Concept 14 Macros

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