*********************************************************************** 00010000 * * 00020000 * TITLE 'IEBDG'-DATA GENERATOR * 00030000 * * 00040000 * STATUS: CHANGE LEVEL 0 * 00050000 * * 00060000 * FUNCTION- TO GENERATE DATA USING THE PS AND PO ACCESS METHODS. * 00070000 * RECORDS(FIELDS) MAY BE DEFINED USING SEVEN CHARACTER FORMATS * 00080000 * UPON WHICH NINE ACTIONS MAY BE PERFORMED.A PICTURE CAN BE * 00090000 * SUPPLIED BY CONTROL CARD OR DYNAMICALLY FROM AN OLD DATA SET.* 00100000 * A USER EXIT IS SUPPLIED SO THAT A RECORD CAN BE INSPECTED * 00110000 * BEFORE IT IS OUTPUT. * 00120000 * * 00130000 * ENTRY POINT: IEBDG , THE CSECT NAME OF THIS MODULE * 00140000 * * 00150000 * INPUT: * 00160000 * BY INVOCATION * 00170000 * * 00180000 * REGISTER ONE(1) CONTAINS ADDRESS OF LIST * 00190000 * NO OPTIONS OR PAGANATION ARE PROVIDED,ONLY ACTIVE ENTRY * 00200000 * SHOULD BE THE DDPTR. * 00210000 * FORMAT OF LIST SHOULD BE AS FOLLOWS: * 00220000 * FIRST FOUR BYTES ZERO INDICATING NO OPTIONS * 00230000 * NEXT BYTE HEX 80 INDICATING LAST ENTRY * 00240000 * NEXT 3 BYTES CONTAIN ADDRESS OF LIST OF DDNAMES * 00250000 * * 00260000 * FORMAT OF DDNAME LIST AS FOLLOWS: * 00270000 * BYTE 0-1 CONTAIN LENGTH OF LIST * 00280000 * BYTE 2-9 DD CARD NAME DESCRIBING OLD DATA SET FOR INPUT * 00290000 * BYTE 10-17 ZEROES-NOT ACTIVE * 00300000 * BYTE 18-25 ZEROES-NOT ACTIVE * 00310000 * BYTE 26-33 ZEROES-NOT ACTIVE * 00320000 * BYTE 34-41 DD CARD NAME DESCRIBING DATA SET FOR SYSIN * 00330000 * BYTE 42-49 DD CARD NAME DESCRIBING DATA SET FOR SYSPRINT * 00340000 * BYTE 50-57 ZEROES-NOT ACTIVE * 00350000 * BYTE 58-65 DD CARD NAME DESCRIBING DATA SET FOR OUTPUT RCDS * 00360000 * BYTE XX-XX ADDITIONAL ENTRIES AS ABOVE FOR OUTPUT RECORDS * 00370000 * * 00380000 * * 00390000 * INPUT: * 00400000 * BY CONTROL CARDS * 00410000 * KEYWORDS ARE USED * 00420000 * THE NAME OF THE CONTROL CARD CANNOT START IN COL 1 WHICH IS * 00430000 * RESERVED FOR A NAME. * 00440000 * CONTROL CARDS ARE DSD DATA SET DEFINITION * 00450000 * FD FIELD DEFINITION * 00460000 * CREATE RECORD DEFINITION * 00470000 * REPEAT * 00480000 * END * 00490000 * DSD KEYWORDS ALLOWED ARE INPUT AND OUTPUT * 00500000 * FD KEYWORDS ALLOWED ARE:PICTURE=,FORMAT=,NAME=,LENGTH=, * 00510000 * ACTION=,CHARACTER=,SIGN=,CYCLE=, * 00520000 * INDEX=,REPLACE=,FILL=,RANGE=, * 00530000 * CREATE KEYWORDS ALLOWED ARE:QUANTITY=,NAME=,PICTURE=,FILL=, * 00540000 * LENGTH=,USER=,STARTLOC= * 00550000 * INPUT * 00560000 * * 00570000 * INPUT: * 00580000 * BY SYSTEM * 00590000 * THIS PROGRAM DEPENDS UPON THE SYSTEM FOR INPUT TO THE EXTENT * 00600000 * THAT THE CORRECT INFORMATION FROM LABELS AND DDCARDS MUST * 00610000 * BE CONVEYED TO THE DCBS.A DD CARD DESCRIBING EVERY DATA SET * 00620000 * MUST BE PRESENT.THIS PROGRAM WILL USE THE FOLLOWING NAMES * 00630000 * UNLESS REQUIRED TO CHANGE BY INVOCATION. * 00640000 * * 00650000 * SYSIN -DATA SET FOR INPUTTING CONTROL CARDS * 00660000 * CARDS MAY BE BLOCKED 80 CHAR FIXED FORMAT * 00670000 * SYSPRINT -DATA SET FOR OUTPUTTING MESSAGES * 00680000 * ANY DATA SET FOR OUTPUTING GENERATED RECORDS * 00690000 * ANY DATA SET FOR INPUTING OLD RECORDS * 00700000 * * 00710000 * OUTPUT: * 00720000 * REGISTER FIVE POINTING TO COMMON COMMUNICATION AREA * 00730000 * * 00740000 * TO MESSAGE MODULE - * 00750000 * MS --INDICATES MESSAGE NUMBER * 00760000 * FLAG SWITCH- INDICATES ERROR FLAG WANTED * 00770000 * TO FD ANALYSIS MODULE * 00780000 * REGISTER 9 POINTING AT OPERATION FIELD IN INBUF * 00790000 * TO CREATE ANALYSIS MODULE * 00800000 * REGISTER 9 POINTING AT OPERATION FIELD IN INBUF * 00810000 * * 00820000 * EXTERNAL ROUTINES: * 00830000 * * 00840000 * IEBDGMSG * 00850000 * IEBFDANL * 00860000 * IEBCRANL * 00870000 * IEBDGCUP * 00880000 * GET MACRO * 00890000 * GETMAIN MACRO * 00900000 * LINK MACRO * 00910000 * * 00920000 * EXITS--NORMAL * 00930000 * TO IEBDGMSG BY USE OF LINK MACRO FOR MESSAGES * 00940000 * TO IEBFDANL BY USE OF THE LINK MACRO FOR FD ANALYSIS * 00950000 * TO IEBCRANL BY USE OF THE LINK MACRO FOR CREATE ANALYSIS * 00960000 * TO IEBDGCUP BY USE OF THE LINK MACRO FOR CLEANUP * 00970000 * * 00980000 * EXITS-NORMAL: FROM THIS ROUTINE * 00990000 * CONDITION CODE 0 GIVEN FOR NORMAL CONCLUSION * 01000000 * * 01010000 * EXITS-ERROR * 01020000 * CONTROL IS RETURNED TO THE USER WITH ONE OF THE FOLLOWING * 01030000 * CONDITION CODES * 01040000 * CONDITION CODE 4 TERMINATION AT USERS REQUEST * 01050000 * CONDITION CODE 8 ERROR PROCESSING CONTROL CARD * 01060000 * CONDITION CODE 12 TERMINATION-UNRECOVERABLE ERROR * 01070000 * * 01080000 * TABLES/WORKAREAS:DCBS REFERENCED AT DCBOFLG * 01090000 * FIELD DEFINITION TABLES * 01100000 * * 01110000 * BYTE 0 BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 * 01120000 * ********************************************************* * 01130000 * * NAME * * 01140000 * ********************************************************* * 01150000 * * REPLACE NAME * * 01160000 * ********************************************************* * 01170000 * * INDEX NAME * * 01180000 * ********************************************************* * 01190000 * * LENGTH * CYCLE * ACTION * FORMAT * * 01200000 * ********************************************************* * 01210000 * *SWITCH* FILL * SIGN * CHAR * RANGE * * 01220000 * ********************************************************* * 01230000 * * STARTLOC IN WORKAREA * * * 01240000 * ********************************************************* * 01250000 * * 01260000 * ATTRIBUTES: REENTRANT,REUSEABLE * 01270000 * * 01280000 * * 01290000 *********************************************************************** 01300000 * NEW MODULE, RELEASE 17. DGOH 01310000 * A28655 01320000 *A197600-197984,609600-611869,990000-990200 A37883 01330000 *D567500-572500,873500-888700,891600-891700 A37883 01340000 *C540500,542500,777500 A38710 01350000 * A41807 01360000 *C544100,545500 A38766 01370000 *A545600-545900 A38766 01380000 *A463520-463960 A41807 01390000 *C153000,153100.A638800-639000 A45169 01400000 *C225600,225700 A45200 01410000 *A690800-691000 A48784 01420000 *C610296,611595.D610292,611454,611485,611528,611553.A611538 A50927 01430000 *C262000 YA01692 01440000 *C261500-262000,265500 @XA12917,@YA12894,(ORG)@ZA07373 01450000 *A994300-994700,996700-997100 @XA13603,(ORG)@YA12911,@ZA07394 01460000 *D994300,996700 @XA13603.(ORG)@YA12911,@ZA07394 01470000 *A339600,339700 (ORG)@XA16970,@YA18072,@ZA24201 01480000 *A940800-940900 @ZA24161 01490000 *A339550 @XA21352,@YA18072,(ORG)@ZA28703 01500000 *A1 (ORG)@XA20990,@ZA33694 01510000 *C1 @XA22239,(ORG)@YA19824,@ZA33693 01520000 *D171000 @XA22239,(ORG)@YA19824,@ZA33693 01530000 *A5/C2A1C3A6/C1A1/A3 @XA22239,(ORG)@YA19824,@ZA33693 01540000 LCLA &T,&SPN 0003 01550000 .@001 ANOP 0003 01560000 IEBDG CSECT , 0003 01570000 STM @E,@C,12(@D) 0003 01580000 BALR @B,0 0003 01590000 @PSTART DS 0H 0003 01600000 USING @PSTART+00000,@B 0003 01610000 LA @3,4095(0,@B) 0003 01620000 USING @PSTART+04095,@3 0003 01630000 L @0,@SIZ001 0003 01640000 GETMAIN R,LV=(0) 0003 01650000 LR @C,@1 0003 01660000 USING @DATD+00000,@C 0003 01670000 LM @0,@1,20(@D) 0003 01680000 XC @TEMPS(@L),@TEMPS 0003 01690000 ST @D,@SAV001+4 0003 01700000 LA @F,@SAV001 0003 01710000 ST @F,8(0,@D) 0003 01720000 LR @D,@F 0003 01730000 B MODULEVL /*@ZA33693*/ 01740000 DC C'IEBDG -OZ33693' /*@ZA33693*/ 01750000 MODULEVL DS 0H /*@ZA33693*/ 01760000 DS 0H 01770000 * Q(1) = '00'X; /*SET FIRST BYTE TO 0*/ 01780000 MVI COMMON+216,X'00' 0074 01790000 * R5 = ADDR(Q) /* SET UP FROM ADDR*/; 01800000 LA @5,COMMON+216 0075 01810000 * /* PICK UP CONSTANT LGTH*/ 01820000 * /* GET ADDRESS OF END OF COMMON */ 01830000 * GEN ( LA R7,@DATEND); 01840000 LA R7,@DATEND 01850000 DS 0H 01860000 * /* GET ADDRESS OF Q FOR CLEARING*/ 01870000 * R7 = R7 - ADDR(Q); 01880000 LR @F,@7 0077 01890000 LA @0,COMMON+216 0077 01900000 SR @F,@0 0077 01910000 LR @7,@F 0077 01920000 * R7 = R7 - 1; /** TO CORRECT THE AMOUNT**/ 01930000 BCTR @7,0 0078 01940000 * A000:; 01950000 * IF R7 < 256 THEN GO TO A002 /*BR IF LESS THAN 256*/; 01960000 A000 CH @7,@D1 0080 01970000 BC 04,A002 0081 01980000 * IF R7 = 0 THEN GO TO A003 /*BR IF NONE TO MOVE*/; 01990000 LTR @7,@7 0082 02000000 BC 08,A003 0083 02010000 * /* MOVES 256 BYTES */ 02020000 * GEN ( MVC 1(256,5),0(5)); 02030000 MVC 1(256,5),0(5) 02040000 DS 0H 02050000 * R5 = R5 + 256 /* ADD 256 TO POSITION ADDR*/; 02060000 AH @5,@D1 0085 02070000 * R7 = R7 - 256 /*SUBT 256 TO CORRECT LGTH*/; 02080000 SH @7,@D1 0086 02090000 * GO TO A000 /* BR TO REPEAT SEQUENCE */; 02100000 BC 15,A000 0087 02110000 * A001:; 02120000 * /* THIS INST MOVES LESS THAN 256*/ 02130000 * GEN ( MVC 1(1,5),0(5)); 02140000 A001 MVC 1(1,5),0(5) 02150000 DS 0H 02160000 * A002:; 02170000 * R7 = R7 - 1 /*TO CORRECT LENGTH.*/; 02180000 A002 BCTR @7,0 0091 02190000 * /* THIS INST CAUSES MOVE OF < 256*/ 02200000 * GEN ( EX R7,A001); 02210000 EX R7,A001 02220000 DS 0H 02230000 * /* END OF CLEAR CORE INSTRUCTIONS */ 02240000 * A003:; 02250000 * /******************************************************************* 02260000 * /** * 02270000 * /** THIS SECTION MOVES COPIES OF THE DATA GENERATOR INPUT AND * 02280000 * /** OUTPUT DCBS TO THE COMMON AREA FOR REENTRANTIBILITY. * 02290000 * /** * 02300000 * /******************************************************************* 02310000 * PARM = R1 /* SAVE PARAMETER POINTER */; 02320000 A003 ST @1,COMMON+12 0094 02330000 * /** MOVE DCBS TO COMMON AREA FOR REENTRANCY **/ 02340000 * SYSI = MYDCB1A; 02350000 MVC COMMON+116(96),MYDCB1A 0095 02360000 * SYSP=MYDCB2A; 02370000 MVC COMMON+20(96),MYDCB2A 0096 02380000 * /******************************************************************* 02390000 * /** * 02400000 * /** THIS SECTION ESTABLISHES THE COMMUNICATION REGISTER REG 5 * 02410000 * /** AND INITILIZES DEFAULTS FOR LINE COUNT,PAGE NUMBER AND THE * 02420000 * /** INITIAL VALUE FOR THE RANDOM NUMBER GENERATOR.THE DCB EXIT LIST* 02430000 * /** IS ALSO ESTABLISHED FOR DATA GENERATOR INPUT AND OUTPUT DCBS * 02440000 * /** * 02450000 * /******************************************************************* 02460000 * /* LOAD PARA REG FOR REENTRANT COMMUNICATION */ 02470000 * R5 = ADDR(COMMON); 02480000 LA @5,COMMON 0097 02490000 * LINECT = 58 /* DEFAULT LINECT = 58 */; 02500000 LA @F,58 0098 02510000 ST @F,COMMON+4 0098 02520000 * GENERATE ; 02530000 TIME BIN TAKE TIME VALUE FOR INIT A45200 02540000 ST R0,624(0,R5) RANDOM NUMBER A45200 02550000 DS 0H 02560000 * PAGENO = 'F0F0F0F1'X /*DEFAULT PAGENO = 0001*/; 02570000 MVC COMMON(4),@X2 0100 02580000 * DCBPTR = ADDR(SYSI) /* POINT AT SYSIDCB*/; 02590000 LA @F,COMMON+116 0101 02600000 ST @F,COMMON+300 0101 02610000 * INBUFA1 = '40'X /**BLANK TO FIRST BYTE OF INBUF **/; 02620000 MVI COMMON1+104,X'40' 0102 02630000 MVI COMMON1+105,C' ' 0102 02640000 MVC COMMON1+106(119),COMMON1+105 0102 02650000 * INBUFA1(2:121) = INBUFA1(1:120) /** BLANKS TO INBUFA1 **/; 02660000 MVC COMMON1+105(120),COMMON1+104 0103 02670000 * EXLIST = ADDR(EXLST1) /* EXIT LIST ADDR TO SYSI DCB */; 02680000 LA @F,COMMON+268 0104 02690000 L @2,COMMON+300 COMMON 0104 02700000 ST @F,@TEMP4 0104 02710000 MVC 37(3,@2),@TEMP4+1 0104 02720000 * EDCB1 = '85'X /* ACTIVATE DCB EXIT */; 02730000 MVI COMMON+268,X'85' 0105 02740000 * EDCB2 = ADDR(DCBROUT1) /* SYSI EXIT RT ADDR */; 02750000 LA @F,DCBROUT1 0106 02760000 ST @F,@TEMP4 0106 02770000 MVC COMMON+269(3),@TEMP4+1 0106 02780000 * DCBPTR = ADDR(SYSP) /* POINT AT SYSP DCB */; 02790000 LA @F,COMMON+20 0107 02800000 ST @F,COMMON+300 0107 02810000 * EXLIST = ADDR(EXLST2) /* EXIT LIST ADDR TO SYSP DCB */; 02820000 LA @F,COMMON+272 0108 02830000 L @2,COMMON+300 COMMON 0108 02840000 ST @F,@TEMP4 0108 02850000 MVC 37(3,@2),@TEMP4+1 0108 02860000 * EDCB3 = '85'X /* ACTIVATE DCB EXIT */; 02870000 MVI COMMON+272,X'85' 0109 02880000 * EDCB4 = ADDR(DCBROUT2) /* SYSP EXIT RT ADDR */; 02890000 LA @F,DCBROUT2 0110 02900000 ST @F,@TEMP4 0110 02910000 MVC COMMON+273(3),@TEMP4+1 0110 02920000 * GEN; 02930000 *********************************************************************** 02940000 * * 02950000 * --------- INVOCATION --------- * 02960000 * * 02970000 * INVOCATION MUST BE TESTED UPON ENTRY FOR OS/360.REMOVE CODE * 02980000 * FOR DOS SUPPORT. REG 1 POINTS TO PARAMETER LIST UPON ENTRY. * 02990000 * LIST IS CONSTRUCTED AS FOLLOWS: * 03000000 * FIRST WORD ADDRESS OF OPTIONS * 03010000 * 2ND WORD ADDRESS OF DDNAMES * 03020000 * 3RD WORD ADDRESS OF PAGE INFO * 03030000 * AN '80' X IN BYTE ZERO OF ANY WORD INDICATES END OF LIST. * 03040000 * THIS WORD WILL CONTAIN AN ADDRESS.ANY LIST POINTED AT STARTS * 03050000 * ON 1/2 WORD BOUNDRY.THAT 1/2 WORD CONTAINS LENGTH OF LIST * 03060000 * IF WE ARE INVOKED FOR DDNAMES THE ONLY ONES WE ACCEPT ARE * 03070000 * SYSIN AND SYSPRINT AT CHAR LOCATIONS 35 AND 43. IT IS THE * 03080000 * USERS RESPONSABILITY TO PLACE LENGTH IN EACH LIST.IF ZERO IS * 03090000 * FOUND THAT LIST IS INACTIVE.USER MAY PLACE UP TO A 4 DIGIT * 03100000 * DECIMAL NUMBER IN PARM FIELD OF EXEC CARD FOR CONTROL OF * 03110000 * SYSPRINT LINE COUNT. IF HE WANTS TO PLACE 52 LINES PER PAGE * 03120000 * HE WILL CODE PARM='LINECNT=0052' * 03130000 * AN INCORRECT KEYWORD IN THE PARM FIELD WILL CAUSE A MESSAGE * 03140000 * UPON SYSPRINT WHEN IT IS OPENED * 03150000 * * 03160000 *********************************************************************** 03170000 DS 0H 03180000 * OPTPTR = LIST(1:4) /*INIT OPTION PTR*/; 03190000 L @4,COMMON+12 COMMON 0112 03200000 MVC @TEMP4(4),0(@4) 0112 03210000 L @F,@TEMP4 0112 03220000 ST @F,OPTPTR 0112 03230000 * /*IF LENGTH IN OPTION FIELD BR TO PROCESS LINT COUNT*/ 03240000 * IF OPTIONS(1:2) ^= C00 THEN GO TO PLINECT; 03250000 LR @2,@F 0113 03260000 CLC 0(2,@2),C00 0113 03270000 BC 07,PLINECT 0114 03280000 * /*IF OPTIONS ONLY ARE PRESENT INVOCATION IS ENDED*/ 03290000 * PLINECTR:; 03300000 * IF LIST(1) = '80'X THEN GO TO AFTER; 03310000 PLINECTR L @2,COMMON+12 COMMON 0116 03320000 CLI 0(@2),X'80' 0116 03330000 BC 08,AFTER 0117 03340000 * /* DDNAMES AND PAGEING ARE STILL LEFT TO PROCESS*/ 03350000 * DDPTR = LIST(5:8) /*INIT PTR TO DDNAME LIST*/; 03360000 MVC @TEMP4(4),4(@2) 0118 03370000 L @F,@TEMP4 0118 03380000 ST @F,COMMON1+228 0118 03390000 * /*IF LENGTH IN DDNAMES BR TO PROCESS NAMES*/ 03400000 * IF DDLST(1:2) ^= C00 THEN GO TO PDDNAME; 03410000 LR @4,@F COMMON1 0119 03420000 CLC 0(2,@4),C00 0119 03430000 BC 07,PDDNAME 0120 03440000 * PDDNAMER:; 03450000 * /*IF BYTE 0 OF DDPTR IS '80'X NO MORE TO PROCESS*/ 03460000 * IF LIST(5) = '80'X THEN GO TO AFTER; 03470000 PDDNAMER L @2,COMMON+12 COMMON 0122 03480000 CLI 4(@2),X'80' 0122 03490000 BC 08,AFTER 0123 03500000 * /*IF WE GET HERE ONLY PAGEING IS LEFT TO PROCESS*/ 03510000 * PGPTR = LIST(9:12) /*INIT PTR TO PAGE LIST*/; 03520000 MVC @TEMP4(4),8(@2) 0124 03530000 L @F,@TEMP4 0124 03540000 ST @F,PGPTR 0124 03550000 * /*IF LGTH PRESENT WE HAVE SOMETHIMG TO PROCESS OTHERWISE WE DONE*/ 03560000 * IF PAGE(1:2) = C00 THEN GO TO AFTER /*BR IF NO LENGTH*/; 03570000 LR @4,@F 0125 03580000 CLC 0(2,@4),C00 0125 03590000 BC 08,AFTER 0126 03600000 * /* PROCESS PAGEING HERE*/ 03610000 * /* NUMBER WILL BE PRESENT IN BINARY .PLACE NUMBER IN COMMON AREA*/ 03620000 * /* FOR MSGMOD*/ 03630000 * PAGENO = PAGE(3:6) /*NUMBER TO COMMON AREA*/; 03640000 MVC COMMON(4),2(@4) 0127 03650000 * R6 = PAGENO /*BINARY NUMBER TO REGISTER*/; 03660000 L @6,COMMON 0128 03670000 * /* CONVERT TO PACKED DECIMAL*/ 03680000 * GEN ( CVD 6,Q); 03690000 CVD 6,Q 03700000 DS 0H 03710000 * PAGENO(1:4) = Q(5:8) /*PACKED NUMBER TO PAGENO*/; 03720000 MVC COMMON(4),COMMON+220 0130 03730000 * /* UNPACK PAGE NUMBER*/ 03740000 * GEN ( UNPK Q(8),PAGENO(4)); 03750000 UNPK Q(8),PAGENO(4) 03760000 DS 0H 03770000 * QSIGN = 'F0'X | QSIGN /* OR TO SIGN BIT */; 03780000 OI COMMON+223,X'F0' 0132 03790000 * PAGENO(1:4) = Q(5:8) /*MAKE NUMBER READY FOR MSG*/; 03800000 MVC COMMON(4),COMMON+220 0133 03810000 * GO TO AFTER /*BR INVOCATION DONE*/; 03820000 BC 15,AFTER 0134 03830000 * /* LINECT IS PROCESSED HERE.NUMBER IS CONVERTED TO DECIMAL AND*/ 03840000 * /*PLACED AT LOCATION LINECT.THIS IS USED FOR COMPARISON BY MSG*/ 03850000 * PLINECT:; 03860000 * /* IS LENGTH CORRECT IN OPTION FIELD*/ 03870000 * IF OPTIONS(1:2) ^= '000C'X THEN GO TO PLINECT2; /*@ZA07373* 03880000 PLINECT L @2,OPTPTR 0136 03890000 CLC 0(2,@2),@X6 0136 03900000 BC 07,PLINECT2 0137 03910000 * IF OPTIONS(3:10) ='LINECNT=' THEN GO TO PLINECT1; /*@ZA07373* 03920000 CLC 2(8,@2),@C7 0138 03930000 BC 08,PLINECT1 0139 03940000 * /* AT THIS POINT WILL INIT MESSAGE INDICATING INCORRECT KEYWORD AND* 03950000 * /*DEFAULT LINE COUNT.IT WILL BE PRINTED AFTER SYSPRINT IS OPENED*/ 03960000 * PLINECT2:; 03970000 * MS = 26 /* INDICATE MESSAGE*/; 03980000 PLINECT2 LA @F,26 0141 03990000 STH @F,COMMON1+102 0141 04000000 * GO TO PLINECTR /*BR TO CONTINUE PROCESSING*/; 04010000 BC 15,PLINECTR 0142 04020000 * PLINECT1:; 04030000 * COUNTER=OPTIONS(11:14); /* LINECNT TO COUNTER @ZA07373* 04040000 PLINECT1 L @2,OPTPTR 0144 04050000 MVC @TEMP4(4),10(@2) 0144 04060000 L @F,@TEMP4 0144 04070000 ST @F,COMMON+232 0144 04080000 * /* PACK NUMBER */ 04090000 * GEN ( PACK Q(8),COUNTER(4)); 04100000 PACK Q(8),COUNTER(4) 04110000 DS 0H 04120000 * /* CONVERT TO BINARY */ 04130000 * /*CONVERT TO BINARY LINECT*/ 04140000 * GEN ( CVB 6,Q); 04150000 CVB 6,Q 04160000 DS 0H 04170000 * /* DO NOT ALLOW LINECT OF 1 USE DEFAULT OF 58 */ 04180000 * IF R6 = 1 THEN GO TO PLINECTR ; 04190000 CH @6,@D2 0147 04200000 BC 08,PLINECTR 0148 04210000 * LINECT = R6 /*NUMBER TO COMMON AREA*/; 04220000 ST @6,COMMON+4 0149 04230000 * LINECTR = 0 /*CLEAR COUNTER FOR MSGMOD*/; 04240000 SR @F,@F 0150 04250000 ST @F,COMMON+8 0150 04260000 * GO TO PLINECTR /*BR TO CONTINUE INVOCATION*/; 04270000 BC 15,PLINECTR 0151 04280000 * /******************************************************************* 04290000 * /** * 04300000 * /** ENTRY HERE INDICATES THAT A REPLACEMENT FOR SYSPRINT OR * 04310000 * /** SYSIN MAY BE INDICATED.THE FIRST TWO BYTES OF DDLST WILL * 04320000 * /** CONTAIN THE LENGTH.A LENGTH GT OR EQUAL TO 42 INDICATES THAT * 04330000 * /** SYSIN AND SYSPRINT BOTH MAY BE PRESENT.A LENGTH GT OR EQUAL TO * 04340000 * /** 34 INDICATES THAT SYSIN ONLY MAY BE PRESENT.ZEROS AT SPECIFIC * 04350000 * /** LOCATION INDICATE PARAMETER NOT PRESENT. * 04360000 * /** * 04370000 * /******************************************************************* 04380000 * PDDNAME:; 04390000 * /*FIRST TWO BYTES OF DDLIST CONTAINS LENGTH.IF LGTH=> 42 INDICATES*/ 04400000 * /*SYSIN AND SYSPRINT BOTH MAY BE PRESENT.IF LGTH => 34 INDICATES*/ 04410000 * /*THAT SYSIN ONLY MAY BE PRESENT.ZEROES AT SPECIFIC LOCATION INDICA* 04420000 * /*TES PARAMETER NOT PRESENT*/ 04430000 * IF DDLST(1:2) => '0030'X THEN DO /*ARE BOTH DD FIELDS HERE*/; 04440000 PDDNAME L @2,COMMON1+228 COMMON1 0153 04450000 CLC 0(2,@2),@X8 0153 04460000 BC 04,@9FF 0153 04470000 * /* Q- NAME FOR SYSPRINT */ 04480000 * IF DDLST(43:50) ^= '0000000000000000'X THEN DO; 04490000 CLC 42(8,@2),@X9 0155 04500000 BC 08,@9FE 0155 04510000 * DCBPTR = ADDR(SYSP) /*PICK UP SYSP ADDR*/; 04520000 LA @F,COMMON+20 0157 04530000 ST @F,COMMON+300 0157 04540000 * DDNAME(1:8) = DDLST(43:50) /* NEW NAME TO SYSP DCB*/; 04550000 LR @4,@F COMMON 0158 04560000 MVC 40(8,@4),42(@2) 0158 04570000 * END; 04580000 * /* NO SYSPRINT DDNAME AS FIELD CONTAINED 0 */ 04590000 * END; 04600000 @9FE EQU * 0160 04610000 * IF DDLST(1:2) => '0028'X THEN DO /*COULD SYSIN BE PRESENT*/; 04620000 @9FF L @2,COMMON1+228 COMMON1 0161 04630000 CLC 0(2,@2),@X10 0161 04640000 BC 04,@9FD 0161 04650000 * IF DDLST(35:42) ^= '0000000000000000'X THEN DO; 04660000 CLC 34(8,@2),@X9 0163 04670000 BC 08,@9FC 0163 04680000 * DCBPTR = ADDR(SYSI) /*PICK UP SYSI ADDR*/; 04690000 LA @F,COMMON+116 0165 04700000 ST @F,COMMON+300 0165 04710000 * DDNAME(1:8) = DDLST(35:42) /*NEW NAME TO SYSI DCB*/; 04720000 LR @4,@F COMMON 0166 04730000 MVC 40(8,@4),34(@2) 0166 04740000 * END; 04750000 * /* NO SYSIN DDNAME AS FIELD CONTAINED 0 */ 04760000 * END; 04770000 * GO TO PDDNAMER /*BR TO CONTINUE INVOCATION*/; 04780000 BC 15,PDDNAMER 0169 04790000 * /******************************************************************* 04800000 * /** * 04810000 * /** SYSIN AND SYSPRINT ARE OPENED HERE.CONDITION CODE 12 * 04820000 * /** RETURNED IF UNABLE TO OPEN SYSIN.THE OPEN LIST IS INITILIZED * 04830000 * /** AND THE E FORM OF THE OPEN MACRO USGD. * 04840000 * /** * 04850000 * /******************************************************************* 04860000 * /* THIS SECTION INITILIZES OPEN LIST WHICH IS IN DYNAMIC AREA */ 04870000 * /* LIST MUST BE IN THIS AREA TO BECOME REENTRANT */ 04880000 * /* INPUT DCB ADDRESS */ 04890000 * AFTER:; 04900000 * OPTBYTE1 = ADDR(SYSI); 04910000 AFTER LA @F,COMMON+116 0171 04920000 ST @F,COMMON+236 0171 04930000 * /* OUTPUT DCB ADDRESS */ 04940000 * OPTBYTE2 = ADDR(SYSP); 04950000 LA @F,COMMON+20 0172 04960000 ST @F,COMMON+240 0172 04970000 * /* FIRST ENTRY FOR LIST TAKE DISP FROM DD CARD */ 04980000 * OPTBYTE1(1) = '00'X ; 04990000 MVI COMMON+236,X'00' 0173 05000000 * /* LAST ENTRY T AKE DISP FROM DD CARD */ 05010000 * OPTBYTE2(1) = '8F'X ; 05020000 MVI COMMON+240,X'8F' 0174 05030000 * R1 = ADDR(OPENLIST) /* LOAD REG FOR OPEN */; 05040000 LA @1,COMMON+236 0175 05050000 * GEN (OPEN MF=(E,(1))); 05060000 OPEN MF=(E,(1)) 05070000 DS 0H 05080000 * /******************************************************************* 05090000 * /** * 05100000 * /** SYSIN IS TESTED FOR BEING OPEN,IF OPEN A HEADER MESSAGE IS * 05110000 * /** INDICATED AND A BRANCH IS TAKEN TO GET THE HEADING PRINTED. * 05120000 * /** IN CASE ANOTHER MESSAGE IS ALREADY INDICATED ITS NUMBER IS * 05130000 * /** SAVED.THE OTHER MESSAGE WILL BE PRINTED AFTER THE HEADER MSG. * 05140000 * /** IF SYSIN IS NOT OPEN AN ERROR IS INDICATED,WE WILL PRINT THE * 05150000 * /** MSG,SET CONDITION CODE 12 AND RETURN TO THE SYSTEM. * 05160000 * /** * 05170000 * /******************************************************************* 05180000 * TEST1 :; 05190000 * DCBPTR = ADDR(SYSI) /**PICK UP SYSI ADDRESS **/; 05200000 TEST1 LA @F,COMMON+116 0178 05210000 ST @F,COMMON+300 0178 05220000 * /* IF SYSIN IS OPEN GO TO PROCESS CARD */ 05230000 * IF OFLGS(4) = '1'B THEN DO ; 05240000 LR @2,@F COMMON 0179 05250000 TM 48(@2),B'00010000' 0179 05260000 BC 12,@9FB 0179 05270000 * IF MS ^= 0 THEN DO /*IS THERE A MESS TO PRINT AFTER HDR MSG*/ 05280000 SR @F,@F 0181 05290000 CH @F,COMMON1+102 0181 05300000 BC 08,@9FA 0181 05310000 * SAVEMS = MS /*YES-SAVE MESSAGE*/; 05320000 MVC COMMON1(2),COMMON1+102 0183 05330000 * MS = 1 /*INDICATE HDR MESSAGE*/; 05340000 LA @F,1 0184 05350000 STH @F,COMMON1+102 0184 05360000 * /* LINK TO PRINT MESSAGE */ 05370000 * GEN ( LINK EP=IEBDGMSG); 05380000 LINK EP=IEBDGMSG 05390000 DS 0H 05400000 * MS = SAVEMS /*RESTORE MESSAGE*/; 05410000 MVC COMMON1+102(2),COMMON1 0186 05420000 * GO TO A1B35 /*BR TO PRINT AND GET CARD*/; 05430000 BC 15,A1B35 0187 05440000 * END; 05450000 * MS = 1 ; /* PRINT HEADING ON SYSPRINT */ 05460000 @9FA LA @F,1 0189 05470000 STH @F,COMMON1+102 0189 05480000 * GO TO A1B35; /* TO PRINT HEAD */ 05490000 BC 15,A1B35 0190 05500000 * END; 05510000 * MS = 24 ; /* MESSAGE 24 */ 05520000 @9FB LA @F,24 0192 05530000 STH @F,COMMON1+102 0192 05540000 * GEN ( LINK EP=IEBDGMSG); 05550000 LINK EP=IEBDGMSG 05560000 DS 0H 05570000 * CONCODE = 12; /**PLACE 12 IN CONCODE**/ 05580000 LA @F,12 0194 05590000 STH @F,COMMON1+2 0194 05600000 * GO TO A2J2 /**BR TO END JOB**/; 05610000 BC 15,A2J2 0195 05620000 * GO TO A2B3; 05630000 * /******************************************************************* 05640000 * /** * 05650000 * /** THIS SECTION WILL TURN ON FLAGSW(1) FIRST BIT TO INDICATE * 05660000 * /** THAT SPECIAL ERROR FLAGGING IS WANTED. * 05670000 * /** * 05680000 * /******************************************************************* 05690000 * PRINTERR:; 05700000 * FLAGSW(1) = '1'B /**INDICATE FLAGGING WANTED WITH MSG** 05710000 PRINTERR OI COMMON2+30,B'10000000' 0198 05720000 * /******************************************************************* 05730000 * /** * 05740000 * /** THIS SECTION WILL TEST FOR FLUSHING OF REMAINDER OF CONTROL * 05750000 * /** CARDS.IF SWITCH IS ON A BRANCH IS TAKEN TO PERFORM CLEANUP. * 05760000 * /** THIS SECTION ALSO SETS CONDITION CODE TO 8 AND TURNS ON THE * 05770000 * /** NOGO SWITCH FOR SYNTAX CHECKING ONLY. * 05780000 * /** * 05790000 * /******************************************************************* 05800000 * PRINTMSG:; 05810000 * A1B3:; 05820000 PRINTMSG EQU * 0200 05830000 * IF CONCODE < 8 THEN DO; /** IS CONCODE LESS THAN EIGHT**/ 05840000 A1B3 LA @F,8 0201 05850000 CH @F,COMMON1+2 0201 05860000 BC 12,@9F9 0201 05870000 * CONCODE = 8 /**CONDITION CODE FOR USER**/; 05880000 STH @F,COMMON1+2 0203 05890000 * END; 05900000 * EPSW = 0 /**TURN OFF MSG INDICATOR SWITCH**/; 05910000 @9F9 MVI COMMON2+32,0 0205 05920000 * /* TURN ON NOGO SWITCH SO THAT SYNTAX WILL BE CHECKED*/ 05930000 * NOGOSW = ON /*TURN ON NOGO SWITCH*/; 05940000 MVC COMMON2+15(1),ON 0206 05950000 * /******************************************************************* 05960000 * /** * 05970000 * /** THIS SECTION PICKS UP THE DATA GENERATOR OUTPUT DATA SET * 05980000 * /** ADDRESS AND 'LINKS' TO THE MESSAGE MODULE TO PRINT A MESSAGE. * 05990000 * /** IF CONDITION CODE IS GT OR EQUAL TO 12,UPON RETURN FROM THE * 06000000 * /** MESSAGE MODULE,CONTROL RETURNS TO THE USER. * 06010000 * /** * 06020000 * /******************************************************************* 06030000 * A1B35:; 06040000 * GEN ( LINK EP=IEBDGMSG); 06050000 A1B35 LINK EP=IEBDGMSG 06060000 DS 0H 06070000 * IF FLUSHSW1 = ON THEN GO TO A2J2 /*BR TO CLEANUP USER STOP*/; 06080000 CLC COMMON2+37(1),ON 0209 06090000 BC 08,A2J2 0210 06100000 * IF CONCODE => 12 THEN DO /**IF CCODE EQ OR GT 12 DO BELOW*/; 06110000 LA @F,12 0211 06120000 CH @F,COMMON1+2 0211 06130000 * GO TO A2J2 /**BR TO END JOB**/; 06140000 BC 13,A2J2 0213 06150000 * END; 06160000 * GEN; 06170000 @9F8 EQU * 0215 06180000 *********************************************************************** 06190000 * THIS SECTION WILL GET A CARD FROM SYSIN AND PUT IT ON SYSOUT * 06200000 * COUNTER IS INITILIZED TO ADDRESS OF THE INPUT BUFFER + 72 * 06210000 * FOR THE SCANNING OF CONTINUATIONS * 06220000 *********************************************************************** 06230000 DS 0H 06240000 * A2B3:; 06250000 * R9 = ADDR(INBUFA) /*REG 9 POINTS AT INBUF */; 06260000 A2B3 LA @9,COMMON1+114 0217 06270000 * /* INITILIZE COUNTER TO INBUF COL 72 */ 06280000 * COUNTER = R9 + 70 /* INIT COUNTER TO CONT COLUMN */; 06290000 LA @F,70 0218 06300000 AR @F,@9 0218 06310000 ST @F,COMMON+232 0218 06320000 * /******************************************************************* 06330000 * /** * 06340000 * /** * 06350000 * /** ***** ***** GET A CONTROL CARD ***** ***** * 06360000 * /** * 06370000 * /** * 06380000 * /******************************************************************* 06390000 * A2B33:; 06400000 * DCBPTR = ADDR(SYSI); /*POINT TO SYSIN DCB @ZA28703 06410000 A2B33 LA @F,COMMON+116 0220 06420000 ST @F,COMMON+300 0220 06430000 * IF DCBPTR -> EODSW = ON THEN GO TO CLEANUP; /*EOF ON @ZA24201 06440000 LR @2,@F COMMON 0221 06450000 CLC 268(1,@2),ON 0221 06460000 BC 08,CLEANUP 0222 06470000 * /*SYSIN ALREADY, THEN GO TO CLEANUP @ZA24201 06480000 * GEN(GET SYSI,INBUFA); 06490000 GET SYSI,INBUFA 06500000 DS 0H 06510000 * /***************************************************************/ 06520000 * /** FLUSH TO END OF DSD GROUP HERE ****************************/ 06530000 * /***************************************************************/ 06540000 * IF FLUSHSW = ON THEN DO /*IF FLUSHSW ON DO BELOW*/; 06550000 CLC COMMON2+36(1),ON 0224 06560000 BC 07,@9F7 0224 06570000 * A2B34:; 06580000 * /******************************************************************* 06590000 * /** * 06600000 * /** THIS SECTION WILL FLUSH CARDS ON INPUT UNTIL AN 'END' * 06610000 * /** CONTROL CARD IS FOUND.THEY ARE NOT PRINTED ON SYSPRINT.WHEN END* 06620000 * /** IS FOUND THE END SWITCH IS TURNED ON AND A BRANCH IS TAKEN TO * 06630000 * /** CLEANUP. * 06640000 * /** * 06650000 * /******************************************************************* 06660000 * IF INBUF(1) ^= ' ' THEN GO TO A2B344 /**BR TO LOOK FOR END**/ 06670000 A2B34 CLI 0(@9),C' ' 0227 06680000 BC 07,A2B344 0228 06690000 * R9 = R9 + 1 /**INCREMENT SCAN POINTER**/; 06700000 AH @9,@D2 0229 06710000 * IF R9 = COUNTER THEN GO TO A2B33 /*BR AT END OF SCAN**/; 06720000 C @9,COMMON+232 0230 06730000 BC 08,A2B33 0231 06740000 * GO TO A2B34 /** LOOP ON SCAN**/; 06750000 BC 15,A2B34 0232 06760000 * A2B344:; 06770000 * IF INBUF(1:3) ^= 'END' THEN GO TO A2B33 /**BR TO GET CARD**/; 06780000 A2B344 CLC 0(3,@9),@C14 0234 06790000 BC 07,A2B33 0235 06800000 * ENDSW = ON /**TURN ON END SWITCH**/; 06810000 MVC COMMON2+28(1),ON 0236 06820000 * GO TO CLEANUP /**BRANCH TO END THIS DSD GROUP**/; 06830000 BC 15,CLEANUP 0237 06840000 * END; 06850000 * /******************************************************************* 06860000 * /** * 06870000 * /** THIS SECTION IS ENTERED WHEN NO FLUSHING IS REQUIRED.IT WILL* 06880000 * /** CAUSE THE CARD IMAGE TO BE PLACED ON SYSPRINT.IF PRINTING OF * 06890000 * /** ALL FLUSHED CARDS IS REQUIRED THIS SECTION SHOULD BE MOVED * 06900000 * /** AHEAD OF PRIOR SECTION. * 06910000 * /** * 06920000 * /******************************************************************* 06930000 * MS = 30 /* PRINT CARD ON SYSPRINT */; 06940000 @9F7 LA @F,30 0239 06950000 STH @F,COMMON1+102 0239 06960000 * GEN ( LINK EP=IEBDGMSG); 06970000 LINK EP=IEBDGMSG 06980000 DS 0H 06990000 * GEN; 07000000 *********************************************************************** 07010000 * THIS SECTION WILL SCAN CONTROL CARDS AT LOCATION INBUF. R9 * 07020000 * IS USED AS A POINTER WHICH IS UPDATED AS NEEDED BY THE SCAN * 07030000 * CONTROL CARD NAMES ARE SKIPPED BY IF PRESENT.A NAME IS * 07040000 * INDICATED TO THE SCAN BY A NON-BLANK IN COL ONE UPON FIRST * 07050000 * ENTRY WHEN INSPECTING THE CARD. A BLANK SHOULD FOLLOW THE * 07060000 * NAME.BLANK CARDS ARE FLUSHED. SEVERAL SWITCHES ARE TESTED * 07070000 * FOR CONTINUATION AND APPROPRIATE BRANCHES GIVEN.CONTINUATION * 07080000 * FOR ALL CONTROL CARDS STARTS IN COL 4 * 07090000 *********************************************************************** 07100000 DS 0H 07110000 * /******************************************************************* 07120000 * /** * 07130000 * /** ***** CONTROL CARD SCAN STARTS HERE ***** * 07140000 * /** * 07150000 * /******************************************************************* 07160000 * SCAN:; 07170000 * /******************************************************************* 07180000 * /** * 07190000 * /** IF THE FD CONTINUATION SWITCH IS ON,'LINK' TO IEBFDANL. * 07200000 * /** * 07210000 * /******************************************************************* 07220000 * IF FDCSW = ON THEN DO /* IF FD CONT CARD DO FOLLOWING*/; 07230000 SCAN CLC COMMON2(1),ON 0243 07240000 BC 07,@9F6 0243 07250000 * LINKFD:; 07260000 * GEN ( LINK EP=IEBFDANL) ; 07270000 LINKFD LINK EP=IEBFDANL 07280000 DS 0H 07290000 * /*************************************** 07300000 * /* UPON RETURN FROM THE FD ANALYSIS ** 07310000 * /* MODULE WE MUST DETERMINE WHETHER A * 07320000 * /* MESSAGE IS TO BE PRINTED OR ANOTHER * 07330000 * /* CONTROL CARD IS NEEDED.A MESSAGE IS * 07340000 * /* INDICATED BY EPSW BEING A 1. * 07350000 * /*************************************** 07360000 * LINKFD1:; 07370000 * IF EPSW ^= 1 THEN GO TO A2B3 /**GET A CARD NO MSG REQD**/; 07380000 LINKFD1 CLI COMMON2+32,1 0248 07390000 BC 07,A2B3 0249 07400000 * GO TO A1B3 /**BRANCH TO ISSUE MESSAGE**/; 07410000 BC 15,A1B3 0250 07420000 * END; 07430000 * /******************************************************************* 07440000 * /** * 07450000 * /** IF THE CR CONTINUATION SWITCH IS ON,BRANCH TO ISSUE 'LINK' * 07460000 * /** TO IEBCRANL. * 07470000 * /** * 07480000 * /******************************************************************* 07490000 * /* IF CRCSW ON GO TO LINK TO CRANL*/ 07500000 * IF CRCSW = ON THEN GO TO A2G35; 07510000 @9F6 EQU * 0252 07520000 CLC COMMON2+18(1),ON 0252 07530000 BC 08,A2G35 0253 07540000 * /******************************************************************* 07550000 * /** * 07560000 * /** THIS SECTION WILL TEST FOR COMMENTS CONTINUATION FOR THIS * 07570000 * /** MODULE(IGBDG) AND (IGBFDANL).AS LONG AS A NON-BLANK IS FOUND * 07580000 * /** IN COLUMN 72 AND THE COMCSW IS ON A BRANCH WILL BE TAKEN TO * 07590000 * /** GET ANOTHER CARD.THE LAST COMMENT CARD,BLANK IN 72,CAUSES THE * 07600000 * /** COMCSW TO BE TURNED OFF AND A BRANCH TO GET ANOTHER CARD. * 07610000 * /** * 07620000 * /******************************************************************* 07630000 * IF COMCSW = ON THEN DO /*IF COM CONT SW ON DO FOLLOWING*/; 07640000 CLC COMMON2+29(1),ON 0254 07650000 BC 07,@9F5 0254 07660000 * /* IF THIS CARD HAS COMM INDICATOR GET ANOTHER */ 07670000 * IF COUNTER -> INBUF(2) ^= ' ' THEN GO TO A2B3; 07680000 L @2,COMMON+232 COMMON 0256 07690000 CLI 1(@2),C' ' 0256 07700000 BC 07,A2B3 0257 07710000 * COMCSW = OFF /* TURN OFF COMMENT CONT SW */; 07720000 MVC COMMON2+29(1),OFF 0258 07730000 * GO TO A2B3 /* BR TO GET ANOTHER CARD*/; 07740000 BC 15,A2B3 0259 07750000 * END; 07760000 * /******************************************************************* 07770000 * /** THIS SECTION TESTS FOR A DSD CONTINUATION.IF ON,THE SWITCH * 07780000 * /** IS TURNED OFF,SCAN POINTED AT COLUMN 4 AND BRANCH TO PROCESS. * 07790000 * /******************************************************************* 07800000 * IF DSDCSW = ON THEN DO /*IS DSD CONTINUATION SW ON*/; 07810000 @9F5 CLC COMMON2+17(1),ON 0261 07820000 BC 07,@9F4 0261 07830000 * DSDCSW = OFF /* YES TURN IT OFF*/; 07840000 MVC COMMON2+17(1),OFF 0263 07850000 * R9 = R9 + 3 /**POINTER TO CONT COLUMN**/; 07860000 AH @9,@D3 0264 07870000 * GO TO A3C4 /* BR TO CONTINUE SCANNING DSD */; 07880000 BC 15,A3C4 0265 07890000 * END; 07900000 * /******************************************************************* 07910000 * /** * 07920000 * /** IF THE FD PICTURE CONTINUE SWITCH IS ON A BRANCH IS TAKEN TO * 07930000 * /** 'LINK' TO IEBFDANL FOR FURTHER PROCESSING. * 07940000 * /******************************************************************* 07950000 * IF FDPCSW = ON THEN GO TO LINKFD /* BR TO LINK TO FD */; 07960000 @9F4 CLC COMMON2+2(1),ON 0267 07970000 BC 08,LINKFD 0268 07980000 * /******************************************************************* 07990000 * /** * 08000000 * /** IF FIRST COLUMN OF CARD IS NOT BLANK BRANCH TO PROCESS * 08010000 * /** A CONTROL CARD NAME. * 08020000 * IF INBUF(1) ^= ' ' THEN GO TO LABEL1 /**BR IF COL1 NOT BLANK* 08030000 CLI 0(@9),C' ' 0269 08040000 BC 07,LABEL1 0270 08050000 * SCAN1:; 08060000 * /******************************************************************* 08070000 * /** * 08080000 * /** THIS SECTION WILL SCAN OUT BLANKS LOOKING FOR THE FIRST * 08090000 * /** NON-BLANK COLUMN IN THE CARD.A NON-BLANK CAUSES A BRANCH TO * 08100000 * /** PROCESS FOR THE CONTROL CARD NAME. * 08110000 * /******************************************************************* 08120000 * /* IF CHAR FOUND GO TO ANALYZE KEYWORD */ 08130000 * IF INBUF(1) ^= ' ' THEN GO TO A2D3 /*BR NON-BLANK TO PROCESS* 08140000 SCAN1 CLI 0(@9),C' ' 0272 08150000 BC 07,A2D3 0273 08160000 * /* THIS WILL SCAN OUT BLANKS */ 08170000 * IF R9 = COUNTER THEN GO TO A2B3 /*BR IF AT COLUMN 71 * 08180000 C @9,COMMON+232 0274 08190000 BC 08,A2B3 0275 08200000 * R9 = R9 + 1 /** ADD ONE TO SCAN POINTER */; 08210000 AH @9,@D2 0276 08220000 * GO TO SCAN1; 08230000 BC 15,SCAN1 0277 08240000 * GEN; 08250000 *********************************************************************** 08260000 * THIS SECTION SCANS OUT ANY NAME PRESENT UPON A CONTROL CARD. A NAME* 08270000 * IS RECOGNISED AS ANY NON-BLANK STARTING IN COL 1. IT MAY BE 8 CHAR * 08280000 * LONG.THE NAME MUST BE FOLLOWED BY A BLANK. * 08290000 *********************************************************************** 08300000 DS 0H 08310000 * LABEL1:; 08320000 * R9= R9 + ONE; 08330000 LABEL1 AH @9,ONE 0280 08340000 * IF INBUF(1) ^=' ' THEN DO; /* TO SCAN OUT CONTROL CARD LABEL*/ 08350000 CLI 0(@9),C' ' 0281 08360000 BC 08,@9F3 0281 08370000 * IF R9 > ADDR(INBUFA) + 8 THEN DO /* IS NAME TO LONG */; 08380000 LA @F,8 0283 08390000 LA @0,COMMON1+114 0283 08400000 AR @F,@0 0283 08410000 CR @F,@9 0283 08420000 BC 10,@9F2 0283 08430000 * MS = 12 /* MESSAGE 12 */; 08440000 LA @F,12 0285 08450000 STH @F,COMMON1+102 0285 08460000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 08470000 BC 15,PRINTERR 0286 08480000 * END; 08490000 * GO TO LABEL1; 08500000 * END; 08510000 * GO TO SCAN1; 08520000 * GEN; 08530000 *********************************************************************** 08540000 * THIS SECTION SCANS OUT DSD,FD,CREATE. A DSD CARD MUST BE * 08550000 * PRESENT FIRST OTHERWISE NOGO IS SET AND SYNTAX CHECKING * 08560000 * ONLY IS PERFORMED. MULTIPLE DSD CARDS NOT ALLOWED. THE LAST * 08570000 * ONE WILL BE EFFECTIVE. LABELS OF A3 OPERATE ON DSD.LABELS OF * 08580000 * A4 OPERATE ON FD. LABELS OF A6 OPERATE ON CREATE * 08590000 *********************************************************************** 08600000 DS 0H 08610000 * A2D3:; 08620000 * /* LOOK FOR DSD BEING FIRST CARD */ 08630000 * /* IF WE HAVE A DSD GO TO LOOK FOR OTHER CONTROL CARDS */ 08640000 * IF INBUF(1:3)=DSD THEN GO TO A3B3; 08650000 A2D3 CLC 0(3,@9),DSD 0293 08660000 BC 08,A3B3 0294 08670000 * IF DSDSW = ON THEN GO TO A2G3 /* BR IF DSDSW ON*/; 08680000 CLC COMMON2+14(1),ON 0295 08690000 BC 08,A2G3 0296 08700000 * FLUSHSW = ON /**FLUSH TO END OF DSD GROUP**/; 08710000 MVC COMMON2+36(1),ON 0297 08720000 * MS = 18 /** MSG DSD CARD NOT FIRST **/; 08730000 LA @F,18 0298 08740000 STH @F,COMMON1+102 0298 08750000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 08760000 BC 15,PRINTERR 0299 08770000 * A2G3:; 08780000 * /******************************************************************* 08790000 * /** * 08800000 * /** IF CONTROL CARD IS 'FD' THEN BRANCH TO LINK TO IEBFDANL * 08810000 * /******************************************************************* 08820000 * IF INBUF(1:2) = 'FD' THEN GO TO LINKFD ; 08830000 A2G3 CLC 0(2,@9),@C15 0301 08840000 BC 08,LINKFD 0302 08850000 * /******************************************************************* 08860000 * /** * 08870000 * /** IF CONTROL CARD IS 'CREATE' THEN LINK TO IEBCREAT * 08880000 * /** * 08890000 * /******************************************************************* 08900000 * IF INBUF(1:6) = 'CREATE' THEN DO; 08910000 CLC 0(6,@9),@C16 0303 08920000 BC 07,@9F1 0303 08930000 * A2G35:; 08940000 * GEN( LINK EP=IEBCRANL); 08950000 A2G35 LINK EP=IEBCRANL 08960000 DS 0H 08970000 * /******************************************************************* 08980000 * /** * 08990000 * /** UPON RETURN FROM IEBCREAT WE TEST FOR NEED FOR MESSAGE * 09000000 * /** AND FLUSHING TO END OF JOB.FLUSHSW1 EQ END OF JOB.EPSW A ONE * 09010000 * /** EQ NEED FOR MESSAGE.IF NEITHER ONE IS INDICATED A BRANCH IS * 09020000 * /** TAKEN TO GET ANOTHER CONTROL CARD. * 09030000 * /******************************************************************* 09040000 * IF EPSW = 1 THEN GO TO A1B3; 09050000 CLI COMMON2+32,1 0307 09060000 BC 08,A1B3 0308 09070000 * IF FLUSHSW1 = ON THEN GO TO A2J2 /**BR TO CLEANUP USER STOP** 09080000 CLC COMMON2+37(1),ON 0309 09090000 BC 08,A2J2 0310 09100000 * GO TO A2B3; 09110000 BC 15,A2B3 0311 09120000 * END; 09130000 * /******************************************************************* 09140000 * /** * 09150000 * /** THIS SECTION TESTS FOR 'REPEAT'.IF FOUND A BRANCH IS TAKEN * 09160000 * /** TO PROCESS THE REPEAT CONTROL CARD. * 09170000 * /** * 09180000 * /******************************************************************* 09190000 * /* IF REPEAT CONTROL CARD */ 09200000 * /* GO TO PROCESS IT */ 09210000 * IF INBUF(1:6) = 'REPEAT' THEN GO TO A3C14; 09220000 @9F1 CLC 0(6,@9),@C17 0313 09230000 BC 08,A3C14 0314 09240000 * /** * 09250000 * /******************************************************************* 09260000 * /** THIS SECTION TESTS FOR END.IF FOUND THE END SWITCH IS * 09270000 * /** TURNED ON AND A BRANCH TAKEN TO CLEANUP. * 09280000 * /** * 09290000 * /******************************************************************* 09300000 * /* IF END CONTROL CARD GO */ 09310000 * /* TO PROCESS IT */ 09320000 * IF INBUF(1:3) = 'END' THEN DO; 09330000 CLC 0(3,@9),@C14 0315 09340000 BC 07,@9F0 0315 09350000 * ENDSW = ON /* TURN ON END SWITCH*/; 09360000 MVC COMMON2+28(1),ON 0317 09370000 * GO TO CLEANUP; 09380000 BC 15,CLEANUP 0318 09390000 * END; 09400000 * /******************************************************************* 09410000 * /** * 09420000 * /** THIS SECTION TESTS FOR 'DUMP'.IF FOUND REGISTER 15 IS LOADED* 09430000 * /** WITH ZERO AND A BRANCH TAKEN ON REG 15.THIS FACILITY ALLOWS THE* 09440000 * /** FIELD ENGINEER TO CAUSE AN'ABEND' DUMP TO OCCUR.IT IS INTENDED * 09450000 * /** THAT THIS FACILITY WILL BE EXPANDED SOME TIME IN THE FUTURE TO * 09460000 * /** INCORPORATE MUCH MORE DIAGNOSTIC CAPABILITY. * 09470000 * /** * 09480000 * /******************************************************************* 09490000 * IF INBUF(1:4) ^= 'DUMP' THEN GO TO A2G36; 09500000 @9F0 CLC 0(4,@9),@C18 0320 09510000 BC 07,A2G36 0321 09520000 * R15 = 0 ; 09530000 SR @F,@F 0322 09540000 * GEN ( BR 15 ); 09550000 BR 15 09560000 DS 0H 09570000 * /******************************************************************* 09580000 * /** * 09590000 * /** AT THIS POINT A CORRECT CONTROL CARD NAME HAS NOT BEEN FOUND* 09600000 * /** A MESSAGE IS INDICATED AND A BRANCH TAKEN TO ISSUE THE MESSAGE.* 09610000 * /** * 09620000 * /******************************************************************* 09630000 * A2G36:; 09640000 * IF INBUF(1:2) = '/*' THEN 09650000 A2G36 CLC 0(2,@9),@C19 0325 09660000 * GO TO CLEANUP; 09670000 BC 08,CLEANUP 0326 09680000 * MS = 2 /* MESSAGE 2 */; 09690000 LA @F,2 0327 09700000 STH @F,COMMON1+102 0327 09710000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 09720000 BC 15,PRINTERR 0328 09730000 * GEN; 09740000 *********************************************************************** 09750000 * THIS SECTION PERFORMS THE CLEANUP FUNCTION IT IS ENTERED FROM* 09760000 * EODAD ON SYSIN WHEN A /* CARD IS FOUND IN THE INPUT STREAM. * 09770000 * ENTRY IS ALSO FROM THE END CONTROL CARD******* * 09780000 *********************************************************************** 09790000 DS 0H 09800000 * CLEANUP:; 09810000 * A2J2:; 09820000 CLEANUP EQU * 0331 09830000 * /******************************************************************* 09840000 * /** A MESSAGE WILL BE INDICATED IF THE REPEATSW IS LEFT ON BY * 09850000 * /** THE CREATE MODULE.CREATE TURNS THIS OFF IF THE REPEAT FUNCTION * 09860000 * /** HAS BEEN FULLY SATISFIED. * 09870000 * /******************************************************************* 09880000 * IF REPEATSW = ON THEN DO /*IS REPEAT QUANTITY SATISFIED*/; 09890000 A2J2 CLC COMMON2+42(1),ON 0332 09900000 BC 07,@9EF 0332 09910000 * MS = 14 /* NO-SET MESSAGE NUMBER */; 09920000 LA @F,14 0334 09930000 STH @F,COMMON1+102 0334 09940000 * GEN ( LINK EP=IEBDGMSG); 09950000 LINK EP=IEBDGMSG 09960000 DS 0H 09970000 * /* REPEAT QUANTITY SATISFIED HERE */ 09980000 * END; 09990000 * /******************************************************************** 10000000 * /* * 10010000 * /* CHECK IF SPECIFIED PICTURE DOES EXCEED END OR /* ,IF SO GIVE MSG * 10020000 * /* AND SET CONDITION CODE . A41807* 10030000 * /* * 10040000 * /******************************************************************** 10050000 * IF PICCSW(4) = '1'B /* STILL PICTURE EXPECT A41807* 10060000 * THEN DO ; /* END OF CONTROL STATEMENT A41807* 10070000 @9EF TM COMMON2+26,B'00010000' 0337 10080000 BC 12,@9EE 0337 10090000 * MS = 16 ; /* SET MESSAGE A41807* 10100000 LA @F,16 0339 10110000 STH @F,COMMON1+102 0339 10120000 * PICCSW(4) = '0'B ; /* SET TO ZERO A41807* 10130000 NI COMMON2+26,B'11101111' 0340 10140000 * FLUSHSW1 = ON ; /* SET SWITCH TO END JOB A41807* 10150000 MVC COMMON2+37(1),ON 0341 10160000 * GO TO PRINTERR ; /* PRINT ERROR MESSAGE A41807* 10170000 BC 15,PRINTERR 0342 10180000 * END ; /* END OF CHECK PICTURE LEN A41807* 10190000 * /* * 10200000 * IF ENDSW = ON THEN GO TO A2J5 /**BR AROUND COMP MSG,END ON ** 10210000 @9EE CLC COMMON2+28(1),ON 0344 10220000 BC 08,A2J5 0345 10230000 * MS = 29 /**INDICATE SUCCESSFUL COMPLETION MESSAGE**/; 10240000 LA @F,29 0346 10250000 STH @F,COMMON1+102 0346 10260000 * A2J4:; 10270000 * /** LINK TO MESSAGE MODULE **/ 10280000 * GEN ( LINK EP=IEBDGMSG); 10290000 A2J4 LINK EP=IEBDGMSG 10300000 DS 0H 10310000 * /******************************************************************* 10320000 * /** * 10330000 * /** ******** CLEANUP MODULE ENTERED FROM HERE ******** * 10340000 * /** * 10350000 * /******************************************************************* 10360000 * A2J5:; 10370000 * GEN ( LINK EP=IEBDGCUP); 10380000 A2J5 LINK EP=IEBDGCUP 10390000 DS 0H 10400000 * A2J6:; 10410000 * /******************************************************************* 10420000 * /** UPON RETURN FROM CLEANUP THE END SWITCH BEING ON INDICATES * 10430000 * /** THAT THERE MAY BE ANOTHER GROUP OF CONTROL CARDS TO PROCESS. * 10440000 * /** THE SWITCHES ARE TURNED OFF AND A BRANCH TAKEN TO GET ANOTHER * 10450000 * /** CONTROL CARD.IF NO MORE CONTROL CARDS ARE PRESENT A SLASH * 10460000 * /** ASTERICK CARD SHOULD BE PRESENT.CLEANUP WOULD BE ENTERED AGAIN * 10470000 * /** WITH THE END SWITCH OFF.THIS CAUSES DATA GENERATOR SYSIN AND * 10480000 * /** SYSPRINT DATA SETS TO BE CLOSED.UPON RETURN FROM CLEANUP A * 10490000 * /** RETURN IS TAKEN FROM THIS MODULE BACK TO THE SYSTEM. * 10500000 * /******************************************************************* 10510000 * IF ENDSW = ON THEN DO /**DO BELOW IF ENDSW ON **/; 10520000 A2J6 CLC COMMON2+28(1),ON 0352 10530000 BC 07,@9ED 0352 10540000 * SWITCH(1) = '00'X /**FIRST SW TO OFF **/; 10550000 MVI COMMON2,X'00' 0354 10560000 * SWITCH(2:53) = SWITCH(1:52); 10570000 MVC COMMON2+1(52),COMMON2 0355 10580000 * SYSINSEL = OFF /** TURN OFF SYSIN SEL SWITCH**/; 10590000 MVC COMMON3+28(1),OFF 0356 10600000 * GO TO A2B3; 10610000 BC 15,A2B3 0357 10620000 * END; 10630000 * GO TO USER /** RETURN TO USER **/; 10640000 * /******************************************************************* 10650000 * /** * 10660000 * /** THIS SECTION WILL SCAN FOR KEYWORDS ON THE DSD CONTROL CARD.* 10670000 * /** KEYWORDS ALLOWED ARE OUTPUT= AND INPUT=. AN EIGHT CHARACTER * 10680000 * /** DD NAME IS ALLOWED WITHIN THE PARANTHESIS.ANY NUMBER OF DDNAMES* 10690000 * /** ARE ALLOWED WITHIN THE DELIMITERS,ALTHOUGH THE CURRENT * 10700000 * /** IMPLEMENTATION WITHIN THE CREATE MODULE CAN ONLY PROCESS ONE * 10710000 * /** OUTPUT DATA SET.THE SRL ONLY ALLOWS ONE OUTPUT DATA SET.ONE * 10720000 * /** INPUT DATA SET MAY BE PROCESSED PER CREATE CARD. * 10730000 * /** * 10740000 * /******************************************************************* 10750000 * A3B3:; 10760000 * /******************************************************************* 10770000 * /** * 10780000 * /** THIS SECTION TESTS AND ALLOWS ONLY ONE DSD CARD PER GROUP. * 10790000 * /** MESSAGE IS INDICATED IF MORE THAN ONE. * 10800000 * /** * 10810000 * /******************************************************************* 10820000 * IF DSDSW = ON THEN DO /**IS A DSD ALREADY PRESENT**/; 10830000 A3B3 CLC COMMON2+14(1),ON 0361 10840000 BC 07,@9EC 0361 10850000 * MS = 25 /**INDICATE MESSAGE**/; 10860000 LA @F,25 0363 10870000 STH @F,COMMON1+102 0363 10880000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 10890000 BC 15,PRINTERR 0364 10900000 * END; 10910000 * /******************************************************************* 10920000 * /** * 10930000 * /** THIS SECTION INITILIZES REPEATNO AND CREATEND TO ONE FOR THE* 10940000 * /** CREATE MODULE IF THE NOGO SWITCH ISNT ON. * 10950000 * /******************************************************************* 10960000 * IF NOGOSW = ON THEN GO TO A3C3 /* BR IF NOGO SWITCH IS ON*/; 10970000 @9EC CLC COMMON2+15(1),ON 0366 10980000 BC 08,A3C3 0367 10990000 * DSDSW = ON /* TURN ON DSD SWITCH*/; 11000000 MVC COMMON2+14(1),ON 0368 11010000 * REPEATNO = 1 /* INIT REPEATNO FOR CRANL*/; 11020000 LA @F,1 0369 11030000 STH @F,COMMON+16 0369 11040000 * CREATENO = 1 /*INIT CREATENO FOR CRANL */; 11050000 STH @F,COMMON+18 0370 11060000 * /******************************************************************* 11070000 * /** * 11080000 * /** TEST FOR A BLANK FOLLOWING 'DSD' AND ISSUE MSG IF NOT THERE.* 11090000 * /******************************************************************* 11100000 * A3C3:; 11110000 * R9 = R9 + THREE /* ADVANCE POINTER TO BLANK */; 11120000 A3C3 AH @9,THREE 0372 11130000 * IF INBUF(1) = ' ' THEN GO TO A3C4; 11140000 CLI 0(@9),C' ' 0373 11150000 BC 08,A3C4 0374 11160000 * MS = 20 /* MESSAGE 20 */; 11170000 LA @F,20 0375 11180000 STH @F,COMMON1+102 0375 11190000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 11200000 BC 15,PRINTERR 0376 11210000 * A3C4:; 11220000 * /** THIS SECTION TESTS FOR PROCESSING OF MULTIPLE DDNAMES WITHIN **/ 11230000 * /** THE PARENS.IF DSDSW IS ON,IT IS TURNED OFF AND A BRANCH TAKEN**/ 11240000 * /** TO A3C45 FOR FURTHER PROCESSING OF A NAME.SCANNING IS STARTED ** 11250000 * /** AT COL FOUR **/ 11260000 * IF DSDISW = ON THEN DO /** IS INPUT CONT IND **/; 11270000 A3C4 CLC COMMON2+39(1),ON 0378 11280000 BC 07,@9EB 0378 11290000 * DSDISW = OFF /** TURN OFF DSDISW**/; 11300000 MVC COMMON2+39(1),OFF 0380 11310000 * GO TO A3C45 /** BRANCH FOR FURTHER SCANNING**/; 11320000 BC 15,A3C45 0381 11330000 * END; 11340000 * IF REPEATSW = ON THEN DO /**DO BELOW IF REPEATSW ON**/; 11350000 @9EB CLC COMMON2+42(1),ON 0383 11360000 * GO TO A3C143 /** BRANCH FOR REPEAT CONT**/; 11370000 BC 08,A3C143 0385 11380000 * END; 11390000 * /******************************************************************* 11400000 * /** * 11410000 * /** THIS SECTION SCANS OUT ANY BLANK COLUMNS FOLLOWING 'DSD' * 11420000 * /******************************************************************* 11430000 * IF INBUF(1) = ' ' THEN DO ; 11440000 @9EA CLI 0(@9),C' ' 0387 11450000 BC 07,@9E9 0387 11460000 * R9 = R9 + ONE ; /* ADD ONE TO BUFFER PTR */ 11470000 AH @9,ONE 0389 11480000 * /* THIS SCANS OUT BLANKS */ 11490000 * IF R9 < COUNTER THEN GO TO A3C4; 11500000 C @9,COMMON+232 0390 11510000 BC 04,A3C4 0391 11520000 * IF R9 => COUNTER THEN GO TO A3C441 /**BR IF WRONG COLUMN**/; 11530000 C @9,COMMON+232 0392 11540000 BC 10,A3C441 0393 11550000 * END; 11560000 * /******************************************************************** 11570000 * /** ** 11580000 * /** THIS SECTION SCANS OUT THE KEYWORDS OUTPUT AND INPUT ** 11590000 * /** IT WILL ISSUE A GETMAIN FOR 256 BYTES AS A DDNAME IS FOUND ** 11600000 * /** A COPY OF A DCB IS MOVED INTO THIS AREA AND THE DDNAME FOUND ** 11610000 * /** PLACED IN THE DCB.THE DCB IS THEN OPENED.IF UNABLE TO OPEN THE ** 11620000 * /** DCB A MESSAGE IS ISSUED NOGOI SET AND INPUT STREAM FLUSHED THRU** 11630000 * /** THE END CARD.ADDRESSES OF MULTIPLE DCBS ARE KEPT AS FOLLOWS: ** 11640000 * /** FIRSTGMI = FIRST INPUT DCB,FIRSTGMO = FIRST OUTPUT DCB * 11650000 * /** NEXTDCB = ADDRESS OF NEXT DCB,WORD 65 OF EACH DCB ** 11660000 * /** DDNAME1 = DDNAME FOR THIS DCB,WORD 66-67 OF EACH DCB ** 11670000 * /** ** 11680000 * /******************************************************************** 11690000 * A3C41:; 11700000 @9E9 EQU * 0395 11710000 * /******************************************************************* 11720000 * /** * 11730000 * /** THIS SECTION TESTS FOR 'OUTPUT',IF FOUND,THE DSDDSW IS * 11740000 * /** TURNED ON,POINTER ADJUSTED TO DDNAME AND A BRANCH TAKEN TO * 11750000 * /** SCAN OUT THE OUTPUT DDNAME. * 11760000 * /******************************************************************* 11770000 * /* LOOK FOR OUTPUT KEYWORD */ 11780000 * IF INBUF(1:8) = 'OUTPUT=(' THEN DO; 11790000 A3C41 CLC 0(8,@9),@C21 0396 11800000 BC 07,@9E8 0396 11810000 * DSDOSW = ON /* TURN ON DSDOSW */; 11820000 MVC COMMON2+38(1),ON 0398 11830000 * R9 = R9 + 8 /* ADJUST POINTER */; 11840000 AH @9,@D4 0399 11850000 * GO TO A3C44 /* BRANCH TO SCAN OUT NAME */; 11860000 BC 15,A3C44 0400 11870000 * END; /*LOOK FOR INPUT KEYWORD*/; 11880000 * /******************************************************************* 11890000 * /** * 11900000 * /** THIS SECTION TESTS FOR 'INPUT' AND BRANCHES TO SCAN OUT * 11910000 * /** INPUT DDNAME,OTHERWISE AN ERROR MESSAGE IS INDICATED * 11920000 * /******************************************************************* 11930000 * IF INBUF(1:7) = 'INPUT=(' THEN GO TO A3C43; 11940000 @9E8 CLC 0(7,@9),@C22 0403 11950000 BC 08,A3C43 0404 11960000 * MS = 5 /*INVALID KEYWORD MESS */; 11970000 LA @F,5 0405 11980000 STH @F,COMMON1+102 0405 11990000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 12000000 BC 15,PRINTERR 0406 12010000 * A3C43:; 12020000 * /******************************************************************* 12030000 * /** * 12040000 * /** ENTRY HERE FOR INPUT DDNAMES ONLY.THE DSDOSW IS TURNED OFF * 12050000 * /** AND THE SCAN POINTER ADJUSTED TO POINT TO INPUT DDNAME. * 12060000 * /******************************************************************* 12070000 * DSDOSW = OFF /** TURN OFF DSD OUTPUT SWITCH**/; 12080000 A3C43 MVC COMMON2+38(1),OFF 0408 12090000 * R9 = R9 + 7 /* ADJUST POINTER*/; 12100000 AH @9,@D5 0409 12110000 * A3C44:; 12120000 * /******************************************************************* 12130000 * /** * 12140000 * /** IF DDNAME IS IN COL 72 INDICATE MSG AND BRANCH. * 12150000 * /******************************************************************* 12160000 * IF R9 < COUNTER THEN GO TO A3C45 /* IS POINTER AT COL 72*/; 12170000 A3C44 C @9,COMMON+232 0411 12180000 BC 04,A3C45 0412 12190000 * A3C441:; 12200000 * MS = 21 /* COL 72 MESSAGE */; 12210000 A3C441 LA @F,21 0414 12220000 STH @F,COMMON1+102 0414 12230000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 12240000 BC 15,PRINTERR 0415 12250000 * /******************************************************************* 12260000 * /** * 12270000 * /** SET UP FOR SCAN AND BRANCH TO SCAN OUT DDNAME. * 12280000 * /******************************************************************* 12290000 * A3C45:; 12300000 * R7 = R9 /* COPY PTR FOR SCAN */; 12310000 A3C45 LR @7,@9 0417 12320000 * GO TO A3C50 /* BRANCH TO SCAN OUT NAME */; 12330000 BC 15,A3C50 0418 12340000 * /******************************************************************* 12350000 * /** * 12360000 * /** INCREMENT POINTER AND TEST TO SEE IF DDNAME EXTENDS INTO COLUMN* 12370000 * /* 72. BRANCH TO SET MESSAGE IF SO A38710 * 12380000 * /******************************************************************* 12390000 * A3C47:; 12400000 * R7 = R7 + 1 /* ADD 1 TO SCAN PTR*/; 12410000 A3C47 AH @7,@D2 0420 12420000 * IF R7 = COUNTER + 1 THEN GO TO A3C441 ; /*BRANCH TO MSGA38710 * 12430000 LA @F,1 0421 12440000 A @F,COMMON+232 0421 12450000 CR @F,@7 0421 12460000 BC 08,A3C441 0422 12470000 * /******************************************************************* 12480000 * /* 12490000 * /* LOOK FOR COMMA OR PAREN FOLLOWING DDNAME 12500000 * /* FOR OUTPUT ONLY ONE DDNAME IS PERMITTED A38766 12510000 * /* 12520000 * /******************************************************************* 12530000 * A3C50:; 12540000 * IF R7 -> INBUF(1) = ',' THEN DO ; /* CHECK FOR COMMA A38766* 12550000 A3C50 CLI 0(@7),C',' 0424 12560000 BC 07,@9E7 0424 12570000 * IF DSDOSW ^= ON THEN GO TO A3C60 ; /*INPUT:CONT A38766* 12580000 CLC COMMON2+38(1),ON 0426 12590000 BC 07,A3C60 0427 12600000 * /* FOR OUTPUT MORE THEN ONE DDNAME SPECIF A38766* 12610000 * MS = 3 ; /* SET MSG INVALID OPER A38766* 12620000 LA @F,3 0428 12630000 STH @F,COMMON1+102 0428 12640000 * GO TO PRINTERR ; /* PRINT ERROR MSG A38766* 12650000 BC 15,PRINTERR 0429 12660000 * END ; /* A38766* 12670000 * IF R7 -> INBUF(1) ^= ')' THEN GO TO A3C47 /*BR NOT FOUND*/; 12680000 @9E7 CLI 0(@7),C')' 0431 12690000 BC 07,A3C47 0432 12700000 * PARENSW = ON /*TURN ON PAREN SW */; 12710000 MVC COMMON2+41(1),ON 0433 12720000 * /* END OF DDNAME PARA FOUND AT THIS POINT R9 POINTS AT START OF */ 12730000 * /* NAME IN INBUF.WE WILL GET LENGTH IN R6,GETMAIN FOR DCB PLACE*/ 12740000 * /* NAME IN DCB AND AT WORD 66-67 OF DCB */ 12750000 * /******************************************************************* 12760000 * /** * 12770000 * /** THIS SECTION DETERMINES IF A VALID DDNAME WAS FOUND. * 12780000 * /******************************************************************* 12790000 * A3C60:; 12800000 * R6 = R7 - R9 /* CALCULATE DDNAME LENGTH*/; 12810000 A3C60 LCR @6,@9 0435 12820000 AR @6,@7 0435 12830000 * IF R6 = 0 THEN GO TO A3C65 /* BR TO SET MSG */; 12840000 LTR @6,@6 0436 12850000 BC 08,A3C65 0437 12860000 * IF R6 > EIGHT THEN DO; /* NAME TO LONG */ 12870000 CH @6,EIGHT 0438 12880000 BC 12,@9E6 0438 12890000 * A3C65:; 12900000 * MS = 3 /*INDICATE MESSAGE 3 */; 12910000 A3C65 LA @F,3 0441 12920000 STH @F,COMMON1+102 0441 12930000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 12940000 BC 15,PRINTMSG 0442 12950000 * END; 12960000 * /******************************************************************* 12970000 * /** * 12980000 * /** THIS SECTION GETS CORE FOR 280 BYTES FOR A DCB.16 BYTES ARE** 12990000 * /** USED FOR SWITCHES AND DDNAME.4 BYTES FOR WORKAREA POINTER * 13000000 * /******************************************************************* 13010000 * GEN ( GETMAIN EC,LV=280,A=GCADDR,SP=0,MF=(E,GETMLIST)); 13020000 @9E6 EQU * 0444 13030000 GETMAIN EC,LV=280,A=GCADDR,SP=0,MF=(E,GETMLIST) 13040000 DS 0H 13050000 * /******************************************************************* 13060000 * /** * 13070000 * /** IF GETMAIN IS SUCCESSFUL BRANCH TO CLEAR GOTTEN CORE, * 13080000 * /* R15 CONTAINS CCODES UPON RETURN FROM GMAIN 0=OK,4=NOTOK */ 13090000 * /** OTHERWISE INDICATE MSG,CONCODE AND BRANCH TO PRINT MESSAGE. * 13100000 * /******************************************************************* 13110000 * IF R15 = 0 THEN GO TO A3C70 /* BRANCH IF GMAIN SUCESS */; 13120000 LTR @F,@F 0445 13130000 BC 08,A3C70 0446 13140000 * MS = 10 /*NO SUCCESS GMAIN MESSAGE*/; 13150000 LA @F,10 0447 13160000 STH @F,COMMON1+102 0447 13170000 * CONCODE = 12 /*CONDITION CODE FOR USER*/; 13180000 LA @F,12 0448 13190000 STH @F,COMMON1+2 0448 13200000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 13210000 BC 15,PRINTMSG 0449 13220000 * /******************************************************************* 13230000 * /** * 13240000 * /** CLEAR CORE HERE AND PUT CORE ADDRESS IN DCB POINTER.MOVE COPY * 13250000 * /** OF DCB TO THIS AREA. * 13260000 * /******************************************************************* 13270000 * A3C70:; 13280000 * DCBPTR = GCADDR /* INIT DCB PTR*/; 13290000 A3C70 MVC COMMON+300(4),COMMON1+72 0451 13300000 * DCBD(1:256) = MYDCB3A /* COPY 256 BYTE DCB*/; 13310000 L @2,COMMON+300 COMMON 0452 13320000 MVC 0(256,@2),MYDCB3A 0452 13330000 * DCBD(257) = '00'X /* CLEAR CORE*/; 13340000 MVI 256(@2),X'00' 0453 13350000 * DCBD(258:280) = DCBD(257:279) /** CLEAR CORE**/; 13360000 MVC 257(23,@2),256(@2) 0454 13370000 * /******************************************************************* 13380000 * /** THIS SECTION INITILIZES TABLES FOR GETMAIN ADDRESSES * 13390000 * /******************************************************************* 13400000 * /* */ 13410000 * /* IF WE ARE PROCESSING OUTPUT DS USE THIS SECTION OTHERWISE GO TO */ 13420000 * /* NEXT */ 13430000 * IF DSDOSW = ON THEN DO /* IS DSD OUTPUT SW ON */; 13440000 CLC COMMON2+38(1),ON 0455 13450000 BC 07,@9E5 0455 13460000 * IF FIRSTGMO = 0 THEN DO /*IS ADDR INITILIZED*/; 13470000 SR @F,@F 0457 13480000 C @F,COMMON1+76 0457 13490000 BC 07,@9E4 0457 13500000 * FIRSTGMO = GCADDR /*IF NO,INITILIZE IT*/; 13510000 MVC COMMON1+76(4),COMMON1+72 0459 13520000 * LASTGMO = GCADDR /* INIT LAST GM PTR*/; 13530000 MVC COMMON1+84(4),COMMON1+72 0460 13540000 * CURRGMO = GCADDR /* INIT CURRENT GM ADDR*/; 13550000 MVC COMMON1+80(4),COMMON1+72 0461 13560000 * GO TO A3C75 /*BR TO OPEN OUTPUTDCB FIRST TIME*/; 13570000 BC 15,A3C75 0462 13580000 * END; 13590000 * DCBPTR = LASTGMO /*INIT DCBPTR TO PREV DCBAD*/; 13600000 @9E4 MVC COMMON+300(4),COMMON1+84 0464 13610000 * NEXTDCB = GCADDR /*INIT NEXTDCB PTR TO NEXT*/; 13620000 L @2,COMMON+300 COMMON 0465 13630000 MVC 256(4,@2),COMMON1+72 0465 13640000 * CURRGMO = GCADDR /* INIT CURRENT GM ADDR*/; 13650000 MVC COMMON1+80(4),COMMON1+72 0466 13660000 * DCBPTR = GCADDR /*INIT DCBPTR TO CURRENT*/; 13670000 MVC COMMON+300(4),COMMON1+72 0467 13680000 * LASTGMO = GCADDR /*INIT LASTGM PTR*/; 13690000 MVC COMMON1+84(4),COMMON1+72 0468 13700000 * GO TO A3C75 /* BR TO OPEN DS */; 13710000 BC 15,A3C75 0469 13720000 * END; 13730000 * /* THIS POINT IS ENTERED IF INPUT DDNAME IS FOUND LENGTH OF NAME*/ 13740000 * /* IS IN R6 R9 POINTS AT START */ 13750000 * /* */ 13760000 * IF FIRSTGMI = 0 THEN DO /*Q-FIRST TIME ON INPUT */; 13770000 @9E5 SR @F,@F 0471 13780000 C @F,COMMON1+88 0471 13790000 BC 07,@9E3 0471 13800000 * FIRSTGMI = GCADDR /* INIT FIRST GM PTR*/; 13810000 MVC COMMON1+88(4),COMMON1+72 0473 13820000 * LASTGMI = GCADDR /* INIT LAST GM PTR*/; 13830000 MVC COMMON1+96(4),COMMON1+72 0474 13840000 * CURRGMI = GCADDR /* INIT CURRENT GM PTR*/; 13850000 MVC COMMON1+92(4),COMMON1+72 0475 13860000 * GO TO A3C73 /*BR THIS IS FOR FIRST TIME*/; 13870000 BC 15,A3C73 0476 13880000 * END; 13890000 * /* COME HERE WHEN FIRST GM PTR HAS BEEN INITILIZED */ 13900000 * DCBPTR = LASTGMI /* INIT DCBPTR TO PREV DCBAD*/ 13910000 @9E3 MVC COMMON+300(4),COMMON1+96 0478 13920000 * NEXTDCB = GCADDR /* INIT NEXTDCB PTR TO NEXT*/; 13930000 L @2,COMMON+300 COMMON 0479 13940000 MVC 256(4,@2),COMMON1+72 0479 13950000 * CURRGMI = GCADDR /* INIT CURRENT GM PTR*/; 13960000 MVC COMMON1+92(4),COMMON1+72 0480 13970000 * DCBPTR = GCADDR /* INIT DCBPTR TO CURRENT*/; 13980000 MVC COMMON+300(4),COMMON1+72 0481 13990000 * LASTGMI = GCADDR /* INIT LAST GM PTR*/; 14000000 MVC COMMON1+96(4),COMMON1+72 0482 14010000 * /******************************************************************* 14020000 * /** * 14030000 * /** AT THIS POINT WE HAVE GOT SPACE FOR A DCB,CLEARED THIS SPACE* 14040000 * /** AND INIT NEXTDCBPTR IN PREVIOUS DCB.WE WILL NOW PLACE THE * 14050000 * /** DDNAME INTO THE DCB AND AT END OF DCB FOR THE CREATE MODULE. * 14060000 * /** * 14070000 * /******************************************************************* 14080000 * A3C73:; 14090000 * A3C75:; 14100000 A3C73 EQU * 0484 14110000 * DDNAME1 = INBUF(1:R6) /*MOVE DDNAME TO TABLE*/; 14120000 A3C75 LR @2,@6 0485 14130000 BCTR @2,0 0485 14140000 LR @E,@9 0485 14150000 L @4,COMMON+300 COMMON 0485 14160000 LA @A,260(0,@4) 0485 14170000 MVI 0(@A),C' ' 0485 14180000 MVC 1(007,@A),0(@A) 0485 14190000 EX @2,@MVC 0485 14200000 * A3C76:; 14210000 * DDNAME = INBUF(1:R6) /*MOVE DDNAME TO DCB */; 14220000 A3C76 LR @2,@6 0487 14230000 BCTR @2,0 0487 14240000 LR @E,@9 0487 14250000 L @4,COMMON+300 COMMON 0487 14260000 LA @A,40(0,@4) 0487 14270000 MVI 0(@A),C' ' 0487 14280000 MVC 1(007,@A),0(@A) 0487 14290000 EX @2,@MVC 0487 14300000 * /******************************************************************** 14310000 * /* * 14320000 * /* TO TAKE CARE THAT THE RIGHT ACCESS METHOD IS USED THERE A37883* 14330000 * /* IS DONE A GETMAIN TO GET STORAGE NECESSARY TO READ A JFCB A37883* 14340000 * /* SO THAT BEFORE OPEN THE DSORG CAN BE CHECKED A37883* 14350000 * /* TO SUPPORT PO MEMBERS THEIR DSORG WILL BE SET TO PS A37883* 14360000 * /* * 14370000 * /******************************************************************** 14380000 * DSORG = '40'X ; /* SET DEFAULT DSORG=PS A37883* 14390000 MVI 26(@4),X'40' 0488 14400000 * OPTBYTE1 = DCBPTR ; /* GIVE ADDRESS OF DCB A50927* 14410000 MVC COMMON+236(4),COMMON+300 0489 14420000 * GENERATE ; /* TO GET CORE FOR JFCB A37883* 14430000 * * 14440000 * DO GETMAIN FOR JFCB A37883 * 14450000 * * 14460000 LA R0,GETAREA LOAD 176 FOR JFCB A37883 * 14470000 GETMAIN R,LV=(0) GETMAIN FOR 176 BYTES A37883 14480000 DS 0H 14490000 * /******************************************************************** 14500000 * /* A37883* 14510000 * /* IF GETMAIN SUCCESFUL CLEAR GOTTEN CORE, RETURN CODE=0, A37883* 14520000 * /* OTHERWISE GIVE MESS,COND COD & PRINT MESS A37883* 14530000 * /* A37883* 14540000 * /******************************************************************** 14550000 * IF R15 ^= 0 /* GETMAIN NOT SUCCESFULA37883* 14560000 * THEN DO ; /* THEN A37883* 14570000 LTR @F,@F 0491 14580000 BC 08,@9E2 0491 14590000 * MS = 10 ; /* GIVE MESS A37883* 14600000 LA @F,10 0493 14610000 STH @F,COMMON1+102 0493 14620000 * CONCODE = 12 ; /* COND CODE FOR USER A37883* 14630000 LA @F,12 0494 14640000 STH @F,COMMON1+2 0494 14650000 * GO TO PRINTMSG ; /* PRINT MESSAGE A37883* 14660000 BC 15,PRINTMSG 0495 14670000 * END ; 14680000 * /* * 14690000 * /* BUILD SKELETON DCB FOR RDJFCB A37883* 14700000 * /* * 14710000 * JFCBPTR = R1 ; /* SAVE JFCB ADDRESS A37883* 14720000 @9E2 ST @1,JFCBPTR 0497 14730000 * EXLIST = ADDR(EXITLIST) ; /* PUT EXIT ADDR IN DCB A37883* 14740000 LA @F,EXITLIST 0498 14750000 L @2,COMMON+300 COMMON 0498 14760000 ST @F,@TEMP4 0498 14770000 MVC 37(3,@2),@TEMP4+1 0498 14780000 * PTRJFCB = ADDR(JFCB) ; /* POINT DCB EXIT TO JFCB37883* 14790000 L @4,JFCBPTR 0499 14800000 ST @4,@TEMP4 0499 14810000 MVC EXITLIST+1(3),@TEMP4+1 0499 14820000 * HEX87 = '87'X ; /* FILL IN INDIC JFCB A37883* 14830000 MVI EXITLIST,X'87' 0500 14840000 * JFCB(1) = '00'X ; /* CLEAR CORE A37883* 14850000 MVI 0(@4),X'00' 0501 14860000 * JFCB(2:176) = JFCB(1:175) ; /* FOR USING JFCB A38883* 14870000 MVC 1(175,@4),0(@4) 0502 14880000 * OPTBYTE1(1) = '80'X ; /* INDICATE INPUT A50927* 14890000 MVI COMMON+236,X'80' 0503 14900000 * R1 = ADDR(OPENLIST) ; /*GIVE PLACE IN SUBPOOL A50927* 14910000 LA @1,COMMON+236 0504 14920000 * GEN( RDJFCB MF=(E,(1))) ; /* READ JFCB A50927* 14930000 RDJFCB MF=(E,(1)) 14940000 DS 0H 14950000 * /* TEST DSORG; IF IT IS INDEX SEQ. SET IT SO; ELSE DSORG=P.S A37883* 14960000 * IF DSORGJ(1) = '1'B /* IS DSORG INDEX SEQ A37883* 14970000 * THEN DO ; /* YES, THEN A37883* 14980000 TM 98(@4),B'10000000' 0506 14990000 BC 12,@9E1 0506 15000000 * DSORG = '80'X ; /* RESET DSORG TO I.S. A37883* 15010000 MVI 26(@2),X'80' 0508 15020000 * END ; /* END OF CHECKING DSORGA37883* 15030000 * /* RESET JFCB-EXIT AND GIVE STORAGE BACK;ALSO RELEASE REG 3. A37883* 15040000 * HEX87 = '07'X ; /* RESET JFCBEXIT NOT L A37883* 15050000 @9E1 MVI EXITLIST,X'07' 0510 15060000 * R1 = JFCBPTR ; /* POINT R1 TO JFCBAREA A37883* 15070000 L @1,JFCBPTR 0511 15080000 * GENERATE ; /* FREEMAIN MACRO A37883* 15090000 LA R0,GETAREA SIZE OF JFCBAREA A37883 15100000 FREEMAIN R,LV=(0),A=(1) FREE UP JFCBAREA A37883 15110000 DS 0H 15120000 * /* */ 15130000 * /* WE ARE NOW READY TO OPEN THE DCB THE OPEN LIST MUST BE INIT.*/ 15140000 * /* SEE CONTROL PROGRAM SERVICES FORM C28-6541-1 PAGE 123 FOR */ 15150000 * /* DESCRIPTION OF PARAMETER LIST */ 15160000 * /* */ 15170000 * OPTBYTE1 = DCBPTR /* DCB ADDRESS TO LIST*/; 15180000 MVC COMMON+236(4),COMMON+300 0513 15190000 * EXLIST = ADDR(EXLST3) /* INITLZ DCB EXLIST ADDR */; 15200000 LA @F,COMMON+276 0514 15210000 L @2,COMMON+300 COMMON 0514 15220000 ST @F,@TEMP4 0514 15230000 MVC 37(3,@2),@TEMP4+1 0514 15240000 * EDCB5 = '85'X /* INITLZ EXIT LIST IND FIELD */; 15250000 MVI COMMON+276,X'85' 0515 15260000 * EDCB6 = ADDR(DCBROUT3) /*INITLZ EXIT LIST ADDR FIELD */; 15270000 LA @F,DCBROUT3 0516 15280000 ST @F,@TEMP4 0516 15290000 MVC COMMON+277(3),@TEMP4+1 0516 15300000 * IF DSDOSW = ON THEN DO /*IF OUTPUT SET BITS */; 15310000 CLC COMMON2+38(1),ON 0517 15320000 BC 07,@9E0 0517 15330000 * OPTBYTE1(1) = '8F'X /* INDICATE LAST,DISP,OUTPUT */; 15340000 MVI COMMON+236,X'8F' 0519 15350000 * GO TO A3C77 /* BR TO OPEN DCB */; 15360000 BC 15,A3C77 0520 15370000 * END; 15380000 * OPTBYTE1(1) = '80'X /* INDICATE OPEN FOR INPUT */; 15390000 @9E0 MVI COMMON+236,X'80' 0522 15400000 * MACRF = '5000'X /*SET MACRF TO GET MOVE */; 15410000 L @2,COMMON+300 COMMON 0523 15420000 MVC 50(2,@2),@X27 0523 15430000 * /* READY TO OPEN DCB AS INDICATED IN LIST */ 15440000 * A3C77:; 15450000 * R1 = ADDR(OPENLIST) /*OPEN LIST ADDR FOR OPEN*/; 15460000 A3C77 LA @1,COMMON+236 0525 15470000 * GEN (OPEN MF=(E,(1))); 15480000 OPEN MF=(E,(1)) 15490000 DS 0H 15500000 * IF OFLGS(4) ^='1' B THEN GO TO A3C79 /* BR DCB NOT OPEN*/; 15510000 L @2,COMMON+300 COMMON 0527 15520000 TM 48(@2),B'00010000' 0527 15530000 BC 12,A3C79 0528 15540000 * IF FLUSHSW = ON THEN DO /* FALL THROUGH-FLUSH REQUIRED */; 15550000 CLC COMMON2+36(1),ON 0529 15560000 BC 07,@9DF 0529 15570000 * /* IF FUSHING IS REQD ISSUE MESSAGE* 15580000 * MS = 28 /* MESS FOR INCORRECT DCB PARA */; 15590000 LA @F,28 0531 15600000 STH @F,COMMON1+102 0531 15610000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 15620000 BC 15,PRINTMSG 0532 15630000 * END; 15640000 * /******************************************************************* 15650000 * /** * 15660000 * /** THIS SECTION GETS CORE FOR THE LRECL WORKAREA.ITS ADDRESS * 15670000 * /** IS STORED IN LOCATION OUTREC FOR USE BY THE CREATE MODULE. * 15680000 * /** BLOCKSIZE LENGTH IS GOTTEN IF RECORD FORMAT IS 'U'. * 15690000 * /** * 15700000 * /******************************************************************* 15710000 * R6 = LRECL /* COPY RCD LGTH FOR GETMAIN */; 15720000 @9DF L @2,COMMON+300 COMMON 0534 15730000 LH @6,82(0,@2) 0534 15740000 * IF RECFM = 'C0'X THEN DO /**BRANCH IF NOT 'U' RCD **/; 15750000 CLI 36(@2),X'C0' 0535 15760000 BC 07,@9DE 0535 15770000 * R6 = BLKSI /** PICK UP BLOCKSIZE**/; 15780000 LH @6,62(0,@2) 0537 15790000 * END; 15800000 * IF DSORG(1) = '1'B THEN DO ; /* INDEX SEQUENTIAL A45169* 15810000 @9DE L @2,COMMON+300 COMMON 0539 15820000 TM 26(@2),B'10000000' 0539 15830000 BC 12,@9DD 0539 15840000 * R6 = R6 + KEYLEN ; /* ADD KEYLEN TO LRECL A45169* 15850000 SR @0,@0 0541 15860000 IC @0,16(0,@2) 0541 15870000 AR @6,@0 0541 15880000 * END ; /* FOR GETTING CORR BUFA45169* 15890000 * R8 = ADDR(GCADDR) /* GET GC ADDRESS */; 15900000 @9DD LA @8,COMMON1+72 0543 15910000 * GEN ( GETMAIN EC,LV=(R6),A=(R8),SP=0,MF=(E,GETMLIST)); 15920000 GETMAIN EC,LV=(R6),A=(R8),SP=0,MF=(E,GETMLIST) 15930000 DS 0H 15940000 * /******************************************************************* 15950000 * /** * 15960000 * /** IF GETMAIN IS SUCCESSFUL INITILIZE INREC OR OUTREC AND BRANCH * 15970000 * /** * 15980000 * /******************************************************************* 15990000 * IF R15 = 0 THEN DO /* IS GETMAIN SUCESSFUL */; 16000000 LTR @F,@F 0545 16010000 BC 07,@9DC 0545 16020000 * GMLGTH = R6 /** SAVE LENGTH FOR CUP**/; 16030000 L @2,COMMON+300 COMMON 0547 16040000 STH @6,276(0,@2) 0547 16050000 * IF DSDOSW = ON THEN DO /**IF OUTPUT DO BELOW**/; 16060000 CLC COMMON2+38(1),ON 0548 16070000 BC 07,@9DB 0548 16080000 * OUTREC = GCADDR /**INIT ADDR FOR OUTPUT WORKAREA**/ 16090000 MVC COMMON1+4(4),COMMON1+72 0550 16100000 * GO TO A3C80 /** BRANCH FOR PROCESSING**/; 16110000 BC 15,A3C80 0551 16120000 * END; 16130000 * INREC = GCADDR /**INIT ADDR FOR INPUT WORKAREA**/; 16140000 @9DB L @2,COMMON+300 COMMON 0553 16150000 MVC 272(4,@2),COMMON1+72 0553 16160000 * GO TO A3C80 /**BRANCH FOR PROCESSING**/; 16170000 BC 15,A3C80 0554 16180000 * END ; 16190000 * /******************************************************************* 16200000 * /** * 16210000 * /** SET MESSAGE,INDICATE FLUSH TO END CARD AND BRANCH TO PRINT * 16220000 * /******************************************************************* 16230000 * MS = 10 /* INDICATE MESSAGE*/; 16240000 @9DC LA @F,10 0556 16250000 STH @F,COMMON1+102 0556 16260000 * FLUSHSW = ON /* TURN ON FLUSH AND ISSUE MESSAGE*/; 16270000 MVC COMMON2+36(1),ON 0557 16280000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 16290000 BC 15,PRINTMSG 0558 16300000 * /******************************************************************* 16310000 * /** * 16320000 * /** THIS SECTION INDICATES MSG,CONCODE FOR AN UNSUCCESSFUL * 16330000 * /** OPEN AND BRANCHES TO PRINT MESSAGE. * 16340000 * /** * 16350000 * /******************************************************************* 16360000 * A3C79:; 16370000 * CONCODE = 12 /*CODE FOR USER */; 16380000 A3C79 LA @F,12 0560 16390000 STH @F,COMMON1+2 0560 16400000 * MS = 24 /* SET MSG CANNOT OPEN */; 16410000 LA @F,24 0561 16420000 STH @F,COMMON1+102 0561 16430000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 16440000 BC 15,PRINTERR 0562 16450000 * /******************************************************************* 16460000 * /** * 16470000 * /** CONTINUE HERE AFTER AN OPEN SUCCESS. * 16480000 * /** THERE MAY BE MORE DCBS TO OPEN.R9 POINTS AT START OF DDNAME AS * 16490000 * /** OF LAST OPEN.R6 = LENGTH OF NAME.R7 = COMMA OR PAREN AFTER NAME* 16500000 * /** A BLANK AFTER PAREN INDICATES END OF CARD.COMMA INDICATES * 16510000 * /** MORE DDNAMES ARE PRESENT.THE POINTER WILL BE ADVANCED AND IF * 16520000 * /** COMMA IS PRESENT A BRANCH IS TAKEN TO SCAN OUT ANOTHER NAME. * 16530000 * /** IF BLANK A BRANCH IS TAKEN TO GET ANOTHER CARD. * 16540000 * /** * 16550000 * /******************************************************************* 16560000 * A3C80:; 16570000 * A3C81:; 16580000 A3C80 EQU * 0564 16590000 * R9 = R7 + 1 /*ADVANCE POINTER TO OPERAND*/ 16600000 A3C81 LA @9,1 0565 16610000 AR @9,@7 0565 16620000 * IF R7 -> INBUF(1) = ',' THEN DO /**IF COMMA PRESENT WE ARE 16630000 CLI 0(@7),C',' 0566 16640000 BC 07,@9DA 0566 16650000 * SCANNING INSIDE PARENS**/; 16660000 * IF INBUF(1) = ' ' THEN GO TO A3C83 /** IF A BLANK FOLLOWS 16670000 CLI 0(@9),C' ' 0568 16680000 * THE COMMA WE HAVE 16690000 * INPUT DDNAMES ON THE 16700000 * NEXT CARD**/; 16710000 BC 08,A3C83 0569 16720000 * IF R7 = COUNTER THEN DO /** IF COMMA IN COL 71 DO BELOW**/; 16730000 C @7,COMMON+232 0570 16740000 BC 07,@9D9 0570 16750000 * A3C83:; 16760000 * DSDCSW = ON /** TURN ON DSD CONT SW**/; 16770000 A3C83 MVC COMMON2+17(1),ON 0573 16780000 * DSDISW = ON /** GT 1 NAME WITHIN PARENS DSDISW ON**/ 16790000 MVC COMMON2+39(1),ON 0574 16800000 * GO TO A2B3 /** BRANCH TO GET ANOTHER CARD**/; 16810000 BC 15,A2B3 0575 16820000 * END; 16830000 * GO TO A3C45 /** BRANCH NOT AT COL 71 YET**/; 16840000 * END; 16850000 * IF INBUF(1) = ' ' THEN DO /*TO CHECK FOR COMMENTS*/; 16860000 @9DA CLI 0(@9),C' ' 0579 16870000 BC 07,@9D8 0579 16880000 * IF COUNTER -> INBUF(2) ^= ' ' THEN DO; 16890000 L @2,COMMON+232 COMMON 0581 16900000 CLI 1(@2),C' ' 0581 16910000 BC 08,@9D7 0581 16920000 * COMCSW = ON; /*SET COMMENTS SW*/ 16930000 MVC COMMON2+29(1),ON 0583 16940000 * END; 16950000 * IF FIRSTGMO = 0 THEN DO; /* NO OUTPUT SPECIFIEDA48784* 16960000 @9D7 SR @F,@F 0585 16970000 C @F,COMMON1+76 0585 16980000 BC 07,@9D6 0585 16990000 * MS = 24 ; /* GIVE MESSAGE A48784* 17000000 LA @F,24 0587 17010000 STH @F,COMMON1+102 0587 17020000 * GO TO PRINTERR ; /*PRINT ERROR MSG A48784* 17030000 BC 15,PRINTERR 0588 17040000 * END; /* END OF OUTPUT CHECKA48784* 17050000 * GO TO A2B3 /* NO COMMENTS-BRANCH*/; 17060000 * END; 17070000 * /******************************************************************* 17080000 * /** * 17090000 * /** A COMMA AT THIS POINT INDICATES ANOTHER KEYWORD PRESENT, * 17100000 * /** OTHERWISE A MSG IS INDICATED. * 17110000 * /******************************************************************* 17120000 * IF INBUF(1) = ',' THEN DO /* IF COMMA DO BELOW*/; 17130000 @9D8 CLI 0(@9),C',' 0592 17140000 BC 07,@9D5 0592 17150000 * R9 = R9 + 1 /*STEP PTR PAST COMMA*/; 17160000 AH @9,@D2 0594 17170000 * IF INBUF(1) = ' ' THEN DO /**A BLANK INDICATES CONT **/; 17180000 CLI 0(@9),C' ' 0595 17190000 BC 07,@9D4 0595 17200000 * DSDCSW = ON /**TURN ON DSD CONT SW**/; 17210000 MVC COMMON2+17(1),ON 0597 17220000 * GO TO A2B3 /**BRANCH TO GET ANOTHER CARD**/; 17230000 BC 15,A2B3 0598 17240000 * END; 17250000 * GO TO A3C41 /*BR TO SCAN NEXT KEYWORD*/; 17260000 * END; 17270000 * MS = 3 /*SET MESSAGE INDICATION*/; 17280000 @9D5 LA @F,3 0602 17290000 STH @F,COMMON1+102 0602 17300000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 17310000 BC 15,PRINTERR 0603 17320000 * /******************************************************************* 17330000 * /** * 17340000 * /** ***** REPEAT CARD HERE ***** * 17350000 * /** * 17360000 * /** ADVANCE POINTER PAST KEYWORD,MSG IF NO FOLLOWING BLANK * 17370000 * /** * 17380000 * /******************************************************************* 17390000 * A3C14:; 17400000 * /* POINT TO BLANK FOLLOWING*/ 17410000 * /* KEYWORD REPEAT */ 17420000 * R9 = R9 + SIX; 17430000 A3C14 AH @9,SIX 0605 17440000 * IF INBUF(1) = ' ' THEN GO TO A3C141; 17450000 CLI 0(@9),C' ' 0606 17460000 BC 08,A3C141 0607 17470000 * MS = 20 /* MESSAGE 20 */; 17480000 LA @F,20 0608 17490000 STH @F,COMMON1+102 0608 17500000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 17510000 BC 15,PRINTERR 0609 17520000 * /******************************************************************* 17530000 * /** * 17540000 * /** SCAN LOOKING FOR FIRST KEYWORD,IF NO KEY BY COL 71 CAUSE A * 17550000 * /** MESSAGE TO BE ISSUED. * 17560000 * /** * 17570000 * /******************************************************************* 17580000 * A3C141:; 17590000 * IF R9 > COUNTER THEN DO /**ARE WE AT COL 72 **/; 17600000 A3C141 C @9,COMMON+232 0611 17610000 BC 12,@9D3 0611 17620000 * MS21:; 17630000 * MS = 21 /** INDICATE MESSAGE 21 **/; 17640000 MS21 LA @F,21 0614 17650000 STH @F,COMMON1+102 0614 17660000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 17670000 BC 15,PRINTMSG 0615 17680000 * END; 17690000 * R9 = R9 + ONE ; /* ADVANCE POINTER */ 17700000 @9D3 AH @9,ONE 0617 17710000 * IF INBUF(1) = ' ' THEN GO TO A3C141 /*BR IF COLUMN BLANK*/; 17720000 CLI 0(@9),C' ' 0618 17730000 BC 08,A3C141 0619 17740000 * A3C142:; 17750000 * /******************************************************************* 17760000 * /** * 17770000 * /** THIS SECTION TESTS FOR MORE THAN ONE REPEAT CARD PER DSD GROUP * 17780000 * /******************************************************************* 17790000 * IF REPEATSW = ON THEN DO /* CHECK FOR DUPLICATE REPEAT CARD*/ 17800000 A3C142 CLC COMMON2+42(1),ON 0621 17810000 BC 07,@9D2 0621 17820000 * MS = 14 /* SET MESSAGE 14 */; 17830000 LA @F,14 0623 17840000 STH @F,COMMON1+102 0623 17850000 * FLUSHSW = ON /* FLUSH ON */; 17860000 MVC COMMON2+36(1),ON 0624 17870000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 17880000 BC 15,PRINTMSG 0625 17890000 * END; 17900000 * /******************************************************************* 17910000 * /** * 17920000 * /** THIS SECTION TURNS ON THE REPEAT SWITCH AND PROCESSES FOR THE * 17930000 * /** KEYWORD 'QUANTITY'.IF FOUND A BRANCH IS TAKEN TO CONVERT THE * 17940000 * /** DECIMAL NUMBER TO BINARY. * 17950000 * /******************************************************************* 17960000 * A3C143:; 17970000 @9D2 EQU * 0627 17980000 * REPEATSW = ON /* INDICATE A REPEAT CARD*/; 17990000 A3C143 MVC COMMON2+42(1),ON 0628 18000000 * IF INBUF(1:9) = 'QUANTITY=' THEN DO ; 18010000 CLC 0(9,@9),@C29 0629 18020000 BC 07,@9D1 0629 18030000 * R9 = R9 + NINE ; 18040000 AH @9,NINE 0631 18050000 * IF R9 > COUNTER THEN GO TO MS21 /**PRINT MS21 IF AT COL 72**/; 18060000 C @9,COMMON+232 0632 18070000 BC 02,MS21 0633 18080000 * R7 = ADDR(REPEATNO); 18090000 LA @7,COMMON+16 0634 18100000 * QUANSW = ON /* SET SWITCH INDICATING QUANTITY */; 18110000 MVC COMMON2+40(1),ON 0635 18120000 * GO TO CONVERTB ; 18130000 BC 15,CONVERTB 0636 18140000 * END; 18150000 * /******************************************************************* 18160000 * /** * 18170000 * /** THIS SECTION PROCESSES THE CREATE KEYWORD OF THE REPEAT CARD * 18180000 * /** IF FOUND A BRANCH IS TAKEN TO CONVERT THE DECIMAL NUMBER. * 18190000 * /******************************************************************* 18200000 * IF INBUF(1:7) = 'CREATE=' THEN DO ; 18210000 @9D1 CLC 0(7,@9),@C30 0638 18220000 BC 07,@9D0 0638 18230000 * R9 = R9 + SEVEN; 18240000 AH @9,SEVEN 0640 18250000 * IF R9 > COUNTER THEN GO TO MS21 /**PRINT MS21 IF AT COL 72**/; 18260000 C @9,COMMON+232 0641 18270000 BC 02,MS21 0642 18280000 * R7 = ADDR(CREATENO); 18290000 LA @7,COMMON+18 0643 18300000 * GO TO CONVERTB; 18310000 BC 15,CONVERTB 0644 18320000 * END; 18330000 * /******************************************************************* 18340000 * /** * 18350000 * /** THIS SECTION INDICATES A MESSAGE WHEN THE KEY IS UNRECOGNIZABLE* 18360000 * /******************************************************************* 18370000 * MS = 5 /* MESSAGE 5 */; 18380000 @9D0 LA @F,5 0646 18390000 STH @F,COMMON1+102 0646 18400000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 18410000 BC 15,PRINTERR 0647 18420000 * GEN; 18430000 *********************************************************************** 18440000 * AT ENTRY TO THIS CONVERT DECIMAL TO BINARY SUBROUTINE R9 POINTS AT * 18450000 * INBUFA JUST AFTER QUANTITY= OR CREATE=. R7 CONTAINS ADDRESS OF * 18460000 * REPEATNO OR CREATENO. UPON COMPLETION BINARY NUMBER >HOULD BE * 18470000 * PRESENT IN CORRECT FIELD.R9 WILL BE INIT TO BLANK OR JUST PAST COMMA* 18480000 * FOLLOWING FIELD. BLANK INDICATES END OF CARD . CONTROL GOES TO READ * 18490000 * ANOTHER. COMMA INDICATES ANOTHER FIELD ,CONTROL TO A3C142 TO LOOK * 18500000 * FOR CORRECT FIELD * 18510000 *********************************************************************** 18520000 DS 0H 18530000 * /* COPY START ADDR OF FIELD*/ 18540000 * CONVERTB:; 18550000 * /* CLEAR WORK FIELD */ 18560000 * R8 = R9 ; 18570000 CONVERTB LR @8,@9 0650 18580000 * CONV1:; 18590000 * /* SEARCH FOR END OF FIELD */ 18600000 * IF R8 -> INBUF(1) = ' ' THEN GO TO CONV2; 18610000 CONV1 CLI 0(@8),C' ' 0652 18620000 BC 08,CONV2 0653 18630000 * /* SEARCH FOR END OF FIELD */ 18640000 * IF R8 -> INBUF(1) = ',' THEN GO TO CONV2; 18650000 CLI 0(@8),C',' 0654 18660000 BC 08,CONV2 0655 18670000 * R8 = R8 + ONE; /* INC POINTER BY ONE */ 18680000 AH @8,ONE 0656 18690000 * IF R8 ^> COUNTER THEN GO TO CONV1 ; /* IF NOT PAST 72 A38710 * 18700000 C @8,COMMON+232 0657 18710000 BC 12,CONV1 0658 18720000 * MS = 21 /** INDICATE MESSAGE 21 **/; 18730000 LA @F,21 0659 18740000 STH @F,COMMON1+102 0659 18750000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 18760000 BC 15,PRINTERR 0660 18770000 * CONV2:; 18780000 * R8 = R8-R9 ; /* OBTAIN FIELD LENGTH */ 18790000 CONV2 SR @8,@9 0662 18800000 * IF R8 <= 0 THEN GO TO CONV4; 18810000 LTR @8,@8 0663 18820000 BC 12,CONV4 0664 18830000 * R8 = R8 -ONE; /* TO CORRECT NUMBER */ 18840000 SH @8,ONE 0665 18850000 * /* PACK FIELD */ 18860000 * GEN ( EX R8,CONV5); 18870000 EX R8,CONV5 18880000 DS 0H 18890000 * /* CONVERT TO BINARY*/ 18900000 * GEN ( CVB R6,Q); 18910000 CVB R6,Q 18920000 DS 0H 18930000 * IF R6 = 0 THEN DO /** DO BELOW IF ZERO**/; 18940000 LTR @6,@6 0668 18950000 BC 07,@9CF 0668 18960000 * MS = 15 /** SET MESSAGE 15 **/; 18970000 LA @F,15 0670 18980000 STH @F,COMMON1+102 0670 18990000 * GO TO PRINTERR /** BRANCH TO PRINT MESSAGE**/; 19000000 BC 15,PRINTERR 0671 19010000 * END; 19020000 * IF R6 > 65535 THEN GO TO CONV4; 19030000 @9CF C @6,@D6 0673 19040000 BC 02,CONV4 0674 19050000 * GEN ( STH R6,0(R7)); /* STORE NUMBER */ 19060000 STH R6,0(R7) 19070000 DS 0H 19080000 * /******************************************************************* 19090000 * /** * 19100000 * /** AT THIS POINT WE ARE THROUGH CONVERTING THE DECIMAL NUMBER. * 19110000 * /** SCAN CONTINUES LOOKING FOR END OF CARD OR INDICATION OF * 19120000 * /** ANOTHER KEYWORD. * 19130000 * /** * 19140000 * /******************************************************************* 19150000 * CONV3:; 19160000 * /* POINTER TO COMMA OR */ 19170000 * /* BLANK FOLLOWING NUMBER*/ 19180000 * R9 = R9 + R8 + ONE; 19190000 CONV3 LH @F,ONE 0677 19200000 AR @F,@8 0677 19210000 AR @9,@F 0677 19220000 * /* IF AT END OF FIELD GO */ 19230000 * /* TO READ ANOTHER CARD */ 19240000 * IF INBUF(1) = ' ' THEN GO TO CONV6 /* BR IF COLUMN BLANK */; 19250000 CLI 0(@9),C' ' 0678 19260000 BC 08,CONV6 0679 19270000 * /** R9 IS NOW POINTING AT COMMA**/ 19280000 * IF R9 = COUNTER THEN GO TO CONV34 /** IS COMMA IN COL 71**/; 19290000 C @9,COMMON+232 0680 19300000 BC 08,CONV34 0681 19310000 * IF INBUF(2) = ' ' THEN DO /** IF BLANK DO BELOW**/; 19320000 CLI 1(@9),C' ' 0682 19330000 BC 07,@9CE 0682 19340000 * CONV34:; 19350000 * DSDCSW = ON /** TURN ON CONT SW**/; 19360000 CONV34 MVC COMMON2+17(1),ON 0685 19370000 * GO TO A2B3 /** BR TO GET ANOTHER CARD**/; 19380000 BC 15,A2B3 0686 19390000 * END; 19400000 * R9 = R9 + ONE; /* ADVANCE PTR PAST COMMA */ 19410000 @9CE AH @9,ONE 0688 19420000 * GO TO A3C143 /* BR TO LOOK FOR ANOTHER KEYWORD*/; 19430000 BC 15,A3C143 0689 19440000 * CONV4:; 19450000 * MS = 14; /** SET MSG TO 14 **/ 19460000 CONV4 LA @F,14 0691 19470000 STH @F,COMMON1+102 0691 19480000 * GO TO PRINTERR /** BRANCH TO PRINT MSG AND FLAG **/; 19490000 BC 15,PRINTERR 0692 19500000 * /* **** PACK FIELD *** THIS INST EXECUTED FROM ABOVE**********/ 19510000 * CONV5:; 19520000 * GEN ( PACK Q(8),0(1,R9)); 19530000 CONV5 PACK Q(8),0(1,R9) 19540000 DS 0H 19550000 * CONV6:; 19560000 * /* BRANCH IF COLUMN BLANK */ 19570000 * IF COUNTER -> INBUF(2) = ' ' THEN GO TO CONV7; 19580000 CONV6 L @2,COMMON+232 COMMON 0696 19590000 CLI 1(@2),C' ' 0696 19600000 BC 08,CONV7 0697 19610000 * COMCSW = ON /* TURN ON COMMENTS CONTINUE SWITCH*/; 19620000 MVC COMMON2+29(1),ON 0698 19630000 * CONV7:; 19640000 * IF QUANSW = ON THEN GO TO A2B3 /*BR IF QUAN WAS FOUND */; 19650000 CONV7 CLC COMMON2+40(1),ON 0700 19660000 BC 08,A2B3 0701 19670000 * MS = 15 /* INDICATE MESSAGE QUANTITY MISSING */; 19680000 LA @F,15 0702 19690000 STH @F,COMMON1+102 0702 19700000 * GO TO PRINTMSG /** BRANCH TO PRINT MESSAGE**/; 19710000 BC 15,PRINTMSG 0703 19720000 * /******************************************************************* 19730000 * /** THIS IS THE DCB EXIT ROUTINE ** 19740000 * /** IT WILL TEST FOR BLOCKSIZE AND LRECL BEING PRESENT.LRECL FOR ** 19750000 * /** F RECORDS MUST BE AN EVEN MULTIPLE OF BLOCKSIZE. ** 19760000 * /** FOR SYSIN THE DEFAULT IS: ** 19770000 * /** RECFM = FB ** 19780000 * /** LRECL = 80 ** 19790000 * /** BLKSIZE = 80 ** 19800000 * /** FOR SYSPRINT THE DEFAULT IS: ** 19810000 * /** RECFM = FBA ** 19820000 * /** LRECL = 121 ** 19830000 * /** BLKSIZE = 121 ** 19840000 * /** FOR INPUT OR OUTPUT THE DEFAULT IS: ** 19850000 * /** RECFM = U ** 19860000 * /** LRECL = 1 ** 19870000 * /** BLKSIZE = 1 ** 19880000 * /** ** 19890000 * /** SWITCHES ARE SET UPON ENTRY TO INDICATE TYPE OF DATA SET ** 19900000 * /** SYSISW = SYSIN ** 19910000 * /** SYSPSW = SYSPRINT ** 19920000 * /** OLDNEWSW = INPUT(OLD) OR OUTPUT(NEW) ** 19930000 * /** ** 19940000 * /** AT ENTRY FROM DCB SEPERATE ENTRY POINTS ARE ENTERED FOR EACH ** 19950000 * /** TYPE OF DATA SET SO THAT DEFAULT VALUS MAY BE ASSIGNED. ** 19960000 * /** IF BLKSIZE OR LRECL IS MISSING UPON ENTRY FROM INPUT OR OUTPUT** 19970000 * /** DATA SET A SWITCH IS SET SO THAT CONTROL CARDS MAY BE FLUSHED ** 19980000 * /** TO THE NEXT END OR SLASH ASTERICK CARD.A VALUE OF ONE IS ** 19990000 * /** ASSIGNED SO THAT THE DATA SET MAY BE OPENED WITHOUT ABENDING. ** 20000000 * /** ** 20010000 * /******************************************************************* 20020000 * DCBROUT1:; 20030000 * /******************************************************************* 20040000 * /** * 20050000 * /** ENTRY FOR SYSIN DATA SET TO ASSIGN DEFAULTS * 20060000 * /******************************************************************* 20070000 * SAVE14 = R14 /* SAVE OPEN RETURN REG */; 20080000 DCBROUT1 ST @E,COMMON1+56 0705 20090000 * DCBPTR = ADDR(SYSI); 20100000 LA @F,COMMON+116 0706 20110000 ST @F,COMMON+300 0706 20120000 * DLRECL = 80 /* DEFAULT LRECL 80 */; 20130000 LA @F,80 0707 20140000 STH @F,COMMON+280 0707 20150000 * DBLKSI = 80 /* DEFAULT BLKSIZE 80 */; 20160000 STH @F,COMMON+282 0708 20170000 * DRECFM = '90'X /*DEFAULT RECFM IS FB */; 20180000 MVI COMMON+284,X'90' 0709 20190000 * SYSISW = ON /*TURN ON SYSIN SW */; 20200000 MVC COMMON2+33(1),ON 0710 20210000 * GO TO DCBEXIT /* BRANCH TO CHECK PARAMETERS */; 20220000 BC 15,DCBEXIT 0711 20230000 * /* ENTRY FROM SYSPRINT DCB */ 20240000 * /******************************************************************* 20250000 * /** * 20260000 * /** ENTRY FOR SYSPRINT DATA SET TO ASSIGN DEFAULTS * 20270000 * /** * 20280000 * /******************************************************************* 20290000 * DCBROUT2:; 20300000 * SAVE14 = R14 /* SAVE OPEN RETURN REG */; 20310000 DCBROUT2 ST @E,COMMON1+56 0713 20320000 * DCBPTR = ADDR(SYSP) /* SYSP ADDR TO DCBPTR */; 20330000 LA @F,COMMON+20 0714 20340000 ST @F,COMMON+300 0714 20350000 * DLRECL = 121 /* DEFAULT LRECL 121*/; 20360000 LA @F,121 0715 20370000 STH @F,COMMON+280 0715 20380000 * DBLKSI = 121 /*DEFAULT BLKSI 121*/; 20390000 STH @F,COMMON+282 0716 20400000 * DRECFM = '94'X /* DEFAULT RECFM IS FB ASA */; 20410000 MVI COMMON+284,X'94' 0717 20420000 * SYSPSW = ON /* TURN ON SYSPRINT SW */; 20430000 MVC COMMON2+34(1),ON 0718 20440000 * GO TO DCBEXIT /* BRANCH TO CHECK PARAMETERS */; 20450000 BC 15,DCBEXIT 0719 20460000 * /*ENTRY FROM OLDNEW DS */ 20470000 * /******************************************************************* 20480000 * /** * 20490000 * /** ENTRY FOR USER INPUT OR OUTPUT DATA SET TO ASSIGN DEFAULTS. * 20500000 * /** * 20510000 * /******************************************************************* 20520000 * DCBROUT3:; 20530000 * SAVE14 = R14 /* SAVE OPEN RETURN REG */; 20540000 DCBROUT3 ST @E,COMMON1+56 0721 20550000 * IF DSDOSW = ON THEN DO /*DROP THRU IF OUTPUT DCB*/; 20560000 CLC COMMON2+38(1),ON 0722 20570000 BC 07,@9CD 0722 20580000 * DCBPTR = CURRGMO /* PICK UP OUTPUT DCB ADDRESS*/; 20590000 MVC COMMON+300(4),COMMON1+80 0724 20600000 * GO TO DCBROUT4 /* BR TO CONTINUE PROC */; 20610000 BC 15,DCBROUT4 0725 20620000 * END; 20630000 * DCBPTR = CURRGMI /*PICK UP INPUT DCB ADDRESS*/; 20640000 @9CD MVC COMMON+300(4),COMMON1+92 0727 20650000 * DCBROUT4:; 20660000 * DLRECL = 1 /*DEFAULT LRECL IS ONE*/; 20670000 DCBROUT4 LA @F,1 0729 20680000 STH @F,COMMON+280 0729 20690000 * DBLKSI = 1 /* DEFAULT BLKSIZE IS ONE */; 20700000 STH @F,COMMON+282 0730 20710000 * DRECFM = 'C0'X /* DEFAULT RECFM IS U */; 20720000 MVI COMMON+284,X'C0' 0731 20730000 * OLDNEWSW = ON /* TURN ON SWITCH */; 20740000 MVC COMMON2+35(1),ON 0732 20750000 * /******************************************************************* 20760000 * /** * 20770000 * /** LOOK FOR BLOCKSIZE AND SET DEFAULT IF MISSING. * 20780000 * /******************************************************************* 20790000 * DCBEXIT:; 20800000 * /* DCB POINTER WAS INITILIZED AT OPEN TIME */ 20810000 * /* IF BLOCKSIZE IS EQUAL TO ZERO ASSIGN DEFAULT*/ 20820000 * IF BLKSI ^= 0 THEN GO TO DCBEXIT1; 20830000 DCBEXIT SR @F,@F 0734 20840000 L @2,COMMON+300 COMMON 0734 20850000 CH @F,62(0,@2) 0734 20860000 BC 07,DCBEXIT1 0735 20870000 * /* WHEN OLDNEW WE FLUSH IF DEFAULTED */ 20880000 * IF OLDNEWSW = ON THEN DO; 20890000 CLC COMMON2+35(1),ON 0736 20900000 BC 07,@9CC 0736 20910000 * FLUSHSW = ON; 20920000 MVC COMMON2+36(1),ON 0738 20930000 * END; 20940000 * /* ASSIGN DEFAULT */ 20950000 * BLKSI = DBLKSI; 20960000 @9CC L @2,COMMON+300 COMMON 0740 20970000 MVC 62(2,@2),COMMON+282 0740 20980000 * /******************************************************************* 20990000 * /** * 21000000 * /** LOOK FOR LRECL AND SET DEFAULT IF MISSING. * 21010000 * /******************************************************************* 21020000 * DCBEXIT1:; 21030000 * /** PASS RECFM 'U', 'F', 'FS', 'V' AND /*@ZA33693* 21040000 * /** 'VB' THROUGH THIS TEST AS LRECL /*@ZA33693* 21050000 * /** IS NOT REQUIRED BY DATA MANAGEMENT /*@ZA33693* 21060000 * IF RECFM(1)='1'B /*IS RECFM 'U' OR 'F' /*@ZA33693* 21070000 * THEN IF RECFM(2)='1'B /*YES, WHICH IS IT /*@ZA33693* 21080000 DCBEXIT1 L @2,COMMON+300 COMMON 0742 21090000 TM 36(@2),B'10000000' 0742 21100000 BC 12,@9CB 0742 21110000 * THEN GOTO DCBEXIT4; /*'U'. /*@ZA33693* 21120000 TM 36(@2),B'01000000' 0743 21130000 BC 01,DCBEXIT4 0744 21140000 * ELSE IF RECFM(4)='0'B /*'F', IS IT UNBLCKD /*@ZA33693* 21150000 * THEN GOTO DCBEXIT2; /*YES. /*@ZA33693* 21160000 TM 36(@2),B'00010000' 0745 21170000 BC 08,DCBEXIT2 0746 21180000 BC 15,@9CA 0748 21190000 * ELSE; /*@ZA33693* 21200000 * ELSE IF RECFM(2)='1'B /*NO, IS IT 'V' /*@ZA33693* 21210000 * THEN IF RECFM(5)='0'B /*YES, IS IT ^SPANNED/*@ZA33693* 21220000 @9CB L @2,COMMON+300 COMMON 0748 21230000 TM 36(@2),B'01000000' 0748 21240000 BC 12,@9C9 0748 21250000 * THEN GOTO DCBEXIT2; /*YES. /*@ZA33693* 21260000 TM 36(@2),B'00001000' 0749 21270000 BC 08,DCBEXIT2 0750 21280000 * 21290000 * /* IF LRECL ZERO DEFAULT */ 21300000 * IF LRECL ^= 0 THEN GO TO DCBEXIT2; 21310000 @9C9 EQU * 0751 21320000 @9CA SR @F,@F 0751 21330000 L @2,COMMON+300 COMMON 0751 21340000 CH @F,82(0,@2) 0751 21350000 BC 07,DCBEXIT2 0752 21360000 * /* FLUSH WHEN OLDNEW */ 21370000 * IF OLDNEWSW = ON THEN DO; 21380000 CLC COMMON2+35(1),ON 0753 21390000 BC 07,@9C8 0753 21400000 * FLUSHSW = ON; 21410000 MVC COMMON2+36(1),ON 0755 21420000 * END; 21430000 * /* ASSIGN DEFAULT */ 21440000 * LRECL = DLRECL; 21450000 @9C8 L @2,COMMON+300 COMMON 0757 21460000 MVC 82(2,@2),COMMON+280 0757 21470000 * /******************************************************************* 21480000 * /** * 21490000 * /** THIS SECTION TESTS FOR 'F' RECORD.IF 'F' BLOCKSIZE MUST BE AN * 21500000 * /** EVEN MULTIPLE OF LRECL.IF NOT,FLUSHING TO END CARD IS INDICATED* 21510000 * /** DEFAULTS ARE ASSIGNED SO THAT DATA SET WILL OPEN WITHOUT AN * 21520000 * /** ABEND.A BRANCH IS THEN TAKEN TO RETURN TO OPEN. * 21530000 * /******************************************************************* 21540000 * DCBEXIT2:; 21550000 * /* TEST FOR V OR U RCD */ 21560000 * IF RECFM(1) = '0'B THEN GO TO DCBEXIT3; 21570000 DCBEXIT2 L @2,COMMON+300 COMMON 0759 21580000 TM 36(@2),B'10000000' 0759 21590000 BC 08,DCBEXIT3 0760 21600000 * /* TEST FOR F RCD */ 21610000 * IF RECFM(2) = '1'B THEN GO TO DCBEXIT3; 21620000 TM 36(@2),B'01000000' 0761 21630000 BC 01,DCBEXIT3 0762 21640000 * 21650000 * /* F TYPE AT THIS POINT. IF UNBLOCKED AND /*@ZA33693* 21660000 * /* LRECL=0, SKIP TEST TO AVOID DIVISION BY 0. /*@ZA33693* 21670000 * 21680000 * IF RECFM(4) ='0'B /*IS IT UNBLOCKED /*@ZA33693* 21690000 * THEN IF LRECL=0 /*YES, IS LRECL ZERO /*@ZA33693* 21700000 TM 36(@2),B'00010000' 0763 21710000 BC 05,@9C7 0763 21720000 * THEN GOTO DCBEXIT3;/*YES, SKIP TEST /*@ZA33693* 21730000 SR @F,@F 0764 21740000 CH @F,82(0,@2) 0764 21750000 BC 08,DCBEXIT3 0765 21760000 * 21770000 * /* BLOCKSIZE MUST BE AN EVEN MULTIPLE OF LRECL DIVIDE THE */ 21780000 * /* TWO THE REMAINDER IS PLACED IN LEFTOVER */ 21790000 * LEFTOVER = BLKSI // LRECL; 21800000 @9C7 L @2,COMMON+300 COMMON 0766 21810000 LH @E,62(0,@2) 0766 21820000 SRDA @E,32 0766 21830000 LH @0,82(0,@2) 0766 21840000 DR @E,@0 0766 21850000 ST @E,COMMON+288 0766 21860000 * /* LOOK FOR REMAINDER */ 21870000 * IF LEFTOVER = 0 THEN GO TO DCBEXIT4; 21880000 SR @F,@F 0767 21890000 C @F,COMMON+288 0767 21900000 BC 08,DCBEXIT4 0768 21910000 * /* THERE WAS A REMAINDER AT THIS POINT */ 21920000 * /* TURN ON FLUSH SW PLACE DEFAULT VALUES IN DCB TO */ 21930000 * /* PREVENT OPEN ABEND */ 21940000 * /* ON RETURN FROM OPEN FLUSH WILL BE CHECKED */ 21950000 * FLUSHSW = ON /* TURN ON FLUSH SW */; 21960000 MVC COMMON2+36(1),ON 0769 21970000 * BLKSI = DBLKSI /* DEFAULT BLOCKSIZE */; 21980000 MVC 62(2,@2),COMMON+282 0770 21990000 * LRECL = DLRECL /* DEFAULT LRECL */; 22000000 MVC 82(2,@2),COMMON+280 0771 22010000 * MS = 28 ; /* PRINT MSG IEB728I @ZA24161 22020000 LA @F,28 0772 22030000 STH @F,COMMON1+102 0772 22040000 * /* OZ24161 DID NOT CHANGE IEBDGMSG. /*@ZA33694* 22050000 * CONCODE = 8 ; /* SET RETURN CODE 8 @ZA24161 22060000 LA @F,8 0773 22070000 STH @F,COMMON1+2 0773 22080000 * GO TO DCBEXIT4 /* BRANCH TO RETURN */; 22090000 BC 15,DCBEXIT4 0774 22100000 * /******************************************************************* 22110000 * /** * 22120000 * /** LOOK FOR RECORD FORMAT AND SET DEFAULT IF MISSING. * 22130000 * /******************************************************************* 22140000 * DCBEXIT3:; 22150000 * /* RECORD IS U OR V AT THIS*/ 22160000 * /* POINT BUT MUST FIND IF */ 22170000 * /* NO RECFM WAS SPECIFIED */ 22180000 * /* AT THIS POINT NO RECFM WAS SPECIFIED */ 22190000 * IF RECFM(1) = '0'B THEN DO; 22200000 DCBEXIT3 L @2,COMMON+300 COMMON 0776 22210000 TM 36(@2),B'10000000' 0776 22220000 BC 05,@9C6 0776 22230000 * IF RECFM(2) ^= '0'B THEN GO TO DCBEXIT4; 22240000 TM 36(@2),B'01000000' 0778 22250000 BC 05,DCBEXIT4 0779 22260000 * /* ASSIGN DEFAULT LRECL */ 22270000 * RECFM = DRECFM; 22280000 MVC 36(1,@2),COMMON+284 0780 22290000 * /* MUST FLUSH IF OLDNEW DS */ 22300000 * /* WE CAN LIVE WITH SYSIN SYSPRINT DEFAULTS*/ 22310000 * IF OLDNEWSW ^= ON THEN GO TO DCBEXIT4; 22320000 CLC COMMON2+35(1),ON 0781 22330000 BC 07,DCBEXIT4 0782 22340000 * FLUSHSW = ON /* TURN ON FLUSH */; 22350000 MVC COMMON2+36(1),ON 0783 22360000 * END; 22370000 * DCBEXIT4:; 22380000 @9C6 EQU * 0785 22390000 * /******************************************************************* 22400000 * /** * 22410000 * /** RETURN TO OPEN HERE * 22420000 * /******************************************************************* 22430000 * RETDCB:; 22440000 DCBEXIT4 EQU * 0786 22450000 * /* DEACTIVATE DCB EXIT . IT IS NORMALLY ACTIVATED */ 22460000 * /* JUST PRIOR TO ISSUEING OPEN */ 22470000 * /* SYSI AND SYSP DCB EXITS ARE LEFT ACTIVE */ 22480000 * /* THIS IS FOR OLDNEW DATA SET */ 22490000 * EXITDCB = '00'X ; 22500000 RETDCB MVI COMMON+260,X'00' 0787 22510000 * R14 = SAVE14 ; /* RESTORE RETURN REG */ 22520000 L @E,COMMON1+56 0788 22530000 * GEN ( BR 14 ) ; 22540000 BR 14 22550000 DS 0H 22560000 * /******************************************************************* 22570000 * /** * 22580000 * /** THIS SECTION PROCESSES FOR I/O ERRORS * 22590000 * /******************************************************************* 22600000 * /* THIS IS THE SYNAD ROUTINE AND USES SYNADAF AND SYNADRLS*/ 22610000 * /* MACROS. ERROR INFORMATION IS WRITTEN ON SYSPRINT */ 22620000 * ERRORS:; 22630000 * /* ISSUE SYNADAF MACRO*/ 22640000 * GEN ( SYNADAF ACSMETH=QSAM ); 22650000 ERRORS SYNADAF ACSMETH=QSAM 22660000 DS 0H 22670000 * /* MOVE INFO TO INBUF */ 22680000 * INBUFA1 = ' IEB729I PERMANENT I/O ERROR'; /*SET MSG ID */ 22690000 MVC COMMON1+104(28),@C33 0792 22700000 MVI COMMON1+132,C' ' 0792 22710000 MVC COMMON1+133(92),COMMON1+132 0792 22720000 * GEN ( MVC INBUFA1+28(79),49(1)); 22730000 MVC INBUFA1+28(79),49(1) 22740000 DS 0H 22750000 * MS = 30 /* MESSAGE NUMBER FOR MSGMOD */; 22760000 LA @F,30 0794 22770000 STH @F,COMMON1+102 0794 22780000 * /* LINK TO MESSAGE MODULE */ 22790000 * GEN ( LINK EP=IEBDGMSG); 22800000 LINK EP=IEBDGMSG 22810000 DS 0H 22820000 * /* RELEASE BY MACRO */ 22830000 * GEN ( SYNADRLS); 22840000 SYNADRLS 22850000 DS 0H 22860000 * GO TO A2J2; /** BRANCH TO CLEANUP**/ 22870000 BC 15,A2J2 0797 22880000 * USER : ; 22890000 * /******************************************************************* 22900000 * /** THIS SEQUENCE PLACES THE CONDITION CODE INTO THE SAVE AREA * 22910000 * /** AT THE SPOT THAT REG 15 WILL BE LOADED FROM BY THE RETURN * 22920000 * /** MECHANISM.THIS PASSES THE RETURN CODE BACK TO THE USER THROUGH * 22930000 * /** REG 15 AS DEMANDED BY SYSTEM CONVENTIONS * 22940000 * /******************************************************************* 22950000 * R0 = CONCODE /** PLACE CONDITION CODE IN REG 0 **/; 22960000 USER LH @0,COMMON1+2 0799 22970000 * GEN ( L R1,4(13)); 22980000 L R1,4(13) 22990000 DS 0H 23000000 * GEN ( ST R0,16(R1)); 23010000 ST R0,16(R1) 23020000 DS 0H 23030000 * RETURN; 23040000 BC 15,@EL01 0802 23050000 * GENERATE ; /* A37883* 23060000 GETAREA EQU 176 AREA FOR JFCB A38883 23070000 DS 0H 23080000 * GEN; 23090000 MYDCB1 DCB DDNAME=SYSIN,DSORG=PS,MACRF=GM, *23100000 EODAD=CLEANUP, *23110000 SYNAD=ERRORS, *23120000 EXLST=DCBROUT1, *23130000 EROPT=ACC, /*@ZA07394*/C23140000 LRECL=80, /*@ZA07394*/C23150000 RECFM=FB /*@ZA07394*/ 23160000 MYDCB2 DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM, *23170000 EXLST=DCBROUT2, *23180000 EROPT=ACC, /*@ZA07394*/C23190000 LRECL=121, /*@ZA07394*/C23200000 RECFM=FBA /*@ZA07394*/ 23210000 MYDCB3 DCB DDNAME=SYSUT1,DSORG=IS,MACRF=PM,EXLST=DCBROUT3 23220000 DS 0H 23230000 * END IEBDG; 23240000 @EL01 L @D,4(0,@D) 0805 23250000 LR @1,@C 0805 23260000 L @0,@SIZ001 0805 23270000 FREEMAIN R,LV=(0),A=(1) 0805 23280000 LM @E,@C,12(@D) 0805 23290000 BCR 15,@E 0805 23300000 @DATA1 EQU * 23310000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 23320000 @1 EQU 01 23330000 @2 EQU 02 23340000 @3 EQU 03 23350000 @4 EQU 04 23360000 @5 EQU 05 23370000 @6 EQU 06 23380000 @7 EQU 07 23390000 @8 EQU 08 23400000 @9 EQU 09 23410000 @A EQU 10 23420000 @B EQU 11 23430000 @C EQU 12 23440000 @D EQU 13 23450000 @E EQU 14 23460000 @F EQU 15 23470000 @D6 DC F'65535' 23480000 @D1 DC H'256' 23490000 @D2 DC H'1' 23500000 @D3 DC H'3' 23510000 @D4 DC H'8' 23520000 @D5 DC H'7' 23530000 @MVC MVC 0(1,@A),0(@E) 23540000 DS 0F 23550000 @SIZ001 DC AL1(&SPN) 23560000 DC AL3(@DATEND-@DATD) 23570000 DS 0F 23580000 @X2 DC X'F0F0F0F1' 23590000 @C7 DC C'LINECNT=' 23600000 @X9 DC X'0000000000000000' 23610000 @C18 DC C'DUMP' 23620000 @C21 DC C'OUTPUT=(' 23630000 @C33 DC C' IEB729I PERMANENT I/O ERROR' 23640000 @X6 DC X'000C' 23650000 @X8 DC X'0030' 23660000 @X10 DC X'0028' 23670000 @C15 DC C'FD' 23680000 @C16 DC C'CREATE' 23690000 @C17 DC C'REPEAT' 23700000 @C19 DC C'/*' 23710000 @X27 DC X'5000' 23720000 @C14 DC C'END' 23730000 @C22 DC C'INPUT=(' 23740000 @C29 DC C'QUANTITY=' 23750000 @C30 DC C'CREATE=' 23760000 DS 0D 23770000 @DATA EQU * 23780000 DUMMY EQU 00000000 FULLWORD INTEGER 23790000 OPTIONS EQU 00000000 256 BYTE(S) 23800000 PAGE EQU 00000000 256 BYTE(S) 23810000 DDLST EQU 00000000 256 BYTE(S) 23820000 DCBD EQU 00000000 280 BYTE(S) ON DWORD 23830000 FILL EQU DCBD+00000000 16 BYTE(S) 23840000 KEYLEN EQU DCBD+00000016 1 BYTE(S) 23850000 DEVT EQU DCBD+00000017 8 BIT(S) 23860000 FILL1 EQU DCBD+00000018 8 BYTE(S) 23870000 DSORG1 EQU DCBD+00000026 2 BYTE(S) 23880000 DSORG EQU DCBD+00000026 8 BIT(S) 23890000 FILLER EQU DCBD+00000028 8 BYTE(S) 23900000 IOBAD EQU DCBD+00000028 4 BYTE(S) 23910000 BFTEK EQU DCBD+00000032 8 BIT(S) 23920000 EODAD EQU DCBD+00000033 3 BYTE(S) 23930000 RECFM EQU DCBD+00000036 8 BIT(S) 23940000 EXLIST EQU DCBD+00000037 3 BYTE POINTER ON WORD+1 23950000 DDNAME EQU DCBD+00000040 8 BYTE(S) 23960000 DEBAD EQU DCBD+00000040 4 BYTE(S) 23970000 IFLGS EQU DCBD+00000040 8 BIT(S) 23980000 GETAD EQU DCBD+00000048 4 BYTE(S) 23990000 OFLGS EQU DCBD+00000048 8 BIT(S) 24000000 OFLGS1 EQU DCBD+00000049 1 BYTE(S) 24010000 MACRF EQU DCBD+00000050 2 BYTE(S) 24020000 FILL2 EQU DCBD+00000052 4 BYTE(S) 24030000 SYNAD EQU DCBD+00000056 4 BYTE(S) 24040000 CIND EQU DCBD+00000060 2 BYTE(S) 24050000 BLKSI EQU DCBD+00000062 HALFWORD INTEGER 24060000 FILL3 EQU DCBD+00000064 18 BYTE(S) 24070000 LRECL EQU DCBD+00000082 HALFWORD INTEGER 24080000 FILL4 EQU DCBD+00000084 172 BYTE(S) 24090000 NEXTDCB EQU DCBD+00000256 FULLWORD POINTER 24100000 DDNAME1 EQU DCBD+00000260 8 BYTE(S) 24110000 EODSW EQU DCBD+00000268 1 BYTE(S) 24120000 DCBSW1 EQU DCBD+00000269 1 BYTE(S) 24130000 DCBSW2 EQU DCBD+00000270 1 BYTE(S) 24140000 DCBSW3 EQU DCBD+00000271 8 BIT(S) 24150000 INREC EQU DCBD+00000272 FULLWORD POINTER 24160000 GMLGTH EQU DCBD+00000276 HALFWORD INTEGER 24170000 FIELDSEL EQU DCBD+00000278 1 BYTE(S) 24180000 SPARE EQU DCBD+00000279 1 BYTE(S) 24190000 R2 EQU 00000002 FULLWORD INTEGER REGISTER 24200000 R4 EQU 00000004 FULLWORD POINTER REGISTER 24210000 R5 EQU 00000005 FULLWORD POINTER REGISTER 24220000 R6 EQU 00000006 FULLWORD POINTER REGISTER 24230000 R7 EQU 00000007 FULLWORD POINTER REGISTER 24240000 R8 EQU 00000008 FULLWORD POINTER REGISTER 24250000 R9 EQU 00000009 FULLWORD POINTER REGISTER 24260000 R1 EQU 00000001 FULLWORD INTEGER REGISTER 24270000 R14 EQU 00000014 FULLWORD INTEGER REGISTER 24280000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 24290000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 24300000 ONE EQU * HALFWORD INTEGER 24310000 DC FL2'1' 24320000 TWO EQU * HALFWORD INTEGER 24330000 DC FL2'2' 24340000 THREE EQU * HALFWORD INTEGER 24350000 DC FL2'3' 24360000 FOUR EQU * HALFWORD INTEGER 24370000 DC FL2'4' 24380000 FIVE EQU * HALFWORD INTEGER 24390000 DC FL2'5' 24400000 SIX EQU * HALFWORD INTEGER 24410000 DC FL2'6' 24420000 SEVEN EQU * HALFWORD INTEGER 24430000 DC FL2'7' 24440000 EIGHT EQU * HALFWORD INTEGER 24450000 DC FL2'8' 24460000 NINE EQU * HALFWORD INTEGER 24470000 DC FL2'9' 24480000 TEN EQU * HALFWORD INTEGER 24490000 DC FL2'10' 24500000 ELEVEN EQU * HALFWORD INTEGER 24510000 DC FL2'11' 24520000 DSD EQU * 3 BYTE(S) 24530000 DC C'DSD' 24540000 CREATE EQU * 6 BYTE(S) 24550000 DC C'CREATE' 24560000 FD EQU * 2 BYTE(S) 24570000 DC C'FD' 24580000 ON EQU * 1 BYTE(S) 24590000 DC X'FF' 24600000 OFF EQU * 1 BYTE(S) 24610000 DC X'00' 24620000 MYDCB1A EQU MYDCB1+00000000 96 BYTE(S) 24630000 MYDCB2A EQU MYDCB2+00000000 96 BYTE(S) 24640000 MYDCB3A EQU MYDCB3+00000000 256 BYTE(S) 24650000 ORG @DATA+00000036 24660000 C00 EQU * HALFWORD INTEGER 24670000 DC FL2'0' 24680000 C0 EQU * 24 BIT(S) ON BYTE 24690000 DC X'000000' 24700000 ORG @DATA+00000042 24710000 C10 EQU * HALFWORD INTEGER 24720000 DC FL2'10' 24730000 C42 EQU * HALFWORD INTEGER 24740000 DC FL2'42' 24750000 C50 EQU * HALFWORD INTEGER 24760000 DC FL2'50' 24770000 C66 EQU * HALFWORD INTEGER 24780000 DC FL2'66' 24790000 INBUF EQU 00000000 80 BYTE(S) 24800000 LIST EQU 00000000 12 BYTE(S) 24810000 FDTBL EQU 00000000 40 BYTE(S) 24820000 BUFFER EQU 00000000 32767 BYTE(S) 24830000 AREA EQU 00000000 512 BYTE(S) 24840000 JFCB EQU 00000000 176 BYTE(S) ON WORD 24850000 JFILL EQU JFCB+00000000 98 BYTE(S) 24860000 DSORGD EQU JFCB+00000098 2 BYTE(S) 24870000 DSORGJ EQU JFCB+00000098 8 BIT(S) 24880000 KFILL EQU JFCB+00000100 76 BYTE(S) 24890000 ORG @DATA 24900000 DS 00000050C 24910000 @L EQU 1 24920000 @DATD DSECT 24930000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 24940000 COMMON EQU @DATD+00000072 304 BYTE(S) ON DWORD 24950000 PAGENO EQU COMMON+00000000 4 BYTE(S) 24960000 LINECT EQU COMMON+00000004 FULLWORD INTEGER 24970000 LINECTR EQU COMMON+00000008 FULLWORD INTEGER 24980000 PARM EQU COMMON+00000012 FULLWORD POINTER 24990000 REPEATNO EQU COMMON+00000016 HALFWORD INTEGER 25000000 CREATENO EQU COMMON+00000018 HALFWORD INTEGER 25010000 SYSP EQU COMMON+00000020 96 BYTE(S) 25020000 SYSI EQU COMMON+00000116 96 BYTE(S) 25030000 Q EQU COMMON+00000216 16 BYTE(S) ON DWORD 25040000 QFILL EQU COMMON+00000216 7 BYTE(S) 25050000 QSIGN EQU COMMON+00000223 8 BIT(S) 25060000 QFILL1 EQU COMMON+00000224 7 BYTE(S) 25070000 QSIGN1 EQU COMMON+00000231 8 BIT(S) 25080000 COUNTER EQU COMMON+00000232 FULLWORD POINTER 25090000 OPENLIST EQU COMMON+00000236 8 BYTE(S) 25100000 OPTBYTE1 EQU COMMON+00000236 4 BYTE(S) 25110000 OPTBYTE2 EQU COMMON+00000240 4 BYTE(S) 25120000 EXLST EQU COMMON+00000244 24 BYTE(S) ON WORD 25130000 INHDR EQU COMMON+00000244 1 BYTE(S) 25140000 INHDR1 EQU COMMON+00000245 3 BYTE POINTER ON WORD+1 25150000 OUTHDR EQU COMMON+00000248 1 BYTE(S) 25160000 OUTHDR1 EQU COMMON+00000249 3 BYTE POINTER ON WORD+1 25170000 INTRL EQU COMMON+00000252 1 BYTE(S) 25180000 INTRL1 EQU COMMON+00000253 3 BYTE POINTER ON WORD+1 25190000 OUTTRL EQU COMMON+00000256 1 BYTE(S) 25200000 OUTTRL1 EQU COMMON+00000257 3 BYTE POINTER ON WORD+1 25210000 EXITDCB EQU COMMON+00000260 1 BYTE(S) 25220000 EXITDCB1 EQU COMMON+00000261 3 BYTE POINTER ON WORD+1 25230000 TOTAL EQU COMMON+00000264 1 BYTE(S) 25240000 TOTAL1 EQU COMMON+00000265 3 BYTE POINTER ON WORD+1 25250000 EXLST1 EQU COMMON+00000268 4 BYTE(S) ON WORD 25260000 EDCB1 EQU COMMON+00000268 1 BYTE(S) 25270000 EDCB2 EQU COMMON+00000269 3 BYTE POINTER ON WORD+1 25280000 EXLST2 EQU COMMON+00000272 4 BYTE(S) ON WORD 25290000 EDCB3 EQU COMMON+00000272 1 BYTE(S) 25300000 EDCB4 EQU COMMON+00000273 3 BYTE POINTER ON WORD+1 25310000 EXLST3 EQU COMMON+00000276 4 BYTE(S) ON WORD 25320000 EDCB5 EQU COMMON+00000276 1 BYTE(S) 25330000 EDCB6 EQU COMMON+00000277 3 BYTE POINTER ON WORD+1 25340000 DLRECL EQU COMMON+00000280 HALFWORD INTEGER 25350000 DBLKSI EQU COMMON+00000282 HALFWORD INTEGER 25360000 DRECFM EQU COMMON+00000284 8 BIT(S) 25370000 LEFTOVER EQU COMMON+00000288 FULLWORD INTEGER 25380000 OFFSET EQU COMMON+00000292 FULLWORD POINTER 25390000 LPTR EQU COMMON+00000296 FULLWORD POINTER 25400000 DCBPTR EQU COMMON+00000300 FULLWORD POINTER 25410000 COMMON1 EQU @DATD+00000376 232 BYTE(S) ON WORD 25420000 SAVEMS EQU COMMON1+00000000 HALFWORD INTEGER 25430000 CONCODE EQU COMMON1+00000002 HALFWORD INTEGER 25440000 OUTREC EQU COMMON1+00000004 FULLWORD POINTER 25450000 CRTABPT EQU COMMON1+00000008 FULLWORD POINTER 25460000 CURCRTE EQU COMMON1+00000012 FULLWORD POINTER 25470000 CURCRGM EQU COMMON1+00000016 FULLWORD POINTER 25480000 CURPIC EQU COMMON1+00000020 FULLWORD POINTER 25490000 PICCTR EQU COMMON1+00000024 FULLWORD INTEGER 25500000 EXITTAB EQU COMMON1+00000028 FULLWORD POINTER 25510000 EXITGM EQU COMMON1+00000032 FULLWORD POINTER 25520000 CUREXIT EQU COMMON1+00000036 FULLWORD POINTER 25530000 DELIM EQU COMMON1+00000040 4 BYTE(S) 25540000 RECREM EQU COMMON1+00000044 FULLWORD INTEGER 25550000 CURFD EQU COMMON1+00000048 FULLWORD POINTER 25560000 CUROUT EQU COMMON1+00000052 FULLWORD POINTER 25570000 SAVE14 EQU COMMON1+00000056 FULLWORD POINTER 25580000 GETMLIST EQU COMMON1+00000060 16 BYTE(S) ON WORD 25590000 GLENGTH EQU COMMON1+00000060 FULLWORD INTEGER 25600000 ADRLIST EQU COMMON1+00000064 FULLWORD POINTER 25610000 IND EQU COMMON1+00000068 4 BYTE(S) 25620000 GCODE EQU COMMON1+00000068 1 BYTE(S) 25630000 SPOOL EQU COMMON1+00000069 1 BYTE(S) 25640000 CCODE EQU COMMON1+00000070 2 BYTE(S) 25650000 GCADDR EQU COMMON1+00000072 FULLWORD POINTER 25660000 FIRSTGMO EQU COMMON1+00000076 FULLWORD POINTER 25670000 CURRGMO EQU COMMON1+00000080 FULLWORD POINTER 25680000 LASTGMO EQU COMMON1+00000084 FULLWORD POINTER 25690000 FIRSTGMI EQU COMMON1+00000088 FULLWORD POINTER 25700000 CURRGMI EQU COMMON1+00000092 FULLWORD POINTER 25710000 LASTGMI EQU COMMON1+00000096 FULLWORD POINTER 25720000 CONDCODE EQU COMMON1+00000100 HALFWORD INTEGER 25730000 MS EQU COMMON1+00000102 HALFWORD INTEGER 25740000 INBUFA1 EQU COMMON1+00000104 121 BYTE(S) 25750000 INFILL EQU COMMON1+00000104 10 BYTE(S) 25760000 INBUFA EQU COMMON1+00000114 111 BYTE(S) 25770000 DDPTR EQU COMMON1+00000228 FULLWORD POINTER 25780000 COMMON2 EQU @DATD+00000608 72 BYTE(S) ON WORD 25790000 SWITCH EQU COMMON2+00000000 52 BYTE(S) 25800000 FDCSW EQU COMMON2+00000000 1 BYTE(S) 25810000 FDNAMESW EQU COMMON2+00000001 1 BYTE(S) 25820000 FDPCSW EQU COMMON2+00000002 1 BYTE(S) 25830000 FDFMTSW EQU COMMON2+00000003 1 BYTE(S) 25840000 FDPLSW EQU COMMON2+00000004 1 BYTE(S) 25850000 RANGESW EQU COMMON2+00000005 1 BYTE(S) 25860000 FILLSW EQU COMMON2+00000006 1 BYTE(S) 25870000 REPSW EQU COMMON2+00000007 1 BYTE(S) 25880000 INDEXSW EQU COMMON2+00000008 1 BYTE(S) 25890000 INDNMSW EQU COMMON2+00000009 1 BYTE(S) 25900000 BQUOTESW EQU COMMON2+00000010 1 BYTE(S) 25910000 PQUOTESW EQU COMMON2+00000011 1 BYTE(S) 25920000 EQUOTESW EQU COMMON2+00000012 1 BYTE(S) 25930000 FDSW EQU COMMON2+00000013 1 BYTE(S) 25940000 DSDSW EQU COMMON2+00000014 1 BYTE(S) 25950000 NOGOSW EQU COMMON2+00000015 1 BYTE(S) 25960000 CREATESW EQU COMMON2+00000016 1 BYTE(S) 25970000 DSDCSW EQU COMMON2+00000017 1 BYTE(S) 25980000 CRCSW EQU COMMON2+00000018 1 BYTE(S) 25990000 EXITSW EQU COMMON2+00000019 1 BYTE(S) 26000000 EODSTOP EQU COMMON2+00000020 1 BYTE(S) 26010000 DSDNULSW EQU COMMON2+00000021 1 BYTE(S) 26020000 DSDORGSW EQU COMMON2+00000022 1 BYTE(S) 26030000 DSDDDSW EQU COMMON2+00000023 1 BYTE(S) 26040000 CRTBLK EQU COMMON2+00000024 1 BYTE(S) 26050000 NAMCSW EQU COMMON2+00000025 8 BIT(S) 26060000 PICCSW EQU COMMON2+00000026 8 BIT(S) 26070000 BUFPSW EQU COMMON2+00000027 1 BYTE(S) 26080000 ENDSW EQU COMMON2+00000028 1 BYTE(S) 26090000 COMCSW EQU COMMON2+00000029 1 BYTE(S) 26100000 FLAGSW EQU COMMON2+00000030 8 BIT(S) 26110000 PAGESW EQU COMMON2+00000031 1 BYTE(S) 26120000 EPSW EQU COMMON2+00000032 1 BYTE POINTER 26130000 SYSISW EQU COMMON2+00000033 1 BYTE(S) 26140000 SYSPSW EQU COMMON2+00000034 1 BYTE(S) 26150000 OLDNEWSW EQU COMMON2+00000035 1 BYTE(S) 26160000 FLUSHSW EQU COMMON2+00000036 1 BYTE(S) 26170000 FLUSHSW1 EQU COMMON2+00000037 1 BYTE(S) 26180000 DSDOSW EQU COMMON2+00000038 1 BYTE(S) 26190000 DSDISW EQU COMMON2+00000039 1 BYTE(S) 26200000 QUANSW EQU COMMON2+00000040 1 BYTE(S) 26210000 PARENSW EQU COMMON2+00000041 1 BYTE(S) 26220000 REPEATSW EQU COMMON2+00000042 1 BYTE(S) 26230000 FDPLGTH EQU COMMON2+00000052 HALFWORD INTEGER 26240000 SGCADDR EQU COMMON2+00000056 FULLWORD POINTER 26250000 FDPTR EQU COMMON2+00000060 FULLWORD POINTER 26260000 FDPTR1 EQU COMMON2+00000064 FULLWORD POINTER 26270000 FDPTR2 EQU COMMON2+00000068 FULLWORD POINTER 26280000 COMMON3 EQU @DATD+00000680 128 BYTE(S) ON WORD 26290000 FDCTR EQU COMMON3+00000000 HALFWORD POINTER 26300000 LREMAIN EQU COMMON3+00000004 FULLWORD POINTER 26310000 COMPCTR EQU COMMON3+00000008 FULLWORD POINTER 26320000 LMOVED EQU COMMON3+00000012 HALFWORD POINTER 26330000 U EQU COMMON3+00000016 FULLWORD POINTER 26340000 PICEND EQU COMMON3+00000020 HALFWORD POINTER 26350000 CURFDGM EQU COMMON3+00000024 FULLWORD POINTER 26360000 SWTCH EQU COMMON3+00000028 4 BYTE(S) ON WORD 26370000 SYSINSEL EQU COMMON3+00000028 1 BYTE(S) 26380000 FIRSTSW EQU COMMON3+00000029 1 BYTE(S) 26390000 FRSTSW EQU COMMON3+00000030 1 BYTE(S) 26400000 STOPSW EQU COMMON3+00000031 1 BYTE(S) 26410000 COPYVAL EQU COMMON3+00000032 HALFWORD INTEGER 26420000 COPYFD EQU COMMON3+00000036 FULLWORD POINTER 26430000 COPYFDGM EQU COMMON3+00000040 FULLWORD POINTER 26440000 NAMCTR EQU COMMON3+00000044 HALFWORD INTEGER 26450000 NAMCTR1 EQU COMMON3+00000046 HALFWORD INTEGER 26460000 INRECSZ EQU COMMON3+00000048 HALFWORD POINTER 26470000 OUTRECSZ EQU COMMON3+00000050 HALFWORD POINTER 26480000 INRECFM EQU COMMON3+00000052 1 BYTE(S) 26490000 RECOFFST EQU COMMON3+00000053 1 BYTE POINTER 26500000 OUTRECFM EQU COMMON3+00000054 1 BYTE(S) 26510000 PICBASE EQU COMMON3+00000056 FULLWORD POINTER 26520000 MESSAGE EQU COMMON3+00000060 121 BYTE(S) 26530000 DUMMY3 EQU COMMON3+00000184 FULLWORD POINTER 26540000 OPTPTR EQU @DATD+00000868 FULLWORD POINTER 26550000 PGPTR EQU @DATD+00000872 FULLWORD POINTER 26560000 BUFPTR EQU @DATD+00000876 FULLWORD POINTER 26570000 JFCBPTR EQU @DATD+00000880 FULLWORD POINTER 26580000 EXITLIST EQU @DATD+00000884 4 BYTE(S) ON WORD 26590000 HEX87 EQU EXITLIST+00000000 8 BIT(S) 26600000 PTRJFCB EQU EXITLIST+00000001 3 BYTE POINTER ON WORD+1 26610000 DS 00000888C 26620000 @TEMPS DS 0F 26630000 @TEMP4 DC F'0' 26640000 @DATEND EQU * 26650000 IEBDG CSECT , 26660000 @9FD EQU PDDNAMER 26670000 @9FC EQU PDDNAMER 26680000 @9F2 EQU LABEL1 26690000 @9F3 EQU SCAN1 26700000 @9ED EQU USER 26710000 @9D9 EQU A3C45 26720000 @9D6 EQU A2B3 26730000 @9D4 EQU A3C41 26740000 END IEBDG 26750000