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