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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.3/] [gdb/] [eval.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 1181 sfurman
/* Evaluate expressions for GDB.
2
   Copyright 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995,
3
   1996, 1997, 1998, 1999, 2000, 2001, 2002
4
   Free Software Foundation, Inc.
5
 
6
   This file is part of GDB.
7
 
8
   This program is free software; you can redistribute it and/or modify
9
   it under the terms of the GNU General Public License as published by
10
   the Free Software Foundation; either version 2 of the License, or
11
   (at your option) any later version.
12
 
13
   This program is distributed in the hope that it will be useful,
14
   but WITHOUT ANY WARRANTY; without even the implied warranty of
15
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
   GNU General Public License for more details.
17
 
18
   You should have received a copy of the GNU General Public License
19
   along with this program; if not, write to the Free Software
20
   Foundation, Inc., 59 Temple Place - Suite 330,
21
   Boston, MA 02111-1307, USA.  */
22
 
23
#include "defs.h"
24
#include "gdb_string.h"
25
#include "symtab.h"
26
#include "gdbtypes.h"
27
#include "value.h"
28
#include "expression.h"
29
#include "target.h"
30
#include "frame.h"
31
#include "language.h"           /* For CAST_IS_CONVERSION */
32
#include "f-lang.h"             /* for array bound stuff */
33
#include "cp-abi.h"
34
 
35
/* Defined in symtab.c */
36
extern int hp_som_som_object_present;
37
 
38
/* This is defined in valops.c */
39
extern int overload_resolution;
40
 
41
/* JYG: lookup rtti type of STRUCTOP_PTR when this is set to continue
42
   on with successful lookup for member/method of the rtti type. */
43
extern int objectprint;
44
 
45
/* Prototypes for local functions. */
46
 
47
static struct value *evaluate_subexp_for_sizeof (struct expression *, int *);
48
 
49
static struct value *evaluate_subexp_for_address (struct expression *,
50
                                                  int *, enum noside);
51
 
52
static struct value *evaluate_subexp (struct type *, struct expression *,
53
                                      int *, enum noside);
54
 
55
static char *get_label (struct expression *, int *);
56
 
57
static struct value *evaluate_struct_tuple (struct value *,
58
                                            struct expression *, int *,
59
                                            enum noside, int);
60
 
61
static LONGEST init_array_element (struct value *, struct value *,
62
                                   struct expression *, int *, enum noside,
63
                                   LONGEST, LONGEST);
64
 
65
static struct value *
66
evaluate_subexp (struct type *expect_type, register struct expression *exp,
67
                 register int *pos, enum noside noside)
68
{
69
  return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
70
}
71
 
72
/* Parse the string EXP as a C expression, evaluate it,
73
   and return the result as a number.  */
74
 
75
CORE_ADDR
76
parse_and_eval_address (char *exp)
77
{
78
  struct expression *expr = parse_expression (exp);
79
  register CORE_ADDR addr;
80
  register struct cleanup *old_chain =
81
    make_cleanup (free_current_contents, &expr);
82
 
83
  addr = value_as_address (evaluate_expression (expr));
84
  do_cleanups (old_chain);
85
  return addr;
86
}
87
 
88
/* Like parse_and_eval_address but takes a pointer to a char * variable
89
   and advanced that variable across the characters parsed.  */
90
 
91
CORE_ADDR
92
parse_and_eval_address_1 (char **expptr)
93
{
94
  struct expression *expr = parse_exp_1 (expptr, (struct block *) 0, 0);
95
  register CORE_ADDR addr;
96
  register struct cleanup *old_chain =
97
    make_cleanup (free_current_contents, &expr);
98
 
99
  addr = value_as_address (evaluate_expression (expr));
100
  do_cleanups (old_chain);
101
  return addr;
102
}
103
 
104
/* Like parse_and_eval_address, but treats the value of the expression
105
   as an integer, not an address, returns a LONGEST, not a CORE_ADDR */
106
LONGEST
107
parse_and_eval_long (char *exp)
108
{
109
  struct expression *expr = parse_expression (exp);
110
  register LONGEST retval;
111
  register struct cleanup *old_chain =
112
    make_cleanup (free_current_contents, &expr);
113
 
114
  retval = value_as_long (evaluate_expression (expr));
115
  do_cleanups (old_chain);
116
  return (retval);
117
}
118
 
119
struct value *
120
parse_and_eval (char *exp)
121
{
122
  struct expression *expr = parse_expression (exp);
123
  struct value *val;
124
  register struct cleanup *old_chain =
125
    make_cleanup (free_current_contents, &expr);
126
 
127
  val = evaluate_expression (expr);
128
  do_cleanups (old_chain);
129
  return val;
130
}
131
 
132
/* Parse up to a comma (or to a closeparen)
133
   in the string EXPP as an expression, evaluate it, and return the value.
134
   EXPP is advanced to point to the comma.  */
135
 
136
struct value *
137
parse_to_comma_and_eval (char **expp)
138
{
139
  struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
140
  struct value *val;
141
  register struct cleanup *old_chain =
142
    make_cleanup (free_current_contents, &expr);
143
 
144
  val = evaluate_expression (expr);
145
  do_cleanups (old_chain);
146
  return val;
147
}
148
 
149
/* Evaluate an expression in internal prefix form
150
   such as is constructed by parse.y.
151
 
152
   See expression.h for info on the format of an expression.  */
153
 
154
struct value *
155
evaluate_expression (struct expression *exp)
156
{
157
  int pc = 0;
158
  return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
159
}
160
 
161
/* Evaluate an expression, avoiding all memory references
162
   and getting a value whose type alone is correct.  */
163
 
164
struct value *
165
evaluate_type (struct expression *exp)
166
{
167
  int pc = 0;
168
  return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
169
}
170
 
171
/* If the next expression is an OP_LABELED, skips past it,
172
   returning the label.  Otherwise, does nothing and returns NULL. */
173
 
174
static char *
175
get_label (register struct expression *exp, int *pos)
176
{
177
  if (exp->elts[*pos].opcode == OP_LABELED)
178
    {
179
      int pc = (*pos)++;
180
      char *name = &exp->elts[pc + 2].string;
181
      int tem = longest_to_int (exp->elts[pc + 1].longconst);
182
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
183
      return name;
184
    }
185
  else
186
    return NULL;
187
}
188
 
189
/* This function evaluates tuples (in (OBSOLETE) Chill) or
190
   brace-initializers (in C/C++) for structure types.  */
191
 
192
static struct value *
193
evaluate_struct_tuple (struct value *struct_val,
194
                       register struct expression *exp,
195
                       register int *pos, enum noside noside, int nargs)
196
{
197
  struct type *struct_type = check_typedef (VALUE_TYPE (struct_val));
198
  struct type *substruct_type = struct_type;
199
  struct type *field_type;
200
  int fieldno = -1;
201
  int variantno = -1;
202
  int subfieldno = -1;
203
  while (--nargs >= 0)
204
    {
205
      int pc = *pos;
206
      struct value *val = NULL;
207
      int nlabels = 0;
208
      int bitpos, bitsize;
209
      char *addr;
210
 
211
      /* Skip past the labels, and count them. */
212
      while (get_label (exp, pos) != NULL)
213
        nlabels++;
214
 
215
      do
216
        {
217
          char *label = get_label (exp, &pc);
218
          if (label)
219
            {
220
              for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
221
                   fieldno++)
222
                {
223
                  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
224
                  if (field_name != NULL && STREQ (field_name, label))
225
                    {
226
                      variantno = -1;
227
                      subfieldno = fieldno;
228
                      substruct_type = struct_type;
229
                      goto found;
230
                    }
231
                }
232
              for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
233
                   fieldno++)
234
                {
235
                  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
236
                  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
237
                  if ((field_name == 0 || *field_name == '\0')
238
                      && TYPE_CODE (field_type) == TYPE_CODE_UNION)
239
                    {
240
                      variantno = 0;
241
                      for (; variantno < TYPE_NFIELDS (field_type);
242
                           variantno++)
243
                        {
244
                          substruct_type
245
                            = TYPE_FIELD_TYPE (field_type, variantno);
246
                          if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
247
                            {
248
                              for (subfieldno = 0;
249
                                 subfieldno < TYPE_NFIELDS (substruct_type);
250
                                   subfieldno++)
251
                                {
252
                                  if (STREQ (TYPE_FIELD_NAME (substruct_type,
253
                                                              subfieldno),
254
                                             label))
255
                                    {
256
                                      goto found;
257
                                    }
258
                                }
259
                            }
260
                        }
261
                    }
262
                }
263
              error ("there is no field named %s", label);
264
            found:
265
              ;
266
            }
267
          else
268
            {
269
              /* Unlabelled tuple element - go to next field. */
270
              if (variantno >= 0)
271
                {
272
                  subfieldno++;
273
                  if (subfieldno >= TYPE_NFIELDS (substruct_type))
274
                    {
275
                      variantno = -1;
276
                      substruct_type = struct_type;
277
                    }
278
                }
279
              if (variantno < 0)
280
                {
281
                  fieldno++;
282
                  subfieldno = fieldno;
283
                  if (fieldno >= TYPE_NFIELDS (struct_type))
284
                    error ("too many initializers");
285
                  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
286
                  if (TYPE_CODE (field_type) == TYPE_CODE_UNION
287
                      && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
288
                    error ("don't know which variant you want to set");
289
                }
290
            }
291
 
292
          /* Here, struct_type is the type of the inner struct,
293
             while substruct_type is the type of the inner struct.
294
             These are the same for normal structures, but a variant struct
295
             contains anonymous union fields that contain substruct fields.
296
             The value fieldno is the index of the top-level (normal or
297
             anonymous union) field in struct_field, while the value
298
             subfieldno is the index of the actual real (named inner) field
299
             in substruct_type. */
300
 
301
          field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
302
          if (val == 0)
303
            val = evaluate_subexp (field_type, exp, pos, noside);
304
 
305
          /* Now actually set the field in struct_val. */
306
 
307
          /* Assign val to field fieldno. */
308
          if (VALUE_TYPE (val) != field_type)
309
            val = value_cast (field_type, val);
310
 
311
          bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
312
          bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
313
          if (variantno >= 0)
314
            bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
315
          addr = VALUE_CONTENTS (struct_val) + bitpos / 8;
316
          if (bitsize)
317
            modify_field (addr, value_as_long (val),
318
                          bitpos % 8, bitsize);
319
          else
320
            memcpy (addr, VALUE_CONTENTS (val),
321
                    TYPE_LENGTH (VALUE_TYPE (val)));
322
        }
323
      while (--nlabels > 0);
324
    }
325
  return struct_val;
326
}
327
 
328
/* Recursive helper function for setting elements of array tuples for
329
   (OBSOLETE) Chill.  The target is ARRAY (which has bounds LOW_BOUND
330
   to HIGH_BOUND); the element value is ELEMENT; EXP, POS and NOSIDE
331
   are as usual.  Evaluates index expresions and sets the specified
332
   element(s) of ARRAY to ELEMENT.  Returns last index value.  */
333
 
334
static LONGEST
335
init_array_element (struct value *array, struct value *element,
336
                    register struct expression *exp, register int *pos,
337
                    enum noside noside, LONGEST low_bound, LONGEST high_bound)
338
{
339
  LONGEST index;
340
  int element_size = TYPE_LENGTH (VALUE_TYPE (element));
341
  if (exp->elts[*pos].opcode == BINOP_COMMA)
342
    {
343
      (*pos)++;
344
      init_array_element (array, element, exp, pos, noside,
345
                          low_bound, high_bound);
346
      return init_array_element (array, element,
347
                                 exp, pos, noside, low_bound, high_bound);
348
    }
349
  else if (exp->elts[*pos].opcode == BINOP_RANGE)
350
    {
351
      LONGEST low, high;
352
      (*pos)++;
353
      low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
354
      high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
355
      if (low < low_bound || high > high_bound)
356
        error ("tuple range index out of range");
357
      for (index = low; index <= high; index++)
358
        {
359
          memcpy (VALUE_CONTENTS_RAW (array)
360
                  + (index - low_bound) * element_size,
361
                  VALUE_CONTENTS (element), element_size);
362
        }
363
    }
364
  else
365
    {
366
      index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
367
      if (index < low_bound || index > high_bound)
368
        error ("tuple index out of range");
369
      memcpy (VALUE_CONTENTS_RAW (array) + (index - low_bound) * element_size,
370
              VALUE_CONTENTS (element), element_size);
371
    }
372
  return index;
373
}
374
 
375
struct value *
376
evaluate_subexp_standard (struct type *expect_type,
377
                          register struct expression *exp, register int *pos,
378
                          enum noside noside)
379
{
380
  enum exp_opcode op;
381
  int tem, tem2, tem3;
382
  register int pc, pc2 = 0, oldpos;
383
  struct value *arg1 = NULL;
384
  struct value *arg2 = NULL;
385
  struct value *arg3;
386
  struct type *type;
387
  int nargs;
388
  struct value **argvec;
389
  int upper, lower, retcode;
390
  int code;
391
  int ix;
392
  long mem_offset;
393
  struct type **arg_types;
394
  int save_pos1;
395
 
396
  pc = (*pos)++;
397
  op = exp->elts[pc].opcode;
398
 
399
  switch (op)
400
    {
401
    case OP_SCOPE:
402
      tem = longest_to_int (exp->elts[pc + 2].longconst);
403
      (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
404
      arg1 = value_struct_elt_for_reference (exp->elts[pc + 1].type,
405
                                             0,
406
                                             exp->elts[pc + 1].type,
407
                                             &exp->elts[pc + 3].string,
408
                                             NULL_TYPE);
409
      if (arg1 == NULL)
410
        error ("There is no field named %s", &exp->elts[pc + 3].string);
411
      return arg1;
412
 
413
    case OP_LONG:
414
      (*pos) += 3;
415
      return value_from_longest (exp->elts[pc + 1].type,
416
                                 exp->elts[pc + 2].longconst);
417
 
418
    case OP_DOUBLE:
419
      (*pos) += 3;
420
      return value_from_double (exp->elts[pc + 1].type,
421
                                exp->elts[pc + 2].doubleconst);
422
 
423
    case OP_VAR_VALUE:
424
      (*pos) += 3;
425
      if (noside == EVAL_SKIP)
426
        goto nosideret;
427
 
428
      /* JYG: We used to just return value_zero of the symbol type
429
         if we're asked to avoid side effects.  Otherwise we return
430
         value_of_variable (...).  However I'm not sure if
431
         value_of_variable () has any side effect.
432
         We need a full value object returned here for whatis_exp ()
433
         to call evaluate_type () and then pass the full value to
434
         value_rtti_target_type () if we are dealing with a pointer
435
         or reference to a base class and print object is on. */
436
 
437
        return value_of_variable (exp->elts[pc + 2].symbol,
438
                                  exp->elts[pc + 1].block);
439
 
440
    case OP_LAST:
441
      (*pos) += 2;
442
      return
443
        access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
444
 
445
    case OP_REGISTER:
446
      {
447
        int regno = longest_to_int (exp->elts[pc + 1].longconst);
448
        struct value *val = value_of_register (regno, selected_frame);
449
        (*pos) += 2;
450
        if (val == NULL)
451
          error ("Value of register %s not available.",
452
                 frame_map_regnum_to_name (regno));
453
        else
454
          return val;
455
      }
456
    case OP_BOOL:
457
      (*pos) += 2;
458
      return value_from_longest (LA_BOOL_TYPE,
459
                                 exp->elts[pc + 1].longconst);
460
 
461
    case OP_INTERNALVAR:
462
      (*pos) += 2;
463
      return value_of_internalvar (exp->elts[pc + 1].internalvar);
464
 
465
    case OP_STRING:
466
      tem = longest_to_int (exp->elts[pc + 1].longconst);
467
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
468
      if (noside == EVAL_SKIP)
469
        goto nosideret;
470
      return value_string (&exp->elts[pc + 2].string, tem);
471
 
472
    case OP_BITSTRING:
473
      tem = longest_to_int (exp->elts[pc + 1].longconst);
474
      (*pos)
475
        += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
476
      if (noside == EVAL_SKIP)
477
        goto nosideret;
478
      return value_bitstring (&exp->elts[pc + 2].string, tem);
479
      break;
480
 
481
    case OP_ARRAY:
482
      (*pos) += 3;
483
      tem2 = longest_to_int (exp->elts[pc + 1].longconst);
484
      tem3 = longest_to_int (exp->elts[pc + 2].longconst);
485
      nargs = tem3 - tem2 + 1;
486
      type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
487
 
488
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
489
          && TYPE_CODE (type) == TYPE_CODE_STRUCT)
490
        {
491
          struct value *rec = allocate_value (expect_type);
492
          memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
493
          return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
494
        }
495
 
496
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
497
          && TYPE_CODE (type) == TYPE_CODE_ARRAY)
498
        {
499
          struct type *range_type = TYPE_FIELD_TYPE (type, 0);
500
          struct type *element_type = TYPE_TARGET_TYPE (type);
501
          struct value *array = allocate_value (expect_type);
502
          int element_size = TYPE_LENGTH (check_typedef (element_type));
503
          LONGEST low_bound, high_bound, index;
504
          if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
505
            {
506
              low_bound = 0;
507
              high_bound = (TYPE_LENGTH (type) / element_size) - 1;
508
            }
509
          index = low_bound;
510
          memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
511
          for (tem = nargs; --nargs >= 0;)
512
            {
513
              struct value *element;
514
              int index_pc = 0;
515
              if (exp->elts[*pos].opcode == BINOP_RANGE)
516
                {
517
                  index_pc = ++(*pos);
518
                  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
519
                }
520
              element = evaluate_subexp (element_type, exp, pos, noside);
521
              if (VALUE_TYPE (element) != element_type)
522
                element = value_cast (element_type, element);
523
              if (index_pc)
524
                {
525
                  int continue_pc = *pos;
526
                  *pos = index_pc;
527
                  index = init_array_element (array, element, exp, pos, noside,
528
                                              low_bound, high_bound);
529
                  *pos = continue_pc;
530
                }
531
              else
532
                {
533
                  if (index > high_bound)
534
                    /* to avoid memory corruption */
535
                    error ("Too many array elements");
536
                  memcpy (VALUE_CONTENTS_RAW (array)
537
                          + (index - low_bound) * element_size,
538
                          VALUE_CONTENTS (element),
539
                          element_size);
540
                }
541
              index++;
542
            }
543
          return array;
544
        }
545
 
546
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
547
          && TYPE_CODE (type) == TYPE_CODE_SET)
548
        {
549
          struct value *set = allocate_value (expect_type);
550
          char *valaddr = VALUE_CONTENTS_RAW (set);
551
          struct type *element_type = TYPE_INDEX_TYPE (type);
552
          struct type *check_type = element_type;
553
          LONGEST low_bound, high_bound;
554
 
555
          /* get targettype of elementtype */
556
          while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
557
                 TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
558
            check_type = TYPE_TARGET_TYPE (check_type);
559
 
560
          if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
561
            error ("(power)set type with unknown size");
562
          memset (valaddr, '\0', TYPE_LENGTH (type));
563
          for (tem = 0; tem < nargs; tem++)
564
            {
565
              LONGEST range_low, range_high;
566
              struct type *range_low_type, *range_high_type;
567
              struct value *elem_val;
568
              if (exp->elts[*pos].opcode == BINOP_RANGE)
569
                {
570
                  (*pos)++;
571
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
572
                  range_low_type = VALUE_TYPE (elem_val);
573
                  range_low = value_as_long (elem_val);
574
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
575
                  range_high_type = VALUE_TYPE (elem_val);
576
                  range_high = value_as_long (elem_val);
577
                }
578
              else
579
                {
580
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
581
                  range_low_type = range_high_type = VALUE_TYPE (elem_val);
582
                  range_low = range_high = value_as_long (elem_val);
583
                }
584
              /* check types of elements to avoid mixture of elements from
585
                 different types. Also check if type of element is "compatible"
586
                 with element type of powerset */
587
              if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
588
                range_low_type = TYPE_TARGET_TYPE (range_low_type);
589
              if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
590
                range_high_type = TYPE_TARGET_TYPE (range_high_type);
591
              if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
592
                  (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
593
                   (range_low_type != range_high_type)))
594
                /* different element modes */
595
                error ("POWERSET tuple elements of different mode");
596
              if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
597
                  (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
598
                   range_low_type != check_type))
599
                error ("incompatible POWERSET tuple elements");
600
              if (range_low > range_high)
601
                {
602
                  warning ("empty POWERSET tuple range");
603
                  continue;
604
                }
605
              if (range_low < low_bound || range_high > high_bound)
606
                error ("POWERSET tuple element out of range");
607
              range_low -= low_bound;
608
              range_high -= low_bound;
609
              for (; range_low <= range_high; range_low++)
610
                {
611
                  int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
612
                  if (BITS_BIG_ENDIAN)
613
                    bit_index = TARGET_CHAR_BIT - 1 - bit_index;
614
                  valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
615
                    |= 1 << bit_index;
616
                }
617
            }
618
          return set;
619
        }
620
 
621
      argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
622
      for (tem = 0; tem < nargs; tem++)
623
        {
624
          /* Ensure that array expressions are coerced into pointer objects. */
625
          argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
626
        }
627
      if (noside == EVAL_SKIP)
628
        goto nosideret;
629
      return value_array (tem2, tem3, argvec);
630
 
631
    case TERNOP_SLICE:
632
      {
633
        struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
634
        int lowbound
635
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
636
        int upper
637
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
638
        if (noside == EVAL_SKIP)
639
          goto nosideret;
640
        return value_slice (array, lowbound, upper - lowbound + 1);
641
      }
642
 
643
    case TERNOP_SLICE_COUNT:
644
      {
645
        struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
646
        int lowbound
647
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
648
        int length
649
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
650
        return value_slice (array, lowbound, length);
651
      }
652
 
653
    case TERNOP_COND:
654
      /* Skip third and second args to evaluate the first one.  */
655
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
656
      if (value_logical_not (arg1))
657
        {
658
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
659
          return evaluate_subexp (NULL_TYPE, exp, pos, noside);
660
        }
661
      else
662
        {
663
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
664
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
665
          return arg2;
666
        }
667
 
668
    case OP_FUNCALL:
669
      (*pos) += 2;
670
      op = exp->elts[*pos].opcode;
671
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
672
      /* Allocate arg vector, including space for the function to be
673
         called in argvec[0] and a terminating NULL */
674
      argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
675
      if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
676
        {
677
          LONGEST fnptr;
678
 
679
          /* 1997-08-01 Currently we do not support function invocation
680
             via pointers-to-methods with HP aCC. Pointer does not point
681
             to the function, but possibly to some thunk. */
682
          if (hp_som_som_object_present)
683
            {
684
              error ("Not implemented: function invocation through pointer to method with HP aCC");
685
            }
686
 
687
          nargs++;
688
          /* First, evaluate the structure into arg2 */
689
          pc2 = (*pos)++;
690
 
691
          if (noside == EVAL_SKIP)
692
            goto nosideret;
693
 
694
          if (op == STRUCTOP_MEMBER)
695
            {
696
              arg2 = evaluate_subexp_for_address (exp, pos, noside);
697
            }
698
          else
699
            {
700
              arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
701
            }
702
 
703
          /* If the function is a virtual function, then the
704
             aggregate value (providing the structure) plays
705
             its part by providing the vtable.  Otherwise,
706
             it is just along for the ride: call the function
707
             directly.  */
708
 
709
          arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
710
 
711
          fnptr = value_as_long (arg1);
712
 
713
          if (METHOD_PTR_IS_VIRTUAL (fnptr))
714
            {
715
              int fnoffset = METHOD_PTR_TO_VOFFSET (fnptr);
716
              struct type *basetype;
717
              struct type *domain_type =
718
              TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
719
              int i, j;
720
              basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
721
              if (domain_type != basetype)
722
                arg2 = value_cast (lookup_pointer_type (domain_type), arg2);
723
              basetype = TYPE_VPTR_BASETYPE (domain_type);
724
              for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
725
                {
726
                  struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
727
                  /* If one is virtual, then all are virtual.  */
728
                  if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
729
                    for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
730
                      if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
731
                        {
732
                          struct value *temp = value_ind (arg2);
733
                          arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
734
                          arg2 = value_addr (temp);
735
                          goto got_it;
736
                        }
737
                }
738
              if (i < 0)
739
                error ("virtual function at index %d not found", fnoffset);
740
            }
741
          else
742
            {
743
              VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
744
            }
745
        got_it:
746
 
747
          /* Now, say which argument to start evaluating from */
748
          tem = 2;
749
        }
750
      else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
751
        {
752
          /* Hair for method invocations */
753
          int tem2;
754
 
755
          nargs++;
756
          /* First, evaluate the structure into arg2 */
757
          pc2 = (*pos)++;
758
          tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
759
          *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
760
          if (noside == EVAL_SKIP)
761
            goto nosideret;
762
 
763
          if (op == STRUCTOP_STRUCT)
764
            {
765
              /* If v is a variable in a register, and the user types
766
                 v.method (), this will produce an error, because v has
767
                 no address.
768
 
769
                 A possible way around this would be to allocate a
770
                 copy of the variable on the stack, copy in the
771
                 contents, call the function, and copy out the
772
                 contents.  I.e. convert this from call by reference
773
                 to call by copy-return (or whatever it's called).
774
                 However, this does not work because it is not the
775
                 same: the method being called could stash a copy of
776
                 the address, and then future uses through that address
777
                 (after the method returns) would be expected to
778
                 use the variable itself, not some copy of it.  */
779
              arg2 = evaluate_subexp_for_address (exp, pos, noside);
780
            }
781
          else
782
            {
783
              arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
784
            }
785
          /* Now, say which argument to start evaluating from */
786
          tem = 2;
787
        }
788
      else
789
        {
790
          /* Non-method function call */
791
          save_pos1 = *pos;
792
          argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
793
          tem = 1;
794
          type = VALUE_TYPE (argvec[0]);
795
          if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
796
            type = TYPE_TARGET_TYPE (type);
797
          if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
798
            {
799
              for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
800
                {
801
                  /* pai: FIXME This seems to be coercing arguments before
802
                   * overload resolution has been done! */
803
                  argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
804
                                                 exp, pos, noside);
805
                }
806
            }
807
        }
808
 
809
      /* Evaluate arguments */
810
      for (; tem <= nargs; tem++)
811
        {
812
          /* Ensure that array expressions are coerced into pointer objects. */
813
          argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
814
        }
815
 
816
      /* signal end of arglist */
817
      argvec[tem] = 0;
818
 
819
      if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
820
        {
821
          int static_memfuncp;
822
          char tstr[256];
823
 
824
          /* Method invocation : stuff "this" as first parameter */
825
          argvec[1] = arg2;
826
          /* Name of method from expression */
827
          strcpy (tstr, &exp->elts[pc2 + 2].string);
828
 
829
          if (overload_resolution && (exp->language_defn->la_language == language_cplus))
830
            {
831
              /* Language is C++, do some overload resolution before evaluation */
832
              struct value *valp = NULL;
833
 
834
              /* Prepare list of argument types for overload resolution */
835
              arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
836
              for (ix = 1; ix <= nargs; ix++)
837
                arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
838
 
839
              (void) find_overload_match (arg_types, nargs, tstr,
840
                                     1 /* method */ , 0 /* strict match */ ,
841
                                          &arg2 /* the object */ , NULL,
842
                                          &valp, NULL, &static_memfuncp);
843
 
844
 
845
              argvec[1] = arg2; /* the ``this'' pointer */
846
              argvec[0] = valp;  /* use the method found after overload resolution */
847
            }
848
          else
849
            /* Non-C++ case -- or no overload resolution */
850
            {
851
              struct value *temp = arg2;
852
              argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
853
                                            &static_memfuncp,
854
                                            op == STRUCTOP_STRUCT
855
                                       ? "structure" : "structure pointer");
856
              /* value_struct_elt updates temp with the correct value
857
                 of the ``this'' pointer if necessary, so modify argvec[1] to
858
                 reflect any ``this'' changes.  */
859
              arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
860
                             VALUE_ADDRESS (temp) + VALUE_OFFSET (temp)
861
                             + VALUE_EMBEDDED_OFFSET (temp));
862
              argvec[1] = arg2; /* the ``this'' pointer */
863
            }
864
 
865
          if (static_memfuncp)
866
            {
867
              argvec[1] = argvec[0];
868
              nargs--;
869
              argvec++;
870
            }
871
        }
872
      else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
873
        {
874
          argvec[1] = arg2;
875
          argvec[0] = arg1;
876
        }
877
      else if (op == OP_VAR_VALUE)
878
        {
879
          /* Non-member function being called */
880
          /* fn: This can only be done for C++ functions.  A C-style function
881
             in a C++ program, for instance, does not have the fields that
882
             are expected here */
883
 
884
          if (overload_resolution && (exp->language_defn->la_language == language_cplus))
885
            {
886
              /* Language is C++, do some overload resolution before evaluation */
887
              struct symbol *symp;
888
 
889
              /* Prepare list of argument types for overload resolution */
890
              arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
891
              for (ix = 1; ix <= nargs; ix++)
892
                arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
893
 
894
              (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
895
 
896
                      NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
897
                                          NULL, &symp, NULL);
898
 
899
              /* Now fix the expression being evaluated */
900
              exp->elts[save_pos1+2].symbol = symp;
901
              argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
902
            }
903
          else
904
            {
905
              /* Not C++, or no overload resolution allowed */
906
              /* nothing to be done; argvec already correctly set up */
907
            }
908
        }
909
      else
910
        {
911
          /* It is probably a C-style function */
912
          /* nothing to be done; argvec already correctly set up */
913
        }
914
 
915
    do_call_it:
916
 
917
      if (noside == EVAL_SKIP)
918
        goto nosideret;
919
      if (argvec[0] == NULL)
920
        error ("Cannot evaluate function -- may be inlined");
921
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
922
        {
923
          /* If the return type doesn't look like a function type, call an
924
             error.  This can happen if somebody tries to turn a variable into
925
             a function call. This is here because people often want to
926
             call, eg, strcmp, which gdb doesn't know is a function.  If
927
             gdb isn't asked for it's opinion (ie. through "whatis"),
928
             it won't offer it. */
929
 
930
          struct type *ftype =
931
          TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
932
 
933
          if (ftype)
934
            return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
935
          else
936
            error ("Expression of type other than \"Function returning ...\" used as function");
937
        }
938
      return call_function_by_hand (argvec[0], nargs, argvec + 1);
939
      /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
940
 
941
    case OP_F77_UNDETERMINED_ARGLIST:
942
 
943
      /* Remember that in F77, functions, substring ops and
944
         array subscript operations cannot be disambiguated
945
         at parse time.  We have made all array subscript operations,
946
         substring operations as well as function calls  come here
947
         and we now have to discover what the heck this thing actually was.
948
         If it is a function, we process just as if we got an OP_FUNCALL. */
949
 
950
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
951
      (*pos) += 2;
952
 
953
      /* First determine the type code we are dealing with.  */
954
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
955
      type = check_typedef (VALUE_TYPE (arg1));
956
      code = TYPE_CODE (type);
957
 
958
      switch (code)
959
        {
960
        case TYPE_CODE_ARRAY:
961
          goto multi_f77_subscript;
962
 
963
        case TYPE_CODE_STRING:
964
          goto op_f77_substr;
965
 
966
        case TYPE_CODE_PTR:
967
        case TYPE_CODE_FUNC:
968
          /* It's a function call. */
969
          /* Allocate arg vector, including space for the function to be
970
             called in argvec[0] and a terminating NULL */
971
          argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
972
          argvec[0] = arg1;
973
          tem = 1;
974
          for (; tem <= nargs; tem++)
975
            argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
976
          argvec[tem] = 0;       /* signal end of arglist */
977
          goto do_call_it;
978
 
979
        default:
980
          error ("Cannot perform substring on this type");
981
        }
982
 
983
    op_f77_substr:
984
      /* We have a substring operation on our hands here,
985
         let us get the string we will be dealing with */
986
 
987
      /* Now evaluate the 'from' and 'to' */
988
 
989
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
990
 
991
      if (nargs < 2)
992
        return value_subscript (arg1, arg2);
993
 
994
      arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
995
 
996
      if (noside == EVAL_SKIP)
997
        goto nosideret;
998
 
999
      tem2 = value_as_long (arg2);
1000
      tem3 = value_as_long (arg3);
1001
 
1002
      return value_slice (arg1, tem2, tem3 - tem2 + 1);
1003
 
1004
    case OP_COMPLEX:
1005
      /* We have a complex number, There should be 2 floating
1006
         point numbers that compose it */
1007
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1008
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1009
 
1010
      return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
1011
 
1012
    case STRUCTOP_STRUCT:
1013
      tem = longest_to_int (exp->elts[pc + 1].longconst);
1014
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1015
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1016
      if (noside == EVAL_SKIP)
1017
        goto nosideret;
1018
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1019
        return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
1020
                                                   &exp->elts[pc + 2].string,
1021
                                                   0),
1022
                           lval_memory);
1023
      else
1024
        {
1025
          struct value *temp = arg1;
1026
          return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1027
                                   NULL, "structure");
1028
        }
1029
 
1030
    case STRUCTOP_PTR:
1031
      tem = longest_to_int (exp->elts[pc + 1].longconst);
1032
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1033
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1034
      if (noside == EVAL_SKIP)
1035
        goto nosideret;
1036
 
1037
      /* JYG: if print object is on we need to replace the base type
1038
         with rtti type in order to continue on with successful
1039
         lookup of member / method only available in the rtti type. */
1040
      {
1041
        struct type *type = VALUE_TYPE (arg1);
1042
        struct type *real_type;
1043
        int full, top, using_enc;
1044
 
1045
        if (objectprint && TYPE_TARGET_TYPE(type) &&
1046
            (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1047
          {
1048
            real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1049
            if (real_type)
1050
              {
1051
                if (TYPE_CODE (type) == TYPE_CODE_PTR)
1052
                  real_type = lookup_pointer_type (real_type);
1053
                else
1054
                  real_type = lookup_reference_type (real_type);
1055
 
1056
                arg1 = value_cast (real_type, arg1);
1057
              }
1058
          }
1059
      }
1060
 
1061
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1062
        return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
1063
                                                   &exp->elts[pc + 2].string,
1064
                                                   0),
1065
                           lval_memory);
1066
      else
1067
        {
1068
          struct value *temp = arg1;
1069
          return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1070
                                   NULL, "structure pointer");
1071
        }
1072
 
1073
    case STRUCTOP_MEMBER:
1074
      arg1 = evaluate_subexp_for_address (exp, pos, noside);
1075
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1076
 
1077
      /* With HP aCC, pointers to methods do not point to the function code */
1078
      if (hp_som_som_object_present &&
1079
          (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
1080
      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
1081
        error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
1082
 
1083
      mem_offset = value_as_long (arg2);
1084
      goto handle_pointer_to_member;
1085
 
1086
    case STRUCTOP_MPTR:
1087
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1088
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1089
 
1090
      /* With HP aCC, pointers to methods do not point to the function code */
1091
      if (hp_som_som_object_present &&
1092
          (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
1093
      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
1094
        error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
1095
 
1096
      mem_offset = value_as_long (arg2);
1097
 
1098
    handle_pointer_to_member:
1099
      /* HP aCC generates offsets that have bit #29 set; turn it off to get
1100
         a real offset to the member. */
1101
      if (hp_som_som_object_present)
1102
        {
1103
          if (!mem_offset)      /* no bias -> really null */
1104
            error ("Attempted dereference of null pointer-to-member");
1105
          mem_offset &= ~0x20000000;
1106
        }
1107
      if (noside == EVAL_SKIP)
1108
        goto nosideret;
1109
      type = check_typedef (VALUE_TYPE (arg2));
1110
      if (TYPE_CODE (type) != TYPE_CODE_PTR)
1111
        goto bad_pointer_to_member;
1112
      type = check_typedef (TYPE_TARGET_TYPE (type));
1113
      if (TYPE_CODE (type) == TYPE_CODE_METHOD)
1114
        error ("not implemented: pointer-to-method in pointer-to-member construct");
1115
      if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
1116
        goto bad_pointer_to_member;
1117
      /* Now, convert these values to an address.  */
1118
      arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1119
                         arg1);
1120
      arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1121
                                 value_as_long (arg1) + mem_offset);
1122
      return value_ind (arg3);
1123
    bad_pointer_to_member:
1124
      error ("non-pointer-to-member value used in pointer-to-member construct");
1125
 
1126
    case BINOP_CONCAT:
1127
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1128
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1129
      if (noside == EVAL_SKIP)
1130
        goto nosideret;
1131
      if (binop_user_defined_p (op, arg1, arg2))
1132
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1133
      else
1134
        return value_concat (arg1, arg2);
1135
 
1136
    case BINOP_ASSIGN:
1137
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1138
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1139
 
1140
      /* Do special stuff for HP aCC pointers to members */
1141
      if (hp_som_som_object_present)
1142
        {
1143
          /* 1997-08-19 Can't assign HP aCC pointers to methods. No details of
1144
             the implementation yet; but the pointer appears to point to a code
1145
             sequence (thunk) in memory -- in any case it is *not* the address
1146
             of the function as it would be in a naive implementation. */
1147
          if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
1148
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD))
1149
            error ("Assignment to pointers to methods not implemented with HP aCC");
1150
 
1151
          /* HP aCC pointers to data members require a constant bias */
1152
          if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
1153
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER))
1154
            {
1155
              unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (arg2);       /* forces evaluation */
1156
              *ptr |= 0x20000000;       /* set 29th bit */
1157
            }
1158
        }
1159
 
1160
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1161
        return arg1;
1162
      if (binop_user_defined_p (op, arg1, arg2))
1163
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1164
      else
1165
        return value_assign (arg1, arg2);
1166
 
1167
    case BINOP_ASSIGN_MODIFY:
1168
      (*pos) += 2;
1169
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1170
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1171
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1172
        return arg1;
1173
      op = exp->elts[pc + 1].opcode;
1174
      if (binop_user_defined_p (op, arg1, arg2))
1175
        return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1176
      else if (op == BINOP_ADD)
1177
        arg2 = value_add (arg1, arg2);
1178
      else if (op == BINOP_SUB)
1179
        arg2 = value_sub (arg1, arg2);
1180
      else
1181
        arg2 = value_binop (arg1, arg2, op);
1182
      return value_assign (arg1, arg2);
1183
 
1184
    case BINOP_ADD:
1185
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1186
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1187
      if (noside == EVAL_SKIP)
1188
        goto nosideret;
1189
      if (binop_user_defined_p (op, arg1, arg2))
1190
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1191
      else
1192
        return value_add (arg1, arg2);
1193
 
1194
    case BINOP_SUB:
1195
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1196
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1197
      if (noside == EVAL_SKIP)
1198
        goto nosideret;
1199
      if (binop_user_defined_p (op, arg1, arg2))
1200
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1201
      else
1202
        return value_sub (arg1, arg2);
1203
 
1204
    case BINOP_MUL:
1205
    case BINOP_DIV:
1206
    case BINOP_REM:
1207
    case BINOP_MOD:
1208
    case BINOP_LSH:
1209
    case BINOP_RSH:
1210
    case BINOP_BITWISE_AND:
1211
    case BINOP_BITWISE_IOR:
1212
    case BINOP_BITWISE_XOR:
1213
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1214
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1215
      if (noside == EVAL_SKIP)
1216
        goto nosideret;
1217
      if (binop_user_defined_p (op, arg1, arg2))
1218
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1219
      else if (noside == EVAL_AVOID_SIDE_EFFECTS
1220
               && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
1221
        return value_zero (VALUE_TYPE (arg1), not_lval);
1222
      else
1223
        return value_binop (arg1, arg2, op);
1224
 
1225
    case BINOP_RANGE:
1226
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1227
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1228
      if (noside == EVAL_SKIP)
1229
        goto nosideret;
1230
      error ("':' operator used in invalid context");
1231
 
1232
    case BINOP_SUBSCRIPT:
1233
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1234
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1235
      if (noside == EVAL_SKIP)
1236
        goto nosideret;
1237
      if (binop_user_defined_p (op, arg1, arg2))
1238
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1239
      else
1240
        {
1241
          /* If the user attempts to subscript something that is not an
1242
             array or pointer type (like a plain int variable for example),
1243
             then report this as an error. */
1244
 
1245
          COERCE_REF (arg1);
1246
          type = check_typedef (VALUE_TYPE (arg1));
1247
          if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1248
              && TYPE_CODE (type) != TYPE_CODE_PTR)
1249
            {
1250
              if (TYPE_NAME (type))
1251
                error ("cannot subscript something of type `%s'",
1252
                       TYPE_NAME (type));
1253
              else
1254
                error ("cannot subscript requested type");
1255
            }
1256
 
1257
          if (noside == EVAL_AVOID_SIDE_EFFECTS)
1258
            return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1259
          else
1260
            return value_subscript (arg1, arg2);
1261
        }
1262
 
1263
    case BINOP_IN:
1264
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1265
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1266
      if (noside == EVAL_SKIP)
1267
        goto nosideret;
1268
      return value_in (arg1, arg2);
1269
 
1270
    case MULTI_SUBSCRIPT:
1271
      (*pos) += 2;
1272
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
1273
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1274
      while (nargs-- > 0)
1275
        {
1276
          arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1277
          /* FIXME:  EVAL_SKIP handling may not be correct. */
1278
          if (noside == EVAL_SKIP)
1279
            {
1280
              if (nargs > 0)
1281
                {
1282
                  continue;
1283
                }
1284
              else
1285
                {
1286
                  goto nosideret;
1287
                }
1288
            }
1289
          /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1290
          if (noside == EVAL_AVOID_SIDE_EFFECTS)
1291
            {
1292
              /* If the user attempts to subscript something that has no target
1293
                 type (like a plain int variable for example), then report this
1294
                 as an error. */
1295
 
1296
              type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
1297
              if (type != NULL)
1298
                {
1299
                  arg1 = value_zero (type, VALUE_LVAL (arg1));
1300
                  noside = EVAL_SKIP;
1301
                  continue;
1302
                }
1303
              else
1304
                {
1305
                  error ("cannot subscript something of type `%s'",
1306
                         TYPE_NAME (VALUE_TYPE (arg1)));
1307
                }
1308
            }
1309
 
1310
          if (binop_user_defined_p (op, arg1, arg2))
1311
            {
1312
              arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1313
            }
1314
          else
1315
            {
1316
              arg1 = value_subscript (arg1, arg2);
1317
            }
1318
        }
1319
      return (arg1);
1320
 
1321
    multi_f77_subscript:
1322
      {
1323
        int subscript_array[MAX_FORTRAN_DIMS + 1];      /* 1-based array of
1324
                                                           subscripts, max == 7 */
1325
        int array_size_array[MAX_FORTRAN_DIMS + 1];
1326
        int ndimensions = 1, i;
1327
        struct type *tmp_type;
1328
        int offset_item;        /* The array offset where the item lives */
1329
 
1330
        if (nargs > MAX_FORTRAN_DIMS)
1331
          error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
1332
 
1333
        tmp_type = check_typedef (VALUE_TYPE (arg1));
1334
        ndimensions = calc_f77_array_dims (type);
1335
 
1336
        if (nargs != ndimensions)
1337
          error ("Wrong number of subscripts");
1338
 
1339
        /* Now that we know we have a legal array subscript expression
1340
           let us actually find out where this element exists in the array. */
1341
 
1342
        offset_item = 0;
1343
        for (i = 1; i <= nargs; i++)
1344
          {
1345
            /* Evaluate each subscript, It must be a legal integer in F77 */
1346
            arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1347
 
1348
            /* Fill in the subscript and array size arrays */
1349
 
1350
            subscript_array[i] = value_as_long (arg2);
1351
 
1352
            retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1353
            if (retcode == BOUND_FETCH_ERROR)
1354
              error ("Cannot obtain dynamic upper bound");
1355
 
1356
            retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1357
            if (retcode == BOUND_FETCH_ERROR)
1358
              error ("Cannot obtain dynamic lower bound");
1359
 
1360
            array_size_array[i] = upper - lower + 1;
1361
 
1362
            /* Zero-normalize subscripts so that offsetting will work. */
1363
 
1364
            subscript_array[i] -= lower;
1365
 
1366
            /* If we are at the bottom of a multidimensional
1367
               array type then keep a ptr to the last ARRAY
1368
               type around for use when calling value_subscript()
1369
               below. This is done because we pretend to value_subscript
1370
               that we actually have a one-dimensional array
1371
               of base element type that we apply a simple
1372
               offset to. */
1373
 
1374
            if (i < nargs)
1375
              tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1376
          }
1377
 
1378
        /* Now let us calculate the offset for this item */
1379
 
1380
        offset_item = subscript_array[ndimensions];
1381
 
1382
        for (i = ndimensions - 1; i >= 1; i--)
1383
          offset_item =
1384
            array_size_array[i] * offset_item + subscript_array[i];
1385
 
1386
        /* Construct a value node with the value of the offset */
1387
 
1388
        arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1389
 
1390
        /* Let us now play a dirty trick: we will take arg1
1391
           which is a value node pointing to the topmost level
1392
           of the multidimensional array-set and pretend
1393
           that it is actually a array of the final element
1394
           type, this will ensure that value_subscript()
1395
           returns the correct type value */
1396
 
1397
        VALUE_TYPE (arg1) = tmp_type;
1398
        return value_ind (value_add (value_coerce_array (arg1), arg2));
1399
      }
1400
 
1401
    case BINOP_LOGICAL_AND:
1402
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1403
      if (noside == EVAL_SKIP)
1404
        {
1405
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1406
          goto nosideret;
1407
        }
1408
 
1409
      oldpos = *pos;
1410
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1411
      *pos = oldpos;
1412
 
1413
      if (binop_user_defined_p (op, arg1, arg2))
1414
        {
1415
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1416
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1417
        }
1418
      else
1419
        {
1420
          tem = value_logical_not (arg1);
1421
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1422
                                  (tem ? EVAL_SKIP : noside));
1423
          return value_from_longest (LA_BOOL_TYPE,
1424
                             (LONGEST) (!tem && !value_logical_not (arg2)));
1425
        }
1426
 
1427
    case BINOP_LOGICAL_OR:
1428
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1429
      if (noside == EVAL_SKIP)
1430
        {
1431
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1432
          goto nosideret;
1433
        }
1434
 
1435
      oldpos = *pos;
1436
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1437
      *pos = oldpos;
1438
 
1439
      if (binop_user_defined_p (op, arg1, arg2))
1440
        {
1441
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1442
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1443
        }
1444
      else
1445
        {
1446
          tem = value_logical_not (arg1);
1447
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1448
                                  (!tem ? EVAL_SKIP : noside));
1449
          return value_from_longest (LA_BOOL_TYPE,
1450
                             (LONGEST) (!tem || !value_logical_not (arg2)));
1451
        }
1452
 
1453
    case BINOP_EQUAL:
1454
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1455
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1456
      if (noside == EVAL_SKIP)
1457
        goto nosideret;
1458
      if (binop_user_defined_p (op, arg1, arg2))
1459
        {
1460
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1461
        }
1462
      else
1463
        {
1464
          tem = value_equal (arg1, arg2);
1465
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1466
        }
1467
 
1468
    case BINOP_NOTEQUAL:
1469
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1470
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1471
      if (noside == EVAL_SKIP)
1472
        goto nosideret;
1473
      if (binop_user_defined_p (op, arg1, arg2))
1474
        {
1475
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1476
        }
1477
      else
1478
        {
1479
          tem = value_equal (arg1, arg2);
1480
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1481
        }
1482
 
1483
    case BINOP_LESS:
1484
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1485
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1486
      if (noside == EVAL_SKIP)
1487
        goto nosideret;
1488
      if (binop_user_defined_p (op, arg1, arg2))
1489
        {
1490
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1491
        }
1492
      else
1493
        {
1494
          tem = value_less (arg1, arg2);
1495
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1496
        }
1497
 
1498
    case BINOP_GTR:
1499
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1500
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1501
      if (noside == EVAL_SKIP)
1502
        goto nosideret;
1503
      if (binop_user_defined_p (op, arg1, arg2))
1504
        {
1505
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1506
        }
1507
      else
1508
        {
1509
          tem = value_less (arg2, arg1);
1510
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1511
        }
1512
 
1513
    case BINOP_GEQ:
1514
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1515
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1516
      if (noside == EVAL_SKIP)
1517
        goto nosideret;
1518
      if (binop_user_defined_p (op, arg1, arg2))
1519
        {
1520
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1521
        }
1522
      else
1523
        {
1524
          tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1525
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1526
        }
1527
 
1528
    case BINOP_LEQ:
1529
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1530
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1531
      if (noside == EVAL_SKIP)
1532
        goto nosideret;
1533
      if (binop_user_defined_p (op, arg1, arg2))
1534
        {
1535
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1536
        }
1537
      else
1538
        {
1539
          tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1540
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1541
        }
1542
 
1543
    case BINOP_REPEAT:
1544
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1545
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1546
      if (noside == EVAL_SKIP)
1547
        goto nosideret;
1548
      type = check_typedef (VALUE_TYPE (arg2));
1549
      if (TYPE_CODE (type) != TYPE_CODE_INT)
1550
        error ("Non-integral right operand for \"@\" operator.");
1551
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1552
        {
1553
          return allocate_repeat_value (VALUE_TYPE (arg1),
1554
                                     longest_to_int (value_as_long (arg2)));
1555
        }
1556
      else
1557
        return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1558
 
1559
    case BINOP_COMMA:
1560
      evaluate_subexp (NULL_TYPE, exp, pos, noside);
1561
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1562
 
1563
    case UNOP_NEG:
1564
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1565
      if (noside == EVAL_SKIP)
1566
        goto nosideret;
1567
      if (unop_user_defined_p (op, arg1))
1568
        return value_x_unop (arg1, op, noside);
1569
      else
1570
        return value_neg (arg1);
1571
 
1572
    case UNOP_COMPLEMENT:
1573
      /* C++: check for and handle destructor names.  */
1574
      op = exp->elts[*pos].opcode;
1575
 
1576
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1577
      if (noside == EVAL_SKIP)
1578
        goto nosideret;
1579
      if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1580
        return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1581
      else
1582
        return value_complement (arg1);
1583
 
1584
    case UNOP_LOGICAL_NOT:
1585
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1586
      if (noside == EVAL_SKIP)
1587
        goto nosideret;
1588
      if (unop_user_defined_p (op, arg1))
1589
        return value_x_unop (arg1, op, noside);
1590
      else
1591
        return value_from_longest (LA_BOOL_TYPE,
1592
                                   (LONGEST) value_logical_not (arg1));
1593
 
1594
    case UNOP_IND:
1595
      if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1596
        expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1597
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1598
      if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
1599
          ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
1600
           (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
1601
        error ("Attempt to dereference pointer to member without an object");
1602
      if (noside == EVAL_SKIP)
1603
        goto nosideret;
1604
      if (unop_user_defined_p (op, arg1))
1605
        return value_x_unop (arg1, op, noside);
1606
      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1607
        {
1608
          type = check_typedef (VALUE_TYPE (arg1));
1609
          if (TYPE_CODE (type) == TYPE_CODE_PTR
1610
              || TYPE_CODE (type) == TYPE_CODE_REF
1611
          /* In C you can dereference an array to get the 1st elt.  */
1612
              || TYPE_CODE (type) == TYPE_CODE_ARRAY
1613
            )
1614
            return value_zero (TYPE_TARGET_TYPE (type),
1615
                               lval_memory);
1616
          else if (TYPE_CODE (type) == TYPE_CODE_INT)
1617
            /* GDB allows dereferencing an int.  */
1618
            return value_zero (builtin_type_int, lval_memory);
1619
          else
1620
            error ("Attempt to take contents of a non-pointer value.");
1621
        }
1622
      return value_ind (arg1);
1623
 
1624
    case UNOP_ADDR:
1625
      /* C++: check for and handle pointer to members.  */
1626
 
1627
      op = exp->elts[*pos].opcode;
1628
 
1629
      if (noside == EVAL_SKIP)
1630
        {
1631
          if (op == OP_SCOPE)
1632
            {
1633
              int temm = longest_to_int (exp->elts[pc + 3].longconst);
1634
              (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1635
            }
1636
          else
1637
            evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1638
          goto nosideret;
1639
        }
1640
      else
1641
        {
1642
          struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
1643
          /* If HP aCC object, use bias for pointers to members */
1644
          if (hp_som_som_object_present &&
1645
              (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
1646
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
1647
            {
1648
              unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp);    /* forces evaluation */
1649
              *ptr |= 0x20000000;       /* set 29th bit */
1650
            }
1651
          return retvalp;
1652
        }
1653
 
1654
    case UNOP_SIZEOF:
1655
      if (noside == EVAL_SKIP)
1656
        {
1657
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1658
          goto nosideret;
1659
        }
1660
      return evaluate_subexp_for_sizeof (exp, pos);
1661
 
1662
    case UNOP_CAST:
1663
      (*pos) += 2;
1664
      type = exp->elts[pc + 1].type;
1665
      arg1 = evaluate_subexp (type, exp, pos, noside);
1666
      if (noside == EVAL_SKIP)
1667
        goto nosideret;
1668
      if (type != VALUE_TYPE (arg1))
1669
        arg1 = value_cast (type, arg1);
1670
      return arg1;
1671
 
1672
    case UNOP_MEMVAL:
1673
      (*pos) += 2;
1674
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1675
      if (noside == EVAL_SKIP)
1676
        goto nosideret;
1677
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1678
        return value_zero (exp->elts[pc + 1].type, lval_memory);
1679
      else
1680
        return value_at_lazy (exp->elts[pc + 1].type,
1681
                              value_as_address (arg1),
1682
                              NULL);
1683
 
1684
    case UNOP_PREINCREMENT:
1685
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1686
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1687
        return arg1;
1688
      else if (unop_user_defined_p (op, arg1))
1689
        {
1690
          return value_x_unop (arg1, op, noside);
1691
        }
1692
      else
1693
        {
1694
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1695
                                                      (LONGEST) 1));
1696
          return value_assign (arg1, arg2);
1697
        }
1698
 
1699
    case UNOP_PREDECREMENT:
1700
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1701
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1702
        return arg1;
1703
      else if (unop_user_defined_p (op, arg1))
1704
        {
1705
          return value_x_unop (arg1, op, noside);
1706
        }
1707
      else
1708
        {
1709
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1710
                                                      (LONGEST) 1));
1711
          return value_assign (arg1, arg2);
1712
        }
1713
 
1714
    case UNOP_POSTINCREMENT:
1715
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1716
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1717
        return arg1;
1718
      else if (unop_user_defined_p (op, arg1))
1719
        {
1720
          return value_x_unop (arg1, op, noside);
1721
        }
1722
      else
1723
        {
1724
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1725
                                                      (LONGEST) 1));
1726
          value_assign (arg1, arg2);
1727
          return arg1;
1728
        }
1729
 
1730
    case UNOP_POSTDECREMENT:
1731
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1732
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1733
        return arg1;
1734
      else if (unop_user_defined_p (op, arg1))
1735
        {
1736
          return value_x_unop (arg1, op, noside);
1737
        }
1738
      else
1739
        {
1740
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1741
                                                      (LONGEST) 1));
1742
          value_assign (arg1, arg2);
1743
          return arg1;
1744
        }
1745
 
1746
    case OP_THIS:
1747
      (*pos) += 1;
1748
      return value_of_this (1);
1749
 
1750
    case OP_TYPE:
1751
      error ("Attempt to use a type name as an expression");
1752
 
1753
    default:
1754
      /* Removing this case and compiling with gcc -Wall reveals that
1755
         a lot of cases are hitting this case.  Some of these should
1756
         probably be removed from expression.h; others are legitimate
1757
         expressions which are (apparently) not fully implemented.
1758
 
1759
         If there are any cases landing here which mean a user error,
1760
         then they should be separate cases, with more descriptive
1761
         error messages.  */
1762
 
1763
      error ("\
1764
GDB does not (yet) know how to evaluate that kind of expression");
1765
    }
1766
 
1767
nosideret:
1768
  return value_from_longest (builtin_type_long, (LONGEST) 1);
1769
}
1770
 
1771
/* Evaluate a subexpression of EXP, at index *POS,
1772
   and return the address of that subexpression.
1773
   Advance *POS over the subexpression.
1774
   If the subexpression isn't an lvalue, get an error.
1775
   NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
1776
   then only the type of the result need be correct.  */
1777
 
1778
static struct value *
1779
evaluate_subexp_for_address (register struct expression *exp, register int *pos,
1780
                             enum noside noside)
1781
{
1782
  enum exp_opcode op;
1783
  register int pc;
1784
  struct symbol *var;
1785
 
1786
  pc = (*pos);
1787
  op = exp->elts[pc].opcode;
1788
 
1789
  switch (op)
1790
    {
1791
    case UNOP_IND:
1792
      (*pos)++;
1793
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1794
 
1795
    case UNOP_MEMVAL:
1796
      (*pos) += 3;
1797
      return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
1798
                         evaluate_subexp (NULL_TYPE, exp, pos, noside));
1799
 
1800
    case OP_VAR_VALUE:
1801
      var = exp->elts[pc + 2].symbol;
1802
 
1803
      /* C++: The "address" of a reference should yield the address
1804
       * of the object pointed to. Let value_addr() deal with it. */
1805
      if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
1806
        goto default_case;
1807
 
1808
      (*pos) += 4;
1809
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1810
        {
1811
          struct type *type =
1812
          lookup_pointer_type (SYMBOL_TYPE (var));
1813
          enum address_class sym_class = SYMBOL_CLASS (var);
1814
 
1815
          if (sym_class == LOC_CONST
1816
              || sym_class == LOC_CONST_BYTES
1817
              || sym_class == LOC_REGISTER
1818
              || sym_class == LOC_REGPARM)
1819
            error ("Attempt to take address of register or constant.");
1820
 
1821
          return
1822
            value_zero (type, not_lval);
1823
        }
1824
      else
1825
        return
1826
          locate_var_value
1827
          (var,
1828
           block_innermost_frame (exp->elts[pc + 1].block));
1829
 
1830
    default:
1831
    default_case:
1832
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1833
        {
1834
          struct value *x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1835
          if (VALUE_LVAL (x) == lval_memory)
1836
            return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
1837
                               not_lval);
1838
          else
1839
            error ("Attempt to take address of non-lval");
1840
        }
1841
      return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1842
    }
1843
}
1844
 
1845
/* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
1846
   When used in contexts where arrays will be coerced anyway, this is
1847
   equivalent to `evaluate_subexp' but much faster because it avoids
1848
   actually fetching array contents (perhaps obsolete now that we have
1849
   VALUE_LAZY).
1850
 
1851
   Note that we currently only do the coercion for C expressions, where
1852
   arrays are zero based and the coercion is correct.  For other languages,
1853
   with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
1854
   to decide if coercion is appropriate.
1855
 
1856
 */
1857
 
1858
struct value *
1859
evaluate_subexp_with_coercion (register struct expression *exp,
1860
                               register int *pos, enum noside noside)
1861
{
1862
  register enum exp_opcode op;
1863
  register int pc;
1864
  struct value *val;
1865
  struct symbol *var;
1866
 
1867
  pc = (*pos);
1868
  op = exp->elts[pc].opcode;
1869
 
1870
  switch (op)
1871
    {
1872
    case OP_VAR_VALUE:
1873
      var = exp->elts[pc + 2].symbol;
1874
      if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
1875
          && CAST_IS_CONVERSION)
1876
        {
1877
          (*pos) += 4;
1878
          val =
1879
            locate_var_value
1880
            (var, block_innermost_frame (exp->elts[pc + 1].block));
1881
          return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
1882
                             val);
1883
        }
1884
      /* FALLTHROUGH */
1885
 
1886
    default:
1887
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1888
    }
1889
}
1890
 
1891
/* Evaluate a subexpression of EXP, at index *POS,
1892
   and return a value for the size of that subexpression.
1893
   Advance *POS over the subexpression.  */
1894
 
1895
static struct value *
1896
evaluate_subexp_for_sizeof (register struct expression *exp, register int *pos)
1897
{
1898
  enum exp_opcode op;
1899
  register int pc;
1900
  struct type *type;
1901
  struct value *val;
1902
 
1903
  pc = (*pos);
1904
  op = exp->elts[pc].opcode;
1905
 
1906
  switch (op)
1907
    {
1908
      /* This case is handled specially
1909
         so that we avoid creating a value for the result type.
1910
         If the result type is very big, it's desirable not to
1911
         create a value unnecessarily.  */
1912
    case UNOP_IND:
1913
      (*pos)++;
1914
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1915
      type = check_typedef (VALUE_TYPE (val));
1916
      if (TYPE_CODE (type) != TYPE_CODE_PTR
1917
          && TYPE_CODE (type) != TYPE_CODE_REF
1918
          && TYPE_CODE (type) != TYPE_CODE_ARRAY)
1919
        error ("Attempt to take contents of a non-pointer value.");
1920
      type = check_typedef (TYPE_TARGET_TYPE (type));
1921
      return value_from_longest (builtin_type_int, (LONGEST)
1922
                                 TYPE_LENGTH (type));
1923
 
1924
    case UNOP_MEMVAL:
1925
      (*pos) += 3;
1926
      type = check_typedef (exp->elts[pc + 1].type);
1927
      return value_from_longest (builtin_type_int,
1928
                                 (LONGEST) TYPE_LENGTH (type));
1929
 
1930
    case OP_VAR_VALUE:
1931
      (*pos) += 4;
1932
      type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
1933
      return
1934
        value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
1935
 
1936
    default:
1937
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1938
      return value_from_longest (builtin_type_int,
1939
                                 (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
1940
    }
1941
}
1942
 
1943
/* Parse a type expression in the string [P..P+LENGTH). */
1944
 
1945
struct type *
1946
parse_and_eval_type (char *p, int length)
1947
{
1948
  char *tmp = (char *) alloca (length + 4);
1949
  struct expression *expr;
1950
  tmp[0] = '(';
1951
  memcpy (tmp + 1, p, length);
1952
  tmp[length + 1] = ')';
1953
  tmp[length + 2] = '0';
1954
  tmp[length + 3] = '\0';
1955
  expr = parse_expression (tmp);
1956
  if (expr->elts[0].opcode != UNOP_CAST)
1957
    error ("Internal error in eval_type.");
1958
  return expr->elts[1].type;
1959
}
1960
 
1961
int
1962
calc_f77_array_dims (struct type *array_type)
1963
{
1964
  int ndimen = 1;
1965
  struct type *tmp_type;
1966
 
1967
  if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
1968
    error ("Can't get dimensions for a non-array type");
1969
 
1970
  tmp_type = array_type;
1971
 
1972
  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
1973
    {
1974
      if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
1975
        ++ndimen;
1976
    }
1977
  return ndimen;
1978
}

powered by: WebSVN 2.1.0

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