gdb/valarith.c

   1 /* Perform arithmetic and other operations on values, for GDB.
   2
   3    Copyright 1986, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995,
   4    1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software
   5    Foundation, Inc.
   6
   7    This file is part of GDB.
   8
   9    This program is free software; you can redistribute it and/or modify
  10    it under the terms of the GNU General Public License as published by
  11    the Free Software Foundation; either version 2 of the License, or
  12    (at your option) any later version.
  13
  14    This program is distributed in the hope that it will be useful,
  15    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17    GNU General Public License for more details.
  18
  19    You should have received a copy of the GNU General Public License
  20    along with this program; if not, write to the Free Software
  21    Foundation, Inc., 59 Temple Place - Suite 330,
  22    Boston, MA 02111-1307, USA.  */
  23
  24 #include "defs.h"
  25 #include "value.h"
  26 #include "symtab.h"
  27 #include "gdbtypes.h"
  28 #include "expression.h"
  29 #include "target.h"
  30 #include "language.h"
  31 #include "gdb_string.h"
  32 #include "doublest.h"
  33 #include <math.h>
  34 #include "infcall.h"
  35
  36 /* Define whether or not the C operator '/' truncates towards zero for
  37    differently signed operands (truncation direction is undefined in C). */
  38
  39 #ifndef TRUNCATION_TOWARDS_ZERO
  40 #define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
  41 #endif
  42
  43 static struct value *value_subscripted_rvalue (struct value *, struct value *, int);
  44
  45 void _initialize_valarith (void);
  46 \f
  47
  48 /* Given a pointer, return the size of its target.
  49    If the pointer type is void *, then return 1.
  50    If the target type is incomplete, then error out.
  51    This isn't a general purpose function, but just a
  52    helper for value_sub & value_add.
  53 */
  54
  55 static LONGEST
  56 find_size_for_pointer_math (struct type *ptr_type)
  57 {
  58   LONGEST sz = -1;
  59   struct type *ptr_target;
  60
  61   ptr_target = check_typedef (TYPE_TARGET_TYPE (ptr_type));
  62
  63   sz = TYPE_LENGTH (ptr_target);
  64   if (sz == 0)
  65     {
  66       if (TYPE_CODE (ptr_type) == TYPE_CODE_VOID)
  67         sz = 1;
  68       else
  69         {
  70           char *name;
  71
  72           name = TYPE_NAME (ptr_target);
  73           if (name == NULL)
  74             name = TYPE_TAG_NAME (ptr_target);
  75           if (name == NULL)
  76             error ("Cannot perform pointer math on incomplete types, "
  77                    "try casting to a known type, or void *.");
  78           else
  79             error ("Cannot perform pointer math on incomplete type \"%s\", "
  80                    "try casting to a known type, or void *.", name);
  81         }
  82     }
  83   return sz;
  84 }
  85
  86 struct value *
  87 value_add (struct value *arg1, struct value *arg2)
  88 {
  89   struct value *valint;
  90   struct value *valptr;
  91   LONGEST sz;
  92   struct type *type1, *type2, *valptrtype;
  93
  94   COERCE_NUMBER (arg1);
  95   COERCE_NUMBER (arg2);
  96   type1 = check_typedef (VALUE_TYPE (arg1));
  97   type2 = check_typedef (VALUE_TYPE (arg2));
  98
  99   if ((TYPE_CODE (type1) == TYPE_CODE_PTR
 100        || TYPE_CODE (type2) == TYPE_CODE_PTR)
 101       &&
 102       (TYPE_CODE (type1) == TYPE_CODE_INT
 103        || TYPE_CODE (type2) == TYPE_CODE_INT))
 104     /* Exactly one argument is a pointer, and one is an integer.  */
 105     {
 106       struct value *retval;
 107
 108       if (TYPE_CODE (type1) == TYPE_CODE_PTR)
 109         {
 110           valptr = arg1;
 111           valint = arg2;
 112           valptrtype = type1;
 113         }
 114       else
 115         {
 116           valptr = arg2;
 117           valint = arg1;
 118           valptrtype = type2;
 119         }
 120
 121       sz = find_size_for_pointer_math (valptrtype);
 122
 123       retval = value_from_pointer (valptrtype,
 124                                    value_as_address (valptr)
 125                                    + (sz * value_as_long (valint)));
 126       VALUE_BFD_SECTION (retval) = VALUE_BFD_SECTION (valptr);
 127       return retval;
 128     }
 129
 130   return value_binop (arg1, arg2, BINOP_ADD);
 131 }
 132
 133 struct value *
 134 value_sub (struct value *arg1, struct value *arg2)
 135 {
 136   struct type *type1, *type2;
 137   COERCE_NUMBER (arg1);
 138   COERCE_NUMBER (arg2);
 139   type1 = check_typedef (VALUE_TYPE (arg1));
 140   type2 = check_typedef (VALUE_TYPE (arg2));
 141
 142   if (TYPE_CODE (type1) == TYPE_CODE_PTR)
 143     {
 144       if (TYPE_CODE (type2) == TYPE_CODE_INT)
 145         {
 146           /* pointer - integer.  */
 147           LONGEST sz = find_size_for_pointer_math (type1);
 148
 149           return value_from_pointer (type1,
 150                                      (value_as_address (arg1)
 151                                       - (sz * value_as_long (arg2))));
 152         }
 153       else if (TYPE_CODE (type2) == TYPE_CODE_PTR
 154                && TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type1)))
 155                == TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type2))))
 156         {
 157           /* pointer to <type x> - pointer to <type x>.  */
 158           LONGEST sz = TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type1)));
 159           return value_from_longest
 160             (builtin_type_long, /* FIXME -- should be ptrdiff_t */
 161              (value_as_long (arg1) - value_as_long (arg2)) / sz);
 162         }
 163       else
 164         {
 165           error ("\
 166 First argument of `-' is a pointer and second argument is neither\n\
 167 an integer nor a pointer of the same type.");
 168         }
 169     }
 170
 171   return value_binop (arg1, arg2, BINOP_SUB);
 172 }
 173
 174 /* Return the value of ARRAY[IDX].
 175    See comments in value_coerce_array() for rationale for reason for
 176    doing lower bounds adjustment here rather than there.
 177    FIXME:  Perhaps we should validate that the index is valid and if
 178    verbosity is set, warn about invalid indices (but still use them). */
 179
 180 struct value *
 181 value_subscript (struct value *array, struct value *idx)
 182 {
 183   struct value *bound;
 184   int c_style = current_language->c_style_arrays;
 185   struct type *tarray;
 186
 187   COERCE_REF (array);
 188   tarray = check_typedef (VALUE_TYPE (array));
 189   COERCE_VARYING_ARRAY (array, tarray);
 190
 191   if (TYPE_CODE (tarray) == TYPE_CODE_ARRAY
 192       || TYPE_CODE (tarray) == TYPE_CODE_STRING)
 193     {
 194       struct type *range_type = TYPE_INDEX_TYPE (tarray);
 195       LONGEST lowerbound, upperbound;
 196       get_discrete_bounds (range_type, &lowerbound, &upperbound);
 197
 198       if (VALUE_LVAL (array) != lval_memory)
 199         return value_subscripted_rvalue (array, idx, lowerbound);
 200
 201       if (c_style == 0)
 202         {
 203           LONGEST index = value_as_long (idx);
 204           if (index >= lowerbound && index <= upperbound)
 205             return value_subscripted_rvalue (array, idx, lowerbound);
 206           warning ("array or string index out of range");
 207           /* fall doing C stuff */
 208           c_style = 1;
 209         }
 210
 211       if (lowerbound != 0)
 212         {
 213           bound = value_from_longest (builtin_type_int, (LONGEST) lowerbound);
 214           idx = value_sub (idx, bound);
 215         }
 216
 217       array = value_coerce_array (array);
 218     }
 219
 220   if (TYPE_CODE (tarray) == TYPE_CODE_BITSTRING)
 221     {
 222       struct type *range_type = TYPE_INDEX_TYPE (tarray);
 223       LONGEST index = value_as_long (idx);
 224       struct value *v;
 225       int offset, byte, bit_index;
 226       LONGEST lowerbound, upperbound;
 227       get_discrete_bounds (range_type, &lowerbound, &upperbound);
 228       if (index < lowerbound || index > upperbound)
 229         error ("bitstring index out of range");
 230       index -= lowerbound;
 231       offset = index / TARGET_CHAR_BIT;
 232       byte = *((char *) VALUE_CONTENTS (array) + offset);
 233       bit_index = index % TARGET_CHAR_BIT;
 234       byte >>= (BITS_BIG_ENDIAN ? TARGET_CHAR_BIT - 1 - bit_index : bit_index);
 235       v = value_from_longest (LA_BOOL_TYPE, byte & 1);
 236       VALUE_BITPOS (v) = bit_index;
 237       VALUE_BITSIZE (v) = 1;
 238       VALUE_LVAL (v) = VALUE_LVAL (array);
 239       if (VALUE_LVAL (array) == lval_internalvar)
 240         VALUE_LVAL (v) = lval_internalvar_component;
 241       VALUE_ADDRESS (v) = VALUE_ADDRESS (array);
 242       VALUE_OFFSET (v) = offset + VALUE_OFFSET (array);
 243       return v;
 244     }
 245
 246   if (c_style)
 247     return value_ind (value_add (array, idx));
 248   else
 249     error ("not an array or string");
 250 }
 251
 252 /* Return the value of EXPR[IDX], expr an aggregate rvalue
 253    (eg, a vector register).  This routine used to promote floats
 254    to doubles, but no longer does.  */
 255
 256 static struct value *
 257 value_subscripted_rvalue (struct value *array, struct value *idx, int lowerbound)
 258 {
 259   struct type *array_type = check_typedef (VALUE_TYPE (array));
 260   struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
 261   unsigned int elt_size = TYPE_LENGTH (elt_type);
 262   LONGEST index = value_as_long (idx);
 263   unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
 264   struct value *v;
 265
 266   if (index < lowerbound || elt_offs >= TYPE_LENGTH (array_type))
 267     error ("no such vector element");
 268
 269   v = allocate_value (elt_type);
 270   if (VALUE_LAZY (array))
 271     VALUE_LAZY (v) = 1;
 272   else
 273     memcpy (VALUE_CONTENTS (v), VALUE_CONTENTS (array) + elt_offs, elt_size);
 274
 275   if (VALUE_LVAL (array) == lval_internalvar)
 276     VALUE_LVAL (v) = lval_internalvar_component;
 277   else
 278     VALUE_LVAL (v) = VALUE_LVAL (array);
 279   VALUE_ADDRESS (v) = VALUE_ADDRESS (array);
 280   VALUE_REGNO (v) = VALUE_REGNO (array);
 281   VALUE_OFFSET (v) = VALUE_OFFSET (array) + elt_offs;
 282   return v;
 283 }
 284 \f
 285 /* Check to see if either argument is a structure.  This is called so
 286    we know whether to go ahead with the normal binop or look for a
 287    user defined function instead.
 288
 289    For now, we do not overload the `=' operator.  */
 290
 291 int
 292 binop_user_defined_p (enum exp_opcode op, struct value *arg1, struct value *arg2)
 293 {
 294   struct type *type1, *type2;
 295   if (op == BINOP_ASSIGN || op == BINOP_CONCAT)
 296     return 0;
 297   type1 = check_typedef (VALUE_TYPE (arg1));
 298   type2 = check_typedef (VALUE_TYPE (arg2));
 299   return (TYPE_CODE (type1) == TYPE_CODE_STRUCT
 300           || TYPE_CODE (type2) == TYPE_CODE_STRUCT
 301           || (TYPE_CODE (type1) == TYPE_CODE_REF
 302               && TYPE_CODE (TYPE_TARGET_TYPE (type1)) == TYPE_CODE_STRUCT)
 303           || (TYPE_CODE (type2) == TYPE_CODE_REF
 304               && TYPE_CODE (TYPE_TARGET_TYPE (type2)) == TYPE_CODE_STRUCT));
 305 }
 306
 307 /* Check to see if argument is a structure.  This is called so
 308    we know whether to go ahead with the normal unop or look for a
 309    user defined function instead.
 310
 311    For now, we do not overload the `&' operator.  */
 312
 313 int
 314 unop_user_defined_p (enum exp_opcode op, struct value *arg1)
 315 {
 316   struct type *type1;
 317   if (op == UNOP_ADDR)
 318     return 0;
 319   type1 = check_typedef (VALUE_TYPE (arg1));
 320   for (;;)
 321     {
 322       if (TYPE_CODE (type1) == TYPE_CODE_STRUCT)
 323         return 1;
 324       else if (TYPE_CODE (type1) == TYPE_CODE_REF)
 325         type1 = TYPE_TARGET_TYPE (type1);
 326       else
 327         return 0;
 328     }
 329 }
 330
 331 /* We know either arg1 or arg2 is a structure, so try to find the right
 332    user defined function.  Create an argument vector that calls
 333    arg1.operator @ (arg1,arg2) and return that value (where '@' is any
 334    binary operator which is legal for GNU C++).
 335
 336    OP is the operatore, and if it is BINOP_ASSIGN_MODIFY, then OTHEROP
 337    is the opcode saying how to modify it.  Otherwise, OTHEROP is
 338    unused.  */
 339
 340 struct value *
 341 value_x_binop (struct value *arg1, struct value *arg2, enum exp_opcode op,
 342                enum exp_opcode otherop, enum noside noside)
 343 {
 344   struct value **argvec;
 345   char *ptr;
 346   char tstr[13];
 347   int static_memfuncp;
 348
 349   COERCE_REF (arg1);
 350   COERCE_REF (arg2);
 351   COERCE_ENUM (arg1);
 352   COERCE_ENUM (arg2);
 353
 354   /* now we know that what we have to do is construct our
 355      arg vector and find the right function to call it with.  */
 356
 357   if (TYPE_CODE (check_typedef (VALUE_TYPE (arg1))) != TYPE_CODE_STRUCT)
 358     error ("Can't do that binary op on that type");     /* FIXME be explicit */
 359
 360   argvec = (struct value **) alloca (sizeof (struct value *) * 4);
 361   argvec[1] = value_addr (arg1);
 362   argvec[2] = arg2;
 363   argvec[3] = 0;
 364
 365   /* make the right function name up */
 366   strcpy (tstr, "operator__");
 367   ptr = tstr + 8;
 368   switch (op)
 369     {
 370     case BINOP_ADD:
 371       strcpy (ptr, "+");
 372       break;
 373     case BINOP_SUB:
 374       strcpy (ptr, "-");
 375       break;
 376     case BINOP_MUL:
 377       strcpy (ptr, "*");
 378       break;
 379     case BINOP_DIV:
 380       strcpy (ptr, "/");
 381       break;
 382     case BINOP_REM:
 383       strcpy (ptr, "%");
 384       break;
 385     case BINOP_LSH:
 386       strcpy (ptr, "<<");
 387       break;
 388     case BINOP_RSH:
 389       strcpy (ptr, ">>");
 390       break;
 391     case BINOP_BITWISE_AND:
 392       strcpy (ptr, "&");
 393       break;
 394     case BINOP_BITWISE_IOR:
 395       strcpy (ptr, "|");
 396       break;
 397     case BINOP_BITWISE_XOR:
 398       strcpy (ptr, "^");
 399       break;
 400     case BINOP_LOGICAL_AND:
 401       strcpy (ptr, "&&");
 402       break;
 403     case BINOP_LOGICAL_OR:
 404       strcpy (ptr, "||");
 405       break;
 406     case BINOP_MIN:
 407       strcpy (ptr, "<?");
 408       break;
 409     case BINOP_MAX:
 410       strcpy (ptr, ">?");
 411       break;
 412     case BINOP_ASSIGN:
 413       strcpy (ptr, "=");
 414       break;
 415     case BINOP_ASSIGN_MODIFY:
 416       switch (otherop)
 417         {
 418         case BINOP_ADD:
 419           strcpy (ptr, "+=");
 420           break;
 421         case BINOP_SUB:
 422           strcpy (ptr, "-=");
 423           break;
 424         case BINOP_MUL:
 425           strcpy (ptr, "*=");
 426           break;
 427         case BINOP_DIV:
 428           strcpy (ptr, "/=");
 429           break;
 430         case BINOP_REM:
 431           strcpy (ptr, "%=");
 432           break;
 433         case BINOP_BITWISE_AND:
 434           strcpy (ptr, "&=");
 435           break;
 436         case BINOP_BITWISE_IOR:
 437           strcpy (ptr, "|=");
 438           break;
 439         case BINOP_BITWISE_XOR:
 440           strcpy (ptr, "^=");
 441           break;
 442         case BINOP_MOD: /* invalid */
 443         default:
 444           error ("Invalid binary operation specified.");
 445         }
 446       break;
 447     case BINOP_SUBSCRIPT:
 448       strcpy (ptr, "[]");
 449       break;
 450     case BINOP_EQUAL:
 451       strcpy (ptr, "==");
 452       break;
 453     case BINOP_NOTEQUAL:
 454       strcpy (ptr, "!=");
 455       break;
 456     case BINOP_LESS:
 457       strcpy (ptr, "<");
 458       break;
 459     case BINOP_GTR:
 460       strcpy (ptr, ">");
 461       break;
 462     case BINOP_GEQ:
 463       strcpy (ptr, ">=");
 464       break;
 465     case BINOP_LEQ:
 466       strcpy (ptr, "<=");
 467       break;
 468     case BINOP_MOD:             /* invalid */
 469     default:
 470       error ("Invalid binary operation specified.");
 471     }
 472
 473   argvec[0] = value_struct_elt (&arg1, argvec + 1, tstr, &static_memfuncp, "structure");
 474
 475   if (argvec[0])
 476     {
 477       if (static_memfuncp)
 478         {
 479           argvec[1] = argvec[0];
 480           argvec++;
 481         }
 482       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 483         {
 484           struct type *return_type;
 485           return_type
 486             = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (argvec[0])));
 487           return value_zero (return_type, VALUE_LVAL (arg1));
 488         }
 489       return call_function_by_hand (argvec[0], 2 - static_memfuncp, argvec + 1);
 490     }
 491   error ("member function %s not found", tstr);
 492 #ifdef lint
 493   return call_function_by_hand (argvec[0], 2 - static_memfuncp, argvec + 1);
 494 #endif
 495 }
 496
 497 /* We know that arg1 is a structure, so try to find a unary user
 498    defined operator that matches the operator in question.
 499    Create an argument vector that calls arg1.operator @ (arg1)
 500    and return that value (where '@' is (almost) any unary operator which
 501    is legal for GNU C++).  */
 502
 503 struct value *
 504 value_x_unop (struct value *arg1, enum exp_opcode op, enum noside noside)
 505 {
 506   struct value **argvec;
 507   char *ptr, *mangle_ptr;
 508   char tstr[13], mangle_tstr[13];
 509   int static_memfuncp, nargs;
 510
 511   COERCE_REF (arg1);
 512   COERCE_ENUM (arg1);
 513
 514   /* now we know that what we have to do is construct our
 515      arg vector and find the right function to call it with.  */
 516
 517   if (TYPE_CODE (check_typedef (VALUE_TYPE (arg1))) != TYPE_CODE_STRUCT)
 518     error ("Can't do that unary op on that type");      /* FIXME be explicit */
 519
 520   argvec = (struct value **) alloca (sizeof (struct value *) * 4);
 521   argvec[1] = value_addr (arg1);
 522   argvec[2] = 0;
 523
 524   nargs = 1;
 525
 526   /* make the right function name up */
 527   strcpy (tstr, "operator__");
 528   ptr = tstr + 8;
 529   strcpy (mangle_tstr, "__");
 530   mangle_ptr = mangle_tstr + 2;
 531   switch (op)
 532     {
 533     case UNOP_PREINCREMENT:
 534       strcpy (ptr, "++");
 535       break;
 536     case UNOP_PREDECREMENT:
 537       strcpy (ptr, "--");
 538       break;
 539     case UNOP_POSTINCREMENT:
 540       strcpy (ptr, "++");
 541       argvec[2] = value_from_longest (builtin_type_int, 0);
 542       argvec[3] = 0;
 543       nargs ++;
 544       break;
 545     case UNOP_POSTDECREMENT:
 546       strcpy (ptr, "--");
 547       argvec[2] = value_from_longest (builtin_type_int, 0);
 548       argvec[3] = 0;
 549       nargs ++;
 550       break;
 551     case UNOP_LOGICAL_NOT:
 552       strcpy (ptr, "!");
 553       break;
 554     case UNOP_COMPLEMENT:
 555       strcpy (ptr, "~");
 556       break;
 557     case UNOP_NEG:
 558       strcpy (ptr, "-");
 559       break;
 560     case UNOP_IND:
 561       strcpy (ptr, "*");
 562       break;
 563     default:
 564       error ("Invalid unary operation specified.");
 565     }
 566
 567   argvec[0] = value_struct_elt (&arg1, argvec + 1, tstr, &static_memfuncp, "structure");
 568
 569   if (argvec[0])
 570     {
 571       if (static_memfuncp)
 572         {
 573           argvec[1] = argvec[0];
 574           nargs --;
 575           argvec++;
 576         }
 577       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 578         {
 579           struct type *return_type;
 580           return_type
 581             = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (argvec[0])));
 582           return value_zero (return_type, VALUE_LVAL (arg1));
 583         }
 584       return call_function_by_hand (argvec[0], nargs, argvec + 1);
 585     }
 586   error ("member function %s not found", tstr);
 587   return 0;                     /* For lint -- never reached */
 588 }
 589 \f
 590
 591 /* Concatenate two values with the following conditions:
 592
 593    (1)  Both values must be either bitstring values or character string
 594    values and the resulting value consists of the concatenation of
 595    ARG1 followed by ARG2.
 596
 597    or
 598
 599    One value must be an integer value and the other value must be
 600    either a bitstring value or character string value, which is
 601    to be repeated by the number of times specified by the integer
 602    value.
 603
 604
 605    (2)  Boolean values are also allowed and are treated as bit string
 606    values of length 1.
 607
 608    (3)  Character values are also allowed and are treated as character
 609    string values of length 1.
 610  */
 611
 612 struct value *
 613 value_concat (struct value *arg1, struct value *arg2)
 614 {
 615   struct value *inval1;
 616   struct value *inval2;
 617   struct value *outval = NULL;
 618   int inval1len, inval2len;
 619   int count, idx;
 620   char *ptr;
 621   char inchar;
 622   struct type *type1 = check_typedef (VALUE_TYPE (arg1));
 623   struct type *type2 = check_typedef (VALUE_TYPE (arg2));
 624
 625   COERCE_VARYING_ARRAY (arg1, type1);
 626   COERCE_VARYING_ARRAY (arg2, type2);
 627
 628   /* First figure out if we are dealing with two values to be concatenated
 629      or a repeat count and a value to be repeated.  INVAL1 is set to the
 630      first of two concatenated values, or the repeat count.  INVAL2 is set
 631      to the second of the two concatenated values or the value to be
 632      repeated. */
 633
 634   if (TYPE_CODE (type2) == TYPE_CODE_INT)
 635     {
 636       struct type *tmp = type1;
 637       type1 = tmp;
 638       tmp = type2;
 639       inval1 = arg2;
 640       inval2 = arg1;
 641     }
 642   else
 643     {
 644       inval1 = arg1;
 645       inval2 = arg2;
 646     }
 647
 648   /* Now process the input values. */
 649
 650   if (TYPE_CODE (type1) == TYPE_CODE_INT)
 651     {
 652       /* We have a repeat count.  Validate the second value and then
 653          construct a value repeated that many times. */
 654       if (TYPE_CODE (type2) == TYPE_CODE_STRING
 655           || TYPE_CODE (type2) == TYPE_CODE_CHAR)
 656         {
 657           count = longest_to_int (value_as_long (inval1));
 658           inval2len = TYPE_LENGTH (type2);
 659           ptr = (char *) alloca (count * inval2len);
 660           if (TYPE_CODE (type2) == TYPE_CODE_CHAR)
 661             {
 662               inchar = (char) unpack_long (type2,
 663                                            VALUE_CONTENTS (inval2));
 664               for (idx = 0; idx < count; idx++)
 665                 {
 666                   *(ptr + idx) = inchar;
 667                 }
 668             }
 669           else
 670             {
 671               for (idx = 0; idx < count; idx++)
 672                 {
 673                   memcpy (ptr + (idx * inval2len), VALUE_CONTENTS (inval2),
 674                           inval2len);
 675                 }
 676             }
 677           outval = value_string (ptr, count * inval2len);
 678         }
 679       else if (TYPE_CODE (type2) == TYPE_CODE_BITSTRING
 680                || TYPE_CODE (type2) == TYPE_CODE_BOOL)
 681         {
 682           error ("unimplemented support for bitstring/boolean repeats");
 683         }
 684       else
 685         {
 686           error ("can't repeat values of that type");
 687         }
 688     }
 689   else if (TYPE_CODE (type1) == TYPE_CODE_STRING
 690            || TYPE_CODE (type1) == TYPE_CODE_CHAR)
 691     {
 692       /* We have two character strings to concatenate. */
 693       if (TYPE_CODE (type2) != TYPE_CODE_STRING
 694           && TYPE_CODE (type2) != TYPE_CODE_CHAR)
 695         {
 696           error ("Strings can only be concatenated with other strings.");
 697         }
 698       inval1len = TYPE_LENGTH (type1);
 699       inval2len = TYPE_LENGTH (type2);
 700       ptr = (char *) alloca (inval1len + inval2len);
 701       if (TYPE_CODE (type1) == TYPE_CODE_CHAR)
 702         {
 703           *ptr = (char) unpack_long (type1, VALUE_CONTENTS (inval1));
 704         }
 705       else
 706         {
 707           memcpy (ptr, VALUE_CONTENTS (inval1), inval1len);
 708         }
 709       if (TYPE_CODE (type2) == TYPE_CODE_CHAR)
 710         {
 711           *(ptr + inval1len) =
 712             (char) unpack_long (type2, VALUE_CONTENTS (inval2));
 713         }
 714       else
 715         {
 716           memcpy (ptr + inval1len, VALUE_CONTENTS (inval2), inval2len);
 717         }
 718       outval = value_string (ptr, inval1len + inval2len);
 719     }
 720   else if (TYPE_CODE (type1) == TYPE_CODE_BITSTRING
 721            || TYPE_CODE (type1) == TYPE_CODE_BOOL)
 722     {
 723       /* We have two bitstrings to concatenate. */
 724       if (TYPE_CODE (type2) != TYPE_CODE_BITSTRING
 725           && TYPE_CODE (type2) != TYPE_CODE_BOOL)
 726         {
 727           error ("Bitstrings or booleans can only be concatenated with other bitstrings or booleans.");
 728         }
 729       error ("unimplemented support for bitstring/boolean concatenation.");
 730     }
 731   else
 732     {
 733       /* We don't know how to concatenate these operands. */
 734       error ("illegal operands for concatenation.");
 735     }
 736   return (outval);
 737 }
 738 \f
 739
 740
 741 /* Perform a binary operation on two operands which have reasonable
 742    representations as integers or floats.  This includes booleans,
 743    characters, integers, or floats.
 744    Does not support addition and subtraction on pointers;
 745    use value_add or value_sub if you want to handle those possibilities.  */
 746
 747 struct value *
 748 value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
 749 {
 750   struct value *val;
 751   struct type *type1, *type2;
 752
 753   COERCE_REF (arg1);
 754   COERCE_REF (arg2);
 755   COERCE_ENUM (arg1);
 756   COERCE_ENUM (arg2);
 757   type1 = check_typedef (VALUE_TYPE (arg1));
 758   type2 = check_typedef (VALUE_TYPE (arg2));
 759
 760   if ((TYPE_CODE (type1) != TYPE_CODE_FLT
 761        && TYPE_CODE (type1) != TYPE_CODE_CHAR
 762        && TYPE_CODE (type1) != TYPE_CODE_INT
 763        && TYPE_CODE (type1) != TYPE_CODE_BOOL
 764        && TYPE_CODE (type1) != TYPE_CODE_RANGE)
 765       ||
 766       (TYPE_CODE (type2) != TYPE_CODE_FLT
 767        && TYPE_CODE (type2) != TYPE_CODE_CHAR
 768        && TYPE_CODE (type2) != TYPE_CODE_INT
 769        && TYPE_CODE (type2) != TYPE_CODE_BOOL
 770        && TYPE_CODE (type2) != TYPE_CODE_RANGE))
 771     error ("Argument to arithmetic operation not a number or boolean.");
 772
 773   if (TYPE_CODE (type1) == TYPE_CODE_FLT
 774       ||
 775       TYPE_CODE (type2) == TYPE_CODE_FLT)
 776     {
 777       /* FIXME-if-picky-about-floating-accuracy: Should be doing this
 778          in target format.  real.c in GCC probably has the necessary
 779          code.  */
 780       DOUBLEST v1, v2, v = 0;
 781       v1 = value_as_double (arg1);
 782       v2 = value_as_double (arg2);
 783       switch (op)
 784         {
 785         case BINOP_ADD:
 786           v = v1 + v2;
 787           break;
 788
 789         case BINOP_SUB:
 790           v = v1 - v2;
 791           break;
 792
 793         case BINOP_MUL:
 794           v = v1 * v2;
 795           break;
 796
 797         case BINOP_DIV:
 798           v = v1 / v2;
 799           break;
 800
 801         case BINOP_EXP:
 802           v = pow (v1, v2);
 803           if (errno)
 804             error ("Cannot perform exponentiation: %s", safe_strerror (errno));
 805           break;
 806
 807         default:
 808           error ("Integer-only operation on floating point number.");
 809         }
 810
 811       /* If either arg was long double, make sure that value is also long
 812          double.  */
 813
 814       if (TYPE_LENGTH (type1) * 8 > TARGET_DOUBLE_BIT
 815           || TYPE_LENGTH (type2) * 8 > TARGET_DOUBLE_BIT)
 816         val = allocate_value (builtin_type_long_double);
 817       else
 818         val = allocate_value (builtin_type_double);
 819
 820       store_typed_floating (VALUE_CONTENTS_RAW (val), VALUE_TYPE (val), v);
 821     }
 822   else if (TYPE_CODE (type1) == TYPE_CODE_BOOL
 823            &&
 824            TYPE_CODE (type2) == TYPE_CODE_BOOL)
 825     {
 826       LONGEST v1, v2, v = 0;
 827       v1 = value_as_long (arg1);
 828       v2 = value_as_long (arg2);
 829
 830       switch (op)
 831         {
 832         case BINOP_BITWISE_AND:
 833           v = v1 & v2;
 834           break;
 835
 836         case BINOP_BITWISE_IOR:
 837           v = v1 | v2;
 838           break;
 839
 840         case BINOP_BITWISE_XOR:
 841           v = v1 ^ v2;
 842           break;
 843
 844         case BINOP_EQUAL:
 845           v = v1 == v2;
 846           break;
 847
 848         case BINOP_NOTEQUAL:
 849           v = v1 != v2;
 850           break;
 851
 852         default:
 853           error ("Invalid operation on booleans.");
 854         }
 855
 856       val = allocate_value (type1);
 857       store_signed_integer (VALUE_CONTENTS_RAW (val),
 858                             TYPE_LENGTH (type1),
 859                             v);
 860     }
 861   else
 862     /* Integral operations here.  */
 863     /* FIXME:  Also mixed integral/booleans, with result an integer. */
 864     /* FIXME: This implements ANSI C rules (also correct for C++).
 865        What about FORTRAN and (the deleted) chill ?  */
 866     {
 867       unsigned int promoted_len1 = TYPE_LENGTH (type1);
 868       unsigned int promoted_len2 = TYPE_LENGTH (type2);
 869       int is_unsigned1 = TYPE_UNSIGNED (type1);
 870       int is_unsigned2 = TYPE_UNSIGNED (type2);
 871       unsigned int result_len;
 872       int unsigned_operation;
 873
 874       /* Determine type length and signedness after promotion for
 875          both operands.  */
 876       if (promoted_len1 < TYPE_LENGTH (builtin_type_int))
 877         {
 878           is_unsigned1 = 0;
 879           promoted_len1 = TYPE_LENGTH (builtin_type_int);
 880         }
 881       if (promoted_len2 < TYPE_LENGTH (builtin_type_int))
 882         {
 883           is_unsigned2 = 0;
 884           promoted_len2 = TYPE_LENGTH (builtin_type_int);
 885         }
 886
 887       /* Determine type length of the result, and if the operation should
 888          be done unsigned.
 889          Use the signedness of the operand with the greater length.
 890          If both operands are of equal length, use unsigned operation
 891          if one of the operands is unsigned.  */
 892       if (promoted_len1 > promoted_len2)
 893         {
 894           unsigned_operation = is_unsigned1;
 895           result_len = promoted_len1;
 896         }
 897       else if (promoted_len2 > promoted_len1)
 898         {
 899           unsigned_operation = is_unsigned2;
 900           result_len = promoted_len2;
 901         }
 902       else
 903         {
 904           unsigned_operation = is_unsigned1 || is_unsigned2;
 905           result_len = promoted_len1;
 906         }
 907
 908       if (unsigned_operation)
 909         {
 910           ULONGEST v1, v2, v = 0;
 911           v1 = (ULONGEST) value_as_long (arg1);
 912           v2 = (ULONGEST) value_as_long (arg2);
 913
 914           /* Truncate values to the type length of the result.  */
 915           if (result_len < sizeof (ULONGEST))
 916             {
 917               v1 &= ((LONGEST) 1 << HOST_CHAR_BIT * result_len) - 1;
 918               v2 &= ((LONGEST) 1 << HOST_CHAR_BIT * result_len) - 1;
 919             }
 920
 921           switch (op)
 922             {
 923             case BINOP_ADD:
 924               v = v1 + v2;
 925               break;
 926
 927             case BINOP_SUB:
 928               v = v1 - v2;
 929               break;
 930
 931             case BINOP_MUL:
 932               v = v1 * v2;
 933               break;
 934
 935             case BINOP_DIV:
 936               v = v1 / v2;
 937               break;
 938
 939             case BINOP_EXP:
 940               v = pow (v1, v2);
 941               if (errno)
 942                 error ("Cannot perform exponentiation: %s", safe_strerror (errno));
 943               break;
 944
 945             case BINOP_REM:
 946               v = v1 % v2;
 947               break;
 948
 949             case BINOP_MOD:
 950               /* Knuth 1.2.4, integer only.  Note that unlike the C '%' op,
 951                  v1 mod 0 has a defined value, v1. */
 952               if (v2 == 0)
 953                 {
 954                   v = v1;
 955                 }
 956               else
 957                 {
 958                   v = v1 / v2;
 959                   /* Note floor(v1/v2) == v1/v2 for unsigned. */
 960                   v = v1 - (v2 * v);
 961                 }
 962               break;
 963
 964             case BINOP_LSH:
 965               v = v1 << v2;
 966               break;
 967
 968             case BINOP_RSH:
 969               v = v1 >> v2;
 970               break;
 971
 972             case BINOP_BITWISE_AND:
 973               v = v1 & v2;
 974               break;
 975
 976             case BINOP_BITWISE_IOR:
 977               v = v1 | v2;
 978               break;
 979
 980             case BINOP_BITWISE_XOR:
 981               v = v1 ^ v2;
 982               break;
 983
 984             case BINOP_LOGICAL_AND:
 985               v = v1 && v2;
 986               break;
 987
 988             case BINOP_LOGICAL_OR:
 989               v = v1 || v2;
 990               break;
 991
 992             case BINOP_MIN:
 993               v = v1 < v2 ? v1 : v2;
 994               break;
 995
 996             case BINOP_MAX:
 997               v = v1 > v2 ? v1 : v2;
 998               break;
 999
1000             case BINOP_EQUAL:
1001               v = v1 == v2;
1002               break;
1003
1004             case BINOP_NOTEQUAL:
1005               v = v1 != v2;
1006               break;
1007
1008             case BINOP_LESS:
1009               v = v1 < v2;
1010               break;
1011
1012             default:
1013               error ("Invalid binary operation on numbers.");
1014             }
1015
1016           /* This is a kludge to get around the fact that we don't
1017              know how to determine the result type from the types of
1018              the operands.  (I'm not really sure how much we feel the
1019              need to duplicate the exact rules of the current
1020              language.  They can get really hairy.  But not to do so
1021              makes it hard to document just what we *do* do).  */
1022
1023           /* Can't just call init_type because we wouldn't know what
1024              name to give the type.  */
1025           val = allocate_value
1026             (result_len > TARGET_LONG_BIT / HOST_CHAR_BIT
1027              ? builtin_type_unsigned_long_long
1028              : builtin_type_unsigned_long);
1029           store_unsigned_integer (VALUE_CONTENTS_RAW (val),
1030                                   TYPE_LENGTH (VALUE_TYPE (val)),
1031                                   v);
1032         }
1033       else
1034         {
1035           LONGEST v1, v2, v = 0;
1036           v1 = value_as_long (arg1);
1037           v2 = value_as_long (arg2);
1038
1039           switch (op)
1040             {
1041             case BINOP_ADD:
1042               v = v1 + v2;
1043               break;
1044
1045             case BINOP_SUB:
1046               v = v1 - v2;
1047               break;
1048
1049             case BINOP_MUL:
1050               v = v1 * v2;
1051               break;
1052
1053             case BINOP_DIV:
1054               v = v1 / v2;
1055               break;
1056
1057             case BINOP_EXP:
1058               v = pow (v1, v2);
1059               if (errno)
1060                 error ("Cannot perform exponentiation: %s", safe_strerror (errno));
1061               break;
1062
1063             case BINOP_REM:
1064               v = v1 % v2;
1065               break;
1066
1067             case BINOP_MOD:
1068               /* Knuth 1.2.4, integer only.  Note that unlike the C '%' op,
1069                  X mod 0 has a defined value, X. */
1070               if (v2 == 0)
1071                 {
1072                   v = v1;
1073                 }
1074               else
1075                 {
1076                   v = v1 / v2;
1077                   /* Compute floor. */
1078                   if (TRUNCATION_TOWARDS_ZERO && (v < 0) && ((v1 % v2) != 0))
1079                     {
1080                       v--;
1081                     }
1082                   v = v1 - (v2 * v);
1083                 }
1084               break;
1085
1086             case BINOP_LSH:
1087               v = v1 << v2;
1088               break;
1089
1090             case BINOP_RSH:
1091               v = v1 >> v2;
1092               break;
1093
1094             case BINOP_BITWISE_AND:
1095               v = v1 & v2;
1096               break;
1097
1098             case BINOP_BITWISE_IOR:
1099               v = v1 | v2;
1100               break;
1101
1102             case BINOP_BITWISE_XOR:
1103               v = v1 ^ v2;
1104               break;
1105
1106             case BINOP_LOGICAL_AND:
1107               v = v1 && v2;
1108               break;
1109
1110             case BINOP_LOGICAL_OR:
1111               v = v1 || v2;
1112               break;
1113
1114             case BINOP_MIN:
1115               v = v1 < v2 ? v1 : v2;
1116               break;
1117
1118             case BINOP_MAX:
1119               v = v1 > v2 ? v1 : v2;
1120               break;
1121
1122             case BINOP_EQUAL:
1123               v = v1 == v2;
1124               break;
1125
1126             case BINOP_LESS:
1127               v = v1 < v2;
1128               break;
1129
1130             default:
1131               error ("Invalid binary operation on numbers.");
1132             }
1133
1134           /* This is a kludge to get around the fact that we don't
1135              know how to determine the result type from the types of
1136              the operands.  (I'm not really sure how much we feel the
1137              need to duplicate the exact rules of the current
1138              language.  They can get really hairy.  But not to do so
1139              makes it hard to document just what we *do* do).  */
1140
1141           /* Can't just call init_type because we wouldn't know what
1142              name to give the type.  */
1143           val = allocate_value
1144             (result_len > TARGET_LONG_BIT / HOST_CHAR_BIT
1145              ? builtin_type_long_long
1146              : builtin_type_long);
1147           store_signed_integer (VALUE_CONTENTS_RAW (val),
1148                                 TYPE_LENGTH (VALUE_TYPE (val)),
1149                                 v);
1150         }
1151     }
1152
1153   return val;
1154 }
1155 \f
1156 /* Simulate the C operator ! -- return 1 if ARG1 contains zero.  */
1157
1158 int
1159 value_logical_not (struct value *arg1)
1160 {
1161   int len;
1162   char *p;
1163   struct type *type1;
1164
1165   COERCE_NUMBER (arg1);
1166   type1 = check_typedef (VALUE_TYPE (arg1));
1167
1168   if (TYPE_CODE (type1) == TYPE_CODE_FLT)
1169     return 0 == value_as_double (arg1);
1170
1171   len = TYPE_LENGTH (type1);
1172   p = VALUE_CONTENTS (arg1);
1173
1174   while (--len >= 0)
1175     {
1176       if (*p++)
1177         break;
1178     }
1179
1180   return len < 0;
1181 }
1182
1183 /* Perform a comparison on two string values (whose content are not
1184    necessarily null terminated) based on their length */
1185
1186 static int
1187 value_strcmp (struct value *arg1, struct value *arg2)
1188 {
1189   int len1 = TYPE_LENGTH (VALUE_TYPE (arg1));
1190   int len2 = TYPE_LENGTH (VALUE_TYPE (arg2));
1191   char *s1 = VALUE_CONTENTS (arg1);
1192   char *s2 = VALUE_CONTENTS (arg2);
1193   int i, len = len1 < len2 ? len1 : len2;
1194
1195   for (i = 0; i < len; i++)
1196     {
1197       if (s1[i] < s2[i])
1198         return -1;
1199       else if (s1[i] > s2[i])
1200         return 1;
1201       else
1202         continue;
1203     }
1204
1205   if (len1 < len2)
1206     return -1;
1207   else if (len1 > len2)
1208     return 1;
1209   else
1210     return 0;
1211 }
1212
1213 /* Simulate the C operator == by returning a 1
1214    iff ARG1 and ARG2 have equal contents.  */
1215
1216 int
1217 value_equal (struct value *arg1, struct value *arg2)
1218 {
1219   int len;
1220   char *p1, *p2;
1221   struct type *type1, *type2;
1222   enum type_code code1;
1223   enum type_code code2;
1224
1225   COERCE_NUMBER (arg1);
1226   COERCE_NUMBER (arg2);
1227
1228   type1 = check_typedef (VALUE_TYPE (arg1));
1229   type2 = check_typedef (VALUE_TYPE (arg2));
1230   code1 = TYPE_CODE (type1);
1231   code2 = TYPE_CODE (type2);
1232
1233   if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_BOOL) &&
1234       (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL))
1235     return longest_to_int (value_as_long (value_binop (arg1, arg2,
1236                                                        BINOP_EQUAL)));
1237   else if ((code1 == TYPE_CODE_FLT || code1 == TYPE_CODE_INT || code1 == TYPE_CODE_BOOL)
1238            && (code2 == TYPE_CODE_FLT || code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL))
1239     return value_as_double (arg1) == value_as_double (arg2);
1240
1241   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
1242      is bigger.  */
1243   else if (code1 == TYPE_CODE_PTR && (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL))
1244     return value_as_address (arg1) == (CORE_ADDR) value_as_long (arg2);
1245   else if (code2 == TYPE_CODE_PTR && (code1 == TYPE_CODE_INT || code1 == TYPE_CODE_BOOL))
1246     return (CORE_ADDR) value_as_long (arg1) == value_as_address (arg2);
1247
1248   else if (code1 == code2
1249            && ((len = (int) TYPE_LENGTH (type1))
1250                == (int) TYPE_LENGTH (type2)))
1251     {
1252       p1 = VALUE_CONTENTS (arg1);
1253       p2 = VALUE_CONTENTS (arg2);
1254       while (--len >= 0)
1255         {
1256           if (*p1++ != *p2++)
1257             break;
1258         }
1259       return len < 0;
1260     }
1261   else if (code1 == TYPE_CODE_STRING && code2 == TYPE_CODE_STRING)
1262     {
1263       return value_strcmp (arg1, arg2) == 0;
1264     }
1265   else
1266     {
1267       error ("Invalid type combination in equality test.");
1268       return 0;                 /* For lint -- never reached */
1269     }
1270 }
1271
1272 /* Simulate the C operator < by returning 1
1273    iff ARG1's contents are less than ARG2's.  */
1274
1275 int
1276 value_less (struct value *arg1, struct value *arg2)
1277 {
1278   enum type_code code1;
1279   enum type_code code2;
1280   struct type *type1, *type2;
1281
1282   COERCE_NUMBER (arg1);
1283   COERCE_NUMBER (arg2);
1284
1285   type1 = check_typedef (VALUE_TYPE (arg1));
1286   type2 = check_typedef (VALUE_TYPE (arg2));
1287   code1 = TYPE_CODE (type1);
1288   code2 = TYPE_CODE (type2);
1289
1290   if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_BOOL) &&
1291       (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL))
1292     return longest_to_int (value_as_long (value_binop (arg1, arg2,
1293                                                        BINOP_LESS)));
1294   else if ((code1 == TYPE_CODE_FLT || code1 == TYPE_CODE_INT || code1 == TYPE_CODE_BOOL)
1295            && (code2 == TYPE_CODE_FLT || code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL))
1296     return value_as_double (arg1) < value_as_double (arg2);
1297   else if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
1298     return value_as_address (arg1) < value_as_address (arg2);
1299
1300   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
1301      is bigger.  */
1302   else if (code1 == TYPE_CODE_PTR && (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL))
1303     return value_as_address (arg1) < (CORE_ADDR) value_as_long (arg2);
1304   else if (code2 == TYPE_CODE_PTR && (code1 == TYPE_CODE_INT || code1 == TYPE_CODE_BOOL))
1305     return (CORE_ADDR) value_as_long (arg1) < value_as_address (arg2);
1306   else if (code1 == TYPE_CODE_STRING && code2 == TYPE_CODE_STRING)
1307     return value_strcmp (arg1, arg2) < 0;
1308   else
1309     {
1310       error ("Invalid type combination in ordering comparison.");
1311       return 0;
1312     }
1313 }
1314 \f
1315 /* The unary operators - and ~.  Both free the argument ARG1.  */
1316
1317 struct value *
1318 value_neg (struct value *arg1)
1319 {
1320   struct type *type;
1321   struct type *result_type = VALUE_TYPE (arg1);
1322
1323   COERCE_REF (arg1);
1324   COERCE_ENUM (arg1);
1325
1326   type = check_typedef (VALUE_TYPE (arg1));
1327
1328   if (TYPE_CODE (type) == TYPE_CODE_FLT)
1329     return value_from_double (result_type, -value_as_double (arg1));
1330   else if (TYPE_CODE (type) == TYPE_CODE_INT || TYPE_CODE (type) == TYPE_CODE_BOOL)
1331     {
1332       /* Perform integral promotion for ANSI C/C++.  FIXME: What about
1333          FORTRAN and (the deleted) chill ?  */
1334       if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
1335         result_type = builtin_type_int;
1336
1337       return value_from_longest (result_type, -value_as_long (arg1));
1338     }
1339   else
1340     {
1341       error ("Argument to negate operation not a number.");
1342       return 0;                 /* For lint -- never reached */
1343     }
1344 }
1345
1346 struct value *
1347 value_complement (struct value *arg1)
1348 {
1349   struct type *type;
1350   struct type *result_type = VALUE_TYPE (arg1);
1351   int typecode;
1352
1353   COERCE_REF (arg1);
1354   COERCE_ENUM (arg1);
1355
1356   type = check_typedef (VALUE_TYPE (arg1));
1357
1358   typecode = TYPE_CODE (type);
1359   if ((typecode != TYPE_CODE_INT) && (typecode != TYPE_CODE_BOOL))
1360     error ("Argument to complement operation not an integer or boolean.");
1361
1362   /* Perform integral promotion for ANSI C/C++.
1363      FIXME: What about FORTRAN ?  */
1364   if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
1365     result_type = builtin_type_int;
1366
1367   return value_from_longest (result_type, ~value_as_long (arg1));
1368 }
1369 \f
1370 /* The INDEX'th bit of SET value whose VALUE_TYPE is TYPE,
1371    and whose VALUE_CONTENTS is valaddr.
1372    Return -1 if out of range, -2 other error. */
1373
1374 int
1375 value_bit_index (struct type *type, char *valaddr, int index)
1376 {
1377   LONGEST low_bound, high_bound;
1378   LONGEST word;
1379   unsigned rel_index;
1380   struct type *range = TYPE_FIELD_TYPE (type, 0);
1381   if (get_discrete_bounds (range, &low_bound, &high_bound) < 0)
1382     return -2;
1383   if (index < low_bound || index > high_bound)
1384     return -1;
1385   rel_index = index - low_bound;
1386   word = unpack_long (builtin_type_unsigned_char,
1387                       valaddr + (rel_index / TARGET_CHAR_BIT));
1388   rel_index %= TARGET_CHAR_BIT;
1389   if (BITS_BIG_ENDIAN)
1390     rel_index = TARGET_CHAR_BIT - 1 - rel_index;
1391   return (word >> rel_index) & 1;
1392 }
1393
1394 struct value *
1395 value_in (struct value *element, struct value *set)
1396 {
1397   int member;
1398   struct type *settype = check_typedef (VALUE_TYPE (set));
1399   struct type *eltype = check_typedef (VALUE_TYPE (element));
1400   if (TYPE_CODE (eltype) == TYPE_CODE_RANGE)
1401     eltype = TYPE_TARGET_TYPE (eltype);
1402   if (TYPE_CODE (settype) != TYPE_CODE_SET)
1403     error ("Second argument of 'IN' has wrong type");
1404   if (TYPE_CODE (eltype) != TYPE_CODE_INT
1405       && TYPE_CODE (eltype) != TYPE_CODE_CHAR
1406       && TYPE_CODE (eltype) != TYPE_CODE_ENUM
1407       && TYPE_CODE (eltype) != TYPE_CODE_BOOL)
1408     error ("First argument of 'IN' has wrong type");
1409   member = value_bit_index (settype, VALUE_CONTENTS (set),
1410                             value_as_long (element));
1411   if (member < 0)
1412     error ("First argument of 'IN' not in range");
1413   return value_from_longest (LA_BOOL_TYPE, member);
1414 }
1415
1416 void
1417 _initialize_valarith (void)
1418 {
1419 }