ASMB,R,L,C
      HED DLIST  91700-16106 REV A * (C) HEWLETT-PACKARD CO. 1976 
      NAM DLIST,2,30 91700-16106 REV A 760212 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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 PROGRAM FOR DS1/B
* 
*SOURCE PART #      91700-18106 REV A 
* 
*REL PART #         91700-16106 REV A 
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      9-18-74 
* 
*MODIFIED BY:       JEAN-PIERRE BAUDOUIN
* 
*DATE MODIFIED:     DECEMBER 1975 
* 
********************************************************
      SPC 2 
* 
*     PROGRAM TO DO DIRECTORY LISTING ON AS 
*     MANY REMOTE TERMINALS AS REQUIRED 
* 
      SPC 3 
* 
*     DEFINE ENTRY POINTS 
* 
      ENT DLIST 
      SPC 3 
* 
*     DEFINE EXTERNALS
* 
      EXT EXEC,D65SV,D65CL
      IFZ 
      EXT DBUG
      XIF 
      SPC 2 
* 
*     DEFINE A AND B REG
* 
A     EQU 0 
B     EQU 1 
      SUP 
      SKP 
* 
*     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 EXEC      DO A GET CALL 
      DEF *+5 
      DEF D21 
      DEF CLSSN 
      DEF STYP
      DEF D35 
      LDA RLU 
      AND MSK1      KEEP ONLY THE LOWER BITS OF THE COMM. LU
      STA RLU 
      LDA BROUT     GET ADDRESS OF CURRENT COROUTINE
      SZA,RSS 
      JMP SUB1
      JMP A,I       GO TO SPECIFIED SUBROUTINE
      SPC 2 
SUB2A DEF SUB2
SUB3A DEF SUB3
SUB4A DEF SUB4
SUB5A DEF SUB5
SUB6A DEF SUB6
SUB7A DEF SUB7
DON1A DEF DONE1 
      SKP 
* 
*     HERE ON NEW REQUEST 
* 
SUB1  LDA DBFA      GET AD OF WHERE DIR DATA INFO STORED INFO 
      STA LUDSP     SAVE FOR LU LOOPING 
SUB2  LDA D2        GET ADDRESS OF SYSTEM DISK
      STA WCLU      SAVE AS WANTED LU 
      LDA TATSD     GET # OF TRACK IN SYSTEM DISK 
      ADA M1        GET TO LAST TRACK 
      STA WTRCK     SAVE IN WANT TRACK
      CLB           SET FOR SECTOR ZERO 
      STB WSEC      SET WANT SECTOR TO ZERO 
      LDA D128      READ 128 WORDS
      JSB GETSC     GET THE SECTOR
      LDA LUDSP,I   GET LU OF CARTRIDGE 
      SZA,RSS       DONE? 
      JMP DONE      YES 
      LDA BROUT     SEE IF FIRST TIME 
      SZA 
      JMP SUB22     NOT FIRST TIME
      LDB MCODF     SEE IF THEY SUPPLIED A MASTER 
      CLE,SZB,RSS 
      JMP SUB21 
      CMB,INB       CODE, AND IF THEY DID, DOES 
      ADB MSCA,I    IT MATCH
      CLE,SZB,RSS   IF MATCH,SET E REG
      CCE           MATCH ON SECURITY CODE...SET E REG
      LDA MCODF     SEE IF SECURITY CODE PRESENT
      LDB MSCA,I    GET ACTUAL VALUE
      SZB,RSS       IF MASTER SECURITY CODE...DON'T CHECK 
      SZA,RSS       DID THEY SUPPLY ONE, WHEN THERE WASN'T ONE? 
      RSS           NO...ONE NOT SUPPLIED 
      CCE           ONE SUPPLIED...SET TO ALLOW 
      CLA           SET FLAG
SUB21 ELA 
      STA MCODF     SAVE MASTER SECURITY CODE MATCH 
SUB22 LDA CRLU      DO THEY WANT A SPECIFIED LU?
      SZA,RSS       LU SUPPLIED?
      JMP MCR       NO
      LDB LUDSP     GET DISPLACEMENT
      CMA,INA       ASSUME LU 
      SSA,RSS       IS IT LABEL?
      JMP SUB23     NO...LU 
      CMA,INA       YES...LABEL...MAKE POS AGAIN
      ADB D2        AND GET TO LABEL WORD 
SUB23 CPA B,I       IS LABEL OR LU MATCH? 
      JMP MCR       MATCH...PROCESS LU
      LDA LUDSP     NO MATCH GO TO NEXT ONE 
      ADA D4
      STA LUDSP 
      JMP SUB2
      SKP 
* 
*     ROUTINE TO PROCESS A MOUNTED CARTRIDGE
* 
      SPC 1 
MCR   LDA SUB5A     SET UP FOR RETURN AFTER SENDING THE LINE
      STA BROUT 
      LDA SECT2     GET # OF SECTORS IN TRACK 
      STA SCTRK     SAVE IN SECTORS/TRACK 
      LDA LUDSP,I   GET LU OF DISK
      STA WCLU      SAVE AS WANTED CURRENT LU 
      ISZ LUDSP     GET TO FIRST DIRECTORY TRACK
      LDB LUDSP,I   GET DIRECTORY TRACK ADDRESS 
      STB WTRCK     SAVE TRACK ADDRESS
      ISZ LUDSP     GET TO LOCK WORD
      ISZ LUDSP 
      LDB LUDSP,I   GET LOCK WORD 
      ISZ LUDSP     GET TO NEXT ENTRY 
      SZB           IS LU LOCKED
      JMP SUB2      YES 
      CLB           ASSUME NOT LU 2 
      CPA D2        IS IT SYSTEM DISC?
      LDB D14       YES 
      STB WSEC      SAVE STARTING SECTOR ADDRESS
      LDA DBFA      SET FOR ZERO DISPLACEMENT WITHIN BUFFER 
      JSB SCFX      GO GET SECTOR 
      JMP SUB2      NO DIRECTORY? 
      LDA DISP      GET NAME OF CART. 
      JSB NMOVE     MOVE CR NAME TO OUTPUT BUFFER 
      DEF CRNA
      LDA CRNA      GET FIRST WORD OF CR NAME 
      AND B7777     GET RID OF SIGN BIT 
      STA CRNA      RESTORE 
      LDA DISP      GET TO LABEL WORD 
      ADA D3
      LDA A,I       CONVERT LABEL WORD TO ASC 
      JSB BNDEC 
      DEF LWA       LABEL WORD ADDRESS
      LDB DISP      GET TO # SEC/TRACK
      ADB D6
      LDA B,I       GET # OF SECTORS/TRACK
      STA SCTRK     SAVE AS # OF SECTORS/TRACK
      ADB D2        GET TO # OF DIRECTORY TRACKS
      LDA B,I 
      ADA WTRCK     GET ENDING DIRECTORY TRACK
      STA NTRKS 
      LDA B,I       GET # OF DIRECTORY TRACKS 
      CMA,INA       MAKE # POS. 
      JSB BNDEC     CONVERT TO ASC
      DEF DTRKA 
      LDA DTRKA+2   MOVE UP THE LEAST SIGNIFICANT DIGITS
      STA DTRKA      THEY ARE THE ONLY ONES TO BE PRINTED 
      JSB WTLIN     SEND LINE TO TERMINAL 
      DEF HEAD1     FIRST HEADING LINE
      JMP TERM      WAIT FOR HIM TO RETURN
      SKP 
* 
*     HERE AFTER FIRST HEADING LINE WRITTEN 
* 
SUB3  LDA SUB4A     GET ADDRESS WHERE TO GO NEXT TIME 
      STA BROUT 
      JSB WTLIN     SEND OUT SEND HEADING LINE
      DEF HEAD2 
      JMP TERM      GO WAIT FOR HIM TO RETURN 
      SPC 5 
* 
*     HERE AFTER HEADING LINE WRITTEN 
*     JUST OUTPUT A BLANK LINE
* 
SUB5  LDA SUB3A     GET ADDRESS FOR NEXT TIME 
      STA BROUT 
      JSB WTLIN     SEND OUT BLANK LINE 
      DEF BLNKL 
      JMP TERM      GO WAIT FOR HIM TO RETURN 
      SPC 5 
* 
*     HERE TO START OUTPUTING DIRECTORY 
* 
SUB4  LDA DISP      GET FILE ENTRY
      ADA D16 
      JSB SCFX      SEE IF WE NEED NEW SECTOR 
      JMP SUB2      DONE...NO MORE DIRECTORY
      LDA DISP,I    IS THIS FILE PURGED 
      SSA 
      JMP SUB4      YES...GO TO NEXT ONE
      SZA,RSS       DONE? 
      JMP SUB6      YES...2 SPACES & GET NEXT LU
      JSB MDLIN     MOVE THE LINE 
      JMP SUB4      ERROR CONDITION 
      JSB WTLIN     GO WRITE THE LINE 
      DEF DLINA     ADDRESS OF DETAIL LINE
      JMP TERM      WAIT FOR HIM AGAIN
      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 
      JMP TERM
      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 
      JMP TERM
      SKP 
* 
*     SUBROUTINE TO MOVE DETAIL LINE TO PRINT LINE
*     CALLING SEQUENCE
*     JSB MDLIN 
*     NO MATCH RETURN...IE..FILTER MIS-MATCH,TYPE NO MATCH
*     NORMAL RETURN 
* 
      SPC 1 
MDLIN NOP 
      LDA FLTR      IS FILTER SPECIFIED 
      SZA           NO
      CPA SPACA     OR IS IT ALL SPACE? 
      JMP NDLN2     NOT SUPPLIED OR SPACE 
      LDA FLTRA     GET ADDRESS WHERE FILTER LOCATED
      CLE,ELA       CONVERT TO BYTE ADDRESS 
      STA TEMP      SAVE FILTER BYTE ADDRESS
      LDA DISP      GET ADDRESS OF NAME 
      CLE,ELA       CONVERT TO BYTE ADDRESS 
      STA TEMP1     SAVE IN BYTE ADD COUNTER
      LDA M6        # OF CHAR IN FILTER 
      STA TEMP2     SAVE IN DOWN COUNTER
MDN11 LDB TEMP      GET BYTE ADD OF FILTER
      JSB ABYTE     GET BYTE
      SZA,RSS       IF ZERO, CHANGE TO SPACE
      LDA C40       C40=SPACE 
      CPA FLTRC     IS IT A "*"?
      JMP MDN12     YES...DON'T CHECK 
      STA TEMP3     SAVE IN TEMP LOCATION 
      LDB TEMP1     GET BYTE ADDRESS OF NAME
      JSB ABYTE     GET BYTE
      CPA TEMP3     IS THERE A MATCH? 
      RSS           YES 
      JMP MDLIN,I   NO...IGNORE ENTRY 
MDN12 ISZ TEMP      GET TO NEXT ENTRY 
      ISZ TEMP1 
      ISZ TEMP2     DONE? 
      JMP MDN11     NO
      SPC 2 
* 
*     AFTER CHECKING NAME, CHECK TYPE 
* 
NDLN2 LDB DISP      GET TO FILE TYPE
      ADB D3
      LDB B,I 
      LDA FTYP      CHECK WITH FILE TYPE PASSED 
      RAL,CLE,ERA     IS THERE A FILE TYPE? 
      SEZ           FILE TYPE SPECIFIED 
      CPA B         YES...DOES IT MATCH 
      RSS           MATCH...OR NO FILE TYPE SPECIFIED 
      JMP MDLIN,I   FILE TYPE NOT MATCHED 
      STB FTYPT     SAVE TYPE IN TEMP FOR LATTER
      LDA B 
      JSB BNDEC     CONVERT FILE TYPE TO ASC
      DEF DTYPA 
      LDA DISP      MOVE NAME TO OUTPUT LINE
      JSB NMOVE 
      DEF DNAMA 
      LDA DISP      GET # OF SECTORS OR LU
      ADA D4        ASSUME LU 
      LDB FTYPT     SEE IF TYPE=0 
      SZB           YES?
      ADA D2        NO...GET # OF SECTORS 
      LDA A,I       GET VALUE 
      SZB           IF LU...DON'T DIVIDE BY 2 
      CLE,ERA       CONVERT TO # OF BLOCKS
      JSB BNDEC     CONVERT TO ASC
      DEF DBSLU 
      LDB DISP      GET TO SECURITY CODE
      ADB D8
      LDA B,I       GET SECURITY CODE 
      JSB BNDEC     CONVERT TO ASC
      DEF DSECA 
      LDB FTYPT     CHECK IF THIS REC AN EXTENT 
      LDA DISP
      ADA D5
      LDA A,I       IF EXTENT...CAN'T BE TYPE=0 
      AND UB377     NO EXTENT A=0 
      SZB           IF TYPE 0...DON'T CHECK FOR EXTENT
      SZA,RSS       NOT TYPE 0...EXTENT?
      ISZ MDLIN     NOT EXTENT..OR TYPE 0 NORM RETURN 
      LDA DLLWS     LENGTH OF DETAIL LINE WITH S.C. 
      LDB MCODF     SUPPLY SECURITY CODE? 
      SZB,RSS 
      LDA DLLS      NO...LENGTH WITHOUT SECURITY CODE 
      STA DLINA     SAVE FOR TRANSFER 
      JMP MDLIN,I   RETURN
      SPC 1 
FTYPT NOP 
DLLWS DEC 16
DLLS  DEC 12
D5    DEC 5 
      SKP 
* 
*     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 "DISK NOT MOUNTED" 
      DEF NOCRM 
      JMP TERM
* 
DONE1 JSB D65CL     SEND STOP 
      DEF *+3 
      DEF D3        CONTROL REQUEST 
      DEF RLU       0 IS THE MODE FOR STOP
      JSB CMER      ERROR RETURN
* 
      LDA BIT14     TELL OTHER SIDE, ALL DONE 
      RSS 
      SPC 5 
* 
*     HERE WE TERMINATE BY SENDING REPLY
* 
TERM  CLA           SET FOR MORE TO COME
      STA STAT      SAVE STATUS 
      LDA STYP      GET STREAM TYPE 
      IOR BIT14     SET FOR REPLY 
      STA STYP
      AND B4000     ISOLATE THE F BIT 
      LDB D35       GET F. LENGTH 
      SZA,RSS       BIT SET ? 
      LDB D20       NO, OLD LENGTH
      STB RPLYL     SAVE
      JSB D65SV     SEND REPLY
      DEF *+7 
      DEF IRWW      WRITE 
      DEF RLU       REQUEST ONLY
      DEF STYP
      DEF RPLYL     REPLY LENGTH
      DEF DUMMY 
      DEF DUMMY 
* 
      JSB CMER      ERROR REPLY 
      JMP DLST0     GO DO A GET CALL
      SKP 
* 
*     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 
      LDA RLU       GET COMM. LU
      IOR MSK3      SEND DATA 
      STA IMODE 
* 
      JSB D65CL 
      DEF *+7 
      DEF IRWW
      DEF IMODE 
WTLNB NOP           DATA BUFFER 
      DEF LNGH
      DEF TAGS
      DEF TAGS+1
      JMP BAD       ERROR RETURN
* 
      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 
      ISZ WTLIN     GET RETURN ADDRESS
      JMP WTLIN,I   RETURN
      SPC 3 
BAD   JSB CMER
      JMP DLST0 
      SKP 
* 
*     SUBROUTINE TO MOVE NAME TO OUTPUT BUFFER
*     CALLING SEQUENCE
*     JSB NMOVE 
*     DEF DESTINATION BUFFER
*     A REG=SOURCE ADDRESS
*     WILL MOVE 3 WORDS 
* 
NMOVE NOP 
      LDB NMOVE,I   GET DESTINATION ADDRESS 
      STB NMOV1     SAVE IN TEMP LOCATION 
      LDB M3        GET DOWN COUNT
      STB NMOV2 
NMOVA LDB A,I       GET DATA
      STB NMOV1,I   SAVE DATA 
      INA           GET NEXT ADDRESS
      ISZ NMOV1 
      ISZ NMOV2 
      JMP NMOVA     NOT DONE...CONTINUE 
      ISZ NMOVE     GET TO RETURN ADDRESS 
      JMP NMOVE,I   RETURN
      SPC 2 
NMOV1 NOP 
NMOV2 NOP 
      SKP 
* 
*     SUBROUTINE TO KEEP DISPLACEMENT ON DISK OK
*     CALLING SEQUENCE
*     JSB SCFX
*     NO MORE DIRECTORY TRACK RETURN
*     NORMAL RETURN 
*     A REG=DISPLACEMENT
*     UPON RETURN 
*     WILL UPDATE WTRCK,WSEC,AND DISP AS REQUIRED 
*     ASSUMES DISP STARTS WITH ADDRESS OF BUFFER
*     SCTRK MUST BE SET TO # OF SECTORS/TRACK 
*     IF TRACK CHANGES, NTRCK=LAST DIRECTORY TRACK-1
*     ALL SECTORS ARE ASSUMED TO BE 128 WORDS LONG
* 
      SPC 1 
SCFX  NOP 
      CMA,INA       NEGATE ADDRESS
      ADA DBFA      GET DISPLACEMENT
      CMA,INA       MAKE IT POSITIVE
      CLB           CHECK IF OVERFLOW 
      DIV D128      CROSS A SECTOR BOUNDRY
      ADB DBFA      GET DISPLACEMENT AS AN ADDRESS
      STB DISP      SAVE DISPLACEMENT ADDRESS 
      SZA,RSS       SECTOR CHANGE 
      JMP SCFXA     NO
      LDA D14       YES...GET TO NEXT SECTOR
      ADA WSEC      GET TO NEXT SECTOR ADDRESS
      CLB 
      DIV SCTRK     SEE IF WE HAVE A HAVE LOOPED AROUND 
      STB WSEC      SAVE NEW SECTOR ADDRESS 
      SZA           IF NO ROLLOVER OR 
      SZB           NO NEW TRACK NEEDED 
      JMP SCFXA     DON'T UPDATE TRACK ADDRESS
      CCB           UPDATE TRACK ADDRESS
      ADB WTRCK     GET TO NEXT TRACK 
      CPB NTRKS     DONE? 
      JMP SCFX,I    YES 
      STB WTRCK     NO...SET IN NEW TRACK ADDRESS 
SCFXA LDA D128      DO A 128 WORD READ
      JSB GETSC 
      ISZ SCFX      GET TO RETURN 
      JMP SCFX,I    RETURN
      SKP 
* 
*     SUBROUTINE TO READ A SECTOR 
*     CALLING SEQUENCE
*     JSB GETSC 
*     THE FOLLOWING MUST BE SET UP
*     WTRCK,WSEC,WCLU 
* 
GETSC NOP 
      STA BUFL      SAVE BUFFER READ LENGTH 
      LDA WTRCK     GET CURRENT TRACK ADDRESS 
      CPA CTRCK     SAME AS ONE WE GOT NOW? 
      RSS           YES 
      JMP GTSC1     NO...GO READ IT 
      LDA WSEC      IS IT THE SAME SECTOR 
      CPA CSEC      ? 
      RSS           YES 
      JMP GTSC1     NO...GO READ IT 
      LDA WCLU      SAME LU?
      CPA CCLU
      JMP GETSC,I   YES...DON'T READ SECTOR 
GTSC1 LDA WCLU      SET UP AS CURRENT 
      STA CCLU
      LDA WTRCK 
      STA CTRCK 
      LDA WSEC
      STA CSEC
      JSB EXEC      GO READ A SECTOR
      DEF *+7 
      DEF D1
      DEF WCLU
      DEF DBUF
      DEF BUFL
      DEF WTRCK 
      DEF WSEC
      JMP GETSC,I   GOT SECTOR, RETURN
      SPC 2 
CTRCK OCT -1
CSEC  OCT -1
CCLU  OCT -1
BUFL  NOP 
      SKP 
* 
*     SUBROUTINE CONVERT BINARY TO DECMAL 
*     CALLING SEQUENCE
*     JSB BNDEC 
*     DEF BUFFER WHERE TO ASC 
*     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 M5        GET LOOP COUNT
      STA DTMP3     SAVE IN DOWN COUNTER
      LDA C40       GET A SPACE CHARACTERR
      LDB DTEMP     GET BINARY VALUE
      SSB,RSS       IF NEGATIVE...CONVERT 
      JMP BNDCB     NOT NEGATIVE
      CMB,INB       NEGATIVE, MAKE POSITIVE 
      STB DTEMP 
      LDA C55       SET IN NEG SIGN 
BNDCB LDB DTMP1     GET BYTE ADDRESS
      JSB SBYTE     SAVE SIGN 
      ISZ DTMP1     GET NEXT BYTE ADDRESS 
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 
C55   OCT 55
DTEMP NOP 
DTMP1 NOP 
DTMP2 NOP 
DTMP3 NOP 
DNMA  DEF DNM 
DNM   DEC 10000,1000,100,10,1 
      SKP 
