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