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
40 #define TOBSTACK_ID "tv"
49 static struct obstack tv_obst; /* obstack for all the target values */
50 static pset *tarvals; /* pset containing pointers to _all_ tarvals */
52 /* currently building an object with tarval_start() & friends ? */
53 #define BUILDING obstack_object_size (&tv_obst)
55 /* special tarvals: */
57 tarval *tarval_b_false;
58 tarval *tarval_b_true;
61 tarval *tarval_p_void;
62 tarval *tarval_mode_null[irm_max];
65 /* @@@ depends on order of ir_mode */
66 static tarval_chil min_chil[8] = {
72 static tarval_chil max_chil[8] = {
73 TARGET_SIMAX (c), TARGET_UIMAX (C),
74 TARGET_SIMAX (h), TARGET_UIMAX (H),
75 TARGET_SIMAX (i), TARGET_UIMAX (I),
76 TARGET_SIMAX (l), TARGET_UIMAX (L)
80 /* return a mode-specific value */
95 tv_val_chil (tarval *tv)
101 tv_val_CHIL (tarval *tv)
107 tv_val_Z (tarval *tv)
113 tv_val_p (tarval *tv)
119 tv_val_b (tarval *tv)
125 tv_val_B (tarval *tv)
131 tv_val_s (tarval *tv)
137 /* Overflows `chil' signed integral `mode'? */
139 chil_overflow (tarval_chil chil, ir_mode *mode)
141 assert (is_chilCHIL(get_mode_modecode(mode)));
142 return (get_mode_min(mode) && get_mode_max(mode) /* only valid after firm initialization */
143 && (chil < tv_val_chil (get_mode_min(mode))
144 || tv_val_chil (get_mode_max(mode)) < chil));
148 /* Overflows `CHIL' unsigned integral `mode'? */
150 CHIL_overflow (tarval_CHIL CHIL, ir_mode *mode)
152 assert (is_chilCHIL(get_mode_modecode(mode)));
153 return (get_mode_max(mode) /* only valid after firm initialization */
154 && tv_val_CHIL (get_mode_max(mode)) < CHIL);
160 _tarval_vrfy (const tarval *val)
163 switch (get_mode_modecode(val->mode)) {
169 case irm_C: case irm_H: case irm_I: case irm_L:
170 assert (!CHIL_overflow (val->u.CHIL, val->mode)); break;
171 case irm_c: case irm_h: case irm_i: case irm_l:
172 assert (!chil_overflow (val->u.chil, val->mode)); break;
178 assert (val->u.p.ent->kind == k_entity);
179 assert ( val->u.p.xname || val->u.p.ent
180 || !tarval_p_void || (val == tarval_p_void));
184 assert (val->u.s.p); break;
186 assert (val->u.B.p); break;
188 assert ((unsigned)val->u.b <= 1); break;
190 assert (val->mode == mode_T);
201 pset_stats (tarvals);
207 /* Return the canonical tarval * for tv.
208 May destroy everything allocated on tv_obst after tv! */
210 tarval_identify (tarval *tv)
214 o = pset_insert (tarvals, tv, tarval_hash (tv));
217 obstack_free (&tv_obst, (void *)tv);
225 /* Return 0 iff a equals b. Bitwise identical NaNs compare equal. */
227 tarval_cmp (const void *p, const void *q)
235 if (a == b) return 0;
236 if ((void *)a->mode - (void *)b->mode)
237 return (void *)a->mode - (void *)b->mode;
239 switch (get_mode_modecode(a->mode)) {
242 return memcmp (&a->u.f, &b->u.f, sizeof (a->u.f));
244 return memcmp (&a->u.d, &b->u.d, sizeof (a->u.d));
246 case irm_C: case irm_H: case irm_I: case irm_L:
247 if (sizeof (int) == sizeof (tarval_CHIL)) {
248 return a->u.CHIL - b->u.CHIL;
250 return a->u.CHIL != b->u.CHIL;
252 case irm_c: case irm_h: case irm_i: case irm_l:
253 if (sizeof (int) == sizeof (tarval_chil)) {
254 return a->u.chil - b->u.chil;
256 return a->u.chil != b->u.chil;
258 return mpz_cmp (&a->u.Z, &b->u.Z);
261 if (a->u.p.ent || b->u.p.ent)
262 return (char *)a->u.p.ent - (char *)b->u.p.ent;
263 if (a->u.p.xname && b->u.p.xname)
264 return strcmp (a->u.p.xname, b->u.p.xname);
265 return a->u.p.xname - b->u.p.xname;
267 return a->u.b - b->u.b;
269 return ( a->u.B.n - b->u.B.n
270 ? memcmp (a->u.B.p, b->u.B.p, a->u.B.n)
271 : a->u.B.n - b->u.B.n);
272 case irm_s: case irm_S:
273 return ( a->u.s.n == b->u.s.n
274 ? memcmp (a->u.s.p, b->u.s.p, a->u.s.n)
275 : a->u.s.n - b->u.s.n);
282 tarval_hash (tarval *tv)
286 h = get_mode_modecode(tv->mode) * 0x421u;
287 switch (get_mode_modecode(tv->mode)) {
289 h = 0x94b527ce; break;
292 { union { float f; unsigned u; } u;
293 assert (sizeof (float) <= sizeof (unsigned));
294 u.u = 0; u.f = tv->u.f;
300 { union { double d; unsigned u[2]; } u;
301 assert (sizeof (double) <= 2*sizeof (unsigned));
302 u.u[0] = u.u[1] = 0; u.d = tv->u.d;
303 h ^= u.u[0] ^ u.u[1];
306 case irm_C: case irm_H: case irm_I: case irm_L:
307 h ^= tv->u.CHIL; break;
308 case irm_c: case irm_h: case irm_i: case irm_l:
309 h ^= tv->u.chil; break;
311 h ^= mpz_get_ui (&tv->u.Z); break;
314 /* @@@ lower bits not random, watch for collisions; perhaps
315 replace by tv->u.p.ent - (entity *)0 */
316 h ^= ((char *)tv->u.p.ent - (char *)0) / 64;
317 } else if (tv->u.p.xname) {
318 /* Of course, strlen() in a hash function is a mistake, but this
319 case should be really rare. */
320 h ^= ID_HASH (tv->u.p.xname, strlen (tv->u.p.xname));
328 h ^= tv->u.B.n; break; /* @@@ not really good */
330 h ^= tv->u.s.p[0]<<12 ^ tv->u.s.p[tv->u.s.n]<<4 ^ tv->u.s.n; break;
332 h ^= tv->u.s.p[0]<<4 ^ tv->u.s.p[tv->u.s.n]<<12 ^ tv->u.s.n; break;
341 /******************** Initialization ****************************************/
346 obstack_init (&tv_obst);
347 obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1;
348 assert (IS_POW2 (ALIGNOF (tarval)));
350 /* initialize the target value table */
351 tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS);
358 union ieee754_double x;
360 /* assumed by tarval_hash(): */
361 assert (sizeof (float) * CHAR_BIT == 32);
362 assert (sizeof (double) * CHAR_BIT == 64);
365 /* assumed by tarval_chil & friends: */
366 assert ( (irm_C == irm_c+1) && (irm_h == irm_C+1)
367 && (irm_H == irm_h+1) && (irm_i == irm_H+1)
368 && (irm_I == irm_i+1) && (irm_l == irm_I+1)
369 && (irm_L == irm_l+1));
371 /* assumed everywhere: */
372 for (i = 0; i <= irm_L-irm_c; i += 2) {
373 assert ( IS_POW2 (max_chil[i+1]+1)
374 && (min_chil[i] == -max_chil[i]-1)
375 && ((tarval_CHIL)max_chil[i+1] == (tarval_CHIL)max_chil[i]-min_chil[i]));
380 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
382 tarval_bad = tarval_identify (tv);
384 tarval_b_false = tarval_from_long (mode_b, 0);
385 tarval_b_true = tarval_from_long (mode_b, 1);
387 /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
388 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
391 x.ieee.exponent = 0x7ff;
392 x.ieee.mantissa0 = 0;
393 x.ieee.mantissa1 = 0;
395 tarval_d_Inf = tarval_identify (tv);
397 /* IsNaN <-> exponent==0x7ff && (qnan_bit | bits | fraction_low) */
398 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
400 x.ieee_nan.negative = 0;
401 x.ieee_nan.exponent = 0x7ff;
402 x.ieee_nan.quiet_nan = 1; /* @@@ quiet or signalling? */
403 x.ieee_nan.mantissa0 = 42;
404 x.ieee_nan.mantissa1 = 0;
405 assert(x.d != x.d /* x.d is NaN */);
407 tarval_d_NaN = tarval_identify (tv);
409 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
411 tv->u.p.xname = NULL;
414 tarval_p_void = tarval_identify (tv);
416 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
419 tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0);
420 tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0);
421 tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0);
422 tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
423 tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0);
424 tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0);
425 tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0);
426 tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0);
427 tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0);
428 tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0);
429 tarval_mode_null [irm_b] = tarval_b_false;
430 tarval_mode_null [irm_p] = tarval_p_void;
435 /************************* Constructors for tarvals *************************/
437 /* copy from src to dst len chars omitting '_'. */
439 stripcpy (char *dst, const char *src, size_t len)
444 if (*src == '_') src++;
447 *d = 0; /* make it 0-terminated. */
454 tarval_Z_from_str (const char *s, size_t len, int base)
461 buf = alloca (len+1);
462 stripcpy (buf, s, len);
464 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));
488 assert (s[0] == '0');
491 case 'O': shift = 3; break;
493 case 'X': shift = 4; break;
497 r = s+len; /* set r past input */
498 s += 2; /* skip header */
503 if (*r == '_') continue; /* skip _ styropor */
504 if (('0' <= *r) && (*r <= '9')) {
506 } else if (('a' <= *r) && (*r <= 'f')) {
508 } else { assert (('A' <= *r) && (*r <= 'F'));
512 x |= d << b; /* insert d into x above the b present bits */
513 b += shift; /* x now contains shift more bits */
515 if (b >= 8) { /* we've accumulated at least a byte */
516 char c = x & 0xFF; /* extract the lower 8 bits from x */
517 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
518 x >>= 8; /* remove the lower 8 bits from x */
519 b -= 8; /* x now contains 8 bits fewer */
520 ++n; /* B grew a byte */
524 if (b >= 0) { /* flush the rest of the bits */
525 char c = x; /* extract them */
526 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
527 ++n; /* B grew a byte */
530 { unsigned char *p = obstack_finish (&tv_obst);
531 unsigned char *q = p + n;
535 /* reverse p in place */
536 while (p < q) { char c = *p; *p++ = *q; *q-- = c; }
539 return tarval_identify (tv);
544 tarval_d_from_str (const char *s, size_t len)
552 buf = alloca (len+1);
553 stripcpy (buf, s, len);
555 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
557 tv->u.d = strtod (buf, &eptr);
558 assert (eptr == buf+strlen(buf));
560 return tarval_identify (tv);
565 tarval_s_from_str (const char *s, size_t len)
571 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
575 tv->u.s.p = obstack_copy (&tv_obst, s, len);
577 return tarval_identify (tv);
581 tarval_S_from_str (const char *s, size_t len)
587 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
591 tv->u.s.p = obstack_copy (&tv_obst, s, len);
593 return tarval_identify (tv);
597 /* Create a tarval with mode `m' and value `i' casted to the type that
598 represents such tarvals on host. The resulting value must be legal
601 tarval_from_long (ir_mode *m, long val)
607 if (m == mode_T) return tarval_bad;
609 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
612 switch (get_mode_modecode(m)) {
615 tv->u.f = val; break;
617 tv->u.d = val; break;
619 case irm_C: case irm_H: case irm_I: case irm_L:
620 tv->u.CHIL = val; break;
622 case irm_c: case irm_h: case irm_i: case irm_l:
623 tv->u.chil = val; break;
625 mpz_init_set_si (&tv->u.Z, val);
630 obstack_free (&tv_obst, tv);
631 return tarval_p_void;
633 tv->u.b = !!val; /* u.b must be 0 or 1 */
639 return tarval_identify (tv);
644 tarval_p_from_str (const char *xname)
650 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
653 tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
656 return tarval_identify (tv);
661 tarval_p_from_entity (entity *ent)
667 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
670 tv->u.p.xname = NULL;
673 return tarval_identify (tv);
677 /* Routines for building a tarval step by step follow.
678 Legal calling sequences:
680 No contructors except tarval_append() and tarval_append1 ()
681 tarval_finish_as() or tarval_cancel() */
683 /* Begin building a tarval. */
688 obstack_blank (&tv_obst, sizeof (tarval));
692 /* Append `n' chars from `p' to the tarval currently under construction. */
694 tarval_append (const char *p, size_t n)
697 obstack_grow (&tv_obst, p, n);
701 /* Append `ch' to the tarval currently under construction. */
703 tarval_append1 (char ch)
706 obstack_1grow (&tv_obst, ch);
710 /* Finish the tarval currently under construction and give id mode `m'.
711 `m' must be irm_C, irm_B, irm_s or irm_S.
712 Return NULL if the value does not make sense for this mode, this
713 can only happen in mode C. */
715 tarval_finish_as (ir_mode *m)
717 int size = obstack_object_size (&tv_obst) - sizeof (tarval);
720 char ch = 0; /* initialized to shut up gcc */
722 assert (BUILDING && (size >= 0));
724 if (size != 1) return tarval_cancel();
725 p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
727 obstack_blank (&tv_obst, -size);
729 tv = obstack_finish (&tv_obst);
730 p = (unsigned char *)tv + sizeof (tarval);
733 switch (get_mode_modecode(m)) {
753 return tarval_identify (tv);
757 /* Cancel tarval building and return tarval_bad. */
762 obstack_free (&tv_obst, obstack_finish (&tv_obst));
768 /********************* Arithmethic operations on tarvals ********************/
770 /* Return `src' converted to mode `m' if representable, else NULL.
771 @@@ lots of conversions missing */
773 tarval_convert_to (tarval *src, ir_mode *m)
777 if (m == src->mode) return src;
779 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
782 switch (get_mode_modecode(src->mode)) {
785 if (m != mode_f) goto fail;
790 switch (get_mode_modecode(m)) {
792 case irm_C: case irm_H: case irm_I: case irm_L:
793 if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail;
794 if (mpz_size (&src->u.Z) > 1) goto fail;
795 tv->u.CHIL = mpz_get_ui (&src->u.Z);
796 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
799 case irm_c: case irm_h: case irm_i: case irm_l:
800 tv->u.chil = mpz_get_si (&src->u.Z);
801 if (chil_overflow (tv->u.chil, m)) goto fail;
805 tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0);
809 if (mpz_cmp_ui (&src->u.Z, 0)) goto fail;
810 obstack_free (&tv_obst, tv);
811 return tarval_p_void;
817 case irm_c: case irm_h: case irm_i: case irm_l:
818 switch (get_mode_modecode(m)) {
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;
824 case irm_C: case irm_H: case irm_I: case irm_L:
825 tv->u.CHIL = src->u.chil;
826 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
830 mpz_init_set_si (&tv->u.Z, src->u.chil);
834 tv->u.b = !!src->u.chil;
840 case irm_C: case irm_H: case irm_I: case irm_L:
841 switch (get_mode_modecode(m)) {
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;
847 case irm_C: case irm_H: case irm_I: case irm_L:
848 tv->u.CHIL = src->u.CHIL;
849 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
853 mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
857 tv->u.b = !!src->u.CHIL;
865 switch (get_mode_modecode(m)) {
866 case irm_c: case irm_h: case irm_i: case irm_l:
867 tv->u.chil = src->u.b;
870 case irm_C: case irm_H: case irm_I: case irm_L:
871 tv->u.CHIL = src->u.b;
879 obstack_free (&tv_obst, tv);
883 return tarval_identify (tv);
888 tarval_neg (tarval *a)
894 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
898 switch (get_mode_modecode(a->mode)) {
900 case irm_f: tv->u.f = -a->u.f; break;
901 case irm_d: tv->u.d = -a->u.d; break;
903 case irm_C: case irm_H: case irm_I: case irm_L:
904 tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (get_mode_max(a->mode));
907 case irm_c: case irm_h: case irm_i: case irm_l:
908 tv->u.chil = -a->u.chil;
909 if ( chil_overflow (tv->u.chil, a->mode)
910 || ((tv->u.chil >= 0) == (a->u.chil >= 0))) {
911 obstack_free (&tv_obst, tv);
917 mpz_neg (&tv->u.Z, &a->u.Z);
920 case irm_b: tv->u.b = !a->u.b; break;
924 return tarval_identify (tv);
928 /* Compare `a' with `b'.
929 Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
930 result is unknown. */
932 tarval_comp (tarval *a, tarval *b)
938 assert (a->mode == b->mode);
940 switch (get_mode_modecode(a->mode)) {
942 case irm_f: return ( a->u.f == b->u.f ? irpn_Eq
943 : a->u.f > b->u.f ? irpn_Gt
944 : a->u.f < b->u.f ? irpn_Lt
946 case irm_d: return ( a->u.d == b->u.d ? irpn_Eq
947 : a->u.d > b->u.d ? irpn_Gt
948 : a->u.d < b->u.d ? irpn_Lt
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 case irm_c: case irm_h: case irm_i: case irm_l:
957 return ( a->u.chil == b->u.chil ? irpn_Eq
958 : a->u.chil > b->u.chil ? irpn_Gt
961 { int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
962 return ( cmp == 0 ? irpn_Eq
967 case irm_b: return ( a->u.b == b->u.b ? irpn_Eq
968 : a->u.b > b->u.b ? irpn_Gt
970 /* The following assumes that pointers are unsigned, which is valid
971 for all sane CPUs (transputers are insane). */
972 case irm_p: return ( a == b ? irpn_Eq
973 : a == tarval_p_void ? irpn_Lt
974 : b == tarval_p_void ? irpn_Gt
975 : irpn_False); /* unknown */
981 /* Return `a+b' if computable, else NULL. Modes must be equal. */
983 tarval_add (tarval *a, tarval *b)
987 TARVAL_VRFY (a); TARVAL_VRFY (b);
988 assert (a->mode == b->mode);
990 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
994 switch (get_mode_modecode(a->mode)) {
996 case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */
997 case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */
999 case irm_C: case irm_H: case irm_I: case irm_L:
1000 tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1003 case irm_c: case irm_h: case irm_i: case irm_l:
1004 tv->u.chil = a->u.chil + b->u.chil;
1005 if ( chil_overflow (tv->u.chil, a->mode)
1006 || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) {
1007 obstack_free (&tv_obst, tv);
1012 mpz_init (&tv->u.Z);
1013 mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
1016 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1020 return tarval_identify (tv);
1024 /* Return `a-b' if computable, else NULL. Modes must be equal. */
1026 tarval_sub (tarval *a, tarval *b)
1030 TARVAL_VRFY (a); TARVAL_VRFY (b);
1031 assert (a->mode == b->mode);
1033 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1037 switch (get_mode_modecode(a->mode)) {
1039 case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */
1040 case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */
1042 case irm_C: case irm_H: case irm_I: case irm_L:
1043 tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1046 case irm_c: case irm_h: case irm_i: case irm_l:
1047 tv->u.chil = a->u.chil - b->u.chil;
1048 if ( chil_overflow (tv->u.chil, a->mode)
1049 || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) {
1050 obstack_free (&tv_obst, tv);
1055 mpz_init (&tv->u.Z);
1056 mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
1059 case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
1063 return tarval_identify (tv);
1067 /* Return `a*b' if computable, else NULL. Modes must be equal. */
1069 tarval_mul (tarval *a, tarval *b)
1073 TARVAL_VRFY (a); TARVAL_VRFY (b);
1074 assert (a->mode == b->mode);
1076 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1080 switch (get_mode_modecode(a->mode)) {
1082 case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */
1083 case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */
1085 case irm_C: case irm_H: case irm_I: case irm_L:
1086 tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1089 case irm_c: case irm_h: case irm_i: case irm_l:
1090 tv->u.chil = a->u.chil * b->u.chil;
1091 if ( chil_overflow (tv->u.chil, a->mode)
1092 || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) {
1093 obstack_free (&tv_obst, tv);
1098 mpz_init (&tv->u.Z);
1099 mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
1102 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1106 return tarval_identify (tv);
1110 /* Return floating-point `a/b' if computable, else NULL.
1111 Modes must be equal, non-floating-point operands are converted to irm_d. */
1113 tarval_quo (tarval *a, tarval *b)
1117 TARVAL_VRFY (a); TARVAL_VRFY (b);
1118 assert (a->mode == b->mode);
1120 switch (get_mode_modecode(a->mode)) {
1123 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1125 tv->u.f = a->u.f / b->u.f; /* @@@ overflow etc */
1128 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1130 tv->u.d = a->u.d / b->u.d; /* @@@ overflow etc */
1133 a = tarval_convert_to (a, mode_d);
1134 b = tarval_convert_to (b, mode_d);
1135 return a && b ? tarval_quo (a, b) : NULL;
1138 return tarval_identify (tv);
1142 /* Return `a/b' if computable, else NULL. Modes must be equal. */
1144 tarval_div (tarval *a, tarval *b)
1148 TARVAL_VRFY (a); TARVAL_VRFY (b);
1149 assert (a->mode == b->mode);
1151 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1155 switch (get_mode_modecode(a->mode)) {
1157 case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */
1158 case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */
1160 case irm_C: case irm_H: case irm_I: case irm_L:
1161 if (!b->u.CHIL) goto fail;
1162 tv->u.CHIL = a->u.CHIL / b->u.CHIL;
1165 case irm_c: case irm_h: case irm_i: case irm_l:
1167 || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (get_mode_max(a->mode)) ))) {
1169 obstack_free (&tv_obst, tv);
1172 tv->u.chil = a->u.chil / b->u.chil;
1175 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1176 mpz_init (&tv->u.Z);
1177 mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
1180 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1184 return tarval_identify (tv);
1188 /* Return `a%b' if computable, else NULL. Modes must be equal. */
1190 tarval_mod (tarval *a, tarval *b)
1194 TARVAL_VRFY (a); TARVAL_VRFY (b);
1195 assert (a->mode == b->mode);
1197 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1201 switch (get_mode_modecode(a->mode)) {
1203 case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */
1204 case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */
1206 case irm_C: case irm_H: case irm_I: case irm_L:
1207 if (!b->u.CHIL) goto fail;
1208 tv->u.CHIL = a->u.CHIL % b->u.CHIL;
1211 case irm_c: case irm_h: case irm_i: case irm_l:
1214 obstack_free (&tv_obst, tv);
1217 tv->u.chil = a->u.chil % b->u.chil;
1220 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1221 mpz_init (&tv->u.Z);
1222 mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
1225 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1229 return tarval_identify (tv);
1233 /* Return `a&b'. Modes must be equal. */
1235 tarval_and (tarval *a, tarval *b)
1239 TARVAL_VRFY (a); TARVAL_VRFY (b);
1240 assert (a->mode == b->mode);
1242 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1246 switch (get_mode_modecode(a->mode)) {
1248 case irm_C: case irm_H: case irm_I: case irm_L:
1249 tv->u.CHIL = a->u.CHIL & b->u.CHIL; break;
1251 case irm_c: case irm_h: case irm_i: case irm_l:
1252 tv->u.chil = a->u.chil & b->u.chil; break;
1254 mpz_init (&tv->u.Z);
1255 mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
1258 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1262 return tarval_identify (tv);
1266 /* Return `a|b'. Modes must be equal. */
1268 tarval_or (tarval *a, tarval *b)
1272 TARVAL_VRFY (a); TARVAL_VRFY (b);
1273 assert (a->mode == b->mode);
1275 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1279 switch (get_mode_modecode(a->mode)) {
1281 case irm_C: case irm_H: case irm_I: case irm_L:
1282 tv->u.CHIL = a->u.CHIL | b->u.CHIL; break;
1284 case irm_c: case irm_h: case irm_i: case irm_l:
1285 tv->u.chil = a->u.chil | b->u.chil; break;
1287 mpz_init (&tv->u.Z);
1288 mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
1291 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1295 return tarval_identify (tv);
1299 /* Return `a^b'. Modes must be equal. */
1301 tarval_eor (tarval *a, tarval *b)
1305 TARVAL_VRFY (a); TARVAL_VRFY (b);
1306 assert (a->mode == b->mode);
1308 #if 1 /* see case irm_Z below */
1309 if (a->mode == mode_Z) return NULL;
1312 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1316 switch (get_mode_modecode(a->mode)) {
1318 case irm_C: case irm_H: case irm_I: case irm_L:
1319 tv->u.CHIL = a->u.CHIL ^ b->u.CHIL; break;
1321 case irm_c: case irm_h: case irm_i: case irm_l:
1322 tv->u.chil = a->u.chil ^ b->u.chil; break;
1324 #if 0 /* gmp-1.3.2 declares but does not define mpz_xor() */
1325 mpz_init (&tv->u.Z);
1326 mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
1330 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1334 return tarval_identify (tv);
1338 /* Return `a<<b' if computable, else NULL. */
1340 tarval_shl (tarval *a, tarval *b)
1346 TARVAL_VRFY (a); TARVAL_VRFY (b);
1348 shift = tarval_ord (b, &b_is_huge);
1351 || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) {
1355 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1358 switch (get_mode_modecode(a->mode)) {
1360 case irm_C: case irm_H: case irm_I: case irm_L:
1361 tv->u.CHIL = a->u.CHIL << shift;
1364 case irm_c: case irm_h: case irm_i: case irm_l:
1365 tv->u.chil = a->u.chil << shift;
1368 mpz_init (&tv->u.Z);
1369 mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
1371 default: assert (0);
1374 return tarval_identify (tv);
1378 /* Return `a>>b' if computable, else NULL. */
1380 tarval_shr (tarval *a, tarval *b)
1386 TARVAL_VRFY (a); TARVAL_VRFY (b);
1388 shift = tarval_ord (b, &b_is_huge);
1391 || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) {
1395 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1398 switch (get_mode_modecode(a->mode)) {
1400 case irm_C: case irm_H: case irm_I: case irm_L:
1401 tv->u.CHIL = a->u.CHIL >> shift;
1404 case irm_c: case irm_h: case irm_i: case irm_l:
1405 tv->u.chil = a->u.chil >> shift;
1408 mpz_init (&tv->u.Z);
1409 mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
1411 default: assert (0);
1414 return tarval_identify (tv);
1418 /* Classify `tv', which may be NULL.
1419 Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1420 multiplicative neutral element, and -1 if `tv' is the neutral
1421 element of bitwise and. */
1423 tarval_classify (tarval *tv)
1429 switch (get_mode_modecode(tv->mode)) {
1431 case irm_f: case irm_d:
1435 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_C))) - 1;
1437 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_H))) - 1;
1439 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_I))) - 1;
1441 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_L))) - 1;
1443 case irm_c: case irm_h: case irm_i: case irm_l:
1446 if (mpz_cmp_si (&tv->u.Z, 0)) return 0;
1447 else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
1448 else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
1460 tarval_s_fits (tarval *tv, long min, long max) {
1461 return (( mpz_cmp_si (&tv->u.Z, min) >= 0)
1462 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1466 tarval_u_fits (tarval *tv, unsigned long max) {
1467 return (( mpz_sgn (&tv->u.Z) >= 0)
1468 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1472 /* Convert `tv' into type `long', set `fail' if not representable.
1473 If `fail' gets set for an unsigned `tv', the correct result can be
1474 obtained by casting the result to `unsigned long'. */
1476 tarval_ord (tarval *tv, int *fail)
1480 switch (get_mode_modecode(tv->mode)) {
1482 case irm_C: case irm_H: case irm_I: case irm_L:
1483 *fail = tv->u.CHIL > tv_val_CHIL (get_mode_max(mode_l));
1486 case irm_c: case irm_h: case irm_i: case irm_l:
1490 *fail = ( (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) > 0)
1491 || (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) < 0));
1492 return mpz_get_si (&tv->u.Z);
1506 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1508 tarval *val = XP_GETARG (tarval *, 0);
1513 switch (get_mode_modecode(val->mode)) {
1515 case irm_T: /* none */
1516 printed = XPSR ("<bad>");
1519 case irm_f: /* float */
1520 printed = XPF1R ("%g", (double)(val->u.f));
1522 case irm_d: /* double */
1523 printed = XPF1R ("%g", (double)(val->u.d));
1526 case irm_c: /* signed char */
1527 case irm_C: /* unsigned char */
1528 if (isprint (val->u.chil)) {
1529 printed = XPF1R ("'%c'", val->u.chil);
1531 printed = XPF1R ("'\\%03o'", val->u.chil);
1535 case irm_h: case irm_i: case irm_l: /* signed num */
1536 printed = XPF1R ("%ld", (long)val->u.chil);
1538 case irm_H: case irm_I: case irm_L: /* unsigned num */
1539 printed = XPF1R ("%lu", (unsigned long)val->u.CHIL);
1542 case irm_Z: /* mp int */
1543 printed = XPF1R ("%Z", &val->u.Z);
1546 case irm_p: /* pointer */
1547 if (val->u.p.xname) {
1548 printed = XPR (val->u.p.xname);
1549 } else if (val->u.p.ent) {
1550 printed = XPF1R ("(%I)", val->u.p.ent->name);
1552 assert (val == tarval_p_void);
1553 printed = XPSR ("(void)");
1557 case irm_b: /* boolean */
1558 if (val->u.b) printed = XPSR ("true");
1559 else printed = XPSR ("false");
1562 case irm_B: /* universal bits */
1563 printed = XPSR ("<@@@ some bits>");
1566 case irm_s: /* string */
1569 char *buf = alloca (val->u.s.n + 2);
1575 for (i = 0; i < val->u.s.n; ++i) {
1576 if (isprint (val->u.s.p[i])) {
1577 *bp++ = val->u.s.p[i];
1583 XPF1 ("'\\%03o'", val->u.s.p[i]);
1592 case irm_M: /* memory */
1593 case irm_R: /* region */
1602 get_tv_mode (tarval *tv)