1262710Sganbold/* Evaluate expressions for GDB.
2266337Sian
3262710Sganbold   Copyright (C) 1986-2020 Free Software Foundation, Inc.
4262710Sganbold
5262710Sganbold   This file is part of GDB.
6262710Sganbold
7262710Sganbold   This program is free software; you can redistribute it and/or modify
8262710Sganbold   it under the terms of the GNU General Public License as published by
9262710Sganbold   the Free Software Foundation; either version 3 of the License, or
10262710Sganbold   (at your option) any later version.
11262710Sganbold
12262710Sganbold   This program is distributed in the hope that it will be useful,
13262710Sganbold   but WITHOUT ANY WARRANTY; without even the implied warranty of
14262710Sganbold   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15262710Sganbold   GNU General Public License for more details.
16262710Sganbold
17262710Sganbold   You should have received a copy of the GNU General Public License
18262710Sganbold   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19262710Sganbold
20262710Sganbold#include "defs.h"
21262710Sganbold#include "symtab.h"
22262710Sganbold#include "gdbtypes.h"
23262710Sganbold#include "value.h"
24262710Sganbold#include "expression.h"
25262710Sganbold#include "target.h"
26262710Sganbold#include "frame.h"
27262710Sganbold#include "gdbthread.h"
28262710Sganbold#include "language.h"		/* For CAST_IS_CONVERSION.  */
29262710Sganbold#include "f-lang.h"		/* For array bound stuff.  */
30262710Sganbold#include "cp-abi.h"
31262710Sganbold#include "infcall.h"
32262710Sganbold#include "objc-lang.h"
33262710Sganbold#include "block.h"
34262710Sganbold#include "parser-defs.h"
35262710Sganbold#include "cp-support.h"
36262710Sganbold#include "ui-out.h"
37262710Sganbold#include "regcache.h"
38262710Sganbold#include "user-regs.h"
39262710Sganbold#include "valprint.h"
40262710Sganbold#include "gdb_obstack.h"
41262710Sganbold#include "objfiles.h"
42262710Sganbold#include "typeprint.h"
43262710Sganbold#include <ctype.h>
44262710Sganbold
45262710Sganbold/* Prototypes for local functions.  */
46262710Sganbold
47262710Sganboldstatic struct value *evaluate_subexp_for_sizeof (struct expression *, int *,
48262710Sganbold						 enum noside);
49262710Sganbold
50262710Sganboldstatic struct value *evaluate_subexp_for_address (struct expression *,
51262710Sganbold						  int *, enum noside);
52262710Sganbold
53262710Sganboldstatic value *evaluate_subexp_for_cast (expression *exp, int *pos,
54262710Sganbold					enum noside noside,
55262710Sganbold					struct type *type);
56262710Sganbold
57262710Sganboldstatic struct value *evaluate_struct_tuple (struct value *,
58262710Sganbold					    struct expression *, int *,
59262710Sganbold					    enum noside, int);
60262710Sganbold
61262710Sganboldstatic LONGEST init_array_element (struct value *, struct value *,
62262710Sganbold				   struct expression *, int *, enum noside,
63262710Sganbold				   LONGEST, LONGEST);
64262710Sganbold
65262710Sganboldstruct value *
66262710Sganboldevaluate_subexp (struct type *expect_type, struct expression *exp,
67262710Sganbold		 int *pos, enum noside noside)
68262710Sganbold{
69262710Sganbold  struct value *retval;
70262710Sganbold
71262710Sganbold  gdb::optional<enable_thread_stack_temporaries> stack_temporaries;
72262710Sganbold  if (*pos == 0 && target_has_execution
73262710Sganbold      && exp->language_defn->la_language == language_cplus
74262710Sganbold      && !thread_stack_temporaries_enabled_p (inferior_thread ()))
75262710Sganbold    stack_temporaries.emplace (inferior_thread ());
76262710Sganbold
77262710Sganbold  retval = (*exp->language_defn->la_exp_desc->evaluate_exp)
78262710Sganbold    (expect_type, exp, pos, noside);
79262710Sganbold
80262710Sganbold  if (stack_temporaries.has_value ()
81262710Sganbold      && value_in_thread_stack_temporaries (retval, inferior_thread ()))
82262710Sganbold    retval = value_non_lval (retval);
83262710Sganbold
84262710Sganbold  return retval;
85262710Sganbold}
86262710Sganbold
87262710Sganbold/* Parse the string EXP as a C expression, evaluate it,
88262710Sganbold   and return the result as a number.  */
89262710Sganbold
90262710SganboldCORE_ADDR
91262710Sganboldparse_and_eval_address (const char *exp)
92262710Sganbold{
93262710Sganbold  expression_up expr = parse_expression (exp);
94262710Sganbold
95262710Sganbold  return value_as_address (evaluate_expression (expr.get ()));
96262710Sganbold}
97262710Sganbold
98262710Sganbold/* Like parse_and_eval_address, but treats the value of the expression
99262710Sganbold   as an integer, not an address, returns a LONGEST, not a CORE_ADDR.  */
100262710SganboldLONGEST
101262710Sganboldparse_and_eval_long (const char *exp)
102262710Sganbold{
103262710Sganbold  expression_up expr = parse_expression (exp);
104262710Sganbold
105262710Sganbold  return value_as_long (evaluate_expression (expr.get ()));
106262710Sganbold}
107262710Sganbold
108262710Sganboldstruct value *
109262710Sganboldparse_and_eval (const char *exp)
110262710Sganbold{
111262710Sganbold  expression_up expr = parse_expression (exp);
112262710Sganbold
113262710Sganbold  return evaluate_expression (expr.get ());
114262710Sganbold}
115262710Sganbold
116262710Sganbold/* Parse up to a comma (or to a closeparen)
117262710Sganbold   in the string EXPP as an expression, evaluate it, and return the value.
118262710Sganbold   EXPP is advanced to point to the comma.  */
119262710Sganbold
120262710Sganboldstruct value *
121262710Sganboldparse_to_comma_and_eval (const char **expp)
122262710Sganbold{
123262710Sganbold  expression_up expr = parse_exp_1 (expp, 0, nullptr, 1);
124262710Sganbold
125262710Sganbold  return evaluate_expression (expr.get ());
126262710Sganbold}
127262710Sganbold
128262710Sganbold/* Evaluate an expression in internal prefix form
129262710Sganbold   such as is constructed by parse.y.
130262710Sganbold
131262710Sganbold   See expression.h for info on the format of an expression.  */
132262710Sganbold
133262710Sganboldstruct value *
134262710Sganboldevaluate_expression (struct expression *exp)
135262710Sganbold{
136262710Sganbold  int pc = 0;
137262710Sganbold
138262710Sganbold  return evaluate_subexp (nullptr, exp, &pc, EVAL_NORMAL);
139262710Sganbold}
140262710Sganbold
141262710Sganbold/* Evaluate an expression, avoiding all memory references
142262710Sganbold   and getting a value whose type alone is correct.  */
143262710Sganbold
144262710Sganboldstruct value *
145262710Sganboldevaluate_type (struct expression *exp)
146262710Sganbold{
147262710Sganbold  int pc = 0;
148262710Sganbold
149262710Sganbold  return evaluate_subexp (nullptr, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
150262710Sganbold}
151262710Sganbold
152262710Sganbold/* Evaluate a subexpression, avoiding all memory references and
153262710Sganbold   getting a value whose type alone is correct.  */
154262710Sganbold
155262710Sganboldstruct value *
156262710Sganboldevaluate_subexpression_type (struct expression *exp, int subexp)
157262710Sganbold{
158262710Sganbold  return evaluate_subexp (nullptr, exp, &subexp, EVAL_AVOID_SIDE_EFFECTS);
159262710Sganbold}
160262710Sganbold
161262710Sganbold/* Find the current value of a watchpoint on EXP.  Return the value in
162262710Sganbold   *VALP and *RESULTP and the chain of intermediate and final values
163262710Sganbold   in *VAL_CHAIN.  RESULTP and VAL_CHAIN may be NULL if the caller does
164262710Sganbold   not need them.
165262710Sganbold
166262710Sganbold   If PRESERVE_ERRORS is true, then exceptions are passed through.
167262710Sganbold   Otherwise, if PRESERVE_ERRORS is false, then if a memory error
168262710Sganbold   occurs while evaluating the expression, *RESULTP will be set to
169262710Sganbold   NULL.  *RESULTP may be a lazy value, if the result could not be
170262710Sganbold   read from memory.  It is used to determine whether a value is
171262710Sganbold   user-specified (we should watch the whole value) or intermediate
172262710Sganbold   (we should watch only the bit used to locate the final value).
173262710Sganbold
174262710Sganbold   If the final value, or any intermediate value, could not be read
175262710Sganbold   from memory, *VALP will be set to NULL.  *VAL_CHAIN will still be
176262710Sganbold   set to any referenced values.  *VALP will never be a lazy value.
177262710Sganbold   This is the value which we store in struct breakpoint.
178262710Sganbold
179262710Sganbold   If VAL_CHAIN is non-NULL, the values put into *VAL_CHAIN will be
180262710Sganbold   released from the value chain.  If VAL_CHAIN is NULL, all generated
181262710Sganbold   values will be left on the value chain.  */
182262710Sganbold
183262710Sganboldvoid
184262710Sganboldfetch_subexp_value (struct expression *exp, int *pc, struct value **valp,
185262710Sganbold		    struct value **resultp,
186262710Sganbold		    std::vector<value_ref_ptr> *val_chain,
187262710Sganbold		    int preserve_errors)
188262710Sganbold{
189262710Sganbold  struct value *mark, *new_mark, *result;
190262710Sganbold
191262710Sganbold  *valp = NULL;
192262710Sganbold  if (resultp)
193262710Sganbold    *resultp = NULL;
194262710Sganbold  if (val_chain)
195262710Sganbold    val_chain->clear ();
196262710Sganbold
197262710Sganbold  /* Evaluate the expression.  */
198262710Sganbold  mark = value_mark ();
199262710Sganbold  result = NULL;
200262710Sganbold
201262710Sganbold  try
202262710Sganbold    {
203262710Sganbold      result = evaluate_subexp (nullptr, exp, pc, EVAL_NORMAL);
204262710Sganbold    }
205262710Sganbold  catch (const gdb_exception &ex)
206262710Sganbold    {
207262710Sganbold      /* Ignore memory errors if we want watchpoints pointing at
208262710Sganbold	 inaccessible memory to still be created; otherwise, throw the
209262710Sganbold	 error to some higher catcher.  */
210262710Sganbold      switch (ex.error)
211262710Sganbold	{
212262710Sganbold	case MEMORY_ERROR:
213262710Sganbold	  if (!preserve_errors)
214262710Sganbold	    break;
215262710Sganbold	  /* Fall through.  */
216262710Sganbold	default:
217262710Sganbold	  throw;
218262710Sganbold	  break;
219262710Sganbold	}
220262710Sganbold    }
221262710Sganbold
222262710Sganbold  new_mark = value_mark ();
223262710Sganbold  if (mark == new_mark)
224262710Sganbold    return;
225262710Sganbold  if (resultp)
226262710Sganbold    *resultp = result;
227262710Sganbold
228262710Sganbold  /* Make sure it's not lazy, so that after the target stops again we
229262710Sganbold     have a non-lazy previous value to compare with.  */
230262710Sganbold  if (result != NULL)
231262710Sganbold    {
232262710Sganbold      if (!value_lazy (result))
233262710Sganbold	*valp = result;
234262710Sganbold      else
235262710Sganbold	{
236262710Sganbold
237262710Sganbold	  try
238262710Sganbold	    {
239262710Sganbold	      value_fetch_lazy (result);
240262710Sganbold	      *valp = result;
241262710Sganbold	    }
242262710Sganbold	  catch (const gdb_exception_error &except)
243262710Sganbold	    {
244262710Sganbold	    }
245262710Sganbold	}
246262710Sganbold    }
247262710Sganbold
248262710Sganbold  if (val_chain)
249262710Sganbold    {
250262710Sganbold      /* Return the chain of intermediate values.  We use this to
251262710Sganbold	 decide which addresses to watch.  */
252262710Sganbold      *val_chain = value_release_to_mark (mark);
253262710Sganbold    }
254262710Sganbold}
255262710Sganbold
256262710Sganbold/* Extract a field operation from an expression.  If the subexpression
257262710Sganbold   of EXP starting at *SUBEXP is not a structure dereference
258262710Sganbold   operation, return NULL.  Otherwise, return the name of the
259262710Sganbold   dereferenced field, and advance *SUBEXP to point to the
260262710Sganbold   subexpression of the left-hand-side of the dereference.  This is
261262710Sganbold   used when completing field names.  */
262262710Sganbold
263262710Sganboldconst char *
264262710Sganboldextract_field_op (struct expression *exp, int *subexp)
265262710Sganbold{
266262710Sganbold  int tem;
267262710Sganbold  char *result;
268262710Sganbold
269262710Sganbold  if (exp->elts[*subexp].opcode != STRUCTOP_STRUCT
270262710Sganbold      && exp->elts[*subexp].opcode != STRUCTOP_PTR)
271262710Sganbold    return NULL;
272262710Sganbold  tem = longest_to_int (exp->elts[*subexp + 1].longconst);
273262710Sganbold  result = &exp->elts[*subexp + 2].string;
274262710Sganbold  (*subexp) += 1 + 3 + BYTES_TO_EXP_ELEM (tem + 1);
275262710Sganbold  return result;
276262710Sganbold}
277262710Sganbold
278262710Sganbold/* This function evaluates brace-initializers (in C/C++) for
279262710Sganbold   structure types.  */
280262710Sganbold
281262710Sganboldstatic struct value *
282262710Sganboldevaluate_struct_tuple (struct value *struct_val,
283262710Sganbold		       struct expression *exp,
284262710Sganbold		       int *pos, enum noside noside, int nargs)
285262710Sganbold{
286262710Sganbold  struct type *struct_type = check_typedef (value_type (struct_val));
287262710Sganbold  struct type *field_type;
288262710Sganbold  int fieldno = -1;
289262710Sganbold
290262710Sganbold  while (--nargs >= 0)
291262710Sganbold    {
292262710Sganbold      struct value *val = NULL;
293262710Sganbold      int bitpos, bitsize;
294262710Sganbold      bfd_byte *addr;
295262710Sganbold
296262710Sganbold      fieldno++;
297262710Sganbold      /* Skip static fields.  */
298262710Sganbold      while (fieldno < struct_type->num_fields ()
299262710Sganbold	     && field_is_static (&struct_type->field (fieldno)))
300262710Sganbold	fieldno++;
301262710Sganbold      if (fieldno >= struct_type->num_fields ())
302262710Sganbold	error (_("too many initializers"));
303262710Sganbold      field_type = struct_type->field (fieldno).type ();
304262710Sganbold      if (field_type->code () == TYPE_CODE_UNION
305262710Sganbold	  && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
306262710Sganbold	error (_("don't know which variant you want to set"));
307262710Sganbold
308262710Sganbold      /* Here, struct_type is the type of the inner struct,
309262710Sganbold	 while substruct_type is the type of the inner struct.
310262710Sganbold	 These are the same for normal structures, but a variant struct
311262710Sganbold	 contains anonymous union fields that contain substruct fields.
312262710Sganbold	 The value fieldno is the index of the top-level (normal or
313262710Sganbold	 anonymous union) field in struct_field, while the value
314262710Sganbold	 subfieldno is the index of the actual real (named inner) field
315262710Sganbold	 in substruct_type.  */
316262710Sganbold
317262710Sganbold      field_type = struct_type->field (fieldno).type ();
318262710Sganbold      if (val == 0)
319262710Sganbold	val = evaluate_subexp (field_type, exp, pos, noside);
320262710Sganbold
321262710Sganbold      /* Now actually set the field in struct_val.  */
322262710Sganbold
323262710Sganbold      /* Assign val to field fieldno.  */
324262710Sganbold      if (value_type (val) != field_type)
325262710Sganbold	val = value_cast (field_type, val);
326262710Sganbold
327262710Sganbold      bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
328262710Sganbold      bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
329262710Sganbold      addr = value_contents_writeable (struct_val) + bitpos / 8;
330262710Sganbold      if (bitsize)
331262710Sganbold	modify_field (struct_type, addr,
332262710Sganbold		      value_as_long (val), bitpos % 8, bitsize);
333262710Sganbold      else
334262710Sganbold	memcpy (addr, value_contents (val),
335262710Sganbold		TYPE_LENGTH (value_type (val)));
336262710Sganbold
337262710Sganbold    }
338262710Sganbold  return struct_val;
339262710Sganbold}
340262710Sganbold
341262710Sganbold/* Recursive helper function for setting elements of array tuples.
342262710Sganbold   The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND); the
343262710Sganbold   element value is ELEMENT; EXP, POS and NOSIDE are as usual.
344262710Sganbold   Evaluates index expressions and sets the specified element(s) of
345262710Sganbold   ARRAY to ELEMENT.  Returns last index value.  */
346262710Sganbold
347262710Sganboldstatic LONGEST
348262710Sganboldinit_array_element (struct value *array, struct value *element,
349262710Sganbold		    struct expression *exp, int *pos,
350262710Sganbold		    enum noside noside, LONGEST low_bound, LONGEST high_bound)
351262710Sganbold{
352262710Sganbold  LONGEST index;
353262710Sganbold  int element_size = TYPE_LENGTH (value_type (element));
354262710Sganbold
355262710Sganbold  if (exp->elts[*pos].opcode == BINOP_COMMA)
356262710Sganbold    {
357262710Sganbold      (*pos)++;
358262710Sganbold      init_array_element (array, element, exp, pos, noside,
359262710Sganbold			  low_bound, high_bound);
360262710Sganbold      return init_array_element (array, element,
361262710Sganbold				 exp, pos, noside, low_bound, high_bound);
362262710Sganbold    }
363262710Sganbold  else
364262710Sganbold    {
365262710Sganbold      index = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
366262710Sganbold      if (index < low_bound || index > high_bound)
367262710Sganbold	error (_("tuple index out of range"));
368262710Sganbold      memcpy (value_contents_raw (array) + (index - low_bound) * element_size,
369262710Sganbold	      value_contents (element), element_size);
370262710Sganbold    }
371262710Sganbold  return index;
372262710Sganbold}
373262710Sganbold
374262710Sganboldstatic struct value *
375262710Sganboldvalue_f90_subarray (struct value *array,
376262710Sganbold		    struct expression *exp, int *pos, enum noside noside)
377262710Sganbold{
378262710Sganbold  int pc = (*pos) + 1;
379262710Sganbold  LONGEST low_bound, high_bound;
380262710Sganbold  struct type *range = check_typedef (value_type (array)->index_type ());
381262710Sganbold  enum range_type range_type
382262710Sganbold    = (enum range_type) longest_to_int (exp->elts[pc].longconst);
383262710Sganbold
384262710Sganbold  *pos += 3;
385262710Sganbold
386262710Sganbold  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
387262710Sganbold    low_bound = range->bounds ()->low.const_val ();
388262710Sganbold  else
389262710Sganbold    low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
390262710Sganbold
391262710Sganbold  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
392262710Sganbold    high_bound = range->bounds ()->high.const_val ();
393262710Sganbold  else
394262710Sganbold    high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
395262710Sganbold
396262710Sganbold  return value_slice (array, low_bound, high_bound - low_bound + 1);
397262710Sganbold}
398262710Sganbold
399262710Sganbold
400262710Sganbold/* Promote value ARG1 as appropriate before performing a unary operation
401262710Sganbold   on this argument.
402262710Sganbold   If the result is not appropriate for any particular language then it
403262710Sganbold   needs to patch this function.  */
404262710Sganbold
405262710Sganboldvoid
406262710Sganboldunop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
407262710Sganbold	      struct value **arg1)
408262710Sganbold{
409262710Sganbold  struct type *type1;
410262710Sganbold
411262710Sganbold  *arg1 = coerce_ref (*arg1);
412262710Sganbold  type1 = check_typedef (value_type (*arg1));
413262710Sganbold
414262710Sganbold  if (is_integral_type (type1))
415262710Sganbold    {
416262710Sganbold      switch (language->la_language)
417262710Sganbold	{
418262710Sganbold	default:
419262710Sganbold	  /* Perform integral promotion for ANSI C/C++.
420262710Sganbold	     If not appropriate for any particular language
421262710Sganbold	     it needs to modify this function.  */
422262710Sganbold	  {
423262710Sganbold	    struct type *builtin_int = builtin_type (gdbarch)->builtin_int;
424262710Sganbold
425262710Sganbold	    if (TYPE_LENGTH (type1) < TYPE_LENGTH (builtin_int))
426262710Sganbold	      *arg1 = value_cast (builtin_int, *arg1);
427262710Sganbold	  }
428262710Sganbold	  break;
429262710Sganbold	}
430262710Sganbold    }
431262710Sganbold}
432262710Sganbold
433262710Sganbold/* Promote values ARG1 and ARG2 as appropriate before performing a binary
434262710Sganbold   operation on those two operands.
435262710Sganbold   If the result is not appropriate for any particular language then it
436262710Sganbold   needs to patch this function.  */
437262710Sganbold
438262710Sganboldvoid
439262710Sganboldbinop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
440262710Sganbold	       struct value **arg1, struct value **arg2)
441262710Sganbold{
442262710Sganbold  struct type *promoted_type = NULL;
443262710Sganbold  struct type *type1;
444262710Sganbold  struct type *type2;
445262710Sganbold
446262710Sganbold  *arg1 = coerce_ref (*arg1);
447262710Sganbold  *arg2 = coerce_ref (*arg2);
448262710Sganbold
449262710Sganbold  type1 = check_typedef (value_type (*arg1));
450262710Sganbold  type2 = check_typedef (value_type (*arg2));
451262710Sganbold
452262710Sganbold  if ((type1->code () != TYPE_CODE_FLT
453262710Sganbold       && type1->code () != TYPE_CODE_DECFLOAT
454262710Sganbold       && !is_integral_type (type1))
455262710Sganbold      || (type2->code () != TYPE_CODE_FLT
456262710Sganbold	  && type2->code () != TYPE_CODE_DECFLOAT
457262710Sganbold	  && !is_integral_type (type2)))
458262710Sganbold    return;
459262710Sganbold
460262710Sganbold  if (type1->code () == TYPE_CODE_DECFLOAT
461262710Sganbold      || type2->code () == TYPE_CODE_DECFLOAT)
462262710Sganbold    {
463262710Sganbold      /* No promotion required.  */
464262710Sganbold    }
465262710Sganbold  else if (type1->code () == TYPE_CODE_FLT
466262710Sganbold	   || type2->code () == TYPE_CODE_FLT)
467262710Sganbold    {
468262710Sganbold      switch (language->la_language)
469262710Sganbold	{
470262710Sganbold	case language_c:
471262710Sganbold	case language_cplus:
472262710Sganbold	case language_asm:
473262710Sganbold	case language_objc:
474262710Sganbold	case language_opencl:
475262710Sganbold	  /* No promotion required.  */
476262710Sganbold	  break;
477262710Sganbold
478262710Sganbold	default:
479262710Sganbold	  /* For other languages the result type is unchanged from gdb
480262710Sganbold	     version 6.7 for backward compatibility.
481262710Sganbold	     If either arg was long double, make sure that value is also long
482262710Sganbold	     double.  Otherwise use double.  */
483262710Sganbold	  if (TYPE_LENGTH (type1) * 8 > gdbarch_double_bit (gdbarch)
484262710Sganbold	      || TYPE_LENGTH (type2) * 8 > gdbarch_double_bit (gdbarch))
485262710Sganbold	    promoted_type = builtin_type (gdbarch)->builtin_long_double;
486262710Sganbold	  else
487262710Sganbold	    promoted_type = builtin_type (gdbarch)->builtin_double;
488262710Sganbold	  break;
489262710Sganbold	}
490262710Sganbold    }
491262710Sganbold  else if (type1->code () == TYPE_CODE_BOOL
492262710Sganbold	   && type2->code () == TYPE_CODE_BOOL)
493262710Sganbold    {
494262710Sganbold      /* No promotion required.  */
495262710Sganbold    }
496262710Sganbold  else
497262710Sganbold    /* Integral operations here.  */
498262710Sganbold    /* FIXME: Also mixed integral/booleans, with result an integer.  */
499262710Sganbold    {
500262710Sganbold      const struct builtin_type *builtin = builtin_type (gdbarch);
501262710Sganbold      unsigned int promoted_len1 = TYPE_LENGTH (type1);
502262710Sganbold      unsigned int promoted_len2 = TYPE_LENGTH (type2);
503262710Sganbold      int is_unsigned1 = TYPE_UNSIGNED (type1);
504262710Sganbold      int is_unsigned2 = TYPE_UNSIGNED (type2);
505262710Sganbold      unsigned int result_len;
506262710Sganbold      int unsigned_operation;
507262710Sganbold
508262710Sganbold      /* Determine type length and signedness after promotion for
509262710Sganbold         both operands.  */
510262710Sganbold      if (promoted_len1 < TYPE_LENGTH (builtin->builtin_int))
511262710Sganbold	{
512262710Sganbold	  is_unsigned1 = 0;
513262710Sganbold	  promoted_len1 = TYPE_LENGTH (builtin->builtin_int);
514262710Sganbold	}
515262710Sganbold      if (promoted_len2 < TYPE_LENGTH (builtin->builtin_int))
516262710Sganbold	{
517262710Sganbold	  is_unsigned2 = 0;
518262710Sganbold	  promoted_len2 = TYPE_LENGTH (builtin->builtin_int);
519262710Sganbold	}
520262710Sganbold
521262710Sganbold      if (promoted_len1 > promoted_len2)
522262710Sganbold	{
523262710Sganbold	  unsigned_operation = is_unsigned1;
524262710Sganbold	  result_len = promoted_len1;
525262710Sganbold	}
526262710Sganbold      else if (promoted_len2 > promoted_len1)
527262710Sganbold	{
528262710Sganbold	  unsigned_operation = is_unsigned2;
529262710Sganbold	  result_len = promoted_len2;
530262710Sganbold	}
531262710Sganbold      else
532262710Sganbold	{
533262710Sganbold	  unsigned_operation = is_unsigned1 || is_unsigned2;
534262710Sganbold	  result_len = promoted_len1;
535262710Sganbold	}
536262710Sganbold
537262710Sganbold      switch (language->la_language)
538262710Sganbold	{
539262710Sganbold	case language_c:
540262710Sganbold	case language_cplus:
541262710Sganbold	case language_asm:
542262710Sganbold	case language_objc:
543262710Sganbold	  if (result_len <= TYPE_LENGTH (builtin->builtin_int))
544262710Sganbold	    {
545262710Sganbold	      promoted_type = (unsigned_operation
546262710Sganbold			       ? builtin->builtin_unsigned_int
547262710Sganbold			       : builtin->builtin_int);
548262710Sganbold	    }
549262710Sganbold	  else if (result_len <= TYPE_LENGTH (builtin->builtin_long))
550262710Sganbold	    {
551262710Sganbold	      promoted_type = (unsigned_operation
552262710Sganbold			       ? builtin->builtin_unsigned_long
553262710Sganbold			       : builtin->builtin_long);
554262710Sganbold	    }
555262710Sganbold	  else
556262710Sganbold	    {
557262710Sganbold	      promoted_type = (unsigned_operation
558262710Sganbold			       ? builtin->builtin_unsigned_long_long
559262710Sganbold			       : builtin->builtin_long_long);
560262710Sganbold	    }
561262710Sganbold	  break;
562262710Sganbold	case language_opencl:
563262710Sganbold	  if (result_len <= TYPE_LENGTH (lookup_signed_typename
564262710Sganbold					 (language, "int")))
565262710Sganbold	    {
566262710Sganbold	      promoted_type =
567262710Sganbold		(unsigned_operation
568262710Sganbold		 ? lookup_unsigned_typename (language, "int")
569262710Sganbold		 : lookup_signed_typename (language, "int"));
570262710Sganbold	    }
571262710Sganbold	  else if (result_len <= TYPE_LENGTH (lookup_signed_typename
572262710Sganbold					      (language, "long")))
573262710Sganbold	    {
574262710Sganbold	      promoted_type =
575262710Sganbold		(unsigned_operation
576262710Sganbold		 ? lookup_unsigned_typename (language, "long")
577262710Sganbold		 : lookup_signed_typename (language,"long"));
578262710Sganbold	    }
579262710Sganbold	  break;
580262710Sganbold	default:
581262710Sganbold	  /* For other languages the result type is unchanged from gdb
582262710Sganbold	     version 6.7 for backward compatibility.
583262710Sganbold	     If either arg was long long, make sure that value is also long
584262710Sganbold	     long.  Otherwise use long.  */
585262710Sganbold	  if (unsigned_operation)
586262710Sganbold	    {
587262710Sganbold	      if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
588262710Sganbold		promoted_type = builtin->builtin_unsigned_long_long;
589262710Sganbold	      else
590262710Sganbold		promoted_type = builtin->builtin_unsigned_long;
591262710Sganbold	    }
592262710Sganbold	  else
593262710Sganbold	    {
594262710Sganbold	      if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
595262710Sganbold		promoted_type = builtin->builtin_long_long;
596262710Sganbold	      else
597262710Sganbold		promoted_type = builtin->builtin_long;
598262710Sganbold	    }
599262710Sganbold	  break;
600262710Sganbold	}
601262710Sganbold    }
602262710Sganbold
603262710Sganbold  if (promoted_type)
604262710Sganbold    {
605262710Sganbold      /* Promote both operands to common type.  */
606262710Sganbold      *arg1 = value_cast (promoted_type, *arg1);
607262710Sganbold      *arg2 = value_cast (promoted_type, *arg2);
608262710Sganbold    }
609262710Sganbold}
610262710Sganbold
611262710Sganboldstatic int
612262710Sganboldptrmath_type_p (const struct language_defn *lang, struct type *type)
613262710Sganbold{
614262710Sganbold  type = check_typedef (type);
615262710Sganbold  if (TYPE_IS_REFERENCE (type))
616262710Sganbold    type = TYPE_TARGET_TYPE (type);
617262710Sganbold
618262710Sganbold  switch (type->code ())
619262710Sganbold    {
620262710Sganbold    case TYPE_CODE_PTR:
621262710Sganbold    case TYPE_CODE_FUNC:
622262710Sganbold      return 1;
623262710Sganbold
624262710Sganbold    case TYPE_CODE_ARRAY:
625262710Sganbold      return TYPE_VECTOR (type) ? 0 : lang->c_style_arrays;
626262710Sganbold
627262710Sganbold    default:
628262710Sganbold      return 0;
629262710Sganbold    }
630262710Sganbold}
631262710Sganbold
632262710Sganbold/* Represents a fake method with the given parameter types.  This is
633262710Sganbold   used by the parser to construct a temporary "expected" type for
634262710Sganbold   method overload resolution.  FLAGS is used as instance flags of the
635262710Sganbold   new type, in order to be able to make the new type represent a
636262710Sganbold   const/volatile overload.  */
637262710Sganbold
638262710Sganboldclass fake_method
639262710Sganbold{
640262710Sganboldpublic:
641262710Sganbold  fake_method (type_instance_flags flags,
642262710Sganbold	       int num_types, struct type **param_types);
643262710Sganbold  ~fake_method ();
644262710Sganbold
645262710Sganbold  /* The constructed type.  */
646262710Sganbold  struct type *type () { return &m_type; }
647262710Sganbold
648262710Sganboldprivate:
649262710Sganbold  struct type m_type {};
650262710Sganbold  main_type m_main_type {};
651262710Sganbold};
652262710Sganbold
653262710Sganboldfake_method::fake_method (type_instance_flags flags,
654262710Sganbold			  int num_types, struct type **param_types)
655262710Sganbold{
656262710Sganbold  struct type *type = &m_type;
657262710Sganbold
658262710Sganbold  TYPE_MAIN_TYPE (type) = &m_main_type;
659262710Sganbold  TYPE_LENGTH (type) = 1;
660262710Sganbold  type->set_code (TYPE_CODE_METHOD);
661262710Sganbold  TYPE_CHAIN (type) = type;
662262710Sganbold  TYPE_INSTANCE_FLAGS (type) = flags;
663262710Sganbold  if (num_types > 0)
664262710Sganbold    {
665262710Sganbold      if (param_types[num_types - 1] == NULL)
666262710Sganbold	{
667262710Sganbold	  --num_types;
668262710Sganbold	  TYPE_VARARGS (type) = 1;
669262710Sganbold	}
670262710Sganbold      else if (check_typedef (param_types[num_types - 1])->code ()
671262710Sganbold	       == TYPE_CODE_VOID)
672262710Sganbold	{
673262710Sganbold	  --num_types;
674262710Sganbold	  /* Caller should have ensured this.  */
675262710Sganbold	  gdb_assert (num_types == 0);
676262710Sganbold	  TYPE_PROTOTYPED (type) = 1;
677262710Sganbold	}
678262710Sganbold    }
679262710Sganbold
680262710Sganbold  /* We don't use TYPE_ZALLOC here to allocate space as TYPE is owned by
681262710Sganbold     neither an objfile nor a gdbarch.  As a result we must manually
682262710Sganbold     allocate memory for auxiliary fields, and free the memory ourselves
683262710Sganbold     when we are done with it.  */
684262710Sganbold  type->set_num_fields (num_types);
685262710Sganbold  type->set_fields
686262710Sganbold    ((struct field *) xzalloc (sizeof (struct field) * num_types));
687262710Sganbold
688262710Sganbold  while (num_types-- > 0)
689262710Sganbold    type->field (num_types).set_type (param_types[num_types]);
690262710Sganbold}
691262710Sganbold
692262710Sganboldfake_method::~fake_method ()
693262710Sganbold{
694262710Sganbold  xfree (m_type.fields ());
695262710Sganbold}
696262710Sganbold
697262710Sganbold/* Helper for evaluating an OP_VAR_VALUE.  */
698262710Sganbold
699262710Sganboldvalue *
700262710Sganboldevaluate_var_value (enum noside noside, const block *blk, symbol *var)
701262710Sganbold{
702262710Sganbold  /* JYG: We used to just return value_zero of the symbol type if
703262710Sganbold     we're asked to avoid side effects.  Otherwise we return
704262710Sganbold     value_of_variable (...).  However I'm not sure if
705262710Sganbold     value_of_variable () has any side effect.  We need a full value
706262710Sganbold     object returned here for whatis_exp () to call evaluate_type ()
707262710Sganbold     and then pass the full value to value_rtti_target_type () if we
708262710Sganbold     are dealing with a pointer or reference to a base class and print
709262710Sganbold     object is on.  */
710262710Sganbold
711262710Sganbold  struct value *ret = NULL;
712262710Sganbold
713262710Sganbold  try
714262710Sganbold    {
715262710Sganbold      ret = value_of_variable (var, blk);
716262710Sganbold    }
717262710Sganbold
718262710Sganbold  catch (const gdb_exception_error &except)
719262710Sganbold    {
720262710Sganbold      if (noside != EVAL_AVOID_SIDE_EFFECTS)
721262710Sganbold	throw;
722262710Sganbold
723262710Sganbold      ret = value_zero (SYMBOL_TYPE (var), not_lval);
724262710Sganbold    }
725262710Sganbold
726262710Sganbold  return ret;
727262710Sganbold}
728262710Sganbold
729262710Sganbold/* Helper for evaluating an OP_VAR_MSYM_VALUE.  */
730262710Sganbold
731262710Sganboldvalue *
732262710Sganboldevaluate_var_msym_value (enum noside noside,
733262710Sganbold			 struct objfile *objfile, minimal_symbol *msymbol)
734262710Sganbold{
735262710Sganbold  CORE_ADDR address;
736262710Sganbold  type *the_type = find_minsym_type_and_address (msymbol, objfile, &address);
737262710Sganbold
738262710Sganbold  if (noside == EVAL_AVOID_SIDE_EFFECTS && !TYPE_GNU_IFUNC (the_type))
739262710Sganbold    return value_zero (the_type, not_lval);
740262710Sganbold  else
741262710Sganbold    return value_at_lazy (the_type, address);
742262710Sganbold}
743262710Sganbold
744262710Sganbold/* Helper for returning a value when handling EVAL_SKIP.  */
745262710Sganbold
746262710Sganboldvalue *
747262710Sganboldeval_skip_value (expression *exp)
748262710Sganbold{
749262710Sganbold  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
750262710Sganbold}
751262710Sganbold
752262710Sganbold/* Evaluate a function call.  The function to be called is in
753262710Sganbold   ARGVEC[0] and the arguments passed to the function are in
754262710Sganbold   ARGVEC[1..NARGS].  FUNCTION_NAME is the name of the function, if
755262710Sganbold   known.  DEFAULT_RETURN_TYPE is used as the function's return type
756262710Sganbold   if the return type is unknown.  */
757262710Sganbold
758262710Sganboldstatic value *
759262710Sganboldeval_call (expression *exp, enum noside noside,
760262710Sganbold	   int nargs, value **argvec,
761262710Sganbold	   const char *function_name,
762262710Sganbold	   type *default_return_type)
763262710Sganbold{
764262710Sganbold  if (argvec[0] == NULL)
765262710Sganbold    error (_("Cannot evaluate function -- may be inlined"));
766262710Sganbold  if (noside == EVAL_AVOID_SIDE_EFFECTS)
767262710Sganbold    {
768262710Sganbold      /* If the return type doesn't look like a function type,
769262710Sganbold	 call an error.  This can happen if somebody tries to turn
770262710Sganbold	 a variable into a function call.  */
771262710Sganbold
772262710Sganbold      type *ftype = value_type (argvec[0]);
773262710Sganbold
774262710Sganbold      if (ftype->code () == TYPE_CODE_INTERNAL_FUNCTION)
775262710Sganbold	{
776262710Sganbold	  /* We don't know anything about what the internal
777262710Sganbold	     function might return, but we have to return
778262710Sganbold	     something.  */
779262710Sganbold	  return value_zero (builtin_type (exp->gdbarch)->builtin_int,
780262710Sganbold			     not_lval);
781262710Sganbold	}
782262710Sganbold      else if (ftype->code () == TYPE_CODE_XMETHOD)
783262710Sganbold	{
784262710Sganbold	  type *return_type
785262710Sganbold	    = result_type_of_xmethod (argvec[0],
786262710Sganbold				      gdb::make_array_view (argvec + 1,
787262710Sganbold							    nargs));
788262710Sganbold
789262710Sganbold	  if (return_type == NULL)
790262710Sganbold	    error (_("Xmethod is missing return type."));
791262710Sganbold	  return value_zero (return_type, not_lval);
792262710Sganbold	}
793262710Sganbold      else if (ftype->code () == TYPE_CODE_FUNC
794262710Sganbold	       || ftype->code () == TYPE_CODE_METHOD)
795262710Sganbold	{
796262710Sganbold	  if (TYPE_GNU_IFUNC (ftype))
797262710Sganbold	    {
798262710Sganbold	      CORE_ADDR address = value_address (argvec[0]);
799262710Sganbold	      type *resolved_type = find_gnu_ifunc_target_type (address);
800262710Sganbold
801262710Sganbold	      if (resolved_type != NULL)
802262710Sganbold		ftype = resolved_type;
803262710Sganbold	    }
804262710Sganbold
805262710Sganbold	  type *return_type = TYPE_TARGET_TYPE (ftype);
806262710Sganbold
807262710Sganbold	  if (return_type == NULL)
808262710Sganbold	    return_type = default_return_type;
809262710Sganbold
810262710Sganbold	  if (return_type == NULL)
811262710Sganbold	    error_call_unknown_return_type (function_name);
812262710Sganbold
813262710Sganbold	  return allocate_value (return_type);
814262710Sganbold	}
815262710Sganbold      else
816262710Sganbold	error (_("Expression of type other than "
817262710Sganbold		 "\"Function returning ...\" used as function"));
818262710Sganbold    }
819262710Sganbold  switch (value_type (argvec[0])->code ())
820262710Sganbold    {
821262710Sganbold    case TYPE_CODE_INTERNAL_FUNCTION:
822262710Sganbold      return call_internal_function (exp->gdbarch, exp->language_defn,
823262710Sganbold				     argvec[0], nargs, argvec + 1);
824262710Sganbold    case TYPE_CODE_XMETHOD:
825262710Sganbold      return call_xmethod (argvec[0], gdb::make_array_view (argvec + 1, nargs));
826262710Sganbold    default:
827262710Sganbold      return call_function_by_hand (argvec[0], default_return_type,
828262710Sganbold				    gdb::make_array_view (argvec + 1, nargs));
829262710Sganbold    }
830262710Sganbold}
831262710Sganbold
832262710Sganbold/* Helper for evaluating an OP_FUNCALL.  */
833262710Sganbold
834262710Sganboldstatic value *
835262710Sganboldevaluate_funcall (type *expect_type, expression *exp, int *pos,
836262710Sganbold		  enum noside noside)
837262710Sganbold{
838262710Sganbold  int tem;
839262710Sganbold  int pc2 = 0;
840262710Sganbold  value *arg1 = NULL;
841262710Sganbold  value *arg2 = NULL;
842262710Sganbold  int save_pos1;
843262710Sganbold  symbol *function = NULL;
844262710Sganbold  char *function_name = NULL;
845262710Sganbold  const char *var_func_name = NULL;
846262710Sganbold
847262710Sganbold  int pc = (*pos);
848262710Sganbold  (*pos) += 2;
849262710Sganbold
850262710Sganbold  exp_opcode op = exp->elts[*pos].opcode;
851262710Sganbold  int nargs = longest_to_int (exp->elts[pc].longconst);
852262710Sganbold  /* Allocate arg vector, including space for the function to be
853262710Sganbold     called in argvec[0], a potential `this', and a terminating
854262710Sganbold     NULL.  */
855262710Sganbold  value **argvec = (value **) alloca (sizeof (value *) * (nargs + 3));
856262710Sganbold  if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
857262710Sganbold    {
858262710Sganbold      /* First, evaluate the structure into arg2.  */
859262710Sganbold      pc2 = (*pos)++;
860262710Sganbold
861262710Sganbold      if (op == STRUCTOP_MEMBER)
862262710Sganbold	{
863262710Sganbold	  arg2 = evaluate_subexp_for_address (exp, pos, noside);
864262710Sganbold	}
865262710Sganbold      else
866262710Sganbold	{
867262710Sganbold	  arg2 = evaluate_subexp (nullptr, exp, pos, noside);
868262710Sganbold	}
869262710Sganbold
870262710Sganbold      /* If the function is a virtual function, then the aggregate
871262710Sganbold	 value (providing the structure) plays its part by providing
872262710Sganbold	 the vtable.  Otherwise, it is just along for the ride: call
873262710Sganbold	 the function directly.  */
874262710Sganbold
875262710Sganbold      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
876262710Sganbold
877262710Sganbold      type *a1_type = check_typedef (value_type (arg1));
878262710Sganbold      if (noside == EVAL_SKIP)
879262710Sganbold	tem = 1;  /* Set it to the right arg index so that all
880262710Sganbold		     arguments can also be skipped.  */
881262710Sganbold      else if (a1_type->code () == TYPE_CODE_METHODPTR)
882262710Sganbold	{
883262710Sganbold	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
884262710Sganbold	    arg1 = value_zero (TYPE_TARGET_TYPE (a1_type), not_lval);
885262710Sganbold	  else
886262710Sganbold	    arg1 = cplus_method_ptr_to_value (&arg2, arg1);
887262710Sganbold
888262710Sganbold	  /* Now, say which argument to start evaluating from.  */
889262710Sganbold	  nargs++;
890262710Sganbold	  tem = 2;
891262710Sganbold	  argvec[1] = arg2;
892262710Sganbold	}
893262710Sganbold      else if (a1_type->code () == TYPE_CODE_MEMBERPTR)
894262710Sganbold	{
895262710Sganbold	  struct type *type_ptr
896262710Sganbold	    = lookup_pointer_type (TYPE_SELF_TYPE (a1_type));
897262710Sganbold	  struct type *target_type_ptr
898262710Sganbold	    = lookup_pointer_type (TYPE_TARGET_TYPE (a1_type));
899262710Sganbold
900262710Sganbold	  /* Now, convert these values to an address.  */
901262710Sganbold	  arg2 = value_cast (type_ptr, arg2);
902262710Sganbold
903262710Sganbold	  long mem_offset = value_as_long (arg1);
904262710Sganbold
905262710Sganbold	  arg1 = value_from_pointer (target_type_ptr,
906262710Sganbold				     value_as_long (arg2) + mem_offset);
907262710Sganbold	  arg1 = value_ind (arg1);
908262710Sganbold	  tem = 1;
909262710Sganbold	}
910262710Sganbold      else
911262710Sganbold	error (_("Non-pointer-to-member value used in pointer-to-member "
912262710Sganbold		 "construct"));
913262710Sganbold    }
914262710Sganbold  else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
915262710Sganbold    {
916262710Sganbold      /* Hair for method invocations.  */
917262710Sganbold      int tem2;
918262710Sganbold
919262710Sganbold      nargs++;
920262710Sganbold      /* First, evaluate the structure into arg2.  */
921262710Sganbold      pc2 = (*pos)++;
922262710Sganbold      tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
923262710Sganbold      *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
924262710Sganbold
925262710Sganbold      if (op == STRUCTOP_STRUCT)
926262710Sganbold	{
927262710Sganbold	  /* If v is a variable in a register, and the user types
928262710Sganbold	     v.method (), this will produce an error, because v has no
929262710Sganbold	     address.
930262710Sganbold
931262710Sganbold	     A possible way around this would be to allocate a copy of
932262710Sganbold	     the variable on the stack, copy in the contents, call the
933262710Sganbold	     function, and copy out the contents.  I.e. convert this
934262710Sganbold	     from call by reference to call by copy-return (or
935262710Sganbold	     whatever it's called).  However, this does not work
936262710Sganbold	     because it is not the same: the method being called could
937262710Sganbold	     stash a copy of the address, and then future uses through
938262710Sganbold	     that address (after the method returns) would be expected
939262710Sganbold	     to use the variable itself, not some copy of it.  */
940262710Sganbold	  arg2 = evaluate_subexp_for_address (exp, pos, noside);
941262710Sganbold	}
942262710Sganbold      else
943262710Sganbold	{
944262710Sganbold	  arg2 = evaluate_subexp (nullptr, exp, pos, noside);
945262710Sganbold
946262710Sganbold	  /* Check to see if the operator '->' has been overloaded.
947262710Sganbold	     If the operator has been overloaded replace arg2 with the
948262710Sganbold	     value returned by the custom operator and continue
949262710Sganbold	     evaluation.  */
950262710Sganbold	  while (unop_user_defined_p (op, arg2))
951262710Sganbold	    {
952262710Sganbold	      struct value *value = NULL;
953262710Sganbold	      try
954262710Sganbold		{
955262710Sganbold		  value = value_x_unop (arg2, op, noside);
956262710Sganbold		}
957262710Sganbold
958262710Sganbold	      catch (const gdb_exception_error &except)
959262710Sganbold		{
960262710Sganbold		  if (except.error == NOT_FOUND_ERROR)
961262710Sganbold		    break;
962262710Sganbold		  else
963262710Sganbold		    throw;
964262710Sganbold		}
965262710Sganbold
966262710Sganbold		arg2 = value;
967262710Sganbold	    }
968262710Sganbold	}
969262710Sganbold      /* Now, say which argument to start evaluating from.  */
970262710Sganbold      tem = 2;
971262710Sganbold    }
972262710Sganbold  else if (op == OP_SCOPE
973262710Sganbold	   && overload_resolution
974262710Sganbold	   && (exp->language_defn->la_language == language_cplus))
975262710Sganbold    {
976262710Sganbold      /* Unpack it locally so we can properly handle overload
977262710Sganbold	 resolution.  */
978262710Sganbold      char *name;
979262710Sganbold      int local_tem;
980262710Sganbold
981262710Sganbold      pc2 = (*pos)++;
982262710Sganbold      local_tem = longest_to_int (exp->elts[pc2 + 2].longconst);
983262710Sganbold      (*pos) += 4 + BYTES_TO_EXP_ELEM (local_tem + 1);
984262710Sganbold      struct type *type = exp->elts[pc2 + 1].type;
985262710Sganbold      name = &exp->elts[pc2 + 3].string;
986262710Sganbold
987262710Sganbold      function = NULL;
988262710Sganbold      function_name = NULL;
989262710Sganbold      if (type->code () == TYPE_CODE_NAMESPACE)
990262710Sganbold	{
991262710Sganbold	  function = cp_lookup_symbol_namespace (type->name (),
992262710Sganbold						 name,
993262710Sganbold						 get_selected_block (0),
994262710Sganbold						 VAR_DOMAIN).symbol;
995262710Sganbold	  if (function == NULL)
996262710Sganbold	    error (_("No symbol \"%s\" in namespace \"%s\"."),
997262710Sganbold		   name, type->name ());
998262710Sganbold
999262710Sganbold	  tem = 1;
1000262710Sganbold	  /* arg2 is left as NULL on purpose.  */
1001262710Sganbold	}
1002262710Sganbold      else
1003262710Sganbold	{
1004262710Sganbold	  gdb_assert (type->code () == TYPE_CODE_STRUCT
1005262710Sganbold		      || type->code () == TYPE_CODE_UNION);
1006262710Sganbold	  function_name = name;
1007262710Sganbold
1008262710Sganbold	  /* We need a properly typed value for method lookup.  For
1009262710Sganbold	     static methods arg2 is otherwise unused.  */
1010262710Sganbold	  arg2 = value_zero (type, lval_memory);
1011262710Sganbold	  ++nargs;
1012262710Sganbold	  tem = 2;
1013262710Sganbold	}
1014262710Sganbold    }
1015262710Sganbold  else if (op == OP_ADL_FUNC)
1016262710Sganbold    {
1017262710Sganbold      /* Save the function position and move pos so that the arguments
1018262710Sganbold	 can be evaluated.  */
1019262710Sganbold      int func_name_len;
1020262710Sganbold
1021262710Sganbold      save_pos1 = *pos;
1022262710Sganbold      tem = 1;
1023262710Sganbold
1024262710Sganbold      func_name_len = longest_to_int (exp->elts[save_pos1 + 3].longconst);
1025262710Sganbold      (*pos) += 6 + BYTES_TO_EXP_ELEM (func_name_len + 1);
1026262710Sganbold    }
1027262710Sganbold  else
1028262710Sganbold    {
1029262710Sganbold      /* Non-method function call.  */
1030262710Sganbold      save_pos1 = *pos;
1031262710Sganbold      tem = 1;
1032262710Sganbold
1033262710Sganbold      /* If this is a C++ function wait until overload resolution.  */
1034262710Sganbold      if (op == OP_VAR_VALUE
1035262710Sganbold	  && overload_resolution
1036262710Sganbold	  && (exp->language_defn->la_language == language_cplus))
1037262710Sganbold	{
1038262710Sganbold	  (*pos) += 4; /* Skip the evaluation of the symbol.  */
1039262710Sganbold	  argvec[0] = NULL;
1040262710Sganbold	}
1041262710Sganbold      else
1042262710Sganbold	{
1043262710Sganbold	  if (op == OP_VAR_MSYM_VALUE)
1044262710Sganbold	    {
1045262710Sganbold	      minimal_symbol *msym = exp->elts[*pos + 2].msymbol;
1046262710Sganbold	      var_func_name = msym->print_name ();
1047262710Sganbold	    }
1048262710Sganbold	  else if (op == OP_VAR_VALUE)
1049262710Sganbold	    {
1050262710Sganbold	      symbol *sym = exp->elts[*pos + 2].symbol;
1051262710Sganbold	      var_func_name = sym->print_name ();
1052262710Sganbold	    }
1053262710Sganbold
1054262710Sganbold	  argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1055262710Sganbold	  type *type = value_type (argvec[0]);
1056262710Sganbold	  if (type && type->code () == TYPE_CODE_PTR)
1057262710Sganbold	    type = TYPE_TARGET_TYPE (type);
1058262710Sganbold	  if (type && type->code () == TYPE_CODE_FUNC)
1059262710Sganbold	    {
1060262710Sganbold	      for (; tem <= nargs && tem <= type->num_fields (); tem++)
1061262710Sganbold		{
1062262710Sganbold		  argvec[tem] = evaluate_subexp (type->field (tem - 1).type (),
1063262710Sganbold						 exp, pos, noside);
1064262710Sganbold		}
1065262710Sganbold	    }
1066262710Sganbold	}
1067262710Sganbold    }
1068262710Sganbold
1069262710Sganbold  /* Evaluate arguments (if not already done, e.g., namespace::func()
1070262710Sganbold     and overload-resolution is off).  */
1071262710Sganbold  for (; tem <= nargs; tem++)
1072262710Sganbold    {
1073262710Sganbold      /* Ensure that array expressions are coerced into pointer
1074262710Sganbold	 objects.  */
1075262710Sganbold      argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1076262710Sganbold    }
1077262710Sganbold
1078262710Sganbold  /* Signal end of arglist.  */
1079262710Sganbold  argvec[tem] = 0;
1080262710Sganbold
1081262710Sganbold  if (noside == EVAL_SKIP)
1082262710Sganbold    return eval_skip_value (exp);
1083262710Sganbold
1084262710Sganbold  if (op == OP_ADL_FUNC)
1085262710Sganbold    {
1086262710Sganbold      struct symbol *symp;
1087262710Sganbold      char *func_name;
1088262710Sganbold      int  name_len;
1089262710Sganbold      int string_pc = save_pos1 + 3;
1090262710Sganbold
1091262710Sganbold      /* Extract the function name.  */
1092262710Sganbold      name_len = longest_to_int (exp->elts[string_pc].longconst);
1093262710Sganbold      func_name = (char *) alloca (name_len + 1);
1094262710Sganbold      strcpy (func_name, &exp->elts[string_pc + 1].string);
1095262710Sganbold
1096262710Sganbold      find_overload_match (gdb::make_array_view (&argvec[1], nargs),
1097262710Sganbold			   func_name,
1098262710Sganbold			   NON_METHOD, /* not method */
1099262710Sganbold			   NULL, NULL, /* pass NULL symbol since
1100262710Sganbold					  symbol is unknown */
1101262710Sganbold			   NULL, &symp, NULL, 0, noside);
1102262710Sganbold
1103262710Sganbold      /* Now fix the expression being evaluated.  */
1104262710Sganbold      exp->elts[save_pos1 + 2].symbol = symp;
1105262710Sganbold      argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1106262710Sganbold    }
1107262710Sganbold
1108262710Sganbold  if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR
1109262710Sganbold      || (op == OP_SCOPE && function_name != NULL))
1110262710Sganbold    {
1111262710Sganbold      int static_memfuncp;
1112262710Sganbold      char *tstr;
1113262710Sganbold
1114262710Sganbold      /* Method invocation: stuff "this" as first parameter.  If the
1115262710Sganbold	 method turns out to be static we undo this below.  */
1116262710Sganbold      argvec[1] = arg2;
1117262710Sganbold
1118262710Sganbold      if (op != OP_SCOPE)
1119262710Sganbold	{
1120262710Sganbold	  /* Name of method from expression.  */
1121262710Sganbold	  tstr = &exp->elts[pc2 + 2].string;
1122262710Sganbold	}
1123262710Sganbold      else
1124262710Sganbold	tstr = function_name;
1125262710Sganbold
1126262710Sganbold      if (overload_resolution && (exp->language_defn->la_language
1127262710Sganbold				  == language_cplus))
1128262710Sganbold	{
1129262710Sganbold	  /* Language is C++, do some overload resolution before
1130262710Sganbold	     evaluation.  */
1131262710Sganbold	  struct value *valp = NULL;
1132262710Sganbold
1133262710Sganbold	  (void) find_overload_match (gdb::make_array_view (&argvec[1], nargs),
1134262710Sganbold				      tstr,
1135262710Sganbold				      METHOD, /* method */
1136262710Sganbold				      &arg2,  /* the object */
1137262710Sganbold				      NULL, &valp, NULL,
1138262710Sganbold				      &static_memfuncp, 0, noside);
1139262710Sganbold
1140262710Sganbold	  if (op == OP_SCOPE && !static_memfuncp)
1141262710Sganbold	    {
1142262710Sganbold	      /* For the time being, we don't handle this.  */
1143262710Sganbold	      error (_("Call to overloaded function %s requires "
1144262710Sganbold		       "`this' pointer"),
1145262710Sganbold		     function_name);
1146262710Sganbold	    }
1147262710Sganbold	  argvec[1] = arg2;	/* the ``this'' pointer */
1148262710Sganbold	  argvec[0] = valp;	/* Use the method found after overload
1149262710Sganbold				   resolution.  */
1150262710Sganbold	}
1151262710Sganbold      else
1152262710Sganbold	/* Non-C++ case -- or no overload resolution.  */
1153	{
1154	  struct value *temp = arg2;
1155
1156	  argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1157					&static_memfuncp,
1158					op == STRUCTOP_STRUCT
1159					? "structure" : "structure pointer");
1160	  /* value_struct_elt updates temp with the correct value of
1161	     the ``this'' pointer if necessary, so modify argvec[1] to
1162	     reflect any ``this'' changes.  */
1163	  arg2
1164	    = value_from_longest (lookup_pointer_type(value_type (temp)),
1165				  value_address (temp)
1166				  + value_embedded_offset (temp));
1167	  argvec[1] = arg2;	/* the ``this'' pointer */
1168	}
1169
1170      /* Take out `this' if needed.  */
1171      if (static_memfuncp)
1172	{
1173	  argvec[1] = argvec[0];
1174	  nargs--;
1175	  argvec++;
1176	}
1177    }
1178  else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1179    {
1180      /* Pointer to member.  argvec[1] is already set up.  */
1181      argvec[0] = arg1;
1182    }
1183  else if (op == OP_VAR_VALUE || (op == OP_SCOPE && function != NULL))
1184    {
1185      /* Non-member function being called.  */
1186      /* fn: This can only be done for C++ functions.  A C-style
1187	 function in a C++ program, for instance, does not have the
1188	 fields that are expected here.  */
1189
1190      if (overload_resolution && (exp->language_defn->la_language
1191				  == language_cplus))
1192	{
1193	  /* Language is C++, do some overload resolution before
1194	     evaluation.  */
1195	  struct symbol *symp;
1196	  int no_adl = 0;
1197
1198	  /* If a scope has been specified disable ADL.  */
1199	  if (op == OP_SCOPE)
1200	    no_adl = 1;
1201
1202	  if (op == OP_VAR_VALUE)
1203	    function = exp->elts[save_pos1+2].symbol;
1204
1205	  (void) find_overload_match (gdb::make_array_view (&argvec[1], nargs),
1206				      NULL,        /* no need for name */
1207				      NON_METHOD,  /* not method */
1208				      NULL, function, /* the function */
1209				      NULL, &symp, NULL, no_adl, noside);
1210
1211	  if (op == OP_VAR_VALUE)
1212	    {
1213	      /* Now fix the expression being evaluated.  */
1214	      exp->elts[save_pos1+2].symbol = symp;
1215	      argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1,
1216							 noside);
1217	    }
1218	  else
1219	    argvec[0] = value_of_variable (symp, get_selected_block (0));
1220	}
1221      else
1222	{
1223	  /* Not C++, or no overload resolution allowed.  */
1224	  /* Nothing to be done; argvec already correctly set up.  */
1225	}
1226    }
1227  else
1228    {
1229      /* It is probably a C-style function.  */
1230      /* Nothing to be done; argvec already correctly set up.  */
1231    }
1232
1233  return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
1234}
1235
1236/* Helper for skipping all the arguments in an undetermined argument list.
1237   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
1238   case of evaluate_subexp_standard as multiple, but not all, code paths
1239   require a generic skip.  */
1240
1241static void
1242skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
1243			   enum noside noside)
1244{
1245  for (int i = 0; i < nargs; ++i)
1246    evaluate_subexp (nullptr, exp, pos, noside);
1247}
1248
1249/* Return true if type is integral or reference to integral */
1250
1251static bool
1252is_integral_or_integral_reference (struct type *type)
1253{
1254  if (is_integral_type (type))
1255    return true;
1256
1257  type = check_typedef (type);
1258  return (type != nullptr
1259	  && TYPE_IS_REFERENCE (type)
1260	  && is_integral_type (TYPE_TARGET_TYPE (type)));
1261}
1262
1263struct value *
1264evaluate_subexp_standard (struct type *expect_type,
1265			  struct expression *exp, int *pos,
1266			  enum noside noside)
1267{
1268  enum exp_opcode op;
1269  int tem, tem2, tem3;
1270  int pc, oldpos;
1271  struct value *arg1 = NULL;
1272  struct value *arg2 = NULL;
1273  struct value *arg3;
1274  struct type *type;
1275  int nargs;
1276  struct value **argvec;
1277  int code;
1278  int ix;
1279  long mem_offset;
1280  struct type **arg_types;
1281
1282  pc = (*pos)++;
1283  op = exp->elts[pc].opcode;
1284
1285  switch (op)
1286    {
1287    case OP_SCOPE:
1288      tem = longest_to_int (exp->elts[pc + 2].longconst);
1289      (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
1290      if (noside == EVAL_SKIP)
1291	return eval_skip_value (exp);
1292      arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
1293				  &exp->elts[pc + 3].string,
1294				  expect_type, 0, noside);
1295      if (arg1 == NULL)
1296	error (_("There is no field named %s"), &exp->elts[pc + 3].string);
1297      return arg1;
1298
1299    case OP_LONG:
1300      (*pos) += 3;
1301      return value_from_longest (exp->elts[pc + 1].type,
1302				 exp->elts[pc + 2].longconst);
1303
1304    case OP_FLOAT:
1305      (*pos) += 3;
1306      return value_from_contents (exp->elts[pc + 1].type,
1307				  exp->elts[pc + 2].floatconst);
1308
1309    case OP_ADL_FUNC:
1310    case OP_VAR_VALUE:
1311      {
1312	(*pos) += 3;
1313	symbol *var = exp->elts[pc + 2].symbol;
1314	if (SYMBOL_TYPE (var)->code () == TYPE_CODE_ERROR)
1315	  error_unknown_type (var->print_name ());
1316	if (noside != EVAL_SKIP)
1317	    return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
1318	else
1319	  {
1320	    /* Return a dummy value of the correct type when skipping, so
1321	       that parent functions know what is to be skipped.  */
1322	    return allocate_value (SYMBOL_TYPE (var));
1323	  }
1324      }
1325
1326    case OP_VAR_MSYM_VALUE:
1327      {
1328	(*pos) += 3;
1329
1330	minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
1331	value *val = evaluate_var_msym_value (noside,
1332					      exp->elts[pc + 1].objfile,
1333					      msymbol);
1334
1335	type = value_type (val);
1336	if (type->code () == TYPE_CODE_ERROR
1337	    && (noside != EVAL_AVOID_SIDE_EFFECTS || pc != 0))
1338	  error_unknown_type (msymbol->print_name ());
1339	return val;
1340      }
1341
1342    case OP_VAR_ENTRY_VALUE:
1343      (*pos) += 2;
1344      if (noside == EVAL_SKIP)
1345	return eval_skip_value (exp);
1346
1347      {
1348	struct symbol *sym = exp->elts[pc + 1].symbol;
1349	struct frame_info *frame;
1350
1351	if (noside == EVAL_AVOID_SIDE_EFFECTS)
1352	  return value_zero (SYMBOL_TYPE (sym), not_lval);
1353
1354	if (SYMBOL_COMPUTED_OPS (sym) == NULL
1355	    || SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry == NULL)
1356	  error (_("Symbol \"%s\" does not have any specific entry value"),
1357		 sym->print_name ());
1358
1359	frame = get_selected_frame (NULL);
1360	return SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry (sym, frame);
1361      }
1362
1363    case OP_FUNC_STATIC_VAR:
1364      tem = longest_to_int (exp->elts[pc + 1].longconst);
1365      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1366      if (noside == EVAL_SKIP)
1367	return eval_skip_value (exp);
1368
1369      {
1370	value *func = evaluate_subexp_standard (NULL, exp, pos, noside);
1371	CORE_ADDR addr = value_address (func);
1372
1373	const block *blk = block_for_pc (addr);
1374	const char *var = &exp->elts[pc + 2].string;
1375
1376	struct block_symbol sym = lookup_symbol (var, blk, VAR_DOMAIN, NULL);
1377
1378	if (sym.symbol == NULL)
1379	  error (_("No symbol \"%s\" in specified context."), var);
1380
1381	return evaluate_var_value (noside, sym.block, sym.symbol);
1382      }
1383
1384    case OP_LAST:
1385      (*pos) += 2;
1386      return
1387	access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
1388
1389    case OP_REGISTER:
1390      {
1391	const char *name = &exp->elts[pc + 2].string;
1392	int regno;
1393	struct value *val;
1394
1395	(*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
1396	regno = user_reg_map_name_to_regnum (exp->gdbarch,
1397					     name, strlen (name));
1398	if (regno == -1)
1399	  error (_("Register $%s not available."), name);
1400
1401        /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
1402           a value with the appropriate register type.  Unfortunately,
1403           we don't have easy access to the type of user registers.
1404           So for these registers, we fetch the register value regardless
1405           of the evaluation mode.  */
1406	if (noside == EVAL_AVOID_SIDE_EFFECTS
1407	    && regno < gdbarch_num_cooked_regs (exp->gdbarch))
1408	  val = value_zero (register_type (exp->gdbarch, regno), not_lval);
1409	else
1410	  val = value_of_register (regno, get_selected_frame (NULL));
1411	if (val == NULL)
1412	  error (_("Value of register %s not available."), name);
1413	else
1414	  return val;
1415      }
1416    case OP_BOOL:
1417      (*pos) += 2;
1418      type = language_bool_type (exp->language_defn, exp->gdbarch);
1419      return value_from_longest (type, exp->elts[pc + 1].longconst);
1420
1421    case OP_INTERNALVAR:
1422      (*pos) += 2;
1423      return value_of_internalvar (exp->gdbarch,
1424				   exp->elts[pc + 1].internalvar);
1425
1426    case OP_STRING:
1427      tem = longest_to_int (exp->elts[pc + 1].longconst);
1428      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1429      if (noside == EVAL_SKIP)
1430	return eval_skip_value (exp);
1431      type = language_string_char_type (exp->language_defn, exp->gdbarch);
1432      return value_string (&exp->elts[pc + 2].string, tem, type);
1433
1434    case OP_OBJC_NSSTRING:		/* Objective C Foundation Class
1435					   NSString constant.  */
1436      tem = longest_to_int (exp->elts[pc + 1].longconst);
1437      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1438      if (noside == EVAL_SKIP)
1439	return eval_skip_value (exp);
1440      return value_nsstring (exp->gdbarch, &exp->elts[pc + 2].string, tem + 1);
1441
1442    case OP_ARRAY:
1443      (*pos) += 3;
1444      tem2 = longest_to_int (exp->elts[pc + 1].longconst);
1445      tem3 = longest_to_int (exp->elts[pc + 2].longconst);
1446      nargs = tem3 - tem2 + 1;
1447      type = expect_type ? check_typedef (expect_type) : nullptr;
1448
1449      if (expect_type != nullptr && noside != EVAL_SKIP
1450	  && type->code () == TYPE_CODE_STRUCT)
1451	{
1452	  struct value *rec = allocate_value (expect_type);
1453
1454	  memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
1455	  return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
1456	}
1457
1458      if (expect_type != nullptr && noside != EVAL_SKIP
1459	  && type->code () == TYPE_CODE_ARRAY)
1460	{
1461	  struct type *range_type = type->index_type ();
1462	  struct type *element_type = TYPE_TARGET_TYPE (type);
1463	  struct value *array = allocate_value (expect_type);
1464	  int element_size = TYPE_LENGTH (check_typedef (element_type));
1465	  LONGEST low_bound, high_bound, index;
1466
1467	  if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
1468	    {
1469	      low_bound = 0;
1470	      high_bound = (TYPE_LENGTH (type) / element_size) - 1;
1471	    }
1472	  index = low_bound;
1473	  memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
1474	  for (tem = nargs; --nargs >= 0;)
1475	    {
1476	      struct value *element;
1477	      int index_pc = 0;
1478
1479	      element = evaluate_subexp (element_type, exp, pos, noside);
1480	      if (value_type (element) != element_type)
1481		element = value_cast (element_type, element);
1482	      if (index_pc)
1483		{
1484		  int continue_pc = *pos;
1485
1486		  *pos = index_pc;
1487		  index = init_array_element (array, element, exp, pos, noside,
1488					      low_bound, high_bound);
1489		  *pos = continue_pc;
1490		}
1491	      else
1492		{
1493		  if (index > high_bound)
1494		    /* To avoid memory corruption.  */
1495		    error (_("Too many array elements"));
1496		  memcpy (value_contents_raw (array)
1497			  + (index - low_bound) * element_size,
1498			  value_contents (element),
1499			  element_size);
1500		}
1501	      index++;
1502	    }
1503	  return array;
1504	}
1505
1506      if (expect_type != nullptr && noside != EVAL_SKIP
1507	  && type->code () == TYPE_CODE_SET)
1508	{
1509	  struct value *set = allocate_value (expect_type);
1510	  gdb_byte *valaddr = value_contents_raw (set);
1511	  struct type *element_type = type->index_type ();
1512	  struct type *check_type = element_type;
1513	  LONGEST low_bound, high_bound;
1514
1515	  /* Get targettype of elementtype.  */
1516	  while (check_type->code () == TYPE_CODE_RANGE
1517		 || check_type->code () == TYPE_CODE_TYPEDEF)
1518	    check_type = TYPE_TARGET_TYPE (check_type);
1519
1520	  if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
1521	    error (_("(power)set type with unknown size"));
1522	  memset (valaddr, '\0', TYPE_LENGTH (type));
1523	  for (tem = 0; tem < nargs; tem++)
1524	    {
1525	      LONGEST range_low, range_high;
1526	      struct type *range_low_type, *range_high_type;
1527	      struct value *elem_val;
1528
1529	      elem_val = evaluate_subexp (element_type, exp, pos, noside);
1530	      range_low_type = range_high_type = value_type (elem_val);
1531	      range_low = range_high = value_as_long (elem_val);
1532
1533	      /* Check types of elements to avoid mixture of elements from
1534	         different types. Also check if type of element is "compatible"
1535	         with element type of powerset.  */
1536	      if (range_low_type->code () == TYPE_CODE_RANGE)
1537		range_low_type = TYPE_TARGET_TYPE (range_low_type);
1538	      if (range_high_type->code () == TYPE_CODE_RANGE)
1539		range_high_type = TYPE_TARGET_TYPE (range_high_type);
1540	      if ((range_low_type->code () != range_high_type->code ())
1541		  || (range_low_type->code () == TYPE_CODE_ENUM
1542		      && (range_low_type != range_high_type)))
1543		/* different element modes.  */
1544		error (_("POWERSET tuple elements of different mode"));
1545	      if ((check_type->code () != range_low_type->code ())
1546		  || (check_type->code () == TYPE_CODE_ENUM
1547		      && range_low_type != check_type))
1548		error (_("incompatible POWERSET tuple elements"));
1549	      if (range_low > range_high)
1550		{
1551		  warning (_("empty POWERSET tuple range"));
1552		  continue;
1553		}
1554	      if (range_low < low_bound || range_high > high_bound)
1555		error (_("POWERSET tuple element out of range"));
1556	      range_low -= low_bound;
1557	      range_high -= low_bound;
1558	      for (; range_low <= range_high; range_low++)
1559		{
1560		  int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
1561
1562		  if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
1563		    bit_index = TARGET_CHAR_BIT - 1 - bit_index;
1564		  valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
1565		    |= 1 << bit_index;
1566		}
1567	    }
1568	  return set;
1569	}
1570
1571      argvec = XALLOCAVEC (struct value *, nargs);
1572      for (tem = 0; tem < nargs; tem++)
1573	{
1574	  /* Ensure that array expressions are coerced into pointer
1575	     objects.  */
1576	  argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1577	}
1578      if (noside == EVAL_SKIP)
1579	return eval_skip_value (exp);
1580      return value_array (tem2, tem3, argvec);
1581
1582    case TERNOP_SLICE:
1583      {
1584	struct value *array = evaluate_subexp (nullptr, exp, pos, noside);
1585	int lowbound
1586	  = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
1587	int upper = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
1588
1589	if (noside == EVAL_SKIP)
1590	  return eval_skip_value (exp);
1591	return value_slice (array, lowbound, upper - lowbound + 1);
1592      }
1593
1594    case TERNOP_COND:
1595      /* Skip third and second args to evaluate the first one.  */
1596      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
1597      if (value_logical_not (arg1))
1598	{
1599	  evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
1600	  return evaluate_subexp (nullptr, exp, pos, noside);
1601	}
1602      else
1603	{
1604	  arg2 = evaluate_subexp (nullptr, exp, pos, noside);
1605	  evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
1606	  return arg2;
1607	}
1608
1609    case OP_OBJC_SELECTOR:
1610      {				/* Objective C @selector operator.  */
1611	char *sel = &exp->elts[pc + 2].string;
1612	int len = longest_to_int (exp->elts[pc + 1].longconst);
1613	struct type *selector_type;
1614
1615	(*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1616	if (noside == EVAL_SKIP)
1617	  return eval_skip_value (exp);
1618
1619	if (sel[len] != 0)
1620	  sel[len] = 0;		/* Make sure it's terminated.  */
1621
1622	selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1623	return value_from_longest (selector_type,
1624				   lookup_child_selector (exp->gdbarch, sel));
1625      }
1626
1627    case OP_OBJC_MSGCALL:
1628      {				/* Objective C message (method) call.  */
1629
1630	CORE_ADDR responds_selector = 0;
1631	CORE_ADDR method_selector = 0;
1632
1633	CORE_ADDR selector = 0;
1634
1635	int struct_return = 0;
1636	enum noside sub_no_side = EVAL_NORMAL;
1637
1638	struct value *msg_send = NULL;
1639	struct value *msg_send_stret = NULL;
1640	int gnu_runtime = 0;
1641
1642	struct value *target = NULL;
1643	struct value *method = NULL;
1644	struct value *called_method = NULL;
1645
1646	struct type *selector_type = NULL;
1647	struct type *long_type;
1648
1649	struct value *ret = NULL;
1650	CORE_ADDR addr = 0;
1651
1652	selector = exp->elts[pc + 1].longconst;
1653	nargs = exp->elts[pc + 2].longconst;
1654	argvec = XALLOCAVEC (struct value *, nargs + 5);
1655
1656	(*pos) += 3;
1657
1658	long_type = builtin_type (exp->gdbarch)->builtin_long;
1659	selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1660
1661	if (noside == EVAL_AVOID_SIDE_EFFECTS)
1662	  sub_no_side = EVAL_NORMAL;
1663	else
1664	  sub_no_side = noside;
1665
1666	target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1667
1668	if (value_as_long (target) == 0)
1669 	  return value_from_longest (long_type, 0);
1670
1671	if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0).minsym)
1672	  gnu_runtime = 1;
1673
1674	/* Find the method dispatch (Apple runtime) or method lookup
1675	   (GNU runtime) function for Objective-C.  These will be used
1676	   to lookup the symbol information for the method.  If we
1677	   can't find any symbol information, then we'll use these to
1678	   call the method, otherwise we can call the method
1679	   directly.  The msg_send_stret function is used in the special
1680	   case of a method that returns a structure (Apple runtime
1681	   only).  */
1682	if (gnu_runtime)
1683	  {
1684	    type = selector_type;
1685
1686	    type = lookup_function_type (type);
1687	    type = lookup_pointer_type (type);
1688	    type = lookup_function_type (type);
1689	    type = lookup_pointer_type (type);
1690
1691	    msg_send = find_function_in_inferior ("objc_msg_lookup", NULL);
1692	    msg_send_stret
1693	      = find_function_in_inferior ("objc_msg_lookup", NULL);
1694
1695	    msg_send = value_from_pointer (type, value_as_address (msg_send));
1696	    msg_send_stret = value_from_pointer (type,
1697					value_as_address (msg_send_stret));
1698	  }
1699	else
1700	  {
1701	    msg_send = find_function_in_inferior ("objc_msgSend", NULL);
1702	    /* Special dispatcher for methods returning structs.  */
1703	    msg_send_stret
1704	      = find_function_in_inferior ("objc_msgSend_stret", NULL);
1705	  }
1706
1707	/* Verify the target object responds to this method.  The
1708	   standard top-level 'Object' class uses a different name for
1709	   the verification method than the non-standard, but more
1710	   often used, 'NSObject' class.  Make sure we check for both.  */
1711
1712	responds_selector
1713	  = lookup_child_selector (exp->gdbarch, "respondsToSelector:");
1714	if (responds_selector == 0)
1715	  responds_selector
1716	    = lookup_child_selector (exp->gdbarch, "respondsTo:");
1717
1718	if (responds_selector == 0)
1719	  error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1720
1721	method_selector
1722	  = lookup_child_selector (exp->gdbarch, "methodForSelector:");
1723	if (method_selector == 0)
1724	  method_selector
1725	    = lookup_child_selector (exp->gdbarch, "methodFor:");
1726
1727	if (method_selector == 0)
1728	  error (_("no 'methodFor:' or 'methodForSelector:' method"));
1729
1730	/* Call the verification method, to make sure that the target
1731	 class implements the desired method.  */
1732
1733	argvec[0] = msg_send;
1734	argvec[1] = target;
1735	argvec[2] = value_from_longest (long_type, responds_selector);
1736	argvec[3] = value_from_longest (long_type, selector);
1737	argvec[4] = 0;
1738
1739	ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1740	if (gnu_runtime)
1741	  {
1742	    /* Function objc_msg_lookup returns a pointer.  */
1743	    argvec[0] = ret;
1744	    ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1745	  }
1746	if (value_as_long (ret) == 0)
1747	  error (_("Target does not respond to this message selector."));
1748
1749	/* Call "methodForSelector:" method, to get the address of a
1750	   function method that implements this selector for this
1751	   class.  If we can find a symbol at that address, then we
1752	   know the return type, parameter types etc.  (that's a good
1753	   thing).  */
1754
1755	argvec[0] = msg_send;
1756	argvec[1] = target;
1757	argvec[2] = value_from_longest (long_type, method_selector);
1758	argvec[3] = value_from_longest (long_type, selector);
1759	argvec[4] = 0;
1760
1761	ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1762	if (gnu_runtime)
1763	  {
1764	    argvec[0] = ret;
1765	    ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1766	  }
1767
1768	/* ret should now be the selector.  */
1769
1770	addr = value_as_long (ret);
1771	if (addr)
1772	  {
1773	    struct symbol *sym = NULL;
1774
1775	    /* The address might point to a function descriptor;
1776	       resolve it to the actual code address instead.  */
1777	    addr = gdbarch_convert_from_func_ptr_addr (exp->gdbarch, addr,
1778						       current_top_target ());
1779
1780	    /* Is it a high_level symbol?  */
1781	    sym = find_pc_function (addr);
1782	    if (sym != NULL)
1783	      method = value_of_variable (sym, 0);
1784	  }
1785
1786	/* If we found a method with symbol information, check to see
1787           if it returns a struct.  Otherwise assume it doesn't.  */
1788
1789	if (method)
1790	  {
1791	    CORE_ADDR funaddr;
1792	    struct type *val_type;
1793
1794	    funaddr = find_function_addr (method, &val_type);
1795
1796	    block_for_pc (funaddr);
1797
1798	    val_type = check_typedef (val_type);
1799
1800	    if ((val_type == NULL)
1801		|| (val_type->code () == TYPE_CODE_ERROR))
1802	      {
1803		if (expect_type != NULL)
1804		  val_type = expect_type;
1805	      }
1806
1807	    struct_return = using_struct_return (exp->gdbarch, method,
1808						 val_type);
1809	  }
1810	else if (expect_type != NULL)
1811	  {
1812	    struct_return = using_struct_return (exp->gdbarch, NULL,
1813						 check_typedef (expect_type));
1814	  }
1815
1816	/* Found a function symbol.  Now we will substitute its
1817	   value in place of the message dispatcher (obj_msgSend),
1818	   so that we call the method directly instead of thru
1819	   the dispatcher.  The main reason for doing this is that
1820	   we can now evaluate the return value and parameter values
1821	   according to their known data types, in case we need to
1822	   do things like promotion, dereferencing, special handling
1823	   of structs and doubles, etc.
1824
1825	   We want to use the type signature of 'method', but still
1826	   jump to objc_msgSend() or objc_msgSend_stret() to better
1827	   mimic the behavior of the runtime.  */
1828
1829	if (method)
1830	  {
1831	    if (value_type (method)->code () != TYPE_CODE_FUNC)
1832	      error (_("method address has symbol information "
1833		       "with non-function type; skipping"));
1834
1835	    /* Create a function pointer of the appropriate type, and
1836	       replace its value with the value of msg_send or
1837	       msg_send_stret.  We must use a pointer here, as
1838	       msg_send and msg_send_stret are of pointer type, and
1839	       the representation may be different on systems that use
1840	       function descriptors.  */
1841	    if (struct_return)
1842	      called_method
1843		= value_from_pointer (lookup_pointer_type (value_type (method)),
1844				      value_as_address (msg_send_stret));
1845	    else
1846	      called_method
1847		= value_from_pointer (lookup_pointer_type (value_type (method)),
1848				      value_as_address (msg_send));
1849	  }
1850	else
1851	  {
1852	    if (struct_return)
1853	      called_method = msg_send_stret;
1854	    else
1855	      called_method = msg_send;
1856	  }
1857
1858	if (noside == EVAL_SKIP)
1859	  return eval_skip_value (exp);
1860
1861	if (noside == EVAL_AVOID_SIDE_EFFECTS)
1862	  {
1863	    /* If the return type doesn't look like a function type,
1864	       call an error.  This can happen if somebody tries to
1865	       turn a variable into a function call.  This is here
1866	       because people often want to call, eg, strcmp, which
1867	       gdb doesn't know is a function.  If gdb isn't asked for
1868	       it's opinion (ie. through "whatis"), it won't offer
1869	       it.  */
1870
1871	    struct type *callee_type = value_type (called_method);
1872
1873	    if (callee_type && callee_type->code () == TYPE_CODE_PTR)
1874	      callee_type = TYPE_TARGET_TYPE (callee_type);
1875	    callee_type = TYPE_TARGET_TYPE (callee_type);
1876
1877	    if (callee_type)
1878	    {
1879	      if ((callee_type->code () == TYPE_CODE_ERROR) && expect_type)
1880		return allocate_value (expect_type);
1881	      else
1882		return allocate_value (callee_type);
1883	    }
1884	    else
1885	      error (_("Expression of type other than "
1886		       "\"method returning ...\" used as a method"));
1887	  }
1888
1889	/* Now depending on whether we found a symbol for the method,
1890	   we will either call the runtime dispatcher or the method
1891	   directly.  */
1892
1893	argvec[0] = called_method;
1894	argvec[1] = target;
1895	argvec[2] = value_from_longest (long_type, selector);
1896	/* User-supplied arguments.  */
1897	for (tem = 0; tem < nargs; tem++)
1898	  argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1899	argvec[tem + 3] = 0;
1900
1901	auto call_args = gdb::make_array_view (argvec + 1, nargs + 2);
1902
1903	if (gnu_runtime && (method != NULL))
1904	  {
1905	    /* Function objc_msg_lookup returns a pointer.  */
1906	    deprecated_set_value_type (argvec[0],
1907				       lookup_pointer_type (lookup_function_type (value_type (argvec[0]))));
1908	    argvec[0] = call_function_by_hand (argvec[0], NULL, call_args);
1909	  }
1910
1911	return call_function_by_hand (argvec[0], NULL, call_args);
1912      }
1913      break;
1914
1915    case OP_FUNCALL:
1916      return evaluate_funcall (expect_type, exp, pos, noside);
1917
1918    case OP_F77_UNDETERMINED_ARGLIST:
1919
1920      /* Remember that in F77, functions, substring ops and
1921         array subscript operations cannot be disambiguated
1922         at parse time.  We have made all array subscript operations,
1923         substring operations as well as function calls  come here
1924         and we now have to discover what the heck this thing actually was.
1925         If it is a function, we process just as if we got an OP_FUNCALL.  */
1926
1927      nargs = longest_to_int (exp->elts[pc + 1].longconst);
1928      (*pos) += 2;
1929
1930      /* First determine the type code we are dealing with.  */
1931      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
1932      type = check_typedef (value_type (arg1));
1933      code = type->code ();
1934
1935      if (code == TYPE_CODE_PTR)
1936	{
1937	  /* Fortran always passes variable to subroutines as pointer.
1938	     So we need to look into its target type to see if it is
1939	     array, string or function.  If it is, we need to switch
1940	     to the target value the original one points to.  */
1941	  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1942
1943	  if (target_type->code () == TYPE_CODE_ARRAY
1944	      || target_type->code () == TYPE_CODE_STRING
1945	      || target_type->code () == TYPE_CODE_FUNC)
1946	    {
1947	      arg1 = value_ind (arg1);
1948	      type = check_typedef (value_type (arg1));
1949	      code = type->code ();
1950	    }
1951	}
1952
1953      switch (code)
1954	{
1955	case TYPE_CODE_ARRAY:
1956	  if (exp->elts[*pos].opcode == OP_RANGE)
1957	    return value_f90_subarray (arg1, exp, pos, noside);
1958	  else
1959	    {
1960	      if (noside == EVAL_SKIP)
1961		{
1962		  skip_undetermined_arglist (nargs, exp, pos, noside);
1963		  /* Return the dummy value with the correct type.  */
1964		  return arg1;
1965		}
1966	      goto multi_f77_subscript;
1967	    }
1968
1969	case TYPE_CODE_STRING:
1970	  if (exp->elts[*pos].opcode == OP_RANGE)
1971	    return value_f90_subarray (arg1, exp, pos, noside);
1972	  else
1973	    {
1974	      if (noside == EVAL_SKIP)
1975		{
1976		  skip_undetermined_arglist (nargs, exp, pos, noside);
1977		  /* Return the dummy value with the correct type.  */
1978		  return arg1;
1979		}
1980	      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1981	      return value_subscript (arg1, value_as_long (arg2));
1982	    }
1983
1984	case TYPE_CODE_PTR:
1985	case TYPE_CODE_FUNC:
1986	case TYPE_CODE_INTERNAL_FUNCTION:
1987	  /* It's a function call.  */
1988	  /* Allocate arg vector, including space for the function to be
1989	     called in argvec[0] and a terminating NULL.  */
1990	  argvec = (struct value **)
1991	    alloca (sizeof (struct value *) * (nargs + 2));
1992	  argvec[0] = arg1;
1993	  tem = 1;
1994	  for (; tem <= nargs; tem++)
1995	    {
1996	      argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1997	      /* Arguments in Fortran are passed by address.  Coerce the
1998		 arguments here rather than in value_arg_coerce as otherwise
1999		 the call to malloc to place the non-lvalue parameters in
2000		 target memory is hit by this Fortran specific logic.  This
2001		 results in malloc being called with a pointer to an integer
2002		 followed by an attempt to malloc the arguments to malloc in
2003		 target memory.  Infinite recursion ensues.  */
2004	      if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
2005		{
2006		  bool is_artificial
2007		    = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
2008		  argvec[tem] = fortran_argument_convert (argvec[tem],
2009							  is_artificial);
2010		}
2011	    }
2012	  argvec[tem] = 0;	/* signal end of arglist */
2013	  if (noside == EVAL_SKIP)
2014	    return eval_skip_value (exp);
2015	  return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
2016
2017	default:
2018	  error (_("Cannot perform substring on this type"));
2019	}
2020
2021    case OP_COMPLEX:
2022      /* We have a complex number, There should be 2 floating
2023         point numbers that compose it.  */
2024      (*pos) += 2;
2025      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2026      arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2027
2028      return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
2029
2030    case STRUCTOP_STRUCT:
2031      tem = longest_to_int (exp->elts[pc + 1].longconst);
2032      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
2033      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2034      if (noside == EVAL_SKIP)
2035	return eval_skip_value (exp);
2036      arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
2037			       NULL, "structure");
2038      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2039	arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
2040      return arg3;
2041
2042    case STRUCTOP_PTR:
2043      tem = longest_to_int (exp->elts[pc + 1].longconst);
2044      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
2045      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2046      if (noside == EVAL_SKIP)
2047	return eval_skip_value (exp);
2048
2049      /* Check to see if operator '->' has been overloaded.  If so replace
2050         arg1 with the value returned by evaluating operator->().  */
2051      while (unop_user_defined_p (op, arg1))
2052	{
2053	  struct value *value = NULL;
2054	  try
2055	    {
2056	      value = value_x_unop (arg1, op, noside);
2057	    }
2058
2059	  catch (const gdb_exception_error &except)
2060	    {
2061	      if (except.error == NOT_FOUND_ERROR)
2062		break;
2063	      else
2064		throw;
2065	    }
2066
2067	  arg1 = value;
2068	}
2069
2070      /* JYG: if print object is on we need to replace the base type
2071	 with rtti type in order to continue on with successful
2072	 lookup of member / method only available in the rtti type.  */
2073      {
2074        struct type *arg_type = value_type (arg1);
2075        struct type *real_type;
2076        int full, using_enc;
2077        LONGEST top;
2078	struct value_print_options opts;
2079
2080	get_user_print_options (&opts);
2081        if (opts.objectprint && TYPE_TARGET_TYPE (arg_type)
2082            && (TYPE_TARGET_TYPE (arg_type)->code () == TYPE_CODE_STRUCT))
2083          {
2084            real_type = value_rtti_indirect_type (arg1, &full, &top,
2085						  &using_enc);
2086            if (real_type)
2087                arg1 = value_cast (real_type, arg1);
2088          }
2089      }
2090
2091      arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
2092			       NULL, "structure pointer");
2093      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2094	arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
2095      return arg3;
2096
2097    case STRUCTOP_MEMBER:
2098    case STRUCTOP_MPTR:
2099      if (op == STRUCTOP_MEMBER)
2100	arg1 = evaluate_subexp_for_address (exp, pos, noside);
2101      else
2102	arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2103
2104      arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2105
2106      if (noside == EVAL_SKIP)
2107	return eval_skip_value (exp);
2108
2109      type = check_typedef (value_type (arg2));
2110      switch (type->code ())
2111	{
2112	case TYPE_CODE_METHODPTR:
2113	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
2114	    return value_zero (TYPE_TARGET_TYPE (type), not_lval);
2115	  else
2116	    {
2117	      arg2 = cplus_method_ptr_to_value (&arg1, arg2);
2118	      gdb_assert (value_type (arg2)->code () == TYPE_CODE_PTR);
2119	      return value_ind (arg2);
2120	    }
2121
2122	case TYPE_CODE_MEMBERPTR:
2123	  /* Now, convert these values to an address.  */
2124	  arg1 = value_cast_pointers (lookup_pointer_type (TYPE_SELF_TYPE (type)),
2125				      arg1, 1);
2126
2127	  mem_offset = value_as_long (arg2);
2128
2129	  arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2130				     value_as_long (arg1) + mem_offset);
2131	  return value_ind (arg3);
2132
2133	default:
2134	  error (_("non-pointer-to-member value used "
2135		   "in pointer-to-member construct"));
2136	}
2137
2138    case TYPE_INSTANCE:
2139      {
2140	type_instance_flags flags
2141	  = (type_instance_flag_value) longest_to_int (exp->elts[pc + 1].longconst);
2142	nargs = longest_to_int (exp->elts[pc + 2].longconst);
2143	arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
2144	for (ix = 0; ix < nargs; ++ix)
2145	  arg_types[ix] = exp->elts[pc + 2 + ix + 1].type;
2146
2147	fake_method fake_expect_type (flags, nargs, arg_types);
2148	*(pos) += 4 + nargs;
2149	return evaluate_subexp_standard (fake_expect_type.type (), exp, pos,
2150					 noside);
2151      }
2152
2153    case BINOP_CONCAT:
2154      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2155      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2156      if (noside == EVAL_SKIP)
2157	return eval_skip_value (exp);
2158      if (binop_user_defined_p (op, arg1, arg2))
2159	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2160      else
2161	return value_concat (arg1, arg2);
2162
2163    case BINOP_ASSIGN:
2164      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2165      /* Special-case assignments where the left-hand-side is a
2166	 convenience variable -- in these, don't bother setting an
2167	 expected type.  This avoids a weird case where re-assigning a
2168	 string or array to an internal variable could error with "Too
2169	 many array elements".  */
2170      arg2 = evaluate_subexp (VALUE_LVAL (arg1) == lval_internalvar
2171				? nullptr
2172				: value_type (arg1),
2173			      exp, pos, noside);
2174
2175      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2176	return arg1;
2177      if (binop_user_defined_p (op, arg1, arg2))
2178	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2179      else
2180	return value_assign (arg1, arg2);
2181
2182    case BINOP_ASSIGN_MODIFY:
2183      (*pos) += 2;
2184      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2185      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2186      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2187	return arg1;
2188      op = exp->elts[pc + 1].opcode;
2189      if (binop_user_defined_p (op, arg1, arg2))
2190	return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
2191      else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
2192						  value_type (arg1))
2193	       && is_integral_type (value_type (arg2)))
2194	arg2 = value_ptradd (arg1, value_as_long (arg2));
2195      else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
2196						  value_type (arg1))
2197	       && is_integral_type (value_type (arg2)))
2198	arg2 = value_ptradd (arg1, - value_as_long (arg2));
2199      else
2200	{
2201	  struct value *tmp = arg1;
2202
2203	  /* For shift and integer exponentiation operations,
2204	     only promote the first argument.  */
2205	  if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2206	      && is_integral_type (value_type (arg2)))
2207	    unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2208	  else
2209	    binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2210
2211	  arg2 = value_binop (tmp, arg2, op);
2212	}
2213      return value_assign (arg1, arg2);
2214
2215    case BINOP_ADD:
2216      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2217      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2218      if (noside == EVAL_SKIP)
2219	return eval_skip_value (exp);
2220      if (binop_user_defined_p (op, arg1, arg2))
2221	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2222      else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2223	       && is_integral_or_integral_reference (value_type (arg2)))
2224	return value_ptradd (arg1, value_as_long (arg2));
2225      else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2226	       && is_integral_or_integral_reference (value_type (arg1)))
2227	return value_ptradd (arg2, value_as_long (arg1));
2228      else
2229	{
2230	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2231	  return value_binop (arg1, arg2, BINOP_ADD);
2232	}
2233
2234    case BINOP_SUB:
2235      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2236      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2237      if (noside == EVAL_SKIP)
2238	return eval_skip_value (exp);
2239      if (binop_user_defined_p (op, arg1, arg2))
2240	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2241      else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2242	       && ptrmath_type_p (exp->language_defn, value_type (arg2)))
2243	{
2244	  /* FIXME -- should be ptrdiff_t */
2245	  type = builtin_type (exp->gdbarch)->builtin_long;
2246	  return value_from_longest (type, value_ptrdiff (arg1, arg2));
2247	}
2248      else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2249	       && is_integral_or_integral_reference (value_type (arg2)))
2250	return value_ptradd (arg1, - value_as_long (arg2));
2251      else
2252	{
2253	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2254	  return value_binop (arg1, arg2, BINOP_SUB);
2255	}
2256
2257    case BINOP_EXP:
2258    case BINOP_MUL:
2259    case BINOP_DIV:
2260    case BINOP_INTDIV:
2261    case BINOP_REM:
2262    case BINOP_MOD:
2263    case BINOP_LSH:
2264    case BINOP_RSH:
2265    case BINOP_BITWISE_AND:
2266    case BINOP_BITWISE_IOR:
2267    case BINOP_BITWISE_XOR:
2268      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2269      arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2270      if (noside == EVAL_SKIP)
2271	return eval_skip_value (exp);
2272      if (binop_user_defined_p (op, arg1, arg2))
2273	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2274      else
2275	{
2276	  /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2277	     fudge arg2 to avoid division-by-zero, the caller is
2278	     (theoretically) only looking for the type of the result.  */
2279	  if (noside == EVAL_AVOID_SIDE_EFFECTS
2280	      /* ??? Do we really want to test for BINOP_MOD here?
2281		 The implementation of value_binop gives it a well-defined
2282		 value.  */
2283	      && (op == BINOP_DIV
2284		  || op == BINOP_INTDIV
2285		  || op == BINOP_REM
2286		  || op == BINOP_MOD)
2287	      && value_logical_not (arg2))
2288	    {
2289	      struct value *v_one, *retval;
2290
2291	      v_one = value_one (value_type (arg2));
2292	      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
2293	      retval = value_binop (arg1, v_one, op);
2294	      return retval;
2295	    }
2296	  else
2297	    {
2298	      /* For shift and integer exponentiation operations,
2299		 only promote the first argument.  */
2300	      if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2301		  && is_integral_type (value_type (arg2)))
2302		unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2303	      else
2304		binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2305
2306	      return value_binop (arg1, arg2, op);
2307	    }
2308	}
2309
2310    case BINOP_SUBSCRIPT:
2311      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2312      arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2313      if (noside == EVAL_SKIP)
2314	return eval_skip_value (exp);
2315      if (binop_user_defined_p (op, arg1, arg2))
2316	return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2317      else
2318	{
2319	  /* If the user attempts to subscript something that is not an
2320	     array or pointer type (like a plain int variable for example),
2321	     then report this as an error.  */
2322
2323	  arg1 = coerce_ref (arg1);
2324	  type = check_typedef (value_type (arg1));
2325	  if (type->code () != TYPE_CODE_ARRAY
2326	      && type->code () != TYPE_CODE_PTR)
2327	    {
2328	      if (type->name ())
2329		error (_("cannot subscript something of type `%s'"),
2330		       type->name ());
2331	      else
2332		error (_("cannot subscript requested type"));
2333	    }
2334
2335	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
2336	    return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2337	  else
2338	    return value_subscript (arg1, value_as_long (arg2));
2339	}
2340    case MULTI_SUBSCRIPT:
2341      (*pos) += 2;
2342      nargs = longest_to_int (exp->elts[pc + 1].longconst);
2343      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2344      while (nargs-- > 0)
2345	{
2346	  arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2347	  /* FIXME:  EVAL_SKIP handling may not be correct.  */
2348	  if (noside == EVAL_SKIP)
2349	    {
2350	      if (nargs > 0)
2351		continue;
2352	      return eval_skip_value (exp);
2353	    }
2354	  /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct.  */
2355	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
2356	    {
2357	      /* If the user attempts to subscript something that has no target
2358	         type (like a plain int variable for example), then report this
2359	         as an error.  */
2360
2361	      type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
2362	      if (type != NULL)
2363		{
2364		  arg1 = value_zero (type, VALUE_LVAL (arg1));
2365		  noside = EVAL_SKIP;
2366		  continue;
2367		}
2368	      else
2369		{
2370		  error (_("cannot subscript something of type `%s'"),
2371			 value_type (arg1)->name ());
2372		}
2373	    }
2374
2375	  if (binop_user_defined_p (op, arg1, arg2))
2376	    {
2377	      arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2378	    }
2379	  else
2380	    {
2381	      arg1 = coerce_ref (arg1);
2382	      type = check_typedef (value_type (arg1));
2383
2384	      switch (type->code ())
2385		{
2386		case TYPE_CODE_PTR:
2387		case TYPE_CODE_ARRAY:
2388		case TYPE_CODE_STRING:
2389		  arg1 = value_subscript (arg1, value_as_long (arg2));
2390		  break;
2391
2392		default:
2393		  if (type->name ())
2394		    error (_("cannot subscript something of type `%s'"),
2395			   type->name ());
2396		  else
2397		    error (_("cannot subscript requested type"));
2398		}
2399	    }
2400	}
2401      return (arg1);
2402
2403    multi_f77_subscript:
2404      {
2405	LONGEST subscript_array[MAX_FORTRAN_DIMS];
2406	int ndimensions = 1, i;
2407	struct value *array = arg1;
2408
2409	if (nargs > MAX_FORTRAN_DIMS)
2410	  error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2411
2412	ndimensions = calc_f77_array_dims (type);
2413
2414	if (nargs != ndimensions)
2415	  error (_("Wrong number of subscripts"));
2416
2417	gdb_assert (nargs > 0);
2418
2419	/* Now that we know we have a legal array subscript expression
2420	   let us actually find out where this element exists in the array.  */
2421
2422	/* Take array indices left to right.  */
2423	for (i = 0; i < nargs; i++)
2424	  {
2425	    /* Evaluate each subscript; it must be a legal integer in F77.  */
2426	    arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2427
2428	    /* Fill in the subscript array.  */
2429
2430	    subscript_array[i] = value_as_long (arg2);
2431	  }
2432
2433	/* Internal type of array is arranged right to left.  */
2434	for (i = nargs; i > 0; i--)
2435	  {
2436	    struct type *array_type = check_typedef (value_type (array));
2437	    LONGEST index = subscript_array[i - 1];
2438
2439	    array = value_subscripted_rvalue (array, index,
2440					      f77_get_lowerbound (array_type));
2441	  }
2442
2443	return array;
2444      }
2445
2446    case BINOP_LOGICAL_AND:
2447      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2448      if (noside == EVAL_SKIP)
2449	{
2450	  evaluate_subexp (nullptr, exp, pos, noside);
2451	  return eval_skip_value (exp);
2452	}
2453
2454      oldpos = *pos;
2455      arg2 = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2456      *pos = oldpos;
2457
2458      if (binop_user_defined_p (op, arg1, arg2))
2459	{
2460	  arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2461	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2462	}
2463      else
2464	{
2465	  tem = value_logical_not (arg1);
2466	  arg2
2467	    = evaluate_subexp (nullptr, exp, pos, (tem ? EVAL_SKIP : noside));
2468	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2469	  return value_from_longest (type,
2470			     (LONGEST) (!tem && !value_logical_not (arg2)));
2471	}
2472
2473    case BINOP_LOGICAL_OR:
2474      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2475      if (noside == EVAL_SKIP)
2476	{
2477	  evaluate_subexp (nullptr, exp, pos, noside);
2478	  return eval_skip_value (exp);
2479	}
2480
2481      oldpos = *pos;
2482      arg2 = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2483      *pos = oldpos;
2484
2485      if (binop_user_defined_p (op, arg1, arg2))
2486	{
2487	  arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2488	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2489	}
2490      else
2491	{
2492	  tem = value_logical_not (arg1);
2493	  arg2
2494	    = evaluate_subexp (nullptr, exp, pos, (!tem ? EVAL_SKIP : noside));
2495	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2496	  return value_from_longest (type,
2497			     (LONGEST) (!tem || !value_logical_not (arg2)));
2498	}
2499
2500    case BINOP_EQUAL:
2501      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2502      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2503      if (noside == EVAL_SKIP)
2504	return eval_skip_value (exp);
2505      if (binop_user_defined_p (op, arg1, arg2))
2506	{
2507	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2508	}
2509      else
2510	{
2511	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2512	  tem = value_equal (arg1, arg2);
2513	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2514	  return value_from_longest (type, (LONGEST) tem);
2515	}
2516
2517    case BINOP_NOTEQUAL:
2518      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2519      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2520      if (noside == EVAL_SKIP)
2521	return eval_skip_value (exp);
2522      if (binop_user_defined_p (op, arg1, arg2))
2523	{
2524	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2525	}
2526      else
2527	{
2528	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2529	  tem = value_equal (arg1, arg2);
2530	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2531	  return value_from_longest (type, (LONGEST) ! tem);
2532	}
2533
2534    case BINOP_LESS:
2535      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2536      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2537      if (noside == EVAL_SKIP)
2538	return eval_skip_value (exp);
2539      if (binop_user_defined_p (op, arg1, arg2))
2540	{
2541	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2542	}
2543      else
2544	{
2545	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2546	  tem = value_less (arg1, arg2);
2547	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2548	  return value_from_longest (type, (LONGEST) tem);
2549	}
2550
2551    case BINOP_GTR:
2552      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2553      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2554      if (noside == EVAL_SKIP)
2555	return eval_skip_value (exp);
2556      if (binop_user_defined_p (op, arg1, arg2))
2557	{
2558	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2559	}
2560      else
2561	{
2562	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2563	  tem = value_less (arg2, arg1);
2564	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2565	  return value_from_longest (type, (LONGEST) tem);
2566	}
2567
2568    case BINOP_GEQ:
2569      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2570      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2571      if (noside == EVAL_SKIP)
2572	return eval_skip_value (exp);
2573      if (binop_user_defined_p (op, arg1, arg2))
2574	{
2575	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2576	}
2577      else
2578	{
2579	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2580	  tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2581	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2582	  return value_from_longest (type, (LONGEST) tem);
2583	}
2584
2585    case BINOP_LEQ:
2586      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2587      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2588      if (noside == EVAL_SKIP)
2589	return eval_skip_value (exp);
2590      if (binop_user_defined_p (op, arg1, arg2))
2591	{
2592	  return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2593	}
2594      else
2595	{
2596	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2597	  tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2598	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2599	  return value_from_longest (type, (LONGEST) tem);
2600	}
2601
2602    case BINOP_REPEAT:
2603      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2604      arg2 = evaluate_subexp (nullptr, exp, pos, noside);
2605      if (noside == EVAL_SKIP)
2606	return eval_skip_value (exp);
2607      type = check_typedef (value_type (arg2));
2608      if (type->code () != TYPE_CODE_INT
2609          && type->code () != TYPE_CODE_ENUM)
2610	error (_("Non-integral right operand for \"@\" operator."));
2611      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2612	{
2613	  return allocate_repeat_value (value_type (arg1),
2614				     longest_to_int (value_as_long (arg2)));
2615	}
2616      else
2617	return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2618
2619    case BINOP_COMMA:
2620      evaluate_subexp (nullptr, exp, pos, noside);
2621      return evaluate_subexp (nullptr, exp, pos, noside);
2622
2623    case UNOP_PLUS:
2624      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2625      if (noside == EVAL_SKIP)
2626	return eval_skip_value (exp);
2627      if (unop_user_defined_p (op, arg1))
2628	return value_x_unop (arg1, op, noside);
2629      else
2630	{
2631	  unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2632	  return value_pos (arg1);
2633	}
2634
2635    case UNOP_NEG:
2636      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2637      if (noside == EVAL_SKIP)
2638	return eval_skip_value (exp);
2639      if (unop_user_defined_p (op, arg1))
2640	return value_x_unop (arg1, op, noside);
2641      else
2642	{
2643	  unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2644	  return value_neg (arg1);
2645	}
2646
2647    case UNOP_COMPLEMENT:
2648      /* C++: check for and handle destructor names.  */
2649
2650      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2651      if (noside == EVAL_SKIP)
2652	return eval_skip_value (exp);
2653      if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2654	return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2655      else
2656	{
2657	  unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2658	  return value_complement (arg1);
2659	}
2660
2661    case UNOP_LOGICAL_NOT:
2662      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
2663      if (noside == EVAL_SKIP)
2664	return eval_skip_value (exp);
2665      if (unop_user_defined_p (op, arg1))
2666	return value_x_unop (arg1, op, noside);
2667      else
2668	{
2669	  type = language_bool_type (exp->language_defn, exp->gdbarch);
2670	  return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2671	}
2672
2673    case UNOP_IND:
2674      if (expect_type && expect_type->code () == TYPE_CODE_PTR)
2675	expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2676      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2677      type = check_typedef (value_type (arg1));
2678      if (type->code () == TYPE_CODE_METHODPTR
2679	  || type->code () == TYPE_CODE_MEMBERPTR)
2680	error (_("Attempt to dereference pointer "
2681		 "to member without an object"));
2682      if (noside == EVAL_SKIP)
2683	return eval_skip_value (exp);
2684      if (unop_user_defined_p (op, arg1))
2685	return value_x_unop (arg1, op, noside);
2686      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2687	{
2688	  type = check_typedef (value_type (arg1));
2689	  if (type->code () == TYPE_CODE_PTR
2690	      || TYPE_IS_REFERENCE (type)
2691	  /* In C you can dereference an array to get the 1st elt.  */
2692	      || type->code () == TYPE_CODE_ARRAY
2693	    )
2694	    return value_zero (TYPE_TARGET_TYPE (type),
2695			       lval_memory);
2696	  else if (type->code () == TYPE_CODE_INT)
2697	    /* GDB allows dereferencing an int.  */
2698	    return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2699			       lval_memory);
2700	  else
2701	    error (_("Attempt to take contents of a non-pointer value."));
2702	}
2703
2704      /* Allow * on an integer so we can cast it to whatever we want.
2705	 This returns an int, which seems like the most C-like thing to
2706	 do.  "long long" variables are rare enough that
2707	 BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2708      if (type->code () == TYPE_CODE_INT)
2709	return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2710			      (CORE_ADDR) value_as_address (arg1));
2711      return value_ind (arg1);
2712
2713    case UNOP_ADDR:
2714      /* C++: check for and handle pointer to members.  */
2715
2716      if (noside == EVAL_SKIP)
2717	{
2718	  evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
2719	  return eval_skip_value (exp);
2720	}
2721      else
2722	{
2723	  struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2724							       noside);
2725
2726	  return retvalp;
2727	}
2728
2729    case UNOP_SIZEOF:
2730      if (noside == EVAL_SKIP)
2731	{
2732	  evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
2733	  return eval_skip_value (exp);
2734	}
2735      return evaluate_subexp_for_sizeof (exp, pos, noside);
2736
2737    case UNOP_ALIGNOF:
2738      {
2739	type = value_type (
2740	  evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS));
2741	/* FIXME: This should be size_t.  */
2742	struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
2743	ULONGEST align = type_align (type);
2744	if (align == 0)
2745	  error (_("could not determine alignment of type"));
2746	return value_from_longest (size_type, align);
2747      }
2748
2749    case UNOP_CAST:
2750      (*pos) += 2;
2751      type = exp->elts[pc + 1].type;
2752      return evaluate_subexp_for_cast (exp, pos, noside, type);
2753
2754    case UNOP_CAST_TYPE:
2755      arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2756      type = value_type (arg1);
2757      return evaluate_subexp_for_cast (exp, pos, noside, type);
2758
2759    case UNOP_DYNAMIC_CAST:
2760      arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2761      type = value_type (arg1);
2762      arg1 = evaluate_subexp (type, exp, pos, noside);
2763      if (noside == EVAL_SKIP)
2764	return eval_skip_value (exp);
2765      return value_dynamic_cast (type, arg1);
2766
2767    case UNOP_REINTERPRET_CAST:
2768      arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2769      type = value_type (arg1);
2770      arg1 = evaluate_subexp (type, exp, pos, noside);
2771      if (noside == EVAL_SKIP)
2772	return eval_skip_value (exp);
2773      return value_reinterpret_cast (type, arg1);
2774
2775    case UNOP_MEMVAL:
2776      (*pos) += 2;
2777      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2778      if (noside == EVAL_SKIP)
2779	return eval_skip_value (exp);
2780      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2781	return value_zero (exp->elts[pc + 1].type, lval_memory);
2782      else
2783	return value_at_lazy (exp->elts[pc + 1].type,
2784			      value_as_address (arg1));
2785
2786    case UNOP_MEMVAL_TYPE:
2787      arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2788      type = value_type (arg1);
2789      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2790      if (noside == EVAL_SKIP)
2791	return eval_skip_value (exp);
2792      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2793	return value_zero (type, lval_memory);
2794      else
2795	return value_at_lazy (type, value_as_address (arg1));
2796
2797    case UNOP_PREINCREMENT:
2798      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2799      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2800	return arg1;
2801      else if (unop_user_defined_p (op, arg1))
2802	{
2803	  return value_x_unop (arg1, op, noside);
2804	}
2805      else
2806	{
2807	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2808	    arg2 = value_ptradd (arg1, 1);
2809	  else
2810	    {
2811	      struct value *tmp = arg1;
2812
2813	      arg2 = value_one (value_type (arg1));
2814	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2815	      arg2 = value_binop (tmp, arg2, BINOP_ADD);
2816	    }
2817
2818	  return value_assign (arg1, arg2);
2819	}
2820
2821    case UNOP_PREDECREMENT:
2822      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2823      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2824	return arg1;
2825      else if (unop_user_defined_p (op, arg1))
2826	{
2827	  return value_x_unop (arg1, op, noside);
2828	}
2829      else
2830	{
2831	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2832	    arg2 = value_ptradd (arg1, -1);
2833	  else
2834	    {
2835	      struct value *tmp = arg1;
2836
2837	      arg2 = value_one (value_type (arg1));
2838	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2839	      arg2 = value_binop (tmp, arg2, BINOP_SUB);
2840	    }
2841
2842	  return value_assign (arg1, arg2);
2843	}
2844
2845    case UNOP_POSTINCREMENT:
2846      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2847      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2848	return arg1;
2849      else if (unop_user_defined_p (op, arg1))
2850	{
2851	  return value_x_unop (arg1, op, noside);
2852	}
2853      else
2854	{
2855	  arg3 = value_non_lval (arg1);
2856
2857	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2858	    arg2 = value_ptradd (arg1, 1);
2859	  else
2860	    {
2861	      struct value *tmp = arg1;
2862
2863	      arg2 = value_one (value_type (arg1));
2864	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2865	      arg2 = value_binop (tmp, arg2, BINOP_ADD);
2866	    }
2867
2868	  value_assign (arg1, arg2);
2869	  return arg3;
2870	}
2871
2872    case UNOP_POSTDECREMENT:
2873      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2874      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2875	return arg1;
2876      else if (unop_user_defined_p (op, arg1))
2877	{
2878	  return value_x_unop (arg1, op, noside);
2879	}
2880      else
2881	{
2882	  arg3 = value_non_lval (arg1);
2883
2884	  if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2885	    arg2 = value_ptradd (arg1, -1);
2886	  else
2887	    {
2888	      struct value *tmp = arg1;
2889
2890	      arg2 = value_one (value_type (arg1));
2891	      binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2892	      arg2 = value_binop (tmp, arg2, BINOP_SUB);
2893	    }
2894
2895	  value_assign (arg1, arg2);
2896	  return arg3;
2897	}
2898
2899    case OP_THIS:
2900      (*pos) += 1;
2901      return value_of_this (exp->language_defn);
2902
2903    case OP_TYPE:
2904      /* The value is not supposed to be used.  This is here to make it
2905         easier to accommodate expressions that contain types.  */
2906      (*pos) += 2;
2907      if (noside == EVAL_SKIP)
2908	return eval_skip_value (exp);
2909      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2910	return allocate_value (exp->elts[pc + 1].type);
2911      else
2912        error (_("Attempt to use a type name as an expression"));
2913
2914    case OP_TYPEOF:
2915    case OP_DECLTYPE:
2916      if (noside == EVAL_SKIP)
2917	{
2918	  evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
2919	  return eval_skip_value (exp);
2920	}
2921      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2922	{
2923	  enum exp_opcode sub_op = exp->elts[*pos].opcode;
2924	  struct value *result;
2925
2926	  result = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2927
2928	  /* 'decltype' has special semantics for lvalues.  */
2929	  if (op == OP_DECLTYPE
2930	      && (sub_op == BINOP_SUBSCRIPT
2931		  || sub_op == STRUCTOP_MEMBER
2932		  || sub_op == STRUCTOP_MPTR
2933		  || sub_op == UNOP_IND
2934		  || sub_op == STRUCTOP_STRUCT
2935		  || sub_op == STRUCTOP_PTR
2936		  || sub_op == OP_SCOPE))
2937	    {
2938	      type = value_type (result);
2939
2940	      if (!TYPE_IS_REFERENCE (type))
2941		{
2942		  type = lookup_lvalue_reference_type (type);
2943		  result = allocate_value (type);
2944		}
2945	    }
2946
2947	  return result;
2948	}
2949      else
2950        error (_("Attempt to use a type as an expression"));
2951
2952    case OP_TYPEID:
2953      {
2954	struct value *result;
2955	enum exp_opcode sub_op = exp->elts[*pos].opcode;
2956
2957	if (sub_op == OP_TYPE || sub_op == OP_DECLTYPE || sub_op == OP_TYPEOF)
2958	  result = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2959	else
2960	  result = evaluate_subexp (nullptr, exp, pos, noside);
2961
2962	if (noside != EVAL_NORMAL)
2963	  return allocate_value (cplus_typeid_type (exp->gdbarch));
2964
2965	return cplus_typeid (result);
2966      }
2967
2968    default:
2969      /* Removing this case and compiling with gcc -Wall reveals that
2970         a lot of cases are hitting this case.  Some of these should
2971         probably be removed from expression.h; others are legitimate
2972         expressions which are (apparently) not fully implemented.
2973
2974         If there are any cases landing here which mean a user error,
2975         then they should be separate cases, with more descriptive
2976         error messages.  */
2977
2978      error (_("GDB does not (yet) know how to "
2979	       "evaluate that kind of expression"));
2980    }
2981
2982  gdb_assert_not_reached ("missed return?");
2983}
2984
2985/* Evaluate a subexpression of EXP, at index *POS,
2986   and return the address of that subexpression.
2987   Advance *POS over the subexpression.
2988   If the subexpression isn't an lvalue, get an error.
2989   NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2990   then only the type of the result need be correct.  */
2991
2992static struct value *
2993evaluate_subexp_for_address (struct expression *exp, int *pos,
2994			     enum noside noside)
2995{
2996  enum exp_opcode op;
2997  int pc;
2998  struct symbol *var;
2999  struct value *x;
3000  int tem;
3001
3002  pc = (*pos);
3003  op = exp->elts[pc].opcode;
3004
3005  switch (op)
3006    {
3007    case UNOP_IND:
3008      (*pos)++;
3009      x = evaluate_subexp (nullptr, exp, pos, noside);
3010
3011      /* We can't optimize out "&*" if there's a user-defined operator*.  */
3012      if (unop_user_defined_p (op, x))
3013	{
3014	  x = value_x_unop (x, op, noside);
3015	  goto default_case_after_eval;
3016	}
3017
3018      return coerce_array (x);
3019
3020    case UNOP_MEMVAL:
3021      (*pos) += 3;
3022      return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
3023			 evaluate_subexp (nullptr, exp, pos, noside));
3024
3025    case UNOP_MEMVAL_TYPE:
3026      {
3027	struct type *type;
3028
3029	(*pos) += 1;
3030	x = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3031	type = value_type (x);
3032	return value_cast (lookup_pointer_type (type),
3033			   evaluate_subexp (nullptr, exp, pos, noside));
3034      }
3035
3036    case OP_VAR_VALUE:
3037      var = exp->elts[pc + 2].symbol;
3038
3039      /* C++: The "address" of a reference should yield the address
3040       * of the object pointed to.  Let value_addr() deal with it.  */
3041      if (TYPE_IS_REFERENCE (SYMBOL_TYPE (var)))
3042	goto default_case;
3043
3044      (*pos) += 4;
3045      if (noside == EVAL_AVOID_SIDE_EFFECTS)
3046	{
3047	  struct type *type =
3048	    lookup_pointer_type (SYMBOL_TYPE (var));
3049	  enum address_class sym_class = SYMBOL_CLASS (var);
3050
3051	  if (sym_class == LOC_CONST
3052	      || sym_class == LOC_CONST_BYTES
3053	      || sym_class == LOC_REGISTER)
3054	    error (_("Attempt to take address of register or constant."));
3055
3056	  return
3057	    value_zero (type, not_lval);
3058	}
3059      else
3060	return address_of_variable (var, exp->elts[pc + 1].block);
3061
3062    case OP_VAR_MSYM_VALUE:
3063      {
3064	(*pos) += 4;
3065
3066	value *val = evaluate_var_msym_value (noside,
3067					      exp->elts[pc + 1].objfile,
3068					      exp->elts[pc + 2].msymbol);
3069	if (noside == EVAL_AVOID_SIDE_EFFECTS)
3070	  {
3071	    struct type *type = lookup_pointer_type (value_type (val));
3072	    return value_zero (type, not_lval);
3073	  }
3074	else
3075	  return value_addr (val);
3076      }
3077
3078    case OP_SCOPE:
3079      tem = longest_to_int (exp->elts[pc + 2].longconst);
3080      (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
3081      x = value_aggregate_elt (exp->elts[pc + 1].type,
3082			       &exp->elts[pc + 3].string,
3083			       NULL, 1, noside);
3084      if (x == NULL)
3085	error (_("There is no field named %s"), &exp->elts[pc + 3].string);
3086      return x;
3087
3088    default:
3089    default_case:
3090      x = evaluate_subexp (nullptr, exp, pos, noside);
3091    default_case_after_eval:
3092      if (noside == EVAL_AVOID_SIDE_EFFECTS)
3093	{
3094	  struct type *type = check_typedef (value_type (x));
3095
3096	  if (TYPE_IS_REFERENCE (type))
3097	    return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3098			       not_lval);
3099	  else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
3100	    return value_zero (lookup_pointer_type (value_type (x)),
3101			       not_lval);
3102	  else
3103	    error (_("Attempt to take address of "
3104		     "value not located in memory."));
3105	}
3106      return value_addr (x);
3107    }
3108}
3109
3110/* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
3111   When used in contexts where arrays will be coerced anyway, this is
3112   equivalent to `evaluate_subexp' but much faster because it avoids
3113   actually fetching array contents (perhaps obsolete now that we have
3114   value_lazy()).
3115
3116   Note that we currently only do the coercion for C expressions, where
3117   arrays are zero based and the coercion is correct.  For other languages,
3118   with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
3119   to decide if coercion is appropriate.  */
3120
3121struct value *
3122evaluate_subexp_with_coercion (struct expression *exp,
3123			       int *pos, enum noside noside)
3124{
3125  enum exp_opcode op;
3126  int pc;
3127  struct value *val;
3128  struct symbol *var;
3129  struct type *type;
3130
3131  pc = (*pos);
3132  op = exp->elts[pc].opcode;
3133
3134  switch (op)
3135    {
3136    case OP_VAR_VALUE:
3137      var = exp->elts[pc + 2].symbol;
3138      type = check_typedef (SYMBOL_TYPE (var));
3139      if (type->code () == TYPE_CODE_ARRAY
3140	  && !TYPE_VECTOR (type)
3141	  && CAST_IS_CONVERSION (exp->language_defn))
3142	{
3143	  (*pos) += 4;
3144	  val = address_of_variable (var, exp->elts[pc + 1].block);
3145	  return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3146			     val);
3147	}
3148      /* FALLTHROUGH */
3149
3150    default:
3151      return evaluate_subexp (nullptr, exp, pos, noside);
3152    }
3153}
3154
3155/* Evaluate a subexpression of EXP, at index *POS,
3156   and return a value for the size of that subexpression.
3157   Advance *POS over the subexpression.  If NOSIDE is EVAL_NORMAL
3158   we allow side-effects on the operand if its type is a variable
3159   length array.   */
3160
3161static struct value *
3162evaluate_subexp_for_sizeof (struct expression *exp, int *pos,
3163			    enum noside noside)
3164{
3165  /* FIXME: This should be size_t.  */
3166  struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3167  enum exp_opcode op;
3168  int pc;
3169  struct type *type;
3170  struct value *val;
3171
3172  pc = (*pos);
3173  op = exp->elts[pc].opcode;
3174
3175  switch (op)
3176    {
3177      /* This case is handled specially
3178         so that we avoid creating a value for the result type.
3179         If the result type is very big, it's desirable not to
3180         create a value unnecessarily.  */
3181    case UNOP_IND:
3182      (*pos)++;
3183      val = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3184      type = check_typedef (value_type (val));
3185      if (type->code () != TYPE_CODE_PTR
3186	  && !TYPE_IS_REFERENCE (type)
3187	  && type->code () != TYPE_CODE_ARRAY)
3188	error (_("Attempt to take contents of a non-pointer value."));
3189      type = TYPE_TARGET_TYPE (type);
3190      if (is_dynamic_type (type))
3191	type = value_type (value_ind (val));
3192      return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3193
3194    case UNOP_MEMVAL:
3195      (*pos) += 3;
3196      type = exp->elts[pc + 1].type;
3197      break;
3198
3199    case UNOP_MEMVAL_TYPE:
3200      (*pos) += 1;
3201      val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3202      type = value_type (val);
3203      break;
3204
3205    case OP_VAR_VALUE:
3206      type = SYMBOL_TYPE (exp->elts[pc + 2].symbol);
3207      if (is_dynamic_type (type))
3208	{
3209	  val = evaluate_subexp (nullptr, exp, pos, EVAL_NORMAL);
3210	  type = value_type (val);
3211	  if (type->code () == TYPE_CODE_ARRAY
3212              && is_dynamic_type (type->index_type ())
3213              && type->bounds ()->high.kind () == PROP_UNDEFINED)
3214	    return allocate_optimized_out_value (size_type);
3215	}
3216      else
3217	(*pos) += 4;
3218      break;
3219
3220    case OP_VAR_MSYM_VALUE:
3221      {
3222	(*pos) += 4;
3223
3224	minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
3225	value *mval = evaluate_var_msym_value (noside,
3226					       exp->elts[pc + 1].objfile,
3227					       msymbol);
3228
3229	type = value_type (mval);
3230	if (type->code () == TYPE_CODE_ERROR)
3231	  error_unknown_type (msymbol->print_name ());
3232
3233	return value_from_longest (size_type, TYPE_LENGTH (type));
3234      }
3235      break;
3236
3237      /* Deal with the special case if NOSIDE is EVAL_NORMAL and the resulting
3238	 type of the subscript is a variable length array type. In this case we
3239	 must re-evaluate the right hand side of the subscription to allow
3240	 side-effects. */
3241    case BINOP_SUBSCRIPT:
3242      if (noside == EVAL_NORMAL)
3243	{
3244	  int npc = (*pos) + 1;
3245
3246	  val = evaluate_subexp (nullptr, exp, &npc, EVAL_AVOID_SIDE_EFFECTS);
3247	  type = check_typedef (value_type (val));
3248	  if (type->code () == TYPE_CODE_ARRAY)
3249	    {
3250	      type = check_typedef (TYPE_TARGET_TYPE (type));
3251	      if (type->code () == TYPE_CODE_ARRAY)
3252		{
3253		  type = type->index_type ();
3254		  /* Only re-evaluate the right hand side if the resulting type
3255		     is a variable length type.  */
3256		  if (type->bounds ()->flag_bound_evaluated)
3257		    {
3258		      val = evaluate_subexp (nullptr, exp, pos, EVAL_NORMAL);
3259		      return value_from_longest
3260			(size_type, (LONGEST) TYPE_LENGTH (value_type (val)));
3261		    }
3262		}
3263	    }
3264	}
3265
3266      /* Fall through.  */
3267
3268    default:
3269      val = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3270      type = value_type (val);
3271      break;
3272    }
3273
3274  /* $5.3.3/2 of the C++ Standard (n3290 draft) says of sizeof:
3275     "When applied to a reference or a reference type, the result is
3276     the size of the referenced type."  */
3277  type = check_typedef (type);
3278  if (exp->language_defn->la_language == language_cplus
3279      && (TYPE_IS_REFERENCE (type)))
3280    type = check_typedef (TYPE_TARGET_TYPE (type));
3281  return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3282}
3283
3284/* Evaluate a subexpression of EXP, at index *POS, and return a value
3285   for that subexpression cast to TO_TYPE.  Advance *POS over the
3286   subexpression.  */
3287
3288static value *
3289evaluate_subexp_for_cast (expression *exp, int *pos,
3290			  enum noside noside,
3291			  struct type *to_type)
3292{
3293  int pc = *pos;
3294
3295  /* Don't let symbols be evaluated with evaluate_subexp because that
3296     throws an "unknown type" error for no-debug data symbols.
3297     Instead, we want the cast to reinterpret the symbol.  */
3298  if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
3299      || exp->elts[pc].opcode == OP_VAR_VALUE)
3300    {
3301      (*pos) += 4;
3302
3303      value *val;
3304      if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
3305	{
3306	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
3307	    return value_zero (to_type, not_lval);
3308
3309	  val = evaluate_var_msym_value (noside,
3310					 exp->elts[pc + 1].objfile,
3311					 exp->elts[pc + 2].msymbol);
3312	}
3313      else
3314	val = evaluate_var_value (noside,
3315				  exp->elts[pc + 1].block,
3316				  exp->elts[pc + 2].symbol);
3317
3318      if (noside == EVAL_SKIP)
3319	return eval_skip_value (exp);
3320
3321      val = value_cast (to_type, val);
3322
3323      /* Don't allow e.g. '&(int)var_with_no_debug_info'.  */
3324      if (VALUE_LVAL (val) == lval_memory)
3325	{
3326	  if (value_lazy (val))
3327	    value_fetch_lazy (val);
3328	  VALUE_LVAL (val) = not_lval;
3329	}
3330      return val;
3331    }
3332
3333  value *val = evaluate_subexp (to_type, exp, pos, noside);
3334  if (noside == EVAL_SKIP)
3335    return eval_skip_value (exp);
3336  return value_cast (to_type, val);
3337}
3338
3339/* Parse a type expression in the string [P..P+LENGTH).  */
3340
3341struct type *
3342parse_and_eval_type (char *p, int length)
3343{
3344  char *tmp = (char *) alloca (length + 4);
3345
3346  tmp[0] = '(';
3347  memcpy (tmp + 1, p, length);
3348  tmp[length + 1] = ')';
3349  tmp[length + 2] = '0';
3350  tmp[length + 3] = '\0';
3351  expression_up expr = parse_expression (tmp);
3352  if (expr->elts[0].opcode != UNOP_CAST)
3353    error (_("Internal error in eval_type."));
3354  return expr->elts[1].type;
3355}
3356
3357int
3358calc_f77_array_dims (struct type *array_type)
3359{
3360  int ndimen = 1;
3361  struct type *tmp_type;
3362
3363  if ((array_type->code () != TYPE_CODE_ARRAY))
3364    error (_("Can't get dimensions for a non-array type"));
3365
3366  tmp_type = array_type;
3367
3368  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3369    {
3370      if (tmp_type->code () == TYPE_CODE_ARRAY)
3371	++ndimen;
3372    }
3373  return ndimen;
3374}
3375