ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:07 2020 Source File: \r2fsin.asm CALL FSIN 2 | *************************************************** R2G00005 3 | * * R2G00010 4 | * SUBROUTINE NAME- * R2G00020 5 | * FULL NAME- STANDARD PRECISION FLOATING * R2G00030 6 | * POINT SINE AND COSINE FUNCTION. * R2G00040 7 | * CODE NAME- FSIN/FSIN/FCOSN/FCOS * R2G00050 8 | * PURPOSE- THIS SUBPROGRAM COMPUTES EITHER THE * R2G00060 9 | * SINE OR THE COSINE OF A STANDARD PRECISION * R2G00070 10 | * FLOATING-POINT NUMBER. * R2G00080 11 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* R2G00090 12 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * R2G00100 13 | * SUBROUTINE LIBRARY MANUAL. * R2G00110 14 | * SPECIAL FEATURES- N/A * R2G00120 15 | * ADDITIONAL INFORMATION- * R2G00130 16 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * R2G00140 17 | * SUBROUTINE LIBRARY MANUAL * R2G00150 18 | * OTHER- A PERIOD FOLLOWED BY B, APPEARING TO* R2G00160 19 | * THE RIGHT OF COMMENT, INDICATES THAT THE* R2G00170 20 | * NUMBER FOLLOWING IS THE BINARY POINT OF * R2G00180 21 | * THE NUMBER PRESENTLY IN THE ACCUMULATOR.* R2G00190 22 | * LET C REFER TO THE TRUE EXPONENT OF THE * R2G00200 23 | * INPUT ARGUMENT. * R2G00210 24 | * * R2G00220 25 | *************************************************** R2G00230 CALL FSIN 27 | SPR R2G00250 28 | ENT FSIN STANDARD FORTRAN NAME R2G00260 29 | ENT FSINE R2G00270 30 | ENT FCOS STANDARD FORTRAN NAME R2G00280 31 | ENT FCOSN R2G00290 0000 0000 32 | FCOS DC 0 FORTRAN ENTRY R2G00300 0001 061C*58D7 33 | LIBF FGETP GET PARAMETER R2G00310 0002 0000 34 | FCOSN DC 0 USER ENTRY R2G00320 0003 C0FE 35 | LD FCOSN GET RETURN ADDRESS R2G00330 0004 D005 36 | STO FSINE AND PUT IN FSINE FOR RET. R2G00340 0005 0604*4100 37 | LIBF FADD SINCE COS ENTRY, ADD PI/2 R2G00350 0006 0062R 38 | DC HPI TO THE ARGUMENT. COS(X)= R2G00360 0007 7003 39 | MDX FSINE+1 SIN(X+PI/2). R2G00370 0008 0000 40 | FSIN DC 0 FORTRAN ENTRY R2G00380 0009 061C*58D7 41 | LIBF FGETP GET PARAMETER R2G00390 000A 0000 42 | FSINE DC 0 USER ENTRY R2G00400 000B C37D 43 | LD 3 125 GET EXPONENT TO CHK ARGU- R2G00410 000C 9059 44 | S Q MENT RANGE.IF X LT 2**-17, R2G00420 000D 4CA8 000AR 45 | BSC I FSINE,+Z SIN(X)=.RET X. R2G00430 000F 9057 46 | S Q+1 IF X GT 24,LOSS OF SIGNI- R2G00440 0010 4C10 006DR 47 | BSC L OVFL,- FICANCE--GO SET ERROR INDR R2G00450 48 | * R2G00460 49 | *COMPUTE Y =FRACTIONAL REMAINDER ON DIVISION BY 2PI R2G00470 50 | * R2G00480 0012 C84B 51 | LDD R2PI =1/(2PI). R2G00490 0013 2750*4880 52 | LIBF XMDS CALC Y=X*(1/2PI) R2G00500 0014 DB7E 53 | STD 3 126 SAVE Y MANTISSA .B-2+C R2G00510 0015 C37D 54 | LD 3 125 .C+128 R2G00520 0016 9051 55 | S Q+2 =129 .C-1 R2G00530 0017 4C28 0026R 56 | BSC L SIN1,+Z IF Y EXPONENT LT 1, OMIT R2G00540 0019 8051 57 | A Q+5 SHIFT. OTHERWISE, CONSTRUCT R2G00550 001A D001 58 | STO SLT A SHIFT LEFT. .C-1 R2G00560 001B CB7E 59 | LDD 3 126 GET MANTISSA AND DO SHIFT R2G00570 001C 1080 60 | SLT SLT *-* TO DISCARD INTEGER PART.B-1 R2G00580 001D DB7E 61 | STD 3 126 SAVE FRACTIONAL PART R2G00590 62 | * R2G00600 63 | *COMPUTE Z= INPUT TO APPROXIMATING POLYNOMIAL R2G00610 64 | * R2G00620 001E 1081 65 | SLT 1 IF FRACTION GT .25 AND R2G00630 001F F37E 66 | EOR 3 126 LT 0.75. NO, THEN BR R2G00640 0020 4C10 0025R 67 | BSC L *+3,- TO LEAVE MANTISSA ALONE. R2G00650 0022 C83D 68 | LDD HALF YES, THEN SET Z=.5-Y. R2G00660 0023 9B7E 69 | SD 3 126 R2G00670 0024 DB7E 70 | STD 3 126 STORE Z AS MANTISSA R2G00680 0025 1010 71 | SLA 16 SET EXPONENT TO -1 R2G00690 0026 8045 72 | SIN1 A Q+6 SCALE EXPONENT R2G00700 0027 D37D 73 | STO 3 125 STORE CORRECT EXPONENT R2G00710 0028 1559*9500 74 | LIBF NORM NORMALIZE POLYNOMIAL INPUT R2G00720 75 | * R2G00730 76 | *SHIFT Z MANTISSA ACCORDING TO EXPONENT R2G00740 77 | * R2G00750 0029 068A*3580 78 | LIBF FSTO SAVE INPUT TO POLYNOMIAL R2G00760 002A 0064R 79 | DC Z R2G00770 002B C03E 80 | LD Q+4 GET A SHIFT RT CON R2G00780 002C 937D 81 | S 3 125 SUB C TO SET SHIFT FOR R2G00790 002D D003 82 | STO SRT MANTISSA. -C-2+/1880 R2G00800 002E CB7E 83 | LDD 3 126 GET AMNTISSA .B0+C R2G00810 002F 4828 84 | BSC +Z IF NEG,SUB ONE TO CORRECT R2G00820 0030 982B 85 | SD ONE TWOS COMPLEMENT FOR SHIFT R2G00830 0031 1880 86 | SRT SRT *-* PERFORM SHIFT .B-2 R2G00840 0032 4828 87 | BSC +Z RESTORE TWOS COMPLEMENT ONE R2G00850 0033 8828 88 | AD ONE IF NEG R2G00860 89 | * R2G00870 90 | *COMPUTE POLYNOMIAL APPROXIMATION R2G00880 91 | * R2G00890 0034 DB7E 92 | STD 3 126 SAVE POLYNOMIAL INPUT=Z R2G00900 0035 2750*4880 93 | LIBF XMDS COMPUTE Z**2 R2G00910 0036 DB7E 94 | STD 3 126 AND PUT IN FAC .B-4 R2G00920 0037 C822 95 | LDD A5 GET AS AND .B19 R2G00930 0038 2750*4880 96 | LIBF XMDS MPY BY Z**2 .B15 R2G00940 0039 881E 97 | AD A4 ADD A4 .B15 R2G00950 003A 2750*4880 98 | LIBF XMDS MPY BY Z**2 .B11 R2G00960 003B 881A 99 | AD A3 ADD A3 .B11 R2G00970 003C 2750*4880 100 | LIBF XMDS MPY BY Z**2 .B7 R2G00980 003D 8816 101 | AD A2 ADD A2 .B7 R2G00990 003E 2750*4880 102 | LIBF XMDS MPY BY Z**2 .B3 R2G01000 003F 8812 103 | AD A1 ADD A1 .B3 R2G01010 0040 DB7E 104 | STD 3 126 SAVE INTERMEDIATE R2G01020 0041 C027 105 | LD Q+3 RESULT AND SET EXPONENT=3. R2G01030 0042 D37D 106 | STO 3 125 R2G01040 0043 0651*7A00 107 | LIBF FMPY MPY BY Z TO GET FINAL R2G01050 0044 0064R 108 | DC Z POLYNOMIAL OUTPUT. R2G01060 0045 C37D 109 | LD 3 125 COMPARE EXPON. WITH R2G01070 0046 9021 110 | S Q+2 129 TO CHECK FOR GR. 1 R2G01080 0047 4CA8 000AR 111 | BSC I FSINE,+Z IF NEG., EXIT R2G01090 0049 C37E 112 | LD 3 126 MOVE SIGN OF FAC R2G01100 004A 1081 113 | SLT 1 TO CARR IND. R2G01110 004B C814 114 | LDD HALF GET SIGNIFICANT BIT TO R2G01120 004C 1801 115 | SRA 1 A AND Q AND SHIFT R2G01130 004D 4802 116 | BSC C IS CARRY OFF R2G01140 004E E811 117 | OR HALF NO, GET SIGN BIT SET R2G01150 004F DB7E 118 | STD 3 126 STORE INTO FAC R2G01160 0050 4C80 000AR 119 | BSC I FSINE RET TO MAIN PROGRAM R2G01170 120 | * R2G01180 121 | *CONSTANTS AND BUFFER AREA R2G01190 122 | * R2G01200 0052 6487 ED4F 123 | A1 DEC +6.2831853B3 COEFFICIENTS R2G01210 0054 D6A8 8799 124 | A2 DEC -41.341681B7 FOR R2G01220 0056 0519 A3C3 125 | A3 DEC +81.602481B11 APPROXIMATING R2G01230 0058 FFB3 6B31 126 | A4 DEC -76.581285B15 POLYNOMIAL R2G01240 005A 0002 7C2B 127 | A5 DEC +39.760722B19 R2G01250 005C 0000 0001 128 | ONE DEC 1 FIXED PT TWO WD ONE R2G01260 005E 517C C1B7 129 | R2PI DEC 1.591549430918954E-1B-2 1/2*PI R2G01270 0060 8000 130 | HALF DC /8000 0.5B-2 R2G01280 0061 0000 131 | DC /0000 SECOND WORD OF HALF R2G01290 0062 6487 ED81 132 | HPI DEC 1.57079632679 PI/2 R2G01300 0064 0000 0000 133 | Z DEC 0.0 POLYNOMIAL INPUT STG R2G01310 0066 0070 134 | Q DC 128-16 0 CONSTANTS TO SCALE R2G01320 0067 0028 135 | DC 24+16 1 EXPONENTS AND CHK R2G01330 0068 0081 136 | DC 129 2 RANGES. R2G01340 0069 0083 137 | DC 128+3 3 R2G01350 006A 18FE 138 | DC 126+/1880 4 R2G01360 006B 1080 139 | SLT 0 5 SHIFT LEFT CONSTANT R2G01370 006C 007F 140 | DC 127 6 R2G01380 141 | * R2G01390 142 | *SET ERROR INDR AND RET ZERO IF ARGUMENT GT 2**24 R2G01400 143 | * R2G01410 006D 10A0 144 | OVFL SLT 32 CLEAR ACC AND EXT R2G01420 006E D37D 145 | STO 3 125 RETURN ZERO IN FAC R2G01430 006F DB7E 146 | STD 3 126 SIN(X)=0 R2G01440 0070 C004 147 | LD SINEB TURN ON SINE PROGRAM R2G01450 0071 EB7C 148 | OR 3 124 ERROR INDICATOR. R2G01460 0072 D37C 149 | STO 3 124 R2G01470 0073 4C80 000AR 150 | BSC I FSINE RET TO MAIN PROGRAM R2G01480 0075 0002 151 | SINEB DC /2 BIT 14--SIN ERROR BIT. R2G01490 0076 152 | END R2G01500 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced A1 0052R 123 103 A2 0054R 124 101 A3 0056R 125 99 A4 0058R 126 97 A5 005AR 127 95 FCOS 0000R 32 FCOSN 0002R 34 35 FSIN 0008R 40 FSINE 000AR 42 36 39 45 111 119 150 HALF 0060R 130 68 114 117 HPI 0062R 132 38 ONE 005CR 128 85 88 OVFL 006DR 144 47 Q 0066R 134 44 46 55 57 72 80 105 110 R2PI 005ER 129 51 SIN1 0026R 72 56 SINEB 0075R 151 147 SLT 001CR 60 58 SRT 0031R 86 82 Z 0064R 133 79 108