Regenerate with hacked Cygnus autoconf 2.8 rather than FSF autoconf 2.8,
[deliverable/binutils-gdb.git] / gdb / valops.c
CommitLineData
bd5635a1 1/* Perform non-arithmetic operations on values, for GDB.
2b576293 2 Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994, 1995
67e9b3b3 3 Free Software Foundation, Inc.
bd5635a1
RP
4
5This file is part of GDB.
6
06b6c733 7This program is free software; you can redistribute it and/or modify
bd5635a1 8it under the terms of the GNU General Public License as published by
06b6c733
JG
9the Free Software Foundation; either version 2 of the License, or
10(at your option) any later version.
bd5635a1 11
06b6c733 12This program is distributed in the hope that it will be useful,
bd5635a1
RP
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
06b6c733 18along with this program; if not, write to the Free Software
b4680522 19Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
bd5635a1 20
bd5635a1 21#include "defs.h"
bd5635a1 22#include "symtab.h"
01be6913 23#include "gdbtypes.h"
bd5635a1
RP
24#include "value.h"
25#include "frame.h"
26#include "inferior.h"
27#include "gdbcore.h"
28#include "target.h"
2e4964ad 29#include "demangle.h"
54023465 30#include "language.h"
bd5635a1
RP
31
32#include <errno.h>
2b576293 33#include "gdb_string.h"
bd5635a1 34
75225aa2
FF
35/* Default to coercing float to double in function calls only when there is
36 no prototype. Otherwise on targets where the debug information is incorrect
37 for either the prototype or non-prototype case, we can force it by defining
38 COERCE_FLOAT_TO_DOUBLE in the target configuration file. */
39
40#ifndef COERCE_FLOAT_TO_DOUBLE
41#define COERCE_FLOAT_TO_DOUBLE (param_type == NULL)
42#endif
43
bd5635a1 44/* Local functions. */
01be6913 45
a91a6192 46static int typecmp PARAMS ((int staticp, struct type *t1[], value_ptr t2[]));
01be6913 47
a91a6192 48static CORE_ADDR find_function_addr PARAMS ((value_ptr, struct type **));
01be6913 49
a91a6192 50static CORE_ADDR value_push PARAMS ((CORE_ADDR, value_ptr));
01be6913 51
a91a6192
SS
52static value_ptr search_struct_field PARAMS ((char *, value_ptr, int,
53 struct type *, int));
01be6913 54
a91a6192
SS
55static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
56 value_ptr *,
57 int, int *, struct type *));
01be6913 58
a91a6192 59static int check_field_in PARAMS ((struct type *, const char *));
a163ddec 60
a91a6192 61static CORE_ADDR allocate_space_in_inferior PARAMS ((int));
9ed8604f 62
5222ca60 63static value_ptr cast_into_complex PARAMS ((struct type *, value_ptr));
9ed8604f
PS
64
65#define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
66
5e548861
PB
67/* Flag for whether we want to abandon failed expression evals by default. */
68
69static int auto_abandon = 0;
70
bd5635a1 71\f
09af5868 72/* Find the address of function name NAME in the inferior. */
a163ddec 73
09af5868
PS
74value_ptr
75find_function_in_inferior (name)
76 char *name;
a163ddec 77{
a163ddec 78 register struct symbol *sym;
09af5868 79 sym = lookup_symbol (name, 0, VAR_NAMESPACE, 0, NULL);
a163ddec
MT
80 if (sym != NULL)
81 {
82 if (SYMBOL_CLASS (sym) != LOC_BLOCK)
83 {
09af5868
PS
84 error ("\"%s\" exists in this program but is not a function.",
85 name);
a163ddec 86 }
09af5868 87 return value_of_variable (sym, NULL);
a163ddec
MT
88 }
89 else
90 {
09af5868 91 struct minimal_symbol *msymbol = lookup_minimal_symbol(name, NULL, NULL);
a163ddec
MT
92 if (msymbol != NULL)
93 {
09af5868
PS
94 struct type *type;
95 LONGEST maddr;
a163ddec
MT
96 type = lookup_pointer_type (builtin_type_char);
97 type = lookup_function_type (type);
98 type = lookup_pointer_type (type);
99 maddr = (LONGEST) SYMBOL_VALUE_ADDRESS (msymbol);
09af5868 100 return value_from_longest (type, maddr);
a163ddec
MT
101 }
102 else
103 {
09af5868 104 error ("evaluation of this expression requires the program to have a function \"%s\".", name);
a163ddec
MT
105 }
106 }
09af5868
PS
107}
108
109/* Allocate NBYTES of space in the inferior using the inferior's malloc
110 and return a value that is a pointer to the allocated space. */
111
112value_ptr
113value_allocate_space_in_inferior (len)
114 int len;
115{
116 value_ptr blocklen;
117 register value_ptr val = find_function_in_inferior ("malloc");
a163ddec
MT
118
119 blocklen = value_from_longest (builtin_type_int, (LONGEST) len);
120 val = call_function_by_hand (val, 1, &blocklen);
121 if (value_logical_not (val))
122 {
123 error ("No memory available to program.");
124 }
09af5868
PS
125 return val;
126}
127
128static CORE_ADDR
129allocate_space_in_inferior (len)
130 int len;
131{
132 return value_as_long (value_allocate_space_in_inferior (len));
a163ddec
MT
133}
134
bd5635a1
RP
135/* Cast value ARG2 to type TYPE and return as a value.
136 More general than a C cast: accepts any two types of the same length,
137 and if ARG2 is an lvalue it can be cast into anything at all. */
54023465 138/* In C++, casts may change pointer or object representations. */
bd5635a1 139
a91a6192 140value_ptr
bd5635a1
RP
141value_cast (type, arg2)
142 struct type *type;
a91a6192 143 register value_ptr arg2;
bd5635a1 144{
5e548861 145 register enum type_code code1;
bd5635a1
RP
146 register enum type_code code2;
147 register int scalar;
5e548861 148 struct type *type2;
bd5635a1 149
f91a9e05
PB
150 if (VALUE_TYPE (arg2) == type)
151 return arg2;
152
5e548861
PB
153 CHECK_TYPEDEF (type);
154 code1 = TYPE_CODE (type);
f7a69ed7 155 COERCE_REF(arg2);
5e548861 156 type2 = check_typedef (VALUE_TYPE (arg2));
13ffa6be
JL
157
158 /* A cast to an undetermined-length array_type, such as (TYPE [])OBJECT,
159 is treated like a cast to (TYPE [N])OBJECT,
160 where N is sizeof(OBJECT)/sizeof(TYPE). */
5e548861 161 if (code1 == TYPE_CODE_ARRAY)
13ffa6be
JL
162 {
163 struct type *element_type = TYPE_TARGET_TYPE (type);
5e548861
PB
164 unsigned element_length = TYPE_LENGTH (check_typedef (element_type));
165 if (element_length > 0
166 && TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
167 {
168 struct type *range_type = TYPE_INDEX_TYPE (type);
169 int val_length = TYPE_LENGTH (type2);
170 LONGEST low_bound, high_bound, new_length;
171 if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
172 low_bound = 0, high_bound = 0;
173 new_length = val_length / element_length;
174 if (val_length % element_length != 0)
175 warning("array element type size does not divide object size in cast");
176 /* FIXME-type-allocation: need a way to free this type when we are
177 done with it. */
178 range_type = create_range_type ((struct type *) NULL,
179 TYPE_TARGET_TYPE (range_type),
180 low_bound,
181 new_length + low_bound - 1);
182 VALUE_TYPE (arg2) = create_array_type ((struct type *) NULL,
183 element_type, range_type);
184 return arg2;
185 }
13ffa6be 186 }
9ed8604f 187
f7a69ed7 188 if (current_language->c_style_arrays
5e548861 189 && TYPE_CODE (type2) == TYPE_CODE_ARRAY)
e70bba9f 190 arg2 = value_coerce_array (arg2);
f7a69ed7 191
5e548861 192 if (TYPE_CODE (type2) == TYPE_CODE_FUNC)
f7a69ed7
PB
193 arg2 = value_coerce_function (arg2);
194
5e548861
PB
195 type2 = check_typedef (VALUE_TYPE (arg2));
196 COERCE_VARYING_ARRAY (arg2, type2);
197 code2 = TYPE_CODE (type2);
f7a69ed7 198
34cfa2da
PB
199 if (code1 == TYPE_CODE_COMPLEX)
200 return cast_into_complex (type, arg2);
201 if (code1 == TYPE_CODE_BOOL || code1 == TYPE_CODE_CHAR)
f7a69ed7 202 code1 = TYPE_CODE_INT;
34cfa2da 203 if (code2 == TYPE_CODE_BOOL || code2 == TYPE_CODE_CHAR)
f7a69ed7
PB
204 code2 = TYPE_CODE_INT;
205
bd5635a1 206 scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
f91a9e05 207 || code2 == TYPE_CODE_ENUM || code2 == TYPE_CODE_RANGE);
bd5635a1 208
54023465
JK
209 if ( code1 == TYPE_CODE_STRUCT
210 && code2 == TYPE_CODE_STRUCT
211 && TYPE_NAME (type) != 0)
212 {
213 /* Look in the type of the source to see if it contains the
214 type of the target as a superclass. If so, we'll need to
215 offset the object in addition to changing its type. */
a91a6192 216 value_ptr v = search_struct_field (type_name_no_tag (type),
5e548861 217 arg2, 0, type2, 1);
54023465
JK
218 if (v)
219 {
220 VALUE_TYPE (v) = type;
221 return v;
222 }
223 }
bd5635a1
RP
224 if (code1 == TYPE_CODE_FLT && scalar)
225 return value_from_double (type, value_as_double (arg2));
f91a9e05
PB
226 else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM
227 || code1 == TYPE_CODE_RANGE)
bd5635a1 228 && (scalar || code2 == TYPE_CODE_PTR))
06b6c733 229 return value_from_longest (type, value_as_long (arg2));
5e548861 230 else if (TYPE_LENGTH (type) == TYPE_LENGTH (type2))
bd5635a1
RP
231 {
232 if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
233 {
234 /* Look in the type of the source to see if it contains the
235 type of the target as a superclass. If so, we'll need to
236 offset the pointer rather than just change its type. */
5e548861
PB
237 struct type *t1 = check_typedef (TYPE_TARGET_TYPE (type));
238 struct type *t2 = check_typedef (TYPE_TARGET_TYPE (type2));
2a5ec41d 239 if ( TYPE_CODE (t1) == TYPE_CODE_STRUCT
bd5635a1
RP
240 && TYPE_CODE (t2) == TYPE_CODE_STRUCT
241 && TYPE_NAME (t1) != 0) /* if name unknown, can't have supercl */
242 {
a91a6192
SS
243 value_ptr v = search_struct_field (type_name_no_tag (t1),
244 value_ind (arg2), 0, t2, 1);
bd5635a1
RP
245 if (v)
246 {
247 v = value_addr (v);
248 VALUE_TYPE (v) = type;
249 return v;
250 }
251 }
252 /* No superclass found, just fall through to change ptr type. */
253 }
254 VALUE_TYPE (arg2) = type;
255 return arg2;
256 }
f91a9e05
PB
257 else if (chill_varying_type (type))
258 {
259 struct type *range1, *range2, *eltype1, *eltype2;
260 value_ptr val;
261 int count1, count2;
5e548861 262 LONGEST low_bound, high_bound;
f91a9e05
PB
263 char *valaddr, *valaddr_data;
264 if (code2 == TYPE_CODE_BITSTRING)
265 error ("not implemented: converting bitstring to varying type");
266 if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
5e548861
PB
267 || (eltype1 = check_typedef (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1))),
268 eltype2 = check_typedef (TYPE_TARGET_TYPE (type2)),
f91a9e05
PB
269 (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
270 /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
271 error ("Invalid conversion to varying type");
272 range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
5e548861
PB
273 range2 = TYPE_FIELD_TYPE (type2, 0);
274 if (get_discrete_bounds (range1, &low_bound, &high_bound) < 0)
275 count1 = -1;
276 else
277 count1 = high_bound - low_bound + 1;
278 if (get_discrete_bounds (range2, &low_bound, &high_bound) < 0)
279 count1 = -1, count2 = 0; /* To force error before */
280 else
281 count2 = high_bound - low_bound + 1;
f91a9e05
PB
282 if (count2 > count1)
283 error ("target varying type is too small");
284 val = allocate_value (type);
285 valaddr = VALUE_CONTENTS_RAW (val);
286 valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
287 /* Set val's __var_length field to count2. */
288 store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
289 count2);
290 /* Set the __var_data field to count2 elements copied from arg2. */
291 memcpy (valaddr_data, VALUE_CONTENTS (arg2),
292 count2 * TYPE_LENGTH (eltype2));
293 /* Zero the rest of the __var_data field of val. */
294 memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
295 (count1 - count2) * TYPE_LENGTH (eltype2));
296 return val;
297 }
bd5635a1
RP
298 else if (VALUE_LVAL (arg2) == lval_memory)
299 {
300 return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2));
301 }
d11c44f1
JG
302 else if (code1 == TYPE_CODE_VOID)
303 {
304 return value_zero (builtin_type_void, not_lval);
305 }
bd5635a1
RP
306 else
307 {
308 error ("Invalid cast.");
309 return 0;
310 }
311}
312
313/* Create a value of type TYPE that is zero, and return it. */
314
a91a6192 315value_ptr
bd5635a1
RP
316value_zero (type, lv)
317 struct type *type;
318 enum lval_type lv;
319{
a91a6192 320 register value_ptr val = allocate_value (type);
bd5635a1 321
5e548861 322 memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (check_typedef (type)));
bd5635a1
RP
323 VALUE_LVAL (val) = lv;
324
325 return val;
326}
327
328/* Return a value with type TYPE located at ADDR.
329
330 Call value_at only if the data needs to be fetched immediately;
331 if we can be 'lazy' and defer the fetch, perhaps indefinately, call
332 value_at_lazy instead. value_at_lazy simply records the address of
333 the data and sets the lazy-evaluation-required flag. The lazy flag
334 is tested in the VALUE_CONTENTS macro, which is used if and when
335 the contents are actually required. */
336
a91a6192 337value_ptr
bd5635a1
RP
338value_at (type, addr)
339 struct type *type;
340 CORE_ADDR addr;
341{
a91a6192
SS
342 register value_ptr val;
343
5e548861 344 if (TYPE_CODE (check_typedef (type)) == TYPE_CODE_VOID)
a91a6192
SS
345 error ("Attempt to dereference a generic pointer.");
346
347 val = allocate_value (type);
bd5635a1
RP
348
349 read_memory (addr, VALUE_CONTENTS_RAW (val), TYPE_LENGTH (type));
350
351 VALUE_LVAL (val) = lval_memory;
352 VALUE_ADDRESS (val) = addr;
353
354 return val;
355}
356
357/* Return a lazy value with type TYPE located at ADDR (cf. value_at). */
358
a91a6192 359value_ptr
bd5635a1
RP
360value_at_lazy (type, addr)
361 struct type *type;
362 CORE_ADDR addr;
363{
a91a6192
SS
364 register value_ptr val;
365
5e548861 366 if (TYPE_CODE (check_typedef (type)) == TYPE_CODE_VOID)
a91a6192
SS
367 error ("Attempt to dereference a generic pointer.");
368
369 val = allocate_value (type);
bd5635a1
RP
370
371 VALUE_LVAL (val) = lval_memory;
372 VALUE_ADDRESS (val) = addr;
373 VALUE_LAZY (val) = 1;
374
375 return val;
376}
377
378/* Called only from the VALUE_CONTENTS macro, if the current data for
379 a variable needs to be loaded into VALUE_CONTENTS(VAL). Fetches the
380 data from the user's process, and clears the lazy flag to indicate
381 that the data in the buffer is valid.
382
9cb602e1
JG
383 If the value is zero-length, we avoid calling read_memory, which would
384 abort. We mark the value as fetched anyway -- all 0 bytes of it.
385
bd5635a1
RP
386 This function returns a value because it is used in the VALUE_CONTENTS
387 macro as part of an expression, where a void would not work. The
388 value is ignored. */
389
390int
391value_fetch_lazy (val)
a91a6192 392 register value_ptr val;
bd5635a1
RP
393{
394 CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
5e548861 395 int length = TYPE_LENGTH (VALUE_TYPE (val));
bd5635a1 396
5e548861
PB
397 if (length)
398 read_memory (addr, VALUE_CONTENTS_RAW (val), length);
bd5635a1
RP
399 VALUE_LAZY (val) = 0;
400 return 0;
401}
402
403
404/* Store the contents of FROMVAL into the location of TOVAL.
405 Return a new value with the location of TOVAL and contents of FROMVAL. */
406
a91a6192 407value_ptr
bd5635a1 408value_assign (toval, fromval)
a91a6192 409 register value_ptr toval, fromval;
bd5635a1 410{
67e9b3b3 411 register struct type *type;
a91a6192 412 register value_ptr val;
bd5635a1 413 char raw_buffer[MAX_REGISTER_RAW_SIZE];
bd5635a1
RP
414 int use_buffer = 0;
415
30974778
JK
416 if (!toval->modifiable)
417 error ("Left operand of assignment is not a modifiable lvalue.");
418
8e9a3f3b 419 COERCE_REF (toval);
bd5635a1 420
67e9b3b3 421 type = VALUE_TYPE (toval);
bd5635a1
RP
422 if (VALUE_LVAL (toval) != lval_internalvar)
423 fromval = value_cast (type, fromval);
aa220473
SG
424 else
425 COERCE_ARRAY (fromval);
5e548861 426 CHECK_TYPEDEF (type);
bd5635a1
RP
427
428 /* If TOVAL is a special machine register requiring conversion
429 of program values to a special raw format,
430 convert FROMVAL's contents now, with result in `raw_buffer',
431 and set USE_BUFFER to the number of bytes to write. */
432
ad09cb2b 433#ifdef REGISTER_CONVERTIBLE
bd5635a1
RP
434 if (VALUE_REGNO (toval) >= 0
435 && REGISTER_CONVERTIBLE (VALUE_REGNO (toval)))
436 {
437 int regno = VALUE_REGNO (toval);
ad09cb2b
PS
438 if (REGISTER_CONVERTIBLE (regno))
439 {
5e548861
PB
440 struct type *fromtype = check_typedef (VALUE_TYPE (fromval));
441 REGISTER_CONVERT_TO_RAW (fromtype, regno,
ad09cb2b
PS
442 VALUE_CONTENTS (fromval), raw_buffer);
443 use_buffer = REGISTER_RAW_SIZE (regno);
444 }
bd5635a1 445 }
ad09cb2b 446#endif
bd5635a1
RP
447
448 switch (VALUE_LVAL (toval))
449 {
450 case lval_internalvar:
451 set_internalvar (VALUE_INTERNALVAR (toval), fromval);
75225aa2 452 return value_copy (VALUE_INTERNALVAR (toval)->value);
bd5635a1
RP
453
454 case lval_internalvar_component:
455 set_internalvar_component (VALUE_INTERNALVAR (toval),
456 VALUE_OFFSET (toval),
457 VALUE_BITPOS (toval),
458 VALUE_BITSIZE (toval),
459 fromval);
460 break;
461
462 case lval_memory:
463 if (VALUE_BITSIZE (toval))
464 {
4d52ec86
JK
465 char buffer[sizeof (LONGEST)];
466 /* We assume that the argument to read_memory is in units of
467 host chars. FIXME: Is that correct? */
468 int len = (VALUE_BITPOS (toval)
469 + VALUE_BITSIZE (toval)
470 + HOST_CHAR_BIT - 1)
471 / HOST_CHAR_BIT;
ad09cb2b 472
4d52ec86 473 if (len > sizeof (LONGEST))
ad09cb2b
PS
474 error ("Can't handle bitfields which don't fit in a %d bit word.",
475 sizeof (LONGEST) * HOST_CHAR_BIT);
4d52ec86 476
bd5635a1 477 read_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
4d52ec86
JK
478 buffer, len);
479 modify_field (buffer, value_as_long (fromval),
bd5635a1
RP
480 VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
481 write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
4d52ec86 482 buffer, len);
bd5635a1
RP
483 }
484 else if (use_buffer)
485 write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
486 raw_buffer, use_buffer);
487 else
488 write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
489 VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
490 break;
491
492 case lval_register:
493 if (VALUE_BITSIZE (toval))
494 {
ad09cb2b 495 char buffer[sizeof (LONGEST)];
4d52ec86 496 int len = REGISTER_RAW_SIZE (VALUE_REGNO (toval));
ad09cb2b
PS
497
498 if (len > sizeof (LONGEST))
499 error ("Can't handle bitfields in registers larger than %d bits.",
500 sizeof (LONGEST) * HOST_CHAR_BIT);
501
502 if (VALUE_BITPOS (toval) + VALUE_BITSIZE (toval)
503 > len * HOST_CHAR_BIT)
504 /* Getting this right would involve being very careful about
505 byte order. */
506 error ("\
507Can't handle bitfield which doesn't fit in a single register.");
508
4d52ec86
JK
509 read_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
510 buffer, len);
511 modify_field (buffer, value_as_long (fromval),
512 VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
513 write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
514 buffer, len);
bd5635a1
RP
515 }
516 else if (use_buffer)
517 write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
518 raw_buffer, use_buffer);
519 else
54023465
JK
520 {
521 /* Do any conversion necessary when storing this type to more
522 than one register. */
523#ifdef REGISTER_CONVERT_FROM_TYPE
524 memcpy (raw_buffer, VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
525 REGISTER_CONVERT_FROM_TYPE(VALUE_REGNO (toval), type, raw_buffer);
526 write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
527 raw_buffer, TYPE_LENGTH (type));
528#else
529 write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
530 VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
531#endif
532 }
79971d11
JK
533 /* Assigning to the stack pointer, frame pointer, and other
534 (architecture and calling convention specific) registers may
535 cause the frame cache to be out of date. We just do this
536 on all assignments to registers for simplicity; I doubt the slowdown
537 matters. */
538 reinit_frame_cache ();
bd5635a1
RP
539 break;
540
541 case lval_reg_frame_relative:
542 {
543 /* value is stored in a series of registers in the frame
544 specified by the structure. Copy that value out, modify
545 it, and copy it back in. */
546 int amount_to_copy = (VALUE_BITSIZE (toval) ? 1 : TYPE_LENGTH (type));
547 int reg_size = REGISTER_RAW_SIZE (VALUE_FRAME_REGNUM (toval));
548 int byte_offset = VALUE_OFFSET (toval) % reg_size;
549 int reg_offset = VALUE_OFFSET (toval) / reg_size;
550 int amount_copied;
4d52ec86
JK
551
552 /* Make the buffer large enough in all cases. */
553 char *buffer = (char *) alloca (amount_to_copy
554 + sizeof (LONGEST)
555 + MAX_REGISTER_RAW_SIZE);
556
bd5635a1 557 int regno;
6d34c236 558 struct frame_info *frame;
bd5635a1
RP
559
560 /* Figure out which frame this is in currently. */
561 for (frame = get_current_frame ();
562 frame && FRAME_FP (frame) != VALUE_FRAME (toval);
563 frame = get_prev_frame (frame))
564 ;
565
566 if (!frame)
567 error ("Value being assigned to is no longer active.");
568
569 amount_to_copy += (reg_size - amount_to_copy % reg_size);
570
571 /* Copy it out. */
572 for ((regno = VALUE_FRAME_REGNUM (toval) + reg_offset,
573 amount_copied = 0);
574 amount_copied < amount_to_copy;
575 amount_copied += reg_size, regno++)
576 {
577 get_saved_register (buffer + amount_copied,
51b57ded 578 (int *)NULL, (CORE_ADDR *)NULL,
bd5635a1
RP
579 frame, regno, (enum lval_type *)NULL);
580 }
581
582 /* Modify what needs to be modified. */
583 if (VALUE_BITSIZE (toval))
584 modify_field (buffer + byte_offset,
479fdd26 585 value_as_long (fromval),
bd5635a1
RP
586 VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
587 else if (use_buffer)
4ed3a9ea 588 memcpy (buffer + byte_offset, raw_buffer, use_buffer);
bd5635a1 589 else
4ed3a9ea
FF
590 memcpy (buffer + byte_offset, VALUE_CONTENTS (fromval),
591 TYPE_LENGTH (type));
bd5635a1
RP
592
593 /* Copy it back. */
594 for ((regno = VALUE_FRAME_REGNUM (toval) + reg_offset,
595 amount_copied = 0);
596 amount_copied < amount_to_copy;
597 amount_copied += reg_size, regno++)
598 {
599 enum lval_type lval;
600 CORE_ADDR addr;
601 int optim;
602
603 /* Just find out where to put it. */
604 get_saved_register ((char *)NULL,
605 &optim, &addr, frame, regno, &lval);
606
607 if (optim)
608 error ("Attempt to assign to a value that was optimized out.");
609 if (lval == lval_memory)
610 write_memory (addr, buffer + amount_copied, reg_size);
611 else if (lval == lval_register)
612 write_register_bytes (addr, buffer + amount_copied, reg_size);
613 else
614 error ("Attempt to assign to an unmodifiable value.");
615 }
616 }
617 break;
618
619
620 default:
30974778 621 error ("Left operand of assignment is not an lvalue.");
bd5635a1
RP
622 }
623
b4680522
PB
624 /* If the field does not entirely fill a LONGEST, then zero the sign bits.
625 If the field is signed, and is negative, then sign extend. */
626 if ((VALUE_BITSIZE (toval) > 0)
627 && (VALUE_BITSIZE (toval) < 8 * sizeof (LONGEST)))
628 {
629 LONGEST fieldval = value_as_long (fromval);
630 LONGEST valmask = (((unsigned LONGEST) 1) << VALUE_BITSIZE (toval)) - 1;
631
632 fieldval &= valmask;
633 if (!TYPE_UNSIGNED (type) && (fieldval & (valmask ^ (valmask >> 1))))
634 fieldval |= ~valmask;
635
636 fromval = value_from_longest (type, fieldval);
637 }
638
b4680522 639 val = value_copy (toval);
4ed3a9ea
FF
640 memcpy (VALUE_CONTENTS_RAW (val), VALUE_CONTENTS (fromval),
641 TYPE_LENGTH (type));
bd5635a1
RP
642 VALUE_TYPE (val) = type;
643
644 return val;
645}
646
647/* Extend a value VAL to COUNT repetitions of its type. */
648
a91a6192 649value_ptr
bd5635a1 650value_repeat (arg1, count)
a91a6192 651 value_ptr arg1;
bd5635a1
RP
652 int count;
653{
a91a6192 654 register value_ptr val;
bd5635a1
RP
655
656 if (VALUE_LVAL (arg1) != lval_memory)
657 error ("Only values in memory can be extended with '@'.");
658 if (count < 1)
659 error ("Invalid number %d of repetitions.", count);
660
661 val = allocate_repeat_value (VALUE_TYPE (arg1), count);
662
663 read_memory (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1),
664 VALUE_CONTENTS_RAW (val),
09af5868 665 TYPE_LENGTH (VALUE_TYPE (val)));
bd5635a1
RP
666 VALUE_LVAL (val) = lval_memory;
667 VALUE_ADDRESS (val) = VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1);
668
669 return val;
670}
671
a91a6192 672value_ptr
479fdd26 673value_of_variable (var, b)
bd5635a1 674 struct symbol *var;
479fdd26 675 struct block *b;
bd5635a1 676{
a91a6192 677 value_ptr val;
6d34c236 678 struct frame_info *frame;
bd5635a1 679
479fdd26
JK
680 if (b == NULL)
681 /* Use selected frame. */
6d34c236 682 frame = NULL;
479fdd26
JK
683 else
684 {
6d34c236
PB
685 frame = block_innermost_frame (b);
686 if (frame == NULL && symbol_read_needs_frame (var))
479fdd26
JK
687 {
688 if (BLOCK_FUNCTION (b) != NULL
689 && SYMBOL_NAME (BLOCK_FUNCTION (b)) != NULL)
690 error ("No frame is currently executing in block %s.",
691 SYMBOL_NAME (BLOCK_FUNCTION (b)));
692 else
693 error ("No frame is currently executing in specified block");
694 }
695 }
6d34c236 696 val = read_var_value (var, frame);
bd5635a1 697 if (val == 0)
2e4964ad 698 error ("Address of symbol \"%s\" is unknown.", SYMBOL_SOURCE_NAME (var));
bd5635a1
RP
699 return val;
700}
701
a163ddec
MT
702/* Given a value which is an array, return a value which is a pointer to its
703 first element, regardless of whether or not the array has a nonzero lower
704 bound.
705
706 FIXME: A previous comment here indicated that this routine should be
707 substracting the array's lower bound. It's not clear to me that this
708 is correct. Given an array subscripting operation, it would certainly
709 work to do the adjustment here, essentially computing:
710
711 (&array[0] - (lowerbound * sizeof array[0])) + (index * sizeof array[0])
712
713 However I believe a more appropriate and logical place to account for
714 the lower bound is to do so in value_subscript, essentially computing:
715
716 (&array[0] + ((index - lowerbound) * sizeof array[0]))
717
718 As further evidence consider what would happen with operations other
719 than array subscripting, where the caller would get back a value that
720 had an address somewhere before the actual first element of the array,
721 and the information about the lower bound would be lost because of
722 the coercion to pointer type.
723 */
bd5635a1 724
a91a6192 725value_ptr
bd5635a1 726value_coerce_array (arg1)
a91a6192 727 value_ptr arg1;
bd5635a1 728{
5e548861 729 register struct type *type = check_typedef (VALUE_TYPE (arg1));
bd5635a1
RP
730
731 if (VALUE_LVAL (arg1) != lval_memory)
732 error ("Attempt to take address of value not located in memory.");
733
5e548861 734 return value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
bd5635a1 735 (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
bd5635a1
RP
736}
737
738/* Given a value which is a function, return a value which is a pointer
739 to it. */
740
a91a6192 741value_ptr
bd5635a1 742value_coerce_function (arg1)
a91a6192 743 value_ptr arg1;
bd5635a1 744{
bd5635a1
RP
745
746 if (VALUE_LVAL (arg1) != lval_memory)
747 error ("Attempt to take address of value not located in memory.");
748
06b6c733 749 return value_from_longest (lookup_pointer_type (VALUE_TYPE (arg1)),
bd5635a1 750 (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
bd5635a1
RP
751}
752
753/* Return a pointer value for the object for which ARG1 is the contents. */
754
a91a6192 755value_ptr
bd5635a1 756value_addr (arg1)
a91a6192 757 value_ptr arg1;
bd5635a1 758{
5e548861 759 struct type *type = check_typedef (VALUE_TYPE (arg1));
8e9a3f3b
PB
760 if (TYPE_CODE (type) == TYPE_CODE_REF)
761 {
762 /* Copy the value, but change the type from (T&) to (T*).
763 We keep the same location information, which is efficient,
764 and allows &(&X) to get the location containing the reference. */
a91a6192 765 value_ptr arg2 = value_copy (arg1);
8e9a3f3b
PB
766 VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
767 return arg2;
768 }
8e9a3f3b 769 if (TYPE_CODE (type) == TYPE_CODE_FUNC)
bd5635a1
RP
770 return value_coerce_function (arg1);
771
772 if (VALUE_LVAL (arg1) != lval_memory)
773 error ("Attempt to take address of value not located in memory.");
774
5e548861 775 return value_from_longest (lookup_pointer_type (VALUE_TYPE (arg1)),
bd5635a1 776 (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
bd5635a1
RP
777}
778
779/* Given a value of a pointer type, apply the C unary * operator to it. */
780
a91a6192 781value_ptr
bd5635a1 782value_ind (arg1)
a91a6192 783 value_ptr arg1;
bd5635a1 784{
5e548861 785 struct type *type1;
bd5635a1 786 COERCE_ARRAY (arg1);
5e548861 787 type1 = check_typedef (VALUE_TYPE (arg1));
bd5635a1 788
5e548861 789 if (TYPE_CODE (type1) == TYPE_CODE_MEMBER)
bd5635a1
RP
790 error ("not implemented: member types in value_ind");
791
792 /* Allow * on an integer so we can cast it to whatever we want.
793 This returns an int, which seems like the most C-like thing
794 to do. "long long" variables are rare enough that
795 BUILTIN_TYPE_LONGEST would seem to be a mistake. */
5e548861 796 if (TYPE_CODE (type1) == TYPE_CODE_INT)
bd5635a1
RP
797 return value_at (builtin_type_int,
798 (CORE_ADDR) value_as_long (arg1));
5e548861
PB
799 else if (TYPE_CODE (type1) == TYPE_CODE_PTR)
800 return value_at_lazy (TYPE_TARGET_TYPE (type1), value_as_pointer (arg1));
bd5635a1
RP
801 error ("Attempt to take contents of a non-pointer value.");
802 return 0; /* For lint -- never reached */
803}
804\f
805/* Pushing small parts of stack frames. */
806
807/* Push one word (the size of object that a register holds). */
808
809CORE_ADDR
34df79fc 810push_word (sp, word)
bd5635a1 811 CORE_ADDR sp;
67e9b3b3 812 unsigned LONGEST word;
bd5635a1 813{
67e9b3b3 814 register int len = REGISTER_SIZE;
479fdd26 815 char buffer[MAX_REGISTER_RAW_SIZE];
bd5635a1 816
479fdd26 817 store_unsigned_integer (buffer, len, word);
bd5635a1
RP
818#if 1 INNER_THAN 2
819 sp -= len;
479fdd26 820 write_memory (sp, buffer, len);
bd5635a1 821#else /* stack grows upward */
479fdd26 822 write_memory (sp, buffer, len);
bd5635a1
RP
823 sp += len;
824#endif /* stack grows upward */
825
826 return sp;
827}
828
829/* Push LEN bytes with data at BUFFER. */
830
831CORE_ADDR
832push_bytes (sp, buffer, len)
833 CORE_ADDR sp;
834 char *buffer;
835 int len;
836{
837#if 1 INNER_THAN 2
838 sp -= len;
839 write_memory (sp, buffer, len);
840#else /* stack grows upward */
841 write_memory (sp, buffer, len);
842 sp += len;
843#endif /* stack grows upward */
844
845 return sp;
846}
847
848/* Push onto the stack the specified value VALUE. */
849
01be6913 850static CORE_ADDR
bd5635a1
RP
851value_push (sp, arg)
852 register CORE_ADDR sp;
a91a6192 853 value_ptr arg;
bd5635a1
RP
854{
855 register int len = TYPE_LENGTH (VALUE_TYPE (arg));
856
857#if 1 INNER_THAN 2
858 sp -= len;
859 write_memory (sp, VALUE_CONTENTS (arg), len);
860#else /* stack grows upward */
861 write_memory (sp, VALUE_CONTENTS (arg), len);
862 sp += len;
863#endif /* stack grows upward */
864
865 return sp;
866}
867
868/* Perform the standard coercions that are specified
5222ca60 869 for arguments to be passed to C functions.
bd5635a1 870
5222ca60
PB
871 If PARAM_TYPE is non-NULL, it is the expected parameter type. */
872
873static value_ptr
874value_arg_coerce (arg, param_type)
a91a6192 875 value_ptr arg;
5222ca60 876 struct type *param_type;
bd5635a1 877{
5e548861
PB
878 register struct type *arg_type = check_typedef (VALUE_TYPE (arg));
879 register struct type *type
880 = param_type ? check_typedef (param_type) : arg_type;
bd5635a1 881
5222ca60
PB
882 switch (TYPE_CODE (type))
883 {
884 case TYPE_CODE_REF:
5e548861 885 if (TYPE_CODE (arg_type) != TYPE_CODE_REF)
5222ca60
PB
886 {
887 arg = value_addr (arg);
888 VALUE_TYPE (arg) = param_type;
889 return arg;
890 }
891 break;
892 case TYPE_CODE_INT:
893 case TYPE_CODE_CHAR:
894 case TYPE_CODE_BOOL:
895 case TYPE_CODE_ENUM:
896 if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
897 type = builtin_type_int;
898 break;
aa220473
SG
899 case TYPE_CODE_FLT:
900 /* coerce float to double, unless the function prototype specifies float */
75225aa2 901 if (COERCE_FLOAT_TO_DOUBLE)
aa220473
SG
902 {
903 if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_double))
904 type = builtin_type_double;
905 else if (TYPE_LENGTH (type) > TYPE_LENGTH (builtin_type_double))
906 type = builtin_type_long_double;
907 }
908 break;
5222ca60
PB
909 case TYPE_CODE_FUNC:
910 type = lookup_pointer_type (type);
911 break;
5e548861
PB
912 case TYPE_CODE_ARRAY:
913 if (current_language->c_style_arrays)
914 type = lookup_pointer_type (TYPE_TARGET_TYPE (type));
915 break;
2b576293
C
916 case TYPE_CODE_UNDEF:
917 case TYPE_CODE_PTR:
2b576293
C
918 case TYPE_CODE_STRUCT:
919 case TYPE_CODE_UNION:
920 case TYPE_CODE_VOID:
921 case TYPE_CODE_SET:
922 case TYPE_CODE_RANGE:
923 case TYPE_CODE_STRING:
924 case TYPE_CODE_BITSTRING:
925 case TYPE_CODE_ERROR:
926 case TYPE_CODE_MEMBER:
927 case TYPE_CODE_METHOD:
928 case TYPE_CODE_COMPLEX:
929 default:
930 break;
5222ca60 931 }
479fdd26 932
5222ca60 933 return value_cast (type, arg);
bd5635a1
RP
934}
935
936/* Determine a function's address and its return type from its value.
937 Calls error() if the function is not valid for calling. */
938
01be6913 939static CORE_ADDR
bd5635a1 940find_function_addr (function, retval_type)
a91a6192 941 value_ptr function;
bd5635a1
RP
942 struct type **retval_type;
943{
5e548861 944 register struct type *ftype = check_typedef (VALUE_TYPE (function));
bd5635a1
RP
945 register enum type_code code = TYPE_CODE (ftype);
946 struct type *value_type;
947 CORE_ADDR funaddr;
948
949 /* If it's a member function, just look at the function
950 part of it. */
951
952 /* Determine address to call. */
953 if (code == TYPE_CODE_FUNC || code == TYPE_CODE_METHOD)
954 {
955 funaddr = VALUE_ADDRESS (function);
956 value_type = TYPE_TARGET_TYPE (ftype);
957 }
958 else if (code == TYPE_CODE_PTR)
959 {
d11c44f1 960 funaddr = value_as_pointer (function);
5e548861
PB
961 ftype = check_typedef (TYPE_TARGET_TYPE (ftype));
962 if (TYPE_CODE (ftype) == TYPE_CODE_FUNC
963 || TYPE_CODE (ftype) == TYPE_CODE_METHOD)
9ed8604f
PS
964 {
965#ifdef CONVERT_FROM_FUNC_PTR_ADDR
966 /* FIXME: This is a workaround for the unusual function
967 pointer representation on the RS/6000, see comment
968 in config/rs6000/tm-rs6000.h */
969 funaddr = CONVERT_FROM_FUNC_PTR_ADDR (funaddr);
970#endif
5e548861 971 value_type = TYPE_TARGET_TYPE (ftype);
9ed8604f 972 }
bd5635a1
RP
973 else
974 value_type = builtin_type_int;
975 }
976 else if (code == TYPE_CODE_INT)
977 {
978 /* Handle the case of functions lacking debugging info.
979 Their values are characters since their addresses are char */
980 if (TYPE_LENGTH (ftype) == 1)
d11c44f1 981 funaddr = value_as_pointer (value_addr (function));
bd5635a1
RP
982 else
983 /* Handle integer used as address of a function. */
d11c44f1 984 funaddr = (CORE_ADDR) value_as_long (function);
bd5635a1
RP
985
986 value_type = builtin_type_int;
987 }
988 else
989 error ("Invalid data type for function to be called.");
990
991 *retval_type = value_type;
992 return funaddr;
993}
994
995#if defined (CALL_DUMMY)
996/* All this stuff with a dummy frame may seem unnecessarily complicated
997 (why not just save registers in GDB?). The purpose of pushing a dummy
998 frame which looks just like a real frame is so that if you call a
999 function and then hit a breakpoint (get a signal, etc), "backtrace"
1000 will look right. Whether the backtrace needs to actually show the
1001 stack at the time the inferior function was called is debatable, but
1002 it certainly needs to not display garbage. So if you are contemplating
1003 making dummy frames be different from normal frames, consider that. */
1004
1005/* Perform a function call in the inferior.
1006 ARGS is a vector of values of arguments (NARGS of them).
1007 FUNCTION is a value, the function to be called.
1008 Returns a value representing what the function returned.
1009 May fail to return, if a breakpoint or signal is hit
5222ca60
PB
1010 during the execution of the function.
1011
1012 ARGS is modified to contain coerced values. */
bd5635a1 1013
a91a6192 1014value_ptr
bd5635a1 1015call_function_by_hand (function, nargs, args)
a91a6192 1016 value_ptr function;
bd5635a1 1017 int nargs;
a91a6192 1018 value_ptr *args;
bd5635a1
RP
1019{
1020 register CORE_ADDR sp;
1021 register int i;
1022 CORE_ADDR start_sp;
67e9b3b3
PS
1023 /* CALL_DUMMY is an array of words (REGISTER_SIZE), but each word
1024 is in host byte order. Before calling FIX_CALL_DUMMY, we byteswap it
1025 and remove any extra bytes which might exist because unsigned LONGEST is
1026 bigger than REGISTER_SIZE. */
1027 static unsigned LONGEST dummy[] = CALL_DUMMY;
1028 char dummy1[REGISTER_SIZE * sizeof dummy / sizeof (unsigned LONGEST)];
bd5635a1
RP
1029 CORE_ADDR old_sp;
1030 struct type *value_type;
1031 unsigned char struct_return;
1032 CORE_ADDR struct_addr;
1033 struct inferior_status inf_status;
1034 struct cleanup *old_chain;
1035 CORE_ADDR funaddr;
1036 int using_gcc;
9f739abd 1037 CORE_ADDR real_pc;
5e548861 1038 struct type *ftype = check_typedef (SYMBOL_TYPE (function));
bd5635a1 1039
e17960fb
JG
1040 if (!target_has_execution)
1041 noprocess();
1042
bd5635a1
RP
1043 save_inferior_status (&inf_status, 1);
1044 old_chain = make_cleanup (restore_inferior_status, &inf_status);
1045
1046 /* PUSH_DUMMY_FRAME is responsible for saving the inferior registers
1047 (and POP_FRAME for restoring them). (At least on most machines)
1048 they are saved on the stack in the inferior. */
1049 PUSH_DUMMY_FRAME;
1050
54023465 1051 old_sp = sp = read_sp ();
bd5635a1
RP
1052
1053#if 1 INNER_THAN 2 /* Stack grows down */
9ed8604f 1054 sp -= sizeof dummy1;
bd5635a1
RP
1055 start_sp = sp;
1056#else /* Stack grows up */
1057 start_sp = sp;
9ed8604f 1058 sp += sizeof dummy1;
bd5635a1
RP
1059#endif
1060
1061 funaddr = find_function_addr (function, &value_type);
5e548861 1062 CHECK_TYPEDEF (value_type);
bd5635a1
RP
1063
1064 {
1065 struct block *b = block_for_pc (funaddr);
1066 /* If compiled without -g, assume GCC. */
f7a69ed7 1067 using_gcc = b == NULL ? 0 : BLOCK_GCC_COMPILED (b);
bd5635a1
RP
1068 }
1069
1070 /* Are we returning a value using a structure return or a normal
1071 value return? */
1072
1073 struct_return = using_struct_return (function, funaddr, value_type,
1074 using_gcc);
1075
1076 /* Create a call sequence customized for this function
1077 and the number of arguments for it. */
67e9b3b3
PS
1078 for (i = 0; i < sizeof dummy / sizeof (dummy[0]); i++)
1079 store_unsigned_integer (&dummy1[i * REGISTER_SIZE],
1080 REGISTER_SIZE,
34df79fc 1081 (unsigned LONGEST)dummy[i]);
9f739abd
SG
1082
1083#ifdef GDB_TARGET_IS_HPPA
b5728692
SG
1084 real_pc = FIX_CALL_DUMMY (dummy1, start_sp, funaddr, nargs, args,
1085 value_type, using_gcc);
9f739abd 1086#else
bd5635a1
RP
1087 FIX_CALL_DUMMY (dummy1, start_sp, funaddr, nargs, args,
1088 value_type, using_gcc);
9f739abd
SG
1089 real_pc = start_sp;
1090#endif
bd5635a1
RP
1091
1092#if CALL_DUMMY_LOCATION == ON_STACK
9ed8604f 1093 write_memory (start_sp, (char *)dummy1, sizeof dummy1);
cef4c2e7 1094#endif /* On stack. */
bd5635a1 1095
bd5635a1
RP
1096#if CALL_DUMMY_LOCATION == BEFORE_TEXT_END
1097 /* Convex Unix prohibits executing in the stack segment. */
1098 /* Hope there is empty room at the top of the text segment. */
1099 {
84d82b1c 1100 extern CORE_ADDR text_end;
bd5635a1
RP
1101 static checked = 0;
1102 if (!checked)
9ed8604f 1103 for (start_sp = text_end - sizeof dummy1; start_sp < text_end; ++start_sp)
bd5635a1
RP
1104 if (read_memory_integer (start_sp, 1) != 0)
1105 error ("text segment full -- no place to put call");
1106 checked = 1;
1107 sp = old_sp;
9ed8604f
PS
1108 real_pc = text_end - sizeof dummy1;
1109 write_memory (real_pc, (char *)dummy1, sizeof dummy1);
bd5635a1 1110 }
cef4c2e7
PS
1111#endif /* Before text_end. */
1112
1113#if CALL_DUMMY_LOCATION == AFTER_TEXT_END
bd5635a1 1114 {
84d82b1c 1115 extern CORE_ADDR text_end;
bd5635a1
RP
1116 int errcode;
1117 sp = old_sp;
30d20d15 1118 real_pc = text_end;
9ed8604f 1119 errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy1);
bd5635a1
RP
1120 if (errcode != 0)
1121 error ("Cannot write text segment -- call_function failed");
1122 }
1123#endif /* After text_end. */
cef4c2e7
PS
1124
1125#if CALL_DUMMY_LOCATION == AT_ENTRY_POINT
1126 real_pc = funaddr;
1127#endif /* At entry point. */
bd5635a1
RP
1128
1129#ifdef lint
1130 sp = old_sp; /* It really is used, for some ifdef's... */
1131#endif
1132
f7a69ed7
PB
1133 if (nargs < TYPE_NFIELDS (ftype))
1134 error ("too few arguments in function call");
1135
5222ca60
PB
1136 for (i = nargs - 1; i >= 0; i--)
1137 {
1138 struct type *param_type;
1139 if (TYPE_NFIELDS (ftype) > i)
1140 param_type = TYPE_FIELD_TYPE (ftype, i);
1141 else
1142 param_type = 0;
1143 args[i] = value_arg_coerce (args[i], param_type);
1144 }
1145
bd5635a1
RP
1146#if defined (REG_STRUCT_HAS_ADDR)
1147 {
a91a6192 1148 /* This is a machine like the sparc, where we may need to pass a pointer
bd5635a1 1149 to the structure, not the structure itself. */
a91a6192 1150 for (i = nargs - 1; i >= 0; i--)
5e548861
PB
1151 {
1152 struct type *arg_type = check_typedef (VALUE_TYPE (args[i]));
1153 if ((TYPE_CODE (arg_type) == TYPE_CODE_STRUCT
1154 || TYPE_CODE (arg_type) == TYPE_CODE_UNION
1155 || TYPE_CODE (arg_type) == TYPE_CODE_ARRAY
34cfa2da
PB
1156 || TYPE_CODE (arg_type) == TYPE_CODE_STRING
1157 || TYPE_CODE (arg_type) == TYPE_CODE_BITSTRING
aa220473
SG
1158 || TYPE_CODE (arg_type) == TYPE_CODE_SET
1159 || (TYPE_CODE (arg_type) == TYPE_CODE_FLT
1160 && TYPE_LENGTH (arg_type) > 8)
1161 )
5e548861
PB
1162 && REG_STRUCT_HAS_ADDR (using_gcc, arg_type))
1163 {
1164 CORE_ADDR addr;
1165 int len = TYPE_LENGTH (arg_type);
f7a69ed7 1166#ifdef STACK_ALIGN
5e548861 1167 int aligned_len = STACK_ALIGN (len);
f7a69ed7 1168#else
5e548861 1169 int aligned_len = len;
f7a69ed7 1170#endif
bd5635a1 1171#if !(1 INNER_THAN 2)
5e548861
PB
1172 /* The stack grows up, so the address of the thing we push
1173 is the stack pointer before we push it. */
1174 addr = sp;
f7a69ed7 1175#else
5e548861 1176 sp -= aligned_len;
bd5635a1 1177#endif
5e548861
PB
1178 /* Push the structure. */
1179 write_memory (sp, VALUE_CONTENTS (args[i]), len);
bd5635a1 1180#if 1 INNER_THAN 2
5e548861
PB
1181 /* The stack grows down, so the address of the thing we push
1182 is the stack pointer after we push it. */
1183 addr = sp;
f7a69ed7 1184#else
5e548861 1185 sp += aligned_len;
bd5635a1 1186#endif
5e548861
PB
1187 /* The value we're going to pass is the address of the thing
1188 we just pushed. */
1189 args[i] = value_from_longest (lookup_pointer_type (value_type),
1190 (LONGEST) addr);
1191 }
1192 }
bd5635a1
RP
1193 }
1194#endif /* REG_STRUCT_HAS_ADDR. */
1195
f7a69ed7
PB
1196 /* Reserve space for the return structure to be written on the
1197 stack, if necessary */
1198
1199 if (struct_return)
1200 {
1201 int len = TYPE_LENGTH (value_type);
1202#ifdef STACK_ALIGN
1203 len = STACK_ALIGN (len);
1204#endif
1205#if 1 INNER_THAN 2
1206 sp -= len;
1207 struct_addr = sp;
1208#else
1209 struct_addr = sp;
1210 sp += len;
1211#endif
1212 }
1213
1214#ifdef STACK_ALIGN
1215 /* If stack grows down, we must leave a hole at the top. */
1216 {
1217 int len = 0;
1218
1219 for (i = nargs - 1; i >= 0; i--)
1220 len += TYPE_LENGTH (VALUE_TYPE (args[i]));
1221#ifdef CALL_DUMMY_STACK_ADJUST
1222 len += CALL_DUMMY_STACK_ADJUST;
1223#endif
1224#if 1 INNER_THAN 2
1225 sp -= STACK_ALIGN (len) - len;
1226#else
1227 sp += STACK_ALIGN (len) - len;
1228#endif
1229 }
1230#endif /* STACK_ALIGN */
1231
bd5635a1
RP
1232#ifdef PUSH_ARGUMENTS
1233 PUSH_ARGUMENTS(nargs, args, sp, struct_return, struct_addr);
1234#else /* !PUSH_ARGUMENTS */
1235 for (i = nargs - 1; i >= 0; i--)
5222ca60 1236 sp = value_push (sp, args[i]);
bd5635a1
RP
1237#endif /* !PUSH_ARGUMENTS */
1238
1239#ifdef CALL_DUMMY_STACK_ADJUST
1240#if 1 INNER_THAN 2
1241 sp -= CALL_DUMMY_STACK_ADJUST;
1242#else
1243 sp += CALL_DUMMY_STACK_ADJUST;
1244#endif
1245#endif /* CALL_DUMMY_STACK_ADJUST */
1246
1247 /* Store the address at which the structure is supposed to be
1248 written. Note that this (and the code which reserved the space
1249 above) assumes that gcc was used to compile this function. Since
1250 it doesn't cost us anything but space and if the function is pcc
1251 it will ignore this value, we will make that assumption.
1252
1253 Also note that on some machines (like the sparc) pcc uses a
1254 convention like gcc's. */
1255
1256 if (struct_return)
1257 STORE_STRUCT_RETURN (struct_addr, sp);
1258
1259 /* Write the stack pointer. This is here because the statements above
1260 might fool with it. On SPARC, this write also stores the register
1261 window into the right place in the new stack frame, which otherwise
5632cd56 1262 wouldn't happen. (See store_inferior_registers in sparc-nat.c.) */
54023465 1263 write_sp (sp);
bd5635a1 1264
bd5635a1
RP
1265 {
1266 char retbuf[REGISTER_BYTES];
54023465
JK
1267 char *name;
1268 struct symbol *symbol;
1269
1270 name = NULL;
1271 symbol = find_pc_function (funaddr);
1272 if (symbol)
1273 {
1274 name = SYMBOL_SOURCE_NAME (symbol);
1275 }
1276 else
1277 {
1278 /* Try the minimal symbols. */
1279 struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (funaddr);
1280
1281 if (msymbol)
1282 {
1283 name = SYMBOL_SOURCE_NAME (msymbol);
1284 }
1285 }
1286 if (name == NULL)
1287 {
1288 char format[80];
1289 sprintf (format, "at %s", local_hex_format ());
1290 name = alloca (80);
30974778 1291 /* FIXME-32x64: assumes funaddr fits in a long. */
cef4c2e7 1292 sprintf (name, format, (unsigned long) funaddr);
54023465 1293 }
bd5635a1
RP
1294
1295 /* Execute the stack dummy routine, calling FUNCTION.
1296 When it is done, discard the empty frame
1297 after storing the contents of all regs into retbuf. */
860a1754
JK
1298 if (run_stack_dummy (real_pc + CALL_DUMMY_START_OFFSET, retbuf))
1299 {
1300 /* We stopped somewhere besides the call dummy. */
1301
1302 /* If we did the cleanups, we would print a spurious error message
1303 (Unable to restore previously selected frame), would write the
1304 registers from the inf_status (which is wrong), and would do other
1305 wrong things (like set stop_bpstat to the wrong thing). */
1306 discard_cleanups (old_chain);
1307 /* Prevent memory leak. */
30d20d15 1308 bpstat_clear (&inf_status.stop_bpstat);
860a1754
JK
1309
1310 /* The following error message used to say "The expression
1311 which contained the function call has been discarded." It
1312 is a hard concept to explain in a few words. Ideally, GDB
1313 would be able to resume evaluation of the expression when
1314 the function finally is done executing. Perhaps someday
1315 this will be implemented (it would not be easy). */
1316
1317 /* FIXME: Insert a bunch of wrap_here; name can be very long if it's
1318 a C++ name with arguments and stuff. */
1319 error ("\
1320The program being debugged stopped while in a function called from GDB.\n\
1321When the function (%s) is done executing, GDB will silently\n\
1322stop (instead of continuing to evaluate the expression containing\n\
1323the function call).", name);
1324 }
bd5635a1
RP
1325
1326 do_cleanups (old_chain);
1327
860a1754 1328 /* Figure out the value returned by the function. */
bd5635a1
RP
1329 return value_being_returned (value_type, retbuf, struct_return);
1330 }
1331}
1332#else /* no CALL_DUMMY. */
a91a6192 1333value_ptr
bd5635a1 1334call_function_by_hand (function, nargs, args)
a91a6192 1335 value_ptr function;
bd5635a1 1336 int nargs;
a91a6192 1337 value_ptr *args;
bd5635a1
RP
1338{
1339 error ("Cannot invoke functions on this machine.");
1340}
1341#endif /* no CALL_DUMMY. */
a163ddec 1342
bd5635a1 1343\f
a163ddec
MT
1344/* Create a value for an array by allocating space in the inferior, copying
1345 the data into that space, and then setting up an array value.
1346
1347 The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
1348 populated from the values passed in ELEMVEC.
1349
1350 The element type of the array is inherited from the type of the
1351 first element, and all elements must have the same size (though we
1352 don't currently enforce any restriction on their types). */
bd5635a1 1353
a91a6192 1354value_ptr
a163ddec
MT
1355value_array (lowbound, highbound, elemvec)
1356 int lowbound;
1357 int highbound;
a91a6192 1358 value_ptr *elemvec;
bd5635a1 1359{
a163ddec
MT
1360 int nelem;
1361 int idx;
1362 int typelength;
a91a6192 1363 value_ptr val;
a163ddec
MT
1364 struct type *rangetype;
1365 struct type *arraytype;
1366 CORE_ADDR addr;
bd5635a1 1367
a163ddec
MT
1368 /* Validate that the bounds are reasonable and that each of the elements
1369 have the same size. */
bd5635a1 1370
a163ddec
MT
1371 nelem = highbound - lowbound + 1;
1372 if (nelem <= 0)
bd5635a1 1373 {
a163ddec 1374 error ("bad array bounds (%d, %d)", lowbound, highbound);
bd5635a1 1375 }
a163ddec 1376 typelength = TYPE_LENGTH (VALUE_TYPE (elemvec[0]));
5e548861 1377 for (idx = 1; idx < nelem; idx++)
bd5635a1 1378 {
a163ddec
MT
1379 if (TYPE_LENGTH (VALUE_TYPE (elemvec[idx])) != typelength)
1380 {
1381 error ("array elements must all be the same size");
1382 }
bd5635a1
RP
1383 }
1384
aa220473
SG
1385 rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
1386 lowbound, highbound);
1387 arraytype = create_array_type ((struct type *) NULL,
1388 VALUE_TYPE (elemvec[0]), rangetype);
1389
1390 if (!current_language->c_style_arrays)
1391 {
1392 val = allocate_value (arraytype);
1393 for (idx = 0; idx < nelem; idx++)
1394 {
1395 memcpy (VALUE_CONTENTS_RAW (val) + (idx * typelength),
1396 VALUE_CONTENTS (elemvec[idx]),
1397 typelength);
1398 }
1399 return val;
1400 }
1401
a163ddec
MT
1402 /* Allocate space to store the array in the inferior, and then initialize
1403 it by copying in each element. FIXME: Is it worth it to create a
1404 local buffer in which to collect each value and then write all the
1405 bytes in one operation? */
1406
1407 addr = allocate_space_in_inferior (nelem * typelength);
1408 for (idx = 0; idx < nelem; idx++)
1409 {
1410 write_memory (addr + (idx * typelength), VALUE_CONTENTS (elemvec[idx]),
1411 typelength);
1412 }
1413
1414 /* Create the array type and set up an array value to be evaluated lazily. */
1415
a163ddec
MT
1416 val = value_at_lazy (arraytype, addr);
1417 return (val);
1418}
1419
1420/* Create a value for a string constant by allocating space in the inferior,
1421 copying the data into that space, and returning the address with type
1422 TYPE_CODE_STRING. PTR points to the string constant data; LEN is number
1423 of characters.
1424 Note that string types are like array of char types with a lower bound of
1425 zero and an upper bound of LEN - 1. Also note that the string may contain
1426 embedded null bytes. */
1427
a91a6192 1428value_ptr
a163ddec
MT
1429value_string (ptr, len)
1430 char *ptr;
1431 int len;
1432{
a91a6192 1433 value_ptr val;
5222ca60 1434 int lowbound = current_language->string_lower_bound;
f91a9e05 1435 struct type *rangetype = create_range_type ((struct type *) NULL,
5222ca60
PB
1436 builtin_type_int,
1437 lowbound, len + lowbound - 1);
f91a9e05
PB
1438 struct type *stringtype
1439 = create_string_type ((struct type *) NULL, rangetype);
a163ddec
MT
1440 CORE_ADDR addr;
1441
f91a9e05
PB
1442 if (current_language->c_style_arrays == 0)
1443 {
1444 val = allocate_value (stringtype);
1445 memcpy (VALUE_CONTENTS_RAW (val), ptr, len);
1446 return val;
1447 }
1448
1449
a163ddec
MT
1450 /* Allocate space to store the string in the inferior, and then
1451 copy LEN bytes from PTR in gdb to that address in the inferior. */
1452
1453 addr = allocate_space_in_inferior (len);
1454 write_memory (addr, ptr, len);
1455
a163ddec
MT
1456 val = value_at_lazy (stringtype, addr);
1457 return (val);
bd5635a1 1458}
6d34c236
PB
1459
1460value_ptr
1461value_bitstring (ptr, len)
1462 char *ptr;
1463 int len;
1464{
1465 value_ptr val;
1466 struct type *domain_type = create_range_type (NULL, builtin_type_int,
1467 0, len - 1);
1468 struct type *type = create_set_type ((struct type*) NULL, domain_type);
1469 TYPE_CODE (type) = TYPE_CODE_BITSTRING;
1470 val = allocate_value (type);
b4680522 1471 memcpy (VALUE_CONTENTS_RAW (val), ptr, TYPE_LENGTH (type));
6d34c236
PB
1472 return val;
1473}
bd5635a1 1474\f
479fdd26
JK
1475/* See if we can pass arguments in T2 to a function which takes arguments
1476 of types T1. Both t1 and t2 are NULL-terminated vectors. If some
1477 arguments need coercion of some sort, then the coerced values are written
1478 into T2. Return value is 0 if the arguments could be matched, or the
1479 position at which they differ if not.
a163ddec
MT
1480
1481 STATICP is nonzero if the T1 argument list came from a
1482 static member function.
1483
1484 For non-static member functions, we ignore the first argument,
1485 which is the type of the instance variable. This is because we want
1486 to handle calls with objects from derived classes. This is not
1487 entirely correct: we should actually check to make sure that a
1488 requested operation is type secure, shouldn't we? FIXME. */
1489
1490static int
1491typecmp (staticp, t1, t2)
1492 int staticp;
1493 struct type *t1[];
a91a6192 1494 value_ptr t2[];
a163ddec
MT
1495{
1496 int i;
1497
1498 if (t2 == 0)
1499 return 1;
1500 if (staticp && t1 == 0)
1501 return t2[1] != 0;
1502 if (t1 == 0)
1503 return 1;
1504 if (TYPE_CODE (t1[0]) == TYPE_CODE_VOID) return 0;
1505 if (t1[!staticp] == 0) return 0;
1506 for (i = !staticp; t1[i] && TYPE_CODE (t1[i]) != TYPE_CODE_VOID; i++)
1507 {
40620258 1508 struct type *tt1, *tt2;
a163ddec
MT
1509 if (! t2[i])
1510 return i+1;
5e548861
PB
1511 tt1 = check_typedef (t1[i]);
1512 tt2 = check_typedef (VALUE_TYPE(t2[i]));
40620258 1513 if (TYPE_CODE (tt1) == TYPE_CODE_REF
479fdd26 1514 /* We should be doing hairy argument matching, as below. */
5e548861 1515 && (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (tt1))) == TYPE_CODE (tt2)))
479fdd26 1516 {
09af5868 1517 if (TYPE_CODE (tt2) == TYPE_CODE_ARRAY)
2b576293
C
1518 t2[i] = value_coerce_array (t2[i]);
1519 else
1520 t2[i] = value_addr (t2[i]);
479fdd26
JK
1521 continue;
1522 }
1523
40620258 1524 while (TYPE_CODE (tt1) == TYPE_CODE_PTR
5e548861
PB
1525 && ( TYPE_CODE (tt2) == TYPE_CODE_ARRAY
1526 || TYPE_CODE (tt2) == TYPE_CODE_PTR))
40620258 1527 {
5e548861
PB
1528 tt1 = check_typedef (TYPE_TARGET_TYPE(tt1));
1529 tt2 = check_typedef (TYPE_TARGET_TYPE(tt2));
40620258
KH
1530 }
1531 if (TYPE_CODE(tt1) == TYPE_CODE(tt2)) continue;
1532 /* Array to pointer is a `trivial conversion' according to the ARM. */
479fdd26
JK
1533
1534 /* We should be doing much hairier argument matching (see section 13.2
1535 of the ARM), but as a quick kludge, just check for the same type
1536 code. */
a163ddec
MT
1537 if (TYPE_CODE (t1[i]) != TYPE_CODE (VALUE_TYPE (t2[i])))
1538 return i+1;
1539 }
1540 if (!t1[i]) return 0;
1541 return t2[i] ? i+1 : 0;
1542}
1543
bd5635a1
RP
1544/* Helper function used by value_struct_elt to recurse through baseclasses.
1545 Look for a field NAME in ARG1. Adjust the address of ARG1 by OFFSET bytes,
2a5ec41d 1546 and search in it assuming it has (class) type TYPE.
d3bab255
JK
1547 If found, return value, else return NULL.
1548
1549 If LOOKING_FOR_BASECLASS, then instead of looking for struct fields,
1550 look for a baseclass named NAME. */
bd5635a1 1551
a91a6192 1552static value_ptr
d3bab255 1553search_struct_field (name, arg1, offset, type, looking_for_baseclass)
bd5635a1 1554 char *name;
a91a6192 1555 register value_ptr arg1;
bd5635a1
RP
1556 int offset;
1557 register struct type *type;
d3bab255 1558 int looking_for_baseclass;
bd5635a1
RP
1559{
1560 int i;
1561
5e548861 1562 CHECK_TYPEDEF (type);
bd5635a1 1563
d3bab255
JK
1564 if (! looking_for_baseclass)
1565 for (i = TYPE_NFIELDS (type) - 1; i >= TYPE_N_BASECLASSES (type); i--)
1566 {
1567 char *t_field_name = TYPE_FIELD_NAME (type, i);
1568
2e4964ad 1569 if (t_field_name && STREQ (t_field_name, name))
d3bab255 1570 {
a91a6192 1571 value_ptr v;
01be6913
PB
1572 if (TYPE_FIELD_STATIC (type, i))
1573 {
1574 char *phys_name = TYPE_FIELD_STATIC_PHYSNAME (type, i);
1575 struct symbol *sym =
2e4964ad
FF
1576 lookup_symbol (phys_name, 0, VAR_NAMESPACE, 0, NULL);
1577 if (sym == NULL)
1578 error ("Internal error: could not find physical static variable named %s",
1579 phys_name);
01be6913
PB
1580 v = value_at (TYPE_FIELD_TYPE (type, i),
1581 (CORE_ADDR)SYMBOL_BLOCK_VALUE (sym));
1582 }
1583 else
1584 v = value_primitive_field (arg1, offset, i, type);
d3bab255
JK
1585 if (v == 0)
1586 error("there is no field named %s", name);
1587 return v;
1588 }
37d190e0 1589
4c2260aa
PB
1590 if (t_field_name
1591 && (t_field_name[0] == '\0'
1592 || (TYPE_CODE (type) == TYPE_CODE_UNION
1593 && STREQ (t_field_name, "else"))))
6d34c236 1594 {
37d190e0
PB
1595 struct type *field_type = TYPE_FIELD_TYPE (type, i);
1596 if (TYPE_CODE (field_type) == TYPE_CODE_UNION
1597 || TYPE_CODE (field_type) == TYPE_CODE_STRUCT)
1598 {
1599 /* Look for a match through the fields of an anonymous union,
1600 or anonymous struct. C++ provides anonymous unions.
1601
1602 In the GNU Chill implementation of variant record types,
1603 each <alternative field> has an (anonymous) union type,
1604 each member of the union represents a <variant alternative>.
1605 Each <variant alternative> is represented as a struct,
1606 with a member for each <variant field>. */
1607
1608 value_ptr v;
1609 int new_offset = offset;
1610
1611 /* This is pretty gross. In G++, the offset in an anonymous
1612 union is relative to the beginning of the enclosing struct.
1613 In the GNU Chill implementation of variant records,
1614 the bitpos is zero in an anonymous union field, so we
1615 have to add the offset of the union here. */
1616 if (TYPE_CODE (field_type) == TYPE_CODE_STRUCT
1617 || (TYPE_NFIELDS (field_type) > 0
1618 && TYPE_FIELD_BITPOS (field_type, 0) == 0))
1619 new_offset += TYPE_FIELD_BITPOS (type, i) / 8;
1620
1621 v = search_struct_field (name, arg1, new_offset, field_type,
1622 looking_for_baseclass);
1623 if (v)
1624 return v;
1625 }
6d34c236 1626 }
d3bab255 1627 }
bd5635a1
RP
1628
1629 for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
1630 {
a91a6192 1631 value_ptr v;
5e548861 1632 struct type *basetype = check_typedef (TYPE_BASECLASS (type, i));
bd5635a1 1633 /* If we are looking for baseclasses, this is what we get when we
54023465
JK
1634 hit them. But it could happen that the base part's member name
1635 is not yet filled in. */
d3bab255 1636 int found_baseclass = (looking_for_baseclass
54023465 1637 && TYPE_BASECLASS_NAME (type, i) != NULL
2e4964ad 1638 && STREQ (name, TYPE_BASECLASS_NAME (type, i)));
bd5635a1
RP
1639
1640 if (BASETYPE_VIA_VIRTUAL (type, i))
1641 {
5e548861
PB
1642 int boffset = VALUE_OFFSET (arg1) + offset;
1643 boffset = baseclass_offset (type, i,
1644 VALUE_CONTENTS (arg1) + boffset,
1645 VALUE_ADDRESS (arg1) + boffset);
1646 if (boffset == -1)
bd5635a1
RP
1647 error ("virtual baseclass botch");
1648 if (found_baseclass)
5e548861
PB
1649 {
1650 value_ptr v2 = allocate_value (basetype);
1651 VALUE_LVAL (v2) = VALUE_LVAL (arg1);
1652 VALUE_ADDRESS (v2) = VALUE_ADDRESS (arg1);
1653 VALUE_OFFSET (v2) = VALUE_OFFSET (arg1) + offset + boffset;
1654 if (VALUE_LAZY (arg1))
1655 VALUE_LAZY (v2) = 1;
1656 else
1657 memcpy (VALUE_CONTENTS_RAW (v2),
1658 VALUE_CONTENTS_RAW (arg1) + offset + boffset,
1659 TYPE_LENGTH (basetype));
1660 return v2;
1661 }
1662 v = search_struct_field (name, arg1, offset + boffset,
1663 TYPE_BASECLASS (type, i),
d3bab255 1664 looking_for_baseclass);
bd5635a1 1665 }
01be6913 1666 else if (found_baseclass)
bd5635a1
RP
1667 v = value_primitive_field (arg1, offset, i, type);
1668 else
1669 v = search_struct_field (name, arg1,
1670 offset + TYPE_BASECLASS_BITPOS (type, i) / 8,
5e548861 1671 basetype, looking_for_baseclass);
bd5635a1
RP
1672 if (v) return v;
1673 }
1674 return NULL;
1675}
1676
1677/* Helper function used by value_struct_elt to recurse through baseclasses.
1678 Look for a field NAME in ARG1. Adjust the address of ARG1 by OFFSET bytes,
2a5ec41d 1679 and search in it assuming it has (class) type TYPE.
cef4c2e7 1680 If found, return value, else if name matched and args not return (value)-1,
5b5c6d94 1681 else return NULL. */
bd5635a1 1682
a91a6192 1683static value_ptr
bac89d6c 1684search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
bd5635a1 1685 char *name;
a91a6192 1686 register value_ptr *arg1p, *args;
bd5635a1
RP
1687 int offset, *static_memfuncp;
1688 register struct type *type;
1689{
1690 int i;
a91a6192 1691 value_ptr v;
67e9b3b3 1692 int name_matched = 0;
6ebc9cdd 1693 char dem_opname[64];
bd5635a1 1694
5e548861 1695 CHECK_TYPEDEF (type);
bd5635a1
RP
1696 for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; i--)
1697 {
1698 char *t_field_name = TYPE_FN_FIELDLIST_NAME (type, i);
6ebc9cdd
KH
1699 if (strncmp(t_field_name, "__", 2)==0 ||
1700 strncmp(t_field_name, "op", 2)==0 ||
1701 strncmp(t_field_name, "type", 4)==0 )
1702 {
1703 if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
1704 t_field_name = dem_opname;
1705 else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
1706 t_field_name = dem_opname;
1707 }
2e4964ad 1708 if (t_field_name && STREQ (t_field_name, name))
bd5635a1 1709 {
d3bab255 1710 int j = TYPE_FN_FIELDLIST_LENGTH (type, i) - 1;
bd5635a1 1711 struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
5b5c6d94 1712 name_matched = 1;
bd5635a1 1713
d3bab255
JK
1714 if (j > 0 && args == 0)
1715 error ("cannot resolve overloaded method `%s'", name);
1716 while (j >= 0)
bd5635a1 1717 {
8e9a3f3b 1718 if (TYPE_FN_FIELD_STUB (f, j))
bd5635a1
RP
1719 check_stub_method (type, i, j);
1720 if (!typecmp (TYPE_FN_FIELD_STATIC_P (f, j),
1721 TYPE_FN_FIELD_ARGS (f, j), args))
1722 {
1723 if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
a91a6192 1724 return value_virtual_fn_field (arg1p, f, j, type, offset);
bd5635a1
RP
1725 if (TYPE_FN_FIELD_STATIC_P (f, j) && static_memfuncp)
1726 *static_memfuncp = 1;
a91a6192
SS
1727 v = value_fn_field (arg1p, f, j, type, offset);
1728 if (v != NULL) return v;
bd5635a1 1729 }
d3bab255 1730 j--;
bd5635a1
RP
1731 }
1732 }
1733 }
1734
1735 for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
1736 {
01be6913 1737 int base_offset;
bd5635a1
RP
1738
1739 if (BASETYPE_VIA_VIRTUAL (type, i))
1740 {
5e548861
PB
1741 base_offset = VALUE_OFFSET (*arg1p) + offset;
1742 base_offset =
1743 baseclass_offset (type, i,
1744 VALUE_CONTENTS (*arg1p) + base_offset,
1745 VALUE_ADDRESS (*arg1p) + base_offset);
bac89d6c 1746 if (base_offset == -1)
bd5635a1 1747 error ("virtual baseclass botch");
bd5635a1 1748 }
01be6913
PB
1749 else
1750 {
01be6913
PB
1751 base_offset = TYPE_BASECLASS_BITPOS (type, i) / 8;
1752 }
bac89d6c 1753 v = search_struct_method (name, arg1p, args, base_offset + offset,
bd5635a1 1754 static_memfuncp, TYPE_BASECLASS (type, i));
a91a6192 1755 if (v == (value_ptr) -1)
5b5c6d94
KH
1756 {
1757 name_matched = 1;
1758 }
1759 else if (v)
bac89d6c
FF
1760 {
1761/* FIXME-bothner: Why is this commented out? Why is it here? */
1762/* *arg1p = arg1_tmp;*/
1763 return v;
1764 }
bd5635a1 1765 }
a91a6192 1766 if (name_matched) return (value_ptr) -1;
5b5c6d94 1767 else return NULL;
bd5635a1
RP
1768}
1769
1770/* Given *ARGP, a value of type (pointer to a)* structure/union,
1771 extract the component named NAME from the ultimate target structure/union
1772 and return it as a value with its appropriate type.
1773 ERR is used in the error message if *ARGP's type is wrong.
1774
1775 C++: ARGS is a list of argument types to aid in the selection of
1776 an appropriate method. Also, handle derived types.
1777
1778 STATIC_MEMFUNCP, if non-NULL, points to a caller-supplied location
1779 where the truthvalue of whether the function that was resolved was
1780 a static member function or not is stored.
1781
1782 ERR is an error message to be printed in case the field is not found. */
1783
a91a6192 1784value_ptr
bd5635a1 1785value_struct_elt (argp, args, name, static_memfuncp, err)
a91a6192 1786 register value_ptr *argp, *args;
bd5635a1
RP
1787 char *name;
1788 int *static_memfuncp;
1789 char *err;
1790{
1791 register struct type *t;
a91a6192 1792 value_ptr v;
bd5635a1
RP
1793
1794 COERCE_ARRAY (*argp);
1795
5e548861 1796 t = check_typedef (VALUE_TYPE (*argp));
bd5635a1
RP
1797
1798 /* Follow pointers until we get to a non-pointer. */
1799
1800 while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
1801 {
bd5635a1 1802 *argp = value_ind (*argp);
f2ebc25f
JK
1803 /* Don't coerce fn pointer to fn and then back again! */
1804 if (TYPE_CODE (VALUE_TYPE (*argp)) != TYPE_CODE_FUNC)
1805 COERCE_ARRAY (*argp);
5e548861 1806 t = check_typedef (VALUE_TYPE (*argp));
bd5635a1
RP
1807 }
1808
1809 if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
1810 error ("not implemented: member type in value_struct_elt");
1811
2a5ec41d 1812 if ( TYPE_CODE (t) != TYPE_CODE_STRUCT
bd5635a1
RP
1813 && TYPE_CODE (t) != TYPE_CODE_UNION)
1814 error ("Attempt to extract a component of a value that is not a %s.", err);
1815
1816 /* Assume it's not, unless we see that it is. */
1817 if (static_memfuncp)
1818 *static_memfuncp =0;
1819
1820 if (!args)
1821 {
1822 /* if there are no arguments ...do this... */
1823
d3bab255 1824 /* Try as a field first, because if we succeed, there
bd5635a1 1825 is less work to be done. */
d3bab255 1826 v = search_struct_field (name, *argp, 0, t, 0);
bd5635a1
RP
1827 if (v)
1828 return v;
1829
1830 /* C++: If it was not found as a data field, then try to
1831 return it as a pointer to a method. */
1832
1833 if (destructor_name_p (name, t))
1834 error ("Cannot get value of destructor");
1835
bac89d6c 1836 v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
bd5635a1 1837
a91a6192 1838 if (v == (value_ptr) -1)
67e9b3b3
PS
1839 error ("Cannot take address of a method");
1840 else if (v == 0)
bd5635a1
RP
1841 {
1842 if (TYPE_NFN_FIELDS (t))
1843 error ("There is no member or method named %s.", name);
1844 else
1845 error ("There is no member named %s.", name);
1846 }
1847 return v;
1848 }
1849
1850 if (destructor_name_p (name, t))
1851 {
1852 if (!args[1])
1853 {
1854 /* destructors are a special case. */
a91a6192
SS
1855 v = value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, 0),
1856 TYPE_FN_FIELDLIST_LENGTH (t, 0), 0, 0);
40620258
KH
1857 if (!v) error("could not find destructor function named %s.", name);
1858 else return v;
bd5635a1
RP
1859 }
1860 else
1861 {
1862 error ("destructor should not have any argument");
1863 }
1864 }
1865 else
bac89d6c 1866 v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
bd5635a1 1867
a91a6192 1868 if (v == (value_ptr) -1)
5b5c6d94
KH
1869 {
1870 error("Argument list of %s mismatch with component in the structure.", name);
1871 }
1872 else if (v == 0)
bd5635a1
RP
1873 {
1874 /* See if user tried to invoke data as function. If so,
1875 hand it back. If it's not callable (i.e., a pointer to function),
1876 gdb should give an error. */
d3bab255 1877 v = search_struct_field (name, *argp, 0, t, 0);
bd5635a1
RP
1878 }
1879
1880 if (!v)
1881 error ("Structure has no component named %s.", name);
1882 return v;
1883}
1884
1885/* C++: return 1 is NAME is a legitimate name for the destructor
1886 of type TYPE. If TYPE does not have a destructor, or
1887 if NAME is inappropriate for TYPE, an error is signaled. */
1888int
1889destructor_name_p (name, type)
7919c3ed
JG
1890 const char *name;
1891 const struct type *type;
bd5635a1
RP
1892{
1893 /* destructors are a special case. */
1894
1895 if (name[0] == '~')
1896 {
1897 char *dname = type_name_no_tag (type);
6d34c236
PB
1898 char *cp = strchr (dname, '<');
1899 int len;
1900
1901 /* Do not compare the template part for template classes. */
1902 if (cp == NULL)
1903 len = strlen (dname);
1904 else
1905 len = cp - dname;
1906 if (strlen (name + 1) != len || !STREQN (dname, name + 1, len))
bd5635a1
RP
1907 error ("name of destructor must equal name of class");
1908 else
1909 return 1;
1910 }
1911 return 0;
1912}
1913
1914/* Helper function for check_field: Given TYPE, a structure/union,
1915 return 1 if the component named NAME from the ultimate
1916 target structure/union is defined, otherwise, return 0. */
1917
1918static int
1919check_field_in (type, name)
1920 register struct type *type;
01be6913 1921 const char *name;
bd5635a1
RP
1922{
1923 register int i;
1924
1925 for (i = TYPE_NFIELDS (type) - 1; i >= TYPE_N_BASECLASSES (type); i--)
1926 {
1927 char *t_field_name = TYPE_FIELD_NAME (type, i);
2e4964ad 1928 if (t_field_name && STREQ (t_field_name, name))
bd5635a1
RP
1929 return 1;
1930 }
1931
1932 /* C++: If it was not found as a data field, then try to
1933 return it as a pointer to a method. */
1934
1935 /* Destructors are a special case. */
1936 if (destructor_name_p (name, type))
1937 return 1;
1938
1939 for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; --i)
1940 {
2e4964ad 1941 if (STREQ (TYPE_FN_FIELDLIST_NAME (type, i), name))
bd5635a1
RP
1942 return 1;
1943 }
1944
1945 for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
1946 if (check_field_in (TYPE_BASECLASS (type, i), name))
1947 return 1;
1948
1949 return 0;
1950}
1951
1952
1953/* C++: Given ARG1, a value of type (pointer to a)* structure/union,
1954 return 1 if the component named NAME from the ultimate
1955 target structure/union is defined, otherwise, return 0. */
1956
1957int
1958check_field (arg1, name)
a91a6192 1959 register value_ptr arg1;
7919c3ed 1960 const char *name;
bd5635a1
RP
1961{
1962 register struct type *t;
1963
1964 COERCE_ARRAY (arg1);
1965
1966 t = VALUE_TYPE (arg1);
1967
1968 /* Follow pointers until we get to a non-pointer. */
1969
5e548861
PB
1970 for (;;)
1971 {
1972 CHECK_TYPEDEF (t);
1973 if (TYPE_CODE (t) != TYPE_CODE_PTR && TYPE_CODE (t) != TYPE_CODE_REF)
1974 break;
1975 t = TYPE_TARGET_TYPE (t);
1976 }
bd5635a1
RP
1977
1978 if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
1979 error ("not implemented: member type in check_field");
1980
2a5ec41d 1981 if ( TYPE_CODE (t) != TYPE_CODE_STRUCT
bd5635a1
RP
1982 && TYPE_CODE (t) != TYPE_CODE_UNION)
1983 error ("Internal error: `this' is not an aggregate");
1984
1985 return check_field_in (t, name);
1986}
1987
01be6913 1988/* C++: Given an aggregate type CURTYPE, and a member name NAME,
2a5ec41d 1989 return the address of this member as a "pointer to member"
bd5635a1
RP
1990 type. If INTYPE is non-null, then it will be the type
1991 of the member we are looking for. This will help us resolve
01be6913
PB
1992 "pointers to member functions". This function is used
1993 to resolve user expressions of the form "DOMAIN::NAME". */
bd5635a1 1994
a91a6192 1995value_ptr
51b57ded 1996value_struct_elt_for_reference (domain, offset, curtype, name, intype)
01be6913 1997 struct type *domain, *curtype, *intype;
51b57ded 1998 int offset;
bd5635a1
RP
1999 char *name;
2000{
01be6913 2001 register struct type *t = curtype;
bd5635a1 2002 register int i;
a91a6192 2003 value_ptr v;
bd5635a1 2004
2a5ec41d 2005 if ( TYPE_CODE (t) != TYPE_CODE_STRUCT
bd5635a1 2006 && TYPE_CODE (t) != TYPE_CODE_UNION)
01be6913 2007 error ("Internal error: non-aggregate type to value_struct_elt_for_reference");
bd5635a1 2008
01be6913 2009 for (i = TYPE_NFIELDS (t) - 1; i >= TYPE_N_BASECLASSES (t); i--)
bd5635a1 2010 {
01be6913
PB
2011 char *t_field_name = TYPE_FIELD_NAME (t, i);
2012
2e4964ad 2013 if (t_field_name && STREQ (t_field_name, name))
bd5635a1 2014 {
01be6913 2015 if (TYPE_FIELD_STATIC (t, i))
bd5635a1 2016 {
01be6913
PB
2017 char *phys_name = TYPE_FIELD_STATIC_PHYSNAME (t, i);
2018 struct symbol *sym =
2019 lookup_symbol (phys_name, 0, VAR_NAMESPACE, 0, NULL);
2e4964ad
FF
2020 if (sym == NULL)
2021 error ("Internal error: could not find physical static variable named %s",
01be6913
PB
2022 phys_name);
2023 return value_at (SYMBOL_TYPE (sym),
2024 (CORE_ADDR)SYMBOL_BLOCK_VALUE (sym));
bd5635a1 2025 }
01be6913
PB
2026 if (TYPE_FIELD_PACKED (t, i))
2027 error ("pointers to bitfield members not allowed");
2028
2029 return value_from_longest
2030 (lookup_reference_type (lookup_member_type (TYPE_FIELD_TYPE (t, i),
2031 domain)),
51b57ded 2032 offset + (LONGEST) (TYPE_FIELD_BITPOS (t, i) >> 3));
bd5635a1 2033 }
bd5635a1
RP
2034 }
2035
2036 /* C++: If it was not found as a data field, then try to
2037 return it as a pointer to a method. */
bd5635a1
RP
2038
2039 /* Destructors are a special case. */
2040 if (destructor_name_p (name, t))
2041 {
2a5ec41d 2042 error ("member pointers to destructors not implemented yet");
bd5635a1
RP
2043 }
2044
2045 /* Perform all necessary dereferencing. */
2046 while (intype && TYPE_CODE (intype) == TYPE_CODE_PTR)
2047 intype = TYPE_TARGET_TYPE (intype);
2048
01be6913 2049 for (i = TYPE_NFN_FIELDS (t) - 1; i >= 0; --i)
bd5635a1 2050 {
852b3831
PB
2051 char *t_field_name = TYPE_FN_FIELDLIST_NAME (t, i);
2052 char dem_opname[64];
2053
2054 if (strncmp(t_field_name, "__", 2)==0 ||
2055 strncmp(t_field_name, "op", 2)==0 ||
2056 strncmp(t_field_name, "type", 4)==0 )
2057 {
2058 if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
2059 t_field_name = dem_opname;
2060 else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
2061 t_field_name = dem_opname;
2062 }
2063 if (t_field_name && STREQ (t_field_name, name))
bd5635a1 2064 {
01be6913
PB
2065 int j = TYPE_FN_FIELDLIST_LENGTH (t, i);
2066 struct fn_field *f = TYPE_FN_FIELDLIST1 (t, i);
2067
2068 if (intype == 0 && j > 1)
2069 error ("non-unique member `%s' requires type instantiation", name);
2070 if (intype)
bd5635a1 2071 {
01be6913
PB
2072 while (j--)
2073 if (TYPE_FN_FIELD_TYPE (f, j) == intype)
2074 break;
2075 if (j < 0)
2076 error ("no member function matches that type instantiation");
2077 }
2078 else
2079 j = 0;
2080
2081 if (TYPE_FN_FIELD_STUB (f, j))
2082 check_stub_method (t, i, j);
2083 if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
2084 {
2085 return value_from_longest
2086 (lookup_reference_type
2087 (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
2088 domain)),
13ffa6be 2089 (LONGEST) METHOD_PTR_FROM_VOFFSET (TYPE_FN_FIELD_VOFFSET (f, j)));
01be6913
PB
2090 }
2091 else
2092 {
2093 struct symbol *s = lookup_symbol (TYPE_FN_FIELD_PHYSNAME (f, j),
2094 0, VAR_NAMESPACE, 0, NULL);
35fcebce
PB
2095 if (s == NULL)
2096 {
2097 v = 0;
2098 }
2099 else
2100 {
2101 v = read_var_value (s, 0);
01be6913 2102#if 0
35fcebce
PB
2103 VALUE_TYPE (v) = lookup_reference_type
2104 (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
2105 domain));
01be6913 2106#endif
bd5635a1 2107 }
35fcebce 2108 return v;
bd5635a1
RP
2109 }
2110 }
35fcebce 2111 }
01be6913
PB
2112 for (i = TYPE_N_BASECLASSES (t) - 1; i >= 0; i--)
2113 {
a91a6192 2114 value_ptr v;
51b57ded
FF
2115 int base_offset;
2116
2117 if (BASETYPE_VIA_VIRTUAL (t, i))
2118 base_offset = 0;
2119 else
2120 base_offset = TYPE_BASECLASS_BITPOS (t, i) / 8;
01be6913 2121 v = value_struct_elt_for_reference (domain,
51b57ded 2122 offset + base_offset,
01be6913
PB
2123 TYPE_BASECLASS (t, i),
2124 name,
2125 intype);
2126 if (v)
2127 return v;
bd5635a1
RP
2128 }
2129 return 0;
2130}
2131
bd5635a1
RP
2132/* C++: return the value of the class instance variable, if one exists.
2133 Flag COMPLAIN signals an error if the request is made in an
2134 inappropriate context. */
6d34c236 2135
a91a6192 2136value_ptr
bd5635a1
RP
2137value_of_this (complain)
2138 int complain;
2139{
bd5635a1
RP
2140 struct symbol *func, *sym;
2141 struct block *b;
2142 int i;
2143 static const char funny_this[] = "this";
a91a6192 2144 value_ptr this;
bd5635a1
RP
2145
2146 if (selected_frame == 0)
2147 if (complain)
2148 error ("no frame selected");
2149 else return 0;
2150
2151 func = get_frame_function (selected_frame);
2152 if (!func)
2153 {
2154 if (complain)
2155 error ("no `this' in nameless context");
2156 else return 0;
2157 }
2158
2159 b = SYMBOL_BLOCK_VALUE (func);
2160 i = BLOCK_NSYMS (b);
2161 if (i <= 0)
2162 if (complain)
2163 error ("no args, no `this'");
2164 else return 0;
2165
2166 /* Calling lookup_block_symbol is necessary to get the LOC_REGISTER
2167 symbol instead of the LOC_ARG one (if both exist). */
2168 sym = lookup_block_symbol (b, funny_this, VAR_NAMESPACE);
2169 if (sym == NULL)
2170 {
2171 if (complain)
2172 error ("current stack frame not in method");
2173 else
2174 return NULL;
2175 }
2176
2177 this = read_var_value (sym, selected_frame);
2178 if (this == 0 && complain)
2179 error ("`this' argument at unknown address");
2180 return this;
2181}
a91a6192 2182
f91a9e05
PB
2183/* Create a slice (sub-string, sub-array) of ARRAY, that is LENGTH elements
2184 long, starting at LOWBOUND. The result has the same lower bound as
2185 the original ARRAY. */
2186
2187value_ptr
2188value_slice (array, lowbound, length)
2189 value_ptr array;
2190 int lowbound, length;
2191{
5f3e7bfc
PB
2192 struct type *slice_range_type, *slice_type, *range_type;
2193 LONGEST lowerbound, upperbound, offset;
2194 value_ptr slice;
5e548861
PB
2195 struct type *array_type;
2196 array_type = check_typedef (VALUE_TYPE (array));
2197 COERCE_VARYING_ARRAY (array, array_type);
5e548861 2198 if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
5f3e7bfc
PB
2199 && TYPE_CODE (array_type) != TYPE_CODE_STRING
2200 && TYPE_CODE (array_type) != TYPE_CODE_BITSTRING)
f91a9e05 2201 error ("cannot take slice of non-array");
5f3e7bfc
PB
2202 range_type = TYPE_INDEX_TYPE (array_type);
2203 if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
2204 error ("slice from bad array or bitstring");
2205 if (lowbound < lowerbound || length < 0
2206 || lowbound + length - 1 > upperbound
2207 /* Chill allows zero-length strings but not arrays. */
2208 || (current_language->la_language == language_chill
2209 && length == 0 && TYPE_CODE (array_type) == TYPE_CODE_ARRAY))
2210 error ("slice out of range");
2211 /* FIXME-type-allocation: need a way to free this type when we are
2212 done with it. */
2213 slice_range_type = create_range_type ((struct type*) NULL,
2214 TYPE_TARGET_TYPE (range_type),
2215 lowerbound, lowerbound + length - 1);
2216 if (TYPE_CODE (array_type) == TYPE_CODE_BITSTRING)
2217 {
2218 int i;
2219 slice_type = create_set_type ((struct type*) NULL, slice_range_type);
2220 TYPE_CODE (slice_type) = TYPE_CODE_BITSTRING;
2221 slice = value_zero (slice_type, not_lval);
2222 for (i = 0; i < length; i++)
2223 {
2224 int element = value_bit_index (array_type,
2225 VALUE_CONTENTS (array),
2226 lowbound + i);
2227 if (element < 0)
2228 error ("internal error accessing bitstring");
2229 else if (element > 0)
2230 {
2231 int j = i % TARGET_CHAR_BIT;
2232 if (BITS_BIG_ENDIAN)
2233 j = TARGET_CHAR_BIT - 1 - j;
2234 VALUE_CONTENTS_RAW (slice)[i / TARGET_CHAR_BIT] |= (1 << j);
2235 }
2236 }
2237 /* We should set the address, bitssize, and bitspos, so the clice
2238 can be used on the LHS, but that may require extensions to
2239 value_assign. For now, just leave as a non_lval. FIXME. */
2240 }
f91a9e05
PB
2241 else
2242 {
5e548861 2243 struct type *element_type = TYPE_TARGET_TYPE (array_type);
5e548861
PB
2244 offset
2245 = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
f91a9e05
PB
2246 slice_type = create_array_type ((struct type*) NULL, element_type,
2247 slice_range_type);
5e548861 2248 TYPE_CODE (slice_type) = TYPE_CODE (array_type);
f91a9e05
PB
2249 slice = allocate_value (slice_type);
2250 if (VALUE_LAZY (array))
2251 VALUE_LAZY (slice) = 1;
2252 else
2253 memcpy (VALUE_CONTENTS (slice), VALUE_CONTENTS (array) + offset,
2254 TYPE_LENGTH (slice_type));
2255 if (VALUE_LVAL (array) == lval_internalvar)
2256 VALUE_LVAL (slice) = lval_internalvar_component;
2257 else
2258 VALUE_LVAL (slice) = VALUE_LVAL (array);
2259 VALUE_ADDRESS (slice) = VALUE_ADDRESS (array);
2260 VALUE_OFFSET (slice) = VALUE_OFFSET (array) + offset;
f91a9e05 2261 }
5f3e7bfc 2262 return slice;
f91a9e05
PB
2263}
2264
2265/* Assuming chill_varying_type (VARRAY) is true, return an equivalent
2266 value as a fixed-length array. */
2267
2268value_ptr
2269varying_to_slice (varray)
2270 value_ptr varray;
2271{
5e548861 2272 struct type *vtype = check_typedef (VALUE_TYPE (varray));
f91a9e05
PB
2273 LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
2274 VALUE_CONTENTS (varray)
2275 + TYPE_FIELD_BITPOS (vtype, 0) / 8);
2276 return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length);
2277}
2278
a91a6192
SS
2279/* Create a value for a FORTRAN complex number. Currently most of
2280 the time values are coerced to COMPLEX*16 (i.e. a complex number
2281 composed of 2 doubles. This really should be a smarter routine
2282 that figures out precision inteligently as opposed to assuming
2283 doubles. FIXME: fmb */
2284
2285value_ptr
5222ca60 2286value_literal_complex (arg1, arg2, type)
a91a6192
SS
2287 value_ptr arg1;
2288 value_ptr arg2;
5222ca60 2289 struct type *type;
a91a6192 2290{
a91a6192 2291 register value_ptr val;
5222ca60 2292 struct type *real_type = TYPE_TARGET_TYPE (type);
a91a6192 2293
5222ca60
PB
2294 val = allocate_value (type);
2295 arg1 = value_cast (real_type, arg1);
2296 arg2 = value_cast (real_type, arg2);
a91a6192 2297
5222ca60
PB
2298 memcpy (VALUE_CONTENTS_RAW (val),
2299 VALUE_CONTENTS (arg1), TYPE_LENGTH (real_type));
2300 memcpy (VALUE_CONTENTS_RAW (val) + TYPE_LENGTH (real_type),
2301 VALUE_CONTENTS (arg2), TYPE_LENGTH (real_type));
a91a6192
SS
2302 return val;
2303}
9ed8604f 2304
5222ca60 2305/* Cast a value into the appropriate complex data type. */
9ed8604f
PS
2306
2307static value_ptr
5222ca60 2308cast_into_complex (type, val)
9ed8604f
PS
2309 struct type *type;
2310 register value_ptr val;
2311{
5222ca60
PB
2312 struct type *real_type = TYPE_TARGET_TYPE (type);
2313 if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_COMPLEX)
9ed8604f 2314 {
5222ca60
PB
2315 struct type *val_real_type = TYPE_TARGET_TYPE (VALUE_TYPE (val));
2316 value_ptr re_val = allocate_value (val_real_type);
2317 value_ptr im_val = allocate_value (val_real_type);
9ed8604f 2318
5222ca60
PB
2319 memcpy (VALUE_CONTENTS_RAW (re_val),
2320 VALUE_CONTENTS (val), TYPE_LENGTH (val_real_type));
2321 memcpy (VALUE_CONTENTS_RAW (im_val),
2322 VALUE_CONTENTS (val) + TYPE_LENGTH (val_real_type),
2323 TYPE_LENGTH (val_real_type));
9ed8604f 2324
5222ca60 2325 return value_literal_complex (re_val, im_val, type);
9ed8604f 2326 }
5222ca60
PB
2327 else if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_FLT
2328 || TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_INT)
2329 return value_literal_complex (val, value_zero (real_type, not_lval), type);
9ed8604f 2330 else
5222ca60 2331 error ("cannot cast non-number to complex");
9ed8604f 2332}
5e548861
PB
2333
2334void
2335_initialize_valops ()
2336{
2337#if 0
2338 add_show_from_set
2339 (add_set_cmd ("abandon", class_support, var_boolean, (char *)&auto_abandon,
2340 "Set automatic abandonment of expressions upon failure.",
2341 &setlist),
2342 &showlist);
2343#endif
2344}
This page took 0.396404 seconds and 4 git commands to generate.