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, 2004 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   arg1 = coerce_array (arg1);
  95   arg2 = coerce_array (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       (is_integral_type (type1) || is_integral_type (type2)))
 103     /* Exactly one argument is a pointer, and one is an integer.  */
 104     {
 105       struct value *retval;
 106
 107       if (TYPE_CODE (type1) == TYPE_CODE_PTR)
 108         {
 109           valptr = arg1;
 110           valint = arg2;
 111           valptrtype = type1;
 112         }
 113       else
 114         {
 115           valptr = arg2;
 116           valint = arg1;
 117           valptrtype = type2;
 118         }
 119
 120       sz = find_size_for_pointer_math (valptrtype);
 121
 122       retval = value_from_pointer (valptrtype,
 123                                    value_as_address (valptr)
 124                                    + (sz * value_as_long (valint)));
 125       return retval;
 126     }
 127
 128   return value_binop (arg1, arg2, BINOP_ADD);
 129 }
 130
 131 struct value *
 132 value_sub (struct value *arg1, struct value *arg2)
 133 {
 134   struct type *type1, *type2;
 135   arg1 = coerce_array (arg1);
 136   arg2 = coerce_array (arg2);
 137   type1 = check_typedef (value_type (arg1));
 138   type2 = check_typedef (value_type (arg2));
 139
 140   if (TYPE_CODE (type1) == TYPE_CODE_PTR)
 141     {
 142       if (is_integral_type (type2))
 143         {
 144           /* pointer - integer.  */
 145           LONGEST sz = find_size_for_pointer_math (type1);
 146
 147           return value_from_pointer (type1,
 148                                      (value_as_address (arg1)
 149                                       - (sz * value_as_long (arg2))));
 150         }
 151       else if (TYPE_CODE (type2) == TYPE_CODE_PTR
 152                && TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type1)))
 153                == TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type2))))
 154         {
 155           /* pointer to <type x> - pointer to <type x>.  */
 156           LONGEST sz = TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type1)));
 157           return value_from_longest
 158             (builtin_type_long, /* FIXME -- should be ptrdiff_t */
 159              (value_as_long (arg1) - value_as_long (arg2)) / sz);
 160         }
 161       else
 162         {
 163           error ("\
 164 First argument of `-' is a pointer and second argument is neither\n\
 165 an integer nor a pointer of the same type.");
 166         }
 167     }
 168
 169   return value_binop (arg1, arg2, BINOP_SUB);
 170 }
 171
 172 /* Return the value of ARRAY[IDX].
 173    See comments in value_coerce_array() for rationale for reason for
 174    doing lower bounds adjustment here rather than there.
 175    FIXME:  Perhaps we should validate that the index is valid and if
 176    verbosity is set, warn about invalid indices (but still use them). */
 177
 178 struct value *
 179 value_subscript (struct value *array, struct value *idx)
 180 {
 181   struct value *bound;
 182   int c_style = current_language->c_style_arrays;
 183   struct type *tarray;
 184
 185   array = coerce_ref (array);
 186   tarray = check_typedef (value_type (array));
 187
 188   if (TYPE_CODE (tarray) == TYPE_CODE_ARRAY
 189       || TYPE_CODE (tarray) == TYPE_CODE_STRING)
 190     {
 191       struct type *range_type = TYPE_INDEX_TYPE (tarray);
 192       LONGEST lowerbound, upperbound;
 193       get_discrete_bounds (range_type, &lowerbound, &upperbound);
 194
 195       if (VALUE_LVAL (array) != lval_memory)
 196         return value_subscripted_rvalue (array, idx, lowerbound);
 197
 198       if (c_style == 0)
 199         {
 200           LONGEST index = value_as_long (idx);
 201           if (index >= lowerbound && index <= upperbound)
 202             return value_subscripted_rvalue (array, idx, lowerbound);
 203           /* Emit warning unless we have an array of unknown size.
 204              An array of unknown size has lowerbound 0 and upperbound -1.  */
 205           if (upperbound > -1)
 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       v->bitpos = bit_index;
 237       v->bitsize = 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       v->offset = 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_REGNUM (v) = VALUE_REGNUM (array);
 281   v->offset = 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   arg1 = coerce_ref (arg1);
 350   arg2 = coerce_ref (arg2);
 351   arg1 = coerce_enum (arg1);
 352   arg2 = 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   arg1 = coerce_ref (arg1);
 512   arg1 = 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   /* First figure out if we are dealing with two values to be concatenated
 626      or a repeat count and a value to be repeated.  INVAL1 is set to the
 627      first of two concatenated values, or the repeat count.  INVAL2 is set
 628      to the second of the two concatenated values or the value to be
 629      repeated. */
 630
 631   if (TYPE_CODE (type2) == TYPE_CODE_INT)
 632     {
 633       struct type *tmp = type1;
 634       type1 = tmp;
 635       tmp = type2;
 636       inval1 = arg2;
 637       inval2 = arg1;
 638     }
 639   else
 640     {
 641       inval1 = arg1;
 642       inval2 = arg2;
 643     }
 644
 645   /* Now process the input values. */
 646
 647   if (TYPE_CODE (type1) == TYPE_CODE_INT)
 648     {
 649       /* We have a repeat count.  Validate the second value and then
 650          construct a value repeated that many times. */
 651       if (TYPE_CODE (type2) == TYPE_CODE_STRING
 652           || TYPE_CODE (type2) == TYPE_CODE_CHAR)
 653         {
 654           count = longest_to_int (value_as_long (inval1));
 655           inval2len = TYPE_LENGTH (type2);
 656           ptr = (char *) alloca (count * inval2len);
 657           if (TYPE_CODE (type2) == TYPE_CODE_CHAR)
 658             {
 659               inchar = (char) unpack_long (type2,
 660                                            VALUE_CONTENTS (inval2));
 661               for (idx = 0; idx < count; idx++)
 662                 {
 663                   *(ptr + idx) = inchar;
 664                 }
 665             }
 666           else
 667             {
 668               for (idx = 0; idx < count; idx++)
 669                 {
 670                   memcpy (ptr + (idx * inval2len), VALUE_CONTENTS (inval2),
 671                           inval2len);
 672                 }
 673             }
 674           outval = value_string (ptr, count * inval2len);
 675         }
 676       else if (TYPE_CODE (type2) == TYPE_CODE_BITSTRING
 677                || TYPE_CODE (type2) == TYPE_CODE_BOOL)
 678         {
 679           error ("unimplemented support for bitstring/boolean repeats");
 680         }
 681       else
 682         {
 683           error ("can't repeat values of that type");
 684         }
 685     }
 686   else if (TYPE_CODE (type1) == TYPE_CODE_STRING
 687            || TYPE_CODE (type1) == TYPE_CODE_CHAR)
 688     {
 689       /* We have two character strings to concatenate. */
 690       if (TYPE_CODE (type2) != TYPE_CODE_STRING
 691           && TYPE_CODE (type2) != TYPE_CODE_CHAR)
 692         {
 693           error ("Strings can only be concatenated with other strings.");
 694         }
 695       inval1len = TYPE_LENGTH (type1);
 696       inval2len = TYPE_LENGTH (type2);
 697       ptr = (char *) alloca (inval1len + inval2len);
 698       if (TYPE_CODE (type1) == TYPE_CODE_CHAR)
 699         {
 700           *ptr = (char) unpack_long (type1, VALUE_CONTENTS (inval1));
 701         }
 702       else
 703         {
 704           memcpy (ptr, VALUE_CONTENTS (inval1), inval1len);
 705         }
 706       if (TYPE_CODE (type2) == TYPE_CODE_CHAR)
 707         {
 708           *(ptr + inval1len) =
 709             (char) unpack_long (type2, VALUE_CONTENTS (inval2));
 710         }
 711       else
 712         {
 713           memcpy (ptr + inval1len, VALUE_CONTENTS (inval2), inval2len);
 714         }
 715       outval = value_string (ptr, inval1len + inval2len);
 716     }
 717   else if (TYPE_CODE (type1) == TYPE_CODE_BITSTRING
 718            || TYPE_CODE (type1) == TYPE_CODE_BOOL)
 719     {
 720       /* We have two bitstrings to concatenate. */
 721       if (TYPE_CODE (type2) != TYPE_CODE_BITSTRING
 722           && TYPE_CODE (type2) != TYPE_CODE_BOOL)
 723         {
 724           error ("Bitstrings or booleans can only be concatenated with other bitstrings or booleans.");
 725         }
 726       error ("unimplemented support for bitstring/boolean concatenation.");
 727     }
 728   else
 729     {
 730       /* We don't know how to concatenate these operands. */
 731       error ("illegal operands for concatenation.");
 732     }
 733   return (outval);
 734 }
 735 \f
 736
 737
 738 /* Perform a binary operation on two operands which have reasonable
 739    representations as integers or floats.  This includes booleans,
 740    characters, integers, or floats.
 741    Does not support addition and subtraction on pointers;
 742    use value_add or value_sub if you want to handle those possibilities.  */
 743
 744 struct value *
 745 value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
 746 {
 747   struct value *val;
 748   struct type *type1, *type2;
 749
 750   arg1 = coerce_ref (arg1);
 751   arg2 = coerce_ref (arg2);
 752   type1 = check_typedef (value_type (arg1));
 753   type2 = check_typedef (value_type (arg2));
 754
 755   if ((TYPE_CODE (type1) != TYPE_CODE_FLT && !is_integral_type (type1))
 756       ||
 757       (TYPE_CODE (type2) != TYPE_CODE_FLT && !is_integral_type (type2)))
 758     error ("Argument to arithmetic operation not a number or boolean.");
 759
 760   if (TYPE_CODE (type1) == TYPE_CODE_FLT
 761       ||
 762       TYPE_CODE (type2) == TYPE_CODE_FLT)
 763     {
 764       /* FIXME-if-picky-about-floating-accuracy: Should be doing this
 765          in target format.  real.c in GCC probably has the necessary
 766          code.  */
 767       DOUBLEST v1, v2, v = 0;
 768       v1 = value_as_double (arg1);
 769       v2 = value_as_double (arg2);
 770       switch (op)
 771         {
 772         case BINOP_ADD:
 773           v = v1 + v2;
 774           break;
 775
 776         case BINOP_SUB:
 777           v = v1 - v2;
 778           break;
 779
 780         case BINOP_MUL:
 781           v = v1 * v2;
 782           break;
 783
 784         case BINOP_DIV:
 785           v = v1 / v2;
 786           break;
 787
 788         case BINOP_EXP:
 789           v = pow (v1, v2);
 790           if (errno)
 791             error ("Cannot perform exponentiation: %s", safe_strerror (errno));
 792           break;
 793
 794         default:
 795           error ("Integer-only operation on floating point number.");
 796         }
 797
 798       /* If either arg was long double, make sure that value is also long
 799          double.  */
 800
 801       if (TYPE_LENGTH (type1) * 8 > TARGET_DOUBLE_BIT
 802           || TYPE_LENGTH (type2) * 8 > TARGET_DOUBLE_BIT)
 803         val = allocate_value (builtin_type_long_double);
 804       else
 805         val = allocate_value (builtin_type_double);
 806
 807       store_typed_floating (VALUE_CONTENTS_RAW (val), value_type (val), v);
 808     }
 809   else if (TYPE_CODE (type1) == TYPE_CODE_BOOL
 810            &&
 811            TYPE_CODE (type2) == TYPE_CODE_BOOL)
 812     {
 813       LONGEST v1, v2, v = 0;
 814       v1 = value_as_long (arg1);
 815       v2 = value_as_long (arg2);
 816
 817       switch (op)
 818         {
 819         case BINOP_BITWISE_AND:
 820           v = v1 & v2;
 821           break;
 822
 823         case BINOP_BITWISE_IOR:
 824           v = v1 | v2;
 825           break;
 826
 827         case BINOP_BITWISE_XOR:
 828           v = v1 ^ v2;
 829           break;
 830
 831         case BINOP_EQUAL:
 832           v = v1 == v2;
 833           break;
 834
 835         case BINOP_NOTEQUAL:
 836           v = v1 != v2;
 837           break;
 838
 839         default:
 840           error ("Invalid operation on booleans.");
 841         }
 842
 843       val = allocate_value (type1);
 844       store_signed_integer (VALUE_CONTENTS_RAW (val),
 845                             TYPE_LENGTH (type1),
 846                             v);
 847     }
 848   else
 849     /* Integral operations here.  */
 850     /* FIXME:  Also mixed integral/booleans, with result an integer. */
 851     /* FIXME: This implements ANSI C rules (also correct for C++).
 852        What about FORTRAN and (the deleted) chill ?  */
 853     {
 854       unsigned int promoted_len1 = TYPE_LENGTH (type1);
 855       unsigned int promoted_len2 = TYPE_LENGTH (type2);
 856       int is_unsigned1 = TYPE_UNSIGNED (type1);
 857       int is_unsigned2 = TYPE_UNSIGNED (type2);
 858       unsigned int result_len;
 859       int unsigned_operation;
 860
 861       /* Determine type length and signedness after promotion for
 862          both operands.  */
 863       if (promoted_len1 < TYPE_LENGTH (builtin_type_int))
 864         {
 865           is_unsigned1 = 0;
 866           promoted_len1 = TYPE_LENGTH (builtin_type_int);
 867         }
 868       if (promoted_len2 < TYPE_LENGTH (builtin_type_int))
 869         {
 870           is_unsigned2 = 0;
 871           promoted_len2 = TYPE_LENGTH (builtin_type_int);
 872         }
 873
 874       /* Determine type length of the result, and if the operation should
 875          be done unsigned.
 876          Use the signedness of the operand with the greater length.
 877          If both operands are of equal length, use unsigned operation
 878          if one of the operands is unsigned.  */
 879       if (promoted_len1 > promoted_len2)
 880         {
 881           unsigned_operation = is_unsigned1;
 882           result_len = promoted_len1;
 883         }
 884       else if (promoted_len2 > promoted_len1)
 885         {
 886           unsigned_operation = is_unsigned2;
 887           result_len = promoted_len2;
 888         }
 889       else
 890         {
 891           unsigned_operation = is_unsigned1 || is_unsigned2;
 892           result_len = promoted_len1;
 893         }
 894
 895       if (unsigned_operation)
 896         {
 897           ULONGEST v1, v2, v = 0;
 898           v1 = (ULONGEST) value_as_long (arg1);
 899           v2 = (ULONGEST) value_as_long (arg2);
 900
 901           /* Truncate values to the type length of the result.  */
 902           if (result_len < sizeof (ULONGEST))
 903             {
 904               v1 &= ((LONGEST) 1 << HOST_CHAR_BIT * result_len) - 1;
 905               v2 &= ((LONGEST) 1 << HOST_CHAR_BIT * result_len) - 1;
 906             }
 907
 908           switch (op)
 909             {
 910             case BINOP_ADD:
 911               v = v1 + v2;
 912               break;
 913
 914             case BINOP_SUB:
 915               v = v1 - v2;
 916               break;
 917
 918             case BINOP_MUL:
 919               v = v1 * v2;
 920               break;
 921
 922             case BINOP_DIV:
 923               v = v1 / v2;
 924               break;
 925
 926             case BINOP_EXP:
 927               v = pow (v1, v2);
 928               if (errno)
 929                 error ("Cannot perform exponentiation: %s", safe_strerror (errno));
 930               break;
 931
 932             case BINOP_REM:
 933               v = v1 % v2;
 934               break;
 935
 936             case BINOP_MOD:
 937               /* Knuth 1.2.4, integer only.  Note that unlike the C '%' op,
 938                  v1 mod 0 has a defined value, v1. */
 939               if (v2 == 0)
 940                 {
 941                   v = v1;
 942                 }
 943               else
 944                 {
 945                   v = v1 / v2;
 946                   /* Note floor(v1/v2) == v1/v2 for unsigned. */
 947                   v = v1 - (v2 * v);
 948                 }
 949               break;
 950
 951             case BINOP_LSH:
 952               v = v1 << v2;
 953               break;
 954
 955             case BINOP_RSH:
 956               v = v1 >> v2;
 957               break;
 958
 959             case BINOP_BITWISE_AND:
 960               v = v1 & v2;
 961               break;
 962
 963             case BINOP_BITWISE_IOR:
 964               v = v1 | v2;
 965               break;
 966
 967             case BINOP_BITWISE_XOR:
 968               v = v1 ^ v2;
 969               break;
 970
 971             case BINOP_LOGICAL_AND:
 972               v = v1 && v2;
 973               break;
 974
 975             case BINOP_LOGICAL_OR:
 976               v = v1 || v2;
 977               break;
 978
 979             case BINOP_MIN:
 980               v = v1 < v2 ? v1 : v2;
 981               break;
 982
 983             case BINOP_MAX:
 984               v = v1 > v2 ? v1 : v2;
 985               break;
 986
 987             case BINOP_EQUAL:
 988               v = v1 == v2;
 989               break;
 990
 991             case BINOP_NOTEQUAL:
 992               v = v1 != v2;
 993               break;
 994
 995             case BINOP_LESS:
 996               v = v1 < v2;
 997               break;
 998
 999             default:
1000               error ("Invalid binary operation on numbers.");
1001             }
1002
1003           /* This is a kludge to get around the fact that we don't
1004              know how to determine the result type from the types of
1005              the operands.  (I'm not really sure how much we feel the
1006              need to duplicate the exact rules of the current
1007              language.  They can get really hairy.  But not to do so
1008              makes it hard to document just what we *do* do).  */
1009
1010           /* Can't just call init_type because we wouldn't know what
1011              name to give the type.  */
1012           val = allocate_value
1013             (result_len > TARGET_LONG_BIT / HOST_CHAR_BIT
1014              ? builtin_type_unsigned_long_long
1015              : builtin_type_unsigned_long);
1016           store_unsigned_integer (VALUE_CONTENTS_RAW (val),
1017                                   TYPE_LENGTH (value_type (val)),
1018                                   v);
1019         }
1020       else
1021         {
1022           LONGEST v1, v2, v = 0;
1023           v1 = value_as_long (arg1);
1024           v2 = value_as_long (arg2);
1025
1026           switch (op)
1027             {
1028             case BINOP_ADD:
1029               v = v1 + v2;
1030               break;
1031
1032             case BINOP_SUB:
1033               v = v1 - v2;
1034               break;
1035
1036             case BINOP_MUL:
1037               v = v1 * v2;
1038               break;
1039
1040             case BINOP_DIV:
1041               if (v2 != 0)
1042                 v = v1 / v2;
1043               else
1044                 error ("Division by zero");
1045               break;
1046
1047             case BINOP_EXP:
1048               v = pow (v1, v2);
1049               if (errno)
1050                 error ("Cannot perform exponentiation: %s", safe_strerror (errno));
1051               break;
1052
1053             case BINOP_REM:
1054               if (v2 != 0)
1055                 v = v1 % v2;
1056               else
1057                 error ("Division by zero");
1058               break;
1059
1060             case BINOP_MOD:
1061               /* Knuth 1.2.4, integer only.  Note that unlike the C '%' op,
1062                  X mod 0 has a defined value, X. */
1063               if (v2 == 0)
1064                 {
1065                   v = v1;
1066                 }
1067               else
1068                 {
1069                   v = v1 / v2;
1070                   /* Compute floor. */
1071                   if (TRUNCATION_TOWARDS_ZERO && (v < 0) && ((v1 % v2) != 0))
1072                     {
1073                       v--;
1074                     }
1075                   v = v1 - (v2 * v);
1076                 }
1077               break;
1078
1079             case BINOP_LSH:
1080               v = v1 << v2;
1081               break;
1082
1083             case BINOP_RSH:
1084               v = v1 >> v2;
1085               break;
1086
1087             case BINOP_BITWISE_AND:
1088               v = v1 & v2;
1089               break;
1090
1091             case BINOP_BITWISE_IOR:
1092               v = v1 | v2;
1093               break;
1094
1095             case BINOP_BITWISE_XOR:
1096               v = v1 ^ v2;
1097               break;
1098
1099             case BINOP_LOGICAL_AND:
1100               v = v1 && v2;
1101               break;
1102
1103             case BINOP_LOGICAL_OR:
1104               v = v1 || v2;
1105               break;
1106
1107             case BINOP_MIN:
1108               v = v1 < v2 ? v1 : v2;
1109               break;
1110
1111             case BINOP_MAX:
1112               v = v1 > v2 ? v1 : v2;
1113               break;
1114
1115             case BINOP_EQUAL:
1116               v = v1 == v2;
1117               break;
1118
1119             case BINOP_LESS:
1120               v = v1 < v2;
1121               break;
1122
1123             default:
1124               error ("Invalid binary operation on numbers.");
1125             }
1126
1127           /* This is a kludge to get around the fact that we don't
1128              know how to determine the result type from the types of
1129              the operands.  (I'm not really sure how much we feel the
1130              need to duplicate the exact rules of the current
1131              language.  They can get really hairy.  But not to do so
1132              makes it hard to document just what we *do* do).  */
1133
1134           /* Can't just call init_type because we wouldn't know what
1135              name to give the type.  */
1136           val = allocate_value
1137             (result_len > TARGET_LONG_BIT / HOST_CHAR_BIT
1138              ? builtin_type_long_long
1139              : builtin_type_long);
1140           store_signed_integer (VALUE_CONTENTS_RAW (val),
1141                                 TYPE_LENGTH (value_type (val)),
1142                                 v);
1143         }
1144     }
1145
1146   return val;
1147 }
1148 \f
1149 /* Simulate the C operator ! -- return 1 if ARG1 contains zero.  */
1150
1151 int
1152 value_logical_not (struct value *arg1)
1153 {
1154   int len;
1155   char *p;
1156   struct type *type1;
1157
1158   arg1 = coerce_number (arg1);
1159   type1 = check_typedef (value_type (arg1));
1160
1161   if (TYPE_CODE (type1) == TYPE_CODE_FLT)
1162     return 0 == value_as_double (arg1);
1163
1164   len = TYPE_LENGTH (type1);
1165   p = VALUE_CONTENTS (arg1);
1166
1167   while (--len >= 0)
1168     {
1169       if (*p++)
1170         break;
1171     }
1172
1173   return len < 0;
1174 }
1175
1176 /* Perform a comparison on two string values (whose content are not
1177    necessarily null terminated) based on their length */
1178
1179 static int
1180 value_strcmp (struct value *arg1, struct value *arg2)
1181 {
1182   int len1 = TYPE_LENGTH (value_type (arg1));
1183   int len2 = TYPE_LENGTH (value_type (arg2));
1184   char *s1 = VALUE_CONTENTS (arg1);
1185   char *s2 = VALUE_CONTENTS (arg2);
1186   int i, len = len1 < len2 ? len1 : len2;
1187
1188   for (i = 0; i < len; i++)
1189     {
1190       if (s1[i] < s2[i])
1191         return -1;
1192       else if (s1[i] > s2[i])
1193         return 1;
1194       else
1195         continue;
1196     }
1197
1198   if (len1 < len2)
1199     return -1;
1200   else if (len1 > len2)
1201     return 1;
1202   else
1203     return 0;
1204 }
1205
1206 /* Simulate the C operator == by returning a 1
1207    iff ARG1 and ARG2 have equal contents.  */
1208
1209 int
1210 value_equal (struct value *arg1, struct value *arg2)
1211 {
1212   int len;
1213   char *p1, *p2;
1214   struct type *type1, *type2;
1215   enum type_code code1;
1216   enum type_code code2;
1217   int is_int1, is_int2;
1218
1219   arg1 = coerce_array (arg1);
1220   arg2 = coerce_array (arg2);
1221
1222   type1 = check_typedef (value_type (arg1));
1223   type2 = check_typedef (value_type (arg2));
1224   code1 = TYPE_CODE (type1);
1225   code2 = TYPE_CODE (type2);
1226   is_int1 = is_integral_type (type1);
1227   is_int2 = is_integral_type (type2);
1228
1229   if (is_int1 && is_int2)
1230     return longest_to_int (value_as_long (value_binop (arg1, arg2,
1231                                                        BINOP_EQUAL)));
1232   else if ((code1 == TYPE_CODE_FLT || is_int1)
1233            && (code2 == TYPE_CODE_FLT || is_int2))
1234     return value_as_double (arg1) == value_as_double (arg2);
1235
1236   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
1237      is bigger.  */
1238   else if (code1 == TYPE_CODE_PTR && is_int2)
1239     return value_as_address (arg1) == (CORE_ADDR) value_as_long (arg2);
1240   else if (code2 == TYPE_CODE_PTR && is_int1)
1241     return (CORE_ADDR) value_as_long (arg1) == value_as_address (arg2);
1242
1243   else if (code1 == code2
1244            && ((len = (int) TYPE_LENGTH (type1))
1245                == (int) TYPE_LENGTH (type2)))
1246     {
1247       p1 = VALUE_CONTENTS (arg1);
1248       p2 = VALUE_CONTENTS (arg2);
1249       while (--len >= 0)
1250         {
1251           if (*p1++ != *p2++)
1252             break;
1253         }
1254       return len < 0;
1255     }
1256   else if (code1 == TYPE_CODE_STRING && code2 == TYPE_CODE_STRING)
1257     {
1258       return value_strcmp (arg1, arg2) == 0;
1259     }
1260   else
1261     {
1262       error ("Invalid type combination in equality test.");
1263       return 0;                 /* For lint -- never reached */
1264     }
1265 }
1266
1267 /* Simulate the C operator < by returning 1
1268    iff ARG1's contents are less than ARG2's.  */
1269
1270 int
1271 value_less (struct value *arg1, struct value *arg2)
1272 {
1273   enum type_code code1;
1274   enum type_code code2;
1275   struct type *type1, *type2;
1276   int is_int1, is_int2;
1277
1278   arg1 = coerce_array (arg1);
1279   arg2 = coerce_array (arg2);
1280
1281   type1 = check_typedef (value_type (arg1));
1282   type2 = check_typedef (value_type (arg2));
1283   code1 = TYPE_CODE (type1);
1284   code2 = TYPE_CODE (type2);
1285   is_int1 = is_integral_type (type1);
1286   is_int2 = is_integral_type (type2);
1287
1288   if (is_int1 && is_int2)
1289     return longest_to_int (value_as_long (value_binop (arg1, arg2,
1290                                                        BINOP_LESS)));
1291   else if ((code1 == TYPE_CODE_FLT || is_int1)
1292            && (code2 == TYPE_CODE_FLT || is_int2))
1293     return value_as_double (arg1) < value_as_double (arg2);
1294   else if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
1295     return value_as_address (arg1) < value_as_address (arg2);
1296
1297   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
1298      is bigger.  */
1299   else if (code1 == TYPE_CODE_PTR && is_int2)
1300     return value_as_address (arg1) < (CORE_ADDR) value_as_long (arg2);
1301   else if (code2 == TYPE_CODE_PTR && is_int1)
1302     return (CORE_ADDR) value_as_long (arg1) < value_as_address (arg2);
1303   else if (code1 == TYPE_CODE_STRING && code2 == TYPE_CODE_STRING)
1304     return value_strcmp (arg1, arg2) < 0;
1305   else
1306     {
1307       error ("Invalid type combination in ordering comparison.");
1308       return 0;
1309     }
1310 }
1311 \f
1312 /* The unary operators - and ~.  Both free the argument ARG1.  */
1313
1314 struct value *
1315 value_neg (struct value *arg1)
1316 {
1317   struct type *type;
1318   struct type *result_type = value_type (arg1);
1319
1320   arg1 = coerce_ref (arg1);
1321
1322   type = check_typedef (value_type (arg1));
1323
1324   if (TYPE_CODE (type) == TYPE_CODE_FLT)
1325     return value_from_double (result_type, -value_as_double (arg1));
1326   else if (is_integral_type (type))
1327     {
1328       /* Perform integral promotion for ANSI C/C++.  FIXME: What about
1329          FORTRAN and (the deleted) chill ?  */
1330       if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
1331         result_type = builtin_type_int;
1332
1333       return value_from_longest (result_type, -value_as_long (arg1));
1334     }
1335   else
1336     {
1337       error ("Argument to negate operation not a number.");
1338       return 0;                 /* For lint -- never reached */
1339     }
1340 }
1341
1342 struct value *
1343 value_complement (struct value *arg1)
1344 {
1345   struct type *type;
1346   struct type *result_type = value_type (arg1);
1347
1348   arg1 = coerce_ref (arg1);
1349
1350   type = check_typedef (value_type (arg1));
1351
1352   if (!is_integral_type (type))
1353     error ("Argument to complement operation not an integer or boolean.");
1354
1355   /* Perform integral promotion for ANSI C/C++.
1356      FIXME: What about FORTRAN ?  */
1357   if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
1358     result_type = builtin_type_int;
1359
1360   return value_from_longest (result_type, ~value_as_long (arg1));
1361 }
1362 \f
1363 /* The INDEX'th bit of SET value whose value_type is TYPE,
1364    and whose VALUE_CONTENTS is valaddr.
1365    Return -1 if out of range, -2 other error. */
1366
1367 int
1368 value_bit_index (struct type *type, char *valaddr, int index)
1369 {
1370   LONGEST low_bound, high_bound;
1371   LONGEST word;
1372   unsigned rel_index;
1373   struct type *range = TYPE_FIELD_TYPE (type, 0);
1374   if (get_discrete_bounds (range, &low_bound, &high_bound) < 0)
1375     return -2;
1376   if (index < low_bound || index > high_bound)
1377     return -1;
1378   rel_index = index - low_bound;
1379   word = unpack_long (builtin_type_unsigned_char,
1380                       valaddr + (rel_index / TARGET_CHAR_BIT));
1381   rel_index %= TARGET_CHAR_BIT;
1382   if (BITS_BIG_ENDIAN)
1383     rel_index = TARGET_CHAR_BIT - 1 - rel_index;
1384   return (word >> rel_index) & 1;
1385 }
1386
1387 struct value *
1388 value_in (struct value *element, struct value *set)
1389 {
1390   int member;
1391   struct type *settype = check_typedef (value_type (set));
1392   struct type *eltype = check_typedef (value_type (element));
1393   if (TYPE_CODE (eltype) == TYPE_CODE_RANGE)
1394     eltype = TYPE_TARGET_TYPE (eltype);
1395   if (TYPE_CODE (settype) != TYPE_CODE_SET)
1396     error ("Second argument of 'IN' has wrong type");
1397   if (TYPE_CODE (eltype) != TYPE_CODE_INT
1398       && TYPE_CODE (eltype) != TYPE_CODE_CHAR
1399       && TYPE_CODE (eltype) != TYPE_CODE_ENUM
1400       && TYPE_CODE (eltype) != TYPE_CODE_BOOL)
1401     error ("First argument of 'IN' has wrong type");
1402   member = value_bit_index (settype, VALUE_CONTENTS (set),
1403                             value_as_long (element));
1404   if (member < 0)
1405     error ("First argument of 'IN' not in range");
1406   return value_from_longest (LA_BOOL_TYPE, member);
1407 }
1408
1409 void
1410 _initialize_valarith (void)
1411 {
1412 }