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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gdb-6.8/] [gdb/] [eval.c] - Blame information for rev 853

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

Line No. Rev Author Line
1 24 jeremybenn
/* Evaluate expressions for GDB.
2
 
3
   Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995,
4
   1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2008
5
   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 146 jeremybenn
        /* Initialize the array to avoid picky compiler complaints */
1651
        memset (subscript_array, 0, MAX_FORTRAN_DIMS * sizeof (int));
1652
 
1653 24 jeremybenn
        if (nargs > MAX_FORTRAN_DIMS)
1654
          error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
1655
 
1656
        tmp_type = check_typedef (value_type (arg1));
1657
        ndimensions = calc_f77_array_dims (type);
1658
 
1659
        if (nargs != ndimensions)
1660
          error (_("Wrong number of subscripts"));
1661
 
1662
        /* Now that we know we have a legal array subscript expression
1663
           let us actually find out where this element exists in the array. */
1664
 
1665
        offset_item = 0;
1666
        /* Take array indices left to right */
1667
        for (i = 0; i < nargs; i++)
1668
          {
1669
            /* Evaluate each subscript, It must be a legal integer in F77 */
1670
            arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1671
 
1672
            /* Fill in the subscript and array size arrays */
1673
 
1674
            subscript_array[i] = value_as_long (arg2);
1675
          }
1676
 
1677
        /* Internal type of array is arranged right to left */
1678
        for (i = 0; i < nargs; i++)
1679
          {
1680
            retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1681
            if (retcode == BOUND_FETCH_ERROR)
1682
              error (_("Cannot obtain dynamic upper bound"));
1683
 
1684
            retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1685
            if (retcode == BOUND_FETCH_ERROR)
1686
              error (_("Cannot obtain dynamic lower bound"));
1687
 
1688
            array_size_array[nargs - i - 1] = upper - lower + 1;
1689
 
1690
            /* Zero-normalize subscripts so that offsetting will work. */
1691
 
1692
            subscript_array[nargs - i - 1] -= lower;
1693
 
1694
            /* If we are at the bottom of a multidimensional
1695
               array type then keep a ptr to the last ARRAY
1696
               type around for use when calling value_subscript()
1697
               below. This is done because we pretend to value_subscript
1698
               that we actually have a one-dimensional array
1699
               of base element type that we apply a simple
1700
               offset to. */
1701
 
1702
            if (i < nargs - 1)
1703
              tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1704
          }
1705
 
1706
        /* Now let us calculate the offset for this item */
1707
 
1708
        offset_item = subscript_array[ndimensions - 1];
1709
 
1710
        for (i = ndimensions - 1; i > 0; --i)
1711
          offset_item =
1712
            array_size_array[i - 1] * offset_item + subscript_array[i - 1];
1713
 
1714
        /* Construct a value node with the value of the offset */
1715
 
1716
        arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1717
 
1718
        /* Let us now play a dirty trick: we will take arg1
1719
           which is a value node pointing to the topmost level
1720
           of the multidimensional array-set and pretend
1721
           that it is actually a array of the final element
1722
           type, this will ensure that value_subscript()
1723
           returns the correct type value */
1724
 
1725
        deprecated_set_value_type (arg1, tmp_type);
1726
        return value_ind (value_add (value_coerce_array (arg1), arg2));
1727
      }
1728
 
1729
    case BINOP_LOGICAL_AND:
1730
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1731
      if (noside == EVAL_SKIP)
1732
        {
1733
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1734
          goto nosideret;
1735
        }
1736
 
1737
      oldpos = *pos;
1738
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1739
      *pos = oldpos;
1740
 
1741
      if (binop_user_defined_p (op, arg1, arg2))
1742
        {
1743
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1744
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1745
        }
1746
      else
1747
        {
1748
          tem = value_logical_not (arg1);
1749
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1750
                                  (tem ? EVAL_SKIP : noside));
1751
          return value_from_longest (LA_BOOL_TYPE,
1752
                             (LONGEST) (!tem && !value_logical_not (arg2)));
1753
        }
1754
 
1755
    case BINOP_LOGICAL_OR:
1756
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1757
      if (noside == EVAL_SKIP)
1758
        {
1759
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1760
          goto nosideret;
1761
        }
1762
 
1763
      oldpos = *pos;
1764
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1765
      *pos = oldpos;
1766
 
1767
      if (binop_user_defined_p (op, arg1, arg2))
1768
        {
1769
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1770
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1771
        }
1772
      else
1773
        {
1774
          tem = value_logical_not (arg1);
1775
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1776
                                  (!tem ? EVAL_SKIP : noside));
1777
          return value_from_longest (LA_BOOL_TYPE,
1778
                             (LONGEST) (!tem || !value_logical_not (arg2)));
1779
        }
1780
 
1781
    case BINOP_EQUAL:
1782
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1783
      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1784
      if (noside == EVAL_SKIP)
1785
        goto nosideret;
1786
      if (binop_user_defined_p (op, arg1, arg2))
1787
        {
1788
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1789
        }
1790
      else
1791
        {
1792
          tem = value_equal (arg1, arg2);
1793
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1794
        }
1795
 
1796
    case BINOP_NOTEQUAL:
1797
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1798
      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1799
      if (noside == EVAL_SKIP)
1800
        goto nosideret;
1801
      if (binop_user_defined_p (op, arg1, arg2))
1802
        {
1803
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1804
        }
1805
      else
1806
        {
1807
          tem = value_equal (arg1, arg2);
1808
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1809
        }
1810
 
1811
    case BINOP_LESS:
1812
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1813
      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1814
      if (noside == EVAL_SKIP)
1815
        goto nosideret;
1816
      if (binop_user_defined_p (op, arg1, arg2))
1817
        {
1818
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1819
        }
1820
      else
1821
        {
1822
          tem = value_less (arg1, arg2);
1823
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1824
        }
1825
 
1826
    case BINOP_GTR:
1827
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1828
      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1829
      if (noside == EVAL_SKIP)
1830
        goto nosideret;
1831
      if (binop_user_defined_p (op, arg1, arg2))
1832
        {
1833
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1834
        }
1835
      else
1836
        {
1837
          tem = value_less (arg2, arg1);
1838
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1839
        }
1840
 
1841
    case BINOP_GEQ:
1842
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1843
      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1844
      if (noside == EVAL_SKIP)
1845
        goto nosideret;
1846
      if (binop_user_defined_p (op, arg1, arg2))
1847
        {
1848
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1849
        }
1850
      else
1851
        {
1852
          tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1853
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1854
        }
1855
 
1856
    case BINOP_LEQ:
1857
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1858
      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1859
      if (noside == EVAL_SKIP)
1860
        goto nosideret;
1861
      if (binop_user_defined_p (op, arg1, arg2))
1862
        {
1863
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1864
        }
1865
      else
1866
        {
1867
          tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1868
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1869
        }
1870
 
1871
    case BINOP_REPEAT:
1872
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1873
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1874
      if (noside == EVAL_SKIP)
1875
        goto nosideret;
1876
      type = check_typedef (value_type (arg2));
1877
      if (TYPE_CODE (type) != TYPE_CODE_INT)
1878
        error (_("Non-integral right operand for \"@\" operator."));
1879
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1880
        {
1881
          return allocate_repeat_value (value_type (arg1),
1882
                                     longest_to_int (value_as_long (arg2)));
1883
        }
1884
      else
1885
        return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1886
 
1887
    case BINOP_COMMA:
1888
      evaluate_subexp (NULL_TYPE, exp, pos, noside);
1889
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1890
 
1891
    case UNOP_PLUS:
1892
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1893
      if (noside == EVAL_SKIP)
1894
        goto nosideret;
1895
      if (unop_user_defined_p (op, arg1))
1896
        return value_x_unop (arg1, op, noside);
1897
      else
1898
        return value_pos (arg1);
1899
 
1900
    case UNOP_NEG:
1901
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1902
      if (noside == EVAL_SKIP)
1903
        goto nosideret;
1904
      if (unop_user_defined_p (op, arg1))
1905
        return value_x_unop (arg1, op, noside);
1906
      else
1907
        return value_neg (arg1);
1908
 
1909
    case UNOP_COMPLEMENT:
1910
      /* C++: check for and handle destructor names.  */
1911
      op = exp->elts[*pos].opcode;
1912
 
1913
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1914
      if (noside == EVAL_SKIP)
1915
        goto nosideret;
1916
      if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1917
        return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1918
      else
1919
        return value_complement (arg1);
1920
 
1921
    case UNOP_LOGICAL_NOT:
1922
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1923
      if (noside == EVAL_SKIP)
1924
        goto nosideret;
1925
      if (unop_user_defined_p (op, arg1))
1926
        return value_x_unop (arg1, op, noside);
1927
      else
1928
        return value_from_longest (LA_BOOL_TYPE,
1929
                                   (LONGEST) value_logical_not (arg1));
1930
 
1931
    case UNOP_IND:
1932
      if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1933
        expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1934
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1935
      type = check_typedef (value_type (arg1));
1936
      if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
1937
          || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
1938
        error (_("Attempt to dereference pointer to member without an object"));
1939
      if (noside == EVAL_SKIP)
1940
        goto nosideret;
1941
      if (unop_user_defined_p (op, arg1))
1942
        return value_x_unop (arg1, op, noside);
1943
      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1944
        {
1945
          type = check_typedef (value_type (arg1));
1946
          if (TYPE_CODE (type) == TYPE_CODE_PTR
1947
              || TYPE_CODE (type) == TYPE_CODE_REF
1948
          /* In C you can dereference an array to get the 1st elt.  */
1949
              || TYPE_CODE (type) == TYPE_CODE_ARRAY
1950
            )
1951
            return value_zero (TYPE_TARGET_TYPE (type),
1952
                               lval_memory);
1953
          else if (TYPE_CODE (type) == TYPE_CODE_INT)
1954
            /* GDB allows dereferencing an int.  */
1955
            return value_zero (builtin_type_int, lval_memory);
1956
          else
1957
            error (_("Attempt to take contents of a non-pointer value."));
1958
        }
1959
      return value_ind (arg1);
1960
 
1961
    case UNOP_ADDR:
1962
      /* C++: check for and handle pointer to members.  */
1963
 
1964
      op = exp->elts[*pos].opcode;
1965
 
1966
      if (noside == EVAL_SKIP)
1967
        {
1968
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1969
          goto nosideret;
1970
        }
1971
      else
1972
        {
1973
          struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
1974
          return retvalp;
1975
        }
1976
 
1977
    case UNOP_SIZEOF:
1978
      if (noside == EVAL_SKIP)
1979
        {
1980
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1981
          goto nosideret;
1982
        }
1983
      return evaluate_subexp_for_sizeof (exp, pos);
1984
 
1985
    case UNOP_CAST:
1986
      (*pos) += 2;
1987
      type = exp->elts[pc + 1].type;
1988
      arg1 = evaluate_subexp (type, exp, pos, noside);
1989
      if (noside == EVAL_SKIP)
1990
        goto nosideret;
1991
      if (type != value_type (arg1))
1992
        arg1 = value_cast (type, arg1);
1993
      return arg1;
1994
 
1995
    case UNOP_MEMVAL:
1996
      (*pos) += 2;
1997
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1998
      if (noside == EVAL_SKIP)
1999
        goto nosideret;
2000
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2001
        return value_zero (exp->elts[pc + 1].type, lval_memory);
2002
      else
2003
        return value_at_lazy (exp->elts[pc + 1].type,
2004
                              value_as_address (arg1));
2005
 
2006
    case UNOP_MEMVAL_TLS:
2007
      (*pos) += 3;
2008
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2009
      if (noside == EVAL_SKIP)
2010
        goto nosideret;
2011
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2012
        return value_zero (exp->elts[pc + 2].type, lval_memory);
2013
      else
2014
        {
2015
          CORE_ADDR tls_addr;
2016
          tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2017
                                                   value_as_address (arg1));
2018
          return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2019
        }
2020
 
2021
    case UNOP_PREINCREMENT:
2022
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2023
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2024
        return arg1;
2025
      else if (unop_user_defined_p (op, arg1))
2026
        {
2027
          return value_x_unop (arg1, op, noside);
2028
        }
2029
      else
2030
        {
2031
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2032
                                                      (LONGEST) 1));
2033
          return value_assign (arg1, arg2);
2034
        }
2035
 
2036
    case UNOP_PREDECREMENT:
2037
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2038
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2039
        return arg1;
2040
      else if (unop_user_defined_p (op, arg1))
2041
        {
2042
          return value_x_unop (arg1, op, noside);
2043
        }
2044
      else
2045
        {
2046
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2047
                                                      (LONGEST) 1));
2048
          return value_assign (arg1, arg2);
2049
        }
2050
 
2051
    case UNOP_POSTINCREMENT:
2052
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2053
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2054
        return arg1;
2055
      else if (unop_user_defined_p (op, arg1))
2056
        {
2057
          return value_x_unop (arg1, op, noside);
2058
        }
2059
      else
2060
        {
2061
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2062
                                                      (LONGEST) 1));
2063
          value_assign (arg1, arg2);
2064
          return arg1;
2065
        }
2066
 
2067
    case UNOP_POSTDECREMENT:
2068
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2069
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2070
        return arg1;
2071
      else if (unop_user_defined_p (op, arg1))
2072
        {
2073
          return value_x_unop (arg1, op, noside);
2074
        }
2075
      else
2076
        {
2077
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2078
                                                      (LONGEST) 1));
2079
          value_assign (arg1, arg2);
2080
          return arg1;
2081
        }
2082
 
2083
    case OP_THIS:
2084
      (*pos) += 1;
2085
      return value_of_this (1);
2086
 
2087
    case OP_OBJC_SELF:
2088
      (*pos) += 1;
2089
      return value_of_local ("self", 1);
2090
 
2091
    case OP_TYPE:
2092
      /* The value is not supposed to be used.  This is here to make it
2093
         easier to accommodate expressions that contain types.  */
2094
      (*pos) += 2;
2095
      if (noside == EVAL_SKIP)
2096
        goto nosideret;
2097
      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2098
        return allocate_value (exp->elts[pc + 1].type);
2099
      else
2100
        error (_("Attempt to use a type name as an expression"));
2101
 
2102
    default:
2103
      /* Removing this case and compiling with gcc -Wall reveals that
2104
         a lot of cases are hitting this case.  Some of these should
2105
         probably be removed from expression.h; others are legitimate
2106
         expressions which are (apparently) not fully implemented.
2107
 
2108
         If there are any cases landing here which mean a user error,
2109
         then they should be separate cases, with more descriptive
2110
         error messages.  */
2111
 
2112
      error (_("\
2113
GDB does not (yet) know how to evaluate that kind of expression"));
2114
    }
2115
 
2116
nosideret:
2117
  return value_from_longest (builtin_type_long, (LONGEST) 1);
2118
}
2119
 
2120
/* Evaluate a subexpression of EXP, at index *POS,
2121
   and return the address of that subexpression.
2122
   Advance *POS over the subexpression.
2123
   If the subexpression isn't an lvalue, get an error.
2124
   NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2125
   then only the type of the result need be correct.  */
2126
 
2127
static struct value *
2128
evaluate_subexp_for_address (struct expression *exp, int *pos,
2129
                             enum noside noside)
2130
{
2131
  enum exp_opcode op;
2132
  int pc;
2133
  struct symbol *var;
2134
  struct value *x;
2135
  int tem;
2136
 
2137
  pc = (*pos);
2138
  op = exp->elts[pc].opcode;
2139
 
2140
  switch (op)
2141
    {
2142
    case UNOP_IND:
2143
      (*pos)++;
2144
      x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2145
 
2146
      /* We can't optimize out "&*" if there's a user-defined operator*.  */
2147
      if (unop_user_defined_p (op, x))
2148
        {
2149
          x = value_x_unop (x, op, noside);
2150
          goto default_case_after_eval;
2151
        }
2152
 
2153
      return x;
2154
 
2155
    case UNOP_MEMVAL:
2156
      (*pos) += 3;
2157
      return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2158
                         evaluate_subexp (NULL_TYPE, exp, pos, noside));
2159
 
2160
    case OP_VAR_VALUE:
2161
      var = exp->elts[pc + 2].symbol;
2162
 
2163
      /* C++: The "address" of a reference should yield the address
2164
       * of the object pointed to. Let value_addr() deal with it. */
2165
      if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2166
        goto default_case;
2167
 
2168
      (*pos) += 4;
2169
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2170
        {
2171
          struct type *type =
2172
          lookup_pointer_type (SYMBOL_TYPE (var));
2173
          enum address_class sym_class = SYMBOL_CLASS (var);
2174
 
2175
          if (sym_class == LOC_CONST
2176
              || sym_class == LOC_CONST_BYTES
2177
              || sym_class == LOC_REGISTER
2178
              || sym_class == LOC_REGPARM)
2179
            error (_("Attempt to take address of register or constant."));
2180
 
2181
          return
2182
            value_zero (type, not_lval);
2183
        }
2184
      else if (symbol_read_needs_frame (var))
2185
        return
2186
          locate_var_value
2187
          (var,
2188
           block_innermost_frame (exp->elts[pc + 1].block));
2189
      else
2190
        return locate_var_value (var, NULL);
2191
 
2192
    case OP_SCOPE:
2193
      tem = longest_to_int (exp->elts[pc + 2].longconst);
2194
      (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2195
      x = value_aggregate_elt (exp->elts[pc + 1].type,
2196
                               &exp->elts[pc + 3].string,
2197
                               1, noside);
2198
      if (x == NULL)
2199
        error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2200
      return x;
2201
 
2202
    default:
2203
    default_case:
2204
      x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2205
    default_case_after_eval:
2206
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
2207
        {
2208
          struct type *type = check_typedef (value_type (x));
2209
 
2210
          if (VALUE_LVAL (x) == lval_memory)
2211
            return value_zero (lookup_pointer_type (value_type (x)),
2212
                               not_lval);
2213
          else if (TYPE_CODE (type) == TYPE_CODE_REF)
2214
            return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2215
                               not_lval);
2216
          else
2217
            error (_("Attempt to take address of non-lval"));
2218
        }
2219
      return value_addr (x);
2220
    }
2221
}
2222
 
2223
/* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2224
   When used in contexts where arrays will be coerced anyway, this is
2225
   equivalent to `evaluate_subexp' but much faster because it avoids
2226
   actually fetching array contents (perhaps obsolete now that we have
2227
   value_lazy()).
2228
 
2229
   Note that we currently only do the coercion for C expressions, where
2230
   arrays are zero based and the coercion is correct.  For other languages,
2231
   with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2232
   to decide if coercion is appropriate.
2233
 
2234
 */
2235
 
2236
struct value *
2237
evaluate_subexp_with_coercion (struct expression *exp,
2238
                               int *pos, enum noside noside)
2239
{
2240
  enum exp_opcode op;
2241
  int pc;
2242
  struct value *val;
2243
  struct symbol *var;
2244
 
2245
  pc = (*pos);
2246
  op = exp->elts[pc].opcode;
2247
 
2248
  switch (op)
2249
    {
2250
    case OP_VAR_VALUE:
2251
      var = exp->elts[pc + 2].symbol;
2252
      if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2253
          && CAST_IS_CONVERSION)
2254
        {
2255
          (*pos) += 4;
2256
          val =
2257
            locate_var_value
2258
            (var, block_innermost_frame (exp->elts[pc + 1].block));
2259
          return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2260
                             val);
2261
        }
2262
      /* FALLTHROUGH */
2263
 
2264
    default:
2265
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2266
    }
2267
}
2268
 
2269
/* Evaluate a subexpression of EXP, at index *POS,
2270
   and return a value for the size of that subexpression.
2271
   Advance *POS over the subexpression.  */
2272
 
2273
static struct value *
2274
evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2275
{
2276
  enum exp_opcode op;
2277
  int pc;
2278
  struct type *type;
2279
  struct value *val;
2280
 
2281
  pc = (*pos);
2282
  op = exp->elts[pc].opcode;
2283
 
2284
  switch (op)
2285
    {
2286
      /* This case is handled specially
2287
         so that we avoid creating a value for the result type.
2288
         If the result type is very big, it's desirable not to
2289
         create a value unnecessarily.  */
2290
    case UNOP_IND:
2291
      (*pos)++;
2292
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2293
      type = check_typedef (value_type (val));
2294
      if (TYPE_CODE (type) != TYPE_CODE_PTR
2295
          && TYPE_CODE (type) != TYPE_CODE_REF
2296
          && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2297
        error (_("Attempt to take contents of a non-pointer value."));
2298
      type = check_typedef (TYPE_TARGET_TYPE (type));
2299
      return value_from_longest (builtin_type_int, (LONGEST)
2300
                                 TYPE_LENGTH (type));
2301
 
2302
    case UNOP_MEMVAL:
2303
      (*pos) += 3;
2304
      type = check_typedef (exp->elts[pc + 1].type);
2305
      return value_from_longest (builtin_type_int,
2306
                                 (LONGEST) TYPE_LENGTH (type));
2307
 
2308
    case OP_VAR_VALUE:
2309
      (*pos) += 4;
2310
      type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2311
      return
2312
        value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
2313
 
2314
    default:
2315
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2316
      return value_from_longest (builtin_type_int,
2317
                                 (LONGEST) TYPE_LENGTH (value_type (val)));
2318
    }
2319
}
2320
 
2321
/* Parse a type expression in the string [P..P+LENGTH). */
2322
 
2323
struct type *
2324
parse_and_eval_type (char *p, int length)
2325
{
2326
  char *tmp = (char *) alloca (length + 4);
2327
  struct expression *expr;
2328
  tmp[0] = '(';
2329
  memcpy (tmp + 1, p, length);
2330
  tmp[length + 1] = ')';
2331
  tmp[length + 2] = '0';
2332
  tmp[length + 3] = '\0';
2333
  expr = parse_expression (tmp);
2334
  if (expr->elts[0].opcode != UNOP_CAST)
2335
    error (_("Internal error in eval_type."));
2336
  return expr->elts[1].type;
2337
}
2338
 
2339
int
2340
calc_f77_array_dims (struct type *array_type)
2341
{
2342
  int ndimen = 1;
2343
  struct type *tmp_type;
2344
 
2345
  if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2346
    error (_("Can't get dimensions for a non-array type"));
2347
 
2348
  tmp_type = array_type;
2349
 
2350
  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2351
    {
2352
      if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2353
        ++ndimen;
2354
    }
2355
  return ndimen;
2356
}

powered by: WebSVN 2.1.0

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