OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-7.1/] [gdb/] [eval.c] - Blame information for rev 595

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.