00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
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
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
00086
00087 ar_state_info ar_state_register = { 0, 0, 0, 0, 0, 0, 0, 0 };
00088
00089
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
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
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
00161
00162 int
00163 AR_get_floating_point_format()
00164 {
00165 return ar_state_register.ar_float_format;
00166 }
00167
00168
00169
00170 int
00171 AR_get_128bit_format()
00172 {
00173 return ar_state_register.ar_128bit_format;
00174 }
00175
00176
00177
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
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
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
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;
00399 else if (opnd->ar_ieee32.sign)
00400 status |= AR_STAT_OVERFLOW |
00401 AR_STAT_NEGATIVE;
00402 else
00403 status |= AR_STAT_OVERFLOW;
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;
00418 else if (opnd->ar_ieee64.sign)
00419 status |= AR_STAT_OVERFLOW |
00420 AR_STAT_NEGATIVE;
00421 else
00422 status |= AR_STAT_OVERFLOW;
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;
00438 else if (opnd->ar_mips128.sign)
00439 status |= AR_STAT_OVERFLOW |
00440 AR_STAT_NEGATIVE;
00441 else
00442 status |= AR_STAT_OVERFLOW;
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;
00455 else if (opnd->ar_ieee128.sign)
00456 status |= AR_STAT_OVERFLOW |
00457 AR_STAT_NEGATIVE;
00458 else
00459 status |= AR_STAT_OVERFLOW;
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
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
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
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
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
00759 return AR_STAT_INVALID_TYPE;
00760 }
00761
00762
00763
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
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
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
00803
00804
00805
00806
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
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
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:
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:
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:
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
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";
