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