Access routine to tarval
[libfirm] / ir / tv / tv.c
index 2026143..e0b825f 100644 (file)
@@ -1,6 +1,8 @@
 /* TV --- Target Values, aka Constant Table.
    Copyright (C) 1995, 1996 Christian von Roques */
 
+/* $Id$ */
+
 /* This implementation assumes:
    * target characters/strings can be represented as type `char'/`char *',
    * host's type `long'/`unsigned long' can hold values of mode `l'/`L',
@@ -23,6 +25,8 @@
    values is cheaper than the extra obstack_alloc()/free() for
    discarded ones.  */
 
+/* Defining this causes inclusions of functions renamed with new gmp.h */
+#define _TARVAL_GMP_ 0
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -31,6 +35,7 @@
 # include "xprintf.h"
 #include <assert.h>
 #include <limits.h>
+#include <errno.h>
 #include <math.h>
 #include <stdlib.h>
 #include <string.h>
@@ -255,7 +260,11 @@ tarval_cmp (const void *p, const void *q)
     }
     return a->u.chil != b->u.chil;
   case irm_Z:
+#if _TARVAL_GMP_
     return mpz_cmp (&a->u.Z, &b->u.Z);
+#else
+    return 99; /* ?? */
+#endif
     /* strange */
   case irm_p:
     if (a->u.p.ent || b->u.p.ent)
@@ -308,7 +317,11 @@ tarval_hash (tarval *tv)
   case irm_c: case irm_h: case irm_i: case irm_l:
     h ^= tv->u.chil; break;
   case irm_Z:
+#if _TARVAL_GMP_
     h ^= mpz_get_ui (&tv->u.Z); break;
+#else
+    h ^= (unsigned int) tv; break; /* tut das? */
+#endif
   case irm_p:
     if (tv->u.p.ent) {
       /* @@@ lower bits not random, watch for collisions; perhaps
@@ -463,7 +476,11 @@ tarval_Z_from_str (const char *s, size_t len, int base)
 
   tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
   tv->mode = mode_Z;
+#if _TARVAL_GMP_
   if (mpz_init_set_str (&tv->u.Z, buf, base)) assert (0);
+#else
+  assert(0 && "no support for Z in tv!");
+#endif
 
   return tarval_identify (tv);
 }
@@ -540,6 +557,27 @@ tarval_B_from_str (const char *s, size_t len)
 }
 
 
+tarval *
+tarval_f_from_str (const char *s, size_t len)
+{
+  tarval *tv;
+  char *buf;
+  char *eptr;
+
+  assert (!BUILDING);
+
+  buf = alloca (len+1);
+  stripcpy (buf, s, len);
+
+  tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
+  tv->mode = mode_f;
+  tv->u.f = (float)strtod (buf, &eptr);
+  assert (eptr == buf+strlen(buf));
+
+  return tarval_identify (tv);
+}
+
+
 tarval *
 tarval_d_from_str (const char *s, size_t len)
 {
@@ -593,6 +631,28 @@ tarval_S_from_str (const char *s, size_t len)
   return tarval_identify (tv);
 }
 
+tarval *tarval_int_from_str (const char *s, size_t len, int base, ir_mode *m) {
+  long val;
+  char *eptr;
+  char *buf;
+
+  assert (mode_is_int(m));
+  assert (!BUILDING);
+
+  buf = alloca (len+1);
+  stripcpy (buf, s, len);
+
+  errno = 0;
+  val = strtol(buf, &eptr, base);    /* strtoll */
+  assert (eptr == buf+strlen(buf));
+  if ((errno == ERANGE)               &&
+      ((m == mode_l) || (m == mode_L))  ) {
+    printf("WARNING: Constant %s not representable. Continuing with %ld.\n",
+          s, val);
+  }
+
+  return tarval_from_long(m, val);
+}
 
 /* Create a tarval with mode `m' and value `i' casted to the type that
    represents such tarvals on host.  The resulting value must be legal
@@ -622,7 +682,11 @@ tarval_from_long (ir_mode *m, long val)
   case irm_c: case irm_h: case irm_i: case irm_l:
     tv->u.chil = val; break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init_set_si (&tv->u.Z, val);
+#else
+    assert(0 && "no support for Z in tv!");
+#endif
     break;
     /* strange */
   case irm_p:
@@ -787,6 +851,7 @@ tarval_convert_to (tarval *src, ir_mode *m)
     break;
 
   case irm_Z:
+#if _TARVAL_GMP_
     switch (get_mode_modecode(m)) {
 
     case irm_C: case irm_H: case irm_I: case irm_L:
@@ -812,6 +877,9 @@ tarval_convert_to (tarval *src, ir_mode *m)
 
     default: goto fail;
     }
+#else
+    goto fail;
+#endif
     break;
 
   case irm_c: case irm_h: case irm_i: case irm_l:
@@ -827,7 +895,11 @@ tarval_convert_to (tarval *src, ir_mode *m)
       break;
 
     case irm_Z:
+#if _TARVAL_GMP_
       mpz_init_set_si (&tv->u.Z, src->u.chil);
+#else
+      goto fail;
+#endif
       break;
 
     case irm_b:
@@ -850,7 +922,11 @@ tarval_convert_to (tarval *src, ir_mode *m)
       break;
 
     case irm_Z:
+#if _TARVAL_GMP_
       mpz_init_set_ui (&tv->u.Z, src->u.CHIL);
+#else
+      goto fail;
+#endif
       break;
 
     case irm_b:
@@ -884,6 +960,7 @@ tarval_convert_to (tarval *src, ir_mode *m)
 }
 
 
+/* GL Why are there no ArmRoq comments, why is this not used? */
 tarval *
 tarval_neg (tarval *a)
 {
@@ -913,8 +990,14 @@ tarval_neg (tarval *a)
     }
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_neg (&tv->u.Z, &a->u.Z);
+#else
+    obstack_free (&tv_obst, tv);
+    tv = a;
+    printf("\nWrong negation\n\n");
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = !a->u.b; break;
@@ -958,10 +1041,15 @@ tarval_comp (tarval *a, tarval *b)
            : a->u.chil > b->u.chil ? irpn_Gt
            : irpn_Lt);
   case irm_Z:
