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