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