ASMB,L,C,R
      HED DBCLS SUBROUTINE OF IMAGE/1000
      NAM DBCLS,7 92069-16144 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-18144
*     RELOC:     92069-16144
* 
*     PRGMR:     CEJ
*     ALTERED:   JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ 
* 
* 
******************************************************************* 
* 
* 
* 
*  Data Base CLoSe is one of the ten user callable subroutines in the 
*  IMAGE/1000 DML Library.  It provides two services to the user.  These
*  services correspond to the mode of close and are as follows: 
*      mode                      service
*      ----                      -------
*        1            Close data base - 
*                       terminates all access to the data base by the 
*                       user and deallocates any memory used solely 
*                       by the data base being closed.
*        2            Close the specified data set. 
* 
*  The calling sequence for DBCLS is: 
* 
*          JSB DBCLS
*           DEF *+5 
*           DEF BASE         data base parameter used in a successful 
*                              DBOPN call for the data base which is to 
*                              be closed or which contains the data set 
*                              to be closed.
*           DEF SET          the name or number of the data set to be 
*                              closed if a mode 2 close.
*           DEF MODE         DBCLS mode, legal values are as described
*                              above. 
*           DEF STAT         a ten word array in which status information 
*                              is returned to the user.  This subroutine
*                              uses only the first word of this array in
*                              which is stores an error code, zero if 
*                              successful.
* 
      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 DBCLS 
      EXT .ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDCT,DBDEX
      EXT DBDMX,DBFDS,DBIDS,DBRBL,DBRBP,DBRTM,DBRTP 
      EXT EXEC,PNAME,RBCLS,RETBF,RMPAR,RNRQ,ECLOS 
* 
BASE  NOP 
SET   NOP 
MODE  NOP 
STAT  NOP 
* 
*  Get true parameter and return point addresses. 
* 
DBCLS NOP 
      JSB .ENTR 
       DEF BASE 
* 
*  Make sure all the parameters are there.
* 
      LDA STAT
      SZA,RSS 
      JMP CLST      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 BASE,I 
* 
      JMP E103      Error return - illegal BASE param.
      JMP LOCAL     Local data base return. 
* 
      JSB RBCLS     Remote data base return.
       DEF *+5      Ask RBCLS to handle 
       DEF BASE,I     this request. 
       DEF SET,I
       DEF MODE,I 
       DEF STAT,I 
      JMP CLST      Return to caller. 
* 
*  CASE on the DBCLS mode 
* 
LOCAL LDA MODE,I
      CPA D1        MODE = 1? 
      JMP CLSM1       Yes 
      CPA D2          No - MODE = 2?
      JMP CLSM2         Yes 
      JMP E115          No - illegal mode.
* 
*  DBCLS mode = 1.
*  User wants us to terminate access to this data base.  In order for us
*  to do this, the data base must not be locked.  If it is, we will try 
*  to unlock it for the user.  If we do not succeed we cannot close.
*  The data base is locked if the lock flag (high order byte of 14th word 
*  of the DBCB) is negative.
* 
CLSM1 LDB AIRUN 
      ADB DBLFG 
      LDA B,I 
      SSA,RSS 
      JMP CLS12     Data base not locked. 
* 
*  The data base is locked to the user.  To unlock it we need to get the
*  RN from the 7th word of the DBCB and call RNRQ to release the RN.  If
*  RNRQ succeeds, we clear the lock flag in the DBCB and continue with
*  the close.  If not, we return a data base locked error to the user.
* 
      LDB AIRUN     Put the address of the
      ADB DBRSN       RN in the unlock call.
      STB RN
* 
      JSB RNRQ
       DEF *+4
       DEF RNCOD    Unlock, no wait, no abort.
RN     ABS *-*
       DEF STAT,I 
      JMP E135      Abortion return point.
* 
      LDA STAT,I    Did unlock succeed? 
      CMA,INA       (i.e. is status = 1?) 
      INA,SZA 
      JMP E135        No - data base locked error.
