Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2 of the GNU General Public License as 00007 published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU General Public License along 00021 with this program; if not, write the Free Software Foundation, Inc., 59 00022 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00023 00024 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00025 Mountain View, CA 94043, or: 00026 00027 http://www.sgi.com 00028 00029 For further information regarding this notice, see: 00030 00031 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00032 00033 */ 00034 00035 00036 #include <inttypes.h> 00037 #include "quad.h" 00038 00039 /* intrinsic QPROD -- by value version */ 00040 /* multiplies doubles x and y, returning the long double product */ 00041 00042 #ifdef FUSED_MADD 00043 static double __sub(double, double, double); 00044 #endif 00045 00046 typedef union 00047 { 00048 struct 00049 { 00050 unsigned int hi; 00051 unsigned int lo; 00052 } word; 00053 00054 double d; 00055 } du; 00056 00057 double fabs(double); 00058 #pragma intrinsic (fabs) 00059 00060 #ifndef FUSED_MADD 00061 /* const1 is 1.0 + 2^(53 - 53/2), i.e. 1.0 + 2^27 */ 00062 static const du const1 = {0x41a00000, 0x02000000}; 00063 #endif 00064 00065 static const du twop590 = {0x64d00000, 0x00000000}; 00066 static const du twopm590 = {0x1b100000, 0x00000000}; 00067 static const du inf = {0x7ff00000, 0x00000000}; 00068 00069 #define NO 0 00070 #define YES 1 00071 00072 long double __qprod(double x, double y) 00073 { 00074 ldquad z; 00075 int32_t ix, xptx, iy, xpty; 00076 double w, ww; 00077 double xfactor, yfactor; 00078 int32_t scaleup, scaledown; 00079 00080 #ifndef FUSED_MADD 00081 double p; 00082 double hx, hy, tx, ty; 00083 #endif 00084 00085 #include "msg.h" 00086 00087 /* Avoid underflows and overflows in forming the products 00088 x*const1.d, y*const1.d, x*y, and hx*hy by scaling if 00089 necessary. x and y should also be scaled if tx*ty is 00090 a denormal. 00091 */ 00092 ix = *(int32_t *)&x; 00093 xptx = (ix >> 20); 00094 xptx &= 0x7ff; 00095 iy = *(int32_t *)&y; 00096 xpty = (iy >> 20); 00097 xpty &= 0x7ff; 00098 if ((0x21a < xptx) && (xptx < 0x5fd) && (0x21a < xpty) && (xpty < 0x5fd)) { 00099 /* normal case */ 00100 #ifdef FUSED_MADD 00101 z.q.hi = x*y; 00102 z.q.lo = __sub(x, y, z.q.hi); 00103 #else 00104 p = x*const1.d; 00105 hx = p + (x - p); 00106 tx = x - hx; 00107 p = y*const1.d; 00108 hy = p + (y - p); 00109 ty = y - hy; 00110 z.q.hi = x*y; 00111 z.q.lo = (((hx*hy - z.q.hi) + hx*ty) + hy*tx) + tx*ty; 00112 #endif 00113 return (z.ld); 00114 } 00115 00116 if ((xptx < 0x7ff) && (xpty < 0x7ff)) { 00117 if ((x == 0.0) || (y == 0.0)) { 00118 z.q.lo = 0.0; 00119 z.q.hi = x*y; 00120 return (z.ld); 00121 } 00122 xfactor = 1.0; 00123 yfactor = 1.0; 00124 scaleup = scaledown = NO; 00125 if (xptx <= 0x21a) { 00126 x *= twop590.d; 00127 xfactor = twopm590.d; 00128 scaleup = YES; 00129 } 00130 if (xpty <= 0x21a) { 00131 y *= twop590.d; 00132 yfactor = twopm590.d; 00133 scaleup = YES; 00134 } 00135 if (xptx >= 0x5fd) { 00136 x *= twopm590.d; 00137 xfactor = twop590.d; 00138 scaledown = YES; 00139 } 00140 if (xpty >= 0x5fd) { 00141 y *= twopm590.d; 00142 yfactor = twop590.d; 00143 scaledown = YES; 00144 } 00145 if ((scaleup == YES) && (scaledown == YES)) { 00146 xfactor = yfactor = 1.0; 00147 } 00148 #ifdef FUSED_MADD 00149 w = x*y; 00150 ww = __sub(x, y, w); 00151 #else 00152 p = x*const1.d; 00153 hx = p + (x - p); 00154 tx = x - hx; 00155 p = y*const1.d; 00156 hy = p + (y - p); 00157 ty = y - hy; 00158 w = x*y; 00159 ww = (((hx*hy - w) + hx*ty) + hy*tx) + tx*ty; 00160 #endif 00161 w *= xfactor; 00162 w *= yfactor; 00163 if ((w == 0.0) || (fabs(w) == inf.d)) { 00164 z.q.hi = w; 00165 z.q.lo = 0.0; 00166 return (z.ld); 00167 } 00168 ww *= xfactor; 00169 ww *= yfactor; 00170 /* do to rounding, (w, ww) may not be normalized, so we have 00171 to normalize it again just to be safe 00172 */ 00173 z.q.hi = w + ww; 00174 z.q.lo = w - z.q.hi + ww; 00175 return (z.ld); 00176 } 00177 z.q.lo = 0.0; 00178 z.q.hi = x*y; 00179 return (z.ld); 00180 } 00181 00182 #ifdef FUSED_MADD 00183 static double __sub(double x, double y, double z) 00184 { 00185 return (x*y-z); 00186 } 00187 #endif