//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