ASMB,N,C,L
      IFN 
          NAM  DSINF,19,65 1000-1000-3000 780106 24999-16215 REV 1902 
          EXT  DEXEC
      XIF 
      IFZ 
          NAM  DSINF,19,65 1000-3000 VRSN 780106
      XIF 
          SPC  1
          SUP 
A         EQU  0
B         EQU  1
          EXT  $LIBR,$LIBX,$PARS,$CVT1,CNUMO,CNUMD
          EXT  EXEC,RMPAR,$CLAS,$RNTB 
      SPC 1 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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.        * 
*  **************************************************************** 
      SPC 1 
********************************************
*                                          *
*     NAME:        DSINF (DS INFORMATION)  *
*                                          *
*     SOURCE:      24999-18215 (N-OPTION)  *
*                                          *
*     RELOCATABLE: 24999-16215 (N-OPTION)  *
*                                          *
*     PROGRAMMER:  DT                      *
*                                          *
*     DATE:        APRIL 1977              *
*                                          *
********************************************
      SPC 3 
* THE ORIGINAL CODE FOR THIS PROGRAM WAS WRITTEN IN HP ALGOL. 
* MODIFICATIONS HAVE BEEN INTRODUCED SINCE TRANSLATION TO 
* ASSEMBLY LANGUAGE!
      SPC 3 
* ASSEMBLY OPTIONS: 
*    N    1000-1000 AND 1000-3000 VERSION 
*    Z    1000-3000 ONLY (NO DEXEC OR NRV)
      SKP 
*COMMENT DS/1000 UTILTIY PROGRAM. [DT]
* 
*RUN FROM RTE WITH
*  RU,DSINF,<INLU>,<OUTLU>,<CONWD>,<NODE>,<FLAG>
* 
*THE RUN-TIME PARAMETERS HAVE THESE MEANINGS: 
* 
*  <INLU>   THE LOGICAL UNIT NUMBER OF THE INPUT DEVICE. THE DEFAULT
*           IS THE NUMBER OF THE SCHEDULING TERMINAL PASSED BY M-T-M
*           OR 1. IF THE INPUT DEVICE IS INTERACTIVE (USES DVR00 OR 
*           SUBCHANNEL 0 AND DVR05), A PROMPT IS PRINTED ON THE DEVICE
*           BEFORE EACH READ. 
* 
*  <OUTLU>  THE LOGICAL UNIT NUMBER OF THE DEVICE WHERE INFORMATION IS
*           PRINTED. THE DEFAULT IS THE INPUT LU (IF INTERACTIVE) OR 6. 
* 
*  <CONWD>  A CONTROL WORD WHICH SPECIFIES DSINF WILL BE RUN NON- 
*           INTERACTIVELY. THE FUNCTIONS WHICH TAKE PLACE ARE 
*           DETERMINED BY THE BITS SET: 
* 
*            DECIMAL
*             VALUE  PRINT THIS INFORMATION 
*            ------- ------------------------------ 
*               1    AVAILABLE MEMORY SUSPEND LIST
*               2    I/O CLASSES
*               4    DS/1000 VALUES 
*               8    DUMP OF SAM BLOCK
*              16    DS/1000 LISTS
*              32    NODAL ROUTING VECTOR 
*              64    DS/1000 EQT ENTRIES
* 
*           FOR EXAMPLE, TO PRINT THE I/O CLASS AND DS/1000 VALUES
*           ON YOUR TERMINAL, TYPE RU,DSINF,,,6.
* 
*  <NODE>   THE NODE NUMBER WHERE I/O IS TO OCCUR. DEFAULT IS LOCAL 
*           NODE (-1).
* 
*  <FLAG>   SET TO A NON-ZERO VALUE WHEN THE NODE NUMBER IS 0 (TO 
*           DISTINGUISH IT FROM THE DEFAULT). 
* 
* 
*DSINF RECOGNIZES THE FOLLOWING COMMANDS: 
*   AV  AVAILABLE MEMORY SUSPEND LIST 
*   CL  I/O CLASSES 
*   VA  DS/1000 VALUES
*   DU  DUMP OF SAM BLOCK 
*   LI  DS/1000 LISTS 
*   NR  NODAL ROUTING VECTOR
*   EQ  DS/1000 EQT ENTRIES 
*   EQ,N  PRINT INFORMATION ON EQT N
*   /E OR EX  TERMINATE DSINF 
* 
*ALL OTHER CHARACTERS CAUSE THE FUNCTIONS TO BE LISTED ON THE 
*OUTPUT DEVICE.;
          SKP 
* RUN-TIME PARAMETERS 
*INTEGER INLU,OUTLU,CONWD,P4,P5;
INLU      BSS  01 
OUTLU     BSS  01 
CONWD     BSS  01 
NODE      BSS  01 
FLAG      BSS  01 
          SPC  2
*INTEGER I,J,         & COUNTERS
I         BSS  01 
J         BSS  01 
*        KYWRD,       & BASE OF KEYWORD TABLE 
KYWRD     BSS  01 
*        BLANK:="  ", & ASCII BLANK 
BLANK     OCT  020040 
*        MAXID,       & # OF ENTRIES IN KEYWORD TABLE 
MAXID     BSS  01 
*        SSIZE;       & SIZE OF SAM BLOCK 
SSIZE     BSS  01 
          SPC  2
* DS/1000 VALUES
          EXT  #CNOD,#FWAM,#TBRN,#QRN,#MSTO,#SVTO,#WAIT 
          EXT  #BREJ,#LU3K,#QZRN,#GRPM,#NRV,#TST
          EXT  #RFSZ,#LDEF,#NCNT,#NODE,#LNOD,D$LID,D$RID
          SPC 2 
*INTEGER ARRAY BUFR[1:1];  & OUTPUT BUFFER
BUFR      EQU  *
* OUTPUT FIELDS (WORDS 1 THROUGH 39)
W1        BSS  01 
W2        BSS  01 
W3        BSS  2
W5        BSS  01 
W6        BSS  01 
W7        BSS  01 
W8        BSS  01 
W9        BSS  01 
W10       BSS  01 
W11       BSS  2
W13       BSS  01 
W14       BSS  01 
W15       BSS  01 
W16       BSS  01 
W17       BSS  1
W18       BSS  1
W19       BSS  01 
W20       BSS  01 
W21       BSS  19 
* 
* HOLDING AREA FOR NUMBER CONVERSION
*INTEGER HOLD1,HOLD2,HOLD3; 
HOLD1     BSS  01 
HOLD2     BSS  01 
HOLD3     BSS  01 
* 
* BASE PAGE LOCATIONS 
SAMIN     BSS 1     SAM ARRAY INITIALIZED?
*INTEGER EQTA  := @1650,    & FIRST WORD OF EQUIPMENT TABLE 
EQTA      EQU  1650B
*        DRT   := @1652,    & FIRST WORD OF DEVICE REFERENCE TABLE
DRT       EQU  1652B
*        LUMAX := @1653,    & NUMBER OF LOGICAL UNITS IN DRT
LUMAX     EQU  1653B
*        KEYWD := @1657,    & FWA OF KEYWORD BLOCK
KEYWD     EQU  1657B
*        SUSP2 := @1713,    & "WAIT SUSPEND" LIST 
SUSP2     EQU  1713B
*        SUSP3 := @1714;    & "AVAILABLE MEMORY" WAIT LIST
SUSP3     EQU  1714B
XEQT      EQU  1717B     MY ID SEGMENT ADDRESS
* 
*EQUATE  LSTRM := 10;       & LAST STREAM NUMBER
LSTRM     EQU  10 
NOSTR     ABS  LSTRM
* 
*INTEGER ARRAY SAM[0:640],     & DS/1000 SYSTEM-AVAILABLE-MEMORY
SAM       EQU  *
          BSS  640
*              PNTR[-3:LSTRM]; & POINTERS INTO SAM
PNTR      EQU  *+3
          BSS  LSTRM+4
          SKP 
*  +--------------+ 
*  !  PROCEDURES  ! 
*  +--------------+ 
          SPC 3 
* 
*   CONVERT DECIMAL NUMBER TO ASCII 
* 
CNVTD NOP 
      STA T1        SAVE THE RAW DATA, TEMPORARILY. 
      LDA CNVTD,I   GET THE DESTINATION ADDRESS.
      STA STUFM     CONFIGURE THE CALL TO 'CNUMD'.
      JSB CNUMD     GO TO 
      DEF *+3        CONVERT
      DEF T1          THE VALUE 
STUFM NOP              TO ASCII.
      ISZ CNVTD     ADJUST THE RETURN POINTER,
      JMP CNVTD,I    AND RETURN TO THE CALLER.
      SPC 3 
* 
*   CONVERT DECIMAL NUMBER TO ASCII, TWO DIGITS 
*     (VALUE GOES IN A-REGISTER)
* 
KCVT  NOP 
      CCE           SET DECIMAL OPTION. 
      JSB $LIBR     GO TO 
      NOP            THE SYSTEM 
      JSB $CVT1       FOR CONVERSION. 
      JSB $LIBX     RETURN TO 
      DEF KCVT       THE CALLER.
      SPC 3 
* 
* CHASE DOWN INDIRECTS
* 
INDR  NOP 
      RSS 
N     LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP N 
      JMP INDR,I
      SKP 
* 
*   FILL BUFR ARRAY WITH A-REGISTER CONTENTS
* 
FILL      NOP           ENTRY POINT 
          LDX  D39      INITIALIZE COUNTER
LOOP      SAX  BUFR-1   STORE A-REG 
          DSX           DECREMENT X-REG AND CONTINUE
          JMP  LOOP      IN LOOP UNTIL X=0. 
* 
          JMP  FILL,I   RETURN
          SPC 3 
* 
*  PRINT A STRING 
* 
MSG       BSS  1          STRING ADDRESS
LEN       BSS  1          LENGTH
* 
PRINT     NOP           ENTRY POINT 
          LDA  PRINT,I  GET PARAMETERS
          STA  MSG
          ISZ  PRINT
          LDA  PRINT,I
          STA  LEN
          ISZ  PRINT
* 
      UNL 
      IFN 
      LST 
          JSB  DEXEC     CALL DEXEC FOR WRITE 
          DEF  *+6
          DEF  NODE 
      UNL 
      XIF 
      LST 
      UNL 
      IFZ 
      LST 
          JSB  EXEC      CALL EXEC FOR WRITE
          DEF  *+5
      UNL 
      XIF 
      LST 
          DEF  D2 
          DEF  OUTLU
          DEF  MSG,I
          DEF  LEN
* 
          JMP  PRINT,I  RETURN
          SKP 
* 
*  MOVE THE DS/1000 BLOCK OF SAM
* 
DEST      DEF  SAM      DESTINATION ADDRESS 
PONTR     NOP           ADDRESS WHERE POINTER IS STORED 
          DEF  PNTR-3   POINTERS' ARRAY 
* 
GTSAM     NOP           ENTRY POINT 
          JSB  $LIBR    INSURE NOBODY CHANGES SAM 
          NOP            BY GOING PRIVILEGED
* 
          LDA  #FWAM    A-REG := SOURCE ADDR IN SAM 
          LDB  DEST     B-REG := DESTINATION
          LDX  SSIZE    X-REG := # OF WORDS TO MOVE 
          MWF           MOVE WORDS FROM ALTERNATE MAP 
* 
          LDA  PONTR+1
          STA  PONTR
          CCA           \ GET ADDRESS 
          ADA  #LDEF    /  OF FIRST POINTER 
          LDX  D14      INITIALIZE COUNTER
LOOP2     LDB  A,I      PICK UP POINTER 
          LDB  B,I
          STB  PONTR,I  STORE POINTER 
          INA           INCREMENT SOURCE ADDR 
          ISZ  PONTR    INCREMENT DEST ADDR 
          DSX           DONE? 
          JMP  LOOP2      NO--MOVE NEXT POINTER 
* 
          JSB  $LIBX    RESTORE SYSTEM
          DEF  GTSAM      AND RETURN
          SPC  3
* 
*  PLACE THE CONTENTS OF A LOCATION IN ALTERNATE MAP
*   INTO THE A-REGISTER 
* 
IXGET     NOP           ENTRY POINT 
          XLA  A,I
          JMP  IXGET,I  RETURN
          SKP 
*    (LYLE WEIMAN'S 11-2-76 VERSION MODIFIED BY DT) 
* 
*   RETRIEVE DS/1000 EQT CONTENTS 
* 
*    CALL FROM ALGOL WITH 
*         GTEQT(IBUF[1],EQTN,LU)
* 
*       IBUF - BUFFER TO ACCOMODATE 15 WORDS OF EQT + 8 WORD EXTENT 
*       EQTN - I'LL FIND THE FIRST EQT *AFTER* EQTN WHICH IS
*               DIRECTED TO DVA65 (TYPE 65) AND RETURN THAT 
*               EQT NUMBER IN EQTN - IF NO EQT IS FOUND, I'LL RETURN
*               ZERO IN 'EQTN'
*       LU   -  AN LU POINTING TO THE EQT 
* 
EQTBF DEF EBUFR+1 
      UNL 
      IFN 
      LST 
EQTN  DEF EQNUM 
EQLU  DEF LUNUM 
* 
GTEQT NOP 
      LDA 1651B     IF REQUEST IS FOR N> NUMBER 
      CMA,INA       OF EQT'S IN SYSTEM, ERROR!
      ADA EQTN,I
      SSA,RSS 
      JMP DONE1 
* 
LOOP1 LDA EQTN,I   GET ADDRESS OF EQT 
      ISZ EQTN,I    (POINT TO NEXT ONE...)
      MPY D15 
      ADA EQTA
      STA EQADR     SAVE
      ADA D4       CHECK TYPE CODE
      LDA A,I 
      AND EQTYP 
      CPA D65TP     FOR DVA65?
      JMP MOVE      YES, GO MOVE IT TO USER AREA
      LDA EQTN,I    NO, WAS IT THE LAST ONE IN
      CPA 1651B      THE SYSTEM?
      JMP DONE1     YES, ALL DONE!
      JMP LOOP1     NO, LOOK AGAIN! 
* 
*  MOVE EQT TO USER BUFFER
MOVE  LDA EQADR     A := SOURCE ADDRESS 
      LDB EQTBF     B := DESTINATION
      JSB $LIBR     MAKE SURE EQT ISN'T CHANGED 
      NOP            BY HOLDING OFF INTERRUPTS
      MVW D15      MOVE 15 WORDS FROM EQT 
*   MOVE EQT EXTENSION
      LDA EQADR     GET ADDRESS OF EQT EXTENSION
      ADA D12      (IT'S IN EQT WORD 13)
      LDA A,I 
      MVW D8       MOVE 8 WORD EXTENSION
      JSB $LIBX     RESTORE INTERRUPTS
      DEF *+1 
      DEF *+1 
* 
* 
      CLA,INA       PRESET TO LU=1
      STA EQLU,I
      LDA LUMAX     GET DRT TABLE SIZE
      CMA,INA       NEGATE AS COUNTER 
      STA C0UNT 
      LDB DRT       GET DRT ADDRESS 
LOOP4 LDA B,I       GET DRT ENTRY 
      AND B77       GET EQT NUMBER
      CPA EQTN,I    = OURS? 
      JMP GTEQT,I   YES, WE'RE ALL DONE!, RETURN
      ISZ EQLU,I    NO,INDEX TO NEXT
      INB 
      ISZ C0UNT 
      JMP LOOP4     KEEP GOING 'TILL RUN OUT... 
* 
      CLA           CAN'T FIND AN LU, SET IT = 0
      STA EQLU,I
      JMP GTEQT,I   RETURN TO CALLER
* 
*  GET HERE IF RUN OUT OF EQT'S...
DONE1 CLA           RETURN WITH EQTN=0
      STA EQTN,I
      JMP GTEQT,I   RETURN... 
* 
C0UNT BSS 1 
EQADR BSS 1 
EQTYP OCT 37400 
D65TP OCT 32400 
      UNL 
      XIF 
      LST 
          SPC  3
*PROCEDURE BLINE; 
BLINE     NOP 
*     PRINT A BLANK LINE
          JSB  PRINT
          DEF  BLANK
D1        DEC  1
          JMP  BLINE,I
          SKP 
*PROCEDURE LFUNS; 
*   BEGIN 
* 
*   COMMENT 
*      +------------------------------------+ 
*      !  LIST FUNCTIONS PROVIDED BY DSINF  ! 
*      +------------------------------------+;
* 
@FUN1     DBL  FUN1+1 
FUN1      ASC 13, /DSINF: VALID FUNCTIONS-- 
FUN2      ASC 18,   AV  AVAILABLE MEMORY SUSPEND LIST 
FUN3      ASC  9,   CL  I/O CLASSES 
FUN5      ASC 11,   VA  DS/1000 VALUES
FUN6      ASC 12,   DU  DUMP OF SAM BLOCK 
FUN7      ASC 10,   LI  DS/1000 LISTS 
      UNL 
      IFN 
      LST 
FUN9      ASC 14,   NR  NODAL ROUTING VECTOR
      UNL 
      XIF 
      LST 
FUN8      ASC 13,   EQ  DS/1000 EQT ENTRIES 
      UNL 
      IFN 
      LST 
FUN8A     ASC 15,   EQ,N  DS/1000 EQT ENTRY # N 
      UNL 
      XIF 
      LST 
FUN10     ASC 14,   /E OR EX  TERMINATE DSINF 
@FN10     DBR  FUN10+11 
* 
LFUNS     NOP 
* 
          JSB  BLINE
* 
          JSB  PRINT
          DEF  FUN1 
          DEC  13 
* 
          JSB  PRINT
          DEF  FUN2 
          DEC  18 
* 
          JSB  PRINT
          DEF  FUN3 
          DEC  9
* 
          JSB  PRINT
          DEF  FUN5 
          DEC  11 
* 
          JSB  PRINT
          DEF  FUN6 
          DEC  12 
* 
          JSB  PRINT
          DEF  FUN7 
          DEC  10 
* 
      UNL 
      IFN 
      LST 
          JSB PRINT 
          DEF FUN9
          DEC 14
* 
      UNL 
      XIF 
      LST 
          JSB  PRINT
          DEF  FUN8 
          DEC  13 
* 
      UNL 
      IFN 
      LST 
          JSB  PRINT
          DEF  FUN8A
          DEC  15 
* 
      UNL 
      XIF 
      LST 
          JSB  PRINT
          DEF  FUN10
          DEC  14 
* 
          JSB  BLINE
*   END OF LFUNS; 
          JMP  LFUNS,I
          SKP 
*PROCEDURE AVMEM; 
*   BEGIN 
*   COMMENT 
*   +---------------------------------------+ 
*   !  PRINT AVAILABLE MEMORY SUSPEND LIST  ! 
*   +---------------------------------------+;
* 
*     HEADINGS: 
MHED1     ASC 20, AVAILABLE MEMORY SUSPEND LIST IS EMPTY
MHED2     ASC 23,    PT  SZ  PRGRM  T PRIOR  AMT.MEM RN  FATHER 
* 
B40K      OCT  40000
B76K      OCT  76000
B77       OCT  77 
D3        DEC  3
D6        DEC  6
HYPHN     ASC  1,-- 
"B"       ASC  1,B
"RN"      ASC  1,RN 
WRD21     BSS  1     ID SEGMENT WORD 21 
WRD22     BSS  1     ID SEGMENT WORD 22 
FATHR     BSS  1     FATHER'S ID SEGMENT WORD 1 
MORE      BSS  1     MORE FATHERS WAITING?
AW1       DEF  W1 
BAW7      DBL  W7 
* 
AVMEM     NOP 
          JSB  BLINE
*   IF (LINK := IGET(SUSP3))#0 THEN 
          LDA  SUSP3
          STA  LINK 
          SZA,RSS 
          JMP  L383 
*      BEGIN
*      & PRINT HEADING
          JSB  PRINT
          DEF  MHED1
D15       DEC  15 
* 
          JSB  BLINE
* 
          JSB  PRINT
          DEF  MHED2
          DEC  23 
*      & PRINT A LINE OF HYPHENS
*      FILL(BUFR,"--"); 
          LDA  HYPHN
          JSB  FILL 
* 
          JSB  PRINT
          DEF  BUFR 
          DEC  35 
*      & PRINT ID INFORMATION FOR EACH PROGRAM IN LIST
*      DO 
*         BEGIN 
*         & POINT TO NEXT LINK IN "AVAILABLE MEMORY" LIST 
*         FILL(BUFR,BLANK);  & CLEAR OUTPUT BUFR
L338      LDA  BLANK
          JSB  FILL 
*         & MOVE PROGRAM NAME 
          LDA  LINK 
          ADA  D12
          CLE,ELA 
          LDB  BAW7 
          MBT  D5 
*         W10 := KCVT(IGET(LINK+14) AND @17);  & TYPE 
          LDA  LINK 
          ADA  D14
          LDA  A,I
          AND  B17
          JSB  KCVT 
          STA  W10
*         W3 := KCVT(((WRD22:=IGET(LINK+21)) AND @77)+1);  & PARTN
          LDA  LINK 
          ADA  D21
          LDA  A,I
          STA  WRD22
          AND  B77
          INA 
          JSB  KCVT 
          STA  W3 
*         W5 := KCVT((WRD22 AND @76000)\@2000 + 1);  & SIZE 
          LDA  WRD22
          AND  B76K 
          CLB 
          LSR  10 
          INA 
          JSB  KCVT 
          STA  W5 
*         CNUMD(IGET(LINK+6),W11);  & PRIORITY
          LDA  LINK 
          ADA  D6 
          LDA  A,I
          JSB  CNVTD
          DEF  W11
*         IF (WRD21 := IGET(LINK+20))<0 THEN W14:="B ";  & BATCH? 
          LDB  "B"
          LDA  LINK 
          ADA  D20
          LDA  A,I
          STA  WRD21
          SSA 
          STB  W14
*         CNUMD(IGET(LINK+1),W15);  & AMOUNT OF MEMORY REQUESTED
          LDA  LINK 
          INA 
          LDA  A,I
          JSB  CNVTD
          DEF  W15
*         IF (WRD21 AND @400)#0 THEN W19:="RN";  & RN?
          LDB  "RN" 
          LDA  WRD21
          AND  B400 
          SZA 
          STB  W19
*         & PUT LINE LENGTH IN "I"
*         I := 20;
          LDA  D20
          STA  I
*         & CHECK "FATHER WAITING" BIT
*         IF (MORE := ((WRD21 AND @40000)#0)) THEN
          LDA  WRD21
          AND  B40K 
          SZA,RSS 
          JMP  L373 
          CCA 
          STA  MORE 
*            BEGIN
*            & MOVE FATHER NAME(S)
*            FATHR := IGET(KYWRD + (WRD21 AND @377)); 
          LDA  WRD21
          AND  B377 
          ADA  KYWRD
          LDA  A,I
          STA  FATHR
*            WHILE MORE DO
*               BEGIN 
*               & MOVE THE NAME 
L354      LDA  FATHR
          ADA  D12
          CLE,ELA 
          LDB  AW1
          ADB  I
          CLE,ELB 
          MBT  D5 
*               & CHECK FOR GRANDFATHER WAITING 
*               IF (MORE := (IGET(FATHR+20) AND @40000)#0) THEN 
          LDA  FATHR
          ADA  D20
          LDA  A,I
          AND  B40K 
          SZA,RSS 
          JMP  L373 
          CCA 
          STA  MORE 
*                  BEGIN
*                  I := I + 3;
          LDA  I
          ADA  D3 
          STA  I
*                  FATHR:=IGET(KYWRD+(IGET(FATHR+20) AND @377));
          LDA  FATHR
          ADA  D20
          LDA  A,I
          AND  B377 
          ADA  KYWRD
          LDA  A,I
          STA  FATHR
*                  & CHECK FOR FULL OUTPUT BUFFER 
*                  IF I > 35 THEN 
          LDA  I
          ADA  DM34 
          SSA 
          JMP  L354 
*                     BEGIN  & WRITE LINE, THEN CLEAR BUFFER
* 
          JSB  PRINT
          DEF  BUFR 
          DEC  38 
*                     FILL(BUFR,BLANK); 
          LDA  BLANK
          JSB  FILL 
*                     I := 20;
          LDA  D20
          STA  I
*                     END;
*                  END; 
*               END;
          JMP  L354 
*            END; 
*         & PRINT OUTPUT BUFFER 
*         PRINT1(I+3);
L373      LDA  I
          ADA  D3 
          STA  T1 
          JSB  PRINT
          DEF  BUFR 
T1        DEC  0
*         LINK := IGET(LINK);  & NEXT ID SEGMENT IN LIST OR 0 
          LDA  LINK,I 
          STA  LINK 
*         END 
*      UNTIL LINK=0;
          SZA 
          JMP  L338 
*      & PRINT LINE OF HYPHENS
*      FILL(BUFR,"--"); 
          LDA  HYPHN
          JSB  FILL 
* 
          JSB  PRINT
          DEF  BUFR 
          DEC  35 
*      END
*    ELSE 
          JMP  L384 
*      & NO PROGRAMS IN "AVAILABLE MEMORY" LIST 
* 
L383      JSB  PRINT
          DEF  MHED1
D20       DEC  20 
*   BLINE;
L384      JSB  BLINE
*   END OF AVMEM; 
          JMP  AVMEM,I
          SKP 
*PROCEDURE CLASS; 
*   BEGIN 
* 
*   COMMENT 
*   +-------------------------------+ 
*   !  PRINT I/O CLASS INFORMATION  ! 
*   +-------------------------------+;
* 
*INTEGER    NBLCK,   & NUMBER OF BLOCKS WAITING IN SAM
NBLCK     BSS  01 
*           TBLCK;   & TOTAL SIZE OF SAM BLOCKS FOR A CLASS 
TBLCK     BSS  01 
* 
*     HEADINGS: 
CHED1     ASC 11, I/O CLASS INFORMATION 
CHED2     ASC 12,       CLASSES IN SYSTEM 
CHED3     ASC 10,    CLASSES IN USE:
CHED4     ASC 22,      CLASS  STATE   GET      POSSIBLE OWNER 
CHED5     ASC 12,       CLASSES AVAILABLE 
CHED6     ASC 13,[    BLOCK(S)      WORDS]
* 
ACHD6     DEF  CHED6
"BU"      ASC  1,BU 
"AL"      ASC  1,AL 
"GT"      ASC  1,GT 
B174C     OCT  17400
D4        DEC  4
B17       EQU  D15
D32       DEC  32 
DM34      DEC  -34
DCLAS     DEF  $CLAS
AVLBL     BSS  1     NUMBER OF CLASSES AVAILABLE
TADDR     BSS  1     I/O CLASS OR RN TABLE ADDRESS
TSIZE     BSS  1     TABLE SIZE 
ENTRY     BSS  1     TABLE ENTRY NUMBER 
TWORD     BSS  1     CONTENTS OF TABLE ENTRY
LINK      BSS  1     ID SEGMENT WORD 1
AW9       DEF  W9 
AW11      DEF  W11
* 
*   & GET CLASS I/O TABLE START ADDRESS & NUMBER OF ENTRIES 
*   GETCL(TADDR,TSIZE); 
CLASS     NOP 
          LDA  DCLAS    GET CLASS TABLE ADDRESS 
          JSB  INDR      CHASE INDIRECT ADDRESS 
          STA  TADDR
          LDA  A,I      GET NUMBER OF ENTRIES 
          STA  TSIZE
*   & PRINT HEADINGS
*   BLINE;
          JSB  BLINE
* 
          JSB  PRINT
          DEF  CHED1
          DEC  11 
*   & PRINT NUMBER OF CLASSES 
*   CNUMD(TSIZE,CHED2); 
          LDA  TSIZE
          JSB  CNVTD
          DEF  CHED2
* 
          JSB  PRINT
          DEF  CHED2
D12       DEC  12 
*   BLINE;
          JSB  BLINE
*   & PRINT HEAD FOR CLASSES IN USE 
* 
          JSB  PRINT
          DEF  CHED3
D10       DEC  10 
* 
          JSB  PRINT
          DEF  CHED4
          DEC  22 
*   & LOOK AT EACH CLASS TO DETERMINE STATE AND POSSIBLE OWNER
*   AVLBL := 0; 
          CLA 
          STA  AVLBL
*   FOR ENTRY := TADDR+1 TO TADDR+TSIZE DO
          LDA  TADDR
          INA 
          STA  ENTRY
          LDB  TADDR
          ADB  TSIZE
          STB  LASTI
L424      CMA,INA 
          ADA  LASTI
          SSA 
          JMP  L498 
*      BEGIN
*      INTOF; 
          JSB  $LIBR
          NOP 
*      IF (TWORD := IGET(ENTRY))=0 THEN 
          LDA  ENTRY,I
          STA  TWORD
          SZA 
          JMP  L434 
*         BEGIN 
*         INTON;
          JSB  $LIBX
          DEF  *+1
          DEF  *+1
*         AVLBL := AVLBL + 1;  & CLASS IS AVAILABLE 
          ISZ  AVLBL
*         END 
*       ELSE
          JMP  L497 
*         BEGIN 
*         FILL(BUFR,BLANK); 
L434      LDA  BLANK
          JSB  FILL 
*         CNUMD(ENTRY-TADDR,W3);
          LDA  TADDR
          CMA,INA 
          ADA  ENTRY
          JSB  CNVTD
          DEF  W3 
*         IF TWORD>0 THEN 
          LDA  TWORD
          SZA 
          SSA 
          JMP  L456 
*            BEGIN  & STATE 2--BUFFERED REQUESTS
*            W8 := "BU";
          LDA  "BU" 
          STA  W8 
*            & FOLLOW LINKS TO BLOCKS OF SAM
*            NBLCK := TBLCK := 0; 
          CLA 
          STA  TBLCK
          STA  NBLCK
*            WHILE TWORD>0 DO 
L441      LDA  TWORD
          SZA 
          SSA 
*               BEGIN 
          JMP  L447 
*               NBLCK := NBLCK + 1; 
          ISZ  NBLCK
*               TBLCK := TBLCK + IXGET(TWORD+3);
          LDA  TWORD
          ADA  D3 
          JSB  IXGET
          ADA  TBLCK
          STA  TBLCK
*               TWORD := IXGET(TWORD);
          LDA  TWORD
          JSB  IXGET
          STA  TWORD
*               END;
          JMP  L441 
*            INTON; 
L447      JSB  $LIBX
          DEF  *+1
          DEF  *+1
*            & PRINT INFORMATION
*            & MOVE # OF BLOCKS AND WORDS HEAD TO OUTPUT BUFFER 
          LDA  ACHD6
          LDB  AW9
          MVW  D13
*            W10 := KCVT(NBLCK);
          LDA  NBLCK
          JSB  KCVT 
          STA  W10
*            CNUMD(TBLCK,HOLD1);
          LDA  TBLCK
          JSB  CNVTD
          DEF  HOLD1
*            MOVE(HOLD2,W16,4); 
          LDA  HOLD2
          STA  W16
          LDA  HOLD3
          STA  W17
* 
          JSB  PRINT
          DEF  BUFR 
          DEC  22 
*            FILL(BUFR,BLANK);
          LDA  BLANK
          JSB  FILL 
*            END
*          ELSE INTON;
          JMP  L457 
L456      JSB  $LIBX
          DEF  *+1
          DEF  *+1
*         IF (TWORD AND @40000)=0 THEN
L457      LDA  TWORD
          AND  B40K 
          SZA 
          JMP  L461 
*            W8 := "AL"  & ALLOCATED
*          ELSE 
          LDA  "AL" 
          STA  W8 
          JMP  L476 
*            BEGIN
*            W8 := "GT"; & GET
L461      LDA  "GT" 
          STA  W8 
*            & SOMEONE MUST BE WAITING ON THIS CLASS'S GET
*            INTOF; 
          JSB  $LIBR
          NOP 
*            LINK := IGET(SUSP2);  & HEAD OF GENERAL WAIT QUEUE 
          LDA  SUSP2
          STA  LINK 
*            WHILE LINK#0 AND IGET(LINK+1)#ENTRY DO 
L465      LDA  LINK 
          SZA,RSS 
          JMP  L467 
          LDA  LINK 
          INA 
          LDA  A,I
          CMA,INA 
          ADA  ENTRY
          SZA,RSS 
*               LINK := IGET(LINK); 
          JMP  L467 
          LDA  LINK,I 
          STA  LINK 
          JMP  L465 
*            INTON; 
L467      JSB  $LIBX
          DEF  *+1
          DEF  *+1
*            IF LINK#0 THEN 
          LDA  LINK 
          SZA,RSS 
          JMP  L473 
*               BEGIN  & FOUND "GET" PROGRAM
*               & MOVE NAME TO OUTPUT BUFFER
          LDA  LINK 
          ADA  D12
          CLE,ELA 
          LDB  AW11 
          CLE,ELB 
          MBT  D5 
*               END 
*             ELSE
          JMP  L476 
*               & MOVE "<NONE>" TO BUFFER 
L473      LDA  ANONE
          LDB  AW11 
          MVW  D3 
*            END; 
*         & PICK UP INDEX INTO KEYWORD TABLE, MODULO 32 
*         IDNUM := ROTATE(TWORD AND @17400);
L476      LDA  TWORD
          AND  B174C
          ALF,ALF 
*         IF IDNUM=0 THEN IDNUM:=32;
          SZA,RSS 
          LDA  D32
          STA  IDNUM
*         & FIND POSSIBLE OWNERS
*         I := 15;  & OUTPUT BUFFER POINTER 
          LDA  D15
          STA  I
*         DONE := FALSE;
          CLA 
          STA  DONE 
*         DO
*            BEGIN
*            LINK := IGET(KYWRD+IDNUM); 
L483      LDA  KYWRD
          ADA  IDNUM
          LDA  A,I
          STA  LINK 
*            IF (IGET(LINK+14) AND @20)=0 AND IGET(LINK+12)#0 THEN
          ADA  D14
          LDA  A,I
          AND  B20
          SZA 
          JMP  L490 
          LDA  LINK 
          ADA  D12
          LDA  A,I
          SZA,RSS 
          JMP  L490 
*               BEGIN  & GOOD ID SEGMENT
*               MOVII(LINK+12,AW1+I,5); 
          LDA  LINK 
          ADA  D12
          CLE,ELA 
          LDB  AW1
          ADB  I
          CLE,ELB 
          MBT  D5 
*               IF (I := I + 4)>34 THEN 
          LDA  I
          ADA  D4 
          STA  I
          ADA  DM34 
          SZA 
          SSA 
          JMP  L490 
*                  DONE := TRUE;  & OUTPUT BUFFER IS FULL 
          CCA 
          STA  DONE 
*               END;
*            IF (IDNUM:=IDNUM+32)>MAXID THEN
L490      LDA  IDNUM
          ADA  D32
          STA  IDNUM
          CMA,INA 
          ADA  MAXID
          SSA,RSS 
          JMP  L493 
*               DONE := TRUE;  & ALL ID SEGMENTS CHECKED
          CCA 
          STA  DONE 
*            END
*            UNTIL DONE;
L493      LDA  DONE 
          SSA,RSS 
          JMP  L483 
*         & PRINT LINE OF INFORMATION FOR THIS CLASS
          LDA  I
          STA  T4 
          JSB  PRINT
          DEF  BUFR 
T4        DEC  0
*         END;
*      END; 
L497      LDA  ENTRY
          INA 
          STA  ENTRY
          JMP  L424 
*   IF AVLBL=TSIZE THEN 
L498      LDA  TSIZE
          CMA,INA 
          ADA  AVLBL
          SZA 
          JMP  L502 
* 
          JSB  PRINT
          DEF  NONE 
          DEC  7
*    ELSE 
          JMP  L507 
*      BEGIN  & PRINT NUMBER OF AVAILABLE CLASSES 
*      BLINE; 
L502      JSB  BLINE
*      CNUMD(AVLBL,CHED5);
          LDA  AVLBL
          JSB  CNVTD
          DEF  CHED5
* 
          JSB  PRINT
          DEF  CHED5
          DEC  12 
*      END; 
*   BLINE;
L507      JSB  BLINE
*   END OF CLASS; 
          JMP  CLASS,I
          SPC  3
DONE      BSS  1     ALL POSSIBLE CLASS OWNERS FOUND? 
IDNUM     BSS  1     INDEX INTO KEYWORD TABLE 
NONE      ASC  7,        <NONE> 
          SKP 
*PROCEDURE VALUS; 
*   BEGIN 
* 
*   COMMENT 
*   +------------------------+
*   !  PRINT DS/1000 VALUES  !
*   +------------------------+; 
* 
*     HEADINGS: 
VHED1     ASC  8, DS/1000 VALUES: 
VHED2     ASC 20,  RESOURCE NUMBERS:     OWNER     LOCKER 
VHED3     ASC  7,TABLE ACCESS 
VHED4     ASC  7,QUIESCENT
VHED5     ASC  7,QUEZ "LISTEN"
VHD12     ASC 12,  TIMEOUT VALUES (SEC):
VHD13     ASC 13,    MASTER T/O 
VHD14     ASC 13,    SLAVE T/O
VHD15     ASC 13,    REMOTE BUSY WAIT 
VHD16     ASC 13,    REMOTE QUIET WAIT
VHED7     ASC 16,           RFA FILES MAY BE OPEN 
VHED9     ASC 11,    HP3000 IS ON LU
VHD10     ASC 21,      LOCAL ID SEQUENCE: 
VHD11     ASC 21,      REMOTE ID SEQUENCE:
* 
B377      OCT  377
UPMSK     OCT  177400 
MASK2     OCT  177760 
D5        DEC  5
D26       DEC  26 
AVH10     DBL  VHD10+13 
AVH11     DBL  VHD11+13 
DRNTB     DEF  $RNTB
RN        BSS  1
FMTAD     BSS  1
GLBAL     ASC  5, <GLOBAL>
AGLBL     DEF  GLBAL
ANONE     DEF  NONE+4 
AW3       DEF  W3 
AW13      DEF  W13
AW16      DEF  W16
AW18      DEF  W18
* 
*   PROCEDURE RNOUT(RN,FMTAD);
RNOUT     BSS  01 
*      VALUE RN,FMTAD; INTEGER RN,FMTAD;
*      BEGIN  & PRINT RN INFORMATION
          AND  B377     ISOLATE RESOURCE
          STA  RN        NUMBER.
          LDA  RNOUT,I
          STA  FMTAD
          ISZ  RNOUT
*      FILL(BUFR,BLANK);
          LDA  BLANK
          JSB  FILL 
*      & MOVE TITLE 
          LDA  FMTAD
          LDB  AW3
          MVW  D7 
*      & CONVERT RN NUMBER
*      W10 := KCVT(RN); 
          LDA  RN 
          JSB  KCVT 
          STA  W10
*      & FIND LOCKER
*      TWORD := IGET(TADDR+RN); 
          LDA  TADDR
          ADA  RN 
          LDA  A,I
          STA  TWORD
*      IF (IDNUM := TWORD AND @377)=@377 THEN 
          AND  B377 
          STA  IDNUM
          CPA  B377 
          RSS 
          JMP  L548 
*         & MOVE "<GLOBAL>" 
          LDA  AGLBL
          LDB  AW16 
          INB 
          MVW  D5 
*       ELSE IF IDNUM=0 THEN
          JMP  L553 
L548      LDA  IDNUM
          SZA 
          JMP  L551 
*         & MOVE "<NONE>" 
          LDA  ANONE
          LDB  AW18 
          MVW  D3 
*       ELSE
          JMP  L553 
*         & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 
L551      LDA  KYWRD
          ADA  IDNUM
          LDA  A,I
          ADA  D12
          CLE,ELA 
          LDB  AW18 
          CLE,ELB 
          MBT  D5 
*      & FIND OWNER 
*      IF (IDNUM := ROTATE(TWORD) AND @377)=@377 THEN 
L553      LDA  TWORD
          ALF,ALF 
          AND  B377 
          STA  IDNUM
          CPA  B377 
          RSS 
          JMP  L555 
*         & MOVE "<GLOBAL>" 
          LDA  AGLBL
          LDB  AW11 
          INB 
          MVW  D5 
*       ELSE IF IDNUM=0 THEN
          JMP  L560 
L555      LDA  IDNUM
          SZA 
          JMP  L558 
*         & MOVE "<NONE>" 
          LDA  ANONE
          LDB  AW13 
          MVW  D3 
*       ELSE
          JMP  L560 
*         & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 
L558      LDA  KYWRD
          ADA  IDNUM
          LDA  A,I
          ADA  D12
          CLE,ELA 
          LDB  AW13 
          CLE,ELB 
          MBT  D5 
*      & PRINT INFORMATION
L560      JSB  PRINT
          DEF  BUFR 
D21       DEC  21 
*      END OF RNOUT;
          JMP  RNOUT,I
* 
*   & PRINT HEADINGS
VALUS     NOP 
*   BLINE;
          JSB  BLINE
* 
          JSB  PRINT
          DEF  VHED1
D8        DEC  8
*   BLINE;
          JSB  BLINE
*   & RESOURCE NUMBERS
          JSB  PRINT
          DEF  VHED2
          DEC  20 
*   GETRN(TADDR,TSIZE); 
          LDA  DRNTB    GET RN TABLE ADDRESS
          JSB  INDR      CHASE INDIRECT ADDRESS 
          STA  TADDR
          LDA  A,I      GET NUMBER OF ENTRIES 
          STA  TSIZE
*   RNOUT(TBRN,FADDRESS(VHED3));
          LDA  #TBRN
          JSB  RNOUT
          DEF  VHED3
*   RNOUT(QRN,FADDRESS(VHED4)); 
          LDA  #QRN 
          JSB  RNOUT
          DEF  VHED4
*   IF LU3K#0 THEN
          LDA  #LU3K
          SZA,RSS 
          JMP  L574 
*      RNOUT(QZRN,FADDRESS(VHED5)); 
          LDA  #QZRN
          JSB  RNOUT
          DEF  VHED5
*   BLINE;
L574      JSB  BLINE
*   & TIMEOUT VALUES
          JSB  PRINT
          DEF  VHD12
          DEC  12 
*   CNUMD(-(MSTO OR @177400)*5,VHD13[10]);
          LDA  #MSTO
          IOR  UPMSK
          CMA,INA 
          CLB 
          MPY  D5 
          JSB  CNVTD
          DEF  VHD13+10 
* 
          JSB  PRINT
          DEF  VHD13
D13       DEC  13 
*   CNUMD(-(SVTO OR @177400)*5,VHD14[10]);
          LDA  #SVTO
          IOR  UPMSK
          CLB 
          MPY  D5 
          CMA,INA 
          JSB  CNVTD
          DEF  VHD14+10 
* 
          JSB  PRINT
          DEF  VHD14
          DEC  13 
*   HOLD1 := KCVT(NOT(ROTATE(BREJ) OR @177760));
          LDA  #BREJ
          ALF,ALF 
          IOR  MASK2
          CMA 
          JSB  KCVT 
          STA  VHD15+12 
*   MOVII(AHLD1,FADDRESS(VHD15)+13,2);
* 
          JSB  PRINT
          DEF  VHD15
          DEC  13 
*   CNUMD(-WAIT,HOLD1); 
          LDA  #WAIT
          CMA,INA 
          JSB  CNVTD
          DEF  HOLD1
*   MOVIIAHLD2,FADDRESS(VHD16)+12,4); 
          LDA  HOLD2
          STA  VHD16+11 
          LDA  HOLD3
          STA  VHD16+12 
* 
          JSB  PRINT
          DEF  VHD16
          DEC  13 
*   BLINE;
          JSB  BLINE
*   & NUMBER OF FILES WHICH MAY BE OPEN AT ONCE 
*   CNUMD(RFSZ,VHED7[2]); 
          LDA  #RFSZ
          JSB  CNVTD
          DEF  VHED7+2
* 
          JSB  PRINT
          DEF  VHED7
B20       DEC  16 
*   & CHECK FOR HP3000 AGAIN
*   IF LU3K#0 THEN
          LDA  #LU3K
          SZA,RSS 
          JMP  L611 
*      BEGIN
*      BLINE; 
          JSB  BLINE
*      & HP3000 LU
*      VHED9[10] := KCVT(LU3K); 
          LDA  #LU3K
          JSB  KCVT 
          STA  VHED9+10 
* 
          JSB  PRINT
          DEF  VHED9
          DEC  11 
*      & LOCAL ID SEQUENCE
          LDA  D$LID    LOCAL ID POINTER IN "RES" 
          LDB  A,I      B := NUMBER OF CHARACTERS 
          STB  I        STORE IN I
          SZB,RSS       IF # 0
          JMP  L603 
          INA             A := ADDR OF CHARACTERS 
          CLE,ELA         CHANGE TO BYTE ADDR 
          LDB  AVH10      B := DEST ADDRESS 
          MBT  I          MOVE CHARACTERS 
L603      LDA  I        A := NUMBER OF CHARACTERS 
*      IF I>0 THEN
          SZA 
          SSA 
          JMP  L607 
*         PRINT(VHD10,26+I);
          ADA  D26
          CMA,INA 
          STA  T3 
          JSB  PRINT
          DEF  VHD10
T3        DEC  0
*      & REMOTE ID SEQUENCE 
L607      LDA  D$RID    GET REMOTE POINTER IN "RES" 
          INA 
          LDB  A,I      B := NUMBER OF CHARACTERS 
          STB  I        STORE IN I
          SZB,RSS       IF # 0, 
          JMP  L603A
          INA             A := ADDR OF CHARACTERS 
          CLE,ELA         CHANGE TO BYTE ADDR 
          LDB  AVH11      B := DESTINATION ADDR 
          MBT  I          MOVE CHARACTERS 
L603A     LDA  I        A := NUMBER OF CHARACTERS 
*      IF I>0 THEN
          SZA 
          SSA 
          JMP  L611 
*         PRINT(VHD11,26+I);
          ADA  D26
          CMA,INA 
          STA  T7 
          JSB  PRINT
          DEF  VHD11
T7        DEC  0
*      END; 
*   BLINE;
L611      JSB  BLINE
*END OF VALUS;
          JMP  VALUS,I
          SKP 
*PROCEDURE DUMP;
*   BEGIN 
* 
*   COMMENT 
*   +--------------------------------------+
*   !  DUMP CONTENTS OF DS/1000 SAM BLOCK  !
*   +--------------------------------------+; 
* 
*   INTEGER BADDR,    & DUMP BEGINNING ADDRESS
BADDR     BSS  01 
*           EADDR,    & DUMP ENDING ADDRESS 
EADDR     BSS  01 
*           INCR;     & ADDRESS INCREMENT 
INCR      BSS  01 
* 
*     HEADINGS: 
DHED1     ASC  9, DUMP OF TCB BLOCK 
DHED2     ASC 25,    LOC       OCTAL CONTENTS OF LOC THROUGH LOC+4
DHED3     ASC 20, DUMP OF HP3000 TRANSACTION STATUS TABLE 
DHED4     ASC 25,    LOC       OCTAL CONTENTS OF LOC THROUGH LOC+7
* 
D33       DEC  33 
DM1       DEC  -1 
*   PROCEDURE DODMP;
DODMP     BSS  01 
*      BEGIN
*      FILL(BUFR,BLANK);
          LDA  BLANK
          JSB  FILL 
*      FOR I := BADDR STEP INCR UNTIL EADDR DO
          LDA  BADDR
          STA  I
L637      CMA,INA 
          ADA  EADDR
          LDB  INCR 
          SSB 
          CMA,INA 
          SSA 
          JMP  L647 
*         BEGIN 
*         & CONVERT ADDRESS 
*         CNUMO(I,W2);
          JSB  CNUMO
          DEF  *+3
          DEF  I
          DEF  W2 
*         FOR J := 0 TO INCR-1 DO 
          CLA 
          STA  J
          CCB 
          ADB  INCR 
          STB  T1 
L641      CMA,INA 
          ADA  T1 
          SSA 
          JMP  L645 
*            & CONVERT CONTENTS 
*            CNUMO(SAM[I+J-FWAM],BUFR[7+4*J]);
          LDA  I
          ADA  J
          CMA 
          ADA  #FWAM
          CMA 
          CAX 
          LAX  SAM
          STA  T2 
          LDA  J
          RAL,RAL 
          ADA  D6 
          ADA  AW1
          STA  T4 
          JSB  CNUMO
          DEF  *+3
          DEF  T2 
          DEF  T4,I 
          LDA  J
          INA 
          STA  J
          JMP  L641 
*         & PRINT 
L645      JSB  PRINT
          DEF  BUFR 
LEN1      NOP 
*         END;
          LDA  I
          ADA  INCR 
          STA  I
          JMP  L637 
*      BLINE; 
L647      JSB  BLINE
*      END OF DODMP;
          JMP  DODMP,I
* 
*   & GET DS/1000 SAM BLOCK 
DUMP      NOP 
*   GTSAM(SAM[0],SSIZE,PNTR[-3]); 
          JSB  GTSAM
*   SAMIN := TRUE;
          CCA 
          STA  SAMIN
*   BLINE;
          JSB  BLINE
*   & DUMP TCB AREA IN SAM
          JSB  PRINT
          DEF  DHED1
D9        DEC  9
* 
          JSB  PRINT
          DEF  DHED2
          DEC  25 
*   & SET UP START, STOP, AND INCREMENT OF ADDRESS
*   BADDR := FWAM;
          LDA  #FWAM
          STA  BADDR
*   EADDR := (IF TST#0 THEN TST ELSE NRV) - 1;
          LDA  #TST 
          SZA,RSS 
          LDA  #NRV 
          ADA  DM1
          STA  EADDR
*   INCR := 5;
          LDA  D5 
          STA  INCR 
          LDA  D25       SET LEN1 
          STA  LEN1       TO 25.
*   DODMP;
          JSB  DODMP
*   & HP3000 CONNECTED? 
*   IF LU3K#0 THEN
          LDA  #LU3K
          SZA,RSS 
          JMP  L674 
*      BEGIN
*      & DUMP TST AREA IN SAM 
* 
          JSB  PRINT
          DEF  DHED3
          DEC  20 
* 
          JSB  PRINT
          DEF  DHED4
          DEC  25 
*      & SET UP START, STOP, AND INCREMENT OF ADDRESS 
*      BADDR := TST;
          LDA  #TST 
          STA  BADDR
*      EADDR := FWAM + SSIZE - 1; 
          CCA 
          ADA  #FWAM
          ADA  SSIZE
          STA  EADDR
*      INCR := 7; 
          LDA  D7 
          STA  INCR 
          LDA  D33       SET LEN1 
          STA  LEN1       TO 33.
*      DODMP; 
          JSB  DODMP
*      END; 
*   END OF DUMP;
L674      JMP  DUMP,I 
          SKP 
*PROCEDURE LISTS; 
*   BEGIN 
* 
*   COMMENT 
*   +----------------------------------+
*   !  PRINT DS/1000 LIST INFORMATION  !
*   +----------------------------------+; 
* 
*   INTEGER COUNT,       & # OF ENTRIES IN A LIST 
COUNT     BSS  01 
*           STCB,        & # OF SLAVE TCB ENTRIES 
STCB      BSS  01 
*           HEAD,        & LIST HEAD
HEAD      BSS  01 
*           NEXT;        & NEXT LIST ELEMENT
NEXT      BSS  01 
* 
*     HEADINGS: 
LHED1     ASC  7, DS/1000 LISTS 
LHED2     ASC 20,         ENTRIES IN MASTER REQUEST LIST, 
          ASC  9, STARTING AT 
LHED3     ASC 24,  ACTIVE SLAVE MONITORS:                1ST TCB
LHED4     ASC 24,      STREAM  CLASS  MONITOR  ENTRIES  LOCATION
LHED5     ASC 24,         ENTRIES IN NULL LIST, STARTING AT 
LHED7     ASC 20,         ENTRIES IN HP3000 PROCESS LIST, 
          ASC  9, STARTING AT 
LHED8     ASC 16,         ENTRIES IN SLAVE LISTS
NOT15     OCT  77777
D2        DEC  2
D19       DEC  19 
D39       DEC  39 
* 
*   PROCEDURE CHASE;
CHASE     BSS  01 
*      BEGIN
*      COMMENT   CHASE A LIST TO ITS END; 
*      COUNT := 0;
          CLA 
          STA  COUNT
*      WHILE NEXT#0 DO
L705      LDA  NEXT 
          SZA,RSS 
*         BEGIN 
          JMP  L710 
*         NEXT := SAM[NEXT-FWAM]; 
          LDA  #FWAM
          CMA,INA 
          ADA  NEXT 
          CAX 
          LAX  SAM
          STA  NEXT 
*         COUNT := COUNT + 1; 
          ISZ  COUNT
*         END;
          JMP  L705 
*      END; 
L710      LDA  COUNT     PUT COUNT IN A-REG.
          JMP  CHASE,I   RETURN.
* 
* 
LISTS     NOP 
*   & PRINT HEADINGS
*   BLINE;
          JSB  BLINE
* 
          JSB  PRINT
          DEF  LHED1
D7        DEC  7
*   BLINE;
          JSB  BLINE
*   & DO WE NEED TO GET SAM AND POINTERS? 
*   IF NOT SAMIN THEN 
          LDA  SAMIN
          SSA 
          JMP  L721 
*      GTSAM(SAM[0],SSIZE,PNTR[-3]);
          JSB  GTSAM
*   & CHECK OUT MASTER REQUEST LIST 
*   HEAD := NEXT := PNTR[-1]; 
L721      LDA  PNTR-1 
          STA  NEXT 
          STA  HEAD 
*   CHASE;
          JSB  CHASE
*   CNUMD(COUNT,LHED2[1]);
          JSB  CNVTD
          DEF  LHED2+1
*   CNUMO(HEAD,LHED2[26]);
          JSB  CNUMO
          DEF  *+3
          DEF  HEAD 
          DEF  LHED2+26 
*   PRINT(LHED2,39+19*SIGN(HEAD));
          LDB  D39
          LDA  HEAD 
          SZA 
          ADB  D19
          CMB,INB 
          STB  T2 
          JSB  PRINT
          DEF  LHED2
T2        DEC  0
*   BLINE;
          JSB  BLINE
*   & CHECK SLAVE STREAMS 
          JSB  PRINT
          DEF  LHED3
          DEC  24 
          JSB  PRINT
          DEF  LHED4
          DEC  24 
*   STCB := 0;
          CLA 
          STA  STCB 
*   FOR I := 0 TO LSTRM DO
          CLA 
          STA  I
L733      CMA,INA 
          ADA  NOSTR
          SSA 
          JMP  L753 
*      BEGIN
*      HEAD := IGET(LDEF+2+I);
          LDA  #LDEF
          ADA  D2 
          ADA  I
          LDA  A,I
          STA  HEAD 
*      NEXT := PNTR[I]; 
          LDX  I
          LAX  PNTR 
          STA  NEXT 
*          FILL(BUFR,BLANK);
          LDA  BLANK
          JSB  FILL 
*         &  GET MONITOR NAME FROM ID SEGMENT 
          LDA  HEAD 
          ADA  D2 
          LDA  A,I
*             (CHECK FOR INACTIVE MONITOR:) 
          SZA,RSS 
          JMP  L751A
          AND  NOT15
          ADA  D12
          CLE,ELA 
          LDB  AW11 
          INB 
          CLE,ELB 
          MBT  D5 
*         W5 := KCVT(I);  & STREAM NUMBER 
          LDA  I
          JSB  KCVT 
          STA  W5 
*         W9 := KCVT(IGET(HEAD+1) AND @377);  & CLASS NUMBER
          LDA  HEAD 
          INA 
          LDA  A,I
          AND  B377 
          JSB  KCVT 
          STA  W9 
*      IF NEXT>0 THEN 
          LDA  NEXT 
          SZA 
          SSA 
          JMP  L751 
*         BEGIN 
*         & WE HAVE AN ACTIVE STREAM
*         CNUMO(NEXT,W21);  & STARTING LOCATION 
          JSB  CNUMO
          DEF  *+3
          DEF  NEXT 
          DEF  W21
*         CHASE;
          JSB  CHASE
*         CNUMD(COUNT,W16);  & NUMBER OF ENTRIES
          JSB  CNVTD
          DEF  W16
* 
          JSB  PRINT
          DEF  BUFR 
          DEC  23 
*         STCB := STCB + COUNT; 
          LDA  STCB 
          ADA  COUNT
          STA  STCB 
          JMP  L751A
*         END;
*  EMPTY SLAVE LIST-- W18:="0"
L751      LDA  "0"
          STA  W18
          JSB  PRINT
          DEF  BUFR 
          DEC  18 
*** 
*      END; 
L751A     LDA  I
          INA 
          STA  I
          JMP  L733 
*   & TOTAL NUMBER OF SLAVE TCB'S 
*      CNUMD(STCB,LHED8[1]);
L753      LDA  STCB 
          JSB  CNVTD
          DEF  LHED8+1
* 
          JSB  PRINT
          DEF  LHED8
          DEC  16 
*   BLINE;
          JSB  BLINE
*   & NULL LIST 
*   HEAD := NEXT := PNTR[-2]; 
          LDA  PNTR-2 
          STA  NEXT 
          STA  HEAD 
*   CHASE;
          JSB  CHASE
*   CNUMD(COUNT,LHED5[1]);
          JSB  CNVTD
          DEF  LHED5+1
*   CNUMO(HEAD,LHED5[21]);
          JSB  CNUMO
          DEF  *+3
          DEF  HEAD 
          DEF  LHED5+21 
*   PRINT(LHED5,29+19*SIGN(HEAD));
          LDB  D29
          LDA  HEAD 
          SZA 
          ADB  D19
          CMB,INB 
          STB  T5 
          JSB  PRINT
          DEF  LHED5
T5        DEC  0
*   & CHECK FOR HP3000
*   IF LU3K#0 THEN
          LDA  #LU3K
          SZA,RSS 
          JMP  L787 
*      BEGIN
*      & PROCESS NUMBER LIST
*      HEAD := NEXT := PNTR[-3];
          LDA  PNTR-3 
          STA  NEXT 
          STA  HEAD 
*      CHASE; 
          JSB  CHASE
*      CNUMD(COUNT,LHED7[1]); 
          JSB  CNVTD
          DEF  LHED7+1
*      CNUMO(HEAD,LHED7[26]); 
          JSB  CNUMO
          DEF  *+3
          DEF  HEAD 
          DEF  LHED7+26 
*      PRINT(LHED7,39+19*SIGN(HEAD)); 
          LDB  D39
          LDA  HEAD 
          SZA 
          ADB  D19
          CMB,INB 
          STB  T6 
          JSB  PRINT
          DEF  LHED7
T6        DEC  0
*      END; 
*   BLINE;
L787      JSB  BLINE
*   END OF LISTS; 
          JMP  LISTS,I
          SKP 
*PROCEDURE EQTS;
EQTS      NOP 
* 
*   COMMENT 
*   +--------------------------------------+
*   !  PRINT CONTENTS OF ALL DS/1000 EQTS  !
*   +--------------------------------------+; 
* 
          JSB  BLINE
      UNL 
      IFN 
      LST 
*IF GRPM#0 THEN 
          LDA  #GRPM
          SZA 
          JMP  L857 
      UNL 
      XIF 
      LST 
*   BEGIN 
          JMP  L903 
*   BEGIN 
* 
*   INTEGER EQNUM,  & EQT NUMBER
EQNUM     BSS  01 
*           LUNUM,  & LU CONECTED TO EQT
LUNUM     BSS  01 
*           FPNTR,  & FORMAT ADDRESS POINTER
FPNTR     BSS  01 
* 
*   INTEGER ARRAY EBUFR[1:22]; & HOLDS EQT WORDS
EBUFR     EQU  *-1
          BSS  23 
* 
AEQ1      DEF  EQ1
AEHD4     DEF  EHED4+1
DM22      DEC  -22
DM6       DEC  -6 
"0"       ASC  1, 0 
"1"       ASC  1, 1 
EHED2     ASC 11, DVA65 EQT INFORMATION 
EHED3     ASC 12,   EQT #    ,  LU #   :
EHED4     ASC 18,   WORD  VALUE  MEANING
          ASC 11, WORD  VALUE  MEANING
EHED5     ASC 25,   *BIT BREAKDOWN 15    12     9     6     3     0 
EHED6     ASC 11, DVG67 EQT INFORMATION 
* 
*   & EQT WORDS DESCRIPTIONS--20 CHARACTERS EACH
EQ1       ASC 10,I/O LIST ADDRESS 
          ASC 10,INITIATION ADDRESS 
          ASC 10,CONTINUATION ADDR
          ASC 10,STATUS/UNIT/SUBCHNL* 
          ASC 10,AV/TYPE/STATUS*
          ASC 10,CONWD
      UNL 
      IFN 
      LST 
          ASC 10,DATA BUFFER ADDRESS
          ASC 10,DATA BUFFER LENGTH 
          ASC 10,REQUEST BUFFER ADDR
          ASC 10,REQUEST BUFFER LEN 
          ASC 10,COROUTINE ADDRESS
          ASC 10,CURRENT STATUS*
          ASC 10,EQT EXTENSION ADDR 
          ASC 10,NOMINAL TIMEOUT
          ASC 10,MICROCODE TIMEOUT
          ASC 10,DATA TRANSFER COUNT
          ASC 10,LAST WORD RECEIVED 
          ASC 10,VPW/REPLY REQ LENGTH 
          ASC 10,DPW/REPLY DATA LEN 
          ASC 10,TOTAL BLOCK TRANSFERS
          ASC 10,TOTAL # RETRIES
          ASC 10,NEW REQ ID SEQ ADDR
      UNL 
      XIF 
      LST 
* 
AW20      DEF  W20
COL1      BSS  1
COL3      BSS  1
LASTI     BSS  1
LASTJ     BSS  1
* 
*   PROCEDURE EQMOV(COL1,COL2,COL3);
*      INTEGER COL1,COL2,COL3;
*      BEGIN  & MOVE EQT INFO TO OUTPUT BUFFER
EQMOV     NOP 
          STA  COL1 
          ADA  D2 
          STA  COL2 
          ADA  D4 
          STA  COL3 
*      COL1 := KCVT(I);  & EQT WORD NUMBER
          LDA  I
          JSB  KCVT 
          STA  COL1,I 
*      CNUMO(EBUFR[I],COL2);  & CONTENTS
          LDX  I
          LAX  EBUFR
          STA  T5 
          JSB  CNUMO
          DEF  *+3
          DEF  T5 
COL2      DEF  *-*
*      & MOVE MEANING 
          LDA  FPNTR
          LDB  COL3 
          MVW  D10
*      I := I + 1;
          ISZ  I
*      POINT TO NEXT MEANING
          LDA  FPNTR
          ADA  D10
          STA  FPNTR
*      END OF EQMOV;
          JMP  EQMOV,I
      SPC 1 
* THIS ALGOL BLOCK WAS MODIFIED INTO A SUBROUTINE TO PRINT
*   EQT INFORMATION.
EQOUT     NOP 
*         BEGIN 
*         & PRINT HEADER FOR EQT INFORMATION
*         BLINE;
          JSB  BLINE
*         CNUMD(EQNUM,HOLD1); 
          LDA  EQNUM
          JSB  CNVTD
          DEF  HOLD1
*         MOVII(AHLD2,FADDRESS(EHED3)+5,4); 
          LDA  HOLD2
          STA  EHED3+4
          LDA  HOLD3
          STA  EHED3+5
*         EHED3[10] := KCVT(LUNUM); 
          LDA  LUNUM
          JSB  KCVT 
          STA  EHED3+10 
* 
          JSB  PRINT
          DEF  EHED3
          DEC  12 
* 
          JSB  PRINT
          DEF  EHED4
D29       DEC  29 
*         & PRINT CONTENTS OF EQT AND EXTENT
*         FILL(BUFR,BLANK); 
          LDA  BLANK
          JSB  FILL 
*         FPNTR := FADDRESS(EQ1)+1; 
          LDA  AEQ1 
          STA  FPNTR
*         I := 1; 
          CLA,INA 
          STA  I
*         WHILE I<LASTI DO
L877      LDA  I
          ADA  LASTI
          SSA,RSS 
*            BEGIN
          JMP  L884 
*            EQMOV(W3,W5,W9); 
          LDA  AW3
          JSB  EQMOV
*            EQMOV(W20,W22,W26);
          LDA  AW20 
          JSB  EQMOV
* 
          JSB  PRINT
          DEF  BUFR 
          DEC  36 
*            END; 
          JMP  L877 
*         & PRINT BREAKDOWN OF WORDS 4, 5, (AND 12 FOR DVA65) 
*         BLINE;
L884      JSB  BLINE
* 
          JSB  PRINT
          DEF  EHED5
          DEC  25 
*         FILL(BUFR,BLANK); 
          LDA  BLANK
          JSB  FILL 
*         MOVEI(FADDRESS(EHED4)+2,W3,5);
          LDA  AEHD4
          LDB  AW3
          MVW  D3 
*         J := 4; 
          LDA  D4 
          STA  J
*         DO
*            BEGIN
*            W6 := KCVT(J); 
L891      LDA  J
          JSB  KCVT 
          STA  W6 
*            MASK := 1; 
          CLB,INB 
*            FOR I := 25 STEP -1 UNTIL 10 DO
          LDA  D25
          STA  I
L893      CMA,INA 
          ADA  D10
          CMA,SSA,INA,SZA 
          JMP  L899 
*               BEGIN 
*               BUFR[I] := IF (MASK AND EBUFR[J])#0 THEN
          LDX  J
          LAX  EBUFR
          AND  B
          SZA,RSS 
          JMP  L896 
*                              "1 " ELSE " 0";
          LDA  "1"
          RSS 
L896      LDA  "0"
          LDX  I
          SAX  BUFR-1 
*               MASK := MASK + MASK;
          ADB  B
*               END;
          CCA 
          ADA  I
          STA  I
          JMP  L893 
* 
L899      JSB  PRINT
          DEF  BUFR 
D25       DEC  25 
*            J := IF J=5 THEN 12 ELSE J+1;
          LDA  J
          CPA  D5 
          RSS 
          INA,RSS 
          LDA  D12
          STA  J
*            END
*         UNTIL J=LASTJ;
          CPA  LASTJ
          RSS 
          JMP  L891 
*         BLINE;
          JSB  BLINE
*         END;
          JMP  EQOUT,I   RETURN 
      SPC 1 
      UNL 
      IFN 
      LST 
* PARSE INPUT BUFFER FOR "EQ,N" OPTION
L857  JSB $LIBR 
      NOP 
      LDA @FNTN     INPUT CHARACTERS
      LDB D6        # OF CHARACTERS 
      JSB $PARS 
      DEF PBUFR 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
      LDA INEQT     IF "N" NOT
      SZA,RSS        SPECIFIED, 
      JMP L857A       PRINT ALL DS EQTS.
      ADA DM1 
      STA EQNUM     GET EQT 
      JSB GTEQT      INFO.
      LDA INEQT     WAS IT
      CPA EQNUM       DVA65?
      RSS 
      JMP L903          NO--CHECK FOR HP3000. 
* PRINT THE ONE EQT, THEN RETURN. 
      LDA DM22
      STA LASTI 
      LDA D13 
      STA LASTJ 
      JSB EQOUT 
      JMP EQTS,I
      SPC 1 
* PRINT ALL DS/1000 EQTS: 
* 
*   & PRINT HEADING 
* 
L857A     JSB  PRINT
          DEF  EHED2
          DEC  11 
*   & SEARCH ALL EQT'S
*   EQNUM := 0; 
          CLA 
          STA  EQNUM
*   DO
*      BEGIN
*      GTEQT(EBUFR[1],EQNUM,LUNUM); 
L860      JSB  GTEQT
*      IF EQNUM#0 THEN
          LDA  EQNUM
          SZA,RSS 
          JMP  L903 
* CALL SUBROUTINE TO PRINT EQT INFORMATION
          LDA  DM22      SET
          STA  LASTI      UP
          LDA  D13         FOR
          STA  LASTJ        22 WORDS. 
          JSB  EQOUT
*      END
*   UNTIL EQNUM=0;
          JMP  L860 
      UNL 
      XIF 
      LST 
* 
*  IF HP3000 CONNECTED, PRINT EQT 1-6 AND LONG TERM STATS 
L903      LDA  #LU3K     3000 CONNECTED?
          SZA,RSS 
          JMP  EQTS,I     NO--RETURN. 
* 
          STA  LUNUM     SAVE LU NUMBER.
          ADA  DM1
          ADA  DRT
          LDA  A,I
          AND  B77       A:=HP3000 EQT NUMBER.
          STA  EQNUM     SAVE IT. 
      UNL 
      IFN 
      LST 
      LDB INEQT     IF "EQ,N" NOT 
      SZB,RSS        SPECIFIED, 
      JMP OK1          PRINT 3000 EQT.
      CPB EQNUM     IF 3000 EQT NOT 
      RSS            SPECIFIED, 
      JMP EQTS,I       RETURN.
      UNL 
      XIF 
      LST 
OK1       ADA  DM1
          MPY  D15
          ADA  EQTA      A:=EQT ADDRESS 
          LDB  EQTBF     B:=EQT BUFFER ADDRESS
          JSB  $LIBR     BE SURE EQT ISN'T CHANGED
          NOP              BY HOLDING OFF INTERRUPTS. 
          MVW  D6        MOVE 6 WORDS FROM EQT. 
          LDA  FSTVL     RESOLVE INDIRECT 
          JSB  INDR        ADDRESS. 
          STB  VPNT      SAVE ADDRESS OF STATS. 
          MVW  D11       MOVE STATS.
          JSB  $LIBX     RESTORE
          DEF  *+1         INTERRUPTS.
          DEF  *+1
          JSB  BLINE
          JSB  PRINT     PRINT
          DEF  EHED6      HEADING.
D11       DEC  11 
          LDA  DM6       SET
          STA  LASTI      UP
          LDA  D12         FOR
          STA  LASTJ        6 WORDS.
          JSB  EQOUT
* PRINT LONG TERM STATISTICS
      JSB PRINT     PRINT 
      DEF SHEAD      HEADING. 
      DEC 13
      LDA DM11      SET UP COUNTER
      STA T6         FOR 11 FIELDS. 
      LDA MSGTB     INITIALIZE
      STA MPNT       MESSAGE POINTER. 
* 
LOOPA LDA AW3       SET OUTPUT
      STA OPNTR      POINTER. 
      LDA BLANK     CLEAR 
      JSB FILL       BUFFER.
* 
LOOPB LDA VPNT,I    CONVERT NEXT
      JSB CNVTD      VALUE. 
      DEF OPNTR,I 
      LDA OPNTR     BUMP
      ADA D14        OUTPUT 
      STA OPNTR       POINTER.
      ISZ VPNT      BUMP VALUE POINTER. 
      LDA MPNT,I    GET # OF
      STA T7         CHARACTERS.
      ISZ MPNT
      LDA MPNT      MESSAGE SOURCE ADDR.
      LDB OPNTR     MESSAGE DESTINATION FIELD.
      ADB DM11
      MVW T7        MOVE MESSAGE. 
      ISZ T6        LAST MESSAGE? 
      RSS 
      JMP LPRNT      YES--GO DO LAST PRINT. 
      STA MPNT      POINT TO NEXT MESSAGE.
      LDA OPNTR     IF PRINTLINE
      CPA AW17       NOT FULL,
      JMP LOOPB       MOVE 2ND MESSAGE. 
* 
      JSB PRINT     PRINT 
      DEF BUFR       MESSAGES.
      DEC 30
      JMP LOOPA 
* 
LPRNT JSB PRINT     PRINT 
      DEF BUFR       FINAL
D14   DEC 14          STATISTIC.
*   BLINE;
          JSB  BLINE
*   END OF EQTS;
          JMP  EQTS,I 
      SPC 2 
PBUFR BSS 33        PARSE BUFFER
INEQT EQU PBUFR+5   SECOND PARAMETER
@FNTN DEF FNCTN 
          SPC 2 
* LONG TERM STATS HEADINGS
* 
SHEAD ASC 13, SLC LONG TERM STATISTICS
MSGTB DEF *+1       MESSAGE TABLE 
      DEC 7 
      ASC 7, READ REQUESTS
      DEC 8 
      ASC 8, WRITE REQUESTS 
      DEC 11
      ASC 11, MESSAGES TRANSMITTED
      DEC 11
      ASC 11, ERROR-FREE MSGS RECV
      DEC 6 
      ASC 6, LINE ERRORS
      DEC 7 
      ASC 7, NAKS RECEIVED
      DEC 9 
      ASC 9, BCC/PARITY ERRORS
      DEC 7 
      ASC 7, LONG TIMEOUTS
      DEC 8 
      ASC 8, RESPONSE ERRORS
      DEC 7 
      ASC 7, RESPONSE REJ 
      DEC 9 
      ASC 9, WACK/TTD RECEIVED
      EXT D$XS5 
FSTVL DEF D$XS5+2 
OPNTR NOP 
VPNT  NOP 
MPNT  NOP 
* 
AW17  DEF W17 
      SKP 
      UNL 
      IFN 
      LST 
*  NRV DISPLAY ROUTINE. 
* 
DSNRV NOP           ENTRY.
      LDA #NCNT     GET ADDRESS OF NO. OF NODES.
      STA NCNT      SAVE THE NUMBER OF NODES. 
      CMA,INA,SZA,RSS  ANYTHING SPECIFIED?
      JMP DSNRV,I    NO--IGNORE THE REQUEST!
      STA NONDT     SAVE THE NEGATIVE LOOP COUNT. 
* 
      LDA #NODE     GET LOCAL NODE NUMBER.
      JSB CNVTD     CONVERT IT TO ASCII,
      DEF LOCLN      AND CONFIGURE THE MESSAGE. 
      LDA NONDT     GET THE NUMBER OF NODES.
      JSB CNVTD     CONVERT TO ASCII, 
      DEF NNODS      AND CONFIGURE MESSAGE. 
      JSB PRINT     PRINT THE FIRST MESSAGE.
      DEF NODM1 
      DEC 10
      JSB PRINT 
      DEF NODM2 
      DEC 21
      JSB BLINE 
* 
      LDA #NRV      GET THE NRV ADDRESS,
      STA NPNT        AND SAVE THE POINTER. 
* 
DLOOP LDA NONDT     GET NUMBER OF NODAL PAIRS.
      ADA NCNT      SUBTRACT NUMBER ALREADY REPORTED. 
      INA           FORM A SEQUENCE NUMBER. 
      JSB CNVTD     CONVERT TO ASCII, 
      DEF SEQN       AND CONFIGURE THE MESSAGE. 
* 
      LDA NPNT      GET A NODE NUMBER.
      JSB IXGET 
      ISZ NPNT      ADVANCE THE POINTER.
      JSB CNVTD     CONVERT 
      DEF NODEN      & CONFIGURE. 
* 
      LDA NPNT      GET TIMEOUT/LU. 
      JSB IXGET 
      AND B77       ISOLATE THE LU. 
      JSB CNVTD     CONVERT 
      DEF VECTR      & CONFIGURE. 
* 
      LDA NPNT      GET TIMEOUT/LU, AGAIN.
      JSB IXGET 
      ISZ NPNT      ADVANCE POINTER.
      AND BT137     RETAIN THE TIMEOUT VALUE (BITS#13-7). 
      ALF,ALF       POSITION VALUE
      RAL,RAL        TO THE LOWER BYTE. 
      SZA           IF =0, THEN NO FILLING NEEDED.
      IOR DM256     FILL-IN THE UPPER BYTE. 
      CMA,INA       MAKE THE VALUE POSITIVE (OR 0). 
      MPY D5        MULTIPLY BY FIVE. 
      JSB CNVTD     CONVERT 
      DEF NRVTO      & CONFIGURE. 
* 
      JSB PRINT     PRINT NODAL ADDRESS DATA
      DEF NRVMS      WITHOUT THE HEADER.
      DEC 25
      JSB BLINE 
* 
      ISZ NCNT      ANY MORE TO PROCESS?
      JMP DLOOP      YES, CONTINUE. 
* 
      EXT $OPSY 
      LDA $OPSY     GET THE SYSTEM SPECIFICATION. 
      RAR,RAR 
      SLA           FOR NON-RTE-M SYSTEMS,
      JMP DSNRV,I    THE PROCESS IS COMPLETE. 
* 
      LDA #LNOD     GET THE DOWN-LOAD NODE NUMBER.
      CPA DM1       IF IT HAS NOT BEEN USED,
      JMP PRAPM      THEN IGNORE THE CONVERSION.
      JSB CNVTD     CONVERT TO ASCII, 
      DEF APNOD      AND CONFIGURE THE MESSAGE. 
* 
PRAPM JSB PRINT     PRINT <APLDR> NODE NUMBER (OR "NONE"),
      DEF APMSG      WITHOUT A HEADER.
      DEC 16
      JSB BLINE 
      JMP DSNRV,I   PROCESS COMPLETE--CHECK FOR NEW REQUEST.
      SPC 2 
NODM1 ASC 10, NRV SPECIFICATIONS: 
NODM2 ASC 7, LOCAL NODE#: 
LOCLN ASC 3,
      ASC 8,, NO. OF NODES= 
NNODS ASC 3,
* 
NRVMS EQU * 
SEQN  ASC 3,
      ASC 4,: NODE= 
NODEN ASC 3,
      ASC 3,, LU= 
VECTR ASC 3,
      ASC 3,, TO= 
NRVTO ASC 3,
      ASC 3,(SEC.)
* 
APMSG ASC 13, LAST <APLDR> LOAD-NODE= 
APNOD ASC 3,NONE
* 
BT137 OCT 37700 
DM256 DEC -256
* 
NCNT  NOP           NUMBER OF NODES 
NONDT NOP           NODE COUNTER
NPNT  NOP 
      SKP 
      UNL 
      XIF 
      LST 
*PROCEDURE XEQFN; 
* 
"AV"      ASC  1,AV 
"CL"      ASC  1,CL 
"VA"      ASC  1,VA 
"DU"      ASC  1,DU 
"LI"      ASC  1,LI 
"NR"      ASC  1,NR 
"EQ"      ASC  1,EQ 
"/E"      ASC  1,/E 
"EX"      ASC  1,EX 
FNCTN     ASC  3,        FUNCTION TO BE PERFORMED 
* 
XEQFN     BSS  01 
*   BEGIN 
* 
*   COMMENT 
*   +----------------------+
*   !  EXECUTE A FUNCTION  !
*   +----------------------+; 
* 
*   IF PRMPT THEN 
          LDA  PRMPT
          SSA,RSS 
          JMP  L928 
*      BEGIN  & PROMPT FOR COMMAND
      UNL 
      IFN 
      LST 
          JSB  DEXEC
          DEF  *+6
          DEF  NODE 
      UNL 
      XIF 
      LST 
      UNL 
      IFZ 
      LST 
          JSB  EXEC 
          DEF  *+5
      UNL 
      XIF 
      LST 
          DEF  D2 
          DEF  INLU 
          DEF  BLANK
          DEF  D1 
*      & PRINT THE PROMPT 
      UNL 
      IFN 
      LST 
          JSB  DEXEC
          DEF  *+6
          DEF  NODE 
      UNL 
      XIF 
      LST 
      UNL 
      IFZ 
      LST 
          JSB  EXEC 
          DEF  *+5
      UNL 
      XIF 
      LST 
          DEF  D2 
          DEF  INLU 
          DEF  PROMP
          DEF  D9 
*      END; 
* 
* CLEAR WORDS 2 & 3 OF FNCTN
      LDA BLANK 
      STA FNCTN+1 
      STA FNCTN+2 
*     READ COMMAND FROM INPUT LU
      UNL 
      IFN 
      LST 
L928      JSB  DEXEC
          DEF  *+6
          DEF  NODE 
      UNL 
      XIF 
      LST 
      UNL 
      IFZ 
      LST 
L928      JSB  EXEC 
          DEF  *+5
      UNL 
      XIF 
      LST 
          DEF  SD1       SET NO-ABORT BIT.
          DEF  INLU 
          DEF  FNCTN
          DEF  D3 
          JMP  EX        ERROR: TREAT AS "/E".
* 
*     EXECUTE COMMAND 
*   IF FNCTN="AV" THEN AVMEM
          LDA  FNCTN
          CPA  "AV" 
          RSS 
          JMP  *+3
          JSB  AVMEM
          JMP  L939 
*    ELSE IF FNCTN="CL" THEN CLASS
          CPA  "CL" 
          RSS 
          JMP  *+3
          JSB  CLASS
          JMP  L939 
*    ELSE IF FNCTN="VA" THEN VALUS
          CPA  "VA" 
          RSS 
          JMP  *+3
          JSB  VALUS
          JMP  L939 
*    ELSE IF FNCTN="DU" THEN DUMP 
          CPA  "DU" 
          RSS 
          JMP  *+3
          JSB  DUMP 
          JMP  L939 
*    ELSE IF FNCTN="LI" THEN LISTS
          CPA  "LI" 
          RSS 
          JMP  *+3
          JSB  LISTS
          JMP  L939 
      UNL 
      IFN 
      LST 
* CHECK FOR "NR": 
          CPA  "NR" 
          RSS 
          JMP  *+3
          JSB  DSNRV
          JMP  L939 
      UNL 
      XIF 
      LST 
*    ELSE IF FNCTN="EQ" THEN EQTS 
          CPA  "EQ" 
          RSS 
          JMP  *+3
          JSB  EQTS 
          JMP  L939 
*    ELSE IF FNCTN="/E" OR FNCTN="EX" THEN MOREC:=FALSE 
          CPA  "/E" 
          JMP  EX 
          CPA  "EX" 
          RSS 
          JMP  BADF 
EX        CLA 
          STA  MOREC
          JMP  L939 
*    ELSE LFUNS;
BADF      JSB  LFUNS
*   END OF XEQFN; 
L939      JMP  XEQFN,I
      SPC 6 
B206      OCT  206
B400      OCT  400
B401      OCT  401
DM640     DEC  -640 
DM11      DEC  -11
D16       DEC  16 
D64       DEC  64 
D640      DEC  640
SD1       DEF  1,I
@EXCW     DBL  EXECW
EXECW     ASC  3,EXECW
@NAME     NOP 
PROMP     ASC  9,/DSINF: FUNCTION?_ 
RUNL      ASC 13, /DSINF: RUN LSTEN FIRST!
FINIS     ASC 11, *** END OF DSINF ***
@RUNL     DBL  RUNL+1 
@PRMP     DBR  PROMP
@FINS     DBL  FINIS+6
SUB       BSS  1      INPUT LU'S SUBCHANNEL 
DVR       BSS  1      INPUT LU'S DRIVER TYPE
MOREC     BSS  1      MORE COMMANDS TO READ?
PRMPT     BSS  1      PROMPT FOR COMMANDS?
          SKP 
*+-----------------------------+
*!  BEGINNING OF MAIN PROGRAM  !
*+-----------------------------+; 
          SPC  1
* PICK UP RUN-TIME PARAMETERS 
*RMPAR(INLU); 
DSINF     JSB  RMPAR
          DEF  *+2
          DEF  INLU 
*& SET FLAGS
*PRMPT := SAMIN := FALSE; 
          CLA 
          STA  SAMIN
          STA  PRMPT
* 
      UNL 
      IFN 
      LST 
*   DETERMINE THE NODE NUMBER:
          LDA  NODE      IF NODE
          SZA             NOT 0,
          JMP  OK            USE IT.
          LDB  FLAG      CHECK
          SZB             NODE 0
          JMP  OK          FLAG.
*   WE HAVE BEEN SCHEDULED WITH BOTH FLAG AND NODE SET TO 0.
*   IF OUR FATHER IS "EXECW", USE #CNOD AS THE NODE NUMBER. 
          LDB  XEQT      GET
          ADB  D20        FATHER'S
          LDA  B,I         ID SEGMENT 
          AND  B377         NUMBER. 
          SZA,RSS        IF ZERO, 
          JMP  LOCAL       WE ARE LOCAL.
          ADA  DM1
          ADA  KEYWD     GET ADDR OF FATHER'S 
          LDB  A,I         ID SEGMENT.
          ADB  D12       WHAT'S 
          CLE,ELB         HIS NAME? 
          LDA  @EXCW       EXECW? 
          CBT  D5 
          JMP  NTLOC     YES--NOT LOCAL 
          NOP 
LOCAL     CCA            NODE:=-1 
          RSS 
NTLOC     LDA  #CNOD     NODE:=#CNOD
          STA  NODE 
OK        EQU  *
      UNL 
      XIF 
      LST 
          SPC  1
* GET TRUE PROGRAM NAME (USUALLY WILL BE DSINF).
          LDA  XEQT      GET ID SEG ADDR. 
          ADA  D12
          CLE,ELA 
          STA  @NAME     MOVE FOR 
          LDB  @RUNL      "RUN LSTEN" MESSAGE.
          MBT  D5 
          LDA  @NAME     MOVE FOR 
          LDB  @FINS      FINAL MESSAGE.
          MBT  D5 
          LDA  @NAME     MOVE FOR 
          LDB  @PRMP      PROMPT. 
          MBT  D5 
* 
*IF INLU<1 OR INLU>IGET(LUMAX) THEN 
          CCA 
          ADA  INLU 
          SSA 
          JMP  L963 
          LDA  LUMAX
          CMA 
          ADA  INLU 
          SSA 
          JMP  L968 
*   BEGIN 
*   INLU := @401;  & DEFAULT INPUT LU IS SYS CONSOLE
L963      LDA  B401 
          STA  INLU 
*   PRMPT := TRUE;  & INTERACTIVE DEVICE
          CCA 
          STA  PRMPT
*   END 
* ELSE
          JMP  L977 
*   BEGIN  & GET LU INFORMATION 
      UNL 
      IFN 
      LST 
*   DEXEC(NODE,13,INLU,DVR,T7,SUB); 
L968      JSB  DEXEC
          DEF  *+7
          DEF  NODE 
      UNL 
      XIF 
      LST 
      UNL 
      IFZ 
      LST 
*   EXEC(13,INLU,DVR,T7,SUB); 
L968      JSB  EXEC 
          DEF  *+6
      UNL 
      XIF 
      LST 
          DEF  D13
          DEF  INLU 
          DEF  DVR
          DEF  T7 
          DEF  SUB
*   SUB := SUB AND @17; 
          LDA  SUB
          AND  B17
          STA  SUB
*   DVR := ROTATE DVR AND @77;
          LDA  DVR
          ALF,ALF 
          AND  B77
          STA  DVR
*   PRMPT := (DVR=00) OR (DVR=07 OR DVR=05 AND SUB=0);
          CCB 
          SZA,RSS 
          JMP  TRU
          CPA  D7 
          JMP  SUBCK
          CPA  D5 
          JMP  SUBCK
          JMP  FLS
SUBCK     LDA  SUB
          SZA 
FLS       CMB 
TRU       STB  PRMPT
*   IF PRMPT THEN 
          SSB,RSS 
          JMP  L977 
*      INLU:=INLU OR @400; & SET "K" BIT FOR INTERACTIVE INPUT
          LDA  INLU 
          IOR  B400 
          STA  INLU 
*   END;
* CHECK OUTPUT LU DEVICE
*IF OUTLU<1 OR OUTLU>IGET(LUMAX) THEN 
L977      CCA 
          ADA  OUTLU
          SSA 
          JMP  L978 
          LDA  LUMAX
          CMA 
          ADA  OUTLU
          SSA 
          JMP  L984 
*   OUTLU := IF PRMPT THEN INLU ELSE @206;
L978      LDB  INLU 
          LDA  PRMPT
          SSA,RSS 
          LDB  B206 
          STB  OUTLU
* 
* FIND # OF PROGRAM ID SEGMENTS IN SYSTEM 
*KYWRD := IGET(KEYWD) - 1;
L984      CCA 
          ADA  KEYWD
          STA  KYWRD
*I := 1;
          CLA,INA 
          STA  I
*WHILE IGET(KYWRD+I)#0 DO 
L986      LDA  KYWRD
          ADA  I
          LDA  A,I
          SZA,RSS 
*    I := I + 1;
          JMP  L988 
          LDA  I
          INA 
          STA  I
          JMP  L986 
*MAXID := I - 1;
L988      CCA 
          ADA  I
          STA  MAXID
* 
*SSIZE := (IF TST#0 THEN (TST+14*TSTSZ) ELSE NRV) - FWAM; 
          LDA  #TST 
          SZA,RSS 
          JMP  L995 
          LDA  D14
          CLB 
          MPY  #TST+1 
          ADA  #TST 
          RSS 
L995      LDA  #NRV 
          CMA 
          ADA  #FWAM
          CMA 
          STA  SSIZE
*IF SSIZE>640 THEN
          ADA  DM640
          SZA 
          SSA 
          JMP  L1001
*   & DON'T OVERRUN SAM ARRAY 
*   SSIZE := 640; 
          LDA  D640 
          STA  SSIZE
* 
* CHECK TO SEE IF LSTEN HAS BEEN RUN
*IF FWAM=0 THEN 
L1001     LDA  #FWAM
          SZA 
          JMP  L1007
* 
          JSB  PRINT
          DEF  RUNL 
          DEC  13 
* ELSE
          JMP  L1037
* 
* 
* CHECK FOR NON-INTERACTIVE RUN 
*IF CONWD # 0 THEN
L1007     LDA  CONWD
          SZA,RSS 
          JMP  L1033
*   BEGIN 
*   INTEGER TMSC,SEC,MIN,HOUR;
          JMP  L1014
TMSC      BSS  01 
SEC       BSS  01 
MIN       BSS  01 
HOUR      BSS  01 
          BSS  1
TIME      ASC  9, TIME---  :   :
*   PRMPT := FALSE; 
L1014     CLA 
          STA  PRMPT
*   EXEC(11,TMSC);
          JSB  EXEC 
          DEF  *+3
          DEF  D11
          DEF  TMSC 
*   TIME[8] := KCVT(SEC); 
          LDA  SEC
          JSB  KCVT 
          STA  TIME+8 
*   TIME[6] := KCVT(MIN); 
          LDA  MIN
          JSB  KCVT 
          STA  TIME+6 
*   TIME[4] := KCVT(HOUR);
          LDA  HOUR 
          JSB  KCVT 
          STA  TIME+4 
          JSB  BLINE
* 
          JSB  PRINT
          DEF  TIME 
          DEC  9
      UNL 
      IFN 
      LST 
*   PRINT LOCAL NODE NUMBER 
          LDA  #NODE
          JSB  CNVTD
          DEF  LOCLN
          JSB  PRINT
          DEF  NODM2
          DEC  10 
      UNL 
      XIF 
      LST 
*   BLINE;
          JSB  BLINE
*   IF (CONWD AND  1)#0 THEN AVMEM; 
          LDA  CONWD
          AND  D1 
          SZA 
          JSB  AVMEM
*   IF (CONWD AND  2)#0 THEN CLASS; 
          LDA  CONWD
          AND  D2 
          SZA 
          JSB  CLASS
*   IF (CONWD AND  4)#0 THEN VALUS; 
          LDA  CONWD
          AND  D4 
          SZA 
          JSB  VALUS
*   IF (CONWD AND  8)#0 THEN DUMP;
          LDA  CONWD
          AND  D8 
          SZA 
          JSB  DUMP 
*   IF (CONWD AND 16)#0 THEN LISTS; 
          LDA  CONWD
          AND  D16
          SZA 
          JSB  LISTS
      UNL 
      IFN 
      LST 
*   IF (CONWD AND 32)#0 THEN DSNRV; 
          LDA  CONWD
          AND  D32
          SZA 
          JSB  DSNRV
      UNL 
      XIF 
      LST 
*   IF (CONWD AND 64)#0 THEN EQTS;
          LDA  CONWD
          AND  D64
          SZA 
          JSB  EQTS 
*   END 
* 
*ELSE 
          JMP  L1037
*   SET PROGRAM NAME IN FUN1 AND FUN10
L1033     LDA  @NAME
          LDB  @FUN1
          MBT  D5 
*   MOREC := TRUE;
          CCA 
          STA  MOREC
          LDA  @NAME
          LDB  @FN10
          MBT  D5 
*   WHILE MOREC DO
L1034     LDA  MOREC
          SSA,RSS 
*      XEQFN; 
          JMP  L1037
          JSB  XEQFN
          JMP  L1034
* 
L1037     JSB  PRINT
          DEF  FINIS
          DEC  11 
* 
* DSINF REUSES PARAMETERS IF IN TIME LIST 
*   EXEC(6,0,0,INLU,OUTLU,CONWD); 
          JSB  EXEC 
          DEF  *+9
          DEF  D6 
          DEF  D0 
          DEF  D0 
          DEF  INLU 
          DEF  OUTLU
          DEF  CONWD
          DEF  NODE 
          DEF  FLAG 
D0        DEC  0
*END$ 
          END  DSINF
      