ibm:ibm1130-lib:dmsr2v12:r2fatn_lst
R2FATN
| Table Of Contents |
|---|
|
- r2fatn.lst
ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:07 2020 Source File: \r2fatn.asm 1 | *************************************************** R2B00010 2 | * * R2B00020 3 | * VERSION 2 MODIFICATION LEVEL 10 * R2B00025 4 | * SUBROUTINE NAME- * R2B00030 5 | * FULL NAME- STANDARD PRECISION FLOATING- * R2B00040 6 | * POINT ARCTANGENT FUNCTION. * R2B00050 7 | * CODE NAME- FATN/FATAN * R2B00060 8 | * PURPOSE- THIS SUBPROGRAM COMPUTES THE ARCTAN- * R2B00070 9 | * GENT OF A STANDARD PRECISION FLOATING-POINT* R2B00080 10 | * NUMBER. * R2B00090 11 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* R2B00100 12 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * R2B00110 13 | * SUBROUTINE LIBRARY MANUAL. * R2B00120 14 | * SPECIAL FEATURES- N/A * R2B00130 15 | * ADDITIONAL INFORMATION- * R2B00140 16 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * R2B00150 17 | * SUBROUTINE LIBRARY MANUAL * R2B00160 18 | * OTHER- A PERIOD FOLLOWED BY B, APPEARING TO* R2B00170 19 | * THE RIGHT OF COMMENT, INDICATES THAT THE* R2B00180 20 | * NUMBER FOLLOWING IS THE BINARY POINT OF * R2B00190 21 | * THE NUMBER PRESENTLY IN THE ACCUMULATOR.* R2B00200 22 | * LET C REFER TO THE TRUE EXPONENT OF THE * R2B00210 23 | * INPUT ARGUMENT. * R2B00220 24 | * * R2B00230 25 | *************************************************** R2B00240 CALL FATN -V1. 27 | SPR R2B00260 28 | ENT FATN R2B00270 29 | ENT FATAN STANDARD FORTRAN NAME R2B00280 0000 0000 30 | FATAN DC 0 FORTRAN ENTRY R2B00290 0001 061C*58D7 31 | LIBF FGETP GET PARAMETER R2B00300 0002 0000 32 | FATN DC 0 USER ENTRY R2B00310 0003 C37E 33 | LD 3 126 R2B00320 0004 D05A 34 | STO SIGN SAVE SIGN OF ARGUMENT R2B00330 0005 10A0 35 | SLT 32 CLEAR ACC AND EXT R2B00340 0006 9B7E 36 | SD 3 126 NEGATE ARGUMENT R2B00350 0007 4828 37 | BSC +Z AND CHK IF PTV R2B00360 0008 CB7E 38 | LDD 3 126 IF NOT LD ARGUMENT R2B00370 0009 D85A 39 | STD XABS STORE ABSOLUTE VALUE R2B00380 000A DB7E 40 | STD 3 126 R2B00390 000B 18D0 41 | RTE 16 SIGNIFICANT PART TO EXT R2B00400 000C C37D 42 | LD 3 125 SAVE EXPONENT IN T2 R2B00410 000D D04D 43 | STO T2 R2B00420 000E 6935 44 | STX 1 SAVE+1 SAVE XR1 R2B00430 45 | * R2B00440 46 | *FIND THE RANGE OF THE ARGUMENT R2B00450 47 | * R2B00460 000F 6112 48 | LDX 1 18 SET TABLE REFERENCE INDR R2B00470 0010 9D00 006AR 49 | ETN1 SD L1 KTAB-6 IS IT IN THIS RANGE R2B00480 0012 4C10 004AR 50 | BSC L KEQX1,- IF LARGER,BR TO GET INPUT R2B00490 51 | * POLYNOMIAL. K IN XR1 R2B00500 0014 8D00 006AR 52 | AD L1 KTAB-6 OTHERWISE RESTORE VALUE R2B00510 0016 71FA 53 | MDX 1 -6 AND TRY NEXT RANGE R2B00520 0017 70F8 54 | MDX ETN1 R2B00530 55 | * R2B00540 56 | *IS EXPONENT INSIDE RANGE OF POLYNOMIAL R2B00550 57 | * R2B00560 0018 C043 58 | POLY LD PC1 GET EXPONENT SHIFT CONSTANT R2B00570 0019 937D 59 | S 3 125 LET C=THE EXPONENT OF THE R2B00580 60 | * ARGUMENT. ACC = 2+/1880. R2B00590 001A D008 61 | STO SRTN KEEP EXPONENT SHIFT R2B00600 001B 9041 62 | S PC2 =15+/1880 -C-17 R2B00610 001C 4C08 001FR 63 | BSC L *+1,+ BR IF IN RANGE R2B00620 001E 701B 64 | MDX POLY1 AS POLYNOMIAL OUTPUT R2B00640 001F CB7E 65 | LDD 3 126 IN RANGE,GET ARGUMENT.B0+C R2B00650 0020 D843 66 | STD XABS SAVE ARGUMENT .B0+C R2B00660 0021 4828 67 | BSC +Z BR IF NON-NEG R2B00670 0022 983D 68 | SD XONE OTHERWISE,SUB ONE R2B00680 0023 1880 69 | SRTN SRT *-* ALLOW FOR EXPONENT SHIFT R2B00690 0024 4828 70 | BSC +Z BR IF NON-NEG .B-2 R2B00700 0025 883A 71 | AD XONE OTHERWISE,RESTORE ONE R2B00710 0026 DB7E 72 | STD 3 126 PUT BACK IN FAC .B-2 R2B00720 73 | * R2B00730 74 | *CALCULATE THE POLYNOMIAL APPROXIMATION R2B00740 75 | * R2B00750 0027 2750*4880 76 | LIBF XMDS GET Z**2 .B-4 R2B00760 0028 DB7E 77 | STD 3 126 AND SAVE IN FAC .B-4 R2B00770 0029 C844 78 | LDD A3 MPY BY A3 .B13 R2B00780 002A 2750*4880 79 | LIBF XMDS B9 R2B00790 002B 8840 80 | AD A2 ADD A2 .B9 R2B00800 002C 2750*4880 81 | LIBF XMDS MPY BY Z**2 .B5 R2B00810 002D 883C 82 | AD A1 ADD A1 .B5 R2B00820 002E 2750*4880 83 | LIBF XMDS MPY BY Z**2 .B1 R2B00830 002F 8038 84 | A A0 ADD LAST TERM .B1 R2B00840 0030 18D0 85 | RTE 16 R2B00850 0031 1808 86 | SRA 8 STRIP OFF OLD EXPONENT R2B00860 0032 1008 87 | SLA 8 R2B00870 0033 E82A 88 | OR X1 PUT IN EXPONENT OF ONE R2B00880 0034 18D0 89 | RTE 16 RESTORE ORDER R2B00890 0035 D830 90 | STD ARG AND SAVE RESULT IN ARG R2B00900 0036 C82D 91 | LDD XABS GET ABS VALUE OF Z R2B00910 0037 DB7E 92 | STD 3 126 R2B00920 0038 0651*7A00 93 | LIBF FMPY MPY POLYNOMIAL BY Z R2B00930 0039 0066R 94 | DC ARG R2B00940 003A 1559*9500 95 | POLY1 LIBF NORM TO NORMALIZING SUBR R2B00950 003B 7100 96 | MDX 1 0 GO GET ABS VALUE IF XR1=0 R2B00960 003C 700A 97 | MDX AK OTHERWISE,GO GET OFFSET R2B00970 003D C021 98 | SGN LD SIGN GET SIGN OF ARGUMENT R2B00980 003E 4C10 0043R 99 | BSC L SAVE,- BR TO EXIT IF PTV R2B00990 0040 10A0 100 | SLT 32 CLEAR ACC AND EXT R2B01000 0041 9B7E 101 | SD 3 126 NEGATE ARCTANGENT R2B01010 0042 DB7E 102 | STD 3 126 STORE ABSOLUTE VALUE RSLT R2B01020 0043 6500 0000 103 | SAVE LDX L1 *-* RESTORE XR1 R2B01030 0045 4C80 0002R 104 | BSC I FATN RETURN TO MAIN PROGRAM R2B01040 0047 0604*4127 105 | AK LIBF FADDX ADD PROPER OFFSET R2B01050 0048 006CR 106 | DC KTAB-4 ACCORDING TO VALUE IN XR1 R2B01060 0049 70F3 107 | MDX SGN GO BACK TO SET SIGN R2B01070 108 | * R2B01080 109 | *CALCULATE INPUT TO POLYNOMIAL R2B01090 110 | * R2B01100 004A C819 111 | KEQX1 LDD XABS PUT ABS VALUE OF ARGUMENT R2B01110 004B DB7E 112 | STD 3 126 IN FAC R2B01120 004C 0651*7A27 113 | LIBF FMPYX MPY ABS VALUE TIME KTAB-2 R2B01130 004D 006ER 114 | DC KTAB-2 R2B01140 004E 0604*4100 115 | LIBF FADD ADD ONE AND SAVE IN T1 R2B01150 004F 0062R 116 | DC ONE R2B01160 0050 068A*3580 117 | LIBF FSTO R2B01170 0051 0066R 118 | DC T1 R2B01180 0052 C008 119 | LD T2 GET Z EXPONENT AND Z AND R2B01190 0053 D37D 120 | STO 3 125 PUT IN FAC R2B01200 0054 C80F 121 | LDD XABS GET ABS VALUE OF MANTISSA R2B01210 0055 DB7E 122 | STD 3 126 R2B01220 0056 068A*40A7 123 | LIBF FSUBX SUB OFFSET FACTOR R2B01230 0057 006ER 124 | DC KTAB-2 R2B01240 0058 0610*9940 125 | LIBF FDIV AND DIVIDE BY PREVIOUS NO. R2B01250 0059 0066R 126 | DC T1 R2B01260 005A 70BD 127 | MDX POLY R2B01270 128 | * R2B01280 129 | *CONSTANTS AREA R2B01290 130 | * R2B01300 005B 0000 131 | T2 DC 0 ST EXPONENT R2B01310 005C 18FE 132 | PC1 DC 128-2+/1880 SHIFT CONSTANTS FOR R2B01320 005D 188F 133 | PC2 DC 15+/1880 EXPONENT ALLOWANCE R2B01330 005E 0081 134 | X1 DC /81 EXPONENT OF ONE R2B01340 005F 0000 135 | SIGN DC 0 SAVE SIGN R2B01350 0060 0000 0001 136 | XONE DEC 1 DOUBLE WORD ONE R2B01360 0062 4000 0081 137 | ONE DEC 1.0 FLT PT ONE R2B01370 0064 0000 0000 138 | XABS DEC 0 SAVE ABS VALUE R2B01380 0066 0000 0000 139 | ARG DEC 0 SAVE ARGUMENT R2B01390 0068 4000 0000 140 | A0 DEC 1.0B1 CONSTANTS R2B01400 006A FEAA ABA8 141 | A1 DEC -0.333329573B5 FOR R2B01410 006C 000C C6EB 142 | A2 DEC +0.199641035B9 POLYNOMIAL R2B01420 006E FFFF 790F 143 | A3 DEC -0.131779888B13 R2B01430 0070 144 | BSS E 0 R2B01440 0070 007E 74DC 5424 145 | KTAB XFLC 2.282434743901500E-01 L1=TAN(PI/14) R2B01450 0072 146 | ORG *-1 R2B01460 0072 72E4 7C7F 147 | DEC 4.487989506128276E-01 A1=PI/7 R2B01470 0074 7B48 797F 148 | DEC 4.815746188075286E-01 B1=TAN(PI/7) R2B01480 0076 0080 6613 9BA6 149 | XFLC 7.974733888824038E-01 L2=TAN(3PI/14) R2B01490 0078 150 | ORG *-1 R2B01500 0078 72E4 7C80 151 | DEC 8.975979011256552E-01 A2=2PI/7 R2B01510 007A 5040 E281 152 | DEC 1.253960337662704E0 B2=TAN(2PI/7) R2B01520 007C 0082 4272 DD00 153 | XFLC 2.076521396572337E0 L3=TAN(5PI/14) R2B01530 007E 154 | ORG *-1 R2B01540 007E 562B 5D81 155 | DEC 1.346396851538483E0 A3=3PI/7 R2B01550 0080 4619 BF83 156 | DEC 4.381286267534823E0 B3=TAN(3PI/7) R2B01560 0066R 157 | T1 EQU ARG R2B01570 0082 158 | END R2B01580 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced A0 0068R 140 84 A1 006AR 141 82 A2 006CR 142 80 A3 006ER 143 78 AK 0047R 105 97 ARG 0066R 139 90 94 157 ETN1 0010R 49 54 FATAN 0000R 30 FATN 0002R 32 104 KEQX1 004AR 111 50 KTAB 0070R 145 49 52 106 114 124 ONE 0062R 137 116 PC1 005CR 132 58 PC2 005DR 133 62 POLY 0018R 58 127 POLY1 003AR 95 64 SAVE 0043R 103 44 99 SGN 003DR 98 107 SIGN 005FR 135 34 98 SRTN 0023R 69 61 T1 0066R 157 118 126 T2 005BR 131 43 119 X1 005ER 134 88 XABS 0064R 138 39 66 91 111 121 XONE 0060R 136 68 71
ibm/ibm1130-lib/dmsr2v12/r2fatn_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator