*********************************************************************** 00010000 * * 00020000 * TITLE: IEBCRANL DATA GENERATOR CREATE ANALYZE * 00030000 * * 00040000 * STATUS: CHANGE LEVEL 0 * 00050000 * FUNCTION - ANALYZES THE CREATE CARD AND BUILDS TABLES TO HOLD * 00060000 * KEYWORD VALUES. * 00070000 * THIS MODULE IS ALWAYS ENTERED FROM MODULE IEBDG AFTER * 00080000 * A CREATE CARD IS READ. CONTROL IS PASSED TO MODULE * 00090000 * IEBCREAT AFTER A SINGLE CREATE CARD IS PROCESSED OR * 00100000 * AFTER ALL CREATE CARDS OF A REPEAT GROUP ARE PROCESSED.* 00110000 * IF THE CREATE CARD IS NOT THE LAST CARD OF A REPEAT * 00120000 * GROUP, CONTROL IS PASSED TO MODULE IEBDG TO READ THE * 00130000 * NEXT CREATE CARD. * 00140000 * IF AN ERROR IS FOUND IN THE CREATE CARD, CONTROL IS * 00150000 * PASSED TO IEBDG TO PRINT A MESSAGE, SET THE NOGO SWITCH* 00160000 * TO STOP GENERATING OUTPUT RECORDS, AND READ THE NEXT * 00170000 * CONTROL CARD TO CONTINUE SYNTAX CHECKING. * 00180000 * * 00190000 * ENTRY POINT: IEBCRANL THE CSECT NAME OF THIS MODULE * 00200000 * LINKED TO BY MODULE IEBDG. * 00210000 * * 00220000 * INPUT - 'INBUFA' - CONTROL CARD READ FROM SYSIN. * 00230000 * 'COMMON' - WORK AREA. * 00240000 * R9 - POINTS TO START OF CREATE KEYWORD. FOR A * 00250000 * CREATE CONTINUATION CARD R9 POINTS TO COLUMN * 00260000 * 1. * 00270000 * R5 - POINTS TO 'COMMON' WORK AREA. * 00280000 * 'CRCSW' - IF ON, THE CONTROL CARD IS A CREATE CONT- * 00290000 * UATION CARD. * 00300000 * * 00310000 * OUTPUT - CREATE TABLE - A CREATE ENTRY IS BUILT FOR EACH CREATE * 00320000 * CARD. IF A REPEAT GROUP IS PRESENT THERE WILL BE * 00330000 * MULTIPLE CREATE ENTRIES CHAINED TOGETHER. ADDITIONAL * 00340000 * GETMAINS ARE ISSUED IF NECESSARY TO HOLD ALL CREATE * 00350000 * ENTRIES. * 00360000 * PICTURE TABLE - HOLDS THE PICTURE LENGTH, START * 00370000 * LOCATION, AND THE PICTURE VALUE. * 00380000 * FD ADDRESS TABLE - HOLDS ADDRESSES OF FD TABLES FOR * 00390000 * EACH FD NAME SPECIFIED ON THE CREATE CARD. * 00400000 * EXIT NAME TABLE - HOLDS NAMES OF USER EXIT ROUTINES SO * 00410000 * THAT USER EXIT ROUTINES MAY BE DELETED AT END OF DSD * 00420000 * GROUP. * 00430000 * * 00440000 * EXTERNAL ROUTINES - GETMAIN MACRO. * 00450000 * LINK MACRO. * 00460000 * MODULE IEBCREAT. * 00470000 * * 00480000 * EXITS - NORMAL - RETURN TO MODULE IEBDG. * 00490000 * LINK TO MODULE IEBCREAT. * 00500000 * ERROR - RETURN TO MODULE IEBDG. * 00510000 * LINK TO MODULE IEBCREAT. * 00520000 * * 00530000 * * 00540000 * TABLES/WORKAREAS * 00550000 * * 00560000 * CREATE TABLES - FIRST GETMAIN IS POINTED TO BY 'CRTABPT'. * 00570000 * STORAGE IS GOTTEN BY THIS MODULE. IT IS FREED * 00580000 * BY IEBCREAT AFTER ALL RECORDS ARE WRITTEN. * 00590000 * * 00600000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 00610000 * ***************************** * 00620000 * * ADDRESS OF NEXT GETMAIN *---FIRST 4 BYTES OF EACH 512 BYTE * 00630000 * ***************************** GETMAIN. * 00640000 * ********************************************************* * 00650000 * 0 * ADDRESS OF NEXT CREATE * QUANTITY * * 00660000 * ********************************************************* * 00670000 * 8 * INPUT DCB ADDRESS * USER EXIT ADDRESS * * 00680000 * ********************************************************* * 00690000 * 16 * PICTURE ADDRESS * FILL * NOT USED * * 00700000 * ********************************************************* * 00710000 * 24 * FD ADDRESS TABLE * * 00720000 * ***************************** * 00730000 * ANY POINTER OF 0 MEANS NO TABLE OR LAST TABLE. * 00740000 * * 00750000 * * 00760000 * * 00770000 * PICTURE TABLE - POINTED TO BY 'PICPTR' IN CREATE ENTRY. * 00780000 * GETMAIN FOR PICTURE LENGTH + 6. FREED WHEN THE * 00790000 * CREATE TABLES ARE FREED. * 00800000 * * 00810000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 00820000 * ********************************************************* * 00830000 * * START LOCATION OFFSET * LENGTH * PICTURE * * 00840000 * ********************************************************* * 00850000 * * STRING * * 00860000 * ********************************************************* * 00870000 * * 00880000 * * 00890000 * * 00900000 * FD ADDRESS TABLE - POINTED TO BY 'FDADTAB' IN CREATE ENTRY. * 00910000 * GETMAIN OF 88 BYTES. FREED WHEN THE CREATE * 00920000 * TABLES ARE FREED. * 00930000 * * 00940000 * ***************************** * 00950000 * O * ADDRESS OF NEXT GETMAIN * * 00960000 * ***************************** * 00970000 * 4 * FD TABLE ADDRESS * * 00980000 * ***************************** * 00990000 * 8 * FD TABLE ADDRESS * * 01000000 * ***************************** * 01010000 * LAST FD TABLE ADDRESS IN GETMAIN IS FOLLOWED BY 4 BYTES OF 0'S* 01020000 * * 01030000 * * 01040000 * * 01050000 * EXIT NAME TABLE - FIRST GETMAIN IS POINTED TO BY 'EXITTAB'. * 01060000 * GETMAIN OF 72 BYTES. FREED BY MODULE IEBDG * 01070000 * WHEN AN END CARD IS READ. * 01080000 * * 01090000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 01100000 * ***************************** * 01110000 * 0 * ADDRESS OF NEXT GETMAIN * * 01120000 * ********************************************************* * 01130000 * 4 * USER EXIT ROUTINE NAME * * 01140000 * ********************************************************* * 01150000 * 12 * USER EXIT ROUTINE NAME * * 01160000 * ********************************************************* * 01170000 * LAST EXIT NAME IN GETMAIN IS FOLLOWED BY 4 BYTES OF 0'S. * 01180000 * * 01190000 * * 01200000 * * 01210000 * DCB TABLES- KEPT FOR DSD GROUP GETMAIN 272 BYTES FOR EACH UNIQUE* 01220000 * DDNAME ON CREATE CARD. INPUT DCB'S ARE CHAINED * 01230000 * TOGETHER AND POINTED TO BY 'IDCBPT'. OUTPUT DCB IS * 01240000 * POINTED TO BY 'ODCBPT'. * 01250000 * * 01260000 * BYTE 1 BYTE 2 BYTE 3 BYTE 4 BYTE 5 BYTE 6 BYTE 7 BYTE 8 * 01270000 * ********************************************************* * 01280000 * * DCB FOR INPUT OR OUTPUT DATA SET * * 01290000 * * 256 BYTES * * 01300000 * ********************************************************* * 01310000 * * ADDRESS OF NEXT DCB * DDNAME--- * * 01320000 * ********************************************************* * 01330000 * * ---DDNAME *EODSW * * * 01340000 * ********************************************************* * 01350000 * * 01360000 * ATTRIBUTES: REENTRANT,REUSEABLE * 01370000 * * 01380000 *********************************************************************** 01390000 * NEW MODULE, RELEASE 17. DG0H 01400000 *A818600,876600-876900 A38710 01410000 *A687600-687998 A38781 01420000 *C687500 A38781 01430000 *C206000 @ZA04231 01440000 *C206000 @ZA07345 01450000 LCLA &T,&SPN 0003 01460000 .@001 ANOP 0003 01470000 IEBCRANL CSECT , 0003 01480000 ST @E,12(0,@D) 0003 01490000 STM @0,@8,20(@D) 0003 01500000 STM @A,@C,60(@D) 0003 01510000 BALR @B,0 0003 01520000 @PSTART DS 0H 0003 01530000 USING @PSTART+00000,@B 0003 01540000 L @0,@SIZ001 0003 01550000 GETMAIN R,LV=(0) 0003 01560000 LR @C,@1 0003 01570000 USING @DATD+00000,@C 0003 01580000 LM @0,@1,20(@D) 0003 01590000 XC @TEMPS(@L),@TEMPS 0003 01600000 ST @D,@SAV001+4 0003 01610000 LA @F,@SAV001 0003 01620000 ST @F,8(0,@D) 0003 01630000 LR @D,@F 0003 01640000 * A6A1:; 01650000 * /*SET 'EPSW' TO 2 IN CASE OF SUC- * 01660000 * /* CESSFUL RETURN TO IEBDG. * 01670000 * EPSW = 2; 01680000 A6A1 MVI 568(@5),2 0050 01690000 * /*TEST IF CREATE CARD OR CREATE */ 01700000 * /*CONTINUATION CARD WAS READ. */ 01710000 * IF CRCSW = ON THEN GO TO A6A21; 01720000 CLC 554(1,@5),ON 0051 01730000 BC 08,A6A21 0052 01740000 * A6A15: R9 = R9 + 6 /*POINT AT BLANK FOLLOWING CREATE KEYWORD*/; 01750000 A6A15 AH @9,@D1 0053 01760000 * IF INBUF(1) ^=' ' THEN DO; 01770000 CLI 0(@9),C' ' 0054 01780000 BC 08,@9FF 0054 01790000 * /*NO BLANK FOLLOWING OPERATION FLD. 01800000 * /*SET MSG 20. 01810000 * MS = 20; 01820000 LA @F,20 0056 01830000 STH @F,406(0,@5) 0056 01840000 * GO TO ERRORF; 01850000 BC 15,ERRORF 0057 01860000 * END; 01870000 * /******************************************************************* 01880000 * /** THIS SECTION WILL SCAN OUT BLANKS ON THE CONTROL CARD.IT IS * 01890000 * /** LOOKING FOR THE FIRST NON-BLANK * 01900000 * /******************************************************************* 01910000 * A6A3:; 01920000 @9FF EQU * 0059 01930000 * R9 = R9 + 1 /*ADVANCE COLUMN POINTER.*/; 01940000 A6A3 AH @9,@D2 0060 01950000 * /*TEST IF PAST COLUMN 71. */ 01960000 * IF R9 > COUNTER THEN DO; 01970000 C @9,232(0,@5) 0061 01980000 BC 12,@9FE 0061 01990000 * /*************************************** 02000000 * /**CREATE CARD HAS NO OPERANDS. CREATE * 02010000 * /** ENTRY WILL CONTAIN DEFAULT VALUES * 02020000 * /** OF - QUANTITY = 1 * 02030000 * /** FILL = X'00' * 02040000 * /*************************************** 02050000 * /*TURN ON 'CRTBLK' SWITCH. */ 02060000 * CRTBLK = ON; 02070000 MVC 560(1,@5),ON 0063 02080000 * /*GO TO GET SPACE FOR CREATE ENTRY. 02090000 * GO TO A6A10; 02100000 BC 15,A6A10 0064 02110000 * END; 02120000 * /*TEST IF COLUMN IS BLANK. */ 02130000 * IF INBUF(1) = ' ' THEN GO TO A6A3; 02140000 @9FE CLI 0(@9),C' ' 0066 02150000 BC 08,A6A3 0067 02160000 * GO TO A6A10; 02170000 BC 15,A6A10 0068 02180000 * /******************************************************************** 02190000 * /** CREATE CONTINUATION - THIS SECTION WILL TEST THE COMMENT CONT. * 02200000 * /** SW. BEING ON. IF YES, IT WILL BRANCH TO TEST FOR MORE CONTIN- * 02210000 * /** UATIONS. IT WILL TEST FOR SPECIFIC NAME OR PICTURE SUB- * 02220000 * /** PARAMETER CONTINUATIONS AND BRANCH TO THE ROUTINE TO CONTINUE * 02230000 * /** PROCESSING THE SUBPARAMETER. IF NONE OF THESE ARE FOUND THEN * 02240000 * /** THE CONT. CARD BEGINS WITH A NEW KEYWORD. * 02250000 * /******************************************************************** 02260000 * A6A21: 02270000 * /*TURN OFF CREATE CONTINUE SWITCH.* 02280000 * CRCSW = OFF; 02290000 A6A21 MVC 554(1,@5),OFF 0069 02300000 * /*TEST IF COMMENT CONT. SW. ON. */ 02310000 * IF COMCSW = ON THEN DO; 02320000 CLC 565(1,@5),ON 0070 02330000 BC 07,@9FD 0070 02340000 * /*TURN OFF COMMENT CONT. SW. */ 02350000 * COMCSW = OFF; 02360000 MVC 565(1,@5),OFF 0072 02370000 * /*GO TO CHECK MORE CONTINUATIONS. * 02380000 * GO TO A6P01; 02390000 BC 15,A6P01 0073 02400000 * END; 02410000 * /*ADVANCE CARD COL PTR TO COL 4.*/ 02420000 * R9 = R9 + 3; 02430000 @9FD AH @9,@D3 0075 02440000 * /*TEST IF PICTURE STRING CONT. */ 02450000 * IF PICCSW(3) = '1'B THEN DO; 02460000 TM 562(@5),B'00100000' 0076 02470000 BC 12,@9FC 0076 02480000 * /*TURN OFF SWITCH.*/ 02490000 * PICCSW(3) = '0'B; 02500000 NI 562(@5),B'11011111' 0078 02510000 * /*GO TO CONTINUE PROCESSING */ 02520000 * /* PICTURE KEYWORD. */ 02530000 * GO TO A6D7; 02540000 BC 15,A6D7 0079 02550000 * END; 02560000 * /************************************************* 02570000 * /**THIS SECTION WILL SCAN THE CARD BEGINNING AT * 02580000 * /** COL. 4 LOOKING FOR A NON-BLANK. A PICTURE * 02590000 * /** STRING CONT. IS REQUIRED TO START IN COL. 4. * 02600000 * /** THE FOLLOWING CONTINUATIONS MAY BEGIN IN COL.* 02610000 * /** 4 OR ANY COLUMN AFTER 4. * 02620000 * /************************************************* 02630000 * /*TEST IF PAST COL. 71. */ 02640000 * A6A31: IF R9 > COUNTER THEN GO TO MSG21; 02650000 @9FC EQU * 0081 02660000 A6A31 C @9,232(0,@5) 0081 02670000 BC 02,MSG21 0082 02680000 * /*TEST IF COLUMN IS BLANK. */ 02690000 * IF INBUF(1) = ' ' THEN DO; 02700000 CLI 0(@9),C' ' 0083 02710000 BC 07,@9FB 0083 02720000 * /*STEP CARD COL PTR. */ 02730000 * R9 = R9 + 1; 02740000 AH @9,@D2 0085 02750000 * GO TO A6A31; 02760000 BC 15,A6A31 0086 02770000 * END; 02780000 * /*TEST IF NAME SUBPARAMETER CONT.*/ 02790000 * IF NAMCSW(1) = '1'B THEN DO; 02800000 @9FB TM 561(@5),B'10000000' 0088 02810000 BC 12,@9FA 0088 02820000 * /*TURN OFF SWITCH.*/ 02830000 * NAMCSW(1) = '0'B; 02840000 NI 561(@5),B'01111111' 0090 02850000 * /*GO TO CONTINUE PROCESSING */ 02860000 * /* NAME KEYWORD. */ 02870000 * GO TO A6C5; 02880000 BC 15,A6C5 0091 02890000 * END; 02900000 * /*TEST IF NAME SUBPARAMETER CONT.*/ 02910000 * IF NAMCSW(2) = '1'B THEN DO; 02920000 @9FA TM 561(@5),B'01000000' 0093 02930000 BC 12,@9F9 0093 02940000 * /*TURN OFF SWITCH.*/ 02950000 * NAMCSW(2) = '0'B; 02960000 NI 561(@5),B'10111111' 0095 02970000 * /*GO TO CONTINUE PROCESSING */ 02980000 * /* NAME KEYWORD. */ 02990000 * GO TO A6C8; 03000000 BC 15,A6C8 0096 03010000 * END; 03020000 * /*TEST IF PICTURE SUBPARAM. CONT.*/ 03030000 * IF PICCSW(1) = '1'B THEN DO; 03040000 @9F9 TM 562(@5),B'10000000' 0098 03050000 BC 12,@9F8 0098 03060000 * /*TURN OFF SWITCH.*/ 03070000 * PICCSW(1) = '0'B; 03080000 NI 562(@5),B'01111111' 0100 03090000 * /*GO TO CONTINUE PROCESSING */ 03100000 * /* PICTURE KEYWORD. */ 03110000 * GO TO A6D4; 03120000 BC 15,A6D4 0101 03130000 * END; 03140000 * /*TEST IF PICTURE SUBPARAM. CONT.*/ 03150000 * IF PICCSW(2) = '1'B THEN DO; 03160000 @9F8 TM 562(@5),B'01000000' 0103 03170000 BC 12,@9F7 0103 03180000 * /*TURN OFF SWITCH.*/ 03190000 * PICCSW(2) = '0'B; 03200000 NI 562(@5),B'10111111' 0105 03210000 * /*GO TO CONTINUE PROCESSING */ 03220000 * /* PICTURE KEYWORD. */ 03230000 * GO TO A6D6; 03240000 BC 15,A6D6 0106 03250000 * END; 03260000 * /*CONTINUATION IS AFTER A COMPLETE 03270000 * /* PARAMETER. 03280000 * GO TO KEYSCAN; 03290000 * /******************************************************************** 03300000 * /** GET SPACE FOR A CREATE ENTRY - THIS SECTION WILL GET SPACE FOR * 03310000 * /** THE INITIAL CREATE TABLE OR FOR AN ADDITIONAL TABLE IF THE * 03320000 * /** PREVIOUS ONE IS FULL BECAUSE OF THE NUMBER OF CREATE CARDS IN * 03330000 * /** A REPEAT GROUP. GETMAINS ARE CHAINED TOGETHER. IF A GETMAIN * 03340000 * /** IS ISSUED THE ENTIRE AREA IS CLEARED TO 0'S. EACH CREATE * 03350000 * /** TABLE IS 512 BYTES AND EACH CREATE ENTRY IS 28 BYTES. * 03360000 * /** ENTRY - 'CREATESW' = OFF IF CREATE CARD ISN'T IN A REPEAT * 03370000 * /** GROUP OR IF IT IS THE 1ST CARD IN A REPEAT GROUP* 03380000 * /** EXIT - 'CURCRGM' POINTS TO THE CURRENT CREATE TABLE. * 03390000 * /** 'CURCRTE' POINTS TO THE NEW CREATE ENTRY. * 03400000 * /******************************************************************** 03410000 * /*TEST IF 1ST CREATE CARD. */ 03420000 * A6A10: IF CREATESW = OFF THEN GO TO A6A11; 03430000 A6A10 CLC 552(1,@5),OFF 0109 03440000 BC 08,A6A11 0110 03450000 * /*TEST IF ENOUGH ROOM IN GETMAIN * 03460000 * /* FOR FIXED PORTION OF NEW CREATE* 03470000 * /* ENTRY. * 03480000 * IF CURCRGM + 512 > CURCRTE + 56 THEN DO; 03490000 LA @F,512 0111 03500000 A @F,320(0,@5) 0111 03510000 ST @F,@T1 0111 03520000 LA @F,56 0111 03530000 A @F,316(0,@5) 0111 03540000 C @F,@T1 0111 03550000 BC 10,@9F6 0111 03560000 * /*CHAIN NEW CREATE ENTRY TO 03570000 * /* PREVIOUS ONE. 03580000 * CURCRTE -> NXTCRTE = CURCRTE + 28; 03590000 LA @F,28 0113 03600000 A @F,316(0,@5) 0113 03610000 L @1,316(0,@5) 0113 03620000 ST @F,0(0,@1) 0113 03630000 * /*POINT TO NEW CREATE ENTRY.*/ 03640000 * CURCRTE = CURCRTE + 28; 03650000 LA @F,28 0114 03660000 A @F,316(0,@5) 0114 03670000 ST @F,316(0,@5) 0114 03680000 * GO TO A6A12; 03690000 BC 15,A6A12 0115 03700000 * END; 03710000 * /*ISSUE CONDITIONAL GM 512 BYTES*/ 03720000 * /* FOR CREATE TABLE. ADR IS */ 03730000 * /* RETURNED IN 'GCADDR'. */ 03740000 * /*PUT LENGTH IN GM PARAMETER LIST. 03750000 * A6A11: GLENGTH = 512; 03760000 @9F6 EQU * 0117 03770000 A6A11 LA @F,512 0117 03780000 ST @F,364(0,@5) 0117 03790000 * /*GO TO GETMAIN ROUTINE. */ 03800000 * CALL GETMAIN; 03810000 BAL @E,GETMAIN 0118 03820000 * /*BASE POINTER FOR 'AREA'.*/ 03830000 * R4 = GCADDR; 03840000 L @4,376(0,@5) 0119 03850000 * AREA(1) = '0'X /*CLEAR GETMAIN AREA.*/; 03860000 MVI 0(@4),X'00' 0120 03870000 * AREA(2:256) = AREA(1:255); 03880000 MVC 1(255,@4),0(@4) 0121 03890000 * AREA(257:512) = AREA(256:511); 03900000 MVC 256(256,@4),255(@4) 0122 03910000 * /*TEST IF NON-1ST CREATE CARD.*/ 03920000 * IF CREATESW = OFF THEN DO; 03930000 CLC 552(1,@5),OFF 0123 03940000 BC 07,@9F5 0123 03950000 * CRTABPT = GCADDR /*GM ADR TO CREATE TABLE PTR.*/; 03960000 MVC 312(4,@5),376(@5) 0125 03970000 * CREATESW = ON /*TURN ON CREATE SWITCH.*/; 03980000 MVC 552(1,@5),ON 0126 03990000 BC 15,@9F4 0128 04000000 * END; 04010000 * ELSE DO; 04020000 * R4 = CURCRGM /*POINT TO PREVIOUS GM.*/; 04030000 @9F5 L @4,320(0,@5) 0129 04040000 * AREA(1:4) = GCADDR /*LINK NEW GM TO PREVIOUS ONE.*/; 04050000 MVC 0(4,@4),376(@5) 0130 04060000 * END; 04070000 * CURCRTE = GCADDR + 4 /*POINT TO NEW CREATE ENTRY.*/; 04080000 @9F4 LA @F,4 0132 04090000 A @F,376(0,@5) 0132 04100000 ST @F,316(0,@5) 0132 04110000 * CURCRGM = GCADDR /*SAVE ADR OF CURRENT GM.*/; 04120000 MVC 320(4,@5),376(@5) 0133 04130000 * /*IF 'CRTBLK' SW. IS ON, THERE 04140000 * /* ARE NO CREATE OPERANDS. GO TO 04150000 * /* CHECK FOR COMMENTS CONTINUATION. 04160000 * A6A12: IF CRTBLK = ON THEN DO; 04170000 A6A12 CLC 560(1,@5),ON 0134 04180000 BC 07,@9F3 0134 04190000 * /*TURN OFF 'CRTBLK' SWITCH. */ 04200000 * CRTBLK = OFF; 04210000 MVC 560(1,@5),OFF 0136 04220000 * /*GO TO CHECK FOR COMMENTS CONTIN- 04230000 * /* UATIONS. 04240000 * GO TO A6P01; 04250000 BC 15,A6P01 0137 04260000 * END; 04270000 * /******************************************************************** 04280000 * /** KEYWORD SCAN - THIS SECTION SCANS FOR ALL VALID CREATE CARD * 04290000 * /** KEYWORDS. IF A KEYWORD IS FOUND INVALID GO TO * 04300000 * /** IEBDG TO ISSUE SYNTAX MESSAGE. * 04310000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 04320000 * /******************************************************************** 04330000 * KEYSCAN:; 04340000 @9F3 EQU * 0139 04350000 * /*TEST IF QUANTITY KEYWORD. */ 04360000 * IF INBUF(1:9) = 'QUANTITY=' THEN GO TO A6B1; 04370000 KEYSCAN CLC 0(9,@9),@C5 0140 04380000 BC 08,A6B1 0141 04390000 * /*TEST IF NAME KEYWORD. */ 04400000 * IF INBUF(1:5) = 'NAME=' THEN GO TO A6C1; 04410000 CLC 0(5,@9),@C6 0142 04420000 BC 08,A6C1 0143 04430000 * /*TEST IF PICTURE KEYWORD. */ 04440000 * IF INBUF(1:8) = 'PICTURE=' THEN GO TO A6D1; 04450000 CLC 0(8,@9),@C7 0144 04460000 BC 08,A6D1 0145 04470000 * /*TEST IF FILL KEYWORD. */ 04480000 * IF INBUF(1:5) = 'FILL=' THEN GO TO A6E1; 04490000 CLC 0(5,@9),@C8 0146 04500000 BC 08,A6E1 0147 04510000 * /*TEST IF INPUT KEYWORD. */ 04520000 * IF INBUF(1:6) = 'INPUT=' THEN GO TO A6F1; 04530000 CLC 0(6,@9),@C9 0148 04540000 BC 08,A6F1 0149 04550000 * /*TEST IF EXIT KEYWORD. */ 04560000 * IF INBUF(1:5) = 'EXIT=' THEN GO TO A6G1; 04570000 CLC 0(5,@9),@C10 0150 04580000 BC 08,A6G1 0151 04590000 * /*INVALID KEYWORD. */ 04600000 * /*SET MSG 5. */ 04610000 * MS = 5; 04620000 LA @F,5 0152 04630000 STH @F,406(0,@5) 0152 04640000 * GO TO ERRORF; 04650000 BC 15,ERRORF 0153 04660000 * /******************************************************************** 04670000 * /** PROCESS QUANTITY KEYWORD * 04680000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 04690000 * /** EXIT - R8 POINTS TO DELIMITER FOLLOWING QUANTITY * 04700000 * /** PARAMETER. * 04710000 * /** FORMAT - QUANTITY=DD 1 TO 9 DECIMAL DIGITS. * 04720000 * /******************************************************************** 04730000 * A6B1: 04740000 * /*ADVANCE COLUMN POINTER TO START * 04750000 * /* OF PARAMETER. * 04760000 * R9 = R9 + 9; 04770000 A6B1 AH @9,@D4 0154 04780000 * /*GO TO SCAN OUT PARAMETER.*/ 04790000 * CALL SPSCAN; 04800000 BAL @E,SPSCAN 0155 04810000 * /*GO TO CONVERT QUANTITY TO BINARY. 04820000 * CALL CONVDB; 04830000 BAL @E,CONVDB 0156 04840000 * /*STORE QUANTITY IN CREATE ENTRY.*/ 04850000 * CURCRTE -> QUAN = R6; 04860000 L @1,316(0,@5) 0157 04870000 ST @6,4(0,@1) 0157 04880000 * /*QUANTITY KEYWORD HAS BEEN */ 04890000 * /* PROCESSED. GO TO SCAN OUT NEXT*/ 04900000 * GO TO CARDSCAN /* KEYWORD. */ 04910000 BC 15,CARDSCAN 0158 04920000 * /******************************************************************** 04930000 * /** PROCESS NAME KEYWORD. * 04940000 * /** AFTER EACH NAME IS SCANNED, THE 'FDSRCH' ROUTINE IS * 04950000 * /** CALLED TO FIND THE FD TABLE AND STORE ITS ADDRESS IN * 04960000 * /** THE FD ADDRESS TABLE. AFTER A COPY GROUP IS COMPLETED,* 04970000 * /** ALL THE FD ADDRESSES ASSOCIATED WITH THE COPY GROUP * 04980000 * /** ARE DUPLICATED IN THE FD ADR. TABLES THE NO. OF TIMES * 04990000 * /** INDICATED BY THE COPY KEYWORD. * 05000000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 05010000 * /** EXIT - R8 POINTS TO DELIMITER FOLLOWING NAME KEYWORD. * 05020000 * /** FORMAT - NAME=NAME1 * 05030000 * /** NAME=(NAME1,...(COPY=VALUE,NAME2,...),...) * 05040000 * /******************************************************************** 05050000 * A6C1:; 05060000 * /*ADVANCE CARD COLUMN PTR TO START 05070000 * /* OF PARAMETER. 05080000 * R9 = R9 + 5; 05090000 A6C1 AH @9,@D5 0160 05100000 * /*TURN ON FIRSTSW. */ 05110000 * FIRSTSW = ON; 05120000 MVC 637(1,@5),ON 0161 05130000 * /*TEST IF COLUMN IS A LEFT PAREND. 05140000 * IF INBUF(1) = '(' THEN GO TO A6C2; 05150000 CLI 0(@9),C'(' 0162 05160000 BC 08,A6C2 0163 05170000 * /************************************************* 05180000 * /** ONLY A SINGLE FD NAME PRESENT - NO PARENDS * 05190000 * /** WERE FOUND. * 05200000 * /************************************************* 05210000 * /*ONLY ONE FD NAME IS PRESENT. */ 05220000 * /*GO TO SPSCAN TO SCAN OUT NAME. */ 05230000 * CALL SPSCAN; 05240000 BAL @E,SPSCAN 0164 05250000 * /*GO TO SEARCH FD TABLES. */ 05260000 * CALL FDSRCH; 05270000 BAL @E,FDSRCH 0165 05280000 * /*NAME KEYWORD HAS BEEN PROCESSED, 05290000 * /* GO TO SCAN OUT NEXT KEYWORD. 05300000 * GO TO CARDSCAN; 05310000 BC 15,CARDSCAN 0166 05320000 * /************************************************* 05330000 * /** SCAN FD NAMES IN AN OUTER PARENTHESES GROUP. * 05340000 * /** THIS SECTION WILL CONTINUE TO SCAN NAMES * 05350000 * /** UNTIL A RIGHT PAREND IS FOUND. IF A LEFT * 05360000 * /** PAREND IS FOUND A BRANCH IS TAKEN TO THE * 05370000 * /** SECTION THAT SCANS THE INNER PARENTHESES * 05380000 * /** GROUP. * 05390000 * /************************************************* 05400000 * /*STEP CARD COLUMN PTR. */ 05410000 * A6C2: R9 = R9 + 1; 05420000 A6C2 AH @9,@D2 0167 05430000 * /*TEST IF COLUMN IS A LEFT PAREND. 05440000 * A6C5: IF INBUF(1) = '(' THEN GO TO A6C6; 05450000 A6C5 CLI 0(@9),C'(' 0168 05460000 BC 08,A6C6 0169 05470000 * /*GO TO SPSCAN TO SCAN OUT NAME. */ 05480000 * CALL SPSCAN; 05490000 BAL @E,SPSCAN 0170 05500000 * /*GO TO SEARCH FD TABLES. */ 05510000 * CALL FDSRCH; 05520000 BAL @E,FDSRCH 0171 05530000 * /*SET R9 TO DELIMITER FOLLOWING */ 05540000 * /* NAME. */ 05550000 * R9 = R8; 05560000 LR @9,@8 0172 05570000 * /*TEST IF COLUMN IS A RIGHT PAREND. 05580000 * A6C55: IF INBUF(1) = ')' THEN DO; 05590000 A6C55 CLI 0(@9),C')' 0173 05600000 BC 07,@9F2 0173 05610000 * /*STEP CARD COLUMN PTR. */ 05620000 * A6C54: R8 = R9 + 1; 05630000 A6C54 LA @8,1 0175 05640000 AR @8,@9 0175 05650000 * /*NAME KEYWORD HAS BEEN PROCESSED, 05660000 * /* GO TO SCAN OUT NEXT KEYWORD. 05670000 * GO TO CARDSCAN; 05680000 BC 15,CARDSCAN 0176 05690000 * END; 05700000 * /*************************************** 05710000 * /**THIS SECTION TESTS IF NEXT NAME IS * 05720000 * /** ON THIS CARD OR IF IT IS CONTINUED * 05730000 * /** ONTO NEXT CARD. * 05740000 * /*************************************** 05750000 * /*TEST IF COLUMN IS A COMMA. */ 05760000 * IF INBUF(1) ^= ',' THEN DO; 05770000 @9F2 CLI 0(@9),C',' 0178 05780000 BC 08,@9F1 0178 05790000 * /*INVALID DELIMITER. */ 05800000 * /*SET MSG 3. */ 05810000 * MSG3: MS = 3; 05820000 MSG3 LA @F,3 0180 05830000 STH @F,406(0,@5) 0180 05840000 * GO TO ERRORF; 05850000 BC 15,ERRORF 0181 05860000 * END; 05870000 * /*TEST IF COMMA IS IN COL 71. */ 05880000 * IF R9 = COUNTER THEN GO TO A6C52; 05890000 @9F1 C @9,232(0,@5) 0183 05900000 BC 08,A6C52 0184 05910000 * /*STEP CARD COLUMN PTR. */ 05920000 * R9 = R9 + 1; 05930000 AH @9,@D2 0185 05940000 * /*TEST IF COLUMN PAST COMMA IS */ 05950000 * /* BLANK. */ 05960000 * IF INBUF(1) = ' ' THEN DO; 05970000 CLI 0(@9),C' ' 0186 05980000 BC 07,@9F0 0186 05990000 * /*CONTINUATION AFTER A NAME IS */ 06000000 * /* INDICATED. */ 06010000 * /*SET NAMCSW1. */ 06020000 * A6C52: NAMCSW(1) = '1'B; 06030000 A6C52 OI 561(@5),B'10000000' 0188 06040000 * /*TURN ON CREATE CONT. SW. */ 06050000 * A6C53: CRCSW = ON; 06060000 A6C53 MVC 554(1,@5),ON 0189 06070000 * /*GO TO IEBDG TO READ CONTINUATION 06080000 * /* CARD. 06090000 * GO TO RETURN2; 06100000 BC 15,RETURN2 0190 06110000 * END; 06120000 * /*GO TO SCAN FOR ANOTHER NAME. */ 06130000 * GO TO A6C5; 06140000 * /************************************************* 06150000 * /** SCAN FD NAMES IN AN INNER PARENTHESES GROUP. * 06160000 * /** THIS SECTION WILL SCAN NAMES UNTIL A RIGHT * 06170000 * /** PAREND IS FOUND. THE COPY KEYWORD MUST * 06180000 * /** APPEAR FIRST. WHEN A RIGHT PAREND IS FOUND* 06190000 * /** ALL FD ADR'S ASSOCIATED WITH THE GROUP ARE * 06200000 * /** DUPLICATED IN THE FD ADDRESS TABLE. IF * 06210000 * /** COPY = 1 NONE ARE DUPLICATED. * 06220000 * /************************************************* 06230000 * /*STEP CARD COLUMN PTR. */ 06240000 * A6C6: R9 = R9 + 1; 06250000 A6C6 AH @9,@D2 0193 06260000 * /*TEST IF COPY KEYWORD IS PRESENT. 06270000 * IF INBUF(1:5) ^= 'COPY=' THEN GO TO MSG3; 06280000 CLC 0(5,@9),@C14 0194 06290000 BC 07,MSG3 0195 06300000 * /*SET SWITCH TO INDICATE 1ST NAME * 06310000 * /* IN COPY GROUP. * 06320000 * FRSTSW = ON; 06330000 MVC 638(1,@5),ON 0196 06340000 * /*CLEAR NAME COUNTER. */ 06350000 * NAMCTR = 0; 06360000 SR @F,@F 0197 06370000 STH @F,652(0,@5) 0197 06380000 * /*ADVANCE CARD COL PTR TO COPY NO.* 06390000 * R9 = R9 + 5; 06400000 AH @9,@D5 0198 06410000 * /*GO TO SPSCAN TO SCAN OUT COPY */ 06420000 * /* VALUE. */ 06430000 * CALL SPSCAN; 06440000 BAL @E,SPSCAN 0199 06450000 * /*GO TO CONVDB TO CONVERT COPY */ 06460000 * /* VALUE TO BINARY. */ 06470000 * CALL CONVDB; 06480000 BAL @E,CONVDB 0200 06490000 * /*SAVE COPY VALUE. */ 06500000 * COPYVAL = R6; 06510000 STH @6,640(0,@5) 0201 06520000 * /*SET R9 TO DELIMITER FOLLOWING */ 06530000 * /* COPY VALUE. */ 06540000 * R9 = R8; 06550000 LR @9,@8 0202 06560000 * /*************************************** 06570000 * /**THIS SECTION TESTS IF NEXT NAME IS * 06580000 * /** ON THIS CARD OR IF IT IS CONTINUED * 06590000 * /** ONTO NEXT CARD. * 06600000 * /*************************************** 06610000 * /*TEST IF COLUMN IS A COMMA. */ 06620000 * A6C61: IF INBUF(1) ^= ',' THEN GO TO MSG3; 06630000 A6C61 CLI 0(@9),C',' 0203 06640000 BC 07,MSG3 0204 06650000 * /*TEST IF COMMA IS IN COL 71. */ 06660000 * IF R9 = COUNTER THEN GO TO A6C62; 06670000 C @9,232(0,@5) 0205 06680000 BC 08,A6C62 0206 06690000 * /*STEP CARD COLUMN PTR. */ 06700000 * R9 = R9 + 1; 06710000 AH @9,@D2 0207 06720000 * /*TEST IF COLUMN PAST COMMA IS */ 06730000 * /* BLANK. */ 06740000 * IF INBUF(1) = ' ' THEN DO; 06750000 CLI 0(@9),C' ' 0208 06760000 BC 07,@9EF 0208 06770000 * /*CONTINUATION AFTER COPY OR AN */ 06780000 * /* FD NAME IS INDICATED. */ 06790000 * /*SET NAMCSW2. */ 06800000 * A6C62: NAMCSW(2) = '1'B; 06810000 A6C62 OI 561(@5),B'01000000' 0210 06820000 * GO TO A6C53; 06830000 BC 15,A6C53 0211 06840000 * END; 06850000 * /*GO TO SPSCAN TO SCAN OUT FD NAME. 06860000 * A6C8: CALL SPSCAN; 06870000 @9EF EQU * 0213 06880000 A6C8 BAL @E,SPSCAN 0213 06890000 * /*GO TO SEARCH FD TABLES. */ 06900000 * IF NAMCTR = 20 THEN 06910000 LA @F,20 0214 06920000 CH @F,652(0,@5) 0214 06930000 BC 07,@9EE 0214 06940000 * FRSTSW = ON; 06950000 MVC 638(1,@5),ON 0215 06960000 * CALL FDSRCH; 06970000 @9EE BAL @E,FDSRCH 0216 06980000 * /*TEST IF 1ST NAME IN COPY GROUP. * 06990000 * IF FRSTSW = ON THEN DO; 07000000 CLC 638(1,@5),ON 0217 07010000 BC 07,@9ED 0217 07020000 * /*TURN SWITCH OFF. */ 07030000 * FRSTSW = OFF; 07040000 MVC 638(1,@5),OFF 0219 07050000 * /*SAVE PTR TO 1ST FD ADR OF COPY */ 07060000 * /* GROUP. */ 07070000 * COPYFD = CURFD; 07080000 MVC 644(4,@5),352(@5) 0220 07090000 * /*SAVE PTR TO GM FOR 1ST FD ADR. */ 07100000 * COPYFDGM = CURFDGM; 07110000 MVC 648(4,@5),632(@5) 0221 07120000 * END; 07130000 * /*INCREMENT NAME CTR. */ 07140000 * NAMCTR = NAMCTR + 1; 07150000 @9ED LA @F,1 0223 07160000 AH @F,652(0,@5) 0223 07170000 STH @F,652(0,@5) 0223 07180000 * /*SET R9 TO DELIMITER FOLLOWING */ 07190000 * /* NAME. */ 07200000 * R9 = R8; 07210000 LR @9,@8 0224 07220000 * /*TEST IF COLUMN IS A RIGHT PAREND. 07230000 * IF INBUF(1) ^= ')' THEN GO TO A6C61; 07240000 CLI 0(@9),C')' 0225 07250000 BC 07,A6C61 0226 07260000 * /*DECREMENT COPY VALUE. */ 07270000 * A6C82: COPYVAL = COPYVAL - 1; 07280000 A6C82 LH @F,@D6 0227 07290000 AH @F,640(0,@5) 0227 07300000 STH @F,640(0,@5) 0227 07310000 * /*TEST IF COPY VALUE IS 0. */ 07320000 * IF COPYVAL = 0 THEN DO; 07330000 SR @F,@F 0228 07340000 CH @F,640(0,@5) 0228 07350000 BC 07,@9EC 0228 07360000 * /*STEP CARD COLUMN PTR. */ 07370000 * R9 = R9 + 1; 07380000 AH @9,@D2 0230 07390000 * /************************************************* 07400000 * /** AT THIS POINT ALL FD NAMES OF AN INNER PAREN-* 07410000 * /** THESES GROUP HAVE BEEN SCANNED. THIS SECT- * 07420000 * /** ION DOES GETMAIN OF 88 BYTES FOR A NEW FD * 07430000 * /** ADR. TABLE IF NECESSARY. 'NAMCTR' CONTAINS * 07440000 * /** NO. OF FD ADR'S. IN GROUP. * 07450000 * /************************************************* 07460000 * /*END OF INNER PARENTHESES GROUP. * 07470000 * GO TO A6C55; 07480000 BC 15,A6C55 0231 07490000 * END; 07500000 * /*POINT TO 1ST FD ADR IN COPY GROUP 07510000 * R4 = COPYFD; 07520000 @9EC L @4,644(0,@5) 0233 07530000 * /*POINT TO GM FOR 1ST COPY NAME. */ 07540000 * R6 = COPYFDGM; 07550000 L @6,648(0,@5) 0234 07560000 * /*LOAD COUNTER WITH NO. OF FD ADRS. 07570000 * /* TO BE COPIED. 07580000 * NAMCTR1 = NAMCTR; 07590000 MVC 654(2,@5),652(@5) 0235 07600000 * /*TEST IF ROOM IN CURRENT FD ADR */ 07610000 * /* GM FOR ANOTHER FD ADR ENTRY. */ 07620000 * A6D88: IF CURFD =< CURFDGM + 76 THEN DO; 07630000 A6D88 LA @F,76 0236 07640000 A @F,632(0,@5) 0236 07650000 C @F,352(0,@5) 0236 07660000 BC 04,@9EB 0236 07670000 * /*THERE IS ENOUGH ROOM. */ 07680000 * /*UPDATE PTR TO NEW ENTRY. */ 07690000 * CURFD = CURFD + 4; 07700000 LA @F,4 0238 07710000 A @F,352(0,@5) 0238 07720000 ST @F,352(0,@5) 0238 07730000 * GO TO A6C81; 07740000 BC 15,A6C81 0239 07750000 * END; 07760000 * /*GETMAIN 88 BYTES FOR A NEW FD */ 07770000 * /* ADR. TABLE. */ 07780000 * /*PUT LENGTH IN GM PARAMETER LIST. 07790000 * GLENGTH = 88; 07800000 @9EB LA @F,88 0241 07810000 ST @F,364(0,@5) 0241 07820000 * /*GO TO GETMAIN ROUTINE. */ 07830000 * CALL GETMAIN; 07840000 BAL @E,GETMAIN 0242 07850000 * /*CLEAR GETMAIN AREA. */ 07860000 * GCADDR -> AREA(1:88) = GCADDR -> AREA(1:88) && 07870000 * GCADDR -> AREA(1:88); 07880000 L @1,376(0,@5) 0243 07890000 XC 0(88,@1),0(@1) 0243 07900000 * /*CHAIN NEW FD ADR. TABLE TO */ 07910000 * /* PREVIOUS ONE. */ 07920000 * CURFDGM -> NXTFDGM = GCADDR; 07930000 L @2,632(0,@5) 0244 07940000 MVC 0(4,@2),376(@5) 0244 07950000 * /*UPDATE POINTER TO NEW GM. */ 07960000 * CURFDGM = GCADDR; 07970000 MVC 632(4,@5),376(@5) 0245 07980000 * /*UPDATE POINTER TO NEW ENTRY. */ 07990000 * CURFD = GCADDR + 4; 08000000 LA @F,4 0246 08010000 A @F,376(0,@5) 0246 08020000 ST @F,352(0,@5) 0246 08030000 * /*COPY FD ADR. TO NEW ENTRY. */ 08040000 * A6C81: CURFD -> FDADR = FDADR; 08050000 A6C81 L @1,352(0,@5) 0247 08060000 MVC 0(4,@1),0(@4) 0247 08070000 * /*DECREMENT 'NAMECTR1'. */ 08080000 * NAMCTR1 = NAMCTR1 - 1; 08090000 LH @F,@D6 0248 08100000 AH @F,654(0,@5) 0248 08110000 STH @F,654(0,@5) 0248 08120000 * /*TEST IF 'NAMECTR1' IS 09 */ 08130000 * IF NAMCTR1 = 0 THEN GO TO A6C82; 08140000 SR @F,@F 0249 08150000 CH @F,654(0,@5) 0249 08160000 BC 08,A6C82 0250 08170000 * /*STEP PTR TO NEXT FD ADR. */ 08180000 * R4 = R4 + 4; 08190000 AH @4,@D7 0251 08200000 * /*TEST IF LAST FD ADR IN THIS GM. * 08210000 * IF FDADR ^= 0 THEN GO TO A6D88; 08220000 C @F,0(0,@4) 0252 08230000 BC 07,A6D88 0253 08240000 * /*LAST FD ADR. GET ADR OF NEXT GM.* 08250000 * R6 = R6 -> NXTFDGM; 08260000 L @6,0(0,@6) 0254 08270000 * /*POINT TO 1ST FD ADR. */ 08280000 * R4 = R6 + 4; 08290000 LA @4,4 0255 08300000 AR @4,@6 0255 08310000 * GO TO A6D88; 08320000 BC 15,A6D88 0256 08330000 * /******************************************************************** 08340000 * /** FDSRCH - THIS SUBROUTINE WILL SCAN THE FD TABLES FOR AN EQUAL * 08350000 * /** NAME AND STORE THE ADR OF THE FD TABLE IN THE FD ADR * 08360000 * /** TABLE POINTED TO BY THE CREATE ENTRY. IF AN EQUAL NAME* 08370000 * /** IS NOT FOUND MSG 7 IS ISSUED. * 08380000 * /** ENTRY - R14 IS LINKAGE REGISTER. * 08390000 * /** R9 POINTS TO START OF NAME. * 08400000 * /** R7 CONTAINS LENGTH OF NAME. * 08410000 * /** EXIT - ENTRY REGISTERS ARE UNCHANGED. * 08420000 * /******************************************************************** 08430000 * FDSRCH:; 08440000 * /*SAVE REG 14 IN COMMON AREA. */ 08450000 * RECREM = R14; 08460000 FDSRCH ST @E,348(0,@5) 0258 08470000 * /*MOVE NAME TO 'Q' FOR COMPARE. */ 08480000 * Q(1:8) = INBUF(1:R7); 08490000 LR @1,@7 0259 08500000 BCTR @1,0 0259 08510000 LR @E,@9 0259 08520000 LA @A,216(0,@5) 0259 08530000 MVI 0(@A),C' ' 0259 08540000 MVC 1(007,@A),0(@A) 0259 08550000 EX @1,@MVC 0259 08560000 * /************************************************* 08570000 * /** WHILE SCANNING FD TABLES - * 08580000 * /** R4 POINTS TO CURRENT FD TABLE GETMAIN. * 08590000 * /** R6 POINTS TO CURRENT FD TABLE. * 08600000 * /************************************************* 08610000 * /*POINT TO 1ST FD TABLE GM. */ 08620000 * R4 = FDPTR1; 08630000 L @4,600(0,@5) 0260 08640000 * /*TEST IF NO FD TABLES PRESENT. */ 08650000 * IF R4 = 0 THEN GO TO A6C94; 08660000 LTR @4,@4 0261 08670000 BC 08,A6C94 0262 08680000 * /*POINT TO 1ST FD ENTRY. */ 08690000 * A6C93: R6 = R4; 08700000 A6C93 LR @6,@4 0263 08710000 * /*COMPARE NAME ON CREATE CARD TO */ 08720000 * /* NAME IN FD TABLE. */ 08730000 * A6C90: IF Q(1:8) = FDNAME THEN GO TO A6C91; 08740000 A6C90 CLC 216(8,@5),0(@6) 0264 08750000 BC 08,A6C91 0265 08760000 * /*UPDATE PTR TO NEXT FD ENTRY. */ 08770000 * R6 = R6 + 64; 08780000 AH @6,@D8 0266 08790000 * /*TEST IF ANOTHER FD ENTRY IN GM. * 08800000 * IF R6 -> AREA(1:4) ^= 0 THEN GO TO A6C90; 08810000 CLC 0(4,@6),@D9 0267 08820000 BC 07,A6C90 0268 08830000 * /*NO MORE FD ENTRIES IN THIS GM. */ 08840000 * /*TEST IF ANOTHER FD TABLE GM. */ 08850000 * IF R4 -> NXTFDTAB = 0 THEN DO; 08860000 SR @F,@F 0269 08870000 C @F,516(0,@4) 0269 08880000 BC 07,@9EA 0269 08890000 * /*NO FD TABLE FOR FD NAME SPECIFIED 08900000 * /* ON CREATE CARD. 08910000 * /*SET MSG 7. */ 08920000 * A6C94: MS = 7; 08930000 A6C94 LA @F,7 0271 08940000 STH @F,406(0,@5) 0271 08950000 * GO TO ERRORF; 08960000 BC 15,ERRORF 0272 08970000 * END; 08980000 * /*POINT TO NEXT FD TABLE GM. */ 08990000 * R4 = R4 -> NXTFDTAB; 09000000 @9EA L @4,516(0,@4) 0274 09010000 * GO TO A6C93; 09020000 BC 15,A6C93 0275 09030000 * /*TEST IF FIRSTSW IS ON. */ 09040000 * A6C91: IF FIRSTSW = ON THEN GO TO A6C92; 09050000 A6C91 CLC 637(1,@5),ON 0276 09060000 BC 08,A6C92 0277 09070000 * /*TEST IF ENOUGH ROOM IN FD ADR */ 09080000 * /* TABLE FOR NEW ENTRY. */ 09090000 * IF CURFD =< CURFDGM + 76 THEN DO; 09100000 LA @F,76 0278 09110000 A @F,632(0,@5) 0278 09120000 C @F,352(0,@5) 0278 09130000 BC 04,@9E9 0278 09140000 * /*THERE IS ENOUGH ROOM. */ 09150000 * /*UPDATE POINTER TO NEW ENTRY. */ 09160000 * CURFD = CURFD + 4; 09170000 LA @F,4 0280 09180000 A @F,352(0,@5) 0280 09190000 ST @F,352(0,@5) 0280 09200000 * GO TO A6C98; 09210000 BC 15,A6C98 0281 09220000 * END; 09230000 * /*GETMAIN 88 BYTES FOR A NEW FD */ 09240000 * /* ADR. TABLE. */ 09250000 * /*PUT LENGTH IN GM PARAMETER LIST. 09260000 * A6C92: GLENGTH = 88; 09270000 @9E9 EQU * 0283 09280000 A6C92 LA @F,88 0283 09290000 ST @F,364(0,@5) 0283 09300000 * /*GO TO GETMAIN ROUTINE. */ 09310000 * CALL GETMAIN; 09320000 BAL @E,GETMAIN 0284 09330000 * /*BASE POINTER FOR 'AREA'. */ 09340000 * R4 = GCADDR; 09350000 L @4,376(0,@5) 0285 09360000 * /*CLEAR GETMAIN AREA. */ 09370000 * AREA(1:88) = AREA(1:88) && AREA(1:88); 09380000 XC 0(88,@4),0(@4) 0286 09390000 * /*TEST IF FIRSTSW IS OFF. */ 09400000 * IF FIRSTSW = OFF THEN DO; 09410000 CLC 637(1,@5),OFF 0287 09420000 BC 07,@9E8 0287 09430000 * /*CHAIN NEW FD ADR. TABLE TO */ 09440000 * /* PREVIOUS ONE. */ 09450000 * CURFDGM -> NXTFDGM = R4; 09460000 L @1,632(0,@5) 0289 09470000 ST @4,0(0,@1) 0289 09480000 BC 15,@9E7 0291 09490000 * END; 09500000 * ELSE DO; 09510000 * /*STORE ADR. OF 1ST FD ADR. TABLE * 09520000 * /* IN CREATE ENTRY. * 09530000 * CURCRTE -> FDADTAB = R4; 09540000 @9E8 L @1,316(0,@5) 0292 09550000 ST @4,24(0,@1) 0292 09560000 * /*TURN OFF FIRSTSW. */ 09570000 * FIRSTSW = OFF; 09580000 MVC 637(1,@5),OFF 0293 09590000 * END; 09600000 * /*UPDATE POINTER TO NEW GM. */ 09610000 * CURFDGM = R4; 09620000 @9E7 ST @4,632(0,@5) 0295 09630000 * /*UPDATE POINTER TO NEW ENTRY. */ 09640000 * CURFD = R4 + 4; 09650000 LA @F,4 0296 09660000 AR @F,@4 0296 09670000 ST @F,352(0,@5) 0296 09680000 * /*STORE FD ADR. IN FD ADR. TABLE. * 09690000 * A6C98: CURFD -> FDADR = R6; 09700000 A6C98 L @1,352(0,@5) 0297 09710000 ST @6,0(0,@1) 0297 09720000 * /*RESTORE REG 14. */ 09730000 * R14 = RECREM; 09740000 L @E,348(0,@5) 0298 09750000 * /*RETURN TO CALLER. */ 09760000 * GO TO R14; 09770000 BCR 15,@E 0299 09780000 * /******************************************************************** 09790000 * /** PROCESS PICTURE KEYWORD. * 09800000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 09810000 * /** EXIT - R8 POINTS TO DELIMITER FOLLOWING PICTURE * 09820000 * /** PARAMETERS. * 09830000 * /** FORMAT - PICTURE=LENGTH,STARTLOC,'EBCDIC STRING' OR * 09840000 * /** P'DECIMAL VALUE' OR * 09850000 * /** B'DECIMAL VALUE' * 09860000 * /** LENGTH IS THE NO. OF BYTES THE PICTURE FIELD WILL * 09870000 * /** OCCUPY IN THE LOGICAL RECORD. * 09880000 * /** STARTLOC IS THE RELATIVE POSITION TO 0 IN THE LOGICAL * 09890000 * /** RECORD WHERE THE PICTURE FIELD WILL START. * 09900000 * /** 'P' TYPE STRING - THE DECIMAL VALUE WILL BE CONVERTED * 09910000 * /** TO PACKED DECIMAL AND PLACED RIGHT-JUSTIFIED IN THE * 09920000 * /** PICTURE FIELD. * 09930000 * /** 'B' TYPE STRING - THE DECIMAL VALUE WILL BE CONVERTED * 09940000 * /** TO A BINARY NO. AND PLACED RIGHT-JUSTIFIED IN THE * 09950000 * /** PICTURE FIELD. * 09960000 * /******************************************************************** 09970000 * A6D1:; 09980000 * /*ADVANCE CARD COLUMN PTR TO START 09990000 * /* OF PARAMETER. 10000000 * R9 = R9 + 8; 10010000 A6D1 AH @9,@D10 0301 10020000 * /************************************************* 10030000 * /** PROCESS PICTURE LENGTH. * 10040000 * /************************************************* 10050000 * /*GO TO SCAN OUT FIRST SUBPARAMETER 10060000 * /* (PICTURE LENGTH). 10070000 * CALL SPSCAN; 10080000 BAL @E,SPSCAN 0302 10090000 * /*GO TO CONVERT QUANTITY TO BINARY. 10100000 * CALL CONVDB; 10110000 BAL @E,CONVDB 0303 10120000 * /*INCREMENT PICUTRE LENGTH + 6 FOR 10130000 * /* SIZE OF PICTURE TABLE. 10140000 * /*PUT LENGTH IN GM PARAMETER LIST. 10150000 * GLENGTH = R6 + 6; 10160000 LA @F,6 0304 10170000 AR @F,@6 0304 10180000 ST @F,364(0,@5) 0304 10190000 * /*GO TO GETMAIN ROUTINE. */ 10200000 * CALL GETMAIN; 10210000 BAL @E,GETMAIN 0305 10220000 * /*PUT GM ADDRESS IN BASE FOR */ 10230000 * /* PICTURE TABLE. */ 10240000 * PICBASE = GCADDR; 10250000 MVC 664(4,@5),376(@5) 0306 10260000 * /*STORE PICTURE LENGTH IN PICTURE * 10270000 * /* TABLE. * 10280000 * PICLGTH = R6; 10290000 L @1,664(0,@5) 0307 10300000 STH @6,4(0,@1) 0307 10310000 * /* STORE ADDR OF PICTURE TABLE */ 10320000 * /* IN CREATE ENTRY. */ 10330000 * CURCRTE -> PICPTR = ADDR(CRPICT); 10340000 L @2,316(0,@5) 0308 10350000 ST @1,16(0,@2) 0308 10360000 * /*UPDATE CARD COL PTR TO DELIMITER 10370000 * /* AFTER PICTURE LENGTH. 10380000 * R9 = R8; 10390000 LR @9,@8 0309 10400000 * /*************************************** 10410000 * /**THIS SECTION TESTS IF PICTURE START * 10420000 * /** LOCATION IS ON THIS CARD OR IF IT * 10430000 * /** CONTINUED ONTO NEXT CARD. * 10440000 * /*************************************** 10450000 * /*TEST IF COMMA AFTER LENGTH */ 10460000 * /* SUBPARAMETER. IF NOT, GO */ 10470000 * /* TO ISSUE MESSAGE #3. */ 10480000 * IF INBUF(1) ^= ',' THEN GO TO MSG3; 10490000 CLI 0(@9),C',' 0310 10500000 BC 07,MSG3 0311 10510000 * /*TEST IF COMMA IS IN COL 71.*/ 10520000 * IF R9 = COUNTER THEN GO TO A6D2; 10530000 C @9,232(0,@5) 0312 10540000 BC 08,A6D2 0313 10550000 * /*STEP CARD COLUMN PTR.*/ 10560000 * R9 = R9 + 1; 10570000 AH @9,@D2 0314 10580000 * /*TEST IF COLUMN PAST COMMA IS */ 10590000 * /* BLANK. */ 10600000 * IF INBUF(1) = ' ' THEN DO; 10610000 CLI 0(@9),C' ' 0315 10620000 BC 07,@9E6 0315 10630000 * /*CONTINUATION AFTER 1ST PICTURE */ 10640000 * /* SUBPARAMETER IS INDICATED. */ 10650000 * /*SET PICCSW1. */ 10660000 * A6D2: PICCSW(1) = '1'B; 10670000 A6D2 OI 562(@5),B'10000000' 0317 10680000 * /*TURN ON CREATE CONT. SW. */ 10690000 * A6D3: CRCSW = ON; 10700000 A6D3 MVC 554(1,@5),ON 0318 10710000 * /*GO TO IEBDG TO READ CONTINUATION 10720000 * /*CARD. 10730000 * GO TO RETURN2; 10740000 BC 15,RETURN2 0319 10750000 * END; 10760000 * /************************************************* 10770000 * /** PROCESS PICTURE START LOCATION. * 10780000 * /************************************************* 10790000 * /*GO TO SCAN OUT 2ND SUBPARAMETER.* 10800000 * /* (PICTURE START LOC). * 10810000 * A6D4: CALL SPSCAN; 10820000 @9E6 EQU * 0321 10830000 A6D4 BAL @E,SPSCAN 0321 10840000 * /*GO TO CONVERT QUANTITY TO BINARY. 10850000 * CALL CONVDB; 10860000 BAL @E,CONVDB 0322 10870000 * /*STORE PICTURE START LOC. IN */ 10880000 * /* CREATE ENTRY. */ 10890000 * PICSTLOC = R6 - 1; 10900000 LR @F,@6 0323 10910000 BCTR @F,0 0323 10920000 L @1,664(0,@5) 0323 10930000 ST @F,0(0,@1) 0323 10940000 * /*UPDATE CARD COL PTR TO DELIMITER 10950000 * /* AFTER PICTURE LENGTH. 10960000 * R9 = R8; 10970000 LR @9,@8 0324 10980000 * /*************************************** 10990000 * /**THIS SECTION TESTS IF PICTURE STRING* 11000000 * /** IS ON THIS CARD OR IF IT IS * 11010000 * /** CONTINUED ONTO NEXT CARD. * 11020000 * /*************************************** 11030000 * /*TEST IF COMMA AFTER START LOC */ 11040000 * /* SUBPARAMETER. IF NOT, GO TO */ 11050000 * /* ISSUE MESSAGE #3. */ 11060000 * IF INBUF(1) ^= ',' THEN GO TO MSG3; 11070000 CLI 0(@9),C',' 0325 11080000 BC 07,MSG3 0326 11090000 * /*TEST IF COMMA IS IN COL 71.*/ 11100000 * IF R9 = COUNTER THEN GO TO A6D5; 11110000 C @9,232(0,@5) 0327 11120000 BC 08,A6D5 0328 11130000 * /*STEP CARD COLUMN PTR.*/ 11140000 * R9 = R9 + 1; 11150000 AH @9,@D2 0329 11160000 * /*TEST IF COLUMN PAST COMMA IS */ 11170000 * /* BLANK. */ 11180000 * IF INBUF(1) = ' ' THEN DO; 11190000 CLI 0(@9),C' ' 0330 11200000 BC 07,@9E5 0330 11210000 * /*CONTINUATION AFTER 2ND PICTURE */ 11220000 * /* SUBPARAMETER IS INDICATED. */ 11230000 * /* SET PICCSW2. */ 11240000 * A6D5: PICCSW(2) = '1'B; 11250000 A6D5 OI 562(@5),B'01000000' 0332 11260000 * /*GO TO SET CRCSW.*/ 11270000 * GO TO A6D3; 11280000 BC 15,A6D3 0333 11290000 * END; 11300000 * /************************************************* 11310000 * /** PROCESS EBCDIC PICTURE. * 11320000 * /** PICTURE LENGTH IS USED TO DETERMINE * 11330000 * /** IF THE STRING TERMINATES ON THIS CARD OR * 11340000 * /** IF A CONTINUATION CARD IS NECESSARY TO * 11350000 * /** SATISFY LENGTH. THE STRING IS MOVED FROM * 11360000 * /** THE CARD TO THE PICTURE TABLE AS EACH CARD* 11370000 * /** IS READ IF NECESSARY. 'CURPIC' POINTS TO * 11380000 * /** LOCATION IN PICTURE TABLE WHERE NEXT * 11390000 * /** PORTION OF STRING IS TO BE MOVED. * 11400000 * /************************************************* 11410000 * /*INITIALIZE PTR TO START OF */ 11420000 * /* PICTURE STRING. */ 11430000 * A6D6: CURPIC = ADDR(PICSTRNG); 11440000 @9E5 EQU * 0335 11450000 A6D6 L @1,664(0,@5) 0335 11460000 LA @F,6(0,@1) 0335 11470000 ST @F,324(0,@5) 0335 11480000 * /*INITIALIZE PICCTR TO PICTURE */ 11490000 * /* LENGTH. */ 11500000 * PICCTR = PICLGTH; 11510000 L @1,664(0,@5) 0336 11520000 LH @F,4(0,@1) 0336 11530000 ST @F,328(0,@5) 0336 11540000 * /*TEST IF COLUMN IS A QUOTE.*/ 11550000 * IF INBUF(1) ^= '''' THEN GO TO A6D65; 11560000 CLI 0(@9),C'''' 0337 11570000 BC 07,A6D65 0338 11580000 * PICCSW(4) = '1'B ; /* SET SW. BUSY WITH PIC A41807* 11590000 OI 562(@5),B'00010000' 0339 11600000 * /*TEST IF QUOTE IS IN COL 71.*/ 11610000 * IF R9 = COUNTER THEN GO TO A6D73; 11620000 C @9,232(0,@5) 0340 11630000 BC 08,A6D73 0341 11640000 * /*PICTURE STRING IS IN EBCDIC. */ 11650000 * /*ADVANCE CARD COLUMN PTR.*/ 11660000 * R9 = R9 + 1; 11670000 AH @9,@D2 0342 11680000 * /*TEST IF EBCDIC STRING ON THIS */ 11690000 * /* CARD IS GT THE PICTURE LENGTH.*/ 11700000 * IF PICCTR => COUNTER - R9 + 1 THEN GO TO A6D68; 11710000 LA @F,1 0343 11720000 SR @F,@9 0343 11730000 A @F,232(0,@5) 0343 11740000 C @F,328(0,@5) 0343 11750000 BC 12,A6D68 0344 11760000 * /*REMAINDER OF PICTURE STRING IS */ 11770000 * /* CONTAINED ON THIS CARD. */ 11780000 * /*MOVE STRING FROM CARD TO PICTURE* 11790000 * /* TABLE ACCORDING TO LENGTH * 11800000 * /* REMAINING IN PICCTR. * 11810000 * A6D71: CURPIC -> AREA(1:PICCTR) = INBUF; 11820000 A6D71 LR @E,@9 0345 11830000 L @1,328(0,@5) 0345 11840000 BCTR @1,0 0345 11850000 L @2,324(0,@5) 0345 11860000 LR @A,@2 0345 11870000 EX @1,@MVC 0345 11880000 * /*ADVANCE CARD COLUMN PTR TO COL */ 11890000 * /* PAST PICTURE STRING. */ 11900000 * R9 = R9 + PICCTR; 11910000 A @9,328(0,@5) 0346 11920000 * /*TEST IF COLUMN IS A QUOTE. IF NOT 11930000 * /* GO TO ISSUE MESSAGE #3. 11940000 * A6D72: IF INBUF(1) ^= '''' THEN GO TO MSG3; 11950000 A6D72 CLI 0(@9),C'''' 0347 11960000 BC 07,MSG3 0348 11970000 * /*SET R8 TO DELIMITER FOLLOWING */ 11980000 * /* LAST PICTURE PARAMETER. */ 11990000 * PICCSW(4) = '0'B ; /* READY WITH PICTURE A41807* 12000000 NI 562(@5),B'11101111' 0349 12010000 * R8 = R9 + 1; 12020000 LA @8,1 0350 12030000 AR @8,@9 0350 12040000 * /*PICTURE KEYWORD HAS BEEN * 12050000 * /* PROCESSED. GO TO SCAN OUT NEXT * 12060000 * /* KEYWORD. * 12070000 * GO TO CARDSCAN; 12080000 BC 15,CARDSCAN 0351 12090000 * /*CALCULATE NO. OF BYTES TO BE */ 12100000 * /* MOVED. */ 12110000 * A6D68: R6 = COUNTER - R9 + 1; 12120000 A6D68 LA @6,1 0352 12130000 SR @6,@9 0352 12140000 A @6,232(0,@5) 0352 12150000 * /*MOVE PICTURE STRING FROM CARD TO 12160000 * /* PICTURE TABLE. STRING IS CONT- 12170000 * /* AINED IN COLUMNS FROM WHERE R9 12180000 * /* POINTS TO COLUMN 71. 12190000 * CURPIC -> AREA(1:R6) = INBUF; 12200000 LR @E,@9 0353 12210000 LR @1,@6 0353 12220000 BCTR @1,0 0353 12230000 L @2,324(0,@5) 0353 12240000 LR @A,@2 0353 12250000 EX @1,@MVC 0353 12260000 * /*DECREMENT PICCTR BY NO. IF BYTES* 12270000 * /* MOVED. * 12280000 * A6D69: PICCTR = PICCTR - R6; 12290000 A6D69 LCR @F,@6 0354 12300000 A @F,328(0,@5) 0354 12310000 ST @F,328(0,@5) 0354 12320000 * /*UPDATE CURPIC TO POINT TO NEXT 12330000 * /* POSITION IN PICTURE TABLE STRING 12340000 * CURPIC = CURPIC + R6; 12350000 LR @F,@6 0355 12360000 A @F,324(0,@5) 0355 12370000 ST @F,324(0,@5) 0355 12380000 * /*CONTINUATION OF PICTURE STRING IS 12390000 * /* INDICATED. 12400000 * /*SET PICCSW3. 12410000 * A6D73: PICCSW(3) = '1'B; 12420000 A6D73 OI 562(@5),B'00100000' 0356 12430000 * /*GO TO SET CRCSW.*/ 12440000 * GO TO A6D3; 12450000 BC 15,A6D3 0357 12460000 * /*************************************** 12470000 * /** CONTROL IS TRANSFERRED TO THIS * 12480000 * /** POINT IF A CONTINUATION CARD WAS * 12490000 * /** READ. * 12500000 * /*************************************** 12510000 * /*TEST IF REMAINING LENGTH OF */ 12520000 * /* STRING IS GT 67. */ 12530000 * A6D7: IF PICCTR > 67 THEN DO; 12540000 A6D7 LA @F,67 0358 12550000 C @F,328(0,@5) 0358 12560000 BC 10,@9E4 0358 12570000 * /*STRING DOESN'T TERMINATE ON THIS 12580000 * /* CARD. 12590000 * /*MOVE 68 CHARS FROM COL 4 TO COL 12600000 * /* 71 TO PICTURE TABLE STRING. 12610000 * CURPIC -> AREA(1:68) = INBUF; 12620000 L @1,324(0,@5) 0360 12630000 MVC 0(68,@1),0(@9) 0360 12640000 * /*PUT NO. CHARS MOVED IN R6. */ 12650000 * R6 = 68; 12660000 LA @6,68 0361 12670000 * /*LOOP BACK TO PROCESS REMAINDER */ 12680000 * /* OF PICTURE STRING. */ 12690000 * GO TO A6D69; 12700000 BC 15,A6D69 0362 12710000 * END; 12720000 * /*TEST IF LENGTH OF PICTURE */ 12730000 * /* REMAINING IS 0. */ 12740000 * IF PICCTR = 0 THEN GO TO A6D72; 12750000 @9E4 SR @F,@F 0364 12760000 C @F,328(0,@5) 0364 12770000 BC 08,A6D72 0365 12780000 * /*GO TO MOVE REMAINING STRING.*/ 12790000 * GO TO A6D71; 12800000 BC 15,A6D71 0366 12810000 * /************************************************* 12820000 * /** PROCESS PACKED DECIMAL OR BINARY PICTURE * 12830000 * /** STRING. * 12840000 * /** THESE STRINGS MUST BE CONTAINED ON ONE * 12850000 * /** CARD AND MAY NOT BE CONTINUED. * 12860000 * /************************************************* 12870000 * /*TEST IF START OF PICTURE STRING * 12880000 * /* IS P'. * 12890000 * A6D65: IF INBUF(1:2) = 'P''' THEN DO; 12900000 A6D65 CLC 0(2,@9),@C16 0367 12910000 BC 07,@9E3 0367 12920000 * /*TURN ON PICCSW5.*/ 12930000 * PICCSW(5) = '1'B; 12940000 OI 562(@5),B'00001000' 0369 12950000 * GO TO A6D79; 12960000 BC 15,A6D79 0370 12970000 * END; 12980000 * /*TEST IF START OF PICTURE STRING * 12990000 * /* IS B'. IF NOT, GO TO SET * 13000000 * /* MESSAGE #3. * 13010000 * IF INBUF(1:2) ^= 'B''' THEN GO TO MSG3; 13020000 @9E3 CLC 0(2,@9),@C17 0372 13030000 BC 07,MSG3 0373 13040000 * /*TURN ON PICCSW6. */ 13050000 * PICCSW(6) = '1'B; 13060000 OI 562(@5),B'00000100' 0374 13070000 * /*INITIALIZE PICCTR TO 0.*/ 13080000 * A6D79: PICCTR = 0; 13090000 A6D79 SR @F,@F 0375 13100000 ST @F,328(0,@5) 0375 13110000 * /*************************************** 13120000 * /** THIS SECTION SCANS THE STRING * 13130000 * /** LOOKING FOR AN ENDING QUOTE. * 13140000 * /*************************************** 13150000 * /*ADVANCE CARD COLUMN PTR TO START 13160000 * /* OF STRING. 13170000 * R9 = R9 + 2; 13180000 AH @9,@D11 0376 13190000 * R8 = R9; 13200000 LR @8,@9 0377 13210000 * /*TEST IF COLUMN IS A QUOTE */ 13220000 * /* (ENDING QUOTE). */ 13230000 * A6D8: IF R8 -> INBUF(1) = '''' THEN GO TO A6D81; 13240000 A6D8 CLI 0(@8),C'''' 0378 13250000 BC 08,A6D81 0379 13260000 * /*STEP PICCTR BY 1.*/ 13270000 * PICCTR = PICCTR + 1; 13280000 LA @F,1 0380 13290000 A @F,328(0,@5) 0380 13300000 ST @F,328(0,@5) 0380 13310000 * /*TEST IF PICCTR IS GT 16.*/ 13320000 * IF PICCTR > 16 THEN DO; 13330000 LA @F,16 0381 13340000 C @F,328(0,@5) 0381 13350000 BC 10,@9E2 0381 13360000 * /*PACKED DECIMAL OR BINARY PICTURE* 13370000 * /* TOO LONG. * 13380000 * /*SET MSG 8. */ 13390000 * MS = 8; 13400000 LA @F,8 0383 13410000 STH @F,406(0,@5) 0383 13420000 * GO TO ERRORF; 13430000 BC 15,ERRORF 0384 13440000 * RETURN; 13450000 * END; 13460000 * /*TEST IF AT COL 71.*/ 13470000 * IF R8 => COUNTER THEN DO; 13480000 @9E2 C @8,232(0,@5) 0387 13490000 BC 04,@9E1 0387 13500000 * /*PARAMETER EXTENDS INTO COL 72. */ 13510000 * /*SET MSG 21. */ 13520000 * MS = 21; 13530000 LA @F,21 0389 13540000 STH @F,406(0,@5) 0389 13550000 * GO TO ERRORF; 13560000 BC 15,ERRORF 0390 13570000 * END; 13580000 * /*ADVANCE CARD COLUMN PTR.*/ 13590000 * R8 = R8 + 1; 13600000 @9E1 AH @8,@D2 0392 13610000 * /*LOOP BACK TO SCAN NEXT COLUMN.*/ 13620000 * GO TO A6D8; 13630000 BC 15,A6D8 0393 13640000 * /*TEST IF BYTE COUNTER IS 0. IF SO, 13650000 * /* GO TO SET MESSAGE #6. 13660000 * A6D81: IF PICCTR = 0 THEN DO; 13670000 A6D81 SR @F,@F 0394 13680000 C @F,328(0,@5) 0394 13690000 BC 07,@9E0 0394 13700000 * /*NO STRING SUPPLIED. */ 13710000 * /*GO TO SET MSG 3. */ 13720000 * GO TO MSG3; 13730000 BC 15,MSG3 0396 13740000 * END; 13750000 * /*************************************** 13760000 * /** PICTURE STRING IN PICTURE TABLE * 13770000 * /** MUST BE CLEARED TO ZEROES TO PRO- * 13780000 * /** VIDE LEADING ZEROES FOR THE VALUE.* 13790000 * /*************************************** 13800000 * /*GET LENGTH OF PICTURE STRING. */ 13810000 * R6 = PICLGTH; 13820000 @9E0 L @1,664(0,@5) 0398 13830000 LH @6,4(0,@1) 0398 13840000 * /*GET ADDRESS OF PICTURE STRING. */ 13850000 * R7 = ADDR(PICSTRNG); 13860000 LA @7,6(0,@1) 0399 13870000 * /*TEST IF LENGTH IS GT 256. */ 13880000 * A6D83: IF R6 > 256 THEN DO; 13890000 A6D83 CH @6,@D12 0400 13900000 BC 12,@9DF 0400 13910000 * /*CLEAR 256 BYTES. */ 13920000 * GEN( XC 0(256,R7),0(R7)); 13930000 XC 0(256,R7),0(R7) 13940000 DS 0H 13950000 * /*DECREMENT LENGTH BY 256. */ 13960000 * R6 = R6 - 256; 13970000 SH @6,@D12 0403 13980000 * /*INCREMENT ADDRESS BY 256. */ 13990000 * R7 = R7 + 256; 14000000 AH @7,@D12 0404 14010000 * /*LOOP BACK TO CLEAR MORE. */ 14020000 * GO TO A6D83; 14030000 BC 15,A6D83 0405 14040000 * END; 14050000 * /*PUT LENGTH - 1 INTO R6. */ 14060000 * R6 = R6 - 1; 14070000 @9DF BCTR @6,0 0407 14080000 * /*CLEAR REMAINDER OF AREA. */ 14090000 * GEN( EX R6,CLEAR); 14100000 EX R6,CLEAR 14110000 DS 0H 14120000 * GO TO A6D87; 14130000 BC 15,A6D87 0409 14140000 * CLEAR: GEN( XC 0(1,R7),0(R7)); 14150000 CLEAR XC 0(1,R7),0(R7) 14160000 DS 0H 14170000 * /*FIND LENGTH OF STRING ON CARD. */ 14180000 * A6D87: R7 = R8 - R9; 14190000 A6D87 LCR @7,@9 0411 14200000 AR @7,@8 0411 14210000 * /*************************************** 14220000 * /** CALL 'CONVDB' ROUTINE. * 14230000 * /** PACKED DECIMAL STRING - NO. IS * 14240000 * /** PACKED INTO 'Q'. * 14250000 * /** BINARY STRING - NO. IS PACKED AND* 14260000 * /** CONVERTED TO BINARY IN REG 6. * 14270000 * /*************************************** 14280000 * CALL CONVDB; 14290000 BAL @E,CONVDB 0412 14300000 * /*TEST IF PACKED DECIMAL STRING.*/ 14310000 * IF PICCSW(5) = '0'B THEN GO TO A6D84; 14320000 TM 562(@5),B'00001000' 0413 14330000 BC 08,A6D84 0414 14340000 * /************************************************* 14350000 * /** PROCESS PACKED DECIMAL PICTURE. * 14360000 * /** PACKED NO. IS MOVED FROM 'Q' INTO PICTURE * 14370000 * /** AND RIGHT-JUSTIFIED. * 14380000 * /************************************************* 14390000 * /*PICTURE IS PACKED DECIMAL. */ 14400000 * /*CLEAR SWITCH.*/ 14410000 * PICCSW(5) = '0'B; 14420000 NI 562(@5),B'11110111' 0415 14430000 * /*CALCULATE NO. OF BYTES TO MOVE */ 14440000 * /* BY, LENGTH OF STRING ON CARD */ 14450000 * /* / 2 + 1. */ 14460000 * R6 = R7 / 2 + 1; 14470000 LR @E,@7 0416 14480000 SRA @E,1 0416 14490000 AH @E,@D2 0416 14500000 LR @6,@E 0416 14510000 * /*MOVE PACKED DECIMAL NUMBER FROM * 14520000 * /* Q TO PICTURE TABLE. * 14530000 * /*MAKE SIGN OF PACKED DECML NO. A * 14540000 * /* STANDARD PLUS SIGN. * 14550000 * Q(16) = Q(16) & 'FC'X; 14560000 NI 231(@5),X'FC' 0417 14570000 * /*CALCULATE FROM ADDRESS. */ 14580000 * R9 = ADDR(Q) + 16 - R6; 14590000 LCR @F,@6 0418 14600000 AH @F,@D13 0418 14610000 LA @0,216(0,@5) 0418 14620000 AR @F,@0 0418 14630000 LR @9,@F 0418 14640000 * /*CALCULATE TO ADDRESS. */ 14650000 * R7 = ADDR(PICSTRNG) + PICLGTH - R6; 14660000 LCR @F,@6 0419 14670000 L @1,664(0,@5) 0419 14680000 AH @F,4(0,@1) 0419 14690000 LA @0,6(0,@1) 0419 14700000 AR @F,@0 0419 14710000 LR @7,@F 0419 14720000 * R7 -> AREA(1:R6) = R9 -> AREA(1:R6); 14730000 LR @E,@9 0420 14740000 LR @2,@6 0420 14750000 BCTR @2,0 0420 14760000 LR @A,@7 0420 14770000 EX @2,@MVC 0420 14780000 * /*UPDATE CARD COLUMN PTR TO */ 14790000 * /* DELIMITER AFTER STRING QUOTE. */ 14800000 * A6D85: R8 = R8 + 1; 14810000 A6D85 AH @8,@D2 0421 14820000 * /*PICTURE KEYWORD HAS BEEN * 14830000 * /* PROCESSED. GO TO SCAN OUT NEXT * 14840000 * /* KEYWORD. * 14850000 * GO TO CARDSCAN; 14860000 BC 15,CARDSCAN 0422 14870000 * /************************************************* 14880000 * /** PROCESS BINARY PICTURE. * 14890000 * /** BINARY VALUE IS PLACED RIGHT JUSTIFIED IN * 14900000 * /** THE PICTURE TABLE. * 14910000 * /************************************************* 14920000 * /*PICTURE IS BINARY. */ 14930000 * /*CLEAR SWITCH. */ 14940000 * A6D84: PICCSW(6) = '0'B; 14950000 A6D84 NI 562(@5),B'11111011' 0423 14960000 * /*SET R7 TO PICTURE LENGTH. */ 14970000 * R7 = PICLGTH; 14980000 L @1,664(0,@5) 0424 14990000 LH @7,4(0,@1) 0424 15000000 * /*TEST IF LENGTH IS EQ OR GT 4. */ 15010000 * IF R7 => 4 THEN DO; 15020000 CH @7,@D7 0425 15030000 BC 04,@9DE 0425 15040000 * /*ADJUST R7 FOR A MOVE OF 4 BYTES. 15050000 * R7 = 4; 15060000 LA @7,4 0427 15070000 * GO TO A6D86; 15080000 BC 15,A6D86 0428 15090000 * END; 15100000 * /*TEST IF LENGTH IS 3. */ 15110000 * IF R7 = 3 THEN DO; 15120000 @9DE CH @7,@D3 0430 15130000 BC 07,@9DD 0430 15140000 * /*SHIFT NO. LEFT 1 BYTE. */ 15150000 * GEN( SLL R6,8); 15160000 SLL R6,8 15170000 DS 0H 15180000 * GO TO A6D86; 15190000 BC 15,A6D86 0433 15200000 * END; 15210000 * /*TEST IF LENGTH IS 2. */ 15220000 * IF R7 = 2 THEN DO; 15230000 @9DD CH @7,@D11 0435 15240000 BC 07,@9DC 0435 15250000 * /*SHIFT NO. LEFT 2 BYTES. */ 15260000 * GEN( SLL R6,16); 15270000 SLL R6,16 15280000 DS 0H 15290000 * GO TO A6D86; 15300000 BC 15,A6D86 0438 15310000 * END; 15320000 * /*LENGTH IS 1. SHIFT NO. LEFT 3 */ 15330000 * /* BYTES. */ 15340000 * GEN( SLL R6,24); 15350000 @9DC EQU * 0440 15360000 SLL R6,24 15370000 DS 0H 15380000 * /*MOVE BINARY VALUE TO Q. */ 15390000 * A6D86: Q(1:4) = R6; 15400000 A6D86 ST @6,@TEMP4 0441 15410000 MVC 216(4,@5),@TEMP4 0441 15420000 * /********************************** 15430000 * /** MOVE BINARY VALUE TO PICTURE * 15440000 * /** TABLE. * 15450000 * /********************************** 15460000 * /*CALCULATE TO ADDRESS. */ 15470000 * R6 = ADDR(PICSTRNG) + PICLGTH - R7; 15480000 LCR @F,@7 0442 15490000 L @1,664(0,@5) 0442 15500000 AH @F,4(0,@1) 0442 15510000 LA @0,6(0,@1) 0442 15520000 AR @F,@0 0442 15530000 LR @6,@F 0442 15540000 * R6 -> AREA(1:R7) = Q(1:R7); 15550000 LA @E,216(0,@5) 0443 15560000 LR @2,@7 0443 15570000 BCTR @2,0 0443 15580000 LR @A,@6 0443 15590000 EX @2,@MVC 0443 15600000 * GO TO A6D85; 15610000 BC 15,A6D85 0444 15620000 * /******************************************************************** 15630000 * /** PROCESS FILL KEYWORD. * 15640000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 15650000 * /** EXIT - R8 POINTS TO DELIMITER FOLLOWING FILL PARAMETER. * 15660000 * /** FORMAT - FILL='C' 1 EBCDIC CHAR. * 15670000 * /** FILL=X'XX' 2 HEX DIGITS. * 15680000 * /******************************************************************** 15690000 * A6E1:; 15700000 * /*ADVANCE COLUMN POINTER TO START * 15710000 * /* OF PARAMETER. * 15720000 * R9 = R9 + 5; 15730000 A6E1 AH @9,@D5 0446 15740000 * /*TEST IF AT OR PAST COL 72.*/ 15750000 * IF R9 > COUNTER THEN GO TO A6E4; 15760000 C @9,232(0,@5) 0447 15770000 BC 02,A6E4 0448 15780000 * /*TEST IF HEX FORMAT.*/ 15790000 * IF INBUF(1) = 'X' THEN GO TO A6E5; 15800000 CLI 0(@9),C'X' 0449 15810000 BC 08,A6E5 0450 15820000 * /************************************************* 15830000 * /** FILL CHAR. IS EBCDIC. * 15840000 * /** CHARACTER IS MOVED DIRECTLY FROM CARD TO * 15850000 * /** CREATE ENTRY. * 15860000 * /************************************************* 15870000 * /*FILL IS EBCDIC CHAR.*/ 15880000 * /*TEST IF QUOTE. */ 15890000 * IF INBUF(1) = '''' THEN GO TO A6E3; 15900000 CLI 0(@9),C'''' 0451 15910000 * /*IMPROPER SYNTAX. */ 15920000 * /*GO TO SET MSG 3. */ 15930000 * GO TO MSG3; 15940000 BC 07,MSG3 0453 15950000 * /*TEST IF QUOTE.*/ 15960000 * A6E3: IF INBUF(3) ^= '''' THEN GO TO MSG3; 15970000 A6E3 CLI 2(@9),C'''' 0454 15980000 BC 07,MSG3 0455 15990000 * /*PUT FILL CHAR IN CREATE ENTRY.*/ 16000000 * A6E35: CURCRTE -> FILLCH = INBUF(2); 16010000 A6E35 SR @F,@F 0456 16020000 IC @F,1(0,@9) 0456 16030000 L @1,316(0,@5) 0456 16040000 STC @F,20(0,@1) 0456 16050000 * /*POINT TO END OF PARAMETER.*/ 16060000 * R8 = R9 + 3; 16070000 LA @8,3 0457 16080000 AR @8,@9 0457 16090000 * /*TEST IF NOT AT COL 72. IF NOT, 16100000 * /* FILL KEYWORD HAS BEEN PROCESSED. 16110000 * /* GO TO SCAN NEXT KEYWORD. 16120000 * A6E36: IF R8 ^> COUNTER+1 /* NOT PAST COLUMN 72 A38781* 16130000 * THEN DO ; /* CHECK IF AT COL 72 A38781* 16140000 A6E36 LA @F,1 0458 16150000 A @F,232(0,@5) 0458 16160000 CR @F,@8 0458 16170000 BC 04,@9DB 0458 16180000 * IF R8 = COUNTER+1 /* POINTER JUST AT COL72A38781* 16190000 * THEN DO ; /* CHECK IF CONTINUATIONA38781* 16200000 LA @F,1 0460 16210000 A @F,232(0,@5) 0460 16220000 CR @F,@8 0460 16230000 BC 07,@9DA 0460 16240000 * IF R8 -> INBUF(1) ^= ' ' /* REQUIRED A38781* 16250000 * THEN DO ; /* COMMENT CONTINUATION A38781* 16260000 CLI 0(@8),C' ' 0462 16270000 BC 08,@9D9 0462 16280000 * CRCSW = ON ; /* CREATE CONT.SW. ONA38781* 16290000 MVC 554(1,@5),ON 0464 16300000 * COMCSW = ON ; /*CREATE COMMENT SW A38781* 16310000 MVC 565(1,@5),ON 0465 16320000 * GO TO RETURN2 ; /* READ NEXT CARD A38781* 16330000 BC 15,RETURN2 0466 16340000 * END ; /* END OF CONT. CHECK A38781* 16350000 * GO TO CREATE ; /* NO CONT.SO END CREATEA38781* 16360000 * END ; /* NOT IN COL72,BUT LESSA38781* 16370000 * GO TO CARDSCAN ; /* THEREFORE GO ON SCANNING * 16380000 * /* CREATE CARD A38781* 16390000 * END ; /* POINTER PAST COL 72 A38781* 16400000 * A6E4: MS = 21 /*PARAMETER EXTENDS INTO COL 72.*/; 16410000 @9DB EQU * 0472 16420000 A6E4 LA @F,21 0472 16430000 STH @F,406(0,@5) 0472 16440000 * GO TO ERRORF; 16450000 BC 15,ERRORF 0473 16460000 * A6E5: 16470000 * /************************************************* 16480000 * /** FILL CHAR. IS HEX. * 16490000 * /** EACH CHAR. IS TESTED FOR VALIDITY AND THEN* 16500000 * /** IS CONVERTED TO HEX. * 16510000 * /************************************************* 16520000 * /*HEX FORMAT. TEST IF QUOTE.*/ 16530000 * IF INBUF(2) ^= '''' THEN GO TO MSG3; 16540000 A6E5 CLI 1(@9),C'''' 0474 16550000 BC 07,MSG3 0475 16560000 * /*TEST IF QUOTE.*/ 16570000 * IF INBUF(5) ^= '''' THEN GO TO MSG3; 16580000 CLI 4(@9),C'''' 0476 16590000 BC 07,MSG3 0477 16600000 * /*SET FIRSTSW. */ 16610000 * FIRSTSW = ON; 16620000 MVC 637(1,@5),ON 0478 16630000 * /*STEP CARD COL PTR TO 1ST HEX CHAR 16640000 * R9 = R9 + 2; 16650000 AH @9,@D11 0479 16660000 * /*TEST IF CHAR IS LT A '0'. */ 16670000 * A6E52: IF INBUF(1) < '0' THEN GO TO A6E6; 16680000 A6E52 CLI 0(@9),C'0' 0480 16690000 BC 04,A6E6 0481 16700000 * /*TEST IF CHAR IS GT A '9'. */ 16710000 * IF INBUF(1) > '9' THEN GO TO MSG3; 16720000 CLI 0(@9),C'9' 0482 16730000 BC 02,MSG3 0483 16740000 * /*SET R6 TO LO-ORDER DIGIT OF CHAR. 16750000 * R6 = INBUF(1) & '0F'X; 16760000 LA @F,X'0F' 0484 16770000 SR @0,@0 0484 16780000 IC @0,0(0,@9) 0484 16790000 NR @F,@0 0484 16800000 LR @6,@F 0484 16810000 * /*TEST IF FIRSTSW IS ON. */ 16820000 * A6E53: IF FIRSTSW = ON THEN DO; 16830000 A6E53 CLC 637(1,@5),ON 0485 16840000 BC 07,@9D8 0485 16850000 * /*TURN OFF FIRSTSW. */ 16860000 * FIRSTSW = OFF; 16870000 MVC 637(1,@5),OFF 0487 16880000 * /*SHIFT DIGIT LEFT 4 BITS. */ 16890000 * R6 = R6 * 16; 16900000 SLA @6,4 0488 16910000 * /*PUT DIGIT IN CREATE ENTRY. */ 16920000 * CURCRTE -> FILLCH = R6; 16930000 L @1,316(0,@5) 0489 16940000 STC @6,20(0,@1) 0489 16950000 * /*STEP CARD COL PTR. */ 16960000 * R9 = R9 + 1; 16970000 AH @9,@D2 0490 16980000 * /*LOOP BACK TO PROCESS 2ND DIGIT. * 16990000 * GO TO A6E52; 17000000 BC 15,A6E52 0491 17010000 * END; 17020000 * /*PUT 2ND DIGIT IN CREATE ENTRY. */ 17030000 * CURCRTE -> FILLCH = CURCRTE -> FILLCH | R6; 17040000 @9D8 LR @F,@6 0493 17050000 L @1,316(0,@5) 0493 17060000 SR @0,@0 0493 17070000 IC @0,20(0,@1) 0493 17080000 OR @F,@0 0493 17090000 STC @F,20(0,@1) 0493 17100000 * /*STEP CARD COL PTR TO DELIMITER */ 17110000 * /* FOLLOWING FILL PARAMETER. */ 17120000 * R8 = R9 + 2; 17130000 LA @8,2 0494 17140000 AR @8,@9 0494 17150000 * /*HEX FILL HAS BEEN PROCESSED. */ 17160000 * GO TO A6E36; 17170000 BC 15,A6E36 0495 17180000 * /*TEST IF CHAR IS LT AN 'A'. */ 17190000 * A6E6: IF INBUF(1) < 'A' THEN GO TO MSG3; 17200000 A6E6 CLI 0(@9),C'A' 0496 17210000 BC 04,MSG3 0497 17220000 * /*TEST IF CHAR IS GT AN 'F'. */ 17230000 * IF INBUF(1) > 'F' THEN GO TO MSG3; 17240000 CLI 0(@9),C'F' 0498 17250000 BC 02,MSG3 0499 17260000 * /*SET R6 TO LO-ORDER DIGIT OF CHAR. 17270000 * R6 = INBUF(1) & '0F'X; 17280000 LA @F,X'0F' 0500 17290000 SR @0,@0 0500 17300000 IC @0,0(0,@9) 0500 17310000 NR @F,@0 0500 17320000 LR @6,@F 0500 17330000 * /*ADD 9 TO OBTAIN HEX EQUIVALENCE. 17340000 * R6 = R6 + 9; 17350000 AH @6,@D4 0501 17360000 * GO TO A6E53; 17370000 BC 15,A6E53 0502 17380000 * /******************************************************************** 17390000 * /** PROCESS INPUT KEYWORD. * 17400000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 17410000 * /** EXIT - R8 POINTS TO DELIMITER FOLLOWING DDNAME PARAMETER* 17420000 * /** FORMAT - INPUT=DDNAME OR * 17430000 * /** =SYSIN IMPLIES A $$$E INPUT DELIMETER OR * 17440000 * /** =SYSIN(DDDD) EXPLICIT 1 TO 4 CHAR DELIMITER* 17450000 * /******************************************************************** 17460000 * A6F1:; 17470000 * /*ADVANCE COLUMN POINTER TO START * 17480000 * /* OF PARAMETER. * 17490000 * R9 = R9 + 6; 17500000 A6F1 AH @9,@D1 0504 17510000 * /*GO TO SCAN OUT PARAMETER.*/ 17520000 * CALL SPSCAN; 17530000 BAL @E,SPSCAN 0505 17540000 * /*TEST IF LENGTH OF DDNAME IS GT */ 17550000 * /* 8 CHARS. */ 17560000 * IF R7 > 8 THEN DO; 17570000 CH @7,@D10 0506 17580000 BC 12,@9D7 0506 17590000 * /*DDNAME IS TOO LONG.*/ 17600000 * MS = 12 /*SET MSG 12. */; 17610000 LA @F,12 0508 17620000 STH @F,406(0,@5) 0508 17630000 * GO TO ERRORF; 17640000 BC 15,ERRORF 0509 17650000 * END; 17660000 * /*MOVE DDNAME INTO 'Q' FOR COMPARE. 17670000 * Q = INBUF(1:R7); 17680000 @9D7 LR @1,@7 0511 17690000 BCTR @1,0 0511 17700000 LR @E,@9 0511 17710000 LA @A,216(0,@5) 0511 17720000 MVI 0(@A),C' ' 0511 17730000 MVC 1(015,@A),0(@A) 0511 17740000 EX @1,@MVC 0511 17750000 * /*TEST IF DDNAME IS 'SYSIN'.*/ 17760000 * IF Q(1:8) = 'SYSIN ' THEN GO TO A6F2; 17770000 CLC 216(8,@5),@C24 0512 17780000 BC 08,A6F2 0513 17790000 * /************************************************* 17800000 * /** DDNAME IS NOT 'SYSIN'. SCAN ALL INPUT DCB'S * 17810000 * /** FOR AN EQUAL DDNAME. ADDRESS OF DCB IS * 17820000 * /** THEN STORED IN THE CREATE ENTRY. * 17830000 * /************************************************* 17840000 * /*SET 'DCBPTR' TO ADDRESS OF FIRST 17850000 * /* INPUT DCB. 17860000 * DCBPTR = FIRSTGMI; 17870000 MVC 300(4,@5),392(@5) 0514 17880000 * /*TEST IF NO INPUT DCB'S. */ 17890000 * /*IF NONE, GO TO ISSUE MSG 4. */ 17900000 * IF DCBPTR = 0 THEN GO TO A6F25; 17910000 SR @F,@F 0515 17920000 C @F,300(0,@5) 0515 17930000 BC 08,A6F25 0516 17940000 * /*TEST IF DDNAME ON CREATE CARD IS 17950000 * /* EQUAL TO DDNAME IN THIS INPUT 17960000 * /* DCB. 17970000 * A6F3: IF Q(1:8) = DDNAME1(1:8) THEN DO; 17980000 A6F3 L @1,300(0,@5) 0517 17990000 CLC 216(8,@5),260(@1) 0517 18000000 BC 07,@9D6 0517 18010000 * /*PUT ADDRESS OF INPUT DCB IN */ 18020000 * /* CREATE ENTRY. */ 18030000 * CURCRTE -> IDCBPTR = DCBPTR; 18040000 L @2,316(0,@5) 0519 18050000 MVC 8(4,@2),300(@5) 0519 18060000 * /*DDNAME KEYWORD HAS BEEN PROCESSED 18070000 * /*GO TO SCAN OUT NEXT KEYWORD. 18080000 * GO TO CARDSCAN; 18090000 BC 15,CARDSCAN 0520 18100000 * END; 18110000 * /*DDNAMES AREN'T EQUAL.*/ 18120000 * /*TEST IF PTR TO NEXT INPUT DCB IS 18130000 * /* 0. 18140000 * IF NEXTDCB = 0 THEN DO; 18150000 @9D6 SR @F,@F 0522 18160000 L @1,300(0,@5) 0522 18170000 C @F,256(0,@1) 0522 18180000 BC 07,@9D5 0522 18190000 * /*DDNAME ON CREATE CARD WASN'T */ 18200000 * /* FOUND IN INPUT DCB'S. */ 18210000 * /*SET MSG 4. */ 18220000 * A6F25: MS = 4; 18230000 A6F25 LA @F,4 0524 18240000 STH @F,406(0,@5) 0524 18250000 * GO TO ERRORF; 18260000 BC 15,ERRORF 0525 18270000 * END; 18280000 * /*SET 'DCBPTR' TO ADDRESS OF NEXT * 18290000 * /* INPUT DCB. * 18300000 * DCBPTR = NEXTDCB; 18310000 @9D5 L @1,300(0,@5) 0527 18320000 MVC 300(4,@5),256(@1) 0527 18330000 * /*LOOP BACK TO TEST NEXT INPUT DCB. 18340000 * GO TO A6F3; 18350000 BC 15,A6F3 0528 18360000 * /************************************************* 18370000 * /** DDNAME IS 'SYSIN'. ADDRESS OF SYSIN DCB * 18380000 * /** WHICH RESIDES IN 'COMMON' AREA IS STORED * 18390000 * /** IN THE CREATE ENTRY. * 18400000 * /************************************************* 18410000 * /*STORE ADR OF SYSIN DCB IN CREATE 18420000 * /* ENTRY. 18430000 * A6F2: CURCRTE -> IDCBPTR = ADDR(SYSI); 18440000 A6F2 LA @F,116(0,@5) 0529 18450000 L @1,316(0,@5) 0529 18460000 ST @F,8(0,@1) 0529 18470000 * /*TEST IF LEFT PAREND FOLLOWS */ 18480000 * /* DDNAME. */ 18490000 * IF R8 -> INBUF(1) ^= '(' THEN DO; 18500000 CLI 0(@8),C'(' 0530 18510000 BC 08,@9D4 0530 18520000 * /*************************************** 18530000 * /** NO EXPLICIT SYSIN DELIMITER. * 18540000 * /*************************************** 18550000 * /*SET DELIMITER TO DEFAULT OF */ 18560000 * /* '$$$E' */ 18570000 * DELIM = '$$$E'; 18580000 MVC 344(4,@5),@C25 0532 18590000 BC 15,@9D3 0534 18600000 * END; 18610000 * /*************************************** 18620000 * /** THERE IS A SYSIN DELIMITER SPEC- * 18630000 * /** IFIED. DELIMITER IS SCANNED AND * 18640000 * /** SAVED IN 'DELIM'. * 18650000 * /*************************************** 18660000 * ELSE DO /*SET R9 TO START OF DELIMITER.*/; 18670000 * R9 = R8 + 1; 18680000 @9D4 LA @9,1 0535 18690000 AR @9,@8 0535 18700000 * /*CALL SPSCAN TO SCAN OUT DELIMITER 18710000 * CALL SPSCAN; 18720000 BAL @E,SPSCAN 0536 18730000 * /*TEST IF LENGTH OF DELIMITER IS */ 18740000 * /* GT 4 CHARACTERS. */ 18750000 * IF R7 > 4 THEN DO; 18760000 CH @7,@D7 0537 18770000 * /*DELIMITER IS TOO LONG.*/ 18780000 * /*GO TO SET MSG 3. */ 18790000 * GO TO MSG3; 18800000 BC 03,MSG3 0539 18810000 * END; 18820000 * /*MOVE DELIMITER TO 'DELIM'.*/ 18830000 * DELIM = INBUF(1:R7); 18840000 @9D2 LR @1,@7 0541 18850000 BCTR @1,0 0541 18860000 LR @E,@9 0541 18870000 LA @A,344(0,@5) 0541 18880000 MVI 0(@A),C' ' 0541 18890000 MVC 1(003,@A),0(@A) 0541 18900000 EX @1,@MVC 0541 18910000 * /*POINT TO COLUMN FOLLOWING RIGHT * 18920000 * /* PAREND. * 18930000 * R8 = R8 + 1; 18940000 AH @8,@D2 0542 18950000 * END; 18960000 * /*DDNAME KEYWORD HAS BEEN PROCESSED 18970000 * /*GO TO SCAN OUT NEXT KEYWORD. 18980000 * GO TO CARDSCAN; 18990000 BC 15,CARDSCAN 0544 19000000 * /******************************************************************** 19010000 * /** PROCESS EXIT KEYWORD. * 19020000 * /** THIS SECTION WILL SCAN OUT THE NAME OF THE USER'S EXIT * 19030000 * /** ROUTINE AND LOAD THAT ROUTINE INTO STORAGE. THE ADDRESS OF * 19040000 * /** THE ROUTINE WILL BE IN THE CREATE ENTRY. * 19050000 * /** IF THE USER'S EXIT ROUTINE IS NOT IN THE LIBRARY, THE LOAD * 19060000 * /** MACRO WILL ABEND. * 19070000 * /** ENTRY - R9 POINTS TO START OF KEYWORD. * 19080000 * /** EXIT - R8 POINTS TO DELIMETER FOLLOWING EXIT NAME. * 19090000 * /** FORMAT - EXIT=NAME 1 TO 8 A/N CHARACTERS. * 19100000 * /******************************************************************** 19110000 * A6G1:; 19120000 * /*ADVANCE COLUMN POINTER TO START*/ 19130000 * /* OF PARAMETER. */ 19140000 * R9 = R9 + 5; 19150000 A6G1 AH @9,@D5 0546 19160000 * /*GO TO SCAN OUT PARAMETER.*/ 19170000 * CALL SPSCAN; 19180000 BAL @E,SPSCAN 0547 19190000 * /*TEST IF EXITNAME IS GT 8 BYTES.*/ 19200000 * IF R7 > 8 THEN DO; 19210000 CH @7,@D10 0548 19220000 BC 12,@9D1 0548 19230000 * /*EXIT NAME IS GT 8 CHARS. */ 19240000 * /*SET MSG 12. */ 19250000 * MS = 12; 19260000 LA @F,12 0550 19270000 STH @F,406(0,@5) 0550 19280000 * GO TO ERRORF; 19290000 BC 15,ERRORF 0551 19300000 * END; 19310000 * /************************************************* 19320000 * /** THIS SECTION WILL GETMAIN 72 BYTES FOR AN * 19330000 * /** INITIAL EXIT NAME TABLE OR FOR AN ADDIT- * 19340000 * /** IONAL TABLE IF NECESSARY. * 19350000 * /************************************************* 19360000 * /*TEST IF EXITSW IS OFF. */ 19370000 * IF EXITSW = OFF THEN GO TO A6G2; 19380000 @9D1 CLC 555(1,@5),OFF 0553 19390000 BC 08,A6G2 0554 19400000 * /*TEST IF ENOUGH ROOM IN EXITNAME * 19410000 * /* TABLE FOR NEW ENTRY. * 19420000 * IF CUREXIT + 8 => EXITGM + 68 THEN GO TO A6G2; 19430000 LA @F,8 0555 19440000 A @F,340(0,@5) 0555 19450000 ST @F,@T1 0555 19460000 LA @F,68 0555 19470000 A @F,336(0,@5) 0555 19480000 C @F,@T1 0555 19490000 BC 12,A6G2 0556 19500000 * /*POINT TO NEXT EXITNAME ENTRY.*/ 19510000 * CUREXIT = CUREXIT + 8; 19520000 LA @F,8 0557 19530000 A @F,340(0,@5) 0557 19540000 ST @F,340(0,@5) 0557 19550000 * GO TO A6G5; 19560000 BC 15,A6G5 0558 19570000 * /*ISSUE A GM FOR 72 BYTES FOR */ 19580000 * /* INITIAL EXITNAME TABLE. */ 19590000 * /*PUT LENGTH IN GM PARAMETER LIST. 19600000 * A6G2: GLENGTH = 72; 19610000 A6G2 LA @F,72 0559 19620000 ST @F,364(0,@5) 0559 19630000 * /*GO TO GETMAIN ROUTINE. */ 19640000 * CALL GETMAIN; 19650000 BAL @E,GETMAIN 0560 19660000 * /*BASE POINTER FOR 'AREA'.*/ 19670000 * R4 = GCADDR; 19680000 L @4,376(0,@5) 0561 19690000 * /*CLEAR GETMAIN AREA.*/ 19700000 * AREA(1) = '0'X; 19710000 MVI 0(@4),X'00' 0562 19720000 * AREA(2:72) = AREA(1:71); 19730000 MVC 1(71,@4),0(@4) 0563 19740000 * /*TEST IF EXITSW IS OFF. */ 19750000 * IF EXITSW = OFF THEN DO; 19760000 CLC 555(1,@5),OFF 0564 19770000 BC 07,@9D0 0564 19780000 * /*EXITNAME TABLE PTR = ADR OF GM.*/ 19790000 * EXITTAB = GCADDR; 19800000 MVC 332(4,@5),376(@5) 0566 19810000 * /*TURN ON EXITSW. */ 19820000 * EXITSW = ON; 19830000 MVC 555(1,@5),ON 0567 19840000 BC 15,@9CF 0569 19850000 * END; 19860000 * ELSE DO; 19870000 * /*CHAIN PREVIOUS EXITNAME TABLE TO 19880000 * /* NEW ONE. 19890000 * EXITGM -> NXTEXGM = GCADDR; 19900000 @9D0 L @1,336(0,@5) 0570 19910000 MVC 0(4,@1),376(@5) 0570 19920000 * END; 19930000 * /*SET CURRENT EXITNAME PTR TO ADR * 19940000 * /* OF GETMAIN + 4. * 19950000 * CUREXIT = GCADDR + 4; 19960000 @9CF LA @F,4 0572 19970000 A @F,376(0,@5) 0572 19980000 ST @F,340(0,@5) 0572 19990000 * /*SET CURRENT EXITNAME GETMAIN TO * 20000000 * /* ADR OF GETMAIN. * 20010000 * EXITGM = GCADDR; 20020000 MVC 336(4,@5),376(@5) 0573 20030000 * /************************************************* 20040000 * /** THIS SECTION WILL MOVE THE USER'S EXIT * 20050000 * /** ROUTINE NAME TO THE EXIT NAME TABLE. IT * 20060000 * /** THEN LOADS THE USER'S ROUTINE INTO STORAGE* 20070000 * /************************************************* 20080000 * /*MOVE USER'S EXIT ROUTINE NAME */ 20090000 * /* INTO EXITNAME TABLE. */ 20100000 * A6G5: CUREXIT -> EXITNAME = INBUF(1:R7); 20110000 A6G5 LR @1,@7 0574 20120000 BCTR @1,0 0574 20130000 LR @E,@9 0574 20140000 L @2,340(0,@5) 0574 20150000 LR @A,@2 0574 20160000 MVI 0(@A),C' ' 0574 20170000 MVC 1(007,@A),0(@A) 0574 20180000 EX @1,@MVC 0574 20190000 * /*POINT TO 'EXITNAME'.*/ 20200000 * R6 = CUREXIT; 20210000 L @6,340(0,@5) 0575 20220000 * /*LOAD USER'S EXIT ROUTINE. ADDRESS 20230000 * /* OF ROUTINE IS RETURNED IN REG 0. 20240000 * GEN( LOAD EPLOC=(6)); 20250000 LOAD EPLOC=(6) 20260000 DS 0H 20270000 * /*STORE EXIT ADR IN CREATE ENTRY.*/ 20280000 * CURCRTE -> EXITADR = R0; 20290000 L @1,316(0,@5) 0577 20300000 ST @0,12(0,@1) 0577 20310000 * /*EXIT KEYWORD HAS BEEN PROCESSED*/ 20320000 * /* GO TO SCAN OUT NEXT KEYWORD. */ 20330000 * GO TO CARDSCAN; 20340000 BC 15,CARDSCAN 0578 20350000 * /******************************************************************** 20360000 * /** SCAN NEXT KEYWORD - PREVIOUS KEYWORD HAS BEEN PROCESSED. THIS * 20370000 * /** SECTION WILL SCAN FOR DELIMITER FOLLOWING PREVIOUS * 20380000 * /** KEYWORD. IT WILL CHECK FOR OPERAND CONTINUATION OR * 20390000 * /** COMMENTS CONTINUATION AND IF SO, GO TO IEBDG TO READ * 20400000 * /** THE NEXT CARD. * 20410000 * /** ENTRY - R8 POINTS TO DELIMITER FOLLOWING LAST PARAMETER * 20420000 * /** THAT WAS PROCESSED. * 20430000 * /** EXIT - TO KEYWORD SCAN(KEYSCAN) * 20440000 * /** R9 POINTS TO START OF NEXT KEYWORD TO BE PROCESSED. * 20450000 * /******************************************************************** 20460000 * CARDSCAN:; 20470000 * /*SET R9 = R8. R8 POINTS TO DELIMIT 20480000 * /* ER FOLLOWING PARAMETER. 20490000 * R9 = R8; 20500000 CARDSCAN LR @9,@8 0580 20510000 * /*TEST IF COLUMN IS BLANK.*/ 20520000 * IF INBUF(1) = ' ' THEN GO TO A6P01; 20530000 CLI 0(@9),C' ' 0581 20540000 BC 08,A6P01 0582 20550000 * /*TEST IF COLUMN IS A COMMA.*/ 20560000 * IF INBUF(1) = ',' THEN GO TO A6P1; 20570000 CLI 0(@9),C',' 0583 20580000 BC 08,A6P1 0584 20590000 * /*DELIMETER FOLLOWING A COMPLETE */ 20600000 * /* PARAMETER IS NOT A BLANK OR */ 20610000 * /* COMMA. */ 20620000 * IF R9 = COUNTER THEN GO TO A6P2 ; /* CONTINUATION A38710 * 20630000 C @9,232(0,@5) 0585 20640000 BC 08,A6P2 0586 20650000 * /*GO TO ISSUE MESSAGE NO. 3. */ 20660000 * GO TO MSG3; 20670000 BC 15,MSG3 0587 20680000 * A6P1: IF R9 = COUNTER THEN DO; 20690000 A6P1 C @9,232(0,@5) 0588 20700000 BC 07,@9CE 0588 20710000 * /*TURN ON CREATE CONTINUE SW.*/ 20720000 * A6P2: CRCSW = ON; 20730000 A6P2 MVC 554(1,@5),ON 0590 20740000 * /*GO TO IEBDG TO READ CREATE */ 20750000 * /* CONTINUATION CARD. */ 20760000 * GO TO RETURN2; 20770000 BC 15,RETURN2 0591 20780000 * END; 20790000 * /*ADVANCE CARD COLUMN PTR.*/ 20800000 * R9 = R9 + 1; 20810000 @9CE AH @9,@D2 0593 20820000 * /*TEST IF COLUMN IS BLANK.*/ 20830000 * IF INBUF(1) = ' ' THEN GO TO A6P2; 20840000 CLI 0(@9),C' ' 0594 20850000 BC 08,A6P2 0595 20860000 * /*READY TO PROCESS NEXT KEYWORD.*/ 20870000 * GO TO KEYSCAN; 20880000 BC 15,KEYSCAN 0596 20890000 * /************************************************* 20900000 * /** AT THIS POINT ALL OPERAND KEYWORDS HAVE * 20910000 * /** BEEN PROCESSED. THERE ARE COMMENTS CONTIN-* 20920000 * /** UATION ON ANOTHER CARD IF COL. 72 IS NOT * 20930000 * /** BLANK. * 20940000 * /************************************************* 20950000 * /*TEST IF COL 72 NOT BLANK.*/ 20960000 * A6P01: IF COUNTER -> AREA(2) ^= ' ' THEN DO; 20970000 A6P01 L @1,232(0,@5) 0597 20980000 CLI 1(@1),C' ' 0597 20990000 BC 08,@9CD 0597 21000000 * /*TURN ON CREATE CONTINUE SW. */ 21010000 * CRCSW = ON; 21020000 MVC 554(1,@5),ON 0599 21030000 * COMCSW = ON /*TURN ON COMMENTS CONT. SW.*/; 21040000 MVC 565(1,@5),ON 0600 21050000 * /*GO TO IEBDG TO READ COMMENTS */ 21060000 * /*CONTINUATION CARD. */ 21070000 * GO TO RETURN2; 21080000 BC 15,RETURN2 0601 21090000 * END; 21100000 * /************************************************* 21110000 * /** ALL CONTINUATION CARDS THAT ARE PRESENT * 21120000 * /** HAVE BEEN PROCESSED. SET DEFAULTS FOR * 21130000 * /** QUANTITY AND FILL IF NOT SPECIFIED ON THE * 21140000 * /** CREATE CARD. * 21150000 * /************************************************* 21160000 * /*TEST IF QUANTITY = 0.*/ 21170000 * CREATE:IF CURCRTE -> QUAN = 0 THEN 21180000 @9CD EQU * 0603 21190000 CREATE L @1,316(0,@5) 0603 21200000 CLC 4(4,@1),@D9 0603 21210000 BC 07,@9CC 0603 21220000 * /*TEST IF NO INPUT DCB. */ 21230000 * IF CURCRTE -> IDCBPTR = 0 THEN 21240000 SR @F,@F 0604 21250000 C @F,8(0,@1) 0604 21260000 BC 07,@9CB 0604 21270000 * /*SET QUANTITY = 1 */ 21280000 * CURCRTE -> QUAN = 1; 21290000 MVC 4(4,@1),@D14 0605 21300000 * /*DECREMENT NO. OF CREATE CARDS */ 21310000 * /* REMAINING. */ 21320000 * CREATENO = CREATENO - 1; 21330000 @9CB EQU * 0606 21340000 @9CC LH @F,@D6 0606 21350000 AH @F,18(0,@5) 0606 21360000 STH @F,18(0,@5) 0606 21370000 * /*TEST IF MORE CARDS IN A REPEAT */ 21380000 * /* GROUP. */ 21390000 * IF CREATENO > 0 THEN DO; 21400000 SR @F,@F 0607 21410000 CH @F,18(0,@5) 0607 21420000 BC 10,@9CA 0607 21430000 * /*GO TO IEBDG TO READ NEXT CREATE*/ 21440000 * /* CARD. */ 21450000 * GO TO RETURN2; 21460000 BC 15,RETURN2 0609 21470000 * END; 21480000 * /******************************************************************** 21490000 * /** LINK TO IEBCREAT MODULE - CONTROL IS PASSED TO IEBCREAT TO * 21500000 * /** WRITE THE OUTPUT RECORDS FOR A SINGLE CREATE CARD OR * 21510000 * /** FOR MULTIPLE CREATE CARDS IF A REPEAT GROUP. * 21520000 * /******************************************************************** 21530000 * /*TURN OFF 'REPEATSW' TO INDICATE * 21540000 * /* REPEAT GROUP IS COMPLETED. */ 21550000 * REPEATSW = OFF; 21560000 @9CA MVC 578(1,@5),OFF 0611 21570000 * LINK: GEN( LINK EP=IEBCREAT); 21580000 LINK LINK EP=IEBCREAT 21590000 DS 0H 21600000 * /******************************************************************** 21610000 * /** RETURN FROM IEBCREAT MODULE. * 21620000 * /******************************************************************** 21630000 * GO TO RETURN2; 21640000 * /******************************************************************** 21650000 * /** NORMAL RETURN. * 21660000 * /** RETURN TO MODULE IEBDG. * 21670000 * /******************************************************************** 21680000 * /*RETURN TO IEBDG. */ 21690000 * RETURN2: RETURN; 21700000 BC 15,@EL01 0614 21710000 * /******************************************************************** 21720000 * /** ERROR RETURNS. - CONTROL IS PASSED TO MODULE IEBCREAT TO * 21730000 * /** TO FREE TABLES. CONTROL IS RETURNED TO * 21740000 * /** MODULE IEBDG TO PRINT THE APPROPRIATE * 21750000 * /** MESSAGE. * 21760000 * /******************************************************************** 21770000 * /*TURN ON ERROR FLAG SW. */ 21780000 * ERRORF: FLAGSW(1) = '1'B; 21790000 ERRORF OI 566(@5),B'10000000' 0615 21800000 * /*SET 'EPSW' TO INDICATE ERROR. */ 21810000 * ERROR: EPSW = 1; 21820000 ERROR MVI 568(@5),1 0616 21830000 * /*SET CONDITION CODE TO 8. */ 21840000 * CONCODE = 8; 21850000 LA @F,8 0617 21860000 STH @F,306(0,@5) 0617 21870000 * /*TURN ON 'NOGO' SWITCH. */ 21880000 * NOGOSW = ON; 21890000 MVC 551(1,@5),ON 0618 21900000 * /*GO TO LINK TO IEBCREAT. */ 21910000 * GO TO LINK; 21920000 BC 15,LINK 0619 21930000 * /******************************************************************** 21940000 * /** SPSCAN - THIS SUBROUTINE WILL SCAN OUT A PARAMETER. * 21950000 * /** IT SCANS FOR A DELIMITER OF COMMA, BLANK, LEFT PAREND * 21960000 * /** OR RIGHT PAREND. * 21970000 * /** IT CHECKS FOR A FIELD LENGTH OF 0, AND IF SO, ISSUES * 21980000 * /** MESSAGE #6. * 21990000 * /** ENTRY - R14 IS LINKAGE REGISTER. * 22000000 * /** R9 POINTS TO START OF PARAMETER. * 22010000 * /** EXIT - R9 NO CHANGE. * 22020000 * /** R8 POINTS TO DELIMETER FOLLOWING PARAMETER. * 22030000 * /** R7 CONTAINS LENGTH OF PARAMETER. * 22040000 * /******************************************************************** 22050000 * SPSCAN:; 22060000 * /*SAVE REG 14 IN COMMON AREA. */ 22070000 * SAVE14 = R14; 22080000 SPSCAN ST @E,360(0,@5) 0621 22090000 * R8 = R9 /*INITIALIZE CARD COL PTR.*/; 22100000 LR @8,@9 0622 22110000 * A6M11: IF R8 > COUNTER THEN DO; 22120000 A6M11 C @8,232(0,@5) 0623 22130000 BC 12,@9C9 0623 22140000 * MSG21: MS = 21 /*PARAMETER EXTENDS INTO COL 72.*/; 22150000 MSG21 LA @F,21 0625 22160000 STH @F,406(0,@5) 0625 22170000 * GO TO ERRORF; 22180000 BC 15,ERRORF 0626 22190000 * END; 22200000 * /*TEST IF COMMA.*/ 22210000 * A6M12: IF PARAM(1) = ',' THEN GO TO A6M13; 22220000 @9C9 EQU * 0628 22230000 A6M12 CLI 0(@8),C',' 0628 22240000 BC 08,A6M13 0629 22250000 * /*TEST IF BLANK.*/ 22260000 * IF PARAM(1) = ' ' THEN GO TO A6M13; 22270000 CLI 0(@8),C' ' 0630 22280000 BC 08,A6M13 0631 22290000 * /*TEST IF LEFT PAREND.*/ 22300000 * IF PARAM(1) = '(' THEN GO TO A6M13; 22310000 CLI 0(@8),C'(' 0632 22320000 BC 08,A6M13 0633 22330000 * /*TEST IF RIGHT PAREND.*/ 22340000 * IF PARAM(1) = ')' THEN GO TO A6M13; 22350000 CLI 0(@8),C')' 0634 22360000 BC 08,A6M13 0635 22370000 * R8 = R8 + 1 /*ADVANCE COLUMN POINTER.*/; 22380000 AH @8,@D2 0636 22390000 * IF R8 = COUNTER + 1 THEN DO ; /* AT COL 72 A38710 * 22400000 LA @F,1 0637 22410000 A @F,232(0,@5) 0637 22420000 CR @F,@8 0637 22430000 BC 07,@9C8 0637 22440000 * IF R8 -> INBUF(1) ^= ' ' THEN /* NO CONT.CHHAR A38710 * 22450000 CLI 0(@8),C' ' 0639 22460000 * GO TO A6P2 ; /* A38710 * 22470000 BC 07,A6P2 0640 22480000 * END ; /* A38710 * 22490000 * GO TO A6M11; 22500000 BC 15,A6M11 0642 22510000 * /*CALCULATE LENGTH OF PARAMETER.*/ 22520000 * A6M13: R7 = R8 - R9; 22530000 A6M13 LCR @7,@9 0643 22540000 AR @7,@8 0643 22550000 * /*TEST IF PARAMETER LENGTH IS 0.*/ 22560000 * IF R7 = 0 THEN DO; 22570000 LTR @7,@7 0644 22580000 * /*PARAMETER LENGTH IS 0. */ 22590000 * /*GO TO ISSUE MSG 3. */ 22600000 * GO TO MSG3; 22610000 BC 08,MSG3 0646 22620000 * END; 22630000 * /*RESTORE REG 14 FROM COMMON AREA. 22640000 * R14 = SAVE14; 22650000 @9C7 L @E,360(0,@5) 0648 22660000 * /*RETURN TO CALLER.*/ 22670000 * GO TO R14; 22680000 BCR 15,@E 0649 22690000 * /******************************************************************** 22700000 * /** CONVDB - THIS SUBROUTINE WILL PACK A DECIMAL FIELD FROM THE CARD* 22710000 * /** AND CONVERT IT TO BINARY. IT CHECKS FOR A MAXIMUM * 22720000 * /** DECIMAL VALUE OF 2,147,483,647 OR A VALUE OF 0, AND * 22730000 * /** IF SO, ISSUES MESSAGE #6. * 22740000 * /** ENTRY - R14 IS LINKAGE REGISTER. * 22750000 * /** R9 POINTS TO START OF PARAMETER. * 22760000 * /** R7 CONTAINS LENGTH OF PARAMETER. * 22770000 * /** EXIT - R6 CONTAINS CONVERTED BINARY VALUE. * 22780000 * /** R7 NO CHANGE. * 22790000 * /** R9 NO CHANGE. * 22800000 * /******************************************************************** 22810000 * CONVDB:; 22820000 * A6N11: 22830000 * /*SAVE REG 14 IN COMMON AREA. */ 22840000 * SAVE14 = R14; 22850000 CONVDB EQU * 0651 22860000 A6N11 ST @E,360(0,@5) 0651 22870000 * /*TEST IF LENGTH OF VALUE ON CARD * 22880000 * /* IS GT 16 BYTES. */ 22890000 * IF R7 > 16 THEN GO TO A6N20; 22900000 CH @7,@D13 0652 22910000 BC 02,A6N20 0653 22920000 * /*PUT LENGTH - 1 IN R6. */ 22930000 * R6 = R7 - 1; 22940000 LH @6,@D6 0654 22950000 AR @6,@7 0654 22960000 * /*CLEAR 'Q' TO ZEROS. */ 22970000 * Q = Q && Q; 22980000 XC 216(16,@5),216(@5) 0655 22990000 * /*MOVE ZONES ONLY OF CHARACTERS ON * 23000000 * /* CARD INTO 'Q'. * 23010000 * GEN( EX R6,MVZON ); 23020000 EX R6,MVZON 23030000 DS 0H 23040000 * /*************************************** 23050000 * /** CHECK CHARS. ON CARD FOR NUMERIC * 23060000 * /** BY TESTING ALL ZONES FOR AN 'F'. * 23070000 * /*************************************** 23080000 * IF Q(1:R7) = FOXZEROS(1:R7) THEN GO TO A6N12; 23090000 LA @E,FOXZEROS 0657 23100000 LR @1,@7 0657 23110000 BCTR @1,0 0657 23120000 LA @A,216(0,@5) 0657 23130000 EX @1,@CLC 0657 23140000 BC 08,A6N12 0658 23150000 * /*IF CHARS ARE INVALID ISSUE MSG 3 * 23160000 * GO TO MSG3; 23170000 BC 15,MSG3 0659 23180000 * /*PACK QUANTITY INTO Q.*/ 23190000 * A6N12: GEN( EX R6,PACK); 23200000 A6N12 EX R6,PACK 23210000 DS 0H 23220000 * /*************************************** 23230000 * /** IF PACKED DECIMAL PICTURE RETURN * 23240000 * /** TO CALLER. PACKED NO. IS IN 'Q'. * 23250000 * /*************************************** 23260000 * IF PICCSW(5) = '1'B THEN GO TO A6N26; 23270000 TM 562(@5),B'00001000' 0661 23280000 BC 01,A6N26 0662 23290000 * /*TEST IF LENGTH GT 10. */ 23300000 * IF R7 > 10 THEN GO TO A6N20; 23310000 CH @7,@D15 0663 23320000 BC 02,A6N20 0664 23330000 * /*TEST IF DECIMAL VALUE GREATER*/ 23340000 * /* THAN 2,147,483,647. */ 23350000 * IF Q(11:16) > '02147483647F'X THEN DO; 23360000 CLC 226(6,@5),@X26 0665 23370000 BC 12,@9C6 0665 23380000 * A6N20: MS = 6; 23390000 A6N20 LA @F,6 0667 23400000 STH @F,406(0,@5) 0667 23410000 * GO TO ERRORF; 23420000 BC 15,ERRORF 0668 23430000 * END; 23440000 * /*CONVERT QUANTITY FROM PACKED DEC. 23450000 * /* TO BINARY, RESULT IN R6. 23460000 * GEN( CVB R6,Q+8(R5)); 23470000 @9C6 EQU * 0670 23480000 CVB R6,Q+8(R5) 23490000 DS 0H 23500000 * /*TEST IF NOT BINARY PICTURE. */ 23510000 * IF PICCSW(6) = '0'B THEN 23520000 TM 562(@5),B'00000100' 0671 23530000 BC 05,@9C5 0671 23540000 * /*TEST IF VALUE IS 0. IF SO, GO TO 23550000 * /* ISSUE MSG 3. 23560000 * IF R6 = 0 THEN GO TO MSG3; 23570000 LTR @6,@6 0672 23580000 BC 08,MSG3 0673 23590000 * /*RESTORE REG 14 FROM COMMON AREA. 23600000 * A6N26: R14 = SAVE14; 23610000 @9C5 EQU * 0674 23620000 A6N26 L @E,360(0,@5) 0674 23630000 * /*RETURN TO USER.*/ 23640000 * GO TO R14; 23650000 BCR 15,@E 0675 23660000 * MVZON: GEN( MVZ Q(1,R5),0(R9)); 23670000 MVZON MVZ Q(1,R5),0(R9) 23680000 DS 0H 23690000 * PACK: GEN( PACK Q(16,R5),0(1,R9)); 23700000 PACK PACK Q(16,R5),0(1,R9) 23710000 DS 0H 23720000 * /******************************************************************** 23730000 * /** GETMAIN - THIS SUBROUTINE ISSUES A CONDITIONAL GETMAIN MACRO * 23740000 * /** WHICH IS REENTRANT. IT CHECKS FOR AN ERROR RETURN * 23750000 * /** CODE FROM THE GETMAIN AND ISSUES MESSAGE 10 IF * 23760000 * /** UNSUCCESSFUL. * 23770000 * /** ENTRY - 'GLENGTH' CONTAINS THE LENGTH TO BE GOTTEN. * 23780000 * /** R14 IS LINKAGE REGISTER. * 23790000 * /** EXIT - 'GCADDR' CONTAINS THE ADDRESS OF THE GOTTEN CORE. * 23800000 * /******************************************************************** 23810000 * GETMAIN:; 23820000 * /*SAVE REG 14 IN COMMON AREA. */ 23830000 * SAVE14 = R14; 23840000 GETMAIN ST @E,360(0,@5) 0679 23850000 * /*POINT TO GETMAIN PARAMETER LIST. 23860000 * R1 = ADDR(GETMLIST); 23870000 LA @1,364(0,@5) 0680 23880000 * /*POINT TO RETURNED GM ADDRESS. */ 23890000 * R2 = ADDR(GCADDR); 23900000 LA @2,376(0,@5) 0681 23910000 * /*ISSUE GETMAIN MACRO */ 23920000 * /*LENGTH VALUE IS ALREADY IN */ 23930000 * /* PARAMETER LIST. */ 23940000 * GEN( GETMAIN EC,A=(2),SP=0,MF=(E,(1))); 23950000 GETMAIN EC,A=(2),SP=0,MF=(E,(1)) 23960000 DS 0H 23970000 * /*TEST IF GETMAIN SUCCESSFUL. */ 23980000 * IF R15 ^= 0 THEN DO; 23990000 LTR @F,@F 0683 24000000 BC 08,@9C4 0683 24010000 * /*GETMAIN UNSUCCESSFUL. */ 24020000 * /*SET MSG 10. */ 24030000 * MS = 10; 24040000 LA @F,10 0685 24050000 STH @F,406(0,@5) 0685 24060000 * GO TO ERROR; 24070000 BC 15,ERROR 0686 24080000 * END; 24090000 * /*RESTORE REG 14. */ 24100000 * R14 = SAVE14; 24110000 @9C4 L @E,360(0,@5) 0688 24120000 * /*RETURN TO CALLER. */ 24130000 * GO TO R14; 24140000 BCR 15,@E 0689 24150000 * END IEBCRANL; 24160000 @EL01 L @D,4(0,@D) 0690 24170000 LR @1,@C 0690 24180000 L @0,@SIZ001 0690 24190000 FREEMAIN R,LV=(0),A=(1) 0690 24200000 L @E,12(0,@D) 0690 24210000 LM @0,@8,20(@D) 0690 24220000 LM @A,@C,60(@D) 0690 24230000 BCR 15,@E 0690 24240000 @DATA1 EQU * 24250000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 24260000 @1 EQU 01 24270000 @2 EQU 02 24280000 @3 EQU 03 24290000 @4 EQU 04 24300000 @5 EQU 05 24310000 @6 EQU 06 24320000 @7 EQU 07 24330000 @8 EQU 08 24340000 @9 EQU 09 24350000 @A EQU 10 24360000 @B EQU 11 24370000 @C EQU 12 24380000 @D EQU 13 24390000 @E EQU 14 24400000 @F EQU 15 24410000 @D9 DC F'0' 24420000 @D14 DC F'1' 24430000 @D1 DC H'6' 24440000 @D2 DC H'1' 24450000 @D3 DC H'3' 24460000 @D4 DC H'9' 24470000 @D5 DC H'5' 24480000 @D6 DC H'-1' 24490000 @D7 DC H'4' 24500000 @D8 DC H'64' 24510000 @D10 DC H'8' 24520000 @D11 DC H'2' 24530000 @D12 DC H'256' 24540000 @D13 DC H'16' 24550000 @D15 DC H'10' 24560000 @CLC CLC 0(1,@A),0(@E) 24570000 @MVC MVC 0(1,@A),0(@E) 24580000 DS 0F 24590000 @SIZ001 DC AL1(&SPN) 24600000 DC AL3(@DATEND-@DATD) 24610000 DS 0F 24620000 @C7 DC C'PICTURE=' 24630000 @C24 DC C'SYSIN ' 24640000 @C25 DC C'$$$E' 24650000 @C9 DC C'INPUT=' 24660000 @C16 DC C'P''' 24670000 @C17 DC C'B''' 24680000 @X26 DC X'02147483647F' 24690000 @C5 DC C'QUANTITY=' 24700000 @C6 DC C'NAME=' 24710000 @C8 DC C'FILL=' 24720000 @C10 DC C'EXIT=' 24730000 @C14 DC C'COPY=' 24740000 DS 0D 24750000 @DATA EQU * 24760000 R1 EQU 00000001 FULLWORD INTEGER REGISTER 24770000 R2 EQU 00000002 FULLWORD INTEGER REGISTER 24780000 R3 EQU 00000003 FULLWORD INTEGER REGISTER 24790000 R4 EQU 00000004 FULLWORD POINTER REGISTER 24800000 R5 EQU 00000005 FULLWORD POINTER REGISTER 24810000 R6 EQU 00000006 FULLWORD POINTER REGISTER 24820000 R7 EQU 00000007 FULLWORD POINTER REGISTER 24830000 R8 EQU 00000008 FULLWORD POINTER REGISTER 24840000 R9 EQU 00000009 FULLWORD POINTER REGISTER 24850000 R14 EQU 00000014 FULLWORD POINTER REGISTER 24860000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 24870000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 24880000 COMMON EQU 00000000 308 BYTE(S) ON DWORD 24890000 PAGENO EQU COMMON+00000000 4 BYTE(S) 24900000 LINECT EQU COMMON+00000004 FULLWORD INTEGER 24910000 LINECTR EQU COMMON+00000008 FULLWORD INTEGER 24920000 PARM EQU COMMON+00000012 FULLWORD POINTER 24930000 REPEATNO EQU COMMON+00000016 HALFWORD INTEGER 24940000 CREATENO EQU COMMON+00000018 HALFWORD INTEGER 24950000 SYSP EQU COMMON+00000020 96 BYTE(S) 24960000 SYSI EQU COMMON+00000116 96 BYTE(S) 24970000 Q EQU COMMON+00000216 16 BYTE(S) ON DWORD 24980000 QFILL EQU COMMON+00000216 7 BYTE(S) 24990000 QSIGN EQU COMMON+00000223 8 BIT(S) 25000000 QFILL1 EQU COMMON+00000224 7 BYTE(S) 25010000 QSIGN1 EQU COMMON+00000231 8 BIT(S) 25020000 COUNTER EQU COMMON+00000232 FULLWORD POINTER 25030000 OPENLIST EQU COMMON+00000236 8 BYTE(S) 25040000 OPTBYTE1 EQU COMMON+00000236 4 BYTE(S) 25050000 OPTBYTE2 EQU COMMON+00000240 4 BYTE(S) 25060000 EXLST EQU COMMON+00000244 24 BYTE(S) ON WORD 25070000 INHDR EQU COMMON+00000244 1 BYTE(S) 25080000 INHDR1 EQU COMMON+00000245 3 BYTE POINTER ON WORD+1 25090000 OUTHDR EQU COMMON+00000248 1 BYTE(S) 25100000 OUTHDR1 EQU COMMON+00000249 3 BYTE POINTER ON WORD+1 25110000 INTRL EQU COMMON+00000252 1 BYTE(S) 25120000 INTRL1 EQU COMMON+00000253 3 BYTE POINTER ON WORD+1 25130000 OUTTRL EQU COMMON+00000256 1 BYTE(S) 25140000 OUTTRL1 EQU COMMON+00000257 3 BYTE POINTER ON WORD+1 25150000 EXITDCB EQU COMMON+00000260 1 BYTE(S) 25160000 EXITDCB1 EQU COMMON+00000261 3 BYTE POINTER ON WORD+1 25170000 TOTAL EQU COMMON+00000264 1 BYTE(S) 25180000 TOTAL1 EQU COMMON+00000265 3 BYTE POINTER ON WORD+1 25190000 EXLST1 EQU COMMON+00000268 4 BYTE(S) ON WORD 25200000 EDCB1 EQU COMMON+00000268 1 BYTE(S) 25210000 EDCB2 EQU COMMON+00000269 3 BYTE POINTER ON WORD+1 25220000 EXLST2 EQU COMMON+00000272 4 BYTE(S) ON WORD 25230000 EDCB3 EQU COMMON+00000272 1 BYTE(S) 25240000 EDCB4 EQU COMMON+00000273 3 BYTE POINTER ON WORD+1 25250000 EXLST3 EQU COMMON+00000276 4 BYTE(S) ON WORD 25260000 EDCB5 EQU COMMON+00000276 1 BYTE(S) 25270000 EDCB6 EQU COMMON+00000277 3 BYTE POINTER ON WORD+1 25280000 DLRECL EQU COMMON+00000280 HALFWORD INTEGER 25290000 DBLKSI EQU COMMON+00000282 HALFWORD INTEGER 25300000 DRECFM EQU COMMON+00000284 8 BIT(S) 25310000 LEFTOVER EQU COMMON+00000288 FULLWORD INTEGER 25320000 OFFSET EQU COMMON+00000292 FULLWORD POINTER 25330000 LPTR EQU COMMON+00000296 FULLWORD POINTER 25340000 DCBPTR EQU COMMON+00000300 FULLWORD POINTER 25350000 DUMMY EQU COMMON+00000304 FULLWORD POINTER 25360000 COMMON1 EQU 00000304 236 BYTE(S) ON WORD 25370000 SAVEMS EQU COMMON1+00000000 HALFWORD INTEGER 25380000 CONCODE EQU COMMON1+00000002 HALFWORD INTEGER 25390000 OUTREC EQU COMMON1+00000004 FULLWORD POINTER 25400000 CRTABPT EQU COMMON1+00000008 FULLWORD POINTER 25410000 CURCRTE EQU COMMON1+00000012 FULLWORD POINTER 25420000 CURCRGM EQU COMMON1+00000016 FULLWORD POINTER 25430000 CURPIC EQU COMMON1+00000020 FULLWORD POINTER 25440000 PICCTR EQU COMMON1+00000024 FULLWORD INTEGER 25450000 EXITTAB EQU COMMON1+00000028 FULLWORD POINTER 25460000 EXITGM EQU COMMON1+00000032 FULLWORD POINTER 25470000 CUREXIT EQU COMMON1+00000036 FULLWORD POINTER 25480000 DELIM EQU COMMON1+00000040 4 BYTE(S) 25490000 RECREM EQU COMMON1+00000044 FULLWORD INTEGER 25500000 CURFD EQU COMMON1+00000048 FULLWORD POINTER 25510000 CUROUT EQU COMMON1+00000052 HALFWORD POINTER 25520000 SAVE14 EQU COMMON1+00000056 FULLWORD POINTER 25530000 GETMLIST EQU COMMON1+00000060 16 BYTE(S) ON WORD 25540000 GLENGTH EQU COMMON1+00000060 FULLWORD INTEGER 25550000 ADRLIST EQU COMMON1+00000064 FULLWORD POINTER 25560000 IND EQU COMMON1+00000068 4 BYTE(S) 25570000 GCODE EQU COMMON1+00000068 1 BYTE(S) 25580000 SPOOL EQU COMMON1+00000069 1 BYTE(S) 25590000 CCODE EQU COMMON1+00000070 2 BYTE(S) 25600000 GCADDR EQU COMMON1+00000072 FULLWORD POINTER 25610000 FIRSTGMO EQU COMMON1+00000076 FULLWORD POINTER 25620000 CURRGMO EQU COMMON1+00000080 FULLWORD POINTER 25630000 LASTGMO EQU COMMON1+00000084 FULLWORD POINTER 25640000 FIRSTGMI EQU COMMON1+00000088 FULLWORD POINTER 25650000 CURRGMI EQU COMMON1+00000092 FULLWORD POINTER 25660000 LASTGMI EQU COMMON1+00000096 FULLWORD POINTER 25670000 CONDCODE EQU COMMON1+00000100 HALFWORD INTEGER 25680000 MS EQU COMMON1+00000102 HALFWORD INTEGER 25690000 INBUFA1 EQU COMMON1+00000104 121 BYTE(S) 25700000 INFILL EQU COMMON1+00000104 10 BYTE(S) 25710000 INBUFA EQU COMMON1+00000114 111 BYTE(S) 25720000 DDPTR EQU COMMON1+00000228 FULLWORD POINTER 25730000 DUMMY1 EQU COMMON1+00000232 FULLWORD POINTER 25740000 COMMON2 EQU 00000536 76 BYTE(S) ON WORD 25750000 SWITCH EQU COMMON2+00000000 52 BYTE(S) 25760000 FDCSW EQU COMMON2+00000000 1 BYTE(S) 25770000 FDNAMESW EQU COMMON2+00000001 1 BYTE(S) 25780000 FDPCSW EQU COMMON2+00000002 1 BYTE(S) 25790000 FDFMTSW EQU COMMON2+00000003 1 BYTE(S) 25800000 FDPLSW EQU COMMON2+00000004 1 BYTE(S) 25810000 RANGESW EQU COMMON2+00000005 1 BYTE(S) 25820000 FILLSW EQU COMMON2+00000006 1 BYTE(S) 25830000 REPSW EQU COMMON2+00000007 1 BYTE(S) 25840000 INDEXSW EQU COMMON2+00000008 1 BYTE(S) 25850000 INDNMSW EQU COMMON2+00000009 1 BYTE(S) 25860000 BQUOTESW EQU COMMON2+00000010 1 BYTE(S) 25870000 PQUOTESW EQU COMMON2+00000011 1 BYTE(S) 25880000 EQUOTESW EQU COMMON2+00000012 1 BYTE(S) 25890000 FDSW EQU COMMON2+00000013 1 BYTE(S) 25900000 DSDSW EQU COMMON2+00000014 1 BYTE(S) 25910000 NOGOSW EQU COMMON2+00000015 1 BYTE(S) 25920000 CREATESW EQU COMMON2+00000016 1 BYTE(S) 25930000 DSDCSW EQU COMMON2+00000017 1 BYTE(S) 25940000 CRCSW EQU COMMON2+00000018 1 BYTE(S) 25950000 EXITSW EQU COMMON2+00000019 1 BYTE(S) 25960000 EODSTOP EQU COMMON2+00000020 1 BYTE(S) 25970000 DSDNULSW EQU COMMON2+00000021 1 BYTE(S) 25980000 DSDORGSW EQU COMMON2+00000022 1 BYTE(S) 25990000 DSDDDSW EQU COMMON2+00000023 1 BYTE(S) 26000000 CRTBLK EQU COMMON2+00000024 1 BYTE(S) 26010000 NAMCSW EQU COMMON2+00000025 8 BIT(S) 26020000 PICCSW EQU COMMON2+00000026 8 BIT(S) 26030000 BUFPSW EQU COMMON2+00000027 1 BYTE(S) 26040000 ENDSW EQU COMMON2+00000028 1 BYTE(S) 26050000 COMCSW EQU COMMON2+00000029 1 BYTE(S) 26060000 FLAGSW EQU COMMON2+00000030 8 BIT(S) 26070000 PAGESW EQU COMMON2+00000031 1 BYTE(S) 26080000 EPSW EQU COMMON2+00000032 1 BYTE POINTER 26090000 SYSISW EQU COMMON2+00000033 1 BYTE(S) 26100000 SYSPSW EQU COMMON2+00000034 1 BYTE(S) 26110000 OLDNEWSW EQU COMMON2+00000035 1 BYTE(S) 26120000 FLUSHSW EQU COMMON2+00000036 1 BYTE(S) 26130000 FLUSHSW1 EQU COMMON2+00000037 1 BYTE(S) 26140000 DSDOSW EQU COMMON2+00000038 1 BYTE(S) 26150000 DSDISW EQU COMMON2+00000039 1 BYTE(S) 26160000 QUANSW EQU COMMON2+00000040 1 BYTE(S) 26170000 PARENSW EQU COMMON2+00000041 1 BYTE(S) 26180000 REPEATSW EQU COMMON2+00000042 1 BYTE(S) 26190000 SYSINEOD EQU COMMON2+00000043 1 BYTE(S) 26200000 FDPLGTH EQU COMMON2+00000052 HALFWORD INTEGER 26210000 SGCADDR EQU COMMON2+00000056 FULLWORD POINTER 26220000 FDPTR EQU COMMON2+00000060 FULLWORD POINTER 26230000 FDPTR1 EQU COMMON2+00000064 FULLWORD POINTER 26240000 FDPTR2 EQU COMMON2+00000068 FULLWORD POINTER 26250000 DUMMY2 EQU COMMON2+00000072 FULLWORD POINTER 26260000 COMMON3 EQU 00000608 188 BYTE(S) ON WORD 26270000 FDCTR EQU COMMON3+00000000 HALFWORD POINTER 26280000 LREMAIN EQU COMMON3+00000004 FULLWORD POINTER 26290000 COMPCTR EQU COMMON3+00000008 FULLWORD POINTER 26300000 LMOVED EQU COMMON3+00000012 HALFWORD POINTER 26310000 U EQU COMMON3+00000016 FULLWORD POINTER 26320000 PICEND EQU COMMON3+00000020 HALFWORD POINTER 26330000 CURFDGM EQU COMMON3+00000024 FULLWORD POINTER 26340000 SWTCH EQU COMMON3+00000028 4 BYTE(S) ON WORD 26350000 SYSINSEL EQU COMMON3+00000028 1 BYTE(S) 26360000 FIRSTSW EQU COMMON3+00000029 1 BYTE(S) 26370000 FRSTSW EQU COMMON3+00000030 1 BYTE(S) 26380000 STOPSW EQU COMMON3+00000031 1 BYTE(S) 26390000 COPYVAL EQU COMMON3+00000032 HALFWORD INTEGER 26400000 COPYFD EQU COMMON3+00000036 FULLWORD POINTER 26410000 COPYFDGM EQU COMMON3+00000040 FULLWORD POINTER 26420000 NAMCTR EQU COMMON3+00000044 HALFWORD INTEGER 26430000 NAMCTR1 EQU COMMON3+00000046 HALFWORD INTEGER 26440000 INRECSZ EQU COMMON3+00000048 HALFWORD POINTER 26450000 OUTRECSZ EQU COMMON3+00000050 HALFWORD POINTER 26460000 INRECFM EQU COMMON3+00000052 1 BYTE(S) 26470000 RECOFFST EQU COMMON3+00000053 1 BYTE POINTER 26480000 OUTRECFM EQU COMMON3+00000054 1 BYTE(S) 26490000 PICBASE EQU COMMON3+00000056 FULLWORD POINTER 26500000 MESSAGE EQU COMMON3+00000060 121 BYTE(S) 26510000 DUMMY3 EQU COMMON3+00000184 FULLWORD POINTER 26520000 DCBD EQU 00000000 280 BYTE(S) ON DWORD 26530000 FILL EQU DCBD+00000000 26 BYTE(S) 26540000 DSORG1 EQU DCBD+00000026 2 BYTE(S) 26550000 DSORG EQU DCBD+00000026 8 BIT(S) 26560000 FILLER EQU DCBD+00000028 8 BYTE(S) 26570000 IOBAD EQU DCBD+00000028 4 BYTE(S) 26580000 BFTEK EQU DCBD+00000032 8 BIT(S) 26590000 EODAD EQU DCBD+00000033 3 BYTE(S) 26600000 RECFM EQU DCBD+00000036 8 BIT(S) 26610000 EXLIST EQU DCBD+00000037 3 BYTE POINTER ON WORD+1 26620000 DDNAME EQU DCBD+00000040 8 BYTE(S) 26630000 DEBAD EQU DCBD+00000040 4 BYTE(S) 26640000 IFLGS EQU DCBD+00000040 8 BIT(S) 26650000 GETAD EQU DCBD+00000048 4 BYTE(S) 26660000 OFLGS EQU DCBD+00000048 8 BIT(S) 26670000 OFLGS1 EQU DCBD+00000049 1 BYTE(S) 26680000 MACRF EQU DCBD+00000050 2 BYTE(S) 26690000 FILL2 EQU DCBD+00000052 10 BYTE(S) 26700000 BLKSI EQU DCBD+00000062 HALFWORD INTEGER 26710000 FILL3 EQU DCBD+00000064 18 BYTE(S) 26720000 LRECL EQU DCBD+00000082 HALFWORD INTEGER 26730000 FILL4 EQU DCBD+00000084 172 BYTE(S) 26740000 NEXTDCB EQU DCBD+00000256 FULLWORD POINTER 26750000 DDNAME1 EQU DCBD+00000260 8 BYTE(S) 26760000 EODSW EQU DCBD+00000268 1 BYTE(S) 26770000 DCBSW1 EQU DCBD+00000269 1 BYTE(S) 26780000 DCBSW2 EQU DCBD+00000270 1 BYTE(S) 26790000 DCBSW3 EQU DCBD+00000271 8 BIT(S) 26800000 INREC EQU DCBD+00000272 FULLWORD POINTER 26810000 GMLGTH EQU DCBD+00000276 HALFWORD INTEGER 26820000 FIELDSEL EQU DCBD+00000278 1 BYTE(S) 26830000 SPARE EQU DCBD+00000279 1 BYTE(S) 26840000 CRPICT EQU 00000000 7 BYTE(S) ON WORD 26850000 PICSTLOC EQU CRPICT+00000000 FULLWORD POINTER 26860000 PICLGTH EQU CRPICT+00000004 HALFWORD INTEGER 26870000 PICSTRNG EQU CRPICT+00000006 1 BYTE(S) 26880000 CRTAB EQU 00000000 28 BYTE(S) ON WORD 26890000 NXTCRTE EQU CRTAB+00000000 FULLWORD POINTER 26900000 QUAN EQU CRTAB+00000004 4 BYTE(S) 26910000 IDCBPTR EQU CRTAB+00000008 FULLWORD POINTER 26920000 EXITADR EQU CRTAB+00000012 FULLWORD POINTER 26930000 PICPTR EQU CRTAB+00000016 FULLWORD POINTER 26940000 FILLCH EQU CRTAB+00000020 1 BYTE POINTER 26950000 EMP1 EQU CRTAB+00000021 3 BYTE(S) 26960000 FDADTAB EQU CRTAB+00000024 FULLWORD POINTER 26970000 ENDFD EQU CRTAB+00000024 1 BYTE(S) 26980000 FDTBL EQU 00000000 520 BYTE(S) ON WORD 26990000 FDNAME EQU FDTBL+00000000 8 BYTE(S) 27000000 FDREPNM EQU FDTBL+00000008 8 BYTE(S) 27010000 FDINDNM EQU FDTBL+00000016 8 BYTE(S) ON WORD 27020000 FDUMMY EQU FDTBL+00000016 4 BYTE(S) 27030000 FDINDNUM EQU FDTBL+00000020 FULLWORD POINTER 27040000 FDLGTH EQU FDTBL+00000024 HALFWORD POINTER 27050000 FDCYCLE EQU FDTBL+00000026 HALFWORD POINTER 27060000 FDACTION EQU FDTBL+00000028 2 BYTE(S) 27070000 FDFORMAT EQU FDTBL+00000030 2 BYTE(S) 27080000 FDSWITCH EQU FDTBL+00000032 8 BIT(S) 27090000 INDBYNAM EQU FDTBL+00000032 1 BIT(S) 27100000 PASS EQU FDTBL+00000032 1 BIT(S) 27110000 FXACTION EQU FDTBL+00000032 1 BIT(S) 27120000 RPACTION EQU FDTBL+00000032 1 BIT(S) 27130000 ROACTION EQU FDTBL+00000032 1 BIT(S) 27140000 WVACTION EQU FDTBL+00000032 1 BIT(S) 27150000 STACTION EQU FDTBL+00000032 1 BIT(S) 27160000 NUACTION EQU FDTBL+00000032 1 BIT(S) 27170000 FDFILL EQU FDTBL+00000033 1 BYTE(S) 27180000 FDSIGN EQU FDTBL+00000034 1 BYTE(S) 27190000 FDCHAR EQU FDTBL+00000035 1 BYTE(S) 27200000 FDRANGE EQU FDTBL+00000036 4 BYTE(S) 27210000 FDOBUF EQU FDTBL+00000040 HALFWORD POINTER 27220000 FDFRINC EQU FDTBL+00000042 HALFWORD POINTER 27230000 FDFROMAD EQU FDTBL+00000044 4 BYTE(S) 27240000 FDMLGTH EQU FDTBL+00000048 HALFWORD POINTER 27250000 FDTOINC EQU FDTBL+00000050 HALFWORD POINTER 27260000 FDCYCCNT EQU FDTBL+00000052 HALFWORD POINTER 27270000 FDSLGTH EQU FDTBL+00000054 HALFWORD POINTER 27280000 FDSLGTHR EQU FDTBL+00000056 HALFWORD POINTER 27290000 FDFRINCR EQU FDTBL+00000058 1 BYTE(S) 27300000 FDTOINCR EQU FDTBL+00000059 1 BYTE(S) 27310000 LTOFREE EQU FDTBL+00000060 HALFWORD POINTER 27320000 FDSW1 EQU FDTBL+00000062 8 BIT(S) 27330000 STRTLOC1 EQU FDTBL+00000062 1 BIT(S) 27340000 NXTFDTAB EQU 00000516 FULLWORD POINTER 27350000 INBUF EQU 00000000 80 BYTE(S) 27360000 PARAM EQU 00000000 1 BYTE(S) 27370000 AREA EQU 00000000 512 BYTE(S) 27380000 NXTCRGM EQU 00000000 FULLWORD POINTER 27390000 NXTEXGM EQU 00000000 FULLWORD POINTER 27400000 EXITNAME EQU 00000000 8 BYTE(S) 27410000 NXTFDGM EQU 00000000 FULLWORD POINTER 27420000 FDADR EQU 00000000 FULLWORD POINTER 27430000 ONE EQU * FULLWORD INTEGER 27440000 DC FL4'0' 27450000 YES EQU * 1 BYTE(S) 27460000 DC X'FF' 27470000 NO EQU * 1 BYTE(S) 27480000 DC X'00' 27490000 ON EQU * 1 BYTE(S) 27500000 DC X'FF' 27510000 OFF EQU * 1 BYTE(S) 27520000 DC X'00' 27530000 FOXZEROS EQU * 16 BYTE(S) 27540000 DC X'F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0' 27550000 ORG @DATA 27560000 DS 00000024C 27570000 @L EQU 1 27580000 @DATD DSECT 27590000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 27600000 DS 00000072C 27610000 @TEMPS DS 0F 27620000 @TEMP4 DC F'0' 27630000 @T1 DC F'0' 27640000 @DATEND EQU * 27650000 IEBCRANL CSECT , 27660000 @9F7 EQU KEYSCAN 27670000 @9F0 EQU A6C5 27680000 @9D9 EQU CREATE 27690000 @9DA EQU CARDSCAN 27700000 @9D3 EQU CARDSCAN 27710000 RETURN2 EQU @EL01 27720000 @9C8 EQU A6M11 27730000 END IEBCRANL 27740000