gdb/valarith.c

   1 /* Perform arithmetic and other operations on values, for GDB.
   2    Copyright 1986, 1989, 1991, 1992 Free Software Foundation, Inc.
   3
   4 This file is part of GDB.
   5
   6 This program is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2 of the License, or
   9 (at your option) any later version.
  10
  11 This program is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program; if not, write to the Free Software
  18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20 #include "defs.h"
  21 #include "value.h"
  22 #include "symtab.h"
  23 #include "gdbtypes.h"
  24 #include "expression.h"
  25 #include "target.h"
  26 #include "language.h"
  27 #include <string.h>
  28
  29 /* Define whether or not the C operator '/' truncates towards zero for
  30    differently signed operands (truncation direction is undefined in C). */
  31
  32 #ifndef TRUNCATION_TOWARDS_ZERO
  33 #define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
  34 #endif
  35
  36 static value
  37 value_subscripted_rvalue PARAMS ((value, value));
  38
  39 \f
  40 value
  41 value_add (arg1, arg2)
  42         value arg1, arg2;
  43 {
  44   register value valint, valptr;
  45   register int len;
  46
  47   COERCE_ARRAY (arg1);
  48   COERCE_ARRAY (arg2);
  49
  50   if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR
  51        || TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR)
  52       &&
  53       (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_INT
  54        || TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_INT))
  55     /* Exactly one argument is a pointer, and one is an integer.  */
  56     {
  57       if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR)
  58         {
  59           valptr = arg1;
  60           valint = arg2;
  61         }
  62       else
  63         {
  64           valptr = arg2;
  65           valint = arg1;
  66         }
  67       len = TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (valptr)));
  68       if (len == 0) len = 1;    /* For (void *) */
  69       return value_from_longest (VALUE_TYPE (valptr),
  70                               value_as_long (valptr)
  71                               + (len * value_as_long (valint)));
  72     }
  73
  74   return value_binop (arg1, arg2, BINOP_ADD);
  75 }
  76
  77 value
  78 value_sub (arg1, arg2)
  79         value arg1, arg2;
  80 {
  81
  82   COERCE_ARRAY (arg1);
  83   COERCE_ARRAY (arg2);
  84
  85   if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR)
  86     {
  87       if (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_INT)
  88         {
  89           /* pointer - integer.  */
  90           return value_from_longest
  91             (VALUE_TYPE (arg1),
  92              value_as_long (arg1)
  93              - (TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)))
  94                 * value_as_long (arg2)));
  95         }
  96       else if (VALUE_TYPE (arg1) == VALUE_TYPE (arg2))
  97         {
  98           /* pointer to <type x> - pointer to <type x>.  */
  99           return value_from_longest
 100             (builtin_type_long,         /* FIXME -- should be ptrdiff_t */
 101              (value_as_long (arg1) - value_as_long (arg2))
 102              / TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))));
 103         }
 104       else
 105         {
 106           error ("\
 107 First argument of `-' is a pointer and second argument is neither\n\
 108 an integer nor a pointer of the same type.");
 109         }
 110     }
 111
 112   return value_binop (arg1, arg2, BINOP_SUB);
 113 }
 114
 115 /* Return the value of ARRAY[IDX].
 116    See comments in value_coerce_array() for rationale for reason for
 117    doing lower bounds adjustment here rather than there.
 118    FIXME:  Perhaps we should validate that the index is valid and if
 119    verbosity is set, warn about invalid indices (but still use them). */
 120
 121 value
 122 value_subscript (array, idx)
 123      value array, idx;
 124 {
 125   int lowerbound;
 126   value bound;
 127   struct type *range_type;
 128
 129   if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_ARRAY)
 130     {
 131       range_type = TYPE_FIELD_TYPE (VALUE_TYPE (array), 0);
 132       lowerbound = TYPE_FIELD_BITPOS (range_type, 0);
 133       if (lowerbound != 0)
 134         {
 135           bound = value_from_longest (builtin_type_int, (LONGEST) lowerbound);
 136           idx = value_sub (idx, bound);
 137         }
 138       if (VALUE_LVAL (array) != lval_memory)
 139         {
 140           return value_subscripted_rvalue (array, idx);
 141         }
 142     }
 143   return value_ind (value_add (array, idx));
 144 }
 145
 146 /* Return the value of EXPR[IDX], expr an aggregate rvalue
 147    (eg, a vector register).  This routine used to promote floats
 148    to doubles, but no longer does.  */
 149
 150 static value
 151 value_subscripted_rvalue (array, idx)
 152      value array, idx;
 153 {
 154   struct type *elt_type = TYPE_TARGET_TYPE (VALUE_TYPE (array));
 155   int elt_size = TYPE_LENGTH (elt_type);
 156   int elt_offs = elt_size * longest_to_int (value_as_long (idx));
 157   value v;
 158
 159   if (elt_offs >= TYPE_LENGTH (VALUE_TYPE (array)))
 160     error ("no such vector element");
 161
 162   v = allocate_value (elt_type);
 163   memcpy (VALUE_CONTENTS (v), VALUE_CONTENTS (array) + elt_offs, elt_size);
 164
 165   if (VALUE_LVAL (array) == lval_internalvar)
 166     VALUE_LVAL (v) = lval_internalvar_component;
 167   else
 168     VALUE_LVAL (v) = not_lval;
 169   VALUE_ADDRESS (v) = VALUE_ADDRESS (array);
 170   VALUE_OFFSET (v) = VALUE_OFFSET (array) + elt_offs;
 171   VALUE_BITSIZE (v) = elt_size * 8;
 172   return v;
 173 }
 174 \f
 175 /* Check to see if either argument is a structure.  This is called so
 176    we know whether to go ahead with the normal binop or look for a
 177    user defined function instead.
 178
 179    For now, we do not overload the `=' operator.  */
 180
 181 int
 182 binop_user_defined_p (op, arg1, arg2)
 183      enum exp_opcode op;
 184      value arg1, arg2;
 185 {
 186   if (op == BINOP_ASSIGN)
 187     return 0;
 188   return (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_STRUCT
 189           || TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_STRUCT
 190           || (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_REF
 191               && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_STRUCT)
 192           || (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_REF
 193               && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_STRUCT));
 194 }
 195
 196 /* Check to see if argument is a structure.  This is called so
 197    we know whether to go ahead with the normal unop or look for a
 198    user defined function instead.
 199
 200    For now, we do not overload the `&' operator.  */
 201
 202 int unop_user_defined_p (op, arg1)
 203      enum exp_opcode op;
 204      value arg1;
 205 {
 206   if (op == UNOP_ADDR)
 207     return 0;
 208   return (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_STRUCT
 209           || (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_REF
 210               && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_STRUCT));
 211 }
 212
 213 /* We know either arg1 or arg2 is a structure, so try to find the right
 214    user defined function.  Create an argument vector that calls
 215    arg1.operator @ (arg1,arg2) and return that value (where '@' is any
 216    binary operator which is legal for GNU C++).
 217
 218    OP is the operatore, and if it is BINOP_ASSIGN_MODIFY, then OTHEROP
 219    is the opcode saying how to modify it.  Otherwise, OTHEROP is
 220    unused.  */
 221
 222 value
 223 value_x_binop (arg1, arg2, op, otherop)
 224      value arg1, arg2;
 225      enum exp_opcode op, otherop;
 226 {
 227   value * argvec;
 228   char *ptr;
 229   char tstr[13];
 230   int static_memfuncp;
 231
 232   COERCE_REF (arg1);
 233   COERCE_REF (arg2);
 234   COERCE_ENUM (arg1);
 235   COERCE_ENUM (arg2);
 236
 237   /* now we know that what we have to do is construct our
 238      arg vector and find the right function to call it with.  */
 239
 240   if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_STRUCT)
 241     error ("Can't do that binary op on that type");  /* FIXME be explicit */
 242
 243   argvec = (value *) alloca (sizeof (value) * 4);
 244   argvec[1] = value_addr (arg1);
 245   argvec[2] = arg2;
 246   argvec[3] = 0;
 247
 248   /* make the right function name up */
 249   strcpy(tstr, "operator__");
 250   ptr = tstr+8;
 251   switch (op)
 252     {
 253     case BINOP_ADD:             strcpy(ptr,"+"); break;
 254     case BINOP_SUB:             strcpy(ptr,"-"); break;
 255     case BINOP_MUL:             strcpy(ptr,"*"); break;
 256     case BINOP_DIV:             strcpy(ptr,"/"); break;
 257     case BINOP_REM:             strcpy(ptr,"%"); break;
 258     case BINOP_LSH:             strcpy(ptr,"<<"); break;
 259     case BINOP_RSH:             strcpy(ptr,">>"); break;
 260     case BINOP_BITWISE_AND:     strcpy(ptr,"&"); break;
 261     case BINOP_BITWISE_IOR:     strcpy(ptr,"|"); break;
 262     case BINOP_BITWISE_XOR:     strcpy(ptr,"^"); break;
 263     case BINOP_LOGICAL_AND:     strcpy(ptr,"&&"); break;
 264     case BINOP_LOGICAL_OR:      strcpy(ptr,"||"); break;
 265     case BINOP_MIN:             strcpy(ptr,"<?"); break;
 266     case BINOP_MAX:             strcpy(ptr,">?"); break;
 267     case BINOP_ASSIGN:          strcpy(ptr,"="); break;
 268     case BINOP_ASSIGN_MODIFY:
 269       switch (otherop)
 270         {
 271         case BINOP_ADD:         strcpy(ptr,"+="); break;
 272         case BINOP_SUB:         strcpy(ptr,"-="); break;
 273         case BINOP_MUL:         strcpy(ptr,"*="); break;
 274         case BINOP_DIV:         strcpy(ptr,"/="); break;
 275         case BINOP_REM:         strcpy(ptr,"%="); break;
 276         case BINOP_BITWISE_AND: strcpy(ptr,"&="); break;
 277         case BINOP_BITWISE_IOR: strcpy(ptr,"|="); break;
 278         case BINOP_BITWISE_XOR: strcpy(ptr,"^="); break;
 279         case BINOP_MOD:         /* invalid */
 280         default:
 281           error ("Invalid binary operation specified.");
 282         }
 283       break;
 284     case BINOP_SUBSCRIPT: strcpy(ptr,"[]"); break;
 285     case BINOP_EQUAL:     strcpy(ptr,"=="); break;
 286     case BINOP_NOTEQUAL:  strcpy(ptr,"!="); break;
 287     case BINOP_LESS:      strcpy(ptr,"<"); break;
 288     case BINOP_GTR:       strcpy(ptr,">"); break;
 289     case BINOP_GEQ:       strcpy(ptr,">="); break;
 290     case BINOP_LEQ:       strcpy(ptr,"<="); break;
 291     case BINOP_MOD:       /* invalid */
 292     default:
 293       error ("Invalid binary operation specified.");
 294     }
 295   argvec[0] = value_struct_elt (&arg1, argvec+1, tstr, &static_memfuncp, "structure");
 296   if (argvec[0])
 297     {
 298       if (static_memfuncp)
 299         {
 300           argvec[1] = argvec[0];
 301           argvec++;
 302         }
 303       return call_function_by_hand (argvec[0], 2 - static_memfuncp, argvec + 1);
 304     }
 305   error ("member function %s not found", tstr);
 306 #ifdef lint
 307   return call_function_by_hand (argvec[0], 2 - static_memfuncp, argvec + 1);
 308 #endif
 309 }
 310
 311 /* We know that arg1 is a structure, so try to find a unary user
 312    defined operator that matches the operator in question.
 313    Create an argument vector that calls arg1.operator @ (arg1)
 314    and return that value (where '@' is (almost) any unary operator which
 315    is legal for GNU C++).  */
 316
 317 value
 318 value_x_unop (arg1, op)
 319      value arg1;
 320      enum exp_opcode op;
 321 {
 322   value * argvec;
 323   char *ptr;
 324   char tstr[13];
 325   int static_memfuncp;
 326
 327   COERCE_ENUM (arg1);
 328
 329   /* now we know that what we have to do is construct our
 330      arg vector and find the right function to call it with.  */
 331
 332   if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_STRUCT)
 333     error ("Can't do that unary op on that type");  /* FIXME be explicit */
 334
 335   argvec = (value *) alloca (sizeof (value) * 3);
 336   argvec[1] = value_addr (arg1);
 337   argvec[2] = 0;
 338
 339   /* make the right function name up */
 340   strcpy(tstr,"operator__");
 341   ptr = tstr+8;
 342   switch (op)
 343     {
 344     case UNOP_PREINCREMENT:     strcpy(ptr,"++"); break;
 345     case UNOP_PREDECREMENT:     strcpy(ptr,"++"); break;
 346     case UNOP_POSTINCREMENT:    strcpy(ptr,"++"); break;
 347     case UNOP_POSTDECREMENT:    strcpy(ptr,"++"); break;
 348     case UNOP_LOGICAL_NOT:      strcpy(ptr,"!"); break;
 349     case UNOP_COMPLEMENT:       strcpy(ptr,"~"); break;
 350     case UNOP_NEG:              strcpy(ptr,"-"); break;
 351     default:
 352       error ("Invalid binary operation specified.");
 353     }
 354   argvec[0] = value_struct_elt (&arg1, argvec+1, tstr, &static_memfuncp, "structure");
 355   if (argvec[0])
 356     {
 357       if (static_memfuncp)
 358         {
 359           argvec[1] = argvec[0];
 360           argvec++;
 361         }
 362       return call_function_by_hand (argvec[0], 1 - static_memfuncp, argvec + 1);
 363     }
 364   error ("member function %s not found", tstr);
 365   return 0;  /* For lint -- never reached */
 366 }
 367
 368 \f
 369 /* Concatenate two values with the following conditions:
 370
 371    (1)  Both values must be either bitstring values or character string
 372         values and the resulting value consists of the concatenation of
 373         ARG1 followed by ARG2.
 374
 375         or
 376
 377         One value must be an integer value and the other value must be
 378         either a bitstring value or character string value, which is
 379         to be repeated by the number of times specified by the integer
 380         value.
 381
 382
 383     (2) Boolean values are also allowed and are treated as bit string
 384         values of length 1.
 385
 386     (3) Character values are also allowed and are treated as character
 387         string values of length 1.
 388 */
 389
 390 value
 391 value_concat (arg1, arg2)
 392      value arg1, arg2;
 393 {
 394   register value inval1, inval2, outval;
 395   int inval1len, inval2len;
 396   int count, idx;
 397   char *ptr;
 398   char inchar;
 399
 400   /* First figure out if we are dealing with two values to be concatenated
 401      or a repeat count and a value to be repeated.  INVAL1 is set to the
 402      first of two concatenated values, or the repeat count.  INVAL2 is set
 403      to the second of the two concatenated values or the value to be
 404      repeated. */
 405
 406   if (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_INT)
 407     {
 408       inval1 = arg2;
 409       inval2 = arg1;
 410     }
 411   else
 412     {
 413       inval1 = arg1;
 414       inval2 = arg2;
 415     }
 416
 417   /* Now process the input values. */
 418
 419   if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_INT)
 420     {
 421       /* We have a repeat count.  Validate the second value and then
 422          construct a value repeated that many times. */
 423       if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_STRING
 424           || TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_CHAR)
 425         {
 426           count = longest_to_int (value_as_long (inval1));
 427           inval2len = TYPE_LENGTH (VALUE_TYPE (inval2));
 428           ptr = (char *) alloca (count * inval2len);
 429           if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_CHAR)
 430             {
 431               inchar = (char) unpack_long (VALUE_TYPE (inval2),
 432                                            VALUE_CONTENTS (inval2));
 433               for (idx = 0; idx < count; idx++)
 434                 {
 435                   *(ptr + idx) = inchar;
 436                 }
 437             }
 438           else
 439             {
 440               for (idx = 0; idx < count; idx++)
 441                 {
 442                   memcpy (ptr + (idx * inval2len), VALUE_CONTENTS (inval2),
 443                           inval2len);
 444                 }
 445             }
 446           outval = value_string (ptr, count * inval2len);
 447         }
 448       else if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_BITSTRING
 449                || TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_BOOL)
 450         {
 451           error ("unimplemented support for bitstring/boolean repeats");
 452         }
 453       else
 454         {
 455           error ("can't repeat values of that type");
 456         }
 457     }
 458   else if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_STRING
 459       || TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_CHAR)
 460     {
 461       /* We have two character strings to concatenate. */
 462       if (TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_STRING
 463           && TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_CHAR)
 464         {
 465           error ("Strings can only be concatenated with other strings.");
 466         }
 467       inval1len = TYPE_LENGTH (VALUE_TYPE (inval1));
 468       inval2len = TYPE_LENGTH (VALUE_TYPE (inval2));
 469       ptr = (char *) alloca (inval1len + inval2len);
 470       if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_CHAR)
 471         {
 472           *ptr = (char) unpack_long (VALUE_TYPE (inval1), VALUE_CONTENTS (inval1));
 473         }
 474       else
 475         {
 476           memcpy (ptr, VALUE_CONTENTS (inval1), inval1len);
 477         }
 478       if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_CHAR)
 479         {
 480           *(ptr + inval1len) =
 481             (char) unpack_long (VALUE_TYPE (inval2), VALUE_CONTENTS (inval2));
 482         }
 483       else
 484         {
 485           memcpy (ptr + inval1len, VALUE_CONTENTS (inval2), inval2len);
 486         }
 487       outval = value_string (ptr, inval1len + inval2len);
 488     }
 489   else if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_BITSTRING
 490            || TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_BOOL)
 491     {
 492       /* We have two bitstrings to concatenate. */
 493       if (TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_BITSTRING
 494           && TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_BOOL)
 495         {
 496           error ("Bitstrings or booleans can only be concatenated with other bitstrings or booleans.");
 497         }
 498       error ("unimplemented support for bitstring/boolean concatenation.");
 499     }
 500   else
 501     {
 502       /* We don't know how to concatenate these operands. */
 503       error ("illegal operands for concatenation.");
 504     }
 505   return (outval);
 506 }
 507
 508 \f
 509 /* Perform a binary operation on two operands which have reasonable
 510    representations as integers or floats.  This includes booleans,
 511    characters, integers, or floats.
 512    Does not support addition and subtraction on pointers;
 513    use value_add or value_sub if you want to handle those possibilities.  */
 514
 515 value
 516 value_binop (arg1, arg2, op)
 517      value arg1, arg2;
 518      enum exp_opcode op;
 519 {
 520   register value val;
 521
 522   COERCE_ENUM (arg1);
 523   COERCE_ENUM (arg2);
 524
 525   if ((TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT
 526        &&
 527        TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_CHAR
 528        &&
 529        TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_INT
 530        &&
 531        TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_BOOL)
 532       ||
 533       (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_FLT
 534        &&
 535        TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_CHAR
 536        &&
 537        TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT
 538        &&
 539        TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_BOOL))
 540     error ("Argument to arithmetic operation not a number or boolean.");
 541
 542   if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_FLT
 543       ||
 544       TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_FLT)
 545     {
 546       double v1, v2, v;
 547       v1 = value_as_double (arg1);
 548       v2 = value_as_double (arg2);
 549       switch (op)
 550         {
 551         case BINOP_ADD:
 552           v = v1 + v2;
 553           break;
 554
 555         case BINOP_SUB:
 556           v = v1 - v2;
 557           break;
 558
 559         case BINOP_MUL:
 560           v = v1 * v2;
 561           break;
 562
 563         case BINOP_DIV:
 564           v = v1 / v2;
 565           break;
 566
 567         default:
 568           error ("Integer-only operation on floating point number.");
 569         }
 570
 571       val = allocate_value (builtin_type_double);
 572       SWAP_TARGET_AND_HOST (&v, sizeof (v));
 573       *(double *) VALUE_CONTENTS_RAW (val) = v;
 574     }
 575   else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_BOOL
 576            &&
 577            TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_BOOL)
 578       {
 579           LONGEST v1, v2, v;
 580           v1 = value_as_long (arg1);
 581           v2 = value_as_long (arg2);
 582
 583           switch (op)
 584             {
 585             case BINOP_BITWISE_AND:
 586               v = v1 & v2;
 587               break;
 588
 589             case BINOP_BITWISE_IOR:
 590               v = v1 | v2;
 591               break;
 592
 593             case BINOP_BITWISE_XOR:
 594               v = v1 ^ v2;
 595               break;
 596
 597             default:
 598               error ("Invalid operation on booleans.");
 599             }
 600
 601           /* start-sanitize-chill (FIXME!) */
 602           val = allocate_value (builtin_type_chill_bool);
 603           /* end-sanitize-chill */
 604           SWAP_TARGET_AND_HOST (&v, sizeof (v));
 605           *(LONGEST *) VALUE_CONTENTS_RAW (val) = v;
 606       }
 607   else
 608     /* Integral operations here.  */
 609     /* FIXME:  Also mixed integral/booleans, with result an integer. */
 610     {
 611       /* Should we promote to unsigned longest?  */
 612       if ((TYPE_UNSIGNED (VALUE_TYPE (arg1))
 613            || TYPE_UNSIGNED (VALUE_TYPE (arg2)))
 614           && (TYPE_LENGTH (VALUE_TYPE (arg1)) >= sizeof (unsigned LONGEST)
 615               || TYPE_LENGTH (VALUE_TYPE (arg1)) >= sizeof (unsigned LONGEST)))
 616         {
 617           unsigned LONGEST v1, v2, v;
 618           v1 = (unsigned LONGEST) value_as_long (arg1);
 619           v2 = (unsigned LONGEST) value_as_long (arg2);
 620
 621           switch (op)
 622             {
 623             case BINOP_ADD:
 624               v = v1 + v2;
 625               break;
 626
 627             case BINOP_SUB:
 628               v = v1 - v2;
 629               break;
 630
 631             case BINOP_MUL:
 632               v = v1 * v2;
 633               break;
 634
 635             case BINOP_DIV:
 636               v = v1 / v2;
 637               break;
 638
 639             case BINOP_REM:
 640               v = v1 % v2;
 641               break;
 642
 643             case BINOP_MOD:
 644               /* Knuth 1.2.4, integer only.  Note that unlike the C '%' op,
 645                  v1 mod 0 has a defined value, v1. */
 646               /* start-sanitize-chill */
 647               /* Chill specifies that v2 must be > 0, so check for that. */
 648               if (current_language -> la_language == language_chill
 649                   && value_as_long (arg2) <= 0)
 650                 {
 651                   error ("Second operand of MOD must be greater than zero.");
 652                 }
 653               /* end-sanitize-chill */
 654               if (v2 == 0)
 655                 {
 656                   v = v1;
 657                 }
 658               else
 659                 {
 660                   v = v1/v2;
 661                   /* Note floor(v1/v2) == v1/v2 for unsigned. */
 662                   v = v1 - (v2 * v);
 663                 }
 664               break;
 665
 666             case BINOP_LSH:
 667               v = v1 << v2;
 668               break;
 669
 670             case BINOP_RSH:
 671               v = v1 >> v2;
 672               break;
 673
 674             case BINOP_BITWISE_AND:
 675               v = v1 & v2;
 676               break;
 677
 678             case BINOP_BITWISE_IOR:
 679               v = v1 | v2;
 680               break;
 681
 682             case BINOP_BITWISE_XOR:
 683               v = v1 ^ v2;
 684               break;
 685
 686             case BINOP_LOGICAL_AND:
 687               v = v1 && v2;
 688               break;
 689
 690             case BINOP_LOGICAL_OR:
 691               v = v1 || v2;
 692               break;
 693
 694             case BINOP_MIN:
 695               v = v1 < v2 ? v1 : v2;
 696               break;
 697
 698             case BINOP_MAX:
 699               v = v1 > v2 ? v1 : v2;
 700               break;
 701
 702             default:
 703               error ("Invalid binary operation on numbers.");
 704             }
 705
 706           val = allocate_value (BUILTIN_TYPE_UNSIGNED_LONGEST);
 707           SWAP_TARGET_AND_HOST (&v, sizeof (v));
 708           *(unsigned LONGEST *) VALUE_CONTENTS_RAW (val) = v;
 709         }
 710       else
 711         {
 712           LONGEST v1, v2, v;
 713           v1 = value_as_long (arg1);
 714           v2 = value_as_long (arg2);
 715
 716           switch (op)
 717             {
 718             case BINOP_ADD:
 719               v = v1 + v2;
 720               break;
 721
 722             case BINOP_SUB:
 723               v = v1 - v2;
 724               break;
 725
 726             case BINOP_MUL:
 727               v = v1 * v2;
 728               break;
 729
 730             case BINOP_DIV:
 731               v = v1 / v2;
 732               break;
 733
 734             case BINOP_REM:
 735               v = v1 % v2;
 736               break;
 737
 738             case BINOP_MOD:
 739               /* Knuth 1.2.4, integer only.  Note that unlike the C '%' op,
 740                  X mod 0 has a defined value, X. */
 741               /* start-sanitize-chill */
 742               /* Chill specifies that v2 must be > 0, so check for that. */
 743               if (current_language -> la_language == language_chill
 744                   && v2 <= 0)
 745                 {
 746                   error ("Second operand of MOD must be greater than zero.");
 747                 }
 748               /* end-sanitize-chill */
 749               if (v2 == 0)
 750                 {
 751                   v = v1;
 752                 }
 753               else
 754                 {
 755                   v = v1/v2;
 756                   /* Compute floor. */
 757                   if (TRUNCATION_TOWARDS_ZERO && (v < 0) && ((v1 % v2) != 0))
 758                     {
 759                       v--;
 760                     }
 761                   v = v1 - (v2 * v);
 762                 }
 763               break;
 764
 765             case BINOP_LSH:
 766               v = v1 << v2;
 767               break;
 768
 769             case BINOP_RSH:
 770               v = v1 >> v2;
 771               break;
 772
 773             case BINOP_BITWISE_AND:
 774               v = v1 & v2;
 775               break;
 776
 777             case BINOP_BITWISE_IOR:
 778               v = v1 | v2;
 779               break;
 780
 781             case BINOP_BITWISE_XOR:
 782               v = v1 ^ v2;
 783               break;
 784
 785             case BINOP_LOGICAL_AND:
 786               v = v1 && v2;
 787               break;
 788
 789             case BINOP_LOGICAL_OR:
 790               v = v1 || v2;
 791               break;
 792
 793             case BINOP_MIN:
 794               v = v1 < v2 ? v1 : v2;
 795               break;
 796
 797             case BINOP_MAX:
 798               v = v1 > v2 ? v1 : v2;
 799               break;
 800
 801             default:
 802               error ("Invalid binary operation on numbers.");
 803             }
 804
 805           val = allocate_value (BUILTIN_TYPE_LONGEST);
 806           SWAP_TARGET_AND_HOST (&v, sizeof (v));
 807           *(LONGEST *) VALUE_CONTENTS_RAW (val) = v;
 808         }
 809     }
 810
 811   return val;
 812 }
 813 \f
 814 /* Simulate the C operator ! -- return 1 if ARG1 contains zero.  */
 815
 816 int
 817 value_logical_not (arg1)
 818      value arg1;
 819 {
 820   register int len;
 821   register char *p;
 822
 823   COERCE_ARRAY (arg1);
 824
 825   if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_FLT)
 826     return 0 == value_as_double (arg1);
 827
 828   len = TYPE_LENGTH (VALUE_TYPE (arg1));
 829   p = VALUE_CONTENTS (arg1);
 830
 831   while (--len >= 0)
 832     {
 833       if (*p++)
 834         break;
 835     }
 836
 837   return len < 0;
 838 }
 839
 840 /* Simulate the C operator == by returning a 1
 841    iff ARG1 and ARG2 have equal contents.  */
 842
 843 int
 844 value_equal (arg1, arg2)
 845      register value arg1, arg2;
 846
 847 {
 848   register int len;
 849   register char *p1, *p2;
 850   enum type_code code1;
 851   enum type_code code2;
 852
 853   COERCE_ARRAY (arg1);
 854   COERCE_ARRAY (arg2);
 855
 856   code1 = TYPE_CODE (VALUE_TYPE (arg1));
 857   code2 = TYPE_CODE (VALUE_TYPE (arg2));
 858
 859   if (code1 == TYPE_CODE_INT && code2 == TYPE_CODE_INT)
 860     return value_as_long (arg1) == value_as_long (arg2);
 861   else if ((code1 == TYPE_CODE_FLT || code1 == TYPE_CODE_INT)
 862            && (code2 == TYPE_CODE_FLT || code2 == TYPE_CODE_INT))
 863     return value_as_double (arg1) == value_as_double (arg2);
 864
 865   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
 866      is bigger.  */
 867   else if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_INT)
 868     return value_as_pointer (arg1) == (CORE_ADDR) value_as_long (arg2);
 869   else if (code2 == TYPE_CODE_PTR && code1 == TYPE_CODE_INT)
 870     return (CORE_ADDR) value_as_long (arg1) == value_as_pointer (arg2);
 871
 872   else if (code1 == code2
 873            && ((len = TYPE_LENGTH (VALUE_TYPE (arg1)))
 874                == TYPE_LENGTH (VALUE_TYPE (arg2))))
 875     {
 876       p1 = VALUE_CONTENTS (arg1);
 877       p2 = VALUE_CONTENTS (arg2);
 878       while (--len >= 0)
 879         {
 880           if (*p1++ != *p2++)
 881             break;
 882         }
 883       return len < 0;
 884     }
 885   else
 886     {
 887       error ("Invalid type combination in equality test.");
 888       return 0;  /* For lint -- never reached */
 889     }
 890 }
 891
 892 /* Simulate the C operator < by returning 1
 893    iff ARG1's contents are less than ARG2's.  */
 894
 895 int
 896 value_less (arg1, arg2)
 897      register value arg1, arg2;
 898 {
 899   register enum type_code code1;
 900   register enum type_code code2;
 901
 902   COERCE_ARRAY (arg1);
 903   COERCE_ARRAY (arg2);
 904
 905   code1 = TYPE_CODE (VALUE_TYPE (arg1));
 906   code2 = TYPE_CODE (VALUE_TYPE (arg2));
 907
 908   if (code1 == TYPE_CODE_INT && code2 == TYPE_CODE_INT)
 909     {
 910       if (TYPE_UNSIGNED (VALUE_TYPE (arg1))
 911        || TYPE_UNSIGNED (VALUE_TYPE (arg2)))
 912         return ((unsigned LONGEST) value_as_long (arg1)
 913                 < (unsigned LONGEST) value_as_long (arg2));
 914       else
 915         return value_as_long (arg1) < value_as_long (arg2);
 916     }
 917   else if ((code1 == TYPE_CODE_FLT || code1 == TYPE_CODE_INT)
 918            && (code2 == TYPE_CODE_FLT || code2 == TYPE_CODE_INT))
 919     return value_as_double (arg1) < value_as_double (arg2);
 920   else if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
 921     return value_as_pointer (arg1) < value_as_pointer (arg2);
 922
 923   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
 924      is bigger.  */
 925   else if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_INT)
 926     return value_as_pointer (arg1) < (CORE_ADDR) value_as_long (arg2);
 927   else if (code2 == TYPE_CODE_PTR && code1 == TYPE_CODE_INT)
 928     return (CORE_ADDR) value_as_long (arg1) < value_as_pointer (arg2);
 929
 930   else
 931     {
 932       error ("Invalid type combination in ordering comparison.");
 933       return 0;
 934     }
 935 }
 936 \f
 937 /* The unary operators - and ~.  Both free the argument ARG1.  */
 938
 939 value
 940 value_neg (arg1)
 941      register value arg1;
 942 {
 943   register struct type *type;
 944
 945   COERCE_ENUM (arg1);
 946
 947   type = VALUE_TYPE (arg1);
 948
 949   if (TYPE_CODE (type) == TYPE_CODE_FLT)
 950     return value_from_double (type, - value_as_double (arg1));
 951   else if (TYPE_CODE (type) == TYPE_CODE_INT)
 952     return value_from_longest (type, - value_as_long (arg1));
 953   else {
 954     error ("Argument to negate operation not a number.");
 955     return 0;  /* For lint -- never reached */
 956   }
 957 }
 958
 959 value
 960 value_complement (arg1)
 961      register value arg1;
 962 {
 963   COERCE_ENUM (arg1);
 964
 965   if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_INT)
 966     error ("Argument to complement operation not an integer.");
 967
 968   return value_from_longest (VALUE_TYPE (arg1), ~ value_as_long (arg1));
 969 }
 970 \f