ASMB,C,Q,N
      IFN           * START RTE CODE
      HED DLIST  91740-16009 REV 2001 * (C) HEWLETT-PACKARD CO. 1980
      XIF           * END RTE CODE
* 
      IFZ           * START RTE-M FLOPPY CODE 
      HED DLIST  91740-16010 REV 2001 * (C) HEWLETT-PACKARD CO. 1980
      XIF           * END RTE-M FLOPPY CODE 
* 
      IFN           * START RTE CODE
      NAM DLIST,19,30 91740-16009 REV 2001 791029 
      XIF           * END RTE CODE
* 
      IFZ           * START RTE-M FLOPPY CODE 
      NAM DLIST,19,30 91740-16010 REV 2001 791029 
      XIF           * END RTE-M FLOPPY CODE 
      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 DS-1000
*                     IFN = RTE SYSTEMS 
*                     IFZ = RTE-M FLOPPY-BASED SYSTEMS
* 
*     NAME:         DLIST 
*     SOURCE:       91740-18009 ('IFN' VERSION) 
*     SOURCE:       91740-18010 ('IFZ' VERSION) 
*     RELOC:        91740-16009 ('IFN' VERSION) 
*     RELOC:        91740-16010 ('IFZ' VERSION) 
*     PGMR:         DAN GIBBONS 
* 
* 
*     MODIFIED BY:  JEAN-PIERRE BAUDOUIN (MAY 1976) 
*                   DAN GIBBONS (JANUARY 1979)
*                   C.HAMILTON: ADD CART. LIST, 'OPEN TO', EXTENT NO.(10/78)
*                   D.GIBBONS: MAKE COMPAT. WITH MSTR SECU CODE ENCRYPTION
* 
********************************************************
      SPC 2 
* 
*     PROGRAM TO DO DIRECTORY LISTING ON AS 
*     MANY REMOTE TERMINALS AS REQUIRED 
* 
* 
      ENT DLIST 
* 
      EXT EXEC,D65SV,D65GT,#NODE
* 
      IFN           * START RTE CODE
      EXT $CL1,$CL2,FSTAT,$BMON 
      XIF           * END RTE CODE
      IFZ           * START RTE-M FLOPPY CODE 
      EXT .DRCT,$CDIR,$XECM 
      XIF           * END RTE-M FLOPPY CODE 
* 
* 
A     EQU 0 
B     EQU 1 
      SUP 
      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
* 
      IFN           * START RTE CODE
INIT  LDA $BMON     CHECK TYPE OF SYSTEM
      SZA           PRE-RTE4B SYSTEM? 
      JMP NEWSY     NO, SETUP FOR NEW DRCTRY FRMT 
      LDA TATSD     YES, GET # TRKS IN SYS DISC 
      ADA M1        GET TO LAST TRACK 
      CLB           SET FOR SECTOR ZERO 
      JMP SETCD     GO SET CARTRIDGE DRCTRY DISC ADR
* 
CDTRK NOP           CARTRIDGE DRCTRY TRACK #
CDSEC NOP           CARTRIDGE DRCTRY SECTR #
* 
NEWSY LDA MSCA      ADJUST MSTR SEC CODE ADR
      ADA D128       FOR NEW CARTRIDGE DRCTRY 
      STA MSCA        FORMAT. 
      LDA DBFA1     ADJUST BUFR PTR TO
      ADA D128       2ND BLOCK OF CARTRIDGE 
      STA DBFAD       DIRECTORY BUFR. 
      LDA $CL1      GET CARTRIDGE DRCTRY TRK ADR
      LDB $CL2      GET SECTR ADR OF 2ND BLOCK
      ADB D2         OF CARTRIDGE DRCTRY. 
* 
SETCD STA CDTRK     SET DRCTRY TRK #
      STB CDSEC      AND SECTOR #.
      XIF           * END RTE CODE
      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
SUB3A DEF SUB3
SUB4A DEF SUB4
SUB5A DEF SUB5
SUB7A DEF SUB7
SUB9A DEF SUB9
SB10A DEF SUB10 
SB11A DEF SUB11 
DON1A DEF DONE1 
      SPC 5 
* 
*     HERE ON NEW REQUEST 
* 
SUB1  EQU * 
      IFN           * START RTE CODE
      LDA DBFA1     GET DIRECTORY DATA BUFR ADR 
      STA LUDSP     SAVE FOR LU LOOPING 
SUB2  LDA D2        GET LU OF SYSTEM DISC 
      STA WCLU      SAVE AS WANTED LU 
      LDA CDTRK     GET CARTRIDGE DRCTRY TRACK #
      STA WTRCK     SAVE IN WANTED TRACK
      LDB CDSEC     GET CARTRIDGE DRCTRY SECTOR # 
      STB WSEC      SAVE IN WANTED SECTOR 
      LDA DBFAD     READ 128 WORDS CONTAINING MSTR
      JSB GETSC      SECURITY CODE. 
* 
      LDA $BMON     CHECK SYSTEM TYPE 
      SZA,RSS       PRE-RTE4B SYSTEM? 
      JMP SUB2B     YES, DRCTRY & MSC ARE IN DBUF 
      JSB FSTAT     NO, READ IN 253 WORD
      DEF *+3        CARTRIDGE DIRECTORY
      DEF DBUF        (IN OLD FORMAT).
      DEF D253
* 
SUB2B LDA LUDSP,I   GET LU OF CARTRIDGE 
      SZA,RSS       DONE? 
      XIF           * END RTE CODE
* 
      IFZ           * START RTE-M FLOPPY CODE 
* 
      LDA M1        INITIALIZE VARIABLES TO ENSURE
      STA CTRCK       FRESH FILE DIRECTORY COPY 
      STA CSEC          IS READ AT LEAST ONCE.
      STA CCLU
* 
      JSB .DRCT     GET ADR OF FLOPPY DIRECTORY 
      DEF $CDIR 
      STA LUDSP     SAVE FOR LU LOOPING 
SUB2B EQU * 
SUB2  JSB .DRCT     GET ADR OF DIRECTORY
      DEF $CDIR 
      ADA M1        GET TO END-OF-DIRECTORY ADR 
      LDA A,I       GET THE ADDRESS 
      CPA LUDSP     DONE? 
      JMP DONE      YES 
      LDA LUDSP,I   GET LU OF CARTRIDGE 
      SZA           DONE OR $CDIR 
      CPA M2          NOT INITIALIZED?
      XIF           * END RTE-M FLOPPY CODE 
* 
      JMP DONE      YES 
      LDA FLTR      IF FILTER-WORD #1 
      CPA M1         IS EQUAL TO A -1, THEN 
      JMP *+2         THIS IS A CARTRIDGE LIST REQUEST; 
      JMP SUB20        ELSE, PROCESS THE DIRECTORY LIST.
      LDA FLTR+1    IF FILTER-WORD #2 
      SZA,RSS        IS EQUAL TO A 0, THEN
      JMP SUB8        BEGIN THE CARTRIDGE LIST; 
      JMP SUB10        ELSE, CONTINUE LISTING.
SUB20 LDB BROUT     SEE IF FIRST TIME 
      SZB 
      JMP SUB22     NOT FIRST TIME
      IFZ           * START RTE-M FLOPPY CODE 
      LDA $XECM     GET RTE-M SECURITY CODE 
      STA MSCA,I    SAVE IT 
      XIF           * END RTE-M FLOPPY CODE 
      CPB MCODF     MSTR SECU SUPPLIED? (NOTE: <B>=0) 
      JMP SUB22     NONE--NO SPECIAL ACCESS.
      LDA MSCA,I    GET MASTER SECURITY CODE. 
      SZA,RSS       IF NONE, ALLOW ACCESS.
      JMP SUB22     NO SYS SECU CODE, SO ALLOW ACCESS 
* 
      IFN           * START RTE CODE
      LDB $BMON     CHECK TYPE OF SYSTEM
      SZB,RSS       PRE-RTE4B SYSTEM? 
      JMP NOMSK     YES, NO MASK ON MSTR SECU CODE
      XOR MASK      NO, SECU CODE IS ENCRYPTED
      INA           CONTINUE THE DECRYPTION 
NOMSK EQU * 
      XIF           * END RTE CODE
* 
      CPA MCODF     USER'S AND MASTER MATCH?
      JMP SUB22     MATCH! ALLOW ACCESS.
      CLB           NO SPECIAL ACCESS ALLOWED, SO 
      STB MCODF      CLEAR MCODF. 
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 SUB2B 
      UNL 
      IFN           * START RTE CODE
MASK  DEC 31178 
      XIF           * END RTE CODE
      LST 
      SPC 5 
