ASMB,R,L,C,Q
      HED RTE FILE MANAGER DIRECTORY ROUTINE **************** 
*     NAME:   D.RTR 
*     SOURCE: 92002-18007 
*     RELOC:  92002-16007 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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,2,1 92002-16007 REV.1926 790502 
      EXT EXEC,PRTN,$OPSY,P.PAS 
      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 TO MAKE ALL I\O REQUESTS    APR/78**GLM 
*                     WITH "NO-ABORT" 
*            MODIFIED TO PREVENT CREATION OF      APR/78**GLM 
*                     ZERO LENGTH FILES 
*            MODIFIED TO PREVENT THE REUSE OF     NOV/78**GLM 
*                     TYPE ZERO DIRECTORY ENTRIES 
*            MODIFIED TO CORRECTLY CREAT FILES    MAY/79**GLM 
*                     ON MULTI-DISC SEARCHES. 
* 
* 
* THIS PROGRAM IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT
* SYSTEM. IT OWNS THE DIRECTORY AND PERFORMS ALL WRITES 
* ON IT.
* 
* PROGRAM WISHING TO ACCESS THE DIRECTORY 
* SCHEDULE (WITH WAIT) THIS PROGRAM.
* 
* CALLS ARE AS FOLLOWS (P1,P2,P3,P4,P5 ARE THE PASSED PARAMETERS):
* 
* 
* 1. OPEN 
*     P1. 1,ID      CALLER'S ID SEGMENT ADDRESS WITH SIGN BIT SET 
*     P2. E,NAME(1,2) E(BIT 15) INDICATES EXCLUSIVE OPEN IF SET 
*     P3. 0,NAME(3,4) 
*     P4. 0,NAME(5,6) 
*     P5. -LU,+CARTRIDGE LABEL,0   IF ZERO SEARCH ALL MOUNTED CARTRIDGES
* 
* 2. CLOSE
*     P1. ID        CALLER'S ID SEGMENT ADDRESS 
*     P2. 0,-(NO. SECTORS TO BE DELETED),+ PURGE EXTENTS ONLY 
*     P3. TR,LU 
*     P4. OFFSET,SECTOR  / DIRECTORY ADDRESS
*     P5. 0         INDICATES CLOSE 
* 
* 3. CREAT
*     P1. ID
*     P2. TR,LU     DATA TRACK ADDRESS
*     P3. -LU,+CARTRIDGE,0    SEE 1.P5. 
*     P4. 
*     P5. 1         INDICATES CREAT 
* 
* 4. CHANGE NAME
*     P1. ID
*     P2. TR,LU     DATA TRACK ADDRESS
*     P3. TR,LU         \ 
*     P4. OFFSET,SECTOR \ DIRECTORY ADDRESS OF FILE BEING RENAMED 
*     P5. 2         INDICATES NAME CHANGE CALL
* 
* 6. SET,CLEAR LOCK ON DISC 
*     P1. ID
*     P2. 
*     P3. -LU,+CARTRIDGE  (0 NOT LEGAL)  DISC TO BE LOCKED
*     P4. 
*     P5. 3 FOR SET  5 FOR CLEAR
* 
* 7. GENERATE,PACK,UPDATE CALL
*     P1. ID
*     P2. TR,LU     DATA TRACK ADDRESS
*     P3. -LU,+CARTRIDGE  (0 NOT LEGAL)  DISC TO BE UPDATED 
*     P4. S,#SEC/TRACK   S(BIT 15)=1 IF DISC DIRECTORY UPDATE 
*     P5. 7         INDICATES GENERATE CALL.
* 
* 8. EXTENSION OPEN 
*     P1. ID
*     P2. EXTENSION NUMBER
*     P3. TR,LU        \
*     P4. OFFSET,SECTOR \DIRECTORY ADDRESS OF MASTER ENTRY
*     P5. 6,8       INDICATES EXTENSION REQUEST (READ,WRITE)
* 
* 9. PACK 
*     P1. ID
*     P2. TR,LU     DATA TRACK ADDRESS
*     P3. -LU,+CARTRIDGE    SEE GENERATE
*     P4. RELATIVE DIRECTORY SECTOR (1 ONLY) TO BE CHANGED
*     P5. 9 
      SKP 
* DATA TRACK FORMAT FOR CREAT AND CHANGE NAME 
*     1. NAME(1,2) \
*     2. NAME(3,4)  > OR NEW NAME 
*     3. NAME(5,6) /
*     4. TYPE 
*     5.
*     6.
*     7. #SECTORS REQUESTED OR -1 FOR REST OF DISC
*     8. RECORD SIZE (TYPE 2 FILES) 
*     9. SECURITY CODE
* 
* 
* WORD FORMATS FOR DOUBLE DUTY WORDS
* 
*  15...6 5..0       15...8 7...0 
*  TRACK ^ LU        OFFSET^SECTOR
*                   #SEC/TR^SECTOR
* 
* RETURN PARAMETERS 
*     R1. ERROR CODE    IF >0 THEN #SEC IN FILE  (0=> TYPE 0) 
*     R2. TR,LU        \
*     R3. OFFSET,SECTOR \ DIRECTORY ADDRESS - OPEN & CREATE CALLS 
*     R4. TR(LU IF TYPE 0)/ FILE ADDRESS ON OPEN & CREATE CALLS 
*     R5. #SEC/TR,SECTOR /
* 
*     IF R1=-99 (EXEC REJECTED I\O REQUEST) R2 & R3 = ERROR CODE
*     RETURNED BY EXEC
* 
* 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              CARTRIDGE NOT FOUND
*    -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 
*    -99             EXEC REJECTED AN I\O REQUEST               *780413)
* 
*    -101            ILLEGAL PARAMETERS IN CALL 
*    -102            ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) 
      SKP 
BUF   BSS 128 
CNT   NOP 
DEST  NOP 
PRAMA DEF P1
N5    DEC -5
.20   DEC 20
P1    NOP 
P2    NOP 
P3    NOP 
P4    NOP 
P5    NOP 
      SPC 2 
BEGIN LDA PRAMA     PARAMETER DESTINATION ADDR
      STA DEST      SAVE IT 
      LDA N5        PARAMETER COUNT 
      STA CNT 
      LDA $OPSY      FETCH SYSTEM IDENTIFIER
      ERA           MOVE "MAPPED" BIT TO SLA
      STA STYPE     SAVE FOR LOADA ROUTINE
LOOP  JSB LOADA     GET NEXT PARAMETER
      STA DEST,I    SAVE IN P1 TO P5
      ISZ DEST      BUMP DESTINATION ADDR 
      INB           BUMP TO NEXT PARAMETER
      ISZ CNT       BUMP PARAMETER COUNT
      JMP LOOP
      SPC 1 
      LDA P1        GET THE FIRST PRAM
      RAL,CLE,ERA   LIST; CLEAR POSSIBLE SIGN BIT 
      STA ID        SAVE ID SEG ADDRESS PASSED IN CALL
* 
      LDB XEQT      GET ID ADDRESS
      ADB .20       ADVANCE TO FATHER INFO
      JSB LOADA          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
      CCB            B=-1 
      ADB A         COUNT FROM 0(USE B FOR LOADA ROUTINE) 
      ADB KEYWD     ADD TO TABLE OF ID SEGS 
      JSB LOADA     FETCH ID SEG ADDR OF CALLER 
      CPA ID        MUST MATCH VALUE PASSED IN P1 
      CLB,RSS       OK
      JMP EXIT2     --NOPE --ERROR (BAD CALL) 
* 
      STB FIRST     CLEAR THE FIRST FLAG
      STB TMP1
      LDA ABUF      SET LOCK SEARCH FOR FIRST 
      STA DIRAD     ENTRY 
      SKP 
*     THE LOCK ROUTINE SEARCHES THE DISC DIRECTORY FOR THE
*     REFERENCED DISC.
* 
*     FOR THE FIRST CALL DIRAD SHOULD POINT AT THE
*     FIRST WORD IN ABUF.  SUBSEQUENTLY LOCK
*     WILL UPDATE DIRAD EACH CALL.
* 
*     WITH THE EXCEPTION OF THE DISC DIRECTORY UPDATE THE DISC
*     MUST BE FOUND.  IN THIS CASE, EXIT IS TO THE CREAT ROUTINE
* 
*     ON EXIT ATRAK CONTAINS THE DIRECTORY TRACK
*              ALU     CONTAINS THE DIRECTORY LU
*              A       CONTAINS THE LOCK WORD 
* 
*     ON SUBSEQUENT CALLS IF THE DISC ID WAS 0, THE NEXT
*     DISC IS RETURNED.  IF THE DISC ID WAS NOT 0,
*     A NOT FOUND EXIT IS TAKEN.
* 
NEXT  LDA P5        GET THE ID -BIT 15 INDICATE DISC
      LDB P1        ID IN P5
      SSB           ID IN P5? 
      JMP LOCK0     YES; SKIP 
      CCE,SLA,RSS   NO; P5 IS FUNCTION EVEN?
      JMP LOCK3     YES; GO EXTRACT LU
      LDA P3        NO; LU IS IN P3 
LOCK0 CMA,CCE,SSA,INA E_0 INDICATES CARTRIDGE LABEL 
      CMA,CLE,INA     E_1 INDICATES LU(SET +) 
      LDB TMP1      GET PREVIOUS ID 
      STA TMP1      STORE ID
      CME,SZB       IF NOT A  ZERO, ID ON SECOND
      JMP EX6       CALL TAKE -6 EXIT 
      SPC 1 
      RAL,ERA       SET SIGN BIT IF A LABEL SEARCH
      STA TMP2      AND SET FOR COMPARE 
      SPC 1 
LOCK6 JSB RDPS      READ THE PARAMETER SECTOR 
      LDA TMP2      SET THE FOUND BIT IN E IF 
      CMA,CLE,INA   A ZERO ID 
      LDB DIRAD     GET CURRENT DIRECTORY ADD.
LOCK2 LDA B,I       GET FIRST WORD
      SZA,RSS       IF 0 THEN END 
      JMP LOCK5     SO GO CHECK FOR  DIRECTORY
      STA ALU       UPDATE; ELSE SAVE LU
      CPA TMP2      IS THIS THE REQUIRED DISC?
      CCE           YES  SET E TO 1 TO INDICATE FOUND 
      INB           STEP TO TRACK ADDRESS AND 
      LDA B,I       SET 
      STA ATRAK     IN ATRAK
      INB           STEP TO 
      LDA B,I       LABEL AND FETCH 
      IOR SIGN      SET SIGN FOR COMPARE
      SEZ,INB,RSS   STEP TO LOCK ADDRESS SKIP IF FOUND
      CPA TMP2      IS THIS THE REQUESTED DISC? 
      JMP LOCK4     YES; GO EXIT
      INB           NO; STEP TO NEXT ONE
      JMP LOCK2     AND GO CHECK IT 
* 
LOCK3 LDA P3        LU AND TRACK IN P3
      AND B77       MASK TO LU
      STA TMP2      SAVE LU 
      STA TMP1      *790501*
      STA B         SAVE LU IN B FOR TEST 
      XOR P3        MASK TO TRACK 
      ALF,RAL       ROTATE TO 
      RAL,ALF       LOW A AND 
      STA DITR      SAVE THE TRACK
      CPB RDPS      DO WE HAVE THIS ONE ALREADY?
      JMP DECOD     YES  SO GO DECODE THE REQUEST 
      JMP LOCK6     NO  SO GO LOOK FOR IT 
