nsz Git - libfirm/blob - ir/tv/tv.c

   1 /* TV --- Target Values, aka Constant Table.
   2    Copyright (C) 1995, 1996 Christian von Roques */
   3
   4 /* $Id$ */
   5
   6 /****i* tv/implementation
   7  *
   8  * AUTHORS
   9  *    Christian von Roques
  10  *    Matthias Heil
  11  *
  12  * NOTES
  13  *    Internal storage for tarvals, 1st draft:
  14  *   Integers as well as pointers are stored in a hex formatted string holding
  15  *   16 characters. Booleans are not stored as there are only two of them.
  16  *
  17  *    Floats are just reinterpreted as byte strings, because I am not sure if
  18  *   there is loss if I convert float to long double and back and furthermore
  19  *   the implementation of a fully ieee compatible floating point emulation
  20  *   is not sensible for now
  21  *    With this information it is easy to decide the kind of stored value:
  22  *   Integers have size 16, floats 4, doubles 8, long doubles 12.
  23  ******/
  24
  25 /* This implementation assumes:
  26    * both host and target have IEEE-754 floating-point arithmetic.  */
  27
  28 /* !!! float and double divides MUST NOT SIGNAL !!! */
  29 /* @@@ query the floating-point expception status flags */
  30
  31 /* @@@ Problem: All Values are stored twice, once as Univ_*s and a 2nd
  32    time in their real target mode. :-( */
  33
  34 #define MAX_INT_LENGTH 8
  35 #define CHAR_BUFFER_SIZE ((MAX_INT_LENGTH) * 2)
  36
  37 #ifdef HAVE_CONFIG_H
  38 # include <config.h>
  39 #endif
  40
  41 #include <assert.h>         /* assertions */
  42 #include <string.h>         /* nice things for strings */
  43
  44 #include <malloc.h>
  45 #include "tv_t.h"
  46 #include "set.h"            /* to store tarvals in */
  47 #include "tune.h"           /* some constants */
  48 #include "entity_t.h"       /* needed to store pointers to entities */
  49 #include "irmode.h"         /* defines modes etc */
  50 #include "irnode.h"         /* defines boolean return values */
  51 #include "xprintf.h"
  52 #include "xp_help.h"
  53 #include "host.h"
  54 #include "strcalc.h"
  55 #include "fltcalc.h"
  56
  57 /****************************************************************************
  58  *   local definitions and macros
  59  ****************************************************************************/
  60 #ifndef NDEBUG
  61 #  define TARVAL_VERIFY(a) tarval_verify((a))
  62 #else
  63 #  define TARVAL_VERIFY(a) ((void)0)
  64 #endif
  65
  66 #define INSERT_TARVAL(tv) ((tarval*)set_insert(tarvals, (tv), sizeof(tarval), hash_tv((tv))))
  67 #define FIND_TARVAL(tv) ((tarval*)set_find(tarvals, (tv), sizeof(tarval), hash_tv((tv))))
  68
  69 #define INSERT_VALUE(val, size) (set_insert(values, (val), size, hash_val((val), size)))
  70 #define FIND_VALUE(val, size) (set_find(values, (val), size, hash_val((val), size)))
  71
  72 #define fail_verify(a) _fail_verify((a), __FILE__, __LINE__)
  73 #if 0
  74 static long long count = 0;
  75 #  define ANNOUNCE() printf(__FILE__": call no. %lld (%s)\n", count++, __FUNCTION__);
  76 #else
  77 #  define ANNOUNCE() ((void)0)
  78 #endif
  79 /****************************************************************************
  80  *   private variables
  81  ****************************************************************************/
  82 static struct set *tarvals;   /* container for tarval structs */
  83 static struct set *values;    /* container for values */
  84
  85 /****************************************************************************
  86  *   private functions
  87  ****************************************************************************/
  88 #ifndef NDEBUG
  89 static int hash_val(const void *value, unsigned int length);
  90 static int hash_tv(tarval *tv);
  91 static void _fail_verify(tarval *tv, const char* file, int line)
  92 {
  93   /* print a memory image of the tarval and throw an assertion */
  94   if (tv)
  95     printf("%s:%d: Invalid tarval:\n  mode: %s\n value: [%p]\n", file, line, get_mode_name(tv->mode), tv->value);
  96   else
  97     printf("%s:%d: Invalid tarval (null)", file, line);
  98   assert(0);
  99 }
 100
 101 static void tarval_verify(tarval *tv)
 102 {
 103   assert(tv);
 104   assert(tv->mode);
 105   assert(tv->value);
 106
 107   if ((tv == tarval_bad) || (tv == tarval_undefined)) return;
 108   if ((tv == tarval_b_true) || (tv == tarval_b_false)) return;
 109
 110   if (!FIND_TARVAL(tv)) fail_verify(tv);
 111   if (tv->length > 0 && !FIND_VALUE(tv->value, tv->length)) fail_verify(tv);
 112
 113   return;
 114 }
 115 #endif /* NDEBUG */
 116
 117 static int hash_tv(tarval *tv)
 118 {
 119   return ((unsigned int)tv->value ^ (unsigned int)tv->mode) + tv->length;
 120 }
 121
 122 static int hash_val(const void *value, unsigned int length)
 123 {
 124   unsigned int i;
 125   unsigned int hash = 0;
 126
 127   /* scramble the byte - array */
 128   for (i = 0; i < length; i++)
 129   {
 130     hash += (hash << 5) ^ (hash >> 27) ^ ((char*)value)[i];
 131     hash += (hash << 11) ^ (hash >> 17);
 132   }
 133
 134   return hash;
 135 }
 136
 137 /* finds tarval with value/mode or creates new tarval*/
 138 static tarval *get_tarval(const void *value, int length, ir_mode *mode)
 139 {
 140   tarval tv;
 141
 142   tv.mode = mode;
 143   tv.length = length;
 144   if (length > 0)
 145     /* if there already is such a value, it is returned, else value
 146      * is copied into the set */
 147     tv.value = INSERT_VALUE(value, length);
 148   else
 149     tv.value = value;
 150
 151   /* if there is such a tarval, it is returned, else tv is copied
 152    * into the set */
 153   return (tarval *)INSERT_TARVAL(&tv);
 154 }
 155
 156 static int overflows(tarval *tv)
 157 {
 158   switch (get_mode_sort(tv->mode))
 159   {
 160     case character:
 161     case int_number:
 162       if (sc_comp(tv->value, get_mode_max(tv->mode)->value) == 1) return 1;
 163       if (sc_comp(tv->value, get_mode_min(tv->mode)->value) == -1) return 1;
 164       break;
 165
 166     case float_number:
 167       if (fc_comp(tv->value, get_mode_max(tv->mode)->value) == 1) return 1;
 168       if (fc_comp(tv->value, get_mode_min(tv->mode)->value) == -1) return 1;
 169       break;
 170
 171     default:
 172       break;
 173   }
 174
 175   return 0;
 176 }
 177
 178 /****************************************************************************
 179  *   public variables declared in tv.h
 180  ****************************************************************************/
 181 tarval *tarval_bad;
 182 tarval *tarval_undefined;
 183 tarval *tarval_b_false;
 184 tarval *tarval_b_true;
 185 tarval *tarval_P_void;
 186
 187 /****************************************************************************
 188  *   public functions declared in tv.h
 189  ****************************************************************************/
 190 /*
 191  * Constructors =============================================================
 192  */
 193 tarval *new_tarval_from_str(const char *str, size_t len, ir_mode *mode)
 194 {
 195   ANNOUNCE();
 196   assert(str);
 197   assert(len);
 198   assert(mode);
 199
 200   switch (get_mode_sort(mode))
 201   {
 202     case auxiliary:
 203       assert(0);
 204       break;
 205
 206     case internal_boolean:
 207       /* match tTrRuUeE/fFaAlLsSeE */
 208       if (strcmp(str, "true")) return tarval_b_true;
 209         else return tarval_b_false;
 210
 211     case float_number:
 212       fc_val_from_str(str, len);
 213       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 214
 215     case int_number:
 216     case character:
 217       sc_val_from_str(str, len);
 218       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);
 219
 220     case reference:
 221       return get_tarval(str, len, mode);
 222   }
 223
 224   assert(0);  /* can't be reached, can it? */
 225 }
 226
 227 #if 0
 228 int tarval_is_str(tarval *tv)
 229 {
 230   ANNOUNCE();
 231   assert(tv);
 232
 233   return ((get_mode_sort(tv->mode) == reference) && (tv->value != NULL) && (tv->length > 0));
 234 }
 235 char *tarval_to_str(tarval *tv)
 236 {
 237   ANNOUNCE();
 238   assert(tarval_is_str(tv));
 239   return (char *)tv->value;
 240 }
 241 #endif
 242
 243 tarval *new_tarval_from_long(long l, ir_mode *mode)
 244 {
 245   ANNOUNCE();
 246   assert(mode && !(get_mode_sort(mode) == auxiliary));
 247
 248   switch(get_mode_sort(mode))
 249   {
 250     case internal_boolean:
 251       /* XXX C-Semantics ! */
 252       return (l)?(tarval_b_true):(tarval_b_false);
 253
 254     case int_number:
 255     case character:
 256       sc_val_from_long(l);
 257       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);
 258
 259     case float_number:
 260       return new_tarval_from_double((long double)l, mode);
 261
 262     case reference:
 263       return (l)?(tarval_bad):(get_tarval(NULL, 0, mode));  /* null pointer or tarval_bad */
 264
 265     default:
 266       assert(0);
 267   }
 268 }
 269 int tarval_is_long(tarval *tv)
 270 {
 271   ANNOUNCE();
 272   return ((get_mode_sort(tv->mode) == int_number) || (get_mode_sort(tv->mode) == character));
 273 }
 274 /* this might overflow the machine's long, so use only with
 275  * small values */
 276 long tarval_to_long(tarval* tv)
 277 {
 278   ANNOUNCE();
 279   assert(tv && get_mode_sort(tv->mode) == int_number);
 280
 281   return sc_val_to_long(tv->value); /* might overflow */
 282 }
 283
 284 tarval *new_tarval_from_double(long double d, ir_mode *mode)
 285 {
 286   ANNOUNCE();
 287   assert(mode && (get_mode_sort(mode) == float_number));
 288
 289   fc_val_from_float(d);
 290   return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 291 }
 292 int tarval_is_double(tarval *tv)
 293 {
 294   ANNOUNCE();
 295   assert(tv);
 296
 297   return (get_mode_sort(tv->mode) == float_number);
 298 }
 299 long double tarval_to_double(tarval *tv)
 300 {
 301   ANNOUNCE();
 302   assert(tarval_is_double(tv));
 303
 304   return fc_val_to_float(tv->value);
 305 }
 306
 307 /* The tarval represents the address of the entity.  As the address must
 308    be constant the entity must have as owner the global type. */
 309 tarval *new_tarval_from_entity (entity *ent, ir_mode *mode)
 310 {
 311   ANNOUNCE();
 312   assert(ent);
 313   assert(mode && (get_mode_sort(mode) == reference));
 314
 315   return get_tarval((void *)ent, 0, mode);
 316 }
 317 int tarval_is_entity(tarval *tv)
 318 {
 319   ANNOUNCE();
 320   assert(tv);
 321   /* tv->value == NULL means dereferencing a null pointer */
 322   return ((get_mode_sort(tv->mode) == reference) && (tv->value != NULL) && (tv->length == 0));
 323 }
 324 entity *tarval_to_entity(tarval *tv)
 325 {
 326   ANNOUNCE();
 327   assert(tarval_is_entity(tv));
 328
 329   return (entity *)tv->value;
 330 }
 331
 332 /*
 333  * Access routines for tarval fields ========================================
 334  */
 335 #ifdef TARVAL_ACCESS_DEFINES
 336 #  undef get_tarval_mode
 337 #endif
 338 ir_mode *get_tarval_mode (tarval *tv)       /* get the mode of the tarval */
 339 {
 340   ANNOUNCE();
 341   assert(tv);
 342   return tv->mode;
 343 }
 344 #ifdef TARVAL_ACCESS_DEFINES
 345 #  define get_tarval_mode(tv) (tv)->mode
 346 #endif
 347
 348 /*
 349  * Special value query functions ============================================
 350  *
 351  * These functions calculate and return a tarval representing the requested
 352  * value.
 353  * The functions get_mode_{Max,Min,...} return tarvals retrieved from these
 354  * functions, but these are stored on initialization of the irmode module and
 355  * therefore the irmode functions should be prefered to the functions below.
 356  */
 357
 358 tarval *get_tarval_bad(void)
 359 {
 360   ANNOUNCE();
 361   return tarval_bad;
 362 }
 363 tarval *get_tarval_undefined(void)
 364 {
 365   ANNOUNCE();
 366   return tarval_undefined;
 367 }
 368 tarval *get_tarval_b_false(void)
 369 {
 370   ANNOUNCE();
 371   return tarval_b_false;
 372 }
 373 tarval *get_tarval_b_true(void)
 374 {
 375   ANNOUNCE();
 376   return tarval_b_true;
 377 }
 378 tarval *get_tarval_P_void(void)
 379 {
 380   ANNOUNCE();
 381   return tarval_P_void;
 382 }
 383
 384 tarval *get_tarval_max(ir_mode *mode)
 385 {
 386   ANNOUNCE();
 387   assert(mode);
 388
 389   switch(get_mode_sort(mode))
 390   {
 391     case reference:
 392     case auxiliary:
 393       assert(0);
 394       break;
 395
 396     case internal_boolean:
 397       return tarval_b_true;
 398
 399     case float_number:
 400       fc_get_max(get_mode_size(mode));
 401       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 402
 403     case int_number:
 404     case character:
 405       sc_max_from_bits(get_mode_size(mode), mode_is_signed(mode));
 406       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);
 407   }
 408   return tarval_bad;
 409 }
 410
 411 tarval *get_tarval_min(ir_mode *mode)
 412 {
 413   ANNOUNCE();
 414   assert(mode);
 415
 416   switch(get_mode_sort(mode))
 417   {
 418     case reference:
 419     case auxiliary:
 420       assert(0);
 421       break;
 422
 423     case internal_boolean:
 424       return tarval_b_false;
 425
 426     case float_number:
 427       fc_get_min(get_mode_size(mode));
 428       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 429
 430     case int_number:
 431     case character:
 432       sc_min_from_bits(get_mode_size(mode), mode_is_signed(mode));
 433       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);
 434   }
 435   return tarval_bad;
 436 }
 437
 438 tarval *get_tarval_null(ir_mode *mode)
 439 {
 440   ANNOUNCE();
 441   assert(mode);
 442
 443   switch(get_mode_sort(mode))
 444   {
 445     case auxiliary:
 446     case internal_boolean:
 447       assert(0);
 448       break;
 449
 450     case float_number:
 451       return new_tarval_from_double(0.0, mode);
 452
 453     case int_number:
 454     case character:
 455       return new_tarval_from_long(0l,  mode);
 456
 457     case reference:
 458       return tarval_P_void;
 459   }
 460   return tarval_bad;
 461 }
 462
 463 tarval *get_tarval_one(ir_mode *mode)
 464 {
 465   ANNOUNCE();
 466   assert(mode);
 467
 468   switch(get_mode_sort(mode))
 469   {
 470     case auxiliary:
 471     case internal_boolean:
 472     case reference:
 473       assert(0);
 474       break;
 475
 476     case float_number:
 477       return new_tarval_from_double(1.0, mode);
 478
 479     case int_number:
 480     case character:
 481       return new_tarval_from_long(1l, mode);
 482       break;
 483   }
 484   return tarval_bad;
 485 }
 486
 487 tarval *get_tarval_nan(ir_mode *mode)
 488 {
 489   ANNOUNCE();
 490   assert(mode);
 491   assert(get_mode_sort(mode) == float_number);
 492
 493   fc_get_nan();
 494   return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 495 }
 496
 497 tarval *get_tarval_inf(ir_mode *mode)
 498 {
 499   ANNOUNCE();
 500   assert(mode);
 501   assert(get_mode_sort(mode) == float_number);
 502
 503   fc_get_inf();
 504   return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 505 }
 506
 507 /*
 508  * Arithmethic operations on tarvals ========================================
 509  */
 510
 511 /* test if negative number, 1 means 'yes' */
 512 int tarval_is_negative(tarval *a)
 513 {
 514   ANNOUNCE();
 515   assert(a);
 516
 517   switch (get_mode_sort(a->mode))
 518   {
 519     case int_number:
 520       if (!mode_is_signed(a->mode)) return 0;
 521       else return sc_comp(a->value, get_mode_null(a->mode)->value);
 522
 523     case float_number:
 524       return fc_comp(a->value, get_mode_null(a->mode)->value);
 525
 526     default:
 527       assert(0 && "not implemented");
 528   }
 529 }
 530
 531 /* comparison */
 532 pnc_number tarval_cmp(tarval *a, tarval *b)
 533 {
 534   ANNOUNCE();
 535   assert(a);
 536   assert(b);
 537
 538   if (a == tarval_bad || b == tarval_bad) assert(0 && "Comparison with tarval_bad");
 539   if (a == tarval_undefined || b == tarval_undefined) return False;
 540   if (a == b) return Eq;
 541   if (get_tarval_mode(a) != get_tarval_mode(b)) return Uo;
 542
 543   /* Here the two tarvals are unequal and of the same mode */
 544   switch (get_mode_sort(a->mode))
 545   {
 546     case auxiliary:
 547       return False;
 548
 549     case float_number:
 550       return (fc_comp(a->value, b->value)==1)?(Gt):(Lt);
 551
 552     case int_number:
 553     case character:
 554       return (sc_comp(a->value, b->value)==1)?(Gt):(Lt);
 555
 556     case internal_boolean:
 557       return (a == tarval_b_true)?(Gt):(Lt);
 558
 559     case reference:
 560       return Uo;
 561   }
 562   return False;
 563 }
 564
 565 tarval *tarval_convert_to(tarval *src, ir_mode *m)
 566 {
 567   ANNOUNCE();
 568   tarval tv;
 569
 570   assert(src);
 571   assert(m);
 572
 573   if (src->mode == m) return src;
 574
 575   switch (get_mode_sort(src->mode))
 576   {
 577     case auxiliary:
 578       break;
 579
 580     case float_number:
 581       break;
 582
 583     case int_number:
 584       switch (get_mode_sort(m))
 585       {
 586         case int_number:
 587         case character:
 588           tv.mode = m;
 589           tv.length = src->length;
 590           tv.value = src->value;
 591           if (overflows(&tv))
 592           {
 593             return tarval_bad;
 594           }
 595           return INSERT_TARVAL(&tv);
 596
 597         case internal_boolean:
 598           /* XXX C semantics */
 599           if (src == get_mode_null(src->mode)) return tarval_b_false;
 600           else return tarval_b_true;
 601
 602         default:
 603           break;
 604       }
 605       break;
 606
 607     case internal_boolean:
 608       switch (get_mode_sort(m))
 609       {
 610         case int_number:
 611           if (src == tarval_b_true) return get_mode_one(m);
 612           else return get_mode_null(m);
 613
 614         default:
 615           break;
 616       }
 617       break;
 618
 619     case character:
 620       break;
 621     case reference:
 622       break;
 623   }
 624
 625   return tarval_bad;
 626 }
 627
 628 tarval *tarval_neg(tarval *a)              /* negation */
 629 {
 630   ANNOUNCE();
 631   assert(a);
 632   assert(mode_is_num(a->mode)); /* negation only for numerical values */
 633   assert(mode_is_signed(a->mode)); /* negation is difficult without negative numbers, isn't it */
 634
 635   switch (get_mode_sort(a->mode))
 636   {
 637     case int_number:
 638       sc_neg(a->value);
 639       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 640
 641     case float_number:
 642       fc_neg(a->value);
 643       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 644
 645     default:
 646       return tarval_bad;
 647   }
 648 }
 649
 650 tarval *tarval_add(tarval *a, tarval *b)   /* addition */
 651 {
 652   ANNOUNCE();
 653   assert(a);
 654   assert(b);
 655   assert((a->mode == b->mode) || (get_mode_sort(a->mode) == character && mode_is_int(b->mode)));
 656
 657   switch (get_mode_sort(a->mode))
 658   {
 659     case character:
 660     case int_number:
 661       /* modes of a,b are equal, so result has mode of a as this might be the character */
 662       sc_add(a->value, b->value);
 663       /* FIXME: Check for overflow */
 664       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 665
 666     case float_number:
 667       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 668       fc_add(a->value, b->value);
 669       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 670
 671     default:
 672       return tarval_bad;
 673   }
 674 }
 675
 676 tarval *tarval_sub(tarval *a, tarval *b)   /* subtraction */
 677 {
 678   ANNOUNCE();
 679   assert(a);
 680   assert(b);
 681   assert((a->mode == b->mode) || (get_mode_sort(a->mode) == character && mode_is_int(b->mode)));
 682
 683   switch (get_mode_sort(a->mode))
 684   {
 685     case character:
 686     case int_number:
 687       /* modes of a,b are equal, so result has mode of a as this might be the character */
 688       sc_sub(a->value, b->value);
 689       /* FIXME: check for overflow */
 690       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 691
 692     case float_number:
 693       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 694       fc_add(a->value, b->value);
 695       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 696
 697     default:
 698       return tarval_bad;
 699   }
 700 }
 701
 702 tarval *tarval_mul(tarval *a, tarval *b)   /* multiplication */
 703 {
 704   ANNOUNCE();
 705   assert(a);
 706   assert(b);
 707   assert((a->mode == b->mode) && mode_is_num(a->mode));
 708
 709   switch (get_mode_sort(a->mode))
 710   {
 711     case int_number:
 712       /* modes of a,b are equal */
 713       sc_mul(a->value, b->value);
 714       /* FIXME: check for overflow */
 715       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 716
 717     case float_number:
 718       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 719       fc_add(a->value, b->value);
 720       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 721
 722     default:
 723       return tarval_bad;
 724   }
 725 }
 726
 727 tarval *tarval_quo(tarval *a, tarval *b)   /* floating point division */
 728 {
 729   ANNOUNCE();
 730   assert(a);
 731   assert(b);
 732   assert((a->mode == b->mode) && mode_is_float(a->mode));
 733
 734   /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 735   fc_div(a->value, b->value);
 736   return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 737 }
 738
 739 tarval *tarval_div(tarval *a, tarval *b)   /* integer division */
 740 {
 741   ANNOUNCE();
 742   assert(a);
 743   assert(b);
 744   assert((a->mode == b->mode) && mode_is_int(a->mode));
 745
 746   /* modes of a,b are equal */
 747   sc_div(a->value, b->value);
 748   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 749 }
 750
 751 tarval *tarval_mod(tarval *a, tarval *b)   /* remainder */
 752 {
 753   ANNOUNCE();
 754   assert(a);
 755   assert(b);
 756   assert((a->mode == b->mode) && mode_is_int(a->mode));
 757
 758   /* modes of a,b are equal */
 759   sc_mod(a->value, b->value);
 760   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 761 }
 762
 763 tarval *tarval_abs(tarval *a)              /* absolute value */
 764 {
 765   ANNOUNCE();
 766   assert(a);
 767   assert(mode_is_num(a->mode));
 768
 769   switch (get_mode_sort(a->mode))
 770   {
 771     case int_number:
 772       if (sc_comp(a->value, get_mode_null(a->mode)->value) == -1)
 773       {
 774         sc_neg(a->value);
 775         return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 776       }
 777       return a;
 778
 779     case float_number:
 780       break;
 781
 782     default:
 783       return tarval_bad;
 784   }
 785   return tarval_bad;
 786 }
 787
 788 tarval *tarval_and(tarval *a, tarval *b)   /* bitwise and */
 789 {
 790   ANNOUNCE();
 791   assert(a);
 792   assert(b);
 793   assert((a->mode == b->mode) && mode_is_int(a->mode));
 794
 795   sc_and(a->value, b->value);
 796   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 797 }
 798 tarval *tarval_or (tarval *a, tarval *b)   /* bitwise or */
 799 {
 800   ANNOUNCE();
 801   assert(a);
 802   assert(b);
 803   assert((a->mode == b->mode) && mode_is_int(a->mode));
 804
 805   sc_or(a->value, b->value);
 806   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 807 }
 808 tarval *tarval_eor(tarval *a, tarval *b)   /* bitwise exclusive or (xor) */
 809 {
 810   ANNOUNCE();
 811   assert(a);
 812   assert(b);
 813   assert((a->mode == b->mode) && mode_is_int(a->mode));
 814
 815   sc_or(a->value, b->value);
 816   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 817 }
 818
 819 tarval *tarval_shl(tarval *a, tarval *b)   /* bitwise left shift */
 820 {
 821   ANNOUNCE();
 822   assert(a);
 823   assert(b);
 824   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 825
 826   sc_shl(a->value, b->value, get_mode_size(a->mode), mode_is_signed(a->mode));
 827   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 828 }
 829 tarval *tarval_shr(tarval *a, tarval *b)   /* bitwise unsigned right shift */
 830 {
 831   ANNOUNCE();
 832   assert(a);
 833   assert(b);
 834   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 835
 836   sc_shr(a->value, b->value, get_mode_size(a->mode), mode_is_signed(a->mode));
 837   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 838 }
 839 tarval *tarval_shrs(tarval *a, tarval *b)  /* bitwise signed right shift */
 840 {
 841   ANNOUNCE();
 842   assert(a);
 843   assert(b);
 844   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 845
 846   sc_shrs(a->value, b->value, get_mode_size(a->mode), mode_is_signed(a->mode));
 847   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 848 }
 849 tarval *tarval_rot(tarval *a, tarval *b)   /* bitwise rotation */
 850 {
 851   ANNOUNCE();
 852   assert(a);
 853   assert(b);
 854   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 855
 856   sc_rot(a->value, b->value, get_mode_size(a->mode), mode_is_signed(a->mode));
 857   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 858 }
 859
 860 /** *********** Output of tarvals *********** **/
 861 int tarval_print(XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
 862 {
 863   ANNOUNCE();
 864   tarval *tv;
 865   char *str;
 866   int offset;
 867
 868   tv = XP_GETARG(tarval *, 0);
 869   switch (get_mode_sort(tv->mode))
 870   {
 871     case int_number:
 872     case character:
 873       offset = 16 - (get_mode_size(tv->mode)/4);
 874       str = sc_print_hex(tv->value);
 875       return XPF1R("0x%s", str + offset);
 876
 877     case float_number:
 878       return XPF1R("%s", fc_print_dec(tv->value));
 879
 880     case reference:
 881       if (tv->value != NULL)
 882         if (tarval_is_entity(tv))
 883           if (get_entity_peculiarity((entity *)tv->value) == existent)
 884             return XPF1R("&(%I)", get_entity_ld_ident((entity *)tv->value));
 885           else
 886             return XPSR("NULL");
 887         else
 888           return XPMR((char*)tv->value, tv->length);
 889       else
 890         return XPSR("void");
 891
 892     case internal_boolean:
 893       if (tv == tarval_b_true) return XPSR("true");
 894       else return XPSR("false");
 895
 896     case auxiliary:
 897       return XPSR("<BAD>");
 898   }
 899
 900   return 0;
 901 }
 902
 903 char *tarval_bitpattern(tarval *tv)
 904 {
 905   return NULL;
 906 }
 907
 908 /* Identifying some tarvals ??? */
 909 /* Implemented in old tv.c as such:
 910  *   return 0 for additive neutral,
 911  *   1 for multiplicative neutral,
 912  *   -1 for bitwise-and neutral
 913  *   2 else
 914  *
 915  * Implemented for completeness */
 916 long tarval_classify(tarval *tv)
 917 {
 918   ANNOUNCE();
 919   if (!tv || tv == tarval_bad) return 2;
 920
 921   if (tv == get_mode_null(tv->mode)) return 0;
 922   else if (tv == get_mode_one(tv->mode)) return 1;
 923   else if ((get_mode_sort(tv->mode) == int_number)
 924            && (tv == new_tarval_from_long(-1, tv->mode))) return -1;
 925
 926   return 2;
 927 }
 928
 929 /** Initialization of the tarval module **/
 930 void init_tarval_1(void)
 931 {
 932   ANNOUNCE();
 933   /* initialize the sets holding the tarvals with a comparison function and
 934    * an initial size, which is the expected number of constants */
 935   tarvals = new_set(memcmp, TUNE_NCONSTANTS);
 936   values = new_set(memcmp, TUNE_NCONSTANTS);
 937 }
 938
 939 void init_tarval_2(void)
 940 {
 941   ANNOUNCE();
 942
 943   tarval_bad = (tarval*)malloc(sizeof(tarval));
 944   tarval_bad->mode = NULL;
 945
 946   tarval_undefined = (tarval*)malloc(sizeof(tarval));
 947   tarval_undefined->mode = NULL;
 948
 949   tarval_b_true = (tarval*)malloc(sizeof(tarval));
 950   tarval_b_true->mode = mode_b;
 951
 952   tarval_b_false = (tarval*)malloc(sizeof(tarval));
 953   tarval_b_false->mode = mode_b;
 954
 955   tarval_P_void = (tarval*)malloc(sizeof(tarval));
 956   tarval_P_void->mode = mode_P;
 957 }
 958
 959 /****************************************************************************
 960  *   end of tv.c
 961  ****************************************************************************/
 962
 963 void
 964 free_tarval_entity(entity *ent) {
 965   /* There can be a tarval referencing this entity.  Even if the
 966      tarval is not used by the code any more, it can still reference
 967      the entity as tarvals live forever (They live on an obstack.).
 968      Further the tarval is hashed into a set.  If a hash function
 969      evaluation happens to collide with this tarval, we will vrfy that
 970      it contains a proper entity and we will crash if the entity is
 971      freed.  We cannot remove tarvals from the obstack but we can
 972      remove the entry in the hash table. */
 973   /* this will be re-implemented later */
 974   ANNOUNCE();
 975 }