ASMB,L,C,R
      HED DBLCK AND DBUNL SUBROUTINES OF IMAGE/1000 
      NAM DBLCK,7 92069-16143 REV.2026 800122 
* 
* 
******************************************************************* 
* (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-18143
*     RELOC:     92069-16143
* 
*     PRGMR:     CEJ
*     ALTERED:   JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ 
* 
* 
******************************************************************* 
* 
* 
* 
*  Data Base LoCK is one of the ten user callable subroutines in the
*  IMAGE/1000 library.  Its function is to lock a data base opened in 
*  mode 1 using the RN for the data base set up in DBOPN in order to
*  allow the user exclusive use of the data base.  In addition to lock- 
*  ing the data base, DBLCK brings in a fresh copy of the free record 
*  table from the root file and rewinds all currently used data sets in 
*  the data base to guarantee the user has the most current information 
*  on the state of the data sets. 
* 
*  The calling sequence for DBLCK is: 
* 
*         JSB DBLCK 
*          DEF *+5        return point
*          DEF IBASE      data base to be locked - must be the same para- 
*                           meter as used in a successful DBOPN call. 
*          DEF ISET       (currently unused - place holder) 
*          DEF MODE       =1 for a lock with wait 
*                         =2 for a lock without wait
*          DEF ISTAT      ten word status array (only first word is used
*                           by this subroutine
* 
      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
*                                                                     * 
*********************************************************************** 
***                                                                 *** 
*                                                                     * 
      ENT DBLCK,DBUNL 
      EXT .ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDMX,DBIDS,EREAD
      EXT RBLCK,RBUNL,RNRQ,RWNDF
A     EQU 0 
B     EQU 1 
* 
LBASE NOP 
LSET  NOP 
LMODE NOP 
LSTAT NOP 
* 
*  Get true addresses of parameters and return point. 
* 
DBLCK NOP 
      JSB .ENTR 
       DEF LBASE
* 
*  Make sure all the parameters are there.
* 
      LDA LSTAT 
      SZA,RSS 
      JMP LCK4      Missing parameter.
* 
*  Ask DBIDS to check the data base specified in BASE to see if it is on
*  a remote machine, and to set up its Run Table as the current Run Table.
* 
      CCA           A = -1 signifies not DBOPN calling. 
      JSB DBIDS 
       DEF *+2
       DEF LBASE,I
* 
      JMP L103      Error return - illegal BASE parameter.
      JMP LLOCL     Local data base return. 
* 
      JSB RBLCK     Remote data base return.
       DEF *+5      Ask RBLCK to handle 
       DEF LBASE,I    this request. 
       DEF LSET,I 
       DEF LMODE,I
       DEF LSTAT,I
      JMP LCK4      Return to caller. 
* 
*  Initialize the LSTAT parameter.
* 
LLOCL CLA           Set status word to zero 
      STA LSTAT,I     for facility in a successful return.
* 
*  Get open mode from Run Table (low order byte of 14th word in DBCB) and 
*  the lock flag (high order byte of the same word).  User must have
*  opened data base in mode 1 and cannot already have locked the data 
*  base in order for us to lock it now.  Note:  mode 3 open or data base
*  already locked to user will return as successful lock anyway.
* 
      LDB AIRUN     AIRUN has address of current Run Table. 
      ADB DBLMD 
      LDA B,I 
      AND LOBYT     A = open mode.
* 
      CPA D3        If open mode = 3, ignore lock call. 
      JMP LCK4
      CPA D1        Else, if open mode NE 1 
      RSS             we cannot lock the data base. 
      JMP L134
* 
      LDA B,I       Open mode okay - now check lock flag. 
      SSA           Will be positive if data base unlocked. 
      JMP LCK4      It's not - data base already locked to user.
* 
*  Open mode & lock flag checked out, now get RN from DBCB (word 6).
*  Then determine if the lock is to be with or without wait (lock modes 
*  1 and 2, respectively) and set up the RNRQ call accordingly. 
* 
      ADB M7
      STB LRN       Put RN in RNRQ call.
* 
      LDA CNTRL     Get the RN lock control word. 
      LDB LMODE,I   It already has no abort,
      CPB D1          lock locally bits set.
      JMP LCK1      If mode = 1, leave no wait bit clear. 
      CPB D2        If mode - 2,
      RSS             set no wait bit (bit 15). 
      JMP L115      If neither 1 or 2, illegal DBLCK mode.
      IOR NWAIT 
* 
LCK1  STA LCODE     Put control word in RNRQ call.
* 
*  Perform the RNRQ call.  When it returns, the status word will contain
*  a 2 if successful.  If it aborts or the status word is not 2, return 
*  an error code to the user. 
* 
      JSB RNRQ
       DEF *+4
       DEF LCODE
LRN    ABS *-*
       DEF FLAG 
      JMP L137      abort return point
* 
      LDA FLAG      Request succeed?
      CPA D2
      JMP LCK2      Yes - continue with processing. 
* 
      CPA D6        No - RN already locked? 
      JMP L136        Yes - tell user.
      JMP L137        No - illegal RN usage elsewhere.
* 
*  RN lock succeeded.  Set lock flag in DBCB (high order byte of word 13).
*  Then determine Free Record Table location (pointer in word 12 of DBCB),
*  and length (word 14 of DBCB) and put both in the FMP EREAD call to read
*  the free record information into the Run Table.
* 
LCK2  LDB AIRUN 
      ADB DBLFG 
      LDA B,I 
      IOR NWAIT     Set lock flag to negative.
      STA B,I 
* 
      INB           Get free record table length first. 
      LDA B,I 
      STA LENTH 
* 
      ADB M2        Get true address of free record table 
      LDA B,I         by adding the relative pointer
      ADA AIRUN       to the address of the Run Table 
      STA BUFFR 
* 
*  Put the 16 FMP word (start in 17th word of the DBCB) into the data 
*  base root file DCB for the EREAD call. 
* 
      LDA AIRUN 
      ADA DCBWS 
      LDB DBDCB 
      JSB .MVW
       DEF D16
       DEC 0
* 
*  Ask FMP to read in the free record table.  If it succeeds, we are done.
*  If it is unsuccessful, we must backtrack everything we have done so far
*  and return the ABS(FMP error) to the user. 
* 
      JSB EREAD 
       DEF *+7
       DEF DBDCB,I
       DEF FLAG 
BUFFR  NOP
       DEF LENTH
       DEF DUMMY
       DEF FRTRC    FRT always starts in record 2.
* 
      SSA           Call succeed? 
      JMP LCK3        No - go unlock the RN.
* 
*  Rewind all data sets in the data base to beginning of file to guarantee
*  a disc access the next time the set is accessed.  We do this by search-
*  ing the DCB table for all DCBs currently open with a set in the data 
*  base and calling the RWNDF FMP subroutine for each DCB found.  Each entry
*  in the DCB table contains two words in the format: 
* 
*       +-------------------------------------+ 
*       |   data base #    |    data set #    | -> -1 if DCB unused,
*       ---------------------------------------     0 if entry empty
*       |           DCB  address              | 
*       +-------------------------------------+ 
* 
*  We will search on the high order byte of the first word of each entry
*  comparing it against the current data base's number. 
* 
*  Set up for search by getting data base number from LBASE into the high 
*  order byte, getting -(maximum # of DCBs) as a counter, and making a
*  copy of the DCB table address. 
* 
      LDA LBASE,I 
      ALF,ALF 
      STA TEMP
* 
      LDA DBDMX 
      CMA,INA 
      STA CNTR
* 
      LDA DBDCP 
      STA PTADR 
* 
*  Now, for each entry in table, if there is a DCB associated with the
*  entry, and that DCB is being used for this data base, rewind the DCB.
* 
SRCH1 LDA PTADR,I 
      ISZ PTADR 
      AND HIBYT 
      CPA TEMP
      RSS 
      JMP SRCH2 
* 
      LDA PTADR,I 
      STA RWNAD 
      JSB RWNDF 
       DEF *+2
RWNAD  ABS *-*      Ignore any errors.
* 
SRCH2 ISZ PTADR 
      ISZ CNTR
      JMP SRCH1 
* 
*  When completed, return successful to user. 
* 
      JMP LCK4
* 
*  Here when an error occurred on reading the FRT into memory, release
*  RN and return ABS(FMP error code) to user. 
* 
LCK3  CMA,INA         No - make error positive
      STA LSTAT,I       and put into status word. 
* 
      LDB AIRUN     Clear lock flag in Run Table. 
      ADB DBLFG 
      LDA B,I 
      AND LOBYT 
      STA B,I 
* 
      JSB RNRQ      Tell RNRQ to unlock the RN. 
       DEF *+4
       DEF UCODE    Unlock, no wait, no abort 
       DEF LRN,I
       DEF DUMMY
      NOP           Ignore any errors.
* 
LCK4  CLA           Set LSTAT to zero for 
      STA LSTAT       param check on next entry.
      JMP DBLCK,I   Return to user. 
* 
*  Error return points. 
* 
L103  LDA D103      Data base not properly opened.
      RSS 
L115  LDA D115      Illegal DBLCK mode. 
      RSS 
L134  LDA D134      Improper open mode for a lock.
      RSS 
L136  LDA D136      Data base locked to someone else. 
      RSS 
L137  LDA D137      Illegal RN usage. 
      STA LSTAT,I   Put error in status word
      JMP LCK4        and return to user. 
* 
*  Constants and variables. 
* 
M2    DEC -2
D2    EQU ZERO+2
D6    EQU ZERO+6
D16   EQU ZERO+16 
D134  DEC 134 
D136  DEC 136 
* 
HIBYT OCT 177400
* 
CNTRL OCT 040001
NWAIT OCT 100000
* 
LCODE NOP 
LENTH NOP 
DUMMY NOP 
TEMP  EQU DUMMY 
CNTR  NOP 
PTADR NOP 
FRTRC DEC 0,2 
      SKP 
* 
*  Data Base UNLock is one of the ten user callable subroutines in the
*  IMAGE/1000 library.  Its function is to unlock a data base openend in
*  mode 1 using the RN for the data base set up in DBOPN in order to
*  allow the user to relinquish exclusive use of the data base. 
* 
*  The calling sequence for DBUNL is: 
* 
*        JSB DBUNL
*         DEF *+5       return point
*         DEF IBASE     data base to be unlocked - must be the same para- 
*                         meter as used in a successful DBOPN call. 
*         DEF ISET      (currently unused - place holder) 
*         DEF MODE      = 1 
*         DEF ISTAT     ten word status array (only the first word is 
*                         used by this subroutine 
* 
UBASE NOP 
USET  NOP 
UMODE NOP 
USTAT NOP 
* 
*  Get true parmeter and return point addresses.
* 
DBUNL NOP 
      JSB .ENTR 
       DEF UBASE
* 
*  Make sure all the parameters are there.
* 
      LDA USTAT 
      SZA,RSS 
      JMP UNL1      Missing parameter.
* 
*  Ask DBIDS to check the data base specified in UBASE to see if it is
*  on a remote machine, and to set up its Run Table as the current Run
*  Table. 
* 
      CCA           A = -1 signifies not DBOPN calling. 
      JSB DBIDS 
       DEF *+2
       DEF UBASE,I
* 
      JMP U103      Error return - illegal UBASE param. 
      JMP ULOCL     Local data base return. 
* 
      JSB RBUNL     Remote data base return.
       DEF *+5      Ask RBUNL to handle 
       DEF UBASE,I    this request. 
       DEF USET,I 
       DEF UMODE,I
       DEF USTAT,I
      JMP UNL1      Return to caller. 
* 
*  Initialize the USTAT parameter.
* 
ULOCL CLA           Set status word to zero for 
      STA USTAT,I     facility in a successful return.
* 
*  Get open mode from Run Table (low order byte of word 13 in the DBCB) 
*  and the lock flag (high order byte of the same word).  User must have
*  opened the data base in mode 1 and must have previously locked the data
*  base in order for us to unlock it now.  Note:  A non mode 1 open and 
*  data base already unlocked will return as a successful unlock anyway.
* 
      LDB AIRUN     AIRUN has address of current Run Table
      ADB DBLMD 
      LDA B,I 
      AND LOBYT     A = open mode.
* 
      CPA D1        If open mode NE 1,
      RSS             we cannot unlock data base
      JMP UNL1        (It couldn't be locked!)
* 
      LDA B,I       Open mode okay - now check lock flag, 
      SSA,RSS         must be negative. 
      JMP UNL1      It's not - data base already unlocked.
* 
*  All okay.  Make sure unlock mode 1.  If so, get RN from DBCB (6th word)
*  and put it into RNRQ call. 
* 
      LDA UMODE,I 
      CPA D1
      RSS 
      JMP U115      Illegal unlock mode (NE 1). 
* 
      ADB M7        Put RN in RNRQ call.
      STB URN 
* 
*  Ask RNRQ to unlock RN for us.  If we are unable to unlock the RN or
*  the request is aborted, someone else is illegally using the RN.
* 
      JSB RNRQ
       DEF *+4
       DEF UCODE    Unlock, no wait, no abort 
URN    ABS *-*
       DEF FLAG 
      JMP U137      Abortion return point.
* 
      LDA FLAG      Returned status must be 1,
      CPA D1          else unlock did not succeed.
      RSS 
      JMP U137
* 
*  Unlock succeeded.  Clear the lock flag in the DBCB (high order byte
*  of the 13th word)  and return successfully to the user.
* 
      LDB AIRUN 
      ADB DBLFG 
      LDA B,I 
      AND LOBYT 
      STA B,I 
* 
UNL1  CLA           Set USTAT to zero for 
      STA USTAT       param check on next entry.
      JMP DBUNL,I 
* 
*  Error return points. 
* 
U103  LDA D103      Data base not properly opened.
      RSS 
U115  LDA D115      Illega DBUNL mode.
      RSS 
U137  LDA D137      Illegal RN usage. 
      STA USTAT,I   Set status word and 
      JMP UNL1        return to user. 
* 
*  Constants and variables. 
* 
M7    DEC -7
D1    EQU ZERO+1
D3    EQU ZERO+3
D103  DEC 103 
D115  DEC 115 
D137  DEC 137 
* 
LOBYT OCT 377 
UCODE OCT 140004
* 
FLAG  NOP 
      END 
                                                                                                                                                                    