ASMB,R,L,C
*     NAME:   D.RTR 
*     SOURCE: 92070-18037 
*     RELOC:  92070-16037 
*     PGMR:   G.A.A.   MOD   G.L.M.   M.L.K.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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,6,1  92070-16037 REV.2001  800103 
* 
      ENT D.RTR 
* 
      EXT EXEC,$CDIR,$MDSP
      EXT $LIBR,$LIBX,$IDA,$IDSZ,$ID# 
* 
* 
      SUP 
*            RTE FMP DIRECTORY ROUTINE
* 
* THIS PROGRAM IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT
* SYSTEM. IT OWNS THE DIRECTORY AND PERFORMS ALL WRITES 
* ON IT.  THIS PROGRAM MUST BE IN THE RESIDENT LIBRARY AND ONLY 
* ONE COPY CAN EXIST. 
* 
* PROGRAM WISHING TO ACCESS THE DIRECTORY 
* CALL THIS PROGRAM.
* 
* CALLS ARE AS FOLLOWS (P1,P2... ETC.  ARE THE PASSED PARAMETERS):
* 
* 
* 1. OPEN 
*     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. 0,NAME(3,4) S(BIT 15) INDICATES SCRATCH FILE PURGE. 
*     P5. 0,NAME(5,6) 
* 
* 2. CLOSE
*     P0. OPEN FLAG 
*     P1. FUNCTION CODE =0
*     P2. TR,LU 
*     P3. OFFSET,SECTOR  /DIRECTORY ADDRESS 
*     P4. 0,-(NO. SECTORS TO BE DELETED),+ PURGE EXTENTS ONLY 
* 
* 3. CREAT
*     P0. OPEN FLAG 
*     P1. FUNCTION CODE =1
*     P2. -LU,+CARTRIDGE,0
*     P3. NAME (1,2)
*     P4. NAME (3,4)
*     P5. NAME (5,6)
*     P6. TYPE       \  TYPE=0
*     P7. FILE SIZE  \  0 
*     P8. REC SIZE   \  NOT PASSED
*     P9. SEC CODE   \  NOT PASSED
* 
* 4. CHANGE NAME
*     P0. OPEN FLAG 
*     P1. FUNCTION CODE=2 
*     P2. TR,LU         (FROM DCB WD 1) 
*     P3. OFFSET,SECTOR (FROM DCB WD 2 OF FILE BEING RENAMED) 
*     P4. NEW NAMME(1)
*     P5. NEW NAMME(2)
*     P6. NEW NAMME(3)
* 
* 6. SET,CLEAR LOCK ON DISC 
*     P0. OPEN FLAG 
*     P1. FUNCTION = 3 FOR SET, 5 FOR CLEAR 
*     P2. -LU,+CARTRIDGE  (0 NOT LEGAL)  DISC TO BE LOCKED
* 
* 7. MOUNT,DISMOUNT,UPDATE CALL 
*     P0. OPEN FLAG 
*     P1. FUNCTION =7 
*     P2. -LU,+CR 
*     P3. LU
*     P4. LAST TRACK
*     P5. CARTRIDGE REFERENCE 
*     P6. LOCK WORD 
*     P7. SUBFUNCTION CODE: -1=UPDATE DRN ONLY
*                            0=DISMOUNT CALL
*                           -2=MOUNT CALL 
* 
* 8. EXTENSION OPEN 
*     P0. OPEN FLAG 
*     P1. FUNCTION CODE= 6(READ), 8(WRITE)
*     P2. TR,LU        \
*     P3. OFFSET,SECTOR \DIRECTORY ADDRESS OF MASTER ENTRY
*     P4. EXTENSION NUMBER
* 
* 9. RETURN PARAMETERS
*     R1. ERROR CODE (IF POSITIVE, THEN # OF SECTORS IN FILE) 
*     R2. TR,LU 
*     R3. OFFSET,SECTOR 
*     R4. TR (LU IF TYPE 0) 
*     R5. NUMBER OF SECTORS/TRACK 
* 
* 
*     ROUTINES WHICH CALL D.RTR:
*         OPEN     LOCK.
*         CLOSE    MCDC.
*         CREAT    CR.. 
*         CRETS    CREA.
*         NAMF
      SKP 
* 
* WORD FORMATS FOR DOUBLE DUTY WORDS
* 
*  15...6 5..0       15...8 7...0       15...8 7...0
*  TRACK ^ LU        OFFSET^SECTOR     #SEC/TR^SECTOR 
* 
* ERROR CODES 
*     12             DUPLICATE CRN ON MOUNT 
*     0              NO ERROR 
*    -1              DISC DOWN
*    -2              DUPLICATE NAME 
*    -5              READ EXTENT OPEN AND EXTENT NOT FOUND
*    -6              FILE NOT FOUND 
*    -8              FILE IS CURRENTLY OPEN (ALSO FOR REJECT LOCK)
*    -11             FILE NOT OPEN (CLOSE)
*    -13             DISC LOCKED
*    -14             DIRECTORY FULL 
*    -16             ILLEGAL TYPE OR SIZE = 0 
*    -32             DISC CARTRIDGE NOT FOUND 
*    -33             NOT ENOUGH ROOM ON DISC CARTRIDGE
* 
*    -100            BOOTUP AND LU 2 DOES NOT REFERENCE INITIALIZED 
*                    FMGR DISK
*    -101            ILLEGAL PARAMETERS IN CALL 
*    -102            ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) 
*    -103            DISC DIRECTORY CORRUPT 
* 
* 
* 
*     OPEN FLAG FORMAT: 
*     ------------------------------------- 
*     !EX!  SEQ   ! CPU  !   ID SEG #     ! 
*     ------------------------------------- 
*      15 14    11 10   8 7              0
* 
*     WHERE:
*           EX = EXCLUSIVE BIT
*           SEQ = SEQUENCE COUNT FROM ID SEGMENT
*           ID SEG# = ID SEGMENT NUMBER (1 TO N)
*           CPU = RESERVED
      SKP 
D.RTR NOP           ENTRY POINT 
      JSB $LIBR     CALL SYSTEM AS
      DEF TDB         A RE-ENTRANT SUBROUTINE 
* 
      LDA OFTST     GET OFF TEST FLAG 
      SZA,RSS       COMPLETED NORMALLY LAST TIME? 
      JMP ENTRD     YES, CONTINUE 
* 
      CLA           NO, SET UP TO CLEAR 
      STA RDPS      ALL TEMPOYARY 
      LDA RDPSA     AND IN CORE 
      LDB A         GET SAME ADDRESS
      INB           AND INCREMENT BY ONE
      CCE           AND FLAGS 
      JSB MOVE
      DEC -20 
* 
ENTRD CCA           SET OFF TEST FLAG 
      STA OFTST     TO "ENTERED"
      LDA RTNAD,I   GET ADDRESS OF PASSED PARAMETERS
      ISZ RTNAD     POINT TO RETURN PARAMETERS
      LDB IDA       SET DESTINATION ADDRESS FOR MOVE
      CCE           SET E=1 TO MOVE PARAMETERS
      JSB MOVE      NOW MOVE THEM 
      DEC -12       MOVE THE FIRST 12 
* 
      LDA RTNAD,I   GET ADDRESS OF THE RETURN BUF 
      STA ADRTN     AND STORE IT
      ISZ RTNAD     NOW POINT TO RETURN ADDRESS 
* 
      LDA $CDIR     GET FIRST WORD OF DIRECTORY TABLE 
      SSA           IF IT IS NEG
INITR JMP INIT        THEN GO INITIALIZE DISC 
* 
      CLB 
      STB FIRST     CLEAR THE FIRST FLAG
      STB TMP1
* 
* FETCH ADDRESS OF CARTRIDGE DIRECTORY. 
* 
      LDA CRDIR     SET LOCK SEARCH FOR FIRST 
      STA DIRAD     ENTRY 
      SKP 
*     THE LOCK ROUTINE SEARCHES THE DISC DIRECTORY FOR THE
*     REFERENCED DISC.
* 
*     FOR THE FIRST CALL DIRAD SHOULD POINT AT THE
*     FIRST WORD IN $CDIR.  SUBSEQUENTLY LOCK 
*     WILL UPDATE DIRAD EACH CALL.
* 
*     WITH THE EXCEPTION OF THE DISC DIRECTORY UPDATE THE DISC
*     MUST BE FOUND.  IN THIS CASE, EXIT IS TO THE CREAT ROUTINE
* 
*     ON EXIT ATRAK CONTAINS THE DIRECTORY TRACK
*              ALU     CONTAINS THE DIRECTORY LU
*              A       CONTAINS THE LOCK WORD 
* 
*     ON SUBSEQUENT CALLS IF THE DISC ID WAS 0, THE NEXT
*     DISC IS RETURNED.  IF THE DISC ID WAS NOT 0,
*     A NOT FOUND EXIT IS TAKEN.
* 
NEXT  LDA P2        FETCH LU
      LDB P1        FETCH FUNCTION
      CCE,SLB,RSS    IS FUNCTION EVEN?
      JMP LOCK3     YES; GO EXTRACT LU
      CMA,CCE,SSA,INA E_0 INDICATES CARTRIDGE LABEL 
      CMA,CLE,INA     E_1 INDICATES LU(SET +) 
      LDB TMP1      GET PREVIOUS ID 
      STA TMP1      STORE ID
      CME,SZB       IF NOT A  ZERO, ID ON SECOND
      JMP CKERR     GO DETERMINE WHAT ERROR TYPE
      SPC 1 
      RAL,ERA       SET SIGN BIT IF A LABEL SEARCH
      STA TMP2      AND SET FOR COMPARE 
      SPC 1 
