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 void free_tarval_entity(entity *ent) {
 352   /* There can be a tarval referencing this entity.  Even if the
 353      tarval is not used by the code any more, it can still reference
 354      the entity as tarvals live indepently of the entity referenced.
 355      Further the tarval is hashed into a set. If a hash function
 356      evaluation happens to collide with this tarval, we will vrfy that
 357      it contains a proper entity and we will crash if the entity is
 358      freed.
 359
 360      Unluckily, tarvals can neither be changed nor deleted, and to find
 361      one, all existing reference modes have to be tried -> a facility
 362      to retrieve all modes of a kind is needed. */
 363   ANNOUNCE();
 364 }
 365
 366 /*
 367  * Access routines for tarval fields ========================================
 368  */
 369 ir_mode *get_tarval_mode (tarval *tv)       /* get the mode of the tarval */
 370 {
 371   ANNOUNCE();
 372   assert(tv);
 373   return tv->mode;
 374 }
 375
 376 /*
 377  * Special value query functions ============================================
 378  *
 379  * These functions calculate and return a tarval representing the requested
 380  * value.
 381  * The functions get_mode_{Max,Min,...} return tarvals retrieved from these
 382  * functions, but these are stored on initialization of the irmode module and
 383  * therefore the irmode functions should be prefered to the functions below.
 384  */
 385
 386 tarval *get_tarval_bad(void)
 387 {
 388   ANNOUNCE();
 389   return tarval_bad;
 390 }
 391 tarval *get_tarval_undefined(void)
 392 {
 393   ANNOUNCE();
 394   return tarval_undefined;
 395 }
 396 tarval *get_tarval_b_false(void)
 397 {
 398   ANNOUNCE();
 399   return tarval_b_false;
 400 }
 401 tarval *get_tarval_b_true(void)
 402 {
 403   ANNOUNCE();
 404   return tarval_b_true;
 405 }
 406 tarval *get_tarval_P_void(void)
 407 {
 408   ANNOUNCE();
 409   return tarval_P_void;
 410 }
 411
 412 tarval *get_tarval_max(ir_mode *mode)
 413 {
 414   ANNOUNCE();
 415   assert(mode);
 416
 417   switch(get_mode_sort(mode))
 418   {
 419     case reference:
 420     case auxiliary:
 421       assert(0);
 422       break;
 423
 424     case internal_boolean:
 425       return tarval_b_true;
 426
 427     case float_number:
 428       fc_get_max(get_mode_size_bits(mode));
 429       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 430
 431     case int_number:
 432     case character:
 433       sc_max_from_bits(get_mode_size_bits(mode), mode_is_signed(mode));
 434       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);
 435   }
 436   return tarval_bad;
 437 }
 438
 439 tarval *get_tarval_min(ir_mode *mode)
 440 {
 441   ANNOUNCE();
 442   assert(mode);
 443
 444   switch(get_mode_sort(mode))
 445   {
 446     case reference:
 447     case auxiliary:
 448       assert(0);
 449       break;
 450
 451     case internal_boolean:
 452       return tarval_b_false;
 453
 454     case float_number:
 455       fc_get_min(get_mode_size_bits(mode));
 456       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 457
 458     case int_number:
 459     case character:
 460       sc_min_from_bits(get_mode_size_bits(mode), mode_is_signed(mode));
 461       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), mode);
 462   }
 463   return tarval_bad;
 464 }
 465
 466 tarval *get_tarval_null(ir_mode *mode)
 467 {
 468   ANNOUNCE();
 469   assert(mode);
 470
 471   switch(get_mode_sort(mode))
 472   {
 473     case auxiliary:
 474     case internal_boolean:
 475       assert(0);
 476       break;
 477
 478     case float_number:
 479       return new_tarval_from_double(0.0, mode);
 480
 481     case int_number:
 482     case character:
 483       return new_tarval_from_long(0l,  mode);
 484
 485     case reference:
 486       return tarval_P_void;
 487   }
 488   return tarval_bad;
 489 }
 490
 491 tarval *get_tarval_one(ir_mode *mode)
 492 {
 493   ANNOUNCE();
 494   assert(mode);
 495
 496   switch(get_mode_sort(mode))
 497   {
 498     case auxiliary:
 499     case internal_boolean:
 500     case reference:
 501       assert(0);
 502       break;
 503
 504     case float_number:
 505       return new_tarval_from_double(1.0, mode);
 506
 507     case int_number:
 508     case character:
 509       return new_tarval_from_long(1l, mode);
 510       break;
 511   }
 512   return tarval_bad;
 513 }
 514
 515 tarval *get_tarval_nan(ir_mode *mode)
 516 {
 517   ANNOUNCE();
 518   assert(mode);
 519
 520   if (get_mode_sort(mode) == float_number) {
 521     fc_get_nan();
 522     return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 523   }
 524   else {
 525     assert(0 && "tarval is not floating point");
 526     return tarval_bad;
 527   }
 528 }
 529
 530 tarval *get_tarval_inf(ir_mode *mode)
 531 {
 532   ANNOUNCE();
 533   assert(mode);
 534
 535   if (get_mode_sort(mode) == float_number) {
 536     fc_get_inf();
 537     return get_tarval(fc_get_buffer(), fc_get_buffer_length(), mode);
 538   }
 539   else {
 540     assert(0 && "tarval is not floating point");
 541     return tarval_bad;
 542   }
 543 }
 544
 545 /*
 546  * Arithmethic operations on tarvals ========================================
 547  */
 548
 549 /* test if negative number, 1 means 'yes' */
 550 int tarval_is_negative(tarval *a)
 551 {
 552   ANNOUNCE();
 553   assert(a);
 554
 555   switch (get_mode_sort(a->mode))
 556   {
 557     case int_number:
 558       if (!mode_is_signed(a->mode)) return 0;
 559       else
 560         return sc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0;
 561
 562     case float_number:
 563       return fc_comp(a->value, get_mode_null(a->mode)->value) == -1 ? 1 : 0;
 564
 565     default:
 566       assert(0 && "not implemented");
 567       return 0;
 568   }
 569 }
 570
 571 /* comparison */
 572 pnc_number tarval_cmp(tarval *a, tarval *b)
 573 {
 574   ANNOUNCE();
 575   assert(a);
 576   assert(b);
 577
 578   if (a == tarval_bad || b == tarval_bad) assert(0 && "Comparison with tarval_bad");
 579   if (a == tarval_undefined || b == tarval_undefined) return False;
 580   if (a == b) return Eq;
 581   if (get_tarval_mode(a) != get_tarval_mode(b)) return Uo;
 582
 583   /* Here the two tarvals are unequal and of the same mode */
 584   switch (get_mode_sort(a->mode))
 585   {
 586     case auxiliary:
 587       return False;
 588
 589     case float_number:
 590       return (fc_comp(a->value, b->value)==1)?(Gt):(Lt);
 591
 592     case int_number:
 593     case character:
 594       return (sc_comp(a->value, b->value)==1)?(Gt):(Lt);
 595
 596     case internal_boolean:
 597       return (a == tarval_b_true)?(Gt):(Lt);
 598
 599     case reference:
 600       return Uo;
 601   }
 602   return False;
 603 }
 604
 605 tarval *tarval_convert_to(tarval *src, ir_mode *m)
 606 {
 607   ANNOUNCE();
 608   tarval tv;
 609
 610   assert(src);
 611   assert(m);
 612
 613   if (src->mode == m) return src;
 614
 615   switch (get_mode_sort(src->mode))
 616   {
 617     case auxiliary:
 618       break;
 619
 620     case float_number:
 621       break;
 622
 623     case int_number:
 624       switch (get_mode_sort(m))
 625       {
 626         case int_number:
 627         case character:
 628           tv.mode = m;
 629           tv.length = src->length;
 630           tv.value = src->value;
 631           if (overflows(&tv))
 632           {
 633             return tarval_bad;
 634           }
 635           return INSERT_TARVAL(&tv);
 636
 637         case internal_boolean:
 638           /* XXX C semantics */
 639           if (src == get_mode_null(src->mode)) return tarval_b_false;
 640           else return tarval_b_true;
 641
 642         default:
 643           break;
 644       }
 645       break;
 646
 647     case internal_boolean:
 648       switch (get_mode_sort(m))
 649       {
 650         case int_number:
 651           if (src == tarval_b_true) return get_mode_one(m);
 652           else return get_mode_null(m);
 653
 654         default:
 655           break;
 656       }
 657       break;
 658
 659     case character:
 660       break;
 661     case reference:
 662       break;
 663   }
 664
 665   return tarval_bad;
 666 }
 667
 668 tarval *tarval_neg(tarval *a)              /* negation */
 669 {
 670   ANNOUNCE();
 671   assert(a);
 672   assert(mode_is_num(a->mode)); /* negation only for numerical values */
 673   assert(mode_is_signed(a->mode)); /* negation is difficult without negative numbers, isn't it */
 674
 675   switch (get_mode_sort(a->mode))
 676   {
 677     case int_number:
 678       sc_neg(a->value);
 679       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 680
 681     case float_number:
 682       fc_neg(a->value);
 683       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 684
 685     default:
 686       return tarval_bad;
 687   }
 688 }
 689
 690 tarval *tarval_add(tarval *a, tarval *b)   /* addition */
 691 {
 692   ANNOUNCE();
 693   assert(a);
 694   assert(b);
 695   assert((a->mode == b->mode) || (get_mode_sort(a->mode) == character && mode_is_int(b->mode)));
 696
 697   switch (get_mode_sort(a->mode))
 698   {
 699     case character:
 700     case int_number:
 701       /* modes of a,b are equal, so result has mode of a as this might be the character */
 702       sc_add(a->value, b->value);
 703       /* FIXME: Check for overflow */
 704       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 705
 706     case float_number:
 707       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 708       fc_add(a->value, b->value);
 709       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 710
 711     default:
 712       return tarval_bad;
 713   }
 714 }
 715
 716 tarval *tarval_sub(tarval *a, tarval *b)   /* subtraction */
 717 {
 718   ANNOUNCE();
 719   assert(a);
 720   assert(b);
 721   assert((a->mode == b->mode) || (get_mode_sort(a->mode) == character && mode_is_int(b->mode)));
 722
 723   switch (get_mode_sort(a->mode))
 724   {
 725     case character:
 726     case int_number:
 727       /* modes of a,b are equal, so result has mode of a as this might be the character */
 728       sc_sub(a->value, b->value);
 729       /* FIXME: check for overflow */
 730       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 731
 732     case float_number:
 733       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 734       fc_add(a->value, b->value);
 735       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 736
 737     default:
 738       return tarval_bad;
 739   }
 740 }
 741
 742 tarval *tarval_mul(tarval *a, tarval *b)   /* multiplication */
 743 {
 744   ANNOUNCE();
 745   assert(a);
 746   assert(b);
 747   assert((a->mode == b->mode) && mode_is_num(a->mode));
 748
 749   switch (get_mode_sort(a->mode))
 750   {
 751     case int_number:
 752       /* modes of a,b are equal */
 753       sc_mul(a->value, b->value);
 754       /* FIXME: check for overflow */
 755       return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 756
 757     case float_number:
 758       /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 759       fc_add(a->value, b->value);
 760       return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 761
 762     default:
 763       return tarval_bad;
 764   }
 765 }
 766
 767 tarval *tarval_quo(tarval *a, tarval *b)   /* floating point division */
 768 {
 769   ANNOUNCE();
 770   assert(a);
 771   assert(b);
 772   assert((a->mode == b->mode) && mode_is_float(a->mode));
 773
 774   /* FIXME: Overflow/Underflow/transition to inf when mode < 80bit */
 775   fc_div(a->value, b->value);
 776   return get_tarval(fc_get_buffer(), fc_get_buffer_length(), a->mode);
 777 }
 778
 779 tarval *tarval_div(tarval *a, tarval *b)   /* integer division */
 780 {
 781   ANNOUNCE();
 782   assert(a);
 783   assert(b);
 784   assert((a->mode == b->mode) && mode_is_int(a->mode));
 785
 786   /* modes of a,b are equal */
 787   sc_div(a->value, b->value);
 788   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 789 }
 790
 791 tarval *tarval_mod(tarval *a, tarval *b)   /* remainder */
 792 {
 793   ANNOUNCE();
 794   assert(a);
 795   assert(b);
 796   assert((a->mode == b->mode) && mode_is_int(a->mode));
 797
 798   /* modes of a,b are equal */
 799   sc_mod(a->value, b->value);
 800   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 801 }
 802
 803 tarval *tarval_abs(tarval *a)              /* absolute value */
 804 {
 805   ANNOUNCE();
 806   assert(a);
 807   assert(mode_is_num(a->mode));
 808
 809   switch (get_mode_sort(a->mode))
 810   {
 811     case int_number:
 812       if (sc_comp(a->value, get_mode_null(a->mode)->value) == -1)
 813       {
 814         sc_neg(a->value);
 815         return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 816       }
 817       return a;
 818
 819     case float_number:
 820       break;
 821
 822     default:
 823       return tarval_bad;
 824   }
 825   return tarval_bad;
 826 }
 827
 828 tarval *tarval_and(tarval *a, tarval *b)   /* bitwise and */
 829 {
 830   ANNOUNCE();
 831   assert(a);
 832   assert(b);
 833   assert((a->mode == b->mode) && mode_is_int(a->mode));
 834
 835   sc_and(a->value, b->value);
 836   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 837 }
 838 tarval *tarval_or (tarval *a, tarval *b)   /* bitwise or */
 839 {
 840   ANNOUNCE();
 841   assert(a);
 842   assert(b);
 843   assert((a->mode == b->mode) && mode_is_int(a->mode));
 844
 845   sc_or(a->value, b->value);
 846   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 847 }
 848 tarval *tarval_eor(tarval *a, tarval *b)   /* bitwise exclusive or (xor) */
 849 {
 850   ANNOUNCE();
 851   assert(a);
 852   assert(b);
 853   assert((a->mode == b->mode) && mode_is_int(a->mode));
 854
 855   sc_or(a->value, b->value);
 856   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 857 }
 858
 859 tarval *tarval_shl(tarval *a, tarval *b)   /* bitwise left 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_shl(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_shr(tarval *a, tarval *b)   /* bitwise unsigned right shift */
 870 {
 871   ANNOUNCE();
 872   assert(a);
 873   assert(b);
 874   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 875
 876   sc_shr(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 tarval *tarval_shrs(tarval *a, tarval *b)  /* bitwise signed right shift */
 880 {
 881   ANNOUNCE();
 882   assert(a);
 883   assert(b);
 884   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 885
 886   sc_shrs(a->value, b->value, get_mode_size_bits(a->mode), mode_is_signed(a->mode));
 887   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 888 }
 889 tarval *tarval_rot(tarval *a, tarval *b)   /* bitwise rotation */
 890 {
 891   ANNOUNCE();
 892   assert(a);
 893   assert(b);
 894   assert(mode_is_int(a->mode) && mode_is_int(b->mode));
 895
 896   sc_rot(a->value, b->value, get_mode_size_bits(a->mode), mode_is_signed(a->mode));
 897   return get_tarval(sc_get_buffer(), sc_get_buffer_length(), a->mode);
 898 }
 899
 900 /** *********** Output of tarvals *********** **/
 901 int tarval_print(XP_PAR1, const xprintf_info *info ATTRIBUTE((unused)), XP_PARN)
 902 {
 903   ANNOUNCE();
 904   tarval *tv;
 905   const char *str;
 906   char buf[100];
 907
 908   tv = XP_GETARG(tarval *, 0);
 909   switch (get_mode_sort(tv->mode))
 910   {
 911     case int_number:
 912     case character:
 913       str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_DEC);
 914       return XPF1R("%s", str);
 915
 916     case float_number:
 917       return XPF1R("%s", fc_print_dec(tv->value, buf, sizeof(buf)));
 918
 919     case reference:
 920       if (tv->value != NULL)
 921         if (tarval_is_entity(tv))
 922           if (get_entity_peculiarity((entity *)tv->value) == existent)
 923             return XPF1R("&(%I)", get_entity_ld_ident((entity *)tv->value));
 924           else
 925             return XPSR("NULL");
 926         else
 927           return XPMR((char*)tv->value, tv->length);
 928       else
 929         return XPSR("void");
 930
 931     case internal_boolean:
 932       if (tv == tarval_b_true) return XPSR("true");
 933       else return XPSR("false");
 934
 935     case auxiliary:
 936       return XPSR("<BAD>");
 937   }
 938
 939   return 0;
 940 }
 941
 942 char *tarval_bitpattern(tarval *tv)
 943 {
 944   return NULL;
 945 }
 946
 947 /*
 948  * access to the bitpattern
 949  */
 950 unsigned char tarval_sub_bits(tarval *tv, unsigned byte_ofs)
 951 {
 952   switch (get_mode_sort(tv->mode)) {
 953     case int_number:
 954     case character:
 955       return sc_sub_bits(tv->value, tv->length, byte_ofs);
 956
 957     case float_number:
 958       return fc_sub_bits(tv->value, get_mode_size_bits(tv->mode), byte_ofs);
 959
 960     default:
 961       return 0;
 962   }
 963 }
 964
 965 /* Identifying some tarvals ??? */
 966 /* Implemented in old tv.c as such:
 967  *   return 0 for additive neutral,
 968  *   1 for multiplicative neutral,
 969  *   -1 for bitwise-and neutral
 970  *   2 else
 971  *
 972  * Implemented for completeness */
 973 long tarval_classify(tarval *tv)
 974 {
 975   ANNOUNCE();
 976   if (!tv || tv == tarval_bad) return 2;
 977
 978   if (tv == get_mode_null(tv->mode)) return 0;
 979   else if (tv == get_mode_one(tv->mode)) return 1;
 980   else if ((get_mode_sort(tv->mode) == int_number)
 981            && (tv == new_tarval_from_long(-1, tv->mode))) return -1;
 982
 983   return 2;
 984 }
 985
 986 /* Initialization of the tarval module: called before init_mode() */
 987 void init_tarval_1(void)
 988 {
 989   ANNOUNCE();
 990   /* initialize the sets holding the tarvals with a comparison function and
 991    * an initial size, which is the expected number of constants */
 992   tarvals = new_set(memcmp, TUNE_NCONSTANTS);
 993   values = new_set(memcmp, TUNE_NCONSTANTS);
 994   /* init with default precision */
 995   init_strcalc(0);
 996   /* init_fltcalc(0); not yet*/
 997 }
 998
 999 /* Initialization of the tarval module: called after init_mode() */
1000 void init_tarval_2(void)
1001 {
1002   ANNOUNCE();
1003
1004   tarval_bad = (tarval*)malloc(sizeof(tarval));
1005   tarval_bad->mode = NULL;
1006
1007   tarval_undefined = (tarval*)malloc(sizeof(tarval));
1008   tarval_undefined->mode = NULL;
1009
1010   tarval_b_true = (tarval*)malloc(sizeof(tarval));
1011   tarval_b_true->mode = mode_b;
1012
1013   tarval_b_false = (tarval*)malloc(sizeof(tarval));
1014   tarval_b_false->mode = mode_b;
1015
1016   tarval_P_void = (tarval*)malloc(sizeof(tarval));
1017   tarval_P_void->mode = mode_P;
1018 }
1019
1020 /****************************************************************************
1021  *   end of tv.c
1022  ****************************************************************************/