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