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