ASMB,L,C,R HED DBGET SUBROUTINE OF IMAGE/1000 NAM DBGET,7 92069-16139 REV.2026 800222 * * ******************************************************************* * (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-18139 * RELOC: 92069-16139 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * ALTERED: FEBRUARY 22, 1980 TO SPEED UP DBGET WHEN PASSED * IN AN "@ " FOR AN ITEM LIST - CEJ * * ******************************************************************* * * * * Data Base GET is one of the ten user callable subroutines in the * IMAGE/1000 library. Its function is to retrieve data from the data * base. It does this by reading an entry of the data set specified by * the user, pulling the vlues for any items the user specified out of the * data record of the entry and putting them into a user specified buffer. * * The user can specify which entry in the data set is to be read in seven * different way. Each method of reading corresponds to a DBGET mode. * These modes (and methods) are: * * 1 - reread the most recently accessed entry of the data set. * 2 - find and read the next non-empty entry in the data set from the * most recently accessed entry and proceding in a serial mono- * tonically increasing fashion. * 3 - find and read the previous non-empty entry in the data set to * the most recently accessed entry and proceding in a serial * monotonically decreasing fashion. * 4 - read the entry number specified by the user. * 5 - read the next record, along the current path of the detail data * set, from the most recently accessed record. * 6 - read the previous record, along the current path of the detail * data set, to the most recently accessed record. * 7 - find and read the record of the manual master data set contain- * ing the user specified value. * * There is one special function performed by DBGET in mode 4. If the * record number specified by the user is zero, the data set is effect- * ively rewound by setting the most recently accessed entry number in * the data set to zero. In this case, no data is transfered to the user. * * The calling sequence for DBGET is: * * JSB DBGET * DEF *+8 return point * DEF IBASE the data base parameter used on a successful * DBOPN call for the data base from which * data is to be retrieved. * DEF ISET the name or number of the detail or manual * master data set from which data is to be * retrieved. * DEF IMODE DBGET mode, values are as described above. * DEF ISTAT a ten word array in which the following is * returned to the user: * word contents * ---- -------- * 1 error code (zero if successful) * If successful: * 2 word length of data returned. * 3-4 record # of entry read * 5-6 zero * 7-8 record # of predecessor of entry * read along current chain * 9-10 record # of successor of entry * read along current chain * DEF LIST a list of item names or numbers whose values * are to be returned to the user from the * entry read * DEF IBUF the buffer into which the item values of the * items specified in LIST are to be put con- * catenated together in the order of the * items in LIST * DEF IARG a doubleword record number for mode 4 * or * the key item value for mode 7 * 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 DBGET EXT .DCO,.DDS,.DIS,.DSBR,.ENTR,.MVW,AIRUN EXT DBFDS,DBHRD,DBIDS,DBPIL,DBRBP,DBRED,RBGET,TEMPX * BASE NOP SET NOP MODE NOP STAT NOP LIST NOP BUF NOP ARG NOP * * Get true parameter and return point addresses * DBGET NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA ARG 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 RBGET Remote data base return. DEF *+8 Ask RBGET to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF LIST,I DEF BUF,I DEF ARG,I JMP GET9 Return to caller. * * Ask DBFDS to check the validity of SET. If it is valid, DBFDS will * return the set number, accessibility and Data Set Control Block Table * entry address (relative to beginning of Run Table). * LOCAL JSB DBFDS DEF *+5 DEF SET,I DEF DSNUM DEF FLAG DEF DSADR * LDA DSNUM If returned set # = zero SZA,RSS (invalid set reference) JMP E100 * LDB FLAG or accessibility FLAG > 0 CMB,INB (set inaccessible) SSB JMP E100 user gave us a bad set reference. * * Now, set FLAG to signify what data set type we have. Type code 0 or * 1 is a master and FLAG is set to -1. Type code 2 is a detail and FLAG * is set to zero. * CCA Set FLAG to -1 to start out. STA FLAG * LDB AIRUN Then get true address of DSCB, ADB DSADR ADB DSTYP and bump to type word LDA B,I Put type bits in sign & least ALF,RAL significant bits of A reg. SLA If least sig. bit set - we have a detail JMP GET1 JMP GET2 Else - a master data set. * GET1 ISZ FLAG NOP * * If the user gave us an "@ " in the item list, then check if the set's * all readable bit (bit 13 of the 5th word of the DSCB) is set. If so, * put an "@ ", the length of the data record, and two zeros in the first * four words of TEMPX. If bit not set, return an error 101 to the user. * If the list does not contain an "@ ", ask DBPIL to process the item * list the user gave us. * GET2 LDA LIST,I The first word of LIST contains the "@ " CPA AT if it is there. RSS JMP GET2A * LDA B,I An "@ " given, is RA bit set? RAL,RAL SSA,RSS JMP E101 No - error 101 * LDA AT Yes - set up TEMPX STA TEMPX,I INB LDA B,I LDB TEMPX INB STA B,I CLA INB STA B,I INB STA B,I JMP GET2B Branch around call to DBPIL. * GET2A JSB DBPIL DEF *+4 DEF LIST,I DEF DSADR DEF PATH# * SZA JMP ERREX No - inform user of error. * GET2B LDB AIRUN Yes - get true address of DSCB ADB DSADR and save for later. STB DSADR * * Do a CASE on the mode of DBGET. Mode should be within [1,7] so check * its bounds then use the mode as an index into a jump table which puts * us at the proper process for the mode. * LDA MODE,I SSA Is mode < 0? JMP E115 Yes - error! SZA,RSS No - is mode = 0? JMP E115 Yes - error! * CMA,INA No - is mode > 7? ADA D7 SSA JMP E115 Yes - error! * ADA JMPTB No - index into jump table JMP A,I and perform jump. * JMPTB DEF *+1 JMP MOD7 mode = 7 JMP MD56 mode = 6 JMP MD56 mode = 5 JMP MOD4 mode = 4 JMP MD23 mode = 3 JMP MD23 mode = 2 JMP MOD1 mode = 1 SKP * * Mode = 1, reread current record in data set. * Get current record number from the DSCB (12th & 13th words), and ask * DBRED to do a directed read on it. * MOD1 LDB DSADR Get address of DSCB ADB DSRCN bump to current record # address DLD B,I and pick it up. * SZB,RSS Is it zero? SZA RSS JMP E157 Yes - no current record DST RECRD No - put it in DBRED call. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: the data base number DEF DSNUM data set number DEF RECRD and record number. * SZA If any error, JMP ERREX pass it to the user. * * Check to see that the entry is not empty. (Flag in first word of media * record non-zero.) If it is empty give the user an error. If its not, * go to process the items the user desires. * LDA DBRBP,I SZA,RSS JMP E114 Entry is empty. JMP GET5 Non-empty, a successful read. SKP * * Mode = 2 or 3, get (next or previous) record by serially reading data * set. * To do either of these we set up a loop which read from the current * record (+1 or -1) until a non-empty entry or the (end or beginning) * of the data set is found. * * First prepare the loop parameters. * MD23 LDB DSADR ADB DSCAP Get and save data set's STB ARG capacity address. ADB D3 Pick up current record number. DLD B,I DST RECRD * LDA MODE,I If we are processing a mode 3 request CPA D2 JMP MD23B LDA RECRD Make sure that the current record number SZB,RSS is not zero. SZA JMP MD23C DLD ARG,I It's zero, set it to the DST RECRD capacity of the data set. JMP MD23D * * BEGIN LOOP * While record number (+1 or -1) is (LE capacity of data set or GT zero) * read record number (+1 or -1). If record empty continue with (next or * previous) record number. If record non-empty, wrap up the serial read * and process the items the user desires. If (end or beginning) of set * found before a non-empty record is, return an error to the user. * MD23A LDA MODE,I CPA D3 If mode = 3 JMP MD23C jump to record decrement. * MD23B JSB .DIS Else, increment record. DEF RECRD RSS JMP E12 (In case of wrap around.) * DLD ARG,I If record # now GT JSB .DCO capacity of data set DEF RECRD RSS JMP E12 return EOF error. JMP MD23D * MD23C JSB .DDS DEF RECRD RSS If previous record is zero JMP E12 BOF error. * MD23D JSB DBRED Ask DBRED to read this record. DEF *+4 DEF BASE,I DBRED needs: the data base # DEF DSNUM data set number DEF RECRD and record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it to the user. * LDA DBRBP,I No - is this entry empty? SZA,RSS JMP MD23A Yes - continue in loop * JMP GET3 No - we've got the record we want. SKP * * Mode = 4, read the record the user specified in ARG or if ARG = 0, * reset the current record number in DSCB to zero. * ARG should be a doubleword record number. If it is not zero, make sure * it falls within the bounds of [1,capacity of data set]. If it is zero, * set the current record number in the DSCB to zero and the current path * number to zero and return successful to the user. * MOD4 DLD ARG,I DST RECRD SZB,RSS SZA JMP MOD4A It's non-zero, go to next process. * LDB DSADR It's zero - ADB DSPAN set current path # (low order byte LDA B,I of 11th word of DSCB) to zero AND HIBYT STA B,I * INB and set the current record # CLA (12th & 13th words of DSCB) STA B,I to zero INB STA B,I * STA LENTH Set returned data length to zero JMP GET7 and take the successful serial read exit. * * ARG was non-zero, make sure it is non-negative and less than or equal * to the data set's capacity as well. * MOD4A SSA JMP E111 Negative! * LDB DSADR Get data set's capacity ADB DSCAP STB ARG LDB RECRD+1 Get 2nd word of value back JSB .DSBR and do compare. DEF ARG,I SSA JMP E111 Greater than capacity! * * Record number okay. Read the entry. If it is non-empty wrap up as * if this were a serial read. If it is empty, that's an error. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: the data base # DEF DSNUM data set number DEF RECRD and record number * SZA Did we get an error from DBRED? JMP ERREX Yes - pass it back to user. * LDA DBRBP,I No - is entry empty? SZA,RSS JMP E114 Yes - inform user of error. * JMP GET3 No - a successful read. SKP * * Mode = 5 or 6, read (next or previous) record along current chain. * The data set must be a detail (FLAG set long ago to zero) and there * must be a current chain. The current path # (low order byte of 11th * word of DSCB) will be non-zero if there is one. * MD56 ISZ FLAG If FLAG = -1 RSS JMP E120 set is a master. * LDB DSADR Now, ADB DSPAN is there a current path? LDA B,I AND LOBYT SZA,RSS JMP E111 No - inform user. * STA PATH# Yes - save path # for (much) later. * * Data set okay so far, now get (next or previous) record along current * chain from DSCB (next is in 16th & 17th words of DSCB, previous in * 14th & 15th). If it is zero, we've reached another error condition - * (end or beginning) of chain. * LDA MODE,I Pointer to previous in 14th & 15th CPA D6 Pointer to next record in 16th & 17th LDA D3 words of DSCB. * ADB A DLD B,I SZB,RSS SZA RSS JMP E155 EOC or BOC! DST RECRD * * Record checks out. Ask DBRED to read it for us. If it is empty, the * data base is corrupt. If it is non-empty, wrap up chain read and pro- * cess the items the user desires. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: the data base # DEF DSNUM data set number DEF RECRD and record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it back to user. * LDA DBRBP,I No - is the entry empty SZA,RSS JMP E154 Yes - bad chain pointers! * JMP GET4 No - a successful read. SKP * * Mode = 7, hash-read into a master. * Data set must be a master (FLAG set long ago to -1) and ARG should * contain its key value. * MOD7 ISZ FLAG Check that data set is a master. JMP E123 It's not - error. * JSB DBHRD It is - ask DBHRD to do the DEF *+7 hash-read for us. DEF BASE,I It needs: the data base # DEF DSNUM data set number DEF ARG,I key item value DEF FLAG Returned read flag. DEF RECRD Returned record number. DEF STAT,I Returned error code. * * Check for any errors. First, check STAT for a returned error code. * If it is not zero, pass the error on to the user. Then check the read * FLAG. If it is not zero, a master with the specified key value could * not be found, so tell the user. If all okay, wrap up this process as * if this were a serial read. * LDA STAT,I SZA JMP ERREX DBHRD encountered an error. * LDA FLAG SZA JMP E107 No master with that key value. SKP * * We come here at the end of a successful serial, directed or hashed * read. Set the current path number in the DSCB (low order byte of 11th * word) to zero. * GET3 LDB DSADR ADB DSPAN First, the path number. LDA B,I Make sure we don't wipe out the AND HIBYT search item # in the high byte. STA B,I JMP GET5 Go to process the item values. * * We come here at the end of a successful chain read. Determine * the index of the current path into the media record of the entry. * This will be used to move the backward (previous) and forward (next) * record pointers into the DSCB. * GET4 LDB DSADR ADB DSBWN B = addr. for previous & next record #s CCA Saved path number long ago in PATH#. ADA PATH# Index for this path = ALS,ALS (path # - 1) * 4 ADA D3 + 3 (for used/unused flag & free pointer. ADA DBRBP Get true address of path pointers. * * Now, move backward & forward pointers (address in A register) into * previous & next record number places in DSCB (address in B register). * These are both doublewords. * JSB .MVW DEF D4 DEC 0 SKP * * We join most of the processes here (excluding a mode 4 call with a * record number of zero) to set the current record number in the DSCB * (12th and 13th words) to the number of the record just read and set * up the return value BUFfer. * GET5 LDB DSADR First, the current record #. ADB DSRCN LDA RECRD STA B,I INB LDA RECRD+1 STA B,I * * Now, we need to move the values of the items the user desires from * the data record of the entry into the buffer the user supplied for * us. We have each of the items' numbers, word lengths, and indices * into the data record in the TEMPX table set up by DBPIL. Each entry * in this table looks like: * * word * +-----------------------------------+ * 1 |W |K |S | | item # | -> entire word * ------------------------------------- is zero at * 2 | word length of item | end of list * ------------------------------------- * 3 | index into data record of entry | * +-----------------------------------+ * 15 14 13 8 7 0 bit * * W, K, & S are ignored in this subroutine but if set mean: * W - item is writeable * K - item is a key item * S - item is a sort item * * We are going to set up a loop which takes each entry in the table and * moves the specified number of words from the data record address + * index of item into the current position of the BUFfer array. First * we must initialize a few parameters for the loop. * CLA Set length of returned STA LENTH data to zero. * LDB DSADR Determine data record address = ADB DSMDL length of media record (low LDA B,I order byte of 5th word of DSCB) AND LOBYT + address of record buffer. ADA DBRBP STA DRADR Save address for loop. * LDA TEMPX Get TEMPX table address & STA ITTAB LDB BUF BUFfer address for loop. * * BEGIN LOOP * While item # NE zero, move item length number of words from data * record + item index into current BUFfer location. LENTH = LENTH + * item length. * GET6 LDA ITTAB,I If item # = 0 SZA,RSS JMP GET7 we are through with move of data. * ISZ ITTAB Else, get length of data LDA ITTAB,I to be moved, STA MVLEN * ISZ ITTAB get index of item in LDA ITTAB,I data record then ADA DRADR get its address * JSB .MVW then perform the move. DEF MVLEN DEC 0 * LDA LENTH Update returned data length ADA MVLEN STA LENTH ISZ ITTAB get next entry in TEMPX table JMP GET6 and continue. SKP * * We come here at the end of the value move process or the end of a suc- * cessful mode 4 call with record number of zero. Set up the first six * words of the STATus return array as follows: * word contents * ---- -------- * 1 zero * 2 word length of data transfered * 3-4 doubleword current record number (in RECRD) * 5-6 doubleword zero * GET7 CLA STA STAT,I ISZ STAT * LDA LENTH STA STAT,I ISZ STAT * LDA RECRD STA STAT,I ISZ STAT LDA RECRD+1 STA STAT,I ISZ STAT * CLA STA STAT,I ISZ STAT STA STAT,I ISZ STAT * * Now we split up return processing between chained read and non-chained * reads. For a chained read the remaining four words of STATus array * contain the following: * word contents * ---- -------- * 7-8 doubleword record # of predecessor of current record * along current chain * 9-10 doubleword record # of successor of current record * along current chain. * * For a non-chained read, both of these doubleword values are zero. * LDB MODE,I CPB D5 Forward chained read? JMP GET8 or CPB D6 Backward chained read? JMP GET8 Yes - separate processing. * STA STAT,I No - pad rest of STATus array ISZ STAT with zeroes. STA STAT,I ISZ STAT STA STAT,I ISZ STAT STA STAT,I * JMP GET9 Return to user. * * Chained read - return previous and next record numbers (14th through * 17th words of DSCB) in remainder of STATus array. * GET8 LDB STAT LDA DSADR ADA DSBWN JSB .MVW DEF D4 DEC 0 * GET9 CLA Set ARG to zero for STA ARG param check on next entry. JMP DBGET,I Return to user. * * Error return points * ERREX SSA If error returned from another subroutine CMA,INA is negative - make it positive. RSS E12 LDA D12 EOF or BOF error. RSS E100 LDA D100 Bad set reference. RSS E101 LDA D101 Bad item list. RSS E103 LDA D103 Improperly opened data base. RSS E107 LDA D107 No master entry with key value. RSS E108 LDA D108 Request directed at an auto master. RSS E111 LDA D111 Chain not set up (modes 5 & 6) RSS or record # illegal (mode 4). E114 LDA D114 Record accessed is empty. RSS E115 LDA D115 Invalid DBGET mode. RSS E120 LDA D120 Data set not a detail. RSS E123 LDA D123 Data set not a master. RSS E154 LDA D154 Data Base corrupt. RSS E155 LDA D155 Beginning or end of chain. RSS E157 LDA D157 No current record RSS E162 LDA D162 Missing parameter. STA STAT,I Set status word in array JMP GET9 and return to user. * * Constants and variables. * D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D5 EQU ZERO+5 D6 EQU ZERO+6 D7 EQU ZERO+7 D12 EQU ZERO+12 D100 DEC 100 D101 DEC 101 D103 DEC 103 D107 DEC 107 D108 DEC 108 D111 DEC 111 D114 DEC 114 D115 DEC 115 D120 DEC 120 D123 DEC 123 D154 DEC 154 D155 DEC 155 D157 DEC 157 D162 DEC 162 * LOBYT OCT 377 HIBYT OCT 177400 AT ASC 1,@ * FLAG NOP DSNUM NOP DSADR NOP RECRD BSS 2 PATH# NOP LENTH NOP DRADR NOP MVLEN NOP ITTAB NOP END