ibm:ibm1130-lib:dmsr2v12:s2eatn_lst
S2EATN
| Table Of Contents |
|---|
|
- s2eatn.lst
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
ibm/ibm1130-lib/dmsr2v12/s2eatn_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator