ASMB,L,C,R
      HED DBOPN SUBROUTINE OF IMAGE/1000
      NAM DBOPN,7 92069-16136 REV.2040 800730 
* 
* 
******************************************************************* 
* (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. 
******************************************************************* 
* 
* 
*     SOURCE:    92069-18136
*     RELOC:     92069-16136
* 
*     PRGMR:     CEJ
*     ALTERED:   JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ 
*                JANUARY 25, 1980 TO RELEASE UNUSED FRT SPACE - CEJ 
*                FEBRUARY 22, 1980 TO ADD RA BIT TO DSCB - CEJ
*                JULY 30, 1980 TO CLOSE FILE AFTER OPEN IF NOT A
*                              TYPE 1 FILE - CEJ
* 
* 
******************************************************************* 
* 
* 
* 
*  Data Base OPeN is one of the ten user callable subroutines in the IMAGE/ 
*  1000 DBMS Library.  Its function is to open the data base root file, 
*  and prepare the necessary main memory buffers for future access to the 
*  data base. 
* 
*  The buffers that DBOPN need initialize are : 
*    1) The Run Table - 
*         an in main memory copy of the root file with additional inform- 
*         ation on the access capabilities to the entities of the data
*         base and some size parameters set.
*    2) The Record Buffer - 
*         for reading and writing entries in the data base. 
*    3) Data Set DCBs - 
*         again for reading and writing entries in the data base. 
* 
*  The user is given three access options for opening a data base.  These 
*  are identified by the DBOPN mode as follows: 
*      mode                  meaning
*      ----                  -------
*        1          shared read/write access
*        3          exclusive read/write access 
*        8          shared read-only access 
* 
*  The calling sequence for DBOPN is: 
* 
*           JSB DBOPN 
*            DEF *+5        return point
*            DEF BASE       an array containing:
*                             two ASCII blanks or a DS/1000 node # in the 
*                             first word followed by an FMP namr string 
*                             specifying at least the data base name and
*                             security code.
*                             On a successful return, DBOPN stores a data 
*                             base number in the first word of the array. 
*            DEF LEVEL      an array containing the user's levelcode word 
*                             three words long, padded by trailing blanks 
*                             if necessary. 
*            DEF MODE       Open mode as described above. 
*            DEF STAT       a ten word array in which status information
*                             is returned to the user.  This subroutine 
*                             uses only the first three words which are 
*                             as follows: 
*                               word                contents
*                               ----                --------
*                                 1         status code (0 if successful) 
*                                   if successful:
*                                 2         user's assigned access level
*                                 3         word length of Run Table
* 
      SKP 
*********************************************************************** 
*                                                                     * 
*  Run Table for IMAGE/1000 Local machine.                            * 
*                                                                     * 
*  The Run Table is comprised of the following sections:              * 
*                                                                     * 
*    1)  Data Base Control Block                                      * 
*    2)  Item Table                                                   * 
*    3)  Data Set Control Block Table                                 * 
*    4)  Data Set Info Table                                          * 
*        A)  Record Definition Table                                  * 
*        B)  Path Table                                               * 
*    5)  Sort Table                                                   * 
*    6)  Free Record Table                                            * 
*                                                                     * 
*  These sections appear in the order described.  Details of each     * 
*  section follow.                                                    * 
*                                                                     * 
*********************************************************************** 
***                                                                 *** 
*                                                                     * 
*  Data Base Control Block - one 59 word entry per data base          * 
*                                                                     * 
***                                                                 *** 
DBCBS DEC 59        Control Block Size
DBNAM DEC 0         Data Base name - 3 words
      DEC 1 
      DEC 2 
