ASMB,C,Q
      HED DLIST 91750-16070 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM DLIST,19,30 91750-16070 REV 2013 800425 M CTU 
      SPC 1 
******************************************************************
*  * (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.       *
******************************************************************
      SPC 2 
******************************************************* 
* 
*     DIRECTORY LIST MONITOR FOR RTE-M CTU-BASED SYSTEMS
* 
*     NAME:         DLIST 
*     SOURCE:       91750-18070 
*     RELOC:        91750-16070 
*     PGMR:         DAN GIBBONS 
* 
********************************************************
      SPC 2 
* 
*     PROGRAM TO DO DIRECTORY LISTING ON AS 
*     MANY REMOTE TERMINALS AS REQUIRED 
* 
* 
      ENT DLIST 
* 
      EXT EXEC,#SLAV,#GET,#NODE 
      EXT .MVW
      EXT .DRCT,$CDIR 
      EXT #RPB
RQB   EQU #RPB
* 
* 
      SUP 
A     EQU 0 
B     EQU 1 
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV XXXX 790531      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  LSTEN, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*                                                                *
******************************************************************
* 
***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!***
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
* 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* GLBLK-END 
      SPC 3 
* 
* OFFSETS INTO DLIST REQUEST/REPLY BUFFER 
* 
STYP  EQU #STR         STREAM TYPE
STAT  EQU #REP         STATUS 
LNGH  EQU #REQ+1       LENGTH WORD
BROUT EQU #REQ+2       ADR OF NEXT PROCESS ROUTINE. 0=START 
CTULU EQU #REQ+7       CARTRIDGE TAPE UNIT LU # 
ENDCD EQU #REP+9       END-OF-CARTRIDGE-DIRECTORY ADR 
ENDFD EQU #REP+10      END-OF-FILE-DIRECTORY ADR
VAL   EQU #REP+11      DIRECTORY-VALID FLAG. 0=VALID
DISP  EQU #REP+12      DISPLACEMENT IN BUFFER 
LUDSP EQU #REP+14      DISPLACEMENT IN DIRECTORY LU 
* 
* 
L#REQ ABS #REQ+16      REQUEST LENGTH 
L#REP EQU L#REQ        REPLY LENGTH 
      HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1980
* 
*     MAIN ROUTINE STARTS HERE
* 
DLIST NOP 
      LDA B,I       SEE IF THEY WANT DEBUG
      STA CLSSN     SAVE  CLASS NUMBER
      SPC 1 
DLST0 JSB #GET      DO A GET CALL 
      DEF *+6 
      DEF CLSSN 
      DEF RQB 
      DEF L#REQ 
      DEF D0        NO DATA 
      DEF D0
      JMP DLST0     IGNORE ERROR CALL 
* 
      LDA RQB+BROUT  GET ADDRESS OF CURRENT COROUTINE 
      SZA,RSS 
      JMP SUB1
      JMP A,I       GO TO SPECIFIED SUBROUTINE
      SPC 2 
SUB2A DEF SUB2
SUB4A DEF SUB4
SUB5A DEF SUB5
SUB7A DEF SUB7
DON1A DEF DONE1 
      SPC 5 
* 
*     HERE ON NEW REQUEST 
* 
SUB1  JSB .DRCT     GET ADR OF CTU DIRECTORY
      DEF $CDIR 
      STA RQB+LUDSP  SAVE FOR LU LOOPING
      ADA M1        GET TO LAST TRACK 
      LDA A,I       GET LAST-ENTRY ADR
      STA RQB+ENDCD  SAVE IT
SUB2  LDA RQB+LUDSP  GET DIRECTORY POINTER
      CPA RQB+ENDCD  DONE?
      JMP DONE      YES 
      LDA A,I       GET CARTRIDGE LU
      SZA,RSS       DONE? 
      JMP DONE      YES 
SUB22 LDA RQB+CTULU  DO THEY WANT A SPECIFIED LU? 
      CPA DBLNK     LU SUPPLIED?
      JMP MCR       NO, DO ALL LU'S 
      LDB RQB+LUDSP  GET DISPLACEMENT 
      SSA           IF NEG, MAKE POS
      CMA,INA 
      CPA B,I       DOES LU MATCH?
      JMP MCR       MATCH...PROCESS LU
      ADB D4        NO MATCH. GO TO NEXT ENTRY
      STB RQB+LUDSP 
      JMP SUB2
      SPC 5 
* 
*     ROUTINE TO PROCESS A MOUNTED CARTRIDGE
* 
      SPC 1 
MCR   LDA SUB5A     SET UP FOR RETURN AFTER SENDING THE LINE
      STA RQB+BROUT 
* 
      LDA LUDSP,I   CONVERT LU TO TWO 
      JSB BNDEC       ASCII DIGITS & SET
      DEF LUXX          INTO HEAD1 MSG. 
* 
      ISZ RQB+LUDSP  GET TO VALIDITY WORD ADR 
      LDA LUDSP,I   GET THE ADR 
      LDA A,I       GET THE VALIDITY WORD 
      STA RQB+VAL   SAVE IT 
      LDB LHED1     GET HEAD1 MESSAGE LENGTH
      SZA           IS DIRECTORY VALID? 
      LDB LHED2     NO, ADJUST LENGTH OF MESSAGE
      STB HEAD1     SET MESSAGE LENGTH
      ISZ RQB+LUDSP  GET TO FILE DIRECTORY ADR
      LDA LUDSP,I   GET THE ADR 
      STA RQB+DISP  SAVE THE ADR
      ADA M1        GET TO LAST-ENTRY ADR 
      LDA A,I       GET THE ADR 
      STA RQB+ENDFD  SAVE IT
      ISZ RQB+LUDSP  GET TO NEXT CTU
      ISZ RQB+LUDSP   DIRECTORY ENTRY.
      JSB WTLIN     SEND LINE BACK TO REMOTE
      DEF HEAD1     HEADING LINE ADR
      SPC 5 
* 
*     HERE AFTER HEADING LINE WRITTEN 
*     JUST OUTPUT A BLANK LINE IF DIRECTORY VALID.
* 
SUB5  LDA RQB+VAL 
      SZA           DIRECTORY VALID?
      JMP SUB6      NO, GET NEXT ONE
      LDA SUB4A     SET ADDRESS FOR NEXT TIME 
      STA RQB+BROUT 
      JSB WTLIN     SEND OUT BLANK LINE 
      DEF BLNKL 
      SPC 5 
* 
*     HERE TO START OUTPUTTING DIRECTORY
* 
SUB4  LDA RQB+DISP  GET FILE ENTRY ADR
      CPA RQB+ENDFD  END OF DIRECTORY?
      JMP SUB6      YES 
      LDA A,I       GET ENTRY 
      SSA           IS THE FILE PURGED? 
      JMP NXT       YES...GO TO NEXT ONE
      SZA,RSS       DONE? 
      JMP SUB6      YES...2 SPACES & GET NEXT LU
      LDA RQB+DISP  MOVE THE
      LDB ADNAM      DETAIL LINE
      JSB .MVW        TO PRINT LINE.
      DEF D4
      NOP 
      LDA RQB+DISP  GET TO NEXT ENTRY 
      ADA D4
      STA RQB+DISP
      JSB WTLIN     GO WRITE THE LINE 
      DEF DLINA     ADDRESS OF DETAIL LINE
NXT   LDA RQB+DISP  GET TO NEXT ENTRY 
      ADA D4
      STA RQB+DISP
      JMP SUB4+1
      SPC 5 
* 
*     HERE TO OUTPUT A BLANK LINE 
* 
SUB6  LDA SUB7A     GET ADDRESS FOR NEXT TIME 
      STA RQB+BROUT 
      JSB WTLIN     OUTPUT A BLANK LINE 
      DEF BLNKL 
      SPC 5 
* 
*     HERE TO OUTPUT A BLANK LINE 
* 
SUB7  LDA SUB2A     GET ADDRESS FOR NEXT TIME 
      STA RQB+BROUT 
      JSB WTLIN     OUTPUT A BLANK LINE 
      DEF BLNKL 
      HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980
* 
*     HERE WHEN WE ARE ALL DONE 
* 
DONE  LDA RQB+BROUT  SEE IF WE SENT THEM ANYTHING 
      SZA 
      JMP DONE1     YES...JUST TERMINATE
      LDA DON1A     GET ADDRESS OF TERMINATION POINT
      STA RQB+BROUT 
      JSB WTLIN     SEND "CTU NOT MOUNTED"
      DEF NOCRM 
* 
DONE1 CLA 
      STA RQB+LNGH  SET FOR NO DATA 
      LDA BIT14     TELL OTHER SIDE, ALL DONE 
      JMP TERM
      SPC 5 
* 
*     SUBROUTINE TO SEND DATA TO  REMOTE
*     CALLING SEQUENCE
*     JSB WTLIN 
*     DEF BUFFER
*     BUFFER FORMAT 
*     LENGTH WORD, DATA BUFFER
* 
WTLIN NOP 
      LDA WTLIN,I   GET ADDRESS OF OUPUT LINE 
      INA           GET TO FIRST DATA WORD
      STA WTLNB 
      LDB WTLIN,I   GET LENGTH OF MESSAGE 
      LDB B,I 
      LDA RQB+LNGH  GET AVAILABLE LENGTH
      CMA,INA 
      ADA B         SEE IF THERE WAS TO MUCH ROOM 
      SSA           CHANGE LENGTH?
      STB RQB+LNGH  YES...SET IN CORRECT LENGTH 
* 
      CLA           SET FOR MORE TO COME
TERM  STA RQB+STAT  SAVE STATUS 
      LDA RQB+STYP  GET STREAM TYPE 
      IOR BIT14     SET FOR REPLY 
      STA RQB+STYP
      LDA #NODE 
      STA RQB+#ENO  SET STATUS LOCATION 
* 
      JSB #SLAV     SEND REPLY
      DEF *+4 
      DEF L#REQ     REPLY LENGTH
WTLNB NOP           DATA ADDRESS
      DEF RQB+LNGH  DATA LENGTH 
* 
      NOP           IGNORE ERROR RETURN 
      JMP DLST0     GO DO A GET CALL
* 
      SPC 5 
* 
*     SUBROUTINE TO CONVERT BINARY # TO 2 ASCII DECIMAL DIGITS
* 
*     CALLING SEQUENCE: 
* 
*     JSB BNDEC 
*     DEF BUFFER WHERE TO STORE ASCII DIGITS
*     A REG=BINARY #
* 
BNDEC NOP 
      STA DTEMP     SAVE BINARY # 
      LDB BNDEC,I   GET ADDRESS WHERE TO ASC
      CLE,ELB       CONVERT TO BYTE ADDRESS 
      STB DTMP1     SAVE BYTE ADDRESS 
      ISZ BNDEC     GET TO RETURN ADDRESS 
      LDA DNMA      GET ADDRESS OF DIVISORS 
      STA DTMP2     SAVE FOR DIVIDING 
      LDA M2        GET LOOP COUNT
      STA DTMP3     SAVE IN DOWN COUNTER
BNDCA LDA DTEMP     GET BINARY #
      CLB           GET A ZERO
      DIV DTMP2,I 
      STB DTEMP     SAVE REMAINDER
      ADA C60       CONVERT TO ASC
      LDB DTMP1     GET CURRENT BYTE ADDRESS
      JSB SBYTE     SAVE ASC BYTE 
      ISZ DTMP2     GET NEXT DIVISOR
      ISZ DTMP1     GET NEXT BYTE ADDRESS 
      ISZ DTMP3     DONE? 
      JMP BNDCA     NO
      JMP BNDEC,I   RETURN
      SPC 1 
DTEMP NOP 
DTMP1 NOP 
DTMP2 NOP 
DTMP3 NOP 
DNMA  DEF DNM 
M2    DEC -2
C60   OCT 60
DNM   DEC 10,1
      SPC 3 
* 
*     SUBROUTINE TO STORE A BYTE
*     CALLING SEQUENCE
*     JSB SYBTE 
*     A REG CONTAINS THE BYTE 
*     B REG CONTAINS THE BYTE ADDRESS 
* 
SBYTE NOP 
      AND B377      MASK ALL BUT LOWER 8 BITS 
      STA STEMP     SAVE IN TEMP LOCATION 
      CLE,ERB       CONVERT TO WORD ADDRESS 
      LDA B,I       GET WORD
      SEZ,RSS       RIGHT OR LEFT HALF? 
      ALF,ALF       LEFT
      AND UB377     ISOLATE UPPER 8 BITS
      IOR STEMP     OR IN NEW HALF
      SEZ,RSS       LEFT OR RIGHT?
      ALF,ALF       LEFT
      STA B,I       SAVE WORD 
      ELB,CLE       GET BYTE ADDRESS AGAIN
      JMP SBYTE,I   RETURN
      SPC 1 
STEMP NOP 
B377  OCT 377 
UB377 OCT 177400
      SPC 5 
D4    DEC 4 
D1    DEC 1 
D6    DEC 6 
D0    DEC 0 
D2    DEC 2 
M1    DEC -1
BIT14 OCT 40000 
* 
CLSSN NOP 
ADNAM DEF DNAMA 
LHED1 ABS ENDM1-SPACA 
LHED2 ABS ENDM2-SPACA 
      SPC 1 
* 
*     DEFINE OUTPUT LINE INFO 
* 
HEAD1 BSS 1         HOLDS MESSAGE LENGTH
SPACA ASC 2,
      ASC 9,REMOTE DLIST   LU 
LUXX  BSS 1 
      ASC 5, DIRECTORY
ENDM1 EQU * 
      ASC 4, INVALID
ENDM2 EQU * 
NOCRM DEC 8 
      ASC 8, CTU NOT MOUNTED
DLINA DEC 7 
      ASC 3,
DNAMA ASC 4,
      SPC 2 
BLNKL DEC 1 
DBLNK OCT 20040 
      SPC 3 
END   EQU * 
      END DLIST 
      