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