DBSCD DEC 3         Data Base Security Code (FMP) 
DBCRN DEC 4         Data Base Cartridge Number (FMP)
DBDSN DEC 5         Data Base node number (DS/1000) 
DBRSN DEC 6         Data Base resource number 
DBICT DEC 7         Data Item Count 
DBITP DEC 8         Data item table pointer 
DBSCT DEC 9         Data set count
DBSTP DEC 10        Data set control block table pointer
DBSOP DEC 11        Sort table pointer
DBFRP DEC 12        Free record table pointer 
DBLMD DEC 13        Data Base lock flag and open mode 
DBLFG EQU DBLMD     1st byte: lock flag 
DBMOD EQU DBLMD     2nd byte: open mode 
DBLVL DEC 14        Access level words - 3 words per level
DBFRL EQU DBLVL     Free record table length
DBOPT DEC 15        Optimal number of DCBs
DBMAX DEC 16        Maximum size of a data entry
DCBWS DEC 17        DCB storage area
* 
ZERO  EQU DBNAM     base of zero for future equates 
***                                                                 *** 
*                                                                     * 
*  Data Item Table - one 7-word entry per item                        * 
*                                                                     * 
***                                                                 *** 
ITELN EQU ZERO+7    item table entry length 
ITNME EQU ZERO      item name - 3 words 
ITINF EQU ZERO+3    item write/read level and type
ITRDL EQU ITINF     1st nibble: item read level 
ITWRL EQU ITINF     2nd nibble: item write level
ITTYP EQU ITINF     2nd byte: item type 
ITSET EQU ZERO+4    set count and 1st set number
ITSCT EQU ITSET     1st byte: set count 
ITSNO EQU ITSET     2nd byte: set number
ITWRC EQU ZERO+5    write/read bits and element count 
ITECT EQU ITWRC     2nd byte: element count 
ITLNG EQU ZERO+6    item length in words
***                                                                 *** 
*                                                                     * 
*  Data Set Control Block Table - one 17 word entry per set           * 
*                                                                     * 
***                                                                 *** 
DSLNG EQU ZERO+17   table entry length
DSNME EQU ZERO      set name - 3 words
DSCRN EQU ZERO+3    cartridge reference number
DSINF EQU ZERO+4    W/R bits, set type and media length 
DSTYP EQU DSINF     1st byte, 2nd nibble: set type
DSMDL EQU DSINF     2nd byte: media record length 
DSDRL EQU ZERO+5    data record length
DSFPC EQU ZERO+6    field and path counts 
DSFCT EQU DSFPC     1st byte: # fields per entry
DSPCT EQU DSFPC     2nd byte: # paths per entry 
DSITP EQU ZERO+7    data set info table entry pointer 
DSCAP EQU ZERO+8    doubleword data set capacity
DSCPN EQU ZERO+10   current path info 
DSCCT EQU DSCPN     1st byte: search item number
DSPAN EQU DSCPN     2nd byte: path # of search item 
DSRCN EQU ZERO+11   doubleword current record number
DSBWN EQU ZERO+13   doubleword previous record number 
DSFWN EQU ZERO+15   doubleword next record number 
***                                                                 *** 
*                                                                     * 
*  Data Set Info Table - one Record Definition Table and one Path     * 
*    Table per data set                                               * 
*                                                                     * 
***                                                                 *** 
*                                                                     * 
*  Record Definition Table - one 1-byte entry per field               * 
*                                                                     * 
***                                                                 *** 
RDLNG EQU ZERO+1    entry length (number of words)
RDINF EQU ZERO      field info (two fields per word)
RDIT1 EQU RDINF     1st byte: item # for field n
RDIT2 EQU RDINF     2nd byte: item # for field n+1
***                                                                 *** 
*                                                                     * 
*  Path Table - one 2-word entry per path                             * 
*                                                                     * 
***                                                                 *** 
PTLNG EQU ZERO+2    entry length
PTINF EQU ZERO      path information - item & set numbers 
PTSIN EQU PTINF     1st byte: detail's search item # for path 
PTDSN EQU PTINF     2nd byte: related set's number
PTSRT EQU ZERO+1    sort item for path
***                                                                 *** 
*                                                                     * 
*  Sort Table - one 1-word entry per item and set                     * 
*                                                                     * 
***                                                                 *** 
STITS EQU ZERO      beginning of item entries 
STSTS NOP           beginning of set entries
***                                                                 *** 
*                                                                     * 
*  Free Record Table - one 4-word entry per set                       * 
*                                                                     * 
***                                                                 *** 
FRLNG EQU ZERO+4    length of entry 
FRRCT EQU ZERO      doubleword free record count
FRPTR EQU ZERO+2    doubleword first free record
*                                                                     * 
*********************************************************************** 
***                                                                 *** 
*                                                                     * 
A     EQU 0 
B     EQU 1 
* 
      ENT DBOPN 
      EXT .CMW,.ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDCT,DBIDS 
      EXT DBDMX,DBDSZ,DBFDI,DBFDS,DBFRT,DBFWZ,DBPAR,DBRBL 
      EXT DBRBP,DBRTP,EXEC,GETBF,OPEN,PNAME,RBOPN,RETBF 
      EXT ECLOS,EREAD,RMPAR,TRIM
* 
BASE  NOP 
LEVEL NOP 
MODE  NOP 
STAT  NOP 
* 
*  Get true parameter and return point addresses. 
* 
DBOPN NOP 
      JSB .ENTR 
       DEF BASE 
* 
*  Make sure all the parameters are there.
* 
      LDA STAT
      SZA,RSS 
      JMP OPN28     Missing parameter.
* 
*  Ask DBIDS to check the BASE parameter to see if the data base is on
*  a remote machine.
* 
      CLA           A = 0 signifies DBOPN calling.
      JSB DBIDS 
       DEF *+2
       DEF BASE,I 
* 
      JMP E103      Error return - invalid BASE param.
      JMP LOCAL     Data base is local return.
* 
      JSB RBOPN     Data base is remote return. 
       DEF *+5      Ask RBOPN to handle 
       DEF BASE,I     this request. 
       DEF LEVEL,I
       DEF MODE,I 
       DEF STAT,I 
      JMP OPN28     Return to user. 
* 
*  The data base parameter contains a root file namr in its 2nd through 
*  ? words.  Parse it into its components.  The file name and security
*  code must be there, cartridge number is optional.
* 
LOCAL JSB DBPAR     DBPAR does the parse. 
       DEF *+3
       DEF NAME 
       DEF BASE,I 
      JMP E103      Error return - illegal base param.
* 
*  Ask DBFRT to see if the data base specified by the user in BASE is al- 
*  ready open to this program.  If so, we cannot open it again.  If not,
*  DBFRT will pass us the index into the Run Table pointer table for the
*  first free space in the table.  This we save off as the data base num- 
*  ber on a successful open.
* 
      CLA           A = 0 tells DBFRT we
      JSB DBFRT       are DBOPN.
       DEF *+4
       DEF BASE,I 
       DEF NAME 
       DEF CRN
* 
      SSA,RSS       Did DBFRT find the R.T.?
      JMP E150        Yes - cannot open it again. 
* 
      LDA AIRUN       No - get index from AIRUN 
      STA DBNUM         and save. 
      CLA 
      STA AIRUN 
