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