nsz Git - libfirm/blob - ir/tv/tv.c

   1 /* TV --- Target Values, aka Constant Table.
   2    Copyright (C) 1995, 1996 Christian von Roques */
   3
   4 /* $Id$ */
   5
   6 /* This implementation assumes:
   7    * target characters/strings can be represented as type `char'/`char *',
   8    * host's type `long'/`unsigned long' can hold values of mode `l'/`L',
   9    * both host and target have two's complement integral arithmetic,
  10      host's C operators `/' and `%' match target's div and mod.
  11      target_max_<mode> == (1<<k)-1 for some k>0
  12      target_min_<mode> == -target_max_<mode>-1
  13      target_max_<Mode> == target_max_<mode>-target_min_<mode>
  14    * both host and target have IEEE-754 floating-point arithmetic.  */
  15
  16 /* !!! float and double divides MUST NOT SIGNAL !!! */
  17 /* @@@ query the floating-point expception status flags */
  18
  19 /* @@@ ToDo: tarval_convert_to is not fully implemented! */
  20 /* @@@ Problem: All Values are stored twice, once as Univ_*s and a 2nd
  21    time in their real target mode. :-( */
  22 /* @@@ Perhaps use a set instead of a pset: new tarvals allocated on
  23    stack, copied into set by tarval_identify() if really new.  If
  24    tarval_identify() discards often enough, the extra copy for kept
  25    values is cheaper than the extra obstack_alloc()/free() for
  26    discarded ones.  */
  27
  28 #ifdef HAVE_CONFIG_H
  29 # include <config.h>
  30 #endif
  31
  32 # include "xprintf.h"
  33 #include <assert.h>
  34 #include <limits.h>
  35 #include <errno.h>
  36 #include <math.h>
  37 #include <stdlib.h>
  38 #include <string.h>
  39 #include <ctype.h>
  40
  41 #include "pset.h"
  42 #define TOBSTACK_ID "tv"
  43 #include "obst.h"
  44 #include "ieee754.h"
  45 #include "tune.h"
  46 #include "xp_help.h"
  47 #include "tv_t.h"
  48 #include "entity_t.h"
  49 #include "ident_t.h"
  50 #include "irmode.h"
  51 #include "irnode.h"
  52
  53 static struct obstack tv_obst;  /* obstack for all the target values */
  54 static pset *tarvals;           /* pset containing pointers to _all_ tarvals */
  55
  56 /* currently building an object with tarval_start() & friends ? */
  57 #define BUILDING obstack_object_size (&tv_obst)
  58
  59 /* bcopy is not ISO C */
  60 #define bcopy(X, Y, Z) memcpy((Y), (X), (Z))
  61
  62
  63 /* special tarvals: */
  64 tarval *tarval_bad;
  65 tarval *tarval_b_false;
  66 tarval *tarval_b_true;
  67 tarval *tarval_D_NaN;
  68 tarval *tarval_D_Inf;
  69 tarval *tarval_P_void;
  70 tarval *tarval_mode_null[irm_max];
  71 tarval *tarval_mode_min[irm_max];
  72 tarval *tarval_mode_max[irm_max];
  73
  74 tarval *get_tarval_bad      ()              { return tarval_bad;     }
  75 tarval *get_tarval_b_false  ()              { return tarval_b_false; }
  76 tarval *get_tarval_b_true   ()              { return tarval_b_true;  }
  77 tarval *get_tarval_D_NaN    ()              { return tarval_D_NaN;   }
  78 tarval *get_tarval_D_Inf    ()              { return tarval_D_Inf;   }
  79 tarval *get_tarval_P_void   ()              { return tarval_P_void;  }
  80 tarval *get_tarval_mode_null(ir_mode *mode)
  81   { return tarval_mode_null[get_mode_modecode(mode)]; }
  82 tarval *get_tarval_mode_min (ir_mode *mode)
  83   { return tarval_mode_min[get_mode_modecode(mode)];  }
  84 tarval *get_tarval_mode_max (ir_mode *mode)
  85   { return tarval_mode_max[get_mode_modecode(mode)];  }
  86
  87 # if 0
  88 /* @@@ depends on order of ir_mode */
  89 static tarval_sInt min_sInt[8] = {
  90   TARGET_SIMIN (c), 0,
  91   TARGET_SIMIN (h), 0,
  92   TARGET_SIMIN (i), 0,
  93   TARGET_SIMIN (l), 0
  94 };
  95 static tarval_sInt max_sInt[8] = {
  96   TARGET_SIMAX (c), TARGET_UIMAX (C),
  97   TARGET_SIMAX (h), TARGET_UIMAX (H),
  98   TARGET_SIMAX (i), TARGET_UIMAX (I),
  99   TARGET_SIMAX (l), TARGET_UIMAX (L)
 100 };
 101 # endif
 102
 103 /* Used to be in irmode.h, replaced now. */
 104 # define is_Int(m) ((m) <= irm_Lu && (m) >= irm_Bs) /* old */
 105
 106 /* return a mode-specific value */
 107
 108 tarval_F
 109 tv_val_F (tarval *tv)
 110 {
 111   return tv->u.F;
 112 }
 113
 114 tarval_D
 115 tv_val_D (tarval *tv)
 116 {
 117   return tv->u.D;
 118 }
 119
 120 tarval_E
 121 tv_val_E (tarval *tv)
 122 {
 123   return tv->u.E;
 124 }
 125
 126 tarval_sInt
 127 tv_val_sInt (tarval *tv)
 128 {
 129   return tv->u.sInt;
 130 }
 131
 132 tarval_uInt
 133 tv_val_uInt (tarval *tv)
 134 {
 135   return tv->u.uInt;
 136 }
 137
 138 tarval_P
 139 tv_val_P (tarval *tv)
 140 {
 141   return tv->u.P;
 142 }
 143
 144 bool
 145 tv_val_b (tarval *tv)
 146 {
 147   return tv->u.b;
 148 }
 149
 150
 151 /* Overflows `sInt' signed integral `mode'?  */
 152 static INLINE bool
 153 sInt_overflow (tarval_sInt sInt, ir_mode *mode)
 154 {
 155   assert (is_Int(get_mode_modecode(mode)));
 156   return (get_mode_min(mode) && get_mode_max(mode)  /* only valid after firm initialization */
 157           && (sInt < tv_val_sInt (get_mode_min(mode))
 158               || tv_val_sInt (get_mode_max(mode)) < sInt));
 159 }
 160
 161
 162 /* Overflows `uInt' unsigned integral `mode'?  */
 163 static INLINE bool
 164 uInt_overflow (tarval_uInt uInt, ir_mode *mode)
 165 {
 166   assert (is_Int(get_mode_modecode(mode)));
 167   return (get_mode_max(mode)   /* only valid after firm initialization */
 168           && tv_val_uInt (get_mode_max(mode)) < uInt);
 169 }
 170
 171
 172 #ifndef NDEBUG
 173 void
 174 _tarval_vrfy (const tarval *val)
 175 {
 176   assert (val);
 177   switch (get_mode_modecode(val->mode)) {
 178     /* floating */
 179   case irm_F:
 180   case irm_D:
 181   case irm_E:
 182     break;
 183     /* integral */
 184   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu: {
 185     //    printf("Tarval is %lu\n", val->u.uInt);
 186     assert (!uInt_overflow (val->u.uInt, val->mode));
 187     } break;
 188   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 189     assert (!sInt_overflow (val->u.sInt, val->mode)); break;
 190   case irm_C:
 191   case irm_U:
 192     break;
 193   case irm_P:
 194     if (val->u.P.ent) {
 195       assert (val->u.P.ent->kind == k_entity);
 196     }
 197     assert (   val->u.P.xname || val->u.P.ent
 198             || !tarval_P_void || (val == tarval_P_void));
 199     break;
 200   case irm_b:
 201     assert ((unsigned)val->u.b <= 1); break;
 202   default:
 203     assert (val->mode == mode_T);
 204     break;
 205   }
 206 }
 207 #endif
 208
 209
 210 #ifdef STATS
 211
 212 static void
 213 tarval_stats (void)
 214 {
 215   pset_stats (tarvals);
 216 }
 217
 218 #endif
 219
 220
 221 /* Return the canonical tarval * for tv.
 222    May destroy everything allocated on tv_obst after tv!  */
 223 static tarval *
 224 tarval_identify (tarval *tv)
 225 {
 226   tarval *o;
 227
 228   o = pset_insert (tarvals, tv, tarval_hash (tv));
 229
 230   if (o != tv) {
 231     obstack_free (&tv_obst, (void *)tv);
 232   }
 233
 234   TARVAL_VRFY (o);
 235   return o;
 236 }
 237
 238
 239 /* Return 0 iff a equals b.  Bitwise identical NaNs compare equal.  */
 240 static int
 241 tarval_cmp (const void *p, const void *q)
 242 {
 243   const tarval *a = p;
 244   const tarval *b = q;
 245
 246   TARVAL_VRFY (a);
 247   TARVAL_VRFY (b);
 248
 249   if (a == b) return 0;
 250   if ((char *)a->mode - (char *)b->mode)
 251     return (char *)a->mode - (char *)b->mode;
 252
 253   switch (get_mode_modecode(a->mode)) {
 254     /* floating */
 255   case irm_F:
 256     return memcmp (&a->u.F, &b->u.F, sizeof (a->u.F));
 257   case irm_D:
 258     return memcmp (&a->u.D, &b->u.D, sizeof (a->u.D));
 259   case irm_E:
 260     return memcmp (&a->u.E, &b->u.E, sizeof (a->u.E));
 261     /* unsigned */
 262   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 263     if (sizeof (int) == sizeof (tarval_uInt)) {
 264       return a->u.uInt - b->u.uInt;
 265     }
 266     return a->u.uInt != b->u.uInt;
 267     /* signed */
 268   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 269     if (sizeof (int) == sizeof (tarval_sInt)) {
 270       return a->u.sInt - b->u.sInt;
 271     }
 272     return a->u.sInt != b->u.sInt;
 273   case irm_C:
 274     return a->u.C - b->u.C;
 275   case irm_U:
 276     return a->u.U - b->u.U;
 277   case irm_P:
 278     if (a->u.P.ent || b->u.P.ent)
 279       return (char *)a->u.P.ent - (char *)b->u.P.ent;
 280     if (a->u.P.xname && b->u.P.xname)
 281       return strcmp (a->u.P.xname, b->u.P.xname);
 282     return a->u.P.xname - b->u.P.xname;
 283   case irm_b:
 284     return a->u.b - b->u.b;
 285   default: assert (0);
 286   }
 287 }
 288
 289
 290 unsigned
 291 tarval_hash (tarval *tv)
 292 {
 293   unsigned h;
 294
 295   h = get_mode_modecode(tv->mode) * 0x421u;
 296   switch (get_mode_modecode(tv->mode)) {
 297   case irm_T:
 298     h = 0x94b527ce; break;
 299   case irm_F:
 300     /* quick & dirty */
 301     { union { float f; unsigned u; } u;
 302       assert (sizeof (float) <= sizeof (unsigned));
 303       u.u = 0; u.f = tv->u.F;
 304       h ^= u.u;
 305       break;
 306     }
 307   case irm_D:
 308     /* quick & dirty */
 309     { union { double d; unsigned u[2]; } u;
 310       assert (sizeof (double) <= 2*sizeof (unsigned));
 311       u.u[0] = u.u[1] = 0; u.d = tv->u.D;
 312       h ^= u.u[0] ^ u.u[1];
 313       break;
 314     }
 315   case irm_E:
 316     { union { long double e; unsigned u[3]; } u;
 317       assert (sizeof (long double) <= 3*sizeof (unsigned));
 318       u.u[0] = u.u[1] = u.u[2] = 0; u.e = tv->u.E;
 319       h ^= u.u[0] ^ u.u[1] ^ u.u[2];
 320       break;
 321     }
 322   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 323     h ^= tv->u.uInt; break;
 324   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 325     h ^= tv->u.sInt; break;
 326   case irm_C:
 327     h ^= tv->u.C; break;
 328   case irm_U:
 329     h ^= tv->u.U; break;
 330   case irm_P:
 331     if (tv->u.P.ent) {
 332       /* @@@ lower bits not random, watch for collisions; perhaps
 333          replace by tv->u.p.ent - (entity *)0 */
 334       h ^= ((char *)tv->u.P.ent - (char *)0) / 64;
 335     } else if (tv->u.P.xname) {
 336       /* Of course, strlen() in a hash function is a mistake, but this
 337          case should be really rare.  */
 338       h ^= ID_HASH (tv->u.P.xname, strlen (tv->u.P.xname));
 339     } else {                    /* void */
 340       h^= 0x2b592b88;
 341     }
 342     break;
 343   case irm_b:
 344     h ^= tv->u.b; break;
 345   default:
 346     assert(0);
 347   }
 348   return h;
 349 }
 350
 351
 352 /*** ***************** Initialization ************************************* ***/
 353
 354 void
 355 tarval_init_1 (void)
 356 {
 357   obstack_init (&tv_obst);
 358   obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1;
 359   assert (IS_POW2 (ALIGNOF (tarval)));
 360
 361   /* initialize the target value table */
 362   tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS);
 363 }
 364
 365 void
 366 tarval_init_2 (void)
 367 {
 368   tarval *tv;
 369   union ieee754_double x;
 370
 371   /* assumed by tarval_hash(): */
 372   assert (sizeof (float) * CHAR_BIT == 32);
 373   assert (sizeof (double) * CHAR_BIT == 64);
 374
 375 # if 0
 376   /* assumed by tarval_sInt & friends: */
 377   assert (   (irm_C == irm_c+1) && (irm_h == irm_C+1)
 378           && (irm_H == irm_h+1) && (irm_i == irm_H+1)
 379           && (irm_I == irm_i+1) && (irm_l == irm_I+1)
 380           && (irm_L == irm_l+1));
 381
 382   /* assumed everywhere: */
 383   for (i = 0;  i <= irm_L-irm_c;  i += 2) {
 384     assert (   IS_POW2 (max_sInt[i+1]+1)
 385             && (min_sInt[i] == -max_sInt[i]-1)
 386             && ((tarval_uInt)max_sInt[i+1] == (tarval_uInt)max_sInt[i]-min_sInt[i]));
 387   }
 388 # endif
 389
 390
 391   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 392   tv->mode = mode_T;
 393   tarval_bad = tarval_identify (tv);
 394
 395   tarval_b_false = tarval_from_long (mode_b, 0);
 396   tarval_b_true = tarval_from_long (mode_b, 1);
 397
 398   /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
 399   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 400   tv->mode = mode_D;
 401   x.ieee.negative = 0;
 402   x.ieee.exponent = 0x7ff;
 403   x.ieee.mantissa0 = 0;
 404   x.ieee.mantissa1 = 0;
 405   tv->u.D = x.d;
 406   tarval_D_Inf = tarval_identify (tv);
 407
 408   /* IsNaN <-> exponent==0x7ff  && (qnan_bit | bits | fraction_low) */
 409   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 410   tv->mode = mode_D;
 411   x.ieee_nan.negative = 0;
 412   x.ieee_nan.exponent = 0x7ff;
 413   x.ieee_nan.quiet_nan = 1;     /* @@@ quiet or signalling? */
 414   x.ieee_nan.mantissa0 = 42;
 415   x.ieee_nan.mantissa1 = 0;
 416   assert(x.d != x.d /* x.d is NaN */);
 417   tv->u.D = x.d;
 418   tarval_D_NaN = tarval_identify (tv);
 419
 420   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 421   tv->mode = mode_P;
 422   tv->u.P.xname = NULL;
 423   tv->u.P.ent = NULL;
 424   tv->u.P.tv = NULL;
 425   tarval_P_void = tarval_identify (tv);
 426
 427   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 428
 429
 430   tarval_mode_null [irm_F] = tarval_from_long (mode_F, 0);
 431   tarval_mode_null [irm_D] = tarval_from_long (mode_D, 0);
 432   tarval_mode_null [irm_E] = tarval_from_long (mode_E, 0);
 433   tarval_mode_null [irm_Bs] = tarval_from_long (mode_Bs, 0);
 434   tarval_mode_null [irm_Bu] = tarval_from_long (mode_Bu, 0);
 435   tarval_mode_null [irm_Hs] = tarval_from_long (mode_Hs, 0);
 436   tarval_mode_null [irm_Hu] = tarval_from_long (mode_Hu, 0);
 437   tarval_mode_null [irm_Is] = tarval_from_long (mode_Is, 0);
 438   tarval_mode_null [irm_Iu] = tarval_from_long (mode_Iu, 0);
 439   tarval_mode_null [irm_Ls] = tarval_from_long (mode_Ls, 0);
 440   tarval_mode_null [irm_Lu] = tarval_from_long (mode_Lu, 0);
 441   tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
 442   tarval_mode_null [irm_U] = tarval_from_long (mode_U, 0);
 443   tarval_mode_null [irm_b] = tarval_b_false;
 444   tarval_mode_null [irm_P] = tarval_P_void;
 445 }
 446
 447
 448 /*** ********************** Constructors for tarvals ********************** ***/
 449
 450 /* copy from src to dst len chars omitting '_'. */
 451 static char *
 452 stripcpy (char *dst, const char *src, size_t len)
 453 {
 454   char *d = dst;
 455
 456   while (len--) {
 457     if (*src == '_') src++;
 458     else *d++ = *src++;
 459   }
 460   *d = 0;                       /* make it 0-terminated. */
 461
 462   return dst;
 463 }
 464
 465 tarval *
 466 tarval_F_from_str (const char *s, size_t len)
 467 {
 468   tarval *tv;
 469   char *buf;
 470   char *eptr;
 471
 472   assert (!BUILDING);
 473
 474   buf = alloca (len+1);
 475   stripcpy (buf, s, len);
 476
 477   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 478   tv->mode = mode_F;
 479   tv->u.F = (float)strtod (buf, &eptr);
 480   assert (eptr == buf+strlen(buf));
 481
 482   return tarval_identify (tv);
 483 }
 484
 485
 486 tarval *
 487 tarval_D_from_str (const char *s, size_t len)
 488 {
 489   tarval *tv;
 490   char *buf;
 491   char *eptr;
 492
 493   assert (!BUILDING);
 494
 495   buf = alloca (len+1);
 496   stripcpy (buf, s, len);
 497
 498   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 499   tv->mode = mode_D;
 500   tv->u.D = strtod (buf, &eptr);
 501   assert (eptr == buf+strlen(buf));
 502
 503   return tarval_identify (tv);
 504 }
 505
 506 tarval *
 507 tarval_int_from_str (const char *s, size_t len, int base, ir_mode *m)
 508 {
 509   long val;
 510   char *eptr;
 511   char *buf;
 512
 513   assert (mode_is_int(m));
 514   assert (!BUILDING);
 515
 516   buf = alloca (len+1);
 517   stripcpy (buf, s, len);
 518
 519   errno = 0;
 520   val = strtol(buf, &eptr, base);    /* strtoll */
 521   assert (eptr == buf+strlen(buf));
 522   if ((errno == ERANGE)               &&
 523       ((m == mode_Ls) || (m == mode_Lu))  ) {
 524     printf("WARNING: Constant %s not representable. Continuing with %ld.\n",
 525            s, val);
 526   }
 527
 528   return tarval_from_long(m, val);
 529 }
 530
 531 /* Create a tarval with mode `m' and value `val' casted to the type that
 532    represents such tarvals on host.  The resulting value must be legal
 533    for mode `m'.  */
 534 tarval *
 535 tarval_from_long (ir_mode *m, long val)
 536 {
 537   tarval *tv;
 538
 539   assert (!BUILDING);
 540
 541   if (m == mode_T) return tarval_bad;
 542
 543   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 544
 545   tv->mode = m;
 546   switch (get_mode_modecode(m)) {
 547     /* floating */
 548   case irm_F:
 549     tv->u.F = val; break;
 550   case irm_D:
 551     tv->u.D = val; break;
 552   case irm_E:
 553     /* @@@ not yet implemented */
 554     break;
 555     /* unsigned */
 556   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 557     tv->u.uInt = val; break;
 558     /* signed */
 559   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 560     tv->u.sInt = val; break;
 561   case irm_P:
 562     assert(!val);
 563     obstack_free (&tv_obst, tv);
 564     return tarval_P_void;
 565   case irm_C:
 566     tv->u.C = val; break;
 567   case irm_U:
 568     tv->u.U = val; break;
 569   case irm_b:
 570     tv->u.b = !!val;            /* u.b must be 0 or 1 */
 571     break;
 572   default:
 573     assert(0);
 574   }
 575
 576   return tarval_identify (tv);
 577 }
 578
 579
 580 tarval *
 581 tarval_P_from_str (const char *xname)
 582 {
 583   tarval *tv;
 584
 585   assert (!BUILDING);
 586
 587   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 588
 589   tv->mode = mode_P;
 590   tv->u.P.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
 591   tv->u.P.ent = NULL;
 592   tv->u.P.tv = NULL;
 593   return tarval_identify (tv);
 594 }
 595
 596
 597 tarval *
 598 tarval_P_from_entity (entity *ent)
 599 {
 600   tarval *tv;
 601
 602   assert (!BUILDING);
 603   //assert(ent && "no entity given");
 604
 605   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 606
 607   tv->mode = mode_P;
 608   tv->u.P.xname = NULL;
 609   tv->u.P.ent = ent;
 610   tv->u.P.tv = NULL;
 611   return tarval_identify (tv);
 612 }
 613
 614
 615 /* Routines for building a tarval step by step follow.
 616    Legal calling sequences:
 617      tarval_start()
 618      No constructors except tarval_append() and tarval_append1 ()
 619      tarval_finish_as() or tarval_cancel() */
 620
 621 /* Begin building a tarval.  */
 622 void
 623 tarval_start (void)
 624 {
 625   assert (!BUILDING);
 626   obstack_blank (&tv_obst, sizeof (tarval));
 627 }
 628
 629
 630 /* Append `n' chars from `p' to the tarval currently under construction.  */
 631 void
 632 tarval_append (const char *p, size_t n)
 633 {
 634   assert (BUILDING);
 635   obstack_grow (&tv_obst, p, n);
 636 }
 637
 638
 639 /* Append `ch' to the tarval currently under construction.  */
 640 void
 641 tarval_append1 (char ch)
 642 {
 643   assert (BUILDING);
 644   obstack_1grow (&tv_obst, ch);
 645 }
 646
 647
 648 /* Finish the tarval currently under construction and give id mode `m'.
 649    `m' must be irm_Bu,
 650    Return NULL if the value does not make sense for this mode, this
 651    can only happen in mode C.  */
 652 tarval *
 653 tarval_finish_as (ir_mode *m)
 654 {
 655   int size = obstack_object_size (&tv_obst) - sizeof (tarval);
 656   tarval *tv;
 657   unsigned char *p;
 658   char ch = 0;                  /* initialized to shut up gcc */
 659
 660   assert (BUILDING && (size >= 0));
 661   if (m == mode_Bu) {
 662     if (size != 1) return tarval_cancel();
 663     p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
 664     ch = *p;
 665     obstack_blank (&tv_obst, -size);
 666   }
 667   tv = obstack_finish (&tv_obst);
 668   p = (unsigned char *)tv + sizeof (tarval);
 669   tv->mode = m;
 670
 671   switch (get_mode_modecode(m)) {
 672   case irm_Bu:
 673     tv->u.uInt = ch;
 674     break;
 675   case irm_P:
 676     tv->u.P.tv = NULL;
 677     break;
 678   default:
 679     assert (0);
 680   }
 681
 682   return tarval_identify (tv);
 683 }
 684
 685
 686 /* Cancel tarval building and return tarval_bad.  */
 687 tarval *
 688 tarval_cancel (void)
 689 {
 690   assert (BUILDING);
 691   obstack_free (&tv_obst, obstack_finish (&tv_obst));
 692   return tarval_bad;
 693 }
 694
 695
 696 /*** ****************** Arithmethic operations on tarvals ***************** ***/
 697
 698 /* Return `src' converted to mode `m' if representable, else NULL.
 699    @@@ lots of conversions missing */
 700 tarval *
 701 tarval_convert_to (tarval *src, ir_mode *m)
 702 {
 703   tarval *tv;
 704
 705   if (m == src->mode) return src;
 706
 707   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 708   tv->mode = m;
 709
 710   switch (get_mode_modecode(src->mode)) {
 711
 712   case irm_D:
 713     if (m != mode_F) goto fail;
 714     tv->u.F = src->u.D;
 715     break;
 716
 717   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 718     switch (get_mode_modecode(m)) {
 719     case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 720       tv->u.sInt = src->u.sInt;
 721       if (sInt_overflow (tv->u.sInt, m)) goto fail;
 722       break;
 723
 724     case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 725       tv->u.uInt = src->u.sInt;
 726       if (uInt_overflow (tv->u.uInt, m)) goto fail;
 727       break;
 728
 729     case irm_b:
 730       tv->u.b = !!src->u.sInt;
 731       break;
 732
 733     default: goto fail;
 734     }
 735
 736   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 737     switch (get_mode_modecode(m)) {
 738     case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 739       tv->u.sInt = src->u.uInt;
 740       if (sInt_overflow (tv->u.sInt, m)) goto fail;
 741       break;
 742
 743     case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 744       tv->u.uInt = src->u.uInt;
 745       if (uInt_overflow (tv->u.uInt, m)) goto fail;
 746       break;
 747
 748     case irm_b:
 749       tv->u.b = !!src->u.uInt;
 750       break;
 751
 752     default: goto fail;
 753     }
 754     break;
 755
 756   case irm_b:
 757     switch (get_mode_modecode(m)) {
 758     case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 759       tv->u.sInt = src->u.b;
 760       break;
 761
 762     case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 763       tv->u.uInt = src->u.b;
 764
 765     default: goto fail;
 766     }
 767     break;
 768
 769   default:
 770   fail:
 771     obstack_free (&tv_obst, tv);
 772     return NULL;
 773   }
 774
 775   return tarval_identify (tv);
 776 }
 777
 778
 779 /* GL Why are there no ArmRoq comments, why is this not used? */
 780 tarval *
 781 tarval_neg (tarval *a)
 782 {
 783   tarval *tv;
 784
 785   TARVAL_VRFY (a);
 786
 787   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 788
 789   tv->mode = a->mode;
 790
 791   switch (get_mode_modecode(a->mode)) {
 792     /* floating */
 793   case irm_F: tv->u.F = -a->u.F; break;
 794   case irm_D: tv->u.D = -a->u.D; break;
 795     /* unsigned */
 796   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 797     tv->u.uInt = -a->u.uInt & tv_val_uInt (get_mode_max(a->mode));
 798     break;
 799     /* signed */
 800   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 801     tv->u.sInt = -a->u.sInt;
 802     if (   sInt_overflow (tv->u.sInt, a->mode)
 803         || ((tv->u.sInt >= 0) == (a->u.sInt >= 0))) {
 804       obstack_free (&tv_obst, tv);
 805       return NULL;
 806     }
 807     break;
 808   case irm_b: tv->u.b = !a->u.b; break;
 809   default: assert(0);
 810   }
 811
 812   return tarval_identify (tv);
 813 }
 814
 815
 816 /* Compare `a' with `b'.
 817    Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
 818    result is unknown.  */
 819 ir_pncmp
 820 tarval_comp (tarval *a, tarval *b)
 821 {
 822
 823   TARVAL_VRFY (a);
 824   TARVAL_VRFY (b);
 825
 826   assert (a->mode == b->mode);
 827
 828   switch (get_mode_modecode(a->mode)) {
 829     /* floating */
 830   case irm_F: return (  a->u.F == b->u.F ? irpn_Eq
 831                       : a->u.F > b->u.F ? irpn_Gt
 832                       : a->u.F < b->u.F ? irpn_Lt
 833                       : irpn_Uo);
 834   case irm_D: return (  a->u.D == b->u.D ? irpn_Eq
 835                       : a->u.D > b->u.D ? irpn_Gt
 836                       : a->u.D < b->u.D ? irpn_Lt
 837                       : irpn_Uo);
 838   case irm_E: return (  a->u.E == b-> u.E ? irpn_Eq
 839               : a->u.E > b->u.E ? irpn_Gt
 840               : a->u.E < b->u.E ? irpn_Lt
 841               : irpn_Uo);
 842     /* unsigned */
 843   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 844     return (  a->u.uInt == b->u.uInt ? irpn_Eq
 845             : a->u.uInt > b->u.uInt ? irpn_Gt
 846             : irpn_Lt);
 847     /* signed */
 848   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 849     return (  a->u.sInt == b->u.sInt ? irpn_Eq
 850             : a->u.sInt > b->u.sInt ? irpn_Gt
 851             : irpn_Lt);
 852   case irm_b: return (  a->u.b == b->u.b ? irpn_Eq
 853                       : a->u.b > b->u.b ? irpn_Gt
 854                       : irpn_Lt);
 855   /* The following assumes that pointers are unsigned, which is valid
 856      for all sane CPUs (transputers are insane). */
 857   case irm_P: return (  a == b ? irpn_Eq
 858                       : a == tarval_P_void ? irpn_Lt
 859                       : b == tarval_P_void ? irpn_Gt
 860                       : irpn_False); /* unknown */
 861   default: assert (0);
 862   }
 863 }
 864
 865
 866 /* Return `a+b' if computable, else NULL.  Modes must be equal.  */
 867 tarval *
 868 tarval_add (tarval *a, tarval *b)
 869 {
 870   tarval *tv;
 871
 872   TARVAL_VRFY (a); TARVAL_VRFY (b);
 873   assert (a->mode == b->mode);
 874
 875   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 876
 877   tv->mode = a->mode;
 878
 879   switch (get_mode_modecode(a->mode)) {
 880     /* floating */
 881   case irm_F: tv->u.F = a->u.F + b->u.F; break; /* @@@ overflow etc */
 882   case irm_D: tv->u.D = a->u.D + b->u.D; break; /* @@@ dto. */
 883   case irm_E: tv->u.E = a->u.E + b->u.E; break; /* @@@ dto. */
 884     /* unsigned */
 885   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 886     tv->u.uInt = (a->u.uInt + b->u.uInt) & tv_val_uInt (get_mode_max(a->mode));
 887     break;
 888     /* signed */
 889   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 890     tv->u.sInt = a->u.sInt + b->u.sInt;
 891     if (   sInt_overflow (tv->u.sInt, a->mode)
 892         || ((tv->u.sInt > a->u.sInt) ^ (b->u.sInt > 0))) {
 893       obstack_free (&tv_obst, tv);
 894       return NULL;
 895     }
 896     break;
 897   case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
 898   default: assert(0);
 899   }
 900
 901   return tarval_identify (tv);
 902 }
 903
 904
 905 /* Return `a-b' if computable, else NULL.  Modes must be equal.  */
 906 tarval *
 907 tarval_sub (tarval *a, tarval *b)
 908 {
 909   tarval *tv;
 910
 911   TARVAL_VRFY (a); TARVAL_VRFY (b);
 912   assert (a->mode == b->mode);
 913
 914   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 915
 916   tv->mode = a->mode;
 917
 918   switch (get_mode_modecode(a->mode)) {
 919     /* floating */
 920   case irm_F: tv->u.F = a->u.F - b->u.F; break; /* @@@ overflow etc */
 921   case irm_D: tv->u.D = a->u.D - b->u.D; break; /* @@@ dto. */
 922   case irm_E: tv->u.E = a->u.E - b->u.E; break; /* @@@ dto. */
 923     /* unsigned */
 924   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 925     tv->u.uInt = (a->u.uInt - b->u.uInt) & tv_val_uInt (get_mode_max(a->mode));
 926     break;
 927     /* signed */
 928   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 929     tv->u.sInt = a->u.sInt - b->u.sInt;
 930     if (   sInt_overflow (tv->u.sInt, a->mode)
 931         || ((tv->u.sInt > a->u.sInt) ^ (b->u.sInt < 0))) {
 932       obstack_free (&tv_obst, tv);
 933       return NULL;
 934     }
 935     break;
 936   case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
 937   default: assert(0);
 938   }
 939
 940   return tarval_identify (tv);
 941 }
 942
 943 /* Return `a*b' if computable, else NULL.  Modes must be equal.  */
 944 tarval *
 945 tarval_mul (tarval *a, tarval *b)
 946 {
 947   tarval *tv;
 948
 949   TARVAL_VRFY (a); TARVAL_VRFY (b);
 950   assert (a->mode == b->mode);
 951
 952   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 953
 954   tv->mode = a->mode;
 955
 956   switch (get_mode_modecode(a->mode)) {
 957     /* floating */
 958   case irm_F: tv->u.F = a->u.F * b->u.F; break; /* @@@ overflow etc */
 959   case irm_D: tv->u.D = a->u.D * b->u.D; break; /* @@@ dto. */
 960   case irm_E: tv->u.E = a->u.E * b->u.E; break; /* @@@ dto. */
 961     /* unsigned */
 962   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
 963     tv->u.uInt = (a->u.uInt * b->u.uInt) & tv_val_uInt (get_mode_max(a->mode));
 964     break;
 965     /* signed */
 966   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
 967     tv->u.sInt = a->u.sInt * b->u.sInt;
 968     if (   sInt_overflow (tv->u.sInt, a->mode)
 969         || (b->u.sInt && (tv->u.sInt / b->u.sInt != a->u.sInt))) {
 970       obstack_free (&tv_obst, tv);
 971       return NULL;
 972     }
 973     break;
 974   case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
 975   default: assert(0);
 976   }
 977
 978   return tarval_identify (tv);
 979 }
 980
 981
 982 /* Return floating-point `a/b' if computable, else NULL.
 983    Modes must be equal, non-floating-point operands are converted to irm_D.  */
 984 tarval *
 985 tarval_quo (tarval *a, tarval *b)
 986 {
 987   tarval *tv;
 988
 989   TARVAL_VRFY (a); TARVAL_VRFY (b);
 990   assert (a->mode == b->mode);
 991
 992   switch (get_mode_modecode(a->mode)) {
 993     /* floating */
 994   case irm_F:
 995     tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 996     tv->mode = mode_F;
 997     tv->u.F = a->u.F / b->u.F;  /* @@@ overflow etc */
 998     break;
 999   case irm_D:
1000     tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1001     tv->mode = mode_D;
1002     tv->u.D = a->u.D / b->u.D;  /* @@@ overflow etc */
1003     break;
1004   default:
1005     a = tarval_convert_to (a, mode_D);
1006     b = tarval_convert_to (b, mode_D);
1007     return a && b ? tarval_quo (a, b) : NULL;
1008   }
1009
1010   return tarval_identify (tv);
1011 }
1012
1013
1014 /* Return `a/b' if computable, else NULL.  Modes must be equal.  */
1015 tarval *
1016 tarval_div (tarval *a, tarval *b)
1017 {
1018   tarval *tv;
1019
1020   TARVAL_VRFY (a); TARVAL_VRFY (b);
1021   assert (a->mode == b->mode);
1022
1023   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1024
1025   tv->mode = a->mode;
1026
1027   switch (get_mode_modecode(a->mode)) {
1028     /* floating */
1029   case irm_F: tv->u.F = floor (a->u.F / b->u.F); break; /* @@@ overflow etc */
1030   case irm_D: tv->u.D = floor (a->u.D / b->u.D); break; /* @@@ dto. */
1031   case irm_E: tv->u.E = floor (a->u.E / b->u.E); break; /* @@@ dto. */
1032     /* unsigned */
1033   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1034     if (!b->u.uInt) goto fail;
1035     tv->u.uInt = a->u.uInt / b->u.uInt;
1036     break;
1037     /* signed */
1038   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1039     if (   !b->u.sInt
1040         || ((b->u.sInt == -1) && (a->u.sInt == tv_val_sInt (get_mode_max(a->mode)) ))) {
1041     fail:
1042       obstack_free (&tv_obst, tv);
1043       return NULL;
1044     }
1045     tv->u.sInt = a->u.sInt / b->u.sInt;
1046     break;
1047   case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1048   default: assert(0);
1049   }
1050
1051   return tarval_identify (tv);
1052 }
1053
1054
1055 /* Return `a%b' if computable, else NULL.  Modes must be equal.  */
1056 tarval *
1057 tarval_mod (tarval *a, tarval *b)
1058 {
1059   tarval *tv;
1060
1061   TARVAL_VRFY (a); TARVAL_VRFY (b);
1062   assert (a->mode == b->mode);
1063
1064   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1065
1066   tv->mode = a->mode;
1067
1068   switch (get_mode_modecode(a->mode)) {
1069     /* floating */
1070   case irm_F: tv->u.F = fmod (a->u.F, b->u.F); break; /* @@@ overflow etc */
1071   case irm_D: tv->u.D = fmod (a->u.D, b->u.D); break; /* @@@ dto */
1072   case irm_E: tv->u.E = fmod (a->u.E, b->u.E); break; /* @@@ dto. */
1073     /* unsigned */
1074   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1075     if (!b->u.uInt) goto fail;
1076     tv->u.uInt = a->u.uInt % b->u.uInt;
1077     break;
1078     /* signed */
1079   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1080     if (!b->u.sInt) {
1081     fail:
1082       obstack_free (&tv_obst, tv);
1083       return NULL;
1084     }
1085     tv->u.sInt = a->u.sInt % b->u.sInt;
1086     break;
1087   case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1088   default: assert(0);
1089   }
1090
1091   return tarval_identify (tv);
1092 }
1093
1094 /* Return |a| if computable, else Null. */
1095 /*  is -max == min?? */
1096 tarval *
1097 tarval_abs (tarval *a) {
1098   TARVAL_VRFY (a);
1099   if (tv_is_negative(a)) return tarval_neg(a);
1100   return a;
1101 }
1102
1103 int
1104 tv_is_negative(tarval *a) {
1105   TARVAL_VRFY (a);
1106   switch (get_mode_modecode(a->mode)) {
1107     /* floating */
1108   case irm_F: return (a->u.F<0);
1109   case irm_D: return (a->u.D<0);
1110   case irm_E: return (a->u.E<0);
1111     /* unsigned */
1112   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1113     return 0;
1114     break;
1115     /* signed */
1116   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1117     return (a->u.sInt < 0);
1118     break;
1119   case irm_b: break;
1120   default: assert(0);
1121   }
1122
1123   return 0;
1124 }
1125
1126
1127 /* Return `a&b'.  Modes must be equal.  */
1128 tarval *
1129 tarval_and (tarval *a, tarval *b)
1130 {
1131   tarval *tv;
1132
1133   TARVAL_VRFY (a); TARVAL_VRFY (b);
1134   assert (a->mode == b->mode);
1135
1136   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1137
1138   tv->mode = a->mode;
1139
1140   switch (get_mode_modecode(a->mode)) {
1141     /* unsigned */
1142   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1143     tv->u.uInt = a->u.uInt & b->u.uInt; break;
1144     /* signed */
1145   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1146     tv->u.sInt = a->u.sInt & b->u.sInt; break;
1147   case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1148   default: assert(0);
1149   }
1150
1151   return tarval_identify (tv);
1152 }
1153
1154
1155 /* Return `a|b'.  Modes must be equal.  */
1156 tarval *
1157 tarval_or (tarval *a, tarval *b)
1158 {
1159   tarval *tv;
1160
1161   TARVAL_VRFY (a); TARVAL_VRFY (b);
1162   assert (a->mode == b->mode);
1163
1164   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1165
1166   tv->mode = a->mode;
1167
1168   switch (get_mode_modecode(a->mode)) {
1169     /* unsigned */
1170   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1171     tv->u.uInt = a->u.uInt | b->u.uInt; break;
1172     /* signed */
1173   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1174     tv->u.sInt = a->u.sInt | b->u.sInt; break;
1175   case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1176   default: assert(0);
1177   }
1178
1179   return tarval_identify (tv);
1180 }
1181
1182
1183 /* Return `a^b'.  Modes must be equal.  */
1184 tarval *
1185 tarval_eor (tarval *a, tarval *b)
1186 {
1187   tarval *tv;
1188
1189   TARVAL_VRFY (a); TARVAL_VRFY (b);
1190   assert (a->mode == b->mode);
1191
1192   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1193
1194   tv->mode = a->mode;
1195
1196   switch (get_mode_modecode(a->mode)) {
1197     /* unsigned */
1198   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1199     tv->u.uInt = a->u.uInt ^ b->u.uInt; break;
1200     /* signed */
1201   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1202     tv->u.sInt = a->u.sInt ^ b->u.sInt; break;
1203   case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1204   default: assert(0);
1205   }
1206
1207   return tarval_identify (tv);
1208 }
1209
1210
1211 /* Return `a<<b' if computable, else NULL.  */
1212 tarval *
1213 tarval_shl (tarval *a, tarval *b)
1214 {
1215   int b_is_huge;
1216   long shift;
1217   tarval *tv;
1218
1219   TARVAL_VRFY (a); TARVAL_VRFY (b);
1220
1221   shift = tarval_ord (b, &b_is_huge);
1222   if (   b_is_huge
1223       || (shift < 0)
1224       || ((shift >= get_mode_size(mode_Ls)*target_bits))) {
1225     return NULL;
1226   }
1227
1228   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1229   tv->mode = a->mode;
1230
1231   switch (get_mode_modecode(a->mode)) {
1232     /* unsigned */
1233   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1234     tv->u.uInt = a->u.uInt << shift;
1235     break;
1236     /* signed */
1237   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1238     tv->u.sInt = a->u.sInt << shift;
1239     break;
1240   default: assert (0);
1241   }
1242
1243   return tarval_identify (tv);
1244 }
1245
1246
1247 /* Return `a>>b' if computable, else NULL.
1248    The interpretation of >> (sign extended or not) is implementaion
1249    dependent, i.e. this is neither shr nor shrs!! */
1250 tarval *
1251 tarval_shr (tarval *a, tarval *b)
1252 {
1253   int b_is_huge;
1254   long shift;
1255   tarval *tv;
1256
1257   TARVAL_VRFY (a); TARVAL_VRFY (b);
1258
1259   shift = tarval_ord (b, &b_is_huge);
1260   if (   b_is_huge
1261       || (shift < 0)
1262       || ((shift >= get_mode_size(mode_Ls)*target_bits))) {
1263     return NULL;
1264   }
1265
1266   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1267   tv->mode = a->mode;
1268
1269   switch (get_mode_modecode(a->mode)) {
1270     /* unsigned */
1271   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1272     tv->u.uInt = a->u.uInt >> shift;
1273     break;
1274     /* signed */
1275   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1276     tv->u.sInt = a->u.sInt >> shift;
1277     break;
1278   default: assert (0);
1279   }
1280
1281   return tarval_identify (tv);
1282 }
1283
1284
1285 /* Classify `tv', which may be NULL.
1286    Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1287    multiplicative neutral element, and -1 if `tv' is the neutral
1288    element of bitwise and.  */
1289 long
1290 tarval_classify (tarval *tv)
1291 {
1292   if (!tv) return 2;
1293
1294   TARVAL_VRFY (tv);
1295
1296   switch (get_mode_modecode(tv->mode)) {
1297     /* floating */
1298   case irm_F: case irm_D: case irm_E:
1299     return 2;
1300     /* unsigned */
1301   case irm_Bu:
1302     return (long)((tv->u.uInt+1) & tv_val_uInt (get_mode_max(mode_Bu))) - 1;
1303   case irm_Hu:
1304     return (long)((tv->u.uInt+1) & tv_val_uInt (get_mode_max(mode_Hu))) - 1;
1305   case irm_Iu:
1306     return (long)((tv->u.uInt+1) & tv_val_uInt (get_mode_max(mode_Iu))) - 1;
1307   case irm_Lu:
1308     return (long)((tv->u.uInt+1) & tv_val_uInt (get_mode_max(mode_Lu))) - 1;
1309     /* signed */
1310   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1311     return tv->u.sInt;
1312   case irm_b:
1313     return tv->u.b;
1314   default:
1315     return 2;
1316   }
1317 }
1318
1319 /* Convert `tv' into type `long', set `fail' if not representable.
1320    If `fail' gets set for an unsigned `tv', the correct result can be
1321    obtained by casting the result to `unsigned long'.  */
1322 long
1323 tarval_ord (tarval *tv, int *fail)
1324 {
1325   TARVAL_VRFY (tv);
1326
1327   switch (get_mode_modecode(tv->mode)) {
1328     /* unsigned */
1329   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
1330     *fail = tv->u.uInt > tv_val_uInt (get_mode_max(mode_Ls));
1331     return tv->u.uInt;
1332     /* signed */
1333   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
1334     *fail = 0;
1335     return tv->u.sInt;
1336   case irm_b:
1337     *fail = 0;
1338     return tv->u.b;
1339   default: ;
1340     *fail = 1;
1341     return 0;
1342   }
1343 }
1344
1345 int
1346 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1347 {
1348   tarval *val = XP_GETARG (tarval *, 0);
1349   int printed;
1350   char buf[40];
1351
1352   TARVAL_VRFY (val);
1353
1354   switch (get_mode_modecode(val->mode)) {
1355
1356   case irm_T:                   /* none */
1357     printed = XPSR ("<bad>");
1358     break;
1359
1360   case irm_F:                   /* float */
1361     sprintf (buf, "%1.9e", (float)(val->u.F));
1362     printed = XPF1R ("%s", buf);
1363     break;
1364   case irm_D:                   /* double */
1365     printed = XPF1R ("%1.30g", (double)(val->u.D));
1366     break;
1367
1368   case irm_C:           /* character */
1369     if ((isprint (val->u.C)) &&
1370         (val->u.C != '\\')   && (val->u.C != '\'')) {
1371       printed = XPF1R ("'%c'", val->u.C);
1372     } else {
1373       printed = XPF1R ("0x%x", (unsigned long)val->u.C);
1374     }
1375     break;
1376   case irm_U:           /* unicode character */
1377       printed = XPF1R ("0x%x", (unsigned long)val->u.U);
1378     break;
1379
1380   case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls: /* signed num */
1381     printed = XPF1R ("%ld", (long)val->u.sInt);
1382     break;
1383   case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu: /* unsigned num */
1384     printed = XPF1R ("%lu", (unsigned long)val->u.uInt);
1385     break;
1386
1387   case irm_P:                   /* pointer */
1388     if (val->u.P.xname) {
1389       printed = XPR (val->u.P.xname);
1390     } else if (val->u.P.ent) {
1391       if (get_entity_peculiarity(val->u.P.ent) == existent)
1392         printed = XPF1R ("&(%I)", get_entity_ld_ident(val->u.P.ent));
1393       else
1394         printed = XPSR ("(NULL)");
1395     } else {
1396       assert (val == tarval_P_void);
1397       printed = XPSR ("(NULL)");
1398     }
1399     break;
1400
1401   case irm_b:                   /* boolean */
1402     if (val->u.b) printed = XPSR ("true");
1403     else          printed = XPSR ("false");
1404     break;
1405
1406   case irm_M:                   /* memory */
1407   case irm_BB:                  /* region */
1408   default:
1409     assert (0);
1410   }
1411
1412   return printed;
1413 }
1414
1415
1416 ir_mode *
1417 get_tv_mode (tarval *tv)
1418 {
1419   return tv->mode;
1420 }
1421
1422 /* Returns the entity if the tv is a pointer to an entity, else
1423    returns NULL; */
1424 entity *get_tv_entity(tarval *tv) {
1425   entity *ent = NULL;
1426
1427   if (tv->mode == mode_P) {
1428     if (tv->u.P.xname) {
1429       assert(0);
1430       /* not an entity */
1431     } else if (tv->u.P.ent) {
1432       ent = tv->u.P.ent;
1433     } else {
1434       /* not an entity */
1435     }
1436   }
1437   return ent;
1438 }
1439
1440
1441 void
1442 free_tv_entity(entity *ent) {
1443   /* There can be a tarval referencing this entity.  Even if the
1444      tarval is not used by the code any more, it can still reference
1445      the entity as tarvals live forever (They live on an obstack.).
1446      Further the tarval is hashed into a set.  If a hash function
1447      evaluation happens to collide with this tarval, we will vrfy that
1448      it contains a proper entity and we will crash if the entity is
1449      freed.  We cannot remove tarvals from the obstack but we can
1450      remove the entry in the hash table. */
1451   tarval *found = NULL;
1452   tarval *tv = (tarval *)pset_first(tarvals);
1453   while (tv) {
1454     entity *tv_ent = get_tv_entity(tv);
1455     if ((tv_ent) && (tv_ent == ent)) found = tv;
1456     tv = pset_next(tarvals);
1457   }
1458   if (found)
1459     pset_remove(tarvals, found, tarval_hash(found));
1460 }