ASMB,R,L,C,Z
      HED D.RTR: RTE-L AND RTE-XL DISC DIRECTORY MANAGER
*     NAME:   D.RTR 
*     SOURCE: 92071-18037 
*     RELOC:  92071-16037 
*     PGMR:   G.A.A.
*     MOD:    G.L.M.   M.L.K.  E.D.B. 
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
      NAM D.RTR,1,2 92071-16037 REV.2041 800903 
* 
      EXT EXEC, $LIBR, $LIBX, PRTN, LIMEM 
      EXT .XLD, .XST, .CAX
      EXT .MVW, .MWF, .MWI, .MWW, $SETP 
      EXT $IDA, $IDSZ, $ID#, $SWLU
      IFZ           *** XL CODE *** 
      EXT $CDA, $CDSZ, $CD# 
      XIF 
      IFN           *** L/10 CODE *** 
      EXT $CDIR, $MDSP
      XIF 
* 
      SUP 
      SKP 
* 
*     RTE-L DISC DIRECTORY MANAGER PROGRAM
* 
*     DESCRIPTION 
* 
*     D.RTR IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT 
*     SYSTEM. IT OWNS ALL DISC DIRECTORIES AND PERFORMS ALL WRITES
*     ON THEM (WITH THE EXCEPTION OF IN.., AND PK.. IN THE FMGR). 
*     THERE MUST ONLY BE ONE COPY OF D.RTR IN THE SYSTEM. 
* 
*     ROUTINES WISHING TO ACCESS DISC DIRECTORIES MUST SCHEDULE THIS
*     PROGRAM VIA CLD.R (WHICH SETS UP THE PROPER CALLING SEQUENCE
*     TO D.RTR).
* 
*     FMP ROUTINES WHICH USE D.RTR: 
* 
*     OPEN-9   CLOSE-0  CREAT-1  CRETS-9  NAMF-2   RWND$-6,8
*     CRLK-3   CRULK-5  CRMC-7   CRDC-7   PURGE-11
* 
*     FMGR ROUTINES WHICH USE D.RTR:
* 
*     IN..-7
* 
*     NOTE #1:  D.RTR SHOULD BE LOADED INTO A PARTITION WITH
*               AT LEAST 3 KWORDS.
* 
*     NOTE #2:  THE SOURCE FILE CONTAINS THE CODE FOR BOTH
*               THE RTE-L AND RTE-XL D.RTR.  USE THE Z SWITCH 
*               TO COMPILE THE RTE-XL CODE, AND THE N SWITCH
*               TO COMPILE THE RTE-L CODE.
      HED D.RTR: FUNCTIONS AND INPUT PARAMETERS 
