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