* 
*  Check that the open mode specified by the user is valid, i.e. that it
*  is in the set [1,3,8]. 
* 
      LDA MODE,I
      CPA D1
      RSS 
      CPA D3
      RSS 
      CPA D8
      RSS 
      JMP E115      No match - bad mode.
* 
*  Merge the open mode in with the function code for DBCOP. 
* 
      LDB D1        Function code for a check is 1. 
      BLF,BLF       Function code in 1st byte,
      IOR B           open mode in 2nd. 
      STA FC/MD 
* 
*  Ask DBCOP to check the data base open mode for obtainability.  DBCOP 
*  supervises data base opens for the proper mix of open modes. 
* 
      JSB EXEC      Schedule DBCOP
       DEF *+8        on queue with wait
       DEF NA23       and no abort. 
       DEF DBCOP
       DEF FC/MD    DBCOP needs: function code/open mode
       DEF NAME                  data base name 
       DEF NAME+1 
       DEF NAME+2 
       DEF CRN                   cartridge number 
      JMP E140      Here on abortion. 
* 
* 
*  Get returned status code from DBCOP.  If zero all is go.  If non-zero
*  it is proper IMAGE error code to return to user. 
* 
      JSB RMPAR 
       DEF *+2
       DEF ERROR
* 
      LDA ERROR 
      SZA 
      JMP ERREX 
* 
*  Set up the data base DCB for the open call for this root file by zero
*  filling its first 16 words.
* 
      JSB DBFWZ 
       DEF *+3
       DEF D16
       DEF DBDCB
* 
*  Set up the OPEN call by checking the open MODE specified by the user.
*  If mode 3, the root file is open exclusively, else the root file is
*  opened non-exclusively.  Root file always opened with update option. 
* 
      LDA IOPTN 
      LDB MODE,I
      CPB D3
      RSS 
      IOR NEXCL 
      STA PATCH 
* 
*  Ask the FMP to open the root file for us.
* 
      JSB OPEN
       DEF *+7
       DEF DBDCB,I
       DEF ERROR
       DEF NAME 
       DEF PATCH    options stored in PATCH 
       DEF SC 
       DEF CRN
* 
      CPA D1        Did OPEN succeed in 
      JMP OPN1        opening a type 1 file?
* 
      SSA,RSS         No - error encountered? 
      JMP E116          No - invalid root file. 
* 
      CPA M8            Yes - locked or open root file? 
      JMP E129            Yes 
      CPA M7              No - security violation?
      JMP E117              Yes 
      CPA M6                No - non-existant file? 
      JMP E119                Yes 
      JMP ERREX               No - return FMP error 
* 
*  From this point on we will jump to a clean-up routine in case of an
*  error.  CLNUP uses SAVE as a check on the record buffer.  We will set
*  it to -1 at this point to inform CLNUP we do not need to rewind the re-
*  cord buffer in case of an error.  CLNUP also uses DCBFL as a flag that 
*  DCBs have been allocated.  We will set it to zero to signify that no 
*  DCB space has been allocated for this data base. 
* 
OPN1  CLA 
      STA DCBFL 
      CMA 
      STA SAVE
* 
*  Now, read in the five overhead words from the first record of the root 
*  file.  These words contain:
*    1) The record number (single integer) at which the data base direc-
*       tory starts.
*    2) The length of the directory.
*    3) The length of the Free Record Table.
*    4) The optimum number of DCBs for the data base. 
*    5) The length of the longest entry in the data base. 
* 
      JSB EREAD 
       DEF *+5
       DEF DBDCB,I
       DEF ERROR
       DEF RTREC+1
       DEF D5 
* 
      SSA           Any error?
      JMP CLNUP       Yes - go clean up.
