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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [eval.c] - Blame information for rev 578

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

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

powered by: WebSVN 2.1.0

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