ibm:vm370-lib:cms:dmsvip.assemble_src
Table of Contents
DMSVIP Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R12931DS]
Source Listing
- DMSVIP.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsvip.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator