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