ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:08 2020 Source File: \t1fbtd.asm 1 | *************************************************** T1A00010 2 | * * T1A00014 3 | *STATUS - VERSION 2, MODIFICATION LEVEL 12 * T1A00015 4 | * * T1A00020 5 | * SUBROUTINE NAME- * T1A00030 6 | * FULL NAME-FLOATING POINT BINARY TO DECIMAL * T1A00040 7 | * AND DECIMAL TO BINARY CONVERSION. * T1A00050 8 | * CODE NAME- FBTD/FDTB * T1A00060 9 | * PURPOSE- THIS SUBPROGRAM CONVERTS A FLOATING- * T1A00070 10 | * POINT BINARY NUMBER TO A DECIMAL FLOATING- * T1A00080 11 | * POINT NUMBER, OR VICE VERSA. * T1A00090 12 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* T1A00100 13 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * T1A00110 14 | * SUBROUTINE LIBRARY MANUAL. * T1A00120 15 | * SPECIAL FEATURES- N/A * T1A00130 16 | * ADDITIONAL INFORMATION- * T1A00140 17 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * T1A00150 18 | * SUBROUTINE LIBRARY MANUAL * T1A00160 19 | * * T1A00170 20 | *************************************************** T1A00180 CALL FBTD/FDTB 22 | ENT FBTD BINARY-TO-DECIMAL T1A00200 23 | ENT FDTB DECIMAL-TO-BINARY. T1A00210 0009 24 | D EQU 9 NO. OF SIGNIFICANT DIGITS T1A00220 0000 0000 25 | FDTB DC 0 FLOAT DECIMAL TO BINARY T1A00230 0001 691E 26 | STX 1 FDX1+1 SAVE INDEX REGISTERS T1A00240 0002 6A1F 27 | STX 2 FDX2+1 T1A00250 0003 6B0A 28 | STX 3 FDX3+1 T1A00260 0004 C480 0000R 29 | LD I FDTB ADDR OF 1ST WD OF INPUT T1A00270 0006 D001 30 | STO *+1 T1A00280 0007 6500 0000 31 | LDX L1 *-* PUT ARGUMENT ADDR IN XR1 T1A00290 0009 7401 0000R 32 | MDX L FDTB,1 SET UP RETURN T1A00300 000B 4400 00C9R 33 | BSI L FLOTD CALL FOR CONVERSION. T1A00310 000D 6700 0000 34 | FDX3 LDX L3 *-* RESTORE XR3 T1A00320 000F 10A0 35 | SLT 32 T1A00330 0010 9A00 36 | SD 2 FLBMN-F T1A00340 0011 4820 37 | BSC Z 2-4 T1A00345 0012 7006 38 | MDX FD01 NON-ZERO, DO 'EOR' 212 T1A00346 0013 18D0 39 | RTE 16 LOOK AT Q REG 212 T1A00348 0014 4820 40 | BSC Z SKIP IF ALSO ZERO 212 T1A00350 0015 7002 41 | MDX FD00 GO DO ROTATE & EOR 212 T1A00352 0016 18D0 42 | RTE 16 RETURN A+Q TO NORMAL 212 T1A00354 0017 7002 43 | MDX FD02 GO CONVERT MAGNITUDE 212 T1A00355 0018 18D0 44 | FD00 RTE 16 RETURN A+Q REGS 212 T1A00356 0019 F051 45 | FD01 EOR FBCN+6 =/8000 212 T1A00358 001A 4810 46 | FD02 BSC - CONVERT MAGNITUDE & SIGN212 T1A00360 001B CA00 47 | LDD 2 FLBMN-F TO TWOS COMPLEMENT FORM. T1A00370 001C DB7E 48 | STD 3 126 STORE RESULT MANTISSA T1A00380 001D C2FE 49 | LD 2 FLBCH-F T1A00390 001E D37D 50 | STO 3 125 STORE RESULT CHARACTERISTIC T1A00400 001F 6500 0000 51 | FDX1 LDX L1 *-* RESTORE XR1 AND XR2 T1A00410 0021 6600 0000 52 | FDX2 LDX L2 *-* T1A00420 0023 4C80 0000R 53 | BSC I FDTB EXIT. T1A00430 0025 0000 54 | FBTD DC 0 FLOAT BINARY TO DECIMAL T1A00440 0026 6D00 00C4R 55 | STX L1 FBX1+1 T1A00450 0028 6E00 00C6R 56 | STX L2 FBX2+1 T1A00460 002A C480 0025R 57 | LD I FBTD GET OUTPUT ADDR T1A00470 002C 7401 0025R 58 | MDX L FBTD,1 SET UP RETURN. T1A00480 002E D07A 59 | STO FPLC+1 T1A00490 002F C37D 60 | LD 3 125 SCALE THE EXPONENT T1A00500 0030 903B 61 | S FBCN+7 =127 T1A00510 0031 D400 0134R 62 | STO L FLBCH SAVE SCALED EXPONENT T1A00520 0033 10A0 63 | SLT 32 CLEAR ACC AND EXT TO T1A00530 0034 DC00 0138R 64 | STD L MCAR INITIALIZE STG AREAS T1A00540 0036 62FB 65 | LDX 2 -5 LOOP TO CLEAR BUF5 T1A00550 0037 D600 0140R 66 | STO L2 BUF5+5 CLEAR BUF5. T1A00560 0039 7201 67 | MDX 2 +1 T1A00570 003A 70FC 68 | MDX *-4 T1A00580 003B D400 0132R 69 | STO L FLE10 CLEAR CTR T1A00590 003D CB7E 70 | LDD 3 126 GET THE MANTISSA OF THE T1A00600 003E DC00 013CR 71 | STD L BUF5+1 ARGUMENT T1A00610 0040 4C18 0079R 72 | BSC L FBNX,+- BR TO OUTPUT ZERO IF ZERO. T1A00620 0042 4C10 0048R 73 | BSC L *+4,- OTHERWISE,GET THE ABSOLUTE T1A00630 0044 10A0 74 | SLT 32 VALUE OF THE MANTISSA T1A00640 0045 9B7E 75 | SD 3 126 T1A00650 0046 DC00 013CR 76 | STD L BUF5+1 T1A00660 0048 7011 77 | MDX FBTN2 BR TO GET PROPER FORM T1A00670 78 | * T1A00680 79 | *THIS SECTION SCALES THE MANTISSA SO THAT THE T1A00690 80 | *BINARY PT IS BETWEEN WDS 1 AND 2 OF BUF5. THE T1A00700 81 | *MANTISSA IS KEPT CENTERED BY MULTIPLYING. T1A00710 82 | * T1A00720 0049 C400 0134R 83 | FBTN LD L FLBCH GET SCALED EXPONENT T1A00730 004B 4C18 0079R 84 | BSC L FBNX,+- GO TO OUTPUT IF ZERO. T1A00740 004D 4C28 0055R 85 | BSC L FBNM,+Z DO A SHIFT RT IF NEG. T1A00750 004F 4400 01B9R 86 | BSI L SLT OTHERWISE SHIFT LEFT AND T1A00760 0051 74FF 0134R 87 | MDX L FLBCH,-1 DECR FLBCH T1A00770 0053 1000 88 | NOP IF MDX CAUSES BR,SKIP NOP T1A00780 0054 7005 89 | MDX FBTN2 GO TO GENERATE FRACTION T1A00790 90 | * DIGITS. T1A00800 0055 4400 01ACR 91 | FBNM BSI L SRT BRANCH TO SHIFT RIGHT SUBR T1A00810 0057 7401 0134R 92 | MDX L FLBCH,+1 ALTER EXPONENT TO MATCH T1A00820 0059 1000 93 | NOP IF MDX CAUSES BR,SKIP NOP T1A00830 94 | * T1A00840 95 | *THIS SECTION CALLS THE MPY BY 10 RTN TO GET T1A00850 96 | *AN INTEGER DIGIT FOR SCIENTIFIC FORMAT OUTPUT. T1A00860 97 | * T1A00870 005A C400 013BR 98 | FBTN2 LD L BUF5 GET THE CARRY WORD T1A00880 005C 4C20 006DR 99 | BSC L FBTN1,Z BR TO DIVIDE BY 10 IF NON- T1A00890 005E 4400 0194R 100 | BSI L MPY ZERO.IF ZERO,GO TO MPY BY T1A00900 0060 74FF 0132R 101 | MDX L FLE10,-1 10,AND KEEP TRACK W/CTR T1A00910 0062 1000 102 | NOP IF MDX CAUSES BR,SKIP NOP T1A00920 0063 70F6 103 | MDX FBTN2 REPEAT T1A00930 0064 0040 104 | BLANK DC /0040 BLANK 2-4 T1A00935 105 | * T1A00940 106 | *CONSTANTS TABLE FOR FBTD T1A00950 107 | * T1A00960 0065 004E 108 | FBCN DC /004E PLUS T1A00970 0066 0060 109 | DC .- 1 MINUS T1A00980 0067 00F0 110 | DC .0 2 ZERO T1A00990 0068 004B 111 | DC .. 3 PERIOD T1A01000 0069 00C5 112 | DC .E 4 LETTER E T1A01010 006A 000A 113 | DC 10 5 SINGLE WD 10 T1A01020 006B 8000 114 | DC /8000 6 SIGN BIT MASK T1A01030 006C 007F 115 | DC 127 7 SCALE EXPONENT T1A01040 116 | * T1A01050 117 | *THIS SECTION CALLS THE DIVIDE BY 10 RTN TO GET T1A01060 118 | *AN INTEGER FOR SCIENTIFIC FORMAT OUTPUT. T1A01070 119 | * T1A01080 006D C400 013BR 120 | FBTN1 LD L BUF5 CHECK CARRY AGAINST 10 T1A01090 006F 90FA 121 | S FBCN+5 =10 T1A01100 0070 4C28 0049R 122 | BSC L FBTN,+Z LT 10,GO SCALE MANTISSA T1A01110 0072 4400 017FR 123 | BSI L DIV GT 10, BR TO DIVIDE SUBR T1A01120 0074 7401 0132R 124 | MDX L FLE10,+1 KEEP TRACK OF POWERS OF 10 T1A01130 0076 1000 125 | NOP IF MDX CAUSES BR,SKIP NOP T1A01140 0077 70F5 126 | MDX FBTN1 RETURN T1A01141 127 | * 2-9 T1A01142 128 | *THIS SECTION TAKES CARE OF POSSIBLE ERRORS 2-9 T1A01143 129 | *ENCOUNTERED DURING EARLIER TRUNCATIONS. 2-9 T1A01144 130 | *MAX ADD THAT WILL NOT EFFECT RESULT INCORRECTLY2-9 T1A01145 131 | *IS 0.5*10**(-8) = /0. 0000 0015 798E 2-9 T1A01146 132 | * 2-9 T1A01147 0078 0001 133 | ONE DC 1 DECIMAL ONE 2-9 T1A01148 134 | * 2-9 T1A01149 0079 6104 135 | FBNX LDX 1 4 2-9 T1A01150 007A 1810 136 | FLOOP SRA 16 CLEAR ACC,SAVE CARRY 2-9 T1A01151 007B 4802 137 | BSC C CARRY ON LAST ADD 2-9 T1A01152 007C C0FB 138 | LD ONE YES,ADD ONE 2-9 T1A01153 007D 8500 0141R 139 | A L1 FEL2-4 ADD MAX ERROR 2-9 T1A01154 007F 8500 013AR 140 | A L1 BUF5-1 2-9 T1A01155 0081 D500 013AR 141 | STO L1 BUF5-1 2-9 T1A01156 0083 71FF 142 | MDX 1 -1 2-9 T1A01157 0084 70F5 143 | MDX FLOOP TAKE NEXT WORD IN BUF5 2-9 T1A01158 144 | * 2-9 T1A01159 0085 9400 012CR 145 | S L FLCN+16 SUBTRACT TEN 2-9 T1A01160 0087 4C28 008ER 146 | BSC L FBNX1,Z+ BR IF BUF5 NE TO 10 2-9 T1A01161 0089 74F7 013BR 147 | MDX L BUF5,-9 NO,MAKE BUF5 = 1 2-9 T1A01162 008B 7401 0132R 148 | MDX L FLE10,1 INCR 10TH EXPONENT 2-9 T1A01163 008D 1000 149 | NOP 2-9 T1A01164 150 | * T1A01169 151 | *THIS SECTION ORGANIZES AND OUTPUTS A STRING OF T1A01170 152 | *EBCDIC-CODED CHARS REPRESENTING THE FLTING PT T1A01180 153 | *DECIMAL EQUIVALENT OF THE INPUT BINARY NO. T1A01190 154 | * T1A01200 008E 6580 00A9R 155 | FBNX1 LDX I1 FPLC+1 OUTPUT ADDR IN XR1 T1A01210 0090 C0D4 156 | LD FBCN =.+ T1A01220 0091 D100 157 | STO 1 0 SET THE ALGEBRAIC SIGN TO T1A01230 0092 C37E 158 | LD 3 126 CORRESPOND TO THAT OF THE T1A01240 0093 4C10 0097R 159 | BSC L *+2,- INPUT BINARY NO. T1A01250 0095 C0D0 160 | LD FBCN+1 =.- T1A01260 0096 D100 161 | STO 1 0 T1A01270 0097 C400 013BR 162 | LD L BUF5 GET INTEGER DIGIT T1A01280 0099 80CD 163 | A FBCN+2 =.0 SET TO EBCDIC CODE T1A01290 009A D101 164 | STO 1 1 AND OUTPUT T1A01300 009B C0CC 165 | LD FBCN+3 =.. SET DECIMAL POINT T1A01310 009C D102 166 | STO 1 2 T1A01320 009D 710B 167 | MDX 1 D+2 MODIFY XR1 ACCORDING TO T1A01330 009E 690A 168 | STX 1 FPLC+1 NO. OF SIGNIFICANT DIGITS T1A01340 009F 61F8 169 | LDX 1 -D+1 FOR NEXT PART OF OUTPUT T1A01350 170 | * T1A01360 171 | *GENERATE THE FRACTIONAL DIGITS T1A01370 172 | * T1A01380 00A0 1010 173 | FBNX2 SLA 16 CLEAR THE CARRY WD OF BUF5 T1A01390 00A1 D400 013BR 174 | STO L BUF5 GENERATE 10 FRACTION DIGITS T1A01400 00A3 4400 0194R 175 | BSI L MPY BR TO MULTIPLY BY 10 SUBR T1A01410 00A5 C400 013BR 176 | LD L BUF5 GET THE RESULTING DIGIT T1A01420 00A7 80BF 177 | A FBCN+2 =.0 EBCDIC FOR OUTPUT T1A01430 00A8 D500 0000 178 | FPLC STO L1 *-* OUTPUT FRACTIONAL DIGIT T1A01440 00AA 7101 179 | MDX 1 +1 MODIFY CTR FOR RETURN T1A01450 00AB 70F4 180 | MDX FBNX2 GO TO CALC NEXT DIGIT T1A01460 181 | * T1A01470 182 | *GENERATE THE EXPONENT OF TEN T1A01480 183 | * T1A01490 00AC 6580 00A9R 184 | LDX I1 FPLC+1 GET NEXT OUTPUT ADDR T1A01500 00AE C0B5 185 | LD BLANK .BLANK. 2-4 T1A01501 00AF D104 186 | STO 1 4 SET .BLANK. 2-4 T1A01502 00B0 C0B8 187 | LD FBCN+4 =.E T1A01510 00B1 D100 188 | STO 1 0 SET .E. T1A01520 00B2 C0B2 189 | LD FBCN =.+ GET PLUS AND STORE T1A01530 00B3 D101 190 | STO 1 1 T1A01540 00B4 1010 191 | SLA 16 GET OPPOSITE SIGN OF FLE10 T1A01550 00B5 907C 192 | S FLE10 2-4 T1A01560 00B6 4C08 00BBR 193 | BSC L FGENT,+ BR IF NOT PTV 2-4 T1A01570 00B8 D079 194 | STO FLE10 ELSE REVERSE SIGN IN 2-4 T1A01580 00B9 C0AC 195 | LD FBCN+1 FLET0,AND REPLACE THE T1A01590 00BA D101 196 | STO 1 1 STORED PLUS WITH MINUS. T1A01600 00BB C076 197 | FGENT LD FLE10 GET ABS VALUE OF EXP. 2-4 T1A01610 00BC 1890 198 | SRT 16 SHIFT TO EXTENSION AND T1A01620 00BD A8AC 199 | D FBCN+5 DIVIDE BY 10. T1A01630 00BE 80A8 200 | A FBCN+2 =.0. EBCDIC OF QUOTIENT T1A01640 00BF D102 201 | STO 1 2 STORED IN TENS POSITION T1A01650 00C0 18D0 202 | RTE 16 GET REMAINDER INTO A REG T1A01660 00C1 80A5 203 | A FBCN+2 =.0. EBCDIC OF REMAINDER T1A01670 00C2 D103 204 | STO 1 3 STORED IN UNITS POSITION T1A01680 00C3 6500 0000 205 | FBX1 LDX L1 *-* RESTORE XR1 T1A01690 00C5 6600 0000 206 | FBX2 LDX L2 *-* RESTORE XR2 T1A01700 00C7 4C80 0025R 207 | BSC I FBTD RETURN TO CALLER T1A01710 208 | * T1A01720 209 | *THIS SECTION IS THE BASIC DECIMAL TO BINARY CON- T1A01730 210 | *VERSION ROUTINE. XR1 POINTS TO THE INPUT STRING. T1A01740 211 | *IT RETURNS A NORMAL MANTISSA (MAGNITUDE+SIGN) IN T1A01750 212 | *FLBMN. IT RETURNS A BINARY EXPONENT IN EXCESS 128 T1A01760 213 | *CODE IN FLBCH. T1A01770 214 | * T1A01780 215 | *IF B VALUE SPECIFIED,ANSWER IS RETURNED IN FLB2 T1A01790 216 | *AND FLBSW SET NON-ZERO. IF DECIMAL POINT OR E T1A01800 217 | *SPECIFIED,OR B SPECIFIED, FLNIS SET NON-ZERO. T1A01810 218 | * T1A01820 00C9 0000 219 | FLOTD DC 0 ENTRY--LINK WORD T1A01830 00CA 10A0 220 | SLT 32 CLEAR ACC AND EXT T1A01840 00CB 62F2 221 | LDX 2 FLE10-BUF5-5 T1A01850 00CC D600 0140R 222 | STO L2 BUF5+5 RESET SWITCHES AND T1A01860 00CE 7201 223 | MDX 2 1 BUFFERS TO ZERO. T1A01870 00CF 70FC 224 | MDX *-4 T1A01880 00D0 C04B 225 | LD FLCN =SLT 0. SET FLLP2 TO SHIFT T1A01890 00D1 D013 226 | STO FLLP2 LEFT ZERO (INITIALIZED) T1A01900 00D2 C100 227 | LD 1 0 ANALYZE SIGN T1A01910 00D3 9049 228 | S FLCN+1 =.PLUS(12-8-6) T1A01920 00D4 4C18 00DER 229 | BSC L FL1,+- IF PLUS,BR TO FL1 T1A01930 00D6 9047 230 | S FLCN+2 =AMPERSAND(12)-PLUS T1A01940 00D7 4C18 00DER 231 | BSC L FL1,+- IF AMPERSAND,BR TO FL1 T1A01950 00D9 9045 232 | S FLCN+3 .- MINUS .AMPERSAND T1A01960 00DA 4C20 00DFR 233 | BSC L *+3,Z IF NOT MINUS,BR TO FL1+1 T1A01970 00DC C043 234 | LD FLCN+4 =/8000 T1A01980 00DD D055 235 | STO FLSGN IF MINUS,ST - BIT IN FLSGN T1A01990 00DE 7101 236 | FL1 MDX 1 +1 INCR XR1 TO READ NEXT CHAR T1A02000 00DF 6300 237 | LDX 3 0 RESET DECML PT CNT T1A02010 00E0 C100 238 | FLLP LD 1 0 GET A MANTISSA DIGIT T1A02020 00E1 7101 239 | MDX 1 +1 INCR XR1 TO READ NEXT CHAR T1A02030 00E2 903E 240 | S FLCN+5 =.0. FROM EBCDIC TO BINARY T1A02040 00E3 4C28 00EDR 241 | BSC L FLSSC,+Z BR IF SPECIAL CHAR T1A02050 00E5 1080 242 | FLLP2 SLT 0 CHANGED TO MDX 3 -1 IF T1A02060 00E6 1080 243 | SLT 0 CHAR IS PERIOD MAY SKIP. T1A02070 00E7 D051 244 | STO MCAR+1 ST CHAR T1A02080 00E8 4400 0194R 245 | BSI L MPY COMPUTE BINARY MANTISSA T1A02090 00EA 4C20 01A5R 246 | BSC L FLERR,Z CHK MCAR+1.ERROR IF NOT 0 T1A02100 00EC 70F3 247 | MDX FLLP IF 0,READ NEXT CHAR T1A02110 248 | * T1A02120 249 | *ANALYZE SPECIAL CHARACTER T1A02130 250 | * T1A02140 00ED 9034 251 | FLSSC S FLCN+6 =.E-.0 CHECK FOR E T1A02150 00EE 4C18 00FBR 252 | BSC L FLESC,+- IF E,BR TO SCAN SPECS T1A02160 00F0 9033 253 | S FLCN+8 =..-.E CHK FOR PERIOD T1A02170 00F1 4C20 00F7R 254 | BSC L *+4,Z IF NOT .,BR TO CHK BLANK T1A02180 00F3 C031 255 | LD FLCN+9 IF PERIOD,PUT MDX 3 -1 IN T1A02190 00F4 D0F0 256 | STO FLLP2 FLLP2 AND IN FLNIS TO CNT T1A02200 00F5 D044 257 | STO FLNIS NO. OF DECML PLACES T1A02210 00F6 70E9 258 | MDX FLLP RETURN TO READ NEXT CHAR T1A02220 00F7 902E 259 | S FLCN+10 =. -.. CHK FOR BLANK T1A02230 00F8 4C20 01A5R 260 | BSC L FLERR,Z IF NOT BLANK,SET ERROR T1A02240 00FA 704B 261 | MDX FLFIN INDR.IF BLANK,END SCAN. T1A02250 262 | * T1A02260 263 | *SCAN FOR E AND B SPECIFICATIONS T1A02270 264 | * T1A02280 00FB C02B 265 | FLESC LD FLCN+11 ST FLE10 ADDR IN FL3+1 AND T1A02290 00FC D017 266 | STO FL3+1 FLNIS T1A02300 00FD D03C 267 | STO FLNIS T1A02310 00FE C030 268 | LD FLCN+19 =A FLEBF-FL4-1 T1A02320 00FF D017 269 | STO FL4 T1A02330 0100 C100 270 | LD 1 0 GET SIGN OF EXPONENT T1A02340 0101 901B 271 | S FLCN+1 =.PLUS(12-6-8) T1A02350 0102 4C18 010CR 272 | BSC L FL2,+- BR TO GET EXPONENT IF PTV T1A02360 0104 9019 273 | S FLCN+2 =.AMPERSAND(12)-.PLUS T1A02370 0105 4C18 010CR 274 | BSC L FL2,+- BR TO GET EXPONENT IF PTV T1A02380 0107 9017 275 | S FLCN+3 .- MINUS .AMPERSAND T1A02390 0108 4C20 010DR 276 | BSC L *+3,Z BR IF NOT MINUS T1A02400 010A C01D 277 | LD FLCN+12 IF MINUS,PUT S FLEBF-FL4-1 T1A02410 010B D00B 278 | STO FL4 IN FL4 T1A02420 010C 7101 279 | FL2 MDX 1 1 INCR XR1 TO READ NEXT CHAR T1A02430 010D C100 280 | LD 1 0 GET A DIGIT OF EXPONENT T1A02440 010E 7101 281 | MDX 1 1 INCR XR1 TO READ NEXT CHAR T1A02450 010F 9011 282 | S FLCN+5 =.0. FROM EBCDIC TO BINARY T1A02460 0110 4C28 00EDR 283 | BSC L FLSSC,+Z BR TO SPECIAL CHAR IF NEG T1A02470 0112 D008 284 | STO FLEBF OTHERWISE,STORE DIGIT T1A02480 0113 C400 0000 285 | FL3 LD L *-* GET PREVIOUS EXPONENT RSLT T1A02490 0115 A016 286 | M FLCN+16 MPY BY 10 T1A02500 0116 1090 287 | SLT 16 MOVE TO A REGISTER T1A02510 0117 8003 288 | FL4 A FLEBF ADD DIGIT JUST READ T1A02520 0118 D480 0114R 289 | STO I FL3+1 KEEP RESULT TO ADD TO NEXT T1A02530 011A 70F2 290 | MDX FL2+1 DIGIT READ T1A02540 291 | * T1A02550 292 | *CONSTANTS TABLE FOR FBTD T1A02560 293 | * T1A02570 011B 0000 294 | FLEBF DC 0 TEMP STG T1A02580 011C 1080 295 | FLCN SLT 0 T1A02590 011D 004E 296 | DC /4E (PLUS) T1A02600 011E 0002 297 | DC /50-/4E (AMPERSAND-PLUS) T1A02610 011F 0010 298 | DC +.--/50 (MINUS-AMPERSAND) T1A02620 0120 8000 299 | DC /8000 SIGN BIT MASK 4 T1A02630 0121 00F0 300 | DC .0 EBCDIC ZERO 5 T1A02640 0122 FFD5 301 | DC .E-.0 TEST FOR E 6 T1A02650 0123 FFFD 302 | DC .B-.E TEST FOR B 7 T1A02660 0124 FF86 303 | DC ..-.E TEST FOR PERIOD 8 T1A02670 0125 73FF 304 | MDX 3 -1 USED TO CNT DECML PLACES 9 T1A02680 0126 FFF5 305 | DC . -.. TEST FOR BLANK 10 T1A02690 0127 0132R 306 | DC FLE10 FLE10 ADDRESS 11 T1A02700 0128 9003 307 | S X FLEBF-FL4-1 SUB CON FOR NEG EXPON- T1A02710 0129 0000 308 | DC 0 SINGLE WORD ZERO. ENT T1A02720 012A 0001 309 | DC 1 SINGLE WORD ONE 14 T1A02730 012B 0100 310 | DC 256 4-BIT ON 15 T1A02740 012C 000A 311 | DC 10 SINGLE WORD TEN 16 T1A02750 012D 0005 312 | DC 5 SINGLE WORD FIVE 17 T1A02760 012E 00E2 313 | DC .S EBCDIC S 18 T1A02770 012F 8003 314 | A X FLEBF-FL4-1 ADD CON FOR PTV 19 T1A02780 0130 7FFF 315 | DC /7FFF SGN BIT MASK. /EXPONENT20 T1A02790 0131 FFFB 316 | DC -5 SINGLE WORD -5 21 T1A02800 0132 317 | FLE10 BSS 1 EXPONENT OF 10 CTR T1A02810 0133 318 | FLSGN BSS 1 TEMP SGN STG T1A02820 0134 319 | FLBCH BSS 1 STG FOR BINARY EXPONENT T1A02830 0136 320 | FLBMN BSS E 2 STG FOR BINARY MANTISSA T1A02840 0138 321 | MCAR BSS E 2 TWO WORD CARRY BUFFER T1A02850 013A 322 | FLNIS BSS 1 INDR OF INPUT FORMAT T1A02860 013B 323 | BUF5 BSS 5 5-WD WORKING BUFFER T1A02870 0140 0000 324 | FLONE DC 0 TWO WORD ONE T1A02880 0141 0001 325 | DC 1 T1A02890 326 | **** ERROR VECTOR **** 2-9 T1A02891 0142 0000 327 | DC 0 * 2-9 T1A02892 0143 0000 328 | DC 0 * 2-9 T1A02893 0144 0015 329 | DC /0015 * 0.5 * 10 ** (-8) 2-9 T1A02894 0145 798D 330 | FEL2 DC /798D * 2-9 T1A02895 331 | ********************* 2-9 T1A02896 332 | * T1A02900 333 | *POST-SCAN PROCESSING T1A02910 334 | * T1A02920 0146 7780 0132R 335 | FLFIN MDX I3 FLE10 COMPUTE POWER OF 10 T1A02930 0148 1080 336 | SLT 0 MAY SKIP T1A02940 0149 6BE8 337 | STX 3 FLE10 ST NEW POWER OF 10 T1A02950 014A 6700 00C0 338 | LDX L3 64+128 INITIAL BINARY EXPONENT T1A02960 014C 62FB 339 | LDX 2 -5 SET CTR TO CHK FOR ZERO T1A02970 014D C600 0140R 340 | GETZ LD L2 BUF5+5 T1A02980 014F 4C20 0154R 341 | BSC L *+3,Z IF NOT ZERO,GO TO POSITION T1A02990 0151 7201 342 | MDX 2 +1 T1A03000 0152 70FA 343 | MDX GETZ REPEAT LOOP T1A03010 0153 7052 344 | MDX FLZER FLOATING ZERO SPECIFIED T1A03020 0154 C0E6 345 | FLFNL LD BUF5 SHIFT MANTISSA RT UNTIL T1A03030 0155 4C18 015BR 346 | BSC L *+4,+- THE LEFT WORD IS ZERO. T1A03040 0157 4054 347 | BSI SRT T1A03050 0158 7301 348 | MDX 3 +1 UPDATE BINARY EXPONENT T1A03060 0159 1080 349 | SLT 0 MAY SKIP T1A03070 015A 70F9 350 | MDX FLFNL REPEAT LOOP T1A03080 015B C0E0 351 | FLFNX LD BUF5+1 SHIFT LEFT(NORMALIZE) T1A03090 015C 4C28 0162R 352 | BSC L *+4,+Z MANTISSA T1A03100 015E 405A 353 | BSI SLT T1A03110 015F 73FF 354 | MDX 3 -1 UPDATE BINARY EXPONENT T1A03120 0160 1080 355 | SLT 0 MAY SKIP T1A03130 0161 70F9 356 | MDX FLFNX REPEAT LOOP T1A03140 357 | * T1A03150 358 | *ADJUST MANTISSA AND EXPONENT BY POWER OF 10 MOD. T1A03160 359 | * T1A03170 0162 C0CF 360 | LD FLE10 GET EXPONENT OF 10 T1A03180 0163 4C08 0169R 361 | BSC L *+4,+ BR IF NOT PTV T1A03190 0165 90C4 362 | S FLCN+14 =1. DECR EXPONENT T1A03200 0166 D0CB 363 | STO FLE10 T1A03210 0167 402C 364 | BSI MPY MPY IF EXPONENT OF 10 IS T1A03220 0168 70EB 365 | MDX FLFNL PTV T1A03230 0169 4C10 016FR 366 | BSC L FLFEX,- EXIT IF ZERO T1A03240 016B 80BE 367 | A FLCN+14 =1. IF EXPONENT OF 10 IS T1A03250 016C D0C5 368 | STO FLE10 NEG,TNCR EXPONENT T1A03260 016D 4011 369 | BSI DIV AND DIVIDE BY 10 T1A03270 016E 70E5 370 | MDX FLFNL GO TO SHIFT RIGHT T1A03280 371 | * T1A03290 372 | *ASSEMBLE SIGNED MANTISSA AND BINARY T1A03300 373 | *CHARACTERISTIC FOR TRANSMISSION T1A03310 374 | * T1A03320 016F C8CC 375 | FLFEX LDD BUF5+1 GET MANTISSA AND STORE T1A03330 0170 6BC3 376 | STX 3 FLBCH T1A03340 0171 1881 377 | SRT 1 LEAVE SIGN BIT T1A03350 0172 E0BD 378 | AND FLCN+20 =/7FFF TURN OFF SIGN BIT T1A03360 0173 E8BF 379 | OR FLSGN GET PROPER SIGN T1A03370 0174 D8C1 380 | STD FLBMN STORE SIGNED MANTISSA T1A03380 0175 C0BE 381 | LD FLBCH GET CHARACTERISTIC T1A03390 0176 4C28 01A5R 382 | BSC L FLERR,+Z CHECK FOR EXPONENT T1A03400 0178 90B2 383 | S FLCN+15 =256 OVERFLOW AND T1A03410 0179 4C10 01A5R 384 | BSC L FLERR,- UNDERFLOW T1A03420 017B 6600 0136R 385 | FLXXX LDX L2 F XR2=MANTISSA ADDR T1A03430 0136R 386 | F EQU FLBMN DEFINE MANITISSA ADDR T1A03440 017D 4C80 00C9R 387 | BSC I FLOTD RETURN TO OUTPUT T1A03450 388 | * T1A03460 389 | *SUBROUTINE TO DIVIDE 5-PRECISION NUMBER IN T1A03470 390 | *BUF5 BY 10 T1A03480 391 | * T1A03490 017F 0000 392 | DIV DC 0 ENTRY T1A03500 0180 10A0 393 | SLT 32 CLEAR ACC AND EXT T1A03510 0181 62FB 394 | LDX 2 -5 SET COUNTER T1A03520 0182 C600 0140R 395 | DIVL LD L2 BUF5+5 GET NEXT WORD T1A03530 0184 18D0 396 | RTE 16 SUBTRACT 5 FROM EXTENSION T1A03540 0185 90A7 397 | S FLCN+17 =5 T1A03550 0186 2002 398 | LDS 2 TURNS ON CARRY T1A03560 0187 4828 399 | BSC +Z BR IF GT 5 T1A03570 0188 90A8 400 | S FLCN+21 IF LT 5,RESTORE 5 T1A03580 0189 2801 401 | STS DIVC AND TURN OFF CARRY T1A03590 018A A8A1 402 | D FLCN+16 =10.PERFORM DIVISION BY 10 T1A03600 018B 2000 403 | DIVC LDS *-* GET STATUS T1A03610 018C 4802 404 | BSC C IF LT 5,BR TO ST QUOTIENT T1A03620 018D 8092 405 | A FLCN+4 IF GT 5,ADD /8000 T1A03630 018E D600 0140R 406 | STO L2 BUF5+5 STORE QUOTIENT T1A03640 0190 7201 407 | MDX 2 +1 DECR CTR FOR RET T1A03650 0191 70F0 408 | MDX DIVL REPEAT LOOP T1A03660 0192 4C80 017FR 409 | BSC I DIV RETURN T1A03670 410 | * T1A03680 411 | *SUBROUTINE TO MPY 5-PRECISION NUMBER IN BUF5 T1A03690 412 | *BY 10. CONTENTS OF MCAR+1 ARE ADDED TO RESULT. T1A03700 413 | * T1A03710 0194 0000 414 | MPY DC 0 ENTRY T1A03720 0195 6205 415 | LDX 2 +5 SET COUNTER T1A03730 0196 C600 013AR 416 | MPYL LD L2 BUF5-1 GET A WORD OF BUF5 T1A03740 0198 A093 417 | M FLCN+16 =10. MPY BY 10 T1A03750 0199 4828 418 | BSC +Z BR IF PTV T1A03760 019A 8091 419 | A FLCN+16 IF NEG, ADD 10 T1A03770 019B 889C 420 | AD MCAR ADD PREVIOUS EXCESS T1A03780 019C D09C 421 | STO MCAR+1 STORE PRESENT EXCESS T1A03790 019D 1090 422 | SLT 16 FETCH EXT--PRODUCT T1A03800 019E D600 013AR 423 | STO L2 BUF5-1 PUT PRODUCT BACK IN BUF5 T1A03810 01A0 72FF 424 | MDX 2 -1 DECR CTR FOR RET T1A03820 01A1 70F4 425 | MDX MPYL REPEAT LOOP T1A03830 01A2 C096 426 | LD MCAR+1 STORE LAST EXCESS IN ACC T1A03840 01A3 4C80 0194R 427 | BSC I MPY RETURN T1A03850 428 | * T1A03860 429 | *DECIMAL DATA ERROR ROUTINE T1A03870 430 | * T1A03880 01A5 2003 431 | FLERR LDS 3 TURN ON OVFLO IF ERROR T1A03890 01A6 10A0 432 | FLZER SLT 32 CLEAR ACC AND EXT T1A03900 01A7 D08C 433 | STO FLBCH ZERO CHARACTERISTIC AND T1A03910 01A8 D88D 434 | STD FLBMN MANTISSA T1A03920 01A9 C0FF 435 | LD *-1 SET FLNIS TO NON-ZERO T1A03930 01AA D08F 436 | STO FLNIS T1A03940 01AB 70CF 437 | MDX FLXXX GO TO EXIT T1A03950 438 | * T1A03960 439 | *THIS ROUTINE DOES A SHIFT RIGHT ONE BIT(THROUGH T1A03970 440 | *WORD BOUNDARIES)OF BUF5 THROUGH BUF5+4. T1A03980 441 | * T1A03990 01AC 0000 442 | SRT DC 0 ENTRY T1A04000 01AD 62FB 443 | LDX 2 -5 SET COUNTER T1A04010 01AE 10A0 444 | SLT 32 CLEAR ACC AND EXT T1A04020 01AF C600 0140R 445 | SRTL LD L2 BUF5+5 GET A WORD T1A04030 01B1 18C1 446 | RTE 1 SHIFT LAST BIT OF ACC TO T1A04040 01B2 D600 0140R 447 | STO L2 BUF5+5 FIRST OF EXT AND VICE VERSA T1A04050 01B4 18CF 448 | RTE 15 POSITION EXTENSION BIT T1A04060 01B5 7201 449 | MDX 2 +1 DECR CTR FOR RET T1A04070 01B6 70F8 450 | MDX SRTL REPEAT LOOP T1A04080 01B7 4C80 01ACR 451 | BSC I SRT RETURN T1A04090 452 | * T1A04100 453 | *THIS ROUTINE DOES A SHIFT LEFT ONE BIT(THROUGH T1A04110 454 | *WORD BOUNDARIES)OF BUF5 THROUGH BUF5+4. T1A04120 455 | * T1A04130 01B9 0000 456 | SLT DC 0 ENTRY T1A04140 01BA 6205 457 | LDX 2 +5 SET COUNTER T1A04150 01BB 10A0 458 | SLT 32 CLEAR ACC AND EXT T1A04160 01BC C600 013AR 459 | SLTL LD L2 BUF5-1 GET A WORD T1A04170 01BE 18DF 460 | RTE 31 EFFECTIVE ROTATE LEFT ONE T1A04180 01BF D600 013AR 461 | STO L2 BUF5-1 REPLACE SHIFTED WORD T1A04190 01C1 108F 462 | SLT 15 POSITION EXTENSION T1A04200 01C2 72FF 463 | MDX 2 -1 DECR CTR FOR RET T1A04210 01C3 70F8 464 | MDX SLTL REPEAT LOOP T1A04220 01C4 4C80 01B9R 465 | BSC I SLT RETURN T1A04230 01C6 466 | END T1A04240 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced BLANK 0064R 104 185 BUF5 013BR 323 66 71 76 98 120 140 141 147 162 174 176 221 222 340 345 351 375 395 406 416 423 445 447 459 461 D 0009 24 167 169 DIV 017FR 392 123 369 409 DIVC 018BR 403 401 DIVL 0182R 395 408 F 0136R 386 36 47 49 385 FBCN 0065R 108 45 61 121 156 160 163 165 177 187 189 195 199 200 203 FBNM 0055R 91 85 FBNX 0079R 135 72 84 FBNX1 008ER 155 146 FBNX2 00A0R 173 180 FBTD 0025R 54 57 58 207 FBTN 0049R 83 122 FBTN1 006DR 120 99 126 FBTN2 005AR 98 77 89 103 FBX1 00C3R 205 55 FBX2 00C5R 206 56 FD00 0018R 44 41 FD01 0019R 45 38 FD02 001AR 46 43 FDTB 0000R 25 29 32 53 FDX1 001FR 51 26 FDX2 0021R 52 27 FDX3 000DR 34 28 FEL2 0145R 330 139 FGENT 00BBR 197 193 FL1 00DER 236 229 231 FL2 010CR 279 272 274 290 FL3 0113R 285 266 289 FL4 0117R 288 269 278 307 314 FLBCH 0134R 319 49 62 83 87 92 376 381 433 FLBMN 0136R 320 36 47 380 386 434 FLCN 011CR 295 145 225 228 230 232 234 240 251 253 255 259 265 268 271 273 275 277 282 286 362 367 378 383 397 400 402 405 417 419 FLE10 0132R 317 69 101 124 148 192 194 197 221 306 335 337 360 363 368 FLEBF 011BR 294 284 288 307 314 FLERR 01A5R 431 246 260 382 384 FLESC 00FBR 265 252 FLFEX 016FR 375 366 FLFIN 0146R 335 261 FLFNL 0154R 345 350 365 370 FLFNX 015BR 351 356 FLLP 00E0R 238 247 258 FLLP2 00E5R 242 226 256 FLNIS 013AR 322 257 267 436 FLONE 0140R 324 FLOOP 007AR 136 143 FLOTD 00C9R 219 33 387 FLSGN 0133R 318 235 379 FLSSC 00EDR 251 241 283 FLXXX 017BR 385 437 FLZER 01A6R 432 344 FPLC 00A8R 178 59 155 168 184 GETZ 014DR 340 343 MCAR 0138R 321 64 244 420 421 426 MPY 0194R 414 100 175 245 364 427 MPYL 0196R 416 425 ONE 0078R 133 138 SLT 01B9R 456 86 353 465 SLTL 01BCR 459 464 SRT 01ACR 442 91 347 451 SRTL 01AFR 445 450