* 
LOCK4 STB DIRAD     FOUND - UPDATE CURRENT
      ISZ DIRAD     ADDRESS FOR NEXT TIME 
      LDA B,I       LOCK TO A 
      SZA           IF NOT LOCKED 
      CPA ID        OR LOCKED TO CALLER 
      JMP DECOD     SKIP
      LDA TMP1      ELSE IF F#
      SZA,RSS       MULTI-DISC SEARCH 
      JMP NEXT      CONTINUE
      JMP EX13      ELSE EXIT LOCKED DISC 
      SPC 2 
DECOD CCA           SET THE NONE FOUND YET
      STA R1        FOR REUSABLE DISC SPACE ROUTINE 
      LDA P1        IF OPEN 
      SSA           REQUEST 
      JMP OPEN      GO OPEN 
      LDA P5        ELSE
      SSA           CHECK REQUEST CODE
      JMP EX101     NEGATIVE - EXIT 
      ADA N10 
      SSA,RSS 
      JMP EX101     GREATER THAN 9 - EXIT 
      ADA TABAD     INDEX INTO THE FUNCTION 
      JMP A,I       GO EXECUTE THE FUNCTION 
      SPC 2 
TABAD DEF TABA+10 
TABA  JMP CLOSE     0 
      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 
      SKP 
* 
*  RDPS     READ THE DISC DIRECTORY 
* 
RDPS  OCT -1
      JSB WCSR      WRITE CURRENT SECTOR BLOCK
      LDA .2        A_2                             *780413*
      STA DRLU      SET  FOR LU2 - SYS DISC 
      CCA           COMPUTE LAST TRACK
      ADA TATSD     ADDRESS AND 
      STA TRACK     SET 
      CLA           SET SECT ADDRESS TO 
      STA SECT      ZERO
      JSB RWSUB     READ THE BLOCK
      JMP RDPS,I    RETURN
      SPC 5 
* 
*  WCSR     WRITE CURRENT BLOCK 
* 
WCSR  NOP 
      LDA WCS       GET WRITE FLAG
      ISZ RW        SET REQUEST CODE TO WRITE 
      SZA           IF NOT WRITTEN ON SKIP
      JSB RWSUB     ELSE WRITE THE BLOCK
      LDA DS1       RESET REQUEST CODE TO           *780413*
      STA RW        READ (NO-ABORT) 
      JMP WCSR,I    AND EXIT (A=1)
      SPC 2 
DS1   OCT 100001
RW    NOP 
DRLU  NOP 
      SKP 
* 
*  RWSUB     ROUTINE TO READ OR WRITE A TWO-SECTOR BLOCK
* 
RWSUB NOP 
      DLD RW        FETCH THE NEW POINTERS
      ADB PRC 
      STB RPRM
      SLA,RSS       IF WRITE THEN 
      JMP RWSU1     GO DO IT
      CPB LDRLU     ELSE IF 
      LDB N7        SAME BLOCK AS 
      LDA TRACK     CURRENT ONE 
      CPA LTRAC     THEN
      INB 
      LDA SECT      NO
      CPA LSECT     ACTION IS 
      CLE,INB 
      CPB N5        REQUIRED SO 
      JMP RWSUB,I   RETURN
RWSU1 JSB EXEC      NOT SAME BLOCK  CALL EXEC 
      DEF RTN       RETURN
      DEF RW        READ WRITE CODE 
      DEF RPRM      LU
ABUF  DEF BUF       BUFFER
      DEF .128      128 WORDS 
      DEF TRACK     ON TRACK &
      DEF SECT      SECTOR
RTN   JMP ERR99     EXEC REJECTED CALL -- EXIT      *780413*
      CLA,CLE       CLEAR THE WRITE 
      STA WCS       FLAG
      LDA RPRM      SET UP LAST POINTERS FOR NEXT TIME
      STA LDRLU 
      LDA TRACK     SAVE THE TRACK
      STA LTRAC     ADDRESS AND THE 
      LDA SECT      SECTOR
      STA LTRAC+1   ADDRESS 
      CPB .128      DISC ERR? 
      JMP RWSUB,I   NO - RETURN 
      STA LDRLU     YES; SET NOT IN CORE FLAG 
      JMP EX1       YES - TAKE DISC ERR EXIT
      SPC 2 
