ASMB,R,L,C
      HED DLIST 91740-16011 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 
      NAM DLIST,19,30 91740-16011 REV 1740 770404 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 
******************************************************* 
* 
*DLIST              DIRECTORY LIST MONITOR FOR DS-1000
*                   CTU-BASED SYSTEMS.
* 
*SOURCE PART #      91740-16011 REV 1740
* 
*REL PART #         91740-16011 REV 1740
* 
*WRITTEN BY:        DAN GIBBONS 
* 
*DATE WRITTEN:      JANUARY 1977
* 
*MODIFIED BY: 
* 
********************************************************
      SPC 2 
* 
*     PROGRAM TO DO DIRECTORY LISTING ON AS 
*     MANY REMOTE TERMINALS AS REQUIRED 
* 
* 
      ENT DLIST 
* 
      EXT EXEC,D65SV,D65GT,#NODE
      EXT .DRCT,$CDIR 
      IFZ 
      EXT DBUG
      XIF 
* 
* 
A     EQU 0 
B     EQU 1 
      HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1977
* 
*     MAIN ROUTINE STARTS HERE
* 
DLIST NOP 
      LDA B,I       SEE IF THEY WANT DEBUG
      STA CLSSN     SAVE  CLASS NUMBER
      IFZ 
      SZA           DO THEY WANT DEBUG
      JMP DLST0     NO
      JSB DBUG
      DEF *+1 
      JSB EXEC
      DEF *+4 
      DEF D6
      DEF D0
      DEF D1
      JMP DLIST 
      XIF 
      SPC 1 
DLST0 JSB D65GT     DO A GET CALL 
      DEF *+6 
      DEF CLSSN 
      DEF IRBUF 
      DEF D23 
      DEF D0        NO DATA 
      DEF D0
      JMP DLST0     IGNORE ERROR CALL 
* 
      LDA 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 LUDSP     SAVE FOR LU LOOPING 
      ADA M1        GET TO LAST TRACK 
      LDA A,I       GET LAST-ENTRY ADR
      STA ENDCD     SAVE IT 
SUB2  LDA LUDSP     GET DIRECTORY POINTER 
      CPA ENDCD     DONE? 
      JMP DONE      YES 
      LDA A,I       GET CARTRIDGE LU
      SZA,RSS       DONE? 
      JMP DONE      YES 
SUB22 LDA CTULU     DO THEY WANT A SPECIFIED LU?
      CPA DBLNK     LU SUPPLIED?
      JMP MCR       NO, DO ALL LU'S 
      LDB 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 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 BROUT 
* 
      LDA LUDSP,I   CONVERT LU TO TWO 
      JSB BNDEC       ASCII DIGITS & SET
      DEF LUXX          INTO HEAD1 MSG. 
* 
      ISZ LUDSP     GET TO VALIDITY WORD ADR
      LDA LUDSP,I   GET THE ADR 
      LDA A,I       GET THE VALIDITY WORD 
      STA 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 LUDSP     GET TO FILE DIRECTORY ADR 
      LDA LUDSP,I   GET THE ADR 
      STA DISP      SAVE THE ADR
      ADA M1        GET TO LAST-ENTRY ADR 
      LDA A,I       GET THE ADR 
      STA ENDFD     SAVE IT 
      ISZ LUDSP     GET TO NEXT CTU 
      ISZ 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 VAL 
      SZA           DIRECTORY VALID?
      JMP SUB6      NO, GET NEXT ONE
      LDA SUB4A     SET ADDRESS FOR NEXT TIME 
      STA BROUT 
      JSB WTLIN     SEND OUT BLANK LINE 
      DEF BLNKL 
      SPC 5 
* 
*     HERE TO START OUTPUTTING DIRECTORY
* 
SUB4  LDA DISP      GET FILE ENTRY ADR
      CPA 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 DISP      MOVE THE
      LDB ADNAM      DETAIL LINE
      MVW D4          TO PRINT LINE.
      LDA DISP      GET TO NEXT ENTRY 
      ADA D4
      STA DISP
      JSB WTLIN     GO WRITE THE LINE 
      DEF DLINA     ADDRESS OF DETAIL LINE
NXT   LDA DISP      GET TO NEXT ENTRY 
      ADA D4
      STA DISP
      JMP SUB4+1
      SPC 5 
* 
*     HERE TO OUTPUT A BLANK LINE 
* 
SUB6  LDA SUB7A     GET ADDRESS FOR NEXT TIME 
      STA 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 BROUT 
      JSB WTLIN     OUTPUT A BLANK LINE 
      DEF BLNKL 
      HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1977
* 
*     HERE WHEN WE ARE ALL DONE 
* 
DONE  LDA BROUT     SEE IF WE SENT THEM ANYTHING
      SZA 
      JMP DONE1     YES...JUST TERMINATE
      LDA DON1A     GET ADDRESS OF TERMINATION POINT
      STA BROUT 
      JSB WTLIN     SEND "CTU NOT MOUNTED"
      DEF NOCRM 
* 
DONE1 CLA 
      STA 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 LNGH      GET AVAILABLE LENGTH
      CMA,INA 
      ADA B         SEE IF THERE WAS TO MUCH ROOM 
      SSA           CHANGE LENGTH?
      STB LNGH      YES...SET IN CORRECT LENGTH 
* 
      CLA           SET FOR MORE TO COME
TERM  STA STAT      SAVE STATUS 
      LDA STYP      GET STREAM TYPE 
      IOR BIT14     SET FOR REPLY 
      STA STYP
      LDA #NODE 
      STA IRBUF+6   SET STATUS LOCATION 
* 
      JSB D65SV     SEND REPLY
      DEF *+5 
      DEF IRBUF 
      DEF D23       REPLY LENGTH
WTLNB NOP           DATA ADDRESS
      DEF 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 
* 
*     REQST/REPLY BUFR LAYOUT 
* 
IRBUF BSS 23
STYP  EQU IRBUF     STREAM TYPE 
STAT  EQU IRBUF+7   STATUS
LNGH  EQU IRBUF+8   LENGTH WORD 
BROUT EQU IRBUF+9   ADR OF NEXT PROCESS ROUTINE. 0=START
CTULU EQU IRBUF+10  CARTRIDGE TAPE UNIT LU #
ENDCD EQU IRBUF+16  END-OF-CARTRIDGE-DIRECTORY ADR
ENDFD EQU IRBUF+17  END-OF-FILE-DIRECTORY ADR 
VAL   EQU IRBUF+18  DIRECTORY-VALID FLAG. 0=VALID 
DISP  EQU IRBUF+19  DISPLACEMENT IN BUFFER
LUDSP EQU IRBUF+21  DISPLACEMENT IN DIRECTORY LU
D23   DEC 23
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 
                                                                                                                                                                                            