* OPEN FILE:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =9
*     P2:   -LU,+CR,0 
*     P3:   E,NAME(1,2) E(BIT 15) INDICATES EXCLUSIVE OPEN IF SET 
*     P4:   NAME(3,4) 
*     P5:   NAME(5,6) 
*     P6:   SECURITY CODE 
* 
* CLOSE FILE: 
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =0
*     P2:   TR,LU         \ 
*     P3:   OFFSET,SECTOR /DIRECTORY ADDRESS OF MASTER ENTRY
*     P4:   0,-(NO: SECTORS TO BE DELETED),+(PURGE EXTENTS ONLY)
* 
* CREATE FILE:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =1
*     P2:   -LU,+CR,0 
*     P3:   NAME(1,2) 
*     P4:   NAME(3,4) 
*     P5:   NAME(5,6) 
*     P6A:  TYPE (#0)   !  TYPE (=0)
*     P6B:  NOT PASSED  !  LU 
*     P6C:  NOT PASSED  !  EOF FUNC 
*     P7:   FILE SIZE   !  SPCL CODE
*     P8:   REC SIZE    !  I/O CODE 
*     P9:   SEC CODE
* 
* CHANGE FILE NAME AND CLOSE: 
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =2
*     P2:   TR,LU         \ 
*     P3:   OFFSET,SECTOR /DIRECTORY ADDRESS OF MASTER ENTRY
*     P4:   NEW NAME(1,2) 
*     P5:   NEW NAME(3,4) 
*     P6:   NEW NAME(5,6) 
* 
* LOCK DISC CARTRIDGE:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =3
*     P2:   -LU,+CR (0 NOT LEGAL)  DISC TO BE LOCKED
* 
* UNLOCK DISC CARTRIDGE:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =5
*     P2:   -LU,+CR (0 NOT LEGAL)  DISC TO BE UNLOCKED
* 
* MOUNT DISC CARTRIDGE: 
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =7
*     P2:   -LU        DISC TO BE OPERATED UPON 
*     P3:   +LU 
*     P4:   LAST TRACK
*     P5:   0 
*     P6:   0 
*     P7:   SUBFUNCTION CODE =-2
* 
* DISMOUNT DISC CARTRIDGE:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =7
*     P2:   -LU/+CRN   DISC TO BE OPERATED UPON 
*     P3:   0 
*     P4:   0 
*     P5:   0 
*     P6:   0 
*     P7:   SUBFUNCTION CODE = 0
* 
* CHANGE DISC CARTRIDGE CRN:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE =7
*     P2:   +NEW CRN   DISC TO BE OPERATED UPON 
*     P3:   +LU 
*     P4:   0 
*     P5:   0 
*     P6:   0 
*     P7:   SUBFUNCTION CODE =-1
* 
* OPEN FILE EXTENT (READ, WRITE): 
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE= 6(READ), =8(WRITE) 
*     P2:   TR,LU         \ 
*     P3:   OFFSET,SECTOR /DIRECTORY ADDRESS OF MASTER ENTRY
*     P4:   EXTENSION NUMBER
* 
* TRUNCATE FILE AND CLOSE:
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE= 4
*     P2:   TR,LU         \ 
*     P3:   OFFSET,SECTOR /DIRECTORY ADDRESS OF MASTER ENTRY
*     P4:   NEW FILE SIZE (IN BLOCKS) 
* 
* PURGE FILE AND CLOSE: 
*     P0:   OPEN FLAG 
*     P1:   FUNCTION CODE= 11 
*     P2:   -LU,+CR,0 
*     P3:   NAME(1,2) 
*     P4:   NAME(3,4) 
*     P5:   NAME(5,6) 
*     P6:   SECURITY CODE 
*     P7:   SUBFUNCTION CODE = 0 PURGE MAIN AND ALL EXTENTS 
*                          =-1 PURGE ONLY EXTENTS 
      HED D.RTR: RETURN PARAMETERS AND ERROR CODES
*     R1:   ERROR CODE (OR SIZE IF OPEN,CREAT,EXOPN CALL) 
*     R2:   TR,LU         \ 
*     R3:   OFFSET,SECTOR /DIRECTORY ADDRESS OF DIRECTORY ENTRY 
*     R4:   TR (LU IF TYPE 0)    \
*     R5:   SECTORS/TRACK,SECTOR /DIRECTORY ADDRESS OF FILE 
* 
* FOR OPEN FILE AND CREATE FILE FUNCTION CALLS, ADDITIONAL PARAMETERS 
* ARE PASSED THROUGH THE STRING PASSAGE CALL (EXEC 14)
* AND CAN BE USED BY THE CALLING PROGRAM: 
* 
*     S1: (WORD 2 OF DCB) FILE TYPE 
*     S2: (WORD 3 OF DCB) STARTING TRACK
*     S3: (WORD 4 OF DCB) EXTENT #,STARTING SECTOR
*     S4: (WORD 5 OF DCB) FILE SIZE 
*     S5: (WORD 6 OF DCB) RECORD LENGTH 
*     S6: SECURITY CODE 
* 
* ERROR CODES:
* 
*    CODE           MESSAGE                              ROUTINES 
*     62            CARTRIDGE LIST FULL                MOUNT
*     38            ATTEMPT TO REMOVE ACTIVE PROGRAM   DISMT
*                    OR SWAP FILE 
*     12            DUPLICATE CRN ON MOUNT             MOUNT,DISMT
*     0             NO ERROR
*    -1             DISC ERROR                         RHEAD,RBLOK,WBLOK
*    -2             DUPLICATE NAME                     CREAT,CNAM 
*    -5             EXTENT BEYOND END OF FILE          EXOPN
*    -6             FILE NOT FOUND
*    -7             ILLEGAL FILE SECURITY CODE         PURGE
*    -8             FILE ALREADY OPEN                  OPEN,TRUNC,PURGE,CNAM
*                    (LOCK REJECTED)                   RLOCK
*    -11            FILE NOT OPEN                      DIRCK
*    -13            DISC LOCKED 
*    -14            FILE DIRECTORY FULL                CREAT
*    -32            DISC CARTRIDGE NOT FOUND           UPDAT
*    -33            NOT ENOUGH ROOM ON DISC CARTRIDGE  CREAT
*    -37            ILLEGAL ACCESS TO ACTIVE           OPEN,PURGE 
*                    PROGRAM FILE 
*    -46            TOO MANY EXTENTS                   EXOPN
*    -99            EXEC READ/WRITE ABORT              RHEAD,RBLOK,WBLOK
*    -101           ILLEGAL PARAMETERS IN D.RTR 
*                    REQUEST
*    -102           ILLEGAL D.RTR SEQUENCE             RSTR 
*    -103           DISC DIRECTORY CORRUPT             RLOCK,ULOCK
*    -104           EXTENT NOT FOUND                   EXOPN
* 
      HED D.RTR: WORD FORMATS 
* OPEN FLAG FORMAT: 
*      15 14       11 10     8  7                    0
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
*     !EX!  SEQ      !   CPU  !   ID SEGMENT NUMBER   ! 
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
* 
*     WHERE:
*          EX  =     EXCLUSIVE BIT
*          SEQ =     SEQUENCE COUNT FROM ID SEGMENT 
*          ID SEG# = ID SEGMENT NUMBER (1 TO N) 
*          CPU =     RESERVED 
* 
* DOUBLE DUTY WORDS FORMAT: 
*      15                          6  5              0
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
*     !  BEGINNING TRACK            !  LOGICAL UNIT   ! 
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
* 
*      15                    8  7                    0
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
*     !  SECTOR OFFSET        !  SECTOR               ! 
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
* 
*      15                    8  7                    0
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
*     !  SECTORS PER TRACK    !  BEGINNING SECTOR     ! 
*     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ 
* 
      HED D.RTR: CONSTANT STORAGE AREA
ZERO  DEC 0         DECIMAL CONSTANTS 
.1    DEC 1 
.2    DEC 2 
.6    DEC 6 
.7    DEC 7 
.8    DEC 8 
.9    DEC 9 
.10   DEC 10
.12   DEC 12
.16   DEC 16
.20   DEC 20
.25   DEC 25
.26   DEC 26
.27   DEC 27
.28   DEC 28
.38   DEC 38
.62   DEC 62
.128  DEC 128 
* 
N1    DEC -1
N2    DEC -2
N3    DEC -3
N4    DEC -4
N5    DEC -5
N6    DEC -6
N7    DEC -7
N8    DEC -8
N11   DEC -11 
N13   DEC -13 
N14   DEC -14 
N16   DEC -16 
N32   DEC -32 
N33   DEC -33 
N37   DEC -37 
N46   DEC -46 
N100  DEC -100
* 
NAB1  OCT 100001    NO ABORT EXEC READ REQUEST
NAB2  OCT 100002    NO ABORT EXEC WRITE REQUEST 
NAB14 OCT 100016    NO ABORT EXEC STRING REQUEST
* 
B77   OCT 77        OCTAL CONSTANTS 
B377  OCT 377 
B1777 OCT 1777
B7700 OCT 7700
B100K OCT 100000
B170K OCT 170000
* 
DSKIP DEC 14        DEFAULT SKIP FACTOR 
MAXSZ OCT 77776     MAXIMUM FILE SIZE 
* 
ANAME DEF NAME
ADIRA DEF DIRA
ACLBL DEF CLABL 
ALU   DEF LU
ANXTR DEF NXTR
AP3   DEF P3
AP4   DEF P4
AEMP1 DEF EMPT1 
AEMP2 DEF EMPT2 
AJTAB DEF JTABL 
      HED D.RTR: VARIABLE STORAGE AREA
* 
ID    NOP           PASSED PARAMETER #0  (OPEN FLAG)
P1    NOP           PASSED PARAMETER #1 
P2    NOP           PASSED PARAMETER #2 
P3    NOP           PASSED PARAMETER #3 
P4    NOP           PASSED PARAMETER #4 
P5    NOP           PASSED PARAMETER #5 
P6A   NOP           PASSED PARAMETER #6 
P6B   NOP            SECONDARY PARAMETER
P6C   NOP            SECONDARY PARAMETER
P7    NOP           PASSED PARAMETER #7 
P8    NOP           PASSED PARAMETER #8 
P9    NOP           PASSED PARAMETER #9 
* 
R1    NOP           RETURN PARAMETER #1 (ERROR CODE)
R2    NOP           RETURN PARAMETER #2 (DIRECTORY ADDRESS) 
R3    NOP           RETURN PARAMETER #3 (DIRECTORY ADDRESS) 
R4    NOP           RETURN PARAMETER #4 (FILE DISC ADDRESS) 
R5    NOP           RETURN PARAMETER #5 (FILE DISC ADDRESS) 
* 
#FMT  DEC 14        SECTOR SKIP VALUE FOR DIRECTORY 
##SEC NOP           NUMBER OF SECTORS/TRACK 
* 
      IFN           *** L/10 CODE *** 
CDA   DEF $CDIR+0   CARTRIDGE LIST ADDRESS  
CDSZ  DEC 4         CARTRIDGE LIST ENTRY SIZE 
CD#   NOP           CARTRIDGE LIST NUMBER OF ENTRIES  
      XIF 
      IFZ           *** XL CODE *** 
CDA   NOP           LOCAL COPY OF $CDA
CDSZ  NOP           LOCAL COPY OF $CDSZ 
CD#   NOP           LOCAL COPY OF $CD#
      XIF 
* 
SBUF  NOP           (RBLOK) ADDRESS OF DIRECTORY BUFFER 
SBUFL NOP           (RBLOK) LENGTH (IN WORDS) OF SBUF 
SBFLN NOP           (RBLOK) LENGTH (IN SECTORS) OF SBUF 
SBFLM NOP           (RBLOK) SECTOR LIMIT OF SBUF
* 
WORD# NOP           (RBLOK) NUMBER OF WORDS TO READ 
RSECT NOP           (RBLOK) REQUESTED SECTOR (REVISED)
* 
OFLAG NOP           (OPEN) FILE OPEN FLAG 
* 
EXTNM NOP           (N.SHR) EXTENT NUMBER 
HIEXT NOP           (N.SHR) HIGHEST EXTENT OF FILE
OPNTR NOP           (N.SHR) FIRST OPEN ENTRY TRACK ADDRESS
OPNSC NOP           (N.SHR) FIRST OPEN ENTRY SECTOR ADDRESS 
OPNWD NOP           (N.SHR) FIRST OPEN ENTRY WORD OFFSET
SNAME NOP           (N.SHR) SEARCH NAME ADDRESS 
* 
FPTR  NOP           (FLAG) POINTER TO OPEN FLAG 
VALDF NOP           (VALID) FLAG TO BE TESTED 
ACTVF NOP           (DISMT) DISC-ACTIVE FLAG
* 
TMP1  NOP           GENERAL TEMPORARY 
TMP2  NOP           GENERAL TEMPORARY 
TMP3  NOP           GENERAL TEMPORARY 
TMP4  NOP           GENERAL TEMPORARY 
TMP5  NOP           GENERAL TEMPORARY 
* 
CALTR NOP           (TSTDR) CALCULATED NEXT TRACK 
CALSC NOP           (TSTDR) CALCULATED NEXT SECTOR
FLGCT NOP           (TSTDR) OPEN FLAG COUNT 
* 
NAME  BSS 9         TEMPORARY FILE ENTRY
* 
DIRA  NOP           - THE NEXT 10 WORDS MUST REMAIN IN ORDER
      NOP           ! (THEY CONTAIN THE ADDRESSES TO A
      NOP           !  FILE ENTRY WITH THE CURRENT BUFFER)
TYPEA NOP           ! 
TRAKA NOP           ! 
SECTA NOP           ! 
SIZEA NOP           ! 
RL    NOP           ! 
SC    NOP           ! 
FLAGA NOP           - 
* 
EMPT1 NOP           - THIS WORD MUST BE ZERO TO ALLOW CLEAR 
CLABL NOP           ! THE NEXT 16 WORDS MUST REMAIN IN ORDER
      NOP           ! (THEY CONTAIN THE CONTENTS OF THE CURRENT 
      NOP           !  CARTRIDGE ENTRY) 
CCRN  NOP           ! 
FRSTR NOP           ! 
NXSEC NOP           ! 
#SECT NOP           ! 
LASTR NOP           ! 
N#TRK NOP           ! 
NXTR  NOP           ! 
BAD1  NOP           ! 
      NOP           ! 
      NOP           ! 
      NOP           ! 
      NOP           ! 
      NOP           - 
* 
LU    NOP           - THE NEXT 4 WORDS MUST REMAIN IN ORDER 
DRTRK NOP           ! (THEY CONTAIN A LOCAL COPY OF THE CURRENT 
CRN   NOP           !  CARTRIDGE LIST ENTRY)  
LKWD  NOP           - 
* 
*     THE FOLLOWING VARIABLES ARE CLEARED IF D.RTR IS "OF'ED" AND 
*     DOESN'T COMPLETE NORMALLY 
*     THE NEXT 21 WORDS MUST REMAIN IN ORDER
* 
EMPT2 NOP           - (FOR CLEAR) THIS WORD MUST REMAIN EMPTY 
TRACK NOP           ! (RBLOK) REQUESTED DISC TRACK
SECT  NOP           ! (RBLOK) REQUESTED DISC SECTOR 
PDSLU NOP           ! (RBLOK) DISC LU WITH PROTECT BITS 
PLU   NOP           ! PREVIOUS LU (FOR DISC SEARCH) 
* 
LLU   NOP           ! (RBLOK) LAST DIRECTORY LU 
LTRAC NOP           ! (RBLOK) LAST TRACK
LSECT NOP           ! (RBLOK) LAST SECTOR READ/WRITTEN
* 
NSEC  NOP           ! (RBLOK) NEGATIVE OF SECTOR BEYOND BUFFER
C.BFL NOP           ! (RBLOK) CURRENT BUFFER LENGTH IN SECTORS
ABUF  NOP           ! REQUESTED BLOCK STARTING ADDRESS
ENDAD NOP           ! REQUESTED BLOCK ENDING ADDRESS
* 
BADTR NOP           ! BAD TRACK POINTER 
* 
DIRAD NOP           ! (C.SHR) CARTRIDGE LIST INDEX  
ENTAD NOP           ! (C.SHR) CARTRIDGE LIST ENTRY ADDRESS  
OFSET NOP           ! (C.SHR) ID WORD OFFSET
* 
WCS   NOP           ! #0 INDICATES DIRTY DIRECTORY BLOCK
WHE   NOP           ! #0 INDICATES DIRTY HEADER ENTRY 
* 
      NOP           - NOT USED
* 
A     EQU 0 
B     EQU 1 
      HED D.RTR (D.RTR): MAIN EXECUTION SECTION 
D.RTR LDA AEMP2     SET UP TO CLEAR TEMPORARIES 
      LDB A          GET SAME ADDRESS 
      INB             AND INCREMENT BY ONE
      JSB .MVW
      DEF .20 
      NOP 
* 
      JSB LIMEM     TRY GETTING SOME MEMORY 
      DEF *+4 
      DEF ZERO      ALLOCATE
      DEF SBUF      BUFFER ADDRESS
      DEF SBUFL     AVAILABLE MEMORY LENGTH 
* 
      LDA SBUFL     GET THE LENGTH
      LSR 6          CONVERT TO SECTORS 
      STA SBFLN       AND SAVE AS SBUF SECTOR LENGTH
      LDA .2        USE DEFAULT SBFLM 
      STA SBFLM 
* 
      IFN           *** L/10 CODE *** 
      LDA CDA       GET CARTRIDGE LIST START ADDRESS  
      CMA,INA        SUBTRACT FROM
      ADA $MDSP       CARTRIDGE LIST END ADDRESS  
      CLB              CLEAR FOR DIVIDE 
      DIV CDSZ          DIVIDE BY ENTRY SIZE
      STA CD#            SAVE NUMBER OF ENTRIES 
      XIF 
* 
      IFZ           *** XL CODE *** 
      JSB .XLD      FETCH A LOCAL COPY OF 
      DEF $CDA+0     CARTRIDGE LIST START ADDRESS 
      STA CDA 
* 
      JSB .XLD      FETCH A LOCAL COPY OF 
      DEF $CDSZ+0    CARTRIDGE LIST ENTRY SIZE  
      STA CDSZ
* 
      JSB .XLD      FETCH A LOCAL COPY OF 
      DEF $CD#+0     CARTRIDGE LIST NUMBER OF ENTRIES 
      STA CD# 
      XIF 
      HED D.RTR (D.RT1) GET PARAMETERS AND RETRIEVE LU
D.RT1 JSB EXEC      RETRIEVE PASSED PARAMETERS
      DEF *+5        VIA STRING PASSAGE 
      DEF NAB14       ROUTINE (DON'T ABORT) 
      DEF .1        TO GET STRING FROM 'FATHER' 
      DEF ID        WHERE TO PUT THE STRING 
      DEF .12       LENGTH OF STRING
      JMP EX101      TAKE ILLEGAL PARAMETER EXIT
* 
      LDA P2        FETCH -LU/+CR/0 OR TR,LU DISC ID WORD 
      LDB P1        FETCH FUNCTION CODE 
      SLB           IF FUNCTION ODD,
      JMP ENTR2      THEN CONTINUE
* 
      AND B77       EXTRACT LU FROM REQUESTED DISC ID 
      CMA,INA        NEGATE 
* 
ENTR2 STA PLU       SAVE ID 
      JSB C.SHR     LOCATE ID IN CARTRIDGE LIST 
      JMP NEXT5      IF NOT FOUND, THEN CHECK FOR CARTRIDGE CONTROL 
      HED D.RTR (NEXT6): MAKE CARTRIDGE ENTRY COPY AND VALIDATE 
* 
*     MAKE COPY OF CARTRIDGE LIST ENTRY 
* 
NEXT6 LDA CDSZ      SET UP TRANSFER LENGTH FOR .MWF 
      JSB .CAX
      LDA ENTAD     GET ENTRY ADDRESS 
      LDB ALU       GET LOCAL CARTRIDGE ENTRY ADDRESS 
      JSB .MWF      GET CARTRIDGE LIST ENTRY  
* 
*     CHECK LOCK WORD FOR VALIDITY
* 
      LDA LKWD      GET LOCK WORD 
      JSB VALID     IF LOCK WORD IS VALID,
      RSS 
      JMP NEXT7      THEN CONTINUE
* 
      CLA           CLEAR LOCK WORD 
      STA LKWD
      JSB WCDIR     GO WRITE NEW ENTRY
* 
NEXT7 LDA LKWD      GET LOCK WORD AGAIN 
      SZA           IF NOT LOCKED 
      CPA ID         OR LOCKED TO CALLER, 
      JMP DECOD       THEN CONTINUE 
* 
      LDA PLU       GET PREVIOUS ID 
      SZA           IF NOT MULTI-DISC SEARCH, 
      JMP EX13       THEN TAKE LOCKED DISC ERROR EXIT 
* 
NEXT  LDA PLU       GET PREVIOUS ID 
      SZA           IF SPECIFIC DISC REQUEST, 
      JMP CKERR      THEN DETERMINE ERROR AND EXIT
* 
      LDB DIRAD     GET DIRECTORY INDEX 
      CPB CD#       IF AT END OF DIRECTORY, 
      JMP CKERR      THEN DETERMINE ERROR AND EXIT
* 
      ISZ DIRAD     INCREMENT INDEX 
      LDA ENTAD     GET ENTRY ADDRESS 
      ADA CDSZ       ADD ENTRY SIZE 
      STA ENTAD       SAVE AGAIN
* 
      JSB .XLD      GET LU FROM CARTRIDGE LIST
      DEF A,I 
      SZA           IF NOT END OF DIRECTORY,
      JMP NEXT6      THEN GET NEXT CARTRIDGE ENTRY
      JMP CKERR      ELSE DETERMINE ERROR AND EXIT
* 
*     ENTRY NOT FOUND, CHECK FOR CARTRIDGE CONTROL
* 
NEXT5 LDA P1        FETCH FUNCTION CODE 
      CPA .7        IF NOT CARTRIDGE CONTROL, 
      RSS 
      JMP CKER       THEN DETERMINE ERROR AND EXIT
* 
      LDA P3        PUT LU
      STA LU         INTO WORKING ENTRY 
* 
      LDA P4        PUT LAST TRACK
      STA DRTRK      INTO WORKING ENTRY 
* 
      JSB RHEAD     GET DISC CARTRIDGE HEADER 
* 
      LDA P7        FETCH SUBFUNCTION CODE
      CPA N2        IF "MC" CALL, 
      JMP MOUNT      THEN GO TO MOUNT ROUTINE 
* 
      CPA N1        IF "IN" CALL, 
      JMP UPDAT      THEN GO TO UPDAT ROUTINE 
* 
*     CHECK FOR PROPER ERROR
* 
CKER  LDA PLU       GET DISC SPECIFICATION
      SZA           IF SPECIFIC DISC REQUEST, 
      JMP EX32       THEN WE MUST HAVE NOT FOUND DISC 
* 
CKERR LDA P1        GET FUNCTION CODE PARAMETER 
      CPA .1        IF CREATE CALL, 
      JMP EX33       THEN TAKE NOT ENOUGH ROOM ERROR EXIT 
      JMP EX6        ELSE TAKE FILE NOT FOUND ERROR EXIT
      HED D.RTR (DECOD): DECODE REQUEST AND JUMP TO ROUTINE 
DECOD LDA P1        GET FUNCTION CODE 
      SSA           IF NEGATIVE REQUEST CODE, 
      JMP EX101      THEN TAKE ILLEGAL REQUEST ERROR EXIT 
* 
      STA B         COMPARE REQUEST CODE
      ADB TABLN 
      SSB,RSS       IF REQUEST CODE TOO HIGH, 
      JMP EX101      THEN TAKE ILLEGAL REQUEST ERROR EXIT 
* 
      CPA .7        IF NOT CARTRIDGE CONTROL REQUEST, 
      RSS 
      JSB RHEAD      THEN READ CARTRIDGE HEADER 
* 
      LDA P1        GET FUNCTION CODE AGAIN 
      ADA AJTAB      CALCULATE TABLE INDEX
      JMP A,I         GO EXECUTE THE FUNCTION 
* 
JTABL JMP CLOSE     ( 0) CLOSE FILE 
      JMP CREAT     ( 1) CREATE FILE
      JMP CNAM      ( 2) CHANGE NAME
      JMP RLOCK     ( 3) LOCK CARTRIDGE 
      JMP TRUNC     ( 4) TRUNCATE FILE
      JMP ULOCK     ( 5) UNLOCK CARTRIDGE 
      JMP EXOPN     ( 6) OPEN EXTENT FOR READ 
      JMP DISMT     ( 7) DISMOUNT CARTRIDGE 
      JMP EXOPN     ( 8) OPEN EXTENT FOR WRITE
      JMP OPEN      ( 9) OPEN FILE
      JMP EX101     (10) ILLEGAL REQUEST
      JMP PURGE     (11) PURGE FILE 
* 
TABLN ABS JTABL-*   LENGTH OF JUMP TABLE (NEGATIVE) 
      HED D.RTR (EXIT): ERROR EXIT SECTION
EX1   LDA N1        DISC ERROR EXIT 
      JMP FEXIT 
EX2   LDA N2        DUPLICATE NAME ERROR EXIT 
      JMP FEXIT 
EX5   LDA N5        EXTENT BEYOND END OF FILE ERROR EXIT
      JMP FEXIT 
EX6   LDA N6        FILE NOT FOUND ERROR EXIT 
      JMP FEXIT 
EX7   LDA N7        ILLEGAL FILE SECURITY CODE ERROR EXIT 
      JMP FEXIT 
EX8   LDA N8        FILE ALREADY OPEN (AND LOCK REJECT) ERROR EXIT
      JMP FEXIT 
EX11  LDA N11       FILE NOT OPEN ERROR EXIT
      JMP FEXIT 
EX12  LDA .12       DUPLICATE LU/DUPLICATE LABEL ERROR EXIT 
      JMP FEXIT 
EX13  LDA N13       DISK LOCKED ERROR EXIT
      JMP FEXIT 
EX14  LDA N14       FILE DIRECTORY FULL ERROR EXIT
      JMP FEXIT 
EX32  LDA N32       DISC NOT FOUND ERROR EXIT 
      JMP FEXIT 
EX33  LDA N33       NO ROOM LEFT ERROR EXIT 
      JMP FEXIT 
EX37  LDA N37       ILLEGAL ACCESS TO ACTIVE PROGRAM OR SWAP FILE ERROR EXIT
      JMP FEXIT 
EX38  LDA .38       ATTEMPT TO REMOVE ACTIVE PROGRAM OR SWAP FILE ERROR EXIT
      JMP FEXIT 
EX46  LDA N46       TOO MANY EXTENTS ERROR EXIT 
      JMP FEXIT 
EX62  LDA .62       CARTRIDGE LIST FULL ERROR EXIT
      JMP FEXIT 
* 
EX99  LDA .1        DISC READ/WRITE ABORT ERROR EXIT
      JMP EXIT2 
EX101 LDA N1        ILLEGAL PARAMETERS ERROR EXIT 
      JMP EXIT2 
EX102 LDA N2        ILLEGAL CALL SEQUENCE ERROR EXIT
      JMP EXIT2 
* 
EX103 LDA ID        CORRUPT DISC DIRECTORY ERROR EXIT 
      STA LKWD      LOCK DISC TO CALLING PROGRAM
      JSB WCDIR      AND WRITE NEW ENTRY
      LDA N3
      JMP EXIT2 
* 
EX104 LDA N4        EXTENT NOT FOUND ERROR EXIT 
* 
EXIT2 ADA N100
      JMP FEXIT 
      HED D.RTR (EXIT): NORMAL AND FAIL EXIT SECTION
EXIT  CLA           NO ERROR INTENDED 
      JMP FEXIT 
* 
OPEX  JSB RSTR      RETURN FILE INFORMATION 
      LDB TYPEA,I   GET FILE TYPE 
      SZB,RSS       IF TYPE ZERO, 
      CLA,RSS        THEN RETURN ZERO ERROR CODE
      LDA SIZEA,I    ELSE RETURN FILE SIZE
* 
FEXIT JSB RPRM      SET THE RETURN PRAMS (ALSO FAIL EXIT) 
      JSB WHEAD     WRITE THE HEADER ENTRY (IF DIRTY) 
      JSB WBLOK     WRITE THE LAST BLOCK (IF DIRTY) 
* 
      JSB EXEC      FREE PROGRAM SCHEDULING 
      DEF *+4        D.RTR FROM WAIT
      DEF .6          BLOCK 
      DEF ZERO         AND TERMINATE SELF 
      DEF .1            SAVING RESOURCES
* 
      JMP D.RT1     RESPOND TO REQUEST
      HED D.RTR (OPEN): OPEN ACTION ROUTINE 
OPEN  LDA ID        GET OPEN FLAG 
      LDB P3        GET NAME WORD 1 
      RBL,CLE,ERB    REMOVE EXCLUSIVE-OPEN FROM NAME WORD 
      RAL,ERA        MOVE EXCLUSIVE-OPEN INTO OPEN FLAG 
      STA OFLAG       SAVE OPEN FLAG
* 
      STB NAME      PUT INTO THE NAME BUFFER
      DLD P4        GET NAME WORDS 2 AND 3
      DST NAME+1     PUT INTO THE NAME BUFFER 
* 
      LDA ANAME     SEARCH FOR FILE 
      JSB N.SHR     IF FILE NOT FOUND,
      JMP NEXT       THEN TRY NEXT DISC 
* 
      JSB FLAG      GET NUMBER OF OPEN FLAGS
      CLE,SZA       IF FILE NOT OPEN, THEN CLEAR FLAG 
      CCE            ELSE SET FLAG
      LDA OFLAG     GET OPEN FLAG 
      SEZ,SSA       IF FILE ALREADY OPEN, AND EXCLUSIVE OPEN, 
      JMP EX8        THEN TAKE FILE ALREADY OPEN ERROR EXIT 
* 
      JSB ACTV?     IF PROGRAM ACTIVE,
      CCE,RSS        THEN SET ACTIVE FLAG 
      CLE            ELSE CLEAR ACTIVE FLAG 
      LDA OFLAG     GET OPEN FLAG 
      SEZ,SSA       IF PROGRAM ACTIVE, AND EXCLUSIVE OPEN,
      JMP EX37       THEN TAKE PROGRAM ACTIVE ERROR EXIT
* 
      LDB N7        INITIALIZE COUNTER
      STB TMP1
* 
OPEN2 LDA FLAGA,I   GET A FLAG WORD 
      SSA           IF SIGN BIT SET,
      JMP EX8        THEN TAKE FILE ALREADY OPEN ERROR EXIT 
* 
      SZA,RSS       IF WORD EMPTY,
      JMP OPEN1      THEN OK TO OPEN
* 
      ISZ FLAGA     BUMP FLAG POINTER 
      ISZ TMP1      IF NOT FINISHED,
      JMP OPEN2      THEN TRY NEXT ONE
      JMP EX8        ELSE TAKE FILE ALREADY OPEN ERROR EXIT 
* 
*     OK TO OPEN
* 
OPEN1 LDA OFLAG     GET THE BUILT-UP OPEN FLAG
      STA FLAGA,I    PUT INTO THE ENTRY 
      ISZ WCS       INDICATE DIRTY BLOCK
      JMP OPEX       AND EXIT 
      HED D.RTR (EXOPN): EXTENT OPEN ACTION ROUTINE 
EXOPN JSB DIRCK     READ IN THE MAIN ENTRY
      LDA P4        GET THE EXTENT NUMBER 
      SZA,RSS       IF THIS THE MAIN? 
      JMP EXIT       THEN WE HAVE IT, SO EXIT 
* 
      AND B377      TEST EXTENT NUMBER
      CPA P4        IF EXTENT > 255,
      RSS 
      JMP EX46       THEN TAKE TOO MANY EXTENTS ERROR EXIT
* 
      STA B         SAVE THE EXTENT NUMBER FOR E.SHR
      ALF,ALF       SHIFT THE EXTENT INTO POSITION
      STA NAME+5     AND SAVE IN ENTRY BUFFER 
* 
      CLA           CLEAR OPEN FLAG OF EXTENT 
      STA ID
* 
      LDA NAME+3    USE FILE TYPE FROM DIRECTORY ENTRY
      STA P6A 
* 
      LDA NAME+6    USE FILE SIZE FROM DIRECTORY ENTRY
      STA P7
* 
      CCA           SET UP REUSABILITY
      STA OPNTR      SEARCH 
      LDA ANAME     SEARCH FOR REQUIRED EXTENT
      JSB E.SHR     IF EXTENT NOT FOUND,
      JMP EXOPT      THEN GO TEST IF READ 
      JMP EXIT       ELSE GO RETURN THE PRAMS 
* 
EXOPT LDB P1        GET FUNCTION REQUEST
      CPB .8        IF REQUEST IS EXTENT OPEN FOR WRITE,
      JMP CREA0       THEN GO CREATE A NEW EXTENT 
* 
      LDA P4        GET EXTENT NUMBER AGAIN 
      CMA,INA        SUBTRACT FROM
      ADA HIEXT       HIGHEST EXTENT NUMBER 
      SSA           IF EXTENT TOO HIGH, 
      JMP EX5        THEN TAKE EXTENT BEYOND END OF FILE EXIT 
      JMP EX104      ELSE TAKE EXTENT NOT FOUND EXIT
      HED D.RTR (CLOSE): CLOSE ACTION ROUTINE 
CLOSE JSB DIRCK     GET MAIN DIRECTORY ENTRY
* 
      JSB FLAG      CLEAR OPEN FLAG AND GET NUMBER OF OPEN FLAGS
      SZA           IF PROGRAM STILL OPEN,
      JMP EXIT       THEN JUST EXIT 
* 
      JSB ACTV?     IF PROGRAM WAS ACTIVE,
      JMP EXIT       THEN JUST EXIT 
* 
      LDA P4        GET TRUNCATE CODE 
      SZA,RSS       IF ZERO,
      JMP EXIT       THEN EXIT
* 
      SSA,RSS       IF POSITIVE,
      JMP EXPUR      THEN GO PURGE EXTENTS
* 
      ADA SIZEA,I   ADD FILE SIZE 
      JMP TRUN1      AND GO TRUNCATE FILE 
      HED D.RTR (TRUNC) TRUNCATE FILE ACTION ROUTINE
TRUNC JSB DIRCK     READ IN THE MAIN ENTRY
* 
      JSB FLAG      CLEAR OPEN FLAG, AND GET NUMBER OF OPEN FLAGS 
      SZA           IF FILE STILL OPEN, 
      JMP EX8        THEN TAKE FILE ALREADY OPEN EXIT 
* 
      LDA TYPEA,I   GET FILE TYPE 
      SZA,RSS       IF TYPE ZERO, 
      JMP EXIT       THEN EXIT (CAN'T TRUNCATE) 
* 
      LDA P4        GET NEW FILE SIZE 
* 
TRUN1 SSA,RSS       IF LESS THAN ZERO,
      SLA            OR ODD VALUE,
      JMP EXIT        THEN EXIT (IGNORE CALL) 
* 
      SZA,RSS       IF ZERO,
      JMP PURG1      THEN GO PURGE FILE 
* 
      STA SIZEA,I   SAVE NEW FILE SIZE
      JSB LAST?     IF NOT LAST FILE, 
      JMP EXPUR      THEN GO PURGE EXTENTS
* 
      JSB NXT/S     UPDATE NEW NEXT TRACK AND SECTOR
      JMP EXIT       AND EXIT 
      HED D.RTR (PURGE): PURGE AND EXPUR ROUTINES (PART OF CLOSE) 
PURGE LDA P3        SET NAME WORD 1 
      STA NAME       INTO NAME BUFFER 
      DLD P4        SET NAME WORDS 2 AND 3
      DST NAME+1     INTO NAME BUFFER 
* 
      LDA ANAME     SEARCH FOR FILE 
      JSB N.SHR     IF FILE NOT FOUND,
      JMP NEXT       THEN TRY NEXT DISC 
* 
      JSB FLAG      CLEAR OPEN FLAG, AND GET NUMBER OF OPEN FLAGS 
      SZA           IF FILE OPEN, 
      JMP EX8        THEN TAKE FILE ALREADY OPEN ERROR EXIT 
* 
      JSB ACTV?     IF PROGRAM ACTIVE,
      JMP EX37       THEN TAKE PROGRAM ACTIVE ERROR EXIT
* 
      LDA SC,I      GET ACTUAL SECURITY CODE
      SZA,RSS       IF ZERO,
      JMP PURG1      THEN SECURITY CODE ALWAYS MATCHES
* 
      CPA P6A       IF REQUESTED FILE SECURITY CODE MATCHES,
      JMP PURG1      THEN CONTINUE
* 
      SSA           IF ACTUAL CODE IS NEGATIVE, 
      JMP EX7        THEN MUST BE ERROR 
* 
      CMA,INA       TRY POSITIVE SECURITY CODE
      CPA P6A       IF REQUESTED SECURITY CODE DOESN'T MATCH, 
      RSS 
      JMP EX7        THEN TAKE ILLEGAL SECURITY CODE ERROR EXIT 
      SKP 
* 
*     OK TO PURGE 
* 
PURG1 JSB LAST?     IF NOT LAST FILE, 
      CCA,RSS        THEN JUST MARK PURGED
      CLA            ELSE MARK END-OF-DIRECTORY 
* 
PURG2 STA DIRA,I    SAVE FLAG WORD
      ISZ WCS       INDICATE DIRTY BLOCK
* 
      SZA           IF JUST PURGED, 
      JMP EXPUR      THEN LOOK FOR EXTENTS
* 
      JSB BCKUP     BACK UP TO PREVIOUS ENTRY 
      JMP PURG4      IF AT PBOD, THEN FINISHED
* 
      LDA DIRA,I    GET FIRST WORD
      INA,SZA,RSS   IF PURGED,
      JMP PURG2      THEN MARK AS EOD AND TRY PREVIOUS ENTRY
* 
PURG3 LDA TYPEA,I   GET FILE TYPE 
      SZA           IF DISC FILE, 
      JMP PURG4      THEN CONTINUE
* 
      JSB BCKUP     BACK UP TO PREVIOUS ENTRY 
      JMP PURG4      IF AT PBOD, THEN FINISHED
      JMP PURG3      AND LOOK AT TYPE 
* 
PURG4 JSB NXT/S     UPDATE NEW TRACK AND SECTOR 
      JMP EXIT       AND EXIT 
      HED D.RTR (EXPUR): PURGE AN EXTENT SUBACTION ROUTINE
EXPUR LDA ANAME     LOOK FOR FILE 
      CCB            FIND ANY EXTENT
      JSB E.SHR     IF EXTENT NOT FOUND,
      JMP EXIT       THEN EXIT
      JMP PURG1      ELSE GO PURGE EXTENT 
      HED D.RTR (CREAT): CREATE ACTION ROUTINE
CREAT CLE           MOVE CREATE PARAMETERS
      LDA AP3        INTO ENTRY BUFFER
      JSB MOVE
* 
      CLA           SET FOR EXTENT ZERO (MAIN)
      LDB P6A       GET FILE TYPE 
      SZB           IF NOT TYPE ZERO, 
      STA NAME+5     SET EXTENT NUMBER INTO ENTRY BUFFER
* 
      CCA           SET FLAG
      STA OPNTR      FOR ENTRY RE-USABILITY 
* 
      LDA ANAME     FIND THE MAIN ENTRY 
      JSB N.SHR     IF NAME ALREADY EXISTS, 
      RSS 
      JMP EX2        THEN TAKE DUPLICATE NAME ERROR EXIT
* 
CREA0 LDB OPNTR     GET RE-USABLE ENTRY TRACK ADDRESS 
      SSB,RSS       IF RE-USABLE ENTRY FOUND, 
      JMP RUSE       THEN GO SET IT UP
* 
      SZA           IF DIRECTORY NOT FULL,
      JMP CRSET      THEN GO SET UP ADDRESSES 
* 
      LDB PLU       GET DISC SPECIFICATION
      SZB           IF SPECIFIC DISC REQUEST, 
      JMP EX14       THEN TAKE DIRECTORY FULL ERROR EXIT
* 
      LDA P1        GET FUNCTION CODE 
      CPA .8        IF EXTENT WRITE (CREATE)
      JMP EX14       THEN TAKE DIRECTORY FULL ERROR EXIT
      JMP NEXT       ELSE TRY NEXT DISC 
      SKP 
* 
*     CHECK DATA AREA FOR OVERLAPS WITH BAD TRACKS
* 
CRSET LDA P6A       GET REQUESTED FILE TYPE 
      SZA,RSS       IF TYPE ZERO, 
      JMP CREA2      THEN SKIP SIZE CALCULATIONS
* 
      LDB ANXTR     GET BAD TRACK POINTER -1
* 
CHKBT INB           BUMP TO BAD TRACK ADDRESS 
      LDA B,I        GET IT 
      SZA,RSS       IF END OF LIST, 
      JMP EOL        THEN CONTINUE
* 
      CMA,CLE       COMPARE BAD TRACK 
      ADA NXTR       WITH NEXT AVAILABLE TRACK
      SEZ           IF NOT PAST NEXT AVAILABLE TRACK, 
      JMP CHKBT      THEN TRY NEXT BAD TRACK
* 
EOL   STB BADTR     SAVE BAD TRACK POINTER
      LDA NXTR      GET THE NEXT TRACK
      LDB NXSEC      AND SECTOR FROM HEADER 
* 
CREA1 STA TMP1      SAVE TRACK
      STB TMP2       AND SECTOR ADDRESS 
      CMB,INB         NEGATE
      STB TMP3         AND SAVE FOR SUBTRACTION 
* 
      LDB BADTR,I   GET BAD TRACK ADDRESS 
      SZB,RSS       IF ZERO,
      LDB LASTR      THEN USE LAST TRACK
* 
      CMA,INA       COMPUTE MAXIMUM FILE SIZE AVAILABLE 
      ADA B          REMAINING ON DISC
      MPY ##SEC 
      ADA TMP3      SUBTRACT NUMBER OF SECTORS USED ON THIS TRACK 
      SZB,RSS       IF MORE 
      SSA            THAN 32K SECTORS 
      LDA MAXSZ       THEN GET MAXIMUM ALLOWABLE (32K SECTORS)  
* 
      SZA,RSS       IF NO SPACE AVAILABLE,
      JMP CREA5      THEN FILE CAN'T FIT
* 
      LDB P7        GET REQUESTED FILE SIZE 
      SSB           IF REMAINING SPACE REQUESTED, 
      LDB A          THEN GET MAXIMUM REMAINING 
* 
      STB NAME+6    SAVE FILE SIZE
      CMB,INB       COMPARE MAXIMUM REMAINING WITH REQUEST
      ADB A 
      SSB,RSS       IF FILE FITS, 
      JMP CREA4      THEN CONTINUE
* 
CREA5 LDA BADTR,I   GET BAD TRACK ADDRESS AGAIN 
      SZA,RSS       IF AT END OF BAD TRACK LIST 
      JMP CREA3      THEN CONTINUE
* 
      INA           CALCULATE NEW TRACK 
      CLB            AND SECTOR ADDRESS 
      ISZ BADTR       BUMP TO NEXT BAD TRACK
      JMP CREA1 
* 
CREA3 LDA P1        GET FUNCTION CODE 
      CPA .8        IF EXTENT CREATE, 
      JMP EX33       THEN TAKE DISC FULL ERROR EXIT 
      JMP NEXT       ELSE TRY NEXT DISC 
* 
CREA4 LDA TMP1      SAVE TRACK AND SECTOR 
      STA NAME+4     IN ENTRY BUFFER
      LDA TMP2
      ADA NAME+5
      STA NAME+5
* 
*     WRITE NEW ENTRY AND UPDATE DISC PARAMETERS
* 
CREA2 CCE 
      LDA DIRA      MOVE ENTRY INTO 
      JSB MOVE       DIRECTORY BLOCK
* 
      LDA ID        GET ID FLAG 
      IOR B100K      MERGE WITH EXCLUSIVE BIT 
      STA FLAGA,I     AND SAVE IN ENTRY 
      ISZ WCS       INDICATE DIRTY BLOCK
* 
      JSB NXT/S     UPDATE NEW NEXT TRACK AND SECTOR
      JMP OPEX       AND EXIT 
      SKP 
* 
*     WE HAVE A RE-USABLE ENTRY IN THE DIRECTORY AND WE NEED IT 
*     SO THE DIRECTORY BLOCK IS READ BACK IN (IF REQUIRED) AND
*     THE ENTRY IS SET UP.
* 
RUSE  LDA OPNTR     GET REUSABLE ADDRESS
      LDB OPNSC 
      STA TRACK     SAVE
      STB SECT
      JSB RBLOK     READ DIRECTORY BLOCK
* 
      LDA ABUF      GET CURRENT 
      ADA OPNWD      ENTRY ADDRESS
      JSB SETAD       SET UP ENTRY POINTERS 
* 
      LDA P6A       GET FILE TYPE 
      SZA,RSS       IF TYPE ZERO, 
      JMP RUSE1      THEN JUST WRITE NEW ENTRY
* 
      LDA TRAKA,I   SET THE OLD FILE ADDRESS
      STA NAME+4     IN THE ENTRY 
* 
      LDA SECTA,I   GET WORD CONTAINING EXTENT
      AND B377       CLEAR OLD EXTENT NUMBER
      ADA NAME+5      MERGE WITH NEW EXTENT NUMBER
      STA NAME+5       SET IN ENTRY 
* 
*     WRITE NEW ENTRY AND UPDATE DISC PARAMETERS
* 
RUSE1 CCE 
      LDA DIRA      MOVE ENTRY INTO 
      JSB MOVE       DIRECTORY BLOCK
* 
      LDA ID        GET ID FLAG 
      IOR B100K      MERGE WITH EXCLUSIVE BIT 
      STA FLAGA,I     AND SAVE IN ENTRY 
      ISZ WCS       INDICATE DIRTY BLOCK
      JMP OPEX      EXIT
      HED D.RTR (CNAM): CHANGE NAME ACTION ROUTINE
CNAM  CLE           SET UP THE NAME 
      LDA AP4        FOR NAME CHECK 
      JSB MOVE
* 
      LDA ANAME     FIND THE MAIN ENTRY 
      JSB N.SHR     IF FILE NAME ALREADY EXISTS,
      RSS 
      JMP EX2        THEN TAKE DUPLICATE NAME ERROR EXIT
* 
      JSB DIRCK     GO GET DIRECTORY ENTRY
* 
      JSB FLAG      CLEAR OPEN FLAG, AND GET NUMBER OF FLAGS
      SZA           IF FILE STILL OPEN, 
      JMP EX8        THEN TAKE FILE ALREADY OPEN EXIT 
* 
CNAM1 LDA P4        MOVE THE NEW NAME 
      STA DIRA,I     INTO THE FILE ENTRY
      DLD P5
      DST DIRA+1,I
      ISZ WCS       INDICATE DIRTY BLOCK
* 
      LDA ANAME     LOOK FOR FILE 
      CCB            FIND ANY EXTENT
      JSB E.SHR     IF EXTENT NOT FOUND,
      JMP EXIT       THEN EXIT
      JMP CNAM1      ELSE GO SET NEW NAME 
      HED D.RTR (RLOCK): LOCK DISC CARTRIDGE ACTION ROUTINE 
RLOCK LDA PLU       GET REQUESTED DISC LU 
      SZA,RSS       IF NOT SPECIFIED, 
      JMP EX101      THEN TAKE ILLEGAL D.RTR SEQUENCE ERROR EXIT
* 
      JSB TSTDR     IF ILLEGAL DIRECTORY
      JMP EX103      THEN TAKE CORRUPT DIRECTORY EXIT 
* 
      SZA           IF ANY OPEN FLAGS,
      JMP EX8        THEN TAKE LOCK REJECTED ERROR EXIT 
* 
      LDA ID        SAVE LOCK WORD
      STA LKWD
      JSB WCDIR     WRITE NEW ENTRY 
      JMP EXIT       AND TAKE NORMAL EXIT 
      HED D.RTR (ULOCK): UNLOCK DISC CARTRIDGE ACTION ROUTINE 
ULOCK LDA PLU       GET REQUESTED DISC LU 
      SZA,RSS       IF NOT SPECIFIED, 
      JMP EX101      THEN TAKE ILLEGAL D.RTR SEQUENCE ERROR EXIT
* 
      JSB TSTDR     IF ILLEGAL DIRECTORY
      JMP EX103      THEN TAKE CORRUPT DIRECTORY EXIT 
* 
      CLA           CLEAR LOCK WORD 
      STA LKWD
      JSB WCDIR      AND WRITE NEW ENTRY
      JMP EXIT      EXIT
      HED D.RTR (MOUNT): MOUNT DISC ACTION ROUTINE
MOUNT LDA CCRN      GET CARTRIDGE REFERENCE NUMBER
      STA CRN        SAVE IN WORKING ENTRY
      SZA           IF ZERO,
      SSA            OR NEGATIVE, 
      LDA N100        THEN CHANGE INTO LU WHICH CANNOT EXIST
      JSB C.SHR     IF CRN ALREADY IN USE,
      RSS 
      JMP EX12       THEN TAKE DUPLICATE LABEL EXIT 
* 
      SZA,RSS       IF AT END OF DIRECTORY, 
      JMP EX62       THEN TAKE CARTRIDGE LIST FULL ERROR EXIT 
* 
      LDA ID        PUT ID INTO LOCK WORD 
      STA LKWD
      JSB WCDIR      AND WRITE NEW CARTRIDGE LIST ENTRY 
      JMP EXIT      EXIT
      HED D.RTR (UPDAT): UPDATE DISC LABEL ACTION ROUTINE 
UPDAT LDA LU        GET ACTUAL LU 
      CMA,INA        NEGATE 
      JSB C.SHR     IF LU NOT FOUND,
      JMP EX32       THEN TAKE CARTRIDGE NOT FOUND EXIT 
* 
      LDA CDSZ      SET UP TRANSFER LENGTH FOR .MWF 
      JSB .CAX
      LDA ENTAD     GET ENTRY ADDRESS 
      LDB ALU       GET LOCAL CARTRIDGE ENTRY ADDRESS 
      JSB .MWF      GET CARTRIDGE LIST ENTRY
* 
      LDA P2        PUT NEW CRN 
      STA CRN        INTO WORKING ENTRY 
* 
      JSB WCDIR     WRITE NEW CARTRIDGE LIST ENTRY  
      JMP EXIT       AND EXIT 
      HED D.RTR (DISMT): DISMOUNT DISC ACTION ROUTINE 
DISMT LDA P7        FETCH SUBFUNCTION 
      SZA           THIS ENTRY IS USED BY "DC" ONLY 
      JMP EX12      DUPLICATE LU OR LABEL 
* 
*     CHECK IF DISC HAS SOMETHING ACTIVE ON IT
* 
      JSB .XLD      CHECK FOR SWAP FILE ACTIVE
      DEF $SWLU+0 
      CCB           PRESET FOR FAILURE
      CPA LU        IF SWAP FILE ON CARTRIDGE 
      JMP DISM3      THEN DISMOUNT IT (BUT REMOUNT LATER) 
* 
      JSB .XLD      GET NUMBER OF ID SEGMENTS 
      DEF $ID#+0
      CMA,INA 
      STA TMP2
* 
      JSB .XLD      GET ID SEGMENT TABLE ADDRESS
      DEF $IDA+0
      STA TMP1
* 
DISM2 LDA TMP1
      ADA .12       BUMP TO DORMANT WORD
      JSB .XLD       GET IT 
      DEF A,I 
      SZA,RSS       IF DORMANT, 
      JMP DISM1      THEN TRY NEXT ENTRY
* 
      LDA TMP1
      ADA .27       BUMP TO LU WORD 
      JSB .XLD       GET IT 
      DEF A,I 
      AND B377      ISOLATE LU PORTION
      CCB           PRESET B-REG FOR FAILURE
      CPA LU        IF SAME AS LU 
      JMP DISM3      THEN DISMOUNT IT (BUT REMOUNT LATER) 
* 
DISM1 JSB .XLD      ADVANCE TO NEXT 
      DEF $IDSZ+0    ID SEGMENT 
      ADA TMP1
      STA TMP1
* 
      ISZ TMP2      IF NOT FINISHED,
      JMP DISM2      THEN TRY NEXT ENTRY
* 
      CLB           CLEAR B-REG FOR SUCCESS 
* 
*     OK TO DISMOUNT
* 
DISM3 STB ACTVF     SAVE ACTIVE FLAG
      CLA           PREPARE FOR CLEAR 
      LDB LU        GET LU
      CPB LLU       IF LAST LU IS SAME AS CURRENT,
      STA LLU        CLEAR LAST LU
* 
*     REMOVE ENTRY FROM CARTRIDGE LIST
* 
      LDA DIRAD     CALCULATE 
      CMA            NUMBER OF
      ADA CD#         WORDS TO
      MPY CDSZ         MOVE 
      JSB .CAX          AND SAVE FOR .MWW 
* 
      JSB $LIBR     GO PRIVILEDGED
      NOP 
      LDB ENTAD     GET CARTRIDGE ENTRY ADDRESS FOR .MWI
      LDA B          MOVE TO A-REG
      ADA CDSZ        AND ADD ENTRY SIZE
      JSB .MWW      MOVE ENTRIES DOWN 
      CLA 
      JSB .XST      CLEAR FIRST WORD OF LAST ENTRY
      DEF B,I 
      JSB $LIBX     GO UNPRIVILEDGED
      DEF *+1        AND CONTINUE 
      DEF *+1 
* 
      ISZ ACTVF     IF DISC WASN'T ACTIVE,
      JMP EXIT       THEN JUST EXIT 
* 
*     REMOUNT CARTRIDGE 
* 
      LDA CRN       GET CARTRIDGE 
      JSB C.SHR      FIND ENTRY ADDRESS 
      NOP             SHOULDN'T GET HERE EVER 
      JSB WCDIR     WRITE NEW CARTRIDGE LIST ENTRY  
      JMP EX38       AND TAKE ERROR EXIT
      HED D.RTR (ACTV?): CHECK IF FILE IS ACTIVE
*     CALLING SEQUENCE: 
*     <SET UP DIRECTORY POINTERS> 
*     JSB ACTV? 
*     <ACTIVE RETURN: A,B,E = GARBAGE>
*     <NOT ACTIVE RETURN: A,B,E = GARBAGE>
* 
*     USES: TMP1, TMP2
* 
ACTV? NOP 
      JSB .XLD      GET SWAP FILE LU ADDRESS
      DEF $SWLU+0 
      CPA LU        IF NOT SAME AS CURRENT LU ADDRESS 
      RSS 
      JMP ACTV1      THEN OK
* 
      JSB .XLD      GET SWAP FILE TRACK ADDRESS 
      DEF $SWLU+1 
      CPA TRAKA,I   IF NOT SAME AS FILE DATA TRACK ADDRESS, 
      RSS 
      JMP ACTV1      THEN OK
* 
      JSB .XLD      GET SWAP FILE SECTOR ADDRESS
      DEF $SWLU+2 
      CPA SECTA,I   IF SAME AS FILE DATA SECTOR ADDRESS,
      JMP ACTV?,I    THEN TAKE ACTIVE EXIT
* 
ACTV1 LDA TYPEA,I   GET FILE TYPE 
      CPA .6        IF NOT TYPE 6,
      RSS 
      JMP ACTV2      THEN TAKE NOT ACTIVE EXIT
* 
      LDA SECTA,I   GET SECTOR ADDRESS
      ADA .2         BUMP BY 2
      CLB             SET UP FOR DIVIDE 
      DIV ##SEC       DIVIDE BY SECTORS / TRACK 
      BRS           CONVERT SECTORS TO BLOCKS 
      STB OPNSC      AND SAVE 
* 
      ADA TRAKA,I   ADD TRACK ADDRESS 
      STA OPNTR      AND SAVE 
* 
      JSB .XLD      GET ID SEGMENT TABLE ADDRESS
      DEF $IDA+0
      STA TMP1
* 
      JSB .XLD      GET NUMBER OF ID SEGMENTS 
      DEF $ID#+0
      CMA,INA        NEGATE 
      STA TMP2        AND SAVE FOR COUNTING 
* 
ACTV3 LDA TMP1      GET CURRENT ENTRY ADDRESS 
      ADA .12       BUMP TO DORMANT WORD
      JSB .XLD       GET IT 
      DEF A,I 
      SZA,RSS       IF DORMANT, 
      JMP ACTV4      THEN TRY NEXT ENTRY
* 
      LDA TMP1
      ADA .25       BUMP TO BLOCK WORD
      JSB .XLD       GET IT 
      DEF A,I 
      IFZ           *** XL CODE *** 
      ALF,ALF       ALIGN BLOCK 
      XIF 
      AND B377      ISOLATE BLOCK ADDRESS 
      CPA OPNSC     IF NOT SAME AS FILE BLOCK ADDRESS 
      RSS 
      JMP ACTV4      THEN TRY NEXT ENTRY
* 
      LDA TMP1
      ADA .26       BUMP TO TRACK WORD
      JSB .XLD       GET IT 
      DEF A,I 
      CPA OPNTR     IF NOT SAME AS FILE TRACK ADDRESS 
      RSS 
      JMP ACTV4      THEN TRY NEXT ENTRY
* 
      LDA TMP1
      ADA .27       BUMP TO LU WORD 
      JSB .XLD       GET IT 
      DEF A,I 
      AND B377      ISOLATE LU PORTION
      CPA LU        IF SAME AS LU 
      JMP ACTV?,I    THEN TAKE ACTIVE EXIT
* 
ACTV4 JSB .XLD      GET ID SEGMENT SIZE 
      DEF $IDSZ+0 
      ADA TMP1      BUMP TO NEXT SEGMENT
      STA TMP1
      ISZ TMP2      IF NOT FINISHED,
      JMP ACTV3      THEN TRY NEXT ENTRY
* 
ACTV2 ISZ ACTV?     BUMP TO SUCCESS RETURN
      JMP ACTV?,I    AND RETURN 
      HED D.RTR (BCKUP): LOCATE PREVIOUS ENTRY
*     CALLING SEQUENCE: 
*     <SET UP DIRECTORY POINTERS> 
*     JSB BCKUP 
*     <PBOD RETURN:   A,B,E = GARBAGE>
*     <NORMAL RETURN: A,B,E = GARBAGE>
* 
*     SETS UP PROPER DIRECTORY ADDRESSES
* 
BCKUP NOP 
      LDA DIRA      GET CURRENT ENTRY ADDRESS 
      CPA ABUF      IF NOT FIRST ENTRY OF BUFFER, 
      RSS 
      JMP BCKU1      THEN JUST POSITION ENTRY 
* 
      LDB SECT      GET CURRENT SECTOR ADDRESS
      SZB           IF NOT SECTOR ZERO, 
      JMP BCKU2      THEN JUST DECREMENT SECTOR 
* 
      LDA TRACK     GET CURRENT TRACK ADDRESS 
      CPA DRTRK     IF AT FIRST DIRECTORY TRACK,
      JMP BCKUP,I    THEN TAKE BOD EXIT 
* 
      ISZ TRACK     INCREMENT TRACK 
* 
BCKU2 CMB,INB       SUBTRACT
      ADB #FMT       SECTOR SKIP
      CMB,INB         FACTOR
      SSB           IF SECTOR WENT NEGATIVE,
      ADB ##SEC      THEN ADJUST IT 
      STB SECT      SAVE NEW SECTOR ADDRESS 
* 
      JSB RBLOK     READ THE BLOCK
      LDA ENDAD     GET THE ENDING BUFFER ADDRESS 
* 
BCKU1 ADA N16       POSITION TO PREVIOUS ENTRY
      JSB SETAD     SET UP NEW DIRECTORY ADDRESSES
      ISZ BCKUP     BUMP TO NORMAL RETURN ADDRESS 
      JMP BCKUP,I    AND RETURN 
      HED D.RTR (FORWD): LOCATE NEXT ENTRY
*     CALLING SEQUENCE: 
*     <SET UP DIRECTORY POINTERS> 
*     JSB FORWD 
*     <PEOD RETURN: A,B,E = GARBAGE>
*     <NORMAL RETURN: A,B,E = GARBAGE>
* 
*     SETS UP PROPER DIRECTORY ADDRESSES
* 
FORWD NOP 
      LDA DIRA      GET CURRENT ENTRY ADDRESS 
      ADA .16        POSITION TO NEXT ENTRY 
      CPA ENDAD     IF NOT LAST ENTRY OF BUFFER,
      RSS 
      JMP FRWD1      THEN JUST POSITION ENTRY 
* 
      LDA SECT      GET CURRENT SECTOR ADDRESS
      ADA #FMT       ADD SECTOR SKIP FACTOR 
      CLB 
      DIV ##SEC     DIVIDE BY SECTORS / TRACK 
      STB SECT       AND SAVE 
* 
      SZB           IF NOT SECTOR ZERO, 
      JMP FRWD2      THEN CONTINUE
* 
      LDA TRACK     GET CURRENT TRACK ADDRESS 
      CPA LASTR     IF AT LAST DIRECTORY TRACK, 
      JMP FORWD,I    THEN TAKE PEOD EXIT
* 
      ADA N1        DECREMENT TRACK ADDRESS 
      STA TRACK      AND SAVE 
* 
FRWD2 JSB RBLOK     READ THE BLOCK
* 
FRWD1 JSB SETAD     SET UP NEW DIRECTORY ADDRESSES
      ISZ FORWD     BUMP TO NORMAL RETURN ADDRESS 
      JMP FORWD,I   RETURN
      HED D.RTR (C.SHR): CARTRIDGE SEARCH (WITHIN CARTRIDGE LIST) 
*     CALLING SEQUENCE: 
*     <A = +CRN OR -LU TO BE LOCATED, OR
*        = 0 TO GET FIRST ENTRY>
*     JSB C.SHR 
*     <FAIL RETURN:    A = 0                  IF PEOD ENCOUNTERED,
*                   OR A = NEXT ENTRY ADDRESS IF LEOD ENCOUNTERED>
*     <SUCCESS RETURN: A = SYSTEM ENTRY ADDRESS>
* 
*     ALSO SETS UP DIRAD, ENTAD 
* 
C.SHR NOP 
      CLB           INITIALIZE DIRECTORY INDEX
      STB DIRAD 
      LDB CDA       INITIALIZE ENTRY ADDRESS
      STB ENTAD 
* 
      CLB           DEFAULT OFFSET TO ZERO (FOR LU) 
      SSA           IF GIVEN LU,
      CMA,INA,RSS    THEN SET POSITIVE, AND USE DEFAULT OFFSET
      LDB .2         ELSE USE PROPER OFFSET 
      STA TMP1      SAVE LU OR CRN
      STB OFSET     SAVE OFFSET 
* 
CSHR1 CLA           PRESET PEOD RETURN VALUE
      LDB DIRAD     GET CURRENT INDEX 
      CPB CD#       IF AT END OF DIRECTORY, 
      JMP C.SHR,I    THEN TAKE PEOD RETURN
* 
      LDA ENTAD     GET ENTRY ADDRESS 
      JSB .XLD       GET LU FROM CARTRIDGE LIST 
      DEF A,I 
      SZA,RSS       IF END OF DIRECTORY,
      JMP CSHR2      THEN TAKE LEOD RETURN
* 
      LDA TMP1      GET REQUESTED ID
      SZA,RSS       IF FIRST ENTRY REQUESTED, 
      JMP CSHR3      THEN TAKE SUCCESS RETURN 
* 
      LDA ENTAD     GET ENTRY ADDRESS 
      ADA OFSET      ADD OFFSET 
      JSB .XLD       GET ID FROM CARTRIDGE LIST 
      DEF A,I 
* 
      CPA TMP1      IF SAME AS REQUESTED LU OR CRN, 
      JMP CSHR3      THEN TAKE SUCCESS RETURN 
* 
      ISZ DIRAD     INCREMENT DIRECTORY INDEX 
      LDA CDSZ      GET ENTRY SIZE
      ADA ENTAD      ADD TO CURRENT ADDRESS 
      STA ENTAD       AND SAVE
      JMP CSHR1     TRY NEXT ENTRY
* 
*     SUCCESS AND LEOD EXITS
* 
CSHR3 ISZ C.SHR     SUCCESS; BUMP TO SUCCESS RETURN 
* 
CSHR2 LDA ENTAD     LEOD; RETURN ENTRY ADDRESS
      JMP C.SHR,I   RETURN
      HED D.RTR (CK.NM): CHECK NAMES FOR EQUALITY 
*     CALLING SEQUENCE: 
*     <A = ADDRESS OF FIRST NAME; 
*      B = ADDRESS OF SECOND NAME>
*     JSB CK.NM 
*     <NOT-EQUAL RETURN: A,B,E = GARBAGE> 
*     <EQUAL RETURN: A,B,E = GARBAGE> 
* 
CK.NM NOP 
      STA TMP1      SAVE FIRST NAME ADDRESS 
      STB TMP2      SAVE SECOND NAME ADDRESS
      LDB N3        PRESET COUNTER TO -3
* 
      LDA TMP1,I    GET 2 CHARACTERS FROM NAME
      CPA TMP2,I    IF SAME AS 2 CHARACTERS FROM OTHER NAME,
      INB            THEN BUMP COUNTER
* 
      ISZ TMP1
      ISZ TMP2
      LDA TMP1,I    GET 2 CHARACTERS FROM NAME
      CPA TMP2,I    IF SAME AS 2 CHARACTERS FROM OTHER NAME,
      INB            THEN BUMP COUNTER
* 
      ISZ TMP1
      ISZ TMP2
      LDA TMP1,I    GET 2 CHARACTERS FROM NAME
      CPA TMP2,I    IF SAME AS 2 CHARACTERS FROM OTHER NAME,
      INB            THEN BUMP COUNTER
* 
      SZB,RSS       IF NAMES MATCH (COUNTER = 0), 
      ISZ CK.NM      THEN BUMP RETURN ADDRESS 
      JMP CK.NM,I   RETURN
      HED D.RTR (DIRCK): READ A DIRECTORY ENTRY AND SET FLAGS 
*     CALLING SEQUENCE: 
*     JSB DIRCK 
*     <RETURN: A,B,E = GARBAGE> 
* 
DIRCK NOP 
      LDA P2        SET THE PASSED TRACK
      ASR 6          ALIGN TRACK, 
      AND B1777       ISOLATE,
      STA TRACK        AND SAVE IT
* 
      LDA P3        GET THE PASSED SECTOR 
      AND B377       ISOLATE, 
      STA SECT        AND SAVE IT 
      JSB RBLOK     READ THE BLOCK
* 
      LDA P3        GET THE PASSED SECTOR AGAIN 
      ALF,ALF        ALIGN OFFSET 
      AND B377        ISOLATE,
      ADA ABUF         ADD THE BUFFER ADDRESS 
      JSB SETAD     SET UP ENTRY POINTERS 
* 
      CLE 
      LDA DIRA
      JSB MOVE      MOVE ENTRY TO LOCAL STORAGE 
* 
      LDB N7        SET FOR 7 ENTRIES 
* 
DIRK1 LDA FLAGA,I   GET AN OPEN FLAG
      RAL,CLE,ERA    REMOVE EXCLUSIVE BIT 
      CPA ID        IF PROGRAM'S OPEN FLAG FOUND, 
      JMP DIRCK,I    THEN RETURN
* 
      ISZ FLAGA     TRY NEXT ONE
      INB,SZB       IF MORE FLAGS,
      JMP DIRK1      THEN CONTINUE
      JMP EX11       ELSE TAKE NOT OPEN TO CALLER ERROR EXIT
      HED D.RTR (RHEAD): READ CARTRIDGE HEADER ENTRY
*     CALLING SEQUENCE: 
*     JSB RHEAD 
*     <RETURN: A,B,E = GARBAGE> 
* 
RHEAD NOP 
      LDA LU        GET DIRECTORY LU
      IOR B7700     SET PROTECT BITS
      STA PDSLU      AND SAVE FOR EXEC
* 
      LDA AEMP1     CLEAR CARTRIDGE HEADER
      LDB A 
      INB 
      JSB .MVW
      DEF .16 
* 
      JSB EXEC      READ NEW CARTRIDGE HEADER 
      DEF *+7 
      DEF NAB1      READ (DON'T ABORT)
      DEF PDSLU 
      DEF CLABL 
      DEF .16 
      DEF DRTRK 
      DEF ZERO
      JMP EX99      ERROR; TAKE EXEC ABORT ERROR EXIT 
* 
      CPB .16       IF 16 WORDS NOT TRANSFERRED,
      RSS 
      JMP EX1        THEN TAKE DISC ERROR EXIT
* 
      LDA #SECT     GET SECTORS/TRACK,OFFSET
      ALF,ALF        SHIFT INTO POSITION
      AND B377        ISOLATE SECTOR SKIP FACTOR
      SZA,RSS       IF ZERO,
      LDA DSKIP      THEN USE DEFAULT SKIP FACTOR 
      STA #FMT      SAVE IT 
* 
      LDA #SECT     GET SECTOR/TRACK,OFFSET 
      AND B377       ISOLATE SECTORS/TRACK
      STA ##SEC     SAVE IT 
* 
      LDA SBFLN     GET THE SBUF LENGTH 
      ADA N2         CALCULATE LARGEST SBFLM
      CLB             SET UP FOR DIVIDE 
      DIV #FMT
      MPY #FMT
      ADA .2
      STA SBFLM     AND SAVE AS SBUF LIMIT
* 
      JMP RHEAD,I    AND RETURN 
      HED D.RTR (FID): TEST CARTRIDGE HEADER FOR LEGALITY 
*     CALLING SEQUENCE: 
*     JSB FID 
*     <FAIL RETURN: A,B,E = GARBAGE>
*     <SUCCESS RETURN: A,B,E = GARBAGE> 
* 
FID   NOP 
      LDB CLABL     GET FIRST LABEL WORD
      SSB,RSS       IF SIGN BIT NOT SET,
      JMP FID,I      THEN CORRUPT DIRECTORY 
* 
      LDB CCRN      GET CARTRIGE REFERENCE NUMBER 
      SSB,RSS       IF NOT POSITIVE,
      SZB,RSS        OR ZERO, 
      JMP FID,I       THEN CORRUPT DIRECTORY
* 
      LDB N#TRK     GET NEGATIVE NUMBER OF DIRECTORY TRACKS 
      SSB,RSS       IF NOT NEGATIVE,
      JMP FID,I      THEN CORRUPT DIRECTORY 
* 
      LDB FRSTR     GET FIRST AVAILABLE TRACK 
      SSB           IF LESS THAN ZERO,
      JMP FID,I      THEN CORRUPT DIRECTORY 
* 
      CMB,INB       NEGATE
      ADB NXTR       AND COMPARE TO NEXT AVAILABLE TRACK
      SSB           IF FIRST PAST NEXT TRACK, 
      JMP FID,I      THEN CORRUPT DIRECTORY 
* 
      LDB NXTR      GET NEXT AVAILABLE FMP TRACK
      CMB,INB        NEGATE 
      ADB LASTR       AND COMPARE TO LAST FMP TRACK + 1 
      SSB           IF NEXT PAST LAST TRACK,
      JMP FID,I      THEN CORRUPT DIRECTORY 
* 
      ISZ FID       BUMP TO SUCCESS RETURN
      JMP FID,I      AND RETURN 
      HED D.RTR (FLAG): CHECK FOR VALID OPEN FLAGS/ 
*     CALLING SEQUENCE: 
*     <SET UP DIRECTORY POINTERS> 
*     JSB FLAG
*     <RETURN: A = NUMBER OF OPEN FLAGS>
* 
FLAG  NOP 
      CLA           CLEAR NUMBER OF 
      STA TMP5       OPEN FLAGS FOUND 
      LDA N7        SET UP COUNT
      STA TMP4       FOR NUMBER OF POSSIBLE OPEN FLAGS
      LDA SC        GET FLAG AREA 
      INA            POINTER
      STA FPTR        AND SAVE
* 
FLAG1 LDA FPTR,I    GET AN OPEN FLAG
      RAL,CLE,ERA    CLEAR EXCLUSIVE OPEN BIT 
      CPA ID        IF FLAG IS EQUAL TO CURRENT PROGRAM 
      JMP FLAG2       THEN FORCE CLOSED 
* 
      LDA FPTR,I    GET OPEN FLAG AGAIN 
      JSB VALID     IF OPEN FLAG IS INVALID 
      JMP FLAG2      THEN GO CLEAR FLAG WORD
* 
      SZA           IF FLAG IS NOT ZERO,
      ISZ TMP5       THEN INCREMENT VALID OPEN FLAG COUNT 
      JMP FLAG4       AND CONTINUE
* 
FLAG2 CLA           INVALID FLAG; SO CLEAR OPEN FLAG
      STA FPTR,I     SAVE OPEN FLAG 
      ISZ WCS       INDICATE DIRTY BLOCK
* 
FLAG4 ISZ FPTR      INCREMENT OPEN FLAG POINTER 
      ISZ TMP4      INCREMENT LOOP COUNTER; IF NOT DONE,
      JMP FLAG1      THEN DO NEXT OPEN FLAG 
* 
      LDA TMP5      GET FLAG COUNT
      JMP FLAG,I     AND EXIT 
      HED D.RTR (LAST?): TEST IF CURRENT ENTRY IS LAST ON DIRECTORY 
*     CALLING SEQUENCE: 
*     <SET UP DIRECTORY POINTERS> 
*     JSB LAST? 
*     <FAIL RETURN: A,B,E = GARBAGE>
*     <SUCCESS RETURN: A,B,E = GARBAGE> 
* 
LAST? NOP 
      JSB FORWD     POSITION TO NEXT ENTRY
      JMP LST?1      IF PEOD, THEN MUST HAVE BEEN LAST ENTRY
* 
      LDA DIRA,I    GET FIRST WORD OF NEXT ENTRY
      STA TMP1       AND SAVE TEMPORARILY 
      JSB BCKUP     POSITION BACK TO ORIGINAL ENTRY 
      NOP            CAN'T BE PBOD
* 
      LDA TMP1      GET FIRST WORD OF NEXT ENTRY
      SZA,RSS       IF END OF DIRECTORY,
* 
LST?1 ISZ LAST?      THEN BUMP TO SUCCESS RETURN
      JMP LAST?,I   RETURN
      HED D.RTR MOVE: MOVE DIRECTORY ENTRIES AROUND 
*     CALLING SEQUENCE: 
*     <E := 0, A = SOURCE ADDRESS> OR 
*       <E := 1, A = DESTINATION ADDRESS> 
*     JSB MOVE
*     <RETURN: A,B,E = GARBAGE> 
* 
*     MOVE TRANSFERS 9 WORDS INTO/FROM NAME BUFFER
* 
MOVE  NOP 
      LDB ANAME     SET B TO ADDRESS OF NAME BUFFER 
      SEZ           IF MOVE TO DESTINATION, 
      SWP            THEN SWITCH CONTENTS OF A AND B
* 
      JSB .MVW      NOW MOVE PARAMETERS 
      DEF .9        9 PARAMETERS REQUIRED 
      NOP 
      JMP MOVE,I    RETURN
      HED D.RTR (N.SHR): SEARCH DIRECTORY FOR NAME
*     CALLING SEQUENCE: 
*     <A = ADDRESS OF TARGET NAME ARRAY;
*      B = EXTENT NUMBER TO FIND (OR -1 FOR ANY) (E.SHR ONLY) 
*     JSB N.SHR/E.SHR 
*     <FAIL RETURN (END OF DIRECTORY):
*      A = NEXT ADDRESS (LOGICAL EOD); A = ZERO (PHYSICAL EOD)> 
*     <SUCCESS RETURN: A = ENTRY ADDRESS> 
*     <B,E = GARBAGE> 
* 
*     SETS UP PROPER DIRECTORY ADDRESSES
* 
N.SHR NOP 
      STA SNAME     SAVE SEARCH NAME ADDRESS  
* 
      LDA DRTRK     GET FIRST DIRECTORY TRACK 
      CLB            AND SECTOR ADDRESSES 
      STA TRACK       SAVE
      STB SECT
      JSB RBLOK     READ THE FIRST DIRECTORY BLOCK
      JSB SETAD     SET UP DIRECTORY ADDRESSES
* 
      LDA N.SHR     GET RETURN ADDRESS
      STA E.SHR      SAVE IT
      CLB           SEARCH FOR MAIN EXTENT
      JMP NSHR3      AND GO TO WORK 
* 
E.SHR NOP 
      STA SNAME     SAVE SEARCH NAME ADDRESS  
* 
NSHR3 STB EXTNM     SAVE EXTENT NUMBER
      CLA           CLEAR HIGHEST 
      STA HIEXT      EXTENT FOUND SO FAR
* 
      LDA SNAME     GET THE SEARCH NAME ADDRESS 
      ADA .6         POINT TO FILE SIZE 
      LDA A,I         GET IT
      STA TMP3         AND SAVE FILE SIZE FOR TESTING 
* 
NSHR0 JSB FORWD     LOCATE NEXT ENTRY 
      JMP NSHR5      IF PEOD, THEN FILE WASN'T FOUND
* 
      LDA DIRA,I    GET FIRST WORD OF ENTRY 
      SZA,RSS       IF LOGICAL END OF DIRECTORY?
      JMP NSHR4      THEN FAIL EXIT 
* 
      INA,SZA       IF NOT PURGED ENTRY?
      JMP NSHR2      THEN GO COMPARE NAME 
* 
*     CHECK IF ENTRY IS AVAILABLE FOR USE 
* 
      LDA SIZEA,I   GET FILE SIZE 
      CPA TMP3      IF NOT SAME SIZE, 
      RSS 
      JMP NSHR0      THEN CONTINUE SEARCH 
* 
      LDA OPNTR     GET RE-USABLE TRACK ADDRESS 
      SSA,RSS       IF ALREADY HAVE AN ADDRESS, 
      JMP NSHR0      THEN CONTINUE SEARCH 
* 
      LDA TRACK     SAVE THE ADDRESS
      STA OPNTR 
      LDA SECT
      STA OPNSC 
      LDA ABUF
      CMA,INA 
      ADA DIRA
      STA OPNWD 
      JMP NSHR0      AND CONTINUE THE SEARCH
* 
NSHR2 LDA DIRA      GET ADDRESS OF ENTRY NAME 
      LDB SNAME     GET ADDRESS OF SEARCH NAME
      JSB CK.NM     IF NAME DOESN'T MATCH,
      JMP NSHR0      THEN CONTINUE SEARCH 
* 
      LDA TYPEA,I   GET FILE TYPE 
      SZA,RSS       IF TYPE 0,
      JMP NSHR1      THEN FOUND IT
* 
      LDA EXTNM     GET REQUESTED EXTENT NUMBER 
      INA,SZA,RSS   IF SPECIFIC EXTENT NOT REQUESTED, 
      JMP NSHR1      THEN FOUND IT
* 
      LDA SECTA,I   GET WORD CONTAINING EXTENT NUMBER 
      ALF,ALF        ALIGN EXTENT NUMBER
      AND B377        AND ISOLATE IT
* 
      LDB HIEXT     FETCH HIGHEST EXTENT NUMBER 
      CMB,INB       SUBTRACT FROM 
      ADB A          EXTENT NUMBER
      SSB,RSS       IF EXTENT NOW HIGHEST,
      STA HIEXT      THEN SAVE IT 
* 
      CPA EXTNM     IF NOT REQUESTED EXTENT,
      RSS 
      JMP NSHR0      THEN CONTINUE SEARCH 
* 
NSHR1 ISZ E.SHR     BUMP TO SUCCESS RETURN
      LDA DIRA      GET CURRENT ENTRY ADDRESS 
      JMP E.SHR,I    AND RETURN (SUCCESS) 
* 
NSHR5 CLA,RSS       PEOD; INDICATE PHYSICAL END OF DIRECTORY
* 
NSHR4 LDA DIRA      LEOD; GET NEXT ENTRY ADDRESS
      JMP E.SHR,I    AND RETURN (FAIL)
      HED D.RTR (NXT/S): UPDATE NEW NEXT TRACK AND SECTOR OF DIRECTORY
*     CALLING SEQUENCE: 
*     <SET UP DIRECTORY POINTERS> 
*     JSB NXT/S 
*     <RETURN>
* 
NXT/S NOP 
      LDA DIRA,I    GET FIRST WORD OF ENTRY 
      SSA,RSS       IF NOT HEADER ENTRY,
      JMP NXT/1      THEN CONTINUE
* 
      LDA FRSTR     GET FIRST AVAILABLE TRACK 
      CLB            AND SECTOR 
      JMP NXT/2 
* 
NXT/1 LDA TYPEA,I   GET FILE TYPE 
      SZA,RSS       IF TYPE ZERO, 
      JMP NXT/S,I    THEN RETURN
* 
      LDA SECTA,I   GET STARTING SECTOR OF THE FILE 
      AND B377       ISOLATE STARTING SECTOR
      ADA SIZEA,I     ADD EXTENT SIZE 
* 
      CLB           CLEAR FOR DIVIDE
      DIV ##SEC       DIVIDE BY SECTORS PER TRACK 
      ADA TRAKA,I      ADD STARTING TRACK ADDRESS 
* 
NXT/2 STA NXTR      UPDATE NEXT TRACK 
      STB NXSEC      AND SECTOR 
      ISZ WHE       INDICATE DIRTY HEADER ENTRY 
      JMP NXT/S,I    AND RETURN 
      HED D.RTR (RDNXB): READ NEXT DIRECTORY BLOCK
**     CALLING SEQUENCE:
**     JSB RDNXB
**     <FAIL RETURN (END OF DIRECTORY): A,B,E = GARBAGE>
**     <SUCCESS RETURN: A,B,E = GARBAGE>
**
*RDNXB NOP
*      LDA SECT      GET THE CURRENT SECTOR ADDRESS 
*      ADA #FMT       AND ADD SECTOR SKIP FACTOR
*      CLB           PREPARE FOR DIVIDE 
*      DIV ##SEC     DIVIDE BY SECTORS/TRACK
*      STB SECT      SET THE NEW SECTOR ADDRESS 
**
*      SZB           IF NOT SECTOR ZERO,
*      JMP RDNX1      THEN CONTINUE 
**
*      LDB TRACK     GET TRACK ADDRESS
*      CPB LASTR     IF THIS WAS THE LOWEST DIRECTORY TRACK?
*      JMP RDNXB,I    THEN FAIL RETURN (END OF DIRECTORY) 
**
*      ADB N1        DECREMENT TRACK ADDRESS
*      STB TRACK      AND SAVE
**
*RDNX1 JSB RBLOK     READ THE BLOCK 
*      ISZ RDNXB     STEP RETURN ADDRESS
*      JMP RDNXB,I    AND RETURN
      HED D.RTR (RPRM): SET UP RETURN PARAMETERS
*     CALLING SEQUENCE: 
*     <A := FIRST RETURN PARAMETER> 
*     JSB RPRM
*     <RETURN: A,B,E = GARBAGE> 
* 
RPRM  NOP 
      STA R1        RETURN 1
* 
      LDA TRACK     GET DIRECTORY TRACK 
      LSL 6          SHIFT INTO POSITION
      ADA LU          MERGE WITH LU 
      STA R2        RETURN 2
* 
      LDA ABUF      GET WORD OFFSET 
      CMA,INA 
      ADA DIRA
      ALF,ALF        SHIFT INTO POSITION
      ADA SECT        MERGE WITH DIRECTORY SECTOR 
      STA R3        RETURN 3
* 
      LDA TRAKA,I   GET DATA TRACK
      STA R4        RETURN 4
* 
      LDA SECTA,I   GET THE SECTOR ADDRESS
      AND B377       ISOLATE IT 
      LDB ##SEC     GET SECTORS / TRACK 
      BLF,BLF        SHIFT INTO POSITION
      ADA B           MERGE WITH THE SECTOR 
      STA R5        RETURN 5
* 
      JSB PRTN      SEND THE RETURNED 
      DEF *+2        PARAMETERS BACK VIA
      DEF R1          PRTN
* 
      JMP RPRM,I    RETURN
      HED D.RTR (RSTR): PASS BACK FILE INFORMATION TO CALLER
*     CALLING SEQUENCE: 
*     JSB RSTR
*     <RETURN: A,B,E = GARBAGE> 
* 
*     SPECIAL EXIT TO EX102 IF STRING CAN'T BE PASSED TO FATHER 
* 
RSTR  NOP 
      JSB EXEC      PASS STRING BACK
      DEF *+5 
      DEF NAB14      TO CALLER (DON'T ABORT)
      DEF .2
      DEF TYPEA,I   ADDRESS OF INFORMATION
      DEF .6        LENGTH OF STRING
      JMP EX102      TAKE ILLEGAL PARAMETER EXIT
* 
      JMP RSTR,I    RETURN
      HED D.RTR (RBLOK): READ (OR WRITE) INFORMATION TO DISC
*     CALLING SEQUENCE: 
*     JSB RBLOK 
*     <RETURN: A = REQUESTED BLOCK, B = GARBAGE, E = 0> 
* 
*     SPECIAL EXIT TO EX99 IF READ/WRITE ABORT
*     SPECIAL EXIT TO EX1 IF DISC ERROR 
* 
*     RBLOK IS THE **ONLY** DISK DIRECTORY ROUTINE WITH THE PRIVILEGE 
*     OF READING THE DIRECTORY TRACKS.  ANY OTHER METHOD OF READING 
*     CONSTITUTES UNAUTHORIZED ACCESS.
* 
*     INPUT PARAMETERS: 
*     LU:     REQUESTED DISC LU 
*     TRACK:  REQUESTED DISC TRACK
*     SECT:   REQUESTED DISC SECTOR 
*     ##SEC:  SECTORS / TRACK FOR LU
*     #FMT:   SECTOR SKIP FACTOR FOR LU 
*     SBUF:   ADDRESS OF BUFFER BUF 
*     SBFLN:  BUFFER LENGTH IN SECTORS
*     SBFLM:  USABLE BUFFER LENGTH IN SECTORS (SBFLM =2+(14*N)<=SBFLN)
*     WCS:    #0 INDICATES LAST BLOCK IS DIRTY (MUST BE WRITTEN OUT)
* 
*     OUTPUT PARAMETERS:
*     LTRAC:  LAST TRACK  (SAME AS TRACK ON EXIT) 
*     LSECT:  LAST SECTOR (SAME AS SECT ON EXIT)
*     LLU:    LAST LU     (SAME AS LU ON EXIT)
*     ABUF:   \ 
*     A-REG:  / ADDRESS OF REQUESTED BLOCK
*     ENDAD:  ADDRESS OF BLOCK BEYOND REQUESTED BLOCK 
*     NSEC:   NEGATIVE VALUE OF SECTOR BEYOND BUFFER
*     C.BFL:  CURRENT NUMBER OF SECTORS IN BUF
*     WORD#:  CURRENT NUMBER OF WORDS IN BUF
* 
RBLOK NOP 
      JSB WBLOK     WRITE CURRENT BLOCK IF DIRTY
      LDA LU        GET REQUESTED DISC LU 
* 
      CPA LLU       IF NOT SAME AS CURRENT LU,
      RSS 
      JMP RBLK1      THEN FORCE DISC READ 
* 
      LDA TRACK     GET REQUESTED TRACK 
      CPA LTRAC     IF NOT SAME AS CURRECT TRACK, 
      RSS 
      JMP RBLK1      THEN FORCE DISC READ 
* 
RBLK  LDA SECT      GET REQUESTED SECTOR
      ADA NSEC       CHECK IF BLOCK IS BELOW MAXIMUM
      SSA,RSS       IF NOT BELOW MAXIMUM, 
      JMP RBLK1      THEN FORCE A DISC READ 
* 
      ADA C.BFL     CHECK IF BLOCK IS ABOVE MINIMUM 
      SSA           IF NOT ABOVE MINIMUM, 
      JMP RBLK1      THEN FORCE A DISC READ 
* 
      LSL 6         IN CORE; CONVERT TO WORDS 
      ADA SBUF       ADD BASE ADDRESS 
      STA ABUF        SAVE STARTING ADDRESS FOR USER
      ADA .128      CALCULATE ENDING ADDRESS
      STA ENDAD      SAVE ENDING ADDRESS FOR USER 
* 
      LDA LU        UPDATE LLU, LTRAC, LSECT
      STA LLU 
      LDA TRACK 
      STA LTRAC 
      LDA SECT
      STA LSECT 
* 
      LDA ABUF      GET BUFFER ADDRESS
      JMP RBLOK,I    AND RETURN 
* 
RBLK1 LDB ##SEC     NOT IN CORE; GET SECTORS / TRACK
      CMB,INB,SZB,RSS IF IT IS NOT KNOWN (>0)?
      JMP RBLK3      THEN JUST READ 2 SECTORS 
* 
      ADB SBFLN     ADD IN BUFFER LENGTH
      SSB           IF TRACK TOO LONG,
      JMP RBLK2      THEN TRIM IT DOWN
* 
      CLA           READ THE WHOLE
      LDB ##SEC      TRACK BEGINNING WITH SECTOR 0
      JMP RBLK4 
* 
*     WHOLE TRACK WON'T FIT; MATCH SBFLM WITH TRACK SIZE
* 
RBLK2 LDB SBFLM     GET MAXIMUM DISC READ LENGTH
      ADB SECT       ADD IN STARTING SECTOR ADDRESS 
      CMB,INB         NEGATE
      ADB ##SEC        AND ADD IN SECTORS / TRACK 
      RSS           SKIP THE FIRST TIME THROUGH THE LOOP
* 
RBLK5 ADB #FMT      DECREMENT ONE BLOCK (INCLUDING SKIP FACTOR) 
      SSB           IF BEYOND END OF TRACK? 
      JMP RBLK5      THEN TRY SMALLER 
* 
      LDA SECT      GET STARTING SECTOR ADDRESS 
      CMB,INB       CALCULATE LENGTH OF READ
      ADB ##SEC 
      JMP RBLK4     GO READ IT
* 
RBLK3 LDA SECT      DON'T KNOW SECTORS/TRACK; TRY 2 SECTORS 
      LDB A 
      ADB .2
* 
RBLK4 STA RSECT     STARTING SECTOR OF DISC READ
      CMB,INB       NEGATE LAST SECTOR NUMBER 
      STB NSEC       AND SAVE 
      ADA B         CALCULATE NUMBER OF 
      CMA,INA        SECTORS IN BUFFER
      STA C.BFL       AND SAVE
      LSL 6         CONVERT BUFFER LENGTH INTO WORDS
      STA WORD#      AND SAVE FOR EXEC
* 
      LDA LU        GET DIRECTORY LU NUMBER 
      IOR B7700      SET PROTECT BITS 
      STA PDSLU       AND SAVE FOR EXEC 
* 
      CLA           CLEAR LAST LU 
      STA LLU        SO WE DON'T USE IT 
* 
      JSB EXEC      DO THE ACTUAL READ
      DEF *+7 
      DEF NAB1      READ (DON'T ABORT)
      DEF PDSLU     LU WITH PROTECT BITS
      DEF SBUF,I
      DEF WORD# 
      DEF TRACK     REQUESTED DISC TRACK
      DEF RSECT      AND SECTOR 
      JMP EX99      ERROR RETURN
* 
      CPB WORD#     IF ALL THE WORDS TRANSFERRED, 
      JMP RBLK       THEN SET UP LAST PARAMETERS AND RETURN 
      JMP EX1        ELSE TAKE DISC ERROR EXIT
      HED D.RTR (WHEAD): WRITE CARTRIDGE HEADER ENTRY 
*     CALLING SEQUENCE: 
*     <SET WHE TO WRITE DISC PARAMETERS>
*     JSB WHEAD 
*     <RETURN: A,B,E = GARBAGE> 
* 
WHEAD NOP 
      LDA WHE       GET HEADER ENTRY DIRTY FLAG 
      SZA,RSS       IF HEADER HAS NOT BEEN MODIFIED,
      JMP WHEAD,I    THEN JUST RETURN 
* 
      CLA           READ THE FIRST DIRECTORY BLOCK
      STA SECT
      LDA DRTRK 
      STA TRACK 
      JSB RBLOK 
* 
      STA B         MOVE BUFFER ADDRESS TO B-REG
      LDA ACLBL     GET LOCAL HEADER ENTRY ADDRESS
      JSB .MVW      MOVE THE ENTRY INTO THE DIRECTORY BLOCK 
      DEF .16 
      NOP 
      ISZ WCS       INDICATE DIRTY BLOCK
* 
      CLA           RESET THE DIRTY HEADER FLAG 
      STA WHE 
      JMP WHEAD,I    AND RETURN 
      HED D.RTR (SETAD): SET UP DIRECTORY ENTRY POINTERS
*     CALLING SEQUENCE: 
*     <A := FIRST ADDRESS TO RECEIVE DIRECTORY ENTRY ADDRESSES> 
*     JSB SETAD 
*     <RETURN: A,B,E = GARBAGE> 
* 
SETAD NOP 
      LDB ADIRA     SET B TO DESTINATION ADDRESS
      JSB $SETP 
      DEF .10       10 ADDRESSES REQUIRED 
      NOP 
      JMP SETAD,I   RETURN
      HED D.RTR (TSTDR): TEST DIRECTORY FOR CONSISTENCY 
*     CALLING SEQUENCE: 
*     JSB TSTDR 
*     <ILLEGAL DIRECTORY, A = GARBAGE>
*     <LEGAL DIRECTORY, A = NUMBER OF OPEN FLAGS> 
* 
TSTDR NOP 
      JSB FID       IF HEADER ILLEGAL,
      JMP ILDIR      THEN TAKE CORRUPT DIRECTORY EXIT 
* 
      LDA FRSTR     GET FIRST FMP TRACK FROM HEADER 
      CLB            AND SECTOR 
      STA CALTR     AND SAVE AS CALCULATED TRACK VALUE
      STB CALSC      AND CALCULATED SECTOR
      STB FLGCT     CLEAR FLAG COUNT
* 
      LDA DRTRK     GET FIRST DIRECTORY TRACK 
      CLB            AND SECTOR ADDRESSES 
      STA TRACK       SAVE
      STB SECT
      JSB RBLOK     READ FIRST DIRECTORY BLOCK
      JSB SETAD      SET UP DIRECTORY ADDRESSES 
* 
NXFIL JSB FORWD     LOCATE NEXT ENTRY 
      JMP EODIR      IF END OF DIRECTORY, THEN FINISH UP
* 
      LDA DIRA,I    GET FIRST NAME WORD 
      SZA,RSS       IF END OF DIRECTORY?
      JMP EODIR      THEN FINISH UP 
* 
      INA,SZA,RSS   IF PURGED ENTRY,
      JMP TDIR4      THEN DON'T COUNT OPEN FLAGS
* 
      JSB FLAG      CLEAR BAD OPEN FLAGS, AND GET NUMBER OF OPEN FLAGS
      ADA FLGCT      ADD TO TOTAL FLAG COUNT
      STA FLGCT       AND SAVE AGAIN
* 
TDIR4 LDA TYPEA,I   GET FILE TYPE 
      SZA,RSS       IF NOT DISC FILE, 
      JMP NXFIL      THEN DON'T DO DIRECTORY ADDRESS CHECKS 
* 
      LDA SIZEA,I     GET FILE SIZE 
      SZA           IF FILE SIZE 0, 
      SSA            OR NEGATIVE, 
      JMP ILDIR       THEN CORRUPT DIRECTORY
* 
      LDA TRAKA,I   GET CURRENT TRACK ADDRESS 
      CPA CALTR     IF SAME AS CALCULATED,
      JMP TDIR3      THEN TEST SECTOR 
* 
      CMA,INA       NEGATE
      ADA CALTR      AND COMPARE TO CALCULATED NEXT TRACK 
      SSA,RSS       IF CURRENT NOT PAST CALCULATED, 
      JMP ILDIR      THEN CORRUPT DIRECTORY 
      JMP ADROK      ELSE ADDRESS OK
* 
TDIR3 LDA SECTA,I   GET SECTOR ADDRESS FOR COMPARISON 
      AND B377       ISOLATE IT 
      CPA CALSC     IF SAME AS CALCULATED,
      JMP ADROK      THEN ADDRESS OK
* 
      CMA,INA       NEGATE
      ADA CALSC      COMPARE TO CALCULATED SECTOR 
      SSA,RSS       IF CURRENT NOT PAST CALCULATED, 
      JMP ILDIR      THEN CORRUPT DIRECTORY 
* 
ADROK LDA SECTA,I   GET STARTING SECTOR OF THE FILE 
      AND B377       ISOLATE STARTING SECTOR
      ADA SIZEA,I     ADD EXTENT SIZE 
      CLB           CLEAR FOR DIVIDE
      DIV ##SEC       DIVIDE BY SECTORS PER TRACK 
      ADA TRAKA,I      ADD STARTING TRACK ADDRESS 
* 
      STA CALTR     SAVE CALCULATED TRACK 
      STB CALSC      AND SECTOR 
      JMP NXFIL     TEST NEXT FILE ENTRY
* 
EODIR LDA NXTR      GET NEXT AVAILABLE TRACK
      CPA CALTR     IF SAME AS CALCULATED,
      JMP TDIR2      THEN TEST SECTOR 
* 
      CMA,INA       NEGATE
      ADA CALTR      AND COMPARE TO CALCULATED NEXT TRACK 
      SSA,RSS       IF NEXT AVAILABLE NOT PAST CALCULATED,
      JMP ILDIR      THEN CORRUPT DIRECTORY 
      JMP OKDIR      ELSE OK DIRECTORY
* 
TDIR2 LDA NXSEC     GET NEXT AVAILABLE SECTOR 
      AND B377       ISOLATE IT 
      CPA CALSC     IF SAME AS CALCULATED,
      JMP OKDIR      THEN OK DIRECTORY
* 
      CMA,INA       NEGATE
      ADA CALSC      AND COMPARE TO CALCULATED NEXT SECTOR
      SSA,RSS       IF NEXT AVAILABLE NOT PAST CALCULATED,
      JMP ILDIR      THEN CORRUPT DIRECTORY 
* 
OKDIR LDA FLGCT     RETURN WITH FLAG COUNT IN A 
      ISZ TSTDR     DIRECTORY OK, STEP RETURN ADDRESS 
* 
ILDIR JMP TSTDR,I   RETURN
      HED D.RTR (VALID): CHECK OPEN FLAG AND LOCK WORD VALIDITY 
*     CALLING SEQUENCE: 
*     <A := FLAG/LOCK WORD TO TEST> 
*     JSB VALID 
*     <FAIL RETURN: A = GARBAGE>
*     <SUCCESS RETURN: A = OLD A> 
* 
VALID NOP 
      STA VALDF     SAVE THE OPEN FLAG/LOCK WORD
      SZA,RSS       IF FLAG IS ZERO,
      JMP VEXIT      THEN VALID FLAG/LOCK WORD
* 
      AND B377      ISOLATE ID NUMBER 
      SZA,RSS       IF ZERO,
      JMP VALID,I    THEN EXIT NOT VALID
* 
      ADA N1        SUBTRACT 1 FOR ID'S FROM 0 TO 255 
      STA TMP1       SAVE CURRENT ID SEGMENT NUMBER 
* 
      JSB .XLD      GET NUMBER OF ID SEGMENTS 
      DEF $ID#+0
      CMA,INA       SET NEGATIVE
      ADA TMP1       ADD CURRENT SEGMENT NUMBER 
      SSA,RSS       IF IT IS TOO LARGE? 
      JMP VALID,I    THEN EXIT NOT VALID
* 
      JSB .XLD      GET ID SEGMENT SIZE 
      DEF $IDSZ+0 
      MPY TMP1      MULTIPLY SIZE BY SEGMENT NUMBER 
      STA TMP1       AND SAVE 
      JSB .XLD      ADD ID SEGMENT TABLE STARTING ADDRESS 
      DEF $IDA+0
      ADA TMP1       ADD OFFSET 
      STA TMP1        AND SAVE
* 
      ADA .8        POINT TO POINT OF SUSPENSION
      JSB .XLD      GET POINT OF SUSPENSION 
      DEF A,I 
      SZA,RSS       IF ZERO (DORMANT),
      JMP VALID,I    THEN EXIT NOT VALID
* 
      LDA TMP1      POINT 
      ADA .28        TO SEQUENCE NUMBER 
      JSB .XLD      GET WORD FROM ID SEGMENT
      DEF A,I 
      AND B170K     ISOLATE SEQ # FROM ID SEGMENT 
      STA B         SAVE SEQUENCE NUMBER
      LDA VALDF     NOW GET OPEN FLAG AGAIN 
      RAL           POSITION SEQUENCE IN HIGH ORDER BITS
      AND B170K     ISOLATE SEQ # FROM OPEN FLAG
      CPA B         IF SEQUENCE NUMBERS DON'T MATCH,
      RSS 
      JMP VALID,I    THEN EXIT NOT VALID
* 
VEXIT LDA VALDF     RETURN WITH VALID OPEN FLAG 
      ISZ VALID      POINT TO SUCCESS RETURN
      JMP VALID,I     AND RETURN
      HED D.RTR (WBLOK): WRITE CURRENT DIRECTORY BLOCK
*     CALLING SEQUENCE: 
*     JSB WBLOK 
*     <RETURN: A,B,E = GARBAGE> 
* 
*     SPECIAL EXIT TO EX99 IF DISC READ/WRITE ERROR 
*     SPECIAL EXIT TO EX1 IF DISC ERROR 
* 
*     WBLOK IS THE **ONLY** ROUTINE WITH THE PRIVILEGE OF WRITING ON
*     THE DIRECTORY TRACKS.  ANY OTHER METHOD OF WRITING CONSTITUTES
*     UNAUTHORIZED ACCESS.
* 
WBLOK NOP 
      LDA WCS       GET WRITE FLAG
      SZA,RSS       IF BUFFER NOT DIRTY,
      JMP WBLOK,I    THEN JUST RETURN 
* 
      CLA           CLEAR WRITTEN-ON FLAG 
      STA WCS 
* 
      LDA LU        GET DIRECTORY LU
      IOR B7700      SET PROTECT BITS 
      STA PDSLU       AND SAVE FOR EXEC 
* 
      JSB EXEC      DO THE ACTUAL WRITE 
      DEF *+7 
      DEF NAB2      WRITE (DON'T ABORT) 
      DEF PDSLU     LU WITH PROTECT BITS
      DEF ABUF,I    CURRENT BLOCK 
      DEF .128       AND LENGTH 
      DEF LTRAC     TRACK AND 
      DEF LSECT      SECTOR ADDRESS 
      JMP EX99      ERROR RETURN
* 
      CPB .128      IF ALL 128 WORDS WRITTEN? 
      JMP WBLOK,I    THEN NORMAL RETURN 
      JMP EX1        ELSE DISC ERROR EXIT 
      HED D.RTR (WCDIR): WRITE NEW CARTRIDGE LIST ENTRY 
*     CALLING SEQUENCE: 
*     <SET UP LU, DRTRK, CRN, LKWD> 
*     <SET ENTAD TO CARTRIDGE LIST ENTRY ADDRESS FOR MOVE>  
*     JSB WCDIR 
*     <RETURN: A,B,E = GARBAGE> 
* 
WCDIR NOP 
      CLA           PREPARE FOR CLEAR 
      LDB LU        GET LU
      CPB LLU       IF LAST LU IS SAME AS CURRENT,
      STA LLU        CLEAR LAST LU
* 
      LDA CDSZ      GET TRANSFER LENGTH 
      JSB .CAX       MOVE INTO X-REG
      LDA ALU       GET LOCAL ENTRY ADDRESS 
      LDB ENTAD     GET SYSTEM ENTRY ADDRESS
* 
      JSB $LIBR     GO PRIVILEDGED
      NOP 
      JSB .MWI      MOVE ENTRY INTO CARTRIDGE LIST  
      JSB $LIBX     GO UNPRIVILEDGED
      DEF WCDIR      AND RETURN 
* 
*     END OF D.RTR
* 
END   EQU * 
* 
      END D.RTR     SET UP MAIN PROGRAM ENTRY 
                                          