ASMB,L,C,R
      HED DBDEL SUBROUTINE OF IMAGE/1000
      NAM DBDEL,7 92069-16142 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-18142
*     RELOC:     92069-16142
* 
*     PRGMR:     CEJ
*     ALTERED:   JANUARY 22, 1980 FOR SORTED CHAINS AND MULTIPLE
*                                 LINKING FEATURES - CEJ
* 
* 
******************************************************************* 
* 
* 
* 
*  Data Base DELete is one of the ten user callable subroutines in the
*  IMAGE/1000 DBMS library.  Its function is to delete the most recentrly 
*  accessed entry from a manual master or detail data set.  For a detail
*  set, this includes deleting any automatic master data set entry whose
*  chain counts for all paths become zero upon the removal of the detail
*  entry. 
* 
*  The calling sequence for DBDEL is: 
* 
*          JSB DBDEL
*           DEF *+5      return point 
*           DEF BASE     the data base parameter used in a successful 
*                          DBOPN for the data base from which the entry 
*                          is to be removed.  The data base must have 
*                          been opened in mode 1 or 3, and if mode 1 must 
*                          have been previously locked to the user. 
*           DEF SET      the name or number of the manual master or detail
*                          data set from which the current entry is to be 
*                          deleted. 
*           DEF MODE     DBDEL mode = 1 
*           DEF STAT     a 10 word status array of which only the first 
*                          word is used by this subroutine to return to 
*                          the user a status 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 DBDEL 
      EXT .DDE,.DIS,.ENTR,.MVW,AIRUN,DBCIX,DBDME,DBFDI,DBFDS
      EXT DBFWZ,DBHRD,DBIDS,DBRBL,DBRBP,DBRED,DBWFR,DBWRT 
      EXT RBDEL 
* 
BASE  NOP 
SET   NOP 
MODE  NOP 
STAT  NOP 
* 
*  Get true parameter and return point addresses. 
* 
DBDEL NOP 
      JSB .ENTR 
       DEF BASE 
* 
*  Make sure all the parameters are there.
* 
      LDA STAT
      SZA,RSS 
      JMP DEL7      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 RBDEL     Remote data base return.
       DEF *+5      Ask RBDEL to handle 
       DEF BASE,I     this request. 
       DEF SET,I
       DEF MODE,I 
       DEF STAT,I 
      JMP DEL7      Return to caller. 
* 
*  Check open mode of data base.  It must be 1 or 3, and if mode 1, must
*  have been locked to the user.  Open mode is in low order byte of 13th
*  word of DBCB, lock flag is in the high order byte of the same word.
* 
LOCAL LDB AIRUN 
      ADB DBLMD 
      LDA B,I 
      AND LOBYT 
      CPA D1        mode = 1? 
      JMP DEL1        Yes - check lock flag 
      CPA D3          No - mode = 3?
      JMP DEL2          Yes - continue
      JMP E104          NO - illegal open mode for a DEL. 
* 
DEL1  LDA B,I       Lock flag is negative 
      SSA,RSS         if data base locked to user.
      JMP E159
* 
*  Now, make sure that the MODE the user specified for DBDEL is 1.
* 
DEL2  LDA MODE,I
      CPA D1        = 1?
      RSS 
      JMP E115        NO - illegal DBDEL mode.
* 
*  Ask DBFDS to check the validity of the set reference in SET and to 
*  give us the pointer to the Data Set Control Block for the set if it
*  is valid.
* 
      JSB DBFDS 
       DEF *+5
       DEF SET,I    DBFDS needs: data set reference 
       DEF STNUM        returns: data set # 
       DEF FLAG                  accessibility flag 
       DEF STADR                 DSCB pointer 
* 
      LDA STNUM     If DBFDS returned a set # 
      SZA,RSS         of zero (set invalid) 
      JMP E100
* 
      LDA FLAG        or an accessibility FLAG
      CMA,INA         of > 0 (set inaccessible) 
      SSA 
      JMP E100        user gave us a bad set reference. 
* 
*  The data set must be writeable (accessibility FLAG returned < 0) for 
*  us to do a DBDEL.
* 
      SZA,RSS 
      JMP E118
* 
*  The data set must be a manual master (type code = 1) or a detail (type 
*  code = 2) for us to do a DEL.  Type code is in 2nd nibble of high order
*  byte of 5th word of DSCB.  If the set is an MM, make FLAG = -1, if 
*  set a detail, make FLAG = 0. 
* 
      CCA 
      STA FLAG
* 
      LDB AIRUN     DSCB pointer passed by DBFDS
      ADB STADR       is relative to start of Run Table 
      ADB DSTYP 
      LDA B,I       Get type code in sign and 
      ALF,RAL         least sig. bits of A reg. 
      SLA           If least sig. bit set,
      JMP DEL3        type = 2. 
      SSA           If sign bit set,
      JMP DEL4        type = 1
      JMP E108        else set an auto-master.
* 
DEL3  ISZ FLAG
      NOP 
* 
*  DBDEL deletes the current record in the data set.  Make sure that there
*  is a current record (i.e. current record number in 12th and 13th words 
*  of DSCB non-zero). 
* 
DEL4  ADB D7
      DLD B,I 
      SZB,RSS 
      SZA 
      RSS 
      JMP E157      No current record to delete.
* 
      DST RECRD     Save current as record to delete. 
* 
*  Read in the current record and see if it is already empty. 
* 
      JSB DBRED 
       DEF *+4
       DEF BASE,I   DBRED needs: data base #
       DEF STNUM                 data set # 
       DEF RECRD                 record number
* 
      SZA           If any error, 
      JMP ERREX       pass code to user.
* 
      LDA DBRBP,I   Else, check entry type word.
      SZA,RSS       If zero,
      JMP E114        entry is empty. 
* 
*  All joint error checking is done.  Now, split up processing between
*  master and detail deletes. 
* 
      ISZ FLAG      Is this an MM?
      JMP DELD        No - a detail 
      SKP 
* 
*  Delete a manual master data entry. 
* 
*  In order for us to delete a manual master data set entry, all chain
*  counts for the paths in the related detail data sets must be zero. 
*  So, the first order of business is to check all the chain counts in the
*  master's media record for zero.  Set up the loop parameters: 
*    Will use the negative of the number of paths/entry in the master 
*    (low order byte of 17th word of DSCB) as the loop counter. 
* 
      LDB AIRUN 
      ADB STADR 
      ADB DSPCT 
      LDA B,I 
      AND LOBYT 
      SZA,RSS       If manual has no chains,
      JMP DELM2       we can skip chain count check.
      CMA,INA 
      STA CNTR1 
* 
*  Skip over entry type word and synonym pointers in media record.
* 
      LDB DBRBP 
      ADB D5
      STB MRADR 
* 
*  Now, loop on each path in the media making sure the chain count for
*  the path is zero.  The first non-zero path count causes an error.
* 
DELM1 DLD MRADR,I 
      SZB,RSS 
      SZA 
      JMP E113      A non-empty chain.
* 
      LDA MRADR 
      ADA D6
      STA MRADR 
      ISZ CNTR1 
      JMP DELM1 
* 
*  We fall through loop here if all chain counts are zero or jump here if 
*  the set has no chains.  Entry may be deleted.  Ask DBDME to do the de- 
*  lete.  It performs all the necessary synonym updates and also alters 
*  the Free Record Table to reflect the deleted record if it is success-
*  ful.  If successful, we merely jump to joint FRT posting.
* 
DELM2 CLA           Let DBDME know that 
      JSB DBDME       record is in record buffer
       DEF *+4        so it doesn't do a read.
       DEF BASE,I   DBDME needs: data base #
       DEF STNUM                 data set # 
       DEF RECRD        returns: record number
* 
      SZA           Any error?
      JMP ERREX       Yes - pass it to user.
      JMP DEL5        No - go post FRT. 
      SKP 
* 
*  Delete a detail data entry.
* 
*  The detail data entry may be deleted if we reach this point since all
*  necessary error checking has been done.  However, we have a problem
*  in deleting a detail data set entry in that we must update all master
*  entries.  To do this we must hash-read into the master set and there-
*  fore we must have the key item value in memory for DBHRD to compare
*  with the value in the master entry.  But, the only buffer we have which
*  contains the key item value is the data record in the record buffer
*  itself and the record buffer gets overlaid by DBHRD during the read
*  of the data entry.  So, we set up a buffer which can contain at least
*  one of the key item values and possibly all of the values. 
* 
*  This buffer is a hard coded 127 words (largest possible key item is
*  127 words).  In addition, in order to organize this buffer, we need to 
*  keep a count of the number of key items in the buffer and a pointer
*  to the current location in this buffer.  The buffer is initialized by
*  moving as many of the key item values as possible into it from the re- 
*  cord buffer in the order of their occurance in the Path Table of the 
*  data set.  The count is then set to the number of key item values which
*  fit in the buffer and the pointer starts at the first word of the buf- 
*  fer.  We then hash-read into each master data set for each path (in
*  order)  using our current position in the buffer as the address of the 
*  key item value and update the master entry.  The count of the key
*  item values is decremented and the pointer is moved to its current posi- 
*  tion plus the length of the key item just used.  When the count reaches
*  zero, if we are not done with the master updating for each path of the 
*  detail, we read the detail entry back into the record buffer and move
*  as many key item values as possible from the record buffer into the key
*  item buffer starting with the key item of the next path upto, and in-
*  cluding, the key item of the last path in the data set.  The count and 
*  pointer are reset and master updating is continued.  This process con- 
*  tinues until all masters are updated.
* 
*  Then, the detail record is deleted by writing a zero-filled record with
*  the free list pointer set to the disc.  The Free Record Table is updated 
*  and posted and we return to the user.  Any error during the master or
*  detail updating causes us to halt processing and return an error code
*  to the user. 
* 
*  First, determine if the data set has any paths.  If not, we can skip 
*  around this entire key item rigamarole.  # paths/entry is in low order 
*  byte of the 7th word of the DSCB.
* 
DELD  LDB AIRUN 
      ADB STADR 
      ADB DSPCT 
      LDA B,I 
      AND LOBYT 
      STA PTCNT     Save path count for later.
      SZA,RSS 
      JMP DELD9 
* 
*  It has paths, initialize the loop parameters:
* 
      CMA,INA       Use path count as the 
      STA CNTR1       loop counter. 
* 
      CLA,INA       Start with path # 1 
      STA PATH# 
* 
      LDA B,I       Get data set's Path 
      ALF,ALF         Table address = 
      AND LOBYT       (# fields/entry <<high order
      INA              byte of 7th word of DSCB>> + 1)
      ARS             / 2 
      INB             + pointer to Info Table 
      ADA B,I         <<8th word of DSCB>>
      ADA AIRUN       + address of Run Table. 
      STA PTADR 
* 
      ADB M3        Move detail's chain pointers
      LDA B,I         into temp. media record 
      AND LOBYT       storage.  Media record
      ADA M3          length is low order byte
      STA MVLEN       of 5th word of DSCB.
      LDA DBRBP 
      ADA D3
      LDB MEDST 
      JSB .MVW
       DEF MVLEN
       DEC 0
* 
      STA DRADR     A now points to data record,
      LDB MEDST       save it for DBKEY.
      STB PATHI 
* 
*      BEGIN MASTER UPDATE LOOP 
*  For each path in the detail: 
* 
*    1) Get address of key item value.
*       DBKEY is the routine which does all the key item value buffer 
*       manipulations and puts the address of the key's value in CURNT. 
* 
DELD1 JSB DBKEY 
* 
*    2) Get master data set's number and detail's key item number from
*       the Path Table entry for this path: 
*       (low order byte of entry whose address = Path Table address + 
*        (path # - 1) * 2). 
* 
      CCB 
      ADB PATH# 
      BLS 
      ADB PTADR 
      LDA B,I 
      AND LOBYT 
      STA MSNUM 
* 
      LDA B,I       Get and save key item 
      AND HIBYT       number for later
      STA CMPAR 
* 
*    3) Hash-read into master to get entry with key value.
* 
      JSB DBHRD 
       DEF *+7
       DEF BASE,I   DBHRD needs: data base #
       DEF MSNUM                 data set # 
       DEF CURNT,I               key item value 
       DEF FLAG         returns: read flag
       DEF MSTRC                 record number
       DEF STAT,I                error code 
* 
      LDA STAT,I    If any error, 
      SZA 
      JMP ERREX       pass code to user.
* 
      LDA FLAG      If returned read flag NE 0
      SZA             (i.e. no entry with hash value) 
      JMP E154        Corrupt Data Base!
* 
*    4) Determine the index into the master's media record for this data
*       set by: 
*       A) Get master's DSCB pointer. 
* 
      JSB DBFDS 
       DEF *+5
       DEF MSNUM
       DEF TEMP 
       DEF FLAG 
       DEF MSADR
* 
      LDA TEMP      Just a check for
      SZA,RSS 
      JMP E160        a bad Run Table.
* 
*       B) Get Path Table address of master (same process as above for
*          detail.
* 
      LDB MSADR 
      ADB AIRUN 
      ADB DSFPC 
      LDA B,I       As a side effect, get # of
      AND LOBYT       paths/entry in master and 
      STA TEMP        save for later. 
* 
      LDA B,I 
      ALF,ALF 
      AND LOBYT 
      INA 
      ARS 
      INB 
      ADA B,I 
      ADA AIRUN 
      STA MRADR 
* 
*       C) Loop on each entry in master's Path Table comparing the set# 
*          and item # in the entry to the detail's set # and key item #.
*          If not a match, add 6 to index.  If a match, index is computed.
*          Before loop, initialize index to 5 skipping over entry type
*          word and synonym pointers in media record and merge the detail's 
*          key item and set numbers.
* 
      LDA TEMP      Use negative of # of paths in 
      CMA,INA         master as the loop counter. 
      STA CNTR3 
* 
      LDA CMPAR     Merge item and set #s 
      IOR STNUM 
      STA CMPAR 
* 
      LDB D5        Initialize index. 
* 
DELD2 LDA MRADR,I 
      CPA CMPAR 
      JMP DELD3 
* 
      ADB D6
      ISZ MRADR     If we run out of paths in 
      ISZ MRADR 
      ISZ CNTR3       master before a match is
      JMP DELD2       found - 
      JMP E160        Run Table is corrupt! 
* 
*    5) Index into master data set's media record to get this path's count
*       and pointer addresses.
* 
DELD3 ADB DBRBP 
      STB MRADR 
* 
*    6) Get path count and decrement. 
* 
      DLD MRADR,I 
      JSB .DDE
      DST MRADR,I 
* 
*    7) If path count is now zero:
*       A) zero-fill path pointers also.
* 
      SZB,RSS 
      SZA 
      JMP DELD5 
* 
      ISZ MRADR     Chain foot
      ISZ MRADR 
      DST MRADR,I 
* 
      ISZ MRADR     Chain head
      ISZ MRADR 
      DST MRADR,I 
* 
*       B) If an automatic master (type code in 2nd nibble of high order
*          byte of 5th word of DSCB = 0), see if all chains are zero. 
*          If so, delete the entry. 
* 
      LDB AIRUN 
      ADB MSADR 
      ADB DSTYP 
      LDA B,I 
      ALF,RAL 
      SSA 
      JMP DELD7 
* 
      LDB TEMP      TEMP set to # paths long ago. 
      CMB,INB       Use negative as loop counter. 
      STB CNTR3 
* 
      LDB DBRBP     Skip over entry type word & 
      ADB D5          synonym pointers in 
      STB MRADR       media record. 
* 
DELD4 DLD MRADR,I   For each path in master,
      SZB,RSS         if chain count NE 0,
      SZA 
      JMP DELD7       cannot delete entry.
* 
      LDA D6
      ADA MRADR 
      STA MRADR 
      ISZ CNTR3 
      JMP DELD4 
