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