xref: /dragonfly/contrib/gdb-7/gdb/eval.c (revision ef5ccd6c)
1 /* Evaluate expressions for GDB.
2 
3    Copyright (C) 1986-2013 Free Software Foundation, Inc.
4 
5    This file is part of GDB.
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11 
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 #include "defs.h"
21 #include "gdb_string.h"
22 #include "symtab.h"
23 #include "gdbtypes.h"
24 #include "value.h"
25 #include "expression.h"
26 #include "target.h"
27 #include "frame.h"
28 #include "language.h"		/* For CAST_IS_CONVERSION.  */
29 #include "f-lang.h"		/* For array bound stuff.  */
30 #include "cp-abi.h"
31 #include "infcall.h"
32 #include "objc-lang.h"
33 #include "block.h"
34 #include "parser-defs.h"
35 #include "cp-support.h"
36 #include "ui-out.h"
37 #include "exceptions.h"
38 #include "regcache.h"
39 #include "user-regs.h"
40 #include "valprint.h"
41 #include "gdb_obstack.h"
42 #include "objfiles.h"
43 #include "python/python.h"
44 
45 #include "gdb_assert.h"
46 
47 #include <ctype.h>
48 
49 /* This is defined in valops.c */
50 extern int overload_resolution;
51 
52 /* Prototypes for local functions.  */
53 
54 static struct value *evaluate_subexp_for_sizeof (struct expression *, int *);
55 
56 static struct value *evaluate_subexp_for_address (struct expression *,
57 						  int *, enum noside);
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 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(const char * exp)79 parse_and_eval_address (const 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 treats the value of the expression
92    as an integer, not an address, returns a LONGEST, not a CORE_ADDR.  */
93 LONGEST
parse_and_eval_long(char * exp)94 parse_and_eval_long (char *exp)
95 {
96   struct expression *expr = parse_expression (exp);
97   LONGEST retval;
98   struct cleanup *old_chain =
99     make_cleanup (free_current_contents, &expr);
100 
101   retval = value_as_long (evaluate_expression (expr));
102   do_cleanups (old_chain);
103   return (retval);
104 }
105 
106 struct value *
parse_and_eval(const char * exp)107 parse_and_eval (const char *exp)
108 {
109   struct expression *expr = parse_expression (exp);
110   struct value *val;
111   struct cleanup *old_chain =
112     make_cleanup (free_current_contents, &expr);
113 
114   val = evaluate_expression (expr);
115   do_cleanups (old_chain);
116   return val;
117 }
118 
119 /* Parse up to a comma (or to a closeparen)
120    in the string EXPP as an expression, evaluate it, and return the value.
121    EXPP is advanced to point to the comma.  */
122 
123 struct value *
parse_to_comma_and_eval(const char ** expp)124 parse_to_comma_and_eval (const char **expp)
125 {
126   struct expression *expr = parse_exp_1 (expp, 0, (struct block *) 0, 1);
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 /* Evaluate an expression in internal prefix form
137    such as is constructed by parse.y.
138 
139    See expression.h for info on the format of an expression.  */
140 
141 struct value *
evaluate_expression(struct expression * exp)142 evaluate_expression (struct expression *exp)
143 {
144   int pc = 0;
145 
146   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
147 }
148 
149 /* Evaluate an expression, avoiding all memory references
150    and getting a value whose type alone is correct.  */
151 
152 struct value *
evaluate_type(struct expression * exp)153 evaluate_type (struct expression *exp)
154 {
155   int pc = 0;
156 
157   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
158 }
159 
160 /* Evaluate a subexpression, avoiding all memory references and
161    getting a value whose type alone is correct.  */
162 
163 struct value *
evaluate_subexpression_type(struct expression * exp,int subexp)164 evaluate_subexpression_type (struct expression *exp, int subexp)
165 {
166   return evaluate_subexp (NULL_TYPE, exp, &subexp, EVAL_AVOID_SIDE_EFFECTS);
167 }
168 
169 /* Find the current value of a watchpoint on EXP.  Return the value in
170    *VALP and *RESULTP and the chain of intermediate and final values
171    in *VAL_CHAIN.  RESULTP and VAL_CHAIN may be NULL if the caller does
172    not need them.
173 
174    If a memory error occurs while evaluating the expression, *RESULTP will
175    be set to NULL.  *RESULTP may be a lazy value, if the result could
176    not be read from memory.  It is used to determine whether a value
177    is user-specified (we should watch the whole value) or intermediate
178    (we should watch only the bit used to locate the final value).
179 
180    If the final value, or any intermediate value, could not be read
181    from memory, *VALP will be set to NULL.  *VAL_CHAIN will still be
182    set to any referenced values.  *VALP will never be a lazy value.
183    This is the value which we store in struct breakpoint.
184 
185    If VAL_CHAIN is non-NULL, *VAL_CHAIN will be released from the
186    value chain.  The caller must free the values individually.  If
187    VAL_CHAIN is NULL, all generated values will be left on the value
188    chain.  */
189 
190 void
fetch_subexp_value(struct expression * exp,int * pc,struct value ** valp,struct value ** resultp,struct value ** val_chain)191 fetch_subexp_value (struct expression *exp, int *pc, struct value **valp,
192 		    struct value **resultp, struct value **val_chain)
193 {
194   struct value *mark, *new_mark, *result;
195   volatile struct gdb_exception ex;
196 
197   *valp = NULL;
198   if (resultp)
199     *resultp = NULL;
200   if (val_chain)
201     *val_chain = NULL;
202 
203   /* Evaluate the expression.  */
204   mark = value_mark ();
205   result = NULL;
206 
207   TRY_CATCH (ex, RETURN_MASK_ALL)
208     {
209       result = evaluate_subexp (NULL_TYPE, exp, pc, EVAL_NORMAL);
210     }
211   if (ex.reason < 0)
212     {
213       /* Ignore memory errors, we want watchpoints pointing at
214 	 inaccessible memory to still be created; otherwise, throw the
215 	 error to some higher catcher.  */
216       switch (ex.error)
217 	{
218 	case MEMORY_ERROR:
219 	  break;
220 	default:
221 	  throw_exception (ex);
222 	  break;
223 	}
224     }
225 
226   new_mark = value_mark ();
227   if (mark == new_mark)
228     return;
229   if (resultp)
230     *resultp = result;
231 
232   /* Make sure it's not lazy, so that after the target stops again we
233      have a non-lazy previous value to compare with.  */
234   if (result != NULL)
235     {
236       if (!value_lazy (result))
237 	*valp = result;
238       else
239 	{
240 	  volatile struct gdb_exception except;
241 
242 	  TRY_CATCH (except, RETURN_MASK_ERROR)
243 	    {
244 	      value_fetch_lazy (result);
245 	      *valp = result;
246 	    }
247 	}
248     }
249 
250   if (val_chain)
251     {
252       /* Return the chain of intermediate values.  We use this to
253 	 decide which addresses to watch.  */
254       *val_chain = new_mark;
255       value_release_to_mark (mark);
256     }
257 }
258 
259 /* Extract a field operation from an expression.  If the subexpression
260    of EXP starting at *SUBEXP is not a structure dereference
261    operation, return NULL.  Otherwise, return the name of the
262    dereferenced field, and advance *SUBEXP to point to the
263    subexpression of the left-hand-side of the dereference.  This is
264    used when completing field names.  */
265 
266 char *
extract_field_op(struct expression * exp,int * subexp)267 extract_field_op (struct expression *exp, int *subexp)
268 {
269   int tem;
270   char *result;
271 
272   if (exp->elts[*subexp].opcode != STRUCTOP_STRUCT
273       && exp->elts[*subexp].opcode != STRUCTOP_PTR)
274     return NULL;
275   tem = longest_to_int (exp->elts[*subexp + 1].longconst);
276   result = &exp->elts[*subexp + 2].string;
277   (*subexp) += 1 + 3 + BYTES_TO_EXP_ELEM (tem + 1);
278   return result;
279 }
280 
281 /* This function evaluates brace-initializers (in C/C++) for
282    structure types.  */
283 
284 static struct value *
evaluate_struct_tuple(struct value * struct_val,struct expression * exp,int * pos,enum noside noside,int nargs)285 evaluate_struct_tuple (struct value *struct_val,
286 		       struct expression *exp,
287 		       int *pos, enum noside noside, int nargs)
288 {
289   struct type *struct_type = check_typedef (value_type (struct_val));
290   struct type *field_type;
291   int fieldno = -1;
292 
293   while (--nargs >= 0)
294     {
295       struct value *val = NULL;
296       int bitpos, bitsize;
297       bfd_byte *addr;
298 
299       fieldno++;
300       /* Skip static fields.  */
301       while (fieldno < TYPE_NFIELDS (struct_type)
302 	     && field_is_static (&TYPE_FIELD (struct_type,
303 					      fieldno)))
304 	fieldno++;
305       if (fieldno >= TYPE_NFIELDS (struct_type))
306 	error (_("too many initializers"));
307       field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
308       if (TYPE_CODE (field_type) == TYPE_CODE_UNION
309 	  && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
310 	error (_("don't know which variant you want to set"));
311 
312       /* Here, struct_type is the type of the inner struct,
313 	 while substruct_type is the type of the inner struct.
314 	 These are the same for normal structures, but a variant struct
315 	 contains anonymous union fields that contain substruct fields.
316 	 The value fieldno is the index of the top-level (normal or
317 	 anonymous union) field in struct_field, while the value
318 	 subfieldno is the index of the actual real (named inner) field
319 	 in substruct_type.  */
320 
321       field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
322       if (val == 0)
323 	val = evaluate_subexp (field_type, exp, pos, noside);
324 
325       /* Now actually set the field in struct_val.  */
326 
327       /* Assign val to field fieldno.  */
328       if (value_type (val) != field_type)
329 	val = value_cast (field_type, val);
330 
331       bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
332       bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
333       addr = value_contents_writeable (struct_val) + bitpos / 8;
334       if (bitsize)
335 	modify_field (struct_type, addr,
336 		      value_as_long (val), bitpos % 8, bitsize);
337       else
338 	memcpy (addr, value_contents (val),
339 		TYPE_LENGTH (value_type (val)));
340 
341     }
342   return struct_val;
343 }
344 
345 /* Recursive helper function for setting elements of array tuples for
346    (the deleted) Chill.  The target is ARRAY (which has bounds
347    LOW_BOUND to HIGH_BOUND); the element value is ELEMENT; EXP, POS
348    and NOSIDE are as usual.  Evaluates index expresions and sets the
349    specified element(s) of ARRAY to ELEMENT.  Returns last index
350    value.  */
351 
352 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)353 init_array_element (struct value *array, struct value *element,
354 		    struct expression *exp, int *pos,
355 		    enum noside noside, LONGEST low_bound, LONGEST high_bound)
356 {
357   LONGEST index;
358   int element_size = TYPE_LENGTH (value_type (element));
359 
360   if (exp->elts[*pos].opcode == BINOP_COMMA)
361     {
362       (*pos)++;
363       init_array_element (array, element, exp, pos, noside,
364 			  low_bound, high_bound);
365       return init_array_element (array, element,
366 				 exp, pos, noside, low_bound, high_bound);
367     }
368   else if (exp->elts[*pos].opcode == BINOP_RANGE)
369     {
370       LONGEST low, high;
371 
372       (*pos)++;
373       low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
374       high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
375       if (low < low_bound || high > high_bound)
376 	error (_("tuple range index out of range"));
377       for (index = low; index <= high; index++)
378 	{
379 	  memcpy (value_contents_raw (array)
380 		  + (index - low_bound) * element_size,
381 		  value_contents (element), element_size);
382 	}
383     }
384   else
385     {
386       index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
387       if (index < low_bound || index > high_bound)
388 	error (_("tuple index out of range"));
389       memcpy (value_contents_raw (array) + (index - low_bound) * element_size,
390 	      value_contents (element), element_size);
391     }
392   return index;
393 }
394 
395 static struct value *
value_f90_subarray(struct value * array,struct expression * exp,int * pos,enum noside noside)396 value_f90_subarray (struct value *array,
397 		    struct expression *exp, int *pos, enum noside noside)
398 {
399   int pc = (*pos) + 1;
400   LONGEST low_bound, high_bound;
401   struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
402   enum f90_range_type range_type = longest_to_int (exp->elts[pc].longconst);
403 
404   *pos += 3;
405 
406   if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
407     low_bound = TYPE_LOW_BOUND (range);
408   else
409     low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
410 
411   if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
412     high_bound = TYPE_HIGH_BOUND (range);
413   else
414     high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
415 
416   return value_slice (array, low_bound, high_bound - low_bound + 1);
417 }
418 
419 
420 /* Promote value ARG1 as appropriate before performing a unary operation
421    on this argument.
422    If the result is not appropriate for any particular language then it
423    needs to patch this function.  */
424 
425 void
unop_promote(const struct language_defn * language,struct gdbarch * gdbarch,struct value ** arg1)426 unop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
427 	      struct value **arg1)
428 {
429   struct type *type1;
430 
431   *arg1 = coerce_ref (*arg1);
432   type1 = check_typedef (value_type (*arg1));
433 
434   if (is_integral_type (type1))
435     {
436       switch (language->la_language)
437 	{
438 	default:
439 	  /* Perform integral promotion for ANSI C/C++.
440 	     If not appropropriate for any particular language
441 	     it needs to modify this function.  */
442 	  {
443 	    struct type *builtin_int = builtin_type (gdbarch)->builtin_int;
444 
445 	    if (TYPE_LENGTH (type1) < TYPE_LENGTH (builtin_int))
446 	      *arg1 = value_cast (builtin_int, *arg1);
447 	  }
448 	  break;
449 	}
450     }
451 }
452 
453 /* Promote values ARG1 and ARG2 as appropriate before performing a binary
454    operation on those two operands.
455    If the result is not appropriate for any particular language then it
456    needs to patch this function.  */
457 
458 void
binop_promote(const struct language_defn * language,struct gdbarch * gdbarch,struct value ** arg1,struct value ** arg2)459 binop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
460 	       struct value **arg1, struct value **arg2)
461 {
462   struct type *promoted_type = NULL;
463   struct type *type1;
464   struct type *type2;
465 
466   *arg1 = coerce_ref (*arg1);
467   *arg2 = coerce_ref (*arg2);
468 
469   type1 = check_typedef (value_type (*arg1));
470   type2 = check_typedef (value_type (*arg2));
471 
472   if ((TYPE_CODE (type1) != TYPE_CODE_FLT
473        && TYPE_CODE (type1) != TYPE_CODE_DECFLOAT
474        && !is_integral_type (type1))
475       || (TYPE_CODE (type2) != TYPE_CODE_FLT
476 	  && TYPE_CODE (type2) != TYPE_CODE_DECFLOAT
477 	  && !is_integral_type (type2)))
478     return;
479 
480   if (TYPE_CODE (type1) == TYPE_CODE_DECFLOAT
481       || TYPE_CODE (type2) == TYPE_CODE_DECFLOAT)
482     {
483       /* No promotion required.  */
484     }
485   else if (TYPE_CODE (type1) == TYPE_CODE_FLT
486 	   || TYPE_CODE (type2) == TYPE_CODE_FLT)
487     {
488       switch (language->la_language)
489 	{
490 	case language_c:
491 	case language_cplus:
492 	case language_asm:
493 	case language_objc:
494 	case language_opencl:
495 	  /* No promotion required.  */
496 	  break;
497 
498 	default:
499 	  /* For other languages the result type is unchanged from gdb
500 	     version 6.7 for backward compatibility.
501 	     If either arg was long double, make sure that value is also long
502 	     double.  Otherwise use double.  */
503 	  if (TYPE_LENGTH (type1) * 8 > gdbarch_double_bit (gdbarch)
504 	      || TYPE_LENGTH (type2) * 8 > gdbarch_double_bit (gdbarch))
505 	    promoted_type = builtin_type (gdbarch)->builtin_long_double;
506 	  else
507 	    promoted_type = builtin_type (gdbarch)->builtin_double;
508 	  break;
509 	}
510     }
511   else if (TYPE_CODE (type1) == TYPE_CODE_BOOL
512 	   && TYPE_CODE (type2) == TYPE_CODE_BOOL)
513     {
514       /* No promotion required.  */
515     }
516   else
517     /* Integral operations here.  */
518     /* FIXME: Also mixed integral/booleans, with result an integer.  */
519     {
520       const struct builtin_type *builtin = builtin_type (gdbarch);
521       unsigned int promoted_len1 = TYPE_LENGTH (type1);
522       unsigned int promoted_len2 = TYPE_LENGTH (type2);
523       int is_unsigned1 = TYPE_UNSIGNED (type1);
524       int is_unsigned2 = TYPE_UNSIGNED (type2);
525       unsigned int result_len;
526       int unsigned_operation;
527 
528       /* Determine type length and signedness after promotion for
529          both operands.  */
530       if (promoted_len1 < TYPE_LENGTH (builtin->builtin_int))
531 	{
532 	  is_unsigned1 = 0;
533 	  promoted_len1 = TYPE_LENGTH (builtin->builtin_int);
534 	}
535       if (promoted_len2 < TYPE_LENGTH (builtin->builtin_int))
536 	{
537 	  is_unsigned2 = 0;
538 	  promoted_len2 = TYPE_LENGTH (builtin->builtin_int);
539 	}
540 
541       if (promoted_len1 > promoted_len2)
542 	{
543 	  unsigned_operation = is_unsigned1;
544 	  result_len = promoted_len1;
545 	}
546       else if (promoted_len2 > promoted_len1)
547 	{
548 	  unsigned_operation = is_unsigned2;
549 	  result_len = promoted_len2;
550 	}
551       else
552 	{
553 	  unsigned_operation = is_unsigned1 || is_unsigned2;
554 	  result_len = promoted_len1;
555 	}
556 
557       switch (language->la_language)
558 	{
559 	case language_c:
560 	case language_cplus:
561 	case language_asm:
562 	case language_objc:
563 	  if (result_len <= TYPE_LENGTH (builtin->builtin_int))
564 	    {
565 	      promoted_type = (unsigned_operation
566 			       ? builtin->builtin_unsigned_int
567 			       : builtin->builtin_int);
568 	    }
569 	  else if (result_len <= TYPE_LENGTH (builtin->builtin_long))
570 	    {
571 	      promoted_type = (unsigned_operation
572 			       ? builtin->builtin_unsigned_long
573 			       : builtin->builtin_long);
574 	    }
575 	  else
576 	    {
577 	      promoted_type = (unsigned_operation
578 			       ? builtin->builtin_unsigned_long_long
579 			       : builtin->builtin_long_long);
580 	    }
581 	  break;
582 	case language_opencl:
583 	  if (result_len <= TYPE_LENGTH (lookup_signed_typename
584 					 (language, gdbarch, "int")))
585 	    {
586 	      promoted_type =
587 		(unsigned_operation
588 		 ? lookup_unsigned_typename (language, gdbarch, "int")
589 		 : lookup_signed_typename (language, gdbarch, "int"));
590 	    }
591 	  else if (result_len <= TYPE_LENGTH (lookup_signed_typename
592 					      (language, gdbarch, "long")))
593 	    {
594 	      promoted_type =
595 		(unsigned_operation
596 		 ? lookup_unsigned_typename (language, gdbarch, "long")
597 		 : lookup_signed_typename (language, gdbarch,"long"));
598 	    }
599 	  break;
600 	default:
601 	  /* For other languages the result type is unchanged from gdb
602 	     version 6.7 for backward compatibility.
603 	     If either arg was long long, make sure that value is also long
604 	     long.  Otherwise use long.  */
605 	  if (unsigned_operation)
606 	    {
607 	      if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
608 		promoted_type = builtin->builtin_unsigned_long_long;
609 	      else
610 		promoted_type = builtin->builtin_unsigned_long;
611 	    }
612 	  else
613 	    {
614 	      if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
615 		promoted_type = builtin->builtin_long_long;
616 	      else
617 		promoted_type = builtin->builtin_long;
618 	    }
619 	  break;
620 	}
621     }
622 
623   if (promoted_type)
624     {
625       /* Promote both operands to common type.  */
626       *arg1 = value_cast (promoted_type, *arg1);
627       *arg2 = value_cast (promoted_type, *arg2);
628     }
629 }
630 
631 static int
ptrmath_type_p(const struct language_defn * lang,struct type * type)632 ptrmath_type_p (const struct language_defn *lang, struct type *type)
633 {
634   type = check_typedef (type);
635   if (TYPE_CODE (type) == TYPE_CODE_REF)
636     type = TYPE_TARGET_TYPE (type);
637 
638   switch (TYPE_CODE (type))
639     {
640     case TYPE_CODE_PTR:
641     case TYPE_CODE_FUNC:
642       return 1;
643 
644     case TYPE_CODE_ARRAY:
645       return TYPE_VECTOR (type) ? 0 : lang->c_style_arrays;
646 
647     default:
648       return 0;
649     }
650 }
651 
652 /* Constructs a fake method with the given parameter types.
653    This function is used by the parser to construct an "expected"
654    type for method overload resolution.  */
655 
656 static struct type *
make_params(int num_types,struct type ** param_types)657 make_params (int num_types, struct type **param_types)
658 {
659   struct type *type = XZALLOC (struct type);
660   TYPE_MAIN_TYPE (type) = XZALLOC (struct main_type);
661   TYPE_LENGTH (type) = 1;
662   TYPE_CODE (type) = TYPE_CODE_METHOD;
663   TYPE_VPTR_FIELDNO (type) = -1;
664   TYPE_CHAIN (type) = type;
665   if (num_types > 0)
666     {
667       if (param_types[num_types - 1] == NULL)
668 	{
669 	  --num_types;
670 	  TYPE_VARARGS (type) = 1;
671 	}
672       else if (TYPE_CODE (check_typedef (param_types[num_types - 1]))
673 	       == TYPE_CODE_VOID)
674 	{
675 	  --num_types;
676 	  /* Caller should have ensured this.  */
677 	  gdb_assert (num_types == 0);
678 	  TYPE_PROTOTYPED (type) = 1;
679 	}
680     }
681 
682   TYPE_NFIELDS (type) = num_types;
683   TYPE_FIELDS (type) = (struct field *)
684     TYPE_ZALLOC (type, sizeof (struct field) * num_types);
685 
686   while (num_types-- > 0)
687     TYPE_FIELD_TYPE (type, num_types) = param_types[num_types];
688 
689   return type;
690 }
691 
692 struct value *
evaluate_subexp_standard(struct type * expect_type,struct expression * exp,int * pos,enum noside noside)693 evaluate_subexp_standard (struct type *expect_type,
694 			  struct expression *exp, int *pos,
695 			  enum noside noside)
696 {
697   enum exp_opcode op;
698   int tem, tem2, tem3;
699   int pc, pc2 = 0, oldpos;
700   struct value *arg1 = NULL;
701   struct value *arg2 = NULL;
702   struct value *arg3;
703   struct type *type;
704   int nargs;
705   struct value **argvec;
706   int code;
707   int ix;
708   long mem_offset;
709   struct type **arg_types;
710   int save_pos1;
711   struct symbol *function = NULL;
712   char *function_name = NULL;
713 
714   pc = (*pos)++;
715   op = exp->elts[pc].opcode;
716 
717   switch (op)
718     {
719     case OP_SCOPE:
720       tem = longest_to_int (exp->elts[pc + 2].longconst);
721       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
722       if (noside == EVAL_SKIP)
723 	goto nosideret;
724       arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
725 				  &exp->elts[pc + 3].string,
726 				  expect_type, 0, noside);
727       if (arg1 == NULL)
728 	error (_("There is no field named %s"), &exp->elts[pc + 3].string);
729       return arg1;
730 
731     case OP_LONG:
732       (*pos) += 3;
733       return value_from_longest (exp->elts[pc + 1].type,
734 				 exp->elts[pc + 2].longconst);
735 
736     case OP_DOUBLE:
737       (*pos) += 3;
738       return value_from_double (exp->elts[pc + 1].type,
739 				exp->elts[pc + 2].doubleconst);
740 
741     case OP_DECFLOAT:
742       (*pos) += 3;
743       return value_from_decfloat (exp->elts[pc + 1].type,
744 				  exp->elts[pc + 2].decfloatconst);
745 
746     case OP_ADL_FUNC:
747     case OP_VAR_VALUE:
748       (*pos) += 3;
749       if (noside == EVAL_SKIP)
750 	goto nosideret;
751 
752       /* JYG: We used to just return value_zero of the symbol type
753 	 if we're asked to avoid side effects.  Otherwise we return
754 	 value_of_variable (...).  However I'm not sure if
755 	 value_of_variable () has any side effect.
756 	 We need a full value object returned here for whatis_exp ()
757 	 to call evaluate_type () and then pass the full value to
758 	 value_rtti_target_type () if we are dealing with a pointer
759 	 or reference to a base class and print object is on.  */
760 
761       {
762 	volatile struct gdb_exception except;
763 	struct value *ret = NULL;
764 
765 	TRY_CATCH (except, RETURN_MASK_ERROR)
766 	  {
767 	    ret = value_of_variable (exp->elts[pc + 2].symbol,
768 				     exp->elts[pc + 1].block);
769 	  }
770 
771 	if (except.reason < 0)
772 	  {
773 	    if (noside == EVAL_AVOID_SIDE_EFFECTS)
774 	      ret = value_zero (SYMBOL_TYPE (exp->elts[pc + 2].symbol),
775 				not_lval);
776 	    else
777 	      throw_exception (except);
778 	  }
779 
780 	return ret;
781       }
782 
783     case OP_VAR_ENTRY_VALUE:
784       (*pos) += 2;
785       if (noside == EVAL_SKIP)
786 	goto nosideret;
787 
788       {
789 	struct symbol *sym = exp->elts[pc + 1].symbol;
790 	struct frame_info *frame;
791 
792 	if (noside == EVAL_AVOID_SIDE_EFFECTS)
793 	  return value_zero (SYMBOL_TYPE (sym), not_lval);
794 
795 	if (SYMBOL_CLASS (sym) != LOC_COMPUTED
796 	    || SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry == NULL)
797 	  error (_("Symbol \"%s\" does not have any specific entry value"),
798 		 SYMBOL_PRINT_NAME (sym));
799 
800 	frame = get_selected_frame (NULL);
801 	return SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry (sym, frame);
802       }
803 
804     case OP_LAST:
805       (*pos) += 2;
806       return
807 	access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
808 
809     case OP_REGISTER:
810       {
811 	const char *name = &exp->elts[pc + 2].string;
812 	int regno;
813 	struct value *val;
814 
815 	(*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
816 	regno = user_reg_map_name_to_regnum (exp->gdbarch,
817 					     name, strlen (name));
818 	if (regno == -1)
819 	  error (_("Register $%s not available."), name);
820 
821         /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
822            a value with the appropriate register type.  Unfortunately,
823            we don't have easy access to the type of user registers.
824            So for these registers, we fetch the register value regardless
825            of the evaluation mode.  */
826 	if (noside == EVAL_AVOID_SIDE_EFFECTS
827 	    && regno < gdbarch_num_regs (exp->gdbarch)
828 			+ gdbarch_num_pseudo_regs (exp->gdbarch))
829 	  val = value_zero (register_type (exp->gdbarch, regno), not_lval);
830 	else
831 	  val = value_of_register (regno, get_selected_frame (NULL));
832 	if (val == NULL)
833 	  error (_("Value of register %s not available."), name);
834 	else
835 	  return val;
836       }
837     case OP_BOOL:
838       (*pos) += 2;
839       type = language_bool_type (exp->language_defn, exp->gdbarch);
840       return value_from_longest (type, exp->elts[pc + 1].longconst);
841 
842     case OP_INTERNALVAR:
843       (*pos) += 2;
844       return value_of_internalvar (exp->gdbarch,
845 				   exp->elts[pc + 1].internalvar);
846 
847     case OP_STRING:
848       tem = longest_to_int (exp->elts[pc + 1].longconst);
849       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
850       if (noside == EVAL_SKIP)
851 	goto nosideret;
852       type = language_string_char_type (exp->language_defn, exp->gdbarch);
853       return value_string (&exp->elts[pc + 2].string, tem, type);
854 
855     case OP_OBJC_NSSTRING:		/* Objective C Foundation Class
856 					   NSString constant.  */
857       tem = longest_to_int (exp->elts[pc + 1].longconst);
858       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
859       if (noside == EVAL_SKIP)
860 	{
861 	  goto nosideret;
862 	}
863       return value_nsstring (exp->gdbarch, &exp->elts[pc + 2].string, tem + 1);
864 
865     case OP_ARRAY:
866       (*pos) += 3;
867       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
868       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
869       nargs = tem3 - tem2 + 1;
870       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
871 
872       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
873 	  && TYPE_CODE (type) == TYPE_CODE_STRUCT)
874 	{
875 	  struct value *rec = allocate_value (expect_type);
876 
877 	  memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
878 	  return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
879 	}
880 
881       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
882 	  && TYPE_CODE (type) == TYPE_CODE_ARRAY)
883 	{
884 	  struct type *range_type = TYPE_INDEX_TYPE (type);
885 	  struct type *element_type = TYPE_TARGET_TYPE (type);
886 	  struct value *array = allocate_value (expect_type);
887 	  int element_size = TYPE_LENGTH (check_typedef (element_type));
888 	  LONGEST low_bound, high_bound, index;
889 
890 	  if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
891 	    {
892 	      low_bound = 0;
893 	      high_bound = (TYPE_LENGTH (type) / element_size) - 1;
894 	    }
895 	  index = low_bound;
896 	  memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
897 	  for (tem = nargs; --nargs >= 0;)
898 	    {
899 	      struct value *element;
900 	      int index_pc = 0;
901 
902 	      if (exp->elts[*pos].opcode == BINOP_RANGE)
903 		{
904 		  index_pc = ++(*pos);
905 		  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
906 		}
907 	      element = evaluate_subexp (element_type, exp, pos, noside);
908 	      if (value_type (element) != element_type)
909 		element = value_cast (element_type, element);
910 	      if (index_pc)
911 		{
912 		  int continue_pc = *pos;
913 
914 		  *pos = index_pc;
915 		  index = init_array_element (array, element, exp, pos, noside,
916 					      low_bound, high_bound);
917 		  *pos = continue_pc;
918 		}
919 	      else
920 		{
921 		  if (index > high_bound)
922 		    /* To avoid memory corruption.  */
923 		    error (_("Too many array elements"));
924 		  memcpy (value_contents_raw (array)
925 			  + (index - low_bound) * element_size,
926 			  value_contents (element),
927 			  element_size);
928 		}
929 	      index++;
930 	    }
931 	  return array;
932 	}
933 
934       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
935 	  && TYPE_CODE (type) == TYPE_CODE_SET)
936 	{
937 	  struct value *set = allocate_value (expect_type);
938 	  gdb_byte *valaddr = value_contents_raw (set);
939 	  struct type *element_type = TYPE_INDEX_TYPE (type);
940 	  struct type *check_type = element_type;
941 	  LONGEST low_bound, high_bound;
942 
943 	  /* Get targettype of elementtype.  */
944 	  while (TYPE_CODE (check_type) == TYPE_CODE_RANGE
945 		 || TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
946 	    check_type = TYPE_TARGET_TYPE (check_type);
947 
948 	  if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
949 	    error (_("(power)set type with unknown size"));
950 	  memset (valaddr, '\0', TYPE_LENGTH (type));
951 	  for (tem = 0; tem < nargs; tem++)
952 	    {
953 	      LONGEST range_low, range_high;
954 	      struct type *range_low_type, *range_high_type;
955 	      struct value *elem_val;
956 
957 	      if (exp->elts[*pos].opcode == BINOP_RANGE)
958 		{
959 		  (*pos)++;
960 		  elem_val = evaluate_subexp (element_type, exp, pos, noside);
961 		  range_low_type = value_type (elem_val);
962 		  range_low = value_as_long (elem_val);
963 		  elem_val = evaluate_subexp (element_type, exp, pos, noside);
964 		  range_high_type = value_type (elem_val);
965 		  range_high = value_as_long (elem_val);
966 		}
967 	      else
968 		{
969 		  elem_val = evaluate_subexp (element_type, exp, pos, noside);
970 		  range_low_type = range_high_type = value_type (elem_val);
971 		  range_low = range_high = value_as_long (elem_val);
972 		}
973 	      /* Check types of elements to avoid mixture of elements from
974 	         different types. Also check if type of element is "compatible"
975 	         with element type of powerset.  */
976 	      if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
977 		range_low_type = TYPE_TARGET_TYPE (range_low_type);
978 	      if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
979 		range_high_type = TYPE_TARGET_TYPE (range_high_type);
980 	      if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type))
981 		  || (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM
982 		      && (range_low_type != range_high_type)))
983 		/* different element modes.  */
984 		error (_("POWERSET tuple elements of different mode"));
985 	      if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type))
986 		  || (TYPE_CODE (check_type) == TYPE_CODE_ENUM
987 		      && range_low_type != check_type))
988 		error (_("incompatible POWERSET tuple elements"));
989 	      if (range_low > range_high)
990 		{
991 		  warning (_("empty POWERSET tuple range"));
992 		  continue;
993 		}
994 	      if (range_low < low_bound || range_high > high_bound)
995 		error (_("POWERSET tuple element out of range"));
996 	      range_low -= low_bound;
997 	      range_high -= low_bound;
998 	      for (; range_low <= range_high; range_low++)
999 		{
1000 		  int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
1001 
1002 		  if (gdbarch_bits_big_endian (exp->gdbarch))
1003 		    bit_index = TARGET_CHAR_BIT - 1 - bit_index;
1004 		  valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
1005 		    |= 1 << bit_index;
1006 		}
1007 	    }
1008 	  return set;
1009 	}
1010 
1011       argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
1012       for (tem = 0; tem < nargs; tem++)
1013 	{
1014 	  /* Ensure that array expressions are coerced into pointer
1015 	     objects.  */
1016 	  argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1017 	}
1018       if (noside == EVAL_SKIP)
1019 	goto nosideret;
1020       return value_array (tem2, tem3, argvec);
1021 
1022     case TERNOP_SLICE:
1023       {
1024 	struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1025 	int lowbound
1026 	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1027 	int upper
1028 	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1029 
1030 	if (noside == EVAL_SKIP)
1031 	  goto nosideret;
1032 	return value_slice (array, lowbound, upper - lowbound + 1);
1033       }
1034 
1035     case TERNOP_COND:
1036       /* Skip third and second args to evaluate the first one.  */
1037       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1038       if (value_logical_not (arg1))
1039 	{
1040 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1041 	  return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1042 	}
1043       else
1044 	{
1045 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1046 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1047 	  return arg2;
1048 	}
1049 
1050     case OP_OBJC_SELECTOR:
1051       {				/* Objective C @selector operator.  */
1052 	char *sel = &exp->elts[pc + 2].string;
1053 	int len = longest_to_int (exp->elts[pc + 1].longconst);
1054 	struct type *selector_type;
1055 
1056 	(*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1057 	if (noside == EVAL_SKIP)
1058 	  goto nosideret;
1059 
1060 	if (sel[len] != 0)
1061 	  sel[len] = 0;		/* Make sure it's terminated.  */
1062 
1063 	selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1064 	return value_from_longest (selector_type,
1065 				   lookup_child_selector (exp->gdbarch, sel));
1066       }
1067 
1068     case OP_OBJC_MSGCALL:
1069       {				/* Objective C message (method) call.  */
1070 
1071 	CORE_ADDR responds_selector = 0;
1072 	CORE_ADDR method_selector = 0;
1073 
1074 	CORE_ADDR selector = 0;
1075 
1076 	int struct_return = 0;
1077 	int sub_no_side = 0;
1078 
1079 	struct value *msg_send = NULL;
1080 	struct value *msg_send_stret = NULL;
1081 	int gnu_runtime = 0;
1082 
1083 	struct value *target = NULL;
1084 	struct value *method = NULL;
1085 	struct value *called_method = NULL;
1086 
1087 	struct type *selector_type = NULL;
1088 	struct type *long_type;
1089 
1090 	struct value *ret = NULL;
1091 	CORE_ADDR addr = 0;
1092 
1093 	selector = exp->elts[pc + 1].longconst;
1094 	nargs = exp->elts[pc + 2].longconst;
1095 	argvec = (struct value **) alloca (sizeof (struct value *)
1096 					   * (nargs + 5));
1097 
1098 	(*pos) += 3;
1099 
1100 	long_type = builtin_type (exp->gdbarch)->builtin_long;
1101 	selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1102 
1103 	if (noside == EVAL_AVOID_SIDE_EFFECTS)
1104 	  sub_no_side = EVAL_NORMAL;
1105 	else
1106 	  sub_no_side = noside;
1107 
1108 	target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1109 
1110 	if (value_as_long (target) == 0)
1111  	  return value_from_longest (long_type, 0);
1112 
1113 	if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0))
1114 	  gnu_runtime = 1;
1115 
1116 	/* Find the method dispatch (Apple runtime) or method lookup
1117 	   (GNU runtime) function for Objective-C.  These will be used
1118 	   to lookup the symbol information for the method.  If we
1119 	   can't find any symbol information, then we'll use these to
1120 	   call the method, otherwise we can call the method
1121 	   directly.  The msg_send_stret function is used in the special
1122 	   case of a method that returns a structure (Apple runtime
1123 	   only).  */
1124 	if (gnu_runtime)
1125 	  {
1126 	    struct type *type = selector_type;
1127 
1128 	    type = lookup_function_type (type);
1129 	    type = lookup_pointer_type (type);
1130 	    type = lookup_function_type (type);
1131 	    type = lookup_pointer_type (type);
1132 
1133 	    msg_send = find_function_in_inferior ("objc_msg_lookup", NULL);
1134 	    msg_send_stret
1135 	      = find_function_in_inferior ("objc_msg_lookup", NULL);
1136 
1137 	    msg_send = value_from_pointer (type, value_as_address (msg_send));
1138 	    msg_send_stret = value_from_pointer (type,
1139 					value_as_address (msg_send_stret));
1140 	  }
1141 	else
1142 	  {
1143 	    msg_send = find_function_in_inferior ("objc_msgSend", NULL);
1144 	    /* Special dispatcher for methods returning structs.  */
1145 	    msg_send_stret
1146 	      = find_function_in_inferior ("objc_msgSend_stret", NULL);
1147 	  }
1148 
1149 	/* Verify the target object responds to this method.  The
1150 	   standard top-level 'Object' class uses a different name for
1151 	   the verification method than the non-standard, but more
1152 	   often used, 'NSObject' class.  Make sure we check for both.  */
1153 
1154 	responds_selector
1155 	  = lookup_child_selector (exp->gdbarch, "respondsToSelector:");
1156 	if (responds_selector == 0)
1157 	  responds_selector
1158 	    = lookup_child_selector (exp->gdbarch, "respondsTo:");
1159 
1160 	if (responds_selector == 0)
1161 	  error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1162 
1163 	method_selector
1164 	  = lookup_child_selector (exp->gdbarch, "methodForSelector:");
1165 	if (method_selector == 0)
1166 	  method_selector
1167 	    = lookup_child_selector (exp->gdbarch, "methodFor:");
1168 
1169 	if (method_selector == 0)
1170 	  error (_("no 'methodFor:' or 'methodForSelector:' method"));
1171 
1172 	/* Call the verification method, to make sure that the target
1173 	 class implements the desired method.  */
1174 
1175 	argvec[0] = msg_send;
1176 	argvec[1] = target;
1177 	argvec[2] = value_from_longest (long_type, responds_selector);
1178 	argvec[3] = value_from_longest (long_type, selector);
1179 	argvec[4] = 0;
1180 
1181 	ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1182 	if (gnu_runtime)
1183 	  {
1184 	    /* Function objc_msg_lookup returns a pointer.  */
1185 	    argvec[0] = ret;
1186 	    ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1187 	  }
1188 	if (value_as_long (ret) == 0)
1189 	  error (_("Target does not respond to this message selector."));
1190 
1191 	/* Call "methodForSelector:" method, to get the address of a
1192 	   function method that implements this selector for this
1193 	   class.  If we can find a symbol at that address, then we
1194 	   know the return type, parameter types etc.  (that's a good
1195 	   thing).  */
1196 
1197 	argvec[0] = msg_send;
1198 	argvec[1] = target;
1199 	argvec[2] = value_from_longest (long_type, method_selector);
1200 	argvec[3] = value_from_longest (long_type, selector);
1201 	argvec[4] = 0;
1202 
1203 	ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1204 	if (gnu_runtime)
1205 	  {
1206 	    argvec[0] = ret;
1207 	    ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1208 	  }
1209 
1210 	/* ret should now be the selector.  */
1211 
1212 	addr = value_as_long (ret);
1213 	if (addr)
1214 	  {
1215 	    struct symbol *sym = NULL;
1216 
1217 	    /* The address might point to a function descriptor;
1218 	       resolve it to the actual code address instead.  */
1219 	    addr = gdbarch_convert_from_func_ptr_addr (exp->gdbarch, addr,
1220 						       &current_target);
1221 
1222 	    /* Is it a high_level symbol?  */
1223 	    sym = find_pc_function (addr);
1224 	    if (sym != NULL)
1225 	      method = value_of_variable (sym, 0);
1226 	  }
1227 
1228 	/* If we found a method with symbol information, check to see
1229            if it returns a struct.  Otherwise assume it doesn't.  */
1230 
1231 	if (method)
1232 	  {
1233 	    CORE_ADDR funaddr;
1234 	    struct type *val_type;
1235 
1236 	    funaddr = find_function_addr (method, &val_type);
1237 
1238 	    block_for_pc (funaddr);
1239 
1240 	    CHECK_TYPEDEF (val_type);
1241 
1242 	    if ((val_type == NULL)
1243 		|| (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1244 	      {
1245 		if (expect_type != NULL)
1246 		  val_type = expect_type;
1247 	      }
1248 
1249 	    struct_return = using_struct_return (exp->gdbarch, method,
1250 						 val_type);
1251 	  }
1252 	else if (expect_type != NULL)
1253 	  {
1254 	    struct_return = using_struct_return (exp->gdbarch, NULL,
1255 						 check_typedef (expect_type));
1256 	  }
1257 
1258 	/* Found a function symbol.  Now we will substitute its
1259 	   value in place of the message dispatcher (obj_msgSend),
1260 	   so that we call the method directly instead of thru
1261 	   the dispatcher.  The main reason for doing this is that
1262 	   we can now evaluate the return value and parameter values
1263 	   according to their known data types, in case we need to
1264 	   do things like promotion, dereferencing, special handling
1265 	   of structs and doubles, etc.
1266 
1267 	   We want to use the type signature of 'method', but still
1268 	   jump to objc_msgSend() or objc_msgSend_stret() to better
1269 	   mimic the behavior of the runtime.  */
1270 
1271 	if (method)
1272 	  {
1273 	    if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1274 	      error (_("method address has symbol information "
1275 		       "with non-function type; skipping"));
1276 
1277 	    /* Create a function pointer of the appropriate type, and
1278 	       replace its value with the value of msg_send or
1279 	       msg_send_stret.  We must use a pointer here, as
1280 	       msg_send and msg_send_stret are of pointer type, and
1281 	       the representation may be different on systems that use
1282 	       function descriptors.  */
1283 	    if (struct_return)
1284 	      called_method
1285 		= value_from_pointer (lookup_pointer_type (value_type (method)),
1286 				      value_as_address (msg_send_stret));
1287 	    else
1288 	      called_method
1289 		= value_from_pointer (lookup_pointer_type (value_type (method)),
1290 				      value_as_address (msg_send));
1291 	  }
1292 	else
1293 	  {
1294 	    if (struct_return)
1295 	      called_method = msg_send_stret;
1296 	    else
1297 	      called_method = msg_send;
1298 	  }
1299 
1300 	if (noside == EVAL_SKIP)
1301 	  goto nosideret;
1302 
1303 	if (noside == EVAL_AVOID_SIDE_EFFECTS)
1304 	  {
1305 	    /* If the return type doesn't look like a function type,
1306 	       call an error.  This can happen if somebody tries to
1307 	       turn a variable into a function call.  This is here
1308 	       because people often want to call, eg, strcmp, which
1309 	       gdb doesn't know is a function.  If gdb isn't asked for
1310 	       it's opinion (ie. through "whatis"), it won't offer
1311 	       it.  */
1312 
1313 	    struct type *type = value_type (called_method);
1314 
1315 	    if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1316 	      type = TYPE_TARGET_TYPE (type);
1317 	    type = TYPE_TARGET_TYPE (type);
1318 
1319 	    if (type)
1320 	    {
1321 	      if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1322 		return allocate_value (expect_type);
1323 	      else
1324 		return allocate_value (type);
1325 	    }
1326 	    else
1327 	      error (_("Expression of type other than "
1328 		       "\"method returning ...\" used as a method"));
1329 	  }
1330 
1331 	/* Now depending on whether we found a symbol for the method,
1332 	   we will either call the runtime dispatcher or the method
1333 	   directly.  */
1334 
1335 	argvec[0] = called_method;
1336 	argvec[1] = target;
1337 	argvec[2] = value_from_longest (long_type, selector);
1338 	/* User-supplied arguments.  */
1339 	for (tem = 0; tem < nargs; tem++)
1340 	  argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1341 	argvec[tem + 3] = 0;
1342 
1343 	if (gnu_runtime && (method != NULL))
1344 	  {
1345 	    /* Function objc_msg_lookup returns a pointer.  */
1346 	    deprecated_set_value_type (argvec[0],
1347 				       lookup_pointer_type (lookup_function_type (value_type (argvec[0]))));
1348 	    argvec[0]
1349 	      = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1350 	  }
1351 
1352 	ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1353 	return ret;
1354       }
1355       break;
1356 
1357     case OP_FUNCALL:
1358       (*pos) += 2;
1359       op = exp->elts[*pos].opcode;
1360       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1361       /* Allocate arg vector, including space for the function to be
1362          called in argvec[0] and a terminating NULL.  */
1363       argvec = (struct value **)
1364 	alloca (sizeof (struct value *) * (nargs + 3));
1365       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1366 	{
1367 	  /* First, evaluate the structure into arg2.  */
1368 	  pc2 = (*pos)++;
1369 
1370 	  if (noside == EVAL_SKIP)
1371 	    goto nosideret;
1372 
1373 	  if (op == STRUCTOP_MEMBER)
1374 	    {
1375 	      arg2 = evaluate_subexp_for_address (exp, pos, noside);
1376 	    }
1377 	  else
1378 	    {
1379 	      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1380 	    }
1381 
1382 	  /* If the function is a virtual function, then the
1383 	     aggregate value (providing the structure) plays
1384 	     its part by providing the vtable.  Otherwise,
1385 	     it is just along for the ride: call the function
1386 	     directly.  */
1387 
1388 	  arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1389 
1390 	  type = check_typedef (value_type (arg1));
1391 	  if (TYPE_CODE (type) == TYPE_CODE_METHODPTR)
1392 	    {
1393 	      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1394 		arg1 = value_zero (TYPE_TARGET_TYPE (type), not_lval);
1395 	      else
1396 		arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1397 
1398 	      /* Now, say which argument to start evaluating from.  */
1399 	      nargs++;
1400 	      tem = 2;
1401 	      argvec[1] = arg2;
1402 	    }
1403 	  else if (TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
1404 	    {
1405 	      struct type *type_ptr
1406 		= lookup_pointer_type (TYPE_DOMAIN_TYPE (type));
1407 	      struct type *target_type_ptr
1408 		= lookup_pointer_type (TYPE_TARGET_TYPE (type));
1409 
1410 	      /* Now, convert these values to an address.  */
1411 	      arg2 = value_cast (type_ptr, arg2);
1412 
1413 	      mem_offset = value_as_long (arg1);
1414 
1415 	      arg1 = value_from_pointer (target_type_ptr,
1416 					 value_as_long (arg2) + mem_offset);
1417 	      arg1 = value_ind (arg1);
1418 	      tem = 1;
1419 	    }
1420 	  else
1421 	    error (_("Non-pointer-to-member value used in pointer-to-member "
1422 		     "construct"));
1423 	}
1424       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1425 	{
1426 	  /* Hair for method invocations.  */
1427 	  int tem2;
1428 
1429 	  nargs++;
1430 	  /* First, evaluate the structure into arg2.  */
1431 	  pc2 = (*pos)++;
1432 	  tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1433 	  *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1434 	  if (noside == EVAL_SKIP)
1435 	    goto nosideret;
1436 
1437 	  if (op == STRUCTOP_STRUCT)
1438 	    {
1439 	      /* If v is a variable in a register, and the user types
1440 	         v.method (), this will produce an error, because v has
1441 	         no address.
1442 
1443 	         A possible way around this would be to allocate a
1444 	         copy of the variable on the stack, copy in the
1445 	         contents, call the function, and copy out the
1446 	         contents.  I.e. convert this from call by reference
1447 	         to call by copy-return (or whatever it's called).
1448 	         However, this does not work because it is not the
1449 	         same: the method being called could stash a copy of
1450 	         the address, and then future uses through that address
1451 	         (after the method returns) would be expected to
1452 	         use the variable itself, not some copy of it.  */
1453 	      arg2 = evaluate_subexp_for_address (exp, pos, noside);
1454 	    }
1455 	  else
1456 	    {
1457 	      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1458 
1459 	      /* Check to see if the operator '->' has been
1460 	         overloaded.  If the operator has been overloaded
1461 	         replace arg2 with the value returned by the custom
1462 	         operator and continue evaluation.  */
1463 	      while (unop_user_defined_p (op, arg2))
1464 		{
1465 		  volatile struct gdb_exception except;
1466 		  struct value *value = NULL;
1467 		  TRY_CATCH (except, RETURN_MASK_ERROR)
1468 		    {
1469 		      value = value_x_unop (arg2, op, noside);
1470 		    }
1471 
1472 		  if (except.reason < 0)
1473 		    {
1474 		      if (except.error == NOT_FOUND_ERROR)
1475 			break;
1476 		      else
1477 			throw_exception (except);
1478 		    }
1479 		  arg2 = value;
1480 		}
1481 	    }
1482 	  /* Now, say which argument to start evaluating from.  */
1483 	  tem = 2;
1484 	}
1485       else if (op == OP_SCOPE
1486 	       && overload_resolution
1487 	       && (exp->language_defn->la_language == language_cplus))
1488 	{
1489 	  /* Unpack it locally so we can properly handle overload
1490 	     resolution.  */
1491 	  char *name;
1492 	  int local_tem;
1493 
1494 	  pc2 = (*pos)++;
1495 	  local_tem = longest_to_int (exp->elts[pc2 + 2].longconst);
1496 	  (*pos) += 4 + BYTES_TO_EXP_ELEM (local_tem + 1);
1497 	  type = exp->elts[pc2 + 1].type;
1498 	  name = &exp->elts[pc2 + 3].string;
1499 
1500 	  function = NULL;
1501 	  function_name = NULL;
1502 	  if (TYPE_CODE (type) == TYPE_CODE_NAMESPACE)
1503 	    {
1504 	      function = cp_lookup_symbol_namespace (TYPE_TAG_NAME (type),
1505 						     name,
1506 						     get_selected_block (0),
1507 						     VAR_DOMAIN);
1508 	      if (function == NULL)
1509 		error (_("No symbol \"%s\" in namespace \"%s\"."),
1510 		       name, TYPE_TAG_NAME (type));
1511 
1512 	      tem = 1;
1513 	    }
1514 	  else
1515 	    {
1516 	      gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT
1517 			  || TYPE_CODE (type) == TYPE_CODE_UNION);
1518 	      function_name = name;
1519 
1520 	      arg2 = value_zero (type, lval_memory);
1521 	      ++nargs;
1522 	      tem = 2;
1523 	    }
1524 	}
1525       else if (op == OP_ADL_FUNC)
1526         {
1527           /* Save the function position and move pos so that the arguments
1528              can be evaluated.  */
1529           int func_name_len;
1530 
1531           save_pos1 = *pos;
1532           tem = 1;
1533 
1534           func_name_len = longest_to_int (exp->elts[save_pos1 + 3].longconst);
1535           (*pos) += 6 + BYTES_TO_EXP_ELEM (func_name_len + 1);
1536         }
1537       else
1538 	{
1539 	  /* Non-method function call.  */
1540 	  save_pos1 = *pos;
1541 	  tem = 1;
1542 
1543 	  /* If this is a C++ function wait until overload resolution.  */
1544 	  if (op == OP_VAR_VALUE
1545 	      && overload_resolution
1546 	      && (exp->language_defn->la_language == language_cplus))
1547 	    {
1548 	      (*pos) += 4; /* Skip the evaluation of the symbol.  */
1549 	      argvec[0] = NULL;
1550 	    }
1551 	  else
1552 	    {
1553 	      argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1554 	      type = value_type (argvec[0]);
1555 	      if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1556 		type = TYPE_TARGET_TYPE (type);
1557 	      if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1558 		{
1559 		  for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1560 		    {
1561 		      argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type,
1562 								      tem - 1),
1563 						     exp, pos, noside);
1564 		    }
1565 		}
1566 	    }
1567 	}
1568 
1569       /* Evaluate arguments.  */
1570       for (; tem <= nargs; tem++)
1571 	{
1572 	  /* Ensure that array expressions are coerced into pointer
1573 	     objects.  */
1574 	  argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1575 	}
1576 
1577       /* Signal end of arglist.  */
1578       argvec[tem] = 0;
1579       if (op == OP_ADL_FUNC)
1580         {
1581           struct symbol *symp;
1582           char *func_name;
1583           int  name_len;
1584           int string_pc = save_pos1 + 3;
1585 
1586           /* Extract the function name.  */
1587           name_len = longest_to_int (exp->elts[string_pc].longconst);
1588           func_name = (char *) alloca (name_len + 1);
1589           strcpy (func_name, &exp->elts[string_pc + 1].string);
1590 
1591           find_overload_match (&argvec[1], nargs, func_name,
1592                                NON_METHOD, /* not method */
1593                                NULL, NULL, /* pass NULL symbol since
1594 					      symbol is unknown */
1595                                NULL, &symp, NULL, 0);
1596 
1597           /* Now fix the expression being evaluated.  */
1598           exp->elts[save_pos1 + 2].symbol = symp;
1599           argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1600         }
1601 
1602       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR
1603 	  || (op == OP_SCOPE && function_name != NULL))
1604 	{
1605 	  int static_memfuncp;
1606 	  char *tstr;
1607 
1608 	  /* Method invocation : stuff "this" as first parameter.  */
1609 	  argvec[1] = arg2;
1610 
1611 	  if (op != OP_SCOPE)
1612 	    {
1613 	      /* Name of method from expression.  */
1614 	      tstr = &exp->elts[pc2 + 2].string;
1615 	    }
1616 	  else
1617 	    tstr = function_name;
1618 
1619 	  if (overload_resolution && (exp->language_defn->la_language
1620 				      == language_cplus))
1621 	    {
1622 	      /* Language is C++, do some overload resolution before
1623 		 evaluation.  */
1624 	      struct value *valp = NULL;
1625 
1626 	      (void) find_overload_match (&argvec[1], nargs, tstr,
1627 	                                  METHOD, /* method */
1628 					  &arg2,  /* the object */
1629 					  NULL, &valp, NULL,
1630 					  &static_memfuncp, 0);
1631 
1632 	      if (op == OP_SCOPE && !static_memfuncp)
1633 		{
1634 		  /* For the time being, we don't handle this.  */
1635 		  error (_("Call to overloaded function %s requires "
1636 			   "`this' pointer"),
1637 			 function_name);
1638 		}
1639 	      argvec[1] = arg2;	/* the ``this'' pointer */
1640 	      argvec[0] = valp;	/* Use the method found after overload
1641 				   resolution.  */
1642 	    }
1643 	  else
1644 	    /* Non-C++ case -- or no overload resolution.  */
1645 	    {
1646 	      struct value *temp = arg2;
1647 
1648 	      argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1649 					    &static_memfuncp,
1650 					    op == STRUCTOP_STRUCT
1651 				       ? "structure" : "structure pointer");
1652 	      /* value_struct_elt updates temp with the correct value
1653 	 	 of the ``this'' pointer if necessary, so modify argvec[1] to
1654 		 reflect any ``this'' changes.  */
1655 	      arg2
1656 		= value_from_longest (lookup_pointer_type(value_type (temp)),
1657 				      value_address (temp)
1658 				      + value_embedded_offset (temp));
1659 	      argvec[1] = arg2;	/* the ``this'' pointer */
1660 	    }
1661 
1662 	  if (static_memfuncp)
1663 	    {
1664 	      argvec[1] = argvec[0];
1665 	      nargs--;
1666 	      argvec++;
1667 	    }
1668 	}
1669       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1670 	{
1671 	  /* Pointer to member.  argvec[1] is already set up.  */
1672 	  argvec[0] = arg1;
1673 	}
1674       else if (op == OP_VAR_VALUE || (op == OP_SCOPE && function != NULL))
1675 	{
1676 	  /* Non-member function being called.  */
1677           /* fn: This can only be done for C++ functions.  A C-style function
1678              in a C++ program, for instance, does not have the fields that
1679              are expected here.  */
1680 
1681 	  if (overload_resolution && (exp->language_defn->la_language
1682 				      == language_cplus))
1683 	    {
1684 	      /* Language is C++, do some overload resolution before
1685 		 evaluation.  */
1686 	      struct symbol *symp;
1687 	      int no_adl = 0;
1688 
1689 	      /* If a scope has been specified disable ADL.  */
1690 	      if (op == OP_SCOPE)
1691 		no_adl = 1;
1692 
1693 	      if (op == OP_VAR_VALUE)
1694 		function = exp->elts[save_pos1+2].symbol;
1695 
1696 	      (void) find_overload_match (&argvec[1], nargs,
1697 					  NULL,        /* no need for name */
1698 	                                  NON_METHOD,  /* not method */
1699 	                                  NULL, function, /* the function */
1700 					  NULL, &symp, NULL, no_adl);
1701 
1702 	      if (op == OP_VAR_VALUE)
1703 		{
1704 		  /* Now fix the expression being evaluated.  */
1705 		  exp->elts[save_pos1+2].symbol = symp;
1706 		  argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1,
1707 							     noside);
1708 		}
1709 	      else
1710 		argvec[0] = value_of_variable (symp, get_selected_block (0));
1711 	    }
1712 	  else
1713 	    {
1714 	      /* Not C++, or no overload resolution allowed.  */
1715 	      /* Nothing to be done; argvec already correctly set up.  */
1716 	    }
1717 	}
1718       else
1719 	{
1720 	  /* It is probably a C-style function.  */
1721 	  /* Nothing to be done; argvec already correctly set up.  */
1722 	}
1723 
1724     do_call_it:
1725 
1726       if (noside == EVAL_SKIP)
1727 	goto nosideret;
1728       if (argvec[0] == NULL)
1729 	error (_("Cannot evaluate function -- may be inlined"));
1730       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1731 	{
1732 	  /* If the return type doesn't look like a function type, call an
1733 	     error.  This can happen if somebody tries to turn a variable into
1734 	     a function call.  This is here because people often want to
1735 	     call, eg, strcmp, which gdb doesn't know is a function.  If
1736 	     gdb isn't asked for it's opinion (ie. through "whatis"),
1737 	     it won't offer it.  */
1738 
1739 	  struct type *ftype = value_type (argvec[0]);
1740 
1741 	  if (TYPE_CODE (ftype) == TYPE_CODE_INTERNAL_FUNCTION)
1742 	    {
1743 	      /* We don't know anything about what the internal
1744 		 function might return, but we have to return
1745 		 something.  */
1746 	      return value_zero (builtin_type (exp->gdbarch)->builtin_int,
1747 				 not_lval);
1748 	    }
1749 	  else if (TYPE_GNU_IFUNC (ftype))
1750 	    return allocate_value (TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype)));
1751 	  else if (TYPE_TARGET_TYPE (ftype))
1752 	    return allocate_value (TYPE_TARGET_TYPE (ftype));
1753 	  else
1754 	    error (_("Expression of type other than "
1755 		     "\"Function returning ...\" used as function"));
1756 	}
1757       if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_INTERNAL_FUNCTION)
1758 	return call_internal_function (exp->gdbarch, exp->language_defn,
1759 				       argvec[0], nargs, argvec + 1);
1760 
1761       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1762       /* pai: FIXME save value from call_function_by_hand, then adjust
1763 	 pc by adjust_fn_pc if +ve.  */
1764 
1765     case OP_F77_UNDETERMINED_ARGLIST:
1766 
1767       /* Remember that in F77, functions, substring ops and
1768          array subscript operations cannot be disambiguated
1769          at parse time.  We have made all array subscript operations,
1770          substring operations as well as function calls  come here
1771          and we now have to discover what the heck this thing actually was.
1772          If it is a function, we process just as if we got an OP_FUNCALL.  */
1773 
1774       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1775       (*pos) += 2;
1776 
1777       /* First determine the type code we are dealing with.  */
1778       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1779       type = check_typedef (value_type (arg1));
1780       code = TYPE_CODE (type);
1781 
1782       if (code == TYPE_CODE_PTR)
1783 	{
1784 	  /* Fortran always passes variable to subroutines as pointer.
1785 	     So we need to look into its target type to see if it is
1786 	     array, string or function.  If it is, we need to switch
1787 	     to the target value the original one points to.  */
1788 	  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1789 
1790 	  if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1791 	      || TYPE_CODE (target_type) == TYPE_CODE_STRING
1792 	      || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1793 	    {
1794 	      arg1 = value_ind (arg1);
1795 	      type = check_typedef (value_type (arg1));
1796 	      code = TYPE_CODE (type);
1797 	    }
1798 	}
1799 
1800       switch (code)
1801 	{
1802 	case TYPE_CODE_ARRAY:
1803 	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
1804 	    return value_f90_subarray (arg1, exp, pos, noside);
1805 	  else
1806 	    goto multi_f77_subscript;
1807 
1808 	case TYPE_CODE_STRING:
1809 	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
1810 	    return value_f90_subarray (arg1, exp, pos, noside);
1811 	  else
1812 	    {
1813 	      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1814 	      return value_subscript (arg1, value_as_long (arg2));
1815 	    }
1816 
1817 	case TYPE_CODE_PTR:
1818 	case TYPE_CODE_FUNC:
1819 	  /* It's a function call.  */
1820 	  /* Allocate arg vector, including space for the function to be
1821 	     called in argvec[0] and a terminating NULL.  */
1822 	  argvec = (struct value **)
1823 	    alloca (sizeof (struct value *) * (nargs + 2));
1824 	  argvec[0] = arg1;
1825 	  tem = 1;
1826 	  for (; tem <= nargs; tem++)
1827 	    argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1828 	  argvec[tem] = 0;	/* signal end of arglist */
1829 	  goto do_call_it;
1830 
1831 	default:
1832 	  error (_("Cannot perform substring on this type"));
1833 	}
1834 
1835     case OP_COMPLEX:
1836       /* We have a complex number, There should be 2 floating
1837          point numbers that compose it.  */
1838       (*pos) += 2;
1839       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1840       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1841 
1842       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1843 
1844     case STRUCTOP_STRUCT:
1845       tem = longest_to_int (exp->elts[pc + 1].longconst);
1846       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1847       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1848       if (noside == EVAL_SKIP)
1849 	goto nosideret;
1850       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1851 	return value_zero (lookup_struct_elt_type (value_type (arg1),
1852 						   &exp->elts[pc + 2].string,
1853 						   0),
1854 			   lval_memory);
1855       else
1856 	{
1857 	  struct value *temp = arg1;
1858 
1859 	  return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1860 				   NULL, "structure");
1861 	}
1862 
1863     case STRUCTOP_PTR:
1864       tem = longest_to_int (exp->elts[pc + 1].longconst);
1865       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1866       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1867       if (noside == EVAL_SKIP)
1868 	goto nosideret;
1869 
1870       /* Check to see if operator '->' has been overloaded.  If so replace
1871          arg1 with the value returned by evaluating operator->().  */
1872       while (unop_user_defined_p (op, arg1))
1873 	{
1874 	  volatile struct gdb_exception except;
1875 	  struct value *value = NULL;
1876 	  TRY_CATCH (except, RETURN_MASK_ERROR)
1877 	    {
1878 	      value = value_x_unop (arg1, op, noside);
1879 	    }
1880 
1881 	  if (except.reason < 0)
1882 	    {
1883 	      if (except.error == NOT_FOUND_ERROR)
1884 		break;
1885 	      else
1886 		throw_exception (except);
1887 	    }
1888 	  arg1 = value;
1889 	}
1890 
1891       /* JYG: if print object is on we need to replace the base type
1892 	 with rtti type in order to continue on with successful
1893 	 lookup of member / method only available in the rtti type.  */
1894       {
1895         struct type *type = value_type (arg1);
1896         struct type *real_type;
1897         int full, top, using_enc;
1898 	struct value_print_options opts;
1899 
1900 	get_user_print_options (&opts);
1901         if (opts.objectprint && TYPE_TARGET_TYPE(type)
1902             && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1903           {
1904             real_type = value_rtti_indirect_type (arg1, &full, &top,
1905 						  &using_enc);
1906             if (real_type)
1907                 arg1 = value_cast (real_type, arg1);
1908           }
1909       }
1910 
1911       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1912 	return value_zero (lookup_struct_elt_type (value_type (arg1),
1913 						   &exp->elts[pc + 2].string,
1914 						   0),
1915 			   lval_memory);
1916       else
1917 	{
1918 	  struct value *temp = arg1;
1919 
1920 	  return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1921 				   NULL, "structure pointer");
1922 	}
1923 
1924     case STRUCTOP_MEMBER:
1925     case STRUCTOP_MPTR:
1926       if (op == STRUCTOP_MEMBER)
1927 	arg1 = evaluate_subexp_for_address (exp, pos, noside);
1928       else
1929 	arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1930 
1931       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1932 
1933       if (noside == EVAL_SKIP)
1934 	goto nosideret;
1935 
1936       type = check_typedef (value_type (arg2));
1937       switch (TYPE_CODE (type))
1938 	{
1939 	case TYPE_CODE_METHODPTR:
1940 	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
1941 	    return value_zero (TYPE_TARGET_TYPE (type), not_lval);
1942 	  else
1943 	    {
1944 	      arg2 = cplus_method_ptr_to_value (&arg1, arg2);
1945 	      gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
1946 	      return value_ind (arg2);
1947 	    }
1948 
1949 	case TYPE_CODE_MEMBERPTR:
1950 	  /* Now, convert these values to an address.  */
1951 	  arg1 = value_cast_pointers (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1952 				      arg1, 1);
1953 
1954 	  mem_offset = value_as_long (arg2);
1955 
1956 	  arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1957 				     value_as_long (arg1) + mem_offset);
1958 	  return value_ind (arg3);
1959 
1960 	default:
1961 	  error (_("non-pointer-to-member value used "
1962 		   "in pointer-to-member construct"));
1963 	}
1964 
1965     case TYPE_INSTANCE:
1966       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1967       arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
1968       for (ix = 0; ix < nargs; ++ix)
1969 	arg_types[ix] = exp->elts[pc + 1 + ix + 1].type;
1970 
1971       expect_type = make_params (nargs, arg_types);
1972       *(pos) += 3 + nargs;
1973       arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
1974       xfree (TYPE_FIELDS (expect_type));
1975       xfree (TYPE_MAIN_TYPE (expect_type));
1976       xfree (expect_type);
1977       return arg1;
1978 
1979     case BINOP_CONCAT:
1980       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1981       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1982       if (noside == EVAL_SKIP)
1983 	goto nosideret;
1984       if (binop_user_defined_p (op, arg1, arg2))
1985 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1986       else
1987 	return value_concat (arg1, arg2);
1988 
1989     case BINOP_ASSIGN:
1990       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1991       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1992 
1993       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1994 	return arg1;
1995       if (binop_user_defined_p (op, arg1, arg2))
1996 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1997       else
1998 	return value_assign (arg1, arg2);
1999 
2000     case BINOP_ASSIGN_MODIFY:
2001       (*pos) += 2;
2002       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2003       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2004       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2005 	return arg1;
2006       op = exp->elts[pc + 1].opcode;
2007       if (binop_user_defined_p (op, arg1, arg2))
2008 	return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
2009       else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
2010 						  value_type (arg1))
2011 	       && is_integral_type (value_type (arg2)))
2012 	arg2 = value_ptradd (arg1, value_as_long (arg2));
2013       else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
2014 						  value_type (arg1))
2015 	       && is_integral_type (value_type (arg2)))
2016 	arg2 = value_ptradd (arg1, - value_as_long (arg2));
2017       else
2018 	{
2019 	  struct value *tmp = arg1;
2020 
2021 	  /* For shift and integer exponentiation operations,
2022 	     only promote the first argument.  */
2023 	  if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2024 	      && is_integral_type (value_type (arg2)))
2025 	    unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2026 	  else
2027 	    binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2028 
2029 	  arg2 = value_binop (tmp, arg2, op);
2030 	}
2031       return value_assign (arg1, arg2);
2032 
2033     case BINOP_ADD:
2034       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2035       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2036       if (noside == EVAL_SKIP)
2037 	goto nosideret;
2038       if (binop_user_defined_p (op, arg1, arg2))
2039 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2040       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2041 	       && is_integral_type (value_type (arg2)))
2042 	return value_ptradd (arg1, value_as_long (arg2));
2043       else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2044 	       && is_integral_type (value_type (arg1)))
2045 	return value_ptradd (arg2, value_as_long (arg1));
2046       else
2047 	{
2048 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2049 	  return value_binop (arg1, arg2, BINOP_ADD);
2050 	}
2051 
2052     case BINOP_SUB:
2053       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2054       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2055       if (noside == EVAL_SKIP)
2056 	goto nosideret;
2057       if (binop_user_defined_p (op, arg1, arg2))
2058 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2059       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2060 	       && ptrmath_type_p (exp->language_defn, value_type (arg2)))
2061 	{
2062 	  /* FIXME -- should be ptrdiff_t */
2063 	  type = builtin_type (exp->gdbarch)->builtin_long;
2064 	  return value_from_longest (type, value_ptrdiff (arg1, arg2));
2065 	}
2066       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2067 	       && is_integral_type (value_type (arg2)))
2068 	return value_ptradd (arg1, - value_as_long (arg2));
2069       else
2070 	{
2071 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2072 	  return value_binop (arg1, arg2, BINOP_SUB);
2073 	}
2074 
2075     case BINOP_EXP:
2076     case BINOP_MUL:
2077     case BINOP_DIV:
2078     case BINOP_INTDIV:
2079     case BINOP_REM:
2080     case BINOP_MOD:
2081     case BINOP_LSH:
2082     case BINOP_RSH:
2083     case BINOP_BITWISE_AND:
2084     case BINOP_BITWISE_IOR:
2085     case BINOP_BITWISE_XOR:
2086       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2087       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2088       if (noside == EVAL_SKIP)
2089 	goto nosideret;
2090       if (binop_user_defined_p (op, arg1, arg2))
2091 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2092       else
2093 	{
2094 	  /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2095 	     fudge arg2 to avoid division-by-zero, the caller is
2096 	     (theoretically) only looking for the type of the result.  */
2097 	  if (noside == EVAL_AVOID_SIDE_EFFECTS
2098 	      /* ??? Do we really want to test for BINOP_MOD here?
2099 		 The implementation of value_binop gives it a well-defined
2100 		 value.  */
2101 	      && (op == BINOP_DIV
2102 		  || op == BINOP_INTDIV
2103 		  || op == BINOP_REM
2104 		  || op == BINOP_MOD)
2105 	      && value_logical_not (arg2))
2106 	    {
2107 	      struct value *v_one, *retval;
2108 
2109 	      v_one = value_one (value_type (arg2));
2110 	      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
2111 	      retval = value_binop (arg1, v_one, op);
2112 	      return retval;
2113 	    }
2114 	  else
2115 	    {
2116 	      /* For shift and integer exponentiation operations,
2117 		 only promote the first argument.  */
2118 	      if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2119 		  && is_integral_type (value_type (arg2)))
2120 		unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2121 	      else
2122 		binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2123 
2124 	      return value_binop (arg1, arg2, op);
2125 	    }
2126 	}
2127 
2128     case BINOP_RANGE:
2129       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2130       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2131       if (noside == EVAL_SKIP)
2132 	goto nosideret;
2133       error (_("':' operator used in invalid context"));
2134 
2135     case BINOP_SUBSCRIPT:
2136       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2137       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2138       if (noside == EVAL_SKIP)
2139 	goto nosideret;
2140       if (binop_user_defined_p (op, arg1, arg2))
2141 	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2142       else
2143 	{
2144 	  /* If the user attempts to subscript something that is not an
2145 	     array or pointer type (like a plain int variable for example),
2146 	     then report this as an error.  */
2147 
2148 	  arg1 = coerce_ref (arg1);
2149 	  type = check_typedef (value_type (arg1));
2150 	  if (TYPE_CODE (type) != TYPE_CODE_ARRAY
2151 	      && TYPE_CODE (type) != TYPE_CODE_PTR)
2152 	    {
2153 	      if (TYPE_NAME (type))
2154 		error (_("cannot subscript something of type `%s'"),
2155 		       TYPE_NAME (type));
2156 	      else
2157 		error (_("cannot subscript requested type"));
2158 	    }
2159 
2160 	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
2161 	    return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2162 	  else
2163 	    return value_subscript (arg1, value_as_long (arg2));
2164 	}
2165 
2166     case BINOP_IN:
2167       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2168       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2169       if (noside == EVAL_SKIP)
2170 	goto nosideret;
2171       type = language_bool_type (exp->language_defn, exp->gdbarch);
2172       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
2173 
2174     case MULTI_SUBSCRIPT:
2175       (*pos) += 2;
2176       nargs = longest_to_int (exp->elts[pc + 1].longconst);
2177       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2178       while (nargs-- > 0)
2179 	{
2180 	  arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2181 	  /* FIXME:  EVAL_SKIP handling may not be correct.  */
2182 	  if (noside == EVAL_SKIP)
2183 	    {
2184 	      if (nargs > 0)
2185 		{
2186 		  continue;
2187 		}
2188 	      else
2189 		{
2190 		  goto nosideret;
2191 		}
2192 	    }
2193 	  /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct.  */
2194 	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
2195 	    {
2196 	      /* If the user attempts to subscript something that has no target
2197 	         type (like a plain int variable for example), then report this
2198 	         as an error.  */
2199 
2200 	      type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
2201 	      if (type != NULL)
2202 		{
2203 		  arg1 = value_zero (type, VALUE_LVAL (arg1));
2204 		  noside = EVAL_SKIP;
2205 		  continue;
2206 		}
2207 	      else
2208 		{
2209 		  error (_("cannot subscript something of type `%s'"),
2210 			 TYPE_NAME (value_type (arg1)));
2211 		}
2212 	    }
2213 
2214 	  if (binop_user_defined_p (op, arg1, arg2))
2215 	    {
2216 	      arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2217 	    }
2218 	  else
2219 	    {
2220 	      arg1 = coerce_ref (arg1);
2221 	      type = check_typedef (value_type (arg1));
2222 
2223 	      switch (TYPE_CODE (type))
2224 		{
2225 		case TYPE_CODE_PTR:
2226 		case TYPE_CODE_ARRAY:
2227 		case TYPE_CODE_STRING:
2228 		  arg1 = value_subscript (arg1, value_as_long (arg2));
2229 		  break;
2230 
2231 		default:
2232 		  if (TYPE_NAME (type))
2233 		    error (_("cannot subscript something of type `%s'"),
2234 			   TYPE_NAME (type));
2235 		  else
2236 		    error (_("cannot subscript requested type"));
2237 		}
2238 	    }
2239 	}
2240       return (arg1);
2241 
2242     multi_f77_subscript:
2243       {
2244 	LONGEST subscript_array[MAX_FORTRAN_DIMS];
2245 	int ndimensions = 1, i;
2246 	struct value *array = arg1;
2247 
2248 	if (nargs > MAX_FORTRAN_DIMS)
2249 	  error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2250 
2251 	ndimensions = calc_f77_array_dims (type);
2252 
2253 	if (nargs != ndimensions)
2254 	  error (_("Wrong number of subscripts"));
2255 
2256 	gdb_assert (nargs > 0);
2257 
2258 	/* Now that we know we have a legal array subscript expression
2259 	   let us actually find out where this element exists in the array.  */
2260 
2261 	/* Take array indices left to right.  */
2262 	for (i = 0; i < nargs; i++)
2263 	  {
2264 	    /* Evaluate each subscript; it must be a legal integer in F77.  */
2265 	    arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2266 
2267 	    /* Fill in the subscript array.  */
2268 
2269 	    subscript_array[i] = value_as_long (arg2);
2270 	  }
2271 
2272 	/* Internal type of array is arranged right to left.  */
2273 	for (i = nargs; i > 0; i--)
2274 	  {
2275 	    struct type *array_type = check_typedef (value_type (array));
2276 	    LONGEST index = subscript_array[i - 1];
2277 
2278 	    array = value_subscripted_rvalue (array, index,
2279 					      f77_get_lowerbound (array_type));
2280 	  }
2281 
2282 	return array;
2283       }
2284 
2285     case BINOP_LOGICAL_AND:
2286       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2287       if (noside == EVAL_SKIP)
2288 	{
2289 	  evaluate_subexp (NULL_TYPE, exp, pos, noside);
2290 	  goto nosideret;
2291 	}
2292 
2293       oldpos = *pos;
2294       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2295       *pos = oldpos;
2296 
2297       if (binop_user_defined_p (op, arg1, arg2))
2298 	{
2299 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2300 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2301 	}
2302       else
2303 	{
2304 	  tem = value_logical_not (arg1);
2305 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2306 				  (tem ? EVAL_SKIP : noside));
2307 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2308 	  return value_from_longest (type,
2309 			     (LONGEST) (!tem && !value_logical_not (arg2)));
2310 	}
2311 
2312     case BINOP_LOGICAL_OR:
2313       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2314       if (noside == EVAL_SKIP)
2315 	{
2316 	  evaluate_subexp (NULL_TYPE, exp, pos, noside);
2317 	  goto nosideret;
2318 	}
2319 
2320       oldpos = *pos;
2321       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2322       *pos = oldpos;
2323 
2324       if (binop_user_defined_p (op, arg1, arg2))
2325 	{
2326 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2327 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2328 	}
2329       else
2330 	{
2331 	  tem = value_logical_not (arg1);
2332 	  arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2333 				  (!tem ? EVAL_SKIP : noside));
2334 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2335 	  return value_from_longest (type,
2336 			     (LONGEST) (!tem || !value_logical_not (arg2)));
2337 	}
2338 
2339     case BINOP_EQUAL:
2340       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2341       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2342       if (noside == EVAL_SKIP)
2343 	goto nosideret;
2344       if (binop_user_defined_p (op, arg1, arg2))
2345 	{
2346 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2347 	}
2348       else
2349 	{
2350 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2351 	  tem = value_equal (arg1, arg2);
2352 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2353 	  return value_from_longest (type, (LONGEST) tem);
2354 	}
2355 
2356     case BINOP_NOTEQUAL:
2357       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2358       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2359       if (noside == EVAL_SKIP)
2360 	goto nosideret;
2361       if (binop_user_defined_p (op, arg1, arg2))
2362 	{
2363 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2364 	}
2365       else
2366 	{
2367 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2368 	  tem = value_equal (arg1, arg2);
2369 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2370 	  return value_from_longest (type, (LONGEST) ! tem);
2371 	}
2372 
2373     case BINOP_LESS:
2374       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2375       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2376       if (noside == EVAL_SKIP)
2377 	goto nosideret;
2378       if (binop_user_defined_p (op, arg1, arg2))
2379 	{
2380 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2381 	}
2382       else
2383 	{
2384 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2385 	  tem = value_less (arg1, arg2);
2386 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2387 	  return value_from_longest (type, (LONGEST) tem);
2388 	}
2389 
2390     case BINOP_GTR:
2391       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2392       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2393       if (noside == EVAL_SKIP)
2394 	goto nosideret;
2395       if (binop_user_defined_p (op, arg1, arg2))
2396 	{
2397 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2398 	}
2399       else
2400 	{
2401 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2402 	  tem = value_less (arg2, arg1);
2403 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2404 	  return value_from_longest (type, (LONGEST) tem);
2405 	}
2406 
2407     case BINOP_GEQ:
2408       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2409       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2410       if (noside == EVAL_SKIP)
2411 	goto nosideret;
2412       if (binop_user_defined_p (op, arg1, arg2))
2413 	{
2414 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2415 	}
2416       else
2417 	{
2418 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2419 	  tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2420 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2421 	  return value_from_longest (type, (LONGEST) tem);
2422 	}
2423 
2424     case BINOP_LEQ:
2425       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2426       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2427       if (noside == EVAL_SKIP)
2428 	goto nosideret;
2429       if (binop_user_defined_p (op, arg1, arg2))
2430 	{
2431 	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2432 	}
2433       else
2434 	{
2435 	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2436 	  tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2437 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2438 	  return value_from_longest (type, (LONGEST) tem);
2439 	}
2440 
2441     case BINOP_REPEAT:
2442       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2443       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2444       if (noside == EVAL_SKIP)
2445 	goto nosideret;
2446       type = check_typedef (value_type (arg2));
2447       if (TYPE_CODE (type) != TYPE_CODE_INT)
2448 	error (_("Non-integral right operand for \"@\" operator."));
2449       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2450 	{
2451 	  return allocate_repeat_value (value_type (arg1),
2452 				     longest_to_int (value_as_long (arg2)));
2453 	}
2454       else
2455 	return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2456 
2457     case BINOP_COMMA:
2458       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2459       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2460 
2461     case UNOP_PLUS:
2462       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2463       if (noside == EVAL_SKIP)
2464 	goto nosideret;
2465       if (unop_user_defined_p (op, arg1))
2466 	return value_x_unop (arg1, op, noside);
2467       else
2468 	{
2469 	  unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2470 	  return value_pos (arg1);
2471 	}
2472 
2473     case UNOP_NEG:
2474       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2475       if (noside == EVAL_SKIP)
2476 	goto nosideret;
2477       if (unop_user_defined_p (op, arg1))
2478 	return value_x_unop (arg1, op, noside);
2479       else
2480 	{
2481 	  unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2482 	  return value_neg (arg1);
2483 	}
2484 
2485     case UNOP_COMPLEMENT:
2486       /* C++: check for and handle destructor names.  */
2487       op = exp->elts[*pos].opcode;
2488 
2489       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2490       if (noside == EVAL_SKIP)
2491 	goto nosideret;
2492       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2493 	return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2494       else
2495 	{
2496 	  unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2497 	  return value_complement (arg1);
2498 	}
2499 
2500     case UNOP_LOGICAL_NOT:
2501       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2502       if (noside == EVAL_SKIP)
2503 	goto nosideret;
2504       if (unop_user_defined_p (op, arg1))
2505 	return value_x_unop (arg1, op, noside);
2506       else
2507 	{
2508 	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2509 	  return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2510 	}
2511 
2512     case UNOP_IND:
2513       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2514 	expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2515       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2516       type = check_typedef (value_type (arg1));
2517       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2518 	  || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2519 	error (_("Attempt to dereference pointer "
2520 		 "to member without an object"));
2521       if (noside == EVAL_SKIP)
2522 	goto nosideret;
2523       if (unop_user_defined_p (op, arg1))
2524 	return value_x_unop (arg1, op, noside);
2525       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2526 	{
2527 	  type = check_typedef (value_type (arg1));
2528 	  if (TYPE_CODE (type) == TYPE_CODE_PTR
2529 	      || TYPE_CODE (type) == TYPE_CODE_REF
2530 	  /* In C you can dereference an array to get the 1st elt.  */
2531 	      || TYPE_CODE (type) == TYPE_CODE_ARRAY
2532 	    )
2533 	    return value_zero (TYPE_TARGET_TYPE (type),
2534 			       lval_memory);
2535 	  else if (TYPE_CODE (type) == TYPE_CODE_INT)
2536 	    /* GDB allows dereferencing an int.  */
2537 	    return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2538 			       lval_memory);
2539 	  else
2540 	    error (_("Attempt to take contents of a non-pointer value."));
2541 	}
2542 
2543       /* Allow * on an integer so we can cast it to whatever we want.
2544 	 This returns an int, which seems like the most C-like thing to
2545 	 do.  "long long" variables are rare enough that
2546 	 BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2547       if (TYPE_CODE (type) == TYPE_CODE_INT)
2548 	return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2549 			      (CORE_ADDR) value_as_address (arg1));
2550       return value_ind (arg1);
2551 
2552     case UNOP_ADDR:
2553       /* C++: check for and handle pointer to members.  */
2554 
2555       op = exp->elts[*pos].opcode;
2556 
2557       if (noside == EVAL_SKIP)
2558 	{
2559 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2560 	  goto nosideret;
2561 	}
2562       else
2563 	{
2564 	  struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2565 							       noside);
2566 
2567 	  return retvalp;
2568 	}
2569 
2570     case UNOP_SIZEOF:
2571       if (noside == EVAL_SKIP)
2572 	{
2573 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2574 	  goto nosideret;
2575 	}
2576       return evaluate_subexp_for_sizeof (exp, pos);
2577 
2578     case UNOP_CAST:
2579       (*pos) += 2;
2580       type = exp->elts[pc + 1].type;
2581       arg1 = evaluate_subexp (type, exp, pos, noside);
2582       if (noside == EVAL_SKIP)
2583 	goto nosideret;
2584       if (type != value_type (arg1))
2585 	arg1 = value_cast (type, arg1);
2586       return arg1;
2587 
2588     case UNOP_CAST_TYPE:
2589       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2590       type = value_type (arg1);
2591       arg1 = evaluate_subexp (type, exp, pos, noside);
2592       if (noside == EVAL_SKIP)
2593 	goto nosideret;
2594       if (type != value_type (arg1))
2595 	arg1 = value_cast (type, arg1);
2596       return arg1;
2597 
2598     case UNOP_DYNAMIC_CAST:
2599       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2600       type = value_type (arg1);
2601       arg1 = evaluate_subexp (type, exp, pos, noside);
2602       if (noside == EVAL_SKIP)
2603 	goto nosideret;
2604       return value_dynamic_cast (type, arg1);
2605 
2606     case UNOP_REINTERPRET_CAST:
2607       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2608       type = value_type (arg1);
2609       arg1 = evaluate_subexp (type, exp, pos, noside);
2610       if (noside == EVAL_SKIP)
2611 	goto nosideret;
2612       return value_reinterpret_cast (type, arg1);
2613 
2614     case UNOP_MEMVAL:
2615       (*pos) += 2;
2616       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2617       if (noside == EVAL_SKIP)
2618 	goto nosideret;
2619       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2620 	return value_zero (exp->elts[pc + 1].type, lval_memory);
2621       else
2622 	return value_at_lazy (exp->elts[pc + 1].type,
2623 			      value_as_address (arg1));
2624 
2625     case UNOP_MEMVAL_TYPE:
2626       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2627       type = value_type (arg1);
2628       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2629       if (noside == EVAL_SKIP)
2630 	goto nosideret;
2631       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2632 	return value_zero (type, lval_memory);
2633       else
2634 	return value_at_lazy (type, value_as_address (arg1));
2635 
2636     case UNOP_MEMVAL_TLS:
2637       (*pos) += 3;
2638       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2639       if (noside == EVAL_SKIP)
2640 	goto nosideret;
2641       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2642 	return value_zero (exp->elts[pc + 2].type, lval_memory);
2643       else
2644 	{
2645 	  CORE_ADDR tls_addr;
2646 
2647 	  tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2648 						   value_as_address (arg1));
2649 	  return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2650 	}
2651 
2652     case UNOP_PREINCREMENT:
2653       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2654       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2655 	return arg1;
2656       else if (unop_user_defined_p (op, arg1))
2657 	{
2658 	  return value_x_unop (arg1, op, noside);
2659 	}
2660       else
2661 	{
2662 	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2663 	    arg2 = value_ptradd (arg1, 1);
2664 	  else
2665 	    {
2666 	      struct value *tmp = arg1;
2667 
2668 	      arg2 = value_one (value_type (arg1));
2669 	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2670 	      arg2 = value_binop (tmp, arg2, BINOP_ADD);
2671 	    }
2672 
2673 	  return value_assign (arg1, arg2);
2674 	}
2675 
2676     case UNOP_PREDECREMENT:
2677       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2678       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2679 	return arg1;
2680       else if (unop_user_defined_p (op, arg1))
2681 	{
2682 	  return value_x_unop (arg1, op, noside);
2683 	}
2684       else
2685 	{
2686 	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2687 	    arg2 = value_ptradd (arg1, -1);
2688 	  else
2689 	    {
2690 	      struct value *tmp = arg1;
2691 
2692 	      arg2 = value_one (value_type (arg1));
2693 	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2694 	      arg2 = value_binop (tmp, arg2, BINOP_SUB);
2695 	    }
2696 
2697 	  return value_assign (arg1, arg2);
2698 	}
2699 
2700     case UNOP_POSTINCREMENT:
2701       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2702       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2703 	return arg1;
2704       else if (unop_user_defined_p (op, arg1))
2705 	{
2706 	  return value_x_unop (arg1, op, noside);
2707 	}
2708       else
2709 	{
2710 	  arg3 = value_non_lval (arg1);
2711 
2712 	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2713 	    arg2 = value_ptradd (arg1, 1);
2714 	  else
2715 	    {
2716 	      struct value *tmp = arg1;
2717 
2718 	      arg2 = value_one (value_type (arg1));
2719 	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2720 	      arg2 = value_binop (tmp, arg2, BINOP_ADD);
2721 	    }
2722 
2723 	  value_assign (arg1, arg2);
2724 	  return arg3;
2725 	}
2726 
2727     case UNOP_POSTDECREMENT:
2728       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2729       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2730 	return arg1;
2731       else if (unop_user_defined_p (op, arg1))
2732 	{
2733 	  return value_x_unop (arg1, op, noside);
2734 	}
2735       else
2736 	{
2737 	  arg3 = value_non_lval (arg1);
2738 
2739 	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2740 	    arg2 = value_ptradd (arg1, -1);
2741 	  else
2742 	    {
2743 	      struct value *tmp = arg1;
2744 
2745 	      arg2 = value_one (value_type (arg1));
2746 	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2747 	      arg2 = value_binop (tmp, arg2, BINOP_SUB);
2748 	    }
2749 
2750 	  value_assign (arg1, arg2);
2751 	  return arg3;
2752 	}
2753 
2754     case OP_THIS:
2755       (*pos) += 1;
2756       return value_of_this (exp->language_defn);
2757 
2758     case OP_TYPE:
2759       /* The value is not supposed to be used.  This is here to make it
2760          easier to accommodate expressions that contain types.  */
2761       (*pos) += 2;
2762       if (noside == EVAL_SKIP)
2763         goto nosideret;
2764       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2765 	{
2766 	  struct type *type = exp->elts[pc + 1].type;
2767 
2768 	  /* If this is a typedef, then find its immediate target.  We
2769 	     use check_typedef to resolve stubs, but we ignore its
2770 	     result because we do not want to dig past all
2771 	     typedefs.  */
2772 	  check_typedef (type);
2773 	  if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
2774 	    type = TYPE_TARGET_TYPE (type);
2775 	  return allocate_value (type);
2776 	}
2777       else
2778         error (_("Attempt to use a type name as an expression"));
2779 
2780     case OP_TYPEOF:
2781     case OP_DECLTYPE:
2782       if (noside == EVAL_SKIP)
2783 	{
2784 	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2785 	  goto nosideret;
2786 	}
2787       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2788 	{
2789 	  enum exp_opcode sub_op = exp->elts[*pos].opcode;
2790 	  struct value *result;
2791 
2792 	  result = evaluate_subexp (NULL_TYPE, exp, pos,
2793 				    EVAL_AVOID_SIDE_EFFECTS);
2794 
2795 	  /* 'decltype' has special semantics for lvalues.  */
2796 	  if (op == OP_DECLTYPE
2797 	      && (sub_op == BINOP_SUBSCRIPT
2798 		  || sub_op == STRUCTOP_MEMBER
2799 		  || sub_op == STRUCTOP_MPTR
2800 		  || sub_op == UNOP_IND
2801 		  || sub_op == STRUCTOP_STRUCT
2802 		  || sub_op == STRUCTOP_PTR
2803 		  || sub_op == OP_SCOPE))
2804 	    {
2805 	      struct type *type = value_type (result);
2806 
2807 	      if (TYPE_CODE (check_typedef (type)) != TYPE_CODE_REF)
2808 		{
2809 		  type = lookup_reference_type (type);
2810 		  result = allocate_value (type);
2811 		}
2812 	    }
2813 
2814 	  return result;
2815 	}
2816       else
2817         error (_("Attempt to use a type as an expression"));
2818 
2819     default:
2820       /* Removing this case and compiling with gcc -Wall reveals that
2821          a lot of cases are hitting this case.  Some of these should
2822          probably be removed from expression.h; others are legitimate
2823          expressions which are (apparently) not fully implemented.
2824 
2825          If there are any cases landing here which mean a user error,
2826          then they should be separate cases, with more descriptive
2827          error messages.  */
2828 
2829       error (_("GDB does not (yet) know how to "
2830 	       "evaluate that kind of expression"));
2831     }
2832 
2833 nosideret:
2834   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
2835 }
2836 
2837 /* Evaluate a subexpression of EXP, at index *POS,
2838    and return the address of that subexpression.
2839    Advance *POS over the subexpression.
2840    If the subexpression isn't an lvalue, get an error.
2841    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2842    then only the type of the result need be correct.  */
2843 
2844 static struct value *
evaluate_subexp_for_address(struct expression * exp,int * pos,enum noside noside)2845 evaluate_subexp_for_address (struct expression *exp, int *pos,
2846 			     enum noside noside)
2847 {
2848   enum exp_opcode op;
2849   int pc;
2850   struct symbol *var;
2851   struct value *x;
2852   int tem;
2853 
2854   pc = (*pos);
2855   op = exp->elts[pc].opcode;
2856 
2857   switch (op)
2858     {
2859     case UNOP_IND:
2860       (*pos)++;
2861       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2862 
2863       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2864       if (unop_user_defined_p (op, x))
2865 	{
2866 	  x = value_x_unop (x, op, noside);
2867 	  goto default_case_after_eval;
2868 	}
2869 
2870       return coerce_array (x);
2871 
2872     case UNOP_MEMVAL:
2873       (*pos) += 3;
2874       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2875 			 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2876 
2877     case UNOP_MEMVAL_TYPE:
2878       {
2879 	struct type *type;
2880 
2881 	(*pos) += 1;
2882 	x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2883 	type = value_type (x);
2884 	return value_cast (lookup_pointer_type (type),
2885 			   evaluate_subexp (NULL_TYPE, exp, pos, noside));
2886       }
2887 
2888     case OP_VAR_VALUE:
2889       var = exp->elts[pc + 2].symbol;
2890 
2891       /* C++: The "address" of a reference should yield the address
2892        * of the object pointed to.  Let value_addr() deal with it.  */
2893       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2894 	goto default_case;
2895 
2896       (*pos) += 4;
2897       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2898 	{
2899 	  struct type *type =
2900 	    lookup_pointer_type (SYMBOL_TYPE (var));
2901 	  enum address_class sym_class = SYMBOL_CLASS (var);
2902 
2903 	  if (sym_class == LOC_CONST
2904 	      || sym_class == LOC_CONST_BYTES
2905 	      || sym_class == LOC_REGISTER)
2906 	    error (_("Attempt to take address of register or constant."));
2907 
2908 	  return
2909 	    value_zero (type, not_lval);
2910 	}
2911       else
2912 	return address_of_variable (var, exp->elts[pc + 1].block);
2913 
2914     case OP_SCOPE:
2915       tem = longest_to_int (exp->elts[pc + 2].longconst);
2916       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2917       x = value_aggregate_elt (exp->elts[pc + 1].type,
2918 			       &exp->elts[pc + 3].string,
2919 			       NULL, 1, noside);
2920       if (x == NULL)
2921 	error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2922       return x;
2923 
2924     default:
2925     default_case:
2926       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2927     default_case_after_eval:
2928       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2929 	{
2930 	  struct type *type = check_typedef (value_type (x));
2931 
2932 	  if (TYPE_CODE (type) == TYPE_CODE_REF)
2933 	    return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2934 			       not_lval);
2935 	  else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2936 	    return value_zero (lookup_pointer_type (value_type (x)),
2937 			       not_lval);
2938 	  else
2939 	    error (_("Attempt to take address of "
2940 		     "value not located in memory."));
2941 	}
2942       return value_addr (x);
2943     }
2944 }
2945 
2946 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2947    When used in contexts where arrays will be coerced anyway, this is
2948    equivalent to `evaluate_subexp' but much faster because it avoids
2949    actually fetching array contents (perhaps obsolete now that we have
2950    value_lazy()).
2951 
2952    Note that we currently only do the coercion for C expressions, where
2953    arrays are zero based and the coercion is correct.  For other languages,
2954    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2955    to decide if coercion is appropriate.  */
2956 
2957 struct value *
evaluate_subexp_with_coercion(struct expression * exp,int * pos,enum noside noside)2958 evaluate_subexp_with_coercion (struct expression *exp,
2959 			       int *pos, enum noside noside)
2960 {
2961   enum exp_opcode op;
2962   int pc;
2963   struct value *val;
2964   struct symbol *var;
2965   struct type *type;
2966 
2967   pc = (*pos);
2968   op = exp->elts[pc].opcode;
2969 
2970   switch (op)
2971     {
2972     case OP_VAR_VALUE:
2973       var = exp->elts[pc + 2].symbol;
2974       type = check_typedef (SYMBOL_TYPE (var));
2975       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
2976 	  && !TYPE_VECTOR (type)
2977 	  && CAST_IS_CONVERSION (exp->language_defn))
2978 	{
2979 	  (*pos) += 4;
2980 	  val = address_of_variable (var, exp->elts[pc + 1].block);
2981 	  return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2982 			     val);
2983 	}
2984       /* FALLTHROUGH */
2985 
2986     default:
2987       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2988     }
2989 }
2990 
2991 /* Evaluate a subexpression of EXP, at index *POS,
2992    and return a value for the size of that subexpression.
2993    Advance *POS over the subexpression.  */
2994 
2995 static struct value *
evaluate_subexp_for_sizeof(struct expression * exp,int * pos)2996 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2997 {
2998   /* FIXME: This should be size_t.  */
2999   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3000   enum exp_opcode op;
3001   int pc;
3002   struct type *type;
3003   struct value *val;
3004 
3005   pc = (*pos);
3006   op = exp->elts[pc].opcode;
3007 
3008   switch (op)
3009     {
3010       /* This case is handled specially
3011          so that we avoid creating a value for the result type.
3012          If the result type is very big, it's desirable not to
3013          create a value unnecessarily.  */
3014     case UNOP_IND:
3015       (*pos)++;
3016       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3017       type = check_typedef (value_type (val));
3018       if (TYPE_CODE (type) != TYPE_CODE_PTR
3019 	  && TYPE_CODE (type) != TYPE_CODE_REF
3020 	  && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3021 	error (_("Attempt to take contents of a non-pointer value."));
3022       type = check_typedef (TYPE_TARGET_TYPE (type));
3023       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3024 
3025     case UNOP_MEMVAL:
3026       (*pos) += 3;
3027       type = check_typedef (exp->elts[pc + 1].type);
3028       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3029 
3030     case UNOP_MEMVAL_TYPE:
3031       (*pos) += 1;
3032       val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3033       type = check_typedef (value_type (val));
3034       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3035 
3036     case OP_VAR_VALUE:
3037       (*pos) += 4;
3038       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
3039       return
3040 	value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3041 
3042     default:
3043       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3044       return value_from_longest (size_type,
3045 				 (LONGEST) TYPE_LENGTH (value_type (val)));
3046     }
3047 }
3048 
3049 /* Parse a type expression in the string [P..P+LENGTH).  */
3050 
3051 struct type *
parse_and_eval_type(char * p,int length)3052 parse_and_eval_type (char *p, int length)
3053 {
3054   char *tmp = (char *) alloca (length + 4);
3055   struct expression *expr;
3056 
3057   tmp[0] = '(';
3058   memcpy (tmp + 1, p, length);
3059   tmp[length + 1] = ')';
3060   tmp[length + 2] = '0';
3061   tmp[length + 3] = '\0';
3062   expr = parse_expression (tmp);
3063   if (expr->elts[0].opcode != UNOP_CAST)
3064     error (_("Internal error in eval_type."));
3065   return expr->elts[1].type;
3066 }
3067 
3068 int
calc_f77_array_dims(struct type * array_type)3069 calc_f77_array_dims (struct type *array_type)
3070 {
3071   int ndimen = 1;
3072   struct type *tmp_type;
3073 
3074   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3075     error (_("Can't get dimensions for a non-array type"));
3076 
3077   tmp_type = array_type;
3078 
3079   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3080     {
3081       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3082 	++ndimen;
3083     }
3084   return ndimen;
3085 }
3086