LDRLU NOP 
LTRAC NOP 
LSECT NOP 
      SKP 
OPEN  DLD P3        SET NAME WORDS 2 AND  3 
      DST NAME+1    INTO THE NAME BUFFER
      LDA P2        SET NAME WORD1
      RAL,CLE,ERA   LESS POSSIBLE SIGN BIT
      STA NAME      INTO THE NAME BUFFER
      JSB SETDR     SET UP TO READ THE DIRECTORY
      JSB N.SHR     GO FIND THE FILE
      JMP NEXT      NOT FOUND - TRY NEXT DISC 
      JSB SETAD     FOUND - GO SET THE ADDRESSES
      JSB FLAG      CHECK THE OPEN FLAGS
      LDB COUN2     IF 7 OPENS
      CPB .7        THEN NO ROOM SO 
      JMP EX8       EXIT
      LDA P2        IF EXCLUSIVE OPEN 
      CLE,SSA,RSS   THEN SKIP 
      JMP OPEN3     NON EXCLUSIVE  SKIP 
      CCE,SZB       IF ANY OPENS THEN 
      JMP EX8       REJECT EXCLUSIVE OPEN 
OPEN3 LDB SC        GET THE FLAG ADDRESS LESS ONE 
OPEN5 INB           SEARCH FOR OPEN SPOT IN FLAG LIST 
      LDA B,I       GET FLAG WORD 
      SSA           IF SIGN BIT SET THEN
      JMP EX8       FILE IS EXCLUSIVELY OPEN TO SOME ONE
      SZA           THIS WORD?
      JMP OPEN5     NO; GO TRY NEXT ONE 
      LDA P1        YES; GET THE ID ADDRESS 
      RAL,ERA       SET THE EXCLUSIVE/NON-EXCLUSIVE 
      STA B,I       FLAG AND PUT IN THE DIRECTORY 
      STA WCS       SET TO WRITE THE BLOCK
OPEN4 LDA TYPE,I   SET UP THE RETURN PARAMETERS 
      SZA           IF TYPE ZERO SEND BACK ZERO CODE
OPEN6 LDA #SEC,I    ELSE SEND BACK THE FILE SIZE
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 ID        OPEN FLAG WORD
      LDA P2        SET THE 
      SZA,RSS       IF AFTER THE MAIN THEN
      JMP OPEN4     WE HAVE IT ALREADY
* 
      AND B377      CHECK IF EXTENT>255?
      CPA P2        YES ? NO? 
      ALF,SLA,ALF   NO  EXTENSION NO. FOR POSSIBLE
      JMP EX6       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 P2        THIS IT?
      JMP OPEN4     YES SO GO RETURN THE PRAMS
CSER  LDA TYPE      NO SO CONTINUE
      JMP NSHR4     THE SEARCH
      SPC 1 
EXOPT LDB P5        IF EXTENT OPEN IS FOR 
      CPB .8        WRITE THE GO CREAT THE EXTENT 
      JMP CREA0     GO EXIT 
      LDA N5        ELSE RETURN ILLEGAL RECORD ERROR
      JMP CREX      GO EXIT 
      SPC 2 
.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 
      JSB WCSR      WRITE CURRENT SECT
      LDA .128      PRESET # SET TO AVOID DIVIDE
      ISZ FIRST     (EXCEPT WHEN REWRITING) 
      STA #SECT     PROBLEMS
      CCA           SET FIRST 
      STA FIRST     FLAG TO INDICATE FIRST BLOCK
      LDA ATRAK     SET THE TRACK 
      STA TRACK     ADDRESS 
      LDA ALU       AND THE LU
      STA DRLU      ADDRESS 
      CPA .2        IF LU=2 
      CLA,RSS       USE ZERO
      LDA N14       ELSE -14 (UDAD ADDS 14) 
      STA SECT      SET THE SECTOR
      JMP SETDR,I   RETURN
