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 /* No math library intrinsic folding available if this module is loaded. 00037 * However, this module may contain other necessary folding routines 00038 * such as string conversion routines. In these cases, the high-level 00039 * interface name (AR_name) must exist here. 00040 */ 00041 00042 #include "arith.internal.h" 00043 00044 int ar_rounding_modes = 0xf; /* All rounding modes allowed */ 00045 int ar_underflow_modes = 1<<AR_UNDERFLOW_TO_DENORM; 00046 00047 /* string -> floating point */ 00048 int 00049 AR_convert_str_to_float (AR_DATA *result, const AR_TYPE *resulttype, 00050 const char *str) 00051 { 00052 int status; 00053 00054 if(AR_CLASS(*resulttype) != AR_CLASS_FLOAT || 00055 AR_FLOAT_IS_COMPLEX(*resulttype) == AR_FLOAT_COMPLEX) 00056 status = AR_STAT_INVALID_TYPE; 00057 else 00058 status = ar_cvt_str_to_float ((ar_data*)result, resulttype, str); 00059 00060 if(IS_ERROR_STATUS(status)) 00061 ar_set_invalid_result((ar_data*)result, resulttype); 00062 00063 return status; 00064 } 00065 00066 00067 /* Complex absolute value */ 00068 int 00069 AR_cabs (AR_DATA *result, const AR_TYPE *resulttype, 00070 const AR_DATA *opnd, const AR_TYPE *opndtype) 00071 { 00072 ar_set_invalid_result((ar_data*)result, resulttype); 00073 return AR_STAT_UNDEFINED; 00074 } 00075 int 00076 ar_cabs (ar_data *result, const AR_TYPE *resulttype, 00077 const ar_data *opnd, const AR_TYPE *opndtype) 00078 { 00079 ar_set_invalid_result((ar_data*)result, resulttype); 00080 return AR_STAT_UNDEFINED; 00081 } 00082 00083 00084 /* Native complex division */ 00085 int 00086 ar_divide_complex (ar_data *result, const AR_TYPE *resulttype, 00087 const ar_data *opnd1, const AR_TYPE *opnd1type, 00088 const ar_data *opnd2, const AR_TYPE *opnd2type) 00089 { 00090 00091 /* Assume types all match (see logic in AR_divide) */ 00092 00093 AR_DATA a, b, c, d, ac, bd, bc, ad, cc, dd, acbd, bcad, ccdd, re, im; 00094 AR_TYPE reimtype1, reimtype2, temptype; 00095 int status, restat, imstat; 00096 00097 status = ar_decompose_complex ((ar_data*)&a, (ar_data*)&b, &reimtype1, 00098 opnd1, opnd1type); 00099 status |= ar_decompose_complex ((ar_data*)&c, (ar_data*)&d, &reimtype2, 00100 opnd2, opnd2type); 00101 00102 /* PDGCS requests that a different sequence be used when the 00103 * imaginary part of the denominator is zero. A meeting of 00104 * managers on 11/30/93 decided in favor of this expediency. 00105 * Note that we do NOT apply special-case processing when 00106 * the real part of the denominator is zero. 00107 */ 00108 00109 imstat = AR_status (&d, &reimtype2); 00110 if (imstat & AR_STAT_ZERO) { 00111 00112 /* zero imaginary part, use short sequence */ 00113 restat = AR_divide (&re, &reimtype1, 00114 &a, &reimtype1, &c, &reimtype2); 00115 imstat = AR_divide (&im, &reimtype1, 00116 &b, &reimtype1, &c, &reimtype2); 00117 00118 } else { 00119 00120 /* 00121 * general sequence: 00122 * 00123 * a + bi (a + bi)(c - di) (ac + bd) (bc - ad)i 00124 * ------ = ---------------- = --------- + ---------- 00125 * c + di (c + di)(c - di) c*c + d*d c*c + d*d 00126 */ 00127 00128 status |= AR_multiply (&ac, &reimtype1, 00129 &a, &reimtype1, &c, &reimtype2); 00130 status |= AR_multiply (&bd, &reimtype1, &b, 00131 &reimtype1, &d, &reimtype2); 00132 status |= AR_multiply (&bc, &reimtype1, 00133 &b, &reimtype1, &c, &reimtype2); 00134 status |= AR_multiply (&ad, &reimtype1, 00135 &a, &reimtype1, &d, &reimtype2); 00136 status |= AR_multiply (&cc, &reimtype2, 00137 &c, &reimtype2, &c, &reimtype2); 00138 status |= AR_multiply (&dd, &reimtype2, 00139 &d, &reimtype2, &d, &reimtype2); 00140 status |= AR_add (&acbd, &reimtype1, 00141 &ac, &reimtype1, &bd, &reimtype1); 00142 status |= AR_subtract (&bcad, &reimtype1, 00143 &bc, &reimtype1, &ad, &reimtype1); 00144 status |= AR_add (&ccdd, &reimtype1, 00145 &cc, &reimtype1, &dd, &reimtype1); 00146 00147 restat = AR_divide (&re, &reimtype1, 00148 &acbd, &reimtype1, &ccdd, &reimtype1); 00149 imstat = AR_divide (&im, &reimtype1, 00150 &bcad, &reimtype1, &ccdd, &reimtype1); 00151 } 00152 00153 status |= ar_compose_complex (result, &temptype, 00154 (ar_data*)&re, (ar_data*)&im, &reimtype1); 00155 status |= restat | imstat; 00156 status &= ~(AR_STAT_ZERO | AR_STAT_NEGATIVE); 00157 status |= restat & imstat & AR_STAT_ZERO; 00158 return status; 00159 } 00160 00161 00162 static char USMID [] = "\n%Z%%M% %I% %G% %U%\n"; 00163 static char rcsid [] = "$Id: no_intrin.c,v 1.1.1.1 2002-05-22 20:06:19 dsystem Exp $";