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 /* ==================================================================== 00037 * ==================================================================== 00038 * 00039 * 00040 * Revision history: 00041 * 12-Jun-91 - Original Version 00042 * 00043 * Description: 00044 * 00045 * Target constant handling. 00046 * 00047 * Routines in this file are supposed to do operations of compile time 00048 * constants in a host independent way. There whould be one version of 00049 * this file for each <host, target> pair. Using these routines, the 00050 * compiler should be able to guarantee that the same source will give 00051 * same object, no matter which machine the compiler is hosted on. 00052 * 00053 * TCON is a data type used to represent all scalar and string 00054 * compile-time constants. Its internals should be visible only inside 00055 * this file. To facilitate constant operations, we probably want to 00056 * keep constants in something resembling the host representation, but 00057 * that is not necessary for the rest of the compiler. The routines 00058 * below must be consistent among themselves in interpreting TCON and 00059 * doing operations on them. 00060 * 00061 * Theoretically rehosting the compiler to machines with different 00062 * byte-order or different floating point format should require changes 00063 * only to internal structure of TCON and to targ_const.c. It should 00064 * even be possible to keep constants in some kind of symbolic way and 00065 * do symbolic constant folding if the target representation is not 00066 * known to some phases of the compiler. 00067 * 00068 * The rest of the compiler must not assume anything about internals of 00069 * TCON, except that it keeps the type of the constant within itself. 00070 * In particular, the size of TCON must not be assumed to related to 00071 * the size of the represented constant in any way. 00072 * 00073 * ==================================================================== 00074 * ==================================================================== 00075 */ 00076 00077 #define USE_STANDARD_TYPES 1 00078 #include <limits.h> 00079 #include <fp_class.h> 00080 #include "defs.h" 00081 #include "config.h" 00082 #include "config_asm.h" 00083 #include "erglob.h" 00084 #include "tracing.h" 00085 00086 #include "mempool.h" 00087 #include "mtypes.h" 00088 #include "strtab.h" 00089 #include "opcode.h" 00090 #include "wintrinsic.h" 00091 #include "wn_core.h" 00092 #include "stab.h" 00093 #include "targ_const.h" 00094 #include "const.h" 00095 #include "quad.h" 00096 #include "quadsim.h" 00097 #include "ir_a2b_util.h" // for b2a and a2b utilities 00098 00099 #include <math.h> 00100 #include "x_math.h" // for hypot() 00101 00102 00103 /* Solaris workaround: The Solaris standard C library does not have 00104 * "float" version of mathematic functions even though they are 00105 * now in C99. 00106 */ 00107 #ifdef _SOLARIS_SOLARIS 00108 inline float sinf(float a) { return (float)sin(a); } 00109 inline float cosf(float a) { return (float)cos(a); } 00110 inline float tanf(float a) { return (float)tan(a); } 00111 00112 inline float asinf(float a) { return (float)asin(a); } 00113 inline float acosf(float a) { return (float)acos(a); } 00114 inline float atanf(float a) { return (float)atan(a); } 00115 inline float atan2f(float a, float b) { return (float)atan2(a, b); } 00116 00117 inline float sinhf(float a) { return (float)sinh(a); } 00118 inline float coshf(float a) { return (float)cosh(a); } 00119 inline float tanhf(float a) { return (float)tanh(a); } 00120 00121 inline float sqrtf(float a) { return (float)sqrt(a); } 00122 inline float expf(float a) { return (float)exp(a); } 00123 inline float logf(float a) { return (float)log(a); } 00124 inline float log10f(float a) { return (float)log10(a); } 00125 inline float fabsf(float a) { return (float)fabs(a); } 00126 #endif 00127 00128 00129 /* For fp_class */ 00130 #define DMANTWIDTH 52 00131 #define DEXPWIDTH 11 00132 #define DSIGNMASK 0x7fffffffffffffffll 00133 #define DEXPMASK 0x800fffffffffffffll 00134 #define DQNANBITMASK 0xfff7ffffffffffffll 00135 00136 #define MANTWIDTH 23 00137 #define EXPWIDTH 8 00138 #define SIGNMASK 0x7fffffff 00139 #define EXPMASK 0x807fffff 00140 #define QNANBITMASK 0xffbfffff 00141 00142 /* Just to make sure we have this, it should come from math.h */ 00143 #ifndef M_PI 00144 #define M_PI 3.14159265358979323846 00145 #endif 00146 00147 #define MIN_INT_I8 (((mINT64)1)<<(sizeof(mINT64)*8 - 1)) 00148 #define MIN_INT_I4 (1<<(sizeof(mINT32)*8 - 1)) 00149 #define MIN_INT_I2 (1<<(sizeof(mINT16)*8 - 1)) 00150 00151 /* results of comparisons */ 00152 #define LOGICAL_MTYPE MTYPE_U4 00153 00154 #include "targ_const_private.h" 00155 00156 #if defined(_COMPILER_VERSION) && (_COMPILER_VERSION >= 400) && _SGIAPI 00157 #define QUAD_PRECISION_SUPPORTED 00158 #else 00159 #undef QUAD_PRECISION_SUPPORTED 00160 #endif 00161 00162 00163 /* This initailization must be static because it may be used 00164 * before first call to Targ_WhirlOp. Also WARNING: It requires 00165 * that TCON_ty field be first one in TCON 00166 */ 00167 TCON Zero_I4_Tcon = { MTYPE_I4 }; 00168 TCON Zero_I8_Tcon = { MTYPE_I8 }; 00169 TCON Quad_Zero_Tcon = { MTYPE_FQ }; 00170 00171 static TCON Targ_Ipower(TCON base, UINT64 exp, BOOL neg_exp, BOOL *folded, TYPE_ID btype); 00172 static TCON Targ_Power(TCON base, TCON exp, BOOL *folded, TYPE_ID btype); 00173 00174 00175 TCON Targ_Conv ( TYPE_ID ty_to, TCON c ); /* Defined later, used in Targ_WhirlOp */ 00176 00177 00178 00179 /* ==================================================================== 00180 * This is the safe way of converting a QUAD_TYPE to a quad and vice 00181 * versa, and replaces: 00182 * 00183 * #define TCON_RQ(c) (*((quad *)&(c).vals.dval)) 00184 * 00185 * This #define may be fatal should a TCON have a smaller alignment 00186 * than a quad. 00187 * ==================================================================== 00188 */ 00189 typedef union QUAD_REPRESENTATION 00190 { 00191 QUAD_TYPE a_quadtype; 00192 QUAD a_quad; 00193 #ifdef QUAD_PRECISION_SUPPORTED 00194 long double a_longdouble; 00195 #endif 00196 } Quad_Representation; 00197 00198 static QUAD 00199 R16_To_RQ(QUAD_TYPE qt) 00200 { 00201 Quad_Representation repr; 00202 00203 repr.a_quadtype = qt; 00204 return repr.a_quad; 00205 } 00206 00207 static QUAD_TYPE 00208 RQ_To_R16(QUAD q) 00209 { 00210 Quad_Representation repr; 00211 00212 repr.a_quad = q; 00213 return repr.a_quadtype; 00214 } 00215 00216 #ifdef QUAD_PRECISION_SUPPORTED 00217 static long double 00218 R16_To_RLD(QUAD_TYPE qt) 00219 { 00220 Quad_Representation repr; 00221 00222 repr.a_quadtype = qt; 00223 return repr.a_longdouble; 00224 } 00225 00226 static QUAD_TYPE 00227 RLD_To_R16(long double q) 00228 { 00229 Quad_Representation repr; 00230 00231 repr.a_longdouble = q; 00232 return repr.a_quadtype; 00233 } 00234 #endif 00235 00236 #ifdef Is_True_On 00237 void 00238 Check_TCON ( TCON *tc ) 00239 { 00240 switch (TCON_ty(*tc)) { 00241 case MTYPE_I1: 00242 case MTYPE_I2: 00243 case MTYPE_I4: 00244 case MTYPE_U1: 00245 case MTYPE_U2: 00246 case MTYPE_U4: 00247 case MTYPE_F4: 00248 Is_True ( TCON_v1(*tc)|TCON_v2(*tc)|TCON_v3(*tc) == 0, 00249 ("High order word of %s TCON non zero %x", 00250 Mtype_Name(TCON_ty(*tc)), TCON_v1(*tc)) ); 00251 break; 00252 case MTYPE_I8: 00253 case MTYPE_U8: 00254 case MTYPE_F8: 00255 Is_True ( TCON_v2(*tc)|TCON_v3(*tc) == 0, 00256 ("High order word of %s TCON non zero %x", 00257 Mtype_Name(TCON_ty(*tc)), TCON_v1(*tc)) ); 00258 break; 00259 #ifdef TARG_NEEDS_QUAD_OPS 00260 case MTYPE_FQ: 00261 { 00262 QUAD q = R16_To_RQ(TCON_R16(*tc)); 00263 /* 00264 In Fortran, a user can specify an illegal quad constant 00265 using VMS-style bit constants, so we should just give 00266 a warning. 00267 */ 00268 if ( q.hi == 0.0 && q.lo != 0.0) 00269 ErrMsg( EC_Ill_Quad_Const, TCON_u0(*tc), TCON_u1(*tc), TCON_u2(*tc), TCON_u3(*tc)); 00270 } 00271 break; 00272 #endif 00273 default: 00274 break; 00275 } 00276 } /* Check_TCON */ 00277 #endif /* Is_True_On */ 00278 00279 /******************************************************************************* 00280 * This is a set of routines for complex arithmetic on 00281 * complex numbers. Much of this was lifted from libF77.a 00282 */ 00283 00284 static TCON complex_sqrt(TCON c0) 00285 { 00286 float fr,fi,fmag; 00287 double dr,di,dmag; 00288 TCON r; 00289 00290 TCON_clear(r); 00291 TCON_ty(r) = TCON_ty(c0); 00292 00293 switch (TCON_ty(c0)) { 00294 case MTYPE_C4: 00295 fr = TCON_R4(c0); 00296 fi = TCON_IR4(c0); 00297 if( (fmag = c_hypotf(fr, fi)) == 0.) 00298 TCON_R4(r) = TCON_IR4(r) = 0.; 00299 else if (fr > 0) { 00300 TCON_R4(r) = sqrtf(0.5 * (fmag + fr) ); 00301 TCON_IR4(r) = fi / TCON_R4(r) / 2; 00302 } else { 00303 TCON_IR4(r) = sqrtf(0.5 * (fmag - fr) ); 00304 if (fi < 0) TCON_IR4(r) = -TCON_IR4(r); 00305 TCON_R4(r) = fi / TCON_IR4(r) /2; 00306 } 00307 break; 00308 00309 case MTYPE_C8: 00310 dr = TCON_R8(c0); 00311 di = TCON_IR8(c0); 00312 if( (dmag = c_hypot(dr, di)) == 0.) 00313 TCON_R8(r) = TCON_IR8(r) = 0.; 00314 else if (dr > 0) { 00315 TCON_R8(r) = sqrt(0.5 * (dmag + dr) ); 00316 TCON_IR8(r) = di / TCON_R8(r) / 2; 00317 } else { 00318 TCON_IR8(r) = sqrt(0.5 * (dmag - dr) ); 00319 if (di < 0) TCON_IR8(r) = -TCON_IR8(r); 00320 TCON_R8(r) = di / TCON_IR8(r) /2; 00321 } 00322 break; 00323 00324 #ifdef TARG_NEEDS_QUAD_OPS 00325 case MTYPE_CQ: 00326 QUAD qr,qi,qmag,rqr,rqi,q0,q05; 00327 INT err; 00328 qr = R16_To_RQ(TCON_R16(c0)); 00329 qi = R16_To_RQ(TCON_IR16(c0)); 00330 q0 = __c_q_ext(0.0,&err); 00331 q05 = __c_q_ext(0.5,&err); 00332 00333 #ifdef TODO_MONGOOSE 00334 /* This set of stuff needs to be re-written to make use of the 00335 qhypot function, when we figure out how to make it available*/ 00336 /* qmag = qhypot(qr,qi); */ 00337 #endif 00338 qmag = __c_q_sqrt(__c_q_add(__c_q_mul(qi,qi,&err), 00339 __c_q_mul(qr,qr,&err), 00340 &err),&err); 00341 if (__c_q_eq(qmag,q0,&err)) { 00342 rqr = q0; 00343 rqi = q0; 00344 } 00345 else if (__c_q_gt(qr,q0,&err)) { 00346 rqr = __c_q_sqrt(__c_q_mul(q05,__c_q_add(qmag,qr,&err),&err),&err); 00347 rqi = __c_q_mul(q05,__c_q_div(qi,rqr,&err),&err); 00348 } else { 00349 rqi = __c_q_sqrt(__c_q_mul(q05,__c_q_sub(qmag,qr,&err),&err),&err); 00350 if (__c_q_lt(qi,q0,&err)) rqi = __c_q_neg(rqi,&err); 00351 rqr = __c_q_mul(q05,__c_q_div(qi,rqi,&err),&err); 00352 } 00353 TCON_R16(r) = RQ_To_R16(rqr); 00354 TCON_IR16(r) = RQ_To_R16(rqi); 00355 break; 00356 #endif 00357 00358 default: 00359 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(c0)), "complex_sqrt" ); 00360 } 00361 00362 return (r); 00363 } 00364 00365 static TCON complex_divide(TCON c0, TCON c1) 00366 { 00367 TCON r; 00368 00369 TCON_clear(r); 00370 TCON_ty(r) = TCON_ty(c0); 00371 00372 switch (TCON_ty(c0)) { 00373 case MTYPE_C4: 00374 { 00375 float c0r,c0i,c1r,c1i,t1,t2,t3; 00376 c0r = TCON_R4(c0); 00377 c0i = TCON_IR4(c0); 00378 c1r = TCON_R4(c1); 00379 c1i = TCON_IR4(c1); 00380 if (fabsf(c1r) < fabsf(c1i)) { 00381 t2 = c1r*(c1r/c1i) + c1i; 00382 t1 = (c0i*(c1r/c1i) - c0r)/t2; 00383 t3 = (c0r*(c1r/c1i) + c0i)/t2; 00384 } else { 00385 t2 = c1i*(c1i/c1r) + c1r; 00386 t1 = (c0i - c0r*(c1i/c1r))/t2; 00387 t3 = (c0i*(c1i/c1r) + c0r)/t2; 00388 } 00389 TCON_R4(r) = t3; 00390 TCON_IR4(r) = t1; 00391 } 00392 break; 00393 00394 case MTYPE_C8: 00395 { 00396 double c0r,c0i,c1r,c1i,t1,t2,t3; 00397 c0r = TCON_R8(c0); 00398 c0i = TCON_IR8(c0); 00399 c1r = TCON_R8(c1); 00400 c1i = TCON_IR8(c1); 00401 if (fabs(c1r) < fabs(c1i)) { 00402 t2 = c1r*(c1r/c1i) + c1i; 00403 t1 = (c0i*(c1r/c1i) - c0r)/t2; 00404 t3 = (c0r*(c1r/c1i) + c0i)/t2; 00405 } else { 00406 t2 = c1i*(c1i/c1r) + c1r; 00407 t1 = (c0i - c0r*(c1i/c1r))/t2; 00408 t3 = (c0i*(c1i/c1r) + c0r)/t2; 00409 } 00410 TCON_R8(r) = t3; 00411 TCON_IR8(r) = t1; 00412 } 00413 break; 00414 00415 #ifdef TARG_NEEDS_QUAD_OPS 00416 case MTYPE_CQ: 00417 { 00418 QUAD c0r,c0i,c1r,c1i,t1,t2,t3,t4,ar,ai,q0; 00419 INT err; 00420 q0 = __c_q_ext(0.0,&err); 00421 c0r = R16_To_RQ(TCON_R16(c0)); 00422 c0i = R16_To_RQ(TCON_IR16(c0)); 00423 c1r = R16_To_RQ(TCON_R16(c1)); 00424 c1i = R16_To_RQ(TCON_IR16(c1)); 00425 ar = c1r; 00426 ai = c1i; 00427 if (__c_q_lt(ar,q0,&err)) ar = __c_q_neg(ar,&err); 00428 if (__c_q_lt(ai,q0,&err)) ai = __c_q_neg(ai,&err); 00429 if (__c_q_lt(ar,ai,&err)) { 00430 t4 = __c_q_div(c1r,c1i,&err); 00431 t2 = __c_q_add(c1i,__c_q_mul(c1r,t4,&err),&err); 00432 t1 = __c_q_div(__c_q_sub(__c_q_mul(c0i,t4,&err),c0r,&err), 00433 t2,&err); 00434 t3 = __c_q_div(__c_q_add(__c_q_mul(c0r,t4,&err),c0i,&err), 00435 t2,&err); 00436 } else { 00437 t4 = __c_q_div(c1i,c1r,&err); 00438 t2 = __c_q_add(c1r,__c_q_mul(c1i,t4,&err),&err); 00439 t1 = __c_q_div(__c_q_sub(c0i,__c_q_mul(c0r,t4,&err),&err), 00440 t2,&err); 00441 t3 = __c_q_div(__c_q_add(__c_q_mul(c0i,t4,&err),c0r,&err), 00442 t2,&err); 00443 } 00444 TCON_R16(r) = RQ_To_R16(t3); 00445 TCON_IR16(r) = RQ_To_R16(t1); 00446 } 00447 break; 00448 #endif 00449 00450 default: 00451 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(c0)), "complex_divide" ); 00452 } 00453 00454 return (r); 00455 } 00456 00457 00458 00459 00460 /* ==================================================================== 00461 * 00462 * Targ_Convert_Length 00463 * 00464 * Convert the length of constants 00465 * 00466 * ==================================================================== 00467 */ 00468 00469 static TCON 00470 Targ_Convert_Length ( 00471 TCON c0, /* The constant to be converted */ 00472 TCON c1, /* The source length for conversion */ 00473 TYPE_ID mtype, /* The result's MTYPE */ 00474 INT16 len, /* The result bit length */ 00475 BOOL sign ) /* Is the conversion signed? */ 00476 { 00477 static const INT64 one = 1; 00478 INT64 sval = Targ_To_Host ( c0 ); 00479 INT64 slen = Targ_To_Host ( c1 ); 00480 00481 /* If the source length is greater than the desired length, this is 00482 * a simple truncation: 00483 */ 00484 if ( slen >= len ) { 00485 if ( len == 32 ) { 00486 mINT32 tval = sval & 0x0ffffffff; 00487 return Host_To_Targ ( mtype, tval ); 00488 } else if ( len == 64 ) { 00489 return Host_To_Targ ( mtype, sval ); 00490 } else { 00491 ErrMsg ( EC_Unimplemented, "Targ_Convert_Length: bad length 1" ); 00492 } 00493 } 00494 00495 if ( len == 32 ) { 00496 mINT32 highmask = (-1) << slen; 00497 mINT32 signmask = 1 << (slen-1); 00498 mINT32 tval = ( sval & ~highmask ); 00499 00500 if ( sign && ((tval & signmask) != 0) ) { 00501 tval |= highmask; 00502 } 00503 return Host_To_Targ ( mtype, tval ); 00504 00505 } else if ( len == 64 ) { 00506 INT64 highmask = (-one) << slen; 00507 INT64 signmask = one << (slen-1); 00508 INT64 tval = ( sval & ~highmask ); 00509 00510 if ( sign && ((tval & signmask) != 0) ) { 00511 tval |= highmask; 00512 } 00513 return Host_To_Targ ( mtype, tval ); 00514 00515 } else { 00516 ErrMsg ( EC_Unimplemented, "Targ_Convert_Length: bad length 2" ); 00517 return c0; 00518 } 00519 00520 } /* Targ_Convert_Length */ 00521 00522 00523 00524 /* ==================================================================== 00525 * 00526 * Targ_WhirlOp 00527 * 00528 * Apply an WHIRL operator to TCON operands, yielding a TCON for the 00529 * result value. The folded parameter, if non-NULL, is used to return 00530 * whether anything was done. 00531 * 00532 * It is an error to call this function with folded == NULL if in fact 00533 * nothing can be done (perhaps because the operator cannot be handed 00534 * yet). 00535 * 00536 * There are many call sites of Targ_WhirlOp with folded == NULL and 00537 * only a few with that check folded. Is this right? 00538 * 00539 * TODO: Check the call sites of Targ_WhirlOp that have NULL folded 00540 * arguments to make sure they are doing the right thing. 00541 * 00542 * TODO Josie/92: Install changes. 00543 * 00544 * ==================================================================== 00545 */ 00546 00547 /************************************ 00548 The latest word on BOTH_OPNDS: instead of complaining about the 00549 operands being of different types, it should now coerce both operands 00550 to the type of the third argument. It should only do this for converts which 00551 are essentially NOPs however. 00552 00553 **************************************/ 00554 00555 #define BOTH_OPNDS(op0,op1,type) \ 00556 if (type != MTYPE_U8) { op0=Targ_Conv(type,op0);op1=Targ_Conv(type,op1); } \ 00557 TCON_ty(op0)=type 00558 00559 00560 00561 /* ==================================================================== 00562 * 00563 * Targ_WhirlOp 00564 * 00565 * Given an SGIR operator (arithmetic) and one or two constant 00566 * operands, produce a constant expression result. Some operators, 00567 * which can't always fold (e.g. division where the divisor might be 00568 * zero), will return an indicator in "folded" of whether they 00569 * succeeded; they generally take assertion failures if folded is NULL 00570 * and they can't fold. 00571 * 00572 * TODO: Should these operators observe IEEE rules more completely, 00573 * e.g. returning NaN for min/max when one operand is NaN? 00574 * 00575 * ==================================================================== 00576 */ 00577 00578 TCON 00579 Targ_WhirlOp ( OPCODE op, TCON c0, TCON c1, BOOL *folded ) 00580 { 00581 #ifdef TARG_NEEDS_QUAD_OPS 00582 QUAD q0, q1; 00583 INT err; 00584 #endif 00585 TCON t1, t2; 00586 TYPE_ID optype; 00587 BOOL dummy_folded; 00588 00589 #ifdef Is_True_On 00590 Check_TCON (&c0); 00591 Check_TCON (&c1); 00592 #endif 00593 00594 #undef DEBUG_FOLD 00595 #ifdef DEBUG_FOLD 00596 printf("Folding %s on 0x%llx (%s), 0x%llx (%s), result",OPCODE_name(op), 00597 TCON_I8(c0),Mtype_Name(TCON_ty(c0)),TCON_I8(c1),Mtype_Name(TCON_ty(c1))); 00598 #endif 00599 00600 if (!folded) { 00601 folded = &dummy_folded; 00602 } 00603 00604 *folded = TRUE; 00605 00606 optype = OPCODE_rtype(op); 00607 TYPE_ID desc = OPCODE_desc(op); 00608 OPERATOR opr = OPCODE_operator(op); 00609 00610 if (OPERATOR_is_compare(opr)) { 00611 if (MTYPE_is_integral(desc)) 00612 BOTH_OPNDS(c0,c1,desc); 00613 switch (desc) { 00614 case MTYPE_I4: 00615 switch (opr) { 00616 case OPR_EQ: TCON_I4(c0) = TCON_I4(c0) == TCON_I4(c1); break; 00617 case OPR_NE: TCON_I4(c0) = TCON_I4(c0) != TCON_I4(c1); break; 00618 case OPR_LT: TCON_I4(c0) = TCON_I4(c0) < TCON_I4(c1); break; 00619 case OPR_LE: TCON_I4(c0) = TCON_I4(c0) <= TCON_I4(c1); break; 00620 case OPR_GT: TCON_I4(c0) = TCON_I4(c0) > TCON_I4(c1); break; 00621 case OPR_GE: TCON_I4(c0) = TCON_I4(c0) >= TCON_I4(c1); break; 00622 } 00623 break; 00624 case MTYPE_U4: 00625 switch (opr) { 00626 case OPR_EQ: TCON_I4(c0) = TCON_U4(c0) == TCON_U4(c1); break; 00627 case OPR_NE: TCON_I4(c0) = TCON_U4(c0) != TCON_U4(c1); break; 00628 case OPR_LT: TCON_I4(c0) = TCON_U4(c0) < TCON_U4(c1); break; 00629 case OPR_LE: TCON_I4(c0) = TCON_U4(c0) <= TCON_U4(c1); break; 00630 case OPR_GT: TCON_I4(c0) = TCON_U4(c0) > TCON_U4(c1); break; 00631 case OPR_GE: TCON_I4(c0) = TCON_U4(c0) >= TCON_U4(c1); break; 00632 } 00633 break; 00634 case MTYPE_I8: 00635 switch (opr) { 00636 case OPR_EQ: TCON_v0(c0) = TCON_I8(c0) == TCON_I8(c1); break; 00637 case OPR_NE: TCON_v0(c0) = TCON_I8(c0) != TCON_I8(c1); break; 00638 case OPR_LT: TCON_v0(c0) = TCON_I8(c0) < TCON_I8(c1); break; 00639 case OPR_LE: TCON_v0(c0) = TCON_I8(c0) <= TCON_I8(c1); break; 00640 case OPR_GT: TCON_v0(c0) = TCON_I8(c0) > TCON_I8(c1); break; 00641 case OPR_GE: TCON_v0(c0) = TCON_I8(c0) >= TCON_I8(c1); break; 00642 } 00643 TCON_v1(c0) = 0; 00644 break; 00645 case MTYPE_U8: 00646 switch (opr) { 00647 case OPR_EQ: TCON_v0(c0) = TCON_U8(c0) == TCON_U8(c1); break; 00648 case OPR_NE: TCON_v0(c0) = TCON_U8(c0) != TCON_U8(c1); break; 00649 case OPR_LT: TCON_v0(c0) = TCON_U8(c0) < TCON_U8(c1); break; 00650 case OPR_LE: TCON_v0(c0) = TCON_U8(c0) <= TCON_U8(c1); break; 00651 case OPR_GT: TCON_v0(c0) = TCON_U8(c0) > TCON_U8(c1); break; 00652 case OPR_GE: TCON_v0(c0) = TCON_U8(c0) >= TCON_U8(c1); break; 00653 } 00654 TCON_v1(c0) = 0; 00655 break; 00656 case MTYPE_F4: 00657 switch (opr) { 00658 case OPR_EQ: TCON_v0(c0) = TCON_R4(c0) == TCON_R4(c1); break; 00659 case OPR_NE: TCON_v0(c0) = TCON_R4(c0) != TCON_R4(c1); break; 00660 case OPR_LT: TCON_v0(c0) = TCON_R4(c0) < TCON_R4(c1); break; 00661 case OPR_LE: TCON_v0(c0) = TCON_R4(c0) <= TCON_R4(c1); break; 00662 case OPR_GT: TCON_v0(c0) = TCON_R4(c0) > TCON_R4(c1); break; 00663 case OPR_GE: TCON_v0(c0) = TCON_R4(c0) >= TCON_R4(c1); break; 00664 } 00665 TCON_v1(c0) = 0; 00666 break; 00667 case MTYPE_F8: 00668 switch (opr) { 00669 case OPR_EQ: TCON_v0(c0) = TCON_R8(c0) == TCON_R8(c1); break; 00670 case OPR_NE: TCON_v0(c0) = TCON_R8(c0) != TCON_R8(c1); break; 00671 case OPR_LT: TCON_v0(c0) = TCON_R8(c0) < TCON_R8(c1); break; 00672 case OPR_LE: TCON_v0(c0) = TCON_R8(c0) <= TCON_R8(c1); break; 00673 case OPR_GT: TCON_v0(c0) = TCON_R8(c0) > TCON_R8(c1); break; 00674 case OPR_GE: TCON_v0(c0) = TCON_R8(c0) >= TCON_R8(c1); break; 00675 } 00676 TCON_v1(c0) = 0; 00677 break; 00678 #ifdef TARG_NEEDS_QUAD_OPS 00679 case MTYPE_FQ: 00680 q0 = R16_To_RQ(TCON_R16(c0)); 00681 q1 = R16_To_RQ(TCON_R16(c1)); 00682 switch (opr) { 00683 case OPR_EQ: TCON_v0(c0) = __c_q_eq ( q0, q1, &err ); break; 00684 case OPR_NE: TCON_v0(c0) = __c_q_ne ( q0, q1, &err ); break; 00685 case OPR_LT: TCON_v0(c0) = __c_q_lt ( q0, q1, &err ); break; 00686 case OPR_LE: TCON_v0(c0) = __c_q_le ( q0, q1, &err ); break; 00687 case OPR_GT: TCON_v0(c0) = __c_q_gt ( q0, q1, &err ); break; 00688 case OPR_GE: TCON_v0(c0) = __c_q_ge ( q0, q1, &err ); break; 00689 } 00690 TCON_v1(c0) = 0; 00691 TCON_v2(c0) = 0; 00692 TCON_v3(c0) = 0; 00693 break; 00694 #endif 00695 case MTYPE_C4: 00696 switch (opr) { 00697 case OPR_EQ: TCON_v0(c0) = (TCON_R4(c0) == TCON_R4(c1)) && 00698 (TCON_IR4(c0) == TCON_IR4(c1)); break; 00699 case OPR_NE: TCON_v0(c0) = (TCON_R4(c0) != TCON_R4(c1)) || 00700 (TCON_IR4(c0) != TCON_IR4(c1)); break; 00701 } 00702 TCON_v1(c0) = 0; 00703 break; 00704 case MTYPE_C8: 00705 switch (opr) { 00706 case OPR_EQ: TCON_v0(c0) = (TCON_R8(c0) == TCON_R8(c1)) && 00707 (TCON_IR8(c0) == TCON_IR8(c1)); break; 00708 case OPR_NE: TCON_v0(c0) = (TCON_R8(c0) != TCON_R8(c1)) || 00709 (TCON_IR8(c0) != TCON_IR8(c1)); break; 00710 } 00711 TCON_v1(c0) = 0; 00712 break; 00713 #ifdef TARG_NEEDS_QUAD_OPS 00714 case MTYPE_CQ: 00715 q0 = R16_To_RQ(TCON_R16(c0)); 00716 q1 = R16_To_RQ(TCON_R16(c1)); 00717 switch (opr) { 00718 case OPR_EQ: TCON_v0(c0) = __c_q_eq ( q0, q1, &err ); break; 00719 case OPR_NE: TCON_v0(c0) = __c_q_ne ( q0, q1, &err ); break; 00720 } 00721 q0 = R16_To_RQ(TCON_IR16(c0)); 00722 q1 = R16_To_RQ(TCON_IR16(c1)); 00723 switch (opr) { 00724 case OPR_EQ: TCON_v0(c0) &= __c_q_eq ( q0, q1, &err ); break; 00725 case OPR_NE: TCON_v0(c0) |= __c_q_ne ( q0, q1, &err ); break; 00726 } 00727 TCON_v1(c0) = 0; 00728 TCON_v2(c0) = 0; 00729 TCON_v3(c0) = 0; 00730 break; 00731 #endif 00732 } 00733 TCON_ty(c0) = optype; 00734 } 00735 else 00736 switch (op) { 00737 00738 case OPC_F4PAREN: 00739 case OPC_F8PAREN: 00740 case OPC_FQPAREN: 00741 case OPC_C4PAREN: 00742 case OPC_C8PAREN: 00743 case OPC_CQPAREN: 00744 /* just c0 */ 00745 break; 00746 00747 00748 case OPC_I8CVTL: 00749 c0 = Targ_Convert_Length(c0,c1,MTYPE_I8,64,TRUE); 00750 break; 00751 case OPC_I4CVTL: 00752 c0 = Targ_Convert_Length(c0,c1,MTYPE_I4,32,TRUE); 00753 break; 00754 case OPC_U8CVTL: 00755 c0 = Targ_Convert_Length(c0,c1,MTYPE_U8,64,FALSE); 00756 break; 00757 case OPC_U4CVTL: 00758 c0 = Targ_Convert_Length(c0,c1,MTYPE_U4,32,FALSE); 00759 break; 00760 00761 /* For shift cases read ANSI/ISO 9899-1990 standard, Section 6.3.7. 00762 The type of the shift is that of the left operand. The right operand 00763 type can actually be larger than the left. The TCON_I8U8I4U4 00764 macro handles this (any other combination will have a CVT inserted). 00765 00766 For shift amounts that are greater than the width of the bits in 00767 the left operand, the behavior on IA64 is defined as: 00768 1) The shift count is interperted as an unsigned number 00769 2) If the value of the shift count is greater than the word size, 00770 the result is all zero (left shifts and logical right shift) or 00771 a word filled with the sign bit (arithmetic right shift). 00772 */ 00773 case OPC_I8SHL: 00774 case OPC_U8SHL: 00775 c0 = Targ_Conv(optype, c0); 00776 if ((TCON_I8U8I4U4(c1) >= 0) && (TCON_I8U8I4U4(c1) <= 63)) { 00777 TCON_I8(c0) <<= TCON_I8U8I4U4(c1); 00778 } else { 00779 TCON_I8(c0) = 0; 00780 } 00781 break; 00782 case OPC_I4SHL: 00783 case OPC_U4SHL: 00784 c0 = Targ_Conv(optype, c0); 00785 if ((TCON_I8U8I4U4(c1) >= 0) && (TCON_I8U8I4U4(c1) <= 31)) { 00786 TCON_I4(c0) <<= TCON_I8U8I4U4(c1); 00787 } else { 00788 TCON_I4(c0) = 0; 00789 } 00790 break; 00791 00792 case OPC_I8LSHR: 00793 case OPC_U8LSHR: 00794 c0 = Targ_Conv(optype, c0); 00795 if ((TCON_I8U8I4U4(c1) >= 0) && (TCON_I8U8I4U4(c1) <= 63)) { 00796 TCON_U8(c0) >>= TCON_I8U8I4U4(c1); 00797 } else { 00798 TCON_U8(c0) = 0; 00799 } 00800 break; 00801 case OPC_I4LSHR: 00802 case OPC_U4LSHR: 00803 c0 = Targ_Conv(optype, c0); 00804 if ((TCON_I8U8I4U4(c1) >= 0) && (TCON_I8U8I4U4(c1) <= 31)) { 00805 TCON_U4(c0) >>= TCON_I8U8I4U4(c1); 00806 } else { 00807 TCON_U4(c0) = 0; 00808 } 00809 break; 00810 00811 case OPC_I8ASHR: 00812 case OPC_U8ASHR: 00813 c0 = Targ_Conv(optype, c0); 00814 TCON_I8(c0) >>= ((TCON_I8U8I4U4(c1) >= 0) && (TCON_I8U8I4U4(c1) <= 63)) ? TCON_I8U8I4U4(c1) : 63; 00815 break; 00816 case OPC_I4ASHR: 00817 case OPC_U4ASHR: 00818 c0 = Targ_Conv(optype, c0); 00819 TCON_I4(c0) >>= ((TCON_I8U8I4U4(c1) >= 0) && (TCON_I8U8I4U4(c1) <= 31)) ? TCON_I8U8I4U4(c1) : 31; 00820 break; 00821 00822 case OPC_F4F8CVT: 00823 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00824 c0 = Targ_Conv(MTYPE_F4, c0); 00825 break; 00826 case OPC_F8F4CVT: 00827 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00828 c0 = Targ_Conv(MTYPE_F8, c0); 00829 break; 00830 #ifdef TARG_NEEDS_QUAD_OPS 00831 case OPC_FQF4CVT: 00832 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00833 c0 = Targ_Conv(MTYPE_FQ, c0); 00834 break; 00835 case OPC_F4FQCVT: 00836 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 00837 c0 = Targ_Conv(MTYPE_F4, c0); 00838 break; 00839 case OPC_FQF8CVT: 00840 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00841 c0 = Targ_Conv(MTYPE_FQ, c0); 00842 break; 00843 case OPC_F8FQCVT: 00844 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 00845 c0 = Targ_Conv(MTYPE_F8, c0); 00846 break; 00847 #endif 00848 case OPC_I4F4CVT: 00849 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00850 c0 = Targ_Conv(MTYPE_I4, c0); 00851 break; 00852 case OPC_I4F8CVT: 00853 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00854 c0 = Targ_Conv(MTYPE_I4, c0); 00855 break; 00856 #ifdef TARG_NEEDS_QUAD_OPS 00857 case OPC_I4FQCVT: 00858 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 00859 c0 = Targ_Conv(MTYPE_I4, c0); 00860 break; 00861 #endif 00862 case OPC_I8F4CVT: 00863 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00864 c0 = Targ_Conv(MTYPE_I8, c0); 00865 break; 00866 case OPC_I8F8CVT: 00867 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00868 c0 = Targ_Conv(MTYPE_I8, c0); 00869 break; 00870 #ifdef TARG_NEEDS_QUAD_OPS 00871 case OPC_I8FQCVT: 00872 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 00873 c0 = Targ_Conv(MTYPE_I8, c0); 00874 break; 00875 #endif 00876 00877 case OPC_U4F4CVT: 00878 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00879 c0 = Targ_Conv(MTYPE_U4, c0); 00880 break; 00881 case OPC_U4F8CVT: 00882 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00883 c0 = Targ_Conv(MTYPE_U4, c0); 00884 break; 00885 #ifdef TARG_NEEDS_QUAD_OPS 00886 case OPC_U4FQCVT: 00887 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 00888 c0 = Targ_Conv(MTYPE_U4, c0); 00889 break; 00890 #endif 00891 case OPC_U8F4CVT: 00892 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00893 c0 = Targ_Conv(MTYPE_U8, c0); 00894 break; 00895 case OPC_U8F8CVT: 00896 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00897 c0 = Targ_Conv(MTYPE_U8, c0); 00898 break; 00899 #ifdef TARG_NEEDS_QUAD_OPS 00900 case OPC_U8FQCVT: 00901 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 00902 c0 = Targ_Conv(MTYPE_U8, c0); 00903 break; 00904 #endif 00905 case OPC_I8I4CVT: 00906 case OPC_I8U4CVT: 00907 case OPC_U8I4CVT: 00908 case OPC_U8U4CVT: 00909 case OPC_I4I8CVT: 00910 case OPC_I4U8CVT: 00911 case OPC_U4I8CVT: 00912 case OPC_U4U8CVT: 00913 case OPC_I8BCVT: 00914 case OPC_U8BCVT: 00915 case OPC_I4BCVT: 00916 case OPC_U4BCVT: 00917 c0 = Targ_Conv(OPCODE_desc(op),c0); 00918 c0 = Targ_Conv(optype, c0); 00919 break; 00920 00921 case OPC_I4F8RND: 00922 if (TCON_R8(c0) >= 0.0) { 00923 TCON_I4(c0) = (INT32)(TCON_R8(c0) + 0.5); 00924 } else { 00925 TCON_I4(c0) = (INT32)(TCON_R8(c0) - 0.5); 00926 } 00927 TCON_v1(c0) = 0; 00928 TCON_ty(c0) = MTYPE_I4; 00929 break; 00930 case OPC_I4F4RND: 00931 if (TCON_R4(c0) >= 0.0) { 00932 TCON_I4(c0) = (INT32)(TCON_R4(c0) + 0.5); 00933 } else { 00934 TCON_I4(c0) = (INT32)(TCON_R4(c0) - 0.5); 00935 } 00936 TCON_v1(c0) = 0; 00937 TCON_ty(c0) = MTYPE_I4; 00938 break; 00939 #ifdef TARG_NEEDS_QUAD_OPS 00940 case OPC_I4FQRND: 00941 if (__c_q_ge(R16_To_RQ(TCON_R16(c0)), 00942 __c_q_flotj(0, &err), 00943 &err)) 00944 TCON_R16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_R16(c0)), 00945 __c_q_ext(.5, &err), 00946 &err)); 00947 else 00948 TCON_R16(c0) = RQ_To_R16(__c_q_sub(R16_To_RQ(TCON_R16(c0)), 00949 __c_q_ext(.5, &err), 00950 &err)); 00951 00952 c0 = Targ_Conv(MTYPE_I4,c0); 00953 break; 00954 #endif 00955 00956 case OPC_I8F8RND: 00957 if (TCON_R8(c0) >= 0.0) { 00958 TCON_I8(c0) = (INT64)(TCON_R8(c0) + 0.5); 00959 } else { 00960 TCON_I8(c0) = (INT64)(TCON_R8(c0) - 0.5); 00961 } 00962 TCON_ty(c0) = MTYPE_I8; 00963 break; 00964 case OPC_I8F4RND: 00965 if (TCON_R4(c0) >= 0.0) { 00966 TCON_I8(c0) = (INT64)(TCON_R4(c0) + 0.5); 00967 } else { 00968 TCON_I8(c0) = (INT64)(TCON_R4(c0) - 0.5); 00969 } 00970 TCON_ty(c0) = MTYPE_I8; 00971 break; 00972 #ifdef TARG_NEEDS_QUAD_OPS 00973 case OPC_I8FQRND: 00974 if (__c_q_ge(R16_To_RQ(TCON_R16(c0)), 00975 __c_q_flotj(0, &err), 00976 &err)) 00977 TCON_R16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_R16(c0)), 00978 __c_q_ext(.5, &err), 00979 &err)); 00980 else 00981 TCON_R16(c0) = RQ_To_R16(__c_q_sub(R16_To_RQ(TCON_R16(c0)), 00982 __c_q_ext(.5, &err), 00983 &err)); 00984 00985 c0 = Targ_Conv(MTYPE_I8,c0); 00986 break; 00987 #endif 00988 00989 /* Handle truncation like C style CVT ops, i.e. with Targ_Conv() */ 00990 case OPC_I4F4TRUNC: 00991 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 00992 c0 = Targ_Conv(MTYPE_I4, c0); 00993 break; 00994 case OPC_I4F8TRUNC: 00995 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 00996 c0 = Targ_Conv(MTYPE_I4, c0); 00997 break; 00998 #ifdef TARG_NEEDS_QUAD_OPS 00999 case OPC_I4FQTRUNC: 01000 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 01001 c0 = Targ_Conv(MTYPE_I4, c0); 01002 break; 01003 #endif 01004 01005 case OPC_I8F4TRUNC: 01006 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 01007 c0 = Targ_Conv(MTYPE_I8, c0); 01008 break; 01009 case OPC_I8F8TRUNC: 01010 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 01011 c0 = Targ_Conv(MTYPE_I8, c0); 01012 break; 01013 #ifdef TARG_NEEDS_QUAD_OPS 01014 case OPC_I8FQTRUNC: 01015 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 01016 c0 = Targ_Conv(MTYPE_I8, c0); 01017 break; 01018 #endif 01019 01020 01021 case OPC_I4F4FLOOR: 01022 t1 = Targ_Conv(MTYPE_I4, c0); 01023 t2 = Targ_Conv(MTYPE_F4,t1); 01024 if (TCON_R4(t2) > TCON_R4(c0)) { 01025 TCON_I4(t1) -= 1; 01026 } 01027 c0 = t1; 01028 break; 01029 case OPC_I4F8FLOOR: 01030 t1 = Targ_Conv(MTYPE_I4, c0); 01031 t2 = Targ_Conv(MTYPE_F8,t1); 01032 if (TCON_R8(t2) > TCON_R8(c0)) { 01033 TCON_I4(t1) -= 1; 01034 } 01035 c0 = t1; 01036 break; 01037 #ifdef TARG_NEEDS_QUAD_OPS 01038 case OPC_I4FQFLOOR: 01039 t1 = Targ_Conv(MTYPE_I4, c0); 01040 t2 = Targ_Conv(MTYPE_FQ,t1); 01041 if (__c_q_gt(R16_To_RQ(TCON_R16(t2)),R16_To_RQ(TCON_R16(c0)),&err)) { 01042 TCON_I4(t1) -= 1; 01043 } 01044 c0 = t1; 01045 break; 01046 #endif 01047 01048 case OPC_I8F4FLOOR: 01049 t1 = Targ_Conv(MTYPE_I8, c0); 01050 t2 = Targ_Conv(MTYPE_F4,t1); 01051 if (TCON_R4(t2) > TCON_R4(c0)) { 01052 TCON_I8(t1) -= 1; 01053 } 01054 c0 = t1; 01055 break; 01056 case OPC_I8F8FLOOR: 01057 t1 = Targ_Conv(MTYPE_I8, c0); 01058 t2 = Targ_Conv(MTYPE_F8,t1); 01059 if (TCON_R8(t2) > TCON_R8(c0)) { 01060 TCON_I8(t1) -= 1; 01061 } 01062 c0 = t1; 01063 break; 01064 #ifdef TARG_NEEDS_QUAD_OPS 01065 case OPC_I8FQFLOOR: 01066 t1 = Targ_Conv(MTYPE_I8, c0); 01067 t2 = Targ_Conv(MTYPE_FQ,t1); 01068 if (__c_q_gt(R16_To_RQ(TCON_R16(t2)),R16_To_RQ(TCON_R16(c0)),&err)) { 01069 TCON_I8(t1) -= 1; 01070 } 01071 c0 = t1; 01072 break; 01073 #endif 01074 01075 01076 case OPC_I4F4CEIL: 01077 t1 = Targ_Conv(MTYPE_I4, c0); 01078 t2 = Targ_Conv(MTYPE_F4,t1); 01079 if (TCON_R4(t2) < TCON_R4(c0)) { 01080 TCON_I4(t1) += 1; 01081 } 01082 c0 = t1; 01083 break; 01084 case OPC_I4F8CEIL: 01085 t1 = Targ_Conv(MTYPE_I4, c0); 01086 t2 = Targ_Conv(MTYPE_F8,t1); 01087 if (TCON_R8(t2) < TCON_R8(c0)) { 01088 TCON_I4(t1) += 1; 01089 } 01090 c0 = t1; 01091 break; 01092 #ifdef TARG_NEEDS_QUAD_OPS 01093 case OPC_I4FQCEIL: 01094 t1 = Targ_Conv(MTYPE_I4, c0); 01095 t2 = Targ_Conv(MTYPE_FQ,t1); 01096 if (__c_q_lt(R16_To_RQ(TCON_R16(t2)),R16_To_RQ(TCON_R16(c0)),&err)) { 01097 TCON_I4(t1) += 1; 01098 } 01099 c0 = t1; 01100 break; 01101 #endif 01102 01103 case OPC_I8F4CEIL: 01104 t1 = Targ_Conv(MTYPE_I8, c0); 01105 t2 = Targ_Conv(MTYPE_F4,t1); 01106 if (TCON_R4(t2) < TCON_R4(c0)) { 01107 TCON_I8(t1) += 1; 01108 } 01109 c0 = t1; 01110 break; 01111 case OPC_I8F8CEIL: 01112 t1 = Targ_Conv(MTYPE_I8, c0); 01113 t2 = Targ_Conv(MTYPE_F8,t1); 01114 if (TCON_R8(t2) < TCON_R8(c0)) { 01115 TCON_I8(t1) += 1; 01116 } 01117 c0 = t1; 01118 break; 01119 #ifdef TARG_NEEDS_QUAD_OPS 01120 case OPC_I8FQCEIL: 01121 t1 = Targ_Conv(MTYPE_I8, c0); 01122 t2 = Targ_Conv(MTYPE_FQ,t1); 01123 if (__c_q_lt(R16_To_RQ(TCON_R16(t2)),R16_To_RQ(TCON_R16(c0)),&err)) { 01124 TCON_I8(t1) += 1; 01125 } 01126 c0 = t1; 01127 break; 01128 #endif 01129 01130 case OPC_U4F8RND: 01131 TCON_U4(c0) = (UINT32)(TCON_R8(c0) + 0.5); 01132 TCON_v1(c0) = 0; 01133 TCON_ty(c0) = MTYPE_U4; 01134 break; 01135 01136 case OPC_U4F4RND: 01137 TCON_U4(c0) = (UINT32)(TCON_R4(c0) + 0.5); 01138 TCON_v1(c0) = 0; 01139 TCON_ty(c0) = MTYPE_U4; 01140 break; 01141 01142 #ifdef TARG_NEEDS_QUAD_OPS 01143 case OPC_U4FQRND: 01144 TCON_R16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_R16(c0)), 01145 __c_q_ext(.5, &err), 01146 &err)); 01147 c0 = Targ_Conv(MTYPE_U4,c0); 01148 break; 01149 #endif 01150 01151 case OPC_U8F8RND: 01152 TCON_U8(c0) = (UINT64)(TCON_R8(c0) + 0.5); 01153 TCON_v1(c0) = 0; 01154 TCON_ty(c0) = MTYPE_U8; 01155 break; 01156 01157 case OPC_U8F4RND: 01158 TCON_U8(c0) = (UINT64)(TCON_R4(c0) + 0.5); 01159 TCON_ty(c0) = MTYPE_U8; 01160 break; 01161 01162 #ifdef TARG_NEEDS_QUAD_OPS 01163 case OPC_U8FQRND: 01164 TCON_R16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_R16(c0)), 01165 __c_q_ext(.5, &err), 01166 &err)); 01167 c0 = Targ_Conv(MTYPE_U8,c0); 01168 break; 01169 #endif 01170 01171 case OPC_U4F4FLOOR: 01172 case OPC_U4F4TRUNC: 01173 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 01174 c0 = Targ_Conv(MTYPE_U4, c0); 01175 break; 01176 01177 case OPC_U4F8FLOOR: 01178 case OPC_U4F8TRUNC: 01179 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 01180 c0 = Targ_Conv(MTYPE_U4, c0); 01181 break; 01182 01183 #ifdef TARG_NEEDS_QUAD_OPS 01184 case OPC_U4FQFLOOR: 01185 case OPC_U4FQTRUNC: 01186 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 01187 c0 = Targ_Conv(MTYPE_U4, c0); 01188 break; 01189 #endif 01190 01191 case OPC_U8F4FLOOR: 01192 case OPC_U8F4TRUNC: 01193 Is_True(TCON_ty(c0) == MTYPE_F4, ("Illegal operand to %s", OPCODE_name(op))); 01194 c0 = Targ_Conv(MTYPE_U8, c0); 01195 break; 01196 01197 case OPC_U8F8FLOOR: 01198 case OPC_U8F8TRUNC: 01199 Is_True(TCON_ty(c0) == MTYPE_F8, ("Illegal operand to %s", OPCODE_name(op))); 01200 c0 = Targ_Conv(MTYPE_U8, c0); 01201 break; 01202 01203 #ifdef TARG_NEEDS_QUAD_OPS 01204 case OPC_U8FQFLOOR: 01205 case OPC_U8FQTRUNC: 01206 Is_True(TCON_ty(c0) == MTYPE_FQ, ("Illegal operand to %s", OPCODE_name(op))); 01207 c0 = Targ_Conv(MTYPE_U8, c0); 01208 break; 01209 #endif 01210 01211 case OPC_U4F4CEIL: 01212 t1 = Targ_Conv(MTYPE_U4, c0); 01213 t2 = Targ_Conv(MTYPE_F4,t1); 01214 if (TCON_R4(t2) < TCON_R4(c0)) { 01215 TCON_U4(t1) += 1; 01216 } 01217 c0 = t1; 01218 break; 01219 01220 case OPC_U4F8CEIL: 01221 t1 = Targ_Conv(MTYPE_U4, c0); 01222 t2 = Targ_Conv(MTYPE_F8,t1); 01223 if (TCON_R8(t2) < TCON_R8(c0)) { 01224 TCON_U4(t1) += 1; 01225 } 01226 c0 = t1; 01227 break; 01228 01229 #ifdef TARG_NEEDS_QUAD_OPS 01230 case OPC_U4FQCEIL: 01231 t1 = Targ_Conv(MTYPE_U4, c0); 01232 t2 = Targ_Conv(MTYPE_FQ,t1); 01233 if (__c_q_lt(R16_To_RQ(TCON_R16(t2)),R16_To_RQ(TCON_R16(c0)),&err)) { 01234 TCON_U4(t1) += 1; 01235 } 01236 c0 = t1; 01237 break; 01238 #endif 01239 01240 case OPC_U8F4CEIL: 01241 t1 = Targ_Conv(MTYPE_U8, c0); 01242 t2 = Targ_Conv(MTYPE_F4,t1); 01243 if (TCON_R4(t2) < TCON_R4(c0)) { 01244 TCON_U8(t1) += 1; 01245 } 01246 c0 = t1; 01247 break; 01248 01249 case OPC_U8F8CEIL: 01250 t1 = Targ_Conv(MTYPE_U8, c0); 01251 t2 = Targ_Conv(MTYPE_F8,t1); 01252 if (TCON_R8(t2) < TCON_R8(c0)) { 01253 TCON_U8(t1) += 1; 01254 } 01255 c0 = t1; 01256 break; 01257 01258 #ifdef TARG_NEEDS_QUAD_OPS 01259 case OPC_U8FQCEIL: 01260 t1 = Targ_Conv(MTYPE_U8, c0); 01261 t2 = Targ_Conv(MTYPE_FQ,t1); 01262 if (__c_q_lt(R16_To_RQ(TCON_R16(t2)),R16_To_RQ(TCON_R16(c0)),&err)) { 01263 TCON_U8(t1) += 1; 01264 } 01265 c0 = t1; 01266 break; 01267 #endif 01268 01269 #ifdef TARG_NEEDS_QUAD_OPS 01270 case OPC_FQI4CVT: 01271 case OPC_FQU4CVT: 01272 case OPC_FQI8CVT: 01273 case OPC_FQU8CVT: 01274 c0 = Targ_Conv(OPCODE_rtype(op),Targ_Conv(OPCODE_desc(op),c0)); 01275 break; 01276 #endif 01277 case OPC_F4I4CVT: 01278 case OPC_F8I4CVT: 01279 case OPC_F4U4CVT: 01280 case OPC_F8U4CVT: 01281 case OPC_F4I8CVT: 01282 case OPC_F8I8CVT: 01283 case OPC_F4U8CVT: 01284 case OPC_F8U8CVT: 01285 c0 = Targ_Conv(OPCODE_rtype(op),Targ_Conv(OPCODE_desc(op),c0)); 01286 break; 01287 01288 01289 /* The 1 and 2 byte types can safely be typecast like this, 01290 since no additional bit motion is necessary. */ 01291 case OPC_I1TAS: 01292 case OPC_U1TAS: 01293 case OPC_I2TAS: 01294 case OPC_U2TAS: 01295 TCON_ty(c0) = OPCODE_rtype(op); 01296 break; 01297 01298 01299 /* If TAS can't be applied to complex types, these are safe 01300 since the bits are in the same position in the TCON structure */ 01301 case OPC_I8TAS: 01302 case OPC_U8TAS: 01303 case OPC_F8TAS: 01304 case OPC_FQTAS: 01305 TCON_ty(c0) = OPCODE_rtype(op); 01306 break; 01307 01308 01309 case OPC_U4TAS: 01310 case OPC_I4TAS: 01311 /* Need to move the bits if the source is an F4 */ 01312 if (TCON_ty(c0) == MTYPE_F4) { 01313 TCON_v0(c0) = TCON_v1(c0); 01314 TCON_v1(c0) = 0; 01315 } 01316 TCON_ty(c0) = OPCODE_rtype(op); 01317 break; 01318 01319 case OPC_F4TAS: 01320 /* Need to move the bits if the source is not an F4 */ 01321 if (TCON_ty(c0) != MTYPE_F4) { 01322 TCON_v1(c0) = TCON_v0(c0); 01323 TCON_v0(c0) = 0; 01324 } 01325 TCON_ty(c0) = MTYPE_F4; 01326 break; 01327 01328 01329 /* Should these even exist? */ 01330 case OPC_C4TAS: 01331 TCON_ty(c0) = MTYPE_C4; 01332 break; 01333 case OPC_C8TAS: 01334 TCON_ty(c0) = MTYPE_C8; 01335 break; 01336 case OPC_CQTAS: 01337 TCON_ty(c0) = MTYPE_CQ; 01338 break; 01339 01340 case OPC_I8ABS: 01341 c0 = Targ_Conv(MTYPE_I8,c0); 01342 if (TCON_I8(c0) < 0) TCON_I8(c0) = -TCON_I8(c0); 01343 break; 01344 case OPC_I4ABS: 01345 c0 = Targ_Conv(MTYPE_I4,c0); 01346 if (TCON_I4(c0) < 0) TCON_I4(c0) = -TCON_I4(c0); 01347 break; 01348 case OPC_F4ABS: 01349 if (TCON_R4(c0) < 0) TCON_R4(c0) = -TCON_R4(c0); 01350 break; 01351 case OPC_F8ABS: 01352 if (TCON_R8(c0) < 0) TCON_R8(c0) = -TCON_R8(c0); 01353 break; 01354 #ifdef TARG_NEEDS_QUAD_OPS 01355 case OPC_FQABS: 01356 if (__c_q_lt(R16_To_RQ(TCON_R16(c0)), 01357 __c_q_flotj(0, &err), 01358 &err)) 01359 TCON_R16(c0) = RQ_To_R16(__c_q_neg(R16_To_RQ(TCON_R16(c0)), 01360 &err)); 01361 break; 01362 #endif 01363 01364 case OPC_I8NEG: 01365 c0 = Targ_Conv(MTYPE_I8,c0); 01366 TCON_I8(c0) = -TCON_I8(c0); 01367 break; 01368 case OPC_I4NEG: 01369 c0 = Targ_Conv(MTYPE_I4,c0); 01370 TCON_I4(c0) = -TCON_I4(c0); 01371 break; 01372 case OPC_U8NEG: 01373 c0 = Targ_Conv(MTYPE_U8,c0); 01374 TCON_U8(c0) = -TCON_U8(c0); 01375 break; 01376 case OPC_U4NEG: 01377 c0 = Targ_Conv(MTYPE_U4,c0); 01378 TCON_U4(c0) = -TCON_U4(c0); 01379 break; 01380 case OPC_F4NEG: 01381 TCON_R4(c0) = -TCON_R4(c0); 01382 break; 01383 case OPC_F8NEG: 01384 TCON_R8(c0) = -TCON_R8(c0); 01385 break; 01386 #ifdef TARG_NEEDS_QUAD_OPS 01387 case OPC_FQNEG: 01388 TCON_R16(c0) = RQ_To_R16(__c_q_neg(R16_To_RQ(TCON_R16(c0)), 01389 &err)); 01390 01391 break; 01392 #endif 01393 case OPC_C4NEG: 01394 TCON_R4(c0) = -TCON_R4(c0); 01395 TCON_IR4(c0) = -TCON_IR4(c0); 01396 break; 01397 case OPC_C8NEG: 01398 TCON_R8(c0) = -TCON_R8(c0); 01399 TCON_IR8(c0) = -TCON_IR8(c0); 01400 break; 01401 #ifdef TARG_NEEDS_QUAD_OPS 01402 case OPC_CQNEG: 01403 TCON_R16(c0) = RQ_To_R16(__c_q_neg(R16_To_RQ(TCON_R16(c0)), 01404 &err)); 01405 TCON_IR16(c0) = RQ_To_R16(__c_q_neg(R16_To_RQ(TCON_IR16(c0)), 01406 &err)); 01407 01408 break; 01409 #endif 01410 01411 case OPC_BLAND: 01412 case OPC_I4LAND: 01413 case OPC_BCAND: 01414 case OPC_I4CAND: 01415 TCON_v0(c0) = TCON_U4(c0) && TCON_U4(c1); 01416 TCON_ty(c0) = LOGICAL_MTYPE; 01417 break; 01418 01419 case OPC_BLIOR: 01420 case OPC_I4LIOR: 01421 case OPC_BCIOR: 01422 case OPC_I4CIOR: 01423 TCON_v0(c0) = TCON_U4(c0) || TCON_U4(c1); 01424 TCON_ty(c0) = LOGICAL_MTYPE; 01425 break; 01426 01427 case OPC_BLNOT: 01428 case OPC_I4LNOT: 01429 switch (TCON_ty(c0)) { 01430 case MTYPE_I4: 01431 TCON_v0(c0) = (TCON_I4(c0) == 0); 01432 break; 01433 case MTYPE_U4: 01434 TCON_v0(c0) = (TCON_U4(c0) == 0); 01435 break; 01436 case MTYPE_I8: 01437 TCON_v0(c0) = (TCON_I8(c0) == 0); 01438 break; 01439 case MTYPE_U8: 01440 TCON_v0(c0) = (TCON_U8(c0) == 0); 01441 break; 01442 default: 01443 FmtAssert(0,("Targ_WhirlOp, illegal operand type for LNOT")); 01444 break; 01445 } 01446 TCON_ty(c0) = OPCODE_rtype(op); 01447 break; 01448 01449 case OPC_I8BXOR: /* type of result is already correct */ 01450 BOTH_OPNDS(c0,c1,MTYPE_I8); 01451 TCON_I8(c0) ^= TCON_I8(c1); 01452 break; 01453 case OPC_I4BXOR: 01454 BOTH_OPNDS(c0,c1,MTYPE_I4); 01455 TCON_I4(c0) ^= TCON_I4(c1); 01456 break; 01457 case OPC_U8BXOR: /* type of result is already correct */ 01458 BOTH_OPNDS(c0,c1,MTYPE_U8); 01459 TCON_U8(c0) ^= TCON_U8(c1); 01460 break; 01461 case OPC_U4BXOR: 01462 BOTH_OPNDS(c0,c1,MTYPE_U4); 01463 TCON_U4(c0) ^= TCON_U4(c1); 01464 break; 01465 01466 case OPC_I8BAND: /* type of result is already correct */ 01467 BOTH_OPNDS(c0,c1,MTYPE_I8); 01468 TCON_I8(c0) &= TCON_I8(c1); 01469 break; 01470 case OPC_I4BAND: 01471 BOTH_OPNDS(c0,c1,MTYPE_I4); 01472 TCON_I4(c0) &= TCON_I4(c1); 01473 break; 01474 case OPC_U8BAND: /* type of result is already correct */ 01475 BOTH_OPNDS(c0,c1,MTYPE_U8); 01476 TCON_U8(c0) &= TCON_U8(c1); 01477 break; 01478 case OPC_U4BAND: 01479 BOTH_OPNDS(c0,c1,MTYPE_U4); 01480 TCON_U4(c0) &= TCON_U4(c1); 01481 break; 01482 01483 case OPC_I8BIOR: /* type of result is already correct */ 01484 BOTH_OPNDS(c0,c1,MTYPE_I8); 01485 TCON_I8(c0) |= TCON_I8(c1); 01486 break; 01487 case OPC_I4BIOR: 01488 BOTH_OPNDS(c0,c1,MTYPE_I4); 01489 TCON_I4(c0) |= TCON_I4(c1); 01490 break; 01491 case OPC_U8BIOR: /* type of result is already correct */ 01492 BOTH_OPNDS(c0,c1,MTYPE_U8); 01493 TCON_U8(c0) |= TCON_U8(c1); 01494 break; 01495 case OPC_U4BIOR: 01496 BOTH_OPNDS(c0,c1,MTYPE_U4); 01497 TCON_U4(c0) |= TCON_U4(c1); 01498 break; 01499 01500 case OPC_I8BNOR: /* type of result is already correct */ 01501 BOTH_OPNDS(c0,c1,MTYPE_I8); 01502 TCON_I8(c0) |= TCON_I8(c1); 01503 TCON_I8(c0) = ~TCON_I8(c0); 01504 break; 01505 case OPC_I4BNOR: 01506 BOTH_OPNDS(c0,c1,MTYPE_I4); 01507 TCON_I4(c0) |= TCON_I4(c1); 01508 TCON_I4(c0) = ~TCON_I4(c0); 01509 break; 01510 case OPC_U8BNOR: /* type of result is already correct */ 01511 BOTH_OPNDS(c0,c1,MTYPE_U8); 01512 TCON_U8(c0) |= TCON_U8(c1); 01513 TCON_U8(c0) = ~TCON_U8(c0); 01514 break; 01515 case OPC_U4BNOR: 01516 BOTH_OPNDS(c0,c1,MTYPE_U4); 01517 TCON_U4(c0) |= TCON_U4(c1); 01518 TCON_U4(c0) = ~TCON_U4(c0); 01519 break; 01520 01521 case OPC_I8BNOT: /* type of result is already correct */ 01522 c0 = Targ_Conv(MTYPE_I8,c0); 01523 TCON_I8(c0) = ~TCON_I8(c0); 01524 break; 01525 case OPC_I4BNOT: 01526 c0 = Targ_Conv(MTYPE_I4,c0); 01527 TCON_I4(c0) = ~TCON_I4(c0); 01528 break; 01529 case OPC_U8BNOT: /* type of result is already correct */ 01530 c0 = Targ_Conv(MTYPE_U8,c0); 01531 TCON_U8(c0) = ~TCON_U8(c0); 01532 break; 01533 case OPC_U4BNOT: 01534 c0 = Targ_Conv(MTYPE_U4,c0); 01535 TCON_U4(c0) = ~TCON_U4(c0); 01536 break; 01537 01538 01539 case OPC_I8ADD: /* type of result is already correct */ 01540 BOTH_OPNDS(c0,c1,MTYPE_I8); 01541 TCON_I8(c0) += TCON_I8(c1); 01542 break; 01543 case OPC_I4ADD: 01544 BOTH_OPNDS(c0,c1,MTYPE_I4); 01545 TCON_I4(c0) += TCON_I4(c1); 01546 break; 01547 case OPC_U8ADD: 01548 BOTH_OPNDS(c0,c1,MTYPE_U8); 01549 TCON_U8(c0) += TCON_U8(c1); 01550 break; 01551 case OPC_U4ADD: 01552 BOTH_OPNDS(c0,c1,MTYPE_U4); 01553 TCON_U4(c0) += TCON_U4(c1); 01554 break; 01555 case OPC_F4ADD: 01556 TCON_R4(c0) += TCON_R4(c1); 01557 break; 01558 case OPC_F8ADD: 01559 TCON_R8(c0) += TCON_R8(c1); 01560 break; 01561 #ifdef TARG_NEEDS_QUAD_OPS 01562 case OPC_FQADD: 01563 01564 01565 TCON_R16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_R16(c0)), 01566 R16_To_RQ(TCON_R16(c1)), 01567 &err)); 01568 01569 break; 01570 #endif 01571 case OPC_C4ADD: 01572 TCON_R4(c0) += TCON_R4(c1); 01573 TCON_IR4(c0) += TCON_IR4(c1); 01574 break; 01575 case OPC_C8ADD: 01576 TCON_R8(c0) += TCON_R8(c1); 01577 TCON_IR8(c0) += TCON_IR8(c1); 01578 break; 01579 #ifdef TARG_NEEDS_QUAD_OPS 01580 case OPC_CQADD: 01581 TCON_R16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_R16(c0)), 01582 R16_To_RQ(TCON_R16(c1)), 01583 &err)); 01584 TCON_IR16(c0) = RQ_To_R16(__c_q_add(R16_To_RQ(TCON_IR16(c0)), 01585 R16_To_RQ(TCON_IR16(c1)), 01586 &err)); 01587 01588 break; 01589 #endif 01590 01591 case OPC_I8SUB: /* type of result is already correct */ 01592 BOTH_OPNDS(c0,c1,MTYPE_I8); 01593 TCON_I8(c0) -= TCON_I8(c1); 01594 break; 01595 case OPC_I4SUB: 01596 BOTH_OPNDS(c0,c1,MTYPE_I4); 01597 TCON_I4(c0) -= TCON_I4(c1); 01598 break; 01599 case OPC_U8SUB: 01600 BOTH_OPNDS(c0,c1,MTYPE_U8); 01601 TCON_U8(c0) -= TCON_U8(c1); 01602 break; 01603 case OPC_U4SUB: 01604 BOTH_OPNDS(c0,c1,MTYPE_U4); 01605 TCON_U4(c0) -= TCON_U4(c1); 01606 break; 01607 case OPC_F4SUB: 01608 TCON_R4(c0) -= TCON_R4(c1); 01609 break; 01610 case OPC_F8SUB: 01611 TCON_R8(c0) -= TCON_R8(c1); 01612 break; 01613 #ifdef TARG_NEEDS_QUAD_OPS 01614 case OPC_FQSUB: 01615 01616 01617 TCON_R16(c0) = RQ_To_R16(__c_q_sub(R16_To_RQ(TCON_R16(c0)), 01618 R16_To_RQ(TCON_R16(c1)), 01619 &err)); 01620 01621 break; 01622 #endif 01623 case OPC_C4SUB: 01624 TCON_R4(c0) -= TCON_R4(c1); 01625 TCON_IR4(c0) -= TCON_IR4(c1); 01626 break; 01627 case OPC_C8SUB: 01628 TCON_R8(c0) -= TCON_R8(c1); 01629 TCON_IR8(c0) -= TCON_IR8(c1); 01630 break; 01631 #ifdef TARG_NEEDS_QUAD_OPS 01632 case OPC_CQSUB: 01633 01634 01635 TCON_R16(c0) = RQ_To_R16(__c_q_sub(R16_To_RQ(TCON_R16(c0)), 01636 R16_To_RQ(TCON_R16(c1)), 01637 &err)); 01638 TCON_IR16(c0) = RQ_To_R16(__c_q_sub(R16_To_RQ(TCON_IR16(c0)), 01639 R16_To_RQ(TCON_IR16(c1)), 01640 &err)); 01641 01642 break; 01643 #endif 01644 01645 case OPC_F8SQRT: 01646 if (TCON_R8(c0) >= 0) { 01647 TCON_R8(c0) = sqrt(TCON_R8(c0)); 01648 } else { 01649 *folded = FALSE; 01650 } 01651 break; 01652 case OPC_F4SQRT: 01653 if (TCON_R4(c0) >= 0) { 01654 TCON_R4(c0) = sqrtf(TCON_R4(c0)); 01655 } else { 01656 *folded = FALSE; 01657 } 01658 break; 01659 #ifdef TARG_NEEDS_QUAD_OPS 01660 case OPC_FQSQRT: 01661 if (__c_q_ge(R16_To_RQ(TCON_R16(c0)), 01662 __c_q_flotj(0, &err), 01663 &err)) { 01664 TCON_R16(c0) = RQ_To_R16(__c_q_sqrt(R16_To_RQ(TCON_R16(c0)), 01665 &err)); 01666 } else { 01667 *folded = FALSE; 01668 } 01669 break; 01670 #endif 01671 case OPC_C4SQRT: 01672 case OPC_C8SQRT: 01673 case OPC_CQSQRT: 01674 c0 = complex_sqrt(c0); 01675 break; 01676 01677 case OPC_I8MPY: /* type of result is already correct */ 01678 BOTH_OPNDS(c0,c1,MTYPE_I8); 01679 TCON_I8(c0) *= TCON_I8(c1); 01680 break; 01681 case OPC_I4MPY: 01682 BOTH_OPNDS(c0,c1,MTYPE_I4); 01683 TCON_I4(c0) *= TCON_I4(c1); 01684 break; 01685 case OPC_U8MPY: 01686 BOTH_OPNDS(c0,c1,MTYPE_U8); 01687 TCON_U8(c0) *= TCON_U8(c1); 01688 break; 01689 case OPC_U4MPY: 01690 BOTH_OPNDS(c0,c1,MTYPE_U4); 01691 TCON_U4(c0) *= TCON_U4(c1); 01692 break; 01693 case OPC_F4MPY: 01694 TCON_R4(c0) *= TCON_R4(c1); 01695 break; 01696 case OPC_F8MPY: 01697 TCON_R8(c0) *= TCON_R8(c1); 01698 break; 01699 01700 #ifdef TARG_NEEDS_QUAD_OPS 01701 case OPC_FQMPY: 01702 01703 01704 TCON_R16(c0) = RQ_To_R16(__c_q_mul(R16_To_RQ(TCON_R16(c0)), 01705 R16_To_RQ(TCON_R16(c1)), 01706 &err)); 01707 01708 break; 01709 #endif 01710 01711 case OPC_C4MPY: 01712 TCON_R4(t1) = TCON_R4(c0)*TCON_R4(c1) - TCON_IR4(c0)*TCON_IR4(c1); 01713 TCON_IR4(c0) = TCON_R4(c0)*TCON_IR4(c1) + TCON_IR4(c0)*TCON_R4(c1); 01714 TCON_R4(c0) = TCON_R4(t1); 01715 break; 01716 case OPC_C8MPY: 01717 TCON_R8(t1) = TCON_R8(c0)*TCON_R8(c1) - TCON_IR8(c0)*TCON_IR8(c1); 01718 TCON_IR8(c0) = TCON_R8(c0)*TCON_IR8(c1) + TCON_IR8(c0)*TCON_R8(c1); 01719 TCON_R8(c0) = TCON_R8(t1); 01720 break; 01721 01722 #ifdef TARG_NEEDS_QUAD_OPS 01723 case OPC_CQMPY: 01724 { 01725 QUAD a,b,c,d,r1,r2,r3; 01726 a = R16_To_RQ(TCON_R16(c0)); 01727 b = R16_To_RQ(TCON_IR16(c0)); 01728 c = R16_To_RQ(TCON_R16(c1)); 01729 d = R16_To_RQ(TCON_IR16(c1)); 01730 r1 = __c_q_mul(a,c,&err); 01731 r2 = __c_q_mul(b,d,&err); 01732 r3 = __c_q_sub(r1,r2,&err); 01733 r1 = __c_q_mul(a,d,&err); 01734 r2 = __c_q_mul(b,c,&err); 01735 r1 = __c_q_add(r1,r2,&err); 01736 TCON_R16(c0) = RQ_To_R16(r3); 01737 TCON_IR16(c0) = RQ_To_R16(r1); 01738 } 01739 break; 01740 #endif 01741 01742 case OPC_I8DIV: /* type of result is already correct */ 01743 BOTH_OPNDS(c0,c1,MTYPE_I8); 01744 if (TCON_I8(c1) != 0) { 01745 /* check for possible integer overflow */ 01746 if ( TCON_I8(c1) != -1 || TCON_I8(c0) != MIN_INT_I8 ) 01747 TCON_I8(c0) /= TCON_I8(c1); 01748 else { 01749 /* ErrMsg( EC_Ill_Divide );*/ 01750 *folded = FALSE; 01751 /* leave c0 as MIN_INT_I8 */ 01752 } 01753 } 01754 else { 01755 /* divide by zero; so don't fold */ 01756 /* ErrMsg( EC_Ill_Int_Oflow, TCON_I8(c0), "/", TCON_I8(c1) );*/ 01757 *folded = FALSE; 01758 } 01759 break; 01760 case OPC_I4DIV: 01761 BOTH_OPNDS(c0,c1,MTYPE_I4); 01762 if (TCON_I4(c1) != 0) { 01763 /* check for possible integer overflow */ 01764 if ( TCON_I4(c1) != -1 || TCON_I4(c0) != MIN_INT_I4 ) 01765 TCON_I4(c0) /= TCON_I4(c1); 01766 else { 01767 *folded = FALSE; 01768 /* ErrMsg( EC_Ill_Int_Oflow, TCON_I4(c0), "/", TCON_I4(c1) );*/ 01769 } 01770 } 01771 else { 01772 /* divide by zero; so don't fold */ 01773 /* ErrMsg( EC_Ill_Divide );*/ 01774 *folded = FALSE; 01775 } 01776 break; 01777 case OPC_U8DIV: 01778 BOTH_OPNDS(c0,c1,MTYPE_U8); 01779 if (TCON_U8(c1) != 0) 01780 TCON_U8(c0) /= TCON_U8(c1); 01781 else { 01782 /* divide by zero; so don't fold */ 01783 /* ErrMsg( EC_Ill_UDivide );*/ 01784 *folded = FALSE; 01785 } 01786 break; 01787 case OPC_U4DIV: 01788 BOTH_OPNDS(c0,c1,MTYPE_U4); 01789 if (TCON_U4(c1) != 0) 01790 TCON_U4(c0) /= TCON_U4(c1); 01791 else { 01792 /* divide by zero; so don't fold */ 01793 /* ErrMsg( EC_Ill_UDivide );*/ 01794 *folded = FALSE; 01795 } 01796 break; 01797 case OPC_F4DIV: 01798 if (TCON_R4(c1) == 0.0) { 01799 /* divide by zero; so don't fold */ 01800 /* ErrMsg( EC_Ill_Divide );*/ 01801 *folded = FALSE; 01802 } 01803 TCON_R4(c0) /= TCON_R4(c1); 01804 break; 01805 case OPC_F8DIV: 01806 if (TCON_R8(c1) == 0.0) { 01807 /* divide by zero; so don't fold */ 01808 /* ErrMsg( EC_Ill_Divide );*/ 01809 *folded = FALSE; 01810 } 01811 TCON_R8(c0) /= TCON_R8(c1); 01812 break; 01813 #ifdef TARG_NEEDS_QUAD_OPS 01814 case OPC_FQDIV: 01815 01816 01817 if (__c_q_eq(R16_To_RQ(TCON_R16(c1)), 01818 __c_q_flotj(0, &err), 01819 &err)) { 01820 /* divide by zero; so don't fold */ 01821 /* ErrMsg( EC_Ill_Divide );*/ 01822 *folded = FALSE; 01823 /* break; */ 01824 } 01825 TCON_R16(c0) = RQ_To_R16(__c_q_div(R16_To_RQ(TCON_R16(c0)), 01826 R16_To_RQ(TCON_R16(c1)), 01827 &err)); 01828 01829 break; 01830 #endif 01831 01832 case OPC_C8DIV: 01833 case OPC_CQDIV: 01834 case OPC_C4DIV: 01835 c0 = complex_divide(c0,c1); 01836 break; 01837 01838 case OPC_I8REM: /* type of result is already correct */ 01839 BOTH_OPNDS(c0,c1,MTYPE_I8); 01840 if (TCON_I8(c1) != 0) { 01841 /* check for possible integer overflow */ 01842 if ( TCON_I8(c1) != -1 || TCON_I8(c0) != MIN_INT_I8 ) 01843 TCON_I8(c0) %= TCON_I8(c1); 01844 else { 01845 /* ErrMsg( EC_Ill_Int_Oflow, TCON_I8(c0), "%", TCON_I8(c1) );*/ 01846 *folded = FALSE; 01847 } 01848 } 01849 else { 01850 /* rem by zero; so don't fold */ 01851 /* ErrMsg( EC_Ill_Modulus );*/ 01852 *folded = FALSE; 01853 } 01854 break; 01855 case OPC_I4REM: 01856 BOTH_OPNDS(c0,c1,MTYPE_I4); 01857 if (TCON_I4(c1) != 0) { 01858 /* check for possible integer overflow */ 01859 if ( TCON_I4(c1) != -1 || TCON_I4(c0) != MIN_INT_I4 ) 01860 TCON_I4(c0) %= TCON_I4(c1); 01861 else { 01862 /* ErrMsg( EC_Ill_Int_Oflow, TCON_I4(c0), "%", TCON_I4(c1) );*/ 01863 *folded = FALSE; 01864 } 01865 } 01866 else { 01867 /* rem by zero; so don't fold */ 01868 /* ErrMsg( EC_Ill_Modulus );*/ 01869 *folded = FALSE; 01870 } 01871 break; 01872 case OPC_U8REM: 01873 BOTH_OPNDS(c0,c1,MTYPE_U8); 01874 if (TCON_U8(c1) != 0) 01875 TCON_U8(c0) %= TCON_U8(c1); 01876 else { 01877 /* rem by zero; so don't fold */ 01878 /* ErrMsg( EC_Ill_UModulus );*/ 01879 *folded = FALSE; 01880 } 01881 break; 01882 case OPC_U4REM: 01883 BOTH_OPNDS(c0,c1,MTYPE_U4); 01884 if (TCON_U4(c1) != 0) 01885 TCON_U4(c0) %= TCON_U4(c1); 01886 else { 01887 /* rem by zero; so don't fold */ 01888 /* ErrMsg( EC_Ill_UModulus );*/ 01889 *folded = FALSE; 01890 } 01891 break; 01892 01893 case OPC_I8MOD: /* type of result is already correct */ 01894 BOTH_OPNDS(c0,c1,MTYPE_I8); 01895 if (TCON_I8(c1) != 0) { 01896 /* check for possible integer overflow */ 01897 if ( TCON_I8(c1) != -1 || TCON_I8(c0) != MIN_INT_I8 ) { 01898 INT64 rem = TCON_I8(c0) % TCON_I8(c1); 01899 if ( rem != 0 && ( (TCON_I8(c0)>0) ^ (TCON_I8(c1)>0) ) ) 01900 rem += TCON_I8(c1); 01901 TCON_I8(c0) = rem; 01902 } 01903 else { 01904 /* ErrMsg( EC_Ill_Int_Oflow, TCON_I8(c0), "%", TCON_I8(c1) );*/ 01905 *folded = FALSE; 01906 } 01907 } else { 01908 /* mod by 0; so don't fold */ 01909 /* ErrMsg( EC_Ill_Modulus );*/ 01910 *folded = FALSE; 01911 } 01912 break; 01913 case OPC_I4MOD: 01914 BOTH_OPNDS(c0,c1,MTYPE_I4); 01915 if (TCON_I4(c1) != 0) { 01916 /* check for possible integer overflow */ 01917 if ( TCON_I4(c1) != -1 || TCON_I4(c0) != MIN_INT_I4 ) { 01918 INT32 rem = TCON_I4(c0) % TCON_I4(c1); 01919 if ( rem != 0 && ( (TCON_I4(c0)>0) ^ (TCON_I4(c1)>0) ) ) 01920 rem += TCON_I4(c1); 01921 TCON_I4(c0) = rem; 01922 } 01923 else { 01924 /* ErrMsg( EC_Ill_Int_Oflow, TCON_I4(c0), "%", TCON_I4(c1) );*/ 01925 *folded = FALSE; 01926 } 01927 } else { 01928 /* mod by 0; so don't fold */ 01929 /* ErrMsg( EC_Ill_Modulus );*/ 01930 *folded = FALSE; 01931 } 01932 break; 01933 case OPC_U8MOD: 01934 BOTH_OPNDS(c0,c1,MTYPE_U8); 01935 if (TCON_U8(c1) != 0) 01936 TCON_U8(c0) %= TCON_U8(c1); 01937 else { 01938 /* mod by 0; so don't fold */ 01939 /* ErrMsg( EC_Ill_UModulus );*/ 01940 *folded = FALSE; 01941 } 01942 break; 01943 case OPC_U4MOD: 01944 BOTH_OPNDS(c0,c1,MTYPE_U4); 01945 if (TCON_U4(c1) != 0) 01946 TCON_U4(c0) %= TCON_U4(c1); 01947 else { 01948 /* mod by 0; so don't fold */ 01949 /* ErrMsg( EC_Ill_UModulus );*/ 01950 *folded = FALSE; 01951 } 01952 break; 01953 01954 01955 case OPC_F4RECIP: 01956 c0 = Targ_WhirlOp(OPC_F4DIV,Host_To_Targ_Float(MTYPE_F4,1.0),c0,folded); 01957 break; 01958 case OPC_F8RECIP: 01959 c0 = Targ_WhirlOp(OPC_F8DIV,Host_To_Targ_Float(MTYPE_F8,1.0),c0,folded); 01960 break; 01961 case OPC_FQRECIP: 01962 c0 = Targ_WhirlOp(OPC_FQDIV,Host_To_Targ_Float(MTYPE_FQ,1.0),c0,folded); 01963 break; 01964 case OPC_C4RECIP: 01965 c0 = Targ_WhirlOp(OPC_C4DIV,Host_To_Targ_Float(MTYPE_C4,1.0),c0,folded); 01966 break; 01967 case OPC_C8RECIP: 01968 c0 = Targ_WhirlOp(OPC_C8DIV,Host_To_Targ_Float(MTYPE_C8,1.0),c0,folded); 01969 break; 01970 case OPC_CQRECIP: 01971 c0 = Targ_WhirlOp(OPC_CQDIV,Host_To_Targ_Float(MTYPE_CQ,1.0),c0,folded); 01972 break; 01973 01974 case OPC_F4RSQRT: 01975 c0 = Targ_WhirlOp(OPC_F4SQRT,c0,c0,folded); 01976 if (*folded) c0 = Targ_WhirlOp(OPC_F4DIV,Host_To_Targ_Float(MTYPE_F4,1.0),c0,folded); 01977 break; 01978 case OPC_F8RSQRT: 01979 c0 = Targ_WhirlOp(OPC_F8SQRT,c0,c0,folded); 01980 if (*folded) c0 = Targ_WhirlOp(OPC_F8DIV,Host_To_Targ_Float(MTYPE_F8,1.0),c0,folded); 01981 break; 01982 case OPC_FQRSQRT: 01983 c0 = Targ_WhirlOp(OPC_FQSQRT,c0,c0,folded); 01984 if (*folded) c0 = Targ_WhirlOp(OPC_FQDIV,Host_To_Targ_Float(MTYPE_FQ,1.0),c0,folded); 01985 break; 01986 case OPC_C4RSQRT: 01987 c0 = Targ_WhirlOp(OPC_C4SQRT,c0,c0,folded); 01988 if (*folded) c0 = Targ_WhirlOp(OPC_C4DIV,Host_To_Targ_Float(MTYPE_C4,1.0),c0,folded); 01989 break; 01990 case OPC_C8RSQRT: 01991 c0 = Targ_WhirlOp(OPC_C8SQRT,c0,c0,folded); 01992 if (*folded) c0 = Targ_WhirlOp(OPC_C8DIV,Host_To_Targ_Float(MTYPE_C8,1.0),c0,folded); 01993 break; 01994 case OPC_CQRSQRT: 01995 c0 = Targ_WhirlOp(OPC_CQSQRT,c0,c0,folded); 01996 if (*folded) c0 = Targ_WhirlOp(OPC_CQDIV,Host_To_Targ_Float(MTYPE_CQ,1.0),c0,folded); 01997 break; 01998 01999 case OPC_I8MIN: 02000 BOTH_OPNDS(c0,c1,MTYPE_I8); 02001 TCON_I8(c0) = TCON_I8(c0)<=TCON_I8(c1)? TCON_I8(c0) : TCON_I8(c1); 02002 break; 02003 case OPC_I4MIN: 02004 BOTH_OPNDS(c0,c1,MTYPE_I4); 02005 TCON_I4(c0) = TCON_I4(c0)<=TCON_I4(c1)? TCON_I4(c0) : TCON_I4(c1); 02006 break; 02007 case OPC_U8MIN: 02008 BOTH_OPNDS(c0,c1,MTYPE_U8); 02009 TCON_U8(c0) = TCON_U8(c0)<=TCON_U8(c1)? TCON_U8(c0) : TCON_U8(c1); 02010 break; 02011 case OPC_U4MIN: 02012 BOTH_OPNDS(c0,c1,MTYPE_U4); 02013 TCON_U4(c0) = TCON_U4(c0)<=TCON_U4(c1)? TCON_U4(c0) : TCON_U4(c1); 02014 break; 02015 02016 case OPC_I8MAX: 02017 BOTH_OPNDS(c0,c1,MTYPE_I8); 02018 TCON_I8(c0) = TCON_I8(c0)>=TCON_I8(c1)? TCON_I8(c0) : TCON_I8(c1); 02019 break; 02020 case OPC_I4MAX: 02021 BOTH_OPNDS(c0,c1,MTYPE_I4); 02022 TCON_I4(c0) = TCON_I4(c0)>=TCON_I4(c1)? TCON_I4(c0) : TCON_I4(c1); 02023 break; 02024 case OPC_U8MAX: 02025 BOTH_OPNDS(c0,c1,MTYPE_U8); 02026 TCON_U8(c0) = TCON_U8(c0)>=TCON_U8(c1)? TCON_U8(c0) : TCON_U8(c1); 02027 break; 02028 case OPC_U4MAX: 02029 BOTH_OPNDS(c0,c1,MTYPE_U4); 02030 TCON_U4(c0) = TCON_U4(c0)>=TCON_U4(c1)? TCON_U4(c0) : TCON_U4(c1); 02031 break; 02032 02033 case OPC_F4MIN: 02034 TCON_R4(c0) = TCON_R4(c0) < TCON_R4(c1) ? 02035 TCON_R4(c0) : TCON_R4(c1); 02036 break; 02037 case OPC_F4MAX: 02038 TCON_R4(c0) = TCON_R4(c0) < TCON_R4(c1) ? 02039 TCON_R4(c1) : TCON_R4(c0); 02040 break; 02041 case OPC_F8MIN: 02042 TCON_R8(c0) = TCON_R8(c0) < TCON_R8(c1) ? 02043 TCON_R8(c0) : TCON_R8(c1); 02044 break; 02045 case OPC_F8MAX: 02046 TCON_R8(c0) = TCON_R8(c0) < TCON_R8(c1) ? 02047 TCON_R8(c1) : TCON_R8(c0); 02048 break; 02049 02050 #ifdef TARG_NEEDS_QUAD_OPS 02051 case OPC_FQMIN: 02052 02053 02054 TCON_R16(c0) = __c_q_lt(R16_To_RQ(TCON_R16(c0)), 02055 R16_To_RQ(TCON_R16(c1)), &err) ? 02056 TCON_R16(c0) : TCON_R16(c1); 02057 02058 break; 02059 02060 case OPC_FQMAX: 02061 02062 02063 TCON_R16(c0) = __c_q_lt(R16_To_RQ(TCON_R16(c0)), 02064 R16_To_RQ(TCON_R16(c1)), &err) ? 02065 TCON_R16(c1) : TCON_R16(c0); 02066 02067 break; 02068 #endif 02069 02070 02071 case OPC_C4COMPLEX: 02072 TCON_IR4(c0) = TCON_R4(c1); 02073 TCON_ty(c0) = MTYPE_C4; 02074 break; 02075 case OPC_C8COMPLEX: 02076 TCON_IR8(c0) = TCON_R8(c1); 02077 TCON_ty(c0) = MTYPE_C8; 02078 break; 02079 case OPC_CQCOMPLEX: 02080 TCON_IR16(c0) = TCON_R16(c1); 02081 TCON_ty(c0) = MTYPE_CQ; 02082 break; 02083 02084 02085 case OPC_F4REALPART: 02086 TCON_ty(c0) = MTYPE_F4; 02087 break; 02088 case OPC_F8REALPART: 02089 TCON_ty(c0) = MTYPE_F8; 02090 break; 02091 case OPC_FQREALPART: 02092 TCON_ty(c0) = MTYPE_FQ; 02093 break; 02094 02095 02096 case OPC_F4IMAGPART: 02097 TCON_R4(c0) = TCON_IR4(c0); 02098 TCON_ty(c0) = MTYPE_F4; 02099 break; 02100 case OPC_F8IMAGPART: 02101 TCON_R8(c0) = TCON_IR8(c0); 02102 TCON_ty(c0) = MTYPE_F8; 02103 break; 02104 case OPC_FQIMAGPART: 02105 TCON_R16(c0) = TCON_IR16(c0); 02106 TCON_ty(c0) = MTYPE_FQ; 02107 break; 02108 02109 default: 02110 FmtAssert ( folded, ("Targ_WhirlOp can not handle %s", OPCODE_name(op)) ); 02111 *folded = FALSE; 02112 break; 02113 } 02114 #ifdef DEBUG_FOLD 02115 printf(" 0x%llx (%s)\n",TCON_I8(c0),Mtype_Name(TCON_ty(c0))); 02116 #endif 02117 02118 return c0; 02119 } /* Targ_WhirlOp */ 02120 02121 /* ==================================================================== 02122 * 02123 * Targ_Conv 02124 * 02125 * Convert a TCON's value to a new type. We currently assume C's 02126 * conversion rules. 02127 * 02128 * ==================================================================== 02129 */ 02130 02131 TCON 02132 Targ_Conv ( TYPE_ID ty_to, TCON c ) 02133 { 02134 TYPE_ID ty_from; 02135 TCON r; 02136 #ifdef TARG_NEEDS_QUAD_OPS 02137 INT32 err; 02138 #endif 02139 02140 #define FROM_TO(type_from, type_to) (type_from)*(MTYPE_LAST+1)+(type_to) 02141 02142 r = MTYPE_size_min(ty_to) <= 32 ? Zero_I4_Tcon : Zero_I8_Tcon; 02143 TCON_v0(r) = 0; 02144 TCON_v1(r) = 0; 02145 TCON_v2(r) = 0; 02146 TCON_v3(r) = 0; 02147 TCON_iv0(r) = 0; 02148 TCON_iv1(r) = 0; 02149 TCON_iv2(r) = 0; 02150 TCON_iv3(r) = 0; 02151 ty_from = TCON_ty(c); 02152 Is_True ( ty_to > MTYPE_UNKNOWN && ty_to <= MTYPE_LAST, 02153 ("Bad dest type in Targ_Conv: %s", Mtype_Name(ty_to)) ); 02154 Is_True ( ty_from > MTYPE_UNKNOWN && ty_from <= MTYPE_LAST, 02155 ("Bad dest type in Targ_Conv: %s", Mtype_Name(ty_from)) ); 02156 02157 if (ty_from == ty_to) 02158 return c; 02159 /* TODO: sign or zero extend when converting from small to large. 02160 make sure it matches convert.c 02161 */ 02162 switch ( FROM_TO(ty_from, ty_to) ) { 02163 #ifdef TARG_NEEDS_QUAD_OPS 02164 case FROM_TO(MTYPE_C8, MTYPE_CQ): 02165 TCON_R16(r) = RQ_To_R16(__c_q_extd(TCON_R8(c), &err)); 02166 TCON_IR16(r) = RQ_To_R16(__c_q_extd(TCON_IR8(c), &err)); 02167 break; 02168 case FROM_TO(MTYPE_C4, MTYPE_CQ): 02169 TCON_R16(r) = RQ_To_R16(__c_q_ext(TCON_R4(c), &err)); 02170 TCON_IR16(r) = RQ_To_R16(__c_q_ext(TCON_IR4(c), &err)); 02171 break; 02172 case FROM_TO(MTYPE_FQ, MTYPE_CQ): 02173 TCON_R16(r) = TCON_R16(c); 02174 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02175 break; 02176 case FROM_TO(MTYPE_F8, MTYPE_CQ): 02177 TCON_R16(r) = RQ_To_R16(__c_q_extd(TCON_R8(c), &err)); 02178 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02179 break; 02180 case FROM_TO(MTYPE_F4, MTYPE_CQ): 02181 TCON_R16(r) = RQ_To_R16(__c_q_ext(TCON_R4(c), &err)); 02182 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02183 break; 02184 case FROM_TO(MTYPE_I8, MTYPE_CQ): 02185 TCON_R16(r) = RQ_To_R16(__c_q_flotk(TCON_I8(c), &err)); 02186 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02187 break; 02188 case FROM_TO(MTYPE_I4, MTYPE_CQ): 02189 case FROM_TO(MTYPE_I2, MTYPE_CQ): 02190 case FROM_TO(MTYPE_I1, MTYPE_CQ): 02191 TCON_R16(r) = RQ_To_R16(__c_q_flotj(TCON_v0(c), &err)); 02192 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02193 break; 02194 case FROM_TO(MTYPE_U8, MTYPE_CQ): 02195 TCON_R16(r) = RQ_To_R16(__c_q_flotku(TCON_U8(c), &err)); 02196 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02197 break; 02198 case FROM_TO(MTYPE_U4, MTYPE_CQ): 02199 case FROM_TO(MTYPE_U2, MTYPE_CQ): 02200 case FROM_TO(MTYPE_U1, MTYPE_CQ): 02201 TCON_R16(r) = RQ_To_R16(__c_q_flotju(TCON_u0(c), &err)); 02202 TCON_IR16(r) = RQ_To_R16(__c_q_ext(0.0, &err)); 02203 break; 02204 #endif /* TARG_NEEDS_QUAD_OPS */ 02205 02206 #ifdef TARG_NEEDS_QUAD_OPS 02207 case FROM_TO(MTYPE_CQ, MTYPE_C8): 02208 TCON_R8(r) = __c_dble_q(R16_To_RQ(TCON_R16(c)), &err); 02209 TCON_IR8(r) = __c_dble_q(R16_To_RQ(TCON_IR16(c)), &err); 02210 break; 02211 #endif /* TARG_NEEDS_QUAD_OPS */ 02212 case FROM_TO(MTYPE_C4, MTYPE_C8): 02213 TCON_R8(r) = TCON_R4(c); 02214 TCON_IR8(r) = TCON_IR4(c); 02215 break; 02216 #ifdef TARG_NEEDS_QUAD_OPS 02217 case FROM_TO(MTYPE_FQ, MTYPE_C8): 02218 TCON_R8(r) = __c_dble_q(R16_To_RQ(TCON_R16(c)), &err); 02219 TCON_IR8(r) = 0.0; 02220 break; 02221 #endif /* TARG_NEEDS_QUAD_OPS */ 02222 case FROM_TO(MTYPE_F8, MTYPE_C8): 02223 TCON_R8(r) = TCON_R8(c); 02224 TCON_IR8(r) = 0.0; 02225 break; 02226 case FROM_TO(MTYPE_F4, MTYPE_C8): 02227 TCON_R8(r) = TCON_R4(c); 02228 TCON_IR8(r) = 0.0; 02229 break; 02230 case FROM_TO(MTYPE_I8, MTYPE_C8): 02231 TCON_R8(r) = TCON_I8(c); 02232 TCON_IR8(r) = 0.0; 02233 break; 02234 case FROM_TO(MTYPE_I4, MTYPE_C8): 02235 case FROM_TO(MTYPE_I2, MTYPE_C8): 02236 case FROM_TO(MTYPE_I1, MTYPE_C8): 02237 TCON_R8(r) = TCON_v0(c); 02238 TCON_IR8(r) = 0.0; 02239 break; 02240 case FROM_TO(MTYPE_U8, MTYPE_C8): 02241 TCON_R8(r) = TCON_U8(c); 02242 TCON_IR8(r) = 0.0; 02243 break; 02244 case FROM_TO(MTYPE_U4, MTYPE_C8): 02245 case FROM_TO(MTYPE_U2, MTYPE_C8): 02246 case FROM_TO(MTYPE_U1, MTYPE_C8): 02247 TCON_R8(r) = TCON_u0(c); 02248 TCON_IR8(r) = 0.0; 02249 break; 02250 02251 #ifdef TARG_NEEDS_QUAD_OPS 02252 case FROM_TO(MTYPE_CQ, MTYPE_C4): 02253 Set_TCON_R4(r, __c_sngl_q(R16_To_RQ(TCON_R16(c)), &err)); 02254 Set_TCON_IR4(r, __c_sngl_q(R16_To_RQ(TCON_IR16(c)), &err)); 02255 break; 02256 #endif /* TARG_NEEDS_QUAD_OPS */ 02257 case FROM_TO(MTYPE_C8, MTYPE_C4): 02258 TCON_R4(r) = TCON_R8(c); 02259 TCON_IR4(r) = TCON_IR8(c); 02260 break; 02261 #ifdef TARG_NEEDS_QUAD_OPS 02262 case FROM_TO(MTYPE_FQ, MTYPE_C4): 02263 Set_TCON_R4(r, __c_sngl_q(R16_To_RQ(TCON_R16(c)), &err)); 02264 TCON_IR4(r) = 0.0; 02265 break; 02266 #endif /* TARG_NEEDS_QUAD_OPS */ 02267 case FROM_TO(MTYPE_F8, MTYPE_C4): 02268 TCON_R4(r) = TCON_R8(c); 02269 TCON_IR4(r) = 0.0; 02270 break; 02271 case FROM_TO(MTYPE_F4, MTYPE_C4): 02272 TCON_R4(r) = TCON_R4(c); 02273 TCON_IR4(r) = 0.0; 02274 break; 02275 case FROM_TO(MTYPE_I8, MTYPE_C4): 02276 TCON_R4(r) = TCON_I8(c); 02277 TCON_IR4(r) = 0.0; 02278 break; 02279 case FROM_TO(MTYPE_I4, MTYPE_C4): 02280 case FROM_TO(MTYPE_I2, MTYPE_C4): 02281 case FROM_TO(MTYPE_I1, MTYPE_C4): 02282 TCON_R4(r) = TCON_v0(c); 02283 TCON_IR4(r) = 0.0; 02284 break; 02285 case FROM_TO(MTYPE_U8, MTYPE_C4): 02286 TCON_R4(r) = TCON_U8(c); 02287 TCON_IR4(r) = 0.0; 02288 break; 02289 case FROM_TO(MTYPE_U4, MTYPE_C4): 02290 case FROM_TO(MTYPE_U2, MTYPE_C4): 02291 case FROM_TO(MTYPE_U1, MTYPE_C4): 02292 TCON_R4(r) = TCON_u0(c); 02293 TCON_IR4(r) = 0.0; 02294 break; 02295 02296 #ifdef TARG_NEEDS_QUAD_OPS 02297 case FROM_TO(MTYPE_CQ, MTYPE_FQ): 02298 TCON_R16(r) = TCON_R16(c); 02299 break; 02300 case FROM_TO(MTYPE_C8, MTYPE_FQ): 02301 TCON_R16(r) = RQ_To_R16(__c_q_extd(TCON_R8(c), &err)); 02302 break; 02303 case FROM_TO(MTYPE_C4, MTYPE_FQ): 02304 TCON_R16(r) = RQ_To_R16(__c_q_ext(TCON_R4(c), &err)); 02305 break; 02306 case FROM_TO(MTYPE_F8, MTYPE_FQ): 02307 TCON_R16(r) = RQ_To_R16(__c_q_extd(TCON_R8(c), &err)); 02308 break; 02309 case FROM_TO(MTYPE_F4, MTYPE_FQ): 02310 TCON_R16(r) = RQ_To_R16(__c_q_ext(TCON_R4(c), &err)); 02311 break; 02312 case FROM_TO(MTYPE_I8, MTYPE_FQ): 02313 TCON_R16(r) = RQ_To_R16(__c_q_flotk(TCON_I8(c), &err)); 02314 break; 02315 case FROM_TO(MTYPE_I4, MTYPE_FQ): 02316 case FROM_TO(MTYPE_I2, MTYPE_FQ): 02317 case FROM_TO(MTYPE_I1, MTYPE_FQ): 02318 TCON_R16(r) = RQ_To_R16(__c_q_flotj(TCON_v0(c), &err)); 02319 break; 02320 case FROM_TO(MTYPE_U8, MTYPE_FQ): 02321 TCON_R16(r) = RQ_To_R16(__c_q_flotku(TCON_U8(c), &err)); 02322 break; 02323 case FROM_TO(MTYPE_U4, MTYPE_FQ): 02324 case FROM_TO(MTYPE_U2, MTYPE_FQ): 02325 case FROM_TO(MTYPE_U1, MTYPE_FQ): 02326 TCON_R16(r) = RQ_To_R16(__c_q_flotju(TCON_u0(c), &err)); 02327 break; 02328 #endif /* TARG_NEEDS_QUAD_OPS */ 02329 02330 #ifdef TARG_NEEDS_QUAD_OPS 02331 case FROM_TO(MTYPE_CQ, MTYPE_F8): 02332 TCON_R8(r) = __c_dble_q(R16_To_RQ(TCON_R16(c)), &err); 02333 break; 02334 #endif /* TARG_NEEDS_QUAD_OPS */ 02335 case FROM_TO(MTYPE_C8, MTYPE_F8): 02336 TCON_R8(r) = TCON_R8(c); 02337 break; 02338 case FROM_TO(MTYPE_C4, MTYPE_F8): 02339 TCON_R8(r) = TCON_R4(c); 02340 break; 02341 #ifdef TARG_NEEDS_QUAD_OPS 02342 case FROM_TO(MTYPE_FQ, MTYPE_F8): 02343 TCON_R8(r) = __c_dble_q(R16_To_RQ(TCON_R16(c)), &err); 02344 break; 02345 #endif /* TARG_NEEDS_QUAD_OPS */ 02346 case FROM_TO(MTYPE_F4, MTYPE_F8): 02347 TCON_R8(r) = TCON_R4(c); 02348 break; 02349 case FROM_TO(MTYPE_I8, MTYPE_F8): 02350 TCON_R8(r) = TCON_I8(c); 02351 break; 02352 case FROM_TO(MTYPE_I4, MTYPE_F8): 02353 case FROM_TO(MTYPE_I2, MTYPE_F8): 02354 case FROM_TO(MTYPE_I1, MTYPE_F8): 02355 TCON_R8(r) = TCON_v0(c); 02356 break; 02357 case FROM_TO(MTYPE_U8, MTYPE_F8): 02358 TCON_R8(r) = TCON_U8(c); 02359 break; 02360 case FROM_TO(MTYPE_U4, MTYPE_F8): 02361 case FROM_TO(MTYPE_U2, MTYPE_F8): 02362 case FROM_TO(MTYPE_U1, MTYPE_F8): 02363 TCON_R8(r) = TCON_u0(c); 02364 break; 02365 02366 #ifdef TARG_NEEDS_QUAD_OPS 02367 case FROM_TO(MTYPE_CQ, MTYPE_F4): 02368 Set_TCON_R4(r, __c_sngl_q(R16_To_RQ(TCON_R16(c)), &err)); 02369 break; 02370 #endif /* TARG_NEEDS_QUAD_OPS */ 02371 case FROM_TO(MTYPE_C8, MTYPE_F4): 02372 TCON_R4(r) = TCON_R8(c); 02373 break; 02374 case FROM_TO(MTYPE_C4, MTYPE_F4): 02375 TCON_R4(r) = TCON_R4(c); 02376 break; 02377 #ifdef TARG_NEEDS_QUAD_OPS 02378 case FROM_TO(MTYPE_FQ, MTYPE_F4): 02379 Set_TCON_R4(r, __c_sngl_q(R16_To_RQ(TCON_R16(c)), &err)); 02380 break; 02381 #endif /* TARG_NEEDS_QUAD_OPS */ 02382 case FROM_TO(MTYPE_F8, MTYPE_F4): 02383 TCON_R4(r) = TCON_R8(c); 02384 break; 02385 case FROM_TO(MTYPE_I8, MTYPE_F4): 02386 TCON_R4(r) = TCON_I8(c); 02387 break; 02388 case FROM_TO(MTYPE_I4, MTYPE_F4): 02389 case FROM_TO(MTYPE_I2, MTYPE_F4): 02390 case FROM_TO(MTYPE_I1, MTYPE_F4): 02391 TCON_R4(r) = TCON_v0(c); 02392 break; 02393 case FROM_TO(MTYPE_U8, MTYPE_F4): 02394 TCON_R4(r) = TCON_U8(c); 02395 break; 02396 case FROM_TO(MTYPE_U4, MTYPE_F4): 02397 case FROM_TO(MTYPE_U2, MTYPE_F4): 02398 case FROM_TO(MTYPE_U1, MTYPE_F4): 02399 TCON_R4(r) = TCON_u0(c); 02400 break; 02401 02402 #ifdef TARG_NEEDS_QUAD_OPS 02403 case FROM_TO(MTYPE_CQ, MTYPE_I8): 02404 TCON_I8(r) = __c_ki_qint(R16_To_RQ(TCON_R16(c)), &err); 02405 break; 02406 #endif /* TARG_NEEDS_QUAD_OPS */ 02407 case FROM_TO(MTYPE_C8, MTYPE_I8): 02408 TCON_I8(r) = (INT64)TCON_R8(c); 02409 break; 02410 case FROM_TO(MTYPE_C4, MTYPE_I8): 02411 TCON_I8(r) = (INT64)TCON_R4(c); 02412 break; 02413 #ifdef TARG_NEEDS_QUAD_OPS 02414 case FROM_TO(MTYPE_FQ, MTYPE_I8): 02415 TCON_I8(r) = __c_ki_qint(R16_To_RQ(TCON_R16(c)), &err); 02416 break; 02417 #endif /* TARG_NEEDS_QUAD_OPS */ 02418 case FROM_TO(MTYPE_F8, MTYPE_I8): 02419 TCON_I8(r) = (INT64)TCON_R8(c); 02420 break; 02421 case FROM_TO(MTYPE_F4, MTYPE_I8): 02422 TCON_I8(r) = (INT64)TCON_R4(c); 02423 break; 02424 case FROM_TO(MTYPE_I4, MTYPE_I8): 02425 case FROM_TO(MTYPE_I2, MTYPE_I8): 02426 case FROM_TO(MTYPE_I1, MTYPE_I8): 02427 case FROM_TO(MTYPE_B, MTYPE_I8): 02428 TCON_I8(r) = TCON_v0(c); 02429 break; 02430 case FROM_TO(MTYPE_U8, MTYPE_I8): 02431 TCON_I8(r) = TCON_U8(c); 02432 break; 02433 case FROM_TO(MTYPE_U4, MTYPE_I8): 02434 case FROM_TO(MTYPE_U2, MTYPE_I8): 02435 case FROM_TO(MTYPE_U1, MTYPE_I8): 02436 TCON_I8(r) = TCON_u0(c); 02437 break; 02438 02439 #ifdef TARG_NEEDS_QUAD_OPS 02440 case FROM_TO(MTYPE_CQ, MTYPE_I4): 02441 case FROM_TO(MTYPE_CQ, MTYPE_I2): 02442 case FROM_TO(MTYPE_CQ, MTYPE_I1): 02443 TCON_v0(r) = __c_ji_qint(R16_To_RQ(TCON_R16(c)), &err); 02444 break; 02445 #endif 02446 case FROM_TO(MTYPE_C8, MTYPE_I4): 02447 case FROM_TO(MTYPE_C8, MTYPE_I2): 02448 case FROM_TO(MTYPE_C8, MTYPE_I1): 02449 TCON_v0(r) = (INT32)TCON_R8(c); 02450 break; 02451 case FROM_TO(MTYPE_C4, MTYPE_I4): 02452 case FROM_TO(MTYPE_C4, MTYPE_I2): 02453 case FROM_TO(MTYPE_C4, MTYPE_I1): 02454 TCON_v0(r) = (INT32)TCON_R4(c); 02455 break; 02456 #ifdef TARG_NEEDS_QUAD_OPS 02457 case FROM_TO(MTYPE_FQ, MTYPE_I4): 02458 case FROM_TO(MTYPE_FQ, MTYPE_I2): 02459 case FROM_TO(MTYPE_FQ, MTYPE_I1): 02460 TCON_v0(r) = __c_ji_qint(R16_To_RQ(TCON_R16(c)), &err); 02461 break; 02462 #endif 02463 case FROM_TO(MTYPE_F8, MTYPE_I4): 02464 case FROM_TO(MTYPE_F8, MTYPE_I2): 02465 case FROM_TO(MTYPE_F8, MTYPE_I1): 02466 TCON_v0(r) = (INT32)TCON_R8(c); 02467 break; 02468 case FROM_TO(MTYPE_F4, MTYPE_I4): 02469 case FROM_TO(MTYPE_F4, MTYPE_I2): 02470 case FROM_TO(MTYPE_F4, MTYPE_I1): 02471 TCON_v0(r) = (INT32)TCON_R4(c); 02472 break; 02473 case FROM_TO(MTYPE_I8, MTYPE_I4): 02474 case FROM_TO(MTYPE_I8, MTYPE_I2): 02475 case FROM_TO(MTYPE_I8, MTYPE_I1): 02476 TCON_v0(r) = TCON_I8(c); 02477 break; 02478 case FROM_TO(MTYPE_I4, MTYPE_I2): 02479 case FROM_TO(MTYPE_I4, MTYPE_I1): 02480 case FROM_TO(MTYPE_I2, MTYPE_I4): 02481 case FROM_TO(MTYPE_I2, MTYPE_I1): 02482 case FROM_TO(MTYPE_I1, MTYPE_I4): 02483 case FROM_TO(MTYPE_I1, MTYPE_I2): 02484 case FROM_TO(MTYPE_B, MTYPE_I4): 02485 TCON_v0(r) = TCON_v0(c); 02486 break; 02487 case FROM_TO(MTYPE_U8, MTYPE_I4): 02488 case FROM_TO(MTYPE_U8, MTYPE_I2): 02489 case FROM_TO(MTYPE_U8, MTYPE_I1): 02490 TCON_v0(r) = TCON_U8(c); 02491 break; 02492 case FROM_TO(MTYPE_U4, MTYPE_I4): 02493 case FROM_TO(MTYPE_U4, MTYPE_I2): 02494 case FROM_TO(MTYPE_U4, MTYPE_I1): 02495 case FROM_TO(MTYPE_U2, MTYPE_I4): 02496 case FROM_TO(MTYPE_U2, MTYPE_I2): 02497 case FROM_TO(MTYPE_U2, MTYPE_I1): 02498 case FROM_TO(MTYPE_U1, MTYPE_I4): 02499 case FROM_TO(MTYPE_U1, MTYPE_I2): 02500 case FROM_TO(MTYPE_U1, MTYPE_I1): 02501 TCON_v0(r) = TCON_v0(c); 02502 break; 02503 02504 #ifdef TARG_NEEDS_QUAD_OPS 02505 case FROM_TO(MTYPE_CQ, MTYPE_U8): 02506 TCON_U8(r) = __c_ki_quint(R16_To_RQ(TCON_R16(c)), &err); 02507 break; 02508 #endif 02509 case FROM_TO(MTYPE_C8, MTYPE_U8): 02510 TCON_U8(r) = (UINT64)TCON_R8(c); 02511 break; 02512 case FROM_TO(MTYPE_C4, MTYPE_U8): 02513 TCON_U8(r) = (UINT64)TCON_R4(c); 02514 break; 02515 #ifdef TARG_NEEDS_QUAD_OPS 02516 case FROM_TO(MTYPE_FQ, MTYPE_U8): 02517 TCON_U8(r) = __c_ki_quint(R16_To_RQ(TCON_R16(c)), &err); 02518 break; 02519 #endif 02520 case FROM_TO(MTYPE_F8, MTYPE_U8): 02521 TCON_U8(r) = (UINT64)TCON_R8(c); 02522 break; 02523 case FROM_TO(MTYPE_F4, MTYPE_U8): 02524 TCON_U8(r) = (UINT64)TCON_R4(c); 02525 break; 02526 case FROM_TO(MTYPE_I8, MTYPE_U8): 02527 TCON_U8(r) = TCON_I8(c); 02528 break; 02529 case FROM_TO(MTYPE_I4, MTYPE_U8): 02530 case FROM_TO(MTYPE_I2, MTYPE_U8): 02531 case FROM_TO(MTYPE_I1, MTYPE_U8): 02532 case FROM_TO(MTYPE_B, MTYPE_U8): 02533 TCON_U8(r) = TCON_v0(c); 02534 break; 02535 case FROM_TO(MTYPE_U4, MTYPE_U8): 02536 case FROM_TO(MTYPE_U2, MTYPE_U8): 02537 case FROM_TO(MTYPE_U1, MTYPE_U8): 02538 TCON_U8(r) = TCON_u0(c); 02539 break; 02540 02541 #ifdef TARG_NEEDS_QUAD_OPS 02542 case FROM_TO(MTYPE_CQ, MTYPE_U4): 02543 case FROM_TO(MTYPE_CQ, MTYPE_U2): 02544 case FROM_TO(MTYPE_CQ, MTYPE_U1): 02545 TCON_u0(r) = __c_ji_quint(R16_To_RQ(TCON_R16(c)), &err); 02546 break; 02547 #endif 02548 case FROM_TO(MTYPE_C8, MTYPE_U4): 02549 case FROM_TO(MTYPE_C8, MTYPE_U2): 02550 case FROM_TO(MTYPE_C8, MTYPE_U1): 02551 TCON_u0(r) = (UINT32)TCON_R8(c); 02552 break; 02553 case FROM_TO(MTYPE_C4, MTYPE_U4): 02554 case FROM_TO(MTYPE_C4, MTYPE_U2): 02555 case FROM_TO(MTYPE_C4, MTYPE_U1): 02556 TCON_u0(r) = (UINT32)TCON_R4(c); 02557 break; 02558 #ifdef TARG_NEEDS_QUAD_OPS 02559 case FROM_TO(MTYPE_FQ, MTYPE_U4): 02560 case FROM_TO(MTYPE_FQ, MTYPE_U2): 02561 case FROM_TO(MTYPE_FQ, MTYPE_U1): 02562 TCON_u0(r) = __c_ji_quint(R16_To_RQ(TCON_R16(c)), &err); 02563 break; 02564 #endif 02565 case FROM_TO(MTYPE_F8, MTYPE_U4): 02566 case FROM_TO(MTYPE_F8, MTYPE_U2): 02567 case FROM_TO(MTYPE_F8, MTYPE_U1): 02568 TCON_u0(r) = (UINT32)TCON_R8(c); 02569 break; 02570 case FROM_TO(MTYPE_F4, MTYPE_U4): 02571 case FROM_TO(MTYPE_F4, MTYPE_U2): 02572 case FROM_TO(MTYPE_F4, MTYPE_U1): 02573 TCON_u0(r) = (UINT32)TCON_R4(c); 02574 break; 02575 case FROM_TO(MTYPE_I8, MTYPE_U4): 02576 case FROM_TO(MTYPE_I8, MTYPE_U2): 02577 case FROM_TO(MTYPE_I8, MTYPE_U1): 02578 case FROM_TO(MTYPE_I8, MTYPE_B): 02579 TCON_u0(r) = TCON_I8(c); 02580 break; 02581 case FROM_TO(MTYPE_I4, MTYPE_U4): 02582 case FROM_TO(MTYPE_I4, MTYPE_U2): 02583 case FROM_TO(MTYPE_I4, MTYPE_U1): 02584 case FROM_TO(MTYPE_I4, MTYPE_B): 02585 case FROM_TO(MTYPE_I2, MTYPE_U4): 02586 case FROM_TO(MTYPE_I2, MTYPE_U2): 02587 case FROM_TO(MTYPE_I2, MTYPE_U1): 02588 case FROM_TO(MTYPE_I2, MTYPE_B): 02589 case FROM_TO(MTYPE_I1, MTYPE_U4): 02590 case FROM_TO(MTYPE_I1, MTYPE_U2): 02591 case FROM_TO(MTYPE_I1, MTYPE_U1): 02592 case FROM_TO(MTYPE_I1, MTYPE_B): 02593 case FROM_TO(MTYPE_B, MTYPE_U4): 02594 TCON_v0(r) = TCON_v0(c); 02595 break; 02596 case FROM_TO(MTYPE_U8, MTYPE_U4): 02597 case FROM_TO(MTYPE_U8, MTYPE_U2): 02598 case FROM_TO(MTYPE_U8, MTYPE_U1): 02599 case FROM_TO(MTYPE_U8, MTYPE_B): 02600 TCON_u0(r) = TCON_U8(c); 02601 break; 02602 case FROM_TO(MTYPE_U4, MTYPE_U2): 02603 case FROM_TO(MTYPE_U4, MTYPE_U1): 02604 case FROM_TO(MTYPE_U4, MTYPE_B): 02605 case FROM_TO(MTYPE_U2, MTYPE_U4): 02606 case FROM_TO(MTYPE_U2, MTYPE_U1): 02607 case FROM_TO(MTYPE_U2, MTYPE_B): 02608 case FROM_TO(MTYPE_U1, MTYPE_U4): 02609 case FROM_TO(MTYPE_U1, MTYPE_U2): 02610 case FROM_TO(MTYPE_U1, MTYPE_B): 02611 TCON_v0(r) = TCON_v0(c); 02612 break; 02613 02614 default: 02615 Is_True ( FALSE, ( "Targ-Conv can not convert from %s to %s", 02616 Mtype_Name(ty_from), Mtype_Name(ty_to) ) ); 02617 } 02618 TCON_ty(r) = ty_to; 02619 return r; 02620 } /* Targ_Conv */ 02621 02622 #ifndef MONGOOSE_BE 02623 /* ==================================================================== 02624 * 02625 * Targ_Atoll 02626 * 02627 * Convert an ASCII number representation to an INT64. If it fits, 02628 * put it in i64 and return TRUE. If not, truncate it into i64 and 02629 * return FALSE. 02630 * 02631 * WARNING: sgned must be 0 or 1. 02632 * 02633 * ==================================================================== 02634 */ 02635 02636 static BOOL 02637 Targ_Atoll ( char *str, INT64 *i64, BOOL sgned ) 02638 { 02639 UINT64 m, d; 02640 UINT64 mhi, mlo; 02641 INT16 digits; 02642 BOOL neg = FALSE; 02643 BOOL valid = TRUE; 02644 02645 if ( *str == '-' ) { 02646 neg = TRUE; 02647 str++; 02648 } 02649 02650 m = 0; 02651 digits = 0; 02652 while ( *str ) { 02653 d = *str - '0'; 02654 if ( valid && ++digits >= 19 ) { 02655 /* Check for overflow before proceeding: */ 02656 mhi = (UINT32) (m >> 32); 02657 mlo = (UINT32) m; 02658 mlo = 10 * mlo + d; 02659 mhi *= 10; 02660 if ( mlo > UINT32_MAX ) { 02661 mhi += mlo >> 32; 02662 } 02663 if ( ( sgned && mhi > INT32_MAX+(neg) ) || 02664 ( ! sgned && mhi > UINT32_MAX ) ) 02665 { 02666 valid = FALSE; 02667 } 02668 } 02669 m = 10 * m + d; 02670 str++; 02671 } 02672 02673 *i64 = neg ? -(INT64)m : (INT64)m; 02674 return valid; 02675 } /* Targ_Atoll */ 02676 02677 /* ==================================================================== 02678 * 02679 * Targ_Atoc 02680 * 02681 * Convert an ASCII number representation to a TCON of the given mtype. 02682 * 02683 * ==================================================================== 02684 */ 02685 02686 TCON 02687 Targ_Atoc ( TYPE_ID ty, char *str ) 02688 { 02689 static TCON c; 02690 INT64 m; 02691 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 02692 char *sstr; 02693 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 02694 INT err; 02695 02696 TCON_ty(c) = ty; 02697 TCON_v0(c) = 0; 02698 TCON_v1(c) = 0; 02699 TCON_v2(c) = 0; 02700 TCON_v3(c) = 0; 02701 02702 switch (ty) { 02703 02704 case MTYPE_I1: 02705 if ( ! Targ_Atoll ( str, &m, TRUE ) || 02706 m > SCHAR_MAX || 02707 m < SCHAR_MIN ) 02708 { 02709 ErrMsg ( EC_Large_Const, str ); 02710 } 02711 TCON_v0(c) = m; 02712 TCON_v1(c) = 0; 02713 break; 02714 02715 case MTYPE_I2: 02716 if ( ! Targ_Atoll ( str, &m, TRUE ) || 02717 m > INT16_MAX || 02718 m < INT16_MIN ) 02719 { 02720 ErrMsg ( EC_Large_Const, str ); 02721 } 02722 TCON_v0(c) = m; 02723 TCON_v1(c) = 0; 02724 break; 02725 02726 case MTYPE_I4: 02727 if ( ! Targ_Atoll ( str, &m, TRUE ) || 02728 m > INT32_MAX || 02729 m < INT32_MIN ) 02730 { 02731 ErrMsg ( EC_Large_Const, str ); 02732 } 02733 TCON_v0(c) = m; 02734 TCON_v1(c) = 0; 02735 break; 02736 02737 case MTYPE_I8: 02738 if ( ! Targ_Atoll ( str, &m, TRUE ) ) { 02739 ErrMsg ( EC_Large_Const, str ); 02740 } 02741 TCON_I8(c) = m; 02742 break; 02743 02744 case MTYPE_U1: 02745 if ( ! Targ_Atoll ( str, &m, FALSE ) || 02746 (UINT64) m > UCHAR_MAX ) 02747 { 02748 ErrMsg ( EC_Large_Const, str ); 02749 } 02750 TCON_u0(c) = (UINT8) m; 02751 TCON_u1(c) = 0; 02752 break; 02753 02754 case MTYPE_U2: 02755 if ( ! Targ_Atoll ( str, &m, FALSE ) || 02756 (UINT64) m > UINT16_MAX ) 02757 { 02758 ErrMsg ( EC_Large_Const, str ); 02759 } 02760 TCON_u0(c) = (UINT16) m; 02761 TCON_u1(c) = 0; 02762 break; 02763 02764 case MTYPE_U4: 02765 if ( ! Targ_Atoll ( str, &m, FALSE ) || 02766 (UINT64) m > UINT32_MAX ) 02767 { 02768 ErrMsg ( EC_Large_Const, str ); 02769 } 02770 TCON_u0(c) = (UINT32) m; 02771 TCON_u1(c) = 0; 02772 break; 02773 02774 case MTYPE_U8: 02775 if ( ! Targ_Atoll ( str, &m, FALSE ) ) { 02776 ErrMsg ( EC_Large_Const, str ); 02777 } 02778 TCON_U8(c) = (UINT64) m; 02779 break; 02780 02781 case MTYPE_F4: 02782 /* TODO: do these carefully, taking care of overflow */ 02783 /* Do this the right way * ((float *) &TCON_v0(c)) = atof(str); */ 02784 TCON_R4(c) = atof(str); 02785 TCON_v0(c) = 0; 02786 break; 02787 02788 case MTYPE_F8: 02789 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 02790 for ( sstr = str; *sstr; sstr++ ) { 02791 if (*sstr == 'd' || *sstr == 'D') { 02792 *sstr='E'; 02793 break; 02794 } 02795 } 02796 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 02797 /* Do this the right way * ((double *) &TCON_v0(c)) = atof(str); */ 02798 TCON_R8(c) = atof(str); 02799 break; 02800 02801 case MTYPE_FQ: 02802 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 02803 for ( sstr = str; *sstr; sstr++ ) { 02804 if (*sstr == 'q' || *sstr == 'Q') { 02805 *sstr='E'; 02806 break; 02807 } 02808 } 02809 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 02810 /* TODO: add errror checking */ 02811 TCON_R16(c) = RQ_To_R16(__c_a_to_q(str, &err)); 02812 02813 break; 02814 02815 default: 02816 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Targ_Atoc" ); 02817 } 02818 return c; 02819 } /* Targ_Atoc */ 02820 #endif /* MONGOOSE_BE */ 02821 02822 /* ==================================================================== 02823 * 02824 * Targ_Hexfptoc 02825 * 02826 * Convert an ASCII number representation of a floating-point hexadecimal 02827 * constant to a TCON of the given mtype. The input string must be a 02828 * valid hexadecimal number. Its length must be 32 digits for MTYPE_FQ, 02829 * 16 digits for MTYPE_F8, or 8 digits for MTYPE_F4. These restrictions 02830 * are assumed correct and are not checked by this function! 02831 * 02832 * ==================================================================== 02833 */ 02834 02835 TCON 02836 Targ_Hexfptoc(const TYPE_ID ty, const char * const str) 02837 { 02838 static TCON c; 02839 char ac[9]; 02840 02841 TCON_ty(c) = ty; 02842 TCON_u1(c) = 0; 02843 TCON_u0(c) = 0; 02844 TCON_u3(c) = 0; 02845 TCON_u2(c) = 0; 02846 /* Set the null character in the string argument for strtoul. All 02847 strings will have 8 characters. */ 02848 ac[8] = '\0'; 02849 switch (ty) { 02850 case MTYPE_FQ: 02851 strncpy(ac, str+24, 8); 02852 TCON_u2(c) = strtoul(ac, (char **)NULL, 16); 02853 strncpy(ac, str+16, 8); 02854 TCON_u3(c) = strtoul(ac, (char **)NULL, 16); 02855 /* FALL THROUGH */ 02856 case MTYPE_F8: 02857 strncpy(ac, str+8, 8); 02858 TCON_u0(c) = strtoul(ac, (char **)NULL, 16); 02859 /* FALL THROUGH */ 02860 case MTYPE_F4: 02861 strncpy(ac, str, 8); 02862 TCON_u1(c) = strtoul(ac, (char **)NULL, 16); 02863 break; 02864 default: 02865 ErrMsg(EC_Inv_Mtype, Mtype_Name(ty), "Targ_Hexfptoc"); 02866 } 02867 return c; 02868 } /* Targ_Hexfptoc */ 02869 02870 /* ==================================================================== 02871 * 02872 * TCONFlags_To_Str and Str_To_TCONFlags 02873 * 02874 * ==================================================================== 02875 */ 02876 02877 // The type for flag value -> string tables 02878 struct FlagToStr_t : public ir_a2b::flag2str_tbl_entry_t { 02879 FlagToStr_t(UINT64 val_ = 0, const char* str_ = 0) 02880 : val(val_), str(str_) { } 02881 02882 virtual ~FlagToStr_t() { } 02883 02884 virtual UINT64 getFlagVal() const { return val; } 02885 virtual const char* getStr() const { return str; } 02886 02887 UINT64 val; 02888 const char* str; 02889 }; 02890 02891 02892 #define TCONFLAGS_ToStrTblENTRY(flg) \ 02893 FlagToStr_t(flg, #flg) 02894 02895 FlagToStr_t TCONFLAGS_ToStrTbl[] = { 02896 TCONFLAGS_ToStrTblENTRY(TCON_ADD_NULL) 02897 }; 02898 02899 const UINT TCONFLAGS_ToStrTblSZ = 02900 (sizeof(TCONFLAGS_ToStrTbl) / sizeof(FlagToStr_t)); 02901 02902 02903 const char * 02904 TCONFlags_To_Str (UINT64 flags) 02905 { 02906 using namespace ir_a2b; 02907 return MapFlagsToStr<FlagToStr_t, TCONFLAGS_ToStrTbl, 02908 TCONFLAGS_ToStrTblSZ>("TCONFLAGS_ToStrTbl", flags); 02909 } 02910 02911 UINT64 02912 Str_To_TCONFlags (const char* str) 02913 { 02914 using namespace ir_a2b; 02915 return MapStrToFlags<FlagToStr_t, TCONFLAGS_ToStrTbl, 02916 TCONFLAGS_ToStrTblSZ>("TCONFLAGS_ToStrTbl", str); 02917 } 02918 02919 02920 /* ==================================================================== 02921 * 02922 * Targ_Print 02923 * 02924 * Convert constant c to a character string. if fmt is given, it is 02925 * used as the printf fmt, else a default fmt is provided. The returning 02926 * ptr points to a static array which gets recycled after TPB_SIZE calls. 02927 * 02928 * WARNING: TO BE USED ONLY FOR DIAGNOSTICS. 02929 * 02930 * ==================================================================== 02931 */ 02932 02933 char * 02934 Targ_Print ( const char *fmt, TCON c ) 02935 { 02936 INT slen,i; 02937 char *bytes; 02938 INT spos; 02939 BOOL string_as_bytes; 02940 02941 struct tpb { 02942 char buf[1024]; 02943 }; 02944 #define TPB_SIZE 8 02945 static struct tpb tpbuf[8]; 02946 static INT tpidx = 0; 02947 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 02948 char *re; 02949 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 02950 char *r; 02951 02952 r = tpbuf[tpidx].buf; 02953 tpidx = (tpidx + 1) & 7; 02954 switch (TCON_ty(c)) { 02955 case MTYPE_STRING: 02956 /* Since in F90 strings may be used to represent byte strings, 02957 * we will use two slightly different methods for displaying them. 02958 */ 02959 slen = TCON_len(c); 02960 bytes = Index_to_char_array (TCON_cp(c)); 02961 string_as_bytes = FALSE; 02962 for (i = 0; i < slen-1; i++) { 02963 if (bytes[i] == '\0') { 02964 string_as_bytes = TRUE; 02965 break; 02966 } 02967 } 02968 if (string_as_bytes) { 02969 spos = 0; 02970 spos = sprintf(r,"(%d hex bytes) ",slen); 02971 for (i=0; i < slen && spos < 1000; i++) { 02972 if (i == slen-1) { 02973 spos += sprintf(r+spos,"%x",bytes[i]); 02974 } else { 02975 spos += sprintf(r+spos,"%x, ",bytes[i]); 02976 } 02977 } 02978 if (i < slen) { 02979 sprintf(r+spos,"..."); 02980 } 02981 } else { 02982 // sprintf(r, "(%d bytes) \"", slen); 02983 sprintf(r, "\""); 02984 char *t = r + strlen (r); 02985 char *s = r + 1000; 02986 for (i = 0; i < slen && t < s; i++) { 02987 t = Targ_Append_To_Dbuf (t, bytes[i]); 02988 } 02989 if (i < slen) { 02990 sprintf(t,"...\""); 02991 } else { 02992 sprintf(t, "\""); 02993 } 02994 } 02995 break; 02996 02997 case MTYPE_B: 02998 case MTYPE_I1: 02999 case MTYPE_I2: 03000 case MTYPE_I4: 03001 case MTYPE_U1: 03002 case MTYPE_U2: 03003 case MTYPE_U4: 03004 if (fmt == NULL) fmt = "%1d"; 03005 sprintf(r, fmt, TCON_v0(c)); 03006 break; 03007 03008 case MTYPE_I8: 03009 case MTYPE_U8: 03010 if (fmt == NULL) fmt = "%1lld"; 03011 sprintf(r, fmt, TCON_I8(c)); 03012 break; 03013 03014 case MTYPE_F4: 03015 if (fmt == NULL) fmt = "%#12.7g"; 03016 sprintf(r, fmt, TCON_R4(c)); 03017 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03018 if (re = strchr(r, 'e')) 03019 *re = 'd'; 03020 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03021 break; 03022 03023 case MTYPE_F8: 03024 case MTYPE_FQ: 03025 03026 if (fmt == NULL) fmt = "%#21.16g"; 03027 sprintf(r, fmt, TCON_R8(c)); 03028 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03029 if (re = strchr(r, 'e')) 03030 *re = 'd'; 03031 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03032 break; 03033 03034 # if 0 //August 03035 #ifdef TARG_NEEDS_QUAD_OPS 03036 case MTYPE_FQ: 03037 { 03038 INT dummy_err; 03039 QUAD q = R16_To_RQ(TCON_R16(c)); 03040 /* 03041 In Fortran, a user can specify an illegal quad constant 03042 using VMS-style bit constants, so we should just give 03043 a warning. 03044 */ 03045 if ( q.hi == 0.0 && q.lo != 0.0) 03046 ErrMsg( EC_Ill_Quad_Const, TCON_u0(c), TCON_u1(c), TCON_u2(c), TCON_u3(c)); 03047 __c_q_to_a(r, q, &dummy_err); 03048 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03049 if (re = strchr(r, 'e')) 03050 *re = 'd'; 03051 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03052 } 03053 break; 03054 #endif 03055 # endif 03056 03057 03058 case MTYPE_C4: 03059 if (fmt == NULL) fmt = "%#12.7g, %#12.7g"; 03060 sprintf(r, fmt, TCON_R4(c), TCON_IR4(c)); 03061 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03062 if (re = strchr(r, 'e')) 03063 *re = 'd'; 03064 if (re = strrchr(r, 'e')) 03065 *re = 'd'; 03066 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03067 break; 03068 03069 case MTYPE_C8: 03070 if (fmt == NULL) fmt = "%#21.16g, %#21.16g"; 03071 sprintf(r, fmt, TCON_R8(c), TCON_IR8(c)); 03072 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03073 if (re = strchr(r, 'e')) 03074 *re = 'd'; 03075 if (re = strrchr(r, 'e')) 03076 *re = 'd'; 03077 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03078 break; 03079 03080 #ifdef TARG_NEEDS_QUAD_OPS 03081 case MTYPE_CQ: 03082 { 03083 INT dummy_err; 03084 INT l; 03085 QUAD q = R16_To_RQ(TCON_R16(c)); 03086 /* 03087 In Fortran, a user can specify an illegal quad constant 03088 using VMS-style bit constants, so we should just give 03089 a warning. 03090 */ 03091 if ( q.hi == 0.0 && q.lo != 0.0) 03092 ErrMsg( EC_Ill_Quad_Const, TCON_u0(c), TCON_u1(c), TCON_u2(c), TCON_u3(c)); 03093 __c_q_to_a(r, q, &dummy_err); 03094 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03095 if (re = strchr(r, 'e')) 03096 *re = 'd'; 03097 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03098 03099 l = strlen(r); 03100 r [l++] = ','; 03101 r [l++] = ' '; 03102 03103 q = R16_To_RQ(TCON_IR16(c)); 03104 /* 03105 In Fortran, a user can specify an illegal quad constant 03106 using VMS-style bit constants, so we should just give 03107 a warning. 03108 */ 03109 if ( q.hi == 0.0 && q.lo != 0.0) 03110 ErrMsg( EC_Ill_Quad_Const, TCON_u0(c), TCON_u1(c), TCON_u2(c), TCON_u3(c)); 03111 __c_q_to_a(&r [l], q, &dummy_err); 03112 #if !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) 03113 if (re = strchr(r, 'e')) 03114 *re = 'd'; 03115 #endif /* !(defined(FRONT_END_C) || defined(FRONT_END_CPLUSPLUS)) */ 03116 } 03117 break; 03118 #endif 03119 03120 default: 03121 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(c)), "Targ_Print" ); 03122 } 03123 return r; 03124 } /* Targ_Print */ 03125 03126 INT64 03127 Targ_To_Host ( TCON c ) 03128 { 03129 mINT32 i32; 03130 03131 switch (TCON_ty(c)) { 03132 case MTYPE_B: 03133 return (TCON_U4(c)&0x1); 03134 case MTYPE_I1: 03135 i32 = TCON_I4(c); 03136 return ((i32&0x80) ? 0xffffffffffffff00ll : 0ll) | (i32&0xff); 03137 case MTYPE_I2: 03138 i32 = TCON_I4(c); 03139 return ((i32&0x8000) ? 0xffffffffffff0000ll : 0ll) | (i32&0xffff); 03140 case MTYPE_U1: 03141 return (TCON_U4(c)&0xff); 03142 case MTYPE_U2: 03143 return (TCON_U4(c)&0xffff); 03144 case MTYPE_U4: 03145 return (TCON_U4(c)&0x00000000ffffffffll); 03146 case MTYPE_I4: 03147 return TCON_I4(c); 03148 case MTYPE_I8: 03149 return TCON_I8(c); 03150 case MTYPE_U8: 03151 return TCON_U8(c); 03152 03153 default: 03154 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(c)), "Targ_To_Host" ); 03155 } 03156 03157 return 0; 03158 } /* Targ_To_Host */ 03159 03160 #ifndef MONGOOSE_BE 03161 INT64 03162 Targ_To_Signed_Host ( TCON c ) 03163 { 03164 mINT32 i32; 03165 03166 switch (TCON_ty(c)) { 03167 case MTYPE_B: 03168 return (TCON_U4(c)&0x1); 03169 case MTYPE_I1: 03170 i32 = TCON_I4(c); 03171 return ((i32&0x80) ? 0xffffffffffffff00ll : 0ll) | (i32&0xff); 03172 case MTYPE_I2: 03173 i32 = TCON_I4(c); 03174 return ((i32&0x8000) ? 0xffffffffffff0000ll : 0ll) | (i32&0xffff); 03175 case MTYPE_U1: 03176 return (TCON_U4(c)&0xff); 03177 case MTYPE_U2: 03178 return (TCON_U4(c)&0xffff); 03179 case MTYPE_U4: 03180 return TCON_I4(c); /* force it to sign extend */ 03181 case MTYPE_I4: 03182 return TCON_I4(c); 03183 case MTYPE_I8: 03184 return TCON_I8(c); 03185 case MTYPE_U8: 03186 return TCON_U8(c); 03187 03188 default: 03189 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(c)), "Targ_To_Signed_Host" ); 03190 } 03191 03192 return 0; 03193 } /* Targ_To_Signed_Host */ 03194 #endif /* MONGOOSE_BE */ 03195 03196 TCON 03197 Host_To_Targ(TYPE_ID ty, INT64 v) 03198 { 03199 static TCON c; 03200 03201 TCON_clear(c); 03202 03203 switch (ty) { 03204 default: 03205 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Host_To_Targ" ); 03206 03207 case MTYPE_B: 03208 case MTYPE_I1: 03209 case MTYPE_I2: 03210 case MTYPE_I4: 03211 case MTYPE_U1: 03212 case MTYPE_U2: 03213 case MTYPE_U4: 03214 TCON_ty(c) = ty; 03215 TCON_I8(c) = v; /* Don't change the upper bits */ 03216 return c; 03217 case MTYPE_I8: 03218 case MTYPE_U8: 03219 TCON_ty(c) = ty; 03220 TCON_I8(c) = v; 03221 return c; 03222 } 03223 } /* Host_To_Targ */ 03224 03225 03226 TCON 03227 Host_To_Targ_Float ( TYPE_ID ty, double v ) 03228 { 03229 TCON c; 03230 03231 switch (ty) { 03232 case MTYPE_C4: 03233 case MTYPE_F4: 03234 TCON_clear(c); 03235 TCON_ty(c) = ty; 03236 Set_TCON_R4(c,v); 03237 return c; 03238 03239 case MTYPE_C8: 03240 case MTYPE_F8: 03241 TCON_clear(c); 03242 TCON_ty(c) = ty; 03243 TCON_R8(c) = v; 03244 return c; 03245 03246 case MTYPE_CQ: 03247 case MTYPE_FQ: 03248 TCON_clear(c); 03249 c = Targ_Conv (MTYPE_FQ, 03250 Host_To_Targ_Float ( MTYPE_F8, v ) ); 03251 TCON_ty(c) = ty; 03252 return c; 03253 03254 default: 03255 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Host_To_Targ_Float" ); 03256 TCON_clear(c); 03257 TCON_ty(c) = MTYPE_F4; 03258 return c; 03259 } 03260 } /* Host_To_Targ_Float */ 03261 03262 /* like Host_To_Targ_Float but avoids conversion from float to double */ 03263 TCON 03264 Host_To_Targ_Float_4 ( TYPE_ID ty, float v ) 03265 { 03266 TCON c; 03267 03268 switch (ty) { 03269 case MTYPE_C4: 03270 case MTYPE_F4: 03271 TCON_clear(c); 03272 TCON_ty(c) = ty; 03273 Set_TCON_R4(c,v); 03274 return c; 03275 03276 case MTYPE_C8: 03277 case MTYPE_F8: 03278 TCON_clear(c); 03279 TCON_ty(c) = ty; 03280 TCON_R8(c) = v; 03281 return c; 03282 03283 case MTYPE_CQ: 03284 case MTYPE_FQ: 03285 TCON_clear(c); 03286 c = Targ_Conv (MTYPE_FQ, 03287 Host_To_Targ_Float ( MTYPE_F8, v ) ); 03288 TCON_ty(c) = ty; 03289 return c; 03290 03291 default: 03292 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Host_To_Targ_Float" ); 03293 TCON_clear(c); 03294 TCON_ty(c) = MTYPE_F4; 03295 return c; 03296 } 03297 } /* Host_To_Targ_Float_4 */ 03298 03299 TCON 03300 Host_To_Targ_UV( TYPE_ID ty) 03301 { 03302 TCON c; 03303 03304 TCON_clear(c); 03305 TCON_ty(c) = ty; 03306 03307 switch (ty) { 03308 case MTYPE_F4: 03309 TCON_v1(c)= 0xfffa5a5a; 03310 break; 03311 case MTYPE_F8: 03312 TCON_v0(c)= 0xfffa5a5a; 03313 TCON_v1(c)= 0xfffa5a5a; 03314 break; 03315 case MTYPE_FQ: 03316 TCON_v0(c)= 0xfffa5a5a; 03317 TCON_v1(c)= 0xfffa5a5a; 03318 TCON_v2(c)= 0xfffa5a5a; 03319 TCON_v3(c)= 0xfffa5a5a; 03320 break; 03321 case MTYPE_C4: 03322 TCON_v1(c)= 0xfffa5a5a; 03323 TCON_iv1(c)= 0xfffa5a5a; 03324 break; 03325 case MTYPE_C8: 03326 TCON_v0(c)= 0xfffa5a5a; 03327 TCON_v1(c)= 0xfffa5a5a; 03328 TCON_iv0(c)= 0xfffa5a5a; 03329 TCON_iv1(c)= 0xfffa5a5a; 03330 break; 03331 case MTYPE_CQ: 03332 TCON_v0(c)= 0xfffa5a5a; 03333 TCON_v1(c)= 0xfffa5a5a; 03334 TCON_v2(c)= 0xfffa5a5a; 03335 TCON_v3(c)= 0xfffa5a5a; 03336 TCON_iv0(c)= 0xfffa5a5a; 03337 TCON_iv1(c)= 0xfffa5a5a; 03338 TCON_iv2(c)= 0xfffa5a5a; 03339 TCON_iv3(c)= 0xfffa5a5a; 03340 break; 03341 03342 default: 03343 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Host_To_Targ_UV" ); 03344 TCON_clear(c); 03345 TCON_ty(c) = MTYPE_F4; 03346 return c; 03347 } 03348 return c; 03349 } /* Host_To_Targ_UV */ 03350 03351 /* Make complex TCON from two TCONs representing real and imaginary parts. */ 03352 TCON 03353 Make_Complex ( TYPE_ID ctype, TCON real, TCON imag ) 03354 { 03355 TCON c; 03356 03357 TCON_clear(c); 03358 TCON_ty(c) = ctype; 03359 switch (ctype) { 03360 case MTYPE_C4: 03361 Set_TCON_R4(c, TCON_R4(real)); 03362 Set_TCON_IR4(c, TCON_R4(imag)); 03363 break; 03364 03365 case MTYPE_C8: 03366 Set_TCON_R8(c, TCON_R8(real)); 03367 Set_TCON_IR8(c, TCON_R8(imag)); 03368 break; 03369 03370 case MTYPE_CQ: 03371 Set_TCON_R16(c, TCON_R16(real)); 03372 Set_TCON_IR16(c, TCON_R16(imag)); 03373 break; 03374 03375 default: 03376 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ctype), "Make_Complex" ); 03377 break; 03378 } 03379 return c; 03380 } /* Make_Complex */ 03381 03382 03383 TCON 03384 Extract_Complex_Real(TCON complex) 03385 { 03386 TCON c; 03387 TCON_clear(c); 03388 03389 switch (TCON_ty(complex)) { 03390 case MTYPE_C4: 03391 TCON_ty(c) = MTYPE_F4; 03392 Set_TCON_R4(c, TCON_R4(complex)); 03393 return c; 03394 03395 case MTYPE_C8: 03396 TCON_ty(c) = MTYPE_F8; 03397 Set_TCON_R8(c, TCON_R8(complex)); 03398 return c; 03399 03400 case MTYPE_CQ: 03401 TCON_ty(c) = MTYPE_FQ; 03402 Set_TCON_R16(c, TCON_R16(complex)); 03403 return c; 03404 03405 default: 03406 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(complex)), "Extract_Complex_Real" ); 03407 TCON_ty(c) = MTYPE_F4; 03408 return c; 03409 } 03410 } 03411 03412 TCON 03413 Extract_Complex_Imag(TCON complex) 03414 { 03415 TCON c; 03416 TCON_clear(c); 03417 03418 switch (TCON_ty(complex)) { 03419 case MTYPE_C4: 03420 TCON_ty(c) = MTYPE_F4; 03421 Set_TCON_R4(c, TCON_IR4(complex)); 03422 return c; 03423 03424 case MTYPE_C8: 03425 TCON_ty(c) = MTYPE_F8; 03426 Set_TCON_R8(c, TCON_IR8(complex)); 03427 return c; 03428 03429 case MTYPE_CQ: 03430 TCON_ty(c) = MTYPE_FQ; 03431 Set_TCON_R16(c, TCON_IR16(complex)); 03432 return c; 03433 03434 default: 03435 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(complex)), "Extract_Complex_Real" ); 03436 TCON_ty(c) = MTYPE_F4; 03437 return c; 03438 } 03439 } 03440 03441 TCON 03442 Extract_Quad_Hi(TCON v) 03443 { 03444 TCON c; 03445 TCON_clear(c); 03446 03447 switch (TCON_ty(v)) { 03448 case MTYPE_FQ: 03449 { 03450 QUAD quadTemp = R16_To_RQ(TCON_R16(v)); 03451 03452 TCON_ty(c) = MTYPE_F8; 03453 Set_TCON_R8(c, quadTemp.hi); 03454 return c; 03455 } 03456 /*************************************************** 03457 TO BE DETERMINED 03458 case MTYPE_CQ: 03459 { 03460 quad quadTemp = R16_To_RQ(TCON_IR16(v)); 03461 03462 TCON_ty(c) = MTYPE_C8; 03463 Set_TCON_R16(c, TCON_IR16(complex)); 03464 return c; 03465 } 03466 ***************************************************/ 03467 default: 03468 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(v)), "Extract_Quad_Hi" ); 03469 TCON_ty(c) = MTYPE_F4; 03470 return c; 03471 } 03472 } 03473 03474 TCON 03475 Extract_Quad_Lo(TCON v) 03476 { 03477 TCON c; 03478 TCON_clear(c); 03479 03480 switch (TCON_ty(v)) { 03481 case MTYPE_FQ: 03482 { 03483 QUAD quadTemp = R16_To_RQ(TCON_R16(v)); 03484 03485 TCON_ty(c) = MTYPE_F8; 03486 Set_TCON_R8(c, quadTemp.lo); 03487 return c; 03488 } 03489 /*************************************************** 03490 TO BE DETERMINED 03491 case MTYPE_CQ: 03492 { 03493 quad quadTemp = R16_To_RQ(TCON_IR16(v)); 03494 03495 TCON_ty(c) = MTYPE_C8; 03496 Set_TCON_R16(c, TCON_IR16(complex)); 03497 return c; 03498 } 03499 ***************************************************/ 03500 default: 03501 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(v)), "Extract_Quad_Lo" ); 03502 TCON_ty(c) = MTYPE_F4; 03503 return c; 03504 } 03505 } 03506 03507 TCON 03508 Host_To_Targ_Quad(QUAD_TYPE v) 03509 { 03510 static TCON c; 03511 03512 TCON_ty(c) = MTYPE_FQ; 03513 TCON_R16(c) = v; 03514 return c; 03515 } 03516 03517 TCON 03518 Host_To_Targ_Complex_Quad(QUAD_TYPE real, QUAD_TYPE imag) 03519 { 03520 static TCON c; 03521 03522 TCON_ty(c) = MTYPE_CQ; 03523 TCON_R16(c) = real; 03524 TCON_IR16(c) = imag; 03525 return c; 03526 } 03527 03528 03529 double 03530 Targ_To_Host_Float(TCON fvalue) 03531 { 03532 INT16 ty = TCON_ty(fvalue); 03533 03534 switch (ty) { 03535 case MTYPE_F4: 03536 return (double)TCON_R4(fvalue); 03537 03538 case MTYPE_F8: 03539 return TCON_R8(fvalue); 03540 03541 case MTYPE_FQ: 03542 return Targ_To_Host_Float(Targ_Conv(MTYPE_F8, fvalue)); 03543 03544 default: 03545 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Targ_To_Host_Float" ); 03546 return Targ_To_Host_Float(Targ_Conv(MTYPE_F8, fvalue)); 03547 } 03548 } /* Targ_To_Host_Float */ 03549 03550 double 03551 Targ_To_Host_ComplexReal(TCON fvalue) 03552 { 03553 INT16 ty = TCON_ty(fvalue); 03554 03555 switch (ty) { 03556 case MTYPE_C4: 03557 return (double)TCON_R4(fvalue); 03558 03559 case MTYPE_C8: 03560 return TCON_R8(fvalue); 03561 03562 case MTYPE_CQ: 03563 return Targ_To_Host_Float(Targ_Conv(MTYPE_CQ, fvalue)); 03564 03565 default: 03566 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Targ_To_Host_ComplexReal" ); 03567 return Targ_To_Host_Float(Targ_Conv(MTYPE_C8, fvalue)); 03568 } 03569 } 03570 03571 double 03572 Targ_To_Host_ComplexImag(TCON fvalue) 03573 { 03574 INT16 ty = TCON_ty(fvalue); 03575 03576 switch (ty) { 03577 case MTYPE_C4: 03578 return (double)TCON_IR4(fvalue); 03579 03580 case MTYPE_C8: 03581 return TCON_IR8(fvalue); 03582 03583 case MTYPE_CQ: 03584 return Targ_To_Host_Float(Targ_Conv(MTYPE_C8, fvalue)); 03585 03586 default: 03587 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Targ_To_Host_ComplexImag" ); 03588 return Targ_To_Host_Float(Targ_Conv(MTYPE_C8, fvalue)); 03589 } 03590 } 03591 03592 QUAD_TYPE 03593 Targ_To_Host_Quad(TCON fvalue) 03594 { 03595 INT16 ty = TCON_ty(fvalue); 03596 03597 switch (ty) { 03598 case MTYPE_F4: 03599 return Targ_To_Host_Quad(Targ_Conv(MTYPE_FQ, fvalue)); 03600 03601 case MTYPE_F8: 03602 return Targ_To_Host_Quad(Targ_Conv(MTYPE_FQ, fvalue)); 03603 03604 case MTYPE_FQ: 03605 return TCON_R16(fvalue); 03606 03607 default: 03608 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Targ_To_Host_Quad" ); 03609 return Targ_To_Host_Quad(Targ_Conv(MTYPE_FQ, fvalue)); 03610 } 03611 } /* Targ_To_Host_Quad */ 03612 03613 INT 03614 fp_class_d( double x ) 03615 { 03616 UINT64 ll, exp, mantissa; 03617 INT32 sign; 03618 03619 ll = *(UINT64*)&x; 03620 exp = (ll >> DMANTWIDTH); 03621 sign = (exp >> DEXPWIDTH); 03622 exp &= 0x7ff; 03623 mantissa = (ll & (DSIGNMASK & DEXPMASK)); 03624 if ( exp == 0x7ff ) { 03625 /* result is an infinity, or a NaN */ 03626 if ( mantissa == 0 ) 03627 return ( (sign == 0) ? FP_POS_INF : FP_NEG_INF ); 03628 else if ( mantissa & ~DQNANBITMASK ) 03629 return ( FP_QNAN ); 03630 else 03631 return ( FP_SNAN ); 03632 } 03633 03634 if ( exp == 0 ) { 03635 if ( mantissa == 0 ) 03636 return ( (sign == 0) ? FP_POS_ZERO : FP_NEG_ZERO ); 03637 else 03638 return ( (sign == 0) ? FP_POS_DENORM : FP_NEG_DENORM ); 03639 } 03640 else 03641 return ( (sign == 0) ? FP_POS_NORM : FP_NEG_NORM ); 03642 } 03643 03644 INT 03645 fp_class_f( float x ) 03646 { 03647 UINT32 n, exp, mantissa; 03648 INT32 sign; 03649 03650 n = *(UINT32 *)&x; 03651 exp = (n >> MANTWIDTH); 03652 sign = (exp >> EXPWIDTH); 03653 exp &= 0xff; 03654 mantissa = (n & (SIGNMASK & EXPMASK)); 03655 03656 if ( exp == 0xff ) { 03657 /* result is an infinity, or a NaN */ 03658 if ( mantissa == 0 ) 03659 return ( (sign == 0) ? FP_POS_INF : FP_NEG_INF ); 03660 else if ( mantissa & ~QNANBITMASK ) 03661 return ( FP_QNAN ); 03662 else 03663 return ( FP_SNAN ); 03664 } 03665 03666 if ( exp == 0 ) { 03667 if ( mantissa == 0 ) 03668 return ( (sign == 0) ? FP_POS_ZERO : FP_NEG_ZERO ); 03669 else 03670 return ( (sign == 0) ? FP_POS_DENORM : FP_NEG_DENORM ); 03671 } 03672 else 03673 return ( (sign == 0) ? FP_POS_NORM : FP_NEG_NORM ); 03674 } 03675 03676 INT32 03677 Targ_fp_class(TCON fvalue) 03678 { 03679 INT16 ty = TCON_ty(fvalue); 03680 03681 switch (ty) { 03682 case MTYPE_F4: 03683 return fp_class_f(TCON_R4(fvalue)); 03684 03685 case MTYPE_F8: 03686 return fp_class_d(TCON_R8(fvalue)); 03687 03688 #ifdef TARG_NEEDS_QUAD_OPS 03689 case MTYPE_FQ: 03690 return __c_fp_class_q(R16_To_RQ(TCON_R16(fvalue))); 03691 #endif 03692 03693 default: 03694 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Targ_fp_class" ); 03695 return FP_QNAN; 03696 } 03697 } /* Targ_fp_class */ 03698 03699 TCON 03700 Host_To_Targ_Complex ( TYPE_ID ty, double real, double imag ) 03701 { 03702 TCON c; 03703 03704 switch (ty) { 03705 03706 case MTYPE_C4: 03707 03708 TCON_clear(c); 03709 TCON_ty(c) = ty; 03710 TCON_R4(c) = real; 03711 TCON_IR4(c) = imag; 03712 return c; 03713 03714 case MTYPE_C8: 03715 03716 TCON_clear(c); 03717 TCON_ty(c) = ty; 03718 TCON_R8(c) = real; 03719 TCON_IR8(c) = imag; 03720 return c; 03721 03722 default: 03723 03724 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Host_To_Targ_Complex" ); 03725 TCON_clear(c); 03726 TCON_ty(c) = MTYPE_C4; 03727 return c; 03728 } 03729 } /* Host_To_Targ_Complex */ 03730 03731 TCON 03732 Host_To_Targ_Complex_4 ( TYPE_ID ty, float real, float imag ) 03733 { 03734 TCON c; 03735 03736 switch (ty) { 03737 03738 case MTYPE_C4: 03739 03740 TCON_clear(c); 03741 TCON_ty(c) = ty; 03742 TCON_R4(c) = real; 03743 TCON_IR4(c) = imag; 03744 return c; 03745 03746 case MTYPE_C8: 03747 03748 TCON_clear(c); 03749 TCON_ty(c) = ty; 03750 TCON_R8(c) = real; 03751 TCON_IR8(c) = imag; 03752 return c; 03753 03754 default: 03755 03756 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Host_To_Targ_Complex_4" ); 03757 TCON_clear(c); 03758 TCON_ty(c) = MTYPE_C4; 03759 return c; 03760 } 03761 } /* Host_To_Targ_Complex_4 */ 03762 03763 03764 03765 TCON 03766 Host_To_Targ_String ( TYPE_ID ty, char *v, UINT32 l ) 03767 { 03768 static TCON c; 03769 BOOL add_null = FALSE; /* whether to add a NULL in strtab */ 03770 Is_True(ty==MTYPE_STRING, 03771 ("Bad type of const to Host_To_Targ_String: %s", Mtype_Name(ty))); 03772 TCON_clear(c); 03773 TCON_ty(c) = ty; 03774 /* for debugging purposes, we ensure that the tcon string is 03775 * null-terminated; however, we keep the len as is, without the null. */ 03776 if (l == 0 || v[l-1] != '\0') 03777 add_null = TRUE; 03778 /* use StrN in case a wide-string with non-terminating NULLs */ 03779 TCON_cp(c) = Save_StrN(v, (add_null ? l+1 : l)); 03780 if (add_null) 03781 Index_to_char_array (TCON_cp(c))[l] = '\0'; 03782 TCON_len(c) = l; 03783 return (c); 03784 } 03785 03786 char * 03787 Targ_String_Address ( TCON c ) 03788 { 03789 Is_True(TCON_ty(c)==MTYPE_STRING, 03790 ("Bad type of const to Host_To_Targ_String: %s", 03791 Mtype_Name(TCON_ty(c)))); 03792 return Index_to_char_array (TCON_cp(c)); 03793 } 03794 03795 mUINT32 03796 Targ_String_Length ( TCON c ) 03797 { 03798 Is_True(TCON_ty(c)==MTYPE_STRING, 03799 ("Bad type of const to Host_To_Targ_String: %s", 03800 Mtype_Name(TCON_ty(c)))); 03801 return ( TCON_len(c) ); 03802 } 03803 03804 03805 static TCON Targ_Ipower(TCON base, UINT64 exp, BOOL neg_exp, BOOL *folded, TYPE_ID btype) 03806 { 03807 OPCODE mpy_op,div_op; 03808 TCON r; 03809 #ifdef TARG_NEEDS_QUAD_OPS 03810 INT err; 03811 #endif 03812 03813 *folded = TRUE; 03814 TCON_clear(r); 03815 TCON_ty(r) = btype; 03816 03817 switch (btype) { 03818 case MTYPE_I4: 03819 mpy_op = OPC_I4MPY; 03820 div_op = OPCODE_UNKNOWN; 03821 TCON_I4(r) = 1; 03822 break; 03823 case MTYPE_U4: 03824 mpy_op = OPC_U4MPY; 03825 div_op = OPCODE_UNKNOWN; 03826 TCON_U4(r) = 1; 03827 break; 03828 case MTYPE_I8: 03829 mpy_op = OPC_I8MPY; 03830 div_op = OPCODE_UNKNOWN; 03831 TCON_I8(r) = 1; 03832 break; 03833 case MTYPE_U8: 03834 mpy_op = OPC_U8MPY; 03835 div_op = OPCODE_UNKNOWN; 03836 TCON_U8(r) = 1; 03837 break; 03838 case MTYPE_F4: 03839 mpy_op = OPC_F4MPY; 03840 div_op = OPC_F4RECIP; 03841 TCON_R4(r) = 1.0; 03842 break; 03843 case MTYPE_F8: 03844 mpy_op = OPC_F8MPY; 03845 div_op = OPC_F8RECIP; 03846 TCON_R8(r) = 1.0; 03847 break; 03848 #ifdef TARG_NEEDS_QUAD_OPS 03849 case MTYPE_FQ: 03850 mpy_op = OPC_FQMPY; 03851 div_op = OPC_FQRECIP; 03852 TCON_R16(r) = RQ_To_R16(__c_q_ext(1.0,&err)); 03853 break; 03854 #endif 03855 case MTYPE_C4: 03856 mpy_op = OPC_C4MPY; 03857 div_op = OPC_C4RECIP; 03858 TCON_R4(r) = 1.0; 03859 break; 03860 case MTYPE_C8: 03861 mpy_op = OPC_C8MPY; 03862 div_op = OPC_C8RECIP; 03863 TCON_R8(r) = 1.0; 03864 break; 03865 #ifdef TARG_NEEDS_QUAD_OPS 03866 case MTYPE_CQ: 03867 mpy_op = OPC_CQMPY; 03868 div_op = OPC_CQRECIP; 03869 TCON_R16(r) = RQ_To_R16(__c_q_ext(1.0,&err)); 03870 break; 03871 #endif 03872 } 03873 03874 /* At this point r contains 1, do the square and multiply loop */ 03875 while (exp != 0) { 03876 if (exp & 1) { 03877 r = Targ_WhirlOp(mpy_op,r,base,NULL); 03878 } 03879 base = Targ_WhirlOp(mpy_op,base,base,NULL); 03880 exp >>= 1; 03881 } 03882 03883 /* take reciprocal if negative denominator */ 03884 if (neg_exp) { 03885 if (div_op) { 03886 r = Targ_WhirlOp(div_op,r,r,folded); 03887 } else { 03888 /* Integer reciprocal is easy. If r is not 0, 1, or -1, 03889 return 0. If it's 0, give up */ 03890 switch (TCON_ty(base)) { 03891 case MTYPE_I4: 03892 if (TCON_I4(r) == 0) { 03893 *folded = FALSE; 03894 } else if (TCON_I4(r) != 1 && TCON_I4(r) != -1) { 03895 TCON_I4(r) = 0; 03896 } 03897 break; 03898 case MTYPE_U4: 03899 if (TCON_U4(r) == 0) { 03900 *folded = FALSE; 03901 } else if (TCON_U4(r) != 1) { 03902 TCON_U4(r) = 0; 03903 } 03904 break; 03905 case MTYPE_I8: 03906 if (TCON_I8(r) == 0) { 03907 *folded = FALSE; 03908 } else if (TCON_I8(r) != 1 && TCON_I8(r) != -1) { 03909 TCON_I8(r) = 0; 03910 } 03911 break; 03912 case MTYPE_U8: 03913 if (TCON_U8(r) == 0) { 03914 *folded = FALSE; 03915 } else if (TCON_U8(r) != 1) { 03916 TCON_U8(r) = 0; 03917 } 03918 break; 03919 } 03920 } 03921 } 03922 return (r); 03923 } 03924 03925 03926 /* General exponentiation routine. If nothing is done, return 03927 FALSE in folded */ 03928 03929 03930 static TCON Targ_Power(TCON base, TCON exp, BOOL *folded, TYPE_ID btype) 03931 { 03932 UINT64 int_exp; 03933 BOOL neg_exp; 03934 TCON r; 03935 03936 03937 TCON_clear (r); 03938 03939 /* Check for integer exponent */ 03940 if (TCON_ty(exp) == MTYPE_U8) { 03941 return (Targ_Ipower(base, TCON_U8(exp), FALSE, folded, btype)); 03942 } else if (TCON_ty(exp) == MTYPE_U4) { 03943 return (Targ_Ipower(base, (UINT64) TCON_U4(exp), FALSE, folded, btype)); 03944 } else if (TCON_ty(exp) == MTYPE_I4) { 03945 int_exp = TCON_I4(exp); 03946 neg_exp = FALSE; 03947 if ((INT64) int_exp < 0) { 03948 neg_exp = TRUE; 03949 int_exp = -((INT64) int_exp); 03950 } 03951 return (Targ_Ipower(base,int_exp,neg_exp,folded,btype)); 03952 03953 } else if (TCON_ty(exp) == MTYPE_I8) { 03954 int_exp = TCON_I8(exp); 03955 neg_exp = FALSE; 03956 03957 if (int_exp == 0x8000000000000000LL) { 03958 neg_exp = TRUE; 03959 } else if ((INT64) int_exp < 0) { 03960 int_exp = -((INT64)int_exp); 03961 neg_exp = TRUE; 03962 } 03963 return (Targ_Ipower(base,int_exp,neg_exp,folded,btype)); 03964 } 03965 03966 /* Check for the same type */ 03967 if (TCON_ty(base) != TCON_ty(exp)) { 03968 if (folded) *folded = FALSE; 03969 return (r); 03970 } 03971 03972 /* Do the floating-point types */ 03973 03974 switch (TCON_ty(base)) { 03975 case MTYPE_F4: 03976 TCON_ty(r) = MTYPE_F4; 03977 TCON_R4(r) = pow ((double) TCON_R4(base), (double) TCON_R4(exp)); 03978 break; 03979 03980 case MTYPE_F8: 03981 TCON_ty(r) = MTYPE_F8; 03982 TCON_R8(r) = pow (TCON_R8(base),TCON_R8(exp)); 03983 break; 03984 03985 default: 03986 /* Not done yet */ 03987 if (folded) *folded = FALSE; 03988 break; 03989 } 03990 03991 return (r); 03992 } 03993 03994 #ifndef MONGOOSE_BE 03995 TCON 03996 Targ_Pow ( TCON a, TCON b ) 03997 /* NOTE: No one invokes this function !! */ 03998 03999 { 04000 INT32 va, vb, r; 04001 04002 va = TCON_v0(a); 04003 vb = TCON_v0(b); 04004 if (va == 0) 04005 r = 0; 04006 else if (va == 1) 04007 r = 1; 04008 else if (va == -1) { 04009 if (vb < 0) vb = -vb; 04010 r = (vb % 2) ? -1 : 1; 04011 } else if (vb == 0) 04012 r = 1; 04013 else if (vb < 0) /* va > 1 or va < -1. vb < 0. => 1/va**vb = 0 */ 04014 r = 0; 04015 else { 04016 if (vb >= 63) { 04017 /* ErrMsg ( EC_Exp_Oflow, va, vb );*/ 04018 r = 0; 04019 } else { 04020 r = 1; 04021 while (vb--) r *= va; 04022 } 04023 } 04024 TCON_v0(a) = r; 04025 return a; 04026 } /* Targ_Pow */ 04027 #endif /* MONGOOSE_BE */ 04028 04029 /* ==================================================================== 04030 * 04031 * Targ_Append_To_Dbuf 04032 * 04033 * Append the given character to the given string, returning an updated 04034 * pointer to the string. If the character is "special", use the C 04035 * format for it, e.g. "\n" for newline, "\003" for ^C, etc. 04036 * 04037 * ==================================================================== 04038 */ 04039 04040 char * 04041 Targ_Append_To_Dbuf (char *str, char ch) 04042 { 04043 char ch1; 04044 if ( ch >= ' ' && ch <= '~' && ch != '\\' ) { 04045 *str++ = ch; 04046 } else { 04047 ch1 = 0; 04048 switch ( ch ) { 04049 case '\n': ch1 = 'n'; break; 04050 case '\t': ch1 = 't'; break; 04051 case '\b': ch1 = 'b'; break; 04052 case '\r': ch1 = 'r'; break; 04053 case '\f': ch1 = 'f'; break; 04054 case '\v': ch1 = 'v'; break; 04055 case '\?': ch1 = '?'; break; 04056 case '\\': ch1 = '\\'; break; 04057 } 04058 *str++ = '\\'; 04059 if (ch1) 04060 *str++ = ch1; 04061 else { 04062 sprintf(str, "%03o", ch & 0xff); 04063 str += 3; 04064 } 04065 } 04066 return str; 04067 } /* Targ_Append_To_Dbuf */ 04068 04069 #define DUMP_STR 1 04070 #ifdef DUMP_STR 04071 #define APPEND_TO_DBUF(a,b) a = Targ_Append_To_Dbuf(a,b) 04072 #else /* DUMP_STR */ 04073 #define APPEND_TO_DBUF(a,b) 04074 #endif /* DUMP_STR */ 04075 04076 #ifndef MONGOOSE_BE 04077 /* ==================================================================== 04078 * 04079 * Targ_Format_String 04080 * 04081 * Format the given string as a printable string, by replacing special 04082 * characters by the C source codes, e.g. "\n" for newline, "\003" for 04083 * '^C', etc. The caller passes the string to be formatted (s), its 04084 * length (slen, zero implying NULL termination), the string to format 04085 * it into (buf), a maximum length (lmax), a maximum line length (line, 04086 * may be 0 for no maximum), and a string to insert in the buffer 04087 * between lines (divider). 04088 * 04089 * If lmax may be exceeded, the source string is truncated, and the 04090 * buffer is terminated with an * ellipsis (...). If line is non-zero, 04091 * the formatted string has "divider" inserted between segments of at 04092 * most line characters; "divider" will typically consist of a 04093 * terminating double quote, a newline, possibly a tab, and an opening 04094 * double quote. 04095 * 04096 * Inserted dividers do count against the maximum length, but not 04097 * against the line length. The returned string is NULL-terminated, 04098 * and the terminating NULL counts against the maximum length. 04099 * 04100 * The return value indicates whether the full string was formatted. 04101 * 04102 * NOTE: No attempt has been made to be efficient. 04103 * 04104 * ==================================================================== 04105 */ 04106 04107 BOOL 04108 Targ_Format_String ( 04109 char *s, /* String to format, */ 04110 INT32 slen, /* ... of this length, */ 04111 char *buf, /* ... into this buffer, */ 04112 INT32 blen, /* ... with at most this many characters, */ 04113 INT32 line, /* ... with lines at most this long (0 = no limit), */ 04114 char *divider ) /* ... divided by this string. */ 04115 { 04116 INT32 len=0; /* Actual formatted length */ 04117 INT32 llen=0; /* Actual formatted line length */ 04118 INT32 dlen = divider ? strlen(divider) : 0; 04119 char cbuf[5]; /* Buffer for a character */ 04120 INT16 clen; /* Length of character in cbuf */ 04121 INT32 i; 04122 04123 /* Adjust input parameters: */ 04124 if ( slen == 0 ) slen = strlen(s); 04125 if ( line == 0 || divider == NULL ) line = blen; 04126 04127 for ( i=0; i<slen; i++ ) { 04128 04129 /* Format the character. Note that the maximum value of clen, for 04130 * a special character formatted \xxx, is 4: 04131 */ 04132 clen = Targ_Append_To_Dbuf ( cbuf, s[i] ) - cbuf; 04133 cbuf[clen] = 0; 04134 04135 /* Make sure there's room in this line for the string -- 04136 * we are conservative: 04137 */ 04138 if ( llen > line-clen ) { 04139 /* If there's no room in buffer, ignore line length limit: */ 04140 if ( len < blen-dlen-clen-1 ) { 04141 (void) strcpy ( buf, divider ); 04142 buf += dlen; 04143 len += dlen; 04144 llen = 0; 04145 } 04146 } 04147 04148 /* Is there room in the buffer for it? */ 04149 if ( len+clen < blen ) { 04150 /* Yes: */ 04151 (void) strcpy ( buf, cbuf ); 04152 buf += clen; 04153 len += clen; 04154 llen += clen; 04155 } else { 04156 /* No: insert ellipsis and quit: */ 04157 if ( blen - len < 4 ) buf -= (len+4)-blen; 04158 (void) strcpy ( buf, "..." ); 04159 return FALSE; 04160 } 04161 } 04162 04163 /* We managed to format everything. Note that copying the last 04164 * character always set terminating NULL. 04165 */ 04166 return TRUE; 04167 } /* Targ_Format_String */ 04168 04169 04170 04171 #ifdef HAS_TCON_TO_STR 04172 /*---------------------------------------------------------------------- 04173 * Put value of v in *buf in a host independent way. buf will only 04174 * be accessed as char*. The byte ordering within buf may be 04175 * 'implementation defined', but it must give the same results for the 04176 * same compiler on different hosts. 04177 * 04178 * TODO Josie/92: Integrate changes 04179 *--------------------------------------------------------------------*/ 04180 char * 04181 Tcon_To_Str(buf, v) 04182 TCON v; 04183 char *buf; 04184 { 04185 INT *ip = (INT *) buf; /*TODO: or should this be INT64 ? */ 04186 float *fp = (float *) buf; 04187 double *dp = (double *) buf; 04188 switch (TCON_ty(v)) { 04189 case MTYPE_B: 04190 case MTYPE_I1: /* may want to change for [IL][12] */ 04191 case MTYPE_I2: 04192 case MTYPE_I4: 04193 case MTYPE_U1: 04194 case MTYPE_U2: 04195 case MTYPE_U4: 04196 /* if host and target byte order are different, we might want to do 04197 something here */ 04198 *ip = TCON_v0(v); 04199 break; 04200 case MTYPE_I8: 04201 case MTYPE_U8: 04202 /* if host and target byte order are different, we might want to do 04203 something here */ 04204 *ip = TCON_I8(v); 04205 break; 04206 case MTYPE_F4: 04207 /* user is attempting to look into individual bytes of floating constant 04208 He better know the floating point format. Compilers responsibility 04209 is only to do the conversion in a host independent way, i.e., same 04210 source must give same object on whatever machine the compiler 04211 is hosted */ 04212 *fp = TCON_R4(v); 04213 break; 04214 case MTYPE_F8: 04215 *dp = TCON_R8(v); 04216 break; 04217 default: 04218 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(v)), "Tcon_To_Str" ); 04219 } 04220 return buf; 04221 } /* Tcon_To_Str */ 04222 04223 04224 /*---------------------------------------------------------------------- 04225 * reverse of above. Used where constants have been specified in 04226 * hex, binary, holleriths etc. 04227 *--------------------------------------------------------------------*/ 04228 04229 /* 04230 * Throughout this routine, if Same_Byte_Sex, then perform no 04231 * transformation on data string, otherwise perform byte-sex-change on 04232 * data. We always have to copy to a local buffer in case the argument 04233 * buffer is not aligned properly. 04234 */ 04235 TCON 04236 Str_To_Tcon(TYPE_ID ty, char *buf) 04237 { 04238 union { 04239 double d_align; /* for alignment and size restrictions */ 04240 char buf[2*sizeof(double)]; 04241 } local_buf; 04242 char *tbuf = (char *)&local_buf; 04243 TCON c; 04244 04245 TCON_ty(c) = ty; 04246 04247 switch (ty) { 04248 case MTYPE_I1: 04249 case MTYPE_U1: /* We want to sign-extend here; we'll truncate later */ 04250 TCON_v0(c) = *buf; 04251 TCON_v1(c) = 0; 04252 break; 04253 case MTYPE_I2: 04254 case MTYPE_U2: /* We want to sign-extend here; we'll truncate later */ 04255 if (Same_Byte_Sex) { 04256 tbuf[0] = buf[0]; 04257 tbuf[1] = buf[1]; 04258 } else { 04259 tbuf[0] = buf[1]; 04260 tbuf[1] = buf[0]; 04261 } 04262 TCON_v0(c) = *((mINT16 *)tbuf); 04263 TCON_v1(c) = 0; 04264 break; 04265 case MTYPE_I4: 04266 case MTYPE_U4: 04267 /* if host and target byte order are different, we might want to do 04268 something here */ 04269 if (Same_Byte_Sex) { 04270 tbuf[0] = buf[0]; 04271 tbuf[1] = buf[1]; 04272 tbuf[2] = buf[2]; 04273 tbuf[3] = buf[3]; 04274 } else { 04275 tbuf[0] = buf[3]; 04276 tbuf[1] = buf[2]; 04277 tbuf[2] = buf[1]; 04278 tbuf[3] = buf[0]; 04279 } 04280 TCON_v0(c) = *((INT32 *)tbuf); 04281 TCON_v1(c) = 0; 04282 break; 04283 case MTYPE_I8: 04284 case MTYPE_U8: 04285 /* if host and target byte order are different, we might want to do 04286 something here */ 04287 if (Same_Byte_Sex) { 04288 tbuf[0] = buf[0]; 04289 tbuf[1] = buf[1]; 04290 tbuf[2] = buf[2]; 04291 tbuf[3] = buf[3]; 04292 tbuf[4] = buf[4]; 04293 tbuf[5] = buf[5]; 04294 tbuf[6] = buf[6]; 04295 tbuf[7] = buf[7]; 04296 TCON_I8(c) = *((INT64 *)tbuf); 04297 } else { 04298 /* 04299 * We must be very careful about which word gets which set of 4 04300 * bytes here. To be totally correct, buf[0] must go into the 04301 * byte referenced by (char *)(TCON_I8(c)). That would be the 04302 * first word here, normally (ie, TCON_v0(c)). However, since 04303 * the current code is written to use the host's representation 04304 * as the internal representation, there is a kludge in 04305 * Emit_Const above which always swaps words when dumping to the 04306 * output file. As such, we swap the words here, so that the 04307 * later swap will do the right thing. Blech, kludge upon kludge. 04308 */ 04309 tbuf[0] = buf[7]; 04310 tbuf[1] = buf[6]; 04311 tbuf[2] = buf[5]; 04312 tbuf[3] = buf[4]; 04313 TCON_v0(c) = *((INT *)tbuf); 04314 tbuf[0] = buf[3]; 04315 tbuf[1] = buf[2]; 04316 tbuf[2] = buf[1]; 04317 tbuf[3] = buf[0]; 04318 TCON_v1(c) = *((INT *)tbuf); 04319 } 04320 break; 04321 case MTYPE_F4: 04322 /* User is trying to give floating constant in hollerith, etc. 04323 He needs to know the floating point format. On the other hand, 04324 he may be doing hollerith/character init of a variable which will 04325 be printed out as character data, in which case the user doesn't 04326 care what the format is. Either way, the compiler's responsibility 04327 is only to do the conversion in a host independent way, i.e., same 04328 source must give same object on whatever machine the compiler 04329 is hosted. 04330 */ 04331 if (Same_Byte_Sex) { 04332 tbuf[0] = buf[0]; 04333 tbuf[1] = buf[1]; 04334 tbuf[2] = buf[2]; 04335 tbuf[3] = buf[3]; 04336 } else { 04337 tbuf[0] = buf[3]; 04338 tbuf[1] = buf[2]; 04339 tbuf[2] = buf[1]; 04340 tbuf[3] = buf[0]; 04341 } 04342 Set_TCON_R4 ( c, *((float *)tbuf) ); 04343 TCON_v1(c) = 0; 04344 break; 04345 04346 case MTYPE_F8: 04347 if (Same_Byte_Sex) { 04348 tbuf[0] = buf[0]; 04349 tbuf[1] = buf[1]; 04350 tbuf[2] = buf[2]; 04351 tbuf[3] = buf[3]; 04352 tbuf[4] = buf[4]; 04353 tbuf[5] = buf[5]; 04354 tbuf[6] = buf[6]; 04355 tbuf[7] = buf[7]; 04356 TCON_R8(c) = *((double *)tbuf); 04357 } else { 04358 /* 04359 * We must be very careful about which word gets which set of 4 04360 * bytes here. To be totally correct, buf[0] must go into the 04361 * byte referenced by (char *)(TCON_R8(c)). That would be the 04362 * first word here, normally (ie, TCON_v0(c)). However, since 04363 * the current code is written to use the host's representation 04364 * as the internal representation, there is a kludge in 04365 * Emit_Const above which always swaps words when dumping to the 04366 * output file. As such, we swap the words here, so that the 04367 * later swap will do the right thing. Blech, kludge upon kludge. 04368 */ 04369 tbuf[0] = buf[7]; 04370 tbuf[1] = buf[6]; 04371 tbuf[2] = buf[5]; 04372 tbuf[3] = buf[4]; 04373 TCON_v0(c) = *((INT *)tbuf); 04374 tbuf[0] = buf[3]; 04375 tbuf[1] = buf[2]; 04376 tbuf[2] = buf[1]; 04377 tbuf[3] = buf[0]; 04378 TCON_v1(c) = *((INT *)tbuf); 04379 } 04380 break; 04381 04382 default: 04383 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Str_To_Tcon" ); 04384 } 04385 return c; 04386 } /* Str_To_Tcon */ 04387 04388 #if 0 /*foo*/ 04389 /* 04390 * Bit_Str_To_Tcon 04391 * 04392 * This routine is passed a sequence of bytes in buf[0], buf[1], ... 04393 * which have the following semantics: the byte in buf[0] is the least 04394 * significant byte; the byte in buf[1] is the next least significant 04395 * byte; etc until we run out of bytes for an object of be_type "ty". 04396 * We must make a TCON which preserves the byte ordering regardless of 04397 * target endianness. Hence if the user does: 04398 * i = '00001001'x 04399 * i had better get the value 4097. 04400 * It is the callers responsibility to provide us with "n" bytes of 04401 * valid "buf" if the betype corresponding to "ty" requires "n" bytes 04402 * of target representation. In other words, MTYPE_I1 only requires 04403 * that buf[0] be valid, but MTYPE_F8 requires that buf[0] through 04404 * buf[7] be valid. The caller must do any zero padding in buf as 04405 * required so that buf[0] is the LSByte of the constant. 04406 * TODO: is MTYPE_I1, buf[0] == 0xff supposed to be 255 or -1? 04407 * Targ_To_Host doesn't care what we do, does anybody else? 04408 */ 04409 04410 TCON 04411 Bit_Str_To_Tcon ( TYPE_ID ty, char *arg_buf ) 04412 { 04413 static TCON c; 04414 unsigned char *buf; 04415 UINT temp; 04416 04417 buf = (unsigned char *)arg_buf; /* zero-extend our arg bytes */ 04418 TCON_ty(c) = ty; 04419 04420 switch (ty) { 04421 case MTYPE_I1: 04422 case MTYPE_U1: /* We want to sign-extend here; we'll truncate later */ 04423 TCON_v0(c) = buf[0]; 04424 TCON_v1(c) = 0; 04425 break; 04426 04427 case MTYPE_I2: 04428 case MTYPE_U2: /* We want to sign-extend here; we'll truncate later */ 04429 TCON_v0(c) = (buf[1] << 8) | buf[0]; 04430 TCON_v1(c) = 0; 04431 break; 04432 04433 case MTYPE_I4: 04434 case MTYPE_U4: 04435 TCON_v0(c) = (buf[3] << 24) | (buf[2] << 16) | (buf[1] << 8) | buf[0]; 04436 TCON_v1(c) = 0; 04437 break; 04438 04439 case MTYPE_F4: 04440 /* user is trying to give floating constant in binary, octal, hex, 04441 * etc. He had better know the floating point format. 04442 */ 04443 temp = (buf[3] << 24) | (buf[2] << 16) | (buf[1] << 8) | buf[0]; 04444 Set_TCON_R4(c, *((float *)&temp)); 04445 TCON_v1(c) = 0; 04446 break; 04447 04448 case MTYPE_F8: 04449 /* We must be careful about which word gets which set of 4 bytes 04450 * here. buf[0] must go into the most significant byte of 04451 * TCON_R8. Since the current code is written to use the host's 04452 * representation as the internal representation, we must make 04453 * sure we put it in the proper place depending on the host's 04454 * endianness. 04455 */ 04456 #if HOST_IS_BIG_ENDIAN 04457 TCON_v1(c) = (buf[3] << 24) | (buf[2] << 16) | (buf[1] << 8) | buf[0]; 04458 TCON_v0(c) = (buf[7] << 24) | (buf[6] << 16) | (buf[5] << 8) | buf[4]; 04459 #else 04460 TCON_v0(c) = (buf[3] << 24) | (buf[2] << 16) | (buf[1] << 8) | buf[0]; 04461 TCON_v1(c) = (buf[7] << 24) | (buf[6] << 16) | (buf[5] << 8) | buf[4]; 04462 #endif 04463 break; 04464 04465 case MTYPE_FQ: 04466 /* We must be careful about which word gets which set of 4 bytes 04467 * here. buf[0] must go into the most significant byte of 04468 * TCON_R8. Since the current code is written to use the host's 04469 * representation as the internal representation, we must make 04470 * sure we put it in the proper place depending on the host's 04471 * endianness. 04472 */ 04473 #if HOST_IS_BIG_ENDIAN 04474 TCON_v3(c) = (buf[3] << 24) | (buf[2] << 16) | (buf[1] << 8) | buf[0]; 04475 TCON_v2(c) = (buf[7] << 24) | (buf[6] << 16) | (buf[5] << 8) | buf[4]; 04476 TCON_v1(c) = (buf[11] << 24) | (buf[10] << 16) | (buf[9] << 8) | buf[8]; 04477 TCON_v0(c) = (buf[15] << 24) | (buf[14] << 16) | (buf[13] << 8) | buf[12]; 04478 #else 04479 TCON_v0(c) = (buf[3] << 24) | (buf[2] << 16) | (buf[1] << 8) | buf[0]; 04480 TCON_v1(c) = (buf[7] << 24) | (buf[6] << 16) | (buf[5] << 8) | buf[4]; 04481 TCON_v2(c) = (buf[11] << 24) | (buf[10] << 16) | (buf[9] << 8) | buf[8]; 04482 TCON_v3(c) = (buf[15] << 24) | (buf[14] << 16) | (buf[13] << 8) | buf[12]; 04483 #endif 04484 break; 04485 04486 default: 04487 ErrMsg ( EC_Inv_Mtype, Mtype_Name(ty), "Bit_Str_To_Tcon" ); 04488 } 04489 return c; 04490 } /* Bit_Str_To_Tcon */ 04491 #endif /*foo*/ 04492 04493 #endif /* HAS_TCON_TO_STR */ 04494 04495 #endif /* MONGOOSE_BE */ 04496 04497 /* ==================================================================== 04498 * 04499 * Targ_Is_Integral 04500 * 04501 * Determine whether a TCON represents an integral value, and if so 04502 * return its value. 04503 * 04504 * ==================================================================== 04505 */ 04506 04507 BOOL 04508 Targ_Is_Integral ( TCON tc, INT64 *iv ) 04509 { 04510 switch (TCON_ty(tc)) { 04511 case MTYPE_B: 04512 case MTYPE_I1: 04513 case MTYPE_I2: 04514 case MTYPE_I4: 04515 *iv = TCON_v0(tc); 04516 return TRUE; 04517 04518 case MTYPE_U1: 04519 case MTYPE_U2: 04520 case MTYPE_U4: 04521 *iv = TCON_u0(tc); 04522 return TRUE; 04523 04524 case MTYPE_I8: 04525 case MTYPE_U8: 04526 *iv = TCON_I8(tc); 04527 return TRUE; 04528 04529 case MTYPE_F4: 04530 { 04531 INT32 k = (INT32)TCON_R4(tc); 04532 float s = k; 04533 if (s == TCON_R4(tc)) { 04534 *iv = k; 04535 return TRUE; 04536 } 04537 } 04538 return FALSE; 04539 04540 case MTYPE_F8: 04541 { 04542 INT64 k = (INT64)TCON_R8(tc); 04543 double d = k; 04544 if (d == TCON_R8(tc)) { 04545 *iv = k; 04546 return TRUE; 04547 } 04548 } 04549 return FALSE; 04550 04551 #ifdef TARG_NEEDS_QUAD_OPS 04552 case MTYPE_FQ: 04553 { 04554 QUAD q; 04555 INT32 err; 04556 INT32 k = __c_ji_qint(R16_To_RQ(TCON_R16(tc)), &err); 04557 if (err) return FALSE; 04558 q = __c_q_flotj(k, &err); 04559 if (err) return FALSE; 04560 if (__c_q_eq(q, R16_To_RQ(TCON_R16(tc)), &err)) { 04561 if (err) return FALSE; 04562 *iv = k; 04563 return TRUE; 04564 } 04565 } 04566 return FALSE; 04567 #endif 04568 04569 /* TODO : fix for mongoose */ 04570 case MTYPE_C4: 04571 case MTYPE_C8: 04572 case MTYPE_CQ: 04573 return FALSE; 04574 04575 case MTYPE_STR: 04576 return FALSE; 04577 04578 default: 04579 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(tc)), 04580 "Targ_Is_Integral" ); 04581 } 04582 return FALSE; 04583 } /* Targ_Is_Integral */ 04584 #ifdef OLDCODE 04585 #ifdef FRONT_END 04586 04587 /**********************************************************************/ 04588 /* Coerce the input parameter to an integer constant, if the */ 04589 /* conversion can be done without loss of significance */ 04590 /**********************************************************************/ 04591 WN * 04592 Coerce_To_Integer(subtree) 04593 WN *subtree; 04594 { 04595 TCON operand, truncated, converted; 04596 WN *coerced_subtree; 04597 INT32 err; 04598 04599 coerced_subtree = subtree; 04600 truncated = MTYPE_size_min(TY_btype(The_Tree_Type(subtree))) <= 32 ? 04601 Zero_I4_Tcon : Zero_I8_Tcon; 04602 04603 if (Is_Const(subtree, &operand)) { 04604 switch (TCON_ty(operand)) { 04605 case MTYPE_B: 04606 case MTYPE_I1: 04607 case MTYPE_I2: 04608 case MTYPE_I4: 04609 case MTYPE_I8: 04610 case MTYPE_U1: 04611 case MTYPE_U2: 04612 case MTYPE_U4: 04613 case MTYPE_U8: 04614 break; 04615 04616 case MTYPE_F4: 04617 TCON_v0(truncated) = TCON_R4(operand); 04618 Set_TCON_R4 ( converted, TCON_v0(truncated) ); 04619 if (TCON_R4(converted) == TCON_R4(operand)) { 04620 TCON_ty(truncated) = MTYPE_I4; 04621 coerced_subtree = Make_Const(truncated); 04622 } 04623 break; 04624 04625 case MTYPE_F8: 04626 TCON_v0(truncated) = TCON_R8(operand); 04627 TCON_R8(converted) = TCON_v0(truncated); 04628 if (TCON_R8(converted) == TCON_R8(operand)) { 04629 TCON_ty(truncated) = MTYPE_I4; 04630 coerced_subtree = Make_Const(truncated); 04631 } 04632 break; 04633 04634 #ifdef TARG_NEEDS_QUAD_OPS 04635 case MTYPE_FQ: 04636 TCON_v0(truncated) = __c_ji_qint(R16_To_RQ(TCON_R16(operand)), &err); 04637 TCON_R16(converted) = RQ_To_R16(__c_q_flotj(TCON_v0(truncated), &err)); 04638 if (__c_q_eq(R16_To_RQ(TCON_R16(converted)), 04639 R16_To_RQ(TCON_R16(operand)), 04640 &err)) { 04641 TCON_ty(truncated) = MTYPE_I4; 04642 coerced_subtree = Make_Const(truncated); 04643 } 04644 break; 04645 #endif 04646 04647 default: 04648 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(operand)), 04649 "Coerce_To_Integer" ); 04650 break; 04651 } 04652 } 04653 return coerced_subtree; 04654 } /* Coerce_To_Integer */ 04655 #endif 04656 #endif /* OLDCODE */ 04657 04658 /*---------------------------------------------------------------------------- 04659 * return TRUE if the target representation of this TCON is has all zeros 04660 *--------------------------------------------------------------------------*/ 04661 04662 BOOL Targ_Is_Zero ( TCON t ) 04663 { 04664 switch (TCON_ty(t)) { 04665 case MTYPE_B: 04666 case MTYPE_I1: 04667 case MTYPE_I2: 04668 case MTYPE_I4: 04669 case MTYPE_U1: 04670 case MTYPE_U2: 04671 case MTYPE_U4: 04672 return TCON_v0(t) == 0; 04673 case MTYPE_F4: 04674 /* make sure is not -0.0 (sign-bit set); 04675 * -0.0 will == 0.0, so add check for sign bit. */ 04676 return (TCON_R4(t) == 0.0 && TCON_v0(t) == 0); 04677 // return TCON_v1(t) == 0; 04678 case MTYPE_I8: 04679 case MTYPE_U8: 04680 return (TCON_v0(t)|TCON_v1(t)) == 0; 04681 case MTYPE_F8: 04682 /* make sure is not -0.0 (sign-bit set); 04683 * -0.0 will == 0.0, so add check for sign bit. */ 04684 return (TCON_R8(t) == 0.0 04685 && (TCON_v0(t)|TCON_v1(t)) == 0); 04686 04687 #ifdef TARG_NEEDS_QUAD_OPS 04688 case MTYPE_FQ: 04689 { 04690 INT32 dummy_err; 04691 /* return (TCON_v0(t)|TCON_v1(t)|TCON_v2(t)|TCON_v3(t)) == 0; */ 04692 return (__c_q_eq(R16_To_RQ(TCON_R16(t)), 04693 __c_q_extd(0.0, &dummy_err), 04694 &dummy_err)); 04695 } 04696 #endif 04697 04698 /* TODO : fix for mongoose */ 04699 case MTYPE_C4: 04700 case MTYPE_C8: 04701 case MTYPE_CQ: 04702 case MTYPE_STR: 04703 return FALSE; 04704 04705 default: 04706 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(t)), "Targ_Is_Zero" ); 04707 } 04708 return FALSE; 04709 } /* Targ_Is_Zero */ 04710 04711 /* ==================================================================== 04712 * 04713 * Targ_Is_Power_Of_Two 04714 * 04715 * Determine whether the TCON represents a power of two. 04716 * 04717 * ==================================================================== 04718 */ 04719 04720 BOOL 04721 Targ_Is_Power_Of_Two ( TCON t ) 04722 { 04723 INT64 cval; 04724 INT32 exponent, mant; 04725 04726 if ( Targ_Is_Integral ( t, &cval ) ) { 04727 if ( cval == 0 ) return FALSE; 04728 if ( cval == ( cval & ~(cval-1) ) ) return TRUE; 04729 } 04730 04731 /* Check for other floating point powers */ 04732 switch (TCON_ty(t)) { 04733 case MTYPE_F4: 04734 exponent = (TCON_v0(t) & 0x7f800000) >> 23; 04735 mant = TCON_v0(t) & 0x007fffff; 04736 return mant == 0 && exponent != 0 && exponent != 255; 04737 04738 case MTYPE_F8: 04739 exponent = (TCON_v1(t) & 0x7ff00000) >> 20; 04740 mant = (TCON_v1(t) & 0x000fffff) | TCON_v0(t); 04741 return mant==0 && exponent != 0 && exponent != 2047; 04742 04743 #ifdef TARG_NEEDS_QUAD_OPS 04744 case MTYPE_FQ: 04745 /* assumes quads are implemented as 04746 * struct quad { 04747 * double hi,lo 04748 * } 04749 */ 04750 exponent = (TCON_v1(t) & 0x7ff00000) >> 20; 04751 mant = (TCON_v1(t) & 0x000fffff) | TCON_v0(t) | TCON_v2(t) | TCON_v3(t); 04752 return mant==0 && exponent != 0 && exponent != 2047; 04753 #endif 04754 } 04755 04756 return FALSE; 04757 } 04758 04759 04760 #ifndef MONGOOSE_BE 04761 /* ==================================================================== 04762 * 04763 * Targ_Contains_One_Bit_On 04764 * 04765 * Determine whether the TCON contains an integral value with only 04766 * one bit on. 04767 * 04768 * If onebit is not NULL then return the bit number of the bit 04769 * that is on. 04770 * 04771 * 04772 * ==================================================================== 04773 */ 04774 04775 BOOL 04776 Targ_Contains_One_Bit_On ( TCON t, INT32 *onebit ) 04777 { 04778 INT64 cval; 04779 INT32 i; 04780 04781 if ( Targ_Is_Integral ( t, &cval ) ) { 04782 if ( cval == 0 ) return FALSE; 04783 if ( cval != ( cval & ~(cval-1) ) ) return FALSE; 04784 for (i=0; i< 64; i++) { 04785 if (cval & 0x1 ) { 04786 if (onebit != NULL) *onebit = i; 04787 return TRUE; 04788 } 04789 cval = cval >> 1; 04790 } /* for i */ 04791 } 04792 return FALSE; 04793 } 04794 04795 /* ==================================================================== 04796 * 04797 * Targ_Determine_High_Bit 04798 * 04799 * Determine the most significant bit that is on, with 0 being the 04800 * least-sig bit, and type's_size - 1 being the most-sig bit. 04801 * If no bits are on, return FALSE. 04802 * 04803 * ==================================================================== 04804 */ 04805 04806 BOOL 04807 Targ_Determine_High_Bit ( TCON t, INT32 *highbit ) 04808 { 04809 INT64 cval; 04810 INT32 i; 04811 04812 if ( Targ_Is_Integral ( t, &cval ) ) { 04813 UINT64 testbit; 04814 if ( cval == 0 ) return FALSE; 04815 04816 testbit = ((INT64)1) << MTYPE_size_min(TCON_ty(t))-1; 04817 for ( i = MTYPE_size_min(TCON_ty(t))-1; i >= 0; i-- ) { 04818 if ( (cval & testbit) != 0 ) { 04819 if ( highbit != NULL ) *highbit = i; 04820 return TRUE; 04821 } 04822 04823 testbit = testbit >> 1; 04824 } 04825 } 04826 return FALSE; 04827 } 04828 #endif /* MONGOOSE_BE */ 04829 04830 /* ==================================================================== 04831 * 04832 * Hash_TCON 04833 * 04834 * Hash a TCON into a 32-bit integer modulo another integer. 04835 * 04836 * ==================================================================== 04837 */ 04838 04839 UINT32 04840 Hash_TCON ( TCON * t, UINT32 modulus ) 04841 { 04842 UINT32 hash = TCON_ty(*t); 04843 UINT32 rhash; 04844 INT32 i; 04845 char *s; 04846 04847 switch (TCON_ty(*t)) { 04848 case MTYPE_B: 04849 case MTYPE_I1: 04850 case MTYPE_I2: 04851 case MTYPE_I4: 04852 case MTYPE_U1: 04853 case MTYPE_U2: 04854 case MTYPE_U4: 04855 case MTYPE_F4: 04856 hash += TCON_v0(*t); 04857 break; 04858 case MTYPE_I8: 04859 case MTYPE_U8: 04860 case MTYPE_F8: 04861 hash += TCON_v0(*t) + TCON_v1(*t); 04862 break; 04863 case MTYPE_FQ: 04864 hash += TCON_v0(*t) + TCON_v1(*t) + TCON_v2(*t) + TCON_v3(*t); 04865 break; 04866 case MTYPE_C4: 04867 hash += TCON_v0(*t); 04868 hash += TCON_iv0(*t); 04869 break; 04870 case MTYPE_C8: 04871 hash += TCON_v0(*t) + TCON_v1(*t); 04872 hash += TCON_iv0(*t) + TCON_iv1(*t); 04873 break; 04874 case MTYPE_CQ: 04875 hash += TCON_v0(*t) + TCON_v1(*t) + TCON_v2(*t) + TCON_v3(*t); 04876 hash += TCON_iv0(*t) + TCON_iv1(*t) + TCON_iv2(*t) + TCON_iv3(*t); 04877 break; 04878 case MTYPE_STRING: 04879 s = Index_to_char_array (TCON_cp (*t)); 04880 for ( i = 0; i < TCON_len(*t); i++, s++ ) { 04881 hash += (*s) << ((i % 4) * 8); 04882 } 04883 break; 04884 default: 04885 ErrMsg ( EC_Inv_Mtype, Mtype_Name(TCON_ty(*t)), "Hash_TCON" ); 04886 return 0; 04887 } 04888 04889 if ( hash == 0 ) { 04890 /* Avoid later recalculation: */ 04891 hash = MTYPE_LAST; 04892 } 04893 rhash = hash % modulus; 04894 04895 #ifdef Is_True_On 04896 if ( Get_Trace ( TP_MISC, 16 ) ) { 04897 fprintf ( TFile, "<tc> Hashing TCON ty=%d, %u mod %u = %u\n", 04898 TCON_ty(*t), hash, modulus, rhash ); 04899 } 04900 #endif 04901 04902 return rhash; 04903 } /* Hash_TCON */ 04904 04905 /* ==================================================================== 04906 * 04907 * Handle_Fortran_Constants 04908 * 04909 * Process context dependent floating point constants (FORTRAN ONLY) 04910 * 04911 * ==================================================================== 04912 */ 04913 04914 #ifdef FRONT_END_FORTRAN 04915 BOOL Handle_Fortran_Constants(ND *t, TY *to_ty) 04916 { 04917 return FALSE; 04918 } /* Handle_Fortran_Constants */ 04919 #endif /* FRONT_END_FORTRAN */ 04920 04921 04922 /* 04923 * Targ_IntrinsicOp 04924 * 04925 * fold intrinsics. Arguments are essentially the same as Targ_Op and Targ_WhirlOp 04926 * 04927 */ 04928 04929 04930 TCON Targ_IntrinsicOp ( UINT32 intrinsic, TCON c[], BOOL *folded) 04931 { 04932 TCON c0,t; 04933 *folded = TRUE; 04934 04935 c0 = c[0]; /* to get the type information by default */ 04936 04937 04938 #define DEG_TO_RAD (M_PI/180.0) 04939 #define RAD_TO_DEG (180.0/M_PI) 04940 04941 #ifdef QUAD_PRECISION_SUPPORTED 04942 #define M_PIL 3.141592653589793238462643383279531l 04943 #define DEG_TO_RADQ (M_PIL/180.0l) 04944 #define RAD_TO_DEGQ (180.0l/M_PIL) 04945 #endif 04946 04947 switch ((INTRINSIC) intrinsic) { 04948 04949 case INTRN_I4EXPEXPR: 04950 c0 = Targ_Power(c[0],c[1],folded,MTYPE_I4); 04951 break; 04952 case INTRN_I8EXPEXPR: 04953 c0 = Targ_Power(c[0],c[1],folded,MTYPE_I8); 04954 break; 04955 case INTRN_F4EXPEXPR: 04956 case INTRN_F4I4EXPEXPR: 04957 case INTRN_F4I8EXPEXPR: 04958 c0 = Targ_Power(c[0],c[1],folded,MTYPE_F4); 04959 break; 04960 case INTRN_F8EXPEXPR: 04961 case INTRN_F8I4EXPEXPR: 04962 case INTRN_F8I8EXPEXPR: 04963 c0 = Targ_Power(c[0],c[1],folded,MTYPE_F8); 04964 break; 04965 case INTRN_FQEXPEXPR: 04966 case INTRN_FQI4EXPEXPR: 04967 case INTRN_FQI8EXPEXPR: 04968 c0 = Targ_Power(c[0],c[1],folded,MTYPE_FQ); 04969 break; 04970 case INTRN_C4EXPEXPR: 04971 case INTRN_C4I4EXPEXPR: 04972 case INTRN_C4I8EXPEXPR: 04973 c0 = Targ_Power(c[0],c[1],folded,MTYPE_C4); 04974 break; 04975 case INTRN_C8EXPEXPR: 04976 case INTRN_C8I4EXPEXPR: 04977 case INTRN_C8I8EXPEXPR: 04978 c0 = Targ_Power(c[0],c[1],folded,MTYPE_C8); 04979 break; 04980 case INTRN_CQEXPEXPR: 04981 case INTRN_CQI4EXPEXPR: 04982 case INTRN_CQI8EXPEXPR: 04983 c0 = Targ_Power(c[0],c[1],folded,MTYPE_CQ); 04984 break; 04985 04986 04987 case INTRN_I1DIM: 04988 case INTRN_I2DIM: 04989 case INTRN_I4DIM: 04990 if (TCON_I4(c[0]) > TCON_I4(c[1])) { 04991 TCON_I4(c0) = TCON_I4(c[0]) - TCON_I4(c[1]); 04992 } else { 04993 TCON_I4(c0) = 0; 04994 } 04995 break; 04996 case INTRN_I8DIM: 04997 if (TCON_I8(c[0]) > TCON_I8(c[1])) { 04998 TCON_I8(c0) = TCON_I8(c[0]) - TCON_I8(c[1]); 04999 } else { 05000 TCON_I8(c0) = 0; 05001 } 05002 break; 05003 05004 case INTRN_I1SIGN: 05005 case INTRN_I2SIGN: 05006 case INTRN_I4SIGN: 05007 if (TCON_I4(c0) < 0) TCON_I4(c0) = -TCON_I4(c0); 05008 if (TCON_I4(c[1]) < 0) TCON_I4(c0) = -TCON_I4(c0); 05009 break; 05010 05011 case INTRN_I8SIGN: 05012 if (TCON_I8(c0) < 0) TCON_I8(c0) = -TCON_I8(c0); 05013 if (TCON_I8(c[1]) < 0) TCON_I8(c0) = -TCON_I8(c0); 05014 break; 05015 05016 case INTRN_F4SIGN: 05017 c0 = Targ_WhirlOp(OPC_F4ABS,c0,c0,folded); 05018 if (TCON_R4(c[1]) < 0) TCON_R4(c0) = -TCON_R4(c0); 05019 break; 05020 05021 case INTRN_F8SIGN: 05022 c0 = Targ_WhirlOp(OPC_F8ABS,c0,c0,folded); 05023 if (TCON_R8(c[1]) < 0) TCON_R8(c0) = -TCON_R8(c0); 05024 break; 05025 05026 case INTRN_FQSIGN: 05027 c0 = Targ_WhirlOp(OPC_FQABS,c0,c0,folded); 05028 t = Targ_WhirlOp(OPC_I4FQLT,c[1],Quad_Zero_Tcon,folded); 05029 if (TCON_I4(t)) c0 = Targ_WhirlOp(OPC_FQNEG,c0,c0,folded); 05030 break; 05031 05032 05033 case INTRN_I2F4NINT: 05034 c0 = Targ_Conv(MTYPE_I2,Targ_WhirlOp(OPC_I4F4RND,c[0],c[0],folded)); 05035 break; 05036 05037 case INTRN_I4F4NINT: 05038 c0 = Targ_WhirlOp(OPC_I4F4RND,c[0],c[0],folded); 05039 break; 05040 05041 case INTRN_I8F4NINT: 05042 c0 = Targ_WhirlOp(OPC_I8F4RND,c[0],c[0],folded); 05043 break; 05044 05045 case INTRN_I2F8IDNINT: 05046 c0 = Targ_Conv(MTYPE_I2,Targ_WhirlOp(OPC_I4F8RND,c[0],c[0],folded)); 05047 break; 05048 05049 case INTRN_I4F8IDNINT: 05050 c0 = Targ_WhirlOp(OPC_I4F8RND,c[0],c[0],folded); 05051 break; 05052 05053 case INTRN_I8F8IDNINT: 05054 c0 = Targ_WhirlOp(OPC_I8F8RND,c[0],c[0],folded); 05055 break; 05056 05057 case INTRN_I2FQIQNINT: 05058 c0 = Targ_Conv(MTYPE_I2,Targ_WhirlOp(OPC_I4FQRND,c[0],c[0],folded)); 05059 break; 05060 05061 case INTRN_I4FQIQNINT: 05062 c0 = Targ_WhirlOp(OPC_I4FQRND,c[0],c[0],folded); 05063 break; 05064 05065 case INTRN_I8FQIQNINT: 05066 c0 = Targ_WhirlOp(OPC_I8FQRND,c[0],c[0],folded); 05067 break; 05068 05069 case INTRN_I1BITS: 05070 case INTRN_I2BITS: 05071 case INTRN_I4BITS: 05072 { 05073 INT64 mask,bits,one=1; 05074 mask = (one << TCON_U4(c[2])) - 1; 05075 bits = TCON_U4(c0) >> TCON_U4(c[1]); 05076 TCON_U4(c0) = mask & bits; 05077 } 05078 break; 05079 05080 case INTRN_I8BITS: 05081 { 05082 INT64 mask,bits,one=1; 05083 mask = (one << TCON_U8(c[2])) - 1; 05084 bits = TCON_U8(c0) >> TCON_U8(c[1]); 05085 TCON_U8(c0) = mask & bits; 05086 } 05087 break; 05088 05089 case INTRN_I1BSET: 05090 case INTRN_I2BSET: 05091 case INTRN_I4BSET: 05092 TCON_I4(c0) |= (1 << TCON_I4(c[1])); 05093 break; 05094 05095 case INTRN_I8BSET: 05096 { 05097 INT64 one=1; 05098 TCON_I8(c0) |= (one << TCON_I8(c[1])); 05099 } 05100 break; 05101 05102 case INTRN_I1BCLR: 05103 case INTRN_I2BCLR: 05104 case INTRN_I4BCLR: 05105 TCON_I4(c0) &= ~(1 << TCON_I4(c[1])); 05106 break; 05107 05108 case INTRN_I8BCLR: 05109 { 05110 INT64 one=1; 05111 TCON_I8(c0) &= ~(one << TCON_I8(c[1])); 05112 } 05113 break; 05114 05115 case INTRN_I1BTEST: 05116 case INTRN_I2BTEST: 05117 case INTRN_I4BTEST: 05118 { 05119 INT32 test; 05120 test = TCON_I4(c0) & (1<<TCON_I4(c[1])); 05121 TCON_I4(c0) = (test != 0); TCON_v1(c0) = 0; 05122 TCON_ty(c0) = LOGICAL_MTYPE; 05123 } 05124 break; 05125 05126 case INTRN_I8BTEST: 05127 { 05128 INT64 test,one=1; 05129 test = TCON_I8(c0) & (one<<TCON_I8(c[1])); 05130 TCON_I4(c0) = (test != 0); TCON_v1(c0) = 0; 05131 TCON_ty(c0) = LOGICAL_MTYPE; 05132 } 05133 break; 05134 05135 case INTRN_I1SHL: 05136 TCON_I4(c0) = (TCON_I4(c0) << TCON_I4(c[1]))&0xff; 05137 break; 05138 05139 case INTRN_I2SHL: 05140 TCON_I4(c0) = (TCON_I4(c0) << TCON_I4(c[1]))&0xffff; 05141 break; 05142 05143 case INTRN_I1SHFT: 05144 if (TCON_I4(c[1]) >= 0) { 05145 TCON_I4(c0) <<= TCON_I4(c[1]); 05146 } else { 05147 TCON_U4(c0) >>= (-TCON_I4(c[1])); 05148 } 05149 TCON_U4(c0) &= 0xff; 05150 break; 05151 05152 case INTRN_I2SHFT: 05153 if (TCON_I4(c[1]) >= 0) { 05154 TCON_I4(c0) <<= TCON_I4(c[1]); 05155 } else { 05156 TCON_U4(c0) >>= (-TCON_I4(c[1])); 05157 } 05158 TCON_U4(c0) &= 0xffff; 05159 break; 05160 05161 case INTRN_I4SHFT: 05162 if (TCON_I4(c[1]) >= 0) { 05163 TCON_I4(c0) <<= TCON_I4(c[1]); 05164 } else { 05165 TCON_U4(c0) >>= (-TCON_I4(c[1])); 05166 } 05167 break; 05168 05169 case INTRN_I8SHFT: 05170 if (TCON_I8(c[1]) >= 0) { 05171 TCON_I8(c0) <<= TCON_I8(c[1]); 05172 } else { 05173 TCON_U8(c0) >>= (-TCON_I8(c[1])); 05174 } 05175 break; 05176 05177 case INTRN_I1SHFTC: 05178 case INTRN_I2SHFTC: 05179 case INTRN_I4SHFTC: 05180 { 05181 UINT32 mask,size,t,sl,sr; 05182 size = TCON_I4(c[2]); 05183 if (size == 32) { 05184 mask = (UINT32)-1; 05185 } else { 05186 mask = (1U << size) - 1; 05187 } 05188 if (TCON_I4(c[1]) >= 0) { 05189 sl = TCON_I4(c[1]); 05190 } else { 05191 sl = size + TCON_I4(c[1]); 05192 } 05193 sr = size - sl; 05194 t = TCON_I4(c0) & mask; 05195 t = ((t >> sl) | (t << sr)) & mask; 05196 TCON_I4(c0) = t | (TCON_I4(c0) & (~mask)); 05197 } 05198 break; 05199 05200 05201 case INTRN_I8SHFTC: 05202 { 05203 UINT64 mask,size,t,sl,sr; 05204 size = TCON_I8(c[2]); 05205 if (size==64) { 05206 mask = (UINT64)-1; 05207 } else { 05208 mask = (1ULL << size) - 1; 05209 } 05210 if (TCON_I8(c[1]) >= 0) { 05211 sl = TCON_I8(c[1]); 05212 } else { 05213 sl = size + TCON_I8(c[1]); 05214 } 05215 sr = size - sl; 05216 t = TCON_I8(c0) & mask; 05217 t = ((t >> sl) | (t << sr)) & mask; 05218 TCON_I8(c0) = t | (TCON_I8(c0) & (~mask)); 05219 } 05220 break; 05221 05222 case INTRN_I8DIVFLOOR: 05223 if (TCON_I8(c[1]) == 0) { 05224 *folded = FALSE; 05225 } else { 05226 INT64 q,sign; 05227 q = TCON_I8(c[0]) / TCON_I8(c[1]); 05228 sign = TCON_I8(c[0]) ^ TCON_I8(c[1]); 05229 if (sign < 0 && q*TCON_I8(c[1]) != TCON_I8(c[0])) { 05230 q -= 1; 05231 } 05232 TCON_I8(c0) = q; 05233 } 05234 break; 05235 05236 case INTRN_I4DIVFLOOR: 05237 if (TCON_I4(c[1]) == 0) { 05238 *folded = FALSE; 05239 } else { 05240 INT32 q,sign; 05241 q = TCON_I4(c[0]) / TCON_I4(c[1]); 05242 sign = TCON_I4(c[0]) ^ TCON_I4(c[1]); 05243 if (sign < 0 && q*TCON_I4(c[1]) != TCON_I4(c[0])) { 05244 q -= 1; 05245 } 05246 TCON_I4(c0) = q; 05247 } 05248 break; 05249 05250 case INTRN_U8DIVFLOOR: 05251 if (TCON_U8(c[1]) == 0) { 05252 *folded = FALSE; 05253 } else { 05254 TCON_U8(c0) = TCON_U8(c[0]) / TCON_U8(c[1]); 05255 } 05256 break; 05257 05258 case INTRN_U4DIVFLOOR: 05259 if (TCON_U4(c[1]) == 0) { 05260 *folded = FALSE; 05261 } else { 05262 TCON_U4(c0) = TCON_U4(c[0]) / TCON_U4(c[1]); 05263 } 05264 break; 05265 05266 case INTRN_I8DIVCEIL: 05267 if (TCON_I8(c[1]) == 0) { 05268 *folded = FALSE; 05269 } else { 05270 INT64 q,sign; 05271 q = TCON_I8(c[0]) / TCON_I8(c[1]); 05272 sign = TCON_I8(c[0]) ^ TCON_I8(c[1]); 05273 if (sign >= 0 && q*TCON_I8(c[1]) != TCON_I8(c[0])) { 05274 q += 1; 05275 } 05276 TCON_I8(c0) = q; 05277 } 05278 break; 05279 05280 case INTRN_I4DIVCEIL: 05281 if (TCON_I4(c[1]) == 0) { 05282 *folded = FALSE; 05283 } else { 05284 INT32 q,sign; 05285 q = TCON_I4(c[0]) / TCON_I4(c[1]); 05286 sign = TCON_I4(c[0]) ^ TCON_I4(c[1]); 05287 if (sign >= 0 && q*TCON_I4(c[1]) != TCON_I4(c[0])) { 05288 q += 1; 05289 } 05290 TCON_I4(c0) = q; 05291 } 05292 break; 05293 05294 case INTRN_U8DIVCEIL: 05295 if (TCON_U8(c[1]) == 0) { 05296 *folded = FALSE; 05297 } else { 05298 UINT64 q; 05299 q = TCON_U8(c[0]) / TCON_U8(c[1]); 05300 if (q*TCON_U8(c[1]) != TCON_U8(c[0])) { 05301 q += 1; 05302 } 05303 TCON_U8(c0) = q; 05304 } 05305 break; 05306 05307 case INTRN_U4DIVCEIL: 05308 if (TCON_U4(c[1]) == 0) { 05309 *folded = FALSE; 05310 } else { 05311 UINT32 q; 05312 q = TCON_U4(c[0]) / TCON_U4(c[1]); 05313 if (q*TCON_U4(c[1]) != TCON_U4(c[0])) { 05314 q += 1; 05315 } 05316 TCON_U4(c0) = q; 05317 } 05318 break; 05319 05320 05321 case INTRN_F4DIM: 05322 if (TCON_R4(c[0]) > TCON_R4(c[1])) { 05323 TCON_R4(c0) = TCON_R4(c[0]) - TCON_R4(c[1]); 05324 } else { 05325 TCON_R4(c0) = 0.0; 05326 } 05327 break; 05328 05329 case INTRN_F8DIM: 05330 if (TCON_R8(c[0]) > TCON_R8(c[1])) { 05331 TCON_R8(c0) = TCON_R8(c[0]) - TCON_R8(c[1]); 05332 } else { 05333 TCON_R8(c0) = 0.0; 05334 } 05335 break; 05336 05337 case INTRN_FQDIM: 05338 c0 = Targ_WhirlOp(OPC_FQSUB,c0,c[1],folded); 05339 t = Targ_WhirlOp(OPC_I4FQLT,c0,Quad_Zero_Tcon,folded); 05340 if (TCON_I4(t)) c0 = Quad_Zero_Tcon; 05341 break; 05342 05343 05344 case INTRN_F4AINT: 05345 t = Targ_WhirlOp(OPC_F4ABS,c[0],c[0],folded); 05346 if ((INT32) TCON_R4(t) < (1<<30)) { 05347 TCON_R4(c0) = (INT32) TCON_R4(c0); 05348 } 05349 break; 05350 05351 case INTRN_F8AINT: 05352 t = Targ_WhirlOp(OPC_F8ABS,c[0],c[0],folded); 05353 if ((INT64) TCON_R8(t) < (1LL << 62)) { 05354 TCON_R8(c0) = (INT64) TCON_R8(c0); 05355 } 05356 break; 05357 05358 case INTRN_F4ANINT: 05359 if (TCON_R4(c0) < 0) { 05360 TCON_R4(c0) -= 0.5; 05361 } else { 05362 TCON_R4(c0) += 0.5; 05363 } 05364 c0 = Targ_IntrinsicOp(INTRN_F4AINT,&c0,folded); 05365 break; 05366 case INTRN_F8ANINT: 05367 if (TCON_R8(c0) < 0) { 05368 TCON_R8(c0) -= 0.5; 05369 } else { 05370 TCON_R8(c0) += 0.5; 05371 } 05372 c0 = Targ_IntrinsicOp(INTRN_F8AINT,&c0,folded); 05373 break; 05374 05375 case INTRN_F4EXP: 05376 TCON_R4(c0) = expf(TCON_R4(c0)); 05377 break; 05378 case INTRN_F8EXP: 05379 TCON_R8(c0) = exp(TCON_R8(c0)); 05380 break; 05381 05382 case INTRN_F4LOG: 05383 TCON_R4(c0) = logf(TCON_R4(c0)); 05384 break; 05385 case INTRN_F8LOG: 05386 TCON_R8(c0) = log(TCON_R8(c0)); 05387 break; 05388 05389 case INTRN_F4LOG10: 05390 TCON_R4(c0) = log10f(TCON_R4(c0)); 05391 break; 05392 case INTRN_F8LOG10: 05393 TCON_R8(c0) = log10(TCON_R8(c0)); 05394 break; 05395 05396 case INTRN_F4COS: 05397 TCON_R4(c0) = cosf(TCON_R4(c0)); 05398 break; 05399 case INTRN_F8COS: 05400 TCON_R8(c0) = cos(TCON_R8(c0)); 05401 break; 05402 05403 case INTRN_F4SIN: 05404 TCON_R4(c0) = sinf(TCON_R4(c0)); 05405 break; 05406 case INTRN_F8SIN: 05407 TCON_R8(c0) = sin(TCON_R8(c0)); 05408 break; 05409 05410 case INTRN_F4TAN: 05411 TCON_R4(c0) = tanf(TCON_R4(c0)); 05412 break; 05413 case INTRN_F8TAN: 05414 TCON_R8(c0) = tan(TCON_R8(c0)); 05415 break; 05416 05417 case INTRN_F4COSD: 05418 TCON_R4(c0) = cosf(DEG_TO_RAD*TCON_R4(c0)); 05419 break; 05420 case INTRN_F8COSD: 05421 TCON_R8(c0) = cos(DEG_TO_RAD*TCON_R8(c0)); 05422 break; 05423 05424 case INTRN_F4SIND: 05425 TCON_R4(c0) = sinf(DEG_TO_RAD*TCON_R4(c0)); 05426 break; 05427 case INTRN_F8SIND: 05428 TCON_R8(c0) = sin(DEG_TO_RAD*TCON_R8(c0)); 05429 break; 05430 05431 case INTRN_F4TAND: 05432 TCON_R4(c0) = tanf(DEG_TO_RAD*TCON_R4(c0)); 05433 break; 05434 case INTRN_F8TAND: 05435 TCON_R8(c0) = tan(DEG_TO_RAD*TCON_R8(c0)); 05436 break; 05437 05438 05439 case INTRN_F4ACOS: 05440 TCON_R4(c0) = acosf(TCON_R4(c0)); 05441 break; 05442 case INTRN_F8ACOS: 05443 TCON_R8(c0) = acos(TCON_R8(c0)); 05444 break; 05445 05446 case INTRN_F4ASIN: 05447 TCON_R4(c0) = asinf(TCON_R4(c0)); 05448 break; 05449 case INTRN_F8ASIN: 05450 TCON_R8(c0) = asin(TCON_R8(c0)); 05451 break; 05452 05453 case INTRN_F4ATAN: 05454 TCON_R4(c0) = atanf(TCON_R4(c0)); 05455 break; 05456 case INTRN_F8ATAN: 05457 TCON_R8(c0) = atan(TCON_R8(c0)); 05458 break; 05459 05460 case INTRN_F4ACOSD: 05461 TCON_R4(c0) = RAD_TO_DEG*acosf(TCON_R4(c0)); 05462 break; 05463 case INTRN_F8ACOSD: 05464 TCON_R8(c0) = RAD_TO_DEG*acos(TCON_R8(c0)); 05465 break; 05466 05467 case INTRN_F4ASIND: 05468 TCON_R4(c0) = RAD_TO_DEG*asinf(TCON_R4(c0)); 05469 break; 05470 case INTRN_F8ASIND: 05471 TCON_R8(c0) = RAD_TO_DEG*asin(TCON_R8(c0)); 05472 break; 05473 05474 case INTRN_F4ATAND: 05475 TCON_R4(c0) = RAD_TO_DEG*atanf(TCON_R4(c0)); 05476 break; 05477 case INTRN_F8ATAND: 05478 TCON_R8(c0) = RAD_TO_DEG*atan(TCON_R8(c0)); 05479 break; 05480 05481 case INTRN_F4COSH: 05482 TCON_R4(c0) = coshf(TCON_R4(c0)); 05483 break; 05484 case INTRN_F8COSH: 05485 TCON_R8(c0) = cosh(TCON_R8(c0)); 05486 break; 05487 05488 case INTRN_F4SINH: 05489 TCON_R4(c0) = sinhf(TCON_R4(c0)); 05490 break; 05491 case INTRN_F8SINH: 05492 TCON_R8(c0) = sinh(TCON_R8(c0)); 05493 break; 05494 05495 case INTRN_F4TANH: 05496 TCON_R4(c0) = tanhf(TCON_R4(c0)); 05497 break; 05498 case INTRN_F8TANH: 05499 TCON_R8(c0) = tanh(TCON_R8(c0)); 05500 break; 05501 05502 case INTRN_F4ATAN2: 05503 TCON_R4(c0) = atan2f(TCON_R4(c0),TCON_R4(c[1])); 05504 break; 05505 case INTRN_F8ATAN2: 05506 TCON_R8(c0) = atan2(TCON_R8(c0),TCON_R8(c[1])); 05507 break; 05508 05509 case INTRN_F4ATAN2D: 05510 TCON_R4(c0) = RAD_TO_DEG*atan2f(TCON_R4(c0),TCON_R4(c[1])); 05511 break; 05512 case INTRN_F8ATAN2D: 05513 TCON_R8(c0) = RAD_TO_DEG*atan2(TCON_R8(c0),TCON_R8(c[1])); 05514 break; 05515 05516 case INTRN_F4CIS: 05517 TCON_ty(c0) = MTYPE_C4; 05518 TCON_R4(c0) = cosf(TCON_R4(c[0])); 05519 TCON_IR4(c0) = sinf(TCON_R4(c[0])); 05520 break; 05521 05522 case INTRN_F8CIS: 05523 TCON_ty(c0) = MTYPE_C8; 05524 TCON_R8(c0) = cos(TCON_R8(c[0])); 05525 TCON_IR8(c0) = sin(TCON_R8(c[0])); 05526 break; 05527 05528 #ifdef QUAD_PRECISION_SUPPORTED 05529 /* Warning: we use native long doubles in here */ 05530 05531 case INTRN_FQEXP: 05532 TCON_R16(c0) = RLD_To_R16(expl(R16_To_RLD(TCON_R16(c0)))); 05533 break; 05534 case INTRN_FQLOG: 05535 TCON_R16(c0) = RLD_To_R16(logl(R16_To_RLD(TCON_R16(c0)))); 05536 break; 05537 case INTRN_FQLOG10: 05538 TCON_R16(c0) = RLD_To_R16(log10l(R16_To_RLD(TCON_R16(c0)))); 05539 break; 05540 case INTRN_FQCOS: 05541 TCON_R16(c0) = RLD_To_R16(cosl(R16_To_RLD(TCON_R16(c0)))); 05542 break; 05543 case INTRN_FQSIN: 05544 TCON_R16(c0) = RLD_To_R16(sinl(R16_To_RLD(TCON_R16(c0)))); 05545 break; 05546 case INTRN_FQTAN: 05547 TCON_R16(c0) = RLD_To_R16(tanl(R16_To_RLD(TCON_R16(c0)))); 05548 break; 05549 case INTRN_FQCOSD: 05550 TCON_R16(c0) = RLD_To_R16(cosl(DEG_TO_RADQ*R16_To_RLD(TCON_R16(c0)))); 05551 break; 05552 case INTRN_FQSIND: 05553 TCON_R16(c0) = RLD_To_R16(sinl(DEG_TO_RADQ*R16_To_RLD(TCON_R16(c0)))); 05554 break; 05555 case INTRN_FQTAND: 05556 TCON_R16(c0) = RLD_To_R16(tanl(DEG_TO_RADQ*R16_To_RLD(TCON_R16(c0)))); 05557 break; 05558 case INTRN_FQCOSH: 05559 TCON_R16(c0) = RLD_To_R16(coshl(R16_To_RLD(TCON_R16(c0)))); 05560 break; 05561 case INTRN_FQSINH: 05562 TCON_R16(c0) = RLD_To_R16(sinhl(R16_To_RLD(TCON_R16(c0)))); 05563 break; 05564 case INTRN_FQTANH: 05565 TCON_R16(c0) = RLD_To_R16(tanhl(R16_To_RLD(TCON_R16(c0)))); 05566 break; 05567 case INTRN_FQACOS: 05568 TCON_R16(c0) = RLD_To_R16(acosl(R16_To_RLD(TCON_R16(c0)))); 05569 break; 05570 case INTRN_FQASIN: 05571 TCON_R16(c0) = RLD_To_R16(asinl(R16_To_RLD(TCON_R16(c0)))); 05572 break; 05573 case INTRN_FQATAN: 05574 TCON_R16(c0) = RLD_To_R16(atanl(R16_To_RLD(TCON_R16(c0)))); 05575 break; 05576 case INTRN_FQACOSD: 05577 TCON_R16(c0) = RLD_To_R16(RAD_TO_DEGQ*acosl(R16_To_RLD(TCON_R16(c0)))); 05578 break; 05579 case INTRN_FQASIND: 05580 TCON_R16(c0) = RLD_To_R16(RAD_TO_DEGQ*asinl(R16_To_RLD(TCON_R16(c0)))); 05581 break; 05582 case INTRN_FQATAND: 05583 TCON_R16(c0) = RLD_To_R16(RAD_TO_DEGQ*atanl(R16_To_RLD(TCON_R16(c0)))); 05584 break; 05585 case INTRN_FQATAN2: 05586 TCON_R16(c0) = RLD_To_R16(atan2l(R16_To_RLD(TCON_R16(c0)),R16_To_RLD(TCON_R16(c[1])))); 05587 break; 05588 case INTRN_FQATAN2D: 05589 TCON_R16(c0) = RLD_To_R16(RAD_TO_DEGQ*atan2l(R16_To_RLD(TCON_R16(c0)),R16_To_RLD(TCON_R16(c[1])))); 05590 break; 05591 05592 case INTRN_FQCIS: 05593 TCON_ty(c0) = MTYPE_CQ; 05594 TCON_R16(c0) = RLD_To_R16(cosl(R16_To_RLD(TCON_R16(c[0])))); 05595 TCON_IR16(c0) = RLD_To_R16(sinl(R16_To_RLD(TCON_R16(c[0])))); 05596 break; 05597 05598 case INTRN_FQAINT: 05599 TCON_R16(c0) = RLD_To_R16(truncl(R16_To_RLD(TCON_R16(c0)))); 05600 break; 05601 05602 case INTRN_FQANINT: 05603 if (R16_To_RLD(TCON_R16(c0)) < 0) { 05604 TCON_R16(c0) = RLD_To_R16(truncl(R16_To_RLD(TCON_R16(c0))-0.5l)); 05605 } else { 05606 TCON_R16(c0) = RLD_To_R16(truncl(R16_To_RLD(TCON_R16(c0))+0.5l)); 05607 } 05608 break; 05609 05610 /* These aren't done because we will catch them when lowering */ 05611 case INTRN_C4COS: 05612 case INTRN_C8COS: 05613 case INTRN_C4SIN: 05614 case INTRN_C8SIN: 05615 case INTRN_C4EXP: 05616 case INTRN_C8EXP: 05617 case INTRN_C4LOG: 05618 case INTRN_C8LOG: 05619 case INTRN_CQEXP: 05620 case INTRN_CQLOG: 05621 case INTRN_CQCOS: 05622 case INTRN_CQSIN: 05623 case INTRN_F8F4PROD: 05624 case INTRN_FQF8PROD: 05625 *folded = FALSE; 05626 break; 05627 05628 #else /* No quad support in library */ 05629 /* These aren't done because we don't have a convenient library yet */ 05630 case INTRN_FQAINT: 05631 case INTRN_FQANINT: 05632 case INTRN_FQEXP: 05633 case INTRN_FQLOG: 05634 case INTRN_FQLOG10: 05635 case INTRN_FQCOS: 05636 case INTRN_FQSIN: 05637 case INTRN_FQCIS: 05638 case INTRN_FQTAN: 05639 case INTRN_FQCOSD: 05640 case INTRN_FQSIND: 05641 case INTRN_FQTAND: 05642 case INTRN_FQCOSH: 05643 case INTRN_FQSINH: 05644 case INTRN_FQTANH: 05645 case INTRN_FQACOS: 05646 case INTRN_FQASIN: 05647 case INTRN_FQATAN: 05648 case INTRN_FQACOSD: 05649 case INTRN_FQASIND: 05650 case INTRN_FQATAND: 05651 case INTRN_FQATAN2: 05652 case INTRN_FQATAN2D: 05653 05654 /* These aren't done because we will catch them when lowering */ 05655 case INTRN_C4COS: 05656 case INTRN_C8COS: 05657 case INTRN_C4SIN: 05658 case INTRN_C8SIN: 05659 case INTRN_C4EXP: 05660 case INTRN_C8EXP: 05661 case INTRN_C4LOG: 05662 case INTRN_C8LOG: 05663 case INTRN_CQEXP: 05664 case INTRN_CQLOG: 05665 case INTRN_CQCOS: 05666 case INTRN_CQSIN: 05667 case INTRN_F8F4PROD: 05668 case INTRN_FQF8PROD: 05669 *folded = FALSE; 05670 break; 05671 #endif 05672 05673 case INTRN_I1POPCNT: 05674 case INTRN_I2POPCNT: 05675 case INTRN_I4POPCNT: 05676 case INTRN_I8POPCNT: 05677 { 05678 INT64 count; 05679 INT i,numbits; 05680 INT64 val; 05681 switch (intrinsic) { 05682 case INTRN_I1POPCNT: 05683 numbits = 8; 05684 val = TCON_I4(c0); 05685 break; 05686 case INTRN_I2POPCNT: 05687 numbits = 16; 05688 val = TCON_I4(c0); 05689 break; 05690 case INTRN_I4POPCNT: 05691 numbits = 32; 05692 val = TCON_I4(c0); 05693 break; 05694 case INTRN_I8POPCNT: 05695 numbits = 64; 05696 val = TCON_I8(c0); 05697 break; 05698 } 05699 count = 0; 05700 for (i = 0; i < numbits; i++) { 05701 count += (val & 1); 05702 val >>= 1; 05703 } 05704 TCON_I4(c0) = count; 05705 TCON_ty(c0) = MTYPE_I4; 05706 } 05707 break; 05708 05709 case INTRN_I1LEADZ: 05710 case INTRN_I2LEADZ: 05711 case INTRN_I4LEADZ: 05712 case INTRN_I8LEADZ: 05713 { 05714 INT64 count; 05715 INT i,numbits; 05716 INT64 val; 05717 switch (intrinsic) { 05718 case INTRN_I1LEADZ: 05719 numbits = 8; 05720 val = TCON_I4(c0); 05721 val <<= 56; 05722 break; 05723 case INTRN_I2LEADZ: 05724 numbits = 16; 05725 val = TCON_I4(c0); 05726 val <<= 48; 05727 break; 05728 case INTRN_I4LEADZ: 05729 numbits = 32; 05730 val = TCON_I4(c0); 05731 val <<= 32; 05732 break; 05733 case INTRN_I8LEADZ: 05734 numbits = 64; 05735 val = TCON_I8(c0); 05736 break; 05737 } 05738 count = 0; 05739 for (i = 0; i < numbits; i++) { 05740 if (val >= 0) { 05741 ++count; 05742 val <<= 1; 05743 } else { 05744 break; 05745 } 05746 } 05747 TCON_I4(c0) = count; 05748 TCON_ty(c0) = MTYPE_I4; 05749 } 05750 break; 05751 05752 default: 05753 *folded = FALSE; 05754 break; 05755 } 05756 return (c0); 05757 } 05758