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