* 
*     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 
* 
      IFN           * START RTE CODE
      LDB $BMON     CHECK SYSTEM TYPE 
      SZB           PRE-RTE4B SYSTEM? 
      JMP MCR01     NO
      CPA D2        YES, IS IT SYSTEM DISC? 
      LDB D14       YES 
      RSS 
MCR01 CLB 
      XIF           * END RTE CODE
* 
      STB WSEC      SAVE STARTING SECTOR ADDRESS
      LDA DBFA1     SET FOR ZERO DISPLACEMENT WITHIN BUFFER 
      JSB SCFX      GO GET SECTOR 
      JMP SUB2      NO DIRECTORY? 
      LDA DISP      GET NAME OF CART. 
      LDB CRNAA     GET DESTINATION ADDRESS 
      MVW D3        MOVE 3 WORDS
      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 
      LDA #NODE     IDENTIFY THE
      JSB BNDEC      NODE WHICH IS
      DEF NODE        BEING LISTED. 
      JSB WTLIN     SEND LINE TO TERMINAL 
      DEF HEAD1     FIRST HEADING LINE
      SPC 5 
* 
*     HERE AFTER FIRST HEADING LINE WRITTEN 
* 
SUB3  LDA SUB4A     GET ADDRESS WHERE TO GO NEXT TIME 
      STA BROUT 
      LDB D17       NON-SECURITY HEADER LENGTH. 
      LDA MCODF 
      SZA           SECURITY CODES BEING LISTED?
      LDB D20       YES, ADD "SCODE" TO HEADER
      STB HEAD2 
      JSB WTLIN     SEND OUT SEND HEADING LINE
      DEF HEAD2 
      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 
      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
      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 
* 
*     HERE TO DO A CARTRIDGE LIST 
* 
SUB8  LDA SUB9A     GET ADDRESS FOR NEXT TIME.
      STA BROUT 
      LDA #NODE     IDENTIFY THE NODE 
      JSB BNDEC      WHOSE CARTRIDGE LIST 
      DEF CLNOD       IS BEING PROCESSED. 
      JSB WTLIN     OUTPUT THE
      DEF CLHED      CARTRIDGE-LIST HEADER. 
      SPC 2 
* 
*     HERE TO OUTPUT A SEPARATING BLANK LINE. 
* 
SUB9  LDA SB10A     GET ADDRESS FOR FIRST LINE
      STA BROUT     SET COROUTINE POINTER.
      JSB WTLIN     OUTPUT A
      DEF BLNKL      BLANK LINE.
      SPC 2 
* 
*     PROCESS THE CARTRIDGE-LIST ENTRY. 
* 
SUB10 LDA LUDSP,I   GET THE CARTRIDGE LOGICAL UNIT. 
      ISZ LUDSP     ADVANCE THE ENTRY-POINTER.
      JSB BNDEC     CONVERT THE LU
      DEF DTYPA      TO IT'S ASCII EQUIVALENT.
      LDA DTYPA+2   GET THE TWO USEFUL ASCII DIGITS.
      STA LU        CONFIGURE THE LINE. 
      LDA LUDSP,I   GET THE LAST TRACK FOR THE CARTRIDGE. 
      ISZ LUDSP     ADVANCE THE POINTER.
      JSB BNDEC     CONVERT LAST TRACK TO ASCII,
      DEF LTRK       AND CONFIGURE THE LINE.
      LDA LUDSP,I   GET THE CARTRIDGE NUMBER. 
      ISZ LUDSP     ADVANCE THE POINTER.
      JSB BNDEC     CONVERT CARTRIDGE NO. TO ASCII, 
      DEF CART       AND CONFIGURE INTO MESSAGE.
      LDB CLEN1     PREPARE FOR UNLOCKED LINE LENGTH. 
      LDA LUDSP,I   GET THE LOCK FLAG (I.D. SEG. ADDR.) 
      ISZ LUDSP     BUMP POINTER. 
      SZA,RSS       IF IT'S NOT LOCKED, 
      JMP SNDLN      THEN COMPLETE THE LINE;
      ADA D12         ELSE, POINT TO PROGRAM NAME,
      CLE,ELA          AND FORM ITS BYTE ADDRESS. 
      LDB CLKBA     GET CONFIGURED MESSAGE BYTE ADDRESS.
      MBT D5        MOVE THE LOCKER'S NAME TO THE LINE. 
      LDB CLEN2     GET LOCKED-CARTRIDGE LINE LENGTH. 
