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