* 
      CLA           All paths are zero.  Ask
      JSB DBDME       DBDME to delete entry 
       DEF *+4      The A reg. = 0 tells
       DEF BASE,I     DBDME that the record 
       DEF MSNUM      is already in memory. 
       DEF MSTRC
* 
      SZA           Did DBDME succeed?
      JMP ERREX       No - inform user
      JMP DELD8       Yes - continue with next master.
* 
*    8) Path count still non-zero.  If chain foot in master's media re- 
*       cord = record # of detail entry to delete, set the chain foot to
*       the detail's backward pointer for this path (in temp. media sto-
*       rage pointed to by PATHI).
* 
DELD5 ISZ MRADR     MRADR points to chain count,
      ISZ MRADR       move it to chain foot.
      DLD MRADR,I 
      CPB RECRD+1 
      RSS 
      JMP DELD6 
      CPA RECRD 
      RSS 
      JMP DELD6 
* 
      DLD PATHI,I 
      DST MRADR,I 
* 
*    9) If chain head in master's media record = record # of detail entry 
*       to delete, set the chain head to the detail's forward pointer for 
*       this path.
* 
DELD6 ISZ MRADR     Point MRADR to chain head,
      ISZ MRADR       it's currently at chain foot. 
      DLD MRADR,I 
      CPB RECRD+1 
      RSS 
      JMP DELD7 
      CPA RECRD 
      RSS 
      JMP DELD7 
* 
      LDB PATHI     Get this path's forward 
      ADB D2          pointer, in 2nd doubleword
      DLD B,I         of media storage. 
      DST MRADR,I 
      SKP 
* 
*  Write updated master entry to disc.  If successful, continue with next 
*  master, else return error to user. 
* 
DELD7 JSB DBWRT 
       DEF *+4
       DEF BASE,I   DBWRT needs: data base #
       DEF MSNUM                 data set # 
       DEF MSTRC                 record number
* 
      SZA 
      JMP ERREX 
* 
DELD8 LDB PATHI     Update media record pointer 
      ADB D4
      STB PATHI 
      ISZ PATH#       and path number.
      ISZ CNTR1     If more to do 
      JMP DELD1       go do them. 
* 
*      END OF MASTER UPDATE LOOP
* 
      SKP 
* 
*  We come here when all master entries for the detail's path have been 
*  successfully update, or if the detail has no paths.  Delete the detail 
*  entry by writing a zero-filled entry to the disc.  That is, zero ex- 
*  cept for the 2nd & 3rd words which contain the forward free list pointer 
*  which is the current free list head pointer from the 3rd & 4th words 
*  of the detail's Free Record Table entry. 
* 
DELD9 JSB DBFWZ     Ask DBFWZ to zero out 
       DEF *+3        the record buffer.
       DEF DBRBL    It needs: length of area to zero
       DEF DBRBP              address of area to zero 
* 
      LDA DBRBP     Get address of free list pointer in 
      INA 
      STA MRADR       detail's media record.
* 
      CCA           Set's entry in FRT is:
      ADA STNUM       data set # - 1
      ALS,ALS         * 4 
      LDB AIRUN       + pointer to FRT
      ADB DBFRP       (12th word of DBCB) 
      ADA B,I 
      ADA AIRUN       + address of Run Table. 
      STA TEMP      Save for later. 
* 
      ADA FRPTR     Bump to freelist head pointer 
      DLD A,I         pick it up & put it in 2nd &
      DST MRADR,I     3rd words of record buffer. 
* 
      JSB DBWRT     Write unused entry to disc. 
       DEF *+4
       DEF BASE,I 
       DEF STNUM
       DEF RECRD
* 
      SZA           If any error
      JMP ERREX       return code to user.
* 
*  Update the FRT entry for the detail data set to reflect the deletion 
*  of the record by incrementing the free record count (in 1st two words) 
*  and storing the deleted record's number as the new free record list
*  head pointer (in 3rd & 4th words). 
* 
      JSB .DIS
       DEF TEMP,I 
       NOP
      ISZ TEMP
      ISZ TEMP
      DLD RECRD 
      DST TEMP,I
      SKP 
