ASMB,L,C,R HED DBPIL IMAGE/1000 UTILITY SUBROUTINE NAM DBPIL,7 92069-16156 REV.2026 800501 * * ******************************************************************* * (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-18156 * RELOC: 92069-16156 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Process Item List is a subroutine which accepts the item list passed * to an IMAGE subroutine by the user's program, parses the item list into * its components and builds an information table on the items in the list * for the IMAGE subroutine. The item list is either: * * 1) A number list in which the first word contains an integer count * of the number of items in the list and each succeeding word, up * to the count number of items contains an unique item number. * 2) A name list which is a list of unique item names concatenated * together, separated by commas, and terminated by a semi-colons * or a blank. * 3) A special construct either: * "@ " meaning all items in the data set's record definition * table * or * "0 " meaning no items. * * The information returned by DBPIL is in a table where each item has * one entry and each entry is three words long and have the meaning: * * word --------------------------------- * 1 !w!k!s| ! item no. ! -> or entire word = 0 * --------------------------------- * 2 ! word length of item ! * --------------------------------- * 3 ! index into data record of set ! * --------------------------------- * * 15 14 13 8 7 0 bit * * w if set means item is writeable * k if set means item is a key item * s if set means item is a sort item * * The last entry following the last item's entry in this table contains * a zero (end of table marker). In addition, DBPIL returns the number * of key items in the list as its third parameter. * * The calling sequence for DBPIL is: * * JSB DBPIL * DEF *+4 return point * DEF IMLST item list to process * DEF DSADR address of data set's control block table * entry, relative to start of Run Table * DEF KEYS returned number of keys in list * * A status code, zero if successful, is returned in the A register. * 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 * * *********************************************************************** *** *** * * EXT .ENTR,AIRUN,DBCIX,DBFDI,DBRBP,NAMR ENT DBPIL,TEMPX A EQU 0 B EQU 1 * IMLST NOP DSADR NOP KEYS NOP * * Get true addresses of parameters and return point. * DBPIL NOP JSB .ENTR DEF IMLST * * Initialize process's parameters. * PIL1 CLA Zero to # of keys STA KEYS,I LDA TEMPX Set up information table address STA TABAD for loop. * * Determine if a special contruct we recognize is given. If so, branch * to the appropriate processing location. If not, assume the list is * of numbers or names. * LDA IMLST,I SSA If negative first word - JMP E101 illegal item list * CPA /@ If an "@ " JMP PIL11 process entire record definition table * CPA /0 If an "0 " or an integer zero JMP PIL14 process no items SZA,RSS JMP PIL14 * AND HIBYT Else, if first byte of word is zero - SZA,RSS this is a number list. CMA Set number flag to TRUE. STA NFLAG Else, set number flag to FALSE. * * Get # of fields/entry (i.e. # of items/data record) in data set and * save. If we are processing a number list, make sure the count spe- * cified by the user is within the range 0 < item count <= # fields/entry. * LDB AIRUN Get true address of data set's entry ADB DSADR,I in Run Table. ADB DSFCT Increment to # fields/entry word. LDA B,I Pick up number - it is in the AND HIBYT first byte of this word. ALF,ALF STA #F/E * LDB NFLAG If a number list SSB,RSS JMP PIL2 LDB IMLST,I CMB see if count okay. STB CONTR INB ADB A (i.e. count <= # fields/entry) SSB JMP E101 No - illegal item list JMP PIL3 * * For a name list, we will use NAMR to parse the string as we need a * name. So we need to set up for NAMR. This means getting the byte * count in the string and setting the starting byte to one. To get the * byte count, we will search each byte in the string until we find a * blank or semi-colon, incrementing the byte count by one for each byte * not matching an ending character. * PIL2 CLA Initialize byte count to zero. STA BCNT INA And starting byte to one. STA BSTRT * LDA #F/E Set maximum byte count to CLB -(# items in set * 7) MPY D7 CMA,INA This is 6 bytes per name STA BMAX plus trailing ",", ";", or " ". * LDB IMLST Get address of item list. PIL21 CCA Set first byte in word flag. STA FIRST LDA B,I Get first byte. ALF,ALF * PIL22 AND LOBYT CPA SEMI If a semi-colon JMP PIL24 CPA ABLNK or a blank JMP PIL24 we are done. * ISZ BCNT Else, increment byte count ISZ BMAX If byte count exceeds the maximum, RSS JMP E101 a bad item list. * ISZ FIRST If we were on first byte JMP PIL23 LDA B,I get second byte in word. JMP PIL22 * PIL23 INB Else get next word and JMP PIL21 process its first byte. * PIL24 LDA BCNT At end, if byte count SZA,RSS is zero, JMP E101 a bad item list. JMP PIL4 * * BEGIN MAIN LOOP FOR NUMBER OR NAME LIST * This section of code picks up each item in the list, gets its item * table entry, item number and length, and determines if the item is * writeable. Then it calculates the item's index into the data record * of the set and determines if the item is a key. With each bit of in- * formation, the information table is slowly built. * PIL3 LDB NFLAG If a number list SSB,RSS JMP PIL4 ISZ CONTR If no more items in list, RSS JMP PIL10 we are done. ISZ IMLST LDA IMLST,I Else, pick up next item number STA ITEM and save it. JMP PIL5 * PIL4 JSB NAMR Else a name list - DEF *+5 call NAMR to get DEF ITEM next name. DEF IMLST,I DEF BCNT DEF BSTRT * SSA If no more names JMP PIL10 we are done. * PIL5 JSB DBFDI Call DBFDI to get item's item DEF *+5 table entry address relative to DEF ITEM beginning of Run Table. DEF NUMBR DEF FLAG DEF DIADR * LDB NUMBR If number returned is SZB,RSS equal to zero - JMP E101 illegal item list. * LDA FLAG If item inaccessible SSA,RSS (i.e. FLAG > 0) SZA,RSS then the item list is invalid RSS JMP E101 * * Search information table for an identical item number. If a match is * found, item list is illegal. * LDB TEMPX PIL6 CPB TABAD If at end of table, JMP PIL7 everything is fine. * LDA B,I If item # in this entry in table AND LOBYT same as the item # we are CPA NUMBR processing - JMP E101 illegal item list. ADB D3 Else try next entry until JMP PIL6 end of meaningful data in table. * PIL7 LDA NUMBR Get item # into A reg. LDB FLAG If accessibility flag from DBFDI is < 0 SSB item is writeable, set w bit in IOR WRITE item # word of information table entry. STA TABAD,I * LDB DIADR Get length of item from ADB AIRUN ADB ITLNG item's item table entry. LDB B,I LDA TABAD INA Store it in the 2nd word of the STB A,I information table entry. * * Call DBCIX to compute the index into the data set's data record for * this item. * JSB DBCIX DEF *+4 DEF NUMBR DEF DSADR,I DEF INDEX * * If INDEX < 0, item could not be found in record definition table - * Illegal item list!! * LDA INDEX SSA JMP E101 * * Else okay, put index into third word of information table. * LDB TABAD ADB D2 STA B,I * * Determine if item is a key item. * JSB DBIFK * * A register is returned <0 if item a key, >0 if item a sort item, else * zero. If item a key set key bit in information table and increment * the key item count. If item is a sort item, set sort bit in information * table. * SZA,RSS JMP PIL9 * SSA,RSS JMP PIL8 * LDA TABAD,I Item is a key item. IOR KEY STA TABAD,I ISZ KEYS,I JMP PIL9 * PIL8 LDA TABAD,I Item is a sort item. IOR SORT STA TABAD,I * PIL9 LDA TABAD Get address of next entry ADA D3 in TEMPX table STA TABAD JMP PIL3 and continue with next item. * * We come here when the item list processing is done successfully. * PIL10 CLB Put a zero item number word as the STB TABAD,I final entry in the information table. JMP PILF * * We come here when the special construct "@ " is given in the item list. * Get entire record definition table and transform it into an item num- * ber list. Then, branch up to item number list processing. * * The item list we build will occupy the low 128 words of TEMPX and there- * fore starts at TEMPX+254. We use TEMPX in this way to save space since * the item list would cost us a hard coded 128 words. * PIL11 LDB DSADR,I Get data set entry true address ADB AIRUN ADB DSFCT Increment to fields/entry count. LDA B,I Get the count from the first byte of this word ALF,ALF AND LOBYT STA LIST,I and put into item list. CMA,INA Negate it and save as loop counter. STA CONTR LDA LIST Get list address and bump INA STA TEMP2 then save for loop. * INB Increment B to the info table pointer LDA B,I and get its true address. ADA AIRUN STA IFADR * * Pull each byte out of the record definition table, make it into a word * and put it into the list. * PIL12 LDA IFADR,I Get first byte's item #. ALF,ALF AND LOBYT STA TEMP2,I and put into item number list. ISZ TEMP2 * ISZ CONTR If more to go, RSS continue with second byte. JMP PIL13 Else we are done. * LDA IFADR,I AND LOBYT STA TEMP2,I ISZ TEMP2 * ISZ CONTR If last field we are done, RSS JMP PIL13 ISZ IFADR else bump RDT address JMP PIL12 and continue with first byte of this word. * PIL13 LDA LIST List is built STA IMLST put it in the item list parameter JMP PIL1 and jump to number list processing. * * We come here when the special construct "0 " or an item count of zero * is given in the item list. Put a zero entry in the information table. * PIL14 CLA STA TEMPX,I * * Exit points. * PILF CLA No error - error code = 0. RSS E101 LDA D101 Error 101 - illegal item list JMP DBPIL,I * * Constants and variables * D2 EQU ZERO+2 D3 EQU ZERO+3 D101 DEC 101 LOBYT OCT 377 KEY OCT 040000 SORT OCT 020000 WRITE OCT 100000 HIBYT OCT 177400 * /@ OCT 040040 /0 OCT 030040 SEMI OCT 000073 ABLNK OCT 000040 * TABAD NOP NFLAG NOP #F/E NOP FLAG NOP DIADR NOP IFADR NOP NUMBR NOP ITEM BSS 10 TEMP2 NOP INDEX NOP CONTR NOP FIRST NOP BCNT NOP BMAX NOP BSTRT NOP * TEMPX DEF *+1 NOTE: LIST is used to build an item list BSS 382 from the RDT. Do not shorten TEMPX without LIST DEF TEMPX+254 exploring the consequences on LIST. SKP * * IF Key is a subroutine which searches the data set control block and * path table of the specified data set to determine if the specified * item is a key item or a sort item for the data set. DBIFK signifies * that the item is a key by setting the key flag (A reg) to <0, that * the item is a sort item by setting the A reg to >0. If the item is * not a key or sort item, A reg is set to 0. If the item is a key and * a sort item, the key reference takes precedence and the A reg is set * to <0. * DBIFK NOP * * Initialize search parameters. * * LDB NUMBR Move the item number from the 2nd BLF,BLF byte of this word into the 1st byte. STB KBYTE (for easier comparison of key items) * * Get data set type from data set's entry. * LDB AIRUN Get true address of data set's entry. ADB DSADR,I ADB DSTYP Increment to word containing type, LDA B,I get that word - ALF type is in 10th & 11th bits. SSA If type = 2, this is a detail. JMP IFK1 * ADB D6 Else type = 0 or 1, both are masters. LDA B,I A master's key item is in control block. AND HIBYT First byte of 11th word. CPA KBYTE Are they the same? JMP IFK3 Yes - set flag then return JMP IFK4 No - clear flag then return. * * Detail data set - get path table address and # paths/entry. * IFK1 ADB D2 # paths is in 2nd byte of 7th word LDA B,I of the control block. AND LOBYT SZA,RSS If # paths = 0, there are no keys, JMP IFK4 just return. * CMA,INA Else, negate the path count STA CNTR2 for use as a loop counter. * LDA B,I # fields/entry is in 1st byte of 7th word. ALF,ALF (# fields/entry + 1) / 2 AND LOBYT is the length of the record INA definition table in the info table. ARS * INB Pointer to info table is in 8th word LDB B,I of the control block. Get its true address ADB AIRUN add the length of the RDT ADB A = address of path table. * CLA Set sort flag to zero. STA SFLAG * * BEGIN MAIN LOOP * IFK2 LDA B,I For each entry in path table, AND HIBYT if item # in entry = CPA KBYTE specified item # then JMP IFK3 we have a key. INB if item # in sort field = LDA B,I specified item # then CPA NUMBR STA SFLAG we have a sort item ISZ CNTR2 RSS JMP IFK4 Else, not a key INB JMP IFK2 * * Exit points. * IFK3 CCA,RSS If the item was a key set A to -1 IFK4 LDA SFLAG else if the item was a sort item JMP DBIFK,I set A positive, else set A to zero. * * Constants and variables * D6 EQU ZERO+6 D7 EQU ZERO+7 CNTR2 NOP SFLAG NOP KBYTE NOP END