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