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