* 
*  Now, we need to update any detail records which reference the deleted
*  record through their chain pointers.  We do this by looping on each
*  path in the detail checking the backward and forward pointers for the
*  path in the temp. media record storage area.  If the backward pointer
*  is non-zero, we read in the record whose number the pointer contains 
*  and set its forward pointer for the path (which we blindly assume cur- 
*  rently contains the record number of the record just deleted) to the 
*  contents of the forward pointer for the path in the deleted record 
*  and write it out to disc.  Then, if the forward pointer (in temp. media
*  storage) is non-zero, we read in the record corresponding to the for-
*  ward pointer's contents, set its backward pointer for the path (again, 
*  blindly assuming its current content is the record number of the record
*  just deleted) to the contents of the backward pointer for the path in
*  the deleted record.
* 
*  First, let's check the path count for the detail again.  We set PTCNT
*  to the path count long ago.  If it's zero, we can skip over this de- 
*  tail path updating.
* 
      LDA PTCNT 
      SZA,RSS 
      JMP DEL5
* 
*  It has paths, so initialize the loop parameters. 
* 
      CMA,INA       Use negative # paths
      STA CNTR1       as loop counter.
* 
      CLA           Zero for 1st path's 
      STA INDEX       media record index. 
* 
*      BEGIN DETAIL UPDATE LOOP 
*  For each path in the detail: 
* 
*    1) Get the backward pointer. 
* 
DED10 LDB MEDST 
      ADB INDEX 
      STB PATHI 
      DLD B,I 
* 
*    2) If backward pointer non-zero, read it into the record buffer. 
* 
      SZB,RSS 
      SZA 
      RSS 
      JMP DED11 
* 
      DST MSTRC 
      JSB DBRED 
       DEF *+4
       DEF BASE,I 
       DEF STNUM
       DEF MSTRC
* 
      SZA           Was read successful?
      JMP ERREX       No - give user error code.
* 
*    3) Set the backward pointer's forward pointer to deleted record's
*       forward pointer.
* 
      LDA DBRBP 
      ADA INDEX 
      ADA D5
      STA TEMP
* 
      LDA PATHI 
      ADA D2
      DLD A,I 
      DST TEMP,I
* 
*    4) Write updated backward pointer to disc. 
* 
      JSB DBWRT 
       DEF *+4
       DEF BASE,I 
       DEF STNUM
       DEF MSTRC
* 
      SZA           If an error,
      JMP ERREX       give error code to user.
* 
*    5) Get forward pointer.
* 
DED11 LDA PATHI 
      ADA D2
      DLD A,I 
* 
*    6) If forward pointer non-zero, read it into record buffer.
* 
      SZB,RSS 
      SZA 
      RSS 
      JMP DED12 
* 
      DST MSTRC 
      JSB DBRED 
       DEF *+4
       DEF BASE,I 
       DEF STNUM
       DEF MSTRC
* 
      SZA           If any error, 
      JMP ERREX       pass code to user.
* 
*    7) Set the forward pointer's backward pointer to the deleted record's
*       backward pointer. 
* 
      LDA DBRBP 
      ADA INDEX 
      ADA D3
      STA TEMP
* 
      DLD PATHI,I 
      DST TEMP,I
* 
*    8) Write updated forward pointer to disc.
* 
      JSB DBWRT 
       DEF *+4
       DEF BASE,I 
       DEF STNUM
       DEF MSTRC
* 
      SZA           If any error, 
      JMP ERREX       pass code to user.
* 
*    9) Continue with next path.
* 
DED12 LDA INDEX     Update path index.
      ADA D4
      STA INDEX 
      ISZ CNTR1 
      JMP DED10 
      SKP 
* 
*  We come here after a successful deletion from either a manual master 
*  or detail data set to post the Free Record Table to disc and return
*  to the user. 
* 
DEL5  JSB DBWFR     DBWFR posts the FRT.
* 
DEL6  STA STAT,I    Returns status in A reg.
DEL7  CLA           Set STAT to zero for
      STA STAT        param check on next entry.
      JMP DBDEL,I 
* 
*  Error return points. 
* 
ERREX SSA           If error from some other
      CMA,INA         routine < 0, make it > 0. 
      JMP DEL6
E100  LDA D100      Invalid data set
      JMP DEL6
E103  LDA D103      Improperly opened data base.
      JMP DEL6
E104  LDA D104      Invalid open mode for a DEL.
      JMP DEL6
E108  LDA D108      Request directed to an auto-master. 
      JMP DEL6
E113  LDA D113      Master entry still has
      JMP DEL6        non-zero chains.
E114  LDA D114      Current record is empty.
      JMP DEL6
E115  LDA D115      Invalid DBDEL mode. 
      JMP DEL6
E118  LDA D118      Data set not writeable. 
      JMP DEL6
E154  LDA D154      Corrupt data base.
      JMP DEL6
E157  LDA D157      No current record.
      JMP DEL6
E159  LDA D159      Data base not locked. 
      JMP DEL6
E160  LDA D160      Corrupt Run Table.
      JMP DEL6
* 
*  Constants and variables. 
* 
M3    DEC -3
M2    DEC -2
D1    EQU ZERO+1
D2    EQU ZERO+2
D3    EQU ZERO+3
D4    EQU ZERO+4
D5    EQU ZERO+5
D6    EQU ZERO+6
D7    EQU ZERO+7
D100  DEC 100 
D103  DEC 103 
D104  DEC 104 
D108  DEC 108 
D113  DEC 113 
D114  DEC 114 
D115  DEC 115 
D118  DEC 118 
D154  DEC 154 
D157  DEC 157 
D159  DEC 159 
D160  DEC 160 
* 
LOBYT OCT 377 
HIBYT OCT 177400
* 
FLAG  NOP 
STNUM NOP 
STADR NOP 
RECRD BSS 2 
CNTR1 NOP 
CNTR2 NOP 
CNTR3 NOP 
MRADR NOP 
PATH# NOP 
CMPAR NOP 
ITEM1 NOP 
ITEM2 NOP 
PTADR NOP 
ITADR NOP 
MVLEN NOP 
INDEX NOP 
DRADR NOP 
MSNUM NOP 
MSADR NOP 
TEMP  NOP 
MSTRC BSS 2 
PTCNT NOP 
CURNT NOP 
PATHI NOP 
#KEYS NOP 
PTAD2 NOP 
MEDST DEF *+1 
      BSS 64
KEYBF DEF *+1 
      BSS 127 
BFEND DEF * 
      SKP 
* 
*  DBKEY is a utility subroutine for a detail delete which does all the 
*  necessary buffering of key item values.
* 
*  All the parameters it uses are global to DBPUT.
* 
DBKEY NOP 
* 
*  First time we are called, PATH# contains the value 1.  If first time,
*  we need to do a little initialization. 
* 
      LDA PATH# 
      CPA D1
      RSS 
      JMP KEY1
* 
*  Initialization 
*    Need:  # keys in buffer = zero.
*           copy of # paths negated for loop counter. 
*           copy of detail's Path Table address.
* 
      CLA 
      STA #KEYS 
* 
      LDA CNTR1 
      STA CNTR2 
* 
      LDA PTADR 
      STA PTAD2 
* 
      JMP KEY2
* 
*  Here after 1st time through.  See if there is another key value still
*  in buffer.  If not we must restock buffer. 
* 
KEY1  ISZ #KEYS 
      JMP KEY5      One there - get its address 
* 
*  No more keys left in buffer, we need to restock it from the detail 
*  record.  If this is first time through, we already have the detail 
*  record in the record buffer.  Else we must reread it.
* 
      JSB DBRED 
       DEF *+4
       DEF BASE,I   DBRED needs: data base #
       DEF STNUM                 data set # 
       DEF RECRD                 record number
* 
      SZA           If an error,
      JMP ERREX       pass code to user.
* 
*  Join procesing for 1st & nth time through.  Loop on the remainder of 
*  the Path Table (count is in CNTR2) picking up the detail's key item
*  for the path.  Call DBFDI to give us the item's Item Table pointer 
*  then get the item's length from the 7th word of the entry. 
* 
KEY2  LDA KEYBF     Set current key item pointer
      STA CURNT       to beginning of buffer. 
* 
KEY3  LDA PTAD2,I 
      ALF,ALF 
      AND LOBYT 
      STA ITEM1 
* 
      JSB DBFDI 
       DEF *+5
       DEF ITEM1    DBFDI needs: item reference 
       DEF ITEM2        returns: item number
       DEF FLAG                  accessibility flag 
       DEF ITADR                 Item Table entry pointer 
* 
      LDA ITEM2     If DBFDI returned an item # 
      SZA,RSS         of zero (item invalid)
      JMP E160        Run Table is corrupt. 
* 
      LDB ITADR 
      ADB AIRUN 
      ADB ITLNG 
      LDA B,I       Save item length for bound
      STA MVLEN       checking & data move. 
* 
*  Determine if the item will fit in the buffer by adding the length of 
*  the item to the current position in the buffer, then subtracting the 
*  result from the end of the buffer.  If the final result is non-negative
*  the item will fit.  Else the buffer is as full as we can get it. 
* 
      ADA CURNT 
      CMA,INA 
      ADA BFEND 
      SSA 
      JMP KEY4
* 
*  Ask DBCIX to determine the index of the key item into the data record. 
* 
      JSB DBCIX 
       DEF *+4
       DEF ITEM2    DBCIX needs: item number
       DEF STADR                 DSCB 
       DEF INDEX        returns: index (-1 if error)
* 
      LDA INDEX     If index < 0
      SSA 
      JMP E160        Run Table corrupt!
* 
*  Get address of key item in data record in A register and address of
*  current position in buffer in B register.  Then move the item into 
*  the buffer.
* 
      ADA DRADR 
      LDB CURNT 
      JSB .MVW
       DEF MVLEN
       DEC 0
* 
      STB CURNT     B = new current address.
* 
*  Continue until buffer is full, or all keys are in it.
* 
      ISZ PTAD2 
      ISZ PTAD2 
      ISZ #KEYS     Increment # keys in buffer. 
      ISZ CNTR2 
      JMP KEY3
* 
*  We fall through loop here at end of paths in data set or jump here at
*  end of room in buffer.  Negate the number of keys in the buffer for
*  a counter.  Put the address of the buffer as current pointer and re- 
*  turn it as key item address. 
* 
KEY4  LDA #KEYS 
      CMA,INA 
      STA #KEYS 
* 
      LDA KEYBF 
      STA CURNT 
      JMP KEY6
      SKP 
* 
*  We come here when we only need to get the next key item's address and
*  it is in the buffer.  The current path number (in PATH#) is used to in-
*  dex into the Path Table by: (PATH# - 2) * 2 + PTADR.  This entry then
*  contains the item number of the last key item accessed in its first byte.
* 
KEY5  LDB M2
      ADB PATH# 
      BLS 
      ADB PTADR 
      LDA B,I 
      ALF,ALF 
      AND LOBYT 
      STA ITEM1 
* 
*  Ask DBFDI to get the item's Item Table entry for us.  From this we get 
*  the item's length (7th word of entry). 
* 
      JSB DBFDI 
       DEF *+5
       DEF ITEM1
       DEF ITEM2
       DEF FLAG 
       DEF ITADR
* 
      LDA ITEM2 
      SZA,RSS       If returned item # = 0, 
      JMP E160        Run Table is corrupt. 
* 
      LDA ITADR 
      ADA AIRUN 
      ADA ITLNG 
      LDB A,I 
* 
*  Add the item's length to our current position to get the next key item's 
*  address (the new current position).
* 
      ADB CURNT 
      STB CURNT 
* 
*  Return to caller.
* 
KEY6  JMP DBKEY,I 
      END 
                                                                                                                                                                              