* NEW MODULE, RELEASE 17. DG0H 00010000 * A27778 00020000 * A29841 00030000 *A445410-445630 @YA02530 00040000 *C219800 @ZA04231 00050000 *C219800 @ZA07345 00060000 LCLA &T,&SPN 0002 00070000 .@001 ANOP 0002 00080000 IEBFDTBL CSECT , 0002 00090000 ST @E,12(0,@D) 0002 00100000 STM @0,@8,20(@D) 0002 00110000 STM @A,@C,60(@D) 0002 00120000 BALR @B,0 0002 00130000 @PSTART DS 0H 0002 00140000 USING @PSTART+00000,@B 0002 00150000 LA @3,4095(0,@B) 0002 00160000 USING @PSTART+04095,@3 0002 00170000 L @0,@SIZ001 0002 00180000 GETMAIN R,LV=(0) 0002 00190000 LR @C,@1 0002 00200000 USING @DATD+00000,@C 0002 00210000 LM @0,@1,20(@D) 0002 00220000 XC @TEMPS(@L),@TEMPS 0002 00230000 ST @D,@SAV001+4 0002 00240000 LA @F,@SAV001 0002 00250000 ST @F,8(0,@D) 0002 00260000 LR @D,@F 0002 00270000 CLC 546(1,@5),ON 0044 00280000 * IF BQUOTESW = ON THEN GO TO F5G3 /*BR IF BINARY PICTURE*/; 00290000 BC 08,F5G3 0045 00300000 * IF PQUOTESW ^= ON THEN GO TO F6A1 /*BR IF NOT PD PICTURE*/; 00310000 CLC 547(1,@5),ON 0046 00320000 BC 07,F6A1 0047 00330000 * /******************************************************************* 00340000 * /** * 00350000 * /** THIS SECTION PICKS UP THE PICTURE LENGTH AND TEMPORARY * 00360000 * /** STORAGE ADDRESS(SGCADDR) AND VALIDITY CHECKS THE NUMBER FOR A * 00370000 * /** VALID DECIMAL VALUE. ACTION IS SET TO FIXED AS A NUMBER MAY * 00380000 * /** ONLY BE INCREMENTED(INDEXED).A BRANCH IS THEN TAKEN TO * 00390000 * /** PROCESS A PACKED DECIMAL NUMBER IF INDICATED. A DECIMAL NUMBER * 00400000 * /** IS REQUIRED BETWEEN THE DELIMITING QUOTES OF THE INITIAL * 00410000 * /** PICTURE * 00420000 * /** * 00430000 * /******************************************************************* 00440000 * F5G3:; 00450000 * R7 = FDPLGTH /**PICTURE LGTH FOR VALCHECK** 00460000 F5G3 LH @7,588(0,@5) 0049 00470000 * /* VALIDITY CHECK B OR P PICTURE */ 00480000 * R9 = SGCADDR /**PICK UP PICTURE ADDRESS**/; 00490000 L @9,592(0,@5) 0050 00500000 * CALL VALCHECK; 00510000 BAL @E,VALCHECK 0051 00520000 * FDACTION = 'FX' /**ACTION MUST BE FIXED**/; 00530000 L @1,596(0,@5) 0052 00540000 MVC 28(2,@1),@C1 0052 00550000 * IF PQUOTESW = ON THEN GO TO F5H4; 00560000 CLC 547(1,@5),ON 0053 00570000 BC 08,F5H4 0054 00580000 * /******************************************************************* 00590000 * /** * 00600000 * /** THIS SECTION PROCESSES A BINARY PICTURE. THE RANGESW IS * 00610000 * /** TURNED ON SO THAT THE CONVB ROUTINE WHEN CALLED WILL ALLOW * 00620000 * /** THE MAXIMUM BINARY NUMBER THAT CAN BE HELD IN A REGISTER. ONCE * 00630000 * /** CONVERTED, THE FIELD LENGTH IS PICKED UP AND A BRANCH TAKEN TO * 00640000 * /** F6F4 TO GET CORE TO HOLD THE BINARY NUMBER. * 00650000 * /** * 00660000 * /******************************************************************* 00670000 * RANGESW = ON /*ALLOW MAX BINARY NUMBER*/; 00680000 MVC 541(1,@5),ON 0055 00690000 * /* CONVERT PICTURE TO BINARY*/ 00700000 * CALL CONVB; 00710000 BAL @E,CONVB 0056 00720000 * Q = R6 /**SAVE BINARY NO IN Q **/; 00730000 ST @6,@TEMP4 0057 00740000 MVC 216(4,@5),@TEMP4 0057 00750000 MVI 220(@5),C' ' 0057 00760000 MVC 221(11,@5),220(@5) 0057 00770000 * /******************************************************************/ 00780000 * F5H3:; 00790000 * R6 = FDLGTH /**PICK UP FIELD LENGTH**/; 00800000 F5H3 L @1,596(0,@5) 0059 00810000 LH @6,24(0,@1) 0059 00820000 * GO TO F6F4 /** BR TO GET CORE**/; 00830000 BC 15,F6F4 0060 00840000 * /******************************************************************* 00850000 * /** * 00860000 * /** THIS SECTION WILL PROCESS A PACKED DECIMAL NUMBER. THE * 00870000 * /** MAXIMUM LENGTH WE CAN PACK IS 16 DIGITS. IF GREATER THAN 16,A * 00880000 * /** MESSAGE IS INDICATED AND A BRANCH IS TAKEN TO EXIT THE ROUTINE.* 00890000 * /** OTHERWISE, THE TEMPORARY STORAGE IS PICKED UP, THE NUMBER IS * 00900000 * /** PACKED AND A BRANCH TAKEN TO PICK UP THE FIELD LENGTH AND GET * 00910000 * /** CORE AS FOR A BINARY NUMBER. BOTH PD AND BI NUMBERS WILL * 00920000 * /** EVENTUALLY BE MOVED INTO PERMANENT STORAGE AFTER GETTING CORE * 00930000 * /** TO HOLD THEM. * 00940000 * /** * 00950000 * /******************************************************************* 00960000 * F5H4:; 00970000 * /* TEST NUMBER FOR MAX LENGTH*/ 00980000 * IF FDPLGTH =< 16 THEN GO TO F5J4 /*BR WE CAN PACK THIS NO.*/; 00990000 F5H4 LA @F,16 0062 01000000 CH @F,588(0,@5) 0062 01010000 BC 10,F5J4 0063 01020000 * /* LENGTH TOO LARGE*/ 01030000 * MS = 8 /* SET MESSAGE INDICATION*/; 01040000 LA @F,8 0064 01050000 STH @F,406(0,@5) 0064 01060000 * GO TO F1B411 /** BRANCH TO LEAVE ROUTINE**/; 01070000 BC 15,F1B411 0065 01080000 * F5F5:; 01090000 * GEN ( PACK Q(16,R5),0(1,R7)); 01100000 F5F5 PACK Q(16,R5),0(1,R7) 01110000 DS 0H 01120000 * F5J4:; 01130000 * R7 = SGCADDR /*PICK UP NUMBER ADDRESS*/; 01140000 F5J4 L @7,592(0,@5) 0069 01150000 * R6 = FDPLGTH - 1 /**RESOLVE LENGTH TO PACK**/; 01160000 LH @6,@D1 0070 01170000 AH @6,588(0,@5) 0070 01180000 * /* PACK NUMBER*/ 01190000 * GEN ( EX R6,F5F5); 01200000 EX R6,F5F5 01210000 DS 0H 01220000 * GO TO F5H3 /** BRANCH**/; 01230000 BC 15,F5H3 0072 01240000 * /******************************************************************/ 01250000 * /** * 01260000 * /** THIS SECTION SCANS FOR ACTION AND BRANCHES TO PROCESS.UNKNOWN * 01270000 * /** ACTION CAUSES A MESSAGE INDICATION.IF A USER ACTION IS EVER * 01280000 * /** ALLOWED IT IS PLANNED THAT THE KEYWORD WILL BE'US' WHEREUPON * 01290000 * /** A SPECIFIC NAME OF A ROUTINE FROM THE LINKLIB WOULD BE LOADED, * 01300000 * /** ITS ADDRESS SAVED SO THAT IEBCREAT WHEN IT ACCESSED THE * 01310000 * /** PARTICULAR FD TABLE FOR PROCESSING NAME WOULD BRANCH AND LINK * 01320000 * /** TO THIS ROUTINE.A PARAMETER LIST WOULD CONTAIN ADDRESS OF * 01330000 * /** RECORD SEGMENT TO BE ACTED UPON BY USER,DCB ADDRESS AND SEGMENT* 01340000 * /** LENGTH.PARAMETER LIST ADDRESS TO BE CONTAINED IN REGISTER ONE * 01350000 * /** * 01360000 * /******************************************************************* 01370000 * F6A1:; 01380000 * IF FDFORMAT = 'RA' THEN GO TO F6F2 /** BR RANDOM FORMAT MUST 01390000 F6A1 L @1,596(0,@5) 0074 01400000 CLC 30(2,@1),@C2 0074 01410000 * BE FIXED ACTION **/; 01420000 BC 08,F6F2 0075 01430000 * IF FDACTION = 'SL' THEN GO TO F6A2 /* IF SL BR TO SET INC*/; 01440000 CLC 28(2,@1),@C3 0076 01450000 BC 08,F6A2 0077 01460000 * IF FDACTION = 'TL' THEN GO TO F6B2 /* IF TL BR TO SET INC*/; 01470000 CLC 28(2,@1),@C4 0078 01480000 BC 08,F6B2 0079 01490000 * IF FDACTION = 'SR' THEN GO TO F6C2 /* IF SR BR TO SET INC*/; 01500000 CLC 28(2,@1),@C5 0080 01510000 BC 08,F6C2 0081 01520000 * IF FDACTION = 'TR' THEN DO /**DO FOLLOWING IF TRUNC RIGHT**/; 01530000 CLC 28(2,@1),@C6 0082 01540000 BC 07,@9FF 0082 01550000 * STACTION = '1'B /**INDICATE SHIFT OR TRUNC**/; 01560000 OI 32(@1),B'00000010' 0084 01570000 * GO TO F8B4 /** BRANCH TO RESOLVE LENGTH**/; 01580000 BC 15,F8B4 0085 01590000 * END; 01600000 * IF FDACTION = 'FX' THEN DO /**DO FOLLOWING IF FX ACTION**/; 01610000 @9FF L @1,596(0,@5) 0087 01620000 CLC 28(2,@1),@C1 0087 01630000 BC 07,@9FE 0087 01640000 * FXACTION = '1'B /**INDICATE FIXED ACTION**/; 01650000 OI 32(@1),B'00100000' 0089 01660000 * GO TO F8B4 /** BRANCH TO RESOLVE LENGTH**/; 01670000 BC 15,F8B4 0090 01680000 * END; 01690000 * IF FDACTION = '0000'X THEN GO TO F6F2 /*BR TO ASSIGN DEFAULT* 01700000 @9FE L @1,596(0,@5) 0092 01710000 CLC 28(2,@1),@X8 0092 01720000 BC 08,F6F2 0093 01730000 * IF FDACTION = 'RP' THEN DO /**DO FOLLOWING IF RIPPLE**/; 01740000 CLC 28(2,@1),@C9 0094 01750000 BC 07,@9FD 0094 01760000 * RPACTION = '1'B /**INDICATE RIPPLE ACTION**/; 01770000 OI 32(@1),B'00010000' 0096 01780000 * GO TO F6K2 /** BRANCH TO PROCESS**/; 01790000 BC 15,F6K2 0097 01800000 * END; 01810000 * IF EQUOTESW = ON THEN DO /**DO BELOW IF E PICT**/; 01820000 @9FD CLC 548(1,@5),ON 0099 01830000 BC 07,@9FC 0099 01840000 * IF FDACTION = 'RO' THEN DO /**DO FOLLOWING IF ROLL**/; 01850000 L @1,596(0,@5) 0101 01860000 CLC 28(2,@1),@C10 0101 01870000 BC 07,@9FB 0101 01880000 * ROACTION = '1'B /**INDICATE ROLL ACTION**/; 01890000 OI 32(@1),B'00001000' 0103 01900000 * GO TO F6H3 /**BR TO PROCESS**/; 01910000 BC 15,F6H3 0104 01920000 * END; 01930000 * IF FDACTION = 'WV' THEN DO /**DO FOLLOWING IF WAVE**/; 01940000 @9FB L @1,596(0,@5) 0106 01950000 CLC 28(2,@1),@C11 0106 01960000 BC 07,@9FA 0106 01970000 * WVACTION = '1'B /**INDICATE WAVE ACTION**/; 01980000 OI 32(@1),B'00000100' 0108 01990000 * GO TO F6K2 /**BRANCH TO PROCESS**/; 02000000 BC 15,F6K2 0109 02010000 * END; 02020000 * END; 02030000 @9FA EQU * 0111 02040000 * /*ERROR-ACTION SPECIFIED NOT SUPPORTED*/ 02050000 * /* * 02060000 * MS = 3 /*SET MESSAGE 3 */; 02070000 @9FC LA @F,3 0112 02080000 STH @F,406(0,@5) 0112 02090000 * GO TO F1B411 /**BRANCH TO EXIT ROUTINE**/; 02100000 BC 15,F1B411 0113 02110000 * F6A2:; 02120000 * STACTION = '1'B /**INDICATE SHIFT,TRUNC ACTION**/; 02130000 F6A2 L @1,596(0,@5) 0115 02140000 OI 32(@1),B'00000010' 0115 02150000 * FDFRINCR = '01'X /*SET FROM INC RESTORE TO ONE* 02160000 MVI 58(@1),X'01' 0116 02170000 * GO TO F8B4 /** BRANCH TO RESOLVE LENGTH**/; 02180000 BC 15,F8B4 0117 02190000 * F6B2:; 02200000 * FDFRINCR = '01'X /*SET FROM INC RESTORE TO ONE* 02210000 F6B2 L @1,596(0,@5) 0119 02220000 MVI 58(@1),X'01' 0119 02230000 * F6C2:; 02240000 * STACTION = '1'B /**INDICATE SHIFT,TRUNC ACTION**/; 02250000 F6C2 L @1,596(0,@5) 0121 02260000 OI 32(@1),B'00000010' 0121 02270000 * FDTOINCR = '01'X /*SET TO INC RESTORE TO ONE*/; 02280000 MVI 59(@1),X'01' 0122 02290000 * GO TO F8B4 /** BRANCH TO RESOLVE LENGTH**/; 02300000 BC 15,F8B4 0123 02310000 * F6F2:; 02320000 * FDACTION = 'FX' /*DEFAULT ACTION TO FIXED*/; 02330000 F6F2 L @1,596(0,@5) 0125 02340000 MVC 28(2,@1),@C1 0125 02350000 * FXACTION = '1'B /**INDICATE FIXED ACTION**/; 02360000 OI 32(@1),B'00100000' 0126 02370000 * GO TO F8B4 /** BRANCH TO RESOLVE LENGTH**/; 02380000 BC 15,F8B4 0127 02390000 * F6K2:; 02400000 * FDFRINCR = '01'X /*SET FROM INC RESTORE TO ONE* 02410000 F6K2 L @1,596(0,@5) 0129 02420000 MVI 58(@1),X'01' 0129 02430000 * GO TO F8A1 /*BR TO CONTINUE PROCESSING*/; 02440000 BC 15,F8A1 0130 02450000 * /******************************************************************* 02460000 * /** * 02470000 * /** THIS SECTION GETS CORE, LENGTH DEPENDING ON VALUE CONTAINED * 02480000 * /** IN REG6. A MESSAGE IS INDICATED WHEN THE CONDITIONAL GETMAIN * 02490000 * /** WAS UNSUCCESSFUL. OTHERWISE, A BRANCH IS TAKEN TO SECTION F7A1.* 02500000 * /** TO PROPAGATE THE FILL CHARACTER. * 02510000 * /** * 02520000 * /******************************************************************* 02530000 * F6F4:; 02540000 * /*GET MAIN TO HOLD PATTERN*/ 02550000 * R1 = ADDR(GETMLIST) /** PICK UP LIST ADDRESS ** 02560000 F6F4 LA @1,364(0,@5) 0132 02570000 * R7 = ADDR(GCADDR) /** PICK UP GCADDR ADDRESS ** 02580000 LA @7,376(0,@5) 0133 02590000 * /*ISSUE GET MAIN MACRO*/ 02600000 * GEN ( GETMAIN EC,LV=(R6),A=(R7),SP=0,MF=(E,(R1))); 02610000 GETMAIN EC,LV=(R6),A=(R7),SP=0,MF=(E,(R1)) 02620000 DS 0H 02630000 * IF R15 = 0 THEN GO TO F7A1 /*BR IF GM SUCCESSFUL*/; 02640000 LTR @F,@F 0135 02650000 BC 08,F7A1 0136 02660000 * MS = 10 /*SET MESSAGE FOR BAD GETMAIN* 02670000 LA @F,10 0137 02680000 STH @F,406(0,@5) 0137 02690000 * GO TO F1B411 /** BRANCH TO LEAVE ROUTINE**/; 02700000 BC 15,F1B411 0138 02710000 * /******************************************************************* 02720000 * /** * 02730000 * /** THIS SECTION WILL TRIPLE THE FIELD LENGTH WHICH IS REQUIRED * 02740000 * /** FOR THE ROLL PATTERN AND BRANCH TO GETMAIN BASED ON THE VALUE * 02750000 * /** OF REG6. * 02760000 * /** * 02770000 * /******************************************************************* 02780000 * F6H3:; 02790000 * FDFRINCR = '01'X /*SET FROM INC RESTORE TO ONE* 02800000 F6H3 L @1,596(0,@5) 0140 02810000 MVI 58(@1),X'01' 0140 02820000 * R6 = FDLGTH /*PICK UP FIELD LENGTH*/; 02830000 LH @6,24(0,@1) 0141 02840000 * R6 = R6 * 3 /*TRIPLE THE LENGTH*/; 02850000 MH @6,@D2 0142 02860000 * GO TO F6F4 /*BR TO GET MAIN*/; 02870000 BC 15,F6F4 0143 02880000 * /******************************************************************* 02890000 * /** * 02900000 * /** THIS SECTION WILL INITIALIZE THE FDFROMAD TO THE ADDRESS * 02910000 * /** JUST OBTAINED AT F6F4. IT WILL THEN PROPAGATE THE FILL * 02920000 * /** CHARACTER THROUGHOUT THE FIELD. IF A BI OF PD FORMAT IS * 02930000 * /** INDICATED, THE FIELD WILL BE FILLED WITH BINARY ZEROS. * 02940000 * /** * 02950000 * /******************************************************************* 02960000 * F7A1:; 02970000 * LTOFREE = R6 /*SAVE LENGTH FOR FREEING*/; 02980000 F7A1 L @1,596(0,@5) 0145 02990000 STH @6,60(0,@1) 0145 03000000 * R8 = GCADDR /*WORK ADDRESS TO REG */; 03010000 L @8,376(0,@5) 0146 03020000 * FDFROMAD = R8 /**INITILIZE FD FROM ADDRESS*/; 03030000 ST @8,44(0,@1) 0147 03040000 * IF FDFORMAT = 'BI' THEN DO /**BR IF NOT BI TO TEST FOR PD **/ 03050000 CLC 30(2,@1),@C13 0148 03060000 BC 07,@9F9 0148 03070000 * FDFILL = '00'X /**INITILIZE FILL TO '00'X **/; 03080000 MVI 33(@1),X'00' 0150 03090000 * END; 03100000 * IF FDFORMAT = 'PD' THEN DO /**BR IF NOT PD TO FILL FIELD **/; 03110000 @9F9 L @1,596(0,@5) 0152 03120000 CLC 30(2,@1),@C14 0152 03130000 BC 07,@9F8 0152 03140000 * FDFILL = '00'X /**INITILIZE FILL TO '00'X **/; 03150000 MVI 33(@1),X'00' 0154 03160000 * END; 03170000 * R8 -> INBUF(1) = FDFILL /**FILL CHARACTER TO FIELD**/; 03180000 @9F8 L @1,596(0,@5) 0156 03190000 MVC 0(1,@8),33(@1) 0156 03200000 * R6 = R6 - 1 /**CORRECT THE LENGTH**/; 03210000 BCTR @6,0 0157 03220000 * F7A2:; 03230000 * IF R6 = 0 THEN GO TO F7A5 /**BR FIELD IS FILLED**/; 03240000 F7A2 LTR @6,@6 0159 03250000 BC 08,F7A5 0160 03260000 * IF R6 <= 256 THEN GO TO F7A4 /**BR LT OR EQ TO 256 TO MOVE**/ 03270000 CH @6,@D3 0161 03280000 BC 12,F7A4 0162 03290000 * /**FILL 256 BYTES**/ 03300000 * GEN ( MVC 1(256,R8),0(R8)); 03310000 MVC 1(256,R8),0(R8) 03320000 DS 0H 03330000 * R6 = R6 - 256 /**DECREMENT LENGTH BY 256**/; 03340000 SH @6,@D3 0164 03350000 * R8 = R8 + 256 /**INCREMENT ADDRESS BY 256**/; 03360000 AH @8,@D3 0165 03370000 * GO TO F7A2 /**BRANCH MORE TO MOVE**/; 03380000 BC 15,F7A2 0166 03390000 * /**FILL OUT REST OF AREA**/ 03400000 * F7A3:; 03410000 * GEN ( MVC 1(1,R8),0(R8)); 03420000 F7A3 MVC 1(1,R8),0(R8) 03430000 DS 0H 03440000 * F7A4:; 03450000 * R6 = R6 - 1 /**LENGTH FOR EXECUTE**/; 03460000 F7A4 BCTR @6,0 0170 03470000 * GEN ( EX R6,F7A3); 03480000 EX R6,F7A3 03490000 DS 0H 03500000 * /******************************************************************* 03510000 * /** * 03520000 * /** AT THIS POINT THE LENGTH REGISTER IS RESTORED AND IF A BI OR* 03530000 * /** PD PICTURE IS PRESENT A BRANCH IS TAKEN FOR THEIR FINAL * 03540000 * /** INITIALIZATION.IF NOT AN EBCDIC PICTURE A BRANCH IS TAKEN TO * 03550000 * /** PROCESS IBM SUPPLIED NUMBER FORMATS. * 03560000 * /** * 03570000 * /******************************************************************* 03580000 * F7A5:; 03590000 * R6 = LTOFREE /**RESTORE LENGTH REGISTER**/; 03600000 F7A5 L @1,596(0,@5) 0173 03610000 LH @6,60(0,@1) 0173 03620000 * IF PQUOTESW = ON THEN GO TO F10A2 /**BR IF PD NO**/; 03630000 CLC 547(1,@5),ON 0174 03640000 BC 08,F10A2 0175 03650000 * IF BQUOTESW = ON THEN GO TO F10A4 /**BR IF BINARY NO**/; 03660000 CLC 546(1,@5),ON 0176 03670000 BC 08,F10A4 0177 03680000 * IF EQUOTESW ^= ON THEN GO TO F8G1 /*BR NOT PICT-ITS IBM FMT*/ 03690000 CLC 548(1,@5),ON 0178 03700000 BC 07,F8G1 0179 03710000 * /******************************************************************/ 03720000 * /*AT THIS POINT WE ARE PROCESSING A USER */ 03730000 * /*DEFINED EBCDIC PICTURE WHICH WILL BE */ 03740000 * /*ROLLED WAVED OR RIPPLED.THE PICTURE HAS*/ 03750000 * /*BEEN SCANNED FROM THE FD CONTROL CARD AT*/ 03760000 * /*WHICH TIME IT WAS PLACED AT SGCADDR*/ 03770000 * /*ITS FINAL RESTING PLACE WILL BE GCADDR*/ 03780000 * /*EQUALS FROM ADDR WHERE THE PICTURE WILL*/ 03790000 * /*BE DOUBLED FOR WAVE AND RIPPLE-TRIPLED*/ 03800000 * /*FOR ROLL.IT WILL BE MOVED BY SETTING UP*/ 03810000 * /*TO AND FROM ADDRESSES AND CALLING MOVEROUT* 03820000 * /*THE REQUIRED NUMBER OF TIMES*/ 03830000 * /* */ 03840000 * /******************************************************************/ 03850000 * /* */ 03860000 * /******************************************************************* 03870000 * /** * 03880000 * /** THIS SECTION TESTS FOR PICTURE LENGTH BEING LONGER THAN FD * 03890000 * /** LENGTH.IF SO A MESSAGE IS INDICATED AND A BRANCH TAKEN TO EXIT.* 03900000 * /** * 03910000 * /******************************************************************* 03920000 * IF FDLGTH >= FDPLGTH THEN GO TO F7A7 /**IF PLGTH OK BRANCH**/ 03930000 LH @F,588(0,@5) 0180 03940000 CH @F,24(0,@1) 0180 03950000 BC 12,F7A7 0181 03960000 * MS = 16 /**INDICATE MESSAGE**/; 03970000 LA @F,16 0182 03980000 STH @F,406(0,@5) 0182 03990000 * GO TO F1B411 /**BRANCH TO EXIT ROUTINE**/; 04000000 BC 15,F1B411 0183 04010000 * /******************************************************************* 04020000 * /** * 04030000 * /** HERE THE FROM AND TOO ADDRESSES OF THE PICTURE AND LENGTH * 04040000 * /** ARE PICKED UP.IF ROLL ACTION A BRANCH IS TAKEN TO MOVE THE * 04050000 * /** PICTURE THREE TIMES.WAVE AND RIPPLE REQUIRE A DOUBLE PATTERN IN* 04060000 * /** CORE.IF NOT ROLL,WAVE OR RIPPLE A BRANCH IS TAKEN TO MOVE * 04070000 * /** PICTURE ONCE. * 04080000 * /** * 04090000 * /******************************************************************* 04100000 * F7A7:; 04110000 * /*RESOLVE THE FROM ADDRESS = SGCADDR*/ 04120000 * R9 = SGCADDR /*FROM ADDRESS RESOLVED*/; 04130000 F7A7 L @9,592(0,@5) 0185 04140000 * /*LENGTH TO MOVE = FDLGTH*/ 04150000 * R7 = FDPLGTH /*PICK UP LGTH TO MOVE*/; 04160000 LH @7,588(0,@5) 0186 04170000 * /* TO ADDRESS = GCADDR*/ 04180000 * R8 = GCADDR /*TO ADDRESS RESOLVED*/; 04190000 L @8,376(0,@5) 0187 04200000 * /*IF PATTERN IS A ROLL THE FDFROMAD MUST*/ 04210000 * /*EQUAL THE SECOND PATTERN ADDR FOR WAVE OR*/ 04220000 * /*RIPPLE IT EQUALS GCADDR*/ 04230000 * R6 = R8 /* SAVE ADDRESS*/; 04240000 LR @6,@8 0188 04250000 * IF FDACTION = 'RO' THEN GO TO F7C3 /**BR FOR ROLLING ACTION** 04260000 L @1,596(0,@5) 0189 04270000 CLC 28(2,@1),@C10 0189 04280000 BC 08,F7C3 0190 04290000 * IF FDACTION = 'WV' THEN GO TO F7E3 /**BRANCH IF WAVE**/; 04300000 CLC 28(2,@1),@C11 0191 04310000 BC 08,F7E3 0192 04320000 * IF FDACTION = 'RP' THEN GO TO F7E3 /**BRANCH IF ROLL**/; 04330000 CLC 28(2,@1),@C9 0193 04340000 BC 08,F7E3 0194 04350000 * FDFROMAD = GCADDR /**INIT FD FROM ADDRESS**/; 04360000 MVC 44(4,@1),376(@5) 0195 04370000 * GO TO F7E4 /**BRANCH TO MOVE PICTURE ONCE**/; 04380000 BC 15,F7E4 0196 04390000 * /******************************************************************/ 04400000 * /*RIPPLE AND WAVE HERE */ 04410000 * /*MOVE THE PICTURE TO FDFROMAD */ 04420000 * /*FOR USE OF THE CREATE MODULE*/ 04430000 * /** ENTRY HERE MOVES PICTURE TWICE INTO GCADDR * 04440000 * /** * 04450000 * /******************************************************************* 04460000 * F7E3:; 04470000 * CALL MOVEROUT; 04480000 F7E3 BAL @E,MOVEROUT 0198 04490000 * /*ADDRESS WERE DESTROYED BY THE MOVE ROUTINE* 04500000 * R9 = SGCADDR /*FROM ADDRESS RESOLVED*/; 04510000 L @9,592(0,@5) 0199 04520000 * R7 = FDPLGTH /*LENGTH RESOLVED*/; 04530000 LH @7,588(0,@5) 0200 04540000 * R8 = R6 + FDLGTH /**RESOLVE TOO ADDRESS**/; 04550000 L @1,596(0,@5) 0201 04560000 LH @8,24(0,@1) 0201 04570000 AR @8,@6 0201 04580000 * /******************************************************************* 04590000 * /** * 04600000 * /** ENTRY HERE MOVES PICTURE ONCE * 04610000 * /** * 04620000 * /******************************************************************* 04630000 * F7E4:; 04640000 * /* MOVE FOR THE LAST TIME*/ 04650000 * CALL MOVEROUT; 04660000 F7E4 BAL @E,MOVEROUT 0203 04670000 * /*CORE MAY NOW BE FREED THAT HELD THE */ 04680000 * /* ORIGINAL PICTURE*/ 04690000 * /******************************************************************* 04700000 * /** * 04710000 * /** THIS SECTION FREES CORE OBTAINED FOR TEMPORARY STORAGE. * 04720000 * /** THIS SECTION IS ONE OF THE EXIT POINTS FROM THIS ROUTINE.IT * 04730000 * /** WILL CLEAR ALL FD SWITCHES SET DURING THIS EXECUTION AND RETURN* 04740000 * /** TO IEBFDANL * 04750000 * /** * 04760000 * /******************************************************************* 04770000 * F7G3:; 04780000 * R6 = FDPLGTH /*PICK UP LENGTH TO FREE*/; 04790000 F7G3 LH @6,588(0,@5) 0205 04800000 * R7 = ADDR(SGCADDR) /**ADDRESS OF ADDRESS TO FREE**/; 04810000 LA @7,592(0,@5) 0206 04820000 * R1 = ADDR(GETMLIST) /*PICK UP LIST ADDR FOR MACRO* 04830000 LA @1,364(0,@5) 0207 04840000 * GEN ( FREEMAIN E,LV=(R6),A=(R7),SP=0,MF=(E,(1))); 04850000 FREEMAIN E,LV=(R6),A=(R7),SP=0,MF=(E,(1)) 04860000 DS 0H 04870000 * F7H3:; 04880000 * /* CLEAR SWITCHES*/ 04890000 * SWITCH(1:14) = SWITCH(1:14) && SWITCH(1:14) /*FD SWIT OFF*/; 04900000 F7H3 XC 536(14,@5),536(@5) 0210 04910000 * /*RETURN TO BASE MODULE ONE ENTRY DONE*/ 04920000 * RETURN; 04930000 BC 15,@EL01 0211 04940000 * /******************************************************************* 04950000 * /** ENTRY HERE CAUSES THE PICTURE TO BE MOVED THREE TIMES. * 04960000 * /******************************************************************* 04970000 * F7C3:; 04980000 * /*MOVE FIRST PATTERN TO WKAREA*/ 04990000 * /* ADDRESSES ARE RESOLVED*/ 05000000 * CALL MOVEROUT; 05010000 F7C3 BAL @E,MOVEROUT 0213 05020000 * /*RESOLVE ADDRESSES AND LENGTH BEFORE*/ 05030000 * /*BRANCH TO MOVE 2ND TIME*/ 05040000 * R9 = SGCADDR /*FROM ADDRESS RESOLVED*/; 05050000 L @9,592(0,@5) 0214 05060000 * R7 = FDPLGTH /*LENGTH RESOLVED*/; 05070000 LH @7,588(0,@5) 0215 05080000 * R8 = R6 + FDLGTH /**RESOLVE TOO ADDRESS**/; 05090000 L @1,596(0,@5) 0216 05100000 LH @8,24(0,@1) 0216 05110000 AR @8,@6 0216 05120000 * FDFROMAD = R8 /**INITILIZE CORRECT FROM ADDRESS**/; 05130000 ST @8,44(0,@1) 0217 05140000 * R6 = R8 /*SAVE ADDRESS*/; 05150000 LR @6,@8 0218 05160000 * GO TO F7E3 /*BR TO MOVE 2ND TIME*/; 05170000 BC 15,F7E3 0219 05180000 * /******************************************************************* 05190000 * /** * 05200000 * /** ENTRY IS TO THIS POINT WHEN AL,AN,CO OR USER PICTURE WANTED * 05210000 * /** * 05220000 * /** THIS SECTION WILL TEST FOR FORMAT AND IF FOUND WILL BRANCH * 05230000 * /** TO SET UP SEQUENCE LENGTH AND SEQUENCE LENGTH RESTORES FOR THE * 05240000 * /** CREATE MODULE.THE LENGTH THAT THE PATTERN NEEDS WILL ALSO BE * 05250000 * /** DETERMINED.IF NO FORMAT,A PICTURE IS PRESENT,A BRANCH WILL BE * 05260000 * /** TAKEN TO DOUBLE THE FIELD LENGTH. * 05270000 * /** * 05280000 * /******************************************************************* 05290000 * F8A1:; 05300000 * IF FDFORMAT = 'AL' THEN GO TO F8A4 /*BR IF AL FORMAT*/; 05310000 F8A1 L @1,596(0,@5) 0221 05320000 CLC 30(2,@1),@C15 0221 05330000 BC 08,F8A4 0222 05340000 * IF FDFORMAT = 'AN' THEN GO TO F8B3 /*BR IF AN FORMAT*/; 05350000 CLC 30(2,@1),@C16 0223 05360000 BC 08,F8B3 0224 05370000 * IF FDFORMAT = 'CO' THEN GO TO F8D2 /*BR IF CO FORMAT*/; 05380000 CLC 30(2,@1),@C17 0225 05390000 BC 08,F8D2 0226 05400000 * /*USER PICTURE BR TO DOUBLE FIELD*/ 05410000 * GO TO F8B4 /*BRANCH TO DOUBLE FIELD*/; 05420000 BC 15,F8B4 0227 05430000 * /******************************************************************* 05440000 * /** * 05450000 * /** THIS SECTION IS ENTERED FOR AN ALPHABETIC SEQUENCE.IF THE * 05460000 * /** FIELD LENGTH IS GREATER THAN THE SEQUENCE LENGTH OF 26 A BRANCH* 05470000 * /** IS TAKEN TO TEST FOR RIPPLE OR WAVE ACTION. * 05480000 * /******************************************************************* 05490000 * F8A4:; 05500000 * IF FDLGTH > '001A'X THEN GO TO F8B4 /*BR WHEN OVER 26 LONG*/; 05510000 F8A4 L @F,@X18 0229 05520000 L @1,596(0,@5) 0229 05530000 CH @F,24(0,@1) 0229 05540000 BC 04,F8B4 0230 05550000 * FDSLGTHR = '001A'X /*SEQ LGTH RESTORE TO 26*/; 05560000 MVC 56(2,@1),@X18+2 0231 05570000 * FDSLGTH = FDSLGTHR /**INIT SEQ LGTH FOR RIPPLE**/; 05580000 MVC 54(2,@1),56(@1) 0232 05590000 * R6 = FDLGTH + 26 /*LGTH FOR GMAIN FOR PATTERN*/ 05600000 LA @6,26 0233 05610000 AH @6,24(0,@1) 0233 05620000 * GO TO F6F4 /*BR TO GET MAIN*/; 05630000 BC 15,F6F4 0234 05640000 * /******************************************************************* 05650000 * /** * 05660000 * /** THIS SECTION IS ENTERED FOR AN ALPHANUMERIC SEQUENCE. * 05670000 * /******************************************************************* 05680000 * F8B3:; 05690000 * IF FDLGTH < '0024'X THEN GO TO F8C3 /**BRANCH LT 36 **/; 05700000 F8B3 L @F,@X19 0236 05710000 L @1,596(0,@5) 0236 05720000 CH @F,24(0,@1) 0236 05730000 BC 02,F8C3 0237 05740000 * /******************************************************************* 05750000 * /** * 05760000 * /** THIS SECTION WILL DOUBLE THE FIELD LENGTH FOR WAVE OR RIPPLE* 05770000 * /** ACTION.A BRANCH IS TAKEN TO F6F4 TO GETMAIN TO HOLD THE PATTERN* 05780000 * /** IF NOT RP OR WV. * 05790000 * /******************************************************************* 05800000 * F8B4:; 05810000 * FDSLGTHR = FDLGTH /*SEQ RESTORE TO FIELD LGTH*/; 05820000 F8B4 L @1,596(0,@5) 0239 05830000 MVC 56(2,@1),24(@1) 0239 05840000 * IF FDACTION = 'RP' THEN DO /**IF RIPPLE DO FOLLOWING**/; 05850000 CLC 28(2,@1),@C9 0240 05860000 BC 07,@9F7 0240 05870000 * FDSLGTH = FDSLGTHR /**INIT SEQ LGTH FOR RIPPLE ONLY**/; 05880000 MVC 54(2,@1),56(@1) 0242 05890000 * GO TO F8B5 /**BRANCH TO DOUBLE FIELD LGTH**/; 05900000 BC 15,F8B5 0243 05910000 * END; 05920000 * IF FDACTION ^= 'WV' THEN GO TO F6F4 /**BR NOT WAVE**/; 05930000 @9F7 L @1,596(0,@5) 0245 05940000 CLC 28(2,@1),@C11 0245 05950000 BC 07,F6F4 0246 05960000 * F8B5:; 05970000 * R6 = FDLGTH * 2 /*DOUBLE THE FIELD LENGTH*/; 05980000 F8B5 LA @E,2 0248 05990000 L @1,596(0,@5) 0248 06000000 MH @E,24(0,@1) 0248 06010000 LR @6,@E 0248 06020000 * GO TO F6F4 /*BR TO GET MAIN*/; 06030000 BC 15,F6F4 0249 06040000 * /******************************************************************* 06050000 * /** * 06060000 * /** THIS SECTION IS ENTERED FOR AN ALPHANUMERIC SEQUENCE.IT WILL* 06070000 * /** SET THE SEQUENCE LENGTH RESTORES AND DETERMINE THE LENGTH FOR * 06080000 * /** THE GETMAIN AT F6F4. * 06090000 * /******************************************************************* 06100000 * F8C3:; 06110000 * FDSLGTHR = '0024'X /*SEQ LGTH RESTORE TO 36 */; 06120000 F8C3 L @1,596(0,@5) 0251 06130000 MVC 56(2,@1),@X19+2 0251 06140000 * FDSLGTH = FDSLGTHR /**INIT SEQ LGTH FOR RIPPLE**/; 06150000 MVC 54(2,@1),56(@1) 0252 06160000 * R6 = FDLGTH + 36 /*LGTH FOR GM FOR PATTERN*/; 06170000 LA @6,36 0253 06180000 AH @6,24(0,@1) 0253 06190000 * GO TO F6F4 /*BR TO GET MAIN*/; 06200000 BC 15,F6F4 0254 06210000 * /******************************************************************* 06220000 * /** * 06230000 * /** THIS SECTION IS ENTERED FOR A COLLATTING SEQUENCE.IT WILL * 06240000 * /** SET THE SEQUENCE LENGTH RESTORES AND DETERMINE THE LENGTH FOR * 06250000 * /** THE GETMAIN AT F6F4. * 06260000 * /******************************************************************* 06270000 * F8D2:; 06280000 * IF FDLGTH > '003F'X THEN GO TO F8B4 /*BRANCH GT 63 */; 06290000 F8D2 L @F,@X20 0256 06300000 L @1,596(0,@5) 0256 06310000 CH @F,24(0,@1) 0256 06320000 BC 04,F8B4 0257 06330000 * FDSLGTHR = '003F'X /*SEQ LGTH RESTORE TO 63 */; 06340000 MVC 56(2,@1),@X20+2 0258 06350000 * FDSLGTH = FDSLGTHR /**INIT SEQ LGTH FOR RIPPLE**/; 06360000 MVC 54(2,@1),56(@1) 0259 06370000 * R6 = FDLGTH + 63 /*LGTH FOR GM FOR PATTERN*/; 06380000 LA @6,63 0260 06390000 AH @6,24(0,@1) 0260 06400000 * GO TO F6F4 /*BR TO GET MAIN*/; 06410000 BC 15,F6F4 0261 06420000 * /******************************************************************* 06430000 * /** * 06440000 * /** THIS SECTION WILL TEST FOR RANDOM FORMAT WHICH AT THIS TIME * 06450000 * /** NEEDS NO FURTHER PROCESSING IN THIS MODULE.IF RANDOM A NUMBER * 06460000 * /** IS INDICATED AND A BRANCH IS TAKEN TO F7H3 TO EXIT THIS MODULE.* 06470000 * /******************************************************************* 06480000 * F8G1:; 06490000 * IF FDFORMAT = 'RA' THEN DO /** DO BELOW IF RANDOM**/; 06500000 F8G1 L @1,596(0,@5) 0263 06510000 CLC 30(2,@1),@C2 0263 06520000 BC 07,@9F6 0263 06530000 * R6 = U ; /* PICK UP LAST RANDOM @YA02530* 06540000 L @6,624(0,@5) 0265 06550000 * GENERATE ; 06560000 LA R7,1 SET ALL FF IN R7 @YA02530 06570000 LCR R7,R7 FOR SUBTRACTING @YA02530 06580000 SRDL R6,8 SHIFT TO RETAIN @YA02530 06590000 SLL R6,8 CLEAN NUMBER @YA02530 06600000 SLR R7,R6 SUBTRACT TO NUMBER @YA02530 06610000 SRL R6,8 SHIFT TO GET BYTE @YA02530 06620000 SLDL R6,8 PLACE IN @YA02530 06630000 DS 0H 06640000 * R7 = 524293 ; /* INIT MULTIPLIER @YA02530* 06650000 L @7,@D4 0267 06660000 * GENERATE ; 06670000 MR R6,R6 MULTIPLY FOR NEW RANDOM @YA02530 06680000 LA R6,3201 LOAD NUMBER FOR ADD @YA02530 06690000 ALR R7,R6 ADD VALUE RANDOMIZING @YA02530 06700000 LR R6,R7 SAVE NEW VALUE @YA02530 06710000 SLL R7,24 SHIFT TO ADD RANDOM # @YA02530 06720000 ALR R7,R6 ADD TO NEW # TO AVOID @YA02530 06730000 SRL R6,8 PAIR/UNPAIR SEQUENCE @YA02530 06740000 SLDL R6,8 RESULT RANDOM @YA02530 06750000 DS 0H @YA02530 06760000 DS 0H 06770000 * U = R6 ; /* NEW RANDOM # @YA02530* 06780000 ST @6,624(0,@5) 0269 06790000 * FDMLGTH = FDLGTH /**INITILIZE MOVE LENGTH**/; 06800000 L @1,596(0,@5) 0270 06810000 MVC 48(2,@1),24(@1) 0270 06820000 * IF FDLGTH > 4 THEN R6 = 4 /**IF LGTH GT 4 THEN MAKE MOVE REG 06830000 LA @F,4 0271 06840000 CH @F,24(0,@1) 0271 06850000 BC 10,@9F5 0271 06860000 * 4 **/; 06870000 LR @6,@F 0272 06880000 BC 15,@9F4 0273 06890000 * ELSE R6 = FDLGTH /** LGTH LT 4 REG EQ LGTH**/; 06900000 @9F5 LH @6,24(0,@1) 0273 06910000 * R9 = FDFROMAD + FDLGTH - R6 /**DERIVE ADDRESS FOR RANDOM NUMB 06920000 * R**/; 06930000 @9F4 LCR @9,@6 0274 06940000 LH @0,24(0,@1) 0274 06950000 ALR @9,@0 0274 06960000 AL @9,44(0,@1) 0274 06970000 * R7 = ADDR(U) /**PICK UP RANDOM NUMBER ADDRESS**/; 06980000 LA @7,624(0,@5) 0275 06990000 * R7 = R7 - R6 + 4 /** ADDRESS PROPER PART OF U **/; 07000000 LA @F,4 0276 07010000 SR @F,@6 0276 07020000 AR @7,@F 0276 07030000 * INBUF(1:R6) = R7 -> INBUF(1:R6) /**INIT RANDOM NUMBER**/; 07040000 LR @E,@7 0277 07050000 LR @2,@6 0277 07060000 BCTR @2,0 0277 07070000 LR @A,@9 0277 07080000 EX @2,@MVC 0277 07090000 * F8G2:; 07100000 * FDSWITCH = 'C0'X & FDSWITCH /**TURN OFF ACTION IND FOR CR**/; 07110000 F8G2 L @1,596(0,@5) 0279 07120000 NI 32(@1),X'C0' 0279 07130000 * NUACTION = '1'B /**TURN ON NUMBER ACTION SWITCH**/; 07140000 OI 32(@1),B'00000001' 0280 07150000 * GO TO F7H3 /** BR TO EXIT ROUTINE**/; 07160000 BC 15,F7H3 0281 07170000 * END; 07180000 * /******************************************************************* 07190000 * /** * 07200000 * /** THIS SECTION TESTS FOR REST OF FORMATS.IF NO FORMAT WAS * 07210000 * /** SPECIFIED,ACTION IS DEFAULTED TO FIXED.FORMAT DEFAULT IS THE * 07220000 * /** FILL CHARACTER,ALREADY PROPOGATED THROUGH THE FIELD.IF NO FILL * 07230000 * /** THERE IS A DEFAULT OF BINARY ZERO.WHEN A FORMAT IS FOUND A * 07240000 * /** BRANCH IS TAKEN FOR FURTHER PROCESSING. * 07250000 * /******************************************************************* 07260000 * IF FDFORMAT = 'BI' THEN GO TO F8H2 /*BR ITS BI FORMAT*/; 07270000 @9F6 L @1,596(0,@5) 0283 07280000 CLC 30(2,@1),@C13 0283 07290000 BC 08,F8H2 0284 07300000 * IF FDFORMAT = 'PD' THEN GO TO F8J4 /*BR ITS PD FORMAT*/; 07310000 CLC 30(2,@1),@C14 0285 07320000 BC 08,F8J4 0286 07330000 * IF FDFORMAT = 'ZD' THEN GO TO F8K2 /*BRANCH IF ZD FORMAT*/; 07340000 CLC 30(2,@1),@C22 0287 07350000 BC 08,F8K2 0288 07360000 * /** IF FORMAT IS SPECIFIED BRANCH **/ 07370000 * IF FDFORMAT ^= '0000'X THEN GO TO F9A1 /** BR A FORMAT**/; 07380000 CLC 30(2,@1),@X8 0289 07390000 BC 07,F9A1 0290 07400000 * /** AT THIS POINT NO FORMAT WAS ASSIGNED - FILL CHAR HAS BEEN **/ 07410000 * /** MOVED THROUGH FIELD SEE F7A1. A BRANCH WILL BE TAKEN TO **/ 07420000 * FXACTION = '1'B /** TURN ON FX ACTION SWITCH**/; 07430000 OI 32(@1),B'00100000' 0291 07440000 * GO TO F7H3 /**BRANCH TO FINISH UP**/; 07450000 BC 15,F7H3 0292 07460000 * /******************************************************************* 07470000 * /** * 07480000 * /** BINARY FORMAT IS PROCESSED HERE * 07490000 * /** * 07500000 * /** IF THE SIGN WAS SPECIFIED AS NEGATIVE A BRANCH IS TAKEN TO NEXT* 07510000 * /** SECTION.A POSITIVE BINARY FIELD IS INITILIZED BY LOCATING THE * 07520000 * /** RIGHTMOST BYTE IN THE FIELD AND PLACING A '01'X IN IT.A BRANCH * 07530000 * /** IS THEN TAKEN TO TURN ON NUMBER ACTION SWITCH AND EXIT. * 07540000 * /******************************************************************* 07550000 * F8H2:; 07560000 * IF FDSIGN = '-' THEN GO TO F8H3 /*BR BI SIGN NEG*/; 07570000 F8H2 L @1,596(0,@5) 0294 07580000 CLI 34(@1),C'-' 0294 07590000 BC 08,F8H3 0295 07600000 * /*POS BI SIGN HERE*/ 07610000 * R9 = FDFROMAD + FDLGTH - 1 /**POINT AT RIGHTMOST BYTE**/; 07620000 L @9,@D5 0296 07630000 LH @0,24(0,@1) 0296 07640000 ALR @9,@0 0296 07650000 AL @9,44(0,@1) 0296 07660000 * R9 -> WKADDR(1) = '01'X /*INIT FIELD TO POS ONE*/; 07670000 MVI 0(@9),X'01' 0297 07680000 * GO TO F8G2 /** BR TO TURN ON NU ACTION SWITCH**/; 07690000 BC 15,F8G2 0298 07700000 * /******************************************************************* 07710000 * /** * 07720000 * /** NEGATIVE BINARY NUMBER HERE * 07730000 * /** THE FIELD ADDRESS IS PICKED UP AND A 'FF'X IS PLACED IN THE * 07740000 * /** FIRST BYTE.IF THE FIELD LENGTH IS ONE A BRANCH IS TAKEN TO TURN* 07750000 * /** ON NUMBER ACTION SWITCH AND EXIT.FOR A LENGTH GT ONE,ONE BITS * 07760000 * /** ARE PROPOGATED THROUGH THE FIELD. * 07770000 * /******************************************************************* 07780000 * F8H3:; 07790000 * R9 = FDFROMAD /*POINT AT START OF FIELD*/; 07800000 F8H3 L @1,596(0,@5) 0300 07810000 L @9,44(0,@1) 0300 07820000 * /*INITILIZE FIELD TO NEG ONE*/ 07830000 * INBUF(1) = 'FF'X /*FIRST BYTE TO ONE BITS*/; 07840000 MVI 0(@9),X'FF' 0301 07850000 * IF FDLGTH = 1 THEN GO TO F8G2 /**BRANCH IF LENGTH IS ONE**/; 07860000 LA @F,1 0302 07870000 CH @F,24(0,@1) 0302 07880000 BC 08,F8G2 0303 07890000 * R6 = FDLGTH - 2 /**INITILIZE REG FOR EXECUTE INST**/; 07900000 LH @6,@D6 0304 07910000 AH @6,24(0,@1) 0304 07920000 * /*FILL OUT REST OF FIELD*/ 07930000 * GEN ( EX R6,F8H4); 07940000 EX R6,F8H4 07950000 DS 0H 07960000 * GO TO F8G2 /** BR TO TURN ON NU ACTION SWITCH**/; 07970000 BC 15,F8G2 0306 07980000 * F8H4:; 07990000 * /* MOVE CHARACTERS */ 08000000 * GEN ( MVC 1(1,R9),0(R9)); 08010000 F8H4 MVC 1(1,R9),0(R9) 08020000 DS 0H 08030000 * /******************************************************************* 08040000 * /** * 08050000 * /** PACKED DECIMAL FIELD HERE * 08060000 * /** * 08070000 * /** THE ADDRESS OF LAST BYTE OF THE FIELD IS PICKED UP.IF POSITIVE * 08080000 * /** A '1C'X IS PLACED IN THIS POSITION.NEGATIVE REQUIRES A '1D'X. * 08090000 * /** A BRANCH IS THEN TAKEN TO TURN ON THE NUMBER ACTION SWITCH AND * 08100000 * /** EXIT THIS ROUTINE. * 08110000 * /******************************************************************* 08120000 * F8J4:; 08130000 * R9 = FDFROMAD + FDLGTH - 1 /**ADDRESS LAST BYTE OF FIELD**/; 08140000 F8J4 L @9,@D5 0310 08150000 L @1,596(0,@5) 0310 08160000 LH @0,24(0,@1) 0310 08170000 ALR @9,@0 0310 08180000 AL @9,44(0,@1) 0310 08190000 * IF FDSIGN = '-' THEN GO TO F8J5 /*BR PD AND NEG*/; 08200000 CLI 34(@1),C'-' 0311 08210000 BC 08,F8J5 0312 08220000 * /*POS PD FIELD HERE*/ 08230000 * R9 -> WKADDR(1) = '1C'X /*INIT TO POS ONE*/; 08240000 MVI 0(@9),X'1C' 0313 08250000 * GO TO F8G2 /** BR TO TURN ON NU ACTION SWITCH**/; 08260000 BC 15,F8G2 0314 08270000 * F8J5:; 08280000 * R9 -> WKADDR(1) = '1D'X /*INIT TO NEG ONE*/; 08290000 F8J5 MVI 0(@9),X'1D' 0316 08300000 * GO TO F8G2 /** BR TO TURN ON NU ACTION SWITCH**/; 08310000 BC 15,F8G2 0317 08320000 * F8K2:; 08330000 * /******************************************************************* 08340000 * /** * 08350000 * /** ZONED DECIMAL HERE * 08360000 * /** * 08370000 * /** THE FIELD IS INITILIZED BY FILLING THE FIRST BYTE WITH 'F0'X * 08380000 * /** AND PROPOGATING THIS CHARACTER THROUGH THE FIELD.THE LAST BYTE * 08390000 * /** IS THEN MADE A 'F1'X,A ZONED DECIMAL CNE. * 08400000 * /******************************************************************* 08410000 * R9 = FDFROMAD /*ADDRESS START OF FIELD*/; 08420000 F8K2 L @1,596(0,@5) 0319 08430000 L @9,44(0,@1) 0319 08440000 * INBUF(1) = 'F0'X /*ZD ZERO TO FIRST BYTE*/; 08450000 MVI 0(@9),X'F0' 0320 08460000 * IF FDLGTH = 1 THEN DO /**IF LENGTH NOT ONE BR TO INIT LNG**/; 08470000 LA @F,1 0321 08480000 CH @F,24(0,@1) 0321 08490000 BC 07,@9F3 0321 08500000 * INBUF(1) = 'F1'X /**ONE CHARACTER FIELD TO ZD ONE**/; 08510000 MVI 0(@9),X'F1' 0323 08520000 * GO TO F8G2 /**BR TO TURN ON NUACTION SWITCH**/; 08530000 BC 15,F8G2 0324 08540000 * END; 08550000 * R6 = FDLGTH - 2 /**INITILIZE REG FOR EXECUTE INST**/; 08560000 @9F3 LH @6,@D6 0326 08570000 L @1,596(0,@5) 0326 08580000 AH @6,24(0,@1) 0326 08590000 * /*PROPOGATE ZEROES IN FIELD*/ 08600000 * F8K3:; 08610000 * IF R6 = 0 THEN GO TO F8K5 /**NO MORE TO MOVE**/; 08620000 F8K3 LTR @6,@6 0328 08630000 BC 08,F8K5 0329 08640000 * IF R6 < 256 THEN GO TO F8K4 /**BR LGTH LESS THAN 256**/; 08650000 CH @6,@D3 0330 08660000 BC 04,F8K4 0331 08670000 * GEN( MVC 1(256,R9),0(R9)); /**MOVE 256 CHARACTERS**/ 08680000 MVC 1(256,R9),0(R9) 08690000 DS 0H 08700000 * R6 = R6 - 256 /**REDUCE COUNT BY 256**/; 08710000 SH @6,@D3 0333 08720000 * R9 = R9 + 256 /**ADD 256 TO ADDRESS**/; 08730000 AH @9,@D3 0334 08740000 * GO TO F8K3 /**BR TO KEEP MOVING**/; 08750000 BC 15,F8K3 0335 08760000 * F8K4:; 08770000 * GEN ( EX R6,F8H4); 08780000 F8K4 EX R6,F8H4 08790000 DS 0H 08800000 * F8K5:; 08810000 * R9 = FDFROMAD + FDLGTH - 1 /**ADDRESS LAST BYTE OF FIELD**/ 08820000 F8K5 L @9,@D5 0339 08830000 L @1,596(0,@5) 0339 08840000 LH @0,24(0,@1) 0339 08850000 ALR @9,@0 0339 08860000 AL @9,44(0,@1) 0339 08870000 * R9 -> WKADDR(1) = 'F1'X /*INIT FIELD TO ONE*/; 08880000 MVI 0(@9),X'F1' 0340 08890000 * GO TO F8G2 /** BR TO TURN ON NU ACTION SWITCH**/; 08900000 BC 15,F8G2 0341 08910000 * /******************************************************************/ 08920000 * /** * 08930000 * /** THIS SECTION WILL SET UP AL,AN AND CO FORMATS FOR STARTING * 08940000 * /** CHARACTER.NO START CHARACTER DEFAULTS TO'A' FOR AL AND AN. * 08950000 * /** CO STARTING CHARACTER DEFAULT IS A BLANK- '40'X.IF CHARACTER * 08960000 * /** SPECIFIED IS NOT IN SEQUENCE A MSG IS ISSUED. E.G. A SEMI-COLON* 08970000 * /** IS NOT PART OF AL FORMAT.WHEN CHARACTER IS RESOLVED,A LOOP IS * 08980000 * /** STARTED TO FILL FIELD WITH THE PATTERN.WE CAN ONLY MOVE IN * 08990000 * /** INCREMENTS OF 26 FOR AL,36 FOR AN,AND 63 FOR CO.A 63 DIGIT * 09000000 * /** PATTERN IS USED AT LABEL COPAT AND ALPAT. * 09010000 * /** * 09020000 * /** * 09030000 * /** R9 WILL BE USED TO HOLD THE PATTERN ADDRESS-EQUALS FROM ADDRESS* 09040000 * /** R8 WILL BE USED TO HOLD THE TOO ADDRESS-EQUALS FD FIELD ADDRESS* 09050000 * /** R7 WILL BE USED TO HOLD THE LENGTH TO MOVE * 09060000 * /** * 09070000 * /******************************************************************/ 09080000 * F9A1:; 09090000 * /******************************************************************* 09100000 * /** * 09110000 * /** THIS SECTION PICKS UP START OF AL PATTERN,CLEARS CTR1 AND * 09120000 * /** BRANCHES TO RESOLVE PATTERN. * 09130000 * /******************************************************************* 09140000 * /*PICK UP START OF AL AND AN FIELDS*/ 09150000 * R9 = ADDR(ALPAT) /*PICKS UP START OF AL,AN*/; 09160000 F9A1 LA @9,ALPAT 0343 09170000 * R6 = 0 /* CTR1 TO ZERO*/; 09180000 SR @6,@6 0344 09190000 * IF FDFORMAT = 'AL' THEN GO TO F9A2 /* IF AL FORMAT-BRANCH*/; 09200000 L @1,596(0,@5) 0345 09210000 CLC 30(2,@1),@C15 0345 09220000 BC 08,F9A2 0346 09230000 * IF FDFORMAT = 'CO' THEN GO TO F9F1 /**IF CO FORMAT BRANCH**/; 09240000 CLC 30(2,@1),@C17 0347 09250000 BC 08,F9F1 0348 09260000 * /******************************************************************* 09270000 * /** * 09280000 * /** ALPHANUMERIC PATTERN HERE * 09290000 * /** THE SEQUENCE LENGTH OF 36 IS PICKED UP AND A BRANCH TAKEN IF * 09300000 * /** A START CHARACTER IS TO BE RESOLVED.IF NO START CHARACTER AND * 09310000 * /** LENGTH IS LESS THAN 36 A BRANCH IS TAKEN TO RESOLVE POINTERS * 09320000 * /** FOR FILLING FIELD WITH PATTERN,OTHERWISE A BRANCH IS TAKEN TO * 09330000 * /** FILL FIELD FROM PATTERN IN INCREMENTS OF 36. * 09340000 * /******************************************************************* 09350000 * COMPCTR = 36 /**COMPARE CTR TO SEQUENCE LENGTH**/; 09360000 LA @F,36 0349 09370000 ST @F,616(0,@5) 0349 09380000 * IF FDCHAR ^= '00'X THEN GO TO F9A3 /*BR TO RESOLVE START*/; 09390000 L @1,596(0,@5) 0350 09400000 CLI 35(@1),X'00' 0350 09410000 BC 07,F9A3 0351 09420000 * IF LTOFREE > '0024'X THEN GO TO F9C3 /*BR NO START CHARACTER* 09430000 L @F,@X19 0352 09440000 CH @F,60(0,@1) 0352 09450000 BC 04,F9C3 0353 09460000 * GO TO F9J2 /*BR TO RESOLVE PARA FOR MOVE* 09470000 BC 15,F9J2 0354 09480000 * /******************************************************************* 09490000 * /** * 09500000 * /** COLLATTING SEQUENCE HERE * 09510000 * /** THE SEQUENCE LENGTH OF 63 IS PICKED UP AND A BRANCH TAKEN IF * 09520000 * /** A START CHARACTER IS TO BE RESOLVED.IF NO START CHARACTER AND * 09530000 * /** LENGTH IS LESS THAN 63 THE NEXT SECTION IS ENTERED.IF LENGTH IS* 09540000 * /** GREATER THAN 63 A BRANCH IS TAKEN TO MOVE PATTERN IN INCREMENTS* 09550000 * /** OF 63. * 09560000 * /******************************************************************* 09570000 * F9F1:; 09580000 * R9 = ADDR(COPAT) /*PICK UP START OF CO FIELD*/; 09590000 F9F1 LA @9,COPAT 0356 09600000 * COMPCTR = 63 /**COMPARE CTR TO SEQUENCE LENGTH**/; 09610000 LA @F,63 0357 09620000 ST @F,616(0,@5) 0357 09630000 * IF FDCHAR ^= '00'X THEN GO TO F9A3 /**BR TO RESOLVE START**/; 09640000 L @1,596(0,@5) 0358 09650000 CLI 35(@1),X'00' 0358 09660000 BC 07,F9A3 0359 09670000 * IF LTOFREE > '003F'X THEN GO TO F9C3 /*BR NO START CHARACTER* 09680000 L @F,@X20 0360 09690000 CH @F,60(0,@1) 0360 09700000 BC 04,F9C3 0361 09710000 * /******************************************************************* 09720000 * /** THIS SECTION PICKS UP THE LENGTH AND ADDRESS OF FIELD TO BE * 09730000 * /** FILLED AND BRANCHES TO MOVE THE PATTERN * 09740000 * /******************************************************************* 09750000 * F9J2:; 09760000 * R8 = GCADDR /* PICK UP WORK ADDRESS*/; 09770000 F9J2 L @8,376(0,@5) 0363 09780000 * R7 = LTOFREE /**NO.OF BYTES TO MOVE**/; 09790000 L @1,596(0,@5) 0364 09800000 LH @7,60(0,@1) 0364 09810000 * GO TO F9G5 /*BR TO MOVE PATTERN*/; 09820000 BC 15,F9G5 0365 09830000 * /******************************************************************* 09840000 * /** * 09850000 * /** ALPHABETIC PATTERN HERE * 09860000 * /** THE SEQUENCE LENGTH IS PICKED UP AND A BRANCH TAKEN IF A START * 09870000 * /** CHARACTER IS TO BE RESOLVED.IF NO START CHAR AND LENGTH IS GT * 09880000 * /** 26 A BRANCH IS TAKEN TO FILL FIELD IN INCREMENTS OF 26, * 09890000 * /** OTHERWISE A BRANCH IS TAKEN TO FILL ALL OF FIELD. * 09900000 * /******************************************************************* 09910000 * F9A2:; 09920000 * COMPCTR = 26 /**COMPARE CTR TO SEQUENCE LENGTH**/; 09930000 F9A2 LA @F,26 0367 09940000 ST @F,616(0,@5) 0367 09950000 * IF FDCHAR ^= '00'X THEN GO TO F9A3 /*BR TO RESOLVE STARTAD*/; 09960000 L @1,596(0,@5) 0368 09970000 CLI 35(@1),X'00' 0368 09980000 BC 07,F9A3 0369 09990000 * IF LTOFREE > '001A'X THEN GO TO F9C3 /*BR NO START CHARACTER* 10000000 L @F,@X18 0370 10010000 CH @F,60(0,@1) 0370 10020000 BC 04,F9C3 0371 10030000 * GO TO F9J2 /*BR TO READY FOR MOVE*/; 10040000 BC 15,F9J2 0372 10050000 * /*TEST HERE FOR START CHARACTER*/ 10060000 * /******************************************************************* 10070000 * /** RESOLVE START CHARACTER HERE * 10080000 * /** THIS SECTION CONSISTING OF TWO LABELS WILL PASS CHARACTER BY * 10090000 * /** CHARACTER THROUGH A SEQUENCE LOOKING FOR A MATCH ON FDCHAR. * 10100000 * /** THE COMPCTR CONTAINS THE LENGTH OF THE SEQUENCE.REG 6 IS USED * 10110000 * /** TO COUNT WHERE WE ARE IN THE SEQUENCE.REG 9 IS THE POINTER TO * 10120000 * /** THE SEQUENCE.IF A MATCH IS FOUND THE NEXT SECTION IS ENTERED. * 10130000 * /** NO MATCH CAUSES A MESSAGE INDICATION. * 10140000 * /******************************************************************* 10150000 * F9A3:; 10160000 * IF INBUF(1) = FDCHAR THEN GO TO F9C3 /*BRANCH A MATCH*/; 10170000 F9A3 L @1,596(0,@5) 0374 10180000 CLC 0(1,@9),35(@1) 0374 10190000 BC 08,F9C3 0375 10200000 * /*HAVE WE PASSED THROUGH ALL OF SEQ*/ 10210000 * IF R6 = COMPCTR THEN GO TO F9B5 /**BRANCH CHARACTER NO GOOD** 10220000 C @6,616(0,@5) 0376 10230000 BC 08,F9B5 0377 10240000 * R6 =R6 + 1 /*ADD 1 TO SEQ COUNT*/; 10250000 AH @6,@D7 0378 10260000 * R9 =R9 + 1 /* INC COMPARE ADDR BY ONE*/; 10270000 AH @9,@D7 0379 10280000 * GO TO F9A3 /*BR TO COMPARE AGAIN*/; 10290000 BC 15,F9A3 0380 10300000 * F9B5:; 10310000 * MS = 3 /*SET MESSAGE 3 */; 10320000 F9B5 LA @F,3 0382 10330000 STH @F,406(0,@5) 0382 10340000 * GO TO F1B411 /** BRANCH TO EXIT ROUTINE**/; 10350000 BC 15,F1B411 0383 10360000 * /*AT THIS POINT THE STARTING ADDRESS */ 10370000 * /*IN THE PATTERN HAS BEEN RESOLVED*/ 10380000 * /*EITHER BY LOOP AT F9A3 OR DEFAULT*/ 10390000 * F9C3:; 10400000 * R8 = GCADDR /*PICK UP WORK ADDRESS*/; 10410000 F9C3 L @8,376(0,@5) 0385 10420000 * /******************************************************************* 10430000 * /** THIS SECTION PICKS UP LENGTH TO MOVE AND DETERMINES IF THE * 10440000 * /** FIELD CAN BE FILLED IN ONE MOVE OF IF MORE MOVES ARE NEEDED. * 10450000 * /******************************************************************* 10460000 * F9C4:; 10470000 * R7 = COMPCTR - R6 /**R7 EQUALS LENGTH TO MOVE**/; 10480000 F9C4 LCR @7,@6 0387 10490000 A @7,616(0,@5) 0387 10500000 * COMPCTR = LTOFREE /** PICK UP TOTAL LENGTH TO MOVE**/; 10510000 L @1,596(0,@5) 0388 10520000 LH @F,60(0,@1) 0388 10530000 ST @F,616(0,@5) 0388 10540000 * /*IF LENGTH TO MOVE IS EQ OR LESS THAN R7 THE FIELD CAN BE*/ 10550000 * /*FILLED DIRECTLY FROM THE SEQUENCE*/ 10560000 * IF COMPCTR =< R7 THEN DO /*CAN WHOLE FIELD BE INIT FROM SEQ** 10570000 C @7,616(0,@5) 0389 10580000 BC 04,@9F2 0389 10590000 * /**YES REINIT CTR IN CASE FIELD LENGTH** 10600000 * /**IS LT LENGTH REMAINING IN SEQUENCE**/ 10610000 * R7 = LTOFREE /**REINITILIZE COUNTER**/; 10620000 L @1,596(0,@5) 0391 10630000 LH @7,60(0,@1) 0391 10640000 * GO TO F9G5 /**BRANCH TO FILL WHOLE FIELD**/; 10650000 BC 15,F9G5 0392 10660000 * END; 10670000 * GO TO F9E5 /**BR TO MOVE PART OF SEQUENCE**/; 10680000 * /******************************************************************* 10690000 * /** THIS SECTION MOVES PART OF SEQUENCE AND RESOLVES NEW ADDRESSES * 10700000 * /** AND LENGTH.A BRANCH IS THEN TAKEN TO PICK UP SEQUENCE LENGTH IF* 10710000 * /** AL,AN AND CO. * 10720000 * /******************************************************************* 10730000 * F9E4:; 10740000 * R7 = R6; 10750000 F9E4 LR @7,@6 0396 10760000 * F9E5:; 10770000 * CALL MOVEROUT; 10780000 F9E5 BAL @E,MOVEROUT 0398 10790000 * R8 = R8 + R7 /**RESOLVE NEW ADDRESS**/; 10800000 AR @8,@7 0399 10810000 * COMPCTR = COMPCTR - R7 /**COMPUTE AMOUNT REMAINING TO MOVE**/; 10820000 LCR @F,@7 0400 10830000 A @F,616(0,@5) 0400 10840000 ST @F,616(0,@5) 0400 10850000 * IF FDFORMAT = 'AL' THEN GO TO F9F4 /*BR IF AL FORMAT*/; 10860000 L @1,596(0,@5) 0401 10870000 CLC 30(2,@1),@C15 0401 10880000 BC 08,F9F4 0402 10890000 * IF FDFORMAT = 'AN' THEN GO TO F9G4 /*BR IF AN FORMAT*/; 10900000 CLC 30(2,@1),@C16 0403 10910000 BC 08,F9G4 0404 10920000 * /******************************************************************* 10930000 * /** PICK UP COLLATTING SEQUENCE ADDRESS AND LENGTH * 10940000 * /******************************************************************* 10950000 * R9 = ADDR(COPAT) /*PICK UP CO ADDRESS*/; 10960000 LA @9,COPAT 0405 10970000 * R6 = 63 /*RENEW CTR1*/; 10980000 LA @6,63 0406 10990000 * F9F5:; 11000000 * /******************************************************************* 11010000 * /** IF LENGTH REMAING IS GT SEQUENCE LENGTH BRANCH * 11020000 * /******************************************************************* 11030000 * /*TEST LENGTH LEFT*/ 11040000 * IF COMPCTR > R6 THEN GO TO F9E4 /**BRANCH TO MOVE MORE**/; 11050000 F9F5 C @6,616(0,@5) 0408 11060000 BC 04,F9E4 0409 11070000 * /* THIS IS LAST MOVE TO COMPLETE FIELD*/ 11080000 * R7 = COMPCTR /**RESOLVE LENGTH FOR LAST MOVE**/; 11090000 L @7,616(0,@5) 0410 11100000 * /******************************************************************* 11110000 * /** * 11120000 * /** THIS SECTION IS LAST MOVE TO FILL FIELD * 11130000 * /** * 11140000 * /******************************************************************* 11150000 * F9G5:; 11160000 * CALL MOVEROUT /*MOVE BYTES REMAINING*/; 11170000 F9G5 BAL @E,MOVEROUT 0412 11180000 * GO TO F7H3 /*BR NOT RIPPLE*/; 11190000 BC 15,F7H3 0413 11200000 * /******************************************************************* 11210000 * /** PICK UP ALPHABETIC SEQUENCE ADDRESS AND LENGTH AND BRANCH TO * 11220000 * /** TEST LENGTH REMAINING TO MOVE. * 11230000 * /******************************************************************* 11240000 * F9F4:; 11250000 * R9 = ADDR(ALPAT) /*PICK UP AL ADDRESS*/; 11260000 F9F4 LA @9,ALPAT 0415 11270000 * R6 = 26 /*RENEW CTR1*/; 11280000 LA @6,26 0416 11290000 * GO TO F9F5 /*BR TO TEST LGTH LEFT*/; 11300000 BC 15,F9F5 0417 11310000 * /******************************************************************* 11320000 * /** PICK UP ALPHANUMERIC SEQUENCE ADDRESS AND LENGTH AND BRANCH TO * 11330000 * /** TEST LENGTH REMAINING TO MOVE. * 11340000 * /******************************************************************* 11350000 * F9G4:; 11360000 * R9 = ADDR(ALPAT) /*PICK UP AL ADDRESS*/; 11370000 F9G4 LA @9,ALPAT 0419 11380000 * R6 = 36 /*RENEW CTR1*/; 11390000 LA @6,36 0420 11400000 * GO TO F9F5 /*BR TO TEST LGTH LEFT*/; 11410000 BC 15,F9F5 0421 11420000 * F10A0:; 11430000 * /* THIS INST MOVES PICTURE*/ 11440000 * F10A1:; 11450000 F10A0 EQU * 0423 11460000 * GEN ( MVC 0(1,R7),0(R8)); 11470000 F10A1 MVC 0(1,R7),0(R8) 11480000 DS 0H 11490000 * /******************************************************************* 11500000 * /** * 11510000 * /** THIS SECTION WILL PLACE THE PACKED DECIMAL PICTURE INTO THE * 11520000 * /** FIELD.IF THE PACKED LENGTH IS GREATER THAN THE FIELD LENGTH * 11530000 * /** IT IS SHORTENED UNTIL IT WILL FIT IN THE FIELD.SIGN IS HONORED.* 11540000 * /** THE FORMAT IS MADE 'PD',NUMBER ACTION SWITCH TURNED ON AND THE * 11550000 * /** LENGTH OF THE PACKED NUMBER IS RESOLVED. * 11560000 * /** * 11570000 * /******************************************************************* 11580000 * F10A2:; 11590000 * FDFORMAT = 'PD' /**FORMAT MUST BE PD**/; 11600000 F10A2 L @1,596(0,@5) 0426 11610000 MVC 30(2,@1),@C14 0426 11620000 * NUACTION = '1'B /**TURN ON NUMBER ACTION SWITCH**/; 11630000 OI 32(@1),B'00000001' 0427 11640000 * R6 = FDPLGTH / 2 + 1 /*PACKED LGTH= LGTH/2 PLUS 1 * 11650000 LH @E,588(0,@5) 0428 11660000 SRDA @E,32 0428 11670000 LA @0,2 0428 11680000 DR @E,@0 0428 11690000 AH @F,@D7 0428 11700000 LR @6,@F 0428 11710000 * /******************************************************************* 11720000 * /**AT THIS POINT LOCATION OF PACKED NUMBER IN Q MUST BE RESOLVED *** 11730000 * /**RECEIVING ADDRESS MUST ALSO BE RESOLVED ************************ 11740000 * /******************************************************************* 11750000 * /*FROM ADDR = ADDR Q + 16 - PACKED LGTH*/ 11760000 * F10A3:; 11770000 * R8 = ADDR(Q) /*PICK UP Q ADDR*/; 11780000 F10A3 LA @8,216(0,@5) 0430 11790000 * R8 = R8 -R6 + 16 /*RESOLVE FROM ADDRESS*/; 11800000 LA @F,16 0431 11810000 SR @F,@6 0431 11820000 AR @8,@F 0431 11830000 * /*TO ADDR = WKADDR PLUS FLD LGTH-PLGTH*/ 11840000 * IF R6 <= FDLGTH THEN DO /**WILL NUMBER FIT IN FIELD**/; 11850000 L @1,596(0,@5) 0432 11860000 CH @6,24(0,@1) 0432 11870000 BC 02,@9F1 0432 11880000 * /**YES-RESOLVE FIELD ADDRESS**/ 11890000 * R7 = GCADDR - R6 + FDLGTH /** OBTAIN WORK ADDRESS**/; 11900000 LH @7,24(0,@1) 0434 11910000 SR @7,@6 0434 11920000 A @7,376(0,@5) 0434 11930000 * R6 = R6 - 1 /** CORRECT THE LENGTH**/; 11940000 BCTR @6,0 0435 11950000 * GO TO F10A5 /**BRANCH TO PROCESS**/; 11960000 BC 15,F10A5 0436 11970000 * END; 11980000 * R6 = R6 - 1 /** DECREMENT LENGTH BY ONE**/; 11990000 @9F1 BCTR @6,0 0438 12000000 * GO TO F10A3 /**BRANCH TO TRY AGAIN**/; 12010000 BC 15,F10A3 0439 12020000 * /******************************************************************* 12030000 * /** IF SIGN IS NEGATIVE BRANCH TO MAKE SIGN DIGIT A 'FD'. * 12040000 * /******************************************************************* 12050000 * F10A5:; 12060000 * IF FDSIGN = '-' THEN GO TO F10E3 /*BR IF NEG SIGN */; 12070000 F10A5 L @1,596(0,@5) 0441 12080000 CLI 34(@1),C'-' 0441 12090000 BC 08,F10E3 0442 12100000 * GO TO F10F1 /**BR SIGN NOT NEG TO INIT TO POSITIVE** 12110000 BC 15,F10F1 0443 12120000 * /******************************************************************* 12130000 * /** THIS SECTION MOVES NUMBER TO FD FIELD,INITILIZES THE FIELD * 12140000 * /** ADDRESS IN THE FD TABLE AND BRANCHES TO FREEMAIN CORE USED TO * 12150000 * /** HOLD PICTURE WHEN IT WAS FIRST SCANNED FROM THE CONTROL CARD. * 12160000 * /******************************************************************* 12170000 * F10H2:; 12180000 * /* MOVE PACKED NO TO FIELD ADDR RES ABOVE*/ 12190000 * GEN ( EX R6,F10A1); 12200000 F10H2 EX R6,F10A1 12210000 DS 0H 12220000 * FDFROMAD = GCADDR /** INIT FD FROM ADDRESS**/; 12230000 L @1,596(0,@5) 0446 12240000 MVC 44(4,@1),376(@5) 0446 12250000 * GO TO F7G3 /** BR TO FREEMAIN AND EXIT**/; 12260000 BC 15,F7G3 0447 12270000 * /******************************************************************* 12280000 * /** INITILIZE SIGN DIGIT TO 'FC' AND BRANCH TO MOVE NUMBER. * 12290000 * /******************************************************************* 12300000 * F10E3:; 12310000 * QSIGN1 = 'FD'X & QSIGN1 /**CHANGE SIGN TO NEG**/; 12320000 F10E3 NI 231(@5),X'FD' 0449 12330000 * GO TO F10H2 /* BR TO MOVE NUMBER*/; 12340000 BC 15,F10H2 0450 12350000 * F10F1:; 12360000 * QSIGN1 = 'FC'X & QSIGN1 /**CHANGE SIGN TO POS**/; 12370000 F10F1 NI 231(@5),X'FC' 0452 12380000 * GO TO F10H2 /*BR TO MOVE NUMBER*/; 12390000 BC 15,F10H2 0453 12400000 * /******************************************************************* 12410000 * /** * 12420000 * /** THIS SECTION WILL PLACE THE REQUIRED BINARY PICTURE IN THE * 12430000 * /** FIELD.AS FOR A PACKED DECIMAL NUMBER THE NUMBER IS RIGHT * 12440000 * /** ADJUSTED IN THE FIELD. * 12450000 * /** * 12460000 * /** THE FORMAT IS MADE 'BI',NUMBER ACTION SWITCH TURNED ON,LGTH * 12470000 * /** AND ADDRESSES ARE THEN PICKED UP.IF SIGN IS TO BE POSITIVE A * 12480000 * /** BRANCH IS TAKEN OTHER WISE THE NUMBER IS CHANGED TO NEGATIVE. * 12490000 * /** * 12500000 * /******************************************************************* 12510000 * F10A4:; 12520000 * FDFORMAT = 'BI' /**FORMAT MIST BE BINARY**/; 12530000 F10A4 L @1,596(0,@5) 0455 12540000 MVC 30(2,@1),@C13 0455 12550000 * NUACTION = '1'B /**TURN ON NUMBER ACTION SWITCH**/; 12560000 OI 32(@1),B'00000001' 0456 12570000 * R7 = FDPLGTH /* PICK UP NUMBER LENGTH*/; 12580000 LH @7,588(0,@5) 0457 12590000 * R6 = Q(1:4) /** PICK UP BINARY NUMBER**/; 12600000 L @6,216(0,@5) 0458 12610000 * IF FDSIGN ^= '-' THEN GO TO F10B4 /*BR TO STORE NO.NOT NEG*/; 12620000 CLI 34(@1),C'-' 0459 12630000 BC 07,F10B4 0460 12640000 * /*CHANGE SIGN TO NEG AS REQD*/ 12650000 * GEN ( LCR R6,R6); 12660000 LCR R6,R6 12670000 DS 0H 12680000 * /******************************************************************* 12690000 * /** IF FD LENGTH IS GT 4 WE WILL RIGHT ADJUST THE NUMBER IN THE * 12700000 * /** FIELD. * 12710000 * /******************************************************************* 12720000 * F10B4:; 12730000 * Q = R6 /* STORE BINARY NUMBER*/; 12740000 F10B4 ST @6,@TEMP4 0463 12750000 MVC 216(4,@5),@TEMP4 0463 12760000 MVI 220(@5),C' ' 0463 12770000 MVC 221(11,@5),220(@5) 0463 12780000 * /*IF FD FIELD LENGTH IS GREATER THAN 4 WE */ 12790000 * /*MUST RIGHT ADJUST THE NUMBER IN THE FIELD.* 12800000 * /*ANYTHING LESS THAN THIS WE CAN MOVE */ 12810000 * /*DIRECTLY INTO FIELD BUT MUST TEST FO FIELF* 12820000 * /* LENGTH*/ 12830000 * IF FDLGTH => '0004'X THEN GO TO F10C5 /*BR EQ OR GT FDLGTH*/; 12840000 L @F,@X31 0464 12850000 L @1,596(0,@5) 0464 12860000 CH @F,24(0,@1) 0464 12870000 BC 12,F10C5 0465 12880000 * IF FDLGTH = '0003'X THEN GO TO F10E5 /*BR LENGTH EQUALS 3 */; 12890000 L @F,@X32 0466 12900000 CH @F,24(0,@1) 0466 12910000 BC 08,F10E5 0467 12920000 * IF FDLGTH = '0002'X THEN GO TO F10G5 /*BR LENGTH EQUALS 2 */; 12930000 L @F,@X33 0468 12940000 CH @F,24(0,@1) 0468 12950000 BC 08,F10G5 0469 12960000 * /******************************************************************* 12970000 * /** HERE LENGTH EQUALS ONE,THE FROM AND TOO ADDRESSES ARE * 12980000 * /** RESOLVED AND A BRANCH TAKEN TO MOVE THE NUMBER. * 12990000 * /******************************************************************* 13000000 * R6 = 0 /** LENGTH TO MOVE EQUALS ONE**/; 13010000 SR @6,@6 0470 13020000 * R8 = ADDR(Q) + 3 /*RESOLVE FROM ADDRESS*/; 13030000 LA @8,219(0,@5) 0471 13040000 * R7 = GCADDR + FDLGTH - 1 /** RESOLVE TOO ADDRESS**/; 13050000 LH @7,@D1 0472 13060000 AH @7,24(0,@1) 0472 13070000 A @7,376(0,@5) 0472 13080000 * GO TO F10H2 /*BR TO MOVE NUMBER*/; 13090000 BC 15,F10H2 0473 13100000 * /******************************************************************* 13110000 * /** HERE THE LENGTH IS FOUR OR GREATER,ADDRESSES AND LENGTH IS * 13120000 * /** RESOLVED AND A BRANCH IS TAKEN TO MOVE THE NUMBER. * 13130000 * /******************************************************************* 13140000 * F10C5:; 13150000 * /*RESOLVE ADDRESS LGTH EQ OR GR THAN 4*/ 13160000 * R7 = GCADDR + FDLGTH - 4 /** RESOLVE TOO ADDRESS**/; 13170000 F10C5 LH @7,@D8 0475 13180000 L @1,596(0,@5) 0475 13190000 AH @7,24(0,@1) 0475 13200000 A @7,376(0,@5) 0475 13210000 * /*FIELD LENGTH MINUS 4 */ 13220000 * /* FROM ADDRESS = ADDRESS Q*/ 13230000 * R8 = ADDR(Q) /** RESOLVE FROM ADDRESS**/; 13240000 LA @8,216(0,@5) 0476 13250000 * R6 = 3 /** LENGTH TO MOVE EQUALS FOUR**/; 13260000 LA @6,3 0477 13270000 * GO TO F10H2 /*BR TO MOVE LENGTH*/; 13280000 BC 15,F10H2 0478 13290000 * /******************************************************************* 13300000 * /** HERE LENGTH EQUALS THREE,ADDRESSES ARE RESOLVED AND A BRANCH* 13310000 * /** TAKEN TO MOVE THE NUMBER. * 13320000 * /******************************************************************* 13330000 * F10E5:; 13340000 * /*FROM ADDRESS = Q ADDRESS+ 1 */ 13350000 * R8 = ADDR(Q) + 1 /* RESOLVE FROM ADDRESS*/; 13360000 F10E5 LA @8,217(0,@5) 0480 13370000 * /* */ 13380000 * R7 = GCADDR + FDLGTH - 3 /** RESOLVE TOO ADDRESS**/; 13390000 LH @7,@D9 0481 13400000 L @1,596(0,@5) 0481 13410000 AH @7,24(0,@1) 0481 13420000 A @7,376(0,@5) 0481 13430000 * R6 = 2 /** LENGTH TO MOVE EQUALS THREE**/; 13440000 LA @6,2 0482 13450000 * GO TO F10H2 /*BR TO MOVE LENGTH*/; 13460000 BC 15,F10H2 0483 13470000 * /******************************************************************* 13480000 * /** HERE LENGTH EQUALS TWO,ADDRESSES ARE RESOLVED AND A BRANCH * 13490000 * /** TAKEN TO MOVE THE NUMBER. * 13500000 * /******************************************************************* 13510000 * F10G5:; 13520000 * /*FROM ADDRESS = Q ADDRESS + 2 */ 13530000 * R8 = ADDR(Q) + 2 /*RESOLVE FROM ADDRESS*/; 13540000 F10G5 LA @8,218(0,@5) 0485 13550000 * R7 = GCADDR + FDLGTH - 2 /** RESOLVE TOO ADDRESS**/; 13560000 LH @7,@D6 0486 13570000 L @1,596(0,@5) 0486 13580000 AH @7,24(0,@1) 0486 13590000 A @7,376(0,@5) 0486 13600000 * R6 = 1 /** LENGTH TO MOVE EQUALS TWO**/; 13610000 LA @6,1 0487 13620000 * GO TO F10H2 /*BR TO MOVE NUMBER*/; 13630000 BC 15,F10H2 0488 13640000 * /******************************************************************/ 13650000 * /** ** 13660000 * /** THIS SECTION CONSISTING OF THREE LABELS WHICH ARE BRANCHED TO * 13670000 * /** FOR EXITING FROM THIS ROUTINE WHEN RETURN OF CONTROL IS NOT * 13680000 * /** REQUIRED.A BRANCH TO F1B41 CAUSES ALL FD SWITCHES TO BE TURNED** 13690000 * /** OFF AND A NORMAL RETURN TO THE BASE MODULE.A BRANCH TO F1B411 * 13700000 * /** CAUSES THE EPSW TO BE SET TO ONE(INDICATES NEED FOR MESSAGE) * 13710000 * /** SWITCHES OFF AND RETURN.A BRANCH TO F1B4 CAUSES FLAGSW(1) TO * 13720000 * /** BE SET INDICATING A NEED FOR ERROR FLAGGING A MESSAGE.EPSW IS * 13730000 * /** THEN SET,SWITCHES TURNED OFF AND A RETURN ISSUED.THUS F1B41 * 13740000 * /** IS FOR A NORMAL RETURN.F1B411 INDICATES NEED FOR A MESSAGE AND * 13750000 * /** RETURN.F1B4 INDICATES ERROR FLAGGING,MESSAGE AND RETURN. * 13760000 * /** ** 13770000 * /******************************************************************/ 13780000 * F1B4:; 13790000 * FLAGSW(1) = '1'B /*INDICATE ERROR FLAG WANTED*/ 13800000 F1B4 OI 566(@5),B'10000000' 0490 13810000 * F1B411:; 13820000 * EPSW = 1 /*INDICATE NEED FOR MESSAGE */; 13830000 F1B411 MVI 568(@5),1 0492 13840000 * F1B41:; 13850000 * SWITCH(1) = OFF /**TURN OFF FIRST FD SWITCH**/ 13860000 F1B41 MVC 536(1,@5),OFF 0494 13870000 * SWITCH(2:14) = SWITCH(1:13) /** TURN OFF FD SWITCHES**/; 13880000 MVC 537(13,@5),536(@5) 0495 13890000 * RETURN; 13900000 * SCANOUT: PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 13910000 @EL01 L @D,4(0,@D) 0497 13920000 LR @1,@C 0497 13930000 L @0,@SIZ001 0497 13940000 FREEMAIN R,LV=(0),A=(1) 0497 13950000 L @E,12(0,@D) 0497 13960000 LM @0,@8,20(@D) 0497 13970000 LM @A,@C,60(@D) 0497 13980000 BCR 15,@E 0497 13990000 SCANOUT EQU * 0497 14000000 * /*************************************** 14010000 * /** THIS PROCEDURE WILL FIND THE LGTH ** 14020000 * /** OF THE PARAMETER FOLLOWING THE ** 14030000 * /** EQUAL SIGN.UPON ENTRY REG 9 SHOULD** 14040000 * /** BE POINTING AT START OF PARAMETER ** 14050000 * /** UPON EXIT REGISTERS ARE AS FOLLOWS** 14060000 * /** ** 14070000 * /** REG 7 EQUALS LENGTH OF PARA ** 14080000 * /** REG 8 COMMA OR BLANK AFTER PARA ** 14090000 * /** REG 9 START OF PARAMETER ** 14100000 * /** ** 14110000 * /*************************************** 14120000 * R8 = R9 /*COPY SCAN POINTER */; 14130000 LR @8,@9 0498 14140000 * SCANOUT1:; 14150000 * /* */ 14160000 * IF R8 -> INBUF(1) = ',' THEN GO TO SCANOUT2 /*BR IF COMMA*/; 14170000 SCANOUT1 CLI 0(@8),C',' 0500 14180000 BC 08,SCANOUT2 0501 14190000 * IF R8 -> INBUF(1) = ' ' THEN GO TO SCANOUT2 /*BR IF BLANK*/; 14200000 CLI 0(@8),C' ' 0502 14210000 BC 08,SCANOUT2 0503 14220000 * R8 = R8 + 1 /*INC PTR BY ONE*/; 14230000 AH @8,@D7 0504 14240000 * IF R8 < COUNTER THEN GO TO SCANOUT1 /**BR NOT IN COL 72 ** 14250000 C @8,232(0,@5) 0505 14260000 BC 04,SCANOUT1 0506 14270000 * MS = 21 /** INDICATE MESSAGE ** 14280000 LA @F,21 0507 14290000 STH @F,406(0,@5) 0507 14300000 * GO TO F1B411 /** BRANCH TO LEAVE ROUTINE**/; 14310000 BC 15,F1B411 0508 14320000 * /* */ 14330000 * SCANOUT2:; 14340000 * /* R8 SHOULD BE POINTING AT BLANK OR COMMA*/ 14350000 * R7 = R8 - R9 /** CALCULATE PARAMETER LENGTH** 14360000 SCANOUT2 LCR @7,@9 0510 14370000 AR @7,@8 0510 14380000 * IF R7 = 0 THEN DO /**BR WHEN LENGTH IS NOT EQUAL TO ZERO** 14390000 LTR @7,@7 0511 14400000 BC 07,@9F0 0511 14410000 * MS = 3 /** INDICATE MESSAGE**/; 14420000 LA @F,3 0513 14430000 STH @F,406(0,@5) 0513 14440000 * GO TO F1B411 /** BRANCH TO LEAVE ROUTINE**/; 14450000 BC 15,F1B411 0514 14460000 * END; 14470000 * /** LGTH GT EIGHT- NAME IS TOO LONG ** 14480000 * IF R7 > 8 THEN DO /** BR IF LENGTH LT,EQ TO 8 ** 14490000 @9F0 CH @7,@D10 0516 14500000 BC 12,@9EF 0516 14510000 * MS = 3 /** INDICATE MESSAGE ** 14520000 LA @F,3 0518 14530000 STH @F,406(0,@5) 0518 14540000 * GO TO F1B411 /** BRANCH TO LEAVE ROUTINE**/; 14550000 BC 15,F1B411 0519 14560000 * END; 14570000 * RETURN /* RETURN TO CALLER WITH REGISTERS SET*/; 14580000 * END SCANOUT; 14590000 @EL02 BCR 15,@E 0522 14600000 * /* */ 14610000 * /******************************************************************* 14620000 * /** * 14630000 * /** THIS PROCEDURE WILL CONVERT AN EBCDIC NUMBER FROM THE INPUT * 14640000 * /** WORKAREA TO BINARY.THE NUMBER IS TESTED BEFORE CONVERSION FOR * 14650000 * /** 2147483647.THE LARGEST BINARY NUMBER A REGISTER CAN CONTAIN IS * 14660000 * /** THIS NUMBER.THIS NUMBER MUST BE VALIDITY CHECKED BEFORE ENTRY * 14670000 * /** TO THIS ROUTINE OR THE CVB INSTRUCTION MAY FAIL. * 14680000 * /** UPON ENTRY REG 9 POINTS AT START OF EBCDIC NUMBER IN INBUF * 14690000 * /** UPON ENTRY REG 7 CONTAINS LENGTH OF NUMBER * 14700000 * /** UPON EXIT REG9 AND REG7 ARE NOT CHANGED * 14710000 * /** REG 6 CONTAINS THE BINARY EQUIVALENT OF NUMBER * 14720000 * /** IF RANGESW IS NOT ON THE NUMBER IS TESTED FOR BEING LARGER THAN* 14730000 * /** 32767 THE MAXIMUM VALUE ALLOWED FOR LRECL. * 14740000 * /** * 14750000 * /******************************************************************* 14760000 * CONVB: PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 14770000 * /*SAVE REG 14 IN COMMON AREA. */ 14780000 * SAVE14 = R14; 14790000 CONVB ST @E,360(0,@5) 0524 14800000 * R6 = R7 - 1 /**CORRECT THE VALUE IN THE REGISTER**/; 14810000 LH @6,@D1 0525 14820000 AR @6,@7 0525 14830000 * /**PACK THE NUMBER IN Q AREA **/ 14840000 * GEN ( EX R6,CONVBP); 14850000 EX R6,CONVBP 14860000 DS 0H 14870000 * /**TEST FOR NUMBER BEING LARGER THEN**/ 14880000 * /**2147483647 AND BRANCH IF NOT SO **/ 14890000 * IF Q(1:8) > '000002147483647F'X THEN DO /*BR IF NUMBER OK*/; 14900000 CLC 216(8,@5),@X36 0527 14910000 * GO TO CONVB1 /*BRANCH TO SET MSG*/; 14920000 BC 03,CONVB1 0529 14930000 * END; 14940000 * GEN ( CVB R6,Q(0,R5)); 14950000 @9EE EQU * 0531 14960000 CVB R6,Q(0,R5) 14970000 DS 0H 14980000 * IF RANGESW = ON THEN DO /** IF RANGESW ON DO BELOW**/; 14990000 CLC 541(1,@5),ON 0532 15000000 BC 07,@9ED 0532 15010000 * RANGESW = OFF /**TURN OFF RANGE SW**/; 15020000 MVC 541(1,@5),OFF 0534 15030000 * RETURN; 15040000 BC 15,@EL03 0535 15050000 * END; 15060000 * IF R6 <= 32767 THEN DO /** BRANCH IF LARGER THAN 32767**/ 15070000 @9ED CH @6,@D11 0537 15080000 BC 02,@9EC 0537 15090000 * /*RESTORE REG 14 FROM COMMON AREA. 15100000 * R14 = SAVE14; 15110000 L @E,360(0,@5) 0539 15120000 * RETURN /*RETURN TO CALLER*/; 15130000 BC 15,@EL03 0540 15140000 * END; 15150000 * CONVB1:; 15160000 @9EC EQU * 0542 15170000 * MS = 6 /*INDICATE MSG*/; 15180000 CONVB1 LA @F,6 0543 15190000 STH @F,406(0,@5) 0543 15200000 * GO TO F1B411 /** BRANCH TO LEAVE ROUTINE**/; 15210000 BC 15,F1B411 0544 15220000 * CONVBP: GEN ( PACK Q(8,R5),0(1,R9)); 15230000 CONVBP PACK Q(8,R5),0(1,R9) 15240000 DS 0H 15250000 * END CONVB; 15260000 @EL03 BCR 15,@E 0546 15270000 * /******************************************************************* 15280000 * /** * 15290000 * /** THIS PROCEDURE WILL MOVE ANY NUMBER OF CHARACTERS FOR THE * 15300000 * /** CALLER.EXPECTED CONTENTS OF REGISTERS UPON ENTRY ARE: * 15310000 * /** REG 9 = FROM ADDRESS * 15320000 * /** REG 8 = TO ADDRESS * 15330000 * /** REG 7 = LENGTH TO MOVE * 15340000 * /** REGISTER CONTENTS ARE DESTROYED UPON EXIT IF MOVE IS GT 256 * 15350000 * /** * 15360000 * /******************************************************************* 15370000 * MOVEROUT: PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 15380000 MOVEROUT EQU * 0547 15390000 * MOVE1:; 15400000 * IF R7 = 0 THEN RETURN /** RETURN IF ZERO LENGTH ** 15410000 MOVE1 LTR @7,@7 0549 15420000 BC 08,@EL04 0550 15430000 * IF R7 < 256 THEN GO TO MOVE5 /** BR IF LT 256 TO MOVE ** 15440000 @9EB CH @7,@D3 0551 15450000 BC 04,MOVE5 0552 15460000 * /*MOVES 256 BYTES*/ 15470000 * GEN (MVC 0(256,R8),0(R9)); 15480000 MVC 0(256,R8),0(R9) 15490000 DS 0H 15500000 * R9 = R9 + 256 /*ADD 256 TO POSITION ADDR*/; 15510000 AH @9,@D3 0554 15520000 * R8 = R8 + 256 /*ADD 256 TO POSITION ADDR*/; 15530000 AH @8,@D3 0555 15540000 * R7 = R7 - 256 /*SUBT 256 TO CORRECT LENGTH*/ 15550000 SH @7,@D3 0556 15560000 * GO TO MOVE1 /*BR TO CONTINUE PROCESSING*/; 15570000 BC 15,MOVE1 0557 15580000 * MOVE4 :; 15590000 * /*MOVE REMAINING BYTES*/ 15600000 * GEN ( MVC 0(1,R8),0(R9)); 15610000 MOVE4 MVC 0(1,R8),0(R9) 15620000 DS 0H 15630000 * MOVE5:; 15640000 * R7 = R7 - 1 /*CORRECT THE LENGTH*/; 15650000 MOVE5 BCTR @7,0 0561 15660000 * GEN ( EX R7,MOVE4); 15670000 EX R7,MOVE4 15680000 DS 0H 15690000 * R7 = R7 + 1 /**RESTORE REG 7 FOR EXIT WHEN LT 256 **/; 15700000 AH @7,@D7 0563 15710000 * RETURN /*RETURN TO CALLER */; 15720000 * END MOVEROUT; 15730000 @EL04 BCR 15,@E 0565 15740000 * /******************************************************************* 15750000 * /** * 15760000 * /** THIS PROCEDURE WILL VALIDITY CHECK AN EBCDIC NUMBER AS IT IS * 15770000 * /** INPUT FROM THE CONTROL CARD.UPON ENTRY REG 9 SHOULD POINT AT * 15780000 * /** START OF NUMBER IN INBUF.REG 7 SHOULD CONTAIN LENGTH OF NUMBER** 15790000 * /** A WORKAREA IS CLEARED TO BINARY ZERO AND ZONES FROM THE NUMBER * 15800000 * /** ARE MOVED TO THE WORKAREA.A COMPARE IS THEN DONE AGAINST * 15810000 * /** FOXZEROEZ.IF ALL DIGITS DO NOT COMPARE THE NUMBER IS INVALID * 15820000 * /** AND A BRANCH IS TAKEN TO SET UP MESSAGE AND RETURN,OTHERWISE * 15830000 * /** RETURN IS TO THE CALLER. * 15840000 * /** * 15850000 * /******************************************************************* 15860000 * VALCHECK: PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 15870000 * /*SAVE REG 14 IN COMMON AREA. */ 15880000 * SAVE14 = R14; 15890000 VALCHECK ST @E,360(0,@5) 0567 15900000 * R8 = R9 + R7 - 1 /**POINT AT END OF NUMBER**/; 15910000 LH @8,@D1 0568 15920000 AR @8,@7 0568 15930000 AR @8,@9 0568 15940000 * VALCK1:; /** TEST ZONE FOR 'F' **/ 15950000 * GEN ( TM 0(R8),X'F0'); 15960000 VALCK1 TM 0(R8),X'F0' 15970000 DS 0H 15980000 * /**BRANCH TO ISSUE MESSAGE 3 15990000 * IF ZONE NOT 'F' **/ 16000000 * GEN ( BC 14,MS3 ); 16010000 BC 14,MS3 16020000 DS 0H 16030000 * IF R8 ^= R9 THEN DO /**DO BELOW IF R8 NOT EQ R9**/; 16040000 CR @8,@9 0572 16050000 BC 08,@9EA 0572 16060000 * R8 = R8 - 1 /**SUBT ONE FROM R8 **/; 16070000 BCTR @8,0 0574 16080000 * GO TO VALCK1 /** BR TO TEST NEXT ZONE**/; 16090000 BC 15,VALCK1 0575 16100000 * MS3:; 16110000 * MS = 3 /**INDICATE MESSAGE 3 **/; 16120000 MS3 LA @F,3 0577 16130000 STH @F,406(0,@5) 0577 16140000 * GO TO F1B411 /** BR TO LEAVE ROUTINE**/; 16150000 BC 15,F1B411 0578 16160000 * END; 16170000 * /*RESTORE REG 14 FROM COMMON AREA. 16180000 * R14 = SAVE14; 16190000 @9EA L @E,360(0,@5) 0580 16200000 * /* RETURN TO CALLER*/ 16210000 * RETURN; 16220000 * END VALCHECK; 16230000 @EL05 BCR 15,@E 0582 16240000 * END IEBFDTBL; 16250000 @DATA1 EQU * 16260000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 16270000 @1 EQU 01 16280000 @2 EQU 02 16290000 @3 EQU 03 16300000 @4 EQU 04 16310000 @5 EQU 05 16320000 @6 EQU 06 16330000 @7 EQU 07 16340000 @8 EQU 08 16350000 @9 EQU 09 16360000 @A EQU 10 16370000 @B EQU 11 16380000 @C EQU 12 16390000 @D EQU 13 16400000 @E EQU 14 16410000 @F EQU 15 16420000 @D4 DC F'524293' 16430000 @D5 DC F'-1' 16440000 @D1 DC H'-1' 16450000 @D2 DC H'3' 16460000 @D3 DC H'256' 16470000 @D6 DC H'-2' 16480000 @D7 DC H'1' 16490000 @D8 DC H'-4' 16500000 @D9 DC H'-3' 16510000 @D10 DC H'8' 16520000 @D11 DC H'32767' 16530000 @MVC MVC 0(1,@A),0(@E) 16540000 DS 0F 16550000 @SIZ001 DC AL1(&SPN) 16560000 DC AL3(@DATEND-@DATD) 16570000 DS 0F 16580000 @X18 DC X'0000001A' 16590000 @X19 DC X'00000024' 16600000 @X20 DC X'0000003F' 16610000 @X31 DC X'00000004' 16620000 @X32 DC X'00000003' 16630000 @X33 DC X'00000002' 16640000 @X36 DC X'000002147483647F' 16650000 @C1 DC C'FX' 16660000 @C2 DC C'RA' 16670000 @C3 DC C'SL' 16680000 @C4 DC C'TL' 16690000 @C5 DC C'SR' 16700000 @C6 DC C'TR' 16710000 @X8 DC X'0000' 16720000 @C9 DC C'RP' 16730000 @C10 DC C'RO' 16740000 @C11 DC C'WV' 16750000 @C13 DC C'BI' 16760000 @C14 DC C'PD' 16770000 @C15 DC C'AL' 16780000 @C16 DC C'AN' 16790000 @C17 DC C'CO' 16800000 @C22 DC C'ZD' 16810000 DS 0D 16820000 @DATA EQU * 16830000 R14 EQU 00000014 FULLWORD INTEGER REGISTER 16840000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 16850000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 16860000 R1 EQU 00000001 FULLWORD INTEGER REGISTER 16870000 R2 EQU 00000002 FULLWORD INTEGER REGISTER 16880000 R3 EQU 00000003 FULLWORD INTEGER REGISTER 16890000 R5 EQU 00000005 FULLWORD POINTER REGISTER 16900000 R6 EQU 00000006 FULLWORD POINTER REGISTER 16910000 R7 EQU 00000007 FULLWORD POINTER REGISTER 16920000 R8 EQU 00000008 FULLWORD POINTER REGISTER 16930000 R9 EQU 00000009 FULLWORD POINTER REGISTER 16940000 COMMON EQU 00000000 308 BYTE(S) ON DWORD 16950000 PAGENO EQU COMMON+00000000 4 BYTE(S) 16960000 LINECT EQU COMMON+00000004 FULLWORD INTEGER 16970000 LINECTR EQU COMMON+00000008 FULLWORD INTEGER 16980000 PARM EQU COMMON+00000012 FULLWORD POINTER 16990000 REPEATNO EQU COMMON+00000016 HALFWORD INTEGER 17000000 CREATENO EQU COMMON+00000018 HALFWORD INTEGER 17010000 SYSP EQU COMMON+00000020 96 BYTE(S) 17020000 SYSI EQU COMMON+00000116 96 BYTE(S) 17030000 Q EQU COMMON+00000216 16 BYTE(S) ON DWORD 17040000 QFILL EQU COMMON+00000216 7 BYTE(S) 17050000 QSIGN EQU COMMON+00000223 8 BIT(S) 17060000 QFILL1 EQU COMMON+00000224 7 BYTE(S) 17070000 QSIGN1 EQU COMMON+00000231 8 BIT(S) 17080000 COUNTER EQU COMMON+00000232 FULLWORD POINTER 17090000 OPENLIST EQU COMMON+00000236 8 BYTE(S) 17100000 OPTBYTE1 EQU COMMON+00000236 4 BYTE(S) 17110000 OPTBYTE2 EQU COMMON+00000240 4 BYTE(S) 17120000 EXLST EQU COMMON+00000244 24 BYTE(S) ON WORD 17130000 INHDR EQU COMMON+00000244 1 BYTE(S) 17140000 INHDR1 EQU COMMON+00000245 3 BYTE POINTER ON WORD+1 17150000 OUTHDR EQU COMMON+00000248 1 BYTE(S) 17160000 OUTHDR1 EQU COMMON+00000249 3 BYTE POINTER ON WORD+1 17170000 INTRL EQU COMMON+00000252 1 BYTE(S) 17180000 INTRL1 EQU COMMON+00000253 3 BYTE POINTER ON WORD+1 17190000 OUTTRL EQU COMMON+00000256 1 BYTE(S) 17200000 OUTTRL1 EQU COMMON+00000257 3 BYTE POINTER ON WORD+1 17210000 EXITDCB EQU COMMON+00000260 1 BYTE(S) 17220000 EXITDCB1 EQU COMMON+00000261 3 BYTE POINTER ON WORD+1 17230000 TOTAL EQU COMMON+00000264 1 BYTE(S) 17240000 TOTAL1 EQU COMMON+00000265 3 BYTE POINTER ON WORD+1 17250000 EXLST1 EQU COMMON+00000268 4 BYTE(S) ON WORD 17260000 EDCB1 EQU COMMON+00000268 1 BYTE(S) 17270000 EDCB2 EQU COMMON+00000269 3 BYTE POINTER ON WORD+1 17280000 EXLST2 EQU COMMON+00000272 4 BYTE(S) ON WORD 17290000 EDCB3 EQU COMMON+00000272 1 BYTE(S) 17300000 EDCB4 EQU COMMON+00000273 3 BYTE POINTER ON WORD+1 17310000 EXLST3 EQU COMMON+00000276 4 BYTE(S) ON WORD 17320000 EDCB5 EQU COMMON+00000276 1 BYTE(S) 17330000 EDCB6 EQU COMMON+00000277 3 BYTE POINTER ON WORD+1 17340000 DLRECL EQU COMMON+00000280 HALFWORD INTEGER 17350000 DBLKSI EQU COMMON+00000282 HALFWORD INTEGER 17360000 DRECFM EQU COMMON+00000284 8 BIT(S) 17370000 LEFTOVER EQU COMMON+00000288 FULLWORD INTEGER 17380000 OFFSET EQU COMMON+00000292 FULLWORD POINTER 17390000 LPTR EQU COMMON+00000296 FULLWORD POINTER 17400000 DCBPTR EQU COMMON+00000300 FULLWORD POINTER 17410000 DUMMY EQU COMMON+00000304 FULLWORD POINTER 17420000 COMMON1 EQU 00000304 236 BYTE(S) ON WORD 17430000 SAVEMS EQU COMMON1+00000000 HALFWORD INTEGER 17440000 CONCODE EQU COMMON1+00000002 HALFWORD INTEGER 17450000 OUTREC EQU COMMON1+00000004 FULLWORD POINTER 17460000 CRTABPT EQU COMMON1+00000008 FULLWORD POINTER 17470000 CURCRTE EQU COMMON1+00000012 FULLWORD POINTER 17480000 CURCRGM EQU COMMON1+00000016 FULLWORD POINTER 17490000 CURPIC EQU COMMON1+00000020 FULLWORD POINTER 17500000 PICCTR EQU COMMON1+00000024 FULLWORD INTEGER 17510000 EXITTAB EQU COMMON1+00000028 FULLWORD POINTER 17520000 EXITGM EQU COMMON1+00000032 FULLWORD POINTER 17530000 CUREXIT EQU COMMON1+00000036 FULLWORD POINTER 17540000 DELIM EQU COMMON1+00000040 4 BYTE(S) 17550000 RECREM EQU COMMON1+00000044 FULLWORD INTEGER 17560000 CURFD EQU COMMON1+00000048 FULLWORD POINTER 17570000 CUROUT EQU COMMON1+00000052 FULLWORD POINTER 17580000 SAVE14 EQU COMMON1+00000056 FULLWORD POINTER 17590000 GETMLIST EQU COMMON1+00000060 16 BYTE(S) ON WORD 17600000 GLENGTH EQU COMMON1+00000060 FULLWORD INTEGER 17610000 ADRLIST EQU COMMON1+00000064 FULLWORD POINTER 17620000 IND EQU COMMON1+00000068 4 BYTE(S) 17630000 GCODE EQU COMMON1+00000068 1 BYTE(S) 17640000 SPOOL EQU COMMON1+00000069 1 BYTE(S) 17650000 CCODE EQU COMMON1+00000070 2 BYTE(S) 17660000 GCADDR EQU COMMON1+00000072 FULLWORD POINTER 17670000 FIRSTGMO EQU COMMON1+00000076 FULLWORD POINTER 17680000 CURRGMO EQU COMMON1+00000080 FULLWORD POINTER 17690000 LASTGMO EQU COMMON1+00000084 FULLWORD POINTER 17700000 FIRSTGMI EQU COMMON1+00000088 FULLWORD POINTER 17710000 CURRGMI EQU COMMON1+00000092 FULLWORD POINTER 17720000 LASTGMI EQU COMMON1+00000096 FULLWORD POINTER 17730000 CONDCODE EQU COMMON1+00000100 HALFWORD INTEGER 17740000 MS EQU COMMON1+00000102 HALFWORD INTEGER 17750000 INBUFA1 EQU COMMON1+00000104 121 BYTE(S) 17760000 INFILL EQU COMMON1+00000104 10 BYTE(S) 17770000 INBUFA EQU COMMON1+00000114 111 BYTE(S) 17780000 DDPTR EQU COMMON1+00000228 FULLWORD POINTER 17790000 DUMMY1 EQU COMMON1+00000232 FULLWORD POINTER 17800000 COMMON2 EQU 00000536 76 BYTE(S) ON WORD 17810000 SWITCH EQU COMMON2+00000000 52 BYTE(S) 17820000 FDCSW EQU COMMON2+00000000 1 BYTE(S) 17830000 FDNAMESW EQU COMMON2+00000001 1 BYTE(S) 17840000 FDPCSW EQU COMMON2+00000002 1 BYTE(S) 17850000 FDFMTSW EQU COMMON2+00000003 1 BYTE(S) 17860000 FDPLSW EQU COMMON2+00000004 1 BYTE(S) 17870000 RANGESW EQU COMMON2+00000005 1 BYTE(S) 17880000 FILLSW EQU COMMON2+00000006 1 BYTE(S) 17890000 REPSW EQU COMMON2+00000007 1 BYTE(S) 17900000 INDEXSW EQU COMMON2+00000008 1 BYTE(S) 17910000 INDNMSW EQU COMMON2+00000009 1 BYTE(S) 17920000 BQUOTESW EQU COMMON2+00000010 1 BYTE(S) 17930000 PQUOTESW EQU COMMON2+00000011 1 BYTE(S) 17940000 EQUOTESW EQU COMMON2+00000012 1 BYTE(S) 17950000 FDSW EQU COMMON2+00000013 1 BYTE(S) 17960000 DSDSW EQU COMMON2+00000014 1 BYTE(S) 17970000 NOGOSW EQU COMMON2+00000015 1 BYTE(S) 17980000 CREATESW EQU COMMON2+00000016 1 BYTE(S) 17990000 DSDCSW EQU COMMON2+00000017 1 BYTE(S) 18000000 CRCSW EQU COMMON2+00000018 1 BYTE(S) 18010000 EXITSW EQU COMMON2+00000019 1 BYTE(S) 18020000 EODSTOP EQU COMMON2+00000020 1 BYTE(S) 18030000 DSDNULSW EQU COMMON2+00000021 1 BYTE(S) 18040000 DSDORGSW EQU COMMON2+00000022 1 BYTE(S) 18050000 DSDDDSW EQU COMMON2+00000023 1 BYTE(S) 18060000 CRTBLK EQU COMMON2+00000024 1 BYTE(S) 18070000 NAMCSW EQU COMMON2+00000025 8 BIT(S) 18080000 PICCSW EQU COMMON2+00000026 8 BIT(S) 18090000 BUFPSW EQU COMMON2+00000027 1 BYTE(S) 18100000 ENDSW EQU COMMON2+00000028 1 BYTE(S) 18110000 COMCSW EQU COMMON2+00000029 1 BYTE(S) 18120000 FLAGSW EQU COMMON2+00000030 8 BIT(S) 18130000 PAGESW EQU COMMON2+00000031 1 BYTE(S) 18140000 EPSW EQU COMMON2+00000032 1 BYTE POINTER 18150000 SYSISW EQU COMMON2+00000033 1 BYTE(S) 18160000 SYSPSW EQU COMMON2+00000034 1 BYTE(S) 18170000 OLDNEWSW EQU COMMON2+00000035 1 BYTE(S) 18180000 FLUSHSW EQU COMMON2+00000036 1 BYTE(S) 18190000 FLUSHSW1 EQU COMMON2+00000037 1 BYTE(S) 18200000 DSDOSW EQU COMMON2+00000038 1 BYTE(S) 18210000 DSDISW EQU COMMON2+00000039 1 BYTE(S) 18220000 QUANSW EQU COMMON2+00000040 1 BYTE(S) 18230000 PARENSW EQU COMMON2+00000041 1 BYTE(S) 18240000 REPEATSW EQU COMMON2+00000042 1 BYTE(S) 18250000 FDPLGTH EQU COMMON2+00000052 HALFWORD INTEGER 18260000 SGCADDR EQU COMMON2+00000056 FULLWORD POINTER 18270000 FDPTR EQU COMMON2+00000060 FULLWORD POINTER 18280000 FDPTR1 EQU COMMON2+00000064 FULLWORD POINTER 18290000 FDPTR2 EQU COMMON2+00000068 FULLWORD POINTER 18300000 DUMMY2 EQU COMMON2+00000072 FULLWORD POINTER 18310000 COMMON3 EQU 00000608 188 BYTE(S) ON WORD 18320000 FDCTR EQU COMMON3+00000000 HALFWORD POINTER 18330000 LREMAIN EQU COMMON3+00000004 FULLWORD POINTER 18340000 COMPCTR EQU COMMON3+00000008 FULLWORD POINTER 18350000 LMOVED EQU COMMON3+00000012 HALFWORD POINTER 18360000 U EQU COMMON3+00000016 FULLWORD POINTER 18370000 PICEND EQU COMMON3+00000020 HALFWORD POINTER 18380000 CURFDGM EQU COMMON3+00000024 FULLWORD POINTER 18390000 SWTCH EQU COMMON3+00000028 4 BYTE(S) ON WORD 18400000 SYSINSEL EQU COMMON3+00000028 1 BYTE(S) 18410000 FIRSTSW EQU COMMON3+00000029 1 BYTE(S) 18420000 FRSTSW EQU COMMON3+00000030 1 BYTE(S) 18430000 STOPSW EQU COMMON3+00000031 1 BYTE(S) 18440000 COPYVAL EQU COMMON3+00000032 HALFWORD INTEGER 18450000 COPYFD EQU COMMON3+00000036 FULLWORD POINTER 18460000 COPYFDGM EQU COMMON3+00000040 FULLWORD POINTER 18470000 NAMCTR EQU COMMON3+00000044 HALFWORD INTEGER 18480000 NAMCTR1 EQU COMMON3+00000046 HALFWORD INTEGER 18490000 INRECSZ EQU COMMON3+00000048 HALFWORD POINTER 18500000 OUTRECSZ EQU COMMON3+00000050 HALFWORD POINTER 18510000 INRECFM EQU COMMON3+00000052 1 BYTE(S) 18520000 RECOFFST EQU COMMON3+00000053 1 BYTE POINTER 18530000 OUTRECFM EQU COMMON3+00000054 1 BYTE(S) 18540000 PICBASE EQU COMMON3+00000056 FULLWORD POINTER 18550000 MESSAGE EQU COMMON3+00000060 121 BYTE(S) 18560000 DUMMY3 EQU COMMON3+00000184 FULLWORD POINTER 18570000 DCBD EQU 00000000 280 BYTE(S) ON DWORD 18580000 FILL EQU DCBD+00000000 26 BYTE(S) 18590000 DSORG1 EQU DCBD+00000026 2 BYTE(S) 18600000 DSORG EQU DCBD+00000026 8 BIT(S) 18610000 FILLER EQU DCBD+00000028 8 BYTE(S) 18620000 IOBAD EQU DCBD+00000028 4 BYTE(S) 18630000 BFTEK EQU DCBD+00000032 8 BIT(S) 18640000 EODAD EQU DCBD+00000033 3 BYTE(S) 18650000 RECFM EQU DCBD+00000036 8 BIT(S) 18660000 EXLIST EQU DCBD+00000037 3 BYTE POINTER ON WORD+1 18670000 DDNAME EQU DCBD+00000040 8 BYTE(S) 18680000 DEBAD EQU DCBD+00000040 4 BYTE(S) 18690000 IFLGS EQU DCBD+00000040 8 BIT(S) 18700000 GETAD EQU DCBD+00000048 4 BYTE(S) 18710000 OFLGS EQU DCBD+00000048 8 BIT(S) 18720000 OFLGS1 EQU DCBD+00000049 1 BYTE(S) 18730000 MACRF EQU DCBD+00000050 2 BYTE(S) 18740000 FILL2 EQU DCBD+00000052 10 BYTE(S) 18750000 BLKSI EQU DCBD+00000062 HALFWORD INTEGER 18760000 FILL3 EQU DCBD+00000064 18 BYTE(S) 18770000 LRECL EQU DCBD+00000082 HALFWORD INTEGER 18780000 FILL4 EQU DCBD+00000084 172 BYTE(S) 18790000 NEXTDCB EQU DCBD+00000256 FULLWORD POINTER 18800000 DDNAME1 EQU DCBD+00000260 8 BYTE(S) 18810000 EODSW EQU DCBD+00000268 1 BYTE(S) 18820000 DCBSW1 EQU DCBD+00000269 1 BYTE(S) 18830000 DCBSW2 EQU DCBD+00000270 1 BYTE(S) 18840000 DCBSW3 EQU DCBD+00000271 8 BIT(S) 18850000 INREC EQU DCBD+00000272 FULLWORD POINTER 18860000 GMLGTH EQU DCBD+00000276 HALFWORD INTEGER 18870000 FIELDSEL EQU DCBD+00000278 1 BYTE(S) 18880000 SPARE EQU DCBD+00000279 1 BYTE(S) 18890000 FDTBL EQU 00000000 520 BYTE(S) ON WORD 18900000 FDNAME EQU FDTBL+00000000 8 BYTE(S) 18910000 FDREPNM EQU FDTBL+00000008 8 BYTE(S) 18920000 FDINDNM EQU FDTBL+00000016 8 BYTE(S) ON WORD 18930000 FDUMMY EQU FDTBL+00000016 4 BYTE(S) 18940000 FDINDNUM EQU FDTBL+00000020 FULLWORD POINTER 18950000 FDLGTH EQU FDTBL+00000024 HALFWORD POINTER 18960000 FDCYCLE EQU FDTBL+00000026 HALFWORD POINTER 18970000 FDACTION EQU FDTBL+00000028 2 BYTE(S) 18980000 FDFORMAT EQU FDTBL+00000030 2 BYTE(S) 18990000 FDSWITCH EQU FDTBL+00000032 8 BIT(S) 19000000 INDBYNAM EQU FDTBL+00000032 1 BIT(S) 19010000 PASS EQU FDTBL+00000032 1 BIT(S) 19020000 FXACTION EQU FDTBL+00000032 1 BIT(S) 19030000 RPACTION EQU FDTBL+00000032 1 BIT(S) 19040000 ROACTION EQU FDTBL+00000032 1 BIT(S) 19050000 WVACTION EQU FDTBL+00000032 1 BIT(S) 19060000 STACTION EQU FDTBL+00000032 1 BIT(S) 19070000 NUACTION EQU FDTBL+00000032 1 BIT(S) 19080000 FDFILL EQU FDTBL+00000033 1 BYTE(S) 19090000 FDSIGN EQU FDTBL+00000034 1 BYTE(S) 19100000 FDCHAR EQU FDTBL+00000035 1 BYTE(S) 19110000 FDRANGE EQU FDTBL+00000036 4 BYTE(S) 19120000 FDOBUF EQU FDTBL+00000040 HALFWORD POINTER 19130000 FDFRINC EQU FDTBL+00000042 HALFWORD POINTER 19140000 FDFROMAD EQU FDTBL+00000044 4 BYTE(S) 19150000 FDMLGTH EQU FDTBL+00000048 HALFWORD POINTER 19160000 FDTOINC EQU FDTBL+00000050 HALFWORD POINTER 19170000 FDCYCCNT EQU FDTBL+00000052 HALFWORD POINTER 19180000 FDSLGTH EQU FDTBL+00000054 HALFWORD POINTER 19190000 FDSLGTHR EQU FDTBL+00000056 HALFWORD POINTER 19200000 FDFRINCR EQU FDTBL+00000058 1 BYTE(S) 19210000 FDTOINCR EQU FDTBL+00000059 1 BYTE(S) 19220000 LTOFREE EQU FDTBL+00000060 HALFWORD POINTER 19230000 FDSW1 EQU FDTBL+00000062 8 BIT(S) 19240000 STRTLOC1 EQU FDTBL+00000062 1 BIT(S) 19250000 FOXZEROS EQU * 16 BYTE(S) 19260000 DC X'F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0' 19270000 INBUF EQU 00000000 80 BYTE(S) 19280000 BUFFER EQU 00000000 32767 BYTE(S) 19290000 ON EQU * 1 BYTE(S) 19300000 DC X'FF' 19310000 OFF EQU * 1 BYTE(S) 19320000 DC X'00' 19330000 WKADDR EQU 00000000 32767 BYTE(S) 19340000 COPAT EQU * 27 BYTE(S) 19350000 DC C' ½.<(+|&&!$*);^-/,%_>?:#@''="' 19360000 ALPAT EQU * 36 BYTE(S) 19370000 DC C'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' 19380000 OPTIONS EQU 00000000 256 BYTE(S) 19390000 PAGE EQU 00000000 256 BYTE(S) 19400000 DDLST EQU 00000000 256 BYTE(S) 19410000 ORG @DATA 19420000 DS 00000081C 19430000 @L EQU 1 19440000 @DATD DSECT 19450000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 19460000 BUFPTR EQU @DATD+00000072 FULLWORD POINTER 19470000 RCODE EQU @DATD+00000076 FULLWORD INTEGER 19480000 OPTPTR EQU @DATD+00000080 FULLWORD POINTER 19490000 PGPTR EQU @DATD+00000084 FULLWORD POINTER 19500000 DS 00000088C 19510000 @TEMPS DS 0F 19520000 @TEMP4 DC F'0' 19530000 @DATEND EQU * 19540000 IEBFDTBL CSECT , 19550000 @9F2 EQU F9E5 19560000 @9EF EQU @EL02 19570000 END IEBFDTBL 19580000