ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:07 2020
Source File: \s2eatn.asm
1 | *************************************************** S2B00010
2 | * * S2B00020
3 | * VERSION 2 MODIFICATION LEVEL 10 * S2B00025
4 | * SUBROUTINE NAME- * S2B00030
5 | * FULL NAME-EXTENDED PRECISION FLOATING-POINT* S2B00040
6 | * ARCTANGENT FUNCTION. * S2B00050
7 | * CODE NAME-EATN/EATAN. * S2B00060
8 | * PURPOSE-THIS SUBPROGRAM COMPUTES THE ARCTAN- * S2B00070
9 | * GENT OF AN EXTENDED PRECISION FLOATING- * S2B00080
10 | * POINT NUMBER. INPUT IS IN RADIANS. * S2B00090
11 | * METHOD- SEE IBM 1130 SUBROUTINE LIBRARY MANUAL* S2B00100
12 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * S2B00110
13 | * SUBROUTINE LIBRARY MANUAL. * S2B00120
14 | * SPECIAL FEATURES-N/A * S2B00130
15 | * ADDITIONAL INFORMATION- * S2B00140
16 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * S2B00150
17 | * SUBROUTINE LIBRARY MANUAL * S2B00160
18 | * * S2B00170
19 | *************************************************** S2B00180
CALL EATN -V1.
21 | EPR S2B00200
22 | ENT EATN S2B00210
23 | ENT EATAN STANDARD FORTRAN NAME S2B00220
0000 0000 24 | EATAN DC 0 FORTRAN ENTRY S2B00230
0001 051C*58D7 25 | LIBF EGETP GET PARAMETER S2B00240
0002 0000 26 | EATN DC 0 USER ENTRY S2B00250
0003 C37E 27 | LD 3 126 S2B00260
0004 D06D 28 | STO SIGN SAVE SIGN OF ARGUMENT S2B00270
0005 10A0 29 | SLT 32 S2B00280
0006 9B7E 30 | SD 3 126 CHANGE SIGN OF ARGUMENT S2B00290
0007 4828 31 | BSC +Z IS IT POSITIVE S2B00300
0008 CB7E 32 | LDD 3 126 NO,GET ORIGINAL ARGUMENT S2B00310
0009 D866 33 | STD XABS S2B00320
000A DB7E 34 | STD 3 126 PUT ABSOLUTE VALUE IN FAC S2B00330
000B 18D0 35 | RTE 16 SIGNIFICANT PART IN EXT S2B00340
000C C37D 36 | LD 3 125 PUT EXPONENT IN ACC S2B00350
000D D055 37 | STO T2 STORE EXPONENT S2B00360
000E 693B 38 | STX 1 SAVE+1 SAVE INDEX REGISTER 1 S2B00370
39 | * S2B00380
40 | *FIND THE RANGE OF THE ARGUMENT S2B00390
41 | * S2B00400
000F 6118 42 | LDX 1 24 LD FOR REF TO CON TBL S2B00410
0010 9D00 0076R 43 | ETN1 SD L1 KTAB-8 IS IT IN THIS RANGE S2B00420
0012 4C10 0050R 44 | BSC L KEQX1,- IF LARGER,GO TO KEQX1 TO S2B00430
45 | * GET INPUT TO POLYNOMIAL S2B00440
0014 8D00 0076R 46 | AD L1 KTAB-8 OTHERWISE RESTORE VALUE S2B00450
0016 71F8 47 | MDX 1 -8 AND TRY NEXT RANGE S2B00460
0017 70F8 48 | MDX ETN1 S2B00470
49 | * S2B00480
50 | *IS EXPONENT INSIDE RANGE OF THE POLYNOMIAL S2B00490
51 | * S2B00500
0018 C04B 52 | POLY LD PC1 S2B00510
0019 937D 53 | S 3 125 LET C=THE EXPONENT OF THE S2B00520
54 | * ARGUMENT.ACC=-C-2+/1880 S2B00530
001A D009 55 | STO SRTN KEEP EXPONENT SHIFT S2B00540
001B 9049 56 | S PC2 =15+/1880 ACC=-C-17 S2B00550
001C 4C08 0020R 57 | BSC L *+2,+ BR IF IN RANGE 2-11 S2B00560
001E C849 58 | LDD ONE+1 OUT OF RANGE,GET ONE 2-11 S2B00570
001F 7020 59 | MDX POLY1 AS POLYNOMIAL OUTPUT S2B00580
0020 CB7E 60 | LDD 3 126 IN RANGE,GET ARGUMENT.B0+C S2B00590
0021 D84E 61 | STD XABS SAVE ARGUMENT .B0+C S2B00600
0022 4828 62 | BSC +Z BRANCH IF NON-NEG S2B00610
0023 984A 63 | SD XONE OTHERWISE SUBTRACT ONE S2B00620
0024 1880 64 | SRTN SRT *-* ALLOW FOR EXPONENT SHIFT S2B00630
0025 4828 65 | BSC +Z BRANCH IF NON-NEG .B-2 S2B00640
0026 8847 66 | AD XONE OTHERWISE RESTORE ONE S2B00650
0027 DB7E 67 | STD 3 126 PUT BACK IN FLT ACC .B-2 S2B00660
68 | * S2B00670
69 | *CALCULATE THE POLYNOMIAL APPROXIMATION S2B00680
70 | * S2B00690
0028 2750*4000 71 | LIBF XMD GET Z**2 .B-4 S2B00700
0029 DB7E 72 | STD 3 126 PUT IN FAC .B-4 S2B00710
002A C851 73 | LDD A4 MPY BY A4 S2B00720
002B 2750*4000 74 | LIBF XMD .B-7 S2B00730
002C 1885 75 | SRT 5 SHIFT TO SUB A3 .B-2 S2B00740
002D 984C 76 | SD A3 .B-2 S2B00750
002E 2750*4000 77 | LIBF XMD MPY BY Z**2 .B-6 S2B00760
002F 883A 78 | AD S4 S2B00770
0030 1884 79 | SRT 4 SHIFT TO ADD A2 .B-2 S2B00780
0031 8846 80 | AD A2 .B-2 S2B00790
0032 2750*4000 81 | LIBF XMD MPY BY Z**2 .B-6 S2B00800
0033 1885 82 | SRT 5 SHIFT TO SUB A1 .B-1 S2B00810
0034 9841 83 | SD A1 .B-1 S2B00820
0035 2750*4000 84 | LIBF XMD MPY BY Z**2 .B-5 S2B00830
0036 8835 85 | AD S6 S2B00840
0037 1886 86 | SRT 6 SHIFT TO ADD ONE .B+1 S2B00850
0038 882F 87 | AD ONE+1 ADD ONE .B+1 S2B00860
0039 D83A 88 | STD ARG SAVE POLYNOMIAL RSLT S2B00870
003A C02B 89 | LD X1 129 S2B00880
003B D037 90 | STO ARG-1 SET EXPONENT S2B00890
003C C833 91 | LDD XABS PUT ABS VALUE OF ARGUMENT S2B00900
003D DB7E 92 | STD 3 126 BACK IN FAC S2B00910
003E 0551*7A00 93 | LIBF EMPY MPY Z*(POLYNOMIAL RSLT) S2B00920
003F 0073R 94 | DC ARG-1 S2B00930
0040 1559*9500 95 | POLY1 LIBF NORM NORMALIZE S2B00940
0041 7100 96 | MDX 1 0 GO GET ABS VALUE IF XR1=0 S2B00950
0042 700A 97 | MDX AK OTHERWISE,ADD OFFSET NO. S2B00960
0043 C02E 98 | SGN LD SIGN GET SIGN OF ARGUMENT S2B00970
0044 4C10 0049R 99 | BSC L SAVE,- BR TO EXIT IF PTV S2B00980
0046 10A0 100 | SLT 32 CLEAR ACC AND EXT S2B00990
0047 9B7E 101 | SD 3 126 NEGATE ARCTANGENT S2B01000
0048 DB7E 102 | STD 3 126 S2B01010
0049 6500 0000 103 | SAVE LDX L1 *-* S2B01020
004B 4C80 0002R 104 | BSC I EATN RET TO MAIN PROG S2B01030
004D 0504*4127 105 | AK LIBF EADDX IF K NOT ZERO,ADD APPRO- S2B01040
004E 0078R 106 | DC KTAB-6 PRIATE OFFSET TO RSLT S2B01050
004F 70F3 107 | MDX SGN RET TO SET SIGN S2B01060
108 | * S2B01070
109 | *CALCULATE INPUT TO POLYNOMIAL S2B01080
110 | * S2B01090
0050 C81F 111 | KEQX1 LDD XABS PUT ABS VALUE OF ARGUMENT S2B01100
0051 DB7E 112 | STD 3 126 IN FAC S2B01110
0052 0551*7A27 113 | LIBF EMPYX S2B01120
0053 007BR 114 | DC KTAB-3 MPY ABS VALUE TIMES KTAB-3 S2B01130
0054 0504*4100 115 | LIBF EADD S2B01140
0055 0067R 116 | DC ONE ADD EXTENDED PRECISION 1 S2B01150
0056 C37D 117 | LD 3 125 GET EXPONENT S2B01160
0057 D01B 118 | STO T1-1 AND STORE IN ARG-1 S2B01170
0058 CB7E 119 | LDD 3 126 GET ARGUMENT AND S2B01180
0059 D81A 120 | STD T1 STORE IN ARG S2B01190
005A C008 121 | LD T2 GET ORIGINAL EXPONENT S2B01200
005B D37D 122 | STO 3 125 AND PUT IN FAC S2B01210
005C C813 123 | LDD XABS GET ABS VALUE MANTISSA S2B01220
005D DB7E 124 | STD 3 126 AND PUT IN FAC S2B01230
005E 058A*40A7 125 | LIBF ESUBX SUBTRACT KTAB-3 FROM XABS S2B01240
005F 007BR 126 | DC KTAB-3 S2B01250
0060 0510*9940 127 | LIBF EDIV DIVIDE BY ORIGINAL S2B01260
0061 0073R 128 | DC T1-1 EXPONENT S2B01270
0062 70B5 129 | MDX POLY RETURN TO POLY S2B01280
0063 0000 130 | T2 DC 0 USED TO ST EXPONENT S2B01290
0064 18FE 131 | PC1 DC 128-2+/1880 CONSTANTS TO S2B01300
0065 188F 132 | PC2 DC 15+/1880 SCALE ARGUMENT S2B01310
0066 0081 133 | X1 DC /81 EXPONENT OF ONE S2B01320
0067 0081 4000 0000 134 | ONE XFLC 1.0 EXTENDED PREC FLT PT ONE S2B01330
006A 0000 000F 135 | S4 DEC 15 CORRECTIONS FOR NEG SHIFT S2B01340
006C 0000 003F 136 | S6 DEC 63 S2B01350
006E 0000 0001 137 | XONE DEC 1 EXTENDED PREC ONE S2B01360
0070 0000 0000 138 | XABS DEC 0 STORE ABS VALUE S2B01370
0072 139 | SIGN BSS 1 KEEP SGN OF ARGUMENT S2B01380
0073 140 | BSS 1 ST EXPONENT OF ARG S2B01390
0074 0000 0000 141 | ARG DEC 0 ST RSLT S2B01400
0076 5555 544B 142 | A1 DEC 0.33333327142E0B-1 CONSTANTS S2B01410
0078 6665 29E9 143 | A2 DEC 0.19999056792E0B-2 FOR S2B01420
007A 48E2 54F1 144 | A3 DEC 0.14235177463E0B-2 POLYNOMIAL S2B01430
007C 6652 4BFC 145 | A4 DEC 0.09992331248E0B-3 S2B01440
007E 146 | BSS E 0 S2B01450
007E 007E 74DC 5424 147 | KTAB XFLC 2.282434743901500E-01 L1=TAN(PI/14) S2B01460
0080 148 | ORG *-1 S2B01470
0080 007F 72E4 7CEF 149 | XFLC 4.487989506128276E-01 A1=PI/7 S2B01480
0083 007F 7B48 7966 150 | XFLC 4.815746188075286E-01 B1=TAN(PI/7) S2B01490
0086 0080 6613 9BA6 151 | XFLC 7.974733888824038E-01 L2=TAN(3PI/14) S2B01500
0088 152 | ORG *-1 S2B01510
0088 0080 72E4 7CEF 153 | XFLC 8.975979011256552E-01 A2=2PI/7 S2B01520
008B 0081 5040 E2DC 154 | XFLC 1.253960337662704E0 B2=TAN(2PI/7) S2B01530
008E 0082 4272 DD00 155 | XFLC 2.076521396572337E0 L3=TAN(5PI/14) S2B01540
0090 156 | ORG *-1 S2B01550
0090 0081 562B 5DB3 157 | XFLC 1.346396851538483E0 A3=3PI/7 S2B01560
0093 0083 4619 BFA1 158 | XFLC 4.381286267534823E0 B3=TAN(3PI/7) S2B01570
0074R 159 | T1 EQU ARG S2B01580
0096 160 | END S2B01590
There were no errors in this assembly
=== CROSS REFERENCES ==========================================================
Name Val Defd Referenced
A1 0076R 142 83
A2 0078R 143 80
A3 007AR 144 76
A4 007CR 145 73
AK 004DR 105 97
ARG 0074R 141 88 90 94 159
EATAN 0000R 24
EATN 0002R 26 104
ETN1 0010R 43 48
KEQX1 0050R 111 44
KTAB 007ER 147 43 46 106 114 126
ONE 0067R 134 58 87 116
PC1 0064R 131 52
PC2 0065R 132 56
POLY 0018R 52 129
POLY1 0040R 95 59
S4 006AR 135 78
S6 006CR 136 85
SAVE 0049R 103 38 99
SGN 0043R 98 107
SIGN 0072R 139 28 98
SRTN 0024R 64 55
T1 0074R 159 118 120 128
T2 0063R 130 37 121
X1 0066R 133 89
XABS 0070R 138 33 61 91 111 123
XONE 006ER 137 63 66