ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:07 2020
Source File: \r2fatn.asm
1 | *************************************************** R2B00010
2 | * * R2B00020
3 | * VERSION 2 MODIFICATION LEVEL 10 * R2B00025
4 | * SUBROUTINE NAME- * R2B00030
5 | * FULL NAME- STANDARD PRECISION FLOATING- * R2B00040
6 | * POINT ARCTANGENT FUNCTION. * R2B00050
7 | * CODE NAME- FATN/FATAN * R2B00060
8 | * PURPOSE- THIS SUBPROGRAM COMPUTES THE ARCTAN- * R2B00070
9 | * GENT OF A STANDARD PRECISION FLOATING-POINT* R2B00080
10 | * NUMBER. * R2B00090
11 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* R2B00100
12 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * R2B00110
13 | * SUBROUTINE LIBRARY MANUAL. * R2B00120
14 | * SPECIAL FEATURES- N/A * R2B00130
15 | * ADDITIONAL INFORMATION- * R2B00140
16 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * R2B00150
17 | * SUBROUTINE LIBRARY MANUAL * R2B00160
18 | * OTHER- A PERIOD FOLLOWED BY B, APPEARING TO* R2B00170
19 | * THE RIGHT OF COMMENT, INDICATES THAT THE* R2B00180
20 | * NUMBER FOLLOWING IS THE BINARY POINT OF * R2B00190
21 | * THE NUMBER PRESENTLY IN THE ACCUMULATOR.* R2B00200
22 | * LET C REFER TO THE TRUE EXPONENT OF THE * R2B00210
23 | * INPUT ARGUMENT. * R2B00220
24 | * * R2B00230
25 | *************************************************** R2B00240
CALL FATN -V1.
27 | SPR R2B00260
28 | ENT FATN R2B00270
29 | ENT FATAN STANDARD FORTRAN NAME R2B00280
0000 0000 30 | FATAN DC 0 FORTRAN ENTRY R2B00290
0001 061C*58D7 31 | LIBF FGETP GET PARAMETER R2B00300
0002 0000 32 | FATN DC 0 USER ENTRY R2B00310
0003 C37E 33 | LD 3 126 R2B00320
0004 D05A 34 | STO SIGN SAVE SIGN OF ARGUMENT R2B00330
0005 10A0 35 | SLT 32 CLEAR ACC AND EXT R2B00340
0006 9B7E 36 | SD 3 126 NEGATE ARGUMENT R2B00350
0007 4828 37 | BSC +Z AND CHK IF PTV R2B00360
0008 CB7E 38 | LDD 3 126 IF NOT LD ARGUMENT R2B00370
0009 D85A 39 | STD XABS STORE ABSOLUTE VALUE R2B00380
000A DB7E 40 | STD 3 126 R2B00390
000B 18D0 41 | RTE 16 SIGNIFICANT PART TO EXT R2B00400
000C C37D 42 | LD 3 125 SAVE EXPONENT IN T2 R2B00410
000D D04D 43 | STO T2 R2B00420
000E 6935 44 | STX 1 SAVE+1 SAVE XR1 R2B00430
45 | * R2B00440
46 | *FIND THE RANGE OF THE ARGUMENT R2B00450
47 | * R2B00460
000F 6112 48 | LDX 1 18 SET TABLE REFERENCE INDR R2B00470
0010 9D00 006AR 49 | ETN1 SD L1 KTAB-6 IS IT IN THIS RANGE R2B00480
0012 4C10 004AR 50 | BSC L KEQX1,- IF LARGER,BR TO GET INPUT R2B00490
51 | * POLYNOMIAL. K IN XR1 R2B00500
0014 8D00 006AR 52 | AD L1 KTAB-6 OTHERWISE RESTORE VALUE R2B00510
0016 71FA 53 | MDX 1 -6 AND TRY NEXT RANGE R2B00520
0017 70F8 54 | MDX ETN1 R2B00530
55 | * R2B00540
56 | *IS EXPONENT INSIDE RANGE OF POLYNOMIAL R2B00550
57 | * R2B00560
0018 C043 58 | POLY LD PC1 GET EXPONENT SHIFT CONSTANT R2B00570
0019 937D 59 | S 3 125 LET C=THE EXPONENT OF THE R2B00580
60 | * ARGUMENT. ACC = 2+/1880. R2B00590
001A D008 61 | STO SRTN KEEP EXPONENT SHIFT R2B00600
001B 9041 62 | S PC2 =15+/1880 -C-17 R2B00610
001C 4C08 001FR 63 | BSC L *+1,+ BR IF IN RANGE R2B00620
001E 701B 64 | MDX POLY1 AS POLYNOMIAL OUTPUT R2B00640
001F CB7E 65 | LDD 3 126 IN RANGE,GET ARGUMENT.B0+C R2B00650
0020 D843 66 | STD XABS SAVE ARGUMENT .B0+C R2B00660
0021 4828 67 | BSC +Z BR IF NON-NEG R2B00670
0022 983D 68 | SD XONE OTHERWISE,SUB ONE R2B00680
0023 1880 69 | SRTN SRT *-* ALLOW FOR EXPONENT SHIFT R2B00690
0024 4828 70 | BSC +Z BR IF NON-NEG .B-2 R2B00700
0025 883A 71 | AD XONE OTHERWISE,RESTORE ONE R2B00710
0026 DB7E 72 | STD 3 126 PUT BACK IN FAC .B-2 R2B00720
73 | * R2B00730
74 | *CALCULATE THE POLYNOMIAL APPROXIMATION R2B00740
75 | * R2B00750
0027 2750*4880 76 | LIBF XMDS GET Z**2 .B-4 R2B00760
0028 DB7E 77 | STD 3 126 AND SAVE IN FAC .B-4 R2B00770
0029 C844 78 | LDD A3 MPY BY A3 .B13 R2B00780
002A 2750*4880 79 | LIBF XMDS B9 R2B00790
002B 8840 80 | AD A2 ADD A2 .B9 R2B00800
002C 2750*4880 81 | LIBF XMDS MPY BY Z**2 .B5 R2B00810
002D 883C 82 | AD A1 ADD A1 .B5 R2B00820
002E 2750*4880 83 | LIBF XMDS MPY BY Z**2 .B1 R2B00830
002F 8038 84 | A A0 ADD LAST TERM .B1 R2B00840
0030 18D0 85 | RTE 16 R2B00850
0031 1808 86 | SRA 8 STRIP OFF OLD EXPONENT R2B00860
0032 1008 87 | SLA 8 R2B00870
0033 E82A 88 | OR X1 PUT IN EXPONENT OF ONE R2B00880
0034 18D0 89 | RTE 16 RESTORE ORDER R2B00890
0035 D830 90 | STD ARG AND SAVE RESULT IN ARG R2B00900
0036 C82D 91 | LDD XABS GET ABS VALUE OF Z R2B00910
0037 DB7E 92 | STD 3 126 R2B00920
0038 0651*7A00 93 | LIBF FMPY MPY POLYNOMIAL BY Z R2B00930
0039 0066R 94 | DC ARG R2B00940
003A 1559*9500 95 | POLY1 LIBF NORM TO NORMALIZING SUBR R2B00950
003B 7100 96 | MDX 1 0 GO GET ABS VALUE IF XR1=0 R2B00960
003C 700A 97 | MDX AK OTHERWISE,GO GET OFFSET R2B00970
003D C021 98 | SGN LD SIGN GET SIGN OF ARGUMENT R2B00980
003E 4C10 0043R 99 | BSC L SAVE,- BR TO EXIT IF PTV R2B00990
0040 10A0 100 | SLT 32 CLEAR ACC AND EXT R2B01000
0041 9B7E 101 | SD 3 126 NEGATE ARCTANGENT R2B01010
0042 DB7E 102 | STD 3 126 STORE ABSOLUTE VALUE RSLT R2B01020
0043 6500 0000 103 | SAVE LDX L1 *-* RESTORE XR1 R2B01030
0045 4C80 0002R 104 | BSC I FATN RETURN TO MAIN PROGRAM R2B01040
0047 0604*4127 105 | AK LIBF FADDX ADD PROPER OFFSET R2B01050
0048 006CR 106 | DC KTAB-4 ACCORDING TO VALUE IN XR1 R2B01060
0049 70F3 107 | MDX SGN GO BACK TO SET SIGN R2B01070
108 | * R2B01080
109 | *CALCULATE INPUT TO POLYNOMIAL R2B01090
110 | * R2B01100
004A C819 111 | KEQX1 LDD XABS PUT ABS VALUE OF ARGUMENT R2B01110
004B DB7E 112 | STD 3 126 IN FAC R2B01120
004C 0651*7A27 113 | LIBF FMPYX MPY ABS VALUE TIME KTAB-2 R2B01130
004D 006ER 114 | DC KTAB-2 R2B01140
004E 0604*4100 115 | LIBF FADD ADD ONE AND SAVE IN T1 R2B01150
004F 0062R 116 | DC ONE R2B01160
0050 068A*3580 117 | LIBF FSTO R2B01170
0051 0066R 118 | DC T1 R2B01180
0052 C008 119 | LD T2 GET Z EXPONENT AND Z AND R2B01190
0053 D37D 120 | STO 3 125 PUT IN FAC R2B01200
0054 C80F 121 | LDD XABS GET ABS VALUE OF MANTISSA R2B01210
0055 DB7E 122 | STD 3 126 R2B01220
0056 068A*40A7 123 | LIBF FSUBX SUB OFFSET FACTOR R2B01230
0057 006ER 124 | DC KTAB-2 R2B01240
0058 0610*9940 125 | LIBF FDIV AND DIVIDE BY PREVIOUS NO. R2B01250
0059 0066R 126 | DC T1 R2B01260
005A 70BD 127 | MDX POLY R2B01270
128 | * R2B01280
129 | *CONSTANTS AREA R2B01290
130 | * R2B01300
005B 0000 131 | T2 DC 0 ST EXPONENT R2B01310
005C 18FE 132 | PC1 DC 128-2+/1880 SHIFT CONSTANTS FOR R2B01320
005D 188F 133 | PC2 DC 15+/1880 EXPONENT ALLOWANCE R2B01330
005E 0081 134 | X1 DC /81 EXPONENT OF ONE R2B01340
005F 0000 135 | SIGN DC 0 SAVE SIGN R2B01350
0060 0000 0001 136 | XONE DEC 1 DOUBLE WORD ONE R2B01360
0062 4000 0081 137 | ONE DEC 1.0 FLT PT ONE R2B01370
0064 0000 0000 138 | XABS DEC 0 SAVE ABS VALUE R2B01380
0066 0000 0000 139 | ARG DEC 0 SAVE ARGUMENT R2B01390
0068 4000 0000 140 | A0 DEC 1.0B1 CONSTANTS R2B01400
006A FEAA ABA8 141 | A1 DEC -0.333329573B5 FOR R2B01410
006C 000C C6EB 142 | A2 DEC +0.199641035B9 POLYNOMIAL R2B01420
006E FFFF 790F 143 | A3 DEC -0.131779888B13 R2B01430
0070 144 | BSS E 0 R2B01440
0070 007E 74DC 5424 145 | KTAB XFLC 2.282434743901500E-01 L1=TAN(PI/14) R2B01450
0072 146 | ORG *-1 R2B01460
0072 72E4 7C7F 147 | DEC 4.487989506128276E-01 A1=PI/7 R2B01470
0074 7B48 797F 148 | DEC 4.815746188075286E-01 B1=TAN(PI/7) R2B01480
0076 0080 6613 9BA6 149 | XFLC 7.974733888824038E-01 L2=TAN(3PI/14) R2B01490
0078 150 | ORG *-1 R2B01500
0078 72E4 7C80 151 | DEC 8.975979011256552E-01 A2=2PI/7 R2B01510
007A 5040 E281 152 | DEC 1.253960337662704E0 B2=TAN(2PI/7) R2B01520
007C 0082 4272 DD00 153 | XFLC 2.076521396572337E0 L3=TAN(5PI/14) R2B01530
007E 154 | ORG *-1 R2B01540
007E 562B 5D81 155 | DEC 1.346396851538483E0 A3=3PI/7 R2B01550
0080 4619 BF83 156 | DEC 4.381286267534823E0 B3=TAN(3PI/7) R2B01560
0066R 157 | T1 EQU ARG R2B01570
0082 158 | END R2B01580
There were no errors in this assembly
=== CROSS REFERENCES ==========================================================
Name Val Defd Referenced
A0 0068R 140 84
A1 006AR 141 82
A2 006CR 142 80
A3 006ER 143 78
AK 0047R 105 97
ARG 0066R 139 90 94 157
ETN1 0010R 49 54
FATAN 0000R 30
FATN 0002R 32 104
KEQX1 004AR 111 50
KTAB 0070R 145 49 52 106 114 124
ONE 0062R 137 116
PC1 005CR 132 58
PC2 005DR 133 62
POLY 0018R 58 127
POLY1 003AR 95 64
SAVE 0043R 103 44 99
SGN 003DR 98 107
SIGN 005FR 135 34 98
SRTN 0023R 69 61
T1 0066R 157 118 126
T2 005BR 131 43 119
X1 005ER 134 88
XABS 0064R 138 39 66 91 111 121
XONE 0060R 136 68 71