home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibmtsonih / tsnpch.asm < prev    next >
Assembly Source File  |  2020-01-01  |  14KB  |  176 lines
  1. //MWCALPCH JOB (ZZXZ,504,A),'MWC: ALP->ASM'                             00001000
  2. /*RERUN                                                                 00002000
  3. /*CNTL MILWYL                                                           00003000
  4. // EXEC MWCALCL                                                         00004000
  5. //SYSIN DD *                                                            00005000
  6. ALPC     TITLE 'PROGRAM TO PASS ALP OUTPUT TO ASSEMBLER'                00006000
  7. ALPC     CSECT                                                          00007000
  8.          STM   14,12,12(13)            SAVE REGISTERS                   00008000
  9.          BALR  12,0                    SET UP BASE                      00009000
  10.          USING *,12                                                     00010000
  11.          ST    13,SAVE+4               SET UP SAVE AREA                 00011000
  12.          LA    13,SAVE                                                  00012000
  13.          EJECT                                                          00013000
  14. *  SCAN PARM FIELD                                                      00014000
  15. *                                                                       00015000
  16.          L     3,0(,1)                 PARM ADDRESS                     00016000
  17.          LH    2,0(,3)                 LENGTH                           00017000
  18.          CL    2,=F'100'               MAX. LENGTH IS 100               00018000
  19.          BNH   *+8                                                      00019000
  20.          LA    2,100                                                    00020000
  21.          LA    3,2(,3)                 1ST BYTE OF TEXT                 00021000
  22. *                                                                       00022000
  23.          LA    4,ALPPARM               ALP PARM FIELD                   00023000
  24.          LA    5,ASMPARM               ASSEMBLER PARM FIELD             00024000
  25.          LA    6,POSTPARM              POSTALP PARM FIELD               00025000
  26. *                                                                       00026000
  27.          LR    0,2                     LENGTH                           00027000
  28.          LR    1,3                     LOCATION                         00028000
  29.          SR    15,15                   PARENTHESIS LEVEL                00029000
  30. SCAN     CLI   0(1),C'/'               BRANCH ON NEXT CHARACTER         00030000
  31.          BE    SLASH                                                    00031000
  32.          CLI   0(1),C'('                                                00032000
  33.          BE    LPAR                                                     00033000
  34.          CLI   0(1),C')'                                                00034000
  35.          BE    RPAR                                                     00035000
  36.          CLI   0(1),C''''                                               00036000
  37.          BE    QUOTE                                                    00037000
  38. NEXT     LA    1,1(,1)                                                  00038000
  39.          BCT   0,SCAN                                                   00039000
  40. *                                                                       00040000
  41. ALLASM   LTR   6,6                     SLASH FOUND ALREADY?             00041000
  42.          BZ    SETPARM                 BR IF SO                         00042000
  43.          LR    4,5                     GIVE PARM TO ASSEMBLER           00043000
  44.          B     SETPARM                                                  00044000
  45. *                                                                       00045000
  46. *  LEFT PARENTHESIS                                                     00046000
  47. *                                                                       00047000
  48. LPAR     LA    15,1(,15)               BUMP LEVEL                       00048000
  49.          B     NEXT                                                     00049000
  50. *                                                                       00050000
  51. *  RIGHT PARENTHESIS                                                    00051000
  52. *                                                                       00052000
  53. RPAR     BCTR  15,0                    DECR LEVEL                       00053000
  54.          LTR   15,15                                                    00054000
  55.          BNM   NEXT                    BR IF NOT UNBALANCED             00055000
  56.          SR    15,15                   STAY AT LEVEL ZERO               00056000
  57.          B     NEXT                                                     00057000
  58. *                                                                       00058000
  59. *  QUOTE                                                                00059000
  60. *                                                                       00060000
  61. QUOTE    LA    1,1(,1)                 SKIP OVER CHARACTER              00061000
  62.          BCT   0,*+8                   DECR COUNT                       00062000
  63.          B     ALLASM                  BR IF END                        00063000
  64.          CLI   0(1),C''''              ENDING QUOTE?                    00064000
  65.          BNE   QUOTE                   BR IF NOT                        00065000
  66.          B     NEXT                                                     00066000
  67. *                                                                       00067000
  68. *  SLASH                                                                00068000
  69. *                                                                       00069000
  70. SLASH    LTR   15,15                   LEVEL ZERO?                      00070000
  71.          BNZ   NEXT                    CONTINUE IF NOT                  00071000
  72. SETPARM  LR    14,2                    TOTAL PARM LENGTH                00072000
  73.          LTR   5,5                     MORE PARM FIELDS?                00073000
  74.          BZ    *+6                     BR IF NOT                        00074000
  75.          SR    14,0                    COMPUTE LENGTH OF THIS PARM      00075000
  76.          STH   14,0(,4)                PLANT PARM LENGTH                00076000
  77.          LTR   14,14                   NULL PARM?                       00077000
  78.          BNP   *+10                    BR IF SO                         00078000
  79.          BCTR  14,0                                                     00079000
  80.          EX    14,MVCPARM              COPY PARM TO PARM AREA           00080000
  81.          LR    4,5                     MOVE TO NEXT PARM                00081000
  82.          LR    5,6                                                      00082000
  83.          SR    6,6                                                      00083000
  84.          LA    1,1(,1)                 MOVE OVER SLASH                  00084000
  85.          BCTR  0,0                                                      00085000
  86.          LTR   2,0                     REMAINING LENGTH                 00086000
  87.          BNP   SCANDONE                BR IF DONE                       00087000
  88.          LR    3,1                     NEW LOCATION                     00088000
  89.          LTR   5,5                     LAST PARM?                       00089000
  90.          BZ    SETPARM                 BR IF SO                         00090000
  91.          B     SCAN                    CONTINUE SCANNING                00091000
  92. *                                                                       00092000
  93. MVCPARM  MVC   2(0,4),0(3)                                              00093000
  94. *                                                                       00094000
  95. SCANDONE DS    0H                                                       00095000
  96.          EJECT                                                          00096000
  97. *  LINK TO ALP AND ASSEMBLER                                            00097000
  98. *                                                                       00098000
  99.          BLDL  0,BLDLIST               LOCATE ALP AND ASSEMBLER         00099000
  100.          DEVTYPE DDSYSOUT,DEVA         CHECK FOR SYSOUT DD CARD         00100000
  101.          LTR   15,15                                                    00101000
  102.          BNZ   ASMONLY                 BR IF NONE, ALP NOT WANTED       00102000
  103.          CLI   ALP+10,0                ALP FOUND?                       00103000
  104.          BE    NOALP                   BR IF NOT                        00104000
  105.          LINK  PARAM=(ALPPARM),VL=1,DE=ALP  CALL ALP                    00105000
  106.          CL    15,=F'8'                RETURN CODE OK?                  00106000
  107.          BNL   ASMFAIL                 BR IF NOT                        00107000
  108. ASMGO    CLI   ASM+10,0                ASSEMBLER FOUND?                 00108000
  109.          BE    NOASM                   BR IF NOT                        00109000
  110.          LA    1,ASMLIST               PARM LIST FOR ASSEMBLER          00110000
  111.          LINK  DE=ASM                  CALL THE ASSEMBLER               00111000
  112. *                                                                       00112000
  113. ASMDONE  LR    2,15                    SAVE ASSEMBLER RETURN CODE       00113000
  114.          DEVTYPE =CL8'NEWPRINT',DEVA   CHECK FOR NEWPRINT DD CARD       00114000
  115.          LTR   15,15                                                    00115000
  116.          BNZ   NOPOST                  BR IF NONE                       00116000
  117.          C     2,=F'24'                WAS ASSEMBLER CALLED?            00117000
  118.          BNE   NOEOF                   BR IF IT WAS                     00118000
  119.          OPEN  (ASMPRINT,(OUTPUT))     WRITE EOF INTO ASM SYSPRINT      00119000
  120.          CLOSE (ASMPRINT)                                               00120000
  121. NOEOF    CLI   ALPPP+10,0              POSTALP FOUND?                   00121000
  122.          BE    NOALPPP                 BR IF NOT                        00122000
  123.          LINK  DE=ALPPP,PARAM=(POSTPARM)  CALL POSTALP                  00123000
  124. NOPOST   LR    15,2                    RESTORE ASSEMBLER RETUEN CODE    00124000
  125. EXIT     L     13,SAVE+4               RESTORE SAVE AREA                00125000
  126.          L     14,12(,13)              RESTORE REGISTERS                00126000
  127.          LM    0,12,20(13)                                              00127000
  128.          BR    14                      RETURN TO OS                     00128000
  129.          EJECT                                                          00129000
  130. ASMONLY  XC    DDSYSOUT(8),DDSYSOUT    KEEP SYSIN DDNAME WHEN           00130000
  131.          B     ASMGO                   ONLY THE ASSEMBLER IS WANTED     00131000
  132. *                                                                       00132000
  133. NOALP    WTO   'UNABLE TO FIND ALP (BLDL FAILED FOR MWCALP)',ROUTCDE=11 00133000
  134.          LA    15,28                                                    00134000
  135.          B     EXIT                                                     00135000
  136. *                                                                       00136000
  137. NOASM    WTO   'UNABLE TO FIND ASSEMBLER H (BLDL FAILED FOR IEV90)',   *00137000
  138.                ROUTCDE=11                                               00138000
  139. ASMFAIL  LA    15,24                                                    00139000
  140.          B     ASMDONE                                                  00140000
  141. *                                                                       00141000
  142. NOALPPP  WTO   'UNABLE TO FIND POSTALP (BLDL FAILED FOR MWCALPPP)',    *00142000
  143.                ROUTCDE=11                                               00143000
  144.          B     NOPOST                                                   00144000
  145.          EJECT                                                          00145000
  146. ALPPARM  DC    H'0',CL100' '           PARM FOR ALP                     00146000
  147. ASMPARM  DC    H'0',CL100' '           PARM FOR ASSEMBLER               00147000
  148. POSTPARM DC    H'0',CL100' '           PARM FOR POSTALP                 00148000
  149. *                                                                       00149000
  150. ASMLIST  DC    A(ASMPARM)              PARM FIELD                       00150000
  151.          DC    X'80',AL3(DDNAMES)      DDNAME LIST                      00151000
  152. DDNAMES  DC    Y(DDNAMESL)             START OF DDNAME LIST             00152000
  153.          DC    4XL8'00'                                                 00153000
  154. DDSYSOUT DC    CL8'SYSOUT'             SYSIN -> SYSOUT                  00154000
  155.          DC    CL8'ASMPRINT'           SYSPRINT -> ASMPRINT             00155000
  156. DDNAMESL EQU   *-DDNAMES-2                                              00156000
  157. *                                                                       00157000
  158. BLDLIST  DC    H'3'                    3 ENTIRES IN LIST                00158000
  159.          DC    H'58'                   LENGTH OF ENTRY                  00159000
  160. ASM      DC    CL8'IEV90'              MEMBER NAME FOR ASSEMBLER H      00160000
  161.          DC    XL50'00'                                                 00161000
  162. ALP      DC    CL8'MWCALP'             MEMBER NAME FOR ALP              00162000
  163.          DC    XL50'00'                                                 00163000
  164. ALPPP    DC    CL8'MWCALPPP'           MEMBER NAME FOR POSTALP          00164000
  165.          DC    XL50'00'                                                 00165000
  166. *                                                                       00166000
  167. ASMPRINT DCB   DDNAME=ASMPRINT,DSORG=PS,MACRF=(W)                       00167000
  168. *                                                                       00168000
  169. DEVA     DC    2A(0)                                                    00169000
  170. *                                                                       00170000
  171. SAVE     DC    18A(0)                  SAVE AREA                        00171000
  172. *                                                                       00172000
  173.          LTORG                                                          00173000
  174.          END                                                            00174000
  175. //  EXEC MWCLUTIL,PROGRAM=MWCALPCH                                      00175000
  176.