Open64: osprey/arith/miscmath.c Source File

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