* 
      LDB AIRUN       Yes - clear lock flag.
      ADB DBLFG 
      LDA B,I 
      AND LOBYT 
      STA B,I 
* 
*  Data base may be closed.  First we must close all data sets in the data
*  base that are open.  To do this, we will loop on each set asking DBCDS 
*  to close the data set for us.  So, set up the loop.
* 
CLS12 ADB M4        Use negative of data set count
      LDA B,I         (10th word of DBCB) 
      CMA,INA         as the loop counter.
      STA CNTR
* 
      CLA,INA       Start with data set # 1.
      STA STNUM 
* 
*      BEGIN LOOP 
* 
M11   JSB DBCDS     DBCDS parameters are global.
* 
      ISZ STNUM     Continue for all sets.
      ISZ CNTR
      JMP M11 
* 
*      END LOOP 
* 
*  Second, we close the root file itself.  So, set up for the FMP ECLOS 
*  call.
* 
      LDA AIRUN     Move 16 FMP words from
      ADA DCBWS       DBCB (18th thru 33rd words) 
      LDB DBDCB       into data base DCB. 
      JSB .MVW
       DEF D16
       DEC 0
* 
*  Ask FMP to close data base root file.
* 
      JSB ECLOS 
       DEF *+2
       DEF DBDCB,I
* 
      SSA           If any error -
      JMP ERREX       pass code to user.
* 
*  Ask DBDEX to release any record buffer or DCB memory used solely by
*  this data base.
* 
      JSB DBDEX 
       DEF *+1
      JMP E160      ERROR RETURN, MEMORY CORRUPT. 
* 
*  Release the data base Run Table memory space.
* 
      CCA 
      ADA BASE,I    Get primary pointer to Run
      ADA DBRTP       Table by adding data base # 
      STA PTRAD       to address of pointer table - 1.
* 
      JSB RETBF 
       DEF *+2
       DEF PTRAD,I
* 
      SSA           Did RETBF succeed?
      JMP E160        No - someone's walked on our memory.
* 
*  Schedule  DBCOP to remove us from the data base user co-ordinating 
*  table.  (Must move the data base name, CRN, and this program's name into 
*  the EXEC call first.)  AIRUN still points to the Run Table, first three
*  words of which contain the data base name. 
* 
      LDA AIRUN 
      STA NAME
      INA 
      STA NAME+1
      INA 
      STA NAME+2
      ADA D2
      STA CRN 
* 
      JSB PNAME 
       DEF *+2
       DEF PROGN
* 
      JSB EXEC
       DEF *+10 
       DEF NA23 
       DEF DBCOP
       DEF B1400    First byte = 3 (DBCOP close code).
NAME   ABS *-*
       ABS *-*
       ABS *-*
CRN    ABS *-*
       DEF PROGN
       DEF D3 
      JMP E140      Abortion return point.
* 
*  Get error code returned by DBCOP.  If zero, a successful close.
* 
      JSB RMPAR 
       DEF *+2
       DEF ERROR
* 
      LDA ERROR 
      SZA 
      JMP ERREX       Not successful. 
* 
*  A successful close, replace first word of BASE parameter with its old
*  value (stored in 6th word of DBCB to which AIRUN still points) then
*  return successful to user. 
* 
      LDB AIRUN 
      ADB DBDSN 
      LDA B,I 
      STA BASE,I
* 
      JMP CLSE
      SKP 
* 
*  DBCLS mode = 2.
*  Close the data set specified in SET. 
* 
*  Ask DBFDS to confirm the set reference for us and give us the set's
*  number.
* 
CLSM2 JSB DBFDS 
       DEF *+5
       DEF SET,I    DBFDS needs: data set reference 
       DEF STNUM        returns: data set number
       DEF FLAG                  accessibility flag 
       DEF STADR                 entry address
* 
      LDA STNUM     If set # came back
      SZA,RSS         as zero 
      JMP E100
* 
      LDA FLAG        or set is inaccessible
      CMA,INA         (FLAG > 0)
      SSA 
      JMP E100        user gave us a bad set reference. 
