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