The Concept 14 macros were written by Marvin Kessler while at IBM, Federal Systems Division. I've included them here in IEBUPDTE fashion for convenience. For coding instructions, see Appendix III of Kessler's original paper.
./ 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
/*