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