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