*  USE ASMB,R,L,N FOR THE M1 VERSION\ ASMB,R,L,Z FOR M2&M3
* 
* 
*     Z OPTION FOR M2/M3 VERSION
*     N OPTION FOR M1 VERSION 
* 
************************************* 
*    M2/M3 VERSION                  * 
************************************* 
* 
* 
*     NAME:   D.RCR 
*     SOURCE: 92064-18054 
*     RELOC:  92064-16018 
*     PGMR:   G.L.M.
* 
* 
************************************
*    M1 VERSION                    *
************************************
* 
* 
*      NAME:   $D.RC
*      SOURCE: 92064-18054
*      RELOC:  92064-16021
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
* 
      IFZ 
* 
**************************************
*       BEGIN M2\3 VERSION CODE      *
**************************************
* 
      NAM D.RCR,2,1  92064-16018  REV.1650  761129
* 
      EXT PRTN,RMPAR,.MVW 
      XIF 
* 
**************************************
*       END M2\3 VERSION CODE        *
**************************************
* 
      IFN 
* 
**************************************
*       BEGIN M1 VERSION CODE        *
**************************************
* 
      NAM $D.RC,6  92064-16021  REV.1650  761129
      EXT .ENTP 
      ENT $D.RC 
* 
      XIF 
* 
**************************************
*       END M1 VERSION CODE          *
**************************************
* 
      EXT EXEC,$LIBR,$LIBX,$TBLS
      EXT $CDIR 
      EXT $CRLK 
* 
* 
      SUP 
* 
* 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. FUNCTION CODE  (10) 
*     P2. -LU,+CARTRIDGE LABEL,0   IF ZERO, SEARCH ALL MOUNTED CARTRIDGES 
*     P3. 0,NAME(1,2) 
*     P4. S,NAME(3,4)  S(BIT 15) INDICATES SCRATCH OPEN IF SET
*     P5. 0,NAME(5,6) 
* 
* 2. CLOSE
*     P1. FUNCTION CODE  (0)
*     P2. LU
* 
* 
* 4. CHANGE NAME
*     P1. FUNCTION CODE  (2)
*     P2. -LU 
*     P3. NAME  (1,2) 
*     P4. NAME  (3,4) 
*     P5. NAME  (5,6) 
*     P6. NEW-NAME (1,2)
*     P7. NEW-NAME (3,4)
*     P8. NEW-NAME (5,6)
* 
* 6. SET,CLEAR LOCK ON CARTRIDGE TAPE UNIT
*     P1. FUNCTION CODE    (3=SET, 5=CLEAR) 
*     P2. -LU,+CARTRIDGE  (0 NOT LEGAL)  DEV. TO BE LOCKED
*     P3. 
*     P4. 
*     P5. 
* 
      SKP 
* 
* RETURN PARAMETERS 
*     R1. ERROR CODE
*     R2. LU
*     R3. DIRECTORY ADDRESS - 
*     R4. FILE #
*     R5. FILE TYPE 
* 
* ERROR CODES 
*     0 OR POSITIVE -NO ERROR 
*    -2              DUPLICATE NAME 
*    -3              FILE NOT FOUND 
*    -6              CARTRIDGE NOT FOUND
*    -8              FILE IS CURRENTLY OPEN (ALSO FOR REJECT LOCK)
*    -11             FILE NOT OPEN (CLOSE)
*    -13             CTU  LOCKED
*    -14             DIRECTORY FULL 
* 
*    -101            ILLEGAL PARAMETERS IN CALL 
*    -102            ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) 
      SKP 
*    FETCH DIRECT ADDRESSES FOR DIRECTORIES 
CRDIR JSB ADD1
FTYPE DEF $CDIR 
CRLK  STA CRDIR 
DIRAD JSB ADD1
ALU   DEF $CRLK 
DIRS  STA CRLK
DRSTP NOP 
TEMPX NOP 
MDSK  CLA 
TMP2  STA BEGIN 
* 
FILE# JMP BG2 
* 
* 
ID    NOP 
* 
* 
ADD1  NOP            FETCH DIRECT ADDRESSES 
      LDA ADD1
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      ISZ ADD1
      JMP ADD1,I
