nsz Git - libfirm/blob - ir/tv/tv.c

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