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