ASMB,L,C,R HED DBUPD SUBROUTINE OF IMAGE/1000 NAM DBUPD,7 92069-16140 REV.2026 800121 * * ******************************************************************* * (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-18140 * RELOC: 92069-16140 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base UPDate is one of the ten user callable subroutines in the * IMAGE/1000 library. Its function is to replace non-key item values * for items which the user has write access in the current record of the * specified manual master or detail data set with the values supplied * by the user. * * The calling sequence for DBUPD is: * * JSB DBUPD * DEF *+7 return point * DEF BASE the data base parameter used in a successful DBOPN * on the data base in which an entry is to be up- * dated. The data base must have been opened in * either mode 1 or mode 3. * DEF SET data set name or number of the data set in which * the current entry is to be updated. * DEF MODE DBUPD mode = 1. * DEF STAT a ten word array in which the status of the call * is returned. This subroutine only uses the first * two words in which it returns: * word contents * ---- -------- * 1 error code (zero if successful) * If successful: * 2 word length of data in BUF * DEF LIST a list of items whose values in the data record * of the current entry in SET are to be replaced * by the values in BUF. Non-writeable and key * items may appear in this list but their values * in BUF must be identical to their values in the * data record. * DEF BUF the values of the items to replaced concatenated * together and in the same order as the items in * LIST. * 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 DBUPD EXT .CMW,.ENTR,.MVW,AIRUN,DBFDS,DBIDS EXT DBPIL,DBRBP,DBRED,DBWRT,RBUPD,TEMPX * BASE NOP SET NOP MODE NOP STAT NOP LIST NOP BUF NOP * * Get true parameter and return addresses. * DBUPD 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 RBUPD Remote data base return. DEF *+7 Ask RBUPD to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF LIST,I DEF BUF,I JMP UPD6 Return to caller. * * Make sure that the data base is open in a proper mode for updating the * open mode (low order byte of 14th word of DBCB) must be either 1 or 3. * Also, if the open mode is 1, make sure the data base is locked to the * user (lock flag is high order byte of 14th word of DBCB). The lock * flag will be negative if the data base is locked. * LOCAL LDB AIRUN DBFRT puts address of Run Table in ADB DBMOD AIRUN - bump to open mode. LDA B,I AND LOBYT CPA D1 Mode = 1? JMP UPD0 Yes CPA D3 Mode = 3? JMP UPD1 Yes JMP E104 No - open mode improper. * UPD0 LDA B,I Open mode is 1, SSA,RSS is data base locked? JMP E159 No - cannot do Update. * * Now make sure the Update MODE = 1. * UPD1 CLA,INA CPA MODE,I RSS JMP E115 Not one, illegal update mode. * * Ask DBFDS to check the validity of the SET parameter and if valid to * give us the set's accessibility and Set Control Block Table entry ad- * dress relative to beginning of Run Table. * JSB DBFDS DEF *+5 DEF SET,I DBFDS needs: data set parameter DEF STNUM returns: set number DEF FLAG accessibility DEF STADR entry address * LDA STNUM If returned set # = 0 SZA,RSS (set invalid) JMP E100 * LDA FLAG or accessibility FLAG > 0 CMA,INA (set inaccessible) SSA JMP E100 user gave us a bad set reference. * * Now, check that the set is not an automatic master and that there is * a current record number for the set. Type code (2nd nibble of high * order byte of 5th word of DSCB) will be zero for an automatic master. * The current record number in the DSCB (12th and 13th words) will be * non-zero if a current record exists. * LDB AIRUN Add Run Table address to set's ADB STADR relative address to get true ADB DSTYP address - bump to type code. LDA B,I ALF,RAL Type code in sign & least sig. bits of A SSA,RSS after rotate - are they now SLA both zero? RSS JMP E108 Yes - user cannot update an auto. master. * ADB D7 Point to current record # DLD B,I and pick it up. SSA Is it negative? JMP E160 Yes - Run Table corrupt! SZB,RSS Is it zero? SZA RSS JMP E157 Yes - no current record to update * DST RECRD No - save for later * * Ask DBPIL to process the item LIST given to us by the user. * JSB DBPIL DEF *+4 DEF LIST,I DBPIL needs: item list DEF STADR set's entry address DEF FLAG returns: # keys * SZA Did DBPIL encounter an error? JMP ERREX Yes - pass it to the user. * * DBPIL successfully processed item list. Now, ask DBRED to reread the * current record for us. It puts the record into the record buffer * pointed to by DBRBP. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: data base # DEF STNUM data set # DEF RECRD record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it to user. * LDA DBRBP,I No - Is the entry empty? SZA,RSS (i.e. Flag in media record = 0?) JMP E114 Yes - inform user of error. * * Everything checks out so far. Now, we are going to build a loop to * transfer the data item values from the user's buffer into the data * record. DBPIL set up all the information we need for the data trans- * fer in the TEMPX table. This table has one entry for each item speci- * fied by the user, and each entry is of the form: * * word +-----------------------------------+ * 1 |W |K |S | | item number | * ------------------------------------- * 2 | word length of item | * ------------------------------------- * 3 | index into data record of entry | * +-----------------------------------+ * * 15 14 13 8 7 0 bit * * where: * W if set means the item is writeable * K if set means the item is a key item * S if set means the item is a sort item * * The loop looks at the first word of each entry. If the word is zero, * the process is stopped. If either the W bit is not set or the K or S * bit is, a comparison of the user supplied value with the value in the * data record for this item is done. If the two values do not match, we * halt processing and pass the user an error. If they match, no data * transfer is made and we just continue on with the next item. If the W * bit is set and the K and S bits are not, we just blindly transfer the * value for the item supplied by the user into the word(s) in the data * record for the item, and continue on with the next entry. In addition, * the loop maintains a running total of the lengths of the items in the * TEMPX table, whether or not a data transfer occurs. * * First, set up the loop parameters. * CLA A zero to the total word length STA LENTH of the values in BUF. * LDA TEMPX STA ITTAB Set up the TEMPX table address. * LDB STADR Determine the address of the ADB AIRUN data record = ADB DSMDL length of media record LDA B,I (low order byte of 5th word of DSCB) AND LOBYT ADA DBRBP + address of record buffer. STA DRADR * LDA BUF Get address of user's buffer. * * BEGIN LOOP * While item # is non-zero: If item writeable and not a key or sort item, * move item length number of words from user buffer into data record * address + index of item. If item not writeable or item is a key or sort * item, compare item length number of words from user buffer to data * record address + index of item - if not a match, error. LENTH := LENTH * + item length. * UPD2 LDB ITTAB,I Item number = 0? SZB,RSS JMP UPD5 Yes - done with data transfer STB FLAG No - save W, K, & S bits for later. * ISZ ITTAB Set up move or compare length. LDB ITTAB,I STB CM/MV * ISZ ITTAB Bump ITTAB to index word. * LDB FLAG Get W, K, & S bits again. SSB,RSS Item writeable? JMP UPD3 No - do compare. RBL Yes - SSB item a key? JMP UPD3 Yes - do a compare. RBL No - item a sort item? SSB JMP UPD3 Yes - do a compare. * LDB ITTAB,I No - get address of item ADB DRADR in data record. * JSB .MVW Do a move of the item value DEF CM/MV from user's buffer DEC 0 into data record. JMP UPD4 * UPD3 LDB ITTAB,I Get address of item in ADB DRADR data record. * JSB .CMW Do a compare of the item value DEF CM/MV in the user's buffer DEC 0 with that in the data record. JMP UPD4 The values are equal. NOP Unequal values - JMP E112 error. * UPD4 LDB LENTH Move or compare successful. ADB CM/MV Add length of item STB LENTH to total. ISZ ITTAB Get next entry in TEMPX JMP UPD2 and continue. * * The transfer and/or compare of all item vlaues succeeded. Ask DBWRT * to write and post the updated record to disc. * UPD5 JSB DBWRT DEF *+4 DEF BASE,I DBWRT needs: data base # DEF STNUM data set # DEF RECRD record number * SZA Did DBWRT encounter an error? JMP ERREX Yes - pass it to user. * * Update successful. Set up STATus array to contain the following: * word contents * ---- -------- * 1 zero * 2 word length of data in BUF * * and return to the user. * STA STAT,I LDA LENTH ISZ STAT STA STAT,I * UPD6 CLA Set BUF to zero for STA BUF param check on next entry. JMP DBUPD,I * * Error return points. * ERREX SSA If error returned by another CMA,INA subroutine < 0, make it > 0. RSS E100 LDA D100 Invalid set reference. RSS E103 LDA D103 Improperly opened data base. RSS E104 LDA D104 Improper open mode for an update. RSS E108 LDA D108 Set referenced is an auto. master. RSS E112 LDA D112 Attempt to change a key, sort, or RSS non-writeable item value. E114 LDA D114 Record accessed is empty. RSS E115 LDA D115 Invalid DBUPD mode. RSS E157 LDA D157 No current record number. RSS E159 LDA D159 Data base not locked to user. RSS E160 LDA D160 Corrupt Run Table. RSS E162 LDA D162 Missing parameter. * STA STAT,I Set error code in STAT JMP UPD6 and return to user. * * Constants and variables. * D1 EQU ZERO+1 D3 EQU ZERO+3 D7 EQU ZERO+7 D100 DEC 100 D103 DEC 103 D104 DEC 104 D108 DEC 108 D112 DEC 112 D114 DEC 114 D115 DEC 115 D157 DEC 157 D159 DEC 159 D160 DEC 160 D162 DEC 162 * LOBYT OCT 377 * FLAG NOP STNUM NOP STADR NOP RECRD BSS 2 ITTAB NOP DRADR NOP LENTH NOP CM/MV NOP END