SLN      TITLE 'DMSSLN     (CMS)       VM/370 - RELEASE 6'              00001000
         SPACE 2                                                        00002000
*.                                                                      00003000
* MODULE NAME                                                           00004000
*                                                                       00005000
*        DMSSLN                                                         00006000
*                                                                       00007000
* FUNCTION                                                              00008000
*                                                                       00009000
*        HANDLE OS CONTENTS MANAGEMENT REQUESTS ISSUED                  00010000
*        UNDER CMS. (LINK, LOAD, XCTL, DELETE, ATTACH,EXIT)             00011000
*                                                                       00012000
* ATTRIBUTES                                                            00013000
*                                                                       00014000
*        REENTRANT, SEGMENT RESIDENT                                    00015000
*                                                                       00016000
* ENTRY POINTS                                                          00017000
*                                                                       00018000
*        DMSSLN7 - XCTL - R15 POINTS TO ADDRESS OF REQUESTED            00019000
*             PHASE NAME                                                00020000
*        DMSSLN6 - LINK - SAME AS DMSSLN7                               00021000
*        DMSSLN42 - ATTACH - R15 POINTS TO ATTACH PARAMETER LIS         00022000
*        DMSSLN8 - LOAD - R0 POINTS TO PHASE NAME                       00023000
*        DMSSLN9 - DELETE - R0 POINTS TO PHASE NAME                     00024000
*        DMSSLN3 - EXIT - NO ENTRY CONDITIONS                           00025000
*        DMSSLNAB - ABEND RECOVERY - R14 RETURN ADDRESS                 00026000
*        ALL ENTRY POINTS - R15 CONTAINS ADDRESSIBILITY                 00027000
*                                                                       00028000
* ENTRY CONDITIONS                                                      00029000
*                                                                       00030000
*        SEE ENTRY POINTS                                               00031000
*                                                                       00032000
* EXIT CONDITIONS                                                       00033000
*                                                                       00034000
*        NORMAL                                                         00035000
*        RETURN TO DMSITS TO:                                           00036000
*        1) CONTINUE PROCESSING WITH CALLED PHASE OR END                00037000
*        OF TASK EXIT (LINK, XCTL, ATTACH)                              00038000
*        2) RETURN TO CALLER - EXIT FROM CALLED PHASE                   00039000
*        3) RETURN TO CALLER WITH LOADED PHASE ADDRESS IN               00040000
*        REGISTER ZERO (LOAD)                                           00041000
*        4) RETURN TO CALLER WITH ZERO IN REGISTER 15 FOR               00042000
*        SUCCESSFUL DELETE                                              00043000
*                                                                       00044000
*        ERROR                                                          00045000
*        1) RETURN TO CALLER WITH 4 IN REGISTER 15 FOR                  00046000
*        PHASE NOT FOUND - DELETE                                       00047000
*        2) ABEND X'155' LOADMOD ERROR (LINK, LOAD, XCTL,               00048000
*        ATTACH)                                                        00049000
*        3) ABEND X'15A' - CMS LOADER ERROR (>4) OR ENTRY               00050000
*        LOCATION NOT DETERMINEABLE                                     00051000
*                                                                       00052000
* CALLS TO OTHER ROUTINES                                               00053000
*                                                                       00054000
*        DMSMOD, DMSLDRB                                                00055000
*                                                                       00056000
* EXTERNAL REFERENCES                                                   00057000
*                                                                       00058000
*        NUCON, SVCSECT, PGMSECT, DCB,                                  00059000
*        CALLER'S SAVE AREA + 12 (LINK, LOAD, XCTL,                     00060000
*        ATTACH) IF COMPILER SWITCH IS OFF                              00061000
*                                                                       00062000
* TABLES/WORKAREAS                                                      00063000
*                                                                       00064000
*        REQUEST BLOCK                                                  00065000
*                                                                       00066000
* REGISTER USAGE                                                        00067000
*                                                                       00068000
*        R7  REQUEST BLOCK ADDRESS                                      00069000
*        R12 BASE REGISTER                                              00070000
*        R13 CMS SVC SAVE AREA ADDRESS                                  00071000
*        WORK 0-5,8-11,14,15                                            00072000
*        UNUSED 6                                                       00073000
*                                                                       00074000
* OPERATION                                                             00075000
*                                                                       00076000
*        DMSSLN7 - XCTL                                                 00077000
*        1. IF XCTL IS FROM NON-DYNAMICALLY LOADED                      00078000
*        PHASE GO TO DMSSLN6 STEP 2 (BELOW)                             00079000
*        2. RELEASE STORAGE OCCUPIED BY CURRENT PHASE (LATEST           00080000
*        RB ON LINK CHAIN DEFINES STORAGE AREA)                         00081000
*        3. GO TO DYNAMIC (BELOW)                                       00082000
*                                                                       00083000
*        DMSSLN6 - LINK                                                 00084000
*                                                                       00085000
*        1. CALL RESIDENT (BELOW) TO CHECK FOR LINK TO CMS              00086000
*        RESIDENT FUNCTION.                                             00087000
*        2. ISSUE GETMAIN FOR A NEW REQUEST BLOCK                       00088000
*        3. IF ATTACH REQUEST SAVE ATTACHER'S R13 AND R15               00089000
*        IN THE RB.  POINT R13 TO RB SAVE AREA FOR ATTACHEE             00090000
*        4. IF THIS IS A LOAD REQUEST GO TO STEP 7                      00091000
*        5. CHAIN THIS RB AS LATEST ON LINK CHAIN.  SAVE                00092000
*        RESUME PSW IN RB.                                              00093000
*        6. IF COMPILER SWITCH IS ON GO TO LODMOD (BELOW),              00094000
*        OTHERWISE, GO TO DYNAMIC (BELOW).                              00095000
*        7. CHAIN THIS RB ON LOAD LIST. SET ZERO USE COUNT              00096000
*        GO TO DYNAMIC STEP 2 (BELOW).                                  00097000
*                                                                       00098000
*        DMSSLN42 - ATTACH                                              00099000
*                                                                       00100000
*        1. ISSUE STAE MACRO IF STAI EXIT IS REQUESTED BY               00101000
*        ATTACHER.                                                      00102000
*        2. GO TO DMSSLN6 (ABOVE).                                      00103000
*                                                                       00104000
*        DMSSLN8 - LOAD                                                 00105000
*                                                                       00106000
*        1. IF REQUESTED PHASE IS ON LOAD RB CHAIN GO TO                00107000
*        DYNAMIC STEP 6 (BELOW).                                        00108000
*        STEP 2 (ABOVE).                                                00109000
*        3. IF COMPILER SWITCH IS ON GO TO LODMOD                       00110000
*        STEP 2 (BELOW; OTHERWISE GO TO DMSSLN6 STEP 2                  00111000
*        (ABOVE).                                                       00112000
*                                                                       00113000
*        DMSSLN9 - DELETE                                               00114000
*                                                                       00115000
*        1. IF COMPILER SWITCH IS ON RETURN TO DMSITS.                  00116000
*        2. IF REQUESTED PHASE IS NOT ON LOAD RB CHAIN SET              00117000
*        RETURN CODE 4 IN R15. AND RETURN TO DMSITS.                    00118000
*        3. DECREMENT USE COUNT BY ONE. IF USE COUNT IS NOT             00119000
*        ZERO RETURN TO DMSITS.                                         00120000
*        4. RELEASE PHASE STORAGE AREA, UNCHAIN AND FREEMAIN            00121000
*        LOAD REQUEST BLOCK. ZERO R15 AND RETURN TO DMSITS.             00122000
*                                                                       00123000
*        DMSSLN3 - EXIT FROM CALLED PHASE                               00124000
*                                                                       00125000
*        1. IF NOT RETURN FROM SUBTASK (ATTACH) GO TO STEP 3.           00126000
*        2. POST ECB, EXECUTE END OF TASK EXIT ROUTINE IF ONE           00127000
*        WAS REQUESTED.                                                 00128000
*        3. RELEASE PHASE STORAGE, UNCHAIN AND FREE LATEST RB O         00129000
*        LINK RB CHAIN. RESTORE REGISTERS IF RETURN FROM SUBTAS         00130000
*        RETURN TO DMSITS.                                              00131000
*                                                                       00132000
*        DYNAMIC - CALL CMS LOADER                                      00133000
*                                                                       00134000
*        1. IF REQUESTED PHASE IS ON LOAD REQUEST BLOCK CHAIN           00135000
*        GO TO STEP 6.                                                  00136000
*        2. SET PHASE NAME IN RB. ISSUE CONDITIONAL GETMAIN FOR         00137000
*        AN AREA TO LOAD REQUESTED PHASE INTO. SET LOCATION             00138000
*        COUNTER TO PHASE AREA.  CALL DMSLDRB TO INCLUDE PHASE.         00139000
*        3. IF DMSLDR RETURNS AN ERROR CODE >4 ISSUE ABEND              00140000
*        X'15A'. OTHERWISE RESET LOADER TABLE COUNT TO PRE-INCL         00141000
*        COUNT.                                                         00142000
*        4. RELEASE EXCESS PHASE STORAGE.                               00143000
*        5. DETERMINE PHASE ENTRY POINT:                                00144000
*         A.USE STRTADDR VALUE IN NUCON IF COMPILER SWITCH IS O         00145000
*         B.USE STRTADDR IF PHASE NAME OCCURED AS A MEMBER NAME         00146000
*           IN A CMS TXTLIB (OS FORM - REF. TXTLIB COMMAND).            00147000
*         C.USE ALIASENT IN NUCON IF PHASE NAME OCCURED IN LOAD         00148000
*           CSECTS BUT WAS NOT THE TXTLIB MEMBER NAME (REAL ALI         00149000
*         D.USE STRTADDR FOR ALL OTHER CASES (SYMBOLIC ALIAS).          00150000
*                                                                       00151000
*        6. RESET DYNAMIC FLAGS.                                        00152000
*        7. IF THIS IS A LOAD REQUEST GO TO STEP 9.                     00153000
*        8. SET PHASE ENTRY ADDRESS IN CMS OLD PSW AND R15, SET         00154000
*        THAT CALLED PHASE WILL RETURN TO AN SVC 3 INSTRUCTION.         00155000
*        RETURN TO DMSITS WHICH WILL TRANSFER TO CALLED PHASE.          00156000
*        9. IF COMPILER SWITCH IS OFF INCREASE USE COUNT IN RB          00157000
*        ONE AND SAVE ENTRY LOCATION IN LOAD RB.                        00158000
*        10. SET R0 TO ENTRY LOCATION. RETURN TO DMSITS.                00159000
*        THE ENTRY ADDR. IS FROM THE LOAD RB IF PHASE WAS ALREA         00160000
*        IN STORAGE.                                                    00161000
*                                                                       00162000
*        LODMOD - LOADMOD A PHASE                                       00163000
*                                                                       00164000
*        1. SAVE REQUESTED NAME IN RB. IF REQUESTED NAME IS             00165000
*        ON LOAD RB CHAIN GO TO DYNAMIC STEP 6 (ABOVE).                 00166000
*        2. CALL DMSMOD TO BRING IN REQUESTED PHASE AS A CMS MO         00167000
*        IF DMSMOD RETURNS NON ZERO RETURN CODE ISSUE ABEND X'1         00168000
*        3. GO TO DYNAMIC STEP 5 (ABOVE).                               00169000
*                                                                       00170000
*        RESIDENT                                                       00171000
*                                                                       00172000
*        CHECK REQUESTED PHASE NAME AGAINST CMS RESIDENT LIST           00173000
*        (IECQBFG1 IS ONLY ENTRY). IF EQUAL GO TO RESIDENT ROUT         00174000
*        OTHERWISE RETURN TO INTERNAL CALLER.                           00175000
*                                                                       00176000
*        DMSSLNAB - ABEND RECOVERY                                      00177000
*                                                                       00178000
*        ENTERED WHEN AN ABEND (SVC 13) OCCURS IN CMS. DMSSLNAB         00179000
*        RELEASES THE LOAD AND LINK REQUEST BLOCK CHAINS BY             00180000
*        ZEROING THEIR RESPECTIVE ANCHORS IN NUCON. RETURN              00181000
*        TO DMSABN.                                                     00182000
*.                                                                      00183000
         EJECT                                                          00184000
DMSSLN7  START                                               , @V305665 00185000
         ENTRY DMSSLN                                          @V305665 00186000
         ENTRY DMSSLN3,DMSSLN6,DMSSLN7,DMSSLN8                 @V1D1705 00187000
         ENTRY DMSSLN9,DMSSLN42                                @V1D1705 00188000
         USING NUCON,XR0                                       @V1D1705 00189000
         USING SVCSECT,XRB                                     @V1D1705 00190000
         USING SSAVE,XRD                                       @V1D1705 00191000
*   TRANSFER CONTROL - XCTL, SVC 7                                      00192000
         SPACE 1                                                        00193000
DMSSLN   EQU   *                                               @V305665 00194000
         USING DMSSLN7,XRC                                     @V1D1705 00195000
         BAL   XRA,LODREG     SET REGS 7 13                    @V1D1705 00196000
         LTR   XR7,XR7        XCTL FROM DYNAMICALLY LOADED PHAS@V1D1705 00197000
         BZ    LINK1          NO, TREAT XCTL AS LINK           @V1D1705 00198000
         LA    XRA,LINK1A     SET LINKAGE                      @V1D1705 00199000
         B     DEL6           FREE OLD PHASE AREA              @V1D1705 00200000
         EJECT                                                          00201000
         SPACE 1                                                        00202000
         USING *,12                                            @V1D1705 00203000
DMSSLN42 EQU   *                                               @V1D1705 00204000
         TM    8(XRF),X'01'   WAS STAI EXIT REQUESTED          @V1D1705 00205000
         BNO   DMSSLN6        NO                               @V1D1705 00206000
         L     XR4,40(XRF)    GET STAE PARM ADDR               @V1D1705 00207000
         L     XR5,44(XRF)    GET STAE EXIT ADDR               @V1D1705 00208000
         LR    XR1,XRD        SET PARAM REG                    @V1D1705 00209000
         STAE  (XR5),CT,PARAM=(XR4),MF=(E,(1))                 @V1D1705 00210000
         L     XRA,APGMSECT   SET STAI FLG IN SCB              @V1D1705 00211000
         USING PGMSECT,XRA                                     @V1D1705 00212000
         L     XRA,SCBPTR     PTR TO CURRENT SCB               @V1D1705 00213000
         DROP  XRA                                             @V1D1705 00214000
         OI    12(XRA),X'20'  INDICATE SCB FOR STAI            @V1D1705 00215000
         EJECT                                                          00216000
*    LINK - SVC 6                                                       00217000
         SPACE 1                                                        00218000
DMSSLN6  BALR  XRC,0                                           @V1D1705 00219000
         USING *,XRC                                           @V1D1705 00220000
         L     XRC,BASED          COMMON CAUSE                 @V1D1705 00221000
         USING DMSSLN7,XRC                                     @V1D1705 00222000
         BAL   10,RESIDENT    CHECK FOR RESIDENT ROUTINE       @V1D1705 00223000
         BAL   10,LODREG      SET REGS BY CONVENTION           @V1D1705 00224000
         USING LINKBLK,XR1    LINKBLK DSECT                    @V1D1705 00225000
LINK1    LA    XR0,SAVLEN/8   GET  LINK BLOCK                  @V1D1705 00226000
         DMSFREE DWORDS=(0),TYPCALL=BALR                       @V1D1705 00227000
         CLI   OLDPSW+3,42    IS THIS ATTACH                   @V1D1705 00228000
         BNE   LINK11         BRANCH IF NOT                    @V1D1705 00229000
         MVC   SAVR15(4),EGPR15    SAVE PARAMETER REG          @V1D1705 00230000
         MVC   SAVR13(4),EGPR13    SAVE ATTACHER'S R13         @V1D1705 00231000
         LA    XR0,SVAREA     POINT TO NEW SAVE AREA FOR ATTACH@V1D1705 00232000
         ST    XR0,EGPR13                                      @V1D1705 00233000
         B     LINKA          JOIN BELOW                       @V1D1705 00234000
LINK11   CLI   OLDPSW+3,SLOAD SVC 08                           @V1D1705 00235000
         BE    LOAD5          BRANCH IF YES                    @V1D1705 00236000
LINKA    ST    XR7,LINKPTR    CHAIN NEW AREA AHEAD OF OTHERS   @V1D1705 00237000
         LR    XR7,XR1                                         @V1D1705 00238000
         ST    XR7,LINKLAST                                    @V1D1705 00239000
         XC    LINKBYTE(4),LINKBYTE     CLEAR SIZE FIELD       @V1D1705 00240000
         DROP  XR1                                             @V1D1705 00241000
         USING LINKBLK,XR7        USE LINKBLK DSECT            @V1D1705 00242000
         MVC   SAVPSW(8),OLDPSW SAVE OLD SVC PSW               @V1D1705 00243000
LINK1A   L     XRF,EGPR15      GET A(PHASE NAME)               @V1D1705 00244000
         L     XRF,0(,XRF)                                     @V1D1705 00245000
         TM    OSSFLAGS,COMPSWT    MODULES                     @V1D1705 00246000
         BO    LODMOD         CMS LOADMOD                      @V1D1705 00247000
         B     DYNAMIC            GO DYNAMICALLY LINK          @V1D1705 00248000
LINK2    EQU   *                  RETURN FROM DYNAMIC LOAD OF T@V1D1705 00249000
         ST    XR0,OLDPSW+4     SET PSW TO ENTRY POINT         @V1D1705 00250000
         ST    XR0,EGPR15      SET ENTRY POINT IN R15          @V1D1705 00251000
LINK3    LA    XRE,EXIT       SET RETURN ADDRESS               @V1D1705 00252000
         CLI   OLDPSW+3,07    WAS THIS A TRANSFER CONTROL?     @VA05460 00253000
         BE    TRANS1         YES, SPECIAL CONSIDERATION       @VA05460 00254000
         ST    XRE,EGPR14     FOR CALLEE                       @V1D1705 00255000
TRANS1   EQU   *                                               @VA05460 00256000
         L     XRE,OSTEMP     RETURN TO SVC HANDLER            @V1D1705 00257000
         BR    XRE                                             @V1D1705 00258000
LOAD5    L     XRF,EGPR0      GET REQUESTED PHASE NAME         @V1D1705 00259000
         LPR   XRF,XRF        IN CASE DE TYPE                  @V1D1705 00260000
         L     XR7,LINKSTRT   CHAIN NEW BLOCK TO LOAD LIST     @V1D1705 00261000
         ST    XR1,LINKSTRT   AT THE TOP OF THE LIST           @V1D1705 00262000
         ST    XR7,0(XR1)                                      @V1D1705 00263000
         LR    XR7,XR1        R7 HAS LINK BLOCK ADDR           @V1D1705 00264000
         MVI   LINKCNT,X'00'  CLEAR USE COUNT                  @V1D1705 00265000
         XC    LINKBYTE,LINKBYTE  CLEAR SIZE FIELD             @VA04980 00266000
         B     DYNAMIC1       FETCH PHASE                      @V1D1705 00267000
         EJECT                                                          00268000
*   EXIT MACRO EXIT, SVC 3                                              00269000
EXIT     SVC   3              COME HERE ON RETURN MACRO        @V1D1705 00270000
         SPACE 3                                                        00271000
*   RETURN FROM LINKED-TO PHASE - RETURN, SVC 3                         00272000
         SPACE 1                                                        00273000
         USING *,12                                            @V1D1705 00274000
DMSSLN3  L     XRC,BASED          COMMON ADDRESSABILITY        @V1D1705 00275000
         USING DMSSLN7,XRC                                     @V1D1705 00276000
         BAL   10,LODREG      SET REGS BY CONVENTION           @V1D1705 00277000
         CLI   SAVPSW+3,42        WAS THIS AN ATTACH SVC       @V1D1705 00278000
         BNE   RETURN3        NO, SKIP ATTACH EXIT CODE        @V1D1705 00279000
         L     XR1,SAVR15         GET ADDR OF ATTACH PARM LIST @V1D1705 00280000
         LA    XR1,0(0,XR1)   CLEAR HI BYTE                    @V1D1705 00281000
         LTR   XR1,XR1            IS THIS SECOND TIME THROUGH  @V1D1705 00282000
         BZ    RETURN3        YES, RETURN                      @V1D1705 00283000
         XC    SAVR15(4),SAVR15   SET SWITCH FOR 2ND TIME THROU@V1D1705 00284000
         L     XRA,8(XR1)         GET ECB ADDR                 @V1D1705 00285000
         LA    XRA,0(0,XRA)   CLEAR HI BYTE                    @V1D1705 00286000
         LTR   XRA,XRA            IS IT ZERO                   @V1D1705 00287000
         BZ    CKEXIT             YES, CONTINUE                @V1D1705 00288000
         MVC   0(4,XRA),EGPR15  FILL IN RETURN CODE            @V1D1705 00289000
         MVI   0(XRA),X'40'       FILL IN COMPLETION BIT       @V1D1705 00290000
CKEXIT   L     XRA,20(XR1)        GET ADDR OF EXIT ROUTINE     @V1D1705 00291000
         LA    XRA,0(0,XRA)   CLEAR HI BYTE                    @V1D1705 00292000
         LTR   XRA,XRA            IS THERE AN EXIT RTN. SPECIFI@V1D1705 00293000
         BZ    RETURN3        NO, RETURN                       @V1D1705 00294000
         XC    EGPR1,EGPR1 ZERO REG 1                          @V1D1705 00295000
         ST    XRA,EGPR15       SET ENTRY POINT IN REG 15      @V1D1705 00296000
         MVC   OLDPSW+5(3),21(XR1) SET OLDPSW TO EXIT ROUTINE  @V1D1705 00297000
         B     LINK3              RETURN TO SVC ROUTINE        @V1D1705 00298000
RETURN3  BAL   XRA,DEL6       RELEASE PHASE STORAGE            @V1D1705 00299000
         MVC   OLDPSW,SAVPSW RESTORE PSW FROM LAST LINK        @V1D1705 00300000
         LR    XR1,XR7        PREPARE TO FREE LATEST BLOCK ON C@V1D1705 00301000
         L     XR7,LINKPTR        GET SECOND MEMBER OF CHAIN   @V1D1705 00302000
         ST    7,LINKLAST                                      @V1D1705 00303000
         LA    XR0,SAVLEN/8   LINK/XCTL LINK BLOCK SIZE        @V1D1705 00304000
         CLI   OLDPSW+3,42    IS THIS ATTACH                   @V1D1705 00305000
         BNE   RETURN4        NO                               @V1D1705 00306000
         LA    XRF,SVAREA-LINKBLK(XR1)  GET ATTACHEE'S SAVE ARE@V1D1705 00307000
         MVC   EGPR0(52),20(XRF)   RESTORE REGS FOR ATTACHER   @V1D1705 00308000
         MVC   EGPR13(4),SAVR13-LINKBLK(XR1) RESTORE ATTACHER'S@V1D1705 00309000
RETURN4  DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR               @V1D1705 00310000
         B     DEL7A                                           @VA03007 00311000
         EJECT                                                          00312000
*   LOAD IN AN OBJECT DECK - LOAD, SVC 8                                00313000
         SPACE 1                                                        00314000
DMSSLN8  EQU   *                  LOAD A MODULE, SVC 8         @V1D1705 00315000
         USING DMSSLN8,12                                      @V1D1705 00316000
         L     XRC,BASED          COMMON ADDRESSABILITY        @V1D1705 00317000
         USING DMSSLN7,12                                      @V1D1705 00318000
         BAL   10,LODREG          SET REGS BY CONVENTION       @V1D1705 00319000
         L     15,EGPR0         GET A(PHASE NAME)              @V1D1705 00320000
         LPR   XRF,XRF        IN CASE OF DE TYPE               @V1D1705 00321000
         LA    XR8,LOAD2      IN CASE FOUND                    @V1D1705 00322000
         LA    XRA,LODMOD1    IN CASE NOT FOUND                @V1D1705 00323000
         TM    OSSFLAGS,COMPSWT    TEST FOR MODULE FORM        @V1D1705 00324000
         BO    SCAN           MODULES, LOOK FOR LRB            @V1D1705 00325000
         LA    XRA,LINK1      IN CASE NOT FOUND                @V1D1705 00326000
SCAN     L     XR0,LINKSTRT    GET LRB ANCHOR                  @V1D1705 00327000
LDLOOP   LTR   XR1,XR0        LAST LRB ?                       @V1D1705 00328000
         DROP  XR7                                             @V1D1705 00329000
         USING LINKBLK,XR1                                     @V1D1705 00330000
         BCR   8,XRA          BRANCH IF LAST                   @V1D1705 00331000
         CLC   LINKNAM(8),0(XRF)   IS THIS REQUESTED PHASE     @V1D1705 00332000
         L     XR0,LINKPTR    PTR TO NEXT LRB                  @V1D1705 00333000
         BNE   LDLOOP         NO, CHECK NEXT LRB               @V1D1705 00334000
         L     XR0,LINKENT    GET ENTRY LOCATION               @V1D1705 00335000
         LR    XR7,XR1        SET LINKBLK IN 7                 @V1D1705 00336000
         DROP  XR1                                             @V1D1705 00337000
         USING LINKBLK,XR7                                     @V1D1705 00338000
         BR    XR8            RETURN                           @V1D1705 00339000
         EJECT                                                          00340000
*                                                                       00341000
*   SET UP TO GO TO "LOADER" TO LOAD APPROPRIATE TEXT DECKS             00342000
*                                                                       00343000
DYNAMIC  LA    XR8,INCORE2    IN CASE FOUND IN CORE            @V1D1705 00344000
         BAL   XRA,SCAN       LOOK FOR PHASE IN CORE           @V1D1705 00345000
         USING DYNALIST,XR9                                    @V1D1705 00346000
DYNAMIC1 MVC   LINKNAM(8),0(XRF)   MOVE PHASE NAME TO LINK BLOC@V1D1705 00347000
         LH    XR0,TBENT          GET NUMBER OF TABLE ENTRIES  @VA04980 00348000
         LTR   XR0,XR0            HAS ANYTHING BEEN LOADED?    @VA04980 00349000
         BZ    DYNAMIC9           BRANCH IF NOT                @VA04980 00350000
         L     XR4,ALDRTBLS       GET LOADER TABLE ADDRESS     @VA04980 00351000
         LA    XR4,0(,XR4)        CLEAR HIGH BYTE              @VA04980 00352000
         LA    XR3,LDRENT         GET LENGTH OF TABLE ENTRY    @VA04980 00353000
         USING LDRSECT,XR4                                     @VA04980 00354000
DYNAMIC3 EQU   *                                               @VA04980 00355000
         SR    XR4,XR3            POINT TO NEXT LOADER ENTRY   @VA04980 00356000
         CLC   LINKNAM(8),LDRNAME IS THIS THE NAME?            @VA04980 00357000
         BE    DYNAMIC4           BRANCH IF YES                @VA04980 00358000
         BCT   XR0,DYNAMIC3       GO CHECK NEXT ENTRY          @VA04980 00359000
         B     DYNAMIC9           NAME IS NOT IN TABLE         @VA04980 00360000
DYNAMIC4 EQU   *                                               @VA04980 00361000
         L     XR0,LDRADD         GET START ADDRESS            @VA04980 00362000
         MVC   LINKAREA,LDRRELO   MOVE IN RELOCATION FACTOR    @VA04980 00363000
         B     INCORE2                                         @VA04980 00364000
         DROP  XR4                                             @VA04980 00365000
DYNAMIC9 EQU   *                                               @VA04980 00366000
         L     XR9,EGPR13     CALLER'S REG13                   @V1D1705 00367000
         MVC   LDNAME(8),0(XRF)    SET NAME                    @V1D1705 00368000
         LA    XR4,LOADLST+16     GETMAIN PARAM AREA           @V305665 00369000
         LA    XR3,LINKAREA   SET ANSWER AREA                  @V1D1705 00370000
         GETMAIN VU,LA=GETCONST,A=(XR3),MF=(E,(XR4))           @V1D1705 00371000
*                             FOR NEW PHASE                             00372000
         L     XR1,LINKAREA   ADDR OF GOTTEN AREA              @V1D1705 00373000
         ST    XR1,LOCCNT     SET LOCATION COUNTER             @V1D1705 00374000
         A     XR1,LINKBYTE   POINT TO END OF GOTTEN AREA      @V1D1705 00375000
         ST    XR1,DYNAEND    CHECKED BY DMSLDR                @V1D1705 00376000
         XC    ALIASENT(4),ALIASENT     CLEAR ENTRY LOCATION FO@V1D1705 00377000
         MVC   LOADLST+16(32),WLIST COMPLETE INCLUDE PLIST     @V305665 00378000
         LH    XRB,TBENT      REMEMBER LOADER TABLE COUNT      @V1D1705 00379000
         LA    XR1,LOADLST        SET PLIST                    @V305665 00380000
         LR    XRA,XR7        SAVE XR7                         @V1D1705 00381000
         L     XRF,=V(DMSOLD)     CALL LOADER                  @V305665 00382000
         BALR  XRE,XRF                                         @V1D1705 00383000
         USING *,XRE                                           @V1D1705 00384000
         L     XRC,BASED                                       @V1D1705 00385000
         DROP  XRE                                             @V1D1705 00386000
         L     XRD,CURRSAVE   RESTORE R13                      @V1D1705 00387000
         LR    XR7,XRA        RESTORE XR7                      @V1D1705 00388000
         CH    XRF,=H'4'      CHECK LOADER RETURN CODE         @V1D1705 00389000
         BH    DYNAERR        BRANCH IF YES                    @V1D1705 00390000
         STH   XRB,TBENT      RESTORE LOADER TBL COUNT         @V1D1705 00391000
         L     XR1,LOCCNT     ENDING LOAD LOCATION             @V1D1705 00392000
         LA    XR1,7(0,XR1)   ROUND TO DBL WD BDRY.            @V1D1705 00393000
         N     XR1,GETMASK                                     @V1D1705 00394000
         L     XR0,DYNAEND    END OF PHASE AREA                @V1D1705 00395000
         SR    XR0,XR1        REMAING UNUSED STOR.             @V1D1705 00396000
         BZ    LOAD3A         BRANCH IF ZERO                   @V1D1705 00397000
         FREEMAIN R,LV=(XR0),A=(XR1)    RELEASE IT             @V1D1705 00398000
LOAD3A   L     XRF,LINKBYTE   LENGTH OF GOTTEN AREA            @V1D1705 00399000
         SR    XRF,XR0        MINUS AM'T JUST FREED            @V1D1705 00400000
         ST    XRF,LINKBYTE   AM'T STILL LEFT                  @V1D1705 00401000
         TM    OSSFLAGS,DYMBRNM    WAS A MEMBER CALLED BY ITS N@V1D1705 00402000
         BO    DEFENT         YES, USE DEFAULT ENTRY ADDRESS   @V1D1705 00403000
         TM    OSSFLAGS,DYLIBO     WAS ENTRY POINT FOUND IN PHA@V1D1705 00404000
         BNO   DEFENT         NO, USE DEFAULT                  @V1D1705 00405000
         L     XR0,ALIASENT   GET ENTRY NAME LOCATION          @V1D1705 00406000
         B     INCORE2        CONTINUE                         @V1D1705 00407000
DEFENT   L     XR0,STRTADDR   DEFAULT ENTRY LOCATION           @V1D1705 00408000
         LTR   XR0,XR0        WAS ENTRY POINT SET              @V1D1705 00409000
         BZ    DYNAERR        NO, ERROR                        @V1D1705 00410000
INCORE2  NI    OSSFLAGS,255-DYLD-DYLIBO-DYMBRNM                @V1D1705 00411000
*              RESET DYNAMIC FLAGS                                      00412000
         CLI   OLDPSW+3,SLOAD SVC 8 ?                          @V1D1705 00413000
         BE    LOAD2              YES.                         @V1D1705 00414000
         B     LINK2          ALL OTHER SVC'S                  @V1D1705 00415000
DYNAERR  ABEND 346            ERROR FROM DMSLDR                @V1D1705 00416000
LOAD2    TM    OSSFLAGS,COMPSWT    MODULES                     @V1D1705 00417000
         BO    LOAD3          YES, SKIP USE COUNT CODE         @V1D1705 00418000
         IC    XRE,LINKCNT    GET USE COUNT                    @V1D1705 00419000
         LA    XRE,1(0,XRE)   INCREASE IT                      @V1D1705 00420000
         STC   XRE,LINKCNT    SAVE IT                          @V1D1705 00421000
         ST    XR0,LINKENT    SET ENTRY ADDRESS IN LOAD BLOCK  @V1D1705 00422000
LOAD3    ST    XR0,EGPR0      SET ANSWER REG                   @V1D1705 00423000
         L     XRE,OSTEMP                                      @V1D1705 00424000
         BR    14                 RETURN TO SVCINT             @V1D1705 00425000
         SPACE 1                                                        00426000
         EJECT                                                          00427000
*   RELEASE A LOAD MODULE - DELETE, SVC 9                               00428000
DMSSLN9  EQU   *                  DELETE A PHASE, SVC 9        @V1D1705 00429000
         USING DMSSLN9,12          SET TEMPORARY ADDRESSABLIITY@V1D1705 00430000
         L     XRC,BASED                                       @V1D1705 00431000
         USING DMSSLN7,12                                      @V1D1705 00432000
         BAL   XRA,LODREG                                      @V1D1705 00433000
         TM    OSSFLAGS,COMPSWT    CMS MODULES                 @V1D1705 00434000
         BO    DEL1           YES, DELETE TREATED AS NOP       @V1D1705 00435000
         L     XRF,EGPR0      SET R15 FOR SCAN                 @V1D1705 00436000
         LA    XRA,DELABEND   IN CASE NOT FOUND IN CORE        @V1D1705 00437000
         BAL   XR8,SCAN       LOOK FOR PHASE ON LOAD LIST      @V1D1705 00438000
         SR    XR8,XR8        CLEAR FOR IC                     @V1D1705 00439000
         IC    XR8,LINKCNT    GET USE COUNT                    @V1D1705 00440000
         BCT   XR8,DEL5       DECREMENT, BRANCH IF NOT ZERO    @V1D1705 00441000
         LA    XRA,DEL2                                        @V1D1705 00442000
DEL6     L     XR0,LINKBYTE   LENGTH OF PHASE AREA             @V1D1705 00443000
         LTR   XR0,XR0        DOES PHASE OCCUPY STOR.          @V1D1705 00444000
         BCR   8,XRA          RETURN IF NOT                    @V1D1705 00445000
         L     XR1,LINKAREA   ADDR OF PHASE AREA               @V1D1705 00446000
         FREEMAIN R,LV=(0),A=(1)   RETURN STORAGE              @V1D1705 00447000
         BR    XRA                RETURN TO CALLING SECTION    @V1D1705 00448000
DEL2     LA    XR3,LINKSTRT   FIND PREVIOUS LRB                @V1D1705 00449000
DEL4     C     XR7,0(XR3)     THIS LRB POINT TO CURRENT LRB    @V1D1705 00450000
         BE    DEL3           YES, FOUND IT                    @V1D1705 00451000
         L     XR3,0(XR3)     NEXT LRB ON CHAIN                @V1D1705 00452000
         B     DEL4                                            @V1D1705 00453000
DEL3     LR    XR1,XR7                                         @V1D1705 00454000
         L     XR7,LINKPTR    NEXT LRB                         @V1D1705 00455000
         LA    XR0,SAVLEN/8   FREE LOAD BLOCK                  @V1D1705 00456000
         DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR               @V1D1705 00457000
         ST    XR7,0(XR3)     RECONNECT CHAIN                  @V1D1705 00458000
DEL1     EQU   *                                               @V1D1705 00459000
         SR    XRF,XRF        CLEAR ERROR CODE                 @V1D1705 00460000
DEL7     ST    XRF,EGPR15     SET RETURN CODE FOR USER         @VA02371 00461000
DEL7A    DS    0H                                              @VA03007 00462000
         NI    OSSFLAGS,255-DYLD-DYLIBO-DYMBRNM CLEAR DYMAMIC  @VA02371 00463000
         L     XRE,OSTEMP                                      @V1D1705 00464000
         BR    14                 RETURN TO SVC                @V1D1705 00465000
DEL5     STC   XR8,LINKCNT    SET USE COUNT                    @V1D1705 00466000
         B     DEL1           RETURN                           @V1D1705 00467000
DELABEND LA    XRF,4          SET DELETE RETURN CODE           @V1D1705 00468000
         B     DEL7           EXIT                             @V1D1705 00469000
         EJECT                                                          00470000
*                                                                       00471000
*   INITIALIZE PROGRAM REGISTERS                                        00472000
*                                                                       00473000
LODREG   OI    OSSFLAGS,DYLD+OSRESET    SET FLAGS              @V1D1705 00474000
         L     XR7,LINKLAST       V(LAST LINKAGE CHAIN BLOCK)  @V1D1705 00475000
         L     XRD,CURRSAVE            POINT TO SYSTEM SAVE ARE@V1D1705 00476000
         ST    XRE,OSTEMP    SAVE RETURN REG                   @V1D1705 00477000
         BR    10                                              @V1D1705 00478000
         SPACE 3                                                        00479000
         SPACE 3                                                        00480000
         EJECT                                                          00481000
*                                                                       00482000
*   EXECUTE CMS LOADMOD OF A MODULE PHASE                               00483000
*                                                                       00484000
LODMOD   MVC   LINKNAM(8),0(XRF)   PHASE NAME TO LINK BLOCK    @V1D1705 00485000
         LA    XR8,INCORE2    IN CASE FOUND                    @V1D1705 00486000
         BAL   XRA,SCAN       LOOK FOR PHASE ON LOAD RB CHAIN  @V1D1705 00487000
LODMOD1  L     XRB,ASVCSECT                                    @V1D1705 00488000
         MVC   DUMCOM(8),0(XRF)   MOVE PHASE NAME TO LOAD PLIST@V1D1705 00489000
         LA    XR1,MODLIST                                     @V1D1705 00490000
         L     XRD,USAVEPTR   SAVE AREA FOR DMSMOD             @V1D1705 00491000
         USING FREEST,XRD                                      @V305665 00492000
         L     XRA,AFVS           ADDR. OF FVSECT              @V305665 00493000
         USING FVSECT,XRA                                      @V305665 00494000
         MVC   DSKLIN(44),DSKLIS  MOVE PARAMETER LIST          @V305665 00495000
         MVC   DSKLIN+8(8),8(XR1) MOVE MODULE NAME TO PLIST    @V305665 00496000
         LA    XR1,DSKLIN         SET PLIST REGISTER           @V305665 00497000
         SR    XR9,XR9        AVOID POSSIBLE FRET ERROR        @VA06348 00498000
         L     XRF,ASTATE         CHECK FOR FILE               @V305665 00499000
         BALR  XRE,XRF                                         @V305665 00500000
         BNZ   LMODSTER           STATE ERROR                  @V305665 00501000
         L     XR1,28(,XR1)       GET A(FST COPY)              @V305665 00502000
         MVC   DSKLIN+24(2),24(XR1) SET MODE IN PLIST          @V305665 00503000
         LA    XR0,TEN            GET AN INPUT BUFFER          @V305066 00504000
         DMSFREE DWORDS=(0),TYPCALL=BALR                       @V305665 00505000
         LR    XR9,XR1            USE R9 AS BUFFER ADDR        @V305665 00506000
         ST    XR9,DSKLIN+28      SET IN PLIST                 @V305665 00507000
         LA    XR1,DSKLIN         ADDR OF READ PLIST           @V305665 00508000
         L     XRF,ARDBUF         READ FIRST RECORD            @V305665 00509000
         BALR  XRE,XRF                                         @V305665 00510000
         BNZ   ERR104S            ERROR                        @V305665 00511000
         L     XR6,0(XR9)         GET STARTING ADDR OF MOD     @V305665 00512000
         LM    XR3,XR4,4(XR9)     GET 1ST AND LAST LOCATIONS   @V305665 00513000
         TM    SUBFLAG,SUBACT     IS IT ACTIVE?                @V305665 00514000
         BZ    SUBOK              BRANCH IF NOT                @V305665 00515000
         C     XR3,AUSRAREA       COMPARE LOAD LOC WITH USER   @V305665 00516000
         BL    SUBOK              OK IF LOADING BELOW USER     @V305665 00517000
         LA    XRF,THIRTY2        WOULD OVERLAY VALID TEXT     @V305066 00518000
         B     EXITA                                           @V305665 00519000
LMODSTER EQU   *                                               @V305665 00520000
         CH    XRF,=H'28'         FILE NOT FOUND?              @V305665 00521000
         BE    ERR002E            BRANCH IF YES                @V305665 00522000
         B     EXITA                                           @V305665 00523000
SUBOK    EQU   *                                               @V305665 00524000
         CLM   XR3,LOW3,ADTRANS   PUT MODULE IN TRANS?         @V305665 00525000
         BNE   STR6               BRANCH IF NOT                @V305665 00526000
         MVC   LASTTMOD,DSKLIN+8  REMEMBER MODULE              @V305665 00527000
         ST    XR6,STRTADDR       SET STARTING ADDRESS         @VA14326 00527500
         B     LM34                                            @V305665 00528000
STR6     EQU   *                                               @V305665 00529000
         C     XR4,FREELOWE       WILL FREE STOR BE OVERLAID   @V305665 00530000
         BH    ERR109S            BRANCH IF YES                @V305665 00531000
         MVC   LASTLMOD,DSKLIN+8  REMEMBER MODULE              @V305665 00532000
         ST    XR6,STRTADDR       SET STARTING ADRESS          @V305665 00533000
         MVC   LOCCNT(4),LOCCNT-STRTADDR(XR9) SET LOCATIONS    @V305665 00534000
         LH    XR8,TBENT-STRTADDR(XR9) LDR TABLE COUNT         @V305665 00535000
         LTR   XR8,XR8            IS IT ZERO (NO MAP)?         @V305665 00536000
         BZ    NOCOUNT            BRANCH IF YES                @V305665 00537000
         STH   XR8,TBENT          SET NEW COUNT                @V305665 00538000
         SR    XR0,XR0            GET NUM OF LDRTBL PAGES      @V305665 00539000
         IC    XR0,ALDRTBLS       FROM LEFT-MOST BYTE          @V305665 00540000
         MH    XR0,=H'204'        X 204 (204 ENTRIES/PAGE)     @V305665 00541000
         CR    XR8,XR0                                         @V305665 00542000
         BH    ERR116S            REFERENCE TABLE OVERFLOW     @V305665 00543000
NOCOUNT  EQU   *                                               @V305665 00544000
         OI    LDRFLAGS,HEX04     SET NOERASE FOR LOAD MAP     @V305066 00545000
LM34     EQU   *                                               @V305665 00546000
         MVC   FRSTLOC(8),FRSTLOC-STRTADDR(XR9) SET LOCATIONS  @V305665 00547000
         L     XR5,F65535         MAX SIZE FOR RDBUF           @V305665 00548000
         SR    XR4,XR3            GET LENGTH OF TEXT           @V305665 00549000
RLOOP    EQU   *                                               @V305665 00550000
         STM   XR3,XR4,DSKLIN+28  ADDR AND LNTH IN PLIST       @V305665 00551000
         CR    XR4,XR5            TOO BIG FOR RDBUF?           @V305665 00552000
         BNH   OKR                BRANCH IF NOT                @V305665 00553000
         ST    XR5,DSKLIN+32      IF TOO BIG SUBSTITUTE MAX    @V305665 00554000
OKR      EQU   *                                               @V305665 00555000
         L     XRF,ARDBUF         READ IN SOME TEXT            @V305665 00556000
         BALR  XRE,XRF                                         @V305665 00557000
         BNZ   ERR104S            BRANCH IF ERROR              @V305665 00558000
         AR    XR3,XR5            INCREMENT STARTING ADDRESS   @V305665 00559000
         SR    XR4,XR5            REMAINING COUNT              @V305665 00560000
         BP    RLOOP              LOOP IF MORE                 @V305665 00561000
         LH    XR4,TBENT-STRTADDR(XR9) NUM OF LOADER TBL ENT   @V305665 00562000
         MH    XR4,=H'20'         MULTIPLY BY 20               @V305665 00563000
         LTR   XR4,XR4            ANY LOADER TABLES?           @V305665 00564000
         BZ    CHKSTR             BRANCH IF NOT                @V305665 00565000
         L     XR3,ALDRTBLS       TOP OF LOADER TABLES         @V305665 00566000
         LA    XR3,0(,XR3)        CLEAR HIGH BYTE              @V305665 00567000
         SR    XR3,XR4            GET STORAGE LOADER LOC       @V305665 00568000
         STM   XR3,XR4,DSKLIN+28  SET PLIST                    @V305665 00569000
         L     XRF,ARDBUF                                      @V305665 00570000
         BALR  XRE,XRF            READ IN LDR TABLES           @V305665 00571000
         N     XRF,=A(X'FFFFF7')  ALLOW ONLY 0 OR 8            @V305665 00572000
         BNZ   ERR104S            READ ERROR                   @V305665 00573000
CHKSTR   EQU   *                                               @V305665 00574000
         TM    LDRFLAGS+1-STRTADDR(XR9),X'80' STRINIT?         @V305665 00575000
         BNO   CHKSYS             BRANCH IF NOT                @V305665 00576000
         L     XRF,=V(DMSSMNSB)   STORAGE INIT. ROUTINE        @V305665 00577000
         BALR  XRE,XRF                                         @V305665 00578000
CHKSYS   EQU   *                                               @V305665 00579000
         L     XR3,4(XR9)         GET FIST LOCATION            @V305665 00580000
         CLM   XR3,LOW3,ADTRANS   TRANSIENT AREA?              @V305665 00581000
         LA    XR1,PRFUSYS        XR1 <- USER SYSTEM BIT       @V305665 00582000
         BNE   CHKSYSA            SKIP IF USER ROUTINE         @V305665 00583000
         LA    XR1,PRFTSYS        XR1 <- TRANSIENT SYSTEM BIT  @V305665 00584000
CHKSYSA  EQU   *                                               @V305665 00585000
         EX    XR1,CHKSYSO        TURN ON SYSTEM FLAG          @V305665 00586000
         TM    LDRFLAGS-STRTADDR(XR9),SYSTEM IS IT SYSTEM MOD? @V305665 00587000
         BO    FINMOD         SKIP IF SO                       @VA09429 00588000
         EX    XR1,CHKSYSX    IF NOT, RESET FLAG               @VA09429 00589000
         B     FINMOD                                          @V305665 00590000
CHKSYSO  OI    PROTFLAG,BINZERO   BIT FILLED IN BY EX          @V305066 00591000
CHKSYSX  XI    PROTFLAG,BINZERO   BIT FILLED IN BY EX          @V305066 00592000
FINMOD   EQU   *                                               @V305665 00593000
         LA    XR1,DSKLIN         PLIST FOR FINIS              @V305665 00594000
         L     XRF,AFINIS                                      @V305665 00595000
         BALR  XRE,XRF            FINIS FILE                   @V305665 00596000
         BNZ   ERR105S            BRANCH IF ERROR              @V305665 00597000
EXITA    EQU   *                                               @V305665 00598000
         LTR   XR1,XR9            WAS A BUFFER ACQUIRED?       @V305665 00599000
         BZ    EXIT1              BRANCH IF NOT                @V305665 00600000
         LR    XR5,XRF            PROTECT RETURN CODE          @V305665 00601000
         LA    XR0,TEN            SIZE OF BUFFER               @V305066 00602000
         DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR               @V305665 00603000
         LR    XRF,XR5            RESTORE RETURN CODE          @V305665 00604000
EXIT1    EQU   *                                               @V305665 00605000
         LR    XRE,XRB                                         @V305665 00606000
         LM    XR3,XR4,FRSTLOC    FIRST AND LAST LOCATIONS     @V305665 00607000
         L     XR7,LINKLAST   RESTORE SOME REGS                @V1D1705 00608000
         L     XRD,CURRSAVE                                    @V1D1705 00609000
         LTR   XRF,XRF        ANY ERRORS                       @V1D1705 00610000
         BZ    DEFENT         SET ENTRY POINT AND EXIT         @V1D1705 00611000
         ABEND 341            TERMINATE                        @V1D1705 00612000
         EJECT 1                                                        00613000
ERR002E  EQU   *                                               @V305665 00614000
         LA    XR2,DSKLIN+8       ADDR OF FILE NAME            @V305665 00615000
         DMSERR TEXT='FILE ........ MODULE NOT FOUND',         @V305665X00616000
               LET=E,NUM=2,SUB=(CHARA,(XR2))                   @V305665 00617000
         LA    XRF,TWENTY8        SET ERROR CODE               @V305066 00618000
         B     EXITA              AND RETURN                   @V305665 00619000
         SPACE 1                                                        00620000
ERR104S  EQU   *                                               @V305665 00621000
         LR    XR3,XRF            SAVE RETURN CODE             @V305665 00622000
         LA    XR2,DSKLIN+8       ADDR OF FILE NAME            @V305665 00623000
         DMSERR TEXT=('ERROR ''..'' READING FILE ',            @V305665X00624000
               '''....................'' FROM DISK'),          @V305665X00625000
               NUM=104,LET=S,MF=(E,MSG),                       @V305665X00626000
               SUB=(DEC,(XR3),CHAR8A,(XR2))                    @V305665 00627000
         LA    XRF,HUNDRED        SET RETURN CODE              @V305066 00628000
         B     EXITA              AND EXIT                     @V305665 00629000
         SPACE 1                                                        00630000
ERR105S  EQU   *                                               @V305665 00631000
         LR    XR3,XRF            SAVE RETURN CODE             @V305665 00632000
         LA    XR2,DSKLIN+8       ADDR OF FILE NAME            @V305665 00633000
         DMSERR TEXT=('ERROR ''..'' WRITING FILE ',            @V305665X00634000
               '''....................'' ON DISK'),            @V305665X00635000
               NUM=105,LET=S,MF=(E,MSG),                       @V305665X00636000
               SUB=(DEC,(XR3),CHAR8A,(XR2))                    @V305665 00637000
         LA    XRF,HUNDRED        SET RETURN CODE              @V305066 00638000
         B     EXITA              AND RETURN                   @V305665 00639000
         SPACE 1                                                        00640000
ERR109S  EQU   *                                               @V305665 00641000
         DMSERR TEXT='STORAGE EXCEEDED',LET=S,NUM=109          @V305665 00642000
         LA    XRF,HUNDRED4       SET ERROR CODE               @V305066 00643000
         B     EXITA              AND RETURN                   @V305665 00644000
         SPACE 1                                                        00645000
ERR116S  EQU   *                                               @V305665 00646000
         DMSERR TEXT='LOADER TABLE OVERFLOW',LET=S,NUM=116     @V305665 00647000
         LA    XRF,HUNDRED4       SET ERROR CODE               @V305066 00648000
         B     EXITA              AND RETURN                   @V305665 00649000
         EJECT                                                          00650000
XR0      EQU   0                                               @V1D1705 00651000
XR1      EQU  1                                                @V1D1705 00652000
XR2      EQU  2                                                @V1D1705 00653000
XR3      EQU  3                                                @V1D1705 00654000
XR4      EQU   4                                               @V1D1705 00655000
XR5      EQU   5                                               @V1D1705 00656000
XR6      EQU   6                                               @V1D1705 00657000
XR7      EQU  7                                                @V1D1705 00658000
XR8      EQU   8                                               @V1D1705 00659000
XR9      EQU  9                                                @V1D1705 00660000
XRA      EQU   10                                              @V1D1705 00661000
XRB      EQU  11                                               @V1D1705 00662000
XRC      EQU  12                                               @V1D1705 00663000
XRD      EQU  13                                               @V1D1705 00664000
XRE      EQU   14                                              @V1D1705 00665000
XRF      EQU  15                                               @V1D1705 00666000
         DROP  XRA                                             @V305665 00667000
         EJECT                                                          00668000
***************************************************************         00669000
*                                                                       00670000
*                            'RESIDENT'                                 00671000
* TESTS IF THE CALLED ROUTINE IS ELEMENT OF A 'CORE RESIDENT RO         00672000
*  LIST', IF SO BRANCHES TO IT.                                         00673000
*                                                                       00674000
***************************************************************         00675000
RESIDENT EQU    *                                              @V1D1705 00676000
         USING SSAVE,XRD                                       @V1D1705 00677000
         L     XRD,CURRSAVE            POINT TO SYSTEM SAVE ARE@V1D1705 00678000
         L     XRD,USAVEPTR            POINT TO USER SAVE AREA @V1D1705 00679000
         STM   XR8,XRB,0(XRD)          SAVE SOME REGS          @V1D1705 00680000
         L     XRD,CURRSAVE            POINT TO SYSTEM SAVE ARE@V1D1705 00681000
          LA   9,ROUTABLE      ORIGIN OF CORE RESIDENT ROUTINES@V1D1705 00682000
         LA    XRA,12             GET TABLE INCREMENT          @V1D1705 00683000
         LA    11,ROUTEND      END OF THE CORE RESIDENT ROUTINE@V1D1705 00684000
          SR   11,10                                           @V1D1705 00685000
         L     8,EGPR15     R8 POINTS TO THE NAME              @V1D1705 00686000
          L    8,0(,8)         OF THE CALLED ROUTINE           @V1D1705 00687000
SUIT01   CLC   0(8,9),0(8)                                     @V1D1705 00688000
          BE   SUIT02          THE CALLED ROUTINE IS ON THE LIS@V1D1705 00689000
          BXLE 9,10,SUIT01                                     @V1D1705 00690000
         L     XR8,USAVEPTR            POINT TO USER SAVE AREA @V1D1705 00691000
         LM    XR8,XRB,0(XR8)          RESTORE REGS            @V1D1705 00692000
         LA    XRD,EGPRS               REPOINT TO XRD TO EGPRS @V1D1705 00693000
         BR    10              PROBABLY ON DISK.               @V1D1705 00694000
*                                                                       00695000
SUIT02   LA    9,8(,9)                                         @V1D1705 00696000
         L     12,0(,9)       LOAD ROUTINE ADDRESS IN REGISTER @V1D1705 00697000
         LM    XR0,XR8,EGPRS                                   @V1D1705 00698000
         LA    XRD,EGPRS                                       @V1D1705 00699000
         BR    12                                              @V1D1705 00700000
*                                                                       00701000
* TRANSFERT WITH RETURN (TO SVCINT) IN R14,SAVE AREA(USED BY SV         00702000
* IN R13,BASE IN R12.R15 TO R11, THE CONTENTS THAT EXISTED BEFO         00703000
* THE OS SVC WAS EXECUTED.                                              00704000
* THE ROUTINE IS ENTERED WITH REGISTERS SET AS IF IT HAS BEEN C         00705000
* DIRECTLY VIA AN OS SVC INSTEAD OF BEING 'LINK-ED'.                    00706000
*                                                                       00707000
          EJECT                                                         00708000
***************************************************************         00709000
*                                                                       00710000
*                              GETPOOL OS MACRO INSTRUCTION             00711000
*                              ****************************             00712000
*GETPOOL ROUTINE IS ENTERED VIA AN LINK SVC WHEN USER ISSUES            00713000
* A GETPOOL MACRO.THE ROUTINE GETS CORE AND BUILD THE POOL              00714000
* OF BUFFERS.                                                           00715000
*ENTRY POINT BY LINK TO IECQBFG1                                        00716000
*INPUT REGISTER 13  USER SAVE AREA ADDRESS                              00717000
*      REGISTER 14  RETURN ADDRESS                                      00718000
*      REGISTER 12  IECQBFG1 FIRST LOCATION ADDRESS                     00719000
*      REGISTER 1  DCB ADDRESS FOR POOL ASSIGNMENT                      00720000
*              +22  NUMBER OF BUFFERS REQUESTED                         00721000
*              +24  LENGTH OF BUFFERS REQUESTED                         00722000
*OUTPUT NUMBER AND ADDRESS OF BUILT BUFFERS IN DCB BUFNO AND BU         00723000
* EXITS NORMAL RETURN ON REGISTER 14 TO CALLER. NUMBER AND ADDR         00724000
*  BUILT BUFFERS IN DCB BUFNO AND BUFCB                                 00725000
*EXITS ERRORS RETURN ON REGISTER 14 TO CALLER.NO BUFFERS BUILT.         00726000
*  FORCE OPEN TO BUILD BUFFERS SINCE USER SPECIFIED 0 BUFFER            00727000
*  NUMBER OR LENGTH                                                     00728000
*                                                                       00729000
***************************************************************         00730000
         USING IECQBFG1,12                                     @V1D1705 00731000
IECQBFG1 EQU   *                                               @V1D1705 00732000
         LPR   DCBR,BUFPTR        (R1 MIGHT BE COMPLEMENTED)   @V1D1705 00733000
         LH    BUFNOR,22(,DCBR)    PLACE NUMBER OF BUFFERS IN R@V1D1705 00734000
         LH    LBUFLR,24(,DCBR)    PLACE LENGTH OF BUFFERS IN R@V1D1705 00735000
         LTR   BUFNOR,BUFNOR  Q. ZERO NUMBER REQUESTED.        @V1D1705 00736000
         BZ    RETURNA        YES,RETURN                       @V1D1705 00737000
         LTR   LBUFLR,LBUFLR  Q. ZERO LENGTH REQUESTED.        @V1D1705 00738000
         BZ    RETURNA        YES, RETURN                      @V1D1705 00739000
         LA    LBUFLR,7(,LBUFLR)   ROUND LENGTH.               @V1D1705 00740000
         SRL   LBUFLR,3       TO   MULTIPLE                    @V1D1705 00741000
         SLL   LBUFLR,3       OF   EIGHT.                      @V1D1705 00742000
         LR    BUFPTR,LBUFLR  ROUNDED LENGTH TIMES             @V1D1705 00743000
         MR    BUFPAR,BUFNOR  NUMBER FOR TOTAL LENGTH          @V1D1705 00744000
         TM    32(DCBR),1     Q.FULL WORD ALIGNMENT SPECIFIED  @V1D1705 00745000
         BO    POOL1          YES                              @V1D1705 00746000
         LA    BUFPAR,8(,BUFPTR)   NO, ADD 8 TO LGN FOR BCB    @V1D1705 00747000
         B     POOL2                                           @V1D1705 00748000
POOL1    LA    BUFPAR,16(,BUFPTR)  YES, ADD 16 FOR BCB AND ALIG@V1D1705 00749000
POOL2    GETMAIN R,LV=(0)              OBTAIN CORE             @V1D1705 00750000
         ST    BUFPTR,20(,DCBR)    PLACE BUFCB IN DCB          @V1D1705 00751000
         STC   BUFNOR,20(,DCBR)    PLACE BUFNO IN DCB          @V1D1705 00752000
         TM    32(DCBR),1     Q. FULL WORD ALIGNMENT SPECIFIED @V1D1705 00753000
         BO    POOL3          YES                              @V1D1705 00754000
         LA    BUFPAR,8(,BUFPTR)   NO,DETERMINE BCB LINK ADDR  @V1D1705 00755000
         B     POOL4                                           @V1D1705 00756000
POOL3    LA    BUFPAR,12(,BUFPTR)  YES,LINK ADDR AROUND ALIGN P@V1D1705 00757000
POOL4    ST    BUFPAR,0(,BUFPTR)        PLACE LINK ADDR IN BCB @V1D1705 00758000
         STH   LBUFLR,6(,BUFPTR)   PLACE LENGTH IN BCB         @V1D1705 00759000
         STH   BUFNOR,4(,BUFPTR)   PLACE NUMBER IN BCB         @V1D1705 00760000
POOLLOOP LR    BUFPTR,BUFPAR  UPDATE BUFFER ADDRESS POINTER    @V1D1705 00761000
         BCT   BUFNOR,LOOP    Q.ALL BUFFERS BUILT              @V1D1705 00762000
         XC    0(4,BUFPTR),0(BUFPTR)   CLEAR BUFFER LINK ADDRES@V1D1705 00763000
RETURNA  BR    14            RETURN TO CALLER                  @V1D1705 00764000
LOOP     LA    BUFPAR,0(3,BUFPTR)  NO,CALCULATE NEXT BUFFER ADD@V1D1705 00765000
         ST    BUFPAR,0(,BUFPTR)   STORE BUFFER LINK ADDRESS   @V1D1705 00766000
         BC    15,POOLLOOP    BUILD NEXT BUFFER                @V1D1705 00767000
         SPACE 1                                                        00768000
BUFPAR   EQU   0                                               @V1D1705 00769000
BUFPTR   EQU   1                                               @V1D1705 00770000
BUFNOR   EQU   2                                               @V1D1705 00771000
LBUFLR  EQU    3                                               @V1D1705 00772000
DCBR     EQU   4                                               @V1D1705 00773000
*   SOME NICE CONSTANTS AND EQUATES                                     00774000
*                                                                       00775000
         SPACE 1                                                        00776000
         DS    0D                                              @V1D1705 00777000
BASED    DC    A(DMSSLN7)                                      @V1D1705 00778000
*                                                                       00779000
*   TABLE OF CORE-RESIDENT ROUNTINES                                    00780000
*        CL8'*NAME*', A(CORE LOCATION)                                  00781000
*                                                                       00782000
ROUTABLE DS    0F                 BEGGINING OF TABLE           @V1D1705 00783000
         DC    CL8'IECQBFG1',A(IECQBFG1)                       @V1D1705 00784000
ROUTEND  DS    0F                 END OF TABLE                 @V1D1705 00785000
*                                                                       00786000
GETMASK  DC    X'00FFFFF8'                                     @V1D1705 00787000
*                                                                       00788000
*                                                                       00789000
WLIST    DS    0X                 STOCK VOCABULARY             @V1D1705 00790000
         DC    CL8'('                                          @V1D1705 00791000
         DC    CL8'RESET'                                      @V1D1705 00792000
         DC    CL8'*'                                          @V1D1705 00793000
         DC    8X'FF'                                          @V1D1705 00794000
GETCONST DC    F'16'          MINIMUM GETMAIN STOR.            @V1D1705 00795000
         DC    X'00F00000'    MAXIMUM                          @V1D1705 00796000
LOW3     EQU   7                  MASK FOR 2-4 BYTES           @V305665 00797000
SYSTEM   EQU   X'01'                                           @V305665 00798000
TEN      EQU   10                                              @V305066 00799000
THIRTY2  EQU   32                                              @V305066 00800000
HEX04    EQU   X'04'                                           @V305066 00801000
BINZERO  EQU   X'00'                                           @V305066 00802000
TWENTY8  EQU   28                                              @V305066 00803000
HUNDRED  EQU   100                                             @V305066 00804000
HUNDRED4 EQU   104                                             @V305066 00805000
         SPACE 2                                                        00806000
DSKLIS   EQU   *-8                                             @V305665 00807000
         DC    X'FF',7X'40'       SET FOR DEFAULT FNAME        @V305665 00808000
         DC    CL8'MODULE'        FTYPE                        @V305665 00809000
         DC    CL2'* '            FMODE                        @V305665 00810000
         DC    H'0'               ITEM NUMBER                  @V305665 00811000
         DC    F'0'               BUFFER ADDRESS               @V305665 00812000
         DC    A(80)              LENGTH OF FIRST RECORD       @V305665 00813000
         DC    CL2'V '            VARIABLE LENGTH FILE         @V305665 00814000
         DC    H'1'               NO. OF ITEMS                 @V305665 00815000
         DC    F'0'               NO. OF BYTES READ            @V305665 00816000
         SPACE 2                                                        00817000
         LTORG                                                 @V1D1705 00818000
*                                                                       00819000
*   SOME DUMMIES FOLLOW ....                                            00820000
*                                                                       00821000
         SPACE 1                                                        00822000
*              BASE=XR9=A(12+XRD OF CALLER OS SAVEAREA)                 00823000
DYNALIST DSECT                                                 @V1D1705 00824000
         DS    3F                                              @V1D1705 00825000
LOADLST  DS    CL8                INCLUDE                      @V305665 00826000
LDNAME   DS    CL8                "*NAME*"                     @V1D1705 00827000
         DS    8F                                              @V1D1705 00828000
FREEST   DSECT                                                 @V305665 00829000
BUFF     DS    2F                                              @V305665 00830000
DSKLIN   DS    11F                                             @V305665 00831000
MSG      DMSERR MF=L,MAXSUBS=2                                 @V305665 00832000
         EJECT                                                          00833000
         SPACE 3                                                        00834000
SLOAD    EQU   8                                               @V1D1705 00835000
LINKBLK  DSECT                                                 @V1D1705 00836000
LINKPTR  DS    1F                 POINTER TO NEXT LINK BLOCK   @V1D1705 00837000
LINKAREA DS    1F             PHASE STORAGE AREA LOCATION      @V1D1705 00838000
LINKBYTE DS    1F             LENGTH (BYTES) OF PHASE AREA     @V1D1705 00839000
LINKNAM  DS    2F             PHASE NAME                       @V1D1705 00840000
SAVPSW   DS    2F                 OLD SVC PSW FOR LINK         @V1D1705 00841000
LINKENT  DS    1F             ENTRY LOCATION OF PHASE          @V1D1705 00842000
LINKCNT  DS    2X             USE COUNT - LOAD RB              @V1D1705 00843000
SVAREA   DS    19F            SAVE AREA FOR ATTACHEE           @V1D1705 00844000
SAVR13   DS    1F                                              @V1D1705 00845000
SAVR15   DS    1F                                              @V1D1705 00846000
         DS    0D                                              @V1D1705 00847000
SAVLEN   EQU   (*-LINKBLK)    BLOCK LENGTH                     @V1D1705 00848000
         SPACE 3                                               @VA04980 00849000
LDRSECT  DSECT                    LOADER TABLE ENTRY           @VA04980 00850000
LDRNAME  DS    2F                 LOADED TEXT NAME             @VA04980 00851000
LDRRELO  DS    F                  RELOCATION FACTOR            @VA04980 00852000
LDRADD   DS    F                  ASSIGNED ADDRESS             @VA04980 00853000
LDRFLG2  DS    F                                               @VA04980 00854000
LDRENT   EQU   *-LDRNAME                                       @VA04980 00855000
         EJECT                                                          00856000
         PGMSECT                                               @V1D1705 00857000
         SPACE 3                                                        00858000
         NUCON                                                 @V1D1705 00859000
         SPACE 3                                                        00860000
         SVCSECT                                               @V1D1705 00861000
         SPACE 3                                                        00862000
         FVS                                                   @V305665 00863000
         CMSAVE                                                @V1D1705 00864000
         EJECT                                                          00865000
         END                                                            00866000