ASMB,L,C,R HED DBPUT SUBROUTINE OF IMAGE/1000 NAM DBPUT,7 92069-16141 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-18141 * RELOC: 92069-16141 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base PUT is one of the ten user callable subroutines in the IMAGE/ * 1000 DBMS library. Its function is to add a new entry to a manual * master or detail data set. For a detail data set this possibly in- * cludes adding a new entry to any automatic master data sets related * to the detail. * * The calling sequence for DBPUT is: * * JSB DBPUT * DEF *+7 return point * DEF BASE the data base parameter used in a successful * DBOPN call for the data base in which an * entry is to be added. The data base must * have been opened in either 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 in which the entry is to * be added. * DEF MODE DBPUT mode = 1. * DEF STAT a ten word status array in which the follow- * ing is returned: * word contents * ---- -------- * 1 status code (0 if successful) * If successful: * 2 word length of contents of BUF * 3-4 new entry's record number * 5-6 count of entries in * - last chain if detail * - synonym chain if master * 7-8 record number of predecessor in * - last chain if detail * - synonym chain if master * 9-10 record number of successor in * - last chain if detail * - synonym chain if master (zero) * DEF LIST a list of item names or numbers of the items * in the data set which are to receive values * in the new entry. Must contain all key * items in the data set. * DEF BUF the values for the items in LIST 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 DBPUT EXT .CMW,.DCO,.DDE,.DDS,.DIN,.DIS,.ENTR,.FSB,.MVW EXT AIRUN,DBBAM,DBCBI,DBCIX,DBDME,DBFDI,DBFDS,DBFWZ EXT DBHRD,DBIDS,DBMST,DBPIL,DBRED,DBRBL,DBRBP,DBWFR EXT DBWRT,RBPUT,TEMPX * BASE NOP SET NOP MODE NOP STAT NOP LIST NOP BUF NOP * * Get true parameter and return point addresses * DBPUT 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 by the BASE parameter to * see if it is on a remote machine, and to set up its Run Table as the * 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 RBPUT Remote data base return. DEF *+7 Ask RBPUT to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF LIST,I DEF BUF,I JMP PUT6 Return to caller. * * Make sure that the open mode allows a DBPUT, that is that the open * mode is either 1 or 3. (Open mode is in low order byte of 13th word * of the DBCB.) Also, if the open mode is 1, make sure the data base is * locked to the user. (Lock flag in high order byte of 13th word of * DBCB.) The lock flag will be negative if the data base is locked. * LOCAL LDB AIRUN DBFRT puts address of Run Table ADB DBLMD in AIRUN - bump to open LDA B,I mode / lock flag word. AND LOBYT CPA D1 Is open mode = 1? JMP PUT1 Yes CPA D3 Is open mode = 3? JMP PUT2 Yes JMP E104 No - invalid open mode for a PUT. * PUT1 LDA B,I Open mode = 1, SSA,RSS Is data base locked? JMP E159 No - cannot do PUT. * * Data base checks out. Ask DBFDS to check the validity of SET for us * and, if valid, to give us the set's accessibility and Set Control Block * Table entry address (relative to start of Run Table). * PUT2 JSB DBFDS DEF *+5 DEF SET,I DBFDS needs: data set parameter DEF STNUM returns: data set number DEF FLAG accessibility flag DEF STADR and 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, make sure the set is writeable (returned accessibility FLAG < 0) * and that the set is not an automatic master. Type code (2nd nibble * of high order byte of 5th word of DSCB) is zero if the set is an auto- * matic master. If not an auto. master, set FLAG to indicate if it is * a manual master or detail data set. Type code = 1 for a manual master * and FLAG will be set to -1. Type code = 2 for a detail and FLAG will * be set to zero. * SZA,RSS If FLAG is non-zero now, JMP E118 CCA set is writeable. STA FLAG Make set type FLAG < 0. * LDB AIRUN Get true address of DSCB. ADB STADR ADB DSTYP Bump to type word. LDA B,I Put type code in sign and ALF,RAL least sig. bits of A reg. SLA If least sig. bit is set, JMP PUT3 type = 2, set a detail. SSA,RSS If sign bit is set, JMP E108 type = 1, set a MM. RSS * PUT3 ISZ FLAG Detail type FLAG = 0. NOP * * Now make sure the DBPUT MODE is 1 and that the set has a free entry * to put a record in. * LDA MODE,I CMA,INA INA,SZA Is MODE = 1? JMP E115 No - bad PUT mode * CCA Yes - calculate address of set's ADA STNUM entry in Free Record Table = ALS,ALS (set number - 1) * 4 LDB AIRUN + pointer to FRT in DBCB ADB DBFRP (12th word) ADA B,I ADA AIRUN + address of Run Table * DLD A,I 1st doubleword of entry SZB,RSS contains # of free records. SZA Is it zero? JMP PUT4 No - set okay ISZ FLAG Yes - if this is a detail set JMP E105 return error # 105 JMP E106 else return error # 106. * * Set checks out. Ask DBPIL to process the item list the user gave us * setting up the TEMPX table with the information we need to perform a * data transfer on the items and returning the number of keys the user * specified in the list. * PUT4 JSB DBPIL DEF *+4 DEF LIST,I DBPIL needs: the item list DEF STADR set's entry address DEF KEYS returns: the # of keys * SZA Did DBPIL encounter an error? JMP ERREX Yes - pass it to user. * * All combined initial error checking done, now split processing between * manual master and detail data set types. * ISZ FLAG If FLAG = 0 JMP PUTD a detail, else a manual master. SKP * * Manual master data set Put. * * A manual master entry may only be added if the user specified the mas- * ter's key item in the item LIST and if an entry containing the value * the user specified for the key item does not already exist in the data * set. First we want to check that the number of keys the user specified * in the item LIST is 1 (passed to us by DBPIL in KEYS). If this check * succeeds, get the master's key item number from its DSCB (high order * byte of 11th word of DSCB) and ask DBCBI to determine the index of the * item into the value BUFfer the user passed us. * LDA KEYS CMA,INA INA,SZA Is # keys = 1? JMP E102 No - cannot put the new record. * LDB AIRUN Yes - get set's key item # ADB STADR ADB DSCCT LDA B,I ALF,ALF AND LOBYT STA KEYS * JSB DBCBI Ask DBCBI to compute its DEF *+3 INDEX into BUF. DEF KEYS DBCBI needs: key item # DEF INDEX returns: INDEX into BUF * LDA INDEX Did DBCBI succeed? SSA (i.e. is INDEX >= 0?) JMP E160 No - Run Table is corrupt! * * Compute adress of key item value by adding the index to the address * of BUF and ask DBHRD to see if there is another entry with this key * item value. * ADA BUF STA KEYS KEYS = address of key item value * JSB DBHRD DEF *+7 DEF BASE,I DBHRD needs: data base # DEF STNUM data set # DEF KEYS,I key item value DEF READ returns: READ flag DEF RECRD record # of last entry read DEF STAT,I any error it received * * For us, and for us alone, DBHRD returns the number of synonyms on the * chain in the A & B registers. Save them for a successful return. * DST SYCNT * LDA STAT,I Did DBHRD encounter an error? SZA JMP ERREX Yes - pass it to user. * LDA READ No - did it match an entry? SZA,RSS (i.e. is READ flag = 0?) JMP E110 Yes - cannot put new record. * * The new entry may be added now. DBHRD in its process of looking for * an entry with the user specified key value also performed more ser- * vices for us. If it found no matching record, the record number it * passed to us is either the record number for the new record or the * record number of the last record on the new record's synonym chain. * In addition, the record corresponding to the record number it passed * us is still in the record buffer. We will pass all of this informa- * tion to DBMST. It will determine the record number for the new mas- * ter and prepare the new master's media record for us, zero-filling * the remainder of the entry. It returns any error condition code in * the A register, zero if successful. * JSB DBMST DEF *+5 DEF BASE,I Pass DBMST all the info DEF STNUM given us by DBHRD. DEF READ Will return new record # in RECRD DEF RECRD (-1 if no free record). * SZA Did DBMST encounter an error? JMP ERREX Yes - pass it to user. * LDA RECRD No - did it get us the SSA new record? JMP E160 No - but the R.T. says it's there! * * Now that the media record is built, the data record for the entry is * moved into the record buffer by calling DBMDR. It uses the TEMPX table * set up by DBPIL to do this. When DBMDR returns to us, we write the * new entry to disc. * * Then, if the new record is a synonym, we update the old synonym chain * foot by setting its forward pointer to the new record number. * Then, the free record table is updated to show that another record has * been used by decrementng the free record count in the first two words * of the data set's entry in the free record table, and then writing and * posting the table back to the root file through DBWFR. * * At this point, if all disc accesses were successful, we return to the * user with a successful DBPUT status array. * JSB DBMDR Ask DBMDR to move the DEF *+2 data values from the user's buffer DEF STADR into the data record for us. * JSB DBWRT Put the new record out to disc. 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 the user. * CLB No - zero synonym save areas. DST SYNYM DST SAVE1 * LDB DBRBP Is the new record an LDA B,I end of a synonym chain? SSA,RSS JMP PUTM6 * INB Yes - get the old end of DLD B,I synonym chain. DST SYNYM * JSB DBRED Ask DBRED to get the entry DEF *+4 from disc. DEF BASE,I DBRED needs: data base # DEF STNUM data set # DEF SYNYM record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it to the user. * LDA DBRBP No - make old synonym chain ADA D3 foot's forward synonym chain STA TEMP pointer the new record's DLD RECRD record number. DST TEMP,I * JSB DBWRT Then, write the updated DEF *+4 synonym back to disc. DEF BASE,I DEF STNUM DEF SYNYM * SZA If any error - JMP ERREX pass it to the user. * PUTM6 CCA Calculate set's entry in ADA STNUM Free Record Table = ALS,ALS (set number - 1) * 4 LDB AIRUN ADB DBFRP + pointer to FRT in DBCB ADA B,I (12th word) ADA AIRUN + address of Run Table STA TEMP * JSB .DDS Decrement free record count DEF TEMP,I (1st & 2nd words of FRT entry) NOP * JSB .DIS Increment number of records DEF SYCNT on the synonym chain NOP * JMP PUT5 then write FRT to disc & return to user. SKP * * Detail Data Set Put. * * A detail data set entry may be added if the user specified all the * detail's key items and sort items (if any) in the item LIST, and if * all manual master data sets related to the detail have an existant * entry with the associated key's item value, and all automatic master * data sets related to the detail either have an existant entry or have * have room to create an entry with the associated key item value. * * First, make sure that the number of keys the user specified in the * item LIST (passed to us by DBPIL in KEYS) is equal to the # paths/entry * in the DSCB (low order byte of 7th word). * PUTD LDB AIRUN ADB STADR ADB DSPCT LDA B,I AND LOBYT CPA KEYS If not equal - RSS JMP E102 missing search item. * * We are going to take a shortcut in processing the detail in the case * of a successful non-sorted Put. First, for each path in the detail, * we update its associated master entry. This involves either updating * a manual or automatic master entry chain pointers or putting a new * automatic master entry for this chain. * * During this path processing, we are building the new entry's media re- * cord in temporary storage. When the path processing for all the mas- * ters for the new entry's chains has been completed, the new entry's * media record is moved into the record buffer and its data record is * built in the record buffer then written onto disc. * * Then, for each path in the detail, we update any old records in the * detail data set to point forward or backward to the new record. * * During the processing of the master entries, we are keeping a list of * the data set and record numbers and media record index for each master * entry we have successfully updated or added. Should an error occur * (either hard (disc) or soft such as a manual master does not contain * an entry with the key value) we step backward in the processing un- * doing everything we have done up to this point which altered the data * on the disc. We do this, instead of running through the error check- * ing on each related master before putting the new record and then up- * dating each master, in the hope that in the general case of a successful * non-sorted Put, there will be less disc accesses and therefore the Put * will take less time. * * First, we need to initialize the temporary storage areas for the media * record and master record numbers to zero. Then set up their addresses * for the path processing. * JSB DBFWZ DEF *+3 media record storage is 64 words DEF D113 master record # storage is 49 words DEF MEDST these are concatenated in memory. * LDA MEDST STA PATHI LDA MSTST STA MSTRI * * Get address of next free record number in the detail data set. It's * the 3rd and 4th words of the detail's entry in the Free Record Table. * This address is: (detail data set # - 1) * 4 + pointer to FRT in DBCB * (12th word) + address of Run Table. * CCA ADA STNUM ALS,ALS LDB AIRUN ADB DBFRP ADA B,I ADA AIRUN ADA FRPTR STA NEXT * DLD NEXT,I If the next free record is zero SZB,RSS we have a corrupt Run Table. SZA RSS JMP E160 * * Set up loop for master chain update. # paths/entry in detail is same * as the contents of KEYS, negate it for a loop counter. Get the detail's * Path Table address to pull out the values for the loop. Path table * address = (# fields/entry in detail <> + 1) / 2 + pointer to Info Table entry <<8th word of DSCB>> + * address of Run Table. * LDA KEYS If detail has no paths SZA,RSS JMP PTD10 jump around the master update. * CMA,INA STA CNTR1 * LDB AIRUN Calculate Path Table address. ADB STADR ADB DSFCT LDA B,I ALF,ALF AND LOBYT INA ARS INB ADA B,I ADA AIRUN STA PTADR * * BEGIN MASTER UPDATE LOOP * For each path in the detail: * * 1) Get the detail's key item number from the Path Table entry (high * order byte) and the master's set number (low order byte). * PTD1 LDA PTADR,I ALF,ALF AND LOBYT STA DKEY * LDA PTADR,I AND LOBYT STA MNUM * * 2) Determine the address of the key item's value in the user's BUFfer * = index into BUFfer + address of BUFfer. * JSB DBCBI DBCBI will calculate index. DEF *+3 DEF DKEY It needs: item number DEF INDEX returns: index into BUFfer * LDA D160 LDB INDEX If INDEX came base < 0 SSB (i.e. item not found in user's list) JMP REWND we have a corrupt Run Table. * ADB BUF STB KVAL * * 3) Hash-read into the master data set. If any disc error, rewind process. * JSB DBHRD DBHRD does the hash-read. DEF *+7 DEF BASE,I It needs: data base # DEF MNUM data set # DEF KVAL,I key item value DEF READ returns: READ flag DEF RECRD record # of last entry read DEF STAT,I any error encountered * LDA STAT,I Any error? SZA JMP REWND Yes! * * 4) Determine the address for this detail chain in the master's media * record = Record buffer address + 5 + ((master's path # - 1) * 6). * JSB DBFDS DBFDS will give us the master's DEF *+5 DSCB pointer. DEF MNUM It needs: data set reference DEF TEMP returns: data set number DEF FLAG accessibility flag DEF MADR DSCB pointer * LDA D160 LDB TEMP It set# came back as zero SZB,RSS JMP REWND we have a corrupt Run Table. * LDB AIRUN Calculate master's PT ADB MADR address as done above for detail. ADB DSFPC LDA B,I * AND LOBYT (save # paths/entry in master CMA,INA as a counter for following loop.) STA CNTR2 LDA B,I * ALF,ALF (then back to PT AND LOBYT address calculation.) INA ARS INB ADA B,I ADA AIRUN STA TEMP * LDA DKEY Set up combined detail item and ALF,ALF set numbers for master path IOR STNUM table search. STA SAVE1 * LDB D5 Determine index into master's PTD4 LDA TEMP,I media record for this path = CPA SAVE1 5 + (# paths before the one JMP PTD5 we seek * 6). ADB D6 ISZ TEMP ISZ TEMP ISZ CNTR2 JMP PTD4 * LDA D160 If path never found, JMP REWND corrupt Run Table. * PTD5 STB INDEX * * 6) If hash-read unsuccessful (i.e. READ flag <> 0) then if master is * a manual, error code = 107 and rewind the process. Else an auto- * matic master, try to create a new entry. * LDA READ SZA,RSS JMP PTD8 * PTD6 LDB AIRUN ADB MADR Data set type code in 2nd ADB DSTYP nibble of 5th word of DSCB LDA B,I type = 0 is an auto master ALF,RAL type = 1 is a manual master SSA,RSS JMP PTD7 If sign (A) = 0, type = 0 LDA D107 If sign (A) <> 0, type = 1 JMP REWND * PTD7 JSB DBBAM DBBAM will build the new DEF *+6 automatic master entry. DEF BASE,I It needs: data base # DEF MNUM data set # DEF KVAL,I key item value DEF READ values from DBHRD DEF RECRD returns: record # or -1 * * 7) If auto create unsuccessful, error # in A, rewind process. * Else, put master's set number, index, and record number in * storage area in case of clean-up. * SZA JMP REWND * LDA MNUM ALF,ALF IOR INDEX STA MSTRI,I LDA MSTRI INA STA TEMP DLD RECRD DST TEMP,I * * 8) Join process of successful auto create or master record existant. * Determine if this is a sorted chain. If so, get its sort item * number and the index into the user's buffer for the sort item's * value. If the sort item value is not there, error code = 102 and * rewind the process. * PTD8 ISZ PTADR If sort item number LDA PTADR,I in path table entry STA SITNO SZA,RSS is zero, JMP ADD1 chain is not sorted. * JSB DBCBI Get sort item's index into values. DEF *+3 DEF SITNO DEF SINDX * LDA D102 If sort item index came back LDB SINDX in SINDX SSB less than zero, JMP REWND error - missing sort item. * * 9) If the current chain count in the master's media record is zero, * add the record as the chain head and chain foot. * ADD1 LDB DBRBP Current chain count is ADB INDEX the first two words of STB TEMP path info in media record. DLD TEMP,I SZB,RSS SZA JMP ADD2 * ISZ TEMP Chain foot is next two words. ISZ TEMP DLD NEXT,I DST TEMP,I * ISZ TEMP Chain head is last two words. ISZ TEMP DST TEMP,I JMP ADDX Branch to end of master update. * * 10) If the path is unsorted, add the record as the chain foot, saving * old chain foot as backward pointer in media record storage. * ADD2 LDA SITNO SITNO = zero if chain unsorted. SZA JMP ADD3 * ISZ TEMP Chain foot in 2nd doubleword ISZ TEMP of path info in master's DLD TEMP,I media record. DST PATHI,I * DLD NEXT,I DST TEMP,I JMP ADDX Branch around sort processing. * * 11) Path is sorted: * a) get length of sort item, type of sort item, and its address * in BUF. * ADD3 JSB DBFDI DBFDI will return item table entry. DEF *+5 DEF SITNO It need: data item reference DEF WLEN It returns: data item number DEF FLAG accessibility flag DEF ITTAB item table reference * LDA D160 If item # came back zero, LDB WLEN SZB,RSS JMP REWND corrupt Run Table. * LDB ITTAB Item's type is low byte of ADB ITTYP 4th word of item table entry. ADB AIRUN LDA B,I AND LOBYT STA FLAG * ADB D3 Item's length is 7th word LDA B,I or item table entry. STA WLEN * LDA SINDX Sort item's address = ADA BUF index + address of BUFfer. STA KVAL * * b) determine address in record for sort item. * JSB DBCIX DBCIX returns index relative to DEF *+4 beginning of data record for set. DEF SITNO It needs: item number DEF STADR data set address DEF SINDX It returns: index * LDA KEYS Address = address of data record ALS,ALS in record buffer ADA D3 (skip media record) ADA DBRBP ADA SINDX + index. STA SADDR * * c) determine address in media record for this path. * LDA CNTR1 This is current path - 1 ADA KEYS ALS,ALS * 4 ADA D3 + 3 ADA DBRBP + address of record buffer STA PADDR * * d) loop through each record in detail chain until the first record * with a sort item value greater than the one given for this entry * or the end of chain is found. First record in chain is the * chain head found in the master's media record. Succeeding records * are found in the forward pointer for the chain in the detail's * media record. At any error, processing is rewound. * LDA PATHI Set up DRECD to point to forward ADA D2 pointer in media record storage area. STA DRECD * LDA TEMP ADA D4 DLD A,I * SZB,RSS If chain head is zero, SZA JMP ADD4 LDA D154 corrupt chain! JMP REWND * ADD4 DST DRECD,I JSB DBRED DBRED reads the detail record. DEF *+4 DEF BASE,I It needs: data base number DEF STNUM data set number DEF DRECD,I record number * SZA Error code returned in JMP REWND A register. * * e) compare sort item values. Get the item type from FLAG and * branch to the proper compare routine. All routines return: * P+1 if values are equal * P+2 if value in record just read > * new record's value * P+3 if value in record just read < * new record's value * LDA FLAG CPA I JMP ADINT Item an integer CPA X JMP ADCHR Item a character string * * item a real, do a real compare * JSB RCMP DEF *+1 RSS Values equal - continue JMP ADD5 Found spot! JMP ADD45 Value less than - continue * * item an integer, do an integer compare * ADINT JSB ICMP DEF *+1 RSS Values equal - continue JMP ADD5 Found spot! JMP ADD45 Value less than - continue * * item a character string, do a word compare * ADCHR LDA KVAL LDB SADDR JSB .CMW DEF WLEN DEC 0 RSS Values equal - continue JMP ADD5 Found spot! * ADD45 LDA PADDR Get forward pointer in chain ADA D2 (2nd doubleword of path info) DLD A,I SZB,RSS If it is zero, SZA we've found the spot. JMP ADD4 Else, continue search. * DLD DRECD,I When at end of chain, DST PATHI,I save off old chain foot as CLA backward pointer and CLB zero as the forward pointer. DST DRECD,I JMP ADD55 * * f) when the new record's spot is found, move the backward chain * pointer of most recently read record into backward chain pointer * in media record storage area. The record number is already * saved as the forward chain pointer (indirect through DRECD). * ADD5 DLD PADDR,I Backward pointer is 1st DST PATHI,I doubleword of path info. * * g) reread the associated master record. * ADD55 JSB DBRED DBRED performs the read. DEF *+4 DEF BASE,I DEF MNUM DEF RECRD * SZA If any error, JMP REWND rewind process. * * h) Now, if the backward pointer in the media record storage area * is zero, put the new record's number as chain head in the * master's media record. If the forward pointer is zero, put * the new record as chain foot. * DLD PATHI,I 1st doubleword in media record SZB,RSS storage is backward pointer. SZA JMP ADD6 * LDA TEMP Chain head is 3rd doubleword ADA D4 of path info in master's STA TEMP media record. DLD NEXT,I DST TEMP,I JMP ADDX * ADD6 LDA PATHI 2nd doubleword in media storage ADA D2 is forward pointer. DLD A,I SZB,RSS SZA JMP ADDX * ISZ TEMP Chain foot is 2nd doubleword ISZ TEMP of path info in master's DLD NEXT,I media record DST TEMP,I * * 12) Join all successful path processing here. Increment the chain * count in the master's media record. * ADDX LDB DBRBP Chain count is 1st doubleword ADB INDEX of path infor in master's STB TEMP media record. DLD TEMP,I JSB .DIN Increment it, DST TEMP,I DST SYCNT and save for successful return * * 13) Write updated master entry to disc. * PTD9 JSB DBWRT DEF *+4 DEF BASE,I DBWRT needs: data base # DEF MNUM data set # DEF RECRD record # * * 14) If an error, rewind process. If no error, put master data set * number, record number, and index into media record in the temp. * master record number storage area, update the temp. media record * storage to point to the next path's storage and continue with the * next path. * SZA JMP REWND * LDA MNUM ALF,ALF IOR INDEX STA MSTRI,I ISZ MSTRI * DLD RECRD DST MSTRI,I ISZ MSTRI ISZ MSTRI * LDA D4 ADA PATHI STA PATHI * ISZ PTADR ISZ CNTR1 JMP PTD1 * * END OF MASTER UPDATE LOOP * * * We come here when all masters have been successfully updated or if the * detail had no path to begin with. Read in the record for the new de- * tail entry in order to get its forward free record list pointer. Save * this pointer for a future update of the Free Record Table entry for * the detail data set. * PTD10 JSB DBRED DBRED will perform the read. DEF *+4 DEF BASE,I It needs: data base # DEF STNUM data set # DEF NEXT,I record # * SZA Any error? JMP REWND Yes - rewind process * LDA D160 LDB DBRBP,I Was this truely a free record? SZB (i.e. is used/unused flag = 0?) JMP REWND No - Run Table is corrupt. * PTD11 LDB DBRBP Yes - get and save next free INB DLD B,I record number. DST SAVE1 * * Now, build the new detail entry by zeroing the record buffer, moving * the media record from temp. storage into the record buffer then asking * DBMDR to move the data record into the record buffer. * JSB DBFWZ DEF *+3 DEF DBRBL DBFWZ needs: length of area to zero DEF DBRBP address of area to zero * LDB AIRUN Get length of media record ADB STADR from low order byte of ADB DSMDL 5th word of DSCB LDA B,I for the move. AND LOBYT ADA M3 Subtract the free record info space. STA TEMP * LDA MEDST Then, move the chain pointers LDB DBRBP into the media record. ADB D3 JSB .MVW DEF TEMP DEC 0 * CLA,INA Set used/unused flag STA DBRBP,I in media to used (1). * JSB DBMDR Ask DBMDR to move in DEF *+2 the data record. DEF STADR * * Write the new record out to disc. If an error, rewind process. If * no error, update the free record information for the detail data set * by putting the free pointer saved in SAVE1 into the free list head * pointer and decrementing the free list count. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF NEXT,I * SZA Any error? JMP REWND Yes! * DLD NEXT,I No - save the new record's #. DST RECRD * DLD SAVE1 Update the FRT. DST NEXT,I LDA M2 ADA NEXT STA NEXT JSB .DDS DEF NEXT,I NOP * * Now, update all related entries in the detail data set. * From this point on no rewind of the process is performed. The data * base on the disc is left in its current state should an error occur. * * Set up the loop for this update by negating the number of keys in the * detail as a loop counter, setting KEYS to one <>, and setting up the pointer to the temp. media * storage in PATHI. * CLA Zero out predecessor and CLB successor save areas. DST SYNYM DST SAVE1 * LDA KEYS SZA,RSS If detail has no paths, JMP PUT5 jump around path processing * CMA,INA STA CNTR1 * CLA,INA STA KEYS * LDA MEDST STA PATHI * * BEGIN DETAIL UPDATE LOOP * For each path in the detail: * * 1) If backward pointer in temp. media storage is non-zero, read back- * ward pointer record number, else continue with forward pointer. * PTD12 DLD PATHI,I DST SYNYM Save bckwrd ptr. for successful return SZB,RSS SZA RSS JMP PTD13 * JSB DBRED DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA If any error, JMP ERREX pass it to user. * * 2) Calculate address for the forward pointer for this path in media * record of detail entry = (path# - 1) * 4 + 5 + address of record * buffer. * CCA ADA KEYS ALS,ALS ADA D5 ADA DBRBP STA TEMP * * 3) Put new record's number in entry's forward chain pointer. * DLD RECRD DST TEMP,I * * 4) Write updated entry to disc. If any error, return it to user. If * no error, continue with forward pointer. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA JMP ERREX * * 5) If forward pointer in temp. media storage is non-zero, read forward * pointer record number, else continue with next path. * PTD13 ISZ PATHI ISZ PATHI DLD PATHI,I DST SAVE1 Save frwd ptr for successful return * SZB,RSS SZA RSS JMP PTD14 * JSB DBRED DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA If any error, JMP ERREX pass it to user. * * 6) Calculate address for backward pointer for this path in media record * of detail entry = (path# - 1) * 4 + 3 + address of record buffer. * CCA ADA KEYS ALS,ALS ADA D3 ADA DBRBP STA TEMP * * 7) Put new record's number in entry's backward chain pointer. * DLD RECRD DST TEMP,I * * 8) Write updated entry to disc. If any error, return it to user. If * no error, continue with next path. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA JMP ERREX * PTD14 ISZ PATHI ISZ PATHI ISZ KEYS ISZ CNTR1 JMP PTD12 * * END OF DETAIL UPDATE LOOP * SKP * * We come here at the end of a successful master or detail put. We need * to write the Free Record Table to disc to complete the process. Then * we can build a successful return STATus array. * PUT5 JSB DBWFR DBWFR does the FRT write. * SZA Any error? JMP ERREX Yes - pass it to user. * * Now we build the successful reply STATus array. * This looks like: * word contents * ---- -------- * 1 zero * 2 word length of data entry in BUF * 3-4 new record' number * 5-6 doubleword count of entries in * - last chain if detail * - synonym chain if master * 7-8 doubleword record number of predecessor in * - last chain in detail * - synonym chain if master * 9-10 doubleword record number of successor in * - last chain if detail * - synonym chain if master (always zero) * * STA STAT,I Error code = 0 * ISZ STAT DBMDR set WLEN to length LDA WLEN of data in BUFfer for us. STA STAT,I * ISZ STAT DLD RECRD New record number DST STAT,I * ISZ STAT ISZ STAT DLD SYCNT # records on chain DST STAT,I * ISZ STAT ISZ STAT DLD SYNYM Predecessor on chain DST STAT,I * ISZ STAT ISZ STAT DLD SAVE1 Successor on chain DST STAT,I * * Return to user. * PUT6 CLA Set BUF to zero for STA BUF param check on next entry. JMP DBPUT,I * * Error return points * ERREX SSA If error code given by another CMA,INA routine < 0, make it > 0. RSS E100 LDA D100 Invalid data set. RSS E102 LDA D102 Improper or missing key or sort item. RSS E103 LDA D103 Improperly opened data base. RSS E104 LDA D104 Invalid open mode for PUT. RSS E105 LDA D105 Detail data set full. RSS E106 LDA D106 Master data set full. RSS E108 LDA D108 Request directed at an automaster. RSS E110 LDA D110 Master with key value already exists. RSS E115 LDA D115 PUT mode invalid. RSS E118 LDA D118 Data set is not writeable. RSS E159 LDA D159 Data base not locked. RSS E160 LDA D160 Run Table corrupt. RSS E162 LDA D162 Missing parameter. STA STAT,I JMP PUT6 SKP * * The following routines perform comparisons of integers and reals for * sorting chains. Each routine returns: * P+1 if the sort values are equal * P+2 if the sort value in the record buffer is > * the sort value in the user's buffer * P+3 if the sort value in the record buffer is < * the sort value in the user's buffer * * The first is ICMP. It compares integers by subtracting the value of * the sort item in the user's buffer (pointed to by KVAL) from the value * of the sort item in the record buffer (pointed to by SADDR) and * checking the overflow. If the A reg is zero after the subtract, the * values are equal. If the A reg is positive, SADDR's value is greater * than KVAL's. If the A reg is negative, KVAL's value is greater than * SADDR's. * ICMP NOP JSB .ENTR DEF ICMP * CLO LDA KVAL,I CMA ADA SADDR,I SOS CMA * SZA,RSS JMP ICMP,I ISZ ICMP SSA,RSS ISZ ICMP JMP ICMP,I * * The second routine is RCMP. It compares reals by first comparing the * sign of the sort value in the user's buffer (pointed to by KVAL) to * the sign of the sort value in the record buffer (pointed to by SADDR). * If the signs differ, then if KVAL's sign is negative, KVAL's value is * less than SADDR's, else SADDR's value is less than KVAL's. If the signs * are the same, it subtracts KVAL's value from SADDR's checking for over- * flow. If no overflow occurs, then the A reg determines the comparison * of the values. If an overflow occurs, the exponents of the sort items * are incremented by one, and the subtract is retried. After successful * completion of the subtraction, the A reg determines the comparison of * the values as follows. If the A reg is zero, the values are equal. * If the A reg is negative, SADDR's value is greater than KVAL's. If * the A reg is positive, SADDR's value is less than KVAL's. * RCMP NOP JSB .ENTR DEF RCMP * LDA KVAL,I XOR SADDR,I SSA JMP RCMP2 * DLD KVAL,I RCMP1 JSB .FSB DEF SADDR,I SOS JMP RCMP3 * DLD SADDR,I INB DST SADDR,I DLD KVAL,I INB JMP RCMP1 * RCMP2 LDA KVAL,I JMP RCMP4 RCMP3 SZA,RSS JMP RCMP,I RCMP4 ISZ RCMP SSA,RSS ISZ RCMP JMP RCMP,I SKP * * The following section performs the rewind of a detail data set PUT in * the case of an error occurring after the first master has been updated * and before the new detail entry is written successfully to disc. It * does this by looping on the temp. master record number storage area * picking up each entry in the area undoing the update on the path re- * lated to the detail. Each entry in the storage area looks like: * * word +--------------------------------+ * 1 | master's set # | index into media record for path * ---------------------------------- * 2 | master record | * -- -- * 3 | number | * +--------------------------------+ * * The end of the meaningful data in the area is signified by the first * zero in the master data set word. The last word of the area is al- * ways zero as a safety catch. * * When this clean-up routine is entered, the error code of the error which * brought us here is in the A register. If it's negative, set it posi- * tive and put the error code in the STATus array. * REWND SSA CMA,INA STA STAT,I * * Set up the loop parameters. * LDA MEDST Address of temp. media record STA PATHI * LDA MSTST Address of temp. master STA MSTRI record number storage. * * For each entry in temp. master record number storage area: * * 1) If set number = 0, return to user. * RWND0 LDA MSTRI,I SZA,RSS JMP PUT6 * * 2) Else, read entry whose record number follows master's set number * into record buffer. * AND LOBYT Save index into media STA TEMP record for later. * LDA MSTRI,I Get master set's number. ALF,ALF AND LOBYT STA MNUM ISZ MSTRI * JSB DBRED DEF *+4 DEF BASE,I DEF MNUM DEF MSTRI,I * SZA If any error just ignore JMP RWND8 and continue with next entry. * * 3) Calculate address for this path in master's media record by adding * the index to the address of the record buffer. * LDB TEMP ADB DBRBP STB TEMP * * 4) Decrement chain count. * DLD TEMP,I JSB .DDE DST TEMP,I SSA JMP RWND1 SZB,RSS SZA JMP RWND3 * * 5) If chain count <= 0: * A) Zero-fill chain head and chain foot pointers. * RWND1 CLA CLB DST TEMP,I ISZ TEMP ISZ TEMP DST TEMP,I ISZ TEMP ISZ TEMP DST TEMP,I * * B) If set an auto master, see if all chain counts are zero. * JSB DBFDS Ask DBFDS to get the DEF *+5 DSCB for us. DEF MNUM DEF TEMP DEF READ DEF MADR * LDA TEMP If it returns a set# of 0 SZA,RSS ignore this error and just JMP RWND8 continue with next entry. * LDB MADR Set type code in 2nd nibble ADB AIRUN of high order byte of 5th ADB DSTYP word of DSCB. If set LDA B,I type = 0 then set is ALF,RAL an automatic master. SSA JMP RWND7 * ADB D2 Loop on each path in media record LDA B,I checking for zero chain counts. AND LOBYT Use negative of #paths/entry CMA,INA as the loop counter. STA CNTR1 * LDA DBRBP Get first chain pointer address ADA D5 STA TEMP * RWND2 DLD TEMP,I First non-zero chain count SZB,RSS gets us out of loop SZA and to the record write. JMP RWND7 * LDA TEMP ADA D6 STA TEMP ISZ CNTR1 JMP RWND2 * * C) If all chain counts are zero, delete the automatic master entry. * CLA Let DBDME know record is JSB DBDME in record buffer. DEF *+4 DEF BASE,I DEF MNUM DEF MSTRI,I * JMP RWND8 Ignore any errors. * * If chain foot pointer in master's media record = new record's number, * put backward pointer from temp. media storage there. * RWND3 ISZ TEMP ISZ TEMP DLD TEMP,I JSB .DCO DEF NEXT,I JMP RWND4 NOP JMP RWND5 * RWND4 DLD PATHI,I DST TEMP,I * * If chain head pointer in master's media record = new record's number, * put forward pointer from temp. media storage there. * RWND5 ISZ TEMP ISZ TEMP DLD TEMP,I JSB .DCO DEF NEXT,I JMP RWND6 NOP JMP RWND7 * RWND6 LDA PATHI ADA D2 DLD A,I DST TEMP,I * * 7) Write the updated record to disc. * RWND7 JSB DBWRT DEF *+4 DEF BASE,I DEF MNUM DEF MSTRI,I * * 8) Continue with next entry. * RWND8 LDA MSTRI Get next entry's address. ADA D2 STA MSTRI LDA PATHI Get next path in temp. ADA D4 media record storage. STA PATHI JMP RWND0 * SKP * * Move Data Record is a utility subroutine which moves the data item * values supplied by the user into the data record (of the data set whose * DSCB is passed to us) in the record buffer. DBPIL set up all the in- * formation we need for the data transfer in the TEMPX table. This table * has on entry for each item specified 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 * * W, K, & S are ignored by 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 build a loop which looks at the first word of each * entry. If the word is zero, the process is stopped. If non-zero, we * 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 word * length of all the items in the TEMPX table. * * First, get the true parameter and return point addresses for this call. * DSCB NOP * DBMDR NOP JSB .ENTR DEF DSCB * * Set up the loop parameters. * CLA A zero to the totl word length STA WLEN of the values in BUF. * LDA TEMPX Set up TEMPX table address. STA ITTAB * LDB DSCB,I 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 DBCB) AND LOBYT ADA DBRBP + address of record buffer. STA DRADR * LDA BUF Get address of user's buffer * * BEGIN LOOP * While item # not zero: Move item length number of words from user * buffer into data record address + index of item. WLEN := WLEN + * length of item. * MDR1 LDB ITTAB,I Item # = 0? SZB,RSS JMP DBMDR,I Yes - return to caller. * ISZ ITTAB No - set up move length LDB ITTAB,I STB MVLEN * ISZ ITTAB and get address of item LDB ITTAB,I in data record. ADB DRADR * JSB .MVW Then, do the move of the item value. DEF MVLEN DEC 0 * LDB MVLEN Add in this item's length ADB WLEN to the running total. STB WLEN ISZ ITTAB Get next entry in TEMPX JMP MDR1 and continue. * * 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 D100 DEC 100 D102 DEC 102 D103 DEC 103 D104 DEC 104 D105 DEC 105 D106 DEC 106 D107 DEC 107 D108 DEC 108 D110 DEC 110 D113 DEC 113 D115 DEC 115 D118 DEC 118 D154 DEC 154 D159 DEC 159 D160 DEC 160 D162 DEC 162 * LOBYT OCT 377 I OCT 111 X OCT 130 * FLAG NOP KEYS NOP STADR NOP STNUM NOP INDEX NOP READ NOP RECRD BSS 2 SYNYM BSS 2 SYCNT BSS 2 SAVE1 BSS 2 TEMP NOP SITNO NOP SINDX NOP PADDR NOP SADDR NOP DRECD NOP ITTAB NOP DRADR NOP MVLEN NOP WLEN NOP CNTR1 NOP PTADR NOP NEXT NOP DKEY NOP MNUM NOP MADR NOP KVAL NOP CNTR2 NOP PATHI NOP MSTRI NOP MEDST DEF *+1 } Do not separate these BSS 64 } BSS instruction unless you BSS 49 } change the call to DBFWZ MSTST DEF MEDST+65 END