SNDLN STB CLINE     CONFIGURE THE LINE LENGTH.
      LDB SUB2A     SET FOR RETURN VIA RELOAD SECTION.
      LDA LUDSP,I   IF THE NEXT ENTRY 
      SZA,RSS        IS NULL, THE LIST IS COMPLETE, SO
      LDB SB11A       SET RETURN TO WRAP-UP SECTION;
      STB BROUT        ESTABLISH THE COROUTINE POINTER. 
      STB FLTR+1    SET FLAG FOR CLIST CONTINUATION.
      JSB WTLIN     SEND THE CONFIGURED LINE
      DEF CLINE      TO THE REMOTE NODE.
* 
SUB11 LDA DON1A     SEND A
      STA BROUT      BLANK LINE,
      JSB WTLIN       AND RETURN
      DEF BLNKL        TO THE END PROCESSOR.
* 
CLEN1 DEC 11
CLEN2 DEC 15
CLKBA DBL LOCK
* 
CLHED DEC 24
      ASC 14,  LU  LAST TRACK   CR   LOCK 
      ASC 7,  REMOTE NODE=
CLNOD ASC 3,
* 
CLINE NOP 
      ASC 1,
LU    ASC 1,
      ASC 2,
LTRK  ASC 3,
      ASC 1,
CART  ASC 3,
      ASC 1,
LOCK  ASC 3,
* 
      HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980
* 
*     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
      LBT           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
      LBT           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 1 
* 
*     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 
      ISZ MDLIN     SET FOR NORMAL (P+2) RETURN.
      LDA DLLS      ESTABLISH LINE LENGTH 
      STA DLINA      FOR LINE SANS SECURITY CODE. 
      STB FTYPT     SAVE FILE TYPE, TEMPORARILY.
      LDA B         GET FILE TYPE FOR CONVERSION. 
      JSB BNDEC     CONVERT FILE TYPE TO ASC
      DEF DTYPA 
      LDA DISP      MOVE NAME TO OUTPUT LINE
      LDB ADNAM     GET DESTINATION ADDRESS 
      MVW D3        MOVE NAME 
      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,RSS       LU? 
      JMP CNVRT     YES, DON'T DIVIDE BY 2
      SSA           NEG BLOCK COUNT?
      CMA,INA,RSS   YES, MAKE POS & SKIP DIV BY 2 
      CLE,ERA       CONVERT TO # OF BLOCKS
CNVRT JSB BNDEC     CONVERT TO ASC
      DEF DBSLU 
      LDA BLNK4     BLANK OUT THE 
      LDB OPNAD      'OPEN TO' / EXTENT NO. 
      MVW D4           INFORMATION FIELD. 
      LDA FTYPT     GET THE FILE TYPE.
      SZA,RSS       IF THE TYPE IS ZERO,
      JMP OPNFL      DON'T WORRY ABOUT EXTENTS. 
      LDB DISP      GET THE 
      ADB D5         EXTENT WORD
      CLE,ELB         FROM THE UPPER BYTE 
      LBT              OF THE DIRECTORY ENTRY.
      SZA,RSS       IF NOT AN EXTENT, THEN
      JMP OPNFL      CHECK THE OPEN FLAGS;
      JSB BNDEC       ELSE, CONVERT EXTENT NO., 
OPNAD DEF DXOPN        AND ADD IT TO THE LINE.
      LDA EXTBA     GET BYTE ADDR. OF EXTENT DELIMITER. 
      LDB EXNBA     GET BYTE ADDR. OF DELIMITER BUFFER. 
      MBT D3        MOVE '  +' TO CONFIGURED LINE.
      JMP SCODP     IGNORE OPEN FLAGS FOR EXTENTS.
OPNFL LDA DISP      GET THE 
      ADA D9         OPEN FLAG
      LDA A,I         FROM THE ENTRY. 
* 
      IFN           * START RTE CODE
      LDB $BMON     CHECK SYSTEM TYPE 
      SZB,RSS       PRE-RTE4B SYSTEM? 
      JMP OPNF1     NO
      LDB A         YES, SAVE OPEN FLAG 
      AND BT15      ISOLATE OPEN FLAG 
      STA DTEMP     SAVE EXCLUSIVE BIT
      LDA B         RETRIEVE FLAG 
      AND RTBYT     ISOLATE ID SEG #
      SZA,RSS       IF FILE'S NOT OPENED, THEN
      JMP SCODP      IGNORE THIS ENTRY. 
      LDB KEYWD     CALCULATE POINTER 
      ADB M1         TO ID SEGMENT
      ADB A            ADDRESS. 
      LDA B,I       GET ID SEG ADR
      IOR DTEMP     INCLUDE EXCLUSIVE BIT 
      XIF           * END RTE CODE
