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