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"
47 # include "entity_t.h"
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(mode->code));
142 return (mode->min && mode->max /* only valid after firm initialization */
143 && (chil < tv_val_chil (mode->min) || tv_val_chil (mode->max) < chil));
147 /* Overflows `CHIL' unsigned integral `mode'? */
149 CHIL_overflow (tarval_CHIL CHIL, ir_mode *mode)
151 assert (is_chilCHIL(mode->code));
152 return (mode->max /* only valid after firm initialization */
153 && tv_val_CHIL (mode->max) < CHIL);
159 _tarval_vrfy (const tarval *val)
162 switch (val->mode->code) {
168 case irm_C: case irm_H: case irm_I: case irm_L:
169 assert (!CHIL_overflow (val->u.CHIL, val->mode)); break;
170 case irm_c: case irm_h: case irm_i: case irm_l:
171 assert (!chil_overflow (val->u.chil, val->mode)); break;
177 assert (val->u.p.ent->kind == k_entity);
178 assert ( val->u.p.xname || val->u.p.ent
179 || !tarval_p_void || (val == tarval_p_void));
183 assert (val->u.s.p); break;
185 assert (val->u.B.p); break;
187 assert ((unsigned)val->u.b <= 1); break;
189 assert (val->mode == mode_T);
200 pset_stats (tarvals);
206 /* Return the canonical tarval * for tv.
207 May destroy everything allocated on tv_obst after tv! */
209 tarval_identify (tarval *tv)
213 o = pset_insert (tarvals, tv, tarval_hash (tv));
216 obstack_free (&tv_obst, (void *)tv);
224 /* Return 0 iff a equals b. Bitwise identical NaNs compare equal. */
226 tarval_cmp (const void *p, const void *q)
234 if (a == b) return 0;
235 if (a->mode - b->mode) return a->mode - b->mode;
237 switch (a->mode->code) {
240 return memcmp (&a->u.f, &b->u.f, sizeof (a->u.f));
242 return memcmp (&a->u.d, &b->u.d, sizeof (a->u.d));
244 case irm_C: case irm_H: case irm_I: case irm_L:
245 if (sizeof (int) == sizeof (tarval_CHIL)) {
246 return a->u.CHIL - b->u.CHIL;
248 return a->u.CHIL != b->u.CHIL;
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;
254 return a->u.chil != b->u.chil;
256 return mpz_cmp (&a->u.Z, &b->u.Z);
259 if (a->u.p.ent || b->u.p.ent)
260 return (char *)a->u.p.ent - (char *)b->u.p.ent;
261 if (a->u.p.xname && b->u.p.xname)
262 return strcmp (a->u.p.xname, b->u.p.xname);
263 return a->u.p.xname - b->u.p.xname;
265 return a->u.b - b->u.b;
267 return ( a->u.B.n - b->u.B.n
268 ? memcmp (a->u.B.p, b->u.B.p, a->u.B.n)
269 : a->u.B.n - b->u.B.n);
270 case irm_s: case irm_S:
271 return ( a->u.s.n == b->u.s.n
272 ? memcmp (a->u.s.p, b->u.s.p, a->u.s.n)
273 : a->u.s.n - b->u.s.n);
280 tarval_hash (tarval *tv)
284 h = tv->mode->code * 0x421u;
285 switch (tv->mode->code) {
287 h = 0x94b527ce; break;
290 { union { float f; unsigned u; } u;
291 assert (sizeof (float) <= sizeof (unsigned));
292 u.u = 0; u.f = tv->u.f;
298 { union { double d; unsigned u[2]; } u;
299 assert (sizeof (double) <= 2*sizeof (unsigned));
300 u.u[0] = u.u[1] = 0; u.d = tv->u.d;
301 h ^= u.u[0] ^ u.u[1];
304 case irm_C: case irm_H: case irm_I: case irm_L:
305 h ^= tv->u.CHIL; break;
306 case irm_c: case irm_h: case irm_i: case irm_l:
307 h ^= tv->u.chil; break;
309 h ^= mpz_get_ui (&tv->u.Z); break;
312 /* @@@ lower bits not random, watch for collisions; perhaps
313 replace by tv->u.p.ent - (entity *)0 */
314 h ^= ((char *)tv->u.p.ent - (char *)0) / 64;
315 } else if (tv->u.p.xname) {
316 /* Of course, strlen() in a hash function is a mistake, but this
317 case should be really rare. */
318 h ^= ID_HASH (tv->u.p.xname, strlen (tv->u.p.xname));
326 h ^= tv->u.B.n; break; /* @@@ not really good */
328 h ^= tv->u.s.p[0]<<12 ^ tv->u.s.p[tv->u.s.n]<<4 ^ tv->u.s.n; break;
330 h ^= tv->u.s.p[0]<<4 ^ tv->u.s.p[tv->u.s.n]<<12 ^ tv->u.s.n; break;
339 /******************** Initialization ****************************************/
344 obstack_init (&tv_obst);
345 obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1;
346 assert (IS_POW2 (ALIGNOF (tarval)));
348 /* initialize the target value table */
349 tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS);
356 union ieee754_double x;
358 /* assumed by tarval_hash(): */
359 assert (sizeof (float) * CHAR_BIT == 32);
360 assert (sizeof (double) * CHAR_BIT == 64);
363 /* assumed by tarval_chil & friends: */
364 assert ( (irm_C == irm_c+1) && (irm_h == irm_C+1)
365 && (irm_H == irm_h+1) && (irm_i == irm_H+1)
366 && (irm_I == irm_i+1) && (irm_l == irm_I+1)
367 && (irm_L == irm_l+1));
369 /* assumed everywhere: */
370 for (i = 0; i <= irm_L-irm_c; i += 2) {
371 assert ( IS_POW2 (max_chil[i+1]+1)
372 && (min_chil[i] == -max_chil[i]-1)
373 && ((tarval_CHIL)max_chil[i+1] == (tarval_CHIL)max_chil[i]-min_chil[i]));
378 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
380 tarval_bad = tarval_identify (tv);
382 tarval_b_false = tarval_from_long (mode_b, 0);
383 tarval_b_true = tarval_from_long (mode_b, 1);
385 /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
386 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
389 x.ieee.exponent = 0x7ff;
390 x.ieee.mantissa0 = 0;
391 x.ieee.mantissa1 = 0;
393 tarval_d_Inf = tarval_identify (tv);
395 /* IsNaN <-> exponent==0x7ff && (qnan_bit | bits | fraction_low) */
396 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));
409 tv->u.p.xname = NULL;
412 tarval_p_void = tarval_identify (tv);
414 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
417 tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0);
418 tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0);
419 tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0);
420 tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
421 tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0);
422 tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0);
423 tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0);
424 tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0);
425 tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0);
426 tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0);
427 tarval_mode_null [irm_b] = tarval_b_false;
428 tarval_mode_null [irm_p] = tarval_p_void;
433 /************************* Constructors for tarvals *************************/
435 /* copy from src to dst len chars omitting '_'. */
437 stripcpy (char *dst, const char *src, size_t len)
442 if (*src == '_') src++;
445 *d = 0; /* make it 0-terminated. */
452 tarval_Z_from_str (const char *s, size_t len, int base)
459 buf = alloca (len+1);
460 stripcpy (buf, s, len);
462 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
464 if (mpz_init_set_str (&tv->u.Z, buf, base)) assert (0);
466 return tarval_identify (tv);
471 tarval_B_from_str (const char *s, size_t len)
474 size_t n; /* size of B */
475 const char *r; /* read ptr */
476 unsigned x; /* bit store */
477 int b; /* bits in x */
478 int shift; /* base shift */
483 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
486 assert (s[0] == '0');
489 case 'O': shift = 3; break;
491 case 'X': shift = 4; break;
495 r = s+len; /* set r past input */
496 s += 2; /* skip header */
501 if (*r == '_') continue; /* skip _ styropor */
502 if (('0' <= *r) && (*r <= '9')) {
504 } else if (('a' <= *r) && (*r <= 'f')) {
506 } else { assert (('A' <= *r) && (*r <= 'F'));
510 x |= d << b; /* insert d into x above the b present bits */
511 b += shift; /* x now contains shift more bits */
513 if (b >= 8) { /* we've accumulated at least a byte */
514 char c = x & 0xFF; /* extract the lower 8 bits from x */
515 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
516 x >>= 8; /* remove the lower 8 bits from x */
517 b -= 8; /* x now contains 8 bits fewer */
518 ++n; /* B grew a byte */
522 if (b >= 0) { /* flush the rest of the bits */
523 char c = x; /* extract them */
524 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
525 ++n; /* B grew a byte */
528 { unsigned char *p = obstack_finish (&tv_obst);
529 unsigned char *q = p + n;
533 /* reverse p in place */
534 while (p < q) { char c = *p; *p++ = *q; *q-- = c; }
537 return tarval_identify (tv);
542 tarval_d_from_str (const char *s, size_t len)
550 buf = alloca (len+1);
551 stripcpy (buf, s, len);
553 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
555 tv->u.d = strtod (buf, &eptr);
556 assert (eptr == buf+strlen(buf));
558 return tarval_identify (tv);
563 tarval_s_from_str (const char *s, size_t len)
569 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
573 tv->u.s.p = obstack_copy (&tv_obst, s, len);
575 return tarval_identify (tv);
579 tarval_S_from_str (const char *s, size_t len)
585 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
589 tv->u.s.p = obstack_copy (&tv_obst, s, len);
591 return tarval_identify (tv);
595 /* Create a tarval with mode `m' and value `i' casted to the type that
596 represents such tarvals on host. The resulting value must be legal
599 tarval_from_long (ir_mode *m, long val)
605 if (m == mode_T) return tarval_bad;
607 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
613 tv->u.f = val; break;
615 tv->u.d = val; break;
617 case irm_C: case irm_H: case irm_I: case irm_L:
618 tv->u.CHIL = val; break;
620 case irm_c: case irm_h: case irm_i: case irm_l:
621 tv->u.chil = val; break;
623 mpz_init_set_si (&tv->u.Z, val);
628 obstack_free (&tv_obst, tv);
629 return tarval_p_void;
631 tv->u.b = !!val; /* u.b must be 0 or 1 */
637 return tarval_identify (tv);
642 tarval_p_from_str (const char *xname)
648 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
651 tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
654 return tarval_identify (tv);
659 tarval_p_from_entity (entity *ent)
665 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
668 tv->u.p.xname = NULL;
671 return tarval_identify (tv);
675 /* Routines for building a tarval step by step follow.
676 Legal calling sequences:
678 No contructors except tarval_append() and tarval_append1 ()
679 tarval_finish_as() or tarval_cancel() */
681 /* Begin building a tarval. */
686 obstack_blank (&tv_obst, sizeof (tarval));
690 /* Append `n' chars from `p' to the tarval currently under construction. */
692 tarval_append (const char *p, size_t n)
695 obstack_grow (&tv_obst, p, n);
699 /* Append `ch' to the tarval currently under construction. */
701 tarval_append1 (char ch)
704 obstack_1grow (&tv_obst, ch);
708 /* Finish the tarval currently under construction and give id mode `m'.
709 `m' must be irm_C, irm_B, irm_s or irm_S.
710 Return NULL if the value does not make sense for this mode, this
711 can only happen in mode C. */
713 tarval_finish_as (ir_mode *m)
715 int size = obstack_object_size (&tv_obst) - sizeof (tarval);
718 char ch = 0; /* initialized to shut up gcc */
720 assert (BUILDING && (size >= 0));
722 if (size != 1) return tarval_cancel();
723 p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
725 obstack_blank (&tv_obst, -size);
727 tv = obstack_finish (&tv_obst);
728 p = (unsigned char *)tv + sizeof (tarval);
751 return tarval_identify (tv);
755 /* Cancel tarval building and return tarval_bad. */
760 obstack_free (&tv_obst, obstack_finish (&tv_obst));
766 /********************* Arithmethic operations on tarvals ********************/
768 /* Return `src' converted to mode `m' if representable, else NULL.
769 @@@ lots of conversions missing */
771 tarval_convert_to (tarval *src, ir_mode *m)
775 if (m == src->mode) return src;
777 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
780 switch (src->mode->code) {
783 if (m != mode_f) goto fail;
790 case irm_C: case irm_H: case irm_I: case irm_L:
791 if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail;
792 if (mpz_size (&src->u.Z) > 1) goto fail;
793 tv->u.CHIL = mpz_get_ui (&src->u.Z);
794 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
797 case irm_c: case irm_h: case irm_i: case irm_l:
798 tv->u.chil = mpz_get_si (&src->u.Z);
799 if (chil_overflow (tv->u.chil, m)) goto fail;
803 tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0);
807 if (mpz_cmp_ui (&src->u.Z, 0)) goto fail;
808 obstack_free (&tv_obst, tv);
809 return tarval_p_void;
815 case irm_c: case irm_h: case irm_i: case irm_l:
817 case irm_c: case irm_h: case irm_i: case irm_l:
818 tv->u.chil = src->u.chil;
819 if (chil_overflow (tv->u.chil, m)) goto fail;
822 case irm_C: case irm_H: case irm_I: case irm_L:
823 tv->u.CHIL = src->u.chil;
824 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
828 mpz_init_set_si (&tv->u.Z, src->u.chil);
832 tv->u.b = !!src->u.chil;
838 case irm_C: case irm_H: case irm_I: case irm_L:
840 case irm_c: case irm_h: case irm_i: case irm_l:
841 tv->u.chil = src->u.CHIL;
842 if (chil_overflow (tv->u.chil, m)) goto fail;
845 case irm_C: case irm_H: case irm_I: case irm_L:
846 tv->u.CHIL = src->u.CHIL;
847 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
851 mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
855 tv->u.b = !!src->u.CHIL;
864 case irm_c: case irm_h: case irm_i: case irm_l:
865 tv->u.chil = src->u.b;
868 case irm_C: case irm_H: case irm_I: case irm_L:
869 tv->u.CHIL = src->u.b;
877 obstack_free (&tv_obst, tv);
881 return tarval_identify (tv);
886 tarval_neg (tarval *a)
892 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
896 switch (a->mode->code) {
898 case irm_f: tv->u.f = -a->u.f; break;
899 case irm_d: tv->u.d = -a->u.d; break;
901 case irm_C: case irm_H: case irm_I: case irm_L:
902 tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (a->mode->max);
905 case irm_c: case irm_h: case irm_i: case irm_l:
906 tv->u.chil = -a->u.chil;
907 if ( chil_overflow (tv->u.chil, a->mode)
908 || ((tv->u.chil >= 0) == (a->u.chil >= 0))) {
909 obstack_free (&tv_obst, tv);
915 mpz_neg (&tv->u.Z, &a->u.Z);
918 case irm_b: tv->u.b = !a->u.b; break;
922 return tarval_identify (tv);
926 /* Compare `a' with `b'.
927 Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
928 result is unknown. */
930 tarval_comp (tarval *a, tarval *b)
936 assert (a->mode == b->mode);
938 switch (a->mode->code) {
940 case irm_f: return ( a->u.f == b->u.f ? irpn_Eq
941 : a->u.f > b->u.f ? irpn_Gt
942 : a->u.f < b->u.f ? irpn_Lt
944 case irm_d: return ( a->u.d == b->u.d ? irpn_Eq
945 : a->u.d > b->u.d ? irpn_Gt
946 : a->u.d < b->u.d ? irpn_Lt
949 case irm_C: case irm_H: case irm_I: case irm_L:
950 return ( a->u.CHIL == b->u.CHIL ? irpn_Eq
951 : a->u.CHIL > b->u.CHIL ? irpn_Gt
954 case irm_c: case irm_h: case irm_i: case irm_l:
955 return ( a->u.chil == b->u.chil ? irpn_Eq
956 : a->u.chil > b->u.chil ? irpn_Gt
959 { int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
960 return ( cmp == 0 ? irpn_Eq
965 case irm_b: return ( a->u.b == b->u.b ? irpn_Eq
966 : a->u.b > b->u.b ? irpn_Gt
968 /* The following assumes that pointers are unsigned, which is valid
969 for all sane CPUs (transputers are insane). */
970 case irm_p: return ( a == b ? irpn_Eq
971 : a == tarval_p_void ? irpn_Lt
972 : b == tarval_p_void ? irpn_Gt
973 : irpn_False); /* unknown */
979 /* Return `a+b' if computable, else NULL. Modes must be equal. */
981 tarval_add (tarval *a, tarval *b)
985 TARVAL_VRFY (a); TARVAL_VRFY (b);
986 assert (a->mode == b->mode);
988 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
992 switch (a->mode->code) {
994 case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */
995 case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */
997 case irm_C: case irm_H: case irm_I: case irm_L:
998 tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (a->mode->max);
1001 case irm_c: case irm_h: case irm_i: case irm_l:
1002 tv->u.chil = a->u.chil + b->u.chil;
1003 if ( chil_overflow (tv->u.chil, a->mode)
1004 || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) {
1005 obstack_free (&tv_obst, tv);
1010 mpz_init (&tv->u.Z);
1011 mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
1014 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1018 return tarval_identify (tv);
1022 /* Return `a-b' if computable, else NULL. Modes must be equal. */
1024 tarval_sub (tarval *a, tarval *b)
1028 TARVAL_VRFY (a); TARVAL_VRFY (b);
1029 assert (a->mode == b->mode);
1031 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1035 switch (a->mode->code) {
1037 case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */
1038 case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */
1040 case irm_C: case irm_H: case irm_I: case irm_L:
1041 tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (a->mode->max);
1044 case irm_c: case irm_h: case irm_i: case irm_l:
1045 tv->u.chil = a->u.chil - b->u.chil;
1046 if ( chil_overflow (tv->u.chil, a->mode)
1047 || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) {
1048 obstack_free (&tv_obst, tv);
1053 mpz_init (&tv->u.Z);
1054 mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
1057 case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
1061 return tarval_identify (tv);
1065 /* Return `a*b' if computable, else NULL. Modes must be equal. */
1067 tarval_mul (tarval *a, tarval *b)
1071 TARVAL_VRFY (a); TARVAL_VRFY (b);
1072 assert (a->mode == b->mode);
1074 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1078 switch (a->mode->code) {
1080 case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */
1081 case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */
1083 case irm_C: case irm_H: case irm_I: case irm_L:
1084 tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (a->mode->max);
1087 case irm_c: case irm_h: case irm_i: case irm_l:
1088 tv->u.chil = a->u.chil * b->u.chil;
1089 if ( chil_overflow (tv->u.chil, a->mode)
1090 || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) {
1091 obstack_free (&tv_obst, tv);
1096 mpz_init (&tv->u.Z);
1097 mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
1100 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1104 return tarval_identify (tv);
1108 /* Return floating-point `a/b' if computable, else NULL.
1109 Modes must be equal, non-floating-point operands are converted to irm_d. */
1111 tarval_quo (tarval *a, tarval *b)
1115 TARVAL_VRFY (a); TARVAL_VRFY (b);
1116 assert (a->mode == b->mode);
1118 switch (a->mode->code) {
1121 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1123 tv->u.f = a->u.f / b->u.f; /* @@@ overflow etc */
1126 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1128 tv->u.d = a->u.d / b->u.d; /* @@@ overflow etc */
1131 a = tarval_convert_to (a, mode_d);
1132 b = tarval_convert_to (b, mode_d);
1133 return a && b ? tarval_quo (a, b) : NULL;
1136 return tarval_identify (tv);
1140 /* Return `a/b' if computable, else NULL. Modes must be equal. */
1142 tarval_div (tarval *a, tarval *b)
1146 TARVAL_VRFY (a); TARVAL_VRFY (b);
1147 assert (a->mode == b->mode);
1149 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1153 switch (a->mode->code) {
1155 case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */
1156 case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */
1158 case irm_C: case irm_H: case irm_I: case irm_L:
1159 if (!b->u.CHIL) goto fail;
1160 tv->u.CHIL = a->u.CHIL / b->u.CHIL;
1163 case irm_c: case irm_h: case irm_i: case irm_l:
1165 || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (a->mode->max) ))) {
1167 obstack_free (&tv_obst, tv);
1170 tv->u.chil = a->u.chil / b->u.chil;
1173 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1174 mpz_init (&tv->u.Z);
1175 mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
1178 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1182 return tarval_identify (tv);
1186 /* Return `a%b' if computable, else NULL. Modes must be equal. */
1188 tarval_mod (tarval *a, tarval *b)
1192 TARVAL_VRFY (a); TARVAL_VRFY (b);
1193 assert (a->mode == b->mode);
1195 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1199 switch (a->mode->code) {
1201 case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */
1202 case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */
1204 case irm_C: case irm_H: case irm_I: case irm_L:
1205 if (!b->u.CHIL) goto fail;
1206 tv->u.CHIL = a->u.CHIL % b->u.CHIL;
1209 case irm_c: case irm_h: case irm_i: case irm_l:
1212 obstack_free (&tv_obst, tv);
1215 tv->u.chil = a->u.chil % b->u.chil;
1218 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1219 mpz_init (&tv->u.Z);
1220 mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
1223 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1227 return tarval_identify (tv);
1231 /* Return `a&b'. Modes must be equal. */
1233 tarval_and (tarval *a, tarval *b)
1237 TARVAL_VRFY (a); TARVAL_VRFY (b);
1238 assert (a->mode == b->mode);
1240 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1244 switch (a->mode->code) {
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 case irm_c: case irm_h: case irm_i: case irm_l:
1250 tv->u.chil = a->u.chil & b->u.chil; break;
1252 mpz_init (&tv->u.Z);
1253 mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
1256 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1260 return tarval_identify (tv);
1264 /* Return `a|b'. Modes must be equal. */
1266 tarval_or (tarval *a, tarval *b)
1270 TARVAL_VRFY (a); TARVAL_VRFY (b);
1271 assert (a->mode == b->mode);
1273 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1277 switch (a->mode->code) {
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 case irm_c: case irm_h: case irm_i: case irm_l:
1283 tv->u.chil = a->u.chil | b->u.chil; break;
1285 mpz_init (&tv->u.Z);
1286 mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
1289 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1293 return tarval_identify (tv);
1297 /* Return `a^b'. Modes must be equal. */
1299 tarval_eor (tarval *a, tarval *b)
1303 TARVAL_VRFY (a); TARVAL_VRFY (b);
1304 assert (a->mode == b->mode);
1306 #if 1 /* see case irm_Z below */
1307 if (a->mode == mode_Z) return NULL;
1310 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1314 switch (a->mode->code) {
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 case irm_c: case irm_h: case irm_i: case irm_l:
1320 tv->u.chil = a->u.chil ^ b->u.chil; break;
1322 #if 0 /* gmp-1.3.2 declares but does not define mpz_xor() */
1323 mpz_init (&tv->u.Z);
1324 mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
1328 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1332 return tarval_identify (tv);
1336 /* Return `a<<b' if computable, else NULL. */
1338 tarval_shl (tarval *a, tarval *b)
1344 TARVAL_VRFY (a); TARVAL_VRFY (b);
1346 shift = tarval_ord (b, &b_is_huge);
1349 || ((shift >= mode_l->size*target_bits) && (a->mode != mode_Z))) {
1353 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1356 switch (a->mode->code) {
1358 case irm_C: case irm_H: case irm_I: case irm_L:
1359 tv->u.CHIL = a->u.CHIL << shift;
1362 case irm_c: case irm_h: case irm_i: case irm_l:
1363 tv->u.chil = a->u.chil << shift;
1366 mpz_init (&tv->u.Z);
1367 mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
1369 default: assert (0);
1372 return tarval_identify (tv);
1376 /* Return `a>>b' if computable, else NULL. */
1378 tarval_shr (tarval *a, tarval *b)
1384 TARVAL_VRFY (a); TARVAL_VRFY (b);
1386 shift = tarval_ord (b, &b_is_huge);
1389 || ((shift >= mode_l->size*target_bits) && (a->mode != mode_Z))) {
1393 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1396 switch (a->mode->code) {
1398 case irm_C: case irm_H: case irm_I: case irm_L:
1399 tv->u.CHIL = a->u.CHIL >> shift;
1402 case irm_c: case irm_h: case irm_i: case irm_l:
1403 tv->u.chil = a->u.chil >> shift;
1406 mpz_init (&tv->u.Z);
1407 mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
1409 default: assert (0);
1412 return tarval_identify (tv);
1416 /* Classify `tv', which may be NULL.
1417 Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1418 multiplicative neutral element, and -1 if `tv' is the neutral
1419 element of bitwise and. */
1421 tarval_classify (tarval *tv)
1427 switch (tv->mode->code) {
1429 case irm_f: case irm_d:
1433 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_C->max)) - 1;
1435 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_H->max)) - 1;
1437 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_I->max)) - 1;
1439 return (long)((tv->u.CHIL+1) & tv_val_CHIL (mode_L->max)) - 1;
1441 case irm_c: case irm_h: case irm_i: case irm_l:
1444 if (mpz_cmp_si (&tv->u.Z, 0)) return 0;
1445 else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
1446 else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
1458 tarval_s_fits (tarval *tv, long min, long max) {
1459 return (( mpz_cmp_si (&tv->u.Z, min) >= 0)
1460 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1464 tarval_u_fits (tarval *tv, unsigned long max) {
1465 return (( mpz_sgn (&tv->u.Z) >= 0)
1466 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1470 /* Convert `tv' into type `long', set `fail' if not representable.
1471 If `fail' gets set for an unsigned `tv', the correct result can be
1472 obtained by casting the result to `unsigned long'. */
1474 tarval_ord (tarval *tv, int *fail)
1478 switch (tv->mode->code) {
1480 case irm_C: case irm_H: case irm_I: case irm_L:
1481 *fail = tv->u.CHIL > tv_val_CHIL (mode_l->max);
1484 case irm_c: case irm_h: case irm_i: case irm_l:
1488 *fail = ( (mpz_cmp_si (&tv->u.Z, tv_val_chil(mode_l->max)) > 0)
1489 || (mpz_cmp_si (&tv->u.Z, tv_val_chil(mode_l->min)) < 0));
1490 return mpz_get_si (&tv->u.Z);
1504 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1506 tarval *val = XP_GETARG (tarval *, 0);
1511 switch (val->mode->code) {
1513 case irm_T: /* none */
1514 printed = XPSR ("<bad>");
1517 case irm_f: /* float */
1518 printed = XPF1R ("%g", (double)(val->u.f));
1520 case irm_d: /* double */
1521 printed = XPF1R ("%g", (double)(val->u.d));
1524 case irm_c: /* signed char */
1525 case irm_C: /* unsigned char */
1526 if (isprint (val->u.chil)) {
1527 printed = XPF1R ("'%c'", val->u.chil);
1529 printed = XPF1R ("'\\%03o'", val->u.chil);
1533 case irm_h: case irm_i: case irm_l: /* signed num */
1534 printed = XPF1R ("%ld", (long)val->u.chil);
1536 case irm_H: case irm_I: case irm_L: /* unsigned num */
1537 printed = XPF1R ("%lu", (unsigned long)val->u.CHIL);
1540 case irm_Z: /* mp int */
1541 printed = XPF1R ("%Z", &val->u.Z);
1544 case irm_p: /* pointer */
1545 if (val->u.p.xname) {
1546 printed = XPR (val->u.p.xname);
1547 } else if (val->u.p.ent) {
1548 printed = XPF1R ("(%I)", val->u.p.ent->name);
1550 assert (val == tarval_p_void);
1551 printed = XPSR ("(void)");
1555 case irm_b: /* boolean */
1556 if (val->u.b) printed = XPSR ("true");
1557 else printed = XPSR ("false");
1560 case irm_B: /* universal bits */
1561 printed = XPSR ("<@@@ some bits>");
1564 case irm_s: /* string */
1567 char *buf = alloca (val->u.s.n + 2);
1573 for (i = 0; i < val->u.s.n; ++i) {
1574 if (isprint (val->u.s.p[i])) {
1575 *bp++ = val->u.s.p[i];
1581 XPF1 ("'\\%03o'", val->u.s.p[i]);
1590 case irm_M: /* memory */
1591 case irm_R: /* region */
1600 get_tv_mode (tarval *tv)