* 
*  We will do a couple of checks to see if the root file we just opened 
*  is valid.  First, the 1st word of overhead (read into RTREC+1) should
*  be either 3 or 4.  Second, the 4th word of overhead (read into #DCBS)
*  should be within [1,17]. 
* 
      LDA D116
      LDB RTREC+1 
      CPB D3
      RSS 
      CPB D4
      RSS 
      JMP CLNUP 
* 
      LDB #DCBS 
      CMB,INB 
      SSB,RSS 
      JMP CLNUP 
      ADB D17 
      SSB 
      JMP CLNUP 
* 
*  RTLEN now contains the length of the Run Table minus the Free Record 
*  Table.  FRTLN contains the Free Record Table length, round this up to
*  the nearest multiple of 128.  Total the two (i.e. RTLEN and rounded
*  FRTLN).  Get the primary pointer address for the Run Table by adding the 
*  data base number (passed to us long ago by DBFRT) to the address of the
*  Run Table pointer table and subtracting one.  Then ask GETBF for a 
*  slice of memory large enough for the total Run Table.
* 
      CCA           The reason we need to round up to a 
      ADA FRTLN       multiple of 128 is that the FMP expects 
      ADA D128        a multiple of 128 words to be written to
      CLB             a type 1 file.  We get the extra memory 
      DIV D128        (even though it is wasted) in order 
      MPY D128        to avoid aborting with a memory error 
      ADA RTLEN       when writing the FRT to disc. 
      STA TEMP
* 
      CCA 
      ADA DBRTP 
      ADA DBNUM 
      STA RTPTR 
* 
      JSB GETBF 
       DEF *+4
       DEF TEMP 
       DEF RTPTR,I
       DEF ERROR
* 
      SSA,RSS       Did GETBF succeed?
      JMP OPN2        Yes - continue on.
      LDA D128        No - not enough room
      JMP CLNUP         for Run Table.
* 
*  We've got the space, so trim off any excess allocated for the Free 
*  Record Table.  To do this, compute the space we will actually use
*  and call TRIM to trim off the rest.
* 
OPN2  LDA FRTLN 
      ADA RTLEN 
      STA TEMP      TEMP = actual size of used space
* 
      JSB TRIM      TRIM trims off the excess 
       DEF *+3
       DEF RTPTR,I  It needs: pointer to allocated space
       DEF TEMP               length to keep
* 
      SSA,RSS       If TRIM returns any error,
      JMP OPN2A 
      LDA D128        no memory error!
      JMP CLNUP 
* 
*  Read the Run Table into the remaining space.  First, we bring in the 
*  directory (that is the Run Table minus FRT) then we bring in the 
*  Free Record Table. 
* 
OPN2A LDA RTPTR 
      STA AIRUN     Point AIRUN to the pointer. 
      LDA A,I       Point RTPTR to the Run Table. 
      STA RTPTR 
* 
      JSB EREAD 
       DEF *+7
       DEF DBDCB,I
       DEF ERROR
       DEF RTPTR,I
       DEF RTLEN
       DEF TEMP 
       DEF RTREC
* 
      SSA           If any error
      JMP CLNUP       clean up the process. 
* 
      LDA RTPTR     Calculate address for FRT.
      ADA RTLEN 
      STA RTPTR 
* 
      JSB EREAD 
       DEF *+7
       DEF DBDCB,I
       DEF ERROR
       DEF RTPTR,I
       DEF FRTLN
       DEF TEMP 
       DEF FRTRC    FRT starts in record # 2. 
* 
      SSA           Any error?
      JMP CLNUP       Yes - clean up! 
* 
      LDB AIRUN,I     No - set up the pointer to the
      ADB DBFRP         FRT in the Run Table (12th word). 
      LDA RTLEN         This is same as directory length. 
      STA B,I 
* 
*  Now, we have the root file in memory.  Check that the security code
*  specified by the user matches the one in the root file to make sure
*  no-one has tampered with it and get the cartridge number from the Run
*  Table and put it in CRN. 
* 
      LDB AIRUN,I 
      ADB DBSCD 
      LDA SC
      CPA B,I 
      JMP OPN3
      LDA D117
      JMP CLNUP     Not the same. 
* 
OPN3  INB           Security codes the same,
      LDA B,I         make sure we've got the 
      STA CRN         cartridge number. 
* 
*  Now, we need to get a record buffer of the proper size.  First, let's
*  see if one already exists and if so, if it is large enough.  The record
*  buffer must be as long as the longest entry in the data base.  The 
*  length is in ENTLN from the overhead read. 
* 
      LDA DBRBL     Record buffer length is zero
      STA SAVE        if no record buffer.
      SZA,RSS 
      JMP OPN4
* 
      CMA           Not zero - is it big enough?
      ADA ENTLN 
      SSA 
      JMP OPN6        Yes - skip reallocation.
* 
      JSB RETBF       No - deallocate it. 
       DEF *+2
       DEF DBRBP
* 
      SSA,RSS       Did deallocate succeed? 
      JMP OPN4        Yes 
      LDA D160        No - corrupt memory error 
      JMP CLNUP         clean up. 
* 
*  Join processing here for allocation of record buffer from no record
*  buffer and from deallocation of existing record buffer.  Old record
*  size was saved for CLNUP above, so now set the record buffer length to 
*  zero.  Then try to allocate one of the proper size.
* 
OPN4  CLA 
      STA DBRBL 
* 
      JSB GETBF 
       DEF *+4
       DEF ENTLN
       DEF DBRBP
       DEF ERROR
* 
      SSA,RSS       Did GETBF succeed?
      JMP OPN5
      LDA D128        No - go clean up. 
      JMP CLNUP 
* 
OPN5  LDA ENTLN       Yes - set DBRBL to length of
      STA DBRBL         new record buffer.
* 
*  Now, we want to allocate as many 272 word DCBs as possible up to the 
*  optimal number of DCBs for this data base.  First, we'll check the 
*  number of DCBs already allocated.  If this is greater than or equal
*  to the number we would like (#DCBS from root file overhead) we are 
*  all set.  If there are no DCBs already allocated we must be able to
*  allocate at least one DCB for DBOPN to succeed.  Also, if there are
*  no DCBs allocated, we set DCBFL to -1 to signify to CLNUP that all 
*  DCBs allocated when it is called must be deallocated, otherwise no 
*  deallocation is done.
* 
OPN6  CCB 
      LDA DBDCT 
      SZA,RSS 
      STB DCBFL 
      CMA 
      ADA #DCBS 
      SSA           Are there enough DCBs alreadY?
      JMP OPN10       Yes - need allocate no more.
* 
*  Loop on the number of DCBs we would like over the number we have,
*  searching for an empty DCB pointer in the DCB pointer table then call- 
*  ing GETBF to allocate the new DCB.  If GETBF ever comes back unsuc-
*  cessful and we started with none allocated, we check to make sure that 
*  we were able to allocate at least one DCB.  If not, we cannot complete 
*  the DBOPN and undo everything we have already done.
* 
*  First, we need to set up the loop parameters.
* 
      INA           Use negative of # of DCBs we
      CMA,INA         would like over the # we
      STA CNTR        have now as loop counter. 
* 
      LDB DBDCP     Get address of DCB
      STB TEMP        pointer table.
* 
      LDB DBDMX     Use negative # of entries 
      CMB,INB         in DCB pointer table as 
      STB CNTR2       loop counter also.
* 
*      BEGIN LOOP 
*  For each DCB we would like:
*    1) Find an empty DCB pointer, 1st word of DCB pointer table entry
*       is zero if pointer empty. 
* 
OPN7  LDA TEMP,I
      SZA,RSS 
      JMP OPN8
* 
      ISZ TEMP
      ISZ TEMP
      ISZ CNTR2     End of pointer table? 
      JMP OPN7        No - try this entry 
      JMP OPN9        Yes - cannot allocate more DCBs 
* 
*    2) Try to allocate DCB 
* 
OPN8  ISZ TEMP      TEMP -> DCB pointer.
      JSB GETBF 
       DEF *+4
       DEF DBDSZ    Changeable size of DCBs 
       DEF TEMP,I 
       DEF ERROR
