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