gdb/valarith.c

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