LOCK6 LDA TMP2      SET THE FOUND BIT IN E IF 
      CMA,CLE,INA   A ZERO ID 
      LDB DIRAD     GET CURRENT DIRECTORY ADD.
LOCK2 CPB $MDSP     END OF DIRECTORY? 
      JMP LOCK5     YEP--GO CHECK FOR TYPE 7 CALL 
      LDA B,I       GET FIRST WORD
      SZA,RSS       IF 0 THEN END 
      JMP LOCK5     SO GO CHECK FOR  DIRECTORY UPDATE 
      STA ALU         ELSE SAVE LU
      CPA TMP2      IS THIS THE REQUIRED DISC?
      CCE           YES  SET E TO 1 TO INDICATE FOUND 
      INB           STEP TO TRACK ADDRESS AND 
      LDA B,I       SET 
      STA ATRAK     IN ATRAK
      INB           STEP TO 
      LDA B,I       LABEL AND FETCH 
      IOR SIGN      SET SIGN FOR COMPARE
      SEZ,INB,RSS   STEP TO LOCK ADDRESS SKIP IF FOUND
      CPA TMP2      IS THIS THE REQUESTED DISC? 
      JMP LOCK4     YES; GO EXIT
      INB           NO; STEP TO NEXT ONE
      JMP LOCK2     AND GO CHECK IT 
      SPC 2 
*                   LU AND TRACK IN (A) 
* 
LOCK3 AND B77       MASK TO LU
      STA TMP2      SAVE LU 
      STA B         SAVE LU IN B FOR TEST 
      XOR P2        MASK TO TRACK 
      ALF,RAL       ROTATE TO 
      RAL,ALF       LOW A AND 
      STA DITR      SAVE THE TRACK
      JMP LOCK6     GO LOOK FOR DISC
      SPC 1 
B77   OCT 77
      SPC 1 
LOCK4 STB DIRAD     FOUND 
      LDA B,I       LOCK TO A 
* 
      JSB VALID     GO CHECK VALIDITY OF LOCK WORD
      RSS           VALID RETURN
      STA DIRAD,I   NOT VALID, CLEAR LOCK WORD
      ISZ DIRAD     UPDATE DIRECTORY PTR FOR NEXT SEARCH
      SZA           IF NOT LOCKED 
      CPA ID        OR LOCKED TO CALLER 
      JMP DECOD     SKIP
      LDA TMP1      ELSE IF 
      SZA,RSS       MULTI-DISC SEARCH 
      JMP NEXT      CONTINUE
      JMP EX13      ELSE EXIT LOCKED DISC 
      SPC 2 
DECOD CCA           SET THE NONE FOUND YET
      STA R1        FOR RE-USABLE DISC SPACE ROUTINE (CKRUS)
      LDA P1        FETCH FUNCTION CODE 
      SSA           CHECK REQUEST CODE
      JMP EX101     NEGATIVE - EXIT 
      ADA N10 
      SSA,RSS 
      JMP EX101     GREATER THAN 9 - EXIT 
      ADA TABAD     INDEX INTO THE FUNCTION 
      JMP A,I       GO EXECUTE THE FUNCTION 
      SPC 2 
TABAD DEF TABA+10 
TABA  JMP CLOSE     0 CLOSE 
      JMP CREAT     1 CREATE
      JMP CNAM      2 CHANGE NAME 
      JMP RLOCK     3 LOCK DISC 
      JMP EX101     4 ERROR 
      JMP ULOCK     5 UNLOCK DISC 
      JMP EXOPN     6 EXTENT OPEN 
      JMP MDUDT     7 MOUNT, DISMOUNT, UPDATE 
      JMP EXOPN     8 EXTENT OPEN 
      JMP OPEN      9 OPEN
      SKP 
*          OPEN ACTION ROUTINE
* 
* 
OPEN  DLD P4        SET NAME WORDS 2 AND  3 
      ELA,CLE,ERA   CLEAR POSSIBLE SCRATCH PURGE BIT
      DST NAME+1    INTO THE NAME BUFFER
      LDA P3        SET NAME WORD1
      RAL,CLE,ERA   LESS POSSIBLE SIGN BIT
      STA NAME      INTO THE NAME BUFFER
      JSB SETDR     SET UP TO READ THE DIRECTORY
      JSB N.SHR     GO FIND THE FILE
      JMP NEXT      NOT FOUND - TRY NEXT DISC 
      JSB SETAD     FOUND - GO SET THE ADDRESSES
      JSB FLAG      CHECK THE OPEN FLAGS
      LDB COUN2     IF 7 OPENS
* 
*    IF SCRATCH PURGE MUST HAVE CLEARED SC PU BIT EARLIER 
*    NOW MUST MAKE SURE ONLY 1 PROG OPEN TO IT(ELSE EX 101?)
*    THEN CLEAR OPEN FLAG 
*         JMP PURGE 
* 
      LDA P4        FETCH POSSIBLE SCR PURGE FLAG 
      SSA,RSS       IF SIGN NOT SET 
      JMP OPEN1       CONTINUE
      ADB N2          ELSE, FORCE PURGE - CHECK OPEN FLAG COUNT 
      SSB,RSS       IF JUST ONE, OK 
      JMP EX101       ELSE EXIT MORE THAN 1 PROG OPEN TO IT 
      CLA 
      STA FLAGA,I   CLEAR FLAG,IF ANY 
      JMP PURGE 
* 
OPEN1 CPB .7        THEN NO ROOM SO 
      JMP EX8       EXIT
      LDA P3        IF EXCLUSIVE OPEN 
      CLE,SSA,RSS   THEN SKIP 
      JMP OPEN3     NON EXCLUSIVE  SKIP 
      CCE,SZB       IF ANY OPENS THEN 
      JMP EX8       REJECT EXCLUSIVE OPEN 
OPEN3 LDB SC        GET THE FLAG ADDRESS LESS ONE 
OPEN5 INB           SEARCH FOR OPEN SPOT IN FLAG LIST 
      LDA B,I       GET FLAG WORD 
      SSA           IF SIGN BIT SET THEN
      JMP EX8       FILE IS EXCLUSIVELY OPEN TO SOME ONE
      SZA           THIS WORD?
      JMP OPEN5     NO; GO TRY NEXT ONE 
      LDA ID        YES; GET THE ID ADDRESS 
      RAL,ERA       SET THE EXCLUSIVE/NON-EXCLUSIVE 
      STA B,I       FLAG AND PUT IN THE DIRECTORY 
      STA WCS       SET TO WRITE THE BLOCK
OPEN4 LDA TYPE,I   SET UP THE RETURN PARAMETERS 
      SZA           IF TYPE ZERO SEND BACK ZERO CODE
      LDA #SEC,I    ELSE SEND BACK THE FILE SIZE
      JMP CREX
      SKP 
* 
*          EXTENT OPEN ACTION ROUTINE 
* 
* 
EXOPN JSB DIRCK     GO READ IN THE MASTER DIRECTORY ENTRY 
      CLA           CLEAR THE 
      STA ID        OPEN FLAG WORD
      LDA P4        SET THE 
      SZA,RSS       IF AFTER THE MAIN THEN
      JMP OPEN4     WE HAVE IT ALREADY
* 
      AND B377      EXTENT NUMBER > 255?
      CPA P4
      ALF,SLA,ALF   EXTENSION NUMBER FOR POSSIBLE 
      JMP EX46      ERROR, TOO MANY EXTENTS 
* 
      STA GSEC      EXTENSION CREAT 
      JSB EXSHR     SEARCH FOR THE REQUIRED EXTENT
      JMP EXOPT     NOT FOUND SO GO TEST IF READ
      ALF,ALF       EXTENT NO TO A
      AND B377      MASK
      CPA P4        THIS IT?
      JMP OPEN4     YES SO GO RETURN THE PRAMS
CSER  LDA TYPE      NO SO CONTINUE
      JMP NSHR4     THE SEARCH
      SPC 1 
EXOPT LDB P1        IF EXTENT OPEN IS FOR 
      CPB .8        WRITE THE GO CREAT THE EXTENT 
      JMP CREA0     GO EXIT 
      LDA N5        ELSE RETURN ILLEGAL RECORD ERROR
      JMP CREX      GO EXIT 
      SPC 2 
N2    DEC -2
      SKP 
* 
*          CLOSE ACTION ROUTINE 
* 
* 
CLOSE JSB DIRCK     CLOSE; GET THE SECTOR 
      LDA N7        SET FOR 7 ENTRIES 
CLOS1 LDB FLAGA,I   FIND
      RBL,CLE,ERB   CALLERS 
      CPB ID        FLAG
      JMP CLOS2     FOUND 
      ISZ FLAGA     NOT; YET TRY NEXT ONE 
      INA,SZA       MORE? 
      JMP CLOS1     YES; OK 
      JMP EX11      NO; ERR - NOT OPEN TO CALLER
      SPC 2 
CLOS2 CLA           FOUND; CLEAR THE
      STA FLAGA,I   FLAG
      LDA P4        GET TRUNCATE CODE 
      SZA           IF ZERO THEN SKIP  NO ACTION
      SEZ,RSS       EXCLUSIVE OPEN? 
      JMP EXIT3     NO; EXIT
      SSA,RSS       IF POSITIVE THEN
      JMP EXPUR     GO PURGE THE EXTENTS
      ADA #SEC,I    CALCULATE NEW FILE SIZE 
      SLA,RSS       IGNOR IF ODD SECTOR COUNT 
      SSA           IF RESULT LESS THAN ZERO
      JMP EXIT3     THEN IGNOR IT 
      CCE,SZA,RSS   IF ZERO 
      JMP PURGE     GO PURGE
      STA TMP2      SAVE THE NEW SIZE 
      JSB LAST?     LAST FILE?
      CLE,RSS       NO, CLEAR E  SKIP 
      CCE           YES; SET E
      LDA TMP2      SET THE NEW SIZE
      STA #SEC,I    IN THE DIRECTORY
      SEZ,RSS       IF NOT THE LAST ENTRY 
      JMP EXPUR     GO PURGE ANY EXTENTS
      JMP PURG8     ELSE GO UPDATE DISC PRAMS 
      SKP 
