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));
377 tarval_bad = tarval_identify (tv);
379 tarval_b_false = tarval_from_long (mode_b, 0);
380 tarval_b_true = tarval_from_long (mode_b, 1);
382 /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
383 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
386 x.ieee.exponent = 0x7ff;
387 x.ieee.mantissa0 = 0;
388 x.ieee.mantissa1 = 0;
390 tarval_d_Inf = tarval_identify (tv);
392 /* IsNaN <-> exponent==0x7ff && (qnan_bit | bits | fraction_low) */
393 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
395 x.ieee_nan.negative = 0;
396 x.ieee_nan.exponent = 0x7ff;
397 x.ieee_nan.quiet_nan = 1; /* @@@ quiet or signalling? */
398 x.ieee_nan.mantissa0 = 42;
399 x.ieee_nan.mantissa1 = 0;
400 assert(x.d != x.d /* x.d is NaN */);
402 tarval_d_NaN = tarval_identify (tv);
404 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
406 tv->u.p.xname = NULL;
409 tarval_p_void = tarval_identify (tv);
411 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
414 tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0);
415 tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0);
416 tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0);
417 tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
418 tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0);
419 tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0);
420 tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0);
421 tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0);
422 tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0);
423 tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0);
424 tarval_mode_null [irm_b] = tarval_b_false;
425 tarval_mode_null [irm_p] = tarval_p_void;
430 /************************* Constructors for tarvals *************************/
432 /* copy from src to dst len chars omitting '_'. */
434 stripcpy (char *dst, const char *src, size_t len)
439 if (*src == '_') src++;
442 *d = 0; /* make it 0-terminated. */
449 tarval_Z_from_str (const char *s, size_t len, int base)
456 buf = alloca (len+1);
457 stripcpy (buf, s, len);
459 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
461 if (mpz_init_set_str (&tv->u.Z, buf, base)) assert (0);
463 return tarval_identify (tv);
468 tarval_B_from_str (const char *s, size_t len)
471 size_t n; /* size of B */
472 const char *r; /* read ptr */
473 unsigned x; /* bit store */
474 int b; /* bits in x */
475 int shift; /* base shift */
480 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
483 assert (s[0] == '0');
486 case 'O': shift = 3; break;
488 case 'X': shift = 4; break;
492 r = s+len; /* set r past input */
493 s += 2; /* skip header */
498 if (*r == '_') continue; /* skip _ styropor */
499 if (('0' <= *r) && (*r <= '9')) {
501 } else if (('a' <= *r) && (*r <= 'f')) {
503 } else { assert (('A' <= *r) && (*r <= 'F'));
507 x |= d << b; /* insert d into x above the b present bits */
508 b += shift; /* x now contains shift more bits */
510 if (b >= 8) { /* we've accumulated at least a byte */
511 char c = x & 0xFF; /* extract the lower 8 bits from x */
512 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
513 x >>= 8; /* remove the lower 8 bits from x */
514 b -= 8; /* x now contains 8 bits fewer */
515 ++n; /* B grew a byte */
519 if (b >= 0) { /* flush the rest of the bits */
520 char c = x; /* extract them */
521 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
522 ++n; /* B grew a byte */
525 { unsigned char *p = obstack_finish (&tv_obst);
526 unsigned char *q = p + n;
530 /* reverse p in place */
531 while (p < q) { char c = *p; *p++ = *q; *q-- = c; }
534 return tarval_identify (tv);
539 tarval_d_from_str (const char *s, size_t len)
547 buf = alloca (len+1);
548 stripcpy (buf, s, len);
550 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
552 tv->u.d = strtod (buf, &eptr);
553 assert (eptr == buf+strlen(buf));
555 return tarval_identify (tv);
560 tarval_s_from_str (const char *s, size_t len)
566 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
570 tv->u.s.p = obstack_copy (&tv_obst, s, len);
572 return tarval_identify (tv);
576 tarval_S_from_str (const char *s, size_t len)
582 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
586 tv->u.s.p = obstack_copy (&tv_obst, s, len);
588 return tarval_identify (tv);
592 /* Create a tarval with mode `m' and value `i' casted to the type that
593 represents such tarvals on host. The resulting value must be legal
596 tarval_from_long (ir_mode *m, long val)
602 if (m == mode_T) return tarval_bad;
604 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
610 tv->u.f = val; break;
612 tv->u.d = val; break;
614 case irm_C: case irm_H: case irm_I: case irm_L:
615 tv->u.CHIL = val; break;
617 case irm_c: case irm_h: case irm_i: case irm_l:
618 tv->u.chil = val; break;
620 mpz_init_set_si (&tv->u.Z, val);
625 obstack_free (&tv_obst, tv);
626 return tarval_p_void;
628 tv->u.b = !!val; /* u.b must be 0 or 1 */
634 return tarval_identify (tv);
639 tarval_p_from_str (const char *xname)
645 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
648 tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
651 return tarval_identify (tv);
656 tarval_p_from_entity (entity *ent)
662 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
665 tv->u.p.xname = NULL;
668 return tarval_identify (tv);
672 /* Routines for building a tarval step by step follow.
673 Legal calling sequences:
675 No contructors except tarval_append() and tarval_append1 ()
676 tarval_finish_as() or tarval_cancel() */
678 /* Begin building a tarval. */
683 obstack_blank (&tv_obst, sizeof (tarval));
687 /* Append `n' chars from `p' to the tarval currently under construction. */
689 tarval_append (const char *p, size_t n)
692 obstack_grow (&tv_obst, p, n);
696 /* Append `ch' to the tarval currently under construction. */
698 tarval_append1 (char ch)
701 obstack_1grow (&tv_obst, ch);
705 /* Finish the tarval currently under construction and give id mode `m'.
706 `m' must be irm_C, irm_B, irm_s or irm_S.
707 Return NULL if the value does not make sense for this mode, this
708 can only happen in mode C. */
710 tarval_finish_as (ir_mode *m)
712 int size = obstack_object_size (&tv_obst) - sizeof (tarval);
715 char ch = 0; /* initialized to shut up gcc */
717 assert (BUILDING && (size >= 0));
719 if (size != 1) return tarval_cancel();
720 p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
722 obstack_blank (&tv_obst, -size);
724 tv = obstack_finish (&tv_obst);
725 p = (unsigned char *)tv + sizeof (tarval);
748 return tarval_identify (tv);
752 /* Cancel tarval building and return tarval_bad. */
757 obstack_free (&tv_obst, obstack_finish (&tv_obst));
763 /********************* Arithmethic operations on tarvals ********************/
765 /* Return `src' converted to mode `m' if representable, else NULL.
766 @@@ lots of conversions missing */
768 tarval_convert_to (tarval *src, ir_mode *m)
772 if (m == src->mode) return src;
774 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
777 switch (src->mode->code) {
780 if (m != mode_f) goto fail;
787 case irm_C: case irm_H: case irm_I: case irm_L:
788 if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail;
789 if (mpz_size (&src->u.Z) > 1) goto fail;
790 tv->u.CHIL = mpz_get_ui (&src->u.Z);
791 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
794 case irm_c: case irm_h: case irm_i: case irm_l:
795 tv->u.chil = mpz_get_si (&src->u.Z);
796 if (chil_overflow (tv->u.chil, m)) goto fail;
800 tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0);
804 if (mpz_cmp_ui (&src->u.Z, 0)) goto fail;
805 obstack_free (&tv_obst, tv);
806 return tarval_p_void;
812 case irm_c: case irm_h: case irm_i: case irm_l:
814 case irm_c: case irm_h: case irm_i: case irm_l:
815 tv->u.chil = src->u.chil;
816 if (chil_overflow (tv->u.chil, m)) goto fail;
819 case irm_C: case irm_H: case irm_I: case irm_L:
820 tv->u.CHIL = src->u.chil;
821 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
825 mpz_init_set_si (&tv->u.Z, src->u.chil);
829 tv->u.b = !!src->u.chil;
835 case irm_C: case irm_H: case irm_I: case irm_L:
837 case irm_c: case irm_h: case irm_i: case irm_l:
838 tv->u.chil = src->u.CHIL;
839 if (chil_overflow (tv->u.chil, m)) goto fail;
842 case irm_C: case irm_H: case irm_I: case irm_L:
843 tv->u.CHIL = src->u.CHIL;
844 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
848 mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
852 tv->u.b = !!src->u.CHIL;
861 case irm_c: case irm_h: case irm_i: case irm_l:
862 tv->u.chil = src->u.b;
865 case irm_C: case irm_H: case irm_I: case irm_L:
866 tv->u.CHIL = src->u.b;
874 obstack_free (&tv_obst, tv);
878 return tarval_identify (tv);
883 tarval_neg (tarval *a)
889 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
893 switch (a->mode->code) {
895 case irm_f: tv->u.f = -a->u.f; break;
896 case irm_d: tv->u.d = -a->u.d; break;
898 case irm_C: case irm_H: case irm_I: case irm_L:
899 tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (a->mode->max);
902 case irm_c: case irm_h: case irm_i: case irm_l:
903 tv->u.chil = -a->u.chil;
904 if ( chil_overflow (tv->u.chil, a->mode)
905 || ((tv->u.chil >= 0) == (a->u.chil >= 0))) {
906 obstack_free (&tv_obst, tv);
912 mpz_neg (&tv->u.Z, &a->u.Z);
915 case irm_b: tv->u.b = !a->u.b; break;
919 return tarval_identify (tv);
923 /* Compare `a' with `b'.
924 Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
925 result is unknown. */
927 tarval_comp (tarval *a, tarval *b)
933 assert (a->mode == b->mode);
935 switch (a->mode->code) {
937 case irm_f: return ( a->u.f == b->u.f ? irpn_Eq
938 : a->u.f > b->u.f ? irpn_Gt
939 : a->u.f < b->u.f ? irpn_Lt
941 case irm_d: return ( a->u.d == b->u.d ? irpn_Eq
942 : a->u.d > b->u.d ? irpn_Gt
943 : a->u.d < b->u.d ? irpn_Lt
946 case irm_C: case irm_H: case irm_I: case irm_L:
947 return ( a->u.CHIL == b->u.CHIL ? irpn_Eq
948 : a->u.CHIL > b->u.CHIL ? irpn_Gt
951 case irm_c: case irm_h: case irm_i: case irm_l:
952 return ( a->u.chil == b->u.chil ? irpn_Eq
953 : a->u.chil > b->u.chil ? irpn_Gt
956 { int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
957 return ( cmp == 0 ? irpn_Eq
962 case irm_b: return ( a->u.b == b->u.b ? irpn_Eq
963 : a->u.b > b->u.b ? irpn_Gt
965 /* The following assumes that pointers are unsigned, which is valid
966 for all sane CPUs (transputers are insane). */
967 case irm_p: return ( a == b ? irpn_Eq
968 : a == tarval_p_void ? irpn_Lt
969 : b == tarval_p_void ? irpn_Gt
970 : irpn_False); /* unknown */
976 /* Return `a+b' if computable, else NULL. Modes must be equal. */
978 tarval_add (tarval *a, tarval *b)
982 TARVAL_VRFY (a); TARVAL_VRFY (b);
983 assert (a->mode == b->mode);
985 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
989 switch (a->mode->code) {
991 case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */
992 case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */
994 case irm_C: case irm_H: case irm_I: case irm_L:
995 tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (a->mode->max);
998 case irm_c: case irm_h: case irm_i: case irm_l:
999 tv->u.chil = a->u.chil + b->u.chil;
1000 if ( chil_overflow (tv->u.chil, a->mode)
1001 || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) {
1002 obstack_free (&tv_obst, tv);
1007 mpz_init (&tv->u.Z);
1008 mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
1011 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1015 return tarval_identify (tv);
1019 /* Return `a-b' if computable, else NULL. Modes must be equal. */
1021 tarval_sub (tarval *a, tarval *b)
1025 TARVAL_VRFY (a); TARVAL_VRFY (b);
1026 assert (a->mode == b->mode);
1028 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1032 switch (a->mode->code) {
1034 case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */
1035 case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */
1037 case irm_C: case irm_H: case irm_I: case irm_L:
1038 tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (a->mode->max);
1041 case irm_c: case irm_h: case irm_i: case irm_l:
1042 tv->u.chil = a->u.chil - b->u.chil;
1043 if ( chil_overflow (tv->u.chil, a->mode)
1044 || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) {
1045 obstack_free (&tv_obst, tv);
1050 mpz_init (&tv->u.Z);
1051 mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
1054 case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
1058 return tarval_identify (tv);
1062 /* Return `a*b' if computable, else NULL. Modes must be equal. */
1064 tarval_mul (tarval *a, tarval *b)
1068 TARVAL_VRFY (a); TARVAL_VRFY (b);
1069 assert (a->mode == b->mode);
1071 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1075 switch (a->mode->code) {
1077 case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */
1078 case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */
1080 case irm_C: case irm_H: case irm_I: case irm_L:
1081 tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (a->mode->max);
1084 case irm_c: case irm_h: case irm_i: case irm_l:
1085 tv->u.chil = a->u.chil * b->u.chil;
1086 if ( chil_overflow (tv->u.chil, a->mode)
1087 || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) {
1088 obstack_free (&tv_obst, tv);
1093 mpz_init (&tv->u.Z);
1094 mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
1097 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1101 return tarval_identify (tv);
1105 /* Return floating-point `a/b' if computable, else NULL.
1106 Modes must be equal, non-floating-point operands are converted to irm_d. */
1108 tarval_quo (tarval *a, tarval *b)
1112 TARVAL_VRFY (a); TARVAL_VRFY (b);
1113 assert (a->mode == b->mode);
1115 switch (a->mode->code) {
1118 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1120 tv->u.f = a->u.f / b->u.f; /* @@@ overflow etc */
1123 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1125 tv->u.d = a->u.d / b->u.d; /* @@@ overflow etc */
1128 a = tarval_convert_to (a, mode_d);
1129 b = tarval_convert_to (b, mode_d);
1130 return a && b ? tarval_quo (a, b) : NULL;
1133 return tarval_identify (tv);
1137 /* Return `a/b' if computable, else NULL. Modes must be equal. */
1139 tarval_div (tarval *a, tarval *b)
1143 TARVAL_VRFY (a); TARVAL_VRFY (b);
1144 assert (a->mode == b->mode);
1146 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1150 switch (a->mode->code) {
1152 case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */
1153 case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */
1155 case irm_C: case irm_H: case irm_I: case irm_L:
1156 if (!b->u.CHIL) goto fail;
1157 tv->u.CHIL = a->u.CHIL / b->u.CHIL;
1160 case irm_c: case irm_h: case irm_i: case irm_l:
1162 || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (a->mode->max) ))) {
1164 obstack_free (&tv_obst, tv);
1167 tv->u.chil = a->u.chil / b->u.chil;
1170 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1171 mpz_init (&tv->u.Z);
1172 mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
1175 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1179 return tarval_identify (tv);
1183 /* Return `a%b' if computable, else NULL. Modes must be equal. */
1185 tarval_mod (tarval *a, tarval *b)
1189 TARVAL_VRFY (a); TARVAL_VRFY (b);
1190 assert (a->mode == b->mode);
1192 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1196 switch (a->mode->code) {
1198 case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */
1199 case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */
1201 case irm_C: case irm_H: case irm_I: case irm_L:
1202 if (!b->u.CHIL) goto fail;
1203 tv->u.CHIL = a->u.CHIL % b->u.CHIL;
1206 case irm_c: case irm_h: case irm_i: case irm_l:
1209 obstack_free (&tv_obst, tv);
1212 tv->u.chil = a->u.chil % b->u.chil;
1215 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1216 mpz_init (&tv->u.Z);
1217 mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
1220 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1224 return tarval_identify (tv);
1228 /* Return `a&b'. Modes must be equal. */
1230 tarval_and (tarval *a, tarval *b)
1234 TARVAL_VRFY (a); TARVAL_VRFY (b);
1235 assert (a->mode == b->mode);
1237 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1241 switch (a->mode->code) {
1243 case irm_C: case irm_H: case irm_I: case irm_L:
1244 tv->u.CHIL = a->u.CHIL & b->u.CHIL; break;
1246 case irm_c: case irm_h: case irm_i: case irm_l:
1247 tv->u.chil = a->u.chil & b->u.chil; break;
1249 mpz_init (&tv->u.Z);
1250 mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
1253 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1257 return tarval_identify (tv);
1261 /* Return `a|b'. Modes must be equal. */
1263 tarval_or (tarval *a, tarval *b)
1267 TARVAL_VRFY (a); TARVAL_VRFY (b);
1268 assert (a->mode == b->mode);
1270 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1274 switch (a->mode->code) {
1276 case irm_C: case irm_H: case irm_I: case irm_L:
1277 tv->u.CHIL = a->u.CHIL | b->u.CHIL; break;
1279 case irm_c: case irm_h: case irm_i: case irm_l:
1280 tv->u.chil = a->u.chil | b->u.chil; break;
1282 mpz_init (&tv->u.Z);
1283 mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
1286 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1290 return tarval_identify (tv);
1294 /* Return `a^b'. Modes must be equal. */
1296 tarval_eor (tarval *a, tarval *b)
1300 TARVAL_VRFY (a); TARVAL_VRFY (b);
1301 assert (a->mode == b->mode);
1303 #if 1 /* see case irm_Z below */
1304 if (a->mode == mode_Z) return NULL;
1307 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1311 switch (a->mode->code) {
1313 case irm_C: case irm_H: case irm_I: case irm_L:
1314 tv->u.CHIL = a->u.CHIL ^ b->u.CHIL; break;
1316 case irm_c: case irm_h: case irm_i: case irm_l:
1317 tv->u.chil = a->u.chil ^ b->u.chil; break;
1319 #if 0 /* gmp-1.3.2 declares but does not define mpz_xor() */
1320 mpz_init (&tv->u.Z);
1321 mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
1325 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1329 return tarval_identify (tv);
1333 /* Return `a<<b' if computable, else NULL. */
1335 tarval_shl (tarval *a, tarval *b)
1341 TARVAL_VRFY (a); TARVAL_VRFY (b);
1343 shift = tarval_ord (b, &b_is_huge);
1346 || ((shift >= mode_l->size*target_bits) && (a->mode != mode_Z))) {
1350 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1353 switch (a->mode->code) {
1355 case irm_C: case irm_H: case irm_I: case irm_L:
1356 tv->u.CHIL = a->u.CHIL << shift;
1359 case irm_c: case irm_h: case irm_i: case irm_l:
1360 tv->u.chil = a->u.chil << shift;
1363 mpz_init (&tv->u.Z);
1364 mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
1366 default: assert (0);
1369 return tarval_identify (tv);
1373 /* Return `a>>b' if computable, else NULL. */
1375 tarval_shr (tarval *a, tarval *b)
1381 TARVAL_VRFY (a); TARVAL_VRFY (b);
1383 shift = tarval_ord (b, &b_is_huge);
1386 || ((shift >= mode_l->size*target_bits) && (a->mode != mode_Z))) {
1390 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1393 switch (a->mode->code) {
1395 case irm_C: case irm_H: case irm_I: case irm_L:
1396 tv->u.CHIL = a->u.CHIL >> shift;
1399 case irm_c: case irm_h: case irm_i: case irm_l:
1400 tv->u.chil = a->u.chil >> shift;
1403 mpz_init (&tv->u.Z);
1404 mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
1406 default: assert (0);
1409 return tarval_identify (tv);
1413 /* Classify `tv', which may be NULL.
1414 Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1415 multiplicative neutral element, and -1 if `tv' is the neutral
1416 element of bitwise and. */
1418 tarval_classify (tarval *tv)
1424 switch (tv->mode->code) {
1426 case irm_f: case irm_d:
1430 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_C->max)) - 1;
1432 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_H->max)) - 1;
1434 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_I->max)) - 1;
1436 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_L->max)) - 1;
1438 case irm_c: case irm_h: case irm_i: case irm_l:
1441 if (mpz_cmp_si (&tv->u.Z, 0)) return 0;
1442 else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
1443 else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
1455 tarval_s_fits (tarval *tv, long min, long max) {
1456 return (( mpz_cmp_si (&tv->u.Z, min) >= 0)
1457 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1461 tarval_u_fits (tarval *tv, unsigned long max) {
1462 return (( mpz_sgn (&tv->u.Z) >= 0)
1463 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1467 /* Convert `tv' into type `long', set `fail' if not representable.
1468 If `fail' gets set for an unsigned `tv', the correct result can be
1469 obtained by casting the result to `unsigned long'. */
1471 tarval_ord (tarval *tv, int *fail)
1475 switch (tv->mode->code) {
1477 case irm_C: case irm_H: case irm_I: case irm_L:
1478 *fail = tv->u.CHIL > tv_val_CHIL (mode_l->max);
1481 case irm_c: case irm_h: case irm_i: case irm_l:
1485 *fail = ( (mpz_cmp_si (&tv->u.Z, tv_val_chil(mode_l->max)) > 0)
1486 || (mpz_cmp_si (&tv->u.Z, tv_val_chil(mode_l->min)) < 0));
1487 return mpz_get_si (&tv->u.Z);
1501 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1503 tarval *val = XP_GETARG (tarval *, 0);
1508 switch (val->mode->code) {
1510 case irm_T: /* none */
1511 printed = XPSR ("<bad>");
1514 case irm_f: /* float */
1515 printed = XPF1R ("%g", (double)(val->u.f));
1517 case irm_d: /* double */
1518 printed = XPF1R ("%g", (double)(val->u.d));
1521 case irm_c: /* signed char */
1522 case irm_C: /* unsigned char */
1523 if (isprint (val->u.chil)) {
1524 printed = XPF1R ("'%c'", val->u.chil);
1526 printed = XPF1R ("'\\%03o'", val->u.chil);
1530 case irm_h: case irm_i: case irm_l: /* signed num */
1531 printed = XPF1R ("%ld", (long)val->u.chil);
1533 case irm_H: case irm_I: case irm_L: /* unsigned num */
1534 printed = XPF1R ("%lu", (unsigned long)val->u.CHIL);
1537 case irm_Z: /* mp int */
1538 printed = XPF1R ("%Z", &val->u.Z);
1541 case irm_p: /* pointer */
1542 if (val->u.p.xname) {
1543 printed = XPR (val->u.p.xname);
1544 } else if (val->u.p.ent) {
1545 printed = XPF1R ("(%I)", val->u.p.ent->name);
1547 assert (val == tarval_p_void);
1548 printed = XPSR ("(void)");
1552 case irm_b: /* boolean */
1553 if (val->u.b) printed = XPSR ("true");
1554 else printed = XPSR ("false");
1557 case irm_B: /* universal bits */
1558 printed = XPSR ("<@@@ some bits>");
1561 case irm_s: /* string */
1564 char *buf = alloca (val->u.s.n + 2);
1570 for (i = 0; i < val->u.s.n; ++i) {
1571 if (isprint (val->u.s.p[i])) {
1572 *bp++ = val->u.s.p[i];
1578 XPF1 ("'\\%03o'", val->u.s.p[i]);
1587 case irm_M: /* memory */
1588 case irm_R: /* region */
1597 get_tv_mode (tarval *tv)