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 /* Defining this causes inclusions of functions renamed with new gmp.h */
  29 #define _TARVAL_GMP_ 0
  30
  31 #ifdef HAVE_CONFIG_H
  32 # include <config.h>
  33 #endif
  34
  35 # include "xprintf.h"
  36 #include <assert.h>
  37 #include <limits.h>
  38 #include <errno.h>
  39 #include <math.h>
  40 #include <stdlib.h>
  41 #include <string.h>
  42 #include <ctype.h>
  43
  44 #include "pset.h"
  45 #define TOBSTACK_ID "tv"
  46 #include "obst.h"
  47 #include "ieee754.h"
  48 #include "tune.h"
  49 #include "ident_t.h"
  50 #include "tv_t.h"
  51 #include "entity_t.h"
  52 #include "irmode.h"
  53
  54 static struct obstack tv_obst;  /* obstack for all the target values */
  55 static pset *tarvals;           /* pset containing pointers to _all_ tarvals */
  56
  57 /* currently building an object with tarval_start() & friends ? */
  58 #define BUILDING obstack_object_size (&tv_obst)
  59
  60 /* bcopy is not ISO C */
  61 #define bcopy(X, Y, Z) memcpy((Y), (X), (Z))
  62
  63
  64 /* special tarvals: */
  65 tarval *tarval_bad;
  66 tarval *tarval_b_false;
  67 tarval *tarval_b_true;
  68 tarval *tarval_d_NaN;
  69 tarval *tarval_d_Inf;
  70 tarval *tarval_p_void;
  71 tarval *tarval_mode_null[irm_max];
  72
  73 # if 0
  74 /* @@@ depends on order of ir_mode */
  75 static tarval_chil min_chil[8] = {
  76   TARGET_SIMIN (c), 0,
  77   TARGET_SIMIN (h), 0,
  78   TARGET_SIMIN (i), 0,
  79   TARGET_SIMIN (l), 0
  80 };
  81 static tarval_chil max_chil[8] = {
  82   TARGET_SIMAX (c), TARGET_UIMAX (C),
  83   TARGET_SIMAX (h), TARGET_UIMAX (H),
  84   TARGET_SIMAX (i), TARGET_UIMAX (I),
  85   TARGET_SIMAX (l), TARGET_UIMAX (L)
  86 };
  87 # endif
  88
  89 /* return a mode-specific value */
  90
  91 tarval_f
  92 tv_val_f (tarval *tv)
  93 {
  94   return tv->u.f;
  95 }
  96
  97 tarval_d
  98 tv_val_d (tarval *tv)
  99 {
 100   return tv->u.d;
 101 }
 102
 103 tarval_chil
 104 tv_val_chil (tarval *tv)
 105 {
 106   return tv->u.chil;
 107 }
 108
 109 tarval_CHIL
 110 tv_val_CHIL (tarval *tv)
 111 {
 112   return tv->u.CHIL;
 113 }
 114
 115 tarval_Z
 116 tv_val_Z (tarval *tv)
 117 {
 118   return tv->u.Z;
 119 }
 120
 121 tarval_p
 122 tv_val_p (tarval *tv)
 123 {
 124   return tv->u.p;
 125 }
 126
 127 bool
 128 tv_val_b (tarval *tv)
 129 {
 130   return tv->u.b;
 131 }
 132
 133 tarval_B
 134 tv_val_B (tarval *tv)
 135 {
 136   return tv->u.B;
 137 }
 138
 139 tarval_s
 140 tv_val_s (tarval *tv)
 141 {
 142   return tv->u.s;
 143 }
 144
 145
 146 /* Overflows `chil' signed integral `mode'?  */
 147 static INLINE bool
 148 chil_overflow (tarval_chil chil, ir_mode *mode)
 149 {
 150   assert (is_chilCHIL(get_mode_modecode(mode)));
 151   return (get_mode_min(mode) && get_mode_max(mode)  /* only valid after firm initialization */
 152           && (chil < tv_val_chil (get_mode_min(mode))
 153               || tv_val_chil (get_mode_max(mode)) < chil));
 154 }
 155
 156
 157 /* Overflows `CHIL' unsigned integral `mode'?  */
 158 static INLINE bool
 159 CHIL_overflow (tarval_CHIL CHIL, ir_mode *mode)
 160 {
 161   assert (is_chilCHIL(get_mode_modecode(mode)));
 162   return (get_mode_max(mode)   /* only valid after firm initialization */
 163           && tv_val_CHIL (get_mode_max(mode)) < CHIL);
 164 }
 165
 166
 167 #ifndef NDEBUG
 168 void
 169 _tarval_vrfy (const tarval *val)
 170 {
 171   assert (val);
 172   switch (get_mode_modecode(val->mode)) {
 173     /* floating */
 174   case irm_f:
 175   case irm_d:
 176     break;
 177     /* integral */
 178   case irm_C: case irm_H: case irm_I: case irm_L:
 179     assert (!CHIL_overflow (val->u.CHIL, val->mode)); break;
 180   case irm_c: case irm_h: case irm_i: case irm_l:
 181     assert (!chil_overflow (val->u.chil, val->mode)); break;
 182   case irm_Z:
 183     break;
 184     /* strange */
 185   case irm_p:
 186     if (val->u.p.ent)
 187       assert (val->u.p.ent->kind == k_entity);
 188     assert (   val->u.p.xname || val->u.p.ent
 189             || !tarval_p_void || (val == tarval_p_void));
 190     break;
 191   case irm_s:
 192   case irm_S:
 193     assert (val->u.s.p); break;
 194   case irm_B:
 195     assert (val->u.B.p); break;
 196   case irm_b:
 197     assert ((unsigned)val->u.b <= 1); break;
 198   default:
 199     assert (val->mode == mode_T);
 200   }
 201 }
 202 #endif
 203
 204
 205 #ifdef STATS
 206
 207 void
 208 tarval_stats (void)
 209 {
 210   pset_stats (tarvals);
 211 }
 212
 213 #endif
 214
 215
 216 /* Return the canonical tarval * for tv.
 217    May destroy everything allocated on tv_obst after tv!  */
 218 static tarval *
 219 tarval_identify (tarval *tv)
 220 {
 221   tarval *o;
 222
 223   o = pset_insert (tarvals, tv, tarval_hash (tv));
 224
 225   if (o != tv) {
 226     obstack_free (&tv_obst, (void *)tv);
 227   }
 228
 229   TARVAL_VRFY (o);
 230   return o;
 231 }
 232
 233
 234 /* Return 0 iff a equals b.  Bitwise identical NaNs compare equal.  */
 235 static int
 236 tarval_cmp (const void *p, const void *q)
 237 {
 238   const tarval *a = p;
 239   const tarval *b = q;
 240
 241   TARVAL_VRFY (a);
 242   TARVAL_VRFY (b);
 243
 244   if (a == b) return 0;
 245   if ((void *)a->mode - (void *)b->mode)
 246     return (void *)a->mode - (void *)b->mode;
 247
 248   switch (get_mode_modecode(a->mode)) {
 249     /* floating */
 250   case irm_f:
 251     return memcmp (&a->u.f, &b->u.f, sizeof (a->u.f));
 252   case irm_d:
 253     return memcmp (&a->u.d, &b->u.d, sizeof (a->u.d));
 254     /* unsigned */
 255   case irm_C: case irm_H: case irm_I: case irm_L:
 256     if (sizeof (int) == sizeof (tarval_CHIL)) {
 257       return a->u.CHIL - b->u.CHIL;
 258     }
 259     return a->u.CHIL != b->u.CHIL;
 260     /* signed */
 261   case irm_c: case irm_h: case irm_i: case irm_l:
 262     if (sizeof (int) == sizeof (tarval_chil)) {
 263       return a->u.chil - b->u.chil;
 264     }
 265     return a->u.chil != b->u.chil;
 266   case irm_Z:
 267 #if _TARVAL_GMP_
 268     return mpz_cmp (&a->u.Z, &b->u.Z);
 269 #else
 270     return 99; /* ?? */
 271 #endif
 272     /* strange */
 273   case irm_p:
 274     if (a->u.p.ent || b->u.p.ent)
 275       return (char *)a->u.p.ent - (char *)b->u.p.ent;
 276     if (a->u.p.xname && b->u.p.xname)
 277       return strcmp (a->u.p.xname, b->u.p.xname);
 278     return a->u.p.xname - b->u.p.xname;
 279   case irm_b:
 280     return a->u.b - b->u.b;
 281   case irm_B:
 282     return (  a->u.B.n - b->u.B.n
 283             ? memcmp (a->u.B.p, b->u.B.p, a->u.B.n)
 284             : a->u.B.n - b->u.B.n);
 285   case irm_s: case irm_S:
 286     return (  a->u.s.n == b->u.s.n
 287             ? memcmp (a->u.s.p, b->u.s.p, a->u.s.n)
 288             : a->u.s.n - b->u.s.n);
 289   default: assert (0);
 290   }
 291 }
 292
 293
 294 unsigned
 295 tarval_hash (tarval *tv)
 296 {
 297   unsigned h;
 298
 299   h = get_mode_modecode(tv->mode) * 0x421u;
 300   switch (get_mode_modecode(tv->mode)) {
 301   case irm_T:
 302     h = 0x94b527ce; break;
 303   case irm_f:
 304     /* quick & dirty */
 305     { union { float f; unsigned u; } u;
 306       assert (sizeof (float) <= sizeof (unsigned));
 307       u.u = 0; u.f = tv->u.f;
 308       h ^= u.u;
 309       break;
 310     }
 311   case irm_d:
 312     /* quick & dirty */
 313     { union { double d; unsigned u[2]; } u;
 314       assert (sizeof (double) <= 2*sizeof (unsigned));
 315       u.u[0] = u.u[1] = 0; u.d = tv->u.d;
 316       h ^= u.u[0] ^ u.u[1];
 317       break;
 318     }
 319   case irm_C: case irm_H: case irm_I: case irm_L:
 320     h ^= tv->u.CHIL; break;
 321   case irm_c: case irm_h: case irm_i: case irm_l:
 322     h ^= tv->u.chil; break;
 323   case irm_Z:
 324 #if _TARVAL_GMP_
 325     h ^= mpz_get_ui (&tv->u.Z); break;
 326 #else
 327     h ^= (unsigned int) tv; break; /* tut das? */
 328 #endif
 329   case irm_p:
 330     if (tv->u.p.ent) {
 331       /* @@@ lower bits not random, watch for collisions; perhaps
 332          replace by tv->u.p.ent - (entity *)0 */
 333       h ^= ((char *)tv->u.p.ent - (char *)0) / 64;
 334     } else if (tv->u.p.xname) {
 335       /* Of course, strlen() in a hash function is a mistake, but this
 336          case should be really rare.  */
 337       h ^= ID_HASH (tv->u.p.xname, strlen (tv->u.p.xname));
 338     } else {                    /* void */
 339       h^= 0x2b592b88;
 340     }
 341     break;
 342   case irm_b:
 343     h ^= tv->u.b; break;
 344   case irm_B:
 345     h ^= tv->u.B.n; break; /* @@@ not really good */
 346   case irm_s:
 347     h ^= tv->u.s.p[0]<<12 ^ tv->u.s.p[tv->u.s.n]<<4 ^ tv->u.s.n; break;
 348   case irm_S:
 349     h ^= tv->u.s.p[0]<<4 ^ tv->u.s.p[tv->u.s.n]<<12 ^ tv->u.s.n; break;
 350   default:
 351     assert(0);
 352   }
 353   return h;
 354 }
 355
 356
 357 \f
 358 /*** ***************** Initialization ************************************* ***/
 359
 360 void
 361 tarval_init_1 (void)
 362 {
 363   obstack_init (&tv_obst);
 364   obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1;
 365   assert (IS_POW2 (ALIGNOF (tarval)));
 366
 367   /* initialize the target value table */
 368   tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS);
 369 }
 370
 371 void
 372 tarval_init_2 (void)
 373 {
 374   tarval *tv;
 375   union ieee754_double x;
 376
 377   /* assumed by tarval_hash(): */
 378   assert (sizeof (float) * CHAR_BIT == 32);
 379   assert (sizeof (double) * CHAR_BIT == 64);
 380
 381 # if 0
 382   /* assumed by tarval_chil & friends: */
 383   assert (   (irm_C == irm_c+1) && (irm_h == irm_C+1)
 384           && (irm_H == irm_h+1) && (irm_i == irm_H+1)
 385           && (irm_I == irm_i+1) && (irm_l == irm_I+1)
 386           && (irm_L == irm_l+1));
 387
 388   /* assumed everywhere: */
 389   for (i = 0;  i <= irm_L-irm_c;  i += 2) {
 390     assert (   IS_POW2 (max_chil[i+1]+1)
 391             && (min_chil[i] == -max_chil[i]-1)
 392             && ((tarval_CHIL)max_chil[i+1] == (tarval_CHIL)max_chil[i]-min_chil[i]));
 393   }
 394 # endif
 395
 396
 397   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 398   tv->mode = mode_T;
 399   tarval_bad = tarval_identify (tv);
 400
 401   tarval_b_false = tarval_from_long (mode_b, 0);
 402   tarval_b_true = tarval_from_long (mode_b, 1);
 403
 404   /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
 405   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 406   tv->mode = mode_d;
 407   x.ieee.negative = 0;
 408   x.ieee.exponent = 0x7ff;
 409   x.ieee.mantissa0 = 0;
 410   x.ieee.mantissa1 = 0;
 411   tv->u.d = x.d;
 412   tarval_d_Inf = tarval_identify (tv);
 413
 414   /* IsNaN <-> exponent==0x7ff  && (qnan_bit | bits | fraction_low) */
 415   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 416   tv->mode = mode_d;
 417   x.ieee_nan.negative = 0;
 418   x.ieee_nan.exponent = 0x7ff;
 419   x.ieee_nan.quiet_nan = 1;     /* @@@ quiet or signalling? */
 420   x.ieee_nan.mantissa0 = 42;
 421   x.ieee_nan.mantissa1 = 0;
 422   assert(x.d != x.d /* x.d is NaN */);
 423   tv->u.d = x.d;
 424   tarval_d_NaN = tarval_identify (tv);
 425
 426   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 427   tv->mode = mode_p;
 428   tv->u.p.xname = NULL;
 429   tv->u.p.ent = NULL;
 430   tv->u.p.tv = NULL;
 431   tarval_p_void = tarval_identify (tv);
 432
 433   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 434
 435
 436   tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0);
 437   tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0);
 438   tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0);
 439   tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
 440   tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0);
 441   tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0);
 442   tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0);
 443   tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0);
 444   tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0);
 445   tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0);
 446   tarval_mode_null [irm_b] = tarval_b_false;
 447   tarval_mode_null [irm_p] = tarval_p_void;
 448 }
 449
 450
 451 \f
 452 /*** ********************** Constructors for tarvals ********************** ***/
 453
 454 /* copy from src to dst len chars omitting '_'. */
 455 static char *
 456 stripcpy (char *dst, const char *src, size_t len)
 457 {
 458   char *d = dst;
 459
 460   while (len--) {
 461     if (*src == '_') src++;
 462     else *d++ = *src++;
 463   }
 464   *d = 0;                       /* make it 0-terminated. */
 465
 466   return dst;
 467 }
 468
 469
 470 tarval *
 471 tarval_Z_from_str (const char *s, size_t len, int base)
 472 {
 473   tarval *tv;
 474   char *buf;
 475
 476   assert (!BUILDING);
 477
 478   buf = alloca (len+1);
 479   stripcpy (buf, s, len);
 480
 481   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 482   tv->mode = mode_Z;
 483 #if _TARVAL_GMP_
 484   if (mpz_init_set_str (&tv->u.Z, buf, base)) assert (0);
 485 #else
 486   assert(0 && "no support for Z in tv!");
 487 #endif
 488
 489   return tarval_identify (tv);
 490 }
 491
 492
 493 tarval *
 494 tarval_B_from_str (const char *s, size_t len)
 495 {
 496   tarval *tv;
 497   size_t n;                     /* size of B */
 498   const char *r;                /* read ptr */
 499   unsigned x;                   /* bit store */
 500   int b;                        /* bits in x */
 501   int shift;                    /* base shift */
 502
 503   assert (!BUILDING);
 504   assert (len >= 3);
 505
 506   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 507   tv->mode = mode_B;
 508
 509   assert (s[0] == '0');
 510   switch (s[1]) {
 511   case 'o':
 512   case 'O': shift = 3; break;
 513   case 'x':
 514   case 'X': shift = 4; break;
 515   default: assert(0);
 516   }
 517
 518   r = s+len;                    /* set r past input */
 519   s += 2;                       /* skip header */
 520   x = 0; b = 0; n = 0;
 521   while (--r >= s) {
 522     int d;                      /* digit */
 523
 524     if (*r == '_') continue;    /* skip _ styropor */
 525     if (('0' <= *r) && (*r <= '9')) {
 526       d = *r - '0';
 527     } else if (('a' <= *r) && (*r <= 'f')) {
 528       d = *r - 'a' + 10;
 529     } else { assert (('A' <= *r) && (*r <= 'F'));
 530       d = *r - 'A' + 10;
 531     }
 532
 533     x |= d << b;                /* insert d into x above the b present bits */
 534     b += shift;                 /* x now contains shift more bits */
 535
 536     if (b >= 8) {               /* we've accumulated at least a byte */
 537       char c = x & 0xFF;        /* extract the lower 8 bits from x */
 538       obstack_grow (&tv_obst, &c, 1);  /* and stuff them into B */
 539       x >>= 8;                  /* remove the lower 8 bits from x */
 540       b -= 8;                   /* x now contains 8 bits fewer */
 541       ++n;                      /* B grew a byte */
 542     }
 543   }
 544
 545   if (b >= 0) {                 /* flush the rest of the bits */
 546     char c = x;                 /* extract them */
 547     obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
 548     ++n;                        /* B grew a byte */
 549   }
 550
 551   { unsigned char *p = obstack_finish (&tv_obst);
 552     unsigned char *q = p + n;
 553
 554     tv->u.B.p = p;
 555     tv->u.B.n = n;
 556     /* reverse p in place */
 557     while (p < q) { char c = *p; *p++ = *q; *q-- = c; }
 558   }
 559
 560   return tarval_identify (tv);
 561 }
 562
 563
 564 tarval *
 565 tarval_f_from_str (const char *s, size_t len)
 566 {
 567   tarval *tv;
 568   char *buf;
 569   char *eptr;
 570
 571   assert (!BUILDING);
 572
 573   buf = alloca (len+1);
 574   stripcpy (buf, s, len);
 575
 576   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 577   tv->mode = mode_f;
 578   tv->u.f = (float)strtod (buf, &eptr);
 579   assert (eptr == buf+strlen(buf));
 580
 581   return tarval_identify (tv);
 582 }
 583
 584
 585 tarval *
 586 tarval_d_from_str (const char *s, size_t len)
 587 {
 588   tarval *tv;
 589   char *buf;
 590   char *eptr;
 591
 592   assert (!BUILDING);
 593
 594   buf = alloca (len+1);
 595   stripcpy (buf, s, len);
 596
 597   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 598   tv->mode = mode_d;
 599   tv->u.d = strtod (buf, &eptr);
 600   assert (eptr == buf+strlen(buf));
 601
 602   return tarval_identify (tv);
 603 }
 604
 605
 606 tarval *
 607 tarval_s_from_str (const char *s, size_t len)
 608 {
 609   tarval *tv;
 610
 611   assert (!BUILDING);
 612
 613   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 614
 615   tv->mode = mode_s;
 616   tv->u.s.n = len;
 617   tv->u.s.p = obstack_copy (&tv_obst, s, len);
 618
 619   return tarval_identify (tv);
 620 }
 621
 622 tarval *
 623 tarval_S_from_str (const char *s, size_t len)
 624 {
 625   tarval *tv;
 626
 627   assert (!BUILDING);
 628
 629   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 630
 631   tv->mode = mode_S;
 632   tv->u.s.n = len;
 633   tv->u.s.p = obstack_copy (&tv_obst, s, len);
 634
 635   return tarval_identify (tv);
 636 }
 637
 638 tarval *tarval_int_from_str (const char *s, size_t len, int base, ir_mode *m) {
 639   long val;
 640   char *eptr;
 641   char *buf;
 642
 643   assert (mode_is_int(m));
 644   assert (!BUILDING);
 645
 646   buf = alloca (len+1);
 647   stripcpy (buf, s, len);
 648
 649   errno = 0;
 650   val = strtol(buf, &eptr, base);    /* strtoll */
 651   assert (eptr == buf+strlen(buf));
 652   if ((errno == ERANGE)               &&
 653       ((m == mode_l) || (m == mode_L))  ) {
 654     printf("WARNING: Constant %s not representable. Continuing with %ld.\n",
 655            s, val);
 656   }
 657
 658   return tarval_from_long(m, val);
 659 }
 660
 661 /* Create a tarval with mode `m' and value `i' casted to the type that
 662    represents such tarvals on host.  The resulting value must be legal
 663    for mode `m'.  */
 664 tarval *
 665 tarval_from_long (ir_mode *m, long val)
 666 {
 667   tarval *tv;
 668
 669   assert (!BUILDING);
 670
 671   if (m == mode_T) return tarval_bad;
 672
 673   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 674
 675   tv->mode = m;
 676   switch (get_mode_modecode(m)) {
 677     /* floating */
 678   case irm_f:
 679     tv->u.f = val; break;
 680   case irm_d:
 681     tv->u.d = val; break;
 682     /* unsigned */
 683   case irm_C: case irm_H: case irm_I: case irm_L:
 684     tv->u.CHIL = val; break;
 685     /* signed */
 686   case irm_c: case irm_h: case irm_i: case irm_l:
 687     tv->u.chil = val; break;
 688   case irm_Z:
 689 #if _TARVAL_GMP_
 690     mpz_init_set_si (&tv->u.Z, val);
 691 #else
 692     assert(0 && "no support for Z in tv!");
 693 #endif
 694     break;
 695     /* strange */
 696   case irm_p:
 697     assert(!val);
 698     obstack_free (&tv_obst, tv);
 699     return tarval_p_void;
 700   case irm_b:
 701     tv->u.b = !!val;            /* u.b must be 0 or 1 */
 702     break;
 703   default:
 704     assert(0);
 705   }
 706
 707   return tarval_identify (tv);
 708 }
 709
 710
 711 tarval *
 712 tarval_p_from_str (const char *xname)
 713 {
 714   tarval *tv;
 715
 716   assert (!BUILDING);
 717
 718   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 719
 720   tv->mode = mode_p;
 721   tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
 722   tv->u.p.ent = NULL;
 723   tv->u.p.tv = NULL;
 724   return tarval_identify (tv);
 725 }
 726
 727
 728 tarval *
 729 tarval_p_from_entity (entity *ent)
 730 {
 731   tarval *tv;
 732
 733   assert (!BUILDING);
 734
 735   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 736
 737   tv->mode = mode_p;
 738   tv->u.p.xname = NULL;
 739   tv->u.p.ent = ent;
 740   tv->u.p.tv = NULL;
 741   return tarval_identify (tv);
 742 }
 743
 744
 745 /* Routines for building a tarval step by step follow.
 746    Legal calling sequences:
 747      tarval_start()
 748      No contructors except tarval_append() and tarval_append1 ()
 749      tarval_finish_as() or tarval_cancel() */
 750
 751 /* Begin building a tarval.  */
 752 void
 753 tarval_start (void)
 754 {
 755   assert (!BUILDING);
 756   obstack_blank (&tv_obst, sizeof (tarval));
 757 }
 758
 759
 760 /* Append `n' chars from `p' to the tarval currently under construction.  */
 761 void
 762 tarval_append (const char *p, size_t n)
 763 {
 764   assert (BUILDING);
 765   obstack_grow (&tv_obst, p, n);
 766 }
 767
 768
 769 /* Append `ch' to the tarval currently under construction.  */
 770 void
 771 tarval_append1 (char ch)
 772 {
 773   assert (BUILDING);
 774   obstack_1grow (&tv_obst, ch);
 775 }
 776
 777
 778 /* Finish the tarval currently under construction and give id mode `m'.
 779    `m' must be irm_C, irm_B, irm_s or irm_S.
 780    Return NULL if the value does not make sense for this mode, this
 781    can only happen in mode C.  */
 782 tarval *
 783 tarval_finish_as (ir_mode *m)
 784 {
 785   int size = obstack_object_size (&tv_obst) - sizeof (tarval);
 786   tarval *tv;
 787   unsigned char *p;
 788   char ch = 0;                  /* initialized to shut up gcc */
 789
 790   assert (BUILDING && (size >= 0));
 791   if (m == mode_C) {
 792     if (size != 1) return tarval_cancel();
 793     p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
 794     ch = *p;
 795     obstack_blank (&tv_obst, -size);
 796   }
 797   tv = obstack_finish (&tv_obst);
 798   p = (unsigned char *)tv + sizeof (tarval);
 799   tv->mode = m;
 800
 801   switch (get_mode_modecode(m)) {
 802   case irm_C:
 803     tv->u.CHIL = ch;
 804     break;
 805   case irm_B:
 806     tv->u.B.n = size;
 807     tv->u.B.p = p;
 808     break;
 809   case irm_s:
 810   case irm_S:
 811     tv->u.s.n = size;
 812     tv->u.s.p = p;
 813     break;
 814   case irm_p:
 815     tv->u.p.tv = NULL;
 816     break;
 817   default:
 818     assert (0);
 819   }
 820
 821   return tarval_identify (tv);
 822 }
 823
 824
 825 /* Cancel tarval building and return tarval_bad.  */
 826 tarval *
 827 tarval_cancel (void)
 828 {
 829   assert (BUILDING);
 830   obstack_free (&tv_obst, obstack_finish (&tv_obst));
 831   return tarval_bad;
 832 }
 833
 834
 835 \f
 836 /*** ****************** Arithmethic operations on tarvals ***************** ***/
 837
 838 /* Return `src' converted to mode `m' if representable, else NULL.
 839    @@@ lots of conversions missing */
 840 tarval *
 841 tarval_convert_to (tarval *src, ir_mode *m)
 842 {
 843   tarval *tv;
 844
 845   if (m == src->mode) return src;
 846
 847   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 848   tv->mode = m;
 849
 850   switch (get_mode_modecode(src->mode)) {
 851
 852   case irm_d:
 853     if (m != mode_f) goto fail;
 854     tv->u.f = src->u.d;
 855     break;
 856
 857   case irm_Z:
 858 #if _TARVAL_GMP_
 859     switch (get_mode_modecode(m)) {
 860
 861     case irm_C: case irm_H: case irm_I: case irm_L:
 862       if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail;
 863       if (mpz_size (&src->u.Z) > 1) goto fail;
 864       tv->u.CHIL = mpz_get_ui (&src->u.Z);
 865       if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
 866       break;
 867
 868     case irm_c: case irm_h: case irm_i: case irm_l:
 869       tv->u.chil = mpz_get_si (&src->u.Z);
 870       if (chil_overflow (tv->u.chil, m)) goto fail;
 871       break;
 872
 873     case irm_b:
 874       tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0);
 875       break;
 876
 877     case irm_p:
 878       if (mpz_cmp_ui (&src->u.Z, 0)) goto fail;
 879       obstack_free (&tv_obst, tv);
 880       return tarval_p_void;
 881
 882     default: goto fail;
 883     }
 884 #else
 885     goto fail;
 886 #endif
 887     break;
 888
 889   case irm_c: case irm_h: case irm_i: case irm_l:
 890     switch (get_mode_modecode(m)) {
 891     case irm_c: case irm_h: case irm_i: case irm_l:
 892       tv->u.chil = src->u.chil;
 893       if (chil_overflow (tv->u.chil, m)) goto fail;
 894       break;
 895
 896     case irm_C: case irm_H: case irm_I: case irm_L:
 897       tv->u.CHIL = src->u.chil;
 898       if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
 899       break;
 900
 901     case irm_Z:
 902 #if _TARVAL_GMP_
 903       mpz_init_set_si (&tv->u.Z, src->u.chil);
 904 #else
 905       goto fail;
 906 #endif
 907       break;
 908
 909     case irm_b:
 910       tv->u.b = !!src->u.chil;
 911       break;
 912
 913     default: goto fail;
 914     }
 915
 916   case irm_C: case irm_H: case irm_I: case irm_L:
 917     switch (get_mode_modecode(m)) {
 918     case irm_c: case irm_h: case irm_i: case irm_l:
 919       tv->u.chil = src->u.CHIL;
 920       if (chil_overflow (tv->u.chil, m)) goto fail;
 921       break;
 922
 923     case irm_C: case irm_H: case irm_I: case irm_L:
 924       tv->u.CHIL = src->u.CHIL;
 925       if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
 926       break;
 927
 928     case irm_Z:
 929 #if _TARVAL_GMP_
 930       mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
 931 #else
 932       goto fail;
 933 #endif
 934       break;
 935
 936     case irm_b:
 937       tv->u.b = !!src->u.CHIL;
 938       break;
 939
 940     default: goto fail;
 941     }
 942     break;
 943
 944   case irm_b:
 945     switch (get_mode_modecode(m)) {
 946     case irm_c: case irm_h: case irm_i: case irm_l:
 947       tv->u.chil = src->u.b;
 948       break;
 949
 950     case irm_C: case irm_H: case irm_I: case irm_L:
 951       tv->u.CHIL = src->u.b;
 952
 953     default: goto fail;
 954     }
 955     break;
 956
 957   default:
 958   fail:
 959     obstack_free (&tv_obst, tv);
 960     return NULL;
 961   }
 962
 963   return tarval_identify (tv);
 964 }
 965
 966
 967 /* GL Why are there no ArmRoq comments, why is this not used? */
 968 tarval *
 969 tarval_neg (tarval *a)
 970 {
 971   tarval *tv;
 972
 973   TARVAL_VRFY (a);
 974
 975   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
 976
 977   tv->mode = a->mode;
 978
 979   switch (get_mode_modecode(a->mode)) {
 980     /* floating */
 981   case irm_f: tv->u.f = -a->u.f; break;
 982   case irm_d: tv->u.d = -a->u.d; break;
 983     /* unsigned */
 984   case irm_C: case irm_H: case irm_I: case irm_L:
 985     tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (get_mode_max(a->mode));
 986     break;
 987     /* signed */
 988   case irm_c: case irm_h: case irm_i: case irm_l:
 989     tv->u.chil = -a->u.chil;
 990     if (   chil_overflow (tv->u.chil, a->mode)
 991         || ((tv->u.chil >= 0) == (a->u.chil >= 0))) {
 992       obstack_free (&tv_obst, tv);
 993       return NULL;
 994     }
 995     break;
 996   case irm_Z:
 997 #if _TARVAL_GMP_
 998     mpz_init (&tv->u.Z);
 999     mpz_neg (&tv->u.Z, &a->u.Z);
1000 #else
1001     obstack_free (&tv_obst, tv);
1002     tv = a;
1003     printf("\nWrong negation\n\n");
1004 #endif
1005     break;
1006     /* strange */
1007   case irm_b: tv->u.b = !a->u.b; break;
1008   default: assert(0);
1009   }
1010
1011   return tarval_identify (tv);
1012 }
1013
1014
1015 /* Compare `a' with `b'.
1016    Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
1017    result is unknown.  */
1018 ir_pncmp
1019 tarval_comp (tarval *a, tarval *b)
1020 {
1021
1022   TARVAL_VRFY (a);
1023   TARVAL_VRFY (b);
1024
1025   assert (a->mode == b->mode);
1026
1027   switch (get_mode_modecode(a->mode)) {
1028     /* floating */
1029   case irm_f: return (  a->u.f == b->u.f ? irpn_Eq
1030                       : a->u.f > b->u.f ? irpn_Gt
1031                       : a->u.f < b->u.f ? irpn_Lt
1032                       : irpn_Uo);
1033   case irm_d: return (  a->u.d == b->u.d ? irpn_Eq
1034                       : a->u.d > b->u.d ? irpn_Gt
1035                       : a->u.d < b->u.d ? irpn_Lt
1036                       : irpn_Uo);
1037     /* unsigned */
1038   case irm_C: case irm_H: case irm_I: case irm_L:
1039     return (  a->u.CHIL == b->u.CHIL ? irpn_Eq
1040             : a->u.CHIL > b->u.CHIL ? irpn_Gt
1041             : irpn_Lt);
1042     /* signed */
1043   case irm_c: case irm_h: case irm_i: case irm_l:
1044     return (  a->u.chil == b->u.chil ? irpn_Eq
1045             : a->u.chil > b->u.chil ? irpn_Gt
1046             : irpn_Lt);
1047   case irm_Z:
1048     {
1049 #if _TARVAL_GMP_
1050       int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
1051       return (  cmp == 0 ? irpn_Eq
1052               : cmp > 0 ? irpn_Gt
1053               : irpn_Lt);
1054 #else
1055       return irpn_False;
1056 #endif
1057     }
1058     /* strange */
1059   case irm_b: return (  a->u.b == b->u.b ? irpn_Eq
1060                       : a->u.b > b->u.b ? irpn_Gt
1061                       : irpn_Lt);
1062   /* The following assumes that pointers are unsigned, which is valid
1063      for all sane CPUs (transputers are insane). */
1064   case irm_p: return (  a == b ? irpn_Eq
1065                       : a == tarval_p_void ? irpn_Lt
1066                       : b == tarval_p_void ? irpn_Gt
1067                       : irpn_False); /* unknown */
1068   default: assert (0);
1069   }
1070 }
1071
1072
1073 /* Return `a+b' if computable, else NULL.  Modes must be equal.  */
1074 tarval *
1075 tarval_add (tarval *a, tarval *b)
1076 {
1077   tarval *tv;
1078
1079   TARVAL_VRFY (a); TARVAL_VRFY (b);
1080   assert (a->mode == b->mode);
1081
1082   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1083
1084   tv->mode = a->mode;
1085
1086   switch (get_mode_modecode(a->mode)) {
1087     /* floating */
1088   case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */
1089   case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */
1090     /* unsigned */
1091   case irm_C: case irm_H: case irm_I: case irm_L:
1092     tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1093     break;
1094     /* signed */
1095   case irm_c: case irm_h: case irm_i: case irm_l:
1096     tv->u.chil = a->u.chil + b->u.chil;
1097     if (   chil_overflow (tv->u.chil, a->mode)
1098         || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) {
1099       obstack_free (&tv_obst, tv);
1100       return NULL;
1101     }
1102     break;
1103   case irm_Z:
1104 #if _TARVAL_GMP_
1105     mpz_init (&tv->u.Z);
1106     mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
1107 #else
1108     obstack_free (&tv_obst, tv);
1109     return NULL;
1110 #endif
1111     break;
1112     /* strange */
1113   case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1114   default: assert(0);
1115   }
1116
1117   return tarval_identify (tv);
1118 }
1119
1120
1121 /* Return `a-b' if computable, else NULL.  Modes must be equal.  */
1122 tarval *
1123 tarval_sub (tarval *a, tarval *b)
1124 {
1125   tarval *tv;
1126
1127   TARVAL_VRFY (a); TARVAL_VRFY (b);
1128   assert (a->mode == b->mode);
1129
1130   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1131
1132   tv->mode = a->mode;
1133
1134   switch (get_mode_modecode(a->mode)) {
1135     /* floating */
1136   case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */
1137   case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */
1138     /* unsigned */
1139   case irm_C: case irm_H: case irm_I: case irm_L:
1140     tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1141     break;
1142     /* signed */
1143   case irm_c: case irm_h: case irm_i: case irm_l:
1144     tv->u.chil = a->u.chil - b->u.chil;
1145     if (   chil_overflow (tv->u.chil, a->mode)
1146         || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) {
1147       obstack_free (&tv_obst, tv);
1148       return NULL;
1149     }
1150     break;
1151   case irm_Z:
1152 #if _TARVAL_GMP_
1153     mpz_init (&tv->u.Z);
1154     mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
1155 #else
1156     obstack_free (&tv_obst, tv);
1157     return NULL;
1158 #endif
1159     break;
1160     /* strange */
1161   case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
1162   default: assert(0);
1163   }
1164
1165   return tarval_identify (tv);
1166 }
1167
1168 /* Return `a*b' if computable, else NULL.  Modes must be equal.  */
1169 tarval *
1170 tarval_mul (tarval *a, tarval *b)
1171 {
1172   tarval *tv;
1173
1174   TARVAL_VRFY (a); TARVAL_VRFY (b);
1175   assert (a->mode == b->mode);
1176
1177   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1178
1179   tv->mode = a->mode;
1180
1181   switch (get_mode_modecode(a->mode)) {
1182     /* floating */
1183   case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */
1184   case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */
1185     /* unsigned */
1186   case irm_C: case irm_H: case irm_I: case irm_L:
1187     tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1188     break;
1189     /* signed */
1190   case irm_c: case irm_h: case irm_i: case irm_l:
1191     tv->u.chil = a->u.chil * b->u.chil;
1192     if (   chil_overflow (tv->u.chil, a->mode)
1193         || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) {
1194       obstack_free (&tv_obst, tv);
1195       return NULL;
1196     }
1197     break;
1198   case irm_Z:
1199 #if _TARVAL_GMP_
1200     mpz_init (&tv->u.Z);
1201     mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
1202 #else
1203     obstack_free (&tv_obst, tv);
1204     return NULL;
1205 #endif
1206     break;
1207     /* strange */
1208   case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1209   default: assert(0);
1210   }
1211
1212   return tarval_identify (tv);
1213 }
1214
1215
1216 /* Return floating-point `a/b' if computable, else NULL.
1217    Modes must be equal, non-floating-point operands are converted to irm_d.  */
1218 tarval *
1219 tarval_quo (tarval *a, tarval *b)
1220 {
1221   tarval *tv;
1222
1223   TARVAL_VRFY (a); TARVAL_VRFY (b);
1224   assert (a->mode == b->mode);
1225
1226   switch (get_mode_modecode(a->mode)) {
1227     /* floating */
1228   case irm_f:
1229     tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1230     tv->mode = mode_f;
1231     tv->u.f = a->u.f / b->u.f;  /* @@@ overflow etc */
1232     break;
1233   case irm_d:
1234     tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1235     tv->mode = mode_d;
1236     tv->u.d = a->u.d / b->u.d;  /* @@@ overflow etc */
1237     break;
1238   default:
1239     a = tarval_convert_to (a, mode_d);
1240     b = tarval_convert_to (b, mode_d);
1241     return a && b ? tarval_quo (a, b) : NULL;
1242   }
1243
1244   return tarval_identify (tv);
1245 }
1246
1247
1248 /* Return `a/b' if computable, else NULL.  Modes must be equal.  */
1249 tarval *
1250 tarval_div (tarval *a, tarval *b)
1251 {
1252   tarval *tv;
1253
1254   TARVAL_VRFY (a); TARVAL_VRFY (b);
1255   assert (a->mode == b->mode);
1256
1257   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1258
1259   tv->mode = a->mode;
1260
1261   switch (get_mode_modecode(a->mode)) {
1262     /* floating */
1263   case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */
1264   case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */
1265     /* unsigned */
1266   case irm_C: case irm_H: case irm_I: case irm_L:
1267     if (!b->u.CHIL) goto fail;
1268     tv->u.CHIL = a->u.CHIL / b->u.CHIL;
1269     break;
1270     /* signed */
1271   case irm_c: case irm_h: case irm_i: case irm_l:
1272     if (   !b->u.chil
1273         || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (get_mode_max(a->mode)) ))) {
1274     fail:
1275       obstack_free (&tv_obst, tv);
1276       return NULL;
1277     }
1278     tv->u.chil = a->u.chil / b->u.chil;
1279     break;
1280   case irm_Z:
1281 #if _TARVAL_GMP_
1282     if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1283     mpz_init (&tv->u.Z);
1284     mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
1285 #else
1286     goto fail;
1287 #endif
1288     break;
1289     /* strange */
1290   case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1291   default: assert(0);
1292   }
1293
1294   return tarval_identify (tv);
1295 }
1296
1297
1298 /* Return `a%b' if computable, else NULL.  Modes must be equal.  */
1299 tarval *
1300 tarval_mod (tarval *a, tarval *b)
1301 {
1302   tarval *tv;
1303
1304   TARVAL_VRFY (a); TARVAL_VRFY (b);
1305   assert (a->mode == b->mode);
1306
1307   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1308
1309   tv->mode = a->mode;
1310
1311   switch (get_mode_modecode(a->mode)) {
1312     /* floating */
1313   case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */
1314   case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */
1315     /* unsigned */
1316   case irm_C: case irm_H: case irm_I: case irm_L:
1317     if (!b->u.CHIL) goto fail;
1318     tv->u.CHIL = a->u.CHIL % b->u.CHIL;
1319     break;
1320     /* signed */
1321   case irm_c: case irm_h: case irm_i: case irm_l:
1322     if (!b->u.chil) {
1323     fail:
1324       obstack_free (&tv_obst, tv);
1325       return NULL;
1326     }
1327     tv->u.chil = a->u.chil % b->u.chil;
1328     break;
1329   case irm_Z:
1330 #if _TARVAL_GMP_
1331     if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1332     mpz_init (&tv->u.Z);
1333     mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
1334 #else
1335     goto fail;
1336 #endif
1337     break;
1338     /* strange */
1339   case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1340   default: assert(0);
1341   }
1342
1343   return tarval_identify (tv);
1344 }
1345
1346 /* Return |a| if computable, else Null. */
1347 /*  is -max == min?? */
1348 tarval *
1349 tarval_abs (tarval *a) {
1350   TARVAL_VRFY (a);
1351   if (tv_is_negative(a)) return tarval_neg(a);
1352   return a;
1353 }
1354
1355 int
1356 tv_is_negative(tarval *a) {
1357   TARVAL_VRFY (a);
1358   switch (get_mode_modecode(a->mode)) {
1359     /* floating */
1360   case irm_f: return (a->u.f<0); break;
1361   case irm_d: return (a->u.d<0); break;
1362     /* unsigned */
1363   case irm_C: case irm_H: case irm_I: case irm_L:
1364     return 0;
1365     break;
1366     /* signed */
1367   case irm_c: case irm_h: case irm_i: case irm_l:
1368     return (a->u.chil < 0);
1369     break;
1370   case irm_Z:
1371     break;
1372   case irm_b: break;
1373   default: assert(0);
1374   }
1375
1376   return 0;
1377 }
1378
1379
1380 /* Return `a&b'.  Modes must be equal.  */
1381 tarval *
1382 tarval_and (tarval *a, tarval *b)
1383 {
1384   tarval *tv;
1385
1386   TARVAL_VRFY (a); TARVAL_VRFY (b);
1387   assert (a->mode == b->mode);
1388
1389   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1390
1391   tv->mode = a->mode;
1392
1393   switch (get_mode_modecode(a->mode)) {
1394     /* unsigned */
1395   case irm_C: case irm_H: case irm_I: case irm_L:
1396     tv->u.CHIL = a->u.CHIL & b->u.CHIL; break;
1397     /* signed */
1398   case irm_c: case irm_h: case irm_i: case irm_l:
1399     tv->u.chil = a->u.chil & b->u.chil; break;
1400   case irm_Z:
1401 #if _TARVAL_GMP_
1402     mpz_init (&tv->u.Z);
1403     mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
1404 #else
1405     assert(0);
1406 #endif
1407     break;
1408     /* strange */
1409   case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1410   default: assert(0);
1411   }
1412
1413   return tarval_identify (tv);
1414 }
1415
1416
1417 /* Return `a|b'.  Modes must be equal.  */
1418 tarval *
1419 tarval_or (tarval *a, tarval *b)
1420 {
1421   tarval *tv;
1422
1423   TARVAL_VRFY (a); TARVAL_VRFY (b);
1424   assert (a->mode == b->mode);
1425
1426   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1427
1428   tv->mode = a->mode;
1429
1430   switch (get_mode_modecode(a->mode)) {
1431     /* unsigned */
1432   case irm_C: case irm_H: case irm_I: case irm_L:
1433     tv->u.CHIL = a->u.CHIL | b->u.CHIL; break;
1434     /* signed */
1435   case irm_c: case irm_h: case irm_i: case irm_l:
1436     tv->u.chil = a->u.chil | b->u.chil; break;
1437   case irm_Z:
1438 #if _TARVAL_GMP_
1439     mpz_init (&tv->u.Z);
1440     mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
1441 #else
1442     assert(0);
1443 #endif
1444     break;
1445     /* strange */
1446   case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1447   default: assert(0);
1448   }
1449
1450   return tarval_identify (tv);
1451 }
1452
1453
1454 /* Return `a^b'.  Modes must be equal.  */
1455 tarval *
1456 tarval_eor (tarval *a, tarval *b)
1457 {
1458   tarval *tv;
1459
1460   TARVAL_VRFY (a); TARVAL_VRFY (b);
1461   assert (a->mode == b->mode);
1462
1463 #if 1 /* see case irm_Z below */
1464   if (a->mode == mode_Z) return NULL;
1465 #endif
1466
1467   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1468
1469   tv->mode = a->mode;
1470
1471   switch (get_mode_modecode(a->mode)) {
1472     /* unsigned */
1473   case irm_C: case irm_H: case irm_I: case irm_L:
1474     tv->u.CHIL = a->u.CHIL ^ b->u.CHIL; break;
1475     /* signed */
1476   case irm_c: case irm_h: case irm_i: case irm_l:
1477     tv->u.chil = a->u.chil ^ b->u.chil; break;
1478   case irm_Z:
1479 #if 0
1480     /* gmp-1.3.2 declares but does not define mpz_xor() */
1481     mpz_init (&tv->u.Z);
1482     mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
1483 #endif
1484     break;
1485     /* strange */
1486   case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1487   default: assert(0);
1488   }
1489
1490   return tarval_identify (tv);
1491 }
1492
1493
1494 /* Return `a<<b' if computable, else NULL.  */
1495 tarval *
1496 tarval_shl (tarval *a, tarval *b)
1497 {
1498   int b_is_huge;
1499   long shift;
1500   tarval *tv;
1501
1502   TARVAL_VRFY (a); TARVAL_VRFY (b);
1503
1504   shift = tarval_ord (b, &b_is_huge);
1505   if (   b_is_huge
1506       || (shift < 0)
1507       || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) {
1508     return NULL;
1509   }
1510
1511   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1512   tv->mode = a->mode;
1513
1514   switch (get_mode_modecode(a->mode)) {
1515     /* unsigned */
1516   case irm_C: case irm_H: case irm_I: case irm_L:
1517     tv->u.CHIL = a->u.CHIL << shift;
1518     break;
1519     /* signed */
1520   case irm_c: case irm_h: case irm_i: case irm_l:
1521     tv->u.chil = a->u.chil << shift;
1522     break;
1523   case irm_Z:
1524 #if _TARVAL_GMP_
1525     mpz_init (&tv->u.Z);
1526     mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
1527 #else
1528     assert(0);
1529 #endif
1530     break;
1531   default: assert (0);
1532   }
1533
1534   return tarval_identify (tv);
1535 }
1536
1537
1538 /* Return `a>>b' if computable, else NULL.
1539    The interpretation of >> (sign extended or not) is implementaion
1540    dependent, i.e. this is neither shr nor shrs!! */
1541 tarval *
1542 tarval_shr (tarval *a, tarval *b)
1543 {
1544   int b_is_huge;
1545   long shift;
1546   tarval *tv;
1547
1548   TARVAL_VRFY (a); TARVAL_VRFY (b);
1549
1550   shift = tarval_ord (b, &b_is_huge);
1551   if (   b_is_huge
1552       || (shift < 0)
1553       || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) {
1554     return NULL;
1555   }
1556
1557   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1558   tv->mode = a->mode;
1559
1560   switch (get_mode_modecode(a->mode)) {
1561     /* unsigned */
1562   case irm_C: case irm_H: case irm_I: case irm_L:
1563     tv->u.CHIL = a->u.CHIL >> shift;
1564     break;
1565     /* signed */
1566   case irm_c: case irm_h: case irm_i: case irm_l:
1567     tv->u.chil = a->u.chil >> shift;
1568     break;
1569   case irm_Z:
1570 #if _TARVAL_GMP_
1571     mpz_init (&tv->u.Z);
1572     mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
1573 #else
1574     assert(0);
1575 #endif
1576     break;
1577   default: assert (0);
1578   }
1579
1580   return tarval_identify (tv);
1581 }
1582
1583
1584 /* Classify `tv', which may be NULL.
1585    Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1586    multiplicative neutral element, and -1 if `tv' is the neutral
1587    element of bitwise and.  */
1588 long
1589 tarval_classify (tarval *tv)
1590 {
1591   if (!tv) return 2;
1592
1593   TARVAL_VRFY (tv);
1594
1595   switch (get_mode_modecode(tv->mode)) {
1596     /* floating */
1597   case irm_f: case irm_d:
1598     return 2;
1599     /* unsigned */
1600   case irm_C:
1601     return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_C))) - 1;
1602   case irm_H:
1603     return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_H))) - 1;
1604   case irm_I:
1605     return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_I))) - 1;
1606   case irm_L:
1607     return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_L))) - 1;
1608     /* signed */
1609   case irm_c: case irm_h: case irm_i: case irm_l:
1610     return tv->u.chil;
1611   case irm_Z:
1612 #if _TARVAL_GMP_
1613     if      (mpz_cmp_si (&tv->u.Z, 0)) return 0;
1614     else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
1615     else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
1616 #endif
1617     return 2;
1618     /* strange */
1619   case irm_b:
1620     return tv->u.b;
1621   default:
1622     return 2;
1623   }
1624 }
1625
1626
1627 #if _TARVAL_GMP_
1628 bool
1629 tarval_s_fits (tarval *tv, long min, long max) {
1630   return ((  mpz_cmp_si (&tv->u.Z, min) >= 0)
1631           && mpz_cmp_si (&tv->u.Z, max) <= 0);
1632 }
1633
1634 bool
1635 tarval_u_fits (tarval *tv, unsigned long max) {
1636   return ((  mpz_sgn (&tv->u.Z) >= 0)
1637           && mpz_cmp_si (&tv->u.Z, max) <= 0);
1638 }
1639 #endif
1640
1641 /* Convert `tv' into type `long', set `fail' if not representable.
1642    If `fail' gets set for an unsigned `tv', the correct result can be
1643    obtained by casting the result to `unsigned long'.  */
1644 long
1645 tarval_ord (tarval *tv, int *fail)
1646 {
1647   TARVAL_VRFY (tv);
1648
1649   switch (get_mode_modecode(tv->mode)) {
1650     /* unsigned */
1651   case irm_C: case irm_H: case irm_I: case irm_L:
1652     *fail = tv->u.CHIL > tv_val_CHIL (get_mode_max(mode_l));
1653     return tv->u.CHIL;
1654     /* signed */
1655   case irm_c: case irm_h: case irm_i: case irm_l:
1656     *fail = 0;
1657     return tv->u.chil;
1658   case irm_Z:
1659 #if _TARVAL_GMP_
1660     *fail = (   (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) > 0)
1661              || (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) < 0));
1662     return mpz_get_si (&tv->u.Z);
1663 #else
1664     *fail = 1;
1665     return 0;
1666 #endif
1667     /* strange */
1668   case irm_b:
1669     *fail = 0;
1670     return tv->u.b;
1671   default: ;
1672     *fail = 1;
1673     return 0;
1674   }
1675 }
1676
1677 \f
1678 int
1679 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1680 {
1681   tarval *val = XP_GETARG (tarval *, 0);
1682   int printed;
1683   char buf[40];
1684
1685   TARVAL_VRFY (val);
1686
1687   switch (get_mode_modecode(val->mode)) {
1688
1689   case irm_T:                   /* none */
1690     printed = XPSR ("<bad>");
1691     break;
1692
1693   case irm_f:                   /* float */
1694     sprintf (buf, "%1.9e", (float)(val->u.f));
1695     printed = XPF1R ("%s", buf);
1696     break;
1697   case irm_d:                   /* double */
1698     printed = XPF1R ("%1.30g", (double)(val->u.d));
1699     break;
1700
1701   case irm_c:                   /* signed char */
1702   case irm_C:                   /* unsigned char */
1703     if ((isprint (val->u.chil)) &&
1704         (val->u.chil != '\\')   && (val->u.chil != '\'')) {
1705       printed = XPF1R ("'%c'", val->u.chil);
1706     } else {
1707       printed = XPF1R ("0x%x", (unsigned long)val->u.chil);
1708     }
1709     break;
1710
1711   case irm_h: case irm_i: case irm_l: /* signed num */
1712     printed = XPF1R ("%ld", (long)val->u.chil);
1713     break;
1714   case irm_H: case irm_I: case irm_L: /* unsigned num */
1715     printed = XPF1R ("%lu", (unsigned long)val->u.CHIL);
1716     break;
1717
1718   case irm_Z:                   /* mp int */
1719     printed = XPF1R ("%Z", &val->u.Z);
1720     break;
1721
1722   case irm_p:                   /* pointer */
1723     if (val->u.p.xname) {
1724       printed = XPR (val->u.p.xname);
1725     } else if (val->u.p.ent) {
1726       if (get_entity_peculiarity(val->u.p.ent) == existent)
1727         printed = XPF1R ("&(%I)", get_entity_ld_ident(val->u.p.ent));
1728       else
1729         printed = XPSR ("(NULL)");
1730     } else {
1731       assert (val == tarval_p_void);
1732       printed = XPSR ("(void)");
1733     }
1734     break;
1735
1736   case irm_b:                   /* boolean */
1737     if (val->u.b) printed = XPSR ("true");
1738     else          printed = XPSR ("false");
1739     break;
1740
1741   case irm_B:                   /* universal bits */
1742     printed = XPSR ("<@@@ some bits>");
1743     break;
1744
1745   case irm_s:                   /* string */
1746   case irm_S:
1747     { size_t i;
1748       char *buf = alloca (val->u.s.n + 2);
1749       char *bp;
1750
1751       printed = 0;
1752       buf[0] = '\'';
1753       bp = buf + 1;
1754       for (i = 0;  i < val->u.s.n;  ++i) {
1755         if (isprint (val->u.s.p[i])) {
1756           *bp++ = val->u.s.p[i];
1757         } else {
1758           if (bp != buf) {
1759             XPM (buf, bp-buf);
1760             bp = buf;
1761           }
1762           XPF1 ("'\\%03o'", val->u.s.p[i]);
1763         }
1764       }
1765       *bp++ = '\'';
1766       XPM (buf, bp-buf);
1767       break;
1768     }
1769
1770
1771   case irm_M:                   /* memory */
1772   case irm_R:                   /* region */
1773   default:
1774     assert (0);
1775   }
1776
1777   return printed;
1778 }
1779
1780
1781 ir_mode *
1782 get_tv_mode (tarval *tv)
1783 {
1784   return tv->mode;
1785 }
1786
1787 /* Returns the entity if the tv is a pointer to an entity, else
1788    returns NULL; */
1789 entity *get_tv_entity(tarval *tv) {
1790   entity *ent = NULL;
1791
1792   if (tv->mode == mode_p) {
1793     if (tv->u.p.xname) {
1794       assert(0);
1795       /* not an entity */
1796     } else if (tv->u.p.ent) {
1797       ent = tv->u.p.ent;
1798     } else {
1799       /* not an entity */
1800     }
1801   }
1802   return ent;
1803 }