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