VIP TITLE 'DMSVIP (CMS) VM/370 - RELEASE 6' 00001000
*********************************************************************** 00002000
* * 00003000
* * 00004000
* MODULE NAME: * 00005000
* * 00006000
* DMSVIP - CMS VSAM INTERFACE PROCESSOR * 00007000
* * 00008000
* * 00009000
* FUNCTION: * 00010000
* * 00011000
* DMSVIP PERFORMS THE FOLLOWING: * 00012000
* * 00013000
* 1. LOADS THE DOS DCSS (VSAM OPTION SPECIFIED). * 00014000
* * 00015000
* 2. ISSUES ALL NECESSARY DOS ASSGN COMMANDS FOR THE OS * 00016000
* USER. * 00017000
* * 00018000
* 3. MAPS ALL OS VSAM MACRO REQUESTS TO DOS SPECIFICATIONS * 00019000
* (INCLUDING MODIFICATION OF VSAM CONTROL BLOCKS AND * 00020000
* USER PARAMETER LISTS). * 00021000
* * 00022000
* 4. PERFORMS SIMULATION FOR OS ASYNCHRONOUS VSAM DATA * 00023000
* MANAGEMENT REQUESTS. * 00024000
* * 00025000
* 5. MAPS DOS VSAM MACRO RETURN CODES AND ERROR CODES TO OS * 00026000
* EQUIVALENTS WHERE NECESSARY. * 00027000
* * 00028000
* 6. TRAPS ALL TRANSFERS OF CONTROL BETWEEN VSAM AND THE OS * 00029000
* USER AND SETS THE APPROPRIATE OPERATING ENVIRONMENT FLAGS.* 00030000
* * 00031000
* * 00032000
* ATTRIBUTES: * 00033000
* * 00034000
* EXECUTES IN CMS VSAM DCSS, REENTRANT * 00035000
* * 00036000
* ENTRY POINTS: * 00037000
* * 00038000
* DMSVIP - OPEN, CLOSE, TCLOSE, GENCB, MODCB, SHOWCB, AND * 00039000
* TESTCB MACROS * 00040000
* * 00041000
* CALLERS - DMSVIB (FIRST CALL) * 00042000
* - DMSSOP (OPEN, CLOSE, TCLOSE) * 00043000
* - USER PROGRAM (OTHER) * 00044000
* * 00045000
* * 00046000
* DMSVIP2 - GET, PUT, POINT, ENDREQ, ERASE, CHECK MACROS * 00047000
* * 00048000
* DMSVIP3 - VSAM BRANCHES TO USER EXIT ROUTINES * 00049000
* * 00050000
* DMSVIP4 - VSAM BRANCHES TO USER ERET ROUTINES (TESTCB) * 00051000
* * 00052000
* * 00053000
* ENTRY CONDITIONS: * 00054000
* * 00055000
* ENTERED VIA BALR R14,R15. * 00056000
* * 00057000
* DEPENDING ON THE TYPE OF REQUEST, R0 AND R1 CONTAIN BOTH * 00058000
* CODES AND/OR POINTERS TO PARAMETER LISTS. SEE THE OPEN * 00059000
* PROCESSING ROUTINE FOR SPECIAL LINKAGE WITH DMSSOP. * 00060000
* * 00061000
* DOS VSAM ENTERS THE INTERFACE EITHER ON RETURN FROM A * 00062000
* DOS MACRO REQUEST OR ON A BRANCH TO A USER-SPECIFIED ERROR * 00063000
* HANDLING (EXIT) ROUTINE. * 00064000
* * 00065000
* EXIT CONDITIONS: * 00066000
* * 00067000
* NORMAL: * 00068000
* * 00069000
* CONTROL IS RETURNED TO THE CALLER. ALL VSAM CONTROL * 00070000
* BLOCKS, RETURN CODES, AND REGISTERS ARE SET TO REFLECT * 00071000
* NORMAL VSAM PROCESSING. * 00072000
* * 00073000
* ERROR: * 00074000
* * 00075000
* DMSVIP ISSUES A CMS ABEND WHEN UNABLE TO CONTINUE. * 00076000
* THE FOLLOWING ARE THE ABEND CODES AND THEIR MEANING: * 00077000
* * 00078000
* HEX CODE DESCRIPTION * 00079000
* * 00080000
* 34 ERROR DURING DATA MANAGEMENT MACRO- * 00081000
* INTERNAL ERROR OCCURRED IN DOS VSAM * 00082000
* ROUTINE * 00083000
* * 00084000
* 38 ERROR DURING DATA MANAGEMENT MACRO- * 00085000
* I/O ERROR ENCOUNTERED DURING * 00086000
* CATALOG ACCESS * 00087000
* * 00088000
* 177 DMSVIP UNABLE TO CONTINUE- * 00089000
* SEE ADDITIONAL ERROR MESSAGE * 00090000
* ACCOMPANYING ABEND MESSAGE: * 00091000
* * 00092000
* 109S - 'VIRTUAL STORAGE CAPACITY * 00093000
* EXCEEDED' * 00094000
* * 00095000
* 230E - 'NO. OF VSAM EXIT ROUTINES * 00096000
* HAS EXCEEDED MAX OF 128' * 00097000
* * 00098000
* IF CMS/DOS DETECTS AN ERROR DURING AN ASSGN FOR THE OS * 00099000
* USER, OR DURING OPEN, CLOSE, OR TCLOSE REQUESTS, THE * 00100000
* JOB IS TERMINATED AND CONTROL IS RETURNED TO CMS. * 00101000
* * 00102000
* * 00103000
* FOR DOS OPEN ERROR CODE X'22' (VOL SER NOS * 00104000
* SPECIFIED IN THE EXTENT STMNT DO NOT MATCH * 00105000
* THOSE IN THE CATALOG) - THE JOB IS TERMINATED * 00106000
* AND CONTROL IS RETURNED TO CMS WITH THE VSAM * 00107000
* RETURN CODE OF X'08'. * 00108000
* * 00109000
* * 00110000
* CALLS TO OTHER ROUTINES: * 00111000
* * 00112000
* IKQGEN, IKQVSM, IKQTMS, $$BOPEN, $$BCLOSE * 00113000
* * 00114000
* EXTERNAL REFERENCES: * 00115000
* * 00116000
* DMSKEY - FOR CORRECT PROTECT KEY (SEE NOTES) * 00117000
* DMSERR - FOR CMS ERROR MESSAGES * 00118000
* DMSFREE - FOR NUCLEUS FREE STORAGE * 00119000
* DMSFRET - FOR RELEASE OF FREE STORAGE * 00120000
* DMSABN - FOR ABNORMAL TERMINATION OF RUN * 00121000
* REGEQU - FOR SYMBOLIC REGISTER NAMES * 00122000
* NUCON - FOR NUCLEUS STORAGE AREA DSECT * 00123000
* CMSAVE - FOR SYSTEM SAVE AREA DSECT * 00124000
* DOSCB - FOR DOS SIMULATION CONTROL BLOCK DSECT * 00125000
* IKQACB - FOR DOS VSAM ACB DSECT * 00126000
* IKQRPL - FOR DOS VSAM RPL DSECT * 00127000
* IKQEXLST - FOR DOS VSAM EXLST DSECT * 00128000
* * 00129000
* TABLES: * 00130000
* * 00131000
* LUT - LOGICAL UNIT TABLE * 00132000
* FOR ISSUING DOS AGGN COMMANDS DURING INITIALIZATION * 00133000
* * 00134000
* OPTTAB - OS TO DOS OPTION BYTE TABLE * 00135000
* FOR MAPPING OS RPL OPTION BYTES TO THE DOS RPL * 00136000
* * 00137000
* WORK AREAS: * 00138000
* * 00139000
* VIPWORK - WORK AREA OBTAINED BY DMSVIB (BOOTSTRAP) * 00140000
* USED TO BUILD DOS VSAM CONTROL BLOCKS, SAVE * 00141000
* REGISTERS, ETC. * 00142000
* * 00143000
* OEXLSA - OVERFLOW EXIT LIST SAVE BLOCK * 00144000
* FOR SAVED EXIT ROUTINE ADDRESSES IF PRIMARY SPACE IN * 00145000
* WORK AREA IS USED UP. OBTAINED VIA DMSFREE. * 00146000
* * 00147000
* * 00148000
* REGISTER USAGE: * 00149000
* * 00150000
* R0 - NUCLEUS DSECT * 00151000
* R1 - DOS RPL DSECT, WORK * 00152000
* R2-4 - WORK * 00153000
* R5 - DOS ACB DSECT, WORK * 00154000
* R6 - DOS EXLST DSECT, WORK * 00155000
* R7-9 - WORK * 00156000
* R10 - OEXLSA DSECT, WORK * 00157000
* R11 - WORK AREA DSECT (VIPWORK) * 00158000
* R12 - DMSVIP ADDRESSABILITY * 00159000
* R13 - SYSTEM SAVE AREA ADDRESSABILITY (ASGNERR, DOSEPRO RTNS)* 00160000
* R14 - WORK * 00161000
* R15 - TEMP ADDRESSABILITY UPON ENTRY * 00162000
* * 00163000
* * 00164000
* NOTES: * 00165000
* * 00166000
* FOR DMSVIP TO GET CONTROL AFTER OS GENCB, TESTCB, * 00167000
* MODCB, OR SHOWCB MACRO EXECUTION, THE VIP ADCON MUST BE * 00168000
* AT RELATIVE LOCATION 12(C). * 00169000
* * 00170000
* THE FOLLOWING OS VSAM MACRO EXPANSION LOADS THE ENTRY POINT * 00171000
* ADDRESS SET IN THE SIMULATED CVT AT INITIAL PROGRAM * 00172000
* LOAD: * 00173000
* * 00174000
* + L 15,16 POINT TO CVT * 00175000
* + L 15,256(,15) POINT TO AMCBS * 00176000
* + L 15,12(,15) POINT TO CB MANIPULATION ROUTINE 00177000
* XX REPRESENTS VARIOUS @VA12931 00178000
* ENTRY POINTS 0 TO 80 @VA12931 00178300
* + BAL 14,XX(,15) BRANCH TO ROUTINE @VA12931 00178600
* * 00179000
* THIS MODULE EXECUTES WITH A PSW KEY OF X'0' (NUCLEUS) WHICH * 00180000
* IS SET VIA A DMSKEY MACRO. THE PSW KEY IS RESET PRIOR TO * 00181000
* EACH RETURN OF CONTROL TO THE CALLING PROGRAM. * 00182000
* * 00183000
* * 00184000
* OPERATION: * 00185000
* * 00186000
* INITIALIZATION- * 00187000
* * 00188000
* UPON FIRST CALL TO THE INTERFACE, A 'SET DOS ON (VSAM '* 00189000
* COMMAND IS ISSUED TO LOAD THE DOS SEGMENT. THEN, THE * 00190000
* CHAIN OF DOSCB'S IS SEARCHED AND DOS ASSGN COMMANDS * 00191000
* ARE ISSUED FOR THE OS USER. * 00192000
* * 00193000
* OPEN (SVC19)- * 00194000
* * 00195000
* ALL OS ACB'S ARE REARRANGED TO DOS FORMAT PRIOR TO * 00196000
* OPEN. IN ADDITION, ANY EXIT LISTS POINTED TO BY THE * 00197000
* ACB'S ARE REARRANGED IF NECESSARY. THE ADDRESSES OF * 00198000
* EXIT ROUTINES CONTAINED THEREIN ARE REPLACED BY THE * 00199000
* ADDRESS OF DMSVIP3 TO ALLOW VIP TO GAIN CONTROL * 00200000
* PRIOR TO THE USER EXIT (SEE BELOW). * 00201000
* * 00202000
* A DOS OPEN IS THEN ISSUED VIA DOS SVC 2 TO $$BOPEN. * 00203000
* ANY DOS ERROR CODES THAT DO NOT EXIST IN OS ARE * 00204000
* MAPPED TO OS EQUIVALENTS. THE A(DMSVIP2) (ACTION MACRO * 00205000
* ENTRY POINT) IS STORED IN ALL SUCCESSFULLY OPENED * 00206000
* ACB'S, AND CONTROL IS RETURNED TO THE CALLER (DMSSOP). * 00207000
* * 00208000
* CLOSE (SVC20), TCLOSE(SVC23)- * 00209000
* * 00210000
* THESE REQUESTS ARE MADE VIA DOS SVC 2 TO $$BCLOSE. * 00211000
* FOR TCLOSE, A FLAG IS SET IN THE NUCLEUS TO DIRECT * 00212000
* $$BCLOSE TO CALL $$BTCLOS AFTER PROCESSING THE SVC * 00213000
* PLIST. * 00214000
* * 00215000
* THE A(IKQVSM) (VSAM DATA MGT REQUEST DRIVER) IS STORED * 00216000
* IN ALL ACB'S PRIOR TO THE SUPERVISOR CALL. ON RETURN, * 00217000
* THE A(DMSVIP2) IS RESTORED IN THE ACB UNCONDITIONALLY * 00218000
* FOR TCLOSE REQUESTS, AND IN UNSUCCESSFULLY CLOSED ACB'S* 00219000
* FOR CLOSE REQUESTS. CONTROL IS RETURNED TO THE CALLER. * 00220000
* * 00221000
* NOTE THAT FOR OPEN, CLOSE AND TCLOSE REQUESTS, AN ACB * 00222000
* LIST IS BUILT IN FREE STORAGE FROM THE USER'S PLIST * 00223000
* AND PASSED TO DOS. THE LIST IS DMSFRET'D UPON RETURN * 00224000
* FROM VSAM. * 00225000
* * 00226000
* * 00227000
* GET, PUT, POINT, ENDREQ, ERASE- * 00228000
* * 00229000
* THE REQUEST CODE IN REGISTER ZERO IS MAPPED TO THE * 00230000
* EQUIVALENT DOS REQUEST CODE. NEXT, THE RPL (OR CHAIN * 00231000
* OF RPL'S) IS REARRANGED TO DOS FORMAT IF NOT PREVIOUSLY* 00232000
* DONE. IF THE USER HAS PROVIDED AN ECB ADDRESS IN THE * 00233000
* OS RPL, A FLAG IS SET IN THE NEW DOS RPL AND THE ECB * 00234000
* ADDRESS IS SAVED AT THE END OF THE BLOCK. ASYNCHRONOUS * 00235000
* PROCESSING IS SIMULATED BY THE SETTING OF ANY ACTIVE * 00236000
* EXIT RTNS INACTIVE WITHIN THE USER EXLST (WITH THE * 00237000
* EXCEPTION OF A JRNAD EXIT WHICH IS NOT AN ERROR EXIT). * 00238000
* THIS PREVENTS VSAM FROM TAKING AN ERROR EXIT AND ALLOWS* 00239000
* SUCH AN EXIT TO BE DEFERRED UNTIL A CHECK IS ISSUED * 00240000
* (SEE BELOW). * 00241000
* * 00242000
* THE DOS MACRO IS THEN ISSUED VIA A BALR TO IKQVSM. * 00243000
* * 00244000
* ALL DOS ERROR CODES IN THE RPL FDBK FIELD THAT DO NOT * 00245000
* EXIST IN OS ARE MAPPED TO OS EQUIVALENTS. * 00246000
* IF THE USER HAS SPECIFIED SYNCHRONOUS PROCESSING, THE * 00247000
* RETURN CODE IS PASSED UNCHANGED IN REGISTER 15. * 00248000
* * 00249000
* FOR ASYNCHRONOUS PROCESSING, ANY RETURN CODE IS * 00250000
* CLEARED BEFORE RETURN AND PREVIOUSLY SET INACTIVE * 00251000
* EXIT ROUTINES ARE RESTORED TO ACTIVE STATUS IN THE * 00252000
* EXLST. (SEE DESCRIPTION OF CHECK MACRO, BELOW, FOR * 00253000
* FURTHER COMMENTS). ALL ECB'S ARE SET TO 'WAITING' * 00254000
* STATUS. * 00255000
* * 00256000
* CHECK- * 00257000
* * 00258000
* THE RPL FDBK FIELD IS EXAMINED FOR THE RESULTS OF THE * 00259000
* PREVIOUS I/O OPERATION ON THE VSAM DATA SET. CONTROL * 00260000
* IS PASSED TO THE APPROPRIATE EXIT ROUTINE, IF AN * 00261000
* ACTIVE ONE HAS BEEN PROVIDED. ALSO, ALL 'WAITING' * 00262000
* ECB'S ARE POSTED WITH AN EQUIVALENT COMPLETION CODE. * 00263000
* * 00264000
* IF NO ACTIVE EXIT ROUTINE EXISTS, OR IF AN EXIT ROUTINE* 00265000
* 'RETURNS TO VSAM', THE RETURN CODE IS SET IN REGISTER * 00266000
* 15, AND CONTROL IS RETURNED TO THE USER INSTRUCTION * 00267000
* FOLLOWING THE CHECK. * 00268000
* * 00269000
* GENCB- * 00270000
* * 00271000
* FOR GENCB BLK=ACB OR BLK=EXLST, A DOS GENCB REQUEST * 00272000
* IS ISSUED VIA BALR TO IKQGEN. THE PLIST IS UNCHANGED. * 00273000
* * 00274000
* IF THE GENCB IS FOR AN RPL, AND THE USER HAS SPECIFIED * 00275000
* THE ECB KEYWORD, THE PLIST IS REARRANGED TO EXCLUDE * 00276000
* THE ECB ELEMENT, SINCE IT IS NOT SUPPORTED IN DOS. * 00277000
* A DOS GENCB IS THEN ISSUED AND, IF THE USER HAS * 00278000
* PROVIDED A WORKAREA, THE ADDRESS OF THE ECB IS STORED * 00279000
* AT THE END OF THE RPL AND A FLAG IS SET IN THE RPL. * 00280000
* THE PLIST IS RESTORED BEFORE CONTROL IS RETURNED TO * 00281000
* THE USER. * 00282000
* * 00283000
* MODCB, SHOWCB, TESTCB- * 00284000
* * 00285000
* IF A MODCB IS ISSUED FOR AN OS ACB, RPL OR EXLST, * 00286000
* THE CONTROL BLOCK IS REARRANGED TO DOS FORMAT BEFORE * 00287000
* A BALR TO IKQTMS. THE ECB KEYWORD IS NOT ALLOWED ON * 00288000
* A MODCB, SHOWCB OR TESTCB. * 00289000
* * 00290000
* IF THE REQUEST IS FOR TESTCB IO=COMPLETE, A 'NOT EQUAL'* 00291000
* OR 'WAITING' RESULT IS UNCONDITIONALLY RETURNED TO THE * 00292000
* USER. ALL OTHER SUPPORTED TESTCB REQUESTS ARE PASSED * 00293000
* TO DOS, AND THE USER CAN RELY ON THE PSW CONDITION CODE* 00294000
* TO INDICATE THE RESULTS OF THE TEST. * 00295000
* * 00296000
* IF AN ERET EXIT IS PROVIDED FOR TESTCB, THE A(DMSVIP4) * 00297000
* IS SUBSTITUTED IN THE PLIST TO ALLOW VIP TO GAIN CONTROL 00298000
* PRIOR TO ERET ENTRY AND SET THE PROPER SVC BIT (DOS BIT* 00299000
* OFF). THE ERET ADDRESS IS RESTORED TO THE PLIST PRIOR TO 00300000
* RETURN TO THE USER FOLLOWING THE TESTCB. * 00301000
* * 00302000
* VSAM EXIT TO USER EXIT RTN- * 00303000
* * 00304000
* ENTRY TO THE INTERFACE IS MADE AT DMSVIP3 FOR ALL * 00305000
* VSAM ERROR EXITS DURING I/O. THE DOS SVC BIT IS TURNED * 00306000
* OFF AND USER STORAGE KEY IS RESTORED. * 00307000
* * 00308000
* THE ADDRESS OF THE USER ROUTINE IS RECOVERED FROM * 00309000
* THE SAVED LIST (EITHER THE PRIMARY LIST IN THE WORK AREA 00310000
* OR FROM AN OVERFLOW LIST- OEXLSA). * 00311000
* * 00312000
* CONTROL IS THEN PASSED DIRECTLY TO THE EXIT ROUTINE. * 00313000
* IF THE ROUTINE 'RETURNS TO VSAM', VIP3 RESETS THE * 00314000
* ENVIRONMENT FLAGS, AND BRANCHES BACK TO VSAM. * 00315000
* * 00316000
* NOTE THAT THE INTERFACE IS CAPABLE OF SAVING UP TO * 00317000
* 128 DISTINCT EXIT ROUTINE ADDRESSES DURING A RUN UNIT. * 00318000
* * 00319000
* VSAM EXIT TO USER ERET RTN- * 00320000
* * 00321000
* ENTRY TO THE INTERFACE IS MADE AT DMSVIP4 FOR ALL * 00322000
* VSAM EXITS TO A USER ERET ROUTINE DURING TESTCB MACRO * 00323000
* REQUESTS. THE DOS SVC BIT IS TURNED OFF AND USER * 00324000
* STORAGE KEY RESTORED. * 00325000
* * 00326000
* THE ADDRESS OF THE ERET ROUTINE IS RECOVERED FROM THE * 00327000
* WORK AREA AND CONTROL IS PASSED TO THE ROUTINE. * 00328000
* * 00329000
* NOTE THAT THE ERET ROUTINE IS RESTRICTED FROM RETURNING* 00330000
* CONTROL TO VSAM. * 00331000
* * 00332000
* NOTE - PROGRAMMER CODE = @V305174 * 00333000
* * 00334000
*********************************************************************** 00335000
EJECT 00336000
DMSVIP START , @V305174 00337000
USING NUCON,R0 @V305174 00338000
USING DMSVIP,R15 @V305174 00339000
B VIPENTRY GO SET REGISTER 14 @VA07050 00340100
DROP R15 @V305174 00341000
DMSVIP2 EQU * @V305174 00342000
USING *,R15 @V305174 00343000
ICM R14,HIGHBYTE,=X'80' USE HI-ORD TO IND VIP2 ENTRY@V305174 00344000
B REGSTORE GO SAVE REGISTERS @V305174 00345000
*********************************************************************** 00346000
* * 00347000
* VIP ADCON - MUST BE AT RELATIVE LOCATION 12(C) - SEE NOTES * 00348000
* * 00349000
*********************************************************************** 00350000
ADMSVIP1 DC AL4(DMSVIP1) @VA12931 00351000
*********************************************************************** 00352000
DROP R15 @V305174 00353000
DMSVIP3 EQU * @V305174 00354000
USING *,R15 @V305174 00355000
B VIP3PROC BRANCH TO VIP3 PROCESSING @V305174 00356000
DROP R15 @V305174 00357000
SPACE 2 00358000
DMSVIP1 DS 0H MACRO ENTRY POINT @VA12931 00358300
* @VA12931 00358310
* THE ENHANCED OS/VS VSAM CONTROL BLOCK MANIPULATION MACROS @VA12931 00358320
* USE A BRANCH TABLE ENTRY TO INVOKE THE APPROPRIATE VSAM @VA12931 00358330
* FUNCTION. THE FOLLOWING TABLE SUPPORTS BRANCH TABLE ENTRY. @VA12931 00358340
* @VA12931 00358350
SPACE 2 @VA12931 00358360
USING DMSVIP1,R15 @VA12931 00358370
B VIPENTRY + 0 @VA12931 00358380
B VIPENTRY + 4 @VA12931 00358390
B VIPENTRY + 8 GENCB = ACB @VA12931 00358400
B VIPENTRY + 12 GENCB = RPL @VA12931 00358410
B VIPENTRY + 16 GENCB = EXLST @VA12931 00358420
B VIPENTRY + 20 ** RESERVED ** @VA12931 00358430
B VIPENTRY + 24 MODCB AN ACB @VA12931 00358440
B VIPENTRY + 28 MODCB AN RPL @VA12931 00358450
B VIPENTRY + 32 MODCB AN EXLST @VA12931 00358460
B VIPENTRY + 36 ** RESERVED ** @VA12931 00358470
B VIPENTRY + 40 SHOWCB = ACB @VA12931 00358480
B VIPENTRY + 44 SHOWCB = RPL @VA12931 00358490
B VIPENTRY + 48 SHOWCB = EXLST @VA12931 00358500
B VIPENTRY + 52 ** RESERVED ** @VA12931 00358510
B VIPENTRY + 56 TESTCB AN ACB @VA12931 00358520
B VIPENTRY + 60 TESTCB AN RPL @VA12931 00358530
B VIPENTRY + 64 TESTCB AN EXLST @VA12931 00358540
B VIPENTRY + 68 ** RESERVED ** @VA12931 00358550
B VIPENTRY + 72 SHOWCB/TESTCB (KEYWORDS) @VA12931 00358560
B VIPENTRY + 76 SHOWCB (RECLEN OF RPL) @VA12931 00358570
B VIPENTRY + 80 MODCB (RECLEN OF RPL) @VA12931 00358580
DROP R15 @VA12931 00358590
VIPENTRY DS 0H MAIN OR COMMON ENTRY @VA12931 00358600
LA R14,0(,R14) CLEAR HIGH ORDER BYTE @VA07050 00358700
REGSTORE DMSKEY NUCLEUS GET NUCLEUS STOR KEY @V305174 00359000
L R15,AVIPWORK GET ADDRESS OF WORK AREA @V305174 00360000
USING VIPWORK,R15 @V305174 00361000
STM R0,R14,VIPRSAVE SAVE CALLER'S REGS @V305174 00362000
DROP R15 @V305174 00363000
LR R11,R15 LOAD PERM BASE FOR WORK AREA@V305174 00364000
USING VIPWORK,R11 @V305174 00365000
BALR R12,R0 PERM BASE FOR REST OF COMMON CODE@V305174 00366000
USING *,R12 @V305174 00367000
LTR R14,R14 WHERE WAS INTERFACE ENTERED? @V305174 00368000
BM DMREQ ENTERED AT DMSVIP2, @V305174 00369000
* PROCESS VSAM DATA MGT MACRO 00370000
* 00371000
* ELSE, ENTRY WAS MADE AT DMSVIP ENTRY POINT- DETERMINE WHETHER THIS IS 00372000
* FIRST ENTRY TO ROUTINE AND ALSO WHETHER OR NOT CALLER WAS CMS 00373000
* OPEN ROUTINE (DMSSOP) OR USER PROGRAM (GENCB, TESTCB, MODCB, SHOWCB). 00374000
* 00375000
TM VSAMFLG1,VIPINIT FIRST TIME ENTERED? @V305174 00376000
BO QUERCALL NO, DETERMINE CALLER'S IDNTY @V305174 00377000
EJECT 00378000
*********************************************************************** 00379000
* * 00380000
* INITIALIZATION PROCESSING - FIRST CALL TO INTERFACE * 00381000
* * 00382000
*********************************************************************** 00383000
OI VSAMFLG1,VIPINIT TURN ON ENTRY FLAG (CLEANUP @V305174 00384000
* RTN WILL TURN OFF - DMSVSR) 00385000
* 00386000
* LOAD THE DOS SEGMENT 00387000
* 00388000
LA R1,SETDOSON POINT TO PLIST @V305174 00389000
SVC 202 LOAD DOS SHARED SEGMENT @V305174 00390000
DC AL4(*+4) @V305174 00391000
LA R1,=CL8'DMSSMNAT' CALL STORAGE INITIALIZER @V305174 00392000
SVC 202 TO SETUP STOR AND ANCHOR TABLE @V305174 00393000
DC AL4(*+4) @V305174 00394000
* 00395000
* 00396000
* ISSUE DOS ASSGN'S FOR THE OS USER 00397000
* 00398000
* 00399000
L R7,DOSFIRST GET ADDR OF DOSCB'S @V305174 00400000
LTR R7,R7 ANY? @V305174 00401000
BZ QUERCALL NO, SKIP THIS @V305174 00402000
USING DOSSECT,R7 @V305174 00403000
MVC DLUT(44),LUT USE WORK FOR LOG UNIT SEARCH @V305174 00404000
MVC DASSGN(32),ASSGNCMD MOVE CMD TO DYNAMIC AREA @V305174 00405000
LOOPTOP ICM R2,LOWBYTE,DOSDSMD GET MODE FOR POSSIBLE ASSGN @V305106 00406000
LA R3,DOSYSXXX WHERE WE WANT DOS LOG UNIT @V305106 00407000
SR R9,R9 CLEAR REG FOR 1ST CALL INDIC @V305174 00408000
BAL R14,SRCHLUT CALL FOR DOS LOG UNIT ASSGN @V305174 00409000
CLI DOSEXTNO,ALLOFF ANY EXTENTS? @V305106 00410000
BZ MULTCHK NO, CHECK FOR MULTI-VOLS @V305106 00411000
ICM R9,LOWBYTE,DOSEXTNO GET NO. EXTENTS @V305106 00412000
L R10,DOSEXTTB AND ADDRESS OF BLOCK @V305106 00413000
ELOOP ICM R2,LOWBYTE,0(R10) PROVIDE MODE FOR POSS ASSGN @V305106 00414000
CLM R2,LOWBYTE,DOSDSMD DOES MODE MATCH 'MASTER'? @V305106 00415000
BNE EPOINT NO, PREPARE TO CALL SRCHLUT @V305106 00416000
MVC 1(2,R10),DOSYSXXX USE THE SAME LOG UNIT CODE @V305106 00417000
B ENEXT SKIP SRCHLUT CALL @V305106 00418000
EPOINT LA R3,1(,R10) SET DOS LOG UNIT PTR @V305106 00419000
BAL R14,SRCHLUT CALL FOR DOS LOG UNIT ASSGN @V305106 00420000
ENEXT LA R10,11(,R10) POINT TO NEXT ENTRY @V305106 00421000
BCT R9,ELOOP LOOP THRU... @V305106 00422000
MULTCHK CLI DOSVOLNO,ALLOFF MULT-VOLS SPECIFIED? @V305106 00423000
BZ NDOSCB NO, GET NEXT DOSCB @V305106 00424000
ICM R9,LOWBYTE,DOSVOLNO GET NO. ENTRIES @V305174 00425000
L R10,DOSVOLTB AND ADDRESS OF BLOCK @V305106 00426000
MLOOP ICM R2,LOWBYTE,0(R10) PROVIDE MODE FOR POSS ASSGN @V305106 00427000
LA R3,1(,R10) SET DOS LOG UNIT PTR @V305174 00428000
BAL R14,SRCHLUT CALL FOR DOS LOG UNIT ASSGN @V305174 00429000
LA R10,3(,R10) POINT TO NEXT ENTRY @V305174 00430000
BCT R9,MLOOP LOOP THRU MULT BLOCK @V305106 00431000
SPACE 00432000
B NDOSCB NOW ON TO THE NEXT @V305174 00433000
* 00434000
* PROVIDE DOS LOG UNIT CODE, ASSGN IF NECESSARY 00435000
* 00436000
SRCHLUT LA R6,DLUT POINT TO BEG OF TABLE @V305174 00437000
CLC DOSDD(7),=CL8'IJSYSCT' SYSCAT DDNAME? @V305174 00438000
BE SYSCAT YES, SPECIAL HANDLING HERE @V305174 00439000
NOTCAT MVI 0(R3),PROG SET TO INDIC PROG UNIT @V305066 00440000
CLI DOSDEV,DOSDUM DUMMY DATA SET? @V305174 00441000
BNE AGAIN NO, GO MATCH LOGICAL UNIT @V305174 00442000
OI DUMFLAG,DUMMIES SET DUMMY FLAG FOR LATER REF @V305174 00443000
MVI 1(R3),SYS010 LOG UNIT SYS010 FOR DUMMIES @V305174 00444000
BR R14 RETURN TO CALLER @V305174 00445000
AGAIN CLI 0(R6),BLANKS MODE STILL UNASSIGNED? @V305174 00446000
BE NEWSLOT YES, GO AND USE IT @V305174 00447000
CLM R2,LOWBYTE,0(R6) DO FILEMODES MATCH? @V305174 00448000
BNE UPDLUT NO @V305174 00449000
MVC 1(1,R3),3(R6) PROV. LOG DEV NUM FOR CALLER @V305174 00450000
NI 1(R3),HEXTRANS TRANSLATE TO HEX @V305174 00451000
BR R14 RET TO CALLER,ASSGN PREV DONE@V305174 00452000
UPDLUT LA R6,4(,R6) NO, CHECK NEXT IN TABLE @V305174 00453000
B AGAIN @V305174 00454000
NEWSLOT STCM R2,LOWBYTE,0(R6) ASSIGN MODE IN TABLE @V305174 00455000
MVC 1(1,R3),3(R6) MOVE CHAR DEV NUM TO DOSCB @V305174 00456000
NI 1(R3),HEXTRANS TRANSLATE TO HEX @V305174 00457000
EJECT 00458000
* 00459000
* MODIFY ASSGN COMMAND FOR THIS DATA SET AND 00460000
* ISSUE DOS ASSGN 00461000
* 00462000
MVC DASSGN+11(3),1(R6) INSERT LOGICAL DEVICE @V305174 00463000
FOUND STCM R2,LOWBYTE,DASSGN+16 INSERT FILEMODE @V305174 00464000
DOSASSGN LA R1,DASSGN POINT TO PLIST @V305174 00465000
SVC 202 @V305174 00466000
DC AL4(ASGNERR) ERROR ROUTINE @V305174 00467000
BR R14 RETURN TO CALLER @V305174 00468000
SYSCAT EQU * @V305174 00469000
* 00470000
* FOR DDNAME IJSYSCT ISSUE 'ASSGN SYSCAT FILEMODE' 00471000
* 00472000
LTR R9,R9 FIRST DOSCB CALL? @V305174 00473000
BZ GOODCAT YES, GO TO IT @V305174 00474000
CLM R2,LOWBYTE,DOSDSMD EXTENT MODE SAME AS 'MASTER'?@V305106 00475000
BNE NOTCAT NO, TREAT AS NO CAT @V305174 00476000
GOODCAT MVC 0(2,R3),=X'000D' SET SYSTEM CODE IN DOSCB @V305174 00477000
CLI DOSDEV,DOSDUM SYSCAT DUMMIED? @V305174 00478000
BNE CAT NO, PROCEED @V305174 00479000
OI DUMFLAG,DUMCAT YES, SET FLAG FOR LATER REF @V305174 00480000
BR R14 RETURN TO CALLER @V305174 00481000
CAT MVC DASSGN+11(3),=CL3'CAT' SPECIAL LOG UNIT @V305174 00482000
B FOUND ISSUE DOS ASSGN COMMAND @V305174 00483000
NDOSCB ICM R7,B8TO31,DOSNEXT+1 POINT TO NEXT DOSCB @V305174 00484000
LTR R7,R7 ANY LEFT? @V305174 00485000
BP LOOPTOP YES, CONTINUE TO MARCH @V305174 00486000
* 00487000
* ISSUE 'ASSGN SYS010 IGN' OR 'ASSGN SYSCAT IGN' AS INDIC IN DLUT 00488000
* 00489000
MVC DASSGN+16(3),=CL3'IGN' SET IGNORE FIELD IN CMD @V305174 00490000
TM DUMFLAG,DUMMIES ANY DUMMY DATASETS ENCNTR'D? @V305174 00491000
BZ TDUMCAT NO, HOW ABOUT SYSCAT DATA SET@V305174 00492000
MVC DASSGN+11(3),DUMUNIT LOG UNIT SYS010 FOR DUMMY @V305174 00493000
BAL R14,DOSASSGN ISSUE COMMAND @V305174 00494000
TDUMCAT TM DUMFLAG,DUMCAT HAS IJSYSCT BEEN DUMMIED? @V305174 00495000
BZ QUERCALL NO, END OF ASSIGNMENTS @V305174 00496000
MVC DASSGN+11(3),=CL3'CAT' LOGICAL UNIT @V305174 00497000
BAL R14,DOSASSGN ISSUE CMD THEN FALL THRU @V305174 00498000
* TO QUERCALL 00499000
DROP R7 @V305174 00500000
EJECT 00501000
* 00502000
* DETERMINE WHETHER CALLER WAS DMSSOP OR USER VIA CONTROL BLOCK MACRO 00503000
* 00504000
QUERCALL OI DOSFLAGS,DOSSVC TURN ON DOS SVC BIT @V305174 00505000
L R5,SAVER14 LOAD CALLER'S R14 @V305174 00506000
CLC 1(3,R5),=CL3'SOP' IS THIS OPEN ROUTINE'S PLIST?@V305174 00507000
BNE CBMACS NO, CNTL BLK MANIP MACROS-PROC @V305174 00508000
LR R6,R5 PRIME WK REG FOR OPEN CLOSE PROC @V305174 00509000
LA R5,4(,R5) BUMP REG PAST PLIST IN SOP @V305174 00510000
ST R5,SAVER14 REPLACE FOR LATER RETURN @V305174 00511000
EJECT 00512000
* 00513000
* PROCESS REQUEST FROM DMSSOP- OPEN/CLOSE/TCLOSE 00514000
* 00515000
* CALLING SEQUENCE: 00516000
* 00517000
* L R15,ACMSCVT POINT TO CVT 00518000
* L R15,256(,R15) GET ADDR OF DMSVIP (CVTAVIB) 00519000
* BALR R14,R15 EXIT TO INTERFACE 00520000
* DC CL1'O' OPTION BYTE (C'O'-OPEN, C'C'-CLOSE, 00521000
* C'T'-TCLOSE) 00522000
* DC CL3'SOP' SOP IDENTIFIER 00523000
* 00524000
* R6 CONTAINS THE CONTENTS OF CALLER'S R14 00525000
* 00526000
* BUILD LIST OF ACB'S IN FREE STORAGE FOR DOS 00527000
* 00528000
* DETERMINE TYPE OF REQUEST- OPEN, CLOSE, OR TCLOSE 00529000
* 00530000
OI VSAMFLG1,VIPSOP SET FLAG FOR DOS $$B... RTN @V305174 00531000
SR COUNTREG,COUNTREG INITIALIZE COUNTER @V305174 00532000
L R7,SAVER1 PLIST ADDRESS IN WORK REG @V305174 00533000
SOP1 L ACBREG,0(,R7) PT TO CNTL BLK (ACB OR DCB) @V305174 00534000
CLI 0(ACBREG),ACBIDD ACB? @V305174 00535000
BNE SOP2 NO, SKIP @V305174 00536000
LA COUNTREG,1(,COUNTREG) YES, INCREMENT COUNTER @V305174 00537000
SOP2 TM 0(R7),LAST LAST IN PLIST? @V305174 00538000
BO FREEACBL YES, GO DMSFREE FOR LIST @V305174 00539000
LA R7,4(,R7) POINT TO NEXT @V305174 00540000
B SOP1 CONTINUE @V305174 00541000
FREEACBL EQU * @V305174 00542000
SRL COUNTREG,1 DIVIDE BY 2 AND @V305174 00543000
LA COUNTREG,1(,COUNTREG) ADD 1 FOR SPACE REQUEST @V305174 00544000
LR R0,COUNTREG R0 HAS NUMBER OF DWORDS @V305174 00545000
DMSFREE DWORDS=(0),TYPE=NUCLEUS,ERR=ERR109S @V305174 00546000
ST R1,ACBLIST SAVE ADDRESS IN NUCON @V305174 00547000
STC COUNTREG,ACBLIST WITH SIZE IN HI-ORDER BYTE @V305174 00548000
L R0,SAVER1 PRIME R0 WITH PLIST ADDRESS @V305174 00549000
CLI 0(R6),CLOSE CLOSE REQUEST? @V305174 00550000
BE DOSCLOSE YES @V305174 00551000
CLI 0(R6),TCLOSE TCLOSE? @V305174 00552000
BE DOSTCLOS RIGHT THIS TIME @V305174 00553000
SPACE 2 00554000
OSOPEN EQU * @V305174 00555000
LR DOSLREG,R1 USE WORK REG FOR ACB LIST PTR@V305174 00556000
LR R7,R0 PLIST ADDRESS IN WORK REG @V305174 00557000
OP2 L ACBREG,0(,R7) PT TO CNTL BLK (ACB OR DCB) @V305174 00558000
CLI 0(ACBREG),ACBIDD ACB? @V305174 00559000
BE OP4 YES, PROCESS IT @V305174 00560000
OP3 TM 0(R7),LAST IS THIS THE LAST IN PLIST? @V305174 00561000
BO DOSOPEN YES, NOW CAN ISSUE DOS OPEN @V305174 00562000
LA R7,4(,R7) POINT TO NEXT @V305174 00563000
B OP2 CONTINUE @V305174 00564000
OP4 LA R14,OP3 LOAD BRANCH ADDR FOR PROCEXL @V305174 00565000
MVI 0(DOSLREG),ALLOFF CLEAR HI-ORD POS (FLAG BYTE) @V305174 00566000
MVC 1(3,DOSLREG),1(R7) ENTER ACB ADDRESS IN LIST @V305174 00567000
LA DOSLREG,4(,DOSLREG) AND POINT TO NEXT SLOT @V305174 00568000
CLI 3(ACBREG),OSACBLEN OS ACB? @V305174 00569000
BNE PROCEXL NO, DOS-SET=OPEN, 1ST PROC EXLST @V305174 00570000
* 00571000
* BUILD DOS ACB IN WORK AREA FROM THE OS ACB. 00572000
* 00573000
BDOSACB XC CBWKAR(LCBWK),CBWKAR CLEAR WORK AREA @V305174 00574000
USING IKQACB,R11 @V305174 00575000
MVI ACBID,ACBIDD ID @V305174 00576000
MVI ACBSTYP,VSAMTYP VSAM SUBTYPE @V305066 00577000
MVI ACBLEN+1,LENGTH LENGTH @V305066 00578000
MVC ACBAMBL(8),4(ACBREG) AMBL ADDR & PTR TO VSAM @V305174 00579000
MVC ACBBUFND(2),16(ACBREG) NUM OF DATA BUFFERS @V305174 00580000
MVC ACBIBUF(2),18(ACBREG) NUM OF INDEX BUFFERS @V305174 00581000
MVC ACBMACRF(2),12(ACBREG) MACRF BYTES @V305174 00582000
MVI ACBDOSID,ACBDTFID DTF TYPE FOR VSAM @V305174 00583000
MVC ACBSTRNO(1),15(ACBREG) NUM OF RPL STRINGS @V305174 00584000
MVC ACBDDNM(8),40(ACBREG) DDNAME @V305174 00585000
MVC ACBPRTCT(4),32(ACBREG) PTR TO PASSWORD @V305174 00586000
MVC ACBUAPTR(4),52(ACBREG) PTR TO USER WORK AREA @V305174 00587000
MVC ACBBFPL(4),20(ACBREG) ->1ST DATA BUF IN BUF POO@V305174 00588000
MVC ACBEXLST(4),36(ACBREG) USER EXIT LIST PTR @V305174 00589000
MVC 0(68,ACBREG),ACBST OVERLAY OS WITH DOS @V305174 00590000
EJECT 00591000
* 00592000
* IF USER HAS AN EXIT LIST, BUILD A LIST OF EXIT ADDRESSES IN 00593000
* THE WORK AREA AND STORE VIP ADDRESS IN EXLST ADDRESS CELLS. 00594000
* THIS WILL ENABLE VIP TO GET CONTROL PRIOR TO AN EXIT LIST BEING 00595000
* ENTERED SO THAT THE DOS SVC BIT CAN BE TURNED OFF. 00596000
* 00597000
* NOTE- THIS ADDRESS LIST (MADE UP OF 4-BYTE ENTRIES) IS OPTIMIZED 00598000
* AS IT IS BEING BUILT. I.E., EXIT LIST ADDRESSES FOR DIFFERENT 00599000
* ACB'S POINTING TO THE SAME ROUTINES WILL EFFECT ONLY 1 ENTRY 00600000
* IN VIP'S LIST. IF THE PRIMARY SAVE AREA (EXLSA) IS COMPLETELY 00601000
* FILLED, AN OVERFLOW AREA (OEXLSA) IS OBTAINED DYNAMICALLY 00602000
* FROM NUCLEUS FREE STORAGE, CHAINED TO THE PRIMARY AREA, AND 00603000
* FILLED. 00604000
* 00605000
* PROCEXL IS ENTERED VIA AN IN-LINE BAL. R14 CONTAINS THE CALLER'S 00606000
* RETURN ADDRESS, AND R5 CONTAINS A POINTER TO THE ACB. 00607000
* 00608000
PROCEXL EQU * @V305174 00609000
USING IKQACB,ACBREG @V305174 00610000
USING VIPWORK,R11 @V305174 00611000
L EXLSTREG,ACBEXLST GET EXLST PTR @V305174 00612000
LTR EXLSTREG,EXLSTREG ANY? @V305174 00613000
BCR ZERO,R14 NO, RETURN @V305174 00614000
USING IKQEXLST,EXLSTREG @V305174 00615000
PROCEXL2 ST R14,RETSAV SAVE CALLER'S RETURN ADDRESS @V305174 00616000
STM R7,DOSLREG,WKSAVE SAVE OSOPEN'S WORK REGS @V305174 00617000
LA R2,FIVE LOAD SEARCH INCREMENT @V305066 00618000
CLI EXLLEN+1,EXLJRNL EXIT LIST LEN > MAX DOS LEN? @V305174 00619000
BNH SRCHEXL NO, THEN OS IS ALREADY EQUIV @V305174 00620000
* RE-ARRANGE OS EXLST TO DOS FORMAT 00621000
MVC EXLJRN(5),30(EXLSTREG) RELOCATE JRNAD ENTRY @V305174 00622000
MVI EXLLEN+1,EXLJRNL RESET PROPER LENGTH @V305174 00623000
SRCHEXL EQU * @V305174 00624000
LH R3,EXLLEN GET EXIT LIST LENGTH @V305174 00625000
LA R3,0(R3,EXLSTREG) R3 PTS TO END OF EXLST @V305174 00626000
SR R3,R2 NOW PT TO LAST 5-BYTE ENTRY @V305174 00627000
AR EXLSTREG,R2 GO PST HDR INFO & ->1ST ENTRY @V305174 00628000
S2 ICM R4,ALLFOUR,EXENADDR GET PTR TO EXIT ROUTINE @V305174 00629000
LTR R4,R4 ANY? @V305174 00630000
BZ S3 NO, SKIP TABLE CALL @V305174 00631000
BAL R14,BLDEXLSA GO MAKE TABLE ENTRY @V305174 00632000
STCM R4,ALLFOUR,EXENADDR STOR VIP3 ADDR & HI-ORD NDX @V305174 00633000
S3 BXLE EXLSTREG,R2,S2 PROCESS NEXT IF NEC @V305174 00634000
LM R7,DOSLREG,WKSAVE RESTORE OSOPEN'S WORK REGS @V305174 00635000
L R14,RETSAV GET RETURN ADDRESS @V305174 00636000
BR R14 AND EXIT @V305174 00637000
DROP EXLSTREG @V305174 00638000
SPACE 3 00639000
* 00640000
* BUILD TABLE OF EXIT LIST ADDRESSES IN WORK AREA 00641000
* 00642000
* ON ENTRY: R4 HAS ADDRESS OF EXIT LIST ROUTINE 00643000
* ON EXIT: R4 HAS ADDRESS OF VIP3 (WITH INDEX ENTRY IN HI-ORDER 00644000
* BYTE) TO BE STORED BACK INTO EXLST ADCON CELL 00645000
* 00646000
* INDEX ENTRY DESCRIPTION - 00647000
* 00648000
* BIT 0 - ADDRESS HAS BEEN PROCESSED BY VIP 00649000
* BITS 1-3 - BLOCK NUM (PRIMARY BLOCK IN VIPWORK = 0) 00650000
* BITS 4-7 - WORD NUMBER IN ABOVE BLOCK 00651000
* 00652000
* NOTE- EACH ADDRESS SAVE BLOCK IS 18 FW'S, INCLUDING 00653000
* THE PRIMARY BLOCK AND UP TO 7 OVERFLOW BLOCKS. 00654000
* 00655000
BLDEXLSA EQU * @V305174 00656000
USING VIPWORK,R11 @V305174 00657000
LTR R4,R4 ALREADY PROC'D THIS ENTRY? @V305174 00658000
BCR NEG,R14 YES, RETURN @V305174 00659000
XC CUROVFL(4),CUROVFL CLEAR WORK CELLS @V305174 00660000
LA R10,EXLSA ADDRESS PRIMARY SAVE AREA @V305174 00661000
LA R8,FOUR LOAD SEARCH INCREMENT @V305066 00662000
* PROCESS PRIMARY BLOCK FIRST, THEN OVERFLOWS IF NEC 00663000
LA R9,LASTEXL R9->LAST AVAIL SLOT @V305174 00664000
LR R7,R10 PT TO 1ST SLOT IN SAVE AREA @V305174 00665000
BLD2 CLC 0(4,R7),FZERO WHAT'S THERE? @V305174 00666000
BE ADDEXL ZILCH, ADD THIS @V305174 00667000
CLM R4,B8TO31,1(R7) THIS ADDR BEEN SAVED PREV? @V305174 00668000
BE FOUNDEXL YES @V305174 00669000
BXH R7,R8,OVERFLOW BRANCH IF END OF LIST REACHED@V305174 00670000
B BLD2 ELSE, CHECK NEXT SLOT @V305174 00671000
ADDEXL EQU * @V305174 00672000
ST R4,0(,R7) SAVE CALLER'S EXIT ADDRESS @V305174 00673000
FOUNDEXL L R4,AVIP3 GET VIP3 ENTRY ADDRESS @V305174 00674000
SR R7,R10 CALCULATE SLOT NUMBER IN @V305174 00675000
SRL R7,2 EXIT LIST SAVE TABLE @V305174 00676000
STC R7,EXLMISC MOVE TO WORK @V305174 00677000
LH R7,CUROVFL LOAD CURRENT BLOCK NUMBER @V305174 00678000
SLL R7,28 SHIFT TO HIGH 4 BITS @V305174 00679000
O R7,EXLMISC FORMAT FOR WORK CELL @V305174 00680000
STCM R7,HIGHBYTE,EXLMISC STORE @V305174 00681000
OI EXLMISC,HION PROCESSED BIT ON @V305174 00682000
ICM R4,HIGHBYTE,EXLMISC INSERT INDEX BYTE INTO REG @V305174 00683000
BR R14 RETURN @V305174 00684000
OVERFLOW EQU * @V305174 00685000
USING OEXLSA,R10 OVERFLOW BLOCK ADDRESSABILITY@V305174 00686000
ICM R7,ALLFOUR,ANOEXL GET OVERFLOW POINTER @V305174 00687000
BZ FREEAOEX NONE, GO BUY ONE @V305174 00688000
LR R10,R7 REPRIME BASE REG FOR THIS BLK@V305174 00689000
B OVFL2 AND CONTINUE SEARCH @V305174 00690000
SPACE 2 00691000
* OBTAIN AN OVERFLOW BLOCK FROM NUCLEUS FREE STORAGE AND CHAIN IT 00692000
* TO PREVIOUS ONE 00693000
FREEAOEX EQU * @V305174 00694000
CLC OVFLNUM(2),=H'7' WILL THIS REQ EXCEED LIMIT? @V305174 00695000
BNL ERR230E YES, CANNOT HONOR REQUEST @V305174 00696000
LA R0,NINE LOAD STORAGE REQUEST @V305066 00697000
DMSFREE DWORDS=(0),TYPE=NUCLEUS,ERR=ERR109S @V305174 00698000
ST R1,ANOEXL STORE ADDRESS OF NEW BLOCK @V305174 00699000
XC 0(72,R1),0(R1) INITIALIZE FREE'D AREA @V305174 00700000
LH R15,OVFLNUM BUMP TOTAL @V305174 00701000
LA R15,1(,R15) NUMBER OF BLOCKS @V305174 00702000
STH R15,OVFLNUM BY ONE @V305174 00703000
LR R10,R1 RE-PRIME BASE REG @V305174 00704000
LR R7,R10 R7 NOW->1ST OVFL ADDR SLOT @V305174 00705000
OVFL2 LH R15,CUROVFL BUMP CURRENT @V305174 00706000
LA R15,1(,R15) OVERFLOW COUNTER @V305174 00707000
STH R15,CUROVFL BY ONE @V305174 00708000
LA R9,LASTOEXL R9 NOW->LAST AVAIL SLOT @V305174 00709000
B BLD2 CONTINUE PROCESSING @V305174 00710000
DROP R10 @V305174 00711000
SPACE 2 00712000
FRETACBL EQU * @V305174 00713000
* 00714000
* RELEASE DMSFREE'D STORAGE FOR DOS ACB LIST 00715000
* 00716000
* R9 CONTAINS CALLER'S RETURN ADDRESS 00717000
* 00718000
* RETURN CODE IN REG 15 IS SAVED IN REG 6 00719000
* 00720000
SR R0,R0 CLEAR PARM REG @V305174 00721000
ICM R0,LOWBYTE,ACBLIST NUMBER OF DWORDS IN R0 @V305174 00722000
L R1,ACBLIST LOAD ADDRESS OF STORAGE BLOCK@V305174 00723000
LR R6,R15 SAVE RETURN CODE OVER FRET @V305174 00724000
DMSFRET DWORDS=(0),LOC=(1) @V305174 00725000
LR R15,R6 RESTORE RETURN CODE @V305174 00726000
XC ACBLIST,ACBLIST CLEAR POINTER FIELD @V305174 00727000
BR R9 RETURN TO CALLER @V305174 00728000
* 00729000
ERR109S EQU * @V305174 00730000
NI VSAMFLG1,255-VIPSOP CLEAR OPEN BIT IF ON @V305174 00731000
DMSERR NUM=109,LET=S,TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED' 00732000
ABN177 LA R3,ABEND177 LOAD ABEND CODE @V305066 00733000
B ABEND ISSUE ABEND @V305174 00734000
ERR230E EQU * @V305174 00735000
NI VSAMFLG1,255-VIPSOP CLEAR OPEN BIT IF ON @V305174 00736000
DMSERR NUM=230,LET=E,TEXT='NO. OF VSAM EXIT ROUTINES HAS EXCEEX00737000
DED MAX OF 128- UNABLE TO CONTINUE' @V305174 00738000
B ABN177 @V305174 00739000
EJECT 00740000
USING VIPWORK,R11 @V305174 00741000
DOSOPEN EQU * @V305174 00742000
* 00743000
* ISSUE DOS OPEN, TURN OFF DOS SVC BIT, MAP ERROR CODES IF NEC, 00744000
* STORE A(DMSVIP2) IN ACB+8 (ACBAM0), AND RETURN TO CALLER 00745000
* 00746000
MVC 0(2,DOSLREG),SVC2 SET DOS END OF LIST MARKER @V305174 00747000
L R0,ACBLIST GET ACB LIST PTR @V305174 00748000
LA R1,=CL8'$$BOPEN' @V305174 00749000
SVC SVCTWO ISSUE DOS OPEN @V305066 00750000
* 00751000
L R8,ADOSEPRO GET ADDRESS OF ERROR CHECKER @V305174 00752000
BALR R9,R8 CHECK FOR ANY DOS ERRORS @V305174 00753000
* 00754000
BAL R9,FRETACBL GO RELEASE ACB LIST STORAGE @V305174 00755000
NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 00756000
L R1,SAVER1 RESTORE POINTER TO OPEN PLIST@V305174 00757000
L R15,AOPNEMAP LOAD ERROR MAPPING RTN ADDR @V305174 00758000
* OPNEMAP RTN WILL STORE A(DMSVIP2) IN ACB+8 FOR ALL 00759000
* SUCCESSFULLY OPENED ACB'S- ELSE THE ACB'S ARE RETURNED IN THEIR 00760000
* PREVIOUSLY UNOPENED CONDITION BY DOS 00761000
BALR R14,R15 GO TO IT @V305174 00762000
DMSKEY RESET @V305174 00763000
LR R15,R6 RESTORE DOS OPEN RETURN CODE @V305174 00764000
LM R0,R14,VIPRSAVE RESTORE CALLER'S REGISTERS @V305174 00765000
BR R14 RETURN @V305174 00766000
SPACE 2 00767000
* 00768000
* R1= ADDRESS OF DMSFREE'D ACB LIST STORAGE 00769000
* 00770000
DOSTCLOS EQU * @V305174 00771000
OI VSAMFLG1,VIPTCLOS SET BIT FOR DOS CLOSE RTN @V305174 00772000
DOSCLOSE EQU * @V305174 00773000
LR R6,R0 PLIST PTR IN WORK REG @V305174 00774000
DCL02 L ACBREG,0(,R6) POINT TO CONTROL BLOCK @V305174 00775000
USING IKQACB,ACBREG @V305174 00776000
CLI ACBID,ACBIDD IS IT AN ACB? @V305174 00777000
BNE DCL03 NO, SKIP RESTORE @V305174 00778000
MVI 0(R1),ALLOFF CLEAR HI-ORD POS (FLAG BYTE) @V305174 00779000
MVC 1(3,R1),1(R6) ENTER ACB ADDRESS IN LIST @V305174 00780000
LA R1,4(,R1) POINT TO NEXT SLOT @V305174 00781000
MVC ACBAM0,AIKQVSM RESTOR ADDR DATAMGT REQ DRIVER @V305174 00782000
* FOR VSAM RTN (IKQCLO) 00783000
DCL03 TM 0(R6),LAST ALL DONE? @V305174 00784000
BO DSVC YES, ISSUE DOS REQUEST @V305174 00785000
LA R6,4(,R6) NO, POINT TO NEXT @V305174 00786000
B DCL02 AND CONTINUE @V305174 00787000
DSVC EQU * @V305174 00788000
MVC 0(2,R1),SVC2 SET DOS END OF LIST MARKER @V305174 00789000
LA R1,=CL8'$$BCLOSE' DOS RTN NAME @V305174 00790000
L R0,ACBLIST GET ACB LIST PTR @V305174 00791000
SVC SVCTWO @V305066 00792000
L R8,ADOSEPRO GET ADDRESS OF ERROR CHECKER @V305174 00793000
BALR R9,R8 CHECK FOR ANY DOS ERRORS @V305174 00794000
BAL R9,FRETACBL GO RELEASE ACB LIST STORAGE @V305174 00795000
NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 00796000
TM VSAMFLG1,VIPTCLOS WAS THIS A TCLOSE? @V305174 00797000
BO DTCL YES, NEED TO REPL ACBAMO FLD @V305174 00798000
* ELSE, RESTORE ADDR VIP2 FOR ALL ACBS NOT SUCCESSFULLY CLOSED 00799000
L R6,SAVER1 NEED PLIST PTR @V305174 00800000
L ACBREG,0(,R6) POINT TO CONTROL BLOCK @V305174 00801000
DCL04 CLI ACBID,ACBIDD ACB? @V305174 00802000
BNE DCL05 NO, SKIP CLOSE TEST @V305174 00803000
TM ACBOFLGS,ACBOPEN STILL OPEN (UNSUCC CLOSE)? @V305174 00804000
BZ DCL05 NO, DON'T NEED RESTORE @V305174 00805000
MVC ACBAM0,AVIP2 CLOSE NO GOOD- PUT BACK AVIP2@V305174 00806000
DCL05 TM 0(R6),LAST LAST? @V305174 00807000
BO CLOSRTN YES, GO RETURN TO USER @V305174 00808000
LA R6,4(,R6) NEXT @V305174 00809000
B DCL04 AND CONTINUE @V305174 00810000
CLOSRTN LR R6,R15 SAVE RET CODE REG OVER DMSKEY@V305174 00811000
DMSKEY RESET @V305174 00812000
LR R15,R6 RESTORE RETURN CODE @V305174 00813000
LM R0,R14,VIPRSAVE RESTORE CALLER'S REGS @V305174 00814000
BR R14 RETURN @V305174 00815000
DTCL EQU * @V305174 00816000
NI VSAMFLG1,255-VIPTCLOS TURN OFF FLAG BIT @V305174 00817000
L R6,SAVER1 GET PTR TO PLIST AGAIN @V305174 00818000
L ACBREG,0(,R6) POINT TO CONTROL BLOCK @V305174 00819000
DTCL02 CLI ACBID,ACBIDD ACB? @V305174 00820000
BNE DTCL03 NO, SKIP RESTORE @V305174 00821000
MVC ACBAM0,AVIP2 RESTORE ACBAM0 FIELD @V305174 00822000
DTCL03 TM 0(R6),LAST LAST? @V305174 00823000
BO CLOSRTN YES, RETURN TO USER @V305174 00824000
LA R6,4(,R6) NO, GET NEXT @V305174 00825000
B DTCL02 AND CONTINUE @V305174 00826000
DROP ACBREG @V305174 00827000
EJECT 00828000
* 00829000
* PROCESS VSAM CONTROL BLOCK MACRO REQUESTS 00830000
* 00831000
CBMACS EQU * @V305174 00832000
XC CBMACAR(LCBMAC),CBMACAR INIT WORK AREA @V305174 00833000
L LISTPTR,SAVER1 PT WORK REG TO PLIST @V305174 00834000
L ACEPTR,0(,LISTPTR) PT TO HEADER ACE @V305174 00835000
USING CBMACD,ACEPTR @V305174 00836000
* 00837000
* FOR GENCB, MODCB, TESTCB EXLST- INSURE THAT IF THE ELEMENT 00838000
* ARGUMENT CONTROL ENTRY (EACE) CONTAINS THE ADDRESS OF AN EXIT 00839000
* LIST, THE CORRESPONDING BIT (BIT 3) IN THE BIT STRING IS ON 00840000
* 00841000
CLI FTC,SHOWFTC SHOWCB? @V305174 00842000
BE REARR YES, THIS IS N/A - SKIP @V305174 00843000
CLI BTC,BTEXLST BLOCK TYPE=EXLST? @V305174 00844000
BNE TGEN NO, THEN ALSO DON'T NEED THIS@V305174 00845000
BIT3DONE TM 0(LISTPTR),LAST ALL DONE? @V305174 00846000
BO BIT3OUT YES @V305174 00847000
LA LISTPTR,4(,LISTPTR) POINT TO NEXT @V305174 00848000
L ACEPTR,0(,LISTPTR) POINT TO EACE @V305174 00849000
CLC ELEMPTR(4,ACEPTR),FZERO EXLST ADDR IN EACE? @V305174 00850000
BE BIT3DONE NO, GO SEE IF DONE @V305174 00851000
TM ELEMXFLG(ACEPTR),BIT3 BETTER BE ON @V305174 00852000
BO BIT3DONE GREAT @V305174 00853000
OI ELEMXFLG(ACEPTR),BIT3 NO, COVER UP FOR OS @V305174 00854000
B BIT3DONE GO SEE IF DONE @V305174 00855000
BIT3OUT L LISTPTR,SAVER1 RESET TO TOP OF PLIST @V305174 00856000
L ACEPTR,0(,LISTPTR) RESET TO HEADER ACE @V305174 00857000
SPACE 2 00858000
TGEN CLI FTC,GENFTC GENCB? @V305174 00859000
BE PGENCB YES, PROCESS @V305174 00860000
* 00861000
* FOR MODCB, TESTCB, SHOWCB - RE-ARRANGE OS CONTROL BLOCKS TO 00862000
* DOS FORMAT IF NECESSARY. 00863000
* 00864000
REARR CLI BTC,BTACB ACB? @V305174 00865000
BNE TRPL NO @V305174 00866000
L ACBREG,4(,ACEPTR) YES, PT TO CONTROL BLOCK @V305174 00867000
CLI 3(ACBREG),OSACBLEN OS ACB? @V305174 00868000
BNE CBMACS02 NO, SKIP MAPPING @V305174 00869000
STM LISTPTR,ACEPTR,CBMR34 SAVE WORK REGS @V305174 00870000
LA R15,BDOSACB GET ADDR OF ACB MAPPING RTN @V305174 00871000
BALR R14,R15 MAP OS TO DOS @V305174 00872000
LM LISTPTR,ACEPTR,CBMR34 RESTORE REGS @V305174 00873000
B CBMACS02 CONTINUE @V305174 00874000
TRPL EQU * @V305174 00875000
CLI BTC,BTRPL RPL? @V305174 00876000
BNE TEXLST NO @V305174 00877000
L RPLREG,4(,ACEPTR) YES, PT TO CONTROL BLOCK @V305174 00878000
CLC 0(4,RPLREG),DOSRPL RPL IN DOS FORMAT? @V305174 00879000
BE CBMACS02 YES, SKIP MAPPING @V305174 00880000
LA R15,BDOSRPL GET ADDRESS OF RPL MAP RTN @V305174 00881000
BALR R14,R15 MAP OS TO DOS @V305174 00882000
B CBMACS02 CONTINUE @V305174 00883000
TEXLST EQU * @V305174 00884000
CLI BTC,BTEXLST EXLST? @V305174 00885000
BNE CBMACS02 NO @V305174 00886000
L EXLSTREG,4(,ACEPTR) PT TO CONTROL BLOCK @V305174 00887000
USING IKQEXLST,EXLSTREG @V305174 00888000
CLI EXLLEN+1,EXLJRNL EXIT LIST LEN > MAX DOS LEN? @V305174 00889000
BNH CBMACS02 NO, OS IS ALRDY EQUIV TO DOS @V305174 00890000
* RE-ARRANGE OS EXLST TO DOS FORMAT 00891000
MVC EXLJRN(5),30(EXLSTREG) RELOCATE JRNAD ENTRY @V305174 00892000
MVI EXLLEN+1,EXLJRNL RESET PROPER LENGTH @V305174 00893000
B CBMACS02 CONTINUE @V305174 00894000
DROP EXLSTREG @V305174 00895000
EJECT 00896000
PGENCB EQU * @V305174 00897000
* INSURE THAT NUMBER OF COPIES (IN HEADER ACE) IS AT LEAST =1 00898000
LH R9,GENCOP NUMBER OF COPIES IN WORK REG @V305174 00899000
C R9,FZERO IS IT ZERO? @V305174 00900000
BNE GR NO, FINE @V305174 00901000
MVI GENCOP+1,ONES YES, SET TO DEFAULT VALUE @V305174 00902000
GR CLI BTC,BTRPL GENCB BLK=RPL ? @V305174 00903000
BE PGR YES, SPECIAL HANDLING @V305174 00904000
* 00905000
* FOR BLK=ACB OR BLK=EXLST, DOS GENCB IS ISSUED WITH PLIST 00906000
* UNCHANGED. 00907000
* 00908000
BAL R9,GENBALR GO ISSUE DOS MACRO REQUEST @V305174 00909000
GENRET LR R6,R15 SAVE R15 OVER DMSKEY @V305174 00910000
NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 00911000
DMSKEY RESET @V305174 00912000
LR R15,R6 RESTORE RTN CODE REG @V305174 00913000
L R14,SAVER14 LOAD RETURN ADDRESS @V305174 00914000
LM R2,R12,SAVER2 RESTORE CALLER'S REGS @V305174 00915000
BR R14 EXIT @V305174 00916000
* 00917000
PGR EQU * @V305174 00918000
* 00919000
* USER HAS ISSUED GENCB BLK=RPL,... 00920000
* 00921000
* THE PLIST IS SCANNED FOR NON-DOS KEYWORDS (OS/VS ONLY). IF ANY 00922000
* ARE FOUND, THEY ARE CLEARED BEFORE THE DOS REQUEST IS MADE. 00923000
* 00924000
LA R9,GENRET SET RETURN ADDR FOR GENBALR @V305174 00925000
CLC 4(4,ACEPTR),FZERO WORKAREA PROVIDED? @V305174 00926000
BE PGR02 NO, SKIP @V305174 00927000
OI CBMACFLG,WORKAREA SET FLAG @V305174 00928000
MVC COPYNUM,2(ACEPTR) SAVE NUMBER OF COPIES @V305174 00929000
PGR02 LTR ACEPTR,ACEPTR DEFAULT BLK REQ OR LAST EACE @V305174 00930000
BM GENBALR YES, GO ISSUE REQUEST @V305174 00931000
NEXTEACE LA LISTPTR,4(,LISTPTR) PT TO NEXT EACE ADDRESS @V305174 00932000
L ACEPTR,0(,LISTPTR) PT TO EACE @V305174 00933000
CLI 1(ACEPTR),ECBELID ECB ELEMENT ID? @V305174 00934000
BNE PGR02 NO, CONTINUE SCAN @V305174 00935000
* 00936000
* USER HAS SPECIFIED ECB KEYWORD- 00937000
* 00938000
* IF THE ECB EACE ADDRESS IS THE LAST ONE IN THE PLIST, 00939000
* THE HIGH-ORDER BIT OF THE PREVIOUS EACE ADDRESS IS SET ON 00940000
* SO THAT THE ECB KEYWORD WILL NOT BE PROCESSED BY DOS VSAM. 00941000
* NOTE THAT IF THE ECB EACE ADDRESS IS THE ONLY ONE IN THE PLIST, 00942000
* THE HIGH-ORDER BIT IN SET IN THE HEADER ACE ADDRESS (THIS IS 00943000
* LOGICALLY EQUIVALENT TO A DEFAULT REQUEST). 00944000
* 00945000
* IF THE ECB EACE IS NEITHER LAST NOR ONLY, THE LAST EACE ADDRESS 00946000
* IN THE LIST IS COPIED OVER THE ECB EACE ADDRESS, THE 00947000
* OVERLAYED ADDRESS FIELD AND THE ADDRESS OF THE FIELD ARE SAVED, AND 00948000
* RESTORATION IS ACCOMPLISHED UPON RETURN FROM THE GENCB REQUEST. 00949000
* 00950000
ST ACEPTR,AECBEACE SAVE PTR TO ECB EACE @V305174 00951000
LTR ACEPTR,ACEPTR LAST IN PLIST? @V305174 00952000
BNM OVERLAY NO, THEN OVERLAY PLIST ENTRY @V305174 00953000
* 00954000
SH LISTPTR,=H'4' PT TO PREVIOUS LIST ADDR @V305174 00955000
OI 0(LISTPTR),LAST MAKE IT THE LAST @V305174 00956000
BAL R10,COPIES GO PROC COPIES (>1) & ISSUE MACRO@V305174 00957000
* RESTORE PLIST 00958000
RESTOREP L LISTPTR,SAVER1 START AT TOP OF LIST @V305174 00959000
FINDLAST TM 0(LISTPTR),LAST LAST? @V305174 00960000
BO FLAST YES, FINISH RESTORE @V305174 00961000
LA LISTPTR,4(,LISTPTR) PT TO NEXT @V305174 00962000
B FINDLAST CONTINUE SEARCH @V305174 00963000
FLAST NI 0(LISTPTR),255-LAST CLEAR LAST BIT @V305174 00964000
OI 4(LISTPTR),LAST ECB EACE PTR NOW RESET @V305174 00965000
B GENRET GO EXIT @V305174 00966000
SPACE 2 00967000
OVERLAY EQU * @V305174 00968000
* LISTPTR= ADDRESS OF ECB EACE PTR 00969000
LR R7,LISTPTR PRIME WORK REG @V305174 00970000
ONEXT LA R7,4(,R7) PT TO NEXT ADDRESS IN PLIST @V305174 00971000
TM 0(R7),LAST IS THIS THE LAST ONE? @V305174 00972000
BZ ONEXT NO, KEEP LOOKING @V305174 00973000
MVC 0(4,LISTPTR),0(R7) BRNG THIS ENTRY INTO ECB SLOT@V305174 00974000
NI 0(LISTPTR),255-LAST CLEAR 'LAST' INDIC @V305174 00975000
SH R7,=H'4' PT TO PREV ENTRY @V305174 00976000
OI 0(R7),LAST SET 'LAST' INDIC @V305174 00977000
BAL R10,COPIES GO PROC COPIES (>1) & ISSUE MACRO@V305174 00978000
* NOW RESTORE PLIST 00979000
LR R7,LISTPTR START WITH OLD ECB SLOT @V305174 00980000
OVERLAY2 TM 0(R7),LAST LAST? @V305174 00981000
BO OVERLAY3 YES @V305174 00982000
LA R7,4(,R7) NO, NEXT @V305174 00983000
B OVERLAY2 CONTINUE @V305174 00984000
OVERLAY3 NI 0(R7),255-LAST SET OFF(THIS WAS PSEUDO LAST)@V305174 00985000
MVC 0(4,LISTPTR),AECBEACE RESTORE PLIST ENTRY @V305174 00986000
B GENRET GO EXIT @V305174 00987000
EJECT 00988000
COPIES EQU * @V305174 00989000
* 00990000
* USER MAY HAVE ISSUED GENCB BLK=RPL,ECB=..,WAREA=..,LENGTH=..,COPIES=N 00991000
* -WHERE N IS A NUMBER >1. 00992000
* 00993000
* SINCE VSAM BUILDS THE CONTROL BLOCKS ADJACENT IN THE WORK AREA, 00994000
* PROVISION MUST BE MADE FOR A FULL WORD AT THE END OF EACH RPL 00995000
* FOR THE ECB ADDRESS (CMS USE ONLY). THIS IS DONE BY ISSUING 00996000
* THE GENCB REQUEST FOR 1 COPY AT A TIME AND ADJUSTING THE WORK 00997000
* AREA ADDRESS AND LENGTH FOR EACH REQUEST. 00998000
* 00999000
* WITH A WORKAREA PROVIDED FOR THE CONTROL BLOCK, THE GENCB IS 01000000
* ISSUED AND, IF SUCCESSFUL, THE ECB ADDRESS IS STORED IMMEDIATELY 01001000
* AFTER THE RPL (RPL+52). 01002000
* 01003000
* (NOTE THAT THE OS RPL = 76 BYTES IN LENGTH, WHILE THE DOS RPL 01004000
* IS ONLY 52 BYTES IN LENGTH.) 01005000
* 01006000
* IF AN ERROR IS ENCOUNTERED AFTER ANY INDIVIDUAL GENCB REQUEST, 01007000
* NO FURTHER REQUESTS ARE ISSUED, THE PLIST IS RESTORED, AND CONTROL 01008000
* IS RETURNED TO THE USER. 01009000
* 01010000
TM CBMACFLG,WORKAREA WORKAREA PROVIDED? @V305174 01011000
BO WARYES YES, CONTINUE @V305174 01012000
COPYGEN BAL R9,GENBALR NO - ISSUE GENCB HERE @V305174 01013000
BR R10 AND HEAD FOR THE EXITS @V305174 01014000
WARYES L R6,SAVER1 PT TO PLIST @V305174 01015000
L R6,0(,R6) PT TO HEADER ACE @V305174 01016000
MVC HEACE(12),0(R6) SAVE HEADER ACE IN WORK AREA @V305174 01017000
SR R8,R8 CLEAR COPY HOLDER REG @V305174 01018000
ICM R8,LOWTWO,HEACE+2 REAL NO. OF COPIES IN REG8 @V305174 01019000
LA R5,ONE PRIME WORK REG @V305066 01020000
STCM R5,LOWTWO,2(R6) NUM COPIES SET TO =1 IN PLIST@V305174 01021000
COPYGEN2 BAL R9,GENBALR ISSUE GENCB FOR 1 COPY @V305174 01022000
LTR R15,R15 ERRORS? @V305174 01023000
BNZ COPYEXIT YES, GO NO FURTHER @V305174 01024000
* SAVE ECB ADDRESS 01025000
ICM R5,ALLFOUR,4(R6) GET ADDR OF WORKAREA @V305174 01026000
USING IKQRPL,R5 @V305174 01027000
MVC RPLECB,4(ACEPTR) MOVE ECB ADDR->END OF GEN'D RPL@V305174 01028000
OI RPLFLAG,RPLECBPR SET RPL FLAG @V305174 01029000
BCTR R8,R0 DECR NUM OF COPIES @V305174 01030000
LTR R8,R8 ALL DONE? @V305174 01031000
BZ COPYEXIT YES, PREPARE FOR IN-LINE RETN@V305174 01032000
AH R5,=H'56' BUMP WAREA ADDR BY LEN(DOS RPL+4)@V305174 01033000
STCM R5,ALLFOUR,4(R6) STORE IN HEADER @V305174 01034000
SR R5,R5 ZERO WORK REG @V305174 01035000
ICM R5,LOWTWO,8(R6) GET WORKAREA LENGTH @V305174 01036000
SH R5,=H'56' REDUCE LENGTH ACCORDINGLY @V305174 01037000
STCM R5,LOWTWO,8(R6) STORE IN HEADER @V305174 01038000
B COPYGEN2 ISSUE NEXT GENCB @V305174 01039000
COPYEXIT EQU * @V305174 01040000
MVC 0(12,R6),HEACE RESTORE USER'S HEACE TO PLIST@V305174 01041000
BR R10 RETURN @V305174 01042000
DROP R5 @V305174 01043000
EJECT 01044000
CBMACS02 EQU * @V305174 01045000
CLI FTC,TESTFTC TESTCB? @V305174 01046000
BE PTESTCB YES, SPECIAL HANDLING @V305174 01047000
* 01048000
* FOR MODCB AND SHOWCB, CAN ISSUE REQUEST NOW, THEN RETURN 01049000
* 01050000
BAL R9,LOADTMS GET ADDRESS OF VSAM RTN @V387274 01051100
BAL R9,TMSBALR BRANCH TO ISSUE DOS CB MACRO @V305174 01052000
* 01053000
* IF REQUEST WAS FOR A MODCB EXLST, PROCESS NEWLY MODIFIED EXLST 01054000
* TO INSURE THAT EXIT ADDRESSES EQUAL A(DMSVIP3) 01055000
* 01056000
CLI FTC,MODFTC MODCB? @V305174 01057000
BNE GENRET NO @V305174 01058000
CLI BTC,BTEXLST MODCB EXLST? @V305174 01059000
BNE GENRET NO, RETURN @V305174 01060000
STM R15,R1,TEMPRSAV SAVE VITAL REGS OVER BAL @V305174 01061000
L EXLSTREG,4(,ACEPTR) PRIME REG W/ADDR OF CNTL BLK@V305174 01062000
BAL R14,PROCEXL2 PROCESS EXLST @V305174 01063000
LM R15,R1,TEMPRSAV RESTORE REGS @V305174 01064000
B GENRET GO RETURN TO CALLER @V305174 01065000
SPACE 3 01066000
PTESTCB EQU * @V305174 01067000
L R5,8(,ACEPTR) LOAD POSSIBLE ERET ADDRESS @V305174 01068000
LTR R5,R5 ANY? @V305174 01069000
BZ TIOEQCOM NO, PERFORM NEXT CHECK @V305174 01070000
OI CBMACFLG,ERET SET FLAG @V305174 01071000
ST R5,AERET SAVE ADDRESS @V305174 01072000
L R6,AVIP4 GET ADDR VIP TRAP RTN @V305174 01073000
STCM R6,ALLFOUR,8(ACEPTR) SUB FOR ERET ADD IN HDR ACE@V305174 01074000
TIOEQCOM EQU * @V305174 01075000
CLI BTC,ALLOFF ZERO BLOCK TYPE CODE? @V305174 01076000
BE DOSTCB YES, SKIP @V305174 01077000
* 01078000
* IF THE REQUEST IS TESTCB RPL=..,IO=COMPLETE - 01079000
* A 'NOT EQUAL' RESULT IS UNCONDITIONALLY RETURNED TO THE USER 01080000
* 01081000
LA LISTPTR,4(,LISTPTR) PT TO EACE ADDRESS @V305174 01082000
L ACEPTR,0(,LISTPTR) PT TO EACE @V305174 01083000
CLI 1(ACEPTR),IOEQCOM IO=COMPLETE KEYWORD? @V305174 01084000
BNE DOSTCB NO, GO ISSUE DOS REQUEST @V305174 01085000
TM CBMACFLG,ERET ERET ADDRESS PROVIDED? @V305174 01086000
BZ TCB02 NO @V305174 01087000
BAL R9,RESTERET YES, MUST RESTORE PLIST ENTRY@V305174 01088000
TCB02 NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 01089000
DMSKEY RESET @V305174 01090000
SR R15,R15 CLEAR RETURN CODE REG @V305174 01091000
CLI 1(ACEPTR),WAITING PERFRM UNEQUAL COMPARE TO SET@V305174 01092000
* PSW CONDITION CODE 01093000
TCBEXIT L R14,SAVER14 GET RETURN ADDRESS @V305174 01094000
LM R1,R12,SAVER1 LOAD USER'S REGS @V305174 01095000
BR R14 EXIT @V305174 01096000
SPACE 3 01097000
DOSTCB EQU * @V305174 01098000
BAL R9,LOADTMS GET ADDRESS OF VSAM RTN @V387274 01099100
BAL R9,TMSBALR ISSUE DOS TESTCB @V305174 01100000
* 01101000
* RETURN TO USER BUT PRESERVE THE PSW CONDITION CODE 01102000
* 01103000
BZ CC0 EQUAL @V305174 01104000
BL CC1 LOW @V305174 01105000
BH CC2 HIGH @V305174 01106000
SPACE 2 01107000
DOSTCB02 EQU * @V305174 01108000
TM CBMACFLG,ERET USER PROVIDED ERET? @V305174 01109000
BZ DOSTCB03 NO, SKIP RESTORE @V305174 01110000
BAL R9,RESTERET RESTORE PLIST ENTRY @V305174 01111000
DOSTCB03 NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 01112000
LR R6,R15 SAVE RET CODE REG OVER DMSKEY@V305174 01113000
DMSKEY RESET @V305174 01114000
LR R15,R6 RESTORE REG @V305174 01115000
LA R6,=X'04' ->WK REG TO CONST FOR EX INST@V305174 01116000
SR R5,R5 ZERO WORK REG @V305174 01117000
ICM R5,LOWBYTE,CBMACFLG GET CONDITION CODE FLAG @V305174 01118000
SRL R5,4 POSITION TO BITS 28-31 @V305174 01119000
EX R5,CCSET PERFORM COMPARE TO SET CC @V305174 01120000
B TCBEXIT GO RETURN TO USER @V305174 01121000
SPACE 2 01122000
RESTERET EQU * @V305174 01123000
* RESTORE THE USER'S ERET RTN ADDRESS IN THE TESTCB HEADER ACE 01124000
L LISTPTR,SAVER1 START WITH PLIST ADDRESS @V305174 01125000
L ACEPTR,0(,LISTPTR) POINT TO HEADER ACE @V305174 01126000
MVC 8(4,ACEPTR),AERET PUT BACK SAVED ERET ADDRESS @V305174 01127000
BR R9 RETURN IN-LINE @V305174 01128000
SPACE 2 01129000
CC0 OI CBMACFLG,CCEQUAL PSW CONDITION CODE = 0 @V305174 01130000
B DOSTCB02 BRANCH @V305174 01131000
CC1 OI CBMACFLG,CCLOW PSW CONDITION CODE = 1 @V305174 01132000
B DOSTCB02 BRANCH @V305174 01133000
CC2 OI CBMACFLG,CCHIGH PSW CONDITION CODE = 2 @V305174 01134000
B DOSTCB02 BRANCH @V305174 01135000
CCSET CLI 0(R6),BINZERO EXECUTED INSTRUCTION @V305066 01136000
EJECT 01137000
GENBALR L R15,AIKQGEN LOAD ADDRESS OF VSAM RTN @V305174 01138000
TMSBALR L R1,SAVER1 RESTORE PLIST PTR @V305174 01139000
BALR R14,R15 BRANCH @V305174 01140000
BR R9 RETURN TO IN-LINE PROC @V305174 01141000
DROP ACEPTR @V305174 01142000
SPACE 2 01142100
LOADTMS L R3,AVSAMSYS PT TO VSAM SAVED SYSYEM @V387274 01142200
LA R3,FOUR(,R3) PT TO 1ST PHASE NAME @V387274 01142300
FINDTMS CLC 0(EIGHT,R3),=CL8'IKQVTMS' DR LIVINGSTON? @V387274 01142400
BE EXLTMS YES, I PRESUME @V387274 01142500
LA R3,TWELVE(,R3) NEXT ENTRY @V387274 01142600
B FINDTMS KEEP LOOKING @V387274 01142700
EXLTMS L R15,EIGHT(,R3) GET ADDRESS OF TMS @V387274 01142800
BR R9 RETURN IN-LINE @V387274 01142900
EJECT 01143000
* 01144000
* PROCESS VSAM DATA MANAGEMENT MACROS 01145000
* 01146000
DMREQ EQU * @V305174 01147000
L R6,SAVER0 GET REQUEST CODE @V305174 01148000
LA R5,DOSCODES ->TO TABLE OF DOS EQUIV CODES@V305174 01149000
IC R6,0(R6,R5) MAP OS TO DOS @V305174 01150000
ST R6,SAVER0 STORE CONVERTED CODE IN USER'S R0@V305174 01151000
* 01152000
* 01153000
L RPLREG,SAVER1 LOAD ADDRESS OF RPL @V305174 01154000
CLI SAVER0+3,CHECK CHECK REQUEST (ASYNCHRONOUS)?@V305174 01155000
BE CKPROC YES, SPECIAL HANDLING @V305174 01156000
OI DOSFLAGS,DOSSVC TURN ON DOS SVC BIT @V305174 01157000
DMR2 CLC 0(4,RPLREG),DOSRPL IS RPL IN DOS FORMAT? @V305174 01158000
BE NEXTRPL YES, CHECK FOR RPL CHAINING @V305174 01159000
LA R14,NEXTRPL LOAD BRANCH ADDR FOR BDOSRPL @V305174 01160000
* 01161000
* BUILD DOS RPL IN WORK AREA FROM THE OS RPL & THEN OVERLAY 01162000
* OS WITH DOS 01163000
* 01164000
BDOSRPL XC CBWKAR(LCBWK),CBWKAR CLEAR WORK AREA @V305174 01165000
USING IKQRPL,R11 @V305174 01166000
MVC RPLST(4),DOSRPL ID, SUBTYPE, & LENGTH @V305174 01167000
MVC RPLARG(4),36(RPLREG) PTR TO SEARCH ARG @V305174 01168000
MVC RPLAREA(4),32(RPLREG) ADDR OF WORK AREA @V305174 01169000
MVC RPLRLEN(4),48(RPLREG) RECORD LENGTH @V305174 01170000
MVC RPLBUFL(4),52(RPLREG) BUFFER LENGTH @V305174 01171000
MVC RPLACB(4),24(RPLREG) PTR TO ACB @V305174 01172000
MVC RPLSTRID(1),19(RPLREG) CCW STG ID (OS = 2 BYTES)@V305174 01173000
MVC RPLKEYL(2),16(RPLREG) KEY LENGTH @V305174 01174000
MVC RPLCHAIN(4),44(RPLREG) PTR TO NEXT RPL @V305174 01175000
* 01176000
* NOW MAP THE OPTION BYTES 01177000
* ALSO SAVE THE ECB ADDR (LOCATED AT OS RPL+8), IF ANY 01178000
* 01179000
USING VIPWORK,R11 @V305174 01180000
SR R7,R7 CLEAR WORK REG @V305174 01181000
LA R6,TWO LOAD SEARCH INCREMENT @V305066 01182000
LA R5,OPTTAB POINT TO DOS OPT CODE TABLE @V305174 01183000
ICM R7,HIGHTWO,40(RPLREG) OS OPTN BYTES INTO HI-ORD @V305174 01184000
* 1ST TIME- CHECK BIT 0, LOC MODE 01185000
BNM NEXTOPT NOT ON, SKIP DOS TURN ON @V305174 01186000
DOSOPMAP OC WKMISC(2),0(R5) MAP OS TO EQUIV DOS BIT @V305174 01187000
NEXTOPT AR R5,R6 BUMP TABLE POINTER @V305174 01188000
BXLE R7,R7,DOSOPMAP MAP EQV DOS IF NXT OS BIT ON @V305174 01189000
LTR R7,R7 FINISHED? @V305174 01190000
BNZ NEXTOPT NO, CONTINUE @V305174 01191000
USING IKQRPL,R11 @V305174 01192000
MVC RPLOPT1(2),LCBWK-4(R11) MOVE OPT BYTES->DOS RPL @V305174 01193000
* INSURE THAT THE UPDATE-NO UPDATE BITS ARE IN BALANCE 01194000
TM RPLOPT1,RPLUPD UPDATE? @V305174 01195000
BO TECB YES, LEAVE NO UPDATE OFF @V305174 01196000
OI RPLOPT2,RPLNUP NO, FLIP NO UPDATE ON @V305174 01197000
* TURN ON RPLFLAG BIT 0 (ECB INDICATOR) IF OS OPT BYTE 1, BIT 7, IS ON 01198000
TECB TM 40(RPLREG),HEX01 OS RPLECB FIELD HAVE ECB ADDR?@V305174 01199000
BZ MOVERPL NO SKIP EXTRA TURN-ON @V305174 01200000
OI RPLFLAG,RPLECBPR INDIC EQUIV DOS FLAG @V305174 01201000
MVC RPLECB,8(RPLREG) ECB ADDR SAVED AT END OF RPL @V305174 01202000
MOVERPL MVC 0(56,RPLREG),RPLST OVERLAY OS RPL WITH DOS @V305174 01203000
BR R14 EXIT @V305174 01204000
USING VIPWORK,R11 @V305174 01205000
NEXTRPL EQU * @V305174 01206000
USING IKQRPL,RPLREG @V305174 01207000
L RPLREG,RPLCHAIN GET PTR TO NEXT RPL @V305174 01208000
LA R1,0(R1) CLEAR HI ORDER BYTE @VA06127 01208500
LTR RPLREG,RPLREG ANY? @V305174 01209000
BNZ DMR2 YES, FORMAT TO DOS IF NEC @V305174 01210000
* 01211000
* BALR TO DOS VSAM REQUEST ROUTINE 01212000
* 01213000
* FIRST DETERMINE IF ASYNCHRONOUS PROC IS DESIRED 01214000
* 01215000
L RPLREG,SAVER1 RESTORE PTR TO RPL @V305174 01216000
TM RPLOPT1,RPLASY ASYNCHRONOUS? @V305174 01217000
BZ VSAMREQ NO, CAN ISSUE DATAMGT REQ NOW@V305174 01218000
* 01219000
* FOR ASYNCHRONOUS PROCESSING, ALL ACTIVE EXIT RTNS ARE SET INACTIVE 01220000
* WITH THE EXCEPTION OF THE JRNAD EXIT (WHICH IS NOT AN ERROR EXIT AND 01221000
* ALWAYS RETURNS CONTROL TO VSAM). 01222000
* THIS PRECLUDES VSAM TAKING AN ERROR EXIT AND ENABLES VIP TO DEFER 01223000
* ANY POSSIBLE EXIT RTN BRANCH UNTIL THE USER ISSUES A CHECK REQUEST 01224000
* FOR THE RPL. AT CHECK TIME, THE RPL FEEDBACK FIELD INDICATES 01225000
* WHETHER OR NOT AN ERROR EXIT IS WARRANTED. 01226000
* 01227000
* NOTE THAT ONLY 1 EXLST IS PROCESSED REGARDLESS OF WHETHER OR 01228000
* NOT RPL'S HAVE BEEN CHAINED. SINCE CHAINED RPL'S MAY ONLY POINT 01229000
* TO ONE DATA SET (I.E., ONE ACB), ONLY A SINGLE EXLST IS INVOLVED. 01230000
* DOS VSAM (IKQVSM, IKQERH) WILL FLAG AS AN ERROR ANY CHAINED RPL'S 01231000
* NOT HAVING THE SAME ACB. 01232000
* 01233000
* AFTER VSAM RETURNS CONTROL FROM THE DATA MGT REQUEST, THE EXLST 01234000
* ACTIVE BITS ARE RESET AND ANY RETURN CODE IN REGISTER 15 IS 01235000
* CLEARED. 01236000
* 01237000
L ACBREG,RPLACB GET PTR TO ACB @V305174 01238000
USING IKQACB,ACBREG @V305174 01239000
MVI VIPINDC,ALLOFF CLEAR INDICATOR FIELD @V305174 01240000
L EXLSTREG,ACBEXLST GET PTR TO EXLST @V305174 01241000
LTR EXLSTREG,EXLSTREG ANY? @V305174 01242000
BZ VSAMREQ NO, SKP EXLST ACTIVE BITS MSG@V305174 01243000
USING IKQEXLST,EXLSTREG @V305174 01244000
CLI EXLLEN+1,EXLEODL EXLST ONLY CONTAINS EODAD? @V305174 01245000
BE CLEAREOD YES, TEST EODAD ACT BIT ONLY @V305174 01246000
CLI EXLLEN+1,EXLSYNL SYNAD AND (POSSIBLE) EODAD? @V305174 01247000
BE CLEARSYN YES, NO LERAD WORK THIS TIME @V305174 01248000
TM EXLLERF,EXENACTB ACTIVE LERAD? @V305174 01249000
BZ CLEARSYN NO, ON TO THE NEXT BIT @V305174 01250000
OI VIPINDC,SETLERAD SET INDICATOR BIT @V305174 01251000
NI EXLLERF,INACTIVE TURN OFF 'ENTRY ACTIVE' BIT @V305174 01252000
CLEARSYN TM EXLSYNF,EXENACTB ACTIVE SYNAD? @V305174 01253000
BZ CLEAREOD NO, ONE MORE TO GO @V305174 01254000
OI VIPINDC,SETSYNAD SET INDICATOR BIT @V305174 01255000
NI EXLSYNF,INACTIVE TURN OFF 'ENTRY ACTIVE' BIT @V305174 01256000
CLEAREOD TM EXLEODF,EXENACTB ACTIVE EODAD? @V305174 01257000
BZ VSAMREQ NO, ON TO VSAM @V305174 01258000
OI VIPINDC,SETEODAD SET INDICATOR BIT @V305174 01259000
NI EXLEODF,INACTIVE TURN OFF 'ENTRY ACTIVE' BIT @V305174 01260000
* 01261000
VSAMREQ LM R0,R1,SAVER0 RELOAD REQ TYPE AND RPL ADDR @V305174 01262000
L R15,AIKQVSM LOAD ADDRESS OF VSAM ROUTINE @V305174 01263000
BALR R14,R15 BRANCH TO DOS VSAM @V305174 01264000
NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 01265000
* 01266000
* MAP ERROR CODES FROM DOS TO OS IF NECESSARY 01267000
* 01268000
L RPLREG,SAVER1 RESTORE PTR TO RPL @V305174 01269000
LR R7,R15 SAVE RET CODE OVER E-MAP BR @V305174 01270000
MAPERR L R15,ADMEMAP LOAD BRANCH ADDRESS @V305174 01271000
BALR R14,R15 GO MAP ERRORS @V305174 01272000
* 01273000
L RPLREG,RPLCHAIN GET PTR TO NEXT RPL @V305174 01274000
LTR RPLREG,RPLREG ANY MORE ON CHAIN? @V305174 01275000
BO MAPERR YES, DO ANY NEC MAPPING @V305174 01276000
L RPLREG,SAVER1 PT AGAIN TO 1ST RPL @V305174 01277000
TM RPLOPT1,RPLASY ASYNCHRONOUS REQUEST? @V305174 01278000
BO PRASY YES, SPECIAL HANDLING @V305174 01279000
L R15,AECBPOST GET ADDRESS OF ECB POST RTN @V305174 01280000
BALR R14,R15 GO SET UP ECB(S) @V305174 01281000
B DMREQRTN NOW EXIT @V305174 01282000
* 01283000
* ASYNCHRONOUS - 01284000
* SET 'WAITING' FLAG ON FOR ANY ECB'S 01285000
* RESTORE EXIT ROUTINE FLAGS TO 'ACTIVE' STATUS WHERE NEC 01286000
* 01287000
PRASY EQU * @V305174 01288000
TM RPLFLAG,RPLECBPR ECB FOR THIS RPL? @V305174 01289000
BZ ASYECB NO, CONTINUE ALONG CHAIN @V305174 01290000
L R8,RPLECB GET PTR TO ECB @V305174 01291000
XC 0(4,R8),0(R8) CLEAR ECB @V305174 01292000
MVI 0(R8),WAITING SET 'WAITING' BIT @V305174 01293000
ASYECB L RPLREG,RPLCHAIN PT TO NEXT RPL @V305174 01294000
LTR RPLREG,RPLREG ANY? @V305174 01295000
BO PRASY YES, CHECK IT OUT @V305174 01296000
L RPLREG,SAVER1 ELSE DONE, RESTOR 1ST RPL PTR@V305174 01297000
* 01298000
SR R7,R7 CLEAR TEMP RETURN CODE REG @V305174 01299000
CLI VIPINDC,ALLOFF ANY FLAGS SET INACTIVE? @V305174 01300000
BE DMREQRTN NO, SKIP THIS EXERCISE @V305174 01301000
TM VIPINDC,SETEODAD EODAD? @V305174 01302000
BZ TSYN NO, NEXT @V305174 01303000
OI EXLEODF,EXENACTB RESTORE EODAD TO ACTIVE DUTY @V305174 01304000
TSYN TM VIPINDC,SETSYNAD SYNAD? @V305174 01305000
BZ TLER NO, NEXT @V305174 01306000
OI EXLSYNF,EXENACTB RESTORE SYNAD TO ACTIVE DUTY @V305174 01307000
TLER TM VIPINDC,SETLERAD LERAD? @V305174 01308000
BZ DMREQRTN NO, BRANCH AROUND RESTORE @V305174 01309000
OI EXLLERF,EXENACTB RESTORE LERAD TO ACTIVE DUTY @V305174 01310000
SPACE 2 01311000
* RETURN TO CALLER 01312000
DMREQRTN DMSKEY RESET @V305174 01313000
LR R15,R7 LOAD RETURN CODE @V305174 01314000
L R14,SAVER14 GET USER RETURN ADDRESS @V305174 01315000
LM R2,R12,SAVER2 RESTORE USER'S REGS @V305174 01316000
BR R14 EXIT @V305174 01317000
EJECT 01318000
*********************************************************************** 01319000
* * 01320000
* CHECK PROCESSING (ASYNCHRONOUS SIMULATION) * 01321000
* * 01322000
* R1 = ADDRESS OF RPL * 01323000
* * 01324000
* FIRST, ALL ECB'S ARE POSTED WITH THE PROPER COMPLETION CODE. * 01325000
* * 01326000
* THEN, THE RPL FEEDBACK FIELD IS EXAMINED FOR THE RETURN CODE FROM * 01327000
* THE PREVIOUS I/O OPERATION ON THE VSAM DATA SET. THIS INFORMATION * 01328000
* IS STORED BY VSAM (AFTER ORIG GET, PUT, ETC REQ) SINCE CMS PROC * 01329000
* IS SYNCHRONOUS AND I/O IS COMPLETED BEFORE CONTROL IS RETURNED. * 01330000
* * 01331000
* PROCESSING CONTINUES FOR EACH RPL (IN THE CASE OF CHAINED REQUESTS). 01332000
* IF AN ERROR IS FOUND, THE RPL CONTAINING THE ERROR IS THE LAST * 01333000
* ONE PROCESSED. * 01334000
* * 01335000
* CONTROL IS EITHER PASSED TO AN ACTIVE EXIT ROUTINE (AS INDICATED BY* 01336000
* THE RETURN CODE IN THE RPL), OR BACK TO THE USER. * 01337000
* * 01338000
*********************************************************************** 01339000
CKPROC EQU * @V305174 01340000
L R15,AECBPOST GET ADDRESS OF ECB POST RTN @V305174 01341000
BALR R14,R15 RESET ANY ECB'S FRM 'WAITING'@V305174 01342000
* TO 'COMPLETE' 01343000
MVI RTNCDSV,ALLOFF INIT RETURN CODE WORK SAVE @V305174 01344000
CKPROC2 EQU * @V305174 01345000
CLC RPLRTNCD,RTNCDSV HIGHEST RET CODE SO FAR? @V305174 01346000
BL CKRCODE NO, SKIP UPDATE @V305174 01347000
MVC RTNCDSV,RPLRTNCD SAVE FOR RETURN TO USER @V305174 01348000
CKRCODE EQU * @V305174 01349000
CLI RPLRTNCD,RC04 EXAMINE PREV I/O RETURN CODE @V305066 01350000
BNH CKRET 0 OR 4, RET TO CALLER IF LAST RPL@V305174 01351000
L ACBREG,RPLACB GET PTR TO ACB @V305174 01352000
L EXLSTREG,ACBEXLST GET PTR TO EXLST @V305174 01353000
LTR EXLSTREG,EXLSTREG ANY? @V305174 01354000
BZ CKRET2 NO, FORGET POSS BR TO EXIT RTN@V305174 01355000
CLI RPLRTNCD,LOGERR LOG ERRO ENCOUNT DURING I/O? @V305174 01356000
BNE LOCASYN NO, PHYS ERR-FIND ACT SYNAD @V305174 01357000
* 01358000
* LOGICAL ERROR HERE MAY HAVE BEEN CAUSED BY AN END OF FILE 01359000
* CONDITION- IF SO, CONTROL IS PASSED TO THE EODAD ROUTINE IF AN 01360000
* ACTIVE ONE EXISTS. 01361000
* 01362000
CLI RPLFDBKC,RPLEOFDS REACHED END OF FILE? @V305174 01363000
BNE LOCALER NO, GO FIND AN ACTIVE LERAD @V305174 01364000
TM EXLEODF,EXENACTB IS THE EODAD ACTIVE? @V305174 01365000
BZ LOCALER NO, THEN TRY FOR LERAD @V305174 01366000
* FOUND ACTIVE EODAD EXIT ROUTINE 01367000
ICM R7,ALLFOUR,EXLEODP LOAD ADDR OF RTN INTO TEMP @V305174 01368000
* (ACTUALLY, DMSVIP3 ADDRESS) 01369000
B EXRTNBR GO BALR TO RTN @V305174 01370000
LOCALER EQU * @V305174 01371000
CLI EXLLEN+1,EXLLERL EXLST MIN LENGTH FOR LERAD? @V305174 01372000
BL CKRET2 NO, CAN BAIL OUT NOW @VM03054 01373000
TM EXLLERF,EXENACTB LERAD ACTIVE? @V305174 01374000
BZ CKRET2 INACTIVE- EXIT @V305174 01375000
* FOUND ACTIVE LERAD ROUTINE 01376000
ICM R7,ALLFOUR,EXLLERP LOAD EXIT RTN ADDR INTO TEMP@V305174 01377000
B EXRTNBR GO BALR TO RTN @V305174 01378000
LOCASYN EQU * @V305174 01379000
CLI EXLLEN+1,EXLSYNL EXLST MIN LENGTH FOR SYNAD? @V305174 01380000
BL CKRET2 NO, CAN BAIL OUT NOW @VM03054 01381000
TM EXLSYNF,EXENACTB SYNAD ACTIVE? @V305174 01382000
BZ CKRET2 INACTIVE- EXIT @V305174 01383000
*FOUND ACTIVE SYNAD ROUTINE 01384000
ICM R7,ALLFOUR,EXLSYNP LOAD EXIT RTN ADDR INTO TEMP@V305174 01385000
B EXRTNBR GO BALR TO RTN @V305174 01386000
CKRET EQU * @V305174 01387000
L RPLREG,RPLCHAIN GET ADDRESS OF NEXT RPL @V305174 01388000
LTR RPLREG,RPLREG ANY? @V305174 01389000
BO CKPROC2 YES, KEEP GOING @V305174 01390000
CKRET2 EQU * @V305174 01391000
SR R6,R6 CLEAR TEMP RETURN CODE REG @V305174 01392000
ICM R6,LOWBYTE,RTNCDSV INSERT RETURN CODE @V305174 01393000
* 01394000
DMSKEY RESET @V305174 01395000
LR R15,R6 LOAD RETURN CODE @V305174 01396000
L R14,SAVER14 GET RETURN ADDRESS @V305174 01397000
LM R2,R12,SAVER2 RESTORE USER'S REGS @V305174 01398000
BR R14 EXIT @V305174 01399000
EXRTNBR EQU * @V305174 01400000
LR R15,R7 ADDRESS IN BRANCH REG @V305174 01401000
BALR R14,R15 PASS CONTROL TO USER EXIT @V305174 01402000
* 01403000
* IF THE USER 'RETURNS TO VSAM', CONTROL IS PASSED BACK TO THE POINT 01404000
* IMMEDIATELY FOLLOWING THE 'CHECK' REQUEST, WITH THE RPL RETURN CODE 01405000
* IN REGISTER 15. 01406000
* 01407000
* NOTE THAT THE REGISTERS ARE NO LONGER RELIABLE SINCE THE USER 01408000
* MAY HAVE ALTERED THEM DURING EXIT PROCESSING. 01409000
* 01410000
L R11,AVIPWORK ADDRESS WORK AREA @V305174 01411000
L RPLREG,VIP3R1 RESTOR PTR TO RPL (SAVED BY VIP3)@V305174 01412000
DMSKEY RESET RESET STORAGE KEY @V305174 01413000
SR R15,R15 CLEAR RET CODE REG @V305174 01414000
ICM R15,LOWBYTE,RPLRTNCD INSERT RETURN CODE @V305174 01415000
L R14,SAVER14 GET RETURN ADDRESS @V305174 01416000
LM R2,R12,SAVER2 RESTORE USER'S REGS @V305174 01417000
BR R14 EXIT @V305174 01418000
DROP RPLREG,ACBREG,EXLSTREG @V305174 01419000
EJECT 01420000
*********************************************************************** 01421000
* * 01422000
* ENTRY TO THIS CODE INDICATES THAT DOS VSAM HAS TRIED TO ENTER * 01423000
* A USER-SPECIFIED EXIT ROUTINE. THE DOS SVC BIT IS TURNED OFF, * 01424000
* AND THE HI-ORDER BYTE OF REG 15 IS USED TO LOCATE THE PROPER * 01425000
* EXIT ROUTINE ADDRESS THAT HAS BEEN SAVED PREVIOUSLY BY VIP. * 01426000
* * 01427000
* IN ADDITION, DOS ERROR CODES ARE MAPPED TO OS EQUIVALENTS WHERE * 01428000
* NECESSARY. * 01429000
* * 01430000
* REGISTERS UPON ENTRY: * 01431000
* * 01432000
* R1 - ADDRESS OF RPL (EODAD, LERAD, SYNAD) * 01433000
* ADDRESS OF PARAM LIST (JRNAD) * 01434000
* * 01435000
* R15 - VIP3 ENTRY ADDRESS, HI-ORDER = INDEX TO TABLE OF * 01436000
* SAVED EXIT ROUTINE ADDRESSES * 01437000
* * 01438000
* CONTROL IS THEN PASSED DIRECTLY TO THE OS EXIT ROUTINE. * 01439000
* * 01440000
*********************************************************************** 01441000
VIP3PROC EQU * @V305174 01442000
BALR R12,R0 @V305174 01443000
USING *,R12 @V305174 01444000
USING OEXLSA,R10 BLOCK ADDRESSABILITY @V305174 01445000
L R11,AVIPWORK ADDRESS WORK AREA @V305174 01446000
STM R14,R15,VIP3R14 SAVE REGS @V305174 01447000
ST R1,VIP3R1 R1 TOO @V305174 01448000
MVC VIP3R213(48),SAVER2 SAVE REGS IN CASE EXIT RTN @V305174 01449000
* ISSUES ANY C B MANIP MACROS 01450000
LA R10,EXLSA LOAD BASE FOR PRIM EXIT LIST @V305174 01451000
* ADDRESS SAVE BLOCK 01452000
NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 01453000
* 01454000
* BALR TO DMEMAP FOR ANY NEC ERROR CODE MAPPING 01455000
* 01456000
L R15,ADMEMAP LOAD BRANCH ADDRESS @V305174 01457000
L RPLREG,VIP3R1 GET VSAM'S R1 @V305174 01458000
CLC 0(4,RPLREG),DOSRPL PT'NG. TO RPL OR PARAM LIST? @V305174 01459000
BNE FINDEXR IT'S A JRNAD, SKP ERRMAP PROC@V305174 01460000
BALR R14,R15 RPL, BRANCH @V305174 01461000
* 01462000
* USING THE HI-ORDER BYTE OF R15, FIND THE CORRECT 01463000
* EXIT ROUTINE ADDRESS AND BRANCH TO THE USER'S CODE. 01464000
* 01465000
FINDEXR MVC EXLMISC(1),VIP3WORK MVE NDX(R15 HI-ORD)->WK AREA@V305174 01466000
NI EXLMISC,255-HION TURN OFF PROCESS BIT @V305174 01467000
* GO TO CORRECT BLOCK 01468000
L R5,EXLMISC @V305174 01469000
SRA R5,28 POSITION BLOCK NUMBER @V305174 01470000
* EXIT RTN IN PRIMARY? 01471000
BZ WORD YES, GO POS TO CORRECT WORD @V305174 01472000
PROC2 L R10,ANOEXL ADDRESS NEXT OVERFLOW BLOCK @V305174 01473000
BCT R5,PROC2 ON TO NEXT BLOCK OR DONE @V305174 01474000
* GET WORD NUM 01475000
WORD L R5,EXLMISC RE-LOAD INDEX INTO REG @V305174 01476000
SLL R5,4 @V305174 01477000
SRL R5,28 GET WORD NUMBER @V305174 01478000
SLL R5,2 *4 FOR DISPLACEMENT @V305174 01479000
MVC VIP3WORK,SAVER14 NOW USE WK CELL TO SAVE ORIG @V305174 01480000
* REG 14 IN CASE OF EXIT RTN C B MACRO 01481000
* ACTIVITY 01482000
DMSKEY RESET @V305174 01483000
L R15,0(R5,R10) LOAD EXIT RTN ADDRESS @V305174 01484000
L R1,VIP3R1 RESTORE VSAM'S R1 @V305174 01485000
LM R2,R12,SAVER2 GIVE USER BACK ORIG R2-R12 @V305174 01486000
BALR R14,R15 EXIT @V305174 01487000
DROP R10,R12 @V305174 01488000
EJECT 01489000
*********************************************************************** 01490000
* * 01491000
* ENTRY TO THIS CODE MEANS THAT A USER EXIT ROUTINE HAS COMPLETED * 01492000
* PROCESSING AND HAS OPTED TO RETURN TO VSAM. THE DOS SVC BIT IS * 01493000
* TURNED ON AND THE RETURN ADDRESS TO VSAM IS RECOVERED FROM THE * 01494000
* SAVE CELL IN VIPWORK. * 01495000
* * 01496000
* * 01497000
* CONTROL IS PASSED BACK TO VSAM. * 01498000
* * 01499000
*********************************************************************** 01500000
SPACE 2 01501000
DMSKEY NUCLEUS RESTORE NUCLEUS KEY @V305174 01502000
OI DOSFLAGS,DOSSVC TURN ON DOS SVC FLAG @V305174 01503000
L R14,AVIPWORK ADDRESS WORK AREA @V305174 01504000
USING VIPWORK,R14 @V305174 01505000
MVC SAVER14,VIP3WORK REPLACE ORIGINAL RET ADDRESS @V305174 01506000
MVC SAVER2(48),VIP3R213 RESTORE REGS TO THOSE AT @V305174 01507000
* TIME OF DATA MGT REQUEST MACRO 01508000
L R15,VIP3R14 LOAD VSAM'S ADDRESS @V305174 01509000
BR R15 EXIT @V305174 01510000
DROP R14 @V305174 01511000
EJECT 01512000
*********************************************************************** 01513000
* * 01514000
* ERROR MAPPING ROUTINES * 01515000
* * 01516000
*********************************************************************** 01517000
* * 01518000
* OPNEMAP - * 01519000
* * 01520000
* REGS UPON ENTRY: * 01521000
* * 01522000
* R1 = ADDRESS OF USER'S OPEN PLIST * 01523000
* R14 = CALLER'S RETURN ADDRESS * 01524000
* R15 = ENTRY ADDRESS * 01525000
* * 01526000
* ADDR OF DMSVIP2 IS STORED AT ACB+8 FOR ALL SUCCESSFULLY OPENED ACB'S 01527000
* * 01528000
* DMEMAP - * 01529000
* * 01530000
* REGS UPON ENTRY: * 01531000
* * 01532000
* R1 = ADDRESS OF RPL * 01533000
* R14 = CALLER'S RETURN ADDRESS * 01534000
* R15 = ENTRY ADDRESS * 01535000
* * 01536000
* DMEMAP MAPS ONLY A SINGLE RPL (NO CHAIN SEARCH PERFORMED) * 01537000
* * 01538000
*********************************************************************** 01539000
OPNEMAP EQU * @V305174 01540000
USING *,R15 @V305174 01541000
USING IKQACB,ACBREG @V305174 01542000
OPNE2 L ACBREG,0(,R1) POINT TO CONTROL BLOCK @V305174 01543000
CLI 0(ACBREG),ACBIDD IS IT AN ACB OR DCB @V305174 01544000
BE OPNE3 ACB, GO LOOK FOR MAPPING WORK@V305174 01545000
CKLAST TM 0(R1),LAST LAST ADDRESS IN PLIST? @V305174 01546000
BCR ONES,R14 YES, RETURN TO CALLER @V305174 01547000
LA R1,4(,R1) NO, POINT TO NEXT @V305174 01548000
B OPNE2 AROUND AGAIN @V305174 01549000
OPNE3 TM ACBOFLGS,ACBOPEN WAS THIS ACB OPENED SUC'FLLY?@V305174 01550000
BZ TOCEXT NO, SCAN FOR MAPPABLE ERRORS @V305174 01551000
MVC ACBAM0,AVIP2 VIP ENTRY ADDR INTO PTR FLD @V305174 01552000
CLI ACBERFLG,NOERR ANY ERROR RETURN CODES? @V305174 01553000
BE CKLAST NO, GO CHECK IF FINISHED @V305174 01554000
TOCEXT CLI ACBERFLG,ACBOCEXT VOLSER CATALOG/EXTENT MIXUP? @V305174 01555000
BNE TOEMPT NO, CONTINUE TEST SCAN @V305174 01556000
MVI DOSRC,LOGERR SET RETURN CODE @V305174 01557000
L R15,ADOSEPRO GET ADDRESS OF ERROR RTN @V305174 01558000
BR R15 AND HEAD FOR EOJ @V305174 01559000
TOEMPT CLI ACBERFLG,ACBOEMPT EMPTY DATASET OPEN FOR INPUT?@V305174 01560000
BNE TOKBUF NO, CONTINUE TEST SCAN @V305174 01561000
LA R3,CON160 LOAD OS EQUIV (X'A0') @V305066 01562000
B MOVECODE GO CONVERT ACB ERR FLAG TO OS@V305174 01563000
TOKBUF CLI ACBERFLG,ACBOKBUF USER BUFS NOT CONT INT ACC? @V305174 01564000
BNE TOCTER NO, CONTINUE TEST SCAN @V305174 01565000
LA R3,CON160 LOAD OS EQUIV (X'A0') @V305066 01566000
B MOVECODE GO CONVERT ACB ERR FLAG TO OS@V305174 01567000
TOCTER CLI ACBERFLG,ACBOCTER UNEXPECTED ERROR DET BY DOS? @V305174 01568000
BNE CKLAST GO CHECK IF DONE @V305174 01569000
LA R3,CON144 LOAD OS EQUIV (X'90') @V305066 01570000
MOVECODE EQU * @V305174 01571000
EX R3,MVIERR OS CODE INTO ACB ERROR FLAG @V305174 01572000
B CKLAST GO CHECK IF DONE @V305174 01573000
MVIERR MVI ACBERFLG,BINZERO EXECUTED INSTRUCTION @V305066 01574000
DROP ACBREG,R15 @V305174 01575000
SPACE 2 01576000
DMEMAP EQU * @V305174 01577000
USING *,R15 @V305174 01578000
USING IKQRPL,RPLREG @V305174 01579000
CLI RPLFDBKC,RPLVLERR INTERNAL VSAM LOGIC ERROR? @V305174 01580000
BNE DME2 NO, CK FOR CATLG ACCESS ERROR@V305174 01581000
LA R3,ABEND52 LOAD ABEND CODE @V305066 01582000
B BABN BRANCH AROUND @V305174 01583000
DME2 CLI RPLFDBKC,RPLCAERR I/O ERR DURING CATLG ACCESS? @V305174 01584000
BCR NOTEQ,R14 NO, RETURN TO CALLER @V305174 01585000
LA R3,ABEND56 LOAD ABEND CODE @V305066 01586000
BABN L R15,AABEND LOAD ADDRESS OF ABEND RTN @V305174 01587000
BR R15 GO ISSUE ABEND @V305174 01588000
DROP RPLREG,R15 @V305174 01589000
EJECT 01590000
*********************************************************************** 01591000
* * 01592000
* ECBPOST - ECB POSTING ROUTINE * 01593000
* * 01594000
* REGS UPON ENTRY: * 01595000
* * 01596000
* R1 = PTR TO RPL * 01597000
* R14 = CALLER'S RETURN ADDRESS * 01598000
* R15 = ENTRY ADDRESS * 01599000
* * 01600000
* EACH RPL IN THE CHAIN (IF CHAINING HAS BEEN DONE) IS PROCESSED. * 01601000
* THE ECB IS POSTED WITH THE APPROPRIATE COMPLETION CODE: * 01602000
* * 01603000
* X'7F' - THE EVENT HAS COMPLETED SUCCESSFULLY * 01604000
* X'41' - I/O OPERATION HAS RESULTED IN A PHYSICAL ERROR * 01605000
* X'42' - LOGICAL ERROR DETECTED DURING I/O * 01606000
* * 01607000
*********************************************************************** 01608000
ECBPOST EQU * @V305174 01609000
USING *,R15 @V305174 01610000
USING IKQRPL,RPLREG @V305174 01611000
TM RPLFLAG,RPLECBPR ECB FOR THIS RPL? @V305174 01612000
BZ POSTNEXT NO, SEE IF CHAIN CONTINUES @V305174 01613000
L R8,RPLECB GET PTR TO ECB @V305174 01614000
XC 0(4,R8),0(R8) CLEAR ECB @V305174 01615000
CLI RPLRTNCD,LOGERR LOGICAL ERROR? @V305174 01616000
BH POST41 NO, PHYSICAL @V305174 01617000
BE POST42 YES @V305174 01618000
MVI 0(R8),COMPLETE INDIC SUCCESSFUL COMPLETION @V305174 01619000
B POSTNEXT GET NEXT @V305174 01620000
POST41 MVI 0(R8),UNITCHCK INDIC PHYSICAL ERROR @V305174 01621000
B POSTNEXT GET NEXT @V305174 01622000
POST42 MVI 0(R8),LOGIC INDIC LOGICAL ERROR @V305174 01623000
POSTNEXT EQU * @V305174 01624000
L RPLREG,RPLCHAIN PT TO NEXT RPL ON CHAIN @V305174 01625000
LTR RPLREG,RPLREG ANY? @V305174 01626000
BO ECBPOST YES, PROCESS POSSIBLE ECB @V305174 01627000
L RPLREG,SAVER1 RESTORE PTR TO 1ST RPL @V305174 01628000
BR R14 RETURN @V305174 01629000
DROP RPLREG,R15 @V305174 01630000
EJECT 01631000
*********************************************************************** 01632000
* * 01633000
* DMSVIP4 - * 01634000
* * 01635000
* THE VSAM TESTCB RTN (IKQTMS) WAS UNABLE TO PERFORM THE REQUESTED * 01636000
* OPERATION AND HAS TAKEN AN ERROR EXIT TO THE USER ERET ROUTINE. * 01637000
* * 01638000
* THE DOS SVC BIT IS TURNED OFF AND THE ADDRESS OF THE ERET RTN IS * 01639000
* RECOVERED FROM THE VIP WORK AREA. * 01640000
* * 01641000
* CONTROL IS PASSED DIRECTLY TO THE USER'S ERET. * 01642000
* * 01643000
* NOTE - THE ERET ROUTINE MUST NOT RETURN TO VSAM AFTER PROCESSING! * 01644000
* * 01645000
*********************************************************************** 01646000
DMSVIP4 EQU * @V305174 01647000
L R11,AVIPWORK ADDRESS WORK AREA @V305174 01648000
* RESTORE THE ERET RTN ADDRESS TO THE TESTCB HEADER ACE 01649000
L LISTPTR,SAVER1 START WITH PLIST ADDRESS @V305174 01650000
L ACEPTR,0(,LISTPTR) POINT TO HEADER ACE @V305174 01651000
MVC 8(4,ACEPTR),AERET PUT BACK SAVED ERET ADDRESS- @V305174 01652000
* USER MAY RE-USE PLIST 01653000
NI DOSFLAGS,DOSOFF TURN OFF DOS SVC BIT @V305174 01654000
LR R6,R15 SAVE R15 OVER DMSKEY @V305174 01655000
DMSKEY RESET @V305174 01656000
LR R15,R6 RESTORE @V305174 01657000
L R14,AERET LOAD ADDRESS OF ERET @V305174 01658000
LM R1,R12,SAVER1 GET USER'S REGS @V305174 01659000
BR R14 EXIT TO ERET @V305174 01660000
EJECT 01661000
*********************************************************************** 01662000
* * 01663000
* CMS/DOS ERROR PROCESSING ROUTINES * 01664000
* * 01665000
*********************************************************************** 01666000
* * 01667000
* ASGNERR - ERROR DETECTED DURING ASSGN FOR OS USER * 01668000
* * 01669000
* DOSEPRO - DOS ERROR PROCESSING * 01670000
* * 01671000
* REGS UPON ENTRY: * 01672000
* * 01673000
* R8 = ENTRY ADDRESS * 01674000
* R9 = CALLER'S RETURN ADDRESS * 01675000
* * 01676000
* THIS ROUTINE IS CALLED AFTER EACH ISSUANCE OF A DOS SVC 2 (OPEN, * 01677000
* CLOSE,TCLOSE). * 01678000
* * 01679000
* IF THE DOS RETURN CODE INDICATES THAT AN ERROR HAS OCCURRED, * 01680000
* THE SYSTEM SVC SAVE AREA STACK IS SEARCHED AND CLEARED * 01681000
* UNTIL THE LATEST OUTSTANDING CMS SVC IS LOCATED. CONTROL * 01682000
* IS THEN PASSED TO CMS AND THE JOB IS TERMINATED. * 01683000
* * 01684000
* CONTROL IS RETURNED TO THE USER IF NO ERROR HAS BEEN DETECTED * 01685000
* BY CMS/DOS (DOSEPRO ONLY). * 01686000
* * 01687000
*********************************************************************** 01688000
ASGNERR EQU * @V305174 01689000
STCM R15,LOWBYTE,DOSRC SAVE RETURN CODE @V305174 01690000
DOSEPRO EQU * @V305174 01691000
CLI DOSRC,ALLOFF GOOD RETURN CODE FROM DOS? @V305174 01692000
BCR EQ,R9 YES, NORMAL RETURN TO USER @V305174 01693000
DMSKEY RESET RESET STOR KEY FOR USER @V305174 01694000
SPACE 2 01695000
EOJ1 BALR R9,R0 ADDRESSABILITY @V305174 01696000
USING *,R9 @V305174 01697000
L R13,CURRSAVE GET CURRENT SAVE POINTER @V305174 01698000
USING SSAVE,R13 @V305174 01699000
TM TYPFLAG,TPFSVO CMS SVC? @V305174 01700000
BZ EOJ2 YES, HEAD FOR CMS LAND @V305174 01701000
L R2,AEOJ1 GET COME-BACK ADDRESS @VM03028 01702000
DMSEXS ST,R2,OLDPSW+4 AND SAVE AS OLD PSW @VM03028 01703000
DMSEXS NI,OLDPSW+1,RESET RESET PSW STORAGE KEY @VM03028 01704000
SR R15,R15 CLEAR REG 15 @V305174 01705000
L R14,AOSRET GET OS RET ADDRESS @V305174 01706000
BR R14 CLR SVC SAVE STK FOR THIS SVC@V305174 01707000
* AND COME BACK TO EOJ1 01708000
SPACE 2 01709000
EOJ2 EQU * @V305174 01710000
ICM R13,ALLFOUR,SSAVEPRV TAKE A PEEK AT PREVIOUS @VM03028 01711000
BZ REALEOJ NONE, THIS IS THE END OF THE LINE@VM03028 01712000
CLC CALLEE,NAMEXEC EXEC THE CALLED ROUTINE? @V305174 01713000
BE REALEOJ YES, THEN OK BYE... @V305174 01714000
L R13,CURRSAVE BACK TO CURRENT BUSINESS @VM03028 01715000
L R14,ACMSRET GET CMS RET ADDRESS @V305174 01716000
L R2,AEOJ1 RETURN HERE AFTER UNSTACK @VM03028 01717000
DMSEXS ST,R2,NRMRET MODIFY APPROPRIATE @VM03028 01718000
DMSEXS ST,R2,ERRET SAVE AREA FIELDS @VM03028 01719000
BR R14 CLEAR STACK FOR THIS SVC @V305174 01720000
REALEOJ EQU * @V305174 01721000
SR R15,R15 CLEAR REG 15 @V305174 01722000
ICM R15,LOWBYTE,DOSRC GET DOS RETURN CODE @V305174 01723000
DMSEXS MVI,DOSRC,ALLOFF CLEAR FIELD FOR NEXT TIME @V305174 01724000
L R14,ACMSRET GET CMS RET ADDRESS @V305174 01725000
BR R14 RETURN TO CMS @V305174 01726000
DROP R9,R13 @V305174 01727000
EJECT 01728000
*********************************************************************** 01729000
* * 01730000
* DMSVIP ABEND * 01731000
* * 01732000
* R3 = ABEND CODE * 01733000
* * 01734000
*********************************************************************** 01735000
ABEND EQU * @V305174 01736000
DMSABN (R3),TYPCALL=SVC @V305174 01737000
EJECT 01738000
*********************************************************************** 01739000
* * 01740000
* DMSVIP DATA AREAS * 01741000
* * 01742000
*********************************************************************** 01743000
DS 0D @V305174 01744000
ASSGNCMD DC CL8'ASSGN' @V305174 01745000
SYSXXX DC CL8'SYS' @V305174 01746000
MODE DC CL8' ' @V305174 01747000
DC 8X'FF' @V305174 01748000
SETDOSON DS 0D @V305174 01749000
DC CL8'SET' @V305174 01750000
DC CL8'DOS' @V305174 01751000
DC CL8'ON' @V305174 01752000
DC CL8'(' @V305174 01753000
DC CL8'VSAM' @V305174 01754000
DC 8X'FF' @V305174 01755000
AVIP2 DC A(DMSVIP2) @V305174 01756000
AVIP3 DC A(DMSVIP3) @V305174 01757000
AVIP4 DC A(DMSVIP4) ERET RTN PROC - TESTCB @V305174 01758000
AIKQVSM DC V(IKQVSM) ADDR OF VSAM DATAMGT REQ DRIVER @V305174 01759000
AIKQGEN DC V(IKQGEN) ADDRESS OF VSAM C.B. GEN. RTN@V305174 01760000
AABEND DC A(ABEND) @V305174 01762000
AOPNEMAP DC A(OPNEMAP) ADDR OF ERR MAPPING RTN-OPEN @V305174 01763000
ADMEMAP DC A(DMEMAP) ADDR OF ERR MAPPING RTN-OTHER@V305174 01764000
AECBPOST DC A(ECBPOST) ADDRESS OF ECB POSTING RTN @V305174 01765000
ADOSEPRO DC A(DOSEPRO) ADDRESS OF CMS/DOS ERROR PROC@V305174 01766000
AEOJ1 DC A(EOJ1) @V305174 01767000
* 01768000
FZERO DC F'0' @V305174 01769000
LUT DC CL4' 000' @V305174 01770000
DC CL4' 001' @V305174 01771000
DC CL4' 002' @V305174 01772000
DC CL4' 003' @V305174 01773000
DC CL4' 004' @V305174 01774000
DC CL4' 005' @V305174 01775000
DC CL4' 006' @V305174 01776000
DC CL4' 007' @V305174 01777000
DC CL4' 008' @V305174 01778000
DC CL4' 009' @V305174 01779000
DC XL4'00F0F1F0' @V305174 01780000
* 01781000
OPTTAB DS 0XL32 DOS OPTION FLAG BYTES 1 & 2 @V305174 01782000
* OS OPTION FLAG BYTE 1 (EACH ENTRY REPRESENTS 1 BIT POS) : 01783000
DC X'0008' LOCATE MODE @V305174 01784000
DC X'1000' DIRECT PROCESSING @V305174 01785000
DC X'2000' SEQUENTIAL @V305174 01786000
DC X'0400' SKIP SEQUENTIAL @V305174 01787000
DC X'0800' ASYNCHRONOUS @V305174 01788000
DC X'0080' SEARCH KEY GT/EQ @V305174 01789000
DC X'0040' GENERIC KEY @V305174 01790000
DC X'0000' NO OPT BYTE EQV (IS IN RPLFLAG) @V305174 01791000
* OS OPTION FLAG BYTE 2: 01792000
DC X'8000' KEYED ACCESS @V305174 01793000
DC X'4000' ADDRESSED ACCESS @V305174 01794000
DC X'0200' CONTROL INTERVAL ACC BY RBA @V305174 01795000
DC X'0000' NO OPT BYTE EQUIV @V305174 01796000
DC X'0000' NO OPT BYTE EQUIV @V305174 01797000
DC X'0000' NO OPT BYTE EQUIV @V305174 01798000
DC X'0100' UPDATE @V305174 01799000
DC X'0020' NOTE STRING POSITION @V305174 01800000
* 01801000
DOSRPL DC XL4'00100034' FIXED PORT(1ST 4 BYTES)OF DOS RPL@V305174 01802000
DOSCODES DC X'040C14001C0820' DOS R0 REQUEST CODES @V305174 01803000
SVC2 DC XL2'0A02' DOS END OF LIST MARKER @V305174 01804000
NAMEXEC DC CL8'EXEC' EXEC COMMAND @V305174 01805000
SPACE 2 01806000
LTORG @V305174 01807000
EJECT 01808000
*********************************************************************** 01809000
* * 01810000
* VIPWORK - DMSVIP WORK/SAVE AREA DSECT * 01811000
* * 01812000
*********************************************************************** 01813000
VIPWORK DSECT @V305174 01814000
DS 0D @V305174 01815000
CBWKAR DS 17F DOS VSAM CNTL BLK BUILD AREA @V305174 01816000
WKMISC DS F WORK SPACE @V305174 01817000
LCBWK EQU *-CBWKAR @V305174 01818000
CBMACAR DS 0F CNTL BLK MANIP MACRO WK AREA @V305174 01819000
AECBEACE DS F SAVED ECB EACE ADDRESS @V305174 01820000
AERET DS F TESTCB--ADDR OF USER ERET RTN@V305174 01821000
HEACE DS 3F HEADER ACE SAVE AREA @V305174 01822000
CBMR34 DS 2F SAVE FOR WORK REGS @V305174 01823000
COPYNUM DS H SAVE FOR NUMBER OF COPIES @V305174 01824000
CBMACFLG DS X FLAG BYTE @V305174 01825000
* NOTE- BIT 3 IS NOT TO BE USED (X'10') 01826000
CCEQUAL EQU X'40' PSW CONDITION CODE = 0 @V305174 01827000
CCLOW EQU X'80' PSW CONDITION CODE = 1 @V305174 01828000
CCHIGH EQU X'20' PSW CONDITION CODE = 2 @V305174 01829000
WORKAREA EQU X'08' USER HAS PROVIDED WORKAREA @V305174 01830000
ERET EQU X'04' USER PRV'D ERET RTN(TESTCB) @V305174 01831000
DS X @V305174 01832000
LCBMAC EQU *-CBMACAR @V305174 01833000
VIPRSAVE DS 0F SAVE AREA FOR CALLER'S REGS @V305174 01834000
SAVER0 DS F @V305174 01835000
SAVER1 DS F @V305174 01836000
SAVER2 DS F @V305174 01837000
SAVER3 DS F @V305174 01838000
SAVER4 DS F @V305174 01839000
SAVER5 DS F @V305174 01840000
SAVER6 DS F @V305174 01841000
SAVER7 DS F @V305174 01842000
SAVER8 DS F @V305174 01843000
SAVER9 DS F @V305174 01844000
SAVER10 DS F @V305174 01845000
SAVER11 DS F @V305174 01846000
SAVER12 DS F @V305174 01847000
SAVER13 DS F @V305174 01848000
SAVER14 DS F @V305174 01849000
EXLSA DS 15F PRIMARY EXLST ADDR SAVE AREA @V305174 01850000
LASTEXL DS F LAST ADDRESS SAVE SLOT @V305174 01851000
DS F PTR TO 1ST OVERFLOW BLOCK @V305174 01852000
OVFLNUM DS H TOT NUM OF OVFL BLKS ALLOC @V305174 01853000
VIPINDC DS X INDICATOR BYTE @V305174 01854000
SETEODAD EQU X'80' EODAD RTN SET INACTIVE @V305174 01855000
SETSYNAD EQU X'40' SYNAD RTN SET INACTIVE @V305174 01856000
SETLERAD EQU X'20' LERAD RTN SET INACTIVE @V305174 01857000
RTNCDSV DS X CK PROC--RPL RET CODE SAVE @V305174 01858000
* 01859000
* DMSVIP3 SAVE AREA - EXIT ROUTINE BRANCHES 01860000
* 01861000
VIP3REGS DS 0F @V305174 01862000
VIP3R1 DS F @V305174 01863000
VIP3R213 DS 12F @V305174 01864000
VIP3R14 DS F @V305174 01865000
VIP3WORK DS F @V305174 01866000
VIPWKEND DS 0F END OF VIPWORK @V305174 01867000
SPACE 2 01868000
ORG VIPWORK ASSGNS RTN USAGE @V305174 01869000
DLUT DS 10F @V305174 01870000
DUMFLAG DS X @V305174 01871000
DUMMIES EQU X'80' @V305174 01872000
DUMCAT EQU X'40' @V305174 01873000
DUMUNIT DS 3C @V305174 01874000
DS 0D @V305174 01875000
DASSGN DS 4D @V305174 01876000
SPACE 2 01877000
ORG VIPWORK BLDEXLSA, CBMACS02 RTN USAGE @V305174 01878000
TEMPRSAV DS 3F TEMP SAVE FOR REGS R15,R0,R1 @V305174 01879000
RETSAV DS F RETURN ADDRESS SAVE CELL @V305174 01880000
EXLMISC DS F WORK AREA @V305174 01881000
WKSAVE DS 2F SAVE FOR WK REGS/(ENTRY REG) @V305174 01882000
CUROVFL DS H CURRENT OVERFLOW BLOCK NUMBER@V305174 01883000
ORG , @V305174 01884000
EJECT 01885000
OEXLSA DSECT OVERFLOW OVERFLOW EXLST ADDR @V305174 01886000
DS 0D @V305174 01887000
OEXLADS DS 15F ADDRESS SAVE WORDS @V305174 01888000
LASTOEXL DS F LAST ADDRESS SAVE SLOT @V305174 01889000
ANOEXL DC A(0) ADDRESS OF NEXT OVERFLOW AREA@V305174 01890000
DS F RESERVED @V305174 01891000
OEXLEND DS 0F END OF OVERFLOW AREA @V305174 01892000
EJECT 01893000
CBMACD DSECT HEADER HDR ARG CNTL ENTRY DSE@V305174 01894000
HEADER EQU * @V305174 01895000
BTC DS B BLOCK TYPE CODE @V305174 01896000
BTACB EQU X'A0' ACB @V305174 01897000
BTEXLST EQU X'B0' EXLST @V305174 01898000
BTRPL EQU X'C0' RPL @V305174 01899000
FTC DS B FUNCTION TYPE CODE @V305174 01900000
GENFTC EQU 1 GENCB @V305174 01901000
MODFTC EQU 2 MODCB @V305174 01902000
SHOWFTC EQU 3 SHOWCB @V305174 01903000
TESTFTC EQU 4 TESTCB @V305174 01904000
GENCOP DS H NUMBER OF COPIES- GENCB @V305174 01905000
EJECT 01906000
DOSCB @V305174 01907000
NUCON @V305174 01908000
CMSAVE @V305174 01909000
IKQACB @V305174 01910000
EJECT 01911000
IKQRPL @V305174 01912000
RPLECB DS A SAVE ECB ADDR (CMS USE ONLY) @V305174 01913000
EJECT 01914000
IKQEXLST @V305174 01915000
EJECT 01916000
REGEQU @V305174 01917000
* 01918000
* OTHER EQUATES 01919000
* 01920000
PROG EQU X'01' PROGRAMMER LOGICAL UNIT @V305066 01921000
SYS010 EQU X'0A' SYS010 LOGICAL UNIT @V305066 01922000
VSAMTYP EQU X'10' VSAM SUB TYPE @V305066 01923000
LENGTH EQU X'44' ACB LENGTH @V305066 01924000
FIVE EQU 5 ... @V305066 01925000
FOUR EQU 4 ... @V305066 01926000
NINE EQU 9 ... @V305066 01927000
ONE EQU 1 ... @V305066 01928000
TWO EQU 2 ... @V305066 01929000
EIGHT EQU 8 ... 01929100
TWELVE EQU 12 ... 01929200
ABEND177 EQU X'177' ABEND CODE - 177 @V305066 01930000
ABEND34 EQU 34 ABEND CODE = 34 @V305066 01931000
ABEND52 EQU 52 ABEND CODE = 52 @V305066 01932000
ABEND56 EQU 56 ABEND CODE = 56 @V305066 01933000
SVCTWO EQU 2 SVC 2 @V305066 01934000
BINZERO EQU X'00' @V305066 01935000
HEX01 EQU X'01' @V305066 01936000
RC04 EQU X'04' @V305066 01937000
CON160 EQU 160 @V305066 01938000
CON144 EQU 144 @V305066 01939000
RESET EQU X'0F' @V305066 01940000
ZERO EQU 8 @V305174 01941000
EQ EQU 8 @V305174 01942000
NOTEQ EQU 7 @V305174 01943000
NEG EQU 4 @V305174 01944000
ONES EQU 1 @V305174 01945000
BIT3 EQU B'00010000' @V305174 01946000
CLOSE EQU C'C' @V305174 01947000
TCLOSE EQU C'T' @V305174 01948000
CHECK EQU X'14' DOS CHECK REQUEST CODE @V305174 01949000
COUNTREG EQU 4 @V305174 01950000
DOSLREG EQU 8 @V305174 01951000
ACBREG EQU 5 @V305174 01952000
RPLREG EQU 1 @V305174 01953000
EXLSTREG EQU 6 @V305174 01954000
LISTPTR EQU 3 @V305174 01955000
ACEPTR EQU 4 @V305174 01956000
ELEMPTR EQU 4 @V305174 01957000
ELEMXFLG EQU 8 @V305174 01958000
OSACBLEN EQU 76 @V305174 01959000
ECBELID EQU 47 ECB EACE ID @V305174 01960000
IOEQCOM EQU 54 IO=COMPLETE EACE ID @V305174 01961000
LOGERR EQU 8 LOGICAL ERROR DURING VSAM I/O@V305174 01962000
RPLCAERR EQU X'38' RPL FDBK CDE-IO ERR DUR CATG ACC @V305174 01963000
NOERR EQU X'00' @V305174 01964000
LAST EQU X'80' @V305174 01965000
HION EQU X'80' @V305174 01966000
BLANKS EQU X'40' @V305174 01967000
HEXTRANS EQU X'0F' @V305174 01968000
ALLOFF EQU X'00' @V305174 01969000
DOSOFF EQU X'BF' @V305174 01970000
INACTIVE EQU X'BF' EXIT RTN INACTIV FLAG (EXLST)@V305174 01971000
LOWBYTE EQU B'0001' @V305174 01972000
LOWTWO EQU B'0011' @V305174 01973000
HIGHTWO EQU B'1100' @V305174 01974000
B8TO31 EQU B'0111' @V305174 01975000
HIGHBYTE EQU B'1000' @V305174 01976000
ALLFOUR EQU B'1111' @V305174 01977000
* ECB EQUATES 01978000
WAITING EQU X'80' WAITING FOR COMPL'TN OF EVENT@V305174 01979000
COMPLETE EQU X'7F' EVENT COMPL'TD SUCCESSFULLY @V305174 01980000
UNITCHCK EQU X'41' UNIT CHECK--PHYS ERROR INDIC @V305174 01981000
LOGIC EQU X'42' LOGICAL ERROR INDIC @V305174 01982000
END 01983000