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