* 
*    3) If DCB allocated, set first word of entry to -1 to indicate a 
*       DCB pointer there and zero-fill the first 16 words of the DCB 
*       to avoid conflicts with whatever may be in memory and legitimate
*       FMP values.  If DCB not allocated jump to check for at least one
*       DCB allocated.
* 
      SSA 
      JMP OPN9
* 
      CCB 
      CCA 
      ADA TEMP
      STB A,I 
* 
      JSB DBFWZ 
       DEF *+3
       DEF D16
       DEF TEMP,I 
* 
*    4) Continue with next DCB we would like. 
* 
      ISZ TEMP
      ISZ DBDCT     Increment DCB count.
      ISZ CNTR      Done with number we want? 
      JMP OPN7
      JMP OPN10       Yes success!
* 
*      END OF LOOP
* 
* 
*  We come here when: 1) end of DCB pointer table is found before we could
*  allocate all the DCBs we wanted or 2) end of free memory is found be-
*  fore we could allocate all the DCBs we wanted.  Make sure there is at
*  least one DCB allocated. 
* 
OPN9  LDA D128      If not even one DCB 
      LDB DBDCT       a not enough memory error.
      SZB,RSS 
      JMP CLNUP 
* 
*  All memory allocation is done, there should be no more compaction. 
*  So, we want AIRUN to contain the Run Table address (rather than the
*  address of the address it contains now) but need to save the address 
*  of the address in case of a future clean up.  So, first set AIRUN then 
*  we want to initialize the Run Table for this particular user and open. 
*  Put the first word of the base parameter in the 6th word of the DBCB.
*  Then save the words/no level words flag in the 14th word of the DBCB and 
*  put the open mode in the same word of the DBCB (low order byte) zeroing
*  the lock flag (high order byte of same word).
* 
OPN10 LDB AIRUN 
      STB RTPTR 
      LDB B,I 
      STB AIRUN 
* 
      ADB DBDSN 
      LDA BASE,I
      STA B,I 
* 
      ADB D8
      LDA B,I 
      STA TEMP
* 
      LDA MODE,I
      STA B,I 
* 
*  Determine user's access level by comparing the level code word given 
*  us in LEVEL to the code words in the DBCB.  The first match gives us 
*  the level.  If no match, the user has level zero.  If no level code
*  words in DBCB, the user has level 15.  We can check for no level code
*  words by looking at the flag we saved in TEMP.  If flag = TRUE (0) 
*  there are level code words and we must do comparison search.  If flag
*  = FLASE (-1) there are no level code words and the user automatically
*  has level of 15. 
* 
      LDA D15 
      ISZ TEMP
      CMA,INA,RSS 
      JMP OPN15     No code words.
      STA CNTR      Set loop counter to -15.
* 
*  If the first word of the user supplied LEVEL code word is blank, we
*  will assign an access level of zero.  We make this check in case the 
*  entire code word array is blank filled so the blanks will not match
*  the first level in the DBCB which does not contain a code word.  DBDS
*  fills undefined level code words with blanks.
* 
      CLA 
      LDB LEVEL,I 
      CPB BLNKS 
      JMP OPN15 
* 
*  There are levels and user specified code word appears okay.  Try to
*  find a match.
* 
      LDB AIRUN     Loop on each level code word
      ADB DBLVL       (15 in all) comparing user specified
      STB TEMP        word with that in DBCB. 
* 
OPN13 LDA LEVEL 
      JSB .CMW
       DEF D3 
       DEC 0
      JMP OPN14     Code words match. 
* 
      NOP 
      LDB TEMP      No match try next one.
      ADB D3
      STB TEMP
* 
      ISZ CNTR      If there is a next one. 
      JMP OPN13 
* 
      CLA           No match - user has level of zero.
      JMP OPN15 
* 
OPN14 LDA CNTR      A match - get level by adding 
      ADA D16         16 to loop counter. 
* 
OPN15 STA LEVEL     Save access level in LEVEL. 
* 
*  Now, we need to determine the access the user has to each item in the
*  data base and set the Write and Read bits in the item's entry in the 
*  Item Table.  We do this by setting up a loop on the number of items
*  in the Run Table.
* 
      CLA,INA       Set 1st item # to one.
      STA ITEM
* 
      LDB AIRUN     Use negative of # of items
      ADB DBICT       in data base as a loop counter. 
      LDA B,I 
      CMA,INA 
      STA CNTR
