MVS Software

./ ADD NAME=CASE
 MACRO
 CASE
 COPY GBLVARS
 LCLA &NBR,&CASENO
 PUSHLAB
 AIF (N'&SYSLIST EQ 1).LDSUBL
&NBR SETA N'&SYSLIST
 AGO .LDAIND
.LDSUBL ANOP
&NBR SETA N'&SYSLIST(1)
.LDAIND AIF (&NBR LE 0).NOPRMS
&AIND(&AI) SETA &AIND(&AI)+&NBR
.TSTSUBL AIF (T'&SYSLIST(1,2) EQ 'O' AND &NBR NE 1).NOTSUBL
&CASENO SETA &SYSLIST(1,&NBR)
 AGO .TSTMULT
.NOTSUBL ANOP
&CASENO SETA &SYSLIST(&NBR)
.TSTMULT AIF (&CASENO-(&CASENO/&MULT(&AI))*&MULT(&AI) NE 0).NOTMULT
 AIF (&CASENO EQ 0).NOTMULT
 AIF (&CI GE 200).OVER
&CI SETA &CI+1
&CIND1(&CI) SETA &CASENO
&CIND2(&CI) SETC '&LIND(&LI)'
.RETRNPT ANOP
&NBR SETA &NBR-1
 AIF (&NBR NE 0).TSTSUBL
.FRSTIME AIF ('&NEST(&NI)'(3,1) NE ' ').BCGEN1
&NEST(&NI) SETC ' Y'.'&NEST(&NI)'(4,5)
 AGO .EQUGN1
.BCGEN1 AIF ('&NEST(&NI)'(4,1) EQ 'B').BCINST
 L &RIND(&AI),&LIND(&LI-2)
 BCR 15,&RIND(&AI)
 AGO .EQUGN1
.BCINST BC 15,&LIND(&LI-1)
.EQUGN1 ANOP
&LIND(&LI) EQU *
&LI SETA &LI-1
 MEXIT
.NOTMULT MNOTE 8,'CASE &CASENO DELETED. NOT MULTIPLE OF &MULT(&AI).'
&AIND(&AI) SETA &AIND(&AI)-1
 AGO .RETRNPT
.NOPRMS MNOTE 'NO PARAMETERS FOUND WITH CASE MACRO'
 AGO .FRSTIME
.OVER MNOTE 8,'CASE NUMBER STK EXCEEDED. FURTHER EXPANSIONS INVALID'
 MEND
./ ADD NAME=CASENTRY
 MACRO
 CASENTRY &P1,&VECTOR=,&POWER=0
 COPY GBLVARS
 PUSHNEST CASE
 PUSHLAB
 PUSHLAB
 AIF (&AI GE 50).OVER
&AI SETA &AI+1
&AIND(&AI) SETA 0
&RIND(&AI) SETC '&P1'
&MULT(&AI) SETA 1
&CTR SETA &POWER
.SHIFTLP AIF (&CTR LE 0).GENSHFT
&MULT(&AI) SETA &MULT(&AI)+&MULT(&AI)
&CTR SETA &CTR-1
 AGO .SHIFTLP
.GENSHFT AIF (&MULT(&AI) EQ 4).TESTVEC
 AIF (&MULT(&AI) GT 4).RTSHIFT
 SLA &P1,2-&POWER
 AGO .TESTVEC
.RTSHIFT SRA &P1,&POWER-2
.TESTVEC AIF ('&VECTOR' EQ 'B' OR '&VECTOR' EQ 'BR').BRVEC
 PUSHLAB
 A &P1,&LIND(&LI)
 L &P1,0(&P1)
 BCR 15,&P1
&LIND(&LI) DC A(&LIND(&LI-2))
&LI SETA &LI-1
 MEXIT
.BRVEC BC 15,&LIND(&LI-1)(&P1)
&NEST(&NI) SETC ' B'.'&NEST(&NI)'(5,4)
 MEXIT
.OVER MNOTE 8,'TOTAL CASES STK EXCEEDED. FURTHER EXPANSIONS INVALID'
 MEND
./ ADD NAME=CHKSTACK
 MACRO
 CHKSTACK
 GBLA &AI,&CI,&II,&LI,&NI
 LCLA &SI
 LCLC &STACK(5)
 AIF (&AI LE 0).FIXC
&SI SETA &SI+1
&STACK(&SI) SETC 'TOTLCASE'
.FIXC AIF (&CI LE 0).FIXI
&SI SETA &SI+1
&STACK(&SI) SETC 'CASELABL'
.FIXI AIF (&II LE 0).FIXL
&SI SETA &SI+1
&STACK(&SI) SETC 'INSTRCTN'
.FIXL AIF (&LI LE 0).FIXN
&SI SETA &SI+1
&STACK(&SI) SETC 'LABEL'
.FIXN AIF (&NI LE 0).TEST
&SI SETA &SI+1
&STACK(&SI) SETC 'NESTING'
.TEST AIF (&SI EQ 0).END
 MNOTE 8,'&STACK(&SI) STACK NOT EMPTY'
&SI SETA &SI-1
 AGO .TEST
.END MEND
./ ADD NAME=DO
 MACRO
 DO &P1,&FROM=,&TO=,&BY=,&UNTIL=,&WHILE=
 PUSHNEST DO
 DOPROC &FROM,&TO,&BY,&UNTIL,&WHILE,&P1
 MEND
./ ADD NAME=DOEXIT
 MACRO
 DOEXIT &P1,&P2,&P3,&P4,&P5,&P6,&P7,&P8,&P9,&P10,&P11,&P12,&P13,X
 &P14,&P15,&P16,&P17,&P18,&P19,&P20,&P21,&P22,&P23,&P24,&X
 P25,&P26,&P27,&P28,&P29,&P30,&P31,&P32,&P33,&P34,&P35,&PX
 36,&P37,&P38,&P39,&P40,&P41,&P42,&P43,&P44,&P45,&P46,&P4X
 7,&P48,&P49,&P50,&CC=
 COPY GBLVARS
 PUSHLAB
&NEST(&NI) SETC ' Y'.'&NEST(&NI)'(5,4)
 IFPROC &CC,&P1,&P2,&P3,&P4,&P5,&P6,&P7,&P8,&P9,&P10,&P11,&P12,X
 &P13,&P14,&P15,&P16,&P17,&P18,&P19,&P20,&P21,&P22,&P23,&X
 P24,&P25,&P26,&P27,&P28,&P29,&P30,&P31,&P32,&P33,&P34,&PX
 35,&P36,&P37,&P38,&P39,&P40,&P41,&P42,&P43,&P44,&P45,&P4X
 6,&P47,&P48,&P49,&P50
 MEND
./ ADD NAME=DOPROC
 MACRO
 DOPROC &FROM,&TO,&BY,&UNTIL,&WHILE,&P1
 COPY GBLVARS
 LCLA &I
 LCLC &LCLWK1
 PUSHLAB
 PUSHINS (EQU,*,,,,&LIND(&LI))
&ST(&NI) SETA &II+1
 PUSHLAB
 AIF (T'&FROM EQ 'O').NOIND
 AIF ('&FROM(3)' EQ '').INCR
 LA &FROM(3),&LIND(&LI)
.INCR ANOP
&I SETA &I+1
 AIF ('&SYSLIST(&I,2)' EQ '').TEST
 AIF ('&SYSLIST(&I,2)' EQ '0').GENSR
 AIF ('&SYSLIST(&I,2)'(1,1) EQ '-').NEGVAL
 AIF (T'&SYSLIST(&I,2) EQ 'N').POSVAL
 AIF ('&SYSLIST(&I,2)'(1,1) EQ '(').GENLR
 L &SYSLIST(&I,1),&SYSLIST(&I,2)
 AGO .TEST
.GENLR LR &SYSLIST(&I,1),&SYSLIST(&I,2)
 AGO .TEST
.POSVAL AIF (&SYSLIST(&I,2) GE 4096).TSTMAG
 LA &SYSLIST(&I,1),&SYSLIST(&I,2)
 AGO .TEST
.TSTMAG AIF (&SYSLIST(&I,2) GE 32768).FULLIT
 AGO .HALFLIT
.NEGVAL ANOP
&LCLWK1 SETC '&SYSLIST(&I,2)'(2,7)
 AIF (&LCLWK1 GE 32768).FULLIT
.HALFLIT LH &SYSLIST(&I,1),=H'&SYSLIST(&I,2)'
 AGO .TEST
.FULLIT L &SYSLIST(&I,1),=F'&SYSLIST(&I,2)'
 AGO .TEST
.GENSR SR &SYSLIST(&I,1),&SYSLIST(&I,1)
.TEST AIF (&I LT 3).INCR
 AIF (T'&UNTIL NE 'O').ERRMG2
.CKWHILE AIF (T'&WHILE NE 'O').COMPGEN
&LIND(&LI) EQU *
.POSTIND AIF (T'&P1 EQ 'O').GETIND
 AIF (T'&BY NE 'O').PFB
 AIF (T'&TO NE 'O').PFT
 AIF ('&FROM(3)' NE '').BCTRZ
 PUSHINS (BCT,&FROM(1),&LIND(&LI))
 AGO .ERRMG
.BCTRZ PUSHINS (BCTR,&FROM(1),&FROM(3))
 AGO .ERRMG
.PFT PUSHINS (&P1,&FROM(1),&TO(1),&LIND(&LI))
 MEXIT
.PFB PUSHINS (&P1,&FROM(1),&BY(1),&LIND(&LI))
 MEXIT
.GETIND AIF ('&FROM(3)' EQ '').BCTR1
 PUSHINS (BCTR,&FROM(1),&FROM(3))
 MEXIT
.BCTR1 AIF (T'&BY NE 'O').FB
 AIF (T'&TO EQ 'O').FONLY
 PUSHINS (BXLE,&FROM(1),&TO(1),&LIND(&LI))
 MEXIT
.FONLY PUSHINS (BCT,&FROM(1),&LIND(&LI))
 MEXIT
.FB AIF (T'&TO NE 'O').FTB
 AIF ('&BY(2)' EQ '').GENBXLE
 AIF ('&BY(2)'(1,1) NE '-').GENBXLE
 AGO .GENBXH
.FTB AIF ('&TO(2)' EQ '' OR '&FROM(2)' EQ '').GENBXLE
 AIF ('&FROM(2)'(1,1) EQ '-').TRYTNEG
 AIF (T'&FROM(2) NE 'N').GENBXLE
 AIF ('&TO(2)'(1,1) EQ '-').GENBXH
 AIF (T'&TO(2) NE 'N').GENBXLE
 AIF (&FROM(2) GT &TO(2)).GENBXH
.GENBXLE PUSHINS (BXLE,&FROM(1),&BY(1),&LIND(&LI))
 MEXIT
.TRYTNEG AIF ('&TO(2)'(1,1) NE '-').GENBXLE
 AIF ('&FROM(2)'(2,7) GE '&TO(2)'(2,7)).GENBXLE
.GENBXH PUSHINS (BXH,&FROM(1),&BY(1),&LIND(&LI))
 MEXIT
.NOIND AIF (T'&WHILE EQ 'O').NOWHILE
 AIF (T'&UNTIL NE 'O').COMPGEN
 BC 15,&LIND(&LI)
 PUSHLAB
&LI SETA &LI-1
&LIND(&LI+1) EQU *
 AIF ('&WHILE(6)' EQ '').OKSUBL
 STKINS &WHILE
 MEXIT
.OKSUBL STKINS (&WHILE(1),&WHILE(2),&WHILE(3),&WHILE(4), X
 &WHILE(5),&LIND(&LI))
 AIF ('&WHILE(2)' EQ '').LABEL
 PUSHINS (BC,&CCVAL,&LIND(&LI+1))
 MEXIT
.LABEL PUSHINS (BC,&CCVAL,&LIND(&LI+1),,,&LIND(&LI))
 MEXIT
.NOWHILE AIF (T'&UNTIL EQ 'O').TRYINF
&LIND(&LI) EQU *
.UNT STKINS &UNTIL
 PUSHINS (BC,15-&CCVAL,&LIND(&LI))
 MEXIT
.TRYINF AIF ('&P1' NE 'INF').ERRMG1
&LIND(&LI) EQU *
 PUSHINS (BC,15,&LIND(&LI))
 MEXIT
.COMPGEN AIF ('&WHILE(6)' EQ '').OK
 STKINS &WHILE
 AGO .BCHINST
.OK STKINS (&WHILE(1),&WHILE(2),&WHILE(3),&WHILE(4), X
 &WHILE(5),&LIND(&LI))
 AIF (N'&WHILE GT 1).ENDCOMP
&LIND(&LI) BC 15-&CCVAL,&LIND(&LI-1)
 AGO .FLAGEQU
.ENDCOMP ANOP
&ST(&NI+1) SETA &II
 POPINS &ST(&NI+1)
.BCHINST BC 15-&CCVAL,&LIND(&LI-1)
.FLAGEQU ANOP
&NEST(&NI) SETC ' Y'.'&NEST(&NI)'(5,4)
 AIF (T'&FROM NE 'O').POSTIND
 AGO .UNT
.ERRMG MNOTE 4,'POSITIONAL PARAMETER IGNORED. BCT/BCTR LOOP END USED'
 MEXIT
.ERRMG2 MNOTE 4,'UNTIL KEYWORD INVALID WITH INDEXING GROUP. IGNORED'
 AGO .CKWHILE
.ERRMG1 MNOTE 4,'NO WHILE,UNTIL, OR INDEXING PARAMETERS ON DO MACRO.'
 MEND
./ ADD NAME=ELSE
 MACRO
 ELSE
 COPY GBLVARS
&LIND(&LI+1) SETC '&LIND(&LI)'
&LI SETA &LI-1
 PUSHLAB
 BC 15,&LIND(&LI)
&LIND(&LI+1) EQU *
 MEND
./ ADD NAME=ENDCASE
 MACRO
 ENDCASE
 COPY GBLVARS
 LCLA &K,&I
 AIF ('&NEST(&NI)'(4,1) EQ 'B').BVECT1
 L &RIND(&AI),&LIND(&LI-1)
 BCR 15,&RIND(&AI)
&LIND(&LI-1) DC A(&LIND(&LI))
 AGO .BLDVECT
.BVECT1 ANOP
&LIND(&LI-1) BC 15,&LIND(&LI)
.BLDVECT AIF (&AIND(&AI) LE 0).TESTCI
&K SETA &MULT(&AI)
.LOOPIN ANOP
&I SETA 1
.LOOP1 AIF (&K EQ &CIND1(&CI-&I+1)).ELEND
 AIF (&I EQ &AIND(&AI)).GENTRY
&I SETA &I+1
 AGO .LOOP1
.GENTRY AIF ('&NEST(&NI)'(4,1) EQ 'B').BVECT2
 DC A(&LIND(&LI))
 AGO .INCRK
.ELEND AIF ('&NEST(&NI)'(4,1) EQ 'B').BVECT3
 DC A(&CIND2(&CI-&I+1))
 AGO .DECSTK
.BVECT3 BC 15,&CIND2(&CI-&I+1)
.DECSTK ANOP
&AIND(&AI) SETA &AIND(&AI)-1
&CI SETA &CI-1
 AIF (&AIND(&AI) EQ 0).TESTCI
.LOOP2 AIF (&I EQ 1).INCRK
&I SETA &I-1
&CIND1(&CI-&I+1) SETA &CIND1(&CI-&I+2)
&CIND2(&CI-&I+1) SETC '&CIND2(&CI-&I+2)'
 AGO .LOOP2
.BVECT2 BC 15,&LIND(&LI)
.INCRK ANOP
&K SETA &K+&MULT(&AI)
 AGO .LOOPIN
.TESTCI AIF (&CI LT 0).ASTKERR
&LIND(&LI) EQU *
&LI SETA &LI-2
&AI SETA &AI-1
 POPNEST CASE
 AIF (&AI LT 0).ASTKERR
 MEXIT
.ASTKERR MNOTE 8,'NEGATIVE CASE MACRO STACK PTR. EXPANSION INVALID.'
 MEND
./ ADD NAME=ENDDO
 MACRO
 ENDDO
 GBLA &ST(51),&NI,&LI,&II
 POPINS &ST(&NI)
&II SETA &II-1
 POPNEST DO
&LI SETA &LI-2
 MEND
./ ADD NAME=ENDIF
 MACRO
 ENDIF
 COPY GBLVARS
 POPNEST IF
&LIND(&LI) EQU *
&LI SETA &LI-1
 MEND
./ ADD NAME=ENDLOOP
 MACRO
 ENDLOOP
 COPY GBLVARS
 AIF ('&NEST(&NI)'(3,1) EQ 'P').CALLEND
 BC 15,&LIND(&LI-3)
&LIND(&LI) EQU *
.CALLEND ANOP
&NEST(&NI) SETC ' '.'&NEST(&NI)'(4,5)
 POPINS &ST(&NI)
&II SETA &II-1
&LI SETA &LI-3
 MEND
./ ADD NAME=ENDSRCH
 MACRO
 ENDSRCH
 COPY GBLVARS
 POPNEST SRCH
&LIND(&LI) EQU *
&LI SETA &LI-1
 MEND
./ ADD NAME=EXITIF
 MACRO
 EXITIF &P1,&P2,&P3,&P4,&P5,&P6,&P7,&P8,&P9,&P10,&P11,&P12,&P13,X
 &P14,&P15,&P16,&P17,&P18,&P19,&P20,&P21,&P22,&P23,&P24,&X
 P25,&P26,&P27,&P28,&P29,&P30,&P31,&P32,&P33,&P34,&P35,&PX
 36,&P37,&P38,&P39,&P40,&P41,&P42,&P43,&P44,&P45,&P46,&P4X
 7,&P48,&P49,&P50,&CC=
 IFPROC &CC,&P1,&P2,&P3,&P4,&P5,&P6,&P7,&P8,&P9,&P10,&P11,&P12,X
 &P13,&P14,&P15,&P16,&P17,&P18,&P19,&P20,&P21,&P22,&P23,&X
 P24,&P25,&P26,&P27,&P28,&P29,&P30,&P31,&P32,&P33,&P34,&PX
 35,&P36,&P37,&P38,&P39,&P40,&P41,&P42,&P43,&P44,&P45,&P4X
 6,&P47,&P48,&P49,&P50
 MEND
./ ADD NAME=GBLVARS
 GBLA &CCVAL COND CODE VARIABLE
 GBLA &CTR MACRO PARAMETER COUNTER
 GBLA &SEQ LABEL NUMBER GENERATOR
 GBLA &AI INDEX FOR TOTAL NO. CASES STK
 GBLA &CI INDEX FOR CASE AND LBL NO.STKS
 GBLA &II PTR TO INST STKS
 GBLA &LI INDEX FOR LABEL NUMBER STK
 GBLA &NI PTR TO NEST STK
 GBLA &AIND(50) TOTAL CASES STK
 GBLA &CIND1(200) CASE NUMBER STK
 GBLA &MULT(50) CASE NUMBER MULTIPLIER
 GBLA &ST(51) INST STK INCREASE AT EACH LEVEL
 GBLC &CIND2(200) LABEL NUMBER STK FOR CASES
 GBLC &IIND1(100) INSTRUCTION STK 1
 GBLC &IIND2(100) INSTRUCTION STK 2
 GBLC &I22(100) INSTRUCTION STK 2, 2ND PART
 GBLC &I23(100) INSTRUCTION STK 2, 3RD PART
 GBLC &I24(100) INSTRUCTION STK 2, 4TH PART
 GBLC &IIND3(100) INSTRUCTION STK 3
 GBLC &I32(100) INSTRUCTION STK 3, 2ND PART
 GBLC &I33(100) INSTRUCTION STK 3, 3RD PART
 GBLC &I34(100) INSTRUCTION STK 3, 4TH PART
 GBLC &IIND4(100) INSTRUCTION STK 4
 GBLC &I42(100) INSTRUCTION STK 4, 2ND PART
 GBLC &I43(100) INSTRUCTION STK 4, 3RD PART
 GBLC &IIND5(100) INSTRUCTION NAME STACK
 GBLC &LIND(101) LABEL NUMBER STK
 GBLC &NEST(50) NESTING STK
 GBLC &RIND(50) REG STK FOR CASENTRY MACRO
./ ADD NAME=GETCC
 MACRO
 GETCC &COND
 GBLA &CCVAL
 LCLC &LWK1
 AIF ('&COND'(1,1) LT '0' OR '&COND'(1,1) GT '9').NOTNUM
&CCVAL SETA &COND
 MEXIT
.NOTNUM AIF (K'&COND NE 1).TWOCHAR
&LWK1 SETC '&COND'
 AGO .CALCC
.TWOCHAR AIF (K'&COND NE 2).INVCOND
 AIF ('&COND'(1,1) NE 'N').OTHERMN
&LWK1 SETC '&COND'(2,1)
 AGO .CALCC
.OTHERMN AIF ('&COND' EQ 'EQ').BC8
 AIF ('&COND' EQ 'LT').BC4
 AIF ('&COND' NE 'LE').TRYGT
&CCVAL SETA 13
 MEXIT
.TRYGT AIF ('&COND' EQ 'GT').BC2
 AIF ('&COND' NE 'GE').INVCOND
&CCVAL SETA 11
 MEXIT
.CALCC AIF ('&LWK1' NE 'O').TRYH
&CCVAL SETA 1
 AGO .TSTN
.TRYH AIF ('&LWK1' EQ 'P' OR '&LWK1' EQ 'H').BC2
 AIF ('&LWK1' EQ 'L' OR '&LWK1' EQ 'M').BC4
 AIF ('&LWK1' EQ 'E' OR '&LWK1' EQ 'Z').BC8
 AGO .INVCOND
.BC8 ANOP
&CCVAL SETA 8
 AGO .TSTN
.BC4 ANOP
&CCVAL SETA 4
 AGO .TSTN
.BC2 ANOP
&CCVAL SETA 2
.TSTN AIF ('&COND'(1,1) NE 'N').DONE
&CCVAL SETA 15-&CCVAL
.DONE MEXIT
.INVCOND ANOP
&CCVAL SETA 15
 MNOTE 4,'INVALID CONDITION MNEMONIC. NOP GENERATED'
 MEND
./ ADD NAME=IF
 MACRO
 IF &P1,&P2,&P3,&P4,&P5,&P6,&P7,&P8,&P9,&P10,&P11,&P12,&P13,X
 &P14,&P15,&P16,&P17,&P18,&P19,&P20,&P21,&P22,&P23,&P24,&X
 P25,&P26,&P27,&P28,&P29,&P30,&P31,&P32,&P33,&P34,&P35,&PX
 36,&P37,&P38,&P39,&P40,&P41,&P42,&P43,&P44,&P45,&P46,&P4X
 7,&P48,&P49,&P50,&CC=
 PUSHNEST IF
 PUSHLAB
 IFPROC &CC,&P1,&P2,&P3,&P4,&P5,&P6,&P7,&P8,&P9,&P10,&P11,&P12,X
 &P13,&P14,&P15,&P16,&P17,&P18,&P19,&P20,&P21,&P22,&P23,&X
 P24,&P25,&P26,&P27,&P28,&P29,&P30,&P31,&P32,&P33,&P34,&PX
 35,&P36,&P37,&P38,&P39,&P40,&P41,&P42,&P43,&P44,&P45,&P4X
 6,&P47,&P48,&P49,&P50
 MEND
./ ADD NAME=IFPROC
 MACRO
 IFPROC
 COPY GBLVARS
 LCLB &ANDIND,&ORIND
 PUSHLAB
&CTR SETA 2
&ST(&NI+1) SETA &II+1
&NEST(&NI) SETC ' R'.'&NEST(&NI)'(4,5)
 AIF (T'&SYSLIST(1) EQ 'O').LOOP
 AIF (&SYSLIST(1) LE 0 OR &SYSLIST(1) GE 15).INVALCC
&CCVAL SETA &SYSLIST(1)
 AIF ('SYSLIST(2)' EQ '').ENDBOOL
 MNOTE 4,'CC KEYWORD USED. OTHER PARAMETERS IGNORED'
 AGO .ENDBOOL
.INVALCC MNOTE 4,'CC OUTSIDE VALID RANGE OF 1 TO 14. NOP GENERATED'
&CCVAL SETA 15
 AGO .ENDBOOL
.LOOP STKINS &SYSLIST(&CTR),&SYSLIST(&CTR+1),&SYSLIST(&CTR+2), X
 &SYSLIST(&CTR+3),&SYSLIST(&CTR+4)
 AIF ('&SYSLIST(&CTR+1)' EQ 'AND').ANDPROC
 AIF ('&SYSLIST(&CTR+1)' NE 'ANDIF').TESTOR
.ANDPROC PUSHINS (BC,15-&CCVAL,&LIND(&LI-1))
&ANDIND SETB 1
 AIF ('&SYSLIST(&CTR+1)' NE 'ANDIF' OR NOT &ORIND).TESTLP
 POPINS &ST(&NI+1)
&LIND(&LI) EQU *
&ORIND SETB 0
&LI SETA &LI-1
 PUSHLAB
 AGO .TESTLP
.TESTOR AIF ('&SYSLIST(&CTR+1)' EQ 'OR').ORPROC
 AIF ('&SYSLIST(&CTR+1)' NE 'ORIF').TESTLP
.ORPROC PUSHINS (BC,&CCVAL,&LIND(&LI))
&ORIND SETB 1
 AIF ('&SYSLIST(&CTR+1)' NE 'ORIF' OR NOT &ANDIND).TESTLP
 PUSHINS (EQU,*,,,,&LIND(&LI-1))
&ANDIND SETB 0
 PUSHLAB
&LI SETA &LI-1
&LIND(&LI-1) SETC '&LIND(&LI+1)'
.TESTLP ANOP
&CTR SETA &CTR+2
 AIF ('&SYSLIST(&CTR-1)' NE '').LOOP
.ENDBOOL AIF ('&NEST(&NI)'(5,4) EQ 'DO').DOEND
 POPINS &ST(&NI+1)
 BC 15-&CCVAL,&LIND(&LI-1)
 AIF (NOT &ORIND).POPLBL
&LIND(&LI) EQU *
.POPLBL ANOP
&LI SETA &LI-1
 MEXIT
.DOEND ANOP
&CTR SETA &ST(&NI+1)
 AGO .ENDLBL
.NXTLBL AIF ('&IIND3(&CTR)' NE '&LIND(&LI)').INCTR
&IIND3(&CTR) SETC '&LIND(&LI-3)'
.INCTR ANOP
&CTR SETA &CTR+1
.ENDLBL AIF (&CTR LE &II).NXTLBL
 POPINS &ST(&NI+1)
 BC &CCVAL,&LIND(&LI-3)
 AIF (NOT &ANDIND).POP2LBL
&LIND(&LI-1) EQU *
.POP2LBL ANOP
&LI SETA &LI-2
&NEST(&NI) SETC ' Y'.'&NEST(&NI)'(5,4)
 MEND
./ ADD NAME=MACROS
 COPY CASE
 COPY CASENTRY
 COPY CHKSTACK
 COPY DO
 COPY DOEXIT
 COPY DOPROC
 COPY ELSE
 COPY ENDCASE
 COPY ENDDO
 COPY ENDIF
 COPY ENDLOOP
 COPY ENDSRCH
 COPY EXITIF
 COPY GETCC
 COPY IF
 COPY IFPROC
 COPY ORELSE
 COPY POPINS
 COPY POPNEST
 COPY PUSHINS
 COPY PUSHLAB
 COPY PUSHNEST
 COPY STKINS
 COPY STRTSRCH
./ ADD NAME=ORELSE
 MACRO
 ORELSE
 COPY GBLVARS
&LIND(&LI+1) SETC '&LIND(&LI)'
&LI SETA &LI-1
 PUSHLAB
 BC 15,&LIND(&LI-3)
&LIND(&LI+1) EQU *
&NEST(&NI) SETC ' P'.'&NEST(&NI)'(4,5)
 MEND
./ ADD NAME=POPINS
 MACRO
 POPINS &P
 COPY GBLVARS
 LCLA &W
&W SETA &P
 AGO .TEST
.UNSTACK AIF ('&IIND3(&W)' EQ '').ONEOP
 AIF ('&IIND4(&W)' NE '').THREEOP
&IIND5(&W) &IIND1(&W) &IIND2(&W)&I22(&W)&I23(&W)&I24(&W),&IIND3(&W)X
 &I32(&W)&I33(&W)&I34(&W)
 AGO .INCTR
.THREEOP ANOP
&IIND5(&W) &IIND1(&W) &IIND2(&W)&I22(&W)&I23(&W)&I24(&W),&IIND3(&W)X
 &I32(&W)&I33(&W)&I34(&W),&IIND4(&W)&I42(&W)&I43(&W)
 AGO .INCTR
.ONEOP ANOP
&IIND5(&W) &IIND1(&W) &IIND2(&W)&I22(&W)&I23(&W)&I24(&W)
.INCTR ANOP
&W SETA &W+1
.TEST AIF (&W LE &II).UNSTACK
&II SETA &P-1
 AIF ('&NEST(&NI)'(3,1) NE ' ' OR '&NEST(&NI)'(4,1) EQ ' ').NEQ
&IIND5(&II) &IIND1(&II) &IIND2(&II)
.NEQ AIF (&II GT 0 OR (&II EQ 0 AND '&NEST(&NI)'(5,4) EQ 'IF')).END
 MNOTE 8,'NEGATIVE INSTRUCTION STACK PTR. EXPANSION INVALID.'
.END MEND
./ ADD NAME=POPNEST
 MACRO
 POPNEST &P1
 COPY GBLVARS
 LCLC &SUFFIX
&SUFFIX SETC '&NEST(&NI)'(5,4)
 AIF ('&NEST(&NI)'(5,4) EQ '&P1').GOOD
 MNOTE 8,'&SUFFIX MACRO AT SAME LEVEL AS &P1 TERMINATOR.'
.GOOD ANOP
&NI SETA &NI-1
 AIF (&NI GE 0).OK
 MNOTE 8,'NEGATIVE NEST STACK POINTER. CHECK NUMBER OF ENDS.'
.OK MEND
./ ADD NAME=PUSHINS
 MACRO
 PUSHINS &PAM
 COPY GBLVARS
 LCLA &WK,&I,&J,&K
&I SETA 3
&J SETA 4
&K SETA 4
 AIF ('&PAM(1)' NE 'TS').NOTTS
&J SETA 3
&I SETA 5
 AGO .SETK
.NOTTS AIF ('&PAM(1)' EQ 'BAL' OR '&PAM(1)' EQ 'BALR').SETK
 AIF ('&PAM(1)'(1,1) EQ 'B' OR '&PAM(1)' EQ 'EQU').BCH
 AIF ('&PAM(5)' EQ '').TWOPERS
 AIF ('&PAM(1)'(1,1) EQ 'C').SETK
&J SETA 5
 AGO .GETCOND
.TWOPERS AIF ('&PAM(1)'(1,1) NE 'C').SETK
&I SETA 4
&J SETA 3
.SETK ANOP
&K SETA 5
.GETCOND GETCC &PAM(&J)
.BCH AIF (&II GE 100).OVERI
&II SETA &II+1
&IIND1(&II) SETC '&PAM(1)'
&IIND2(&II) SETC '&PAM(2)'(1,8)
&WK SETA K'&SYSLIST(1,2)
 AIF (&WK GE 25).LD24
&I24(&II) SETC ''
 AIF (&WK GE 17).LD23
&I23(&II) SETC ''
 AIF (&WK GE 9).LD22
&I22(&II) SETC ''
 AGO .PAM3
.LD24 ANOP
&I24(&II) SETC '&PAM(2)'(25,8)
.LD23 ANOP
&I23(&II) SETC '&PAM(2)'(17,8)
.LD22 ANOP
&I22(&II) SETC '&PAM(2)'(9,8)
.PAM3 AIF ('&PAM(&I)' NE '').LD31
&IIND3(&II) SETC ''
 AGO .BLKOUT3
.LD31 ANOP
&IIND3(&II) SETC '&PAM(&I)'(1,8)
.BLKOUT3 ANOP
&WK SETA K'&SYSLIST(1,&I)
 AIF (&WK GE 25).LD34
&I34(&II) SETC ''
 AIF (&WK GE 17).LD33
&I33(&II) SETC ''
 AIF (&WK GE 9).LD32
&I32(&II) SETC ''
 AGO .PAM4
.LD34 ANOP
&I34(&II) SETC '&PAM(&I)'(25,8)
.LD33 ANOP
&I33(&II) SETC '&PAM(&I)'(17,8)
.LD32 ANOP
&I32(&II) SETC '&PAM(&I)'(9,8)
.PAM4 AIF ('&PAM(&K)' NE '').LD41
&IIND4(&II) SETC ''
 AGO .BLKOUT4
.LD41 ANOP
&IIND4(&II) SETC '&PAM(&K)'(1,8)
.BLKOUT4 ANOP
&WK SETA K'&SYSLIST(1,&K)
 AIF (&WK GE 17).LD43
&I43(&II) SETC ''
 AIF (&WK GE 9).LD42
&I42(&II) SETC ''
 AGO .PAM5
.LD43 ANOP
&I43(&II) SETC '&PAM(&K)'(17,8)
.LD42 ANOP
&I42(&II) SETC '&PAM(&K)'(9,8)
.PAM5 AIF ('&PAM(6)' EQ '').BLKOUT5
 AIF ('&PAM(6)'(1,4) NE '#@LB').BLKOUT5
&IIND5(&II) SETC '&PAM(6)'
 MEXIT
.BLKOUT5 ANOP
&IIND5(&II) SETC ''
 MEXIT
.OVERI MNOTE 8,'INSTRN STK SIZE EXCEEDED. FURTHER EXPANSIONS INVALID'
 MEND
./ ADD NAME=PUSHLAB
 MACRO
 PUSHLAB
 COPY GBLVARS
 AIF (&LI GE 100).OVER
&SEQ SETA &SEQ+1
&LI SETA &LI+1
&LIND(&LI) SETC '#@LB&SEQ'
 MEXIT
.OVER MNOTE 8,' LABEL STK SIZE EXCEEDED. FURTHER EXPANSIONS INVALID'
 MEND
./ ADD NAME=PUSHNEST
 MACRO
 PUSHNEST &P1
 COPY GBLVARS
&NI SETA &NI+1
 AIF (&NI GE 50).OVER
&NEST(&NI) SETC ' '.'&P1'
 MEXIT
.OVER MNOTE 8,'NEST STACK SIZE EXCEEDED. FURTHER EXPANSIONS INVALID'
 MEND
./ ADD NAME=STKINS
 MACRO
 STKINS &P1,&P2,&P3,&P4,&P5,&P6
 COPY GBLVARS
 AIF ('&P1(2)' EQ '').NOTSUBL
 AIF ('&P1(6)' EQ '' OR '&P1(6)' EQ '&LIND(&LI)').OKSUBL
 MNOTE 12,'TOO MANY OPERANDS INSIDE PARENTHESES'
 MEXIT
.OKSUBL PUSHINS (&P1(1),&P1(2),&P1(3),&P1(4),&P1(5),&P1(6))
 MEXIT
.NOTSUBL AIF ('&P2' EQ '' OR '&P2' EQ 'OR' OR '&P2' EQ 'AND' OR '&P2'X
 EQ 'ORIF' OR '&P2' EQ 'ANDIF').SGLOPR
 AIF ('&P5' EQ 'OR' OR '&P5' EQ 'AND' OR '&P5' EQ 'ORIF' OR X
 '&P5' EQ 'ANDIF').TWOPER2
 PUSHINS (&P1,&P2,&P3,&P4,&P5,&P6)
&CTR SETA &CTR+4
 MEXIT
.TWOPER2 PUSHINS (&P1,&P2,&P3,&P4,,&P6)
&CTR SETA &CTR+3
 MEXIT
.SGLOPR GETCC &P1(1)
 MEND
./ ADD NAME=STRTSRCH
 MACRO
 STRTSRCH &P1,&FROM=,&TO=,&BY=,&UNTIL=,&WHILE=
 PUSHLAB
 PUSHNEST SRCH
 DOPROC &FROM,&TO,&BY,&UNTIL,&WHILE,&P1
 PUSHLAB
 MEND
/*