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