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 /* Miscellaneous arithmetic operations */ 00037 00038 #include "arith.internal.h" 00039 #include "int64.h" 00040 00041 #include <string.h> 00042 00043 #if !defined(__mips) && !defined(__sun) 00044 typedef AR_HOST_UINT64 an_mc_table[129]; 00045 extern int GETPMC(an_mc_table, char *); 00046 extern long CHECKMC(const char *mcname, 00047 AR_HOST_SINT64 *pdtwrd, 00048 AR_HOST_SINT64 *pdtstrt, 00049 AR_HOST_SINT64 *pdtlen, 00050 AR_HOST_SINT64 *mcindx, 00051 AR_HOST_SINT64 *mctype, 00052 AR_HOST_SINT64 *mcdef, 00053 const char *pmtname, ...); 00054 #endif 00055 00056 /* 00057 * Linux workaround 00058 */ 00059 #if !defined(__mips) && !defined(__sun) 00060 int GETPMC(an_mc_table a, char * b) 00061 { 00062 return 0; 00063 } 00064 00065 long CHECKMC(const char *mcname, 00066 AR_HOST_SINT64 *pdtwrd, 00067 AR_HOST_SINT64 *pdtstrt, 00068 AR_HOST_SINT64 *pdtlen, 00069 AR_HOST_SINT64 *mcindx, 00070 AR_HOST_SINT64 *mctype, 00071 AR_HOST_SINT64 *mcdef, 00072 const char *pmtname, ...) 00073 { 00074 return 0; 00075 } 00076 #endif 00077 00078 AR_DATA AR_const_zero = { 0, 0, 0, 0 }; 00079 AR_DATA AR_const_one = { 1, 0, 0, 0 }; 00080 AR_DATA AR_const_two = { 2, 0, 0, 0 }; 00081 00082 AR_DATA AR_const_false = { 0, 0, 0, 0 }; 00083 AR_DATA AR_const_true = {-1, 0, 0, 0 }; 00084 00085 /* Global state */ 00086 00087 ar_state_info ar_state_register = { 0, 0, 0, 0, 0, 0, 0, 0 }; 00088 00089 /* Get/set internal state register */ 00090 00091 AR_HOST_SINT64 00092 AR_get_state_register() 00093 { 00094 ar_state_info state_register = ar_state_register; 00095 00096 state_register.ar_unused_mode_bits = 0x1e; 00097 return *(AR_HOST_SINT64*)&state_register; 00098 } 00099 00100 int 00101 AR_set_state_register(AR_HOST_SINT64 state_reg) 00102 { 00103 ar_state_info state_register = *(ar_state_info*)&state_reg; 00104 00105 if(state_register.ar_unused_mode_bits != 0x1e) 00106 return AR_STAT_UNDEFINED; 00107 00108 if(ar_rounding_modes && 00109 !(ar_rounding_modes & (1<<state_register.ar_rounding_mode))) 00110 return AR_STAT_UNDEFINED; 00111 00112 if(ar_underflow_modes && 00113 !(ar_underflow_modes & (1<<state_register.ar_underflow_mode))) 00114 return AR_STAT_UNDEFINED; 00115 00116 state_register.ar_unused_mode_bits = 0; 00117 ar_state_register = state_register; 00118 return AR_STAT_OK; 00119 } 00120 00121 /* Get/set rounding mode */ 00122 00123 int 00124 AR_get_rounding_mode() 00125 { 00126 return ar_state_register.ar_rounding_mode; 00127 } 00128 00129 int 00130 AR_set_rounding_mode(int rounding_mode) 00131 { 00132 if(ar_rounding_modes && 00133 !(ar_rounding_modes & (1<<rounding_mode))) 00134 return AR_STAT_UNDEFINED; 00135 00136 ar_state_register.ar_rounding_mode = rounding_mode; 00137 return AR_STAT_OK; 00138 } 00139 00140 /* Get/set underflow mode */ 00141 00142 int 00143 AR_get_underflow_mode() 00144 { 00145 return ar_state_register.ar_underflow_mode; 00146 } 00147 00148 int 00149 AR_set_underflow_mode(int underflow_mode) 00150 { 00151 if(ar_underflow_modes && 00152 !(ar_underflow_modes & (1<<underflow_mode))) 00153 return AR_STAT_UNDEFINED; 00154 00155 ar_state_register.ar_underflow_mode = underflow_mode; 00156 return AR_STAT_OK; 00157 } 00158 00159 00160 /* Get floating point format */ 00161 00162 int 00163 AR_get_floating_point_format() 00164 { 00165 return ar_state_register.ar_float_format; 00166 } 00167 00168 /* Get 128-bit floating point format */ 00169 00170 int 00171 AR_get_128bit_format() 00172 { 00173 return ar_state_register.ar_128bit_format; 00174 } 00175 00176 00177 /* Complex value decomposition */ 00178 int 00179 ar_decompose_complex (ar_data *real, ar_data *imag, AR_TYPE *parttype, 00180 const ar_data *cplx, const AR_TYPE *cplxtype) { 00181 00182 *parttype = (AR_TYPE) (*cplxtype ^ AR_FLOAT_COMPLEX); 00183 00184 if (AR_CLASS (*cplxtype) != AR_CLASS_FLOAT || 00185 AR_FLOAT_IS_COMPLEX (*cplxtype) != AR_FLOAT_COMPLEX) 00186 return AR_STAT_INVALID_TYPE; 00187 00188 if (AR_FLOAT_FORMAT (*cplxtype) == AR_FLOAT_CRAY) 00189 if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_64) { 00190 real->ar_f64 = cplx->ar_cplx_f64.real; 00191 imag->ar_f64 = cplx->ar_cplx_f64.imag; 00192 } else if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_128) { 00193 real->ar_f128 = cplx->ar_cplx_f128.real; 00194 imag->ar_f128 = cplx->ar_cplx_f128.imag; 00195 } else 00196 return AR_STAT_INVALID_TYPE; 00197 else if (AR_FLOAT_FORMAT (*cplxtype) == AR_FLOAT_IEEE) 00198 if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_32) { 00199 CPLX32_REAL_TO_IEEE32(real->ar_ieee32, 00200 cplx->ar_cplx_ieee32); 00201 CPLX32_IMAG_TO_IEEE32(imag->ar_ieee32, 00202 cplx->ar_cplx_ieee32); 00203 } else if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_64) { 00204 real->ar_ieee64 = cplx->ar_cplx_ieee64.real; 00205 imag->ar_ieee64 = cplx->ar_cplx_ieee64.imag; 00206 } else if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_128) { 00207 real->ar_ieee128 = cplx->ar_cplx_ieee128.real; 00208 imag->ar_ieee128 = cplx->ar_cplx_ieee128.imag; 00209 } else 00210 return AR_STAT_INVALID_TYPE; 00211 else 00212 return AR_STAT_INVALID_TYPE; 00213 00214 return AR_STAT_OK; 00215 } 00216 00217 00218 /* Complex value construction */ 00219 int 00220 ar_compose_complex (ar_data *cplx, AR_TYPE *cplxtype, 00221 const ar_data *real, const ar_data *imag, 00222 const AR_TYPE *parttype) { 00223 00224 *cplxtype = (AR_TYPE) (*parttype ^ AR_FLOAT_COMPLEX); 00225 00226 if (AR_CLASS (*cplxtype) != AR_CLASS_FLOAT || 00227 AR_FLOAT_IS_COMPLEX (*cplxtype) != AR_FLOAT_COMPLEX) 00228 return AR_STAT_INVALID_TYPE; 00229 00230 if (AR_FLOAT_FORMAT (*cplxtype) == AR_FLOAT_CRAY) 00231 if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_64) { 00232 cplx->ar_cplx_f64.real = real->ar_f64; 00233 cplx->ar_cplx_f64.imag = imag->ar_f64; 00234 } else if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_128) { 00235 cplx->ar_cplx_f128.real = real->ar_f128; 00236 cplx->ar_cplx_f128.imag = imag->ar_f128; 00237 } else 00238 return AR_STAT_INVALID_TYPE; 00239 else if (AR_FLOAT_FORMAT (*cplxtype) == AR_FLOAT_IEEE) 00240 if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_32) { 00241 IEEE32_TO_CPLX32_REAL(cplx->ar_cplx_ieee32, 00242 real->ar_ieee32); 00243 IEEE32_TO_CPLX32_IMAG(cplx->ar_cplx_ieee32, 00244 imag->ar_ieee32); 00245 } else if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_64) { 00246 cplx->ar_cplx_ieee64.real = real->ar_ieee64; 00247 cplx->ar_cplx_ieee64.imag = imag->ar_ieee64; 00248 } else if (AR_FLOAT_SIZE (*cplxtype) == AR_FLOAT_128) { 00249 cplx->ar_cplx_ieee128.real = real->ar_ieee128; 00250 cplx->ar_cplx_ieee128.imag = imag->ar_ieee128; 00251 } else 00252 return AR_STAT_INVALID_TYPE; 00253 else 00254 return AR_STAT_INVALID_TYPE; 00255 00256 return AR_STAT_OK; 00257 } 00258 00259 00260 int 00261 AR_creal (AR_DATA *result, const AR_TYPE *resulttype, 00262 const AR_DATA *opnd, const AR_TYPE *opndtype) { 00263 00264 ar_data im; 00265 AR_TYPE reimtype; 00266 int status; 00267 00268 status = ar_decompose_complex ((ar_data*)result, &im, &reimtype, 00269 (const ar_data*)opnd, opndtype); 00270 if (reimtype != *resulttype) 00271 return AR_STAT_INVALID_TYPE; 00272 return status; 00273 } 00274 00275 00276 int 00277 AR_cimag (AR_DATA *result, const AR_TYPE *resulttype, 00278 const AR_DATA *opnd, const AR_TYPE *opndtype) { 00279 00280 ar_data re; 00281 AR_TYPE reimtype; 00282 int status; 00283 00284 status = ar_decompose_complex (&re, (ar_data*)result, &reimtype, 00285 (const ar_data*)opnd, opndtype); 00286 if (reimtype != *resulttype) 00287 return AR_STAT_INVALID_TYPE; 00288 return status; 00289 } 00290 00291 00292 /* Status bit computation */ 00293 int 00294 AR_status (const AR_DATA *opd, const AR_TYPE *opndtype) { 00295 00296 ar_data* opnd = (ar_data*)opd; 00297 00298 int status = AR_STAT_OK, restat, imstat; 00299 ar_data re, im; 00300 AR_TYPE reimtype; 00301 00302 if (AR_CLASS (*opndtype) == AR_CLASS_INT) { 00303 switch (AR_INT_SIZE (*opndtype)) { 00304 case AR_INT_SIZE_8: 00305 if (IS_INT8_ZERO(opnd)) 00306 status |= AR_STAT_ZERO; 00307 else if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED && 00308 INT8_SIGN(opnd)) 00309 status |= AR_STAT_NEGATIVE; 00310 break; 00311 case AR_INT_SIZE_16: 00312 if (IS_INT16_ZERO(opnd)) 00313 status |= AR_STAT_ZERO; 00314 else if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED && 00315 INT16_SIGN(opnd)) 00316 status |= AR_STAT_NEGATIVE; 00317 break; 00318 case AR_INT_SIZE_24: 00319 if (IS_INT24_ZERO(opnd)) 00320 status |= AR_STAT_ZERO; 00321 else if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED && 00322 INT24_SIGN(opnd)) 00323 status |= AR_STAT_NEGATIVE; 00324 break; 00325 case AR_INT_SIZE_32: 00326 if (IS_INT32_ZERO(opnd)) 00327 status |= AR_STAT_ZERO; 00328 else if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED && 00329 INT32_SIGN(opnd)) 00330 status |= AR_STAT_NEGATIVE; 00331 break; 00332 case AR_INT_SIZE_46: 00333 case AR_INT_SIZE_64: 00334 if (IS_INT64_ZERO(opnd)) 00335 status |= AR_STAT_ZERO; 00336 else if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED && 00337 INT64_SIGN(opnd)) 00338 status |= AR_STAT_NEGATIVE; 00339 break; 00340 default: 00341 status = AR_STAT_INVALID_TYPE; 00342 } 00343 00344 return status; 00345 } 00346 00347 /* Check for null pointer constant */ 00348 if (AR_CLASS (*opndtype) == AR_CLASS_POINTER) 00349 if (!(opnd->ar_i64.part1 | opnd->ar_i64.part2 | 00350 opnd->ar_i64.part3 | opnd->ar_i64.part4)) 00351 return AR_STAT_ZERO; 00352 else 00353 return AR_STAT_OK; 00354 00355 if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT) { 00356 00357 switch (*opndtype) { 00358 00359 case AR_Float_Cray1_64: 00360 case AR_Float_Cray1_64_F: 00361 if (opnd->ar_f64.sign) 00362 status |= AR_STAT_NEGATIVE; 00363 if (!(opnd->ar_f64.expo | opnd->ar_f64.coeff0 | 00364 opnd->ar_f64.coeff1 | opnd->ar_f64.coeff2)) 00365 status |= AR_STAT_ZERO; 00366 else { 00367 if (opnd->ar_f64.expo > AR_CRAY_MAX_EXPO) 00368 status |= AR_STAT_OVERFLOW; 00369 else if (opnd->ar_f64.expo < AR_CRAY_MIN_EXPO) 00370 status |= AR_STAT_UNDERFLOW; 00371 } 00372 break; 00373 00374 case AR_Float_Cray1_128: 00375 if (opnd->ar_f128.sign) 00376 status |= AR_STAT_NEGATIVE; 00377 if (!(opnd->ar_f128.expo | opnd->ar_f128.coeff0 | 00378 opnd->ar_f128.coeff1 | opnd->ar_f128.coeff2 | 00379 opnd->ar_f128.zero | opnd->ar_f128.coeff3 | 00380 opnd->ar_f128.coeff4 | opnd->ar_f128.coeff5)) 00381 status |= AR_STAT_ZERO; 00382 else { 00383 if (opnd->ar_f128.zero) 00384 status |= AR_STAT_UNDEFINED; 00385 if (opnd->ar_f128.expo > AR_CRAY_MAX_EXPO) 00386 status |= AR_STAT_OVERFLOW; 00387 else if (opnd->ar_f128.expo < AR_CRAY_MIN_EXPO) 00388 status |= AR_STAT_UNDERFLOW; 00389 } 00390 break; 00391 00392 case AR_Float_IEEE_NR_32: 00393 case AR_Float_IEEE_ZE_32: 00394 case AR_Float_IEEE_UP_32: 00395 case AR_Float_IEEE_DN_32: 00396 if (opnd->ar_ieee32.expo > AR_IEEE32_MAX_EXPO) 00397 if (IS_IEEE32_NZ_COEFF(&opnd->ar_ieee32)) 00398 status |= AR_STAT_UNDEFINED; /* NaN */ 00399 else if (opnd->ar_ieee32.sign) 00400 status |= AR_STAT_OVERFLOW | 00401 AR_STAT_NEGATIVE; /* -Inf */ 00402 else 00403 status |= AR_STAT_OVERFLOW; /* +Inf */ 00404 else if (opnd->ar_ieee32.sign) 00405 status |= AR_STAT_NEGATIVE; 00406 if (opnd->ar_ieee32.expo == 0 && 00407 !IS_IEEE32_NZ_COEFF(&opnd->ar_ieee32)) 00408 status |= AR_STAT_ZERO; 00409 break; 00410 00411 case AR_Float_IEEE_NR_64: 00412 case AR_Float_IEEE_ZE_64: 00413 case AR_Float_IEEE_UP_64: 00414 case AR_Float_IEEE_DN_64: 00415 if (opnd->ar_ieee64.expo > AR_IEEE64_MAX_EXPO) 00416 if (IS_IEEE64_NZ_COEFF(&opnd->ar_ieee64)) 00417 status |= AR_STAT_UNDEFINED; /* NaN */ 00418 else if (opnd->ar_ieee64.sign) 00419 status |= AR_STAT_OVERFLOW | 00420 AR_STAT_NEGATIVE; /* -Inf */ 00421 else 00422 status |= AR_STAT_OVERFLOW; /* +Inf */ 00423 else if (opnd->ar_ieee64.sign) 00424 status |= AR_STAT_NEGATIVE; 00425 if (opnd->ar_ieee64.expo == 0 && 00426 !IS_IEEE64_NZ_COEFF(&opnd->ar_ieee64)) 00427 status |= AR_STAT_ZERO; 00428 break; 00429 00430 case AR_Float_IEEE_NR_128: 00431 case AR_Float_IEEE_ZE_128: 00432 case AR_Float_IEEE_UP_128: 00433 case AR_Float_IEEE_DN_128: 00434 if (HOST_IS_MIPS) { 00435 if (opnd->ar_mips128.expo > AR_MIPS128_MAX_EXPO) 00436 if (IS_MIPS128_NZ_COEFF(&opnd->ar_mips128)) 00437 status |= AR_STAT_UNDEFINED; /* NaN */ 00438 else if (opnd->ar_mips128.sign) 00439 status |= AR_STAT_OVERFLOW | 00440 AR_STAT_NEGATIVE; /* -Inf */ 00441 else 00442 status |= AR_STAT_OVERFLOW; /* +Inf */ 00443 else if (opnd->ar_mips128.sign) 00444 status |= AR_STAT_NEGATIVE; 00445 if (opnd->ar_mips128.expo == 0 && 00446 opnd->ar_mips128.expol == 0 && 00447 !IS_MIPS128_NZ_COEFF(&opnd->ar_mips128)) 00448 status |= AR_STAT_ZERO; 00449 break; 00450 } 00451 00452 if (opnd->ar_ieee128.expo > AR_IEEE128_MAX_EXPO) 00453 if (IS_IEEE128_NZ_COEFF(&opnd->ar_ieee128)) 00454 status |= AR_STAT_UNDEFINED; /* NaN */ 00455 else if (opnd->ar_ieee128.sign) 00456 status |= AR_STAT_OVERFLOW | 00457 AR_STAT_NEGATIVE; /* -Inf */ 00458 else 00459 status |= AR_STAT_OVERFLOW; /* +Inf */ 00460 else if (opnd->ar_ieee128.sign) 00461 status |= AR_STAT_NEGATIVE; 00462 if (opnd->ar_ieee128.expo == 0 && 00463 !IS_IEEE128_NZ_COEFF(&opnd->ar_ieee128)) 00464 status |= AR_STAT_ZERO; 00465 break; 00466 00467 case AR_Complex_Cray1_64: 00468 case AR_Complex_Cray1_64_F: 00469 case AR_Complex_Cray1_128: 00470 case AR_Complex_IEEE_NR_32: 00471 case AR_Complex_IEEE_ZE_32: 00472 case AR_Complex_IEEE_UP_32: 00473 case AR_Complex_IEEE_DN_32: 00474 case AR_Complex_IEEE_NR_64: 00475 case AR_Complex_IEEE_ZE_64: 00476 case AR_Complex_IEEE_UP_64: 00477 case AR_Complex_IEEE_DN_64: 00478 case AR_Complex_IEEE_NR_128: 00479 case AR_Complex_IEEE_ZE_128: 00480 case AR_Complex_IEEE_UP_128: 00481 case AR_Complex_IEEE_DN_128: 00482 status |= ar_decompose_complex (&re, &im, &reimtype, 00483 opnd, opndtype); 00484 restat = AR_status ((const AR_DATA*)&re, &reimtype); 00485 imstat = AR_status ((const AR_DATA*)&im, &reimtype); 00486 status |= restat & imstat & AR_STAT_ZERO; 00487 status |= (restat | imstat) & 00488 (AR_STAT_OVERFLOW | AR_STAT_UNDEFINED | 00489 AR_STAT_UNDERFLOW | AR_STAT_INVALID_TYPE); 00490 break; 00491 00492 default: 00493 return AR_STAT_INVALID_TYPE; 00494 00495 } 00496 00497 return status; 00498 } 00499 00500 if (AR_CLASS (*opndtype) == AR_CLASS_LOGICAL) { 00501 if (!(opnd->ar_i64.part1 | opnd->ar_i64.part2 | 00502 opnd->ar_i64.part3 | opnd->ar_i64.part4)) 00503 status = AR_STAT_ZERO; 00504 return status; 00505 } 00506 00507 return AR_STAT_INVALID_TYPE; 00508 } 00509 00510 00511 /* Compute the value of one. Really. */ 00512 int 00513 AR_one (AR_DATA *res, const AR_TYPE *type) { 00514 00515 ar_data* result = (ar_data*)res; 00516 00517 switch (*type) { 00518 case AR_Int_16_S: 00519 case AR_Int_16_U: 00520 case AR_Int_32_S: 00521 case AR_Int_32_U: 00522 case AR_Int_46_S: 00523 case AR_Int_64_S: 00524 case AR_Int_64_U: 00525 result->ar_i64.part1 = 0; 00526 result->ar_i64.part2 = 0; 00527 result->ar_i64.part3 = 0; 00528 result->ar_i64.part4 = 1; 00529 break; 00530 case AR_Float_Cray1_64: 00531 case AR_Float_Cray1_64_F: 00532 ZEROCRAY64 (result->ar_f64); 00533 result->ar_f64.expo = AR_CRAY_EXPO_BIAS; 00534 result->ar_f64.coeff0 = 1 << (AR_CRAY_C0_BITS - 1); 00535 break; 00536 case AR_Float_Cray1_128: 00537 ZEROCRAY128 (result->ar_f128); 00538 result->ar_f128.expo = AR_CRAY_EXPO_BIAS; 00539 result->ar_f128.coeff0 = 1 << (AR_CRAY_C0_BITS - 1); 00540 break; 00541 case AR_Float_IEEE_NR_32: 00542 case AR_Float_IEEE_ZE_32: 00543 case AR_Float_IEEE_UP_32: 00544 case AR_Float_IEEE_DN_32: 00545 ZEROIEEE32 (result->ar_ieee32); 00546 result->ar_ieee32.expo = AR_IEEE32_EXPO_BIAS; 00547 break; 00548 case AR_Float_IEEE_NR_64: 00549 case AR_Float_IEEE_ZE_64: 00550 case AR_Float_IEEE_UP_64: 00551 case AR_Float_IEEE_DN_64: 00552 ZEROIEEE64 (result->ar_ieee64); 00553 result->ar_ieee64.expo = AR_IEEE64_EXPO_BIAS; 00554 break; 00555 case AR_Float_IEEE_NR_128: 00556 case AR_Float_IEEE_ZE_128: 00557 case AR_Float_IEEE_UP_128: 00558 case AR_Float_IEEE_DN_128: 00559 ZEROIEEE128 (result->ar_ieee128); 00560 if (HOST_IS_MIPS) 00561 result->ar_mips128.expo = AR_MIPS128_EXPO_BIAS; 00562 else 00563 result->ar_ieee128.expo = AR_IEEE128_EXPO_BIAS; 00564 break; 00565 case AR_Complex_Cray1_64: 00566 case AR_Complex_Cray1_64_F: 00567 ZEROCRAY64 (result->ar_cplx_f64.real); 00568 result->ar_cplx_f64.real.expo = AR_CRAY_EXPO_BIAS; 00569 result->ar_cplx_f64.real.coeff0 = 1 << (AR_CRAY_C0_BITS - 1); 00570 ZEROCRAY64 (result->ar_cplx_f64.imag); 00571 break; 00572 case AR_Complex_Cray1_128: 00573 ZEROCRAY128 (result->ar_cplx_f128.real); 00574 result->ar_cplx_f128.real.expo = AR_CRAY_EXPO_BIAS; 00575 result->ar_cplx_f128.real.coeff0 = 1 << (AR_CRAY_C0_BITS - 1); 00576 ZEROCRAY128 (result->ar_cplx_f128.imag); 00577 break; 00578 case AR_Complex_IEEE_NR_32: 00579 case AR_Complex_IEEE_ZE_32: 00580 case AR_Complex_IEEE_UP_32: 00581 case AR_Complex_IEEE_DN_32: 00582 result->ar_cplx_ieee32.rsign = 0; 00583 result->ar_cplx_ieee32.rexpo = AR_IEEE32_EXPO_BIAS; 00584 result->ar_cplx_ieee32.rcoeff0 = 0; 00585 result->ar_cplx_ieee32.rcoeff1 = 0; 00586 00587 result->ar_cplx_ieee32.isign = 0; 00588 result->ar_cplx_ieee32.iexpo = 0; 00589 result->ar_cplx_ieee32.icoeff0 = 0; 00590 result->ar_cplx_ieee32.icoeff1 = 0; 00591 break; 00592 case AR_Complex_IEEE_NR_64: 00593 case AR_Complex_IEEE_ZE_64: 00594 case AR_Complex_IEEE_UP_64: 00595 case AR_Complex_IEEE_DN_64: 00596 ZEROIEEE64 (result->ar_cplx_ieee64.real); 00597 result->ar_cplx_ieee64.real.expo = AR_IEEE64_EXPO_BIAS; 00598 ZEROIEEE64 (result->ar_cplx_ieee64.imag); 00599 break; 00600 case AR_Complex_IEEE_NR_128: 00601 case AR_Complex_IEEE_ZE_128: 00602 case AR_Complex_IEEE_UP_128: 00603 case AR_Complex_IEEE_DN_128: 00604 ZEROIEEE128 (result->ar_cplx_ieee128.real); 00605 if (HOST_IS_MIPS) 00606 result->ar_cplx_mips128.real.expo = 00607 AR_MIPS128_EXPO_BIAS; 00608 else 00609 result->ar_cplx_ieee128.real.expo = 00610 AR_IEEE128_EXPO_BIAS; 00611 ZEROIEEE128 (result->ar_cplx_ieee128.imag); 00612 break; 00613 default: 00614 return AR_STAT_INVALID_TYPE; 00615 } 00616 00617 return AR_STAT_OK; 00618 } 00619 00620 00621 /* Absolute value */ 00622 int 00623 AR_abs (AR_DATA *res, const AR_TYPE *resulttype, 00624 const AR_DATA *opd, const AR_TYPE *opndtype) { 00625 00626 ar_data* result = (ar_data*)res; 00627 ar_data* opnd = (ar_data*)opd; 00628 00629 int status; 00630 00631 if (AR_CLASS (*resulttype) == AR_CLASS_INT) { 00632 if (*opndtype != *resulttype) 00633 return AR_STAT_INVALID_TYPE; 00634 switch (AR_INT_SIZE (*opndtype)) { 00635 case AR_INT_SIZE_8: 00636 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED && 00637 INT8_SIGN(opnd)) { 00638 status = ar_negate_integer (result, resulttype, 00639 opnd, opndtype); 00640 if(status & AR_STAT_NEGATIVE) { 00641 status &= ~ AR_STAT_SEMIVALID; 00642 status |= AR_STAT_OVERFLOW; 00643 } 00644 return status; 00645 } 00646 00647 ZERO_INT8_UPPER(result); 00648 COPY_INT8(result, opnd); 00649 return AR_status ((const AR_DATA*)result, 00650 resulttype); 00651 00652 case AR_INT_SIZE_16: 00653 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED && 00654 INT16_SIGN(opnd)) { 00655 status = ar_negate_integer (result, resulttype, 00656 opnd, opndtype); 00657 if(status & AR_STAT_NEGATIVE) { 00658 status &= ~ AR_STAT_SEMIVALID; 00659 status |= AR_STAT_OVERFLOW; 00660 } 00661 return status; 00662 } 00663 00664 ZERO_INT16_UPPER(result); 00665 COPY_INT16(result, opnd); 00666 return AR_status ((const AR_DATA*)result, 00667 resulttype); 00668 00669 case AR_INT_SIZE_32: 00670 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED && 00671 INT32_SIGN(opnd)) { 00672 status = ar_negate_integer (result, resulttype, 00673 opnd, opndtype); 00674 if(status & AR_STAT_NEGATIVE) { 00675 status &= ~ AR_STAT_SEMIVALID; 00676 status |= AR_STAT_OVERFLOW; 00677 } 00678 return status; 00679 } 00680 00681 ZERO_INT32_UPPER(result); 00682 COPY_INT32(result, opnd); 00683 return AR_status ((const AR_DATA*)result, 00684 resulttype); 00685 00686 case AR_INT_SIZE_46: 00687 case AR_INT_SIZE_64: 00688 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED && 00689 INT64_SIGN(opnd)) { 00690 status = ar_negate_integer (result, resulttype, 00691 opnd, opndtype); 00692 if(status & AR_STAT_NEGATIVE) { 00693 status &= ~ AR_STAT_SEMIVALID; 00694 status |= AR_STAT_OVERFLOW; 00695 } 00696 return status; 00697 } 00698 00699 COPY_INT64(result, opnd); 00700 return AR_status ((const AR_DATA*)result, 00701 resulttype); 00702 00703 default: 00704 return (AR_STAT_INVALID_TYPE); 00705 } 00706 } 00707 00708 if (AR_CLASS (*resulttype) == AR_CLASS_FLOAT) { 00709 00710 if (AR_FLOAT_IS_COMPLEX (*opndtype) == AR_FLOAT_COMPLEX) 00711 return ar_cabs (result, resulttype, opnd, opndtype); 00712 00713 /* Floating-point absolute value */ 00714 if (*opndtype != *resulttype) 00715 return AR_STAT_INVALID_TYPE; 00716 if (AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_CRAY) { 00717 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) { 00718 result->ar_f64 = opnd->ar_f64; 00719 result->ar_f64.sign = 0; 00720 return AR_status ((const AR_DATA*)result, resulttype); 00721 } 00722 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) { 00723 result->ar_f128 = opnd->ar_f128; 00724 result->ar_f128.sign = 0; 00725 return AR_status ((const AR_DATA*)result, resulttype); 00726 } 00727 return AR_STAT_INVALID_TYPE; 00728 } 00729 if (AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_IEEE) 00730 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) { 00731 result->ar_ieee64 = opnd->ar_ieee64; 00732 result->ar_ieee64.sign = 0; 00733 return AR_status ((const AR_DATA*)result, resulttype); 00734 } else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_32) { 00735 result->ar_ieee32 = opnd->ar_ieee32; 00736 result->ar_ieee32.sign = 0; 00737 return AR_status ((const AR_DATA*)result, resulttype); 00738 } else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) { 00739 if (HOST_IS_MIPS) { 00740 result->ar_mips128 = opnd->ar_mips128; 00741 if (result->ar_mips128.sign) { 00742 /* zero high sign, flip low sign */ 00743 result->ar_mips128.sign = 0; 00744 result->ar_mips128.signl ^= 1; 00745 } 00746 } 00747 else { 00748 result->ar_ieee128 = opnd->ar_ieee128; 00749 result->ar_ieee128.sign = 0; 00750 } 00751 return AR_status ((const AR_DATA*)result, 00752 resulttype); 00753 } else 00754 return AR_STAT_INVALID_TYPE; 00755 return AR_STAT_INVALID_TYPE; 00756 } 00757 00758 /* Neither integer or floating-point */ 00759 return AR_STAT_INVALID_TYPE; 00760 } 00761 00762 00763 /* Complex conjugate */ 00764 int 00765 AR_conj (AR_DATA *res, const AR_TYPE *resulttype, 00766 const AR_DATA *opd, const AR_TYPE *opndtype) { 00767 00768 ar_data* result = (ar_data*)res; 00769 ar_data* opnd = (ar_data*)opd; 00770 00771 int status; 00772 ar_data re, im, negim; 00773 AR_TYPE reimtype, temptype; 00774 00775 status = ar_decompose_complex (&re, &im, &reimtype, opnd, opndtype); 00776 status |= ar_negate_float (&negim, &reimtype, &im, &reimtype); 00777 status |= ar_compose_complex (result, &temptype, 00778 &re, &negim, &reimtype); 00779 status &= ~(AR_STAT_ZERO | AR_STAT_NEGATIVE); 00780 return status | AR_status ((const AR_DATA*)result, resulttype); 00781 } 00782 00783 00784 00785 /* Complex construction: a -> (0, ai) */ 00786 int 00787 AR_make_imag 00788 (AR_DATA *result, const AR_TYPE *resulttype, 00789 const AR_DATA *opnd, const AR_TYPE *opndtype) { 00790 return (AR_make_complex(result, resulttype, &AR_const_zero, opndtype, 00791 opnd, opndtype)); 00792 } 00793 00794 /* Complex construction: a,b -> (a, bi) */ 00795 int 00796 AR_make_complex 00797 (AR_DATA *res, const AR_TYPE *resulttype, 00798 const AR_DATA *op1, const AR_TYPE *opnd1type, 00799 const AR_DATA *op2, const AR_TYPE *opnd2type) { 00800 00801 /* 00802 * Opnd1 and opnd2 are local copies, in case one or the other 00803 * is an alias for result. It may be that only the case where 00804 * result and opnd2 are aliased is a problem, but doing both 00805 * operands the same way retains symmetry in the source, and 00806 * removes the need to analyze the opnd1 case. 00807 */ 00808 00809 ar_data* result = (ar_data*)res; 00810 ar_data opnd1 = *(ar_data*)op1; 00811 ar_data opnd2 = *(ar_data*)op2; 00812 00813 if (*opnd1type != *opnd2type || 00814 AR_CLASS (*opnd1type) != AR_CLASS_FLOAT || 00815 AR_FLOAT_IS_COMPLEX (*opnd1type) == AR_FLOAT_COMPLEX || 00816 *resulttype != (*opnd1type | AR_FLOAT_COMPLEX)) 00817 return AR_STAT_INVALID_TYPE; 00818 00819 switch (*opnd1type) { 00820 case AR_Float_Cray1_64: 00821 case AR_Float_Cray1_64_F: 00822 result->ar_cplx_f64.real = opnd1.ar_f64; 00823 result->ar_cplx_f64.imag = opnd2.ar_f64; 00824 break; 00825 case AR_Float_Cray1_128: 00826 result->ar_cplx_f128.real = opnd1.ar_f128; 00827 result->ar_cplx_f128.imag = opnd2.ar_f128; 00828 break; 00829 case AR_Float_IEEE_NR_32: 00830 case AR_Float_IEEE_ZE_32: 00831 case AR_Float_IEEE_UP_32: 00832 case AR_Float_IEEE_DN_32: 00833 IEEE32_TO_CPLX32_REAL(result->ar_cplx_ieee32, opnd1.ar_ieee32); 00834 IEEE32_TO_CPLX32_IMAG(result->ar_cplx_ieee32, opnd2.ar_ieee32); 00835 break; 00836 case AR_Float_IEEE_NR_64: 00837 case AR_Float_IEEE_ZE_64: 00838 case AR_Float_IEEE_UP_64: 00839 case AR_Float_IEEE_DN_64: 00840 result->ar_cplx_ieee64.real = opnd1.ar_ieee64; 00841 result->ar_cplx_ieee64.imag = opnd2.ar_ieee64; 00842 break; 00843 case AR_Float_IEEE_NR_128: 00844 case AR_Float_IEEE_ZE_128: 00845 case AR_Float_IEEE_UP_128: 00846 case AR_Float_IEEE_DN_128: 00847 result->ar_cplx_ieee128.real = opnd1.ar_ieee128; 00848 result->ar_cplx_ieee128.imag = opnd2.ar_ieee128; 00849 break; 00850 default: 00851 return AR_STAT_INVALID_TYPE; 00852 } 00853 00854 return AR_status ((const AR_DATA*)result, resulttype); 00855 } 00856 00857 00858 /* Utility routine to force unused bits to zero. */ 00859 void 00860 ar_clear_unused_bits (ar_data *opnd, const AR_TYPE *opndtype) { 00861 00862 if (AR_CLASS (*opndtype) == AR_CLASS_INT) { 00863 switch (AR_INT_SIZE (*opndtype)) { 00864 case AR_INT_SIZE_8: 00865 ZERO_INT8_UPPER(opnd); 00866 break; 00867 case AR_INT_SIZE_16: 00868 ZERO_INT16_UPPER(opnd); 00869 break; 00870 case AR_INT_SIZE_24: 00871 ZERO_INT24_UPPER(opnd); 00872 break; 00873 case AR_INT_SIZE_32: 00874 ZERO_INT32_UPPER(opnd); 00875 break; 00876 } 00877 return; 00878 } 00879 00880 if (AR_CLASS (*opndtype) == AR_CLASS_POINTER) { 00881 if (AR_POINTER_FORMAT (*opndtype) == AR_POINTER_WORD) { 00882 if (AR_POINTER_SIZE (*opndtype) == AR_POINTER_32) 00883 opnd->ar_i64.part1 = opnd->ar_i64.part2 = 0; 00884 else if(AR_POINTER_SIZE(*opndtype) == AR_POINTER_24) { 00885 opnd->ar_i64.part1 = opnd->ar_i64.part2 = 0; 00886 opnd->ar_i64.part3 &= 0xFF; 00887 } 00888 } 00889 return; 00890 } 00891 00892 ar_internal_error (2004, __FILE__, __LINE__); 00893 } 00894 00895 00896 int 00897 AR_CRAY_64_trunc_bits(int truncbits) 00898 { 00899 if (truncbits < 0 || truncbits >= AR_CRAY64_COEFF_BITS) 00900 return AR_STAT_UNDEFINED; 00901 00902 ar_state_register.ar_truncate_bits = truncbits; 00903 return AR_STAT_OK; 00904 } 00905 00906 00907 void 00908 ar_CRAY_64_trunc(AR_CRAY_64 *opnd) 00909 { 00910 int ntruncated_bits = ar_state_register.ar_truncate_bits; 00911 00912 if (ntruncated_bits < 16) 00913 { 00914 opnd->coeff2 &= ~((1 << ntruncated_bits) - 1); 00915 } 00916 else if (ntruncated_bits < 32) 00917 { 00918 opnd->coeff2 = 0; 00919 opnd->coeff1 &= ~((1 << ntruncated_bits-16) - 1); 00920 } 00921 else if (ntruncated_bits < 48) 00922 { 00923 opnd->coeff2 = 0; 00924 opnd->coeff1 = 0; 00925 opnd->coeff0 &= ~((1 << ntruncated_bits-32) - 1); 00926 } 00927 else 00928 ar_internal_error (2008, __FILE__, __LINE__); 00929 } 00930 00931 /* Routine to generate an invalid result value based on type */ 00932 void 00933 ar_set_invalid_result(ar_data *result, const AR_TYPE *resulttype) 00934 { 00935 switch (AR_CLASS(*resulttype)) { 00936 00937 case AR_CLASS_INT: /* Generate -MAXINT */ 00938 ZERO64(result->ar_i64); 00939 switch (AR_INT_SIZE(*resulttype)) { 00940 case AR_INT_SIZE_8: 00941 result->ar_i8.part5 = 1 << 7; 00942 break; 00943 case AR_INT_SIZE_16: 00944 result->ar_i64.part4 = 1 << 15; 00945 break; 00946 case AR_INT_SIZE_24: 00947 result->ar_i64.part3 = 1 << 7; 00948 break; 00949 case AR_INT_SIZE_32: 00950 result->ar_i64.part3 = 1 << 15; 00951 break; 00952 case AR_INT_SIZE_46: 00953 case AR_INT_SIZE_64: 00954 result->ar_i64.part1 = 1 << 15; 00955 break; 00956 case AR_INT_SIZE_128: 00957 result->ar_i128.part5 = result->ar_i128.part6 = 00958 result->ar_i128.part7 = result->ar_i128.part8 = 0; 00959 result->ar_i128.part1 = 1 << 15; 00960 break; 00961 } 00962 break; 00963 00964 case AR_CLASS_FLOAT: /* Generate -Inf */ 00965 switch (AR_FLOAT_SIZE(*resulttype)) { 00966 case AR_FLOAT_32: 00967 ZEROIEEE32 (result->ar_ieee32); 00968 result->ar_ieee32.expo = AR_IEEE32_MAX_EXPO+1; 00969 break; 00970 case AR_FLOAT_64: 00971 if (AR_FLOAT_FORMAT(*resulttype) == AR_FLOAT_IEEE) { 00972 ZEROIEEE64 (result->ar_ieee64); 00973 result->ar_ieee64.expo = AR_IEEE64_MAX_EXPO+1; 00974 } 00975 else { 00976 ZEROCRAY64(result->ar_f64); 00977 result->ar_f64.expo = AR_CRAY_MAX_EXPO+1; 00978 } 00979 break; 00980 case AR_FLOAT_128: 00981 if (AR_FLOAT_FORMAT(*resulttype) == AR_FLOAT_IEEE) { 00982 ZEROIEEE128 (result->ar_ieee128); 00983 result->ar_ieee128.expo = AR_IEEE128_MAX_EXPO+1; 00984 } 00985 else { 00986 ZEROCRAY128(result->ar_f128); 00987 result->ar_f128.expo = AR_CRAY_MAX_EXPO+1; 00988 } 00989 break; 00990 } 00991 break; 00992 00993 default: /* Generate all 1 bits */ 00994 ZERO64(result->ar_i64); 00995 NEG64(result->ar_i64); 00996 break; 00997 } 00998 } 00999 01000 void 01001 #if defined(__sparc__) || defined(__mips) 01002 ar_nointrin_error_(char* intrin_name) { 01003 char* name = intrin_name; 01004 #else 01005 #define _fcdtocp(f) ((char *)(((long)(f))&0xfc000000ffffffff)) 01006 #define _fcdlen(f) ((unsigned)((((long)(f))>>35)&0x7fffff)) 01007 AR_NOINTRIN_ERROR(char* intrin_name) { 01008 int i; 01009 char* name = _fcdtocp(intrin_name); 01010 for(i=0; i<_fcdlen(intrin_name); i++) 01011 if(!isalnum(name[i])) break; 01012 name[i] = '\0'; 01013 #endif 01014 ar_internal_error(2017, name, 1); 01015 } 01016 01017 void 01018 ar_internal_error (int msgnum, char *file, int line) { 01019 01020 extern char* AR_version; 01021 char nullptr[] = ""; 01022 01023 PRINTMSG(0, msgnum, Internal, 0, file, line, nullptr, nullptr); 01024 } 01025 01026 01027 /* 01028 * What architecture is this? 01029 */ 01030 AR_ARCHITECTURE 01031 ar_host(void) 01032 { 01033 01034 #if defined(__mips) 01035 return AR_Arch_MIPS; 01036 #elif defined(__sun) 01037 return AR_Arch_SPARC; 01038 #else 01039 static int initialized = 0; 01040 static AR_ARCHITECTURE host_arch; 01041 01042 an_mc_table mctable; 01043 AR_HOST_SINT64 pdtword; 01044 AR_HOST_SINT64 pdtstart; 01045 AR_HOST_SINT64 pdtlen; 01046 AR_HOST_SINT64 mctidx; 01047 AR_HOST_SINT64 mctype; 01048 AR_HOST_SINT64 mcdef; 01049 char host_name[9]; 01050 01051 if (!initialized) { 01052 initialized = 1; 01053 01054 host_arch = AR_Arch_Unknown; 01055 01056 if (!GETPMC(mctable, "*host")) { 01057 ar_internal_error(2019, __FILE__, __LINE__); 01058 } 01059 01060 if (!CHECKMC("primary", &pdtword, &pdtstart, &pdtlen, 01061 &mctidx, &mctype, &mcdef, "*HOST")) { 01062 ar_internal_error(2019, __FILE__, __LINE__); 01063 } 01064 01065 strncpy(host_name, (char *) &mctable[mctidx], 8); 01066 host_name[8] = '\0'; 01067 01068 if (strcmp(host_name, "CRAY-XMP") == 0 || 01069 strcmp(host_name, "CRAY-YMP") == 0 || 01070 strcmp(host_name, "CRAY-C90") == 0) { 01071 host_arch = AR_Arch_PVP; 01072 } 01073 else if (strcmp(host_name, "CRAY-TS") == 0) { 01074 (void) CHECKMC("ieee", &pdtword, &pdtstart, &pdtlen, 01075 &mctidx, &mctype, &mcdef, "*HOST"); 01076 if (mctable[mctidx]) { 01077 host_arch = AR_Arch_PVP_IEEE; 01078 } 01079 else { 01080 host_arch = AR_Arch_PVP; 01081 } 01082 } 01083 else if (strcmp(host_name,"CRAY-T3D") == 0) { 01084 host_arch = AR_Arch_T3D; 01085 } 01086 else if (strcmp(host_name,"CRAY-T3E") == 0) { 01087 host_arch = AR_Arch_T3E; 01088 } 01089 } 01090 01091 return host_arch; 01092 #endif 01093 } 01094 01095 01096 static char USMID [] = "\n%Z%%M% %I% %G% %U%\n";