X-Git-Url: http://nsz.repo.hu/git/?a=blobdiff_plain;f=ir%2Ftv%2Ftv.c;h=7af7434e5bafb849e7a75004bef963059cf799d6;hb=f73f5c542edb2e4ff58a4bdc4f9d53415a14c4a1;hp=e0b825fbaa128d4674ea5db5148d12ab328435b1;hpb=a589d14815569918d18568a397995cf6e0b67021;p=libfirm diff --git a/ir/tv/tv.c b/ir/tv/tv.c index e0b825fba..7af7434e5 100644 --- a/ir/tv/tv.c +++ b/ir/tv/tv.c @@ -1,1798 +1,1676 @@ -/* TV --- Target Values, aka Constant Table. - Copyright (C) 1995, 1996 Christian von Roques */ - -/* $Id$ */ +/* + * Project: libFIRM + * File name: ir/tv/tv.c + * Purpose: Representation of and static computations on target machine + * values. + * Author: Mathias Heil + * Modified by: + * Created: + * CVS-ID: $Id$ + * Copyright: (c) 2003 Universität Karlsruhe + * Licence: This file protected by GPL - GNU GENERAL PUBLIC LICENSE. + */ + +/* + * Values are stored in a format depending upon chosen arithmetic + * module. Default uses strcalc and fltcalc. + * + */ /* 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', - * both host and target have two's complement integral arithmetic, - host's C operators `/' and `%' match target's div and mod. - target_max_ == (1<0 - target_min_ == -target_max_-1 - target_max_ == target_max_-target_min_ - * both host and target have IEEE-754 floating-point arithmetic. */ - -/* !!! float and double divides MUST NOT SIGNAL !!! */ -/* @@@ query the floating-point expception status flags */ - -/* @@@ ToDo: tarval_convert_to is not fully implemented! */ -/* @@@ Problem: All Values are stored twice, once as Univ_*s and a 2nd - time in their real target mode. :-( */ -/* @@@ Perhaps use a set instead of a pset: new tarvals allocated on - stack, copied into set by tarval_identify() if really new. If - tarval_identify() discards often enough, the extra copy for kept - 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 + * - target has IEEE-754 floating-point arithmetic. */ + #ifdef HAVE_CONFIG_H -# include +# include "config.h" #endif -# include "xprintf.h" -#include -#include -#include -#include + +#include /* assertions */ +#include /* atoi() */ +#ifdef HAVE_STRING_H +# include /* nice things for strings */ +#endif +#ifdef HAVE_STRINGS_H +#include /* strings.h also includes bsd only function strcasecmp */ +#endif #include -#include -#include - -#include "pset.h" -#define TOBSTACK_ID "tv" -#include "obst.h" -#include "ieee754.h" -#include "tune.h" -#include "ident_t.h" +#ifdef HAVE_ALLOCA_H +# include +#endif +#ifdef HAVE_MALLOC_H +# include +#endif + #include "tv_t.h" -#include "entity_t.h" -#include "irmode.h" - -static struct obstack tv_obst; /* obstack for all the target values */ -static pset *tarvals; /* pset containing pointers to _all_ tarvals */ - -/* currently building an object with tarval_start() & friends ? */ -#define BUILDING obstack_object_size (&tv_obst) - -/* special tarvals: */ -tarval *tarval_bad; -tarval *tarval_b_false; -tarval *tarval_b_true; -tarval *tarval_d_NaN; -tarval *tarval_d_Inf; -tarval *tarval_p_void; -tarval *tarval_mode_null[irm_max]; - -# if 0 -/* @@@ depends on order of ir_mode */ -static tarval_chil min_chil[8] = { - TARGET_SIMIN (c), 0, - TARGET_SIMIN (h), 0, - TARGET_SIMIN (i), 0, - TARGET_SIMIN (l), 0 -}; -static tarval_chil max_chil[8] = { - TARGET_SIMAX (c), TARGET_UIMAX (C), - TARGET_SIMAX (h), TARGET_UIMAX (H), - TARGET_SIMAX (i), TARGET_UIMAX (I), - TARGET_SIMAX (l), TARGET_UIMAX (L) -}; -# endif +#include "set.h" /* to store tarvals in */ +/* #include "tune.h" */ /* some constants */ +#include "entity_t.h" /* needed to store pointers to entities */ +#include "irmode_t.h" +#include "irnode.h" /* defines boolean return values (pnc_number)*/ +#include "strcalc.h" +#include "fltcalc.h" + +/** Size of hash tables. Should correspond to average number of distinct constant + target values */ +#define N_CONSTANTS 2048 + +/* get the integer overflow mode */ +#define GET_OVERFLOW_MODE() int_overflow_mode + +/* unused, float to int doesn't work yet */ +#define TRUNCATE 1 +#define ROUND 2 +#define GET_FLOAT_TO_INT_MODE() TRUNCATE + +#define SWITCH_NOINFINITY 0 +#define SWITCH_NODENORMALS 0 + +/**************************************************************************** + * local definitions and macros + ****************************************************************************/ +#ifndef NDEBUG +# define TARVAL_VERIFY(a) tarval_verify((a)) +#else +# define TARVAL_VERIFY(a) ((void)0) +#endif -/* return a mode-specific value */ +#define INSERT_TARVAL(tv) ((tarval*)set_insert(tarvals, (tv), sizeof(tarval), hash_tv((tv)))) +#define FIND_TARVAL(tv) ((tarval*)set_find(tarvals, (tv), sizeof(tarval), hash_tv((tv)))) -tarval_f -tv_val_f (tarval *tv) -{ - return tv->u.f; -} +#define INSERT_VALUE(val, size) (set_insert(values, (val), size, hash_val((val), size))) +#define FIND_VALUE(val, size) (set_find(values, (val), size, hash_val((val), size))) -tarval_d -tv_val_d (tarval *tv) +#define fail_verify(a) _fail_verify((a), __FILE__, __LINE__) +#if 0 +static long long count = 0; +# define ANNOUNCE() printf(__FILE__": call no. %lld (%s)\n", count++, __FUNCTION__); +#else +# define ANNOUNCE() ((void)0) +#endif +/**************************************************************************** + * private variables + ****************************************************************************/ +static struct set *tarvals; /* container for tarval structs */ +static struct set *values; /* container for values */ +static tarval_int_overflow_mode_t int_overflow_mode = TV_OVERFLOW_WRAP; + +/**************************************************************************** + * private functions + ****************************************************************************/ +#ifndef NDEBUG +static int hash_val(const void *value, unsigned int length); +static int hash_tv(tarval *tv); +static void _fail_verify(tarval *tv, const char* file, int line) { - return tv->u.d; + /* print a memory image of the tarval and throw an assertion */ + if (tv) + printf("%s:%d: Invalid tarval:\n mode: %s\n value: [%p]\n", file, line, get_mode_name(tv->mode), tv->value); + else + printf("%s:%d: Invalid tarval (null)", file, line); + assert(0); } +#ifdef __GNUC__ +INLINE static void tarval_verify(tarval *tv) __attribute__ ((unused)); +#endif -tarval_chil -tv_val_chil (tarval *tv) +INLINE static void tarval_verify(tarval *tv) { - return tv->u.chil; -} + assert(tv); + assert(tv->mode); + assert(tv->value); -tarval_CHIL -tv_val_CHIL (tarval *tv) -{ - return tv->u.CHIL; -} + if ((tv == tarval_bad) || (tv == tarval_undefined)) return; + if ((tv == tarval_b_true) || (tv == tarval_b_false)) return; -tarval_Z -tv_val_Z (tarval *tv) -{ - return tv->u.Z; -} + if (!FIND_TARVAL(tv)) fail_verify(tv); + if (tv->length > 0 && !FIND_VALUE(tv->value, tv->length)) fail_verify(tv); -tarval_p -tv_val_p (tarval *tv) -{ - return tv->u.p; + return; } +#endif /* NDEBUG */ -bool -tv_val_b (tarval *tv) +static int hash_tv(tarval *tv) { - return tv->u.b; + return ((unsigned int)tv->value ^ (unsigned int)tv->mode) + tv->length; } -tarval_B -tv_val_B (tarval *tv) +static int hash_val(const void *value, unsigned int length) { - return tv->u.B; -} + unsigned int i; + unsigned int hash = 0; + + /* scramble the byte - array */ + for (i = 0; i < length; i++) + { + hash += (hash << 5) ^ (hash >> 27) ^ ((char*)value)[i]; + hash += (hash << 11) ^ (hash >> 17); + } -tarval_s -tv_val_s (tarval *tv) -{ - return tv->u.s; + return hash; } - -/* Overflows `chil' signed integral `mode'? */ -static inline bool -chil_overflow (tarval_chil chil, ir_mode *mode) +/* finds tarval with value/mode or creates new tarval */ +static tarval *get_tarval(const void *value, int length, ir_mode *mode) { - assert (is_chilCHIL(get_mode_modecode(mode))); - return (get_mode_min(mode) && get_mode_max(mode) /* only valid after firm initialization */ - && (chil < tv_val_chil (get_mode_min(mode)) - || tv_val_chil (get_mode_max(mode)) < chil)); + tarval tv; + + tv.mode = mode; + tv.length = length; + if (length > 0) { + /* if there already is such a value, it is returned, else value + * is copied into the set */ + tv.value = INSERT_VALUE(value, length); + } else { + tv.value = value; + } + /* if there is such a tarval, it is returned, else tv is copied + * into the set */ + return (tarval *)INSERT_TARVAL(&tv); } - -/* Overflows `CHIL' unsigned integral `mode'? */ -static inline bool -CHIL_overflow (tarval_CHIL CHIL, ir_mode *mode) +/** + * handle overflow + */ +static tarval *get_tarval_overflow(const void *value, int length, ir_mode *mode) { - assert (is_chilCHIL(get_mode_modecode(mode))); - return (get_mode_max(mode) /* only valid after firm initialization */ - && tv_val_CHIL (get_mode_max(mode)) < CHIL); -} + switch (get_mode_sort(mode)) + { + case irms_int_number: + if (sc_comp(value, get_mode_max(mode)->value) == 1) { + switch (GET_OVERFLOW_MODE()) { + case TV_OVERFLOW_SATURATE: + return get_mode_max(mode); + case TV_OVERFLOW_WRAP: + { + char *temp = alloca(sc_get_buffer_length()); + char *diff = alloca(sc_get_buffer_length()); + sc_sub(get_mode_max(mode)->value, get_mode_min(mode)->value, diff); + sc_val_from_ulong(1, temp); + sc_add(diff, temp, diff); + sc_sub(value, diff, temp); + while (sc_comp(temp, get_mode_max(mode)->value) == 1) + sc_sub(temp, diff, temp); + return get_tarval(temp, length, mode); + } + case TV_OVERFLOW_BAD: + return tarval_bad; + default: + return get_tarval(value, length, mode); + } + } + if (sc_comp(value, get_mode_min(mode)->value) == -1) { + switch (GET_OVERFLOW_MODE()) { + case TV_OVERFLOW_SATURATE: + return get_mode_min(mode); + case TV_OVERFLOW_WRAP: + { + char *temp = alloca(sc_get_buffer_length()); + char *diff = alloca(sc_get_buffer_length()); + sc_sub(get_mode_max(mode)->value, get_mode_min(mode)->value, diff); + sc_val_from_ulong(1, temp); + sc_add(diff, temp, diff); + sc_add(value, diff, temp); + while (sc_comp(temp, get_mode_max(mode)->value) == 1) + sc_add(temp, diff, temp); + return get_tarval(temp, length, mode); + } + case TV_OVERFLOW_BAD: + return tarval_bad; + default: + return get_tarval(value, length, mode); + } + } + break; + case irms_float_number: + if (SWITCH_NOINFINITY && fc_is_inf(value)) + { + return fc_is_negative(value)?get_mode_min(mode):get_mode_max(mode); + } -#ifndef NDEBUG -void -_tarval_vrfy (const tarval *val) -{ - assert (val); - switch (get_mode_modecode(val->mode)) { - /* floating */ - case irm_f: - case irm_d: - break; - /* integral */ - case irm_C: case irm_H: case irm_I: case irm_L: - assert (!CHIL_overflow (val->u.CHIL, val->mode)); break; - case irm_c: case irm_h: case irm_i: case irm_l: - assert (!chil_overflow (val->u.chil, val->mode)); break; - case irm_Z: - break; - /* strange */ - case irm_p: - if (val->u.p.ent) - assert (val->u.p.ent->kind == k_entity); - assert ( val->u.p.xname || val->u.p.ent - || !tarval_p_void || (val == tarval_p_void)); - break; - case irm_s: - case irm_S: - assert (val->u.s.p); break; - case irm_B: - assert (val->u.B.p); break; - case irm_b: - assert ((unsigned)val->u.b <= 1); break; - default: - assert (val->mode == mode_T); + if (SWITCH_NODENORMALS && fc_is_subnormal(value)) + { + return get_mode_null(mode); + } + break; + default: + break; } + return get_tarval(value, length, mode); } -#endif -#ifdef STATS +/* + * public variables declared in tv.h + */ +static tarval reserved_tv[5]; -void -tarval_stats (void) -{ - pset_stats (tarvals); -} - -#endif +tarval *tarval_bad = &reserved_tv[0]; +tarval *tarval_undefined = &reserved_tv[1]; +tarval *tarval_b_false = &reserved_tv[2]; +tarval *tarval_b_true = &reserved_tv[3]; +tarval *tarval_P_void = &reserved_tv[4]; +/* + * public functions declared in tv.h + */ -/* Return the canonical tarval * for tv. - May destroy everything allocated on tv_obst after tv! */ -static tarval * -tarval_identify (tarval *tv) +/* + * Constructors ============================================================= + */ +tarval *new_tarval_from_str(const char *str, size_t len, ir_mode *mode) { - tarval *o; + ANNOUNCE(); + assert(str); + assert(len); + assert(mode); + + switch (get_mode_sort(mode)) + { + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + assert(0); + break; - o = pset_insert (tarvals, tv, tarval_hash (tv)); + case irms_internal_boolean: + /* match [tT][rR][uU][eE]|[fF][aA][lL][sS][eE] */ + if (strcasecmp(str, "true")) return tarval_b_true; + else if (strcasecmp(str, "false")) return tarval_b_true; + else + /* XXX This is C semantics */ + return atoi(str) ? tarval_b_true : tarval_b_false; + + case irms_float_number: + switch(get_mode_size_bits(mode)) { + case 32: + fc_val_from_str(str, len, 8, 23, NULL); + break; + case 64: + fc_val_from_str(str, len, 11, 52, NULL); + break; + case 80: + fc_val_from_str(str, len, 15, 64, NULL); + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode); - if (o != tv) { - obstack_free (&tv_obst, (void *)tv); + case irms_int_number: + case irms_character: + sc_val_from_str(str, len, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode); + + case irms_reference: + return get_tarval(str, len, mode); } - TARVAL_VRFY (o); - return o; + assert(0); /* can't be reached, can it? */ + return NULL; } - -/* Return 0 iff a equals b. Bitwise identical NaNs compare equal. */ -static int -tarval_cmp (const void *p, const void *q) +/* + * helper function, create a tarval from long + */ +tarval *new_tarval_from_long(long l, ir_mode *mode) { - const tarval *a = p; - const tarval *b = q; - - TARVAL_VRFY (a); - TARVAL_VRFY (b); - - if (a == b) return 0; - if ((void *)a->mode - (void *)b->mode) - return (void *)a->mode - (void *)b->mode; - - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: - return memcmp (&a->u.f, &b->u.f, sizeof (a->u.f)); - case irm_d: - return memcmp (&a->u.d, &b->u.d, sizeof (a->u.d)); - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - if (sizeof (int) == sizeof (tarval_CHIL)) { - return a->u.CHIL - b->u.CHIL; - } - return a->u.CHIL != b->u.CHIL; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - if (sizeof (int) == sizeof (tarval_chil)) { - return a->u.chil - b->u.chil; - } - 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) - return (char *)a->u.p.ent - (char *)b->u.p.ent; - if (a->u.p.xname && b->u.p.xname) - return strcmp (a->u.p.xname, b->u.p.xname); - return a->u.p.xname - b->u.p.xname; - case irm_b: - return a->u.b - b->u.b; - case irm_B: - return ( a->u.B.n - b->u.B.n - ? memcmp (a->u.B.p, b->u.B.p, a->u.B.n) - : a->u.B.n - b->u.B.n); - case irm_s: case irm_S: - return ( a->u.s.n == b->u.s.n - ? memcmp (a->u.s.p, b->u.s.p, a->u.s.n) - : a->u.s.n - b->u.s.n); - default: assert (0); - } -} + ANNOUNCE(); + assert(mode && !((get_mode_sort(mode) == irms_memory)||(get_mode_sort(mode)==irms_control_flow)||(get_mode_sort(mode)==irms_auxiliary))); + switch(get_mode_sort(mode)) + { + case irms_internal_boolean: + /* XXX C semantics ! */ + return l ? tarval_b_true : tarval_b_false ; -unsigned -tarval_hash (tarval *tv) -{ - unsigned h; - - h = get_mode_modecode(tv->mode) * 0x421u; - switch (get_mode_modecode(tv->mode)) { - case irm_T: - h = 0x94b527ce; break; - case irm_f: - /* quick & dirty */ - { union { float f; unsigned u; } u; - assert (sizeof (float) <= sizeof (unsigned)); - u.u = 0; u.f = tv->u.f; - h ^= u.u; - break; - } - case irm_d: - /* quick & dirty */ - { union { double d; unsigned u[2]; } u; - assert (sizeof (double) <= 2*sizeof (unsigned)); - u.u[0] = u.u[1] = 0; u.d = tv->u.d; - h ^= u.u[0] ^ u.u[1]; - break; - } - case irm_C: case irm_H: case irm_I: case irm_L: - h ^= tv->u.CHIL; break; - 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 - replace by tv->u.p.ent - (entity *)0 */ - h ^= ((char *)tv->u.p.ent - (char *)0) / 64; - } else if (tv->u.p.xname) { - /* Of course, strlen() in a hash function is a mistake, but this - case should be really rare. */ - h ^= ID_HASH (tv->u.p.xname, strlen (tv->u.p.xname)); - } else { /* void */ - h^= 0x2b592b88; - } - break; - case irm_b: - h ^= tv->u.b; break; - case irm_B: - h ^= tv->u.B.n; break; /* @@@ not really good */ - case irm_s: - h ^= tv->u.s.p[0]<<12 ^ tv->u.s.p[tv->u.s.n]<<4 ^ tv->u.s.n; break; - case irm_S: - h ^= tv->u.s.p[0]<<4 ^ tv->u.s.p[tv->u.s.n]<<12 ^ tv->u.s.n; break; - default: - assert(0); - } - return h; -} - + case irms_int_number: + case irms_character: + sc_val_from_long(l, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode); - -/*** ***************** Initialization ************************************* ***/ + case irms_float_number: + return new_tarval_from_double((long double)l, mode); -void -tarval_init_1 (void) -{ - obstack_init (&tv_obst); - obstack_alignment_mask (&tv_obst) = ALIGNOF (tarval) - 1; - assert (IS_POW2 (ALIGNOF (tarval))); + case irms_reference: + return l ? tarval_bad : get_tarval(NULL, 0, mode); /* null pointer or tarval_bad */ - /* initialize the target value table */ - tarvals = new_pset (tarval_cmp, TUNE_NCONSTANTS); + default: + assert(0); + } + return NULL; } -void -tarval_init_2 (void) +/* returns non-zero if can be converted to long */ +int tarval_is_long(tarval *tv) { - tarval *tv; - union ieee754_double x; - - /* assumed by tarval_hash(): */ - assert (sizeof (float) * CHAR_BIT == 32); - assert (sizeof (double) * CHAR_BIT == 64); - -# if 0 - /* assumed by tarval_chil & friends: */ - assert ( (irm_C == irm_c+1) && (irm_h == irm_C+1) - && (irm_H == irm_h+1) && (irm_i == irm_H+1) - && (irm_I == irm_i+1) && (irm_l == irm_I+1) - && (irm_L == irm_l+1)); - - /* assumed everywhere: */ - for (i = 0; i <= irm_L-irm_c; i += 2) { - assert ( IS_POW2 (max_chil[i+1]+1) - && (min_chil[i] == -max_chil[i]-1) - && ((tarval_CHIL)max_chil[i+1] == (tarval_CHIL)max_chil[i]-min_chil[i])); + ANNOUNCE(); + if (get_mode_sort(tv->mode) != irms_int_number) return 0; + + if (get_mode_size_bits(tv->mode) > sizeof(long)<<3) + { + /* the value might be too big to fit in a long */ + sc_max_from_bits(sizeof(long)<<3, 0, NULL); + if (sc_comp(sc_get_buffer(), tv->value) == -1) + { + /* really doesn't fit */ + return 0; + } } -# endif - - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_T; - tarval_bad = tarval_identify (tv); - - tarval_b_false = tarval_from_long (mode_b, 0); - tarval_b_true = tarval_from_long (mode_b, 1); - - /* IsInf <-> exponent == 0x7ff && ! (bits | fraction_low) */ - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_d; - x.ieee.negative = 0; - x.ieee.exponent = 0x7ff; - x.ieee.mantissa0 = 0; - x.ieee.mantissa1 = 0; - tv->u.d = x.d; - tarval_d_Inf = tarval_identify (tv); - - /* IsNaN <-> exponent==0x7ff && (qnan_bit | bits | fraction_low) */ - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_d; - x.ieee_nan.negative = 0; - x.ieee_nan.exponent = 0x7ff; - x.ieee_nan.quiet_nan = 1; /* @@@ quiet or signalling? */ - x.ieee_nan.mantissa0 = 42; - x.ieee_nan.mantissa1 = 0; - assert(x.d != x.d /* x.d is NaN */); - tv->u.d = x.d; - tarval_d_NaN = tarval_identify (tv); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_p; - tv->u.p.xname = NULL; - tv->u.p.ent = NULL; - tv->u.p.tv = NULL; - tarval_p_void = tarval_identify (tv); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - - - tarval_mode_null [irm_f] = tarval_from_long (mode_f, 0); - tarval_mode_null [irm_d] = tarval_from_long (mode_d, 0); - tarval_mode_null [irm_c] = tarval_from_long (mode_c, 0); - tarval_mode_null [irm_C] = tarval_from_long (mode_C, 0); - tarval_mode_null [irm_h] = tarval_from_long (mode_h, 0); - tarval_mode_null [irm_H] = tarval_from_long (mode_H, 0); - tarval_mode_null [irm_i] = tarval_from_long (mode_i, 0); - tarval_mode_null [irm_I] = tarval_from_long (mode_I, 0); - tarval_mode_null [irm_l] = tarval_from_long (mode_l, 0); - tarval_mode_null [irm_L] = tarval_from_long (mode_L, 0); - tarval_mode_null [irm_b] = tarval_b_false; - tarval_mode_null [irm_p] = tarval_p_void; + return 1; } +/* this might overflow the machine's long, so use only with small values */ +long get_tarval_long(tarval* tv) +{ + ANNOUNCE(); + assert(tarval_is_long(tv) && "tarval too big to fit in long"); - -/*** ********************** Constructors for tarvals ********************** ***/ + return sc_val_to_long(tv->value); +} -/* copy from src to dst len chars omitting '_'. */ -static char * -stripcpy (char *dst, const char *src, size_t len) +tarval *new_tarval_from_double(long double d, ir_mode *mode) { - char *d = dst; + ANNOUNCE(); + assert(mode && (get_mode_sort(mode) == irms_float_number)); - while (len--) { - if (*src == '_') src++; - else *d++ = *src++; + switch (get_mode_size_bits(mode)) { + case 32: + fc_val_from_float(d, 8, 23, NULL); + break; + case 64: + fc_val_from_float(d, 11, 52, NULL); + break; + case 80: + fc_val_from_float(d, 15, 64, NULL); + break; } - *d = 0; /* make it 0-terminated. */ - - return dst; + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode); } - -tarval * -tarval_Z_from_str (const char *s, size_t len, int base) +/* returns non-zero if can be converted to double */ +int tarval_is_double(tarval *tv) { - tarval *tv; - char *buf; - - assert (!BUILDING); + ANNOUNCE(); + assert(tv); - buf = alloca (len+1); - stripcpy (buf, s, len); + return (get_mode_sort(tv->mode) == irms_float_number); +} - 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 +long double get_tarval_double(tarval *tv) +{ + ANNOUNCE(); + assert(tarval_is_double(tv)); - return tarval_identify (tv); + return fc_val_to_float(tv->value); } -tarval * -tarval_B_from_str (const char *s, size_t len) +/* + * Access routines for tarval fields ======================================== + */ +ir_mode *get_tarval_mode (tarval *tv) /* get the mode of the tarval */ { - tarval *tv; - size_t n; /* size of B */ - const char *r; /* read ptr */ - unsigned x; /* bit store */ - int b; /* bits in x */ - int shift; /* base shift */ - - assert (!BUILDING); - assert (len >= 3); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_B; - - assert (s[0] == '0'); - switch (s[1]) { - case 'o': - case 'O': shift = 3; break; - case 'x': - case 'X': shift = 4; break; - default: assert(0); - } + ANNOUNCE(); + assert(tv); + return tv->mode; +} - r = s+len; /* set r past input */ - s += 2; /* skip header */ - x = 0; b = 0; n = 0; - while (--r >= s) { - int d; /* digit */ - - if (*r == '_') continue; /* skip _ styropor */ - if (('0' <= *r) && (*r <= '9')) { - d = *r - '0'; - } else if (('a' <= *r) && (*r <= 'f')) { - d = *r - 'a' + 10; - } else { assert (('A' <= *r) && (*r <= 'F')); - d = *r - 'A' + 10; - } +/* +void *get_tarval_link (tarval *tv) +{ + ANNOUNCE (); + assert (tv); + return (tv->link); +} +*/ + +/* + * Special value query functions ============================================ + * + * These functions calculate and return a tarval representing the requested + * value. + * The functions get_mode_{Max,Min,...} return tarvals retrieved from these + * functions, but these are stored on initialization of the irmode module and + * therefore the irmode functions should be prefered to the functions below. + */ + +tarval *get_tarval_bad(void) +{ + ANNOUNCE(); + return tarval_bad; +} +tarval *get_tarval_undefined(void) +{ + ANNOUNCE(); + return tarval_undefined; +} +tarval *get_tarval_b_false(void) +{ + ANNOUNCE(); + return tarval_b_false; +} +tarval *get_tarval_b_true(void) +{ + ANNOUNCE(); + return tarval_b_true; +} +tarval *get_tarval_P_void(void) +{ + ANNOUNCE(); + return tarval_P_void; +} - x |= d << b; /* insert d into x above the b present bits */ - b += shift; /* x now contains shift more bits */ +tarval *get_tarval_max(ir_mode *mode) +{ + ANNOUNCE(); + assert(mode); - if (b >= 8) { /* we've accumulated at least a byte */ - char c = x & 0xFF; /* extract the lower 8 bits from x */ - obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */ - x >>= 8; /* remove the lower 8 bits from x */ - b -= 8; /* x now contains 8 bits fewer */ - ++n; /* B grew a byte */ - } + if (get_mode_n_vector_elems(mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; } - if (b >= 0) { /* flush the rest of the bits */ - char c = x; /* extract them */ - obstack_grow (&tv_obst, &c, 1); /* and stuff them into B */ - ++n; /* B grew a byte */ - } + switch(get_mode_sort(mode)) + { + case irms_reference: + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + assert(0); + break; - { unsigned char *p = obstack_finish (&tv_obst); - unsigned char *q = p + n; + case irms_internal_boolean: + return tarval_b_true; + + case irms_float_number: + switch(get_mode_size_bits(mode)) + { + case 32: + fc_get_max(8, 23, NULL); + break; + case 64: + fc_get_max(11, 52, NULL); + break; + case 80: + fc_get_max(15, 64, NULL); + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode); - tv->u.B.p = p; - tv->u.B.n = n; - /* reverse p in place */ - while (p < q) { char c = *p; *p++ = *q; *q-- = c; } + case irms_int_number: + case irms_character: + sc_max_from_bits(get_mode_size_bits(mode), mode_is_signed(mode), NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode); } - - return tarval_identify (tv); + return tarval_bad; } - -tarval * -tarval_f_from_str (const char *s, size_t len) +tarval *get_tarval_min(ir_mode *mode) { - tarval *tv; - char *buf; - char *eptr; + ANNOUNCE(); + assert(mode); - assert (!BUILDING); + if (get_mode_n_vector_elems(mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - buf = alloca (len+1); - stripcpy (buf, s, len); + switch(get_mode_sort(mode)) + { + case irms_reference: + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + assert(0); + break; - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_f; - tv->u.f = (float)strtod (buf, &eptr); - assert (eptr == buf+strlen(buf)); + case irms_internal_boolean: + return tarval_b_false; + + case irms_float_number: + switch(get_mode_size_bits(mode)) + { + case 32: + fc_get_min(8, 23, NULL); + break; + case 64: + fc_get_min(11, 52, NULL); + break; + case 80: + fc_get_min(15, 64, NULL); + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode); - return tarval_identify (tv); + case irms_int_number: + case irms_character: + sc_min_from_bits(get_mode_size_bits(mode), mode_is_signed(mode), NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode); + } + return tarval_bad; } - -tarval * -tarval_d_from_str (const char *s, size_t len) +tarval *get_tarval_null(ir_mode *mode) { - 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_d; - tv->u.d = strtod (buf, &eptr); - assert (eptr == buf+strlen(buf)); - - return tarval_identify (tv); -} + ANNOUNCE(); + assert(mode); + if (get_mode_n_vector_elems(mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } -tarval * -tarval_s_from_str (const char *s, size_t len) -{ - tarval *tv; - - assert (!BUILDING); + switch(get_mode_sort(mode)) + { + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + case irms_internal_boolean: + assert(0); + break; - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + case irms_float_number: + return new_tarval_from_double(0.0, mode); - tv->mode = mode_s; - tv->u.s.n = len; - tv->u.s.p = obstack_copy (&tv_obst, s, len); + case irms_int_number: + case irms_character: + return new_tarval_from_long(0l, mode); - return tarval_identify (tv); + case irms_reference: + return tarval_P_void; + } + return tarval_bad; } -tarval * -tarval_S_from_str (const char *s, size_t len) +tarval *get_tarval_one(ir_mode *mode) { - tarval *tv; + ANNOUNCE(); + assert(mode); - assert (!BUILDING); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - - tv->mode = mode_S; - tv->u.s.n = len; - tv->u.s.p = obstack_copy (&tv_obst, s, 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; + if (get_mode_n_vector_elems(mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - assert (mode_is_int(m)); - assert (!BUILDING); + switch(get_mode_sort(mode)) + { + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + case irms_internal_boolean: + case irms_reference: + assert(0); + break; - buf = alloca (len+1); - stripcpy (buf, s, len); + case irms_float_number: + return new_tarval_from_double(1.0, mode); - 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); + case irms_int_number: + case irms_character: + return new_tarval_from_long(1l, mode); + break; } - - return tarval_from_long(m, val); + return tarval_bad; } -/* 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 - for mode `m'. */ -tarval * -tarval_from_long (ir_mode *m, long val) +tarval *get_tarval_nan(ir_mode *mode) { - tarval *tv; - - assert (!BUILDING); - - if (m == mode_T) return tarval_bad; - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - - tv->mode = m; - switch (get_mode_modecode(m)) { - /* floating */ - case irm_f: - tv->u.f = val; break; - case irm_d: - tv->u.d = val; break; - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = val; break; - /* signed */ - 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: - assert(!val); - obstack_free (&tv_obst, tv); - return tarval_p_void; - case irm_b: - tv->u.b = !!val; /* u.b must be 0 or 1 */ - break; - default: - assert(0); + ANNOUNCE(); + assert(mode); + + if (get_mode_n_vector_elems(mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; } - return tarval_identify (tv); + if (get_mode_sort(mode) == irms_float_number) { + switch(get_mode_size_bits(mode)) + { + case 32: + fc_get_qnan(8, 23, NULL); + break; + case 64: + fc_get_qnan(11, 52, NULL); + break; + case 80: + fc_get_qnan(15, 64, NULL); + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode); + } + else { + assert(0 && "tarval is not floating point"); + return tarval_bad; + } } - -tarval * -tarval_p_from_str (const char *xname) +tarval *get_tarval_inf(ir_mode *mode) { - tarval *tv; + ANNOUNCE(); + assert(mode); - assert (!BUILDING); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + if (get_mode_n_vector_elems(mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - tv->mode = mode_p; - tv->u.p.xname = obstack_copy0 (&tv_obst, xname, strlen (xname)); - tv->u.p.ent = NULL; - tv->u.p.tv = NULL; - return tarval_identify (tv); + if (get_mode_sort(mode) == irms_float_number) { + switch(get_mode_size_bits(mode)) + { + case 32: + fc_get_plusinf(8, 23, NULL); + break; + case 64: + fc_get_plusinf(11, 52, NULL); + break; + case 80: + fc_get_plusinf(15, 64, NULL); + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode); + } + else { + assert(0 && "tarval is not floating point"); + return tarval_bad; + } } +/* + * Arithmethic operations on tarvals ======================================== + */ -tarval * -tarval_p_from_entity (entity *ent) +/* + * test if negative number, 1 means 'yes' + */ +int tarval_is_negative(tarval *a) { - tarval *tv; - - assert (!BUILDING); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + ANNOUNCE(); + assert(a); - tv->mode = mode_p; - tv->u.p.xname = NULL; - tv->u.p.ent = ent; - tv->u.p.tv = NULL; - return tarval_identify (tv); -} + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + assert(0 && "tarval_is_negative is not allowed for vector modes"); + return 0; + } + switch (get_mode_sort(a->mode)) + { + case irms_int_number: + if (!mode_is_signed(a->mode)) return 0; + else + return sc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0; -/* Routines for building a tarval step by step follow. - Legal calling sequences: - tarval_start() - No contructors except tarval_append() and tarval_append1 () - tarval_finish_as() or tarval_cancel() */ + case irms_float_number: + return fc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0; -/* Begin building a tarval. */ -void -tarval_start (void) -{ - assert (!BUILDING); - obstack_blank (&tv_obst, sizeof (tarval)); + default: + assert(0 && "not implemented"); + return 0; + } } - -/* Append `n' chars from `p' to the tarval currently under construction. */ -void -tarval_append (const char *p, size_t n) +/* + * test if null, 1 means 'yes' + */ +int tarval_is_null(tarval *a) { - assert (BUILDING); - obstack_grow (&tv_obst, p, n); -} - + ir_mode *m = get_tarval_mode(a); -/* Append `ch' to the tarval currently under construction. */ -void -tarval_append1 (char ch) -{ - assert (BUILDING); - obstack_1grow (&tv_obst, ch); + return a == get_tarval_null(m); } - -/* Finish the tarval currently under construction and give id mode `m'. - `m' must be irm_C, irm_B, irm_s or irm_S. - Return NULL if the value does not make sense for this mode, this - can only happen in mode C. */ -tarval * -tarval_finish_as (ir_mode *m) +/* + * test if one, 1 means 'yes' + */ +int tarval_is_one(tarval *a) { - int size = obstack_object_size (&tv_obst) - sizeof (tarval); - tarval *tv; - unsigned char *p; - char ch = 0; /* initialized to shut up gcc */ - - assert (BUILDING && (size >= 0)); - if (m == mode_C) { - if (size != 1) return tarval_cancel(); - p = (unsigned char *)obstack_base (&tv_obst) + sizeof (tarval); - ch = *p; - obstack_blank (&tv_obst, -size); - } - tv = obstack_finish (&tv_obst); - p = (unsigned char *)tv + sizeof (tarval); - tv->mode = m; + ir_mode *m = get_tarval_mode(a); - switch (get_mode_modecode(m)) { - case irm_C: - tv->u.CHIL = ch; - break; - case irm_B: - tv->u.B.n = size; - tv->u.B.p = p; - break; - case irm_s: - case irm_S: - tv->u.s.n = size; - tv->u.s.p = p; - break; - case irm_p: - tv->u.p.tv = NULL; - break; - default: - assert (0); - } - - return tarval_identify (tv); + return a == get_tarval_one(m); } - -/* Cancel tarval building and return tarval_bad. */ -tarval * -tarval_cancel (void) +/* + * comparison + */ +pnc_number tarval_cmp(tarval *a, tarval *b) { - assert (BUILDING); - obstack_free (&tv_obst, obstack_finish (&tv_obst)); - return tarval_bad; -} + ANNOUNCE(); + assert(a); + assert(b); + + if (a == tarval_bad || b == tarval_bad) assert(0 && "Comparison with tarval_bad"); + if (a == tarval_undefined || b == tarval_undefined) return False; + if (a == b) return Eq; + if (a->mode != b->mode) return False; + + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + assert(0 && "cmp not implemented for vector modes"); + } + /* Here the two tarvals are unequal and of the same mode */ + switch (get_mode_sort(a->mode)) + { + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + case irms_reference: + return False; + + case irms_float_number: + switch (fc_comp(a->value, b->value)) { + case -1: return Lt; + case 0: assert(0 && "different tarvals compare equal"); return Eq; + case 1: return Gt; + case 2: return Uo; + default: return False; + } + case irms_int_number: + case irms_character: + return (sc_comp(a->value, b->value)==1)?(Gt):(Lt); - -/*** ****************** Arithmethic operations on tarvals ***************** ***/ + case irms_internal_boolean: + return (a == tarval_b_true)?(Gt):(Lt); + } + return False; +} -/* Return `src' converted to mode `m' if representable, else NULL. - @@@ lots of conversions missing */ -tarval * -tarval_convert_to (tarval *src, ir_mode *m) +/* + * convert to other mode + */ +tarval *tarval_convert_to(tarval *src, ir_mode *m) { - tarval *tv; - - if (m == src->mode) return src; + char *buffer; - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = m; + ANNOUNCE(); + assert(src); + assert(m); - switch (get_mode_modecode(src->mode)) { + if (src->mode == m) return src; - case irm_d: - if (m != mode_f) goto fail; - tv->u.f = src->u.d; - break; - - case irm_Z: -#if _TARVAL_GMP_ - switch (get_mode_modecode(m)) { + if (get_mode_n_vector_elems(src->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - case irm_C: case irm_H: case irm_I: case irm_L: - if (mpz_cmp_si (&src->u.Z, 0) < 0) goto fail; - if (mpz_size (&src->u.Z) > 1) goto fail; - tv->u.CHIL = mpz_get_ui (&src->u.Z); - if (CHIL_overflow (tv->u.CHIL, m)) goto fail; + switch (get_mode_sort(src->mode)) + { + case irms_control_flow: + case irms_memory: + case irms_auxiliary: break; - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = mpz_get_si (&src->u.Z); - if (chil_overflow (tv->u.chil, m)) goto fail; + /* cast float to something */ + case irms_float_number: + switch (get_mode_sort(m)) { + case irms_float_number: + switch (get_mode_size_bits(m)) + { + case 32: + fc_cast(src->value, 8, 23, NULL); + break; + case 64: + fc_cast(src->value, 11, 52, NULL); + break; + case 80: + fc_cast(src->value, 15, 64, NULL); + break; + default: + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), m); + + case irms_int_number: + switch (GET_FLOAT_TO_INT_MODE()) + { + case TRUNCATE: + fc_int(src->value, NULL); + break; + case ROUND: + fc_rnd(src->value, NULL); + break; + default: + break; + } + /* XXX floating point unit can't produce a value in integer + * representation + * an intermediate representation is needed here first. */ + /* return get_tarval(); */ + return tarval_bad; + + default: + /* the rest can't be converted */ + return tarval_bad; + } break; - case irm_b: - tv ->u.b = !mpz_cmp_ui (&src->u.Z, 0); + /* cast int to something */ + case irms_int_number: + switch (get_mode_sort(m)) { + case irms_int_number: + case irms_character: + return get_tarval_overflow(src->value, src->length, m); + + case irms_internal_boolean: + /* XXX C semantics */ + if (src == get_mode_null(src->mode)) return tarval_b_false; + else return tarval_b_true; + + case irms_float_number: + /* XXX floating point unit does not understand internal integer + * representation, convert to string first, then create float from + * string */ + buffer = alloca(100); + /* decimal string representation because hexadecimal output is + * interpreted unsigned by fc_val_from_str, so this is a HACK */ + snprintf(buffer, 100, "%s", + sc_print(src->value, get_mode_size_bits(src->mode), SC_DEC)); + switch (get_mode_size_bits(m)) + { + case 32: + fc_val_from_str(buffer, 0, 8, 23, NULL); + break; + case 64: + fc_val_from_str(buffer, 0, 11, 52, NULL); + break; + case 80: + fc_val_from_str(buffer, 0, 15, 64, NULL); + break; + } + return get_tarval(fc_get_buffer(), fc_get_buffer_length(), m); + + default: + break; + } break; - case irm_p: - if (mpz_cmp_ui (&src->u.Z, 0)) goto fail; - obstack_free (&tv_obst, tv); - return tarval_p_void; - - default: goto fail; - } -#else - goto fail; -#endif - break; + case irms_internal_boolean: + switch (get_mode_sort(m)) + { + case irms_int_number: + if (src == tarval_b_true) return get_mode_one(m); + else return get_mode_null(m); - case irm_c: case irm_h: case irm_i: case irm_l: - switch (get_mode_modecode(m)) { - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = src->u.chil; - if (chil_overflow (tv->u.chil, m)) goto fail; + default: + break; + } break; - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = src->u.chil; - if (CHIL_overflow (tv->u.CHIL, m)) goto fail; + case irms_character: 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: - tv->u.b = !!src->u.chil; + case irms_reference: break; + } - default: goto fail; - } + return tarval_bad; +} - case irm_C: case irm_H: case irm_I: case irm_L: - switch (get_mode_modecode(m)) { - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = src->u.CHIL; - if (chil_overflow (tv->u.chil, m)) goto fail; - break; +/* + * bitwise negation + */ +tarval *tarval_not(tarval *a) +{ + char *buffer; - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = src->u.CHIL; - if (CHIL_overflow (tv->u.CHIL, m)) goto fail; - break; + ANNOUNCE(); + assert(a); + assert(mode_is_int(a->mode)); /* bitwise negation is only allowed for integer */ - case irm_Z: -#if _TARVAL_GMP_ - mpz_init_set_ui (&tv->u.Z, src->u.CHIL); -#else - goto fail; -#endif - break; + /* works for vector mode without changes */ - case irm_b: - tv->u.b = !!src->u.CHIL; - break; + switch (get_mode_sort(a->mode)) + { + case irms_int_number: + buffer = alloca(sc_get_buffer_length()); + sc_not(a->value, buffer); + return get_tarval(buffer, a->length, a->mode); - default: goto fail; - } - break; + default: + return tarval_bad; + } +} - case irm_b: - switch (get_mode_modecode(m)) { - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = src->u.b; - break; +/* + * arithmetic negation + */ +tarval *tarval_neg(tarval *a) +{ + char *buffer; - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = src->u.b; + ANNOUNCE(); + assert(a); + assert(mode_is_num(a->mode)); /* negation only for numerical values */ - default: goto fail; - } - break; + /* note: negation is allowed even for unsigned modes. */ - default: - fail: - obstack_free (&tv_obst, tv); - return NULL; + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; } - return tarval_identify (tv); -} - + switch (get_mode_sort(a->mode)) + { + case irms_int_number: + buffer = alloca(sc_get_buffer_length()); + sc_neg(a->value, buffer); + return get_tarval_overflow(buffer, a->length, a->mode); -/* GL Why are there no ArmRoq comments, why is this not used? */ -tarval * -tarval_neg (tarval *a) -{ - tarval *tv; + case irms_float_number: + fc_neg(a->value, NULL); + return get_tarval_overflow(fc_get_buffer(), fc_get_buffer_length(), a->mode); - TARVAL_VRFY (a); + default: + return tarval_bad; + } +} - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); +/* + * addition + */ +tarval *tarval_add(tarval *a, tarval *b) +{ + char *buffer; - tv->mode = a->mode; + ANNOUNCE(); + assert(a); + assert(b); + assert(a->mode == b->mode); - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: tv->u.f = -a->u.f; break; - case irm_d: tv->u.d = -a->u.d; break; - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = -a->u.CHIL & tv_val_CHIL (get_mode_max(a->mode)); - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = -a->u.chil; - if ( chil_overflow (tv->u.chil, a->mode) - || ((tv->u.chil >= 0) == (a->u.chil >= 0))) { - obstack_free (&tv_obst, tv); - return NULL; - } - 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; - default: assert(0); + if (get_mode_n_vector_elems(a->mode) > 1 || get_mode_n_vector_elems(b->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; } - return tarval_identify (tv); + switch (get_mode_sort(a->mode)) + { + case irms_character: + case irms_int_number: + /* modes of a,b are equal, so result has mode of a as this might be the character */ + buffer = alloca(sc_get_buffer_length()); + sc_add(a->value, b->value, buffer); + return get_tarval_overflow(buffer, a->length, a->mode); + + case irms_float_number: + fc_add(a->value, b->value, NULL); + return get_tarval_overflow(fc_get_buffer(), fc_get_buffer_length(), a->mode); + + default: + return tarval_bad; + } } - -/* Compare `a' with `b'. - Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if - result is unknown. */ -ir_pncmp -tarval_comp (tarval *a, tarval *b) +/* + * subtraction + */ +tarval *tarval_sub(tarval *a, tarval *b) { + char *buffer; - TARVAL_VRFY (a); - TARVAL_VRFY (b); - - assert (a->mode == b->mode); - - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: return ( a->u.f == b->u.f ? irpn_Eq - : a->u.f > b->u.f ? irpn_Gt - : a->u.f < b->u.f ? irpn_Lt - : irpn_Uo); - case irm_d: return ( a->u.d == b->u.d ? irpn_Eq - : a->u.d > b->u.d ? irpn_Gt - : a->u.d < b->u.d ? irpn_Lt - : irpn_Uo); - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - return ( a->u.CHIL == b->u.CHIL ? irpn_Eq - : a->u.CHIL > b->u.CHIL ? irpn_Gt - : irpn_Lt); - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - return ( a->u.chil == b->u.chil ? irpn_Eq - : a->u.chil > b->u.chil ? irpn_Gt - : irpn_Lt); - case irm_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 - : a->u.b > b->u.b ? irpn_Gt - : irpn_Lt); - /* The following assumes that pointers are unsigned, which is valid - for all sane CPUs (transputers are insane). */ - case irm_p: return ( a == b ? irpn_Eq - : a == tarval_p_void ? irpn_Lt - : b == tarval_p_void ? irpn_Gt - : irpn_False); /* unknown */ - default: assert (0); + ANNOUNCE(); + assert(a); + assert(b); + assert(a->mode == b->mode); + + if (get_mode_n_vector_elems(a->mode) > 1 || get_mode_n_vector_elems(b->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } + switch (get_mode_sort(a->mode)) + { + case irms_character: + case irms_int_number: + /* modes of a,b are equal, so result has mode of a as this might be the character */ + buffer = alloca(sc_get_buffer_length()); + sc_sub(a->value, b->value, buffer); + return get_tarval_overflow(buffer, a->length, a->mode); + + case irms_float_number: + fc_sub(a->value, b->value, NULL); + return get_tarval_overflow(fc_get_buffer(), fc_get_buffer_length(), a->mode); + + default: + return tarval_bad; } } - -/* Return `a+b' if computable, else NULL. Modes must be equal. */ -tarval * -tarval_add (tarval *a, tarval *b) +/* + * multiplication + */ +tarval *tarval_mul(tarval *a, tarval *b) { - tarval *tv; + char *buffer; - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + ANNOUNCE(); + assert(a); + assert(b); + assert(a->mode == b->mode); - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - tv->mode = a->mode; + switch (get_mode_sort(a->mode)) + { + case irms_int_number: + /* modes of a,b are equal */ + buffer = alloca(sc_get_buffer_length()); + sc_mul(a->value, b->value, buffer); + return get_tarval_overflow(buffer, a->length, a->mode); - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: tv->u.f = a->u.f + b->u.f; break; /* @@@ overflow etc */ - case irm_d: tv->u.d = a->u.d + b->u.d; break; /* @@@ dto. */ - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = (a->u.CHIL + b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode)); - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = a->u.chil + b->u.chil; - if ( chil_overflow (tv->u.chil, a->mode) - || ((tv->u.chil > a->u.chil) ^ (b->u.chil > 0))) { - obstack_free (&tv_obst, tv); - return NULL; - } - 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 */ - default: assert(0); - } + case irms_float_number: + fc_mul(a->value, b->value, NULL); + return get_tarval_overflow(fc_get_buffer(), fc_get_buffer_length(), a->mode); - return tarval_identify (tv); + default: + return tarval_bad; + } } - -/* Return `a-b' if computable, else NULL. Modes must be equal. */ -tarval * -tarval_sub (tarval *a, tarval *b) +/* + * floating point division + */ +tarval *tarval_quo(tarval *a, tarval *b) { - tarval *tv; + ANNOUNCE(); + assert(a); + assert(b); + assert((a->mode == b->mode) && mode_is_float(a->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + fc_div(a->value, b->value, NULL); + return get_tarval_overflow(fc_get_buffer(), fc_get_buffer_length(), a->mode); +} - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); +/* + * integer division + * overflow is impossible, but look out for division by zero + */ +tarval *tarval_div(tarval *a, tarval *b) +{ + ANNOUNCE(); + assert(a); + assert(b); + assert((a->mode == b->mode) && mode_is_int(a->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - tv->mode = a->mode; + /* x/0 error */ + if (b == get_mode_null(b->mode)) return tarval_bad; + /* modes of a,b are equal */ + sc_div(a->value, b->value, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); +} - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: tv->u.f = a->u.f - b->u.f; break; /* @@@ overflow etc */ - case irm_d: tv->u.d = a->u.d - b->u.d; break; /* @@@ dto. */ - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = (a->u.CHIL - b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode)); - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = a->u.chil - b->u.chil; - if ( chil_overflow (tv->u.chil, a->mode) - || ((tv->u.chil > a->u.chil) ^ (b->u.chil < 0))) { - obstack_free (&tv_obst, tv); - return NULL; - } - 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 */ - default: assert(0); +/* + * remainder + * overflow is impossible, but look out for division by zero + */ +tarval *tarval_mod(tarval *a, tarval *b) +{ + ANNOUNCE(); + assert(a); + assert(b); + assert((a->mode == b->mode) && mode_is_int(a->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; } - return tarval_identify (tv); + /* x/0 error */ + if (b == get_mode_null(b->mode)) return tarval_bad; + /* modes of a,b are equal */ + sc_mod(a->value, b->value, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); } -/* Return `a*b' if computable, else NULL. Modes must be equal. */ -tarval * -tarval_mul (tarval *a, tarval *b) +/* + * absolute value + */ +tarval *tarval_abs(tarval *a) { - tarval *tv; + char *buffer; + + ANNOUNCE(); + assert(a); + assert(mode_is_num(a->mode)); - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + if (get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + switch (get_mode_sort(a->mode)) + { + case irms_int_number: + if (sc_comp(a->value, get_mode_null(a->mode)->value) == -1) + { + buffer = alloca(sc_get_buffer_length()); + sc_neg(a->value, buffer); + return get_tarval_overflow(buffer, a->length, a->mode); + } + return a; - tv->mode = a->mode; + case irms_float_number: + if (fc_comp(a->value, get_mode_null(a->mode)->value) == -1) + { + fc_neg(a->value, NULL); + return get_tarval_overflow(fc_get_buffer(), fc_get_buffer_length(), a->mode); + } + return a; - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: tv->u.f = a->u.f * b->u.f; break; /* @@@ overflow etc */ - case irm_d: tv->u.d = a->u.d * b->u.d; break; /* @@@ dto. */ - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = (a->u.CHIL * b->u.CHIL) & tv_val_CHIL (get_mode_max(a->mode)); - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = a->u.chil * b->u.chil; - if ( chil_overflow (tv->u.chil, a->mode) - || (b->u.chil && (tv->u.chil / b->u.chil != a->u.chil))) { - obstack_free (&tv_obst, tv); - return NULL; - } - 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 */ - default: assert(0); + default: + return tarval_bad; } - - return tarval_identify (tv); + return tarval_bad; } - -/* Return floating-point `a/b' if computable, else NULL. - Modes must be equal, non-floating-point operands are converted to irm_d. */ -tarval * -tarval_quo (tarval *a, tarval *b) +/* + * bitwise and + */ +tarval *tarval_and(tarval *a, tarval *b) { - tarval *tv; + ANNOUNCE(); + assert(a); + assert(b); + assert(a->mode == b->mode); - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + /* works even for vector modes */ - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_f; - tv->u.f = a->u.f / b->u.f; /* @@@ overflow etc */ - break; - case irm_d: - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = mode_d; - tv->u.d = a->u.d / b->u.d; /* @@@ overflow etc */ - break; - default: - a = tarval_convert_to (a, mode_d); - b = tarval_convert_to (b, mode_d); - return a && b ? tarval_quo (a, b) : NULL; - } + switch(get_mode_sort(a->mode)) + { + case irms_internal_boolean: + return (a == tarval_b_false) ? a : b; - return tarval_identify (tv); -} + case irms_int_number: + sc_and(a->value, b->value, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); + default: + assert(0 && "operation not defined on mode"); + return tarval_bad; + } +} -/* Return `a/b' if computable, else NULL. Modes must be equal. */ -tarval * -tarval_div (tarval *a, tarval *b) +/* + * bitwise or + */ +tarval *tarval_or (tarval *a, tarval *b) { - tarval *tv; + ANNOUNCE(); + assert(a); + assert(b); + assert(a->mode == b->mode); - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + /* works even for vector modes */ - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + switch (get_mode_sort(a->mode)) + { + case irms_internal_boolean: + return (a == tarval_b_true) ? a : b; - tv->mode = a->mode; + case irms_int_number: + sc_or(a->value, b->value, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: tv->u.f = floor (a->u.f / b->u.f); break; /* @@@ overflow etc */ - case irm_d: tv->u.d = floor (a->u.d / b->u.d); break; /* @@@ dto. */ - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - if (!b->u.CHIL) goto fail; - tv->u.CHIL = a->u.CHIL / b->u.CHIL; - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - if ( !b->u.chil - || ((b->u.chil == -1) && (a->u.chil == tv_val_chil (get_mode_max(a->mode)) ))) { - fail: - obstack_free (&tv_obst, tv); - return NULL; - } - 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 */ - default: assert(0); + default: + assert(0 && "operation not defined on mode"); + return tarval_bad;; } - - return tarval_identify (tv); } - -/* Return `a%b' if computable, else NULL. Modes must be equal. */ -tarval * -tarval_mod (tarval *a, tarval *b) +/* + * bitwise exclusive or (xor) + */ +tarval *tarval_eor(tarval *a, tarval *b) { - tarval *tv; + ANNOUNCE(); + assert(a); + assert(b); + assert((a->mode == b->mode)); - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + /* works even for vector modes */ - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + switch (get_mode_sort(a->mode)) + { + case irms_internal_boolean: + return (a == b)? tarval_b_false : tarval_b_true; - tv->mode = a->mode; + case irms_int_number: + sc_xor(a->value, b->value, NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); - switch (get_mode_modecode(a->mode)) { - /* floating */ - case irm_f: tv->u.f = fmod (a->u.f, b->u.f); break; /* @@@ overflow etc */ - case irm_d: tv->u.d = fmod (a->u.d, b->u.d); break; /* @@@ dto */ - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - if (!b->u.CHIL) goto fail; - tv->u.CHIL = a->u.CHIL % b->u.CHIL; - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - if (!b->u.chil) { - fail: - obstack_free (&tv_obst, tv); - return NULL; - } - 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 */ - default: assert(0); + default: + assert(0 && "operation not defined on mode"); + return tarval_bad;; } - - 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; -} +/* + * bitwise left shift + */ +tarval *tarval_shl(tarval *a, tarval *b) +{ + char *temp_val = NULL; + ANNOUNCE(); + assert(a); + assert(b); + assert(mode_is_int(a->mode) && mode_is_int(b->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1 || get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } -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); + if (get_mode_modulo_shift(a->mode) != 0) + { + temp_val = alloca(sc_get_buffer_length()); + + sc_val_from_ulong(get_mode_modulo_shift(a->mode), temp_val); + sc_mod(b->value, temp_val, temp_val); } + else + temp_val = (char*)b->value; - return 0; + sc_shl(a->value, temp_val, get_mode_size_bits(a->mode), mode_is_signed(a->mode), NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); } - -/* Return `a&b'. Modes must be equal. */ -tarval * -tarval_and (tarval *a, tarval *b) +/* + * bitwise unsigned right shift + */ +tarval *tarval_shr(tarval *a, tarval *b) { - tarval *tv; - - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - - tv->mode = a->mode; - - switch (get_mode_modecode(a->mode)) { - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = a->u.CHIL & b->u.CHIL; break; - /* signed */ - 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 */ - default: assert(0); + char *temp_val = NULL; + ANNOUNCE(); + assert(a); + assert(b); + assert(mode_is_int(a->mode) && mode_is_int(b->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1 || get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; } - return tarval_identify (tv); -} - + if (get_mode_modulo_shift(a->mode) != 0) + { + temp_val = alloca(sc_get_buffer_length()); -/* Return `a|b'. Modes must be equal. */ -tarval * -tarval_or (tarval *a, tarval *b) -{ - tarval *tv; - - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); - - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - - tv->mode = a->mode; - - switch (get_mode_modecode(a->mode)) { - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = a->u.CHIL | b->u.CHIL; break; - /* signed */ - 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 */ - default: assert(0); + sc_val_from_ulong(get_mode_modulo_shift(a->mode), temp_val); + sc_mod(b->value, temp_val, temp_val); } + else + temp_val = (char*)b->value; - return tarval_identify (tv); + sc_shr(a->value, temp_val, get_mode_size_bits(a->mode), mode_is_signed(a->mode), NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); } - -/* Return `a^b'. Modes must be equal. */ -tarval * -tarval_eor (tarval *a, tarval *b) +/* + * bitwise signed right shift + */ +tarval *tarval_shrs(tarval *a, tarval *b) { - tarval *tv; + char *temp_val = NULL; + ANNOUNCE(); + assert(a); + assert(b); + assert(mode_is_int(a->mode) && mode_is_int(b->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1 || get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - TARVAL_VRFY (a); TARVAL_VRFY (b); - assert (a->mode == b->mode); + if (get_mode_modulo_shift(a->mode) != 0) + { + temp_val = alloca(sc_get_buffer_length()); -#if 1 /* see case irm_Z below */ - if (a->mode == mode_Z) return NULL; -#endif + sc_val_from_ulong(get_mode_modulo_shift(a->mode), temp_val); + sc_mod(b->value, temp_val, temp_val); + } + else + temp_val = (char*)b->value; - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); + sc_shrs(a->value, temp_val, get_mode_size_bits(a->mode), mode_is_signed(a->mode), NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); +} - tv->mode = a->mode; +/* + * bitwise rotation + */ +tarval *tarval_rot(tarval *a, tarval *b) +{ + char *temp_val = NULL; + ANNOUNCE(); + assert(a); + assert(b); + assert(mode_is_int(a->mode) && mode_is_int(b->mode)); + + if (get_mode_n_vector_elems(a->mode) > 1 || get_mode_n_vector_elems(a->mode) > 1) { + /* vector arithmetic not implemented yet */ + return tarval_bad; + } - switch (get_mode_modecode(a->mode)) { - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = a->u.CHIL ^ b->u.CHIL; break; - /* signed */ - 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() */ - mpz_init (&tv->u.Z); - mpz_xor (&tv->u.Z, &a->u.Z, &b->u.Z); -#endif - break; - /* strange */ - case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */ - default: assert(0); + if (get_mode_modulo_shift(a->mode) != 0) + { + temp_val = alloca(sc_get_buffer_length()); + + sc_val_from_ulong(get_mode_modulo_shift(a->mode), temp_val); + sc_mod(b->value, temp_val, temp_val); } + else + temp_val = (char*)b->value; - return tarval_identify (tv); + sc_rot(a->value, temp_val, get_mode_size_bits(a->mode), mode_is_signed(a->mode), NULL); + return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode); } +/* + * carry flag of the last operation + */ +int tarval_carry(void) +{ + return sc_had_carry(); +} -/* Return `a<= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) { - return NULL; - } + ANNOUNCE(); + + mode_info = tv->mode->tv_priv; + if (! mode_info) + mode_info = &default_info; + prefix = mode_info->mode_prefix ? mode_info->mode_prefix : ""; + suffix = mode_info->mode_suffix ? mode_info->mode_suffix : ""; - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = a->mode; + switch (get_mode_sort(tv->mode)) + { + case irms_int_number: + case irms_character: + switch (mode_info->mode_output) { - switch (get_mode_modecode(a->mode)) { - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = a->u.CHIL << shift; + case TVO_DECIMAL: + str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_DEC); break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - tv->u.chil = a->u.chil << shift; + + case TVO_OCTAL: + str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_OCT); 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 + + case TVO_HEX: + case TVO_NATIVE: + default: + str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_HEX); break; - default: assert (0); - } + } + return snprintf(buf, len, "%s%s%s", prefix, str, suffix); - return tarval_identify (tv); -} + case irms_float_number: + switch (mode_info->mode_output) { + case TVO_HEX: + return snprintf(buf, len, "%s%s%s", prefix, fc_print(tv->value, tv_buf, sizeof(tv_buf), FC_PACKED), suffix); + case TVO_HEXFLOAT: + return snprintf(buf, len, "%s%s%s", prefix, fc_print(tv->value, tv_buf, sizeof(tv_buf), FC_HEX), suffix); -/* 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) -{ - int b_is_huge; - long shift; - tarval *tv; + case TVO_FLOAT: + case TVO_NATIVE: + default: + return snprintf(buf, len, "%s%s%s", prefix, fc_print(tv->value, tv_buf, sizeof(tv_buf), FC_DEC), suffix); + } + break; - TARVAL_VRFY (a); TARVAL_VRFY (b); + case irms_reference: + if (tv == tarval_P_void) return snprintf(buf, len, "NULL"); + if (tv->value != NULL){ + if (len > tv->length) { + memcpy(buf, tv->value, tv->length); + buf[tv->length] = '\0'; + } + else { + /* truncated */ + memcpy(buf, tv->value, len-1); + buf[len-1] = '\0'; + } + return tv->length; + } + else + return snprintf(buf, len, "void"); - shift = tarval_ord (b, &b_is_huge); - if ( b_is_huge - || (shift < 0) - || ((shift >= get_mode_size(mode_l)*target_bits) && (a->mode != mode_Z))) { - return NULL; - } + case irms_internal_boolean: + switch (mode_info->mode_output) { - tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval)); - tv->mode = a->mode; + case TVO_DECIMAL: + case TVO_OCTAL: + case TVO_HEX: + case TVO_BINARY: + return snprintf(buf, len, "%s%c%s", prefix, (tv == tarval_b_true) ? '1' : '0', suffix); - switch (get_mode_modecode(a->mode)) { - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - tv->u.CHIL = a->u.CHIL >> shift; - break; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - 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); + case TVO_NATIVE: + default: + return snprintf(buf, len, "%s%s%s", prefix, (tv == tarval_b_true) ? "true" : "false", suffix); + } + + case irms_control_flow: + case irms_memory: + case irms_auxiliary: + return snprintf(buf, len, ""); } - return tarval_identify (tv); + return 0; } -/* Classify `tv', which may be NULL. - Return 0 if `tv' is the additive neutral element, 1 if `tv' is the - multiplicative neutral element, and -1 if `tv' is the neutral - element of bitwise and. */ -long -tarval_classify (tarval *tv) -{ - if (!tv) return 2; - - TARVAL_VRFY (tv); - - switch (get_mode_modecode(tv->mode)) { - /* floating */ - case irm_f: case irm_d: - return 2; - /* unsigned */ - case irm_C: - return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_C))) - 1; - case irm_H: - return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_H))) - 1; - case irm_I: - return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_I))) - 1; - case irm_L: - return (long)((tv->u.CHIL+1) & tv_val_CHIL (get_mode_max(mode_L))) - 1; - /* signed */ - 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: - return tv->u.b; - default: - return 2; - } -} - +/** + * Output of tarvals to stdio. + */ +int tarval_printf(tarval *tv) { + char buf[1024]; + int res; -#if _TARVAL_GMP_ -bool -tarval_s_fits (tarval *tv, long min, long max) { - return (( mpz_cmp_si (&tv->u.Z, min) >= 0) - && mpz_cmp_si (&tv->u.Z, max) <= 0); + res = tarval_snprintf(buf, sizeof(buf), tv); + assert(res < sizeof(buf) && "buffer to small for tarval_snprintf"); + printf(buf); + return res; } -bool -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 - obtained by casting the result to `unsigned long'. */ -long -tarval_ord (tarval *tv, int *fail) +char *get_tarval_bitpattern(tarval *tv) { - TARVAL_VRFY (tv); - - switch (get_mode_modecode(tv->mode)) { - /* unsigned */ - case irm_C: case irm_H: case irm_I: case irm_L: - *fail = tv->u.CHIL > tv_val_CHIL (get_mode_max(mode_l)); - return tv->u.CHIL; - /* signed */ - case irm_c: case irm_h: case irm_i: case irm_l: - *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; - return tv->u.b; - default: ; - *fail = 1; - return 0; + int i, j, pos = 0; + int n = get_mode_size_bits(tv->mode); + int bytes = (n + 7) / 8; + char *res = malloc((n + 1) * sizeof(char)); + unsigned char byte; + + for(i = 0; i < bytes; i++) { + byte = get_tarval_sub_bits(tv, i); + for(j = 1; j < 256; j <<= 1) + if(pos < n) + res[pos++] = j & byte ? '1' : '0'; } + + res[n] = '\0'; + + return res; } - -int -tarval_print (XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN) +/* + * access to the bitpattern + */ +unsigned char get_tarval_sub_bits(tarval *tv, unsigned byte_ofs) { - tarval *val = XP_GETARG (tarval *, 0); - int printed; - char buf[40]; - - TARVAL_VRFY (val); + switch (get_mode_sort(tv->mode)) { + case irms_int_number: + case irms_character: + return sc_sub_bits(tv->value, tv->length, byte_ofs); - switch (get_mode_modecode(val->mode)) { + case irms_float_number: + return fc_sub_bits(tv->value, get_mode_size_bits(tv->mode), byte_ofs); - case irm_T: /* none */ - printed = XPSR (""); - break; + default: + return 0; + } +} - case irm_f: /* float */ - sprintf (buf, "%1.9e", (float)(val->u.f)); - printed = XPF1R ("%s", buf); - break; - case irm_d: /* double */ - printed = XPF1R ("%1.30g", (double)(val->u.d)); - break; +/* + * Specify the output options of one mode. + * + * This functions stores the modinfo, so DO NOT DESTROY it. + * + * Returns zero on success. + */ +int set_tarval_mode_output_option(ir_mode *mode, const tarval_mode_info *modeinfo) +{ + assert(mode); - case irm_c: /* signed char */ - case irm_C: /* unsigned char */ - if (isprint (val->u.chil)) { - printed = XPF1R ("'%c'", val->u.chil); - } else { - printed = XPF1R ("0x%x", (unsigned long)val->u.chil); - } - break; + mode->tv_priv = modeinfo; + return 0; +} - case irm_h: case irm_i: case irm_l: /* signed num */ - printed = XPF1R ("%ld", (long)val->u.chil); - break; - case irm_H: case irm_I: case irm_L: /* unsigned num */ - printed = XPF1R ("%lu", (unsigned long)val->u.CHIL); - break; +/* + * Returns the output options of one mode. + * + * This functions returns the modinfo of a given mode. + */ +const tarval_mode_info *get_tarval_mode_output_option(ir_mode *mode) +{ + assert(mode); - case irm_Z: /* mp int */ - printed = XPF1R ("%Z", &val->u.Z); - break; + return mode->tv_priv; +} - case irm_p: /* pointer */ - if (val->u.p.xname) { - printed = XPR (val->u.p.xname); - } else if (val->u.p.ent) { - 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)"); - } - break; +/* + * Identifying tarvals values for algebraic simplifications. + * + * Returns: + * - TV_CLASSIFY_NULL for additive neutral, + * - TV_CLASSIFY_ONE for multiplicative neutral, + * - TV_CLASSIFY_ALL_ONE for bitwise-and neutral + * - TV_CLASSIFY_OTHER else + */ +tarval_classification_t classify_tarval(tarval *tv) +{ + ANNOUNCE(); + if (!tv || tv == tarval_bad) return TV_CLASSIFY_OTHER; + + if (tv == get_mode_null(tv->mode)) + return TV_CLASSIFY_NULL; + else if (tv == get_mode_one(tv->mode)) + return TV_CLASSIFY_ONE; + else if ((get_mode_sort(tv->mode) == irms_int_number) + && (tv == new_tarval_from_long(-1, tv->mode))) + return TV_CLASSIFY_ALL_ONE; + + return TV_CLASSIFY_OTHER; +} - case irm_b: /* boolean */ - if (val->u.b) printed = XPSR ("true"); - else printed = XPSR ("false"); - break; +/** + * Sets the overflow mode for integer operations. + */ +void tarval_set_integer_overflow_mode(tarval_int_overflow_mode_t ov_mode) { + int_overflow_mode = ov_mode; +} - case irm_B: /* universal bits */ - printed = XPSR ("<@@@ some bits>"); - break; +/** + * Get the overflow mode for integer operations. + */ +tarval_int_overflow_mode_t tarval_get_integer_overflow_mode(void) { + return int_overflow_mode; +} - case irm_s: /* string */ - case irm_S: - { size_t i; - char *buf = alloca (val->u.s.n + 2); - char *bp; - - printed = 0; - buf[0] = '\''; - bp = buf + 1; - for (i = 0; i < val->u.s.n; ++i) { - if (isprint (val->u.s.p[i])) { - *bp++ = val->u.s.p[i]; - } else { - if (bp != buf) { - XPM (buf, bp-buf); - bp = buf; - } - XPF1 ("'\\%03o'", val->u.s.p[i]); - } - } - *bp++ = '\''; - XPM (buf, bp-buf); - break; - } +/** + * default mode_info for output as HEX + */ +static const tarval_mode_info hex_output = { + TVO_HEX, + "0x", + NULL, +}; +/** + * default mode_info for output as reference + */ +static const tarval_mode_info reference_output = { + TVO_NATIVE, + "&(", + ")", +}; - case irm_M: /* memory */ - case irm_R: /* region */ - default: - assert (0); - } - return printed; +/* + * Initialization of the tarval module: called before init_mode() + */ +void init_tarval_1(void) +{ + ANNOUNCE(); + /* initialize the sets holding the tarvals with a comparison function and + * an initial size, which is the expected number of constants */ + tarvals = new_set(memcmp, N_CONSTANTS); + values = new_set(memcmp, N_CONSTANTS); + /* init strcalc with precision of 68 to support floating point values with 64 + * bit mantissa (needs extra bits for rounding and overflow) */ + init_strcalc(68); + init_fltcalc(0); } - -ir_mode * -get_tv_mode (tarval *tv) +/* + * Initialization of the tarval module: called after init_mode() + */ +void init_tarval_2(void) { - return tv->mode; + ANNOUNCE(); + + tarval_bad->mode = mode_BAD; + tarval_undefined->mode = mode_ANY; + tarval_b_true->mode = mode_b; + tarval_b_false->mode = mode_b; + tarval_P_void->mode = mode_P; + + /* + * assign output modes that are compatible with the + * old implementation: Hex output + */ + set_tarval_mode_output_option(mode_U, &hex_output); + set_tarval_mode_output_option(mode_C, &hex_output); + set_tarval_mode_output_option(mode_Bs, &hex_output); + set_tarval_mode_output_option(mode_Bu, &hex_output); + set_tarval_mode_output_option(mode_Hs, &hex_output); + set_tarval_mode_output_option(mode_Hu, &hex_output); + set_tarval_mode_output_option(mode_Is, &hex_output); + set_tarval_mode_output_option(mode_Iu, &hex_output); + set_tarval_mode_output_option(mode_Ls, &hex_output); + set_tarval_mode_output_option(mode_Lu, &hex_output); + set_tarval_mode_output_option(mode_P, &reference_output); } -/* 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; +/* free all memory occupied by tarval. */ +void finish_tarval(void) { + finish_strcalc (); + finish_fltcalc (); + del_set(tarvals); tarvals = NULL; + del_set(values); values = NULL; } + +/**************************************************************************** + * end of tv.c + ****************************************************************************/