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