ASMB,L,C,R
      HED DBINF SUBROUTINE OF IMAGE/1000
      NAM DBINF,7 92069-16137 REV.2026 800125 
* 
* 
******************************************************************* 
* (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-18137
*     RELOC:     92069-16137
* 
*     PRGMR:     CEJ
*     ALTERED:   JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ 
*                JANUARY 22, 1980 TO ALLOW FOR SAVING OF CURRENT
*                                 RECORDS IN A MASTER SET - CEJ 
* 
* 
******************************************************************* 
* 
* 
* 
*  Data Base INFormation is one of the ten user callable IMAGE/1000 
*  library subroutines.  DBINF's function is to reference the Run Table 
*  to return information on the structure and current state of the data 
*  base.  DBINF has four general catagories of information it returns.
*  These are: 
* 
*    100 Series:  Data Item Information 
*    200 Series:  Data Set Information
*    300 Series:  Data Path Information 
*    400 Series:  Current Path Information
* 
*  Each category contains specific requests.  Each request is assigned a
*  DBINF mode.  The modes allowed for DBINF are:
* 
*    101 - determine data item number and accessibility.
*    102 - describe data item 
*    103 - enumerate all accessible data items in the data base.
*    104 - enumerate all accessible data items in a specific data set.
*    201 - determine data set number and accessibility. 
*    202 - describe data set. 
*    203 - enumerate all accessible data sets in the data base. 
*    204 - enumerate all accessible data sets which containe a specific 
*            data item. 
*    301 - enumerate all data sets linked to specific data set, the 
*            detail data set search item numbers used for the links and 
*            the sort item (if any) for the link. 
*    302 - determine the search item number of a specific master data set.
*    401 - save current record information for a specific data set. 
*    402 - restore current record information for a specific data set 
* 
*  The calling sequence for DBINF is: 
* 
*       JSB DBINF 
*        DEF *+6        return point
*        DEF IBASE      data base about which information is to be returned.
*                         This must be the same parameter as used in a
*                         successful DBOPN call for the data base.
*        DEF ID         a data set name or number   or
*                       a data item name or number
*                         (When the mode calls for a specific set or item.) 
*        DEF MODE       request mode, legal values are as described above.
*        DEF STAT       status return array of the form:
*                         1st word always the status word, zero on a suc- 
*                           cessful return
*                         2nd word contains the word length of the informa- 
*                           tion in the BUF parameter when 1st word is
*                           zero. 
*        DEF BUF        buffer to contain returned information (supplied
*                         information on a 402 call).  A description of 
*                         the returned information in BUF precedes each 
*                         mode process in the following code. 
* 
      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 DBINF 
      EXT .DSBR,.ENTR,.MVW
      EXT AIRUN,DBFDI,DBFDS,DBIDS,RBINF 
A     EQU 0 
B     EQU 1 
* 
BASE  NOP 
ID    NOP 
MODE  NOP 
STAT  NOP 
BUF   NOP 
* 
*  Get true parameter and return point addresses. 
* 
DBINF NOP 
      JSB .ENTR 
       DEF BASE 
* 
*  Make sure all the parameters are there.
* 
      LDA BUF 
      SZA,RSS 
      JMP E162      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 RBINF     Remote data base retunrn. 
       DEF *+6      Ask RBINF to handle this request. 
       DEF BASE,I 
       DEF ID,I 
       DEF MODE,I 
       DEF STAT,I 
       DEF BUF,I
      JMP INF2      Return to caller. 
* 
*  Do a case on the mode parameter (MODE) to determine what kind of in- 
*  formation the user requests and where to process the request.  The case
*  is performed by dividing the mode parameter by 100 and checking the
*  bounds of the quotient and remainder.  The quotient must be within 
*  [1,4], the remainder within [1,4].  Then, use the two values as an index 
*  into a jump table.  Four entries in this table are actually error re-
*  turns since any combination of quotient within [3,4] and remainder 
*  within [3,4] is invalid. 
* 
LOCAL LDA MODE,I
      SSA           Is mode < 0?
      JMP E124        Yes - illegal mode. 
      CLB 
      DIV D100
* 
      SZA,RSS       Is quotient > 0 
      JMP E124
      CMA,INA         and <= 4? 
      ADA D4
      SSA 
      JMP E124        No - illegal mode.
* 
      SZB,RSS       Is remainder > 0
      JMP E124
      CMB,INB         and <= 4? 
      ADB D4
      SSB 
      JMP E124        No - illegal mode.
* 
*  Put quotient into bits 2 & 3 of A register and remainder in bits 0 & 1.
*  This becomes, then, a four bit index within [0,15] into the jump table.
*  The index numbers 0,1,4, and 5 are illegal.
* 
      ALS,ALS 
      IOR B 
* 
      ADA JMPTB 
      JMP A,I 
* 
JMPTB DEF *+1 
      JMP E124      mode = 404
      JMP E124      mode = 403
      JMP M412      mode = 402
      JMP M412      mode = 401
* 
      JMP E124      mode = 304
      JMP E124      mode = 303
      JMP M302      mode = 302
      JMP M301      mode = 301
* 
      JMP M204      mode = 204
      JMP M203      mode = 203
      JMP M202      mode = 202
      JMP M201      mode = 201
* 
      JMP M104      mode = 104
      JMP M103      mode = 103
      JMP M102      mode = 102
      JMP M101      mode = 101
      SKP 
* 
*  Mode = 101.
*  BUF returned with: 
*    word                    contents 
*    ----                    -------- 
*     1         + or - data item number,
*                      positive if item read-only 
*                      negative if item readable and writeable
* 
*  ID should contain an item name or number.  Ask DBFDI to get the item's 
*  number and accessibility.
* 
M101  JSB DBFDI 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
      JMP M101A 
* 
*  Mode = 201.
*  BUF returned with: 
*    word                     contents
*    ----                     --------
*     1            + or - data set number 
*                    (positive if set readable, and possibly updateable 
*                     negative if entries may be added or deleted from
*                     the set.) 
* 
*  ID should contain a data set name or number.  Ask DBFDS to get the 
*  set's number and accessibility for us. 
* 
M201  JSB DBFDS 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
*  If DBFDI (or DBFDS) returns a zero item (or set) number or sets the ac-
*  cessibility FLAG to > 0, the user gave us a bad item (or set) name or
*  number.  Else if FLAG was set < 0 the item (or set) is writeable, negate 
*  its number.
* 
M101A LDA NUMBR 
      SZA,RSS 
      JMP E125      Bad item (or set) parameter.
* 
      LDB FLAG      If the flag was set > 0 
      CMB,INB         then this will set it < 0 
      SSB 
      JMP E125      Bad item (or set) parameter.
* 
      SZB           If item (or set) writeable, 
      CMA,INA         negate its number.
* 
*  Put the number in BUF array and set the length of the information in 
*  BUF to 1 word.  Then take the successful reply exit. 
* 
      STA BUF,I 
      CLB,INB 
      JMP INF1
      SKP 
* 
*  Mode = 102.
*  BUF returned with: 
*     word                    contents
*     ----                    --------
*      1-8         data item name, left-justified and padded with 
*                    trailing blanks. 
*       9          bits 0-7  an ASCII blank 
*                  bits 8-15 ASCII data item type: either I, R, or X
*       10         element length in words if type is I or R, 
*                    in bytes if type is X
*       11         element count
*     12-13        zero 
* 
*  ID should contain an item name or number.  Ask DBFDI to get the item's 
*  number, accessibility and Item Table entry address (relative to begin- 
*  ning of Run Table) for us. 
* 
M102  JSB DBFDI 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
*  If DBFDI returned a zero item number or set the accessibility FLAG to
*  > 0, the user gave us a bad item parameter.
* 
      LDA NUMBR 
      SZA,RSS 
      JMP E125      Bad item parameter. 
* 
      LDA FLAG
      CMA,INA 
      SSA 
      JMP E125
* 
*  Item parameter okay.  Move the item name (first 3 words of item's entry) 
*  item type (low order byte of 4th word of item entry) and element count 
*  (low order byte of 6th word of item entry) into the return buffer, pad-
*  ding the name to 16 characters with trailing blanks.  Then calculate 
*  the element length by dividing the item's length (7th word of item 
*  entry) by the element count and store it in BUF. 
* 
      LDA AIRUN     Get true address of item's Item Table 
      ADA ADDRS       entry by adding to Run Table address. 
      STA ADDRS 
      LDB BUF       Get address of BUF
      JSB .MVW        and move the item name into it. 
       DEF D3 
       DEC 0
* 
      LDA M5        Pad it with 5 words of blanks.
      STA CNTR
      LDA BLNKS 
M102A STA B,I 
      INB 
      ISZ CNTR
      JMP M102A 
      STB BUF       Save place in BUF for later.
* 
      CCA           Set item type is X FLAG 
      STA FLAG        to FALSE. 
      LDB ADDRS     Get item's type.
      ADB ITTYP 
      LDA B,I 
      AND LOBYT 
      ALF,ALF 
      IOR ABLNK     Pad it on bottom with a blank and 
      STA BUF,I       put it into BUF.
      ISZ BUF 
* 
      CPA /X        If item type is X,
      RSS 
      JMP M102B 
      CLA             set FLAG to TRUE. 
      STA FLAG
* 
M102B ADB D2        Get element count 
      LDA B,I 
      AND LOBYT 
      STA TEMP        and save for divide.
* 
      INB           Get item length in A & B regs.
      LDA B,I 
      CLB 
      ISZ FLAG      If item type = X
      ALS             (FLAG = TRUE) get length in bytes.
* 
      DIV TEMP      Divide it by the element count. 
      STA BUF,I     A = element length. 
      ISZ BUF 
* 
      LDA TEMP
      STA BUF,I     Put element count into BUF
      ISZ BUF 
* 
      CLA 
      CLB 
      DST BUF,I     End with two zeroes in BUF. 
* 
*  BUF complete.  Now set length of returned data to 13 and take the
*  successful reply exit. 
* 
      LDB D13 
      JMP INF1
      SKP 
* 
*  Mode = 103.
*  BUF returned with: 
*    word                       contents
*    ----                       --------
*      1            n = data item count 
*      2            + or - data item number 
*      .              (positive if item read-only 
*      .               negative if item readable and writeable) 
*      .
*    n+1            + or - data item number 
* 
*  Ignore ID parameter.  Get the uumber of items in the data base (7th
*  word of the DBCB) and loop for each item calling DBFDI to determine
*  accessibility of the item.  If accessible, then store the current item 
*  number (or the negative of the current item number if the item is
*  writeable) in the buffer array (BUF) and increment the accessible item 
*  count.  If inaccessible, just continue with next item. 
* 
M103  LDA AIRUN     First get item count. 
      ADA DBICT 
      LDB A,I 
      JMP M103A 
* 
*  Mode = 203.
*  BUF returned with: 
*    word                     contents
*    ----                     --------
*      1           n = number of data sets
*      2           + or - data set number 
*      .             (positive if entries may 'not' be added or deleted,
*      .              negative if entries may be added or deleted.) 
*      .
*    n+1           + or - data set number 
* 
*  ID is ignored.  Get the number of data sets in the data base (9th word 
*  of the DBCB) and loop for each set calling DBFDS to determine the ac-
*  cessibility of the set.  If accessible, then store the current set 
*  number (or the negative of the set number if the set is writeable) in
*  BUF, and increment the accessible set count.  If inaccessible, just
*  continue with next set.
* 
M203  LDA AIRUN     First get set count.
      ADA DBSCT 
      LDB A,I 
* 
*  Initialize loop parameters.
* 
M103A CMB,INB       Loop counter =
      STB CNTR        negative of item (or set) count.
      CLB 
      STB LENTH     Zero to length of returned data.
      INB 
      STB ID        A 1 to first item (or set) number 
      LDB BUF       Save address of 1st word in BUF 
      STB TEMP        for later 
      ISZ BUF         then point BUF to its 2nd word. 
* 
*   BEGIN LOOP
* 
M103B LDA MODE,I    If MODE = 103 
      CPA D103        call DBFDI
      JMP M103C       else call DBFDS 
* 
      JSB DBFDS     Ask DBFDS to define the set's 
       DEF *+5        accessibility for us. 
       DEF ID 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
      JMP M103D 
* 
M103C JSB DBFDI     Ask DBFDI to define item's accessibility
       DEF *+5        for us. 
       DEF ID 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
M103D LDA NUMBR     Item (or set) number can't be zero or 
      SZA,RSS         we've got a bad Run Table.
      JMP E160
* 
      LDB FLAG      If item (or set) inaccessible (FLAG > 0)
      CMB,INB 
      SSB 
      JMP M103E       just continue on with next one. 
* 
      SZB           Else, if item (or set) writeable
      CMA,INA         negate its number.
* 
      STA BUF,I     Put the number in the BUF array.
      ISZ BUF 
      ISZ LENTH     Bump the length/count parameter.
M103E ISZ ID        Continue with next item (or set), 
      ISZ CNTR        if there is one.
      JMP M103B 
* 
*  LENTH now contains the number of accessible items (or sets) as well as 
*  the combined word length of their numbers.  Put the number of items (or
*  sets) in the first word of BUF (remember we saved it above in TEMP), and 
*  increment the word length again for the word taken by the count.  Then 
*  take the successful reply exit.
* 
      LDB LENTH 
      STB TEMP,I
      INB 
      JMP INF1
      SKP 
* 
*  Mode = 104.
*  BUF returned with: 
*    word                        contents 
*    ----                        -------- 
*      1          n = data item count 
*      2          + or - data item number 
*      .            (positive if item read-only 
*      .             negative if item readable and writeable) 
*      .
*    n+1          + or - data item number 
* 
*  ID should contain a data set name or number.  Ask DBFDS to check ID
*  for validity and return us the accessibility of the set and its entry
*  address in the Data Set Control Block Table (relative to the start of
*  the Run Table) if it is valid. 
* 
M104  JSB DBFDS 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If the returned set number
      SZA,RSS         is zero 
      JMP E125
* 
      LDA FLAG        or the asseccibility FLAG > 0 
      CMA,INA 
      SSA 
      JMP E125        then the user gave us a bad set reference.
* 
*  ID okay.  Now, determine the number of items in the data set (high 
*  order byte of the 7th word in the DSCB), and the address of the data 
*  set's Record Definition Table.  This is: 
*    address of Run Table (in AIRUN) +
*    pointer to the data set's Info Table entry (in 8th word of the DSCB).
* 
      LDB ADDRS     Address returned by DBFDS is relative 
      ADB AIRUN       to beginning of Run Table.
      ADB DSFCT 
      LDA B,I 
      ALF,ALF 
      AND LOBYT     A = # fields (items) in data set. 
      CMA,INA       Negate it for a loop counter. 
      STA CNTR
* 
      INB 
      LDA B,I 
      ADA AIRUN     A = set's RDT address 
      STA NEXT        save for loop.
* 
*  Now, for each item in the RDT, ask DBFDI to determine the accessibi- 
*  lity of the item.  If the item accessible, then if the item is write-
*  able, negate the item number, put item number in BUF.  (Remember that
*  each item number in the RDT is stored in a byte.  Therefore, each word 
*  in the RDT is processed twice, once for its high byte item number, and 
*  once for its low byte item number.)
* 
      LDA BUF       Save address of 1st word in BUF 
      STA TEMP        array for later and 
      ISZ BUF         point BUF to its 2nd word.
      CLA           Zero to the returned length/
      STA LENTH       item count word.
* 
M104A CCA           Set first flag to minus one,
      STA FIRST       signifies that we are processing high byte. 
* 
      LDA NEXT,I    Get next item number
      ALF,ALF         from high byte in RDT entry.
M104B AND LOBYT 
      STA ID
* 
      JSB DBFDI     Ask DBFDI to check the item's 
       DEF *+5        accessibility.
       DEF ID 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If item number returned as zero,
      SZA,RSS 
      JMP E160        we have a bad Run Table.
* 
      LDB FLAG      If accessibility FLAG set > 0 
      CMB,INB 
      SSB 
      JMP M104C       just continue with next item. 
* 
      SZB           Else, if accessibility FLAG set < 0 
      CMA,INA         negate item number. 
      STA BUF,I     Put number in BUF 
      ISZ BUF         and increment both BUF address
      ISZ LENTH       and the item count. 
* 
M104C ISZ CNTR      Are we through with all items?
      RSS 
      JMP M104E       Yes - wrap up this request. 
* 
      ISZ FIRST       No - were we processing high order byte?
      JMP M104D         No - get next word
      LDA NEXT,I      Yes - get low order byte
      JMP M104B         and process it. 
* 
M104D ISZ NEXT
      JMP M104A 
* 
*  We are done with each item in the data set.  LENTH contains the item 
*  count.  Put it in the first word of BUF, then increment it for the first 
*  word and it is the word length of the information in BUF.  Then return 
*  successful to the user.
* 
M104E LDB LENTH 
      STB TEMP,I
      INB 
      JMP INF1
      SKP 
* 
*  Mode = 202.
*  BUF returned with: 
*    word                       contents
*    ----                       --------
*     1-8            data set name, left-justified and padded with
*                      trailing blanks
*      9             bits 0-7:  an ASCII blank
*                    bits 8-15: ASCII data set type, either M, A, or D
*      10            length of entry in words 
*    11-13           zero 
*    14-15           doubleword number of entries in set
*    16-17           doubleword capacity of set 
* 
*  ID should contain a set name or number.  Ask DBFDS to get the set's
*  accessibility and Set Control Block Table entry address (relative to 
*  beginning of Run Table). 
* 
M202  JSB DBFDS 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
*  If DBFDS returned a set number of zero or set the accessibility FLAG 
*  to > 0, the user gave us a bad set reference.
* 
      LDA NUMBR 
      SZA,RSS 
      JMP E125
* 
      LDA FLAG
      CMA,INA 
      SSA 
      JMP E125
* 
*  Set reference okay.  Move set name (first 3 words of DSCB) padded to 
*  8 words with blanks, set type (code in second nibble of high order byte
*  in 5th word of DSCB), and data record length (6th word of DSCB) into 
*  BUF, then pad BUF with three zeroes. 
* 
      LDA AIRUN     Set's entry address of relative to
      ADA ADDRS       beginning of Run Table. 
      STA ADDRS 
      LDB BUF 
      JSB .MVW
       DEF D3 
       DEC 0
* 
      LDA M5        Pad name with 5 words of blanks.
      STA CNTR
M202A LDA BLNKS 
      STA B,I 
      INB 
      ISZ CNTR
      JMP M202A 
      STB BUF 
* 
      LDB ADDRS 
      ADB DSTYP 
      LDA B,I 
      ALF,RAL       Get two bit type code in sign and 
      LDB /D          least significant bits of reg. A. 
      SLA,RSS       If code = 0 (neither bit set) 
      LDB /A          data set an auto. master. 
      SSA           If code = 1 (sign bit set)
      LDB /M          data set a manual master. 
      STB BUF,I     Else, data set a detail.
      ISZ BUF 
* 
      LDB ADDRS     Finally, get the data 
      ADB DSDRL       record length 
      LDA B,I 
      STA BUF,I     Put it into BUF 
      ISZ BUF         and pad BUF with three zeroes.
      CLA 
      STA BUF,I 
      ISZ BUF 
      STA BUF,I 
      ISZ BUF 
      STA BUF,I 
      ISZ BUF 
* 
*  Get capacity from DSCB (16th and 17th words) and save.  Then determine 
*  the number of records used in data set by: 
*    number of records used = capacity of data set -
*      number of free records in set (1st & 2nd words in the data set's 
*      entry in the free record table). 
*  Store both the number of used records and the capacity (both double- 
*  words) in BUF. 
* 
      ADB D3
      DLD B,I 
      DST CAPAC 
* 
      CCA           Set's relative (to beginning of FRT) free record
      ADA NUMBR       table entry is: (set # -1) * FRLNG. 
      CLB 
      MPY FRLNG 
* 
      LDB AIRUN     FRT's relative (to start of RT) address 
      ADB DBFRP       is in the 13th word of the DBCB.
      LDB B,I 
      ADB AIRUN 
* 
      ADA B         Get FRT entry.
      DLD A,I       # free records in first two words.
      JSB .DSBR     Then subtract is from the capacity of set 
       DEF CAPAC      and A & B will be the # of used records.
* 
      DST BUF,I     Put number of used records
      ISZ BUF 
      ISZ BUF 
      DLD CAPAC       and capacity of data set
      DST BUF,I       into BUF. 
* 
*  BUF complete.  Set word length of returned data to 17 and take the 
*  successful reply exit. 
* 
      LDB D17 
      JMP INF1
      SKP 
* 
*  Mode = 204.
*  BUF returned with: 
*    word                     contents
*    ----                     --------
*      1          n = number of data sets 
*      2          + or - data set number
*      .            (positive if entries may 'not' be added or deleted
*      .             negative if entries may be added or deleted) 
*      .
*    n+1          + or - data set number
* 
*  ID should contain an item name or number.  Ask DBFDI to check it for 
*  validity and accessibility.  If valid, we also get the item's Item 
*  Table entry address relative to the beginnig of the Run Table. 
* 
M204  JSB DBFDI 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     Item is invalid if
      SZA,RSS         returned item number is zero. 
      JMP E125
      STA TEMP
* 
      LDA FLAG      Item is inaccessible if 
      CMA,INA         returned accessibility FLAG > 0.
      SSA 
      JMP E125
* 
*  Get the number of sets this item is in (high order byte of 5th word
*  of item's entry) and first set's number (low order byte of 5th word
*  in entry). 
* 
      LDB AIRUN 
      ADB ADDRS 
      ADB ITSET 
* 
      LDA B,I 
      ALF,ALF 
      AND LOBYT 
      CMA,INA       Will use the negative of the # of 
      STA CNTR        sets as a loop counter. 
* 
      LDA B,I 
      AND LOBYT 
      STA ID        The loop starts with the 1st set for item.
* 
      CLA           Set length/set count word to zero.
      STA LENTH 
* 
      LDA BUF       Save address of 1st word of BUF 
      STA SAVE
      ISZ BUF         and point BUF to its 2nd word.
* 
*  Will use the number of data sets in the data base - all data sets
*  previous to the first data set containing the data item as a loop
*  counter to tell us when all the data sets in the data base have
*  been checked.
* 
      LDA AIRUN 
      ADA DBSCT 
      LDA A,I 
      CMA 
      ADA ID
      STA CNTR2 
* 
*  Now, loop on each data set starting with the first set number and con- 
*  tinuing in a serially increasing fashion, checking to see if the item
*  is in the data set's Record Definition Table until the number of data
*  sets the item is in is matched by the number of data sets in which the 
*  item appears in the RDT.  For each set the item appears in, determine
*  the set's accessibility (Note:  if the set is totally inaccessible the 
*  Run Table is corrupt since we know at least one item in the set which
*  is accessible).  Put the number of the set (negated if set writeable)
*  in BUF.  This loop also keeps a running count of the number of sets
*  containing the item. 
* 
M204A JSB DBFDS     Ask DBFDS to get set's entry address
       DEF *+5        (relative to start of Run Table)
       DEF ID         and accessibility.
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     Returned set number can't be zero 
      SZA,RSS 
      JMP E160        else Run Table is corrupt.
* 
      LDB AIRUN     Get data set's item count (high 
      ADB ADDRS       order byte of 7th word of DSCB) 
      ADB DSFCT 
      LDA B,I 
      ALF,ALF 
      AND LOBYT 
      CMA,INA         and negate it for a loop counter
      STA ITCNT 
* 
      INB             and get data set's Record Definition
      LDA B,I         Table address from pointer (in 8th word 
      ADA AIRUN       of DSCB) added to the address of the
      STA ADDRS       Run Table.
* 
*  Each item in the RDT takes only one byte.  Therefore each word in the
*  RDT is checked twice, once for the item in the high order byte and 
*  once for the item in the low order byte. 
* 
M204B CCA           Set processing first byte flag. 
      STA FIRST 
      LDA ADDRS,I 
      ALF,ALF       Get item # from first byte. 
      AND LOBYT 
* 
M204C CPA TEMP      Does it match the one the user gave?
      JMP M204E       Yes 
* 
      ISZ ITCNT       No - is it last in RDT? 
      RSS 
      JMP M204F         Yes 
* 
      ISZ FIRST         No - were we processing 1st byte? 
      JMP M204D           No - get next word
* 
      LDA ADDRS,I         Yes - get low byte. 
      AND LOBYT 
      JMP M204C 
* 
M204D ISZ ADDRS 
      JMP M204B 
* 
*  We come here when an item in the RDT matched the item the user gave us.
*  Determine if the set is writeable (NUMBR and FLAG from DBFDS have not
*  been changed) and store the appropriately signed set number in BUF.
* 
M204E LDA NUMBR 
      LDB FLAG
      SSB 
      CMA,INA 
      STA BUF,I 
      ISZ BUF 
      ISZ LENTH 
      ISZ CNTR      Found them all? 
      JMP M204F       No
* 
*  All data sets with the item found.  Put set count (in LENTH remember)
*  into first word of BUF.  Increment the count and it is the word length 
*  of the information in BUF.  Then take the successful reply exit. 
* 
      LDB LENTH 
      STB SAVE,I    Save set to 1st word of BUF above.
      INB 
      JMP INF1
* 
*  Here when we are through with this data set. 
* 
M204F ISZ ID        Continue on with next data set
      ISZ CNTR2       if there is one left. 
      JMP M204A 
      JMP E160      If not, the Run Table is corrupt! 
      SKP 
* 
*  Mode = 301.
*  BUF returned with: 
*    word                        contents 
*    ----                        -------- 
*      1             n = number of paths
*      2             data set number of related data set
*      3             detail's search item number
*      4             path's sort item number
*      .
*      .
*      .
*   3n-1             data set number of related data set
*     3n             detail's search item number
*   3n+1             path's sort item number
* 
*  ID should contian a data set name or number.  Ask DBFDS to validify
*  ID and if valid to give us the data set's Data Set Control Block Table 
*  entry address (relative to start of Run Table).
* 
M301  JSB DBFDS 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If the set # returned by DBFDS
      SZA,RSS         is zero,
      JMP E125        user gave us a bad set reference. 
* 
      LDB FLAG      If the returned accessibility FLAG
      CMB,INB         is > 0
      SSB 
      JMP E125        user gave us a bad set reference. 
* 
*  Get the set's number of paths from the DSCB (low order byte of the 
*  7th word).  Then calculate the Path Table address by:
*    Path Table address = Pointer to Info Table (8th word of DSCB) +
*    (# of fields in set <<high order byte of 7th word of DSCB>> - 1) / 2 + 
*    address of Run Table.
* 
      LDB AIRUN 
      ADB ADDRS 
      ADB DSPCT 
      LDA B,I 
      AND LOBYT 
      SZA,RSS       If path count is zero 
      JMP M301D       skip around the processing below. 
      CMA,INA       Negate # paths for a loop counter.
      STA CNTR
* 
      LDA B,I       Get # fields
      ALF,ALF 
      AND LOBYT 
      INA             increment and divide by two 
      ARS 
      INB             add in the relative address of the Info Table 
      ADA B,I 
      ADA AIRUN       then add in the address of the Run Table. 
      STA NEXT
* 
*  Loop on each path, determining if its search item number in the Path 
*  Table entry is accessible.  (Note:  this item always belongs to the
*  detail.)  If so, put related data set's number (2nd byte of the PT 
*  entry) and the detail search item number (1st byte of the PT entry)
*  in BUF followed with the number of the item on which the path is 
*  sorted.  The sort item is in the second word of the path table entry.
*  It is put into BUF only if it is accessible by the user.  Each time
*  an accessible path is incountered, the path counter is also increased. 
* 
      LDA BUF       Save address of 1st word in BUF for later.
      STA TEMP
      ISZ BUF       Point BUF to its 2nd word.
* 
      CLA           Set path count to zero. 
      STA LENTH 
M301A LDA NEXT,I    Get search item # from PT entry.
      ALF,ALF 
      AND LOBYT 
      STA ID
* 
      JSB DBFDI     Ask DBFDI to determine the
       DEF *+5        item's accessibility. 
       DEF ID 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If DBFDI returned a zero item # 
      SZA,RSS 
      JMP E160        the Run Table is corrupt. 
* 
      LDB FLAG      If DBFDI set the accessibility
      CMB,INB         FLAG to > 0 
      SSB             then item is inaccessible,
      JMP M301C       skip this path
* 
      LDA NEXT,I    Else, store related data set #
      AND LOBYT 
      STA BUF,I 
      ISZ BUF 
      LDA NUMBR       and detail's item # into BUF
      STA BUF,I 
      ISZ BUF 
* 
      LDB NEXT      Get sort item's number. 
      INB 
      LDA B,I 
* 
      SZA,RSS       If zero,
      JMP M301B       no sort item. 
* 
      STA ID
      JSB DBFDI     Ask DBFDI to determine
       DEF *+5        sort item's accessibility.
       DEF ID 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If DBFDI returned a zero, 
      SZA,RSS         the Run table is corrupt! 
      JMP E160
* 
      LDB FLAG      If FLAG > 0,
      CMB,INB         item is inaccessible. 
      SSB 
      CLA 
* 
M301B STA BUF,I     Store sort item # or zero in BUF. 
      ISZ BUF 
* 
      ISZ LENTH     Bump the path count 
M301C ISZ NEXT        and the Path Table entry address. 
      ISZ NEXT
      ISZ CNTR      Are we through with all paths?
      JMP M301A       No - continue with next path. 
* 
*  We come here at the end of the Path Table processing.  LENTH contains
*  the number of paths that had accessible search items (and therefore
*  the number of paths whose description is in BUF.  Put the count in the 
*  first word of BUF.  Then multiply the count by three and add 1, this 
*  gives us the word length of the information in BUF, and take the suc-
*  cessful reply exit.
* 
      LDA LENTH     Address of 1st word of BUF
      STA TEMP,I      saved above in TEMP.
      CLB 
      MPY D3
      INA 
      LDB A 
      JMP INF1
* 
*  We come here when the data set has no paths.  Set the path count in
*  BUF to zero and the length of returned data to one, then take the
*  successful reply exit. 
* 
M301D STA BUF,I 
      CLB,INB 
      JMP INF1
      SKP 
* 
*  Mode = 302.
*  BUF returned with: 
*    word                       contents
*    ----                       --------
*      1             master's search item number
*      2             zero 
* 
*  ID should contain a master data set name or number.  Ask DBFDS to check
*  the validity of the data set reference and five us the set's Set Control 
*  Block Table entry address (relative to start of Run Table) if the set
*  is valid.
* 
M302  JSB DBFDS 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If DBFDS returned a set # of zero 
      SZA,RSS 
      JMP E125
* 
      LDB FLAG        or an accessibility FLAG of > 0 
      CMB,INB         (i.e. set inaccessible) 
      SSB 
      JMP E125        user gave us a bad set reference. 
* 
*  Now check if the data set is a master.  The set type code is in the
*  2nd nibble of the 5th word of the DSCB.  If it is a master get its 
*  search item number (high order byte of 11th word of DSCB). 
* 
      LDB AIRUN 
      ADB ADDRS 
      ADB DSTYP 
      LDA B,I 
      ALF           If type = 2 
      SSA             (sign bit set after the rotate) 
      JMP E123        the data set is a detail. 
* 
      ADB D6
      LDA B,I 
      ALF,ALF 
      AND LOBYT 
      STA ID
* 
*  Ask DBFDI to check accessibility of search item.  If it is accessible, 
*  put the search item followed by a zero in BUF.  If not, put two zeroes 
*  in BUF.
* 
      JSB DBFDI 
       DEF *+5
       DEF ID 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If DBFDI returned a zero item # 
      SZA,RSS 
      JMP E160        the Run Table is corrupt. 
* 
      LDB FLAG      If DBFDI returned a > 0 accessibility FLAG, 
      CMB,INB 
      SSB 
      CLA             item is inaccessible. 
* 
      STA BUF,I 
      ISZ BUF 
      CLA 
      STA BUF,I 
* 
*  Set returned data word length to two and take the successful reply 
*  exit.
* 
      LDB D2
      JMP INF1
      SKP 
* 
*  Mode = 401 or 402
*  For mode 401 BUF returned with:
*    word                       contents
*    ----                       --------
*     1-2          doubleword record number of the most recently
*                    accessed record
*     3-4          doubleword record number of previous record in 
*                    chain if a detail, zero if a master
*     5-6          doubleword record number of next record in chain 
*                    if a detail, zero if a master
*      7           path number of current chain if a detail, zero 
*                    if a master
* 
*  For mode 402 BUF is passed to us with the above information. 
* 
*  ID should contain a data set name or number.  Ask DBFDS to check 
*  it for validity and pass us the data set's entry in the Data Set Control 
*  Block Table (relative to start of Run Table).
* 
M412  JSB DBFDS 
       DEF *+5
       DEF ID,I 
       DEF NUMBR
       DEF FLAG 
       DEF ADDRS
* 
      LDA NUMBR     If DBFDS returned a zero
      SZA,RSS         set number
      JMP E125
* 
      LDA FLAG        or an accessibility FLAG
      CMA,INA         of > 0
      SSA 
      JMP E125        the set reference is bad. 
* 
*  Get the data set's DSCB address and index into record information. 
* 
      LDB AIRUN 
      ADB ADDRS 
      STB ADDRS 
      ADB DSRCN 
* 
*  If mode is 401, move the current, previous and next record numbers 
*  from the DSCB (12th through 17th words) and the current path number
*  (low order byte of 11th word of the DSCB) into BUF.
* 
      LDA MODE,I
      CPA D402
      JMP M402
* 
      LDA B         Get current chain info
      LDB BUF        and put into BUF.
      JSB .MVW
       DEF D6       This puts record #s into BUF. 
       DEC 0
      STB BUF       Save place in BUF.
* 
      LDB ADDRS     Now get current path number.
      ADB DSPAN 
      LDA B,I 
      AND LOBYT 
      STA BUF,I 
      JMP M412B 
* 
*  If mode 402, move the three record numbers from BUF into the 12th
*  through 17th words of the DSCB, and put the path number in BUF into
*  the DSCB (low order byte of 11th word).
* 
M402  LDA BUF       Move the record numbers 
      JSB .MVW        into the DSCB.
       DEF D6 
       DEC 0
* 
      STA BUF       Save adress of current path # in BUF. 
      LDB ADDRS 
      ADB DSPAN     Get its word in DSCB
      LDA B,I       Save off the serach item # in 
      AND HIBYT       high byte of word and 
      IOR BUF,I       put in path number
      STA B,I         then restore it in DSCB.
* 
*  Set length of given information in BUF to 7 and take the successful
*  reply exit.
* 
M412B LDB D7
      SKP 
* 
*  Successful return point - set status word in STAT array to zero and
*  put length (in B register) into 2nd word of STAT.
* 
INF1  CLA 
      STA STAT,I
      ISZ STAT
      STB STAT,I
INF2  CLA           Set BUF to zero for 
      STA BUF         param check on next entry.
      JMP DBINF,I 
* 
*  Error returns
* 
E103  LDA D103      Data base not properly opened.
      RSS 
E123  LDA D123      Data set not a master.
      RSS 
E124  LDA D124      Illegal DBINF mode. 
      RSS 
E125  LDA D125      Invalid or inaccessible data
      RSS             item or data set. 
E160  LDA D160      Corrupt Run Table.
      RSS 
E162  LDA D162      Missing parameter.
      STA STAT,I    Put error code into STAT
      JMP INF2        and return to user. 
* 
*  Constants and variables
* 
M5    DEC -5
D2    EQU ZERO+2
D3    EQU ZERO+3
D4    EQU ZERO+4
D6    EQU ZERO+6
D7    EQU ZERO+7
D13   EQU ZERO+13 
D17   EQU ZERO+17 
D100  DEC 100 
D103  DEC 103 
D123  DEC 123 
D124  DEC 124 
D125  DEC 125 
D160  DEC 160 
D162  DEC 162 
D402  DEC 402 
* 
LOBYT OCT 377 
HIBYT OCT 177400
* 
ABLNK OCT 040 
BLNKS ASC 1,
/D    ASC 1,D 
/A    ASC 1,A 
/M    ASC 1,M 
/X    ASC 1,X 
* 
FLAG  NOP 
NUMBR NOP 
ADDRS NOP 
LENTH NOP 
CNTR  NOP 
CNTR2 NOP 
TEMP  NOP           } Note: Do NOT change the order of these unless 
NEXT  NOP           } you make sure CAPAC (a doubleword) will not 
CAPAC EQU TEMP      } overwrite some valuable information.
*                                    CAPAC is used in mode 202. 
ITCNT NOP 
FIRST NOP 
SAVE  NOP 
      END 
                                        