R2FSIN

Table Of Contents
  • [00004] CALL FSIN
r2fsin.lst
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