ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:08 2020
Source File: \s2esin.asm
1 | *************************************************** S2G00010
2 | * * S2G00020
3 | * SUBROUTINE NAME- * S2G00030
4 | * FULL NAME- EXTENDED PRECISION FLOATING- * S2G00040
5 | * POINT SINE AND COSINE FUNCTION. * S2G00050
6 | * CODE NAME- ESIN/ESINE/ECOS/ECOSN * S2G00060
7 | * PURPOSE- THIS SUBPROGRAM COMPUTES THE SINE,OR * S2G00070
8 | * COSINE AS DESIRED, OF AN EXTENDED PRECISION* S2G00080
9 | * FLOATING POINT ANGLE IN RADIANS. * S2G00090
10 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* S2G00100
11 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * S2G00110
12 | * SUBROUTINE LIBRARY MANUAL. * S2G00120
13 | * SPECIAL FEATURES- N/A * S2G00130
14 | * ADDITIONAL INFORMATION- * S2G00140
15 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * S2G00150
16 | * SUBROUTINE LIBRARY MANUAL * S2G00160
17 | * OTHER- A PERIOD FOLLOWED BY B, APPEARING TO* S2G00170
18 | * THE RIGHT OF COMMENT, INDICATES THAT THE* S2G00180
19 | * NUMBER FOLLOWING IS THE BINARY POINT OF * S2G00190
20 | * THE NUMBER PRESENTLY IN THE ACCUMULATOR.* S2G00200
21 | * LET C REFER TO THE TRUE EXPONENT OF THE * S2G00210
22 | * INPUT ARGUMENT. * S2G00220
23 | * * S2G00230
24 | *************************************************** S2G00240
CALL ESIN -V1.
26 | EPR S2G00260
27 | ENT ESINE S2G00270
28 | ENT ESIN STANDARD FORTRAN NAME S2G00280
29 | ENT ECOSN S2G00290
30 | ENT ECOS STANDARD FORTRAN NAME S2G00300
0000 0000 31 | ECOS DC 0 FORTRAN ENTRY S2G00310
0001 051C*58D7 32 | LIBF EGETP GET PARAMETER S2G00320
0002 0000 33 | ECOSN DC 0 USER ENTRY S2G00330
0003 C0FE 34 | LD ECOSN ADD PI/2 TO ANGLE AND S2G00340
0004 D005 35 | STO ESINE USE SINE SUBR SINCE S2G00350
0005 0504*4100 36 | LIBF EADD COS(X)=SIN(X+PI/2) S2G00360
0006 006ER 37 | DC HPI S2G00370
0007 7003 38 | MDX ESINE+1 S2G00380
0008 0000 39 | ESIN DC 0 FORTRAN ENTRY S2G00390
0009 051C*58D7 40 | LIBF EGETP GET PARAMETER S2G00400
000A 0000 41 | ESINE DC 0 USER ENTRY S2G00410
000B C37D 42 | LD 3 125 GET EXPONENT,SCALE TO TRUE S2G00420
000C 9067 43 | S Q VALUE AND ADD 16.IF NEG, S2G00430
000D 4CA8 000AR 44 | BSC I ESINE,+Z X LT 2**-17 SO SIN(X)=X . S2G00440
000F 9065 45 | S Q+1 IF X GET 2**24, INDICATE S2G00450
0010 4C10 007BR 46 | BSC L OVFL,- LOSS OF SIGNIFICANCE ERROR S2G00460
47 | * S2G00470
48 | *SCALE INPUT VALUE S2G00480
49 | * S2G00490
0012 C857 50 | LDD R2PI DIVIDE ANGLE BY 2PI S2G00500
0013 2750*4000 51 | LIBF XMD Y=X*(1/2PI) S2G00510
0014 DB7E 52 | STD 3 126 STORE IN FAC .B-2+C S2G00520
0015 C37D 53 | LD 3 125 GET EXPONENT .C+128 S2G00530
0016 905F 54 | S Q+2 AND MODIFY .C-1 S2G00540
0017 4C28 0026R 55 | BSC L SIN1,+Z BR IF NEG. OTHERWISE S2G00550
0019 805F 56 | A Q+5 CONSTRUCT A SHIFT LEFT S2G00560
001A D001 57 | STO SLT CON AND ST IN SLT .C-1 S2G00570
001B CB7E 58 | LDD 3 126 GET MANTISSA .B-2+C S2G00580
59 | * S2G00590
60 | *FIND RANGE OF SCALED ARGUMENT AND MODIFY S2G00600
61 | * S2G00610
001C 1080 62 | SLT SLT *-* SHIFT TO DISCARD INTEGER S2G00620
001D DB7E 63 | STD 3 126 PORTION OF Y,AND ST. .B-1 S2G00630
001E 1081 64 | SLT 1 IS FRACTION BETWEEN .25 S2G00640
001F F37E 65 | EOR 3 126 S2G00650
0020 4C10 0025R 66 | BSC L *+3,- AND .75 . NO THEN BR S2G00660
0022 C849 67 | LDD HALF YES,THEN SET Z=0.5-Y S2G00670
0023 9B7E 68 | SD 3 126 Z=0.5-Y IF Y IS BETWEEN S2G00680
0024 DB7E 69 | STD 3 126 0.25 AND 0.75. S2G00690
0025 1010 70 | SLA 16 S2G00700
71 | * S2G00710
72 | *COMPUTE EXPONENT AND DO CORRECT SHIFT ON MANTISSA S2G00720
73 | * S2G00730
0026 8053 74 | SIN1 A Q+6 SCALE EXPONENT S2G00740
0027 D37D 75 | STO 3 125 AND STORE CORRECT EXPONENT S2G00750
0028 1559*9500 76 | LIBF NORM NORMALIZE S2G00760
0029 C37D 77 | LD 3 125 STORE (FAC) IN Z S2G00770
002A D046 78 | STO Z S2G00780
002B CB7E 79 | LDD 3 126 S2G00790
002C D845 80 | STD Z+1 S2G00800
002D C04A 81 | LD Q+4 GENERATE SHIFT CONSTANT S2G00810
002E 937D 82 | S 3 125 FOR EXPONENT.-C-2+/1880 S2G00820
002F D007 83 | STO SRT S2G00830
0030 F01D 84 | EOR SRTK CHK RANGE OF SHIFT S2G00840
0031 1806 85 | SRA 6 S2G00850
0032 4C20 0083R 86 | BSC L SPEC,Z BR IF OUT OF RANGE S2G00860
0034 CB7E 87 | LDD 3 126 GET MANTISSA .B0+C S2G00870
0035 4828 88 | BSC +Z BR IF NOT NEG S2G00880
0036 9831 89 | SD ONE IF NEG,SUB ONE S2G00890
0037 1880 90 | SRT SRT *-* SHIFT FOR EXPONENT .B-2 S2G00900
0038 4828 91 | BSC +Z BR IF NOT NEG S2G00910
0039 882E 92 | AD ONE IF NEG,RESTORE ONE S2G00920
93 | * S2G00930
94 | *USE POLYNOMIAL TO COMPUTE EXTENDED PRECISION SINE S2G00940
95 | * S2G00950
003A DB7E 96 | CSR STD 3 126 STORE Z IN FAC .B-2 S2G00960
003B 2750*4000 97 | LIBF XMD Z**2 .B-4 S2G00970
003C DB7E 98 | STD 3 126 S2G00980
003D C824 99 | LDD A6 GET A6 .B4 S2G00990
003E 2750*4000 100 | LIBF XMD A6*Z**2 .B0 S2G01000
003F 8824 101 | AD S6 S2G01010
0040 1886 102 | SRT 6 SHIFT TO ADD .B6 S2G01020
0041 881E 103 | AD A5 B6 + S2G01030
0042 2750*4000 104 | LIBF XMD (Z**2)*(A5+A6*Z**2) .B2 S2G01040
0043 1885 105 | SRT 5 SHIFT TO ADD .B7 S2G01050
0044 8819 106 | AD A4 B7 - S2G01060
0045 2750*4000 107 | LIBF XMD (Z**2)*(ACC AND EXT) .B3 S2G01070
0046 881F 108 | AD S4 S2G01080
0047 1884 109 | SRT 4 SHIFT TO ADD .B7 S2G01090
0048 8813 110 | AD A3 B7 + S2G01100
0049 2750*4000 111 | LIBF XMD (Z**2)*(ACC AND EXT) .B3 S2G01110
004A 1883 112 | SRT 3 SHIFT TO ADD A2 .B6 S2G01120
004B 880E 113 | AD A2 B6 - S2G01130
004C 2750*4000 114 | LIBF XMD (Z**2)*(A AND Q REGS).B2 S2G01140
004D 881A 115 | AD ONE S2G01150
004E 1881 116 | SRTK SRT 1 SHIFT TO ADD A1 S2G01160
004F 8808 117 | AD A1 B3 + S2G01170
0050 DB7E 118 | STD 3 126 STORE RESULT IN FAC .B3 S2G01180
0051 C025 119 | LD Q+3 GET AN EXPONENT OF 3 S2G01190
0052 D37D 120 | STO 3 125 S2G01200
0053 0551*7A00 121 | LIBF EMPY PUT IN FACTOR OF Z S2G01210
0054 0071R 122 | DC Z S2G01220
0055 4C80 000AR 123 | BSC I ESINE EXIT S2G01230
124 | * S2G01240
125 | *CONSTANTS AREA S2G01250
126 | * S2G01260
0058 6487 ED51 127 | A1 DEC +6.2831853071B3 COEFFICIENTS S2G01270
005A AD51 0C6C 128 | A2 DEC -41.341702117B6 FOR THE S2G01280
005C 519A F01A 129 | A3 DEC +81.605226206B7 APPROXIMATING S2G01290
005E B34B B439 130 | A4 DEC -76.704281321B7 POLYNOMIAL. S2G01300
0060 5405 0541 131 | A5 DEC +42.009805726B6 S2G01310
0062 8CD8 CF8F 132 | A6 DEC -14.394135365B4 S2G01320
0064 0000 003F 133 | S6 DEC 63 USED TO ROUND OFF S2G01330
0066 0000 000F 134 | S4 DEC 15 BEFORE SHIFTING S2G01340
0068 0000 0001 135 | ONE DEC 1 EXTENDED PREC ONE S2G01350
006A 517C C1B7 136 | R2PI DEC 1.591549430918954E-1B-2 1/2PI S2G01360
006C 8000 137 | HALF DC /8000 0.5B-2 S2G01370
006D 0000 138 | DC /0000 S2G01380
006E 0081 6487 ED51 139 | HPI XFLC 1.57079632679 PI/2 S2G01390
0071 0000 0000 0000 140 | Z XFLC 0.0 ARGUMENT OF POLYNOMIAL S2G01400
0074 0070 141 | Q DC 128-16 0 EXPONENT AND SHIFT S2G01410
0075 0028 142 | DC 24+16 1 CONSTANTS. S2G01420
0076 0081 143 | DC 129 2 S2G01430
0077 0083 144 | DC 128+3 3 S2G01440
0078 18FE 145 | DC 126+/1880 4 S2G01450
0079 1080 146 | SLT 0 5 S2G01460
007A 007F 147 | DC 127 6 S2G01470
148 | * S2G01480
149 | *ERROR ROUTINES S2G01490
150 | * S2G01500
007B 10A0 151 | OVFL SLT 32 SINE LOSS OF SIGNIFICANCE. S2G01510
007C D37D 152 | STO 3 125 RETURN ZERO. S2G01520
007D DB7E 153 | STD 3 126 TURN ON SINE PROGRAM S2G01530
007E C009 154 | LD SINEB ERROR INDICATOR. S2G01540
007F EB7C 155 | OR 3 124 S2G01550
0080 D37C 156 | STO 3 124 S2G01560
0081 4C80 000AR 157 | BSC I ESINE EXIT S2G01570
0083 C802 158 | SPEC LDD MAXF EXPONENT TOO LARGE.RTN MAX S2G01580
0084 70B5 159 | MDX CSR PTV NO. TO POLYNOMIAL. S2G01590
0086 7FFF FFFF 160 | MAXF DEC 0.999999999999B0 S2G01600
0088 0002 161 | SINEB DC /2 BIT 14--SIN ERROR BIT. S2G01610
0089 162 | END S2G01620
There were no errors in this assembly
=== CROSS REFERENCES ==========================================================
Name Val Defd Referenced
A1 0058R 127 117
A2 005AR 128 113
A3 005CR 129 110
A4 005ER 130 106
A5 0060R 131 103
A6 0062R 132 99
CSR 003AR 96 159
ECOS 0000R 31
ECOSN 0002R 33 34
ESIN 0008R 39
ESINE 000AR 41 35 38 44 123 157
HALF 006CR 137 67
HPI 006ER 139 37
MAXF 0086R 160 158
ONE 0068R 135 89 92 115
OVFL 007BR 151 46
Q 0074R 141 43 45 54 56 74 81 119
R2PI 006AR 136 50
S4 0066R 134 108
S6 0064R 133 101
SIN1 0026R 74 55
SINEB 0088R 161 154
SLT 001CR 62 57
SPEC 0083R 158 86
SRT 0037R 90 83
SRTK 004ER 116 84
Z 0071R 140 78 80 122