1 /* TV --- Target Values, aka Constant Table.
2 Copyright (C) 1995, 1996 Christian von Roques */
6 /* This implementation assumes:
7 * target characters/strings can be represented as type `char'/`char *',
8 * host's type `long'/`unsigned long' can hold values of mode `l'/`L',
9 * both host and target have two's complement integral arithmetic,
10 host's C operators `/' and `%' match target's div and mod.
11 target_max_<mode> == (1<<k)-1 for some k>0
12 target_min_<mode> == -target_max_<mode>-1
13 target_max_<Mode> == target_max_<mode>-target_min_<mode>
14 * both host and target have IEEE-754 floating-point arithmetic. */
16 /* !!! float and double divides MUST NOT SIGNAL !!! */
17 /* @@@ query the floating-point expception status flags */
19 /* @@@ ToDo: tarval_convert_to is not fully implemented! */
20 /* @@@ Problem: All Values are stored twice, once as Univ_*s and a 2nd
21 time in their real target mode. :-( */
22 /* @@@ Perhaps use a set instead of a pset: new tarvals allocated on
23 stack, copied into set by tarval_identify() if really new. If
24 tarval_identify() discards often enough, the extra copy for kept
25 values is cheaper than the extra obstack_alloc()/free() for
28 /* Defining this causes inclusions of functions renamed with new gmp.h */
29 #define _TARVAL_GMP_ 0
44 #define TOBSTACK_ID "tv"
53 static struct obstack tv_obst; /* obstack for all the target values */
54 static pset *tarvals; /* pset containing pointers to _all_ tarvals */
56 /* currently building an object with tarval_start() & friends ? */
57 #define BUILDING obstack_object_size (&tv_obst)
59 /* special tarvals: */
61 tarval *tarval_b_false;
62 tarval *tarval_b_true;
65 tarval *tarval_p_void;
66 tarval *tarval_mode_null[irm_max];
69 /* @@@ depends on order of ir_mode */
70 static tarval_chil min_chil[8] = {
76 static tarval_chil max_chil[8] = {
77 TARGET_SIMAX (c), TARGET_UIMAX (C),
78 TARGET_SIMAX (h), TARGET_UIMAX (H),
79 TARGET_SIMAX (i), TARGET_UIMAX (I),
80 TARGET_SIMAX (l), TARGET_UIMAX (L)
84 /* return a mode-specific value */
99 tv_val_chil (tarval *tv)
105 tv_val_CHIL (tarval *tv)
111 tv_val_Z (tarval *tv)
117 tv_val_p (tarval *tv)
123 tv_val_b (tarval *tv)
129 tv_val_B (tarval *tv)
135 tv_val_s (tarval *tv)
141 /* Overflows `chil' signed integral `mode'? */
143 chil_overflow (tarval_chil chil, ir_mode *mode)
145 assert (is_chilCHIL(get_mode_modecode(mode)));
146 return (get_mode_min(mode) && get_mode_max(mode) /* only valid after firm initialization */
147 && (chil < tv_val_chil (get_mode_min(mode))
148 || tv_val_chil (get_mode_max(mode)) < chil));
152 /* Overflows `CHIL' unsigned integral `mode'? */
154 CHIL_overflow (tarval_CHIL CHIL, ir_mode *mode)
156 assert (is_chilCHIL(get_mode_modecode(mode)));
157 return (get_mode_max(mode) /* only valid after firm initialization */
158 && tv_val_CHIL (get_mode_max(mode)) < CHIL);
164 _tarval_vrfy (const tarval *val)
167 switch (get_mode_modecode(val->mode)) {
173 case irm_C: case irm_H: case irm_I: case irm_L:
174 assert (!CHIL_overflow (val->u.CHIL, val->mode)); break;
175 case irm_c: case irm_h: case irm_i: case irm_l:
176 assert (!chil_overflow (val->u.chil, val->mode)); break;
182 assert (val->u.p.ent->kind == k_entity);
183 assert ( val->u.p.xname || val->u.p.ent
184 || !tarval_p_void || (val == tarval_p_void));
188 assert (val->u.s.p); break;
190 assert (val->u.B.p); break;
192 assert ((unsigned)val->u.b <= 1); break;
194 assert (val->mode == mode_T);
205 pset_stats (tarvals);
211 /* Return the canonical tarval * for tv.
212 May destroy everything allocated on tv_obst after tv! */
214 tarval_identify (tarval *tv)
218 o = pset_insert (tarvals, tv, tarval_hash (tv));
221 obstack_free (&tv_obst, (void *)tv);
229 /* Return 0 iff a equals b. Bitwise identical NaNs compare equal. */
231 tarval_cmp (const void *p, const void *q)
239 if (a == b) return 0;
240 if ((void *)a->mode - (void *)b->mode)
241 return (void *)a->mode - (void *)b->mode;
243 switch (get_mode_modecode(a->mode)) {
246 return memcmp (&a->u.f, &b->u.f, sizeof (a->u.f));
248 return memcmp (&a->u.d, &b->u.d, sizeof (a->u.d));
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 case irm_c: case irm_h: case irm_i: case irm_l:
257 if (sizeof (int) == sizeof (tarval_chil)) {
258 return a->u.chil - b->u.chil;
260 return a->u.chil != b->u.chil;
263 return mpz_cmp (&a->u.Z, &b->u.Z);
269 if (a->u.p.ent || b->u.p.ent)
270 return (char *)a->u.p.ent - (char *)b->u.p.ent;
271 if (a->u.p.xname && b->u.p.xname)
272 return strcmp (a->u.p.xname, b->u.p.xname);
273 return a->u.p.xname - b->u.p.xname;
275 return a->u.b - b->u.b;
277 return ( a->u.B.n - b->u.B.n
278 ? memcmp (a->u.B.p, b->u.B.p, a->u.B.n)
279 : a->u.B.n - b->u.B.n);
280 case irm_s: case irm_S:
281 return ( a->u.s.n == b->u.s.n
282 ? memcmp (a->u.s.p, b->u.s.p, a->u.s.n)
283 : a->u.s.n - b->u.s.n);
290 tarval_hash (tarval *tv)
294 h = get_mode_modecode(tv->mode) * 0x421u;
295 switch (get_mode_modecode(tv->mode)) {
297 h = 0x94b527ce; break;
300 { union { float f; unsigned u; } u;
301 assert (sizeof (float) <= sizeof (unsigned));
302 u.u = 0; u.f = tv->u.f;
308 { union { double d; unsigned u[2]; } u;
309 assert (sizeof (double) <= 2*sizeof (unsigned));
310 u.u[0] = u.u[1] = 0; u.d = tv->u.d;
311 h ^= u.u[0] ^ u.u[1];
314 case irm_C: case irm_H: case irm_I: case irm_L:
315 h ^= tv->u.CHIL; break;
316 case irm_c: case irm_h: case irm_i: case irm_l:
317 h ^= tv->u.chil; break;
320 h ^= mpz_get_ui (&tv->u.Z); break;
322 h ^= (unsigned int) tv; break; /* tut das? */
326 /* @@@ lower bits not random, watch for collisions; perhaps
327 replace by tv->u.p.ent - (entity *)0 */
328 h ^= ((char *)tv->u.p.ent - (char *)0) / 64;
329 } else if (tv->u.p.xname) {
330 /* Of course, strlen() in a hash function is a mistake, but this
331 case should be really rare. */
332 h ^= ID_HASH (tv->u.p.xname, strlen (tv->u.p.xname));
340 h ^= tv->u.B.n; break; /* @@@ not really good */
342 h ^= tv->u.s.p[0]<<12 ^ tv->u.s.p[tv->u.s.n]<<4 ^ tv->u.s.n; break;
344 h ^= tv->u.s.p[0]<<4 ^ tv->u.s.p[tv->u.s.n]<<12 ^ tv->u.s.n; break;
353 /*** ***************** Initialization ************************************* ***/
358 obstack_init (&tv_obst);
359 obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1;
360 assert (IS_POW2 (ALIGNOF (tarval)));
362 /* initialize the target value table */
363 tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS);
370 union ieee754_double x;
372 /* assumed by tarval_hash(): */
373 assert (sizeof (float) * CHAR_BIT == 32);
374 assert (sizeof (double) * CHAR_BIT == 64);
377 /* assumed by tarval_chil & friends: */
378 assert ( (irm_C == irm_c+1) && (irm_h == irm_C+1)
379 && (irm_H == irm_h+1) && (irm_i == irm_H+1)
380 && (irm_I == irm_i+1) && (irm_l == irm_I+1)
381 && (irm_L == irm_l+1));
383 /* assumed everywhere: */
384 for (i = 0; i <= irm_L-irm_c; i += 2) {
385 assert ( IS_POW2 (max_chil[i+1]+1)
386 && (min_chil[i] == -max_chil[i]-1)
387 && ((tarval_CHIL)max_chil[i+1] == (tarval_CHIL)max_chil[i]-min_chil[i]));
392 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
394 tarval_bad = tarval_identify (tv);
396 tarval_b_false = tarval_from_long (mode_b, 0);
397 tarval_b_true = tarval_from_long (mode_b, 1);
399 /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */
400 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
403 x.ieee.exponent = 0x7ff;
404 x.ieee.mantissa0 = 0;
405 x.ieee.mantissa1 = 0;
407 tarval_d_Inf = tarval_identify (tv);
409 /* IsNaN <-> exponent==0x7ff && (qnan_bit | bits | fraction_low) */
410 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
412 x.ieee_nan.negative = 0;
413 x.ieee_nan.exponent = 0x7ff;
414 x.ieee_nan.quiet_nan = 1; /* @@@ quiet or signalling? */
415 x.ieee_nan.mantissa0 = 42;
416 x.ieee_nan.mantissa1 = 0;
417 assert(x.d != x.d /* x.d is NaN */);
419 tarval_d_NaN = tarval_identify (tv);
421 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
423 tv->u.p.xname = NULL;
426 tarval_p_void = tarval_identify (tv);
428 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
431 tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0);
432 tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0);
433 tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0);
434 tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0);
435 tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0);
436 tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0);
437 tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0);
438 tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0);
439 tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0);
440 tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0);
441 tarval_mode_null [irm_b] = tarval_b_false;
442 tarval_mode_null [irm_p] = tarval_p_void;
447 /*** ********************** Constructors for tarvals ********************** ***/
449 /* copy from src to dst len chars omitting '_'. */
451 stripcpy (char *dst, const char *src, size_t len)
456 if (*src == '_') src++;
459 *d = 0; /* make it 0-terminated. */
466 tarval_Z_from_str (const char *s, size_t len, int base)
473 buf = alloca (len+1);
474 stripcpy (buf, s, len);
476 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
479 if (mpz_init_set_str (&tv->u.Z, buf, base)) assert (0);
481 assert(0 && "no support for Z in tv!");
484 return tarval_identify (tv);
489 tarval_B_from_str (const char *s, size_t len)
492 size_t n; /* size of B */
493 const char *r; /* read ptr */
494 unsigned x; /* bit store */
495 int b; /* bits in x */
496 int shift; /* base shift */
501 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
504 assert (s[0] == '0');
507 case 'O': shift = 3; break;
509 case 'X': shift = 4; break;
513 r = s+len; /* set r past input */
514 s += 2; /* skip header */
519 if (*r == '_') continue; /* skip _ styropor */
520 if (('0' <= *r) && (*r <= '9')) {
522 } else if (('a' <= *r) && (*r <= 'f')) {
524 } else { assert (('A' <= *r) && (*r <= 'F'));
528 x |= d << b; /* insert d into x above the b present bits */
529 b += shift; /* x now contains shift more bits */
531 if (b >= 8) { /* we've accumulated at least a byte */
532 char c = x & 0xFF; /* extract the lower 8 bits from x */
533 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
534 x >>= 8; /* remove the lower 8 bits from x */
535 b -= 8; /* x now contains 8 bits fewer */
536 ++n; /* B grew a byte */
540 if (b >= 0) { /* flush the rest of the bits */
541 char c = x; /* extract them */
542 obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */
543 ++n; /* B grew a byte */
546 { unsigned char *p = obstack_finish (&tv_obst);
547 unsigned char *q = p + n;
551 /* reverse p in place */
552 while (p < q) { char c = *p; *p++ = *q; *q-- = c; }
555 return tarval_identify (tv);
560 tarval_d_from_str (const char *s, size_t len)
568 buf = alloca (len+1);
569 stripcpy (buf, s, len);
571 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
573 tv->u.d = strtod (buf, &eptr);
574 assert (eptr == buf+strlen(buf));
576 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 tarval_S_from_str (const char *s, size_t len)
603 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
607 tv->u.s.p = obstack_copy (&tv_obst, s, len);
609 return tarval_identify (tv);
613 /* Create a tarval with mode `m' and value `i' casted to the type that
614 represents such tarvals on host. The resulting value must be legal
617 tarval_from_long (ir_mode *m, long val)
623 if (m == mode_T) return tarval_bad;
625 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
628 switch (get_mode_modecode(m)) {
631 tv->u.f = val; break;
633 tv->u.d = val; break;
635 case irm_C: case irm_H: case irm_I: case irm_L:
636 tv->u.CHIL = val; break;
638 case irm_c: case irm_h: case irm_i: case irm_l:
639 tv->u.chil = val; break;
642 mpz_init_set_si (&tv->u.Z, val);
644 assert(0 && "no support for Z in tv!");
650 obstack_free (&tv_obst, tv);
651 return tarval_p_void;
653 tv->u.b = !!val; /* u.b must be 0 or 1 */
659 return tarval_identify (tv);
664 tarval_p_from_str (const char *xname)
670 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
673 tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname));
676 return tarval_identify (tv);
681 tarval_p_from_entity (entity *ent)
687 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
690 tv->u.p.xname = NULL;
693 return tarval_identify (tv);
697 /* Routines for building a tarval step by step follow.
698 Legal calling sequences:
700 No contructors except tarval_append() and tarval_append1 ()
701 tarval_finish_as() or tarval_cancel() */
703 /* Begin building a tarval. */
708 obstack_blank (&tv_obst, sizeof (tarval));
712 /* Append `n' chars from `p' to the tarval currently under construction. */
714 tarval_append (const char *p, size_t n)
717 obstack_grow (&tv_obst, p, n);
721 /* Append `ch' to the tarval currently under construction. */
723 tarval_append1 (char ch)
726 obstack_1grow (&tv_obst, ch);
730 /* Finish the tarval currently under construction and give id mode `m'.
731 `m' must be irm_C, irm_B, irm_s or irm_S.
732 Return NULL if the value does not make sense for this mode, this
733 can only happen in mode C. */
735 tarval_finish_as (ir_mode *m)
737 int size = obstack_object_size (&tv_obst) - sizeof (tarval);
740 char ch = 0; /* initialized to shut up gcc */
742 assert (BUILDING && (size >= 0));
744 if (size != 1) return tarval_cancel();
745 p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval);
747 obstack_blank (&tv_obst, -size);
749 tv = obstack_finish (&tv_obst);
750 p = (unsigned char *)tv + sizeof (tarval);
753 switch (get_mode_modecode(m)) {
773 return tarval_identify (tv);
777 /* Cancel tarval building and return tarval_bad. */
782 obstack_free (&tv_obst, obstack_finish (&tv_obst));
788 /*** ****************** Arithmethic operations on tarvals ***************** ***/
790 /* Return `src' converted to mode `m' if representable, else NULL.
791 @@@ lots of conversions missing */
793 tarval_convert_to (tarval *src, ir_mode *m)
797 if (m == src->mode) return src;
799 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
802 switch (get_mode_modecode(src->mode)) {
805 if (m != mode_f) goto fail;
811 switch (get_mode_modecode(m)) {
813 case irm_C: case irm_H: case irm_I: case irm_L:
814 if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail;
815 if (mpz_size (&src->u.Z) > 1) goto fail;
816 tv->u.CHIL = mpz_get_ui (&src->u.Z);
817 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
820 case irm_c: case irm_h: case irm_i: case irm_l:
821 tv->u.chil = mpz_get_si (&src->u.Z);
822 if (chil_overflow (tv->u.chil, m)) goto fail;
826 tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0);
830 if (mpz_cmp_ui (&src->u.Z, 0)) goto fail;
831 obstack_free (&tv_obst, tv);
832 return tarval_p_void;
841 case irm_c: case irm_h: case irm_i: case irm_l:
842 switch (get_mode_modecode(m)) {
843 case irm_c: case irm_h: case irm_i: case irm_l:
844 tv->u.chil = src->u.chil;
845 if (chil_overflow (tv->u.chil, m)) goto fail;
848 case irm_C: case irm_H: case irm_I: case irm_L:
849 tv->u.CHIL = src->u.chil;
850 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
855 mpz_init_set_si (&tv->u.Z, src->u.chil);
862 tv->u.b = !!src->u.chil;
868 case irm_C: case irm_H: case irm_I: case irm_L:
869 switch (get_mode_modecode(m)) {
870 case irm_c: case irm_h: case irm_i: case irm_l:
871 tv->u.chil = src->u.CHIL;
872 if (chil_overflow (tv->u.chil, m)) goto fail;
875 case irm_C: case irm_H: case irm_I: case irm_L:
876 tv->u.CHIL = src->u.CHIL;
877 if (CHIL_overflow (tv->u.CHIL, m)) goto fail;
882 mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
889 tv->u.b = !!src->u.CHIL;
897 switch (get_mode_modecode(m)) {
898 case irm_c: case irm_h: case irm_i: case irm_l:
899 tv->u.chil = src->u.b;
902 case irm_C: case irm_H: case irm_I: case irm_L:
903 tv->u.CHIL = src->u.b;
911 obstack_free (&tv_obst, tv);
915 return tarval_identify (tv);
919 /* GL Why are there no ArmRoq comments, why is this not used? */
921 tarval_neg (tarval *a)
927 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
931 switch (get_mode_modecode(a->mode)) {
933 case irm_f: tv->u.f = -a->u.f; break;
934 case irm_d: tv->u.d = -a->u.d; break;
936 case irm_C: case irm_H: case irm_I: case irm_L:
937 tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (get_mode_max(a->mode));
940 case irm_c: case irm_h: case irm_i: case irm_l:
941 tv->u.chil = -a->u.chil;
942 if ( chil_overflow (tv->u.chil, a->mode)
943 || ((tv->u.chil >= 0) == (a->u.chil >= 0))) {
944 obstack_free (&tv_obst, tv);
951 mpz_neg (&tv->u.Z, &a->u.Z);
953 obstack_free (&tv_obst, tv);
955 printf("\nWrong negation\n\n");
959 case irm_b: tv->u.b = !a->u.b; break;
963 return tarval_identify (tv);
967 /* Compare `a' with `b'.
968 Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
969 result is unknown. */
971 tarval_comp (tarval *a, tarval *b)
977 assert (a->mode == b->mode);
979 switch (get_mode_modecode(a->mode)) {
981 case irm_f: return ( a->u.f == b->u.f ? irpn_Eq
982 : a->u.f > b->u.f ? irpn_Gt
983 : a->u.f < b->u.f ? irpn_Lt
985 case irm_d: return ( a->u.d == b->u.d ? irpn_Eq
986 : a->u.d > b->u.d ? irpn_Gt
987 : a->u.d < b->u.d ? irpn_Lt
990 case irm_C: case irm_H: case irm_I: case irm_L:
991 return ( a->u.CHIL == b->u.CHIL ? irpn_Eq
992 : a->u.CHIL > b->u.CHIL ? irpn_Gt
995 case irm_c: case irm_h: case irm_i: case irm_l:
996 return ( a->u.chil == b->u.chil ? irpn_Eq
997 : a->u.chil > b->u.chil ? irpn_Gt
1002 int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
1003 return ( cmp == 0 ? irpn_Eq
1011 case irm_b: return ( a->u.b == b->u.b ? irpn_Eq
1012 : a->u.b > b->u.b ? irpn_Gt
1014 /* The following assumes that pointers are unsigned, which is valid
1015 for all sane CPUs (transputers are insane). */
1016 case irm_p: return ( a == b ? irpn_Eq
1017 : a == tarval_p_void ? irpn_Lt
1018 : b == tarval_p_void ? irpn_Gt
1019 : irpn_False); /* unknown */
1020 default: assert (0);
1025 /* Return `a+b' if computable, else NULL. Modes must be equal. */
1027 tarval_add (tarval *a, tarval *b)
1031 TARVAL_VRFY (a); TARVAL_VRFY (b);
1032 assert (a->mode == b->mode);
1034 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1038 switch (get_mode_modecode(a->mode)) {
1040 case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */
1041 case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */
1043 case irm_C: case irm_H: case irm_I: case irm_L:
1044 tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1047 case irm_c: case irm_h: case irm_i: case irm_l:
1048 tv->u.chil = a->u.chil + b->u.chil;
1049 if ( chil_overflow (tv->u.chil, a->mode)
1050 || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) {
1051 obstack_free (&tv_obst, tv);
1057 mpz_init (&tv->u.Z);
1058 mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
1060 obstack_free (&tv_obst, tv);
1065 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1069 return tarval_identify (tv);
1073 /* Return `a-b' if computable, else NULL. Modes must be equal. */
1075 tarval_sub (tarval *a, tarval *b)
1079 TARVAL_VRFY (a); TARVAL_VRFY (b);
1080 assert (a->mode == b->mode);
1082 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1086 switch (get_mode_modecode(a->mode)) {
1088 case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */
1089 case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */
1091 case irm_C: case irm_H: case irm_I: case irm_L:
1092 tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1095 case irm_c: case irm_h: case irm_i: case irm_l:
1096 tv->u.chil = a->u.chil - b->u.chil;
1097 if ( chil_overflow (tv->u.chil, a->mode)
1098 || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) {
1099 obstack_free (&tv_obst, tv);
1105 mpz_init (&tv->u.Z);
1106 mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
1108 obstack_free (&tv_obst, tv);
1113 case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
1117 return tarval_identify (tv);
1120 /* Return `a*b' if computable, else NULL. Modes must be equal. */
1122 tarval_mul (tarval *a, tarval *b)
1126 TARVAL_VRFY (a); TARVAL_VRFY (b);
1127 assert (a->mode == b->mode);
1129 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1133 switch (get_mode_modecode(a->mode)) {
1135 case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */
1136 case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */
1138 case irm_C: case irm_H: case irm_I: case irm_L:
1139 tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode));
1142 case irm_c: case irm_h: case irm_i: case irm_l:
1143 tv->u.chil = a->u.chil * b->u.chil;
1144 if ( chil_overflow (tv->u.chil, a->mode)
1145 || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) {
1146 obstack_free (&tv_obst, tv);
1152 mpz_init (&tv->u.Z);
1153 mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
1155 obstack_free (&tv_obst, tv);
1160 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1164 return tarval_identify (tv);
1168 /* Return floating-point `a/b' if computable, else NULL.
1169 Modes must be equal, non-floating-point operands are converted to irm_d. */
1171 tarval_quo (tarval *a, tarval *b)
1175 TARVAL_VRFY (a); TARVAL_VRFY (b);
1176 assert (a->mode == b->mode);
1178 switch (get_mode_modecode(a->mode)) {
1181 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1183 tv->u.f = a->u.f / b->u.f; /* @@@ overflow etc */
1186 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1188 tv->u.d = a->u.d / b->u.d; /* @@@ overflow etc */
1191 a = tarval_convert_to (a, mode_d);
1192 b = tarval_convert_to (b, mode_d);
1193 return a && b ? tarval_quo (a, b) : NULL;
1196 return tarval_identify (tv);
1200 /* Return `a/b' if computable, else NULL. Modes must be equal. */
1202 tarval_div (tarval *a, tarval *b)
1206 TARVAL_VRFY (a); TARVAL_VRFY (b);
1207 assert (a->mode == b->mode);
1209 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1213 switch (get_mode_modecode(a->mode)) {
1215 case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */
1216 case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */
1218 case irm_C: case irm_H: case irm_I: case irm_L:
1219 if (!b->u.CHIL) goto fail;
1220 tv->u.CHIL = a->u.CHIL / b->u.CHIL;
1223 case irm_c: case irm_h: case irm_i: case irm_l:
1225 || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (get_mode_max(a->mode)) ))) {
1227 obstack_free (&tv_obst, tv);
1230 tv->u.chil = a->u.chil / b->u.chil;
1234 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1235 mpz_init (&tv->u.Z);
1236 mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
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' if computable, else NULL. Modes must be equal. */
1252 tarval_mod (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));
1263 switch (get_mode_modecode(a->mode)) {
1265 case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */
1266 case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */
1268 case irm_C: case irm_H: case irm_I: case irm_L:
1269 if (!b->u.CHIL) goto fail;
1270 tv->u.CHIL = a->u.CHIL % b->u.CHIL;
1273 case irm_c: case irm_h: case irm_i: case irm_l:
1276 obstack_free (&tv_obst, tv);
1279 tv->u.chil = a->u.chil % b->u.chil;
1283 if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
1284 mpz_init (&tv->u.Z);
1285 mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
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);
1298 /* Return |a| if computable, else Null. */
1299 /* is -max == min?? */
1301 tarval_abs (tarval *a) {
1303 if (tv_is_negative(a)) return tarval_neg(a);
1308 tv_is_negative(tarval *a) {
1310 switch (get_mode_modecode(a->mode)) {
1312 case irm_f: return (a->u.f<0); break;
1313 case irm_d: return (a->u.d<0); break;
1315 case irm_C: case irm_H: case irm_I: case irm_L:
1319 case irm_c: case irm_h: case irm_i: case irm_l:
1320 return (a->u.chil < 0);
1332 /* Return `a&b'. Modes must be equal. */
1334 tarval_and (tarval *a, tarval *b)
1338 TARVAL_VRFY (a); TARVAL_VRFY (b);
1339 assert (a->mode == b->mode);
1341 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1345 switch (get_mode_modecode(a->mode)) {
1347 case irm_C: case irm_H: case irm_I: case irm_L:
1348 tv->u.CHIL = a->u.CHIL & b->u.CHIL; break;
1350 case irm_c: case irm_h: case irm_i: case irm_l:
1351 tv->u.chil = a->u.chil & b->u.chil; break;
1354 mpz_init (&tv->u.Z);
1355 mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
1361 case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
1365 return tarval_identify (tv);
1369 /* Return `a|b'. Modes must be equal. */
1371 tarval_or (tarval *a, tarval *b)
1375 TARVAL_VRFY (a); TARVAL_VRFY (b);
1376 assert (a->mode == b->mode);
1378 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1382 switch (get_mode_modecode(a->mode)) {
1384 case irm_C: case irm_H: case irm_I: case irm_L:
1385 tv->u.CHIL = a->u.CHIL | b->u.CHIL; break;
1387 case irm_c: case irm_h: case irm_i: case irm_l:
1388 tv->u.chil = a->u.chil | b->u.chil; break;
1391 mpz_init (&tv->u.Z);
1392 mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
1398 case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
1402 return tarval_identify (tv);
1406 /* Return `a^b'. Modes must be equal. */
1408 tarval_eor (tarval *a, tarval *b)
1412 TARVAL_VRFY (a); TARVAL_VRFY (b);
1413 assert (a->mode == b->mode);
1415 #if 1 /* see case irm_Z below */
1416 if (a->mode == mode_Z) return NULL;
1419 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1423 switch (get_mode_modecode(a->mode)) {
1425 case irm_C: case irm_H: case irm_I: case irm_L:
1426 tv->u.CHIL = a->u.CHIL ^ b->u.CHIL; break;
1428 case irm_c: case irm_h: case irm_i: case irm_l:
1429 tv->u.chil = a->u.chil ^ b->u.chil; break;
1432 /* gmp-1.3.2 declares but does not define mpz_xor() */
1433 mpz_init (&tv->u.Z);
1434 mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
1438 case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
1442 return tarval_identify (tv);
1446 /* Return `a<<b' if computable, else NULL. */
1448 tarval_shl (tarval *a, tarval *b)
1454 TARVAL_VRFY (a); TARVAL_VRFY (b);
1456 shift = tarval_ord (b, &b_is_huge);
1459 || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) {
1463 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1466 switch (get_mode_modecode(a->mode)) {
1468 case irm_C: case irm_H: case irm_I: case irm_L:
1469 tv->u.CHIL = a->u.CHIL << shift;
1472 case irm_c: case irm_h: case irm_i: case irm_l:
1473 tv->u.chil = a->u.chil << shift;
1477 mpz_init (&tv->u.Z);
1478 mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
1483 default: assert (0);
1486 return tarval_identify (tv);
1490 /* Return `a>>b' if computable, else NULL.
1491 The interpretation of >> (sign extended or not) is implementaion
1492 dependent, i.e. this is neither shr nor shrs!! */
1494 tarval_shr (tarval *a, tarval *b)
1500 TARVAL_VRFY (a); TARVAL_VRFY (b);
1502 shift = tarval_ord (b, &b_is_huge);
1505 || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) {
1509 tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
1512 switch (get_mode_modecode(a->mode)) {
1514 case irm_C: case irm_H: case irm_I: case irm_L:
1515 tv->u.CHIL = a->u.CHIL >> shift;
1518 case irm_c: case irm_h: case irm_i: case irm_l:
1519 tv->u.chil = a->u.chil >> shift;
1523 mpz_init (&tv->u.Z);
1524 mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
1529 default: assert (0);
1532 return tarval_identify (tv);
1536 /* Classify `tv', which may be NULL.
1537 Return 0 if `tv' is the additive neutral element, 1 if `tv' is the
1538 multiplicative neutral element, and -1 if `tv' is the neutral
1539 element of bitwise and. */
1541 tarval_classify (tarval *tv)
1547 switch (get_mode_modecode(tv->mode)) {
1549 case irm_f: case irm_d:
1553 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_C))) - 1;
1555 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_H))) - 1;
1557 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_I))) - 1;
1559 return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_L))) - 1;
1561 case irm_c: case irm_h: case irm_i: case irm_l:
1565 if (mpz_cmp_si (&tv->u.Z, 0)) return 0;
1566 else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
1567 else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
1581 tarval_s_fits (tarval *tv, long min, long max) {
1582 return (( mpz_cmp_si (&tv->u.Z, min) >= 0)
1583 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1587 tarval_u_fits (tarval *tv, unsigned long max) {
1588 return (( mpz_sgn (&tv->u.Z) >= 0)
1589 && mpz_cmp_si (&tv->u.Z, max) <= 0);
1593 /* Convert `tv' into type `long', set `fail' if not representable.
1594 If `fail' gets set for an unsigned `tv', the correct result can be
1595 obtained by casting the result to `unsigned long'. */
1597 tarval_ord (tarval *tv, int *fail)
1601 switch (get_mode_modecode(tv->mode)) {
1603 case irm_C: case irm_H: case irm_I: case irm_L:
1604 *fail = tv->u.CHIL > tv_val_CHIL (get_mode_max(mode_l));
1607 case irm_c: case irm_h: case irm_i: case irm_l:
1612 *fail = ( (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) > 0)
1613 || (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) < 0));
1614 return mpz_get_si (&tv->u.Z);
1631 tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
1633 tarval *val = XP_GETARG (tarval *, 0);
1638 switch (get_mode_modecode(val->mode)) {
1640 case irm_T: /* none */
1641 printed = XPSR ("<bad>");
1644 case irm_f: /* float */
1645 printed = XPF1R ("%g", (double)(val->u.f));
1647 case irm_d: /* double */
1648 printed = XPF1R ("%g", (double)(val->u.d));
1651 case irm_c: /* signed char */
1652 case irm_C: /* unsigned char */
1653 if (isprint (val->u.chil)) {
1654 printed = XPF1R ("'%c'", val->u.chil);
1656 printed = XPF1R ("'\\%03o'", val->u.chil);
1660 case irm_h: case irm_i: case irm_l: /* signed num */
1661 printed = XPF1R ("%ld", (long)val->u.chil);
1663 case irm_H: case irm_I: case irm_L: /* unsigned num */
1664 printed = XPF1R ("%lu", (unsigned long)val->u.CHIL);
1667 case irm_Z: /* mp int */
1668 printed = XPF1R ("%Z", &val->u.Z);
1671 case irm_p: /* pointer */
1672 if (val->u.p.xname) {
1673 printed = XPR (val->u.p.xname);
1674 } else if (val->u.p.ent) {
1675 printed = XPF1R ("(%I)", get_entity_ld_ident(val->u.p.ent));
1677 assert (val == tarval_p_void);
1678 printed = XPSR ("(void)");
1682 case irm_b: /* boolean */
1683 if (val->u.b) printed = XPSR ("true");
1684 else printed = XPSR ("false");
1687 case irm_B: /* universal bits */
1688 printed = XPSR ("<@@@ some bits>");
1691 case irm_s: /* string */
1694 char *buf = alloca (val->u.s.n + 2);
1700 for (i = 0; i < val->u.s.n; ++i) {
1701 if (isprint (val->u.s.p[i])) {
1702 *bp++ = val->u.s.p[i];
1708 XPF1 ("'\\%03o'", val->u.s.p[i]);
1717 case irm_M: /* memory */
1718 case irm_R: /* region */
1728 get_tv_mode (tarval *tv)