* 
*  Set reference okay.  Ask DBCDS to perform the close.  If it returns
*  to us, just return successful to user. 
* 
      JSB DBCDS 
* 
CLSE  CLA 
CLSX  STA STAT,I
CLST  CLA           Set STAT to zero for
      STA STAT        param check on next entry.
      JMP DBCLS,I 
* 
*  Error return points. 
* 
ERREX SSA           Error code in A reg.
      CMA,INA         make sure its positive. 
      JMP CLSX
E100  LDA D100      Bad set reference 
      JMP CLSX
E103  LDA D103      Improperly opened data base.
      JMP CLSX
E115  LDA D115      Illegal DBCLS mode. 
      JMP CLSX
E135  LDA D135      Data base locked. 
      JMP CLSX
E140  LDA D140      Unable to schedule DBCOP. 
      JMP CLSX
E160  LDA D160      Corrupt Run Table or
      JMP CLSX
      SKP 
* 
*  Close Data Set is a utility subroutine for DBCLS.  Its function is to
*  search through the DCB pointer table for a DCB opened to the file spe- 
*  cified by the base/set number pair found in BASE,I and STNUM, and if it
*  finds one, to call ECLOS to close the file and sets the DCB to unused. 
*  No error occurs if the file is not open. 
* 
*  Each entry in the DCB pointer table looks like:
*      word 
*      ----   +---------------------------------------------+ 
*        1    |      data base #      |      data set #     |-> -1 if 
*             -----------------------------------------------   DCB empty 
*        2    |                  DCB address                |   0 if entry
*             +---------------------------------------------+   empty 
*              15                    8 7                   0  bit 
* 
*  All parameters used by DBCDS are global to DBCLS.
* 
*  Set up for the loop. 
* 
DBCDS NOP 
      LDA BASE,I    Get base/set combination. 
      ALF,ALF 
      IOR STNUM 
      STA NUMBR 
* 
      LDA DBDMX     Use negative of # of entries
      CMA,INA         in pointer table as 
      STA CNTR2       the loop counter. 
* 
      LDA DBDCP 
      STA PTRAD 
* 
*      BEGIN LOOP 
*  For each entry in pointer table: 
* 
*    1) If 1st word of entry = NUMBR, get DCB address from 2nd word and 
*       close file. 
* 
CDS1  LDA PTRAD,I 
      CPA NUMBR 
      RSS 
      JMP CDS3
* 
      ISZ PTRAD 
      LDA PTRAD,I 
      STA CDS10 
      JSB ECLOS 
       DEF *+2
CDS10  NOP
* 
      SSA           If ECLOS returns an error 
      JMP ERREX       pass it to user.
* 
      CCA           Else, set 1st word of pointer 
      CCB             table entry to -1 to
      ADB PTRAD       signify DCB is unused.
      STA B,I 
* 
CDS2  JMP DBCDS,I   Then, return to the user. 
* 
CDS3  ISZ PTRAD     If not the entry we want
      ISZ PTRAD       try next one, 
      ISZ CNTR2       if there is one.
      JMP CDS1
      JMP CDS2
* 
*      END LOOP 
* 
      SKP 
* 
*  Constants and variables. 
* 
M4    DEC -4
D1    EQU ZERO+1
D2    EQU ZERO+2
D3    EQU ZERO+3
D16   EQU ZERO+16 
D100  DEC 100 
D103  DEC 103 
D115  DEC 115 
D135  DEC 135 
D140  DEC 140 
D160  DEC 160 
B1400 OCT 1400
* 
NA23  OCT 100027
LOBYT OCT 377 
RNCOD OCT 140004
DBCOP ASC 3,DBCOP 
* 
STNUM NOP 
PTRAD NOP 
NUMBR NOP 
ERROR NOP           } NOTE: Do not change the 
FLAG  NOP           }   order of these variables
STADR NOP           }   used in RMPAR call for
CNTR2 NOP           }   return from DBCOP.
CNTR  NOP           } 
PROGN EQU ERROR     Program name buffer for PNAME call. 
      END 
                                                                                                                                                                                                