* 
* 
N1    OCT -1
N2    OCT -2
N3    OCT -3
.1    OCT 1 
.2    OCT 2 
.3    OCT 3 
.4    OCT 4 
.6    OCT 6 
B100  OCT 100 
.20   DEC 20
B777 OCT 777
.9    DEC 9 
.16   DEC 16
.26   DEC 26
* 
* 
      IFN 
* 
**************************************
*       BEGIN M1 VERSION CODE        *
**************************************
* 
* 
.7    OCT 7 
* 
TDB   NOP 
      DEC 12
      NOP 
* 
      XIF 
* 
**************************************
*       END M1 VERSION CODE          *
**************************************
* 
* 
* 
P1    NOP            ID 
P2    NOP            FUNCTION 
P3    NOP            CR\-LU\0 
P4    NOP 
P5    NOP 
*-----------------^^^FROM SCHED REQUEST-------------
P6    NOP            FROM CALLERS ID SEG:  XA 
P7    NOP                                  XB 
P8    NOP                                  W27
P9    NOP                                  W28
* 
* 
      IFN 
* 
**************************************
*       BEGIN M1 VERSION CODE        *
**************************************
* 
* 
* 
$D.RC NOP 
      JSB $LIBR     RE-ENTRANT ENTRY
      DEF TDB 
      JSB .ENTP      FETCH CALL PARMS 
P1A   DEF P1
      STA TDB+2     SET RETURN ADDRESS
* 
      LDA P1        FETCH ADDRESS OF PARMS
      LDB P1A       FETCH ADDRESS OF LOCAL AREA 
      JSB .MVW      MOVE EM IN
      DEF .7
      NOP 
* 
* 
BEGIN JMP CRDIR     GO DO BOOT UP THING 
BG2   LDA XEQT      FETCH ID SEG ADDRESS
      STA ID        SAVE IT 
      ADA .26       ADVANCE TO WD27 OF IDSEG
* 
      XIF 
* 
**************************************
*       END M1 VERSION CODE          *
**************************************
* 
* 
* 
* 
      SPC 2 
* 
* 
      IFZ 
* 
**************************************
*       BEGIN M2\3 VERSION CODE      *
**************************************
* 
BEGIN JMP CRDIR     GO FETCH DIRECT ADDRS 
* 
BG2   JSB RMPAR     FETCH ADDRESS OF TDB
      DEF *+2 
      DEF P1
      LDA XEQT      FETCH ID SEG ADDR 
      ADA .20       ADVANCE TO FATHER INFO. 
      LDA A,I           AND FETCH IT
      RAL           POSITION FATHER WAIT BIT TO SIGN
      SSA,RSS       CONTINUE ONLY IF FATHER IS WAITING
      JMP EXIT2     NOT WAITING--ERROR EXIT 
* 
      RAR           REPOSITION ID SEG # OF FATHER 
      AND B777      ISOLATE IT
      ADA N1
      ADA KEYWD     ADD TO TABLE OF ID SEGS 
      LDA A,I       FETCH ID SEG ADDRESS OF CALLER
      STA ID
* 
      ADA .9        ADVANCE TO XA 
      LDB A,I       AND FETCH IT
      STB P6          NOW SAVE
      INA           ADVANCE TO XB 
      LDB A,I         FETCH IT
      STB P7             AND SAVE 
      ADA .16       ADVANCE TO WORD 27
* 
      XIF 
* 
**************************************
*       END M2\3 VERSION CODE        *
**************************************
* 
* 
* 
      DLD A,I       FETCH WDS 27 & 28 
      DST P8        SAVE FOR PARMS P8 AND P9
      SPC 2 
      CLB 
      STB FIRST     CLEAR THE FIRST FLAG
      STB MDSK
* FETCH ADDRESS OF CARTRIDGE DIRECTORY. 
      LDA CRDIR     SET LOCK SEARCH FOR FIRST 
      STA DIRAD     ENTRY 
      ADA N1        BACK UP TO STOP ADDRESS 
      STA DRSTP     SET STOP ADDRESS
* 
*  IF MASTER LOCK REQUEST SKIP "NEXT" WORK
* 
      LDA P1
      CPA .11 
      JMP LCKER 
      SKP 
* 
* 
NEXT  LDA P2        FETCH THE LU
      CMA,CLE,INA    SET LU POSITIVE
      SSA,SZA       DONT' ALLOW 
      JMP EX6          CARTRIDGE REFS 
      AND B77       ISOLATE LU
      LDB MDSK      GET PREVIOUS ID 
      STA MDSK      STORE ID
      CME,SZB       IF NOT A  ZERO, ID ON SECOND
      JMP EX6       CALL TAKE -6 EXIT 
      SPC 1 
LOCK6 STA TMP2      AND SET FOR COMPARE 
* 
*                   SET THE FOUND BIT IN E IF 
* 
      CMA,CLE,INA   A ZERO ID 
      LDB DIRAD     GET CURRENT DIRECTORY ADD.
* 
LOCK2 CPB DRSTP,I   END OF SEARCH?
      JMP EX6       YEP--EXIT 
      LDA B,I       GET FIRST WORD
      SZA,RSS       IF 0 THEN END 
      JMP EX6       NOT MOUNTED 
* 
      STA ALU       UPDATE; ELSE SAVE LU
      CPA TMP2      IS THIS THE REQUIRED CTU ?
      CCE           YES  SET E TO 1 TO INDICATE FOUND 
      ADB .3        INDEX TO NEXT ENTRY 
      SEZ,INB,RSS   IF SEARCHING ALL CTUS  OR FOUND-SKIP
      JMP LOCK2     ELSE GET NEXT ONE.
* 
* 
      SPC 2 
      STB DIRAD     FOUND - UPDATE CURRENT ADDRESS(FOR NEXT CALL) 
      LDB CRLK      FETCH MASTER LOCK ADDRESS 
      LDA B,I       FETCH CONTENTS
      CPA ID        IF LOCKED TO SELF--DON'T CLEAR
      JMP DECOD     CONTINUE
      JSB DORM      GO SEE IF LOCKED-AND NOT DORMANT
      JMP EX31     YES LOCKED AND NOT DORMANT 
* 
      SPC 2 
DECOD LDA P1        FETCH FUNCTION
      SSA           CHECK REQUEST CODE
      JMP EX101     NEGATIVE - EXIT 
      ADA N12 
      SSA,RSS 
      JMP EX101     GREATER THAN 11 - EXIT
      ADA TABAD     INDEX INTO THE FUNCTION 
      JMP A,I       GO EXECUTE THE FUNCTION 
      SPC 2 
* 
* 
TABAD DEF TABA+12 
TABA  JMP CLOSE     0 
      JMP EX101     1 
      JMP CNAM      2 
      JMP RLOCK     3 
      JMP EX101     4 
      JMP ULOCK     5 
      JMP EX101     6 
      JMP EX101     7 
      JMP EX101     8 
      JMP EX101     9 
      JMP OPEN      10
      JMP LCKER     11
* 
.11   DEC 11
      SKP 
*****MASTER LOCK ROUTINE
* 
LCKER LDA P4        FETCH ID/0
      SZA           IF RELEASE THEN CONTINUE
      JMP LKCK      ELSE CHECK FOR ANY OPEN CARTRIDGES
* 
      LDB CRLK,I    FETCH LOCKER'S ID 
      CPB ID        MUST BE SAME AS CALLER'S
      RSS           YEP--IT'S OK
      JMP EX8       NO--REJECT CALL 
* 
LKOK  LDB CRLK      FETCH ADDRESS 
      JSB SETIT     GO SET/CLEAR LOCK 
CRAD  LDA DIRAD 
      STA ADD1      SET DIRECTORY ADDRESS FOR RETURN TO CALLER
      JMP C.X 
* 
* 
* 
* 
LKCK  LDB CRDIR     FETCH CARTRIDGE DIRECTORY ADDRESS 
LK?   ADB .3        ADVANCE TO LOCK WORD
      STB LKTMP     SAVE IN LOCAL TEMP
      LDA B,I       FETCH LOCK WORD 
* 
      CPA ID        IF LOCKED TO SELF 
      JMP NOLK          LEAVE IT ALONE
* 
      JSB DORM      GO SEE IF DORMANT OR NEW-RUN
      JMP EX8       NOPE-LOCKED--LOCK REJECT ERROR
* 
NOLK  LDB LKTMP     FETCH CARTRIDGE DIR ADDR
      INB           ADVANCE TO NEXT ENTRY 
      CPB DRSTP,I   END?? 
      JMP BLLK      YES GO DO LOCK
      JMP LK?       CONTINUE SEARCH 
* 
BLLK  LDA P4
      JMP LKOK      GO LOCK IT
* 
LKTMP NOP 
* 
      SKP 
* 
*************************************************** 
* 
*   OPEN ROUTINE  ***** 
* 
**************************************************
* 
* 
* 
OPEN  JSB SETDR     SET UP TO READ THE DIRECTORY
      LDA P4        IF SIGN SET ON P4 
      SSA           THEN SCRATCH OPEN REQUESTED 
      JMP SCR       GO FIND # OF FILES ON CTU 
* 
      JSB N.SHR     GO FIND THE FILE
      JMP NEXT      NOT FOUND - TRY NEXT CARTRIDGE TAPE 
* 
*    FOUND
* 
LCKR  STA ADD1      SET ADDRESS OF DIRECTORY FOR RETURN 
* 
*   FOUND IT-- IS IT LOCKED?
* 
      LDB DIRAD     FETCH DIRECTORY ADDRESS 
      ADB N1        BACKUP TO LOCK WORD 
      LDA B,I       FETCH LOCK WORD 
      CPA ID        IF LOCKED TO SELF 
      JMP EX13            REJECT OPEN ATTEMPT 
* 
      JSB DORM      GO SEE IF LOCKING PROG IS DORMANT 
* 
* 
      JMP EX13      NOPE NOT DORMANT-CAN'T BUILD DCB
* 
* 
*    SET SUBFUNCTION BIT
* 
      LDA ADD1      FETCH DIRECTORY ADDRESS 
      ADA .3         ADVANCE TO TYPE WORD 
      LDB A,I              AND FETCH IT 
      STB FTYPE     SAVE IT 
      LDA ALU        FETCH LU 
* 
      CPB BS        IF ASCII
      RSS               SKIP
      IOR B100         ELSE-INCLUDE "M" BIT  (BINARY) 
      STA ALU       RESTORE LU AND SUBFUNCTION
* 
* 
      LDB DIRAD      FETCH ADDRESS
      ADB N1         OF LOCK WORD FOR THIS CARTRIDGE
      LDA ID         FETCH ID SEG ADDRESS OF REQUESTING PROG
      JSB SETIT     LOCK THIS UNIT
* 
C.X   CLA           CLEAR ERROR CODE
* 
CREX  JSB RPRM      GO SET RETURN PARAMETERS
* 
      IFZ 
* 
**************************************
*       BEGIN M2\3 VERSION CODE      *
**************************************
* 
      JSB PRTN      PASS THE RETURN PRAMS 
      DEF *+2       AND 
      DEF R1        THEN
EXIT2 JSB EXEC      COMPLETE
      DEF *+2 
      DEF .6
* 
      XIF 
* 
**************************************
*       END M2\3 VERSION CODE        *
**************************************
* 
* 
      IFN 
* 
**************************************
*       BEGIN M1 VERSION CODE        *
**************************************
* 
      LDA R1AD      FETCH ADDRESS OF RETURN PARMS 
      LDB XEQT      FETCH IDSEG ADDR
      INB           ADVANCE TO TEMP AREA
* 
* 
*   SET RETURN PARMS INTO ID TEMP AREA 
* 
      JSB .MVW
      DEF .5
      NOP 
* 
* 
*   RESET B FOR RMPAR CALL BY CALLER
* 
      LDB XEQT
      INB 
      JSB $LIBX 
      DEF TDB 
      NOP 
* 
* 
* 
* 
R1AD  DEF R1
.5    OCT 5 
* 
      XIF 
* 
**************************************
*       END M1 VERSION CODE          *
**************************************
* 
* 
      SPC 2 
* 
BS    ASC 1, S
* 
SCR   JSB N.SHR     GO COUNT THE FILES
      JMP LCKR      GO TREAT AS NORMAL
* 
      JMP EX101     THIS SHOULD NEVER HAPPEN
* 
      SPC 2 
.8    DEC 8 
.14   DEC 14
SIGN  OCT 100000
      SPC 2 
* 
RPRM  NOP 
      STA R1        SET ERROR RETURN/TYPE 
      LDA ALU       SET LU CODE 
      STA R2
      LDA ADD1      FETCH DIRECTORY ADDRESS 
      STA R3        SET IN RETURN PARMS 
      LDA FILE#     FETCH ABS FILE #
      STA R4        RETURN TO CALLER
      LDA FTYPE     FETCH FILE TYPE 
      STA R5        SET IT
* 
* 
      JMP RPRM,I
* 
* 
* 
R1    NOP 
R2    NOP 
R3    NOP 
R4    NOP 
R5    NOP 
      SPC 2 
* 
* 
EX2   LDA .2
      RSS 
EX6   LDA .6
      RSS 
EX8   LDA .8
      RSS 
EX13  LDA .13 
      CMA,INA,RSS 
EX11  LDA N11 
      RSS 
EX31  LDA N31 
* 
      JMP CREX
      SPC 2 
N31   DEC 31
EX101 LDA N101
      JMP CREX
* 
N101  DEC -101
      SKP 
*  SETDR     ROUTINE TO SET UP TO READ A DIRECTORY
* 
SETDR NOP 
* 
* 
      LDB DIRAD     FETCH POINTER TO CART. DIR
      ADB N2        BACKUP TO DIRECTORY ADDRESS 
      LDA B,I       FETCH IT
      STA DIRS      SAVE IT 
      ADB N1        BACK UP TO VALIDITY WORD
      STB N.SHR     SAVE LOCATION OF VALIDITY WORD
      LDB B,I 
* 
*   CHECK VALIDITY OF DIRECTORY--0=GOOD,ELSE INVALID. 
* 
      LDB B,I       FETCH CONTENTS OF VALIDITY WORD 
      SZB,RSS       IF NOT ZERO--SKIP 
      JMP SETDR,I   ITS VALID--ALL DONE.
* 
* 
      LDA DIRS      FETCH DESTINATION ADDR FOR INPUT
* 
* 
*  READ DIRECTORY ENTRY 
* 
* 
      LDB ALU 
* 
      JSB $TBLS     GO  RESTORE DIRECTORY 
* 
      JMP CREX      READ ERROR/DIRECTORY ERROR-CODE IN (A)
* 
ROK   CLA 
      LDB N.SHR     FETCH ADDRESS OF VALIDITY WORD
      ADB SIGN
      JSB SETIT     GO CLEAR VALIDITY(STA B,I)
      ADB .2        ADVANCE TO LOCK WORD
      JSB SETIT     GO REMOVE LOCK (NEW DIRECTORY HAS BEEN READ)
* 
      JMP SETDR,I 
* 
* 
      SKP 
* N.SHR     DIRECTORY SEARCH ROUTINE
*           TARGET NAME IN NAME 
*           RETURNS:
*           P+1  END OF DIRECTORY A=NEXT ADDR.(IF A=STOP,NO SPACE)
*                "FILE#"=ABSOLUTE FILE# FOR NEXT FILE.
*           P+2  FOUND RETURN   A=ENTRY ADDR. 
*                "FILE#"=ABSOLUTE FILE# OF THIS FILE. 
* 
N.SHR NOP 
* 
* 
      LDA DIRS      ADDRESS OF DIRECTORY TO BE SEARCHED.
      ADA N1        DIR-1=END OF TABLE TO BE SEARCHED.
      LDB A,I       FETCH THAT ADDRESS
      STB STOP      AND SAVE IT 
      INA           POSITION TO BEGINING OF TABLE/DIRECTORY 
* 
*   SETUP FOR SEARCH
* 
      CLB,INB       SET FOR FILE
      STB FILE#                COUNT -ADJUST FOR DIRECTORY
* 
*  SEARCH FOR REQUESTED NAME. 
* 
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 
      ISZ FILE#     INCREMENT FILE COUNT
* 
NSHR2 CPA STOP      END OF SEARCH ? 
      JMP N.SHR,I   YES EXIT--A=STOP
      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 INA           NO; SET FOR NEXT ENTRY
      JMP NSHR1     NO; DO NEXT ENTRY 
NSHR3 ADB N.SHR     FOUND - STEP RETURN ADDRESS 
      ADA N3        ADJUST TO START OF ENTRY
      JMP B,I       RETURN
* 
* 
STOP  NOP 
ANAME DEF P3
* 
N11   DEC -11 
N12   DEC -12 
      SPC 2 
.13   DEC 13
B77   OCT 77
FIRST NOP 
COUN2 NOP 
      SPC 10
* 
* 
*   LOCAL MOVE WORDS SUBROUTINE 
*        M1 VERSION ONLY
* 
      IFN 
* 
**************************************
*       BEGIN M1 VERSION CODE        *
**************************************
* 
* 
* 
.MVW  NOP 
      STA .A
      LIA 6 
      SZA,RSS       MX OR XE COMPUTER?
      JMP NMX0      NEITHER 
* 
      CCA 
      ADA .MVW      GET P+1 
      STA .MVW      CALCULATE P 
      LDA MVW 
      STA .MVW,I    PATCH INSTRUCTION 
      LDA .A        RESTORE A 
      JMP .MVW,I    GO DO MVW THING 
* 
* NEITHER MX NOR XE 
* 
NMX0  LDA .MVW,I    MICRO CODE MOVE REPLACEMENT 
      LDA A,I       GET THE COUNT 
      ISZ .MVW      STEP TO NOP (NOP IS RETURN) 
      SZA,RSS 
      JMP OUT       SKIP MOVE IF ZERO COUNT 
* 
      CMA,INA       SET IT NEGATIVE 
      STA COUNT     SET COUNTER 
LOOP  LDA .A,I      GET WORD
      STA B,I       SET IN DESTINATION
      INB           STEP DESTINATION
      ISZ .A        SOURCE
      ISZ COUNT     AND COUNT 
      JMP LOOP      IF NOT DONE LOOP
* 
OUT   LDA .A        PUT NEXT LOC IN A 
      JMP .MVW,I    AND RETURN
* 
MVW   MVW 0 
.A    EQU *-1 
COUNT NOP 
* 
      XIF 
* 
**************************************
*       END M1 VERSION CODE          *
**************************************
* 
      SKP 
* 
CNAM  JSB SETDR 
      JSB N.SHR 
      JMP NEXT
* 
      STA RPRM      SAVE ADDRESS OF FILE
      LDA P6
      STA P3
      DLD P7
      DST P4
* 
      JSB N.SHR     SEARCH FOR NEW NAME 
      RSS 
      JMP EX2 
* 
      LDB RPRM      FETCH ADDRESS OF OLD NAME 
      LDA ANAME 
* 
      JSB $LIBR 
      NOP 
      JSB .MVW
      DEF .3
      NOP 
      JSB $LIBX 
      DEF *+1 
      DEF C.X 
      SKP 
* 
RLOCK LDB DIRAD     FETCH CART.DIR POINTER
      STB ADD1      SAVE IT INCASE LOCKED 
      ADB N1        BACK UP TO LOCK WORD
      LDA B,I       FETCH LOCK CONTENTS 
      CPA ID        IF LOCKED TO SELF 
      JMP EX8       REJECT LOCK REQUEST 
* 
* 
      JSB DORM      SEE IF LOCKING PROG IS DORMANT OR THIS ONE
* 
      JMP EX13
* 
*  UNLOCKED OR DORMANT--GRANT LOCK REQUEST
*      OR LOCKED TO THIS PROG 
* 
      LDA ID        FETCH CALLERS ID
      JSB SETIT     GO SET LOCK (STA B,I) 
* 
*     CLEAR ERROR CODE
      JMP CRAD      GO SET DIR ADDR FOR RETURN\EXIT 
      SPC 5 
* 
* 
* 
ULOCK LDB DIRAD 
      ADB N1
      LDA B,I       FETCH LOCK CONTENTS 
      CPA ID        INSURE RELEASE OF OWN LOCK
      RSS           YES --ITS OK
      JMP EX13      UNLOCK ERROR
      CLA 
      JSB SETIT     GO CLEAR LOCK (STA B,I) 
      JMP CREX
      SKP 
* 
CLOSE LDA P2        FETCH LU
      CPA N1        IF -1,   NO ACTION---DEVICE FILE
      JMP C.X        GO EXIT(ERR CODE=0)
* 
      LDB DIRAD     MIGHT BE SET ALREADY!!!!!!!!
      ADB N1
      LDA B,I 
      CPA ID        ONLY CLOSE YOUR OWN FILES 
      RSS           --OK
      JMP EX11      FILE(DEVICE) NOT OPEN TO YOU
      CLA 
      JSB SETIT     GO REMOVE LOCK
      JMP CREX
      SPC 5 
* 
*    SET CONTENTS OF (A) BELOW THE FENCE--- 
*         TO LOCATION POINTED AT BY (B) 
* 
* 
SETIT NOP 
      JSB $LIBR 
      NOP           PRIV REQUEST
      STA B,I       THATS ALL FOLKS 
* 
      JSB $LIBX 
      DEF SETIT 
      SPC 5 
*  DORM     CHECK TO SEE IF PROGRAM IS DORMANT
* 
*                ID ADDRESS 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
      CCE,SZA,RSS   IF ZERO THEN JUST RETURN P+2
      CLE,RSS       SO SKIP   ELSE
      CPA ID        IF OPEN TO THIS PGM  FORCE CLOSE
      JMP DORM1     SO GO EXIT
      LDB KEYWD     MAKE SURE THE FLAG POINTS 
      STB TEMPX     TO A VALID
DORM2 LDB TEMPX,I   ID SEGMENT
      CPB A         THIS ONE? 
      JMP DORM3     YES CONTINUE
      ISZ TEMPX     NO TRY THE NEXT ONE 
      CCE,SZB       IF END THEN 
      JMP DORM2 
      JMP DORM1     NOT VALID  GO CLEAR FLAG
* 
DORM3 ADA .28       ADVANCE TO NEW-RUN INFO 
      LDB A,I         FETCH IT
      CCE,SSB       SKIP IF CLEAR(NOT NEW-RUN)
      JMP DORM1     IT'S A NEW RUN--CLEAR LOCK
      ADA N20       BACK UP TO POINT OF SUSPENSION
* 
*    SHOULD ALSO CHECK TO SEE IF IN TIME LIST!!!!!
* 
* 
      LDB A,I       TO B
      CMB,CLE,INB,SZB,RSS   IF ZERO (DORMANT) E_1 
DORM1 ISZ DORM              ELSE SKIP 
      LDB TMP2      RESTORE BREG
      CLA,SEZ       CHANGE TO DORMANT 
      JSB SETIT     SET TO ZERO 
      JMP DORM,I    RETURN
* 
.28   DEC 28
N20   DEC -20 
      SKP 
A     EQU 0 
B     EQU 1 
.     EQU 1650B 
KEYWD EQU .+7 
XEQT  EQU .+39
LN    EQU * 
**************************
* 
      END BEGIN 
                                                                                                                                                  