* 
*          PURGE (PART OF CLOSE)
* 
* 
PURGE CCA 
      STA DIRA,I    SET PURGE FLAG
      JSB LAST?     LAST FILE?
      JMP EXPUR     NO; GO CHECK FOR EXTENTS
PURG2 STA DIRA,I    MAKE ENTRY AVAILABLE
      LDA DIRA      IS THIS THE FIRST 
      STA WCS          SET TO WRITE CURRENT BLOCK 
      CPA ABUF      ENTRY IN THE CURRENT BLOCK? 
      JMP PURG5     YES; GO READ PREVIOUS BLOCK 
PURG7 ADA N16       NO; BACK UP TO PREVIOUS 
      JSB SETAD     ENTRY; FIND FIRST UNPURGED
      LDB TYPE,I    CHECK TYPE
      LDA DIRA,I    ENTRY 
      SZB           TYPE ZERO - IF SO SKIP
      INA,SZA,RSS   PURGED? 
      JMP PURG2     YES; TRY PREVIOUS ENTRY 
      SPC 1 
      SSA           FOUND ENTRY - IS IT THE 
      JMP PURG3     DISC SPEC ENTRY? - YES JUMP 
PURG8 JSB NXT/S     NO; CACULATE THE NEXT TRACK AND SECT
      JMP CREA6     GO SET, WRITE & EXIT
      SPC 2 
PURG3 LDA TRAKA,I  SET TO SHOW
      CLB           NEXT AVAILABLE SECT 
      JMP CREA6     IS FIRST SECTOR 
      SPC 1 
PURG5 JSB WCSR      WRITE CURRENT SECTOR
      LDB SECT      GET SECTOR ADDRESS
      SZB,RSS       IF START OF TRACK 
      ISZ TRACK     DIRECTORY TRACK 
      ADB N14       SUBTRACT 14 SECTORS 
      SSB           IF NEGATIVE THEN
      ADB ##SEC     ADD THE NO. PER TRACK 
      STB SECT      SET NEW SECTOR ADDRESS
      JSB RWSUB     READ THE BLOCK
      LDA ABUF      SET ADDRESS FOR 
      ADA .128      LAST ENTRY
      JMP PURG7     IN THE BLOCK
      SPC 2 
EXPUR JSB EXSH      SEARCH FOR EXTENTS TO PURGE 
      JMP PURGE     GO PURGE EXTENT 
      SPC 2 
N14   DEC -14 
      SKP 
* 
* 
*          CREATE ACTION ROUTINE
* 
* 
CREAT LDA ID       SET UP EXCLUSIVE OPEN FLAG 
      IOR SIGN     ADD THE EXCLUSIVE BIT
      STA ID        SAVE IT 
      CLA,CLE      CLEAR THE EXTENT FLAG
      STA GSEC      SAVE IT FOR THE DIRECTORY 
      CPA P7        IS SIZE = 0 ? 
      CPA P6        YES, IS IT TYPE 0?
      RSS           ITS OK, CONTINUE
      JMP EX16      ZERO LENGTH FILE, ILLEGAL!
* 
* 
      LDA P3A       MOVE IT 
      JSB MOVE1     THE SAVE AREA 
      JSB SETDR     SET TO READ THE DIRECTORY 
      JSB N.SHR     SEARCH FOR THE NAME 
CREA0 CCE,RSS       NOT FOUND SKIP
      JMP EX2       FOUND - TAKE DUP NAME EXIT
* 
      LDB R1        WAS A RE-USABLE ENTRY FOUND?
      SSB,RSS       WELL! 
      JMP RUSE      YES, GO SET IT UP 
* 
      SZA           DIRECTORY FULL? 
      JMP CRSET     NO, GO SET UP ADDRESSES 
      LDB TMP1      GET DISC SPECS
      SZB           MULTI DISC SEARCH?
      JMP EX14      NO, REPORT DIRECTORY FULL 
      LDA P1        GET FUNCTION CODE 
      CPA .8        IS IT EXTENT WRITE (CREATE) 
      JMP EX14      YES, EXIT DIRECTORY FULL
      JMP NEXT      NO, GO TRY NEXT DISC
* 
CRSET JSB SETAD     SET THE ADDRESSES 
      CCE 
      LDA DIRA      MOVE IN 
      JSB MOVE1 
      LDA ID        SET THE OPEN FLAG 
      STA FLAGA,I 
      LDB BTRA      SET THE BAD TRACK POINTER 
CHKBT LDA B,I       IF END OF LIST
      SZA,RSS       THEN
      JMP EOL       CONTINUE
      CMA,CLE       ELSE SET
      ADA NXTR      BADTR TO
      SEZ,RSS       POINT TO
      JMP EOL       FIRST BAD TRACK 
      INB           => NXTR 
      JMP CHKBT 
EOL   STB BADTR     SET BAD TRACK POINTER 
      LDB NXSEC     GET THE NEXT TRACK
      LDA NXTR      AND SECT
CREA1 STA TRAKA,I   SET THE TRACK 
      ADB GSEC      ADD THE EXTENT WORD 
      STB SECTA,I   SET THE SECT/EXTENT 
      LDB #SEC,I    GET REQUESTED FILE SIZE 
      LDA BADTR,I   AND THE FIRST BAD TRACK 
      SZA           IF GOOD SKIP
      SSB,RSS       ELSE IF REST OF DISC SKIP 
      JMP CREA2     GO CALCULATE SIZE 
CREA3 INA           BAD TRACK ON REST OF DISC RQ
      ISZ BADTR     SET FILE ABOVE IT AND 
      CLB           TRY AGAIN 
      JMP CREA1 
      SPC 2 
CREA2 SSB           IF REST OF DISC 
      JMP CREA5     JMP 
* 
CREA7 JSB NXT/S     COMPUTE THE NEXT TRACK AND SECTOR 
      STA SETAD     SECTOR - SAVE LAST TRACK
      LDA BADTR,I   GET LAST AVAILABLE TRACK
      SZA,RSS       IF NOT BAD
      LDA LASTR     THE LAST ON DISC+1
      CMA           SUBTRACT FROM 
      SZB           BUMP TRACK
      INA           IF SOME OF IT USED
      ADA SETAD     LAST FILE TRACK 
      SSA           0 OR +? 
      JMP CREA4     YES; IT FITS
      LDA BADTR,I   NO; WON'T FIT 
      SZA           WAS IT A BAD TRACK? 
      JMP CREA3     YES; TRY ABOVE IT 
* 
      STA DIRA,I    NO  CLEAR THE ENTRY FROM BUFFER 
      LDA GSEC      IF EXTENT CREAT 
      SZA,RSS       THEN SKIP TO ERROR EXIT 
      JMP NEXT      ELSE TRY NEXT DISC
      JMP EX33      NO ROOM FOR EXTENT EXIT 
      SPC 1 
CREA4 LDA SETAD     IT FIT SO 
CREA6 STA NXTR      UPDATE THE NEXT 
      STB NXSEC     TRACK AND SECTOR
      ISZ WCS       SET THE WRITE FLAG
      LDA #SEC,I    GET THE RETURN PRAM 
      JSB RPRM      AND GO SET UP THE RETURN
      CCA           SET FIRST TO AVOID
      STA FIRST     RESETING THE #SECTORS/TRACK 
      JSB SETDR     SET UP TO READ FIRST
      STA FIRST     DIRECTORY BLOCK 
      JSB RDNXB     READ IT 
.2    DEC 2 
      CCE           MOVE NEW
      JSB DPMM      NEXT TRACK AND SECT WORDS 
      ISZ WCS       IN - SET TO WRITE 
      JMP EXIT      AND EXIT
      SPC 1 
CREA5 LDA TRAKA,I   REQUEST FOR REST OF DISC
      CMA,INA       COMPUTE THE 
      ADA LASTR     NUMBER OF 
      LDB SECTA,I   GET THE NUMBER OF SECTORS 
      CMB,INB       USED THIS TRACK 
      STB TMP3      AND SAVE
      MPY ##SEC     SECTORS 
      ADA TMP3      SUBTRACT NUMBER USED THIS TRACK 
      SZB,RSS       IF MORE THAN 32K
      SSA           THEN
      LDA MAXSZ     SET TO MAX ALLOWABLE(32K) 
      STA #SEC,I    SET IN THE FILE ENTRY 
      SZA           IF NON-ZERO 
      JMP CREA7     GO WRAP IT UP 
* 
      STA DIRA,I    CLEAR ENTRY 
      JMP NEXT      TRY NEXT DISC 
      SPC 3 
* 
*  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  STB TRACK     B HAS TRACK FROM EXISTANCE TEST 
      LDB R2        GET THE SECTOR AND
      STB SECT      SET IT
      JSB RWSUB     READ THE BLOCK TO CORE IF REQUIRED
      LDA N16       GET THE OFFSET (IT WAS SAVED +16) 
      ADA R3        AND SET UP THE ADDRESSES
      JSB SETAD 
      LDA TRAKA,I   SET THE FILE ADDRESSES
      STA NAME+4    IN THE ENTRY
      LDA SECTA,I 
      AND B377      PURGE POSSIBLE EXTENT FLAG
      ADA GSEC      ADD IN POSSIBLE NEW EXTENT FLAG 
      STA NAME+5
      LDA DIRA      MOVE THE ENTRY INTO THE BUFFER
      CCE 
      JSB MOVE1 
      LDA ID        SET POSSIBLE OPEN FLAG
      STA FLAGA,I   IN THE ENTRY
      ISZ WCS       SET THE WRITE FLAG
      LDA #SEC,I    SEND BACK THE FILE SIZE 
      JMP CREX      EXIT
      SPC 2 