* 
      CCA           Set an accessible item flag 
      STA NACC        to FALSE. 
* 
*      BEGIN LOOP 
*  For each item in data base:
* 
*    1) Get relative Item Table entry address through DBFDI.  Then get
*       true address by adding to address of Run Table. 
* 
OPN16 JSB DBFDI 
       DEF *+5
       DEF ITEM 
       DEF ITMNO
       DEF TEMP 
       DEF ADDRS
* 
      LDB AIRUN 
      ADB ADDRS 
* 
*    2) Check read and write levels in entry against LEVEL.  If LEVEL < 
*       read level, leave both W & R bits in entry clear.  If LEVEL >=
*       read level set an accessible item flag to TRUE, then if LEVEL >=
*       write level set both W & R bits in entry, else clear W bit and
*       set R bit.
* 
      ADB ITINF 
      LDA B,I 
      ALF 
      AND NIBBL 
      CMA,INA 
      ADA LEVEL     LEVEL >= read level?
      SSA 
      JMP OPN18       No - leave bits clear.
* 
      ISZ NACC        Yes - make an accessible item 
      NOP               flag non-negative.
* 
      LDA MODE,I    If open mode = 8, 
      CPA D8
      JMP OPN17       no need to check write level. 
* 
      LDA B,I 
      ALF,ALF 
      AND NIBBL 
      CMA,INA 
      ADA LEVEL     LEVEL >= write level? 
      SSA 
      JMP OPN17 
* 
      LDA WRITE       Yes - set both bits.
      RSS 
OPN17 LDA READ        No - set R bit only.
* 
      ADB D2
      IOR B,I 
      STA B,I 
* 
OPN18 ISZ ITEM      Get next item's number
      ISZ CNTR        if there is one 
      JMP OPN16       and check it. 
* 
*      END OF LOOP
* 
*  If an accessible item flag is still FALSE (-1), user has no access to
*  anything in the data base
* 
      ISZ NACC
      RSS 
      JMP E153
* 
*  Now, we need to determine the access the user has to each data set in
*  the data base and set the Write and Read bits in the set's entry in the
*  Data Set Control Block Table entry for the set.  We do this by setting 
*  up a loop on the number of sets in the Run Table.
* 
      CLA,INA       Set 1st set # to one. 
      STA SET 
* 
      LDB AIRUN     Use negative of # of sets 
      ADB DBSCT       in base as a loop counter.
      LDA B,I 
      CMA,INA 
      STA CNTR
* 
*      BEGIN LOOP 
*  For each set in data base: 
* 
*    1) Get relative DSCB address through DBFDS then get true address by
*       adding to address of Run Table. 
* 
OPN19 JSB DBFDS 
       DEF *+5
       DEF SET
       DEF SETNO
       DEF TEMP 
       DEF ADDRS
* 
      LDB ADDRS 
      ADB AIRUN 
      STB ADDRS 
* 
*    2) Get # fields/entry of data set for an inner loop counter. 
* 
      ADB DSFCT 
      LDA B,I 
      ALF,ALF 
      AND LOBYT 
      CMA,INA 
      STA CNTR2 
* 
*    3) Get address of set's Record Definition Table
* 
      INB 
      LDA B,I 
      ADA AIRUN 
      STA RDTAD 
* 
*    4) Set non-writeable flag, clear inaccessible flag, set all
*       readable flag.
* 
      CLA 
      STA NACC
      CMA 
      STA NWRT
      STA ALRED 
* 
*    5) For each item in RDT, check accessibility of item through DBFDI.
*       If item non-writeable, clear non-writeable flag.  If item readable
*       set inaccessible flag.  If item not readable, clear all readable
*       flag. 
* 
OPN20 STA FIRST     Set using 1st byte flag.
* 
      LDA RDTAD,I   Each item in RDT takes one byte 
      ALF,ALF         get item # from 1st byte. 
OPN21 AND LOBYT 
      STA ITEM
* 
      JSB DBFDI 
       DEF *+5
       DEF ITEM 
       DEF ITMNO
       DEF TYPE 
       DEF TEMP 
* 
      LDA TYPE      If TYPE > 0 
      CMA,INA         item is inaccessible. 
      SSA,RSS 
      JMP OPN2B 
      ISZ ALRED     Since it's inaccessible,
      NOP             clear all readable flag.
      JMP OPN22 
OPN2B SZA,RSS       If TYPE < 0 
      ISZ NWRT        item is writeable 
      NOP 
      CCA 
      STA NACC
* 
OPN22 ISZ CNTR2     Done with all items?
      RSS             No
      JMP OPN24       Yes - get out of inner loop.
* 
      ISZ FIRST     Were we on first byte?
      JMP OPN23 
      LDA RDTAD,I     Yes - get 2nd byte
      JMP OPN21         and try it. 
* 
OPN23 ISZ RDTAD       No - get 1st byte of next 
      CCA               word and try it.
      JMP OPN20 
* 
*    5) If inaccessible flag still clear leave both W & R bits clear. 
*       If open mode = 8, no need to check NWRT flag since user cannot
*       write anything.  Else, if NWRT is clear, set R bit only else
*       set both bits.  If all readable flag still set, set RA bit also.
* 
OPN24 LDB NACC
      SZB,RSS 
      JMP OPN26 
* 
      LDB MODE,I
      CPB D8
      JMP OPN25 
* 
      LDB NWRT
      SSB,RSS 
      JMP OPN25 
      LDA WRITE 
      RSS 
OPN25 LDA READ
      LDB ALRED 
      SSB 
      IOR AREAD 
* 
      LDB ADDRS 
      ADB DSINF 
      IOR B,I 
      STA B,I 
* 
OPN26 ISZ SET       Get next set's number 
      ISZ CNTR        if there is one 
      JMP OPN19       and check it. 
* 
*  All there is left to initializing the Run Table now is setting the root
*  file overhead and 16 FMP words in the DBCB 
* 
      LDB AIRUN 
      ADB DBFRL     Free Record Table legnth
      LDA FRTLN       in 15th word. 
      STA B,I 
* 
      INB           Optimal # of DCBs 
      LDA #DCBS       in 16th word. 
      STA B,I 
* 
      INB           Length of longest entry 
      LDA ENTLN       in 17th word. 
      STA B,I 
* 
      INB           16 FMP words from DCB 
      LDA DBDCB       in 18th through 33nd
      JSB .MVW        words.
       DEF D16
       DEC 0
* 
*  Run Table initialization is complete.  Now, we need to schedule DBCOP
*  to add us to the co-ordinating table.  If this succeeds, we are home 
*  free.  If it does not succeed, we need to undo everything we've done 
*  so far.
* 
*  First, to call DBCOP, we need to merge the open mode in with the func- 
*  tion code for adding an entry to the co-ordinating table.
* 
      LDB D2        Function code for adding an 
      BLF,BLF         entry is 2.  Function code
      LDA MODE,I      in 1st byte, open mode
      IOR B           in 2nd byte.
      STA FC/MD 
* 
*  Next, get this program's name.  We send this to DBCOP as the optional
*  buffer in the EXEC scheduling call.
* 
      JSB PNAME 
       DEF *+2
       DEF PROGN
* 
      JSB EXEC
       DEF *+10 
       DEF NA23 
       DEF DBCOP
       DEF FC/MD
       DEF NAME 
       DEF NAME+1 
       DEF NAME+2 
       DEF CRN
       DEF PROGN
       DEF D3 
      JMP ADDER     Abortion return point.
* 
      JSB RMPAR 
       DEF *+2
       DEF ERROR
* 
      LDA ERROR     If DBCOP returns an error - 
      SZA             it is proper IMAGE code.
      JMP COPER 
* 
*  If the open mode is 1, DBCOP also returned the data base RN in RN. 
*  Put it into the DBCB (7th word). 
* 
      LDA MODE,I
      CPA D1
      RSS 
      JMP OPN27 
      LDB AIRUN 
      ADB DBRSN 
      LDA RN
      STA B,I 
* 
*  We have a successful DBOPN.  Put the data base pointer table index in
*  the first word of the base parameter and set up the status array as
*  follows: 
*      word                 contents
*      ----                 --------
*        1         zero 
*        2         user's assigned access level 
*        3         word length of Run Table 
* 
*  Then, return to the user.
* 
OPN27 LDA DBNUM 
      STA BASE,I
* 
      CLA 
      STA STAT,I
      ISZ STAT
      LDA LEVEL 
      STA STAT,I
      ISZ STAT
      LDA RTLEN 
      ADA FRTLN 
      STA STAT,I
* 
OPN28 CLA           Set STAT to zero
      STA STAT        for param check on next call. 
      JMP DBOPN,I 
* 
*  Error return points before clean up. 
* 
ERREX SSA           A = error code, if negative 
      CMA,INA         make it positive. 
      RSS 
E103  LDA D103      Illegal BASE parameter. 
      RSS 
E115  LDA D115      Illegal DBOPN mode. 
      RSS 
E117  LDA D117      Bad security code.
      RSS 
E119  LDA D119      Root file non-existant. 
      RSS 
E129  LDA D129      Root file opened exclusively. 
      RSS 
E140  LDA D140      Cannot schedule DBCOP.
      RSS 
E150  LDA D150      Data base already open to user. 
      STA STAT,I
      JMP OPN28 
* 
*  The following error return point is seperated from the others because
*  the file which we opened expecting a root file must be closed. 
* 
E116  JSB ECLOS 
       DEF *+2
       DEF DBDCB,I
* 
      LDA D116      File specified is not a root file.
      STA STAT,I
      JMP OPN28 
* 
*  The following error return points are separate from all the others 
*  because they are errors which occur after AIRUN has been set to the
*  address of the Run Table (rather than the address of the address) yet
*  the clean up routine expects AIRUN in the latter state.
* 
E153  LDA D153      User has NO access to anything in d.b.
      RSS 
ADDER LDA D140      Abortion on a DBCOP schedule. 
COPER LDB RTPTR     Restore AIRUN to address of address of
      STB AIRUN       Run Table and branch to CLNUP.
      JMP CLNUP 
      SKP 
* 
*  The following code is the clean up routine which rewinds everything
*  DBOPN has done to change memory and disc data structures.  There are 
*  four major points at which we can enter the clean up routine.  The 
*  first is after the root file has been opened but no memory has been
*  allocated for the data base.  The second is after the memory for the 
*  Run Table has been allocated but before the record buffer has been 
*  altered.  The third is after the record buffer has been altered.  The
*  forth is after any DCB has been allocated and there were no DCB(s) from
*  any previous DBOPN.
* 
*  These points are signified by: 
*    1) AIRUN = 0 
*    2) AIRUN NE 0, and SAVE = -1 
*    3) SAVE NE -1, and SAVE NE DBRBL and DCBFL = 0 
*    4) DCBFL = -1
* 
*  We will process these backwards since 3 presupposes the rewind for 2 
*  which presupposes the rewind for 1.
* 
CLNUP SSA           On entry to clean up
      CMA,INA         A = error code
      STA STAT,I      make sure it's positive.
