DOS TITLE 'DMSDOS (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. * 00003000
* * 00004000
* MODULE NAME: * 00005000
* * 00006000
* DMSDOS ( CMS/DOS SVC HANDLER ) * 00007000
* * 00008000
* FUNCTION: * 00009000
* * 00010000
* PROVIDES THE INTERFACE CAPABILITIES IN THE CMS/DOS * 00011000
* SEGMENT TO PROCESS DOS/VS SVCS. DMSDOS WILL PROCESS * 00012000
* DOS/VS SVCS IN LINE OR WILL CALL OTHER ROUTINES THAT * 00013000
* WILL SIMULATE THE SVC (E.G. OPEN, CLOSE, FETCH, EXCP). * 00014000
* * 00015000
* ATTRIBUTES: * 00016000
* * 00017000
* CMSDOS SEGMENT RESIDENT * 00018000
* REENTRANT * 00019000
* * 00020000
* ENTRY POINT: * 00021000
* * 00022000
* DMSDOS * 00023000
* * 00024000
* ENTRY CONDITIONS: * 00025000
* * 00026000
* ENTERED VIA 'LPSW' FROM DMSITS * 00027000
* * 00028000
* R12 = A(DMSDOS) * 00029000
* R14 = RETURN ADDRESS * 00030000
* * 00031000
* EXIT CONDITIONS: * 00032000
* * 00033000
* RETURN TO CALLER WITH RETURN CODE IN R15 * 00034000
* * 00035000
* RETURN CODES AND MESSAGES: * 00036000
* * 00037000
* 28 - SPECIFIED PHASE NOT FOUND * 00038000
* 100 - UNSUPPORTED SVC XX CALLED FROM XXXXXX * 00039000
* 100 - UNSUPPORTED FUNCTION IN A LIOCS ROUTINE * 00040000
* 100 - SAVEAREA ADDR IN PART. PIB NOT EQUAL LTA SAVEAREA * 00041000
* 100 - MVCOM ATTEMPTING TO ALTER OTHER THAN LOC 12-23 * 00042000
* 100 - MVCOM FROM ADDRESS IS INVALID * 00043000
* 100 - INVALID ADDRESS XXXXXX * 00044000
* 100 - STXIT SAVEAREA ADDRESS INVALID * 00045000
* 104 - V.M. SIZE CANNOT EXCEED SEGMENT START ADDRESS * 00046000
* XXX - JOB CANCELLED DUE TO PROGRAM REQUEST * 00047000
* * 00048000
* CALLS TO OTHER ROUTINES: * 00049000
* * 00050000
* DMSERR, DMSFRE, DMSXCP, DMSFCH, DMSBOP, DMSOPL * 00051000
* DMSOR1, DMSOR2, DMSOR3, DMSDMP, DMSCLS, DMSBAB * 00052000
* * 00053000
* EXTERNAL REFERENCES: * 00054000
* * 00055000
* NUCON, CMSAVE, BGCOM, SYSCOM * 00056000
* PIBTAB, DOSAVE, FCHTAB, ANCHTAB * 00057000
* * 00058000
* REGISTER USAGE: * 00059000
* * 00060000
* R0 NUCON ADDRESSABILITY & WORK * 00061000
* R1 WORK * 00062000
* R2 SYSCOM ADDRESSABILITY & WORK * 00063000
* R3 WORK * 00064000
* R4 WORK * 00065000
* R5 BGCOM ADDRESSABILITY & WORK * 00066000
* R6 WORK * 00067000
* R7 WORK * 00068000
* R8 WORK * 00069000
* R9 WORK * 00070000
* R10 PIBTAB ADDRESSABILITY & WORK * 00071000
* R11 WORK * 00072000
* R12 DMSDOS ADDRESSABILITY * 00073000
* R13 SVC SAVE AREA ADDRESSABILITY * 00074000
* R14 EXTERNAL LINKAGE & RETURN REGISTER * 00075000
* R15 EXTERNAL LINKAGE & RETURN CODE * 00076000
* * 00077000
* OPERATION: * 00078000
* * 00079000
* SVC SUPPORT ROUTINES AND THEIR OPERATION: * 00080000
* * 00081000
* * 00082000
* EXCP-SVC 0: USED TO READ FROM CMS OR DOS/OS FORMATTED DISKS. * 00083000
* * 00084000
* THE CCW'S ARE CONVERTED TO APPROPIATE CMS'S I/O * 00085000
* REQUESTS (E.G. RDBUF/WRBUF, CARDRD/CARDPH, ETC.) * 00086000
* AND TO POST THE CCB ACCORDING TO THE CMS RETURN * 00087000
* INFORMATION. DMSDOS WILL CALL DMSXCP ROUTINE TO * 00088000
* PERFORM THE I/O OPERATION. IF A NON-ZERO RETURN * 00089000
* CODE IS RETURNED FROM DMSXCP, A CANCEL IS DONE. * 00090000
* * 00091000
* FETCH-SVC 1: USED TO BRING A PROBLEM PROGRAM PHASE INTO USER * 00092000
* STORAGE, AND TO START EXECUTION OF THE PHASE IF * 00093000
* THE PHASE WAS FOUND. * 00094000
* * 00095000
* IF THE USER DID SPECIFY A DIRECTORY LIST, A CALL * 00096000
* TO DMSFCH IS MADE. OTHERWISE, DMSDOS WILL BUILD * 00097000
* A DIRECTORY LIST USING THE SPECIFIED PHASE NAME. * 00098000
* ONCE THE DIRECTORY LIST IS PREPARED, A CALL TO * 00099000
* DMSFCH IS MADE. UPON RETURN FROM DMSFCH, IF THE * 00100000
* PHASE WAS FOUND, THE ENTRY POINT ADDRESS OF THE * 00101000
* PHASE IS SAVED IN THE 'SVC' SAVE AREA OLDPSW SO * 00102000
* THAT UPON RETURN TO CMS, DMSITS WILL THEN GIVE * 00103000
* CONTROL TO THE PHASE JUST LOADED. IF UPON RETURN * 00104000
* FROM DMSFCH THERE WHERE ANY ERRORS, A CANCEL IS * 00105000
* DONE. IF THE PHASE WAS NOT FOUND, A MESSAGE IS * 00106000
* ISSUED AND A CANCEL IS DONE. * 00107000
* * 00108000
* FETCH-SVC 2: USED TO BRING A $$B-TRANSIENT PHASE INTO THE CMS * 00109000
* TRANSIENT AREA (OR IF THE PHASE IS IN THE CMSDOS * 00110000
* SEGMENT, NOT TO LOAD IT), AND START EXECUTION OF * 00111000
* THE PHASE IF THE PHASE WAS FOUND. * 00112000
* * 00113000
* A SEARCH IS MADE THROUGH THE INCORE SEGMENT (S) * 00114000
* IN AN ATTEMPT TO LOCATE THE SPECIFIED TRANSIENT. * 00115000
* IF THE PHASE IS FOUND IN ONE OF THE SEGMENTS, A * 00116000
* CALL TO DMSFCH IS NOT NEEDED. IF THE PHASE WAS * 00117000
* NOT FOUND, A CALL TO DMSFCH IS MADE IN A SIMILAR * 00118000
* WAY AS IN SVC 1 ABOVE. ONCE THE TRANSIENT ENTRY * 00119000
* POINT IS OBTAINED (FROM INCORE OR LOADED), THE * 00120000
* ADDRESS IS SAVED IN THE SVC SAVE AREA (AS ABOVE * 00121000
* SVC 1) SO THAT DMSITS GIVES IMMEDIATE CONTROL TO * 00122000
* THE PHASE WANTED. ERRORS OR NOT FOUND CONDITIONS * 00123000
* ARE HANDLED AS ABOVE SVC 1. (SEE NOTE1 FOR * 00124000
* ADDITIONAL INFORMATION ABOUT SVC 2 PROCESSING). * 00125000
* * 00126000
* LOAD-SVC 4: USED TO BRING A PROBLEM PROGRAM PHASE INTO USER * 00127000
* STORAGE, AND RETURN THE CALLER THE ENTRY POINT * 00128000
* ADDRESS OF THE PHASE JUST LOADED. * 00129000
* * 00130000
* LOADING OF THE REQUESTED PHASE IS DONE EXACTLY AS * 00131000
* FETCH (SVC 1) CALLING DMSFCH. ANY ERRORS RETURNED * 00132000
* FROM DMSFCH ARE PROCESSED EXACTLY AS IN FETCH. A * 00133000
* DIFFERENCE BETWEEN FETCH (SVC 1) AND LOAD (SVC 4), * 00134000
* IS THAT UPON RETURN FROM DMSFCH, ASSUMING THERE IS * 00135000
* NO ERRORS, THE USER'S REGISTER 0 AND 1 ARE UPDATED * 00136000
* TO CONTAIN THE ADDRESS OF THE DIRECTORY LIST (FOR * 00137000
* THE USER TO TEST IF THE PHASE WAS FOUND), AND THE * 00138000
* ENTRY POINT ADDRESS OF THE PHASE, RESPECTIVELY. * 00139000
* * 00140000
* MVCOM-SVC 5: USED TO PROVIDE THE USER WITH A MEANS OF ALTERING * 00141000
* POSITIONS 12 THROUGH 23 OF THE PARTITION COMMUNI- * 00142000
* CATIONS REGION. * 00143000
* * 00144000
* BEFORE MOVING THE SPECIFIED INFORMATION, A TEST IS * 00145000
* MADE TO ENSURE THAT THE RANGE (USER'S TO ADDRESS, * 00146000
* PLUS LENGTH OF FIELD TO MOVE) WILL NOT EXCEED THE * 00147000
* ALLOWED RANGE. ONCE THE SPECIFIED RANGE IS FOUND TO * 00148000
* BE WITHIN THE ALLOWED LIMITS, THE USER'S SPECIFIED * 00149000
* INFORMATION IS MOVED TO THE PARTITION COMMUNICATIONS * 00150000
* REGION. * 00151000
* * 00152000
* CANCL-SVC 6: USED TO CANCEL A DOS/VS SESSION EITHER BY A DOS/VS * 00153000
* PROGRAM REQUEST, OR BY REQUEST FROM ANY OF THE CMS * 00154000
* ROUTINES HANDLING CMS/DOS. * 00155000
* * 00156000
* CANCEL WILL ISSUE THE MESSAGE 'JOB CANCELLED DUE TO * 00157000
* PROGRAM REQUEST'. A TEST WILL BE MADE TO SEE IF THE * 00158000
* VALUE OF REGISTER 15 UPON ENTRY TO CANCEL IS BELOW * 00159000
* 256. IF BELOW, THAT WILL BE THE RETURN CODE TO CMS. * 00160000
* IF EQUAL OR GREATER, A SPECIAL RETURN CODE OF 101 * 00161000
* WILL BE USED TO DENOTE THAT THE CANCEL WASS ISSUED * 00162000
* FROM A USER PROGRAM (RETURN CODE OF 101 IS NOT USED * 00163000
* FOR CMS ERROR MESSAGES). PROCESSING THEN CONTINUES * 00164000
* USING THE 'EOJ' CODE. (SEE EOJ - SVC 14 BELOW FOR A * 00165000
* DESCRIPTION OF THE COMMON EOJ/CANCEL CODE). * 00166000
* * 00167000
* WAIT-SVC 7: USED TO WAIT ON A CCB, ECB OR TECB. (NOTE THAT CMS/ * 00168000
* DOS DOES NOT SUPPORT ECB'S OR TECB'S). IN THE CASE * 00169000
* OF CCB'S, THEY WILL ALWAYS BE POSTED BY THE DMSXCP * 00170000
* ROUTINE BEFORE RETURNING TO THE CALLER. * 00171000
* * 00172000
* THE WAIT SUPPORT UNDER CMS/DOS WILL EFFECTIVELY BE * 00173000
* A BRANCH TO THE CMS/DOS POST ROUTINE. THIS IS DONE * 00174000
* BECAUSE IF THE USER EXPECTS TO WAIT ON A CCB, MAY * 00175000
* BE BECAUSE HE DID NOT TEST TO SEE IF THE WAIT BIT * 00176000
* WAS ON (WHICH SHOULD BE IF HE DID ANY I/O, OR MAY * 00177000
* NOT BE ON IF HE DID NOT DO ANY I/O, IN WHICH CASE * 00178000
* IT DOES NOT MATTER). IN THE CASE OF A ECB OR TECB, * 00179000
* SINCE CMS/DOS DOES NOT SUPPORT THEM, THE USER MUST * 00180000
* THEREFORE KNOW WHAT HE IS DOING. * 00181000
* * 00182000
* SVC 8: TEMPORARILY RETURN CONTROL FROM A $$B-TRANSIENT TO * 00183000
* THE PROBLEM PROGRAM. * 00184000
* * 00185000
* IF A $$B-TRANSIENT HAS TO TEMPORARILY GIVE CONTROL * 00186000
* THE PROBLEM PROGRAM, THE $$B-TRANSIENT WILL ISSUE * 00187000
* AN SVC 8 PASSING IN REGISTER 0 THE PROBLEM PROGRAM * 00188000
* ADDRESS TO GAIN CONTROL. SVC 8 ROUTINE WILL STORE * 00189000
* THIS ADDRESS ON THE SVC WORK AREA OLDPSW, REMEMBER * 00190000
* THE ADDRESS FROM WHERE THE SVC 8 WAS ISSUED (FOR * 00191000
* LATER RETURN), AND RETURNS BACK TO CMS SVC HANDLER. * 00192000
* (SEE NOTE1 FOR ADDITIONAL INFORMATION ABOUT SVC 8 * 00193000
* PROCESSING). * 00194000
* * 00195000
* SVC 9: RETURN TO A $$B-TRANSIENT AFTER AN SVC 8 WAS ISSUED * 00196000
* TO GIVE CONTROL TO THE PROBLEM PROGRAM. * 00197000
* * 00198000
* THE ADDRESS SAVED BEFORE (SVC 8 ABOVE) IS STORED * 00199000
* IN THE SVC WORK AREA OLDPSW, SO THAT WHEN DMSDOS * 00200000
* RETURNS TO THE CMS SVC HANDLER, CONTROL IS GIVEN * 00201000
* TO THE $$B-RANSIENT THAT ISSUED THE SVC 8. (SEE * 00202000
* NOTE 1 FOR ADDITIONAL INFORMATION ABOUT * 00203000
* SVC 9 PROCESSING). * 00204000
* * 00205000
* SVC 11: RETURN FROM A $$B-TRANSIENT TO THE CALLING PROBLEM * 00206000
* PROGRAM. * 00207000
* * 00208000
* THE ADDRESS SAVED WHEN THE INITIAL SVC 2 (FETCH A * 00209000
* $$B-TRANSIENT) WAS ISSUED, IS STORED IN THE CMS'S * 00210000
* SVC WORK AREA OLDPSW. NOW, WHEN DMSDOS RETURNS TO * 00211000
* THE CMS'S SVC HANDLER, CONTROL WILL RETURN TO THE * 00212000
* PROBLEM PROGRAM THAT ISSUED THE SVC 2 CALLING THE * 00213000
* $$B-TRANSIENT. (SEE NOTE1 FOR ADDITIONAL INFORMATION * 00214000
* ABOUT SVC 11 PROCESSING). * 00215000
* * 00216000
* SVC 12: RESETS FLAGS TO 0 IN THE LINKAGE CONTROL BYTE IN * 00217000
* BGCOM (COMMUNICATION REGION). IF R1 = 0, SVC 12 * 00218000
* HAS ANOTHER MEANING. BIT 5 OF JCSW4 (COMREG BYTE * 00219000
* 59) IS TURNED OFF. * 00220000
* * 00221000
* IF R1 CONTAINS A NONZERO VALUE, THE FUNCTION * 00222000
* DEPENDS ON BIT 8 OF THIS REGISTER. IF THIS BIT * 00223000
* IS 0, THIS SVC SUPPLIES SUPERVISORY SUPPORT * 00224000
* TO RESET FLAGS IN THE LINKAGE CONTROL BYTE * 00225000
* (DISPLACEMENT 57 IN BGCOM - COMMUNICATION REGION). * 00226000
* THE USER HAS PROVIDED THE ADDRESS OF A * 00227000
* MASK (1 BYTE) IN R1. THIS MASK IS ANDED WITH THE * 00228000
* LINKAGE CONTROL BYTE. IF BIT 8 OF R1 IS ONE, * 00229000
* THIS SVC SUPPLIES THE SUPERVISORY SUPPORT TO * 00230000
* RESET FLAGS IN A SPECIFIED BYTE OF BGCOM * 00231000
* (COMMUNICATION REGION). THE USER HAS * 00232000
* PROVIDED A DISPLACEMENT IN BYTE 2 AND A MASK * 00233000
* IN BYTE 3 OF R1. THE MASK IS ANDED WITH THE * 00234000
* BYTE AT THE SPECIFIED DISPLACEMENT IN THE PARTITION * 00235000
* COMMUNICATION REGION. * 00236000
* * 00237000
* * 00238000
* EOJ-SVC 14: USED TO NORMALLY TERMINATE EXECUTION OF A PROBLEM * 00239000
* PROGRAM. * 00240000
* * 00241000
* THE LAST SVC SAVE WORK AREA IS UNSTACKED. CLEANUP * 00242000
* IS DONE BY: * 00243000
* 1. CLEARING THE CMS DOSLIB CMSCB * 00244000
* 2. RESETTING THE JOBNAME IN BGCOM * 00245000
* * 00246000
* THE LATEST RETURN CODE IS LOADED INTO REGISTER 15, * 00247000
* AND CONTROL RETURNS TO DMSITS (CMSRET). * 00248000
* * 00249000
* SVC 16: ESTABLISH OR TERMINATE LINKAGE TO A USER'S * 00250000
* PROGRAM CHECK ROUTINE. * 00251000
* * 00252000
* LOCATE THE APPROPRIATE PC OPTION TABLE ENTRY. * 00253000
* THEN DETERMINE BY TESTING R0 WHETHER ESTABLISHING OR * 00254000
* TERMINATING LINKAGE TO USER'S PC ROUTINE. * 00255000
* IF R0 HAS A ZERO VALUE (TERMINATE LINKAGE), DETERMINE * 00256000
* IF PC ROUTINE IS ACTIVE (PC ROUTINE ADDRESS IN PC * 00257000
* OPTION TABLE IS NEGATIVE) AND IF IT IS, TERMINATE * 00258000
* LINKAGE BY STORING ZERO IN ROUTINE ADDRESS FIELD OF PC* 00259000
* OPTION TABLE. IF ROUTINE IS NOT ACTIVE PRESENTLY, * 00260000
* STORE ZEROS IN PC ROUTINE ADDRESS FIELD AND SAVEAREA * 00261000
* ADDRESS FIELD IN PC OPTION TABLE. * 00262000
* IF R0 IS NOT ZERO, THE STXIT MACRO PASSED PARAMETERS. * 00263000
* (USER PC ROUTINE ADDRESS AND SAVEAREA ADDRESS) * 00264000
* IN THIS CASE, THE LIMITS OF THE SAVEAREA ARE * 00265000
* VALIDATED (CANNOT BE LESS THAN 20000 OR GREATER THAN * 00266000
* PARTITION END). NEXT, IF A STXIT PC ROUTINE IS * 00267000
* ACTIVE, THE COMPLEMENT OF THE NEW ROUTINE ADDRESS * 00268000
* IS PLACED IN THE PC OPTION TABLE. IF NO STXIT * 00269000
* PC ROUTINE IS ACTIVE, THE NEW PC ROUTINE ADDRESS AND * 00270000
* SAVEAREA ADDRESS ARE STORED IN THE PC OPTION TABLE. * 00271000
* * 00272000
* SVC 17: USED TO PROVIDE SUPERVISORY SUPPORT FOR THE * 00273000
* EXIT MACRO. SVC 17 PROVIDES A RETURN FROM THE * 00274000
* USER'S PC ROUTINE TO THE NEXT SEQUENTIAL INSTRUCTION * 00275000
* IN THE PROGRAM THAT WAS INTERRUPTED DUE TO A * 00276000
* PROGRAM CHECK. * 00277000
* * 00278000
* LOCATE APPROPRIATE PC OPTION TABLE ENTRY. RESTORE * 00279000
* USER'S REGISTERS AND PSW. STORE THE COMPLEMENT * 00280000
* OF THE PC ROUTINE ADDRESS IN THE PC OPTION TABLE * 00281000
* (CHANGE ROUTINE ADDRESS FROM NEGATIVE TO POSITIVE). * 00282000
* RETURN TO NEXT SEQUENTIAL INSTRUCTION IN THE * 00283000
* PROGRAM THAT WAS INTERRUPTED. * 00284000
* * 00285000
* SVC 26: VALIDATE ADDRESS LIMITS. THE UPPER ADDRESS MUST * 00286000
* BE SPECIFIED IN GENERAL REGISTER 2 AND THE LOWER * 00287000
* ADDRESS MUST BE SPECIFIED IN GENERAL REGISTER 1. * 00288000
* * 00289000
* FIRST THE LOWER ADDRESS MUST NOT BE NEGATIVE. * 00290000
* AN ERROR MESSAGE DMSDOS005E IS ISSUED IF IT IS. * 00291000
* SECOND, THE HIGH ADDRESS CANNOT BE NEGATIVE. * 00292000
* IF IT IS, THE SAME ERROR MESSAGE IS ISSUED. * 00293000
* IF THE LOW OR HIGH ADDRESS IS GREATER THAN THE * 00294000
* END OF PARTITION ADDRESS IN BGCOM, THE SAME ERROR * 00295000
* MESSAGE IS ISSUED. OTHERWISE, CONTROL * 00296000
* RETURNS TO THE CALLER. * 00297000
* * 00298000
* COMRG-SVC 33: USED TO PROVIDE THE CALLER WITH THE ADDRESS OF THE * 00299000
* PARTITION COMMUNICATIONS REGION. * 00300000
* * 00301000
* DMSDOS WILL PROVIDE THE CALLER WITH THE ADDRESS OF * 00302000
* THE PARTITION COMMUNICATIONS REGION, IN THE USER'S * 00303000
* REGISTER 1. * 00304000
* * 00305000
* SVC 34: PROVIDES SUPPORT FOR THE GETIME MACRO. * 00306000
* SVC 34 UPDATES THE DATE FIELD IN THE COMMUNICATIONS * 00307000
* REGION. UPON RETURN, GENERAL REGISTER 1 * 00308000
* CONTAINS THE TIME OF DAY IN TIMER UNITS (1/300 SEC). * 00309000
* * 00310000
* SVC 37: ESTABLISH OR TERMINATE LINKAGE TO A USER'S * 00311000
* ABNORMAL TERMINATION ROUTINE. * 00312000
* * 00313000
* LOCATE THE APPROPRIATE AB OPTION TABLE ENTRY. * 00314000
* THEN DETERMINE BY TESTING R0 WHETHER ESTABLISHING OR * 00315000
* TERMINATING LINKAGE TO USER'S AB ROUTINE. * 00316000
* IF R0 HAS A ZERO VALUE (TERMINATE LINKAGE), DETERMINE * 00317000
* IF AB ROUTINE IS ACTIVE (AB ROUTINE ADDRESS IN AB * 00318000
* OPTION TABLE IS NEGATIVE), AND IF IT IS, TERMINATE * 00319000
* LINKAGE BY STORING ZERO IN ROUTINE ADDRESS FIELD OF AB* 00320000
* OPTION TABLE. IF ROUTINE IS NOT ACTIVE PRESENTLY, * 00321000
* STORE ZEROS IN AB ROUTINE ADDRESS FIELD AND SAVEAREA * 00322000
* ADDRESS FIELD IN AB OPTION TABLE. * 00323000
* IF R0 IS NOT ZERO, THE STXIT MACRO PASSED PARAMETERS. * 00324000
* (USER AB ROUTINE ADDRESS AND SAVEAREA ADDRESS) * 00325000
* IN THIS CASE, THE LIMITS OF THE SAVEAREA ARE * 00326000
* VALIDATED (CANNOT BE LESS THAN 20000 OR GREATER THAN * 00327000
* PARTITION END). NEXT, IF A STXIT AB ROUTINE IS * 00328000
* ACTIVE, THE COMPLEMENT OF THE NEW ROUTINE ADDRESS * 00329000
* IS PLACED IN THE AB OPTION TABLE. IF NO STXIT * 00330000
* AB ROUTINE IS ACTIVE, THE NEW AB ROUTINE ADDRESS AND * 00331000
* SAVEAREA ADDRESS ARE STORED IN THE AB OPTION TABLE. * 00332000
* * 00333000
* POST-SVC 40: USED TO POST AN ECB, TECB OR CCB. * 00334000
* * 00335000
* BYTE 2, BIT 0 OF THE SPECIFIED CONTROL BLOCK WILL * 00336000
* BE TURNED 'ON' BY DMSDOS. * 00337000
* * 00338000
* SVC 50: ISSUED BY A LOGICAL IOCS ROUTINE WHEN THE LIOCS IS * 00339000
* CALLED TO PERFORM AN OPERATION FOR WHICH THE LIOCS * 00340000
* WAS NOT GENERATED TO PERFORM. * 00341000
* * 00342000
* THE ERROR MESSAGE 'UNSUPPORTED FUNCTION IN A LIOCS * 00343000
* ROUTINE' WILL BE ISSUED, AND THE SESSION WILL THEN * 00344000
* BE TERMINATED. * 00345000
* * 00346000
* SVC 61: GETVIS: USED BY VSAM TO OBTAIN FREE STORAGE FOR * 00347000
* SCRATCH USE OR FOR OBTAINING AN AREA INTO WHICH A * 00348000
* RELOCATABLE VSAM PROGRAM MAY BE LOADED. * 00349000
* * 00350000
* A FREE STORAGE SUBROUTINE SIMILAR TO THAT IN THE * 00351000
* "DMSSMN" ROUTINE IS CALLED TO OBTAIN THE NEEDED * 00352000
* SPACE (FROM THE USER AREA). IF SUCCESSFUL, THE * 00353000
* ADDRESS IS RETURNED IN REGISTER 1, AND REGISTER 15 * 00354000
* IS CLEARED. IF THE REQUEST CANNOT BE SATISFIED, A * 00355000
* RETURN-CODE OF 12 IS PASSED BACK IN REGISTER 15. * 00356000
* * 00357000
* THE "PAGE", "POOL", AND "SVA" GETVIS OPTIONS ARE * 00358000
* IGNORED. * 00359000
* * 00360000
* SVC 62: FREEVIS: USED TO RETURN THE FREE STORAGE OBTAINED * 00361000
* VIA AN EARLIER GETVIS CALL. * 00362000
* * 00363000
* THE FREE STORAGE SUBROUTINE SIMILAR TO THAT IN * 00364000
* THE "DMSSMN" ROUTINE IS CALLED TO RETURN THE AREA * 00365000
* DESIGNATED BY REGISTER 1. * 00366000
* * 00367000
* SVC 63: USE: USED BY VSAM ROUTINES TO ENSURE THAT SYSTEM * 00368000
* RESOURCES ARE MODIFIED SERIALLY, SO THAT TWO OR * 00369000
* MORE ATTEMPTS TO MODIFY THE SAME DATA AT THE SAME * 00370000
* TIME CANNOT SUCCEED. * 00371000
* * 00372000
* A TABLE OF COUNTERS ("RURTBL") IS KEPT FOR THE * 00373000
* VARIOUS RESOURCES. IF THE COUNTER CORRESPONDING * 00374000
* TO THE SPECIFIED RESOURCE IS 0, IT IS INCREMENTED * 00375000
* BY ONE, AND A VALUE OF 0 IS RETURNED IN REGISTER 0. * 00376000
* IF THE COUNTER WAS ALREADY > 0, IT IS INCREMENTED * 00377000
* BY ONE, AND A VALUE OF 8 IS RETURNED IN REGISTER 0. * 00378000
* * 00379000
* SVC 64: RELEASE: USED BY VSAM ROUTINES TO "RELEASE" A * 00380000
* RESOURCE FOR WHICH A PREVIOUS "USE" WAS ISSUED. * 00381000
* * 00382000
* THE COUNTER PERTAINING TO THE RESOURCE IS DECREMENTED * 00383000
* BY ONE. IF THIS SHOULD MAKE THE COUNTER NEGATIVE, * 00384000
* IT IS CLEARED INSTEAD. * 00385000
* * 00386000
* SVC 65: CDLOAD: USED TO LOAD A RELOCATABLE VSAM PHASE INTO * 00387000
* STORAGE, UNLESS THE PROGRAM HAS ALREADY BEEN LOADED. * 00388000
* * 00389000
* IF AN ANCHOR TABLE IS AVAILABLE, IT IS SEARCHED * 00390000
* FOR THE GIVEN PHASE; IF FOUND, ITS LOAD POINT, * 00391000
* ENTRY POINT, AND LENGTH ARE RETURNED IN THE CALLER'S * 00392000
* 0, 1, AND 14 RESPECTIVELY, WITH REGISTER 15 = 0. * 00393000
* * 00394000
* IF NOT, DMSFCH IS CALLED TO FIND THE GIVEN PHASE; * 00395000
* IF FOUND IN A DISCONTINUOUS SHARED SEGMENT, REGISTERS * 00396000
* 0, 1, AND 14 ARE LOADED AS ABOVE AND RETURN MADE. * 00397000
* * 00398000
* IF THE PHASE WAS FOUND BUT IS NOT LOADED, STORAGE * 00399000
* IS OBTAINED (IF AVAILABLE) FROM THE GETVIS CODE; * 00400000
* THEN DMSFCH IS CALLED AGAIN TO LOAD THE PROGRAM INTO * 00401000
* THAT STORAGE AREA. THEN AN ANCHOR TABLE IS BUILT IN * 00402000
* THE USER AREA (UNLESS ONE ALREADY EXISTS), THE * 00403000
* APPROPRIATE ENTRIES MADE THEREIN, AND REGISTERS * 00404000
* 0, 1, AND 14 LOADED AS ABOVE, WITH RETURN TO CALLER. * 00405000
* * 00406000
* IF THE PROGRAM CANNOT BE FOUND, OR IF STORAGE IS * 00407000
* UNAVAILABLE FOR EITHER LOADING THE PROGRAM OR FOR * 00408000
* BUILDING THE ANCHOR TABLE, AN ERROR CODE 22 (X'16') * 00409000
* IS RETURNED TO THE CALLER IN REGISTER 15. * 00410000
* * 00411000
* SVC 66: RUNMODE: USED BY A PROBLEM PROGRAM TO FIND OUT IF * 00412000
* THE PROGRAM IS RUNNING IN REAL OR VIRTUAL MODE. * 00413000
* * 00414000
* THE CALLER'S REGISTER 0 WILL BE ZEROED TO INDICATE * 00415000
* THAT THE PROGRAM IS RUNNING IN VIRTUAL MODE. * 00416000
* * 00417000
* SVC 75: SECTVAL: USED BY VSAM I/O ROUTINES (E.G. IKQIOA) TO * 00418000
* OBTAIN A SECTOR NUMBER FOR A 3330, 3330-11, 3340, * 00419000
* OR 3350 DEVICE * 00420000
* 00421000
* THE APPROPRIATE SECTOR VALUE IS CALCULATED FROM THE * 00422000
* INPUT DATA SUPPLIED BY THE USER'S REGISTER 0 AND 1; * 00423000
* IF THE CALCULATION IS SUCCESSFUL, THE SECTOR NUMBER * 00424000
* (FROM 0 TO 127) IS RETURNED IN REGISTER 0. * 00425000
* * 00426000
* IF ANY ERRORS WERE DETECTED, THE NO-OP SET-SECTOR * 00427000
* VALUE OF 255 (X'FF') IS RETURNED. * 00428000
* * 00429000
* 00430000
* SVC 95: EXIT AB: EXIT FROM ABNORMAL TASK TERMINATION 00431000
* ROUTINE AND CONTINUE THE TASK. 00432000
* 00433000
* THE LINKAGE TO EITHER THE PC OR AB ROUTINE IS 00434000
* REESTABLISHED, AND THE CANCEL CONDITION IS RESET 00435000
* BY CLEARING THE ABEND INDICATION IN THE PART- 00436000
* ITION PIB EXTENSION. CONTROL IS RETURNED TO THE 00437000
* INSTRUCTION FOLLOWING THE EXIT AB MACRO. 00438000
* 00439000
* THE FOLLOWING SVC'S ARE HANDLED AS A NO-OP; IN EACH CASE, * 00440000
* REGISTER 15 IS CLEARED TO SIMULATE SUCCESSFUL OPERATION, * 00441000
* AND ALL OTHER REGISTERS ARE RETURNED UNCHANGED, UNLESS * 00442000
* OTHERWISE NOTED: * 00443000
* * 00444000
* SVC 10: SET TIMER INTERVAL * 00445000
* SVC 18: STXIT (IT) * 00446000
* SVC 20: ESTABLISH LNKGE TO OC * 00447000
* SVC 22: SEIZE (INTERRUPT ENABLE/DISABLE) * 00448000
* SVC 24: SET TIMER INTERVAL * 00449000
* SVC 35: HOLD A TRACK * 00450000
* SVC 36: FREE A TRACK * 00451000
* SVC 41: DEQUEUE A RESOURCE * 00452000
* SVC 42: ENQUEUE A RESOURCE * 00453000
* SVC 52: RETURN REMAINING TIMER INTERVAL * 00454000
* (REGISTER 0 IS ALSO CLEARED) * 00455000
* SVC 67: PFIX, FIX PAGES IN REAL STORAGE * 00456000
* SVC 68: PFREE, FREE PAGES IN REAL STORAGE * 00457000
* SVC 71: SETPFA * 00458000
* SVC 85: RELPAG * 00459000
* SVC 86: FCEPGOUT * 00460000
* SVC 87: PAGEIN * 00461000
* * 00462000
* THE FOLLOWING SVC'S ARE NOT SUPPORTED BY DMSDOS; * 00463000
* IF ANY OF THEM IS ISSUED, AN ERROR MESSAGE WILL BE * 00464000
* GIVEN, AND THE SVC WILL BE TREATED AS A "CANCEL": * 00465000
* * 00466000
* SVC 3: FORCE DEQUEUE * 00467000
* SVC 13: SET SWITCHES IN BGCOM * 00468000
* SVC 15: HEADQUEUE & EXECUTE CHANNEL PGM. * 00469000
* SVC 19: RETURN FROM USER'S IT * 00470000
* SVC 23: LOAD PHASE HEADER * 00471000
* SVC 25: ISSUE HALT I/O * 00472000
* SVC 27: SPECIAL HALT I/O * 00473000
* SVC 28: RETURN FROM USER'S MR * 00474000
* SVC 29: MULTIPLE WAITM SUPPORT * 00475000
* SVC 30: WAIT FOR QTAM ELEMENT * 00476000
* SVC 31: POST A QTAM ELEMENT * 00477000
* SVC 32: RESERVED * 00478000
* SVC 38: INITIALIZE A SUBSTASK * 00479000
* SVC 39: TERMINATE A SUBSTASK * 00480000
* SVC 43: RESERVED * 00481000
* SVC 44: EXTERNAL UNIT CHECKS RECORD * 00482000
* SVC 45: EMULATOR INTERFACE * 00483000
* SVC 46: OLTEP IN SUPERVISOR STATE * 00484000
* SVC 47: MULTIPLE WAITF SUPPORTATE * 00485000
* SVC 48: FETCH A CRT TRANS * 00486000
* SVC 49: RESERVED * 00487000
* SVC 51: RETURN PHASE HEADER * 00488000
* SVC 53: RESERVED * 00489000
* SVC 54: FREE REAL PAGE FRAMES * 00490000
* SVC 55: GET REAL PAGE FRAMES * 00491000
* SVC 56: GET/FREE PUB OF POWER DEVICE * 00492000
* SVC 57: MAKE POWER DISPATCHABLE * 00493000
* SVC 58: INT. BETWEEN JCL AND SUPVSOR * 00494000
* SVC 59: INT. BETWEEN EOJ AND SUPVSOR * 00495000
* SVC 60: EREP AND CRT I/O AREAS ADDR. * 00496000
* SVC 69: REALAD * 00497000
* SVC 70: VIRTAD * 00498000
* SVC 72: GETCBUF/FREECBUF * 00499000
* SVC 73: SETAPP * 00500000
* SVC 74: FIX PAGES IN REAL STORAGE FOR RESTART * 00501000
* SVC 76: INIT. RECORD. OF RMSR IO ERROR * 00502000
* SVC 77: TRANSCSW * 00503000
* SVC 78: RESERVED * 00504000
* SVC 79: RESERVED * 00505000
* SVC 80: RESERVED * 00506000
* SVC 81: RESERVED * 00507000
* SVC 82: RESERVED * 00508000
* SVC 83: RESERVED * 00509000
* SVC 84: RESERVED * 00510000
* SVC 88 AND UP: RESERVED * 00511000
* * 00512000
* NOTE1: SVC 2, 8, 9, AND 11 ALL PASS CONTROL TO OR * 00513000
* FROM A LOGICAL TRANSIENT. IN ADDITION, THEY * 00514000
* ALL PERFORM ANOTHER COMMON FUNCTION. * 00515000
* THE INTERRUPT INFORMATION AT THE TIME OF THE SVC * 00516000
* IS STORED IN THE PARTITION PIB EXTENSION TABLE. * 00517000
* THE USER'S REGISTERS AND PSW ARE SAVED IN THE * 00518000
* PROBLEM PROGRAM SAVE AREA OR LTA SAVE AREA, * 00519000
* DEPENDING ON THE SAVE AREA ADDRESS SPECIFIED * 00520000
* IN THE PARTITION PIB. * 00521000
* UNDER CMS/DOS THERE IS A PARTITION PIB AND AN * 00522000
* ATTENTION PIB. EACH OF THE PIBS CONTAINS A * 00523000
* SAVEAREA ADDRESS (PPSAVE OR LTASAVE). WHEN ANY * 00524000
* OF THE ABOVE SVC'S ARE EXECUTED, PART OF THE * 00525000
* SUPPORT IS THE SWAPPING OF THESE SAVE AREA * 00526000
* ADDRESSES. (IE.; * 00527000
* THE SAVEAREA ADDRESS IN THE PARTITION PIB * 00528000
* IS SWAPPED WITH THE SAVEAREA ADDRESS IN THE * 00529000
* ATTENTION PIB). THE SAME HOLDS FOR THE PIB * 00530000
* EXTENSIONS ( THE INTERRUPT INFORMATION IN THE * 00531000
* PARTITION PIB EXTENSION IS SWAPPED WITH THE * 00532000
* INTERRUPT INFORMATION IN THE ATTENTION PIB * 00533000
* EXTENSION). * 00534000
*. * 00535000
EJECT 00536000
SPACE 3 00537000
MACRO 00538000
JTBL &SVC,&ADD 00539000
DC S(&ADD) 00540000
MEND 00541000
EJECT 00542000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00543000
* * 00544000
* INITIALIZATION: SET-UP NEEDED REGISTERS, AND ESTABLISH * 00545000
* COMMON ADDRESSABILITIES. USE THE SVC NUMBER FROM THE * 00546000
* SVC OLDPSW TO LOCATE THE ROUTINE THAT WILL PROCESS * 00547000
* THIS PARTICULAR SVC CALL. * 00548000
* * 00549000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00550000
SPACE 1 00551000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00552000
SPACE 1 00553000
DMSDOS CSECT @V305001 00554000
USING NUCON,R0 ADDRESSABILITIES @V305001 00555000
USING DMSDOS,R12 ... @V305001 00556000
USING SSAVE,R13 ... @V305001 00557000
USING BGCOM,R5 @V305001 00558000
L R13,CURRSAVE GET CURRENT SSAVE ADDRESS @V305001 00559000
ST R14,OSTEMP SAVE RETURN ADDRESS @V305001 00560000
LM R0,R11,EGPR0 RESTORE REGS @V305001 00561000
LM R14,R15,EGPR14 TO VALUE AT TIME OF SVC @V305001 00562000
L R5,ASYSREF R5 CONTAINS ADDRESS OF BGCOM @V305001 00563000
SR R4,R4 CLEAR R4 @V305001 00564000
IC R4,OLDPSW+3 GET SVC NUMBER @V305001 00565000
ALR R4,R4 MULTIPLY BY 2 @V305001 00566000
C R4,SVCMAX EXCEEDS MAX ALLOWED ? @V305001 00567000
LH R4,SVCTAB(R4) GET S-CON VECTOR (PRESERVES C.C.)@V305001 00568000
BL DMSDOS(R4) IF < MAX, GO TO SPECIFIED ROUTINE@V305001 00569000
B NOTSUP SVC NUMBERS > MAX NOT SUPPORTED. @V305001 00570000
EJECT 00571000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00572000
* * 00573000
* THE FOLLOWING CODE STORES INTERRUPT INFORMATION IN THE * 00574000
* PIB EXTENSION AFTER AN SVC HAS BEEN ISSUED. * 00575000
* THIS ROUTINE ALSO STORES THE OLD PSW AND THE USER REGISTERS * 00576000
* IN THE USER SAVEAREA. * 00577000
* * 00578000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00579000
SPACE 1 00580000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 00581000
SPACE 1 00582000
COMMON CLC ABTERM,0(R1) FETCH FOR ABNORM TERM ROUT. @V305066 00583000
BNE REGFETCH NO, NORMAL FETCH PROCESSING @V305066 00584000
L R14,OSTEMP GET RETURN VALUE IN R14 @V305066 00585000
L R12,ABTERM+8 ABNORM TERM ROUT. ADD @V305066 00586000
BR R12 BR TO THIS ROUTINE @V305066 00587000
REGFETCH LH R10,PIK PROGRAM INTERRUPT KEY @V305066 00588000
USING PIBADR,R10 ESTABLISH ADDRESSABILITY @V305066 00589000
AH R10,PIBPT INCREM R10 BY ADD OF PIB @V305066 00590000
* 00591000
* R10 NOW POINTS TO THE PARTITION PIB 00592000
* 00593000
SH R10,PIBDIFF @V305066 00594000
* 00595000
* R10 NOW POINTS TO THE PARTITION PIB EXTENSION 00596000
* 00597000
SR R4,R4 CLEAR WORK REG @V305066 00598000
* 00599000
* THE FOLLOWING INSTRUCTIONS PLACE THE INTERRUPT INFORMATION 00600000
* IN THE PARTITION PIB EXTENSION 00601000
* THE FORMAT OF THE INTERRUPT INFORMATION IN THE PIB EXTENSION 00602000
* IS AS FOLLOWS: 00603000
* 00604000
* BYTE 0 - X'00' 00605000
* BYTE 1 - ILC IN BITS 5,6; OTHER BITS ARE ZERO 00606000
* BYTES 2,3 - INTERRUPTION CODE 00607000
* 00608000
IC R4,OLDPSW+4 INSERT ILC @V305066 00609000
SRL R4,6 SHIFT RIGHT TO ELIMINATE GARBAGE @V305066 00610000
SLL R4,17 SHIFT LEFT TO POSITION IN REG @V305066 00611000
IC R4,OLDPSW+3 COMPLETE INTERRUPT CODE @V305066 00612000
ST R4,INTINFO STORE SVC INTRPT INFO IN PIB EXT @V305066 00613000
EJECT 00614000
LAPIB LA R10,32(R10) RE-ESTABLISH PIB POINTER @V305066 00615000
PIBDIFF EQU LAPIB+2 DISPLACEMT BETWN PIB AND PIB EXT @V305066 00616000
L R8,PIBSAVE GET SAVE AREA ADDRESS @V305066 00617000
USING SVEARA,R8 ESTABLISH ADDRESSABILITY @V305066 00618000
MVC SVEPSW(8),OLDPSW SAVE OLD PSW @V305066 00619000
MVC SVER09(28),EGPR9 USER'S REGS TO PPSAVE/LTASAVE @V305066 00620000
MVC SVER00(36),EGPR0 STORE REST OF USER'S REGS @V305066 00621000
SR R4,R4 CLEAR WORK REG AGAIN @V305066 00622000
IC R4,OLDPSW+3 GET SVC NUMBER @V305066 00623000
CH R4,TWO SVC 2 ? @V305066 00624000
BE FETCHB YES, GO TO FETCHB ROUTINE @V305066 00625000
CH R4,EIGHT SVC 8 ? @V305066 00626000
BE SVC08 GO TO SVC08 ROUTINE @V305066 00627000
CH R4,NINE SVC 9 ? @V305066 00628000
BE SVC09 YES, GO TO SVC09 ROUTINE @V305066 00629000
CH R4,ELEVEN SVC 11 ? @V305066 00630000
BE SVC011 YES, GO TO SVC 11 ROUTINE @V305066 00631000
SPACE 2 00632000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00633000
* * 00634000
* NOT SUPPORTED ERROR * 00635000
* * 00636000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00637000
SPACE 1 00638000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00639000
SPACE 1 00640000
NOTSUP SR R4,R4 GET SVC NUMBER AGAIN @V305001 00641000
IC R4,OLDPSW+3 AND GIVE A DESCRIPTIVE ERROR MSG @V305001 00642000
DMSERR NUM=121,LET=S,MF=(E,'SYS'),TEXTA=ERRMSG0, @V305001*00643000
SUB=(DEC,(R4),HEX,(R4),HEXA,CALLER) @V305001 00644000
LA R0,ABEND21 DOS/VS ABEND CODE @V305001 00645000
LA R15,RC100 MESSAGE RETURN CODE @V305001 00646000
B BABEND CALL $$BABEND @V305001 00647000
EJECT 00648000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00649000
* * 00650000
* EXECUTE CHANNEL PROGRAM. * 00651000
* * 00652000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00653000
SPACE 1 00654000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00655000
SPACE 1 00656000
EXCP L R2,ASYSCOM GET SYSTEM COM.REGION ADDR. @V305001 00657000
USING SYSCOM,R2 @V305001 00658000
L R11,IJBCCWT GET EXCP WORK AREA ADDRESS @V305001 00659000
DROP R2 @V305001 00660000
L R15,=V(DMSXCP) GET DMSXCP ADDRESS @V305001 00661000
BALR R14,R15 GO TO EXCP EXECUTOR @V305001 00662000
LTR R15,R15 ANY ERRORS IN DMSXCP ? @V305001 00663000
BZ DOSRET NO, RETURN TO CALLER @V305001 00664000
LA R0,ABEND1A DOS/VS ABEND CODE @V305001 00665000
B BABEND CALL $$BABEND @V305001 00666000
SPACE 2 00667000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00668000
* * 00669000
* FETCH A PROBLEM PROGRAM PHASE INTO USER STORAGE * 00670000
* * 00671000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00672000
SPACE 1 00673000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00674000
SPACE 1 00675000
FETCHA SR R0,R0 NO USER ENTRY POINT @V305001 00676000
BAL R14,LOAD2 GO PREPARE LIST FOR FETCH @V305001 00677000
LTR R15,R15 ANY ERRORS ? @V305001 00678000
BNZ FCHERRS YES, CALL $$BABEND @V305001 00679000
LR R2,R0 R0 TO USABLE REGISTER @V305001 00680000
USING DIRNAME,R2 @V305001 00681000
TM DIRC,PNOTFND PHASE FOUND ? @V305001 00682000
BO ERR06E NO, GIVE MSG AND CANCEL @V305001 00683000
DROP R2 @V305001 00684000
ICM R2,M7,EGPR0+1 ANY USER ENTRY POINT ? @V305001 00685000
BZ FETCHA2 NO, USE DEFAULT @V305001 00686000
LR R1,R2 USE USER'S ENTRY POINT THEN.. @V305001 00687000
FETCHA2 ST R1,OLDPSW+4 SET UP PSW FOR NEW PHASE @V305001 00688000
MVI OLDPSW+4,HEX00 ... @V305001 00689000
B DOSRET RETURN TO CMS @V305001 00690000
EJECT 00691000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00692000
* * 00693000
* FETCH A $$B-TRANS INTO CMS TRANSIENT AREA * 00694000
* * 00695000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00696000
SPACE 1 00697000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00698000
SPACE 1 00699000
FETCHB LA R9,DCSSTAB GET TABLE OF RESIDENT $$B-TRANS @V305001 00700000
L R8,0(,R9) GET END ADDRESS OF TABLE @V305001 00701000
LA R9,4(,R9) POINT TO 1ST. PHASE @V305001 00702000
FETLUP CR R9,R8 ARE WE AT END OF TABLE @V305001 00703000
BNL FETCHIT YES, PHASE NOT IN DCSS @V305001 00704000
CLC 0(8,R9),0(R1) PHASE NAME MATCH ? @V305001 00705000
BE DCSSPHS YES, PHASE IN DCSS AREA @V305001 00706000
LA R9,12(,R9) BUMP TO NEXT PHASE @V305001 00707000
B FETLUP KEEP LOOKING @V305001 00708000
DCSSPHS CLC 0(8,R9),BOSDEV FEOVD MACRO NOT SUPPORTED @V305001 00709000
BE FEOVDERR EQUAL TO $$BOSDEV @V305001 00710000
CLC 0(8,R9),BCEOV1 SEOV/FEOV NOT SUPPORTED @V305001 00711000
BE SEOVFEOV EQUAL TO ONE OF THESE MACROS @V305001 00712000
L R9,8(,R9) GET PHASE LOAD PT @V305001 00713000
B FETCOMM GO TO COMMON CODE @V305001 00714000
FEOVDERR LA R2,FEOVD PREPARE MESSAGE @V305001 00715000
B ERR140S BR TO PRINT MSG @V305001 00716000
SEOVFEOV LA R2,SEOV PREPARE MESSAGE @V305001 00717000
B ERR140S BR TO PRINT MESSAGE @V305001 00718000
EJECT 00719000
FETCHIT SR R0,R0 ... @V305001 00720000
CLC 0(8,R1),BEOJ4 $$BACLOS CALLING? @V305001 00721000
BNE TRANSADR NO, CONTINUE AS USUAL @V305106 00722000
L R9,AVSREOJ YES, GO BACK TO DMSVSR @V305106 00723000
B SAVENTRY PLAY THE GAME... @V305106 00724000
TRANSADR ICM R0,M7,DOSTRANS+1 GET A(DOS TRANS AREA) @V305106 00725000
LR R7,R10 SAVE REG. 10 TEMP @V305001 00726000
BAL R14,LOAD2 GO PREPARE FETCH LIST @V305001 00727000
LR R2,R0 REG. 0 TO USABLE REGISTER @V305001 00728000
USING DIRNAME,R2 @V305001 00729000
TM DIRC,PNOTFND PHASE FOUND ? @V305001 00730000
BO ERR06E NO, GIVE MSG AND CANCEL @V305001 00731000
DROP R2 @V305001 00732000
FETFND L R5,ABGCOM RESTORE BGCOM POINTER @V305001 00733000
LR R10,R7 ALSO R10 THAT WE SAVED BEFORE... @V305001 00734000
LTR R15,R15 ANY ERRORS IN DMSFCH ? @V305001 00735000
BNZ FCHERRS IF ERRORS, CALL $$BABEND @V305001 00736000
L R9,DOSTRANS GET LOAD POINT IN R9 @V305106 00737000
SAVENTRY EQU * @VA05918 00738000
ST R9,EGPR15 @VA05918 00739000
L R9,AFVS @VA05918 00740000
USING FVSECT,R9 @VA05918 00741000
TM UFDBUSY,ABNBIT WAS HX ENTERED? @VA05918 00742000
L R9,EGPR15 RESTORE THE REGISTER @VA05918 00743000
BNZ TESTVSAM YES @VA12124 00744000
DROP R9 @VA05918 00745000
FETCOMM L R8,ALTASAVE ADDRESS OF LTA SAVEAREA @V305001 00746000
L R15,EGPR15 RESTORE USER'S R15 @V305001 00747000
LM R0,R1,EGPR0 RESTORE USER'S R0 AND R1 @V305001 00748000
STM R15,R1,SVER0F STORE REGS 0, 1, 15 IN LTASAVE @V305001 00749000
LA R9,8(,R9) EPA IN TRANSIENT PHASE = EPA+8 @V305001 00750000
ST R9,SVEPSW2 MOVE THIS EPA INTO SEC HALF PSW @V305001 00751000
NI OLDPSW+1,RESETSK RESET PSW STORAGE KEY @V305001 00752000
ST R9,OLDPSW+4 SAME AS ABOVE FOR CMS PSW @V305001 00753000
MVI PIBFLG,READY MAKE TASK READY TO RUN @V305001 00754000
CLC ALTASAVE+1(3),PIBSAVE+1 REQUEST FROM LOG.TRANS?@V305001 00755000
BE DOSRET YES, RETURN @V305001 00756000
BAL R6,SWAP SET/RESET PIB AND PIB EXT INFO @V305001 00757000
B DOSRET RETURN @V305001 00758000
TESTVSAM EQU * @VA12124 00758200
TM VSAMFLG1,VSAMRUN ARE WE HERE FOR VSAM ? @VA12124 00758400
BO FETCOMM YES,BRANCH @VA12124 00758600
B DOSRET NO,GO TO DOSRET @VA12124 00758800
EJECT 00759000
FETVSAM LR R4,R2 SAVE TRANS NAME POINTER @V305001 00760000
L R0,DOSTRANS GET DOS TRANS AREA BEGIN @V305106 00761000
LR R2,R1 POINT TO VSAM TRANS BEGIN @V305001 00762000
L R1,20(,R3) GET ADDRESS NEXT PHASE IN SEGMENT@V305001 00763000
SR R1,R2 AND COMPUTE THIS PHASE LENGTH. @V305001 00764000
BNP FETVSAME IF NOT VALID LENGTH, DO LONG WAY.@V305001 00765000
LR R3,R1 SAME FOR R2 + 1 REGISTER @V305001 00766000
MVCL R0,R2 MOVE VSAM TRANS TO TRANS AREA @V305001 00767000
LR R2,R4 RESTORE TRANS NAME POINTER @V305001 00768000
SR R15,R15 ZERO FOR ABOVE TEST @V305001 00769000
B FETFND CONTINUE AS IF DMSFCH FOUND IT @V305001 00770000
FETVSAME LR R1,R4 RESET R1 TO POINT TO PHASE NAME. @V305001 00771000
L R0,DOSTRANS AND R0 TO DOS TRANSIENT AREA @V305001 00772000
B LOAD7 NOW TRY TO LOAD THROUGH DMSFCH. @V305001 00773000
SPACE 1 00774000
LOADAMS CLI OLDPSW+3,SVC2CALL WAS CALL FROM SVC 2 ? @V305001 00775000
BE FETVSAM YES, CONTINUE ABOVE @V305001 00776000
CLI OLDPSW+3,SVC4CALL WAS CALL FROM SVC 4 ? @V305001 00777000
BNER R14 IF NOT, RETURN TO CALLER @V305001 00778000
LR R4,R1 SAVE SEGMENT PHASE LOAD ADDRESS @V305001 00779000
ICM R2,15,EGPR0 GET USER'S LOAD POINT ADDRESS @V305001 00780000
BNP VSAMPNF INVALID ADDRESS - NOT FOUND @VA12893 00781000
L R3,20(,R3) GET ADDRESS NEXT PHASE IN SEGMENT@V305001 00782000
SR R3,R4 COMPUTE LOADED PHASE LENGTH @V305001 00783000
BNP VSAMPNF INVALID LENGTH - NOT FOUND @VA12893 00784000
LR R5,R0 GET ADDRESS OF PHASE NAME @VM03230 00785000
CLC 0(8,R5),BTRANS IS IT $$BOMSG7 ? @VM03230 00786000
BNE LENOK NO, DON'T CHANGE LENGTH @VM03230 00787000
SH R3,FOUR ADJUST LENGTH - 4 @VM03230 00788000
LENOK LR R5,R3 SET R5 TO CONTAIN LENGHT TOO @VM03230 00789000
LR R1,R2 SAVE LOAD ADDRESS FOR NOW... @V305001 00790000
MVCL R2,R4 MOVE PHASE FROM SGT TO USER AREA @V305001 00791000
SR R15,R15 SET RETURN CODE OF ZERO @V305001 00792000
LR R2,R0 GET ADDRESS OF PHASE DIRECTORY @V305001 00793000
CLC 0(8,R2),IKQVDCN IS IT SPECIAL CASE ? @V305001 00794000
BNER R14 NO, JUST RETURN TO LOAD MAINLINE @V305001 00795000
LA R3,24(,R1) POINT TO CCW(S) ADDRESS IN DTF @V305001 00796000
ST R3,8(,R1) AND SAVE IN PROPER SLOT IN DTF @V305001 00797000
LA R3,48(,R1) GET ADDRESS OF DTFCN LIOCS @V305106 00798000
STCM R3,M7,17(R1) AND SAVE IN PROPER SLOT IN DTF @V305106 00799000
BR R14 RETURN TO LOAD MAINLINE @V305001 00800000
EJECT 00801000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00802000
* * 00803000
* THIS ROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * 00804000
* * 00805000
* SET/RESETS THE LOGICAL TRANSIENT KEY (LTK) * 00806000
* * 00807000
* SWAPS THE SAVE AREA ADDRESSES IN THE ATTENTION * 00808000
* PIB WITH THE ADDRESSES IN THE PARTITION PIB. * 00809000
* * 00810000
* SWAPS INTERRUPT INFORMATION IN THE ATTENTION PIB EXT * 00811000
* WITH INTERRUPT INFORMATION IN THE PARTITION PIB EXT. * 00812000
* * 00813000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00814000
SPACE 1 00815000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 00816000
SPACE 1 00817000
SWAP XC LTK+1(1),PIK+1 SET/RESET LTK @V305066 00818000
SETLT L R8,PIBSAVE GET SAVEAREA ADDRESS @V305066 00819000
LH R2,PIBPT ADDRESS OF PIB @V305066 00820000
MVC PIBSAVE+1(3),9(R2) SWAP SAVE AREA ADDRESSES @V305066 00821000
STCM R8,M7,9(R2) @V305066 00822000
LH R2,PIB2PTR GET ATTENTION PIB EXT @V305066 00823000
SH R10,PIBDIFF ADJ. R10 POINTER TO PART PIB2TAB @V305066 00824000
L R8,INTINFO GET INTERRUPT INFOR AND SWAP @V305066 00825000
MVC INTINFO,4(R2) W/INTRPT INFO IN ATTEN. PIB2TAB @V305066 00826000
ST R8,4(R2) SWAP INTERRUPT INFORMATION @V305066 00827000
AH R10,PIBDIFF RESTORE ORIG PIB PTR @V305066 00828000
BR R6 RETURN TO MAINLINE @V305066 00829000
SPACE 2 00830000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00831000
* * 00832000
* LOAD A PROBLEM PROGRAM PHASE INTO USER STORAGE * 00833000
* * 00834000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00835000
SPACE 1 00836000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00837000
SPACE 1 00838000
LOAD BAL R14,LOAD2 GO TO COMMON ROUTINE @V305001 00839000
LTR R15,R15 ANY ERRORS ? @V305001 00840000
BNZ FCHERRS YES, CALL $$BABEND @V305001 00841000
ST R1,EGPR1 SAVE ENTRY POINT @V305001 00842000
LR R2,R0 DIRECTORY TO USABLE REGISTER @V305001 00843000
USING DIRNAME,R2 @V305001 00844000
TM DIRC,NOTEXT+DACTIVE TXT=NO WITH DE=YES / LIST=?@V305001 00845000
BO LOADOK YES, GIVE USER DIRECTORY ADDR. @V305001 00846000
TM DIRC,PNOTFND WAS PHASE FOUND ? @V305001 00847000
BZ DOSRET YES, RETURN TO CALLER @V305001 00848000
B ERR06E ELSE GIVE MESSAGE AND CANCEL @V305001 00849000
DROP R2 @V305001 00850000
LOADOK ST R0,EGPR0 SAVE DIRECTORY ADDRESS @V305001 00851000
B DOSRET RETURN TO CALLER @V305001 00852000
EJECT 00853000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00854000
* * 00855000
* SUBROUTINE TO DECODE FETCH/LOAD PARAMETER LIST. VALID * 00856000
* PARAMETERS ARE: DE = YES, TXT = NO, OR LIST = LISTNAME. * 00857000
* * 00858000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00859000
SPACE 1 00860000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 00861000
SPACE 1 00862000
LOAD2 CLI 0(R1),ANYPARM ANY PARAMETERS SPECIFIED ? @V305001 00863000
BNE ONLINE NO, NO ON-LINE LIST THEN.. @V305001 00864000
TM 4(R1),DEEQYES DE = YES ? @V305001 00865000
BO DEYES YES, BRANCH @V305001 00866000
ONLINE L R2,ASYSCOM GET SYSCOM ADDRESS @V305001 00867000
USING SYSCOM,R2 @V305001 00868000
L R2,IJBFTTAB GET FETCH WORK TABLE @V305001 00869000
DROP R2 @V305001 00870000
USING FCHTAB,R2 @V305001 00871000
LA R2,DIRNAME POINT TO IN-CORE DIRECTORY @V305001 00872000
DROP R2 @V305001 00873000
USING DIRNAME,R2 @V305001 00874000
XC 0(34,R2),0(R2) ZERO DIRECTORY @V305001 00875000
MVI DIRN,LENGTH SET UP LENGTH IN H-WORDS @V305001 00876000
CLI 0(R1),ANYPARM ANY PARAMETERS SPECIFIED ? @V305001 00877000
BNE NOLIST NO, NO ON-LINE LIST THEN.. @V305001 00878000
SR R5,R5 .... @V305001 00879000
L R6,0(,R1) POINT TO PHASE NAME @V305001 00880000
ICM R5,M7,5(R1) ANY LIST POINTER ? @V305001 00881000
BZ LOAD4 NO, BRANCH @V305001 00882000
LA R3,2(,R5) POINT TO 1ST. LIST ELEMENT @V305001 00883000
LA R4,ELEMLEN GET LIST ELEMENT LENGTH @V305001 00884000
AH R5,0(,R5) POINT TO PARAM LIST END @V305001 00885000
SH R5,TWO COMPENSATE FOR 2 BYTES LENGTH @V305001 00886000
SR R5,R4 POINT TO LAST ITEM @V305001 00887000
LOAD3 CLC 0(8,R6),0(R3) FOUND A LIST MATCH ? @V305001 00888000
BE LISTFND YES, BRANCH @V305001 00889000
BXLE R3,R4,LOAD3 KEEP LOOKING @V305001 00890000
LOAD4 MVC DIRNAME,0(R6) MOVE PHASE NAME TO OUR LIST @V305001 00891000
LOAD5 NI DIRC,255-NOTEXT RESET TXT=NO @VA05888 00892000
TM 4(R1),NOTEXT TXT=NO SPECIFIED? @VA05888 00893000
BNO LOAD6 NO, BRANCH AROUND @V305001 00894000
OI DIRC,NOTEXT SET FLAG IN DIRECTORY @V305001 00895000
LOAD6 LR R1,R2 DIRECTORY TO R1 @V305001 00896000
BAL R6,VSAMDS SEE IF AMS OR VSAM PHASE @V305001 00897000
BZ LOADAMS IF VSAM OR AMS, THEN RETURN @V305001 00898000
LOAD7 L R15,=V(DMSFCH) GET DMSFCH ADDRESS @V305001 00899000
BR R15 GO TO FETCH ROUTINE @V305001 00900000
DEYES L R2,0(,R1) POINT TO ON-LINE LIST @V305001 00901000
OI DIRC,DACTIVE SET DIRECTORY ACTIVE @V305001 00902000
B LOAD5 GO CHECK TXT = NO @V305001 00903000
NOLIST MVC DIRNAME,0(R1) MOVE PHASE NAME TO DUMMY LIST @V305001 00904000
B LOAD6 GO TO DMSFCH CALL @V305001 00905000
LISTFND LR R2,R3 USER LIST TO R2 @V305001 00906000
OI DIRC,DACTIVE SET DIRECTORY ACTIVE @V305001 00907000
B LOAD5 GO CHECK TXT = NO @V305001 00908000
DROP R2 @V305001 00909000
EJECT 00910000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00911000
* * 00912000
* SVC5: PROVIDES USER WITH MEANS OF ALTERING POSITIONS * 00913000
* 12-23 OF THE PARTITION COMMUNICATION REGION * 00914000
* * 00915000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00916000
SPACE 1 00917000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 00918000
SPACE 1 00919000
MVCOM SR R3,R3 CLEAR REGISTER @V305066 00920000
IC R3,1(,R1) INSERT LENGTH FIELD @V305066 00921000
SR R4,R4 CLEAR REGISTER @V305066 00922000
IC R4,3(,R1) INSERT RELATIVE 'TO ADDRESS' @V305066 00923000
CH R4,TWELVE RELATIVE 'TO ADDRESS' INVALID IF @V305066 00924000
BL ERR03E LESS THAN 12 @V305066 00925000
LA R2,0(R3,R4) PT TO UPMOST BYTE OF COMREG FIELD@V305066 00926000
CH R2,TWENTY4 ONLY VALID TO ALTER POS. 12-23 @V305066 00927000
BNL ERR03E OF COMREG @V305066 00928000
LR R1,R0 COPY 'FROM ADDRESS' @V305066 00929000
LA R2,0(R1,R3) POINT TO LAST BYTE 'FROM' FIELD @V305066 00930000
C R2,PPBEG INSURE 'FROM ADDRESS' IS WITHIN @V305066 00931000
BL ERR04E USER PARTITION LIMITS @V305066 00932000
TM DOSFLAGS,DOSVSAM IS VSAM SET ON ? @VA07500 00932300
BO CKMAINHI YES CHECK MAINHIGH @VA07500 00932600
C R2,PPEND EXCEED END OF PARTITION? @V305066 00933000
BH ERR04E YES @V305066 00934000
B MVCOM1 CONTINUE IF NOT HIGH @VA07500 00934030
CKMAINHI EQU * @VA07500 00934060
C R2,MAINHIGH LAST BYTE 'FROM' EXCEED @VA07500 00934090
* MAINHIGH ? 00934120
BH ERR04E YES, ERROR @VA07500 00934150
L R8,MAINLIST GET FREELIST POINTER @VA07500 00934180
LA R8,0(R8) CLEAR HIGH ORDER BYTE @VA07500 00934210
LTR R8,R8 IS POINTER ZERO ? @VA07500 00934240
BZ MVCOM1 YES, NO MORE CHECKING NEEDED @VA07500 00934270
CHKFREE EQU * @VA07500 00934300
LR R15,R8 LOAD POINTER TO WORK REG @VA13128 00934330
CR R15,R1 IS IT HIGHER THAN FROM ADDR @VA13128 00934360
BH CHKMORE1 YES, CHECK SOME MORE @VA07500 00934390
A R15,4(R15) ADD FREEAREA LENGTH @VA13128 00934420
BCTR R15,R0 SUB 1 FOR TRUE LENGTH @VA13128 00934450
CR R15,R1 IS IT HIGHER THAN FROM ADDR @VA13128 00934480
BH ERR04E YES, ERROR @VA07500 00934510
L R8,0(R8) GET NEXT POINTER @VA07500 00934540
LA R8,0(R8) CLEAR HIGH ORDER BYTE @VA07500 00934570
LTR R8,R8 IS POINTER ZERO ? @VA07500 00934600
BZ MVCOM1 YES (END OF FREELIST) @VA07500 00934630
B CHKFREE CHECK NEXT AREA @VA07500 00934660
CHKMORE1 EQU * @VA07500 00934690
CR R15,R2 HIGHER THAN LAST BYTE OF @VA13128 00934720
* 'FROM' ? 00934750
BNH ERR04E NO,ERROR @VA07500 00934780
MVCOM1 AR R4,R5 CALCULATE RIGHT DISP IN COMREG @VA07500 00935000
EX R3,MVC MOVE INFORMATION TO COMREG @V305066 00936000
B DOSRET @V305066 00937000
MVC MVC 0(0,R4),0(R1) MVCOM @V305066 00938000
SPACE 2 00939000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00940000
* * 00941000
* SVC08 - TEMPORARILY RETURN FROM A B-TRANSIENT TO * 00942000
* THE PROBLEM PROGRAM. * 00943000
* * 00944000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00945000
SPACE 1 00946000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 00947000
SPACE 1 00948000
SVC08 LH R2,PIBPT POINT TO ATTENTION PIB @V305066 00949000
DROP R10 @V305066 00950000
USING PIBADR,R2 PIB BASE REGISTER @V305066 00951000
L R8,ARFLG POINT TO PP SAVEAREA BYTES 9-11 @V305066 00952000
USING PIBADR,R10 OF ATTENTION PIB @V305066 00953000
L R7,PIBSAVE PTR TO LTA SAVE @V305066 00954000
MVC 44(4,R7),SVEPSW2 SAVE PP PSW ADDR IN LTA R0 @V305066 00955000
MVC SVEPSW2+1(3),37(R7) STOR ADDR PASSD BY TRANSIENT@V305066 00956000
STM R0,R1,SVER00 STORE REGISTERS @V305066 00957000
ST R15,SVER0F DITTO... @V305066 00958000
BAL R6,SETLT BRANCH TO SWAP SAVE ADDRESSES @V305066 00959000
B STOREPSW CONTROL MUST RETURN TO PROB PROG @V305066 00960000
EJECT 00961000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00962000
* * 00963000
* SVC09 - RETURN TO A LOGICAL TRANSIENT AFTER AN SVC 08 * 00964000
* * 00965000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00966000
SPACE 1 00967000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 00968000
SPACE 1 00969000
SVC09 LH R2,PIBPT POINT TO ATTENTION PIB @V305066 00970000
DROP R10 @V305066 00971000
USING PIBADR,R2 R10 BASE REG @V305066 00972000
L R8,ARFLG POINT TO LTA SAVE AREA @V305066 00973000
USING PIBADR,R10 @V305066 00974000
L R7,PIBSAVE GET PTR TO PP SAVE AREA @V305066 00975000
MVC 12(4,R7),SVER00 RESTORE PP PSW ADDRESS @V305066 00976000
STM R0,R1,SVER00 PASS REGS 0,1 @V305066 00977000
BAL R6,SETLT @V305066 00978000
B STOREPSW CONTROL MUST RETURN TO TRANSIENT @V305066 00979000
SPACE 2 00980000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00981000
* * 00982000
* SVC11 - RETURNS FROM A LOGICAL B-TRANSIENT * 00983000
* TO THE PROBLEM PROGRAM. * 00984000
* * 00985000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00986000
SPACE 1 00987000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 00988000
SPACE 1 00989000
SVC011 CLC ALTASAVE+1(3),PIBSAVE+1 REQUEST FROM LTA? @V305066 00990000
BNE ERR01E ILLEGAL SVC @V305066 00991000
BAL R6,SWAP GO TO FLIP-FLOP SAVE AREA ADDRS @V305066 00992000
STOREPSW L R8,PIBSAVE ADDR OF PART PIB SAVEAREA ADDR @V305066 00993000
MVC OLDPSW(8),SVEPSW WHEN DMSITS GETS CONTROL IT @V305066 00994000
MVC EGPR0(36),SVER00 WILL RETURN CNTL TO INSTRUC @V305066 00995000
MVC EGPR9(28),SVER09 INDICATED IN OLDPSW @V305066 00996000
B DOSRET @V305066 00997000
EJECT 00998000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00999000
* * 01000000
* SVC12: RESETS FLAGS TO 0 IN THE LINKAGE CONTROL * 01001000
* BYTE OF COMREG. * 01002000
* IF R1 = 0, SVC12 HAS ANOTHER MEANING. * 01003000
* BIT 5 OF JCSW4 (COMREG BYTE 59 IS TURNED OFF * 01004000
* * 01005000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01006000
SPACE 1 01007000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01008000
SPACE 1 01009000
SVC012 LTR R1,R1 IF R1 IS NOT ZERO @V305066 01010000
BNZ SVC12A GO TO NORMAL SVC12 ROUTINE @V305066 01011000
NI JCSW4,JC59OFF TURN OFF BIT 5 OF BYTE 59 @V305066 01012000
B DOSRET @V305066 01013000
SVC12A BAL R6,SVC1213 TEST FOR GEN PURPOSE SVC @V305066 01014000
NC 0(1,R1),SVC12SAV+3 @V305066 01015000
* RETURN HERE FOR 'OLD' DEFINITION OF SVC12 01016000
NC JCSW2,0(R1) TURN OFF BITS SPECIFIED BY R1 @V305066 01017000
B DOSRET @V305066 01018000
SVC1213 ST R1,SVC12SAV STORE R1 IN WORK @V305066 01019000
CLI SVC12SAV,XFF NEW DEFINITION? @V305066 01020000
BNE 6(R6) NO, OLD SVC12/13 DEFINITION @V305066 01021000
SR R1,R1 ZERO R1 @V305066 01022000
IC R1,SVC12SAV+2 GET COMREG DISPLACEMENT @V305066 01023000
AR R1,R2 ADD COMREG ADDRESS @V305066 01024000
EX R0,0(R6) TURN OFF BITS @V305066 01025000
B DOSRET @V305066 01026000
EJECT 01027000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01028000
* * 01029000
* CANCEL THE JOB. ISSUE MESSAGE 'JOB CANCELLED DUE TO * 01030000
* PROGRAM REQUEST' , AND GO TO DMSABN. * 01031000
* * 01032000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01033000
SPACE 1 01034000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01035000
SPACE 1 01036000
CANCELS ST R15,EGPR15 SET UP RETURN CODE IN SAVE AREA @V305001 01037000
CANCEL L R5,ASYSREF RE-INITIALIZE BGCOM ADDRESS @V305001 01038000
LA R15,ERR12 SET AMSERV RETURN CODE @VM03230 01039000
TM VSAMFLG1,VSAMSERV IS AMSERV RUNNING ? @VM03230 01040000
BO BABEND YES, GO EXIT THROUGH STXIT. @VM03230 01041000
DMSERR NUM=160,LET=S,SUB=(CHARA,COMNAME), @V305001*01042000
TEXT='JOB ''........'' CANCELLED DUE TO PROGRAM REQUEST' 01043000
L R10,EGPR15 GET USER'S R15 @V305001 01044000
CH R10,H255 EXCEEDS MAX. CMS RET CODE ? @V305001 01045000
BNH SETRETC NO, USE THIS RETURN CODE @V305001 01046000
LA R10,RC101 SPECIAL CODE @V305001 01047000
SETRETC STC R10,DOSRC SAVE IN NUCON @V305001 01048000
EOJ XC LTK(2),LTK ZERO LOG TRANS. KEY @V305001 01049000
LH R10,PIBPT PIB ADDRESS @V305001 01050000
L R6,ALTASAVE LTA SAVE AREA ADDRESS @V305001 01051000
ST R6,8(,R10) STORE IN ATTEN. PIB @V305001 01052000
L R6,APPSAVE PPSAVE ADDRESS @V305001 01053000
LA R10,16(,R10) POINT TO PART. PIB @V305001 01054000
ST R6,4(,R10) STORE IN PART. PIB @V305001 01055000
LH R10,PCPTR PTR TO BEG PC OPT. TABLE @V305001 01056000
LH R6,PIK PROGRAM INTERRUPT KEY @V305001 01057000
SRL R6,1 8-BYTE TABLE ENTRY BUT @V305001 01058000
AR R10,R6 TABLES OFFSET BY 8 BYTES @V305001 01059000
XC 0(4,R10),0(R10) ZERO PC OPT. TAB. ENTRY @V305001 01060000
L R1,ASYSCOM SYSCOM ADDRESS @V305001 01061000
USING SYSCOM,R1 ADDRESSABILITY @V305001 01062000
L R10,IJBABTAB BEG ADD AB OPT. TAB. @V305001 01063000
AR R10,R6 TAB. OFFSET BY 8 BYTES @V305001 01064000
XC 0(4,R10),0(R10) ZERO ROUT. ADD. IN TABLE @V305001 01065000
EJECT 01066000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01067000
* * 01068000
* EOJ (NORMAL END OF JOB) * 01069000
* UNSTACK LAST SVC WORK AREA, AND RETURN TO CMS * 01070000
* * 01071000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01072000
SPACE 1 01073000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01074000
SPACE 1 01075000
EOJ1 LA R1,EOJ2 GET FINAL END ADDRESS @V305001 01076000
ST R1,OLDPSW+4 SAVE AS OLD PSW @V305001 01077000
NI OLDPSW+1,RESETSK RESET PSW STORAGE KEY @V305001 01078000
B DOSRET RETURN TO CMS @V305001 01079000
EOJ2 BALR R15,0 ESTABLISH ADDRESSABILITY @V305001 01080000
USING *,R15 @V305001 01081000
L R12,=A(DMSDOS) RESTORE ADDRESSABILITY TO R12 @V305001 01082000
DROP R15 @V305001 01083000
LA R1,FCLEAR GET FILEDEF CLEAR LIST ADDRESS @V305001 01084000
SVC 202 CLEAR DOSLIB FCB @V305001 01085000
DC AL4(*+4) ... @V305001 01086000
TM VSAMFLG1,VSAMRUN+VIPINIT IF NOT VSAM JOB OR... @V305106 01087000
BNM NOVSAM OS VSAM JOB, SKIP CLEANUP @V305106 01088000
LA R1,VSRLIST YES, CALL DMSVSR TO @V305106 01089000
SVC 202 CLEANUP AFTER AND RELEASE VSAM @V305106 01090000
DC AL4(*+4) ... @V305106 01091000
NOVSAM L R5,ABGCOM GET COMM. REGION ADDRESS @V305106 01092000
MVC COMNAME,NONAME RE-INITIALIZE JOB NAME @V305001 01093000
SR R15,R15 ... @V305001 01094000
ST R15,PPEND CLEAR PPEND @VA04646 01095000
IC R15,DOSRC GET LAST RETURN CODE @V305001 01096000
MVI DOSRC,HEX00 AND CLEAR DOSRC @VM03230 01097000
L R14,ACMSRET GET CMSRET ADDRESS @V305001 01098000
L R13,CURRSAVE GET CURRENT SAVE AREA POINTER @V305001 01099000
TM TYPFLAG,TPFSVO IS THIS CMS SVC ? @V305001 01100000
BZR R14 YES, JUST RETURN @V305001 01101000
L R14,AOSRET THEN GET OSRET ADDRESS @V305001 01102000
BR R14 RETURN TO DMSITS @V305001 01103000
EJECT 01104000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01105000
* * 01106000
* DETERMINE WHICH DOS/VS ABEND CODE TO USE FOR LOAD/FETCH * 01107000
* ERRORS, AND ISSUE SVC 2 TO $$BABEND TO PROCESS ANY USER * 01108000
* ACTIVE STIXIT AB'S. * 01109000
* * 01110000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01111000
SPACE 1 01112000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01113000
SPACE 1 01114000
FCHERRS LA R0,ABEND2B I/O ERROR ABEND CODE @V305001 01115000
CH R15,H100 WAS IT I/O ERROR ? @V305001 01116000
BE BABEND YES, BRANCH @V305001 01117000
LA R0,ABEND25 MUST BE STORAGE EXCEEDED @V305001 01118000
BABEND ST R0,EGPR0 SAVE ABEND CODE FOR NOW.. @V305001 01119000
ST R15,EGPR15 SAVE RETURN CODE @V305001 01120000
LA R1,BABEND2 GET RETURN ADDRESS @V305001 01121000
ST R1,OLDPSW+4 SAVE AS OLD PSW @V305001 01122000
NI OLDPSW+1,RESETSK RESET PSW STORAGE KEY @V305001 01123000
B DOSRET RETURN TO CMS @V305001 01124000
BABEND2 BALR R14,0 ESTABLISH ADDRESSABILITY @V305001 01125000
USING *,R14 @V305001 01126000
LA R1,ABTERM POINT TO $$BABEND LITERAL @V305001 01127000
DROP R14 @V305001 01128000
SVC SVC2 CALL $$BABEND @V305001 01129000
DC H'0' SHOULD NEVER COME BACK HERE @V305001 01130000
EJECT 01131000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01132000
* * 01133000
* SVC16: STORE THE ADDRESS OF THE USER'S PC ROUTINE * 01134000
* AND SAVEAREA ADDRESS IN THE PC OPTION TABLE * 01135000
* * 01136000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01137000
SPACE 1 01138000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01139000
SPACE 1 01140000
STXITPC BAL R6,GETPC GET ADDRESS OF PC OPTION TABLE @V305066 01141000
B COMSVCE LOCATE APPROPRIATE ENTRY @V305066 01142000
SPACE 2 01143000
GETPC LH R2,PCPTR POINTER TO BEG. PC OPTION TABLE @V305066 01144000
B COMTABA GO CALCULATE APPROPRIATE ENTRY @V305066 01145000
SPACE 2 01146000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01147000
* * 01148000
* SVC17: PROVIDES A RETURN FROM THE USER'S PC ROUTINE * 01149000
* TO THE PROGRAM INTERRUPTED DUE TO A PROGRAM * 01150000
* CHECK. * 01151000
* * 01152000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01153000
SPACE 1 01154000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01155000
SPACE 1 01156000
EXITPC BAL R6,GETPC GET PC OPTION TABLE ADDRESS @V305066 01157000
LH R10,PIK PROGRAM INTERRUPT KEY @V305066 01158000
USING PIBADR,R10 ADDRESSABILITY FOR PIB @V305066 01159000
AH R10,PIBPT POINT TO PARTITION PIB @V305066 01160000
L R7,PIBSAVE PPSAVE AREA ADDRESS @V305066 01161000
USING SVUARA,R4 USER SAVE AREA ADDRESSABILITY @V305066 01162000
DROP R8 @V305066 01163000
USING SVEARA,R7 PPSAVE ADDRESSABILITY @V305066 01164000
MVC SVEPSW2,SVUPSW2 RESTORE PSW AND REGISTERS @V305066 01165000
MVC SVER09(28),SVUR09 REGISTERS TO USER SAVE AREA @V305066 01166000
MVC SVER00(36),SVUR00 IN SEQUENCE R9 TO R8 @V305066 01167000
LCR R3,R3 CONVERT ROUTINE ADDRESS @V305066 01168000
ST R3,0(R2) STORE ROUT ADD IN PC TABLE @V305066 01169000
MVC OLDPSW(8),SVEPSW WHEN DMSITS GETS CONTROL, @V305066 01170000
MVC EGPR0(36),SVER00 IT WILL RETURN CONTROL TO @V305066 01171000
MVC EGPR9(28),SVER09 INST INDICATED IN OLDPSW @V305066 01172000
B DOSRET @V305066 01173000
EJECT 01174000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01175000
* * 01176000
* SVC37: STORE THE ADDRESS OF THE USER'S PC ROUTINE * 01177000
* AND SAVEAREA ADDRESS IN THE PC OPTION TABLE * 01178000
* * 01179000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01180000
SPACE 1 01181000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01182000
SPACE 1 01183000
STXITAB BAL R6,GETAB GET ADDRESS OF AB OPTION TABLE @V305066 01184000
COMSVCE LTR R0,R0 SEE IF MACRO PASSED PARAMETERS ? @V305066 01185000
BZ SKPVALID BRANCH IF PARMS NOT SPECIFIED @V305066 01186000
LA R7,71(R1) POINT TO END OF SAVEAREA @V305066 01187000
C R7,PPBEG VALIDATE SAVEAREA LIMITS @V305066 01188000
BL ERR02E ERROR IS SAVEAREA ADDR LESS 20000@V305066 01189000
TM DOSFLAGS,DOSVSAM IS VSAM SET ON ? @VA07500 01189300
BO CHKMNHI YES, CHECK MAINHIGH @VA07500 01189600
C R7,PPEND COMPARE WITH END PARTITION ADDR @V305066 01190000
BH ERR02E ERROR HIGHER THAN PARTITION END @V305066 01191000
B SKPVALID CONTINUE IF NOT HIGH @VA07500 01191030
CHKMNHI EQU * @VA07500 01191060
C R7,MAINHIGH DOES SAVEAREA END EXCEED @VA07500 01191090
* MAINHIGH ? 01191120
BH ERR02E YES, ERROR @VA07500 01191150
L R8,MAINLIST GET FREELIST POINTER @VA07500 01191180
LA R8,0(R8) CLEAR HIGH ORDER BYTE @VA07500 01191210
LTR R8,R8 IS POINTER ZERO ? @VA07500 01191240
BZ SKPVALID YES - NO MORE CHECKING NEEDED @VA07500 01191270
CHKFRE EQU * @VA07500 01191300
LR R4,R8 LOAD POINTER INTO WORK REG @VA07500 01191330
CR R4,R1 IS IT HIGHER THAN SAVEAREA ? @VA07500 01191360
BH CHKMORE YES - SEE IF SAVEAREA FITS @VA07500 01191390
A R4,4(R4) ADD FREEAREA LENGTH @VA07500 01191420
BCTR R4,R0 SUBTRACT '1' FOR TRUE LENGTH @VA07500 01191450
CR R4,R1 IS IT HIGHER THAN SAVEAREA ? @VA07500 01191480
BNL ERR02E YES, ERROR @VA07500 01191510
L R8,0(R8) GET NEXT POINTER @VA07500 01191540
LA R8,0(R8) CLEAR HIGH ORDER BYTE @VA07500 01191570
LTR R8,R8 IS POINTER ZERO ? @VA07500 01191600
BZ SKPVALID YES (END OF FREELIST) @VA07500 01191630
B CHKFRE CHECK NEXT AREA @VA07500 01191660
CHKMORE EQU * @VA07500 01191690
CR R4,R7 IS IT HIGHER THAN SAVEAREA END ? @VA07500 01191720
BNH ERR02E NO, ERROR @VA07500 01191750
SKPVALID LTR R3,R3 IS ROUTINE ACTIVE NOW ? @V305066 01192000
BNM STOREPC NO, STORE PARAMETERS @V305066 01193000
LCR R0,R0 INVERT NEW ROUTINE ADDRESS @V305066 01194000
LR R1,R4 DON'T DESTROY SAVEAREA POINTER @V305066 01195000
STOREPC STM R0,R1,0(R2) STORE RTNE & SAVEAREA ADDR IN TAB@V305066 01196000
B DOSRET @V305066 01197000
SPACE 2 01198000
GETAB L R9,ASYSCOM GET ADDRESS OF SYSCOM @VA15167 01199000
USING SYSCOM,R9 ESTABLISH SYSCOM ADDRESSABILIY @V305066 01200000
L R2,IJBABTAB GET ADDRESS OF AB OPTION TABLE @V305066 01201000
COMTABA LH R8,PIK GET PROGRAM INTERRUPT KEY @V305066 01202000
SRL R8,1 ONE ONE 8-BYTE TABLE ENTRY BUT @V305066 01203000
AR R2,R8 TABLES ARE OFFSET BY 8 BYTES @V305066 01204000
LM R3,R4,0(R2) LOAD ROUTINE AND SAVEAREA ADDRS @V305066 01205000
BR R6 RETURN TO MAIN LINE @V305066 01206000
SPACE 01207000
DROP R9 (THRU W/SYSCOM ADDR'BILITY HERE) @V305066 01208000
EJECT 01209000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01210000
* * 01211000
* SVC95: EXIT AB * 01212000
* RETURN CONTROL TO SUPERVISOR AND CONTINUE TASK * 01213000
* * 01214000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01215000
SPACE 01216000
EXITAB BAL R6,GETPC GET PC OPT TAB ENTRY @V387274 01217000
LTR R3,R3 EXIT FROM PC ROUTINE? @V387274 01218000
BNM ESTAB NO, IT WAS AN AB ROUTINE @V387274 01219000
LCR R3,R3 REESTABLISH PC LINKAGE @V387274 01220000
B SETLKGE AND GO PUT IN TAB @V387274 01221000
ESTAB BAL R6,GETAB GET AB OPT TAB ADDR IN R2 @V387274 01222000
LH R10,PIK GET PROG INTERRUPT KEY @V387274 01223000
AH R10,PIBPT PIB TABLE @V387274 01224000
USING PIBADR,R10 ADDRESSABILITY @V387274 01225000
L R8,PIBSAVE PPSAVE ADDRESS @V387274 01226000
USING SVEARA,R8 ADDRESSABILITY @V387274 01227000
L R3,SVEPSW2 GET AB RTN ADDR FROM SAVE AREA @V387274 01228000
SETLKGE ST R3,0(,R2) RESTORE ADDR IN OPTION TABLE @V387274 01229000
* RESET ABEND INDICATIONS @V387274 01230000
* CLEAR INTERRUPT INFORMATION IN PARTITION PIB EXTENSION @V387274 01231000
LH R10,PIB2PTR PT TO PART PIB EXTENSION @V387274 01232000
XC INTINFO(4),INTINFO CLEAR FIELD @V387274 01233000
* RETURN TO INSTR FOLLOWING EXIT AB MACRO @V387274 01234000
B DOSRET RETURN @V387274 01235000
DROP R8,R10 @V387274 01236000
EJECT 01237000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01238000
* * 01239000
* SVC34: GET TIME OF DAY IN TIMER UNITS * 01240000
* * 01241000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01242000
SPACE 1 01243000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01244000
SPACE 1 01245000
USING NUCON,R0 REF. DATE/TIME STUFF IN NUCON @V305066 01246000
GETIME MVC JOBDATE(8),CURRDATE SAVE THE DATE (MM/DD/YY) @VA09246 01247000
L R2,EGPR0 SAVE EGPR0 (NEED SCRATCH DBLWORD)@V305066 01248000
STCK EGPR0 TELL ME THE TIME RIGHT NOW @V305066 01249000
LM R0,R1,EGPR0 OBTAIN IT IN REGS 0-1 @V305066 01250000
ST R2,EGPR0 RESTORE EGPR0 @V305066 01251000
SL R1,CLKVALMD+4 SUBT LOW-ORDR PART OF ELAPSD TIME@V305066 01252000
BC 2+1,*+6 X-FER IF CC=2 OR 3 (CARRY OCC'RD)@V305066 01253000
BCTR R0,0 FOR CC=1, DECRMT HIGH ORDER PART @V305066 01254000
SL R0,CLKVALMD SUBT HIGH ORDR PRT OF ELAPSD TIME@V305066 01255000
LR R2,R0 SAVE THIS VALUE @V305066 01256000
LR R3,R1 ... @V305066 01257000
SLDL R0,1 DOUBLE IT, @V305066 01258000
ALR R0,R2 & ADD - TO GET 3 TIMES ITS VALUE @V305066 01259000
ALR R1,R3 ... @V305066 01260000
BC 8+4,*+8 TRANSFER IF NO CARRY OCCURRED, @V305066 01261000
AL R0,ADD1 IF CARRY, ADD 1 TO HIGH-ORDR PART@V305066 01262000
* NOW HAVE TIME IN STCK UNITS TIMES 3 ... 01263000
D R0,CON4096 DIVIDE BY TEN THOUSAND (X 4096) @V305066 01264000
TWFRCK EQU * 01264250
C R1,TWFRTMUS COMPARE AGAINST 24 HOURS @VA09246 01264500
BH ADJUSTME IF ELLAPS TIME MORE,ADJUST @VA09246 01264750
ST R1,EGPR1 STORE ANSWER IN CALLER'S R1 @V305066 01265000
L R7,OLDPSW+4 RETURN INST ADDRESS @V305066 01266000
CLI 0(R7),NEWGET NEW GETIME MACRO @V305066 01267000
BE DOSRET YES, RETURN @V305066 01268000
LA R7,10(,R7) SKIP SEVERAL INSTS @V305066 01269000
ST R7,OLDPSW+4 STORE UPD INST ADDRESS @V305066 01270000
B DOSRET @V305066 01271000
ADJUSTME EQU * 01271200
S R1,TWFRTMUS SUBTRACT 24 HOURS IN TIMER @VA09246 01271400
* UNITS FROM ELAPSED TIME 01271600
B TWFRCK AND GO CHECK AGAIN @VA09246 01271800
EJECT 01272000
* * 01297000
* COMREG .. GIVE ADDRESS OF BGCOM IN R1 * 01298000
* * 01299000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01300000
SPACE 1 01301000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01302000
SPACE 1 01303000
COMREG L R1,ASYSREF GET ADDRESS BGCOM @V305001 01304000
ST R1,EGPR1 SAVE IN USER'S R1 @V305001 01305000
B DOSRET RETURN TO CMS @V305001 01306000
SPACE 2 01307000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01308000
* * 01309000
* WAIT ON A CCB, ECB OR TECB. THIS CONDITION SHOULD NOT * 01310000
* OCCUR, SINE CMS/DOS DOES NOT SUPPORT ECB'S OR TECB'S. * 01311000
* IN CASE OF CCB, THEY WILL ALWAYS BE POSTED BY EXCP, * 01312000
* THUS WAIT BECOMES AN EFFECTIVE POST. * 01313000
* * 01314000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01315000
SPACE 1 01316000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01317000
SPACE 1 01318000
WAIT EQU * @V305001 01319000
SPACE 2 01320000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01321000
* * 01322000
* POST .. SVC 40 .. POST ECB .. (BYTE 2, BIT 0) * 01323000
* * 01324000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01325000
SPACE 1 01326000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01327000
SPACE 1 01328000
POST OI 2(R1),POSTECB POST ECB (BYTE 2, BIT 0) @V305001 01329000
B DOSRET GO TO EXIT @V305001 01330000
EJECT 01331000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01332000
* * 01333000
* SVC 50 IN OUR CASE MEANS THAT LIOCS HAS ENCOUNTERED * 01334000
* AN OPERATION NOT SUPPORTED BY THE XXMOD. * 01335000
* * 01336000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01337000
SPACE 1 01338000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01339000
SPACE 1 01340000
LIOCS LR R2,R1 POINT TO CCB @V305001 01341000
DMSFREE DWORDS=2,TYPCALL=BALR @V305001 01342000
LR R6,R1 SAVE LOCATION POINTER @V305001 01343000
BAL R4,CONVERT @V305001 01344000
DMSERR NUM=96,LET=S,SUB=(CHARA,(R6)), @V305001*01345000
TEXT='UNSUPPORTED FUNCTION IN A LIOCS ROUTINE FOR ''....*01346000
..''' @V305001 01347000
LR R1,R6 RESTORE LOCATION TO FREE @V305001 01348000
DMSFRET DWORDS=2,LOC=(1),TYPCALL=BALR @V305001 01349000
B NOTSUP GIVE NOT SUPPORTED MSG ALSO @V305001 01350000
EJECT 01351000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01352000
* * 01353000
* ROUTINE TO SEARCH THROUGH THE AMS OR VSAM SEGMENTS * 01354000
* LOOKING FOR A SPECIFIED PHASE OR $$B-TRANS. * 01355000
* * 01356000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01357000
SPACE 1 01358000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01359000
SPACE 1 01360000
VSAMDS LR R2,R1 LET R2 POINT TO PHASE NAME, @V305001 01361000
LR R8,R1 SAVE PHASE NAME ADDRESS @VA12893 01361500
LR R15,R0 SAVE CONTENTS OF REG. 0 @V305001 01362000
TM DOSFLAGS,DOSVSAM IS VSAM SUPPOSED TO BE RUNNING?@V305106 01363000
BZ VSAMPNF NO, GO TO NOT FOUND EXIT. @V305106 01364000
LM R0,R1,0(R2) LOAD PHASE-NAME INTO HANDY REGS. @V305001 01365000
CLM R0,M14,IDC AMS PHASE TO BE LOADED ? @V305001 01366000
BNE VSAMSEG NOPE - SEE IF IT IS VSAM PHASE. @V305001 01367000
ICM R3,15,AAMSSYS GET ADDRESS OF AMS SEGMENT @V305001 01368000
BNZ VSAMLKP IF EXISTS, GO START SEARCH. @V305001 01369000
B VSAMPNF IF NOT THERE, THEN NOT FOUND EXIT@V305001 01370000
VSAMSEG CL R0,IKQV VSAM PHASE TO BE LOADED ? @V305001 01371000
BE VSAMLDS YES, START SEARCH ON VSAM SEGMENT@V305066 01372000
CLM R0,M14,BTRANS VSAM TRANSIENT TO BE LOADED ? @V305001 01373000
BNE VSAMPNF NOPE - GO THROUGH NOT FOUND EXIT.@V305001 01374000
VSAMLDS ICM R3,15,AVSAMSYS GET ADDRESS OF VSAM SEGMENT @V305001 01375000
BNZ VSAMLKP IF THERE, START SEARCH FOR PHASE @V305001 01376000
L R11,=A(LDVSAM) GET ADDRESS OF VSAM LOAD ROUTINE @V305001 01377000
BALR R10,R11 GO TO LOAD VSAM SEGMENT @V305001 01378000
BNZ VSAMPNF IF NO SEGMENT, PHASE NOT FOUND. @V305001 01379000
VSAMLKP LA R4,BXLE12 12 FOR BXLE USE SEARCHING TABLES @V305001 01380000
L R5,0(,R3) ENDING ADDR INTO R5 FOR BXLE USE,@V305001 01381000
LA R3,4(,R3) AND START WITH FIRST PHASE NAME @V305001 01382000
* 01383000
* SPEEDY LOOP TO FIND THE DESIRED 01384000
* PHASE-NAME IN VSAM OR AMS SEGMENT: 01385000
* 01386000
VSAMLUP CL R1,4(,R3) DOES 2ND HALF OF PHASE NAME MTCH?@V305001 01387000
BE VSAMCK1 YES - BET FIRST HALF MATCHES TOO @V305001 01388000
BXLE R3,R4,VSAMLUP NO - KEEP CHECKING. @V305001 01389000
B VSAMNXT GO SEE IF THERE'S ANOTHER TABLE. @V305001 01390000
VSAMCK1 CL R0,0(,R3) DOES 1ST HALF OF PHASE NAME MTCH?@V305001 01391000
BE VSAMFND AHA - I WAS RIGHT. @V305001 01392000
BXLE R3,R4,VSAMLUP NO (GUESSED WRONG) - KEEP CHKNG @V305001 01393000
VSAMNXT SR R3,R4 BACK TO LAST 16-BYTE NAME,ADDR.. @V305001 01394000
CLC 0(8,R3),FENCE8 WE SHOULD BE AT AN 8-BYTE 'FENCE'@V305001 01395000
BNE VSAMPNF IF NOT, THEN NOT FOUND EXIT. @V305001 01396000
ICM R3,15,8(R3) GET ADDRESS OF NEXT SECTION @V305001 01397000
BNZ VSAMLKP IF IT EXISTS GO CHECK IT ALSO. @V305001 01398000
EJECT 01399000
* 01400000
* DID NOT FIND THE DESIRED PHASE NAME: 01401000
* 01402000
VSAMPNF EQU * PHASE NOT FOUND @VA12893 01403300
LTR R1,R8 POINT TO PHASE NAME @VA12893 01403600
LR R0,R15 RESTORE REG. 0 @V305001 01404000
BR R6 RETURN TO CALLER. @V305001 01405000
* 01406000
* FOUND THE DESIRED PHASE NAME: 01407000
* 01408000
VSAMFND L R1,8(,R3) LOAD POINT INTO R1 @V305001 01409000
LR R0,R2 REG. 0 POINTS TO PHASE NAME. @V305001 01410000
SR R4,R4 ZERO CONDITION CODE, @V305001 01411000
BR R6 RETURN TO CALLER. @V305001 01412000
EJECT 01413000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01414000
* * 01415000
* ROUTINE TO CONVERT THE 2-BYTE LOGICAL UNIT IN THE * 01416000
* CCB TO AN EBCDIC SYSXXX LITERAL. UPON ENTRY, REG. 2 * 01417000
* POINTS TO THE CCB, AND REG. 6 POINTS TO A 16 BYTE * 01418000
* DOUBLE WORD ALIGNED AREA FOR INTERNAL WORK. * 01419000
* * 01420000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01421000
SPACE 1 01422000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01423000
SPACE 1 01424000
CONVERT SR R5,R5 CLEAR @V305001 01425000
IC R5,7(,R2) GET UNIT NUMBER @V305001 01426000
TM 6(R2),PROG IS IT PROGRAMMER UNIT ? @V305001 01427000
BO CNVPROG YES, BRANCH @V305001 01428000
SLL R5,2 MULTIPLY BY 4 @V305001 01429000
LA R5,SYSTAB(R5) INDEX TO CORRECT XXX @V305001 01430000
MVC 3(3,R6),0(R5) MOVE XXX TO AREA @V305001 01431000
CONVERT2 MVC 0(3,R6),SYS MOVE THE SYS TO AREA @V305001 01432000
BR R4 RETURN TO CALLER @V305001 01433000
CNVPROG CVD R5,8(,R6) CONVERT UNIT NUMBER @V305001 01434000
UNPK 0(6,R6),8(8,R6) UNPACK TO AREA @V305001 01435000
OI 5(R6),ZONE SET LAST ZONE @V305001 01436000
B CONVERT2 GO TO MOVE SYS TO AREA @V305001 01437000
SPACE 1 01438000
* 01439000
* SYSXXX CONSTANTS FOR SYSTEM LOGICAL UNITS 01440000
* 01441000
SYSTAB DS 0H @V305001 01442000
DC CL4'RDR' 00 @V305001 01443000
DC CL4'IPT' 01 @V305001 01444000
DC CL4'PCH' 02 @V305001 01445000
DC CL4'LST' 03 @V305001 01446000
DC CL4'LOG' 04 @V305001 01447000
DC CL4'LNK' 05 @V305001 01448000
DC CL4'RES' 06 @V305001 01449000
DC CL4'SLB' 07 @V305001 01450000
DC CL4'RLB' 08 @V305001 01451000
DC CL4'USE' 09 @V305001 01452000
DC CL4'REC' 0A @V305001 01453000
DC CL4'CLB' 0B @V305001 01454000
DC CL4'VIS' 0C @V305001 01455000
DC CL4'CAT' 0D @V305001 01456000
EJECT 01457000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01458000
* * 01459000
* GETVIS (SVC 61) = GET VIRTUAL STORAGE * 01460000
* LIMITED IMPLEMENTATION AS NEEDED FOR VSAM UNDER CMS * 01461000
* * 01462000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01463000
SPACE 1 01464000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 01465000
SPACE 1 01466000
GETVIS DS 0H "GETVIS" - LMTED IMPLEMENTATTION @V305132 01467000
LA R11,GETVISCN SET R11 TO CONT AFTER GETBLK CALL@V305132 01468000
* CAN ENTER HERE (VIA BAL R11,GETVISUB") TO GET INTERNAL GETVIS: 01469000
GETVISUB L R10,=A(GETBLK) NEEDED ADDRESSABILITY IN R10, @V305132 01470000
BALR R14,R10 CALL "GETBLK" SUBROUTINE @V305132 01471000
BR R11 EITHER EXIT TO CALLER, OR CONT...@V305132 01472000
GETVISCN ST R1,EGPR1 RETURN THE ADDRESS, @V305132 01473000
ST R15,EGPR15 AND THE RETURN-CODE TO THE CALLER@V305132 01474000
B DOSRET AND GO EXIT. @V305132 01475000
EJECT 01476000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01477000
* * 01478000
* FREEVIS (SVC 62) = RETURN VIRTUAL STORAGE * 01479000
* LIMITED IMPLEMENTATION AS NEEDED FOR VSAM UNDER CMS * 01480000
* * 01481000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01482000
SPACE 1 01483000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 01484000
SPACE 1 01485000
FREEVIS DS 0H "FREEVIS" - LMTD IMPLEMENT'TN @V305132 01486000
LA R11,DOSRET SET R11 = EXIT AFTER FREBLK CALL @V305132 01487000
* CAN ENTER HERE (VIA BAL R11,FREVISUB") TO GET INTERNAL FREEVIS: 01488000
FREVISUB CL R1,ADIKQLAB IS 'IKQLAB' BEING FREVIS'D ? @V305132 01489000
BNE FREVISOK NOPE - NO SPECIAL HANDLING NEEDED@V305132 01490000
L R14,=A(X'FFFFFF') YES (=IKQLAB) - SET ADIKQLAB @V305132 01491000
SR R15,R15 TO '00FFFFFF', AND NDIKQLAB TO 0 @V305132 01492000
STM R14,R15,ADIKQLAB (INDC'TNG IKQLAB NOT IN STOR) @V305132 01493000
FREVISOK L R10,=A(GETBLK) COMMON ADDR'BTY FOR GETBLK/FREBLK@V305132 01494000
DROP R12 (BRIEFLY) @V305132 01495000
USING GETBLK,R10 ... @V305132 01496000
BAL R14,FREBLK CALL "FREBLK" SUBROUTINE @V305132 01497000
DROP R10 RESTORE NORMAL ADDRESSABILITY @V305132 01498000
USING DMSDOS,R12 ... @V305132 01499000
BR R11 RETURN TO CALLER OR "B DOSRET" @V305132 01500000
SPACE 2 01501000
* GETVIS/FREEVIS OPTIONS (SPECIFIED BY CALLER) 01502000
* (PASSED IN LOW-ORDER BYTE OF R15 AT ENTRY) 01503000
SPACE 01504000
EQBIT31 EQU 1 "PAGE" - GET STORG ON PAGE BNDARY@V305132 01505000
EQBIT30 EQU 2 "POOL" - GET STORG FROM USER-POOL@V305132 01506000
EQBIT29 EQU 4 "SVA" - GET STORAGE FROM SVA @V305132 01507000
EJECT 01508000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01576000
* * 01577000
* "RELEASE" = SVC 64 * 01578000
* LIMITED IMPLEMENTATION AS NEEDED FOR VSAM UNDER CMS * 01579000
* * 01580000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01581000
SPACE 1 01582000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 01583000
SPACE 1 01584000
SVC64 DS 0H "RELEASE" - LIMITED IMPLEMENT'TN @V305132 01585000
LTR R1,R1 IS R1 PERCHANCE 0 ? @V305132 01586000
BZ SVC64CLR YES - RELEASE ALL RESOURCES. @V305132 01587000
L R3,SYSE000 NO - LOOK FOR KEY OF 'E000' @V305132 01588000
CLM R3,M3,2(R1) ... @V305132 01589000
BE SVC64B IF = 'E000', HANDLE R0 ALSO. @V305132 01590000
CLI 2(R1),KEYC0 IF NOT E000, MUST BE C0 @V305132 01591000
BNE ERROR64 ERROR SOMEWHERE IF NOT. @V305132 01592000
CLI 3(R1),HEX07 AND LAST BYTE MUST NOT EXCEED 07 @V305132 01593000
BH ERROR64 ERROR SOMEWHERE IF IT DOES. @V305132 01594000
SR R2,R2 CLEAR, @V305132 01595000
IC R2,3(,R1) GET LAST 3 BITS OF RESOURCE CODE @V305132 01596000
ALR R2,R2 "MULTIPLY BY 4" @V305132 01597000
ALR R2,R2 ... @V305132 01598000
A R2,ARURTBL FORM ADDRESS OF RUR-TABLE ENTRY @V305132 01599000
SVC64A L R3,0(,R2) GET OLD VALUE (CTR) FRM RUR-TABLE@V305132 01600000
SH R3,ONE MINUS ONE; @V305132 01601000
BNM SVC64X IF ZERO OR PLUS IT'S OK. @V305132 01602000
SR R3,R3 NO NEGATIVE NUMBERS PLEASE @V305132 01603000
SVC64X ST R3,0(,R2) STORE DEC'MTD RUR-TABLE COUNTER @V305132 01604000
B DOSRET GO CLEAR R15 AND EXIT. @V305132 01605000
SPACE 01606000
SVC64B EQU * CODE WAS X'E000' ... @V305132 01607000
LA R2,RURDISP FORM ADDRESS OF SECTION OF RURTBL@V305132 01608000
A R2,ARURTBL CONTAINING E000 ENTRIES @V305132 01609000
L R1,EGPR0 REF 8-BYTE RESOURCE PER USER'S R0@V305132 01610000
L R0,FENCE ENDING SENTINEL @V305132 01611000
SVC64C CLC 4(8,R2),0(R1) DOES RESOURCE MATCH THAT IN TABLE@V305132 01612000
BE SVC64D YES - MAKE ONE MORE CHECK BELOW @V305132 01613000
LA R2,12(,R2) NO - POINT TO NEXT 12-BYTE ENTRY,@V305132 01614000
CL R0,0(,R2) HAVE WE HIT ENDING SENTINEL ? @V305132 01615000
BNE SVC64C NOPE - KEEP LOOKING. @V305132 01616000
B DOSRET YES - IGNORE NOT FOUND @V305132 01617000
SVC64D LA R3,COUNT1 SEE IF COUNTER IS 1 @V305132 01618000
CL R3,0(,R2) ... @V305132 01619000
BL SVC64A NOPE - GENERAL CASE. @V305132 01620000
XC 4(8,R2),4(R2) YES - CLEAR RESOURCE NAME @V305132 01621000
B SVC64A AND GO JOIN GENERAL-CASE HANDLER.@V305132 01622000
SPACE 01623000
* R1 = 0 AT INPUT MEANS TO RELEASE ALL RESOURCES: 01624000
SVC64CLR L R2,ARURTBL ADDRESS OF RURTBL @V305132 01625000
LA R3,RURLENG LENGTH (IN BYTES) @V305132 01626000
* NOTE: R1 = 0; R0 IS IMMATERIAL 01627000
MVCL R2,R0 CLEAR ENTIRE RURTBL @V305132 01628000
B DOSRET FOURTH DOWN - PUNT. @V305132 01629000
SPACE 01630000
ERROR64 EQU * SOME KIND OF ERROR IN "RELEASE" @V305132 01631000
B DOSRET NONFATAL; RETURN TO CALLER. @V305132 01632000
SPACE 01633000
* THE HALFWORD AT 2(R1) HAS A KEY OF THE FOLLOWING KIND: 01634000
* SYSOPN =X'C000'; SYSSPM =X'C004'; SYSMCO =X'C005'; SYSCTLG =X'C006'; 01635000
SPACE 01636000
SYSE000 DC A(X'E000') ALL OTHERS = THIS TWO-BYTE SIGNAL@V305132 01637000
FENCE DC X'FFFFFFFF' ENDNG SENTINEL FOLLOWNG RUR-TABLE@V305132 01638000
SPACE 01639000
* NOTE: MAKE SURE THE FOLLOWING IS KEPT CURRENT (SEE DMSNUC): 01640000
RURLENG EQU 32*4 LENGTH OF RURTBL (IN BYTES) @V305132 01641000
EJECT 01642000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01643000
* * 01644000
* "CDLOAD" = SVC 65 * 01645000
* IMPLEMENTATION AS APPROPRIATE FOR VSAM UNDER CMS * 01646000
* * 01647000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01648000
SPACE 1 01649000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 01650000
SPACE 1 01651000
CDLOAD DS 0H CDLOAD = SVC 65: @V305132 01652000
TM DOSFLAGS,DOSVSAM DOS SET WITH 'VSAM'? @V305106 01653000
BZ NOVSAMS NO, CANCEL THE JOB... @V305106 01654000
BAL R6,VSAMDS GO SEE IF VSAM OR AMS PHASE. @V305132 01655000
BNZ CDHRDWAY IF NOT FOUND, TRY THE HARD WAY. @V305132 01656000
LR R0,R1 PUT LOAD POINT IN R0. @V305132 01657000
LR R3,R2 R3 PT TO PHASE NAME INSTEAD OF R2@V305132 01658000
SR R2,R2 LENGTH OF 0 MEANS LENGTH UNAVAIL @V305132 01659000
CLC 0(8,R3),IKQVLAB PERCHANCE 'IKQLAB' PHASE ? @V305132 01660000
BE CDIKQLAB YES - DO SPECIAL HANDLING. @V305132 01661000
CLC 0(8,R3),IKQVLASF PERCHANCE 'IKQLASF' PHASE ? @VM03158 01662000
BE CDIKQLAS YES - DO SPECIAL HANDLING. @VM03158 01663000
STM R0,R1,EGPR0 RETN LOADPT & ENTRY PT IN R0/R1, @V305132 01664000
ST R2,EGPR14 AND "LENGTH" IN CALLER'S R14 @V305132 01665000
SR R15,R15 CLEAR RETURN-CODE TO = SUCCESS @V305132 01666000
ST R15,EGPR15 STORE RETURN-CODE IN CALLER'S R15@V305132 01667000
B DOSRET AND RETURN TO CALLER OF CDLOAD. @V305132 01668000
EJECT 01669000
* 01670000
* COULDN'T FIND WHAT WE WANTED IN D.C.S.S. STUFF - DO IT THE HARD WAY: 01671000
* R2 STILL POINTS TO THE GIVEN PHASE NAME: 01672000
* 01673000
DROP R5 @V305132 01674000
CDHRDWAY L R3,ABGCOM REFERENCE BGCOM @V305132 01675000
USING BGCOM,R3 @V305132 01676000
ICM R3,15,PPEND DO WE HAVE AN ANCHOR-TABLE ? @VM03158 01677000
BZ CDLOAD00 NOPE - NOTHING TO SEARCH @V305132 01678000
LA R0,1(,R3) YES - PPEND+1 INTO R0, @VM03158 01679000
BAL R14,SRCHANCH SEARCH ANCHOR-TABLE FOR A MATCH @V305132 01680000
BZ CDLOADOK SUCCESS - LOAD UP REGS AND EXIT. @V305132 01681000
CDLOAD00 L R3,ASYSCOM REFERENCE SYSCOM @V305132 01682000
USING SYSCOM,R3 ... @V305132 01683000
L R3,IJBFTTAB GET ADDRESS OF FETCH WORK TABLE @V305132 01684000
XC 0(FCHLENG,R3),0(R3) CLEAR IT, @V305132 01685000
USING FCHTAB,R3 AND REFERENCE VIA R3 @V305132 01686000
MVC DIRNAME(8),0(R2) MOVE PHASE NAME TO DIRNAME, @V305132 01687000
MVI DIRN,LENGTH SET UP LENGTH IN HALFWORDS @V305132 01688000
SR R0,R0 R0=0 WHEN WE'RE NOT GOING TO LOAD@V305132 01689000
OI DIRC,NOTEXT SIGNAL TXT=NO PLEASE @V305132 01690000
LA R1,DIRNAME R1 POINTS TO DIRNAME & FOLLOWING @V305132 01691000
L R15,=V(DMSFCH) INVOKE THE 'FETCH' ROUTINE @V305132 01692000
BALR R14,R15 ... @V305132 01693000
LTR R15,R15 DID FETCH FIND IT SOMEPLACE ? @V305132 01694000
BNZ ERR22 IF NOT, GIVE UP @V305132 01695000
TM DIRC,PNOTFND WAS THE PHASE FOUND ? @V305132 01696000
BO ERR22 BRANCH IF NOT. @V305132 01697000
LH R0,DIRTT GET "NUMBER OF TEXT BLOCKS", @V305132 01698000
SH R0,ONE LESS ONE, @V305132 01699000
BNM CDLOAD01 MAKE SURE NOT MINUS @V305132 01700000
SR R0,R0 (IF MINUS REPLACE WITH 0) @V305132 01701000
CDLOAD01 SLL R0,10 (DIRTT-1) TO 10TH POWER = X 1024,@V305132 01702000
AH R0,DIRLL + LGTH OF LAST BLOCK = NO. BYTES @V305132 01703000
LR R4,R0 KEEP SIZE (FOR LATER USE), @V305132 01704000
BAL R11,GETVISUB GET STOR TO LOAD NEEDED PHASE @V305132 01705000
BNZ ERR22 IF NO FREE STOR AVAIL, GIVE UP. @V305132 01706000
LR R6,R1 OK - REMEMBER ADDRESS, @V305132 01707000
LR R0,R1 AND R0 PTS TO WHERE LOAD PHASE, @V305132 01708000
NI DIRC,255-NOTEXT SIGNAL TXT=YES THIS TIME @V305132 01709000
LA R1,DIRNAME R1 POINTS TO DIRNAME ETC. AGAIN @V305132 01710000
L R15,=V(DMSFCH) INVOKE THE 'FETCH' ROUTINE AGAIN @V305132 01711000
BALR R14,R15 (TO REALLY LOAD IT THIS TIME) @V305132 01712000
LTR R15,R15 DID IT GET LOADED OK ? @V305132 01713000
BNZ ERR22P IF NOT, GIVE UP. @V305132 01714000
LR R3,R1 NOW SAVE THE PHASE ENTRY POINT. @V305132 01715000
DROP R3 @V305132 01716000
EJECT 01717000
* 01718000
* LOAD SUCCEEDED - BUILD ANCHOR-TABLE (IF NECESSARY) & INSERT THE DATA: 01719000
* 01720000
CDLOAD0X L R5,ABGCOM REFERENCE BGCOM @VM03158 01721000
USING BGCOM,R5 @V305132 01722000
ICM R1,15,PPEND DO WE HAVE AN ANCHOR-TABLE ? @V305132 01723000
BNZ CDLOAD02 YES - GO TO IT. @V305132 01724000
LA R1,DMSSMNAT IF NOT, CREATE AN ANCHOR-TABLE @V305132 01725000
SVC 202 ... @V305132 01726000
DC AL4(ERR22P) IF NO LUCK, EXIT "GRACEFULLY". @V305132 01727000
L R1,PPEND NOW GET PPEND @V305132 01728000
DROP R5 @V305132 01729000
CDLOAD02 LA R1,1(,R1) PPEND+1 = ADDRESS OF ANCHOR TABLE@V305132 01730000
USING ANCHSECT,R1 REFERENCE THE ANCHTAB DSECT, @V305132 01731000
L R0,ANCHENDA POINT TO END OF ANCHOR TABLE, @V305132 01732000
SR R15,R15 CLEAR A REGISTER, @V305132 01733000
LA R5,ANCHPHNM POINT TO THE FIRST ENTRY POINT @V305132 01734000
DROP R1 NOW SEARCH FOR AN EMPTY SLOT: @V305132 01735000
CDLOAD03 CL R15,0(,R5) EMPTY SLOT FOUND ? @V305132 01736000
BE CDLOAD04 YES - GOOD SHOW. @V305132 01737000
LA R5,ANCHLENG(,R5) NO, ADVANCE TO NEXT SLOT, @V305132 01738000
CR R5,R0 CHECK AGAINST ENDING ADDRESS, @V305132 01739000
BL CDLOAD03 IF NOT EXCEEDED, THERE'S HOPE. @V305132 01740000
B ERR22P IF NONE LEFT, GIVE UP (FOR NOW). @V305132 01741000
* 01742000
* EMPTY SLOT FOUND - FILL IN THE ANCHOR-TABLE ENTRY (AS NEEDED): 01743000
* 01744000
USING ANCHPHNM,R5 REF 20-BYTE ANCHOR-TABLE ENTRY: @V305132 01745000
CDLOAD04 MVC ANCHPHNM(8),0(R2) MOVE THE PHASE NAME, @V305132 01746000
ST R6,ANCHLDPT THE LOAD POINT, @V305132 01747000
ST R3,ANCHENTP THE ENTRY POINT, @V305132 01748000
ST R4,ANCHPHLN-1 THE LENGTH OF THE PHASE @V305132 01749000
MVI ANCHSTSW,ANCHINST AND SET THE STATUS SWITCH @V305132 01750000
* 01751000
* CDLOAD SUCCESSFUL, RETURN THE "ANSWERS" TO THE CALLER: 01752000
* 01753000
SVC65OK LM R0,R2,ANCHLDPT GET ANCHLDPT,ANCHENTP,&ANCHPHLN @V305132 01754000
DROP R5 AND ... @V305132 01755000
SVC65STR LA R2,0(,R2) STRIP STATUS BYTE FROM HI END @V305132 01756000
STM R0,R1,EGPR0 RETN LOADPT & ENTRY PT IN R0/R1, @V305132 01757000
ST R2,EGPR14 AND LENGTH IN CALLER'S R14 @V305132 01758000
SR R15,R15 CLEAR RETURN-CODE TO = SUCCESS @V305132 01759000
* FINISH UP AND RETURN FROM CDLOAD: 01760000
SVC65RTN ST R15,EGPR15 STORE RETURN-CODE IN CALLER'S R15@V305132 01761000
B DOSRET AND RETURN TO CALLER OF CDLOAD. @V305132 01762000
EJECT 01763000
ERR22P LR R0,R4 SIZE OF GETVIS'D AREA INTO R0, @V305132 01764000
LR R1,R6 AND ADDRESS INTO R1, @V305132 01765000
BAL R11,FREVISUB GIVE BACK AREA (WE WON'T NEED IT)@V305132 01766000
* NOTE R6 IS "LOST"; CONTINUE TO ERR22: 01767000
ERR22 LA R15,ERROR22 ERROR 22 (X'16') MEANS NOT FOUND @V305132 01768000
B SVC65RTN THE GIVEN PHASE - GIVE UP. @V305132 01769000
SPACE 01770000
CDIKQLAB LR R3,R0 YES - GET LOAD POINT @V305132 01771000
LTR R4,R2 AND LENGTH @V305132 01772000
BP CDAR43 MAKE SURE POSITIVE @V305132 01773000
LA R4,CON2048 IF NOT, GET KNOWN (SAFE) LENGTH @V305132 01774000
CDAR43 AR R4,R3 END = BEGINNING PLUS LENGTH @V305132 01775000
STM R3,R4,ADIKQLAB STORE CURRENT VALUES @V305132 01776000
B SVC65STR AND GO RETURN ANSWERS TO CALLER. @V305132 01777000
SPACE 1 01778000
CDIKQLAS LR R4,R2 GET LENGTH OF PHASE, @VM03158 01779000
LR R2,R3 POINTER TO PHASE NAME, @VM03158 01780000
LR R3,R1 PHASE ENTRY POINT, @VM03158 01781000
LR R6,R3 PHASE LOAD POINT (SAME AS E.P.), @VM03158 01782000
L R1,ABGCOM REFERENCE BGCOM @VM03158 01783000
USING BGCOM,R1 @VM03158 01784000
ICM R1,15,PPEND DO WE HAVE AN ANCHOR-TABLE ? @VM03158 01785000
BZ CDLOAD0X NO - GO BUILD ANCHOR TABLE ENTRY.@VM03158 01786000
LA R0,1(,R1) PPEND+1 INTO R0, @VM03158 01787000
LR R1,R2 PHASE NAME POINTER INTO R1 @VM03158 01788000
BAL R14,SRCHANCH SEARCH ANCHOR-TABLE FOR MATCH @VM03158 01789000
BZ CDLOADOK SUCCESS - LOAD REGS. AND EXIT @VM03158 01790000
B CDLOAD0X IF NOT, BUILD ANCHOR TABLE ENTRY.@VM03158 01791000
DROP R1 @VM03158 01792000
SPACE 01793000
CDLOADOK EQU * SUCCESS ON INIT CALL TO SRCHANCH @V305132 01794000
LR R5,R0 A (ANCHOR-TABLE-ENTRY) INTO R5, @V305132 01795000
B SVC65OK GO LOAD & STORE REGS, THEN EXIT @V305132 01796000
EJECT 01797000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01798000
* * 01799000
* SRCHANCH = INTERNAL SUBROUTINE TO SEARCH AN ANCHOR TABLE * 01800000
* * 01801000
* ENTRY CONDITIONS: * 01802000
* R0 = ADDRESS OF ANCHOR TABLE (IN "ANCHTAB" FORMAT) * 01803000
* R1 = ADDRESS OF PHASE-NAME TO BE SEARCHED FOR * 01804000
* R14 = RETURN REGISTER * 01805000
* EXIT CONDITIONS: * 01806000
* R1 = UNCHANGED (IN ANY CASE); * 01807000
* ENTRY FOUND: * 01808000
* R0 = ADDRESS OF ANCHOR-TABLE-ENTRY * 01809000
* R15 = 0 * 01810000
* CONDITION-CODE = 0 * 01811000
* ENTRY NOT FOUND: * 01812000
* R0 = SCRATCH VALUE * 01813000
* R15 = 1 * 01814000
* CONDITION-CODE = NONZERO * 01815000
* * 01816000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01817000
SPACE 1 01818000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 01819000
SPACE 1 01820000
SRCHANCH LTR R15,R0 PUT A(ANCHOR-TABLE) IN USABLE REG@V305132 01821000
BNP SRCHNG NO GOOD IF R0 NOT > 0. @V305132 01822000
USING ANCHSECT,R15 OK - REFERENCE ANCHOR TABLE @V305132 01823000
L R0,ANCHENDA END-ADDR INTO R0 FOR ENDING-TEST @V305132 01824000
LA R15,ANCHPHNM AND PT TO 1ST ANCHOR-TABLE ENTRY @V305132 01825000
USING ANCHPHNM,R15 REFERENCE ONE ANCHOR-TABLE-ENTRY @V305132 01826000
SRCHLOOP CLC 0(8,R15),0(R1) DESIRED PHASE-NAME FOUND ? @V305132 01827000
BE SRCHOK YES-GOOD SHOW-LOAD R0 AND EXIT. @V305132 01828000
LA R15,ANCHLENG(,R15) NO, ADVANCE TO NEXT ENTRY, @V305132 01829000
CR R15,R0 HAVE WE EXHAUSTED THE TABLE ? @V305132 01830000
BL SRCHLOOP NO - KEEP LOOKING. @V305132 01831000
DROP R15 YES - GIVE UP: @V305132 01832000
* MATCHING ANCHOR-TABLE-ENTRY WAS NOT FOUND: 01833000
SRCHNG LA R15,CON1 NO GOOD - R15=1 PER SPECS @V305132 01834000
LTR R15,R15 SET CONDITION CODE, @V305132 01835000
BR R14 AND RETURN. @V305132 01836000
SPACE 01837000
* MATCHING ANCHOR-TABLE-ENTRY WAS FOUND: 01838000
SRCHOK LR R0,R15 ADDR OF ANCHOR-TABLE ENTRY TO R0,@V305132 01839000
SR R15,R15 CLEAR R15 AND CONDITION CODE, @V305132 01840000
BR R14 AND RETURN. @V305132 01841000
EJECT 01842000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01843000
* * 01844000
* ERROR MESSAGES * 01845000
* * 01846000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01847000
SPACE 1 01848000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01849000
SPACE 1 01850000
ERR01E DMSERR NUM=91,LET=E,TEXT='SAVEAREA ADDRESS IN PARTITION PIB *01851000
NOT EQUIVALENT TO LTA SAVE ADDRESS' @V305066 01852000
LA R15,RC100 MESSAGE RETURN CODE @V305066 01853000
B CANCELS CANCEL THE SESSION @V305066 01854000
SPACE 2 01855000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01856000
SPACE 1 01857000
ERR02E DMSERR NUM=92,LET=E,TEXT='STXIT SAVEAREA ADDRESS INVALID' 01858000
LA R15,RC100 MESSAGE RETURN CODE @V305066 01859000
B CANCELS CANCEL THE SESSION @V305066 01860000
EJECT 01861000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01862000
SPACE 1 01863000
ERR03E DMSERR NUM=93,LET=E,TEXT='MVCOM MACRO ATTEMPTING TO ALTER OTHE*01864000
R THAN POSITION 12-23 OF COMREG' @V305066 01865000
LA R15,RC100 MESSAGE RETURN CODE @V305066 01866000
B CANCELS CANCEL THE SESSION @V305066 01867000
SPACE 2 01868000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01869000
SPACE 1 01870000
ERR04E DMSERR NUM=94,LET=E,TEXT='FROM ADDRESS ON MVCOM MACRO INVALID' 01871000
LA R15,RC100 MESSAGE RETURN CODE @V305066 01872000
B CANCELS CANCEL THE SESSION @V305066 01873000
EJECT 01874000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01875000
SPACE 1 01876000
ERR05E DMSERR NUM=95,LET=E,SUB=(HEX,(R2)),TEXT='INVALID ADDRESS ''...*01877000
.....''' @V305066 01878000
LA R15,RC100 MESSAGE RETURN CODE @V305066 01879000
B CANCELS CANCEL THE SESSION @V305066 01880000
SPACE 2 01881000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01882000
SPACE 1 01883000
ERR06E DMSERR NUM=04,LET=E,SUB=(CHARA,(R2)), @V305001*01884000
TEXT='PHASE ''........'' NOT FOUND' @V305001 01885000
LA R0,ABEND22 DOS/VS ABEND CODE @V305001 01886000
LA R15,RC28 MESSAGE RETURN CODE @V305001 01887000
B BABEND CALL $$BABEND @V305001 01888000
SPACE 1 01889000
VSRLIST DC CL8'DMSVSR' FOR VSAM CLEANUP AND RELEASE @V305106 01890000
DC 8X'FF' @V305106 01891000
EJECT 01892000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01893000
SPACE 01894000
NOVSAMS EQU * @V305106 01895000
DMSERR NUM=413,LET=S, @V305106*01896000
TEXT='STORAGE NOT INITIALIZED FOR VSAM PROCESSING' 01897000
LA R15,RC104 @V305106 01898000
B CANCELS NOW CANCEL THE JOB @V305106 01899000
SPACE 1 01900000
ERR140S DMSERR NUM=140,LET=S,SUB=(CHARA,(R2)),TEXT='......... MACRO NO*01901000
T SUPPORTED' @V305001 01902000
LA R15,RC100 MESSAGE RETURN CODE @V305001 01903000
B CANCELS CANCEL THE ROUTINE @V305001 01904000
EJECT 01905000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01906000
* * 01907000
* RUNMODE .. SVC 66 .. RETURN R1 = 0 INDICATING ISSUING * 01908000
* PROGRAM RUNNING IN VIRTUAL MODE * 01909000
* * 01910000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01911000
SPACE 1 01912000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305066 01913000
SPACE 1 01914000
RUNMODE SR R1,R1 ZERO REGISTER 1 @V305066 01915000
ST R1,EGPR1 RETURN R1 = 0 TO USER @V305066 01916000
B DOSRET GO TO EXIT WITH R15 = 0 @V305066 01917000
SPACE 2 01918000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01919000
* * 01920000
* DOSNOOP = SVC'S TO BE HANDLED AS A "NO-OP" * 01921000
* * 01922000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01923000
SPACE 1 01924000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 01925000
SPACE 1 01926000
DOSNOOP SR R0,R0 HERE TO RETURN R0 = 0 TO CALLER @V305132 01927000
ST R0,EGPR0 ... @V305132 01928000
SPACE 2 01929000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01930000
* * 01931000
* RETURN TO CMS * 01932000
* * 01933000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01934000
SPACE 1 01935000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01936000
SPACE 1 01937000
DOSRET DS 0H CLEAR R15 AND RETURN: @V305001 01938000
SR R15,R15 ZERO ERROR CODE FOR CMS @V305001 01939000
DOSRET2 L R14,OSTEMP RESTORE RETURN REGISTER, @V305001 01940000
BR R14 RETURN TO CMS @V305001 01941000
EJECT 01942000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01943000
* * 01944000
* CMS/DOS TABLE OF SEGMENT RESIDENT ROUTINES * 01945000
* * 01946000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01947000
SPACE 1 01948000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01949000
SPACE 1 01950000
DCSSTAB DS 0F TABLE OF ROUTINES IN DOS DCSS @V305001 01951000
DC AL4(DCSSEND) END ADDRESS OF TABLE @V305001 01952000
DC CL8'$$BOPEN',V(DMSBOP) @V305001 01953000
DC CL8'$$BOPNLB',V(DMSOPL) @V305001 01954000
DC CL8'$$BOPENR',V(DMSOR1) @V305001 01955000
DC CL8'$$BOPNR2',V(DMSOR2) @V305001 01956000
DC CL8'$$BOPNR3',V(DMSOR3) @V305001 01957000
DC CL8'$$BDUMP',V(DMSDMP) @V305001 01958000
DC CL8'$$BPDUMP',V(DMSPDP) @V305001 01959000
DC CL8'$$BJDUMP',V(DMSDMP) @V305001 01960000
DC CL8'$$BCLOSE',V(DMSCLS) @V305001 01961000
ABTERM DC CL8'$$BABEND',V(DMSBAB) @V305001 01962000
DC CL12'$$BOSDEV' @V305001 01963000
DC CL12'$$BCEOV1' @V305001 01964000
DCSSEND EQU * @V305001 01965000
EJECT 01966000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01967000
* * 01968000
* CONSTANTS, PLISTS, AND EQUATES * 01969000
* * 01970000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01971000
SPACE 1 01972000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305001 01973000
SPACE 1 01974000
ERRMSG0 DC AL1(ENDMSG0-ERRMSG0-1) @V305001 01975000
DC C'UNSUPPORTED SVC ... (HEX ..) CALLED FROM ......' 01976000
ENDMSG0 DS 0X @V305001 01977000
SPACE 2 01978000
DS 0D @V305001 01979000
FCLEAR DC CL8'FILEDEF' COMMAND NAME @V305001 01980000
DC CL8'DOSLIB' DDNAME @V305001 01981000
DC CL8'CLEAR' FUNCTION @V305001 01982000
FENCE8 DC 8X'FF' 8-BYTE FENCE @V305001 01983000
SPACE 2 01984000
FEOVD DC CL9'FEOVD ' @V305001 01985000
SEOV DC CL5'SEOV/' @V305001 01986000
FEOV DC CL4'FEOV' @V305001 01987000
BOSDEV DC CL8'$$BOSDEV' @V305066 01988000
BCEOV1 DC CL8'$$BCEOV1' @V305066 01989000
BEOJ4 DC CL8'$$BEOJ4' @V305066 01990000
IKQVDCN DC CL8'IKQVDCN' @V305066 01991000
NONAME DC CL8'NO NAME' DEFAULT JOBNAME @V305066 01992000
IDC DC CL3'IDC' @V305066 01993000
SYS DC CL3'SYS' @V305066 01994000
IKQV DC CL4'IKQV' @V305066 01995000
IKQVLAB DC CL8'IKQVLAB' @V305066 01996000
IKQVLASF DC CL8'IKQVLASF' @VM03158 01997000
DMSSMNAT DC CL8'DMSSMNAT' @V305066 01998000
BTRANS DC CL8'$$BOMSG7' @VM03230 01999000
SPACE 2 02000000
ONE DC H'1' @V305001 02001000
TWO DC H'2' @V305001 02002000
THREE DC H'3' @V305001 02003000
FOUR DC H'4' @VM03230 02004000
SEVEN DC H'7' @V305001 02005000
EIGHT DC H'8' @V305001 02006000
NINE DC H'9' @V305001 02007000
ELEVEN DC H'11' @V305001 02008000
TWELVE DC H'12' @V305001 02009000
TWENTY4 DC H'24' @V305001 02010000
H255 DC H'255' MAX. CMS RETCODE @V305066 02011000
H100 DC H'100' @V305001 02012000
H8192 DC H'8192' @V305001 02013000
ADD1 DC F'1' @V305066 02014000
CON4096 DC F'40960000' TEN THOUSAND (TIMES 4096) @V305066 02015000
F127 DC F'127' @V305001 02016000
MASKB DC X'00FFFFF8' @VA06270 02017000
TWFRTMUS DC XL4'018B8200' 24 HRS IN TIMER UNITS @VA09246 02017500
* 02018000
* VARIOUS EQUATES: 02019000
* 02020000
XFF EQU X'FF' @V305001 02021000
JC59OFF EQU X'FB' @V305001 02022000
M7 EQU B'0111' FOR CLM/ICM/STCM USE-LOW 3 BYTES @V305001 02023000
M3 EQU B'0011' FOR CLM/ICM USE - LOW 2 BYTES @V305001 02024000
M14 EQU B'1110' FOR CLM/ICM/STCM USE-HI 3 BYTES @V305001 02025000
READY EQU X'83' IND TASK READY TO RUN (IN PIBTAB)@V305001 02026000
ABEND25 EQU X'25' ERROR CODE PASSED TO $$BABEND @V305066 02027000
ABEND2B EQU X'2B' I/O ERROR ABEND @V305066 02028000
ABEND21 EQU X'21' ERROR CODE PASSED TO $$BABEND @V305066 02029000
ABEND22 EQU X'22' ERROR CODE PASSED TO $$BABEND @V305066 02030000
ABEND1A EQU X'1A' ERROR CODE PASSED TO $$BABEND @V305066 02031000
RC100 EQU 100 @V305066 02032000
RC101 EQU 101 @V305066 02033000
RC8 EQU 8 @V305066 02034000
RC12 EQU 12 @V305066 02035000
RC28 EQU 28 @V305066 02036000
RESETSK EQU X'0F' RESET PSW STORAGE KEY @V305066 02037000
SVC2CALL EQU 2 @V305066 02038000
SVC4CALL EQU 4 @V305066 02039000
ANYPARM EQU X'00' ANY PARAMETERS @V305066 02040000
DEEQYES EQU X'02' DE = YES ON FETCH/LOAD @V305066 02041000
ELEMLEN EQU 34 LIST ELEMENT LENGTH @V305066 02042000
SVC2 EQU 2 SVC 2 @V305066 02043000
NEWGET EQU X'07' NEW GETIME MACRO @V305066 02044000
POSTECB EQU X'80' POST ECB AFTER EXCP @V305066 02045000
BXLE12 EQU 12 @V305066 02046000
PROG EQU X'01' PROGRAMMER LOGICAL UNIT @V305066 02047000
ZONE EQU X'F0' @V305066 02048000
KEYC0 EQU X'C0' @V305066 02049000
HEX07 EQU X'07' @V305066 02050000
COUNT1 EQU 1 @V305066 02051000
LENGTH EQU 11 LENGTH IN HALFWORDS @V305066 02052000
ERROR22 EQU 22 @V305066 02053000
CON2048 EQU 2048 @V305066 02054000
CON1 EQU 1 @V305066 02055000
HEX00 EQU X'00' @V305001 02056000
RURDISP EQU 32 DISP INTO RURTABL @V305001 02057000
NOOP EQU 255 @V305001 02058000
TYP3330 EQU X'04' @V305001 02059000
TYP3340 EQU X'08' @V305001 02060000
TYP3340B EQU X'0A' @V305001 02061000
TYP333B EQU X'05' 3330-11 DTF DEV TYPE @V505098 02062000
TYP3350 EQU X'07' 3350 DTF DEV TYPE @V505098 02063000
FINDSYS EQU 12 @V305001 02064000
RC104 EQU 104 @V305001 02065000
ERR12 EQU 12 @V305001 02066000
EJECT 02067000
LTORG @V305001 02068000
EJECT 02069000
DROP R12 ADDRESSABILITY REQUIREMENTS... @V305001 02070000
USING DMSDOS,R0,R1 FOR S-CONSTANTS IN VECTOR-TABLE @V305001 02071000
SPACE 02072000
SVCMAX DC A(SVCTABE) LENGTH OF TABLE (IN BYTES) @V305001 02073000
SVCTAB DS 0F VECTOR-TABLE FOR SUPPRTD DOS SVCS@V305001 02074000
JTBL 0,EXCP EXCP @V305001 02075000
JTBL 1,FETCHA FETCH ANY PHASE @V305001 02076000
JTBL 2,COMMON FETCH $$B TRANS @V305001 02077000
JTBL 3,NOTSUP FORCE DEQUEUE @V305001 02078000
JTBL 4,LOAD LOAD ANY PHASE @V305001 02079000
JTBL 5,MVCOM MODIFY SYSCOM @V305001 02080000
JTBL 6,CANCEL CANCEL PROBLEM PROGRAM @V305001 02081000
JTBL 7,WAIT WAIT FOR A CCB @V305001 02082000
JTBL 8,COMMON TRANSFER CONTROL TO PROGRAM @V305001 02083000
JTBL 9,COMMON RETURN TO $$B TRANSIENT @V305001 02084000
JTBL 10,DOSRET SET TIMER INTERVAL @V305001 02085000
JTBL 11,COMMON RETURN FROM $$B TRANSIENT @V305001 02086000
JTBL 12,SVC012 RESET SWITCHES IN BGCOM @V305001 02087000
JTBL 13,NOTSUP SET SWITCHES IN BGCOM @V305001 02088000
JTBL 14,EOJ TERMINATE JOB @V305001 02089000
JTBL 15,NOTSUP HEADQUEUE & EXECUTE CHANNEL PGM. @V305001 02090000
JTBL 16,STXITPC ESTABLISH LNKGE TO PC @V305001 02091000
JTBL 17,EXITPC RETURN FROM USER'S PC @V305001 02092000
JTBL 18,DOSRET STXIT (IT) @V305001 02093000
JTBL 19,NOTSUP RETURN FROM USER'S IT @V305001 02094000
JTBL 20,DOSRET ESTABLISH LNKGE TO OC @V305001 02095000
JTBL 21,NOTSUP RETURN FROM USER'S OC @V305001 02096000
JTBL 22,DOSRET SEIZE (INTERRUPT ENABLE/DISABLE) @V305001 02097000
JTBL 23,NOTSUP LOAD PHASE HEADER @V305001 02098000
JTBL 24,DOSRET SET TIMER INTERVAL @V305001 02099000
JTBL 25,NOTSUP ISSUE HALT I/O @V305001 02100000
JTBL 26,VALADDR VALIDATE ADDRESS LIMITS @V305001 02101000
JTBL 27,NOTSUP SPECIAL HALT I/O @V305001 02102000
JTBL 28,NOTSUP RETURN FROM USER'S MR @V305001 02103000
JTBL 29,NOTSUP MULTIPLE WAITM SUPPORT @V305001 02104000
JTBL 30,NOTSUP WAIT FOR QTAM ELEMENT @V305001 02105000
JTBL 31,NOTSUP POST A QTAM ELEMENT @V305001 02106000
JTBL 32,NOTSUP RESERVED @V305001 02107000
JTBL 33,COMREG VERIFY ADDRESS OF BGCOMM @V305001 02108000
JTBL 34,GETIME PROVIDE TIME OF DAY @V305001 02109000
JTBL 35,DOSRET HOLD A TRACK @V305001 02110000
JTBL 36,DOSRET FREE A TRACK @V305001 02111000
JTBL 37,STXITAB ESTABLISH LNKGE TO AB @V305001 02112000
JTBL 38,NOTSUP INITIALIZE A SUBSTASK @V305001 02113000
JTBL 39,NOTSUP TERMINATE A SUBSTASK @V305001 02114000
JTBL 40,POST POST TASK EVENT @V305001 02115000
JTBL 41,DOSRET DEQUEUE A RESOURCE @V305001 02116000
JTBL 42,DOSRET ENQUEUE A RESOURCE @V305001 02117000
JTBL 43,NOTSUP RESERVED @V305001 02118000
JTBL 44,NOTSUP EXTERNAL UNIT CHECKS RECORD @V305001 02119000
JTBL 45,NOTSUP EMULATOR INTERFACE @V305001 02120000
JTBL 46,NOTSUP OLTEP IN SUPERVISOR STATE @V305001 02121000
JTBL 47,NOTSUP MULTIPLE WAITF SUPPORT @V305001 02122000
JTBL 48,NOTSUP FETCH A CRT TRANS @V305001 02123000
JTBL 49,NOTSUP RESERVED @V305001 02124000
EJECT 02125000
JTBL 50,LIOCS RESERVED FOR LIOCS @V305001 02126000
JTBL 51,NOTSUP RETURN PHASE HEADER @V305001 02127000
JTBL 52,DOSNOOP RETURN REMAINING TIMER INTERVAL @V305001 02128000
JTBL 53,NOTSUP RESERVED @V305001 02129000
JTBL 54,NOTSUP FREE REAL PAGE FRAMES @V305001 02130000
JTBL 55,NOTSUP GET REAL PAGE FRAMES @V305001 02131000
JTBL 56,NOTSUP GET/FREE PUB OF POWER DEVICE @V305001 02132000
JTBL 57,NOTSUP MAKE POWER DISPATCHABLE @V305001 02133000
JTBL 58,NOTSUP INT. BETWEEN JCL AND SUPVSOR @V305001 02134000
JTBL 59,NOTSUP INT. BETWEEN EOJ AND SUPVSOR @V305001 02135000
JTBL 60,NOTSUP EREP AND CRT I/O AREAS ADDR. @V305001 02136000
JTBL 61,GETVIS GET VIRTUAL STORAGE @V305001 02137000
JTBL 62,FREEVIS FREE VIRTUAL STORAGE @V305001 02138000
JTBL 63,SVC63 USE A RESOURCE @V305001 02139000
JTBL 64,SVC64 RELEASE A RESOURCE @V305001 02140000
JTBL 65,CDLOAD LOAD VSAM @V305001 02141000
JTBL 66,RUNMODE RUNMODE @V305001 02142000
JTBL 67,DOSRET PFIX, FIX PAGES IN REAL STORAGE @V305001 02143000
JTBL 68,DOSRET PFREE, FREE PAGES IN REAL STOR @V305001 02144000
JTBL 69,NOTSUP REALAD @V305001 02145000
JTBL 70,NOTSUP VIRTAD @V305001 02146000
JTBL 71,DOSRET SETPFA @V305001 02147000
JTBL 72,NOTSUP GETCBUF/FREECBUF @V305001 02148000
JTBL 73,NOTSUP SETAPP @V305001 02149000
JTBL 74,NOTSUP FIX PAGES IN REAL STOR FOR RESTRT@V305001 02150000
EJECT 02151000
JTBL 75,SECTVAL SECTVAL @V305001 02152000
JTBL 76,NOTSUP INIT. RECORD. OF RMSR IO ERROR @V305001 02153000
JTBL 77,NOTSUP TRANSCSW @V305001 02154000
JTBL 78,NOTSUP RESERVED @V305001 02155000
JTBL 79,NOTSUP RESERVED @V305001 02156000
JTBL 80,NOTSUP RESERVED @V305001 02157000
JTBL 81,NOTSUP RESERVED @V305001 02158000
JTBL 82,NOTSUP RESERVED @V305001 02159000
JTBL 83,NOTSUP RESERVED @V305001 02160000
JTBL 84,NOTSUP RESERVED @V305001 02161000
JTBL 85,DOSRET RELPAG @V305001 02162000
JTBL 86,DOSRET FCEPGOUT @V305001 02163000
JTBL 87,DOSRET PAGEIN @V305001 02164000
JTBL 88,NOTSUP RESERVED @V387274 02165000
JTBL 89,NOTSUP RESERVED @V387274 02166000
JTBL 90,NOTSUP RESERVED @V387274 02167000
JTBL 91,NOTSUP RESERVED @V387274 02168000
JTBL 92,NOTSUP RESERVED @V387274 02169000
JTBL 93,NOTSUP RESERVED @V387274 02170000
JTBL 94,NOTSUP RESERVED @V387274 02171000
JTBL 95,EXITAB EXIT AB @V387274 02172000
SVCTABE EQU *-SVCTAB LENGTH OF TABLE (IN BYTES). @V305001 02173000
SPACE 02174000
USING NUCON,R0 RESTORE NORMAL ADDRESSABILITY @V305001 02175000
USING DMSDOS,R12 ... @V305001 02176000
DROP R1 ... @V305001 02177000
EJECT 02178000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02179000
* * 02180000
* "SECTVAL" = SVC 75 * 02181000
* * 02182000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02183000
SPACE 1 02184000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 02185000
SPACE 1 02186000
SECTVAL DS 0H COMPUTE DESIRED SECTOR VALUE: @V305132 02187000
BALR R11,0 ADDRESSABILITY IN CASE NEEDED @V305132 02188000
USING *,R11 ... @V305132 02189000
LA R4,PARM3330 SET R4 (DEFAULT) = 3330 PARM TABL@V305132 02190000
CLI EGPR1,TYP3330 BYTE 0 OF REG 1 = DEV TYPE CODE @V305132 02191000
BE SECTVAL1 = X'04' - IT'S A 3330 @V305132 02192000
CLI EGPR1,TYP333B IS DEV TYPE A 3330-11?? @V505098 02193000
BE SECTVAL1 YES, GO CAL. SECTOR VALUE @V505098 02194000
LA R4,PARM3350 SET UP 3350 SECTOR CONSTANTS @V505098 02195000
CLI EGPR1,TYP3350 IS DEV TYPE A 3350?? @V505098 02196000
BE SECTVAL1 YES, GO CAL. SECTOR VALUE @V505098 02197000
CLI EGPR1,TYP3340 NO - '08'/'09'/'0A' MEANS 3340...@V305132 02198000
BL SECTNG NO GOOD - SOMEBODY GOOFED. @V305132 02199000
CLI EGPR1,TYP3340B ... @V305132 02200000
BH SECTNG NO GOOD - SORRY ABOUT THAT. @V305132 02201000
LA R4,PARM3340 OK - IT'S A 3340 - SET R4. @V305132 02202000
SECTVAL1 SR R0,R0 CLEAR REGS FOR MULTIPLY, DIVIDE, @V305132 02203000
SR R2,R2 AND IC USE @V305132 02204000
SR R3,R3 ... @V305132 02205000
IC R2,EGPR0+2 GET 'K' FIELD = KEY LENGTH @V305132 02206000
IC R3,EGPR0+3 GET 'R' FIELD = RECORD NUMBER @V305132 02207000
LH R1,EGPR0 GET THE 2-BYTE 'DD' FIELD @V305132 02208000
LTR R1,R1 CK SIGN AFTER LH TO CHECK 1ST BIT@V305132 02209000
BM SECTVAR IF MINUS, MEANS VAR. LENGTH RECS @V305132 02210000
AL R1,8(,R4) ADD VALUE OF 135(3330)/167(3340) @V305132 02211000
BC 11,SECTNG ERR IF CC ¬= 1 (PLUS W/NO CARRY) @V305132 02212000
LTR R2,R2 KEY GIVEN ? @V305132 02213000
BZ SECTMULT NO - CONTINUE SHORTLY BELOW. @V305132 02214000
ALR R1,R2 YES - ADD KEY LENGTH, @V305132 02215000
BC 11,SECTNG ERR IF CC ¬= 1 (PLUS W/NO CARRY) @V305132 02216000
AL R1,12(,R4) PLUS ADDL ADJ'TR FOR NONZERO KEYS@V305132 02217000
BC 11,SECTNG ERR IF CC ¬= 1 (PLUS W/NO CARRY) @V305132 02218000
SECTMULT S R3,ADD1 SUBTRACT ONE FROM RECORD NUMBER, @V305132 02219000
BM SECTZERO IF IT WAS RCD R0, MAKE ANSWER=0. @V305132 02220000
MR R0,R3 OK - MULT R1 BY RCD NUMBER (-1) @V305132 02221000
LTR R0,R0 MAKE SURE NO RIDICULOUS PRODUCT @V305132 02222000
BNZ SECTNG ... @V305132 02223000
LTR R1,R1 ... @V305132 02224000
BM SECTNG ... @V305132 02225000
AL R1,4(,R4) ADD NUMTR CONSTANT OF 237 OR 353,@V305132 02226000
BC 4,SECTDIV CC SHOULD = 1 FOR PLUS W/NO CARRY@V305132 02227000
B SECTNG OTHERWISE WE'VE GOT FISHY ANSWER @V305132 02228000
SPACE 02229000
SECTVAR ICM R1,M3,EGPR0 FOR VAR LENGTH RCDS, GET NO. OF @V305132 02230000
N R1,=A(X'7FFF') BYTES USED ON TRACK UPTO CURR.RCD@V305132 02231000
SECTDIV D R0,0(,R4) DIV BY 105 (3330) OR 140 (3340) @V305132 02232000
* (REMAINDER NOW IN R0, QUOTIENT IN R1) 02233000
SECTCHEK CL R1,F127 IS CALCULATED ANSWER > 127? @V305132 02234000
BH SECTNG YES - USE NO-OP VALUE OF X'FF'. @V305132 02235000
SECTSTOR ST R1,EGPR0 STORE ANSWER IN CALLER'S GPR0, @V305132 02236000
B DOSRET AND RETURN TO CALLER. @V305132 02237000
SPACE 02238000
* INPUT PARAMETERS ARE FAULTY, OR CALCULATED ANSWER IS > 127: 02239000
SECTNG LA R1,NOOP USE NO-OP VALUE OF X'FF', @V305132 02240000
B SECTSTOR AND GO RETURN SAME TO CALLER. @V305132 02241000
SPACE 02242000
* RECORD NUMBER WAS 0: 02243000
SECTZERO SR R1,R1 USE VALUE OF 0, @V305132 02244000
B SECTSTOR AND GO RETURN SAME TO CALLER. @V305132 02245000
SPACE 02246000
* PARAMETERS FOR CALCULATING 3330 SECTOR NUMBERS: 02247000
PARM3330 DC F'105' 0 - DENOMINATOR @V305132 02248000
DC F'237' 4 - NUMERATOR CONSTANT @V305132 02249000
DC F'135' 8 - ADDITION CONSTANT IF KL = 0 @V305132 02250000
DC A(191-135) 12 - ALSO ADD THIS IF KL > 0 @V305132 02251000
SPACE 02252000
* PARAMETERS FOR CALCULATING 3340 SECTOR NUMBERS: 02253000
PARM3340 DC F'140' 0 - DENOMINATOR @V305132 02254000
DC F'353' 4 - NUMERATOR CONSTANT @V305132 02255000
DC F'167' 8 - ADDITION CONSTANT IF KL = 0 @V305132 02256000
DC A(242-167) 12 - ALSO ADD THIS IF KL > 0 @V305132 02257000
SPACE 02258000
* PARAMETERS FOR CALCULATING 3350 SECTOR NUMBERS 02259000
PARM3350 DC F'156' 0 - DENOMINATOR @V505098 02260000
DC F'389' 4 - NUMERATOR CONSTANT @V505098 02261000
DC F'185' 8 - ADDITION CONSTANT IF KL=0 @V505098 02262000
DC A(267-185) 12 - ALSO ADD THIS IF KL > 0 @V505098 02263000
SPACE 02264000
DROP R11 (THRU WITH LOCAL ADDRESSABILITY) @V305132 02265000
EJECT 02266000
* 02267000
* NECESSARY TO LOAD VSAM SEGMENT (E.G. TO DO A CALL FOR GENCB/MODCB): 02268000
* 02269000
LDVSAM DS 0F @V305132 02270000
USING LDVSAM,R11 TEMP. ADDRESSABILITY @V305132 02271000
L R3,ASYSNAMS GET A(SAVED SYS TABLE) @V305106 02272000
USING SYSNAMES,R3 AND MAP IT... @V305106 02273000
LA R4,CMSVSAM POINT TO SAVED VSAM NAME @V305106 02274000
LA R5,FINDSYS USE 'FINDSYS' CODE @V305132 02275000
DC X'83450064' FIND SAVED SYSTEM @V305132 02276000
BC 8,LOADED CC=0, ALREADY LOADED (STRANGE) @V305132 02277000
BC 4,LOADIT CC=1, EXISTS BUT NOT LOADED @V305132 02278000
BR R10 OTHER ERRORS--RETURN TO CALLER. @V305132 02279000
SPACE 1 02280000
LOADIT C R4,VMSIZE WILL IT OVERLAY USER'S VIRT MACH?@V305132 02281000
BL CDOVRLAY ERROR - SGMT WAS GEN'D INCORR. @V305132 02282000
LA R4,CMSVSAM POINT TO VSAM NAME AGAIN @V305106 02283000
DROP R3 @V305132 02284000
SR R5,R5 R5=0 FOR SHARED COPY @V305132 02285000
DC X'83450064' LOAD THE SHARED SYSTEM @V305132 02286000
BCR 7,R10 ANY ERROR - RETURN TO CALLER. @V305132 02287000
LOADED EQU * VSAM SEGMENT LOADED (ADDR IN R4) @V305132 02288000
C R4,VMSIZE WILL IT OVERLAY USER'S VIRT MACH?@V305132 02289000
BL CDOVRLAY ERROR - SEGT WAS GEN'D INCORR. @V305132 02290000
ST R4,AVSAMSYS OK-STOR "AVSAMSYS" ADDR(IN NUCON)@V305132 02291000
OI VSAMFLG1,VSAMRUN AND SIGNAL VSAM SYSTEM LOADED. @V305132 02292000
LR R3,R4 ADDRESS OF VSAM SEGMENT TO R3. @V305132 02293000
SR R4,R4 CC=0 (MEANS PHASE FOUND ON SEGT) @V305132 02294000
BR R10 RETURN TO CALLER. @V305132 02295000
EJECT 02296000
* 02297000
* ATTEMPT TO LOAD VSAM SEGMENT WOULD OVERLAY USER'S VIRTUAL MACHINE: 02298000
* VMSIZE HOLDS USERS VIRTUAL MACHINE SIZE 02299000
* VSAMNAME HOLDS NAME OF SEGMENT GENERATED INCORRECTLY 02300000
* R4 (BINARY NO.) HOLDS ADDRESS AT WHICH SEGMENT WAS GENERATED 02301000
SPACE 1 02302000
* NOTE: SUPPORT CODE FOR THIS SECTION = @V305132 02303000
SPACE 1 02304000
CDOVRLAY L R2,VMSIZE LOAD VMSIZE @V305132 02305000
L R3,ASYSNAMS GET A(SAVED SYS TABLE) @V305106 02306000
USING SYSNAMES,R3 AND MAP IT... @V305106 02307000
LA R3,CMSVSAM POINT TO SAVED VSAM NAME @V305106 02308000
DROP R3 @V305132 02309000
DMSERR MF=(E,'SYS'),LET=S,NUM=401,TEXTA=CDOVMSGL, @V305132X02310000
SUB=(HEX,(R2),CHARA,(R3),HEX,(R4)) @V305132 02311000
LA R15,RC104 RETURN ABEND CODE NUMBER 104 @V305132 02312000
TM VSAMFLG1,VSAMSERV IS AMSERV RUNNING ? @V305106 02313000
BO BABEND YES, THEN EXIT THROUGH STXIT @V305106 02314000
B CANCELS OTHERWISE CANCEL THE SESSION. @V305106 02315000
DROP R11 (THRU WITH LOCAL ADDRESSABILITY) @V305132 02316000
SPACE 02317000
CDOVMSGL DC AL1(L'CDOVRMSG) @V305132 02318000
CDOVRMSG DC C'V.M. SIZE (......) CANNOT EXCEED ''........'' START ADX02319000
DRESS (......)' @V305132 02320000
DS 0H @V305132 02321000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02321030
* * 02321060
* SVC 26: VALIDATE ADDRESS LIMITS * 02321090
* R1 CONTAINS LOW ADDRESS * 02321120
* R2 CONTAINS HIGH ADDRESS * 02321150
* * 02321180
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02321210
SPACE 1 02321240
USING BGCOM,R5 @VA07500 02321270
VALADDR L R4,PPEND END PARTITION ADDRESS FROM BGCOM @VA07500 02321300
BALR R10,0 @VA07500 02321330
USING *,R10 @VA07500 02321360
LTR R1,R1 LOW ADDRESS MUST NOT BE NEGATIVE @VA07500 02321390
BNM TESTHIGH 0 OR POSITIVE, CHECK HIGH ADDRESS@VA07500 02321420
BADAD LR R2,R1 PREPARE TO ISSUE MESSAGE @VA07500 02321450
B ERR05E ISSUE ERROR MSG @VA07500 02321480
TESTHIGH LTR R2,R2 HIGH ADDRESS CANNOT BE NEGATIVE @VA07500 02321510
BM ERR05E ERROR IF IT IS @VA07500 02321540
CR R1,R4 LOW ADDRESS > PPEND @VA07500 02321570
BNH CHKR2 CHECK HIGH ADDRESS @VA12390 02321600
CL R1,MAINHIGH LOW ADDR > GETVIS @VA12390 02321610
BH BADAD ERROR IF IT IS @VA12390 02321620
CHKR2 EQU * @VA12390 02321630
CR R2,R4 HIGH ADDR > PPEND @VA12390 02321640
BNH DOSRET ADDRESS IS OKAY @VA12390 02321650
CL R2,MAINHIGH HIGH ADDR > GETVIS @VA12390 02321660
BNH DOSRET ADDRESS IS OKAY @VA12390 02321670
B ERR05E GO TO PRINT MESSAGE @VA07500 02321690
DROP R10 @VA07500 02321720
DROP R5 @VA07500 02321750
EJECT 02321780
EJECT 02322000
* GET BLOCK OF STORAGE 02323000
* (THIS CODE DELIBERATELY LIFTED FROM DMSSMN FOR COMPATIBILITY) 02324000
* 02325000
* R0 = SIZE OF FREE AREA DESIRED 02326000
* R14 = RETURN REGISTER 02327000
* NOTE: R7 THRU R9 USED FOR SCRATCH (NOT PRESERVED) 02328000
USING GETBLK,R10 ADDR'BILITY PROVIDED BY CALLER @V305132 02329000
USING NUCON,R0 MUST BE STILL IN EFFECT @V305132 02330000
GETBLK LA R8,MAINLIST POINT TO FIRST BLOCK POINTER @V305132 02331000
AH R0,SEVEN ROUND BLOCK LENGTH TO @VA06270 02332000
N R0,MASKB DOUBLEWORD BOUNDARY @VA06270 02333000
GTNXTG LR R9,R8 UPDATE CHAIN PTR FOR "NEXT" BLOCK@V305132 02334000
L R8,0(,R9) GET BLOCK ADDRESS @V305132 02335000
LA R8,0(,R8) REMOVE HIGH ORDER BYTE @V305132 02336000
LTR R8,R8 IS THIS THE LAST BLOCK IN CHAIN? @V305132 02337000
BZ CKHIMAIN YES - TRY GET BLOCK FROM "HIMAIN"@V305132 02338000
CL R0,FRELEN(,R8) TEST SIZE OF FREE AREA @V305132 02339000
BH GTNXTG IF NOT BIG ENOUGH GET NEXT BLOCK @V305132 02340000
LR R1,R8 SAVE ADDRESS OF FREE AREA @V305132 02341000
BE ELIMBLK IF COMPLET AREA USED ELIM. BLOCK @V305132 02342000
LR R7,R8 A(START OF FREE BLOCK) @V305132 02343000
ALR R7,R0 + L'DESIRED AMOUNT @V305132 02344000
ST R7,0(,R9) = A(START OF REMAINING BLOCK) @V305132 02345000
L R15,0(,R8) RESET CHAIN OF POINTERS @V305132 02346000
ST R15,0(,R7) ... @V305132 02347000
L R8,FRELEN(,R8) ADJ FOR AMT USED FROM THIS BLOCK @V305132 02348000
SLR R8,R0 L'FREE BLOCK - L'DESIRED AMOUNT @V305132 02349000
ST R8,FRELEN(,R7) = L'REMAINING FREE BLOCK @V305132 02350000
B GETEXIT ZERO OUT BLOCK AND GET OUT @V305132 02351000
SPACE 02352000
ELIMBLK EQU * WHOLE BLOCK WAS GIVEN UP. @V305132 02353000
L R15,0(,R8) REMOVE BLOCK FROM CHAIN, @V305132 02354000
ST R15,0(,R9) BY UPDATING BACK POINTERS @V305132 02355000
B GETEXIT ZERO OUT BLOCK AND GET OUT @V305132 02356000
SPACE 02357000
CKHIMAIN L R1,MAINHIGH @V305132 02358000
LR R7,R1 A(PROPOSED BLOCK) = A(HIMAIN) @V305132 02359000
AR R7,R0 + L'DESIRED BLOCK @V305132 02360000
AH R7,H8192 KEEP 2 PAGES FOR EXTENTS @V305132 02361000
CL R7,FREELOWE A(PROP AREA) > A(EXTENDED AREA)? @V305132 02362000
BH NOBLOCK YES - NO BLOCK AVAILABLE @V305132 02363000
SH R7,H8192 SAVE 2 PAGES @V305132 02364000
ST R7,MAINHIGH RESET HIMAIN POINTER @V305132 02365000
GETEXIT SR R15,R15 ZERO OUT THE RETURN CODE. @V305132 02366000
BR R14 RETURN (W/ADDR OF BLOCK IN R1). @V305132 02367000
SPACE 2 02368000
NOBLOCK EQU * COULDN'T OBTAIN THE STORAGE ... @V305132 02369000
L R1,=A(X'FFFFFF') MAKE SURE R1 IS AN INVAL ADDR @V305132 02370000
* (SO USER CAN'T USE INADVERTENTLY) 02371000
LA R15,ERR12 ERROR 12 (X'0C') MEANS "NO GOTS" @V305132 02372000
LTR R15,R15 ENSURE NON-ZERO CONDITION CODE, @V305132 02373000
BR R14 AND PUNT OUT OF BOUNDS. @V305132 02374000
EJECT 02375000
* RETURN A FREED BLOCK(FB) TO THE CHAIN OF AVAILABLE CORE BLOCKS(CB) 02376000
* (THIS CODE DELIBERATELY LIFTED FROM DMSSMN FOR COMPATIBILITY) 02377000
* 02378000
* ENTRY: C(R0)=SIZE OF FB. C(R1)=V(FB) 02379000
* R14 = RETURN REGISTER 02380000
* NOTE: R6 THRU R9 USED FOR SCRATCH (NOT PRESERVED) 02381000
* 02382000
* "LOWER" MEANS "TOWARD CORE LOCATION ZERO." 02383000
USING GETBLK,R10 (SIC) ALSO IN EFFECT FOR "FREBLK"@V305132 02384000
USING NUCON,R0 (STILL IN EFFECT) @V305132 02385000
FREBLK LTR R0,R0 A VALID BLOCK LENGTH SPECIFIED? @V305132 02386000
BNP FREBLKNG NO - ERROR RETURN @V305132 02387000
CL R1,MAINSTRT VERIFY FB NOT BELOW FIRST CB @V305132 02388000
BL FREBLKNG LOWER - ERROR RETURN. @V305132 02389000
LA R9,MAINLIST GET FIRST BLOCK POINTER @V305132 02390000
AH R0,SEVEN ROUND BLOCK LENGTH TO @VA06270 02391000
N R0,MASKB DOUBLEWORD BOUNDARY @VA06270 02392000
NEXTF L R8,0(,R9) GET BLOCK ADDRESS @V305132 02393000
LA R8,0(,R8) REMOVE HIGH ORDER BYTE @V305132 02394000
LTR R6,R8 VER. THAT THIS CORE BLOCK EXISTS @V305132 02395000
BZ CKMAIN NO BLOCK - END OF CHAIN. @V305132 02396000
CLR R1,R8 EXAMINE V(FB) RELATIVE TO V(CB) @V305132 02397000
BNH FRABVE CB HIGHER THAN FB @V305132 02398000
AL R6,FRELEN(,R8) CB < FB - GET V(END IF CB) @V305132 02399000
CLR R1,R6 COMP A(FB) TO A(END OF CB) @V305132 02400000
BE FRBLOW FREED BLOCK CONTIG. AT END OF CB @V305132 02401000
BL FREBLKNG ERR - FREED BLCK IN MIDDLE OF CB @V305132 02402000
LR R9,R8 FREE AREA ¬ RELATED TO THIS AREA @V305132 02403000
B NEXTF TRY AGAIN @V305132 02404000
SPACE 02405000
CKMAIN EQU * FB MUST BR RELATIVE TO LAST CB @V305132 02406000
LR R7,R1 GET V(LOCATION OF FREED BLOCK) @V305132 02407000
ALR R7,R0 ADDRESS + SIZE @V305132 02408000
CL R7,MAINHIGH VERIFY END OF FB IS < HIMAIN @V305132 02409000
BH FREBLKNG ERROR - VERY FISHY @V305132 02410000
BL ADDBLK FREED BLCK SOMEWHERE W/I MAINHIGH@V305132 02411000
ST R1,MAINHIGH FB CONTIG. TO HIMAIN-RESET HIMAIN@V305132 02412000
SR R15,R15 CLEAR RETURN CODE, @V305132 02413000
BR R14 AND RETURN TO CALLER. @V305132 02414000
SPACE 02415000
FRABVE LR R6,R1 FIND END OF NEW AREA @V305132 02416000
ALR R6,R0 A(FB)+L'FB = A(END OF FREED BLK) @V305132 02417000
CLR R6,R8 A(END OF FRED BLOCK) <> A(CB) @V305132 02418000
BH FREBLKNG @V305132 02419000
BL ADDBLK ADD NEW AREA ABOVE THIS AREA @V305132 02420000
ST R1,0(,R9) NEW AREA CONTIGUOUS TO THIS AREA @V305132 02421000
L R7,FRELEN(,R8) MODIFY THIS BLOCK @V305132 02422000
ALR R7,R0 REFLECT ADDED FREED BLOCK AMOUNT @V305132 02423000
ST R7,FRELEN(,R1) @V305132 02424000
L R15,0(,R8) MOVE POINTER TO NEW @V305132 02425000
ST R15,0(,R1) BEGINNING OF BLOCK @V305132 02426000
SR R15,R15 CLEAR RETURN CODE, @V305132 02427000
BR R14 AND RETURN TO CALLER. @V305132 02428000
EJECT 02429000
ADDBLK EQU * CREATE ANOTHER CHAINED BLOCK. @V305132 02430000
ST R1,0(,R9) POINT TO FREED BLOCK @V305132 02431000
ST R8,0(,R1) SET CONTROL WORDS FOR NEW BLOCK. @V305132 02432000
ST R0,FRELEN(,R1) SET ADDR & SIZE OF THIS NEW BLK @V305132 02433000
SR R15,R15 CLEAR RETURN CODE, @V305132 02434000
BR R14 AND RETURN TO CALLER. @V305132 02435000
SPACE 02436000
FRBLOW EQU * FREED BLOCK IS HIGHER THAN ITS CB@V305132 02437000
L R7,FRELEN(,R8) L'CB @V305132 02438000
ALR R7,R0 + L'FB = SIZE OF TOTAL CORE BLOCK@V305132 02439000
L R15,0(,R8) GET A(NEXT BLOCK) @V305132 02440000
LR R6,R7 L'ENTIRE RETURNING CORE BLOCK @V305132 02441000
ALR R6,R8 + AA(CB) = A(END OF TOT CORE BLK)@V305132 02442000
LTR R15,R15 IS THERE ANOTHER BLOCK @V305132 02443000
BZ CMAIN NO - NEW FB LOWER THAN LAST BLOCK@V305132 02444000
CLR R6,R15 A(END OF CB)<> A(NEXT BLOCK) @V305132 02445000
BH FREBLKNG ERR--A(END OF TOT CB) > A(NXT BL)@V305132 02446000
BL KPBLK NEW AREA DOESN'T TOUCH NEXT BLK @V305132 02447000
MVC 0(4,R8),0(R15) TOTAL CB & NEXT BLK ARE CONTIG. @V305132 02448000
AL R7,FRELEN(,R15) INCLUDE L'NEXT CORE BLOCK @V305132 02449000
KPBLK ST R7,FRELEN(,R8) RESET LGTH OF CB TO INC FB & NXT @V305132 02450000
SR R15,R15 CLEAR RETURN CODE, @V305132 02451000
BR R14 AND RETURN TO CALLER. @V305132 02452000
SPACE 02453000
CMAIN CL R6,MAINHIGH COMP A(END OF BLOCK) TO MAINHIGH @V305132 02454000
BNE KPBLK NE - FB MUST BE WITHIN MAINHIGH @V305132 02455000
L R6,MAINHIGH VALUE OF MAINHIGH @V305132 02456000
SR R6,R7 - L'ENTIRE RETURNING BLOCK @V305132 02457000
ST R6,MAINHIGH RESET HIMAIN TO REFLECT FREED BLK@V305132 02458000
SR R15,R15 CLEAR RETURN CODE, @V305132 02459000
ST R15,0(,R9) ELIMINATE OLD BLOCK @V305132 02460000
BR R14 AND RETURN TO CALLER. @V305132 02461000
SPACE 1 02462000
FREBLKNG LA R15,CON1 ERROR IN BLOCK BEING RETURNED @V305132 02463000
LTR R15,R15 ENSURE NONZERO CONDITION CODE @V305132 02464000
BR R14 AND PUNT OVER THE GOAL LINE. @V305132 02465000
SPACE 02466000
FREPTR EQU 0 POINTER TO NEXT BLOCK (IF ANY) @V305132 02467000
FRELEN EQU 4 LENGTH OF THIS BLOCK @V305132 02468000
SPACE 02469000
DROP R10 THRU WITH LOCAL ADDRESSABILITY @V305132 02470000
EJECT 02470010
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02470020
* * 02470030
* "USE" = SVC 63 * 02470040
* LIMITED IMPLEMENTATION AS NEEDED FOR VSAM UNDER CMS * 02470050
* * 02470060
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02470070
SPACE 1 02470080
* NOTE: USES "RURTBL" (IN DMSNUC) OF THE FOLLOWING FORM: 02470090
* (1) 8 FULLWORDS SERVING AS COUNTERS FOR RESOURCE CODES 02470100
* (HALFWORD 2 BYTES BEYOND R1 GIVEN BY USER) OF 02470110
* THE FORM X'C000' TO X'C007' 02470120
* (2) 8 GROUPS OF 12 BYTES EACH FOR RESOURCE CODES OF X'E000' 02470130
* GIVEN BY CALLER, WHERE R0 POINTED TO AN 8-BYTE RESOURCE-NAME, 02470140
* THE 12 BYTES BEING IN THE FOLLOWING FORM: 02470150
* FIRST 4 BYTES: COUNTER 02470160
* NEXT 8 BYTES: 8-BYTE RESOURCE NAME 02470170
SPACE 2 02470180
SVC63 DS 0H "USE" - LIMITED IMPLEMENTATION: @VA07500 02470190
BALR R10,0 @VA07500 02470200
USING *,R10 ADDRESSABILITY @VA07500 02470210
L R3,SYSE000 LOOK FOR KEY OF 'E000' @VA07500 02470220
CLM R3,M3,2(R1) ... @VA07500 02470230
BE SVC63B IF = 'E000', HANDLE R0 ALSO. @VA07500 02470240
CLI 2(R1),KEYC0 IF NOT E000, MUST BE C0 @VA07500 02470250
BNE ERROR63 ERROR SOMEWHERE IF NOT. @VA07500 02470260
CLI 3(R1),HEX07 AND LAST BYTE MUST NOT EXCEED 07 @VA07500 02470270
BH ERROR63 ERROR SOMEWHERE IF IT DOES. @VA07500 02470280
SR R2,R2 CLEAR, @VA07500 02470290
IC R2,3(,R1) GET LAST 3 BITS OF RESOURCE CODE @VA07500 02470300
ALR R2,R2 "MULTIPLY BY 4" @VA07500 02470310
ALR R2,R2 ... @VA07500 02470320
A R2,ARURTBL FORM ADDRESS OF RUR-TABLE ENTRY @VA07500 02470330
SVC63A L R3,0(,R2) GET OLD VALUE FROM RUR-TABLE @VA07500 02470340
LA R4,1(,R3) PLUS ONE; @VA07500 02470350
ST R4,0(,R2) STORE INCREMENTED VALUE (COUNTER)@VA07500 02470360
LTR R0,R3 OLD VALUE INTO R0 AND SET C.C. @VA07500 02470370
BZ SVC63X IF 0, EXIT (WITH R0 = 0). @VA07500 02470380
LA R0,RC8 IF > 0, SET RETURN-CODE = 8 @VA07500 02470390
SVC63X ST R0,EGPR0 RETURN R0 VALUE TO THE USER @VA07500 02470400
B DOSRET AND GO EXIT. @VA07500 02470410
SPACE 02470420
SVC63B EQU * CODE WAS X'E000' ... @VA07500 02470430
LA R2,RURDISP FORM ADDRESS OF SECTION OF RURTBL@VA07500 02470440
A R2,ARURTBL CONTAINING E000 ENTRIES @VA07500 02470450
LR R3,R2 REMEMBER FOR LATER; @VA07500 02470460
L R1,EGPR0 REF 8-BYTE RESOURCE PER USER'S R0@VA07500 02470470
L R0,FENCE ENDING SENTINEL @VA07500 02470480
SVC63C CLC 4(8,R2),0(R1) DOES RESOURCE MATCH THAT IN TABLE@VA07500 02470490
BE SVC63A YES-GO HANDLE VIA GENL CASE LOGIC@VA07500 02470500
LA R2,12(,R2) NO - POINT TO NEXT 12-BYTE ENTRY,@VA07500 02470510
CL R0,0(,R2) HAVE WE HIT ENDING SENTINEL ? @VA07500 02470520
BNE SVC63C NOPE - KEEP LOOKING. @VA07500 02470530
LR R2,R3 START AT BEG'NG OF SECTION AGAIN @VA07500 02470540
SR R3,R3 AND LOOK FOR AN EMPTY SLOT: @VA07500 02470550
SVC63D CL R3,0(,R2) EMPTY SLOT FOUND ? @VA07500 02470560
BE SVC63E YES - GOOD SHOW. @VA07500 02470570
LA R2,12(,R2) NO - POINT TO NEXT 12-BYTE ENTRY,@VA07500 02470580
CL R0,0(,R2) HAVE WE HIT ENDING SENTINEL ? @VA07500 02470590
BNE SVC63D NOPE - KEEP LOOKING. @VA07500 02470600
B ERROR63 ERROR IF NOTHING LEFT IN RURTBL. @VA07500 02470610
SVC63E MVC 4(8,R2),0(R1) MOVE RESOURCE-NAME TO EMPTY SLOT,@VA07500 02470620
B SVC63A AND GO JOIN GENERAL-CASE HANDLER.@VA07500 02470630
SPACE 02470640
ERROR63 EQU * AN ERROR IN "USE" ... @VA07500 02470650
LA R0,RC12 VALUE OF 12 INDICATES A USE ERROR@VA07500 02470660
B SVC63X GO RETURN SAME TO CALLER & EXIT. @VA07500 02470670
DROP R10 @VA07500 02470680
EJECT 02470690
SPACE 2 02471000
* NOTE: NO MORE CODE BEYOND THIS POINT PLEASE. 02472000
EJECT 02473000
LTORG *** HERE ENDETH DMSDOS *** @V305132 02474000
ENTRY DOS$END *** SHOW END OF DMSDOS CODE *** @V305132 02475000
DOS$END DS 0C *** ENDOF DMSDOS CODE BEF "ORG" @V305132 02476000
SPACE 02477000
EJECT 02478000
NUCON @V305132 02479000
CMSAVE @V305132 02480000
BGCOM @V305132 02481000
SYSCOM @V305132 02482000
PIBTAB @V305132 02483000
DOSAVE @V305132 02484000
SPACE 2 02485000
SVUARA DSECT USER SAVE AREA @V305132 02486000
SVUPSW DS F FIRST HALF PSW @V305132 02487000
SVUPSW2 DS F SECOND HALF PSW @V305132 02488000
SVUR00 DS 9F REGISTERS 0-8 @V305132 02489000
SVUR09 DS 7F REGISTERS 9-15 @V305132 02490000
EJECT 02491000
FCHTAB @V305132 02492000
REGEQU @V305132 02493000
ANCHTAB @V305132 02494000
SPACE 02495000
SYSNAMES @V305132 02496000
FVS @VA05918 02497000
END 02498000