*********************************************************************** 00010000 * TITLE: IEBCREAT DATA GENERATOR CREATE MODULE. * 00020000 * * 00030000 * STATUS: CHANGE LEVEL 0 * 00040000 * * 00050000 * FUNCTION - GENERATES OUTPUT RECORDS AND READS INPUT RECORDS FROM * 00060000 * INPUT DATA SETS. AFTER EACH RECORD IS WRITTEN, ALL * 00070000 * FD TABLES THAT ARE ACCESSED ARE PROCESSED TO PERFORM * 00080000 * ACTIONS, INDEXING, RANGE, AND CYCLE FUNCTIONS. * 00090000 * THIS MODULE IS ALWAYS ENTERED FROM MODULE IEBCRANL AND * 00100000 * RETURNS CONTROL TO IEBCRANL. IF ENTERED WITH THE * 00110000 * 'NOGO' SWITCH ON ALL OUTPUT GENERATION IS SUPPRESSED * 00120000 * AND ANY EXISTING CREATE, FD ADDRESS, OR PICTURE TABLES * 00130000 * ARE FREED. * 00140000 * IF AN ERROR IS FOUND CONTROL IS RETURNED TO PRINT A * 00150000 * MESSAGE, SET THE NOGO SWITCH, AND READ THE NEXT CONTROL* 00160000 * CARD TO CONTINUE SYNTAX CHECKING. * 00170000 * * 00180000 * ENTRY POINT: IEBCREAT THE CSECT NAME OF THIS MODULE. * 00190000 * LINKED TO BY MODULE IEBCRANL. - * 00200000 * * 00210000 * INPUT - 'COMMON' - WORK AREA. * 00220000 * R5 - POINTS TO 'COMMON'. * 00230000 * 'NOGO' - IF ON, SUPPRESSES ALL OUTPUT GENERATION. * 00240000 * CREATE TABLES. * 00250000 * PICTURE TABLES. * 00260000 * FD ADDRESS TABLES. * 00270000 * * 00280000 * OUTPUT - RECORDS WRITTEN ON THE OUTPUT DEVICE DEFINED BY THE * 00290000 * DD NAME SPECIFIED ON THE DSD CARD. * 00300000 * * 00310000 * EXTERNAL ROUTINES - GETMAIN MACRO. * 00320000 * GET MACRO. * 00330000 * PUT MACRO. * 00340000 * * 00350000 * EXITS - NORMAL - RETURN TO MODULE IEBCRANL. * 00360000 * ERROR - RETURN TO MODULE IEBCRANL. * 00370000 * * 00380000 * * 00390000 * TABLES/WORKAREAS * 00400000 * * 00410000 * CREATE TABLES - FIRST GETMAIN IS POINTED TO BY 'CRTABPT'. * 00420000 * * 00430000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 00440000 * ***************************** * 00450000 * * ADDRESS OF NEXT GETMAIN *---FIRST 4 BYTES OF EACH 512 BYTE * 00460000 * ***************************** GETMAIN. * 00470000 * ********************************************************* * 00480000 * 0 * ADDRESS OF NEXT CREATE * QUANTITY * * 00490000 * ********************************************************* * 00500000 * 8 * INPUT DCB ADDRESS * USER EXIT ADDRESS * * 00510000 * ********************************************************* * 00520000 * 16 * PICTURE ADDRESS * FILL * NOT USED * * 00530000 * ********************************************************* * 00540000 * 24 * FD ADDRESS TABLE * * 00550000 * ***************************** * 00560000 * ANY POINTER OF 0 MEANS NO TABLE OR LAST TABLE. * 00570000 * * 00580000 * * 00590000 * * 00600000 * PICTURE TABLE - POINTED TO BY 'PICPTR IN CREATE ENTRY. * 00610000 * GETMAIN FOR PICTURE LENGTH +6. * 00620000 * * 00630000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 00640000 * ********************************************************* * 00650000 * * START LOCATION OFFSET * LENGTH * PICTURE * * 00660000 * ********************************************************* * 00670000 * * STRING * * 00680000 * ********************************************************* * 00690000 * * 00700000 * * 00710000 * * 00720000 * FD ADDRESS TABLE - POINTED TO BY 'FDADTAB' IN CREATE ENTRY. * 00730000 * GETMAIN OF 88 BYTES. * 00740000 * * 00750000 * ***************************** * 00760000 * O * ADDRESS OF NEXT GETMAIN * * 00770000 * ***************************** * 00780000 * 4 * FD TABLE ADDRESS * * 00790000 * ***************************** * 00800000 * 8 * FD TABLE ADDRESS * * 00810000 * ***************************** * 00820000 * LAST FD TABLE ADDRESS IN GETMAIN IS FOLLOWED BY 4 BYTES OF 0'S* 00830000 * * 00840000 * * 00850000 * * 00860000 * EXIT NAME TABLE - FIRST GETMAIN IS POINTED TO BY 'EXITTAB'. * 00870000 * GETMAIN OF 72 BYTES. FREED BY MODULE IEBDG * 00880000 * WHEN AN END CARD IS READ. * 00890000 * * 00900000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 00910000 * ***************************** * 00920000 * 0 * ADDRESS OF NEXT GETMAIN * * 00930000 * ********************************************************* * 00940000 * 4 * USER EXIT ROUTINE NAME * * 00950000 * ********************************************************* * 00960000 * 12 * USER EXIT ROUTINE NAME * * 00970000 * ********************************************************* * 00980000 * LAST EXIT NAME IN GETMAIN IS FOLLOWED BY 4 BYTES OF 0'S. * 00990000 * * 01000000 * * 01010000 * * 01020000 * DCB TABLES- KEPT FOR DSD GROUP GETMAIN 272 BYTES FOR EACH UNIQUE* 01030000 * DDNAME ON CREATE CARD. INPUT DCB'S ARE CHAINED * 01040000 * TOGETHER AND POINTED TO BY 'IDCBPT'. OUTPUT DCB IS * 01050000 * POINTED TO BY 'ODCBPT'. * 01060000 * * 01070000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 01080000 * ********************************************************* * 01090000 * * DCB FOR INPUT OR OUTPUT DATA SET * * 01100000 * * 256 BYTES * * 01110000 * ********************************************************* * 01120000 * * ADDRESS OF NEXT DCB * DDNAME--- * * 01130000 * ********************************************************* * 01140000 * * ---DDNAME *EODSW * * * 01150000 * ********************************************************* * 01160000 * * 01170000 * ATTRIBUTES: REENTRANT,REUSEABLE * 01180000 * * 01190000 * NEW MODULE, RELEASE 17. DG0H 01200000 * A30011 01210000 *A507700-508000.C506400 A45152 01220000 *C187800-188300.A280100-280188 A45169 01230000 *C667000-673400 A45200 01240000 *A804300,811500,812000 YA01453 01250000 *A360010-360380,361210 YA01716 01260000 *D804600-808600,814200-816600 YA01453 01270000 *A507710-507750 YA02528 01280000 *C508800 YA02528 01290000 *A518700,523840-524320 @ZA03396 01300000 *C289200 @ZA03396 01310000 *C237000 @ZA04231 01320000 *C237000 @ZA07345 01330000 *A246700,262300-262600,381700,382110 (ORG)@XA16970,@YA18072,@ZA24201 01340000 *A905500-905700 (ORG)@XA16970,@YA18072,@ZA24201 01350000 *381920 @ZA26202 01360000 LCLA &T,&SPN 0003 01370000 .@001 ANOP 0003 01380000 IEBCREAT CSECT , 0003 01390000 ST @E,12(0,@D) 0003 01400000 STM @0,@8,20(@D) 0003 01410000 STM @A,@C,60(@D) 0003 01420000 BALR @B,0 0003 01430000 @PSTART DS 0H 0003 01440000 USING @PSTART+00000,@B 0003 01450000 L @0,@SIZ001 0003 01460000 GETMAIN R,LV=(0) 0003 01470000 LR @C,@1 0003 01480000 USING @DATD+00000,@C 0003 01490000 LM @0,@1,20(@D) 0003 01500000 XC @TEMPS(@L),@TEMPS 0003 01510000 ST @D,@SAV001+4 0003 01520000 LA @F,@SAV001 0003 01530000 ST @F,8(0,@D) 0003 01540000 LR @D,@F 0003 01550000 * SYSINEOD = OFF; 01560000 MVC 579(1,@5),OFF 0048 01570000 * /*CLEAR SYSISW SWITCH. */ 01580000 * SYSISW = OFF; 01590000 MVC 569(1,@5),OFF 0049 01600000 * /*TEST IF NOGO SWITCH IS ON.*/ 01610000 * IF NOGOSW = ON THEN GO TO A7A6; 01620000 CLC 551(1,@5),ON 0050 01630000 BC 08,A7A6 0051 01640000 * /*PUT ADR. OF SYSI DCB IN BASE PTR. 01650000 * DCBPTR = ADDR(SYSI); 01660000 LA @F,116(0,@5) 0052 01670000 ST @F,300(0,@5) 0052 01680000 * /*SAVE SYNAD OF SYSIN DCB FOR 01690000 * /* IEBDG. MUST BE RESTORED BEFORE 01700000 * /* EXITING. 01710000 * /*SAVE SYNAD ADR. IN 'PARM'. */ 01720000 * PARM = SYNAD; 01730000 L @1,300(0,@5) 0053 01740000 MVC 12(4,@5),56(@1) 0053 01750000 * /*CHANGE SYSIN EODAD FOR @ZA24201 01760000 * /*READING DATA RECORDS @ZA24201 01770000 * SAVEEOD = EODAD; /*@ZA24201 01780000 L @1,300(0,@5) 0054 01790000 MVC SAVEEOD(3),33(@1) 0054 01800000 * EODAD = ADDR(A7EOD); /*@ZA24201 01810000 LA @F,A7EOD 0055 01820000 ST @F,@TEMP4 0055 01830000 MVC 33(3,@1),@TEMP4+1 0055 01840000 * /*INITIALIZE OUTPUT DCB SYNAD. */ 01850000 * /*PUT SYNAD ADR. IN 'Q'. */ 01860000 * Q(1:4) = ADDR(A7SYNAD); 01870000 LA @F,A7SYNAD 0056 01880000 ST @F,216(0,@5) 0056 01890000 * /*MOVE SYNAD TO OUTPUT DCB. */ 01900000 * FIRSTGMO -> SYNAD(2:4) = Q(2:4); 01910000 L @1,380(0,@5) 0057 01920000 MVC 57(3,@1),217(@5) 0057 01930000 * A7A1:; 01940000 * /*INITIALIZE CREATE TABLE POINTERS. 01950000 * /*CURRENT CREATE GM = 1ST CREATE GM 01960000 * CURCRGM = CRTABPT; 01970000 A7A1 MVC 320(4,@5),312(@5) 0059 01980000 * /*CURRENT CREATE = 1ST CREATE ENTRY 01990000 * CURCRTE = CRTABPT + 4; 02000000 LA @F,4 0060 02010000 A @F,312(0,@5) 0060 02020000 ST @F,316(0,@5) 0060 02030000 * /******************************************************************** 02040000 * /** DO INITIALIZATION FOR EACH CREATE ENTRY. * 02050000 * /** R4 IS BASE REG. FOR CREATE TABLE AND MUST BE PRESERVED * 02060000 * /** ACROSS MOST OF MODULE. * 02070000 * /******************************************************************** 02080000 * A7A11:; 02090000 * /*BASE REG FOR CREATE ENTRY.*/ 02100000 * R4 = CURCRTE; 02110000 A7A11 L @4,316(0,@5) 0062 02120000 * /*CLEAR EODSTOP SWITCH. */ 02130000 * EODSTOP = OFF; 02140000 MVC 556(1,@5),OFF 0063 02150000 * /*PUT OUTPUT DCB RECFM BITS 0,1 */ 02160000 * /* ONLY IN OUTRECFM. */ 02170000 * OUTRECFM = FIRSTGMO -> RECFM & 'C0'X; 02180000 MVI 662(@5),X'C0' 0064 02190000 L @1,380(0,@5) 0064 02200000 NC 662(1,@5),36(@1) 0064 02210000 * /*IF OUTPUT RECFM IS U RECORD SIZE 02220000 * /* IS BLKSIZE. 02230000 * IF OUTRECFM = 'C0'X THEN OUTRECSZ = FIRSTGMO -> BLKSI; 02240000 CLI 662(@5),X'C0' 0065 02250000 BC 07,@9FF 0065 02260000 L @1,380(0,@5) 0066 02270000 MVC 658(2,@5),62(@1) 0066 02280000 BC 15,@9FE 0067 02290000 * /*ELSE, RECORD SIZE IS LRECL. */ 02300000 * ELSE OUTRECSZ = FIRSTGMO -> LRECL; 02310000 @9FF L @1,380(0,@5) 0067 02320000 MVC 658(2,@5),82(@1) 0067 02330000 * IF FIRSTGMO -> DSORG(1) = '1'B THEN DO ; /* I.SEQ.A45169* 02340000 @9FE L @1,380(0,@5) 0068 02350000 TM 26(@1),B'10000000' 0068 02360000 BC 12,@9FD 0068 02370000 * IF FIRSTGMO -> CIND = '0000'X THEN DO; /* RKP=0 A45169* 02380000 CLC 60(2,@1),@X3 0070 02390000 BC 07,@9FC 0070 02400000 * IF FIRSTGMO -> RECFM = '80'X THEN DO; /* F A45169* 02410000 CLI 36(@1),X'80' 0072 02420000 BC 07,@9FB 0072 02430000 * /* LRECL ONLY DATA SO ADD KEYLEN A45169* 02440000 * OUTRECSZ = OUTRECSZ + FIRSTGMO -> KEYLEN ; 02450000 SR @F,@F 0074 02460000 IC @F,16(0,@1) 0074 02470000 AH @F,658(0,@5) 0074 02480000 STH @F,658(0,@5) 0074 02490000 * END; /* END OF CHECK F UNBLK A45169* 02500000 * END; /* END OF CHECK RKP A45169* 02510000 @9FB EQU * 0076 02520000 * END; /* END OF CHECK INDEX SEQ A45169* 02530000 @9FC EQU * 0077 02540000 * /*TEST IF OUTPUT RECFM IS V. */ 02550000 * IF OUTRECFM = '40'X THEN RECOFFST = 4; 02560000 @9FD CLI 662(@5),X'40' 0078 02570000 BC 07,@9FA 0078 02580000 MVI 661(@5),4 0079 02590000 BC 15,@9F9 0080 02600000 * /*ELSE, RECORD OFFSET = 0. */ 02610000 * ELSE RECOFFST = 0; 02620000 @9FA MVI 661(@5),0 0080 02630000 * /************************************************* 02640000 * /** DO INITIALIZATION FOR AN INPUT DATA SET. * 02650000 * /** THIS SECTION INITIALIZES SWITCHES AND INPUT * 02660000 * /** DCB ADRS. IT ALSO TESTS IF THE INPUT * 02670000 * /** RECORD SIZE EXCEEDS THE OUTPUT RECORD * 02680000 * /** SIZE. * 02690000 * /************************************************* 02700000 * /*TEST IF INPUT DCB PRESENT.*/ 02710000 * IF IDCBPTR ^= 0 THEN DO; 02720000 @9F9 SR @F,@F 0081 02730000 C @F,8(0,@4) 0081 02740000 BC 08,@9F8 0081 02750000 * /*INITIALIZE INPUT DCB SYNAD. */ 02760000 * /*PUT SYNAD ADR. IN 'Q'. */ 02770000 * Q(1:4) = ADDR(A7SYNAD1); /*@ZA03396* 02780000 LA @F,A7SYNAD1 0083 02790000 ST @F,216(0,@5) 0083 02800000 * /*MOVE SYNAD TO INPUT DCB. */ 02810000 * IDCBPTR -> SYNAD(2:4) = Q(2:4); 02820000 L @1,8(0,@4) 0084 02830000 MVC 57(3,@1),217(@5) 0084 02840000 * /*PUT INPUT DCB RECFM BITS 0,1 */ 02850000 * /* ONLY IN INRECFM. */ 02860000 * INRECFM = IDCBPTR -> RECFM & 'C0'X; 02870000 MVI 660(@5),X'C0' 0085 02880000 NC 660(1,@5),36(@1) 0085 02890000 * /*IF INPUT RECFM IS U RECORD SIZE * 02900000 * /* BLKSIZE. * 02910000 * IF INRECFM = 'C0'X THEN INRECSZ = IDCBPTR -> BLKSI; 02920000 CLI 660(@5),X'C0' 0086 02930000 BC 07,@9F7 0086 02940000 MVC 656(2,@5),62(@1) 0087 02950000 BC 15,@9F6 0088 02960000 * /*ELSE, RECORD SIZE IS LRECL. */ 02970000 * ELSE INRECSZ = IDCBPTR -> LRECL; 02980000 @9F7 MVC 656(2,@5),82(@1) 0088 02990000 * /*************************************** 03000000 * /**IF QUANTITY IS 0, THEN AN INPUT DATA* 03010000 * /** SET WAS SPECIFIED. 'EODSTOP' SW. * 03020000 * /** IS USED TO STOP RECORD GENERATION * 03030000 * /** WHEN AN INPUT END-OF-DATA OCCURS. * 03040000 * /*************************************** 03050000 * /*TEST IF QUANTITY = 0. */ 03060000 * IF QUAN = 0 THEN DO; 03070000 @9F6 CLC 4(4,@4),@D1 0089 03080000 BC 07,@9F5 0089 03090000 * /*SET EODSTOP SWITCH TO STOP GENER- 03100000 * /* ATION ON INPUT EOD. 03110000 * EODSTOP = ON; 03120000 MVC 556(1,@5),ON 0091 03130000 * END; 03140000 * /*TEST IF INPUT DCB IS SYSIN. */ 03150000 * IF IDCBPTR ^= ADDR(SYSI) THEN DO; 03160000 @9F5 LA @F,116(0,@5) 0093 03170000 C @F,8(0,@4) 0093 03180000 BC 08,@9F4 0093 03190000 * /*PUT EODAD ADR IN INPUT DCB.*/ 03200000 * IDCBPTR -> EODAD = ADDR(A7EODAD); 03210000 LA @F,A7EODAD 0095 03220000 L @1,8(0,@4) 0095 03230000 ST @F,@TEMP4 0095 03240000 MVC 33(3,@1),@TEMP4+1 0095 03250000 BC 15,@9F3 0097 03260000 * END; 03270000 * /*************************************** 03280000 * /**IF THE INPUT DDNAME IS 'SYSIN', * 03290000 * /** 'SYSISW' SW. IS USED TO INDICATE * 03300000 * /** THERE ARE SYSIN DATA RECORDS AFTER * 03310000 * /** A SINGLE CREATE OR REPEAT GROUP. * 03320000 * /*************************************** 03330000 * /*TURN ON 'SYSISW' SW. */ 03340000 * ELSE SYSISW = ON; 03350000 @9F4 MVC 569(1,@5),ON 0097 03360000 * /*TEST IF INPUT RECORD EXCEEDS */ 03370000 * /* OUTPUT RECORD. */ 03380000 * IF INRECSZ > OUTRECSZ THEN DO; 03390000 @9F3 LH @F,658(0,@5) 0098 03400000 CH @F,656(0,@5) 0098 03410000 BC 10,@9F2 0098 03420000 * IF SYSISW = ON THEN DO /** DO BELOW IF SYSIN **/; 03430000 CLC 569(1,@5),ON 0100 03440000 BC 07,@9F1 0100 03450000 * IF SYSINSEL = ON THEN GO TO A7A111 /** BR NO MSG REQUIRED**/ 03460000 CLC 636(1,@5),ON 0102 03470000 BC 08,A7A111 0103 03480000 * END; 03490000 * IF IDCBPTR -> FIELDSEL = ON THEN GO TO A7A111 /**BR NO MSG**/ 03500000 @9F1 L @1,8(0,@4) 0105 03510000 CLC 278(1,@1),ON 0105 03520000 BC 08,A7A111 0106 03530000 * /*INPUT LRECL IS TOO LARGE.*/ 03540000 * MS = 17 /*SET MSG 17 */; 03550000 LA @F,17 0107 03560000 STH @F,406(0,@5) 0107 03570000 * SYSISW = OFF; 03580000 MVC 569(1,@5),OFF 0108 03590000 * FLUSHSW = ON; 03600000 MVC 572(1,@5),ON 0109 03610000 * GO TO ERROR1; 03620000 BC 15,ERROR1 0110 03630000 * END; 03640000 * END; 03650000 @9F2 EQU * 0112 03660000 * A7A111:; 03670000 @9F8 EQU * 0113 03680000 * /*INIT. NO. OF RECORDS COUNTER.*/ 03690000 * RECREM = QUAN; 03700000 A7A111 MVC 348(4,@5),4(@4) 0114 03710000 * /******************************************************************** 03720000 * /** START CONSTRUCTION OF OUTPUT RECORD. * 03730000 * /** CONTROL IS RETURNED TO THIS POINT AFTER THE PREVIOUS RECORD * 03740000 * /** IS WRITTEN AND ANY FD TABLES PROCESSED AND THERE ARE MORE * 03750000 * /** RECORDS TO BE WRITTEN. ALL FD FIELDS, CREATE PICTURE AND * 03760000 * /** INPUT RECORD, IF PRESENT, ARE CONSTRUCTED IN THE OUTPUT * 03770000 * /** BUFFER. * 03780000 * /******************************************************************** 03790000 * /************************************************* 03800000 * /** FILL OUTPUT BUFFER WITH FILL CHAR. * 03810000 * /************************************************* 03820000 * A7A12: OUTREC -> AREA(1) = FILLCH; 03830000 A7A12 L @1,308(0,@5) 0115 03840000 MVC 0(1,@1),20(@4) 0115 03850000 * /*CALL MOVEROUT TO FILL OUTPUT REC. 03860000 * /*SETUP PARAMETERS FOR MOVEROUT.*/ 03870000 * R6 = OUTREC /*FROM FIELD.*/; 03880000 L @6,308(0,@5) 0116 03890000 * R7 = OUTREC + 1 /*TO FIELD.*/; 03900000 LA @7,1 0117 03910000 A @7,308(0,@5) 0117 03920000 * R8 = OUTRECSZ - 1 /*LENGTH - 1. */; 03930000 LH @8,@D2 0118 03940000 AH @8,658(0,@5) 0118 03950000 * CALL MOVEROUT; 03960000 BAL @E,MOVEROUT 0119 03970000 * /*INITIALIZE FD FIELD LOCATION * 03980000 * /* TO 1ST BYTE OF DATA IN RECORD. * 03990000 * CUROUT = RECOFFST; 04000000 MVC 357(1,@5),661(@5) 0120 04010000 MVI 356(@5),X'00' 0120 04020000 * /*INITIALIZE PICTURE LOCATION * 04030000 * /* TO 1ST BYTE OF DATA IN RECORD. * 04040000 * PICEND = RECOFFST; 04050000 MVC 629(1,@5),661(@5) 0121 04060000 MVI 628(@5),X'00' 0121 04070000 * /*IF V RECFM INIT. LENGTH DESCRIP- 04080000 * /* TOR FIELD TO 4. 04090000 * IF OUTRECFM = '40'X THEN LLFLD = 4; 04100000 CLI 662(@5),X'40' 0122 04110000 BC 07,@9F0 0122 04120000 LA @F,4 0123 04130000 L @1,308(0,@5) 0123 04140000 STH @F,0(0,@1) 0123 04150000 * /************************************************* 04160000 * /** READ A RECORD FROM THE INPUT DATA SET. * 04170000 * /** 'SYSINEOD' SW. IS TURNED ON WHEN THE SYSIN* 04180000 * /** DELIMITER IS READ. * 04190000 * /** 'EODSW' SW. IN THE INPUT DCB TABLE IS * 04200000 * /** TURNED ON WHEN AN END-OF-DATA OCCURS ON * 04210000 * /** A NON-SYSIN DATA SET. * 04220000 * /************************************************* 04230000 * /*TEST IF INPUT DCB IS PRESENT.*/ 04240000 * IF IDCBPTR = 0 THEN GO TO A7A18; 04250000 @9F0 SR @F,@F 0124 04260000 C @F,8(0,@4) 0124 04270000 BC 08,A7A18 0125 04280000 * /*TEST IF INPUT DCB IS SYSIN. */ 04290000 * IF IDCBPTR = ADDR(SYSI) THEN DO; 04300000 LA @F,116(0,@5) 0126 04310000 C @F,8(0,@4) 0126 04320000 BC 07,@9EF 0126 04330000 * /*TEST IF EOD ON SYSIN DCB. */ 04340000 * IF SYSINEOD = ON THEN GO TO A7A15; 04350000 CLC 579(1,@5),ON 0128 04360000 BC 08,A7A15 0129 04370000 * /*GO TO ISSUE GET MACRO. */ 04380000 * GO TO A7A13; 04390000 BC 15,A7A13 0130 04400000 * END; 04410000 * /*TEST IF EOD ON INPUT DCB. */ 04420000 * IF IDCBPTR -> EODSW = ON THEN GO TO A7A15; 04430000 @9EF L @1,8(0,@4) 0132 04440000 CLC 268(1,@1),ON 0132 04450000 BC 08,A7A15 0133 04460000 * /*INPUT DCB FOR GET MACRO.*/ 04470000 * A7A13: R1 = IDCBPTR; 04480000 A7A13 L @1,8(0,@4) 0134 04490000 * /** TEST IF INPUT DCB IS SYSIN **/ 04500000 * IF IDCBPTR = ADDR(SYSI) THEN DO; 04510000 LA @F,116(0,@5) 0135 04520000 C @F,8(0,@4) 0135 04530000 BC 07,@9EE 0135 04540000 * /** TEST IF FIELD SELECTION ON SYSIN**/ 04550000 * IF SYSINSEL = ON THEN DO; 04560000 CLC 636(1,@5),ON 0137 04570000 BC 07,@9ED 0137 04580000 * /** READ SYSIN INTO INBUFA**/ 04590000 * R0 = ADDR(INBUFA); 04600000 LA @0,418(0,@5) 0139 04610000 * GO TO GETINP; 04620000 BC 15,GETINP 0140 04630000 * END; 04640000 * /**INPUT IS SYSIN WITHOUT FIELD SELECT** 04650000 * /** READ SYSIN INTO OUTREC**/ 04660000 * GO TO GETIN; 04670000 * END; 04680000 * /**TEST IF FIELD SELECT ON INPUT**/ 04690000 * IF IDCBPTR -> FIELDSEL = ON THEN DO ; 04700000 @9EE L @1,8(0,@4) 0144 04710000 CLC 278(1,@1),ON 0144 04720000 BC 07,@9EC 0144 04730000 * /**READ INPUT RECORD INTO INREC**/ 04740000 * R0 = IDCBPTR -> INREC; 04750000 L @0,272(0,@1) 0146 04760000 * GO TO GETINP; 04770000 BC 15,GETINP 0147 04780000 * END; 04790000 * /******************************************************************** 04800000 * /** INPUT IS WITHOUT FIELD SELECT AND THE INPUT RECORD CAN YA01716* 04810000 * /** BE READ INTO OUTREC, BUT IF THE INPUT WORKAREA YA01716* 04820000 * /** PREVIOUSLY HAS BEEN EXTENDED WITH A KEYFIELD THEN THE YA01716* 04830000 * /** OUTPUT WORKAREA MUST HAVE THE SAME SIZE AS THE INPUT YA01716* 04840000 * /** WORKAREA, IN THIS CASE A FREEMAIN ON THE OUTPUT WORKAREA YA01716* 04850000 * /** AND A NEW GETMAIN WITH THE SAME SIZE AS THE INPUT YA01716* 04860000 * /** WORKAREA WILL BE DONE YA01716* 04870000 * /******************************************************************** 04880000 * DCBPTR = IDCBPTR; /* REINITILIZE DCB POINTER YA01716 04890000 @9EC MVC 300(4,@5),8(@4) 0149 04900000 * R15 = GMLGTH; /* PICK UP INPUT WORKAREA LENGTH YA01716 04910000 L @1,300(0,@5) 0150 04920000 LH @F,276(0,@1) 0150 04930000 * DCBPTR = FIRSTGMO; /* REINITILIZE DCB POINTER YA01716 04940000 MVC 300(4,@5),380(@5) 0151 04950000 * /* TEST IF INPUT WORKAREA EXEEDS YA01716 04960000 * /* OUTPUT WORKAREA YA01716 04970000 * IF R15 > GMLGTH THEN DO; /*YA01716 04980000 L @1,300(0,@5) 0152 04990000 CH @F,276(0,@1) 0152 05000000 BC 12,@9EB 0152 05010000 * R7 = GMLGTH; /* PICK UP OUTPUT WORKAREA LENGHT YA01716 05020000 LH @7,276(0,@1) 0154 05030000 * R6 = ADDR(OUTREC); /* GET OUTPUT WORKAREA PTR YA01716 05040000 LA @6,308(0,@5) 0155 05050000 * R1 = ADDR(GETMLIST); /*YA01716 05060000 LA @1,364(0,@5) 0156 05070000 * /* FREEMAIN THE 'OLD' OUTPUT YA01716 05080000 * /* WORKAREA YA01716 05090000 * GEN ( FREEMAIN E,LV=(R7),A=(R6),SP=0,MF=(E,(R1))); /*YA01716 05100000 FREEMAIN E,LV=(R7),A=(R6),SP=0,MF=(E,(R1)) 05110000 DS 0H 05120000 * DCBPTR = IDCBPTR; /* REINITILIZE DCB POINTER YA01716 05130000 MVC 300(4,@5),8(@4) 0158 05140000 * R6 = GMLGTH; /* PICK UP INPUT WORKAREA LENGHT YA01716 05150000 L @1,300(0,@5) 0159 05160000 LH @6,276(0,@1) 0159 05170000 * R8 = ADDR(GCADDR); /* GET GC ADDRESS YA01716 05180000 LA @8,376(0,@5) 0160 05190000 * R1 = ADDR(GETMLIST); /*YA01716 05200000 LA @1,364(0,@5) 0161 05210000 * /* GETMAIN FOR THE 'NEW' YA01716 05220000 * /* OUTPUT WORKAREA YA01716 05230000 * GEN ( GETMAIN EC,LV=(R6),A=(R8),SP=0,MF=(E,(R1))); /*YA01716 05240000 GETMAIN EC,LV=(R6),A=(R8),SP=0,MF=(E,(R1)) 05250000 DS 0H 05260000 * IF R15 > 0 THEN DO; /* IS GETMAIN NOT SUCCESSESFUL YA01716 05270000 LTR @F,@F 0163 05280000 BC 12,@9EA 0163 05290000 * MS = 10; /*INDICATE MESSAGE YA01716 05300000 LA @F,10 0165 05310000 STH @F,406(0,@5) 0165 05320000 * SYSISW = OFF; /*YA01716 05330000 MVC 569(1,@5),OFF 0166 05340000 * FLUSHSW = ON; /*YA01716 05350000 MVC 572(1,@5),ON 0167 05360000 * GO TO ERROR1; /*YA01716 05370000 BC 15,ERROR1 0168 05380000 * END; /*YA01716 05390000 * DCBPTR = FIRSTGMO; /* REINITILIZE DCB POINTER YA01716 05400000 @9EA MVC 300(4,@5),380(@5) 0170 05410000 * GMLGTH = R6; /* SAVE LENGHT YA01716 05420000 L @1,300(0,@5) 0171 05430000 STH @6,276(0,@1) 0171 05440000 * OUTREC = GCADDR; /* INIT ADDR FOR OUTPUT WORKAREA YA01716 05450000 MVC 308(4,@5),376(@5) 0172 05460000 * END; /*YA01716 05470000 * /** SET READIN ADDRESS TO OUTREC**/ 05480000 * GETIN:; 05490000 @9EB EQU * 0174 05500000 * R1 = IDCBPTR; /*YA01716 05510000 GETIN L @1,8(0,@4) 0175 05520000 * R0 = OUTREC; 05530000 L @0,308(0,@5) 0176 05540000 * GETINP:; 05550000 * /** GET INPUT RECORD **/ 05560000 * GEN( GET (R1),(R0)); 05570000 GETINP GET (R1),(R0) 05580000 DS 0H 05590000 * /*TEST IF INPUT DCB IS SYSIN. */ 05600000 * IF IDCBPTR = ADDR(SYSI) THEN DO; 05610000 LA @F,116(0,@5) 0179 05620000 C @F,8(0,@4) 0179 05630000 BC 07,@9E9 0179 05640000 * /** TEST IF FIELD SEL ON SYSIN**/ 05650000 * IF SYSINSEL = ON THEN DO; 05660000 CLC 636(1,@5),ON 0181 05670000 BC 07,@9E8 0181 05680000 * /**TEST FOR DELIMITER IN INBUFA**/ 05690000 * IF INBUFA(1:4) ^= DELIM THEN GO TO A7A18; 05700000 CLC 418(4,@5),344(@5) 0183 05710000 BC 07,A7A18 0184 05720000 * INBUFA(1:4) = ' ' /**BLANK DELIM IN INBUFA **/; 05730000 MVC 418(4,@5),@C6 0185 05740000 * /**GO TO SET SYSIN EOD SW**/ 05750000 * GO TO A7A135; 05760000 BC 15,A7A135 0186 05770000 * END; 05780000 * /*TEST IF DELIMITER CARD WAS READ. 05790000 * IF OUTREC -> AREA(1:4) ^= DELIM THEN GO TO A7A18; 05800000 @9E8 L @1,308(0,@5) 0188 05810000 CLC 0(4,@1),344(@5) 0188 05820000 BC 07,A7A18 0189 05830000 * A7A135:; 05840000 * /*TURN ON SYSIN EOD SWITCH. */ 05850000 * SYSINEOD = ON; 05860000 A7A135 MVC 579(1,@5),ON 0191 05870000 * /*************************************** 05880000 * /**REFILL OUTPUT BUFFER WITH FILL CHAR.* 05890000 * /** BECAUSE DELIMITER WAS READ INTO * 05900000 * /** BUFFER. * 05910000 * /*************************************** 05920000 * OUTREC -> AREA(1) = FILLCH; 05930000 L @1,308(0,@5) 0192 05940000 MVC 0(1,@1),20(@4) 0192 05950000 * /*SETUP PARAMETERS FOR MOVEROUT. */ 05960000 * R6 = OUTREC /*FROM FIELD. */; 05970000 L @6,308(0,@5) 0193 05980000 * R7 = OUTREC + 1 /*TO FIELD. */; 05990000 LA @7,1 0194 06000000 A @7,308(0,@5) 0194 06010000 * R8 = OUTRECSZ - 1 /*LENGTH - 1. */; 06020000 LH @8,@D2 0195 06030000 AH @8,658(0,@5) 0195 06040000 * CALL MOVEROUT /*LINK TO MOVEROUT. */; 06050000 BAL @E,MOVEROUT 0196 06060000 * GO TO A7A15; 06070000 BC 15,A7A15 0197 06080000 * END; 06090000 * GO TO A7A18; 06100000 * /*************************************** 06110000 * /**EODAD ENRTY FOR SYSIN DCB * 06120000 * /*************************************** 06130000 * A7EOD:; /*@ZA24201 06140000 * DCBPTR -> EODSW = ON; /*@ZA26202 06150000 A7EOD L @1,300(0,@5) 0201 06160000 MVC 268(1,@1),ON 0201 06170000 * GO TO A7A135; /*@ZA24201 06180000 BC 15,A7A135 0202 06190000 * /*************************************** 06200000 * /**EODAD ENTRY FOR INPUT DCB (EXCEPT * 06210000 * /** SYSIN). * 06220000 * /*************************************** 06230000 * A7EODAD:; 06240000 * /*TURN ON EODSW IN INPUT DCB TABLE. 06250000 * IDCBPTR -> EODSW = ON; 06260000 A7EODAD L @1,8(0,@4) 0204 06270000 MVC 268(1,@1),ON 0204 06280000 * /*TEST IF EODSTOP SWITCH IS ON, IF 06290000 * /* SO TERMINATE GENERATION FOR THIS 06300000 * /* CREATE ENTRY. 06310000 * A7A15: IF EODSTOP = ON THEN GO TO A7A56; 06320000 A7A15 CLC 556(1,@5),ON 0205 06330000 BC 08,A7A56 0206 06340000 * /************************************************* 06350000 * /** PROCESS FD NAMES. * 06360000 * /** R9 IS USED AS A BASE REG. FOR THE FD TABLE* 06370000 * /** AND MUST BE PRESERVED ACROSS MOST OF * 06380000 * /** THIS SECTION. * 06390000 * /** 'CUROUT' POINTS TO THE OFFSET * 06400000 * /** IN THE RECORD WHERE THE NEXT FD FIELD * 06410000 * /** BEGINS UNLESS START LOC. WAS SPECIFIED * 06420000 * /** ON THE FD CARD. * 06430000 * /** 'FDOBUF' IN THE FD TABLE SPECIFIES THE * 06440000 * /** OFFSET IN THE RECORD FOR FD START LOC. * 06450000 * /** (EXCLUDING THE LENGTH DESCRIPTOR IF * 06460000 * /** V RECFM). * 06470000 * /************************************************* 06480000 * /*TEST IF ANY FD ADRS. FOR THIS */ 06490000 * /* CREATE ENTRY. */ 06500000 * A7A18: IF FDADTAB = 0 THEN GO TO A7A14; 06510000 A7A18 SR @F,@F 0207 06520000 C @F,24(0,@4) 0207 06530000 BC 08,A7A14 0208 06540000 * /*POINT TO 1ST FD ADR. TABLE GM. */ 06550000 * CURFDGM = FDADTAB; 06560000 MVC 632(4,@5),24(@4) 0209 06570000 * /*POINT TO 1ST FD ADR. IN GM. */ 06580000 * A7B1: CURFD = CURFDGM + 4; 06590000 A7B1 LA @F,4 0210 06600000 A @F,632(0,@5) 0210 06610000 ST @F,352(0,@5) 0210 06620000 * /*PUT FD ADR. IN BASE PTR. */ 06630000 * A7B2: R9 = CURFD -> FDADR; 06640000 A7B2 L @1,352(0,@5) 0211 06650000 L @9,0(0,@1) 0211 06660000 * /*TEST IF FD STARTLOC SPECIFIED. */ 06670000 * IF STRTLOC1 = '1'B THEN DO; 06680000 TM 62(@9),B'10000000' 0212 06690000 BC 12,@9E7 0212 06700000 * /*UPDATE CURRENT OUTPUT LOCATION */ 06710000 * /* WITH FD STARTLOC. */ 06720000 * CUROUT = FDOBUF + RECOFFST; 06730000 SR @F,@F 0214 06740000 IC @F,661(0,@5) 0214 06750000 AH @F,40(0,@9) 0214 06760000 STH @F,356(0,@5) 0214 06770000 * END; 06780000 * /*TEST IF FD FIELD OVERFLOWS OUTPUT 06790000 * /* RECORD. 06800000 * IF CUROUT + FDLGTH > OUTRECSZ THEN DO; 06810000 @9E7 LH @F,24(0,@9) 0216 06820000 AH @F,356(0,@5) 0216 06830000 CH @F,658(0,@5) 0216 06840000 BC 12,@9E6 0216 06850000 * /*FD FIELD OVERFLOWS. */ 06860000 * /*GO TO ISSUE MSG 16. */ 06870000 * GO TO A7A16; 06880000 BC 15,A7A16 0218 06890000 * END; 06900000 * /*************************************** 06910000 * /**FILL FD FIELD WITH BLANKS. * 06920000 * /** IN CASE OF SHIFT OR TRUNCATE ACT- * 06930000 * /** IONS, ONLY A PROTION OF THE FIELD * 06940000 * /** MAY BE MOVED IN. * 06950000 * /*************************************** 06960000 * /*SETUP PARAMETERS FOR MOVEROUT 06970000 * /*PUT FD LENGTH - 1 IN R8. */ 06980000 * R8 = FDLGTH - 1; 06990000 @9E6 LH @8,@D2 0220 07000000 AH @8,24(0,@9) 0220 07010000 * /*FROM ADR. IN R6. */ 07020000 * R6 = CUROUT + OUTREC; 07030000 L @6,308(0,@5) 0221 07040000 AH @6,356(0,@5) 0221 07050000 * /*TO ADR. IN R7. */ 07060000 * R7 = CUROUT + OUTREC + 1; 07070000 LA @7,1 0222 07080000 A @7,308(0,@5) 0222 07090000 AH @7,356(0,@5) 0222 07100000 * /*MOVE A BLANK INTO 1ST CHAR. OF */ 07110000 * /* FD FIELD. */ 07120000 * R6 -> AREA(1) = ' '; 07130000 MVI 0(@6),C' ' 0223 07140000 * /*CALL MOVEROUT TO BLANK FD FIELD. 07150000 * CALL MOVEROUT; 07160000 BAL @E,MOVEROUT 0224 07170000 * /*************************************** 07180000 * /**MOVE FD FIELD TO OUTPUT RECORD. * 07190000 * /*************************************** 07200000 * /*GET LENGTH OF PATTERN TO MOVE. */ 07210000 * R8 = FDMLGTH; 07220000 LH @8,48(0,@9) 0225 07230000 * /*RESOLVE FROM ADR. */ 07240000 * R6 = FDFROMAD + FDFRINC; 07250000 LH @6,42(0,@9) 0226 07260000 AL @6,44(0,@9) 0226 07270000 * /*RESOLVE TO ADR. IN OUTPUT RECORD. 07280000 * R7 = CUROUT + OUTREC + FDTOINC; 07290000 LH @7,50(0,@9) 0227 07300000 A @7,308(0,@5) 0227 07310000 AH @7,356(0,@5) 0227 07320000 * /*CALL MOVEROUT TO MOVE FD PATTERN 07330000 * /* TO OUTPUT RECORD. 07340000 * CALL MOVEROUT; 07350000 BAL @E,MOVEROUT 0228 07360000 * /*************************************** 07370000 * /** 'PASS' BIT IN FD TABLE IS USED IN * 07380000 * /** PROCESS FD TABLES SECTION * 07390000 * /*************************************** 07400000 * /*CLEAR PASS BIT IN FD TABLE. */ 07410000 * PASS = '0'B; 07420000 NI 32(@9),B'10111111' 0229 07430000 * /*UPDATE CURRENT OUTPUT LOCATION. * 07440000 * CUROUT = CUROUT + FDLGTH; 07450000 LH @F,24(0,@9) 0230 07460000 AH @F,356(0,@5) 0230 07470000 STH @F,356(0,@5) 0230 07480000 * /*UPDATE PTR. TO NEXT FD ADR. */ 07490000 * CURFD = CURFD + 4; 07500000 LA @F,4 0231 07510000 A @F,352(0,@5) 0231 07520000 ST @F,352(0,@5) 0231 07530000 * /*TEST IF LAST FD ADR. IN GM. */ 07540000 * IF CURFD -> AREA(1:4) ^= 0 THEN GO TO A7B2; 07550000 L @1,352(0,@5) 0232 07560000 CLC 0(4,@1),@D1 0232 07570000 BC 07,A7B2 0233 07580000 * /*TEST IF ANOTHER FD ADR. GM. */ 07590000 * IF CURFDGM -> NXTFDGM = 0 THEN GO TO A7A14; 07600000 SR @F,@F 0234 07610000 L @2,632(0,@5) 0234 07620000 C @F,0(0,@2) 0234 07630000 BC 08,A7A14 0235 07640000 * /*GET ADR. OF NEXT FD ADR. GM. */ 07650000 * CURFDGM = CURFDGM -> NXTFDGM; 07660000 MVC 632(4,@5),0(@2) 0236 07670000 * /*LOOP BACK TO PROCESS MORE FD ADRS 07680000 * GO TO A7B1; 07690000 BC 15,A7B1 0237 07700000 * /************************************************* 07710000 * /** PROCESS CREATE PICTURE. * 07720000 * /** 'PICSTLOC' POINTS TO THE OFFSET IN THE * 07730000 * /** RECORD WHERE THE PICTURE BEGINS (EXCLUD- * 07740000 * /** ING THE LENGTH DESCRIPTOR IF V RECFM). * 07750000 * /************************************************* 07760000 * A7A14:; 07770000 * /*TEST IF PICTURE IS PRESENT.*/ 07780000 * IF PICPTR = 0 THEN GO TO A7A2; 07790000 A7A14 SR @F,@F 0239 07800000 C @F,16(0,@4) 0239 07810000 BC 08,A7A2 0240 07820000 * /*CALCULATE END LOC. OF PICTURE. */ 07830000 * PICEND = PICPTR -> PICSTLOC + PICPTR -> PICLGTH + RECOFFST 07840000 IC @F,661(0,@5) 0241 07850000 L @1,16(0,@4) 0241 07860000 AH @F,4(0,@1) 0241 07870000 A @F,0(0,@1) 0241 07880000 STH @F,628(0,@5) 0241 07890000 * /*TEST IF PICTURE OVERFLOWS OUTPUT 07900000 * /* RECORD. 07910000 * IF PICEND > OUTRECSZ THEN DO; 07920000 LH @F,658(0,@5) 0242 07930000 CH @F,628(0,@5) 0242 07940000 BC 10,@9E5 0242 07950000 * /*PICTURE OVERFLOWS. */ 07960000 * A7A16: MS = 16; 07970000 A7A16 LA @F,16 0244 07980000 STH @F,406(0,@5) 0244 07990000 * GO TO ERROR1; 08000000 BC 15,ERROR1 0245 08010000 * END; 08020000 * /*************************************** 08030000 * /**MOVE PICTURE STRING INTO OUTPUT * 08040000 * /** RECORD STARTING AT PICTURE START * 08050000 * /** LOCATION. * 08060000 * /*************************************** 08070000 * /*SETUP PARAMETERS FOR MOVEROUT TO 08080000 * /* MOVE PICTURE. 08090000 * R6 = PICPTR + 6 /*FROM ADDRESS.*/; 08100000 @9E5 LA @6,6 0247 08110000 A @6,16(0,@4) 0247 08120000 * /*TO ADDRESS. */ 08130000 * R7 = OUTREC + PICPTR -> PICSTLOC + RECOFFST; 08140000 SR @F,@F 0248 08150000 IC @F,661(0,@5) 0248 08160000 L @1,16(0,@4) 0248 08170000 A @F,0(0,@1) 0248 08180000 A @F,308(0,@5) 0248 08190000 LR @7,@F 0248 08200000 * R8 = PICPTR -> PICLGTH /*LENGTH. */; 08210000 LH @8,4(0,@1) 0249 08220000 * /*CALL MOVEROUT.*/ 08230000 * CALL MOVEROUT; 08240000 BAL @E,MOVEROUT 0250 08250000 * /************************************************* 08260000 * /** SETUP LENGTH DESCRIPTOR FIELD IF V RECFM . * 08270000 * /** DESCRIPTOR FIELD CONTAINS 4 UNLESS AN * 08280000 * /** INPUT RECORD WAS READ. * 08290000 * /************************************************* 08300000 * A7A2:; 08310000 * /*TEST IF V TYPE RECORDS. */ 08320000 * IF OUTRECFM = '40'X THEN DO; 08330000 A7A2 CLI 662(@5),X'40' 0252 08340000 BC 07,@9E4 0252 08350000 * /*TEST IF END LOCATION OF FD IS GT 08360000 * /* LL FIELD. 08370000 * IF CUROUT > LLFLD THEN LLFLD = CUROUT; 08380000 L @1,308(0,@5) 0254 08390000 LH @F,0(0,@1) 0254 08400000 CH @F,356(0,@5) 0254 08410000 BC 10,@9E3 0254 08420000 MVC 0(2,@1),356(@5) 0255 08430000 * /*TEST IF END LOCATION OF PICTURE * 08440000 * /* IS GT LL FIELD. 08450000 * IF PICEND > LLFLD THEN LLFLD = PICEND; 08460000 @9E3 LH @F,0(0,@1) 0256 08470000 CH @F,628(0,@5) 0256 08480000 BC 10,@9E2 0256 08490000 MVC 0(2,@1),628(@5) 0257 08500000 * /*************************************** 08510000 * /**IF LL FIELD IS 4, THEN NO INPUT * 08520000 * /** RECORD, FD FIELD, OR PICTURE IS * 08530000 * /** PRESENT. MAKE LL FIELD EQUAL TO * 08540000 * /** OUTPUT LRECL. * 08550000 * /*************************************** 08560000 * IF LLFLD = 4 THEN DO; 08570000 @9E2 LA @F,4 0258 08580000 CH @F,0(0,@1) 0258 08590000 BC 07,@9E1 0258 08600000 * /*PUT LRECL IN LL FIELD. */ 08610000 * LLFLD = FIRSTGMO -> LRECL; 08620000 L @2,380(0,@5) 0260 08630000 MVC 0(2,@1),82(@2) 0260 08640000 * END; 08650000 * /*CLEAR LAST 2 BYTES OF DESCRIPTOR 08660000 * /* FIELD. 08670000 * OUTREC -> AREA(3:4) = '0000'X; 08680000 @9E1 L @1,308(0,@5) 0262 08690000 MVC 2(2,@1),@X3 0262 08700000 * END; 08710000 * /******************************************************************** 08720000 * /** GO TO USER EXIT ROUTINE IF PRESENT. * 08730000 * /** REG. 1 CONTAINS ADR. OF OUTPUT RECORD. * 08740000 * /** USER'S ROUTINE MUST PASS BACK A RETURN CODE IN REG. 15. * 08750000 * /******************************************************************** 08760000 * /*TEST IF USER EXIT PRESENT.*/ 08770000 * IF EXITADR = 0 THEN GO TO A7A4; 08780000 @9E4 SR @F,@F 0264 08790000 C @F,12(0,@4) 0264 08800000 BC 08,A7A4 0265 08810000 * /*PASS OUTPUT RECORD TO USER IN R1. 08820000 * R1 = OUTREC; 08830000 L @1,308(0,@5) 0266 08840000 * /*SET R15 TO ADR OF EXIT ROUTINE.*/ 08850000 * R15 = EXITADR; 08860000 L @F,12(0,@4) 0267 08870000 * /*GO TO USER ROUTINE.*/ 08880000 * GEN( BALR 14,15); 08890000 BALR 14,15 08900000 DS 0H 08910000 * /************************************************* 08920000 * /** USER PASSES A RETURN CODE IN REG. 15 AS * 08930000 * /** FOLLOWS- * 08940000 * /** 0 WRITE THE RECORD. * 08950000 * /** 4 SKIP THE RECORD (COUNTS AS 1 RECORD * 08960000 * /** IN THE QUANTITY OF RECORDS TO BE * 08970000 * /** WRITTEN). * 08980000 * /** 12 END GENERATION FOR THIS DSD GROUP. * 08990000 * /** 16 END GENERATION FOR ENTIRE JOB STEP. * 09000000 * /************************************************* 09010000 * /*TEST RETURN CODE FROM USER IN 09020000 * /* REG. 15. 09030000 * R6 = R15; 09040000 LR @6,@F 0269 09050000 * IF R6 = 0 THEN GO TO A7A4; 09060000 LTR @6,@6 0270 09070000 BC 08,A7A4 0271 09080000 * IF R6 = 4 THEN GO TO A7C1; 09090000 CH @6,@D3 0272 09100000 BC 08,A7C1 0273 09110000 * IF R6 = 12 THEN DO; 09120000 CH @6,@D4 0274 09130000 BC 07,@9E0 0274 09140000 * /*SET CONDITION CODE TO 8. */ 09150000 * CONCODE = 8; 09160000 LA @F,8 0276 09170000 STH @F,306(0,@5) 0276 09180000 * /*TURN ON FLUSHSW. */ 09190000 * FLUSHSW = ON; 09200000 MVC 572(1,@5),ON 0277 09210000 * /*GO TO CREATE CLEAN UP. */ 09220000 * GO TO A7A6; 09230000 BC 15,A7A6 0278 09240000 * END; 09250000 * IF R6 = 16 THEN DO; 09260000 @9E0 CH @6,@D5 0280 09270000 BC 07,@9DF 0280 09280000 * /*SET CONDITION CODE TO 4. */ 09290000 * CONCODE = 4; 09300000 LA @F,4 0282 09310000 STH @F,306(0,@5) 0282 09320000 * /*TURN ON FLUSHSW1. */ 09330000 * FLUSHSW1 = ON; 09340000 MVC 573(1,@5),ON 0283 09350000 * /*GO TO CREATE CLEAN UP. */ 09360000 * GO TO A7A6; 09370000 BC 15,A7A6 0284 09380000 * END; 09390000 * /*USER DIDN'T RETURN A VALID RETURN 09400000 * /* CODE. 09410000 * MS = 9; 09420000 @9DF LA @F,9 0286 09430000 STH @F,406(0,@5) 0286 09440000 * GO TO ERROR1; 09450000 BC 15,ERROR1 0287 09460000 * /******************************************************************** 09470000 * /** WRITE THE OUTPUT RECORD. * 09480000 * /******************************************************************** 09490000 * A7A4:; 09500000 * /*OUTPUT DCB FOR PUT MACRO.*/ 09510000 * R1 = FIRSTGMO; 09520000 A7A4 L @1,380(0,@5) 0289 09530000 * IF OUTRECFM='C0'X THEN DO ; /* RECFM=U A45152* 09540000 CLI 662(@5),X'C0' 0290 09550000 BC 07,@9DE 0290 09560000 * R1->LRECL = CUROUT; 09570000 MVC 82(2,@1),356(@5) 0292 09580000 * IF PICEND>CUROUT THEN R1->LRECL = PICEND; 09590000 LH @F,356(0,@5) 0293 09600000 CH @F,628(0,@5) 0293 09610000 BC 10,@9DD 0293 09620000 MVC 82(2,@1),628(@5) 0294 09630000 * IF R1 -> LRECL = 0 THEN DO ; /* NO FD CARD NOR PICT A45152* 09640000 @9DD SR @F,@F 0295 09650000 CH @F,82(0,@1) 0295 09660000 BC 07,@9DC 0295 09670000 * IF IDCBPTR = 0 THEN DO; /* NO INPUT DCB @YA02528* 09680000 C @F,8(0,@4) 0297 09690000 BC 07,@9DB 0297 09700000 * R1 -> LRECL = R1 -> BLKSI; /* MAKE LRECL SAME @YA02528* 09710000 MVC 82(2,@1),62(@1) 0299 09720000 * /* AS BLKSIZE @YA02528* 09730000 * GO TO PUTOUT; /*@YA02528* 09740000 BC 15,PUTOUT 0300 09750000 * END; /*@YA02528* 09760000 * R14 = IDCBPTR ; /* INIT INPUT DCB A45152* 09770000 @9DB L @E,8(0,@4) 0302 09780000 * R1 -> LRECL = R14 -> LRECL ; /* STRAIGT COPY A45152* 09790000 MVC 82(2,@1),82(@E) 0303 09800000 * END ; /* OUTPUT REC. EQU INPUTA45152* 09810000 * END; 09820000 @9DC EQU * 0305 09830000 * PUTOUT:; /*OUTPUT AREA FOR PUT MACRO @YA02528* 09840000 @9DE EQU * 0306 09850000 * R0 = OUTREC; 09860000 PUTOUT L @0,308(0,@5) 0307 09870000 * /*WRITE OUTPUT RECORD.*/ 09880000 * GEN( PUT (R1),(R0)); 09890000 PUT (R1),(R0) 09900000 DS 0H 09910000 * /*GO TO PROCESS FD TABLES. */ 09920000 * GO TO A7C1; 09930000 BC 15,A7C1 0309 09940000 * /******************************************************************** 09950000 * /** SYNAD ENTRY FOR INPUT OR OUTPUT DCB. * 09960000 * /** THIS SECTION IS ENTERED BY THE ACCESS METHOD WHEN A * 09970000 * /** PERMANENT I/O ERROR OCCURS. SYNADAF MACRO IS ISSUED * 09980000 * /** TO GET INFORMATION ABOUT THE ERROR. THIS INFORMATION IS * 09990000 * /** PRINTED IN MESSAGE 29. * 10000000 * /******************************************************************** 10010000 * A7SYNAD:; 10020000 * /*MOVE FIRST PORTION OF MSG 29 */ 10030000 * /* INTO BUFFER. */ 10040000 * INBUFA1 = ' IEB729I PERMANENT I/O ERROR'; 10050000 A7SYNAD MVC 408(28,@5),@C8 0311 10060000 MVI 436(@5),C' ' 0311 10070000 MVC 437(92,@5),436(@5) 0311 10080000 * R1 = FIRSTGMO; /*GET OUTPUT DCB ADDRESS @ZA03396* 10090000 L @1,380(0,@5) 0312 10100000 * IF R1 -> DSORG = '80'X THEN DO /**IF ISAM USE ISAM SYNADAF ** 10110000 CLI 26(@1),X'80' 0313 10120000 BC 07,@9DA 0313 10130000 * GEN ( SYNADAF ACSMETH=QISAM); 10140000 SYNADAF ACSMETH=QISAM 10150000 DS 0H 10160000 * GO TO A7SYNAD5 /**BR TO MOVE INFO AND RLSE**/ 10170000 BC 15,A7SYNAD5 0316 10180000 * END; 10190000 * /*ISSUE SYNADAF MACRO. */ 10200000 * /*SYNADAF RETURNS AN ADDRESS OF THE 10210000 * /* DATA IN REG. 1. THE DATA TO BE 10220000 * /* PRINTED IS AT AN OFFSET OF 49. 10230000 * GEN( SYNADAF ACSMETH=QSAM ); 10240000 @9DA EQU * 0318 10250000 SYNADAF ACSMETH=QSAM 10260000 DS 0H 10270000 * GO TO A7SYNAD5; /*BR TO MOVE INFO AND RLSE @ZA03396* 10280000 BC 15,A7SYNAD5 0319 10290000 * A7SYNAD1:; /*@ZA03396* 10300000 * /*MOVE FIRST PORTION OF MSG 29 INTO BUFFER @ZA03396* 10310000 * INBUFA1 = ' IEB729I PERMANENT I/O ERROR'; /*@ZA03396* 10320000 A7SYNAD1 MVC 408(28,@5),@C8 0321 10330000 MVI 436(@5),C' ' 0321 10340000 MVC 437(92,@5),436(@5) 0321 10350000 * R1 = IDCBPTR; /*GET INPUT DCB ADDRESS @ZA03396* 10360000 L @1,8(0,@4) 0322 10370000 * /*IF ISAM USE ISAM SYNADAF @ZA03396* 10380000 * IF R1 -> DSORG = '80'X THEN DO; /*@ZA03396* 10390000 CLI 26(@1),X'80' 0323 10400000 BC 07,@9D9 0323 10410000 * GEN ( SYNADAF ACSMETH=QISAM); /*@ZA03396* 10420000 SYNADAF ACSMETH=QISAM 10430000 DS 0H 10440000 * GO TO A7SYNAD5; /*BR TO MOVE INFO AND RLSE @ZA03396* 10450000 BC 15,A7SYNAD5 0326 10460000 * END; /*@ZA03396* 10470000 * /*ISSUE SYNADAF MACRO. SYNADAF RETURNS AN ADDRESS OF THE @ZA03396* 10480000 * /*DATA IN REG1. THE DATA TO BE PRINTED IS AT OFFSET 49 @ZA03396* 10490000 * GEN ( SYNADAF ACSMETH=QSAM); /*@ZA03396* 10500000 @9D9 EQU * 0328 10510000 SYNADAF ACSMETH=QSAM 10520000 DS 0H 10530000 * A7SYNAD5:; 10540000 * /*MOVE SYNAD INFORMATION TO BUFFER. 10550000 * GEN( MVC INBUFA1+28(79,5),49(1)); 10560000 A7SYNAD5 MVC INBUFA1+28(79,5),49(1) 10570000 DS 0H 10580000 * GEN ( SYNADRLS); 10590000 SYNADRLS 10600000 DS 0H 10610000 * /*SET CONDITION CODE TO 12. */ 10620000 * CONCODE = 12; 10630000 LA @F,12 0332 10640000 STH @F,306(0,@5) 0332 10650000 * /*SET 'FLUSHSW1' TO TERMINATE STEP. 10660000 * FLUSHSW1 = ON; 10670000 MVC 573(1,@5),ON 0333 10680000 * /*SET MS=30 TO CAUSE IEBMSG TO */ 10690000 * /* PRINT MESSAGE IN 'INBUFA1'. */ 10700000 * MS = 30; 10710000 LA @F,30 0334 10720000 STH @F,406(0,@5) 0334 10730000 * /*GO TO SET AN ERROR RETURN AND */ 10740000 * /* CREATE CLEANUP. */ 10750000 * GO TO ERROR; 10760000 BC 15,ERROR 0335 10770000 * /******************************************************************** 10780000 * /** PROCESS FD TABLES. * 10790000 * /** ANY FD TABLES REFERENCED BY THE CREATE ENTRY MUST BE PRO- * 10800000 * /** CESSED FOR ACTION, INDEX, REANGE, AND CYCLE. IF A TABLE * 10810000 * /** IS REFERENCED MORE THAN ONCE, IT IS ONLY PROCESSED ONCE. * 10820000 * /** THE 'PASS' BIT IN THE FD TABLE INDICATES THIS. * 10830000 * /** REG. 9 IS USED AS A BASE REG. FOR THE FD TABLE AND MUST BE * 10840000 * /** PRESERVED ACROSS MOST OF THIS SECTION. * 10850000 * /******************************************************************** 10860000 * /*TEST IF ANY FD ADRS. FOR THIS */ 10870000 * /* CREATE ENTRY. */ 10880000 * A7C1: IF FDADTAB = 0 THEN GO TO A7A5; 10890000 A7C1 SR @F,@F 0336 10900000 C @F,24(0,@4) 0336 10910000 BC 08,A7A5 0337 10920000 * /*POINT TO 1ST FD ADR. TABLE GM. */ 10930000 * CURFDGM = FDADTAB; 10940000 MVC 632(4,@5),24(@4) 0338 10950000 * /*POINT TO 1ST FD ADR. IN GM. */ 10960000 * A7J1: CURFD = CURFDGM + 4; 10970000 A7J1 LA @F,4 0339 10980000 A @F,632(0,@5) 0339 10990000 ST @F,352(0,@5) 0339 11000000 * /*PUT FD ADR. IN BASE PTR. */ 11010000 * A7J2: R9 = CURFD -> FDADR; 11020000 A7J2 L @1,352(0,@5) 0340 11030000 L @9,0(0,@1) 0340 11040000 * /*TEST IF FD TABLE ALREADY */ 11050000 * /* PROCESSED. */ 11060000 * IF PASS = '1'B THEN GO TO A7J3; 11070000 TM 32(@9),B'01000000' 0341 11080000 BC 01,A7J3 0342 11090000 * /*TURN ON PASS BIT IN FD TABLE. */ 11100000 * PASS = '1'B; 11110000 OI 32(@9),B'01000000' 0343 11120000 * /*SAVE R4 TEMPORARILY. */ 11130000 * GCADDR = R4; 11140000 ST @4,376(0,@5) 0344 11150000 * /*TEST IF NUACTION BIT ON. */ 11160000 * IF NUACTION = '0'B THEN GO TO A7R8; 11170000 TM 32(@9),B'00000001' 0345 11180000 BC 08,A7R8 0346 11190000 * /*TEST IF RANDOM FORMAT. */ 11200000 * IF FDFORMAT = 'RA' THEN GO TO A7R6; 11210000 CLC 30(2,@9),@C9 0347 11220000 BC 08,A7R6 0348 11230000 * /************************************************* 11240000 * /** PROCESS INDEX, CYCLE, AND RANGE FUNCTIONS. * 11250000 * /************************************************* 11260000 * /*TEST IF INDEX NO. IS 0. */ 11270000 * IF FDINDNUM = 0 THEN GO TO ABCD; 11280000 SR @F,@F 0349 11290000 C @F,20(0,@9) 0349 11300000 BC 08,ABCD 0350 11310000 * /*TEST IF CYCLE IS 0. */ 11320000 * IF FDCYCLE = 0 THEN GO TO A7R1; 11330000 CH @F,26(0,@9) 0351 11340000 BC 08,A7R1 0352 11350000 * /*INCREMENT CYCLE CTR. */ 11360000 * FDCYCCNT = FDCYCCNT + 1; 11370000 LA @F,1 0353 11380000 AH @F,52(0,@9) 0353 11390000 STH @F,52(0,@9) 0353 11400000 * /*TEST IF CYCLE CTR = CYCLE VALUE. 11410000 * IF FDCYCCNT < FDCYCLE THEN GO TO ABCD; 11420000 LH @F,26(0,@9) 0354 11430000 CH @F,52(0,@9) 0354 11440000 BC 02,ABCD 0355 11450000 * /*SET CYCLE CTR TO 0. */ 11460000 * A7R1: FDCYCCNT = 0; 11470000 A7R1 SR @F,@F 0356 11480000 STH @F,52(0,@9) 0356 11490000 * /*CLEAR 'Q' TO ZEROS. */ 11500000 * Q = Q && Q; 11510000 XC 216(16,@5),216(@5) 0357 11520000 * /*************************************** 11530000 * /**CONVERT ZONED DECIMAL NO. * 11540000 * /** NO. IS PACKED INTO 'Q'. * 11550000 * /*************************************** 11560000 * /*TEST IF ZD FORMAT. */ 11570000 * IF FDFORMAT = 'ZD' THEN DO; 11580000 CLC 30(2,@9),@C10 0358 11590000 BC 07,@9D8 0358 11600000 * /*TEST IF FD LENGTH GT 15. */ 11610000 * IF FDLGTH > 15 THEN R6 = 15; 11620000 LA @F,15 0360 11630000 CH @F,24(0,@9) 0360 11640000 BC 10,@9D7 0360 11650000 LR @6,@F 0361 11660000 BC 15,@9D6 0362 11670000 * /*ELSE, SET R6 TO FD LENGTH. */ 11680000 * ELSE R6 = FDLGTH; 11690000 @9D7 LH @6,24(0,@9) 0362 11700000 * /*CALCULATE FROM ADR. */ 11710000 * R7 = FDFROMAD + FDLGTH - R6; 11720000 @9D6 LCR @7,@6 0363 11730000 LH @0,24(0,@9) 0363 11740000 ALR @7,@0 0363 11750000 AL @7,44(0,@9) 0363 11760000 * /*PACK ZD NO. INTO 'Q'. */ 11770000 * /*DECREMENT LENGTH BY 1. */ 11780000 * R6 = R6 - 1; 11790000 BCTR @6,0 0364 11800000 * GEN( EX R6,PACK ); 11810000 EX R6,PACK 11820000 DS 0H 11830000 * GO TO A7R2; 11840000 BC 15,A7R2 0366 11850000 * END; 11860000 * /*************************************** 11870000 * /**CONVERT PACKED DECIMAL NO. * 11880000 * /** NO. IS MOVED INTO 'Q'. * 11890000 * /*************************************** 11900000 * /*TEST IF PD FORMAT. */ 11910000 * IF FDFORMAT = 'PD' THEN DO; 11920000 @9D8 CLC 30(2,@9),@C11 0368 11930000 BC 07,@9D5 0368 11940000 * /*TEST IF FD LENGTH GT 8. */ 11950000 * IF FDLGTH > 8 THEN R6 = 8; 11960000 LA @F,8 0370 11970000 CH @F,24(0,@9) 0370 11980000 BC 10,@9D4 0370 11990000 LR @6,@F 0371 12000000 BC 15,@9D3 0372 12010000 * /*ELSE, SET R6 TO FD LENGTH. */ 12020000 * ELSE R6 = FDLGTH; 12030000 @9D4 LH @6,24(0,@9) 0372 12040000 * /*CALCULATE FROM ADR. */ 12050000 * R7 = FDFROMAD + FDLGTH - R6; 12060000 @9D3 LCR @7,@6 0373 12070000 LH @0,24(0,@9) 0373 12080000 ALR @7,@0 0373 12090000 AL @7,44(0,@9) 0373 12100000 * /*CALCULATE TO ADR. */ 12110000 * R8 = ADDR(Q) + 8 - R6; 12120000 LCR @F,@6 0374 12130000 AH @F,@D6 0374 12140000 LA @0,216(0,@5) 0374 12150000 AR @F,@0 0374 12160000 LR @8,@F 0374 12170000 * /*MOVE PD NO. INTO 'Q'. */ 12180000 * R8 -> AREA(1:R6) = R7 -> AREA(1:R6); 12190000 LR @E,@7 0375 12200000 LR @1,@6 0375 12210000 BCTR @1,0 0375 12220000 LR @A,@8 0375 12230000 EX @1,@MVC 0375 12240000 * GO TO A7R2; 12250000 BC 15,A7R2 0376 12260000 * END; 12270000 * /*************************************** 12280000 * /**PROCESS BINARY NO. * 12290000 * /** NO. IS MOVED INTO REG 4. * 12300000 * /*************************************** 12310000 * /*FORMAT MUST BE BI. */ 12320000 * /*TEST IF FD LENGTH GT 4. */ 12330000 * IF FDLGTH > 4 THEN R6 = 4; 12340000 @9D5 LA @F,4 0378 12350000 CH @F,24(0,@9) 0378 12360000 BC 10,@9D2 0378 12370000 LR @6,@F 0379 12380000 BC 15,@9D1 0380 12390000 * /*ELSE, SET R6 TO FD LENGTH. */ 12400000 * ELSE R6 = FDLGTH; 12410000 @9D2 LH @6,24(0,@9) 0380 12420000 * /*CALCULATE FROM ADR. */ 12430000 * R7 = FDFROMAD + FDLGTH - R6; 12440000 @9D1 LCR @7,@6 0381 12450000 LH @0,24(0,@9) 0381 12460000 ALR @7,@0 0381 12470000 AL @7,44(0,@9) 0381 12480000 * /*CALCULATE TO ADR. */ 12490000 * R8 = ADDR(Q) + 4 - R6; 12500000 LCR @F,@6 0382 12510000 AH @F,@D3 0382 12520000 LA @0,216(0,@5) 0382 12530000 AR @F,@0 0382 12540000 LR @8,@F 0382 12550000 * /*MOVE BINARY NO. INTO 'Q'. */ 12560000 * R8 -> AREA(1:R6) = R7 -> AREA(1:R6); 12570000 LR @E,@7 0383 12580000 LR @1,@6 0383 12590000 BCTR @1,0 0383 12600000 LR @A,@8 0383 12610000 EX @1,@MVC 0383 12620000 * R4 = Q(1:4); 12630000 L @4,216(0,@5) 0384 12640000 * GO TO A7R3; 12650000 BC 15,A7R3 0385 12660000 * /*************************************** 12670000 * /**IF PD OR ZD FORMAT, CONVERT PACKED * 12680000 * /** DECIMAL NO. TO BINARY. * 12690000 * /*************************************** 12700000 * /*CONVERT PACKED NO. IN 'Q' TO */ 12710000 * /*BINARY. */ 12720000 * A7R2: 12730000 * IF Q(1:8) >= '000002147483647C'X THEN 12740000 A7R2 CLC 216(8,@5),@X12 0386 12750000 BC 04,@9D0 0386 12760000 * DO; 12770000 * MESS6: 12780000 * MS = 6; 12790000 MESS6 LA @F,6 0388 12800000 STH @F,406(0,@5) 0388 12810000 * GOTO ERROR1; 12820000 BC 15,ERROR1 0389 12830000 * END; 12840000 * GEN (CVB R4,Q(R5)); 12850000 @9D0 EQU * 0391 12860000 CVB R4,Q(R5) 12870000 DS 0H 12880000 * A7R3: 12890000 * R0 = FDINDNUM; 12900000 A7R3 L @0,20(0,@9) 0392 12910000 * INDEXIT: 12920000 * R0 = R0 - 1; 12930000 INDEXIT LR @F,@0 0393 12940000 BCTR @F,0 0393 12950000 LR @0,@F 0393 12960000 * R4 = R4 + 1; 12970000 AH @4,@D7 0394 12980000 * IF R4 = BINARYMX THEN DO; 12990000 C @4,BINARYMX 0395 13000000 BC 07,@9CF 0395 13010000 * IF R0 = 0 THEN 13020000 LTR @0,@0 0397 13030000 * GOTO A7R33; 13040000 BC 08,A7R33 0398 13050000 * GOTO MESS6; 13060000 BC 15,MESS6 0399 13070000 * END; 13080000 * IF R0 = 0 THEN 13090000 @9CF LTR @0,@0 0401 13100000 * GOTO A7R33; 13110000 BC 08,A7R33 0402 13120000 * GOTO INDEXIT; 13130000 BC 15,INDEXIT 0403 13140000 * /*ADD INDEX NO. TO R4. */ 13150000 * /*************************************** 13160000 * /**AT THIS POINT REG. 4 CONTAINS THE * 13170000 * /** INDEXED BINARY NO. IT MUST NOW BE * 13180000 * /** CONVERTED BACK TO ITS ORIGINAL * 13190000 * /** FORMAT. * 13200000 * /*************************************** 13210000 * /*TEST IF RANGE VALUE IS 0. */ 13220000 * A7R33: 13230000 * IF FDRANGE = 0 THEN GO TO A7R4; 13240000 A7R33 CLC 36(4,@9),@D1 0404 13250000 BC 08,A7R4 0405 13260000 * /*TEST IF VALUE EXCEEDS RANGE. */ 13270000 * /*IF YES, DONT CHANGE VALUE IN FD * 13280000 * /* TABLE. * 13290000 * IF R4 > FDRANC THEN GO TO ABCD; 13300000 C @4,36(0,@9) 0406 13310000 BC 02,ABCD 0407 13320000 * /*TEST IF BI FORMAT. */ 13330000 * A7R4: IF FDFORMAT = 'BI' THEN DO; 13340000 A7R4 CLC 30(2,@9),@C13 0408 13350000 BC 07,@9CE 0408 13360000 * /*PUT NO. IN 'Q'. */ 13370000 * Q(1:4) = R4; 13380000 ST @4,@TEMP4 0410 13390000 MVC 216(4,@5),@TEMP4 0410 13400000 * GO TO A7R5; 13410000 BC 15,A7R5 0411 13420000 * END; 13430000 * /*CONVERT BINARY NO. TO PACKED */ 13440000 * /* DECIMAL. */ 13450000 * GEN( CVD R4,Q(R5)); 13460000 @9CE EQU * 0413 13470000 CVD R4,Q(R5) 13480000 DS 0H 13490000 * /*TEST IF PD FORMAT. */ 13500000 * IF FDFORMAT = 'PD' THEN DO; 13510000 CLC 30(2,@9),@C11 0414 13520000 BC 07,@9CD 0414 13530000 * /*MOVE PACKED NO. OR BINARY NO. */ 13540000 * /* INTO FD FIELD. */ 13550000 * A7R5: R7 -> AREA(1:R6) = R8 -> AREA(1:R6); 13560000 A7R5 LR @E,@8 0416 13570000 LR @1,@6 0416 13580000 BCTR @1,0 0416 13590000 LR @A,@7 0416 13600000 EX @1,@MVC 0416 13610000 * GO TO ABCD; 13620000 BC 15,ABCD 0417 13630000 * END; 13640000 * /*TEST IF ZD FORMAT. */ 13650000 * IF FDFORMAT = 'ZD' THEN DO; 13660000 @9CD CLC 30(2,@9),@C10 0419 13670000 BC 07,@9CC 0419 13680000 * /*SHIFT R6 LEFT 4 BITS FOR UNPACK * 13690000 * /* INSTRUCTION. * 13700000 * R6 = R6 * 16; 13710000 SLA @6,4 0421 13720000 * /*UNPACK NO. INTO FD FIELD. */ 13730000 * GEN( EX R6,UNPACK); 13740000 EX R6,UNPACK 13750000 DS 0H 13760000 * /*CALCULATE ADR. OF LO-ORDER BYTE * 13770000 * /* OF FD FIELD. * 13780000 * R4 = FDFROMAD + FDLGTH - 1; 13790000 L @4,@D8 0423 13800000 LH @0,24(0,@9) 0423 13810000 ALR @4,@0 0423 13820000 AL @4,44(0,@9) 0423 13830000 * /*OR A 'F0' INTO LO-ORDER BYTE TO * 13840000 * /* MAKE CHAR. A VALID EBCDIC NO. * 13850000 * R4 -> AREA(1) = R4 -> AREA(1) | 'F0'X; 13860000 OI 0(@4),X'F0' 0424 13870000 * GO TO ABCD; 13880000 BC 15,ABCD 0425 13890000 * END; 13900000 * PACK: GEN( PACK Q(8,R5),0(1,R7)); 13910000 @9CC EQU * 0427 13920000 PACK PACK Q(8,R5),0(1,R7) 13930000 DS 0H 13940000 * UNPACK: GEN( UNPK 0(1,R7),Q(8,R5)); 13950000 UNPACK UNPK 0(1,R7),Q(8,R5) 13960000 DS 0H 13970000 * /************************************************* 13980000 * /** PROCESS RANDOM FORMAT NO. * 13990000 * /** 'U' CONTAINS LAST RANDOM NO. * 14000000 * /************************************************* 14010000 * A7R6:; 14020000 * R6 = U ; /* PICK UP LAST RANDOM # A45200* 14030000 A7R6 L @6,624(0,@5) 0430 14040000 * GENERATE ; 14050000 LA R7,1 SET ALL FF IN R7 A45200 14060000 LCR R7,R7 FOR SUBTRACTING A45200 14070000 SRDL R6,8 SHIFT TO RETAIN A45200 14080000 SLL R6,8 CLEAN NUMBER A45200 14090000 SLR R7,R6 SUBTRACT TO NUMBER A45200 14100000 SRL R6,8 SHIFT TO GET BYTE A45200 14110000 SLDL R6,8 PLACE IN A45200 14120000 DS 0H 14130000 * R7 = 524293 ; /* INIT MULTIPLIER A45200* 14140000 L @7,@D9 0432 14150000 * GENERATE ; 14160000 MR R6,R6 MULTIPLY FOR NEW RANDOM A45200 14170000 LA R6,3201 LOAD NUMBER FOR ADD A45200 14180000 ALR R7,R6 ADD VALUE RANDOMIZING A45200 14190000 LR R6,R7 SAVE NEW VALUE A45200 14200000 SLL R7,24 SHIFT TO ADD RANDOM # A45200 14210000 ALR R7,R6 ADD TO NEW # TO AVOID A45200 14220000 SRL R6,8 PAIR/UNPAIR SEQUENCE A45200 14230000 SLDL R6,8 RESULT RANDOM A45200 14240000 DS 0H 14250000 DS 0H 14260000 * U = R6 ; /* NEW RANDOM # A45200* 14270000 ST @6,624(0,@5) 0434 14280000 * /*TEST IF FD LENGTH IS GT 4. */ 14290000 * /*IF YES, SET R6 = 4. */ 14300000 * IF FDLGTH > 4 THEN R6 = 4; 14310000 LA @F,4 0435 14320000 CH @F,24(0,@9) 0435 14330000 BC 10,@9CB 0435 14340000 LR @6,@F 0436 14350000 BC 15,@9CA 0437 14360000 * /*ELSE, R6 = FD LENGTH. */ 14370000 * ELSE R6 = FDLGTH; 14380000 @9CB LH @6,24(0,@9) 0437 14390000 * /*CALCULATE FROM ADDRESS. */ 14400000 * R7 = ADDR(U) + 4 - R6; 14410000 @9CA LCR @F,@6 0438 14420000 AH @F,@D3 0438 14430000 LA @0,624(0,@5) 0438 14440000 AR @F,@0 0438 14450000 LR @7,@F 0438 14460000 * /*CALCULATE TO ADDRESS. */ 14470000 * R8 = FDFROMAD + FDLGTH - R6; 14480000 LCR @8,@6 0439 14490000 LH @0,24(0,@9) 0439 14500000 ALR @8,@0 0439 14510000 AL @8,44(0,@9) 0439 14520000 * /*MOVE NEW RANDOM NO. INTO FD TABLE 14530000 * R8 -> AREA(1:R6) = R7 -> AREA(1:R6); 14540000 LR @E,@7 0440 14550000 LR @1,@6 0440 14560000 BCTR @1,0 0440 14570000 LR @A,@8 0440 14580000 EX @1,@MVC 0440 14590000 * /*RANDOM NO. IS PROCESSED. */ 14600000 * GO TO ABCD; 14610000 BC 15,ABCD 0441 14620000 * /************************************************* 14630000 * /** PROCESS SHIFT OR TRUNCATE ACTIONS. * 14640000 * /************************************************* 14650000 * A7R8:; 14660000 * IF FXACTION = '1'B THEN GO TO ABCD /**BR NO ACTION TO DO**/; 14670000 A7R8 TM 32(@9),B'00100000' 0443 14680000 BC 01,ABCD 0444 14690000 * IF STACTION ^= '1'B THEN GO TO ABCD1 /**BR NOT S OR T **/; 14700000 TM 32(@9),B'00000010' 0445 14710000 BC 12,ABCD1 0446 14720000 * IF FDMLGTH > 1 THEN DO; 14730000 LA @F,1 0447 14740000 CH @F,48(0,@9) 0447 14750000 BC 10,@9C9 0447 14760000 * FDMLGTH = FDMLGTH- 1 /**COUNT DOWN ON MOVE LGTH**/; 14770000 LH @F,@D2 0449 14780000 AH @F,48(0,@9) 0449 14790000 STH @F,48(0,@9) 0449 14800000 * FDFRINC = FDFRINC + FDFRINCR /**INCREASE FROM INC**/; 14810000 SR @F,@F 0450 14820000 IC @F,58(0,@9) 0450 14830000 AH @F,42(0,@9) 0450 14840000 STH @F,42(0,@9) 0450 14850000 * FDTOINC = FDTOINC + FDTOINCR /**INCREASE TO INC**/; 14860000 SR @F,@F 0451 14870000 IC @F,59(0,@9) 0451 14880000 AH @F,50(0,@9) 0451 14890000 STH @F,50(0,@9) 0451 14900000 * GO TO ABCD /** BR WE ARE DONE**/; 14910000 BC 15,ABCD 0452 14920000 * END; 14930000 * FDMLGTH = FDLGTH /**RESTORE MOVE LENGTH**/; 14940000 @9C9 MVC 48(2,@9),24(@9) 0454 14950000 * FDFRINC = 0 /**RESTORE FROM INCREMENT**/; 14960000 SR @F,@F 0455 14970000 STH @F,42(0,@9) 0455 14980000 * FDTOINC = 0 /**RESTORE TO INCREMENT**/; 14990000 STH @F,50(0,@9) 0456 15000000 * GO TO ABCD /**BR TO PROCESS**/; 15010000 BC 15,ABCD 0457 15020000 * /************************************************* 15030000 * /** PROCESS RIPPLE ACTION. * 15040000 * /************************************************* 15050000 * ABCD1:; 15060000 * IF RPACTION ^= '1'B THEN GO TO ABCD5 /**BR NOT RIPPLE**/; 15070000 ABCD1 TM 32(@9),B'00010000' 0459 15080000 BC 12,ABCD5 0460 15090000 * IF FDSLGTH > 1 THEN DO /**DO BELOW IF ANY COUNT LEFT**/; 15100000 LA @F,1 0461 15110000 CH @F,54(0,@9) 0461 15120000 BC 10,@9C8 0461 15130000 * FDSLGTH = FDSLGTH - 1 /**COUNT DOWN ON SEQUENCE**/; 15140000 LH @F,@D2 0463 15150000 AH @F,54(0,@9) 0463 15160000 STH @F,54(0,@9) 0463 15170000 * FDFRINC = FDFRINC + 1 /**INCREASE FROM INC**/; 15180000 LA @F,1 0464 15190000 AH @F,42(0,@9) 0464 15200000 STH @F,42(0,@9) 0464 15210000 * GO TO ABCD /** BRANCH TO PROCESS**/; 15220000 BC 15,ABCD 0465 15230000 * END; 15240000 * FDSLGTH = FDSLGTHR /**RESTORE SEQ LGTH COUNTER**/; 15250000 @9C8 MVC 54(2,@9),56(@9) 0467 15260000 * FDFRINC = 0 /**RESTORE FROM INCREMENT**/; 15270000 SR @F,@F 0468 15280000 STH @F,42(0,@9) 0468 15290000 * GO TO ABCD /** BRANCH TO PROCESS*/; 15300000 BC 15,ABCD 0469 15310000 * ABCD5:; 15320000 * R6 = FDFROMAD + FDFRINC /*PICKUP FROM ADDRESS. */; 15330000 ABCD5 LH @6,42(0,@9) 0471 15340000 AL @6,44(0,@9) 0471 15350000 * IF WVACTION ^= '1'B THEN GO TO ABCD2 /**DO BELOW IF WAVE**/; 15360000 TM 32(@9),B'00000100' 0472 15370000 BC 12,ABCD2 0473 15380000 * /************************************************* 15390000 * /** PROCESS WAVE ACTION. * 15400000 * /************************************************* 15410000 * /*DO BELOW IF FROMAD NOT BLANK. */ 15420000 * IF R6 -> AREA(1) = ' ' THEN DO; 15430000 CLI 0(@6),C' ' 0474 15440000 BC 07,@9C7 0474 15450000 * FDFRINC = FDFRINC + 1 /**RESOLVE NEW FROM INCREMENT**/; 15460000 LA @F,1 0476 15470000 AH @F,42(0,@9) 0476 15480000 STH @F,42(0,@9) 0476 15490000 * GO TO ABCD /** BRANCH TO PROCESS**/; 15500000 BC 15,ABCD 0477 15510000 * END; 15520000 * FDFRINC = 0 /**RESTORE FROM INCREMENT**/; 15530000 @9C7 SR @F,@F 0479 15540000 STH @F,42(0,@9) 0479 15550000 * FDMLGTH = FDLGTH /**RESTORE MOVE LENGTH**/; 15560000 MVC 48(2,@9),24(@9) 0480 15570000 * GO TO ABCD /**BRANCH FINISHED WAVEING**/; 15580000 BC 15,ABCD 0481 15590000 * ABCD2:; 15600000 * IF ROACTION ^= '1'B THEN GO TO ABCD /**BRANCH IF NOT ROLL**/; 15610000 ABCD2 TM 32(@9),B'00001000' 0483 15620000 BC 12,ABCD 0484 15630000 * /**IF USER PATTERN IS ALLOWED IN THE FUTURE THIS BRANCH**/ 15640000 * /**SHOULD GO TO TEST A USER SWITCH SET WHEN THE ACTION IS TAKEN**/ 15650000 * /** FROM CONTROL CARD DURING INITIAL SCAN**/ 15660000 * /************************************************* 15670000 * /** PROCESS ROLL ACTION. * 15680000 * /************************************************* 15690000 * IF FDFRINCR = '01'X THEN GO TO ABCD3 /**BR TO TEST LEFT BL**/ 15700000 CLI 58(@9),X'01' 0485 15710000 BC 08,ABCD3 0486 15720000 * R6 = R6 + FDLGTH - 1 /**POINT AT END OF FIELD**/; 15730000 LH @F,@D2 0487 15740000 AH @F,24(0,@9) 0487 15750000 AR @6,@F 0487 15760000 * IF R6 -> AREA(1) ^= ' ' THEN DO; 15770000 CLI 0(@6),C' ' 0488 15780000 BC 08,@9C6 0488 15790000 * FDFRINCR = '01'X /**INDICATE ROLL TO LEFT**/; 15800000 MVI 58(@9),X'01' 0490 15810000 * FDFRINC = FDFRINC + 1 /**RESOLVE FROM IINCREMENT**/; 15820000 LA @F,1 0491 15830000 AH @F,42(0,@9) 0491 15840000 STH @F,42(0,@9) 0491 15850000 * GO TO ABCD /** BRANCH TO PROCESS**/; 15860000 BC 15,ABCD 0492 15870000 * END; 15880000 * FDFRINC = FDFRINC - 1 /**RESOLVE FROM INC-ROLL TO RIGHT**/; 15890000 @9C6 LH @F,@D2 0494 15900000 AH @F,42(0,@9) 0494 15910000 STH @F,42(0,@9) 0494 15920000 * GO TO ABCD /**BRANCH TO PROCESS**/; 15930000 BC 15,ABCD 0495 15940000 * ABCD3:; 15950000 * /*BRANCH NEED TO RESTORE. */ 15960000 * IF R6 -> AREA(1) ^= ' ' THEN GO TO ABCD4; 15970000 ABCD3 CLI 0(@6),C' ' 0497 15980000 BC 07,ABCD4 0498 15990000 * FDFRINC = FDFRINC + 1 /**RESOLVE NEW FROM INCREMENT**/; 16000000 LA @F,1 0499 16010000 AH @F,42(0,@9) 0499 16020000 STH @F,42(0,@9) 0499 16030000 * GO TO ABCD /**BRANCH TO PROCESS**/; 16040000 BC 15,ABCD 0500 16050000 * ABCD4:; 16060000 * FDFRINCR = '02'X /** CHANGE INDICATOR**/; 16070000 ABCD4 MVI 58(@9),X'02' 0502 16080000 * FDFRINC = FDFRINC - 1 /**RESOLVE NEW FROM INCREMENT**/; 16090000 LH @F,@D2 0503 16100000 AH @F,42(0,@9) 0503 16110000 STH @F,42(0,@9) 0503 16120000 * GO TO ABCD /** BRANCH TO PROCESS**/; 16130000 * /************************************************* 16140000 * /** FD TABLE HAS BEEN PROCESSED. THIS SECTION * 16150000 * /** TESTS IF ANY MORE TABLES ARE TO BE PRO- * 16160000 * /** CESSED. * 16170000 * /************************************************* 16180000 * ABCD:; 16190000 * /*RESTORE REG 4. */ 16200000 * R4 = GCADDR; 16210000 ABCD L @4,376(0,@5) 0506 16220000 * /*UPDATE PTR TO NEXT FD ADR. */ 16230000 * A7J3: CURFD = CURFD + 4; 16240000 A7J3 LA @F,4 0507 16250000 A @F,352(0,@5) 0507 16260000 ST @F,352(0,@5) 0507 16270000 * /*TEST IF LAST FD ADR. IN GM. */ 16280000 * IF CURFD -> AREA(1:4) ^= 0 THEN GO TO A7J2; 16290000 L @1,352(0,@5) 0508 16300000 CLC 0(4,@1),@D1 0508 16310000 BC 07,A7J2 0509 16320000 * /*TEST IF ANOTHER FD ADR. GM. */ 16330000 * IF CURFDGM -> NXTFDGM = 0 THEN GO TO A7A5; 16340000 SR @F,@F 0510 16350000 L @2,632(0,@5) 0510 16360000 C @F,0(0,@2) 0510 16370000 BC 08,A7A5 0511 16380000 * /*GET ADR. OF NEXT FD ADR. GM. */ 16390000 * CURFDGM = CURFDGM -> NXTFDGM; 16400000 MVC 632(4,@5),0(@2) 0512 16410000 * /*LOOP BACK TO PROCESS NORE FD TABS 16420000 * GO TO A7J1; 16430000 BC 15,A7J1 0513 16440000 * /******************************************************************** 16450000 * /** CHECK NO. OF RECORDS TO GENERATE. * 16460000 * /** IF 'EODSTOP' SW. IS ON, RECORDS ARE WRITTEN UNTIL AN * 16470000 * /** END-OF DATA OCCURS. * 16480000 * /******************************************************************** 16490000 * /*TEST IF EODSTOP SWITCH IS ON. */ 16500000 * A7A5: IF EODSTOP = ON THEN GO TO A7A12; 16510000 A7A5 CLC 556(1,@5),ON 0514 16520000 BC 08,A7A12 0515 16530000 * /*DECREMENT RECORD COUNTER.*/ 16540000 * RECREM = RECREM - 1; 16550000 LH @F,@D2 0516 16560000 A @F,348(0,@5) 0516 16570000 ST @F,348(0,@5) 0516 16580000 * /*TEST IF ALL RECORDS WRITTEN FOR * 16590000 * /* THIS CREATE ENTRY. * 16600000 * IF RECREM ^= 0 THEN GO TO A7A12; 16610000 SR @F,@F 0517 16620000 C @F,348(0,@5) 0517 16630000 BC 07,A7A12 0518 16640000 * /******************************************************************** 16650000 * /** CHECK FOR ANY MORE CREATE ENTRIES. * 16660000 * /** IF THE CREATE CARD WASN'T IN A REPEAT GROUP, THEN THERE ARE * 16670000 * /** NO MORE CREATE ENTRIES. * 16680000 * /******************************************************************** 16690000 * /*TEST IF NEXT CREATE POINTER IS 0. 16700000 * A7A56: IF NXTCRTE ^= 0 THEN DO; 16710000 A7A56 SR @F,@F 0519 16720000 C @F,0(0,@4) 0519 16730000 BC 08,@9C5 0519 16740000 * /*IT'S NOT 0. POINT TO NEXT */ 16750000 * /* CREATE ENTRY. */ 16760000 * CURCRTE = NXTCRTE; 16770000 MVC 316(4,@5),0(@4) 0521 16780000 * /*GO TO PROCESS NEW CREATE ENTRY.*/ 16790000 * GO TO A7A11; 16800000 BC 15,A7A11 0522 16810000 * END; 16820000 * /*TEST IF NEXT CREATE GM POINTER*/ 16830000 * /* IS 0. */ 16840000 * IF CURCRGM -> NXTCRGM ^= 0 THEN DO; 16850000 @9C5 SR @F,@F 0524 16860000 L @1,320(0,@5) 0524 16870000 C @F,0(0,@1) 0524 16880000 BC 08,@9C4 0524 16890000 * /*IT'S NOT 0. UPDATE CURRENT CREATE 16900000 * /* GM POINTER. 16910000 * CURCRGM = CURCRGM -> NXTCRGM; 16920000 MVC 320(4,@5),0(@1) 0526 16930000 * /*UPDATE CURRENT CREATE POINTER.*/ 16940000 * CURCRTE = CURCRGM + 4; 16950000 LA @F,4 0527 16960000 A @F,320(0,@5) 0527 16970000 ST @F,316(0,@5) 0527 16980000 * /*GO TO PROCESS NEW CREATE ENTRY.*/ 16990000 * GO TO A7A11; 17000000 BC 15,A7A11 0528 17010000 * END; 17020000 * /*DECREMENT REPEATNO.*/ 17030000 * REPEATNO = REPEATNO - 1; 17040000 @9C4 LH @F,@D2 0530 17050000 AH @F,16(0,@5) 0530 17060000 STH @F,16(0,@5) 0530 17070000 * /*TEST IF REPEATNO = 0. IF NOT, * 17080000 * /* LOOP BACK TO PROCESS ALL * 17090000 * /* CREATE ENTRIES AGAIN. * 17100000 * IF REPEATNO ^= 0 THEN GO TO A7A1; /* REPEATNO NOT 0OY01163* 17110000 SR @F,@F 0531 17120000 CH @F,16(0,@5) 0531 17130000 BC 07,A7A1 0532 17140000 * /******************************************************************** 17150000 * /** CREATE CLEAN UP - ALL CREATE ENTRIES HAVE BEEN PROCESSED. * 17160000 * /** CREATE TABLES, PICTURE TABLES, & NAME TABLES MUST BE * 17170000 * /** FREED. ALSO, ANY USER EXIT ROUTINES MUST BE DELETED. * 17180000 * /******************************************************************** 17190000 * A7A6:; 17200000 * /************************************************* 17210000 * /** FLUSH SYSIN DATA RECORDS. * 17220000 * /** IF INPUT=SYSIN WAS SPECIFIED AND THE DELIM-* 17230000 * /** WASN'T READ, SYSIN MUST BE FLUSHED TO THE * 17240000 * /** NEXT CONTROL CARD. * 17250000 * /************************************************* 17260000 * /*TEST IF THERE WERE ANY CREATE */ 17270000 * /* ENTRIES WITH SYSIN INPUT DCB. */ 17280000 * IF SYSISW = OFF THEN GO TO A7A62; 17290000 A7A6 CLC 569(1,@5),OFF 0534 17300000 BC 08,A7A62 0535 17310000 * /*TEST IF WE HAD AN EOD ON SYSIN. * 17320000 * A7A61: 17330000 * IF SYSINEOD = ON THEN GO TO A7A62; 17340000 A7A61 CLC 579(1,@5),ON 0536 17350000 BC 08,A7A62 0537 17360000 * /*FLUSH AN INPUT RECORD. */ 17370000 * /*PUT SYSIN DCB ADR IN REG 1. */ 17380000 * R1 = ADDR(SYSI); 17390000 LA @1,116(0,@5) 0538 17400000 * R0 = ADDR(MESSAGE); /**ADDRESS OF FLUSH BUFFER YA01453** 17410000 LA @0,668(0,@5) 0539 17420000 * A7FLUSH:; 17430000 * /*ISSUE GET MACRO. */ 17440000 * GEN( GET (R1),(R0)); 17450000 A7FLUSH GET (R1),(R0) 17460000 DS 0H 17470000 * /*TEST IF A DELIMITER CARD WAS READ YA01453* 17480000 * IF MESSAGE(1:4)=DELIM THEN GO TO A7A62; /*YA01453* 17490000 CLC 668(4,@5),344(@5) 0542 17500000 * GO TO A7A61 /**BR NOT AT DELIM YET**/; 17510000 BC 07,A7A61 0544 17520000 * /************************************************* 17530000 * /** THIS SECTION WILL FREE TABLE SPACE. * 17540000 * /************************************************* 17550000 * /*IF 'CRTABPT' IS 0, THERE ARE NO * 17560000 * /* TABLES TO FREE. * 17570000 * A7A62: IF CRTABPT = 0 THEN GO TO A7A9; 17580000 A7A62 SR @F,@F 0545 17590000 C @F,312(0,@5) 0545 17600000 BC 08,A7A9 0546 17610000 * /*INITIALIZE POINTERS TO 1ST */ 17620000 * /* CREATE ENTRY. */ 17630000 * CURCRGM = CRTABPT; 17640000 MVC 320(4,@5),312(@5) 0547 17650000 * CURCRTE = CURCRGM + 4; 17660000 LA @F,4 0548 17670000 A @F,320(0,@5) 0548 17680000 ST @F,316(0,@5) 0548 17690000 * A7A7:; 17700000 * /*BASE REG FOR CREATE ENTRY.*/ 17710000 * R4 = CURCRTE; 17720000 A7A7 L @4,316(0,@5) 0550 17730000 * /*************************************** 17740000 * /**FREE PICTURE TABLE. * 17750000 * /*************************************** 17760000 * /*TEST IF PICTURE POINTER IS 0.*/ 17770000 * IF PICPTR ^= 0 THEN DO; 17780000 SR @F,@F 0551 17790000 C @F,16(0,@4) 0551 17800000 BC 08,@9C3 0551 17810000 * /*PUT ADR OF AREA TO FREE IN*/ 17820000 * /* FREEMAIN PARAMETER. */ 17830000 * GCADDR = PICPTR; 17840000 MVC 376(4,@5),16(@4) 0553 17850000 * /*PUT LENGTH TO FREE IN REG 3.*/ 17860000 * R3 = PICPTR -> PICLGTH + 6; 17870000 LA @F,6 0554 17880000 L @1,16(0,@4) 0554 17890000 AH @F,4(0,@1) 0554 17900000 LR @3,@F 0554 17910000 * /*POINT TO ADDRESS PARAMETER.*/ 17920000 * R2 = ADDR(GCADDR); 17930000 LA @2,376(0,@5) 0555 17940000 * /*POINT TO PARAMETER LIST.*/ 17950000 * R1 = ADDR(GETMLIST); 17960000 LA @1,364(0,@5) 0556 17970000 * /*FREE SPACE FOR PICTURE.*/ 17980000 * GEN( FREEMAIN E,LV=(R3),A=(R2),SP=0,MF=(E,(1))); 17990000 FREEMAIN E,LV=(R3),A=(R2),SP=0,MF=(E,(1)) 18000000 DS 0H 18010000 * END; 18020000 * /*************************************** 18030000 * /**FREE FD ADDRESS TABLES. * 18040000 * /*************************************** 18050000 * /*TEST IF ANY FD'S FOR THIS */ 18060000 * /* CREATE ENTRY. */ 18070000 * IF FDADTAB = 0 THEN GO TO A7A75; 18080000 @9C3 SR @F,@F 0559 18090000 C @F,24(0,@4) 0559 18100000 BC 08,A7A75 0560 18110000 * /*POINT TO 1ST FD ADR. GM. */ 18120000 * R6 = FDADTAB; 18130000 L @6,24(0,@4) 0561 18140000 * /*SAVE PTR TO NEXT FD ADR. GM. */ 18150000 * A7A73: CURFDGM = R6 -> NXTFDGM; 18160000 A7A73 MVC 632(4,@5),0(@6) 0562 18170000 * /*FREE 88 BYTE FD ADR. TABLE. */ 18180000 * R0 = 88; 18190000 LA @0,88 0563 18200000 * /*ISSUE FREEMAIN MACRO. */ 18210000 * GEN( FREEMAIN R,LV=(0),A=(6)); 18220000 FREEMAIN R,LV=(0),A=(6) 18230000 DS 0H 18240000 * /*PUT PTR TO NEXT GM IN R6. */ 18250000 * R6 = CURFDGM; 18260000 L @6,632(0,@5) 0565 18270000 * /*TEST IF PTR TO NEXT GM IS 0. */ 18280000 * IF R6 ^= 0 THEN GO TO A7A73; 18290000 LTR @6,@6 0566 18300000 BC 07,A7A73 0567 18310000 * /*TEST IF NEXT CREATE PTR IS 0.*/ 18320000 * A7A75: IF NXTCRTE ^= 0 THEN DO; 18330000 A7A75 SR @F,@F 0568 18340000 C @F,0(0,@4) 0568 18350000 BC 08,@9C2 0568 18360000 * /*POINT TO NEXT CREATE ENTRY.*/ 18370000 * CURCRTE = NXTCRTE; 18380000 MVC 316(4,@5),0(@4) 0570 18390000 * /*LOOP BACK TO PROCESS NEW CREATE * 18400000 * /* ENTRY. * 18410000 * GO TO A7A7; 18420000 BC 15,A7A7 0571 18430000 * END; 18440000 * /*TEST IF NEXT CREATE GETMAIN */ 18450000 * /* POINTER IS 0. */ 18460000 * IF CURCRGM -> NXTCRGM ^= 0 THEN DO; 18470000 @9C2 SR @F,@F 0573 18480000 L @1,320(0,@5) 0573 18490000 C @F,0(0,@1) 0573 18500000 BC 08,@9C1 0573 18510000 * /*UPDATE CURRENT CREATE GM PTR.*/ 18520000 * CURCRGM = CURCRGM -> NXTCRGM; 18530000 MVC 320(4,@5),0(@1) 0575 18540000 * /*UPDATE CURRENT CREATE ENTRY PTR.* 18550000 * CURCRTE = CURCRGM + 4; 18560000 LA @F,4 0576 18570000 A @F,320(0,@5) 0576 18580000 ST @F,316(0,@5) 0576 18590000 * /*LOOP BACK TO PROCESS NEW CREATE * 18600000 * /* ENTRY. * 18610000 * GO TO A7A7; 18620000 BC 15,A7A7 0577 18630000 * END; 18640000 * /*************************************** 18650000 * /**FREE CREATE TABLES. * 18660000 * /*************************************** 18670000 * /*INITIALIZE CURRENT CREATE GM PTR. 18680000 * CURCRGM = CRTABPT; 18690000 @9C1 MVC 320(4,@5),312(@5) 0579 18700000 * A7A8:; 18710000 * /*PUT ADR OF CREATE TABLE IN */ 18720000 * /* FREEMAIN PARAMETER LIST. */ 18730000 * GCADDR = CURCRGM; 18740000 A7A8 MVC 376(4,@5),320(@5) 0581 18750000 * /*GET ADR OF NEXT CREATE GETMAIN.*/ 18760000 * CURCRGM = CURCRGM -> NXTCRGM; 18770000 L @1,320(0,@5) 0582 18780000 MVC 320(4,@5),0(@1) 0582 18790000 * /*POINT TO ADDRESS PARAMETER.*/ 18800000 * R2 = ADDR(GCADDR); 18810000 LA @2,376(0,@5) 0583 18820000 * /*POINT TO PARAMETER LIST.*/ 18830000 * R1 = ADDR(GETMLIST); 18840000 LA @1,364(0,@5) 0584 18850000 * /*FREE CREATE TABLE SPACE.*/ 18860000 * GEN( FREEMAIN E,LV=512,A=(R2),SP=0,MF=(E,(1))); 18870000 FREEMAIN E,LV=512,A=(R2),SP=0,MF=(E,(1)) 18880000 DS 0H 18890000 * /*TEST IF NEXT GM PTR IS 0. IF NOT* 18900000 * /* LOOP BACK TO FREE NEXT GM. * 18910000 * IF CURCRGM ^= 0 THEN GO TO A7A8; 18920000 SR @F,@F 0586 18930000 C @F,320(0,@5) 0586 18940000 BC 07,A7A8 0587 18950000 * /************************************************* 18960000 * /** THIS SECTION INITIALIZES POINTERS AND SW- * 18970000 * /** ITCHES FOR INITIAL ENTRY TO MODULE * 18980000 * /** IEBCRANL. * 18990000 * /************************************************* 19000000 * /*CLEAR NAME CONTINUATION SW. */ 19010000 * A7A9: NAMCSW = '0'X; 19020000 A7A9 MVI 561(@5),X'00' 0588 19030000 * /*CLEAR PICTURE CONTINUATION SW. */ 19040000 * PICCSW = '0'X; 19050000 MVI 562(@5),X'00' 0589 19060000 * /*CLEAR CREATE SW. */ 19070000 * CREATESW = '0'X; 19080000 MVI 552(@5),X'00' 0590 19090000 * /*CLEAR REPEAT SW. */ 19100000 * REPEATSW = '0'X; 19110000 MVI 578(@5),X'00' 0591 19120000 * /*SET 'CREATENO' TO 1. */ 19130000 * CREATENO = 1; 19140000 LA @F,1 0592 19150000 STH @F,18(0,@5) 0592 19160000 * /*SET 'REPEATNO' TO 1. */ 19170000 * REPEATNO = 1; 19180000 STH @F,16(0,@5) 0593 19190000 * /*SET POINTER TO 1ST CREATE TABLE * 19200000 * /* TO 0. * 19210000 * CRTABPT = 0; 19220000 SR @F,@F 0594 19230000 ST @F,312(0,@5) 0594 19240000 * /*PUT ADR. OF SYSI DCB IN BASE PTR. 19250000 * DCBPTR = ADDR(SYSI); 19260000 LA @F,116(0,@5) 0595 19270000 ST @F,300(0,@5) 0595 19280000 * /*RESTORE SYSIN DCB SYNAD FOR IEBDG 19290000 * SYNAD = PARM; 19300000 L @1,300(0,@5) 0596 19310000 MVC 56(4,@1),12(@5) 0596 19320000 * /*RESTORE SYSIN EODAD FOR @ZA24201 19330000 * /*READING CONTROL STMT'S @ZA24201 19340000 * EODAD = SAVEEOD; /*@ZA24201 19350000 MVC 33(3,@1),SAVEEOD 0597 19360000 * /******************************************************************** 19370000 * /** NORMAL RETURN. * 19380000 * /** CONTROL IS PASSED TO IEBCRANL WHICH RETURNS TO IEBDG TO * 19390000 * /** READ THE NEXT CONTROL CARD. * 19400000 * /******************************************************************** 19410000 * /*GO TO IEBDG TO READ NEXT CONTROL* 19420000 * /* STATEMENT. * 19430000 * RETURN; 19440000 BC 15,@EL01 0598 19450000 * /******************************************************************** 19460000 * /** ERROR RETURN. * 19470000 * /** CONTROL IS PASSED TO IEBCRANL WHICH RETURNS TO IEBDG TO * 19480000 * /** PRINT A MESSAGE, SET THE 'NOGO' SW., AND READ THE NEXT * 19490000 * /** CONTROL CARD. * 19500000 * /******************************************************************** 19510000 * /*SET CONDITION CODE TO 8. */ 19520000 * ERROR1: CONCODE = 8; 19530000 ERROR1 LA @F,8 0599 19540000 STH @F,306(0,@5) 0599 19550000 * /*SET EPSW = 1 TO PRINT A MSG, SET* 19560000 * /* NOGO, & READ NEXT CARD. 19570000 * ERROR: EPSW = 1; 19580000 ERROR MVI 568(@5),1 0600 19590000 * /*GO TO CREATE CLEANUP. */ 19600000 * GO TO A7A6; 19610000 BC 15,A7A6 0601 19620000 * /******************************************************************** 19630000 * /** MOVEROUT - THIS SUBROUTINE WILL MOVE ONE AREA TO ANOTHER * 19640000 * /** REGARDLESS OF LENGTH. * 19650000 * /** ENTRY - R14 IS LINKAGE REGISTER. * 19660000 * /** R6 POINTS TO START OF FROM FIELD. * 19670000 * /** R7 POINTS TO START OF TO FIELD. * 19680000 * /** R8 CONTAINS NO. OF BYTES TO BE MOVED. * 19690000 * /** EXIT - R6 POINTS TO START OF FROM FIELD ON LAST MOVE. * 19700000 * /** R7 POINTS TO START OF TO FIELD ON LAST MOVE. * 19710000 * /** R8 DESTROYED. * 19720000 * /******************************************************************** 19730000 * MOVEROUT:; 19740000 * /*SAVE REG 14 IN COMMON AREA. */ 19750000 * SAVE14 = R14; 19760000 MOVEROUT ST @E,360(0,@5) 0603 19770000 * /*TEST IF LENGTH IS 0 IN CASE */ 19780000 * /* NOTHING SHOULD BE MOVED. */ 19790000 * IF R8 =< 0 THEN GO TO A7P2; 19800000 LTR @8,@8 0604 19810000 BC 12,A7P2 0605 19820000 * /*TEST IF LENGTH IS GT 256. IF YES, 19830000 * /* PEFORM A MOVE OF 256 BYTES. 19840000 * A7P1: IF R8 > 256 THEN DO; 19850000 A7P1 CH @8,@D10 0606 19860000 BC 12,@9C0 0606 19870000 * /*MOVE 256 BYTES.*/ 19880000 * GEN( MVC 0(256,R7),0(R6)); 19890000 MVC 0(256,R7),0(R6) 19900000 DS 0H 19910000 * /*DECREMENT LENGTH 256.*/ 19920000 * R8 = R8 - 256; 19930000 SH @8,@D10 0609 19940000 * /*INCREMENT FROM POINTER BY 256.*/ 19950000 * R6 = R6 + 256; 19960000 AH @6,@D10 0610 19970000 * /*INCREMENT TO POINTER BY 256.*/ 19980000 * R7 = R7 + 256; 19990000 AH @7,@D10 0611 20000000 * /*LOOP TO DO ANOTHER MOVE.*/ 20010000 * GO TO A7P1; 20020000 BC 15,A7P1 0612 20030000 * END; 20040000 * /*DECREMENT LENGTH BY 1.*/ 20050000 * R8 = R8 - 1; 20060000 @9C0 BCTR @8,0 0614 20070000 * /*EXECUTE MOVE INSTRUCTION.*/ 20080000 * GEN( EX R8,MOVE); 20090000 EX R8,MOVE 20100000 DS 0H 20110000 * /*RESTORE REG 14 FROM COMMON AREA. 20120000 * A7P2: R14 = SAVE14; 20130000 A7P2 L @E,360(0,@5) 0616 20140000 * /*RETURN TO CALLER.*/ 20150000 * GO TO R14; 20160000 BCR 15,@E 0617 20170000 * MOVE: GEN( MVC 0(1,R7),0(R6)); 20180000 MOVE MVC 0(1,R7),0(R6) 20190000 DS 0H 20200000 * END IEBCREAT; 20210000 @EL01 L @D,4(0,@D) 0619 20220000 LR @1,@C 0619 20230000 L @0,@SIZ001 0619 20240000 FREEMAIN R,LV=(0),A=(1) 0619 20250000 L @E,12(0,@D) 0619 20260000 LM @0,@8,20(@D) 0619 20270000 LM @A,@C,60(@D) 0619 20280000 BCR 15,@E 0619 20290000 @DATA1 EQU * 20300000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 20310000 @1 EQU 01 20320000 @2 EQU 02 20330000 @3 EQU 03 20340000 @4 EQU 04 20350000 @5 EQU 05 20360000 @6 EQU 06 20370000 @7 EQU 07 20380000 @8 EQU 08 20390000 @9 EQU 09 20400000 @A EQU 10 20410000 @B EQU 11 20420000 @C EQU 12 20430000 @D EQU 13 20440000 @E EQU 14 20450000 @F EQU 15 20460000 @D1 DC F'0' 20470000 @D8 DC F'-1' 20480000 @D9 DC F'524293' 20490000 @D2 DC H'-1' 20500000 @D3 DC H'4' 20510000 @D4 DC H'12' 20520000 @D5 DC H'16' 20530000 @D6 DC H'8' 20540000 @D7 DC H'1' 20550000 @D10 DC H'256' 20560000 @MVC MVC 0(1,@A),0(@E) 20570000 DS 0F 20580000 @SIZ001 DC AL1(&SPN) 20590000 DC AL3(@DATEND-@DATD) 20600000 DS 0F 20610000 @C6 DC C' ' 20620000 @C8 DC C' IEB729I PERMANENT I/O ERROR' 20630000 @X12 DC X'000002147483647C' 20640000 @X3 DC X'0000' 20650000 @C9 DC C'RA' 20660000 @C10 DC C'ZD' 20670000 @C11 DC C'PD' 20680000 @C13 DC C'BI' 20690000 DS 0D 20700000 @DATA EQU * 20710000 R2 EQU 00000002 FULLWORD POINTER REGISTER 20720000 R3 EQU 00000003 FULLWORD POINTER REGISTER 20730000 R4 EQU 00000004 FULLWORD POINTER REGISTER 20740000 R5 EQU 00000005 FULLWORD POINTER REGISTER 20750000 R6 EQU 00000006 FULLWORD POINTER REGISTER 20760000 R7 EQU 00000007 FULLWORD POINTER REGISTER 20770000 R8 EQU 00000008 FULLWORD POINTER REGISTER 20780000 R9 EQU 00000009 FULLWORD POINTER REGISTER 20790000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 20800000 R1 EQU 00000001 FULLWORD POINTER REGISTER 20810000 R14 EQU 00000014 FULLWORD POINTER REGISTER 20820000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 20830000 COMMON EQU 00000000 308 BYTE(S) ON DWORD 20840000 PAGENO EQU COMMON+00000000 4 BYTE(S) 20850000 LINECT EQU COMMON+00000004 FULLWORD INTEGER 20860000 LINECTR EQU COMMON+00000008 FULLWORD INTEGER 20870000 PARM EQU COMMON+00000012 FULLWORD POINTER 20880000 REPEATNO EQU COMMON+00000016 HALFWORD INTEGER 20890000 CREATENO EQU COMMON+00000018 HALFWORD INTEGER 20900000 SYSP EQU COMMON+00000020 96 BYTE(S) 20910000 SYSI EQU COMMON+00000116 96 BYTE(S) 20920000 Q EQU COMMON+00000216 16 BYTE(S) ON DWORD 20930000 QFILL EQU COMMON+00000216 7 BYTE(S) 20940000 QSIGN EQU COMMON+00000223 8 BIT(S) 20950000 QFILL1 EQU COMMON+00000224 7 BYTE(S) 20960000 QSIGN1 EQU COMMON+00000231 8 BIT(S) 20970000 COUNTER EQU COMMON+00000232 FULLWORD POINTER 20980000 OPENLIST EQU COMMON+00000236 8 BYTE(S) 20990000 OPTBYTE1 EQU COMMON+00000236 4 BYTE(S) 21000000 OPTBYTE2 EQU COMMON+00000240 4 BYTE(S) 21010000 EXLST EQU COMMON+00000244 24 BYTE(S) ON WORD 21020000 INHDR EQU COMMON+00000244 1 BYTE(S) 21030000 INHDR1 EQU COMMON+00000245 3 BYTE POINTER ON WORD+1 21040000 OUTHDR EQU COMMON+00000248 1 BYTE(S) 21050000 OUTHDR1 EQU COMMON+00000249 3 BYTE POINTER ON WORD+1 21060000 INTRL EQU COMMON+00000252 1 BYTE(S) 21070000 INTRL1 EQU COMMON+00000253 3 BYTE POINTER ON WORD+1 21080000 OUTTRL EQU COMMON+00000256 1 BYTE(S) 21090000 OUTTRL1 EQU COMMON+00000257 3 BYTE POINTER ON WORD+1 21100000 EXITDCB EQU COMMON+00000260 1 BYTE(S) 21110000 EXITDCB1 EQU COMMON+00000261 3 BYTE POINTER ON WORD+1 21120000 TOTAL EQU COMMON+00000264 1 BYTE(S) 21130000 TOTAL1 EQU COMMON+00000265 3 BYTE POINTER ON WORD+1 21140000 EXLST1 EQU COMMON+00000268 4 BYTE(S) ON WORD 21150000 EDCB1 EQU COMMON+00000268 1 BYTE(S) 21160000 EDCB2 EQU COMMON+00000269 3 BYTE POINTER ON WORD+1 21170000 EXLST2 EQU COMMON+00000272 4 BYTE(S) ON WORD 21180000 EDCB3 EQU COMMON+00000272 1 BYTE(S) 21190000 EDCB4 EQU COMMON+00000273 3 BYTE POINTER ON WORD+1 21200000 EXLST3 EQU COMMON+00000276 4 BYTE(S) ON WORD 21210000 EDCB5 EQU COMMON+00000276 1 BYTE(S) 21220000 EDCB6 EQU COMMON+00000277 3 BYTE POINTER ON WORD+1 21230000 DLRECL EQU COMMON+00000280 HALFWORD INTEGER 21240000 DBLKSI EQU COMMON+00000282 HALFWORD INTEGER 21250000 DRECFM EQU COMMON+00000284 8 BIT(S) 21260000 LEFTOVER EQU COMMON+00000288 FULLWORD INTEGER 21270000 OFFSET EQU COMMON+00000292 FULLWORD POINTER 21280000 LPTR EQU COMMON+00000296 FULLWORD POINTER 21290000 DCBPTR EQU COMMON+00000300 FULLWORD POINTER 21300000 DUMMY EQU COMMON+00000304 FULLWORD POINTER 21310000 COMMON1 EQU 00000304 236 BYTE(S) ON WORD 21320000 SAVEMS EQU COMMON1+00000000 HALFWORD INTEGER 21330000 CONCODE EQU COMMON1+00000002 HALFWORD INTEGER 21340000 OUTREC EQU COMMON1+00000004 FULLWORD POINTER 21350000 CRTABPT EQU COMMON1+00000008 FULLWORD POINTER 21360000 CURCRTE EQU COMMON1+00000012 FULLWORD POINTER 21370000 CURCRGM EQU COMMON1+00000016 FULLWORD POINTER 21380000 CURPIC EQU COMMON1+00000020 FULLWORD POINTER 21390000 PICCTR EQU COMMON1+00000024 FULLWORD INTEGER 21400000 EXITTAB EQU COMMON1+00000028 FULLWORD POINTER 21410000 EXITGM EQU COMMON1+00000032 FULLWORD POINTER 21420000 CUREXIT EQU COMMON1+00000036 FULLWORD POINTER 21430000 DELIM EQU COMMON1+00000040 4 BYTE(S) 21440000 RECREM EQU COMMON1+00000044 FULLWORD INTEGER 21450000 CURFD EQU COMMON1+00000048 FULLWORD POINTER 21460000 CUROUT EQU COMMON1+00000052 HALFWORD POINTER 21470000 SAVE14 EQU COMMON1+00000056 FULLWORD POINTER 21480000 GETMLIST EQU COMMON1+00000060 16 BYTE(S) ON WORD 21490000 GLENGTH EQU COMMON1+00000060 FULLWORD INTEGER 21500000 ADRLIST EQU COMMON1+00000064 FULLWORD POINTER 21510000 IND EQU COMMON1+00000068 4 BYTE(S) 21520000 GCODE EQU COMMON1+00000068 1 BYTE(S) 21530000 SPOOL EQU COMMON1+00000069 1 BYTE(S) 21540000 CCODE EQU COMMON1+00000070 2 BYTE(S) 21550000 GCADDR EQU COMMON1+00000072 FULLWORD POINTER 21560000 FIRSTGMO EQU COMMON1+00000076 FULLWORD POINTER 21570000 CURRGMO EQU COMMON1+00000080 FULLWORD POINTER 21580000 LASTGMO EQU COMMON1+00000084 FULLWORD POINTER 21590000 FIRSTGMI EQU COMMON1+00000088 FULLWORD POINTER 21600000 CURRGMI EQU COMMON1+00000092 FULLWORD POINTER 21610000 LASTGMI EQU COMMON1+00000096 FULLWORD POINTER 21620000 CONDCODE EQU COMMON1+00000100 HALFWORD INTEGER 21630000 MS EQU COMMON1+00000102 HALFWORD INTEGER 21640000 INBUFA1 EQU COMMON1+00000104 121 BYTE(S) 21650000 INFILL EQU COMMON1+00000104 10 BYTE(S) 21660000 INBUFA EQU COMMON1+00000114 111 BYTE(S) 21670000 DDPTR EQU COMMON1+00000228 FULLWORD POINTER 21680000 DUMMY1 EQU COMMON1+00000232 FULLWORD POINTER 21690000 COMMON2 EQU 00000536 76 BYTE(S) ON WORD 21700000 SWITCH EQU COMMON2+00000000 52 BYTE(S) 21710000 FDCSW EQU COMMON2+00000000 1 BYTE(S) 21720000 FDNAMESW EQU COMMON2+00000001 1 BYTE(S) 21730000 FDPCSW EQU COMMON2+00000002 1 BYTE(S) 21740000 FDFMTSW EQU COMMON2+00000003 1 BYTE(S) 21750000 FDPLSW EQU COMMON2+00000004 1 BYTE(S) 21760000 RANGESW EQU COMMON2+00000005 1 BYTE(S) 21770000 FILLSW EQU COMMON2+00000006 1 BYTE(S) 21780000 REPSW EQU COMMON2+00000007 1 BYTE(S) 21790000 INDEXSW EQU COMMON2+00000008 1 BYTE(S) 21800000 INDNMSW EQU COMMON2+00000009 1 BYTE(S) 21810000 BQUOTESW EQU COMMON2+00000010 1 BYTE(S) 21820000 PQUOTESW EQU COMMON2+00000011 1 BYTE(S) 21830000 EQUOTESW EQU COMMON2+00000012 1 BYTE(S) 21840000 FDSW EQU COMMON2+00000013 1 BYTE(S) 21850000 DSDSW EQU COMMON2+00000014 1 BYTE(S) 21860000 NOGOSW EQU COMMON2+00000015 1 BYTE(S) 21870000 CREATESW EQU COMMON2+00000016 1 BYTE(S) 21880000 DSDCSW EQU COMMON2+00000017 1 BYTE(S) 21890000 CRCSW EQU COMMON2+00000018 1 BYTE(S) 21900000 EXITSW EQU COMMON2+00000019 1 BYTE(S) 21910000 EODSTOP EQU COMMON2+00000020 1 BYTE(S) 21920000 DSDNULSW EQU COMMON2+00000021 1 BYTE(S) 21930000 DSDORGSW EQU COMMON2+00000022 1 BYTE(S) 21940000 DSDDDSW EQU COMMON2+00000023 1 BYTE(S) 21950000 CRTBLK EQU COMMON2+00000024 1 BYTE(S) 21960000 NAMCSW EQU COMMON2+00000025 8 BIT(S) 21970000 PICCSW EQU COMMON2+00000026 8 BIT(S) 21980000 BUFPSW EQU COMMON2+00000027 1 BYTE(S) 21990000 ENDSW EQU COMMON2+00000028 1 BYTE(S) 22000000 COMCSW EQU COMMON2+00000029 1 BYTE(S) 22010000 FLAGSW EQU COMMON2+00000030 8 BIT(S) 22020000 PAGESW EQU COMMON2+00000031 1 BYTE(S) 22030000 EPSW EQU COMMON2+00000032 1 BYTE POINTER 22040000 SYSISW EQU COMMON2+00000033 1 BYTE(S) 22050000 SYSPSW EQU COMMON2+00000034 1 BYTE(S) 22060000 OLDNEWSW EQU COMMON2+00000035 1 BYTE(S) 22070000 FLUSHSW EQU COMMON2+00000036 1 BYTE(S) 22080000 FLUSHSW1 EQU COMMON2+00000037 1 BYTE(S) 22090000 DSDOSW EQU COMMON2+00000038 1 BYTE(S) 22100000 DSDISW EQU COMMON2+00000039 1 BYTE(S) 22110000 QUANSW EQU COMMON2+00000040 1 BYTE(S) 22120000 PARENSW EQU COMMON2+00000041 1 BYTE(S) 22130000 REPEATSW EQU COMMON2+00000042 1 BYTE(S) 22140000 SYSINEOD EQU COMMON2+00000043 1 BYTE(S) 22150000 FDPLGTH EQU COMMON2+00000052 HALFWORD INTEGER 22160000 SGCADDR EQU COMMON2+00000056 FULLWORD POINTER 22170000 FDPTR EQU COMMON2+00000060 FULLWORD POINTER 22180000 FDPTR1 EQU COMMON2+00000064 FULLWORD POINTER 22190000 FDPTR2 EQU COMMON2+00000068 FULLWORD POINTER 22200000 DUMMY2 EQU COMMON2+00000072 FULLWORD POINTER 22210000 COMMON3 EQU 00000608 188 BYTE(S) ON WORD 22220000 FDCTR EQU COMMON3+00000000 HALFWORD POINTER 22230000 LREMAIN EQU COMMON3+00000004 FULLWORD POINTER 22240000 COMPCTR EQU COMMON3+00000008 FULLWORD POINTER 22250000 LMOVED EQU COMMON3+00000012 HALFWORD POINTER 22260000 U EQU COMMON3+00000016 FULLWORD POINTER 22270000 PICEND EQU COMMON3+00000020 HALFWORD POINTER 22280000 CURFDGM EQU COMMON3+00000024 FULLWORD POINTER 22290000 SWTCH EQU COMMON3+00000028 4 BYTE(S) ON WORD 22300000 SYSINSEL EQU COMMON3+00000028 1 BYTE(S) 22310000 FIRSTSW EQU COMMON3+00000029 1 BYTE(S) 22320000 FRSTSW EQU COMMON3+00000030 1 BYTE(S) 22330000 STOPSW EQU COMMON3+00000031 1 BYTE(S) 22340000 COPYVAL EQU COMMON3+00000032 HALFWORD INTEGER 22350000 COPYFD EQU COMMON3+00000036 FULLWORD POINTER 22360000 COPYFDGM EQU COMMON3+00000040 FULLWORD POINTER 22370000 NAMCTR EQU COMMON3+00000044 HALFWORD INTEGER 22380000 NAMCTR1 EQU COMMON3+00000046 HALFWORD INTEGER 22390000 INRECSZ EQU COMMON3+00000048 HALFWORD POINTER 22400000 OUTRECSZ EQU COMMON3+00000050 HALFWORD POINTER 22410000 INRECFM EQU COMMON3+00000052 1 BYTE(S) 22420000 RECOFFST EQU COMMON3+00000053 1 BYTE POINTER 22430000 OUTRECFM EQU COMMON3+00000054 1 BYTE(S) 22440000 PICBASE EQU COMMON3+00000056 FULLWORD POINTER 22450000 MESSAGE EQU COMMON3+00000060 121 BYTE(S) 22460000 DUMMY3 EQU COMMON3+00000184 FULLWORD POINTER 22470000 DCBD EQU 00000000 280 BYTE(S) ON DWORD 22480000 FILL EQU DCBD+00000000 16 BYTE(S) 22490000 KEYLEN EQU DCBD+00000016 1 BYTE(S) 22500000 DEVT EQU DCBD+00000017 8 BIT(S) 22510000 FILL1 EQU DCBD+00000018 8 BYTE(S) 22520000 DSORG1 EQU DCBD+00000026 2 BYTE(S) 22530000 DSORG EQU DCBD+00000026 8 BIT(S) 22540000 FILLER EQU DCBD+00000028 8 BYTE(S) 22550000 IOBAD EQU DCBD+00000028 4 BYTE(S) 22560000 BFTEK EQU DCBD+00000032 8 BIT(S) 22570000 EODAD EQU DCBD+00000033 3 BYTE(S) 22580000 RECFM EQU DCBD+00000036 8 BIT(S) 22590000 EXLIST EQU DCBD+00000037 3 BYTE POINTER ON WORD+1 22600000 DDNAME EQU DCBD+00000040 8 BYTE(S) 22610000 DEBAD EQU DCBD+00000040 4 BYTE(S) 22620000 IFLGS EQU DCBD+00000040 8 BIT(S) 22630000 GETAD EQU DCBD+00000048 4 BYTE(S) 22640000 OFLGS EQU DCBD+00000048 8 BIT(S) 22650000 OFLGS1 EQU DCBD+00000049 1 BYTE(S) 22660000 MACRF EQU DCBD+00000050 2 BYTE(S) 22670000 FILL2 EQU DCBD+00000052 4 BYTE(S) 22680000 SYNAD EQU DCBD+00000056 4 BYTE(S) 22690000 CIND EQU DCBD+00000060 2 BYTE(S) 22700000 BLKSI EQU DCBD+00000062 HALFWORD INTEGER 22710000 FILL3 EQU DCBD+00000064 18 BYTE(S) 22720000 LRECL EQU DCBD+00000082 HALFWORD INTEGER 22730000 FILL4 EQU DCBD+00000084 172 BYTE(S) 22740000 NEXTDCB EQU DCBD+00000256 FULLWORD POINTER 22750000 DDNAME1 EQU DCBD+00000260 8 BYTE(S) 22760000 EODSW EQU DCBD+00000268 1 BYTE(S) 22770000 DCBSW1 EQU DCBD+00000269 1 BYTE(S) 22780000 DCBSW2 EQU DCBD+00000270 1 BYTE(S) 22790000 DCBSW3 EQU DCBD+00000271 8 BIT(S) 22800000 INREC EQU DCBD+00000272 FULLWORD POINTER 22810000 GMLGTH EQU DCBD+00000276 HALFWORD INTEGER 22820000 FIELDSEL EQU DCBD+00000278 1 BYTE(S) 22830000 SPARE EQU DCBD+00000279 1 BYTE(S) 22840000 CRPICT EQU 00000000 7 BYTE(S) ON WORD 22850000 PICSTLOC EQU CRPICT+00000000 FULLWORD POINTER 22860000 PICLGTH EQU CRPICT+00000004 HALFWORD INTEGER 22870000 PICSTRNG EQU CRPICT+00000006 1 BYTE(S) 22880000 CRTAB EQU 00000000 28 BYTE(S) ON WORD 22890000 NXTCRTE EQU CRTAB+00000000 FULLWORD POINTER 22900000 QUAN EQU CRTAB+00000004 4 BYTE(S) 22910000 IDCBPTR EQU CRTAB+00000008 FULLWORD POINTER 22920000 EXITADR EQU CRTAB+00000012 FULLWORD POINTER 22930000 PICPTR EQU CRTAB+00000016 FULLWORD POINTER 22940000 FILLCH EQU CRTAB+00000020 1 BYTE POINTER 22950000 EMP1 EQU CRTAB+00000021 3 BYTE(S) 22960000 FDADTAB EQU CRTAB+00000024 FULLWORD POINTER 22970000 ENDFD EQU CRTAB+00000024 1 BYTE(S) 22980000 FDTBL EQU 00000000 520 BYTE(S) ON WORD 22990000 FDNAME EQU FDTBL+00000000 8 BYTE(S) 23000000 FDREPNM EQU FDTBL+00000008 8 BYTE(S) 23010000 FDINDNM EQU FDTBL+00000016 8 BYTE(S) ON WORD 23020000 FDUMMY EQU FDTBL+00000016 4 BYTE(S) 23030000 FDINDNUM EQU FDTBL+00000020 FULLWORD POINTER 23040000 FDLGTH EQU FDTBL+00000024 HALFWORD POINTER 23050000 FDCYCLE EQU FDTBL+00000026 HALFWORD POINTER 23060000 FDACTION EQU FDTBL+00000028 2 BYTE(S) 23070000 FDFORMAT EQU FDTBL+00000030 2 BYTE(S) 23080000 FDSWITCH EQU FDTBL+00000032 8 BIT(S) 23090000 INDBYNAM EQU FDTBL+00000032 1 BIT(S) 23100000 PASS EQU FDTBL+00000032 1 BIT(S) 23110000 FXACTION EQU FDTBL+00000032 1 BIT(S) 23120000 RPACTION EQU FDTBL+00000032 1 BIT(S) 23130000 ROACTION EQU FDTBL+00000032 1 BIT(S) 23140000 WVACTION EQU FDTBL+00000032 1 BIT(S) 23150000 STACTION EQU FDTBL+00000032 1 BIT(S) 23160000 NUACTION EQU FDTBL+00000032 1 BIT(S) 23170000 FDFILL EQU FDTBL+00000033 1 BYTE(S) 23180000 FDSIGN EQU FDTBL+00000034 1 BYTE(S) 23190000 FDCHAR EQU FDTBL+00000035 1 BYTE(S) 23200000 FDRANGE EQU FDTBL+00000036 4 BYTE(S) 23210000 FDRANC EQU FDTBL+00000036 4 BYTE INTEGER 23220000 FDOBUF EQU FDTBL+00000040 HALFWORD POINTER 23230000 FDFRINC EQU FDTBL+00000042 HALFWORD POINTER 23240000 FDFROMAD EQU FDTBL+00000044 4 BYTE(S) 23250000 FDMLGTH EQU FDTBL+00000048 HALFWORD POINTER 23260000 FDTOINC EQU FDTBL+00000050 HALFWORD POINTER 23270000 FDCYCCNT EQU FDTBL+00000052 HALFWORD POINTER 23280000 FDSLGTH EQU FDTBL+00000054 HALFWORD POINTER 23290000 FDSLGTHR EQU FDTBL+00000056 HALFWORD POINTER 23300000 FDFRINCR EQU FDTBL+00000058 1 BYTE(S) 23310000 FDTOINCR EQU FDTBL+00000059 1 BYTE(S) 23320000 LTOFREE EQU FDTBL+00000060 HALFWORD POINTER 23330000 FDSW1 EQU FDTBL+00000062 8 BIT(S) 23340000 STRTLOC1 EQU FDTBL+00000062 1 BIT(S) 23350000 NXTFDTAB EQU 00000516 FULLWORD POINTER 23360000 INBUF EQU 00000000 80 BYTE(S) 23370000 PARAM EQU 00000000 1 BYTE(S) 23380000 AREA EQU 00000000 512 BYTE(S) 23390000 NXTCRGM EQU 00000000 FULLWORD POINTER 23400000 BINARYMX EQU * FULLWORD INTEGER 23410000 DC BL4'1111111111111111111111111111110' 23420000 NXTFDGM EQU 00000000 FULLWORD POINTER 23430000 FDADR EQU 00000000 FULLWORD POINTER 23440000 LLFLD EQU 00000000 HALFWORD INTEGER 23450000 ONE EQU * FULLWORD INTEGER 23460000 DC FL4'0' 23470000 YES EQU * 1 BYTE(S) 23480000 DC X'FF' 23490000 NO EQU * 1 BYTE(S) 23500000 DC X'00' 23510000 ON EQU * 1 BYTE(S) 23520000 DC X'FF' 23530000 OFF EQU * 1 BYTE(S) 23540000 DC X'00' 23550000 ORG @DATA 23560000 DS 00000012C 23570000 @L EQU 1 23580000 @DATD DSECT 23590000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 23600000 SAVEEOD EQU @DATD+00000072 3 BYTE(S) 23610000 DS 00000084C 23620000 @TEMPS DS 0F 23630000 @TEMP4 DC F'0' 23640000 @DATEND EQU * 23650000 IEBCREAT CSECT , 23660000 @9ED EQU GETIN 23670000 @9E9 EQU A7A18 23680000 END IEBCREAT 23690000