* 
*     SBROUTINE TO GET A BYTE 
*     CALLING SEQUENCE
*     JSB ABYTE 
*     B REG= BYTE ADDRESS 
*     A REG= BYTE 
*     UPON RETURN 
*     B AND A REG UNCHANGED 
* 
ABYTE NOP 
      CLE,ERB       CONVERT TO WORD ADDRESS 
      LDA B,I       GET WORD
      SEZ,RSS       CHECK WHICH HALF
      ALF,ALF 
      AND B377      GET BYTE
      ELB,CLE       GET BYTE ADDRESS AGAIN
      JMP ABYTE,I   RETURN
      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     MASK ALL BUT 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 
      SPC 3 
CMER  NOP 
      DST ERVAL 
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF D1
      DEF ERMS
      DEF ERML
* 
      JMP CMER,I
      SPC 3 
ERMS  ASC 9,DLIST: COMM. ERROR
ERVAL BSS 2 
ERML  DEC 11
      SKP 
* 
*     DCB LAYOUT
* 
STYP  NOP           STREAM TYPE 
      BSS 1         NOT USED
STAT  NOP           STATUS
ECOD  NOP           ERROR CODE
LNGH  NOP           LENGTH WORD 
FLTR  ASC 3,        NAME FILTER...0..NO FILTER
MCODF NOP           MASTER SECURITY CODE
CRLU  NOP           LU OF CART. TO DO 
FTYP  NOP           FILE TYPE FILTER
BROUT NOP           ADDRESS OF CURRENT ROUTINE TO PROCESS 0=START 
WCLU  NOP           CURRENT LU FOR DISK READ
WTRCK NOP           CURRETN TRACK TO READ 
WSEC  NOP           CURRENT SECTOR TO READ
DISP  NOP           DISPLACEMENT IN BUFFER
SCTRK NOP           # OF SECTORS/TRACK
LUDSP NOP           DISPLACEMENT IN DIRECTORY LU
NTRKS NOP           # OF DIRECTORY TRACKS 
* 
*     HERE WE FILL TO GET TO 35 WORD REQ
* 
      BSS 5 
RLU   NOP           DEFINED IN QUEUE...LU OF WHO WE ARE TALKING TO
      BSS 8 
TAGS  BSS 2 
      SPC 2 
RPLYL NOP           LENGTH OF DIRECTORY PARMB 
B377  OCT 377 
C40   OCT 40
C60   OCT 60
D3    DEC 3 
D8    DEC 8 
UB377 OCT 177400
D35   DEC 35
D21   DEC 21
D14   DEC 14
D20   DEC 20
B4000 OCT 4000
D16   DEC 16
D128  DEC 128 
D4    DEC 4 
D1    DEC 1 
D6    DEC 6 
D0    DEC 0 
D2    DEC 2 
M1    DEC -1
M3    DEC -3
M5    DEC -5
M6    DEC -6
MSK1  OCT 77
MSK3  OCT 300 
IRWW  OCT 100002
DUMMY NOP 
IMODE NOP 
B7777 OCT 77777 
BIT14 OCT 40000 
FLTRA DEF FLTR
FLTRC OCT 52
TEMP  NOP 
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
* 
TATSD EQU 1756B 
SECT2 EQU 1757B 
DBFA  DEF DBUF
MSCA  DEF DBUF+126
CLSSN NOP 
      SPC 1 
* 
*     DEFINE OUTPUT LINE INFO 
* 
HEAD1 DEC 27
SPACA ASC 1,
      ASC 3,ILAB= 
CRNA  ASC 3,
      ASC 1,
      ASC 7,REMOTE DLIST
      ASC 2,CR#=
LWA   ASC 3,
      ASC 1,
      ASC 5,DIR TRKS= 
DTRKA ASC 3,
      SPC 1 
HEAD2 DEC 16
      ASC 16,  NAME     TYPE  #BLKS/LU  SCODE 
      SPC 1 
NOCRM DEC 8 
      ASC 8,DISK NOT MOUNTED
DLINA DEC 16
      ASC 1,
DNAMA ASC 3,
      ASC 1,
DTYPA ASC 3,
      ASC 1 
DBSLU ASC 3,
      ASC 1,
DSECA ASC 3,
      SPC 2 
BLNKL DEC 1 
      OCT 20040 
DBUF  BSS 128 
      SPC 3 
END   EQU * 
      END DLIST 
                                              