SBD TITLE 'DMSSBD (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * MODULE NAME: 00005000 * 00006000 * DMSSBD (DMSSBD - BASIC DIRECT ACCESS METHOD) 00007000 * 00008000 * FUNCTION: 00009000 * 00010000 * THE CMS BDAM MACRO ROUTINE IS USED TO ACCESS DATA SET 00011000 * RECORDS DIRECTLY BY ITEM NUMBER. IT CONVERTS RECORD 00012000 * IDENTIFICATIONS GIVEN BY OS BDAM MACROS INTO ITEM 00013000 * NUMBERS AND USES THESE ITEM NUMBERS TO ACCESS 00014000 * RECORDS. THE CMS BDAM MACRO ROUTINE SUPPORTS ALL THE 00015000 * RELEASE 20 OS BDAM MACRO FUNCTIONS EXCEPT THOSE 00016000 * LISTED AS RESTRICTIONS. 00017000 * 00018000 * ATTRIBUTES: 00019000 * 00020000 * REENTRANT, NUCLEUS RESIDENT 00021000 * 00022000 * ENTRY POINTS: 00023000 * 00024000 * DMSSBD - CALLED BY DMSSBS 00025000 * DMSSBDFR - CALLED BY DMSSVT FOR SVC 57 00026000 * 00027000 * ENTRY CONDITIONS: 00028000 * 00029000 * R1 = V(DECB) 00030000 * R2 = V(DCB) 00031000 * R11 = V(FCB) 00032000 * R14 = V(RETURN) 00033000 * R15 = V(DMSSBD) 00034000 * 00035000 * MUST BE CALLED BY BALR R14, R15 00036000 * 00037000 * EXIT CONDITIONS: 00038000 * 00039000 * IF ID, KEY, BUFFER, LIMIT, SEARCH OR I/O ERRORS 00040000 * OCCUR, THEY ARE REFLECTED IN THE DECB AND CONTROL IS 00041000 * RETURNED 00042000 * TO THE DMSSBS ROUTINE WHICH RETURNS 00043000 * CONTROL TO THE USER. THE ERROR CODES CORRESPOND TO OS 00044000 * ERROR CODES AND ARE LISTED BELOW. 00045000 * 00046000 * ERROR CODES PUT IN DECB+1 00047000 * 00048000 * NOTFOUND DC X'8000' THE RECORD WAS NOT FOUND 00049000 * IDTOBIG DC X'1010' RECORD ID WAS MORE THAN TWO BYTES 00050000 * IOERR DC X'0800' UNCORRECTABLE I/O ERROR 00051000 * BADDCB DC X'1020' DCB AND MACRO ENTRIES CONFLICT 00052000 * NOBUFFER DC X'0200' NO BUFFERS FREE 00053000 * NOSPACE DC X'2000' NO SPACE FOUND 00054000 * 00055000 * CALLS TO OTHER ROUTINES: 00056000 * 00057000 * DMSBRD, DMSFRE, DMSBWR, DMSFNS, DMSSVT 00058000 * 00059000 * EXTERNAL REFERENCES: 00060000 * 00061000 * NONE. 00062000 * 00063000 * TABLES/WORKAREAS: 00064000 * 00065000 * NONE. 00066000 * 00067000 * REGISTER USAGE: 00068000 * 00069000 * R0, R1 - WORK 00070000 * R2 - DCB 00071000 * R3 - DECB 00072000 * R8 - OPSECT DSECT 00073000 * R9 - BASE 00074000 * R11 - FCB 00075000 * R12 - KEYTABL DSECT 00076000 * R13 - SAVE AREA 00077000 * R4 - R7 - WORK 00078000 * R10, R14, R15 - WORK 00079000 * 00080000 * OPERATION: 00081000 * 00082000 * FOR RELATIVE BLOCK, RELATIVE TRACK AND ACTUAL 00083000 * ADDRESSES, THE LOW ORDER TWO BYTES OF A RECORD 00084000 * IDENTIFICATION ARE USED FOR AN ITEM NUMBER. FOR 00085000 * RELATIVE TRACK ADDRESS AND ACTUAL KEY, THE LOW ORDER 00086000 * BYTE OF THE RELATIVE TRACK ADDRESS IS USED TO ACCESS 00087000 * A TABLE OF KEYS WHICH IF NOT ALREADY IN CORE IS 00088000 * BROUGHT IN AND SEARCHED FOR THE CORRECT KEY. 00089000 * 00090000 * CMS DOES NOT SUPPORT ACTUAL KEY I/O SO THE CMS BDAM 00091000 * ROUTINE SIMULATES IT. IN CMS, ALL KEYS ARE KEPT AT 00092000 * THE END OF THEIR DATA FILE. WHEN THE DATA FILES IS 00093000 * OPENED, EITHER THE KEYS ARE ACCESSED FROM THE END OF V0016 00094000 * THE DATA FILE AS IN THE CASE OF A FIXED FILE OR A V0016 00095000 * VARIABLE FILE THAT IS ONLY BEING READ OR TWO NEW V0016 00096000 * FILES ARE CREATED WITH THE SAME V0016 00097000 * FILETYPE, BUT WITH FILENAMES OF $KEYTEMP AND 00098000 * $KEYSAVE. BOTH THESE FILES CONTAIN ALL THE KEYS IN 00099000 * THE ORIGINAL DATA FILE. $KEYTEMP IS USED FOR 00100000 * UPDATING KEYS AND $KEYSAVE IS USED TO SAVE ALL THE 00101000 * KEYS IN CASE OF A RE-IPL OR SYSTEM CRASH. FOR EVERY 00102000 * ITEM IN THE ORIGINAL FILE THERE IS A CORRESPONDING 00103000 * KEY SPACE IN THE $KEYTEMP FILE. EACH ITEM IN THE 00104000 * $KEYTEMP FILE IS A KEY TABLE THAT CONTAINS 256 KEYS. 00105000 * WHEN THE DATA FILE IS CLOSED, THE $KEYTEMP FILE IS 00106000 * WRITTEN AT THE END OF THE DATA FILE, AND THE $KEYTEMP 00107000 * AND $KEYSAVE FILES ARE ERASED. 00108000 * 00109000 * THE CMS BDAM ROUTINE GETS CONTROL FROM THE CMS BSAM 00110000 * ROUTINE WHICH IN TURN GETS CONTROL FROM AN OS READ OR 00111000 * WRITE MACRO. UPON ENTRY TO DMSSBD, A CHECK IS MADE 00112000 * TO SEE IF DYNAMIC BUFFERING IS NEEDED. IF SO, A KEY 00113000 * BUFFER AND OR DATA BUFFER IS ACQUIRED OR RETURNED 00114000 * DEPENDING ON WHETHER A READ OR WRITE IS REQUESTED. 00115000 * NEXT THE RELATIVE OR ACTUAL ADDRESS IS CHECKED TO 00116000 * MAKE SURE IT DOES NOT EXCEED TWO BYTES. THIS ADDRESS 00117000 * IS CONVERTED INTO AN ITEM NUMBER AND, IF KEYS ARE NOT 00118000 * INVOLVED, THE FEEDBACK OPTION IS TAKEN CARE OF AND 00119000 * CONTROL IS 00120000 * PASSED BACK TO DMSSBS. 00121000 * IF KEYS ARE ACCESSED AND THE KEY TABLE CONTAINING THE 00122000 * KEY WANTED IS NOT IN CORE, IT IS BROUGHT IN AND 00123000 * SEARCHED OR UPDATED. IF A SEARCH IS SPECIFIED, THE 00124000 * ITEM NUMBER OF THE KEY TABLE CONTAINING THE KEY IS 00125000 * COMBINED WITH THE POSITION NUMBER OF THE KEY IN THE 00126000 * TABLE TO FORM THE ITEM NUMBER OF THE DATA. IF THE 00127000 * EXTENDED SEARCH OPTION IS NOT SPECIFIED, ONLY ONE KEY 00128000 * TABLE OF 256 KEYS IS SEARCHED. IF THE EXTENDED 00129000 * SEARCH OPTION IS SPECIFIED, THE LIMIT PARAMETER IN 00130000 * THE DCB IS CONVERTED TO A NUMBER OF KEY TABLES AND 00131000 * THAT NUMBER OF KEY TABLES IS SEARCHED FOR A MATCHING 00132000 * KEY. AFTER THE KEY TABLE HAS BEEN READ, UPDATED OR 00133000 * SEARCHED, THE ITEM NUMBER, IF FEEDBACK 00134000 * IS REQUESTED, IS STORED IN THE CORRECT FEEDBACK 00135000 * ADDRESS AND CONTROL IS 00136000 * RETURNED TO DMSSBS. 00137000 * CORE FOR THE KEY TABLE AND ITS CONTROL PARAMETERS IS 00138000 * ACQUIRED THE FIRST TIME A KEY IS ACCESSED. THE 00139000 * ADDRESS OF THIS CORE IS STORED IN THE FCB AND THE 00140000 * CORE IS NOT FREED UP UNTIL THE DATA SET IS CLOSED. 00141000 * 00142000 * THE FORMAT OF THE DISK KEY TABLE AND THE IN-CORE KEY 00143000 * TABLE AND CONTROL WORDS IS DESCRIBED BELOW. 00144000 * 00145000 * 00146000 * KEY TABLE 00147000 * 00148000 * | KEYLENGTH | 00149000 * ----------------- 00150000 * | LST KEY | N IS 256 00151000 * ----------------- 00152000 * | 2ND KEY | 00153000 * ----------------- 00154000 * | | 00155000 * ----------------- 00156000 * | NTH KEY | 00157000 * ----------------- 00158000 * 00159000 * 00160000 * IN-CORE KEY TABLE AND CONTROL WORDS 00161000 * 00162000 * KEYTABL DSECT 00163000 * KEYLNGTH DS 1F KEY LENGTH 00164000 * ENDDATA DS 1F LAST DATA ITEM IN FILE 00165000 * KEYOP DS 2F COMMAND NAME 00166000 * KEYNAME DS 2F FILENAME OF KEY FILE 00167000 * KEYTYPE DS 2F FILETYPE OF KEY FILE 00168000 * KEYMODE DS 1H FILEMODE OF KEY FILE 00169000 * KEYTBLNO DS 1H ITEM NUMBER OF KEY TABLE 00170000 * KEYTBLAD DC A(KEYTABLE) ADDRESS OF KEY TABLE 00171000 * TBLLNGTH DS 1F BYTE SIZE OF KEY TABLE 00172000 * KEYFORM DC C'F' FORMAT OF KEY TABLE 00173000 * KEYCHNG DC X'00' BYTE TO SIGNIFY CHANGE IN KEY TBL 00174000 * KEYCOUT DC X'0001' NUMBER OF TABLES PER ITEM 00175000 * DS IF USED BY RDBUF FOR RESIDUAL COUNTS 00176000 * KEYTABLE DS 0F TABLE OF KEYS 00177000 * 00178000 * 00179000 * RESTRICTIONS 00180000 * 00181000 * THE FOUR METHODS OF ACCESSING BDAM RECORDS ARE: 00182000 * 00183000 * 1. RELATIVE BLOCK RRR 00184000 * -- 00185000 * 2. RELATIVE TRACK TTR 00186000 * -- 00187000 * 3. RELATIVE TRACK AND KEY TT KEY 00188000 * - - 00189000 * 4. ACTUAL ADDRESS MBBCCHHR 00190000 * -- 00191000 * 00192000 * THE RESTRICTIONS ON THESE METHODS ARE: 00193000 * 00194000 * 00195000 * . BDAM SPANNED RECORDS ARE NOT SUPPORTED IN CMS. 00196000 * 00197000 * . THE R AND RU OPTIONS OF READ AND WRITE (ADDED 00198000 * IN OS RELEASE 19) ARE NOT SUPPORTED. 00199000 * 00200000 * . SINCE CMS FILES ONLY HAVE A TWO-BYTE RECORD 00201000 * IDENTIFIER, ONLY THE BDAM IDENTIFIERS 00202000 * UNDERLINED ABOVE CAN BE USED TO REFERENCE 00203000 * RECORDS. 00204000 * 00205000 * . CMS BDAM FILES ARE ALWAYS CREATED WITH 255 00206000 * RECORDS ON THE 1ST LOGICAL TRACK AND 256 RECORDS 00207000 * ON ALL OTHER LOGICAL TRACKS REGUARDLESS OF THE 00208000 * BLOCKSIZE. IF BDAM METHODS 2, 3 OR 4 ARE USED 00209000 * AND THE RECFM IS U OR V, THE BDAM USER MUST EITHER 00210000 * WRITE 255 RECORDS ON THE 1ST TRACK AND 256 00211000 * RECORDS ON EVERY TRACK THEREAFTER OR HE MUST NOT 00212000 * UPDATE THE TRACK INDICATOR UNTIL A NO SPACE 00213000 * FOUND MESSAGE IS RETURNED ON A WRITE. FOR 00214000 * METHOD 3 (WRITE ADD), THIS IS WHEN NO MORE 00215000 * DUMMY RECORDS CAN BE FOUND ON A WRITE 00216000 * REQUEST. FOR METHODS 2 AND 4, THIS WILL NOT 00217000 * OCCUR, AND THE TRACK INDICATOR WILL ONLY BE 00218000 * UPDATED WHEN THE RECORD INDICATOR REACHES 256 00219000 * AND OVERFLOWS INTO THE TRACK INDICATOR. 00220000 * 00221000 * . TWO FILES WITH KEYS AND THE SAME FILETYPE 00222000 * CANNOT BE OPEN AT THE SAME TIME. IF A 00223000 * PROGRAM THAT IS UPDATING KEYS DOES NOT CLOSE 00224000 * THE FILE IT IS UPDATING FOR SOME REASON, 00225000 * E.G., A SYSTEM CRASH OR A RE-IPL, THE 00226000 * ORIGINAL KEYS FOR A VARIABLE OR UNDEFINED DATA V0016 00227000 * FILE WILL BE IN A TEMPORARY FILE V0016 00228000 * WITH THE SAME FILETYPE AND A FILENAME OF 00229000 * $KEYSAVE. THE KEYS FOR A FIXED DATA FILE WILL BE V0016 00230000 * INTACT AT THE END OF THE DATA FILE. TO FINISH THEV0016 00231000 * UPDATE, RUN THE UPDATE PROGRAM AGAIN. V0016 00232000 * 00233000 * . ONCE A FILE IS CREATED USING KEYS, THE FILE 00234000 * MUST NOT BE ADDED TO WITHOUT USING KEYS AND 00235000 * SPECIFYING THE ORIGINAL KEY LENGTH. 00236000 * 00237000 * . THE MINIMUM DCBLRECL FOR A CMS BDAM FILE WITH KEYV0016 00238000 * IS 8 BYTES. V0016 00239000 * 00240000 *. 00241000 EJECT 00242000 * 00243000 DMSSBD CSECT 00244000 ENTRY DMSSBDFR 00245000 SPACE 00246000 * DCB FLAGS 00247000 EXTSRCH EQU X'20' 00248000 ACTADD EQU X'08' 00249000 RELBLK EQU X'01' 00250000 * BSAM DECB FLAGS 00251000 WRSDSZ EQU X'14' DUMMY AND CAPACITY SWITCH P3056 00252000 BSAMREAD EQU X'80' BSAM READ INDICATOR P3040 00253000 * BDAM DECB FLAGS 00254000 FDBK EQU X'10' 00255000 DYNBUF EQU X'04' 00256000 SKEY EQU X'80' 00257000 SBLKLN EQU X'40' 00258000 RDSW EQU X'08' 00259000 KEYSW EQU X'04' 00260000 WRADD EQU X'02' 00261000 ******************************************************************* 00262000 * 00263000 * UPON ENTRY 00264000 * R14 = V(RETURN) 00265000 * R15 = V(BDAM) 00266000 * R1 = V(DECB) 00267000 * R2 = V(DCB) 00268000 * R11 = V(FCB) 00269000 * 00270000 ******************************************************************* 00271000 SPACE 2 00272000 USING IHADCB,R2 00273000 USING IHADECB,R3 00274000 USING OPSECT,R8 00275000 USING DMSSBD,R9 00276000 USING FCBSECT,R11 00277000 USING KEYSECT,R12 00278000 * 00279000 * SETUP DECB AND CONVERT RECORD IDENTIFIER TO AN ITEM NO. 00280000 * 00281000 LR R9,R15 GET BDAM BASE 00282000 LR R3,R1 GET DECB BASE 00283000 L R12,FCBKEYS GET ADDR OF KEY DSECT P3056 00284000 SR R7,R7 00285000 TM DCBDSORG,PS PHYSICAL SEQUENTIAL? 00286000 BO GETKEYS YES, BYPASS FLAG CHECKING 00287000 TM DECTYPE+1,SBLKLN IS LENGTH SPECIFIED 00288000 BNO CKDYNBUF YES, CHECK FOR BUFFERRING 00289000 MVC DECLNGTH(2),DCBBLKSI NO, GET LENGTH FROM DCB 00290000 CKDYNBUF TM DECTYPE,DYNBUF IS DYNAMIC BUFFERRING OPTION ON 00291000 BO GETBUF YES, GO HANDLE BUFFERS 00292000 RDITEMNO L R10,DECRECPT GET RECORD IDENTIFIER 00293000 ST R7,FCBOP 00294000 TM DCBOPTCD,ACTADD IS ACTUAL ADDRESSING SPECIFIED 00295000 BNO CKKEYSW NO, CHECK KEY SWITCH 00296000 MVC FCBOP(4),4(R10) YES, GET ACTUAL ADDRESS 00297000 B CKITEMNO 00298000 CKKEYSW TM DECTYPE+1,KEYSW IS SEARCH KEY SWITCH ON 00299000 BNO RELADD NO, GET RELATIVE ADDRESS 00300000 MVC FCBOP+1(2),0(R10) YES, GET RELATIVE TRACK 00301000 B CKITEMNO 00302000 RELADD MVC FCBOP+1(3),0(R10) GET RELATIVE ADDRESS 00303000 CKITEMNO EQU * V0310 00304000 L R5,FCBOP NO, LOAD IDENTIFIER 00305000 LA R5,1(R5) ADD ONE TO RELATIVE NO. 00306000 LTR R5,R5 IS RESULT ZERO? @VA09009 00306300 BZ IDERR YES, DISPLAY ERROR MSG @VA09009 00306600 STH R5,FCBITEM SET ITEM NO. P3056 00307000 LH R4,FCBXTENT GET EXTENT LIMIT P3056 00308000 N R4,HALFWORD ALLIGN FOR COMPARE P3056 00309000 CR R5,R4 IS ITEM NO. IN XTENT P3056 00310000 BNH CKKYADR YES, CONTINUE V0310 00311000 TM DECTYPE+1,KEYSW KEY SEARCH? V0310 00312000 BO SRCHERR YES, GIVE NOT FOUND ERR V0310 00313000 B IDERR NO, GIVE TO LARGE ID ERR V0310 00314000 CKKYADR EQU * V0310 00315000 C R7,DECKYADR ARE KEYS INVOLVED? 00316000 BE RDWRITEM NO, RETURN TO BSAM 00317000 CLI DCBKEYLE,X'00' DO DCB AND DECB AGREE? 00318000 BE RDWRITEM NO, GO TO READ WRITE RTN 00319000 TM DECTYPE+1,RDSW IS THIS A READ V0016 00320000 BNO GETKEYS NO, CONTINUE V0016 00321000 OI IOBIOFLG,IOBIN SET INPUT FLAG V0016 00322000 GETKEYS LTR R12,R12 IS KEY TABLE IN CORE V0016 00323000 BZ CALLSAVE NO GET A KEY TABLE V0016 00324000 TM IOBIOFLG,IOBIN IS INPUT SPECIFIED V0016 00325000 BO GETTBLNO YES, THEN GET CURRENT TBL V0016 00326000 TM DCBRECFM,VAR RECFORM= FIXED V0016 00327000 BNO GETTBLNO YES, CONTINUE V0016 00328000 CLC KEYNAME(8),=CL8'$KEYTEMP' IS THIS A TEMP FILE V0016 00329000 BE GETTBLNO YES, CONTINUE V0016 00330000 CALLSAVE LA R0,4 CREATE OR SAVE KEY FILE V0016 00331000 SVC 203 CALL KEYSAVE 00332000 DC H'-3' SVC 203 ENTRY IN DMSSVT 00333000 STH R5,FCBITEM RESTORE ITEM NO. 00334000 MVC FCBBYTE+2(2),DCBBLKSI RESTORE FCBBYTE 00335000 LTR R15,R15 WAS KEYSAV SUCCESSFULL 00336000 BNZ WRERRRTN NO, RETURN WITH ERROR CODE 00337000 L R12,FCBKEYS GET DSECT ADDR 00338000 GETTBLNO SR R4,R4 ZERO REG 4 00339000 LA R6,256 GET NO. KEYS IN TABLE 00340000 DR R4,R6 GET NEW TABLE NO. 00341000 LA R5,1(R5) 00342000 L R6,KEYLNGTH GET KEY LENGTH 00343000 BCTR R6,R0 SET LENGTH FOR MVC OR CLC 00344000 L R10,DECKYADR GET KEY ADDRESS 00345000 SR R15,R15 CLEAR REGISTER 15 P3040 00346000 LA R1,KEYOP SETUP ADDR OF KEYS PLIST P3040 00347000 CH R5,KEYTBLNO IS NEW TABLE IN CORE 00348000 BNE SAVEKEYS NO, GO GET IT 00349000 * 00350000 * SETUP TO READ OR WRITE KEY 00351000 * 00352000 SRCHKEYS TM DCBDSORG,PS PHYSICAL SEQUENTIAL? 00353000 BO PSKEY YES, GO TO PS CHECKS 00354000 TM DECTYPE+1,KEYSW IS SEARCH KEY SWITCH ON 00355000 BO FINDKEY YES, GO SEARCH FOR KEY 00356000 TM DECTYPE+1,WRADD IS SEARCH FOR DUMMY SWITCH ON 00357000 BO FINDDUMY YES, GO SEARCH FOR DUMMY 00358000 MH R4,KEYLNGTH+2 GET ADDRESS OF 00359000 A R4,KEYTBLAD KEY TO BE CHANGED 00360000 TM DECTYPE+1,RDSW IS THIS A READ 00361000 BNO MOVEKEY NO, GO WRITE KEY 00362000 EX R6,RDMOVE YES, READ KEY 00363000 B RDWRITEM RETURN TO BSAM 00364000 SPACE 2 00365000 PSKEY MH R4,KEYLNGTH+2 GET ADDRESS OF KEY 00366000 A R4,KEYTBLAD TO BE CHANGED 00367000 L R10,DECAREA GET ADDR OF USER KEY AREA P3040 00368000 TM DECTYPE+1,BSAMREAD IS THIS A BSAM READ P3040 00369000 BNO SETCHNG NO, THEN SET KEY CHNG BIT P3040 00370000 EX R6,RDMOVE MOVE KEY TO USER AREA P3040 00371000 B BDAMRTRN RETURN TO BSAM P3040 00372000 SETCHNG MVI KEYCHNG,2 SET CHANGE BYTE P3040 00373000 TM DECTYPE+1,WRSDSZ DUMMY OR CAPACITY SWITCH P3056 00374000 BM WRDUMMY YES, THEN WRITE DUMMY KEYS P3056 00375000 CLI 0(R10),X'FF' IS KEY A DUMMY KEY 00376000 BE PSERR YES, GO TO ERROR RTN 00377000 WRDUMMY EX R6,WRMOVE SET NEW KEY V0300 00378000 B BDAMRTRN RETURN TO BSAM 00379000 SPACE 2 00380000 * 00381000 * SEARCH KEY TABLES FOR A MATCHING KEY 00382000 * 00383000 FINDDUMY TM DCBRECFM,VAR RECFM VARIABLE V0300 00384000 BNO GETDUMY NO, FIND KEY V0300 00385000 L R10,KEYTBLAD GET ADDR OF KEY TABLE V0300 00386000 A R10,TBLLNGTH GET ADDR OF END OF TABLE V0300 00387000 EX R6,CLRKEY CLEAR DUMMY KEY V0300 00388000 B FINDKEY GO FIND DUMMY KEY V0300 00389000 GETDUMY SR R6,R6 SET COMPARE LENGTH TO 1 V0300 00390000 LA R10,DUMMY FOR DUMMY KEY 00391000 FINDKEY LA R5,256 GET NO. OF KEYS IN TABLE 00392000 L R4,KEYTBLAD GET KEY TABLE ADDRESS P3056 00393000 LTR R15,R15 RETURN CODE= 0 P3056 00394000 BZ CKNEXT YES, THEN CONTINUE SEARCH P3056 00395000 CH R15,=XL2'000C' ERROR= END OF FILE? P3056 00396000 BNE SRCHERR NO, THEN KEY NOT FOUND ERR P3056 00397000 SR R4,R4 ZERO LIMIT REG P3056 00398000 IC R4,FCBITEM GET NO. AT START OF SEARCH P3056 00399000 LTR R4,R4 TABLE ONE SEARCHED? P3056 00400000 BZ SRCHERR YES, THEN KEY NOT FOUND P3056 00401000 LA R5,1 SET TBL NO AT 1 P3056 00402000 CLR R7,R4 LIMIT < NO. TABLES LEFT V0300 00403000 BL SAVEKEYS NO, CONTINUE V0300 00404000 LR R7,R4 LIMIT= NO. TABLES LEFT P3056 00405000 B SAVEKEYS CONTINUE SEARCH V0300 00406000 CKNEXT EX R6,COMPARE IS THIS THE KEY WE WANT 00407000 BE KEYFOUND YES, GO TO FIND RTN 00408000 A R4,KEYLNGTH NO, CONTINUE SEARCH 00409000 BCT R5,CKNEXT CHECK NEXT KEY 00410000 LTR R7,R7 IS THIS FIRST TABLE SEARCHED? 00411000 BNZ SRCHON NO, GET NEXT TABLE 00412000 LA R7,1 GET NO. OF TABLES FOR SEARCH 00413000 CKEXTSRC TM DCBOPTCD,EXTSRCH IS EXTRA SEARCH OPTION ON 00414000 BO EXTRSRCH YES, GET SEARCH LIMIT 00415000 SRCHON LH R5,KEYTBLNO UPDATE ITEM NO. 00416000 LA R5,1(R5) 00417000 BCT R7,SAVEKEYS GET NEXT KEY TABLE V0300 00418000 B SRCHERR GO TO KEY NOT FOUND RTN 00419000 SPACE 2 00420000 * 00421000 * DETERMINE NO. OF TABLES TO BE SEARCHED 00422000 * 00423000 EXTRSRCH CLC DCBLIMCT(3),=AL3(1) IS LIMIT SPECIFIED P3056 00424000 BNH KEYERR NO, GO TO ERROR RTN P3056 00425000 TM DCBOPTCD,RELBLK IS LIMIT IN BLOCKS 00426000 BO EXTRBLKS YES, GO CONVERT TO TABLES 00427000 MH R7,DCBLIMCT+1 CONVERT TRACKS TO TABLES 00428000 B SRCHON CONTINUE SEARCH 00429000 EXTRBLKS L R4,DCBLIMCT-1 CONVERT NUMBER OF 00430000 SLL R4,8 BLOCKS TO 00431000 SRL R4,16 NUMBERS TBLS FOR SEARCH V0300 00432000 AR R7,R4 TO BE SEARCHED 00433000 B SRCHON CONTINUE SEARCH 00434000 SPACE 2 00435000 * 00436000 * DETERMINE ITEM NO. FROM POSITION IN TABLE 00437000 * 00438000 KEYFOUND LR R6,R4 COMPUTE ITEM 00439000 S R6,KEYTBLAD NUMBER OF DATA 00440000 SRDL R6,32 FROM POSITION 00441000 D R6,KEYLNGTH OF KEY IN TABLE 00442000 LH R6,KEYTBLNO AND TABLE NUMBER 00443000 BCTR R6,R0 00444000 SLL R6,8 SET TRACK INDICATOR P3056 00445000 AR R6,R7 00446000 STH R6,FCBITEM STORE ITEM NUMBER IN FCB 00447000 TM DECTYPE+1,RDSW IS THIS A READ 00448000 BO RDWRITEM YES, RETURN TO BSAM 00449000 L R6,KEYLNGTH GET KEY LENGTH 00450000 BCTR R6,R0 DECREMENT LENGTH BY ONE 00451000 L R10,DECKYADR GET ADDRESS OF NEW KEY 00452000 SPACE 2 00453000 * 00454000 * SETUP FOR RETURN TO DMSSBS 00455000 * 00456000 MOVEKEY EX R6,WRMOVE WRITE NEW KEY 00457000 MVI KEYCHNG,X'01' SET CHANGE BYTE 00458000 RDWRITEM TM DECTYPE,FDBK IS FEEDBACK OPTION ON 00459000 BO FEEDBACK YES, HANDLE FEEDBACK 00460000 BDAMRTRN LR R1,R3 RESTORE DECB BASE 00461000 L R3,BSAMBASE RESTORE BSAM BASE 00462000 LTR R12,R12 IS IT ZERO 00463000 BCR 8,R14 YES, THEN RETURN 00464000 LH R5,FCBITEM GET ITEM NO. P3056 00465000 N R5,HALFWORD CLEAR FIRST HALF P3056 00466000 LH R15,FCBXTENT GET XTENT V0016 00467000 N R15,HALFWORD CLEAR 1ST HALF V0016 00468000 CR R5,R15 ITEM NO. > XTENT V0016 00469000 BNH CKKEYPTR NO, CONTINUE V0016 00470000 LR R3,R1 RESTORE DECB BASE V0016 00471000 B IDERR RETURN ERROR V0016 00472000 CKKEYPTR C R5,DATAEND SHOULD KEY PTR BE HIGHER V0016 00473000 BCR 13,R14 BNH... NO, RETURN 00474000 MVC DATAEND+2(2),FCBITEM YES, RESET DATAEND 00475000 BR R14 RETURN TO BSAM OR USER 00476000 FEEDBACK L R10,DECRECPT GET ADDR OF RECORD POINTER V0206 00477000 LH R5,FCBITEM GET ITEM NO. 00478000 N R5,HALFWORD ZERO FIRST HALF 00479000 BCTR R5,R0 SUBTRACT ONE 00480000 STH R5,FCBOP ALLIGN FOR MOVE 00481000 XC 0(4,R10),0(R10) CLEAR FEEDBACK AREA V0206 00482000 MVC 1(2,R10),FCBOP SET RELATIVE ADDRESS V0206 00483000 TM DCBOPTCD,ACTADD ACTUAL ADDRESS SPECIFIED V0206 00484000 BZ BDAMRTRN NO, RETURN TO CALLER V0206 00485000 FEEDACTL MVC 6(2,R10),FCBOP RETURN ACTUAL ADDR V0206 00486000 XC 0(6,R10),0(R10) CLEAR 1ST PART OF ADDRESS V0206 00487000 B BDAMRTRN RETURN TO BSAM 00488000 * 00489000 * READ AND WRITE KEYTABLES 00490000 * 00491000 SAVEKEYS CLI KEYCHNG,0 IS CHANGE BYTE ON? P3040 00492000 BE READKEYS NO, BYPASS WRITE 00493000 CLC KEYNAME(8),=CL8'$KEYTEMP' IS THIS A TEMP FILE V0300 00494000 BNE RDFXDKEY NO, GET NO. OF TABLE V0300 00495000 TM DCBRECFM,VAR RECFM= VAR OR UND V0300 00496000 BNO RDFXDKEY NO, GET REAL KEY ITEM NO. V0300 00497000 CALLWRIT MVC KEYOP(8),=CL8'FINIS' FINIS FILE V0300 00498000 SVC X'CA' V0300 00499000 DC AL4(*+4) 00500000 MVC KEYOP(8),=CL8'WRBUF' YES, WRITE OUT 00501000 SVC X'CA' V0300 00502000 DC AL4(WRERRRTN) 00503000 DOFINIS MVC KEYOP(8),FINIS FINIS KEY FILE 00504000 SVC X'CA' 00505000 DC AL4(*+4) 00506000 MVI KEYCHNG,X'00' RESET CHANGE BYTE 00507000 READKEYS MVC KEYOP(8),=CL8'RDBUF' READ NEW 00508000 NEWKYTBL STH R5,KEYTBLNO KEY TABLE IN 00509000 CLC KEYNAME(8),=CL8'$KEYTEMP' IS THIS A TEMP FILE V0016 00510000 BNE RDFXDKEY NO. GET ITEM NO. V0300 00511000 TM DCBRECFM,VAR RECFM= VAR OR UND V0300 00512000 BO CALLREAD YES, CONTINUE V0300 00513000 RDFXDKEY LH R15,KEYTBLNO GET NO. OF KEY TABLE V0016 00514000 BCTR R15,R0 SET FOR MULTIPLY V0016 00515000 MH R15,KEYCOUT GET RELATIVE ITEM NO. V0016 00516000 A R15,DATAEND GET REAL ITEM NO. V0016 00517000 STH R15,KEYTBLNO SET REAL ITEM NO. V0016 00518000 CLI KEYCHNG,0 IS THIS A WRITE V0016 00519000 BNE CALLWRIT YES, ISSUE WRITE V0016 00520000 CALLREAD MVC SEBSAV(1),37(R1) RETAIN INDICATOR @VA03023 00521000 SVC X'CA' READ IN TABLE @VA03023 00522000 DC AL4(RDERRRTN) V0016 00523000 MVC 37(1,R1),SEBSAV RESTORE INDICATOR @VA03023 00524000 READOK STH R5,KEYTBLNO SET KEY TABLE NO. V0016 00525000 B SRCHKEYS CONTINUE KEY SEARCH 00526000 SPACE 2 00527000 * 00528000 * GET AND RELEASE BDAM BUFFERS 00529000 * 00530000 GETBUF TM DECTYPE+1,RDSW IS THIS A READ 00531000 BNO RDITEMNO NO, CONTINUE @VA03006 00532000 L R5,DCBBUFCB YES GET ADDRESS 00533000 L R6,0(R5) OF BUFFER 00534000 LTR R6,R6 ARE ALL BUFFERS TAKEN 00535000 BZ BUFFERR YES, GO TO ERROR RTN 00536000 MVC 0(4,R5),0(R6) NO, GET BUFFER 00537000 TM DECTYPE+1,SKEY IS KEY PART OF BUFFER 00538000 BNO AREAADD NO, SET DECB DATA ADDRESS 00539000 ST R6,DECKYADR YES, SET DECB KEY ADDRESS 00540000 IC R7,DCBKEYLE GET DECB 00541000 AR R6,R7 DATA ADDRESS 00542000 SR R7,R7 00543000 AREAADD ST R6,DECAREA SET DECB DATA ADDRESS 00544000 B RDITEMNO GO COMPUTE ITEM NO. 00545000 RETRNBUF LA R4,RDITEMNO SET DMSSBDFR RETURN ADDRESS 00546000 BALR R15,R0 00547000 DROP R9 00548000 USING *,R15 00549000 DMSSBDFR TM DECTYPE,DYNBUF DYNAMIC BUFFERING? @VA03006 00550000 BNO NOBUF NO, RETURN @VA03006 00551000 L R6,DECAREA GET DATA ADDRESS @VA03006 00552000 L R5,DCBBUFCB GET BUFFER CONTROL BLOCK ADDR 00553000 TM DECTYPE+1,SKEY IS KEY PART OF DATA 00554000 BNO SETUPCB NO, RETURN BUFFER 00555000 IC R7,DCBKEYLE YES, GET DECB 00556000 SR R6,R7 DATA ADDRESS 00557000 SR R7,R7 00558000 SETUPCB MVC 0(4,R6),0(R5) RETURN BUFFER TO 00559000 ST R6,0(R5) BUFFER CONTROL BLOCK 00560000 NOBUF BR R4 RETURN TO CALLER @VA03006 00561000 DROP R15 00562000 USING DMSSBD,R9 00563000 SPACE 2 00564000 * 00565000 * CHECK BDAM ERRORS AND SET ERROR CODES 00566000 * 00567000 RDERRRTN MVC 37(1,R1),SEBSAV RESTORE INDICATOR @VA03023 00568000 CH R15,=XL2'000C' IS THIS EOF @VA03023 00569000 BE EOFERR YES, CLEAR KEY TABLE P3056 00570000 CH R15,=H'8' LENGTH ERROR V0016 00571000 BE READOK YES, THEN IGNORE V0016 00572000 CH R15,=H'1' IS THIS AN EOF ERROR V0016 00573000 BE EOFERR YES, CLEAR KEY TABLE P3056 00574000 CH R15,=H'9' IS A FINIS NEEDED 00575000 BE DOFINIS YES, FINIS FILE 00576000 WRERRRTN TM DCBDSORG,PS IS THIS PS DATA SET 00577000 BO PSERR YES, GO TO PS ERROR RTN 00578000 LA R7,IOERR GET IO ERROR CODE 00579000 B ERRRTRN GO FILL IN DECB 00580000 IDERR LA R7,IDTOBIG GET ID TO BIG ERROR CODE 00581000 TM DCBDSORG,PS ACCESS METHOD= SEQUENTIAL V0206 00582000 BNO ERRRTRN NO, RETURN BDAM ERROR CODE V0206 00583000 MVI DECSDECB+3,12 RETURN EOF CODE V0206 00584000 MVI DECSDECB,X'42' INDICATE BSAM ERROR V0206 00585000 B USERRTRN RETURN TO CALLER V0206 00586000 KEYERR LA R7,BADDCB GET BAD DCB ERROR CODE 00587000 B ERRRTRN GO FILL IN DECB 00588000 SRCHERR EQU * @VA05072 00589000 CLI FCBRECFM,VAR IS THIS A VARIABLE RECORD? @VA05072 00590000 BE SPACEERR YES DIFFERENT ERROR @VA05072 00591000 LA R7,NOTFOUND GET KEY NOT FOUND ERROR CODE @VA06252 00592000 CLC 0(2,R10),DUMMY IS THIS A WRITE ADD 00593000 BNE ERRRTRN NO, CONTINUE 00594000 SPACEERR LA R7,NOSPACE YES, THEN SET NO SPACE ERR 00595000 B ERRRTRN GO FILL IN DECB 00596000 BUFFERR LA R7,NOBUFFER GET NO BUFFER ERROR CODE 00597000 ERRRTRN MVI DECSDECB,X'40' FILL IN DECB 00598000 MVC DECSDECB+1(2),0(R7) WITH SELECTED ERROR CODE 00599000 SETERR MVI DECSDECB+3,X'FF' FILL IN ERROR CODE 00600000 USERRTRN L R14,=V(DMSSBSRT) RETURN TO THE USER 00601000 SR R12,R12 DON'T CHECK FOR END OF XTENV0016 00602000 B BDAMRTRN GO TO COMMON RETURN 00603000 PSERR MVI DECSDECB,X'42' FILL IN ECB 00604000 B SETERR RETURN TO CALLER 00605000 EOFERR L R0,KEYLNGTH GET NO. OF 256 BYTE TBLS V0016 00606000 L R1,KEYTBLAD GET KEY TBL ADDR P3056 00607000 CLRLOOP XC 0(256,R1),0(R1) CLEAR A BLOCK P3056 00608000 LA R1,256(,R1) GET ADDR OF NEXT BLK P3056 00609000 BCT R0,CLRLOOP CLEAR NEXT BLK P3056 00610000 LA R1,KEYOP GET ADDRESS OF KEY PLIST P3056 00611000 B READOK CONTINUE KEY HANDLING V0016 00612000 SPACE 2 00613000 BSAMBASE DC V(DMSSBS) BSAM BASE REG 00614000 WRMOVE DS 0H 00615000 MVC 0(0,R4),0(R10) WRITE KEY 00616000 COMPARE CLC 0(0,R4),0(R10) COMPARE KEYS 00617000 RDMOVE MVC 0(0,R10),0(R4) READ KEY 00618000 CLRKEY XC 0(0,R10),0(R10) CLEAR KEY V0300 00619000 DUMMY DC X'FF00' DUMMY KEY 00620000 NOTFOUND DC X'8000' 00621000 IDTOBIG DC X'1010' ERROR 00622000 IOERR DC X'0800' 00623000 BADDCB DC X'1020' CODES 00624000 NOSPACE DC X'2000' 00625000 NOBUFFER DC X'0200' 00626000 HALFWORD DC F'65535' 00627000 FINIS DC CL8'FINIS' 00628000 LTORG 00629000 SPACE 2 00630000 KEYSECT 00631000 EJECT 00632000 DCBD DSORG=(DA) 00633000 EJECT 00634000 CMSCB 00635000 EJECT 00636000 IO 00637000 EJECT 00638000 REGEQU 00639000 END 00640000