* 
OPNF1 SZA,RSS       IF FILE'S NOT OPENED, THEN
      JMP SCODP      IGNORE THIS ENTRY. 
      CLE,ELA       SAVE EXCLUSIVE FLAG,
      ADA D24        AND FORM I.D. SEG WD#13 BYTE ADDRESS.
      LDB OPNBA     GET BYTE ADDR. FOR CONFIGURED LINE. 
      MBT D5        MOVE PROGRAM NAME INTO LINE.
      LDA C55       IF IT IS EXCLUSIVE, THEN
      SEZ            USE ' -' AS A DELIMITER, AND 
      SBT             ADD THE DELIMITER TO THE LINE.
SCODP LDB MCODF     SUPPLY SECURITY CODE? 
      SZB,RSS 
      JMP MDLIN,I    NO...RETURN. 
      LDA DLLWS     ESTABLISH LINE LENGTH 
      STA DLINA      FOR LINE WITH SECURITY CODE. 
      LDA DISP      GET THE 
      ADA D8         SECURITY CODE
      LDA A,I         FROM THE ENTRY. 
      JSB BNDEC     CONVERT TO ASCII, 
      DEF DSECA      AND CONFIGURE INTO LINE. 
      JMP MDLIN,I   RETURN. 
      SPC 1 
FTYPT NOP 
D5    DEC 5 
D9    DEC 9 
D12   DEC 12
D16   DEC 16
D20   DEC 20
DLLS  EQU D16 
DLLWS EQU D20 
D24   DEC 24
BLNK4 DEF BLNKL+1 
BLPLS ASC 2,  + 
EXTBA DBL BLPLS 
EXNBA DBL DXOPN 
OPNBA DBL DXOPN+1 
KEYWD EQU 1657B     KEYWORD BLOCK ADR 
RTBYT OCT 377 
BT15  OCT 100000
      SPC 5 
* 
*     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 
* 
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 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 DBFA1     GET DISPLACEMENT
      CMA,INA       MAKE IT POSITIVE
      CLB           CHECK IF OVERFLOW 
      DIV D128      CROSS A SECTOR BOUNDRY
      ADB DBFA1     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 DBFA1     DO A 128 WORD READ
      JSB GETSC 
      ISZ SCFX      GET TO RETURN 
      JMP SCFX,I    RETURN
      SPC 5 
* 
*     SUBROUTINE TO READ A PHYSICAL SECTOR (128 WORDS)
* 
*     CALLING SEQUENCE: 
* 
*        LDA <BUFR ADR> 
*        JSB GETSC
* 
*     THE FOLLOWING MUST BE SET UP: 
* 
*        WTRCK,WSEC,WCLU
* 
GETSC NOP 
      STA BUFAD     SAVE BUFFER ADR 
      LDA FLTR      IF A CARTRIDGE LISTING
      CPA M1         IS CURRENTLY IN PROGRESS,
      JMP GTSC1       FORCE A RELOAD OF THE SECTOR. 
      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
BUFAD NOP 
      DEF D128
      DEF WTRCK 
      DEF WSEC
      JMP GETSC,I   GOT SECTOR, RETURN
      SPC 2 
CTRCK OCT -1
CSEC  OCT -1
CCLU  OCT -1
BUFL  NOP 
      SPC 5 
* 
*     SUBROUTINE CONVERT BINARY TO ASCII DECIMAL
*     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
      SBT           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
      SBT           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 
      SPC 5 
* 
*     PARMB LAYOUT
* 
IRBUF BSS 23
STYP  EQU IRBUF     STREAM TYPE 
STAT  EQU IRBUF+7   STATUS
LNGH  EQU IRBUF+8   LENGTH WORD 
FLTR  EQU IRBUF+10  NAME FILTER...0..NO FILTER
MCODF EQU IRBUF+13  MASTER SECURITY CODE
CRLU  EQU IRBUF+14  LU OF CART. TO DO 
FTYP  EQU IRBUF+15  FILE TYPE FILTER
BROUT EQU IRBUF+9   ADR OF NEXT PROCESS ROUTINE. 0=START
                                                