ibm:ibm1130-lib:dmsr2v12:r2fln_lst
R2FLN
| Table Of Contents |
|---|
|
- r2fln.lst
ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:07 2020 Source File: \r2fln.asm 1 | *************************************************** R2E00010 2 | * * R2E00020 3 | * SUBROUTINE NAME- * R2E00030 4 | * FULL NAME- STANDARD PRECISION FLOATING- * R2E00040 5 | * POINT NATURAL LOGARITHM FUNCTION. * R2E00050 6 | * CODE NAME- FLN/FALOG * R2E00060 7 | * PURPOSE- THIS SUBPROGRAM COMPUTES THE FLOATING* R2E00070 8 | * POINT LOGARITHM OF A STANDARD PRECISION * R2E00080 9 | * FLOATING-POINT NUMBER. * R2E00090 10 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* R2E00100 11 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * R2E00110 12 | * SUBROUTINE LIBRARY MANUAL. * R2E00120 13 | * SPECIAL FEATURES- N/A * R2E00130 14 | * ADDITIONAL INFORMATION- * R2E00140 15 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * R2E00150 16 | * SUBROUTINE LIBRARY MANUAL * R2E00160 17 | * OTHER- A PERIOD FOLLOWED BY B, APPEARING TO* R2E00170 18 | * THE RIGHT OF COMMENT, INDICATES THAT THE* R2E00180 19 | * NUMBER FOLLOWING IS THE BINARY POINT OF * R2E00190 20 | * THE NUMBER PRESENTLY IN THE ACCUMULATOR.* R2E00200 21 | * LET C REFER TO THE TRUE EXPONENT OF THE * R2E00210 22 | * INPUT ARGUMENT. * R2E00220 23 | * * R2E00230 24 | *************************************************** R2E00240 CALL FLN -V1. 26 | SPR R2E00260 27 | ENT FLN R2E00270 28 | ENT FALOG STANDARD FORTRAN NAME R2E00280 0000 0000 29 | FALOG DC 0 FORTRAN ENTRY R2E00290 0001 061C*58D7 30 | LIBF FGETP GET PARAMETER R2E00300 0002 0000 31 | FLN DC 0 USER ENTRY R2E00310 0003 2855 32 | STS STAT SAVE STATUS R2E00320 0004 C37D 33 | LD 3 125 GET ARGUMENT EXPONENT R2E00330 0005 906C 34 | S K1 =128 R2E00340 0006 D06F 35 | STO K STORE SCALED EXPONENT R2E00350 0007 C06A 36 | LD K1 =128 R2E00360 0008 D37D 37 | STO 3 125 ZERO FAC EXPONENT R2E00370 0009 CB7E 38 | LDD 3 126 GET MANTISSA R2E00380 000A 4C18 005CR 39 | BSC L LNZER,+- IF ZERO,GO SET ERROR INDR R2E00390 000C 4C10 0014R 40 | BSC L *+6,- R2E00400 000E C078 41 | LD LNEBT IF ARGUMENT NEGATIVE, R2E00410 000F EB7C 42 | OR 3 124 TURN ON LN ERROR PROGRAM R2E00420 0010 D37C 43 | STO 3 124 INDICATOR. USE ABSOLUTE R2E00430 0011 10A0 44 | SLT 32 VALUE OF ARGUMENT. R2E00440 0012 9B7E 45 | SD 3 126 R2E00450 0013 DB7E 46 | STD 3 126 R2E00460 0014 D863 47 | STD FM1 STORE ABSOLUTE VALUE R2E00470 0015 905E 48 | S SQRH =SQRT(0.5) .B0 R2E00480 0016 4C10 0020R 49 | BSC L LN1,- GO COMPUTE Z IF GT SQRT(.5) R2E00490 0018 C05F 50 | LD FM1 MPY MANTISSA BY TWO OTHER- R2E00500 0019 1081 51 | SLT 1 WISE. G=2F R2E00510 001A D85D 52 | STD FM1 B1 R2E00520 001B C065 53 | LD C129 INCREMENT EXPONENT TO 129 R2E00530 001C D37D 54 | STO 3 125 TO CORRESPOND. R2E00540 001D C058 55 | LD K ALSO DECREMENT EXPONENT TO R2E00550 001E 9050 56 | S ONE+1 BE USED FOR J. R2E00560 001F D056 57 | STO K R2E00570 0020 C857 58 | LN1 LDD FM1 COMPUTE F-1 BY REVERSING R2E00580 0021 F05E 59 | EOR C8000 THE STATUS OF THE SIGN BIT R2E00590 0022 D855 60 | STD FM1 R2E00600 0023 0604*4100 61 | LIBF FADD COMPUTE F+1 R2E00610 0024 007AR 62 | DC FONE R2E00620 0025 068A*3580 63 | LIBF FSTO AND STORE IN FP1. R2E00630 0026 007CR 64 | DC FP1 R2E00640 0027 C04A 65 | LD K1 RESTORE EFFECTIVE EXPONENT R2E00650 0028 D37D 66 | STO 3 125 OF ZERO TO MANTISSA IN FAC. R2E00660 0029 C84E 67 | LDD FM1 PUT F-1 IN FAC .B0 R2E00670 002A DB7E 68 | STD 3 126 R2E00680 002B 1559*9500 69 | LIBF NORM NORMALIZE DIVIDEND AND R2E00690 002C 0610*9940 70 | LIBF FDIV COMPUTE Z=(F-1)/(F+1) R2E00700 002D 007CR 71 | DC FP1 R2E00710 002E 068A*3580 72 | LIBF FSTO SAVE POLYNOMIAL ARGUMENT R2E00720 002F 007CR 73 | DC Z R2E00730 0030 C055 74 | LD CSRT GENERATE A SHIFT CONSTANT R2E00740 0031 937D 75 | S 3 125 FROM ARGUMENT EXPONENT R2E00750 0032 D008 76 | STO SRT -C-2+/1880 R2E00760 0033 9051 77 | S CSRTR CHECK RANGE OF SHIFT R2E00770 0034 4C08 0038R 78 | BSC L *+2,+ BRANCH IF SHIFT LT 16 R2E00780 0036 C831 79 | LDD A0 OTHERWISE,DO NOT COMPUTE R2E00790 0037 7010 80 | MDX EPOL HI-ORDER TERMS. .B2 R2E00800 0038 CB7E 81 | LDD 3 126 .B0+C R2E00810 0039 4828 82 | BSC +Z SCALE BY 1 FOR SHIFT IF NEG R2E00820 003A 9833 83 | SD ONE R2E00830 003B 1880 84 | SRT SRT *-* PERFORM SHIFT .B-2 R2E00840 003C 4828 85 | BSC +Z RESTORE 1 IF NEG R2E00850 003D 8830 86 | AD ONE R2E00860 003E DB7E 87 | STD 3 126 STORE ARGUMENT IN FAC .B-2 R2E00870 003F 2750*4880 88 | LIBF XMDS COMPUTE Z**2 .B-4 R2E00880 0040 DB7E 89 | STD 3 126 PUT Z**2 INTO FAC .B-4 R2E00890 0041 188A 90 | SRT 10 0.25*Z**2 SCALED TO .B4 R2E00900 0042 8829 91 | AD A4 ADD A4 .B4 R2E00910 0043 2750*4880 92 | LIBF XMDS MPY BY Z**2 .B0 R2E00920 0044 8825 93 | AD A2 ADD A2 .B0 R2E00930 0045 2750*4880 94 | LIBF XMDS MPY BY Z**2 .B-4 R2E00940 0046 1886 95 | SRT 6 SCALE TO ADD A0 .B2 R2E00950 0047 8020 96 | A A0 R2E00960 0048 DB7E 97 | EPOL STD 3 126 ST RSLTS=LN(G) R2E00970 0049 C039 98 | LD C12P2 SET EXPONENT TO +2 R2E00980 004A D37D 99 | STO 3 125 R2E00990 004B 0651*7A00 100 | LIBF FMPY F1(Z)=Z*LN(G) R2E01000 004C 007CR 101 | DC Z R2E01010 004D 068A*3580 102 | LIBF FSTO SAVE Z*LN(G) IN Z R2E01020 004E 007CR 103 | DC Z R2E01030 004F 1090 104 | SLT 16 CLEAR EXTENSION R2E01040 0050 C025 105 | LD K ORIGINAL EXPONENT USED R2E01050 0051 DB7E 106 | STD 3 126 AS MANTISSA. CHANGE FROM R2E01060 0052 C031 107 | LD C1P15 INTEGER TO FRACTION BY R2E01070 0053 D37D 108 | STO 3 125 ADDING 15 TO EXPONENT. R2E01080 0054 1559*9500 109 | LIBF NORM NORMALIZE R2E01090 0055 0651*7A00 110 | LIBF FMPY AND MPY BY LN2. R2E01100 0056 007ER 111 | DC LN2 K*LN2 R2E01110 0057 0604*4100 112 | LIBF FADD ADD Z*LN(G) R2E01120 0058 007CR 113 | DC Z LN(X)=K*LN2+Z*LN(G) R2E01130 0059 2000 114 | STAT LDS *-* RESTORE STATUS R2E01140 005A 4C80 0002R 115 | BSC I FLN RETURN TO MAIN PROGRAM R2E01150 116 | * R2E01160 117 | *IF INPUT ARGUMENT IS ZERO,TURN ON R2E01170 118 | *AND RETURN LARGEST NEGATIVE NUMBER. R2E01180 119 | * R2E01190 005C C02A 120 | LNZER LD LNEBT GET ERROR BIT R2E01200 005D EB7C 121 | OR 3 124 AND STORE R2E01210 005E D37C 122 | STO 3 124 INDICATOR AND RETURN R2E01220 005F C004 123 | LD MXNEC GET LARGEST EXPONENT R2E01230 0060 D37D 124 | STO 3 125 R2E01240 0061 C804 125 | LDD MXNEM MAXIMUM NEG MANTISSA R2E01250 0062 DB7E 126 | STD 3 126 IN FAC R2E01260 0063 70F5 127 | MDX STAT GO TO BR OUT R2E01270 128 | * R2E01280 129 | *CONSTANTS AND BUFFER AREA R2E01290 130 | * R2E01300 0064 00FF 131 | MXNEC DC 255 MAXIMUM EXPONENT R2E01310 0066 8000 0001 132 | MXNEM DEC -0.9999999999B0 LARGEST NEGATIVE R2E01320 133 | * *MANTISSA R2E01330 0068 4000 0000 134 | A0 DEC 2.0B2 CONSTANTS FOR R2E01340 006A 5554 9859 135 | A2 DEC 0.66664413786B0 *POLYNOMIAL R2E01350 006C 0337 23A6 136 | A4 DEC 0.4019234697B4 *COEFICIENTS R2E01360 006E 0000 0001 137 | ONE DEC 1 TWO WORD ONE R2E01370 0070 0000 0000 138 | N1 DEC 0 R2E01380 0072 0080 139 | K1 DC 128 EXPONENT CODE CONSTANT R2E01390 0074 5A82 7B6F 140 | SQRH DEC 1.414214B1 RANGE CHECK FOR F R2E01400 0076 0000 141 | K DC 0 STORAGE FOR K R2E01410 0078 0000 0000 142 | FM1 DEC 0 DIVIDEND BUFFER R2E01420 007A 7FFF FF80 143 | FONE DEC 0.9999999999 FLT POINT ONE R2E01430 007C 0000 0000 144 | FP1 DEC 0.0 DIVISOR AND POLYNOMIAL R2E01440 007CR 145 | Z EQU FP1 RESULT BUFFER R2E01450 007E 58B9 0B80 146 | LN2 DEC 0.6931471806599452 LOG(E) OF TWO R2E01460 0080 8000 147 | C8000 DC /8000 SIGN BIT MASK R2E01470 0081 0081 148 | C129 DC 129 CONSTANTS R2E01480 0082 007E 149 | C12M2 DC 128-2 *FOR R2E01490 0083 0082 150 | C12P2 DC 128+2 *SCALING R2E01500 0084 008F 151 | C1P15 DC 128+15 *EXPONENTS R2E01510 0085 1890 152 | CSRTR DC 16+/1880 SHIFT RIGHT CONSTANTS R2E01520 0086 18FE 153 | CSRT DC 128-2+/1880 R2E01530 0087 0001 154 | LNEBT DC /1 BIT 15--LN ERROR. R2E01540 0088 155 | END R2E01550 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced A0 0068R 134 79 96 A2 006AR 135 93 A4 006CR 136 91 C129 0081R 148 53 C12M2 0082R 149 C12P2 0083R 150 98 C1P15 0084R 151 107 C8000 0080R 147 59 CSRT 0086R 153 74 CSRTR 0085R 152 77 EPOL 0048R 97 80 FALOG 0000R 29 FLN 0002R 31 115 FM1 0078R 142 47 50 52 58 60 67 FONE 007AR 143 62 FP1 007CR 144 64 71 145 K 0076R 141 35 55 57 105 K1 0072R 139 34 36 65 LN1 0020R 58 49 LN2 007ER 146 111 LNEBT 0087R 154 41 120 LNZER 005CR 120 39 MXNEC 0064R 131 123 MXNEM 0066R 132 125 N1 0070R 138 ONE 006ER 137 56 83 86 SQRH 0074R 140 48 SRT 003BR 84 76 STAT 0059R 114 32 127 Z 007CR 145 73 101 103 113
ibm/ibm1130-lib/dmsr2v12/r2fln_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator