ASMB,R,L,C
      HED SUBROUTINE DBOPN
      NAM DBOPN,7 92063-12001 REV.1913 790220 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
*     LISTING:   92063-19001
*     SOURCE:    92063-18001
*     RELOC:     92063-12001
* 
* 
************************************************************* 
* 
* CALLING SEQUENCE :
* 
* CALL DBOPN(IBASE,DBILV,DBSCD,MODE,ISTAT)
* 
* PARAMETER DESCRIPTION : 
* 
* IBASE - AN ASCII ARRAY WHICH CONTAINS THE NAME OF 
*         THE DATA BASE.
* ILEV - AN ASCII ARRAY WHICH CONTAINS THE LEVEL
*         WORD FOR THE DATA BASE. 
* ISCOD - AN INTEGER WHICH IS THE FMP SECURITY CODE 
*         FOR THIS DATA BASE. 
* IMODE - AN INTEGER WHICH IS THE MODE IN WHICH THE 
*         DATA BASE IS OPEN.
* ISTAT - AN INTEGER USED TO RETURN STATUS
*         INFORMATION TO THE USER.
* 
* FUNCTION :
* 
* DBOPN VALIDATES THE VALUE OF IMODE. IT MAKES A
* DISK FILE READ FROM THE FILE WHOSE NAME MATCHES 
* THE VALUE OF IBASE FOR THE PURPOSE OF VERIFYING 1)
* THAT THE FILE READ FROM IS THE ROOT DATA-SET OF AN
* IMAGE DATA-BASE AND 2) THAT THE VALUE IN ISCOD IS 
* CORRECT. NEXT, DBOPN CONTINUES TO READ THE ROOT 
* DATA-SET AND DEVELOPS THE RUN TABLE IN THE IPNTR
* AREA(IN COMMON) PREPARATORY TO ACCEPTING OTHER
* USER REQUESTS RELATIVE TO THIS DATA-BASE. 
* 
* A SUCCESSFUL OPEN IS SIGNALLED TO THE CALLER BY A 
* RETURN OF A BINARY ZERO TO THE FIRST WORD OF ISTAT
* AND A BINARY LEVEL NUMBER BETWEEN 0 AND 15 IN THE 
* SECOND WORD OF ISTAT. 
* 
* TO MODIFY THE CONTENT OF A DATA-BASE, THE USER
* MUST ASK FOR THE OUTPUT CAPABILITY. TO SIMPLY READ
* ,HE SHOULD ASK FOR THE INPUT CAPABILITY. THREE
* MODES ARE AVAILABLE AS SHOWN BY THE FOLLOWING 
* TABLE:
* 
*     IMODE         ACCESS CAPABILITIES 
* 
*      1            READ ONLY 
*      2            READ AND WRITE (DEL AND PUT WITH LOCK)
*      3            READ, WRITE, DELETE AND PUT 
* 
* A USER WHO NEEDS ONLY TO ACCESS THE DATA-BASE AND 
* WHO WILL NOT ALTER ITS CONTENTS IN ANY WAY SHOULD 
* SELECT MODE 1. A USER WHO INTENDS TO UPDATE THE 
* CONTENTS OF THE DATA-BASE SHOULD SELECT MODE 2. 
* THE USER CANNOT ADD OR DELETE DATA-ENTRIES IN THIS
* MODE: HOWEVER,HE MAY UPDATE NON-CRITICAL DATA-ITEM
* VALUES OF EXISTING DATA-ENTRIES. IN OTHER WORDS,
* THIS MODE DOES NOT ALLOW LINKAGE MAINTENANCE. 
* 
* A USER WHO INTENDS TO ADD OR DELETE DATA-ENTRIES, 
* OR TO MODIFY SEARCH ITEMS MUST REQUEST MODE 3.
* 
* AN UNSUCCESSFUL COMPLETION IS SIGNALLED TO THE
* CALLER BY THE RETURN OF A NON-ZERO INTEGER IN THE 
* FIRST WORD OF ISTAT IDENTIFYING THE NATURE OF THE 
* ERROR.
* 
* 
       EXT PHIS1,AIDCB,.ENTR,CMPCT,PHICM,SFILL,DCBAN
      EXT $LIBR,$LIBX,EXEC,RNRQ,.DBRN,AIRUN,READF,SMOVE,OPEN,D%DCB
      EXT POST,WRITF,RWNDF
      ENT DBOPN 
* 
* 
      SUP PRESS 
