//MWCALPCX JOB (ZZXZ,504,A),'MWC: ALP->ASM'                             00001000
/*RERUN                                                                 00002000
// EXEC ASMGCOMP                                                        00003000
//SYSIN DD *                                                            00004000
ALPC     TITLE 'PROGRAM TO PASS ALP OUTPUT TO ASSEMBLER'                00005000
ALPC     CSECT                                                          00006000
         STM   14,12,12(13)            SAVE REGISTERS                   00007000
         BALR  12,0                    SET UP BASE                      00008000
         USING *,12                                                     00009000
         ST    13,SAVE+4               SET UP SAVE AREA                 00010000
         LA    13,SAVE                                                  00011000
         EJECT                                                          00012000
*  SCAN PARM FIELD                                                      00013000
*                                                                       00014000
         L     3,0(,1)                 PARM ADDRESS                     00015000
         LH    2,0(,3)                 LENGTH                           00016000
         CL    2,=F'100'               MAX. LENGTH IS 100               00017000
         BNH   *+8                                                      00018000
         LA    2,100                                                    00019000
         LA    3,2(,3)                 1ST BYTE OF TEXT                 00020000
*                                                                       00021000
         LA    4,ALPPARM               ALP PARM FIELD                   00022000
         LA    5,ASMPARM               ASSEMBLER PARM FIELD             00023000
         LA    6,POSTPARM              POSTALP PARM FIELD               00024000
*                                                                       00025000
         LR    0,2                     LENGTH                           00026000
         LR    1,3                     LOCATION                         00027000
         SR    15,15                   PARENTHESIS LEVEL                00028000
SCAN     CLI   0(1),C'/'               BRANCH ON NEXT CHARACTER         00029000
         BE    SLASH                                                    00030000
         CLI   0(1),C'('                                                00031000
         BE    LPAR                                                     00032000
         CLI   0(1),C')'                                                00033000
         BE    RPAR                                                     00034000
         CLI   0(1),C''''                                               00035000
         BE    QUOTE                                                    00036000
NEXT     LA    1,1(,1)                                                  00037000
         BCT   0,SCAN                                                   00038000
*                                                                       00039000
ALLASM   LTR   6,6                     SLASH FOUND ALREADY?             00040000
         BZ    SETPARM                 BR IF SO                         00041000
         LR    4,5                     GIVE PARM TO ASSEMBLER           00042000
         B     SETPARM                                                  00043000
*                                                                       00044000
*  LEFT PARENTHESIS                                                     00045000
*                                                                       00046000
LPAR     LA    15,1(,15)               BUMP LEVEL                       00047000
         B     NEXT                                                     00048000
*                                                                       00049000
*  RIGHT PARENTHESIS                                                    00050000
*                                                                       00051000
RPAR     BCTR  15,0                    DECR LEVEL                       00052000
         LTR   15,15                                                    00053000
         BNM   NEXT                    BR IF NOT UNBALANCED             00054000
         SR    15,15                   STAY AT LEVEL ZERO               00055000
         B     NEXT                                                     00056000
*                                                                       00057000
*  QUOTE                                                                00058000
*                                                                       00059000
QUOTE    LA    1,1(,1)                 SKIP OVER CHARACTER              00060000
         BCT   0,*+8                   DECR COUNT                       00061000
         B     ALLASM                  BR IF END                        00062000
         CLI   0(1),C''''              ENDING QUOTE?                    00063000
         BNE   QUOTE                   BR IF NOT                        00064000
         B     NEXT                                                     00065000
*                                                                       00066000
*  SLASH                                                                00067000
*                                                                       00068000
SLASH    LTR   15,15                   LEVEL ZERO?                      00069000
         BNZ   NEXT                    CONTINUE IF NOT                  00070000
SETPARM  LR    14,2                    TOTAL PARM LENGTH                00071000
         LTR   5,5                     MORE PARM FIELDS?                00072000
         BZ    *+6                     BR IF NOT                        00073000
         SR    14,0                    COMPUTE LENGTH OF THIS PARM      00074000
         STH   14,0(,4)                PLANT PARM LENGTH                00075000
         LTR   14,14                   NULL PARM?                       00076000
         BNP   *+10                    BR IF SO                         00077000
         BCTR  14,0                                                     00078000
         EX    14,MVCPARM              COPY PARM TO PARM AREA           00079000
         LR    4,5                     MOVE TO NEXT PARM                00080000
         LR    5,6                                                      00081000
         SR    6,6                                                      00082000
         LA    1,1(,1)                 MOVE OVER SLASH                  00083000
         BCTR  0,0                                                      00084000
         LTR   2,0                     REMAINING LENGTH                 00085000
         BNP   SCANDONE                BR IF DONE                       00086000
         LR    3,1                     NEW LOCATION                     00087000
         LTR   5,5                     LAST PARM?                       00088000
         BZ    SETPARM                 BR IF SO                         00089000
         B     SCAN                    CONTINUE SCANNING                00090000
*                                                                       00091000
MVCPARM  MVC   2(0,4),0(3)                                              00092000
*                                                                       00093000
SCANDONE DS    0H                                                       00094000
         EJECT                                                          00095000
*  LINK TO ALP AND ASSEMBLER                                            00096000
*                                                                       00097000
         BLDL  0,BLDLIST               LOCATE ALP AND ASSEMBLER         00098000
         DEVTYPE DDSYSOUT,DEVA         CHECK FOR SYSOUT DD CARD         00099000
         LTR   15,15                                                    00100000
         BNZ   ASMONLY                 BR IF NONE, ALP NOT WANTED       00101000
         CLI   ALP+10,0                ALP FOUND?                       00102000
         BE    NOALP                   BR IF NOT                        00103000
         LINK  PARAM=(ALPPARM),VL=1,DE=ALP  CALL ALP                    00104000
         CL    15,=F'8'                RETURN CODE OK?                  00105000
         BNL   ASMFAIL                 BR IF NOT                        00106000
ASMGO    CLI   ASM+10,0                ASSEMBLER FOUND?                 00107000
         BE    NOASM                   BR IF NOT                        00108000
         LA    1,ASMLIST               PARM LIST FOR ASSEMBLER          00109000
         LINK  DE=ASM                  CALL THE ASSEMBLER               00110000
*                                                                       00111000
ASMDONE  LR    2,15                    SAVE ASSEMBLER RETURN CODE       00112000
         DEVTYPE =CL8'NEWPRINT',DEVA   CHECK FOR NEWPRINT DD CARD       00113000
         LTR   15,15                                                    00114000
         BNZ   NOPOST                  BR IF NONE                       00115000
         C     2,=F'24'                WAS ASSEMBLER CALLED?            00116000
         BNE   NOEOF                   BR IF IT WAS                     00117000
         OPEN  (ASMPRINT,(OUTPUT))     WRITE EOF INTO ASM SYSPRINT      00118000
         CLOSE (ASMPRINT)                                               00119000
NOEOF    CLI   ALPPP+10,0              POSTALP FOUND?                   00120000
         BE    NOALPPP                 BR IF NOT                        00121000
         LINK  DE=ALPPP,PARAM=(POSTPARM)  CALL POSTALP                  00122000
NOPOST   LR    15,2                    RESTORE ASSEMBLER RETUEN CODE    00123000
EXIT     L     13,SAVE+4               RESTORE SAVE AREA                00124000
         L     14,12(,13)              RESTORE REGISTERS                00125000
         LM    0,12,20(13)                                              00126000
         BR    14                      RETURN TO OS                     00127000
         EJECT                                                          00128000
ASMONLY  XC    DDSYSOUT(8),DDSYSOUT    KEEP SYSIN DDNAME WHEN           00129000
         B     ASMGO                   ONLY THE ASSEMBLER IS WANTED     00130000
*                                                                       00131000
NOALP    WTO   'UNABLE TO FIND ALP (BLDL FAILED FOR MWCALP)',ROUTCDE=11 00132000
         LA    15,28                                                    00133000
         B     EXIT                                                     00134000
*                                                                       00135000
NOASM    WTO   'UNABLE TO FIND ASSEMBLER XF (BLDL FAILED FOR IFOX00)', *00136000
               ROUTCDE=11                                               00137000
ASMFAIL  LA    15,24                                                    00138000
         B     ASMDONE                                                  00139000
*                                                                       00140000
NOALPPP  WTO   'UNABLE TO FIND POSTALP (BLDL FAILED FOR MWCALPPP)',    *00141000
               ROUTCDE=11                                               00142000
         B     NOPOST                                                   00143000
         EJECT                                                          00144000
ALPPARM  DC    H'0',CL100' '           PARM FOR ALP                     00145000
ASMPARM  DC    H'0',CL100' '           PARM FOR ASSEMBLER               00146000
POSTPARM DC    H'0',CL100' '           PARM FOR POSTALP                 00147000
*                                                                       00148000
ASMLIST  DC    A(ASMPARM)              PARM FIELD                       00149000
         DC    X'80',AL3(DDNAMES)      DDNAME LIST                      00150000
DDNAMES  DC    Y(DDNAMESL)             START OF DDNAME LIST             00151000
         DC    4XL8'00'                                                 00152000
DDSYSOUT DC    CL8'SYSOUT'             SYSIN -> SYSOUT                  00153000
         DC    CL8'ASMPRINT'           SYSPRINT -> ASMPRINT             00154000
DDNAMESL EQU   *-DDNAMES-2                                              00155000
*                                                                       00156000
BLDLIST  DC    H'3'                    3 ENTIRES IN LIST                00157000
         DC    H'58'                   LENGTH OF ENTRY                  00158000
ASM      DC    CL8'IFOX00'             MEMBER NAME FOR ASSEMBLER XF     00159000
         DC    XL50'00'                                                 00160000
ALP      DC    CL8'MWCALP'             MEMBER NAME FOR ALP              00161000
         DC    XL50'00'                                                 00162000
ALPPP    DC    CL8'MWCALPPP'           MEMBER NAME FOR POSTALP          00163000
         DC    XL50'00'                                                 00164000
*                                                                       00165000
ASMPRINT DCB   DDNAME=ASMPRINT,DSORG=PS,MACRF=(W)                       00166000
*                                                                       00167000
DEVA     DC    2A(0)                                                    00168000
*                                                                       00169000
SAVE     DC    18A(0)                  SAVE AREA                        00170000
*                                                                       00171000
         LTORG                                                          00172000
         END                                                            00173000
//  EXEC ASMGLKMM,NAME='SYS1.VSYSTEMS',DISK=,PROGRAM=MWCALPCX           00174000