N14   DEC -14 
      SKP ll
* 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 ABUF      SET A TO THE BUFFER ADDRESS 
      LDB N8        SET COUNT FOR THE NO. IN A BLOCK
      STB COUN1 
NSHR1 CCE           SET FOUND FLAG (E=1)
      LDB ANAME     SET THE NAME ADDRESS
      STB TMP2      IN TMP2 
      LDB N3        SET FOR 3-WORD NAME 
      STB COUN2 
      LDB A,I       IF PURGED ENTRY 
      INB,SZB,RSS   THEN
      JMP CKRUS     CHECK IF REUSABLE 
* 
NSHR2 LDB A,I       GET A NAME WORD 
      SZB,RSS       IF ZERO - END OF DIRECTORY
      JMP N.SHR,I   SO EXIT 
* 
      CPB TMP2,I    MATCH?
      INA,RSS       YES - SET FOR NEXT WORD SKIP
      CLE,INA       NO  - SET NOT FOUND - STEP NAME 
      ISZ TMP2      STEP LOCATIONS
      ISZ COUN2     AND COUNT MORE NAME 
      JMP NSHR2     YES; GO DO IT 
* 
      CLB,SEZ,CCE,INB  NO; FOUND? 
      JMP NSHR3     YES; GO TAKE FOUND EXIT 
* 
NSHR4 ADA .13       NO; SET FOR NEXT ENTRY
NSHR5 ISZ COUN1     DONE WITH BLOCK?
      JMP NSHR1     NO; DO NEXT ENTRY 
* 
      JMP NSHR      YES; GO READ NEXT BLOCK 
* 
NSHR3 ADB N.SHR     FOUND - STEP RETURN ADDRESS 
      ADA N3        ADJUST TO START OF ENTRY
      JMP B,I       RETURN
* 
*                    *781103* 
CKRUS ADA .3        TO BE REUSABLE IT MUST NOT BE 
      LDB A,I       TYPE ZERO OR SIX. (FETCH TYPE)
      ADA .3        BUMP (A) TO SIZE LOCATION 
      SZB           CHECK FOR TYPE ZERO 
      CPB .6        OR TYPE 6 
      CCB,RSS        NOT REUSABLE 
*                    *781103* 
      LDB A,I       MUST BE SAME SIZE 
      ADA .10       SET A FOR FAILURE 
*                   *781130*
* 
      SSB           IF TYPE 0 OR 6 DIRECTORY ENTRY, 
      JMP NSHR5      CAN'T REUSE. CONTINUE SEARCH 
* 
*                   *781130*
* 
      CPB NAME+6    SAME SIZE?
      JMP CKRU1     YES GO CHECK FURTHER
* 
      JMP NSHR5     NO  CONTINUE SEARCH 
* 
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
      STA R3        R3=OFFSET +16 
      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  NOP 
      STA R1        SET FIRST RETURN PRAM 
      LDA TRACK     TRACK,LU
      LSL 6         TO
      ADA ALU       RETURN
      STA R2        TWO 
      LDA ABUF      OFFSET
      CMA,INA       AND 
      ADA DIRA      SECTOR
      ALF,ALF       TO
      ADA SECT      RETURN
      STA R3        3 
      LDA TRAKA,I   TRACK OF FILE TO
      STA R4        RETURN 4
      LDA SECTA,I   GET THE SECTOR ADDRESS
      AND B377      ISOLATE IT
      LDB #SECT     GET THE NUMBER OF SECTORS /TRACK
      BLF,BLF       ROTATE AND
      ADA B         COMBINE WITH THE SECTOR 
      STA R5        RETURN 5
      JMP RPRM,I
      SPC 2 
R1    NOP 
R2    NOP 
R3    NOP 
R4    NOP 
R5    NOP 
      SKP 
* 
                                                                                                                                                                      