1 /* TV --- Target Values, aka Constant Table.
2 Copyright (C) 1995, 1996 Christian von Roques */
4 /* This implementation assumes:
5 * target characters/strings can be represented as type `char'/`char *',
6 * host's type `long'/`unsigned long' can hold values of mode `l'/`L',
7 * both host and target have two's complement integral arithmetic,
8 host's C operators `/' and `%' match target's div and mod.
9 target_max_<mode> == (1<<k)-1 for some k>0
10 target_min_<mode> == -target_max_<mode>-1
11 target_max_<Mode> == target_max_<mode>-target_min_<mode>
12 * both host and target have IEEE-754 floating-point arithmetic. */
14 /* !!! float and double divides MUST NOT SIGNAL !!! */
15 /* @@@ query the floating-point expception status flags */
17 /* @@@ ToDo: tarval_convert_to is not fully implemented! */
18 /* @@@ Problem: All Values are stored twice, once as Univ_*s and a 2nd
19 time in their real target mode. :-( */
20 /* @@@ Perhaps use a set instead of a pset: new tarvals allocated on
21 stack, copied into set by tarval_identify() if really new. If
22 tarval_identify() discards often enough, the extra copy for kept
23 values is cheaper than the extra obstack_alloc()/free() for
39 #define TOBSTACK_ID "tv"
46 static struct obstack tv_obst; /* obstack for all the target values */
47 static pset *tarvals; /* pset containing pointers to _all_ tarvals */
49 /* currently building an object with tarval_start() & friends ? */
50 #define BUILDING obstack_object_size (&tv_obst)
52 /* special tarvals: */
54 tarval *tarval_b_false;
55 tarval *tarval_b_true;
58 tarval *tarval_p_void;
59 tarval *tarval_mode_null[irm_max];
62 /* @@@ depends on order of ir_mode */
63 static tarval_chil min_chil[8] = {
69 static tarval_chil max_chil[8] = {
70 TARGET_SIMAX (c), TARGET_UIMAX (C),
71 TARGET_SIMAX (h), TARGET_UIMAX (H),
72 TARGET_SIMAX (i), TARGET_UIMAX (I),
73 TARGET_SIMAX (l), TARGET_UIMAX (L)
77 /* return a mode-specific value */
92 tv_val_chil (tarval *tv)
98 tv_val_CHIL (tarval *tv)
104 tv_val_Z (tarval *tv)
110 tv_val_p (tarval *tv)
116 tv_val_b (tarval *tv)
122 tv_val_B (tarval *tv)
128 tv_val_s (tarval *tv)
134 /* Overflows `chil' signed integral `mode'? */
136 chil_overflow (tarval_chil chil, ir_mode *mode)
138 assert (is_chilCHIL(mode->code));
139 return (mode->min && mode->max /* only valid after firm initialization */
140 && (chil < tv_val_chil (mode->min) || tv_val_chil (mode->max) < chil));
144 /* Overflows `CHIL' unsigned integral `mode'? */
146 CHIL_overflow (tarval_CHIL CHIL, ir_mode *mode)
148 assert (is_chilCHIL(mode->code));
149 return (mode->max /* only valid after firm initialization */
150 && tv_val_CHIL (mode->max) < CHIL);
156 _tarval_vrfy (const tarval *val)
159 switch (val->mode->code) {
165 case irm_C: case irm_H: case irm_I: case irm_L:
166 assert (!CHIL_overflow (val->u.CHIL, val->mode)); break;
167 case irm_c: case irm_h: case irm_i: case irm_l:
168 assert (!chil_overflow (val->u.chil, val->mode)); break;
174 assert (val->u.p.ent->kind == k_entity);
175 assert ( val->u.p.xname || val->u.p.ent
176 || !tarval_p_void || (val == tarval_p_void));
180 assert (val->u.s.p); break;
182 assert (val->u.B.p); break;
184 assert ((unsigned)val->u.b <= 1); break;
186 assert (val->mode == mode_T);
197 pset_stats (tarvals);
203 /* Return the canonical tarval * for tv.
204 May destroy everything allocated on tv_obst after tv! */
206 tarval_identify (tarval *tv)
210 o = pset_insert (tarvals, tv, tarval_hash (tv));
213 obstack_free (&tv_obst, (void *)tv);
221 /* Return 0 iff a equals b. Bitwise identical NaNs compare equal. */
223 tarval_cmp (const void *p, const void *q)
231 if (a == b) return 0;
232 if (a->mode - b->mode) return a->mode - b->mode;
234 switch (a->mode->code) {
237 return memcmp (&a->u.f, &b->u.f, sizeof (a->u.f));
239 return memcmp (&a->u.d, &b->u.d, sizeof (a->u.d));
241 case irm_C: case irm_H: case irm_I: case irm_L:
242 if (sizeof (int) == sizeof (tarval_CHIL)) {
243 return a->u.CHIL - b->u.CHIL;
245 return a->u.CHIL != b->u.CHIL;
247 case irm_c: case irm_h: case irm_i: case irm_l:
248 if (sizeof (int) == sizeof (tarval_chil)) {
249 return a->u.chil - b->u.chil;
251 return a->u.chil != b->u.chil;
253 return mpz_cmp (&a->u.Z, &b->u.Z);
256 if (a->u.p.ent || b->u.p.ent)
257 return (char *)a->u.p.ent - (char *)b->u.p.ent;
258 if (a->u.p.xname && b->u.p.xname)
259 return strcmp (a->u.p.xname, b->u.p.xname);
260 return a->u.p.xname - b->u.p.xname;
262 return a->u.b - b->u.b;
264 return ( a->u.B.n - b->u.B.n
265 ? memcmp (a->u.B.p, b->u.B.p, a->u.B.n)
266 : a->u.B.n - b->u.B.n);
267 case irm_s: case irm_S:
268 return ( a->u.s.n == b->u.s.n
269 ? memcmp (a->u.s.p, b->u.s.p, a->u.s.n)
270 : a->u.s.n - b->u.s.n);
277 tarval_hash (tarval *tv)
281 h = tv->mode->code * 0x421u;
282 switch (tv->mode->code) {
284 h = 0x94b527ce; break;
287 { union { float f; unsigned u; } u;
288 assert (sizeof (float) <= sizeof (unsigned));
289 u.u = 0; u.f = tv->u.f;
295 { union { double d; unsigned u[2]; } u;
296 assert (sizeof (double) <= 2*sizeof (unsigned));
297 u.u[0] = u.u[1] = 0; u.d = tv->u.d;
298 h ^= u.u[0] ^ u.u[1];
301 case irm_C: case irm_H: case irm_I: case irm_L:
302 h ^= tv->u.CHIL; break;
303 case irm_c: case irm_h: case irm_i: case irm_l:
304 h ^= tv->u.chil; break;
306 h ^= mpz_get_ui (&tv->u.Z); break;
309 /* @@@ lower bits not random, watch for collisions; perhaps
310 replace by tv->u.p.ent - (entity *)0 */
311 h ^= ((char *)tv->u.p.ent - (char *)0) / 64;
312 } else if (tv->u.p.xname) {
313 /* Of course, strlen() in a hash function is a mistake, but this
314 case should be really rare. */
315 h ^= ID_HASH (tv->u.p.xname, strlen (tv->u.p.xname));
323 h ^= tv->u.B.n; break; /* @@@ not really good */
325 h ^= tv->u.s.p[0]<<12 ^ tv->u.s.p[tv->u.s.n]<<4 ^ tv->u.s.n; break;
327 h ^= tv->u.s.p[0]<<4 ^ tv->u.s.p[tv->u.s.n]<<12 ^ tv->u.s.n; break;
336 /******************** Initialization ****************************************/
341 obstack_init (&tv_obst);
342 obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1;
343 assert (IS_POW2 (ALIGNOF (tarval)));
345 /* initialize the target value table */
346 tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS);
353 union ieee754_double x;
355 /* assumed by tarval_hash(): */
356 assert (sizeof (float) * CHAR_BIT == 32);
357 assert (sizeof (double) * CHAR_BIT == 64);
360 /* assumed by tarval_chil & friends: */
361 assert ( (irm_C == irm_c+1) && (irm_h == irm_C+1)
362 && (irm_H == irm_h+1) && (irm_i == irm_H+1)
363 && (irm_I == irm_i+1) && (irm_l == irm_I+1)
364 && (irm_L == irm_l+1));
366 /* assumed everywhere: */
367 for (i = 0; i <= irm_L-irm_c; i += 2) {
368 assert ( IS_POW2 (max_chil[i+1]+1)
369 && (min_chil[i] == -max_chil[i]-1)
370 && ((tarval_CHIL)max_chil[i+1] == (tarval_CHIL)max_chil[i]-min_chil[i]));
375 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
378 tarval_bad = tarval_identify (tv);
380 tarval_b_false = tarval_from_long (mode_b, 0);
381 tarval_b_true = tarval_from_long (mode_b, 1);
383 /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
384 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
388 x.ieee.exponent = 0x7ff;
389 x.ieee.mantissa0 = 0;
390 x.ieee.mantissa1 = 0;
392 tarval_d_Inf = tarval_identify (tv);
394 /* IsNaN <-> exponent==0x7ff && (qnan_bit | bits | fraction_low) */
395 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
398 x.ieee_nan.negative = 0;
399 x.ieee_nan.exponent = 0x7ff;
400 x.ieee_nan.quiet_nan = 1; /* @@@ quiet or signalling? */
401 x.ieee_nan.mantissa0 = 42;
402 x.ieee_nan.mantissa1 = 0;
403 assert(x.d != x.d /* x.d is NaN */);
405 tarval_d_NaN = tarval_identify (tv);
407 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
410 tv->u.p.xname = NULL;
413 tarval_p_void = tarval_identify (tv);
415 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
418 tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0);
419 tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0);
420 tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0);
421 tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
422 tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0);
423 tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0);
424 tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0);
425 tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0);
426 tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0);
427 tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0);
428 tarval_mode_null [irm_b] = tarval_b_false;
429 tarval_mode_null [irm_p] = tarval_p_void;
434 /************************* Constructors for tarvals *************************/
436 /* copy from src to dst len chars omitting '_'. */
438 stripcpy (char *dst, const char *src, size_t len)
443 if (*src == '_') src++;
446 *d = 0; /* make it 0-terminated. */
453 tarval_Z_from_str (const char *s, size_t len, int base)
460 buf = alloca (len+1);
461 stripcpy (buf, s, len);
463 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
466 if (mpz_init_set_str (&tv->u.Z, buf, base)) assert (0);
468 return tarval_identify (tv);
473 tarval_B_from_str (const char *s, size_t len)
476 size_t n; /* size of B */
477 const char *r; /* read ptr */
478 unsigned x; /* bit store */
479 int b; /* bits in x */
480 int shift; /* base shift */
485 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
489 assert (s[0] == '0');
492 case 'O': shift = 3; break;
494 case 'X': shift = 4; break;
498 r = s+len; /* set r past input */
499 s += 2; /* skip header */
504 if (*r == '_') continue; /* skip _ styropor */
505 if (('0' <= *r) && (*r <= '9')) {
507 } else if (('a' <= *r) && (*r <= 'f')) {
509 } else { assert (('A' <= *r) && (*r <= 'F'));
513 x |= d << b; /* insert d into x above the b present bits */
514 b += shift; /* x now contains shift more bits */
516 if (b >= 8) { /* we've accumulated at least a byte */
517 char c = x & 0xFF; /* extract the lower 8 bits from x */
518 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
519 x >>= 8; /* remove the lower 8 bits from x */
520 b -= 8; /* x now contains 8 bits fewer */
521 ++n; /* B grew a byte */
525 if (b >= 0) { /* flush the rest of the bits */
526 char c = x; /* extract them */
527 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
528 ++n; /* B grew a byte */
531 { unsigned char *p = obstack_finish (&tv_obst);
532 unsigned char *q = p + n;
536 /* reverse p in place */
537 while (p < q) { char c = *p; *p++ = *q; *q-- = c; }
540 return tarval_identify (tv);
545 tarval_d_from_str (const char *s, size_t len)
553 buf = alloca (len+1);
554 stripcpy (buf, s, len);
556 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
559 tv->u.d = strtod (buf, &eptr);
560 assert (eptr == buf+strlen(buf));
562 return tarval_identify (tv);
567 tarval_s_from_str (const char *s, size_t len)
573 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
578 tv->u.s.p = obstack_copy (&tv_obst, s, len);
580 return tarval_identify (tv);
584 tarval_S_from_str (const char *s, size_t len)
590 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
595 tv->u.s.p = obstack_copy (&tv_obst, s, len);
597 return tarval_identify (tv);
601 /* Create a tarval with mode `m' and value `i' casted to the type that
602 represents such tarvals on host. The resulting value must be legal
605 tarval_from_long (ir_mode *m, long val)
611 if (m == mode_T) return tarval_bad;
613 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
620 tv->u.f = val; break;
622 tv->u.d = val; break;
624 case irm_C: case irm_H: case irm_I: case irm_L:
625 tv->u.CHIL = val; break;
627 case irm_c: case irm_h: case irm_i: case irm_l:
628 tv->u.chil = val; break;
630 mpz_init_set_si (&tv->u.Z, val);
635 obstack_free (&tv_obst, tv);
636 return tarval_p_void;
638 tv->u.b = !!val; /* u.b must be 0 or 1 */
644 return tarval_identify (tv);
649 tarval_p_from_str (const char *xname)
655 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
659 tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
662 return tarval_identify (tv);
667 tarval_p_from_entity (entity *ent)
673 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
677 tv->u.p.xname = NULL;
680 return tarval_identify (tv);
684 /* Routines for building a tarval step by step follow.
685 Legal calling sequences:
687 No contructors except tarval_append() and tarval_append1 ()
688 tarval_finish_as() or tarval_cancel() */
690 /* Begin building a tarval. */
695 obstack_blank (&tv_obst, sizeof (tarval));
699 /* Append `n' chars from `p' to the tarval currently under construction. */
701 tarval_append (const char *p, size_t n)
704 obstack_grow (&tv_obst, p, n);
708 /* Append `ch' to the tarval currently under construction. */
710 tarval_append1 (char ch)
713 obstack_1grow (&tv_obst, ch);
717 /* Finish the tarval currently under construction and give id mode `m'.
718 `m' must be irm_C, irm_B, irm_s or irm_S.
719 Return NULL if the value does not make sense for this mode, this
720 can only happen in mode C. */
722 tarval_finish_as (ir_mode *m)
724 int size = obstack_object_size (&tv_obst) - sizeof (tarval);
727 char ch = 0; /* initialized to shut up gcc */
729 assert (BUILDING && (size >= 0));
731 if (size != 1) return tarval_cancel();
732 p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
734 obstack_blank (&tv_obst, -size);
736 tv = obstack_finish (&tv_obst);
737 p = (unsigned char *)tv + sizeof (tarval);
761 return tarval_identify (tv);
765 /* Cancel tarval building and return tarval_bad. */
770 obstack_free (&tv_obst, obstack_finish (&tv_obst));
776 /********************* Arithmethic operations on tarvals ********************/
778 /* Return `src' converted to mode `m' if representable, else NULL.
779 @@@ lots of conversions missing */
781 tarval_convert_to (tarval *src, ir_mode *m)
785 if (m == src->mode) return src;
787 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
791 switch (src->mode->code) {
794 if (m != mode_f) goto fail;
801 case irm_C: case irm_H: case irm_I: case irm_L:
802 if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail;
803 if (mpz_size (&src->u.Z) > 1) goto fail;
804 tv->u.CHIL = mpz_get_ui (&src->u.Z);
805 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
808 case irm_c: case irm_h: case irm_i: case irm_l:
809 tv->u.chil = mpz_get_si (&src->u.Z);
810 if (chil_overflow (tv->u.chil, m)) goto fail;
814 tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0);
818 if (mpz_cmp_ui (&src->u.Z, 0)) goto fail;
819 obstack_free (&tv_obst, tv);
820 return tarval_p_void;
826 case irm_c: case irm_h: case irm_i: case irm_l:
828 case irm_c: case irm_h: case irm_i: case irm_l:
829 tv->u.chil = src->u.chil;
830 if (chil_overflow (tv->u.chil, m)) goto fail;
833 case irm_C: case irm_H: case irm_I: case irm_L:
834 tv->u.CHIL = src->u.chil;
835 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
839 mpz_init_set_si (&tv->u.Z, src->u.chil);
843 tv->u.b = !!src->u.chil;
849 case irm_C: case irm_H: case irm_I: case irm_L:
851 case irm_c: case irm_h: case irm_i: case irm_l:
852 tv->u.chil = src->u.CHIL;
853 if (chil_overflow (tv->u.chil, m)) goto fail;
856 case irm_C: case irm_H: case irm_I: case irm_L:
857 tv->u.CHIL = src->u.CHIL;
858 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
862 mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
866 tv->u.b = !!src->u.CHIL;
875 case irm_c: case irm_h: case irm_i: case irm_l:
876 tv->u.chil = src->u.b;
879 case irm_C: case irm_H: case irm_I: case irm_L:
880 tv->u.CHIL = src->u.b;
888 obstack_free (&tv_obst, tv);
892 return tarval_identify (tv);
897 tarval_neg (tarval *a)
903 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
908 switch (a->mode->code) {
910 case irm_f: tv->u.f = -a->u.f; break;
911 case irm_d: tv->u.d = -a->u.d; break;
913 case irm_C: case irm_H: case irm_I: case irm_L:
914 tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (a->mode->max);
917 case irm_c: case irm_h: case irm_i: case irm_l:
918 tv->u.chil = -a->u.chil;
919 if ( chil_overflow (tv->u.chil, a->mode)
920 || ((tv->u.chil >= 0) == (a->u.chil >= 0))) {
921 obstack_free (&tv_obst, tv);
927 mpz_neg (&tv->u.Z, &a->u.Z);
930 case irm_b: tv->u.b = !a->u.b; break;
934 return tarval_identify (tv);
938 /* Compare `a' with `b'.
939 Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
940 result is unknown. */
942 tarval_comp (tarval *a, tarval *b)
948 assert (a->mode == b->mode);
950 switch (a->mode->code) {
952 case irm_f: return ( a->u.f == b->u.f ? irpn_Eq
953 : a->u.f > b->u.f ? irpn_Gt
954 : a->u.f < b->u.f ? irpn_Lt
956 case irm_d: return ( a->u.d == b->u.d ? irpn_Eq
957 : a->u.d > b->u.d ? irpn_Gt
958 : a->u.d < b->u.d ? irpn_Lt
961 case irm_C: case irm_H: case irm_I: case irm_L:
962 return ( a->u.CHIL == b->u.CHIL ? irpn_Eq
963 : a->u.CHIL > b->u.CHIL ? irpn_Gt
966 case irm_c: case irm_h: case irm_i: case irm_l:
967 return ( a->u.chil == b->u.chil ? irpn_Eq
968 : a->u.chil > b->u.chil ? irpn_Gt
971 { int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
972 return ( cmp == 0 ? irpn_Eq
977 case irm_b: return ( a->u.b == b->u.b ? irpn_Eq
978 : a->u.b > b->u.b ? irpn_Gt
980 /* The following assumes that pointers are unsigned, which is valid
981 for all sane CPUs (transputers are insane). */
982 case irm_p: return ( a == b ? irpn_Eq
983 : a == tarval_p_void ? irpn_Lt
984 : b == tarval_p_void ? irpn_Gt
985 : irpn_False); /* unknown */
991 /* Return `a+b' if computable, else NULL. Modes must be equal. */
993 tarval_add (tarval *a, tarval *b)
997 TARVAL_VRFY (a); TARVAL_VRFY (b);
998 assert (a->mode == b->mode);
1000 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1005 switch (a->mode->code) {
1007 case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */
1008 case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */
1010 case irm_C: case irm_H: case irm_I: case irm_L:
1011 tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (a->mode->max);
1014 case irm_c: case irm_h: case irm_i: case irm_l:
1015 tv->u.chil = a->u.chil + b->u.chil;
1016 if ( chil_overflow (tv->u.chil, a->mode)
1017 || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) {
1018 obstack_free (&tv_obst, tv);
1023 mpz_init (&tv->u.Z);
1024 mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
1027 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1031 return tarval_identify (tv);
1035 /* Return `a-b' if computable, else NULL. Modes must be equal. */
1037 tarval_sub (tarval *a, tarval *b)
1041 TARVAL_VRFY (a); TARVAL_VRFY (b);
1042 assert (a->mode == b->mode);
1044 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1049 switch (a->mode->code) {
1051 case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */
1052 case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */
1054 case irm_C: case irm_H: case irm_I: case irm_L:
1055 tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (a->mode->max);
1058 case irm_c: case irm_h: case irm_i: case irm_l:
1059 tv->u.chil = a->u.chil - b->u.chil;
1060 if ( chil_overflow (tv->u.chil, a->mode)
1061 || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) {
1062 obstack_free (&tv_obst, tv);
1067 mpz_init (&tv->u.Z);
1068 mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
1071 case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
1075 return tarval_identify (tv);
1079 /* Return `a*b' if computable, else NULL. Modes must be equal. */
1081 tarval_mul (tarval *a, tarval *b)
1085 TARVAL_VRFY (a); TARVAL_VRFY (b);
1086 assert (a->mode == b->mode);
1088 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1093 switch (a->mode->code) {
1095 case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */
1096 case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */
1098 case irm_C: case irm_H: case irm_I: case irm_L:
1099 tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (a->mode->max);
1102 case irm_c: case irm_h: case irm_i: case irm_l:
1103 tv->u.chil = a->u.chil * b->u.chil;
1104 if ( chil_overflow (tv->u.chil, a->mode)
1105 || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) {
1106 obstack_free (&tv_obst, tv);
1111 mpz_init (&tv->u.Z);
1112 mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
1115 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1119 return tarval_identify (tv);
1123 /* Return floating-point `a/b' if computable, else NULL.
1124 Modes must be equal, non-floating-point operands are converted to irm_d. */
1126 tarval_quo (tarval *a, tarval *b)
1130 TARVAL_VRFY (a); TARVAL_VRFY (b);
1131 assert (a->mode == b->mode);
1133 switch (a->mode->code) {
1136 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1139 tv->u.f = a->u.f / b->u.f; /* @@@ overflow etc */
1142 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1145 tv->u.d = a->u.d / b->u.d; /* @@@ overflow etc */
1148 a = tarval_convert_to (a, mode_d);
1149 b = tarval_convert_to (b, mode_d);
1150 return a && b ? tarval_quo (a, b) : NULL;
1153 return tarval_identify (tv);
1157 /* Return `a/b' if computable, else NULL. Modes must be equal. */
1159 tarval_div (tarval *a, tarval *b)
1163 TARVAL_VRFY (a); TARVAL_VRFY (b);
1164 assert (a->mode == b->mode);
1166 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1171 switch (a->mode->code) {
1173 case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */
1174 case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */
1176 case irm_C: case irm_H: case irm_I: case irm_L:
1177 if (!b->u.CHIL) goto fail;
1178 tv->u.CHIL = a->u.CHIL / b->u.CHIL;
1181 case irm_c: case irm_h: case irm_i: case irm_l:
1183 || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (a->mode->max) ))) {
1185 obstack_free (&tv_obst, tv);
1188 tv->u.chil = a->u.chil / b->u.chil;
1191 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1192 mpz_init (&tv->u.Z);
1193 mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
1196 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1200 return tarval_identify (tv);
1204 /* Return `a%b' if computable, else NULL. Modes must be equal. */
1206 tarval_mod (tarval *a, tarval *b)
1210 TARVAL_VRFY (a); TARVAL_VRFY (b);
1211 assert (a->mode == b->mode);
1213 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1218 switch (a->mode->code) {
1220 case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */
1221 case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */
1223 case irm_C: case irm_H: case irm_I: case irm_L:
1224 if (!b->u.CHIL) goto fail;
1225 tv->u.CHIL = a->u.CHIL % b->u.CHIL;
1228 case irm_c: case irm_h: case irm_i: case irm_l:
1231 obstack_free (&tv_obst, tv);
1234 tv->u.chil = a->u.chil % b->u.chil;
1237 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1238 mpz_init (&tv->u.Z);
1239 mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
1242 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1246 return tarval_identify (tv);
1250 /* Return `a&b'. Modes must be equal. */
1252 tarval_and (tarval *a, tarval *b)
1256 TARVAL_VRFY (a); TARVAL_VRFY (b);
1257 assert (a->mode == b->mode);
1259 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1264 switch (a->mode->code) {
1266 case irm_C: case irm_H: case irm_I: case irm_L:
1267 tv->u.CHIL = a->u.CHIL & b->u.CHIL; break;
1269 case irm_c: case irm_h: case irm_i: case irm_l:
1270 tv->u.chil = a->u.chil & b->u.chil; break;
1272 mpz_init (&tv->u.Z);
1273 mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
1276 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1280 return tarval_identify (tv);
1284 /* Return `a|b'. Modes must be equal. */
1286 tarval_or (tarval *a, tarval *b)
1290 TARVAL_VRFY (a); TARVAL_VRFY (b);
1291 assert (a->mode == b->mode);
1293 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1298 switch (a->mode->code) {
1300 case irm_C: case irm_H: case irm_I: case irm_L:
1301 tv->u.CHIL = a->u.CHIL | b->u.CHIL; break;
1303 case irm_c: case irm_h: case irm_i: case irm_l:
1304 tv->u.chil = a->u.chil | b->u.chil; break;
1306 mpz_init (&tv->u.Z);
1307 mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
1310 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1314 return tarval_identify (tv);
1318 /* Return `a^b'. Modes must be equal. */
1320 tarval_eor (tarval *a, tarval *b)
1324 TARVAL_VRFY (a); TARVAL_VRFY (b);
1325 assert (a->mode == b->mode);
1327 #if 1 /* see case irm_Z below */
1328 if (a->mode == mode_Z) return NULL;
1331 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1336 switch (a->mode->code) {
1338 case irm_C: case irm_H: case irm_I: case irm_L:
1339 tv->u.CHIL = a->u.CHIL ^ b->u.CHIL; break;
1341 case irm_c: case irm_h: case irm_i: case irm_l:
1342 tv->u.chil = a->u.chil ^ b->u.chil; break;
1344 #if 0 /* gmp-1.3.2 declares but does not define mpz_xor() */
1345 mpz_init (&tv->u.Z);
1346 mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
1350 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1354 return tarval_identify (tv);
1358 /* Return `a<<b' if computable, else NULL. */
1360 tarval_shl (tarval *a, tarval *b)
1366 TARVAL_VRFY (a); TARVAL_VRFY (b);
1368 shift = tarval_ord (b, &b_is_huge);
1371 || ((shift >= mode_l->size*target_bits) && (a->mode != mode_Z))) {
1375 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1379 switch (a->mode->code) {
1381 case irm_C: case irm_H: case irm_I: case irm_L:
1382 tv->u.CHIL = a->u.CHIL << shift;
1385 case irm_c: case irm_h: case irm_i: case irm_l:
1386 tv->u.chil = a->u.chil << shift;
1389 mpz_init (&tv->u.Z);
1390 mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
1392 default: assert (0);
1395 return tarval_identify (tv);
1399 /* Return `a>>b' if computable, else NULL. */
1401 tarval_shr (tarval *a, tarval *b)
1407 TARVAL_VRFY (a); TARVAL_VRFY (b);
1409 shift = tarval_ord (b, &b_is_huge);
1412 || ((shift >= mode_l->size*target_bits) && (a->mode != mode_Z))) {
1416 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1420 switch (a->mode->code) {
1422 case irm_C: case irm_H: case irm_I: case irm_L:
1423 tv->u.CHIL = a->u.CHIL >> shift;
1426 case irm_c: case irm_h: case irm_i: case irm_l:
1427 tv->u.chil = a->u.chil >> shift;
1430 mpz_init (&tv->u.Z);
1431 mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
1433 default: assert (0);
1436 return tarval_identify (tv);
1440 /* Classify `tv', which may be NULL.
1441 Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1442 multiplicative neutral element, and -1 if `tv' is the neutral
1443 element of bitwise and. */
1445 tarval_classify (tarval *tv)
1451 switch (tv->mode->code) {
1453 case irm_f: case irm_d:
1457 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_C->max)) - 1;
1459 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_H->max)) - 1;
1461 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_I->max)) - 1;
1463 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_L->max)) - 1;
1465 case irm_c: case irm_h: case irm_i: case irm_l:
1468 if (mpz_cmp_si (&tv->u.Z, 0)) return 0;
1469 else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
1470 else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
1482 tarval_s_fits (tarval *tv, long min, long max) {
1483 return (( mpz_cmp_si (&tv->u.Z, min) >= 0)
1484 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1488 tarval_u_fits (tarval *tv, unsigned long max) {
1489 return (( mpz_sgn (&tv->u.Z) >= 0)
1490 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1494 /* Convert `tv' into type `long', set `fail' if not representable.
1495 If `fail' gets set for an unsigned `tv', the correct result can be
1496 obtained by casting the result to `unsigned long'. */
1498 tarval_ord (tarval *tv, int *fail)
1502 switch (tv->mode->code) {
1504 case irm_C: case irm_H: case irm_I: case irm_L:
1505 *fail = tv->u.CHIL > tv_val_CHIL (mode_l->max);
1508 case irm_c: case irm_h: case irm_i: case irm_l:
1512 *fail = ( (mpz_cmp_si (&tv->u.Z, tv_val_chil(mode_l->max)) > 0)
1513 || (mpz_cmp_si (&tv->u.Z, tv_val_chil(mode_l->min)) < 0));
1514 return mpz_get_si (&tv->u.Z);
1528 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1530 tarval *val = XP_GETARG (tarval *, 0);
1535 switch (val->mode->code) {
1537 case irm_T: /* none */
1538 printed = XPSR ("<bad>");
1541 case irm_f: /* float */
1542 printed = XPF1R ("%g", (double)(val->u.f));
1544 case irm_d: /* double */
1545 printed = XPF1R ("%g", (double)(val->u.d));
1548 case irm_c: /* signed char */
1549 case irm_C: /* unsigned char */
1550 if (isprint (val->u.chil)) {
1551 printed = XPF1R ("'%c'", val->u.chil);
1553 printed = XPF1R ("'\\%03o'", val->u.chil);
1557 case irm_h: case irm_i: case irm_l: /* signed num */
1558 printed = XPF1R ("%ld", (long)val->u.chil);
1560 case irm_H: case irm_I: case irm_L: /* unsigned num */
1561 printed = XPF1R ("%lu", (unsigned long)val->u.CHIL);
1564 case irm_Z: /* mp int */
1565 printed = XPF1R ("%Z", &val->u.Z);
1568 case irm_p: /* pointer */
1569 if (val->u.p.xname) {
1570 printed = XPR (val->u.p.xname);
1571 } else if (val->u.p.ent) {
1572 printed = XPF1R ("(%I)", val->u.p.ent->name);
1574 assert (val == tarval_p_void);
1575 printed = XPSR ("(void)");
1579 case irm_b: /* boolean */
1580 if (val->u.b) printed = XPSR ("true");
1581 else printed = XPSR ("false");
1584 case irm_B: /* universal bits */
1585 printed = XPSR ("<@@@ some bits>");
1588 case irm_s: /* string */
1591 char *buf = alloca (val->u.s.n + 2);
1597 for (i = 0; i < val->u.s.n; ++i) {
1598 if (isprint (val->u.s.p[i])) {
1599 *bp++ = val->u.s.p[i];
1605 XPF1 ("'\\%03o'", val->u.s.p[i]);
1614 case irm_M: /* memory */
1615 case irm_R: /* region */
1624 /* Labeling of tarvals */
1628 tarval_label (tarval *tv)
1631 tv->lab = new_label();
1639 tarval_forall_labeled (int (*f) (tarval *, void *), void *data)
1643 for (tv = pset_first (tarvals); tv; tv = pset_next (tarvals)) {
1644 if (tv->lab && f (tv, data)) {
1645 pset_break (tarvals);
1653 get_tv_mode (tarval *tv)