MAXSZ OCT 77776 
      SKP 
* 
*          CHANGE NAME ACTION ROUTINE 
* 
* 
CNAM  LDA P4A      MOVE NEW NAME TO 
      CLE           GO THE RIGHT WAY
      JSB MOVE2     LOCAL SAVE AREA 
      LDA P4A       SET UP THE NAME 
      CLE           SET ADDRESSES 
      JSB MOVE1     FOR DUP CHECK 
      JSB SETDR     SET UP TO READ THE DIRECTORY
      JSB N.SHR     SEARCH FOR DUPLICATE NAME 
      RSS           NOT FOUND  SO SKIP
      JMP EX2       TAKE DUP NAME EXIT
      JSB DIRCK     GO GET DIRECTORY ENTRY
      LDA FLAGA,I   OPEN EXCLUSIVELY
      RAL,CLE,ERA   CLEAR EXCLUSIVE BIT AND SAVE IN E 
      CPA ID        TO CALLER?
      SEZ,CCE,RSS   YES SKIP
      JMP EX102     NO; REJECT
CNAM1 LDA DIRA      YES; MOVE 
      JSB MOVE2     THE NEW NAME IN 
      JSB EXSH      SEARCH FOR EXTENT OF THIS FILE
      JMP CNAM1     YES  GO SET NEW NAME
      SKP 
* 
*          LOCK ACTION ROUTINE
* 
* 
RLOCK LDA TMP1      DISC MUST BE SPECIFIED
      SZA,RSS 
      JMP EX101     NOT SPECIFIED - EXIT
* 
      JSB TSTDR     TEST LEGAL DIRECTORY
      JMP ROCK4     NOT LEGAL, ALLOW LOCK BUT RETURN -103 
      SZA           ANY OPEN FLAGS? 
      JMP EX8       YES, DON'T ALLOW LOCK 
      SPC 2 
ROCK4 STA R1        SAVE ERROR CODE 
      LDB DIRAD     LOCK GRANTABLE
      ADB N1        BACK UP TO LOCK WORD
      LDA ID        USE ID ADDRESS AS LOCK WORD 
      STA B,I       STORE IN LOCK WORD
      LDA R1        GET ERROR CODE IN A 
      JMP CREX      EXIT
      SKP 
* 
*          UNLOCK ACTION ROUTINE
* 
* 
ULOCK CLA           FORCE A NEW READ
      STA LDRLU      OF THE DIRECTORY 
      JSB TSTDR     TEST DIRECTORY
      JMP CREX      CORRUPT! EXIT 
      CLA           CLEAR ID FOR STORE
      STA ID        INTO CARTRIDGE DIRECTORY
      JMP ROCK4     AND GO SET IT 
      SKP 
* 
*         MOUNT ACTION ROUTINE
* 
* 
LOCK5 LDA P7        FETCH SUBFUNCTION CODE
      LDB P1        FETCH FUNCTION
      CPB .7        IF MASTER DIRECTORY UPDATE, 
      SSA,RSS       AND NOT "DC" CALL--CONTINUE 
      JMP CKER      ELSE EXIT--AND DETERMINE ERR TYPE 
* 
*  THIS IS THE WAY "IN" (DISC REF UPDATE) AND MOUNT 
*    CARTRIDGE GET IN.
* 
      LDB CRDIR     FETCH MASTER DIRECTORY ADDRESS
      CPA N1        IF SUBFUNCTION=-1 
      JMP MDNXT     THEN GO UPDATE DISKETTE REF 
* 
*   ELSE DO MOUNT WORK
*   FIRST SEARCH FOR DUPLICATE LABEL
*   LOCK ROUTINE HAS ALREADY SEARCHED FOR DUPLICATE LU. 
*   IF FOUND WILL GO TO MDUDT 
* 
MCLB? LDA B,I       FETCH FIRST ENTRY 
      SZA,RSS       END?
      JMP OKMC      YEP--B=AVAILABLE SPACE
* 
      ADB .2        ADVANCE TO LABEL
      LDA B,I       FETCH IT
      CPA P5        MATCH?
      JMP EX12      YES--DUPLICATE LABEL EXIT 
* 
      ADB .2        ADVANCE TO NEXT ENTRY 
      CPB $MDSP     OUT OF ROOM?
      JMP EX14      YEP-BYE BYE 
      JMP MCLB?     GO CHECK THIS ENTRY 
* 
* 
*    B=DESTINATION ADDRESS
* 
OKMC  LDA P3A       FETCH ADDRESS OF NEW DIRECTORY ENTRIES
      JSB $LIBR     GO PRIVILEDGED TO AVOID PROBLEMS
      NOP              WITH BEING OFF'D 
* 
MV4   CCE           SET E TO MOVE PARAMETERS
      JSB MOVE      GO MOVE IT DOWN 
N4    DEC -4
      JSB $LIBX     FINISHED WITH PRIVILEDGED 
      DEF *+1         PROCESSING
      DEF EXIT4      OK-- ALL DONE SO EXIT
      SPC 2 
.7    DEC 7 
      SKP 
* 
*          UPDATE ACTION ROUTINE
* 
* 
* UPDATE DISC REFERENCE # 
* A CHECK FOR DUPLICATE LABEL HAS JUST BEEN DONE IN LOCK
* NOW JUST FIND THE CORRECT LU AND DROP THE NEW LABEL IN. 
* 
* 
MDNXT LDA B,I       FETCH FIRST ENTRY 
      CPA P3        THIS THE RIGHT LU?
      JMP GTIT      YUP YUP YUP 
* 
      ADB .4        NOPE--SO ADVANCE TO NEXT ENTRY
      CPB $MDSP     END OF DIRECTORY
      JMP EX32      DISC NOT FOUND EXIT 
      JMP MDNXT     GO CHECK THIS ONE 
* 
* 
GTIT  ADB .2        ADVANCE TO LABEL WORD 
      LDA P2A,I     ADDRESS OF WORD HOLDING NEW LABEL 
* 
      STA B,I 
      JMP EXIT4 
      SPC 2 
.4    DEC 4 
      SKP 
* 
*          DISMOUNT ACTION ROUTINE
* 
* 
MDUDT LDA P7        FETCH SUBFUNCTION 
      SZA           THIS ENTRY IS USED BY "DC" ONLY 
      JMP EX12      DUPLICATE LU OR LABEL 
* 
* 
      LDB ALU       IF SAME LU AS LAST ONE REF
      CPB LDRLU     CLEAR IT TO PREVENT 
      STA LDRLU     MISTAKEN ID.
* 
* CALCULATE LEGNTH OF MOVE(TO CLOSE UP GAP)B=NEXT ADDRESS IN DIRECTORY
* 
      LDB DIRAD     GET ADDRESS OF CARTRIDGE + 4
      CMB,INB       SET ADDRESS NEGATIVE
      ADB $MDSP     ADD TO STOP ADDRESS 
      CMB,INB       COMPLEMENT LENGTH 
      STB LN1       SAVE THE LEGNTH 
      LDA DIRAD     FETCH "FROM" ADDRESS
      LDB A         "TO" ADDRESS
      ADB N4             = "FROM" -4
* 
      JSB $LIBR     GO PRIVILEDGED
      NOP 
      JSB MOVE
LN1   NOP           CLOSE UP THE GAP
* 
*  CLEAR FIRST WORD IN LAST ENTRY OF DIRECTORY
* 
CLR   LDB $MDSP     FETCH STOP ADDRESS
      ADB N4        BACK UP TO BEGINING OF LAST ENTRY 
      LDA DZERO     ADDRESS OF A ZERO 
* 
      JMP MV4       GO MOVE IT
* 
      SKP 
*          EXIT CODE
* 
EX2   LDA .2
      RSS 
EX6   LDA .6
      RSS 
EX8   LDA .8
      RSS 
EX13  LDA .13 
      RSS 
EX14  LDA .14 
      CMA,INA,RSS 
EX11  LDA N11 
      RSS 
EX12  LDA .12 
      JMP CREX
EXIT3 ISZ WCS       SET WRITE FLAG
EXIT4 CLA           AND TAKE
      JMP CREX      ACCEPT EXIT 
EX16  LDA N16 
      JMP CREX
EX32  LDA N33       DISC NOT FOUND EXIT 
      INA,RSS 
EX33  LDA N33       NO ROOM EXIT
      JMP CREX      EXIT
EX46  LDA N46 
      JMP CREX
EX99  LDA N99 
      JMP CREX
EX101 LDA N102
      INA,RSS 
EX102 LDA N102
CREX  JSB RPRM      SET THE RETURN PRAMS
* 
EXIT  JSB WCSR      WRITE THE SECTOR
      LDA R1A       SET SOURCE ADDRESS FOR MOVE 
      LDB ADRTN     SET DESTINATION ADDRESS FOR MOVE
      CCE           SET MOVE PARAMETERS 
      JSB MOVE      MOVE RETURN PARAMETERS INTO USER'S AREA 
N5    DEC -5
      CLA           CLEAR FLAG FOR SUCCESSFUL COMPLETION
      STA OFTST 
      JSB $LIBX     CALL THE SYSTEM TO RETURN 
      DEF TDB       AS A RE-ENTRANT SUBROUTINE
      DEC 0 
      SPC 3 
CKER  LDA P2        GET -LU/CRN PARAMETER 
      SZA           IS IT 0 (MULTI-DISC SEARCH)?
      JMP EX32      NO, MUST HAVE NOT FOUND DISC
CKERR LDA P1        GET FUNCTION CODE PARAMETER 
      CPA .1        CREATE CALL?
      JMP EX33      YES, MUST NOT HAVE BEEN ENOUGH ROOM 
      JMP EX6       MUST HAVE NOT FOUND FILE FOR OPEN CALL
      SKP 
* 
*     CONSTANTS 
* 
.1    DEC 1 
.6    DEC 6 
.8    DEC 8 
.12   DEC 12
.13   DEC 13
.14   DEC 14
.20   DEC 20
* 
B377  OCT 377 
B170K OCT 170000
* 
N1    DEC -1
N7    DEC -7
N8    DEC -8
N33   DEC -33 
N46   DEC -46 
N99   DEC -99 
N102  DEC -102
* 
SIGN  OCT 100000
* 
*   ADDRESSES 
* 
R1A   DEF R1
CRDIR DEF $CDIR+0 
ANAME DEF NAME
ADIRA DEF DIRA
ABUF3 DEF BUF3
ANXSC DEF NXSEC 
NXSCA DEF BUF+5 
BTRA  DEF BAD1
DZERO DEF ZERO
P1A   DEF P1
P2A   DEF P2
P3A   DEF P3
P4A   DEF P4
RDPSA DEF RDPS
IDA   DEF ID
      SKP 
* 
*     VARIBLES
*  THE FOLLOWING ARE IN THE TEMPORARY DATA BUFFER (TDB) 
* 
TDB   NOP 
      DEC 92        SIZE OF THE TEMPORARY DATA BLOCK
RTNAD NOP           RETURN ADDRESS
OFTST NOP           VALID EXIT FLAG 
* 
ADRTN NOP           USER'S RETURN PARAMETERS ADDRESS
* 
ATRAK NOP 
* 
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 
P6    NOP           PASSED PARAMETER #6 
      NOP 
      NOP 
P7    NOP           PASSED PARAMETER #7 
P8    NOP           PASSED PARAMETER #8 
P9    NOP           PASSED PARAMETER #9 
* 
R1    NOP           RETURN PARM #1
R2    NOP           RETURN PARM #2
R3    NOP           RETURN PARM #3
R4    NOP           RETURN PARM #4
R5    NOP           RETURN PARM #5
* 
#FMT  DEC 14        SECTOR SKIP VALUE FOR DIRECTORY 
N#FMT DEC -14       NEGATIVE OF #FMT
##SEC NOP           NUMBER OF SECTORS/TRACK 
* 
COUN1 NOP 
COUN2 NOP 
* 
GSEC  NOP           EXTENT FLAG 
VALDF NOP           VALID FLAG (OPEN FLAG/LOCK WORD)
* 
TMP1  NOP 
TMP2  NOP 
TMP3  NOP 
* 
FROM  NOP           SOURCE ADDRESS FOR MOVE 
COUNT NOP           LOOP INDEX FOR MOVE 
* 
NAME  BSS 9         BUFFER USED BY MOVE1
CSEC  EQU NAME+5
* 
BUF3  BSS 3         BUFFER USED BY MOVE2
* 
DIRA  NOP           -  THESE MUST REMAIN IN ORDER 
      NOP           ! 
      NOP           ! 
TYPE  NOP           ! 
TRAKA NOP           ! 
SECTA NOP           ! 
#SEC  NOP           ! 
RL    NOP           ! 
SC    NOP           ! 
FLAGA NOP           - 
* 
NXSEC NOP           -  THE NEXT 11 WORDS MUST REMAIN IN ORDER 
#SECT DEC 96        ! 
LASTR NOP           ! 
#TRK  NOP           ! 
NXTR  NOP           ! 
BAD1  NOP           ! 
BAD2  NOP           ! 
BAD3  NOP           ! 
BAD4  NOP           ! 
BAD5  NOP           ! 
BAD6  NOP           ! 
* 
*     THE FOLLOWING VARIBLES ARE CLEARED IF D.RTR IS "OF'ED" AND
*     DOESN'T COMPLETE NORMALLY 
* 
RDPS  NOP           CURRENT DISC POINTER
RW    NOP           READ/WRITE FLAG USED BY RWSUB 
DRLU  NOP           DIRECTORY LU
PDSLU NOP           DISC LU WITH PROTECT BITS 
LDRLU NOP           LAST DIRECTORY LU 
LTRAC NOP           LAST TRACK
LSECT NOP           LAST SECTOR READ/WRITTEN BY RWSUB 
LTR   NOP 
FIRST NOP 
BADTR NOP 
* 
DIRAD NOP           -  THESE MUST REMAIN IN ORDER 
TRACK NOP           ! 
SECT  NOP           ! 
WCS   NOP           ! 
ALU   NOP           ! 
DITR  NOP           ! 
ZERO  NOP           ! 
      NOP           ! 
      NOP           ! 
      NOP           - 
* 
A     EQU 0 
B     EQU 1 
      SKP 
* DIRCK     READ A DIRECTORY ENTRY - SET FLAGS
*           CHECK OPEN FLAGS ETC. 
* 
DIRCK NOP 
      LDA ALU       DO WE ALREADY 
      CPA RDPS      HAVE THE DISC SPECS?
      RSS           YES  SO SKIP SET UP 
      JSB SETPR     SET UP THE DISC PARAMETERS
      LDA DITR      SET 
      STA TRACK     TRACK 
      LDA P3        GET THE PASSED
      AND B377      SECTOR
      STA SECT      AND SET IT
      XOR P3        NOW GET THE 
      ALF,ALF       OFFSET
      ADA ABUF      ADD THE BUFFER ADDRESS
      JSB SETAD     SET DIRECTORY ADDRESSES 
      JSB RWSUB     READ THE BLOCK
      LDA DIRA      MOVE THE ENTRY TO LOCAL 
      JSB MOVE1     STORAGE 
      CLE           CLEAR E JUST IN CASE ANYBODY EXPECTS IT 
      JMP DIRCK,I 
      SKP 
* DPMM  MOVE DISC PARAMETERS FOR CURRENT UNIT 
*           CALLING SEQUENCE
* 
*           E=0  -  SAVE PARAMETERS 
*           E=1  -  MOVE PARAMETERS BACK
* 
* 
DPMM  NOP 
      LDA NXSCA     GET SOURCE ADDRESS (BUF+5)
      LDB ANXSC     GET DESTINATION ADDRESS (NXSEC) 
      SEZ,CCE       CHANGE THE DIRECTION OF MOVE? 
      SWP           YES 
      JSB MOVE      NOW MOVE PARAMETERS 
N11   DEC -11 
      LDB #TRK
      ADB TRACK     COMPUTE THE ADDRESS OF TRACK
      STB LTR       ELSE SET THE ADDRESS
      LDB DRLU      SAVE THE CURRENT LU 
      STB RDPS      FOR CORE RESIDENT SPEED 
* 
*  ISOLATE AND SAVE THE SECTOR OFFSET AND #SECTORS / TRACK
* 
*  THE HIGH EIGHT BITS FORM THE OFFSET
*  THE LOW EIGHT FORM THE #SECT/TRACK 
* 
      LDA #SECT     FETCH THE #SECT/TRACK&OFFSET
      ALF,ALF        POSITION 
*                      THE SKIP FACTOR TO LOW END 
      AND B377      ISOLATE IT
      SZA,RSS       ZERO DEFAULTS TO 14 
      LDA .14 
      STA #FMT       SAVE IT
      CMA,INA       SET IT NEGATIVE (SO YOU CAN SEE BLOCK 0)
      STA N#FMT     SAVE IT ALSO
* 
      LDA #SECT      FETCH THE ORIGIONAL WORD 
      AND B377      ISOLATE THE SECTORS/TRACK INFO
      STA ##SEC     SAVE ANOTHER ONE
      JMP DPMM,I
      SKP 
EXSH  NOP           DIRECTOR SEARCH FOR EXTENTS TO MODIFY 
      ISZ WCS       SET THE WRITE FLAG
      JSB EXSHR    SEARCH FOR EXTENT
      JMP EXIT4     NOT FOUND SO EXIT 
      JMP EXSH,I    FOUND RETURN
      SPC 5 
EXSHR NOP           EXTENT SEARCH ROUTINE 
      LDB DEF       SET RETURN ADDRESS IN 
      STB N.SHR     NAME SEARCH ROUTINE 
      JMP NSHR0    GO TO NAME SEARCH
DEF   DEF *+1       RETURN ADDRESS FOR NAME SEARCH
      JMP EXSHR,I   NOT FOUND SO EXIT 
      JSB SETAD     FOUND  SET THE ADDRESSES
      LDB EXSHR     STEP THE RETURN ADDRESS 
      CCE,INB       AND 
      LDA SECTA,I   MAKE SURE THIS IS NOT THE MAIN
      CPA CSEC      SAME AS MAIN? 
      CCA,RSS 
      JMP B,I       RETURN
* 
      STA R1        AFTER WE CLEAR THE FOUND FLAG 
      JMP CSER      CONTINUE THE SEARCH 
      SKP 
* 
*     FID     TEST CARTRIDGE HEADER FOR LEGALITY
* 
FID   NOP 
      LDB DIRA,I    FIRST WORD
      SSB,RSS         MUST HAVE SIGN SET
      JMP FID,I     NOT INITIALIZED 
* 
      LDB TYPE,I    CRN MUST BE 
      SSB,RSS       POSITIVE AND
      SZB,RSS       NON-ZERO
      JMP FID,I     NOT LEGAL 
* 
      LDB SC,I      NUMBER OF DIRECTORY 
      SSB,RSS       TRACKS MUST BE NEGATIVE 
      JMP FID,I     NOT LEGAL 
* 
      LDB RL,I      GET LOWEST DIRECTORY TRACK
      CMB,INB       SET NEGATIVE
      ADB TRAKA,I   FIRST AVAILABLE TRACK 
      SSB,RSS       MUST BE < DIRECTORY 
      JMP FID,I     NOT LEGAL 
* 
      LDB FLAGA,I   NEXT AVAIL. FMP TRACK 
      SSB           MUST BE POSITIVE
      JMP FID,I       (NOT LEGAL) 
      CMB,INB 
      ADB RL,I      AND LESS THAN OR EQUAL
      SSB           TO LOWEST DIRECTORY TRACK 
      JMP FID,I       (NOT LEGAL) 
* 
      ISZ FID       LEGAL, RETURN P+1 
      JMP FID,I     RETURN
      SKP 
* 
*  FLAG     CHECKS FOR VALID OPEN FLAGS - ASSUMES FLAGA POINTS
*           TO THE FLAG AREA
* 
FLAG  NOP 
      CLA           CLEAR NUMBER OF 
      STA COUN2     OPEN FLAGS
      LDA N7        SET UP COUNT
      STA COUN1     FOR NUMBER OF POSSIBLE OPEN FLAGS 
      LDA FLAGA     GET FLAG AREA 
      STA TMP3      AND SAVE AS POINTER 
* 
FLAG1 LDA TMP3,I    GET NEXT OPEN FLAG
      SZA,RSS       IF FLAG IS ZERO 
      JMP FLAG4       THEN CHECK THE NEXT FLAG
      RAL,CLE,ERA   CLEAR EXCLUSIVE OPEN BIT
      CPA ID        IF FLAG IS EQUAL TO CURRENT PROGRAM 
      JMP FLAG2       THEN FORCE CLOSED 
* 
*     CHECK IF SEQUENCE # IS THE SAME 
* 
      LDA TMP3,I    GET OPEN FLAG AGAIN 
      JSB VALID     GO CHECK VALIDITY OF OPEN FLAG
      JMP FLAG3     VALID, INCREMENT COUNT
* 
*     CLEAR OPEN FLAG 
* 
FLAG2 CLA           INVALID, SO CLEAR OPEN FLAG 
      STA TMP3,I    AND STORE IN FLAG 
      ISZ WCS       SET WRITTEN-ON FLAG 
      JMP FLAG4     SKIP INCREMENT OF VALID OPEN FLAGS
* 
FLAG3 ISZ COUN2     INCREMENT VALID OPEN FLAG COUNT 
FLAG4 ISZ TMP3      INCREMENT OPEN FLAG POINTER 
      ISZ COUN1     INCREMENT LOOP COUNTER, DONE? 
      JMP FLAG1       NO, LOOP
      JMP FLAG,I      YES, EXIT 
      SKP 
LAST? NOP 
      LDB TYPE,I    IF TYPE ZERO
      SZB,RSS          FILE 
* 
      JMP LAST?,I   AS NOT LAST 
      JSB NXT/S     COMPUTE THE NEXT TRACK AND SECTOR 
      CPA NXTR      SAME TRACK? 
      CCA           YES; A_1
      CPB NXSEC     SAME AS NEXT SECTOR?
      INA,SZA       YES; WAS IT SAME TRACK ALSO?
      JMP LAST?,I   NO; NOT LAST FILE  EXIT P+1 
      ISZ LAST?     YES; LAST FILE
      JMP LAST?,I   EXIT P+2
      SPC 5 
*  MOVE SUBROUTINE
*  A = SOURCE     B = DESTINATION     E = 0, SET ADDRESSES
*                                         1, MOVE PARAMETERS
*  JSB MOVE 
*  DEC -N         N = NUMBER OF PARAMETERS
* 
MOVE  NOP 
      STA FROM      STORE SOURCE ADDRESS
      LDA MOVE,I    GET THE COUNT 
      STA COUNT     AND SAVE IT 
      ISZ MOVE      POINT TO RETURN ADDRESS 
      SSA,RSS       IS COUNT ZERO OR POSITIVE?
      JMP MVOUT     YES, DON'T DO MOVE
* 
LOOP  LDA FROM      GET SOURCE ADDRESS
      SEZ           MOVE ADDRESSES OR PARAMETERS
      LDA A,I         PARAMETERS! 
      STA B,I       STORE IN DESTINATION
      INB           INCREMENT DESTINATION 
      ISZ FROM      INCREMENT SOURCE ADDRESS
      ISZ COUNT     INCREMENT COUNT 
      JMP LOOP      LOOP IF NOT DONE
* 
MVOUT LDA FROM      PUT NEXT ADDRESS IN A 
      JMP MOVE,I    EXIT
      SKP 
* MOVE1/2     TO MOVE DIRECTORY ENTRIES TO/FROM 
*             THE LOCAL SAVE AREAS
* 
*             CALLING SEQUENCE: 
* 
*             IF E=0, THEN A=SOURCE AND B=DESTINATION 
*             IF E=1, THEN A=DESTINATION AND B=SOURCE 
* 
*             MOVE1   MOVES 9 WORDS 
*             MOVE2   MOVES 3 WORDS 
* 
MOVE1 NOP 
      LDB ANAME     SET B TO ADDRESS OF NAME BUFFER 
      SEZ,CCE       CHANGE DIRECTION OF MOVE? (ALSO E=1 TO MOVE PARAMETERS) 
      SWP            YES, SO SWITCH CONTENTS OF A AND B 
      JSB MOVE      NOW MOVE PARAMETERS 
      DEC -9        9 PARAMETERS REQUIRED 
      JMP MOVE1,I   RETURN
      SPC 5 
MOVE2 NOP 
      LDB ABUF3     SET B TO ADDRESS OF 3 WORD BUFFER 
      SEZ,CCE       CHANGE DIRECTION OF MOVE? (ALSO E=1 TO MOVE PARAMETERS) 
      SWP            YES, SO SWITCH CONTENTS OF A AND B 
      JSB MOVE      NOW MOVE PARAMETERS 
N3    DEC -3        3 PARAMETERS REQUIRED 
      JMP MOVE2,I   RETURN
      SKP 
* N.SHR     DIRECTORY SEARCH ROUTINE
*           TARGET NAME IN NAME 
*           RETURNS:
*           P+1  END OF DIRECTORY   A=NEXT ADDR. (IF A=0 END OF SPACE)
*           P+2  FOUND RETURN   A=ENTRY ADDR. 
* 
N.SHR NOP 
NSHR  JSB RDNXB     READ THE DIRECTORY
      JMP N.SHR,I   END OF DISC RETURN
NSHR0 LDA ABUF      SET A TO THE BUFFER ADDRESS 
      LDB N8        SET COUNT FOR THE NO. IN A BLOCK
      STB COUN1 
NSHR1 CCE           SET FOUND FLAG (E=1)
      LDB ANAME     SET THE NAME ADDRESS
      STB TMP2      IN TMP2 
      LDB N3        SET FOR 3-WORD NAME 
      STB COUN2 
      LDB A,I       IF PURGED ENTRY 
      INB,SZB,RSS    THEN 
      JMP CKRUS      CHECK IF REUSABLE
* 
NSHR2 LDB A,I       GET A NAME WORD 
      SZB,RSS       IF ZERO - END OF DIRECTORY
      JMP N.SHR,I   SO EXIT 
* 
      CPB TMP2,I    MATCH?
      INA,RSS       YES - SET FOR NEXT WORD SKIP
      CLE,INA       NO  - SET NOT FOUND - STEP NAME 
      ISZ TMP2      STEP LOCATIONS
      ISZ COUN2     AND COUNT MORE NAME 
      JMP NSHR2     YES; GO DO IT 
* 
      CLB,SEZ,CCE,INB  NO; FOUND? 
      JMP NSHR3     YES; GO TAKE FOUND EXIT 
* 
NSHR4 ADA .13       NO; SET FOR NEXT ENTRY
NSHR5 ISZ COUN1     DONE WITH BLOCK?
      JMP NSHR1     NO; DO NEXT ENTRY 
      JMP NSHR      YES; GO READ NEXT BLOCK 
NSHR3 ADB N.SHR     FOUND - STEP RETURN ADDRESS 
      ADA N3        ADJUST TO START OF ENTRY
      JMP B,I       RETURN
      SPC 3 
CKRUS ADA .6        TO BE REUSABLE IT MUST BE THE 
      LDB A,I       SAME SIZE 
      ADA .10       SET A FOR FAILURE 
      CPB NAME+6    SAME SIZE?
      JMP CKRU1      YES, GO CHECK FURTHER
      JMP NSHR5      NO, CONTINUE SEARCH
* 
CKRU1 LDB R1        IF ALREADY HAVE ONE 
      SSB,RSS       THEN JUST 
      JMP NSHR5     CONTINUE
* 
      LDB TRACK     ELSE SAVE THE DIRECTORY 
      STB R1        ADDRESS (MUST SAVE A FOR
      LDB SECT               CONTINUATION OF SCAN)
      STB R2        R1,R2 = DISC ADDRESS
      STA R3        R3 = OFFSET +16 
      JMP NSHR5     CONTINUE THE SCAN 
      SPC 2 
.10   DEC 10
      SKP 
