User Tools

Site Tools


ibm:ibm1130-lib:dmsr2v12:r2fln_lst

R2FLN

Table Of Contents
  • [00028] CALL FLN -V1.
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