ASMB,L,C,R HED DBOPN SUBROUTINE OF IMAGE/1000 NAM DBOPN,7 92069-16136 REV.2040 800730 * * ******************************************************************* * (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-18136 * RELOC: 92069-16136 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * JANUARY 25, 1980 TO RELEASE UNUSED FRT SPACE - CEJ * FEBRUARY 22, 1980 TO ADD RA BIT TO DSCB - CEJ * JULY 30, 1980 TO CLOSE FILE AFTER OPEN IF NOT A * TYPE 1 FILE - CEJ * * ******************************************************************* * * * * Data Base OPeN is one of the ten user callable subroutines in the IMAGE/ * 1000 DBMS Library. Its function is to open the data base root file, * and prepare the necessary main memory buffers for future access to the * data base. * * The buffers that DBOPN need initialize are : * 1) The Run Table - * an in main memory copy of the root file with additional inform- * ation on the access capabilities to the entities of the data * base and some size parameters set. * 2) The Record Buffer - * for reading and writing entries in the data base. * 3) Data Set DCBs - * again for reading and writing entries in the data base. * * The user is given three access options for opening a data base. These * are identified by the DBOPN mode as follows: * mode meaning * ---- ------- * 1 shared read/write access * 3 exclusive read/write access * 8 shared read-only access * * The calling sequence for DBOPN is: * * JSB DBOPN * DEF *+5 return point * DEF BASE an array containing: * two ASCII blanks or a DS/1000 node # in the * first word followed by an FMP namr string * specifying at least the data base name and * security code. * On a successful return, DBOPN stores a data * base number in the first word of the array. * DEF LEVEL an array containing the user's levelcode word * three words long, padded by trailing blanks * if necessary. * DEF MODE Open mode as described above. * DEF STAT a ten word array in which status information * is returned to the user. This subroutine * uses only the first three words which are * as follows: * word contents * ---- -------- * 1 status code (0 if successful) * if successful: * 2 user's assigned access level * 3 word length of Run Table * 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 DBOPN EXT .CMW,.ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDCT,DBIDS EXT DBDMX,DBDSZ,DBFDI,DBFDS,DBFRT,DBFWZ,DBPAR,DBRBL EXT DBRBP,DBRTP,EXEC,GETBF,OPEN,PNAME,RBOPN,RETBF EXT ECLOS,EREAD,RMPAR,TRIM * BASE NOP LEVEL NOP MODE NOP STAT NOP * * Get true parameter and return point addresses. * DBOPN NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA STAT SZA,RSS JMP OPN28 Missing parameter. * * Ask DBIDS to check the BASE parameter to see if the data base is on * a remote machine. * CLA A = 0 signifies DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - invalid BASE param. JMP LOCAL Data base is local return. * JSB RBOPN Data base is remote return. DEF *+5 Ask RBOPN to handle DEF BASE,I this request. DEF LEVEL,I DEF MODE,I DEF STAT,I JMP OPN28 Return to user. * * The data base parameter contains a root file namr in its 2nd through * ? words. Parse it into its components. The file name and security * code must be there, cartridge number is optional. * LOCAL JSB DBPAR DBPAR does the parse. DEF *+3 DEF NAME DEF BASE,I JMP E103 Error return - illegal base param. * * Ask DBFRT to see if the data base specified by the user in BASE is al- * ready open to this program. If so, we cannot open it again. If not, * DBFRT will pass us the index into the Run Table pointer table for the * first free space in the table. This we save off as the data base num- * ber on a successful open. * CLA A = 0 tells DBFRT we JSB DBFRT are DBOPN. DEF *+4 DEF BASE,I DEF NAME DEF CRN * SSA,RSS Did DBFRT find the R.T.? JMP E150 Yes - cannot open it again. * LDA AIRUN No - get index from AIRUN STA DBNUM and save. CLA STA AIRUN * * Check that the open mode specified by the user is valid, i.e. that it * is in the set [1,3,8]. * LDA MODE,I CPA D1 RSS CPA D3 RSS CPA D8 RSS JMP E115 No match - bad mode. * * Merge the open mode in with the function code for DBCOP. * LDB D1 Function code for a check is 1. BLF,BLF Function code in 1st byte, IOR B open mode in 2nd. STA FC/MD * * Ask DBCOP to check the data base open mode for obtainability. DBCOP * supervises data base opens for the proper mix of open modes. * JSB EXEC Schedule DBCOP DEF *+8 on queue with wait DEF NA23 and no abort. DEF DBCOP DEF FC/MD DBCOP needs: function code/open mode DEF NAME data base name DEF NAME+1 DEF NAME+2 DEF CRN cartridge number JMP E140 Here on abortion. * * * Get returned status code from DBCOP. If zero all is go. If non-zero * it is proper IMAGE error code to return to user. * JSB RMPAR DEF *+2 DEF ERROR * LDA ERROR SZA JMP ERREX * * Set up the data base DCB for the open call for this root file by zero * filling its first 16 words. * JSB DBFWZ DEF *+3 DEF D16 DEF DBDCB * * Set up the OPEN call by checking the open MODE specified by the user. * If mode 3, the root file is open exclusively, else the root file is * opened non-exclusively. Root file always opened with update option. * LDA IOPTN LDB MODE,I CPB D3 RSS IOR NEXCL STA PATCH * * Ask the FMP to open the root file for us. * JSB OPEN DEF *+7 DEF DBDCB,I DEF ERROR DEF NAME DEF PATCH options stored in PATCH DEF SC DEF CRN * CPA D1 Did OPEN succeed in JMP OPN1 opening a type 1 file? * SSA,RSS No - error encountered? JMP E116 No - invalid root file. * CPA M8 Yes - locked or open root file? JMP E129 Yes CPA M7 No - security violation? JMP E117 Yes CPA M6 No - non-existant file? JMP E119 Yes JMP ERREX No - return FMP error * * From this point on we will jump to a clean-up routine in case of an * error. CLNUP uses SAVE as a check on the record buffer. We will set * it to -1 at this point to inform CLNUP we do not need to rewind the re- * cord buffer in case of an error. CLNUP also uses DCBFL as a flag that * DCBs have been allocated. We will set it to zero to signify that no * DCB space has been allocated for this data base. * OPN1 CLA STA DCBFL CMA STA SAVE * * Now, read in the five overhead words from the first record of the root * file. These words contain: * 1) The record number (single integer) at which the data base direc- * tory starts. * 2) The length of the directory. * 3) The length of the Free Record Table. * 4) The optimum number of DCBs for the data base. * 5) The length of the longest entry in the data base. * JSB EREAD DEF *+5 DEF DBDCB,I DEF ERROR DEF RTREC+1 DEF D5 * SSA Any error? JMP CLNUP Yes - go clean up. * * We will do a couple of checks to see if the root file we just opened * is valid. First, the 1st word of overhead (read into RTREC+1) should * be either 3 or 4. Second, the 4th word of overhead (read into #DCBS) * should be within [1,17]. * LDA D116 LDB RTREC+1 CPB D3 RSS CPB D4 RSS JMP CLNUP * LDB #DCBS CMB,INB SSB,RSS JMP CLNUP ADB D17 SSB JMP CLNUP * * RTLEN now contains the length of the Run Table minus the Free Record * Table. FRTLN contains the Free Record Table length, round this up to * the nearest multiple of 128. Total the two (i.e. RTLEN and rounded * FRTLN). Get the primary pointer address for the Run Table by adding the * data base number (passed to us long ago by DBFRT) to the address of the * Run Table pointer table and subtracting one. Then ask GETBF for a * slice of memory large enough for the total Run Table. * CCA The reason we need to round up to a ADA FRTLN multiple of 128 is that the FMP expects ADA D128 a multiple of 128 words to be written to CLB a type 1 file. We get the extra memory DIV D128 (even though it is wasted) in order MPY D128 to avoid aborting with a memory error ADA RTLEN when writing the FRT to disc. STA TEMP * CCA ADA DBRTP ADA DBNUM STA RTPTR * JSB GETBF DEF *+4 DEF TEMP DEF RTPTR,I DEF ERROR * SSA,RSS Did GETBF succeed? JMP OPN2 Yes - continue on. LDA D128 No - not enough room JMP CLNUP for Run Table. * * We've got the space, so trim off any excess allocated for the Free * Record Table. To do this, compute the space we will actually use * and call TRIM to trim off the rest. * OPN2 LDA FRTLN ADA RTLEN STA TEMP TEMP = actual size of used space * JSB TRIM TRIM trims off the excess DEF *+3 DEF RTPTR,I It needs: pointer to allocated space DEF TEMP length to keep * SSA,RSS If TRIM returns any error, JMP OPN2A LDA D128 no memory error! JMP CLNUP * * Read the Run Table into the remaining space. First, we bring in the * directory (that is the Run Table minus FRT) then we bring in the * Free Record Table. * OPN2A LDA RTPTR STA AIRUN Point AIRUN to the pointer. LDA A,I Point RTPTR to the Run Table. STA RTPTR * JSB EREAD DEF *+7 DEF DBDCB,I DEF ERROR DEF RTPTR,I DEF RTLEN DEF TEMP DEF RTREC * SSA If any error JMP CLNUP clean up the process. * LDA RTPTR Calculate address for FRT. ADA RTLEN STA RTPTR * JSB EREAD DEF *+7 DEF DBDCB,I DEF ERROR DEF RTPTR,I DEF FRTLN DEF TEMP DEF FRTRC FRT starts in record # 2. * SSA Any error? JMP CLNUP Yes - clean up! * LDB AIRUN,I No - set up the pointer to the ADB DBFRP FRT in the Run Table (12th word). LDA RTLEN This is same as directory length. STA B,I * * Now, we have the root file in memory. Check that the security code * specified by the user matches the one in the root file to make sure * no-one has tampered with it and get the cartridge number from the Run * Table and put it in CRN. * LDB AIRUN,I ADB DBSCD LDA SC CPA B,I JMP OPN3 LDA D117 JMP CLNUP Not the same. * OPN3 INB Security codes the same, LDA B,I make sure we've got the STA CRN cartridge number. * * Now, we need to get a record buffer of the proper size. First, let's * see if one already exists and if so, if it is large enough. The record * buffer must be as long as the longest entry in the data base. The * length is in ENTLN from the overhead read. * LDA DBRBL Record buffer length is zero STA SAVE if no record buffer. SZA,RSS JMP OPN4 * CMA Not zero - is it big enough? ADA ENTLN SSA JMP OPN6 Yes - skip reallocation. * JSB RETBF No - deallocate it. DEF *+2 DEF DBRBP * SSA,RSS Did deallocate succeed? JMP OPN4 Yes LDA D160 No - corrupt memory error JMP CLNUP clean up. * * Join processing here for allocation of record buffer from no record * buffer and from deallocation of existing record buffer. Old record * size was saved for CLNUP above, so now set the record buffer length to * zero. Then try to allocate one of the proper size. * OPN4 CLA STA DBRBL * JSB GETBF DEF *+4 DEF ENTLN DEF DBRBP DEF ERROR * SSA,RSS Did GETBF succeed? JMP OPN5 LDA D128 No - go clean up. JMP CLNUP * OPN5 LDA ENTLN Yes - set DBRBL to length of STA DBRBL new record buffer. * * Now, we want to allocate as many 272 word DCBs as possible up to the * optimal number of DCBs for this data base. First, we'll check the * number of DCBs already allocated. If this is greater than or equal * to the number we would like (#DCBS from root file overhead) we are * all set. If there are no DCBs already allocated we must be able to * allocate at least one DCB for DBOPN to succeed. Also, if there are * no DCBs allocated, we set DCBFL to -1 to signify to CLNUP that all * DCBs allocated when it is called must be deallocated, otherwise no * deallocation is done. * OPN6 CCB LDA DBDCT SZA,RSS STB DCBFL CMA ADA #DCBS SSA Are there enough DCBs alreadY? JMP OPN10 Yes - need allocate no more. * * Loop on the number of DCBs we would like over the number we have, * searching for an empty DCB pointer in the DCB pointer table then call- * ing GETBF to allocate the new DCB. If GETBF ever comes back unsuc- * cessful and we started with none allocated, we check to make sure that * we were able to allocate at least one DCB. If not, we cannot complete * the DBOPN and undo everything we have already done. * * First, we need to set up the loop parameters. * INA Use negative of # of DCBs we CMA,INA would like over the # we STA CNTR have now as loop counter. * LDB DBDCP Get address of DCB STB TEMP pointer table. * LDB DBDMX Use negative # of entries CMB,INB in DCB pointer table as STB CNTR2 loop counter also. * * BEGIN LOOP * For each DCB we would like: * 1) Find an empty DCB pointer, 1st word of DCB pointer table entry * is zero if pointer empty. * OPN7 LDA TEMP,I SZA,RSS JMP OPN8 * ISZ TEMP ISZ TEMP ISZ CNTR2 End of pointer table? JMP OPN7 No - try this entry JMP OPN9 Yes - cannot allocate more DCBs * * 2) Try to allocate DCB * OPN8 ISZ TEMP TEMP -> DCB pointer. JSB GETBF DEF *+4 DEF DBDSZ Changeable size of DCBs DEF TEMP,I DEF ERROR * * 3) If DCB allocated, set first word of entry to -1 to indicate a * DCB pointer there and zero-fill the first 16 words of the DCB * to avoid conflicts with whatever may be in memory and legitimate * FMP values. If DCB not allocated jump to check for at least one * DCB allocated. * SSA JMP OPN9 * CCB CCA ADA TEMP STB A,I * JSB DBFWZ DEF *+3 DEF D16 DEF TEMP,I * * 4) Continue with next DCB we would like. * ISZ TEMP ISZ DBDCT Increment DCB count. ISZ CNTR Done with number we want? JMP OPN7 JMP OPN10 Yes success! * * END OF LOOP * * * We come here when: 1) end of DCB pointer table is found before we could * allocate all the DCBs we wanted or 2) end of free memory is found be- * fore we could allocate all the DCBs we wanted. Make sure there is at * least one DCB allocated. * OPN9 LDA D128 If not even one DCB LDB DBDCT a not enough memory error. SZB,RSS JMP CLNUP * * All memory allocation is done, there should be no more compaction. * So, we want AIRUN to contain the Run Table address (rather than the * address of the address it contains now) but need to save the address * of the address in case of a future clean up. So, first set AIRUN then * we want to initialize the Run Table for this particular user and open. * Put the first word of the base parameter in the 6th word of the DBCB. * Then save the words/no level words flag in the 14th word of the DBCB and * put the open mode in the same word of the DBCB (low order byte) zeroing * the lock flag (high order byte of same word). * OPN10 LDB AIRUN STB RTPTR LDB B,I STB AIRUN * ADB DBDSN LDA BASE,I STA B,I * ADB D8 LDA B,I STA TEMP * LDA MODE,I STA B,I * * Determine user's access level by comparing the level code word given * us in LEVEL to the code words in the DBCB. The first match gives us * the level. If no match, the user has level zero. If no level code * words in DBCB, the user has level 15. We can check for no level code * words by looking at the flag we saved in TEMP. If flag = TRUE (0) * there are level code words and we must do comparison search. If flag * = FLASE (-1) there are no level code words and the user automatically * has level of 15. * LDA D15 ISZ TEMP CMA,INA,RSS JMP OPN15 No code words. STA CNTR Set loop counter to -15. * * If the first word of the user supplied LEVEL code word is blank, we * will assign an access level of zero. We make this check in case the * entire code word array is blank filled so the blanks will not match * the first level in the DBCB which does not contain a code word. DBDS * fills undefined level code words with blanks. * CLA LDB LEVEL,I CPB BLNKS JMP OPN15 * * There are levels and user specified code word appears okay. Try to * find a match. * LDB AIRUN Loop on each level code word ADB DBLVL (15 in all) comparing user specified STB TEMP word with that in DBCB. * OPN13 LDA LEVEL JSB .CMW DEF D3 DEC 0 JMP OPN14 Code words match. * NOP LDB TEMP No match try next one. ADB D3 STB TEMP * ISZ CNTR If there is a next one. JMP OPN13 * CLA No match - user has level of zero. JMP OPN15 * OPN14 LDA CNTR A match - get level by adding ADA D16 16 to loop counter. * OPN15 STA LEVEL Save access level in LEVEL. * * Now, we need to determine the access the user has to each item in the * data base and set the Write and Read bits in the item's entry in the * Item Table. We do this by setting up a loop on the number of items * in the Run Table. * CLA,INA Set 1st item # to one. STA ITEM * LDB AIRUN Use negative of # of items ADB DBICT in data base as a loop counter. LDA B,I CMA,INA STA CNTR * CCA Set an accessible item flag STA NACC to FALSE. * * BEGIN LOOP * For each item in data base: * * 1) Get relative Item Table entry address through DBFDI. Then get * true address by adding to address of Run Table. * OPN16 JSB DBFDI DEF *+5 DEF ITEM DEF ITMNO DEF TEMP DEF ADDRS * LDB AIRUN ADB ADDRS * * 2) Check read and write levels in entry against LEVEL. If LEVEL < * read level, leave both W & R bits in entry clear. If LEVEL >= * read level set an accessible item flag to TRUE, then if LEVEL >= * write level set both W & R bits in entry, else clear W bit and * set R bit. * ADB ITINF LDA B,I ALF AND NIBBL CMA,INA ADA LEVEL LEVEL >= read level? SSA JMP OPN18 No - leave bits clear. * ISZ NACC Yes - make an accessible item NOP flag non-negative. * LDA MODE,I If open mode = 8, CPA D8 JMP OPN17 no need to check write level. * LDA B,I ALF,ALF AND NIBBL CMA,INA ADA LEVEL LEVEL >= write level? SSA JMP OPN17 * LDA WRITE Yes - set both bits. RSS OPN17 LDA READ No - set R bit only. * ADB D2 IOR B,I STA B,I * OPN18 ISZ ITEM Get next item's number ISZ CNTR if there is one JMP OPN16 and check it. * * END OF LOOP * * If an accessible item flag is still FALSE (-1), user has no access to * anything in the data base * ISZ NACC RSS JMP E153 * * Now, we need to determine the access the user has to each data set in * the data base and set the Write and Read bits in the set's entry in the * Data Set Control Block Table entry for the set. We do this by setting * up a loop on the number of sets in the Run Table. * CLA,INA Set 1st set # to one. STA SET * LDB AIRUN Use negative of # of sets ADB DBSCT in base as a loop counter. LDA B,I CMA,INA STA CNTR * * BEGIN LOOP * For each set in data base: * * 1) Get relative DSCB address through DBFDS then get true address by * adding to address of Run Table. * OPN19 JSB DBFDS DEF *+5 DEF SET DEF SETNO DEF TEMP DEF ADDRS * LDB ADDRS ADB AIRUN STB ADDRS * * 2) Get # fields/entry of data set for an inner loop counter. * ADB DSFCT LDA B,I ALF,ALF AND LOBYT CMA,INA STA CNTR2 * * 3) Get address of set's Record Definition Table * INB LDA B,I ADA AIRUN STA RDTAD * * 4) Set non-writeable flag, clear inaccessible flag, set all * readable flag. * CLA STA NACC CMA STA NWRT STA ALRED * * 5) For each item in RDT, check accessibility of item through DBFDI. * If item non-writeable, clear non-writeable flag. If item readable * set inaccessible flag. If item not readable, clear all readable * flag. * OPN20 STA FIRST Set using 1st byte flag. * LDA RDTAD,I Each item in RDT takes one byte ALF,ALF get item # from 1st byte. OPN21 AND LOBYT STA ITEM * JSB DBFDI DEF *+5 DEF ITEM DEF ITMNO DEF TYPE DEF TEMP * LDA TYPE If TYPE > 0 CMA,INA item is inaccessible. SSA,RSS JMP OPN2B ISZ ALRED Since it's inaccessible, NOP clear all readable flag. JMP OPN22 OPN2B SZA,RSS If TYPE < 0 ISZ NWRT item is writeable NOP CCA STA NACC * OPN22 ISZ CNTR2 Done with all items? RSS No JMP OPN24 Yes - get out of inner loop. * ISZ FIRST Were we on first byte? JMP OPN23 LDA RDTAD,I Yes - get 2nd byte JMP OPN21 and try it. * OPN23 ISZ RDTAD No - get 1st byte of next CCA word and try it. JMP OPN20 * * 5) If inaccessible flag still clear leave both W & R bits clear. * If open mode = 8, no need to check NWRT flag since user cannot * write anything. Else, if NWRT is clear, set R bit only else * set both bits. If all readable flag still set, set RA bit also. * OPN24 LDB NACC SZB,RSS JMP OPN26 * LDB MODE,I CPB D8 JMP OPN25 * LDB NWRT SSB,RSS JMP OPN25 LDA WRITE RSS OPN25 LDA READ LDB ALRED SSB IOR AREAD * LDB ADDRS ADB DSINF IOR B,I STA B,I * OPN26 ISZ SET Get next set's number ISZ CNTR if there is one JMP OPN19 and check it. * * All there is left to initializing the Run Table now is setting the root * file overhead and 16 FMP words in the DBCB * LDB AIRUN ADB DBFRL Free Record Table legnth LDA FRTLN in 15th word. STA B,I * INB Optimal # of DCBs LDA #DCBS in 16th word. STA B,I * INB Length of longest entry LDA ENTLN in 17th word. STA B,I * INB 16 FMP words from DCB LDA DBDCB in 18th through 33nd JSB .MVW words. DEF D16 DEC 0 * * Run Table initialization is complete. Now, we need to schedule DBCOP * to add us to the co-ordinating table. If this succeeds, we are home * free. If it does not succeed, we need to undo everything we've done * so far. * * First, to call DBCOP, we need to merge the open mode in with the func- * tion code for adding an entry to the co-ordinating table. * LDB D2 Function code for adding an BLF,BLF entry is 2. Function code LDA MODE,I in 1st byte, open mode IOR B in 2nd byte. STA FC/MD * * Next, get this program's name. We send this to DBCOP as the optional * buffer in the EXEC scheduling call. * JSB PNAME DEF *+2 DEF PROGN * JSB EXEC DEF *+10 DEF NA23 DEF DBCOP DEF FC/MD DEF NAME DEF NAME+1 DEF NAME+2 DEF CRN DEF PROGN DEF D3 JMP ADDER Abortion return point. * JSB RMPAR DEF *+2 DEF ERROR * LDA ERROR If DBCOP returns an error - SZA it is proper IMAGE code. JMP COPER * * If the open mode is 1, DBCOP also returned the data base RN in RN. * Put it into the DBCB (7th word). * LDA MODE,I CPA D1 RSS JMP OPN27 LDB AIRUN ADB DBRSN LDA RN STA B,I * * We have a successful DBOPN. Put the data base pointer table index in * the first word of the base parameter and set up the status array as * follows: * word contents * ---- -------- * 1 zero * 2 user's assigned access level * 3 word length of Run Table * * Then, return to the user. * OPN27 LDA DBNUM STA BASE,I * CLA STA STAT,I ISZ STAT LDA LEVEL STA STAT,I ISZ STAT LDA RTLEN ADA FRTLN STA STAT,I * OPN28 CLA Set STAT to zero STA STAT for param check on next call. JMP DBOPN,I * * Error return points before clean up. * ERREX SSA A = error code, if negative CMA,INA make it positive. RSS E103 LDA D103 Illegal BASE parameter. RSS E115 LDA D115 Illegal DBOPN mode. RSS E117 LDA D117 Bad security code. RSS E119 LDA D119 Root file non-existant. RSS E129 LDA D129 Root file opened exclusively. RSS E140 LDA D140 Cannot schedule DBCOP. RSS E150 LDA D150 Data base already open to user. STA STAT,I JMP OPN28 * * The following error return point is seperated from the others because * the file which we opened expecting a root file must be closed. * E116 JSB ECLOS DEF *+2 DEF DBDCB,I * LDA D116 File specified is not a root file. STA STAT,I JMP OPN28 * * The following error return points are separate from all the others * because they are errors which occur after AIRUN has been set to the * address of the Run Table (rather than the address of the address) yet * the clean up routine expects AIRUN in the latter state. * E153 LDA D153 User has NO access to anything in d.b. RSS ADDER LDA D140 Abortion on a DBCOP schedule. COPER LDB RTPTR Restore AIRUN to address of address of STB AIRUN Run Table and branch to CLNUP. JMP CLNUP SKP * * The following code is the clean up routine which rewinds everything * DBOPN has done to change memory and disc data structures. There are * four major points at which we can enter the clean up routine. The * first is after the root file has been opened but no memory has been * allocated for the data base. The second is after the memory for the * Run Table has been allocated but before the record buffer has been * altered. The third is after the record buffer has been altered. The * forth is after any DCB has been allocated and there were no DCB(s) from * any previous DBOPN. * * These points are signified by: * 1) AIRUN = 0 * 2) AIRUN NE 0, and SAVE = -1 * 3) SAVE NE -1, and SAVE NE DBRBL and DCBFL = 0 * 4) DCBFL = -1 * * We will process these backwards since 3 presupposes the rewind for 2 * which presupposes the rewind for 1. * CLNUP SSA On entry to clean up CMA,INA A = error code STA STAT,I make sure it's positive. * * First ,see if DCBFL = -1. If so, any DCBs allocated must be deallocated. * ISZ DCBFL JMP CLN0 No DCB clean up. * * Deallocation will be done by looping on each entry in the DCB pointer * table. If a DCB is pointed to by the entry (1st word of entry = -1) * the DCB is deallocated. * LDA DBDMX Use # entries in table CMA,INA as loop counter. STA CNTR * LDA DBDCP Get address of DCB STA TEMP pointer table. * * BEGIN LOOP * CLND1 LDA TEMP,I ISZ TEMP INA,SZA JMP CLND2 * JSB RETBF DEF *+2 DEF TEMP,I * SSA JMP CLND2 Ignore any errors. CLA CCB If no error, set 1st word ADB TEMP of entry to zero. STA B,I * CCA ADA DBDCT Decrement DCB count STA DBDCT * CLND2 ISZ TEMP Get next entry if there ISZ CNTR is one, and continue. JMP CLND1 * * END LOOP * * * Second, see if SAVE NE -1, and if so, see if SAVE = DBRBL. If not, * record buffer has been altered. * CLN0 LDA SAVE INA,SZA,RSS JMP CLN2 Save = -1 * LDA SAVE CPA DBRBL JMP CLN2 SAVE = DBRBL * * Record buffer has been altered. Deallocate the new one and if old * record buffer size non-zero, allocate a record buffer of old size. * JSB RETBF DEF *+2 DEF DBRBP * SSA If any error, JMP CLN3 ignore and go to point 2. * LDB SAVE If no old record buffer SZB,RSS need not reallocate one. JMP CLN1 * JSB GETBF Else, get a record buffer DEF *+4 of old size. DEF SAVE DEF DBRBP DEF ERROR * CLB If any error ignore and SSA,RSS set record buffer size LDB SAVE to zero. Else set record CLN1 STB DBRBL buffer size to old size. JMP CLN3 * * Third, see if AIRUN = 0. If not, Run Table space has been allocated. * CLN2 LDA AIRUN SZA,RSS JMP CLN4 * * Run Table allocated, deallocate it ignoring any errors. * CLN3 JSB RETBF DEF *+2 DEF AIRUN,I * * The root file has always been opened by the time we reach CLNUP, so * no check is necessary, just close it ignoring any errors and return to * user. * CLN4 JSB ECLOS DEF *+2 DEF DBDCB,I * JMP OPN28 SKP * * Constants and variables. * M8 DEC -8 M7 DEC -7 M6 DEC -6 D1 EQU ZERO+1 D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D5 EQU ZERO+5 D8 EQU ZERO+8 D15 EQU ZERO+15 D16 EQU ZERO+16 D17 EQU ZERO+17 D103 DEC 103 D115 DEC 115 D116 DEC 116 D117 DEC 117 D119 DEC 119 D128 DEC 128 D129 DEC 129 D140 DEC 140 D150 DEC 150 D153 DEC 153 D160 DEC 160 * NIBBL OCT 17 NA23 OCT 100027 LOBYT OCT 377 BLNKS ASC 1, DBCOP ASC 3,DBCOP WRITE OCT 140000 READ OCT 040000 AREAD OCT 020000 NEXCL OCT 1 IOPTN OCT 2 * DBNUM NOP FIRST NOP ITEM NOP SET NOP ADDRS NOP STCAR NOP TEMP NOP CNTR NOP FC/MD NOP NAME BSS 3 } NOTE: Do not change the order TYPE NOP } of these parameters. This SC NOP } is the 10 word array for CRN NOP } NAMR and parameters for ERROR NOP } return from DBCOP. RN NOP } NWRT NOP } NACC NOP } PATCH NOP } PROGN EQU ERROR Used for name from PNAME call. RTREC DEC 0,0 } NOTE: Do not change the order RTLEN NOP } of these parameters. FRTLN NOP } Overhead words from #DCBS NOP } root file put here. ENTLN NOP } DCBFL NOP RTPTR NOP FRTRC DEC 0,2 ALRED NOP SAVE NOP CNTR2 NOP RDTAD NOP ITMNO NOP SETNO NOP END