|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
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 /* Conversions to and from strings. */ 00037 00038 #include <string.h> 00039 #include <errno.h> 00040 #include <stdlib.h> 00041 #include <stdio.h> 00042 00043 #include "arith.internal.h" 00044 00045 /* string -> integer */ 00046 int 00047 AR_convert_str_to_int (AR_DATA *res, const AR_TYPE *resulttype, 00048 int *bits_used, const char *str, const int *base) { 00049 00050 ar_data* result = (ar_data*)res; 00051 00052 ar_data baseval, intval, temp; 00053 AR_TYPE u64type = AR_Int_64_U; 00054 int status = AR_STAT_OK; 00055 00056 if (AR_CLASS(*resulttype) != AR_CLASS_INT || 00057 AR_INT_SIZE(*resulttype) == AR_INT_SIZE_128 || 00058 AR_SIGNEDNESS(*resulttype) != AR_UNSIGNED) 00059 return AR_STAT_INVALID_TYPE; 00060 00061 ZERO_INT64(result); 00062 ZERO_INT16_UPPER(&baseval); 00063 00064 switch (*base) { 00065 case 2: 00066 case 8: 00067 case 10: 00068 case 16: 00069 baseval.ar_i64.part4 = *base; 00070 break; 00071 default: 00072 return AR_STAT_UNDEFINED; 00073 } 00074 00075 ZERO_INT64(&intval); 00076 00077 /* Peeled iteration */ 00078 if (*str) { 00079 if (*str >= '0' && *str <= '9') 00080 if (*base > (*str-'0')) 00081 result->ar_i64.part4 = *str - '0'; 00082 else 00083 return AR_STAT_UNDEFINED; 00084 else if (*base != 16) 00085 return AR_STAT_UNDEFINED; 00086 else if (*str >= 'A' && *str <= 'F') 00087 result->ar_i64.part4 = *str - 'A' + 10; 00088 else if (*str >= 'a' && *str <= 'f') 00089 result->ar_i64.part4 = *str - 'a' + 10; 00090 else 00091 return AR_STAT_UNDEFINED; 00092 str++; 00093 } 00094 00095 for (; *str; str++) { 00096 if (*str >= '0' && *str <= '9') 00097 if (*base > (*str-'0')) 00098 intval.ar_i64.part4 = *str - '0'; 00099 else 00100 return AR_STAT_UNDEFINED; 00101 else if (*base != 16) 00102 return AR_STAT_UNDEFINED; 00103 else if (*str >= 'A' && *str <= 'F') 00104 intval.ar_i64.part4 = *str - 'A' + 10; 00105 else if (*str >= 'a' && *str <= 'f') 00106 intval.ar_i64.part4 = *str - 'a' + 10; 00107 else 00108 return AR_STAT_UNDEFINED; 00109 status |= ar_multiply_integer (&temp, &u64type, 00110 result, &u64type, 00111 &baseval, &u64type); 00112 status |= ar_add_integer (result, &u64type, 00113 &temp, &u64type, 00114 &intval, &u64type); 00115 } 00116 00117 if (status & (AR_STAT_UNDEFINED | AR_STAT_INVALID_TYPE)) 00118 ar_internal_error (2002, __FILE__, __LINE__); 00119 00120 /* Check for overflow of result size */ 00121 00122 switch(AR_INT_SIZE(*resulttype)) { 00123 case AR_INT_SIZE_8: 00124 if(!IS_INT8_UPPER_ZERO(result)) 00125 status |= AR_STAT_OVERFLOW; 00126 break; 00127 00128 case AR_INT_SIZE_16: 00129 if(!IS_INT16_UPPER_ZERO(result)) 00130 status |= AR_STAT_OVERFLOW; 00131 break; 00132 00133 case AR_INT_SIZE_24: 00134 if(!IS_INT24_UPPER_ZERO(result)) 00135 status |= AR_STAT_OVERFLOW; 00136 break; 00137 00138 case AR_INT_SIZE_32: 00139 if(!IS_INT32_UPPER_ZERO(result)) 00140 status |= AR_STAT_OVERFLOW; 00141 break; 00142 00143 case AR_INT_SIZE_46: 00144 if(!IS_INT46_UPPER_ZERO(result)) 00145 status |= AR_STAT_OVERFLOW; 00146 break; 00147 } 00148 00149 /* Drop all flags but overflow */ 00150 status &= AR_STAT_OVERFLOW; 00151 00152 if(status) 00153 ar_set_invalid_result(result, resulttype); 00154 else 00155 ar_clear_unused_bits(result, resulttype); 00156 00157 if (bits_used) { 00158 AR_leadz ((AR_DATA*)&temp, &u64type, (AR_DATA*)result, 00159 &u64type); 00160 *bits_used = 64 - temp.ar_i64.part4; 00161 } 00162 00163 switch(AR_INT_SIZE(*resulttype)) { 00164 case AR_INT_SIZE_8: 00165 if (IS_INT8_ZERO(result)) 00166 status |= AR_STAT_ZERO; 00167 break; 00168 00169 case AR_INT_SIZE_16: 00170 if (IS_INT16_ZERO(result)) 00171 status |= AR_STAT_ZERO; 00172 break; 00173 00174 case AR_INT_SIZE_24: 00175 if (IS_INT24_ZERO(result)) 00176 status |= AR_STAT_ZERO; 00177 break; 00178 00179 case AR_INT_SIZE_32: 00180 if (IS_INT32_ZERO(result)) 00181 status |= AR_STAT_ZERO; 00182 break; 00183 00184 case AR_INT_SIZE_46: 00185 if (IS_INT46_ZERO(result)) 00186 status |= AR_STAT_ZERO; 00187 break; 00188 00189 case AR_INT_SIZE_64: 00190 if (IS_INT64_ZERO(result)) 00191 status |= AR_STAT_ZERO; 00192 break; 00193 } 00194 00195 return status; 00196 } 00197 00198 00199 /* integer -> string */ 00200 int 00201 AR_convert_int_to_str (char *resultstr, const int *base, 00202 const AR_DATA *opd, const AR_TYPE *opndtype) { 00203 00204 ar_data* opnd = (ar_data*)opd; 00205 00206 ar_data baseval, intval, divresult, modresult; 00207 AR_TYPE intvaltype; 00208 int i, isnegative, status; 00209 char str [66]; 00210 00211 if (AR_CLASS (*opndtype) != AR_CLASS_INT) 00212 return AR_STAT_INVALID_TYPE; 00213 00214 /* normalize to a 64-bit value */ 00215 if (*base == 10 && AR_SIGNEDNESS (*opndtype) == AR_SIGNED) 00216 intvaltype = AR_Int_64_S; 00217 else 00218 intvaltype = AR_Int_64_U; 00219 ar_convert_to_integral (&intval, &intvaltype, opnd, opndtype); 00220 00221 ZERO_INT16_UPPER(&baseval); 00222 00223 switch (*base) { 00224 case 2: 00225 case 8: 00226 case 10: 00227 case 16: 00228 baseval.ar_i64.part4 = *base; 00229 break; 00230 default: 00231 return AR_STAT_UNDEFINED; 00232 } 00233 00234 if (*base == 10 && 00235 AR_SIGNEDNESS (intvaltype) == AR_SIGNED && 00236 INT64_SIGN(&intval)) { 00237 isnegative = 1; 00238 intvaltype = AR_Int_64_U; 00239 ar_negate_integer (&intval, &intvaltype, &intval, &intvaltype); 00240 } else 00241 isnegative = 0; 00242 00243 i = sizeof (str); 00244 str [--i] = '\0'; 00245 00246 do { 00247 status = ar_divide_integer (&divresult, &intvaltype, 00248 &modresult, &intvaltype, 00249 &intval, &intvaltype, 00250 &baseval, &intvaltype); 00251 if (status & (AR_STAT_UNDEFINED | AR_STAT_INVALID_TYPE)) 00252 ar_internal_error (2003, __FILE__, __LINE__); 00253 str [--i] = modresult.ar_i64.part4 + '0'; 00254 intval = divresult; 00255 } while (!IS_INT64_ZERO(&intval)); 00256 00257 if (isnegative) 00258 str [--i] = '-'; 00259 00260 strcpy (resultstr, str + i); 00261 00262 return AR_STAT_OK; 00263 } 00264 00265 /* string -> floating point (native only) */ 00266 int 00267 ar_cvt_str_to_float (ar_data *result, const AR_TYPE *resulttype, 00268 const char *str) 00269 { 00270 int status = AR_STAT_OK; 00271 char *endptr; 00272 00273 #if _CRAY 00274 00275 /* Note: ar_cvt_str_to_float is called on CRAY systems only when all 00276 * other intrinsic function evaluation has been disabled. 00277 */ 00278 00279 errno = 0; 00280 00281 switch(AR_FLOAT_SIZE(*resulttype)) { 00282 00283 case AR_FLOAT_64: 00284 *((double*)result) = strtod (str, &endptr); 00285 break; 00286 00287 case AR_FLOAT_128: 00288 *((long double*)result) = strtold (str, &endptr); 00289 break; 00290 00291 default: 00292 return AR_STAT_INVALID_TYPE; 00293 } 00294 00295 /* Solaris porting 00296 * to workaround the "_defgu2sd" problem, cut off this 00297 * block and use the default - C standard library function 00298 */ 00299 #elif _Solaris 00300 00301 /* Input conversion precision mode flags */ 00302 00303 #define MODESP 000 /* Single-precision (64-bit) flag */ 00304 #define MODEDP 004 /* Double-precision (128-bit) flag */ 00305 #define MODEHP 020 /* Half-precision (32-bit) flag */ 00306 00307 /* Input conversion exit values */ 00308 00309 #define EX_REAL64 3 /* 64-bit real */ 00310 #define EX_REAL128 4 /* 128-bit real */ 00311 #define EX_REAL32 5 /* 32-bit real */ 00312 #define EX_ILLCHAR -1 /* invalid character */ 00313 #define EX_EXPUFLO -3 /* floating-point underflow */ 00314 #define EX_EXPOFLO -4 /* floating-point overflow */ 00315 #define EX_NULLFLD -5 /* null field (no digits) */ 00316 00317 long fw, d, p; 00318 00319 long* lcap1; 00320 long mode; 00321 long stat; 00322 00323 long ichars[64]; 00324 00325 /* Unpack char string into top of simulated stack space */ 00326 00327 status = ar_unpack_float_str(ichars, 64, &fw, &d, &p, str); 00328 if (IS_ERROR_STATUS(status)) 00329 return status; 00330 00331 switch(AR_FLOAT_SIZE(*resulttype)) { 00332 case AR_FLOAT_32: 00333 ZEROIEEE32 (result->ar_ieee32); 00334 mode = MODEHP; 00335 break; 00336 case AR_FLOAT_64: 00337 ZEROIEEE64 (result->ar_ieee64); 00338 mode = MODESP; 00339 break; 00340 case AR_FLOAT_128: 00341 ZEROIEEE128 (result->ar_ieee128); 00342 mode = MODEDP; 00343 break; 00344 } 00345 00346 if(status == AR_STAT_ZERO) 00347 return AR_STAT_ZERO; 00348 00349 lcap1 = &ichars[fw]; 00350 00351 _defgu2sd(ichars, &fw, &lcap1, &mode, result, &stat, &d, &p); 00352 00353 /* 00354 * Process results returned by defgu2sd. Note that defgu2sd has 00355 * already stored the converted number into result. 00356 */ 00357 00358 switch (stat) { 00359 case EX_REAL32: 00360 result[0].ar_i64.part3 = result[0].ar_i64.part1; 00361 result[0].ar_i64.part4 = result[0].ar_i64.part2; 00362 result[0].ar_i64.part1 = result[0].ar_i64.part2 = 0; 00363 case EX_REAL64: 00364 case EX_REAL128: 00365 status = AR_status((AR_DATA*)result, resulttype); 00366 break; 00367 00368 case EX_EXPUFLO: 00369 switch(AR_FLOAT_SIZE(*resulttype)) { 00370 case AR_FLOAT_32: 00371 ZEROIEEE32 (result->ar_ieee32); 00372 break; 00373 case AR_FLOAT_64: 00374 ZEROIEEE64 (result->ar_ieee64); 00375 break; 00376 case AR_FLOAT_128: 00377 ZEROIEEE128 (result->ar_ieee128); 00378 break; 00379 } 00380 status = AR_STAT_UNDERFLOW|AR_STAT_ZERO; 00381 break; 00382 case EX_EXPOFLO: 00383 status = AR_STAT_OVERFLOW; 00384 break; 00385 default: 00386 status = AR_STAT_UNDEFINED; 00387 break; 00388 } 00389 00390 return status; 00391 00392 #elif defined(__mips) 00393 00394 ar_data dval; 00395 double d; 00396 long double ld; 00397 AR_TYPE float_64 = ((AR_TYPE) UNROUNDED_TYPE(AR_Float_IEEE_NR_64)); 00398 00399 /* Define strtod, which isn't defined in stdlib.h on MIPS. */ 00400 extern double strtod(const char *, char **); 00401 extern long double strtold(const char *, char **); 00402 00403 errno = 0; 00404 00405 switch(AR_FLOAT_SIZE(*resulttype)) { 00406 00407 case AR_FLOAT_32: 00408 d = strtod (str, &endptr); 00409 status = AR_convert((AR_DATA*)result, resulttype, 00410 (AR_DATA*)&d, &float_64); 00411 break; 00412 00413 case AR_FLOAT_64: 00414 d = strtod (str, &endptr); 00415 memcpy(result,&d,sizeof(double)); 00416 break; 00417 00418 case AR_FLOAT_128: 00419 ld = strtold (str, &endptr); 00420 memcpy(result,&ld,sizeof(long double)); 00421 break; 00422 } 00423 00424 if (IS_ERROR_STATUS(status)) 00425 return status; 00426 00427 #else 00428 00429 ar_data dval; 00430 AR_TYPE float_64 = UNROUNDED_TYPE(AR_Float_IEEE_NR_64); 00431 00432 /* Define strtod, which isn't defined in stdlib.h on Suns. */ 00433 extern double strtod(const char *, char **); 00434 00435 errno = 0; 00436 00437 switch(AR_FLOAT_SIZE(*resulttype)) { 00438 00439 case AR_FLOAT_32: 00440 *(double*)(&dval) = strtod (str, &endptr); 00441 status = AR_convert((AR_DATA*)result, resulttype, 00442 (AR_DATA*)&dval, &float_64); 00443 break; 00444 00445 case AR_FLOAT_64: 00446 *((double*)result) = strtod (str, &endptr); 00447 break; 00448 00449 case AR_FLOAT_128: 00450 *(double*)(&dval) = strtod (str, &endptr); 00451 status = AR_convert((AR_DATA*)result, resulttype, 00452 (AR_DATA*)&dval, &float_64); 00453 break; 00454 } 00455 00456 if (IS_ERROR_STATUS(status)) 00457 return status; 00458 #endif 00459 00460 if (*endptr) 00461 /* Conversion stopped before the end of the string */ 00462 return AR_STAT_UNDEFINED; 00463 00464 if (errno == ERANGE) 00465 return AR_STAT_OVERFLOW; 00466 00467 return AR_status((AR_DATA*)result, resulttype) | 00468 (status & AR_STAT_UNDERFLOW); 00469 } 00470 00471 int 00472 ar_unpack_float_str(long* ibuf, long maxbuflen, long* w, long* d, long *p, 00473 const char *str) 00474 { 00475 int i; /* index into unpacked buffer of chars */ 00476 int n; /* numeric value of decimal digit */ 00477 int t; /* power of 10 for converting to digits */ 00478 int x; /* exponent value */ 00479 int z; /* mantissa flag: 1=zero, 0=nonzero, -1=bad */ 00480 00481 *w = 0; /* index into string, width of string */ 00482 *d = 0; /* number of digits after decimal pt */ 00483 *p = 0; /* scale factor */ 00484 i = 0; 00485 00486 /* find first non-space character */ 00487 while (*str == ' ' || 00488 *str == '\f' || 00489 *str == '\n' || 00490 *str == '\r' || 00491 *str == '\t' || 00492 *str == '\v') 00493 str++; 00494 if (*str == '+' || *str == '-') 00495 ibuf[i++] = *str++; 00496 00497 /* scan over leading zero digits */ 00498 if(*str == '0') { 00499 z = 1; /* Flag leading zero digits */ 00500 while(*(++str) == '0') 00501 ; 00502 } 00503 else 00504 z = -1; /* Flag no leading zero digits */ 00505 00506 /* move digits before decimal point to ibuf */ 00507 if (*str >= '0' && *str <= '9'){ 00508 z = 0; /* Flag nonzero digit before dec pt */ 00509 ibuf[i++] = *str++; 00510 while (*str >= '0' && *str <= '9'){ 00511 if (i < (maxbuflen-6)) 00512 ibuf[i++] = *str++; 00513 else { 00514 /* 00515 * Ignore trailing digits of long mantissa, 00516 * but adjust the exponent to compensate 00517 */ 00518 (*p)--; 00519 str++; 00520 } 00521 } 00522 } 00523 00524 /* 00525 * if present, move decimal point, digits after decimal point to ibuf 00526 */ 00527 if (*str == '.') { 00528 /* found decimal point */ 00529 if (i == (maxbuflen-6)) i--; 00530 ibuf[i++] = *str++; 00531 if(z == 1) { /* If all 0 digits before decimal pt */ 00532 while (*str == '0') { 00533 (*p)++; /* Use scale factor to ignore 0's */ 00534 str++; 00535 } 00536 } 00537 while (*str >= '0' && *str <= '9') { 00538 if (i < (maxbuflen-6)) 00539 ibuf[i++] = *str; 00540 str++; 00541 (*d)++; 00542 z = 0; /* Flag nonzero mantissa */ 00543 } 00544 } 00545 00546 if (z == -1) /* if no digits in mantissa */ 00547 return AR_STAT_UNDEFINED; 00548 00549 if (z == 1) { /* if only zero digits in mantissa */ 00550 ibuf[i++] = '0'; 00551 *p = 0; 00552 *w = i; 00553 if(ibuf[0] == '-') 00554 return AR_STAT_NEGATIVE | AR_STAT_ZERO; 00555 else 00556 return AR_STAT_ZERO; 00557 } 00558 00559 /* if present or needs to be adjusted, move exponent to ibuf */ 00560 if (*str == 'e' || *str == 'E') { 00561 ibuf[i++] = 'E'; 00562 str++; 00563 if(*p) { /* If 0's before&after decimal point 00564 * or exp, inc for long mantissa */ 00565 x = atoi(str)-*p; 00566 if(x < 0) { 00567 ibuf[i++] = '-'; 00568 x = -x; 00569 } 00570 if (x < 10) t=1; 00571 else if (x < 100) t=10; 00572 else if (x < 1000) t=100; 00573 else t=1000; 00574 while(t > 1) { 00575 /* 00576 * Store scale-adjusted exponent chars 00577 */ 00578 n = x/t; 00579 x -= (n*t); 00580 t = (t+1)/10; 00581 ibuf[i++] = '0'+n; 00582 } 00583 ibuf[i++] = '0'+x; 00584 if (*str == '+' || *str == '-') 00585 str++; 00586 while (*str >= '0' && *str <= '9') 00587 str++; 00588 *p = 0; 00589 } 00590 else { 00591 if (*str == '+' || *str == '-') 00592 ibuf[i++] = *str++; 00593 while (*str=='0') 00594 str++; 00595 while (*str >= '0' && *str <= '9') { 00596 if (i == maxbuflen) break; 00597 ibuf[i++] = *str++; 00598 } 00599 if ((ibuf[i-1] < '0' || ibuf[i-1] > '9') 00600 && *(str-1)=='0') 00601 ibuf[i++] = '0'; 00602 } 00603 } 00604 00605 if(*str != '\0') /* if string not null-terminated */ 00606 return AR_STAT_UNDEFINED; 00607 00608 *w = i; 00609 00610 return AR_STAT_OK; 00611 } 00612 00613 00614 /* floating point -> string */ 00615 int 00616 AR_convert_float_to_str (char *resultstr, 00617 const AR_DATA *opd, const AR_TYPE *opndtype) { 00618 00619 ar_data* opnd = (ar_data*)opd; 00620 00621 ar_data temp, temp2; 00622 AR_TYPE temptype; 00623 int status = AR_STAT_OK; 00624 00625 #if defined _CRAY && !defined _CRAYMPP 00626 00627 switch (*opndtype) { 00628 case AR_Float_Cray1_64: 00629 case AR_Float_Cray1_64_F: 00630 sprintf (resultstr, "%.14e", opnd->ar_f64); 00631 break; 00632 case AR_Float_Cray1_128: 00633 sprintf (resultstr, "%.27Le", opnd->ar_f128); 00634 break; 00635 case AR_Float_IEEE_NR_32: 00636 case AR_Float_IEEE_ZE_32: 00637 case AR_Float_IEEE_UP_32: 00638 case AR_Float_IEEE_DN_32: 00639 status = AR_status(opd, opndtype); 00640 if (status & AR_STAT_OVERFLOW) 00641 sprintf(resultstr, "%sInf", 00642 (status & AR_STAT_NEGATIVE) ? "-" : "+"); 00643 else if (status & AR_STAT_ZERO) 00644 sprintf(resultstr, "%s%.7e", 00645 (status & AR_STAT_NEGATIVE) ? "-" : "", 0.0); 00646 else if (status & AR_STAT_UNDEFINED) 00647 strcpy(resultstr, "NaN"); 00648 else if (HOST_IS_IEEE_FLOAT) { 00649 status = ar_i32to64 (&temp2.ar_ieee64, 00650 &opnd->ar_ieee32); 00651 sprintf (resultstr, "%.7e", 00652 (*(double *) &temp2.ar_ieee64)); 00653 } 00654 else { 00655 status = ar_i32to64 (&temp2.ar_ieee64, 00656 &opnd->ar_ieee32); 00657 status |= ar_i64toc128 (&temp.ar_f128, 00658 &temp2.ar_ieee64); 00659 sprintf (resultstr, "%.16Le", temp.ar_f128); 00660 } 00661 break; 00662 case AR_Float_IEEE_NR_64: 00663 case AR_Float_IEEE_ZE_64: 00664 case AR_Float_IEEE_UP_64: 00665 case AR_Float_IEEE_DN_64: 00666 status = AR_status(opd, opndtype); 00667 if (status & AR_STAT_OVERFLOW) 00668 sprintf(resultstr, "%sInf", 00669 (status & AR_STAT_NEGATIVE) ? "-" : "+"); 00670 else if (status & AR_STAT_ZERO) 00671 sprintf(resultstr, "%s%.16e", 00672 (status & AR_STAT_NEGATIVE) ? "-" : "", 0.0); 00673 else if (status & AR_STAT_UNDEFINED) 00674 strcpy(resultstr, "NaN"); 00675 else if (HOST_IS_IEEE_FLOAT) { 00676 sprintf (resultstr, "%.16e", 00677 (*(double *) &opnd->ar_ieee64)); 00678 } 00679 else 00680 { 00681 status = ar_i64toc128 (&temp.ar_f128, 00682 &opnd->ar_ieee64); 00683 sprintf (resultstr, "%.16Le", temp.ar_f128); 00684 } 00685 break; 00686 case AR_Float_IEEE_NR_128: 00687 case AR_Float_IEEE_ZE_128: 00688 case AR_Float_IEEE_UP_128: 00689 case AR_Float_IEEE_DN_128: 00690 status = AR_status(opd, opndtype); 00691 if (status & AR_STAT_OVERFLOW) 00692 sprintf(resultstr, "%sInf", 00693 (status & AR_STAT_NEGATIVE) ? "-" : "+"); 00694 else if (status & AR_STAT_ZERO) 00695 sprintf(resultstr, "%s%.34e", 00696 (status & AR_STAT_NEGATIVE) ? "-" : "", 0.0); 00697 else if (status & AR_STAT_UNDEFINED) 00698 strcpy(resultstr, "NaN"); 00699 else if (HOST_IS_IEEE_FLOAT) { 00700 sprintf (resultstr, "%.34Le", 00701 (*(long double *) &opnd->ar_ieee128)); 00702 } 00703 else 00704 { 00705 status = ar_itoc128 (&temp.ar_f128, &opnd->ar_ieee128, 00706 ar_state_register.ar_rounding_mode); 00707 sprintf (resultstr, "%.34Le", temp.ar_f128); 00708 } 00709 break; 00710 default: 00711 return AR_STAT_INVALID_TYPE; 00712 } 00713 00714 return status; 00715 00716 #else 00717 00718 switch (*opndtype) { 00719 case AR_Float_Cray1_64: 00720 case AR_Float_Cray1_64_F: 00721 status |= ar_ctoi64 (&temp.ar_ieee64, &opnd->ar_f64); 00722 sprintf (resultstr, "%.15e", *((double *) &temp.ar_ieee64)); 00723 break; 00724 case AR_Float_Cray1_128: 00725 status |= ar_ctoi64 (&temp.ar_ieee64, &opnd->ar_f64); 00726 sprintf (resultstr, "%.29e", *((double *) &temp.ar_ieee64)); 00727 break; 00728 case AR_Float_IEEE_NR_32: 00729 case AR_Float_IEEE_ZE_32: 00730 case AR_Float_IEEE_UP_32: 00731 case AR_Float_IEEE_DN_32: 00732 status |= ar_i32to64 (&temp.ar_ieee64, &opnd->ar_ieee32); 00733 sprintf(resultstr, "%.7e", *((double *) &temp.ar_ieee64)); 00734 break; 00735 case AR_Float_IEEE_NR_64: 00736 case AR_Float_IEEE_ZE_64: 00737 case AR_Float_IEEE_UP_64: 00738 case AR_Float_IEEE_DN_64: 00739 sprintf(resultstr, "%.16le", *((double*) &opnd->ar_ieee64)); 00740 break; 00741 case AR_Float_IEEE_NR_128: 00742 case AR_Float_IEEE_ZE_128: 00743 case AR_Float_IEEE_UP_128: 00744 case AR_Float_IEEE_DN_128: 00745 /* Use 64-bit output routine for now */ 00746 status |= ar_i128to64 (&temp.ar_ieee64, &opnd->ar_ieee128, 00747 AR_ROUND_NEAREST); 00748 sprintf(resultstr, "%.34le", *((double*) &temp.ar_ieee64)); 00749 break; 00750 default: 00751 return AR_STAT_INVALID_TYPE; 00752 } 00753 00754 return status; 00755 00756 #endif 00757 00758 } 00759 00760 00761 /* string with hexadecimal floating point -> floating point */ 00762 int 00763 AR_convert_hex_str_to_float (AR_DATA *result, const AR_TYPE *resulttype, 00764 const char *str) { 00765 00766 00767 int status = AR_STAT_OK; 00768 AR_DATA temp; 00769 const int base = 16; 00770 int bitsused; 00771 const AR_TYPE result64 = AR_Int_64_U; 00772 char save_char; 00773 char temp_string[17]; 00774 00775 errno = 0; 00776 00777 switch (*resulttype) { 00778 case AR_Float_Cray1_64: 00779 case AR_Float_Cray1_64_F: 00780 case AR_Float_IEEE_NR_32: 00781 case AR_Float_IEEE_ZE_32: 00782 case AR_Float_IEEE_UP_32: 00783 case AR_Float_IEEE_DN_32: 00784 case AR_Float_IEEE_NR_64: 00785 case AR_Float_IEEE_ZE_64: 00786 case AR_Float_IEEE_UP_64: 00787 case AR_Float_IEEE_DN_64: 00788 status = AR_convert_str_to_int(result, &result64, &bitsused, 00789 str, &base); 00790 break; 00791 00792 case AR_Float_IEEE_NR_128: 00793 case AR_Float_IEEE_ZE_128: 00794 case AR_Float_IEEE_UP_128: 00795 case AR_Float_IEEE_DN_128: 00796 case AR_Float_Cray1_128: 00797 strncpy(temp_string, str, 16); 00798 temp_string[16] = '\0'; 00799 status = AR_convert_str_to_int(result, &result64, &bitsused, 00800 temp_string, &base); 00801 status |= AR_convert_str_to_int(&temp, &result64, &bitsused, 00802 str+16, &base); 00803 00804 result->ar_internal_data_item2 = temp.ar_internal_data_item1; 00805 00806 break; 00807 00808 default: 00809 return AR_STAT_INVALID_TYPE; 00810 } 00811 00812 /* return only the AR_STAT_UNDEFINED flag */ 00813 return (status & AR_STAT_UNDEFINED); 00814 } 00815 00816 00817 int 00818 AR_convert_host_sint64_to_int(AR_DATA *result, const AR_TYPE *resulttype, 00819 AR_HOST_SINT64 i64val) 00820 { 00821 00822 AR_TYPE s64type = AR_Int_64_S; 00823 00824 if (AR_CLASS(*resulttype) != AR_CLASS_INT) 00825 return AR_STAT_INVALID_TYPE; 00826 00827 result->ar_internal_data_item1 = i64val; 00828 00829 return (AR_convert(result, resulttype, result, &s64type)); 00830 } /* AR_convert_host_sint64_to_int */ 00831 00832 00833 int 00834 AR_convert_int_to_host_sint64(AR_HOST_SINT64 *i64val, 00835 const AR_DATA *opnd, const AR_TYPE *opndtype) 00836 { 00837 int status; 00838 AR_TYPE s64type = AR_Int_64_S; 00839 AR_DATA s64val; 00840 00841 if (AR_CLASS(*opndtype) != AR_CLASS_INT) 00842 return AR_STAT_INVALID_TYPE; 00843 00844 status = AR_convert(&s64val, &s64type, opnd, opndtype); 00845 00846 *i64val = s64val.ar_internal_data_item1; 00847 00848 return (status); 00849 } /* AR_convert_int_to_host_int64 */ 00850 00851 00852 static char USMID [] = "\n%Z%%M% %I% %G% %U%\n";
1.7.6.1 
