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