1 /* Evaluate expressions for GDB.
2 
3    Copyright 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software
5    Foundation, Inc.
6 
7    This file is part of GDB.
8 
9    This program is free software; you can redistribute it and/or modify
10    it under the terms of the GNU General Public License as published by
11    the Free Software Foundation; either version 2 of the License, or
12    (at your option) any later version.
13 
14    This program is distributed in the hope that it will be useful,
15    but WITHOUT ANY WARRANTY; without even the implied warranty of
16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17    GNU General Public License for more details.
18 
19    You should have received a copy of the GNU General Public License
20    along with this program; if not, write to the Free Software
21    Foundation, Inc., 59 Temple Place - Suite 330,
22    Boston, MA 02111-1307, USA.  */
23 
24 #include "defs.h"
25 #include "gdb_string.h"
26 #include "symtab.h"
27 #include "gdbtypes.h"
28 #include "value.h"
29 #include "expression.h"
30 #include "target.h"
31 #include "frame.h"
32 #include "language.h"		/* For CAST_IS_CONVERSION */
33 #include "f-lang.h"		/* for array bound stuff */
34 #include "cp-abi.h"
35 #include "infcall.h"
36 #include "objc-lang.h"
37 #include "block.h"
38 #include "parser-defs.h"
39 
40 /* This is defined in valops.c */
41 extern int overload_resolution;
42 
43 /* JYG: lookup rtti type of STRUCTOP_PTR when this is set to continue
44    on with successful lookup for member/method of the rtti type. */
45 extern int objectprint;
46 
47 /* Prototypes for local functions. */
48 
49 static struct value *evaluate_subexp_for_sizeof (struct expression *, int *);
50 
51 static struct value *evaluate_subexp_for_address (struct expression *,
52 						  int *, enum noside);
53 
54 static struct value *evaluate_subexp (struct type *, struct expression *,
55 				      int *, enum noside);
56 
57 static char *get_label (struct expression *, int *);
58 
59 static struct value *evaluate_struct_tuple (struct value *,
60 					    struct expression *, int *,
61 					    enum noside, int);
62 
63 static LONGEST init_array_element (struct value *, struct value *,
64 				   struct expression *, int *, enum noside,
65 				   LONGEST, LONGEST);
66 
67 static struct value *
evaluate_subexp(struct type * expect_type,struct expression * exp,int * pos,enum noside noside)68 evaluate_subexp (struct type *expect_type, struct expression *exp,
69 		 int *pos, enum noside noside)
70 {
71   return (*exp->language_defn->la_exp_desc->evaluate_exp)
72     (expect_type, exp, pos, noside);
73 }
74 
75 /* Parse the string EXP as a C expression, evaluate it,
76    and return the result as a number.  */
77 
78 CORE_ADDR
parse_and_eval_address(char * exp)79 parse_and_eval_address (char *exp)
80 {
81   struct expression *expr = parse_expression (exp);
82   CORE_ADDR addr;
83   struct cleanup *old_chain =
84     make_cleanup (free_current_contents, &expr);
85 
86   addr = value_as_address (evaluate_expression (expr));
87   do_cleanups (old_chain);
88   return addr;
89 }
90 
91 /* Like parse_and_eval_address but takes a pointer to a char * variable
92    and advanced that variable across the characters parsed.  */
93 
94 CORE_ADDR
parse_and_eval_address_1(char ** expptr)95 parse_and_eval_address_1 (char **expptr)
96 {
97   struct expression *expr = parse_exp_1 (expptr, (struct block *) 0, 0);
98   CORE_ADDR addr;
99   struct cleanup *old_chain =
100     make_cleanup (free_current_contents, &expr);
101 
102   addr = value_as_address (evaluate_expression (expr));
103   do_cleanups (old_chain);
104   return addr;
105 }
106 
107 /* Like parse_and_eval_address, but treats the value of the expression
108    as an integer, not an address, returns a LONGEST, not a CORE_ADDR */
109 LONGEST
parse_and_eval_long(char * exp)110 parse_and_eval_long (char *exp)
111 {
112   struct expression *expr = parse_expression (exp);
113   LONGEST retval;
114   struct cleanup *old_chain =
115     make_cleanup (free_current_contents, &expr);
116 
117   retval = value_as_long (evaluate_expression (expr));
118   do_cleanups (old_chain);
119   return (retval);
120 }
121 
122 struct value *
parse_and_eval(char * exp)123 parse_and_eval (char *exp)
124 {
125   struct expression *expr = parse_expression (exp);
126   struct value *val;
127   struct cleanup *old_chain =
128     make_cleanup (free_current_contents, &expr);
129 
130   val = evaluate_expression (expr);
131   do_cleanups (old_chain);
132   return val;
133 }
134 
135 /* Parse up to a comma (or to a closeparen)
136    in the string EXPP as an expression, evaluate it, and return the value.
137    EXPP is advanced to point to the comma.  */
138 
139 struct value *
parse_to_comma_and_eval(char ** expp)140 parse_to_comma_and_eval (char **expp)
141 {
142   struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
143   struct value *val;
144   struct cleanup *old_chain =
145     make_cleanup (free_current_contents, &expr);
146 
147   val = evaluate_expression (expr);
148   do_cleanups (old_chain);
149   return val;
150 }
151 
152 /* Evaluate an expression in internal prefix form
153    such as is constructed by parse.y.
154 
155    See expression.h for info on the format of an expression.  */
156 
157 struct value *
evaluate_expression(struct expression * exp)158 evaluate_expression (struct expression *exp)
159 {
160   int pc = 0;
161   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
162 }
163 
164 /* Evaluate an expression, avoiding all memory references
165    and getting a value whose type alone is correct.  */
166 
167 struct value *
evaluate_type(struct expression * exp)168 evaluate_type (struct expression *exp)
169 {
170   int pc = 0;
171   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
172 }
173 
174 /* If the next expression is an OP_LABELED, skips past it,
175    returning the label.  Otherwise, does nothing and returns NULL. */
176 
177 static char *
get_label(struct expression * exp,int * pos)178 get_label (struct expression *exp, int *pos)
179 {
180   if (exp->elts[*pos].opcode == OP_LABELED)
181     {
182       int pc = (*pos)++;
183       char *name = &exp->elts[pc + 2].string;
184       int tem = longest_to_int (exp->elts[pc + 1].longconst);
185       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
186       return name;
187     }
188   else
189     return NULL;
190 }
191 
192 /* This function evaluates tuples (in (the deleted) Chill) or
193    brace-initializers (in C/C++) for structure types.  */
194 
195 static struct value *
evaluate_struct_tuple(struct value * struct_val,struct expression * exp,int * pos,enum noside noside,int nargs)196 evaluate_struct_tuple (struct value *struct_val,
197 		       struct expression *exp,
198 		       int *pos, enum noside noside, int nargs)
199 {
200   struct type *struct_type = check_typedef (VALUE_TYPE (struct_val));
201   struct type *substruct_type = struct_type;
202   struct type *field_type;
203   int fieldno = -1;
204   int variantno = -1;
205   int subfieldno = -1;
206   while (--nargs >= 0)
207     {
208       int pc = *pos;
209       struct value *val = NULL;
210       int nlabels = 0;
211       int bitpos, bitsize;
212       char *addr;
213 
214       /* Skip past the labels, and count them. */
215       while (get_label (exp, pos) != NULL)
216 	nlabels++;
217 
218       do
219 	{
220 	  char *label = get_label (exp, &pc);
221 	  if (label)
222 	    {
223 	      for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
224 		   fieldno++)
225 		{
226 		  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
227 		  if (field_name != NULL && DEPRECATED_STREQ (field_name, label))
228 		    {
229 		      variantno = -1;
230 		      subfieldno = fieldno;
231 		      substruct_type = struct_type;
232 		      goto found;
233 		    }
234 		}
235 	      for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
236 		   fieldno++)
237 		{
238 		  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
239 		  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
240 		  if ((field_name == 0 || *field_name == '\0')
241 		      && TYPE_CODE (field_type) == TYPE_CODE_UNION)
242 		    {
243 		      variantno = 0;
244 		      for (; variantno < TYPE_NFIELDS (field_type);
245 			   variantno++)
246 			{
247 			  substruct_type
248 			    = TYPE_FIELD_TYPE (field_type, variantno);
249 			  if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
250 			    {
251 			      for (subfieldno = 0;
252 				 subfieldno < TYPE_NFIELDS (substruct_type);
253 				   subfieldno++)
254 				{
255 				  if (DEPRECATED_STREQ (TYPE_FIELD_NAME (substruct_type,
256 							      subfieldno),
257 					     label))
258 				    {
259 				      goto found;
260 				    }
261 				}
262 			    }
263 			}
264 		    }
265 		}
266 	      error ("there is no field named %s", label);
267 	    found:
268 	      ;
269 	    }
270 	  else
271 	    {
272 	      /* Unlabelled tuple element - go to next field. */
273 	      if (variantno >= 0)
274 		{
275 		  subfieldno++;
276 		  if (subfieldno >= TYPE_NFIELDS (substruct_type))
277 		    {
278 		      variantno = -1;
279 		      substruct_type = struct_type;
280 		    }
281 		}
282 	      if (variantno < 0)
283 		{
284 		  fieldno++;
285 		  subfieldno = fieldno;
286 		  if (fieldno >= TYPE_NFIELDS (struct_type))
287 		    error ("too many initializers");
288 		  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
289 		  if (TYPE_CODE (field_type) == TYPE_CODE_UNION
290 		      && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
291 		    error ("don't know which variant you want to set");
292 		}
293 	    }
294 
295 	  /* Here, struct_type is the type of the inner struct,
296 	     while substruct_type is the type of the inner struct.
297 	     These are the same for normal structures, but a variant struct
298 	     contains anonymous union fields that contain substruct fields.
299 	     The value fieldno is the index of the top-level (normal or
300 	     anonymous union) field in struct_field, while the value
301 	     subfieldno is the index of the actual real (named inner) field
302 	     in substruct_type. */
303 
304 	  field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
305 	  if (val == 0)
306 	    val = evaluate_subexp (field_type, exp, pos, noside);
307 
308 	  /* Now actually set the field in struct_val. */
309 
310 	  /* Assign val to field fieldno. */
311 	  if (VALUE_TYPE (val) != field_type)
312 	    val = value_cast (field_type, val);
313 
314 	  bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
315 	  bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
316 	  if (variantno >= 0)
317 	    bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
318 	  addr = VALUE_CONTENTS (struct_val) + bitpos / 8;
319 	  if (bitsize)
320 	    modify_field (addr, value_as_long (val),
321 			  bitpos % 8, bitsize);
322 	  else
323 	    memcpy (addr, VALUE_CONTENTS (val),
324 		    TYPE_LENGTH (VALUE_TYPE (val)));
325 	}
326       while (--nlabels > 0);
327     }
328   return struct_val;
329 }
330 
331 /* Recursive helper function for setting elements of array tuples for
332    (the deleted) Chill.  The target is ARRAY (which has bounds
333    LOW_BOUND to HIGH_BOUND); the element value is ELEMENT; EXP, POS
334    and NOSIDE are as usual.  Evaluates index expresions and sets the
335    specified element(s) of ARRAY to ELEMENT.  Returns last index
336    value.  */
337 
338 static LONGEST
init_array_element(struct value * array,struct value * element,struct expression * exp,int * pos,enum noside noside,LONGEST low_bound,LONGEST high_bound)339 init_array_element (struct value *array, struct value *element,
340 		    struct expression *exp, int *pos,
341 		    enum noside noside, LONGEST low_bound, LONGEST high_bound)
342 {
343   LONGEST index;
344   int element_size = TYPE_LENGTH (VALUE_TYPE (element));
345   if (exp->elts[*pos].opcode == BINOP_COMMA)
346     {
347       (*pos)++;
348       init_array_element (array, element, exp, pos, noside,
349 			  low_bound, high_bound);
350       return init_array_element (array, element,
351 				 exp, pos, noside, low_bound, high_bound);
352     }
353   else if (exp->elts[*pos].opcode == BINOP_RANGE)
354     {
355       LONGEST low, high;
356       (*pos)++;
357       low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
358       high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
359       if (low < low_bound || high > high_bound)
360 	error ("tuple range index out of range");
361       for (index = low; index <= high; index++)
362 	{
363 	  memcpy (VALUE_CONTENTS_RAW (array)
364 		  + (index - low_bound) * element_size,
365 		  VALUE_CONTENTS (element), element_size);
366 	}
367     }
368   else
369     {
370       index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
371       if (index < low_bound || index > high_bound)
372 	error ("tuple index out of range");
373       memcpy (VALUE_CONTENTS_RAW (array) + (index - low_bound) * element_size,
374 	      VALUE_CONTENTS (element), element_size);
375     }
376   return index;
377 }
378 
379 struct value *
evaluate_subexp_standard(struct type * expect_type,struct expression * exp,int * pos,enum noside noside)380 evaluate_subexp_standard (struct type *expect_type,
381 			  struct expression *exp, int *pos,
382 			  enum noside noside)
383 {
384   enum exp_opcode op;
385   int tem, tem2, tem3;
386   int pc, pc2 = 0, oldpos;
387   struct value *arg1 = NULL;
388   struct value *arg2 = NULL;
389   struct value *arg3;
390   struct type *type;
391   int nargs;
392   struct value **argvec;
393   int upper, lower, retcode;
394   int code;
395   int ix;
396   long mem_offset;
397   struct type **arg_types;
398   int save_pos1;
399 
400   pc = (*pos)++;
401   op = exp->elts[pc].opcode;
402 
403   switch (op)
404     {
405     case OP_SCOPE:
406       tem = longest_to_int (exp->elts[pc + 2].longconst);
407       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
408       arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
409 				  &exp->elts[pc + 3].string,
410 				  noside);
411       if (arg1 == NULL)
412 	error ("There is no field named %s", &exp->elts[pc + 3].string);
413       return arg1;
414 
415     case OP_LONG:
416       (*pos) += 3;
417       return value_from_longest (exp->elts[pc + 1].type,
418 				 exp->elts[pc + 2].longconst);
419 
420     case OP_DOUBLE:
421       (*pos) += 3;
422       return value_from_double (exp->elts[pc + 1].type,
423 				exp->elts[pc + 2].doubleconst);
424 
425     case OP_VAR_VALUE:
426       (*pos) += 3;
427       if (noside == EVAL_SKIP)
428 	goto nosideret;
429 
430       /* JYG: We used to just return value_zero of the symbol type
431 	 if we're asked to avoid side effects.  Otherwise we return
432 	 value_of_variable (...).  However I'm not sure if
433 	 value_of_variable () has any side effect.
434 	 We need a full value object returned here for whatis_exp ()
435 	 to call evaluate_type () and then pass the full value to
436 	 value_rtti_target_type () if we are dealing with a pointer
437 	 or reference to a base class and print object is on. */
438 
439 	return value_of_variable (exp->elts[pc + 2].symbol,
440 				  exp->elts[pc + 1].block);
441 
442     case OP_LAST:
443       (*pos) += 2;
444       return
445 	access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
446 
447     case OP_REGISTER:
448       {
449 	int regno = longest_to_int (exp->elts[pc + 1].longconst);
450 	struct value *val = value_of_register (regno, get_selected_frame ());
451 	(*pos) += 2;
452 	if (val == NULL)
453 	  error ("Value of register %s not available.",
454 		 frame_map_regnum_to_name (get_selected_frame (), regno));
455 	else
456 	  return val;
457       }
458     case OP_BOOL:
459       (*pos) += 2;
460       return value_from_longest (LA_BOOL_TYPE,
461 				 exp->elts[pc + 1].longconst);
462 
463     case OP_INTERNALVAR:
464       (*pos) += 2;
465       return value_of_internalvar (exp->elts[pc + 1].internalvar);
466 
467     case OP_STRING:
468       tem = longest_to_int (exp->elts[pc + 1].longconst);
469       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
470       if (noside == EVAL_SKIP)
471 	goto nosideret;
472       return value_string (&exp->elts[pc + 2].string, tem);
473 
474     case OP_OBJC_NSSTRING:		/* Objective C Foundation Class NSString constant.  */
475       tem = longest_to_int (exp->elts[pc + 1].longconst);
476       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
477       if (noside == EVAL_SKIP)
478 	{
479 	  goto nosideret;
480 	}
481       return (struct value *) value_nsstring (&exp->elts[pc + 2].string, tem + 1);
482 
483     case OP_BITSTRING:
484       tem = longest_to_int (exp->elts[pc + 1].longconst);
485       (*pos)
486 	+= 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
487       if (noside == EVAL_SKIP)
488 	goto nosideret;
489       return value_bitstring (&exp->elts[pc + 2].string, tem);
490       break;
491 
492     case OP_ARRAY:
493       (*pos) += 3;
494       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
495       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
496       nargs = tem3 - tem2 + 1;
497       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
498 
499       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
500 	  && TYPE_CODE (type) == TYPE_CODE_STRUCT)
501 	{
502 	  struct value *rec = allocate_value (expect_type);
503 	  memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
504 	  return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
505 	}
506 
507       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
508 	  && TYPE_CODE (type) == TYPE_CODE_ARRAY)
509 	{
510 	  struct type *range_type = TYPE_FIELD_TYPE (type, 0);
511 	  struct type *element_type = TYPE_TARGET_TYPE (type);
512 	  struct value *array = allocate_value (expect_type);
513 	  int element_size = TYPE_LENGTH (check_typedef (element_type));
514 	  LONGEST low_bound, high_bound, index;
515 	  if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
516 	    {
517 	      low_bound = 0;
518 	      high_bound = (TYPE_LENGTH (type) / element_size) - 1;
519 	    }
520 	  index = low_bound;
521 	  memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
522 	  for (tem = nargs; --nargs >= 0;)
523 	    {
524 	      struct value *element;
525 	      int index_pc = 0;
526 	      if (exp->elts[*pos].opcode == BINOP_RANGE)
527 		{
528 		  index_pc = ++(*pos);
529 		  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
530 		}
531 	      element = evaluate_subexp (element_type, exp, pos, noside);
532 	      if (VALUE_TYPE (element) != element_type)
533 		element = value_cast (element_type, element);
534 	      if (index_pc)
535 		{
536 		  int continue_pc = *pos;
537 		  *pos = index_pc;
538 		  index = init_array_element (array, element, exp, pos, noside,
539 					      low_bound, high_bound);
540 		  *pos = continue_pc;
541 		}
542 	      else
543 		{
544 		  if (index > high_bound)
545 		    /* to avoid memory corruption */
546 		    error ("Too many array elements");
547 		  memcpy (VALUE_CONTENTS_RAW (array)
548 			  + (index - low_bound) * element_size,
549 			  VALUE_CONTENTS (element),
550 			  element_size);
551 		}
552 	      index++;
553 	    }
554 	  return array;
555 	}
556 
557       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
558 	  && TYPE_CODE (type) == TYPE_CODE_SET)
559 	{
560 	  struct value *set = allocate_value (expect_type);
561 	  char *valaddr = VALUE_CONTENTS_RAW (set);
562 	  struct type *element_type = TYPE_INDEX_TYPE (type);
563 	  struct type *check_type = element_type;
564 	  LONGEST low_bound, high_bound;
565 
566 	  /* get targettype of elementtype */
567 	  while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
568 		 TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
569 	    check_type = TYPE_TARGET_TYPE (check_type);
570 
571 	  if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
572 	    error ("(power)set type with unknown size");
573 	  memset (valaddr, '\0', TYPE_LENGTH (type));
574 	  for (tem = 0; tem < nargs; tem++)
575 	    {
576 	      LONGEST range_low, range_high;
577 	      struct type *range_low_type, *range_high_type;
578 	      struct value *elem_val;
579 	      if (exp->elts[*pos].opcode == BINOP_RANGE)
580 		{
581 		  (*pos)++;
582 		  elem_val = evaluate_subexp (element_type, exp, pos, noside);
583 		  range_low_type = VALUE_TYPE (elem_val);
584 		  range_low = value_as_long (elem_val);
585 		  elem_val = evaluate_subexp (element_type, exp, pos, noside);
586 		  range_high_type = VALUE_TYPE (elem_val);
587 		  range_high = value_as_long (elem_val);
588 		}
589 	      else
590 		{
591 		  elem_val = evaluate_subexp (element_type, exp, pos, noside);
592 		  range_low_type = range_high_type = VALUE_TYPE (elem_val);
593 		  range_low = range_high = value_as_long (elem_val);
594 		}
595 	      /* check types of elements to avoid mixture of elements from
596 	         different types. Also check if type of element is "compatible"
597 	         with element type of powerset */
598 	      if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
599 		range_low_type = TYPE_TARGET_TYPE (range_low_type);
600 	      if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
601 		range_high_type = TYPE_TARGET_TYPE (range_high_type);
602 	      if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
603 		  (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
604 		   (range_low_type != range_high_type)))
605 		/* different element modes */
606 		error ("POWERSET tuple elements of different mode");
607 	      if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
608 		  (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
609 		   range_low_type != check_type))
610 		error ("incompatible POWERSET tuple elements");
611 	      if (range_low > range_high)
612 		{
613 		  warning ("empty POWERSET tuple range");
614 		  continue;
615 		}
616 	      if (range_low < low_bound || range_high > high_bound)
617 		error ("POWERSET tuple element out of range");
618 	      range_low -= low_bound;
619 	      range_high -= low_bound;
620 	      for (; range_low <= range_high; range_low++)
621 		{
622 		  int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
623 		  if (BITS_BIG_ENDIAN)
624 		    bit_index = TARGET_CHAR_BIT - 1 - bit_index;
625 		  valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
626 		    |= 1 << bit_index;
627 		}
628 	    }
629 	  return set;
630 	}
631 
632       argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
633       for (tem = 0; tem < nargs; tem++)
634 	{
635 	  /* Ensure that array expressions are coerced into pointer objects. */
636 	  argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
637 	}
638       if (noside == EVAL_SKIP)
639 	goto nosideret;
640       return value_array (tem2, tem3, argvec);
641 
642     case TERNOP_SLICE:
643       {
644 	struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
645 	int lowbound
646 	= value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
647 	int upper
648 	= value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
649 	if (noside == EVAL_SKIP)
650 	  goto nosideret;
651 	return value_slice (array, lowbound, upper - lowbound + 1);
652       }
653 
654     case TERNOP_SLICE_COUNT:
655       {
656 	struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
657 	int lowbound
658 	= value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
659 	int length
660 	= value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
661 	return value_slice (array, lowbound, length);
662       }
663 
664     case TERNOP_COND:
665       /* Skip third and second args to evaluate the first one.  */
666       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
667       if (value_logical_not (arg1))
668 	{
669 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
670 	  return evaluate_subexp (NULL_TYPE, exp, pos, noside);
671 	}
672       else
673 	{
674 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
675 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
676 	  return arg2;
677 	}
678 
679     case OP_OBJC_SELECTOR:
680       {				/* Objective C @selector operator.  */
681 	char *sel = &exp->elts[pc + 2].string;
682 	int len = longest_to_int (exp->elts[pc + 1].longconst);
683 
684 	(*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
685 	if (noside == EVAL_SKIP)
686 	  goto nosideret;
687 
688 	if (sel[len] != 0)
689 	  sel[len] = 0;		/* Make sure it's terminated.  */
690 	return value_from_longest (lookup_pointer_type (builtin_type_void),
691 				   lookup_child_selector (sel));
692       }
693 
694     case OP_OBJC_MSGCALL:
695       {				/* Objective C message (method) call.  */
696 
697 	static CORE_ADDR responds_selector = 0;
698 	static CORE_ADDR method_selector = 0;
699 
700 	CORE_ADDR selector = 0;
701 
702 	int using_gcc = 0;
703 	int struct_return = 0;
704 	int sub_no_side = 0;
705 
706 	static struct value *msg_send = NULL;
707 	static struct value *msg_send_stret = NULL;
708 	static int gnu_runtime = 0;
709 
710 	struct value *target = NULL;
711 	struct value *method = NULL;
712 	struct value *called_method = NULL;
713 
714 	struct type *selector_type = NULL;
715 
716 	struct value *ret = NULL;
717 	CORE_ADDR addr = 0;
718 
719 	selector = exp->elts[pc + 1].longconst;
720 	nargs = exp->elts[pc + 2].longconst;
721 	argvec = (struct value **) alloca (sizeof (struct value *)
722 					   * (nargs + 5));
723 
724 	(*pos) += 3;
725 
726 	selector_type = lookup_pointer_type (builtin_type_void);
727 	if (noside == EVAL_AVOID_SIDE_EFFECTS)
728 	  sub_no_side = EVAL_NORMAL;
729 	else
730 	  sub_no_side = noside;
731 
732 	target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
733 
734 	if (value_as_long (target) == 0)
735  	  return value_from_longest (builtin_type_long, 0);
736 
737 	if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0))
738 	  gnu_runtime = 1;
739 
740 	/* Find the method dispatch (Apple runtime) or method lookup
741 	   (GNU runtime) function for Objective-C.  These will be used
742 	   to lookup the symbol information for the method.  If we
743 	   can't find any symbol information, then we'll use these to
744 	   call the method, otherwise we can call the method
745 	   directly. The msg_send_stret function is used in the special
746 	   case of a method that returns a structure (Apple runtime
747 	   only).  */
748 	if (gnu_runtime)
749 	  {
750 	    struct type *type;
751 	    type = lookup_pointer_type (builtin_type_void);
752 	    type = lookup_function_type (type);
753 	    type = lookup_pointer_type (type);
754 	    type = lookup_function_type (type);
755 	    type = lookup_pointer_type (type);
756 
757 	    msg_send = find_function_in_inferior ("objc_msg_lookup");
758 	    msg_send_stret = find_function_in_inferior ("objc_msg_lookup");
759 
760 	    msg_send = value_from_pointer (type, value_as_address (msg_send));
761 	    msg_send_stret = value_from_pointer (type,
762 					value_as_address (msg_send_stret));
763 	  }
764 	else
765 	  {
766 	    msg_send = find_function_in_inferior ("objc_msgSend");
767 	    /* Special dispatcher for methods returning structs */
768 	    msg_send_stret = find_function_in_inferior ("objc_msgSend_stret");
769 	  }
770 
771 	/* Verify the target object responds to this method. The
772 	   standard top-level 'Object' class uses a different name for
773 	   the verification method than the non-standard, but more
774 	   often used, 'NSObject' class. Make sure we check for both. */
775 
776 	responds_selector = lookup_child_selector ("respondsToSelector:");
777 	if (responds_selector == 0)
778 	  responds_selector = lookup_child_selector ("respondsTo:");
779 
780 	if (responds_selector == 0)
781 	  error ("no 'respondsTo:' or 'respondsToSelector:' method");
782 
783 	method_selector = lookup_child_selector ("methodForSelector:");
784 	if (method_selector == 0)
785 	  method_selector = lookup_child_selector ("methodFor:");
786 
787 	if (method_selector == 0)
788 	  error ("no 'methodFor:' or 'methodForSelector:' method");
789 
790 	/* Call the verification method, to make sure that the target
791 	 class implements the desired method. */
792 
793 	argvec[0] = msg_send;
794 	argvec[1] = target;
795 	argvec[2] = value_from_longest (builtin_type_long, responds_selector);
796 	argvec[3] = value_from_longest (builtin_type_long, selector);
797 	argvec[4] = 0;
798 
799 	ret = call_function_by_hand (argvec[0], 3, argvec + 1);
800 	if (gnu_runtime)
801 	  {
802 	    /* Function objc_msg_lookup returns a pointer.  */
803 	    argvec[0] = ret;
804 	    ret = call_function_by_hand (argvec[0], 3, argvec + 1);
805 	  }
806 	if (value_as_long (ret) == 0)
807 	  error ("Target does not respond to this message selector.");
808 
809 	/* Call "methodForSelector:" method, to get the address of a
810 	   function method that implements this selector for this
811 	   class.  If we can find a symbol at that address, then we
812 	   know the return type, parameter types etc.  (that's a good
813 	   thing). */
814 
815 	argvec[0] = msg_send;
816 	argvec[1] = target;
817 	argvec[2] = value_from_longest (builtin_type_long, method_selector);
818 	argvec[3] = value_from_longest (builtin_type_long, selector);
819 	argvec[4] = 0;
820 
821 	ret = call_function_by_hand (argvec[0], 3, argvec + 1);
822 	if (gnu_runtime)
823 	  {
824 	    argvec[0] = ret;
825 	    ret = call_function_by_hand (argvec[0], 3, argvec + 1);
826 	  }
827 
828 	/* ret should now be the selector.  */
829 
830 	addr = value_as_long (ret);
831 	if (addr)
832 	  {
833 	    struct symbol *sym = NULL;
834 	    /* Is it a high_level symbol?  */
835 
836 	    sym = find_pc_function (addr);
837 	    if (sym != NULL)
838 	      method = value_of_variable (sym, 0);
839 	  }
840 
841 	/* If we found a method with symbol information, check to see
842            if it returns a struct.  Otherwise assume it doesn't.  */
843 
844 	if (method)
845 	  {
846 	    struct block *b;
847 	    CORE_ADDR funaddr;
848 	    struct type *value_type;
849 
850 	    funaddr = find_function_addr (method, &value_type);
851 
852 	    b = block_for_pc (funaddr);
853 
854 	    /* If compiled without -g, assume GCC 2.  */
855 	    using_gcc = (b == NULL ? 2 : BLOCK_GCC_COMPILED (b));
856 
857 	    CHECK_TYPEDEF (value_type);
858 
859 	    if ((value_type == NULL)
860 		|| (TYPE_CODE(value_type) == TYPE_CODE_ERROR))
861 	      {
862 		if (expect_type != NULL)
863 		  value_type = expect_type;
864 	      }
865 
866 	    struct_return = using_struct_return (value_type, using_gcc);
867 	  }
868 	else if (expect_type != NULL)
869 	  {
870 	    struct_return = using_struct_return (check_typedef (expect_type), using_gcc);
871 	  }
872 
873 	/* Found a function symbol.  Now we will substitute its
874 	   value in place of the message dispatcher (obj_msgSend),
875 	   so that we call the method directly instead of thru
876 	   the dispatcher.  The main reason for doing this is that
877 	   we can now evaluate the return value and parameter values
878 	   according to their known data types, in case we need to
879 	   do things like promotion, dereferencing, special handling
880 	   of structs and doubles, etc.
881 
882 	   We want to use the type signature of 'method', but still
883 	   jump to objc_msgSend() or objc_msgSend_stret() to better
884 	   mimic the behavior of the runtime.  */
885 
886 	if (method)
887 	  {
888 	    if (TYPE_CODE (VALUE_TYPE (method)) != TYPE_CODE_FUNC)
889 	      error ("method address has symbol information with non-function type; skipping");
890 	    if (struct_return)
891 	      VALUE_ADDRESS (method) = value_as_address (msg_send_stret);
892 	    else
893 	      VALUE_ADDRESS (method) = value_as_address (msg_send);
894 	    called_method = method;
895 	  }
896 	else
897 	  {
898 	    if (struct_return)
899 	      called_method = msg_send_stret;
900 	    else
901 	      called_method = msg_send;
902 	  }
903 
904 	if (noside == EVAL_SKIP)
905 	  goto nosideret;
906 
907 	if (noside == EVAL_AVOID_SIDE_EFFECTS)
908 	  {
909 	    /* If the return type doesn't look like a function type,
910 	       call an error.  This can happen if somebody tries to
911 	       turn a variable into a function call. This is here
912 	       because people often want to call, eg, strcmp, which
913 	       gdb doesn't know is a function.  If gdb isn't asked for
914 	       it's opinion (ie. through "whatis"), it won't offer
915 	       it. */
916 
917 	    struct type *type = VALUE_TYPE (called_method);
918 	    if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
919 	      type = TYPE_TARGET_TYPE (type);
920 	    type = TYPE_TARGET_TYPE (type);
921 
922 	    if (type)
923 	    {
924 	      if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
925 		return allocate_value (expect_type);
926 	      else
927 		return allocate_value (type);
928 	    }
929 	    else
930 	      error ("Expression of type other than \"method returning ...\" used as a method");
931 	  }
932 
933 	/* Now depending on whether we found a symbol for the method,
934 	   we will either call the runtime dispatcher or the method
935 	   directly.  */
936 
937 	argvec[0] = called_method;
938 	argvec[1] = target;
939 	argvec[2] = value_from_longest (builtin_type_long, selector);
940 	/* User-supplied arguments.  */
941 	for (tem = 0; tem < nargs; tem++)
942 	  argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
943 	argvec[tem + 3] = 0;
944 
945 	if (gnu_runtime && (method != NULL))
946 	  {
947 	    /* Function objc_msg_lookup returns a pointer.  */
948 	    VALUE_TYPE (argvec[0]) = lookup_function_type
949 			    (lookup_pointer_type (VALUE_TYPE (argvec[0])));
950 	    argvec[0] = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
951 	  }
952 
953 	ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
954 	return ret;
955       }
956       break;
957 
958     case OP_FUNCALL:
959       (*pos) += 2;
960       op = exp->elts[*pos].opcode;
961       nargs = longest_to_int (exp->elts[pc + 1].longconst);
962       /* Allocate arg vector, including space for the function to be
963          called in argvec[0] and a terminating NULL */
964       argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
965       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
966 	{
967 	  LONGEST fnptr;
968 
969 	  /* 1997-08-01 Currently we do not support function invocation
970 	     via pointers-to-methods with HP aCC. Pointer does not point
971 	     to the function, but possibly to some thunk. */
972 	  if (deprecated_hp_som_som_object_present)
973 	    {
974 	      error ("Not implemented: function invocation through pointer to method with HP aCC");
975 	    }
976 
977 	  nargs++;
978 	  /* First, evaluate the structure into arg2 */
979 	  pc2 = (*pos)++;
980 
981 	  if (noside == EVAL_SKIP)
982 	    goto nosideret;
983 
984 	  if (op == STRUCTOP_MEMBER)
985 	    {
986 	      arg2 = evaluate_subexp_for_address (exp, pos, noside);
987 	    }
988 	  else
989 	    {
990 	      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
991 	    }
992 
993 	  /* If the function is a virtual function, then the
994 	     aggregate value (providing the structure) plays
995 	     its part by providing the vtable.  Otherwise,
996 	     it is just along for the ride: call the function
997 	     directly.  */
998 
999 	  arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1000 
1001 	  fnptr = value_as_long (arg1);
1002 
1003 	  if (METHOD_PTR_IS_VIRTUAL (fnptr))
1004 	    {
1005 	      int fnoffset = METHOD_PTR_TO_VOFFSET (fnptr);
1006 	      struct type *basetype;
1007 	      struct type *domain_type =
1008 	      TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
1009 	      int i, j;
1010 	      basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
1011 	      if (domain_type != basetype)
1012 		arg2 = value_cast (lookup_pointer_type (domain_type), arg2);
1013 	      basetype = TYPE_VPTR_BASETYPE (domain_type);
1014 	      for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
1015 		{
1016 		  struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
1017 		  /* If one is virtual, then all are virtual.  */
1018 		  if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
1019 		    for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
1020 		      if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
1021 			{
1022 			  struct value *temp = value_ind (arg2);
1023 			  arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
1024 			  arg2 = value_addr (temp);
1025 			  goto got_it;
1026 			}
1027 		}
1028 	      if (i < 0)
1029 		error ("virtual function at index %d not found", fnoffset);
1030 	    }
1031 	  else
1032 	    {
1033 	      VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
1034 	    }
1035 	got_it:
1036 
1037 	  /* Now, say which argument to start evaluating from */
1038 	  tem = 2;
1039 	}
1040       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1041 	{
1042 	  /* Hair for method invocations */
1043 	  int tem2;
1044 
1045 	  nargs++;
1046 	  /* First, evaluate the structure into arg2 */
1047 	  pc2 = (*pos)++;
1048 	  tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1049 	  *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1050 	  if (noside == EVAL_SKIP)
1051 	    goto nosideret;
1052 
1053 	  if (op == STRUCTOP_STRUCT)
1054 	    {
1055 	      /* If v is a variable in a register, and the user types
1056 	         v.method (), this will produce an error, because v has
1057 	         no address.
1058 
1059 	         A possible way around this would be to allocate a
1060 	         copy of the variable on the stack, copy in the
1061 	         contents, call the function, and copy out the
1062 	         contents.  I.e. convert this from call by reference
1063 	         to call by copy-return (or whatever it's called).
1064 	         However, this does not work because it is not the
1065 	         same: the method being called could stash a copy of
1066 	         the address, and then future uses through that address
1067 	         (after the method returns) would be expected to
1068 	         use the variable itself, not some copy of it.  */
1069 	      arg2 = evaluate_subexp_for_address (exp, pos, noside);
1070 	    }
1071 	  else
1072 	    {
1073 	      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1074 	    }
1075 	  /* Now, say which argument to start evaluating from */
1076 	  tem = 2;
1077 	}
1078       else
1079 	{
1080 	  /* Non-method function call */
1081 	  save_pos1 = *pos;
1082 	  argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1083 	  tem = 1;
1084 	  type = VALUE_TYPE (argvec[0]);
1085 	  if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1086 	    type = TYPE_TARGET_TYPE (type);
1087 	  if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1088 	    {
1089 	      for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1090 		{
1091 		  /* pai: FIXME This seems to be coercing arguments before
1092 		   * overload resolution has been done! */
1093 		  argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
1094 						 exp, pos, noside);
1095 		}
1096 	    }
1097 	}
1098 
1099       /* Evaluate arguments */
1100       for (; tem <= nargs; tem++)
1101 	{
1102 	  /* Ensure that array expressions are coerced into pointer objects. */
1103 	  argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1104 	}
1105 
1106       /* signal end of arglist */
1107       argvec[tem] = 0;
1108 
1109       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1110 	{
1111 	  int static_memfuncp;
1112 	  char tstr[256];
1113 
1114 	  /* Method invocation : stuff "this" as first parameter */
1115 	  argvec[1] = arg2;
1116 	  /* Name of method from expression */
1117 	  strcpy (tstr, &exp->elts[pc2 + 2].string);
1118 
1119 	  if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1120 	    {
1121 	      /* Language is C++, do some overload resolution before evaluation */
1122 	      struct value *valp = NULL;
1123 
1124 	      /* Prepare list of argument types for overload resolution */
1125 	      arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1126 	      for (ix = 1; ix <= nargs; ix++)
1127 		arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
1128 
1129 	      (void) find_overload_match (arg_types, nargs, tstr,
1130 				     1 /* method */ , 0 /* strict match */ ,
1131 					  &arg2 /* the object */ , NULL,
1132 					  &valp, NULL, &static_memfuncp);
1133 
1134 
1135 	      argvec[1] = arg2;	/* the ``this'' pointer */
1136 	      argvec[0] = valp;	/* use the method found after overload resolution */
1137 	    }
1138 	  else
1139 	    /* Non-C++ case -- or no overload resolution */
1140 	    {
1141 	      struct value *temp = arg2;
1142 	      argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1143 					    &static_memfuncp,
1144 					    op == STRUCTOP_STRUCT
1145 				       ? "structure" : "structure pointer");
1146 	      /* value_struct_elt updates temp with the correct value
1147 	 	 of the ``this'' pointer if necessary, so modify argvec[1] to
1148 		 reflect any ``this'' changes.  */
1149 	      arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
1150 			     VALUE_ADDRESS (temp) + VALUE_OFFSET (temp)
1151 			     + VALUE_EMBEDDED_OFFSET (temp));
1152 	      argvec[1] = arg2;	/* the ``this'' pointer */
1153 	    }
1154 
1155 	  if (static_memfuncp)
1156 	    {
1157 	      argvec[1] = argvec[0];
1158 	      nargs--;
1159 	      argvec++;
1160 	    }
1161 	}
1162       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1163 	{
1164 	  argvec[1] = arg2;
1165 	  argvec[0] = arg1;
1166 	}
1167       else if (op == OP_VAR_VALUE)
1168 	{
1169 	  /* Non-member function being called */
1170           /* fn: This can only be done for C++ functions.  A C-style function
1171              in a C++ program, for instance, does not have the fields that
1172              are expected here */
1173 
1174 	  if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1175 	    {
1176 	      /* Language is C++, do some overload resolution before evaluation */
1177 	      struct symbol *symp;
1178 
1179 	      /* Prepare list of argument types for overload resolution */
1180 	      arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1181 	      for (ix = 1; ix <= nargs; ix++)
1182 		arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
1183 
1184 	      (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
1185 				 0 /* not method */ , 0 /* strict match */ ,
1186 		      NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
1187 					  NULL, &symp, NULL);
1188 
1189 	      /* Now fix the expression being evaluated */
1190 	      exp->elts[save_pos1+2].symbol = symp;
1191 	      argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1192 	    }
1193 	  else
1194 	    {
1195 	      /* Not C++, or no overload resolution allowed */
1196 	      /* nothing to be done; argvec already correctly set up */
1197 	    }
1198 	}
1199       else
1200 	{
1201 	  /* It is probably a C-style function */
1202 	  /* nothing to be done; argvec already correctly set up */
1203 	}
1204 
1205     do_call_it:
1206 
1207       if (noside == EVAL_SKIP)
1208 	goto nosideret;
1209       if (argvec[0] == NULL)
1210 	error ("Cannot evaluate function -- may be inlined");
1211       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1212 	{
1213 	  /* If the return type doesn't look like a function type, call an
1214 	     error.  This can happen if somebody tries to turn a variable into
1215 	     a function call. This is here because people often want to
1216 	     call, eg, strcmp, which gdb doesn't know is a function.  If
1217 	     gdb isn't asked for it's opinion (ie. through "whatis"),
1218 	     it won't offer it. */
1219 
1220 	  struct type *ftype =
1221 	  TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
1222 
1223 	  if (ftype)
1224 	    return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
1225 	  else
1226 	    error ("Expression of type other than \"Function returning ...\" used as function");
1227 	}
1228       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1229       /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
1230 
1231     case OP_F77_UNDETERMINED_ARGLIST:
1232 
1233       /* Remember that in F77, functions, substring ops and
1234          array subscript operations cannot be disambiguated
1235          at parse time.  We have made all array subscript operations,
1236          substring operations as well as function calls  come here
1237          and we now have to discover what the heck this thing actually was.
1238          If it is a function, we process just as if we got an OP_FUNCALL. */
1239 
1240       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1241       (*pos) += 2;
1242 
1243       /* First determine the type code we are dealing with.  */
1244       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1245       type = check_typedef (VALUE_TYPE (arg1));
1246       code = TYPE_CODE (type);
1247 
1248       switch (code)
1249 	{
1250 	case TYPE_CODE_ARRAY:
1251 	  goto multi_f77_subscript;
1252 
1253 	case TYPE_CODE_STRING:
1254 	  goto op_f77_substr;
1255 
1256 	case TYPE_CODE_PTR:
1257 	case TYPE_CODE_FUNC:
1258 	  /* It's a function call. */
1259 	  /* Allocate arg vector, including space for the function to be
1260 	     called in argvec[0] and a terminating NULL */
1261 	  argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
1262 	  argvec[0] = arg1;
1263 	  tem = 1;
1264 	  for (; tem <= nargs; tem++)
1265 	    argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1266 	  argvec[tem] = 0;	/* signal end of arglist */
1267 	  goto do_call_it;
1268 
1269 	default:
1270 	  error ("Cannot perform substring on this type");
1271 	}
1272 
1273     op_f77_substr:
1274       /* We have a substring operation on our hands here,
1275          let us get the string we will be dealing with */
1276 
1277       /* Now evaluate the 'from' and 'to' */
1278 
1279       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1280 
1281       if (nargs < 2)
1282 	return value_subscript (arg1, arg2);
1283 
1284       arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
1285 
1286       if (noside == EVAL_SKIP)
1287 	goto nosideret;
1288 
1289       tem2 = value_as_long (arg2);
1290       tem3 = value_as_long (arg3);
1291 
1292       return value_slice (arg1, tem2, tem3 - tem2 + 1);
1293 
1294     case OP_COMPLEX:
1295       /* We have a complex number, There should be 2 floating
1296          point numbers that compose it */
1297       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1298       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1299 
1300       return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
1301 
1302     case STRUCTOP_STRUCT:
1303       tem = longest_to_int (exp->elts[pc + 1].longconst);
1304       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1305       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1306       if (noside == EVAL_SKIP)
1307 	goto nosideret;
1308       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1309 	return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
1310 						   &exp->elts[pc + 2].string,
1311 						   0),
1312 			   lval_memory);
1313       else
1314 	{
1315 	  struct value *temp = arg1;
1316 	  return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1317 				   NULL, "structure");
1318 	}
1319 
1320     case STRUCTOP_PTR:
1321       tem = longest_to_int (exp->elts[pc + 1].longconst);
1322       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1323       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1324       if (noside == EVAL_SKIP)
1325 	goto nosideret;
1326 
1327       /* JYG: if print object is on we need to replace the base type
1328 	 with rtti type in order to continue on with successful
1329 	 lookup of member / method only available in the rtti type. */
1330       {
1331         struct type *type = VALUE_TYPE (arg1);
1332         struct type *real_type;
1333         int full, top, using_enc;
1334 
1335         if (objectprint && TYPE_TARGET_TYPE(type) &&
1336             (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1337           {
1338             real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1339             if (real_type)
1340               {
1341                 if (TYPE_CODE (type) == TYPE_CODE_PTR)
1342                   real_type = lookup_pointer_type (real_type);
1343                 else
1344                   real_type = lookup_reference_type (real_type);
1345 
1346                 arg1 = value_cast (real_type, arg1);
1347               }
1348           }
1349       }
1350 
1351       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1352 	return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
1353 						   &exp->elts[pc + 2].string,
1354 						   0),
1355 			   lval_memory);
1356       else
1357 	{
1358 	  struct value *temp = arg1;
1359 	  return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1360 				   NULL, "structure pointer");
1361 	}
1362 
1363     case STRUCTOP_MEMBER:
1364       arg1 = evaluate_subexp_for_address (exp, pos, noside);
1365       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1366 
1367       /* With HP aCC, pointers to methods do not point to the function code */
1368       if (deprecated_hp_som_som_object_present &&
1369 	  (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
1370       (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
1371 	error ("Pointers to methods not supported with HP aCC");	/* 1997-08-19 */
1372 
1373       mem_offset = value_as_long (arg2);
1374       goto handle_pointer_to_member;
1375 
1376     case STRUCTOP_MPTR:
1377       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1378       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1379 
1380       /* With HP aCC, pointers to methods do not point to the function code */
1381       if (deprecated_hp_som_som_object_present &&
1382 	  (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
1383       (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
1384 	error ("Pointers to methods not supported with HP aCC");	/* 1997-08-19 */
1385 
1386       mem_offset = value_as_long (arg2);
1387 
1388     handle_pointer_to_member:
1389       /* HP aCC generates offsets that have bit #29 set; turn it off to get
1390          a real offset to the member. */
1391       if (deprecated_hp_som_som_object_present)
1392 	{
1393 	  if (!mem_offset)	/* no bias -> really null */
1394 	    error ("Attempted dereference of null pointer-to-member");
1395 	  mem_offset &= ~0x20000000;
1396 	}
1397       if (noside == EVAL_SKIP)
1398 	goto nosideret;
1399       type = check_typedef (VALUE_TYPE (arg2));
1400       if (TYPE_CODE (type) != TYPE_CODE_PTR)
1401 	goto bad_pointer_to_member;
1402       type = check_typedef (TYPE_TARGET_TYPE (type));
1403       if (TYPE_CODE (type) == TYPE_CODE_METHOD)
1404 	error ("not implemented: pointer-to-method in pointer-to-member construct");
1405       if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
1406 	goto bad_pointer_to_member;
1407       /* Now, convert these values to an address.  */
1408       arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1409 			 arg1);
1410       arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1411 				 value_as_long (arg1) + mem_offset);
1412       return value_ind (arg3);
1413     bad_pointer_to_member:
1414       error ("non-pointer-to-member value used in pointer-to-member construct");
1415 
1416     case BINOP_CONCAT:
1417       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1418       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1419       if (noside == EVAL_SKIP)
1420 	goto nosideret;
1421       if (binop_user_defined_p (op, arg1, arg2))
1422 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1423       else
1424 	return value_concat (arg1, arg2);
1425 
1426     case BINOP_ASSIGN:
1427       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1428       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1429 
1430       /* Do special stuff for HP aCC pointers to members */
1431       if (deprecated_hp_som_som_object_present)
1432 	{
1433 	  /* 1997-08-19 Can't assign HP aCC pointers to methods. No details of
1434 	     the implementation yet; but the pointer appears to point to a code
1435 	     sequence (thunk) in memory -- in any case it is *not* the address
1436 	     of the function as it would be in a naive implementation. */
1437 	  if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
1438 	      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD))
1439 	    error ("Assignment to pointers to methods not implemented with HP aCC");
1440 
1441 	  /* HP aCC pointers to data members require a constant bias */
1442 	  if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
1443 	      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER))
1444 	    {
1445 	      unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (arg2);	/* forces evaluation */
1446 	      *ptr |= 0x20000000;	/* set 29th bit */
1447 	    }
1448 	}
1449 
1450       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1451 	return arg1;
1452       if (binop_user_defined_p (op, arg1, arg2))
1453 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1454       else
1455 	return value_assign (arg1, arg2);
1456 
1457     case BINOP_ASSIGN_MODIFY:
1458       (*pos) += 2;
1459       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1460       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1461       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1462 	return arg1;
1463       op = exp->elts[pc + 1].opcode;
1464       if (binop_user_defined_p (op, arg1, arg2))
1465 	return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1466       else if (op == BINOP_ADD)
1467 	arg2 = value_add (arg1, arg2);
1468       else if (op == BINOP_SUB)
1469 	arg2 = value_sub (arg1, arg2);
1470       else
1471 	arg2 = value_binop (arg1, arg2, op);
1472       return value_assign (arg1, arg2);
1473 
1474     case BINOP_ADD:
1475       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1476       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1477       if (noside == EVAL_SKIP)
1478 	goto nosideret;
1479       if (binop_user_defined_p (op, arg1, arg2))
1480 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1481       else
1482 	return value_add (arg1, arg2);
1483 
1484     case BINOP_SUB:
1485       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1486       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1487       if (noside == EVAL_SKIP)
1488 	goto nosideret;
1489       if (binop_user_defined_p (op, arg1, arg2))
1490 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1491       else
1492 	return value_sub (arg1, arg2);
1493 
1494     case BINOP_MUL:
1495     case BINOP_DIV:
1496     case BINOP_REM:
1497     case BINOP_MOD:
1498     case BINOP_LSH:
1499     case BINOP_RSH:
1500     case BINOP_BITWISE_AND:
1501     case BINOP_BITWISE_IOR:
1502     case BINOP_BITWISE_XOR:
1503       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1504       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1505       if (noside == EVAL_SKIP)
1506 	goto nosideret;
1507       if (binop_user_defined_p (op, arg1, arg2))
1508 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1509       else if (noside == EVAL_AVOID_SIDE_EFFECTS
1510 	       && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
1511 	return value_zero (VALUE_TYPE (arg1), not_lval);
1512       else
1513 	return value_binop (arg1, arg2, op);
1514 
1515     case BINOP_RANGE:
1516       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1517       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1518       if (noside == EVAL_SKIP)
1519 	goto nosideret;
1520       error ("':' operator used in invalid context");
1521 
1522     case BINOP_SUBSCRIPT:
1523       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1524       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1525       if (noside == EVAL_SKIP)
1526 	goto nosideret;
1527       if (binop_user_defined_p (op, arg1, arg2))
1528 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1529       else
1530 	{
1531 	  /* If the user attempts to subscript something that is not an
1532 	     array or pointer type (like a plain int variable for example),
1533 	     then report this as an error. */
1534 
1535 	  COERCE_REF (arg1);
1536 	  type = check_typedef (VALUE_TYPE (arg1));
1537 	  if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1538 	      && TYPE_CODE (type) != TYPE_CODE_PTR)
1539 	    {
1540 	      if (TYPE_NAME (type))
1541 		error ("cannot subscript something of type `%s'",
1542 		       TYPE_NAME (type));
1543 	      else
1544 		error ("cannot subscript requested type");
1545 	    }
1546 
1547 	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
1548 	    return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1549 	  else
1550 	    return value_subscript (arg1, arg2);
1551 	}
1552 
1553     case BINOP_IN:
1554       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1555       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1556       if (noside == EVAL_SKIP)
1557 	goto nosideret;
1558       return value_in (arg1, arg2);
1559 
1560     case MULTI_SUBSCRIPT:
1561       (*pos) += 2;
1562       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1563       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1564       while (nargs-- > 0)
1565 	{
1566 	  arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1567 	  /* FIXME:  EVAL_SKIP handling may not be correct. */
1568 	  if (noside == EVAL_SKIP)
1569 	    {
1570 	      if (nargs > 0)
1571 		{
1572 		  continue;
1573 		}
1574 	      else
1575 		{
1576 		  goto nosideret;
1577 		}
1578 	    }
1579 	  /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1580 	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
1581 	    {
1582 	      /* If the user attempts to subscript something that has no target
1583 	         type (like a plain int variable for example), then report this
1584 	         as an error. */
1585 
1586 	      type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
1587 	      if (type != NULL)
1588 		{
1589 		  arg1 = value_zero (type, VALUE_LVAL (arg1));
1590 		  noside = EVAL_SKIP;
1591 		  continue;
1592 		}
1593 	      else
1594 		{
1595 		  error ("cannot subscript something of type `%s'",
1596 			 TYPE_NAME (VALUE_TYPE (arg1)));
1597 		}
1598 	    }
1599 
1600 	  if (binop_user_defined_p (op, arg1, arg2))
1601 	    {
1602 	      arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1603 	    }
1604 	  else
1605 	    {
1606 	      arg1 = value_subscript (arg1, arg2);
1607 	    }
1608 	}
1609       return (arg1);
1610 
1611     multi_f77_subscript:
1612       {
1613 	int subscript_array[MAX_FORTRAN_DIMS + 1];	/* 1-based array of
1614 							   subscripts, max == 7 */
1615 	int array_size_array[MAX_FORTRAN_DIMS + 1];
1616 	int ndimensions = 1, i;
1617 	struct type *tmp_type;
1618 	int offset_item;	/* The array offset where the item lives */
1619 
1620 	if (nargs > MAX_FORTRAN_DIMS)
1621 	  error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
1622 
1623 	tmp_type = check_typedef (VALUE_TYPE (arg1));
1624 	ndimensions = calc_f77_array_dims (type);
1625 
1626 	if (nargs != ndimensions)
1627 	  error ("Wrong number of subscripts");
1628 
1629 	/* Now that we know we have a legal array subscript expression
1630 	   let us actually find out where this element exists in the array. */
1631 
1632 	offset_item = 0;
1633 	for (i = 1; i <= nargs; i++)
1634 	  {
1635 	    /* Evaluate each subscript, It must be a legal integer in F77 */
1636 	    arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1637 
1638 	    /* Fill in the subscript and array size arrays */
1639 
1640 	    subscript_array[i] = value_as_long (arg2);
1641 
1642 	    retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1643 	    if (retcode == BOUND_FETCH_ERROR)
1644 	      error ("Cannot obtain dynamic upper bound");
1645 
1646 	    retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1647 	    if (retcode == BOUND_FETCH_ERROR)
1648 	      error ("Cannot obtain dynamic lower bound");
1649 
1650 	    array_size_array[i] = upper - lower + 1;
1651 
1652 	    /* Zero-normalize subscripts so that offsetting will work. */
1653 
1654 	    subscript_array[i] -= lower;
1655 
1656 	    /* If we are at the bottom of a multidimensional
1657 	       array type then keep a ptr to the last ARRAY
1658 	       type around for use when calling value_subscript()
1659 	       below. This is done because we pretend to value_subscript
1660 	       that we actually have a one-dimensional array
1661 	       of base element type that we apply a simple
1662 	       offset to. */
1663 
1664 	    if (i < nargs)
1665 	      tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1666 	  }
1667 
1668 	/* Now let us calculate the offset for this item */
1669 
1670 	offset_item = subscript_array[ndimensions];
1671 
1672 	for (i = ndimensions - 1; i >= 1; i--)
1673 	  offset_item =
1674 	    array_size_array[i] * offset_item + subscript_array[i];
1675 
1676 	/* Construct a value node with the value of the offset */
1677 
1678 	arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1679 
1680 	/* Let us now play a dirty trick: we will take arg1
1681 	   which is a value node pointing to the topmost level
1682 	   of the multidimensional array-set and pretend
1683 	   that it is actually a array of the final element
1684 	   type, this will ensure that value_subscript()
1685 	   returns the correct type value */
1686 
1687 	VALUE_TYPE (arg1) = tmp_type;
1688 	return value_ind (value_add (value_coerce_array (arg1), arg2));
1689       }
1690 
1691     case BINOP_LOGICAL_AND:
1692       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1693       if (noside == EVAL_SKIP)
1694 	{
1695 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1696 	  goto nosideret;
1697 	}
1698 
1699       oldpos = *pos;
1700       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1701       *pos = oldpos;
1702 
1703       if (binop_user_defined_p (op, arg1, arg2))
1704 	{
1705 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1706 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1707 	}
1708       else
1709 	{
1710 	  tem = value_logical_not (arg1);
1711 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1712 				  (tem ? EVAL_SKIP : noside));
1713 	  return value_from_longest (LA_BOOL_TYPE,
1714 			     (LONGEST) (!tem && !value_logical_not (arg2)));
1715 	}
1716 
1717     case BINOP_LOGICAL_OR:
1718       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1719       if (noside == EVAL_SKIP)
1720 	{
1721 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1722 	  goto nosideret;
1723 	}
1724 
1725       oldpos = *pos;
1726       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1727       *pos = oldpos;
1728 
1729       if (binop_user_defined_p (op, arg1, arg2))
1730 	{
1731 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1732 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1733 	}
1734       else
1735 	{
1736 	  tem = value_logical_not (arg1);
1737 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1738 				  (!tem ? EVAL_SKIP : noside));
1739 	  return value_from_longest (LA_BOOL_TYPE,
1740 			     (LONGEST) (!tem || !value_logical_not (arg2)));
1741 	}
1742 
1743     case BINOP_EQUAL:
1744       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1745       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1746       if (noside == EVAL_SKIP)
1747 	goto nosideret;
1748       if (binop_user_defined_p (op, arg1, arg2))
1749 	{
1750 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1751 	}
1752       else
1753 	{
1754 	  tem = value_equal (arg1, arg2);
1755 	  return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1756 	}
1757 
1758     case BINOP_NOTEQUAL:
1759       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1760       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1761       if (noside == EVAL_SKIP)
1762 	goto nosideret;
1763       if (binop_user_defined_p (op, arg1, arg2))
1764 	{
1765 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1766 	}
1767       else
1768 	{
1769 	  tem = value_equal (arg1, arg2);
1770 	  return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1771 	}
1772 
1773     case BINOP_LESS:
1774       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1775       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1776       if (noside == EVAL_SKIP)
1777 	goto nosideret;
1778       if (binop_user_defined_p (op, arg1, arg2))
1779 	{
1780 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1781 	}
1782       else
1783 	{
1784 	  tem = value_less (arg1, arg2);
1785 	  return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1786 	}
1787 
1788     case BINOP_GTR:
1789       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1790       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1791       if (noside == EVAL_SKIP)
1792 	goto nosideret;
1793       if (binop_user_defined_p (op, arg1, arg2))
1794 	{
1795 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1796 	}
1797       else
1798 	{
1799 	  tem = value_less (arg2, arg1);
1800 	  return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1801 	}
1802 
1803     case BINOP_GEQ:
1804       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1805       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1806       if (noside == EVAL_SKIP)
1807 	goto nosideret;
1808       if (binop_user_defined_p (op, arg1, arg2))
1809 	{
1810 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1811 	}
1812       else
1813 	{
1814 	  tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1815 	  return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1816 	}
1817 
1818     case BINOP_LEQ:
1819       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1820       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1821       if (noside == EVAL_SKIP)
1822 	goto nosideret;
1823       if (binop_user_defined_p (op, arg1, arg2))
1824 	{
1825 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1826 	}
1827       else
1828 	{
1829 	  tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1830 	  return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1831 	}
1832 
1833     case BINOP_REPEAT:
1834       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1835       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1836       if (noside == EVAL_SKIP)
1837 	goto nosideret;
1838       type = check_typedef (VALUE_TYPE (arg2));
1839       if (TYPE_CODE (type) != TYPE_CODE_INT)
1840 	error ("Non-integral right operand for \"@\" operator.");
1841       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1842 	{
1843 	  return allocate_repeat_value (VALUE_TYPE (arg1),
1844 				     longest_to_int (value_as_long (arg2)));
1845 	}
1846       else
1847 	return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1848 
1849     case BINOP_COMMA:
1850       evaluate_subexp (NULL_TYPE, exp, pos, noside);
1851       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1852 
1853     case UNOP_NEG:
1854       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1855       if (noside == EVAL_SKIP)
1856 	goto nosideret;
1857       if (unop_user_defined_p (op, arg1))
1858 	return value_x_unop (arg1, op, noside);
1859       else
1860 	return value_neg (arg1);
1861 
1862     case UNOP_COMPLEMENT:
1863       /* C++: check for and handle destructor names.  */
1864       op = exp->elts[*pos].opcode;
1865 
1866       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1867       if (noside == EVAL_SKIP)
1868 	goto nosideret;
1869       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1870 	return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1871       else
1872 	return value_complement (arg1);
1873 
1874     case UNOP_LOGICAL_NOT:
1875       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1876       if (noside == EVAL_SKIP)
1877 	goto nosideret;
1878       if (unop_user_defined_p (op, arg1))
1879 	return value_x_unop (arg1, op, noside);
1880       else
1881 	return value_from_longest (LA_BOOL_TYPE,
1882 				   (LONGEST) value_logical_not (arg1));
1883 
1884     case UNOP_IND:
1885       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1886 	expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1887       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1888       if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
1889 	  ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
1890 	   (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
1891 	error ("Attempt to dereference pointer to member without an object");
1892       if (noside == EVAL_SKIP)
1893 	goto nosideret;
1894       if (unop_user_defined_p (op, arg1))
1895 	return value_x_unop (arg1, op, noside);
1896       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1897 	{
1898 	  type = check_typedef (VALUE_TYPE (arg1));
1899 	  if (TYPE_CODE (type) == TYPE_CODE_PTR
1900 	      || TYPE_CODE (type) == TYPE_CODE_REF
1901 	  /* In C you can dereference an array to get the 1st elt.  */
1902 	      || TYPE_CODE (type) == TYPE_CODE_ARRAY
1903 	    )
1904 	    return value_zero (TYPE_TARGET_TYPE (type),
1905 			       lval_memory);
1906 	  else if (TYPE_CODE (type) == TYPE_CODE_INT)
1907 	    /* GDB allows dereferencing an int.  */
1908 	    return value_zero (builtin_type_int, lval_memory);
1909 	  else
1910 	    error ("Attempt to take contents of a non-pointer value.");
1911 	}
1912       return value_ind (arg1);
1913 
1914     case UNOP_ADDR:
1915       /* C++: check for and handle pointer to members.  */
1916 
1917       op = exp->elts[*pos].opcode;
1918 
1919       if (noside == EVAL_SKIP)
1920 	{
1921 	  if (op == OP_SCOPE)
1922 	    {
1923 	      int temm = longest_to_int (exp->elts[pc + 3].longconst);
1924 	      (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1925 	    }
1926 	  else
1927 	    evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1928 	  goto nosideret;
1929 	}
1930       else
1931 	{
1932 	  struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
1933 	  /* If HP aCC object, use bias for pointers to members */
1934 	  if (deprecated_hp_som_som_object_present &&
1935 	      (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
1936 	      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
1937 	    {
1938 	      unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp);	/* forces evaluation */
1939 	      *ptr |= 0x20000000;	/* set 29th bit */
1940 	    }
1941 	  return retvalp;
1942 	}
1943 
1944     case UNOP_SIZEOF:
1945       if (noside == EVAL_SKIP)
1946 	{
1947 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1948 	  goto nosideret;
1949 	}
1950       return evaluate_subexp_for_sizeof (exp, pos);
1951 
1952     case UNOP_CAST:
1953       (*pos) += 2;
1954       type = exp->elts[pc + 1].type;
1955       arg1 = evaluate_subexp (type, exp, pos, noside);
1956       if (noside == EVAL_SKIP)
1957 	goto nosideret;
1958       if (type != VALUE_TYPE (arg1))
1959 	arg1 = value_cast (type, arg1);
1960       return arg1;
1961 
1962     case UNOP_MEMVAL:
1963       (*pos) += 2;
1964       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1965       if (noside == EVAL_SKIP)
1966 	goto nosideret;
1967       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1968 	return value_zero (exp->elts[pc + 1].type, lval_memory);
1969       else
1970 	return value_at_lazy (exp->elts[pc + 1].type,
1971 			      value_as_address (arg1),
1972 			      NULL);
1973 
1974     case UNOP_PREINCREMENT:
1975       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1976       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1977 	return arg1;
1978       else if (unop_user_defined_p (op, arg1))
1979 	{
1980 	  return value_x_unop (arg1, op, noside);
1981 	}
1982       else
1983 	{
1984 	  arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1985 						      (LONGEST) 1));
1986 	  return value_assign (arg1, arg2);
1987 	}
1988 
1989     case UNOP_PREDECREMENT:
1990       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1991       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1992 	return arg1;
1993       else if (unop_user_defined_p (op, arg1))
1994 	{
1995 	  return value_x_unop (arg1, op, noside);
1996 	}
1997       else
1998 	{
1999 	  arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2000 						      (LONGEST) 1));
2001 	  return value_assign (arg1, arg2);
2002 	}
2003 
2004     case UNOP_POSTINCREMENT:
2005       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2006       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2007 	return arg1;
2008       else if (unop_user_defined_p (op, arg1))
2009 	{
2010 	  return value_x_unop (arg1, op, noside);
2011 	}
2012       else
2013 	{
2014 	  arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2015 						      (LONGEST) 1));
2016 	  value_assign (arg1, arg2);
2017 	  return arg1;
2018 	}
2019 
2020     case UNOP_POSTDECREMENT:
2021       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2022       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2023 	return arg1;
2024       else if (unop_user_defined_p (op, arg1))
2025 	{
2026 	  return value_x_unop (arg1, op, noside);
2027 	}
2028       else
2029 	{
2030 	  arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2031 						      (LONGEST) 1));
2032 	  value_assign (arg1, arg2);
2033 	  return arg1;
2034 	}
2035 
2036     case OP_THIS:
2037       (*pos) += 1;
2038       return value_of_this (1);
2039 
2040     case OP_OBJC_SELF:
2041       (*pos) += 1;
2042       return value_of_local ("self", 1);
2043 
2044     case OP_TYPE:
2045       error ("Attempt to use a type name as an expression");
2046 
2047     default:
2048       /* Removing this case and compiling with gcc -Wall reveals that
2049          a lot of cases are hitting this case.  Some of these should
2050          probably be removed from expression.h; others are legitimate
2051          expressions which are (apparently) not fully implemented.
2052 
2053          If there are any cases landing here which mean a user error,
2054          then they should be separate cases, with more descriptive
2055          error messages.  */
2056 
2057       error ("\
2058 GDB does not (yet) know how to evaluate that kind of expression");
2059     }
2060 
2061 nosideret:
2062   return value_from_longest (builtin_type_long, (LONGEST) 1);
2063 }
2064 
2065 /* Evaluate a subexpression of EXP, at index *POS,
2066    and return the address of that subexpression.
2067    Advance *POS over the subexpression.
2068    If the subexpression isn't an lvalue, get an error.
2069    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2070    then only the type of the result need be correct.  */
2071 
2072 static struct value *
evaluate_subexp_for_address(struct expression * exp,int * pos,enum noside noside)2073 evaluate_subexp_for_address (struct expression *exp, int *pos,
2074 			     enum noside noside)
2075 {
2076   enum exp_opcode op;
2077   int pc;
2078   struct symbol *var;
2079 
2080   pc = (*pos);
2081   op = exp->elts[pc].opcode;
2082 
2083   switch (op)
2084     {
2085     case UNOP_IND:
2086       (*pos)++;
2087       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2088 
2089     case UNOP_MEMVAL:
2090       (*pos) += 3;
2091       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2092 			 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2093 
2094     case OP_VAR_VALUE:
2095       var = exp->elts[pc + 2].symbol;
2096 
2097       /* C++: The "address" of a reference should yield the address
2098        * of the object pointed to. Let value_addr() deal with it. */
2099       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2100 	goto default_case;
2101 
2102       (*pos) += 4;
2103       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2104 	{
2105 	  struct type *type =
2106 	  lookup_pointer_type (SYMBOL_TYPE (var));
2107 	  enum address_class sym_class = SYMBOL_CLASS (var);
2108 
2109 	  if (sym_class == LOC_CONST
2110 	      || sym_class == LOC_CONST_BYTES
2111 	      || sym_class == LOC_REGISTER
2112 	      || sym_class == LOC_REGPARM)
2113 	    error ("Attempt to take address of register or constant.");
2114 
2115 	  return
2116 	    value_zero (type, not_lval);
2117 	}
2118       else
2119 	return
2120 	  locate_var_value
2121 	  (var,
2122 	   block_innermost_frame (exp->elts[pc + 1].block));
2123 
2124     default:
2125     default_case:
2126       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2127 	{
2128 	  struct value *x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2129 	  if (VALUE_LVAL (x) == lval_memory)
2130 	    return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
2131 			       not_lval);
2132 	  else
2133 	    error ("Attempt to take address of non-lval");
2134 	}
2135       return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
2136     }
2137 }
2138 
2139 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2140    When used in contexts where arrays will be coerced anyway, this is
2141    equivalent to `evaluate_subexp' but much faster because it avoids
2142    actually fetching array contents (perhaps obsolete now that we have
2143    VALUE_LAZY).
2144 
2145    Note that we currently only do the coercion for C expressions, where
2146    arrays are zero based and the coercion is correct.  For other languages,
2147    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2148    to decide if coercion is appropriate.
2149 
2150  */
2151 
2152 struct value *
evaluate_subexp_with_coercion(struct expression * exp,int * pos,enum noside noside)2153 evaluate_subexp_with_coercion (struct expression *exp,
2154 			       int *pos, enum noside noside)
2155 {
2156   enum exp_opcode op;
2157   int pc;
2158   struct value *val;
2159   struct symbol *var;
2160 
2161   pc = (*pos);
2162   op = exp->elts[pc].opcode;
2163 
2164   switch (op)
2165     {
2166     case OP_VAR_VALUE:
2167       var = exp->elts[pc + 2].symbol;
2168       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2169 	  && CAST_IS_CONVERSION)
2170 	{
2171 	  (*pos) += 4;
2172 	  val =
2173 	    locate_var_value
2174 	    (var, block_innermost_frame (exp->elts[pc + 1].block));
2175 	  return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2176 			     val);
2177 	}
2178       /* FALLTHROUGH */
2179 
2180     default:
2181       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2182     }
2183 }
2184 
2185 /* Evaluate a subexpression of EXP, at index *POS,
2186    and return a value for the size of that subexpression.
2187    Advance *POS over the subexpression.  */
2188 
2189 static struct value *
evaluate_subexp_for_sizeof(struct expression * exp,int * pos)2190 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2191 {
2192   enum exp_opcode op;
2193   int pc;
2194   struct type *type;
2195   struct value *val;
2196 
2197   pc = (*pos);
2198   op = exp->elts[pc].opcode;
2199 
2200   switch (op)
2201     {
2202       /* This case is handled specially
2203          so that we avoid creating a value for the result type.
2204          If the result type is very big, it's desirable not to
2205          create a value unnecessarily.  */
2206     case UNOP_IND:
2207       (*pos)++;
2208       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2209       type = check_typedef (VALUE_TYPE (val));
2210       if (TYPE_CODE (type) != TYPE_CODE_PTR
2211 	  && TYPE_CODE (type) != TYPE_CODE_REF
2212 	  && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2213 	error ("Attempt to take contents of a non-pointer value.");
2214       type = check_typedef (TYPE_TARGET_TYPE (type));
2215       return value_from_longest (builtin_type_int, (LONGEST)
2216 				 TYPE_LENGTH (type));
2217 
2218     case UNOP_MEMVAL:
2219       (*pos) += 3;
2220       type = check_typedef (exp->elts[pc + 1].type);
2221       return value_from_longest (builtin_type_int,
2222 				 (LONGEST) TYPE_LENGTH (type));
2223 
2224     case OP_VAR_VALUE:
2225       (*pos) += 4;
2226       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2227       return
2228 	value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
2229 
2230     default:
2231       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2232       return value_from_longest (builtin_type_int,
2233 				 (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
2234     }
2235 }
2236 
2237 /* Parse a type expression in the string [P..P+LENGTH). */
2238 
2239 struct type *
parse_and_eval_type(char * p,int length)2240 parse_and_eval_type (char *p, int length)
2241 {
2242   char *tmp = (char *) alloca (length + 4);
2243   struct expression *expr;
2244   tmp[0] = '(';
2245   memcpy (tmp + 1, p, length);
2246   tmp[length + 1] = ')';
2247   tmp[length + 2] = '0';
2248   tmp[length + 3] = '\0';
2249   expr = parse_expression (tmp);
2250   if (expr->elts[0].opcode != UNOP_CAST)
2251     error ("Internal error in eval_type.");
2252   return expr->elts[1].type;
2253 }
2254 
2255 int
calc_f77_array_dims(struct type * array_type)2256 calc_f77_array_dims (struct type *array_type)
2257 {
2258   int ndimen = 1;
2259   struct type *tmp_type;
2260 
2261   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2262     error ("Can't get dimensions for a non-array type");
2263 
2264   tmp_type = array_type;
2265 
2266   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2267     {
2268       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2269 	++ndimen;
2270     }
2271   return ndimen;
2272 }
2273