tv.c

/*
 * 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 Universitt 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 has IEEE-754 floating-point arithmetic.  */


#ifdef HAVE_CONFIG_H
# include "config.h"
#endif


#include <assert.h>         /* assertions */
#include <stdlib.h>         /* atoi() */
#include <string.h>         /* nice things for strings */
#ifdef HAVE_STRINGS_H
#include <strings.h>        /* strings.h also includes bsd only function strcasecmp */
#endif
#include <stdlib.h>
#ifdef HAVE_ALLOCA_H
# include <alloca.h>
#endif
#ifdef HAVE_MALLOC_H
# include <malloc.h>
#endif

#include "tv_t.h"
#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 "host.h"
#include "strcalc.h"
#include "fltcalc.h"

/** Size of hash tables.  Should correspond to average number of distinct constant
    target values */
#define N_CONSTANTS 2048

/* XXX hack until theres's a proper interface */
#define BAD 1
#define SATURATE 2
#define WRAP 3
#define GET_OVERFLOW_MODE() BAD

/* 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

#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))))

#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)))

#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 */

/****************************************************************************
 *   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)
{
  /* 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

INLINE static void tarval_verify(tarval *tv)
{
  assert(tv);
  assert(tv->mode);
  assert(tv->value);

  if ((tv == tarval_bad) || (tv == tarval_undefined)) return;
  if ((tv == tarval_b_true) || (tv == tarval_b_false)) return;

  if (!FIND_TARVAL(tv)) fail_verify(tv);
  if (tv->length > 0 && !FIND_VALUE(tv->value, tv->length)) fail_verify(tv);

  return;
}
#endif /* NDEBUG */

static int hash_tv(tarval *tv)
{
  return ((unsigned int)tv->value ^ (unsigned int)tv->mode) + tv->length;
}

static int hash_val(const void *value, unsigned int length)
{
  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);
  }

  return hash;
}

/* finds tarval with value/mode or creates new tarval */
static tarval *get_tarval(const void *value, int length, ir_mode *mode)
{
  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);
}

static tarval *get_tarval_overflow(const void *value, int length, ir_mode *mode)
{
  switch (get_mode_sort(mode))
  {
    case irms_int_number:
      if (sc_comp(value, get_mode_max(mode)->value) == 1) {
        switch (GET_OVERFLOW_MODE()) {
          case SATURATE:
            return get_mode_max(mode);
          case 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 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 SATURATE:
            return get_mode_min(mode);
          case 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 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);
      }

      if (SWITCH_NODENORMALS && fc_is_subnormal(value))
      {
        return get_mode_null(mode);
      }
      break;
    default:
      break;
  }
  return get_tarval(value, length, mode);
}


/*
 *   public variables declared in tv.h
 */
static tarval reserved_tv[5];

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
 */

/*
 * Constructors =============================================================
 */
tarval *new_tarval_from_str(const char *str, size_t len, ir_mode *mode)
{
  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;

    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);

    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);
  }

  assert(0);  /* can't be reached, can it? */
  return NULL;
}

/*
 * helper function, create a tarval from long
 */
tarval *new_tarval_from_long(long l, ir_mode *mode)
{
  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 ;

    case irms_int_number:
    case irms_character:
      sc_val_from_long(l, NULL);
      return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);

    case irms_float_number:
      return new_tarval_from_double((long double)l, mode);

    case irms_reference:
      return l ? tarval_bad : get_tarval(NULL, 0, mode);  /* null pointer or tarval_bad */

    default:
      assert(0);
  }
  return NULL;
}

/* returns non-zero if can be converted to long */
int tarval_is_long(tarval *tv)
{
  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;
    }
  }
  return 1;
}

/* this might overflow the machine's long, so use only with small values */
long tarval_to_long(tarval* tv)
{
  ANNOUNCE();
  assert(tarval_is_long(tv) && "tarval too big to fit in long");

  return sc_val_to_long(tv->value);
}

tarval *new_tarval_from_double(long double d, ir_mode *mode)
{
  ANNOUNCE();
  assert(mode && (get_mode_sort(mode) == irms_float_number));

  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;
  }
  return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
}

/* returns non-zero if can be converted to double */
int tarval_is_double(tarval *tv)
{
  ANNOUNCE();
  assert(tv);

  return (get_mode_sort(tv->mode) == irms_float_number);
}

long double tarval_to_double(tarval *tv)
{
  ANNOUNCE();
  assert(tarval_is_double(tv));

  return fc_val_to_float(tv->value);
}

/* The tarval represents the address of the entity.  As the address must
   be constant the entity must have as owner the global type.
 * We no more support this function: Use the new SymConst instead.
 */
tarval *new_tarval_from_entity (entity *ent, ir_mode *mode)
{
  ANNOUNCE();
  assert(ent);
  assert(mode && (get_mode_sort(mode) == irms_reference));

  return get_tarval((void *)ent, 0, mode);
}


int tarval_is_entity(tarval *tv)
{
  ANNOUNCE();
  assert(tv);
  /* tv->value == NULL means dereferencing a null pointer */
  return ((get_mode_sort(tv->mode) == irms_reference) && (tv->value != NULL) && (tv->length == 0)
      && (tv != tarval_P_void));
}

#undef tarval_to_entity
entity *tarval_to_entity(tarval *tv) { return get_tarval_entity(tv); }
entity *get_tarval_entity(tarval *tv)
{
  ANNOUNCE();
  assert(tv);

  if (tarval_is_entity(tv))
    return (entity *)tv->value;
  else {
    assert(0 && "tarval did not represent an entity");
    return NULL;
  }
}

