ASMB,R,L,C,Q
      HED RTE FILE MANAGER DIRECTORY ROUTINE **************** 
*     NAME:   D.RTR 
*     SOURCE: 92067-18124 
*     RELOC:  92067-16124 
*     PGMR:   G.A.A.,N.J.S. 
* 
*  ***************************************************************
*  * (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,131,1 92067-16124 REV.2026 800428 
      EXT EXEC,PRTN,P.PAS,XLUEX 
      EXT .DAD,.DNG,GTSCB 
      EXT $CL1,$CL2,$$CPU 
      EXT $SMLK,$SMST,$SMID,$SMGP 
      SUP 
* 
* 
*            RTE FMP DIRECTORY ROUTINE            NOV/72**GAA 
*            MODIFIED TO REUSE DISC SPACE         MAR/76**GAA 
*            MODIFIED TO USE RTE-IV TABLE AREA 2  OCT/77**BL
*            MODIFIED TO TRUNCATE TYPE 6 FILES    JAN/78**GLM 
*            CORRECTLY
*            MODIFIED FOR SESSION MONITOR PROJECT FEB/78**NR
* 
* 
* DISC BUFFER MANAGEMENT
* 
* THIS PROGRAM DECLARES A BUFFER OF 6144 WORDS - ONE 96 SECTOR TRACK. 
* THIS IMPLIES D.RTR SHOULD BE DISC RESIDENT.  HOWEVER THIS PROGRAM WILL
* WORK WITH ANY DECLARED BUFFER SIZE >= 128 WORDS.  IT WILL ALSO HANDLE 
* ANY TRACK SIZE. 
* 
* FOR OPTIMAL EFFICIENCY, LENGTH OF THE DECLARED BUFFER SHOULD BE THE TRACK 
* SIZE OF THE DISC WITH THE LARGEST TRACK THAT WILL BE ACCESSED.
* 
* THIS PROGRAM ASSUMES A SECTOR SKIP VALUE OF 7.
* 
* 
* NOTE:  THE AMOUNT OF DISC BUFFER THAT IS USED BY D.RTR IS INDICATED BY THE
*        FOLLOWING CONDITIONS:
* 
*        BUFFER SIZE = 128 * (N * 7 + 1)
*        WHERE   N IS A POSITIVE INTEGER
*                BUFFER SIZE <= SUPPLIED BUFFER SIZE
*                BUFFER SIZE <= TRACK SIZE
*                BUFFER SIZE  = MAX DISC READ LENGTH
*        THAT IS, BUFFER SIZES USED ARE 128, 1024, 1920, 2816, 3712, 4608,
*        5504, 6400, 7296, 8192, ...  OR EXACTLY THE TRACK SIZE.
* 
      SKP 
* 
* THIS PROGRAM IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT
* SYSTEM (FOR RTE-IV).  IT OWNS THE DIRECTORY AND PERFORMS ALL
* WRITES ON IT. 
* 
* PROGRAMS WISHING TO ACCESS THE DIRECTORY MUST 
* SCHEDULE (WITH WAIT) THIS PROGRAM.
* 
* 
* 
* CALLING SEQUENCES TO D.RTR
* 
* 
* 
* 1.  OPEN
* 
*     P1.  1,ID    (BIT 15 SET) 
*     P2.  BIT 15 SET = SESSION MONITOR OVERRIDE   (ALL DISCS)
*          BIT 14 SET = SESSION MONITOR OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*          BIT 13 SET = SESSION MONITOR OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU, +CRN, 0 
*     P4.  SECURITY CODE
* 
*     STRING:  1.  E,NAME(1,2)       E - BIT 15 = SET IF EXCLUSIVE OPEN 
*              2.  S,NAME(3,4)       S - BIT 15 = SCRATCH FILE PURGE
*              3.  NAME(5,6)
* 2.  CLOSE 
* 
*     P1.  ID 
*     P2.  0
*     P3.  -\  DIRECTORY
*     P4.  -/    ADDRESS
* 
*     STRING:  1.  -\  NEGATIVE - DOUBLE WORD # OF SECTORS TO BE TRUNCATED
*              2.  -/  POSITIVE - PURGE EXTENTS ONLY
* 
* 
* 3.  CREAT 
* 
*     P1.  ID 
*     P2.  1     BIT 15 SET - SES MONIT OVERRIDE   (ALL DISCS)
*                BIT 14 SET - SES MONIT OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*                BIT 13 SET - SES MONIT OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU, +CRN, 0 
* 
*     STRING:  1.  NAME(1,2)
*              2.  NAME(3,4)
*              3.  NAME(5,6)
*              4.  TYPE 
*              5. 
*              6.  DOUBLE WORD SIZE IN +(SECTORS) OR -(128 BLOCK CHUNKS)
*              7.   OR DOUBLE WORD -1 = ALLOCATE REST OF DISC (<=32767X128) 
*                   OR SINGLE WORD -1 = ALLOCATE REST OF DISC (<=32767) 
*              8.  RECORD LENGTH
*              9.  SECURITY CODE
      SKP 
* 
* 
* 4.  CHANGE NAME 
* 
*     P1.  ID 
*     P2.  2
*     P3.  -\  DIRECTORY
*     P4.  -/    ADDRESS
* 
*     STRING:  1.  -\  6-CHARACTER
*              2.   ->   NEW
*              3.  -/      NAME 
* 
* 
* 
* 5.  SET, CLEAR LOCK 
* 
*     P1.  ID 
*     P2.  3 FOR SET, 5 FOR CLEAR 
*          BIT 15 SET = SESSION MONITOR OVERRIDE   (ALL DISCS)
*          BIT 14 SET = SESSION MONITOR OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*          BIT 13 SET = SESSION MONITOR OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU, +CRN     0 NOT LEGAL
* 
* 
* 
* 6.  EXTENSION OPEN
* 
*     P1.  ID 
*     P2.  6 FOR READ, 8 FOR WRITE
*     P3.  -\  DIRECTORY ADDRESS
*     P4.  -/  OF MAIN FILE 
*     P5.  EXTENT NUMBER
* 
* 
* 
* 7.  GENERATE, PACK, UPDATE
* 
*     P1.  ID 
*     P2.  7     BIT 15 SET - SES MONIT OVERRIDE   (ALL DISCS)
*                BIT 14 SET - SES MONIT OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*                BIT 13 SET - SES MONIT OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU, +CRN     0 NOT LEGAL
*     P4.  S, #SECTORS/TRACK        S - BIT 15 = SET IF DISC DIRECTORY UPDATE 
* 
*     STRING:  1.  -\  DATA TRACK 
*              2.  -/    ADDRESS
* 
* 
* 
      SKP 
* 
* 8.  PACK
* 
*     P1.  ID 
*     P2.  9     BIT 15 SET - SES MONIT OVERRIDE   (ALL DISCS)
*                BIT 14 SET - SES MONIT OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*                BIT 13 SET - SES MONIT OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU, +CRN     0 NOT LEGAL
*     P4.  RELATIVE DIRECTORY SECTOR
* 
*     STRING:  -\    128-WORD 
*               -\   DIRECTORY
*               -/   SECTOR TO
*              -/    BE WRITTEN 
* 
* 
* 
* 9.  MOUNT CARTRIDGE 
* 
*     P1.  ID 
*     P2.  13    BIT 15 SET - SES MONIT OVERRIDE   (ALL DISCS)
*                BIT 14 SET - SES MONIT OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*                BIT 13 SET - SES MONIT OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU           0 NOT LEGAL
*     P4.  SCB ADDRESS IF MOUNTING TO SESSION OTHER THAN THE ONE
*          OPERATING UNDER. 
*     P5.  ID TO WHICH DISC IS TO BE MOUNTED
*                  BIT 15 = 1 - INITIALIZE THE DIRECTORY
* 
*     STRING:  -\     1ST 9 WORDS OF
*               -\    CARTRIDGE 
*               -/    SPECIFICATION 
*              -/     ENTRY 
* 
* 
* 
* 10. REMOVE CARTRIDGE
* 
*     P1.  ID 
*     P2.  11    BIT 15 SET - SES MONIT OVERRIDE   (ALL DISCS)
*                BIT 14 SET - SES MONIT OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*                BIT 13 SET - SES MONIT OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU           0 NOT LEGAL
*     P4   SCB ADDRESS IF DISMOUNTING FROM SESSION OTHER THAN ONE 
*          OPERATING UNDER. 
* 
* 
* 
* 11. ALTER CL ENTRY
* 
*     P1.  ID 
*     P2.  15    BIT 15 SET - SES MONIT OVERRIDE   (ALL DISCS)
*                BIT 14 SET - SES MONIT OVERRIDE   (PRIV,GROUP,SYST ONLY) 
*                BIT 13 SET - SES MONIT OVERRIDE   (SYSTEM DISCS ONLY)
*     P3.  -LU, +CRN    0 NOT LEGAL 
* 
*     STRING:  -\   4 WORD
*               -\  CARTRIDGE 
*               -/  DIRECTORY 
*              -/   ENTRY 
* 
* 
      SKP 
* 
* 
*    ID - ID SEGMENT ADDRESS OF CALLING PROGRAM 
* 
* 
* 
*    DIRECTORY ADDRESS FORMAT 
* 
*             !SECTOR!             !LU # OF FILE! 
*             !OFFSET!   SECTOR #  !  DIRECTORY ! 
*    WORD 1   !------!-------------!------------! 
*              15  13 12          6 5          0
* 
* 
*             !           TRACK  #              ! 
*    WORD 2   !---------------------------------! 
*              15                              0
* 
* 
* 
* 
* 
*    DATA TRACK ADDRESS FORMAT
* 
*             !                !      LU #      ! 
*    WORD 1   !----------------!----------------! 
*              15             8 7              0
* 
*             !           TRACK  #              ! 
*    WORD 2   !---------------------------------! 
*              15                              0
* 
* 
* 
* 
*    RETURN PARAMETERS
* 
*    R1.  ERROR CODE    OR      0 
*    R2.  -\  DIRECTORY 
*    R3.  -/    ADDRESS 
*    R4.  STARTING TRACK # OF FILE
*         LU # IF TYPE = 0
*    R5.  # SECTORS/TRACK (BITS 8-15)   STARTING SECTOR (BITS 0-7)
* 
*    STRING IS RETURNED ONLY FOR OPEN AND CREAT CALLS 
*    STRING:  1.  FILE TYPE    BIT 15 SET INDICATES THIS IS LU 2 OR 3 
*             2.  STARTING TRACK
*             3.  EXTENT # (BITS 8-15)   STARTING SECTOR (BITS 0-7) 
*             4.  SIZE IN +SECTORS OR -#128 BLOCK CHUNKS
*             5.  RECORD LENGTH 
*             6.  SECURITY CODE 
* 
      SKP 
* 
* 
* 
* ERROR CODES 
*     0 OR POSITIVE -NO ERROR 
*    -1              DISC DOWN
*    -2              DUPLICATE NAME 
*    -3              FILE NOT FOUND 
*    -5              READ EXTENT OPEN AND EXTENT NOT FOUND
*    -6              FILE NOT FOUND 
*    -7              SECURITY CODES DON'T MATCH 
*    -8              FILE IS CURRENTLY OPEN (ALSO FOR REJECT LOCK)
*    -9              FILE CURRENTLY OPEN TO THE SAME PROGRAM
*    -11             FILE NOT OPEN (CLOSE)
*    -13             DISC LOCKED
*    -14             DIRECTORY FULL 
*    -20             ILLEGAL ACCESS LU
*    -32             CARTRIDGE NOT FOUND
*    -33             NOT ENOUGH ROOM ON CARTRIDGE 
*    -19             ILLEGAL ACCESS ON A SYSTEM DISC
*    -34             DISC ALREADY MOUNTED 
*    -35             ALREADY 63 DISCS MOUNTED TO SYSTEM 
*    -40             DISC NOT IN SST
*    -46             ALREADY 255 EXTENTS
* 
*    -99             DIRECTORY MANAGER WAS REJECTED ON AN EXEC REQUEST
*    -101            ILLEGAL PARAMETERS IN CALL       OR
*                    SCRATCH FILE PURGE FAILED - ANOTHER PROGRAM HAS IT OPEN
*    -102            ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) 
      SKP 
*************************************** 
*                                     *     DECLARE 1 TRACK BUFFER
BUFL  DEC 6144        *      (96 SECT TRACK X 64 WORDS SECT)
BUF   BSS 6144        * 
*                                     * 
*************************************** 
* 
SQCPU NOP 
* 
* 
DEST  NOP 
N5    DEC -5
.20   DEC 20
.22   DEC 22
PRAMA DEF P1
P1    NOP 
P2    NOP 
P3    NOP 
P4    NOP 
P5    NOP 
* 
SCB   EQU BUF+265   BEGINNING OF SCB IN BUF 
A.SCB DEF SCB       ADDRESS OF SCB
IDSSW NOP           POINTS TO SST LENGTH WORD IN SCB
MTDSC NOP           POINTS TO FIRST ENTRY IN DISCS MOUNTED AREA OF SCB
DISCL NOP           MAXIMUM # DISCS IN DISCS MOUNTED AREA 
IERR  NOP 
SCBAD NOP 
MASK  NOP 
PTR1  NOP 
EXTRA NOP 
OFFST NOP 
* 
ID1   NOP           -\
ID2   NOP            ->  ID TABLE 
ID3   NOP           -/
A.ID  DEF ID1 
COUNT NOP 
SESSN NOP           IN SESSION MODE FLAG   =0 IF NOT IN SESSION 
* 
.3    DEC 3 
.144  DEC 144 
.64   DEC 64
N2    OCT -2
N4    DEC -4
B7777 OCT 7777
RDNAB OCT 140001    EXEC READ WITH NO ABORT(15) & NO SUSPEND(14) BITS SET 
WTNAB OCT 140002    EXEC WRITE WITH NO ABORT(15) & NO SUSPEND(14) BITS SET
STAT  OCT 100015
LUTYP OCT 34000 
DISTP OCT 14000 
MSKAL OCT 177777
SYMID EQU B7777     SYSTEM MANAGER ID 
MASK1 OCT 177000
MASK2 OCT 170000
ACDIS OCT 20377 
O.MSK OCT 160000
TMP3  NOP           CAN BE USED AS TEMP STORAGE 
      NOP            FOR DOUBLE WORD
KEYLN NOP           LENGTH OF KEYWORD TABLE 
DISID NOP 
      SKP 
* 
*     FETCH 5 INCOMING PARAMETERS AND SAVE IN P1-P5.
*     TAKES CROSS MAP LOAD PROBLEM FOR DIFFERENT OP SYSTEMS INTO ACCOUNT. 
* 
BEGIX LDA PRAMA     PARAMETER DESTINATION ADDR
      STA DEST      SAVE IT 
      LDA N5        PARAMETER COUNT 
      STA COUNT 
LOOP  XLA B,I       GET NEXT PARAMETER
      STA DEST,I    SAVE IN P1 TO P5
      ISZ DEST      BUMP DESTINATION ADDR 
      INB           BUMP TO NEXT PARAMETER
      ISZ COUNT     BUMP PARAMETER COUNT
      JMP LOOP
* 
* 
      LDB P1        GET THE FIRST PRAM
      RBL,CLE,ERB   LIST; CLEAR POSSIBLE SIGN BIT 
      STB ID        SAVE ID SEG ADDRESS PASSED IN CALL
      ADB .31       POSITION TO SEQUENCE NUMBER 
      XLA B,I       LOAD A FROM B,I 
      AND MASK2     MASK TO SEQUENCE NUMBER 
      ALF,ALF       POSITION CPU TO 
      ALF            BITS 11-8 AND
      IOR $$CPU       CPU NUMBER IN BITS 14-12
      STA SQCPU        AND SAVE 
* 
* 
* 
*  MAKE SURE THAT D.RTR INVOCATION WAS FROM A SCHEDULE WITH WAIT CALL 
*  WITH THE PROPER ID SEGMENT ADDRESS SUPPLIED. 
* 
* 
      LDB XEQT      GET ID ADDRESS
      ADB .20       ADVANCE TO FATHER INFO
      XLA B,I            AND FETCH IT 
      RAL            POSITION FATHER WAIT BIT TO SIGN 
      SSA,RSS       CONTINUE ONLY IF FATHER IS WAITING
      JMP EXIT2     NOT WAITING--ILLEGAL CALL 
* 
      RAR            REPOSITION ID# OF FATHER 
      AND B377      ISOLATE IT
      STA IDNUM     KEEP FATHER'S OFFSET IN KEYWORD TABLE.
      CCB            B=-1 
      ADB A         COUNT FROM 0(USE B FOR LOADA ROUTINE) 
      ADB KEYWD     ADD TO TABLE OF ID SEGS 
      XLA B,I       FETCH ID SEG ADDR OF CALLER 
      CPA ID        MUST MATCH VALUE PASSED IN P1 
      CLB,RSS       OK
      JMP EXIT2     --NOPE --ERROR (BAD CALL) 
* 
* 
* 
      STB SESSN     CLEAR SESSION FLAG
      STB FIRST     CLEAR THE FIRST FLAG
      STB DISID     CLEAR LAST DISC ID
      STB SCBAD     CLEAR SCB ADDRESS 
* 
      LDA BUFL      CALCULATE SBFLN TO BE THE 
      DIV .64        LENGTH OF BUFFER BUF IN
      STA SBFLN       LOGICAL SECTORS 
      CLB 
      ADA N2        CALCULATE SBLFM TO THE THE LARGEST
      DIV .14        2 + (N * 14) NOT GREATER THAN SBFLN. 
      MPY .14       THIS IS USED IF BUFFER
      ADA .2         IS NOT LARGE ENOUGH TO 
      STA SBFLM       READ ONE ENTIRE TRACK.
* 
      LDA ABUF      SET LOCK SEARCH FOR FIRST 
      STA DIRAD     ENTRY 
* 
      CLA 
      STA KEYLN     START COUNT AT 0
      LDB KEYWD     GET ADDRESS OF KEYWORD TABLE
KEY   XLA B,I       GET ENTRY 
      SZA,RSS         ZERO? 
      JMP CLSCB     YES - FOUND THE END 
      ISZ KEYLN     NO - STEP COUNTER 
      INB            AND POINTER IN KEYWORD TABLE 
      JMP KEY         AND LOOK AT NEXT ENTRY. 
* 
CLSCB LDA A.SCB     SCB WILL BE READ INTO BUF AT THIS ADDRESS.
      CMA,INA        CALCULATE POINTER TO SST LENGTH WORD 
      ADA $SMLK       IN SCB SO CAN USE SCB OFFSET GLOBALS
      ADA $SMST        IN ACCESSING ELEMENTS OF THE SCB.
      CMA,INA 
      STA IDSSW 
      LDA A.ID       START WITH FIRST ID
      STA PTR1        IN BLOCK. 
* 
      LDA P2        GET FUNCTION CODE 
      AND B77       MASK TO LOWER BITS
      CPA .11       DISMOUNT CALL 
      RSS           YES 
      CPA .13       MOUNT CALL? 
      RSS           YES 
      JMP RDSCB     NEITHER - SEND 0 FOR SCBAD
      LDA P4        GET SCB ADDRESS IF PASSED 
      STA SCBAD      AND SAVE IT
      SPC 5 
* 
* 
*  NEXT AND THE LOCK ROUTINE SEARCH THE DIRECTORY FOR THE 
*  REFERENCED DISC. 
* 
*  THIS SECTION READS THE SCB IF THERE IS ONE.  IT THEN DECIDES WHICH 
*  DISCS THE CALLER MAY LEGALLY ACCESS AND SAVES THAT INFO IN THE ID TABLE. 
* 
*  0)  IF THE CALLER IS THE SYSTEM MANAGER HE MAY TALK TO ANY DISC ON THE 
*      SYSTEM.  (SYSMG) 
* 
*  1)  IF THE CALLER IS NOT UNDER SESSION CONTROL HE MAY ACCESS 
*      A)  SYSTEM DISCS AND   B)  NON-SESSION DISCS.   (NTSES)
* 
*  2)  IF THE CALLER IS UNDER SESSION CONTROL AND OVRD. = 0 (DISC ACCESS
*      RESTRICTIONS OVERRIDE FLAG) HE MAY ACCESS ONLY HIS PRIVATE AND 
*      GROUP DISCS AND SYSTEM DISCS OTHER THAN LU 2 AND 3.
* 
*  3)  IF THE CALLER IS UNDER SESSION CONTROL AND OVRD. HAS BIT 14 SET
*      HE MAY ACCESS   A) HIS PRIVATE DISCS,   B) HIS GROUP DISCS,
*      AND   C) ALL SYSTEM DISCS.   (OVRRD) 
* 
*  4)  IF BIT 15 IS SET ON OVRD., CALLER IS TREATED LIKE THE SYSTEM MANAGER;
*      HE MAY ACCESS ANY DISC ON THE SYSTEM.  (SYSMG) 
* 
*   5)  IF OVRD. HAS BIT 13 SET THEN THE CALLER MAY ACCESS ONLY SYTEM 
*       CARTRIDGES. 
* 
*  THE ID TABLE IS SET UP WITH THE ID'S REPRESENTING THESE DISCS.  THEY 
*  ARE SAVED IN THE ORDER THEY SHOULD BE SEARCHED FOR IN THE DEFAULT CASE.
*  FOR CASES WHERE -1 IS USED TO INDICATE ANY DISC COULD BE USED, THE -1
*  MUST BE THE LAST ENTRY IN THE ID TABLE.  EXCEPT IN THE CASE OF THE 
*  SYSTEM MANAGER, IT IS THE ONLY ENTRY IN THE ID TABLE.
* 
* 
RDSCB JSB GTSCB     READ SCB INTO BUF AT A.SCB
      DEF *+5 
      DEF SCB 
      DEF .144
      DEF IERR
      DEF SCBAD 
* 
      LDB IERR
      CPB N1        IN SESSION MODE?
      JMP NTSES     NO
* 
      STB SESSN     SET IN-SESSION FLAG NON-ZERO
      LDA IDSSW     CALCULATE ADDRESS OF
      LDB A,I        1ST ENTRY IN DISCS MOUNTED 
      CMB,INB         AREA OF THE SCB USING 
      ADA .2           THE POINTER TO THE SST 
      ADA B             LENGTH WORD.
      STA MTDSC     MTDSC = IDSSW + 2 + C(IDSSW)
* 
      LDA IDSSW     GET AND SAVE LENGTH OF DISCS'S
      ADA N1         MOUNTED AREA IN THE SCB. 
      LDA A,I 
      STA DISCL 
* 
      LDB P1        IF THIS IS A MOUNT CALL, WANT TO SEARCH 
      LDA P2         WHOLE CL FOR LU TO MAKE SURE IT'S NOT
      AND B377        MOUNTED TO ANYONE.  IF THIS CALL TO 
      CPA .13          D.RTR HAS AN EVEN FUNCTION CODE (WHEN
      JMP ALLDS        AN ENTIRE DIRECTORY ADDRESS IS SENT
      SSB,RSS         THEN WE'VE ALREADY BEEN THROUGH THE OVRRD 
      SLA            AND CARTRIDGE ADDRESSING SPACE CHECKS AND
      RSS 
      JMP ALLDS     JUST WANT TO FIND LU IN THE CL
* 
      LDB IDSSW     CALCULATE ADDRESS 
      ADB $SMGP      OF GROUP ID
      STB TMP3        AND SAVE IT.
      LDB IDSSW     CALCULATE ADDRESS 
      ADB $SMID      OF USER ID 
      LDA B,I       GET USER ID IN B-REG
      LDB P2        GET OVERRIDE FLAGS
      ELB            BIT 15 TO E-REG
      SEZ           BIT 15 SET? 
      JMP ALLDS     YES - OVERRIDE FOR ALL DISCS IS SET 
      CPA SYMID     SYSTEM MANAGER??
      JMP SYSMG   YES - THIS IS SYSTEM MANAGER
      ELB           OVERRIDE FLAG BIT 14 TO E-REG 
      SEZ           OVERRIDE PRIV,GROUP,SYS?
      JMP OVRRD     YEP 
      SSB           OVERRIDE TO SYSTEM ONLY?
      JMP SONLY     YEP 
* 
OVRRD LDB TMP3,I    **CASE 2**    AND    **CASE 3** 
      STA ID1 
      STB ID2       TALK TO THIS SESSION'S PRIVATE
      LDA SYMID      AND GROUP DISCS AND SYSTEM 
      STA ID3         DISCS.  DISCRIMINATION OF 
      LDA N3           CASE 2 AND CASE 3 WITH OVERRIDE
      STA COUNT         WILL BE DONE LATER. 
      JMP NEX.1 
* 
* 
NTSES LDA P2        **CASE 1**
      SSA           WAS BIT 15 OVERRIDE SET?
      JMP ALLDS     YES - WANT TO HONOR IT
      AND B77       MASK TO FUNCTION CODE 
      CPA .13       IS THIS A MOUNT CALL? 
      JMP ALLDS     YES - WANT TO SEARCH WHOLE CL FOR FMGR12
      LDB P1        IF THIS CALL HAD EVEN FUNCTION CODE (EXCEPT OPEN) 
      SSB,RSS        A DIRECTORY ADDRESS WAS SENT AND ALREADY BEEN
      SLA             THROUGH THE OVRRD AND CARTRIDGE ACCESS CHECKS 
      RSS              SO JUST FIND THE LU IN THE CL AND CONTINUE 
      JMP ALLDS 
      LDA N2
      STA COUNT     NOT IN SESSION MODE 
      LDA SYMID      SO TALK ONLY TO SYSTEM 
      STA ID1          AND NON-SESSION DISCS
      CLA 
      STA ID2 
      JMP NEX.1 
* 
* 
SONLY LDA N1        **CASE 5**
      STA COUNT     TALK ONLY TO
      LDA SYMID      SYSTEM DISCS 
      STA ID1 
      JMP NEX.1 
* 
* 
ALLDS CCA           **CASE 0 OR 4** 
      STA ID1       SET ID TABLE AND
      STA COUNT       COUNT TO -1 TO
      JMP NEX.1         INDICATE SYSTEM MANAGER 
* 
* 
SYSMG STA ID1       SET 7777 AS PRIVATE ID
      LDB TMP3,I    GET GROUP ID
      STB ID2        AND PUT AS SECOND ENTRY IN TABLE 
      CCA           SET -1 AS THIRD ENTRY 
      STA ID3        IN TABLE TO SEARCH WHOLE DIRECTORY 
      LDA N3        THERE ARE THREE 
      STA COUNT      ENTRIES IN THE TABLE 
      JMP NEX.1 
      SPC 3 
* 
* 
*  THE LOCK ROUTINE READS THE DISC DIRECTORY AND SEARCHES FOR THE 
*  SPECIFIED DISC.
* 
*  FOR THE 1ST CALL DIRAD SHOULD POINT AT THE 1ST WORD OF THE CL (ABUF).
*  LOCK WILL UPDATE DIRAD AFTER EACH SEARCH.
* 
*  WITH THE EXCEPTION OF THE DISC DIRECTORY UPDATE AND THE MOUNT CARTRIDGE
*  REQUEST THE DISC MUST BE FOUND.
* 
*  A.  IF THE DISC WAS SPECIFIED WITH AN LU# THE CL IS SEARCHED FOR THAT
*      LU.  WHEN FOUND THE CORRESPONDING ID IN THE CL ENTRY MUST MATCH ONE
*      OF THE ID'S IN THE ID TABLE.  ELSE AN ERROR -18 IS RETURNED. 
* 
*  B.  IF THE DISC WAS SPECIFIED WITH A CRN, THE CL IS SEARCHED FOR THAT
*      CRN.  A COMPLETE PASS IS MADE FOR EACH ID IN THE ID TABLE UNTIL A
*      CRN WITH A LEGAL ID IS FOUND. (CRN MAY APPEAR > 1 TIMES IN THE CL.)
* 
*  C.  IF A SPECIFIC DISC IS NOT INDICATED AND THE CALLER IS THE SYSTEM 
*      MANAGER THE "NEXT" DISC IS USED REGARDLESS OF ID, ETC. 
* 
*  D.  IF A SPECIFIC DISC IS NOT INDICATED AND THE CALLER IS NOT THE
*      SYSTEM MANAGER THE CL IS SEARCHED FOR AN ID FROM THE CALLER'S ID 
*      TABLE. A COMPLETE PASS IS MADE FOR EACH ID IN THE ID TABLE UNTIL 
*      A DISC IS FOUND. 
* 
*  E.  IN EACH CASE ABOVE, IF UNDER SESSION CONTROL, THE LU MUST ALSO BE
*      MOUNTED TO THE CALLER, THAT IS IN HIS DISCS' MOUNTED LIST IN THE 
*      SCB. 
* 
*  ON SUBSEQUENT CALLS TO NEXT/LOCK IF THE DISC WAS NOT SPECIFIED, THE
*  SEARCH IS CONTINUED.  IF THE DISC WAS SPECIFIED A CARTRIDGE NOT FOUND
*  ERROR EXIT IS TAKEN. 
* 
*  ON EXIT:  ATRAK CONTAINS THE DIRECTORY TRACK (LAST TRACK)
*            ALU   CONTAINS THE DIRECTORY LU
*            C(DIRAD-4) IS THE LU/LOCK WORD 
* 
* 
* 
NEXT  JSB GTSCB     READ THE
      DEF *+5        SESSION CONTROL
      DEF SCB         BLOCK IF
      DEF .144         THERE IS 
      DEF IERR          ONE.
      DEF SCBAD 
NEX.1 CLA           CLEAR ON SYSTEM DISC FLAG 
      STA SYSDS      BECAUSE WE ARE STARTING OVER WITH ANOTHER DISC 
      STA #SECT      CLEAR SEC/TRACK BECAUSE NEXT DISC MAY BE DIFFERENT 
      JSB RDPS      READ THE DISC DIRECTORY.
      LDB P1        GET CALLERS ID
      SSB           CHECK BIT 15. IF SET THIS IS AN OPEN
      JMP LOCK0     YES - OPEN REQUEST
      LDA P2        GET FUNCTION CODE 
      SLA           EVEN? 
      JMP LOCK0     NO
* 
      LDA P3        LU IN P3
      AND B77       MASK TO LU
      STA TMP2      SAVE THE LU 
      STA DISID     HERE TOO
      CCE           SET E=1 TO INDICATE SEARCHING FOR LU
      LDB P4        GET TRACK # 
      STB DITR      SAVE THE TRACK
      CPA RDPS      DO WE HAVE THIS ONE ALREADY?
      JMP DEC.1     YES SO GO DECODE THE REQUEST
      JMP LOCK6     NO SO GO LOOK FOR IT
* 
LOCK0 LDA P3        GET DISC ID 
      SZA,RSS 
      JMP DEFLT     A PARTICULAR DISC WAS NOT SPECIFIED 
      CLE,SSA 
      CMA,CCE,INA   E=1 IF LU, E=0 IF CRN 
      STA TMP2      TMP2 = +LU OR +CRN
      LDB DISID     GET PREVIOUS ID 
      STA DISID     SAVE CURRENT ID 
      SZB           IF PREVIOUS ID NOT A ZERO, ID ON SECOND CALL
      JMP CKERR     GO SEE WHICH ERROR EXIT TO TAKE 
* 
LOCK6 SEZ           LU OR CRN?
      JMP LU.SH      LU - SO GO DO THE SEARCH FOR LU
* 
* 
*  THIS SECTION SEARCHES THE CL FOR A SPECIFIED CRN 
* 
* 
CRNSH LDA MSKAL     SET UP A MASK 
      STA MASK
      LDA .2         AND OFFSET 
      STA OFFST       FOR CL SEARCH ROUTINE 
CRN.1 JSB SCAND     SEARCH CL FOR CRN=TMP2
      JMP CRN.2     DIDN'T FIND IT - GO TRY ANOTHER ID
      LDA N1        FOUND IT
      CPA PTR1,I    IS CALLER THE SYSTEM MANAGER? 
      JMP LOCK4     YES - NO MORE CHECKS NEEDED 
      ADB .3        NO - POSITION TO ID WORD
      LDA B,I       GET ID
      AND B7777       AND MASK
      CPA PTR1,I    DO ID'S MATCH?
      JMP LU.2      YES 
      JMP CRN.1     NOPE - GO LOOK FOR CRN AGAIN
* 
CRN.2 ISZ COUNT     INCREMENT #ID'S COUNTER 
      RSS 
      JMP LOCK5     ALL DONE AND DIDN'T FIND CARTRIDGE - ERROR
      ISZ PTR1      STEP POINTER TO NEXT ID 
      LDA BUFA      START SEARCH OVER AT
      STA DIRAD      BEGINNING OF CARTRIDGE DIRECTORY 
      JMP CRN.1 
* 
* 
*  THIS SECTION SEARCHES THE CL FOR A SPECIFIED DISC LU 
* 
* 
LU.SH LDA B377      SEARCH CL FOR LU# IN TMP2 
      STA MASK
      LDA .0
      STA OFFST 
      JSB SCAND 
      JMP LOCK5     LU JUST ISN'T THERE 
      ADB .3        NO - POSITION TO ID 
      LDA B,I       GET IT
      AND B7777       AND MASK
LU.1  CPA PTR1,I    DOES IT MATCH?
      JMP LU.2      YES - GO SEE IF IT'S IN THE SST 
      ISZ COUNT     NO - ANY MORE ID'S TO CHECK?
      RSS 
      JMP LU.15     NOPE - DIDN'T FIND DISC 
      ISZ PTR1      YES - TRY THE NEXT ONE
      JMP LU.1
* 
LU.15 LDA N1        DOES CALLER HAVE SYSTEM 
      CPA PTR1,I     MANAGER POWERS?
      JMP LOCK4     YES - CAN USE THIS DISC 
      JMP EX32      NOPE - THIS ONE DOESN'T BELONG TO HIM 
* 
LU.2  JSB SCBCK     IS LU MOUNTED IN SCB? 
      JMP LOCK4     YES - WE'VE FOUND THE DISC.  CONTINUE 
      JMP EX32      ERROR.  DISC IS MOUNTED TO SYSTEM BY NOT TO CALLER'S SESSION
* 
* 
* 
DEFLT LDA PTR1,I    NO DISC ID WAS SPECIFIED
      CPA N1        IS CALLER THE SYSTEM MANAGER? 
      JMP SYSTM     YES - JUST USE "NEXT" DISC
* 
* 
*  THIS SECTION SEARCH THE CL FOR A LEGAL ID
* 
* 
ID.SH LDA B7777     SET MASK AND OFFSET 
      STA MASK       TO SEARCH FOR AN ID
      LDA .3
      STA OFFST 
ID.1  LDA PTR1,I    GET ID WE'RE LOOKING FOR
      STA TMP2       TO TMP2
      JSB SCAND     SEARCH CARTRIDGE DIRECTORY
      JMP ID.2      DIDN'T FIND IT
      JSB SCBCK     IS IT IN CALLER'S SST?
      JMP LOCK4     YES - SO USE THIS DISC
      JMP ID.1
* 
ID.2  ISZ COUNT     ANY MORE ID'S LEFT
      RSS 
      JMP CKERR     NO - GO SEE WHICH ERROR EXIT TO TAKE
      ISZ PTR1      YES - STEP TO NEXT ID 
      LDA BUFA      RESET CL POINTER
      STA DIRAD      TO BEGINNING 
      JMP DEFLT       AND SEARCH AGAIN
* 
* 
SYSTM LDB DIRAD 
      LDA B,I       GET 1ST WORD OF "NEXT" CL ENTRY 
      SZA,RSS       0?
      JMP CKERR     YES - GO SEE WHICH ERROR EXIT TO TAKE 
      AND B377      MASK
      STA ALU         AND SAVE
      INB 
      LDA B,I       GET TRACK 
      STA ATRAK       AND SAVE
      ADB .3        UPDATE DIRAD
      STB DIRAD       TO NEXT ENTRY 
* 
* 
* 
* 
* 
LOCK4 LDB DIRAD     FOUND - POSITION TO ID WORD 
      ADB N4        POSITION TO LOCK WORD 
      JSB CK.LK     SEE IF LOCKED AND CHECK VALIDITY
      JMP LK.4      NOT LOCKED OR LOCKED TO CALLER OF BAD LOCK WAS CLEARED
      LDA DISID     LOCKED - IF THIS IS 
      SZA,RSS        A MULTI-DISC SEARCH
      JMP NEX.1       CONTINUE WITH NEXT DISC 
      JMP EX13      ELSE EXIT LOCKED DISC 
* 
* 
*     IF THE "FOUND" DISC IS LU 2 OR LU 3, CAN ONLY USE IT IF 
*     1.  WE'RE NOT UNDER SESSION CONTROL      OR 
*     2.  WE'RE TREATED AS SYSTEM MANAGER      OR 
*     3.  BIT 13, 14, OR 15 ON OVRD. WAS SET   OR 
*     4.  THIS IS AN OPEN CALL
*     OTHERWISE GO FIND ANOTHER DISC
* 
*     # 2 TAKES CARE OF CASE FOR CLOSE, RENAME, EXT OPEN, ETC 
*     WHERE CARTRIDGE ACCESS CHECKS ARE NOT MADE AFTER FILE IS
*     OPENED
* 
* 
LK.4  LDA B,I       GET THE LU WORD FROM THE CL ENTRY 
      AND B377       AND MASK TO THE LU 
      CPA .2        IS THIS LU 2? 
      RSS           YES - SKIP
      CPA .3        OR LU 3?
      RSS           YES - SKIP
      JMP DEC.1     NO - GO AHEAD AND USE THE DISC WE HAVE
      LDA SIGN      CAN USE THIS DISC.  SET 
      STA SYSDS      THE ON SYSTEM DISC FLAG
      LDA SESSN     GET THE IN-SESSION FLAG 
      SZA,RSS       IF NOT IN SESSION 
      JMP DEC.1      GO AHEAD AND USE THIS DISC 
      LDA ID1       GET INDICATOR FROM ID TABLE 
      CPA N1        SYSTEM MANAGER TYPE?
      JMP DEC.1     YES - HE CAN USE ANY DISC 
      CPA SYMID 
      JMP DEC.1 
      LDA P1        BIT 15 ON A = 1 
      ELA            AND E = 1 IF AN OPEN CALL
      LDA P2        GET FUNCTION CODE AND OVERRIDE PARAM
      AND O.MSK     MASK TO OVERRIDE BITS 
      SZA           ANY OVERRIDES?
      JMP DEC.1     YES - CAN USE THIS DISC 
      SEZ           OPEN CALL?
      JMP DEC.1     YES - GO AHEAD AND USE THIS DISC
      LDA DISID     IS THIS A 
      SZA,RSS        MULTI DISC SEARCH? 
      JMP NEX.1     YES GO GET THE NEXT DISC
      JMP EX19      NO - SHOULDN'T EVER HAVE SPECIFIED 2 OR 3 
      SPC 2 
DEC.1 JSB SSTCK     MAKE SURE DISC IS IN CALLER'S SST 
      JMP DEC.2     IT IS SO GO AHEAD WITH STATUS CHECK 
      LDA DISID     IS THIS A MULTI 
      SZA,RSS        DISC SEARCH? 
      JMP NEX.1     YES - JUST SKIP THIS ONE THEN 
      JMP EX40      NO - TELL CALLER IT ISN'T IN HIS SST
      SPC 2 
DEC.2 CLB,CLE 
      LDA ALU       GET LU AND SET
      RAL,ERA        UP DOUBLE WORD 
      DST TMP1        CONTROL WORD FOR XLUEX
      JSB XLUEX     DO STATUS CHECK TO MAKE SURE
      DEF *+4        THIS IS A DISC DEVICE. 
      DEF STAT      (IN CASE SOMEONE DID AN LU
      DEF TMP1       SWITCH AFTER IT WAS MOUNTED) 
      DEF TMP3
      JMP DEC.3     IT'S BAD
      LDA TMP3      GET EQT WORD 5
      AND LUTYP     MASK TO THE LU TYPE 
      CPA DISTP     A DISC? 
      JMP DECOD     YES - CONTINUE WITH THE PROCESSORS
DEC.3 LDA DISID     NO - IS THIS A MULTI- 
      SZA,RSS        DISC SEARCH? 
      JMP NEX.1     YES - JUST SKIP THIS ONE THEN 
      JMP EX20      NO - GIVE THE GUY AN ERROR
      SPC 2 
DECOD CCA           SET THE NONE FOUND YET
      STA R1        FOR REUSABLE DISC SPACE ROUTINE 
      LDA P1        IF OPEN 
      SSA           REQUEST 
      JMP OPEN      GO OPEN 
      LDA P2        ELSE
      AND B77       GET REQUEST CODE (LESS OVERRIDE BITS) 
      ADA N16 
      SSA,RSS 
      JMP EX101     GREATER THAN 15 - EXIT
      ADA TABAD     INDEX INTO THE FUNCTION 
      JMP A,I       GO EXECUTE THE FUNCTION 
      SPC 2 
TABAD DEF TABA+16 
TABA  JMP CLOSE     0 
      JMP CREAT     1 
      JMP CNAM      2 
      JMP RLOCK     3 
      JMP EX101     4 
      JMP ULOCK     5 
      JMP EXOPN     6 
      JMP GEN       7 
      JMP EXOPN     8 
      JMP PACK      9 
      JMP EX101     10
      JMP DISMT     11
      JMP EX101     12
      JMP EX34      13   MOUNT AND FOUND ALREADY MOUNTED
      JMP EX101     14
      JMP CHGCL     15
* 
* 
* 
CKERR LDA P2        GET FUNCTION CODE PARAMETER 
      AND B77        AND MASK OFF ANY POSSIBLE OVERRIDE BITS
      CPA .1        CREAT CALL? 
      JMP EX33      YES - MUST NOT HAVE BEEN ENOUGH ROOM
      JMP EX6       SEND FILE NOT FOUND MESSAGE 
      SPC 3 
* 
* 
*   CK.LK 
* 
*   CHECK LOCK IN CARTRIDGE LIST.  IF INVALID, CLEAR IT 
* 
*   ENTRY   B = ADDRESS OF LOCK WORD IN CL
* 
*   RETURN  P+1  NOT LOCKED OR LOCKED TO CALLER OR INVALID LOCK 
*                THAT WAS CLEARED 
*           P+2  VALID LOCK BELONGING TO SOMEONE ELSE 
* 
* 
CK.LK NOP 
      STB TMP1
      LDA B,I       GET WORD FROM CARTRIDGE LIST
      ALF,ALF 
      AND B377      MASK TO ID SEGMENT NUMBER 
      SZA           IF NOT LOCKED 
      CPA IDNUM      OR LOCKED TO CALLER
      JMP CK.L2       JUST RETURN AT P+1
* 
      LDB KEYLN     GET LENGTH OF KEYWORD 
      CMB,INB        TABLE AND MAKE NEGATIVE
      ADB A         IF LOCK # IS BIGGER THAN KEYWORD
      SSB,RSS        TABLE LENGTH, MUST BE BAD
      JMP CK.L1       SO CLEAR AND RETURN P+1 
* 
      LDB KEYWD     GET ADDRESS OF KEYWORD TABLE
      ADB A          AND POSITION TO ENTRY
      ADB N1        (ACCOUNT FOR STARTING AT 1 INSTEAD OF 0)
      XLA B,I       GET ADDRESS OF ID SEGMENT 
      ADA .8        POSITION TO POINT OF SUSPENSION WORD
      XLA A,I       GET IT
      SZA           POINT OF SUSPENSION 0?
      JMP CK.L3     NO, GOOD LOCK SO STEP TO P+2
* 
CK.L1 LDA TMP1,I    GET LOCK WORD FROM CL 
      AND B377      MASK OFF LOCK PART
      STA TMP1,I     AND PUT BACK WITHOUT LOCK
CK.L2 LDA TMP1,I    GET THE LU/LOCK WORD FROM CL
      AND B377      ISOLATE THE LU
      ADA N1        ADJUST FOR 1 AS ORIGIN
      ADA DRT       ADD IN BASE OF THE DRT WORD 1 TABLE 
      LDA A,I       TO GET THE LU'S DRT WORD 1 ENTRY
      AND B3700     ISOLATE THE LU LOCK BITS
      SZA           IF ZERO, NO LU LOCK 
CK.L3 ISZ CK.LK     ELSE, LU IS LOCKED, RETURN (P+2)
      JMP CK.LK,I    R E T U R N
* 
B3700 OCT 3700      LU LOCK BITS MASK FOR DRT WORD 1
      SKP 
* 
* 
*  SCBCK :  LU MOUNTED IN CALLER'S SCB? 
*           IF CHECK IS APPROPRIATE (IN SESSION MODE AND NOT SYSTEM DISC
*           ON OVERRIDE CASE) SCANS THE DISCS' MOUNTED LIST IN SCB FOR ALU
*           AND MAKES SURE IT IS ACTIVE 
* 
*           ENTRY:  ALU CONTAINS LU# TO BE SEARCHED FOR 
*                   PTR1 POINTS TO CURRENT ENTRY IN ID TABLE
* 
*           RETURN: P+1 FOUND ALU IN SCB
*                   P+2 NOT THERE 
* 
* 
SCBCK NOP 
      LDA SESSN     GET IN SESSION FLAG 
      LDB PTR1,I    GET CURRENT ID FROM ID TABLE
      SZA           IN SESSION MODE?
      CPB SYMID     IS ALU A SYSTEM DISC? 
      JMP SCBCK,I   YES - DON'T CHECK DISCS' MOUNTED LIST 
* 
      LDA DISCL     GET # DISCS TO BE CHECKED 
      CMA,INA        AND USE AS A 
      STA COUN1       COUNTER.
      LDB MTDSC 
SCB.1 LDA B,I 
      AND ACDIS     (DISC MUST BE ACTIVE TO MATCH)
      CPA ALU       THIS DISC SAME AS ALU?
      JMP SCBCK,I   YES - RETURN
      INB 
      ISZ COUN1 
      JMP SCB.1     GO LOOK AT NEXT ONE 
      ISZ SCBCK     DIDN'T FIND IT SO 
      JMP SCBCK,I    RETURN AT P+2
      SPC 4 
* 
* 
*  SSTCK :  LU IN CALLER'S SST? 
*           IF CALLER IS IN SESSION, SCANS SST TO MAKE
*           SURE THE DISC WE'RE GOING TO SEARCH IS IN 
*           HIS ADDRESSING SPACE. 
* 
*           ENTRY - ALU CONTAINS LU# TO BE SEARCHED FOR 
* 
*           RETURN- P+1   IT'S THERE
*                   P+2   NOT THERE 
* 
* 
SSTCK NOP 
      LDA SESSN     GET IN SESSION FLAG 
      SZA,RSS       IN SESSION MODE?
      JMP SSTCK,I   NO - NO SST LIMITATIONS ANYWAY!!
* 
      LDB IDSSW     GET POINTER TO SST LENGTH WORD
      LDA B,I       GET SST LENGTH WORD 
      STA COUN2     SAVE IT AS COUNTER  (IT'S NEGATIVE) 
CK.1  INB 
      LDA B,I       GET SST ENTRY 
      ALF,ALF       GET SYSTEM LU TO LOWER BYTE 
      AND B377      MASK IT OFF 
      INA           ADD ONE  (COMPENSATE FOR SST'S FORMAT)
      CPA ALU       MATCH?
      JMP SSTCK,I   YES - WE'RE DONE! 
      ISZ COUN2 
      JMP CK.1      TRY THE NEXT ONE
      ISZ SSTCK     END OF SST - STEP RETURN ADDRESS
      JMP SSTCK,I    AND RETURN 
* 
* 
*  SCAND :  SEARCH CARTRIDGE DIRECTORY IN BUF FOR TMP2
* 
*           ENTRY:  TMP2 - WHAT WE'RE SEARCHING FOR 
*                   OFFST - OFFSET IN ENTRY   = 0 FOR LU
*                                             = 2 FOR CRN 
*                                             = 3 FOR ID
*                   MASK - MASK IF NEEDED     = 177777B FOR CRN 
*                                             = 377B FOR LU 
*                                             = 7777B FOR ID
*                   DIRAD - STARTING POSITION IN CL 
* 
*           RETURN: P+1 END OF CL AND NOT FOUND IN CL 
*                   P+2 FOUND IT
*                       DIRAD  - POINTS TO NEXT ENTRY IN CL 
*                       B - POINTS TO 1ST WORD OF "FOUND" ENTRY 
*                       ALU - LU # FROM "FOUND" ENTRY 
*                       ATRAK - LAST TRACK INFO FROM "FOUND" ENTRY
* 
* 
SCAND NOP 
      LDA OFFST 
      CMA,INA 
      ADA .4
      STA EXTRA 
      LDB DIRAD     GET STARTING POSITION 
* 
SCAN1 LDA B,I 
      SZA,RSS       ZERO?  END OF LIST? 
      JMP SCAND,I   END OF LIST AND NOT FOUND.  RETURN P+1
      AND B377
      STA ALU       SAVE LU#
      ADB OFFST     POSITION TO ELEMENT IN QUESTION 
      LDA B,I 
      ADB EXTRA     POSITION TO START OF NEXT ENTRY 
      AND MASK
      CPA TMP2      IS THIS THE ONE?
      RSS           YES.  FOUND IT
      JMP SCAN1     NO - KEEP LOOKING 
* 
      STB DIRAD     UPDATE DIRAD
      ADB N3
      LDA B,I       GET LAST TRACK
      STA ATRAK      INFORMATION
      ADB N1        B POINTS TO BEGINNING OF ENTRY
      ISZ SCAND     RETURN
      JMP SCAND,I    AT P+2 
* 
.4    DEC 4 
       SKP
* 
* RDPS       READS CARTRIDGE DIRECTORY FROM SYSTEM DISC 
* 
RDPS  OCT -1
      JSB WCSR      WRITE CURRENT SECTOR BLOCK IF DIRTY 
      JSB EXEC
      DEF CLRTN     READ 256 WORD CARTRIDGE 
      DEF RDNAB      DIRECTORY FROM LU2 
      DEF .2          INTO BUF. 
      DEF BUF       TRACK AND SECTOR
      DEF .256       ADDRESS OF CARTRIDGE 
      DEF $CL1        DIRECTORY COMES FROM
      DEF $CL2          EXTERNALS $CL1 AND $CL2.
CLRTN JMP EX99
      CPB .256      READ 256 WORDS? 
      RSS           OK
      JMP EX1       NO - EXIT DISC ERROR. 
      CLA           CLEAR DISC DIRECTORY
      STA LDRLU      IN-CORE FLAG 
      JMP RDPS,I    RETURN
* 
.256  DEC 256 
      SPC 5 
* 
*  WCSR     WRITE CURRENT BLOCK 
* 
WCSR  NOP 
      LDA WCS       GET WRITTEN-ON FLAG 
      SZA,RSS       IF NOT DIRTY
      JMP WCSR,I     JUST RETURN. 
      CLA 
      STA WCS       CLEAR WRITTEN-ON FLAG 
      JSB EXEC
      DEF WRTN      WRITE CURRENT 128-WORD
      DEF WTNAB      BLOCK FROM SBUF (IN BUF) 
      DEF LDRLU       TO THE DISC.
SBUF  DEF *         LDRLU, LTRAC, LSECT CONTAIN THE 
      DEF .128       CURRENT LU, TRACK, AND 
      DEF LTRAC       SECTOR INFORMATION. 
      DEF LSECT 
WRTN  JMP EX99
      CPB .128      WRITE ALL 128 WORDS?
      JMP WCSR,I    OK - RETURN.
      JMP EX1       NO - EXIT DISC ERROR. 
* 
DRLU  NOP 
      SKP 
* 
*  RWSUB     ROUTINE TO READ OR WRITE A TWO-SECTOR BLOCK
* 
*  THIS IS THE ONLY ROUTINE THAT READS THE FILE DIRECTORIES 
* 
* 
*  4 CASES OF HOW MUCH WILL BE READ 
* 
*  CASE    SECT/TR    SECT    SBFLN    READ LNG       COMMENTS
* 
*   1      UNKNOWN   2-254    2-254       2      USED FOR NORMAL CLOSE NOT
*                      0        2         2      REQUIRING A SEARCH 
* 
*   2      UNKNOWN     0     16-256      16      USED TO READ DISC DIRECTORY
*                                                SBFLN MUST BE 16-256 BLOCKS
*   3      16-256    0-254  =>SECT/TR   ENTIRE TRACK   TRACK LENGTH IS KNOWN
*                                                      AND FITS - READ WHOLE
*   4      16-256    0-254   <SECT/TR   LARGEST SBLFM - (N * 14) THAT 
*                                       WON'T OVERFLOW THE TRACK
* 
* 
*  ENTRY:  FOLLOWING MUST BE SET BEFORE CALLING RWSUB 
* 
*     DRLU - DISC LU (2 - 63) 
*    TRACK - DISC TRACK OF REQUESTED READ 
*     SECT - DISC SECTOR OF REQUESTED READ
*    #SECT - NUMBER OF SECTORS PER TRACK IF KNOWN; ELSE 0 
*     ABUF - ADDRESS OF BUFFER BUF
*    SBFLN - SECTOR LENGTH OF BUF 
*    SBFLM - LARGEST 2 + (N * 14) <= SBFLN
*      WCS - # 0 MEANS LAST BLOCK IS DIRTY AND WILL BE POSTED BEFORE READ 
* 
* 
*  RETURN:
* 
*    LTRAC - LAST TRACK;  SAME AS TRACK WHEN EXIT 
*    LSECT - LAST SECTOR;  SAME AS SECT WHEN EXIT 
*    LDRLU - LAST LU;  SAME AS DRLU + PRC WHEN EXIT 
*     SBUF - A-REG - ADDRESS OF REQUESTED BLOCK 
*     NSEC - NEGATIVE VALUE OF SECTOR BEYOND BUFFER  -(END OF BUFFER + 1) 
*    C.BFL - CURRENT # SECTORS IN BUFFER. 
*    WORD# - CURRENT # WORDS IN BUFFER. 
* 
* 
RWSUB NOP 
      JSB WCSR      WRITE CURRENT BLOCK IF ITS DIRTY
      LDA DRLU      GET REQUESTED DISC LU 
      ADA PRC        ADD IN PRIVILEDGED BITS
      STA RPRM        AND SAVE TEMPORARILY
      CPA LDRLU     SAME AS CURRENT LU? 
      RSS 
      JMP RDSU1     NO - FORCE A DISC READ
      LDA TRACK     GET REQUESTED TRACK 
      CPA LTRAC     SAME AS CURRENT TRACK?
      RSS 
      JMP RDSU1     NO - FORCE A DISC READ
RDSU  LDA SECT      GET REQUESTED SECTOR
      ADA NSEC      CHECK IF REQUIRED BLOCK IS IN CORE
      SSA,RSS        BELOW MAXIMUM? 
      JMP RDSU1     NO - FORCE A DISC READ
      ADA C.BFL 
      SSA            ABOVE MINIMUM? 
      JMP RDSU1     NO - FORCE A DISC READ
* 
      LSL 6         REQUESTED BLOCK IS IN CORE.  MPY BY 64
      ADA ABUF       WORDS PER SECTOR.  CALCULATE CURRENT 
      STA SBUF        READ SECTOR AND SAVE FOR POSSIBLE POST. 
      LDB RPRM
      STB LDRLU 
      LDB TRACK     SAVE CURRENT POSITION:
      STB LTRAC      LU,TRACK, AND SECTOR 
      LDB SECT
      STB LSECT 
      JMP RWSUB,I   RETURN
* 
*  DATA NOT IN CORE -- READ FROM DISC 
* 
RDSU1 LDA SECT      GET REQUESTED SECTOR
      LDB #SECT     GET NUMBER OF SECTORS PER TRACK 
      CMB,INB,SZB,RSS    KNOW # SECTORS PER TRACK?
      JMP RDSU3     NO - GO USE 2 OR 16 SECTORS, ETC. 
      ADB SBFLN     YES - CALCULATE BUF LENGTH - #SECT/TRACK
      SSB           BUF BIG ENOUGH FOR WHOLE TRACK? 
      JMP RDSU2     NO - READ BUFFER IS TOO SMALL 
      CLA           YES - READ WHOLE
      LDB #SECT      TRACK STARTING WITH
      JMP RDSU4       SECTOR 0. 
* 
*  KNOW #SECTORS/TRACK BUT WHOLE TRACK WON'T FIT IN BUFFER.  CALCULATE
*  LARGEST SBLFM - (N*14) THAT WON'T OVERRUN TRACK
* 
RDSU2 LDB SBFLM     GET MAX DISC READ LENGTH
      ADB A          ADD IN STARTING SECTOR NUMBER
      CMB,INB         NEGATE
      ADB #SECT        ADD IN # SECTORS PER TRACK 
      RSS 
      ADB .14       DECREMENT "ONE BLOCK" (INCLUDE SEC SKIP)
      SSB           EQUAL OR LESS THAN END OF TRACK?
      JMP *-2       NO - KEEP DECREMENTING TIL <= END OF TRK
      CMB,INB       CALCULATE DISTANCE FROM END OF TRACK
      ADB #SECT      FOR END OF STUFF IN BUFFER + 1 
      JMP RDSU4 
* 
*  DON'T KNOW #SECT/TRACK 
* 
RDSU3 LDB .2
      SZA,RSS       IS STARTING TRACK 0?
      CPB SBFLM     YES - IS READ BUFFER BIGGER THAN 1 BLOCK? 
      RSS           NO - USE 2-SECTOR READ
      BLF,RBR       YES - USE 16 SECTOR READ
      ADB A         CALCULATE END OF STUFF IN BUFFER + 1
* 
RDSU4 STA RSECT     STARTING SECTOR OF DISC READ
      CMB,INB 
      STB NSEC      SAVE -(LAST SECTOR IN BUFFER + 1) 
      ADA B         CALCULATE NUMBER OF SECTORS IN
      CMA,INA        BUFFER AND SAVE
      STA C.BFL 
      LSL 6         CALCULATE BUFFER LENGTH IN
      STA WORD#      WORDS AND SAVE FOR EXEC CALL 
* 
      JSB EXEC
      DEF RRTN
      DEF RDNAB     READ
      DEF RPRM      FROM LU 
ABUF  DEF BUF       INTO BUF
      DEF WORD#     # WORDS 
      DEF TRACK     FROM TRACK
      DEF RSECT     AND SECTOR
RRTN  JMP ER99
      CPB WORD#     GOOD TRANSFER?
      JMP RDSU      YES - SET UP NEW LAST PARAMS AND RETURN.
      JMP EX1       NO - EXIT DISC ERROR
* 
* 
ER99  LDA P2        SEE IF THIS WAS A DISMOUNT
      AND B377       REQUEST? 
      CPA .11 
      JMP DISM0     IT WAS, ALLOW THE DISC TO BE DISMOUNTED ANYWAY
      JMP EX99      OTHERWISE EXIT DISC ERROR 
* 
* 
* 
WORD# NOP 
RSECT NOP 
NSEC  NOP 
C.BFL NOP 
SBFLM NOP 
SBFLN NOP 
LDRLU NOP 
LTRAC NOP 
LSECT NOP 
ECLOP NOP 
      SKP 
OPEN  LDA A.STR     GET 3 CHARACTER 
      LDB .3         NAME FROM PASSED 
      JSB RDSTR       STRING INTO NAME. 
      LDA A.STR     MOVE STRING INTO NAME BUFFER
      CLE           THIS IS DONE IN CASE THERE IS A MULTI-
      JSB MOVE1      DISC SEARCH (STRING'S NOT AROUND 2ND TIME) 
      LDA NAME+1    CLEAR POSSIBLE
      RAL,CLE,ERA    SCRATCH FILE 
      STA NAME+1      PURGE BIT 
      CLB           PRESET FOR NOT EXCLUSIVE OPEN 
      LDA NAME      REMOVE POSSIBLE 
      RAL,CLE,ERA    SIGN BIT AND 
      STA NAME        PUT BACK. 
      SEZ           IS THIS AN EXCLUSIVE OPEN?
      INB           YES - GET READY TO SET FLAG TO 1
      STB ECLOP     SET OR CLEAR EXCLUSIVE OPEN FLAG
      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
      LDA SC,I      GET SECURITY CODE FROM DIRECTORY ENTRY
      SSA           IF SECURITY CODE IS NEGATIVE
      CPA P4         AND DOESN'T EXACTLY MATCH
      RSS             SECURITY CODE PASSED IN,
      JMP EX7          RETURN AND ERROR 7 
      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 AND JUMP TO PURGE
* 
      LDA STRNG+1   FETCH POSSIBLE SCR PURGE FLAG 
      SSA,RSS       IF SIGN NOT SET 
      JMP OPEN1      CONTINUE 
      ADB N2         ELSE, FORCE PURGE - CHECK OP FLG COUNT 
      SSB,RSS       IF JUST ONE - OK
      JMP EX101      ELSE EXIT ERROR -101 
      CLA 
      STA FLAGA,I   CLEAR FLAG, IF ANY
      JMP PURGE     GO PURGE FILE 
* 
OPEN1 CPB .7        THEN NO ROOM SO 
      JMP EX8       EXIT
      LDA ECLOP     IF EXCLUSIVE OPEN 
      CLE,SZA,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 IDNUM     YES; GET THE ID ADDRESS 
      RAL,ERA       SET THE EXCLUSIVE/NON-EXCLUSIVE 
      IOR SQCPU     ADD IN CPU AND SEQUENCE NUMBERS 
      STA B,I       FLAG AND PUT IN THE DIRECTORY 
      STA WCS       SET TO WRITE THE BLOCK
OPEN4 CLA          SET UP THE RETURN PARAMETERS 
CREX  JSB RPRM      SET THE RETURN PRAMS
EXIT  JSB WCSR      WRITE THE SECTOR
      JSB PRTN      PASS THE RETURN PRAMS 
      DEF *+2       AND 
      DEF R1        THEN
EXIT2 JSB EXEC      COMPLETE (SERIALLY REUSABLE)
      DEF *+4 
      DEF .6
      DEF .0
      DEF N1
N1    DEC -1
.0    NOP PP
      SKP 
* 
*     EXTENSION OPEN ROUTINE
* 
EXOPN JSB DIRCK     GO READ IN THE MASTER DIRECTORY ENTRY 
      CLA           CLEAR THE 
      STA IDNUM     OPEN FLAG WORD
      STA SQCPU      HAVE TO CLEAR THIS PART OF IT TOO
      LDA P5        SET THE 
      SZA,RSS       IF AFTER THE MAIN THEN
      JMP OPEN4     WE HAVE IT ALREADY
* 
      AND B377      CHECK IF EXTENT>255?
      CPA P5        YES ? NO? 
      ALF,SLA,ALF   NO  EXTENSION NO. FOR POSSIBLE
      JMP EX46      YES  GO EXIT  ERROR -6
* 
      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 P5        THIS IT?
      JMP OPEN4     YES SO GO RETURN THE PRAMS
CSER  LDA TYPE      NO SO CONTINUE
      JMP NSHR4     THE SEARCH
      SPC 1 
EXOPT LDB P2        IF EXTENT OPEN IS FOR 
      BLR,BLR        WRITE THEN GO
      RBR,RBR         CREAT THE EXTENT
      CPB .8
      JMP CREA0     GO EXIT 
      LDA N5        ELSE RETURN ILLEGAL RECORD ERROR
      JMP CREX      GO EXIT 
      SPC 1 
.10   DEC 10
.8    DEC 8 8B
.14   DEC 14
ANAME DEF NAME
ATRAK NOP 
SIGN  OCT 100000
      SPC 2 
* 
*  SETDR     ROUTINE TO SET UP TO READ A DIRECTORY
* 
SETDR NOP 
      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 
      LDA N14       SET SECTOR TO -14 (UDAD ADDS 14)
      STA SECT      SET THE SECTOR
      JMP SETDR,I   RETURN
* 
N14   DEC -14 
      SKP 
* 
* 
* N.SHR     DIRECTORY SEARCH ROUTINE
*           TARGET NAME IN NAME 
      UNL 
PRC   OCT 74000 
      LST 
*           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 SBUF      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
* 
CKRUS ADA .3        POSITION TO THE TYPE WORD 
      LDB A,I        AND GET IT 
      ADA .3        POSITION TO THE SIZE WORD 
      SZB           TYPE 0??
      CPB .6         OR TYPE 6??
      CCB,RSS       YES - DON'T WANT TO REUSE THE FILE
      LDB A,I       NOT TYPE 0 OR 6 SO GET THE SIZE WORD
      ADA .10        AND POSITION TO THE NEXT DIRECTORY ENTRY 
      SSB           WAS THIS TYPE 0 OR 6??
      JMP NSHR5     YES - DON'T TRY TO REUSE
      CPB NAME+6    NO - IS SIZE EXACTLY THE SAME 
      JMP CKRU1     YES - CHECK FURTHER 
      JMP NSHR5     NOPE - HANG IT UP AND GO TO NEXT ENTRY
* 
CKRU1 LDB R1        IF ALREADY GOT 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
      LDB SBUF      CALCULATE OFFSET OF THIS ENTRY IN 
      CMB,INB        IN THE CURRENT BLOCK 
      ADB A 
      ADB N16       HAVE TO BACK UP 16
      STB R3        R3 = OFFSET IN CURRENT BLOCK
      JMP NSHR5     CONTINUE THE SCAN 
      SKP 
* SETAD     TO SET UP ADDRESSES FOR DIRECTORY ENTRY IN BUF AT 
*           ADDRESS POINTED TO BY A 
* 
* 
SETAD NOP 
      CLB,CLE 
      JSB P.PAS 
N10   DEC -10 
DIRA  NOP 
      NOP 
      NOP 
TYPE  NOP 
TRAKA NOP 
SECTA NOP 
#SEC  NOP 
RL    NOP 
SC    NOP 
FLAGA NOP 
      JMP SETAD,I 
      SPC 2 
      SPC 2 
* 
* 
*  RPRM 
* 
RPRM  NOP 
      STA R1        SET FIRST RETURN PRAM 
      SSA           IF RETURNING AN ERROR 
      JMP RPRM1      SKIP STRING RETURN 
      LDA P2        IS THIS A CREAT CALL? 
      AND B77 
      CPA .1        CREAT FUNCTION CODE?
      JMP RPRM0     YES - RETURN STRING BUT DON'T SET SY BIT
      LDA P1        IS THIS AN
      SSA,RSS        OPEN CALL??
      JMP RPRM1     NO - SKIP STRING RETURN 
      LDB TYPE,I
      ADB SYSDS     ADD SIGN BIT IF THIS WAS A SYSTEM DISC
      STB TYPE,I
RPRM0 JSB EXEC      YES 
      DEF *+5 
      DEF .14       USE STRING PASSAGE TO 
      DEF .2         SEND TO FATHER (CALLER)
      DEF TYPE,I      6 WORDS OF DIRECTORY
      DEF .6           ENTRY (START AFTER NAME) 
      LDB TYPE,I      NOW CLEAR OUT POSSIBLE
      RBL,CLE,ERB    ON SYSTEM DISC FLAG IN 
      STB TYPE,I      BIT 15 OF TYPE WORD.
RPRM1 CLB           CALCULATE OFFSET
      LDA SBUF       OF DIRECTORY ENTRY 
      CMA,INA         IN THE SECTOR 
      ADA DIRA      OFFSET IS ENTRY NUMBER
      DIV .16        OF DIRECTORY ENTRY (0-8) 
      ALF,ALF       ROTATE OFFSET LEFT
      RAR            7 BITS IN A-REG
      ADA SECT      ADD IN SECTOR NUMBER
      ALF           ROTATE OFFSET AND SECTOR
      RAL,RAL       LEFT 6 BITS IN A-REG
      ADA ALU       ADD IN LU NUMBER
      STA R2        SAVE IN 2ND RETURN PARAMETER
      LDA TRACK     TRACK NUMBER OF DIRECTORY 
      STA R3         ENTRY IS 3RD RETURN PARAMETER
      LDA TRAKA,I   STARTING TRACK OF FILE
      STA R4         IS 4TH RETURN PARAMETER
      LDA SECTA,I   GET THE STARTING SECTOR 
      AND B377       ADDRESS AND ISOLATE IT 
      LDB #SECT     GET THE NUMBER OF SECTORS/TRACK 
      BLF,BLF       ROTATE AND
      ADA B         COMBINE WITH THE SECTOR 
      STA R5        SAVE AS 5TH RETURN PARAMETER
      JMP RPRM,I
      SPC 2 
SYSDS NOP 
R1    NOP 
R2    NOP 
R3    NOP 
R4    NOP 
R5    NOP 
* 
* RDNXB     READ NEXT DIRECTORY BLOCK 
* 
* 
*           EXIT   P+1 - END OF DIRECTORY 
*                  P+2 - OK RETURN
* 
* 
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
* 
* UDAD  --  UPDATE THE DIRECTORY ADDRESS
* 
* 
*           EXIT   P+1 - END OF DIRECTORY 
*                  P+2 - OK RETURN
* 
* 
* NOTE:  THE FIRST TIME A BLOCK IS READ FROM THE DISC (I.E. TO GET
*        16 WORD SPECIF ENTRY) THE DIVIDE BY #SECT IS A 0,0 DIVIDED 
*        BY 0.  THE RESULT IS 0,0 WHICH IS WHAT IS WANTED.  THIS IS 
*        ONLY CASE WHERE THE #SECT IS A 0 ON THE DIVIDE.
* 
UDAD  NOP 
      JSB WCSR      WRITE CURRENT BLOCK 
      LDA .14       A_14
      ADA SECT      ADD  7  TO THE SECTOR 
      CLB           PREPARE FOR DIVIDE
      DIV #SECT     DIVIDE BY THE NO OF SECTORS0TRACK 
      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
      SPC 2 
LTR   NOP 
NXSCA DEF BUF+5 
      SKP 
* DPMM  MOVE DISC PARAMETERS FOR CURRENT UNIT 
*           CALLING SEQUENCE
* 
*           E=0  -  SAVE PARAMETERS 
*           E=1  -  MOVE PARAMETERS BACK
* 
* 
DPMM  NOP 
      LDA NXSCA 
      LDB SIGN
      JSB P.PAS 
N11   DEC -11 
NXSEC NOP 
#SECT NOP 
LASTR NOP 
#TRK  NOP 
NXTR  NOP 
BAD1  NOP 
BAD2  NOP 
BAD3  NOP 
BAD4  NOP 
BAD5  NOP 
BAD6  NOP 
      NOP 
      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 
      JMP DPMM,I
      SPC 5 
* 
*  FLAG     CHECKS FOR OPEN FLAGS 
*           ASSUMES FLAGA POINTS TO THE FLAG AREA 
* 
FLAG  NOP 
      CLA           CLEAR THE OPEN COUNT
      STA COUN2     AND 
      LDA N7        SET TO TEST 
      STA COUN1     THE OPEN FLAGS
      LDB FLAGA     GET THE FLAG ADDRESS
FLAG1 LDA B,I       GET OPEN FLAG 
      RAL,CLE,ERA   REMOVE POSSIBLE EXCLUSIVE BIT 
      JSB DORM      TEST FOR DORMANT
      ISZ COUN2     STEP OPEN FLAG COUNT
      INB           STEP TO NEXT ENTRY
      ISZ COUN1     STEP COUNT; END OF FLAGS? 
      JMP FLAG1     NO; TRY NEXT ONE
      JMP FLAG,I    YES; RETURN 
      SKP 
* 
*  DORM     CHECK TO SEE IF PROGRAM IS DORMANT
* 
*                OPEN FLAG IN A 
*                LOCATION TO BE SET TO ZERO'S ADDRESS INB 
*                   RETURN P+1 IF NOT DORMANT; ELSE P+2 
DORM  NOP 
      STB TMP2      SAVE B REG
      STA ASAVE     SAVE A-REG
      SZA,RSS       IF 0 THEN JUST
      JMP DORM0      RETURN AT P+2
      AND MASK2     DOES FLAG BELONG
      CPA $$CPU       TO OUR CPU? 
      RSS           YES - CAN CONTINUE CHECKS 
      JMP DORM1     NO - SO RETURN P+1 (NOT DORMANT)
* 
      LDA ASAVE     GET FLAG AND MASK 
      AND B377       TO ID SEGMENT NUMBER OFFSET
      SZA,RSS 
      JMP DORM2 
      LDB KEYLN     GET KEYWORD TABLE LENGTH
      CMB,INB        MAKE IT NEGATIVE 
      ADB A           ADD OPEN FLAG (AN OFFSET IN TABLE)
      SSB,RSS       BEYOND KEYWORD TABLE LIMITS?
      JMP DORM2     YES - CLEAR AND RETURN P+2
* 
      CPA IDNUM     IF SAME ID SEG (OFFSET #) EITHER FLAG 
      JMP DORM2      BELONGS TO CALLER OR NEEDS TO BE CLEARED 
* 
      LDB KEYWD     GET 1ST WORD ADDRESS
      ADB A          OF KEYWORD TABLE 
      ADB N1          PLUS OFFSET 
      XLA B,I 
      LDB A 
      LDA ASAVE     GET OPEN FLAG 
      AND B7400     MASK TO SEQUENCE NUMBER 
      ALF           MOVE TO BITS 15-12
      STA TMP3       AND SAVE 
      ADB .31       POSITION TO SEQUENCE NUMBER IN ID SEG.
      XLA B,I        AND LOAD IT
      AND MASK2     MASK TO BITS 15-12
      CPA TMP3      SAME SEQ # AS IN OPEN FLAG? 
      RSS           YES - CONTINUE CHECKING 
      JMP DORM2     NO - MUST BE A JUNK OPEN FLAG 
      ADB N23       POSITION TO POINT OF SUSPENSION 
      XLA B,I        AND LOAD IT
      SZA           IF ZERO, PROGRAM IS DORMANT 
      JMP DORM1     NOT DORMANT 
* 
DORM2 CLA           CLEAR OPEN
      STA TMP2,I     FLAG 
      ISZ WCS       SET WRITTEN ON FLAG 
DORM0 ISZ DORM      STEP RETURN ADDRESS 
DORM1 LDB TMP2      RESTORE B-REG 
      JMP DORM,I    RETURN
      SPC 2 
EX1   CLA,INA,RSS 
EX2   LDA .2
      RSS 
EX6   LDA .6
      RSS 
EX7   LDA .7
      RSS 
EX8   LDA .8
      RSS 
EX11  LDA .11 
      RSS 
EX13  LDA .13 
      RSS 
EX14  LDA .14 
      RSS 
EX19  LDA .19 
      RSS 
EX20  LDA .20 
      RSS 
EX30  LDA .30 
      RSS 
EX32  LDA .32 
      RSS 
EX33  LDA .33 
      RSS 
EX34  LDA .34 
      RSS 
EX35  LDA .35 
      RSS 
EX40  LDA .40 
      RSS 
EX46  LDA .46 
      RSS 
EX99  LDA .99 
      CMA,INA 
      JMP CREX
      SPC 2 
.7    DEC 7 
.9    DEC 9 
.13   DEC 13
.30   DEC 30
.32   DEC 32
.33   DEC 33
.34   DEC 34
.35   DEC 35
.40   DEC 40
.46   DEC 46
.99   DEC 99
.128  DEC 128 
B77   OCT 77
B7400 OCT 7400
N8    DEC -8
N23   DEC -23 
.11   DEC 11
.19   DEC 19
.31   DEC 31
FIRST NOP 
COUN1 NOP 
COUN2 NOP 
COUN3 NOP 
BTRA  DEF BAD1
BADTR NOP 
ASAVE NOP 
* 
* 
      SKP 
CREAT LDA A.STR 
      LDB .9
      JSB RDSTR     READ THE SKELETON DIRECTORY 
      LDA A.STR     MOVE STRING INTO NAME BUFFER
      CLE           THIS IS DONE IN CASE THERE IS A MULTI-DISC
      JSB MOVE1      SEARCH (STRING'S NOT ARUOND 2ND TIME)
      LDA NAME+3    GET THE TYPE OF THE FILE BEING CREATED
      SZA           TYPE ZERO?
      JMP CR.       NO - SKIP THIS STUFF
      DLD NAME+4    WANT TO PULL OUT WORDS
      DST TPZER      5,6,7, AND 8 IN THE
      DLD NAME+6      DIRECTORY ENTRY AND REPLACE 
      DST TPZER+2      THEM WITH ZERO'S 
      CLA 
      CLB 
      DST NAME+4
      DST NAME+6
* 
CR.   LDA IDNUM    SET UP EXCLUSIVE OPEN FLAG 
      IOR SIGN     ADD THE EXCLUSIVE BIT
      STA IDNUM     SAVE IT 
      CLA          CLEAR THE EXTENT FLAG
      STA GSEC      SAVE IT FOR THE DIRECTORY 
* 
      DLD NAME+5    GET DOUBLE WORD SIZE SPECIFIED
      SWP 
      STB SFLAG     SET FLAG FOR MAX SIZE   0 = 32K  -1 = 32K X 128 
      SZB,RSS       IF SIZE IS + SECTORS AND < 32767  OR
      SSA 
      SSB            SIZE IS IN -CHUNKS  OR -1 SPECIFIED
      JMP CR.0        THEN JUST USER LOWER HALF OF WORD 
      CPA N1        IF REST OF DISC REQUEST FROM
      SZB            SINGLE WORD CREAT CALL, THEN JUST
      RSS             USE WHAT'S IN A  ( -1)
      JMP CR.0         AGAIN
      DIV .256      DIVIDE DOUBLE WORD # SECTORS BY  "128 QUANTITY" 
      SOC           IF OVERFLOW  (DIVIDEND TOO BIG) 
      JMP EX30       TAKE ERROR EXIT
      SZB           IF NOT AN EVEN # "128 QUANTITY" 
      INA            THEN INCREMENT 1 "128 QUANTITY"
      CMA,INA       MAKE NEGATIVE 
CR.0  SSA,RSS       IF >0 JUST KEEP WHAT'S IN A 
      JMP CR.1
      CPA N1        IF -1  WANT REST OF DISC
      JMP CR.1
      LDB .127      IF LESS THAN -128 (X128 BLOCK CHUNKS) 
      ADB A          THEN CONVERT TO SECTORS
      SSB,RSS         BY MAKING POSITIVE AND MULTIPLYING BY 256 
      CMA,INA          IF IN + SECTORS ALREADY WILL FALL THROUGH
      SSB,RSS 
      ALF,ALF 
CR.1  STA NAME+6
* 
      JSB SETDR     SET TO BEGINNING OF DIRECTORY AGAIN 
      JSB N.SHR     SEARCH FOR THE NAME 
CREA0 CCE,RSS       NOT FOUND - SKIP
      JMP EX2       FOUND - TAKE DUP NAME EXIT
* 
      LDB R1        WAS A REUSABLE ENTRY FOUND? 
      SSB,RSS       WELL! 
      JMP RUSE      YES GO SET IT UP. 
* 
      SZA,RSS       ELSE IF DIRECTORY FULL
      JMP ER14      TAKE EXIT 
* 
      JSB SETAD     SET THE ADDRESSES 
      CCE 
      LDA DIRA      MOVE IN 
      JSB MOVE1 
      LDA IDNUM     SET THE OPEN FLAG 
      IOR SQCPU     ADD IN CPU AND SEQUENCE NUMBERS 
      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 THE REQUEST SIZE
      LDA BADTR,I   AND THE FIRST BAD TRACK 
      CPB N1        IF REST OF DISC 
      SZA,RSS       ELSE IF TRACK IS GOOD, 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 
* 
CREA2 CPB N1        IF REST OF DISC 
      JMP CREA5     JMP 
* 
CREA7 JSB NXT/S     COMPUTE THE NEXT TRACK AND SECTOR 
      JMP CREA8     WHOOPS - OVERFLOWED OR TRACK > 32767
      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 
* 
CREA8 CLA           NO - CLEAR ENTRY
      STA DIRA,I     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 
* 
CREA4 LDA SETAD     IT FIT SO 
CREA6 STA NXTR      UPDATE THE NEXT 
      STB NXSEC     TRACK AND SECTOR
      ISZ WCS       SET THE WRITE FLAG
* 
      LDA TYPE,I    GET THIS FILE'S TYPE
      SZA           TYPE ZERO?? 
      JMP CR.61     NO - SKIP THIS STUFF
      DLD TPZER     REPLACE WORDS 5,6,7, AND 8
      STA TRAKA,I    IN THE DIRECTORY ENTRY 
      STB SECTA,I     THAT WERE REMOVED BEFORE
      DLD TPZER+2      THE ENTRY WAS CREATED
      STA #SEC,I
      STB RL,I
CR.61 CLA           CLEAR A FOR FIRST RETURN PARAMETER
      JSB RPRM      AND GO SET UP THE RETURN
      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
* 
CREA5 LDA SFLAG     SEE WHAT THE MAX FILE SIZE SHOULD BE
      ELA           E=1 --> MAX = 32K X 128   E=0 --> MAX = 32K 
      LDA MAX       CALCULATE MAX FILE
      CLB            SIZE IN SECTORS   32767 X "128 QUANTITY" 
      SEZ           IF DOUBLE WORD CREAT  WANT 32767
      INA            SO INCREMENT MAX BY 1
      SEZ           DON'T SHIFT IF MAX = 32K
      LSL 8           (GET HIGH ORDER BITS TO A)
      SWP 
      DST TMP1         AND TEMP SAVE IN TMP1 AND TMP2 
      CLA           TEMPORARILY SAVE
      LDB SECTA,I    -(STARTING 
      JSB .DNG        SECTOR) 
      DST TMP3         IN TMP3
      LDA TRAKA,I   CALCULATE -(FILE'S STARTING 
      CMA,INA        TRACK ADDRESS) + LAST TRACK
      ADA LASTR       ON SUBCHANNEL X NUMBER
      MPY #SECT        SECTORS PER TRACK -
      SWP               FILE'S STARTING 
      JSB .DAD           SECTOR ADDRESS 
      DEF TMP3      = SECTORS ON REST OF SUBCHANNEL 
      DST TMP3      SAVE IN TMP3
      SOC           OVERFLOWED THE DOUBLE WORD? 
      JMP CR.51     YES - JUST USE MAX FILE SIZE
      DLD TMP1      GET MAX FILE SIZE 
      JSB .DNG      -(MAX FILE SIZE IN SECTORS) 
      JSB .DAD       + NUMBER SECTORS ON REST 
      DEF TMP3        OF SUBCHANNEL 
      SSA,RSS       REST OF DISC BIGGER THAN MAX FILE SIZE? 
      JMP CR.51     YES - JUST USE MAXIMUM FILE SIZE
      DLD TMP3      GET # SECTORS ON REST OF DISC 
      JMP CR.52     SKIP
CR.51 DLD TMP1      GET MAX FILE SIZE 
CR.52 SWP           GET HIGH ORDER BITS TO B-REG
      SZB,RSS       <=32767 
      SSA           <= 32767? 
      RSS 
      JMP CR.53     YES - SO SAVE SIZE IN +SECTORS
      DIV .256      NO - DIV BY "128 QUANTITY" TO GET SIZE
*                         JUST THIS ONE TIME, IGNORE ANY SECTORS LEFT OVER
      CMA,INA       MAKE NEGATIVE 
CR.53 STA #SEC,I    SET FILE SIZE AS +SECTORS OR -"128 QUANTITY" IN FILE ENTRY
      SZA,RSS       IF ZERO 
      JMP NEXT       TRY NEXT DISC
      JMP CREA7     GO WRAP IT UP 
* 
ER14  LDA DISID     ERROR -14 TRAP.  IF THIS IS 
      SZA,RSS        MULTI-DISC SEARCH THEN 
      JMP NEXT        GO GET THE NEXT DISC. 
      JMP EX14         OTHERWISE, MUST RETURN ERROR.
* 
MAX   OCT 77776     MAX NUMBER OF SECTORS IN A FILE 
.127  DEC 127 
SFLAG NOP 
TPZER BSS 4 
      SKP 
*WE HAVE A REUSABLE ENTRY IN THE DIRECTORY AND WE NEED IT 
*SO THE DIRECTORY BLOCK IS READ BACK IN (IF REQURED) 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 SBUF      GET ADDRESS OF CURRENT BLOCK
      ADA R3         AND ADD IN THE OFFSET
      JSB SETAD     SET UP THE ADDRESSES
      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 IDNUM     SET POSSIBLE OPEN FLAG
      IOR SQCPU     ADD IN CPU AND SEQUENCE NUMBERS 
      STA FLAGA,I   IN THE ENTRY
      ISZ WCS       SET THE WRITE FLAG
      JMP OPEN4     AND GO EXIT (AFTER THE WRITE) 
* 
* 
* MOVE1/2     TO MOVE DIRECTORY ENTRIES TO/FROM 
*             THE LOCAL SAVE AREA DEFINED 
*             HEREIN. 
* 
*             CALLING SEQUENCE: 
* 
*             E=0   TO THIS SAVE AREA 
*             E=1   FROM THIS SAVE AREA 
* 
*             A = ADDRESS OF OTHER AREA 
* 
*             MOVE1   MOVES 9 WORDS 
*             MOVE2   MOVES 3 WORDS 
* 
MOVE1 NOP 
      LDB SIGN      SET B TO MOVE WORDS 
      JSB P.PAS     CALL TO MOVE
N9    DEC -9        9 WORDS 
NAME  BSS 9 
CSEC  EQU NAME+5
      JMP MOVE1,I   RETURN
      SPC 2 
MOVE2 NOP 
      LDB SIGN      SET B FOR MOVE
      JSB P.PAS     CALL TO MOVE
N3    DEC -3        3 
      BSS 3         WORDS 
      JMP MOVE2,I   RETURN
      SPC 2 
GTRK  NOP 
GLU   NOP 
GSEC  NOP 
G#SEC NOP 
      SKP 
GEN   JSB TESTL     TEST LEGALITY OF CALL 
      JSB SETDR     SET UP TO ACCESS THE DIRECTORY
      JSB RDPAS     READ THE PASSED DATA
GEN2  CLE           SET E FOR DPMM CALL 
      ISZ FIRST     FIRST SECTOR? 
      RSS           NO - SKIP 
      JSB DPMM      YES - GO EXTRACT DISC PRAMS 
      JSB UDAD      UPDATE DIRECTORY ACCESS 
      JMP CREX      END GO EXIT 
      JSB ADDR      SET UP TRACK AND SECTOR ADDRESS TO BE WRITTEN 
      ISZ WCS       SET WRITE FLAG
      JSB WCSR      WRITE THE SECTORS 
      LDA BUFA,I    IF A ZERO SECTOR
      SZA,RSS       THEN
      JMP GEN2      ALL THE REST MUST BE ZERO ALSO. 
* 
      JMP RDPA2     GO GET THE NEXT BLOCK 
      SPC 2 
TESTL NOP 
      LDB DIRAD     POSITION TO 
      ADB N4         LOCK WORD
      LDA B,I       GET THE LOCK
      ALF,ALF 
      AND B377
      LDB DISID     IF LOCKED 
      CPA IDNUM     TO CALLER 
      SZB,RSS       AND CORRECT DISC SPEC SKIP
      JMP EX102     ELSE TAKE ERROR EXIT
      JMP TESTL,I 
      SPC 5 
* 
* RDPAS     READ THE PASSED DATA
* 
RDPAS NOP 
      LDA ATMP3     RETRIEVE PASSED 
      LDB .2         STRING CONTAINING
      JSB RDSTR       DATA TRACK ADDRESS. 
      LDA TMP3      GET LU NUMBER,
      AND B77        ISOLATE IT,
      STA GLU         AND SAVE. 
      LDA TMP3+1    GET TRACK NUMBER
      STA GTRK       AND SAVE.
      LDA P4        GET THE #SECTORS/TRACK
      RAL,CLE,ERA   ELIMINATE THE SIGN
      STA G#SEC     AND SET 
      CLA           SET FOR SECTOR
      STA GSEC      ZERO
      LDA ABUF      SET CURRENT BUFFER POINTER TO BEGINNING 
      STA SBUF       OF BUFFER INTO WHICH DATA WAS READ 
RDPA2 JSB EXEC      READ THE SECTORS
      DEF GRTN
      DEF RDNAB 
      DEF GLU 
BUFA  DEF BUF 
      DEF .128
      DEF GTRK
      DEF GSEC
GRTN  JMP EX99
      CPB .128      DISC ERROR? 
      RSS           NO; CONTINUE
      JMP EX1       YES; TAKE DISC ERR EXIT 
      LDA GSEC      UPDATE THE
      ADA .2        DISC ADDRESS
      CPA G#SEC     END OF TRACK? 
      CLA           YES - USE 0 SECT. 
      STA GSEC      SET SECTOR
      CLE,SZA,RSS   IF EOT
      ISZ GTRK      STEP TRACK ADDRESS
      JMP RDPAS,I   RETURN
* 
ATMP3 DEF TMP3
      SPC 4 
* 
* 
*  RDSTR    RETRIEVES PASSED STRING 
* 
*           ENTRY:  A = ADDRESS OF BUFFER 
*                   B = LENGTH OF BUFFER
* 
*           EXIT :  A = 0  SUCCESSFUL 
*                   A = 1  NO STRING FOUND
* 
* 
RDSTR NOP 
      STA STBUF     STUFF BUFFER ADDRESS
      STB STLEN      AND LENGTH INTO EXEC CALL
      JSB EXEC
      DEF STRTN 
      DEF .14       CALL EXEC STRING PASSAGE
      DEF .1         TO RETRIEVE STRING 
STBUF NOP             SAVE IT IN USER 
      DEF STLEN         SUPPLIED BUFFER.
STRTN JMP RDSTR,I   RETURN
* 
STLEN NOP 
STRNG BSS 9 
A.STR DEF STRNG 
      SKP 
LOCK5 LDB P4        END OF DIRECTORY
      LDA P2        SEE IF GEN OR MOUNT CALL
      AND B77 
      CPA .13       MOUNT?
      JMP MOUNT     YES - GO DO IT. 
      CPA .7        GEN CALL AND
      SSB,RSS        SIGN BIT SET?
      JMP EX32      NOPE - NOT FOUND EXIT 
* 
      LDA .2        GET LOGICAL UNIT 2
      ADA PRC        + PRIVILEDGED BITS 
      STA LDRLU       FOR WCSR POST ROUTINE 
      LDA $CL1      GET CARTRIDGE DIRECTORY 
      STA LTRAC      TRACK AND SECTOR ADDRESS 
      LDA $CL2        FROM EXTERNALS FOR
      STA LSECT         WCSR POST ROUTINE 
      LDA N2        SET UP COUNT FOR
      STA COUN3      2 CARTRIDGE DIRECTORY BLOCKS 
      JSB RDPAS     READ A BLOCK OF THE DIRECTORY FROM STRING INTO BUF
      ISZ WCS       SET WRITTEN ON FLAG 
      ISZ COUN3     2ND BLOCK OF CARTRIDGE DIRECTORY
      RSS           NO - SO SKIP
      JMP EXIT3     YES - GO WRITE AND EXIT 
      JSB WCSR       AND GO POST BLOCK
      LDA LSECT     UPDATE SECTOR ADDRESS 
      ADA .2         OF CARTRIDGE DIRECTORY 
      STA LSECT       ON DISC.
      JMP RDPA2     GO GET 2ND BLOCK
      SPC 3 
MOUNT LDA ANAME     READ 9-WORD PASSED
      LDB .9         STRING INTO BUF AT 
      JSB RDSTR       SPCBF.
* 
      LDA P3        GET LU NUMBER 
      CMA,INA        MAKE IT NEGATIVE 
      STA ALU         AND SAVE IT FOR THE CL ENTRY
      LDA NAME+8    GET NEGATIVE # DIRECTORY TRACKS 
      CMA            MAKE POSITIVE AND SUBTRACT ONE 
      ADA NAME+7      AND ADD TO LAST FMP TRACK 
      STA ATRAK        SAVE FOR CL ENTRY
* 
      LDA P5        GET PARAMETER 5 AGAIN 
      ELA           SIGN BIT TO E-REG 
      SEZ           INITIALIZE THIS DISC? 
      JMP MT.1      YES 
      JSB CLOPF     NO - GO CLEAR OFF ANY OPEN FLAGS
      JMP MT.3       AND ADD ENTRY TO CL. 
* 
MT.1  LDA ABUF      MOVE 1ST 9 WORDS OF CARTRIGE SPECIF 
      STA SBUF      (SET UP CURRENT BLOCK ADDRESS)
      JSB MOVE1      INTO BUF   E IS ALREADY = 1
      CLA           ZERO OUT AT LEAST 135 WORDS 
      LDB .144       FOLLOWING THE 9 WORDS OF THE 
      CMB,INB         SPECIFICATION ENTRY IN BUF.  IT 
      STB COUN1        WILL BE USED TO CLEAR OUT THE
      LDB ABUF        REST OF THE FILE DIRECTORY BEHIND 
      ADB .9         THE SPECIFICATION ENTRY. 
      STA B,I 
      INB 
      ISZ COUN1 
      JMP *-3 
* 
      JSB SETDR     SET UP TO ACCESS BEGINNING OF FILE DIRECTORY
      CLE           CLEAR E FOR DPMM
      JSB DPMM      SAVE DISC PARAMETERS
MT.2  JSB UDAD      UPDATE FILE DIRECTORY ADDRESS OF DISC 
      JMP MT.3      END OF DIRECTORY SO GO UPDATE CL
      JSB ADDR      SET LAST READ ADDR AS CURRENT DISC ADDR 
      ISZ WCS       SET WRITTEN ON FLAG 
      JSB WCSR      AND GO WRITE THE BLOCK
      LDA SBUF,I    FROM 2ND TIME THRU FORWARD WANT TO
      SZA,RSS        USE AN ALL ZERO SECTOR SO STEP 
      JMP MT.2        CURRENT BUFER POINTER PAST 16-WORD
      LDA SBUF         SPECIFICATION ENTRY. 
      ADA .16 
      STA SBUF
      JMP MT.2
* 
MT.3  JSB RDPS      READ CARTRIDGE DIRECTORY
      LDB ABUF      START AT BEGINNING OF CL
MT.4  LDA B,I       GET 1ST WORD OF ENTRY 
      SZA,RSS       IS THIS THE 1ST EMPTY ENTRY?
      JMP MT.5      YES 
      ADB .4        NO - STEP TO NEXT ENTRY 
      JMP MT.4       AND CHECK IT 
* 
MT.5  LDA ABUF      MAKE SURE THAT B ISN'T
      ADA .251       POINTING TO STOP WORD, I.E.
      CPA B           THAT CL IS ALREADY FULL 
      JMP EX35
      STB DIRAD     THIS IS THE SPOT TO ADD THE ENTRY 
* 
      LDA ALU         SAVE FOR LATER
      STA DIRAD,I      AND STUFF IN 1ST WORD OF CL ENTRY
      ISZ DIRAD 
      LDA ATRAK      SAVE FOR LATER 
      STA DIRAD,I     AND STUFF IN 2ND WORD OF CL ENTRY 
      ISZ DIRAD 
      LDA NAME+3    GET CRN 
      STA DIRAD,I     AND STUFF IN 3RD WORD 
      ISZ DIRAD 
      LDA P5        GET ID FROM PARAMETER 5 
      RAL,CLE,ERA   CLEAR SIGN BIT
      STA DIRAD,I    AND PUT IT IN WORD 4 OF THE DIRECTORY
      JSB PSTCL      CL OUT TO LU2
      JMP EXIT4     RETURN WITH ERROR = 0 
* 
      SPC 4 
DISMT LDA DISID     A PARTICULAR DISC 
      SZA,RSS        MUST HAVE BEEN SPECIFIED 
      JMP EX101     ONE WASN'T  ERROR -101
* 
      JSB VALID     SEE IF DIRECTORY IS VALID 
      JMP DISM0     IT ISN'T SO SKIP OPEN FLAG CHECK
* 
      JSB OPNCK     ARE THERE ANY VALID OPEN FLAGS
      JMP EX8       YES - SO CAN'T DISMOUNT IT
* 
DISM0 JSB RDPS      RE-READ THE CARTRIDGE LIST
      LDA ABUF      REMOVE THIS ENTRY BY MOVING ALL 
      ADA .248       ENTRIES FOLLOWING IT UP ONE  (4 WORDS) 
      STA TMP3      TMP3 IS ADDRESS OF LAST POSSIBLE ENTRY
      LDB DIRAD      TO BE MOVED. 
      ADB N4        B CONTAINS LOCATION BEING MOVED TO
SHIFT LDA DIRAD,I   DIRAD CONTAINS LOCATION BEING MOVED FROM
      STA B,I       MOVE WORD UP 4
      CPB TMP3      IS THIS THE LAST ONE? 
      JMP DISM1     YES - SO GO POST REVISED CARTRIDGE DIRECTORY
      INB           STEP TO NEXT WORD 
      ISZ DIRAD      TO BE MOVED
      JMP SHIFT 
* 
DISM1 JSB PSTCL      THE CARTRIDGE DIRECTORY
      JMP EXIT4     NO - RETURN 
      SPC 5 
CHGCL LDA DISID     A PARTICULAR DISC 
      SZA,RSS        MUST HAVE BEEN SPECIFIED 
      JMP EX101     ONE WASN'T   ERROR -101 
* 
      LDA DIRAD     WANT NEW ENTRY
      ADA N4         PUT HERE IN CL 
      LDB .4        FOUR WORDS LONG 
      JSB RDSTR     GET STRING AND PUT IN CL ENTRY
      JSB PSTCL     WRITE CL BACK OUT TO DISC 
      JMP EXIT4      AND LEAVE. 
      SKP 
* 
* 
*     VALID  -  MAKES SURE CURRENT DISC HAS A VALID DIRECTORY 
* 
*               CALLING SEQUENCE: 
*               JSB VALID 
*               RETURN NOT VALID DIRECTORY
*               RETURN OK 
* 
*     CAUTION:  THIS SUBROUTINE ASSUMES THAT THE 1ST DIRECTORY
*     BLOCK IS READ INTO THE BEGINNING OF BUF BUFFER.  IT USES
*     BUF INSTEAD OF SBUF, THE ADDRESS OF THE CURRENT BLOCK IN
*     THE TRACK BUFFER.  THAT IS OK NOW, BUT IF ANYTHING IN THE 
*     SCHEME OF MANAGING THE TRACK BUFFER IS CHANGED, IT COULD
*     BE A PROBLEM. 
* 
* 
* 
VALID NOP 
      JSB SETDR     SET UP TO READ 1ST DIRECTORY BLOCK
      JSB RDNXB      AND READ IT
      LDA BUF       GET 1ST WORD
      SSA           SIGN BIT MUST BE SET.  IF NOT 
      JMP VALID,I    ILLEGAL DIRECTORY
* 
      LDA BUF+3     GET CRN 
      SSA           IF NEGATIVE 
      JMP VALID,I    THEN ILLEGAL DIRECTORY 
* 
      LDA BUF+8     NUMBER OF TRACKS IN DIRECTORY 
      CMA,INA        (MADE POSITIVE) PLUS LOWEST
      ADA BUF+7       DIRECTORY TRACK LESS
      ADA N1           ONE MUST BE SAME AS
      CPA TRACK         LAST TRACK
      RSS           OK
      JMP VALID,I   ITS NOT SO ILLEGAL DIRECTORY
* 
      LDA BUF+5     NEXT SECTOR CAN'T 
      CMA,INA        BE LARGER THAN NUMBER OF 
      ADA BUF+6       SECTORS PER TRACK 
      SSA,RSS 
      ISZ VALID     OK
      JMP VALID,I 
      SKP 
* 
* 
*     CLOPF     CLEAR ANY OPEN FLAGS FOUND IN THE FILE DIRECTORY
*               OF THE PENDING DISC.
* 
* 
*         ENTRY:  ATRAK - LAST TRACK
*                 ALU   - LU OF DISC
* 
* 
CLOPF NOP 
      JSB SETDR     SET UP TO READ BEGINNING OF FILE DIRECTORY
CL.1  JSB RDNXB     READ NEXT BLOCK 
      JMP CLOPF,I   END OF DIRECTORY SO LEAVE 
      LDA N8        EIGHT ENTRIES 
      STA COUN3      IN A BLOCK 
      LDA SBUF      START AT BEGINNING OF BLOCK 
CL.2  STA ASAVE     SAVE THIS ADDRESS 
      LDB A,I       GET 1ST WORD OF ENTRY 
      SSB           PURGED? 
      JMP CL.5      YES - IGNORE ENTRY
      SZB,RSS       END OF DIRECTORY? 
      JMP CLOPF,I   YES - SO LEAVE
      JSB SETAD     SET ADDRESSES FOR THIS ENTRY
      LDB FLAGA     USE ADDRESS OF OPEN FLAG
      STB PTR1       LIST AS POINTER
      LDB N7        SET FOR 7 OPEN
      STB COUN1      FLAGS PER ENTRY
CL.3  LDB PTR1,I    GET FLAG
      SZB,RSS       ZERO? 
      JMP CL.4      YES 
      CLB           NO - CLEAR
      STB PTR1,I     OPEN FLAG
      ISZ WCS       SET WRITTEN ON FLAG 
CL.4  ISZ PTR1      STEP TO NEXT ENTRY
      ISZ COUN1     DONE WITH THIS ENTRY? 
      JMP CL.3      NO - KEEP CHECKING
CL.5  LDA ASAVE     YES - STEP
      ADA .16        TO NEXT ENTRY
      ISZ COUN3     END OF BLOCK? 
      JMP CL.2
      JSB WCSR      YES - POST BLOCK IF ANY FLAGS WERE CLEARED
      JMP CL.1       AND GO TO NEXT BLOCK 
      SPC 4 
PACK  JSB TESTL     TEST LEGALITY OF CALL 
      JSB SETPR     SET UP THE DISC PARAMETERS
      LDA P4        GET RELATIVE DOUBLE SECT
      CMA,INA,SZA,RSS  SET NEGATIVE IF ZERO 
      JMP PACK2     SKIP
      STA COUN1     SET COUNT 
PACK1 JSB UDAD      BUMP ADDRESS
      JMP EX101     END OF DIRECTORY EXIT 
      ISZ COUN1     STEP COUNTER; DONE? 
      JMP PACK1     NO; GO BUMP AGIN
PACK2 LDA ABUF
      LDB .128
      JSB RDSTR 
      JSB ADDR      SET TRACK AND SECTOR ADDRESSES TO BE WRITTEN TO 
EXIT3 ISZ WCS       SET WRITE FLAG
EXIT4 CLA           AND TAKE
      JMP CREX      ACCEPT EXIT 
      SPC 2 66
ID    NOP 
IDNUM NOP 
TMP1  NOP           -\ THESE TWO WORDS MUST BE IN THIS ORDER -
TMP2  NOP           -/  SOMETIMES USED TO SAVE A DOUBLE WORD
DIRAD NOP 
TRACK NOP 
SECT  NOP 
WCS   NOP 
ALU   NOP 
DITR  NOP 
      SPC 4 
* 
* 
* PSTCL     POSTS 2 BLOCK CARTRIDGE LIST FROM BUF TO LU 2,
*           TRACK $CL1, SECTOR $CL2 
* 
* 
PSTCL NOP 
      LDA .2        GET LU 2
      ADA PRC        + PRIVILEDGED BITS 
      STA TMP1
      JSB EXEC
      DEF *+7 
      DEF WTNAB     WRITE 
      DEF TMP1      TO LU2
      DEF BUF       FROM BUF
      DEF .256      256 WORD CL 
      DEF $CL1      TO TRACK IN $CL1
      DEF $CL2      AND SECTOR IN $CL2
      JMP EX99
      CPB .256      CHECK TRANSMISSION LOG
      JMP PSTCL,I   OK - SO RETURN
      JMP EX1       DISC ERROR
* 
* 
*  ADDR     SET LAST LU,TRACK AND SECTOR READ PARAMETERS TO 
*           CURRENT TRACK AND SECTOR PARAMETERS 
* 
ADDR  NOP 
      LDA DRLU      GET CURRENT DIRECTORY LU
      ADA PRC       ADD IN PRIVILEDGED BITS 
      STA LDRLU 
      LDA TRACK 
      STA LTRAC 
      LDA SECT
      STA LSECT 
      JMP ADDR,I
      SKP 
RLOCK LDA DISID     DISC MUST BE SPECIFIED
      SZA,RSS 
      JMP EX101     NOT SPECIFIED - EXIT
      JSB OPNCK     ANY OPEN FLAGS ON THIS DISC?
      JMP EX8       YES; REJECT LOCK
      JSB RDPS      LOCK GRANTABLE   READ CARTRIDGE DIRECTORY 
      LDA IDNUM     GET OFFSET IN KEYWORD TABLE OF CALLER'S 
      ALF,ALF        ID SEG ADDRESS AND SHIFT TO HIGH BYTE
      STA TMP1      KEEP TEMPORARILY
      LDB N4        SET B-REG TO ADDRESS OF CORRECT 
      ADB DIRAD      ENTRY'S LOCK AND LU WORD 
      LDA B,I       GET LU WORD AGAIN 
      AND B377      MASK TO JUST LU  (IN CASE PROG ALREADY HAS IT LOCKED) 
      ADA TMP1      ADD LU TO LOCK
ROCK5 STA B,I        AND SET IN CL
      JSB PSTCL      CARTRIDGE DIRECTORY
      CLA 
      JMP CREX
      SPC 5 
ULOCK LDA B377      UNLOCK - CLEAR
      LDB N4        CALCULATE LOCK AND LU WORD ADDRESS
      ADB DIRAD      OF APPROPRIATE CL ENTRY
      AND B,I       CLEAR UPPER BYTE  (LOCK WORD) 
      JMP ROCK5     GO SET IT.
      SPC 2 
EX101 LDA N102
      INA,RSS 
EX102 LDA N102
      JMP CREX
      SPC 2 
N102  DEC -102
.16   DEC 16
B377  OCT 377 
N7    DEC -7
.251  DEC 251 
.248  DEC 248 
      SKP 
CNAM  LDA A.STR    CHANGE NAM - READ NEW NAME 
      LDB .3        FETCH PASSED STRING WITH
      JSB RDSTR     NEW NAME AND PUT IN ARRAY NAME
      LDA A.STR     MOVE STRING INTO NAME BUFFER
      CLE           THIS IS DNE IN CASE THERE IS A MULTI-DISC 
      JSB MOVE1     SEARCH (STRING'S NOT AROUND 2ND TIME) 
      CLE           SAVE SECOND 
      LDA ANAME      COPY OF
      JSB MOVE2       6-CHAR NAME 
      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 
      AND B377      MASK TO ID SEG OFFSET 
      CPA IDNUM     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
      SPC 2 
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 
* 
* 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 
      CLB           GET THE PASSED
      LDA P3         SECTOR 
      RRL 3         OFFSET TO B-REG 
      BLF            MPY BY 16
      STB TMP3        AND SAVE IN TMP3
      AND MASK1     MASK TO SECTOR NUMBER 
      ALF,ALF        POSITION TO
      RAR             BITS 0-6
      STA SECT         AND SAVE.
      JSB RWSUB     READ THE BLOCK
      ADA TMP3
      JSB SETAD 
      LDA DIRA      MOVE THE ENTRY TO LOCAL 
      JSB MOVE1     STORAGE 
      JMP DIRCK,I 
      SKP 
      SPC 5 
CLOSE JSB DIRCK     CLOSE; GET THE SECTOR 
      LDB N7        SET FOR 7 ENTRIES 
CLOS1 LDA FLAGA,I   FIND
      RAL,CLE,ERA   CALLERS 
      AND B377      FLAG
      CPA IDNUM 
      JMP CLOS2     FOUND 
      ISZ FLAGA     NOT; YET TRY NEXT ONE 
      INB,SZB       MORE? 
      JMP CLOS1     YES; OK 
      JMP EX11      NO; ERR - NOT OPEN TO CALLER
      SPC 2 
CLOS2 CLA           FOUND; CLEAR THE
      STA FLAGA,I    OPEN FLAG
      ISZ WCS       SET WRITTEN ON FLAG 
      SEZ,RSS       EXCLUSIVE OPEN? 
      JMP EXIT3     NO; EXIT
      LDA ATMP3     GET TRUNCATE CODE 
      LDB .2         FROM 2-WORD
      JSB RDSTR       PASSED STRING 
      CPA .1        WAS THERE A STRING? 
      JMP EXIT3     NO - WE'ER DONE 
      DLD TMP3      LOAD DOUBLE WORD TRUNCATE CODE
      SZA,RSS       IF TRUNCATE 
      SZB            CODE IS
      RSS             ZERO THEN 
      JMP EXIT3        EXIT - NO ACTION 
      SSA,RSS       IF POSITIVE THEN
      JMP EXPUR      GO PURGE EXTENTS 
      CLB 
      LDA #SEC,I    GET CURRENT FILE SIZE 
      SSA,RSS       IF POSITIVE, ALREADY IN SECTORS 
      JMP CL.21      SO SKIP
      CMA,INA       MAKE POSITIVE 
      LSL 8          AND MULTIPLY BY "128 QUANTITY" 
CL.21 SWP           GET HIGH ORDER BITS TO A-REG
      JSB .DAD      ADD CURRENT FILE SIZE 
      DEF TMP3       TO TRUNCATE CODE 
      SLB,RSS       IGNORE IF ODD SECTOR COUNT
      SSA           IF RESULT IS LESS THAN ZERO 
      JMP EXIT3      THEN IGNORE IT 
      CCE,SZA,RSS   IF ZERO 
      SZB            THEN GO
      RSS             PURGE 
      JMP PURGE        FILE 
      SWP           GET HIGH ORDER BITS TO B-REG
      SZB,RSS       <=32767?
      SSA           MUST CHECK B AND
      RSS            SIGN BIT ON A
      JMP CL.22     YES - SO SET SIZE IN + SECTORS
      DIV .256      NO - MUST USE "128 QUANTITY". 
      SZB            DIVIDE BY 128 AND
      INA             ADD 1 IF ANY SECTORS
      CMA,INA          LEFT OVER. 
CL.22 STA TMP2      SAVE FILE SIZE IN +SECTORS OR -TRACKS 
      JSB LAST?     LAST FILE?
      CLE,RSS       NO
      CCE           YES 
      LDA TMP2      NOW SET FILE SIZE IN ENTRY
      STA #SEC,I
      SEZ,RSS 
      JMP EXPUR     GO PURGE ANY EXTENTS
      JMP PURG8   - GO UPDATE DISC PARAMETERS 
      SKP 
* 
* 
*   NXT/S     CALCULATES NEXT TRACK AND SECTOR ADDRESS FROM CURRENT 
*             TRACK AND SECTOR AND SIZE 
* 
*             RETURN  P+1   NEXT TRACK > 32767
*                     P+2   OK
*                           A = NEXT TRACK
*                           B = NEXT SECTOR 
* 
* 
NXT/S NOP           CACULATE THE NEXT TRACK AND SECTOR
      CLB 
      LDA SECTA,I   GET THE STARTING SECTOR 
      AND B377       AND ISOLATE IT 
      SWP           GET HIGH ORDER BITS TO A-REG
      DST TMP3      SAVE AS A DOUBLE WORD (B=0) 
      CLB 
      LDA #SEC,I    GET FILE SIZE 
      SSA,RSS       IN + SECTORS OR IN -128 BLOCK CHUNKS
      JMP NXT.1     SECTORS OR IN -128 BLOCK CHUNKS 
      CMA,INA       -TRACKS - MAKE POSITIVE 
      MPY .256       AND MPY BY "128 QUANTITY"
NXT.1 SWP           GET HIGH ORDER BITS TO A-REG
      JSB .DAD      SUM NUMBER SECTORS IN FILE
      DEF TMP3       AND STARTING SECTOR
      SWP           GET HIGH ORDER BITS TO B-REG
      DIV #SECT     DIVIDE BY THE NO OF SECTORS PER TRACK 
      SOC           DID WE OVERFLOW ONE WORD FOR TRACK? 
      JMP NXT.2     YES - SET TO RETURN P+1 
      ADA TRAKA,I   ADD TRACK OVERFLOW TO CURRENT TRACK ADDRESS 
      SSA,RSS       IS TRACK >32767?? 
      ISZ NXT/S     NO - RETURN P+2 
NXT.2 JMP NXT/S,I   RETURN WITH A = NEXT TRACK AND B = NEXT SECTOR
      SPC 5 
OPNCK NOP 
      CLA 
      STA OPFLG 
      JSB SETDR     SET TO BEGINNING OF FILE DIRECTORY
OPN.1 JSB RDNXB     READ NEXT DIRECTORY BLOCK 
      JMP OPN.4     END OF DIRECTORY - GRANT LOCK 
      LDA N8        SET COUNTER FOR 8 ENTRIES PER BLOCK 
      STA COUN3 
      LDA SBUF      GET STARTING ADDRESS OF BLOCK 
OPN.2 LDB A,I       GET FIRST WORD OF ENTRY 
      SSB           PURGED? 
      JMP OPN.3     YES - IGNORE THIS ENTRY 
      SZB,RSS       END OF DIRECTORY? 
      JMP OPN.4     YES - GRANT LOCK
      JSB SETAD     NO - SET ENTRY ADDRESSES
      JSB FLAG      TEST FOR OPEN FLAGS 
      LDB COUN2     ANY OPEN FLAGS
      SZB            IN THIS ENTRY? 
      ISZ OPFLG     YES - SET FLAG
      LDA DIRA      NO - GET ADDRESS IN A-REG 
OPN.3 ADA .16       STEP TO NEXT ENTRY
      ISZ COUN3     END OF BLOCK? 
      JMP OPN.2     NO - GO DO NEXT ENTRY 
      JMP OPN.1     YES - TRY NEXT BLOCK
OPN.4 LDA OPFLG     WERE THERE ANY
      SZA,RSS        VALID OPEN FLAGS?
      ISZ OPNCK     NO - STEP RETURN ADDRESS TO P+2 
      JMP OPNCK,I   RETURN
* 
OPFLG NOP 
      SKP 
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 SHEARCH 
      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       YES SO TRY AGAIN
      JMP B,I       RETURN
* 
      STA R1        AFTER WE CLEAR THE FOUND FLAG 
      JMP CSER      CONTINUE THE SEARCH 
      SPC 2 
* 
*   LAST?   CHECKS TO SEE IF CURRENT FILE IS LAST ONE IN DL 
* 
*           EXIT   P+1 - NOT THE LAST FILE
*                  P+2 - IS THE LAST FILE 
* 
* 
LAST? NOP 
      JSB NXT/S     COMPUTE THE NEXT TRACK AND SECTOR 
      NOP           CAN'T GET OVERFLOW CONDITION ON THIS CALL TO NXT/S
      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 
      JSB FORWD     COULD BE  POSITION TO NEXT ENTRY
      JMP LAS.1     END OF DIRECTORY - HAS TO BE LAST FILE
      LDB DIRA,I    GET 1ST WORD OF NEXT ENTRY
      SZB,RSS       ZERO? 
      ISZ LAST?     YES - THAT WAS THE LAST FILE
      JSB BACK      NOW GET BACK TO WHERE WE WERE 
      JMP LAS.2     EXIT P+2
LAS.1 LDA #SECT     HAVE TO RESET SECT PARAMETER TO WHAT IT WAS 
      ADA N14        BEFORE NXT\S CALL.  UDAD HAS SECT=0. IT SHOULD 
      STA SECT        POINT TO THE LAST BLOCK OF THE DIRECTORY NOW. 
      ISZ LAST?     THIS IS THE LAST ENTRY
LAS.2 JMP LAST?,I   RETURN
      SPC 3 
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 
.6    DEC 6 
      SKP 
PURGE CCA 
      STA DIRA,I    SET PURGE FLAG
      ISZ WCS       SET WRITTEN-ON FLAG 
      LDB TYPE,I    IF TYPE 6 FILE                  780106  GLM 
      CPB .6        THEN TREAT                     "           "
      RSS           AS NOT LAST                    "           "
      JSB LAST?     LAST FILE?
      JMP EXPUR     NO; GO CHECK FOR EXTENTS
      CLA           YES - STUFF A 0 IN 1ST WORD 
* 
PURG2 STA DIRA,I    LAST FILE  SET 0 IN ENTRY 
      ISZ WCS       SET WRITTEN-ON FLAG 
      JSB BACK      BACK UP ONE ENTRY
      LDB TYPE,I    GET TYPE
      LDA DIRA,I    GET 1ST WORD OF ENTRY 
      CLE 
      CPB .6        IS THIS A TYPE SIX FILE 
      CCE           YES - DON'T WANT TO REUSE THE SPACE 
      SEZ,INA,SZA,RSS   PURGED? 
      JMP PURG2     YES; TRY PREVIOUS ENTRY 
* 
PURG0 SZB           TYPE 0? 
      JMP PURG1     NO - GO AHEAD AND CALCULATE NEXT TR AND SEC 
      JSB BACK      SET POINTERS BACK 1 MORE FOR NXT/S ROUTINE
      LDB TYPE,I    GET TYPE AGAIN
      JMP PURG0      AND SEE IF HAVE ANOTHER TYPE 0 FILE
* 
PURG1 LDA DIRA,I    GET 1ST WORD OF ENTRY 
      INA           INCREMENT TO TAKE CARE OF PURGES ENTRY CASE 
      SSA           IS THIS THE 
      JMP PURG3     DISC SPEC ENTRY? - YES JUMP 
PURG8 JSB NXT/S     NO; CACULATE THE NEXT TRACK AND SECT
      NOP           CAN'T GET OVERFLOW CONDITION ON THIS CALL TO NXT/S
      JMP CREA6     GO SET, WRITE & EXIT
* 
PURG3 LDA TRAKA,I  SET NEXT TRACK AND SECTOR
      CLB           TO ZERO.
      JMP CREA6     GO SET, WRITE AND EXIT
* 
EXPUR JSB EXSH      SEARCH FOR EXTENTS TO PURGE 
      JMP PURGE     GO PURGE EXTENT 
* 
* 
*  BACK    BACKS UP TO PREVIOUS ENTRY AND SETS UP ADDRESSES 
* 
*  ENTRY   DIRA = ADDRESS OF CURRENT ENTRY
*          CURRENT ENTRY CHANGES TO PREVIOUS ENTRY
* 
BACK  NOP 
      LDA DIRA      GET ADDRESS OF ENTRY
      CPA SBUF      BEGINNING OF BLOCK? 
      RSS           YES - MUST READ PREVIOUS BLOCK
      JMP BACK1     NO - JUST BACK UP 16 WORDS
      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 #SECT     ADD THE NO. PER TRACK 
      STB SECT      SET NEW SECTOR ADDRESS
      JSB RWSUB     READ THE BLOCK
      ADA .128      SET ADDRESS FOR LAST ENTRY
BACK1 ADA N16       POSITION TO BEGINNING OF ENTRY
      JSB SETAD     SET UP ADDRESSES
      JMP BACK,I     AND RETURN 
      SPC 3 
* 
* 
*   FORWD      FORWARD SPACES TO NEXT DIRECTORY ENTRY 
* 
*              ENTRY - DIRA = ADDRESS OF CURRENT DIRECTORY ENTRY
*                      CHANGES TO NEXT DIRECTORY ENTRY
*              EXIT  - P+1 END OF DIRECTORY RETURN
*                      P+2 OK RETURN
* 
* 
FORWD NOP 
      LDA DIRA      GET ADDRESS OF CURRENTY ENTRY 
      ADA .16       POSITION TO NEXT ENTRY
      LDB SBUF      GET ADDRESS OF START OF BLOCK 
      ADB .128      IF CURRENT ENTRY IS LAST IN A BLOCK MUST READ NEXT BLOCK
      CPB A         IS IT?
      RSS           YES - READ NEXT BLOCK 
      JMP FOR.1     NO - JUST SET ADDRESSES AND RETURN
      JSB RDNXB     READ NEXT BLOCK 
      JMP FORWD,I   WHOOPS RAN OUT OF DIRECTORY  EXIT P+1 
FOR.1 JSB SETAD     SET UP ADDRESSES
      ISZ FORWD      INCREMENT TO P+2 
      JMP FORWD,I     AND RETURN
* 
      SKP 
* 
* 
* P.PAS     EXTERNAL
*           CALLING SEQUENCE
* 
*           E_0 FOR SETUP 
*           E_1 TO MOVE OUT 
* 
*           B_0 TO SET ADDRESS
*           B_100000 TO SET PARAMETERS
* 
*           A = ADDRESS OF FROM-TO AREA 
* 
*           JSB P.PAS 
*           DEC -N       NO. OF PARAMETERS TO BE MOVED
*           BSS N        AREA SET UP OR MOVED OUT 
      SPC 2 
.1    DEC 1 
A     EQU 0 
B     EQU 1 
.     EQU 1650B 
DRT   EQU .+2 
KEYWD EQU .+7 
TATSD EQU .+70
XEQT  EQU .+39
LN    EQU * 
      END BEGIX 
                                                                                                                                                                                                