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