ARN      TITLE 'DMSARN     (CMS)       VM/370 - RELEASE 6'              00001000
         SPACE 2                                                        00002000
*.                                                                      00003000
* MODULE NAME:                                                          00004000
*                                                                       00005000
*      DMSARN (ASM3705)                                                 00006000
*                                                                       00007000
* FUNCTION:                                                             00008000
*                                                                       00009000
*        ASM3705 COMMAND.   TO PROVIDE THE  INTERFACE BETWEEN           00010000
*        THE USER AND THE 370X ASSEMBLER.                               00011000
*                                                                       00012000
* ATTRIBUTES:                                                           00013000
*                                                                       00014000
*      DISK RESIDENT                                                    00015000
*                                                                       00016000
* ENTRY POINTS:                                                         00017000
*                                                                       00018000
*        DMSARN - SEE FUNCTION DESCRIPTION                              00019000
*        ASMHAND - SYSUT2 PROCESSING ROUTINE (CALLED FROM DMSSOB)       00020000
*                                                                       00021000
* ENTRY CONDITIONS:                                                     00022000
*                                                                       00023000
*        ASM3705 -                                                      00024000
*        GPR1  = A(PLIST)                                               00025000
*        GPR14 = RETURN ADDRESS                                         00026000
*        GPR15 = A(CALLED ROUTINE)                                      00027000
*        PLIST = CL8 - FILENAME                                         00028000
*                                                                       00029000
*                OPTIONAL AND IN ANY ORDER -                            00030000
*               CL8'(' - START OF OPTIONS                               00031000
*                CL8'XREF'|'NOXREF'     *** DEFAULTS APPEAR FIRST ***   00032000
*                CL8'NORENT'|'RENT'                                     00033000
*                CL8'NODECK'|'DECK'                                     00034000
*                CL8'LOAD'|'NOLOAD'                                     00035000
*                CL8'LIST'|NOLIST'                                      00036000
*                CL8'DISK'|'PRINTER'|'NOPRINT'                          00037000
*                CL'8'LINECNT', CL8'55'|'NN'                            00038000
*                                                                       00039000
*                XL8 - FENCE                                            00040000
*                                                                       00041000
* EXIT CONDITONS:                                                       00042000
*                                                                       00043000
*      NORMAL -                                                         00044000
*      GPR15 = 0    NO ERROR                                            00045000
*                                                                       00046000
*      ERROR -                                                          00047000
*     GPR15 = 28    FILE NOT FOUND.                                     00048000
*        GPR15 = 24    INVALID OPTION, NO FILENAME                      00049000
*     GPR15 = 32    ILLEGAL RECORD LENGTH FOR ASM3705 FILE.             00050000
*     GPR15 = 36    NO READ/WRITE DISKS ACCESSED.                       00051000
*      GPR15 = 4    MINOR  ERRORS  DETECTED  DURING  ASSEMBLE,          00052000
*                   SUCCESSFUL PROGRAM EXECUTION IS PROBABLE.           00053000
*      GPR15 = 8    ERRORS    DETECTED     DURING    ASSEMBLE,          00054000
*                   UNSUCCESSFUL    PROGRAM    EXECUTION    IS          00055000
*                   POSSIBLE.                                           00056000
*      GPR15 = 12   SERIOUS ERRORS  DETECTED DURING  ASSEMBLE,          00057000
*                   UNSUCCESSFUL EXECUTION IS PROBABLE.                 00058000
*      GPR15 = 16   CRITICAL ERRORS DETECTED  DURING ASSEMBLE,          00059000
*                   UNSUCCESSFUL EXECUTION IS PROBABLE.                 00060000
*      GPR15 = 20   CATASTROPHIC   ERRORS    DETECTED   DURING          00061000
*                   ASSEMBLE  (PARTIAL  OR  COMPLETE  ASSEMBLY          00062000
*                   CANCELLED).                                         00063000
*                                                                       00064000
* CALLS TO OTHER ROUTINES:                                              00065000
*                                                                       00066000
*       DMSERSA - ERASE OLD FILES                                       00067000
*        DMSSMNE - INITIALIZE STORAGE POINTERS                          00068000
*        DMSSTTA - LOCATE THE FILE                                      00069000
*        IFKASM  - 370X ASSEMBLER ROOT SEGMENT                          00070000
*                                                                       00071000
* EXTERNAL REFERENCES:                                                  00072000
*                                                                       00073000
*       FREEMAIN                                                        00074000
*       GETMAIN                                                         00075000
*        NUCON                                                          00076000
*       TYPE                                                            00077000
*                                                                       00078000
*                                                                       00079000
* TABLES/WORKAREAS:                                                     00080000
*                                                                       00081000
*        DEFAULTS, OPTEST - LISTS OF VALID OPTIONS AND DEFAULTS         00082000
*                                                                       00083000
* REGISTER USAGE:                                                       00084000
*                                                                       00085000
*        GPR0  = WORKING REGISTER                                       00086000
*        GPR1  = WORKING REGISTER                                       00087000
*        GPR3  = BASE REGISTER                                          00088000
*       GPR4  = WORKING REGISTER                                        00089000
*       GPR5  = WORKING REGISTER                                        00090000
*        GPR6  = RETURN ADDRESS TO CALLER                               00091000
*       GPR7  = WORKING REGISTER                                        00092000
*        GPR8  = WORKING REGISTER                                       00093000
*        GPR9  = WORKING REGISTER                                       00094000
*        GPR10 = CONSTANT '8'                                           00095000
*        GPR12 = WORKING REGISTER                                       00096000
*        GPR13 = WORKING REGISTER                                       00097000
*        GPR14 = RESERVED TO BALR 14, 15                                00098000
*        GPR15 = ERROR CODE ON RETURN.                                  00099000
*                                                                       00100000
* NOTES -                                                               00101000
*                                                                       00102000
*        NONE                                                           00103000
*                                                                       00104000
* OPERATION:                                                            00105000
*                                                                       00106000
*        ASM3705 FIRST SETS A BIT (COMPSWT,X'80') IN                    00107000
*        OSSFLAGS TO INDICATE THE 370X ASSEMBLER IS RUNNING.            00108000
*                                                                       00109000
*        ASM3705 NEXT  SCANS THE  OPTIONS SPECIFIED  AND USES           00110000
*        THE INFORMATION THEREBY OBTAINED TO SET UP THE OPTION          00111000
*        LIST FOR THE 370X ASSEMBLER AND THE FILEDEF PLISTS FOR THE     00112000
*        CALLS  TO FILEDEF.   IF A  PARTICULAR  OPTION IS  NOT          00113000
*        SELECTED, THE CORRESPONDING DEFAULT  VALUE APPEARS IN          00114000
*        THE LIST, WHICH IS  COMPACTED TO ELIMINATE BLANKS              00115000
*        BEFORE PASSING IT TO THE ASSEMBLER.                            00116000
*                                                                       00117000
*       IF RUNNING UNDER THE BATCH MONITOR,                             00118000
*        ASM3705 TYPES A  MESSAGE AT THE TERMINAL  GIVING THE           00119000
*        NAME  OF THE  FILE ABOUT  TO BE  ASSEMBLED.  IT  THEN          00120000
*        CALLS STATE TO VERIFY THE EXISTENCE OF THIS FILE.  IF          00121000
*        IT DOES NOT  EXIST, ASSEMBLE ISSUES AN  ERROR MESSAGE          00122000
*        AND RETURNS TO THE CALLER.  IF IT DOES EXIST,                  00123000
*        ASM3705  CHECKS THE  ITEM  LENGTH,  ISSUES AN  ERROR           00124000
*        MESSAGE IF  ITEM LENGTH IS  INCORRECT AND  RETURNS TO          00125000
*        THE CALLER.                                                    00126000
*                                                                       00127000
*        IF THE  LENGTH IS  CORRECT, ASM3705  CALLS ERASE  TO           00128000
*        DELETE ANY EXISTING TEXT,  LISTING, AND UTILITY FILES          00129000
*        FOR THE CURRENT ASM3705 FILE, AND SETS UP STORAGE BY           00130000
*        CALLS TO STRINIT AND GETMAIN.                                  00131000
*                                                                       00132000
*        IT  THEN  CALLS ADTLKW  TO  OBTAIN  THE MODE  OF  THE          00133000
*        READ-WRITE DISK WITH MOST AVAILABLE SPACE AND USES IT          00134000
*        TO SET UP THE FILEDEF PLIST FOR THE SYSUT FILES AND            00135000
*        CHECKS TO SEE IF THE DISK WITH THE MOST SPACE IS THE SOURCE    00136000
*        DISK. IF IT IS DIFFERENT, THE SYSUT FILES ARE ERASED           00137000
*        FROM IT (SYSUT FILES ALREADY ERASED FROM SOURCE). IF           00138000
*        NOT SPECIFIED BY THE USER, THE TEXT AND LISTING FILES          00139000
*        ARE WRITTEN  ON THE 1)  DISK FROM WHICH  THE ASM3705           00140000
*        SOURCE  IS READ;   2) ON  THE "PARENT"  DISK, IF  THE          00141000
*        FIRST  DISK  IS  A READ-ONLY  EXTENSION;  OR  3)  THE          00142000
*        PRIMARY  A-DISK.    IF  NONE  OF  THESE   CHOICES  IS          00143000
*        AVAILABLE,  THE  COMMAND  WILL  BE  TERMINATED.   CMS          00144000
*        CONTROL BLOCKS (CMSCB'S), WHICH  REFLECT THE SELECTED          00145000
*        OPTION, ARE SET  UP FOR THE TEXT,  LISTING, ASM3705 AND        00146000
*        UTILITY  FILES.  AFTER  EACH  SUCCESSFUL RETURN  FROM          00147000
*        FILEDEF,  ASM3705 SETS  A CLEAR  SWITCH TO  INDICATE           00148000
*        WHICH  CMSCB'S  ARE  TO  BE CLEARED  AT  THE  END  OF          00149000
*        THE ASSEMBLY. ASM3705 FINALLY BRANCHES TO THE 370X ASSEMBLER.  00150000
*                                                                       00151000
*        ON RETURN FROM THE 370X ASSEMBLER, ASM3705 ERASES THE          00152000
*        UTILITY FILES AND CLEARS THE CMSCBS WHICH IT HAD SET UP.       00153000
*        AFTER ANY NECESSARY ERROR MESSAGES, ASM3705 FINALLY            00154000
*        SETS  THE  RELEASE  PAGE  BIT,  CLEARS  THE  SSTATEXT          00155000
*        EXTENSION,  CLEAR OSSFLAGS,  PLACES THE  ERROR CODE  IN        00156000
*        REGISTER 15 AND RETURNS TO THE USER.                           00157000
*                                                                       00158000
*                                                                       00159000
*        SPECIAL OUTPUT HANDLING ROUTINE:  ASMHAND                      00160000
*                                                                       00161000
*        THE  SYSTEM  ROUTINE SOEOB  INTERFACES  WITH  ASMHAND          00162000
*       WHENEVER ANY I/O ACTIVITY PERTAINS TO THE                       00163000
*        SYSUT2 FILE DURING THE ASSEMBLY.                               00164000
*                                                                       00165000
*        SYSUT2 - IF THE FILE IS BEING READ IN ASSEMBLER PHASE          00166000
*        1,  ASMHAND ACCESSES  THE  UTILITY  CONTROL TABLE  TO          00167000
*        ASCERTAIN THE LENGTH  AND LOCATION OF THE  RECORDS TO          00168000
*        BE MOVED AND MOVES IT  TO THE SPECIFIED INPUT BUFFER.          00169000
*        IF THE FILE IS BEING READ,  BUT NOT IN PHASE 1, FIXED          00170000
*        LENGTH IS FORCED AND ASMHAND RETURNS TO SOEOB.                 00171000
*                                                                       00172000
*        IF THE FILE IS BEING WRITTEN  IN PHASE 1, THE UTILITY          00173000
*        CONTROL TABLE  IS FIRST SET UP  BY A CALL  TO GETMAIN          00174000
*        AND THEN UPDATED TO REFLECT THE NUMBERS OF RECORDS TO          00175000
*        BE WRITTEN.  IF THE FILE IS  BEING WRITTEN BUT IS NOT          00176000
*        IN PHASE 1, ASMHAND FORCES A  WRITE OF 4000 BYTES AND          00177000
*        RETURNS TO THE CALLER.                                         00178000
*                                                                       00179000
*                                                                       00180000
*.                                                                      00181000
         EJECT                                                          00182000
DMSARN   START X'00000'                                        @V200820 00183000
         USING DMSARN,R3                                       @V200820 00184000
         LR    R3,R15                                          @V200820 00185000
         LR    R2,R1          SAVE PARAMETER LIST ADDRESS.     @V200820 00186000
         ST    R14,SVREG14    SAVE RETURN TO CMS               @V200820 00187000
*   SET UP SOME QUANTITIES                                              00188000
         DMSKEY NUCLEUS       DISABLE NUCLEUS PROTECT.         @V200820 00189000
         USING NUCON,R0                                        @V200820 00190000
         OI    OSSFLAGS,COMPSWT INDICATE ASSEMBLER RUNNING..   @V200820 00191000
         LA    R10,8          SET CONSTANT                     @V200820 00192000
         MVI   FDEFSWT,0      INITIALIZE FILEDEF SWITCH        @V200820 00193000
         EJECT                                                          00194000
*********************************************************************** 00195000
*                                                                       00196000
*                PROCESS ASSEMBLER OPTIONS.                             00197000
*                                                                       00198000
*********************************************************************** 00199000
         SPACE                                                          00200000
         CLI   8(R2),X'FF'    FILENAME SPECIFIED?              @V200820 00201000
         BE    ERR1E          NO, ERROR                        @V200820 00202000
         CLI   8(R2),C'('     DITTO                            @V200820 00203000
         BE    ERR1E                                           @V200820 00204000
         LA    R2,8(,R2)      POINT TO FILENAME                @V200820 00205000
         LA    R8,8(,R2)      POINT TO OPTIONS                 @V200820 00206000
SUIT03   CLI   0(R8),X'FF'                                     @V200820 00207000
         BE    SQUEEZE        NO OPTIONS                       @V200820 00208000
         CLI   0(R8),C'('                                      @V200820 00209000
         BE    SUIT02                                          @V200820 00210000
         B     ERR3E          MUST HAVE '(' BEFORE OPTNS       @V200820 00211000
*  OPTIONS HANDLING...                                                  00212000
SUIT02   CLI   1(R8),BLANK    ASSEMBLE CALLED AS COMMAND?      @V200820 00213000
         BNE   SUIT05                                          @V200820 00214000
         LA    R8,8(,R8)      PTR TO FIRST OPTION.             @V200820 00215000
         B     SUIT14                                          @V200820 00216000
SUIT05   MVC   0(7,R8),1(R8)  REARRANGE OPTION TO ...          @V200820 00217000
         MVI   7(R8),BLANK    DESTROY THE LEADING BLANK        @V200820 00218000
*   BEGIN THE UNIQUE OPTION SCANNING.                                   00219000
SUIT14   CLI   0(R8),C')'     END OF OPTIONS?                  @V200820 00220000
         BE    SQUEEZE        YES.                             @V200820 00221000
         CLI   0(R8),X'FF'    ASK AGAIN, HE'S BUSY!            @V200820 00222000
         BE    SQUEEZE        YES.                             @V200820 00223000
* COMMENCE OPTION SCANNER...                                            00224000
         CLC   0(8,R8),PRT    CMS 'PRINT' OPTION?              @V200820 00225000
         BE    PDEV                                            @V200820 00226000
         CLC   0(3,R8),=CL3'PR'                                @V200820 00227000
         BNE   TNOPRNT                                         @V200820 00228000
PDEV     MVC   LISTDEV(8),=CL8'PRINTER' LISTING TO PRINTER     @V200820 00229000
         B     SUIT08                                          @V200820 00230000
TNOPRNT  CLC   0(8,R8),NOPRINT                                 @V200820 00231000
         BE    NOPSW                                           @V200820 00232000
         CLC   0(5,R8),=CL5'NOPR'                              @V200820 00233000
         BNE   LISTDSK                                         @V200820 00234000
NOPSW    OI    FDEFSWT,NOPRNT SET 'NOPRINT' SW                 @V200820 00235000
         B     SUIT08                                          @V200820 00236000
LISTDSK  CLC   0(8,R8),DISK   LISTING TO DISK?                 @V200820 00237000
         BE    SUIT08         YES, DEFAULT                     @V200820 00238000
         LA    R5,OPTEST      POINT TO START OF NON-DEFAULTS   @V200820 00239000
         LA    R6,8           INCREMENT                        @V200820 00240000
         LA    R7,RENT        END OF TABLE                     @V200820 00241000
AGAIN    LA    R4,OPTSTART-9  POINT TO WORK AREA               @V200820 00242000
NEXTOPT  LA    R4,9(,R4)      BUMP TO NEXT WORK SPACE          @V200820 00243000
         CLC   0(8,R8),0(R5)  USER OPTION = TABLE OPTION?      @V200820 00244000
         BNE   BXLE           IF NOT, TRY AGAIN                @V200820 00245000
         MVC   0(8,R4),0(R5)  IF SO, PASS HIM TO ASM3705 (LATER@V200820 00246000
         B     SUIT08         AND GET NEXT USER OPTION...      @V200820 00247000
BXLE     BXLE  R5,R6,NEXTOPT                                   @V200820 00248000
         XI    *+5,X'F0'      FIRST TIME SWITCH                @V200820 00249000
RESET    BC    15,SUIT080     EXECUTE FOLLOWING FIRST TIME THR @V200820 00250000
         LA    R5,DEFAULTS    NOW CHECK DEFAULTS, JUST IN CASE @V200820 00251000
         LA    R7,DEFAULTD    END OF DEFAULTS TABLE            @V200820 00252000
         B     AGAIN          USE SAME BXLE AGAIN              @V200820 00253000
SUIT080  CLC   0(7,R8),LINECNT+1 ONLY ONE OPTION LEFT...       @V200820 00254000
         BNE   ERR3E          INVALID OPTION - QUIT            @V200820 00255000
         AR    R8,R10         YES - BUMP R8 TO LINE COUNT      @V200820 00256000
         LA    R7,ERR3E       LOAD ERROR RETURN                @V200820 00257000
         CLI   0(R8),BLANK    ANY VALUE GIVEN?                 @V200820 00258000
         BCR   8,R7           NO...ERROR                       @V200820 00259000
         TM    0(R8),X'F0'    1ST DIGIT NUMERIC?               @V200820 00260000
         BCR   14,R7          NO...ERROR                       @V200820 00261000
         CLI   1(R8),BLANK    2ND DIGIT ?                      @V200820 00262000
         BE    MOVER          NO                               @V200820 00263000
         TM    1(R8),X'F0'    YES...IS IT NUMERIC?             @V200820 00264000
         BCR   14,R7          NO...ERROR                       @V200820 00265000
         CLI   2(R8),BLANK    3RD DIGIT?                       @V200820 00266000
         BCR   7,R7           NO...ERROR                       @V200820 00267000
         B     USECNT         VALID ENTRY                      @V200820 00268000
MOVER    MVC   1(1,R8),0(R8)  MOVE OVER SINGLE DIGIT AND..     @V200820 00269000
         MVI   0(R8),C'0'     GIVE IT A TENS DIGIT OF '0'      @V200820 00270000
USECNT   MVC   LINECNT+9(2),0(R8) AND PUT IT IN OPTION LIST    @V200820 00271000
SUIT08   AR    R8,R10         INC SCAN POINTER THRU ENTRIES    @V200820 00272000
         MVI   RESET+1,X'F0'  RESET SCANNING SWITCH            @V200820 00273000
         B     SUIT14                                          @V200820 00274000
         EJECT                                                          00275000
*********************************************************************** 00276000
*                                                                       00277000
* FOR ANY FILE TO ASSEMBLE, CHECK ITS EXISTENCE, RECORD LENGTH          00278000
* AND ERASE UNECESSARY FILES                                            00279000
*                                                                       00280000
*********************************************************************** 00281000
*   REVISE EXEC PARAMETER LIST BEFORE INVOKING ASSEMBLER                00282000
*                                                                       00283000
SQUEEZE  LA    R12,OPTSTART   SET START ADDRESS                @V200820 00284000
         LA    R15,OPTEND-1   SET END ADDRESS                  @V200820 00285000
         LA    R14,1          SET INCREMENT                    @V200820 00286000
         LA    R6,EXECPARM+2  SET ADDRES FOR BLANKLESS LINE    @V200820 00287000
         LR    R1,R6          SAVE BEGIN LOCATION              @V200820 00288000
TEST     CLI   0(R12),BLANK   IS THE FIRST CHARACTER A BLAN    @V200820 00289000
         BE    MOVALONG       YES. IGNORE IT                   @V200820 00290000
         MVC   0(1,R6),0(R12) MOVE NON BLANK OPTION CHARAC     @V200820 00291000
         LA    R6,1(,R6)      INCREMENT "TO" POINTER           @V200820 00292000
MOVALONG BXLE  R12,R14,TEST   YES, GO GET NEXT CHARACTER       @V200820 00293000
         SR    R6,R1          GET LENGTH OF WRUNG OUT LINE     @V200820 00294000
         STH   R6,EXECPARM    SAVE LENGTH OF PLIST             @V200820 00295000
*                                                                       00296000
SUIT15   EQU   *                                               @V200820 00297000
         TM    BATFLAGS,BATRUN IF BATCH RUNNING, TELL HIM..    @V200820 00298000
         BZ    SUIT25         WHERE HE IS.                     @V200820 00299000
         MVC   MSG1NAM(8),0(R2)                                @V200820 00300000
         LA    R1,CONSOL                                       @V200820 00301000
         SVC   X'CA'                                           @V200820 00302000
         DC    AL4(*+4)                                        @V200820 00303000
         B     CONTINUE                                        @V200820 00304000
*   VERIFY FILE EXISTENCE                                               00305000
SUIT25   MVC   STATE+8(8),0(R2) SET FILE NAME                  @V200820 00306000
         XC    ODE(2),ODE     CLEAR ODE SPECIFICATION.         @V200820 00307000
         MVC   STATE+16(8),INPUT SET INPUT TYPE NAME.          @V200820 00308000
         LA    R1,STATE                                        @V200820 00309000
         SVC   X'CA'                                           @V200820 00310000
         DC    AL4(SUIT25A)                                    @V200820 00311000
         B     SUIT16                                          @V200820 00312000
SUIT25A  MVI   ERRCODE,X'01'                                   @V200820 00313000
         MVC   ERASE+24(2),A1 DUMMY-OUT MODE                   @V200820 00314000
         B     SUIT18A                                         @V200820 00315000
*                                                                       00316000
SUIT16   L     R8,AFSTCOPY                                     @V200820 00317000
         USING FSTSECT,R8                                      @V200820 00318000
         MVC   SYSNMOD(2),FSTM PROVIDE ASSEM SOURCE MODE       @V200820 00319000
         DROP  R8                                              @V200820 00320000
         CLI   35(R8),X'50'   LRECL = 80 BYTES?                @V200820 00321000
         BE    SUIT17                                          @V200820 00322000
         MVC   SYSNAM(8),0(R2) SET FILEID FOR ERRMSG           @V200820 00323000
         LA    R9,SYSNAM      POINT TO FILEID                  @V200820 00324000
         B     ERR007E                                         @V200820 00325000
         EJECT                                                          00326000
*                                                                       00327000
* FIND A R/W DISK FOR WRITING TEXT &LISTING FILES...                    00328000
*                                                                       00329000
SUIT17   L     R1,FSTL(R8)    GET A(ADT) FROM FSTCOPY (STA     @V200820 00330000
         USING ADTSECT,R1                                      @V200820 00331000
         TM    ADTFLG1,ADTFRW IS ORIGIN OF FILE A R/W DISK     @V200820 00332000
         BO    USEIT          YES - WRITE BACK TO IT...        @V200820 00333000
         CLI   ADTMX,BLANK    NO - IS IT  AN EXTENSION?        @V200820 00334000
         BE    CONTINUE       NO- DEFAULT TO PRIMARY DISK      @V200820 00335000
         MVC   ADTPARM(1),ADTMX YES -                          @V200820 00336000
         LA    R1,ADTLIST     CALL ADTLKW FOR PARENT DISK.     @V200820 00337000
         L     R15,VCADTLKW   GET ADTLKW ADDRESS               @VM03093 00338100
         BALR  R14,R15                                         @V200820 00339000
         BC    2,CONTINUE     IF PARENT DISK R/O, DEFAULT.     @V200820 00340000
*                                                                       00341000
USEIT    MVC   WMODE(1),ADTM  IF R/W, USE FOR WRITING NEW      @V200820 00342000
*                                            FILES                      00343000
* PREPARE TO ERASE OLD FILES...                                         00344000
         DROP  R1                                              @V200820 00345000
CONTINUE MVC   ERASE+24(2),WMODE SET MODE                      @V200820 00346000
SUIT18A  MVC   ERASE+8(8),0(R2) SET NAME                       @V200820 00347000
         LA    R9,DDFIN-8                                      @V200820 00348000
         LA    R13,INPUT+8                                     @V200820 00349000
         LA    R8,8                                            @V200820 00350000
         LA    R1,ERASE                                        @V200820 00351000
SUIT18   MVC   ERASE+16(8),0(R13)                              @V200820 00352000
         SVC   X'CA'          ERASE LISTING,TEXT, UTILITY FILES@V200820 00353000
         DC    AL4(JBXLE)     ERROR-RETURN IF IT DIDN'T EXIST  @V200820 00354000
JBXLE    BXLE  R13,R8,SUIT18  ITERATE ...                      @V200820 00355000
         EJECT                                                          00356000
*********************************************************************** 00357000
*                                                                       00358000
*                      INITIALIZATION IN CMS NUCLEUS.                   00359000
*                                                                       00360000
*********************************************************************** 00361000
         L     R15,ASTRINIT   INITIALIZE FREE STORAGE          @V200820 00362000
         BALR  R14,R15                                         @V200820 00363000
* RESERVE A LARGE ENOUGH AREA TO LOAD THE LONGEST ASSEMBLE PATH         00364000
         L     R0,MAXLENGT                                     @V200820 00365000
         GETMAIN  R,LV=(R0)                                    @V200820 00366000
         L     R9,FAKELEN                                      @V200820 00367000
         LA    R8,FAKEAD                                       @V200820 00368000
         GETMAIN   EC,LV=(R9),A=(R8)                           @V200820 00369000
         SPACE 3                                                        00370000
* MOVE FILE NAME AND MODE IN OSSVC PACKAGE.                             00371000
         L     R8,AOPSECT                                      @V200820 00372000
         MVC   8(8,R8),0(R2)  MOVE FILE NAME                   @V200820 00373000
         MVC   24(2,R8),ERASE+24 AND MODE                      @V200820 00374000
         L     R15,VCADTLKW   SET UP CALL TO ADTLKW            @VM03093 00375100
         MVC   ADTPARM,=C'??' FIND DISK WITH MOST SPACE        @V200820 00376000
         LA    R1,ADTLIST                                      @V200820 00377000
         BALR  R14,R15                                         @V200820 00378000
         BC    2,ERR006E      NO READ/WRITE DISKS              @V200820 00379000
         USING ADTSECT,R1                                      @V200820 00380000
         MVC   SYSUTMOD(1),ADTM                                @V200820 00381000
         MVC   ERASE+24(2),SYSUTMOD SET UP UTILITY ERASE       @V200820 00382000
         DROP  R1                                              @V200820 00383000
         CLC   SYSUTMOD(1),WMODE SOURCE = MOST AVAIL. SPACE?   @V200820 00384000
         BE    NOERASE        IF SO, ALREADY ERASED SYSUTS     @V200820 00385000
         BAL   R7,SUIT19      ERASE SYSUTS FROM WRITE DISK     @V200820 00386000
NOERASE  EQU   *                                               @V200820 00387000
         USING FCBSECT,R11                                     @V200820 00388000
         MVC   SUTNAM(8),0(R2) INITIALIZE SYSUT FILENAME       @V200820 00389000
         MVI   DDSYSUT+5,C'1' SET UP FILEDEF SYSUT1            @V200820 00390000
         MVI   DD2SYSUT+5,C'1'                                 @V200820 00391000
         LA    R1,UTFDEF      FILEDEF SYSUT1                   @V200820 00392000
         SVC   202                                             @V200820 00393000
         DC    AL4(*+4)                                        @V200820 00394000
         LTR   R15,R15        ANY ERRORS?                      @V200820 00395000
         BP    CLOSE          YES, GO AWAY                     @V200820 00396000
         LTR   R11,R0         CHEK FOR USER FCB                @V200820 00397000
         BM    FDEFUT2        REQUEST SUCCESSFUL, GO ON        @V200820 00398000
         MVC   FCBPROC(4),AASMHAND USER FCB - TELL HIM WHERE TO@V200820 00399000
FDEFUT2  OI    FDEFSWT,X'02'  SET FIRST RECORD UTILITY SWCH    @V200820 00400000
         MVI   DDSYSUT+5,C'2' SET UP FILEDEF SYSUT2            @V200820 00401000
         MVI   DD2SYSUT+5,C'2'                                 @V200820 00402000
         LA    R1,UTFDEF                                       @V200820 00403000
         SVC   202                                             @V200820 00404000
         DC    AL4(*+4)                                        @V200820 00405000
         LTR   R15,R15        ANY ERRORS?                      @V200820 00406000
         BP    CLOSE          YES, GO AWAY                     @V200820 00407000
         LTR   R11,R0                                          @V200820 00408000
         BM    UT3            REQUEST SUCCESSFUL, GO ON        @V200820 00409000
         MVC   FCBPROC(4),AASMHAND USER FCB - TELL HIM WHERE TO@V200820 00410000
UT3      LPR   R11,R11                                         @V200820 00411000
         OI    FCBIOSW,FCBPROCC+FCBPROCO AUXPROC FOR SYSUT2    @V200820 00412000
         MVI   DDSYSUT+5,C'3' SET UP FILEDEF SYSUT3            @V200820 00413000
         MVI   DD2SYSUT+5,C'3'                                 @V200820 00414000
         LA    R1,UTFDEF                                       @V200820 00415000
         SVC   202                                             @V200820 00416000
         DC    AL4(*+4)                                        @V200820 00417000
         LTR   R15,R15        ANY ERRORS?                      @V200820 00418000
         BP    CLOSE          YES, GO AWAY                     @V200820 00419000
         LTR   R11,R0                                          @V200820 00420000
         BM    FILEDEF        REQUEST SUCCESSFUL - GO ON       @V200820 00421000
         MVC   FCBPROC(4),AASMHAND USER FCB - TELL HIM WHERE TO@V200820 00422000
FILEDEF  EQU   *                                               @V200820 00423000
         XR    R12,R12        CLEAR R12                        @V200820 00424000
         LH    R12,WMODE      LOAD MODE FOR DISK WRITING       @V200820 00425000
         MVC   SYSNAM(8),0(2) STORE FILENAME IN SYSIN PLIST    @V200820 00426000
         STH   R12,TEXTMOD    PROVIDE DISK MODE FOR TEXT       @V200820 00427000
         MVC   TEXTNAM(8),0(2) STORE FILENAME IN TEXT PLIST    @V200820 00428000
         CLC   LISTDEV(3),DISK IS PRINTER DEVICE DSK?          @V200820 00429000
         BE    DISKLIST       YES, DROP                        @V200820 00430000
         MVC   LISTNAM(56),OVER MUST BE PRINTER...             @V200820 00431000
         B     SETFDEF                                         @V200820 00432000
DISKLIST STH   R12,LISTMOD    PROVIDE DISK O|P MODE            @V200820 00433000
         MVC   LISTNAM(8),0(2) STORE FNAME IN LISTING PLIST    @V200820 00434000
SETFDEF  LA    R1,SYSFDEF     SET UP SYSIN FILEDEF             @V200820 00435000
         SVC   202                                             @V200820 00436000
         DC    AL4(*+4)                                        @V200820 00437000
         LTR   R15,R15                                         @V200820 00438000
         BP    CLOSE          ANY ERROR?                       @V200820 00439000
         TM    ERRCODE,X'01'  ? SYSIN FILE ON DISK ?           @V200820 00440000
         BZ    SETEXT         YES - GO ON                      @V200820 00441000
         LTR   R11,R0         ? USER FCB ?                     @V200820 00442000
         BP    DEVTEST        YES, GO CHECK HIS DEVICE         @V200820 00443000
         NI    ERRCODE,X'00'  NO, ERROR EXIT                   @V200820 00444000
         B     ERR002E                                         @V200820 00445000
DEVTEST  EQU   *                                               @V200820 00446000
         CLI   FCBDEV,X'14'   ? IS DEVICE DISK ?               @V200820 00447000
         BNE   SETEXT         NO - SOMETHING ELSE, SO OK       @V200820 00448000
         NI    ERRCODE,X'00'  YES, ERROR EXIT                  @V200820 00449000
         B     ERR002E                                         @V200820 00450000
SETEXT   LA    R1,TXTFDEF     SET UP TEXT FILEDEF              @V200820 00451000
         SVC   202                                             @V200820 00452000
         DC    AL4(*+4)                                        @V200820 00453000
         LTR   R15,R15        ANY ERROR?                       @V200820 00454000
         BP    CLOSE          YES                              @V200820 00455000
         CLC   NODECK+1(8),DECK CHEK FOR 'DECK' OPTION         @V200820 00456000
         BNE   LISTR          NO - CHEK FOR LISTING            @V200820 00457000
         LA    R1,PUNFDEF     YES - SET UP SYSPUNCH FILEDE     @V200820 00458000
         SVC   202                                             @V200820 00459000
         DC    AL4(*+4)                                        @V200820 00460000
         LTR   R15,R15        ANY ERROR?                       @V200820 00461000
         BP    CLOSE                                           @V200820 00462000
LISTR    TM    FDEFSWT,NOPRNT WAS 'NOPRINT' SPEC'D ?           @V200820 00463000
         BZ    FDEFLIST       IF NOT, ISSUE SYSPRINT FDEF      @V200820 00464000
         MVC   LISTDEV(16),DUMMY IF SO, ISSUE DUMMY FDEF...(N  @V200820 00465000
FDEFLIST LA    R1,LSTFDEF     SET UP LISTING FILEDEF           @V200820 00466000
         SVC   202                                             @V200820 00467000
         DC    AL4(*+4)                                        @V200820 00468000
         LTR   R15,R15                                         @V200820 00469000
         BP    CLOSE          ANY ERROR?                       @V200820 00470000
LIST2    LA    R1,LIBFDEF     SET UP CMSLIB FILEDEF            @V200820 00471000
         SVC   202                                             @V200820 00472000
         DC    AL4(*+4)                                        @V200820 00473000
         LTR   R15,R15        ANY ERROR?                       @V200820 00474000
         BP    CLEARFCB       YES. (PROBABLY NO MACLIB FOUND)  @V200820 00475000
         LPR   R11,R0         LOAD (+) FCB ADDR INTO R11 (     @V200820 00476000
         OI    FCBINIT,FCBCATML MACLIB CONCAT FLAG ON          @V200820 00477000
         EJECT                                                          00478000
*********************************************************************** 00479000
*                                                                       00480000
*                        CALL THE ASSEMBLER                             00481000
*                                                                       00482000
*********************************************************************** 00483000
         DMSKEY RESET         RESET NUCLEUS PROTECT.           @V200820 00484000
         LA    R0,*+8         HELLO ASSEMBLER, THIS IS CMS!    @V200820 00485000
         B     *+12                                            @V200820 00486000
         DC    CL8'IFKASM'    HELLO CMS, THIS IS ASSEMBLER!    @V200820 00487000
         SR    R1,R1                                           @V200820 00488000
         SVC   8              LOAD THE ASSEMBLER               @V200820 00489000
         ST    R0,VIFKASM                                      @V200820 00490000
         LM    13,1,LINK                                       @V200820 00491000
         BR    R15                                             @V200820 00492000
*                                                                       00493000
* ON RETURN FROM THE ASSEMBLER.                                         00494000
*                                                                       00495000
RETURN   EQU   *                                               @V200820 00496000
         OI    FDEFSWT,ASMFIN SIGNAL BACK FROM ASSEMBLER       @V200820 00497000
         LA    R9,3           CHECK FOR MULTIPLE OF 4          @V200820 00498000
         NR    R9,R15                                          @V200820 00499000
         LTR   R9,R9                                           @V200820 00500000
         BNZ   SAVRET         STRANGE RETURN FROM ASM3705      @V200820 00501000
         CH    R15,=H'16'     ALSO IF > 16                     @V200820 00502000
         BH    SAVRET                                          @V200820 00503000
         B     *+4(R15)       JUMP TAB FOR NORMAL RETURNS      @V200820 00504000
         B     SUIT19         RETURN = 0                       @V200820 00505000
         B     ERR004W        4                                @V200820 00506000
         B     ERR008W        8                                @V200820 00507000
         B     ERR012W        12                               @V200820 00508000
         B     ERR016W        16                               @V200820 00509000
*                                                                       00510000
SAVRET   EQU   *                                               @V200820 00511000
         STH   R15,ERRCODE    RETURN CODE FORM THE ASSEMBLER   @V200820 00512000
*                                                                       00513000
*   ERASE UTILITIES                                                     00514000
SUIT19   EQU   *                                               @V200820 00515000
         LA    R9,DDFIN-16                                     @V200820 00516000
         LA    R13,INPUT+24   ERASE UTILITIES, USING DDLIST    @V200820 00517000
         LA    R8,8                                            @V200820 00518000
         LA    R1,ERASE                                        @V200820 00519000
SUIT20   MVC   ERASE+16(8),0(R13)                              @V200820 00520000
         SVC   X'CA'                                           @V200820 00521000
         DC    AL4(*+4)                                        @V200820 00522000
         BXLE  R13,R8,SUIT20                                   @V200820 00523000
         TM    FDEFSWT,ASMFIN BEFORE OR AFTER ASSEMBLY?        @V200820 00524000
         BCR   8,R7           BEFORE, RETURN TO INITIALIZA     @V200820 00525000
CLOSE    LA    R1,FINIS       FINIS * * *  (TO BE SAFE)        @V200820 00526000
         SVC   X'CA'                                           @V200820 00527000
         DC    AL4(*+4)                                        @V200820 00528000
*                                                                       00529000
CLEARFCB MVC   CLEARNAM(8),CLEARALL CLEAR ALL FCB'S...         @V200820 00530000
         LA    R1,CLEARFIL                                     @V200820 00531000
         SVC   202                                             @V200820 00532000
         DC    AL4(*+4)                                        @V200820 00533000
         EJECT                                                          00534000
* ALL FILES ARE NOW ASSEMBLED.                                          00535000
END      SR    R0,R0                                           @V200820 00536000
         TM    FDEFSWT,ASMFIN COMMAND ERRORS?                  @V200820 00537000
         BZ    CMDERR         YES...                           @V200820 00538000
         DMSKEY NUCLEUS       DISABLE NUCLEUS PROTECT.         @V200820 00539000
CMDERR   EQU   *              COME HERE IF COMMAND ERROR       @V200820 00540000
         NI    OSSFLAGS,255-COMPSWT ASSEMBLER NO LONGER RUN    @V200820 00541000
         OI    MISFLAGS,RELPAGES SET RELEASE PAGE BIT          @V200820 00542000
         DMSKEY RESET         RESET NUCLEUS PROTECT.           @V200820 00543000
         L     R14,SVREG14                                     @V200820 00544000
         LH    R15,ERRCODE                                     @V200820 00545000
         BR    R14            RETURN TO SVCINT                 @V200820 00546000
         SPACE 2                                                        00547000
         PRINT NOGEN                                                    00548000
ERR1E    DMSERR NUM=1,LET=E,TEXT='NO FILENAME SPECIFIED'       @V200820 00549000
         MVI   ERRCODE+1,X'18' RETURN CODE = 24                @V200820 00550000
         B     END                                             @V200820 00551000
         SPACE                                                          00552000
ERR002E  EQU   *                                               @V200820 00553000
         DMSERR NUM=002,LET=E,SUB=(CHARA,(R2)),                @V200820*00554000
               TEXT='FILE ''........ ASM3705'' NOT FOUND'      @V200820 00555000
         MVI   ERRCODE+1,X'1C'                                 @V200820 00556000
         B     CLOSE                                           @V200820 00557000
*                                                                       00558000
ERR007E  EQU   *                                               @V200820 00559000
         DMSERR NUM=007,LET=E,SUB=(CHAR8A,(R9)),               @V200820*00560000
               TEXT='FILE ''....................'' IS NOT FIXED, 80 CHA*00561100
               R. RECORDS'                                     @VA04895 00562100
         MVI   ERRCODE+1,X'20'                                 @V200820 00563000
         B     CLOSE                                           @V200820 00564000
*                                                                       00565000
ERR006E  EQU   *                                               @V200820 00566000
         DMSERR NUM=6,LET=E,TEXT='NO READ/WRITE DISK ACCESSED' @V200820 00567000
         MVI   ERRCODE+1,X'24'                                 @V200820 00568000
         B     END            GET OUT.                         @V200820 00569000
*                                                                       00570000
ERR3E    EQU   *                                               @V200820 00571000
         DMSERR NUM=3,LET=E,SUB=(CHARA,(R8)),                  @V200820*00572000
               TEXT='INVALID OPTION ''........'''              @V200820 00573000
         MVI   ERRCODE+1,X'18'                                 @V200820 00574000
         B     END                                             @V200820 00575000
         EJECT                                                          00576000
ERR004W  DMSERR NUM=4,LET=W,TEXT='WARNING MESSAGES ISSUED'     @V200820 00577000
         MVI   ERRCODE+1,X'04'                                 @V200820 00578000
         B     SUIT19                                          @V200820 00579000
*                                                                       00580000
ERR008W  DMSERR NUM=8,LET=W,TEXT='ERROR MESSAGES ISSUED'       @V200820 00581000
         MVI   ERRCODE+1,X'08'                                 @V200820 00582000
         B     SUIT19                                          @V200820 00583000
*                                                                       00584000
ERR012W  DMSERR NUM=12,LET=W,TEXT='SEVERE ERROR MESSAGES ISSUED'        00585000
         MVI   ERRCODE+1,X'0C'                                 @V200820 00586000
         B     SUIT19                                          @V200820 00587000
*                                                                       00588000
ERR016W  DMSERR NUM=16,LET=W,TEXT='TERMINAL ERROR MESSAGES ISSUED'      00589000
         MVI   ERRCODE+1,X'10'                                 @V200820 00590000
         B     SUIT19                                          @V200820 00591000
*                                                                       00592000
         EJECT                                                          00593000
*********************************************************************** 00594000
*                                                                       00595000
*                    PARAMETER LIST FOR THE ASSEMBLER                   00596000
*                                                                       00597000
*********************************************************************** 00598000
         SPACE                                                          00599000
LINK     DC    A(SAVEAREA)    R13                              @V200820 00600000
         DC    A(RETURN)      R14                              @V200820 00601000
VIFKASM  DC    A(0)           R15: V(IFKASM)                   @V200820 00602000
         DC    F'0'                                            @V200820 00603000
         DC    A(PARAMLST)    R1                               @V200820 00604000
*                                                                       00605000
PARAMLST DC    A(EXECPARM)                                     @V200820 00606000
         DC    X'80',AL3(DDNAMES)                              @V200820 00607000
*   ASSEMBLER DEFAULT OPTIONS ARE SHOWN.                                00608000
         DS    0H                                              @V200820 00609000
EXECPARM DC    H'00'          L'REVISED EXEC PARAM FIELD       @V200820 00610000
         DC    100C' '                                         @V200820 00611000
OPTSTART EQU   *              ASSEMBLER OPTION WORK AREA       @V200820 00612000
LIST     DC    CL8'LIST'                                       @V200820 00613000
XREF     DC    CL9',XREF'                                      @V200820 00614000
LOAD     DC    CL9',LOAD'                                      @V200820 00615000
NODECK   DC    CL9',NODECK'                                    @V200820 00616000
NORENT   DC    CL9',NORENT'                                    @V200820 00617000
LINECNT  DC    C',LINECNT=55'                                  @V200820 00618000
OPTEND   EQU   *              END OF DEFAULT OPTIONS + 1       @V200820 00619000
         DS    0H                                              @V200820 00620000
*  ALTERNATE DD NAMES AND ERASURE LIST                                  00621000
DDNAMES  DC    AL2(DDFIN-*),24X'00'                            @V200820 00622000
         DC    CL8'CMSLIB'                                     @V200820 00623000
INPUT    DC    CL8'ASM3705'                                    @V200820 00624000
         DC    CL8'LISTING'                                    @V200820 00625000
         DC    CL8'PUNCH'                                      @V200820 00626000
         DC    CL8'SYSUT1'                                     @V200820 00627000
         DC    CL8'SYSUT2'                                     @V200820 00628000
         DC    CL8'SYSUT3'                                     @V200820 00629000
         DC    CL8'TEXT'                                       @V200820 00630000
DDFIN    EQU   *                                               @V200820 00631000
*   LIST OF OPTION KEYWORDS TO COMPARE WITH PARAMETER ENTRIES           00632000
OPTEST   DS    0H                                              @V200820 00633000
NOLIST   DC    CL8'NOLIST'                                     @V200820 00634000
NOXREF   DC    CL8'NOXREF'                                     @V200820 00635000
NOLOAD   DC    CL8'NOLOAD'                                     @V200820 00636000
DECK     DC    CL8'DECK'                                       @V200820 00637000
RENT     DC    CL8'RENT'                                       @V200820 00638000
*        DEFAULTS - SCAN IN CASE OF CONFLICTING ENTRIES, ETC.           00639000
DEFAULTS DS    0H                                              @V200820 00640000
         DC    CL8'LIST'                                       @V200820 00641000
         DC    CL8'XREF'                                       @V200820 00642000
         DC    CL8'LOAD'                                       @V200820 00643000
         DC    CL8'NODECK'                                     @V200820 00644000
DEFAULTD DC    CL8'NORENT'                                     @V200820 00645000
*                                                                       00646000
PRT      DC    CL8'PRINT'                                      @V200820 00647000
NOPRINT  DC    CL8'NOPRINT'                                    @V200820 00648000
         DS    0H                                              @V200820 00649000
WMODE    DC    CL2'A1'        MODE FOR DISK OUTPUT             @V200820 00650000
BLANK    EQU   X'40'                                           @V200820 00651000
         EJECT                                                          00652000
*                                                                       00653000
*   MANDATORY FILE SETUPS                                               00654000
*                                                                       00655000
SYSFDEF  DS    0D                                              @V200820 00656000
         DC    CL8'FILEDEF'                                    @V200820 00657000
         DC    CL8'ASM3705'                                    @V200820 00658000
         DC    CL8'DISK'                                       @V200820 00659000
SYSNAM   DC    CL8' '                                          @V200820 00660000
         DC    CL8'ASM3705'                                    @V200820 00661000
SYSNMOD  DC    CL8'A1'                                         @V200820 00662000
         DC    CL8'(RECFM'                                     @V200820 00663000
         DC    CL8'FB'                                         @V200820 00664000
         DC    CL8'LRECL'                                      @V200820 00665000
         DC    CL8'80'                                         @V200820 00666000
         DC    CL8'BLOCK'                                      @V200820 00667000
         DC    CL8'800'                                        @V200820 00668000
         DC    CL8'NOCHANGE'                                   @V200820 00669000
         DC    8X'FF'                                          @V200820 00670000
TXTFDEF  DS    0D                                              @V200820 00671000
         DC    CL8'FILEDEF'                                    @V200820 00672000
         DC    CL8'TEXT'                                       @V200820 00673000
TEXTDEV  DC    CL8'DISK'                                       @V200820 00674000
TEXTNAM  DC    CL8' '                                          @V200820 00675000
         DC    CL8'TEXT'                                       @V200820 00676000
TEXTMOD  DC    CL8' '                                          @V200820 00677000
         DC    CL8'('                                          @V200820 00678000
         DC    CL8'NOCHANGE'                                   @V200820 00679000
         DC    8X'FF'                                          @V200820 00680000
PUNFDEF  DS    0D                                              @V200820 00681000
         DC    CL8'FILEDEF'                                    @V200820 00682000
         DC    CL8'PUNCH'                                      @V200820 00683000
         DC    CL8'PUNCH'                                      @V200820 00684000
         DC    CL8'('                                          @V200820 00685000
         DC    CL8'RECFM'                                      @V200820 00686000
         DC    CL8'F'                                          @V200820 00687000
         DC    CL8'LRECL'                                      @V200820 00688000
         DC    CL8'80'                                         @V200820 00689000
         DC    CL8'BLOCK'                                      @V200820 00690000
         DC    CL8'80'                                         @V200820 00691000
         DC    CL8'NOCHANGE'                                   @V200820 00692000
         DC    8X'FF'                                          @V200820 00693000
LSTFDEF  DS    0D                                              @V200820 00694000
         DC    CL8'FILEDEF'                                    @V200820 00695000
         DC    CL8'LISTING'                                    @V200820 00696000
LISTDEV  DC    CL8'DISK'                                       @V200820 00697000
LISTNAM  DC    CL8' '                                          @V200820 00698000
         DC    CL8'LISTING'                                    @V200820 00699000
LISTMOD  DC    CL8' '                                          @V200820 00700000
OVER     DC    CL8'('                                          @V200820 00701000
         DC    CL8'RECFM'                                      @V200820 00702000
         DC    CL8'FB'                                         @V200820 00703000
         DC    CL8'BLOCK'                                      @V200820 00704000
         DC    CL8'605'                                        @V200820 00705000
         DC    CL8'NOCHANGE'                                   @V200820 00706000
         DC    8X'FF'                                          @V200820 00707000
UTFDEF   DS    0D                                              @V200820 00708000
         DC    CL8'FILEDEF'                                    @V200820 00709000
DDSYSUT  DC    CL8'SYSUT1'    FIRST SYSUT FILEDEF              @V200820 00710000
DISK     DC    CL8'DISK'                                       @V200820 00711000
SUTNAM   DC    CL8' '                                          @V200820 00712000
DD2SYSUT DC    CL8'SYSUT1'                                     @V200820 00713000
SYSUTMOD DC    CL8' 4'                                         @V200820 00714000
         DC    CL8'('                                          @V200820 00715000
         DC    CL8'NOCHANGE'                                   @V200820 00716000
         DC    CL8'BLOCK'                                      @V200820 00717000
         DC    CL8'1739'                                       @V200820 00718000
         DC    CL8'AUXPROC'                                    @V200820 00719000
         DC    AL4(ASMHAND)                                    @V200820 00720000
         DC    AL4(0)                                          @V200820 00721000
FENCE    DC    8X'FF'                                          @V200820 00722000
LIBFDEF  DS    0D                                              @V200820 00723000
         DC    CL8'FILEDEF'                                    @V200820 00724000
         DC    CL8'CMSLIB'                                     @V200820 00725000
         DC    CL8'DISK'                                       @V200820 00726000
         DC    CL8'CMSLIB'                                     @V200820 00727000
         DC    CL8'MACLIB'                                     @V200820 00728000
         DC    CL8'*'                                          @V200820 00729000
         DC    CL8'(LRECL'                                     @V200820 00730000
         DC    CL8'80'                                         @V200820 00731000
         DC    CL8'RECFM'                                      @V200820 00732000
         DC    CL8'FB'                                         @V200820 00733000
         DC    CL8'BLOCK'                                      @V200820 00734000
         DC    CL8'800'                                        @V200820 00735000
         DC    CL8'NOCHANGE'                                   @V200820 00736000
         DC    8X'FF'                                          @V200820 00737000
CLEARFIL DS    0D                                              @V200820 00738000
         DC    CL8'FILEDEF'                                    @V200820 00739000
CLEARNAM DC    CL8'*'                                          @V200820 00740000
         DC    CL8'CLEAR'                                      @V200820 00741000
         DC    8X'FF'                                          @V200820 00742000
ADTLIST  DS    0D                                              @V200820 00743000
         DC    CL24' '        IMMATERIAL                       @V200820 00744000
ADTPARM  DC    CL2'  '        CODE FOR ADTLKW CALLS            @V200820 00745000
SYSUT1   DC    CL8'SYSUT1'                                     @V200820 00746000
SYSUT2   DC    CL8'SYSUT2'                                     @V200820 00747000
SYSUT3   DC    CL8'SYSUT3'                                     @V200820 00748000
CLEARALL DC    CL8'*'                                          @V200820 00749000
DUMMY    DC    CL8'DUMMY'                                      @V200820 00750000
         DC    8X'FF'                                          @V200820 00751000
         EJECT                                                          00752000
*********************************************************************** 00753000
*                                                                       00754000
*                         CALLING SEQUENCES                             00755000
*                                                                       00756000
*********************************************************************** 00757000
         DS    0F                                              @V200820 00758000
STATE    DC    CL8'STATE'                                      @V200820 00759000
         DC    CL8' '         FILE NAME                        @V200820 00760000
         DC    CL8' '         TYPE                             @V200820 00761000
ODE      DC    CL2'0'         MODE                             @V200820 00762000
         DC    CL2'0'         UNUSED                           @V200820 00763000
AFSTCOPY DC    A(0)           ADDRESS OF FST COPY LOCATION     @V200820 00764000
*                                                                       00765000
         DS    0F                                              @V200820 00766000
ERASE    DC    CL8'ERASE'                                      @V200820 00767000
         DC    CL8' '         FILE NAME                        @V200820 00768000
         DC    CL8' '         TYPE                             @V200820 00769000
         DC    CL2' '         MODE                             @V200820 00770000
*                                                                       00771000
         DS    0F                                              @V200820 00772000
FINIS    DC    CL8'FINIS'                                      @V200820 00773000
         DC    CL8'*'                                          @V200820 00774000
         DC    CL8'*'                                          @V200820 00775000
         DC    CL8'*'                                          @V200820 00776000
*                                                                       00777000
         DS    0F                                              @V200820 00778000
CONSOL   DC    CL8'TYPLIN'                                     @V200820 00779000
         DC    AL1(1)                                          @V200820 00780000
         DC    AL3(MSG1)      MESSAGE ADDRESS                  @V200820 00781000
         DC    C'R'                                            @V200820 00782000
         DC    AL3(EMSG1-MSG1) MESSAGE LENGTH                  @V200820 00783000
         EJECT                                                          00784000
*********************************************************************** 00785000
*                                                                       00786000
*                            DATA                                       00787000
*                                                                       00788000
*********************************************************************** 00789000
         SPACE                                                          00790000
ERRCODE  DC    H'0'                                            @V200820 00791000
MSG1     DC    C' ASSEMBLING: '                                @V200820 00792000
MSG1NAM  DC    CL8' '         FILE NAME                        @V200820 00793000
EMSG1    EQU   *                                               @V200820 00794000
A1       DC    CL2'A1'                                         @V200820 00795000
*                                                                       00796000
AASMHAND DC    A(ASMHAND)     AUXILLARY I/O HANDLER            @V200820 00797000
*                                                                       00798000
*                                                                       00799000
SVREG14  DC    F'0'                                            @V200820 00800000
MAXLENGT DC    X'00007000'    LONGEST ASSEMBLER PATH           @V200820 00801000
HALFZERO EQU   MAXLENGT       H'0'                             @V200820 00802000
*                                                                       00803000
SAVEAREA DC    18F'0'                                          @V200820 00804000
*                                                                       00805000
         DROP  R3                                              @V200820 00806000
         EJECT                                                          00807000
*                                                                       00808000
*   SPECIAL HANDLING ROUTINE. ENTERED FROM "EOBROUTN".                  00809000
*        UPON ENTRY:                                                    00810000
*   R1=A(DECB)   R2=A(DCB)   R8=A(OPSECT)                               00811000
*   R11=A(FCBSECT)   R14=A(RETURN)   R15=A(ASMHAND)                     00812000
*                                                                       00813000
*        UPON RETURN:                                                   00814000
*   ALL REGS ARE RESTORED, EXCEPT R15;                                  00815000
*   EQ 0-EXECUTE I/O REQUEST   GT 0-RESIDUAL COUNT   LT 0-ERROR CODE    00816000
ASMHAND  DS    0D                                              @V200820 00817000
         USING ASMHAND,R15                                     @V200820 00818000
         USING NUCON,R0                                        @V200820 00819000
         USING FCBSECT,R11                                     @V200820 00820000
         STM   R0,R15,SAVEREGS                                 @V200820 00821000
         LR    R3,R15                                          @V200820 00822000
         DROP  R15                                             @V200820 00823000
         USING ASMHAND,R3                                      @V200820 00824000
*   DETERMINE WHICH DATA SET NEEDS SPECIAL HANDLING                     00825000
         CLC   FCBDD(5),=CL8'SYSUT'                            @V200820 00826000
         BNE   HRETURN        NOT AN UTITLITY FILE             @V200820 00827000
         CLI   FCBDD+5,C'2'                                    @V200820 00828000
         BE    SYSUTY         HANDLE SYSUT2                    @V200820 00829000
*   ANY SYSTEM UTILITY DATA SET                                         00830000
SYSUTX   EQU   *              FUDGE SYSTEM UTILITY             @V200820 00831000
         MVI   FCBFORM,C'F'   FORCE "FIXED" RECORDS            @V200820 00832000
         TM    IOBIOFLG,IOBIN INPUT?                           @V200820 00833000
         BO    HRETURN        YES.                             @V200820 00834000
         MVC   FCBBYTE+2(2),HALF4000 FORCE WRITE OF 4000 BYT   @V200820 00835000
         B     HRETURN                                         @V200820 00836000
*   ASSEMBLER SYSUT2                                                    00837000
SYSUTY   EQU   *              KEEP SYSUT2 IN CORE DURING       @V200820 00838000
*                             PHASE 1                                   00839000
         USING UTENTRY,R2                                      @V200820 00840000
         USING UTHEAD,R5                                       @V200820 00841000
         L     R5,UTSAV       GET TABLE ENTRY                  @V200820 00842000
         TM    FCBIOSW,FCBCLOSE IN CLOSE?                      @V200820 00843000
         BO    CLUT2          YES.                             @V200820 00844000
         TM    IOBIOFLG,IOBIN INPUT?                           @V200820 00845000
         BNO   WRUT2          NOPE.                            @V200820 00846000
RDUT2    LTR   R5,R5          READING. IN PHASE 1?             @V200820 00847000
         BZ    SYSUTX         NO. DO NORMAL SYSUT I/O          @V200820 00848000
         LH    R4,FCBITEM                                      @V200820 00849000
         N     R4,HALFWORD                                     @V200820 00850000
         CH    R4,UTNOENT     DOES READ POINTER GT N'ENTRIES?  @V200820 00851000
         BH    EOFUT2         YES, SIMULATE EOF                @V200820 00852000
         SLL   R4,3           GET INDEX TO TABLE ENTRY         @V200820 00853000
         LA    R2,0(R5,R4)    A(ENTRY FOR THIS RECORD)         @V200820 00854000
         LH    R4,FCBBYTE+2                                    @V200820 00855000
         CH    R4,UTLNG       VERIFY BYTES REQUESTED LE LRECL  @V200820 00856000
         BNH   *+6                                             @V200820 00857000
HALF4000 DC    H'4000'                                         @V200820 00858000
         STH   R4,FCBREAD     SET COUNT OF BYTES READ          @V200820 00859000
         L     R5,UTRECAD     GET A("FROM")                    @V200820 00860000
         L     R7,FCBBUFF                                      @V200820 00861000
         LR    R6,R4          GET L'RECORD                     @V200820 00862000
         BAL   R14,MOVEMODE   MOVE THE RECORD                  @V200820 00863000
         B     UTRETURN                                        @V200820 00864000
WRUT2    LTR   R5,R5          WRITING. IN PHASE 1?             @V200820 00865000
         BNZ   UTSET          YES.                             @V200820 00866000
         TM    FDEFSWT,X'02'  FIRST TIME?                      @V200820 00867000
         BNO   SYSUTX         NO                               @V200820 00868000
         NI    FDEFSWT,X'FD'  TURN OFF FIRST TIME SWITCH       @V200820 00869000
         B     UTSETUP        GO SET THINGS UP                 @V200820 00870000
UTSET    LH    R4,FCBITEM                                      @V200820 00871000
         N     R4,HALFWORD                                     @V200820 00872000
         CH    R4,UTNOENT     DOES WRT PTR GT N'RECORDS?       @V200820 00873000
         BH    UTGETCOR       YES. GET MORE CORE               @V200820 00874000
         SLL   R4,3                                            @V200820 00875000
         LA    R2,0(R5,R4)    GET INDEX INTO TABLE             @V200820 00876000
UTSET1   EQU   *                                               @V200820 00877000
         LH    R4,FCBBYTE+2                                    @V200820 00878000
         STH   R4,FCBREAD     SET N'BYTES                      @V200820 00879000
         L     R5,FCBBUFF     GET A("FROM")                    @V200820 00880000
         L     R7,UTRECAD     GET A("TO")                      @V200820 00881000
         LR    R6,R4          GET L'RECORD                     @V200820 00882000
         BAL   R14,MOVEMODE                                    @V200820 00883000
         B     UTRETURN                                        @V200820 00884000
UTSETUP  EQU   *              SET UP WORD TABLE                @V200820 00885000
         L     R0,FAKELEN                                      @V200820 00886000
         L     R1,FAKEAD                                       @V200820 00887000
         FREEMAIN  R,LV=(R0),A=(R1)                            @V200820 00888000
         LA    R0,800         GET 100 DOUBLE WORDS             @V200820 00889000
         LA    R10,UTSAV                                       @V200820 00890000
         GETMAIN  EC,LV=(R0),A=(R10)                           @V200820 00891000
         LTR   R15,R15        STORAGE AVAILABLE?               @V200820 00892000
         BNZ   ERR109S        NO, ERROR                        @V200820 00893000
         L     R1,0(,R10)     LOAD ADDR OF FREE STORAGE        @V200820 00894000
         ST    R1,UTSAV                                        @V200820 00895000
         LR    R5,R1                                           @V200820 00896000
         LA    R0,1                                            @V200820 00897000
         STH   R0,FCBITEM     SET R/W POINTERS                 @V200820 00898000
         ST    R0,UTNOENT                                      @V200820 00899000
         B     UTSET                                           @V200820 00900000
UTGETCOR EQU   *              GET A NEW BUFFER                 @V200820 00901000
         LH    R2,UTNOENT                                      @V200820 00902000
         CH    R2,HALF99      IS TABLE FULL?                   @V200820 00903000
         BL    *+10                                            @V200820 00904000
         B     ERR109S                                         @V200820 00905000
HALF99   DC    H'99'                                           @V200820 00906000
         CH    R4,UTNXT       SAME AS NEXT ENTRY?              @V200820 00907000
         BE    *+10                                            @V200820 00908000
         B     ERR109S                                         @V200820 00909000
         DC    H'23'                                           @V200820 00910000
         STH   R4,UTNOENT     UPDATE N'ENTRIES                 @V200820 00911000
         LA    R2,1(,R4)                                       @V200820 00912000
         STH   R2,UTNXT       UPDATE NEXT AVAILABLE            @V200820 00913000
         SLL   R4,3                                            @V200820 00914000
         LA    R2,0(R5,R4)    GET INDEX TO TABLE               @V200820 00915000
         LH    R9,FCBBYTE+2   GET L'RECORD                     @V200820 00916000
         STH   R9,UTLNG                                        @V200820 00917000
         LA    R10,UTRECAD                                     @V200820 00918000
         GETMAIN  EC,LV=(R9),A=(R10)                           @V200820 00919000
         LTR   R15,R15                                         @V200820 00920000
         BNZ   ERR109S                                         @V200820 00921000
         B     UTSET1                                          @V200820 00922000
CLUT2    EQU   *              CLOSE OUT SYSUT2                 @V200820 00923000
         LTR   R5,R5          ANY BLOCKS USED?                 @V200820 00924000
         BZ    HRETURN        NOPE.                            @V200820 00925000
         LH    R4,UTNOENT     GET N'ENTRIES TO RELEASE         @V200820 00926000
         LR    R2,R5                                           @V200820 00927000
UTNXTFR  LA    R2,8(,R2)      GET NEXT BLOCK TO FREE           @V200820 00928000
         LH    R0,UTLNG                                        @V200820 00929000
         L     R1,UTRECAD                                      @V200820 00930000
         FREEMAIN  R,LV=(R0),A=(R1)                            @V200820 00931000
         BCT   R4,UTNXTFR                                      @V200820 00932000
         LA    R0,800         FREE CONTROL BLOCK               @V200820 00933000
         L     R1,UTSAV                                        @V200820 00934000
         FREEMAIN  R,LV=(R0),A=(R1)                            @V200820 00935000
         SR    R15,R15                                         @V200820 00936000
         ST    R15,UTSAV      SET UTSAV INDEX POINTER CLEAR    @V200820 00937000
         B     HRETURN                                         @V200820 00938000
         EJECT                                                          00939000
*                                                                       00940000
*   MOVE THE RECORD                                                     00941000
*                                                                       00942000
         SPACE                                                          00943000
*   R6=L'RECORD   R7=A("TO")   R5=A("FROM")   R14=A(RETURN)             00944000
MOVEMODE DS    0H             MOVE A RECORD                    @V200820 00945000
MV1      SH    R6,HALF256+2   N'BYTES GT 256?                  @V200820 00946000
         BM    LT256          NO.                              @V200820 00947000
         MVC   0(256,R7),0(R5) MOVE 256 BYTES OF THE RECORD    @V200820 00948000
         BCR   8,R14          L'RECORD=256; FINISHED           @V200820 00949000
HALF256  LA    R7,256(R7,R0)  INCREMENT "TO" LOCATION          @V200820 00950000
         LA    R5,256(,R5)    INCREMENT "FROM" LOCATION        @V200820 00951000
         B     MV1            MOVE ANOTHER CHUNCK OF RECORD    @V200820 00952000
LT256    AH    R6,HALF256+2   RESTORE TRUE COUNT               @V200820 00953000
         BCTR  R6,0           PLAY GAMES                       @V200820 00954000
         EX    R6,MOVEREC     MOVE ALONG                       @V200820 00955000
         BR    R14            RETURN                           @V200820 00956000
MOVEREC  MVC   0(*-*,R7),0(R5) MOVE THE RECORD                 @V200820 00957000
         SPACE 3                                                        00958000
EOFUT2   LA    R15,12         INDEICATE EOF ON DATA SET        @V200820 00959000
         LNR   R15,R15        NEGATIZE VALUE                   @V200820 00960000
         B     RET                                             @V200820 00961000
ERR109S  DMSERR NUM=109,LET=S,TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED'  00962000
         LA    R15,104        RETURN CODE = 104                @V200820 00963000
         LH    R4,UTNOENT                                      @V200820 00964000
         BCTR  R4,0                                            @V200820 00965000
         STH   R4,UTNOENT                                      @V200820 00966000
         B     CLUT2                                           @V200820 00967000
HRETURN  SR    R15,R15        RETURN TO EOBROUTN               @V200820 00968000
         B     RET                                             @V200820 00969000
UTRETURN L     R15,FCBREAD    SEND BACK BYTES READ             @V200820 00970000
RET      LM    R0,R14,SAVEREGS                                 @V200820 00971000
         BR    R14                                             @V200820 00972000
*                                                                       00973000
         DS    0F                                              @V200820 00974000
FAKELEN  DC    X'00005000'                                     @V200820 00975000
FAKEAD   DC    F'0'                                            @V200820 00976000
HALFWORD DC    F'65535'                                        @V200820 00977000
SAVEREGS DC    16F'0'                                          @V200820 00978000
FDEFSWT  DC    X'00'          FILEDEF REMEMBERER:              @V200820 00979000
NOPRNT   EQU   X'80'          'NOPRINT' OPTION                 @V200820 00980000
ASMFIN   EQU   X'40'          ON IF ASSEMBLER CALLED           @V200820 00981000
         EJECT                                                          00982000
UTHEAD   DSECT                                                 @V200820 00983000
UTDUM    DS    H                                               @V200820 00984000
UTRDPTR  DS    0H                                              @V200820 00985000
UTWRPTR  DS    H              READ/WRITE POINTER               @V200820 00986000
UTNOENT  DS    H              N'ENTRIES IN TABLE               @V200820 00987000
UTNXT    DS    H              NEXT AVAILABLE ENTRY             @V200820 00988000
UTENTRY  DSECT                                                 @V200820 00989000
UTENTNO  DS    H              RECORD ALIGNMENT                 @V200820 00990000
UTLNG    DS    H              L'BUFFER                         @V200820 00991000
UTRECAD  DS    A              A(BUFFER)                        @V200820 00992000
         EJECT                                                          00993000
         PRINT GEN                                                      00994000
         REGEQU                                                @V200820 00995000
         SPACE                                                          00996000
         CMSCB                                                 @V200820 00997000
         ADT                                                   @V200820 00998000
         SPACE                                                          00999000
         FSTB                                                  @V200820 01000000
         NUCON                                                 @V200820 01001000
UTSAV    EQU   IOBCSW         HANDLING SYSUT2                  @V200820 01002000
         SPACE 3                                                        01003000
DMSARN   CSECT                                                 @V200820 01004000
         LTORG                                                 @V200820 01005000
         SPACE                                                          01006000
         ORG   DMSARN+X'1000'                                  @V200820 01007000
         END   DMSARN                                                   01008000