* 
NXT/S NOP           CACULATE THE NEXT TRACK AND SECTOR
      LDB #SEC,I    GET THE FILE SIZE 
      LDA SECTA,I   GET THE STARTING SECTOR OF THE FILE 
      AND B377      ISOLATE 
      ADB A         SUM 
      LSR 16        EXTEND TO A 
      DIV ##SEC     DIVIDE BY THE NO SECT PER TRACK 
      ADA TRAKA,I   ADD THE CURRENT TRACK ADDRESS 
      JMP NXT/S,I   RETURN A=NEXT TRACK,B=NEXT SECTOR 
      SPC 5 
* RDNXB     READ NEXT DIRECTORY BLOCK 
* 
RDNXB NOP 
      JSB UDAD      UPDATE THE ADDRESSES
      JMP RDNXB,I   END OF DIRECTORY RETURN 
      JSB RWSUB     READ THE BLOCK
      ISZ RDNXB     STEP TO OK RETURN 
      ISZ FIRST     FIRST BLOCK?
      JMP RDNXB,I   NO; SO RETURN 
      SPC 1 
      CLE 
      JSB DPMM
      JMP RDNXB,I   RETURN
      SPC 3 
*  RPRM             SET RETURN PARAMETERS 
RPRM  NOP 
      STA R1        SET FIRST RETURN PRAM 
      LDA TRACK     TRACK,LU
      LSL 6         TO
      ADA ALU       RETURN
      STA R2        TWO 
      LDA ABUF      OFFSET
      CMA,INA       AND 
      ADA DIRA      SECTOR
      ALF,ALF       TO
      ADA SECT      RETURN
      STA R3        3 
      LDA TRAKA,I   TRACK OF FILE TO
      STA R4        RETURN 4
      LDA SECTA,I   GET THE SECTOR ADDRESS
      AND B377      ISOLATE IT
      LDB ##SEC     GET THE NUMBER OF SECTORS /TRACK
      BLF,BLF       ROTATE AND
      ADA B         COMBINE WITH THE SECTOR 
      STA R5        RETURN 5
      JMP RPRM,I
      SKP 
*  RWSUB     ROUTINE TO READ OR WRITE A TWO-SECTOR BLOCK
* 
RWSUB NOP 
      LDA RW        FETCH THE NEW POINTERS
      SLA,RSS       IF WRITE THEN 
      JMP RWSU1     GO DO IT
      LDB DRLU
      CPB LDRLU     ELSE IF  (TEST LU)
      LDB N7        SAME BLOCK AS 
      LDA TRACK     CURRENT ONE 
      CPA LTRAC     THEN  (TEST TRACK)
      INB 
      LDA SECT      NO
      CPA LSECT     ACTION IS  (TEST SECTOR)
      CLE,INB 
      CPB N5        REQUIRED SO 
      JMP RWSUB,I   RETURN  (IT IS SAME AS LAST SECTOR READ)
RWSU1 JSB EXEC      NOT SAME BLOCK  CALL EXEC 
      DEF RTN       RETURN
      DEF RW        READ WRITE CODE 
      DEF PDSLU     LU (WITH PROTECT BITS)
ABUF  DEF BUF       BUFFER
      DEF .128      128 WORDS 
      DEF TRACK     ON TRACK &
      DEF SECT      SECTOR
RTN   JMP EX99      ABORT RETURN, EXIT
      CLA,CLE       CLEAR THE WRITE 
      STA WCS       FLAG
      LDA DRLU      SET UP LAST POINTERS FOR NEXT TIME
      STA LDRLU 
      LDA TRACK     SAVE THE TRACK
      STA LTRAC     ADDRESS AND THE 
      LDA SECT      SECTOR
      STA LSECT     ADDRESS 
      CPB .128      DISC ERR? 
      JMP RWSUB,I   NO - RETURN 
      STA LDRLU     YES; SET NOT IN CORE FLAG 
      LDA N1        YES - TAKE DISC ERR EXIT
      JMP CREX
      SPC 2 
.128  DEC 128 
      SKP 
* SETAD     TO SET UP ADDRESSES FOR DIRECTORY ENTRY IN BUF AT 
*           ADDRESS POINTED TO BY A 
* 
* 
SETAD NOP 
      LDB ADIRA     SET B TO DESTINATION ADDRESS
      CLE           SET E TO SET UP ADDRESSES 
      JSB MOVE
N10   DEC -10       10 ADDRESSES REQUIRED 
      JMP SETAD,I   RETURN
      SPC 5 
*  SETDR     ROUTINE TO SET UP TO READ A DIRECTORY
* 
SETDR NOP 
      JSB WCSR      WRITE CURRENT SECT
      LDA .128      PRESET # SET TO AVOID DIVIDE (VALUE DOESN'T MATTER) 
      ISZ FIRST     (EXCEPT WHEN REWRITING) 
      STA ##SEC     PROBLEMS
      CCA           SET FIRST 
      STA FIRST     FLAG TO INDICATE FIRST BLOCK
      LDA ATRAK     SET THE TRACK 
      STA TRACK     ADDRESS 
      LDA ALU       AND THE LU
      STA DRLU      ADDRESS 
      ADA B7700     ADD IN PROTECT BITS 
      STA PDSLU     STORE AS PROTECTED DISC LU
* 
      LDA N#FMT     ADD SECTOR BUMP FACTOR(=14 UNTIL1ST BLK READ) 
      STA SECT      SET THE SECTOR
      JMP SETDR,I   RETURN
      SPC 5 
SETPR NOP           READ AND SET UP THE DISC PARAMETERS 
      JSB SETDR     SET UP TO ACCESS THE DIR
      JSB RDNXB     READ AND SET PRAMS
N16   DEC -16 
      JMP SETPR,I   RETURN TO CALLER
      SPC 2 
B7700 OCT 7700
      SKP 
* 
*     TSTDR - TEST DIRECTORY FOR OPEN FLAGS AND FILE SIZE AND ADDRESS 
*             CONSISTENCY.  CALLED BY LOCK AND UNLOCK ROUTINES. 
* 
*     JSB TSTDR 
*       <ILLEGAL DIRECTORY, A = -103> 
*       <LEGAL DIRECTORY, A = NUMBER OF OPEN FLAGS> 
* 
* 
TSTDR NOP           TEST DIRECTORY SUBROUTINE 
      JSB SETDR     SET TO SEARCH DIRECTORY 
      JSB RDNXB     SET UP POINTERS TO READ CARTRIDGE HEADER
      NOP           EOD RETURN NOT USED 
      LDA ABUF      GET POINTER TO CARTRIDGE HEADER 
      JSB SETAD     SET UP POINTERS IN DIRA BUFFERS 
      JSB FID       LEGAL HEADER? 
      JMP ILDIR     ILLEGAL DIRECTORY, EXIT 
      LDA TRAKA,I   GET LOWEST TRACK IN USE FROM HEADER 
      STA CALTR     AND PUT IN CALCULATED TRACK VALUE 
      CLA           SET 0 INTO
      STA CALSC      CALCULATED SECTOR
      STA FLGCT     CLEAR FLAG COUNT
      LDA N8        SET COUNTER FOR 8 ENTRIES 
      STA TCNT      SAVE LOOP COUNTER 
      JMP NXFIL     GO PROCESS FIRST ENTRY
* 
TDIR1 JSB RDNXB     READ NEXT ENTRY BLOCK 
      JMP EODIR     END OF DIRECTORY CHECKS 
      LDA N8        SET COUNTER FOR 8 ENTRIES 
      STA TCNT      SAVE LOOP COUNT 
      LDA ABUF      SET A TO ADDRESS OF FIRST 
TDIR2 JSB SETAD     SET UP DIRECTORY ENTRY ADDRESSES
      LDA DIRA,I    GET FIRST NAME WORD 
      SZA,RSS       END OF DIRECTORY? 
      JMP EODIR     YES, GO MAKE FINAL CHECKS 
* 
      LDA TYPE,I    GET FILE TYPE 
      SZA,RSS       IF TYPE 0, DON'T DO DIRECTORY 
      JMP CNTOP     ADDRESS CHECKS
* 
      LDA #SEC,I    GET FILE SIZE 
      SZA           FILE SIZE 0?
      SSA            OR NEGATIVE? 
      JMP ILDIR     YES, ILLEGAL DIRECTORY
* 
      LDA TRAKA,I   GET CURRENT TRACK ADDRESS 
      CMA,INA       TEST IF IT IS GREATER THAN
      ADA CALTR     THE CALCULATED NEXT TRACK 
      SSA           IS IT?
      JMP ADROK     YES, GO DO NEXT TEST
      LDA TRAKA,I   IS CURRENT TRACK EQUAL
      CPA CALTR      TO THE CALCULATED TRACK? 
      RSS           YES, HAVE TO TEST THE SECTOR ADDRESS
      JMP ILDIR     NO, CURRENT < CALCULATED, ERROR 
      LDA SECTA,I   GET SECTOR ADDRESS FOR COMPARISON 
      AND B377      MASK OFF EXTENT NUMBER
      ADA CALSC     COMPARE TO CALCULATED SECTOR (COMPLEMENTED) 
      SSA           IS CALC SECT =< CURRENT SECT? 
      JMP ILDIR     NO, ERROR 
* 
ADROK JSB NXT/S     CALCULATE NEXT TRACK AND SECTOR 
      CMB,INB       COMPLEMENT SECTOR VALUE 
      STA CALTR     SAVE CALCULATED TRACK 
      STB CALSC     SAVE COMPLEMENTED SECTOR
* 
CNTOP JSB FLAG      COUNT OPEN FLAGS
      LDA COUN2     GET NUMBER OF OPEN FLAGS
      ADA FLGCT     ADD TO TOTAL FLAG COUNT 
      STA FLGCT     SAVE TOTAL COUNT
* 
NXFIL LDA DIRA      GET CURRENT ENTRY'S ADDRESS 
      ADA .16       STEP TO NEXT ENTRY
      ISZ TCNT      END OF BLOCK? 
      JMP TDIR2     NO, TEST NEXT ENTRY 
      JMP TDIR1     YES,READ NEXT BLOCK 
* 
EODIR LDA NXTR      GET NEXT AVAIL. TRACK FROM CART. HEADER 
      CPA CALTR     SAME AS CALCULATED? 
      RSS           YES, CHECK SECTORS
      JMP ILDIR     NO, DIRECTORY ILLEGAL 
      LDA CALSC     GET COMPLEMENT OF CALCULATED NEXT SECT. 
      ADA NXSEC     ADD NEXT AVAIL. SECT FROM HEADER
      SZA           SAME? 
      JMP ILDIR     NO, DIRECTORY ILLEGAL 
* 
      LDA FLGCT     RETURN WITH FLAG COUNT IN A 
      ISZ TSTDR     DIRECTORY OK, STEP RETURN ADDRESS 
      JMP TSTDR,I   RETURN
* 
ILDIR LDA N103      RETURN WITH A = -103
      JMP TSTDR,I   RETURN
* 
* 
CALTR NOP           CALCULATED NEXT TRACK 
CALSC NOP           CALCULATED NEXT SECTOR
TCNT  NOP           TEMPORARY COUNTER 
FLGCT NOP           OPEN FLAG COUNT 
* 
.16   DEC 16
N103  DEC -103
      SKP 
* UDAD  --  UPDATE THE DIRECTORY ADDRESS
* 
* 
*    THE SECTOR OFFSET MUST BE KEPT ON THE DISK ITSELF
* 
*     CKECK ALL REFS TO IT BEFORE CHANGING
* 
* 
* 
UDAD  NOP 
      JSB WCSR      WRITE CURRENT BLOCK 
      LDA #FMT      SET SECTOR BUMP FACTOR(=14 UNTIL 1ST BLK READ)
      ADA SECT      ADD  7  TO THE SECTOR 
      CLB           PREPARE FOR DIVIDE
      DIV ##SEC     DIVIDE BY THE NO OF SECTORS/TRACK 
      STB SECT      SET THE NEW SECTOR ADDRESS
      SZA           IF NO ROLLOVER OR 
      SZB           IF SECTOR IS ZERO THEN SKIP (NEW TRACK) 
      JMP UDAD1     ELSE GO EXIT
      SPC 1 
      CCB           SET TO DECREMENT TRACK
      CLA           SET A FOR ERROR RETURN
      ADB TRACK     ADDRESS 
      CPB LTR       OUT OF DIRECTORY? 
      JMP UDAD,I    YES SO RETURN 
      STB TRACK     SET THE NEW TRACK 
UDAD1 ISZ UDAD      STEP RETURN 
      JMP UDAD,I    TAKE OR RETURN
      SKP 
* 
*     SUBROUTINE VALID CHECKS THE VALIDITY OF OPEN FLAGS AND LOCK WORDS 
* 
VALID NOP 
      STA VALDF     SAVE THE OPEN FLAG/LOCK WORD
      SZA,RSS       IF FLAG IS ZERO 
      JMP NVEXT      THEN NOT VALID 
      AND B377      ISOLATE ID NUMBER 
      ADA N1        SUBTRACT 1 FOR ID'S FROM 0 TO 255 
      LDB $ID#      GET NUMBER OF ID SEGMENTS 
      CMB,INB       SET NEGATIVE
      ADB A         ADD CURRENT SEGMENT NUMBER
      SSB,RSS       IS IT TOO LARGE?
      JMP NVEXT     YES, EXIT NOT VALID 
      MPY $IDSZ     MULTIPLY NUMBER BY SIZE 
      ADA $IDA      ADD ID STARTING ADDRESS 
      ADA .8        POINT TO POINT OF SUSPENSION
      LDB A,I       GET POINT OF SUSPENSION 
      SZB,RSS       ZERO (DORMANT)? 
      JMP NVEXT     YES, INVALID! 
      ADA .20       NO, POINT TO SEQ #
      LDA A,I       GET WORD FROM ID SEGMENT
      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         SEQUENCE NUMBERS MATCH? 
      JMP VEXIT     YES, EXIT VALID 
* 
NVEXT CLA           NOT VALID, CLEAR A
      ISZ VALID     POINT TO NOT VALID RETURN POINT 
      JMP VALID,I   RETURN
* 
VEXIT LDA VALDF     RETURN WITH VALID OPEN FLAG 
      JMP VALID,I   RETURN
      SPC 5 
*  WCSR     WRITE CURRENT BLOCK 
* 
WCSR  NOP 
      LDA WCS       GET WRITE FLAG
      ISZ RW        SET REQUEST CODE TO WRITE 
      SZA           IF NOT WRITTEN ON SKIP
      JSB RWSUB     ELSE WRITE THE BLOCK
      CLA,INA       RESET REQUEST CODE TO 
      ADA SIGN      SET NO ABORT BIT
      STA RW        READ
      JMP WCSR,I    AND EXIT
      SKP 
* 
*     SECTOR BUFFER FOR DISC READS AND WRITES 
* 
BUF   BSS 128 
      ORG BUF       PUT INITIALIZE CODE IN BUFFER AREA
* 
INIT  CMA,INA       CONVERT THE LU TO POSITIVE
      STA TLU       SAVE THE LU NUMBER
      IOR ZBIT      PUT IN Z BIT IN CONWD 
      STA ZLU       AND SAVE FOR STATUS REQUEST 
      LDA TLU       GET DISC LU AGAIN 
      IOR PBITS     ADD IN DISC PROTECT BITS
      STA PLU       SAVE FOR EXEC CALLS 
* 
      JSB EXEC      GET STATUS OF LU
      DEF STRTN     TO DETERMINE TYPE AND LAST TRACK
      DEF XCOD      NO ABORT STATUS REQUEST 
      DEF ZLU       LU WITH Z BIT SET 
      DEF DVT6      CONTAINS DEVICE TYPE
      DEF IFT6
      DEF XTBUF     ARRAY FOR NUMBER OF TRACKS
      DEF X.6 
STRTN JMP BAD       IF LU UNDEFINED, EXIT.
* 
      LDA DVT6      GET DEVICE TYPE 
      ALF,ALF       POSITION TO LOW BITS
      AND XB77      ISOLATE DEVICE TYPE 
      ADA BN30      IS IT LESS
      SSA            THAN 30? 
      JMP BAD       NOT A DISC! 
      ADA XN8       IS IT GREATER 
      SSA,RSS        THAN 37? 
      JMP BAD       NOT DISC EITHER!
* 
      LDA XTRAK     GET NUMBER OF TRACKS
      ADA N1        SUBTRACT 1 FOR LAST TRACK ADDRESS 
      STA XTRK      SAVE FOR CARTRIDGE DIRECTORY
* 
      JSB EXEC      READ FIRST ENTRY ON LAST TRACK
      DEF XRTN      FOR CARTRIDGE INFORMATION 
      DEF X.1       NO ABORT READ 
      DEF PLU       PROTECTED DISC LU 
      DEF XTBUF 
      DEF X.9 
      DEF XTRK      LAST TRACK
      DEF XZRO      FIRST SECTOR
XRTN  JMP BAD       ERROR RETURN
* 
      LDA XTBUF     FETCH FIRST WORD OF ID
      CPB X.9       MUST HAVE 9 WORDS 
      SSA,RSS       AND FIRST WORD MUST BE NEGATIVE 
       JMP BAD      NO GOOD--EXIT 
* 
      LDA HD3       FETCH LABEL 
      SSA           MUST BE POSITIVE
       JMP BAD
* 
      STA TDRN      SAVE IT 
      LDA HD4       FETCH FIRST TRK 
      CMA 
      ADA HD7 
      SSA           MUST BE LESS THAN FIRST DIR TRK 
       JMP BAD
* 
      LDA HD8       FETCH #DIR TRKS 
      SSA,RSS       MUST BE NEGATIVE
       JMP BAD
* 
      LDA DTRK
      LDB CRDIR 
      CCE,INB       MOVE PARMS / POINT TO 2ND WORD
      JSB MOVE      STORE CARTRIDGE INFO INTO 
      DEC -3          TBLFP 
      LDA TLU       STORE LU LAST TO GUARENTEE AN 'OF' WILL 
      STA $CDIR     NOT CAUSE PROBLEMS
* 
BGCLR CLA           CLEAR JUMP TO THIS INITIALIZATION 
      STA INITR     ROUTINE IF THIS SUCCESSFUL
      JMP INITR     NOW RETURN
* 
BAD   LDA X.100     EXIT WITH ERROR -100, DISC
      JMP CREX        NOT INITIALIZED OR NOT A DISC 
* 
XN1   OCT -1
X.1   OCT 100001    NO ABORT READ 
XCOD  OCT 100015    NO ABORT STATUS REQUEST 
XB77  OCT 77
X.9   DEC 9 
X.100 DEC -100
BN30  OCT -30 
X.6   DEC 6 
XN8   DEC -8
* 
TLU   NOP 
XTRK  NOP 
TDRN  NOP 
XZRO  NOP 
* 
DTRK  DEF XTRK
XTBUF NOP 
      NOP 
      NOP 
HD3   NOP 
HD4   NOP 
XTRAK NOP 
      NOP 
HD7   NOP 
HD8   NOP 
* 
DVT6  NOP           STATUS WORD 
IFT6  NOP 
ZLU   NOP           DISC LU WITH Z BIT SET
ZBIT  OCT 10000 
PLU   NOP           PROTECTED DISC LU 
PBITS OCT 7700      DISC PROTECT BITS 
      ORR 
LN    EQU * 
* 
      END 
                                                                                                                        