void free_tarval_entity(entity *ent) {
  /* There can be a tarval referencing this entity.  Even if the
     tarval is not used by the code any more, it can still reference
     the entity as tarvals live indepently of the entity referenced.
     Further the tarval is hashed into a set. If a hash function
     evaluation happens to collide with this tarval, we will vrfy that
     it contains a proper entity and we will crash if the entity is
     freed.

     Unluckily, tarvals can neither be changed nor deleted, and to find
     one, all existing reference modes have to be tried -> a facility
     to retrieve all modes of a kind is needed. */
  ANNOUNCE();
}

/*
 * Access routines for tarval fields ========================================
 */
ir_mode *get_tarval_mode (tarval *tv)       /* get the mode of the tarval */
{
  ANNOUNCE();
  assert(tv);
  return tv->mode;
}

/*
 * 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;
}

tarval *get_tarval_max(ir_mode *mode)
{
  ANNOUNCE();
  assert(mode);

  if (get_mode_vector_elems(mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  switch(get_mode_sort(mode))
  {
    case irms_reference:
    case irms_control_flow:
    case irms_memory:
    case irms_auxiliary:
      assert(0);
      break;

    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);

    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_bad;
}

tarval *get_tarval_min(ir_mode *mode)
{
  ANNOUNCE();
  assert(mode);

  if (get_mode_vector_elems(mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  switch(get_mode_sort(mode))
  {
    case irms_reference:
    case irms_control_flow:
    case irms_memory:
    case irms_auxiliary:
      assert(0);
      break;

    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);

    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 *get_tarval_null(ir_mode *mode)
{
  ANNOUNCE();
  assert(mode);

  if (get_mode_vector_elems(mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  switch(get_mode_sort(mode))
  {
    case irms_control_flow:
    case irms_memory:
    case irms_auxiliary:
    case irms_internal_boolean:
      assert(0);
      break;

    case irms_float_number:
      return new_tarval_from_double(0.0, mode);

    case irms_int_number:
    case irms_character:
      return new_tarval_from_long(0l,  mode);

    case irms_reference:
      return tarval_P_void;
  }
  return tarval_bad;
}

tarval *get_tarval_one(ir_mode *mode)
{
  ANNOUNCE();
  assert(mode);

  if (get_mode_vector_elems(mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  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;

    case irms_float_number:
      return new_tarval_from_double(1.0, mode);

    case irms_int_number:
    case irms_character:
      return new_tarval_from_long(1l, mode);
      break;
  }
  return tarval_bad;
}

tarval *get_tarval_nan(ir_mode *mode)
{
  ANNOUNCE();
  assert(mode);

  if (get_mode_vector_elems(mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  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 *get_tarval_inf(ir_mode *mode)
{
  ANNOUNCE();
  assert(mode);

  if (get_mode_vector_elems(mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  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 ========================================
 */

/*
 * test if negative number, 1 means 'yes'
 */
int tarval_is_negative(tarval *a)
{
  ANNOUNCE();
  assert(a);

  if (get_mode_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;

    case irms_float_number:
      return fc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0;

    default:
      assert(0 && "not implemented");
      return 0;
  }
}

/*
 * test if null, 1 means 'yes'
 */
int tarval_is_null(tarval *a)
{
  ir_mode *m = get_tarval_mode(a);

  return a == get_tarval_null(m);
}

/*
 * test if one, 1 means 'yes'
 */
int tarval_is_one(tarval *a)
{
  ir_mode *m = get_tarval_mode(a);

  return a == get_tarval_one(m);
}

/*
 * comparison
 */
pnc_number tarval_cmp(tarval *a, tarval *b)
{
  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_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);

    case irms_internal_boolean:
      return (a == tarval_b_true)?(Gt):(Lt);
  }
  return False;
}

/*
 * convert to other mode
 */
tarval *tarval_convert_to(tarval *src, ir_mode *m)
{
  char *buffer;

  ANNOUNCE();
  assert(src);
  assert(m);

  if (src->mode == m) return src;

  if (get_mode_vector_elems(src->mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  switch (get_mode_sort(src->mode))
  {
    case irms_control_flow:
    case irms_memory:
    case irms_auxiliary:
      break;

    /* 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);
      break;

        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;
      break;

        default:
          /* the rest can't be converted */
          return tarval_bad;
      }
      break;

    /* 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 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);

        default:
          break;
      }
      break;

    case irms_character:
      break;
    case irms_reference:
      break;
  }

  return tarval_bad;
}

/*
 * bitwise negation
 */
tarval *tarval_not(tarval *a)
{
  char *buffer;

  ANNOUNCE();
  assert(a);
  assert(mode_is_int(a->mode)); /* bitwise negation is only allowed for integer */

  /* works for vector mode without changes */

  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:
      return tarval_bad;
  }
}

/*
 * arithmetic negation
 */
tarval *tarval_neg(tarval *a)
{
  char *buffer;

  ANNOUNCE();
  assert(a);
  assert(mode_is_num(a->mode)); /* negation only for numerical values */
  assert(mode_is_signed(a->mode)); /* negation is difficult without negative numbers, isn't it */

  if (get_mode_vector_elems(a->mode) > 1) {
    /* vector arithmetic not implemented yet */
    return tarval_bad;
  }

  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);

    case irms_float_number: