ASMB,R,Q,C
* 
*     NAME:   TO..
*     SOURCE: 92071-18106 
*     RELOC:  92071-1X106 
*     PGMR:   C.H.W.,DJN
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
* 
      NAM TO..,7  92071-1X106  REV.2041  800409 
* 
* 
* 
* 
*  ACTION SUBROUTINE TO EXECUTE THE "TO" OPERATOR COMMAND 
* 
*    COMMAND SYNTAX:
*        TO,LU(,TIMEOUT VALUE)
* 
* 
      ENT TO..
* 
      EXT EXEC,$LIBR,$LIBX,$CVT3,CAM.O,CNOPT
      EXT $LUTA,$LUT#,.XLA,.XLB,.XSA
* 
* 
TO..  NOP 
      LDA TO..
      INA 
      LDB 0,I 
      STB NUMBA     SAVE ADDR OF # PRAMS
      INA           2ND PARAMETER IS THE PARSE BUFFER ADDR
      LDB 0,I       GET IT
      INB 
      STB TMPAD 
      INA 
      LDA 0,I 
      STA ERRTN     SAVE ADDR OF ERROR PARAM
      LDA TO..,I
      STA TO..      SAVE RETURN ADDR
* 
*  PROCESS LU PARAMETER 
      LDA 1,I       GET LU PARAMETER
      STA M.VAL 
      CMA,INA       A=-LU 
      SSA,RSS       WAS LU < 1? 
      JMP ER56       YES, ERROR 
      STA TEMP
      JSB .XLA      ADD TOTAL # OF LU'S 
      DEF $LUT# 
      ADA TEMP
      SSA           OK? 
      JMP ER56       NO, LU OUT OF RANGE
      LDA M.VAL     GET LU AGAIN
      CLB,CCE 
      DIV .10 
      SZA           LEADING ZERO? 
      IOR B20        NO, FORM NUMERIC 
      ALF,ALF       LEFT JUSTIFY
      IOR 1         INCLUDE LSB 
      IOR ASC.0     FORM ASCII
      STA M.LU      STORE IN MSG
      STA M.LU2 
      JSB .XLA
      DEF $LUTA 
      ADA M.VAL     ADD NUMERIC LU
      ADA N1        DECRIMENT 
      JSB .XLB      GET THE DVT ADDRESS 
      DEF 0,I 
      SZB,RSS       ASSIGNED TO BIT BUCKET? 
      JMP TO.90      YES
      ADB .12       ADDR OF DVT13 (PHY T.O.)
      LDA NUMBA,I   GET NUMBER OF ENTERED PARAMS
      CPA .1
      JMP TO.50     1 ENTERED, SO DISPLAY CURRENT T.O.
      CPA .2
      RAL,SLA       2 ENTERED, OK 
      JMP ER56       ELSE WRONG # OF PARAMS 
* 
      ADA TMPAD     COMPUTE ADDR OF 2ND PARM
      LDA 0,I       GET NEW TIMEOUT 
      CMA,INA,SZA   NEGATE IT 
      ADA N1         LESS 1 UNLESS 0
      JSB $LIBR     LOWER FENCE 
      NOP 
      JSB .XSA      STORE NEW TIMEOUT IN DVT13
      DEF 1,I 
      JSB $LIBX     RAISE FENCE 
      DEF *+1 
      DEF *+1 
      JMP TO.60     NOW DISPLAY TIMEOUT 
* 
      SKP 
* 
* 
*  THIS SECTION DISPLAYS CURRENT TIMEOUT
* 
TO.50 JSB .XLA      GET CURRENT T.O.
      DEF 1,I 
TO.60 CMA,CCE,INA,SZA MAKE POSITIVE 
      ADA N1         LESS 1 UNLESS ZERO 
      JSB $CVT3     CONVERT TO ASCII
      LDB 0,I       GET 1ST 2 CHARS 
      ADB HI.EQ     CHANGE 1ST FROM BLANK TO "="
      STB M.VAL      & STORE IN MSG 
      INA 
      DLD 0,I       GET 3RD THRU 6TH CHARS
      DST M.VAL+1    & PUT IN MSG 
* 
      JSB CNOPT     WRITE RESPONSE LINE 
      DEF *+5 
      DEF .2
      DEF CAM.O 
      DEF MSGBF 
      DEF MSGLN 
      JMP TO..,I    RETURN
* 
*  LU WAS ASSIGNED TO BIT BUCKET
TO.90 JSB CNOPT     WRITE "LU UNASSIGNED" 
      DEF *+5 
      DEF .2
      DEF CAM.O 
      DEF MUNAS 
      DEF MS2LN 
      JMP TO..,I
* 
* 
ER56  LDA .56       56 = BAD PARAMETER
      STA ERRTN,I   RETURN ERROR VALUE
      JMP TO..,I     AND RETURN 
* 
*  DATA AREA
* 
TMPAD NOP 
NUMBA NOP 
ERRTN NOP 
TEMP  NOP 
* 
.1    DEC 1 
.2    DEC 2 
.10   DEC 10
.12   DEC 12
.56   DEC 56
B20   OCT 20
N1    DEC -1
ASC.0 ASC 1, 0
HI.EQ OCT 16400 
* 
MSGBF EQU * 
      ASC 2,TO #
M.LU  BSS 1 
M.VAL BSS 3 
MSGLN ABS *-MSGBF 
* 
MUNAS EQU * 
      ASC 2,LU #
M.LU2 NOP 
      ASC 6, UNASSIGNED 
MS2LN ABS *-MUNAS 
* 
      END 
                                                                  