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
 511   if (get_mode_sort(mode) == float_number) {
 512     fc_get_nan();
 513     return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 514   }
 515   else {
 516     assert(0 && "tarval is not floating point");
 517     return tarval_bad;
 518   }
 519 }
 520
 521 tarval *get_tarval_inf(ir_mode *mode)
 522 {
 523   ANNOUNCE();
 524   assert(mode);
 525
 526   if (get_mode_sort(mode) == float_number) {
 527     fc_get_inf();
 528     return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 529   }
 530   else {
 531     assert(0 && "tarval is not floating point");
 532     return tarval_bad;
 533   }
 534 }
 535
 536 /*
 537  * Arithmethic operations on tarvals ========================================
 538  */
 539
 540 /* test if negative number, 1 means 'yes' */
 541 int tarval_is_negative(tarval *a)
 542 {
 543   ANNOUNCE();
 544   assert(a);
 545
 546   switch (get_mode_sort(a->mode))
 547   {
 548     case int_number:
 549       if (!mode_is_signed(a->mode)) return 0;
 550       else
 551         return sc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0;
 552
 553     case float_number:
 554       return fc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0;
 555
 556     default:
 557       assert(0 && "not implemented");
 558       return 0;
 559   }
 560 }
 561
 562 /* comparison */
 563 pnc_number tarval_cmp(tarval *a, tarval *b)
 564 {
 565   ANNOUNCE();
 566   assert(a);
 567   assert(b);
 568
 569   if (a == tarval_bad || b == tarval_bad) assert(0 && "Comparison with tarval_bad");
 570   if (a == tarval_undefined || b == tarval_undefined) return False;
 571   if (a == b) return Eq;
 572   if (get_tarval_mode(a) != get_tarval_mode(b)) return Uo;
 573
 574   /* Here the two tarvals are unequal and of the same mode */
 575   switch (get_mode_sort(a->mode))
 576   {
 577     case auxiliary:
 578       return False;
 579
 580     case float_number:
 581       return (fc_comp(a->value, b->value)==1)?(Gt):(Lt);
 582
 583     case int_number:
 584     case character:
 585       return (sc_comp(a->value, b->value)==1)?(Gt):(Lt);
 586
 587     case internal_boolean:
 588       return (a == tarval_b_true)?(Gt):(Lt);
 589
 590     case reference:
 591       return Uo;
 592   }
 593   return False;
 594 }
 595
 596 tarval *tarval_convert_to(tarval *src, ir_mode *m)
 597 {
 598   ANNOUNCE();
 599   tarval tv;
 600
 601   assert(src);
 602   assert(m);
 603
 604   if (src->mode == m) return src;
 605
 606   switch (get_mode_sort(src->mode))
 607   {
 608     case auxiliary:
 609       break;
 610
 611     case float_number:
 612       break;
 613
 614     case int_number:
 615       switch (get_mode_sort(m))
 616       {
 617         case int_number:
 618         case character:
 619           tv.mode = m;
 620           tv.length = src->length;
 621           tv.value = src->value;
 622           if (overflows(&tv))
 623           {
 624             return tarval_bad;
 625           }
 626           return INSERT_TARVAL(&tv);
 627
 628         case internal_boolean:
 629           /* XXX C semantics */
 630           if (src == get_mode_null(src->mode)) return tarval_b_false;
 631           else return tarval_b_true;
 632
 633         default:
 634           break;
 635       }
 636       break;
 637
 638     case internal_boolean:
 639       switch (get_mode_sort(m))
 640       {
 641         case int_number:
 642           if (src == tarval_b_true) return get_mode_one(m);
 643           else return get_mode_null(m);
 644
 645         default:
 646           break;
 647       }
 648       break;
 649
 650     case character:
 651       break;
 652     case reference:
 653       break;
 654   }
 655
 656   return tarval_bad;
 657 }
 658
 659 tarval *tarval_neg(tarval *a)              /* negation */
 660 {
 661   ANNOUNCE();
 662   assert(a);
 663   assert(mode_is_num(a->mode)); /* negation only for numerical values */
 664   assert(mode_is_signed(a->mode)); /* negation is difficult without negative numbers, isn't it */
 665
 666 printf("NEG\n");
 667   switch (get_mode_sort(a->mode))
 668   {
 669     case int_number:
 670       sc_neg(a->value);
 671       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 672
 673     case float_number:
 674 printf("FP NEG\n");
 675       fc_neg(a->value);
 676       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 677
 678     default:
 679       return tarval_bad;
 680   }
 681 }
 682
 683 tarval *tarval_add(tarval *a, tarval *b)   /* addition */
 684 {
 685   ANNOUNCE();
 686   assert(a);
 687   assert(b);
 688   assert((a->mode == b->mode) || (get_mode_sort(a->mode) == character && mode_is_int(b->mode)));
 689
 690   switch (get_mode_sort(a->mode))
 691   {
 692     case character:
 693     case int_number:
 694       /* modes of a,b are equal, so result has mode of a as this might be the character */
 695       sc_add(a->value, b->value);
 696       /* FIXME: Check for overflow */
 697       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 698
 699     case float_number:
 700       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 701       fc_add(a->value, b->value);
 702       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 703
 704     default:
 705       return tarval_bad;
 706   }
 707 }
 708
 709 tarval *tarval_sub(tarval *a, tarval *b)   /* subtraction */
 710 {
 711   ANNOUNCE();
 712   assert(a);
 713   assert(b);
 714   assert((a->mode == b->mode) || (get_mode_sort(a->mode) == character && mode_is_int(b->mode)));
 715
 716   switch (get_mode_sort(a->mode))
 717   {
 718     case character:
 719     case int_number:
 720       /* modes of a,b are equal, so result has mode of a as this might be the character */
 721       sc_sub(a->value, b->value);
 722       /* FIXME: check for overflow */
 723       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 724
 725     case float_number:
 726       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 727       fc_add(a->value, b->value);
 728       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 729
 730     default:
 731       return tarval_bad;
 732   }
 733 }
 734
 735 tarval *tarval_mul(tarval *a, tarval *b)   /* multiplication */
 736 {
 737   ANNOUNCE();
 738   assert(a);
 739   assert(b);
 740   assert((a->mode == b->mode) && mode_is_num(a->mode));
 741
 742   switch (get_mode_sort(a->mode))
 743   {
 744     case int_number:
 745       /* modes of a,b are equal */
 746       sc_mul(a->value, b->value);
 747       /* FIXME: check for overflow */
 748       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 749
 750     case float_number:
 751       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 752       fc_add(a->value, b->value);
 753       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 754
 755     default:
 756       return tarval_bad;
 757   }
 758 }
 759
 760 tarval *tarval_quo(tarval *a, tarval *b)   /* floating point division */
 761 {
 762   ANNOUNCE();
 763   assert(a);
 764   assert(b);
 765   assert((a->mode == b->mode) && mode_is_float(a->mode));
 766
 767   /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 768   fc_div(a->value, b->value);
 769   return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 770 }
 771
 772 tarval *tarval_div(tarval *a, tarval *b)   /* integer division */
 773 {
 774   ANNOUNCE();
 775   assert(a);
 776   assert(b);
 777   assert((a->mode == b->mode) && mode_is_int(a->mode));
 778
 779   /* modes of a,b are equal */
 780   sc_div(a->value, b->value);
 781   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 782 }
 783
 784 tarval *tarval_mod(tarval *a, tarval *b)   /* remainder */
 785 {
 786   ANNOUNCE();
 787   assert(a);
 788   assert(b);
 789   assert((a->mode == b->mode) && mode_is_int(a->mode));
 790
 791   /* modes of a,b are equal */
 792   sc_mod(a->value, b->value);
 793   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 794 }
 795
 796 tarval *tarval_abs(tarval *a)              /* absolute value */
 797 {
 798   ANNOUNCE();
 799   assert(a);
 800   assert(mode_is_num(a->mode));
 801
 802   switch (get_mode_sort(a->mode))
 803   {
 804     case int_number:
 805       if (sc_comp(a->value, get_mode_null(a->mode)->value) == -1)
 806       {
 807         sc_neg(a->value);
 808         return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 809       }
 810       return a;
 811
 812     case float_number:
 813       break;
 814
 815     default:
 816       return tarval_bad;
 817   }
 818   return tarval_bad;
 819 }
 820
 821 tarval *tarval_and(tarval *a, tarval *b)   /* bitwise and */
 822 {
 823   ANNOUNCE();
 824   assert(a);
 825   assert(b);
 826   assert((a->mode == b->mode) && mode_is_int(a->mode));
 827
 828   sc_and(a->value, b->value);
 829   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 830 }
 831 tarval *tarval_or (tarval *a, tarval *b)   /* bitwise or */
 832 {
 833   ANNOUNCE();
 834   assert(a);
 835   assert(b);
 836   assert((a->mode == b->mode) && mode_is_int(a->mode));
 837
 838   sc_or(a->value, b->value);
 839   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 840 }
 841 tarval *tarval_eor(tarval *a, tarval *b)   /* bitwise exclusive or (xor) */
 842 {
 843   ANNOUNCE();
 844   assert(a);
 845   assert(b);
 846   assert((a->mode == b->mode) && mode_is_int(a->mode));
 847
 848   sc_or(a->value, b->value);
 849   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 850 }
 851
 852 tarval *tarval_shl(tarval *a, tarval *b)   /* bitwise left shift */
 853 {
 854   ANNOUNCE();
 855   assert(a);
 856   assert(b);
 857   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 858
 859   sc_shl(a->value, b->value, get_mode_size_bits(a->mode), mode_is_signed(a->mode));
 860   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 861 }
 862 tarval *tarval_shr(tarval *a, tarval *b)   /* bitwise unsigned right shift */
 863 {
 864   ANNOUNCE();
 865   assert(a);
 866   assert(b);
 867   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 868
 869   sc_shr(a->value, b->value, get_mode_size_bits(a->mode), mode_is_signed(a->mode));
 870   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 871 }
 872 tarval *tarval_shrs(tarval *a, tarval *b)  /* bitwise signed right shift */
 873 {
 874   ANNOUNCE();
 875   assert(a);
 876   assert(b);
 877   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 878
 879   sc_shrs(a->value, b->value, get_mode_size_bits(a->mode), mode_is_signed(a->mode));
 880   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 881 }
 882 tarval *tarval_rot(tarval *a, tarval *b)   /* bitwise rotation */
 883 {
 884   ANNOUNCE();
 885   assert(a);
 886   assert(b);
 887   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 888
 889   sc_rot(a->value, b->value, get_mode_size_bits(a->mode), mode_is_signed(a->mode));
 890   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 891 }
 892
 893 /** *********** Output of tarvals *********** **/
 894 int tarval_print(XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
 895 {
 896   ANNOUNCE();
 897   tarval *tv;
 898   const char *str;
 899   int offset;
 900   char buf[100];
 901
 902   tv = XP_GETARG(tarval *, 0);
 903   switch (get_mode_sort(tv->mode))
 904   {
 905     case int_number:
 906     case character:
 907       offset = 16 - (get_mode_size_bits(tv->mode)/4);
 908       str = sc_print_hex(tv->value);
 909       return XPF1R("0x%s", str + offset);
 910
 911     case float_number:
 912       return XPF1R("%s", fc_print_dec(tv->value, buf, sizeof(buf)));
 913
 914     case reference:
 915       if (tv->value != NULL)
 916         if (tarval_is_entity(tv))
 917           if (get_entity_peculiarity((entity *)tv->value) == existent)
 918             return XPF1R("&(%I)", get_entity_ld_ident((entity *)tv->value));
 919           else
 920             return XPSR("NULL");
 921         else
 922           return XPMR((char*)tv->value, tv->length);
 923       else
 924         return XPSR("void");
 925
 926     case internal_boolean:
 927       if (tv == tarval_b_true) return XPSR("true");
 928       else return XPSR("false");
 929
 930     case auxiliary:
 931       return XPSR("<BAD>");
 932   }
 933
 934   return 0;
 935 }
 936
 937 char *tarval_bitpattern(tarval *tv)
 938 {
 939   return NULL;
 940 }
 941
 942 /*
 943  * access to the bitpattern
 944  */
 945 unsigned char tarval_sub_bits(tarval *tv, unsigned byte_ofs)
 946 {
 947   switch (get_mode_sort(tv->mode)) {
 948     case int_number:
 949     case character:
 950       return sc_sub_bits(tv->value, tv->length, byte_ofs);
 951
 952     case float_number:
 953       return fc_sub_bits(tv->value, get_mode_size_bits(tv->mode), byte_ofs);
 954
 955     default:
 956       return 0;
 957   }
 958 }
 959
 960 /* Identifying some tarvals ??? */
 961 /* Implemented in old tv.c as such:
 962  *   return 0 for additive neutral,
 963  *   1 for multiplicative neutral,
 964  *   -1 for bitwise-and neutral
 965  *   2 else
 966  *
 967  * Implemented for completeness */
 968 long tarval_classify(tarval *tv)
 969 {
 970   ANNOUNCE();
 971   if (!tv || tv == tarval_bad) return 2;
 972
 973   if (tv == get_mode_null(tv->mode)) return 0;
 974   else if (tv == get_mode_one(tv->mode)) return 1;
 975   else if ((get_mode_sort(tv->mode) == int_number)
 976            && (tv == new_tarval_from_long(-1, tv->mode))) return -1;
 977
 978   return 2;
 979 }
 980
 981 /* Initialization of the tarval module: called before init_mode() */
 982 void init_tarval_1(void)
 983 {
 984   ANNOUNCE();
 985   /* initialize the sets holding the tarvals with a comparison function and
 986    * an initial size, which is the expected number of constants */
 987   tarvals = new_set(memcmp, TUNE_NCONSTANTS);
 988   values = new_set(memcmp, TUNE_NCONSTANTS);
 989 }
 990
 991 /* Initialization of the tarval module: called after init_mode() */
 992 void init_tarval_2(void)
 993 {
 994   ANNOUNCE();
 995
 996   tarval_bad = (tarval*)malloc(sizeof(tarval));
 997   tarval_bad->mode = NULL;
 998
 999   tarval_undefined = (tarval*)malloc(sizeof(tarval));
1000   tarval_undefined->mode = NULL;
1001
1002   tarval_b_true = (tarval*)malloc(sizeof(tarval));
1003   tarval_b_true->mode = mode_b;
1004
1005   tarval_b_false = (tarval*)malloc(sizeof(tarval));
1006   tarval_b_false->mode = mode_b;
1007
1008   tarval_P_void = (tarval*)malloc(sizeof(tarval));
1009   tarval_P_void->mode = mode_P;
1010 }
1011
1012 /****************************************************************************
1013  *   end of tv.c
1014  ****************************************************************************/
1015
1016 void
1017 free_tarval_entity(entity *ent) {
1018   /* There can be a tarval referencing this entity.  Even if the
1019      tarval is not used by the code any more, it can still reference
1020      the entity as tarvals live forever (They live on an obstack.).
1021      Further the tarval is hashed into a set.  If a hash function
1022      evaluation happens to collide with this tarval, we will vrfy that
1023      it contains a proper entity and we will crash if the entity is
1024      freed.  We cannot remove tarvals from the obstack but we can
1025      remove the entry in the hash table. */
1026   /* this will be re-implemented later */
1027   ANNOUNCE();
1028 }