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.
1444      Even if the tarval is not used by the code any more,
1445      it can still reference an entity.  If a hash function
1446      happens to collide with this tarval, we will verify that
1447      it contains a proper entity and we will crash.
1448      As we cannot remove tarvals (they are on an obstack) we
1449      overwrite ent with NULL. */
1450   /* Get the tarval by allocating a new one. */
1451   tarval *tv = (tarval *)pset_first(tarvals);
1452   tarval *found = NULL;
1453   while (tv) {
1454     entity *tv_ent = get_tv_entity(tv);
1455     if ((tv_ent) && (tv_ent == ent)) {
1456       found = tv;
1457       //pset_remove(tarvals, tv, tarval_hash(tv));
1458       //tv->u.P.ent = NULL;
1459       //  tv = NULL;
1460     } //else {
1461       tv = pset_next(tarvals);
1462       //}
1463   }
1464   // pset_break(tarvals);
1465   if (found) {
1466     pset_remove(tarvals, found, tarval_hash(found));
1467   }
1468 }