OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gdb/] [gdb-6.8/] [gdb/] [eval.c] - Blame information for rev 25

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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