./ ADD NAME=AND DSN=CL.REM.UMAC MACRO 00010000 &LABEL AND &TRUE,&FALSE 00020000 GBLA &I,&IMAX,&L 00030000 GBLC &LAB(255),&LIST(255) 00040000 LCLA &K,&N,&L1 00050000 LCLC &NAME 00060000 &NAME SETC '&LABEL' 00070000 .* SEE IF AN AND OPERATION OCCURS AT THE SAME PARENTHESIS LEVEL 00080000 .* BEFORE AN OR OPERATION OCCURS 00090000 .LOOP ANOP 00100000 &K SETA &I 00110000 &N SETA 0 00120000 .AGAIN AIF (&K GT &IMAX).NO 00130000 AIF ('&LIST(&K)' NE '(').OK1 00140000 &N SETA &N+1 00150000 AGO .END 00160000 .OK1 AIF ('&LIST(&K)' NE ')').OK2 00170000 &N SETA &N-1 00180000 AIF (&N LT 0).NO 00190000 .END ANOP 00200000 &K SETA &K+1 00210000 AGO .AGAIN 00220000 .OK2 AIF (&N NE 0).END 00230000 AIF ('&LIST(&K)' EQ '+').NO 00240000 AIF ('&LIST(&K)' NE '.').END 00250000 .* IF SO: 00260000 &L SETA &L+1 00270000 &LAB(&L) SETC '' 00280000 &L1 SETA &L 00290000 &NAME TERM &L1,&FALSE 00300000 &I SETA &I+1 00310000 BRANCH Z,&FALSE 00320000 &NAME SETC '&LAB(&L1)' 00330000 AGO .LOOP 00340000 .* IF NOT: 00350000 .NO ANOP 00360000 &NAME TERM &TRUE,&FALSE 00370000 MEND 00380000 ./ ADD NAME=BASESAVE DSN=CL.REM.UMAC MACRO 00001000 &NAME BASESAVE 00002000 USING *,15 REG 15 HAS ENTRY ADDRESS 00003000 &NAME SAVE (14,12),,* 00004000 LR 12,13 ******** 00005000 LA 13,IEUSAVE *** MAINTAIN SAVE 00006000 ST 13,8(0,12) *** AREA CHAINING 00007000 ST 12,IEUSAVE+4 * 00008000 LR 12,15 ESTABLISH REG 12 AS BASE 00009000 DROP 15 00010000 MEND 00011000 MEMBER NAME CLOSESB 00012000 MACRO 00010000 ./ ADD NAME=BEGIN DSN=CL.REM.UMAC MACRO 00001000 &NAME BEGIN &RENT,&CSECT=,&BASEREG=12,&SVAREA=,&ID=,&SAVEREG=(14,12),00002000 ,&ENTRY=,&LOC=,&START=,&SWITCH=,&DATE=NO,®DEF=YES, X00003000 &FP=YES 00004000 GBLB ®DON 00005000 .* MACRO TO START A PROGRAM 00006000 .* THE RE-ENTRANT FORM DESTROYS REG. 0, BUT PRESERVES REG. 1. 00007000 .* THE NON-RE-ENTRANT FORM PRESERVES BOTH REG. 0 AND REG. 1. 00008000 .* PARAMETER MEANING DEFAULT 00009000 .* &LOC NAME OF 1ST INST. NO NAME 00010000 .* &ENTRY ENTRY POINT NAME(S) &NAME 00011000 .* AND IDENT. NUMBERS 00012000 .* &NAME ENTRY POINT NAME NO NAME 00013000 .* &DATE DATE AND TIME COMPILED INCLUDE 00014000 .* ®DEF ASSIGN SYMBOLIC REGS INCLUDE 00015000 .* &FP DEFINE FLOATING REGS INCLUDE 00016000 .* &START START VALUE &CSECT(2) 00017000 .* &CSECT(1) CSECT NAME NO NAME 00018000 .* &CSECT(2) START VALUE NO START INSTRUCTION 00019000 .* &BASEREG BASE REGISTER 12 00020000 .* &SAVEREG REGS. TO BE SAVED (14,12) 00021000 .* &SVAREA SAVE AREA NAME NO NAME 00022000 .* &SWITCH ENT. PT. SWITCH NAME NO NAME 00023000 .* &ID PROGRAM ID NAME &ENTRY, &NAME, &CSECT(1), 00024000 .* OR NONE 00025000 .* &RENT IF 'RENT', CODE IS CODE GENERATED IS NOT 00026000 .* TO BE REENTRANT TO BE REENTRANT 00027000 .* IT IS ASSUMED THAT REG. 15 CONTAINS A(&LOC) ON ENTRY. 00028000 LCLC &IDDATE,&IDTIME 00029000 LCLC &X1,&X2,&X3 00030000 LCLA &COUNT,&A,&K,&L,&I,&NENTRY,&X4 00031000 LCLB &RENTB,&BASE1,&BASE15,&NMOMIT,&IDOMIT,&DUM,&CKBASE 00032000 LCLB &ENTOMIT,&DS,&MULT,&LOCOMIT 00033000 LCLC &SAVE,&OR,&INST,&B,&B1,&CHAR,&RF,&RL,&FORK 00034000 &RENTB SETB ('&RENT' EQ 'RENT') IS CODE TO BE REENTRANT? 00035000 &CKBASE SETB (T'&BASEREG NE 'N') CAN'T CHECK UNLESS SELF-DEF. 00036000 AIF (&CKBASE).NOCHECK 00037000 &BASE1 SETB (&BASEREG EQ 1) IS BASE REGISTER = 1? 00038000 &BASE15 SETB (&BASEREG EQ 15) IS BASE REGISTER = 15? 00039000 .NOCHECK ANOP 00040000 &NENTRY SETA N'&ENTRY NO. OF ENTRY POINTS & IDENT NOS. 00041000 &MULT SETB (&NENTRY GT 2) ARE THERE MULTIPLE ENTRY PTS? 00042000 &IDOMIT SETB (T'&ID EQ 'O') IS &ID OMITTED? 00043000 &ENTOMIT SETB (&NENTRY EQ 0) IS &ENTRY OMITTED? 00044000 &NMOMIT SETB (T'&NAME EQ 'O') IS &NAME OMITTED? 00045000 &LOCOMIT SETB (T'&LOC EQ 'O') IS &LOC OMITTED? 00046000 &B1 SETC ' ' MAKE COMMENTS LOOK NICE 00047000 AIF (T'&SAVEREG(1) NE 'N').BADREG MUST BE SELF-DEFINING 00048000 AIF (&SAVEREG(1) EQ 13 OR N'&SAVEREG GT 2).BADREG 00049000 &RF SETC '&SAVEREG(1)' FIRST REG. TO BE SAVED 00050000 AIF (N'&SAVEREG EQ 1).OKREG 00051000 AIF (T'&SAVEREG(2) NE 'N').BADREG 00052000 &RL SETC '&SAVEREG(2)' LAST REG. TO BE SAVED 00053000 AIF (&SAVEREG(2) EQ 13).BADREG 00054000 AIF (&SAVEREG(1) EQ 15 AND &SAVEREG(2) EQ 14).BADREG 00055000 AIF (&SAVEREG(1) EQ 14 OR &SAVEREG(1) EQ 15).OKREG 00056000 AIF (&SAVEREG(2) GT 12).BADREG 00057000 AIF (&SAVEREG(1) LE &SAVEREG(2)).OKREG 00058000 .BADREG MNOTE 4,'*** SAVEREG IS ILLEGAL. SAVEREG=(14,12) ASSUMED.' 00059000 &RF SETC '14' DEFAULT VALUES 00060000 &RL SETC '12' 00061000 &A SETA 12 POSITION IN SAVE AREA OF &RF 00062000 AGO .AOK 00063000 .OKREG ANOP 00064000 &A SETA &SAVEREG(1)*4+20 POSITION IN SAVE AREA OF &RF 00065000 AIF (&A LE 75).AOK 00066000 &A SETA &A-64 IF &RF = 14 OR 15 00067000 .AOK AIF (&CKBASE).SET 00068000 AIF (&BASEREG GE 10).SET MAKE COMMENTS LOOK NICE 00069000 &B SETC ' ' EXTRA BLANK IF 1 DIGIT BASE REG. 00070000 .SET AIF (T'&RENT EQ 'O').CONT SKIP IF &RENT OMITTED 00071000 AIF (&RENTB).DUMMY IF PRESENT, &RENT MUST BE 'RENT' 00072000 AIF ('&RENT' EQ 'NORENT').CONT OR 'NORENT' 00073000 MNOTE 4,'*** FIRST PARAMETER IS INVALID AND HAS BEEN IGNORED' 00074000 AGO .CONT IGNORE BAD PARAMETER 00075000 .DUMMY AIF (T'&SVAREA EQ 'O' AND (T'&SWITCH EQ 'O' OR NOT &MULT) X00076000 ).CONT NO DSECT IF &SVAREA AND &SWITCH ARE OMITTED 00077000 AIF (N'&CSECT LT 2 AND T'&START EQ 'O').GENDUM SKIP UNLESS X00078000 START INST. REQUIRED 00079000 &DUM SETB 1 REMEMBER TO GEN. DSECT LATER 00080000 AGO .USSTART CAN'T GEN. IT NOW BECAUSE OF START 00081000 .GENDUM ANOP 00082000 &SAVE SETC 'SAVE'.'&SYSNDX' DSECT NAME 00083000 &SAVE DSECT 00084000 USING *,13 X USE REG. 13 TO REFER TO SAVE AREA 00085000 &SVAREA DS 18F X SAVE AREA 00086000 AIF (NOT &MULT).USCSECT SKIP UNLESS MULTIPLE ENTRY POINTS 00087000 &SWITCH DS F X ENTRY POINT SWITCH 00088000 AGO .USCSECT 00089000 .CONT AIF (N'&CSECT LT 2 AND T'&START EQ 'O').USCSECT 00090000 .USSTART ANOP 00091000 &SAVE SETC '&START' OPERAND FOR START INSTRUCTION 00092000 AIF (T'&START NE 'O').GENSTRT 00093000 &SAVE SETC '&CSECT(2)' USE &CSECT(2) IF &START OMITTED 00094000 .GENSTRT ANOP 00095000 &CSECT(1) START &SAVE 00096000 AGO .CKENTRY 00097000 .USCSECT ANOP 00098000 &CSECT(1) CSECT 00099000 AIF (&DUM).CHECK SKIP IF AT END OF MACRO 00100000 .CKENTRY AIF (&ENTOMIT).ENT SKIP IF &ENTRY OMITTED 00101000 .LOOP ENTRY &ENTRY(&I+1) 00102000 &ENTRY(&I+1) DS 0H 00103000 &DS SETB 1 REMEMBER THE 'DS 0H' 00104000 .ENT AIF (&NMOMIT).NAM SKIP IF &NAME OMITTED 00105000 ENTRY &NAME 00106000 &NAME DS 0H 00107000 &NMOMIT SETB 1 IF MULTIPLE ENTRIES,DON'T REUSE 00108000 &DS SETB 1 REMEMBER THE 'DS 0H' 00109000 .NAM AIF (&DS AND &LOCOMIT).SKIP IS NEXT DS NEEDED? 00110000 &LOC DS 0H 00111000 &LOCOMIT SETB 1 IF MULTIPLE ENTRIES,DON'T REUSE 00112000 .SKIP USING *,15 X USE REG. 15 AS TEMP. BASE REG. 00113000 AIF (&IDOMIT AND &ENTOMIT AND &NMOMIT AND '&CSECT(1)&DATE' X00114000 EQ '').NOID SKIP IF NO ID AVAILABLE 00115000 AIF (&IDOMIT AND &ENTOMIT AND &NMOMIT AND '&CSECT(1)' X00116000 EQ '' AND '&DATE' EQ 'NO').NOID 00117000 AIF (&IDOMIT AND &ENTOMIT AND &NMOMIT AND '&CSECT(1)' X00118000 EQ '' AND '&DATE' EQ 'YES').NMA 00119000 &COUNT SETA 0 00120000 &CHAR SETC '&ID' ID TO APPEAR AFTER ENTRY PT. 00121000 &COUNT SETA K'&ID NO. OF CHARACTERS IN ID 00122000 AIF (NOT &IDOMIT).NM IF &ID OMITTED, USE &ENTRY 00123000 &CHAR SETC '&ENTRY(&I+1)' 00124000 &COUNT SETA K'&ENTRY(&I+1) 00125000 AIF (NOT &ENTOMIT).NMA IF &ENTRY OMITTED, USE &NAME 00126000 &CHAR SETC '&NAME' 00127000 &COUNT SETA K'&NAME 00128000 AIF (NOT &NMOMIT).NMA IF &NAME OMITTED, USE &CSECT 00129000 &CHAR SETC '&CSECT(1)' 00130000 &COUNT SETA K'&CSECT(1) 00131000 AGO .NMA 00132000 .NM ANOP 00133000 AIF ('&CHAR'(1,1) NE '''').NMA 00134000 &COUNT SETA &COUNT-2 00135000 &CHAR SETC '&ID'(2,&COUNT) 00136000 &L SETA 1 00137000 .NMA ANOP 00138000 AIF ('&DATE' EQ 'NO' OR '&DATE' EQ 'YES').DATEOK 00139000 MNOTE 4,'THE DATE OPERAND IS NOT EQUAL TO YES OR NO' 00140000 .DATEOK ANOP 00141000 AIF ('&DATE' NE 'YES').NM1 00142000 .*&IDDATE SETC '&SYSDATE '(1,7) 00143000 .*&IDTIME SETC '&SYSTIME' 00144000 &X1 SETC '&IDDATE'(1,2) 00145000 &X2 SETC '&IDDATE'(3,3) 00146000 &X3 SETC '&IDDATE'(6,2) 00147000 AIF ('&X3'(2,1) NE ' ').NM2 00148000 &X3 SETC '0'.'&X3'(1,1) 00149000 .NM2 ANOP 00150000 &IDDATE SETC ' &X3&X2&X1' 00151000 &X1 SETC ' ' 00152000 &X4 SETA 18 00153000 .NM1 ANOP 00154000 &K SETA &COUNT+5 NO. BYTES TO BRANCH AROUND ID 00155000 AIF (&COUNT/2*2 NE &COUNT).ODD 00156000 &K SETA &COUNT+6 MUST BE AN EVEN NUMBER 00157000 .ODD B *+&K+&X4 X BRANCH AROUND PROGRAM ID 00158000 DC AL1(&COUNT+&X4) X NO. OF CHARACTERS IN ID 00159000 &K SETA &K-5 NO. OF CHARACTERS, FORCED ODD 00160000 &SAVE SETC '&CHAR' FIRST 8 CHARS. OF ID 00161000 AIF (&IDOMIT OR &COUNT LE 8).ONLY 00162000 .BACK ANOP 00163000 &SAVE SETC '&ID'(&L+1,8) EXTRACT 8 CHARS. FROM &ID 00164000 DC CL8'&SAVE' 00165000 &K SETA &K-8 REDUCE CHARACTER COUNT 00166000 &COUNT SETA &COUNT-8 00167000 &L SETA &L+8 STEP THROUGH LONG ID 00168000 AIF (&COUNT GT 8).BACK GO GENERATE NEXT 8 CHARS. 00169000 &SAVE SETC '&ID'(&L+1,&COUNT) LAST BLOCK OF LE 8 CHARS. 00170000 .ONLY ANOP 00171000 &X4 SETA &X4+&K 00172000 DC CL&X4'&SAVE&IDDATE&X1&IDTIME' PROGRAM ID 00173000 &IDOMIT SETB 1 IF MULT. ENTRIES,DON'T REUSE &ID 00174000 AIF ('&DATE' NE 'YES').NOID 00175000 MNOTE *,'****ASSEMBLED &IDDATE &IDTIME ' 00176000 .NOID AIF (N'&SAVEREG EQ 1 OR '&RF' EQ '&RL').ONEREG 00177000 STM &RF,&RL,&A.(13)&B1 SAVE REGISTERS IN CALLER'S AREA 00178000 AGO .CKMULT 00179000 .ONEREG ST &RF,&A.(13) X SAVE REGISTER IN CALLER'S AREA 00180000 .CKMULT AIF (NOT &MULT).CKRENT SKIP UNLESS MULT. ENTRY POINTS 00181000 &FORK SETC 'IHB'.'&SYSNDX' 00182000 AIF ('&ENTRY(&I+2)' EQ '').SR SKIP IF IDENT NO. MISSING 00183000 AIF (&ENTRY(&I+2) EQ 0).SR SKIP IF IDENT. NO. IS 0 00184000 LA 14,&ENTRY(&I+2) X IDENT. NO. FOR THIS ENTRY POINT 00185000 AGO .FORK 00186000 .SR SR 14,14 X IDENT. NO. = 0 FOR THIS ENTRY PT. 00187000 .FORK LA 15,&FORK X A(COMMON CODE) 00188000 &I SETA &I+2 STEP LOOP COUNTER 00189000 AIF (&NENTRY LE &I).CKRENT SKIP IF ALL ENTRIES GENERATED 00190000 BR 15 X BRANCH TO COMMON CODE 00191000 AGO .LOOP GO GENERATE NEXT ENTRY POINT 00192000 .CKRENT AIF (&RENTB).GET SKIP IF CODE IS TO BE REENTRANT 00193000 .* NON-REENTRANT SAVE AREA CODE 00194000 &SAVE SETC '76' 00195000 CNOP 0,4 X GET ON A FULL WORD BOUNDARY 00196000 AIF (NOT &MULT).NOMULT SKIP UNLESS MULT. ENTRY POINTS 00197000 &SAVE SETC '80' 00198000 USING *,15 X COMMON ENTRY POINT CODE 00199000 .NOMULT ANOP 00200000 &FORK BAL &BASEREG,*+&SAVE&B X BRANCH AROUND SAVE AREA 00201000 AIF (&BASE15).USE OMIT DROP IF &BASEREG=15 00202000 DROP 15 X NO LONGER NEED TEMP. BASE REG. 00203000 .USE USING *,&BASEREG&B X BASE REG. AND A(SAVE AREA) NOW SET 00204000 &SVAREA DC 18F'0' X SAVE AREA 00205000 AIF (NOT &MULT).NOSW SKIP UNLESS MULT. ENTRY POINTS 00206000 &SWITCH DS F'0' X ENTRY POINT SWITCH 00207000 ST 14,72(&BASEREG)&B X STORE ENTRY POINT SWITCH 00208000 .NOSW ST &BASEREG,8(13)&B X STORE A(OUR SAVE AREA) IN CALLER'S 00209000 ST 13,4(&BASEREG)&B X STORE A(HIS SAVE AREA) IN OURS 00210000 LR 13,&BASEREG&B X A(OUR SAVE AREA) TO REG. 13 00211000 AGO .CHECK GO CHECK BASE REG. CHOICE 00212000 .* RE-ENTRANT SAVE AREA CODE 00213000 .GET ANOP 00214000 &SAVE SETC '72' 00215000 AIF (NOT &MULT).NOFORK SKIP UNLESS MULT. ENTRY POINTS 00216000 USING *,15 X COMMON ENTRY POINT CODE 00217000 &SAVE SETC '76' 00218000 .NOFORK AIF (&BASE1 OR &BASE15).GTMN 00219000 &FORK LR &BASEREG,1&B X TEMPORARILY SAVE REG. 1 00220000 &FORK SETC '' DON'T REDEFINE &FORK 00221000 .GTMN ANOP 00222000 &FORK LA 0,&SAVE X GET SPACE FOR A SAVE AREA 00223000 GETMAIN R,LV=(0) 00224000 AIF (NOT &MULT).NOSWTCH SKIP UNLESS MULT. ENTRY POINTS 00225000 ST 14,72(1) X STORE ENTRY POINT SWITCH 00226000 .NOSWTCH ANOP 00227000 &SAVE SETC '&BASEREG'.'&B' REG. IN WHICH REG. 1 IS SAVED 00228000 AIF (NOT &BASE15).STORE 00229000 L 0,24(13) X RETRIEVE CONTENTS OF REG. 1 00230000 &SAVE SETC '0 ' C(REG. 1) ARE IN REG. 0 00231000 .STORE ST 1,8(13) X STORE A(OUR SAVE AREA) IN CALLER'S 00232000 ST 13,4(1) X STORE A(HIS SAVE AREA) IN OURS 00233000 LR 13,1 X A(OUR SAVE AREA) TO REG. 13 00234000 AIF (&BASE1).BALR 00235000 LR 1,&SAVE X RESTORE REG. 1 00236000 .BALR BALR &BASEREG,0&B X SET UP BASE REGISTER 00237000 AIF (&BASE15).USIT REG. 15 IS ALREADY BASE REG. 00238000 DROP 15 X NO LONGER NEED TEMP. BASE REG. 00239000 .USIT USING *,&BASEREG&B X BASE REGISTER IS NOW SET 00240000 .CKDUM AIF (&DUM).GENDUM GO BACK & GEN. DSECT IF NEEDED 00241000 .* TEST FOR BAD OR POOR CHOICES OF BASE REGISTER 00242000 .CHECK AIF (NOT &CKBASE).CKIT 00243000 MNOTE 0,'*** BASE REGISTER HAS NOT BEEN CHECKED FOR VALIDITY' 00244000 AGO .DONE 00245000 .CKIT AIF (&BASEREG GT 2 AND &BASEREG LT 13).DONE 00246000 AIF (&BASEREG NE 0).TEST 00247000 MNOTE 8,'*** 0 IS NOT A VALID BASE REGISTER' 00248000 AGO .DONE 00249000 .TEST AIF (&BASEREG NE 13).WARN 00250000 MNOTE 8,'*** BEGIN MACRO CANNOT HANDLE 13 AS BASE REGISTER' 00251000 AGO .DONE 00252000 .WARN AIF (&MULT AND &BASEREG EQ 14).BAD14 00253000 MNOTE 0,'*** BASE REGISTER &BASEREG MAY BE DESTROYED BY' 00254000 AIF (&BASEREG EQ 2).TRT 00255000 MNOTE 4,'*** SVC ROUTINES OR LOWER-LEVEL SUBROUTINES' 00256000 AIF (NOT &BASE1).DONE 00257000 &OR SETC 'OR ' 00258000 &INST SETC 'OR EDMK ' 00259000 .TRT MNOTE 0,'*** &OR.TRT &INST.INSTRUCTIONS' 00260000 AGO .DONE 00261000 .BAD14 MNOTE 8,'*** BEGIN MACRO CANNOT HANDLE 14 AS BASE REGISTER' 00262000 MNOTE *,'*** WITH MULTIPLE ENTRY POINTS' 00263000 .DONE ANOP 00264000 AIF (®DON EQ 1).NOREGDF 00265000 AIF ('®DEF' EQ 'NO' OR '®DEF' EQ 'YES').REGOK 00266000 MNOTE 4,'THE REGDEF OPERAND IS NOT EQUAL TO YES OR NO' 00267000 .REGOK ANOP 00268000 AIF ('®DEF' NE 'YES').NOREGDF 00269000 AIF ('&FP' EQ 'NO' OR '&FP' EQ 'YES').FPOK 00270000 MNOTE 4,'THE FP OPERAND IS NOT EQUAL TO YES OR NO' 00271000 .FPOK AIF ('&FP' EQ 'NO').NOFP 00272000 FPR0 EQU 0 00273000 FPR2 EQU 2 00274000 FPR4 EQU 4 00275000 FPR6 EQU 6 00276000 SPACE 2 00277000 .NOFP ANOP 00278000 R0 EQU 0 00279000 R1 EQU 1 00280000 R2 EQU 2 00281000 R3 EQU 3 00282000 R4 EQU 4 00283000 R5 EQU 5 00284000 R6 EQU 6 00285000 R7 EQU 7 00286000 R8 EQU 8 00287000 R9 EQU 9 00288000 R10 EQU 10 00289000 R11 EQU 11 00290000 R12 EQU 12 00291000 R13 EQU 13 00292000 R14 EQU 14 00293000 R15 EQU 15 00294000 ®DON SETB 1 00295000 .NOREGDF MEND 00296000 ./ ADD NAME=BRANCH DSN=CL.REM.UMAC MACRO 00010000 BRANCH &MASK,&GOTO 00020000 .* GENERATE ALL BC AND BCR STATEMENTS (ONE PER CALL) 00030000 GBLA &COUNT 00040000 GBLB &RDEST,&NOTFLG 00050000 GBLC &LAB(255),&DEST 00060000 AIF (&NOTFLG).INVERT 00070000 AIF (&GOTO EQ 0).LD 00080000 AIF ('&LAB(&GOTO)' NE '').OK 00090000 &COUNT SETA &COUNT+1 00100000 &LAB(&GOTO) SETC '$#L&COUNT' 00110000 .OK B&MASK &LAB(&GOTO) 00120000 MEXIT 00130000 .LD AIF (&RDEST).BCR 00140000 B&MASK &DEST 00150000 MEXIT 00160000 .BCR AIF ('&MASK' EQ 'O').BO 00170000 BCR 8,&DEST 00180000 MEXIT 00190000 .BO BCR 1,&DEST 00200000 MEXIT 00210000 .INVERT ANOP 00220000 &NOTFLG SETB 0 00230000 AIF ('&MASK' EQ 'Z').BZ 00240000 BRANCH Z,&GOTO 00250000 MEXIT 00260000 .BZ BRANCH O,&GOTO 00270000 MEND 00280000 ./ ADD NAME=BUFDSECT DSN=CL.REM.UMAC MACRO 00010000 BUFDSECT 00020000 * 00030000 * DSECT DESCRIBING BSAM/BPAM I/O BUFFERS USED BY IEBUPDTX 00040000 * 00050000 BUFDSECT DSECT 00060000 BUFSTAT DS 0X BUFFER STATUS (I/O ACTIVE) 00070000 BUFCHAIN DS A POINTER TO NEXT BUFFER 00080000 READ BUFDECB,SF,MF=L DECB 00090000 BUFDATA DS 0F START OF DATA AREA 00100000 BUFLEN EQU *-BUFDSECT SIZE OF BUFFER PREFIX 00110000 MEND 00120000 ./ ADD NAME=CLOSESB DSN=CL.REM.UMAC LCLA &ACTR,&ASUM,&CTR,&CTR1,&LGTH,&NUMBER 00030000 LCLB &LOOPSW,&MFESW,&MFISW,&MFI2SW,&NULLSW,&B(3) 00040000 LCLC &PARA 00050000 &NUMBER SETA N'&PAR1 00060000 &CTR SETA 1 00070000 &CTR1 SETA 2 00080000 &LOOPSW SETB 1 00090000 AIF ('&MF' EQ 'L').RTEL 00100000 AIF ('&MF' EQ 'I').TESTI 00110000 AIF (N'&MF LE 1).ERROR3 00120000 AIF ('&MF(1)' NE 'E').ERROR3 00130000 &CNAME IHBINNRA &MF(2) 00140000 .ISSSVC AIF ('&PAR1' EQ '').SVCSVC 00150000 .LOOPA AIF ('&PAR1(&NUMBER)' NE '').GETOUT 00160000 &NUMBER SETA &NUMBER-1 00170000 AIF (&NUMBER EQ 0).SVCSVC 00180000 AGO .LOOPA 00190000 .GETOUT AIF ('&PAR1'(1,2) EQ '(,').NULLONE 00200000 .LOOPB AIF ('&PAR1(&CTR)' EQ '').NULLONE 00210000 .TESTCTR AIF (&CTR EQ &NUMBER).QUITNOW 00220000 .TESTTWO AIF ('&PAR1(&CTR1)' EQ '').NULLTWO 00230000 &MFESW SETB 1 00240000 AGO .CLRSW 00250000 .NULLONE ANOP 00260000 &NULLSW SETB 1 00270000 AGO .TESTCTR 00280000 .ERTRTRN AIF (&CTR1 EQ &NUMBER).THRUNOW 00290000 AIF (&NULLSW).NOFIRST 00300000 AIF ('&PAR1(&CTR)'(1,1) EQ '(').REGISTR 00310000 LA 14,&PAR1(&CTR) PICK UP DCB ADDRESS 00320000 ST 14,&ACTR.(1,0) STORE INTO LIST 00330000 MVI &ACTR.(1),&ASUM MOVE IN OPTION BYTE 00340000 AGO .INCRMT 00350000 .REGISTR ANOP 00360000 &LGTH SETA K'&PAR1(&CTR)-2 00370000 &PARA SETC '&PAR1(&CTR)'(2,&LGTH) 00380000 ST &PARA,&ACTR.(1,0) STORE DCB ADDR IN LIST 00390000 MVI &ACTR.(1),&ASUM MOVE IN OPTION BYTE 00400000 AGO .INCRMT 00410000 .NOFIRST MVI &ACTR.(1),&ASUM MOVE IN OPTION BYTE 00420000 AGO .INCRMT 00430000 .NULLTWO AIF (&NULLSW).INCRMT 00440000 AIF ('&PAR1(&CTR)'(1,1) EQ '(').REGSTER 00450000 IC 14,&ACTR.(1,0) SAVE OPTION BYTE 00460000 LA 0,&PAR1(&CTR) PICK UP DCB ADDRESS 00470000 ST 0,&ACTR.(1,0) STORE INTO LIST 00480000 STC 14,&ACTR.(1,0) RESTORE OPTION BYTE 00490000 AGO .INCRMT 00500000 .REGSTER IC 14,&ACTR.(1,0) SAVE OPTION BYTE 00510000 &LGTH SETA K'&PAR1(&CTR)-2 00520000 &PARA SETC '&PAR1(&CTR)'(2,&LGTH) 00530000 ST &PARA,&ACTR.(1,0) STORE DCB ADDR IN LIST 00540000 STC 14,&ACTR.(1,0) RESTORE OPTION BYTE 00550000 AGO .INCRMT 00560000 .QUITNOW IC 14,&ACTR.(1,0) SAVE OPTION BYTE 00570000 AIF ('&PAR1(&CTR)'(1,1) EQ '(').REGST 00580000 LA 0,&PAR1(&CTR) PICK UP DCB ADDRESS 00590000 ST 0,&ACTR.(1,0) STORE INTO LIST 00600000 STC 14,&ACTR.(1,0) RESTORE OPTION BYTE 00610000 AGO .SVCSVC 00620000 .REGST ANOP 00630000 &LGTH SETA K'&PAR1(&CTR)-2 00640000 &PARA SETC '&PAR1(&CTR)'(2,&LGTH) 00650000 ST &PARA,&ACTR.(1,0) STORE DCB ADDR IN LIST 00660000 STC 14,&ACTR.(1,0) RESTORE OPTION BYTE 00670000 AGO .SVCSVC 00680000 .THRUNOW NI &ACTR.(1),X'80' CLEAR OPTION BITS 00690000 OI &ACTR.(1),&ASUM SET OPTION BITS 00700000 AIF (&NULLSW).SVCSVC 00710000 AGO .QUITNOW 00720000 .INCRMT ANOP 00730000 &CTR SETA &CTR+2 00740000 &CTR1 SETA &CTR1+2 00750000 &ACTR SETA &ACTR+4 00760000 &NULLSW SETB 0 00770000 AGO .LOOPB 00780000 .SVCSVC AIF ('&MF' EQ 'I').SVCSVC1 00790000 CNOP 0,4 00800000 .SVCSVC1 L 15,*+8 LOAD CLOSESB ADDR. 00810000 B *+8 BRANCH AROUND 00820000 DC V(IOCLSESB) 00830000 BALR 14,15 LINK TO CLOSESB ROUTINE 00840000 AIF ('&TYPE' NE 'T').SVC20 00850000 SVC 23 ISSUE TCLOSE SVC 00860000 MEXIT 00870000 .SVC20 SVC 20 ISSUE CLOSE SVC 00880000 MEXIT 00890000 .RTEL ANOP 00900000 &CNAME DS 0F 00910000 .CLRSW ANOP 00920000 &ASUM SETA 0 00930000 AIF ('&PAR1' EQ '').ERROR5 00940000 AIF (&CTR1 GT &NUMBER).J 00950000 AIF ('&PAR1(&CTR1)' EQ '').DC1 00960000 &B(1) SETB ('&PAR1(&CTR1)' EQ 'REREAD') 00970000 &B(2) SETB ('&PAR1(&CTR1)' EQ 'LEAVE') 00980000 &B(3) SETB ('&PAR1(&CTR1)' EQ 'DISP') 00990000 AIF (&B(1)+&B(2)+&B(3) NE 1).ERROR2 01000000 AIF (&B(3) AND '&TYPE' EQ 'T').ERROR2 01010000 &ASUM SETA 16*&B(1)+48*&B(2) 01020000 .DC1 AIF (&MFESW).ERTRTRN 01030000 AIF (&CTR+2 GT &NUMBER).J 01040000 AIF (&MFI2SW).I2ROUT 01050000 AIF (&MFISW).IROUTRN 01060000 AGO .K 01070000 .J ANOP 01080000 &LOOPSW SETB 0 01090000 &ASUM SETA &ASUM+128 01100000 .SKIPT AIF (&MFI2SW).I2ROUT 01110000 AIF (&MFISW).IROUTRN 01120000 .K ANOP 01130000 DC AL1(&ASUM) OPTION BYTE 01140000 AIF ('&PAR1(&CTR)' EQ '').ISBLANK 01150000 AIF ('&PAR1'(1,2) NE '(,' OR &CTR NE 1).NOBLANK 01160000 .ISBLANK DC AL3(0) DCB ADDRESS 01170000 AGO .NOTLST 01180000 .NOBLANK ANOP 01190000 AIF ('&PAR1(&CTR)'(1,1) EQ '(').ERROR6 01200000 .COMMON DC AL3(&PAR1(&CTR)) DCB ADDRESS 01210000 .NOTLST ANOP 01220000 &CTR SETA &CTR+2 01230000 &CTR1 SETA &CTR1+2 01240000 AIF (&LOOPSW).CLRSW 01250000 AGO .FINI 01260000 .TESTI CNOP 0,4 01270000 &LGTH SETA ((&NUMBER+1)/2)*4+4 01280000 &CNAME BAL 1,*+&LGTH BRANCH AROUND LIST 01290000 &MFISW SETB 1 01300000 .RTEYE AIF ('&PAR1(&CTR)' EQ '').ERROR5 01310000 AIF ('&PAR1(&CTR)'(1,1) NE '(').CLRSW 01320000 DC A(0) OPTION AND DCB ADDRESS 01330000 AGO .UPCTRS 01340000 .IROUTRN DC AL1(&ASUM) OPTION BYTE 01350000 DC AL3(&PAR1(&CTR)) DCB ADDRESS 01360000 .UPCTRS AIF (&CTR1 GE &NUMBER).QUITS 01370000 &CTR SETA &CTR+2 01380000 &CTR1 SETA &CTR1+2 01390000 AGO .RTEYE 01400000 .QUITS ANOP 01410000 &CTR SETA 1 01420000 &CTR1 SETA 2 01430000 .ILOOP2 AIF ('&PAR1(&CTR)'(1,1) NE '(').UPCTR2 01440000 &LGTH SETA K'&PAR1(&CTR)-2 01450000 &PARA SETC '&PAR1(&CTR)'(2,&LGTH) 01460000 ST &PARA,&ACTR.(1,0) STORE DCB ADDRESS 01470000 &MFI2SW SETB 1 01480000 AGO .CLRSW 01490000 .I2ROUT AIF (&ASUM EQ 0).UPCTR2 01500000 MVI &ACTR.(1),&ASUM MOVE IN OPTION BYTE 01510000 .UPCTR2 AIF (&CTR1 GE &NUMBER).SVCSVC 01520000 &CTR SETA &CTR+2 01530000 &CTR1 SETA &CTR1+2 01540000 &ACTR SETA &ACTR+4 01550000 AGO .ILOOP2 01560000 .ERROR2 IHBERMAC 49,,&PAR1(&CTR1) 01570000 MEXIT 01580000 .ERROR3 IHBERMAC 35,,&MF 01590000 MEXIT 01600000 .ERROR5 IHBERMAC 06 01610000 MEXIT 01620000 .ERROR6 IHBERMAC 69 01630000 .FINI MEND 01640000 ./ ADD NAME=CLOSS DSN=CL.REM.UMAC MACRO 00001000 &NAME CLOSS &T,&REW=NO 00002000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00003000 AIF ('&REW' EQ 'YES').REW 00004000 CLOSE (IEUIO&T) PERMANENT CLOSE 00005000 AGO .LOAD 00006000 .REW CLOSE (IEUIO&T,REREAD) 00007000 .LOAD LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00008000 MEND 00009000 ./ ADD NAME=CONVERT DSN=CL.REM.UMAC MACRO 00000100 CONVERT &VALUE=,&DIGITS=,&TO= 00000200 GBLA &HEX 00000300 GBLB &QUITB 00000400 GBLC &EBCDIC 00000500 LCLA &A,&B,&C(8),&D 00000600 LCLC &CA 00000700 &EBCDIC SETC '' 00000800 &HEX SETA 0 00000900 AIF ('&TO' EQ 'HEX').TOHEX 00001000 AIF ('&TO' EQ 'EBCDIC').TOEBCDC 00001100 MNOTE 0,'*** CONVERT ''TO'' VALUE NOT SPECIFED OR INVALID' 00001200 &QUITB SETB 1 00001300 MEXIT 00001400 .TOEBCDC ANOP 00001500 &A SETA &VALUE 00001600 &B SETA &DIGITS+1 00001700 &D SETA &A/65536 SHIFT RIGHT 16 POSITIONS. 00001800 &C(8) SETA &D/4096 SHIFT RIGHT 12 POSITIONS. 00001900 &C(7) SETA &D/256-16*&C(8) SHIFT D RIGHT 8 & C LEFT 4-GET 4 ZEROS. 00002000 &C(6) SETA &D/16-&D/256*16 SHIFT D RIGHT 8 & 4 MORE TO GET 4 0'S. 00002100 &C(5) SETA &D-&D/16*16 00002200 &C(4) SETA &A/4096-16*&D 00002300 &C(3) SETA &A/256-&A/4096*16 00002400 &C(2) SETA &A/16-&A/256*16 00002500 &C(1) SETA &A-&A/16*16 00002600 .BACK AIF (&B EQ 1).FINI 00002700 &B SETA &B-1 00002800 &EBCDIC SETC '&EBCDIC'.'0123456789ABCDEF'(&C(&B)+1,1) 00002900 AGO .BACK 00003000 .TOHEX AIF (&B EQ &DIGITS).FINI 00003100 &B SETA &B+1 00003200 &CA SETC '&VALUE'(&B,1) 00003300 AIF ('&CA' GE '0').ZERTO9 00003400 AIF ('&CA' EQ 'A').AX 00003500 AIF ('&CA' EQ 'B').BX 00003600 AIF ('&CA' EQ 'C').CX 00003700 AIF ('&CA' EQ 'D').DX 00003800 AIF ('&CA' EQ 'E').EX 00003900 AIF ('&CA' EQ 'F').FX 00004000 MNOTE 0,'*** CONVERT VALUE=&VALUE IS NOT CONVERTABLE' 00004100 &QUITB SETB 1 00004200 MEXIT 00004300 .ZERTO9 ANOP 00004400 &HEX SETA &HEX*16+&CA 00004500 AGO .TOHEX 00004600 .AX ANOP 00004700 &HEX SETA &HEX*16+X'A' 00004800 AGO .TOHEX 00004900 .BX ANOP 00005000 &HEX SETA &HEX*16+X'B' 00005100 AGO .TOHEX 00005200 .CX ANOP 00005300 &HEX SETA &HEX*16+X'C' 00005400 AGO .TOHEX 00005500 .DX ANOP 00005600 &HEX SETA &HEX*16+X'D' 00005700 AGO .TOHEX 00005800 .EX ANOP 00005900 &HEX SETA &HEX*16+X'E' 00006000 AGO .TOHEX 00006100 .FX ANOP 00006200 &HEX SETA &HEX*16+X'F' 00006300 AGO .TOHEX 00006400 .FINI ANOP 00006500 MEXIT 00006600 MEND 00006700 ./ ADD NAME=DBD DSN=CL.REM.UMAC MACRO 00000010 DBD &NAME=,&ACCESS=ISAM 00000020 COPY GLOBALS 00000030 &D SETA 0 00000040 &S SETA 0 00000050 &F SETA 0 00000060 &W SETA 0 00000070 &W1 SETA 0 00000080 &W2 SETA 0 00000090 &W3 SETA 0 00000100 .* 00000110 AIF (&DB GE 1).NODBD 00000120 &DB SETA &DB+1 00000130 &CSECT(&DB) SETB 0 00000140 AIF ('&NAME' EQ '').EN 00000150 &DBN SETC '&NAME' 00000160 &DBA SETC '1' 00000170 AIF ('&ACCESS' EQ 'ISAM').ISAM 00000180 AIF ('&ACCESS' EQ 'INDX').ISAM 00000190 &DBA SETC '3' 00000200 AIF ('&ACCESS' EQ 'SAM').SAM 00000210 AIF ('&ACCESS' EQ 'SEQ').SAM 00000220 .EACC MNOTE 8,'---DBD010---INCORRECT OR MISSING ACCESS METHOD SPEC' 00000230 &CSECT(&DB) SETB 1 00000240 MEXIT 00000250 .EN MNOTE 8,'---DBD020--- DBD NAME PARAMETER NOT SPECIFIED' 00000260 &CSECT(&DB) SETB 1 00000270 MEXIT 00000280 .NODBD MNOTE 8,'---DBD030--- TO MANY DBD CARDS' 00000290 &CSECT(&DB) SETB 1 00000300 MEXIT 00000310 .ISAM ANOP 00000320 .SAM ANOP 00000330 MEND 00000340 ./ ADD NAME=DBDFP DSN=CL.REM.UMAC MACRO 00000010 DBDFP 00000020 COPY GLOBALS 00000030 &W SETA &W1 00000040 AIF ('&SPN(&W1)' NE '0').FP 00000050 &RS SETB 1 00000060 &SL(&W1) SETA 1 00000070 MEXIT 00000080 .FP AIF (&RS EQ 0).ERR 00000090 AIF ('&SPN(&W1)' EQ '&SN(&W2)').RTN 00000100 AIF (&W2 EQ &W1).ERR NOT USED IN PSBGEN EARL C 4/25 00000110 &W2 SETA &W2+1 00000120 AGO .FP 00000130 .ERR MNOTE 8,'---DGEN10--- SEGMENT &SN(&W1) PARENT &SPN(&W1) NOT X00000140 FOUND ' 00000150 &CSECT(&DB) SETB 1 00000160 MEXIT 00000170 .ERR2 MNOTE 8,'---DGEN70--- TOO MANY SEGMENT LEVELS IN HIERARCHY' 00000180 &CSECT(&DB) SETB 1 00000190 MEXIT 00000200 .RTN ANOP 00000210 AIF (&W2 EQ &W1).ERR 00000220 &SPP(&W1) SETA &W2 00000230 &SL(&W1) SETA &SL(&W2)+1 00000240 &SPD(&W1) SETA &SD(&W2) 00000250 AIF (&SL(&W1) GE 16).ERR2 00000260 AIF ('&SPN(&W2)' EQ '0').SL 00000270 .SL ANOP 00000280 AIF ( &SL(&W1) LT &L ).END 00000290 &L SETA (&SL(&W1)) 00000300 .END ANOP 00000310 MEND 00000320 ./ ADD NAME=DBDFP1 DSN=CL.REM.UMAC MACRO 00000100 DBDFP1 00000200 COPY PGLOB 00000300 &W SETA &W1 00000400 AIF ('&SPN(&W1)' NE '0').FP 00000500 &RS SETB 1 00000600 &SL(&W1) SETA 1 00000700 MEXIT 00000800 .FP AIF (&RS EQ 0).ERR 00000900 AIF ('&SPN(&W1)' EQ '&SN(&W2)').RTN 00001000 &W2 SETA &W2+1 00001100 AGO .FP 00001200 .ERR MNOTE 8,'---PGEN60--- SEGMENT &SN(&W1) PARENT &SPN(&W1) NOT X00001300 FOUND ' 00001400 MEXIT 00001500 .RTN ANOP 00001600 AIF (&W2 EQ &W1).ERR 00001700 &SPP(&W1) SETA &W2 00001800 &SL(&W1) SETA &SL(&W2)+1 00001900 AIF ('&SPN(&W2)' EQ '0').SL 00002000 &SF(&W1) SETA (&SF(&W1)*&SF(&W2)/100) 00002100 .SL ANOP 00002200 AIF ( &SL(&W1) LT &L ).END 00002300 &L SETA (&SL(&W1)) 00002400 .END ANOP 00002500 MEND 00002600 ./ ADD NAME=DBDGEN DSN=CL.REM.UMAC MACRO 00000100 DBDGEN 00000200 COPY GLOBALS 00000300 GBLA &F1,&F2,&F3 00000400 GBLC &FN1(255),&FN2(255),&FN3(255) 00000500 GBLC &FT1(255),&FT2(255),&FT3(255) 00000600 GBLA &FB1(255),&FB2(255),&FB3(255) 00000700 GBLA &FST1(255),&FST2(255),&FST3(255) 00000800 GBLA &FS1(255),&FS2(255),&FS3(255) 00000900 GBLA &HEX 00001000 GBLC &EBCDIC 00001100 GBLB &QUITB 00001200 GBLA &W10,&W11,&W12 00001300 LCLA &RKP 00001400 LCLA &SF100 00001500 LCLA &SSIBUF 00001600 LCLA &ALLRECL 00001700 LCLA &ALLBLKS 00001800 LCLC &SSI 00001900 LCLA &W6,&W7,&W8 00002000 ACTR 20000 00002100 .* 00002200 .* FIND SEGMENT P ARENTS AND NUMBER OF FIELDS 00002300 .* FIND NO OF LEVELS 00002400 .* 00002500 .* 00002600 &RS SETB 0 00002700 &W1 SETA 0 00002800 &W2 SETA 0 00002900 &L SETA 1 00003000 .LOOP ANOP 00003100 &W1 SETA &W1+1 00003200 &W2 SETA 1 00003300 .NR DBDFP 00003400 AIF (&W1 LT &S).LOOP 00003500 AIF (&CSECT(&DB)).MEXIT8 00003600 &DBC SETC '1' 00003700 AIF (&D GT 1).CASE2 00003800 AIF (&S EQ 1).OK 00003900 AIF ('&DBA' NE '1').NOTISAM 00004000 AGO .OK 00004100 .CASE2 ANOP 00004200 &DBC SETC '2' 00004300 AIF ('&DBA' EQ '1').OK 00004400 MNOTE 8,'---DGEN20--- INVALID NUMBER OF DMAN CARDS FOR ACCESSX00004500 METHOD SPECIFIED' 00004600 AGO .MEXIT8 00004700 .NOTISAM ANOP 00004800 &DBA SETC '4' 00004900 .OK ANOP 00005000 &W4 SETA &S 00005100 &W3 SETA &D 00005200 &D SETA 1 00005300 .* 00005400 .* LRECL AND BLKSIZE CALCULATION 00005500 .* 00005600 .CAGAIN ANOP 00005700 AIF (&DE(&D) EQ 0).LRECLZ 00005800 &LRL(&D) SETA &DE(&D) 00005900 AIF ('&DBA' NE '3').NOTSSAM 00005910 AIF (&LRL(&D) EQ (&SB(1)-2)).NOTSSAM 00005920 &LRL(&D) SETA &SB(1)-2 00005930 MNOTE *,'---DGEN---SINGLE SEGMENT HSAM LRECL = SEG LENGTH' 00005940 MNOTE *,'---DGEN---DEFAULT BLOCK SIZE USED' 00005950 AGO .SSUB3 00005960 .NOTSSAM ANOP 00005970 &BLK(&D) SETA &DT(&D)*&LRL(&D) 00006000 &BL(&D) SETA &WA(&D)/&BLK(&D) 00006100 &WX(&D) SETA &BLK(&D) 00006200 AIF ('&DBA' LE '2').REG 00006210 AIF (&WA(&D) EQ 2000).DBD000 00006220 AIF (&BLK(&D) LE &WA(&D)).DBD000 00006230 AIF ('&DBA' EQ '3').SSUB3 00006240 AGO .HSUB0 00006250 AGO .REG 00006300 .* 00006400 .* ROUTINE FOR LRECL 00006500 .* 00006600 .LRECLZ ANOP 00006700 &S SETA 1 00006800 .FS AIF (&SD(&S) EQ &D).RS 00006900 &S SETA &S+1 00007000 AIF (&S LE &W4).FS 00007100 MNOTE 8,'---DGEN40--- NO SEGMENTS FOR DMAN &D' 00007200 &CSECT(&DB) SETB 1 00007300 MEXIT 00007400 .RS ANOP 00007500 AIF ('&SPN(&S)' NE '0').ZZ 00007600 &LRL(&D) SETA &SB(&S) 00007700 AGO .LR 00007800 .ZZ ANOP 00007900 &LRL(&D) SETA &SB(&S)*&SF(&S) 00008000 .LR ANOP 00008100 &S SETA &S+1 00008200 AIF (&S GT &W4).LRE 00008300 AIF (&SD(&S) NE &D).LRE 00008400 AIF ('&SPN(&S)' NE '0').BYP 00008500 .VAC ANOP 00008600 &LRL(&D) SETA &LRL(&D)+(&SB(&S)*&SF(&S)) 00008700 AIF (&LRL(&D) GE &SB(&S)).LRLSB 00008710 &LRL(&D) SETA &LRL(&D)+&SB(&S) 00008720 .LRLSB ANOP 00008730 AGO .LR 00008800 .BYP ANOP 00008900 &W1 SETA &S 00009000 &W2 SETA 1 00009100 DBDFP 00009200 .* FIND PARENT'S FREQ - RETURNED AS &W2 00009300 AIF (&W2 EQ 1).VAC 00009400 AIF (&SL(&S) EQ 2).VAC 00009500 &LRL(&D) SETA &LRL(&D)+(&SB(&S)*&SF(&S)*&SF(&W2)) 00009600 &SF(&S) SETA &SF(&S)*&SF(&W2) 00009650 AIF (&LRL(&D) GE &SB(&S)).LRLSB1 00009660 &LRL(&D) SETA &LRL(&D)+&SB(&S) 00009670 .LRLSB1 ANOP 00009680 AGO .LR 00009700 .LRE ANOP 00009800 AIF ('&DBA' EQ '3').SSUB2 00009900 AIF ('&DBA' EQ '4').HSUB0 00010000 &LRL(&D) SETA &LRL(&D)+3+4 3 FOR ROOT PTR 4 FOR SECOND PTR 00010100 AIF (&D EQ 1).NOMORE 00010200 &LRL(&D) SETA &LRL(&D)+&FB(1) 00010300 .NOMORE ANOP 00010400 .* 00010500 .* ROUTINE FOR BLOCKSIZE 00010600 .* 00010700 AIF (&LRL(&D) LE &WB(&D)).REG 00010800 MNOTE *,'---DGEN--- LRECL CALCULATED GREATER THAN HALF TRACK' 00010900 MNOTE *,'--- LRECL-DSG&D = ''&LRL(&D)'' ' 00011000 &LRL(&D) SETA &WB(&D)-&FB(1) 00011100 .REG ANOP 00011200 AIF (&LRL(&D) EQ (&WB(&D)-&FB(1))).XXREGX 00011220 MNOTE *,'---DGEN---LRECL CALCULATED LESS THAN HALF TRACK' 00011240 MNOTE *,'---LRECL-DSG&D = ''&LRL(&D)'' ' 00011260 .XXREGX ANOP 00011280 &DA(&D) SETA (&DAE(&D)*(&FB(1)+10)/&DAF(&D))+&DAC(&D)+&DAD(&D) 00011300 &DE(&D) SETA (&FB(1)+10+&DAC(&D)) 00011400 &DC(&D) SETA &WA(&D) 00011500 &DD(&D) SETA ((&DC(&D)-&DE(&D))/&DA(&D)+1) 00011600 AIF (&DT(&D) EQ 0).NORMZ 00011700 AGO .NORMX 00011800 .NORMZ ANOP 00011900 &BLA(&D) SETA ((&WB(&D)-&FB(1))/&LRL(&D))*2 00012000 &BLB(&D) SETA ((&WC(&D)-&FB(1))/&LRL(&D))*3 00012100 &BLC(&D) SETA ((&WD(&D)-&FB(1))/&LRL(&D))*4 00012200 &B1 SETB (&BLA(&D) GE &BLB(&D)) A>B 00012300 &B2 SETB (&BLB(&D) GE &BLA(&D)) B>A 00012400 &B3 SETB (&BLA(&D) GE &BLC(&D)) A>C 00012500 &B4 SETB (&BLC(&D) GE &BLA(&D)) C>A 00012600 &B5 SETB (&BLB(&D) GE &BLC(&D)) B>C 00012700 &B6 SETB (&BLC(&D) GE &BLB(&D)) C>B 00012800 &B7 SETB (&B1 AND &B3) A>B AND A>C 00012900 AIF (&B7).B7 00013000 &B8 SETB (&B2 AND &B5) B>A AND B>C 00013100 AIF (&B8).B7 00013200 &B9 SETB (&B4 AND &B6) C>A AND C>B 00013300 AIF (&B9).B7 00013400 &B7 SETB 1 00013500 .B7 ANOP 00013600 &BL(&D) SETA &BLA(&D)*(&B7)+&BLB(&D)*(&B8)+&BLC(&D)*(&B9) 00013700 &$ SETA &WB(&D) 00013800 &@ SETA &WC(&D) 00013900 &# SETA &WD(&D) 00014000 &WX(&D) SETA &$*&B7+&@*&B8+&#*&B9 00014100 &QUO(&D) SETA (&WX(&D)-&FB(1))/&LRL(&D) 00014200 &REM(&D) SETA (&WX(&D)-&FB(1))-&QUO(&D)*&LRL(&D) 00014300 &LRL(&D) SETA &LRL(&D)+&REM(&D)/&QUO(&D) 00014400 &BLK(&D) SETA &LRL(&D)*&QUO(&D) BLKSIZE RECOMPUTED 00014500 &B1 SETB 0 00014505 &B2 SETB 0 00014510 &B3 SETB 0 00014515 &B4 SETB 0 00014520 &B5 SETB 0 00014525 &B6 SETB 0 00014530 &B7 SETB 0 00014540 &B8 SETB 0 00014545 &B9 SETB 0 00014550 .NORMX ANOP 00014600 &BN(&D) SETA 1 00014700 .LALLOC ANOP 00014800 &DD(&D) SETA &DD(&D)*&BN(&D) 00014900 &WX(&D) SETA (&TRCYL(&D)-&BN(&D))*2 00015000 AIF (&DD(&D) GE &WX(&D)).LYES 00015100 &BN(&D) SETA &BN(&D)+1 00015200 AIF (&BN(&D) EQ 10).MMNN 00015300 AGO .LALLOC 00015400 .MMNN MNOTE *,' SOMETHING IS WRONG' 00015500 MEXIT 00015600 .LYES ANOP 00015700 &DD(&D) SETA &DD(&D)/&BN(&D) 00015900 &BLCIN(&D) SETA &BL(&D)*(&TRCYL(&D)-&BN(&D)) 00016000 &PRIME(&D) SETA (&SF(1)/&BLCIN(&D))+1 00016100 &CYLIND(&D) SETA (&PRIME(&D)/&TRCYL(&D))/&DD(&D)+1 00016200 AGO .DBD000 00016400 .SSUB2 ANOP 00016500 &LRL(&D) SETA &LRL(&D)-2 00016600 .SSUB3 ANOP 00016605 AIF (&LRL(&D) LE &WB(&D)).SSUBX 00016610 &BLK(&D) SETA &WA(&D)/&LRL(&D) 00016620 &BLK(&D) SETA &BLK(&D)*&LRL(&D) 00016630 AGO .DBD000 00016640 .SSUBX ANOP 00016650 &BLK(&D) SETA &WB(&D)/&LRL(&D) 00016660 &BLK(&D) SETA &BLK(&D)*&LRL(&D) 00016670 AGO .DBD000 00016680 .HSUB0 ANOP 00016700 &WA(&D) SETA &WB(&D) 00016800 AIF (&LRL(&D) LE &WA(&D)).JBLK 00016900 &LRL(&D) SETA &WA(&D) 00017000 .JBLK ANOP 00017100 &BLK(&D) SETA &WA(&D) 00017200 .DBD000 ANOP 00017300 &D SETA &D+1 00017400 AIF (&D GT &W3).CALEND 00017500 AGO .CAGAIN 00017600 .CALEND ANOP 00017700 &S SETA &W4 00017800 &D SETA 1 00017900 .SSIAGN ANOP 00018000 &ALLBLKS SETA (&ALLBLKS+&BLK(&D)+35) 00018100 &ALLRECL SETA (&ALLRECL+&LRL(&D)+19) 00018200 &D SETA &D+1 00018300 AIF (&D GT &W3).SSIEND 00018400 AGO .SSIAGN 00018500 .SSIEND ANOP 00018600 &D SETA &W3 00018700 &SSIBUF SETA (4*&ALLRECL+&ALLBLKS) 00018800 CONVERT VALUE=&SSIBUF,DIGITS=8,TO=EBCDIC 00018900 PUNCH ' SETSSI &EBCDIC ' 00019000 &DBN CSECT 00019100 *********************************************************************** 00019200 * * 00019300 * VECTOR TABLE * 00019400 * * 00019500 *********************************************************************** 00019600 DS 0D 00019700 DC A(PREFIX&DB,SEGMTAB&DB,FLDTAB&DB,DCBTAB&DB) 00019800 *********************************************************************** 00019900 * * 00020000 * PREFIX * 00020100 * * 00020200 *********************************************************************** 00020300 DS 0F 00020400 .* FIND LONGEST KEY 00020500 &W SETA (&FB(1)) INIT KEY LENGTH 00020600 &W2 SETA 1 INIT KEY COUNTER 00020700 .KLTOP ANOP 00020800 AIF ('&FT(&W2)'(1,1) NE '1').KL KEY? 00020900 AIF (&FB(&W2) LE &W1).KL LONGER THAN LAST? 00021000 &W1 SETA &FB(&W2) YES, SET TO NEW LENGTH 00021100 .KL ANOP 00021200 &W2 SETA &W2+1 00021300 AIF (&W2 LE &F).KLTOP 00021400 PREFIX&DB DC CL8'&DBN' DBD NAME 00021500 DC XL1'0&DBC' CASE 00021600 DC XL1'0&D' NO OF DATA SET GROUPS 00021700 DC H'&L' NO OF LEVELS 00021800 DC H'&S' NO OF ENTRIES IN SEGTAB 00021900 DC XL1'0&DBA' ACCESS METHOD 00022000 MNOTE *,'----------------------------------------------------' 00022100 MNOTE *,'----------------------------------------------------' 00022200 MNOTE *,'--- DBDNAME = ''&DBN'' ' 00022300 MNOTE *,'--- DL/I CASE = ''&DBC'' ' 00022400 MNOTE *,'--- #DATA SET GROUPS = ''&D'' ' 00022500 MNOTE *,'--- #LEVELS = ''&L'' ' 00022600 MNOTE *,'--- #SEGMENTS = ''&S'' ' 00022700 MNOTE *,'----------------------------------------------------' 00022800 AIF ('&W1' EQ '256').KEY256 00022900 &W1 SETA &W1/4 00023000 &W1 SETA &W1+1 00023100 &W1 SETA 4*&W1 00023200 .KEY256 ANOP 00023300 DC AL1(&W1) LENGTH OF LONGEST KEY 00023400 .* 00023500 .* THIS IS THE DMANTAB GENERATION SECTION 00023600 .* 00023700 &W3 SETA &D 00023800 &D SETA 1 00023900 .* 00024000 .* LOOP ON &D UNTIL GT &W3 00024100 DS 0F 00024200 DMANTAB&DB EQU * 00024300 MNOTE *,'****************************************************' 00024400 MNOTE *,'****************************************************' 00024500 .AGAIN ANOP 00024600 MNOTE *,'--- DEVICE = ''&DV1(&D)'' ' 00024700 DC CL4'&DV1(&D)' DEV1 00024800 DC CL8'&D1(&D)' DD1 00024900 MNOTE *,'--- DDNAME-1 = ''&D1(&D)'' ' 00025000 AIF ('&DBA' EQ '3').BL1 00025100 AIF ('&DBA' EQ '4').BL1 00025200 DC CL8'&DO(&D)' DLIOF 00025300 MNOTE *,'--- DDDLIOF = ''&DO(&D)'' ' 00025400 AGO .DD2 00025500 .BL1 ANOP 00025600 DC CL8'&D2(&D)' DD2 00025700 MNOTE *,'--- DDNAME-2 = ''&D2(&D)'' ' 00025800 AGO .DAM1 00025900 .DD2 ANOP 00026000 .DAM1 AIF ('&DBA' NE '2').AFOUND 00026100 MNOTE 8,'---DGEN30--- DAM NOT SUPPORTED' 00026200 &CSECT(&DB) SETB 1 00026300 MEXIT 00026400 .AFOUND ANOP 00026500 AIF ('&DBA' GT '2').SAMSONS 00026600 MNOTE *,'----------------------------------------------------' 00026700 DC H'&LRL(&D)' LRECL 00026800 MNOTE *,'--- LRECL-DSG&D = ''&LRL(&D)'' ' 00026900 DC H'&BLK(&D)' BLOCK SIZE 00027000 MNOTE *,'--- BLKSIZE-DSG&D= ''&BLK(&D)'' ' 00027100 MNOTE *,'----------------------------------------------------' 00027200 MNOTE *,'--- ALLOCATION PARAMETERS IN CYLINDERS -------------' 00027300 MNOTE *,'--- DATA SET GROUP ''&D'' -- DEVICE ''&DV1(&D)''' 00027400 MNOTE *,'----------------------------------------------------' 00027500 MNOTE *,'----------------------------------------------------' 00027600 MNOTE *,'--- ALLOCATION PRIME ------- ''&PRIME(&D)'' -- CYLS.' 00027700 MNOTE *,'--- ALLOCATION CYIND ------- ''&CYLIND(&D)''-- CYLS.' 00027800 MNOTE *,'****************************************************' 00027900 MNOTE *,'****************************************************' 00028000 AGO .CRAIG 00028100 .SAMSONS ANOP 00028200 MNOTE *,'----------------------------------------------------' 00028300 DC H'&LRL(&D)' LRECL 00028400 MNOTE *,'--- LRECL-DSG&D = ''&LRL(&D)'' ' 00028500 DC H'&BLK(&D)' BLOCK SIZE 00028600 MNOTE *,'--- BLKSIZE-DSG&D = ''&BLK(&D)'' ' 00028700 MNOTE *,'----------------------------------------------------' 00028800 MNOTE *,'****************************************************' 00028900 MNOTE *,'****************************************************' 00029000 .CRAIG ANOP 00029100 * 00029200 * 00029300 * 00029400 &D SETA &D+1 00029500 AIF (&D GT &W3).SEGMST 00029600 AGO .AGAIN 00029700 .SEGMST DC XL4'FFFFFFFF' 00029800 .* 00029900 .* THIS IS THE SEGTAB SECTION 00030000 .* 00030100 EJECT 00030200 *********************************************************************** 00030300 * * 00030400 * SEGMTAB * 00030500 * * 00030600 *********************************************************************** 00030700 &D SETA &W3 00030800 &S SETA &W4 00030900 &W2 SETA &F 00031000 &W6 SETA &F1 00031100 &W7 SETA &F2 00031200 &W8 SETA &F3 00031300 &W3 SETA &S 00031400 &S SETA 1 00031500 DS 0F 00031600 SEGMTAB&DB EQU * 00031700 .ENTRY ANOP 00031800 AIF (&SL(&S) LE 2).ENTRY1 00031900 AIF (&SPD(&S) EQ &SD(&S)).ENTRY1 00032000 MNOTE 8,'---DGEN80---1ST SEGM IN SECONDARY DSG IS LOWER THAN X00032100 2ND LEVEL' 00032200 &CSECT(&DB) SETB 1 00032300 MEXIT 00032400 .ENTRY1 ANOP 00032500 DC AL1(&S) PHYSICAL CODE 00032600 DC AL1(&SL(&S)) LEVEL 00032700 DC AL1(&SPP(&S)) PARENTS PHYSICAL CODE 00032800 DC AL1(&SD(&S)) DATA SET NUMBER 00032900 AIF ('&DBA' NE '3').SEGSSAM 00033000 &SB(&S) SETA &SB(&S)-2 00033100 .SEGSSAM ANOP 00033200 DC H'&SB(&S)' BYTE LENGTH 00033300 &Z SETA 0 00033400 &F SETA 1 00033500 &F1 SETA 1 00033600 &F2 SETA 1 00033700 &F3 SETA 1 00033800 .BACK AIF (&FS(&F) NE &S).ADD1 00033900 &Z SETA &Z+1 00034000 .ADD1 ANOP 00034100 &F SETA &F+1 00034200 AIF (&W2 GE &F).BACK 00034300 AIF (&W2 LT 255).OUT 00034400 .BACK1 AIF (&FS1(&F1) NE &S).ADD2 00034500 &Z SETA &Z+1 00034600 .ADD2 ANOP 00034700 &F1 SETA &F1+1 00034800 AIF (&W6 GE &F1).BACK1 00034900 &F1 SETA &F1-1 00035000 AIF (&W6 LT 255).OUT 00035100 .BACK2 AIF (&FS2(&F2) NE &S).ADD3 00035200 &Z SETA &Z+1 00035300 .ADD3 ANOP 00035400 &F2 SETA &F2+1 00035500 .BACK3 AIF (&FS3(&F3) NE &S).ADD4 00035600 AIF (&W7 GE &F2).BACK2 00035700 &F2 SETA &F2-1 00035800 AIF (&W7 LT 255).OUT 00035900 &Z SETA &Z+1 00036000 .ADD4 ANOP 00036100 &F3 SETA &F3+1 00036200 AIF (&W8 GE &F3).BACK3 00036300 &F3 SETA &F3-1 00036400 .OUT ANOP 00036500 DC H'&Z' NO OF FIELDS 00036600 DC CL8'&SN(&S)' NAME 00036700 AIF (&S LE 1).ROTSEG 00036800 &SF100 SETA &SF(&S)*100 00036900 DC F'&SF100' 00037000 AGO .NOTEX 00037100 .ROTSEG DC F'&SF(&S)' 00037200 .NOTEX MNOTE *,'----------------------------------------------------' 00037300 MNOTE *,'--- SEGNAME-&S= ''&SN(&S)'' ' 00037400 MNOTE *,'--- PHY.CODE = ''&S'' ' 00037500 MNOTE *,'--- PAR.PHYCDE= ''&SPP(&S)'' ' 00037600 MNOTE *,'--- LEVEL = ''&SL(&S)'' ' 00037700 MNOTE *,'--- LENGTH = ''&SB(&S)'' ' 00037800 MNOTE *,'--- #FIELDS = ''&Z'' ' 00037900 MNOTE *,'--- DATASET GROUP # = ''&SD(&S)'' ' 00038000 AIF (&S LE 1).NOTEY 00038100 MNOTE *,'--- DEP SEGMENT FREQ X 100 = ''&SF100'' ' 00038200 AGO .NOTEFRQ 00038300 .NOTEY MNOTE *,'--- ROOT SEG FREQUENCY = ''&SF(&S)'' ' 00038400 .NOTEFRQ ANOP 00038500 MNOTE *,'----------------------------------------------------' 00038600 .* LOOP BACK 00038700 .* 00038800 * 00038900 * 00039000 * 00039100 &S SETA &S+1 00039200 AIF (&W3 GE &S).ENTRY 00039300 &S SETA &W3 00039400 DC XL4'FFFFFFFF' 00039500 EJECT 00039600 *********************************************************************** 00039700 * * 00039800 * FLDTAB * 00039900 * * 00040000 *********************************************************************** 00040100 &F SETA 1 00040200 DS 0F 00040300 FLDTAB&DB EQU * 00040400 .ENTRYF ANOP 00040500 DC AL1(&FS(&F)) SEGS PHY CODE 00040600 DC X'&FT(&F)' TYPE CODE AND ENDFLAG 00040700 DC AL2(&FB(&F)-1) LENGTH 00040800 AIF ('&DBA' EQ '3').FLDSSAM 00040900 DC AL2(&FST(&F)+2-1) OFFSET 00041000 AGO .FLDOTHR 00041100 .FLDSSAM ANOP 00041200 DC AL2(&FST(&F)-1) FIELD OFFSET 00041300 .FLDOTHR ANOP 00041400 DC H'0' RESERVED FOR FUTURE USE 00041500 DC CL8'&FN(&F)' NAME 00041600 MNOTE *,'----------------------------------------------------' 00041700 AIF ('&FT(&F)' LT '10').NOTKEY 00041800 MNOTE *,'--- ***** KEY FIELD ****** -----------------' 00041900 .NOTKEY ANOP 00042000 MNOTE *,'--- FLDNAME-&F= ''&FN(&F)'' ' 00042100 MNOTE *,'--- LENGTH = ''&FB(&F)'' ' 00042200 MNOTE *,'--- SEG.PHYCDE= ''&FS(&F)'' ' 00042300 MNOTE *,'----------------------------------------------------' 00042400 * 00042500 * 00042600 * 00042700 &F SETA &F+1 00042800 AIF (&W2 GE &F).ENTRYF 00042900 AIF (&W2 GE 255).EN256 00043000 AGO .DCBTAB 00043100 .EN256 ANOP 00043200 &W2 SETA &F1 00043300 &F1 SETA 1 00043400 .ENTRYF1 ANOP 00043500 DC AL1(&FS1(&F1)) SEGMENT PHYSICAL CODE 00043600 DC X'&FT1(&F1)' TYPE CODE AND END FLAG 00043700 DC AL2(&FB1(&F1)-1) FIELD LENGTH 00043800 AIF ('&DBA' EQ '3').FLDSSA1 00043900 DC AL2(&FST1(&F1)+2-1) FIELD OFFSET 00044000 AGO .FLDOTH1 00044100 .FLDSSA1 ANOP 00044200 DC AL2(&FST1(&F1)-1) FIELD OFFSET FOR SSAM 00044300 .FLDOTH1 ANOP 00044400 DC H'0' RESERVED FOR FUTURE USE 00044500 DC CL8'&FN1(&F1)' FIELD NAME 00044600 MNOTE *,'----------------------------------------------------' 00044700 AIF ('&FT1(&F1)' LT '10').NOTKEY1 00044800 MNOTE *,'--- **** KEY FIELD ***** ----------------------' 00044900 .NOTKEY1 ANOP 00045000 &W10 SETA &F1+255 00045100 MNOTE *,'--- FLDNAME-&W10= ''&FN1(&F1)'' ' 00045200 MNOTE *,'--- LENGTH =''&FB1(&F1)'' ' 00045300 MNOTE *,'--- SEG.PHYCODE =''&FS1(&F1)'' ' 00045400 MNOTE *,'----------------------------------------------------' 00045500 &F1 SETA &F1+1 00045600 AIF (&W2 GE &F1).ENTRYF1 00045700 AIF (&W2 GE 255).EN512 00045800 AGO .DCBTAB 00045900 .EN512 ANOP 00046000 &W2 SETA &F2 00046100 &F2 SETA 1 00046200 .ENTRYF2 ANOP 00046300 DC AL1(&FS2(&F2)) SEGMENT PHYSICAL CODE 00046400 DC X'&FT2(&F2)' TYPE CODE AND END FLAG 00046500 DC AL2(&FB2(&F2)-1) FIELD LENGTH 00046600 AIF ('&DBA' EQ '3').FLDSSA2 00046700 DC AL2(&FST2(&F2)+2-1) FIELD OFFSET 00046800 AGO .FLDOTH2 00046900 .FLDSSA2 ANOP 00047000 DC AL2(&FST2(&F2)-1) FIELD OFFSET 00047100 .FLDOTH2 ANOP 00047200 DC H'0' RESERVED FOR FUTURE USE 00047300 DC CL8'&FN2(&F2)' FIELD NAME 00047400 MNOTE *,'----------------------------------------------------' 00047500 AIF ('&FT2(&F2)' LT '10').NOTKEY2 00047600 MNOTE *,'--- **** KEY FIELD ***** ----------------------' 00047700 .NOTKEY2 ANOP 00047800 &W11 SETA &F2+510 00047900 MNOTE *,'--- FLDNAME-&W11= ''&FN2(&F2)'' ' 00048000 MNOTE *,'--- LENGTH =''&FB2(&F2)'' ' 00048100 MNOTE *,'--- SEG.PHYCDE =''&FS2(&F2)'' ' 00048200 MNOTE *,'----------------------------------------------------' 00048300 &F2 SETA &F2+1 00048400 AIF (&W2 GE &F2).ENTRYF2 00048500 AIF (&W2 GE 255).EN767 00048600 AGO .DCBTAB 00048700 .EN767 ANOP 00048800 &W2 SETA &F3 00048900 &F3 SETA 1 00049000 .ENTRYF3 ANOP 00049100 DC AL1(&FS3(&F3)) SEGMENT PHYSICAL CODE 00049200 DC X'&FT3(&F3)' TYEP CODE AND END BYTE 00049300 DC AL2(&FB3(&F3)-1) FIELD LENGTH 00049400 AIF ('&DBA' EQ '3').FLDSSA3 00049500 DC AL2(&FST3(&F3)+2-1) FIELD OFFSET 00049600 AGO .FLDOTH3 00049700 .FLDSSA3 ANOP 00049800 DC AL2(&FST3(&F3)-1) FIELD OFFSET FOR SSAM 00049900 .FLDOTH3 ANOP 00050000 DC H'0' RESERVED FOR FUTURE USE 00050100 DC CL8'&FN3(&F3)' FIELD NAME 00050200 AIF ('&FT3(&F3)' LT '10').NOTKEY3 00050300 MNOTE *,'--- **** KEY FIELD ***** ----------------------' 00050400 .NOTKEY3 ANOP 00050500 &W12 SETA &F3+765 00050600 MNOTE *,'--- FLDNAME-&W12 =''&FN3(&F3)'' ' 00050700 MNOTE *,'--- LENGTH =''&FB3(&F3)'' ' 00050800 MNOTE *,'--- SEG.PHYCDE =''&FS3(&F3)'' ' 00050900 MNOTE *,'----------------------------------------------------' 00051000 &F3 SETA &F3+1 00051100 AIF (&W2 GE &F3).ENTRYF3 00051200 .DCBTAB ANOP 00051300 DC XL4'FFFFFFFF' 00051400 EJECT 00051500 MNOTE *,'----------------------------------------------------' 00051600 *********************************************************************** 00051700 * * 00051800 * DCBTAB * 00051900 * * 00052000 *********************************************************************** 00052100 DCBTAB&DB EQU * 00052200 &W SETA 1 00052300 DS 0F 00052400 .DCBACON AIF ('&DBA' EQ '1').ISAM 00052500 AIF ('&DBA' EQ '2').DAM 00052600 .SAM ANOP 00052700 *********************************************************************** 00052800 * * 00052900 * SAM INPUT DCB * 00053000 * * 00053100 *********************************************************************** 00053200 AIF ('&DBA' EQ '3').SAMCDE 00053300 DC X'0131' CODE AND DATA SET NO 00053400 AGO .HIN 00053500 .SAMCDE ANOP 00053600 DC X'0121' CODE AND DATA SET NO 00053700 .HIN ANOP 00053800 DC Y(DCBIE&W&DB-DCBI&W&DB-1) LENGTH - 1 00053900 DC A(DCBO&W&DB-8) ADDRESS OF NEXT DCB 00054000 DCBI&W&DB EQU * 00054100 DCB DSORG=PS, C00054200 MACRF=(RP), C00054300 RECFM=U, C00054400 BLKSIZE=&BLK(&W), C00054500 BUFNO=2, C00054600 DDNAME=&D1(&W) 00054700 DCBIE&W&DB EQU * 00054800 *********************************************************************** 00054900 * * 00055000 * SAM OUTPUT DCB * 00055100 * * 00055200 *********************************************************************** 00055300 AIF ('&DBA' EQ '3').SAMCDEO 00055400 DC X'0132' CODE AND DATA SET NO 00055500 AGO .HOUT 00055600 .SAMCDEO ANOP 00055700 DC X'0122' CODE AND DATA SET NO 00055800 .HOUT ANOP 00055900 DC Y(DCBOE&W&DB-DCBO&W&DB-1) LENGTH - 1 00056000 DC A(0) 00056100 DCBO&W&DB EQU * 00056200 DCB DSORG=PS, C00056300 MACRF=(WP), C00056400 RECFM=U, C00056500 BLKSIZE=&BLK(&W), C00056600 BUFNO=2, C00056700 DDNAME=&D2(&W) 00056800 DCBOE&W&DB EQU * 00056900 AGO .DCBEND 00057000 .ISAM ANOP 00057100 *********************************************************************** 00057200 * * 00057300 * QISAM LOAD DCB - USED FOR TYPE REGION DATA BASE LOAD * 00057400 * * 00057500 *********************************************************************** 00057600 &F SETA 1 FIX ACF 8-10-67 WRONG &F FOR CASE 2 00057700 AIF (&W EQ 1).DOK 00057800 &RKP SETA 3 00057900 AGO .NOTU 00058000 .DOK ANOP 00058100 &RKP SETA &FST(&F)+5-1 00058200 .NOTU ANOP 00058300 MNOTE *,'---------------------------------------------------' 00058400 MNOTE *,'-------- DATA SET GROUP ''&W'' ---------------' 00058500 MNOTE *,'------ RELATIVE KEY POSITION --- RKP ''&RKP'' ------' 00058600 MNOTE *,'---------------------------------------------------' 00058700 DC X'&W.11' CODE AND DATA SET NO 00058800 DC Y(DCBQLE&W&DB-DCBQL&W&DB-1) LENGTH - 1 00058900 DC A(DCBB&W&DB-8) ADDRESS OF NEXT DCB 00059000 DCBQL&W&DB EQU * 00059100 DCB DSORG=IS, C00059200 MACRF=(PM), C00059300 RECFM=FB,OPTCD=W, C00059400 LRECL=&LRL(&W), C00059500 BLKSIZE=&BLK(&W), C00059600 RKP=&RKP, FIX ACF 8-10-67 C00059700 KEYLEN=&FB(&F), C00059800 DDNAME=&D1(&W) 00059900 DC A(0) FILL FOR OSAM 00060000 DCBQLE&W&DB EQU * 00060100 *********************************************************************** 00060200 * * 00060300 * BISAM READ/WRITE UPDATE DCB - USED FOR MESSAGE OR TYPE 2 REG * 00060400 * * 00060500 *********************************************************************** 00060600 DC X'&W.12' CODE AND DATA SET NO 00060700 DC Y(DCBBE&W&DB-DCBB&W&DB-1) LENGTH - 1 00060800 DC A(DCBS&W&DB-8) ADDRESS OF NEXT DCB 00060900 DCBB&W&DB EQU * 00061000 DCB DSORG=IS, C00061100 MACRF=(RU,WU), C00061200 DDNAME=&D1(&W) 00061300 DC A(0) FILL FOR OSAM 00061400 DCBBE&W&DB EQU * 00061500 *********************************************************************** 00061600 * * 00061700 * OSAM DCB - USED FOR ALL OSAM DATA SET ACCESS * 00061800 * * 00061900 *********************************************************************** 00062000 DC X'&W.13' CODE AND DATA SET NO 00062100 DC Y(DCBSE&W&DB-DCBS&W&DB-1) LENGTH - 1 00062200 DC A(DCBQS&W&DB-8) ADDRESS OF NEXT DCB 00062300 DCBS&W&DB EQU * 00062400 IDCBOS DDNAME=&DO(&W),BLKLGTH=&LRL(&W) 00062500 DCBSE&W&DB EQU * 00062600 *********************************************************************** 00062700 * * 00062800 * QISAM SCAN MODE DCB - USED FOR GET AND PUTX IN TYPE 3 REGION * 00062900 * * 00063000 *********************************************************************** 00063100 DC X'&W.14' CODE AND DATA SET NO 00063200 DC Y(DCBQSE&W&DB-DCBQS&W&DB-1) LENGTH - 1 00063300 AIF (&W EQ &D).DCW 00063400 &W SETA &W+1 00063500 DC A(DCBQL&W&DB-8) ADDRESS OF NEXT DCB 00063600 &W SETA &W-1 00063700 AGO .UCW 00063800 .DCW ANOP 00063900 DC A(0) 00064000 .UCW ANOP 00064100 DCBQS&W&DB EQU * 00064200 DCB DSORG=IS, C00064300 MACRF=(GL,SK,PU), C00064400 DDNAME=&D1(&W) 00064500 DC A(0) FILL FOR OSAM 00064600 DCBQSE&W&DB EQU * 00064700 AIF (&W EQ &D).DCBEND 00064800 &W SETA &W+1 00064900 AGO .ISAM 00065000 .DAM MNOTE 8,'---DGEN50--- DAM NOT SUPPORTED' 00065100 &CSECT(&DB) SETB 1 00065200 MEXIT 00065300 .DCBEND ANOP 00065400 EJECT 00065500 *********************************************************************** 00065600 * * 00065700 * DBDGEN HAS COMPLETED GENERATION SUCCESSFULLY * 00065800 * * 00065900 *********************************************************************** 00066000 EJECT 00066100 MEXIT 00066200 .MEXIT8 ANOP 00066300 MNOTE 8,'---DGEN60--- ERRORS IN THIS DBD' 00066400 MEND 00066500 ./ ADD NAME=DCBSB DSN=CL.REM.UMAC MACRO 00010000 &NAME DCBSB &DDNAME=SYSIN,&BUFNO=10,&EODAD=1,&MACRF=(GM),&SP=105, +00020000 &BLKSIZE=80,&EXLST=0,&SYNAD=1,&EROPT=ABE 00030000 LCLC &GORP,&LORM,&C 00040000 LCLA &N 00050000 AIF (K'&MACRF(1) NE 2).E3 00060000 &GORP SETC '&MACRF(1)'(1,1) 00070000 &LORM SETC '&MACRF(1)'(2,1) 00080000 &C SETC 'IHB&SYSNDX' 00090000 AIF ('&NAME' EQ '').E4 00100000 AIF (&BUFNO LT 1).E2 00110000 AIF ('&GORP' EQ 'P').OK1 00120000 AIF ('&EODAD' EQ '1').E1 00130000 .OK1 ANOP 00140000 &NAME DCB MACRF=(E),DSORG=PS,DDNAME=&DDNAME,IOBAD=&C.I,DEVD=TA, +00150000 EODAD=&EODAD,EXLST=&EXLST 00160000 SPACE 2 00170000 ORG &NAME+56 00180000 &C.E DC A(0) EVENT CONTROL BLOCK 00190000 SPACE 2 00200000 &C.I DC XL32'00' IOB 00210000 ORG &C.I 00220000 DC X'42' UNRELATED IOB 00230000 ORG &C.I+4 00240000 DC A(&C.E) ADDR. OF ECB 00250000 ORG &C.I+16 00260000 DC A(1) ADDR. OF CCW LIST 00270000 DC A(&NAME) ADDR. OF DCB 00280000 ORG &C.I+32 00290000 SPACE 00300000 AIF ('&LORM' NE 'T').N 00310000 DC X'80' SUBSTITUE MODE FLAG 00320000 AGO .B 00330000 .N ANOP 00340000 AIF ('&LORM' NE 'L').A 00350000 DC X'48' LOCATE MODE FLAG 00360000 AGO .B 00370000 .A AIF ('&LORM' NE 'M').E3 00380000 DC X'50' MOVE MODE FLAG 00390000 .B AIF ('&GORP' NE 'G').C 00400000 DC X'00' GET MODE FLAG 00410000 DC AL2(&BUFNO) NUMBER OF BUFFERS TO ALLOC. 00420000 DC V(IOGETSB) ADDR. OF ACCESS METHOD 00430000 AGO .LAST 00440000 .C AIF ('&GORP' NE 'P').E3 00450000 DC X'01' PUT MODE FLAG 00460000 DC AL2(&BUFNO) NUMBER OF BUFFERS TO ALLOC. 00470000 DC V(IOPUTSB) ADDR. OF ACCESS METHOD 00480000 .LAST DC A(1) ADDR. OF CURRENT CCW 00490000 DC A(1) ADDR. OF CCW FOR UNIT EXECPTION 00500000 &N SETA &BUFNO*(&BLKSIZE+8)+7 00510000 &N SETA 8*(&N/8) 00520000 DC AL1(&SP),AL3(&N) SUBPOOL NUMBER AND CORE SIZE 00530000 AIF ('&EROPT' EQ 'ABE').EROPT1 00540000 AIF ('&EROPT' EQ 'ACC').EROPT2 00550000 AIF ('&EROPT' EQ 'SKP').EROPT3 00560000 MNOTE 4,'INVALID EROPT OPERAND, ABE ASSUMED' 00570000 .EROPT1 DC AL1(32) EROPT=ABE 00580000 AGO .SYNAD 00590000 .EROPT3 MNOTE *,'EROPT=SKP DEFAULTED TO ACC FOR CHAINED SCHEDULTING' 00600000 .EROPT2 DC AL1(128) EROPT=ACC 00610000 .SYNAD DC AL3(&SYNAD) SYNAD 00620000 DC AL2(&BLKSIZE) BLKSIZE 00630000 AGO .MEND 00640000 .E1 MNOTE 12,'NO EODAD SPECIFIED FOR INPUT' 00650000 MEXIT 00660000 .E2 MNOTE 12,'NUMBER OF BUFFERS LESS THAN 1' 00670000 MEXIT 00680000 .E3 MNOTE 12,'INVALID MACRF PARAMTER' 00690000 MEXIT 00700000 .E4 MNOTE 12,'NAME REQUIRED FOR DCBSB' 00710000 .MEND SPACE 2 00720000 MEND 00730000 ./ ADD NAME=DCBV DSN=CL.REM.UMAC MACRO 00020000 &NAME DCBV &DDNAME 00040000 AIF ('&DDNAME' EQ '').A 00060000 &NAME DCB DDNAME=&DDNAME,MACRF=(PM),DSORG=PS,RECFM=VBA 00080000 MEXIT 00100000 .A MNOTE *,'DDNAME WILL BE SYSPRINT BY DEFAULT' 00120000 &NAME DCB DDNAME=SYSPRINT,MACRF=(PM),DSORG=PS,RECFM=VBA 00140000 MEND 00160000 ./ ADD NAME=DCV DSN=CL.REM.UMAC MACRO 00020000 &NAME DCV &A,&B 00040000 LCLA &WHICH,&LRECL 00060000 LCLC &CTL 00080000 &CTL SETC ' ' 00100000 &WHICH SETA 1 00120000 AIF ('&A'(1,1) EQ '''').BUILD 00140000 &WHICH SETA 2 00160000 AIF ('&A' EQ '' OR '&A' EQ 'S' OR '&A' EQ 'SPACE').BUILD 00180000 &CTL SETC '1' 00200000 AIF ('&A' EQ 'P' OR '&A' EQ 'PAGE').BUILD 00220000 &CTL SETC '0' 00240000 AIF ('&A' EQ 'D' OR '&A' EQ 'DOUBLE').BUILD 00260000 &CTL SETC '+' 00280000 AIF ('&A' EQ 'N' OR '&A' EQ 'NOSPACE').BUILD 00300000 &CTL SETC '-' 00320000 AIF ('&A' EQ 'T' OR '&A' EQ 'TRIPLE').BUILD 00340000 &CTL SETC ' ' 00360000 MNOTE 4,'INVALID CONTROL REQUEST, SINGLE SUBSTITUTED' 00380000 .BUILD ANOP 00400000 &LRECL SETA 4+K'&SYSLIST(&WHICH)-1 00420000 &NAME DC AL2(&LRECL),AL2(0),C'&CTL',C&SYSLIST(&WHICH) 00440000 MEND 00460000 ./ ADD NAME=DIRB DSN=CL.REM.UMAC MACRO 04000000 &NAME DIRB &IRB= 08000000 LCLA &CNT 12000000 LCLC ® 16000000 AIF ('&IRB' EQ '').ERROR IRB PARAMETER NOT SPECIFIED 20000000 AIF ('&NAME' EQ '').NONAME LABEL NOT SPECIFIED 24000000 &NAME DS 0H 28000000 .NONAME AIF ('&IRB'(1,1) NE '(').COMP 32000000 AIF ('&IRB' EQ '(0)').INDIC 36000000 &CNT SETA (K'&IRB) 40000000 ® SETC '&IRB'(2,&CNT-2) 44000000 LR 0,® PUT ADDRESS OF IRB IN REG 0 48000000 AGO .INDIC 52000000 .COMP ANOP 56000000 LA 0,&IRB PUT ADDRESS OF IRB IN REG 0 60000000 .INDIC ANOP 64000000 LNR 1,0 INDICATE DELETE IRB 68000000 SVC 43 ISSUE DELETE IRB SVC 72000000 MEXIT 76000000 .ERROR ANOP 80000000 IHBERMAC 02,408 84000000 MEND 88000000 ./ ADD NAME=DMAN DSN=CL.REM.UMAC MACRO 00000010 DMAN &DD1=,&DD2=,&DEV1=,&DLIOF=,&LRECL=,&BLKFACT= 00000020 COPY GLOBALS 00000030 GBLA &DDW 00000040 AIF (&D GE 10).DMAN1 00000050 &D SETA &D+1 00000060 &DV1(&D) SETC '&DEV1' 00000070 AIF ('&LRECL' EQ '' AND '&BLKFACT' EQ '').NOMAX 00000080 AIF ('&LRECL' NE '').NOBLK 00000090 MNOTE 8,'---DMAN050---BLKFACT SPECIFIED BUT NO LRECL' 00000100 &CSECT(&DB) SETB 1 00000110 MEXIT 00000120 .NOBLK AIF ('&BLKFACT' NE '').BOTH 00000130 MNOTE 8,'---DMAN060---LRECL SPECIFIED BUT NO BLKFACT OPERAND' 00000140 &CSECT(&DB) SETB 1 00000150 MEXIT 00000160 .BOTH ANOP 00000170 &DT(&D) SETA &BLKFACT 00000180 &DE(&D) SETA &LRECL 00000190 AGO .NOMAXT 00000200 .NOMAX ANOP 00000210 &DT(&D) SETA 0 00000220 &DE(&D) SETA 0 00000230 .NOMAXT ANOP 00000240 &WA(&D) SETA 2000 TRACK SIZE 00000250 &WB(&D) SETA 2000 TRACK SIZE 00000260 AIF ('&DEV1' EQ '2400').DD1 00000270 AIF ('&DEV1' EQ 'TAPE').DD1 00000280 &TRCYL(&D) SETA 20 TRACKS PER CYLINDER 00000290 &WA(&D) SETA 7294 MAXIMUM BYTES PER TRACK 00000300 &WB(&D) SETA 3476 HALF TRACK CAPACITY 00000310 &WC(&D) SETA 2254 THIRD TRACK CAPACITY 00000320 &WD(&D) SETA 1649 FOURTH TRACK CAPACITY 00000330 &DAC(&D) SETA 45 C 00000340 &DAD(&D) SETA 101 CX 00000350 &DAE(&D) SETA 2137 E 00000360 &DAF(&D) SETA 2048 F 00000370 AIF ('&DEV1' EQ '2314').DD1 00000380 &TRCYL(&D) SETA 10 TRACKS PER CYLINDER 00000390 &WA(&D) SETA 3625 MAXIMUM BYTES PER TRACK 00000400 &WB(&D) SETA 1720 HALF TRACK CAPACITY 00000410 &WC(&D) SETA 1111 THIRD TRACK CAPACITY 00000420 &WD(&D) SETA 811 FOURTH TRACK CAPACITY 00000430 &DAC(&D) SETA 20 C 00000440 &DAD(&D) SETA 61 CX 00000450 &DAE(&D) SETA 537 E 00000460 &DAF(&D) SETA 512 F 00000470 AIF ('&DEV1' EQ '2311').DD1 00000480 &TRCYL(&D) SETA 1 TRACKS PER CYLINDER 00000490 &WA(&D) SETA 20483 MAXIMUM BYTES PER TRACK 00000500 &WB(&D) SETA 10122 HALF TRACK CAPACITY 00000510 &WC(&D) SETA 6686 THIRD TRACK CAPACITY 00000520 &WD(&D) SETA 4968 FOURTH TRACK CAPACITY 00000530 &DAC(&D) SETA 53 C 00000540 &DAD(&D) SETA 133 CX 00000550 &DAE(&D) SETA 1 E 00000560 &DAF(&D) SETA 1 F 00000570 AIF ('&DEV1' EQ '2301').DD1 00000580 AIF ('&DEV1' EQ 'DRUM').DD1 00000590 &TRCYL(&D) SETA 20 TRACKS PER CYLINDER 00000600 &WA(&D) SETA 2000 MAXIMUM BYTES PER TRACK 00000610 &WB(&D) SETA 920 HALF TRACK CAPACITY 00000620 &WC(&D) SETA 576 THIRD TRACK CAPACITY 00000630 &WD(&D) SETA 406 FOURTH TRACK CAPACITY 00000640 &DAC(&D) SETA 16 C 00000650 &DAD(&D) SETA 84 CX 00000660 &DAE(&D) SETA 537 E 00000670 &DAF(&D) SETA 512 F 00000680 AIF ('&DEV1' EQ '2321').DD1 00000690 AIF ('&DEV1' EQ 'CELL').DD1 00000700 &TRCYL(&D) SETA 10 TRACKS PER CYLINDER 00000710 &WA(&D) SETA 4984 MAXIMUM BYTES PER TRACK 00000720 &WB(&D) SETA 2383 HALF TRACK CAPACITY 00000730 &WC(&D) SETA 1550 THIRD TRACK CAPACITY 00000740 &WD(&D) SETA 1139 FOURTH TRACK CAPACITY 00000750 &DAC(&D) SETA 20 C 00000760 &DAD(&D) SETA 61 CX 00000770 &DAE(&D) SETA 537 E 00000780 &DAF(&D) SETA 512 F 00000790 AIF ('&DEV1' EQ '2302').DD1 00000800 MNOTE 8,'---DMAN10--- INCORRECT DEVICE SPECIFICATION' 00000810 &CSECT(&DB) SETB 1 00000820 MEXIT 00000830 AIF ((&WA(&D)) GE (&DE(&D)*&DT(&D))).NOM1 00000840 MNOTE 8,'---DMAN070---LRECL X BLKFACT GE TRACK LENGTH' 00000850 &CSECT(&DB) SETB 1 00000860 MEXIT 00000870 .DD1 ANOP 00000880 .NOM1 ANOP 00000890 AIF ('&DD1' EQ '').NODD1 00000900 &D1(&D) SETC '&DD1' 00000910 AIF ('&DBA' EQ '1').ISAM 00000920 AIF ('&DBA' EQ '3').SAM 00000930 .EACC MNOTE 8,'---DMAN20--- INCORRECT ACCESS SPECIFICATION' 00000940 &CSECT(&DB) SETB 1 00000950 MEXIT 00000960 .ISAM AIF ('&DLIOF' NE '').OVFLOW 00000970 MNOTE 8,'---DMAN080---MISSING DLIOF OPERAND WITH ACCESS EQ X00000980 TO ISAM' 00000990 &CSECT(&DB) SETB 1 00001000 MEXIT 00001010 .OVFLOW AIF ('&DD2' NE '').PERR 00001020 &DV2(&D) SETC ' ' 00001030 &DO(&D) SETC '&DLIOF' 00001040 &DDW SETA 1 00001050 AIF (&D EQ 1).DMANX 00001060 .NXTDMAN AIF ('&D1(&DDW)' EQ '&D1(&D)').DUPDO 00001070 AIF ('&D1(&DDW)' EQ '&DO(&D)').DUPDO 00001080 AIF ('&DO(&DDW)' EQ '&D1(&D)').DUPDO 00001090 AIF ('&DO(&DDW)' EQ '&DO(&D)').DUPDO 00001100 &DDW SETA &DDW+1 00001110 AIF ('&DDW' LT '&D').NXTDMAN 00001120 .DMANX AIF ('&D1(&DDW)' EQ '&DO(&DDW)').DUPDO 00001130 MEXIT 00001140 .SAM AIF ('&DLIOF' NE '' OR 'DD2' EQ '').PERR1 00001150 &DV2(&D) SETC ' ' 00001160 &D2(&D) SETC '&DD2' 00001170 AIF ('&D1(&D)' EQ '&D2(&D)').DUPDD1 00001180 MEXIT 00001190 .PERR MNOTE 8,'---DMAN030---DD2 OPERAND INVALID WITH ACCESS EQ TO ISAM' 00001200 &CSECT(&DB) SETB 1 00001210 MEXIT 00001220 .PERR1 MNOTE 8,'---DMAN090---DLIOF IS PRESENT OR DD2 IS MISSING WITH X00001230 ACCESS EQ TO SAM' 00001240 &CSECT(&DB) SETB 1 00001250 MEXIT 00001260 .DMAN1 MNOTE 8,'---DMAN040---TOO MANY DMAN CARDS' 00001270 &CSECT(&DB) SETB 1 00001280 MEXIT 00001290 .NODD1 MNOTE 8,'---DMAN100---MISSING DD1 OPERAND ON DMAN CARD' 00001300 &CSECT(&DB) SETB 1 00001310 MEXIT 00001320 .DUPDD1 MNOTE 8,'---DMAN110--- DD1 AND DD2 DDNAMES ARE DUPLICATE' 00001330 &CSECT(&DB) SETB 1 00001340 MEXIT 00001350 .DUPDO MNOTE 8,'---DMAN120---DD1 AND/OR DLIOF DDNAMES ARE DUPLICATE' 00001360 &CSECT(&D) SETB 1 00001370 MEXIT 00001380 MEND 00001390 ./ ADD NAME=DSCB DSN=CL.REM.UMAC /* A DSCB MAP IS DEFINED BY THE DATA ATTRIBUTE 'DSCB(N)' WHERE N */00001000 /* MUST BE REPLACED BY AN INTEGER FROM 1 TO 6 DEPENDING */00002000 /* ON THE FORMAT DSCB DESIRED. */00003000 /*SAMPLE USAGE: */00004000 /* DCL 1 FMT4 DSCB(4); */00005000 %DCL DSCB ENTRY(FIXED) RETURNS(CHAR); 00006000 %DSCB: PROC(TYPE) RETURNS(CHAR); 00007000 DCL TYPE FIXED; 00008000 0IF TYPE=1 THEN RETURN( 00009000 'ALIGNED, 00010000 250 DSNAME CHAR(44), 00011000 250 FMTID CHAR(1), 00012000 250 DSSN CHAR(6), 00013000 250 VOLSQ BIT(16), 00014000 250 CREDT, 00015000 251 Y BIT(8), 00016000 251 DD BIT(16), 00017000 250 EXPDT LIKE CREDT, 00018000 250 NOEPV BIT(8), 00019000 250 NOBDB BIT(8), 00020000 250 F61 CHAR(1), 00021000 250 SYSCD CHAR(13), 00022000 250 F75_81 CHAR(7), 00023000 250 DSORG BIT(16), 00024000 250 RECFM BIT(8), 00025000 250 OPTCD BIT(8), 00026000 250 BLKL FIXED BIN(15), 00027000 250 LRECL FIXED BIN(15), 00028000 250 KEYL BIT(8), 00029000 250 RKP BIT(16), 00030000 250 DSIND BIT(8), 00031000 250 SCALO BIT(32), 00032000 250 LSTAR BIT(24), 00033000 250 TRBAL BIT(16), 00034000 250 F103_104 CHAR(2), 00035000 250 EXT(3), 00036000 251 TYPE BIT(8), 00037000 251 M BIT(8), 00038000 251 LO, 00039000 252 CC BIT(16), 00040000 252 HH BIT(16), 00041000 251 HI LIKE EXT.LO, 00042000 250 PTRDS CHAR(5) 00043000 '); 00044000 0IF TYPE = 2 THEN RETURN( 00045000 'ALIGNED, 00046000 250 CHAR CHAR(140) 00047000 '); 00048000 0IF TYPE = 3 THEN RETURN( 00049000 'ALIGNED, 00050000 250 F0_3 CHAR(4), 00051000 250 EXTNT(4), 00052000 251 TYPE BIT(8), 00053000 251 M BIT(8), 00054000 251 LO, 00055000 252 CC BIT(16), 00056000 252 HH BIT(16), 00057000 251 HI, 00058000 252 CC BIT(16), 00059000 252 HH BIT(16), 00060000 250 FMTID CHAR(1), 00061000 250 ADEXT(9) LIKE EXTNT, 00062000 250 F135_139 CHAR(5) 00063000 '); 00064000 0IF TYPE = 4 THEN RETURN( 00065000 'ALIGNED, 00066000 250 F0_43 CHAR(44), 00067000 250 IDENT CHAR(1), 00068000 250 HPCHR CHAR(5), 00069000 250 DSREC FIXED BIN(15), 00070000 250 HCCHH BIT(32), 00071000 250 NOATK FIXED BIN(15), 00072000 250 VTOCI BIT(8), 00073000 250 NOEXT BIT(8), 00074000 250 F60_61 CHAR(2), 00075000 250 DEVSZ BIT(32), 00076000 250 DEVTK FIXED BIN(15), 00077000 250 DEVI BIT(8), 00078000 250 DEVL BIT(8), 00079000 250 DEVK BIT(8), 00080000 250 DEVFG BIT(8), 00081000 250 DEVTL BIT(16), 00082000 250 DEVDT BIT(8), 00083000 250 DEVDB BIT(8), 00084000 250 F76_99 CHAR(24), 00085000 250 F6PTR CHAR(5), 00086000 250 VTOCE, 00087000 251 TYPE BIT(8), 00088000 251 M BIT(8), 00089000 251 LO, 00090000 252 CC BIT(16), 00091000 252 HH BIT(16), 00092000 251 HI LIKE VTOCE.LO, 00093000 250 F115_139 CHAR(25) 00094000 '); 00095000 0IF TYPE = 5 THEN RETURN( 00096000 'ALIGNED, 00097000 250 KEYID BIT(32), 00098000 250 AVEXT(8), 00099000 251 TT BIT(16), 00100000 251 UNUCL BIT(16), 00101000 251 UNUTK BIT(8), 00102000 250 FMTID CHAR(1), 00103000 250 MAVET(18) LIKE AVEXT, 00104000 250 PTRDS CHAR(5) 00105000 '); 00106000 0IF TYPE = 6 THEN RETURN( 00107000 'ALIGNED, 00108000 250 KEYID BIT(32), 00109000 250 AVEXT6(8), 00110000 251 TT BIT(16), 00111000 251 NOCYL BIT(16), 00112000 251 NODS BIT(8), 00113000 250 FMTID CHAR(1), 00114000 250 MAVET6(18) LIKE AVEXT6, 00115000 250 PTRDS CHAR(5) 00116000 '); 00117000 0RETURN(' INVALID /*DSCB TYPE */ 00118000 '); 00119000 %END; 00120000 ./ ADD NAME=FEOV DSN=CL.REM.UMAC /*********************************************************************/00010000 /* FEOV - FORCE END OF VOLUME - FUNCTION DECLARATION */00010001 /*********************************************************************/00010002 0DCL FEOV ENTRY( FILE, CHAR(*) ); 00010003 0 /* ARG NAME DESCRIPTION */00010004 /* 1 FILENAME FILE TO DO AN FEOV ON */00010005 /* 2 OPTION 'LEAVE' 'REWIND' (OR ' ') */00010006 /* OPTION IS EFFECTIVE WITH REL20 ONLY*/00010007 /*SAMPLE CALL: */00010008 /* CALL FEOV(MASTIN,' '); */00010009 ./ ADD NAME=FINISH DSN=CL.REM.UMAC MACRO 00000100 FINISH 00000200 COPY GLOBALS 00000300 &Z SETA 1 00000400 .LOOP AIF (&CSECT(&Z)).ADD1 00000500 .* 00000600 .* FALL THROUGH IF AT LEAST ONE GOOD 00000700 .* ALLOW LINKEDIT STEP 00000800 .* 00000900 MEXIT 00001000 .ADD1 ANOP 00001100 AIF (&Z EQ &DB).ALLBAD 00001200 &Z SETA &Z+1 00001300 AGO .LOOP 00001400 .ALLBAD ANOP 00001500 MNOTE 12,'---FINI10--- NO SUCCESSFUL DBDS IN THIS RUN' 00001600 MEXIT 00001700 MEND 00001800 ./ ADD NAME=FLAG DSN=CL.REM.UMAC MACRO 00010000 &NAME FLAG &LST,&COMMENT,&TYPE=DS,&VALUE=,&INDEX= 00020000 GBLA &N1,&N2,&N3 00030000 LCLA &I 00040000 LCLC &HL(8),&TY 00050000 &HL(1) SETC '80' 00060000 &HL(2) SETC '40' 00070000 &HL(3) SETC '20' 00080000 &HL(4) SETC '10' 00090000 &HL(5) SETC '08' 00100000 &HL(6) SETC '04' 00110000 &HL(7) SETC '02' 00120000 &HL(8) SETC '01' 00130000 AIF (&N1 NE 0).L1 00140000 &N1 SETA 1 00150000 .L1 AIF (&N2 NE 0 OR '&TYPE' NE 'EQU').L2 00160000 .L3 ANOP 00170000 &N2 SETA &N2+1 00180000 $#LEN&HL(&N2) DS 0XL(X'&HL(&N2)') 00190000 AIF (&N2 LT 8).L3 00200000 &N2 SETA 1 00210000 .L2 AIF ('&COMMENT' EQ '').NOCOM 00220000 MNOTE *,&COMMENT 00230000 .NOCOM AIF ('&NAME' EQ '').NONAME 00240000 AIF ('&TYPE' EQ 'EQU').EQU 00250000 AIF (&N1 EQ 8 OR '&TYPE' EQ 'GEN').GEN 00260000 &NAME DS 0XL(X'&HL(&N1)') 00270000 &N1 SETA &N1+1 00280000 MEXIT 00290000 .GEN ANOP 00300000 &NAME DC XL(X'01')'00' 00310000 &N1 SETA 1 00320000 MEXIT 00330000 .EQU AIF ('&VALUE' EQ '').L4 00340000 &N3 SETA &VALUE 00350000 .L4 AIF ('&INDEX' EQ '').L5 00360000 &N2 SETA &INDEX 00370000 .L5 AIF (&N2 LE 8).L6 00380000 &N2 SETA 1 00390000 &N3 SETA &N3+1 00400000 .L6 ANOP 00410000 &NAME EQU $#LEN&HL(&N2)-$#LEN&HL(&N2)+&N3 00420000 &N2 SETA &N2+1 00430000 MEXIT 00440000 .NONAME AIF ('&LST' EQ '').NOLIST 00450000 &TY SETC 'DS' 00460000 AIF ('&TYPE' NE 'EQU').L7 00470000 &TY SETC 'EQU' 00480000 .L7 AIF (N'&LST GT 1 OR '&TYPE' EQ 'EQU').L8 00490000 &TY SETC 'GEN' 00500000 .L8 ANOP 00510000 &LST(1) FLAG TYPE=&TY,VALUE=&VALUE,INDEX=&INDEX 00520000 &I SETA 2 00530000 .LOOP AIF (&I LT N'&LST OR '&TYPE' EQ 'EQU').L9 00540000 &TY SETC 'GEN' 00550000 .L9 AIF (&I GT N'&LST).MEND 00560000 &LST(&I) FLAG TYPE=&TY 00570000 &I SETA &I+1 00580000 AGO .LOOP 00590000 .NOLIST AIF ('&TYPE' EQ 'GEN').L10 00600000 MNOTE 4,'WARNING - NO FLAGS SPECIFIED' 00610000 MEXIT 00620000 .L10 AIF (&N1 GT 1).GEN 00630000 .MEND MEND 00640000 ./ ADD NAME=FLD DSN=CL.REM.UMAC MACRO 00000010 FLD &NAME=,&TYPE=C,&BYTES=,&START= 00000020 COPY GLOBALS 00000030 GBLC &FN1(255),&FN2(255),&FN3(255) 00000040 GBLC &FT1(255),&FT2(255),&FT3(255) 00000050 GBLA &FB1(255),&FB2(255),&FB3(255) 00000060 GBLA &FST1(255),&FST2(255),&FST3(255) 00000070 GBLA &FS1(255),&FS2(255),&FS3(255) 00000080 GBLA &F1,&F2,&F3 00000090 GBLA &KFLD 00000100 GBLA &KFLDW 00000110 AIF (&F GE 255).F256 00000120 &F SETA &F+1 00000130 AIF (NOT &K).EK 00000140 AIF ('&NAME' EQ '').EN 00000150 &FN(&F) SETC '&NAME' 00000160 AIF ('&KFLD' EQ '&F').FLDX 00000170 &KFLDW SETA &KFLD 00000180 .NXTFLD AIF ('&FN(&F)' EQ '&FN(&KFLDW)').ED 00000190 &KFLDW SETA &KFLDW+1 00000200 AIF ('&KFLDW' LT '&F').NXTFLD 00000210 .FLDX ANOP 00000220 AIF ('&BYTES' EQ '').EB 00000230 AIF (&BYTES EQ 0).E0 00000240 &FB(&F) SETA &BYTES 00000250 AIF ('&START' EQ '').ES 00000260 AIF (&START EQ 0).ES0 00000270 &FST(&F) SETA &START 00000280 AIF ((&FST(&F)+&FB(&F)-1) GT &SB(&S)).EL 00000290 &FS(&F) SETA &S 00000300 AIF ('&TYPE' NE 'C').TX 00000310 &FT(&F) SETC '&IBM.3' 00000320 MEXIT 00000330 .TX AIF ('&TYPE' NE 'X').TP 00000340 &FT(&F) SETC '&IBM.1' 00000350 MEXIT 00000360 .TP AIF ('&TYPE' NE 'P').ET 00000370 &FT(&F) SETC '&IBM.2' 00000380 MEXIT 00000390 .F256 ANOP 00000400 AIF (&F1 GE 255).F512 00000410 &F1 SETA &F1+1 00000420 AIF (NOT &K).EK 00000430 AIF ('&NAME' EQ '').EN 00000440 &FN1(&F1) SETC '&NAME' 00000450 AIF ('&BYTES' EQ '').EB 00000460 AIF (&BYTES EQ 0).E0 00000470 &FB1(&F1) SETA &BYTES 00000480 AIF ('&START' EQ '').ES 00000490 AIF (&START EQ 0).ES0 00000500 &FST1(&F1) SETA &START 00000510 AIF ((&FST1(&F1)+&FB1(&F1)-1) GT &SB(&S)).EL 00000520 &FS1(&F1) SETA &S 00000530 AIF ('&TYPE' NE 'C').TX1 00000540 &FT1(&F1) SETC '&IBM.3' 00000550 MEXIT 00000560 .TX1 AIF ('&TYPE' NE 'X').TP1 00000570 &FT1(&F1) SETC '&IBM.1' 00000580 MEXIT 00000590 .TP1 AIF ('&TYPE' NE 'P').ET 00000600 &FT1(&F1) SETC '&IBM.2' 00000610 MEXIT 00000620 .F512 ANOP 00000630 AIF (&F2 GE 255).F768 00000640 &F2 SETA &F2+1 00000650 AIF (NOT &K).EK 00000660 AIF ('&NAME' EQ '').EN 00000670 &FN2(&F2) SETC '&NAME' 00000680 AIF ('&BYTES' EQ '').EB 00000690 AIF (&BYTES EQ 0).E0 00000700 &FB2(&F2) SETA &BYTES 00000710 AIF ('&START' EQ '').ES 00000720 AIF (&START EQ 0).ES0 00000730 &FST2(&F2) SETA &START 00000740 AIF ((&FST2(&F2)+&FB2(&F2)-1) GT &SB(&S)).EL 00000750 &FS2(&F2) SETA &S 00000760 AIF ('&TYPE' NE 'C').TX3 00000770 &FT2(&F2) SETC '&IBM.3' 00000780 MEXIT 00000790 .TX2 AIF ('&TYPE' NE 'X').TP2 00000800 &FT2(&F2) SETC '&IBM.1' 00000810 MEXIT 00000820 .TP2 AIF ('&TYPE' NE 'P').ET 00000830 &FT2(&F2) SETC '&IBM.2' 00000840 MEXIT 00000850 .F768 ANOP 00000860 AIF (&F3 GE 255).FM 00000870 &F3 SETA &F3+1 00000880 AIF (NOT &K).EK 00000890 AIF ('&NAME' EQ '').EN 00000900 &FN3(&F3) SETC '&NAME' 00000910 AIF ('&BYTES' EQ '').EB 00000920 AIF (&BYTES EQ 0).E0 00000930 &FB3(&F3) SETA &BYTES 00000940 AIF ('&START' EQ '').ES 00000950 AIF (&START EQ 0).ES0 00000960 &FST3(&F3) SETA &START 00000970 AIF ((&FST3(&F3)+&FB3(&F3)-1) GT &SB(&S)).EL 00000980 &FS3(&F3) SETA &S 00000990 AIF ('&TYPE' NE 'C').TX2 00001000 &FT3(&F3) SETC '&IBM.3' 00001010 MEXIT 00001020 .TX3 AIF ('&TYPE' NE 'X').TP3 00001030 &FT3(&F3) SETC '&IBM.1' 00001040 &FT3(&F3) SETC '&IBM.2' 00001050 MEXIT 00001060 .EN MNOTE 8,'---FLD010--- NAME PARAMETER NOT SPECIFIED' 00001070 &CSECT(&DB) SETB 1 00001080 MEXIT 00001090 .EB MNOTE 8,'---FLD020--- BYTES PARAMETER NOT SPECIFIED' 00001100 &CSECT(&DB) SETB 1 00001110 MEXIT 00001120 .ES MNOTE 8,'---FLD030--- START PARAMETER NOT SPECIFIED' 00001130 &CSECT(&DB) SETB 1 00001140 MEXIT 00001150 .ET MNOTE 8,'---FLD040--- TYPE PARAMETER NOT SPECIFIED OR INVALD' 00001160 &CSECT(&DB) SETB 1 00001170 MEXIT 00001180 .EK MNOTE 8,'---FLD050---FLDK CARD NOT FIRST AFTER SEGM CARD' 00001190 .EM MNOTE 8,'---FLD060--- TOO MANY FLD AND FLDK CARDS 256 MAX' 00001200 &CSECT(&DB) SETB 1 00001210 MEXIT 00001220 .FM MNOTE 8,'---FLD060--- TO MANY FLD OR FLDK CARDS 1000 MAX ' 00001230 &CSECT(&DB) SETB 1 00001240 MEXIT 00001250 .EL MNOTE 8,'---FLD070---FIELD LENGTH EXTENDS BEYOND SEGMENT END' 00001260 &CSECT(&DB) SETB 1 00001270 MEXIT 00001280 MNOTE 8,'---FLD080---FIRST BYTE OF SEGMENT STARTS WITH BYTE 1' 00001290 &CSECT(&DB) SETB 1 00001300 MEXIT 00001310 .E0 MNOTE 8,'---FLD090---FIELD LENGTH SPECIFIED AS ZERO' 00001320 &CSECT(&DB) SETB 1 00001330 MEXIT 00001340 .ED MNOTE 8,'---FLD100---DUPLICATE FIELD NAME IN SEGMENT' 00001350 &CSECT(&DB) SETB 1 00001360 MEXIT 00001370 MEND 00001380 ./ ADD NAME=FLDK DSN=CL.REM.UMAC MACRO 00000010 FLDK &NAME=,&TYPE=C,&BYTES=,&START= 00000020 COPY GLOBALS 00000030 GBLA &KFLDW 00000040 GBLA &KFLD 00000050 GBLA &F1,&F2,&F3 00000060 AIF (&K NE 0).EM 00000070 &K SETB 1 00000080 AIF (&F GE 255).KF1 00000090 &KFLD SETA &F+1 00000100 AGO .FLD 00000110 .KF1 AIF (&F1 GE 255).KF2 00000120 &KFLD SETA &F1+1 00000130 AGO .FLD 00000140 .KF2 AIF (&F2 GE 255).KF3 00000150 &KFLD SETA &F2+1 00000160 AGO .FLD 00000170 .KF3 ANOP 00000180 &KFLD SETA &F3+1 00000190 .FLD ANOP 00000200 &IBM SETB 1 00000210 FLD NAME=&NAME,TYPE=&TYPE,BYTES=&BYTES,START=&START 00000220 &IBM SETB 0 00000230 &DK(&D) SETA &BYTES 00000240 MEXIT 00000250 .EM MNOTE 8,'---FLDK010--- KEY FIELD SPECIFIED INAPPROPRIATELY' 00000260 &CSECT(&DB) SETB 1 00000270 MEND 00000280 ./ ADD NAME=GETC DSN=CL.REM.UMAC MACRO 00001000 &NAME GETC &CARD,&EOF=IEUABORT 00002000 GBLB &IEUSC 00003000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00004000 BAL 14,IEUOC CHECK TO SEE IF OPEN 00005000 IC 0,IEUCDCB+32 SAVE HIGH ORDER BYTE 00006000 LA 1,&EOF GET EOF ADDRESS 00007000 ST 1,IEUCDCB+32 STORE IT 00008000 STC 0,IEUCDCB+32 REPLACE HIGH ORDER BYTE 00009000 GET IEUCDCB,&CARD 00010000 LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00011000 &IEUSC SETB 1 00012000 MEND 00013000 ./ ADD NAME=GETS DSN=CL.REM.UMAC MACRO 00001000 &NAME GETS &T,&LOC,&EOF=IEUABORT 00002000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00003000 IC 0,IEUIO&T+32 SAVE HIGH ORDER BYTE 00004000 LA 1,&EOF GET EOF ADDRESS 00005000 ST 1,IEUIO&T+32 STORE IT 00006000 STC 0,IEUIO&T+32 RESTORE HIGH ORDER BYTE 00007000 TM IEUIO&T+48,X'10' TEST DCB 00008000 BC 8,IEUDD DCB NOT OPEN 00009000 GET IEUIO&T,&LOC 00010000 LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00011000 MEND 00012000 ./ ADD NAME=GETSB DSN=CL.REM.UMAC MACRO 00000100 &NAME GETSB &DCB,&AREA 00000200 &NAME IHBINNRA &DCB,&AREA 00000300 L 15,96(0,1) LOAD GETSB ROUTINE ADDR. 00000400 BALR 14,15 LINK TO GETSB ROUTINE 00000500 MEND 00000600 ./ ADD NAME=GLOBALS DSN=CL.REM.UMAC GBLC &DBA ACCESS METHOD 00000010 GBLC &DBC DL/I CASE 00000020 GBLC &DBN DATA BASE NAME 00000030 GBLC &D1(25) DDNAME ONE (ISAM,SAM) 00000040 GBLC &D2(25) DDNAME TWO (SAM) 00000050 GBLC &DO(25) DDNAME OSAM 00000060 GBLC &DR(25) DAMRTN 00000070 GBLC &SN(255) SEGMENT NAME 00000080 GBLC &SPN(255) SEGMENT PARENT NAME 00000090 GBLC &FN(255) FIELD NAME 00000100 GBLC &FT(255) FIELD TYPE 00000110 GBLC &DV1(25) DEVICE1 (ISAM,SAM) 00000120 GBLC &DV2(25) DEVICE 2 (SAM) 00000130 GBLA &DB DATA BASE NUMBER 00000140 GBLA &D DATA SET NUMBER 00000150 GBLA &FB(255) FIELD LENGTH IN BYTES 00000160 GBLA &LRL(25) LOGICAL RECORD LENGTH 00000170 GBLA &BLK(25) BLOCK SIZE 00000180 GBLA &DK(25) KEY FIELD LENGTH IN BYTES 00000190 GBLA &DT(25) DEVICE TYPE AND BLOCK SIZE 00000200 GBLA &S SEGMENT NUMBER 00000210 GBLA &SB(255) SEGMENT LENGTH IN BYTES 00000220 GBLA &SD(255) SEGMENT DATA SET NUMBER 00000230 GBLA &SF(255) SEGMENT FREQUENCY 00000240 GBLA &SL(255) SEGMENT LEVEL 00000250 GBLA &SPP(255) SEGMENT PARENT PHYSICAL CODE 00000260 GBLA &F FIELD NUMBER 00000270 GBLA &FS(255) FIELD SEGMENT PHYSICAL CODE 00000280 GBLA &FST(255) FIELD START POSITION 00000290 GBLA &W1,&W2,&W3,&W4,&W5,&W WORK VARIABLES 00000300 GBLA &$,&@,&# CHINESE CUSSWORDS 00000310 GBLA &WA(16),&WB(16),&WC(16),&WD(16),&WX(16) WORK VARS 00000320 GBLA &DAC(16),&DAD(16),&DAE(16),&DAF(16) WORK VARS 00000330 GBLA &DA(16),&DE(16),&DC(16),&DD(16) WORK VARS 00000340 GBLA &BL(16),&BLA(16),&BLB(16),&BLC(16),&BN(16) WORK VARS 00000350 GBLA &REM(16),&QUO(16),&PRIME(16),&TRKIND(16) WORK VARS 00000360 GBLA &BLCIN(16),&CYLIND(16),&TRCYL(16),&GREAT(16) 00000370 GBLA &L,&Z ORK VARIABLES 00000380 GBLB &CSECT(25) ERROR FLAG VARIABLE 00000390 GBLB &IBM KEY FLAG 00000400 GBLB &K KEY FLAG 00000410 GBLB &RS PARENTAGE FLAG 00000420 GBLB &B1,&B2,&B3,&B4,&B5,&B6,&B7 WORK VARIABLES 00000430 GBLB &B8,&B9 00000440 GBLA &SPD(255) SEGMENT PARENT DATA SET GROUP 00000450 ./ ADD NAME=GOBACK DSN=CL.REM.UMAC MACRO 00001000 &NAME GOBACK 00002000 GBLB &IEUSC,&IEUSL,&IEUS(99),&IEUSD 00003000 LCLA &NO 00004000 CNOP 0,4 00005000 &NAME DS 0F ALIGN FOR CLOSE 00006000 AIF ( NOT &IEUSC).TESTL 00007000 CLOSE (IEUCDCB) 00008000 .TESTL AIF ( NOT &IEUSL).TESTD 00009000 CLOSE (IEULDCB) 00010000 .TESTD AIF ( NOT &IEUSD).MERGE 00011000 CLOSE (IEUDDCB) 00012000 .MERGE ANOP 00013000 L 13,IEUSAVE+4 GET PREVIOUS SAVE AREA 00014000 LM 14,12,12(13) RESTORE REGISTERS 00015000 SR 15,15 COMPLETION CODE = 0 00016000 MVI 12(13),X'FF' INDICATE RETURN 00017000 BCR 15,14 RETURN 00018000 SPACE 2 00019000 IEUSAVE DC 22F'0' SAVE AREAS 00020000 AIF ( NOT &IEUSC).TESTLO 00021000 EJECT 00022000 IEUOC TM IEUCDCB+48,X'10' TEST DCB 00023000 BCR 7,14 ALREADY OPEN - RETURN 00024000 OPEN (IEUCDCB,(INPUT)) 00025000 TM IEUCDCB+48,X'10' TEST DCB 00026000 BC 8,IEUDD DCB NOT OPEN - ERROR 00027000 BCR 15,14 RETURN 00028000 SPACE 5 00029000 IEUCDCB DCB DSORG=PS,MACRF=(GM),DDNAME=SYSIN,BLKSIZE=80,LRECL=80, C00030000 RECFM=F,EODAD=IEUABORT,BFTEK=S 00031000 .TESTLO AIF ( NOT &IEUSL).TESTDO 00032000 EJECT 00033000 IEUOL TM IEULDCB+48,X'10' TEST DCB 00034000 BCR 7,14 ALREADY OPEN - RETURN 00035000 OPEN (IEULDCB,(OUTPUT)) 00036000 TM IEULDCB+48,X'10' TEST DCB 00037000 BC 8,IEUDD DCB NOT OPEN - ERROR 00038000 BCR 15,14 RETURN 00039000 SPACE 2 00040000 IEULDCB DCB DSORG=PS,MACRF=(PM),DDNAME=SYSPRINT,BLKSIZE=133, C00041000 LRECL=133,RECFM=FA,BFTEK=S 00042000 .TESTDO AIF ( NOT &IEUSD).TESTAR 00043000 EJECT 00044000 IEUOD TM IEUDDCB+48,X'10' TEST DCB 00045000 BCR 7,14 ALREADY OPEN - RETURN 00046000 OPEN (IEUDDCB,(OUTPUT)) 00047000 TM IEUDDCB+48,X'10' TEST DCB 00048000 BC 8,IEUDD DCB NOT OPEN - ERROR 00049000 BCR 15,14 RETURN 00050000 SPACE 2 00051000 IEUDDCB DCB DSORG=PS,MACRF=(PM),DDNAME=SYSPUNCH,BLKSIZE=81, C00052000 RECFM=FA 00053000 .TESTAR ANOP 00054000 &NO SETA &NO+1 00055000 AIF ( NOT &IEUS(&NO)).NEXT 00056000 EJECT 00057000 IEUIO&NO DCB DSORG=PS,MACRF=(GM,PM),DDNAME=IO&NO,BFTEK=S 00058000 .NEXT AIF (&NO NE 99).TESTAR 00059000 &NO SETA 0 00060000 EJECT 00061000 .LOOP ANOP 00062000 &NO SETA &NO+1 00063000 AIF (&IEUS(&NO)).GEN2 00064000 AIF (&NO NE 99).LOOP 00065000 AIF (&IEUSC).GEN2 00066000 AIF (&IEUSL).GEN1 00067000 AIF (&IEUSD).GEN1 00068000 MEXIT 00069000 .GEN2 ANOP 00070000 IEUABORT ABEND 100,DUMP 00071000 SPACE 5 00072000 .GEN1 ANOP 00073000 IEUDD ABEND 104,DUMP PROBLEM OPENING 00074000 MEND 00075000 ./ ADD NAME=IDCBOS DSN=CL.REM.UMAC MACRO 00000010 &NAME IDCBOS &DDNAME=0,&BLKLGTH=0,&BUFNO=0,&EODAD=1,&OPTCD=F 00000020 .********************************************************************** 00000030 .* * 00000040 .* THE PURPOSE OF THIS MACRO IS TO CONSTRUCT AN OSAM DATA EVENT * 00000050 .* CONTROL BLOCK FOR EITHER AN ICS MESSAGE DATASET OR A DL/I * 00000060 .* OVERFLOW DATASET. * 00000070 .* * 00000080 .********************************************************************** 00000090 &NAME DCB DSORG=PS, X00000100 MACRF=(E), X00000110 DDNAME=&DDNAME, X00000120 BUFNO=&BUFNO, X00000130 BUFL=&BLKLGTH, X00000140 RECFM=FB, X00000150 EODAD=&EODAD, X00000160 CENDA=Z8, X00000170 DEVD=DA 00000180 * * 00000190 * OSAM ACCESS METHOD DEPENDENT SECTION * 00000200 * * 00000210 DC XL1'0' 00000220 DC AL3(1) ADDRESS OF OSAM READ/WRITE ROUTINE 00000230 DC XL1'0' INDICATOR 00000240 DC AL3(1) ADDRESS OF OSAM CHECK ROUTINE ADDRESS 00000250 DC F'0' DEB ADDRESS SAVE AREA 00000260 DC 2F'0' QUEUE CONTROL SECTION 00000270 AIF ('&OPTCD' EQ 'F').SKIP1 00000280 DC XL1'0' OPEN INDICATORS 00000290 AGO .SKIP2 00000300 .SKIP1 ANOP 00000310 DC XL1'04' OPEN INDICATORS 00000320 .SKIP2 ANOP 00000330 DC XL1'0' NUMBER OF VOLUMES 00000340 DC 5XL6'0' VOLUME ID'S 00000350 * * 00000360 * OSAM CONTROL FIELDS * 00000370 * * 00000380 DC F'0' RELATIVE BLOCK NUMBER OF LAST RECORD WRITTEN 00000390 DC F'0' RELATIVE BLOCK NUMBER OF NEXT BLOCK 00000400 DC F'0' RELATIVE BLOCK NUMBER OF LAST BLOCK READ 00000410 DC H'0' SUPERVISOR STATE SVC 00000420 DC H'0' RESERVED FOR FUTURE USE 00000430 DC 2F'0' WORK AREA 00000440 * * 00000450 * OSAM RELATIVE BLOCK APPENDAGES * 00000460 * * 00000470 DC 16F'0' 00000480 * * 00000490 * OSAM DATA EXTENT BLOCK ADDRESSES * 00000500 * * 00000510 DC 4F'0' 00000520 MEND 00000530 ./ ADD NAME=IEFQMRES DSN=CL.REM.UMAC MACRO 00020000 IEFQMRES 00040000 QMRDCB DC 11F'0' QUEUE MANAGER DCB 00060000 DC A(QMRDEB) DEB POINTER 00080000 DC F'0' 00100000 QMRDEB DC 6F'0' QUEUE MANAGER DEB 00120000 DC X'0F' DEB I.D. 00140000 DC AL3(QMRDCB) DCB POINTER 00160000 QMRAPG DC F'0' APPENDAGE POINTER 00180000 QMRUCB DC F'0' UCB POINTER 00200000 DC H'0' 00220000 QMRSCC DC X'0001' Q-MGR EXTENT START (CC) 00240000 QMRSHH DC X'0000' Q-MGR EXTENT START (HH) 00260000 QMRECC DC X'0002' Q-MGR ENTENT END (CC) 00280000 QMREHH DC X'0000' Q-MGR EXTENT END (HH) 00300000 QMRNTR DC X'0014' Q-MGR NO.OF ASSIGNED TRACKS 00320000 QMHDA DC 2F'0' DISK ADDR OF M.H. (MBBCCHHR) 00340000 DC X'00' 00360000 QMFLTM DC X'0000' NN OF FIRST LTRK AVAILABLE 00380000 QMQBK DC X'00' QUEUE BREAKING INFORMATION 00400000 QMRSV EQU X'01' BIT 7 ON-SPACE RESERVED TO START INIT 00420000 QMTLNM DC H'0' TOTAL NO. OF LTRKS IN Q EXTENT 00440000 QMNOTM DC H'0' NUMBER OF LTRKS AVAILABLE 00460000 QMHKT DC H'0' THRSHLD OF LTRKS FOR OVERFLOW 00480000 QMTBT DC H'0' TOTAL THRSHLD OF LTRKS + K BIGT 00500000 QMTIDM DC H'0' NN OF LAST LTRK AVAILABLE 00520000 QMKTT DC H'0' NN OF 1ST LTRK OF ALL JOBQ 00540000 QMHPT DC H'0' NUMBER OF HANDLES PER PHYS. TRK 00560000 QMRPT DC H'0' NUMBER OF RECORDS PER PHYS. TRK 00580000 QMLPT DC H'0' NUMBER OF RECORDS PER LOG. TRK 00600000 QMTRS DC H'0' THRSHLD OF LTRKS SAVED PER INIT 00620000 QMNHM DC H'0' NUMBER OF HANDLES ON MIXED TRK 00640000 QMFQR DC H'0' NN OF 1ST JOBQ RCRD(QMKTT) 00660000 QMECBA DC F'0' ECB FOR NO SPACE 00680000 MEND 00700000 ./ ADD NAME=IF DSN=CL.REM.UMAC MACRO 00010000 &LABEL IF &EXP,&GOTO,&R= 00020000 GBLA &I,&IMAX,&L 00030000 GBLB &RDEST,&NOTFLG 00040000 GBLC &LAB(255),&LIST(255),®(255),&DEST 00050000 LCLA &J,&K,&N 00060000 LCLB &NULL,&ANDOR,&LPAREN,&RPAREN,&NOT,&OP 00070000 LCLC &LA,&C 00080000 &DEST SETC '&GOTO' 00090000 &RDEST SETB ('&GOTO'(1,1) EQ '(' AND '&GOTO'(K'&GOTO,1) EQ ')') 00100000 AIF (NOT &RDEST).LDEST 00110000 AIF (K'&GOTO GT 10 OR K'&GOTO LT 3).ERROR2 00120000 &DEST SETC '&GOTO'(2,K'&GOTO-2) 00130000 .LDEST ANOP 00140000 &NOTFLG SETB 0 00150000 .* PARSE THE EXPRESSION AND CHECK SYNTAX 00160000 &I SETA 1 00170000 &K SETA 1 00180000 &N SETA 1 00190000 &NULL SETB 1 00200000 &ANDOR SETB 1 00210000 &RPAREN SETB 1 00220000 .LOOP AIF (&I GT K'&EXP).EOF 00230000 &C SETC '&EXP'(&I,1) 00240000 &J SETA 1 00250000 AIF ('&C' EQ '$' OR '&C' EQ '#' OR '&C' EQ '@' OR '&C' GE 'A').NAME 00260000 &LIST(&K) SETC '&C' 00270000 AIF ('&C' EQ '+' OR '&C' EQ '.').L1 00280000 AIF ('&C' EQ '(').L2 00290000 AIF ('&C' EQ ')').L3 00300000 AIF ('&C' NE '_').ERROR 00310000 AIF (&NOT).ERROR 00320000 &ANDOR SETB 1 00330000 &NULL SETB 1 00340000 &RPAREN SETB 1 00350000 &NOT SETB 0 00360000 &OP SETB 0 00370000 &LPAREN SETB 0 00380000 AGO .NEXT 00390000 .L3 AIF (&RPAREN).ERROR 00400000 &NOT SETB 1 00410000 &LPAREN SETB 1 00420000 &OP SETB 1 00430000 &RPAREN SETB 0 00440000 &ANDOR SETB 0 00450000 &NULL SETB 0 00460000 AGO .NEXT 00470000 .L2 AIF (&LPAREN).ERROR 00480000 AGO .LX 00490000 .L1 AIF (&ANDOR).ERROR 00500000 .LX ANOP 00510000 &RPAREN SETB 1 00520000 &ANDOR SETB 1 00530000 &NULL SETB 1 00540000 &NOT SETB 0 00550000 &LPAREN SETB 0 00560000 &OP SETB 0 00570000 .NEXT ANOP 00580000 &I SETA &I+1 00590000 &K SETA &K+1 00600000 AGO .LOOP 00610000 .NAME ANOP 00620000 AIF (&I+&J GT K'&EXP).LAST 00630000 &C SETC '&EXP'(&I+&J,1) 00640000 AIF ('&C' NE '$' AND '&C' NE '#' AND '&C' NE '@' AND '&C' LT 'A').LAST 00650000 &J SETA &J+1 00660000 AGO .NAME 00670000 .LAST ANOP 00680000 AIF (&J LE 8).NOTLONG 00690000 &LIST(&K) SETC '&EXP'(&I,8) 00700000 MNOTE 4,'NAME LONGER THAN 8 CHARS - TRUNCATED TO &LIST(&K)' 00710000 AGO .LONG 00720000 .NOTLONG ANOP 00730000 &LIST(&K) SETC '&EXP'(&I,&J) 00740000 .LONG ANOP 00750000 ®(&K) SETC '&R(&N)' 00760000 &N SETA &N+1 00770000 AIF (&OP).ERROR 00780000 &LPAREN SETB 1 00790000 &NOT SETB 1 00800000 &OP SETB 0 00810000 &RPAREN SETB 0 00820000 &ANDOR SETB 0 00830000 &NULL SETB 0 00840000 &I SETA &I+&J 00850000 &K SETA &K+1 00860000 AGO .LOOP 00870000 .EOF AIF (&NULL).ERROR 00880000 &IMAX SETA &K-1 00890000 .* SYNTAX IS VALID; GENERATE THE CODE 00900000 &I SETA 1 00910000 AIF (&IMAX EQ 1).ONEOP 00920000 &L SETA 1 00930000 &LAB(1) SETC '' 00940000 &LABEL ORR 0,1 00950000 BRANCH O,0 00960000 AIF ('&LAB(1)' EQ '').MEND 00970000 &LAB(1) DS 0H 00980000 MEXIT 00990000 .ONEOP ANOP 01000000 &LA SETC 'L''' 01010000 AIF ('&R' NE '').EQU 01020000 &LABEL TM &LIST(1),&LA&LIST(1) 01030000 AGO .BRANCH 01040000 .EQU ANOP 01050000 &LABEL TM &LIST(1).(&R(1)),&LA&LIST(1) 01060000 .BRANCH BRANCH O,0 01070000 MEXIT 01080000 .ERROR MNOTE 8,'INVALID SYNTAX FIRST ARGUMENT CHARACTER NUMBER &I' 01090000 MEXIT 01100000 .ERROR2 MNOTE 8,'INVALID SECOND ARGUMENT SPECIFIED' 01110000 .MEND MEND 01120000 ./ ADD NAME=INVERT DSN=CL.REM.UMAC MACRO 00010000 &LABEL INVERT &FLAG,&R= 00020000 LCLA &N 00030000 LCLC &LA 00040000 &LA SETC 'L''' 00050000 AIF ('&R(1)' NE '').SPECIAL 00060000 &LABEL XI &FLAG(1),&LA&FLAG(1) 00070000 AGO .LOOP 00080000 .SPECIAL ANOP 00090000 &LABEL XI &FLAG(1).(&R(1)),&LA&FLAG(1) 00100000 .LOOP AIF (&N+1 GE N'&FLAG).MEND 00110000 INVERT &FLAG(&N+2),R=&R(&N+2) 00120000 &N SETA &N+1 00130000 AGO .LOOP 00140000 .MEND MEND 00150000 ./ ADD NAME=LCTRL DSN=CL.REM.UMAC MACRO 00020000 &NAME LCTRL &DECB,&DCB,&OPCD,&RLN 00040000 LCLA &A 00060000 LCLB &B(12) 00080000 LCLC &GNAME 00100000 &GNAME SETC 'IHB'.'&SYSNDX' 00120000 AIF ('&DECB' EQ '').E1 00140000 &NAME IHBINNRA &DECB 00160000 AIF ('&DCB' EQ '').OPCD 00180000 AIF ('&DCB'(1,1) EQ '(').REG 00200000 LA 14,&DCB LOAD DCB ADDRESS 00220000 ST 14,8(1) STORE DCB ADDRESS 00240000 AGO .OPCD 00260000 .REG ST &DCB(1),8(1) STORE DCB ADDRESS 00280000 .OPCD AIF ('&OPCD' EQ '').RLN 00300000 &B(1) SETB ('&OPCD' EQ 'AUTOWRAP') 00320000 &B(2) SETB ('&OPCD' EQ 'DIAL') 00340000 &B(3) SETB ('&OPCD' EQ 'BREAK') 00360000 &B(4) SETB ('&OPCD' EQ 'PREPARE') 00380000 &B(5) SETB ('&OPCD' EQ 'INHIBIT') 00400000 &B(6) SETB ('&OPCD' EQ 'SEARCH') 00420000 &B(7) SETB ('&OPCD' EQ 'SADZER') 00440000 &B(8) SETB ('&OPCD' EQ 'SADONE') 00460000 &B(9) SETB ('&OPCD' EQ 'SADTWO') 00480000 &B(10) SETB ('&OPCD' EQ 'SADTHREE') 00500000 &B(11) SETB ('&OPCD' EQ 'ENABLE') 00520000 &B(12) SETB ('&OPCD' EQ 'DISABLE') 00540000 &A SETA 5*&B(1)+41*&B(2)+13*&B(3)+6*&B(4)+10*&B(5)+14*&B(6) 00560000 &A SETA &A+19*&B(7)+23*&B(8)+28*&B(9)+31*&B(10)+39*&B(11) 00580000 &A SETA &A+47*&B(12) 00600000 AIF (&A EQ 0).E2 00620000 MVI 4(1),&A SET CODE IN DECB 00640000 .RLN AIF ('&RLN' EQ '').END 00660000 B &GNAME.A BRANCH AROUND CONSTANT 00680000 &GNAME.L DC AL2(&RLN) LINE NUMBER 00700000 &GNAME.A MVC 24(2,1),&GNAME.L INSERT IN DECB 00720000 .END L 15,&GNAME.C LOAD IECTCTRL ROUTINE 00740000 BALR 14,15 ADDRESS AND LINK TO IT 00760000 B &GNAME.D BRANCH AROUND CONSTANT 00780000 &GNAME.C DC V(IECTCTRL) V-CON OF IECTCTRL 00800000 &GNAME.D EQU * 00820000 MEXIT 00840000 .E1 IHBERMAC 7 00860000 MEXIT 00880000 .E2 IHBERMAC 62 00900000 MEND 00920000 ./ ADD NAME=LEAVE DSN=CL.REM.UMAC MACRO 00001000 &LOC LEAVE &RENT,&RC=,&RESTREG=(14,12),&RESULT= 00002000 .* MACRO TO END A PROGRAM 00003000 .* PARAMETER MEANING DEFAULT 00004000 .* &RESTREG REGS. TO BE RESTORED (14,12) 00005000 .* &RC RETURN CODE NONE 00006000 .* &RESULT RESULT NONE 00007000 .* &LOC NAME FOR FIRST EXEC. NO NAME 00008000 .* STMT. IN MACRO 00009000 .* &RENT IF 'RENT', CODE IS CODE GENERATED IS NOT 00010000 .* TO BE REENTRANT TO BE REENTRANT 00011000 .* THE REENTRANT FORM FREES THIS PROGRAM'S SAVE AREA BEFORE 00012000 .* RETURNING TO THE CALLER. 00013000 LCLA &A,&RF,&RL 00014000 LCLB &RCREG,&RESREG,&LD14,&LD15,&NOLOAD,&RCOMIT,&RESOMIT 00015000 LCLC &TRC,&TRES,&B1 00016000 &TRES SETC T'&RESULT 00017000 &TRC SETC T'&RC 00018000 &RESOMIT SETB ('&TRES' EQ 'O') 00019000 &RCOMIT SETB ('&TRC' EQ 'O') 00020000 &B1 SETC ' ' MAKE COMMENTS LOOK NICE 00021000 AIF (&RESOMIT).SETX SKIP IF &RESULT OMITTED 00022000 &RESREG SETB ('&RESULT'(1,1) EQ '(') CHECK FOR REGISTER NOTATION 00023000 .SETX AIF (&RCOMIT).SETY SKIP IF &RC OMITTED 00024000 &RCREG SETB ('&RC'(1,1) EQ '(') CHECK FOR REGISTER NOTATION 00025000 .* &RESULT AND &RC MUST BE EITHER OMITTED, SELF-DEFINING, OR 00026000 .* FULLWORD STORAGE. IF REG. NOTATION IS USED, THEY MUST BE 00027000 .* SELF-DEFINING. 00028000 .SETY AIF (&RCREG AND '&TRC' NE 'N').RCILL 00029000 AIF (&RCOMIT OR '&TRC' EQ 'N' OR '&TRC' EQ 'F').RCLEG 00030000 .RCILL MNOTE 4,'*** RC MAY BE ILLEGAL.' 00031000 &RCREG SETB 0 00032000 .RCLEG AIF (&RESREG AND '&TRES' NE 'N').RESILL 00033000 AIF (&RESOMIT OR '&TRES' EQ 'N' OR '&TRES' EQ 'F').RESLEG 00034000 .RESILL MNOTE 4,'*** RESULT MAY BE ILLEGAL.' 00035000 &RESREG SETB 0 00036000 .* &RENT MUST BE EITHER OMITTED, 'RENT', OR 'NORENT'. 00037000 .RESLEG AIF (T'&RENT EQ 'O' OR '&RENT' EQ 'RENT' OR '&RENT' EQ X00038000 'NORENT').PARMOK 00039000 MNOTE 4,'*** FIRST PARAMETER IS INVALID AND HAS BEEN IGNORED.' 00040000 .* CHECK &RESTREG FOR LEGAL REGISTER COMBINATIONS. 00041000 .PARMOK AIF (T'&RESTREG(1) NE 'N').BADREG MUST BE SELF-DEFINING 00042000 AIF (&RESTREG(1) EQ 13 OR N'&RESTREG GT 2).BADREG 00043000 &RF SETA &RESTREG(1) FIRST REG. TO BE RESTORED 00044000 &RL SETA &RF 00045000 AIF (N'&RESTREG EQ 1).OKREG 00046000 AIF (T'&RESTREG(2) NE 'N').BADREG 00047000 AIF (&RESTREG(2) EQ 13).BADREG 00048000 AIF (&RESTREG(1) EQ 15 AND &RESTREG(2) EQ 14).BADREG 00049000 &RL SETA &RESTREG(2) LAST REG. TO BE RESTORED 00050000 AIF (&RESTREG(1) EQ 14 OR &RESTREG(1) EQ 15).OKREG 00051000 AIF (&RESTREG(2) GT 12).BADREG 00052000 AIF (&RESTREG(1) LE &RESTREG(2)).OKREG 00053000 .BADREG MNOTE 4,'*** RESTREG IS ILLEGAL. RESTREG=(14,12) ASSUMED.' 00054000 &RF SETA 14 DEFAULT REGISTERS -- (14,12) 00055000 &RL SETA 12 00056000 .* IF &RC IS PRESENT, MUST NOT RESTORE REG. 15. ALSO, 00057000 .* IF &RESULT IS PRESENT, MUST NOT RESTORE REG. 0. 00058000 .OKREG AIF (&RESOMIT AND &RCOMIT).SETA SKIP IF NOT GIVEN 00059000 AIF (NOT &RCREG).CKB IF RET. CODE IS IN REG., 00060000 AIF (&RC(1) EQ 13).BAD13 MUST NOT BE REG. 13 00061000 .CKB AIF (NOT &RESREG).RCOK RESULT ALSO CANNOT BE IN REG. 13 00062000 AIF (&RESULT(1) NE 13).RCOK 00063000 .BAD13 MNOTE 8,'*** REGISTER 13 MUST CONTAIN SAVE AREA ADDRESS.' 00064000 .RCOK AIF ((&RL EQ 14) OR (&RF GT 0 AND &RF LT 14)).SETA 00065000 AIF (&RL EQ 15).CKA 00066000 AIF (&RF EQ 0).CKD 00067000 &LD15 SETB 1 REMEMBER TO RESTORE REG. 15 00068000 AIF (&RF NE 14).CKC 00069000 &LD14 SETB 1 REMEMBER TO RESTORE REG. 14 00070000 .CKC AIF (&RCOMIT).CKD 00071000 &LD15 SETB 0 DON'T RESTORE REG. 15 00072000 &RF SETA 0 DO NOT CHANGE RET. CODE IN REG. 15 00073000 .CKD AIF (&RESOMIT).SETA 00074000 &RF SETA 1 DON'T CHANGE RESULT REGISTER 0 00075000 AIF (&RL GT 0).SETA 00076000 .NONE ANOP 00077000 &NOLOAD SETB 1 DON'T LOAD &RF OR &RL 00078000 AGO .SETA 00079000 .CKA AIF (&RCOMIT).SETA 00080000 &RL SETA 14 DON'T CHANGE REG. 15 00081000 AIF (&RF NE 14).NONE 00082000 .SETA ANOP 00083000 &A SETA &RF*4+20 SAVE AREA LOCATION OF &RF 00084000 AIF (&A LT 76).CKLOC SKIP UNLESS &RF IS 14 OR 15 00085000 &A SETA &A-64 CORRECT SAVE AREA LOC. OF 14 OR 15 00086000 .CKLOC AIF ('&LOC' EQ '').NOLOC SKIP IF &LOC OMITTED 00087000 &LOC DS 0H X GET ON A HALF WORD BOUNDARY 00088000 .NOLOC AIF ('&RENT' NE 'RENT').LD13 DO WE FREE OUR SAVE AREA 00089000 LA 0,72 X RELEASE OUR 72 BYTE SAVE AREA 00090000 LR 1,13 X SAVE AREA ADDRESS 00091000 L 13,4(13) X GET ADDRESS OF CALLER'S SAVE AREA 00092000 FREEMAIN R,LV=(0),A=(1) TURN IN OUR SAVE AREA 00093000 AIF (NOT &RCREG).TSTRES SKIP IF &RC NOT IN REG. 00094000 AIF (&RC(1) EQ 0 OR &RC(1) EQ 1 OR &RC(1) EQ 15).LOST 00095000 .TSTRES AIF (NOT &RESREG).LDRES SKIP IF &RESULT NOT IN REG. 00096000 AIF (NOT (&RESULT(1) EQ 0 OR &RESULT(1) EQ 1 OR &RESULT(1) X00097000 EQ 15)).LDRES 00098000 .LOST MNOTE 8,'*** FREEMAIN DESTROYS REGISTERS 0, 1, AND 15.' 00099000 AGO .LDRES 00100000 .LD13 L 13,4(13) X GET ADDRESS OF CALLER'S SAVE AREA 00101000 .LDRES AIF (&RESOMIT).LDRC SKIP IF &RESULT OMITTED 00102000 AIF (&RESREG).RESREG SKIP IF RESULT IN REGISTER 00103000 AIF ('&TRES' EQ 'N').ABSRES SKIP IF SELF-DEFINING RESULT 00104000 L 0,&RESULT X LOAD RESULT 00105000 AGO .LDRC 00106000 .ABSRES AIF (&RESULT EQ 0).ZERORES SKIP IF &RESULT IS 0 00107000 LA 0,&RESULT X LOAD RESULT 00108000 AGO .LDRC 00109000 .ZERORES SR 0,0 X SET RESULT OF 0 00110000 AGO .LDRC 00111000 .RESREG AIF (&RESULT(1) EQ 0).LDRC NO NEED TO LOAD REG. 0 WITH RES. 00112000 LR 0,&RESULT(1) X RESULT TO REG. 0 00113000 .LDRC AIF (&RCOMIT).LDREGS SKIP IF &RC OMITTED 00114000 AIF (&RCREG).RCREG SKIP IF &RC IN REGISTER 00115000 AIF ('&TRC' EQ 'N').ABSRC SKIP IF SELF-DEFINING RET. CODE 00116000 L 15,&RC X LOAD RETURN CODE 00117000 AGO .LDREGS 00118000 .ABSRC AIF (&RC EQ 0).ZERORC SKIP IF &RC IS 0 00119000 LA 15,&RC X LOAD RETURN CODE 00120000 AGO .LDREGS 00121000 .ZERORC SR 15,15 X SET RETURN CODE OF 0 00122000 AGO .LDREGS 00123000 .RCREG AIF (&RC(1) EQ 15).LDREGS NO NEED TO LOAD REG. 15 WITH RC 00124000 LR 15,&RC(1) X RETURN CODE TO REG. 15 00125000 .LDREGS AIF (&LD14 AND &LD15).BOTH 00126000 AIF (&LD14).LD14 00127000 AIF (NOT &LD15).LOAD 00128000 L 15,16(13) X RESTORE REGISTER 15 00129000 AGO .LOAD 00130000 .LD14 L 14,12(13) X RESTORE REGISTER 14 00131000 AGO .LOAD 00132000 .BOTH LM 14,15,12(13)&B1 RESTORE REGISTERS 14 AND 15 00133000 .LOAD AIF (&NOLOAD).FLAG SKIP IF NO LM IS TO BE ISSUED 00134000 AIF (&RF EQ &RL).ONEREG SKIP IF ONLY ONE REG. TO RESTORE 00135000 LM &RF,&RL,&A.(13)&B1 RESTORE REGISTERS 00136000 AGO .FLAG 00137000 .ONEREG L &RF,&A.(13) X RESTORE REGISTER 00138000 .FLAG MVI 12(13),X'FF'&B1 SET COMPLETION FLAG 00139000 BR 14 X RETURN TO CALLER 00140000 MEND 00141000 ./ ADD NAME=LOCAL DSN=CL.REM.UMAC MACRO 00010000 LOCAL &TYPE= 00020000 AIF ('&TYPE' EQ 'CODE').CODE 00030000 LOCAL DSECT 00040000 AGO .BOTHTYP 00050000 .CODE ANOP 00060000 LOCAL DS 0D 00070000 .BOTHTYP ANOP 00080000 NEXTLEV DC A(0) POINTER TO NEXT UPDATE LEVEL 00090000 BUFADR DC A(0) ADDRESS OF BSAM BUFFER 00100000 CTLBPL DC A(0) BUFFER POOL LENGTH AND SUBPOOL C 00110000 CTLBPA DC A(0) BUFFER POOL ADDRESS (FOR FREEMAIN) C 00120000 CURREC DC A(0) POINTER TO CURRENT RECORD IN BUFFER 00130000 MAXREC DC A(0) ADDRESS OF FIRST INVALID BYTE 00140000 LEVNAME DC CL8' ' DDNAME FOR THIS LEVEL 00150000 * 00160000 * DEFINE SPACE FOR THE CONTROL AND OLD-MASTER BUFFER AREAS. 00170000 * 00180000 CTLAREA DS 0CL106 04AHB152 00190000 CTLWYL DC CL8' ' 04AHB152 00200000 DC CL2' ' 04AHB152 00210000 CTLID DC CL6' ' LEVEL ID NO ('.01. ') 00220000 CTLBUF DS 0CL80 CURRENT CARD IMAGE 00230000 DC CL72' ' 00240000 CTLSQ DC CL8' ' SEQUENCE FIELD 00250000 DC CL2' ' 00260000 CTLPSQ DC CL8' ' PREVIOUS SEQUENCE NUMBER 00270000 CTLOSQ DC CL8' ' ORIGINAL SEQUENCE NUMBER 00280000 * 00290000 OMAREA DS 0CL106 04AHB152 00300000 OMWYL DC CL8' ' 04AHB152 00310000 DC CL2' ' 04AHB152 00320000 OMID DC CL6' ' 00330000 OMBUF DS 0CL80 CURRENT CARD IMAGE 00340000 OMDATA DC CL72' ' 00350000 OMSQ DC CL8' ' SEQUENCE FIELD 00360000 DC CL2' ' 00370000 OMPSQ DC CL8' ' PREVIOUS SEQUENCE NUMBER 00380000 OMOSQ DC CL8' ' ORIGINAL SEQUENCE NUMBER 00390000 * 00400000 KSCANPTR DC A(0) KEYWORD ROUTINE START POINTER 00410000 CMDNUM DC F'0' COMMAND SEQUENCE NUMBER 00420000 * 00430000 BLDLIST DS 0CL80 BLDL WORK AREA 00440000 DC H'1,76' 00450000 BLDLNAME DC CL8' ' 00460000 BLDLTTR DC XL3'0' 00470000 DC XL2'0' 00480000 BLDLC DC XL1'0' 00490000 BLDLUD DC XL62'0' 00500000 * 00510000 * FLAGS USED WHEN ANALYZING KEYWORDS 00520000 * THESE FLAGS ARE RESET EACH TIME A MAJOR OR DETAIL CONTROL CARD 00530000 * IS SCANNED. 00540000 * CHANGES HERE MUST BE REFLECTED IN WTABLE, KEYFLAG, KEYTABLE, 00550000 * FVALID, AND POSSIBLY IN POSTAB AND WORKF. 00560000 * 00570000 FKEYFLGS DS 0XL4 KEYWORDS 'ON' FLAGS 00580000 FLAG (FNAME,FLIST,FSSI,FVERSION,FNEWNAME) 00590000 FLAG (FSEQ1,FSEQ2,FINCR,FNEW1,FINSERT) 00600000 FLAG (FCODE,FCOL,FGANG) 00610000 FLAG (FSEQID,FCOL1,FCOL2,FFROMSEQ,FTOSEQ,FDDNAME) 00620000 * 00630000 * THESE FLAGS ARE RESET EACH TIME A MAJOR CONTROL CARD IS SCANNED. 00640000 * 00650000 CMDFLGS DS 0XL3 COMMANDS IN PROGRESS FLAGS 00660000 FLAG (ADD,CHANGE,DELETE,INSERT,NUMBER,INSERTX,XSEQ1,XSEQ2) 00670000 FLAG (SEQALL,LISTALL,SSISPEC,CTLWAIT,OMWAIT,OMEOF, X00680000 USER,UINSERT) 00690000 FLAG (NOINSERT,INSERT1,ALIAS,ALIAS2,COPY,GANG,MACRO) 00700000 * 00710000 * THESE FLAGS ARE NOT RESET AS A GROUP EVER. 00720000 * 00730000 CTLFLAGS DS 0XL2 00740000 FLAG (CTLEOF,REALEOF,CTLPS,BUFEMPTY,SYSUT1,SYSIN,POSING,HELD) 00750000 FLAG (SYSLIB,TEMPUPD,CHAINED,WYLFORMT) C 00760000 * 00770000 * 00780000 AIF ('&TYPE' EQ 'CODE').CODE2 00790000 LEVDCB DCB DSORG=PS,MACRF=R,DDNAME=SYSIN, X00800000 OPTCD=C,BUFCB=0 00810000 AGO .CONTD 00820000 .CODE2 ANOP 00830000 LEVDCB DCB DSORG=PS,MACRF=R,DDNAME=SYSIN, CX00840000 EXLST=CTLEXIT,EODAD=CTLEOD,SYNAD=CTLSYNAD,OPTCD=C, CX00850000 BUFCB=0 C 00860000 .CONTD ANOP 00870000 * 00880000 * 00890000 * CURRENT KEYWORD VALUES (EBCDIC OR PACKED) 00900000 * 00910000 NAME DC CL8' ' 00920000 SSI DC XL8'0' 00930000 SSICOUNT DC F'0' 00940000 INCR DC PL5'0' 00950000 NEW1 DC PL5'0' 00960000 XINCR DC PL5'0' 00970000 XNEW1 DC PL5'0' 00980000 INCRA DC PL5'0' RENUMBERING COUNTERS FOR COMPLETE # 00990000 NEW1A DC PL5'0' * RESEQUENCING UNDER ./CHANGE # 01000000 DS 0D 01010000 USERCODE DC CL8' ' PASSES CODE TO USER ROUTINE 01020000 USERWORK DC XL8'0' WORK AREA FOR USER ROUTINE 01030000 SEQ1 DC CL8' ' 01040000 SEQ2 DC CL8' ' 01050000 CODE DC CL8' ' 01060000 GANGCOL DC F'0' 01070000 GANGLEN DC F'0' 01080000 UNAME DC CL8' ' NAME OF USER ROUTINE 01090000 * 01100000 OMSEQ DC CL8' ' PREVIOUS OM SEQ. 01110000 * 01120000 LCLFCBAD DC A(0) ADDRESS FIRST FIX CONTROL BLOCK 01130000 REALDCB DC A(1) DCB POINTER FOR CHAINED UPDATES 01140000 * 01150000 LEVSAVE DC 9F'0' 01160000 LOCALSZ EQU *-LOCAL 01170000 BACKLEV EQU LEVSAVE+28 01180000 MEND 01190000 ./ ADD NAME=LOCAL1 DSN=CL.REM.UMAC MACRO 00001000 LOCAL 00002000 NEXTLEV DC A(0) POINTER TO NEXT UPDATE LEVEL 00060000 BUFADR DC A(0) ADDRESS OF BSAM BUFFER 00080000 DC A(0) AND FOR A SECOND ONE 00100000 CURREC DC A(0) POINTER TO CURRENT RECORD IN BUFFER 00120000 MAXREC DC A(0) ADDRESS OF FIRST INVALID BYTE 00140000 LEVNAME DC CL8' ' DDNAME FOR THIS LEVEL 00160000 * 00180000 * DEFINE SPACE FOR THE CONTROL AND OLD-MASTER BUFFER AREAS. 00200000 * 00220000 CTLAREA DS 0CL96 00240000 CTLID DC CL6' ' LEVEL ID NO ('.01. ') 00260000 CTLBUF DS 0CL80 CURRENT CARD IMAGE 00280000 DC CL72' ' 00300000 CTLSQ DC CL8' ' SEQUENCE FIELD 00320000 DC CL2' ' 00340000 CTLPSQ DC CL8' ' PREVIOUS SEQUENCE NUMBER 00360000 CTLOSQ DC CL8' ' ORIGINAL SEQUENCE NUMBER 00380000 * 00400000 OMAREA DS 0CL96 00420000 OMID DC CL6' ' 00440000 OMBUF DS 0CL80 CURRENT CARD IMAGE 00460000 OMDATA DC CL72' ' 00480000 OMSQ DC CL8' ' SEQUENCE FIELD 00500000 DC CL2' ' 00520000 OMPSQ DC CL8' ' PREVIOUS SEQUENCE NUMBER 00540000 OMOSQ DC CL8' ' ORIGINAL SEQUENCE NUMBER 00560000 * 00580000 KSCANPTR DC A(0) KEYWORD ROUTINE START POINTER 00600000 CMDNUM DC F'0' COMMAND SEQUENCE NUMBER 00620000 * 00640000 BLDLIST DS 0CL80 BLDL WORK AREA 00660000 DC H'1,76' 00680000 BLDLNAME DC CL8' ' 00700000 BLDLTTR DC XL3'0' 00720000 DC XL2'0' 00740000 BLDLC DC XL1'0' 00760000 BLDLUD DC XL62'0' 00780000 * 00800000 * FLAGS USED WHEN ANALYZING KEYWORDS 00820000 * THESE FLAGS ARE RESET EACH TIME A MAJOR OR DETAIL CONTROL CARD 00840000 * IS SCANNED. 00860000 * CHANGES HERE MUST BE REFLECTED IN WTABLE, KEYFLAG, KEYTABLE, 00880000 * FVALID, AND POSSIBLY IN POSTAB AND WORKF. 00900000 * 00920000 FKEYFLGS DS 0XL4 KEYWORDS 'ON' FLAGS 00940000 FLAG (FNAME,FLIST,FSSI,FVERSION,FNEWNAME) 00960000 FLAG (FSEQ1,FSEQ2,FINCR,FNEW1,FINSERT) 00980000 FLAG (FCODE,FCOL,FGANG) 01000000 FLAG (FSEQID,FCOL1,FCOL2,FFROMSEQ,FTOSEQ,FDDNAME) 01020000 * 01040000 * THESE FLAGS ARE RESET EACH TIME A MAJOR CONTROL CARD IS SCANNED. 01060000 * 01080000 CMDFLGS DS 0XL3 COMMANDS IN PROGRESS FLAGS 01100000 FLAG (ADD,CHANGE,DELETE,INSERT,NUMBER,INSERTX,XSEQ1,XSEQ2) 01120000 FLAG (SEQALL,LISTALL,SSISPEC,CTLWAIT,OMWAIT,OMEOF, X01140000 USER,UINSERT) 01160000 FLAG (NOINSERT,INSERT1,ALIAS,ALIAS2,COPY,GANG,MACRO) 01180000 * 01200000 * THESE FLAGS ARE NOT RESET AS A GROUP EVER. 01220000 * 01240000 CTLFLAGS DS 0XL2 01260000 FLAG (CTLEOF,REALEOF,CTLPS,BUFEMPTY,SYSUT1,SYSIN,POSING,HELD) 01280000 FLAG (SINGLE,SYSLIB) 01300000 * 01320000 ** DCB DSORG=PO,MACRF=R,DDNAME=SYSIN,NCP=1,LRECL=80,RECFM=FB, 01340000 ** EXLST=CTLEXIT,EODAD=CTLEOD,SYNAD=CTLSYNAD 01360000 * 01380000 LEVDCB DCB DSORG=PO,MACRF=R,DDNAME=SYSIN,NCP=1,LRECL=80,RECFM=FB, X01400000 EXLST=CTLEXIT,EODAD=CTLEOD,SYNAD=CTLSYNAD 01420000 * 01440000 ** READ CTLDECB,SF,MF=L 01460000 * 01480000 READ CTLDECB,SF,MF=L 01500000 * 01520000 * 01540000 * CURRENT KEYWORD VALUES (EBCDIC OR PACKED) 01560000 * 01580000 NAME DC CL8' ' 01600000 SSI DC XL8'0' 01620000 SSICOUNT DC F'0' 01640000 INCR DC PL5'0' 01660000 NEW1 DC PL5'0' 01680000 XINCR DC PL5'0' 01700000 XNEW1 DC PL5'0' 01720000 DS 0D 01740000 USERCODE DC CL8' ' PASSES CODE TO USER ROUTINE 01760000 USERWORK DC XL8'0' WORK AREA FOR USER ROUTINE 01780000 SEQ1 DC CL8' ' 01800000 SEQ2 DC CL8' ' 01820000 CODE DC CL8' ' 01840000 GANGCOL DC F'0' 01860000 GANGLEN DC F'0' 01880000 UNAME DC CL8' ' NAME OF USER ROUTINE 01900000 * 01920000 OMSEQ DC CL8' ' PREVIOUS OM SEQ. 01940000 * 01960000 LCLFCBAD DC A(0) ADDRESS FIRST FIX CONTROL BLOCK 01980000 * 02000000 LEVSAVE DC 9F'0' 02020000 LOCALSZ EQU *-NEXTLEV 02040000 MEND 02060000 ./ ADD NAME=NMDSECT DSN=CL.REM.UMAC MACRO 00010000 NMDSECT 00020000 * DSECT DESCRIBING AN OUTPUT FILE FOR THE NM- ROUTINES 00030000 * (DONE TO ALLOW SYSPUNCH TO USE THE SEQUENTIAL/PARTITIONED LOGIC 00040000 * OF THE NM- ROUTINE, ORIGINALLY WRITTEN FOR SYSUT2 ALONE). 00050000 * 00060000 NMDSECT DSECT 00070000 NMBUFADR DC F'0' BUFFER ADDRSES FOR NEW MASTER WRITE C 00080000 NMCURREC DC F'0' POINTER TO CURRENT RECORD IN BUFFER 00090000 NMBUFLIM DC F'0' 00100000 NMBPL DC F'0' BUFFER POOL SIZE AND SUBPOOL C 00110000 NMBPA DC F'0' BUFFER POOL ADDRESS C 00120000 FDAD DC XL8'0' 00130000 NM DCB DDNAME=SYSUT2,DSORG=PO,MACRF=W C 00140000 TRBAL DC H'0' C 00150000 FLAG (NMPS,NMWYLFMT) WYLSH594 00160000 * 00170000 * 00180000 *HEX DEC 00190000 * *-----------------------------------------------------------* 00200000 * 0 0 | NMBUFADR | 00210000 * | BUFFER ADDRESSES | 00220000 * | | 00230000 * | | 00240000 * | | 00250000 * | | 00260000 * | | 00270000 * *-----------------------------------------------------------* 00280000 * 8 8 | NMCURRED | 00290000 * | RECORD POINTER WITHIN CURRENT BUFFER | 00300000 * | | 00310000 * *-----------------------------------------------------------* 00320000 * C 12 | NMBUFLIM | 00330000 * | LIMITING ADDRESS FOR CURRENT BUFFER | 00340000 * | | 00350000 * *-----------------------------------------------------------* 00360000 * 10 16 | FDAD | 00370000 * | SAVES DCB FULL DIRECT ACCESS ADDRESS | 00380000 * | | 00390000 * | | 00400000 * | | 00410000 * | | 00420000 * | | 00430000 * *-----------------------------*-----------------------------* 00440000 * 18 24 | TRBAL | RESERVED | 00450000 * | DCB'S TRACK BALANCE | | 00460000 * | | | 00470000 * *-----------------------------*-----------------------------* 00480000 * 1C 28 | NM | 00490000 * | DCB FOR AN OUTPUT DATA SET (SYSUT2 OR SYSPUNCH) | 00500000 * | | 00510000 * / / 00520000 * / / 00530000 * | | 00540000 * | | 00550000 * *-----------------------------------------------------------* 00560000 * 74 116 | NMDECB | 00570000 * | DECB FOR USE WITH THE ABOVE DCB | 00580000 * | | 00590000 * / / 00600000 * / / 00610000 * | | 00620000 * | | 00630000 * *--------------*--------------------------------------------* 00640000 * 88 136 | | 00650000 * | SOME FLAGS | 00660000 * | | 00670000 * *--------------* 00680000 MEND 00690000 ./ ADD NAME=OPENS DSN=CL.REM.UMAC MACRO 00001000 &NAME OPENS &T,&MODE=INPUT 00002000 GBLB &IEUS(99) 00003000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00004000 OPEN (IEUIO&T,(&MODE)) 00005000 &IEUS(&T) SETB 1 00006000 LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00007000 MEND 00008000 ./ ADD NAME=ORR DSN=CL.REM.UMAC MACRO 00010000 &LABEL ORR &TRUE,&FALSE 00020000 GBLA &I,&IMAX,&L 00030000 GBLC &LAB(255),&LIST(255) 00040000 LCLA &K,&N,&L1 00050000 LCLC &NAME 00060000 &NAME SETC '&LABEL' 00070000 .* SEE IF AN OR OPERATION OCCURS AT THE SAME PARENTHESIS LEVEL 00080000 .LOOP ANOP 00090000 &K SETA &I 00100000 &N SETA 0 00110000 .AGAIN AIF (&K GT &IMAX).NO 00120000 AIF ('&LIST(&K)' NE '(').OK1 00130000 &N SETA &N+1 00140000 AGO .END 00150000 .OK1 AIF ('&LIST(&K)' NE ')').OK2 00160000 &N SETA &N-1 00170000 AIF (&N LT 0).NO 00180000 .END ANOP 00190000 &K SETA &K+1 00200000 AGO .AGAIN 00210000 .OK2 AIF (&N NE 0).END 00220000 AIF ('&LIST(&K)' NE '+').END 00230000 .* IF SO: 00240000 &L SETA &L+1 00250000 &LAB(&L) SETC '' 00260000 &L1 SETA &L 00270000 &NAME AND &TRUE,&L1 00280000 &I SETA &I+1 00290000 BRANCH O,&TRUE 00300000 &NAME SETC '&LAB(&L1)' 00310000 AGO .LOOP 00320000 .* IF NOT: 00330000 .NO ANOP 00340000 &NAME AND &TRUE,&FALSE 00350000 MEND 00360000 ./ ADD NAME=PCB DSN=CL.REM.UMAC MACRO 00000010 PCB &TYPE=,<ERM=,&DBDNAME=,&PROCOPT=,&KEYLEN= 00000020 GBLC &P(255),&S(255),&T(255),&G(50) 00000030 GBLA &Y,&I,&J,&K,&L,&M,&N,&U 00000040 GBLA &W,&W1,&W2,&W3,&W4,&TP,&DB,&CTR 00000050 GBLB &E,&CO,&PL,&REUS 00000060 &I SETA &I+1 00000070 &K SETA &K+1 00000080 &L SETA &L+1 00000090 &N SETA 0 00000100 AIF ('&TYPE' EQ '').TYPERR TYPE PARAMETER MISSING 00000110 AIF ('&TYPE' EQ 'TP').TP TP 00000120 AIF ('&TYPE' EQ 'DB').DB DB 00000130 AGO .TYPERR INVALID TYPE PARAMETER 00000140 .TP ANOP 00000150 &TP SETA &TP+1 00000160 &P(&I) SETC '&TYPE' 00000170 &I SETA &I+1 00000180 AIF ('&DBDNAME' NE '').NAMERR 00000190 AIF ('&PROCOPT' NE '').PROCERR 00000200 AIF ('&KEYLEN' NE '').KEYERR2 00000210 AIF ('<ERM' EQ '').LTERR LTERM PARAMETER MISSING 00000220 &P(&I) SETC '<ERM' 00000230 MEXIT 00000240 .DB ANOP 00000250 &DB SETA &DB+1 00000260 &P(&I) SETC '&TYPE' 00000270 &I SETA &I+1 00000280 AIF ('<ERM' NE '').LTMERR 00000290 AIF ('&DBDNAME' EQ '').DBERR DBDNAME PARAMETER MISSING 00000300 &P(&I) SETC '&DBDNAME' 00000310 &I SETA &I+1 00000320 AIF ('&PROCOPT' EQ '').PROERR PROCOPT PARAMETER MISSING 00000330 AIF ('&PROCOPT' NE 'A').GET 00000340 &P(&I) SETC '&PROCOPT' 00000350 AGO .KEY 00000360 .GET AIF ('&PROCOPT' NE 'G').LOAD 00000370 &P(&I) SETC '&PROCOPT' 00000380 AGO .KEY 00000390 .LOAD AIF ('&PROCOPT' NE 'L').INSERT 00000400 &P(&I) SETC '&PROCOPT' 00000410 AGO .KEY 00000420 .INSERT AIF ('&PROCOPT' NE 'I').OPTERR 00000430 &P(&I) SETC '&PROCOPT' 00000440 .KEY ANOP 00000450 &I SETA &I+1 00000460 AIF ('&KEYLEN' EQ '').KEYERR KEYLEN PARAMETER MISSING 00000470 &P(&I) SETC '&KEYLEN' 00000480 &I SETA &I+1 00000490 &Y SETA &I SAVE NUMBER OF SS SUBSCRIPT 00000500 &P(&Y) SETC '#SENSEG' 00000510 MEXIT 00000520 .TYPERR MNOTE 8,'---PCB010--- TYPE PARAMETER MISSING OR INVALID' 00000530 &E SETB 1 00000540 MEXIT 00000550 .LTERR MNOTE 8,'---PCB020--- LTERM PARAMETER NOT SPECIFIED' 00000560 &E SETB 1 00000570 MEXIT 00000580 .DBERR MNOTE 8,'---PCB030--- DBDNAME PARAMETER NOT SPECIFIED' 00000590 &E SETB 1 00000600 MEXIT 00000610 .KEYERR MNOTE 8,'---PCB040--- KEYLEN PARAMETER NOT SPECIFIED' 00000620 &E SETB 1 00000630 MEXIT 00000640 .PROERR MNOTE 8,'---PCB050--- PROCOPT PARAMETER NOT SPECIFIED' 00000650 &E SETB 1 00000660 MEXIT 00000670 .NAMERR MNOTE 8,'---PCB060---DBDNAME SPECIFIED FOR TP PCB' 00000680 &E SETB 1 00000690 MEXIT 00000700 .PROCERR MNOTE 8,'---PCB070---PROCOPT SPECIFIED FOR TP PCB' 00000710 &E SETB 1 00000720 MEXIT 00000730 .KEYERR2 MNOTE 8,'---PCB080---KEYLEN OPERAND FOR TP PCB' 00000740 &E SETB 1 00000750 MEXIT 00000760 .LTMERR MNOTE 8,'---PCB090---LTERM OPERAND SPECIFIED FOR DB PCB' 00000770 &E SETB 1 00000780 MEXIT 00000790 .OPTERR MNOTE 8,'---PCB100---INVALID PROCESSING OPTIONS IN PCB' 00000800 &E SETB 1 00000810 MEXIT 00000820 MEND 00000830 ./ ADD NAME=PL1END DSN=CL.REM.UMAC MACRO 00001000 PL1END 00002000 .* 00003000 .********************************************************************** 00004000 .* * 00005000 .* PL1END -- PL1 PROCEDURE INTERFACE MACRO 25 MAY 1971 * 00006000 .* * 00007000 .********************************************************************** 00008000 .* 00009000 .* 00010000 .* 00011000 COPY PL1GLOBL 00012000 .* 00013000 .* 00014000 .*** ARGUMENT CHECKING ************ 00015000 .* 00016000 .* 00017000 AIF (&PL1DEF).DEFINED BRANCH IF PL1PROC HAS BEEN USED 00018000 MNOTE 12,'PL1PROC MACRO HAS NOT BEEN ISSUED' 00019000 MEXIT 00020000 .DEFINED ANOP 00021000 .* 00022000 .* 00023000 .*** CODE GENERATION *************** 00024000 .* 00025000 .* 00026000 * 00027000 *** END PROCEDURE ****************** 00028000 * 00029000 SPACE 00030000 L BR,=V(IHESAFA) ? FREE AUTOMATIC STORAGE 00031000 BALR LR,BR 00032000 DROP RJ 00033000 SPACE 00034000 * 00035000 *** EPILOGUE SUBROUTINE ************ 00036000 * 00037000 SPACE 00038000 PL1EPILG DS 0H 00039000 USING *,BR 00040000 AIF (NOT &PL1RCRS).RCRS10 00041000 SPACE 00042000 TM 1(DR),X'80' ? IS THE DSA FOR THIS BLOCK IN STATIC 00043000 BZ PL1EPIL3 ? OR RESERVED STORAGE? 00044000 SPACE 00045000 L RB,80(,DR) ? YES- IS THERE ANOTHER INVOCATION OF 00046000 LTR RB,RB ? THIS BLOCK IN EXISTANCE? 00047000 BNZ PL1EPIL3 ? BRANCH IF SO 00048000 .RCRS10 SPACE 00049000 C DR,*-*(PR) ? HAVE ANY VDA'S OR DSA'S 00050000 ORG *-2 ? BEEN GOTTEN BEYOND THE 00051000 DC QL2(IHEQSLA) ? DSA FOR THIS 00052000 BNE PL1EPIL3 ? PROCEDURE BLOCK? 00053000 SPACE 00054000 L DR,4(,DR) 00055000 ST DR,*-*(PR) ? NO- TAKE THE STORAGE FOR THIS 00056000 ORG *-2 ? ENVIRONMENT OFF TOP OF STACK 00057000 DC QL2(IHEQSLA) 00058000 SPACE 00059000 PL1EPIL1 TM 0(DR),X'80' ? IS THIS PROCEDURE A SORT EXIT? 00060000 BO PL1EPIL2 00061000 SPACE 00062000 L DR,4(,DR) ? YES- GO POP ANOTHER ENVIRONMENT 00063000 B PL1EPIL1 00064000 SPACE 00065000 PL1EPIL2 ST RB,8(,DR) ? ZERO THE CHAIN-FORWARD FIELD 00066000 SPACE 00067000 LM LR,WR,12(DR) ? RESTORE THE CALLER'S REGISTERS 00068000 BR LR ? AND RETURN TO HIM 00069000 SPACE 00070000 PL1EPIL3 L BR,=V(IHESAFA) ? STORAGE HAS BEEN GOTTEN- 00071000 BR BR ? CALL SUBROUTINE TO FREE IT & RETURN 00072000 SPACE 00073000 * 00074000 *** STATIC PROLOGUE SUBROUTINE ***** 00075000 * 00076000 SPACE 00077000 PL1PROLG L RD,*-*(PR) ? IS THIS AN 'UNCURSIVE' 00078000 ORG *-2 ? ENTRY (TEMPORARY RESTORATION 00079000 DC QL2(IHEQINV) ? OF A PREVIOUS ENVIRONMENT) 00080000 LTR RD,RD ? AS INDICATED BY IHESARA'S SETTING 00081000 BNM PL1PROL1 ? THE SIGN BIT OF IHEQINV? 00082000 SPACE 00083000 L RG,*-*(PR) ? YES- 00084000 ORG *-2 00085000 DC QL2(IHEQLW0) 00086000 MVC 80(4,RC),80(RG) 00087000 SPACE 00088000 LA RD,1(,RD) ? INCREMENT THE BLOCK INVOCATION COUNT 00089000 ST RD,*-*(PR) ? PSEUDO-REGISTER AND COPY THE NEW 00090000 ORG *-2 ? COUNT INTO THE INVOCATION COUNT 00091000 DC QL2(IHEQINV) ? FIELD OF THE GOTTEN DSA. 00092000 ST RD,84(,RC) 00093000 SPACE 00094000 MVI 76(RC),X'00' 00095000 SPACE 00096000 PL1PROL1 ST RC,8(,DR) ? SET CALLER'S DSA CHAIN-FORWARD FIELD 00097000 SPACE 00098000 LR DR,RC 00099000 L RC,*-*(PR) ? SET GOTTEN DSA'S CHAIN-BACK 00100000 ORG *-2 ? FIELD TO THE ADDRESS OF THE 00101000 DC QL2(IHEQSLA) ? PREVIOUS DSA 00102000 ST RC,4(,DR) 00103000 SPACE 00104000 ST DR,*-*(PR) ? UPDATE MOST-RECENTLY-GOTTEN 00105000 ORG *-2 ? BLOCK PSEUDO-REGISTER 00106000 DC QL2(IHEQSLA) 00107000 SPACE 00108000 ST RB,8(,DR) ? ZERO CHAIN-FORWARD FIELD 00109000 SPACE 00110000 BR LR ? RETURN 00111000 SPACE 00112000 * 00113000 *** STATIC INTERNAL STORAGE ******** 00114000 * 00115000 SPACE 00116000 &PL1STAT CSECT 00117000 LTORG 00118000 SPACE 00119000 * 00120000 *** DYNAMIC STORAGE **************** 00121000 * 00122000 SPACE 00123000 AIF (&PL1RCRS).RECURSE 00124000 PL1DSA DS 0F 00125000 DC X'80' ? FLAGS 00126000 DC X'800000' ? DSA+01 LENGTH 00127000 AGO .NOTRCRS 00128000 .RECURSE ANOP 00129000 PL1DSA DSECT 00130000 DS C ? FLAGS 00131000 DS AL3 ? DSA+01 LENGTH 00132000 .NOTRCRS ANOP 00133000 DS A ? DSA+04 SAVE AREA - CHAIN-BACK ADDRESS 00134000 DS A ? DSA+08 CHAIN-FORWARD ADDRESS 00135000 DS 15A ? DSA+12 REGISTERS 14 - 12 00136000 DS 2A ? DSA+72 CURRENT FILE PSEUDO-REGISTER UPDATE 00137000 DS 2A ? DSA+80 INVOCATION COUNT 00138000 DC Q(&PL1SUDO) DSA+88 PSEUDO-REGISTER OFFSET 00139000 MEND 00140000 ./ ADD NAME=PL1GLOBL DSN=CL.REM.UMAC GBLB &PL1DEF DEFINITION IN EFFECT FLAG 00001000 GBLC &PL1NAME PROCEDURE CSECT NAME 00002000 GBLA &PL1NMCT CHARACTERS IN PROCEDURE NAME 00003000 GBLB &PL1RCRS RECURSIVE PROCEDURE OPTION FLAG 00004000 GBLC &PL1STAT STATIC CSECT NAME TO BE ASSEMBLED 00005000 GBLC &PL1SUDO PSEUDO-REGISTER NAME FOR ASSEMBLER 00006000 ./ ADD NAME=PL1LAST DSN=CL.REM.UMAC MACRO 00001000 PL1LAST 00002000 .* 00003000 .********************************************************************** 00004000 .* * 00005000 .* PL1LAST -- PL1 PROCEDURE INTERFACE MACRO 16 MAY 1971 * 00006000 .* * 00007000 .********************************************************************** 00008000 .* 00009000 .* 00010000 .* 00011000 COPY PL1GLOBL 00012000 .* 00013000 .* 00014000 .*** ARGUMENT CHECKING ************ 00015000 .* 00016000 .* 00017000 AIF (&PL1DEF).DEFINED BRANCH IF PL1PROC HAS BEEN USED 00018000 MNOTE 12,'PL1PROC MACRO HAS NOT BEEN ISSUED' 00019000 MEXIT 00020000 .DEFINED ANOP 00021000 .* 00022000 .* 00023000 .*** CODE GENERATION *************** 00024000 .* 00025000 .* 00026000 PL1DSLEN EQU *-PL1DSA ? LENGTH OF DYNAMIC STORAGE 00027000 SPACE 00028000 MEND 00029000 ./ ADD NAME=PL1PRINT DSN=CL.REM.UMAC MACRO 00001000 &NAME PL1PRINT &P1,&P2,&P3 00002000 .* 00003000 .********************************************************************** 00004000 .* * 00005000 .* PL1PRINT -- PL1 PROCEDURE INTERFACE MACRO 31 MAY 1971 * 00006000 .* * 00007000 .********************************************************************** 00008000 .* 00009000 .* 00010000 .* 00011000 COPY PL1GLOBL 00012000 LCLA &TEMP,&LIMIT,&INDEX TEMPORARY STORAGE 00013000 LCLB &PAGE PAGE OPTION SPECIFIED 00014000 LCLB &SKIP SKIP OPTION SPECIFIED 00015000 LCLB &LINE LINE OPTION SPECIFIED 00016000 LCLB &TEXT TEXT OPTION SPECIFIED 00017000 LCLC &N NUMBER SPEC FOR LINE OR SKIP 00018000 LCLA &TEXTPOS POSITION OF LITERAL TEXT IN SYSLIST 00019000 LCLC &TEXTSDV NAME OF THE TEXT STRING DOPE VECTOR 00020000 LCLB &VARIBLN &N HAS A SYMBOLIC VALUE 00021000 LCLA &TEXTLEN LENGTH OF LITERAL TEXT IN BYTES 00022000 LCLA &TEXTHAF LENGTH OF LITERAL TEXT IN HALFWORDS 00023000 LCLA &INITLEN LENGTH OF INITIALIZE ARGUMENT LIST 00024000 LCLA &ABRETRN BYTES TO BRANCH AROUND ON ABNORMAL 00025000 .* RETURN FROM OUTPUT INITIALIZATION 00026000 .* 00027000 .* 00028000 .*** ARGUMENT CHECKING ************ 00029000 .* 00030000 .* 00031000 .* 00032000 AIF (&PL1DEF).DEFINED BRANCH IF PL1PROC HAS BEEN USED 00033000 MNOTE 12,'PL1PROC MACRO HAS NOT BEEN ISSUED' 00034000 MEXIT 00035000 .DEFINED ANOP 00036000 &TEMP SETA 1 00037000 &LIMIT SETA N'&SYSLIST 00038000 AIF (&LIMIT NE 0).SEQ010 00039000 MNOTE 4,'NO MACRO ARGUMENTS' 00040000 &NAME DS 0H 00041000 MEXIT 00042000 .*--------------------------------------------------------------------* 00043000 .* DETECT "PAGE" -- CONFLICTS WITH "SKIP" * 00044000 .*--------------------------------------------------------------------* 00045000 .SEQ010 AIF ('&SYSLIST(&TEMP)' NE 'PAGE').SEQ020 00046000 AIF (&SKIP).SEQ070 00047000 &PAGE SETB 1 00048000 AGO .SEQ060 00049000 .*--------------------------------------------------------------------* 00050000 .* DETECT "SKIP" OR "SKIP(NUMBER)" OR "SKIP(VARIABLE)" -- * 00051000 .* CONFLICTS WITH "PAGE" OR "LINE" * 00052000 .*--------------------------------------------------------------------* 00053000 .SEQ020 AIF ('&SYSLIST(&TEMP)'(1,4) NE 'SKIP').SEQ030 00054000 AIF (&PAGE OR &LINE).SEQ070 00055000 &SKIP SETB 1 00056000 &N SETC '1' 00057000 AIF (K'&SYSLIST(&TEMP) EQ 4).SEQ060 00058000 AIF ('&SYSLIST(&TEMP)'(5,1) NE '(').SEQ050 00059000 &N SETC '&SYSLIST(&TEMP)'(6,K'&SYSLIST(&TEMP)-6) 00060000 AGO .SEQ060 00061000 .*--------------------------------------------------------------------* 00062000 .* DETECT "LINE(NUMBER)" OR "LINE(VARIABLE)" -- * 00063000 .* CONFLICTS WITH "SKIP" * 00064000 .*--------------------------------------------------------------------* 00065000 .SEQ030 AIF ('&SYSLIST(&TEMP)'(1,4) NE 'LINE').SEQ040 00066000 AIF (K'&SYSLIST(&TEMP) LT 7).SEQ050 00067000 AIF ('&SYSLIST(&TEMP)'(5,1) NE '(').SEQ050 00068000 AIF (&SKIP).SEQ070 00069000 &LINE SETB 1 00070000 &N SETC '&SYSLIST(&TEMP)'(6,K'&SYSLIST(&TEMP)-6) 00071000 AGO .SEQ060 00072000 .*--------------------------------------------------------------------* 00073000 .* DETECT "(MSGSDV)" (ADDRESS OF STRING DOPE VECTOR OF MESSAGE) * 00074000 .*--------------------------------------------------------------------* 00075000 .SEQ040 AIF ('&SYSLIST(&TEMP)'(1,1) NE '(').SEQ045 00076000 &TEXTSDV SETC '&SYSLIST(&TEMP)'(2,K'&SYSLIST(&TEMP)-2) 00077000 &TEXT SETB 1 00078000 AGO .SEQ060 00079000 .*--------------------------------------------------------------------* 00080000 .* DETECT " 'TEXT OF MESSAGE' " (LITERAL FORM OF MESSAGE TEXT) * 00081000 .*--------------------------------------------------------------------* 00082000 .SEQ045 AIF ('&SYSLIST(&TEMP)'(1,1) NE '''').SEQ050 00083000 &TEXT SETB 1 00084000 &TEXTPOS SETA &TEMP 00085000 AGO .SEQ060 00086000 .*--------------------------------------------------------------------* 00087000 .* FLAG UNRECOGNIZABLE MACRO OPERANDS * 00088000 .*--------------------------------------------------------------------* 00089000 .SEQ050 MNOTE 4,'ARGUMENT ''&SYSLIST(&TEMP)'' NOT RECOGNIZED' 00090000 .SEQ060 ANOP 00091000 &TEMP SETA &TEMP+1 00092000 AIF (&TEMP LE &LIMIT).SEQ010 00093000 AGO .SEQ080 00094000 .*--------------------------------------------------------------------* 00095000 .* FLAG ILLEGAL FORMATTING COMBINATIONS * 00096000 .*--------------------------------------------------------------------* 00097000 .SEQ070 MNOTE 4,'ILLEGAL COMBINATION OF FORMATTING OPTIONS' 00098000 AGO .SEQ060 00099000 .*--------------------------------------------------------------------* 00100000 .* *** END OF OPERAND DETECTION *** * 00101000 .*--------------------------------------------------------------------* 00102000 .* 00103000 .* 00104000 .*--------------------------------------------------------------------* 00105000 .* IF TEXT WAS SPECIFIED IN THE LITERAL FORM, GET A COUNT OF * 00106000 .* THE NUMBER OF CHARACTERS IN THE MESSAGE BY STARTING WITH * 00107000 .* THE K' ATTRIBUTE OF THE OPERAND AND SCANNING FOR EMBEDDED * 00108000 .* ''S AND &&S WHICH WILL BE REDUCED UPON ASSEMBLY. * 00109000 .*--------------------------------------------------------------------* 00110000 .SEQ080 AIF (NOT &TEXT).SEQ130 00111000 AIF (&TEXTPOS EQ 0).SEQ130 00112000 &LIMIT SETA K'&SYSLIST(&TEXTPOS) 00113000 &TEXTLEN SETA &LIMIT-2 00114000 &INDEX SETA 1 00115000 .SEQ090 ANOP 00116000 &INDEX SETA &INDEX+1 00117000 AIF ('&SYSLIST(&TEXTPOS)'(&INDEX,1) NE '''').SEQ110 00118000 AIF (&INDEX EQ &LIMIT).SEQ120 00119000 .SEQ100 ANOP 00120000 &INDEX SETA &INDEX+1 00121000 &TEXTLEN SETA &TEXTLEN-1 00122000 &TEMP SETA &TEMP-1 00123000 AGO .SEQ090 00124000 .SEQ110 AIF ('&SYSLIST(&TEXTPOS)'(&INDEX,2) NE '&&').SEQ090 00125000 AGO .SEQ100 00126000 .SEQ120 ANOP 00127000 &TEXTHAF SETA (&TEXTLEN+1)/2*2 00128000 .*--------------------------------------------------------------------* 00129000 .* GENERATE THE CALLING SEQUENCE FOR THE APPROPRIATE STREAM * 00130000 .* OUTPUT INITIALIZATION MODULE. THE CALLING SEQUENCE USES * 00131000 .* THREE VALUES CALCULATED FROM THE MACRO OPERANDS: * 00132000 .* 1. THE LENGTH OF THE ARGUMENT LIST IS 2, 3 OR 4 WORDS * 00133000 .* DEPENDING ON WHETHER SKIP OR LINE WAS USED, AND IF SO, * 00134000 .* WHETHER A NUMBER OR VARIBLE NAME WAS USED TO SPECIFY * 00135000 .* THE LINE COUNT. * 00136000 .* 2. THE SUBROUTINE ABNORMAL RETURN ADDRESS, WHICH DEPENDS * 00137000 .* ON ITEM 1 AS WELL AS ON THE LENGTH OF THE CALLING * 00138000 .* SEQUENCE TO BE GENERATED FOR THE TEXT SPECIFICATION, * 00139000 .* IF ONE HAS BEEN GIVEN. * 00140000 .* 3. THE ENTRY NAME TO BE INVOKED, WHICH DEPENDS ON THE * 00141000 .* FORMATTING OPTIONS (PAGE, SKIP, LINE) REQUESTED. * 00142000 .*--------------------------------------------------------------------* 00143000 .SEQ130 ANOP 00144000 &INITLEN SETA 20 00145000 &ABRETRN SETA 18 00146000 AIF (&SKIP OR &LINE).SEQ140 00147000 &INITLEN SETA 12 00148000 &ABRETRN SETA 9 00149000 AGO .SEQ145 00150000 .SEQ140 AIF (('&N'(1,1) GE '0') AND ('&N'(1,1) LE '9')).SEQ145 00151000 &INITLEN SETA 16 00152000 &ABRETRN SETA 14 00153000 &VARIBLN SETB 1 00154000 .SEQ145 AIF (NOT &TEXT).SEQ150 00155000 &ABRETRN SETA &ABRETRN+14 00156000 AIF (&TEXTLEN EQ 0).SEQ150 00157000 &ABRETRN SETA &ABRETRN+&TEXTHAF+10 00158000 .SEQ150 ANOP 00159000 CNOP 0,4 00160000 &NAME BAL RA,*+&INITLEN ? BRANCH AROUND ARGUMENT LIST 00161000 DC V(IHESPRT) ? ADDRESS OF SYSPRINT DCLCB 00162000 AIF (NOT &SKIP AND NOT &LINE).SEQ170 00163000 DC A(*+&ABRETRN) ? ABNORMAL RETURN ADDRESS 00164000 DC X'80' 00165000 AIF (&VARIBLN).SEQ160 00166000 DC AL3(*+3) 00167000 DC A(&N) 00168000 AGO .SEQ180 00169000 .SEQ160 DC AL3(&N) 00170000 AGO .SEQ180 00171000 .SEQ170 DC X'80' 00172000 DC AL3(*+&ABRETRN) ? ABNORMAL RETURN ADDRESS 00173000 .SEQ180 ANOP 00174000 &INDEX SETA 4*&PAGE+2*&LINE+&SKIP+1 00175000 &N SETC 'IHEIOB'.'ACD*B*E*'(&INDEX,1) 00176000 L BR,=V(&N) ? STREAM OUTPUT INITIALIZER 00177000 BALR LR,BR 00178000 .*--------------------------------------------------------------------* 00179000 .* IF A TEXT OPERAND APPEARS, GENERATE A CALL TO THE A-FORMAT * 00180000 .* OUTPUT MODULE. IF THE TEXT WAS SPECIFIED IN LITERAL FORM, * 00181000 .* A STRING DOPE VECTOR AND THE TEXT STRING ARE BUILT IN LINE; * 00182000 .* OTHERWISE, THE ADDRESS OF THE USER'S STRING DOPE VECTOR * 00183000 .* IS PASSED. * 00184000 .*--------------------------------------------------------------------* 00185000 AIF (NOT &TEXT).SEQ210 00186000 LA RB,=X'2C' ? DED FOR FIXED CHARACTER STRING 00187000 AIF (&TEXTLEN EQ 0).SEQ190 00188000 NOPR 0 00189000 &TEMP SETA &TEXTHAF+12 00190000 BAL RA,*+&TEMP ? BRANCH AROUND SDV AND TEXT 00191000 DC A(*+8) ? STRING DOPE VECTOR FOR TEXT 00192000 DC 2Y(&TEXTLEN) 00193000 DC C&SYSLIST(&TEXTPOS) 00194000 AGO .SEQ200 00195000 .SEQ190 LA RA,&TEXTSDV 00196000 .SEQ200 L BR,=V(IHEDOBB) ? STREAM OUTPUT TRANSMITTER 00197000 BALR LR,BR 00198000 .*--------------------------------------------------------------------* 00199000 .* GENERATE A CALL TO THE STREAM OUTPUT TERMINATION MODULE * 00200000 .*--------------------------------------------------------------------* 00201000 .SEQ210 L BR,=V(IHEIOBT) ? STREAM OUTPUT TERMINATOR 00202000 BALR LR,BR 00203000 MEND 00204000 ./ ADD NAME=PL1PROC DSN=CL.REM.UMAC MACRO 00001000 &NAME PL1PROC &OPTIONS= 00002000 .* 00003000 .********************************************************************** 00004000 .* * 00005000 .* PL1PROC -- PL1 PROCEDURE INTERFACE MACRO 25 MAY 1971 * 00006000 .* * 00007000 .********************************************************************** 00008000 .* 00009000 .* 00010000 .* 00011000 COPY PL1GLOBL 00012000 LCLC &PL1STAR STATIC CSECT NAME FOR LINKAGE EDITOR 00013000 LCLC &PL1SUDR PSEUDO-REGISTER NAME FOR LINK-EDIT 00014000 LCLA &TEMP,&LIMIT TEMPORARIES 00015000 &PL1DEF SETB 1 THIS MACRO HAS BEEN INVOKED 00016000 .* 00017000 .* 00018000 .*** ARGUMENT CHECKING ************ 00019000 .* 00020000 .* 00021000 MNOTE *,'VERSION 25 MAY 1971. F-LEVEL V5 RELEASE 18' 00022000 .* 00023000 .*** CHECK THE OPTIONS SPECIFIED, AND SET DEFAULTS 00024000 .* 00025000 AIF ('&OPTIONS' EQ '').OPT100 00026000 &LIMIT SETA N'&OPTIONS 00027000 &TEMP SETA 1 00028000 .OPT000 ANOP 00029000 AIF ('&OPTIONS(&TEMP)' NE 'RECURSIVE').OPT010 00030000 &PL1RCRS SETB 1 00031000 MNOTE *,'THE PROCEDURE IS RECURSIVE' 00032000 .OPT010 ANOP 00033000 MNOTE 4,'''&OPTIONS'' IS NOT A VALID OPTION' 00034000 &TEMP SETA &TEMP+1 00035000 AIF (&TEMP LE &LIMIT).OPT000 00036000 .* 00037000 .*** PRINT MESSAGES DESCRIBING THE DEFAULT OPTIONS TAKEN 00038000 .* 00039000 .OPT100 AIF (&PL1RCRS).OPT110 00040000 MNOTE *,'THE PROCEDURE IS NOT RE-ENTERABLE' 00041000 .OPT110 ANOP 00042000 .* 00043000 .*** CHECK THE PROCEDURE NAME FOR VALIDITY 00044000 .* 00045000 AIF ('&NAME' NE '').NAME10 00046000 MNOTE 4,'PROCEDURE NAME MISSING -- ''$PROC'' USED' 00047000 &PL1NAME SETC '$PROC' SUPPLY A LEGAL PROCEDURE NAME 00048000 &PL1NMCT SETA 5 AND THE RIGHT CHARACTER COUNT 00049000 AGO .NAME30 00050000 .NAME10 AIF ('&NAME'(1,3) NE 'IHE').NAME15 00051000 MNOTE 0,'NAME BEGINNING ''IHE'' MAY CONFLICT WITH PL1 LIBRARY' 00052000 .NAME15 AIF (K'&NAME LE 7).NAME20 00053000 &PL1NAME SETC '&NAME'(1,7) PROCEDURE NAME IS TOO LONG- MAKE 00054000 &PL1NMCT SETA 7 UP A SHORTER ONE 00055000 MNOTE 4,'PROCEDURE NAME TOO LONG -- ''&PL1NAME'' USED' 00056000 AGO .NAME40 00057000 .NAME20 ANOP 00058000 &PL1NAME SETC '&NAME' SAVE PROC NAME FOR PL1PROC MACRO 00059000 &PL1NMCT SETA K'&NAME SAVE FOR PL1PROC MACRO 00060000 AIF (&PL1NMCT EQ 7).NAME40 00061000 .NAME30 ANOP 00062000 &PL1STAT SETC 'XXXXXX'(1,7-&PL1NMCT)'&PL1NAME.A' 00063000 &PL1STAR SETC '******'(1,7-&PL1NMCT)'&PL1NAME.A' 00064000 &PL1SUDO SETC 'XXXXXX'(1,7-&PL1NMCT)'&PL1NAME.B' 00065000 &PL1SUDR SETC '******'(1,7-&PL1NMCT)'&PL1NAME.B' 00066000 .* 00067000 .* 00068000 .*** CODE GENERATION *************** 00069000 .* 00070000 .* 00071000 PUNCH ' CHANGE &PL1STAT.(&PL1STAR),&PL1SUDO.(&PL1SUDR)' 00072000 AGO .NAME50 00073000 .NAME40 ANOP 00074000 &PL1STAT SETC '&PL1NAME.A' 00075000 &PL1SUDO SETC '&PL1NAME.B' 00076000 .NAME50 SPACE 00077000 * 00078000 *** PSEUDO-REGISTERS *************** 00079000 * 00080000 SPACE 00081000 &PL1SUDO DXD A ? PSEUDO-REG FOR THIS PROCEDURE BLOCK 00082000 IHEQINV DXD A ? BLOCK INVOCATION COUNT 00083000 IHEQSLA DXD A 00084000 SPACE 00085000 IHELIB STANDARD DEFINITIONS 00086000 SPACE 2 00087000 &PL1NAME CSECT ? ENTRY POINT 00088000 &TEMP SETA &PL1NMCT/4*4+16 BYTES TO BRANCH AROUND 00089000 B &TEMP.(,BR) ? BRANCH AROUND PROCEDURE NAME 00090000 DC AL1(&PL1NMCT) ? LENGTH OF PROCEDURE NAME 00091000 DC C'&PL1NAME' 00092000 DC A(PL1DSLEN) ? LENGTH OF DYNAMIC STORAGE 00093000 DC A(&PL1STAT) ? ADDRESS OF STATIC INTERNAL CSECT 00094000 SPACE 00095000 STM LR,WR,12(DR) ? SAVE REGISTERS 00096000 SPACE 00097000 &TEMP SETA &TEMP-4 00098000 L WR,&TEMP.(,BR) ? ESTABLISH ADDRESSABILITY 00099000 USING &PL1STAT,WR ? OF STATIC INTERNAL STORAGE 00100000 SPACE 00101000 L RC,=A(PL1DSA) ? ->ASSEMBLED-IN DSA 00102000 SPACE 00103000 SR RB,RB ? ZERO THE ENVIRONMENT CHAIN-BACK 00104000 ST RB,80(,RC) ? ADDRESS IN GOTTEN DSA 00105000 SPACE 00106000 L BR,=A(PL1EPILG) ? GET DYNAMIC STORAGE 00107000 BAL LR,PL1PROLG-PL1EPILG(,BR) 00108000 USING PL1DSA,DR 00109000 SPACE 00110000 ST DR,*-*(PR) ? UPDATE THE PSEUDO-REGISTER 00111000 ORG *-2 ? FOR THIS PROCEDURE BLOCK 00112000 DC QL2(&PL1SUDO) ? TO THE CURRENT INVOCATION 00113000 SPACE 00114000 BALR RJ,0 ? ESTABLISH ADDRESSABILITY 00115000 USING *,RJ ? TO THE PROGRAM CSECT 00116000 MEND 00117000 ./ ADD NAME=PSBGEN DSN=CL.REM.UMAC MACRO 00000010 PSBGEN &R,&LANG=,&PSBNAME= 00000020 GBLC &EBCDIC 00000030 GBLC &P(255),&S(255),&T(255),&G(50) 00000040 GBLA &Y,&I,&J,&K,&L,&M,&N,&U 00000050 GBLA &W,&W1,&W2,&W3,&W4,&TP,&DB,&CTR 00000060 GBLB &E,&CO,&PL,&REUS 00000070 AIF (&E).PCBERR PCB ERROR, PSBGEN TERMINATED 00000080 AIF ('&PSBNAME' EQ '').PSBERR PSBNAME MISSING 00000090 AIF ('&LANG' EQ 'ASSEM').ASSEM 00000100 AIF ('&LANG' EQ 'COBOL').COBOL 00000110 AIF ('&LANG' EQ 'FORTRAN').FORTRAN 00000120 AIF ('&LANG' EQ 'PLI').PLI 00000130 AIF ('&LANG' EQ 'PL1').PLI 00000140 AIF ('&LANG' EQ 'PL/I').PLI 00000150 AIF ('&LANG' EQ 'PL/1').PLI 00000160 AGO .LANGERR 00000170 .COBOL ANOP 00000180 .ASSEM ANOP 00000190 .FORTRAN ANOP 00000200 &CO SETB 1 COBOL ON 00000210 &PL SETB 0 PL/I OFF 00000220 AGO .GEN 00000230 .PLI ANOP 00000240 &CO SETB 0 COBOL OFF 00000250 &PL SETB 1 PL/I ON 00000260 AGO .GEN 00000270 .GEN ANOP 00000280 CONVERT VALUE=&TP,DIGITS=8,TO=EBCDIC 00000290 MNOTE *,'***************************************************' 00000300 MNOTE *,'* *' 00000310 PUNCH ' SETSSI &EBCDIC ' 00000320 MNOTE *,'* *' 00000330 MNOTE *,'***************************************************' 00000340 MNOTE *,'***************************************************' 00000350 MNOTE *,'* *' 00000360 TITLE '--- &PSBNAME --- PSB GENERATION' 00000370 MNOTE *,'* *' 00000380 MNOTE *,'***************************************************' 00000390 &PSBNAME CSECT 00000400 PSBTOP EQU * 00000410 DC F'0' RESERVED 00000420 DC F'0' PST ADDRESS 00000430 DC X'0' RESERVED 00000440 AIF ('&R' EQ '').NOT 00000450 &REUS SETB 1 00000460 .NOT ANOP 00000470 DC BL1'0&REUS&CO&PL.0000' CODE BYTE 00000480 DC H'0' PSB SIZE 00000490 &W SETA 4*&TP 00000500 DC H'&W' TP OFFSET TO LAST TPPCB 00000510 AIF (&DB EQ 0).NODBB 00000520 &W SETA 4*&TP+4 00000530 DC H'&W' DB OFFSET TO FIRST DBPCB 00000540 AGO .IO 00000550 .NODBB DC H'-1' NO DATA BASE PCBS 00000560 AIF (&TP NE 0).IO 00000570 DC F'0' I/O PCB ADDRESS 00000580 MEXIT 00000590 .IO DC F'0' I/O PCB ADDRESS 00000600 &W SETA 1 00000610 AIF (&TP NE 0).TPI 00000620 AGO .DBR 00000630 .TPI ANOP 00000640 AIF (&W EQ &TP).TPF 00000650 DC A(PCB&W-PSBTOP) PCB ADDRESS 00000660 &W SETA &W+1 00000670 AIF (&W LT &TP).TPI 00000680 .TPF ANOP 00000690 AIF (&DB EQ 0).LASTTP 00000700 DC A(PCB&W-PSBTOP) PCB ADDRESS 00000710 AGO .DBR 00000720 .LASTTP DC X'80',AL3(PCB&W-PSBTOP) LAST PCB ADDRESS 00000730 .DBR ANOP 00000740 &W SETA 1 00000750 AIF (&DB EQ 0).NODB 00000760 .DBI ANOP 00000770 AIF (&W EQ &DB).DBF 00000780 &W1 SETA &TP+&W 00000790 DC A(PCB&W1) PCB ADDRESS 00000800 &W SETA &W+1 00000810 AIF (&W LT &DB).DBI 00000820 .DBF ANOP 00000830 &W1 SETA &TP+&W 00000840 DC X'80',AL3(PCB&W1) LAST PCB ADDRESS 00000850 .NODB ANOP 00000860 &I SETA 1 00000870 &J SETA 1 00000880 &U SETA 1 TP CTR 00000890 &M SETA 1 DB CTR 00000900 &W SETA &L SAVE PCB CTR 00000910 &L SETA 1 PCB CTR 00000920 .TOP ANOP MAIN PCB LOOP 00000930 AIF ('&P(&I)' EQ 'TP').TP 00000940 AIF ('&P(&I)' EQ 'DB').DB 00000950 MNOTE *,'---PSB099--- SYSTEM ERROR, GENERATION TERMINATED' 00000960 .TP ANOP 00000970 EJECT 00000980 DS 0F 00000990 PCB&L EQU * 00001000 AIF (NOT &PL).TPPCB NOT PL/I, NO DOPE VECTORS 00001010 *********************************************************************** 00001020 *********************************************************************** 00001030 * 00001040 * DOPE VECTORS FOR TERMINAL PCB 00001050 * 00001060 DC A(TERNAM&U-PCB&L) DOPE VECTOR FOR TERMINAL NAME 00001070 DC H'8' LENGTH 00001080 DC H'8' LENGTH 00001090 DC A(CNT&U-PCB&L) DOPE VECTOR FOR CNT OFFSET 00001100 DC H'2' LENGTH 00001110 DC H'2' LENGTH 00001120 DC A(STAT&U-PCB&L) DOPE VECTOR FOR STATUS CODE 00001130 DC H'2' LENGTH 00001140 DC H'2' LENGTH 00001150 DC A(PREFX1&U-PCB&L) DOPE VECTOR FOR 1ST PREF WORD 00001160 DC H'4' 00001170 DC H'4' 00001180 DC A(PREFX2&U-PCB&L) DOPE VECTOR FOR 2ND PREF WORD 00001190 DC H'4' 00001200 DC H'4' 00001210 DC A(PREFX3&U-PCB&L) DOPE VECTOR FOR 3RD PREF WORD 00001220 DC H'4' 00001230 DC H'4' 00001240 DC A(OPTL&U-PCB&L) DOPE VECTOR FOR LAST TTR 00001250 DC H'4' LENGTH 00001260 DC H'4' LENGTH 00001270 DC A(OPTN&U-PCB&L) DOPE VECTOR FOR NEXT TTR 00001280 DC H'4' LENGTH 00001290 DC H'4' LENGTH 00001300 DC A(SMBPT&U-PCB&L) DOPE VECTOR FOR CNT/SMB PTR 00001310 DC H'4' 00001320 DC H'4' 00001330 .TPPCB ANOP 00001340 *********************************************************************** 00001350 *********************************************************************** 00001360 &I SETA &I+1 00001370 TERNAM&U DC CL8'&P(&I)' LOGICAL TERMINAL 00001380 CNT&U DC XL2'0' CNT OFFSET 00001390 STAT&U DC XL2'0' STATUS CODE 00001400 PREFX1&U DC F'0' PREFIX AREA 00001410 PREFX2&U DC F'0' 00001420 PREFX3&U DC F'0' 00001430 OPTL&U DC F'0' LAST TTR 00001440 OPTN&U DC F'0' NEXT TTR 00001450 SMBPT&U DC F'0' CNT/SMB PTR 00001460 AGO .CHECK 00001470 .DB ANOP 00001480 EJECT 00001490 DS 0F 00001500 PCB&L EQU * 00001510 &W2 SETA &I+3 PICK UP KEYLEN SUBSCRIPT 00001520 &W3 SETA &I+4 PICK UP #SS SUBSCRIPT 00001530 AIF (NOT &PL).DBPCB NOT PL/I NO DOPE VECOTRS 00001540 .* &P(&W3) = #SS 00001550 *********************************************************************** 00001560 *********************************************************************** 00001570 * 00001580 * DOPE VECTORS FOR DATA BASE PCB 00001590 * 00001600 DC A(DBNAME&M-PCB&L) DOPE VECTOR FOR DATA BASE NAME 00001610 DC H'8' LENGTH 00001620 DC H'8' LENGTH 00001630 DC A(LEVFD&M-PCB&L) DOPE VECTOR FOR LEVEL FEEDBACK 00001640 DC H'2' LENGTH 00001650 DC H'2' LENGTH 00001660 DC A(STATCD&M-PCB&L) DOPE VECTOR FOR STATUS CODES 00001670 DC H'2' LENGTH 00001680 DC H'2' LENGTH 00001690 DC A(PROCOPT&M-PCB&L) DOPE VECTOR FOR PROCESSING OPTIONS 00001700 DC H'4' LENGTH 00001710 DC H'4' LENGTH 00001720 DC A(JCBADD&M-PCB&L) DOPE VECTOR FOR JCB ADDRESS 00001730 DC A(SEGFD&M-PCB&L) DOPE VECTOR FOR SEGMENT FEEDBACK 00001740 DC H'8' LENGTH 00001750 DC H'8' LENGTH 00001760 DC A(KEYLEN&M-PCB&L) DOPE VECTOR FOR KEY LENGTH 00001770 DC A(NOSS&M-PCB&L) DOPE VECTOR FOR NO OF SS 00001780 DC A(KEYFD&M-PCB&L) DOPE VECTOR FOR KEY FEEDBACK 00001790 DC H'&P(&W2)' LENGTH 00001800 DC H'&P(&W2)' LENGTH 00001810 &CTR SETA 1 00001820 .ZLP ANOP 00001830 DC A(SN&M&CTR-PCB&L) DOPE VECTOR FOR SEG NAME 00001840 DC H'8' LENGTH 00001850 DC H'8' LENGTH 00001860 &CTR SETA &CTR+1 00001870 AIF (&CTR LE &P(&W3)).ZLP 00001880 ORG *-2 00001890 DC X'8008' 00001900 .DBPCB ANOP 00001910 *********************************************************************** 00001920 *********************************************************************** 00001930 DS 0F 00001940 &I SETA &I+1 INCREMENT &I FOR NEXT PARAMETER 00001950 DBNAME&M DC CL8'&P(&I)' DBD NAME 00001960 LEVFD&M DC CL2' ' LEVEL FEEDBACK 00001970 STATCD&M DC CL2' ' STATUS CODES 00001980 &I SETA &I+1 INCREMENT &I FOR NEXT PARAMETER 00001990 PROCOPT&M DC CL4'&P(&I)' PROCESSING OPTIONS 00002000 JCBADD&M DC F'0' JCB ADDRESS 00002010 SEGFD&M DC CL8' ' SEGMENT NAME FEEDBACK 00002020 &I SETA &I+1 INCREMENT &I FOR NEXT PARAMETER 00002030 KEYLEN&M DC F'&P(&I)' KEY LENGTH 00002040 &I SETA &I+1 INCREMENT &I FOR NEXT PARAMETER 00002050 AIF ('&P(&I)' EQ '0').SEGERR 00002060 NOSS&M DC F'&P(&I)' NO OF SENSITIVE SEGMENTS 00002070 KEYFD&M DS CL&P(&W2)' ' KEY FEEDBACK AREA 00002080 &W4 SETA 1 00002090 .SUB ANOP 00002100 SN&M&W4 DC CL8'&S(&J)' SEGMENT NAME 00002110 &J SETA &J+1 00002120 &W4 SETA &W4+1 00002130 AIF (&W4 LE &P(&W3)).SUB 00002140 .CHECK ANOP 00002150 &I SETA &I+1 00002160 &M SETA &M+1 00002170 &U SETA &U+1 00002180 &L SETA &L+1 00002190 *********************************************************************** 00002200 *********************************************************************** 00002210 AIF (&L LE &W).TOP 00002220 EJECT 00002230 MEXIT 00002240 .PCBERR MNOTE 8,'---PSB010--- PCB IN ERROR,GENERATION TERMINATED' 00002250 MEXIT 00002260 .PSBERR MNOTE 8,'---PSB020---PSBNAME NOT SPECIFIED' 00002270 MEXIT 00002280 .LANGERR MNOTE 8,'---PSB030---INVALID LANGUAGE OPERAND' 00002290 MEXIT 00002300 .SEGERR MNOTE 8,'---PSB040---NO SENSITIVE SEGMENTS FOR DB PCB' 00002310 MEXIT 00002320 MEND 00002330 ./ ADD NAME=PUTC DSN=CL.REM.UMAC MACRO 00001000 &NAME PUTC &CARD 00002000 GBLB &IEUSD 00003000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00004000 BAL 14,IEUOD CHECK TO SEE IF OPEN 00005000 PUT IEUDDCB,&CARD 00006000 LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00007000 &IEUSD SETB 1 00008000 MEND 00009000 ./ ADD NAME=PUTL DSN=CL.REM.UMAC MACRO 00001000 &NAME PUTL &LINE 00002000 GBLB &IEUSL 00003000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00004000 BAL 14,IEUOL CHECK TO SEE IF OPEN 00005000 PUT IEULDCB,&LINE 00006000 LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00007000 &IEUSL SETB 1 00008000 MEND 00009000 ./ ADD NAME=PUTS DSN=CL.REM.UMAC MACRO 00001000 &NAME PUTS &T,&LOC 00002000 &NAME STM 14,1,IEUSAVE+72 SAVE 4 REGISTERS 00003000 TM IEUIO&T+48,X'10' TEST DCB 00004000 BC 8,IEUDD DCB NOT OPEN - ERROR 00005000 PUT IEUIO&T,&LOC 00006000 LM 14,1,IEUSAVE+72 RESTORE 4 REGS 00007000 MEND 00008000 ./ ADD NAME=PUTSB DSN=CL.REM.UMAC MACRO 00010000 &NAME PUTSB &DCB,&AREA 00020000 &NAME IHBINNRA &DCB,&AREA 00030000 L 15,96(0,1) LOAD PUTSB ROUTINE ADDR. 00040000 BALR 14,15 LINK TO PUTSB ROUTINE 00050000 MEND 00060000 ./ ADD NAME=PUTV DSN=CL.REM.UMAC MACRO 00001000 &NAME PUTV &A,&B,&C 00002000 .*--------------------------------------------------------------------* 00003000 .* PUT VARIABLE LENGTH RECORD TO QSAM * 00004000 .* * 00005000 .* FOUR INVOKING SEQUENCES ARE HANDLED- * 00006000 .* PUTV DCB,RECADDR A-FORM * 00007000 .* PUTV DCB,(REG) R-FORM * 00008000 .* PUTV DCB,CC,'LITERAL' LITERAL, CARR CTRL SPECIFIED * 00009000 .* PUTV DCB,'LITERAL' LITERAL, BLANK CARR CTRL ASSUMED * 00010000 .* * 00011000 .* WHEN THE R- OR A-FORM OF THE MACRO IS ISSUED, THE USER MUST * 00012000 .* SUPPLY THE LOGICAL RECORD LENGTH IN THE FIRST AND SECOND * 00013000 .* BYTES OF THE RECORD. PUTV GENERATES LRECL'S FOR LITERAL * 00014000 .* RECORDS AND LOADS DCBLRECL FOR ALL FORMS. * 00015000 .*--------------------------------------------------------------------* 00016000 LCLA &LRECL LOGICAL RECORD LENGTH 00017000 LCLA &NEXT BYTES TO BRANCH FORWARD 00018000 LCLA &WHICH POS PARAM CONTAINING RECORD TO PUT 00019000 LCLA &TEMP CHARACTERS IN LITERAL OPERAND 00020000 LCLA &INDEX LITERAL SCANNER INDEX 00021000 LCLC &CTL CARRIAGE CONTROL CHARACTER 00022000 &CTL SETC ' ' ASSUME BLANK FOR CARRIAGE CONTROL 00023000 &WHICH SETA 2 ASSUME RECORD IS 2ND OPERAND 00024000 AIF ('&B'(1,1) EQ '''').BUILD BR IF R- OR A-FORM 00025000 AIF ('&C' EQ '').NORMAL BRANCH IF ONLY TWO OPERANDS 00026000 .*--------------------------------------------------------------------* 00027000 .* PROCESS LITERAL INVOCATION WITH CARRIAGE CONTROL SPECIFIED * 00028000 .*--------------------------------------------------------------------* 00029000 &WHICH SETA 3 RECORD IS THIRD OPERAND 00030000 AIF ('&B' EQ '' OR '&B' EQ 'S' OR '&B' EQ 'SPACE').BUILD 00031000 &CTL SETC '1' 00032000 AIF ('&B' EQ 'P' OR '&B' EQ 'PAGE').BUILD 00033000 &CTL SETC '0' 00034000 AIF ('&B' EQ 'D' OR '&B' EQ 'DOUBLE').BUILD 00035000 &CTL SETC '+' 00036000 AIF ('&B' EQ 'N' OR '&B' EQ 'NOSPACE').BUILD 00037000 &CTL SETC '-' 00038000 AIF ('&B' EQ 'T' OR '&B' EQ 'TRIPLE').BUILD 00039000 &CTL SETC ' ' 00040000 MNOTE 4,'INVALID CONTROL REQUEST, SINGLE SUBSTITUTED' 00041000 .*--------------------------------------------------------------------* 00042000 .* PROCESS TEXT OF LITERAL RECORD - * 00043000 .* CALCULATE LRECL BY APPROXIMATING TO NUMBER OF CHARACTERS IN * 00044000 .* LITERAL OPERAND, THEN SCANNING THE TEXT FOR DOUBLE QUOTES AND * 00045000 .* AMPERSANDS WHICH SHRINK AFTER BEING ASSEMBLED. * 00046000 .*--------------------------------------------------------------------* 00047000 .BUILD ANOP 00048000 &TEMP SETA K'&SYSLIST(&WHICH) 00049000 &LRECL SETA &TEMP+3 1ST APROX OF LOGICAL RECORD LENGTH 00050000 &INDEX SETA 1 00051000 .SCAN1 ANOP 00052000 &INDEX SETA &INDEX+1 00053000 AIF ('&SYSLIST(&WHICH)'(&INDEX,1) NE '''').SCAN3 00054000 AIF (&INDEX EQ &TEMP).ENDLIT 00055000 .SCAN2 ANOP 00056000 &INDEX SETA &INDEX+1 00057000 &LRECL SETA &LRECL-1 00058000 AGO .SCAN1 00059000 .SCAN3 AIF ('&SYSLIST(&WHICH)'(&INDEX,2) NE '&&').SCAN1 00060000 AGO .SCAN2 00061000 .ENDLIT ANOP 00062000 &NEXT SETA (&LRECL+1)/2*2+4 00063000 &NAME BAL 0,*+&NEXT 00064000 PUTV&SYSNDX DC AL2(&LRECL),AL2(0),C'&CTL',C&SYSLIST(&WHICH) 00065000 IHBINNRA &A 00066000 MVC 82(2,1),PUTV&SYSNDX 00067000 PUT (1),(0) 00068000 MEXIT 00069000 .*--------------------------------------------------------------------* 00070000 .* PROCESS R- AND A-FORM INVOCATIONS * 00071000 .*--------------------------------------------------------------------* 00072000 .NORMAL ANOP 00073000 &NAME IHBINNRA &A 00074000 AIF ('&B'(1,1) EQ '(').REG 00075000 MVC 82(2,1),&B 00076000 AGO .COM 00077000 .REG MVC 82(2,1),0&B 00078000 .COM PUT (1),&B 00079000 MEND 00080000 ./ ADD NAME=PUTVT DSN=CL.REM.UMAC MACRO 00020000 &NAME PUTVT &DCB,&AREA,&MF=I,&L= 00040000 GBLB &PUTVFRS 00060000 LCLA &LM1,&LM2P4,&MLM256,&LM1P4,&M 00080000 LCLC &N 00100000 AIF ('&MF(1)' EQ 'I').IROUT 00120000 AIF ('&MF(1)' EQ 'L').LROUT 00140000 AIF ('&DCB' NE '' OR '&AREA' NE '' OR '&MF(1)' NE 'E').E1 00160000 AIF (N'&MF NE 2).E1 00180000 AIF ('&MF(2)'(1,1) EQ '(').EREG 00200000 &NAME BAL 14,&MF(2) 00220000 MEXIT 00240000 .EREG ANOP 00260000 &M SETA K'&MF(2)-2 00280000 &NAME BALR 14,&MF(2)(2,&M) 00300000 MEXIT 00320000 .IROUT ANOP 00340000 .LROUT ANOP 00360000 AIF ('&L' EQ '').IMPLI 00380000 &M SETA &L 00400000 AGO .COMP 00420000 .IMPLI AIF ('&AREA'(1,1) EQ '(').E2 00440000 &M SETA L'&AREA 00460000 .COMP ANOP 00480000 &LM1 SETA &M-1 00500000 &LM2P4 SETA &M-2+4 00520000 &MLM256 SETA 256-&M 00540000 &LM1P4 SETA &M-1+4 00560000 &NAME MVC PUTVBUF+4(&LM1),PUTVINVT 00580000 AIF ('&AREA'(1,1) NE '(').ADR1 00600000 LA 15,0&AREA 00620000 SH 15,PUTVBLKT+63 00640000 TR PUTVBUF+4(&LM1),&M.(15) 00660000 AGO .A 00680000 .ADR1 TR PUTVBUF+4(&LM1),&AREA-&MLM256 00700000 .A ANOP 00720000 LA 1,PUTVBUF+&LM2P4 00740000 TRT PUTVBUF+4(&LM1),PUTVBLKT 00760000 LA 15,PUTVBUF+&LM1P4 00780000 SR 15,1 00800000 STC 15,*+5 00820000 AIF ('&AREA'(1,1) NE '(').ADR2 00840000 MVC PUTVBUF+4(0),0&AREA 00860000 AGO .B 00880000 .ADR2 MVC PUTVBUF+4(0),&AREA 00900000 .B LA 15,5(,15) 00920000 IHBINNRA &DCB 00940000 STH 15,82(,1) 00960000 STH 15,PUTVBUF 00980000 LA 0,PUTVBUF 01000000 L 15,48(,1) 01020000 AIF ('&MF(1)' NE 'L').C 01040000 BR 15 01060000 AIF (&PUTVFRS).END 01080000 AGO .TABLES 01100000 .C AIF (NOT &PUTVFRS).FIRST 01120000 BALR 14,15 01140000 MEXIT 01160000 .FIRST LA 14,PUTVEND 01180000 BR 15 01200000 .TABLES ANOP 01220000 &PUTVFRS SETB 1 01240000 PUTVBUF DC 2H'0',CL133' ' 01260000 PUTVBLKT DC 64X'01',X'00' 01280000 PUTVINVT DC 191AL1(PUTVINVT+255-*) 01300000 AIF ('&MF(1)' EQ 'L').END 01320000 PUTVEND DS 0H 01340000 MEXIT 01360000 .E1 MNOTE 12,'INVALID MF SPECIFICATION' 01380000 MEXIT 01400000 .E2 MNOTE 12,'LENGTH MUST BE SPEC''D WHEN REGISTER FORM IS USED' 01420000 .END MEND 01440000 ./ ADD NAME=RDEF DSN=CL.REM.UMAC MACRO 00001000 RDEF 00002000 LCLA &R 00003000 .LOOP ANOP 00004000 R&R EQU &R 00005000 &R SETA &R+1 00006000 AIF (&R LE 15).LOOP 00007000 MEND 00008000 ./ ADD NAME=REGISTER DSN=CL.REM.UMAC MACRO 00001000 REGISTER 00002000 R0 EQU 0 00003000 R1 EQU 1 00004000 R2 EQU 2 00005000 R3 EQU 3 00006000 R4 EQU 4 00007000 R5 EQU 5 00008000 R6 EQU 6 00009000 R7 EQU 7 00010000 R8 EQU 8 00011000 R9 EQU 9 00012000 R10 EQU 10 00013000 R11 EQU 11 00014000 R12 EQU 12 00015000 R13 EQU 13 00016000 R14 EQU 14 00017000 R15 EQU 15 00018000 MEND 00019000 ./ ADD NAME=RESET DSN=CL.REM.UMAC MACRO 00010000 &LABEL RESET &FLAG,&R= 00020000 LCLA &N 00030000 LCLC &LA 00040000 &LA SETC 'L''' 00050000 AIF ('&R(1)' NE '').SPECIAL 00060000 &LABEL NI &FLAG(1),X'FF'-&LA&FLAG(1) 00070000 AGO .LOOP 00080000 .SPECIAL ANOP 00090000 &LABEL NI &FLAG(1).(&R(1)),X'FF'-&LA&FLAG(1) 00100000 .LOOP AIF (&N+1 GE N'&FLAG).MEND 00110000 RESET &FLAG(&N+2),R=&R(&N+2) 00120000 &N SETA &N+1 00130000 AGO .LOOP 00140000 .MEND MEND 00150000 ./ ADD NAME=SEGM DSN=CL.REM.UMAC MACRO 00000010 SEGM &NAME=,&PARENT=0,&BYTES=,&FREQ= 00000020 COPY GLOBALS 00000030 LCLA &WS 00000040 &K SETB 0 00000050 AIF (&S GE 256).SEG1 00000060 &S SETA &S+1 00000070 AIF ('&BYTES' EQ '').EB 00000080 AIF (&BYTES EQ 0).E00 00000090 &SB(&S) SETA &BYTES+2 00000100 AIF (&S GT 1).SA 00000110 AIF ('&PARENT' NE '0').EP 00000120 AGO .SBA 00000130 .SA AIF ('&PARENT' EQ '0').ENP 00000140 .SBA AIF ('&NAME' EQ '').EN 00000150 &SN(&S) SETC '&NAME' 00000160 AIF (&SB(&S) GT &WA(&D)).ES 00000170 AIF ('&FREQ' EQ '').EF 00000180 AIF (&S NE 1).S1 00000190 AIF (&FREQ EQ 0).EF0 00000200 .S1 ANOP 00000210 &SF(&S) SETA &FREQ 00000220 &SPN(&S) SETC '&PARENT' 00000230 AIF (&S EQ 1).FRSTSEG 00000240 &WS SETA 1 00000250 .NXTSEG ANOP 00000260 AIF ('&SN(&WS)' EQ '&SN(&S)').EFX 00000270 &WS SETA &WS+1 00000280 AIF ('&WS' LT '&S').NXTSEG 00000290 .FRSTSEG ANOP 00000300 AGO .S 00000310 .EN MNOTE 8,'---SEGM10--- SEGMENT NAME NOT SPECIFIED' 00000320 &CSECT(&DB) SETB 1 00000330 MEXIT 00000340 .EB MNOTE 8,'---SEGM20--- BYTES PARAMETER NOT SPECIFIED' 00000350 &CSECT(&DB) SETB 1 00000360 MEXIT 00000370 .EF MNOTE 8,'---SEGM30--- FREQUENCY PARAMETER NOT SPECIFIED' 00000380 &CSECT(&DB) SETB 1 00000390 MEXIT 00000400 .EP MNOTE 8,'---SEGM40---ROOT SEGMENT PARENT MUST EQ ZERO' 00000410 &CSECT(&DB) SETB 1 00000420 MEXIT 00000430 .ENP MNOTE 8,'---SEGM50---PARENT OPERAND NOT SPECIFIED FOR DEP SEG' 00000440 &CSECT(&DB) SETB 1 00000450 MEXIT 00000460 .SEG1 MNOTE 8,'---SEGM60--- TO MANY SEGM CARDS' 00000470 &CSECT(&DB) SETB 1 00000480 MEXIT 00000490 .ES MNOTE 8,'---SEGM70---SEGMENT LENGTH GREATER THAN DASD TRACK ' 00000500 &CSECT(&DB) SETB 1 00000510 MEXIT 00000520 .E00 MNOTE 8,'---SEGM80---SEGMENT LENGTH SPECIFIED AS ZERO ' 00000530 &CSECT(&DB) SETB 1 00000540 MEXIT 00000550 .EF0 MNOTE 8,'---SEGM90---ROOT SEGMENT FREQUENCY OF ZERO INVALID' 00000560 &CSECT(&DB) SETB 1 00000570 MEXIT 00000580 .EFX MNOTE 8,'---SEGM100---DUPLICATE SEGMENT NAMES IN DATA BASE' 00000590 &CSECT(&DB) SETB 1 00000600 MEXIT 00000610 .S ANOP 00000620 &SD(&S) SETA &D 00000630 MEND 00000640 ./ ADD NAME=SENSEG DSN=CL.REM.UMAC MACRO 00000010 SENSEG &SEG 00000020 GBLC &P(255),&S(255),&T(255),&G(50) 00000030 GBLA &Y,&I,&J,&K,&L,&M,&N,&U 00000040 GBLA &W,&W1,&W2,&W3,&W4,&TP,&DB,&CTR 00000050 GBLB &E,&CO,&PL,&REUS 00000060 AIF ('&SEG' EQ '').SEGERR SEG PARAMETER MISSING 00000070 AIF (&N GE 256).SEGNO 00000080 &N SETA &N+1 INCREMENT SENSEG COUNT 00000090 &J SETA &J+1 00000100 AIF ('&SEG'(1,1) EQ '(').PAREN 00000110 &S(&J) SETC '&SEG(1)' 00000120 &T(&J) SETC '0' 00000130 AGO .N 00000140 .PAREN ANOP 00000150 &S(&J) SETC '&SEG(1)' 00000160 AIF ('&SEG(2)' EQ '').ZERO 00000170 &T(&J) SETC '&SEG(2)' 00000180 AGO .N 00000190 .ZERO ANOP 00000200 &T(&J) SETC '0' 00000210 AGO .N 00000220 .N ANOP 00000230 &P(&Y) SETC '&N' 00000240 MEXIT 00000250 .SEGERR MNOTE 8,'---SEG010--- PARAMETER NOT SPECIFIED' 00000260 &E SETB 1 00000270 MEXIT 00000280 .SEGNO MNOTE 8,'---SEG020---TOO MANY SENSITIVE SEGMENTS 255 MAXIMUM' 00000290 &E SETB 1 00000300 MEXIT 00000310 MEND 00000320 ./ ADD NAME=SET DSN=CL.REM.UMAC MACRO 00010000 &LABEL SET &FLAG,&R= 00020000 LCLA &N 00030000 LCLC &LA 00040000 &LA SETC 'L''' 00050000 AIF ('&R(1)' NE '').SPECIAL 00060000 &LABEL OI &FLAG(1),&LA&FLAG(1) 00070000 AGO .LOOP 00080000 .SPECIAL ANOP 00090000 &LABEL OI &FLAG(1).(&R(1)),&LA&FLAG(1) 00100000 .LOOP AIF (&N+1 GE N'&FLAG).MEND 00110000 SET &FLAG(&N+2),R=&R(&N+2) 00120000 &N SETA &N+1 00130000 AGO .LOOP 00140000 .MEND MEND 00150000 ./ ADD NAME=SETJFCB DSN=CL.REM.UMAC /*********************************************************************/00001000 /* SETJFCB - WRITE (TO THE JOB QUEUE) A JOB FILE CONTROL BLOCK */00002000 /*********************************************************************/00003000 0DCL SETJFCB ENTRY( CHAR(*) , ); 00004000 0 /* ARG NAME DESCRIPTION */00005000 /* 1 DDNAME NAME OF ASSOCIATED DD CARD */00006000 /* 2 JFCBAREA JFCB TO WRITE OUT. */00007000 /* CAUTION: AN EXCP LEVEL OPEN AND A */00008000 /* CLOSE WITH REREAD ARE USED TO */00009000 /* PERFORM THE REWRITE (BY OS). */00010000 /* UNDEFINEDFILE IS NOT RAISED FOR */00011000 /* A MISSING DD CARD (YET). */00012000 ./ ADD NAME=STMTNO DSN=CL.REM.UMAC /*********************************************************************/00001000 /* STMTNO - RETURN NUMBER OF STATEMENT FROM FROM CALLER WAS CALLED */00002000 /*********************************************************************/00003000 0DCL STMTNO RETURNS (FIXED BIN(31)); 00004000 ./ ADD NAME=TABLE DSN=CL.REM.UMAC MACRO 00001000 &LAB TABLE &LIST,&ALL=,&START=0,&END=255,&ORG=NO, X00002000 &HEX=NO,&UC=UC,&LC=LC 00003000 LCLA &N,&I,&J,&K,&C,&COUNT 00004000 LCLB &F1,&F2,&QF,&F3,&F4,&F5 00005000 LCLC &LABEL,&NUM,&DUP,&Q,&R,&S,&T,&U,&V,&W,&X,&Y,&Z 00006000 LCLC &D,&E,&F,&G 00007000 &F1 SETB ('&ALL' EQ '') 00008000 &F2 SETB ('&ORG' EQ 'YES') 00009000 &F3 SETB ('&UC' EQ 'UC') 00010000 &F4 SETB ('&LC' EQ 'LC') 00011000 &F5 SETB ('&HEX' NE 'YES') 00012000 &C SETA N'&LIST 00013000 &LABEL SETC '&LAB' 00014000 AIF (&START LE &END AND &END LE 255).L15 00015000 .L26 MNOTE 4,'ERROR -- INCORRECT SPECIFICATION OF START AND/OR END' 00016000 MEXIT 00017000 .L15 AIF ('&LABEL' NE '').L1 00018000 &LABEL SETC 'TABL&SYSNDX' 00019000 MNOTE 0,'WARNING -- LABEL MISSING, ''&LABEL'' USED.' 00020000 .L1 ANOP 00021000 AIF (&F3 AND &F4).L10 00022000 AIF (&F4).L24 00023000 .* LC=UC OR LC=NNN SPECIFIED 00024000 AIF (&START GT 129 OR &END LT 169).L26 00025000 &F SETC '&LC' 00026000 AIF ('&LC' NE 'UC').L24 00027000 &F SETC '*+X''40''-' 00028000 &G SETC '&LABEL' 00029000 .L24 AIF (&F3).L25 00030000 .* UC=LC OR UC=NNN SPECIFIED 00031000 AIF (&START GT 193 OR &END LT 233).L26 00032000 &D SETC '&UC' 00033000 AIF ('&UC' NE 'LC').L25 00034000 &D SETC '*-X''40''-' 00035000 &E SETC '&LABEL' 00036000 .L25 AIF (&F4 AND NOT &F3).L23 00037000 AIF (&F3 AND NOT &F4).L22 00038000 &LABEL TABLE ('a'=9AL1(&F&G),'j'=9AL1(&F&G),'s'=8AL1(&F&G), X00039000 'A'=9AL1(&D&E),'J'=9AL1(&D&E),'S'=8AL1(&D&E)),ALL=&ALL, X00040000 START=&START,END=&END 00041000 AGO .L21 00042000 .L22 ANOP 00043000 &LABEL TABLE ('a'=9AL1(&F&G),'j'=9AL1(&F&G),'s'=8AL1(&F&G)),ALL=&ALL,X00044000 START=&START,END=&END 00045000 AGO .L21 00046000 .L23 ANOP 00047000 &LABEL TABLE ('A'=9AL1(&D&E),'J'=9AL1(&D&E),'S'=8AL1(&D&E)),ALL=&ALL,X00048000 START=&START,END=&END 00049000 .L21 AIF (&C EQ 0).L20 00050000 &F2 SETB 1 00051000 AGO .L9 00052000 .L10 ANOP 00053000 &LABEL EQU *-&START 00054000 AIF (NOT &F2).L9 00055000 AIF (&F1).L16 00056000 DC (&END+1-&START)AL1(&ALL) 00057000 AGO .L9 00058000 .L16 DC (&END+1-&START)AL1(*-&LABEL) 00059000 .L9 ANOP 00060000 &I SETA &I+1 00061000 &J SETA 1 00062000 AIF (&I GT &C).L6 00063000 &K SETA K'&LIST(&I) 00064000 .L3 AIF ('&LIST(&I)'(&J,1) EQ '=' AND NOT &QF).L4 00065000 AIF ('&LIST(&I)'(&J,1) NE '''').L13 00066000 &QF SETB (NOT &QF) 00067000 .L13 ANOP 00068000 &J SETA &J+1 00069000 AIF (&J LT &K).L3 00070000 .L2 MNOTE 4,'ERROR -- OPERAND &I IS INVALID.' 00071000 MEXIT 00072000 .L4 AIF (&J EQ 1).L2 00073000 &NUM SETC '&LIST(&I)'(1,&J-1) 00074000 AIF (&F5).L18 00075000 &NUM SETC 'X''&NUM''' 00076000 .L18 AIF ('&NUM'(1,1) NE '''').L19 00077000 &NUM SETC 'C&NUM' 00078000 .L19 ANOP 00079000 &Q SETC '&LIST(&I)'(&J+1,8) 00080000 &R SETC '' 00081000 &S SETC '' 00082000 &T SETC '' 00083000 &U SETC '' 00084000 &V SETC '' 00085000 &W SETC '' 00086000 &X SETC '' 00087000 &Y SETC '' 00088000 &Z SETC '' 00089000 AIF (&J+9 GT &K).L5 00090000 &R SETC '&LIST(&I)'(&J+9,8) 00091000 AIF (&J+17 GT &K).L5 00092000 &S SETC '&LIST(&I)'(&J+17,8) 00093000 AIF (&J+25 GT &K).L5 00094000 &T SETC '&LIST(&I)'(&J+25,8) 00095000 AIF (&J+33 GT &K).L5 00096000 &U SETC '&LIST(&I)'(&J+33,8) 00097000 AIF (&J+41 GT &K).L5 00098000 &V SETC '&LIST(&I)'(&J+41,8) 00099000 AIF (&J+49 GT &K).L5 00100000 &W SETC '&LIST(&I)'(&J+49,8) 00101000 AIF (&J+57 GT &K).L5 00102000 &X SETC '&LIST(&I)'(&J+57,8) 00103000 AIF (&J+65 GT &K).L5 00104000 &Y SETC '&LIST(&I)'(&J+65,8) 00105000 AIF (&J+73 GT &K).L5 00106000 &Z SETC '&LIST(&I)'(&J+73,8) 00107000 AIF (&J+81 LT &K).L5 00108000 MNOTE 0,WARNING -- OPERAND &I TOO LONG -- FIRST 80 BYTES USED' 00109000 .L5 AIF (&F2).L14 00110000 AIF (&F1).L7 00111000 &DUP SETC '#&SYSNDX&COUNT' 00112000 &COUNT SETA &COUNT+1 00113000 &DUP EQU &LABEL+&NUM-* 00114000 DC (&DUP)AL1(&ALL) 00115000 AGO .L8 00116000 .L7 ANOP 00117000 &DUP SETC '#&SYSNDX&COUNT' 00118000 &COUNT SETA &COUNT+1 00119000 &DUP EQU &LABEL+&NUM-* 00120000 DC (&DUP)AL1(*-&LABEL) 00121000 .L8 DC &Q&R&S&T&U&V&W&X&Y&Z 00122000 AGO .L9 00123000 .L14 ORG &LABEL+&NUM 00124000 AGO .L8 00125000 .L6 AIF (&F2).L12 00126000 AIF (&F1).L11 00127000 &DUP SETC '#&SYSNDX&COUNT' 00128000 &COUNT SETA &COUNT+1 00129000 &DUP EQU &LABEL+&END+1-* 00130000 DC (&DUP)AL1(&ALL) 00131000 MEXIT 00132000 .L11 ANOP 00133000 &DUP SETC '#&SYSNDX&COUNT' 00134000 &COUNT SETA &COUNT+1 00135000 &DUP EQU &LABEL+&END+1-* 00136000 DC (&DUP)AL1(*-&LABEL) 00137000 MEXIT 00138000 .L12 ORG &LABEL+&END+1 00139000 .L20 MEND 00140000 ./ ADD NAME=TERM DSN=CL.REM.UMAC MACRO 00010000 &LABEL TERM &TRUE,&FALSE 00020000 GBLA &I,&IMAX,&L 00030000 GBLB &NOTFLG 00040000 GBLC &LAB(255),&LIST(255),®(255) 00050000 LCLC &LA 00060000 &LA SETC 'L''' 00070000 AIF ('&LIST(&I)' EQ '_').LNOT 00080000 AIF ('&LIST(&I)' EQ '(').LPAR 00090000 AIF ('®(&I)' NE '').LREG 00100000 &LABEL TM &LIST(&I),&LA&LIST(&I) 00110000 &I SETA &I+1 00120000 MEXIT 00130000 .LREG ANOP 00140000 &LABEL TM &LIST(&I).(®(&I)),&LA&LIST(&I) 00150000 &I SETA &I+1 00160000 MEXIT 00170000 .LPAR ANOP 00180000 &I SETA &I+1 00190000 &LABEL ORR &TRUE,&FALSE 00200000 &I SETA &I+1 00210000 MEXIT 00220000 .LNOT ANOP 00230000 &I SETA &I+1 00240000 &LABEL TERM &FALSE,&TRUE 00250000 &NOTFLG SETB (NOT &NOTFLG) 00260000 MEND 00270000 ./ ADD NAME=TTIMER DSN=CL.REM.UMAC MACRO 00020000 &LABEL TTIMER &CANCEL 00040000 AIF ('&CANCEL' EQ '').B 00060000 AIF ('&CANCEL' EQ 'CANCEL').C 00080000 AIF ('&CANCEL' NE 'STEP').A 00080001 &LABEL L 1,=C'STEP' INDICATE REQUEST FOR TIME REMAINING IN STEP 00080002 AGO .ISVC 00080003 .A ANOP 00080004 IHBERMAC 36,,&CANCEL 00100000 MEXIT 00120000 .B ANOP 00140000 &LABEL SR 1,1 NO CANCELLATION 00160000 AGO .ISVC 00180000 .C ANOP 00200000 &LABEL LA 1,1(0,0) INDICATE CANCEL 00220000 .ISVC SVC 46 ISSUE TTIMER SVC 00240000 MEND 00260000 ./ ADD NAME=XPRCLOSE DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRCLOSE &WA 00002000 .* MACRO TO EXECUTE A CLOSE CALL TO 'XPRNTSUB'. 00003000 CNOP 0,4 00004000 &SYMBOL B *+8 BRANCH AROUND ADDRESS 00005000 XPRINNRA &WA,68 00006000 MEND 00007000 ./ ADD NAME=XPRDCB DSN=CL.REM.UMAC MACRO 00000010 &SYMBOL XPRDCB &DDNAME=SYSPRINT,&BLKSIZE=0 00000020 LCLC &TAG 00000030 .* MACRO TO GENERATE A WORK AREA FOR A PRINTER DATA SET, CONTAINING 00000040 .* A SAVE AREA, THE DCB, OPEN AND CLOSE PARAMETER LISTS, AND VARIOUS 00000050 .* CELLS AND SWITCHES. 00000060 &TAG SETC '&SYMBOL' 00000070 AIF (T'&SYMBOL NE 'O').TOK TEST IF NAME SUPPLIED 00000080 &TAG SETC 'XPRDCB01' SUPPLY STANDARD PRDCB NAME 00000090 .TOK ANOP 00000100 &TAG DS 0D ALIGN ON DOUBLE-WORD BOUNDARY 00000110 DS 18F STANDARD SAVE AREA 00000120 SPACE 00000130 * DCB DDNAME=&DDNAME,DSORG=PS,RECFM=VBM,LRECL=137, X 00000140 * BLKSIZE=&BLKSIZE,MACRF=PL UOR 00000150 IHB&SYSNDX DCB DDNAME=&DDNAME,DSORG=PS,RECFM=VBM,LRECL=137, X00000160 BLKSIZE=&BLKSIZE,MACRF=PL UOR 00000170 SPACE 00000180 * PARAMETER LISTS FOR OPEN AND CLOSE: 00000190 SPACE 00000200 OPEN (IHB&SYSNDX,(OUTPUT,LEAVE)),MF=L PARM LIST FOR OPEN 00000210 SPACE 00000220 CLOSE (IHB&SYSNDX,LEAVE),MF=L PARM LIST FOR CLOSE 00000230 SPACE 00000240 * WORK CELLS AND VARIABLE STORAGE: 00000250 SPACE 00000260 DS 1D WORK CELL 00000270 DS 3F WORK CELLS 00000280 DS 1A PAGE HEADING PARM LIST ADDRESS 00000290 DS 1F MAXIMUM NUMBER OF OUTPUT LINES 00000300 DS 1H PAGE WIDTH 00000310 DS 1H PAGE LENGTH 00000320 DS 1H PAGE NUMBER 00000330 DS 1H PAGE BALANCE 00000340 DS 1X SWITCHES 00000350 DS CL24 DATE & TIME FOR PAGE HEADING 00000360 SPACE 2 00000370 MEND 00000380 ./ ADD NAME=XPREJECT DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPREJECT &WA,&COND= 00002000 .* MACRO TO EXECUTE AN EJECT CALL TO 'XPRNTSUB'. 00003000 LCLC &TAG,&SYM,&OPT,&R 00004000 LCLA &K 00005000 &SYM SETC '&SYMBOL' 00006000 &TAG SETC 'IHB&SYSNDX' 00007000 CNOP 2,4 00008000 .TST1 AIF ('&COND' NE '').TST2 00009000 &OPT SETC 'F000' 00010000 AGO .SIMPLE 00011000 .TST2 AIF ('&COND' NE 'ATHOF').TSTC 00012000 &OPT SETC 'F100' 00013000 .SIMPLE ANOP 00014000 &SYM BAL 1,&TAG.L LOAD PARM ADDRESS 00015000 DC XL2'&OPT' OPTION BITS 00016000 AGO .VCON 00017000 .TSTC AIF ('&COND(1)' NE 'EQ').NE 00018000 &OPT SETC '80' 00019000 .NE AIF ('&COND(1)' NE 'NE').LT 00020000 &OPT SETC '70' 00021000 .LT AIF ('&COND(1)' NE 'LT').GT 00022000 &OPT SETC '40' 00023000 .GT AIF ('&COND(1)' NE 'GT').LE 00024000 &OPT SETC '20' 00025000 .LE AIF ('&COND(1)' NE 'LE').GE 00026000 &OPT SETC 'C0' 00027000 .GE AIF ('&COND(1)' NE 'GE').NOT 00028000 &OPT SETC 'A0' 00029000 .NOT AIF ('&OPT' NE '').COK 00030000 MNOTE 4,'COND OPERAND &COND(1) ILLEGAL' 00031000 .COK AIF ('&COND(2)' NE '').C2OK 00032000 MNOTE 4,'COND TEST QUANTITY MISSING' 00033000 AGO .NOTREG 00034000 .C2OK AIF ('&COND(2)'(1,1) NE '(').NOTREG 00035000 &K SETA K'&COND(2)-2 00036000 &R SETC '&COND(2)'(2,&K) 00037000 &SYM STC &R,&TAG.A STORE INTO PARM LIST 00038000 &SYM SETC '' 00039000 .NOTREG ANOP 00040000 &SYM BAL 1,&TAG.L LOAD PARM ADDRESS 00041000 DC XL1'&OPT' CONDITION MASK 00042000 AIF ('&COND(2)' EQ '').NOTREG2 00043000 AIF ('&COND(2)'(1,1) NE '(').NOTREG2 00044000 &TAG.A DC AL1(0) TEST QUANTITY 00045000 AGO .VCON 00046000 .NOTREG2 DC AL1(&COND(2)) TEST QUANTITY 00047000 .VCON ANOP 00048000 &TAG.L XPRINNRA &WA,92 00049000 MEND 00050000 ./ ADD NAME=XPRHEAD DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRHEAD &WA,&LIST= 00002000 .* MACRO TO PRESENT A LIST OF PRINT LINE DESCRIPTORS FOR PAGE HEADINGS 00003000 .* TO 'XPRNTSUB'. 00004000 &SYMBOL XPRLIST &WA,LIST=&LIST,IHBPARM=80 00005000 MEND 00006000 ./ ADD NAME=XPRINNRA DSN=CL.REM.UMAC MACRO 00000010 &TAG XPRINNRA &WA,&IHBPARM 00000020 .* INNER MACRO USED IN CALLS TO 'XPRNTSUB' 00000030 DC V(XPRNTSUB) PRINTING SUBROUTINE ADDRESS 00000040 &TAG L 15,*-4 LOAD ENTRY POINT 00000050 AIF ('&WA' NE '').WOK 00000060 LA 0,XPRDCB01 LOAD STANDARD WORK AREA ADDRESS 00000070 AGO .BAL 00000080 .WOK AIF ('&WA' EQ '(0)').BAL 00000090 AIF ('&WA'(1,1) EQ '(').REG 00000100 LA 0,&WA LOAD WORK AREA ADDRESS 00000110 AGO .BAL 00000120 .REG LR 0,&WA(1) LOAD WORK AREA ADDRESS 00000130 .BAL BAL 14,&IHBPARM.(15) CALL PRINT SUBROUTINE 00000140 MEND 00000150 ./ ADD NAME=XPRLDEF DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRLDEF &TEXT=,&LENGTH=132,&OFFSET=0,&SPA=1,&SPB=0 00002000 .* MACRO TO DEFINE PRINT LINE DESCRIPTOR BLOCKS ("PLD" BLOCKS) FOR 00003000 .* THE PRINTING SUBROUTINE "XPRNTSUB". 00004000 LCLA &N 00005000 LCLC &B3,&B6,&B7 00006000 ACTR 25 JUST IN CASE 00007000 &B3 SETC '0' 00008000 &B6 SETC '0' 00009000 &B7 SETC '0' 00010000 .* PROCESS OPTIONS IN SPA OPERAND: 00011000 .TSTA1 AIF ('&SPA(2)' EQ '').TSTB1 00012000 AIF ('&SPA(2)' NE 'NOEJ').TSTA2 00013000 &B3 SETC '1' 00014000 AGO .TSTB1 00015000 .TSTA2 MNOTE 4,'OPERAND &SPA(2) AFTER KEYWORD SPA IS ILLEGAL' 00016000 .* PROCESS OPTIONS IN SPB OPERAND: 00017000 .TSTB1 ANOP 00018000 &N SETA 2 00019000 .TSTB5 AIF ('&SPB(&N)' NE 'NOEJ').TSTB2 00020000 &B7 SETC '1' 00021000 AGO .TSTB4 00022000 .TSTB2 AIF ('&SPB(&N)' NE 'ATHOF').TSTB3 00023000 &B6 SETC '1' 00024000 AGO .TSTB4 00025000 .TSTB3 AIF ('&SPB(&N)' EQ '').TSTB4 00026000 MNOTE 4,'OPERAND &SPB(&N) AFTER KEYWORD SPB IS ILLEGAL' 00027000 .TSTB4 ANOP 00028000 &N SETA &N+1 00029000 AIF (&N LE 3).TSTB5 00030000 .IFTEXT AIF ('&TEXT' NE '').TOK 00031000 MNOTE 4,'TEXT ADDRESS MISSING' 00032000 .TOK ANOP 00033000 &SYMBOL DS 0F ALIGN ON FULL-WORD BOUNDARY 00034000 DC BL1'000&B3.00&B6&B7' OPTION BITS 00035000 DC AL3(&TEXT) TEXT ADDRESS 00036000 DC AL1(&LENGTH) TEXT LENGTH 00037000 DC AL1(&OFFSET) MARGIN OFFSET 00038000 .TESTB AIF ('&SPB(1)' EQ 'EJECT').BSKIP 00039000 AIF ('&SPB(1)' EQ 'SKIP').BSKIP 00040000 DC AL1(&SPB(1)) PRE-SPACING 00041000 AGO .TESTA 00042000 .BSKIP ANOP 00043000 DC AL1(255) EJECT BEFORE PRINTING 00044000 .TESTA AIF ('&SPA(1)' EQ 'EJECT').ASKIP 00045000 AIF ('&SPA(1)' EQ 'SKIP').ASKIP 00046000 DC AL1(&SPA(1)) POST-SPACING 00047000 MEXIT 00048000 .ASKIP ANOP 00049000 DC AL1(255) EJECT AFTER PRINTING 00050000 MEND 00051000 ./ ADD NAME=XPRLIST DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRLIST &WA,&LIST=,&IHBPARM=32 00002000 .* MACRO TO DELIVER A LIST OF PRINT LINE DESCRIPTORS TO 'XPRNTSUB'. 00003000 LCLA &N,&K,&D 00004000 LCLC &TAG,&SYM,&R 00005000 ACTR 100 00006000 &SYM SETC '&SYMBOL' 00007000 &TAG SETC 'IHB&SYSNDX' 00008000 AIF ('&LIST' NE '').LOK 00009000 MNOTE 8,'LIST OPERAND MUST BE SUPPLIED' 00010000 MEXIT 00011000 .LOK CNOP 0,4 00012000 AIF ('&LIST' NE '(1)').STLOOP 00013000 &SYMBOL B &TAG.L BRANCH AROUND ADDRESS 00014000 AGO .VCON 00015000 .STLOOP ANOP 00016000 &N SETA &N+1 00017000 AIF (&N GT N'&LIST).STDONE 00018000 AIF ('&LIST(&N)'(1,1) NE '(').STLOOP 00019000 &K SETA K'&LIST(&N)-2 00020000 &R SETC '&LIST(&N)'(2,&K) 00021000 &D SETA 4*(&N-1) 00022000 &SYM ST &R,&TAG.A+&D STORE INTO PARM LIST 00023000 &SYM SETC '' 00024000 AIF (&N NE N'&LIST).STLOOP 00025000 OI &TAG.A+&D,X'80' SET END-OF-LIST BIT 00026000 .STDONE ANOP 00027000 &SYM BAL 1,&TAG.L LOAD PARM LIST ADDRESS 00028000 &SYM SETC '&TAG.A' 00029000 &N SETA 0 00030000 .LOOP ANOP 00031000 &N SETA &N+1 00032000 AIF (&N GT N'&LIST).VCON 00033000 AIF ('&LIST(&N)'(1,1) NE '(').NOTREG 00034000 &SYM DC A(0) 00035000 &SYM SETC '' 00036000 AGO .LOOP 00037000 .NOTREG AIF (&N EQ N'&LIST).LAST 00038000 &SYM DC A(&LIST(&N)) 00039000 &SYM SETC '' 00040000 AGO .LOOP 00041000 .LAST ANOP 00042000 &SYM DC X'80' END-OF-LIST BIT 00043000 DC AL3(&LIST(&N)) 00044000 .VCON ANOP 00045000 &TAG.L XPRINNRA &WA,&IHBPARM 00046000 MEND 00047000 ./ ADD NAME=XPRMOD DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRMOD &WA,&MAXLINE=0,&PAGENO=0,&PAGEWID=0,&PAGELEN=0, X00002000 &TIME=0,&DATE=0 00003000 .* MACRO TO EXECUTE A MODIFY CALL TO 'XPRINTSUB'. 00004000 &SYMBOL XPROPEN &WA,MAXLINE=&MAXLINE,PAGENO=&PAGENO,PAGEWID=&PAGEWID,X00005000 PAGELEN=&PAGELEN,TIME=&TIME,DATE=&DATE,IHBPARM=104 00006000 MEND 00007000 ./ ADD NAME=XPRNTLIN DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRNTLIN &WA,&TEXT=00,&LENGTH=132,&OFFSET=0,&SPB=0,&SPA=1 00002000 LCLA &N 00003000 LCLC &B3,&B6,&B7,&T,&R 00004000 ACTR 25 00005000 &T SETC 'IHB&SYSNDX' 00006000 &B3 SETC '0' 00007000 &B6 SETC '0' 00008000 &B7 SETC '0' 00009000 .* PROCESS OPTIONS IN SPA OPERAND: 00010000 .TSTA1 AIF ('&SPA(2)' EQ '').TSTB1 00011000 AIF ('&SPA(2)' NE 'NOEJ').TSTA2 00012000 &B3 SETC '1' 00013000 AGO .TSTB1 00014000 .TSTA2 MNOTE 4,'OPERAND &SPA(2) AFTER KEYWORD SPA IS ILLEGAL' 00015000 .* PROCESS OPTIONS IN SPB OPERAND: 00016000 .TSTB1 ANOP 00017000 &N SETA 2 00018000 .TSTB5 AIF ('&SPB(&N)' NE 'NOEJ').TSTB2 00019000 &B7 SETC '1' 00020000 AGO .TSTB4 00021000 .TSTB2 AIF ('&SPB(&N)' NE 'ATHOF').TSTB3 00022000 &B6 SETC '1' 00023000 AGO .TSTB4 00024000 .TSTB3 AIF ('&SPB(&N)' EQ '').TSTB4 00025000 MNOTE 4,'OPERAND &SPB(&N) AFTER KEYWORD SPB IS ILLEGAL' 00026000 .TSTB4 ANOP 00027000 &N SETA &N+1 00028000 AIF (&N LE 3).TSTB5 00029000 .* GENERATE STORE INSTRUCTIONS IF REGISTER NOTATION IS USED: 00030000 CNOP 0,4 00031000 AIF ('&SYMBOL' EQ '').IFR1 00032000 &SYMBOL DS 0H 00033000 .IFR1 AIF ('&TEXT' NE '00').TXTOK 00034000 MNOTE 4,'TEXT ADDRESS MUST BE SUPPLIED' 00035000 .TXTOK AIF ('&TEXT'(1,1) NE '(').IFR2 00036000 ST &TEXT(1),&T.A STORE TEXT ADDRESS 00037000 MVI &T.A,B'000&B3.00&B6&B7' INSERT OPTION BITS 00038000 .IFR2 AIF ('&LENGTH'(1,1) NE '(').IFR3 00039000 STC &LENGTH(1),&T.A+4 STORE TEXT LENGTH 00040000 .IFR3 AIF ('&OFFSET'(1,1) NE '(').IFR4 00041000 STC &OFFSET(1),&T.A+5 STORE MARGIN OFFSET 00042000 .IFR4 AIF ('&SPB(1)'(1,1) NE '(').IFR5 00043000 &N SETA K'&SPB(1)-2 00044000 &R SETC '&SPB(1)'(2,&N) 00045000 STC &R,&T.A+6 STORE PRE-SPACING 00046000 .IFR5 AIF ('&SPA(1)'(1,1) NE '(').LOAD1 00047000 &N SETA K'&SPA(1)-2 00048000 &R SETC '&SPA(1)'(2,&N) 00049000 STC &R,&T.A+7 STORE POST-SPACING 00050000 .* LOAD REG 1 AND GENERATE PLD LIST ADDRESS: 00051000 .LOAD1 BAL 1,&T.L LOAD PARM ADDRESS 00052000 DC X'80' MARK END OF ADDRESS LIST 00053000 DC AL3(&T.A) ADDRESS OF PLD 00054000 .* GENREATE PLD PARAMETERS TO DESCRIBE THE PRINT LINE: 00055000 .IFR11 AIF ('&TEXT'(1,1) NE '(').NOTR11 00056000 &T.A DC A(0) TEXT ADDRESS & OPTION BITS 00057000 AGO .IFR12 00058000 .NOTR11 ANOP 00059000 &T.A DC B'000&B3.00&B6&B7' OPTION BITS 00060000 DC AL3(&TEXT) TEXT ADDRESS 00061000 .IFR12 AIF ('&LENGTH'(1,1) NE '(').NOTR12 00062000 DC AL1(0) TEXT LENGTH 00063000 AGO .IFR13 00064000 .NOTR12 DC AL1(&LENGTH) TEXT LENGTH 00065000 .IFR13 AIF ('&OFFSET'(1,1) NE '(').NOTR13 00066000 DC AL1(0) MARGIN OFFSET 00067000 AGO .IFR14 00068000 .NOTR13 DC AL1(&OFFSET) MARGIN OFFSET 00069000 .IFR14 AIF ('&SPB(1)'(1,1) NE '(').NOTR14 00070000 DC AL1(0) PRE-SPACING 00071000 AGO .IFR15 00072000 .NOTR14 AIF ('&SPB(1)' EQ 'EJECT').BSKIP 00073000 AIF ('&SPB(1)' EQ 'SKIP').BSKIP 00074000 DC AL1(&SPB(1)) PRE-SPACING 00075000 AGO .IFR15 00076000 .BSKIP DC AL1(255) SKIP BEFOR PRINTING 00077000 .IFR15 AIF ('&SPA(1)'(1,1) NE '(').NOTR15 00078000 DC AL1(0) POST-SPACING 00079000 AGO .VCON 00080000 .NOTR15 AIF ('&SPA(1)' EQ 'EJECT').ASKIP 00081000 AIF ('&SPA(1)' EQ 'SKIP').ASKIP 00082000 DC AL1(&SPA(1)) POST-SPACING 00083000 AGO .VCON 00084000 .ASKIP DC AL1(255) SKIP AFTER PRINTING 00085000 .VCON ANOP 00086000 &T.L XPRINNRA &WA,32 00087000 MEND 00088000 ./ ADD NAME=XPROPEN DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPROPEN &WA,&MAXLINE=0,&PAGENO=0,&PAGEWID=0,&PAGELEN=0, X00002000 &TIME=0,&DATE=0,&DDNAME=SYSPRINT,&IHBPARM=56 00003000 .* MACRO TO EXECUTE AN 'OPEN' OR 'MODIFY' CALL TO 'XPRNTSUB'. 00004000 LCLC &TAG 00005000 &TAG SETC 'IHB&SYSNDX' 00006000 AIF ('&SYMBOL' EQ '').T1 00007000 &SYMBOL DS 0H 00008000 .T1 AIF ('&MAXLINE'(1,1) NE '(').T2 00009000 ST &MAXLINE(1),&TAG.A STORE IN PARM LIST 00010000 .T2 AIF ('&PAGENO'(1,1) NE '(').T3 00011000 STH &PAGENO(1),&TAG.A+4 STORE IN PARM LIST 00012000 .T3 AIF ('&PAGEWID'(1,1) NE '(').T4 00013000 STC &PAGEWID(1),&TAG.A+6 STORE IN PARM LIST 00014000 .T4 AIF ('&PAGELEN'(1,1) NE '(').T5 00015000 STC &PAGELEN(1),&TAG.A+7 STORE IN PARM LIST 00016000 .T5 AIF ('&TIME'(1,1) NE '(').T6 00017000 ST &TIME(1),&TAG.A+8 STORE IN PARM LIST 00018000 .T6 AIF ('&DATE'(1,1) NE '(').T7 00019000 ST &DATE(1),&TAG.A+12 STORE IN PARM LIST 00020000 .T7 AIF ('&DDNAME'(1,1) NE '(').CNOP 00021000 MVC &TAG.A+16(8),0(&DDNAME(1)) STORE IN PARM LIST 00022000 .CNOP CNOP 0,4 00023000 BAL 1,&TAG.L LOAD PARM LIST ADDRESS 00024000 .P1 AIF ('&MAXLINE'(1,1) EQ '(').PR1 00025000 &TAG.A DC A(&MAXLINE) PRINT OUTPUT LIMIT 00026000 AGO .P2 00027000 .PR1 ANOP 00028000 &TAG.A DC A(0) PRINT OUTPUT LIMIT 00029000 .P2 AIF ('&PAGENO'(1,1) EQ '(').PR2 00030000 DC AL2(&PAGENO) PAGE NUMBER 00031000 AGO .P3 00032000 .PR2 DC AL2(0) PAGE NUMBER 00033000 .P3 AIF ('&PAGEWID'(1,1) EQ '(').PR3 00034000 DC AL1(&PAGEWID) PAGE WIDTH 00035000 AGO .P4 00036000 .PR3 DC AL1(0) PAGE WIDTH 00037000 .P4 AIF ('&PAGELEN'(1,1) EQ '(').PR4 00038000 DC AL1(&PAGELEN) PAGE LENGTH 00039000 AGO .P5 00040000 .PR4 DC AL1(0) PAGE LENGTH 00041000 .P5 AIF ('&TIME'(1,1) EQ '(').PR5 00042000 DC A(&TIME) ADDRESS OF TIME 00043000 AGO .P6 00044000 .PR5 DC A(0) ADDRESS OF TIME 00045000 .P6 AIF ('&DATE'(1,1) EQ '(').PR6 00046000 DC A(&DATE) ADDRESS OF DATE 00047000 AGO .P7 00048000 .PR6 DC A(0) ADDRESS OF DATE 00049000 .P7 AIF ('&IHBPARM' NE '56').VCON 00050000 AIF ('&DDNAME'(1,1) EQ '(').PR7 00051000 DC CL8'&DDNAME' DDNAME FOR DATA SET 00052000 AGO .VCON 00053000 .PR7 DC CL8' ' DDNAME FOR DATA SET 00054000 .VCON ANOP 00055000 &TAG.L XPRINNRA &WA,&IHBPARM 00056000 MEND 00057000 ./ ADD NAME=XPRSPACE DSN=CL.REM.UMAC MACRO 00001000 &SYMBOL XPRSPACE &WA,&LINES=1,&COND= 00002000 .* MACRO TO EXECUTE A SPACE CALL TO 'XPRNTSUB'. 00003000 LCLA &N,&B6,&B7 00004000 LCLC &TAG,&SYM 00005000 &SYM SETC '&SYMBOL' 00006000 &TAG SETC 'IHB&SYSNDX' 00007000 .LOOP ANOP 00008000 &N SETA &N+1 00009000 AIF (&N GT N'&COND).LDONE 00010000 .TST1 AIF ('&COND(&N)' NE 'NOEJ').TST2 00011000 &B6 SETA 1 00012000 AGO .LOOP 00013000 .TST2 AIF ('&COND(&N)' NE 'ATHOF').TST3 00014000 &B7 SETA 1 00015000 AGO .LOOP 00016000 .TST3 MNOTE 4,'OPERAND &COND(&N) AFTER KEYWORD COND IS ILLEGAL' 00017000 AGO .LOOP 00018000 .LDONE CNOP 2,4 00019000 AIF ('&LINES'(1,1) NE '(').NOTREG1 00020000 &SYM STC &LINES(1),&TAG.A+1 STORE INTO PARM LIST 00021000 &SYM SETC '' 00022000 .NOTREG1 ANOP 00023000 &SYM BAL 1,&TAG.L LOAD PARM LIST ADDRESS 00024000 &TAG.A DC B'000000&B6&B7' OPTION BITS 00025000 AIF ('&LINES'(1,1) NE '(').NOTREG2 00026000 DC X'00' SPACING AMOUNT 00027000 AGO .VCON 00028000 .NOTREG2 DC AL1(&LINES) SPACING AMOUNT 00029000 .VCON ANOP 00030000 &TAG.L XPRINNRA &WA,44 00031000 MEND 00032000 ./ ENDUP