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