|
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 between types */ 00037 00038 #include "arith.internal.h" 00039 00040 00041 int 00042 ar_convert_to_integral 00043 (ar_data *result, const AR_TYPE *resulttype, 00044 const ar_data *opnd, const AR_TYPE *opndtype) { 00045 00046 int status = AR_STAT_OK; 00047 int maxnegint; 00048 int rsltsz, opndsz; 00049 00050 if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT) { 00051 switch (*opndtype) { 00052 case AR_Float_Cray1_64: 00053 case AR_Float_Cray1_64_F: 00054 status = ar_cfix64 (&result->ar_i64, &opnd->ar_f64, 64); 00055 break; 00056 case AR_Float_Cray1_128: 00057 status = ar_cfix128 (&result->ar_i64, 00058 &opnd->ar_f128, 64); 00059 break; 00060 case AR_Float_IEEE_NR_32: 00061 case AR_Float_IEEE_ZE_32: 00062 case AR_Float_IEEE_UP_32: 00063 case AR_Float_IEEE_DN_32: 00064 status = ar_ifix32 (&result->ar_i64, &opnd->ar_ieee32, 00065 64, ROUND_MODE (*opndtype)); 00066 break; 00067 case AR_Float_IEEE_NR_64: 00068 case AR_Float_IEEE_ZE_64: 00069 case AR_Float_IEEE_UP_64: 00070 case AR_Float_IEEE_DN_64: 00071 status = ar_ifix64 (&result->ar_i64, &opnd->ar_ieee64, 00072 64, ROUND_MODE (*opndtype)); 00073 break; 00074 case AR_Float_IEEE_NR_128: 00075 case AR_Float_IEEE_ZE_128: 00076 case AR_Float_IEEE_UP_128: 00077 case AR_Float_IEEE_DN_128: 00078 status = ar_ifix128 (&result->ar_i64, &opnd->ar_ieee128, 00079 64, ROUND_MODE (*opndtype)); 00080 break; 00081 case AR_Complex_Cray1_64: 00082 case AR_Complex_Cray1_64_F: 00083 status = ar_cfix64 (&result->ar_i64, 00084 &opnd->ar_cplx_f64.real, 64); 00085 break; 00086 case AR_Complex_Cray1_128: 00087 status = ar_cfix128 (&result->ar_i64, 00088 &opnd->ar_cplx_f128.real, 64); 00089 break; 00090 case AR_Complex_IEEE_NR_32: 00091 case AR_Complex_IEEE_ZE_32: 00092 case AR_Complex_IEEE_UP_32: 00093 case AR_Complex_IEEE_DN_32: 00094 { 00095 AR_IEEE_32 realpart; 00096 00097 CPLX32_REAL_TO_IEEE32(realpart, opnd->ar_cplx_ieee32); 00098 status = ar_ifix32 (&result->ar_i64, &realpart, 00099 64, ROUND_MODE (*opndtype)); 00100 break; 00101 } 00102 case AR_Complex_IEEE_NR_64: 00103 case AR_Complex_IEEE_ZE_64: 00104 case AR_Complex_IEEE_UP_64: 00105 case AR_Complex_IEEE_DN_64: 00106 status = ar_ifix64 (&result->ar_i64, 00107 &opnd->ar_cplx_ieee64.real, 00108 64, ROUND_MODE (*opndtype)); 00109 break; 00110 case AR_Complex_IEEE_NR_128: 00111 case AR_Complex_IEEE_ZE_128: 00112 case AR_Complex_IEEE_UP_128: 00113 case AR_Complex_IEEE_DN_128: 00114 status = ar_ifix128(&result->ar_i64, 00115 &opnd->ar_cplx_ieee128.real, 00116 64, ROUND_MODE (*opndtype)); 00117 break; 00118 00119 default: 00120 return AR_STAT_INVALID_TYPE; 00121 } 00122 00123 } 00124 00125 else if (AR_CLASS (*opndtype) == AR_CLASS_POINTER) { 00126 result->ar_i64 = opnd->ar_i64; 00127 } 00128 00129 else if (AR_CLASS (*opndtype) == AR_CLASS_INT) { 00130 result->ar_i64 = opnd->ar_i64; 00131 opndsz = AR_INT_SIZE(*opndtype); 00132 if(opndsz == AR_INT_SIZE_46) opndsz = AR_INT_SIZE_64; 00133 rsltsz = AR_INT_SIZE(*resulttype); 00134 if(rsltsz == AR_INT_SIZE_46) rsltsz = AR_INT_SIZE_64; 00135 00136 if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED) { 00137 /* operand is signed; sign extend to 64-bit int */ 00138 if (opndsz == AR_INT_SIZE_8 && INT8_SIGN(opnd)) { 00139 /* 8-bit operand is negative; extend the sign */ 00140 maxnegint = IS_INT8_UPPER_ZERO(opnd) && 00141 (opnd->ar_i8.part5 == 0x80); 00142 result->ar_i8.part1 = 0xFFFF; 00143 result->ar_i8.part2 = 0xFFFF; 00144 result->ar_i8.part3 = 0xFFFF; 00145 result->ar_i8.part4 = 0xFF; 00146 } 00147 else if (opndsz == AR_INT_SIZE_16 && INT16_SIGN(opnd)) { 00148 maxnegint = IS_INT16_UPPER_ZERO(opnd) && 00149 (opnd->ar_i64.part4 == 0x8000); 00150 /* 16-bit operand is negative; extend the sign*/ 00151 result->ar_i64.part1 = 0xFFFF; 00152 result->ar_i64.part2 = 0xFFFF; 00153 result->ar_i64.part3 = 0xFFFF; 00154 } 00155 else if (opndsz == AR_INT_SIZE_24 && INT24_SIGN(opnd)) { 00156 maxnegint = IS_INT24_UPPER_ZERO(opnd) && 00157 (opnd->ar_i64.part3 == 0x80) && 00158 (opnd->ar_i64.part4 == 0x0); 00159 /* 24-bit operand is negative; extend the sign*/ 00160 result->ar_i64.part1 = 0xFFFF; 00161 result->ar_i64.part2 = 0xFFFF; 00162 result->ar_i64.part3 |= 0xFF00; 00163 } 00164 else if (opndsz == AR_INT_SIZE_32 && INT32_SIGN(opnd)) { 00165 maxnegint = IS_INT32_UPPER_ZERO(opnd) && 00166 (opnd->ar_i64.part3 == 0x8000) && 00167 (opnd->ar_i64.part4 == 0); 00168 /* 32-bit operand is negative; extend the sign*/ 00169 result->ar_i64.part1 = 0xFFFF; 00170 result->ar_i64.part2 = 0xFFFF; 00171 } 00172 else 00173 maxnegint = (opnd->ar_i64.part1 == 0x8000) && 00174 (opnd->ar_i64.part2 == 0) && 00175 (opnd->ar_i64.part3 == 0) && 00176 (opnd->ar_i64.part4 == 0); 00177 00178 if ((result->ar_i64.part1 & 0x8000) && 00179 (AR_SIGNEDNESS (*resulttype) == AR_UNSIGNED)) { 00180 /* operand is negative and result is unsigned; 00181 original value cannot be preserved */ 00182 if(opndsz == rsltsz) 00183 status |= AR_STAT_SEMIVALID; 00184 if(opndsz != rsltsz || !maxnegint) 00185 status |= AR_STAT_OVERFLOW; 00186 } 00187 } 00188 else if (AR_SIGNEDNESS(*resulttype) == AR_SIGNED && rsltsz == opndsz) { 00189 /* operand is unsigned, same size result is signed */ 00190 switch (AR_INT_SIZE (*opndtype)) { 00191 case AR_INT_SIZE_8: 00192 if (INT8_SIGN(opnd)) { 00193 status |= AR_STAT_SEMIVALID; 00194 if(opnd->ar_i8.part5 != 0x80) 00195 status |= AR_STAT_OVERFLOW; 00196 } 00197 break; 00198 00199 case AR_INT_SIZE_16: 00200 if (INT16_SIGN(opnd)) { 00201 status |= AR_STAT_SEMIVALID; 00202 if(opnd->ar_i64.part4 != 0x8000) 00203 status |= AR_STAT_OVERFLOW; 00204 } 00205 break; 00206 00207 case AR_INT_SIZE_24: 00208 if (INT24_SIGN(opnd)) { 00209 status |= AR_STAT_SEMIVALID; 00210 if(opnd->ar_i64.part3 != 0x80 || 00211 opnd->ar_i64.part4 != 0) 00212 status |= AR_STAT_OVERFLOW; 00213 } 00214 break; 00215 00216 case AR_INT_SIZE_32: 00217 if (INT32_SIGN(opnd)) { 00218 status |= AR_STAT_SEMIVALID; 00219 if(opnd->ar_i64.part3 != 0x8000 || 00220 opnd->ar_i64.part4 != 0) 00221 status |= AR_STAT_OVERFLOW; 00222 } 00223 break; 00224 00225 case AR_INT_SIZE_46: 00226 case AR_INT_SIZE_64: 00227 if(INT64_SIGN(opnd)) { 00228 status |= AR_STAT_SEMIVALID; 00229 if(opnd->ar_i64.part1 != 0x8000 || 00230 opnd->ar_i64.part2 != 0 || 00231 opnd->ar_i64.part3 != 0 || 00232 opnd->ar_i64.part4 != 0) 00233 status |= AR_STAT_OVERFLOW; 00234 } 00235 break; 00236 00237 default: 00238 return (AR_STAT_INVALID_TYPE); 00239 } 00240 00241 if(status & (AR_STAT_SEMIVALID | AR_STAT_OVERFLOW)) 00242 status |= AR_STAT_NEGATIVE; 00243 } 00244 else { 00245 /* operand is unsigned and result is different size */ 00246 if (INT64_SIGN(result) && 00247 (AR_SIGNEDNESS(*resulttype) == AR_SIGNED)) { 00248 /* result is negative; we have overflow */ 00249 status |= AR_STAT_OVERFLOW; 00250 } 00251 } 00252 } 00253 else 00254 return AR_STAT_INVALID_TYPE; 00255 00256 /* At this point, regardless of the original operand type, we've converted 00257 it to a 64-bit int. Now, check for overflow, negative. */ 00258 00259 if(!(status & AR_STAT_SEMIVALID)) 00260 switch (*resulttype) { 00261 case AR_Int_8_S: 00262 if (!(result->ar_i8.part1 == 0xffff && 00263 result->ar_i8.part2 == 0xffff && 00264 result->ar_i8.part3 == 0xffff && 00265 result->ar_i8.part4 == 0xff && 00266 INT8_SIGN(result) == 0x80)&& 00267 !(IS_INT8_UPPER_ZERO(result) && 00268 INT8_SIGN(result) == 0)) { 00269 status |= AR_STAT_OVERFLOW; 00270 } 00271 if (INT8_SIGN(result)) 00272 status |= AR_STAT_NEGATIVE; 00273 break; 00274 00275 case AR_Int_8_U: 00276 if (!IS_INT8_UPPER_ZERO(result)) { 00277 status |= AR_STAT_OVERFLOW; 00278 } 00279 break; 00280 00281 case AR_Int_16_S: 00282 if (!(result->ar_i64.part1 == 0xffff && 00283 result->ar_i64.part2 == 0xffff && 00284 result->ar_i64.part3 == 0xffff && 00285 INT16_SIGN(result) == 0x8000)&& 00286 !(IS_INT16_UPPER_ZERO(result) && 00287 INT16_SIGN(result) == 0)) { 00288 status |= AR_STAT_OVERFLOW; 00289 } 00290 if (INT16_SIGN(result)) 00291 status |= AR_STAT_NEGATIVE; 00292 break; 00293 00294 case AR_Int_16_U: 00295 if (!IS_INT16_UPPER_ZERO(result)) { 00296 status |= AR_STAT_OVERFLOW; 00297 } 00298 break; 00299 00300 case AR_Int_24_S: 00301 if (!(result->ar_i64.part1 == 0xffff && 00302 result->ar_i64.part2 == 0xffff && 00303 (result->ar_i64.part3&0xff00) == 0xff00 && 00304 INT24_SIGN(result) == 0x0080)&& 00305 !(IS_INT24_UPPER_ZERO(result) && 00306 INT24_SIGN(result) == 0)) { 00307 status |= AR_STAT_OVERFLOW; 00308 } 00309 if (INT24_SIGN(result)) 00310 status |= AR_STAT_NEGATIVE; 00311 break; 00312 00313 case AR_Int_24_U: 00314 if (!IS_INT24_UPPER_ZERO(result)) { 00315 status |= AR_STAT_OVERFLOW; 00316 } 00317 break; 00318 00319 case AR_Int_32_S: 00320 if (!(result->ar_i64.part1 == 0xffff && 00321 result->ar_i64.part2 == 0xffff && 00322 INT32_SIGN(result) == 0x8000)&& 00323 !(IS_INT32_UPPER_ZERO(result) && 00324 INT32_SIGN(result) == 0)) { 00325 status |= AR_STAT_OVERFLOW; 00326 } 00327 if (INT32_SIGN(result)) 00328 status |= AR_STAT_NEGATIVE; 00329 00330 break; 00331 00332 case AR_Int_32_U: 00333 if (!IS_INT32_UPPER_ZERO(result)) { 00334 status |= AR_STAT_OVERFLOW; 00335 } 00336 break; 00337 00338 case AR_Int_46_S: 00339 if (INT_OVERFLOWS_46_BITS(*result)) 00340 status |= AR_STAT_OVERFLOW; 00341 if (INT64_SIGN(result)) 00342 status |= AR_STAT_NEGATIVE; 00343 break; 00344 00345 case AR_Int_64_S: 00346 if (INT64_SIGN(result)) 00347 status |= AR_STAT_NEGATIVE; 00348 break; 00349 } 00350 00351 ar_clear_unused_bits(result, resulttype); 00352 00353 if (IS_INT64_ZERO(result)) 00354 status |= AR_STAT_ZERO; 00355 00356 return status; 00357 } 00358 00359 static 00360 int 00361 ar_convert_to_pointer 00362 (ar_data *result, const AR_TYPE *resulttype, 00363 const ar_data *opnd, const AR_TYPE *opndtype) { 00364 00365 AR_TYPE unsigned_word_type = AR_Int_64_U; 00366 00367 00368 if (AR_CLASS (*opndtype) == AR_CLASS_INT) 00369 /* for some reason, we don't sign extend when converting to a 00370 word pointer, but we do if converting to other pointers... */ 00371 if (AR_POINTER_FORMAT (*resulttype) != AR_POINTER_WORD) { 00372 ar_convert_to_integral (result, &unsigned_word_type, 00373 opnd, opndtype); 00374 } 00375 else { 00376 result->ar_i64 = opnd->ar_i64; 00377 } 00378 00379 else if (AR_CLASS (*opndtype) == AR_CLASS_POINTER) { 00380 00381 result->ar_i64 = opnd->ar_i64; 00382 if (*resulttype == *opndtype) 00383 return AR_STAT_OK; 00384 /* if either the result or the operand is a byte pointer 00385 (and the other isn't from the previous test): ERROR */ 00386 if (*resulttype == AR_Pointer_Byte || 00387 *opndtype == AR_Pointer_Byte) 00388 return AR_STAT_INVALID_TYPE; 00389 00390 if (AR_POINTER_FORMAT (*resulttype) == AR_POINTER_WORD) { 00391 if (AR_POINTER_FORMAT (*opndtype) == AR_POINTER_FCTN) { 00392 /* convert parcel address to word address */ 00393 ar_dblshift(result, &unsigned_word_type, 00394 (const ar_data*)&AR_const_zero, result, 2); 00395 } 00396 00397 } else if (AR_POINTER_FORMAT (*resulttype) == AR_POINTER_FCTN) { 00398 if (AR_POINTER_FORMAT (*opndtype) == AR_POINTER_WORD) { 00399 /* convert word address to parcel address */ 00400 ar_dblshift(result, &unsigned_word_type, 00401 (const ar_data*)&AR_const_zero, result, 126); 00402 } 00403 } 00404 } else 00405 return AR_STAT_INVALID_TYPE; 00406 00407 ar_clear_unused_bits (result, resulttype); 00408 return AR_STAT_OK; 00409 } 00410 00411 int 00412 ar_convert_to_float 00413 (ar_data *result, const AR_TYPE *resulttype, 00414 const ar_data *opnd, const AR_TYPE *opndtype) { 00415 00416 ar_data re, im, sint64; 00417 AR_TYPE reimtype, sint64type = AR_Int_64_S; 00418 int status = AR_STAT_OK; 00419 00420 if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT) { 00421 00422 if (AR_FLOAT_IS_COMPLEX (*opndtype) == AR_FLOAT_COMPLEX) 00423 status |= ar_decompose_complex (&re, &im, &reimtype, 00424 opnd, opndtype); 00425 else { 00426 re = *opnd; 00427 reimtype = *opndtype; 00428 } 00429 00430 if (AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_CRAY) 00431 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) 00432 if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) 00433 if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) 00434 status |= ar_itoc64 (&result->ar_f64, &re.ar_ieee64, AR_ROUND_NEAREST); 00435 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) { 00436 status |= ar_i32to64 (&im.ar_ieee64, &re.ar_ieee32); 00437 status |= ar_itoc64 (&result->ar_f64, &im.ar_ieee64, AR_ROUND_NEAREST); 00438 } else 00439 return AR_STAT_INVALID_TYPE; 00440 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) { 00441 result->ar_f64 = re.ar_f64; 00442 status = AR_status ((AR_DATA*)result, resulttype); 00443 } else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) 00444 status |= ar_c128to64 (&result->ar_f64, 00445 &re.ar_f128); 00446 else 00447 return AR_STAT_INVALID_TYPE; 00448 else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) 00449 if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) 00450 if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) 00451 status |= ar_i64toc128 (&result->ar_f128, &re.ar_ieee64); 00452 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) { 00453 status |= ar_i32to64 (&im.ar_ieee64, &re.ar_ieee32); 00454 status |= ar_i64toc128 (&result->ar_f128, &im.ar_ieee64); 00455 } else 00456 return AR_STAT_INVALID_TYPE; 00457 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) { 00458 result->ar_f128 = re.ar_f128; 00459 status = AR_status ((AR_DATA*)result, resulttype); 00460 } else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) 00461 status |= ar_c64to128 (&result->ar_f128, 00462 &re.ar_f64); 00463 else 00464 return AR_STAT_INVALID_TYPE; 00465 else 00466 return AR_STAT_INVALID_TYPE; 00467 00468 else { 00469 /* AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_IEEE */ 00470 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_32) { 00471 if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) { 00472 if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) { 00473 result->ar_ieee32 = re.ar_ieee32; 00474 status |= AR_status ((AR_DATA*)result, resulttype); 00475 } else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) 00476 status |= ar_i64to32 (&result->ar_ieee32, &re.ar_ieee64, AR_ROUND_NEAREST); 00477 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) { 00478 status |= ar_i128to64 (&im.ar_ieee64, &re.ar_ieee128, AR_ROUND_NEAREST); 00479 status |= ar_i64to32 (&result->ar_ieee32, &im.ar_ieee64, AR_ROUND_NEAREST); 00480 } 00481 else 00482 return AR_STAT_INVALID_TYPE; 00483 } 00484 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) { 00485 status |= ar_c128toi64 (&im.ar_ieee64, &re.ar_f128); 00486 status |= ar_i64to32 (&result->ar_ieee32, &im.ar_ieee64, AR_ROUND_NEAREST); 00487 } else { 00488 status |= ar_ctoi64 (&im.ar_ieee64, &re.ar_f64); 00489 status |= ar_i64to32 (&result->ar_ieee32, &im.ar_ieee64, AR_ROUND_NEAREST); 00490 } 00491 } 00492 else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) { 00493 if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) { 00494 if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) 00495 status |= ar_i32to64 (&result->ar_ieee64, &re.ar_ieee32); 00496 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) { 00497 result->ar_ieee64 = re.ar_ieee64; 00498 return AR_status ((AR_DATA*)result, resulttype); 00499 } 00500 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) 00501 status |= ar_i128to64 (&result->ar_ieee64, &re.ar_ieee128, AR_ROUND_NEAREST); 00502 else 00503 return AR_STAT_INVALID_TYPE; 00504 } 00505 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) { 00506 status |= ar_ctoi128 (&im.ar_ieee128, &re.ar_f128); 00507 status |= ar_i128to64 (&result->ar_ieee64, &im.ar_ieee128, AR_ROUND_NEAREST); 00508 } 00509 else { 00510 status |= ar_ctoi64 (&result->ar_ieee64, &re.ar_f64); 00511 } 00512 } 00513 00514 else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) { 00515 if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) { 00516 if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) { 00517 status |= ar_i32to64 (&im.ar_ieee64, &re.ar_ieee32); 00518 status |= ar_i64to128 (&result->ar_ieee128, &im.ar_ieee64); 00519 } 00520 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) 00521 status |= ar_i64to128 (&result->ar_ieee128, &re.ar_ieee64); 00522 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) { 00523 result->ar_ieee128 = re.ar_ieee128; 00524 return AR_status ((AR_DATA*)result, resulttype); 00525 } 00526 else 00527 return AR_STAT_INVALID_TYPE; 00528 } 00529 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) 00530 status |= ar_ctoi128 (&result->ar_ieee128, &re.ar_f128); 00531 else { 00532 status |= ar_ctoi64 (&im.ar_ieee64, &re.ar_f64); 00533 status |= ar_i64to128(&result->ar_ieee128, &im.ar_ieee64); 00534 } 00535 } 00536 00537 else if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_CRAY) 00538 if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) 00539 status |= ar_c128toi64 (&result->ar_ieee64, &re.ar_f128); 00540 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) 00541 status |= ar_ctoi64 (&result->ar_ieee64, &re.ar_f64); 00542 else 00543 return AR_STAT_INVALID_TYPE; 00544 else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) 00545 status |= ar_i32to64 (&result->ar_ieee64, &re.ar_ieee32); 00546 else { 00547 result->ar_ieee64 = re.ar_ieee64; 00548 status = AR_status ((AR_DATA*)result, resulttype); 00549 } 00550 } 00551 00552 } else if (AR_CLASS (*opndtype) == AR_CLASS_INT) { 00553 00554 /* Convert to signed 64-bit (ignoring status) */ 00555 ar_convert_to_integral (&sint64, &sint64type, opnd, opndtype); 00556 00557 switch (*resulttype) { 00558 case AR_Float_Cray1_64: 00559 case AR_Float_Cray1_64_F: 00560 status |= ar_cflt64 (&result->ar_f64, &sint64.ar_i64, 00561 AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED); 00562 break; 00563 case AR_Float_Cray1_128: 00564 status |= ar_cflt128 (&result->ar_f128, &sint64.ar_i64, 00565 AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED); 00566 break; 00567 case AR_Float_IEEE_NR_32: 00568 case AR_Float_IEEE_ZE_32: 00569 case AR_Float_IEEE_UP_32: 00570 case AR_Float_IEEE_DN_32: 00571 status |= ar_iflt32 (&result->ar_ieee32, &sint64.ar_i64, 00572 AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED, 00573 ROUND_MODE (*resulttype)); 00574 break; 00575 case AR_Float_IEEE_NR_64: 00576 case AR_Float_IEEE_ZE_64: 00577 case AR_Float_IEEE_UP_64: 00578 case AR_Float_IEEE_DN_64: 00579 status |= ar_iflt64 (&result->ar_ieee64, &sint64.ar_i64, 00580 AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED, 00581 ROUND_MODE (*resulttype)); 00582 break; 00583 case AR_Float_IEEE_NR_128: 00584 case AR_Float_IEEE_ZE_128: 00585 case AR_Float_IEEE_UP_128: 00586 case AR_Float_IEEE_DN_128: 00587 status |= ar_iflt128 (&result->ar_ieee128, &sint64.ar_i64, 00588 AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED, 00589 ROUND_MODE (*resulttype)); 00590 break; 00591 default: 00592 return AR_STAT_INVALID_TYPE; 00593 } 00594 00595 } else 00596 return AR_STAT_INVALID_TYPE; 00597 00598 return status; 00599 } 00600 00601 00602 int 00603 ar_convert_to_complex 00604 (ar_data *result, const AR_TYPE *resulttype, 00605 const ar_data *opnd, const AR_TYPE *opndtype) { 00606 00607 ar_data from, re, im, cre, cim; 00608 AR_TYPE reimtype, parttype, temptype; 00609 int status = AR_STAT_OK, restat, imstat; 00610 00611 parttype = (AR_TYPE) (*resulttype ^ AR_FLOAT_COMPLEX); 00612 00613 if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT && 00614 AR_FLOAT_IS_COMPLEX (*opndtype) == AR_FLOAT_COMPLEX) { 00615 status |= ar_decompose_complex (&re, &im, &reimtype, 00616 opnd, opndtype); 00617 restat = ar_convert_to_float (&cre, &parttype, &re, &reimtype); 00618 imstat = ar_convert_to_float (&cim, &parttype, &im, &reimtype); 00619 status |= ar_compose_complex (result, &temptype, 00620 &cre, &cim, &parttype); 00621 status &= ~(AR_STAT_ZERO | AR_STAT_NEGATIVE); 00622 status |= restat & imstat & AR_STAT_ZERO; 00623 return status; 00624 } 00625 00626 status |= ar_convert_to_float (&cre, &parttype, opnd, opndtype); 00627 00628 switch (*resulttype) { 00629 case AR_Complex_Cray1_64: 00630 case AR_Complex_Cray1_64_F: 00631 result->ar_cplx_f64.real = cre.ar_f64; 00632 ZEROCRAY64 (result->ar_cplx_f64.imag); 00633 break; 00634 case AR_Complex_Cray1_128: 00635 result->ar_cplx_f128.real = cre.ar_f128; 00636 ZEROCRAY128 (result->ar_cplx_f128.imag); 00637 break; 00638 case AR_Complex_IEEE_NR_32: 00639 case AR_Complex_IEEE_ZE_32: 00640 case AR_Complex_IEEE_UP_32: 00641 case AR_Complex_IEEE_DN_32: 00642 IEEE32_TO_CPLX32_REAL(result->ar_cplx_ieee32, cre.ar_ieee32); 00643 result->ar_cplx_ieee32.isign = 0; 00644 result->ar_cplx_ieee32.iexpo = 0; 00645 result->ar_cplx_ieee32.icoeff0 = 0; 00646 result->ar_cplx_ieee32.icoeff1 = 0; 00647 break; 00648 case AR_Complex_IEEE_NR_64: 00649 case AR_Complex_IEEE_ZE_64: 00650 case AR_Complex_IEEE_UP_64: 00651 case AR_Complex_IEEE_DN_64: 00652 result->ar_cplx_ieee64.real = cre.ar_ieee64; 00653 ZEROIEEE64 (result->ar_cplx_ieee64.imag); 00654 break; 00655 case AR_Complex_IEEE_NR_128: 00656 case AR_Complex_IEEE_ZE_128: 00657 case AR_Complex_IEEE_UP_128: 00658 case AR_Complex_IEEE_DN_128: 00659 result->ar_cplx_ieee128.real = cre.ar_ieee128; 00660 ZEROIEEE128 (result->ar_cplx_ieee128.imag); 00661 break; 00662 default: 00663 return AR_STAT_INVALID_TYPE; 00664 } 00665 00666 return status; 00667 } 00668 00669 00670 /* General dispatch routine for numeric conversions. */ 00671 int 00672 AR_convert 00673 (AR_DATA *res, const AR_TYPE *resulttype, 00674 const AR_DATA *opd, const AR_TYPE *opndtype) { 00675 00676 ar_data* result = (ar_data*)res; 00677 ar_data* opnd = (ar_data*)opd; 00678 00679 if (AR_CLASS (*resulttype) == AR_CLASS_INT) 00680 return ar_convert_to_integral (result, resulttype, opnd, opndtype); 00681 00682 if (AR_CLASS (*resulttype) == AR_CLASS_POINTER) 00683 return ar_convert_to_pointer (result, resulttype, opnd, opndtype); 00684 00685 if (AR_CLASS (*resulttype) == AR_CLASS_FLOAT) 00686 if (AR_FLOAT_IS_COMPLEX (*resulttype) == AR_FLOAT_COMPLEX) 00687 return ar_convert_to_complex (result, resulttype, opnd, opndtype); 00688 else 00689 return ar_convert_to_float (result, resulttype, opnd, opndtype); 00690 00691 return AR_STAT_INVALID_TYPE; 00692 } 00693 00694 00695 /* Weird "round_int_div" operation */ 00696 int 00697 AR_round_int_div 00698 (AR_DATA *res, const AR_TYPE *resulttype, 00699 const AR_DATA *opd, const AR_TYPE *opndtype) { 00700 00701 ar_data* result = (ar_data*)res; 00702 ar_data* opnd = (ar_data*)opd; 00703 00704 if (*resulttype != *opndtype) 00705 return AR_STAT_INVALID_TYPE; 00706 00707 if (*resulttype == AR_Float_Cray1_64 || 00708 *resulttype == AR_Float_Cray1_64_F) 00709 return ar_crnd64 (&result->ar_f64, &opnd->ar_f64); 00710 else if (*resulttype == AR_Float_Cray1_128) 00711 return ar_crnd128 (&result->ar_f128, &opnd->ar_f128); 00712 else 00713 return AR_STAT_INVALID_TYPE; 00714 } 00715 00716 00717 static char USMID [] = "\n%Z%%M% %I% %G% %U%\n"; 00718 static char rcsid [] = "$Id: cvt.c,v 1.1.1.1 2002-05-22 20:06:18 dsystem Exp $";
1.7.6.1 