* 
ACSUB BSS 1        1ST BYTE : ACTIVITY FLAG 
*                   2ND BYTE : SUBCHANNEL # 
DBSTA BSS 1        DATA BASE STATUS 
DBSCD BSS 1        DATA BASE SECURITY CODE(FMP) 
DBICT BSS 1        DATA BASE ITEM COUNT 
DCRUN BSS 1         RUN TABLE ADDRESS 
DCNAM BSS 1         FILE NAMES THAT ARE OPEN
DBSCT BSS 1        DATA BASE DATA SET COUNT 
DBITB BSS 1        ADDRESS OF ITEM TABLE
DBSTB BSS 1        ADDRESS OF DATA SET TABLE
DBLVL BSS 1        1ST BYTE: ACCESS LEVEL GRANTED BY 'DBOPN'
DBILV BSS 1        DATA BASE ITEM LEVEL WORDS - 3 WORDS/LEVEL 
* 
* 
PARS  BSS 5 
DBOPN NOP 
      JSB .ENTR     PICK UP PARAMETERS
      DEF PARS
* 
      LDA AIRUN 
      SZA,RSS       HAS DBINT BEEN CALLED YET?
      JMP E130      NO! 
      STA DCRUN 
      ADA .2
      STA ACSUB       TABLE OF ADDRESSES
      INA 
      STA DBSTA         FOR 
      INA 
      STA DBSCD           ACCESS TO 
      INA 
      STA DBICT             RUN 
      INA 
      STA DBSCT               TABLE 
      INA 
      STA DBITB 
      INA 
      STA DBSTB 
      INA 
      STA DBLVL 
      INA 
      STA DBILV 
      LDA DCBAN 
      STA DCNAM 
* 
      LDA AIDCB     SET UP POINTER TO 
      STA DCB         DATA CONTROL BLOCK FOR RUN TABLE. 
* 
*** 
*** CHANGE REV 1840 
* 
*  MAKE SURE THERE IS NOT A DATA BASE ALREADY OPENED TO THE USER
*  IN AVAILABLE MEMORY.  IF SO, WE CANNOT OPEN A NEW ONE. 
* 
      LDA DBSTA,I   IF DB STATUS IS 
      CPA =ALB        EQUAL TO "LB" 
      JMP E103        A DATA BASE IS ALREADY OPEN.
*** 
*** 
* 
      CLA           SET ENTRY ADDRESS POINTER/FLAG
      STA ENTAD       TO ZERO FOR INITIAL VALUE.
* 
      LDA PARS+2,I  CONVERT SECURITY CODE TO
      CMA,INA 
      STA SC          NEGATIVE
      JSB SFILL     FILL
      DEF *+5 
      DEF DCNAM,I     DATA NAME 
      DEF .1
      DEF .36           TABLE WITH BLANKS 
      DEF .32 
* 
      LDA PARS+3,I  IF MODE BETWEEN 1 AND 3 
      SZA           RANGE 
      SSA 
      JMP E115      BAD MODE
      LDB .3        SET FOR                            *******
      CPA .3          EXCLUSIVE 
      LDB .2            OPEN IF                        *******
      STB IOPTN           MODE=3
      CMA,INA 
      ADA .3
      SSA 
      JMP E115      BAD MODE
      JSB OPEN      OPEN
      DEF *+6 
      DEF DCB,I       THE 
      DEF IERR
      DEF PARS,I        ROOT FILE 
      DEF IOPTN 
      DEF SC
      CPA M8        LOCKED OR OPEN  ROOT FILE?
      JMP E129      YES!
      CPA M7        SECURITY VIOLATION? 
      JMP E117      YES!
      SSA           ANY OTHER ERROR?
      JMP FMER1     YES!
* 
*** 
***  CHANGE REV 1840
* 
*  IF OPEN MODE IS 2, LOOK FOR DATA BASE IN ACTIVE TABLE.  IF THE ENTRY 
*  IS FOUND, TURN OFF INTERRUPTS AND CHECK THE ENTRY AGAIN FOR VALIDITY.
*  IF ENTRY STILL VALID, INCREMENT THE USER COUNT.  THEN TURN OF THE IN-
*  TERRUPT SYSTEM AGAIN.
* 
*  IF THE ENTRY WAS FOUND WE SET ITS ADDRESS IN ENTAD.  IF NOT, ENTAD IS
*  SET TO ZERO
* 
      LDA PARS+3,I
      CPA .2
      RSS 
      JMP C4
* 
      LDA ADBRN     THIS CODE GETS THE TRUE 
      RSS             ADDRESS OF .DBRN
      LDA 0,I         BY CHASING DOWN INDIRECTS.
      RAL,CLE,SLA,ERA 
      JMP *-2 
      STA ADBRN 
* 
      LDB 0,I       GET THE TABLE SIZE AND
      CMB,INB         NEGATE IT FOR A 
      STB TABCT       LOOP COUNTER. 
* 
      INA           GET ACTIVE TABLE
C1    STA TABAD       ENTRY ADDRESS 
      LDB .3
      STB CMPCT     SEARCH ACTIVE TABLE 
      LDB PARS        FOR EXISTING ENTRY. 
      JSB PHICM     ARE NAMES THE SAME? 
      RSS 
      JMP C2          YES - GO ALTER ENTRY. 
      LDA TABAD       NO - CHECK NEXT ENTRY 
      ADA .6
      ISZ TABCT         IF THERE IS ONE.
      JMP C1
      JMP C4
* 
C2    NOP           WE MUST GO PRIVELEDGED
      JSB $LIBR       TO ASSURE THAT WE 
       NOP            HAVE THE CORRECT INFO.
      LDB TABAD     IF FIRST WORD OF ENTRY
      LDA 1,I         IS NEGATIVE ONE,
      SSA             SOMEONE HAS REMOVED ENTRY.
      JMP C3
      STB ENTAD 
      ADB .5
      ISZ 1,I 
C3    NOP 
      JSB $LIBX 
       DEF *+1
       DEF *+1
* 
C4    NOP 
*** 
*** 
* 
      JSB READF     READ
      DEF *+6 
      DEF DCB,I       THE ROOT
      DEF IERR
      DEF DCRUN,I       FILE
      DEF .9999 
      DEF LEN             INTO 'IRUN' 
      SSA           ERROR?
      JMP FMERR     YES!
* 
* 
      JSB SMOVE     MOVE ROOT DCB 
      DEF *+6 
      DEF DCB,I       TO DATA 
      DEF .1
      DEF .32           BASE SYSTEM 
      DEF D%DCB 
      DEF .1              BUFFER
* 
      LDA =ALB      IS DBSTATUS EQUAL 
      CPA DBSTA,I     TO "LB" ? 
      JMP *+2 
      JMP E116      NO,GO TO ERROR
* 
      LDA .1
      STA ACSUB,I 
      LDA DBSCD,I   IS SECURITY CODE = ISCOD? 
      CPA SC
      JMP *+2 
      JMP E117      NO,GO TO ERROR
      LDA DBILV 
      STA ILEV3 
      LDA M15 
      STA TEMP1 
      LDA .3        IF LEVEL WORD 
      STA CMPCT     IS ALL BLANK,ZERO 
      LDA PARS+1    FIRST 2 CHARACTERS
      LDB BLANP     TO RENDER IT GARBAGE
      JSB PHICM 
      JMP *+3 
      CLA 
      STA PARS+1,I
LOOP1 LDA .3        LOOP ON ITEM TABLE AND COMPARE
      STA CMPCT     AGAINST ITEM LEVEL FOR A MATCH
      LDA ILEV3 
      LDB PARS+1
      JSB PHICM 
      JMP *+2 
      JMP DBOP2 
      LDA ILEV3 
      ADA .3
      STA ILEV3 
      ISZ TEMP1 
      JMP LOOP1 
* LOOP ON ITEM FROM BOTTOM TO TOP AND CHECK FOR 
* FIRST NON-BLANK ENTRY. WHEN THIS IS ENCOUNTERED 
* ADD 15 TO THE INDEX AND USE THAT AS ALEVL. IF 
* ITEM TABLE IS ALL BLANKS,SET DBLVL   TO 15. 
      LDA M15 
      STA TEMP1 
      LDA DBILV 
LOOP2 STA ILEV3 
      LDA .3
      STA CMPCT 
      LDA ILEV3 
      LDB BLANP 
      JSB PHICM 
      JMP *+7 
      LDA ILEV3 
      ADA .3
      ISZ TEMP1 
      JMP LOOP2 
      LDB .15 
      JMP DBOP3 
      LDB TEMP1 
      ADB .15 
      JMP DBOP3 
DBOP2 LDB TEMP1     STORE LEVEL NUMBER IN ALEVL AND 
      ADB .16       ISTAT(2)
DBOP3 LDA PARS+4
      INA 
      STB 0,I 
      BLF,BLF 
      ADB PARS+3,I  MERGE IN IMODE
      STB DBLVL,I 
      LDA PARS+3,I  IS IMODE = 1 OR 2 
      ADA M3
      SSA 
      JMP DBOP4 
      LDA DBLVL,I   NO,CHECK FOR ALEVL EQUAL TO 15
      ALF,ALF 
      AND B377
      ADA M15 
      SZA           ILLEGAL ACCESS LEVELFOR THIS MODE 
      JMP E118
DBOP4 CLA           CLEAR FIRST WORD OF ILEVL FOR 
      STA DBILV,I   SUBROUTINE PHIL 
      LDA DBILV     STORE IBASE IN
      STA ILEV3     ILEV(2)-ILEV(4) 
      LDA PARS
      STA TEMP1 
      LDB M3
      LDA TEMP1,I 
      ISZ ILEV3 
      STA ILEV3,I 
      ISZ TEMP1 
      ISZ 1 
      JMP *-5 
      LDA ACSUB,I   SET ACTIVITY FLAG TO "1"
      IOR ACMSK 
      STA ACSUB,I 
      LDA DBSCT,I   LOOP ON DSET COUNT TO CREATE
      CMA,INA       DATA-SETS AND INITIALIZE INFO 
      STA DINX      WITHIN THESE DATA-SETS. 
      LDB DBSTB,I   ALSO,REGARDLESS OF MODE, SET
      ADB DCRUN     READ AND WRITE LEVEL BITS OF
      ADB M1
*                   RECORD DEFINITION TABLES AS TO
      JMP DBOP8     ACCESSIBILITY(0= NON-ACCESSIBLE)
DBOP7 LDB DSET      CALCULATE THE ADDRESS OF THE
      ADB .3        NEXT DATA-SET.
      LDA 1,I 
      LDB 0 
      AND B377
      RAL 
      SWP 
      ALF,ALF 
      AND B377
      ADB 0         DSET=2*PATHCT+FIELDCT+16+DSET 
      ADB .16 
      ADB DSET
DBOP8 STB DSET
      LDB DSET      PICK UP FIELD COUNT, NEGATE 
      ADB .3        AND STORE IN TEMP1
      LDA 1,I 
      ALF,ALF 
      AND B377
      CMA,INA 
      STA TEMP1 
      LDA DSET      INITIALIZE TEMP3 TO POINT TO
      ADA .16       RECORD DEFINITION TABLES FOR
      STA TEMP3     THIS DATA-SET 
DBO12 LDB DBITB,I 
      ADB DCRUN 
      ADB M1
      LDA TEMP3,I   PICK UP INUM(I),NEGATE IT,
*                   INDEX ITEM TABLE WITH IT, AND 
      ALF,ALF       STORE THIS VALUE IN TEMP2 
      AND B377
      CMA,INA 
      ISZ 0 
      JMP *+2 
      JMP *+3 
      ADB .5
      JMP *-4 
      STB TEMP2 
      ADB .3        PICK UP READLEVEL FROM ITEM 
      LDA 1,I       TABLE FOR THIS DATA-ITEM
      ALF,ALF 
      AND B377
      CMA,INA 
      LDB DBLVL,I 
      SWP 
      ALF,ALF 
      AND B377      IF ALEVL-READLEVEL IS NEGATIVE
      ADB 0         THEN DON'T SET THE READ BIT 
      SSB 
      JMP *+4 
      LDB .1        SET READ BIT
      ADB TEMP3,I 
      STB TEMP3,I 
      LDB TEMP2     PICK UP WRITE LEVEL FROM ITEM 
      ADB .3        TABLE FOR THIS DATA-ITEM
      LDB 1,I 
      SWP 
      AND B377      IF ALEVL-WRITELEVEL IS NEGATIVE 
      CMA,INA       THEN DON^T SET THE WRITE BIT
      ADB 0 
      SSB 
      JMP *+4 
      LDB .2        SET WRITE BIT 
      ADB TEMP3,I 
      STB TEMP3,I 
      ISZ TEMP3     INCREMENT TEMP3 FOR NEXT INUM 
      ISZ TEMP1 
      JMP DBO12 
      ISZ DINX
      JMP DBOP7 
* 
      LDA PARS+3,I  IS THIS A 
      CPA .2          MODE=2 OPEN?
      JMP MODE2     YES!
* 
EXIT  CLB           NO! 
      STB PARS+4,I
      JMP ERR1
FMERR CMA,INA 
      STA 1 
ERROR CLA 
      STA DBSTA,I 
* 
*** 
*** CHANGE REV 1840 
* 
*  ON AN ERROR, WE MUST CHECK TO SEE IF WE ALTERED AN ENTRY IN THE ACTIVE 
*  TABLE.  ENTAD WILL BE A NON-ZERO ENTRY ADDRESS, IF SO.  WE MUST GO 
*  PRIVELEDGED AGAIN AND DECREMENT THE USER COUNT THEN WE CAN TURN THE
*  INTERRUPT SYSTEM BACK ON.  IF THE COUNT BECOMES ZERO, WE ASK CLNUP 
*  TO DO THE JOB OF A DBCLS WHEN THE COUNT BECOMES ZERO.  IF NON-ZERO,
*  WE JUST RETURN THE ERROR TO THE USER.
* 
      STB PARS+4,I  SAVE ERROR CODE 
      LDA ENTAD 
      SZA,RSS 
      JMP ERR1      NO ENTRY ALTERED. 
* 
      JSB $LIBR     GO PRIVELEDGED. 
       NOP
      LDB ENTAD 
      LDA 1,I       IS ENTRY STILL OKAY?
      SSA 
      JMP C10         NO - SOMEONE HAS REMOVED IT.
      ADB .5          YES - DECREMENT USER COUNT. 
      CCA 
      ADA 1,I 
      STA 1,I 
* 
      SZA           IF COUNT IS NON-ZERO OR 
C10   CLB,RSS       ENTRY REMOVED, ZERO ENTAD 
      RSS 
      STB ENTAD 
      JSB $LIBX     THEN TURN INTERRUPTS ON AGAIN.
       DEF *+1
       DEF *+1
* 
      LDA ENTAD     IF ENTAD NON-ZERO 
      SZA             WE NEED TO REMOVE ENTRY 
      JMP CLNUP       ELSE JUST RETURN. 
*** 
*** 
* 
ERR1  LDA ACSUB,I    CLEAR ACTIVITY FLAG
      AND B377
      STA ACSUB,I 
* 
*** 
*** CHANGE REV 1840 
* 
*  CLEAR OUT REMAINS OF ROOT DCB
* 
      JSB SFILL 
       DEF *+5
       DEF DCB,I
       DEF .1 
       DEF .32
       DEF .0 
      JMP DBOPN,I 
* 
* SET UP ACTIVE TABLE 
* 
*** 
*** CHANGE REV 1840 
* 
*  IF WE HAVE ALREADY FOUND THE ENTRY FOR THE DATA BASE IN THE ACTIVE TABLE 
*  ITS ADDRESS IS IN ENTAD, ELSE ENTAD IS ZERO. 
*  IF ENTAD IS NON-ZERO:
*    GO PRIVELEDGED AND CHECK THAT THE ENTRY IS STILL VALID.  IF NOT, ZERO
*  ENTAD.  TURN ON INTERRUPTS AGAIN AND IF ENTAD IS ZERO JUMP TO THE CODE 
*  TO BUILD AN ENTRY, ELSE JUST RETURN TO USER. 
* 
MODE2 LDA ENTAD 
      SZA,RSS 
      JMP C20 
* 
      JSB $LIBR 
       NOP
      LDA ENTAD,I   IF FIRST WORD OF ENTRY
      CLB 
      SSA             IS NEGATIVE, ENTRY HAS
      STB ENTAD       BEEN REMOVED. 
      JSB $LIBX 
       DEF *+1
       DEF *+1
* 
      LDA ENTAD 
      SZA 
      JMP EXIT
* 
* 
*  ENTAD IS ZERO, THEREFORE WE MUST BUILD A NEW ENTRY IN THE ACTIVE TABLE.
*  FIRST, WE NEED TO GET A RESOURCE NUMBER.  THEN WE WILL PUT TOGETHER
*  THE VOLATILE DATA IN THE RUN TABLE INTO THE TEMPORARY BUFFER AND WRITE 
*  IT OUT TO SAM, THUS ALLOCATING A CLASS NUMBER. 
* 
C20   NOP 
      JSB RNRQ      ALLOCATE AN RN
       DEF *+4        GLOBALLY. 
       DEF B20
       DEF RN 
       DEF IERR 
* 
      LDA IERR      DID WE SUCCEED? 
      CPA .4
      JMP E132        NO. 
* 
      LDA DBSCT,I     YES - SET UP VOLATILE DATA. 
      CMA,INA       USE NEGATIVE OF DATA SET
      STA TEMP2       COUNT FOR A LOOP COUNTER
      LDA TEMPS     GET ADDRESS OF TEMP.
      STA TEMP3       STORAGE AREA
      CLA,INA       START WITH DATA SET 
      STA TEMP1       NUMBER ONE. 
C21   LDA TEMPP     STORE FREE LIST COUNT AND 
      JSB PHIS1       HEAD OF EACH DATA SET INTO
      JMP C29         TEMPORARY BUFFER
      STB DSET        PRIOR TO OUTPUTTING 
      ADB .6          TO SAM. 
      LDA 1,I 
      STA TEMP3,I 
      ISZ TEMP3 
      INB 
      LDA 1,I 
      STA TEMP3,I 
      ISZ TEMP3 
      ISZ TEMP1 
      ISZ TEMP2     CONTINUE FOR ALL DATA SETS
      JMP C21         IN DATA BASE. 
* 
      LDA DBSCT,I   SET UP LENGTH 
      RAL             FOR CLASS WRITE/READ
      STA TABCT       = DATA SET COUNT * 2. 
* 
      CLA           ZERO OUT CLASS NUMBER 
      STA CLASS       FOR ALLOCATION
* 
      JSB EXEC      PERFORM CLASS WRITE/READ. 
       DEF *+8
       DEF .20
       DEF .0 
       DEF TEMPS,I
       DEF TABCT
       DEF .0 
       DEF .0 
       DEF CLASS
* 
      INA,SZA,RSS   CLASS NUMBER AVAILABLE? 
      JMP E133        NO! 
      INA,SZA,RSS   MEMORY AVAILABLE? 
      JMP E140        NO! 
* 
* 
*  NOW WE HAVE EVERYTHING WE NEED TO BUILD THE ENTRY.  SO, SEARCH THROUGH 
*  TABLE TO SEE IF SOMEONE ELSE BEAT US TO THE PUNCH AND TO GET THE FIRST 
*  FREE ENTRY IF NOT.  IF THERE IS AN ENTRY WE PUT ITS ADDRESS IN ENTAD 
*  IF NOT WE PUT THE FIRST FREE ADDRESS IN EMPAD.  ELSE, EITHER OR BOTH 
*  ARE SET TO ZERO. 
* 
      CLA 
      STA ENTAD 
      STA EMPAD 
* 
      STA TEMP1     SET TEMP1 TO 0 FOR CURNT. ENTRY CHECK 
* 
      LDB ADBRN,I   USE NEGATIVE OF # OF
      CMB,INB         ENTRIES IN TABLE
      STB TABCT       AS LOOP COUNTER.
* 
*  GO PRIVELEDGED FOR REMAINDER OF SEARCH AND/OR SET UP AS THIS IS
*  CRITICAL CODE. 
* 
      NOP 
      JSB $LIBR 
       NOP
* 
      LDA ADBRN     GET 1ST ENTRY ADDRESS AGAIN 
      INA 
C22   STA TABAD 
      LDB 0,I       IF FIRST WORD OF ENTRY IS 
      SSB             NEGATIVE, IT IS EMPTY.
      JMP C23 
      LDB .3        ELSE COMPARE NAMES. 
      STB CMPCT 
      LDB PARS
      JSB PHICM     ARE NAMES THE SAME? 
      JMP C24         NO
      LDB TABAD       YES 
      STB ENTAD         SAVE ENTRY ADDRESS. 
      ADB .5            INCREMENT USER COUNT, 
      ISZ 1,I 
      CCA               SET TEMP1 TO -1 SIGNIFYING
      STA TEMP1           CURRENT ENTRY FOUND,
      JMP C28           AND BRANCH OUT OF CRITICAL CODE.
* 
C23   LDA TABAD     HERE WHEN EMPTY ENTRY FOUND.
      LDB EMPAD     IS IT THE FIRST?
      SZB,RSS 
      STA EMPAD       YES - SAVE ITS ADDRESS
* 
C24   LDA TABAD     CONTINUE SEARCH FOR 
      ADA .6          ALL ENTRIES IN THE
      ISZ TABCT       ACTIVE TABLE. 
      JMP C22 
* 
* 
*  IF EMPAD IS ZERO AT THIS POINT, ALL WE DID WAS FOR NAUGHT.  IF NOT,
*  USE EMPAD AS NEW ENTRY.  TO BUILD THE ENTRY IN EMPAD, WE MOVE THE DATA 
*  BASE NAME, CLASS NUMBER AND RN INTO THE ENTRY THEN SET THE USER COUNT
*  TO ONE.
* 
      LDB EMPAD 
      SZB 
      JMP C27 
      LDB .131
      STA TEMP1       SET TEMP1 TO ERROR CODE 131 
      JMP C28         THEN BRANCH OUT OF CRITICAL CODE. 