* 
*  First ,see if DCBFL = -1.  If so, any DCBs allocated must be deallocated.
* 
      ISZ DCBFL 
      JMP CLN0      No DCB clean up.
* 
*  Deallocation will be done by looping on each entry in the DCB pointer
*  table.  If a DCB is pointed to by the entry (1st word of entry = -1) 
*  the DCB is deallocated.
* 
      LDA DBDMX     Use # entries in table
      CMA,INA         as loop counter.
      STA CNTR
* 
      LDA DBDCP     Get address of DCB
      STA TEMP        pointer table.
* 
*    BEGIN LOOP 
* 
CLND1 LDA TEMP,I
      ISZ TEMP
      INA,SZA 
      JMP CLND2 
* 
      JSB RETBF 
       DEF *+2
       DEF TEMP,I 
* 
      SSA 
      JMP CLND2     Ignore any errors.
      CLA 
      CCB           If no error, set 1st word 
      ADB TEMP        of entry to zero. 
      STA B,I 
* 
      CCA 
      ADA DBDCT     Decrement DCB count 
      STA DBDCT 
* 
CLND2 ISZ TEMP      Get next entry if there 
      ISZ CNTR        is one, and continue. 
      JMP CLND1 
* 
*    END LOOP 
* 
* 
*  Second, see if SAVE NE -1, and if so, see if SAVE = DBRBL.  If not,
*  record buffer has been altered.
* 
CLN0  LDA SAVE
      INA,SZA,RSS 
      JMP CLN2      Save = -1 
* 
      LDA SAVE
      CPA DBRBL 
      JMP CLN2      SAVE = DBRBL
* 
*  Record buffer has been altered.  Deallocate the new one and if old 
*  record buffer size non-zero, allocate a record buffer of old size. 
* 
      JSB RETBF 
       DEF *+2
       DEF DBRBP
* 
      SSA           If any error, 
      JMP CLN3        ignore and go to point 2. 
* 
      LDB SAVE      If no old record buffer 
      SZB,RSS         need not reallocate one.
      JMP CLN1
* 
      JSB GETBF     Else, get a record buffer 
       DEF *+4        of old size.
       DEF SAVE 
       DEF DBRBP
       DEF ERROR
* 
      CLB           If any error ignore and 
      SSA,RSS         set record buffer size
      LDB SAVE        to zero.  Else set record 
CLN1  STB DBRBL       buffer size to old size.
      JMP CLN3
* 
*  Third, see if AIRUN = 0.  If not, Run Table space has been allocated.
* 
CLN2  LDA AIRUN 
      SZA,RSS 
      JMP CLN4
* 
*  Run Table allocated, deallocate it ignoring any errors.
* 
CLN3  JSB RETBF 
       DEF *+2
       DEF AIRUN,I
* 
*  The root file has always been opened by the time we reach CLNUP, so
*  no check is necessary, just close it ignoring any errors and return to 
*  user.
* 
CLN4  JSB ECLOS 
       DEF *+2
       DEF DBDCB,I
* 
      JMP OPN28 
      SKP 
* 
*  Constants and variables. 
* 
M8    DEC -8
M7    DEC -7
M6    DEC -6
D1    EQU ZERO+1
D2    EQU ZERO+2
D3    EQU ZERO+3
D4    EQU ZERO+4
D5    EQU ZERO+5
D8    EQU ZERO+8
D15   EQU ZERO+15 
D16   EQU ZERO+16 
D17   EQU ZERO+17 
D103  DEC 103 
D115  DEC 115 
D116  DEC 116 
D117  DEC 117 
D119  DEC 119 
D128  DEC 128 
D129  DEC 129 
D140  DEC 140 
D150  DEC 150 
D153  DEC 153 
D160  DEC 160 
* 
NIBBL OCT 17
NA23  OCT 100027
LOBYT OCT 377 
BLNKS ASC 1,
DBCOP ASC 3,DBCOP 
WRITE OCT 140000
READ  OCT 040000
AREAD OCT 020000
NEXCL OCT 1 
IOPTN OCT 2 
* 
DBNUM NOP 
FIRST NOP 
ITEM  NOP 
SET   NOP 
ADDRS NOP 
STCAR NOP 
TEMP  NOP 
CNTR  NOP 
FC/MD NOP 
NAME  BSS 3         } NOTE:  Do not change the order
TYPE  NOP           }   of these parameters.  This
SC    NOP           }   is the 10 word array for
CRN   NOP           }   NAMR and parameters for 
ERROR NOP           }   return from DBCOP.
RN    NOP           } 
NWRT  NOP           } 
NACC  NOP           } 
PATCH NOP           } 
PROGN EQU ERROR     Used for name from PNAME call.
RTREC DEC 0,0       } NOTE: Do not change the order 
RTLEN NOP           }  of these parameters. 
FRTLN NOP           }  Overhead words from
#DCBS NOP           }  root file put here.
ENTLN NOP           } 
DCBFL NOP 
RTPTR NOP 
FRTRC DEC 0,2 
ALRED NOP 
SAVE  NOP 
CNTR2 NOP 
RDTAD NOP 
ITMNO NOP 
SETNO NOP 
      END 
                                                                                                                                              