-    { int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
+    {
+#if _TARVAL_GMP_
+      int cmp = mpz_cmp (&a->u.Z, &b->u.Z);
       return (  cmp == 0 ? irpn_Eq
              : cmp > 0 ? irpn_Gt
              : irpn_Lt);
+#else
+      return irpn_False;
+#endif
     }
     /* strange */
   case irm_b: return (  a->u.b == b->u.b ? irpn_Eq
@@ -1009,8 +1097,13 @@ tarval_add (tarval *a, tarval *b)
     }
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_add (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    obstack_free (&tv_obst, tv);
+    return NULL;
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b | b->u.b; break;        /* u.b is in canonical form */
@@ -1052,8 +1145,13 @@ tarval_sub (tarval *a, tarval *b)
     }
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_sub (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    obstack_free (&tv_obst, tv);
+    return NULL;
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
@@ -1063,7 +1161,6 @@ tarval_sub (tarval *a, tarval *b)
   return tarval_identify (tv);
 }
 
-
 /* Return `a*b' if computable, else NULL.  Modes must be equal.  */
 tarval *
 tarval_mul (tarval *a, tarval *b)
@@ -1095,8 +1192,13 @@ tarval_mul (tarval *a, tarval *b)
     }
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_mul (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    obstack_free (&tv_obst, tv);
+    return NULL;
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b & b->u.b; break;        /* u.b is in canonical form */
@@ -1172,9 +1274,13 @@ tarval_div (tarval *a, tarval *b)
     tv->u.chil = a->u.chil / b->u.chil;
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
     mpz_init (&tv->u.Z);
     mpz_div (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    goto fail;
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b ^ b->u.b; break;        /* u.b is in canonical form */
@@ -1217,9 +1323,13 @@ tarval_mod (tarval *a, tarval *b)
     tv->u.chil = a->u.chil % b->u.chil;
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     if (!mpz_cmp_ui (&b->u.Z, 0)) goto fail;
     mpz_init (&tv->u.Z);
     mpz_mod (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    goto fail;
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b ^ b->u.b; break;        /* u.b is in canonical form */
@@ -1229,6 +1339,39 @@ tarval_mod (tarval *a, tarval *b)
   return tarval_identify (tv);
 }
 
+/* Return |a| if computable, else Null. */
+/*  is -max == min?? */
+tarval *
+tarval_abs (tarval *a) {
+  TARVAL_VRFY (a);
+  if (tv_is_negative(a)) return tarval_neg(a);
+  return a;
+}
+
+int
+tv_is_negative(tarval *a) {
+  TARVAL_VRFY (a);
+  switch (get_mode_modecode(a->mode)) {
+    /* floating */
+  case irm_f: return (a->u.f<0); break;
+  case irm_d: return (a->u.d<0); break;
+    /* unsigned */
+  case irm_C: case irm_H: case irm_I: case irm_L:
+    return 0;
+    break;
+    /* signed */
+  case irm_c: case irm_h: case irm_i: case irm_l:
+    return (a->u.chil < 0);
+    break;
+  case irm_Z:
+    break;
+  case irm_b: break;
+  default: assert(0);
+  }
+
+  return 0;
+}
+
 
 /* Return `a&b'.  Modes must be equal.  */
 tarval *
@@ -1251,8 +1394,12 @@ tarval_and (tarval *a, tarval *b)
   case irm_c: case irm_h: case irm_i: case irm_l:
     tv->u.chil = a->u.chil & b->u.chil; break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_and (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    assert(0);
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b & b->u.b; break;        /* u.b is in canonical form */
@@ -1284,8 +1431,12 @@ tarval_or (tarval *a, tarval *b)
   case irm_c: case irm_h: case irm_i: case irm_l:
     tv->u.chil = a->u.chil | b->u.chil; break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_ior (&tv->u.Z, &a->u.Z, &b->u.Z);
+#else
+    assert(0);
+#endif
     break;
     /* strange */
   case irm_b: tv->u.b = a->u.b | b->u.b; break;        /* u.b is in canonical form */
@@ -1321,7 +1472,8 @@ tarval_eor (tarval *a, tarval *b)
   case irm_c: case irm_h: case irm_i: case irm_l:
     tv->u.chil = a->u.chil ^ b->u.chil; break;
   case irm_Z:
-#if 0 /* gmp-1.3.2 declares but does not define mpz_xor() */
+#if 0
+    /* gmp-1.3.2 declares but does not define mpz_xor() */
     mpz_init (&tv->u.Z);
     mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z);
 #endif
@@ -1365,8 +1517,12 @@ tarval_shl (tarval *a, tarval *b)
     tv->u.chil = a->u.chil << shift;
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_mul_2exp (&tv->u.Z, &a->u.Z, shift);
+#else
+    assert(0);
+#endif
     break;
   default: assert (0);
   }
@@ -1375,7 +1531,9 @@ tarval_shl (tarval *a, tarval *b)
 }
 
 
-/* Return `a>>b' if computable, else NULL.  */
+/* Return `a>>b' if computable, else NULL.
+   The interpretation of >> (sign extended or not) is implementaion
+   dependent, i.e. this is neither shr nor shrs!! */
 tarval *
 tarval_shr (tarval *a, tarval *b)
 {
@@ -1405,8 +1563,12 @@ tarval_shr (tarval *a, tarval *b)
     tv->u.chil = a->u.chil >> shift;
     break;
   case irm_Z:
+#if _TARVAL_GMP_
     mpz_init (&tv->u.Z);
     mpz_div_2exp (&tv->u.Z, &a->u.Z, shift);
+#else
+    assert(0);
+#endif
     break;
   default: assert (0);
   }
@@ -1443,9 +1605,11 @@ tarval_classify (tarval *tv)
   case irm_c: case irm_h: case irm_i: case irm_l:
     return tv->u.chil;
   case irm_Z:
+#if _TARVAL_GMP_
     if      (mpz_cmp_si (&tv->u.Z, 0)) return 0;
     else if (mpz_cmp_si (&tv->u.Z, 1)) return 1;
     else if (mpz_cmp_si (&tv->u.Z,-1)) return -1;
+#endif
     return 2;
     /* strange */
   case irm_b:
@@ -1456,6 +1620,7 @@ tarval_classify (tarval *tv)
 }
 
 
+#if _TARVAL_GMP_
 bool
 tarval_s_fits (tarval *tv, long min, long max) {
   return ((  mpz_cmp_si (&tv->u.Z, min) >= 0)
@@ -1467,7 +1632,7 @@ tarval_u_fits (tarval *tv, unsigned long max) {
   return ((  mpz_sgn (&tv->u.Z) >= 0)
          && mpz_cmp_si (&tv->u.Z, max) <= 0);
 }
-
+#endif
 
 /* Convert `tv' into type `long', set `fail' if not representable.
    If `fail' gets set for an unsigned `tv', the correct result can be
@@ -1487,9 +1652,14 @@ tarval_ord (tarval *tv, int *fail)
     *fail = 0;
     return tv->u.chil;
   case irm_Z:
+#if _TARVAL_GMP_
     *fail = (   (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) > 0)
             || (mpz_cmp_si (&tv->u.Z, tv_val_chil(get_mode_max(mode_l))) < 0));
     return mpz_get_si (&tv->u.Z);
+#else
+    *fail = 1;
+    return 0;
+#endif
     /* strange */
   case irm_b:
     *fail = 0;
@@ -1506,6 +1676,7 @@ tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
 {
   tarval *val = XP_GETARG (tarval *, 0);
   int printed;
+  char buf[40];
 
   TARVAL_VRFY (val);
 
@@ -1516,10 +1687,11 @@ tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
     break;
 
   case irm_f:                  /* float */
-    printed = XPF1R ("%g", (double)(val->u.f));
+    sprintf (buf, "%1.9e", (float)(val->u.f));
+    printed = XPF1R ("%s", buf);
     break;
   case irm_d:                  /* double */
-    printed = XPF1R ("%g", (double)(val->u.d));
+    printed = XPF1R ("%1.30g", (double)(val->u.d));
     break;
 
   case irm_c:                  /* signed char */
@@ -1527,7 +1699,7 @@ tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
     if (isprint (val->u.chil)) {
       printed = XPF1R ("'%c'", val->u.chil);
     } else {
-      printed = XPF1R ("'\\%03o'", val->u.chil);
+      printed = XPF1R ("0x%x", (unsigned long)val->u.chil);
     }
     break;
 
@@ -1546,7 +1718,10 @@ tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
     if (val->u.p.xname) {
       printed = XPR (val->u.p.xname);
     } else if (val->u.p.ent) {
-      printed = XPF1R ("(%I)", val->u.p.ent->name);
+      if (get_entity_peculiarity(val->u.p.ent) == existent)
+       printed = XPF1R ("&(%I)", get_entity_ld_ident(val->u.p.ent));
+      else
+       printed = XPSR ("(NULL)");
     } else {
       assert (val == tarval_p_void);
       printed = XPSR ("(void)");
@@ -1603,3 +1778,21 @@ get_tv_mode (tarval *tv)
 {
   return tv->mode;
 }
+
+/* Returns the entity if the tv is a pointer to an entity, else
+   returns NULL; */
+entity *get_tv_entity(tarval *tv) {
+  entity *ent = NULL;
+
+  if (tv->mode == mode_p) {
+    if (tv->u.p.xname) {
+      assert(0);
+      /* not an entity */
+    } else if (tv->u.p.ent) {
+      ent = tv->u.p.ent;
+    } else {
+      /* not an entity */
+    }
+  }
+  return ent;
+}