home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
ibmtsonih.zip
/
tsnmac.alp
< prev
next >
Wrap
Text File
|
1986-12-18
|
278KB
|
9,209 lines
//MWCMACRO JOB (ZZXZ,504,E,60,30),'COMMON MACROS'
/*ROUTE XEQ MSS
/*RERUN
/*CNTL MILWYL,EXCLUSIVE
//PROCLIB DD DSN=ZZXZMWC.PROCLIB.XA,DISP=SHR
// EXEC MWCMLIBF,LIBRARY=COMMON,SIZE=350,INCR=50,DIR=20
//SYSIN DD *
./ ADD LIST=ALL,NAME=AAAAAAAA
TITLE 'COMMON MACRO LIBRARY';
BAL;
./ ADD LIST=ALL,NAME=ADDB
MACRO
&L ADDB &R,&A
GBLC &SIM370
&L MMVC 4*3+3+&SIM370,&A,1
AL &R,4*3+&SIM370
MEND
./ ADD LIST=ALL,NAME=ADDF
MACRO
&L ADDF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP A,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
A &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=ADDH
MACRO
&L ADDH &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP AH,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,2
AH &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=ADDLF
MACRO
&L ADDLF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP AL,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
AL &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=ADDLH
MACRO
&L ADDLH &R,&A
GBLC &SIM370
&L MMVC 4*2+2+&SIM370,&A,2
AL &R,4*2+&SIM370
MEND
./ ADD LIST=ALL,NAME=ADDP
MACRO
&L ADDP &R,&A
GBLC &SIM370
&L MMVC 4*1+1+&SIM370,&A,3
AL &R,4*1+&SIM370
MEND
./ ADD LIST=ALL,NAME=AI
MACRO
&L AI &R,&V
LCLA &X
.*
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).INT
AIF ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
.*
AIF ('&R' NE '0' AND '&R' NE 'R0' AND '&R' NE 'VR0').LA
&L AL &R,=A(&V)
MEXIT
.*
.INT ANOP
AIF ('&R' NE '0' AND '&R' NE 'R0' AND '&R' NE 'VR0' AND &V LT 4096).LA
&L AL &R,=F'&V'
MEXIT
.*
.LA ANOP
&L LA &R,&V.(,&R)
MEND
./ ADD LIST=ALL,NAME=APRIVSCN
ALP;
MACRO &&L: APRIVSCN &&BYTE,&&TYPE=;
LCLC &&LBL;
&&LBL: SETC 'ASCN&SYSNDX';
SYSKWT TYPE,&&TYPE,(NO),COND=NO;
&&L: SYSLBL;
BEGIN SCAN *;
SCKW &&TYPE.MAILBOX,&&LBL,CODE=AL1(KWRAFMB);
SCKW &&TYPE.MAILPEND,&&LBL,CODE=AL1(KWRAFMP);
SCKW &&TYPE.PROFILE,&&LBL,CODE=AL1(KWRAFPRO);
SCKW &&TYPE.MILTENRECOVERY,&&LBL,CODE=AL1(KWRAFRCM);
SCKW &&TYPE.TSORECOVERY,&&LBL,CODE=AL1(KWRAFRCT);
SCKW ,*,B;
&&LBL:
ASM IF ('&TYPE' EQ 'NO')
THEN <X VRE,=XL4'FF'; EXI VRE,NI,&&BYTE,0>
ELSE EXI VRE,OI,&&BYTE,0;
SCANEND; END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=APRIVSEG
ALP;
MACRO &&L: APRIVSEG &&BYTE,&&BEFORE=,&&AFTER=,&&VAREA=;
&&L: SYSLBL;
SELECT;
<TM &&BYTE,KWRAFMB>: BEGIN
APRIVSG1 'MAILBOX',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRAFMP>: BEGIN
APRIVSG1 'MAILPEND',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRAFPRO>: BEGIN
APRIVSG1 'PROFILE',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRAFRCM>: BEGIN
APRIVSG1 'MILTENRECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRAFRCT>: BEGIN
APRIVSG1 'TSORECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
ENDSEL;
MEND;
BAL;
./ ADD LIST=ALL,NAME=APRIVSG1
ALP;
MACRO &&L: APRIVSG1 &&STRING,&&BEFORE=,&&AFTER=,&&VAREA=;
&&L: SYSLBL;
ASM IF ('&BEFORE' NE '')
THEN APRIVSG2 &&VAREA,&&BEFORE(1),&&BEFORE(2);
APRIVSG2 &&VAREA,&&STRING(1),&&STRING(2);
ASM IF ('&AFTER' NE '')
THEN APRIVSG2 &&VAREA,&&AFTER(1),&&AFTER(2);
MEND;
BAL;
./ ADD LIST=ALL,NAME=APRIVSG2
ALP;
MACRO &&L: APRIVSG2 &&VAREA,&&A,&&N;
&&L: SYSLBL;
ASM IF ('&VAREA' EQ '')
THEN TSEG &&A,&&N
ELSE VSEG &&VAREA,&&A,&&N;
MEND;
BAL;
./ ADD LIST=ALL,NAME=AREA
MACRO
&L AREA &ALIGN,&DSECT=
GBLC &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
GBLA &AREAN,&AREAP(10)
.*
SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
SYSKWT DSECT,&DSECT,(YES,NO),COND=NO
.*
AIF (&AREAN EQ 0 OR '&DSECT' NE 'YES').OKDSECT
MNOTE 12,'"DSECT=YES" ILLEGAL FOR NESTED AREA'
.OKDSECT ANOP
.*
&AREAN SETA &AREAN+1
&AREAL(&AREAN) SETC '&L'
AIF ('&L' NE '').LBL
&AREAL(&AREAN) SETC 'AREA&SYSNDX'
.LBL ANOP
&AREAC(&AREAN) SETC '*'
.*
&AREAB(&AREAN) SETC '0X'
AIF ('&ALIGN' EQ '').AOK
&AREAB(&AREAN) SETC '&ALIGN'
AIF ('&ALIGN'(1,1) EQ '0').AOK
&AREAB(&AREAN) SETC '0&ALIGN'
.AOK ANOP
.*
&AREAP(&AREAN) SETA 0
.*
AIF (('&DSECT' EQ '' OR '&DSECT' EQ 'YES') AND &AREAN EQ 1).DSECT
&AREAL(&AREAN) DS &AREAB(&AREAN)
MEXIT
.*
.DSECT ANOP
&AREAC(&AREAN) SETC '&SYSECT'
&AREAL(&AREAN) DSECT
MEND
./ ADD LIST=ALL,NAME=AREAEND
MACRO
&L AREAEND &ALIGN
GBLC &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
GBLA &AREAN,&AREAP(10)
.*
SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
AIF (&AREAN LE 0).ERR
.*
AIF ('&ALIGN' EQ '').AOK
&AREAB(&AREAN) SETC '&ALIGN'
AIF ('&ALIGN'(1,1) EQ '0').AOK
&AREAB(&AREAN) SETC '0&ALIGN'
.AOK ANOP
.*
DS &AREAB(&AREAN)
.*
AIF (&AREAP(&AREAN) LE 0).NORG
.ORGLOOP ANOP
ORGHIGH *,&AREAO(&AREAP(&AREAN)),BASE=&AREAL(&AREAN)
&AREAP(&AREAN) SETA &AREAP(&AREAN)-1
AIF (&AREAP(&AREAN) LE 0).NORG
AIF (&AREAN LE 1).ORGLOOP
AIF (&AREAP(&AREAN) GT &AREAP(&AREAN-1)).ORGLOOP
.NORG ANOP
.*
AIF ('&L' EQ '').NLEN
&L EQU *-&AREAL(&AREAN)
.NLEN ANOP
.*
AIF ('&AREAC(&AREAN)' EQ '*').NCSECT
&AREAC(&AREAN) CSECT
.NCSECT ANOP
.*
&AREAN SETA &AREAN-1
MEXIT
.*
.ERR ANOP
MNOTE 12,'NO MATCHING AREA MACRO'
MEND
./ ADD LIST=ALL,NAME=AREAORG
MACRO
&L AREAORG &ALIGN
GBLC &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
GBLA &AREAN,&AREAP(10)
LCLC &A
.*
SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
AIF (&AREAN LE 0).ERR
.*
&A SETC '&AREAB(&AREAN)'
AIF ('&ALIGN' EQ '').AOK
&A SETC '&ALIGN'
AIF ('&ALIGN'(1,1) EQ '0').AOK
&A SETC '0&ALIGN'
.AOK ANOP
.*
AIF ('&A' EQ '0X' OR '&A' EQ '0C').NDS
DS &A
.NDS ANOP
.*
AIF ('&L' EQ '').NLEN
&L EQU *-&AREAL(&AREAN)
.NLEN ANOP
.*
&AREAP(&AREAN) SETA &AREAP(&AREAN)+1
AIF (&AREAP(&AREAN) GT 1 OR &AREAN EQ 1).NPREV
&AREAP(&AREAN) SETA &AREAP(&AREAN-1)+1
.NPREV ANOP
.*
AREA&SYSNDX EQU *
&AREAO(&AREAP(&AREAN)) SETC 'AREA&SYSNDX'
ORG &AREAL(&AREAN)
MEXIT
.*
.ERR ANOP
MNOTE 12,'NO MATCHING AREA MACRO'
MEND
./ ADD LIST=ALL,NAME=BEH
MACRO
&L BEH &A
&L BNL &A
MEND
./ ADD LIST=ALL,NAME=BEHR
MACRO
&L BEHR &R
&L BNLR &R
MEND
./ ADD LIST=ALL,NAME=BER
MACRO
&L BER &R
&L BCR 8,&R
MEND
./ ADD LIST=ALL,NAME=BHR
MACRO
&L BHR &R
&L BCR 2,&R
MEND
./ ADD LIST=ALL,NAME=BLDLLIST
MACRO
&L BLDLLIST &LENGTH=58
LCLA &C,&X,&Y,&Z
LCLB &SW(32)
.*
&L DC Y(BLDL&SYSNDX,&LENGTH)
.*
&X SETA 0-1
.LOOP ANOP
&X SETA &X+2
AIF (&X GT N'&SYSLIST).DONE
&Z SETA 0
&Y SETA 0-1
.SELECT ANOP
&Y SETA &Y+2
AIF (&Y GT N'&SYSLIST).HAVE
AIF ('&SYSLIST(&Y+1)' EQ '').SELECT
AIF (&SW(&Y)).SELECT
AIF (&Z EQ 0).LOW
AIF ('&SYSLIST(&Z+1) '(1,8) LE '&SYSLIST(&Y+1) '(1,8))*
.SELECT
.LOW ANOP
&Z SETA &Y
AGO .SELECT
.*
.HAVE ANOP
&SYSLIST(&Z) DC CL8'&SYSLIST(&Z+1)'
DC XL4'000000FF'
DC XL(&LENGTH-12)'00'
&SW(&Z) SETB 1
&C SETA &C+1
AGO .LOOP
.*
.DONE ANOP
BLDL&SYSNDX EQU &C
MEND
./ ADD LIST=ALL,NAME=BLE
MACRO
&L BLE &A
&L BNH &A
MEND
./ ADD LIST=ALL,NAME=BLER
MACRO
&L BLER &R
&L BNHR &R
MEND
./ ADD LIST=ALL,NAME=BLH
MACRO
&L BLH &A
&L BNE &A
MEND
./ ADD LIST=ALL,NAME=BLHR
MACRO
&L BLHR &R
&L BNER &R
MEND
./ ADD LIST=ALL,NAME=BLR
MACRO
&L BLR &R
&L BCR 4,&R
MEND
./ ADD LIST=ALL,NAME=BMP
MACRO
&L BMP &A
&L BNZ &A
MEND
./ ADD LIST=ALL,NAME=BMPR
MACRO
&L BMPR &R
&L BNZR &R
MEND
./ ADD LIST=ALL,NAME=BMZ
MACRO
&L BMZ &A
&L BNP &A
MEND
./ ADD LIST=ALL,NAME=BMZR
MACRO
&L BMZR &R
&L BNPR &R
MEND
./ ADD LIST=ALL,NAME=BMR
MACRO
&L BMR &R
&L BCR 4,&R
MEND
./ ADD LIST=ALL,NAME=BNEH
MACRO
&L BNEH &A
&L BL &A
MEND
./ ADD LIST=ALL,NAME=BNEHR
MACRO
&L BNEHR &R
&L BLR &R
MEND
./ ADD LIST=ALL,NAME=BNER
MACRO
&L BNER &R
&L BCR 7,&R
MEND
./ ADD LIST=ALL,NAME=BNHR
MACRO
&L BNHR &R
&L BCR 13,&R
MEND
./ ADD LIST=ALL,NAME=BNLE
MACRO
&L BNLE &A
&L BH &A
MEND
./ ADD LIST=ALL,NAME=BNLER
MACRO
&L BNLER &R
&L BHR &R
MEND
./ ADD LIST=ALL,NAME=BNLH
MACRO
&L BNLH &A
&L BE &A
MEND
./ ADD LIST=ALL,NAME=BNLHR
MACRO
&L BNLHR &R
&L BER &R
MEND
./ ADD LIST=ALL,NAME=BNLR
MACRO
&L BNLR &R
&L BCR 11,&R
MEND
./ ADD LIST=ALL,NAME=BNMP
MACRO
&L BNMP &A
&L BZ &A
MEND
./ ADD LIST=ALL,NAME=BNMPR
MACRO
&L BNMPR &R
&L BZR &R
MEND
./ ADD LIST=ALL,NAME=BNMZ
MACRO
&L BNMZ &A
&L BP &A
MEND
./ ADD LIST=ALL,NAME=BNMZR
MACRO
&L BNMZR &R
&L BPR &R
MEND
./ ADD LIST=ALL,NAME=BNMR
MACRO
&L BNMR &R
&L BCR 11,&R
MEND
./ ADD LIST=ALL,NAME=BNOR
MACRO
&L BNOR &R
&L BCR 14,&R
MEND
./ ADD LIST=ALL,NAME=BNPR
MACRO
&L BNPR &R
&L BCR 13,&R
MEND
./ ADD LIST=ALL,NAME=BNZP
MACRO
&L BNZP &A
&L BM &A
MEND
./ ADD LIST=ALL,NAME=BNZPR
MACRO
&L BNZPR &R
&L BMR &R
MEND
./ ADD LIST=ALL,NAME=BNZR
MACRO
&L BNZR &R
&L BCR 7,&R
MEND
./ ADD LIST=ALL,NAME=BOR
MACRO
&L BOR &R
&L BCR 1,&R
MEND
./ ADD LIST=ALL,NAME=BPR
MACRO
&L BPR &R
&L BCR 2,&R
MEND
./ ADD LIST=ALL,NAME=BZP
MACRO
&L BZP &A
&L BNM &A
MEND
./ ADD LIST=ALL,NAME=BZPR
MACRO
&L BZPR &R
&L BNMR &R
MEND
./ ADD LIST=ALL,NAME=BZR
MACRO
&L BZR &R
&L BCR 8,&R
MEND
./ ADD LIST=ALL,NAME=CAMODE
ALP;
MACRO &&L: CAMODE &&AMODE,&®=RTNR;
GBLC &&OS;
SYSKWT AMODE,&&AMODE,(24,31),NULL=NO,COND=NO;
ASM CASE '&OS';
'MVS','MVT','MFT': &&L: SYSLBL;
'XA': BEGIN
&&L:
LA &®,AMOD&&@;
ASM IF ('&AMODE' EQ '31') THEN O &®,=XL4'80000000';
BSM 0,&®
AMOD&&@: SYSLBL;
END;
ENDCASE;
MEND;
BAL;
./ ADD LIST=ALL,NAME=CBAL
ALP;
MACRO &&L: CBAL &®,&&ADDR;
GBLC &&CPU;
ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
THEN <&&L: BAL &®,&&ADDR>
ELSE <&&L: BAS &®,&&ADDR>;
MEND;
BAL;
./ ADD LIST=ALL,NAME=CBALR
ALP;
MACRO &&L: CBALR &®1,&®2;
GBLC &&CPU;
ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
THEN <&&L: BALR &®1,&®2>
ELSE <&&L: BASR &®1,&®2>;
MEND;
BAL;
./ ADD LIST=ALL,NAME=CBASE
ALP;
MACRO &&L: CBASE &®
GBLC &&CPU;
ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
THEN <&&L: BALR &®,0>
ELSE <&&L: BASR &®,0>;
MEND;
BAL;
./ ADD LIST=ALL,NAME=CBDELINK
MACRO
&L CBDELINK &PREV,&DEL,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=,&ZOT=
SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
AIF ('&BACK' NE '').BACK
&L L &WORK,&NEXT-&CB.(,&DEL)
LTR &PREV,&PREV
BNZ CBD&SYSNDX.A
ST &WORK,&HEAD
B *+8
CBD&SYSNDX.A ST &WORK,&NEXT-&CB.(,&PREV)
AIF ('&TAIL' EQ '').NTAIL
LTR &WORK,&WORK
BNZ *+8
ST &PREV,&TAIL
.NTAIL ANOP
AIF ('&ZOT' NE 'YES').END
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&DEL)
MEXIT
.*
.BACK ANOP
&L L &WORK,&NEXT-&CB.(,&DEL)
LTR &PREV,&PREV
BNZ CBD&SYSNDX.A
ST &WORK,&HEAD
B *+8
CBD&SYSNDX.A ST &WORK,&NEXT-&CB.(,&PREV)
AIF ('&TAIL' EQ '').NTAILB
LTR &WORK,&WORK
BNZ CBD&SYSNDX.B
ST &PREV,&TAIL
B *+8
AGO .TAILB
.*
.NTAILB ANOP
LTR &WORK,&WORK
BZ *+8
.TAILB ANOP
.*
CBD&SYSNDX.B ST &PREV,&BACK-&CB.(,&WORK)
AIF ('&ZOT' NE 'YES').END
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&DEL)
ST &WORK,&BACK-&CB.(,&DEL)
.END MEND
./ ADD LIST=ALL,NAME=CBINIT
ALP;
MACRO &&L: CBINIT &&TYPE,&&LOC,&&LEN,&&ALIGN=F;
GBLC &&CBINITB,&&CBINITE,&&CBINITL,&&CBINITA;
ASM CASE '&TYPE';
'BEGIN': BEGIN
ASM IF ('&CBINITB' NE '') THEN BEGIN
MNOTE 12,'MISSING CBINIT END';
&&CBINITE: SYSLBL;
END;
&&CBINITB: SETC 'CBI&@.B';
&&CBINITE: SETC 'CBI&@.E';
ASM IF ('&L' NE '') THEN <&&CBINITE: SETC '&L'>;
&&CBINITL: SETC 'CBI&@.L';
ASM IF ('&LEN' NE '') THEN <&&CBINITL: SETC '&LEN'>;
&&CBINITA: SETC '&LOC';
GOTO &&CBINITE;
&&CBINITB: DS 0&&ALIGN;
END;
'END': BEGIN
ASM IF ('&CBINITB' EQ '') THEN BEGIN
MNOTE 12,'NO MATCHING CBINIT BEGIN';
&&L: SYSLBL;
MEXIT;
END;
&&CBINITL: EQU *-&&CBINITB;
&&L: SYSLBL;
&&CBINITE: MMVC &&CBINITA,&&CBINITB,&&CBINITL;
&&CBINITB: SETC '';
END;
ENDCASE
ELSE BEGIN
MNOTE 12,'TYPE=&TYPE IS ILLEGAL';
&&L: SYSLBL;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=CBDLINKH
MACRO
&L CBDLINKH &DEL,&WORK,&HEAD=,&TAIL=,&NEXT=,&BACK=,&CB=0,&ZOT=
SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
AIF ('&BACK' NE '').BACK
&L L &WORK,&NEXT-&CB.(,&DEL)
ST &WORK,&HEAD
AIF ('&TAIL' EQ '').NTAIL
LTR &WORK,&WORK
BNZ *+8
ST &WORK,&TAIL
.NTAIL ANOP
AIF ('&ZOT' NE 'YES').END
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&DEL)
MEXIT
.*
.BACK ANOP
&L L &WORK,&NEXT-&CB.(,&DEL)
ST &WORK,&HEAD
LTR &WORK,&WORK
AIF ('&TAIL' EQ '').NTAILB
BZ CBD&SYSNDX
XC &BACK-&CB.(4,&WORK),&BACK-&CB.(&WORK)
B *+8
CBD&SYSNDX ST &WORK,&TAIL
AGO .ZOTB
.*
.NTAILB ANOP
BZ *+10
XC &BACK-&CB.(4,&WORK),&BACK-&CB.(&WORK)
.*
.ZOTB ANOP
AIF ('&ZOT' NE 'YES').END
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&DEL)
ST &WORK,&BACK-&CB.(,&DEL)
.END MEND
./ ADD LIST=ALL,NAME=CBDLINKT
MACRO
&L CBDLINKT &PREV,&DEL,&WORK,&HEAD=,&TAIL=,&NEXT=,&BACK=,&CB=0,&ZOT=
SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
AIF ('&BACK' NE '').BACK
&L ST &PREV,&TAIL
LTR &PREV,&PREV
BNZ *+8
ST &PREV,&HEAD
AIF ('&ZOT' NE 'YES').END
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&DEL)
MEXIT
.*
.BACK ANOP
&L ST &PREV,&TAIL
LTR &WORK,&PREV
BZ CBD&SYSNDX
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&PREV)
B *+8
CBD&SYSNDX ST &PREV,&HEAD
AIF ('&ZOT' NE 'YES').END
ST &WORK,&NEXT-&CB.(,&DEL)
ST &WORK,&BACK-&CB.(,&DEL)
.END MEND
./ ADD LIST=ALL,NAME=CBLINK
MACRO
&L CBLINK &CUR,&ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
AIF ('&BACK' NE '').BACK
&L LTR &CUR,&CUR
BNZ CBL&SYSNDX.A
L &WORK,&HEAD
ST &WORK,&NEXT-&CB.(,&ADD)
ST &ADD,&HEAD
B CBL&SYSNDX.B
CBL&SYSNDX.A L &WORK,&NEXT-&CB.(,&CUR)
ST &WORK,&NEXT-&CB.(,&ADD)
ST &ADD,&NEXT-&CB.(,&CUR)
AIF ('&TAIL' EQ '').NTAIL
CBL&SYSNDX.B LTR &WORK,&WORK
BNZ *+8
ST &ADD,&TAIL
MEXIT
.*
.NTAIL ANOP
CBL&SYSNDX.B DS 0H
MEXIT
.*
.BACK ANOP
&L LTR &CUR,&CUR
BNZ CBL&SYSNDX.A
ST &CUR,&BACK-&CB.(,&ADD)
L &WORK,&HEAD
ST &WORK,&NEXT-&CB.(,&ADD)
ST &ADD,&HEAD
B CBL&SYSNDX.B
CBL&SYSNDX.A L &WORK,&NEXT-&CB.(,&CUR)
ST &ADD,&NEXT-&CB.(,&CUR)
ST &WORK,&NEXT-&CB.(,&ADD)
ST &CUR,&BACK-&CB.(,&ADD)
CBL&SYSNDX.B LTR &WORK,&WORK
AIF ('&TAIL' EQ '').NTAILB
BNZ *+12
ST &ADD,&TAIL
B *+8
AGO .TAILB
.*
.NTAILB ANOP
BZ *+8
.TAILB ANOP
ST &ADD,&BACK-&CB.(,&WORK)
MEND
./ ADD LIST=ALL,NAME=CBLINKH
MACRO
&L CBLINKH &ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
AIF ('&BACK' NE '').BACK
&L L &WORK,&HEAD
ST &ADD,&HEAD
ST &WORK,&NEXT-&CB.(,&ADD)
AIF ('&TAIL' EQ '').END
LTR &WORK,&WORK
BNZ *+8
ST &ADD,&TAIL
MEXIT
.*
.BACK ANOP
&L L &WORK,&HEAD
ST &ADD,&HEAD
ST &WORK,&NEXT-&CB.(,&ADD)
LTR &WORK,&WORK
AIF ('&TAIL' EQ '').NTAILB
BNZ *+12
ST &ADD,&TAIL
B *+8
AGO .TAILB
.*
.NTAILB ANOP
BZ *+8
.TAILB ANOP
ST &ADD,&BACK-&CB.(,&WORK)
SLR &WORK,&WORK
ST &WORK,&BACK-&CB.(,&ADD)
.END MEND
./ ADD LIST=ALL,NAME=CBLINKT
MACRO
&L CBLINKT &ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
AIF ('&BACK' NE '').BACK
&L L &WORK,&TAIL
ST &ADD,&TAIL
LTR &WORK,&WORK
BNZ CBL&SYSNDX.A
ST &ADD,&HEAD
B *+8
CBL&SYSNDX.A ST &ADD,&NEXT-&CB.(,&WORK)
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&ADD)
MEXIT
.*
.BACK ANOP
&L L &WORK,&TAIL
ST &ADD,&TAIL
LTR &WORK,&WORK
BNZ CBL&SYSNDX.A
ST &ADD,&HEAD
B *+8
CBL&SYSNDX.A ST &ADD,&NEXT-&CB.(,&WORK)
ST &WORK,&BACK-&CB.(,&ADD)
SLR &WORK,&WORK
ST &WORK,&NEXT-&CB.(,&ADD)
MEND
./ ADD LIST=ALL,NAME=CCALL
MACRO
&L CCALL &SUBR,&TYPE,&RETURN=,&TEST=,&VRE=,&VRF=,&VR0=,&VR1=
LCLC &LBL
&LBL SETC '&L'
SYSKWT TYPE,&TYPE,(A,V),COND=NO
SYSKWT TEST,&TEST,(YES,NO),COND=NO
.*
AIF ('&VRE' EQ '' OR '&VRE' EQ '(VRE)').NVRE
&LBL SYSLR VRE,&VRE
&LBL SETC ''
.NVRE ANOP
.*
AIF ('&VRF' EQ '' OR '&VRF' EQ '(VRF)').NVRF
&LBL SYSLR VRF,&VRF
&LBL SETC ''
.NVRF ANOP
.*
AIF ('&VR0' EQ '' OR '&VR0' EQ '(VR0)').NVR0
&LBL SYSLR VR0,&VR0
&LBL SETC ''
.NVR0 ANOP
.*
AIF ('&VR1' EQ '' OR '&VR1' EQ '(VR1)').NVR1
&LBL SYSLR VR1,&VR1
&LBL SETC ''
.NVR1 ANOP
.*
AIF ('&SUBR'(1,1) EQ '(').REG
AIF ('&TYPE' EQ 'A').A
&LBL L RTNR,=V(&SUBR)
&LBL SETC ''
.*
.BALR ANOP
AIF ('&TEST' NE 'YES').NTEST
LTR RTNR,RTNR
BZ *+6
.NTEST ANOP
CBALR RTNR,RTNR
CSAVGEN
MEXIT
.*
.A ANOP
&LBL L RTNR,=A(&SUBR)
&LBL SETC ''
AGO .BALR
.*
.REG ANOP
AIF ('&TEST' NE 'YES').NTESTR
&LBL LTR &SUBR,&SUBR
&LBL SETC ''
BZ *+6
.NTESTR ANOP
&LBL CBALR RTNR,&SUBR
&LBL SETC ''
CSAVGEN
MEND
./ ADD LIST=ALL,NAME=CDESRCH
ALP;
MACRO &&L: CDESRCH &&LOC,&&WORK=;
GBLC &&OS;
LCLC &&SRCH,&&TEST;
&&SRCH: SETC 'SRCH&@';
&&TEST: SETC 'TEST&@';
ASM CASE '&OS';
'XA': BEGIN
&&L:
SYSLR VR0,&&LOC,OP=L; % LOCATION
STM XRA,HIGHR,20+XRA*4(STKR); % SAVE REGS
&&SRCH: DO BEGIN
L XRA,CVTPTR; % ADDRESS OF CVT
L XRA,CVTTCBP-CVT(,XRA); L XRA,0(,XRA); % ADDR OF TCB
L XRB,TCBJSTCB-TCB(,XRA); % ADDR OF JOB STEP TCB
L XRB,TCBJPQ-TCB(,XRB); % JOB PACK QUEUE
WHILE <RNZ XRB> DO BEGIN
CBAL RTNR,&&TEST; % CHECK THIS CDE
L XRB,CDCHAIN-CDE(,XRB); % NEXT CDE
END;
L XRC,TCBLLS-TCB(,XRA); % TRY THE LOAD LIST
WHILE <RNZ XRC> DO BEGIN
L XRB,LLECDPT-LLE(,XRC); % POINTER TO CDE
IF <RNZ XRB> THEN CBAL RTNR,&&TEST;
L XRC,LLECHN-LLE(,XRC); % NEXT LLE
END;
L XRB,CVTPTR; % ADDR OF CVT
L XRB,CVTQLPAQ-CVT(,XRB); % TRY THE LPA QUEUE
L XRB,0(,XRB);
WHILE <RNZ XRB> DO BEGIN
CBAL RTNR,&&TEST;
L XRB,CDCHAIN-CDE(,XRB);
END;
L XRB,CVTPTR;
L XRB,CVTLPDIA-CVT(,XRB); % LINK PACK DIRECTORY
UNTIL <MCLC LPDENAME-LPDE(XRB),=8X'FF',8> DO BEGIN
CBAL RTNR,&&TEST;
AI XRB,LPDESIZE;
END;
LM XRA,HIGHR,20+XRA*4(STKR); % RESTORE REGISTERS
SYSLR VR1,&&WORK,ERR='WORK AREA REQUIRED'; % ADDR FOR NAME
NUCLKUP BYADDR,NAME=(1),ADDR=(0); % TRY THE NUCLEUS
IF <RNZ VRF> THEN <ZR VR1; EXIT FROM &&SRCH>;
LR VRE,VR0; N VRE,=XL4'7FFFFFFF'; % LOAD POINT
SYSLR VRF,&&LOC,OP=L; % LOCATION BEING SEARCHED FOR
SR VRF,VRE; % OFFSET
LI VR0,1; % EXTENT NUMBER
EXIT FROM &&SRCH;
&&TEST:
RGOTO RTNR IF <TM CDATTR-CDE(XRB),CDNIC+CDMIN>;
RGOTO RTNR IF ^<TM CDATTR2-CDE(XRB),CDXLE>; % NO XL
IF <TM CDATTRB-CDE(XRB),CDELPDE> THEN BEGIN % REALLY LPDE
RGOTO RTNR IF <CL VR0,LPDEXTAD-LPDE(,XRB); CC L>; % LOW
LR VRF,VR0;
S VRF,LPDEXTAD-LPDE(,XRB); % GET DISPLACEMENT
RGOTO RTNR IF <CL VRF,LPDEXTLN-LPDE(,XRB); CC NL>; % HIGH
END
ELSE BEGIN
RGOTO RTNR IF <TM CDATTRB-CDE(XRB),CDIDENTY>;
L XRD,CDXLMJP-CDE(,XRB); % XL POINTER
RGOTO RTNR IF <RZ XRD>; % NO XL
L VRF,4(,XRD); % NO. OF EXTENTS
RGOTO RTNR IF ^<CI VRF,1>; % NO EXTENTS
L VRE,12(XRD); % LOAD ADDRESS
RGOTO RTNR IF <CR VR0,VRE; CC L>; % TOO LOW
LR VRF,VR0; SR VRF,VRE; % GET DISPLACEMENT
RGOTO RTNR IF <CMPP VRF,9(XRD); CC NL> % TOO HIGH
| <C VRF,=XL4'00FFFFFF'; CC H>;
END;
LA VR1,CDNAME-CDE(XRB); % MODULE NAME
LI VR0,1; % EXTENT NUMBER
LM XRA,HIGHR,20+XRA*4(STKR); % RESTORE REGISTERS
END; % OF &&SRCH
LTR VR1,VR1; % SET CC
END;
'MVT','MVS': BEGIN
&&L:
SYSLR VRF,&&LOC,OP=L; % LOCATION
STM XRA,HIGHR,20+XRA*4(STKR); % SAVE REGS
&&SRCH: DO BEGIN
L XRA,CVTPTR; % ADDRESS OF CVT
L XRA,CVTTCBP-CVT(,XRA); L XRA,0(,XRA); % ADDR OF TCB
L XRB,TCBJSTCB-TCB(,XRA); % ADDR OF JOB STEP TCB
L XRB,TCBJPQ-TCB(,XRB); % JOB PACK QUEUE
WHILE <ZHBR XRB; RNZ XRB> DO BEGIN
CBAL RTNR,&&TEST; % CHECK THIS CDE
L XRB,CDCHAIN-CDE(,XRB); % NEXT CDE
END;
L XRC,TCBLLS-TCB(,XRA); % TRY THE LOAD LIST
WHILE <ZHBR XRC; RNZ XRC> DO BEGIN
L XRB,LLECDPT-LLE(,XRC); % POINTER TO CDE
IF <ZHBR XRB; RNZ XRB> THEN CBAL RTNR,&&TEST;
L XRC,LLECHN-LLE(,XRC); % NEXT LLE
END;
L XRB,CVTPTR; % ADDR OF CVT
L XRB,CVTQLPAQ-CVT(,XRB); % TRY THE LPA QUEUE
L XRB,0(,XRB);
WHILE <ZHBR XRB; RNZ XRB> DO BEGIN
CBAL RTNR,&&TEST;
L XRB,CDCHAIN-CDE(,XRB);
END;
ZR VR1; % INDICATE NOT FOUND
EXIT FROM &&SRCH;
&&TEST:
RGOTO RTNR IF <TM CDATTR-CDE(XRB),CDNIC+CDMIN>;
RGOTO RTNR IF ^<TM CDATTR2-CDE(XRB),CDXLE>; % NO XL
L XRD,CDXLMJP-CDE(,XRB); % XL POINTER
RGOTO RTNR IF <ZHBR XRD; RZ XRD>; % NO XL
L VR0,4(,XRD); % NO. OF EXTENTS
RGOTO RTNR IF <RZ VR0>; % NO EXTENTS
LA VRE,8(,XRD); % LIST OF LENGTHS
LR VR1,VR0; SLL VR1,2; AR VR1,VRE; % LIST OF LOCATIONS
DO BEGIN % SEARCH EXTENTS
IF <CMPP VRF,1(VR1); CC NL> THEN BEGIN % NOT TOO LOW
LR XRE,VRF; SL XRE,0(,VR1); % GET DISPL.
IF <CMPP XRE,1(VRE); CC L> THEN BEGIN % WITHIN RANGE
LA VRF,0(,XRE); % RETURN DISPL.
LOADP VRE,1(VR1); % ORIGIN
LCR VR0,VR0; A VR0,4(,XRD); % EXTENT NO.
LA VR1,CDNAME-CDE(,XRB); % MODULE NAME
LTR VR1,VR1; % SET CC
EXIT FROM &&SRCH;
END;
END;
RGOTO RTNR IF <TM 0(VR1),X'80'> | <TM 0(VRE),X'80'>;
AI VR1,4; AI VRE,4;
END FOR VR0;
RGOTO RTNR;
END; % OF &&SRCH
LM XRA,HIGHR,20+XRA*4(STKR); % RESTORE REGISTERS
END;
ENDCASE
ELSE BEGIN
&&L: ZR VR1;
MNOTE 4,'CDESRCH NOT DEFINED FOR &OS';
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=CENTER
MACRO
&L CENTER &R,&S,&SIZE,&ENTRY=,&BASE=,&WAR=
LCLC &LBL
SYSKWT ENTRY,&ENTRY,(YES,NO),COND=NO
SYSKWT BASE,&BASE,(YES,NO),COND=NO
SYSKWT WAR,&WAR,(YES,NO),COND=NO
&LBL SETC '&L'
AIF ('&R&S' EQ '' OR ('&R' NE '' AND '&S' NE '')).OK
MNOTE 12,'ILLEGAL REGISTER SPECIFICATION'
.OK ANOP
.*
.* GENERATE ENTRY CARD
.*
AIF ('&ENTRY' EQ 'NO' OR '&L' EQ '').NENTRY
AIF ('&L'(1,1) EQ '@').NENTRY
ENTRY &L
.NENTRY ANOP
.*
.* SAVE REGISTERS
.*
AIF ('&R' EQ '').NSTM
&LBL STM &R,&S,0(STKR)
&LBL SETC ''
.NSTM ANOP
.*
.* LOAD WORK AREA REGISTER
.*
AIF ('&WAR' EQ 'NO' OR '&R&SIZE' EQ '' OR '&SIZE' EQ '0').NWAR
&LBL LR WAR,STKR
&LBL SETC ''
.NWAR ANOP
.*
.* BUMP STACK POINTER BY SIZE REQUESTED
.*
AIF ('&SIZE' EQ '' AND '&R' NE '').RSIZE
AIF ('&SIZE' EQ '0' OR '&SIZE' EQ '').NSIZE
&LBL LA STKR,(&SIZE+3)/4*4(,STKR)
&LBL SETC ''
AGO .NSIZE
.*
.RSIZE ANOP
&LBL LA STKR,(&S+1-(&R)+16*((&R)/(&S+1))/((&R)/(&S+1)))*4(,STKR)
&LBL SETC ''
.NSIZE ANOP
.*
.* LOAD BASE REGISTER
.*
AIF ('&BASE' EQ 'NO').NBASE
&LBL CBASE BASER
&LBL SETC ''
USING *,BASER
.NBASE ANOP
&LBL CSAVGEN
MEND
./ ADD LIST=ALL,NAME=CEXIT
MACRO
&L CEXIT &R,&S,&SIZE,&WAR=,<R=,&BRANCH=
LCLC &LBL
&LBL SETC '&L'
SYSKWT WAR,&WAR,(YES,NO),COND=NO
SYSKWT LTR,<R,(VRF,VRE,VR0,VR1),COND=NO
SYSKWT BRANCH,&BRANCH,(YES,NO),COND=NO
.*
.* ADJUST STACK POINTER
.*
AIF ('&WAR' EQ 'NO' OR '&SIZE' EQ '0').NWAR
&LBL LR STKR,WAR
&LBL SETC ''
AGO .NSIZE
.*
.NWAR ANOP
AIF ('&SIZE' EQ '').RSIZE
AIF ('&SIZE' EQ '0').NSIZE
&LBL SL STKR,=A((&SIZE+3)/4*4)
&LBL SETC ''
AGO .NSIZE
.*
.RSIZE ANOP
&LBL SL STKR,=A(4*(&S+1-(&R)+16*((&R)/(&S+1))/((&R)/(&S+1))))
&LBL SETC ''
.NSIZE ANOP
.*
.* RESTORE REGISTERS
.*
&LBL LM &R,&S,0(STKR)
&LBL SETC ''
.*
.* GENERATE LTR INSTRUCTION
.*
AIF ('<R' EQ '').NLTR
LTR <R,<R
.NLTR ANOP
.*
AIF ('&BRANCH' EQ 'NO').NBRANCH
BR RTNR
.NBRANCH ANOP
MEND
./ ADD LIST=ALL,NAME=CHKACCT
ALP;
MACRO &&L: CHKACCT;
GBLA &&LACCT;
GBLC &&SITE;
&&L:
WPUSHREG VRF,VR1; % SAVE REGISTERS
LI VRE,4; % INIT TO BAD RETURN CODE
CHEK&&@: DO BEGIN
EXIT IF ^<CI VR0,&&LACCT>; % NOT CORRECT LENGTH
ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
ASM IF (&&LACCT EQ 4)
THEN EXIT IF <MCLC 0(VR1),=C'NONE',4>;
DO BEGIN % CHECK EACH CHARACTER
EXIT FROM CHEK&&@
IF ^<<<CLI 0(VR1),C'A'; CC NL> & <CLI 0(VR1),C'I'; CC NH>>
| <<CLI 0(VR1),C'J'; CC NL> & <CLI 0(VR1),C'R'; CC NH>>
| <<CLI 0(VR1),C'S'; CC NL> & <CLI 0(VR1),C'Z'; CC NH>>
| <<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>>;
AI VR1,1;
END FOR VR0;
END;
END
THEN ZR VRE; % INDICATE SUCCESS
WPOPREG VRF,VR1; % RESTORE REGISTERS
LTR VRE,VRE; % SET CC
MEND;
BAL;
./ ADD LIST=ALL,NAME=CHKBOX
ALP;
MACRO &&L: CHKBOX;
GBLA &&LBOX;
GBLC &&SITE;
&&L:
WPUSHREG VRF,VR1; % SAVE REGISTERS
LI VRE,4; % INIT TO BAD RETURN CODE
CHEK&&@: DO BEGIN
EXIT IF <CI VR0,&&LBOX; CC H>; % NOT CORRECT LENGTH
ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
IF <CLI 0(VR1),C'M'> THEN BEGIN
AI VR1,1;
SI VR0,1;
END;
DO BEGIN % CHECK EACH CHARACTER
EXIT FROM CHEK&&@
IF ^<<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>;
AI VR1,1;
END FOR VR0;
END;
END
THEN ZR VRE; % INDICATE SUCCESS
WPOPREG VRF,VR1; % RESTORE REGISTERS
LTR VRE,VRE; % SET CC
MEND;
BAL;
./ ADD LIST=ALL,NAME=CHKINIT
ALP;
MACRO &&L: CHKINIT;
GBLA &&LINIT;
GBLC &&SITE;
&&L:
WPUSHREG VRF,VR1; % SAVE REGISTERS
LI VRE,4; % INIT TO BAD RETURN CODE
CHEK&&@: DO BEGIN
EXIT IF ^<CI VR0,&&LINIT>; % NOT CORRECT LENGTH
ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
EXIT FROM CHEK&&@
IF ^<<<CLI 0(VR1),C'A'; CC NL> & <CLI 0(VR1),C'I'; CC NH>>
| <<CLI 0(VR1),C'J'; CC NL> & <CLI 0(VR1),C'R'; CC NH>>
| <<CLI 0(VR1),C'S'; CC NL> & <CLI 0(VR1),C'Z'; CC NH>>
%| <CLI 0(VR1),C'#'> | <CLI 0(VR1),C'$'> | <CLI 0(VR1),C'@'>
>;
SI VR0,1;
DO BEGIN
EXIT FROM CHEK&&@
IF ^<<<CLI 1(VR1),C'A'; CC NL> & <CLI 1(VR1),C'I'; CC NH>>
| <<CLI 1(VR1),C'J'; CC NL> & <CLI 1(VR1),C'R'; CC NH>>
| <<CLI 1(VR1),C'S'; CC NL> & <CLI 1(VR1),C'Z'; CC NH>>
| <<CLI 1(VR1),C'0'; CC NL> & <CLI 1(VR1),C'9'; CC NH>
& ^<<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>>
%| <CLI 1(VR1),C'#'> | <CLI 1(VR1),C'$'> | <CLI 1(VR1),C'@'>
>;
AI VR1,1;
END FOR VR0;
END;
END
THEN ZR VRE; % INDICATE SUCCESS
WPOPREG VRF,VR1; % RESTORE REGISTERS
LTR VRE,VRE; % SET CC
MEND;
BAL;
./ ADD LIST=ALL,NAME=CHKKW
ALP;
MACRO &&L: CHKKW;
GBLA &&LKW;
GBLC &&SITE;
&&L:
WPUSHREG VRF,VR1; % SAVE REGISTERS
LI VRE,4; % KW TO BAD RETURN CODE
CHEK&&@: DO BEGIN
EXIT IF ^<CI VR0,&&LKW>; % NOT CORRECT LENGTH
DO BEGIN % CHECK EACH CHARACTER
EXIT FROM CHEK&&@ IF <CLI 0(VR1),C' '>;
AI VR1,1;
END FOR VR0;
END
THEN ZR VRE; % INDICATE SUCCESS
WPOPREG VRF,VR1; % RESTORE REGISTERS
LTR VRE,VRE; % SET CC
MEND;
BAL;
./ ADD LIST=ALL,NAME=CHKTERM
ALP;
MACRO &&L: CHKTERM;
GBLA &<ERM;
GBLC &&SITE;
&&L:
WPUSHREG VRF,VR1; % SAVE REGISTERS
LI VRE,4; % TERM TO BAD RETURN CODE
CHEK&&@: DO BEGIN
ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
IF <CI VR0,4> & <MCLC 0(VR1),=C'NONE',4> THEN BEGIN
WPOPREG VRF,VR1;
LA VRF,=&<ERM.C'*';
LR VR1,VRF; LI VR0,&<ERM;
WPUSHREG VRF,VR1;
ZR VRE;
EXIT;
END;
END;
EXIT IF ^<CI VR0,&<ERM>; % NOT CORRECT LENGTH
ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
IF <CLI 0(VR1),C'0'; CC HE> & <CLI 0(VR1),C'9'; CC LE>
THEN BEGIN
SI VR0,2; % ALLOW FOR 1ST DIGIT AND LETTER
DO BEGIN
AI VR1,1;
EXIT FROM CHEK&&@
IF ^<<CLI 0(VR1),C'0'; CC HE>
& <CLI 0(VR1),C'9'; CC LE>>;
END FOR VR0;
EXIT FROM CHEK&&@
IF ^<<<CLI 1(VR1),C'A'; CC HE> & <CLI 1(VR1),C'I'; CC LE>>
| <<CLI 1(VR1),C'J'; CC HE> & <CLI 1(VR1),C'R'; CC LE>>
| <<CLI 1(VR1),C'S'; CC HE> & <CLI 1(VR1),C'Z'; CC LE>>>;
END
ELSE BEGIN
EXIT FROM CHEK&&@
IF ^<<<CLI 0(VR1),C'A'; CC HE> & <CLI 0(VR1),C'I'; CC LE>>
| <<CLI 0(VR1),C'J'; CC HE> & <CLI 0(VR1),C'R'; CC LE>>
| <<CLI 0(VR1),C'S'; CC HE> & <CLI 0(VR1),C'Z'; CC LE>>>;
FOREVER DO BEGIN
AI VR1,1; SI VR0,1;
EXIT IF <RNP VR0>;
EXIT FROM CHEK&&@
IF ^<<CLI 0(VR1),C'0'; CC HE>
& <CLI 0(VR1),C'9'; CC LE>>;
END;
END;
END;
END
THEN ZR VRE; % INDICATE SUCCESS
WPOPREG VRF,VR1; % RESTORE REGISTERS
LTR VRE,VRE; % SET CC
MEND;
BAL;
./ ADD LIST=ALL,NAME=CI
MACRO
&L CI &R,&V
LCLA &X
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).F
AIF ('&V'(&X,1) GE '0').LOOP
AIF (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
&L C &R,=A(&V)
MEXIT
.F ANOP
&L C &R,=F'&V'
MEND
./ ADD LIST=ALL,NAME=CIL
MACRO
&L CIL &R,&V
LCLA &X
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).F
AIF ('&V'(&X,1) GE '0').LOOP
AIF (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
&L CL &R,=A(&V)
MEXIT
.F ANOP
&L CL &R,=F'&V'
MEND
./ ADD LIST=ALL,NAME=CMPB
MACRO
&L CMPB &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L CLM &R,1,&A
MEXIT
.S360 ANOP
&L ST &R,&SIM370
MCLC 3+&SIM370,&A,1
MEND
./ ADD LIST=ALL,NAME=CMPF
MACRO
&L CMPF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP C,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
C &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=CMPH
MACRO
&L CMPH &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP CH,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,2
CH &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=CMPLF
MACRO
&L CMPLF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP CL,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
CL &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=CMPLH
MACRO
&L CMPLH &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L CLM &R,3,&A
MEXIT
.S360 ANOP
&L ST &R,&SIM370
MCLC 2+&SIM370,&A,2
MEND
./ ADD LIST=ALL,NAME=CMPP
MACRO
&L CMPP &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L CLM &R,7,&A
MEXIT
.S360 ANOP
&L ST &R,&SIM370
MCLC 1+&SIM370,&A,3
MEND
./ ADD LIST=ALL,NAME=CPARMALL
*
* NIH/COMMON - NO ASSEMBLY PARAMETER VALUES FOR ALL VERSIONS
*
./ ADD LIST=ALL,NAME=CPARMGBL
./ NUMBER NEW1=0,INCR=0
*
* NIH/COMMON - ASSEMBLY PARAMETER DEFINITIONS
*
GBLC &CPU CPU TYPE
GBLC &MP MULTIPROCESSOR OPTION
GBLC &OS OPERATING SYSTEM
GBLC &JES TYPE OF JES TO BE USED
GBLA &LJOBNUM LENGTH OF JOB NUMBER
GBLA &MJOBNUM MAXIMUM JOB NUMBER
GBLC &MSGCLAS DEFAULT MESSAGE CLASS
GBLA &MREMOTE MAXIMUM REMOTE NUMBER
GBLA &LJESCMD MAX. LENGTH OF JES COMMAND
GBLA &LJESMSG MAX. LENGTH OF JES NOTIFY MSG
GBLC &JESCHAR STARTING CHARACTER FOR JES CMDS
GBLC &DBC USE DBC (DEBUGGING CONTROLLER)
GBLA &DBCSP SUBPOOL TO BE USED BY DBC
GBLC &SITE SITE OF INSTALLATION
GBLC &SITENAM(8) INSTALLATION NAME
GBLC &FORHELP(8) WHERE TO GO FOR HELP
GBLA &LINIT LENGTH OF INITIALS
GBLA &LACCT LENGTH OF ACCOUNT
GBLA &LKW LENGTH OF KEYWORD
GBLA <ERM LENGTH OF TERMINAL ID
GBLA &LBOX LENGTH OF BOX NUMBER
GBLC &INITNAM NAME FOR INITIALS
GBLC &ACCTNAM NAME FOR ACCOUNT
GBLC &KWNAME NAME FOR KEYWORD
GBLC &TERMNAM NAME FOR TERMINAL ID
GBLC &BOXNAME NAME FOR BOX
GBLC &RACF RACF SUPPORT
GBLC &RACFID NAME FOR RACF USERID
GBLA &RACFSP SUBPOOL FOR RACF
GBLA &SVCGEN1 GENERAL PURPOSE TYPE 1 SVC NO.
GBLA &SVCGEN2 GENERAL PURPOSE TYPE 2 SVC NO.
GBLA &SVCJES REMOTE JOB ENTRY SVC NUMBER
GBLA &SVCKW KEYWORD SVC NUMBER
GBLA &SVCACCT ACCOUNTING SVC NUMBER
GBLA &VAREA LENGTH OF A VAREA
GBLA &LSCAN SCANNER TOKEN SIZE FOR PADDING
GBLC &LNMIN MINIMUM LINE NUMBER
GBLC &LNMAX MAXIMUM LINE NUMBER
GBLC &LNMAXZ &LNMAX WITH 0S INSTEAD OF 9S
GBLC &LN1 LINE NUMBER 1
GBLC &LNDP DECIMAL PLACES IN LINE NUMBER
GBLC &LNIP INTEGER PLACES IN LINE NUMBER
GBLC &LNMASK LINE NUMBER MASK
GBLC &LNBITS NO. OF BITS IN LINE NUMBER
GBLC &SIM370 WORK AREA FOR 370 SIMULATION
GBLA &TIME128 128 DAYS IN 100THS OF A SECOND
GBLA &WTOMAX MAXIMUM TEXT LENGTH IN A WTO
GBLA &WTOMC WTO ROUTECDE - MASTER CONSOLE
GBLA &WTOMCI WTO ROUTECDE - MASTER CONSOLE INFO
GBLA &WTOTAPE WTO ROUTECDE - TAPE POOL
GBLA &WTODISK WTO ROUTECDE - DISK POOL
GBLA &WTOTLIB WTO ROUTECDE - TAPE LIBRARY
GBLA &WTODLIB WTO ROUTECDE - DISK LIBRARY
GBLA &WTOUREC WTO ROUTECDE - UNIT RECORD POOL
GBLA &WTOTPC WTO ROUTECDE - TELEPROCESSING
GBLA &WTOSSEC WTO ROUTECDE - SYSTEM SECURITY
GBLA &WTOERR WTO ROUTECDE - ERROR LOG
GBLA &WTOPROG WTO ROUTECDE - PROGRAMMER
GBLA &WTOEMUL WTO ROUTECDE - EMULATION
GBLA &WTOURC1 WTO ROUTECDE - USER CODE 1
GBLA &WTOURC2 WTO ROUTECDE - USER CODE 2
GBLA &WTOURC3 WTO ROUTECDE - USER CODE 3
GBLA &WTOFAIL WTO DESC - SYSTEM FAILURE
GBLA &WTOIACT WTO DESC - IMMEDIATE ACTION
GBLA &WTOEACT WTO DESC - EVENTUAL ACTION
GBLA &WTOSTAT WTO DESC - SYSTEM STATUS
GBLA &WTOCMDR WTO DESC - COMMAND RESPONSE
GBLA &WTOJOB WTO DESC - JOB STATUS
GBLA &WTOAPPL WTO DESC - APPLICATION PROGRAM
GBLA &WTOOUTL WTO DESC - OUT-OF-LINE MESSAGE
GBLA &WTODISP WTO DESC - DYNAMIC STATUS DISPLAYS
GBLA &WTOCRIT WTO DESC - CRITICAL EVENTUAL ACTION
GBLA &TEMP WORK VARIABLE
./ ADD LIST=ALL,NAME=CPARMPRT
*
* NIH/COMMON - ASSEMBLY PARAMETER LISTING
*
MNOTE *,'&&CPU=&CPU'
MNOTE *,'&&MP=&MP'
MNOTE *,'&&OS=&OS'
MNOTE *,'&&JES=&JES'
MNOTE *,'&&LJOBNUM=&LJOBNUM'
MNOTE *,'&&MJOBNUM=&MJOBNUM'
MNOTE *,'&&MSGCLAS=&MSGCLAS'
MNOTE *,'&&MREMOTE=&MREMOTE'
MNOTE *,'&&LJESCMD=&LJESCMD'
MNOTE *,'&&LJESMSG=&LJESMSG'
MNOTE *,'&&JESCHAR=&JESCHAR'
MNOTE *,'&&DBC=&DBC'
MNOTE *,'&&DBCSP=&DBCSP'
MNOTE *,'&&SITE=&SITE'
MNOTE *,'&&SITENAM=''&SITENAM(1)&SITENAM(2)&SITENAM(3)&SITENAM*
(4)&SITENAM(5)&SITENAM(6)&SITENAM(7)&SITENAM(8)'''
MNOTE *,'&&FORHELP=''&FORHELP(1)&FORHELP(2)&FORHELP(3)&FORHELP*
(4)&FORHELP(5)&FORHELP(6)&FORHELP(7)&FORHELP(8)'''
MNOTE *,'&&LINIT=&LINIT'
MNOTE *,'&&LACCT=&LACCT'
MNOTE *,'&&LKW=&LKW'
MNOTE *,'&<ERM=<ERM'
MNOTE *,'&&LBOX=&LBOX'
MNOTE *,'&&INITNAM=&INITNAM'
MNOTE *,'&&ACCTNAM=&ACCTNAM'
MNOTE *,'&&KWNAME=&KWNAME'
MNOTE *,'&&TERMNAM=&TERMNAM'
MNOTE *,'&&BOXNAME=&BOXNAME'
MNOTE *,'&&RACF=&RACF'
MNOTE *,'&&RACFID=&RACFID'
MNOTE *,'&&RACFSP=&RACFSP'
MNOTE *,'&&SVCGEN1=&SVCGEN1'
MNOTE *,'&&SVCGEN2=&SVCGEN2'
MNOTE *,'&&SVCJES=&SVCJES'
MNOTE *,'&&SVCKW=&SVCKW'
MNOTE *,'&&SVCACCT=&SVCACCT'
MNOTE *,'&&VAREA=&VAREA'
MNOTE *,'&&LSCAN=&LSCAN'
MNOTE *,'&&LNMIN=&LNMIN'
MNOTE *,'&&LNMAX=&LNMAX'
MNOTE *,'&&LNMAXZ=&LNMAXZ'
MNOTE *,'&&LN1=&LN1'
MNOTE *,'&&LNDP=&LNDP'
MNOTE *,'&&LNIP=&LNIP'
MNOTE *,'&&LNMASK=&LNMASK'
MNOTE *,'&&LNBITS=&LNBITS'
MNOTE *,'&&SIM370=&SIM370'
MNOTE *,'&&TIME128=&TIME128'
MNOTE *,'&&WTOMAX=&WTOMAX'
MNOTE *,'&&WTOMC=&WTOMC'
MNOTE *,'&&WTOMCI=&WTOMCI'
MNOTE *,'&&WTOTAPE=&WTOTAPE'
MNOTE *,'&&WTODISK=&WTODISK'
MNOTE *,'&&WTOTLIB=&WTOTLIB'
MNOTE *,'&&WTODLIB=&WTODLIB'
MNOTE *,'&&WTOUREC=&WTOUREC'
MNOTE *,'&&WTOTPC=&WTOTPC'
MNOTE *,'&&WTOSSEC=&WTOSSEC'
MNOTE *,'&&WTOERR=&WTOERR'
MNOTE *,'&&WTOPROG=&WTOPROG'
MNOTE *,'&&WTOEMUL=&WTOEMUL'
MNOTE *,'&&WTOURC1=&WTOURC1'
MNOTE *,'&&WTOURC2=&WTOURC2'
MNOTE *,'&&WTOURC3=&WTOURC3'
MNOTE *,'&&WTOFAIL=&WTOFAIL'
MNOTE *,'&&WTOIACT=&WTOIACT'
MNOTE *,'&&WTOEACT=&WTOEACT'
MNOTE *,'&&WTOSTAT=&WTOSTAT'
MNOTE *,'&&WTOCMDR=&WTOCMDR'
MNOTE *,'&&WTOJOB=&WTOJOB'
MNOTE *,'&&WTOAPPL=&WTOAPPL'
MNOTE *,'&&WTOOUTL=&WTOOUTL'
MNOTE *,'&&WTODISP=&WTODISP'
MNOTE *,'&&WTOCRIT=&WTOCRIT'
./ ADD LIST=ALL,NAME=CPARMRNG
SYSKWT &&CPU,&CPU,(360,370,370BS),COND=NO,NULL=NO
SYSKWT &&MP,&MP,(YES,NO),NULL=NO,COND=NO
SYSKWT &&OS,&OS,(MVT,MFT,VS1,SVS,MVS,XA),COND=NO,NULL=NO
SYSKWT &&JES,&JES,(NIHHASP3,NIHJES2A),COND=NO,NULL=NO
SYSRNG &&LJOBNUM,&LJOBNUM,GT,0,LE,8
SYSRNG &&MJOBNUM,&MJOBNUM,GT,0,LE,99999999
.* NO CHECK ON &MSGCLAS
SYSRNG &&MREMOTE,&MREMOTE,GT,0,LE,99999
SYSRNG &&LJESCMD,&LJESCMD,GT,0,LE,255
SYSRNG &&LJESMSG,&LJESMSG,GT,0,LT,&LJESCMD
.* NO CHECK ON &JESCHAR
SYSKWT DBC,&DBC,(YES,NO),NULL=NO,COND=NO
SYSRNG &&DBCSP,&DBCSP,GE,2,LE,127,NE,78
.* NO CHECK ON &SITE
.* NO CHECK ON &SITENAM
.* NO CHECK NO &FORHELP
SYSRNG &&LINIT,&LINIT,GE,0,LE,8
SYSRNG &&LACCT,&LACCT,GE,0,LE,8
SYSRNG &&LKW,&LKW,GE,0,LE,8
SYSRNG &<ERM,<ERM,GE,0,LE,8
SYSRNG &&LBOX,&LBOX,GE,0,LE,8
.* NO CHECK ON &INITNAM
.* NO CHECK ON &ACCTNAM
.* NO CHECK ON &KWNAME
.* NO CHECK ON &TERMNAM
.* NO CHECK ON &BOXNAME
SYSKWT &&RACF,&RACF,(YES,NO),NULL=NO,COND=NO
.* NO CHECK ON &RACFID
SYSRNG &&RACFSP,&RACFSP,GE,0,LE,127
SYSRNG &&SVCGEN1,&SVCGEN1,GE,0,LE,255
SYSRNG &&SVCGEN2,&SVCGEN2,GE,0,LE,255
SYSRNG &&SVCJES,&SVCJES,GE,0,LE,255
SYSRNG &&SVCKW,&SVCKW,GE,0,LE,255
SYSRNG &&SVCACCT,&SVCACCT,GE,0,LE,255
SYSRNG &&VAREA,&VAREA,EQ,36
SYSRNG &&LSCAN,&LSCAN,GE,16
SYSRNG &&LNDP,&LNDP,GE,0,LE,8
SYSRNG &&LNIP,&LNIP,GE,0,LE,8
&TEMP SETA &LNIP+&LNDP
SYSRNG &&LNIP+&&LNDP,&TEMP,GT,0,LE,8
.* NO CHECK ON &SIM370
.* NO CHECK ON &TIME128
SYSRNG &&WTOMAX,&WTOMAX,GE,9,LT,255
.* NO CHECK ON WTO CODES
.* NO CHECK ON &TEMP
./ ADD LIST=ALL,NAME=CPARMSET
*
* NIH/COMMON - ASSEMBLY PARAMETER DEFAULTS
*
&CPU SETC '370BS' CPU TYPE
&MP SETC 'YES' MULTIPROCESSOR OPTION
&OS SETC 'MVS' OPERATING SYSTEM
&JES SETC 'NIHJES2A'
&LJOBNUM SETA 4 LENGTH OF JOB NUMBER
&MJOBNUM SETA 9999 MAXIMUM JOB NUMBER
&MSGCLAS SETC 'A' DEFAULT MESSAGE CLASS
&MREMOTE SETA 999 MAXIMUM REMOTE NUMBER
&LJESCMD SETA 132 MAX. LENGTH OF JES COMMAND
&LJESMSG SETA 106 MAX. LENGTH OF JES NOTIFY MSG
&JESCHAR SETC '$' STARTING CHARACTER FOR JES CMDS
&DBC SETC 'NO' USE DBC (DEBUGGING CONTROLLER)
&DBCSP SETA 2
&SITE SETC 'NIH' SITE OF INSTALLATION
&SITENAM(1) SETC 'NIH/DCRT' INSTALLATION NAME
&SITENAM(2) SETC '/CCB'
&SITENAM(3) SETC ' WYLBUR'
&FORHELP(1) SETC 'SEE THE ' HELP MESSAGE
&FORHELP(2) SETC 'PAL UNIT'
&LINIT SETA 3 LENGTH OF INITIALS
&LACCT SETA 4 LENGTH OF ACCOUNT
&LKW SETA 3 LENGTH OF KEYWORD
<ERM SETA 3 LENGTH OF TERMINAL ID
&LBOX SETA 4 LENGTH OF BOX NUMBER
&INITNAM SETC 'INITIALS' NAME FOR INITIALS
&ACCTNAM SETC 'ACCOUNT' NAME FOR ACCOUNT
&KWNAME SETC 'KEYWORD' NAME FOR KEYWORD
&TERMNAM SETC 'TERMINAL' NAME FOR TERMINAL ID
&BOXNAME SETC 'BOX' NAME FOR BOX NUMBER
&RACF SETC 'NO' RACF SUPPORT
&RACFID SETC 'USERID' NAME FOR RACF USERID
&RACFSP SETA 3 SUBPOOL FOR RACF
&SVCGEN1 SETA 251 GENERAL PURPOSE TYPE 1 SVC NO.
&SVCGEN2 SETA 244 GENERAL PURPOSE TYPE 2 SVC NO.
&SVCJES SETA 254 REMOTE JOB ENTRY SVC
&SVCKW SETA 254 KEYWORD SVC
&SVCACCT SETA 242 ACCOUNTING SVC
&VAREA SETA 36 LENGTH OF A VAREA
&LSCAN SETA 16 SCANNER TOKEN SIZE FOR PADDING
&LNDP SETC '3' DECIMAL PLACES IN LINE NUMBER
&LNIP SETC '5' INTEGER PLACES IN LINE NUMBER
&SIM370 SETC 'SIM370' WORK AREA FOR 370 SIMULATION
&TIME128 SETA 128*24*3600*100 128 DAYS IN 100THS OF A SECOND
&WTOMAX SETA 62 MAXIMUM TEXT LENGTH IN A WTO
&WTOMC SETA 1 WTO ROUTECDE - MASTER CONSOLE
&WTOMCI SETA 2 WTO ROUTECDE - MASTER CONSOLE INFO
&WTOTAPE SETA 3 WTO ROUTECDE - TAPE POOL
&WTODISK SETA 4 WTO ROUTECDE - DISK POOL
&WTOTLIB SETA 5 WTO ROUTECDE - TAPE LIBRARY
&WTODLIB SETA 6 WTO ROUTECDE - DISK LIBRARY
&WTOUREC SETA 7 WTO ROUTECDE - UNIT RECORD POOL
&WTOTPC SETA 8 WTO ROUTECDE - TELEPROCESSING
&WTOSSEC SETA 9 WTO ROUTECDE - SYSTEM SECURITY
&WTOERR SETA 10 WTO ROUTECDE - ERROR LOG
&WTOPROG SETA 11 WTO ROUTECDE - PROGRAMMER
&WTOEMUL SETA 12 WTO ROUTECDE - EMULATION
&WTOURC1 SETA 13 WTO ROUTECDE - USER CODE 1
&WTOURC2 SETA 14 WTO ROUTECDE - USER CODE 2
&WTOURC3 SETA 15 WTO ROUTECDE - USER CODE 3
&WTOFAIL SETA 1 WTO DESC - SYSTEM FAILURE
&WTOIACT SETA 2 WTO DESC - IMMEDIATE ACTION
&WTOEACT SETA 3 WTO DESC - EVENTUAL ACTION
&WTOSTAT SETA 4 WTO DESC - SYSTEM STATUS
&WTOCMDR SETA 5 WTO DESC - COMMAND RESPONSE
&WTOJOB SETA 6 WTO DESC - JOB STATUS
&WTOAPPL SETA 7 WTO DESC - APPLICATION PROGRAM
&WTOOUTL SETA 8 WTO DESC - OUT-OF-LINE MESSAGE
&WTODISP SETA 9 WTO DESC - DYNAMIC STATUS DISPLAYS
&WTOCRIT SETA 10 WTO DESC - CRITICAL EVENTUAL ACTION
./ ADD LIST=ALL,NAME=CPARMVER
*
* NIH/COMMON - NO VERSION-SPECIFIC ASSEMBLY PARAMETER VALUES
*
./ ADD LIST=ALL,NAME=CPOP
MACRO
&L CPOP &R,&SIZE,&EXTRA=0
AIF ('&R' EQ '').SIZE
&L LR STKR,&R
MEXIT
.*
.SIZE ANOP
AIF ('&SIZE'(1,1) EQ '(').RSIZE
&L SL STKR,=A((&SIZE+&EXTRA+3)/4*4)
CSAVGEN
MEXIT
.*
.RSIZE ANOP
&L SLR STKR,&SIZE
AIF ('&EXTRA' EQ '0').NEXTRA
SI STKR,&EXTRA
.NEXTRA ANOP
N STKR,=XL4'FFFFFFFC'
CSAVGEN
MEND
./ ADD LIST=ALL,NAME=CPOPREG
MACRO
&L CPOPREG &R,&S
GBLC &CSVLINK(4)
LCLC &SAVLINK
.*
&SAVLINK SETC '&CSVLINK(1)'
&CSVLINK(1) SETC ''
.*
AIF ('&S' EQ '').ONE
&L CPOP ,4*(&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))
LM &R,&S,0(STKR)
&CSVLINK(1) SETC '&SAVLINK'
CSAVGEN
MEXIT
.*
.ONE ANOP
&L CPOP ,4
L &R,0(,STKR)
&CSVLINK(1) SETC '&SAVLINK'
CSAVGEN
MEND
./ ADD LIST=ALL,NAME=CPUSH
MACRO
&L CPUSH &R,&SIZE,&EXTRA=0
LCLC &LBL
&LBL SETC '&L'
AIF ('&R' EQ '').NR
&LBL LR &R,STKR
&LBL SETC ''
.NR ANOP
.*
AIF ('&SIZE'(1,1) EQ '(').REG
&LBL LA STKR,(&SIZE+&EXTRA+3)/4*4(,STKR)
CSAVGEN
MEXIT
.*
.REG ANOP
&LBL LA STKR,&EXTRA+3(&SIZE,STKR)
AIF ('&SIZE' NE '(0)' AND '&SIZE' NE '(R0)' AND *
'&SIZE' NE '(VR0)').NZREG
AR STKR,&SIZE
.NZREG ANOP
N STKR,=XL4'FFFFFFFC'
CSAVGEN
MEND
./ ADD LIST=ALL,NAME=CPUSHREG
MACRO
&L CPUSHREG &R,&S
AIF ('&S' EQ '').ONE
&L STM &R,&S,0(STKR)
CPUSH ,4*(&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))
MEXIT
.*
.ONE ANOP
&L ST &R,0(,STKR)
CPUSH ,4
MEND
./ ADD LIST=ALL,NAME=CREGS
MACRO
CREGS
*
* REGISTER USAGE
*
VR0 EQU 0 PARAMETER REGISTER
VR1 EQU 1 PARAMETER REGISTER
XRA EQU 2 WORK REGISTER
XRB EQU 3 WORK REGISTER
XRC EQU 4 WORK REGISTER
XRD EQU 5 WORK REGISTER
XRE EQU 6 WORK REGISTER
XRF EQU 7 WORK REGISTER
XRG EQU 8 WORK REGISTER
RTNR EQU 9 RETURN REGISTER
BASER EQU 10 BASE REGISTER
WAR EQU 11 WORK AREA REGISTER
GCBR EQU 12 GLOBAL CONTROL BLOCK REGISTER
STKR EQU 13 STACK REGISTER
VRE EQU 14 PARAMETER REGISTER
VRF EQU 15 PARAMETER REGISTER
*
LOWR EQU XRA LOWEST REGISTER TO SAVE
HIGHR EQU WAR HIGHEST REGISTER TO SAVE
MEND
./ ADD LIST=ALL,NAME=CSA
MACRO
&L CSA &R,&S,&EQU=
LCLA &X
LCLC &LBL
.*
&LBL SETC '&L'
AIF ('&L' NE '' OR '&EQU' EQ '').NLBL
&LBL SETC 'CSA&SYSNDX'
.NLBL ANOP
.*
&LBL DS (&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))A
.*
&X SETA 0-1
.LOOP ANOP
&X SETA &X+2
AIF (&X GT N'&EQU).DONE
&EQU(&X) EQU &LBL+(&EQU(&X+1)-(&R)+16*(((&R)/(&EQU(&X+1)+1))/((&R)/(&*
EQU(&X+1)+1))))*4
AGO .LOOP
.*
.DONE ANOP
.*
MEND
./ ADD LIST=ALL,NAME=CSAVGEN
MACRO
&L CSAVGEN
GBLC &CSVLINK(4)
AIF ('&CSVLINK(1)' EQ '').NONE
&L MVC 0(12,STKR),=XL12'00'
SYSLST 4(STKR),NEW=&CSVLINK(1)&CSVLINK(2)&CSVLINK(3)&CSVLINK(4),OP=L
MEXIT
.*
.NONE ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=CSAVLINK
MACRO
&L CSAVLINK &SAVE
GBLC &CSVLINK(4)
LCLA &X,&Y
.*
&L SYSLBL
.*
.LOOP ANOP
&X SETA &X+1
&CSVLINK(&X) SETC ''
&Y SETA K'&SAVE-(&X-1)*8
AIF (&Y LE 0).NULL
AIF (&Y LE 8).SHORT
&Y SETA 8
.SHORT ANOP
&CSVLINK(&X) SETC '&SAVE'(1+(&X-1)*8,&Y)
.*
.NULL ANOP
AIF (&X LT 4).LOOP
MEND
./ ADD LIST=ALL,NAME=CSETUP
MACRO
&L CSETUP ®S=YES,&SETS=YES,&CBS=YES,&SCABBRS=YES,&CSECT=YES, *
&SYMDEL=YES,&KWR=NO,&MDC=NO,&NAT=NO,&SCT=NO, *
&CVT=NO,&DCB=NO,&DEB=NO,&UCB=NO,&DECB=NO, *
&TCB=NO,&CDE=NO,&PQE=NO,&RB=NO,&IQE=NO,&LPDE=NO, *
&ASCB=NO,&S99=NO,&ACB=NO,&RPL=NO,&SSOB=NO,&LRC=NO, *
&SDWA=NO,&JESCT=NO,&PSA=NO,&PCCA=NO,&TQE=NO,&LLE=NO, *
&ASXB=NO,&SMCA=NO,&JSCB=NO,&RIB=NO,&ACEE=NO, *
&R15=VRF,&R14=VRE,&R13=STKR,&BASER=BASER, *
&R1=VR1,&R0=VR0
.*
COPY CPARMGBL
GBLC R15,R14,R13,BASER,R1,R0
GBLC &SYSSPLV
LCLA &X,&Y
.*
.* SET OS REGISTER NAMES
.*
R15 SETC '&R15'
R14 SETC '&R14'
R13 SETC '&R13'
BASER SETC '&BASER'
R1 SETC '&R1'
R0 SETC '&R0'
.*
.* CHECK MACRO PARAMETER VALUES
.*
SYSKWT SETS,&SETS,(YES,NO),COND=NO
SYSKWT SCABBRS,&SCABBRS,(YES,NO),COND=NO
SYSKWT REGS,®S,(YES,NO,NEVER),COND=NO
SYSKWT CBS,&CBS,(YES,NO,ALL),COND=NO
SYSKWT CSECT,&CSECT,(YES,NO),COND=NO
SYSKWT SYMDEL,&SYMDEL,(YES,NO),COND=NO
SYSKWT MDC,&MDC,(YES,NO),COND=NO
SYSKWT SCT,&SCT,(YES,NO,NEVER),COND=NO
SYSKWT NAT,&NAT,(YES,NO),COND=NO
SYSKWT ACB,&ACB,(YES,NO),COND=NO
SYSKWT ACEE,&ACEE,(YES,NO),COND=NO
SYSKWT ASCB,&ASCB,(YES,NO),COND=NO
SYSKWT ASXB,&ASXB,(YES,NO),COND=NO
SYSKWT CDE,&CDE,(YES,NO),COND=NO
SYSKWT CVT,&CVT,(YES,NO),COND=NO
SYSKWT DCB,&DCB,(YES,NO),COND=NO
SYSKWT DEB,&DEB,(YES,NO),COND=NO
SYSKWT DECB,&DECB,(YES,NO),COND=NO
SYSKWT IQE,&IQE,(YES,NO),COND=NO
SYSKWT JESCT,&JESCT,(YES,NO),COND=NO
SYSKWT JSCB,&JSCB,(YES,NO),COND=NO
SYSKWT LLE,&LLE,(YES,NO),COND=NO
SYSKWT LPDE,&LPDE,(YES,NO),COND=NO
SYSKWT LRC,&LRC,(YES,NO),COND=NO
SYSKWT PCCA,&PCCA,(YES,NO),COND=NO
SYSKWT PQE,&PQE,(YES,NO),COND=NO
SYSKWT PSA,&PSA,(YES,NO),COND=NO
SYSKWT RB,&RB,(YES,NO),COND=NO
SYSKWT RPL,&RPL,(YES,NO),COND=NO
SYSKWT SDWA,&SDWA,(YES,NO),COND=NO
SYSKWT SMCA,&SMCA,(YES,NO),COND=NO
SYSKWT SSOB,&SSOB,(YES,NO),COND=NO
SYSKWT S99,&S99,(YES,NO),COND=NO
SYSKWT TCB,&TCB,(YES,NO),COND=NO
SYSKWT TQE,&TQE,(YES,NO),COND=NO
SYSKWT UCB,&UCB,(YES,NO),COND=NO
.*
.* ASSEMBLY PARAMETER VALUES
.*
AIF ('&SETS' EQ 'NO').NSETS
COPY CPARMSET
COPY CPARMALL
COPY CPARMVER
.*
.* CHECK ASSEMBLY PARAMETER VALUES
.*
COPY CPARMRNG
.*
.* COMPUTE LINE NUMBER VALUES
.*
&LNMIN SETC '0'
.*
&Y SETA 1
&X SETA &LNDP
.LNLOOP ANOP
&Y SETA &Y*10
&X SETA &X-1
AIF (&X GE 0).LNLOOP
&Y SETA &Y/10
&LN1 SETC '&Y'
.*
&LNMAX SETC ''
&LNMAXZ SETC ''
&X SETA &LNIP+&LNDP
.LNMLOOP ANOP
&LNMAX SETC '&LNMAX.9'
&LNMAXZ SETC '&LNMAXZ.0'
&X SETA &X-1
AIF (&X GT 0).LNMLOOP
.*
&X SETA 1
&Y SETA 0
.LNBLOOP ANOP
&X SETA &X*2
&Y SETA &Y+1
AIF (&LNMAX GE &X).LNBLOOP
&LNBITS SETC '&Y'
.*
AIF (&Y EQ &Y/4*4 AND &Y GT 4).LNNM4
&LNMASK SETC '0137'(1+&Y-&Y/4*4,1)
.LNNM4 ANOP
AIF (&Y LT 4).LNBLT4
&LNMASK SETC '&LNMASK'.'FFFFFFFF'(1,&Y/4)
.LNBLT4 ANOP
.*
.* PERFORM RACF CHECK
.*
AIF ('&RACF' NE 'YES').NRACF
AIF ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').NRACF
&RACF SETC 'NO'
.NRACF ANOP
.*
.* PERFORM XA CHECK
.*
AIF ('&OS' NE 'XA').NXA
&CPU SETC '370BS'
.NXA ANOP
.*
.* PRINT ASSEMBLY PARAMETER VALUES
.*
COPY CPARMPRT
.*
.NSETS ANOP
.*
.* SET PROPER SPLEVEL FOR MVS/370 AND MVS/XA
.*
AIF ('&OS' EQ 'XA').SPLXA
AIF ('&OS' NE 'MVS').SPLDONE
SPLEVEL SET=1 REQUEST MVS/370 MACRO EXPANSIONS
AGO .SPLDONE
.*
.SPLXA ANOP
SPLEVEL SET=2 REQUEST MVS/XA MACRO EXPANSIONS
.SPLDONE ANOP
SPLEVEL TEST
MNOTE *,'SPLEVEL=&SYSSPLV'
.*
.* SCANNER ABBREVIATIONS
.*
AIF ('&SCABBRS' EQ 'NO').NSCABBR
SCABBRS
.NSCABBR ANOP
.*
.* CONTROL BLOCKS
.*
AIF ('&CBS' EQ 'NO').NCBS
AIF ('&DBC' EQ 'NO' OR '&SYMDEL' EQ 'NO').NSYMDEL
SYMDEL DSECT
.NSYMDEL ANOP
.*
.* KWR
.*
AIF ('&KWR' EQ 'NO' AND '&CBS' NE 'ALL').NKWR
TITLE 'KWR - KEYWORD RECORD'
KWR DSECT
KWR2
.NKWR ANOP
.*
.* MDC
.*
AIF ('&MDC' EQ 'NO' AND '&CBS' NE 'ALL').NMDC
TITLE 'MDC - MACHINE DEPENDENT CELLS'
MDC DSECT
MDC
.NMDC ANOP
.*
.* NAT
.*
AIF ('&NAT' EQ 'NO' AND '&CBS' NE 'ALL').NNAT
TITLE 'NAT - NUCLEUS ADDRESS TABLE'
NAT DSECT
NAT
.NNAT ANOP
.*
.* SCT
.*
AIF (('&SCT' EQ 'NEVER') OR ('&SCT' EQ 'NO' AND '&CBS' NE 'ALL')).NSCT
TITLE 'SCT - SCAN CONTROL TABLE'
SCT DSECT
SCT
.NSCT ANOP
.*
.* ACB
.*
AIF ('&ACB' EQ 'NO' AND '&CBS' NE 'ALL').NACB
AIF ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NACB
TITLE 'ACB - OS ACCESS METHOD CONTROL BLOCK'
IFGACB ,
*
ACB EQU IFGACB
.NACB ANOP
.*
.* ACEE
.*
AIF ('&ACEE' EQ 'NO' AND '&CBS' NE 'ALL').NACEE
AIF ('&RACF' EQ 'NO').NACEE
TITLE 'ACEE - RACF ACCESSOR ENVIRONMENT ELEMENT'
IHAACEE
.NACEE ANOP
.*
.* ASCB
.*
AIF ('&ASCB' EQ 'NO' AND '&CBS' NE 'ALL').NASCB
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NASCB
TITLE 'ASCB - OS ADDRESS SPACE CONTROL BLOCK'
IHAASCB ,
.NASCB ANOP
.*
.* ASXB
.*
AIF ('&ASXB' EQ 'NO' AND '&CBS' NE 'ALL').NASXB
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NASXB
TITLE 'ASXB - OS ADDRESS SPACE EXTENSION BLOCK'
IHAASXB ,
.NASXB ANOP
.*
.* CDE
.*
AIF ('&CDE' EQ 'NO' AND '&CBS' NE 'ALL').NCDE
TITLE 'OS CONTENTS DIRECTORY ENTRY'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHACDE
CDE DSECT
CDEMVT
AGO .NCDE
.*
.IHACDE ANOP
IHACDE ,
*
CDE EQU CDENTRY
.NCDE ANOP
.*
.* CVT
.*
AIF ('&CVT' EQ 'NO' AND '&CBS' NE 'ALL').NCVT
TITLE 'CVT - OS COMMUNICATIONS VECTOR TABLE'
AIF ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').VSCVT
AIF ('&OS' EQ 'SVS' OR '&OS' EQ 'VS1').VSCVT
CVT DSECT
CVT
AGO .NCVT
.*
.VSCVT ANOP
CVT DSECT=YES,LIST=YES
.NCVT ANOP
.*
.* DCB
.*
AIF ('&DCB' EQ 'NO' AND '&CBS' NE 'ALL').NDCB
TITLE 'DCBD - OS DATA CONTROL BLOCK DSECT'
DCBD DSORG=(PS,PO,DA),DEVD=DA
*
DCB EQU IHADCB
.NDCB ANOP
.*
.* DEB
.*
AIF ('&DEB' EQ 'NO' AND '&CBS' NE 'ALL').NDEB
TITLE 'DEB - OS DATA EXTENT BLOCK'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MFT').VSDEB
DEB DSECT
DEBMVT
AGO .NDEB
.*
.VSDEB ANOP
IEZDEB LIST=YES
.NDEB ANOP
.*
.* DECB
.*
AIF ('&DECB' EQ 'NO' AND '&CBS' NE 'ALL').NDECB
TITLE 'DECB - OS DATA EVENT CONTROL BLOCK'
DECB DSECT
DECBMVT
.NDECB ANOP
.*
.* IQE
.*
AIF ('&IQE' EQ 'NO' AND '&CBS' NE 'ALL').NIQE
TITLE 'IQE - OS INTERRUPTION QUEUE ELEMENT'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHAIQE
IQE DSECT
IQEMVT
AGO .NIQE
.*
.IHAIQE ANOP
IHAIQE ,
IQE EQU IQESECT
.NIQE ANOP
.*
.* JESCT
.*
AIF ('&JESCT' EQ 'NO' AND '&CBS' NE 'ALL').NJESCT
AIF ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NJESCT
TITLE 'JESCT - OS JES COMMUNICATION TABLE'
IEFJESCT ,
.NJESCT ANOP
.*
.* JSCB
.*
AIF ('&JSCB' EQ 'NO' AND '&CBS' NE 'ALL').NJSCB
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NJSCB
TITLE 'JSCB - OS JOB STEP CONTROL BLOCK'
IEZJSCB ,
JSCB EQU IEZJSCB
.NJSCB ANOP
.*
.* LLE
.*
AIF ('&LLE' EQ 'NO' AND '&CBS' NE 'ALL').NLLE
TITLE 'LLE - OS LOAD LIST ELEMENT'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHALLE
LLE DSECT
LLEMVT
AGO .NLLE
.*
.IHALLE ANOP
IHALLE ,
.NLLE ANOP
.*
.* LPDE
.*
AIF ('&LPDE' EQ 'NO' AND '&CBS' NE 'ALL').NLPDE
AIF ('&OS' NE 'XA' AND '&OS' NE 'MVS').NLPDE
TITLE 'LPDE - OS LINK PACK DIRECTORY ELEMENT'
IHALPDE ,
LPDESIZE EQU *-LPDE
.NLPDE ANOP
.*
.* LRC
.*
AIF ('&LRC' EQ 'NO' AND '&CBS' NE 'ALL').NLRC
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NLRC
*
&L CSECT
$LRC DOC=YES
*
LRC EQU LRCDSECT
.NLRC ANOP
.*
.* PCCA
.*
AIF ('&PCCA' EQ 'NO' AND '&CBS' NE 'ALL').NPCCA
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NPCCA
TITLE 'PCCA - OS PHYSICAL CONFIGURATION COMMUNICATION AREA'
IHAPCCA ,
.NPCCA ANOP
.*
.* PQE
.*
AIF ('&PQE' EQ 'NO' AND '&CBS' NE 'ALL').NPQE
TITLE 'OS PARTITION QUEUE ELEMENT'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHAPQE
PQE DSECT
PQEMVT
AGO .NPQE
.*
.IHAPQE ANOP
IHAPQE ,
*
PQE EQU PQESECT
.NPQE ANOP
.*
.* PSA
.*
AIF ('&PSA' EQ 'NO' AND '&CBS' NE 'ALL').NPSA
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NPSA
TITLE 'PSA - OS PREFIX STORAGE AREA'
IHAPSA ,
.NPSA ANOP
.*
.* RB
.*
AIF ('&RB' EQ 'NO' AND '&CBS' NE 'ALL').NRB
TITLE 'OS REQUEST BLOCK'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MVT').IHARB
RB DSECT
RBMVT
AGO .NRB
.*
.IHARB ANOP
AIF ('&OS' EQ 'VS1').IHARB1
IHARB ,
*
RB EQU RBBASIC
AGO .NRB
.*
.IHARB1 ANOP
IHARB SYS=AOS1 VS1 RB
*
RB EQU RBBASIC
.NRB ANOP
.*
.* RIB
.*
AIF ('&RIB' EQ 'NO' AND '&CBS' NE 'ALL').NRIB
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NRIB
TITLE 'RIB - OS RESOURCE INFORMATION BLOCK'
ISGRIB ,
.NRIB ANOP
.*
.* RPL
.*
AIF ('&RPL' EQ 'NO' AND '&CBS' NE 'ALL').NRPL
AIF ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NRPL
TITLE 'RPL - OS REQUEST PARAMETER LIST'
IFGRPL ,
*
RPL EQU IFGRPL
EJECT
IDARMRCD ,
AIF ('&JES' NE 'NIHJES2A').NRPL
EJECT
JESNRPL
.NRPL ANOP
.*
.* SDWA
.*
AIF ('&SDWA' EQ 'NO' AND '&CBS' NE 'ALL').NSDWA
AIF ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NSDWA
TITLE 'SDWA - OS SYSTEM DIAGNOSTIC WORKAREA'
IHASDWA ,
.NSDWA ANOP
.*
.* SMCA
.*
AIF ('&SMCA' EQ 'NO' AND '&CBS' NE 'ALL').NSMCA
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NSMCA
TITLE 'SMCA - OS SYSTEM MANAGEMENT FACILITIES CONTROL AREA'
IEESMCA ,
SMCA EQU SMCABASE
.NSMCA ANOP
.*
.* SSOB
.*
AIF ('&SSOB' EQ 'NO' AND '&CBS' NE 'ALL').NSSOB
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NSSOB
TITLE 'SSOB - OS SUBSYSTEM OPTIONS BLOCK'
IEFJSSOB (SO,CS,AL,DA,US),CONTIG=YES
AIF ('&JES' NE 'NIHJES2A').NSSOB
EJECT
JESNSSOB (SO,JC,FC)
.NSSOB ANOP
.*
.* S99
.*
AIF ('&S99' EQ 'NO' AND '&CBS' NE 'ALL').NS99
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NS99
TITLE 'OS DYNAMIC ALLOCATION DEFINITIONS'
S99 DSECT
IEFZB4D0 ,
EJECT
IEFZB4D2 ,
.NS99 ANOP
.*
.* TCB
.*
AIF ('&TCB' EQ 'NO' AND '&CBS' NE 'ALL').NTCB
TITLE 'TCB - OS TASK CONTROL BLOCK'
AIF ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IKJTCB
TCB DSECT
TCBMVT
AGO .NTCB
.*
.IKJTCB ANOP
AIF ('&OS' EQ 'VS1').IKJTCB1
IKJTCB LIST=YES
AGO .NTCB
.*
.IKJTCB1 ANOP
IKJTCB SYS=AOS1,LIST=YES VS1 TCB
.NTCB ANOP
.*
.* TQE
.*
AIF ('&TQE' EQ 'NO' AND '&CBS' NE 'ALL').NTQE
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NTQE
TITLE 'TQE - TIMER QUEUE ELEMENT'
IHATQE ,
.NTQE ANOP
.*
.* UCB
.*
AIF ('&UCB' EQ 'NO' AND '&CBS' NE 'ALL').NUCB
TITLE 'UCB - OS UNIT CONTROL BLOCK'
AIF ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').UCBMVS
UCB DSECT
IEFUCBOB
AGO .NUCB
.*
.UCBMVS ANOP
UCB DSECT
IEFUCBOB LIST=YES
.NUCB ANOP
.*
AIF ('&DBC' EQ 'NO' OR '&SYMDEL' EQ 'NO').NCBS
SYMNODEL DSECT
.NCBS ANOP
.*
.* REGISTERS
.*
AIF (('&CSECT' EQ 'NO') AND *
(('®S' EQ 'NO') OR ('®S' EQ 'NEVER'))).NTITLE
TITLE 'REGISTER DEFINITIONS'
.NTITLE ANOP
AIF ('&CSECT' EQ 'NO').NCSECT
&L CSECT
.NCSECT ANOP
.*
AIF ('®S' EQ 'NEVER').NREGS
AIF (('®S' EQ 'NO') AND (('&CBS' EQ 'NO') *
OR ('&SCT' EQ 'NEVER') *
OR (('&SCT' EQ 'NO') AND ('&CBS' NE 'ALL')))).NREGS
CREGS
.NREGS ANOP
MEND
./ ADD LIST=ALL,NAME=CSPOST
MACRO
&L CSPOST &ECB,&PC
GBLC &OS
.*
&L SYSLR VR1,&ECB,ERR='ECB REQUIRED'
AIF ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').VSPOST
SYSLR VR0,&PC
POST (1),(0)
MEXIT
.*
.VSPOST ANOP
AIF ('&PC' EQ '' OR '&PC' EQ '0').ZPC
SYSLR VR0,&PC
O VR0,=XL4'40000000'
AGO .POST
.*
.ZPC ANOP
L VR0,=XL4'40000000'
.POST ANOP
L VRF,0(,VR1)
PST&SYSNDX.A LTR VRF,VRF
BM PST&SYSNDX.B
CS VRF,VR0,0(VR1)
BNE PST&SYSNDX.A
B PST&SYSNDX.C
PST&SYSNDX.B POST (1),(0)
PST&SYSNDX.C DS 0H
MEND
./ ADD LIST=ALL,NAME=CVBTA
MACRO
&L CVBTA &LOC,&LEN,&WORD
&L SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
SYSLR VR0,&LEN
SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
OSCALL CVBTA,VRF=(VRF)
MEND
./ ADD LIST=ALL,NAME=CVBTD
MACRO
&L CVBTD &LOC,&LEN,&WORD
&L SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
SYSLR VR0,&LEN
SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
OSCALL CVBTD,VRF=(VRF)
MEND
./ ADD LIST=ALL,NAME=CVBTR
MACRO
&L CVBTR &LOC,&LEN,&WORD
&L SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
SYSLR VR0,&LEN
SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
OSCALL CVBTR,VRF=(VRF)
MEND
./ ADD LIST=ALL,NAME=CVBTX
MACRO
&L CVBTX &LOC,&LEN,&BIN
&L SYSLR VRF,&BIN,ERR='ADDRESS OF BINARY DATA REQUIRED'
SYSLR VR0,&LEN,ERR='LENGTH OF HEX AREA REQUIRED'
SYSLR VR1,&LOC,ERR='LOCATION OF HEX AREA REQUIRED'
OSCALL CVBTX,VRF=(VRF)
MEND
./ ADD LIST=ALL,NAME=CVBT$
MACRO
&L CVBT$ &LOC,&LEN,&WORD
&L SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
SYSLR VR0,&LEN
SYSLR VR1,&LOC,ERR='LOCATION OF RESULT AREA REQUIRED'
OSCALL CVBT$,VRF=(VRF)
MEND
./ ADD LIST=ALL,NAME=CVDATE
MACRO
&L CVDATE &LOC,&DATE,&WEEKDAY=
SYSKWT WEEKDAY,&WEEKDAY,(YES,NO)
&L SYSLR VR1,&LOC,TYPE=&WEEKDAY,SELECT=(YES),ERR='LOCATION REQUIRED'
SYSLR VR0,&DATE,OP=L,ERR='DATE REQUIRED'
OSCALL CVDATE
MEND
./ ADD LIST=ALL,NAME=CVDTB
MACRO
&L CVDTB &LOC,&LEN,&EXACT=
SYSKWT EXACT,&EXACT,NO
&L SYSLR VR1,&LOC,TYPE=&EXACT,ERR='LOCATION REQUIRED'
SYSLR VR0,&LEN,ERR='LENGTH REQUIRED'
OSCALL CVDTB
MEND
./ ADD LIST=ALL,NAME=CVTIME
MACRO
&L CVTIME &LOC,&TIME,&M=
SYSKWT AMPM,&M,YES
&L SYSLR VR1,&LOC,TYPE=&M,ERR='LOCATION REQUIRED'
SYSLR VR0,&TIME,OP=L,ERR='TIME REQUIRED'
OSCALL CVTIME
MEND
./ ADD LIST=ALL,NAME=CVTIM128
MACRO
&L CVTIM128 &TIME
&L SYSLR VR0,&TIME,OP=L,ERR='TIME REQUIRED'
OSCALL CVTIM128
MEND
./ ADD LIST=ALL,NAME=CVXTB
MACRO
&L CVXTB &LOC,&LEN,&BIN
&L SYSLR VR1,&LOC,ERR='LOCATION OF HEX STRING REQUIRED'
SYSLR VR0,&LEN,ERR='LENGTH OF HEX STRING REQUIRED'
SYSLR VRF,&BIN,ERR='LOCATION FOR BINARY RESULT REQUIRED'
OSCALL CVXTB,VRF=(VRF)
MEND
./ ADD LIST=ALL,NAME=DALLIST
ALP;
MACRO &&L: DALLIST &&TYPE,&&VERB,&&ERROR=,&&INFO=,&&FLAGS1=,_
&&FLAGS2=,&&MF=,&&SVC=,&&INIT=;
GBLC &&DALMF,&&DALPL,&&DALLBL(25),&&DALEND,&&DALLEN,&&DALPTR;
GBLC &&DALINIT;
GBLA &&DALNUM;
GBLB &&DALSW;
GBLC &&OS;
LCLA &&X,&&Y;
LCLC &&STORE,&&LOAD,&&LQ;
&&LQ: SETC 'L''';
SYSKWT MF,&&MF(1),(L,E,R),COND=NO;
SYSKWT SVC,&&SVC,(YES,NO),COND=NO;
SYSKWT INIT,&&INIT,(YES,NO),COND=NO;
ASM CASE '&TYPE';
'BEGIN': BEGIN
ASM IF ('&OS' NE 'MVS' AND '&OS' NE 'XA')
THEN MNOTE 12,'DALLIST VALID ONLY FOR &&OS=MVS OR &&OS=XA';
ASM IF (&&DALSW) THEN MNOTE 12,'MISSING DALLIST END';
&&DALSW: SETB 1; % SET BEGIN SWITCH
&&DALMF: SETC '&MF(1)'; % SAVE MF VALUE
&&DALPL: SETC '&MF(2)';
&&DALINIT: SETC '&INIT';
&&DALLEN: SETC '24'; % SET INITIAL LENGTH
&&DALPTR: SETC 'DALP&@';
&&DALNUM: SETA 0;
ASM CASE '&MF(1)';
'','L': BEGIN
ASM CASE '&MF(1)';
'L': <&&L: DS 0F>;
'': BEGIN
&&DALEND: SETC 'DALE&@'; % END SYMBOL
&&L: GOTO &&DALEND;
&&DALPL: SETC 'DALA&@';
&&DALPL: DS 0F;
END;
ENDCASE;
DC A(X'80000000'+*+4); % PARM LIST
DC AL1(20,&&VERB);
ASM IF ('&FLAGS1(1)' EQ '') THEN DC AL1(0)
ELSE DC AL1(&&FLAGS1(1));
ASM IF ('&FLAGS1(2)' EQ '') THEN DC AL1(0)
ELSE DC AL1(&&FLAGS1(2));
&&ERROR: DC AL2(0);
&&INFO: DC AL2(0);
DC A(&&DALPTR);
DC A(0);
ASM IF ('&FLAGS2(1)' EQ '') THEN DC AL1(0)
ELSE DC AL1(&&FLAGS2(1));
ASM IF ('&FLAGS2(2)' EQ '') THEN DC AL1(0)
ELSE DC AL1(&&FLAGS2(2));
ASM IF ('&FLAGS2(3)' EQ '') THEN DC AL1(0)
ELSE DC AL1(&&FLAGS2(3));
ASM IF ('&FLAGS2(4)' EQ '') THEN DC AL1(0)
ELSE DC AL1(&&FLAGS2(4));
END;
'E': BEGIN
&&L: SYSLBL;
ASM IF ('&DALINIT' NE 'NO') THEN BEGIN
SYSLST &&MF(2),NEW=4+&&MF(2);
OI &&MF(2),X'80';
MZC 4+&&MF(2),20;
MVI 4+&&MF(2),20;
SYSLST 12+&&MF(2),NEW=&&DALPTR;
ASM IF ('&VERB' EQ '')
THEN MNOTE 12,'VERB REQUIRED WITH MF=E AND INIT=YES';
END;
ASM IF ('&VERB' NE '')
THEN SYSLST 5+&&MF(2),NEW=&&VERB,STORE=STC;
ASM IF ('&FLAGS1(1)' NE '')
THEN SYSLST 6+&&MF(2),NEW=&&FLAGS1(1),STORE=STC;
ASM IF ('&FLAGS1(2)' NE '')
THEN SYSLST 7+&&MF(2),NEW=&&FLAGS1(2),STORE=STC;
ASM IF ('&FLAGS2(1)' NE '')
THEN SYSLST 20+&&MF(2),NEW=&&FLAGS2(1),STORE=STC;
ASM IF ('&FLAGS2(2)' NE '')
THEN SYSLST 21+&&MF(2),NEW=&&FLAGS2(2),STORE=STC;
ASM IF ('&FLAGS2(3)' NE '')
THEN SYSLST 22+&&MF(2),NEW=&&FLAGS2(3),STORE=STC;
ASM IF ('&FLAGS2(4)' NE '')
THEN SYSLST 23+&&MF(2),NEW=&&FLAGS2(4),STORE=STC;
END;
'R': BEGIN
&&L: SYSLBL;
END;
ENDCASE ELSE;
END;
'TEXT': BEGIN
ASM IF (NOT &&DALSW) THEN BEGIN
MNOTE 12,'NO CORRESPONDING DALLIST BEGIN';
&&L: SYSLBL;
MEXIT;
END;
&&DALNUM: SETA &&DALNUM+1;
BAL;
&DALLBL(&DALNUM) SETC 'DALT&@'
ALP;
ASM CASE '&DALMF';
'','L': BEGIN
DALT&&@: DS 0X;
&&X: SETA N'&&SYSLIST-2;
&&L: DC AL2(&&VERB,&&X);
ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
&&Y: SETA &&X-2;
ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
DC AL2(&&SYSLIST(&&X,2)),&&SYSLIST(&&X,1);
END
ELSE BEGIN
DC AL2(&&SYSLIST(&&X,2)),XL(&&SYSLIST(&&X,2))'0';
END;
END
ELSE BEGIN
DC AL2(L'DAC&&Y&&@);
DAC&&Y&&@: DC &&SYSLIST(&&X,1);
END;
END;
END;
'E': BEGIN
&&L: SYSLBL;
ASM IF ('&MF' NE 'L' AND '&DALINIT' NE 'NO') THEN BEGIN
SYSLST &&DALLEN+&&DALPL,NEW=&&VERB,STORE=STOREH;
&&X: SETA N'&&SYSLIST-2;
SYSLST &&DALLEN+2+&&DALPL,NEW=&&X,STORE=STOREH;
END;
DALT&&@: EQU &&DALLEN+4;
&&DALLEN: SETC 'DALT&@';
ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
&&Y: SETA &&X-2;
ASM IF ('&MF' NE 'L') THEN BEGIN
ASM IF ('&SYSLIST(&X,3)' EQ '') THEN BEGIN
ASM IF ('&DALINIT' NE 'NO')
THEN SYSLST &&DALLEN+&&DALPL,_
NEW=&&SYSLIST(&&X,2),STORE=STOREH;
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
DALLISTM &&DALLEN+2+&&DALPL,_
&&SYSLIST(&&X,1),&&SYSLIST(&&X,2);
END;
END
ELSE BEGIN
ASM IF ('&SYSLIST(&X,3)'(1,1) NE '''')
THEN BEGIN
SYSLST &&DALLEN+&&DALPL,_
NEW=&&SYSLIST(&&X,3),STORE=STOREH;
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
DALLISTM &&DALLEN+2+&&DALPL,_
&&SYSLIST(&&X,1),&&SYSLIST(&&X,3);
END;
END
ELSE BEGIN
&&STORE: SETC '&SYSLIST(&X,3)'(2,_
K'&&SYSLIST(&&X,3)-2);
ASM CASE '&STORE';
'STC','STOREB': <&&Y: SETA 1>;
'STH','STOREH','STORELH': <&&Y: SETA 2>;
'STOREP': <&&Y: SETA 3>;
'ST','STOREF','STORELF': <&&Y: SETA 4>;
ENDCASE
ELSE BEGIN
MNOTE 12,'UNABLE TO DETERMINE LENGTH '_
'FROM OPCODE (&STORE)';
&&Y: SETA 0;
END;
ASM IF ('&DALINIT' NE 'NO' OR _
'&Y' NE '&SYSLIST(&X,2)')
THEN SYSLST &&DALLEN+&&DALPL,NEW=&&Y,_
STORE=STOREH;
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
SYSLST &&DALLEN+2+&&DALPL,_
NEW=&&SYSLIST(&&X,1),STORE=&&STORE;
END;
END;
END;
END;
ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
DAL&&Y&&@: EQU &&DALLEN+2+&&SYSLIST(&&X,2);
END
ELSE BEGIN
ASM IF ('&MF' NE 'L') THEN BEGIN
DAL&&Y&&@: EQU &&DALLEN+2+&&LQ&&SYSLIST(&&X,1);
END
ELSE BEGIN
DAC&&Y&&@: DS 0&&SYSLIST(&&X,1);
DAL&&Y&&@: EQU &&DALLEN+2+L'DAC&&Y&&@;
END;
END;
&&DALLEN: SETC 'DAL&Y&@';
END;
END;
'R': BEGIN
&&L: SYSLBL;
DALT&&@: EQU &&DALLEN+4;
&&DALLEN: SETC 'DALT&@';
ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
&&Y: SETA &&X-2;
ASM IF ('&MF' NE 'L') THEN BEGIN
ASM IF ('&SYSLIST(&X,3)' EQ '') THEN BEGIN
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
DALLISTM &&SYSLIST(&&X,1),_
&&DALLEN+2+&&DALPL,&&SYSLIST(&&X,2);
END;
END
ELSE BEGIN
ASM IF ('&SYSLIST(&X,3)'(1,1) NE '''')
THEN BEGIN
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
DALLISTM &&SYSLIST(&&X,1),_
&&DALLEN+2+&&DALPL,&&SYSLIST(&&X,3);
END;
END
ELSE BEGIN
&&STORE: SETC '&SYSLIST(&X,3)'(2,_
K'&&SYSLIST(&&X,3)-1);
ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
ASM CASE '&STORE';
'STC','STOREB': <&&LOAD: SETC 'IC'>;
'STOREH','STOREH','STORELH':
<&&LOAD: SETC 'LOADH'>;
'STOREP': <&&LOAD: SETC 'LOADP'>;
'ST','STOREF','STORELF':
<&&LOAD: SETC 'LOADF'>;
ENDCASE
ELSE BEGIN
MNOTE 12,'UNABLE TO DETERMINE PROPER '_
'LOAD OPERATION FOR STORE OPERATION '_
'&STORE';
&&LOAD: SETC '?';
END;
SYSLST &&DALLEN+2+&&DALPL,OLD=RTNR,_
LOAD=&&LOAD;
SYSLST &&SYSLIST(&&X,1),NEW=(RTNR),_
STORE=&&STORE;
END;
END;
END;
END;
ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
DAL&&Y&&@: EQU &&DALLEN+2+&&SYSLIST(&&X,2);
END
ELSE BEGIN
ASM IF ('&MF' NE 'L') THEN BEGIN
DAL&&Y&&@: EQU &&DALLEN+2+&&LQ&&SYSLIST(&&X,1);
END
ELSE BEGIN
DAC&&Y&&@: DS 0&&SYSLIST(&&X,1);
DAL&&Y&&@: EQU &&DALLEN+2+L'DAC&&Y&&@;
END;
END;
&&DALLEN: SETC 'DAL&Y&@';
END;
END;
ENDCASE ELSE;
END;
'END': BEGIN
ASM IF (NOT &&DALSW) THEN BEGIN
MNOTE 12,'NO CORRESPONDING DALLIST BEGIN';
&&L: SYSLBL;
MEXIT;
END;
ASM IF ('&DALMF' EQ '' OR '&DALMF' EQ 'L') THEN BEGIN
&&L: SYSLBL TYPE=F;
&&DALPTR: DS 0F;
ASM IF (&&DALNUM LE 0)
THEN MNOTE 12,'NO DALLIST TEXT ITEMS'
ELSE BEGIN
ASM FOR &&X FROM 1 TO &&DALNUM-1 DO BEGIN
DC A(&&DALLBL(&&X));
END
THEN BEGIN
DC A(X'80000000'+&&DALLBL(&&DALNUM));
END;
END;
END;
ASM IF ('&DALMF' EQ 'E' OR '&DALMF' EQ 'R') THEN BEGIN
&&L: SYSLBL;
END;
ASM IF ('&DALMF' EQ 'E' AND '&DALINIT' NE 'NO') THEN BEGIN
&&DALPTR: EQU (&&DALLEN+3)/4*4+&&DALPL;
&&Y: SETA 0;
ASM FOR &&X FROM 1 TO &&DALNUM DO BEGIN
&&Y: SETA (&&X-1)*4;
SYSLST &&DALPTR+&&Y,NEW=&&DALLBL(&&X)-4+&&DALPL;
END;
OI &&DALPTR+&&Y,X'80';
END;
ASM IF ('&DALMF' EQ '' OR '&DALMF' EQ 'E') THEN BEGIN
ASM IF ('&DALMF' EQ '') THEN <&&DALEND: SYSLBL>;
ASM IF ('&SVC' NE 'NO') THEN BEGIN
SYSLR VR1,&&DALPL;
DYNALLOC;
END;
END;
&&DALSW: SETB 0;
END;
ENDCASE
ELSE BEGIN
MNOTE 12,'"DALLIST &TYPE" IS ILLEGAL';
&&L: SYSLBL;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=DALLISTM
ALP;
MACRO &&L: DALLISTM &&TO,&&FROM,&&LEN;
ASM IF ('&LEN' EQ '') THEN MMVC &&TO,&&FROM
ELSE BEGIN
ASM IF ('&LEN'(1,1) NE '(')
THEN MMVC &&TO,&&FROM,&&LEN
ELSE IF <RP &&LEN> THEN EXI &&LEN,MMVC,&&TO,&&FROM,DECR=YES,_
INCR=YES;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=DALMSG
ALP;
MACRO &&LBL: DALMSG &&DALLIST=,&&RC=,&&MSG1=,_
&&FLAGS1=,&&FLAGS2=,_
&&MSG2=,&&MSG2LEN=,&&MSG1LEN=,&&MF=L;
LCLC &&Q,&&OP,&&F1,&&F2;
&&Q: SETC '&SYSNDX';
&&F1: SETC '40'; % DEFAULT FLAGS
&&F2: SETC '33'; % DEFAULT FLAGS2
&&OP: SETC 'DC'; % ASSUME LIST FORM
ASMIF ('&MF(1)' EQ 'L') THEN
BEGIN
ASMIF ('&FLAGS1' NE '') THEN &&F1: SETC '&FLAGS1';
ASMIF ('&FLAGS2' NE '') THEN &&F2: SETC '&FLAGS2';
DAMS&&Q: DS 0F;
&&LBL: &&OP A(0);
&&OP A(DAMR&&Q); %RETURN CODE
&&OP A(*+8); %ZEROES
&&OP A(DAMF&&Q); %FLAGS
&&OP A(0);
&&OP A(DAMB&&Q); %BUFFER
DAMR&&Q: &&OP A(0); %WILL CONTAIN RETURN CODE
DAMF&&Q: &&OP X'&F1',X'&F2'; %FLAGS
DAMB&&Q: DS 0H;
&&MSG1LEN: &&OP H'0',H'0'; %LENGTH OF 1ST MSG, 0
&&MSG1: &&OP CL251' '; %TEXT OF 1ST MESSAGE
&&MSG2LEN: &&OP H'0',H'0'; %LENGTH OF 2ND MSG, 0
&&MSG2: &&OP CL251' ';
MEXIT;
END;
&&LBL: SYSLR VR0,&&RC,OP=L;
SYSLR VR1,&&MF(2);
ST VR0,24(,VR1);
ASMIF ('&FLAGS1' NE '') THEN
BEGIN
MVI 28(VR1),X'&F1';
END;
ASMIF ('&FLAGS2' NE '') THEN
BEGIN
MVI 29(VR1),X'&F2';
END;
SYSLR VR1,&&DALLIST,OP=L;
ST VR1,&&MF(2);
LA VR1,&&MF(2);
LINK EP=IKJEFF18;
MEND;
BAL;
./ ADD LIST=ALL,NAME=DBCCALL
ALP;
MACRO &&L: DBCCALL &&STR,&&IF=;
GBLC &&DBC;
LCLC &&LBL,&&CODE,&&MSG(8);
LCLA &&LEN,&&P,&&Q,&&X;
ASM IF ('&IF' EQ '') THEN BEGIN % UNCONDITIONAL CALL
ASM IF ('&DBC' NE 'YES') THEN BEGIN
ASM IF ('&STR' EQ '')
THEN <&&L: DC H'0'>
ELSE <&&L: DC 0H'0',X'00',C&&STR>;
END
ELSE BEGIN
ASM IF ('&STR' EQ '') THEN <&&L: DC 0H'0',X'00DEAD00'>
ELSE BEGIN
&&LBL: SETC 'DBC&@.A';
ASM IF ('&L' NE '') THEN <&&LBL: SETC '&L'>;
&&LBL: DC 0H'0',X'00DEAD',AL1(DBC&&@.L),C&&STR;
DBC&&@.L: EQU *-&&LBL-4;
END;
END;
END
ELSE BEGIN % CONDITIONAL CALL
&&P: SETA 1;
ASM FOR &&X FROM 2 TO K'&&STR-2 DO BEGIN
&&LEN: SETA &&LEN+1;
ASM IF (K'&&MSG(&&P) GE 8) THEN <&&P: SETA &&P+1>;
&&MSG(&&P): SETC '&MSG(&P)'.'&STR'(&&X,1);
ASM IF ('&STR'(&X,1) EQ ''''''(1,1)) THEN BEGIN
&&Q: SETA (&&Q+1)-(&&Q+1)/2*2;
&&LEN: SETA &&LEN-&&Q;
END;
END;
&&CODE: SETC ''; % X'00'
ASM IF ('&DBC' EQ 'YES') THEN BEGIN
&&CODE: SETC '#['; % X'00DEAD'
ASM SELECT FIRST;
(&&LEN LT 64): &&CODE: SETC '&CODE'._
'
'_
''(&&LEN,1);
(&&LEN LT 2*64): &&CODE: SETC '&CODE'._
' &akb+.<(+|&&)*[%c(!$*);^-/_\]^,:,%_>?W012|V{`:#@''="'_
''(&&LEN-64,1);
(&&LEN LT 3*64): &&CODE: SETC '&CODE'._
'xabcdefghi$s/.EjklmnopqrNq~H~stuvwxyzo@Z[ry56}789f;<=Y?]XD'_
''(&&LEN-2*64,1);
(&&LEN LT 4*64): &&CODE: SETC '&CODE'._
'{ABCDEFGHIKJ>hlm}JKLMNOPQR!-ut#\gSTUVWXYZ idQ01234567893wpz''_
''(&&LEN-3*64,1);
ENDSEL;
END;
ASM IF ((&&LEN+K'&&CODE) NE (&&LEN+K'&&CODE)/2*2) THEN BEGIN
&&LEN: SETA &&LEN+1;
ASM IF (K'&&MSG(&&P) GE 8) THEN <&&P: SETA &&P+1>;
&&MSG(&&P): SETC '&MSG(&P)'.' ';
END;
SYSPRED =C'&CODE&MSG(1)&MSG(2)&MSG(3)&MSG(4)&MSG(5)&MSG(6)'_
'&MSG(7)&MSG(8)',IF=&&IF;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=DCC
MACRO
&L DCC &CONST,&LENGTH=
AIF ('&LENGTH' EQ '').NULL
AIF ('&LENGTH' EQ '0').ZERO
&L DC &CONST
MEXIT
.*
.NULL ANOP
MNOTE 12,'LENGTH MUST BE SPECIFIED'
.*
.ZERO ANOP
AIF ('&L' EQ '').END
&L EQU *,0
.END MEND
./ ADD LIST=ALL,NAME=DEBLANK
MACRO
&L DEBLANK &S,&N,&W,&TYPE=RIGHT,&ZERO=YES,&NULL=YES,&LABEL=, *
&FILL=C' ',&FILADDR=
LCLB &END
LCLC &LL,&R
LCLA &D
SYSKWT TYPE,&TYPE,(LEFT,RIGHT,BOTH,NONE),COND=NO,NULL=NO
SYSKWT ZERO,&ZERO,(YES,NO),COND=NO,NULL=NO
SYSKWT NULL,&NULL,(YES,NO),COND=NO,NULL=NO
AIF ('&TYPE' EQ '').NONE
&LL SETC '&L'
&R SETC 'DEBL&SYSNDX'
AIF ('&LABEL' EQ '' OR '&NULL' EQ 'NO').NR
&R SETC '&LABEL'
.NR ANOP
AIF ('&TYPE' EQ 'LEFT').LEFT
AIF ('&W' NE '' AND '&W' NE '&S').DIFF
AIF ('&ZERO' EQ 'NO').NZ1
&LL LTR &N,&N TEST LENGTH
BNP &R BR IF ZERO
&END SETB 1
&LL SETC ''
.NZ1 ANOP
&LL ALR &S,&N POINT AT END OF STRING
&LL SETC ''
BCTR &S,0 NEXT CHARACTER
DEBLANKT &S,&FILL,&FILADDR IS IT BLANK?
AIF ('&NULL' EQ 'NO' OR ('&LABEL' EQ '' AND '&TYPE' EQ 'RIGHT')).NN1
BNE *+12 BR IF NOT BLANK
BCT &N,*-10 DECR. COUNT AND TRY AGAIN
B &R BR IF NULL RESULT
&END SETB 1
SLR &S,&N COMPUTE START OF STRING
LA &S,1(,&S)
AGO .LEFT
.NN1 BNE *+8 BR IF NOT BLANK
BCT &N,*-10 DECR. COUNT AND TRY AGAIN
SLR &S,&N COMPUTE START OF STRING
LA &S,1(,&S)
AGO .LEFT
.DIFF ANOP
&LL LTR &W,&N COUNT TO WORK REGISTER
&LL SETC ''
AIF ('&ZERO' EQ 'NO').NZ2
BNP &R BR IF NULL STRING
&END SETB 1
.NZ2 ALR &W,&S POINT AT END OF STRING
BCTR &W,0 NEXT CHARACTER
DEBLANKT &W,&FILL,&FILADDR IS IT BLANK?
AIF ('&NULL' EQ 'NO' OR ('&LABEL' EQ '' AND '&TYPE' EQ 'RIGHT')).NN2
BNE *+12 BR IF NOT BLANK
BCT &N,*-10 DECR. COUNT AND TRY AGAIN
B &R BR IF NULL RESULT
&END SETB 1
AGO .LEFT
.NN2 BNE *+8 BR IF NOT BLANK
BCT &N,*-10 DECR. COUNT AND TRY AGAIN
.LEFT AIF ('&TYPE' EQ 'RIGHT').DONE
AIF ('&ZERO' EQ 'NO' OR '&TYPE' NE 'LEFT').NZ3
&LL LTR &N,&N TEST FOR ZERO LENGTH
BNP &R BR IF ZERO
&END SETB 1
&LL SETC ''
.NZ3 ANOP
&LL DEBLANKT &S,&FILL,&FILADDR CHARACTER BLANK?
&LL SETC ''
&D SETA 12
AIF ('&R' EQ 'DEBL&SYSNDX').N16
&D SETA 16
.N16 ANOP
AIF ('&TYPE' NE 'LEFT' AND ('&W' EQ '' OR '&W' EQ '&S')).NLA
BNE *+&D BR IF NOT BLANK
LA &S,1(,&S) NEXT CHARACTER
AGO .BCT
.NLA ANOP
&D SETA &D-4
BNE *+&D
.BCT BCT &N,*-12 DECR. COUNT AND TRY AGAIN
AIF ('&R' EQ 'DEBL&SYSNDX').DONE
B &R NULL RESULT
.DONE AIF (&END EQ 0 OR '&R' NE 'DEBL&SYSNDX').NL
DEBL&SYSNDX DS 0H
.NL MEXIT
.NONE ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=DEBLANKT
MACRO
&L DEBLANKT &R,&FILL,&FILADDR
AIF ('&FILADDR' EQ '').FILL
&L CLC 0(1,&R),&FILADDR
MEXIT
.*
.FILL ANOP
&L CLI 0(&R),&FILL
MEND
./ ADD LIST=ALL,NAME=DF
MACRO
&L DF &INIT=
LCLA &X,&Y,&Z,&V
LCLC &T(8),&S,&I(10)
.*
&T(1) SETC '80'
&T(2) SETC '40'
&T(3) SETC '20'
&T(4) SETC '10'
&T(5) SETC '08'
&T(6) SETC '04'
&T(7) SETC '02'
&T(8) SETC '01'
.*
&Y SETA 1
&I(1) SETC '0'
.*
AIF ('&L' EQ '').NLBL
&V SETA (N'&SYSLIST+7)/8
&L DS 0XL&V
.NLBL ANOP
.*
.LOOP ANOP
AIF ((&X EQ 0 OR &X/8*8 NE &X) AND &X LT N'&SYSLIST).NDS
.*
.CLEAR ANOP
&Y SETA &Y+1
&I(&Y) SETC ''
AIF (&Y LT 9).CLEAR
&Y SETA 1
.*
DC AL1(&I(1)&I(2)&I(3)&I(4)&I(5)&I(6)&I(7)&I(8)&I(9))
.NDS ANOP
.*
&X SETA &X+1
AIF (&X GT N'&SYSLIST).END
&S SETC '&T(&X-(&X-1)/8*8)'
&SYSLIST(&X) DS 0XL(X'&S')
.*
&Z SETA 0
.INIT ANOP
&Z SETA &Z+1
AIF (&Z GT N'&INIT).LOOP
AIF ('&SYSLIST(&X)' NE '&INIT(&Z)').INIT
&Y SETA &Y+1
&I(&Y) SETC '+X''&S'''
AGO .LOOP
.*
.END MEND
./ ADD LIST=ALL,NAME=DI
MACRO
&L DI &R,&V
LCLA &X
.*
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).INT
AIF ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
.*
&L D &R,=A(&V)
MEXIT
.*
.INT ANOP
&L D &R,=F'&V'
MEND
./ ADD LIST=ALL,NAME=DSC
MACRO
&L DSC &CONST,&LENGTH=
AIF ('&LENGTH' EQ '').NULL
AIF ('&LENGTH' EQ '0').ZERO
&L DS &CONST
MEXIT
.*
.NULL ANOP
MNOTE 12,'LENGTH MUST BE SPECIFIED'
.*
.ZERO ANOP
AIF ('&L' EQ '').END
&L EQU *,0
.END MEND
./ ADD LIST=ALL,NAME=EDIT
MACRO
&L EDIT &T,&F,&TL,&FL,&CALC=YES,&DIGITS=1,&MARK=NO
LCLA &TOLEN,&FLEN,&D,&IX
LCLC &H(16),&MK
.*
AIF ('&TL' NE '').USETL
AIF (T'&T NE 'N' AND T'&T NE 'O' AND T'&T NE 'T' AND X
T'&T NE 'W' AND T'&T NE 'U' AND T'&T NE '$' AND X
T'&T NE 'M').TOOK
MNOTE 12,'TO FIELD DOES NOT HAVE AN EXPLICIT OR IMPLICIT LENGTH'
MEXIT
.TOOK ANOP
&TOLEN SETA L'&T
MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&TOLEN)'
AGO .CKFL
.USETL ANOP
&TOLEN SETA &TL
.CKFL ANOP
AIF ('&FL' NE '').USEFL
AIF (T'&F NE 'N' AND T'&F NE 'O' AND T'&F NE 'T' AND X
T'&F NE 'W' AND T'&F NE 'U' AND T'&F NE '$' AND X
T'&F NE 'M').FOK
MNOTE 12,'FROM FIELD DOES NOT HAVE AN EXPLICIT OR IMPLICIT LENGTH'
MEXIT
.FOK ANOP
&FLEN SETA L'&F
AGO .LENDONE
.USEFL ANOP
&FLEN SETA &FL
MNOTE *,'LENGTH ATTRIBUTE OF SECOND OPERAND USED (&FLEN)'
.LENDONE ANOP
.*
AIF (2*(&TOLEN/2) EQ &TOLEN).LENOK
MNOTE 4,'LENGTH OF &T MUST BE EVEN'
MEXIT
.LENOK ANOP
AIF (&FLEN+&FLEN GE &TOLEN).NEXT
MNOTE 4,'&F DOES NOT HAVE ENOUGH SOURCE DIGITS'
MEXIT
.NEXT ANOP
AIF ('&MARK' EQ 'NO').NOMK
&MK SETC 'MK'
.NOMK ANOP
.*
&IX SETA 1
&H(1) SETC '40'
.L1 ANOP
&IX SETA &IX+1
&H(&IX) SETC '20'
AIF (&IX LT &TOLEN).L1
.*
&D SETA &DIGITS
AIF (&D EQ 0 OR &TOLEN EQ 2).NOSIG
&H(&IX-&D) SETC '21'
.NOSIG ANOP
.*
&L SYSXXCB MVC,&T,=X'&H(1)&H(2)&H(3)&H(4)&H(5)&H(6)&H(7)&H(8)&H(9X
)&H(10)&H(11)&H(12)&H(13)&H(14)&H(15)&H(16)',&TOLEN
AIF ('&MARK' EQ 'NO').NOMK2
LA 1,&T+&TOLEN-&D
.NOMK2 ANOP
.*
AIF ('&CALC' EQ 'YES').CALC
SYSXXCB ED&MK,&T,&F,&TOLEN
MEXIT
.CALC ANOP
SYSXXCB ED&MK,&T,&FLEN-(&TOLEN-1)/2-1+&F,&TOLEN
MEND
./ ADD LIST=ALL,NAME=EXI
MACRO
&L EXI &R,&OP,&A,&B,&DECR=NO,&INCR=NO
GBLC &EXOP(25),&EXA(250),&EXB(250)
GBLA &EXORG,&EXN
LCLA &X,&Z
LCLC &LBL
.*
SYSKWT DECR,&DECR,(YES,NO),COND=NO,NULL=NO
SYSKWT INCR,&INCR,(YES,NO),COND=NO,NULL=NO
.*
&LBL SETC '&L'
.*
AIF ('&DECR' NE 'YES').NDECR
&LBL SI &R,1
&LBL SETC ''
.NDECR ANOP
.*
&X SETA 0
.SLOOP ANOP
&X SETA &X+1
AIF (&X GT &EXN).SDONE
AIF ('&OP' NE '&EXOP(&X)').SLOOP
&Z SETA (&X-1)*10
AIF ('&A' NE '&EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&*
Z+5)&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10)'*
).SLOOP
AIF ('&B' NE '&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&*
Z+5)&EXB(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)'*
).SLOOP
.*
&X SETA &EXORG+&X
&LBL EX &R,EXI#&X
AGO .INCR
.*
.SDONE ANOP
.*
AIF (&EXN LT 25).OK
MNOTE 12,'EXI TABLE FULL'
&LBL EX &R,0
AGO .INCR
.*
.OK ANOP
.*
&EXN SETA &EXN+1
.*
&X SETA &EXORG+&EXN
&LBL EX &R,EXI#&X
.*
&EXOP(&EXN) SETC '&OP'
.*
&X SETA 0
AIF ('&A' EQ '').AFILL
.ALOOP ANOP
&X SETA &X+1
AIF (&X*8 GE K'&A).ADONE
&EXA((&EXN-1)*10+&X) SETC '&A'((&X-1)*8+1,8)
AIF (&X LT 10).ALOOP
MNOTE 12,'OPERAND TOO LONG'
AGO .AFILLED
.*
.ADONE ANOP
&EXA((&EXN-1)*10+&X) SETC '&A'((&X-1)*8+1,K'&A-(&X-1)*8)
.AFILL ANOP
&X SETA &X+1
AIF (&X GT 10).AFILLED
&EXA((&EXN-1)*10+&X) SETC ''
AGO .AFILL
.*
.AFILLED ANOP
.*
&X SETA 0
AIF ('&B' EQ '').BFILL
.BLOOP ANOP
&X SETA &X+1
AIF (&X*8 GE K'&B).BDONE
&EXB((&EXN-1)*10+&X) SETC '&B'((&X-1)*8+1,8)
AIF (&X LT 10).BLOOP
MNOTE 12,'OPERAND TOO LONG'
AGO .BFILLED
.*
.BDONE ANOP
&EXB((&EXN-1)*10+&X) SETC '&B'((&X-1)*8+1,K'&B-(&X-1)*8)
.BFILL ANOP
&X SETA &X+1
AIF (&X GT 10).BFILLED
&EXB((&EXN-1)*10+&X) SETC ''
AGO .BFILL
.*
.BFILLED ANOP
.*
.INCR ANOP
AIF ('&INCR' NE 'YES').NINCR
AI &R,1
.NINCR ANOP
.*
MEND
./ ADD LIST=ALL,NAME=EXORG
MACRO
&L EXORG
GBLC &EXOP(25),&EXA(250),&EXB(250)
GBLA &EXORG,&EXN
LCLA &X,&Y,&Z
.*
&L SYSLBL
.*
&Y SETA &EXN
&EXN SETA 0
.*
.LOOP ANOP
&X SETA &X+1
AIF (&X GT &Y).END
&Z SETA (&X-1)*10
&EXORG SETA &EXORG+1
AIF ('&EXOP(&X)' EQ 'MCLC').MCLC
AIF ('&EXOP(&X)' EQ 'MMVC').MMVC
AIF ('&EXOP(&X)' EQ 'MNC').MNC
AIF ('&EXOP(&X)' EQ 'MOC').MOC
AIF ('&EXOP(&X)' EQ 'MXC').MXC
AIF ('&EXOP(&X)' EQ 'MTC').MTC
AIF ('&EXOP(&X)' EQ 'MTR').MTR
AIF ('&EXOP(&X)' EQ 'MTRT').MTRT
AIF ('&EXOP(&X)' EQ 'MZC').MZC
EXI#&EXORG EXORGA &EXOP(&X),&EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EX*
A(&Z+5)&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+1*
0),&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EX*
B(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)
AGO .LOOP
.*
.MCLC ANOP
EXI#&EXORG MCLC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MMVC ANOP
EXI#&EXORG MMVC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MNC ANOP
EXI#&EXORG MNC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MOC ANOP
EXI#&EXORG MOC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MTC ANOP
EXI#&EXORG MTC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)&EXA*
(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),0,N=1
AIF ('&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB*
(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)' EQ '').*
MTCOK
MNOTE 12,'TWO OPERANDS ILLEGAL FOR EXI MTC'
.MTCOK ANOP
AGO .LOOP
.*
.MTR ANOP
EXI#&EXORG MTR &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MTRT ANOP
EXI#&EXORG MTRT &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MXC ANOP
EXI#&EXORG MXC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
AGO .LOOP
.*
.MZC ANOP
EXI#&EXORG MZC &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)&EXA*
(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),0,N=1
AIF ('&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB*
(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)' EQ '').*
MZCOK
MNOTE 12,'TWO OPERANDS ILLEGAL FOR EXI MZC'
.MZCOK ANOP
AGO .LOOP
.*
.END MEND
./ ADD LIST=ALL,NAME=EXORGA
MACRO
&L EXORGA &OP,&A,&B
AIF ('&B' EQ '').ONE
&L &OP &A,&B
MEXIT
.*
.ONE ANOP
&L &OP &A
MEND
./ ADD LIST=ALL,NAME=FASTPOST
ALP;
MACRO &&L: FASTPOST &&ECB,&&CODE,&®=,&&SUPMODE=,&&SAVELOC=,_
&&ENABLED=;
GBLC &&OS;
SYSKWT SUPMODE,&&SUPMODE,(YES,NO);
SYSKWT ENABLED,&&ENABLED,(YES,NO),COND=NO;
&&L: SYSLBL;
ASM CASE '&OS';
'MFT','MVT': ; % NO FAST POST
'MVS','XA': BEGIN
ASM IF ('&SUPMODE(1)' EQ 'YES' AND '&SAVELOC' NE '') THEN BEGIN
FPDO&&@: DO BEGIN
ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
&&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
THEN L VR0,=XL4'40000000'
ELSE BEGIN
ASM IF ('&CODE' NE '(0)') THEN SYSLR VR0,&&CODE;
O VR0,=XL4'40000000';
END;
DO BEGIN
L VRF,0(,VR1); % GET CURRENT VALUE OF ECB
IF <RNM VRF> THEN BEGIN % NOT WAITED ON
CS VRF,VR0,0(VR1); % TRY TO POST
EXIT FROM FPDO&&@ IF <CC E>; % GOT IT
NEXT; % TRY AGAIN
END;
END;
POST (1),(0);
EXIT;
NSUP&&@: ;
END;
SYSLR &®,(XRA); % SAVE REGISTER 2
SYSCMP XRA,EQ,2;
MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2; % GO KEY ZERO
ASM IF ('&ENABLED' NE 'NO') THEN
SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
THEN L VR0,=XL4'40000000'
ELSE BEGIN
SYSLR VR0,&&CODE;
O VR0,=XL4'40000000';
END;
ST VR0,0(,VR1); % POST THE ECB
IF <CLI &&SAVELOC,255> THEN BEGIN % WAIT FLAG ON
MVI &&SAVELOC,0; % TURN WAIT FLAG OFF
STM 3,13,12(STKR); % SAVE REGISTERS
LR XRB,STKR; % SAVE STACK POINTER
SYSCMP XRB,EQ,3;
LM 4,5,&&SAVELOC; % GET TCB AND RB ADDRESSES
RESUME TCB=(4),RB=(5); % FORCE OUT OF WAIT
LM 3,13,12(XRB); % RESTORE REGISTERS
END;
ASM IF ('&ENABLED' NE 'NO') THEN
SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
MODESET KEYADDR=(2); % RESTORE KEY
SYSLR XRA,(&®); % RESTORE REGISTER 2
END;
ASM EXIT;
END;
ASM IF ('&SUPMODE(1)' EQ 'YES') THEN BEGIN
FPDO&&@: DO BEGIN
SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
THEN L VR0,=XL4'40000000'
ELSE BEGIN
SYSLR VR0,&&CODE;
O VR0,=XL4'40000000';
END;
DO BEGIN
L VRF,0(,VR1); % GET CURRENT VALUE OF ECB
IF <RNM VRF> THEN BEGIN % NOT WAITED ON
CS VRF,VR0,0(VR1); % TRY TO POST
EXIT FROM FPDO&&@ IF <CC E>; % GOT IT
NEXT; % TRY AGAIN
END;
END;
ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
&&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
POST (1),(0);
EXIT;
NSUP&&@: ;
END;
SYSLR &®,(XRA); % SAVE REGISTER 2
MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2; % KEY ZERO
ASM IF ('&ENABLED' NE 'NO') THEN
SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=SAVE,_
RELATED=*;
STM 10,11,12(STKR); % SAVE REGISTERS
SYSCMP STKR,EQ,13;
LR 11,VR1; % ECB ADDRESS
LR 10,VR0; % COMPLETION CODE
L VRF,CVTPTR; % CVT ADDRESS
L VRF,CVT0PT01-CVT(VRF); % ENTRY POINT TO POST
CBALR VRE,VRF; % CALL POST ROUTINE
LM 10,11,12(STKR); % RESTORE REGISTERS
ASM IF ('&ENABLED' NE 'NO') THEN
SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
MODESET KEYADDR=(2); % RESTORE KEY
SYSLR XRA,(&®); % RESTORE REGISTER 2
END;
ASM EXIT;
END;
END;
ENDCASE
ELSE MNOTE 4,'FASTPOST UNDEFINED FOR &OS, NORMAL POST USED'
THEN BEGIN
POST &&ECB,&&CODE;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=FASTWAIT
ALP;
MACRO &&L: FASTWAIT &&COUNT,&&ECB=,&&ECBLIST=,&®=,&&SUPMODE=,_
&&LABEL=,&&SAVELOC=;
GBLC &&OS;
SYSKWT SUPMODE,&&SUPMODE,(YES,NO);
ASM CASE '&OS';
'MFT','MVT': ; % NO FAST WAIT
'MVS','XA': BEGIN
ASM IF ('&SUPMODE(1)' EQ 'YES' AND '&SAVELOC' NE '') THEN BEGIN
ASM IF ('&COUNT' NE '' AND '&COUNT' NE '1') THEN BEGIN
MNOTE 4,'WAIT COUNT OF 1 REQUIRED WITH SAVELOC OPTION';
END;
&&L: SYSLBL;
DO BEGIN
ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
ASM IF ('&LABEL' NE '') THEN BEGIN
MNOTE 12,'LABEL INVALID WITH CONDITIONAL SUPMODE';
END;
SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
&&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
EXIT;
NSUP&&@: ;
END;
SYSLR &®,(XRA); % SAVE REGISTER 2
SYSCMP XRA,EQ,2;
MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2; % GO KEY ZERO
SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
FWDO&&@: DO BEGIN
ASM IF ('&ECBLIST' EQ '') THEN BEGIN
SYSLR VR1,&&ECB,ERR='ECB OR ECBLIST REQUIRED';
IF <TM 0(VR1),X'40'> THEN BEGIN % ECB IS POSTED
SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
EXIT;
END;
END
ELSE BEGIN
SYSLR VR1,&&ECB&&ECBLIST;
DO BEGIN
L VRF,0(,VR1); % GET ECB ADDRESS
IF <TM 0(VRF),X'40'> THEN BEGIN % ECB IS POSTED
SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
EXIT FROM FWDO&&@;
END;
IF <RNM VRF> THEN BEGIN % NOT LAST ECB
AI VR1,4; % NEXT ECB
NEXT;
END;
END;
END;
L VRF,CVTPTR; % GET ADDRESS OF CVT
L VRE,CVTTCBP-CVT(,VRF); L VRE,0(,VRE); % GET TCB
L VRF,TCBRBP-TCB(,VRE); % GET RB ADDRESS
ASM IF ('&OS' EQ 'MVS') THEN ZHBR VRF;
STM VRE,VRF,&&SAVELOC; % SAVE TCB AND RB ADDRESS
MVI &&SAVELOC,255; % INDICATE WAIT
ST &®,12(STKR); % SAVE REGISTER
STM 11,13,12+4(STKR); % SAVE SUSPEND REGS
LR &®,STKR; % SAVE STACK REG
SUSPEND RB=CURRENT; % GO INTO WAIT STATE
SETLOCK RELEASE,TYPE=LOCAL,RELATED=*; % RELEASE LOCK
LM 11,13,12+4(&®); % RESTORE REGISTERS
L &®,12(,STKR);
IF <CLI &&SAVELOC,255> THEN BEGIN
CALLDISP BRANCH=YES; % GO TO MVS DISPATCHER
&&LABEL: SYSLBL;
END;
END;
MODESET KEYADDR=(2); % RESTORE KEY
SYSLR XRA,(&®); % RESTORE REGISTER 2
END;
ASM EXIT;
END;
ASM IF ('&SUPMODE(1)' EQ 'YES') THEN BEGIN
&&L: SYSLBL;
DO BEGIN
ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
ASM IF ('&LABEL' NE '') THEN BEGIN
MNOTE 12,'LABEL INVALID WITH CONDITIONAL SUPMODE';
END;
SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
&&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
EXIT;
NSUP&&@: ;
END;
SYSLR &®,(XRA); % SAVE REGISTER 2
SYSCMP XRA,EQ,2;
MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2; % KEY ZERO
SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
L VRF,CVTPTR; % GET ADDRESS OF CVT
L VR1,CVTTCBP-CVT(,VRF); L VR1,0(,VR1); % GET TCB ADDR
STM VR0,VRF,TCBGRS-TCB(VR1); % SAVE REGS IN TCB
L VR1,TCBRBP-TCB(,VR1); % GET RB ADDRESS
LA VR0,WAIT&&@; ST VR0,RBOPSW+4-RB(,VR1); %RESUME ADDR
SYSLR VR0,&&COUNT,NULL=1; % WAIT COUNT
ASM IF ('&ECBLIST' EQ '')
THEN SYSLR VR1,&&ECB,ERR='ECB OR ECBLIST REQUIRED' % ECB
ELSE SYSLR VR1,&&ECB&&ECBLIST,TYPE=LCR; % ECBLIST ADDR
L VRF,CVTVWAIT-CVT(,VRF); % ADDR OF WAIT ROUTINE
RGOTO VRF; % GO TO WAIT ROUTINE
&&LABEL: SYSLBL;
WAIT&&@: % RESUME ADDRESS
MODESET KEYADDR=(2); % RESTORE KEY
SYSLR XRA,(&®); % RESTORE REGISTER 2
END;
ASM EXIT;
END;
END;
ENDCASE
ELSE MNOTE 4,'FASTWAIT UNDEFINED FOR &OS, NORMAL WAIT USED'
THEN BEGIN
&&L:
WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
&&LABEL: SYSLBL;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=FLAGSEG
ALP;
MACRO &&L: FLAGSEG &®=,&&VAREA=,&&ACCT=,&&INIT=,&&LABEL=;
GBLA &&LACCT,&&LINIT;
GBLC &&SITE,&&INITNAM,&&ACCTNAM;
&&L: SYSLBL;
ASM CASE '&SITE';
'NIH': BEGIN
CASE &® MAX 12;
0: BEGIN
FLAGSEG2 &&VAREA,&&LABEL;
FLAGSEG1 &&VAREA,'PLEASE CONTACT THE PAL UNIT '_
'AS SOON AS POSSIBLE DURING REGULAR HOURS';
END;
4: BEGIN
FLAGSEG2 &&VAREA,&&LABEL;
FLAGSEG1 &&VAREA,'FOR AN IMPORTANT MESSAGE REGARDING '_
'&INITNAM ';
FLAGSEG1 &&VAREA,&&INIT,&&LINIT,DEBLANK=YES;
END;
8: BEGIN
FLAGSEG2 &&VAREA,&&LABEL;
FLAGSEG1 &&VAREA,'TELEPHONE (301) 496-5525 '_
'OR SUBMIT A "CRITICAL" PTR USING THE PTR COMMAND,'_
' GIVING A PHONE NUMBER WHERE YOU CAN BE REACHED';
END;
12: BEGIN
LTR &®,&® % SET NON-ZERO CC
EXIT; % DO NOT BUMP REGISTER
END;
ENDCASE
THEN BEGIN
AI &®,4; % BUMP TO NEXT CASE
CR &®,&® % SET ZERO CC
END;
END;
ENDCASE
ELSE BEGIN
CLI *,0; % SET NON-ZERO CC
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=FLAGSEG1
ALP;
MACRO &&L: FLAGSEG1 &&VA,&&LOC,&&LEN,&&DEBLANK=;
&&L: SYSLBL;
ASM IF ('&VA' EQ '') THEN TSEG &&LOC,&&LEN,DEBLANK=&&DEBLANK
ELSE VSEG &&VA,&&LOC,&&LEN,DEBLANK=&&DEBLANK;
MEND;
BAL;
./ ADD LIST=ALL,NAME=FLAGSEG2
ALP;
MACRO &&L: FLAGSEG2 &&VAREA,&&LABEL;
&&L: SYSLBL;
ASM IF ('&LABEL' EQ '') THEN MEXIT;
ASM CASE '&LABEL(1)';
'': FLAGSEG1 &&VAREA,&&LABEL(2),&&LABEL(3);
'MMSGINIT': MMSGINIT &&LABEL(2);
'WMSGINIT': WMSGINIT &&LABEL(2);
ENDCASE
ELSE BEGIN
BAL;
&LABEL(1) &LABEL(2),&LABEL(3)
ALP;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=FREESWAM
ALP;
MACRO &&L: FREESWAM &&TCB=,&&ASCB=,&&SAVEXRA=,&&SAVEXRB=,_
&&SAVEXRC=,&&SAVER7=,&&R7=;
GBLC &&OS;
ASM CASE '&OS';
'MVS','XA': BEGIN
&&L:
L VRF,&&TCB; % ADDRESS OF TCB
L VR1,TCBSWASA-TCB(VRF); % GET ADDR OF SWA MGR SAVE AREA
IF <RNZ VR1> & ^<C VRF,TCBJSTCB-TCB(VRF)> THEN BEGIN
SYSLR &&SAVEXRA,(XRA); % SAVE REGISTER 2
SYSCMP XRA,EQ,2;
MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=(2); % KEY 0
SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
SYSLR &&SAVEXRB,(XRB); % SAVE REGISTERS USED BY FREEMAIN
SYSLR &&SAVEXRC,(XRC);
SYSLR &&SAVER7,(&&R7);
L &&R7,&&ASCB; % ASCB ADDRESS FOR FREEMAIN
SYSCMP &&R7,EQ,7;
SYSCMP &&R7,NE,BASER;
L XRC,&&TCB; % TCB ADDRESS FOR FREEMAIN
SYSCMP XRC,EQ,4;
L VR1,TCBSWASA-TCB(XRC); % AREA TO FREE
Z VR0,TCBSWASA-TCB(XRC); % CLEAR POINTER IN TCB
L VRF,0(,VR1); % LENGTH AND SUBPOOL TO FREE
ZR VRE; SLDL VRE,8; SRL VRF,8; % SPLIT SUBPOOL AND LENGTH
FREEMAIN RU,A=(1),LV=(VRF),SP=(VRE),KEY=1,BRANCH=YES;
SYSCMP XRB,EQ,3;
SYSLR XRB,(&&SAVEXRB);
SYSLR XRC,(&&SAVEXRC);
SYSLR &&R7,(&&SAVER7);
SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
MODESET KEYREG=XRA; % RESTORE KEY
SYSLR XRA,(&&SAVEXRA); % RESTORE REGISTER 2
END;
END;
ENDCASE
ELSE <&&L: SYSLBL>;
MEND;
BAL;
./ ADD LIST=ALL,NAME=GBLSET
ALP;
MACRO &&L: GBLSET;
GBLC &&CPU,&&MP,&&OS;
LCLA &&X;
&&L: SYSLBL;
ASM FOR &&X FROM 1 TO N'&&SYSLIST DO BEGIN
ASM CASE '&SYSLIST(&X,1)';
'CPU': BEGIN
&&CPU: SETC '&SYSLIST(&X,2)';
SYSKWT &&&&CPU,&&CPU,(360,370),COND=NO,NULL=NO;
END;
'MP': BEGIN
&&MP: SETC '&SYSLIST(&X,2)';
SYSKWT &&&&MP,&&MP,(YES,NO),COND=NO,NULL=NO;
END;
'OS': BEGIN
&&OS: SETC '&SYSLIST(&X,2)';
SYSKWT &&&&OS,&&OS,(MFT,MVT,VS1,SVS,MVS,XA),_
COND=NO,NULL=NO;
END;
ENDCASE
ELSE MNOTE 12,'"&SYSLIST(&X,1)" IS ILLEGAL';
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=IPRIVSCN
ALP;
MACRO &&L: IPRIVSCN &&BYTE,&&TYPE=;
LCLC &&LBL;
&&LBL: SETC 'ISCN&SYSNDX';
SYSKWT TYPE,&&TYPE,(NO),COND=NO;
&&L: SYSLBL;
BEGIN SCAN *;
SCKW &&TYPE.SYSTEMS,&&LBL,CODE=AL1(KWRIFSPR);
SCKW &&TYPE.ACCOUNTING,&&LBL,CODE=AL1(KWRIFAPR);
SCKW &&TYPE.OPERATOR,&&LBL,CODE=AL1(KWRIFOPR);
SCKW &&TYPE.BASIC,&&LBL,CODE=AL1(KWRIFBPR);
SCKW &&TYPE.UNDER,&&LBL,CODE=AL1(KWRIFUPR);
SCKW &&TYPE.PROJECT,&&LBL,CODE=AL1(KWRIFPRJ);
SCKW &&TYPE.FLAG,&&LBL,CODE=AL1(KWRIFFLG);
SCKW ,*,B;
&&LBL:
ASM IF ('&TYPE' EQ 'NO')
THEN <X VRE,=XL4'FF'; EXI VRE,NI,&&BYTE,0>
ELSE EXI VRE,OI,&&BYTE,0;
SCANEND; END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=IPRIVSEG
ALP;
MACRO &&L: IPRIVSEG &&BYTE,&&BEFORE=,&&AFTER=,&&VAREA=;
&&L: SYSLBL;
SELECT;
<TM &&BYTE,KWRIFSPR>: BEGIN
IPRIVSG1 'SYSTEMS',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRIFAPR>: BEGIN
IPRIVSG1 'ACCOUNTING',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRIFOPR>: BEGIN
IPRIVSG1 'OPERATOR',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRIFBPR>: BEGIN
IPRIVSG1 'BASIC',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRIFUPR>: BEGIN
IPRIVSG1 'UNDER',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRIFPRJ>: BEGIN
IPRIVSG1 'PROJECT',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
<TM &&BYTE,KWRIFFLG>: BEGIN
IPRIVSG1 'FLAG',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
END;
ENDSEL;
MEND;
BAL;
./ ADD LIST=ALL,NAME=IPRIVSG1
ALP;
MACRO &&L: IPRIVSG1 &&STRING,&&BEFORE=,&&AFTER=,&&VAREA=;
&&L: SYSLBL;
ASM IF ('&BEFORE' NE '')
THEN IPRIVSG2 &&VAREA,&&BEFORE(1),&&BEFORE(2);
IPRIVSG2 &&VAREA,&&STRING(1),&&STRING(2);
ASM IF ('&AFTER' NE '')
THEN IPRIVSG2 &&VAREA,&&AFTER(1),&&AFTER(2);
MEND;
BAL;
./ ADD LIST=ALL,NAME=IPRIVSG2
ALP;
MACRO &&L: IPRIVSG2 &&VAREA,&&A,&&N;
&&L: SYSLBL;
ASM IF ('&VAREA' EQ '')
THEN TSEG &&A,&&N
ELSE VSEG &&VAREA,&&A,&&N;
MEND;
BAL;
./ ADD LIST=ALL,NAME=KWR2
MACRO
KWR2
GBLA &LINIT,&LACCT,&LKW
*
* NIH/COMMON - KEYWORD RECORD
*
*
* OPERATION CODES
*
KWRCWR EQU X'80' WRITE
KWRCRD EQU X'40' READ
KWRCRDNA EQU X'20' READ NEXT ACCOUNT
KWRCRDNI EQU X'10' READ NEXT INITIALS
KWRCALL EQU X'08' READ WHOLE LRECD
KWRCLONG EQU X'04' 8-BYTE KW, 4-BYTE INITIALS
KWRC31 EQU X'02' PARM LIST FOR 31 BIT MODE
KWRCXTND EQU X'01' EXTENDED AREAS USED
*
*
KWRSTART DS 0F
KWRACCT DCC CL&LACCT'AAAA',LENGTH=&LACCT ACCOUNT NO.
KWRINIT DCC CL&LINIT'ABC',LENGTH=&LINIT INITIALS
KWRKW DCC CL&LKW'XXX',LENGTH=&LKW KEYWORD
KWRHFL DC X'00' HASP STATUS FLAGS
*
KWRHFCK EQU X'80' KEYWORD CHECKING IN EFFECT
KWRHFUOK EQU X'40' UPDATE SUCCESSFUL
KWRHFROK EQU X'40' READ SUCCESSFUL
KWRHFREJ EQU X'20' REQUEST REJECTED (INVALID)
KWRHFIVI EQU X'10' INVALID INITIALS
KWRHFIVA EQU X'08' INVALID ACCOUNT
*
KWRIFL DC AL1(KWRIFVAL) INITIALS FLAGS
*
KWRIFVAL EQU X'80' VALID
KWRIFSPR EQU X'40' SYSTEM PRIVILIGE
KWRIFAPR EQU X'20' ACCOUNT PRIVILIGE
KWRIFOPR EQU X'10' OPERATOR PRIVILIGE
KWRIFUPR EQU X'08' UNDERPRIVILIGED
KWRIFPRJ EQU X'04' PROJECT
KWRIFBPR EQU X'02' BASIC PRIVILEGE
KWRIFFLG EQU X'01' CONTACT USER SERVICES FLAG
KWRIFRSV EQU X'00' RESERVED BITS
*
KWRAFL DC AL1(KWRAFVAL) ACCOUNT FLAGS
*
KWRAFVAL EQU X'80' VALID
KWRAFFLG EQU X'40' CONTACT USER SERVICES (OBSOLETE)
KWRAFCIB EQU X'20' CHECK KW IN BATCH (OBSOLETE)
KWRAFMB EQU X'10' MAIL BOX ACCOUNT
KWRAFMP EQU X'08' MAIL PENDING
KWRAFPRO EQU X'04' WYLBUR PROFILE EXISTS
KWRAFRCM EQU X'02' WYLBUR RECOVERY - MILTEN
KWRAFRCT EQU X'01' WYLBUR RECOVERY - TSO
KWRAFRSV EQU X'00'+KWRAFCIB+KWRAFFLG RESERVED BITS
*
KWRPTR DS 0AL3 OLD NAME
KWRRSV DC X'000000' FOR FUTURE USE
DS 0F
KWRSIZE EQU *-KWRSTART
*
* EXTENDED AREA
*
KWRIEXT DS XL24'00' FOR FUTURE USE
KWRAEXT DS XL9'00' FOR FUTURE USE
KWREKW DC CL8' ' LONG KW
KWREINIT DC CL4' ' LONG INITIALS
KWRESIZE EQU *-KWRSTART
MEND
./ ADD LIST=ALL,NAME=LI
MACRO
&L LI &R,&V
LCLA &X
.*
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).INT
AIF ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
.*
.LA ANOP
&L LA &R,&V
MEXIT
.*
.INT ANOP
AIF (&V LT 4096).LA
&L L &R,=F'&V'
MEND
./ ADD LIST=ALL,NAME=LQS
MACRO
&L LQS &R,&S,&QS,&N
&L SYSQS &R,&S,&QS,&N
MEND
./ ADD LIST=ALL,NAME=LOADB
MACRO
&L LOADB &R,&A,&JUNK=
SYSKWT JUNK,&JUNK,(OK,YES)
AIF ('&JUNK' NE '').JUNK
&L SLR &R,&R
IC &R,&A
MEXIT
.JUNK ANOP
&L IC &R,&A
MEND
./ ADD LIST=ALL,NAME=LOADF
MACRO
&L LOADF &R,&A,&JUNK=
GBLC &CPU,&SIM370
SYSKWT JUNK,&JUNK,(OK,YES)
AIF ('&CPU' EQ '360').S360
&L UAOP L,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
L &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=LOADH
MACRO
&L LOADH &R,&A,&JUNK=
GBLC &CPU,&SIM370
SYSKWT JUNK,&JUNK,(OK,YES)
AIF ('&CPU' EQ '360').S360
&L UAOP LH,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,2
LH &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=LOADLF
MACRO
&L LOADLF &R,&A,&JUNK=
&L LOADF &R,&A,JUNK=&JUNK
MEND
./ ADD LIST=ALL,NAME=LOADLH
MACRO
&L LOADLH &R,&A,&JUNK=
GBLC &CPU,&SIM370
SYSKWT JUNK,&JUNK,(OK,YES)
AIF ('&CPU' EQ '360').S360
AIF ('&JUNK' NE '').J370
&L SLR &R,&R
ICM &R,3,&A
MEXIT
.J370 ANOP
&L ICM &R,3,&A
MEXIT
.S360 ANOP
&L MMVC 4*2+2+&SIM370,&A,2
L &R,4*2+&SIM370
MEND
./ ADD LIST=ALL,NAME=LOADP
MACRO
&L LOADP &R,&A,&JUNK=
GBLC &CPU,&SIM370
SYSKWT JUNK,&JUNK,(OK,YES)
AIF ('&CPU' EQ '360').S360
AIF ('&JUNK' NE '').J370
&L SLR &R,&R
ICM &R,7,&A
MEXIT
.J370 ANOP
&L ICM &R,7,&A
MEXIT
.S360 ANOP
&L MMVC 4*1+1+&SIM370,&A,3
L &R,4*1+&SIM370
MEND
./ ADD LIST=ALL,NAME=LT
MACRO
&L LT &R,&A
&L L &R,&A
LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=MCCW
MACRO
&L MCCW &OP,&A,&F,&N,&CODE=0
&L CCW &OP,&A,&F,&N
AIF ('&CODE' EQ '' OR '&CODE' EQ '0').END
ORG *-3
DC AL1(&CODE)
ORG *+2
.END MEND
./ ADD LIST=ALL,NAME=MCLC
MACRO
&L MCLC &A,&B,&C,&N=*,&ZERO=
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
&L SYSXXC CLC,&A,&B,&C,N=&N,BC=BNE
MEXIT
.*
.NULL ANOP
&L CLI *+1,0
MEND
./ ADD LIST=ALL,NAME=MCLCL
MACRO
&L MCLCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
GBLC &CPU
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&CPU' EQ '360').S360
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ370
AIF ('&LB' EQ '(&RA+1)' OR '&LA' EQ '(&RB+1)').EQ370
SYSLR &RB+1,&LB
AIF ('&FILADDR' NE '').FILADDR
AIF ('&FILL' EQ '0').Z370
O &RB+1,=AL1(&FILL,0,0,0)
AGO .Z370
.*
.FILADDR ANOP
ICM &RB+1,8,&FILADDR
.Z370 CLCL &RA,&RB
MEXIT
.EQ370 ANOP
LR &RB+1,&RA+1
CLCL &RA,&RB
MEXIT
.*
.* 360 LOOP
.*
.S360 ANOP
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ360
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RB+1,&LB
&L SR &RA+1,&RB+1
BNM *+8
AR &RB+1,&RA+1
SLR &RA+1,&RA+1
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').NE360AZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').NE360BZ
LTR &RB+1,&RB+1
BNP CLC&SYSNDX.A
MCLCLC &RA,&RB,&RB+1,CLC&SYSNDX.B
LA &RA,1(&RA,&RB+1)
CLC&SYSNDX.A LTR &RA+1,&RA+1
BNP CLC&SYSNDX.B
MCLCLF &RA,&RA+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
CLC&SYSNDX.B DS 0H
MEXIT
.*
.NE360AZ ANOP
XR &RA,&RA+1
XR &RA+1,&RA
XR &RA,&RA+1
LTR &RB+1,&RB+1
BNP CLC&SYSNDX.A
MCLCLC &RA+1,&RB,&RB+1,CLC&SYSNDX.B
LA &RA+1,1(&RA+1,&RB+1)
CLC&SYSNDX.A LTR &RB+1,&RA
BNP CLC&SYSNDX.B
MCLCLF &RA+1,&RB+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
CLC&SYSNDX.B DS 0H
MEXIT
.*
.NE360BZ ANOP
XR &RB,&RA+1
XR &RA+1,&RB
XR &RB,&RA+1
LTR &RB+1,&RB+1
BNP CLC&SYSNDX.A
MCLCLC &RA,&RA+1,&RB+1,CLC&SYSNDX.B
LA &RA,1(&RA,&RB+1)
CLC&SYSNDX.A LTR &RB+1,&RB
BNP CLC&SYSNDX.B
MCLCLF &RA,&RB+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
CLC&SYSNDX.B DS 0H
MEXIT
.*
.* 360 EQUAL LENGTH
.*
.EQ360 ANOP
AIF ('&INLINE' EQ 'YES').INLINE
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQ360AZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQ360BZ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP CLC&SYSNDX.A
MCLCLC &RA,&RB,&RA+1,CLC&SYSNDX.A
CLC&SYSNDX.A DS 0H
MEXIT
.*
.EQ360AZ ANOP
&L SYSLR &RB+1,&AA
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP CLC&SYSNDX.A
MCLCLC &RB+1,&RB,&RA+1,CLC&SYSNDX.A
CLC&SYSNDX.A DS 0H
MEXIT
.*
.EQ360BZ ANOP
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB+1,&AB
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP CLC&SYSNDX.A
MCLCLC &RA,&RB+1,&RA+1,CLC&SYSNDX.A
CLC&SYSNDX.A DS 0H
MEXIT
.*
.* INLINE
.*
.INLINE ANOP
&L MCLC &AA,&AB,&LA,N=&N
MEND
./ ADD LIST=ALL,NAME=MCLCLC
MACRO
&L MCLCLC &A,&B,&C,&LEND
LCLC &LBL
.*
&LBL SETC '&L'
AIF ('&L' NE '').OKLBL
&LBL SETC 'CLC&SYSNDX.X'
.OKLBL ANOP
.*
&LBL C &C,=F'256'
BNH CLC&SYSNDX.Z
CLC 0(256,&A),0(&B)
BNE &LEND
LA &A,256(,&A)
LA &B,256(,&B)
S &C,=F'256'
B &LBL
CLC&SYSNDX.Y CLC 0(0,&A),0(&B)
CLC&SYSNDX.Z BCTR &C,0
EX &C,CLC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MCLCLF
MACRO
&L MCLCLF &A,&C,&LEND,&FILL=0,&FILADDR=
.*
AIF ('&FILADDR' EQ '').FILL
&L CLC 0(1,&A),&FILADDR
AGO .BNE
.*
.FILL ANOP
&L CLI 0(&A),&FILL
.BNE BNE &LEND
BCTR &C,0
LTR &C,&C
BNP &LEND
CLC&SYSNDX.P C &C,=F'256'
BNH CLC&SYSNDX.R
CLC 1(256,&A),0(&A)
BNE &LEND
LA &A,256(,&A)
S &C,=F'256'
B CLC&SYSNDX.P
CLC&SYSNDX.Q CLC 1(0,&A),0(&A)
CLC&SYSNDX.R BCTR &C,0
EX &C,CLC&SYSNDX.Q
MEND
./ ADD LIST=ALL,NAME=MDC
MACRO
MDC
*
* MACHINE DEPENDENT CELLS
*
EXOLDPSW EQU 24 EXTERNAL OLD PSW
SVOLDPSW EQU 32 SVC OLD PSW
PIOLDPSW EQU 40 PROGRAM OLD PSW
MKOLDPSW EQU 48 MACHINE CHECK OLD PSW
IOOLDPSW EQU 56 I/O OLD PSW
CSW EQU 64 CHANNEL STATUS WORD
CSWKEY EQU 64 PROTECT KEY PORTION
CSWADDR EQU 65 ADDRESS PORTION OF CSW
CSWSTAT EQU 68 STATUS BYTES
*
CSWSATTN EQU X'80' ATTENTION
CSWSSM EQU X'40' STATUS MODIFIER
CSWSCUE EQU X'20' CONTROL UNIT END
CSWSBUSY EQU X'10' CONTROL UNIT BUSY
CSWSCE EQU X'08' CHANNEL END
CSWSDE EQU X'04' DEVICE END
CSWSUC EQU X'02' UNIT CHECK
CSWSUE EQU X'01' UNIT EXCEPTION
*
CSWSTAT2 EQU 69 2ND STATUS BYTE
*
CSWSPCI EQU X'80' PCI
CSWSIL EQU X'40' INCORRECT LENGTH
CSWSPC EQU X'20' PROGRAM CHECK
CSWSSPC EQU X'10' STORAGE PROTECTION CHECK
CSWSCDC EQU X'08' CHANNEL DATA CHECK
CSWSCCC EQU X'04' CHANNEL CONTROL CHECK
CSWSICC EQU X'02' INTERFACE CONTROL CHECK
CSWSCC EQU X'01' CHAINING CHECK
*
CSWLEN EQU 70 UNUSED LENGTH
CAW EQU 72 CHANNEL ADDRESS WORD
INTTIMER EQU 80 INTERVAL TIMER
EXNEWPSW EQU 88 EXTERNAL NEW PSW
SVNEWPSW EQU 96 SVC NEW PSW
PINEWPSW EQU 104 PROGRAM NEW PSW
MKNEWPSW EQU 112 MACHINE CHECK NEW PSW
IONEWPSW EQU 120 I/O NEW PSW
DSCANA EQU 128 DIAGNOSTIC SCAN-OUT AREA
*
* CCW DEFINITIONS
*
CCWCC EQU 0 COMMAND CODE
*
CCWCNOP EQU X'03' NO OPERATION
CCWCTIC EQU X'08' TRANSFER IN CHANNEL
CCWCSNS EQU X'04' SENSE
*
CCWADDR EQU 1 ADDRESS
CCWFL EQU 4 FLAGS
*
CCWFDCH EQU X'80' DATA CHAINING BIT
CCWFCCH EQU X'40' COMMAND CHAINING BIT
CCWFSLI EQU X'20' SUPPRESS INCORRECT LENGTH BIT
CCWFSKIP EQU X'10' SUPPRESS DATA TRANSFER BIT
CCWFPCI EQU X'08' PROGRAM CONTROLLED INTERRUPT
CCWFIDA EQU X'04' INDIRECT DATA ADDRESS
*
CCWLEN EQU 6 LENGTH
*
* SENSE BYTES
*
SNSBYTE1 EQU 0 SENSE BYTE 1
*
SNSBCR EQU X'80' COMMAND REJECT
SNSBIR EQU X'40' INTERVENTION REQUIRED
SNSBBOPC EQU X'20' BUS OUT PARITY CHECK
SNSBEC EQU X'10' EQUIPMENT CHECK
SNSBDC EQU X'08' DATA CHECK
SNSBOR EQU X'04' OVERRUN
SNSBLD EQU X'02' LOST DATA
SNSBTO EQU X'01' TIMEOUT
*
* EBCDIC CONTROL CHARACTERS
*
EBCNUL EQU X'00' ASCII NULL
EBCSOH EQU X'01' ASCII SOH
EBCSTX EQU X'02' ASCII STX
EBCETX EQU X'03' ASCII ETX
EBCEDI EQU X'04' (1) MILTEN END DIM INTENSITY
EBCPF EQU X'04' (2) IBM PUNCH OFF
EBCHT EQU X'05' ASCII HORIZONTAL TAB
EBCEBC EQU X'06' (1) MILTEN END BOLD CHARACTERS
EBCLC EQU X'06' (2) IBM LOWER CASE
EBCDEL EQU X'07' ASCII DELETE
EBCGE EQU X'08' IBM GRAPHIC ESCAPE
EBCRLF EQU X'09' IBM REVERSE LINE FEED
EBCSTOP EQU X'0A' (1) MILTEN STOP CODE
EBCSMM EQU X'0A' (2) IBM START OF MANUAL MESSAGE
EBCVT EQU X'0B' ASCII VERTICAL TAB
EBCFF EQU X'0C' ASCII FORM FEED
EBCCR EQU X'0D' ASCII CARRIAGE RETURN
EBCSO EQU X'0E' ASCII SHIFT OUT
EBCSI EQU X'0F' ASCII SHIFT IN
EBCDLE EQU X'10' ASCII DATA LINK ESCAPE
EBCDC1 EQU X'11' ASCII DEVICE CONTROL 1
EBCDC2 EQU X'12' ASCII DEVICE CONTROL 2
EBCSVF EQU X'13' (1) MILTEN START OF VARIABLE FIELD
EBCTM EQU X'13' (2) IBM TAPE MARK
EBCEVF EQU X'14' (1) MILTEN END OF VARIABLE FIELD
EBCRES EQU X'14' (2) IBM RESTORE
EBCNL EQU X'15' IBM NEW LINE
EBCBS EQU X'16' ASCII BACKSPACE
EBCIL EQU X'17' IBM IDLE CHARACTER
EBCCAN EQU X'18' ASCII CANCEL
EBCEM EQU X'19' ASCII END OF MEDIUM
EBCFONT EQU X'1A' (1) WYLBUR SELECT NEW FONT
EBCCC EQU X'1A' (2) IBM CURSOR CONTROL
EBCHLF EQU X'1B' (1) MILTEN HALF LINE FEED
EBCCU1 EQU X'1B' (2) IBM CUSTOMER USE 1
EBCIFS EQU X'1C' ASCII INTERCHANGE FILE SEPARATOR
EBCIGS EQU X'1D' ASCII INTERCHANGE GROUP SEPARATOR
EBCIRS EQU X'1E' ASCII INTERCHANGE RECORD SEPARATOR
EBCIUS EQU X'1F' ASCII INTERCHANGE UNIT SEPARATOR
EBCNDBS EQU X'20' (1) MILTEN NON-DESTRUCTIVE BACKSPACE
EBCDS EQU X'20' (2) IBM DIGIT SELECT
EBCSOS EQU X'21' IBM START OF SIGNIFICANCE
EBCFS EQU X'22' IBM FIELD SEPARATOR (EDIT)
EBCCTB EQU X'23' MILTEN CLEAR TERMINAL BUFFER
EBCBYP EQU X'24' IBM BYPASS
EBCLF EQU X'25' ASCII LINE FEED
EBCETB EQU X'26' ASCII END OF TRANSMISSION BLOCK
EBCESC EQU X'27' ASCII ESCAPE
EBCHTS EQU X'28' MILTEN SET HORIZONTAL TAB
EBCHTCA EQU X'29' MILTEN CLEAR ALL HORIZONTAL TABS
EBCSUL EQU X'2A' (1) MILTEN START UNDERLINE
EBCSM EQU X'2A' (2) IBM SET MODE
EBCRHLF EQU X'2B' (1) MILTEN REVERSE HALF LINE FEED
EBCCU2 EQU X'2B' (2) IBM CUSTOMER USE 2
EBCEUL EQU X'2C' MILTEN END UNDERLINE
EBCENQ EQU X'2D' ASCII ENQUIRY
EBCACK EQU X'2E' ASCII ACKNOWLEDGE
EBCBEL EQU X'2F' ASCII BELL
EBCVTS EQU X'30' MILTEN SET VERTICAL TAB
EBCVTCA EQU X'31' MILTEN CLEAR ALL VERTICAL TABS
EBCSYN EQU X'32' ASCII SYNCHRONOUS IDLE
EBCREN EQU X'33' MILTEN REENTER
EBCSDI EQU X'34' (1) MILTEN START DIM INTENSITY
EBCPN EQU X'34' (2) IBM PUNCH ON
EBCDC3 EQU X'35' (1) ASCII DEVICE CONTROL 3
EBCRS EQU X'35' (2) TSO READER STOP
EBCSBC EQU X'36' (1) MILTEN START BOLD CHARACTERS
EBCUC EQU X'36' (2) IBM UPPER CASE
EBCEOT EQU X'37' ASCII END OF TRANSMISSION
EBCSRF EQU X'38' MILTEN START REVERSE FIELD
EBCERF EQU X'39' MILTEN END REVERSE FIELD
EBCSBK EQU X'3A' MILTEN START BLINK
EBCEBK EQU X'3B' (1) MILTEN END BLINK
EBCCU3 EQU X'3B' (2) IBM CUSTOMER USE 3
EBCDC4 EQU X'3C' ASCII DEVICE CONTROL 4
EBCNAK EQU X'3D' ASCII NEGATIVE ACKNOWLEDGE
EBCCTM EQU X'3E' MILTEN CLEAR TERMINAL MESSAGE
EBCSUB EQU X'3F' ASCII SUBSTITUTE
*
* EBCDIC GRAPHIC CHARACTERS
*
EBCSP EQU X'40' ASCII SPACE
EBCDIGSP EQU X'41' MILTEN DIGIT SPACE
EBCUNSP EQU X'42' MILTEN UNIT SPACE
EBCCENT EQU X'4A' IBM CENT SIGN
EBCIHYPH EQU X'62' MILTEN INSERTED HYPHEN
EBCACCNT EQU X'79' ASCII GRAVE ACCENT
EBCLCURL EQU X'8B' ASCII LEFT CURLY BRACKET
EBCRCURL EQU X'9B' ASCII RIGHT CURLY BRACKET
EBCPLMIN EQU X'9E' IBM PLUS/MINUS SIGN
EBCDEGR EQU X'A1' (1) IBM DEGREE MARK
EBCTILDE EQU X'A1' (2) ASCII TILDE
EBCLSQB EQU X'AD' ASCII LEFT SQUARE BRACKET
EBCRSQB EQU X'BD' ASCII RIGHT SQUARE BRACKET
EBCCFLEX EQU X'BE' ASCII CIRCUMFLEX
EBCBKSL EQU X'E0' ASCII BACKSLASH
MEND
./ ADD LIST=ALL,NAME=MFC
MACRO
&L MFC &A,&C,&FILL=C' ',&FILADDR=,&N=*,&ZERO=
LCLA &X,&Y
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
.*
AIF ('&C' NE '').NDLEN
AIF (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND *
T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND *
T'&A NE '$').OKLEN
MNOTE 12,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE'
&L MFCMVI &A,&FILL,&FILADDR
MEXIT
.*
.OKLEN ANOP
&X SETA L'&A
&L MFC &A,&X,FILL=&FILL,FILADDR=&FILADDR,N=&N
MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&X)'
MEXIT
.*
.NDLEN ANOP
.*
&L MFCMVI &A,&FILL,&FILADDR
AIF ('&N' EQ '' OR '&N' EQ '*').STAR
.ONE SYSXXC MVC,&A,&A,&C-1,D1=1,N=&N
MEXIT
.*
.STAR ANOP
AIF ('&C' EQ '').ONE
.CHECK ANOP
&Y SETA &Y+1
AIF (&Y GT K'&C).OK
AIF ('&C'(&Y,1) LT '0').ONE
AGO .CHECK
.OK ANOP
&X SETA &C-1
AIF (&X LE 0).END
SYSXXC MVC,&A,&A,&X,D1=1,N=*
MEXIT
.*
.Z ANOP
&L MXC &A,&A,&C,N=&N
MEXIT
.*
.NULL ANOP
&L SYSLBL
.END MEND
./ ADD LIST=ALL,NAME=MFCMVI
MACRO
&L MFCMVI &A,&FILL,&FILADDR
AIF ('&FILADDR' NE '').FILADDR
AIF ('&A' EQ '').NREG
AIF ('&A'(1,1) NE '(').NREG
&L MVI 0&A,&FILL
MEXIT
.*
.NREG ANOP
&L MVI &A,&FILL
MEXIT
.*
.FILADDR ANOP
&L MMVC &A,&FILADDR,1
MEND
./ ADD LIST=ALL,NAME=MFCL
MACRO
&L MFCL &R,&A,&C,&S,&FILL=C' ',&FILADDR=,&INLINE=,&N=*
GBLC &CPU
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&CPU' EQ '360').S360
&L SYSLR &R,&A,ERR='ADDRESS REQUIRED'
SYSLR &R+1,&C,ERR='LENGTH REQUIRED'
LR &S,&R
AIF ('&FILADDR' NE '').FILADDR
AIF ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
L &S+1,=AL1(&FILL,0,0,0)
AGO .MMVCL
.*
.FILADDR ANOP
SR &S+1,&S+1
ICM &S+1,8,&FILADDR
.MMVCL ANOP
MVCL &R,&S
MEXIT
.*
.Z370 SLR &S+1,&S+1
MVCL &R,&S
MEXIT
.*
.* 360
.*
.S360 ANOP
AIF ('&INLINE' EQ 'YES').MFC
AIF ('&FILL' EQ '' OR '&FILL' EQ '0').Z360
AIF ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').RZ360
&L SYSLR &R,&A,ERR='ADDRESS REQUIRED'
SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP MFC&SYSNDX.A
MFCLF &R,&R+1,MFC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
MFC&SYSNDX.A DS 0H
MEXIT
.*
.RZ360 ANOP
&L SYSLR &S,&A
SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP MFC&SYSNDX.A
MFCLF &S,&R+1,MFC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
MFC&SYSNDX.A DS 0H
MEXIT
.*
.* 360 CLEAR TO ZERO
.*
.Z360 ANOP
AIF ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').ZRZ360
&L SYSLR &R,&A,ERR='ADDRESS REQUIRED'
SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP MFC&SYSNDX.A
MFCLZ &R,&R+1
MFC&SYSNDX.A DS 0H
MEXIT
.*
.ZRZ360 ANOP
&L SYSLR &S,&A
SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP MFC&SYSNDX.A
MFCLZ &S,&R+1
MFC&SYSNDX.A DS 0H
MEXIT
.*
.* MFC
.*
.MFC ANOP
&L MFC &A,&C,FILL=&FILL,FILADDR=&FILADDR,N=&N
MEND
./ ADD LIST=ALL,NAME=MFCLF
MACRO
&L MFCLF &A,&C,&LEND,&FILL=,&FILADDR=
AIF ('&FILADDR' EQ '').FILL
&L MVC 0(1,&A),&FILADDR
AGO .BCT
.*
.FILL ANOP
&L MVI 0(&A),&FILL
.BCT BCT &C,*+8
B &LEND
MFC&SYSNDX.X C &C,=F'256'
BNH MFC&SYSNDX.Z
MVC 1(256,&A),0(&A)
LA &A,256(,&A)
S &C,=F'256'
B MFC&SYSNDX.X
MFC&SYSNDX.Y MVC 1(0,&A),0(&A)
MFC&SYSNDX.Z BCTR &C,0
EX &C,MFC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MFCLZ
MACRO
&L MFCLZ &A,&C
LCLC &LBL
&LBL SETC '&L'
AIF ('&L' NE '').LBL
&LBL SETC 'MFC&SYSNDX.X'
.LBL ANOP
.*
&LBL C &C,=F'256'
BNH MFC&SYSNDX.Z
XC 0(256,&A),0(&A)
LA &A,256(,&A)
S &C,=F'256'
B &LBL
MFC&SYSNDX.Y XC 0(0,&A),0(&A)
MFC&SYSNDX.Z BCTR &C,0
EX &C,MFC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MI
MACRO
&L MI &R,&V
LCLA &X,&Y,&Z
.*
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).INT
AIF ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
AIF ((&X EQ 1) AND (('&V'(1,1) EQ '-') OR ('&V'(1,1) EQ '+'))).LOOP
.*
&L MH &R,=AL2(&V)
MEXIT
.*
.INT ANOP
AIF ('&V' EQ '0').ZERO
AIF ('&V' EQ '1').ONE
&X SETA 0
&Y SETA 1
&Z SETA &V
.POWER ANOP
&X SETA &X+1
&Y SETA &Y*2
AIF (&Y EQ &Z).SHIFT
AIF (&Y LT &Z AND &Y LT 16384).POWER
&L MH &R,=H'&V'
MEXIT
.*
.ZERO ANOP
&L LA &R,0
MEXIT
.*
.ONE ANOP
&L SYSLBL
MEXIT
.*
.SHIFT ANOP
&L SLL &R,&X
MEND
./ ADD LIST=ALL,NAME=MMVC
MACRO
&L MMVC &A,&B,&C,&N=*,&ZERO=
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
&L SYSXXC MVC,&A,&B,&C,N=&N
MEXIT
.*
.NULL ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=MMVCL
MACRO
&L MMVCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
GBLC &CPU,&SIM370
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&CPU' EQ '360').S360
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ370
AIF ('&LB' EQ '(&RA+1)' OR '&LA' EQ '(&RB+1)').EQ370
SYSLR &RB+1,&LB
AIF ('&FILADDR' NE '').FILADDR
AIF ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
O &RB+1,=AL1(&FILL,0,0,0)
AGO .Z370
.*
.FILADDR ANOP
ICM &RB+1,8,&FILADDR
.*
.Z370 MVCL &RA,&RB
MEXIT
.EQ370 ANOP
LR &RB+1,&RA+1
MVCL &RA,&RB
MEXIT
.*
.* 360 LOOP
.*
.S360 ANOP
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ360
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RB+1,&LB
SR &RA+1,&RB+1
BNM *+6
AR &RB+1,&RA+1
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ1
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ1
LTR &RB+1,&RB+1
BNP MVC&SYSNDX.X
MMVCLM &RA,&RB,&RB+1
LA &RA,1(&RA,&RB+1)
MVC&SYSNDX.X LTR &RA+1,&RA+1
BNP MVC&SYSNDX.Y
MMVCLP &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
MVC&SYSNDX.Y DS 0H
MEXIT
.*
.RAZ1 ANOP
XR &RA,&RA+1
XR &RA+1,&RA
XR &RA,&RA+1
LTR &RB+1,&RB+1
BNP MVC&SYSNDX.X
MMVCLM &RA+1,&RB,&RB+1
LA &RA+1,1(&RA+1,&RB+1)
MVC&SYSNDX.X LTR &RB+1,&RA
BNP MVC&SYSNDX.Y
MMVCLP &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
MVC&SYSNDX.Y DS 0H
MEXIT
.*
.RBZ1 ANOP
XR &RA+1,&RB
XR &RB,&RA+1
XR &RA+1,&RB
LTR &RB+1,&RB+1
BNP MVC&SYSNDX.X
MMVCLM &RA,&RA+1,&RB+1
LA &RA,1(&RA,&RB+1)
MVC&SYSNDX.X LTR &RB+1,&RB
BNP MVC&SYSNDX.Y
MMVCLP &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
MVC&SYSNDX.Y DS 0H
MEXIT
.*
.* 360 EQUAL LENGTH
.*
.EQ360 ANOP
AIF ('&INLINE' EQ 'YES').INLINE
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ2
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ2
&L SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP MVC&SYSNDX.Z
SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
MMVCLM &RA,&RB,&RA+1
MVC&SYSNDX.Z DS 0H
MEXIT
.*
.RAZ2 ANOP
&L SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP MVC&SYSNDX.Z
SYSLR &RB+1,&AA
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
MMVCLM &RB+1,&RB,&RA+1
MVC&SYSNDX.Z DS 0H
MEXIT
.*
.RBZ2 ANOP
&L SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP MVC&SYSNDX.Z
SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB+1,&AB
MMVCLM &RA,&RB+1,&RA+1
MVC&SYSNDX.Z DS 0H
MEXIT
.*
.* INLINE
.*
.INLINE ANOP
&L MMVC &AA,&AB,&LA,N=&N
MEND
./ ADD LIST=ALL,NAME=MMVCLM
MACRO
&L MMVCLM &A,&B,&C
LCLC &LBL
.*
&LBL SETC '&L'
AIF ('&L' NE '').OKLBL
&LBL SETC 'MVC&SYSNDX.A'
.OKLBL ANOP
.*
&LBL C &C,=F'256'
BNH MVC&SYSNDX.C
MVC 0(256,&A),0(&B)
LA &A,256(,&A)
LA &B,256(,&B)
S &C,=F'256'
B &LBL
MVC&SYSNDX.B MVC 0(0,&A),0(&B)
MVC&SYSNDX.C BCTR &C,0
EX &C,MVC&SYSNDX.B
MEND
./ ADD LIST=ALL,NAME=MMVCLP
MACRO
&L MMVCLP &A,&C,&FILL=0,&FILADDR=
AIF ('&FILADDR' EQ '').FILL
&L MVC 0(1,&A),&FILADDR
AGO .BCT
.*
.FILL ANOP
AIF ('&FILL' EQ '' OR '&FILL' EQ '0').ZOT
&L MVI 0(&A),&FILL
.BCT BCT &C,*+8
B MVC&SYSNDX.G
MVC&SYSNDX.D C &C,=F'256'
BNH MVC&SYSNDX.F
MVC 1(256,&A),0(&A)
LA &A,256(,&A)
S &C,=F'256'
B MVC&SYSNDX.D
MVC&SYSNDX.E MVC 1(0,&A),0(&A)
MVC&SYSNDX.F BCTR &C,0
EX &C,MVC&SYSNDX.E
MVC&SYSNDX.G DS 0H
MEXIT
.*
.ZOT ANOP
&L SYSLBL
MVC&SYSNDX.D C &C,=F'256'
BNH MVC&SYSNDX.F
XC 0(256,&A),0(&A)
LA &A,256(,&A)
S &C,=F'256'
B MVC&SYSNDX.D
MVC&SYSNDX.E XC 0(0,&A),0(&A)
MVC&SYSNDX.F BCTR &C,0
EX &C,MVC&SYSNDX.E
MEND
./ ADD LIST=ALL,NAME=MNC
MACRO
&L MNC &A,&B,&C,&N=*,&ZERO=
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
&L SYSXXC NC,&A,&B,&C,N=&N
MEXIT
.*
.NULL ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=MNCL
MACRO
&L MNCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=X'FF',&FILADDR=,&INLINE=,&N=*
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RB+1,&LB
SR &RA+1,&RB+1
BNM *+6
AR &RB+1,&RA+1
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
LTR &RB+1,&RB+1
BNP NC&SYSNDX.A
MNCLN &RA,&RB,&RB+1
AIF (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''') *
AND '&FILADDR' EQ '').FF
LA &RA,1(&RA,&RB+1)
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
NC&SYSNDX.A LTR &RA+1,&RA+1
BNP NC&SYSNDX.B
MNCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
NC&SYSNDX.B DS 0H
MEXIT
.Z ANOP
NC&SYSNDX.A LTR &RA+1,&RA+1
BNP NC&SYSNDX.B
MFCLZ &RA,&RA+1
NC&SYSNDX.B DS 0H
MEXIT
.FF ANOP
NC&SYSNDX.A DS 0H
MEXIT
.*
.RAZ ANOP
XR &RA,&RA+1
XR &RA+1,&RA
XR &RA,&RA+1
LTR &RB+1,&RB+1
BNP NC&SYSNDX.A
MNCLN &RA+1,&RB,&RB+1
AIF (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''') *
AND '&FILADDR' EQ '').RAZFF
LA &RA+1,1(&RA+1,&RB+1)
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
NC&SYSNDX.A LTR &RB+1,&RA
BNP NC&SYSNDX.B
MNCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
NC&SYSNDX.B DS 0H
MEXIT
.RAZZ ANOP
NC&SYSNDX.A LTR &RB+1,&RA
BNP NC&SYSNDX.B
MFCLZ &RA+1,&RB+1
NC&SYSNDX.B DS 0H
MEXIT
.RAZFF ANOP
NC&SYSNDX.A DS 0H
MEXIT
.*
.RBZ ANOP
XR &RB,&RA+1
XR &RA+1,&RB
XR &RB,&RA+1
LTR &RB+1,&RB+1
BNP NC&SYSNDX.A
MNCLN &RA,&RA+1,&RB+1
AIF (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''') *
AND '&FILADDR' EQ '').RBZFF
LA &RA,1(&RA,&RB+1)
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') *
AND '&FILADDR' EQ '').RBZZ
NC&SYSNDX.A LTR &RB+1,&RB
BNP NC&SYSNDX.B
MNCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
NC&SYSNDX.B DS 0H
MEXIT
.*
.RBZZ ANOP
NC&SYSNDX.A LTR &RB+1,&RB
BNP NC&SYSNDX.B
MFCLZ &RA,&RB+1
NC&SYSNDX.B DS 0H
MEXIT
.RBZFF ANOP
NC&SYSNDX.A DS 0H
MEXIT
.*
.* EQUAL LENGTH
.*
.EQ ANOP
AIF ('&INLINE' EQ 'YES').MNC
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
LTR &RA+1,&RA+1
BNP NC&SYSNDX.A
MNCLN &RA,&RB,&RA+1
NC&SYSNDX.A DS 0H
MEXIT
.*
.EQRAZ ANOP
&L SYSLR &RB+1,&AA
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP NC&SYSNDX.A
MNCLN &RB+1,&RB,&RA+1
NC&SYSNDX.A DS 0H
MEXIT
.*
.EQRBZ ANOP
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB+1,&AB
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP NC&SYSNDX.A
MNCLN &RA,&RB+1,&RA+1
NC&SYSNDX.A DS 0H
MEXIT
.*
.* MNC
.*
.MNC ANOP
&L MNC &AA,&AB,&LA,N=&N
MEND
./ ADD LIST=ALL,NAME=MNCLN
MACRO
&L MNCLN &A,&B,&C
LCLC &LBL
&LBL SETC '&L'
AIF ('&L' NE '').LBL
&LBL SETC 'NC&SYSNDX.X'
.LBL ANOP
.*
&LBL C &C,=F'256'
BNH NC&SYSNDX.Z
NC 0(256,&A),0(&A)
LA &A,256(,&A)
LA &B,256(,&B)
S &C,=F'256'
B &LBL
NC&SYSNDX.Y NC 0(0,&A),0(&A)
NC&SYSNDX.Z BCTR &C,0
EX &C,NC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MNCLF
MACRO
&L MNCLF &A,&C,&FILL=,&FILADDR=
AIF ('&FILADDR' EQ '').FILL
&L NC 0(1,&A),&FILADDR
LA &A,1(,&A)
BCT &C,*-10
MEXIT
.*
.FILL ANOP
&L NI 0(&A),&FILL
.LA LA &A,1(,&A)
BCT &C,*-8
MEND
./ ADD LIST=ALL,NAME=MOC
MACRO
&L MOC &A,&B,&C,&N=*,&ZERO=
&L SYSXXC OC,&A,&B,&C,N=&N
MEXIT
.*
.NULL ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=MOCL
MACRO
&L MOCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RB+1,&LB
SR &RA+1,&RB+1
BNM *+6
AR &RB+1,&RA+1
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
LTR &RB+1,&RB+1
BNP OC&SYSNDX.A
MOCLN &RA,&RB,&RB+1
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
LA &RA,1(&RA,&RB+1)
AIF (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''') *
AND '&FILADDR' EQ '').FF
OC&SYSNDX.A LTR &RA+1,&RA+1
BNP OC&SYSNDX.B
MOCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
OC&SYSNDX.B DS 0H
MEXIT
.FF ANOP
OC&SYSNDX.A LTR &RA+1,&RA+1
BNP OC&SYSNDX.B
MFCLF &RA,&RA+1,OC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
OC&SYSNDX.B DS 0H
MEXIT
.Z ANOP
OC&SYSNDX.A DS 0H
MEXIT
.*
.RAZ ANOP
XR &RA,&RA+1
XR &RA+1,&RA
XR &RA,&RA+1
LTR &RB+1,&RB+1
BNP OC&SYSNDX.A
MOCLN &RA+1,&RB,&RB+1
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
LA &RA+1,1(&RA+1,&RB+1)
AIF (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''') *
AND '&FILADDR' EQ '').RAZFF
OC&SYSNDX.A LTR &RB+1,&RA
BNP OC&SYSNDX.B
MOCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
OC&SYSNDX.B DS 0H
MEXIT
.RAZFF ANOP
OC&SYSNDX.A LTR &RB+1,&RA
BNP OC&SYSNDX.B
MFCLF &RA+1,&RB+1,OC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
OC&SYSNDX.B DS 0H
MEXIT
.RAZZ ANOP
OC&SYSNDX.A DS 0H
MEXIT
.*
.RBZ ANOP
XR &RB,&RA+1
XR &RA+1,&RB
XR &RB,&RA+1
LTR &RB+1,&RB+1
BNP OC&SYSNDX.A
MOCLN &RA,&RA+1,&RB+1
AIF (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''') *
AND '&FILADDR' EQ '').RBZFF
LA &RA,1(&RA,&RB+1)
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RBZZ
OC&SYSNDX.A LTR &RB+1,&RB
BNP OC&SYSNDX.B
MOCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
OC&SYSNDX.B DS 0H
MEXIT
.*
.RBZZ ANOP
OC&SYSNDX.A LTR &RB+1,&RB
BNP OC&SYSNDX.B
MFCLZ &RA,&RB+1
OC&SYSNDX.B DS 0H
MEXIT
.RBZFF ANOP
OC&SYSNDX.A DS 0H
MEXIT
.*
.* EQUAL LENGTH
.*
.EQ ANOP
AIF ('&INLINE' EQ 'YES').MOC
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
LTR &RA+1,&RA+1
BNP OC&SYSNDX.A
MOCLN &RA,&RB,&RA+1
OC&SYSNDX.A DS 0H
MEXIT
.*
.EQRAZ ANOP
&L SYSLR &RB+1,&AA
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP OC&SYSNDX.A
MOCLN &RB+1,&RB,&RA+1
OC&SYSNDX.A DS 0H
MEXIT
.*
.EQRBZ ANOP
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB+1,&AB
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP OC&SYSNDX.A
MOCLN &RA,&RB+1,&RA+1
OC&SYSNDX.A DS 0H
MEXIT
.*
.* MOC
.*
.MOC ANOP
&L MOC &AA,&AB,&LA,N=&N
MEND
./ ADD LIST=ALL,NAME=MOCLN
MACRO
&L MOCLN &A,&B,&C
LCLC &LBL
&LBL SETC '&L'
AIF ('&L' NE '').LBL
&LBL SETC 'OC&SYSNDX.X'
.LBL ANOP
.*
&LBL C &C,=F'256'
BNH OC&SYSNDX.Z
OC 0(256,&A),0(&A)
LA &A,256(,&A)
LA &B,256(,&B)
S &C,=F'256'
B &LBL
OC&SYSNDX.Y OC 0(0,&A),0(&A)
OC&SYSNDX.Z BCTR &C,0
EX &C,OC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MOCLF
MACRO
&L MOCLF &A,&C,&FILL=,&FILADDR=
AIF ('&FILADDR' EQ '').FILL
&L OC 0(1,&A),&FILADDR
LA &A,1(,&A)
BCT &C,*-10
MEXIT
.*
.FILL ANOP
&L OI 0(&A),&FILL
LA &A,1(,&A)
BCT &C,*-8
MEND
./ ADD LIST=ALL,NAME=MPARMGBL
*
* NIH/COMMON - DUMMY FOR MILTEN GLOBAL DECLARATIONS
*
./ ADD LIST=ALL,NAME=MPNI
MACRO
&L MPNI &A,&B,&BASE=,®S=
GBLC &OS,&MP
LCLC &LBL
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
AIF ('&MP' EQ 'NO').NMP
AIF ('&BASE' EQ '').NBASE
AIF ('&BASE'(1,1) EQ '(').BASER
.*
&L LA ®S(3),255-(&B)
SLL ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
X ®S(3),=XL4'FFFFFFFF'
L ®S(1),&BASE+(&A-(&BASE))/4*4
LR ®S(2),®S(1)
NR ®S(2),®S(3)
CS ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
BNE *-8
MEXIT
.*
.BASER ANOP
&L LA ®S(3),255-(&B)
SLL ®S(3),24-8*(&A-(&A)/4*4)
X ®S(3),=XL4'FFFFFFFF'
L ®S(1),(&A)/4*4&BASE
LR ®S(2),®S(1)
NR ®S(2),®S(3)
CS ®S(1),®S(2),(&A)/4*4&BASE
BNE *-8
MEXIT
.*
.NBASE ANOP
&LBL SETC '&L'
AIF ('&L' NE '').NLBL
&LBL SETC 'MPNI&SYSNDX'
.NLBL ANOP
&LBL SYSLR ®S(1),&A
LR ®S(2),®S(1)
N ®S(1),=XL4'FFFFFFFC'
SLR ®S(2),®S(1)
SLL ®S(2),3
L ®S(3),=AL1(255-(&B),0,0,0)
SRL ®S(3),0(®S(2))
X ®S(3),=XL4'FFFFFFFF'
L ®S(2),0(®S(1))
NR ®S(3),®S(2)
CS ®S(2),®S(3),0(®S(1))
BNE &LBL
MEXIT
.*
.NMP ANOP
AIF ('&BASE' EQ '').NMPNB
AIF ('&BASE'(1,1) NE '(').NMPNB
&L NI &A&BASE,&B
MEXIT
.*
.NMPNB ANOP
&L NI &A,&B
MEND
./ ADD LIST=ALL,NAME=MPOI
MACRO
&L MPOI &A,&B,&BASE=,®S=
GBLC &OS,&MP
LCLC &LBL
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
AIF ('&MP' EQ 'NO').NMP
AIF ('&BASE' EQ '').NBASE
AIF ('&BASE'(1,1) EQ '(').BASER
.*
&L LA ®S(3),&B
SLL ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
L ®S(1),&BASE+(&A-(&BASE))/4*4
LR ®S(2),®S(1)
OR ®S(2),®S(3)
CS ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
BNE *-8
MEXIT
.*
.BASER ANOP
&L LA ®S(3),&B
SLL ®S(3),24-8*(&A-(&A)/4*4)
L ®S(1),(&A)/4*4&BASE
LR ®S(2),®S(1)
OR ®S(2),®S(3)
CS ®S(1),®S(2),(&A)/4*4&BASE
BNE *-8
MEXIT
.*
.NBASE ANOP
&LBL SETC '&L'
AIF ('&L' NE '').NLBL
&LBL SETC 'MPOI&SYSNDX'
.NLBL ANOP
&LBL SYSLR ®S(1),&A
LR ®S(2),®S(1)
N ®S(1),=XL4'FFFFFFFC'
SLR ®S(2),®S(1)
SLL ®S(2),3
L ®S(3),=AL1(&B,0,0,0)
SRL ®S(3),0(®S(2))
L ®S(2),0(®S(1))
OR ®S(3),®S(2)
CS ®S(2),®S(3),0(®S(1))
BNE &LBL
MEXIT
.*
.NMP ANOP
AIF ('&BASE' EQ '').NMPNB
AIF ('&BASE'(1,1) NE '(').NMPNB
&L OI &A&BASE,&B
MEXIT
.*
.NMPNB ANOP
&L OI &A,&B
MEND
./ ADD LIST=ALL,NAME=MPXI
MACRO
&L MPXI &A,&B,&BASE=,®S=
GBLC &OS,&MP
LCLC &LBL
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
AIF ('&MP' EQ 'NO').NMP
AIF ('&BASE' EQ '').NBASE
AIF ('&BASE'(1,1) EQ '(').BASER
.*
&L LA ®S(3),&B
SLL ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
L ®S(1),&BASE+(&A-(&BASE))/4*4
LR ®S(2),®S(1)
XR ®S(2),®S(3)
CS ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
BNE *-8
MEXIT
.*
.BASER ANOP
&L LA ®S(3),&B
SLL ®S(3),24-8*(&A-(&A)/4*4)
L ®S(1),(&A)/4*4&BASE
LR ®S(2),®S(1)
XR ®S(2),®S(3)
CS ®S(1),®S(2),(&A)/4*4&BASE
BNE *-8
MEXIT
.*
.NBASE ANOP
&LBL SETC '&L'
AIF ('&L' NE '').NLBL
&LBL SETC 'MPXI&SYSNDX'
.NLBL ANOP
&LBL SYSLR ®S(1),&A
LR ®S(2),®S(1)
N ®S(1),=XL4'FFFFFFFC'
SLR ®S(2),®S(1)
SLL ®S(2),3
L ®S(3),=AL1(&B,0,0,0)
SRL ®S(3),0(®S(2))
L ®S(2),0(®S(1))
XR ®S(3),®S(2)
CS ®S(2),®S(3),0(®S(1))
BNE &LBL
MEXIT
.*
.NMP ANOP
AIF ('&BASE' EQ '').NMPNB
AIF ('&BASE'(1,1) NE '(').NMPNB
&L XI &A&BASE,&B
MEXIT
.*
.NMPNB ANOP
&L XI &A,&B
MEND
./ ADD LIST=ALL,NAME=MPZI
MACRO
&L MPZI &A,&B,&BASE=,®S=
GBLC &OS,&MP
LCLC &LBL
AIF ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
AIF ('&MP' EQ 'NO').NMP
AIF ('&BASE' EQ '').NBASE
AIF ('&BASE'(1,1) EQ '(').BASER
.*
&L LA ®S(3),&B
SLL ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
X ®S(3),=XL4'FFFFFFFF'
L ®S(1),&BASE+(&A-(&BASE))/4*4
LR ®S(2),®S(1)
NR ®S(2),®S(3)
CS ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
BNE *-8
MEXIT
.*
.BASER ANOP
&L LA ®S(3),&B
SLL ®S(3),24-8*(&A-(&A)/4*4)
X ®S(3),=XL4'FFFFFFFF'
L ®S(1),(&A)/4*4&BASE
LR ®S(2),®S(1)
NR ®S(2),®S(3)
CS ®S(1),®S(2),(&A)/4*4&BASE
BNE *-8
MEXIT
.*
.NBASE ANOP
&LBL SETC '&L'
AIF ('&L' NE '').NLBL
&LBL SETC 'MPNI&SYSNDX'
.NLBL ANOP
&LBL SYSLR ®S(1),&A
LR ®S(2),®S(1)
N ®S(1),=XL4'FFFFFFFC'
SLR ®S(2),®S(1)
SLL ®S(2),3
L ®S(3),=AL1(&B,0,0,0)
SRL ®S(3),0(®S(2))
X ®S(3),=XL4'FFFFFFFF'
L ®S(2),0(®S(1))
NR ®S(3),®S(2)
CS ®S(2),®S(3),0(®S(1))
BNE &LBL
MEXIT
.*
.NMP ANOP
AIF ('&BASE' EQ '').NMPNB
AIF ('&BASE'(1,1) NE '(').NMPNB
&L NI &A&BASE,255-(&B)
MEXIT
.*
.NMPNB ANOP
&L NI &A,255-(&B)
MEND
./ ADD LIST=ALL,NAME=MTC
MACRO
&L MTC &A,&C,&FILL=,&FILADDR=,&N=*,&ZERO=
LCLA &X,&Y
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
AIF ('&FILL' NE '' OR '&FILADDR' NE '').CLC
&L SYSXXC OC,&A,&A,&C,N=&N,BC=BNZ
MEXIT
.*
.CLC ANOP
AIF ('&C' NE '').NDLEN
AIF (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND *
T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND *
T'&A NE '$').OKLEN
MNOTE 12,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE'
&L MTCCLI &A,&FILL,&FILADDR
MEXIT
.*
.OKLEN ANOP
&X SETA L'&A
&L MTC &A,&X,FILL=&FILL,FILADDR=&FILADDR,N=&N
MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&X)'
MEXIT
.*
.NDLEN ANOP
&L MTCCLI &A,&FILL,&FILADDR
AIF ('&N' EQ '' OR '&N' EQ '*').STAR
.ONE BNE MTC&SYSNDX.A
SYSXXC CLC,&A,&A,&C-1,D1=1,N=&N,BC=(BNE,MTC&SYSNDX.B)
MTC&SYSNDX.A DS 0H
MEXIT
.*
.STAR ANOP
AIF ('&C' EQ '').ONE
.CHECK ANOP
&Y SETA &Y+1
AIF (&Y GT K'&C).OK
AIF ('&C'(&Y,1) LT '0').ONE
AGO .CHECK
.OK ANOP
&X SETA &C-1
AIF (&X LE 0).END
BNE MTC&SYSNDX.A
AIF (&X EQ 1).ONE2
SYSXXC CLC,&A,&A,&X,D1=1,N=*,BC=(BNE,MTC&SYSNDX.B)
MTC&SYSNDX.A DS 0H
MEXIT
.*
.ONE2 ANOP
MTCCLI &A,&FILL,&FILADDR,D=1
MTC&SYSNDX.A DS 0H
MEXIT
.*
.NULL ANOP
&L CLI *+1,0
.END MEND
./ ADD LIST=ALL,NAME=MTCCLI
MACRO
&L MTCCLI &A,&FILL,&FILADDR,&D=0
AIF ('&FILADDR' NE '').FILADDR
AIF ('&A' EQ '').NREG
AIF ('&A'(1,1) NE '(').NREG
&L CLI &D&A,&FILL
MEXIT
.*
.NREG ANOP
AIF ('&D' EQ '0').ZD
&L CLI &D+&A,&FILL
MEXIT
.*
.ZD ANOP
&L CLI &A,&FILL
MEXIT
.*
.FILADDR ANOP
AIF ('&A' EQ '').NREGFA
AIF ('&A'(1,1) NE '(').NREGFA
&L CLC &D.(1,&A),&FILADDR
MEXIT
.*
.NREGFA ANOP
AIF ('&D' EQ '0').ZDFA
&L MCLC &D+&A,&FILADDR,1
MEXIT
.*
.ZDFA ANOP
&L MCLC &A,&FILADDR,1
MEND
./ ADD LIST=ALL,NAME=MTCL
MACRO
&L MTCL &R,&A,&C,&S,&FILL=0,&FILADDR=,&INLINE=,&N=*
GBLC &CPU
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&CPU' EQ '360').S360
&L SYSLR &R,&A,ERR='ADDRESS REQUIRED'
SYSLR &R+1,&C,ERR='LENGTH REQUIRED'
AIF ('&FILADDR' NE '').FILADDR
AIF ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
L &S+1,=AL1(&FILL,0,0,0)
AGO .CLCL
.*
.FILADDR ANOP
ICM &S+1,8,&FILADDR
.CLCL CLCL &R,&S
MEXIT
.*
.Z370 ANOP
SLR &S+1,&S+1
CLCL &R,&S
MEXIT
.*
.* 360 LOOP
.*
.S360 ANOP
AIF ('&INLINE' EQ 'YES').INLINE
AIF ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').RZ
&L SYSLR &R,&A,ERR='ADDRESS REQUIRED'
SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP MTC&SYSNDX.A
MTCLC &R,&R+1,MTC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
MTC&SYSNDX.A DS 0H
MEXIT
.*
.RZ ANOP
&L SYSLR &S,&A
SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP MTC&SYSNDX.A
MTCLC &S,&R+1,MTC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
MTC&SYSNDX.A DS 0H
MEXIT
.*
.* INLINE
.*
.INLINE ANOP
&L MTC &A,&C,FILL=&FILL,FILADDR=&FILADDR,N=&N
MEND
./ ADD LIST=ALL,NAME=MTCLC
MACRO
&L MTCLC &A,&C,&LEND,&FILL=,&FILADDR=
AIF ('&FILADDR' EQ '').FILL
&L CLC 0(1,&A),&FILADDR
AGO .BNE
.*
.FILL ANOP
&L CLI 0(&A),&FILL
.BNE BNE &LEND
BCTR &C,0
LTR &C,&C
BNP &LEND
MTC&SYSNDX.X C &C,=F'256'
BNH MTC&SYSNDX.Z
CLC 1(256,&A),0(&A)
BNE &LEND
LA &A,256(,&A)
S &C,=F'256'
B MTC&SYSNDX.X
MTC&SYSNDX.Y CLC 1(0,&A),0(&A)
MTC&SYSNDX.Z BCTR &C,0
EX &C,MTC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MTR
MACRO
&L MTR &A,&T,&C,&N=*,&ZERO=
&L SYSXXC1 TR,&A,&T,&C,N=&N
MEXIT
.*
.NULL ANOP
&L CLI *+1,0
MEND
./ ADD LIST=ALL,NAME=MTRL
MACRO
&L MTRL &RA,&A,&T,&RC,&C,&INLINE=,&N=*
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&INLINE' EQ 'YES').INLINE
&L SYSLR &RA,&A,ERR='ADDRESS REQUIRED'
SYSLR &RC,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP TR&SYSNDX.D
TR&SYSNDX.A C &RC,=F'256'
BNH TR&SYSNDX.C
MTR 0(&RA),&T,256
LA &RA,256(,&RA)
S &RC,=F'256'
B TR&SYSNDX.A
TR&SYSNDX.B MTR 0(&RA),&T,0
TR&SYSNDX.C BCTR &RC,0
EX &RC,TR&SYSNDX.B
TR&SYSNDX.D DS 0H
MEXIT
.*
.INLINE ANOP
&L MTR &A,&C,&T,N=&N
MEND
./ ADD LIST=ALL,NAME=MTRT
MACRO
&L MTRT &A,&T,&C,&N=*,&ZERO=
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
&L SYSXXC1 TRT,&A,&T,&C,N=&N,BC=BNZ
MEXIT
.*
.NULL ANOP
&L CLI *+1,0
MEND
./ ADD LIST=ALL,NAME=MTRTL
MACRO
&L MTRTL &RA,&A,&T,&RC,&C,&INLINE=,&N=*
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&INLINE' EQ 'YES').INLINE
&L SYSLR &RA,&A,ERR='ADDRESS REQUIRED'
SYSLR &RC,&C,LTR=YES,ERR='LENGTH REQUIRED'
BNP TRT&SYSNDX.D
TRT&SYSNDX.A C &RC,=F'256'
BNH TRT&SYSNDX.C
MTRT 0(&RA),&T,256
BNZ TRT&SYSNDX.D
LA &RA,256(,&RA)
S &RC,=F'256'
B TRT&SYSNDX.A
TRT&SYSNDX.B MTRT 0(&RA),&T,0
TRT&SYSNDX.C BCTR &RC,0
EX &RC,TRT&SYSNDX.B
TRT&SYSNDX.D DS 0H
MEXIT
.*
.INLINE ANOP
&L MTRT &A,&C,&T,N=&N
MEND
./ ADD LIST=ALL,NAME=MXC
MACRO
&L MXC &A,&B,&C,&N=*,&ZERO=
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
&L SYSXXC XC,&A,&B,&C,N=&N
MEXIT
.*
.NULL ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=MXCL
MACRO
&L MXCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
AIF ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RB+1,&LB
SR &RA+1,&RB+1
BNM *+6
AR &RB+1,&RA+1
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
LTR &RB+1,&RB+1
BNP XC&SYSNDX.A
MXCLN &RA,&RB,&RB+1
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
LA &RA,1(&RA,&RB+1)
XC&SYSNDX.A LTR &RA+1,&RA+1
BNP XC&SYSNDX.B
MXCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
XC&SYSNDX.B DS 0H
MEXIT
.Z ANOP
XC&SYSNDX.A DS 0H
MEXIT
.*
.RAZ ANOP
XR &RA,&RA+1
XR &RA+1,&RA
XR &RA,&RA+1
LTR &RB+1,&RB+1
BNP XC&SYSNDX.A
MXCLN &RA+1,&RB,&RB+1
AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
LA &RA+1,1(&RA+1,&RB+1)
XC&SYSNDX.A LTR &RB+1,&RA
BNP XC&SYSNDX.B
MXCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
XC&SYSNDX.B DS 0H
MEXIT
.RAZZ ANOP
XC&SYSNDX.A DS 0H
MEXIT
.*
.RBZ ANOP
XR &RB,&RA+1
XR &RA+1,&RB
XR &RB,&RA+1
LTR &RB+1,&RB+1
BNP XC&SYSNDX.A
MXCLN &RA,&RA+1,&RB+1
LA &RA,1(&RA,&RB+1)
AIF ('&FILL' EQ '0' AND '&FILADDR' EQ '').RBZZ
XC&SYSNDX.A LTR &RB+1,&RB
BNP XC&SYSNDX.B
MXCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
XC&SYSNDX.B DS 0H
MEXIT
.*
.RBZZ ANOP
XC&SYSNDX.A DS 0H
MEXIT
.*
.* EQUAL LENGTH
.*
.EQ ANOP
AIF ('&INLINE' EQ 'YES').MXC
AIF ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
AIF ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
LTR &RA+1,&RA+1
BNP XC&SYSNDX.A
MXCLN &RA,&RB,&RA+1
XC&SYSNDX.A DS 0H
MEXIT
.*
.EQRAZ ANOP
&L SYSLR &RB+1,&AA
SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP XC&SYSNDX.A
MXCLN &RB+1,&RB,&RA+1
XC&SYSNDX.A DS 0H
MEXIT
.*
.EQRBZ ANOP
&L SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
SYSLR &RB+1,&AB
SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
BNP XC&SYSNDX.A
MXCLN &RA,&RB+1,&RA+1
XC&SYSNDX.A DS 0H
MEXIT
.*
.* MXC
.*
.MXC ANOP
&L MXC &AA,&AB,&LA,N=&N
MEND
./ ADD LIST=ALL,NAME=MXCLN
MACRO
&L MXCLN &A,&B,&C
LCLC &LBL
&LBL SETC '&L'
AIF ('&L' NE '').LBL
&LBL SETC 'XC&SYSNDX.X'
.LBL ANOP
.*
&LBL C &C,=F'256'
BNH XC&SYSNDX.Z
XC 0(256,&A),0(&A)
LA &A,256(,&A)
LA &B,256(,&B)
S &C,=F'256'
B &LBL
XC&SYSNDX.Y XC 0(0,&A),0(&A)
XC&SYSNDX.Z BCTR &C,0
EX &C,XC&SYSNDX.Y
MEND
./ ADD LIST=ALL,NAME=MXCLF
MACRO
&L MXCLF &A,&C,&FILL=,&FILADDR=
AIF ('&FILADDR' EQ '').FILL
&L XC 0(1,&A),&FILADDR
LA &A,1(,&A)
BCT &C,*-10
MEXIT
.*
.FILL ANOP
&L XI 0(&A),&FILL
LA &A,1(,&A)
BCT &C,*-8
MEND
./ ADD LIST=ALL,NAME=MZC
MACRO
&L MZC &A,&C,&N=*,&ZERO=
SYSKWT ZERO,&ZERO,(NULL),COND=NO
AIF ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
&L SYSXXC XC,&A,&A,&C,N=&N
MEXIT
.*
.NULL ANOP
&L SYSLBL
MEND
./ ADD LIST=ALL,NAME=MZCL
MACRO
&L MZCL &R,&A,&C,&S,&INLINE=,&N=*
&L MFCL &R,&A,&C,&S,FILL=0,INLINE=&INLINE,N=&N
MEND
./ ADD LIST=ALL,NAME=NAT
MACRO
NAT
*
* NIH/COMMON - NUCLEUS ADDRESS TABLE
*
NATSTART DS 0F
NATIBMT DC V(IBMORG) FIRST SVC TABLE ENTRY
NATUSERT DC V(USERORG) FIRST USER SVC ENTRY
NATTYPE1 DC V(IEATYPE1) TYPE 1 SVC SWITCH
NATSCSAV DC V(IEASCSAV) SVC SAVE AREA
NATINT DC V(IECINT) ENTRY TO IOS FOR I/O INTERRUPT
NATDISMS DC V(DISMISS) RETURN POINT FROM IOS TO IO FLIH
NATIORG DC V(IORGSW) I/O INTERRUPT IN IOS SWITCH
NATQIO00 DC V(IEAQIO00) I/O 1ST LEVEL INTERRUPT HANDLER
*
DS 0F
NATSIZE EQU *-NATSTART SIZE OF NAT
MEND
./ ADD LIST=ALL,NAME=OPENP
MACRO
&L OPENP &DCB
AIF ('&DCB' EQ '').NULL
AIF ('&DCB'(1,1) EQ '(').REG
&L TM (DCBOFLGS-IHADCB)+&DCB,X'10'
MEXIT
.*
.REG ANOP
&L TM (DCBOFLGS-IHADCB)+0&DCB,X'10'
MEXIT
.*
.NULL ANOP
&L SYSLBL
MNOTE 12,'NO DCB SPECIFIED'
MEND
./ ADD LIST=ALL,NAME=ORGHIGH
ALP;
MACRO &&L: ORGHIGH &&A,&&B,&&BASE=;
LCLA &&X;
&&L: SYSLBL;
ORG &&A+(&&B-&&A)*((&&B+1-&&BASE)/(&&A+1-&&BASE))/((&&B+1-&&BASE)/_
(&&A+1-&&BASE));
ASM FOR &&X FROM 3 TO N'&&SYSLIST
DO ORGHIGH *,&&SYSLIST(&&X),BASE=&&BASE;
MEND;
BAL;
./ ADD LIST=ALL,NAME=OSCALL
MACRO
&L OSCALL &R,&TYPE,&VRF=,&VR0=,&VR1=,&R15=,&R0=,&R1=,&RCR=, *
&PARAM=,&VL=,&PARAMA=,&PARAML=,&CC=,&TEST=,&CHECK=
GBLC R15,R14,R13,BASER,R1,R0
GBLC &OS
LCLA &X,&Y,&Z
LCLC &LBL,&EP
SYSKWT TYPE,&TYPE,(A,V),COND=NO
SYSKWT TEST,&TEST,(YES,NO),COND=NO
SYSKWT CC,&CC,(YES,NO),COND=NO
&LBL SETC '&L'
&EP SETC 'R15'
.*
AIF ('&VRF&R15&RCR' EQ '').NVRF
&EP SETC 'R14'
AIF ('&VRF&R15&RCR' EQ '(R15)').NVRF
&LBL SYSLR R15,&VRF&R15&RCR
&LBL SETC ''
.NVRF ANOP
.*
AIF ('&VR0&R0' EQ '' OR '&VR0&R0' EQ '(R0)').NVR0
&LBL SYSLR R0,&VR0&R0
&LBL SETC ''
.NVR0 ANOP
.*
AIF ('&VR1&R1' EQ '' OR '&VR1&R1' EQ '(R1)').NVR1
&LBL SYSLR R1,&VR1&R1
&LBL SETC ''
.NVR1 ANOP
.*
AIF ('&PARAM' EQ '').NPARAM
AIF ('&PARAMA' NE '').PARAMA
&X SETA 0
&Y SETA 0-4
.PLOOP ANOP
&X SETA &X+1
&Y SETA &Y+4
AIF (&X GT N'&PARAM).PDONE
&LBL SYSLST &Y.(,R13),NEW=&PARAM(&X),REG=R1
&LBL SETC ''
AIF ('&VL' EQ '').PLOOP
AIF (&X NE N'&PARAM).PLOOP
OI &Y.(R13),X'80'
AGO .PLOOP
.*
.PDONE ANOP
CPUSH R1,&Y
AGO .PCHECK
.*
.PARAMA ANOP
&X SETA 0
&Z SETA 0-4
.PLOOPA ANOP
&X SETA &X+1
&Z SETA &Z+4
AIF (&X GT N'&PARAM).PDONEA
&LBL SYSLST &Z+&PARAMA,NEW=&PARAM(&X),REG=R1
&LBL SETC ''
AIF ('&VL' EQ '').PLOOPA
AIF (&X NE N'&PARAM).PLOOPA
OI &Z+&PARAMA,X'80'
AGO .PLOOPA
.*
.PDONEA ANOP
LA R1,&PARAMA
AIF ('&PARAML' EQ '').PCHECK
SYSCMP &Z,LE,&PARAML,MSG='ERROR BELOW IF PARAMETER LIST TOO LONG'
.*
.PCHECK ANOP
AIF ('&VR1&R1' EQ '').NPARAM
MNOTE 12,'BOTH R1 AND PARAM SPECIFIED'
.*
.NPARAM ANOP
.*
AIF ('&R'(1,1) EQ '(').REG
AIF ('&TYPE' EQ 'A').A
&LBL L &EP,=V(&R)
AGO .BALR
.*
.A ANOP
&LBL L &EP,=A(&R)
AGO .BALR
.*
.REG ANOP
AIF ('&EP' EQ 'R14').REG14
&LBL SYSLR &EP,&R
AGO .BALR
.*
.REG14 ANOP
&EP SETC '&R(1)'
&LBL SYSLBL
.*
.BALR ANOP
AIF ('&TEST' NE 'YES').NTEST
LTR &EP,&EP
BZ *+6
.NTEST ANOP
CBALR R14,&EP
AIF (&Y LE 0).END
AIF ('&CC' EQ 'NO').POP
AIF ('&OS' EQ 'XA').IPM
BALR R14,0
AGO .POP
.*
.IPM ANOP
IPM R14
.POP ANOP
CPOP ,&Y
AIF ('&CC' EQ 'NO').END
SPM R14
.END MEND
./ ADD LIST=ALL,NAME=OSENTER
MACRO
&L OSENTER &ENTRY=,&BASE=,&SAVE=,&PACK=,&ID=,&FORWARD=
GBLC R15,R14,R13,BASER,R1,R0
LCLA &X
LCLC &LBL
LCLC &LENSYM,&LENSYM2
LCLA &LENCNT
.*
SYSKWT ENTRY,&ENTRY,(YES,NO),COND=NO
SYSKWT BASE,&BASE,(YES,NO),COND=NO
SYSKWT PACK,&PACK,(YES,NO),COND=NO
SYSKWT FORWARD,&FORWARD,(YES,NO),COND=NO
.*
&LBL SETC '&L'
.*
AIF ('&ENTRY' EQ 'NO' OR '&L' EQ '').NENTRY
AIF ('&L'(1,1) EQ '@').NENTRY
ENTRY &L
.NENTRY ANOP
.*
AIF ('&ID' EQ '').NOID
AIF ('&ID' EQ '*' AND '&L&SYSECT' EQ '').NOID
&LBL B OSE&SYSNDX.B-*(R15)
&LBL SETC 'OSE&SYSNDX.B'
DC AL1(L'OSE&SYSNDX.A)
AIF ('&ID' EQ '*').IDSTAR
AIF ('&ID'(1,1) EQ '''').IDSTR
OSE&SYSNDX.A DC C'&ID'
AGO .NOID
.*
.IDSTR ANOP
OSE&SYSNDX.A DC C&ID
AGO .NOID
.*
.IDSTAR ANOP
AIF ('&L' EQ '').IDCSECT
OSE&SYSNDX.A DC C'&L'
AGO .NOID
.*
.IDCSECT ANOP
OSE&SYSNDX.A DC C'&SYSECT'
.*
.NOID ANOP
.*
AIF ('&PACK' EQ 'YES').PACK
.LOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
AIF (N'&SYSLIST(&X) GE 2).STM
&LBL ST &SYSLIST(&X),20+(&SYSLIST(&X)-16*((&SYSLIST(&X))/14))*4(,R13)
&LBL SETC ''
AGO .LOOP
.STM ANOP
&LBL STM &SYSLIST(&X,1),&SYSLIST(&X,2),20+(&SYSLIST(&X,1)-16*((&S*
YSLIST(&X,1))/14))*4(R13)
&LBL SETC ''
AGO .LOOP
.*
.PACK ANOP
&LENSYM SETC '12'
.*
.PLOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
AIF (N'&SYSLIST(&X) GE 2).PSTM
&LBL ST &SYSLIST(&X),&LENSYM.(,R13)
&LBL SETC ''
AIF (&X EQ N'&SYSLIST).DONE
&LENCNT SETA &LENCNT+1
&LENSYM2 SETC 'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
&LENSYM2 EQU &LENSYM+4
&LENSYM SETC '&LENSYM2'
AGO .PLOOP
.*
.PSTM ANOP
&LBL STM &SYSLIST(&X,1),&SYSLIST(&X,2),&LENSYM.(R13)
&LBL SETC ''
AIF (&X EQ N'&SYSLIST).DONE
&LENCNT SETA &LENCNT+1
&LENSYM2 SETC 'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
&LENSYM2 EQU &LENSYM+4*(&SYSLIST(&X,2)-&SYSLIST(&X,1)+16*((&SYSLIST(&*
X,1)+1)/(&SYSLIST(&X,2)))/((&SYSLIST(&X,1)+1)/(&SYSLIST(*
&X,2)))+1)
&LENSYM SETC '&LENSYM2'
AGO .PLOOP
.*
.DONE ANOP
.*
AIF ('&BASE' EQ 'NO').NBASE
&LBL CBASE BASER
&LBL SETC ''
USING *,BASER
.NBASE ANOP
.*
AIF ('&SAVE' EQ '').NSAVE
AIF ('&FORWARD' EQ 'YES').FORWARD
&LBL ST R13,&SAVE+4
&LBL SETC ''
LA R13,&SAVE
AGO .NSAVE
.*
.FORWARD ANOP
&LBL SYSLR R14,&SAVE
&LBL SETC ''
ST R13,4(,R14)
ST R14,8(,R13)
LR R13,R14
.NSAVE ANOP
.*
&LBL SYSLBL
MEND
./ ADD LIST=ALL,NAME=OSEXIT
MACRO
&L OSEXIT &SAVE=,<R=,&PACK=,&RC=,&FLAG=NO,&BRANCH=
GBLC R15,R14,R13,BASER,R1,R0
LCLA &X
LCLC &LBL
LCLC &LENSYM,&LENSYM2
LCLA &LENCNT
.*
SYSKWT LTR,<R,(R0,R1,R15,R0,R1,R15),COND=NO
SYSKWT PACK,&PACK,(YES,NO),COND=NO
SYSKWT FLAG,&FLAG,(YES,NO),COND=NO
SYSKWT BRANCH,&BRANCH,(YES,NO),COND=NO
.*
&LBL SETC '&L'
.*
AIF ('&SAVE' EQ '').NSAVE
&LBL L R13,4+&SAVE
&LBL SETC ''
.NSAVE ANOP
.*
AIF ('&PACK' EQ 'YES').PACK
.LOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
AIF (N'&SYSLIST(&X) GE 2).LM
&LBL L &SYSLIST(&X),20+(&SYSLIST(&X)-16*((&SYSLIST(&X))/14))*4(,R13)
&LBL SETC ''
AGO .LOOP
.LM ANOP
&LBL LM &SYSLIST(&X,1),&SYSLIST(&X,2),20+(&SYSLIST(&X,1)-16*((&S*
YSLIST(&X,1))/14))*4(R13)
&LBL SETC ''
AGO .LOOP
.*
.PACK ANOP
&LENSYM SETC '12'
.*
.PLOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
AIF (N'&SYSLIST(&X) GE 2).PLM
&LBL L &SYSLIST(&X),&LENSYM.(,R13)
&LBL SETC ''
AIF (&X EQ N'&SYSLIST).DONE
&LENCNT SETA &LENCNT+1
&LENSYM2 SETC 'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
&LENSYM2 EQU &LENSYM+4
&LENSYM SETC '&LENSYM2'
AGO .PLOOP
.*
.PLM ANOP
&LBL LM &SYSLIST(&X,1),&SYSLIST(&X,2),&LENSYM.(R13)
&LBL SETC ''
AIF (&X EQ N'&SYSLIST).DONE
&LENCNT SETA &LENCNT+1
&LENSYM2 SETC 'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
&LENSYM2 EQU &LENSYM+4*(&SYSLIST(&X,2)-&SYSLIST(&X,1)+16*((&SYSLIST(&*
X,1)+1)/(&SYSLIST(&X,2)))/((&SYSLIST(&X,1)+1)/(&SYSLIST(*
&X,2)))+1)
&LENSYM SETC '&LENSYM2'
AGO .PLOOP
.*
.DONE ANOP
.*
AIF ('&FLAG' NE 'YES').NFLAG
&LBL MVI 12(R13),X'FF'
&LBL SETC ''
.NFLAG ANOP
.*
AIF ('&RC' EQ '').NRC
&LBL SYSLR R15,&RC
&LBL SETC ''
.NRC ANOP
.*
AIF ('<R' EQ '').NLTR
&LBL LTR <R,<R
&LBL SETC ''
.NLTR ANOP
.*
AIF ('&BRANCH' EQ 'NO').NBRANCH
&LBL BR R14
&LBL SETC ''
.NBRANCH ANOP
.*
&LBL SYSLBL
MEND
./ ADD LIST=ALL,NAME=OSREGPLI
MACRO
OSREGPLI
*
* REGISTER USAGE
*
* ABSOLUTE REGISTER DEFINITIONS
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
*
* SYMBOLIC REGISTER DEFINITIONS
*
VR0 EQU 0 PARAMETER REGISTER
VR1 EQU 1 PARAMETER REGISTER
XRA EQU 2 WORK REGISTER
XRB EQU 3 WORK REGISTER
XRC EQU 4 WORK REGISTER
XRD EQU 5 WORK REGISTER
XRE EQU 6 WORK REGISTER
XRF EQU 7 WORK REGISTER
XRG EQU 8 WORK REGISTER
XRH EQU 9 WORK REGISTER
XRI EQU 10 WORK REGISTER
BASER EQU 11 BASE REGISTER
GCBR EQU 12 GLOBAL CONTROL BLOCK REGISTER
SAVER EQU 13 SAVE AREA REGISTER
RTNR EQU 14 RETURN ADDRESS REGISTER
RCR EQU 15 RETURN CODE REGISTER
*
LOWR EQU XRA LOWEST REGISTER TO SAVE
HIGHR EQU BASER HIGHEST REGISTER TO SAVE
MEND
./ ADD LIST=ALL,NAME=OSREGS
MACRO
OSREGS
*
* REGISTER USAGE
*
* ABSOLUTE REGISTER DEFINITIONS
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
*
* SYMBOLIC REGISTER DEFINITIONS
*
VR0 EQU 0 PARAMETER REGISTER
VR1 EQU 1 PARAMETER REGISTER
XRA EQU 2 WORK REGISTER
XRB EQU 3 WORK REGISTER
XRC EQU 4 WORK REGISTER
XRD EQU 5 WORK REGISTER
XRE EQU 6 WORK REGISTER
XRF EQU 7 WORK REGISTER
XRG EQU 8 WORK REGISTER
XRH EQU 9 WORK REGISTER
XRI EQU 10 WORK REGISTER
XRJ EQU 11 WORK REGISTER
BASER EQU 12 BASE REGISTER
SAVER EQU 13 SAVE AREA REGISTER
RTNR EQU 14 RETURN ADDRESS REGISTER
RCR EQU 15 RETURN CODE REGISTER
*
LOWR EQU XRA LOWEST REGISTER TO SAVE
HIGHR EQU BASER HIGHEST REGISTER TO SAVE
MEND
./ ADD LIST=ALL,NAME=OSSA
MACRO
&L OSSA &PACK=,&EQU=
GBLA &OSSACNT
LCLA &X,&Y
LCLC &LBL,&EQUL1,&EQUL2
.*
SYSKWT PACK,&PACK,(YES,NO),COND=NO
.*
&LBL SETC '&L'
AIF ('&LBL' NE '').LBLOK
&LBL SETC 'OSSA&SYSNDX'
.LBLOK ANOP
.*
AIF ('&PACK' EQ 'YES').PACK
&LBL DC 18A(0)
AIF ('&EQU' EQ '').END
&Y SETA 0-1
.EQU ANOP
&Y SETA &Y+2
AIF (&Y GT N'&EQU).END
&EQU(&Y) EQU &LBL+12+4*(&EQU(&Y+1)-14+16*((14/(&EQU(&Y+1)+1))/(14/(&E*
QU(&Y+1)+1))))
AGO .EQU
.*
.PACK ANOP
&LBL DC 3A(0)
.*
.PACKGO ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).PACKEQU
AIF (N'&SYSLIST(&X) EQ 1).ONE
DC (&SYSLIST(&X,2)+1-&SYSLIST(&X,1)+16*(((&SYSLIST(&X,1))/(*
&SYSLIST(&X,2)+1))/((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))*
))A(0)
AGO .PACKGO
.*
.ONE ANOP
DC A(0)
AGO .PACKGO
.*
.PACKEQU ANOP
AIF ('&EQU' EQ '').END
&Y SETA 0-1
.PEQU1 ANOP
&Y SETA &Y+2
AIF (&Y GT N'&EQU).END
&OSSACNT SETA &OSSACNT+1
OSSA&OSSACNT.A EQU &LBL+12
&EQUL1 SETC '0'
&EQUL2 SETC 'OSSA&OSSACNT.A'
&X SETA 0
.PEQU2 ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).PDONE
&OSSACNT SETA &OSSACNT+1
AIF (N'&SYSLIST(&X) LE 1).PONE
OSSA&OSSACNT.A EQU 4*(&EQU(&Y+1)-&SYSLIST(&X,1))
OSSA&OSSACNT.B EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
LIST(&X,1))))*(((&SYSLIST(&X,2))/(&EQU(&Y+1)))/((&SYSLIS*
T(&X,2))/(&EQU(&Y+1))))
OSSA&OSSACNT.C EQU 4*(&EQU(&Y+1)-(&SYSLIST(&X,1))+16)
OSSA&OSSACNT.D EQU (((&SYSLIST(&X,2))/(&EQU(&Y+1)))/((&SYSLIST(&X,2))/(*
&EQU(&Y+1))))*(((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))/((&*
SYSLIST(&X,1))/(&SYSLIST(&X,2)+1)))
OSSA&OSSACNT.E EQU 4*(&EQU(&Y+1)-(&SYSLIST(&X,1)))
OSSA&OSSACNT.F EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
LIST(&X,1))))*(((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))/((&*
SYSLIST(&X,1))/(&SYSLIST(&X,2)+1)))
OSSA&OSSACNT.G EQU 4*(&SYSLIST(&X,2)+1-(&SYSLIST(&X,1))+16*(((&SYSLIST(*
&X,1))/(&SYSLIST(&X,2)+1))/((&SYSLIST(&X,1))/(&SYSLIST(&*
X,2)+1))))
OSSA&OSSACNT.H EQU &EQUL1+OSSA&OSSACNT.B+OSSA&OSSACNT.D+OSSA&OSSACNT.F
OSSA&OSSACNT.I EQU &EQUL2+(OSSA&OSSACNT.A*OSSA&OSSACNT.B+OSSA&OSSACNT.C*
*OSSA&OSSACNT.D+OSSA&OSSACNT.E*OSSA&OSSACNT.F)*(1-&EQUL1*
)+OSSA&OSSACNT.G*(1-OSSA&OSSACNT.H)
&EQUL1 SETC 'OSSA&OSSACNT.H'
&EQUL2 SETC 'OSSA&OSSACNT.I'
AGO .PEQU2
.*
.PONE ANOP
OSSA&OSSACNT.A EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
LIST(&X,1))))*(((&SYSLIST(&X,1))/(&EQU(&Y+1)))/((&SYSLIS*
T(&X,1))/(&EQU(&Y+1))))
OSSA&OSSACNT.B EQU &EQUL1+OSSA&OSSACNT.A*(1-&EQUL1)
OSSA&OSSACNT.C EQU &EQUL2+4*(1-OSSA&OSSACNT.B)
&EQUL1 SETC 'OSSA&OSSACNT.B'
&EQUL2 SETC 'OSSA&OSSACNT.C'
AGO .PEQU2
.*
.PDONE ANOP
SYSCMP &EQUL1,EQ,1,MSG='ERROR BELOW IF &EQU(&Y+1) OUT OF RANGE'
&EQU(&Y) EQU &EQUL2
AGO .PEQU1
.END MEND
./ ADD LIST=ALL,NAME=OSSETUP
MACRO
&L OSSETUP ®S=YES,&CBS=YES, *
&MDC=NO,&CVT=NO,&DCB=NO,&DEB=NO,&UCB=NO,&DECB=NO, *
&NAT=NO,&SCT=NO,&TCB=NO,&CDE=NO,&PQE=NO,&RB=NO, *
&ASCB=NO,&S99=NO,&ACB=NO,&RPL=NO,&LRC=NO,&SSOB=NO, *
&SDWA=NO,&JESCT=NO,&PSA=NO,&PCCA=NO,&TQE=NO,&LLE=NO, *
&ASXB=NO, *
&R15=RCR,&R14=RTNR,&R13=SAVER,&BASER=BASER, *
&R1=VR1,&R0=VR0
.*
&L CSETUP REGS=NO,SCABBRS=NO,CBS=&CBS, *
MDC=&MDC,CVT=&CVT,DCB=&DCB,DEB=&DEB,UCB=&UCB,DECB=&DECB,*
NAT=&NAT,SCT=&SCT,TCB=&TCB,CDE=&CDE,PQE=&PQE,RB=&RB, *
ASCB=&ASCB,S99=&S99,ACB=&ACB,RPL=&RPL,LRC=&LRC, *
SSOB=&SSOB,SDWA=&SDWA,JESCT=&JESCT,PSA=&PSA,PCCA=&PCCA, *
TQE=&TQE,LLE=&LLE,ASXB=&ASXB, *
R15=&R15,R14=&R14,R13=&R13,BASER=&BASER,R1=&R1,R0=&R0
.*
AIF ('®S' EQ 'NO').NREGS
AIF ('®S' EQ 'PLI').PLIREGS
OSREGS
AGO .NREGS
.*
.PLIREGS ANOP
OSREGPLI
.NREGS ANOP
MEND
./ ADD LIST=ALL,NAME=RM
MACRO
&L RM &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RMP
MACRO
&L RMP &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RMZ
MACRO
&L RMZ &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RNM
MACRO
&L RNM &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RNMP
MACRO
&L RNMP &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RNMZ
MACRO
&L RNMZ &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RNP
MACRO
&L RNP &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RNZ
MACRO
&L RNZ &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RNZP
MACRO
&L RNZP &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RP
MACRO
&L RP &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RZ
MACRO
&L RZ &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=RZP
MACRO
&L RZP &R
&L LTR &R,&R
MEND
./ ADD LIST=ALL,NAME=SCABBR
MACRO
SCABBR &W
GBLC &SCABWRD(400),&SCABWDF(400),&SCABABR(500),&SCABABF(500)
GBLA &SCABP(400),&SCABC(400),&SCABN,&SCABAN
GBLB &SCABAC(500)
LCLA &X
LCLC &A,&B
.*
AIF ('&W' EQ '').END
.*
AIF (&SCABN LT 400).ROOM
MNOTE 12,'SCABBR WORD TABLE IS FULL'
MEXIT
.*
.ROOM ANOP
AIF ('&W'(1,1) EQ '''').Q
.*
AIF (&SCABN LE 0).NTEST
&A SETC '''&W'' '(1,16)
AIF (K'&W LE 14).OK
&A SETC '&A'(1,15).''''
.OK ANOP
&B SETC '&SCABWRD(&SCABN) '(1,16)
AIF ('&A' GT '&B').NTEST
MNOTE 12,'WORD BELOW IS OUT OF ORDER'
MNOTE 12,'&W'
MEXIT
.*
.NTEST ANOP
AIF (N'&SYSLIST LE 1).END
&SCABN SETA &SCABN+1
&SCABWDF(&SCABN) SETC '''&W'''
&SCABWRD(&SCABN) SETC '''&W'''
AIF (K'&W LE 14).APUT
&SCABWRD(&SCABN) SETC '&SCABWRD(&SCABN)'(1,15).''''
AGO .APUT
.*
.Q ANOP
AIF (&SCABN LE 0).NTESTQ
&A SETC '&W '(1,16)
AIF (K'&W LE 16).OKQ
&A SETC '&A'(1,15).''''
.OKQ ANOP
&B SETC '&SCABWRD(&SCABN) '(1,16)
AIF ('&A' GT '&B').NTEST
MNOTE 12,'WORD BELOW IS OUT OF ORDER'
MNOTE 12,&W
MEXIT
.*
.NTESTQ ANOP
AIF (N'&SYSLIST LE 1).END
&SCABN SETA &SCABN+1
&SCABWDF(&SCABN) SETC '&W'
&SCABWRD(&SCABN) SETC '&W'
AIF (K'&W LE 16).APUT
&SCABWRD(&SCABN) SETC '&SCABWRD(&SCABN)'(1,15).''''
.*
.APUT ANOP
&SCABP(&SCABN) SETA &SCABAN+1
&X SETA 1
.*
.ALOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).ADONE
AIF ('&SYSLIST(&X,1)' EQ '').ALOOP
AIF (&SCABAN LT 500).AOK
MNOTE 12,'SCABBR SYNONYM TABLE IS FULL'
MEXIT
.*
.AOK ANOP
&SCABAN SETA &SCABAN+1
&SCABC(&SCABN) SETA &SCABC(&SCABN)+1
&SCABAC(&SCABAN) SETB ('&SYSLIST(&X)' NE '&SYSLIST(&X,1)')
AIF ('&SYSLIST(&X,1)'(1,1) EQ '''').AQ
&SCABABF(&SCABAN) SETC '''&SYSLIST(&X,1)'''
&SCABABR(&SCABAN) SETC '''&SYSLIST(&X,1)'''
AIF (K'&SYSLIST(&X,1) LE 14).ALOOP
&SCABABR(&SCABAN) SETC '&SCABABR(&SCABAN)'(1,15).''''
AGO .ALOOP
.*
.AQ ANOP
&SCABABF(&SCABAN) SETC '&SYSLIST(&X,1)'
&SCABABR(&SCABAN) SETC '&SYSLIST(&X,1)'
AIF (K'&SYSLIST(&X,1) LE 16).ALOOP
&SCABABR(&SCABAN) SETC '&SCABABR(&SCABAN)'(1,15).''''
AGO .ALOOP
.*
.ADONE ANOP
.*
.END MEND
./ ADD LIST=ALL,NAME=SCABBRS
MACRO
SCABBRS
SCABBR ABBREVIATION,ABB,ABBR,ABBREV
SCABBR ABBREVIATIONS,ABBS,ABBRS,ABBREVS
SCABBR ACCOUNT,ACC,ACCT
SCABBR ACCOUNTC,ACCC,ACCTC
SCABBR ACCOUNTS,ACCS,ACCTS
SCABBR ACTIVE,ACT
SCABBR ACTIVES,ACTS
SCABBR ADDRESS,ADDR
SCABBR ADJUST,ADJ
SCABBR AFTER,AFT
SCABBR ALIGN,ALI
SCABBR ALTER,ALT,(A)
SCABBR ALWAYS,ALW
SCABBR AND,'&&'
SCABBR APPARENT,APP
SCABBR ARGUMENT,ARG
SCABBR ATTENTION,ATTN
SCABBR AUTOMATIC,AUTO
SCABBR BACKLOG,BKL
SCABBR BACKSLASH,BKSL
SCABBR BACKSPACE,BKSP,BS
SCABBR BACKWARD,BKWD,BKW,(B)
SCABBR BACKWARDS,BKWDS,BKWS
SCABBR BATCH,BAT
SCABBR BEFORE,BEF
SCABBR BETWEEN,BET
SCABBR BLANK,BL
SCABBR BLANKS,BLS
SCABBR BLOCK,BLK
SCABBR BLOCKS,BLKS
SCABBR BOOLEAN,BOOL
SCABBR BOX,B
SCABBR BURST,BUR
SCABBR CANCEL,CAN
SCABBR CARRIAGERETURN,CR
SCABBR CATALOG,CAT,CATLG,CTLG
SCABBR CEILING,CEIL
SCABBR CENTER,CEN
SCABBR CENTRAL,CEN,LOCAL
SCABBR CENTSIGN,CENT
SCABBR CHANGE,CH
SCABBR CHARACTER,CHAR
SCABBR CHARACTERS,CHARS
SCABBR CHECK,CHK
SCABBR CHECKPOINT,CKPT
SCABBR CIRCUMFLEX,CFX
SCABBR CLASS,CLS
SCABBR CLEAN,CLN
SCABBR CLEAR,CLR
SCABBR COLLECT,COL,(C)
SCABBR COLUMN,COL
SCABBR COLUMNA,COLA
SCABBR COLUMNS,COLS
SCABBR COLUMNSA,COLSA
SCABBR COMMAND,CMD
SCABBR COMMANDS,CMDS
SCABBR COMMON,COM
SCABBR COMMONS,COMS
SCABBR COMPARE,COMP
SCABBR CONDENSE,COND
SCABBR CONSOLE,CON
SCABBR CONSTANT,CONST
SCABBR CONTENT,CONT
SCABBR CONTENTS,CONTS
SCABBR CONTINUE,CONT
SCABBR CONTROL,CTL,CNTL
SCABBR COPIES,COPS,COPYS,CPYS
SCABBR COPY,COP,CPY
SCABBR COUNT,CNT
SCABBR COUNTERS,CTRS
SCABBR COUNTS,CNTS
SCABBR CREATE,CRE
SCABBR CURRENT,CUR,C
SCABBR CYCLE,CYC
SCABBR CYLINDER,CYL
SCABBR CYLINDERS,CYLS
SCABBR DATED,DTD
SCABBR DDNAME,DDN,DD
SCABBR DDNAMES,DDNS,DDS
SCABBR DEFAULT,DEF
SCABBR DELETE,DEL,(D)
SCABBR DELIMITER,DLM
SCABBR DENSITY,DEN
SCABBR DEVICE,DEV
SCABBR DIGIT,DIG
SCABBR DIRECTORY,DIR
SCABBR DISCOUNT,DISC,DIS
SCABBR DITTO,DIT
SCABBR DOUBLE,DBL
SCABBR DOWN,DN
SCABBR DSNAME,DSN
SCABBR DSNAMES,DSNS
SCABBR DUPLICATE,DUP
SCABBR DUPLICATES,DUPS,DUP
SCABBR EBCDIC,EBC
SCABBR EMPTY,EMP
SCABBR ENCLOSE,ENC
SCABBR END,E
SCABBR ENDBLINK,EBK
SCABBR ENDBOLD,EBD
SCABBR ENDFIELD,EFD
SCABBR ENDREVERSE,ERV
SCABBR ENDUNDERLINE,EUL
SCABBR ENTER,ENT
SCABBR ERROR,ERR
SCABBR ERRORS,ERRS
SCABBR ESCAPE,ESC
SCABBR EVERY,EV
SCABBR EXCHANGE,EXCH
SCABBR EXCLUSIVE,EXC
SCABBR EXECUTE,EX,EXEC,XEQ,(X)
SCABBR EXPLAIN,EXPL
SCABBR FETCH,FET
SCABBR FIRST,F
SCABBR FLAG,FLG
SCABBR FLAGGED,FLGD
SCABBR FOLLOWING,FOL
SCABBR FOOTING,FOOT
SCABBR FORGET,FGT
SCABBR FORGOTTEN,FGTN
SCABBR FORMAT,FMT
SCABBR FORMFEED,FF
SCABBR FORMLETTER,FORMLTR,FORML
SCABBR FORWARD,FWD,(F)
SCABBR FORWARDS,FWDS
SCABBR FROM,FR
SCABBR GLOBAL,GBL
SCABBR GLOBALS,GBLS
SCABBR GROUP,GRP
SCABBR HALFLINEFEED,HLF
SCABBR HEADING,HEAD
SCABBR HEIGHT,HGT
SCABBR HORIZONTALTAB,HT
SCABBR HYPHENATE,HYP,HY
SCABBR INCREMENT,INCR
SCABBR INDENT,IND
SCABBR INFINITY,INF
SCABBR INITIAL,INIT
SCABBR INITIALS,INIT,INITS
SCABBR INITIALSC,INITC,INITSC
SCABBR INSERT,INS,(I)
SCABBR INTEGER,INT
SCABBR ISBOOLEAN,ISBOOL
SCABBR ISINTEGER,ISINT
SCABBR ISNUMBER,ISNUM
SCABBR JOBNUMBER,JOBNUM
SCABBR JOIN,(J)
SCABBR JUSTIFIED,JUS,JUST
SCABBR JUSTIFY,JUS,JUST
SCABBR KEYWORD,KEY,KW
SCABBR KEYWORDS,KEYS,KWS
SCABBR LABEL,LAB,LBL
SCABBR LAST,L
SCABBR LEFTCURLY,LCURL
SCABBR LEFTSQUARE,LSQ
SCABBR LENGTH,LEN
SCABBR LENGTHA,LENA
SCABBR LETTER,LTR
SCABBR LEVEL,LEV
SCABBR LIMIT,LIM
SCABBR LINEFEED,LF
SCABBR LIST,LIS,(L)
SCABBR LOCAL,LOC,LCL
SCABBR LOCALS,LOCS,LCLS
SCABBR LOCATE,LOC
SCABBR LOGOFF,LOGOUT
SCABBR LOGON,LOGIN
SCABBR LOWER,LOW
SCABBR MARKER,MAR,MARK
SCABBR MASTER,MAS,MAST
SCABBR MAXIMUM,MAX
SCABBR MEMBER,MEM
SCABBR MEMBERS,MEMS
SCABBR MESSAGE,MSG
SCABBR MESSAGES,MSGS
SCABBR MILTEN,MIL
SCABBR MINIMUM,MIN
SCABBR MODIFY,MOD,(M)
SCABBR MONITOR,MON
SCABBR MULTICOLUMN,MULTICOL
SCABBR MULTICOLUMNS,MULTICOLS
SCABBR MULTIPLE,MUL,MULT
SCABBR NEQ,NE
SCABBR NEWFONT,NF
SCABBR NEWLINE,NL
SCABBR NO,N
SCABBR NOACCOUNT,NOACC,NOACCT
SCABBR NOACCOUNTS,NOACCS,NOACCTS
SCABBR NOADJUST,NOADJ
SCABBR NOATTENTION,NOATTN
SCABBR NOBOX,NOB
SCABBR NOCLEAN,NOCLN
SCABBR NOCOLUMN,NOCOL
SCABBR NOCOLUMNS,NOCOLS
SCABBR NOCONTINUE,NOCONT
SCABBR NOCOPIES,NOCOPS,NOCOPYS,NOCPYS
SCABBR NOCOPY,NOCOP,NOCPY
SCABBR NOCREATE,NOCRE
SCABBR NODEFAULT,NODEF
SCABBR NODISCOUNT,NODISC,NODIS
SCABBR NODOWN,NODN
SCABBR NODSNAME,NODSN
SCABBR NOESCAPE,NOESC
SCABBR NOEXCLUSIVE,NOEXC
SCABBR NOEXECUTE,NOEXEC,NOEX,NOXEQ
SCABBR NOFLAG,NOFLG
SCABBR NOFORMFEED,NOFF
SCABBR NOHEIGHT,NOHGT
SCABBR NOHYPHENATE,NOHYP,NOHY
SCABBR NOINDENT,NOIND
SCABBR NOINITIALS,NOINITS,NOINIT
SCABBR NOJOBNUMBER,NOJOBNUM
SCABBR NOJUSTIFY,NOJUS,NOJUST
SCABBR NOKEYWORD,NOKEY,NOKW
SCABBR NOKEYWORDS,NOKEYS,NOKWS
SCABBR NOLABEL,NOLAB,NOLBL
SCABBR NOLENGTH,NOLEN
SCABBR NOLIMIT,NOLIM
SCABBR NOLIST,NOL
SCABBR NOMARKER,NOMAR,NOMARK
SCABBR NOMESSAGE,NOMSG
SCABBR NOMESSAGES,NOMSGS
SCABBR NOMULTICOLUMN,NOMULTICOL
SCABBR NOMULTICOLUMNS,NOMULTICOLS
SCABBR NONOTIFY,NONTF
SCABBR NONSTANDARD,NONSTD,NSTD
SCABBR NONUMBER,NONUM
SCABBR NOOPERATOR,NOOPER,NOOPR
SCABBR NOOVERLAP,NOOVLAP
SCABBR NOOVERLAY,NOOVLAY
SCABBR NOPOINT,NOPNT,NOPT
SCABBR NOPREFIX,NOPRE
SCABBR NOPREVIEW,NOPV
SCABBR NOPRIORITY,NOPRIO,NOPRI
SCABBR NOPRIVILEGE,NOPRIV
SCABBR NOPROGRAMMER,NOPGMR
SCABBR NOPURGE,NOPUR
SCABBR NOQUICK,NOQCK
SCABBR NORECOVERY,NORECOV
SCABBR NORETRY,NORT
SCABBR NORETURN,NORTN
SCABBR NOROUTE,NORTE
SCABBR NOSCRATCH,NOSCR
SCABBR NOSECOND,NOSEC
SCABBR NOSECONDS,NOSECS
SCABBR NOSPACE,NOSP
SCABBR NOSTATEMENT,NOSTMT
SCABBR NOSTATEMENTS,NOSTMTS
SCABBR NOSUBTITLE,NOSUBTTL
SCABBR NOT,^
SCABBR NOTEMPORARY,NOTEMP
SCABBR NOTERSE,NOTER
SCABBR NOTEXT,NOTXT,NOTX
SCABBR NOTIFY,NTF
SCABBR NOTIMEOUT,NOTIME
SCABBR NOTITLE,NOTTL
SCABBR NOVERIFY,NOVER
SCABBR NOVOLUME,NOVOL
SCABBR NOWIDTH,NOWID
SCABBR NUMBER,NUM
SCABBR NUMBERED,NUMD
SCABBR OCCURRENCES,OCCURS,OCCUR,OCCS,OCC
SCABBR OFFLINE,OFF
SCABBR OPERATOR,OPER,OPR
SCABBR OR,|
SCABBR OUTPUT,OUT
SCABBR OVERLAP,OVLAP
SCABBR OVERLAY,OVLAY
SCABBR PAGE,PG
SCABBR PAGINATE,PAG
SCABBR PARAGRAPH,PAR,PGH
SCABBR PATTERN,PAT
SCABBR POINT,PNT,PT,(P)
SCABBR POSITION,POS
SCABBR POSITIONAL,POS
SCABBR PRECEDING,PREC
SCABBR PREFIX,PRE
SCABBR PREVIEW,PV
SCABBR PREVIOUS,PREV,PRV
SCABBR PRINT,PRT,PRNT
SCABBR PRIORITY,PRI,PRIO
SCABBR PRIVILEGE,PRIV
SCABBR PROCEDURE,PROC
SCABBR PROCEDURES,PROCS
SCABBR PROGRAM,PROG,PGM
SCABBR PROGRAMMER,PGMR
SCABBR PUNCH,PUN
SCABBR PUNCTUATION,PUNC
SCABBR PURGE,PUR
SCABBR QUICK,QCK
SCABBR QUIET,QUI
SCABBR RECATALOG,RECAT,RECTLG,RECATLG
SCABBR RECEIVE,RCV
SCABBR RECOVERY,RECOV
SCABBR RELEASE,RLSE,RLS
SCABBR REMEMBER,REMEM
SCABBR REMOTE,REM,RMT
SCABBR RENAME,REN
SCABBR RENUMBER,RENUM
SCABBR REPLACE,REP,(R)
SCABBR RESAVE,RSV
SCABBR RETRIEVE,RTV,RETRV
SCABBR RETRY,RT
SCABBR RETURN,RTN
SCABBR RETURNS,RTNS
SCABBR REVERSEHALFLINEFEED,RHLF
SCABBR REVERSELINEFEED,RLF
SCABBR REVERSESLASH,RSLASH
SCABBR RIGHTCURLY,RCURL
SCABBR RIGHTSQUARE,RSQ
SCABBR ROUTE,RTE
SCABBR SAVE,SV
SCABBR SCRATCH,SCR
SCABBR SECOND,SEC
SCABBR SECONDS,SECS
SCABBR SEPARATOR,SEP
SCABBR SHARED,SHR
SCABBR SHIFTIN,SI
SCABBR SHIFTOUT,SO
SCABBR SHOW,SH
SCABBR SPACE,SP
SCABBR SPACES,SPS
SCABBR SPACING,SPN
SCABBR SPLIT,SPL,(S)
SCABBR STARTBLINK,SBK
SCABBR STARTBOLD,SBD
SCABBR STARTFIELD,SFD
SCABBR STARTREVERSE,SRV
SCABBR STARTUNDERLINE,SUL
SCABBR STATEMENT,STMT
SCABBR STATEMENTS,STMTS
SCABBR STATUS,STAT
SCABBR STOPCODE,SC
SCABBR STORAGE,STOR
SCABBR STRING,STR
SCABBR STRINGM,STRM
SCABBR STRINGZ,STRZ
SCABBR SUBSTITUTE,SUBST
SCABBR SUBSTRING,SUBSTR
SCABBR SUBSTRINGA,SUBSTRA
SCABBR SUBTITLE,SUBTTL
SCABBR SUGGEST,SUG
SCABBR TABLE,TBL
SCABBR TEMPORARY,TEMP
SCABBR TERMINAL,TERM
SCABBR TERMINATE,TERM
SCABBR TERSE,TER
SCABBR TEXT,TXT,TX
SCABBR TITLE,TTL
SCABBR TRACK,TRK
SCABBR TRACKS,TRKS
SCABBR TRIPLE,TRI,TPL
SCABBR TRUNCATE,TRUNC
SCABBR TYPE,TYP,(T)
SCABBR UNCATALOG,UNCAT,UNCTLG,UNCATLG
SCABBR UNDERLINE,UNDL,ULINE
SCABBR UNDERLINED,UNDLD,ULINED
SCABBR UNDERSCORE,UNDSC,USCORE
SCABBR UNFLAGGED,UNFLGD,UFLGD
SCABBR UNNUMBERED,UNN
SCABBR UPLOW,UPL
SCABBR UPPER,UPP,UPR
SCABBR USING,USN
SCABBR VARIABLE,VAR
SCABBR VARIABLES,VARS
SCABBR VERBATIM,VBTM,VB
SCABBR VERIFY,VER
SCABBR VERIFYA,VERA
SCABBR VERIFYN,VERN
SCABBR VERIFYNA,VERNA
SCABBR VERTICALBAR,VBAR
SCABBR VERTICALTAB,VTAB
SCABBR VIEW,(V)
SCABBR VOLUME,VOL
SCABBR VOLUMES,VOLS
SCABBR WIDTH,WID
SCABBR WYLBUR,WYL
SCABBR YES,Y
MEND
./ ADD LIST=ALL,NAME=SCAN
MACRO
&L SCAN &PRT,&BRANCH=,&LIMIT=,&SCT=SCTSTART
GBLC &SCANEND(10),&SCANPRT(10)
GBLA &SCANCNT
GBLA &SCANNDX
&SCANNDX SETA &SCANNDX+1
SYSKWT BRANCH,&BRANCH,(YES,NO)
.*
AIF ('&PRT' EQ '*').STAR
&L SYSLR VR1,&PRT,TYPE=&BRANCH,SELECT=(NO)
SYSLR VR0,&LIMIT
SYSLR VRF,&SCT
SCCALL SCAN
MEXIT
.*
.STAR ANOP
&SCANCNT SETA &SCANCNT+1
&SCANEND(&SCANCNT) SETC 'SCN&SCANNDX.E'
&SCANPRT(&SCANCNT) SETC 'SCN&SCANNDX.T'
&L SYSLR VR1,SCN&SCANNDX.T,TYPE=&BRANCH,SELECT=(NO)
SYSLR VR0,&LIMIT
SYSLR VRF,&SCT
SCCALL SCAN
B &SCANEND(&SCANCNT)
SCN&SCANNDX.T DS 0X
MEND
./ ADD LIST=ALL,NAME=SCANEND
MACRO
&L SCANEND
GBLC &SCANEND(10)
GBLA &SCANCNT
AIF (&SCANCNT GE 0).OK
MNOTE 12,'NO MATCHING SCAN *'
MEXIT
.*
.OK ANOP
&L SYSLBL
&SCANEND(&SCANCNT) SYSLBL
&SCANCNT SETA &SCANCNT-1
MEND
./ ADD LIST=ALL,NAME=SCBACK
MACRO
&L SCBACK &SCT=SCTSTART
&L MMVC SCTLEN-SCTSTART+&SCT,SCTBLEN-SCTSTART+&SCT,8
MEND
./ ADD LIST=ALL,NAME=SCCALL
MACRO
&L SCCALL &R,&RETURN=
&L CCALL &R,RETURN=&RETURN
MEND
./ ADD LIST=ALL,NAME=SCDONE
MACRO
&L SCDONE &SCT=SCTSTART
GBLA &SCANNDX
&SCANNDX SETA &SCANNDX+1
.*
&L SCAN SCT=&SCT
BNP SCD&SCANNDX.X
SCERROR OLD=RTNR,SCT=&SCT
LI VRF,SCTCSCD
SCCALL (RTNR)
SCD&SCANNDX.X DS 0H
MEND
./ ADD LIST=ALL,NAME=SCDQUOTE
MACRO
&L SCDQUOTE &LOC,&LEN,&SCT=
&L SYSQS VR1,VR0,&LOC,&LEN
SCCALL SCDQUOTE
MEND
./ ADD LIST=ALL,NAME=SCERROR
MACRO
&L SCERROR &NEW=,&OLD=,&NEWPARM=,&OLDPARM=,&SCT=SCTSTART
LCLC &LBL
.*
&LBL SETC '&L'
.*
AIF ('&NEW&OLD' EQ '' AND '&NEWPARM&OLDPARM' NE '').PARM
&LBL SYSLST SCTERROR-SCTSTART+&SCT,NEW=&NEW,OLD=&OLD
&LBL SETC ''
AIF ('&NEWPARM&OLDPARM' EQ '').END
.*
.PARM ANOP
&LBL SYSLST SCTERRP-SCTSTART+&SCT,NEW=&NEWPARM,OLD=&OLDPARM
.END MEND
./ ADD LIST=ALL,NAME=SCEXTRA
MACRO
&L SCEXTRA
&L SCAN *
SCKW ,*,B
SCANEND
MEND
./ ADD LIST=ALL,NAME=SCINIT
MACRO
&L SCINIT &LOC,&LEN,&SCT=SCTSTART
&L MZC SCTINIT-SCTSTART+&SCT,SCTINITL
AIF ('&LEN,&LOC' EQ '(VRE),(VRF)').STM
AIF ('&LEN,&LOC' EQ '(VRF),(VR0)').STM
AIF ('&LEN,&LOC' EQ '(VR0),(VR1)').STM
AIF ('&LEN,&LOC' EQ '(VR1),(XRA)').STM
AIF ('&LEN,&LOC' EQ '(XRA),(XRB)').STM
AIF ('&LEN,&LOC' EQ '(XRB),(XRC)').STM
AIF ('&LEN,&LOC' EQ '(XRC),(XRD)').STM
AIF ('&LEN,&LOC' EQ '(XRD),(XRE)').STM
AIF ('&LEN,&LOC' EQ '(XRE),(XRF)').STM
.*
AIF ('&LEN' EQ '').LRLEN
AIF ('&LEN'(1,1) NE '(').LRLEN
ST &LEN,SCTLEN-SCTSTART+&SCT
AGO .LOC
.*
.LRLEN ANOP
SYSLR RTNR,&LEN,ERR='LENGTH MISSING'
ST RTNR,SCTLEN-SCTSTART+&SCT
.*
.LOC ANOP
AIF ('&LOC' EQ '').LRLOC
AIF ('&LOC'(1,1) NE '(').LRLOC
ST &LOC,SCTLOC-SCTSTART+&SCT
MEXIT
.*
.LRLOC ANOP
SYSLR RTNR,&LOC,ERR='LOCATION MISSING'
ST RTNR,SCTLOC-SCTSTART+&SCT
MEXIT
.*
.STM ANOP
STM &LEN,&LOC,SCTLEN-SCTSTART+&SCT
MEND
./ ADD LIST=ALL,NAME=SCKW
MACRO
&L SCKW &WORD,&RTN,&OPTS,&LIMIT=,&CODE=
GBLC &SCKWABR(50)
GBLA &SCKWN
GBLB &SCKWHD,&SCKWAC
GBLC &SCKWAVS,&SCKWRTN
GBLA &SCKWAVC
GBLC &SCKWTBL(42)
LCLA &X,&Y,&Z,&TYPE,&LIML,&CODL
LCLB &B,&J,&P,&TL
LCLC &CH,&LBL
.*
&LBL SETC '&L'
SCKWR INIT
.*
&SCKWAC SETB 0
.LOOP ANOP
&X SETA &X+1
AIF (&X GT N'&OPTS).LOOPEND
AIF ('&OPTS(&X)' EQ 'P').P
AIF ('&OPTS(&X)' EQ 'I').I
AIF ('&OPTS(&X)' EQ 'PI').PI
AIF ('&OPTS(&X)' EQ 'O').O
AIF ('&OPTS(&X)' EQ 'PO').PO
AIF ('&OPTS(&X)' EQ 'LN').LN
AIF ('&OPTS(&X)' EQ 'PLN').PLN
AIF ('&OPTS(&X)' EQ 'QS').QS
AIF ('&OPTS(&X)' EQ 'OQS').OQS
AIF ('&OPTS(&X)' EQ 'PS').PS
AIF ('&OPTS(&X)' EQ 'OPS').OPS
AIF ('&OPTS(&X)' EQ 'B').B
AIF ('&OPTS(&X)' EQ 'J').J
AIF ('&OPTS(&X)' EQ 'SC').SC
AIF ('&OPTS(&X)' EQ 'SCI').SCI
AIF ('&OPTS(&X)' EQ 'AC').AC
AIF ('&OPTS(&X)' EQ 'VC').VC
AIF ('&OPTS(&X)' EQ 'C').C
AIF ('&OPTS(&X)' EQ 'TL').TL
MNOTE 12,'"&OPTS(&X)" IS AN ILLEGAL OPTION'
AGO .LOOP
.*
.* P
.*
.P ANOP
&P SETB 1
AGO .LOOP
.*
.* I
.*
.I ANOP
&TYPE SETA 1
AGO .LOOP
.*
.* PI
.*
.PI ANOP
&TYPE SETA 2
AGO .LOOP
.*
.* O
.*
.O ANOP
&TYPE SETA 3
AGO .LOOP
.*
.* PO
.*
.PO ANOP
&TYPE SETA 4
AGO .LOOP
.*
.* LN
.*
.LN ANOP
&TYPE SETA 5
AGO .LOOP
.*
.* PLN
.*
.PLN ANOP
&TYPE SETA 6
AGO .LOOP
.*
.* QS
.*
.QS ANOP
&TYPE SETA 7
AGO .LOOP
.*
.* OQS
.*
.OQS ANOP
&TYPE SETA 8
AGO .LOOP
.*
.* PS
.*
.PS ANOP
&TYPE SETA 9
AGO .LOOP
.*
.* OPS
.*
.OPS ANOP
&TYPE SETA 10
AGO .LOOP
.*
.* B
.*
.B ANOP
&B SETB 1
AGO .LOOP
.*
.* J
.*
.J ANOP
&J SETB 1
AGO .LOOP
.*
.* SC
.*
.SC ANOP
&SCKWAVS SETC 'SL2'
&SCKWAVC SETA 2
AGO .LOOP
.*
.* SCI
.*
.SCI ANOP
&SCKWAVS SETC 'SL2'
&SCKWAVC SETA 3
AGO .LOOP
.*
.* AC
.*
.AC ANOP
&SCKWAVS SETC 'AL4'
&SCKWAVC SETA 0
AGO .LOOP
.*
.* VC
.*
.VC ANOP
&SCKWAVS SETC 'VL4'
&SCKWAVC SETA 1
AGO .LOOP
.*
.C ANOP
&SCKWAC SETB 1
AGO .LOOP
.*
.TL ANOP
&TL SETB 1
AGO .LOOP
.*
.LOOPEND ANOP
.*
SCKWR ADDR,&RTN
.*
AIF ('&LIMIT' EQ '').NLIM
AIF (K'&LIMIT LT 4).ERRLIM
AIF ('&LIMIT'(1,2) EQ 'AL').LIML
AIF ('&LIMIT'(1,2) EQ 'YL').LIML
AIF ('&LIMIT'(1,2) EQ 'FL').LIML
AIF ('&LIMIT'(1,2) EQ 'HL').LIML
AIF ('&LIMIT'(1,2) EQ 'XL').LIML
AIF ('&LIMIT'(1,2) EQ 'BL').LIML
AIF ('&LIMIT'(1,2) EQ 'CL').LIML
.ERRLIM MNOTE 12,'ILLEGAL LIMIT'
AGO .NLIM
.*
.LIML ANOP
AIF ('&LIMIT'(2,1) NE 'L').ERRLIM
&CH SETC '&LIMIT'(3,1)
AIF ('&CH' NE '1' AND '&CH' NE '2' AND '&CH' NE '4').ERRLIM
&LIML SETA &CH
AIF ('&LIMIT'(4,1) NE '(' AND '&LIMIT'(4,1) NE '''').ERRLIM
&LIML SETA &LIML-&LIML/4
.NLIM ANOP
.*
AIF ('&CODE' EQ '').NCOD
AIF (K'&CODE LT 4).ERRCOD
AIF ('&CODE'(1,2) EQ 'AL').CODL
AIF ('&CODE'(1,2) EQ 'YL').CODL
AIF ('&CODE'(1,2) EQ 'FL').CODL
AIF ('&CODE'(1,2) EQ 'HL').CODL
AIF ('&CODE'(1,2) EQ 'XL').CODL
AIF ('&CODE'(1,2) EQ 'BL').CODL
AIF ('&CODE'(1,2) EQ 'CL').CODL
.ERRCOD MNOTE 12,'ILLEGAL CODE'
AGO .NCOD
.*
.CODL ANOP
AIF ('&CODE'(2,1) NE 'L').ERRCOD
&CH SETC '&CODE'(3,1)
AIF ('&CH' NE '1' AND '&CH' NE '2' AND '&CH' NE '4').ERRCOD
&CODL SETA &CH
AIF ('&CODE'(4,1) NE '(' AND '&CODE'(4,1) NE '''').ERRCOD
&CODL SETA &CODL-&CODL/4
.NCOD ANOP
.*
&SCKWN SETA 0
&SCKWHD SETB 0
&X SETA 0
.WLOOP ANOP
&X SETA &X+1
AIF (&X GT N'&WORD).WDONE
AIF ('&WORD(&X)' EQ '').WLOOP
AIF ('&WORD(&X)'(1,1) EQ '''').WQ
SCKWA '&WORD(&X)'
AGO .WLOOP
.*
.WQ SCKWA &WORD(&X)
AGO .WLOOP
.*
.WDONE ANOP
.*
&X SETA 0
&Y SETA 0
.GLOOP ANOP
.*
AIF ('&SCKWTBL(1)' EQ '').NTBLP
&Z SETA 0
AIF (&SCKWN LT 1).TBLP
AIF (&X EQ 0).TBLPC
AIF (&X+1 GT &SCKWN).NTBLP
AIF ('&SCKWABR(&X)'(2,1) EQ '&SCKWABR(&X+1)'(2,1)).NTBLP
.TBLPC ANOP
AIF ('&SCKWABR(&X+1)'(2,1) LT 'A').TBLP
AIF ('&SCKWABR(&X+1)'(2,1) GT 'Z').TBLP
&CH SETC 'C'''.'&SCKWABR(&X+1)'(2,1).''''
&Z SETA &CH-C'A'+1
.TBLP ANOP
&LBL SYSLBL TYPE=X
&LBL SETC ''
&Z SETA &Z+1
&SCKWTBL(&Z) SCKWTBLP &Z
.NTBLP ANOP
.*
&X SETA &X+1
AIF (&X GT &SCKWN).GDONE
AIF (&X+1 GT &SCKWN).NA3
AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1) '(1,2).'''').NA1
&Y SETA &Y+1
AGO .GLOOP
.*
.NA1 ANOP
AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1) '(1,3).'''').NA2
&Y SETA &Y+2
AGO .GLOOP
.*
.NA2 ANOP
AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1) '(1,4).'''').NA3
&Y SETA &Y+4
AGO .GLOOP
.*
.NA3 ANOP
&LBL SCKWB &SCKWABR(&X),&Y
&LBL SETC ''
&Y SETA 0
.*
AIF ('&SCKWTBL(1)' EQ '').GLOOP
AIF (&X+1 GT &SCKWN).GLOOP
AIF ('&SCKWABR(&X)'(2,1) EQ '&SCKWABR(&X+1)'(2,1)).GLOOP
.*
.GDONE ANOP
.*
&LBL DC AL.1(1),AL.1(0),AL.2(&SCKWAVC),AL.2(&LIML),AL.2(&CODL)
&LBL SETC ''
DC AL.1(&TL),AL.1(&P),AL.1(&B),AL.1(&J),AL.4(&TYPE)
DC &SCKWAVS.(&SCKWRTN)
AIF ('&LIMIT' EQ '').NGLIM
DC &LIMIT
.NGLIM ANOP
.*
AIF ('&CODE' EQ '').NGCOD
DC &CODE
.NGCOD ANOP
.*
AIF (&X LT &SCKWN).GLOOP
.*
.END MEND
./ ADD LIST=ALL,NAME=SCKWA
MACRO
SCKWA &W,&SW
GBLC &SCKWABR(50)
GBLA &SCKWN
GBLB &SCKWHD,&SCKWAC
GBLC &SCABWRD(400),&SCABABR(500)
GBLA &SCABP(400),&SCABC(400),&SCABN,&SCABAN
GBLB &SCABAC(500)
LCLC &A,&B
LCLA &X,&Y,&Z
.*
&A SETC '&W '(1,16)
AIF (K'&W LE 16).LENOK
&A SETC '&A'(1,15).''''
.LENOK ANOP
.*
.TLOOP ANOP
&X SETA &X+1
AIF (&X GT &SCKWN).TDONE
&B SETC '&SCKWABR(&X) '(1,16)
AIF ('&A' GT '&B').TLOOP
AIF ('&A' LT '&B').TDONE
AIF ('&SW' NE '').END
MNOTE 12,'WORD BELOW IS DUPLICATED'
MNOTE 12,&W
&SCKWHD SETB 0
AGO .END
.*
.TDONE ANOP
.*
AIF (&SCKWN LT 50).OK
MNOTE 12,'SCKW TABLE OVERFLOW'
MEXIT
.*
.OK ANOP
.*
&SCKWN SETA &SCKWN+1
AIF (&X GE &SCKWN).MDONE
&Y SETA &SCKWN+1
.MLOOP ANOP
&Y SETA &Y-1
AIF (&Y LE &X).MDONE
&SCKWABR(&Y) SETC '&SCKWABR(&Y-1)'
AGO .MLOOP
.*
.MDONE ANOP
&SCKWABR(&X) SETC '&W'
AIF (K'&W LE 16).MN2
&SCKWABR(&X) SETC '&SCKWABR(&X)'(1,15).''''
.MN2 ANOP
.*
AIF (&SCABN LT 1).END
&X SETA 1
&Y SETA &SCABN
.BLOOP ANOP
AIF (&X GT &Y).END
&Z SETA &X+(&Y-&X)/2
&B SETC '&SCABWRD(&Z) '(1,16)
AIF ('&A' EQ '&B').BFOUND
AIF (&X EQ &Y).END
AIF ('&A' LT '&B').BLEFT
&X SETA &Z+1
AGO .BLOOP
.*
.BLEFT ANOP
&Y SETA &Z-1
AGO .BLOOP
.*
.BFOUND ANOP
&X SETA &SCABP(&Z)-1
&Y SETA &SCABC(&Z)
.*
.CLOOP ANOP
&X SETA &X+1
&Y SETA &Y-1
AIF (&Y LT 0).END
AIF (&SCABAC(&X) AND NOT &SCKWAC).CLOOP
AIF (&SCKWHD).NHD
&SCKWHD SETB 1
MNOTE *,'ABBREVIATIONS/SYNONYMS'
.NHD MNOTE *,&SCABABR(&X)
SCKWA &SCABABR(&X),NO
AGO .CLOOP
.*
.END MEND
./ ADD LIST=ALL,NAME=SCKWB
MACRO
&L SCKWB &W,&A
LCLA &X,&LEN
.*
&X SETA 1
.COUNT ANOP
&X SETA &X+1
AIF (&X GT K'&W-1).COUNTED
&LEN SETA &LEN+1
AIF ('&W'(&X,2) NE ''''''(1,2) AND '&W'(&X,2) NE '&&&&'(1,2)).COUNT
&X SETA &X+1
AGO .COUNT
.*
.COUNTED ANOP
&L DC AL.1(0),AL.3(&A),AL.4(&LEN),C&W
MEND
./ ADD LIST=ALL,NAME=SCKWR
MACRO
&L SCKWR &TYPE,&RTN
GBLC &SCANEND(10)
GBLA &SCANCNT
GBLC &SCKWAVS,&SCKWRTN
GBLA &SCKWAVC
LCLA &X
AIF ('&TYPE' EQ 'INIT').INIT
AIF ('&TYPE' EQ 'ADDR').ADDR
MNOTE 12,'SCKWR &TYPE IS ILLEGAL'
MEXIT
.*
.INIT ANOP
&SCKWAVS SETC 'AL4'
&SCKWAVC SETA 0
&SCKWRTN SETC '0'
MEXIT
.*
.ADDR ANOP
AIF ('&RTN' EQ '' OR '&RTN' EQ '0').ZSC
AIF ('&RTN' EQ '*').STAR
&SCKWRTN SETC '&RTN'
MEXIT
.*
.STAR ANOP
AIF (&SCANCNT LE 0).STARERR
&SCKWRTN SETC '&SCANEND(&SCANCNT)'
MEXIT
.*
.STARERR ANOP
MNOTE 12,'SCKW * MUST BE IN RANGE OF SCAN *'
.*
.ZSC ANOP
&SCKWRTN SETC '0'
&SCKWAVS SETC 'SL2'
&SCKWAVC SETA 2
MEND
./ ADD LIST=ALL,NAME=SCKWTBL
MACRO
&L SCKWTBL &TYPE
GBLC &SCKWTBL(42)
LCLA &X
LCLC &LBL
.*
AIF ('&TYPE' EQ 'BEGIN').BEGIN
AIF ('&TYPE' EQ 'END').END
MNOTE 12,'"&TYPE" IS ILLEGAL'
&L SYSLBL TYPE=X
MEXIT
.*
.BEGIN ANOP
AIF ('&SCKWTBL(1)' EQ '').BEGOK
MNOTE 12,'MISSING SCKWTBL END'
SCKWTBL END
.BEGOK ANOP
&LBL SETC '&L'
.BEGLOOP ANOP
&X SETA &X+1
&LBL SCKWTBLP &X
&LBL SETC ''
AIF (&X LT 42).BEGLOOP
MEXIT
.*
.END ANOP
&L SYSLBL TYPE=X
AIF ('&SCKWTBL(1)' NE '').ENDOK
MNOTE 12,'NO MATCHING SCKWTBL BEGIN'
MEXIT
.ENDOK ANOP
.ENDLOOP ANOP
&X SETA &X+1
&SCKWTBL(&X) EQU 0
&SCKWTBL(&X) SETC ''
AIF (&X LT 42).ENDLOOP
MEND
./ ADD LIST=ALL,NAME=SCKWTBLP
MACRO
&L SCKWTBLP &X
GBLC &SCKWTBL(42)
&SCKWTBL(&X) SETC 'SCKW&SYSNDX'
&L DC AL4(&SCKWTBL(&X))
MEND
./ ADD LIST=ALL,NAME=SCLAST
MACRO
&L SCLAST &SCT=SCTSTART
&L LM VR0,VR1,SCTTLEN-SCTSTART+&SCT
MEND
./ ADD LIST=ALL,NAME=SCPOP
MACRO
&L SCPOP &SCT=SCTSTART
&L MZC SCTINIT-SCTSTART+&SCT,SCTINITL
SCPOPA 8
MMVC SCTLEN-SCTSTART+&SCT,0(STKR),8
MEND
./ ADD LIST=ALL,NAME=SCPOPA
MACRO
&L SCPOPA &S
&L CPOP ,&S
MEND
./ ADD LIST=ALL,NAME=SCPUSH
MACRO
&L SCPUSH &SCT=SCTSTART
&L MMVC 0(STKR),SCTLEN-SCTSTART+&SCT,8
SCPUSHA 8
MEND
./ ADD LIST=ALL,NAME=SCPUSHA
MACRO
&L SCPUSHA &S
&L CPUSH ,&S
MEND
./ ADD LIST=ALL,NAME=SCRTN
MACRO
&L SCRTN &PRT,&RTNR=YES,&SCT=SCTSTART
GBLC &SCANPRT(10)
GBLA &SCANCNT
LCLC &LBL
SYSKWT RTNR,&RTNR,(YES,NO),COND=NO,NULL=NO
.*
&LBL SETC '&L'
.*
AIF ('&PRT' EQ '').NPRT
AIF ('&PRT' NE '*').NSTAR
AIF (&SCANCNT GT 0).STAR
MNOTE 12,'SCRTN * MUST BE IN RANGE OF SCAN *'
AGO .NPRT
.*
.STAR ANOP
&LBL SYSLR VR1,&SCANPRT(&SCANCNT)
&LBL SETC ''
ST VR1,SCTSCKWS-SCTSTART+&SCT
AGO .NPRT
.*
.NSTAR ANOP
&LBL SYSLR VR1,&PRT
&LBL SETC ''
ST VR1,SCTSCKWS-SCTSTART+&SCT
.NPRT ANOP
.*
AIF ('&RTNR' NE 'YES').NRTNR
&LBL BR RTNR
MEXIT
.*
.NRTNR ANOP
&LBL B SCTRET-SCTSTART+&SCT
MEND
./ ADD LIST=ALL,NAME=SCSEMI
MACRO
&L SCSEMI &SCT=SCTSTART
&L L RTNR,SCTLEN-SCTSTART+&SCT
LTR RTNR,RTNR
BNP SCSC&SYSNDX
L RTNR,SCTLOC-SCTSTART+&SCT
CLI 0(RTNR),C';'
BNE SCSC&SYSNDX
LA RTNR,1(,RTNR)
ST RTNR,SCTLOC-SCTSTART+&SCT
L RTNR,SCTLEN-SCTSTART+&SCT
BCTR RTNR,0
ST RTNR,SCTLEN-SCTSTART+&SCT
SCSC&SYSNDX DS 0H
MEND
./ ADD LIST=ALL,NAME=SCT
MACRO
&L SCT
GBLA &LSCAN
&L SYSLBL TYPE=F
*
* NIH/COMMON - SCAN CONTROL TABLE
*
SCTSTART DS 0F
*
SCTINIT DS 0F START OF AREA TO INITIALIZE
*
SCTLEN DC F'0' LENGTH REMAINING
SCTLOC DC A(0) CURRENT LOCATION
SCTBLEN DC F'0' LENGTH FOR SCBACK
SCTBLOC DC A(0) LOCATION FOR SCBACK
SCTTLEN DC F'0' LENGTH OF LAST TOKEN
SCTTLOC DC A(0) LOCATION OF LAST TOKEN
*
SCTINITL EQU *-SCTINIT
*
SCTERROR DC A(0) LOCATION OF ERROR ROUTINE
SCTERRP DC A(0) PARAMETER FOR ERROR ROUTINE
SCTRTN DC A(0) SAVED RETURN ADDRESS
SCTSCKWS DC A(0) SAVED ADDRESS OF SCKW LIST
SCTTYPE DC F'0' SCAN TYPE/TABLE
SCTTOKEN DC CL&LSCAN.' ' TOKEN PADDED WITH BLANKS
*
SCTS370 DC 4F'0' 370 SIMULATION AREA
ORG SCTS370 OVERLAY WITH LINKAGE
*
SCTCALL DS 0F LINKAGE TO PROCESSING ROUTINE
CBASE RTNR GET BASE
SCTBASE1 L RTNR,SCTENTRY-SCTBASE1(,RTNR) ENTRY ADDRESS
CBALR RTNR,RTNR CALL PROCESSING ROUTINE
SCTRET CBASE VRF GET BASE ON RETURN
SCTBASE2 L RTNR,SCTREENT-SCTBASE2(,VRF) ENTRY ADDR FOR SCANNER
BR RTNR GO TO SCANNER
SCTREENT DC A(0) SCANNER ADDRESS
SCTCALLL EQU *-SCTCALL LENGTH OF LINKAGE
SCTENTRY DC A(0) ENTRY POINT OF PROCESSING RTN
*
DS 0F
SCTSIZE EQU *-SCTSTART
*
* ENTRY CODES FOR ERROR ROUTINE
*
SCTCUBQ EQU 00 UNBALANCED QUOTES
SCTCUBP EQU 04 UNBALANCED PARENTHESES
SCTCIXM EQU 08 INTEGER EXCEEDS MAXIMUM
SCTCOXM EQU 12 ORDINAL EXCEEDS MAXIMUM
SCTCLNXM EQU 16 LINE NUMBER EXCEEDS MAXIMUM
SCTCZNG EQU 20 "POSITIVE" VALUE WAS ZERO
SCTCLXM EQU 24 TOKEN LENGTH EXCEEDS MAXIMUM
SCTCUE EQU 28 TOKEN MISSING (UNEXPECTED END)
SCTCZBV EQU 32 ZERO BRANCH VALUE (A OR V)
SCTCSCD EQU 36 SOMETHING FOUND BY SCDONE
SCTCBXN EQU 40 BAD HEX NUMBER
SCTCBXS EQU 44 BAD HEX STRING
SCTCNQ EQU 48 REQUIRED QUOTES MISSING
SCTCNP EQU 52 REQUIRES PARENTHESES MISSING
SCTCBINT EQU 56 BAD INTEGER
SCTCBORD EQU 60 BAD ORDINAL
SCTCBLN EQU 64 BAD LINE NUMBER
*
SCTCMAX EQU SCTCBLN MAX CODE
MEND
./ ADD LIST=ALL,NAME=SCTELL
MACRO
&L SCTELL &SCT=SCTSTART
&L LM VR0,VR1,SCTLEN-SCTSTART+&SCT
MEND
./ ADD LIST=ALL,NAME=SCTYPE
MACRO
&L SCTYPE &NEW=,&OLD=,&SCT=SCTSTART
&L SYSLST SCTTYPE-SCTSTART+&SCT,NEW=&NEW,OLD=&OLD,LOAD=LOADB,STORE=STC
MEND
./ ADD LIST=ALL,NAME=SF
MACRO
&L SF
LCLA &X,&Y,&Z,&I
LCLC &F(16)
.*
AIF (N'&SYSLIST LT 1).NONE
.LOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
.*
AIF (&Z GE 16).MANY
.*
&F(&Z+1) SETC '+L'''(1,3)
&F(&Z+2) SETC '&SYSLIST(&X)'
&I SETA 0
.SCAN ANOP
&I SETA &I+1
AIF (&I GT K'&F(&Z+2)).SCANOK
AIF ('&F(&Z+2)'(&I,1) GE 'A').SCAN
AIF (&I LE 1).SCANOK
&F(&Z+2) SETC '&F(&Z+2)'(1,&I-1)
.SCANOK ANOP
.*
&Y SETA &Z+2
.CHECK ANOP
&Y SETA &Y-2
AIF (&Y LT 2).UNIQUE
AIF ('&F(&Z+2)' NE '&F(&Y)').CHECK
MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
&F(&Z+1) SETC ''
&F(&Z+2) SETC ''
AGO .LOOP
.*
.UNIQUE ANOP
AIF (&X LE 1).NTEST
OI 0,(&F(&Z+2)-&F(2))*256
ORG *-4
.NTEST ANOP
&Z SETA &Z+2
AGO .LOOP
.*
.DONE ANOP
&F(1) SETC 'L'''(1,2)
&L OI &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
)&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
MEXIT
.*
.NONE ANOP
MNOTE 12,'NO FLAGS SPECIFIED'
CLI *+1,0
MEXIT
.*
.MANY ANOP
MNOTE 12,'TOO MANY FLAGS SPECIFIED'
AGO .DONE
MEND
./ ADD LIST=ALL,NAME=SI
MACRO
&L SI &R,&V
LCLA &X
AIF ('&V' EQ '2').BCTR2
AIF ('&V' EQ '1').BCTR1
.LOOP ANOP
&X SETA &X+1
AIF (&X GT K'&V).F
AIF ('&V'(&X,1) GE '0').LOOP
AIF (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
&L SL &R,=A(&V)
MEXIT
.F ANOP
&L SL &R,=F'&V'
MEXIT
.BCTR2 ANOP
&L BCTR &R,0
BCTR &R,0
MEXIT
.BCTR1 ANOP
&L BCTR &R,0
MEND
./ ADD LIST=ALL,NAME=SIM370
MACRO
&L SIM370 &WORDS,&CLEAR=
GBLC &SIM370
SYSKWT CLEAR,&CLEAR,(YES,NO),COND=NO
AIF ('&CLEAR' EQ 'YES').CLEAR
&L SYSLBL
&SIM370 SETC '&WORDS'
AIF ('&WORDS' NE '').END
&SIM370 SETC '*NO*370*'
MEXIT
.*
.CLEAR ANOP
&L MZC &WORDS,16
&SIM370 SETC '&WORDS'
.END MEND
./ ADD LIST=ALL,NAME=STOREB
MACRO
&L STOREB &R,&A
&L STC &R,&A
MEND
./ ADD LIST=ALL,NAME=STOREF
MACRO
&L STOREF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP ST,&R,&A
MEXIT
.S360 ANOP
&L ST &R,&SIM370
SYSXXCB MVC,&A,&SIM370,4
MEND
./ ADD LIST=ALL,NAME=STOREH
MACRO
&L STOREH &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP STH,&R,&A
MEXIT
.S360 ANOP
&L ST &R,&SIM370
MMVC &A,2+&SIM370,2
MEND
./ ADD LIST=ALL,NAME=STORELF
MACRO
&L STORELF &R,&A
&L STOREF &R,&A
MEND
./ ADD LIST=ALL,NAME=STORELH
MACRO
&L STORELH &R,&A
&L STOREH &R,&A
MEND
./ ADD LIST=ALL,NAME=STOREP
MACRO
&L STOREP &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L STCM &R,7,&A
MEXIT
.S360 ANOP
&L ST &R,&SIM370
MMVC &A,1+&SIM370,3
MEND
./ ADD LIST=ALL,NAME=STRIP
MACRO
&L STRIP &S,&N,&W,&TYPE=RIGHT,&ZERO=YES,&NULL=YES,&LABEL=,&FILL=0
&L DEBLANK &S,&N,&W,TYPE=&TYPE,ZERO=&ZERO,NULL=&NULL, *
LABEL=&LABEL,FILL=&FILL
MEND
./ ADD LIST=ALL,NAME=SUBB
MACRO
&L SUBB &R,&A
GBLC &SIM370
&L MMVC 4*3+3+&SIM370,&A,1
SL &R,4*3+&SIM370
MEND
./ ADD LIST=ALL,NAME=SUBF
MACRO
&L SUBF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP S,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
S &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=SUBH
MACRO
&L SUBH &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP SH,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,2
SH &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=SUBLF
MACRO
&L SUBLF &R,&A
GBLC &CPU,&SIM370
AIF ('&CPU' EQ '360').S360
&L UAOP SL,&R,&A
MEXIT
.S360 ANOP
&L MMVC &SIM370,&A,4
SL &R,&SIM370
MEND
./ ADD LIST=ALL,NAME=SUBLH
MACRO
&L SUBLH &R,&A
GBLC &SIM370
&L MMVC 4*2+2+&SIM370,&A,2
SL &R,4*2+&SIM370
MEND
./ ADD LIST=ALL,NAME=SUBP
MACRO
&L SUBP &R,&A
GBLC &SIM370
&L MMVC 4*1+1+&SIM370,&A,3
SL &R,4*1+&SIM370
MEND
./ ADD LIST=ALL,NAME=SUBTITLE
MACRO
&L SUBTITLE &T
&L SYSLBL
TITLE &T
MEND
./ ADD LIST=ALL,NAME=SYSBIT
MACRO
&L SYSBIT &A,&B,&SET=,&RESET=
SYSKWT SET,&SET,(YES,NO,ONLY),COND=NO
SYSKWT RESET,&RESET,(YES,NO,ONLY),COND=NO
AIF ('&SET' EQ '' OR '&RESET' EQ '').OK
AIF ('&SET' EQ 'NO' OR '&RESET' EQ 'NO').OK
MNOTE 12,'CANNOT SPECIFY BOTH SET AND RESET'
.OK ANOP
AIF ('&RESET' NE '' AND '&RESET' NE 'NO').RESET
.*
.* SET
.*
AIF ('&SET' EQ 'ONLY').SONLY
&L TM &A,&B
AIF ('&SET' NE 'YES').END
BO *+12
OI &A,&B
CLI *+1,0
MEXIT
.SONLY ANOP
&L OI &A,&B
MEXIT
.*
.* RESET
.*
.RESET ANOP
AIF ('&RESET' EQ 'ONLY').RONLY
&L TM &A,&B
BZ *+12
NI &A,255-(&B)
TM *+1,255
MEXIT
.RONLY ANOP
&L NI &A,255-(&B)
.END MEND
./ ADD LIST=ALL,NAME=SYSCMP
MACRO
&L SYSCMP &A,&R,&B,&MSG=
&L SYSLBL
AIF ('&MSG' EQ '').STD
MNOTE *,&MSG
AGO .COM
.STD ANOP
MNOTE *,'ERROR BELOW IF &A NOT &R &B'
.COM ANOP
.*
.* BRANCH ON RELATION
.*
AIF ('&R' EQ 'LT').LT
AIF ('&R' EQ 'NGE').LT
AIF ('&R' EQ 'LE').LE
AIF ('&R' EQ 'NGT').LE
AIF ('&R' EQ 'EQ').EQ
AIF ('&R' EQ 'GE').GE
AIF ('&R' EQ 'NLT').GE
AIF ('&R' EQ 'GT').GT
AIF ('&R' EQ 'NLE').GT
AIF ('&R' EQ 'NEQ' OR '&R' EQ 'NE').NEQ
MNOTE 12,'"&R" IS AN ILLEGAL RELATION'
MEXIT
.*
.LT DS 0CL(&B-(&A))
MEXIT
.*
.LE DS 0CL(&B+1-(&A))
MEXIT
.*
.EQ DS 0CL(&B+1-(&A)),0CL(&A+1-(&B))
MEXIT
.*
.GE DS 0CL(&A+1-(&B))
MEXIT
.*
.GT DS 0CL(&A-(&B))
MEXIT
.*
.NEQ DS 0CL(2-((&A)/(&B))/((&A)/(&B))-((&B)/(&A))/((&B)/(&A)))
MEND
./ ADD LIST=ALL,NAME=SYSKWT
MACRO
&L SYSKWT &NAME,&KWS,&LEGAL,&COND=,&NULL=
LCLA &X
AIF ('&KWS' EQ '' AND '&NULL' NE '').ERROR
AIF ('&KWS' EQ '').END
AIF ('&COND' EQ '').COND
AIF ('&COND' EQ 'YES').COND
AIF ('&COND'(1,1) EQ '(').CONDL
AIF ('&KWS'(1,1) EQ '(').ERROR
AGO .COND
.CONDL AIF ('&KWS'(1,1) NE '(').COND
&X SETA 1
.LOOPL AIF (&X GT N'&COND).ERROR
AIF ('&KWS(1)' EQ '&COND(&X)').COND
&X SETA &X+1
AGO .LOOPL
.COND ANOP
&X SETA 1
.LOOP AIF (&X GT N'&LEGAL).ERROR
AIF ('&KWS(1)' EQ '&LEGAL(&X)').END
&X SETA &X+1
AGO .LOOP
.ERROR AIF ('&NAME' EQ '').POSERR
MNOTE 12,'"&NAME=&KWS" IS ILLEGAL'
MEXIT
.POSERR MNOTE 12,'"&KWS" IS ILLEGAL'
.END MEND
./ ADD LIST=ALL,NAME=SYSLBL
MACRO
&L SYSLBL &TYPE=H
AIF ('&L' EQ '').END
&L DS 0&TYPE
.END MEND
./ ADD LIST=ALL,NAME=SYSLR
MACRO
&L SYSLR &R,&P,&TYPE=,&SELECT=,&NULL=0,&ERR=,&OP=LA,<R=,&STRLEN=
LCLA &X,&PT,&KC(32)
LCLB &LCR
LCLC &C(32),&LABEL,&OPC
.*
.* CHECK FOR LITERAL STRING
.*
AIF ('&P' EQ '').NSTRING
AIF ('&P'(1,1) NE '''' OR '&STRLEN' EQ '').NSTRING
&L SYSLR &R,=CL&STRLEN&P,TYPE=&TYPE,SELECT=&SELECT,NULL=&NULL, *
ERR=&ERR,OP=&OP,LTR=<R
MEXIT
.*
.NSTRING ANOP
.*
.* CHECK FOR COMPLEMENT CONDITIONS
.*
AIF ('&TYPE' EQ '').GO
&LCR SETB 1
AIF ('&SELECT' EQ '').GO
&X SETA 1
.LOUP AIF (&X GT N'&SELECT).LOUPEND
AIF ('&TYPE(1)' EQ '&SELECT(&X)').GO
&X SETA &X+1
AGO .LOUP
.LOUPEND ANOP
&LCR SETB 0
.GO ANOP
.*
.* CHECK FOR AND HANDLE OMITTED OPERAND
.*
AIF ('&P' NE '').NBL
AIF ('&ERR' EQ '').NERR
MNOTE 12,&ERR
.NERR AIF ('&NULL' EQ '').LBL
AIF ('&NULL' EQ '0').SR
&L SYSLR &R,&NULL,NULL=,OP=&OP,TYPE=&TYPE,SELECT=&SELECT,LTR=<R
MEXIT
.LBL ANOP
AIF ('<R' NE '').LBLLTR
&L SYSLBL
MEXIT
.LBLLTR ANOP
&L LTR &R,&R
MEXIT
.*
.* CHECK FOR REGISTER OR ZERO
.*
.NBL AIF ('&P'(1,1) EQ '(').REG
AIF ('&P' EQ '0').SR
.*
.* ISOLATE OPCODE AND PROCESS
.*
&LABEL SETC '&L'
&OPC SETC '&OP'
AIF (K'&P LE 2).EXPR
AIF ('&P'(1,2) EQ 'L:').L
AIF (K'&P LE 3).EXPR
AIF ('&P'(1,3) EQ 'LA:').LX
AIF ('&P'(1,3) EQ 'LH:').LX
AIF ('&P'(1,3) EQ 'IC:').IC
AIF (K'&P LE 6).EXPR
AIF ('&P'(1,6) EQ 'LOADB:').LOADX
AIF ('&P'(1,6) EQ 'LOADH:').LOADX
AIF ('&P'(1,6) EQ 'LOADP:').LOADX
AIF ('&P'(1,6) EQ 'LOADF:').LOADX
AIF (K'&P LE 7).EXPR
AIF ('&P'(1,7) EQ 'LOADLH:').LOADXX
AIF ('&P'(1,7) EQ 'LOADLF:').LOADXX
AGO .EXPR
.LOADX ANOP
&PT SETA 6
AGO .DO
.LOADXX ANOP
&PT SETA 7
AGO .DO
.IC ANOP
&L SLR &R,&R
&LABEL SETC ''
.LX ANOP
&PT SETA 3
AGO .DO
.L ANOP
&PT SETA 2
.DO ANOP
&OPC SETC '&P'(1,&PT-1)
.EXPR ANOP
&X SETA 1
.LOOP AIF (K'&P-&PT LE &X*8).BIT
&KC(&X) SETA 8
&C(&X) SETC '&P'(&PT+(&X-1)*8+1,8)
&X SETA &X+1
AGO .LOOP
.BIT ANOP
&KC(&X) SETA K'&P-&PT-(&X-1)*8
&C(&X) SETC '&P'(&PT+(&X-1)*8+1,&KC(&X))
AIF ('&C(1)'(1,1) NE ':').NLIT
&C(1) SETC '='.'&C(1)'(2,&KC(1)-1)
.NLIT ANOP
AIF ('&OPC' EQ 'LOADB').LOADB
AIF ('&OPC' EQ 'LOADH').LOADH
AIF ('&OPC' EQ 'LOADLH').LOADLH
AIF ('&OPC' EQ 'LOADP').LOADP
AIF ('&OPC' EQ 'LOADF').LOADF
AIF ('&OPC' EQ 'LOADLF').LOADLF
AIF ('&OPC' EQ 'LITA').LITA
AIF ('&OPC' EQ 'LITF').LITF
AIF ('&OPC' EQ 'LITH').LITH
AIF ('&OPC' EQ 'LITY').LITY
&LABEL SYSLROP &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32),OP=&OPC
.COM AIF (NOT &LCR).COMLTR
SYSTANDB &TYPE,2,LCR,&R,&R
AIF ('&TYPE'(1,1) NE '(').END
.COMLTR ANOP
AIF ('<R' EQ '').END
LTR &R,&R
MEXIT
.LOADB ANOP
&LABEL LOADB &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32)
AGO .COM
.LOADH ANOP
&LABEL LOADH &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32)
AGO .COM
.LOADLH ANOP
&LABEL LOADLH &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32)
AGO .COM
.LOADP ANOP
&LABEL LOADP &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32)
AGO .COM
.LOADF ANOP
&LABEL LOADF &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32)
AGO .COM
.LOADLF ANOP
&LABEL LOADLF &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
)&C(30)&C(31)&C(32)
AGO .COM
.LITA ANOP
&LABEL L &R,=A(&P)
AGO .COM
.LITF ANOP
&LABEL L &R,=F'&P'
AGO .COM
.LITH ANOP
&LABEL LH &R,=H'&P'
AGO .COM
.LITY ANOP
&LABEL LH &R,=AL2(&P)
AGO .COM
.*
.* HANDLE ZERO
.*
.SR ANOP
&L SLR &R,&R
MEXIT
.*
.* HANDLE REGISTER
.*
.REG AIF (&LCR).LCR
AIF ('(&R)' EQ '&P').LBL
AIF ('<R' NE '').LTR
&L LR &R,&P
MEXIT
.LTR ANOP
&L LTR &R,&P
MEXIT
.LCR ANOP
AIF ('&TYPE'(1,1) EQ '(').LCRX
&L LCR &R,&P
MEXIT
.LCRX ANOP
&L LR &R,&P
SYSTANDB &TYPE,2,LCR,&R,&R
AIF ('<R' EQ '').END
LTR &R,&R
.END MEND
./ ADD LIST=ALL,NAME=SYSLROP
MACRO
&L SYSLROP &R,&A,&OP=
&L &OP &R,&A
MEND
./ ADD LIST=ALL,NAME=SYSLST
MACRO
&L SYSLST &LOC,&NEW=,&OLD=,&LOAD=L,&STORE=ST,&OP=LA,®=RTNR
AIF ('&NEW' EQ '').NNEW
AIF ('&OLD' EQ '').NEWNOLD
AIF ('&NEW'(1,1) EQ '(' AND '&NEW' NE '(&OLD)').RNEWOLD
AIF (('&STORE' NE 'STC' AND '&STORE' NE 'STOREB') *
OR '&OP' NE 'LA').NMVI
AIF ('&NEW'(1,1) EQ '(').NMVI
AIF (K'&NEW LE 2).MVI
AIF ('&NEW'(1,2) EQ 'L:').NMVI
AIF (K'&NEW LE 3).MVI
AIF ('&NEW'(1,3) EQ 'LA:').NMVI
AIF ('&NEW'(1,3) EQ 'LH:').NMVI
AIF ('&NEW'(1,3) EQ 'IC:').NMVI
AIF (K'&NEW LE 6).MVI
AIF ('&NEW'(1,6) EQ 'LOADB:').NMVI
AIF ('&NEW'(1,6) EQ 'LOADH:').NMVI
AIF ('&NEW'(1,6) EQ 'LOADP:').NMVI
AIF ('&NEW'(1,6) EQ 'LOADF:').NMVI
AIF (K'&NEW LE 7).MVI
AIF ('&NEW'(1,7) EQ 'LOADLH:').NMVI
AIF ('&NEW'(1,7) EQ 'LOADLF:').NMVI
AGO .MVI
.NMVI ANOP
&L SYSLR ®,&NEW,OP=&OP
SYSLR &OLD,&LOC,OP=&LOAD
SYSLSTS &STORE,®,&LOC
MEXIT
.*
.MVI ANOP
&L SYSLR &OLD,&LOC,OP=&LOAD
MVI &LOC,&NEW
MEXIT
.*
.RNEWOLD ANOP
&L SYSLR &OLD,&LOC,OP=&LOAD
SYSLSTS &STORE,&NEW,&LOC
MEXIT
.*
.NEWNOLD ANOP
AIF ('&NEW'(1,1) EQ '(').RNEWNOL
AIF (('&STORE' NE 'STC' AND '&STORE' NE 'STOREB') *
OR '&OP' NE 'LA').NMVINOL
AIF ('&NEW'(1,1) EQ '(').NMVINOL
AIF (K'&NEW LE 2).MVINOLD
AIF ('&NEW'(1,2) EQ 'L:').NMVINOL
AIF (K'&NEW LE 3).MVINOLD
AIF ('&NEW'(1,3) EQ 'LA:').NMVINOL
AIF ('&NEW'(1,3) EQ 'LH:').NMVINOL
AIF ('&NEW'(1,3) EQ 'IC:').NMVINOL
AIF (K'&NEW LE 6).MVINOLD
AIF ('&NEW'(1,6) EQ 'LOADB:').NMVINOL
AIF ('&NEW'(1,6) EQ 'LOADH:').NMVINOL
AIF ('&NEW'(1,6) EQ 'LOADP:').NMVINOL
AIF ('&NEW'(1,6) EQ 'LOADF:').NMVINOL
AIF (K'&NEW LE 7).MVINOLD
AIF ('&NEW'(1,7) EQ 'LOADLH:').NMVINOL
AIF ('&NEW'(1,7) EQ 'LOADLF:').NMVINOL
AGO .MVINOLD
.NMVINOL ANOP
&L SYSLR ®,&NEW,OP=&OP
SYSLSTS &STORE,®,&LOC
MEXIT
.*
.MVINOLD ANOP
&L MVI &LOC,&NEW
MEXIT
.*
.RNEWNOL ANOP
&L SYSLSTS &STORE,&NEW,&LOC
MEXIT
.*
.NNEW ANOP
AIF ('&OLD' EQ '').ERROR
&L SYSLR &OLD,&LOC,OP=&LOAD
MEXIT
.*
.ERROR ANOP
MNOTE 12,'EITHER NEW OR OLD (OR BOTH) MUST BE SPECIFIED'
MEND
./ ADD LIST=ALL,NAME=SYSLSTS
ALP;
MACRO &&L: SYSLSTS &&OP,&&R,&&A;
ASM CASE '&OP';
'STOREB': <&&L: STOREB &&R,&&A>;
'STOREH','STORELH': <&&L: STOREH &&R,&&A>;
'STOREP': <&&L: STOREP &&R,&&A>;
'STOREF','STORELF': <&&L: STOREF &&R,&&A>;
ENDCASE
ELSE BEGIN
BAL;
&L &OP &R,&A
ALP;
END;
MEND;
BAL;
./ ADD LIST=ALL,NAME=SYSLV
MACRO
&L SYSLV
LCLA &X,&Y,&V
LCLB &SW(97)
.*
.* COMPUTE INITIAL VALUE FOR REGISTER
.*
&X SETA 2-3
.VLOOP ANOP
&X SETA &X+3
AIF (&X GT N'&SYSLIST).VDONE
AIF ('&SYSLIST(&X+1)' EQ '').VLOOP
AIF ('&SYSLIST(&X+2)' EQ '').VADD
&Y SETA 1
.SLOOP ANOP
AIF ('&SYSLIST(&X+1,1)' EQ '&SYSLIST(&X+2,&Y)').VADD
&Y SETA &Y+1
AIF (&Y LE N'&SYSLIST(&X+2)).SLOOP
AGO .VLOOP
.VADD ANOP
&SW(&X) SETB 1
AIF ('&SYSLIST(&X+1)'(1,1) EQ '(').VLOOP
&V SETA &V+&SYSLIST(&X+0)
AGO .VLOOP
.VDONE ANOP
AIF (&V LT 4096).LA
&L L &SYSLIST(1),=F'&V'
AGO .DOTEST
.*
.LA ANOP
&L SYSLR &SYSLIST(1),&V
.*
.* SEARCH FOR TEST REQUESTS
.*
.DOTEST ANOP
&X SETA 2-3
.TLOOP ANOP
&X SETA &X+3
AIF (&X GT N'&SYSLIST).TDONE
AIF (NOT &SW(&X)).TLOOP
AIF ('&SYSLIST(&X+1)'(1,1) NE '(').TLOOP
AIF ('&SYSLIST(1)' EQ 'VR0').VR0
SYSTANDB &SYSLIST(&X+1),4,LA,&SYSLIST(1),&SYSLIST(&X)(,&SYSLIST(1))
AGO .TLOOP
.*
.VR0 SYSTANDB &SYSLIST(&X+1),4,A,VR0,=F'&SYSLIST(&X)'
AGO .TLOOP
.*
.TDONE ANOP
MEND
./ ADD LIST=ALL,NAME=SYSPRED
ALP;
MACRO &&L: SYSPRED &&LBL,&&IF=,&&BRANCH=TRUE;
LCLA &&X;
LCLC &&LBLEND;
SYSKWT BRANCH,&&BRANCH,(TRUE,FALSE),COND=NO,NULL=NO;
&&L: SYSLBL;
ASM FOR &&X FROM 1 BY 5 TO N'&&IF DO BEGIN
ASM CASE '&IF(&X)'; % GENERATE INSTRUCTION
'TF': BEGIN
ASM IF ('&IF(&X+2)' EQ '')
THEN TF &&IF(&&X+1)
ELSE TF &&IF(&&X+1),&&IF(&&X+2);
END;
'': BEGIN
ASM IF ('&IF(&X+1)&IF(&X+2)' NE '')
THEN MNOTE 12,'NULL OPCODE MUST HAVE NULL OPERANDS';
END;
ENDCASE
ELSE BEGIN
BAL;
&IF(&X) &IF(&X+1),&IF(&X+2)
ALP;
END;
ASM CASE '&BRANCH';
'TRUE','': BEGIN
ASM CASE '&IF(&X+4)';
'OR': BEGIN
SYSPREDB &&IF(&&X+3),&&LBL; % BR IF TRUE
END;
'': BEGIN
ASM IF (&&X+5 LT N'&&IF)
THEN MNOTE 12,'"" IS AN ILLEGAL OPERATOR';
SYSPREDB &&IF(&&X+3),&&LBL; % BR IF TRUE
END;
'AND': BEGIN
&&LBLEND: SETC 'PRED&@';
SYSPREDB N&&IF(&&X+3),&&LBLEND; % BR IF FALSE
END;
ENDCASE
ELSE BEGIN
MNOTE 12,'"&IF(&X+4)" IS AN ILLEGAL OPERATOR';
SYSPREDB &&IF(&&X+3),&&LBL; % BR IF TRUE
END;
END;
'FALSE': BEGIN
ASM CASE '&IF(&X+4)';
'OR': BEGIN
&&LBLEND: SETC 'PRED&@';
SYSPREDB &&IF(&&X+3),&&LBLEND;
END;
'AND': BEGIN
SYSPREDB N&&IF(&&X+3),&&LBL;
END;
'': BEGIN
ASM IF (&&X+5 LT N'&&IF)
THEN MNOTE 12,'"" IS AN ILLEGAL OPERATOR';
SYSPREDB N&&IF(&&X+3),&&LBL;
END;
ENDCASE
ELSE BEGIN
MNOTE 12,'"&IF(&X+4)" IS AN ILLEGAL OPERATOR';
SYSPREDB N&&IF(&&X+3),&&LBL; % BR IF FALSE
END;
END;
ENDCASE ELSE;
END;
&&LBLEND: SYSLBL;
MEND;
BAL;
./ ADD LIST=ALL,NAME=SYSPREDB
ALP;
MACRO &&L: SYSPREDB &&CC,&&LBL;
LCLC &&C;
&&C: SETC '&CC';
ASM IF (K'&&CC GE 2) THEN ASM IF ('&CC'(1,2) EQ 'NN')
THEN <&&C: SETC '&CC'(3,K'&&CC-2)>;
BAL;
&L B&C &LBL
ALP;
MEND;
BAL;
./ ADD LIST=ALL,NAME=SYSQS
MACRO
&L SYSQS &AR,&LR,&AP,&LP,&NULL=,&TYPEA=,&TYPEL=,&SELECTA=,&SELECTL=
LCLA &X,&N
LCLC &C
AIF ('&AP' EQ '').NSTR
AIF ('&AP'(1,1) EQ '''').STR
.NSTR ANOP
AIF ('&AP&LP' EQ '').NULL
&L SYSLR &AR,&AP,TYPE=&TYPEA,SELECT=&SELECTA, *
ERR='STRING LOCATION MISSING'
SYSLR &LR,&LP,TYPE=&TYPEL,SELECT=&SELECTL, *
ERR='STRING LENGTH MISSING'
MEXIT
.*
.* PROCESS OMITTED OPERANDS
.*
.NULL ANOP
AIF ('&NULL(1)&NULL(2)' EQ '').NULLNUL
&L SYSQS &AR,&LR,&NULL(1),&NULL(2),TYPEA=&TYPEA,TYPEL=&TYPEL, *
SELECTA=&SELECTA,SELECTL=&SELECTL
MEXIT
.*
.NULLNUL ANOP
&L SYSQS &AR,&LR,0,0
MNOTE 12,'STRING MISSING'
MEXIT
.*
.* PROCESS QUOTED STRING
.*
.STR AIF ('&LP' NE '').LG
&L SYSLR &AR,=C&AP,TYPE=&TYPEA,SELECT=&SELECTA
&X SETA 1
&C SETC '&&'
.LOOP ANOP
&X SETA &X+1
AIF (&X GE K'&AP).EL
&N SETA &N+1
AIF ('&AP'(&X,1) NE '''' AND '&AP'(&X,1) NE '&C'(1,1)).LOOP
&X SETA &X+1
AGO .LOOP
.EL SYSLR &LR,&N,TYPE=&TYPEL,SELECT=&SELECTL
MEXIT
.*
.* PROCESS STRING WITH LENGTH GIVEN
.*
.LG ANOP
&L SYSLR &AR,=CL(&LP)&AP,TYPE=&TYPEA,SELECT=&SELECTA
SYSLR &LR,&LP,TYPE=&TYPEL,SELECT=&SELECTL
.END MEND
./ ADD LIST=ALL,NAME=SYSRNG
MACRO
SYSRNG &NAME,&VAL,&REL,&LIM
LCLA &X
SYSKWT SYSRNG-RELATION,&REL, *
(LT,NLT,LE,NLE,EQ,NE,NEQ,GE,NGE,GT,NGT,MULT), *
NULL=NO,COND=NO
.*
&X SETA 0
.TEST ANOP
&X SETA &X+1
AIF (&X GT K'&VAL).NUM
AIF ('&VAL'(&X,1) GE '0' AND '&VAL'(&X,1) LE '9').TEST
MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE ALL NUMERIC'
MEXIT
.*
.NUM ANOP
.*
&X SETA 0
.LTEST ANOP
&X SETA &X+1
AIF (&X GT K'&LIM).LNUM
AIF ('&LIM'(&X,1) GE '0' AND '&LIM'(&X,1) LE '9').LTEST
MNOTE 12,'"SYSRNG-LIMIT=&LIM" IS ILLEGAL, MUST BE ALL NUMERIC'
AGO .OK
.*
.LNUM ANOP
.*
AIF ('&REL' EQ 'LT' AND &VAL LT &LIM).OK
AIF ('&REL' EQ 'LE' AND &VAL LE &LIM).OK
AIF ('&REL' EQ 'EQ' AND &VAL EQ &LIM).OK
AIF ('&REL' EQ 'GE' AND &VAL GE &LIM).OK
AIF ('&REL' EQ 'GT' AND &VAL GT &LIM).OK
AIF ('&REL' EQ 'NLT' AND &VAL GE &LIM).OK
AIF ('&REL' EQ 'NLE' AND &VAL GT &LIM).OK
AIF ('&REL' EQ 'NEQ' AND &VAL NE &LIM).OK
AIF ('&REL' EQ 'NE' AND &VAL NE &LIM).OK
AIF ('&REL' EQ 'NGE' AND &VAL LT &LIM).OK
AIF ('&REL' EQ 'NGT' AND &VAL LE &LIM).OK
AIF ('&REL' EQ 'MULT').MULT
MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE &REL &LIM'
.*
.OK ANOP
&X SETA 5
.LOOP ANOP
AIF (&X GT N'&SYSLIST).END
SYSRNG &NAME,&VAL,&SYSLIST(&X),&SYSLIST(&X+1)
&X SETA &X+2
AGO .LOOP
.*
.MULT ANOP
AIF (&VAL EQ &VAL/&LIM*&LIM).OK
MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE A MULTIPLE OF &LIM'
AGO .OK
.END MEND
./ ADD LIST=ALL,NAME=SYSTANDB
MACRO
&L SYSTANDB &T,&C,&OP,&A,&B,&BC=N
LCLC &CC
LCLA &K
AIF ('&T' EQ '').END
AIF ('&T'(1,1) NE '(').OP
AIF ('&T(2)' EQ 'LT').LT
AIF ('&T(2)' EQ 'TF').TF
AIF ('&T(4)' EQ '').TEST1
&L &T(2) &T(3),&T(4)
AGO .DOB
.*
.TEST1 ANOP
&L &T(2) &T(3)
AGO .DOB
.*
.LT ANOP
&L LT &T(3),&T(4)
AGO .DOB
.*
.TF ANOP
AIF ('&T(4)' EQ '').TF1
&L TF &T(3),&T(4)
AGO .DOB
.*
.TF1 ANOP
&L TF &T(3)
.*
.DOB ANOP
&CC SETC '&BC.NZ'
&K SETA K'&BC+2
AIF ('&T(5)' EQ '').TCC
&CC SETC '&BC&T(5)'
&K SETA K'&BC+K'&T(5)
.TCC ANOP
AIF (&K LE 2).DCC
AIF ('&CC'(1,2) NE 'NN').DCC
&CC SETC '&CC'(3,&K-2)
.DCC ANOP
AIF ('&CC' EQ 'LE').BLE
AIF ('&CC' EQ 'EH').BEH
AIF ('&CC' EQ 'LH').BLH
AIF ('&CC' EQ 'NLE').BNLE
AIF ('&CC' EQ 'NEH').BNEH
AIF ('&CC' EQ 'NLH').BNLH
AIF ('&CC' EQ 'MZ').BMZ
AIF ('&CC' EQ 'ZP').BZP
AIF ('&CC' EQ 'MP').BMP
AIF ('&CC' EQ 'NMZ').BNMZ
AIF ('&CC' EQ 'NZP').BNZP
AIF ('&CC' EQ 'NMP').BNMP
B&CC *+4+&C
.BOP &OP &A,&B
MEXIT
.*
.BLE BLE *+4+&C
AGO .BOP
.*
.BEH BEH *+4+&C
AGO .BOP
.*
.BLH BLH *+4+&C
AGO .BOP
.*
.BNLE BNLE *+4+&C
AGO .BOP
.*
.BNEH BNEH *+4+&C
AGO .BOP
.*
.BNLH BNLH *+4+&C
AGO .BOP
.*
.BMZ BMZ *+4+&C
AGO .BOP
.*
.BZP BZP *+4+&C
AGO .BOP
.*
.BMP BMP *+4+&C
AGO .BOP
.*
.BNMZ BNMZ *+4+&C
AGO .BOP
.*
.BNZP BNZP *+4+&C
AGO .BOP
.*
.BNMP BNMP *+4+&C
AGO .BOP
.*
.OP ANOP
&L &OP &A,&B
.END MEND
./ ADD LIST=ALL,NAME=SYSXXC
MACRO
&L SYSXXC &OP,&A,&B,&C,&D1=0,&D2=0,&N=,&BC=
LCLC &LBL,&BCLBL,&LQ
LCLA &M,&X,&Y
&LBL SETC '&L'
AIF ('&N' NE '' AND '&N' NE '*').N
.*
.* NO. OF INSTRUCTIONS NOT SPECIFIED
.*
AIF ('&C' NE '').CHECK
AIF (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND *
T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND *
T'&A NE '$').OKLEN
MNOTE *,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE T*
O MACROS'
&LQ SETC 'L'''
&L SYSXXC &OP,&A,&B,&LQ&A,D1=&D1,D2=&D2,N=&N,BC=&BC
MEXIT
.*
.OKLEN ANOP
&M SETA L'&A
&L SYSXXC &OP,&A,&B,&M,D1=&D1,D2=&D2,N=&N,BC=&BC
MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&M)'
MEXIT
.*
.CHECK ANOP
&Y SETA &Y+1
AIF (&Y GT K'&C).OK
AIF ('&C'(&Y,1) LT '0').ONE
AGO .CHECK
.OK ANOP
.*
AIF (&C LE 256).ONE
.NEXT ANOP
&LBL SYSXXCA &OP,&A,&B,256,D1=&D1+&X,D2=&D2+&X
&LBL SETC ''
AIF ('&BC(1)' EQ '').NBC
AIF ('&BCLBL' NE '').BCA
&BCLBL SETC '&BC(2)'
AIF ('&BCLBL' NE '').BCA
&BCLBL SETC '&OP&SYSNDX'
.BCA &BC(1) &BCLBL
.NBC ANOP
&X SETA &X+256
&Y SETA &C-&X
AIF (&Y GT 256).NEXT
SYSXXCA &OP,&A,&B,&Y,D1=&D1+&X,D2=&D2+&X
&BCLBL SYSLBL
MEXIT
.*
.* NO. OF INSTRUCTIONS SPECIFIED
.*
.N ANOP
&M SETA &N
AIF (&M LE 1).ONE
.LOOP ANOP
AIF (&X GE &M-1).LAST
&LBL SYSXXCA &OP,&A,&B,(&C)/&M,D1=&D1+(&C)/&M*&X,D2=&D2+(&C)/&M*&X
&LBL SETC ''
&X SETA &X+1
AIF ('&BC(1)' EQ '').LOOP
AIF ('&BCLBL' NE '').BCB
&BCLBL SETC '&BC(2)'
AIF ('&BCLBL' NE '').BCB
&BCLBL SETC '&OP&SYSNDX'
.BCB &BC(1) &BCLBL
AGO .LOOP
.LAST ANOP
SYSXXCA &OP,&A,&B,&C-(&C)/&M*&X,D1=&D1+(&C)/&M*&X,D2=&D2+(&C)/&M*&X
&BCLBL SYSLBL
MEXIT
.*
.ONE ANOP
&L SYSXXCA &OP,&A,&B,&C,D1=&D1,D2=&D2
.END MEND
./ ADD LIST=ALL,NAME=SYSXXCA
MACRO
&L SYSXXCA &OP,&A,&B,&C,&D1=0,&D2=0
LCLA &LEN
LCLC &LQ
.*
AIF ('&C' NE '').NDLEN
AIF (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND *
T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND *
T'&A NE '$').OKLEN
MNOTE *,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE T*
O MACROS'
&LQ SETC 'L'''
&L SYSXXCA &OP,&A,&B,&LQ&A,D1=&D1,D2=&D2
MEXIT
.*
.OKLEN ANOP
&LEN SETA L'&A
&L SYSXXCA &OP,&A,&B,&LEN,D1=&D1,D2=&D2
MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&LEN)'
MEXIT
.*
.NDLEN ANOP
.*
AIF ('&A'(1,1) EQ '(').AR
AIF ('&B'(1,1) EQ '(').C2
.*
.C1 ANOP
AIF ('&D1' EQ '0').D1Z
AIF ('&D2' EQ '0').C1B
.*
.C1A ANOP
&L SYSXXCB &OP,&D1+&A,&D2+&B,&C
MEXIT
.*
.C1B ANOP
&L SYSXXCB &OP,&D1+&A,&B,&C
MEXIT
.*
.D1Z ANOP
AIF ('&D2' EQ '0').C1D
.*
.C1C ANOP
&L SYSXXCB &OP,&A,&D2+&B,&C
MEXIT
.*
.C1D ANOP
&L SYSXXCB &OP,&A,&B,&C
MEXIT
.*
.C2 ANOP
AIF ('&D1' EQ '0').C2B
.*
.C2A ANOP
&L SYSXXCB &OP,&D1+&A,&D2&B,&C
MEXIT
.*
.C2B ANOP
&L SYSXXCB &OP,&A,&D2&B,&C
MEXIT
.*
.AR AIF ('&B'(1,1) EQ '(').C4
.*
.C3 ANOP
AIF ('&D2' EQ '0').C3B
.*
.C3A ANOP
&L SYSXXCB &OP,&D1&A,&D2+&B,&C
MEXIT
.*
.C3B ANOP
&L SYSXXCB &OP,&D1&A,&B,&C
MEXIT
.*
.C4 ANOP
&L SYSXXCB &OP,&D1&A,&D2&B,&C
MEND
./ ADD LIST=ALL,NAME=SYSXXCB
MACRO
&L SYSXXCB &OP,&A,&B,&C
LCLA &X,&Y,&Z
LCLC &CL(8),&CR(8)
AIF ('&A' NE '').OK
&L &OP 0(&C),&B
MEXIT
.*
.OK ANOP
AIF ('&A'(K'&A,1) EQ ')').SCAN
.*
.SIMPLE ANOP
&L &OP &A.(&C),&B
MEXIT
.*
.SCAN ANOP
&X SETA &X+1
AIF (&X GT K'&A).SIMPLE
AIF ('&A'(&X,1) EQ '''').QUOTE
AIF ('&A'(&X,1) NE '(').SCAN
AIF (&X EQ 1).SCAN
AIF ('&A'(&X-1,1) EQ '+').SCAN
AIF ('&A'(&X-1,1) EQ '-').SCAN
AIF ('&A'(&X-1,1) EQ '*').SCAN
AIF ('&A'(&X-1,1) EQ '/').SCAN
AIF ('&A'(&X-1,1) EQ '(').SCAN
.LOOPL ANOP
&Y SETA &Y+1
AIF (&Y*8 GE &X).DONEL
&CL(&Y) SETC '&A'((&Y-1)*8+1,8)
AGO .LOOPL
.*
.DONEL ANOP
&CL(&Y) SETC '&A'((&Y-1)*8+1,&X-(&Y-1)*8)
.*
.LOOPR ANOP
&Z SETA &Z+1
AIF (&Z*8 GE K'&A-&X).DONER
&CR(&Z) SETC '&A'(&X+(&Z-1)*8+1,8)
AGO .LOOPR
.*
.DONER ANOP
&CR(&Z) SETC '&A'(&X+(&Z-1)*8+1,K'&A-&X-(&Z-1)*8)
.*
&L &OP &CL(1)&CL(2)&CL(3)&CL(4)&CL(5)&CL(6)&CL(7)&CL(8)&C,&CR(1*
)&CR(2)&CR(3)&CR(4)&CR(5)&CR(6)&CR(7)&CR(8),&B
MEXIT
.*
.QUOTE ANOP
AIF (&X EQ 1).QUOTEL
AIF ('&A'(&X-1,1) EQ 'L').SCAN
.*
.QUOTEL ANOP
&X SETA &X+1
AIF (&X GE K'&A).SIMPLE
AIF ('&A'(&X,1) NE '''').QUOTEL
AGO .SCAN
MEND
./ ADD LIST=ALL,NAME=SYSXXC1
MACRO
&L SYSXXC1 &OP,&A,&T,&C,&D1=0,&N=,&BC=
LCLC &LBL,&BCLBL
LCLA &M,&X,&Y
&LBL SETC '&L'
AIF ('&N' NE '' AND '&N' NE '*').N
.*
.* NO. OF INSTRUCTIONS NOT SPECIFIED
.*
AIF ('&C' EQ '').ONE
.CHECK ANOP
&Y SETA &Y+1
AIF (&Y GT K'&C).OK
AIF ('&C'(&Y,1) LT '0').ONE
AGO .CHECK
.OK ANOP
.*
AIF (&C LE 256).ONE
.NEXT ANOP
&LBL SYSXXCA &OP,&A,&T,256,D1=&X
&LBL SETC ''
AIF ('&BC(1)' EQ '').NBC
AIF ('&BCLBL' NE '').BCA
&BCLBL SETC '&BC(2)'
AIF ('&BCLBL' NE '').BCA
&BCLBL SETC '&OP&SYSNDX'
.BCA &BC(1) &BCLBL
.NBC ANOP
&X SETA &X+256
&Y SETA &C-&X
AIF (&Y GT 256).NEXT
SYSXXCA &OP,&A,&T,&Y,D1=&X
&BCLBL SYSLBL
MEXIT
.*
.* NO. OF INSTRUCTIONS SPECIFIED
.*
.N ANOP
&M SETA &N
AIF (&M LE 1).ONE
.LOOP ANOP
AIF (&X GE &M-1).LAST
&LBL SYSXXCA &OP,&A,&T,(&C)/&M,D1=&D1+(&C)/&M*&X
&LBL SETC ''
&X SETA &X+1
AIF ('&BC(1)' EQ '').LOOP
AIF ('&BCLBL' NE '').BCB
&BCLBL SETC '&BC(2)'
AIF ('&BCLBL' NE '').BCB
&BCLBL SETC '&OP&SYSNDX'
.BCB &BC(1) &BCLBL
AGO .LOOP
.LAST ANOP
SYSXXCA &OP,&A,&T,&C-(&C)/&M*&X,D1=&D1+(&C)/&M*&X
&BCLBL SYSLBL
MEXIT
.*
.ONE ANOP
&L SYSXXCA &OP,&A,&T,&C,D1=&D1
.END MEND
./ ADD LIST=ALL,NAME=TF
MACRO
&L TF
LCLA &X,&Y,&Z,&I
LCLC &F(16)
.*
AIF (N'&SYSLIST LT 1).NONE
.LOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
.*
AIF (&Z GE 16).MANY
.*
&F(&Z+1) SETC '+L'''(1,3)
&F(&Z+2) SETC '&SYSLIST(&X)'
&I SETA 0
.SCAN ANOP
&I SETA &I+1
AIF (&I GT K'&F(&Z+2)).SCANOK
AIF ('&F(&Z+2)'(&I,1) GE 'A').SCAN
AIF (&I LE 1).SCANOK
&F(&Z+2) SETC '&F(&Z+2)'(1,&I-1)
.SCANOK ANOP
.*
&Y SETA &Z+2
.CHECK ANOP
&Y SETA &Y-2
AIF (&Y LT 2).UNIQUE
AIF ('&F(&Z+2)' NE '&F(&Y)').CHECK
MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
&F(&Z+1) SETC ''
&F(&Z+2) SETC ''
AGO .LOOP
.*
.UNIQUE ANOP
AIF (&X LE 1).NTEST
TM 0,(&F(&Z+2)-&F(2))*256
ORG *-4
.NTEST ANOP
&Z SETA &Z+2
AGO .LOOP
.*
.DONE ANOP
&F(1) SETC 'L'''(1,2)
&L TM &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
)&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
MEXIT
.*
.NONE ANOP
MNOTE 12,'NO FLAGS SPECIFIED'
CLI *+1,0
MEXIT
.*
.MANY ANOP
MNOTE 12,'TOO MANY FLAGS SPECIFIED'
AGO .DONE
MEND
./ ADD LIST=ALL,NAME=TIME128
MACRO
&L TIME128
&L OSCALL TIME128
MEND
./ ADD LIST=ALL,NAME=TIOTSRCH
MACRO
&L TIOTSRCH &R,&S,&DD,&UCB=YES
LCLC &LBL
SYSKWT UCB,&UCB,(YES,NO),NULL=NO,COND=NO
&L L &R,16
L &R,0(,&R)
L &R,0(,&R)
L &R,12(,&R)
LA &R,24(,&R)
SLR &S,&S
TIO&SYSNDX.A IC &S,0(,&R)
LTR &S,&S
BZ TIO&SYSNDX.C
CLC 4(8,&R),&DD
BE TIO&SYSNDX.B
ALR &R,&S
B TIO&SYSNDX.A
&LBL SETC 'TIO&SYSNDX.B'
AIF ('&UCB' EQ 'NO').NUCB
&LBL L &R,16(,&R)
&LBL SETC ''
LA &R,0(,&R)
.NUCB ANOP
&LBL LTR &S,&S
&LBL SETC ''
TIO&SYSNDX.C DS 0H
MEND
./ ADD LIST=ALL,NAME=UAOP
MACRO
&L UAOP &OP,&R,&A
&L &OP &R,*-*
ORG *-2
DC S(&A)
MEND
./ ADD LIST=ALL,NAME=VAREA
MACRO
&L VAREA
GBLA &VAREA
&L DS 0F,XL&VAREA
MEND
./ ADD LIST=ALL,NAME=VCLEAR
MACRO
&L VCLEAR &AREA
AIF ('&AREA' NE '').AOK
MNOTE 12,'VAREA ADDRESS REQUIRED'
MEXIT
.*
.AOK ANOP
.*
AIF ('&AREA'(1,1) EQ '(').REG
&L MMVC 12+&AREA,4+&AREA,8
MEXIT
.*
.REG ANOP
&L MMVC 12&AREA,4&AREA,8
MEND
./ ADD LIST=ALL,NAME=VINIT
MACRO
&L VINIT &AREA,&RTN,&LOC,&LEN
AIF ('&AREA' NE '').AOK
MNOTE 12,'VAREA ADDRESS REQUIRED'
MEXIT
.*
.AOK ANOP
.*
&L SYSLR VRF,&RTN,ERR='OUTPUT ROUTINE ADDRESS REQUIRED'
SYSQS VR1,VR0,&LOC,&LEN
AIF ('&AREA'(1,1) EQ '(').REG
STM VRF,VR1,&AREA
STM VR0,VR1,12+&AREA
MEXIT
.*
.REG ANOP
STM VRF,VR1,0&AREA
STM VR0,VR1,12&AREA
MEND
./ ADD LIST=ALL,NAME=VOUT
MACRO
&L VOUT &AREA,&LOC,&LEN,&DEBLANK=,&WGET=,&OFFSET=
AIF ('&LOC&LEN' EQ '').NVSEG
&L VSEG &AREA,&LOC,&LEN,DEBLANK=&DEBLANK,WGET=&WGET,OFFSET=&OFFSET
AGO .COM
.*
.NVSEG ANOP
&L SYSLR VRE,&AREA,ERR='VAREA ADDRESS REQUIRED'
.*
.COM ANOP
LM VR0,VR1,4(VRE)
S VR0,12(VRE)
MVC 12(8,VRE),4(VRE)
L RTNR,0(VRE)
SLR VRF,VRF
CCALL (RTNR)
MEND
./ ADD LIST=ALL,NAME=VSEG
MACRO
&L VSEG &AREA,&LOC,&LEN,&DEBLANK=,&WGET=,&OFFSET=
SYSKWT DEBLANK,&DEBLANK,(YES,NO),COND=NO
SYSKWT WGET,&WGET,(YES,NO)
&L SYSLR VRE,&AREA,ERR='VAREA ADDRESS REQUIRED'
SYSQS VR1,VR0,&LOC,&LEN,TYPEA=&WGET,SELECTA=(YES)
SYSLR VRF,&OFFSET
AIF ('&DEBLANK' EQ 'YES').DB
CCALL VSEG
MEXIT
.*
.DB CCALL VSEGDB
MEND
./ ADD LIST=ALL,NAME=VTELL
MACRO
&L VTELL &AREA
AIF ('&AREA' NE '').AOK
MNOTE 12,'VAREA ADDRESS REQUIRED'
MEXIT
.*
.AOK ANOP
.*
AIF ('&AREA'(1,1) EQ '(').REG
&L LM VR0,VR1,4+&AREA
L VRF,12+&AREA
SLR VR0,VRF
MEXIT
.*
.REG ANOP
&L LM VR0,VR1,4&AREA
L VRF,12&AREA
SLR VR0,VRF
MEND
./ ADD LIST=ALL,NAME=VTEST
MACRO
&L VTEST &AREA,&LEN
AIF ('&AREA' NE '').AOK
MNOTE 12,'VAREA ADDRESS REQUIRED'
MEXIT
.*
.AOK ANOP
.*
&L SYSLR RTNR,&LEN,ERR='LENGTH REQUIRED'
AIF ('&AREA'(1,1) EQ '(').REG
S RTNR,12+&AREA
LCR RTNR,RTNR
MEXIT
.*
.REG ANOP
S RTNR,12&AREA
LCR RTNR,RTNR
MEND
./ ADD LIST=ALL,NAME=WADDR
MACRO
&L WADDR &R,&LOC
&L L &R,&LOC
MEND
./ ADD LIST=ALL,NAME=WCALL
MACRO
&L WCALL &SUBR,&TYPE,&RETURN=,&TEST=, *
&VRE=,&VRF=,&VR0=,&VR1=
&L CCALL &SUBR,&TYPE,RETURN=&RETURN,TEST=&TEST, *
VRE=&VRE,VRF=&VRF,VR0=&VR0,VR1=&VR1
MEND
./ ADD LIST=ALL,NAME=WENTER
MACRO
&L WENTER &R,&S,&SIZE,&ENTRY=,&BASE=,&WAR=, *
&CHECK=,&TRACE=,&ID=
&L CENTER &R,&S,&SIZE,ENTRY=&ENTRY,BASE=&BASE,WAR=&WAR
MEND
./ ADD LIST=ALL,NAME=WEXIT
MACRO
&L WEXIT &R,&S,&SIZE,&WAR=,<R=,&BRANCH=, *
&CHECK=,&TRACE=,&ID=
&L CEXIT &R,&S,&SIZE,LTR=<R,WAR=&WAR,BRANCH=&BRANCH
MEND
./ ADD LIST=ALL,NAME=WPARMGBL
*
* NIH/COMMON - DUMMY FOR WYLBUR GLOBAL DECLARATIONS
*
./ ADD LIST=ALL,NAME=WPOP
MACRO
&L WPOP &R,&SIZE,&EXTRA=0,&CHECK=
&L CPOP &R,&SIZE,EXTRA=&EXTRA
MEND
./ ADD LIST=ALL,NAME=WPOPREG
MACRO
&L WPOPREG &R,&S,&CHECK=
&L CPOPREG &R,&S
MEND
./ ADD LIST=ALL,NAME=WPUSH
MACRO
&L WPUSH &R,&SIZE,&EXTRA=0,&CHECK=
&L CPUSH &R,&SIZE,EXTRA=&EXTRA
MEND
./ ADD LIST=ALL,NAME=WPUSHREG
MACRO
&L WPUSHREG &R,&S,&CHECK=
&L CPUSHREG &R,&S
MEND
./ ADD LIST=ALL,NAME=WSA
MACRO
&L WSA &R,&S,&EQU=
&L CSA &R,&S,EQU=&EQU
MEND
./ ADD LIST=ALL,NAME=Z
MACRO
&L Z &R,&A
AIF ('&R' NE '').REG
&L MZC &A,4
MEXIT
.REG ANOP
&L SLR &R,&R
ST &R,&A
MEND
./ ADD LIST=ALL,NAME=ZB
MACRO
&L ZB &R,&A
AIF ('&R' NE '').REG
&L MVI &A,0
MEXIT
.REG ANOP
&L SLR &R,&R
STC &R,&A
MEND
./ ADD LIST=ALL,NAME=ZF
MACRO
&L ZF
LCLA &X,&Y,&Z,&I
LCLC &F(16)
.*
AIF (N'&SYSLIST LT 1).NONE
.LOOP ANOP
&X SETA &X+1
AIF (&X GT N'&SYSLIST).DONE
.*
AIF (&Z GE 16).MANY
.*
&F(&Z+1) SETC '+L'''(1,3)
&F(&Z+2) SETC '&SYSLIST(&X)'
&I SETA 0
.SCAN ANOP
&I SETA &I+1
AIF (&I GT K'&F(&Z+2)).SCANOK
AIF ('&F(&Z+2)'(&I,1) GE 'A').SCAN
AIF (&I LE 1).SCANOK
&F(&Z+2) SETC '&F(&Z+2)'(1,&I-1)
.SCANOK ANOP
.*
&Y SETA &Z+2
.CHECK ANOP
&Y SETA &Y-2
AIF (&Y LT 2).UNIQUE
AIF ('&F(&Z+2)' NE '&F(&Y)').CHECK
MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
AGO .LOOP
.*
.UNIQUE ANOP
AIF (&X LE 1).NTEST
NI 0,(&F(&Z+2)-&F(2))*256
ORG *-4
.NTEST ANOP
&Z SETA &Z+2
AGO .LOOP
.*
.DONE ANOP
&F(1) SETC 'L'''(1,2)
&L ZI &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
)&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
MEXIT
.*
.NONE ANOP
MNOTE 12,'NO FLAGS SPECIFIED'
CLI *+1,0
MEXIT
.*
.MANY ANOP
MNOTE 12,'TOO MANY FLAGS SPECIFIED'
AGO .DONE
MEND
./ ADD LIST=ALL,NAME=ZH
MACRO
&L ZH &R,&A
AIF ('&R' NE '').REG
&L MZC &A,2
MEXIT
.REG ANOP
&L SLR &R,&R
STH &R,&A
MEND
./ ADD LIST=ALL,NAME=ZHB
MACRO
&L ZHB &R,&A
&L ZB &R,&A
MEND
./ ADD LIST=ALL,NAME=ZHBR
MACRO
&L ZHBR &R
AIF ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').N
&L LA &R,0(,&R)
MEXIT
.*
.N ANOP
&L N &R,=XL4'00FFFFFF'
MEND
./ ADD LIST=ALL,NAME=ZI
MACRO
&L ZI &A,&B
&L NI &A,255-(&B)
MEND
./ ADD LIST=ALL,NAME=ZR
MACRO
&L ZR &R
&L SR &R,&R
MEND
./ ADD LIST=ALL,NAME=ZZZZZZZZ
ALP;
END;