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