//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 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; : BEGIN APRIVSG1 'MAILBOX',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN APRIVSG1 'MAILPEND',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN APRIVSG1 'PROFILE',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN APRIVSG1 'MILTENRECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : 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 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 DO BEGIN L XRB,LLECDPT-LLE(,XRC); % POINTER TO CDE IF 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 DO BEGIN CBAL RTNR,&&TEST; L XRB,CDCHAIN-CDE(,XRB); END; L XRB,CVTPTR; L XRB,CVTLPDIA-CVT(,XRB); % LINK PACK DIRECTORY UNTIL 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 THEN ; 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 ; RGOTO RTNR IF ^; % NO XL IF THEN BEGIN % REALLY LPDE RGOTO RTNR IF ; % LOW LR VRF,VR0; S VRF,LPDEXTAD-LPDE(,XRB); % GET DISPLACEMENT RGOTO RTNR IF ; % HIGH END ELSE BEGIN RGOTO RTNR IF ; L XRD,CDXLMJP-CDE(,XRB); % XL POINTER RGOTO RTNR IF ; % NO XL L VRF,4(,XRD); % NO. OF EXTENTS RGOTO RTNR IF ^; % NO EXTENTS L VRE,12(XRD); % LOAD ADDRESS RGOTO RTNR IF ; % TOO LOW LR VRF,VR0; SR VRF,VRE; % GET DISPLACEMENT RGOTO RTNR IF % TOO HIGH | ; 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 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 DO BEGIN L XRB,LLECDPT-LLE(,XRC); % POINTER TO CDE IF 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 DO BEGIN CBAL RTNR,&&TEST; L XRB,CDCHAIN-CDE(,XRB); END; ZR VR1; % INDICATE NOT FOUND EXIT FROM &&SRCH; &&TEST: RGOTO RTNR IF ; RGOTO RTNR IF ^; % NO XL L XRD,CDXLMJP-CDE(,XRB); % XL POINTER RGOTO RTNR IF ; % NO XL L VR0,4(,XRD); % NO. OF EXTENTS RGOTO RTNR IF ; % 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 THEN BEGIN % NOT TOO LOW LR XRE,VRF; SL XRE,0(,VR1); % GET DISPL. IF 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 | ; 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 ^; % NOT CORRECT LENGTH ASM IF ('&SITE' EQ 'NIH') THEN BEGIN ASM IF (&&LACCT EQ 4) THEN EXIT IF ; DO BEGIN % CHECK EACH CHARACTER EXIT FROM CHEK&&@ IF ^<< & > | < & > | < & > | < & >>; 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 ; % NOT CORRECT LENGTH ASM IF ('&SITE' EQ 'NIH') THEN BEGIN IF THEN BEGIN AI VR1,1; SI VR0,1; END; DO BEGIN % CHECK EACH CHARACTER EXIT FROM CHEK&&@ IF ^< & >; 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 ^; % NOT CORRECT LENGTH ASM IF ('&SITE' EQ 'NIH') THEN BEGIN EXIT FROM CHEK&&@ IF ^<< & > | < & > | < & > %| | | >; SI VR0,1; DO BEGIN EXIT FROM CHEK&&@ IF ^<< & > | < & > | < & > | < & & ^< & >> %| | | >; 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 ^; % NOT CORRECT LENGTH DO BEGIN % CHECK EACH CHARACTER EXIT FROM CHEK&&@ IF ; 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 & 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 ^; % NOT CORRECT LENGTH ASM IF ('&SITE' EQ 'NIH') THEN BEGIN IF & THEN BEGIN SI VR0,2; % ALLOW FOR 1ST DIGIT AND LETTER DO BEGIN AI VR1,1; EXIT FROM CHEK&&@ IF ^< & >; END FOR VR0; EXIT FROM CHEK&&@ IF ^<< & > | < & > | < & >>; END ELSE BEGIN EXIT FROM CHEK&&@ IF ^<< & > | < & > | < & >>; FOREVER DO BEGIN AI VR1,1; SI VR0,1; EXIT IF ; EXIT FROM CHEK&&@ IF ^< & >; 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 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/.E jklmnopqrNq~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 THEN BEGIN % NOT WAITED ON CS VRF,VR0,0(VR1); % TRY TO POST EXIT FROM FPDO&&@ IF ; % 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 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 THEN BEGIN % NOT WAITED ON CS VRF,VR0,0(VR1); % TRY TO POST EXIT FROM FPDO&&@ IF ; % 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 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 THEN BEGIN % ECB IS POSTED SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*; EXIT FROM FWDO&&@; END; IF 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 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 & ^ 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 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; : BEGIN IPRIVSG1 'SYSTEMS',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN IPRIVSG1 'ACCOUNTING',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN IPRIVSG1 'OPERATOR',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN IPRIVSG1 'BASIC',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN IPRIVSG1 'UNDER',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : BEGIN IPRIVSG1 'PROJECT',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA; END; : 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;