File indexing completed on 2025-05-11 08:23:49
0001 #include "fpsp-namespace.h"
0002 //
0003 //
0004 // stanh.sa 3.1 12/10/90
0005 //
0006 // The entry point sTanh computes the hyperbolic tangent of
0007 // an input argument; sTanhd does the same except for denormalized
0008 // input.
0009 //
0010 // Input: Double-extended number X in location pointed to
0011 // by address register a0.
0012 //
0013 // Output: The value tanh(X) returned in floating-point register Fp0.
0014 //
0015 // Accuracy and Monotonicity: The returned result is within 3 ulps in
0016 // 64 significant bit, i.e. within 0.5001 ulp to 53 bits if the
0017 // result is subsequently rounded to double precision. The
0018 // result is provably monotonic in double precision.
0019 //
0020 // Speed: The program stanh takes approximately 270 cycles.
0021 //
0022 // Algorithm:
0023 //
0024 // TANH
0025 // 1. If |X| >= (5/2) log2 or |X| <= 2**(-40), go to 3.
0026 //
0027 // 2. (2**(-40) < |X| < (5/2) log2) Calculate tanh(X) by
0028 // sgn := sign(X), y := 2|X|, z := expm1(Y), and
0029 // tanh(X) = sgn*( z/(2+z) ).
0030 // Exit.
0031 //
0032 // 3. (|X| <= 2**(-40) or |X| >= (5/2) log2). If |X| < 1,
0033 // go to 7.
0034 //
0035 // 4. (|X| >= (5/2) log2) If |X| >= 50 log2, go to 6.
0036 //
0037 // 5. ((5/2) log2 <= |X| < 50 log2) Calculate tanh(X) by
0038 // sgn := sign(X), y := 2|X|, z := exp(Y),
0039 // tanh(X) = sgn - [ sgn*2/(1+z) ].
0040 // Exit.
0041 //
0042 // 6. (|X| >= 50 log2) Tanh(X) = +-1 (round to nearest). Thus, we
0043 // calculate Tanh(X) by
0044 // sgn := sign(X), Tiny := 2**(-126),
0045 // tanh(X) := sgn - sgn*Tiny.
0046 // Exit.
0047 //
0048 // 7. (|X| < 2**(-40)). Tanh(X) = X. Exit.
0049 //
0050
0051 // Copyright (C) Motorola, Inc. 1990
0052 // All Rights Reserved
0053 //
0054 // THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF MOTOROLA
0055 // The copyright notice above does not evidence any
0056 // actual or intended publication of such source code.
0057
0058 //STANH idnt 2,1 | Motorola 040 Floating Point Software Package
0059
0060 |section 8
0061
0062 #include "fpsp.defs"
0063
0064 .set X,FP_SCR5
0065 .set XDCARE,X+2
0066 .set XFRAC,X+4
0067
0068 .set SGN,L_SCR3
0069
0070 .set V,FP_SCR6
0071
0072 BOUNDS1: .long 0x3FD78000,0x3FFFDDCE // ... 2^(-40), (5/2)LOG2
0073
0074 |xref t_frcinx
0075 |xref t_extdnrm
0076 |xref setox
0077 |xref setoxm1
0078
0079 .global stanhd
0080 stanhd:
0081 //--TANH(X) = X FOR DENORMALIZED X
0082
0083 bra t_extdnrm
0084
0085 .global stanh
0086 stanh:
0087 fmovex (%a0),%fp0 // ...LOAD INPUT
0088
0089 fmovex %fp0,X(%a6)
0090 movel (%a0),%d0
0091 movew 4(%a0),%d0
0092 movel %d0,X(%a6)
0093 andl #0x7FFFFFFF,%d0
0094 cmp2l BOUNDS1(%pc),%d0 // ...2**(-40) < |X| < (5/2)LOG2 ?
0095 bcss TANHBORS
0096
0097 //--THIS IS THE USUAL CASE
0098 //--Y = 2|X|, Z = EXPM1(Y), TANH(X) = SIGN(X) * Z / (Z+2).
0099
0100 movel X(%a6),%d0
0101 movel %d0,SGN(%a6)
0102 andl #0x7FFF0000,%d0
0103 addl #0x00010000,%d0 // ...EXPONENT OF 2|X|
0104 movel %d0,X(%a6)
0105 andl #0x80000000,SGN(%a6)
0106 fmovex X(%a6),%fp0 // ...FP0 IS Y = 2|X|
0107
0108 movel %d1,-(%a7)
0109 clrl %d1
0110 fmovemx %fp0-%fp0,(%a0)
0111 bsr setoxm1 // ...FP0 IS Z = EXPM1(Y)
0112 movel (%a7)+,%d1
0113
0114 fmovex %fp0,%fp1
0115 fadds #0x40000000,%fp1 // ...Z+2
0116 movel SGN(%a6),%d0
0117 fmovex %fp1,V(%a6)
0118 eorl %d0,V(%a6)
0119
0120 fmovel %d1,%FPCR //restore users exceptions
0121 fdivx V(%a6),%fp0
0122 bra t_frcinx
0123
0124 TANHBORS:
0125 cmpl #0x3FFF8000,%d0
0126 blt TANHSM
0127
0128 cmpl #0x40048AA1,%d0
0129 bgt TANHHUGE
0130
0131 //-- (5/2) LOG2 < |X| < 50 LOG2,
0132 //--TANH(X) = 1 - (2/[EXP(2X)+1]). LET Y = 2|X|, SGN = SIGN(X),
0133 //--TANH(X) = SGN - SGN*2/[EXP(Y)+1].
0134
0135 movel X(%a6),%d0
0136 movel %d0,SGN(%a6)
0137 andl #0x7FFF0000,%d0
0138 addl #0x00010000,%d0 // ...EXPO OF 2|X|
0139 movel %d0,X(%a6) // ...Y = 2|X|
0140 andl #0x80000000,SGN(%a6)
0141 movel SGN(%a6),%d0
0142 fmovex X(%a6),%fp0 // ...Y = 2|X|
0143
0144 movel %d1,-(%a7)
0145 clrl %d1
0146 fmovemx %fp0-%fp0,(%a0)
0147 bsr setox // ...FP0 IS EXP(Y)
0148 movel (%a7)+,%d1
0149 movel SGN(%a6),%d0
0150 fadds #0x3F800000,%fp0 // ...EXP(Y)+1
0151
0152 eorl #0xC0000000,%d0 // ...-SIGN(X)*2
0153 fmoves %d0,%fp1 // ...-SIGN(X)*2 IN SGL FMT
0154 fdivx %fp0,%fp1 // ...-SIGN(X)2 / [EXP(Y)+1 ]
0155
0156 movel SGN(%a6),%d0
0157 orl #0x3F800000,%d0 // ...SGN
0158 fmoves %d0,%fp0 // ...SGN IN SGL FMT
0159
0160 fmovel %d1,%FPCR //restore users exceptions
0161 faddx %fp1,%fp0
0162
0163 bra t_frcinx
0164
0165 TANHSM:
0166 movew #0x0000,XDCARE(%a6)
0167
0168 fmovel %d1,%FPCR //restore users exceptions
0169 fmovex X(%a6),%fp0 //last inst - possible exception set
0170
0171 bra t_frcinx
0172
0173 TANHHUGE:
0174 //---RETURN SGN(X) - SGN(X)EPS
0175 movel X(%a6),%d0
0176 andl #0x80000000,%d0
0177 orl #0x3F800000,%d0
0178 fmoves %d0,%fp0
0179 andl #0x80000000,%d0
0180 eorl #0x80800000,%d0 // ...-SIGN(X)*EPS
0181
0182 fmovel %d1,%FPCR //restore users exceptions
0183 fadds %d0,%fp0
0184
0185 bra t_frcinx
0186
0187 |end