* 
* 
C27   LDA PARS,I    BUILD NEW ENTRY: MOVE IN NAME,
      STA 1,I 
      INB 
      ISZ PARS
      LDA PARS,I
      STA 1,I 
      INB 
      ISZ PARS
      LDA PARS,I
      STA 1,I 
      INB 
      LDA CLASS       CLASS NUMBER
      STA 1,I 
      INB 
      LDA RN          AND RESOURCE NUMBER.
      STA 1,I 
      INB 
      CLA,INA       SET USER COUNT TO ONE.
      STA 1,I 
* 
C28   NOP 
      JSB $LIBX 
       DEF *+1
       DEF *+1
      LDB TEMP1     IF WE RAN INTO A CURRENT ENTRY
      SZB,RSS         FOR THIS DATA BASE, OR NO EMPTY ENTRY 
      JMP EXIT
      SSB 
      CLB             WE NEED TO DEALLOCATE THE 
      STB PARS+4,I    RN & CLASS WE ALLOCATED.
* 
* 
*  WE WANT TO CLEAN UP SOMEWHAT IF AN ERROR OCCURS AFTER ALLOCATING THE 
*  RN.  THIS CLEANUP JUST INVOLVES DEALLOCATING THE RN AND CLASS NUMBER 
*  IF ALLOCATED.
* 
*  FIRST THE CLASS NUMBER THEN THE RN.
* 
* 
C30   NOP 
      JSB EXEC
       DEF *+5
       DEF .21
       DEF CLASS
       DEF DCB,I
       DEF .0 
      JMP C31 
* 
E133  LDB .133      NO CLASS AVAILABLE. 
      RSS 
E140  LDB .140      NO MEMORY AVAILABLE.
C29   STB PARS+4,I
C31   NOP 
      JSB RNRQ
       DEF *+4
       DEF B40
       DEF RN 
       DEF IERR 
      JMP ERR1
*** 
*** 
* 
FMER1 CMA,INA 
      LDB 0 
      RSS 
E103  LDB .103      A DATA BASE OPEN ALREADY
      RSS 
E115  LDB .115      ILLEGAL MODE
      RSS 
E117  LDB .117      BAD SECURITY CODE 
      RSS 
E129  LDB .129      DATA BASE LOCKED OR OPEN
      RSS 
E130  LDB .130      DBINT NOT CALLED. 
      STB PARS+4,I
      CPB .130      IF ERROR 130, DCB NOT SET UP YET, 
      JMP DBOPN,I     SO DON'T ATTEMPT TO ZERO IT OUT.
      JMP ERR1
* 
* 
E116  LDB .116      BAD ROOT FILE 
      RSS 
E118  LDB .118      BAD ACCESS LEVEL
      RSS 
E132  LDB .132      NO RESOURCE NUMBER
      JMP ERROR 
* 
*** 
*** CHANGE REV 1840 
* 
*  THIS ROUTINE PERFORMS THE REMOVAL OF THE DATA BASE FROM THE ACTIVE 
*  TABLE.  THIS INVOLVES READING THE ROOT FILE INTO MEMORY AGAIN, STORING 
*  THE VOLATILE DATA IN SAM INTO THE ROOT FILE IN MEMORY AND WRITING THE
*  ROOT FILE BACK TO DISC.  THEN, WE GO PRIVELEDGED, CHECK THE ENTRY FOR
*  VALIDITY AND IF THE ENTRY CONTAINS A ZERO USER COUNT, RENDERING THE
*  DATA BASE NAME TO GARBAGE BY SETTING THE FIRST WORD OF THE ENTRY TO
*  A MINUS ONE.  THEN, WE PICK UP THE CLASS NUMBER AND RN, TURN THE IN- 
*  TERRUPT SYSTEM BACK ON AND RELEASE THOSE RESOURCES.  IF THE USER COUNT 
*  IS NOT STILL ZERO, WE DO NOT RELEASE THE RESOURCES BUT MERELY RETURN 
*  TO THE USER. 
* 
CLNUP NOP 
      LDB ENTAD     GET CLASS NUMBER AND RN 
      ADB .3          FROM ENTRY IN ACTIVE TABLE. 
      LDA 1,I 
      STA CLASS     SET SAVE BUFFER AND 
      IOR B6000       SAVE CLASS BITS 
      STA CLAS2       IN CLASS WORD.
* 
      INB 
      LDA 1,I 
      STA RN
* 
      JSB EXEC      BRING THE VOLATILE DATA IN SAM
       DEF *+5        INTO A TEMP. BUFFER.
       DEF .21
       DEF CLAS2
       DEF TEMPS,I
       DEF .100 
* 
      JSB RWNDF     REREAD THE ROOT FILE. 
       DEF *+2
       DEF DCB,I
* 
      SSA 
      JMP ERR1
* 
      JSB READF 
       DEF *+6
       DEF DCB,I
       DEF IERR 
       DEF DCRUN,I
       DEF .9999
       DEF LEN
* 
      SSA 
      JMP ERR1
* 
      CLA,INA       SET UP LOOP FOR MOVE OF 
      STA TEMP1       VOLATILE DATA FROM
      LDA DBSCT,I     SAM INTO ROOT FILE. 
      CMA,INA 
      STA TEMP2 
      LDA TEMPS 
      STA TEMP3 
* 
C50   LDA TEMPP     STORE FREE COUNT AND HEAD 
      JSB PHIS1       OF EACH DATA SET IN DATA
      JMP ERR1        BASE INTO ITS RESPECTIVE
      ADB .6          DSCB IN THE ROOT FILE.
      LDA TEMP3,I 
      STA 1,I 
      ISZ TEMP3 
      INB 
      LDA TEMP3,I 
      STA 1,I 
      ISZ TEMP3 
      ISZ TEMP1 
      ISZ TEMP2 
      JMP C50 
* 
      JSB RWNDF     WRITE THE ROOT FILE 
       DEF *+2        BACK OUT
       DEF DCB,I
* 
      SSA 
      JMP ERR1
* 
      JSB WRITF 
       DEF *+5
       DEF DCB,I
       DEF IERR 
       DEF DCRUN,I
       DEF LEN
* 
      SSA 
      JMP ERR1
* 
      JSB POST        AND MAKE SURE IT
       DEF *+2        GETS ONTO THE DISC. 
       DEF DCB,I
      JSB $LIBR     GO PRIVELEDGED AGAIN. 
       NOP
      LDB ENTAD     IF ENTRY STILL OKAY 
      LDA 1,I 
      SSA 
      JMP C51 
      ADB .5
      LDA 1,I         THEN IF USER COUNT STILL ZERO,
      SZA 
      JMP C51 
      STA ENTAD     ZERO OUT ENTAD
      ADB M1          RN
      STA 1,I 
      ADB M1          AND CLASS NUMBER
      STA 1,I 
      ADB M3          THEN PUT A MINUS ONE
      CCA             IN 1ST WORD OF ENTRY. 
      STA 1,I 
* 
C51   NOP 
      JSB $LIBX     TURN INTERRUPTS ON AGAIN. 
       DEF *+1
       DEF *+1
* 
      LDA ENTAD     DID WE REMOVE ENTRY?
      SZA 
      JMP ERR1        NO - JUST RETURN TO USER. 
      JMP C30         YES - RELEASE RESOURCES.
*** 
*** 
* 
ADBRN DEF .DBRN     ADDRESS OF ACTIVE TABLE 
TABAD NOP           ADDRESS OF CURRENT ENTRY IN ACTIVE TABLE
TABCT NOP           NUMBER OF CURRENT ENTRY IN ACTIVE TABLE 
CLASS NOP           CLASS NUMBER
RN    NOP           RESOURCE NUMBER 
DCB   NOP           RUNTABLE DATA CONTRL BLK ADDRESS
CLAS2 NOP 
ENTAD NOP 
EMPAD NOP 
TEMPS DEF *+1 
      BSS 100 
BLANK ASC 3,
BLANP DEF BLANK 
ILEV3 NOP 
ACMSK OCT 400        ACTIVITY FLAG MASK 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.15   DEC 15
.16   DEC 16
.20   DEC 20
.21   DEC 21
.32   DEC 32
.36   DEC 36
.100  DEC 100 
.103  DEC 103 
.115  DEC 115 
.116  DEC 116 
.117  DEC 117 
.118  DEC 118 
.129  DEC 129 
.130  DEC 130 
.131  DEC 131 
.132  DEC 132 
.133  DEC 133 
.140  DEC 140 
.9999 DEC 9999
M1    DEC -1
M3    DEC -3
M7    DEC -7
M8    DEC -8
M15   DEC -15 
B20   OCT 20
B40   OCT 40
B377  OCT 377 
B6000 OCT 6000
SC    NOP           SECURITY CODE 
DINX  BSS 1 
DSET  BSS 1 
IERR  BSS 1 
LEN   BSS 1 
IOPTN BSS 1         OPEN MODE 
TEMPP DEF *+1 
TEMP1 BSS 1 
TEMP2 BSS 1 
TEMP3 BSS 1 
      END 
          