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