hp merge changes -- too numerous to mention here; see ChangeLog and
[external/binutils.git] / gdb / valops.c
1 /* Perform non-arithmetic operations on values, for GDB.
2    Copyright 1986, 87, 89, 91, 92, 93, 94, 95, 96, 97, 1998
3    Free Software Foundation, Inc.
4
5 This file is part of GDB.
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
20
21 #include "defs.h"
22 #include "symtab.h"
23 #include "gdbtypes.h"
24 #include "value.h"
25 #include "frame.h"
26 #include "inferior.h"
27 #include "gdbcore.h"
28 #include "target.h"
29 #include "demangle.h"
30 #include "language.h"
31 #include "gdbcmd.h"
32
33 #include <errno.h>
34 #include "gdb_string.h"
35
36 /* Default to coercing float to double in function calls only when there is
37    no prototype.  Otherwise on targets where the debug information is incorrect
38    for either the prototype or non-prototype case, we can force it by defining
39    COERCE_FLOAT_TO_DOUBLE in the target configuration file. */
40
41 #ifndef COERCE_FLOAT_TO_DOUBLE
42 #define COERCE_FLOAT_TO_DOUBLE (param_type == NULL)
43 #endif
44
45 /* Flag indicating HP compilers were used; needed to correctly handle some
46    value operations with HP aCC code/runtime. */
47 extern int hp_som_som_object_present;
48
49
50 /* Local functions.  */
51
52 static int typecmp PARAMS ((int staticp, struct type *t1[], value_ptr t2[]));
53
54 #ifdef CALL_DUMMY
55 static CORE_ADDR find_function_addr PARAMS ((value_ptr, struct type **));
56 static value_ptr value_arg_coerce PARAMS ((value_ptr, struct type *, int));
57 #endif
58
59
60 #ifndef PUSH_ARGUMENTS
61 static CORE_ADDR value_push PARAMS ((CORE_ADDR, value_ptr));
62 #endif
63
64 static value_ptr search_struct_field PARAMS ((char *, value_ptr, int,
65                                               struct type *, int));
66
67 static value_ptr search_struct_field_aux PARAMS ((char *, value_ptr, int,
68                                                   struct type *, int, int *, char *,
69                                                   struct type **));
70
71 static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
72                                                value_ptr *,
73                                                int, int *, struct type *));
74
75 static int check_field_in PARAMS ((struct type *, const char *));
76
77 static CORE_ADDR allocate_space_in_inferior PARAMS ((int));
78
79 static value_ptr cast_into_complex PARAMS ((struct type *, value_ptr));
80
81 void _initialize_valops PARAMS ((void));
82
83 #define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
84
85 /* Flag for whether we want to abandon failed expression evals by default.  */
86
87 #if 0
88 static int auto_abandon = 0;
89 #endif
90
91 int overload_resolution = 0;
92
93
94 \f
95 /* Find the address of function name NAME in the inferior.  */
96
97 value_ptr
98 find_function_in_inferior (name)
99      char *name;
100 {
101   register struct symbol *sym;
102   sym = lookup_symbol (name, 0, VAR_NAMESPACE, 0, NULL);
103   if (sym != NULL)
104     {
105       if (SYMBOL_CLASS (sym) != LOC_BLOCK)
106         {
107           error ("\"%s\" exists in this program but is not a function.",
108                  name);
109         }
110       return value_of_variable (sym, NULL);
111     }
112   else
113     {
114       struct minimal_symbol *msymbol = lookup_minimal_symbol(name, NULL, NULL);
115       if (msymbol != NULL)
116         {
117           struct type *type;
118           LONGEST maddr;
119           type = lookup_pointer_type (builtin_type_char);
120           type = lookup_function_type (type);
121           type = lookup_pointer_type (type);
122           maddr = (LONGEST) SYMBOL_VALUE_ADDRESS (msymbol);
123           return value_from_longest (type, maddr);
124         }
125       else
126         {
127           if (!target_has_execution)
128             error ("evaluation of this expression requires the target program to be active");
129           else
130             error ("evaluation of this expression requires the program to have a function \"%s\".", name);
131         }
132     }
133 }
134
135 /* Allocate NBYTES of space in the inferior using the inferior's malloc
136    and return a value that is a pointer to the allocated space. */
137
138 value_ptr
139 value_allocate_space_in_inferior (len)
140      int len;
141 {
142   value_ptr blocklen;
143   register value_ptr val = find_function_in_inferior ("malloc");
144
145   blocklen = value_from_longest (builtin_type_int, (LONGEST) len);
146   val = call_function_by_hand (val, 1, &blocklen);
147   if (value_logical_not (val))
148     {
149       if (!target_has_execution)
150         error ("No memory available to program now: you need to start the target first");
151       else 
152         error ("No memory available to program: call to malloc failed");
153     }
154   return val;
155 }
156
157 static CORE_ADDR
158 allocate_space_in_inferior (len)
159      int len;
160 {
161   return value_as_long (value_allocate_space_in_inferior (len));
162 }
163
164 /* Cast value ARG2 to type TYPE and return as a value.
165    More general than a C cast: accepts any two types of the same length,
166    and if ARG2 is an lvalue it can be cast into anything at all.  */
167 /* In C++, casts may change pointer or object representations.  */
168
169 value_ptr
170 value_cast (type, arg2)
171      struct type *type;
172      register value_ptr arg2;
173 {
174   register enum type_code code1;
175   register enum type_code code2;
176   register int scalar;
177   struct type *type2;
178
179   int convert_to_boolean = 0;
180   
181   if (VALUE_TYPE (arg2) == type)
182     return arg2;
183
184   CHECK_TYPEDEF (type);
185   code1 = TYPE_CODE (type);
186   COERCE_REF(arg2);
187   type2 = check_typedef (VALUE_TYPE (arg2));
188
189   /* A cast to an undetermined-length array_type, such as (TYPE [])OBJECT,
190      is treated like a cast to (TYPE [N])OBJECT,
191      where N is sizeof(OBJECT)/sizeof(TYPE). */
192   if (code1 == TYPE_CODE_ARRAY)
193     {
194       struct type *element_type = TYPE_TARGET_TYPE (type);
195       unsigned element_length = TYPE_LENGTH (check_typedef (element_type));
196       if (element_length > 0
197           && TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
198         {
199           struct type *range_type = TYPE_INDEX_TYPE (type);
200           int val_length = TYPE_LENGTH (type2);
201           LONGEST low_bound, high_bound, new_length;
202           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
203             low_bound = 0, high_bound = 0;
204           new_length = val_length / element_length;
205           if (val_length % element_length != 0)
206             warning("array element type size does not divide object size in cast");
207           /* FIXME-type-allocation: need a way to free this type when we are
208              done with it.  */
209           range_type = create_range_type ((struct type *) NULL,
210                                           TYPE_TARGET_TYPE (range_type),
211                                           low_bound,
212                                           new_length + low_bound - 1);
213           VALUE_TYPE (arg2) = create_array_type ((struct type *) NULL,
214                                                  element_type, range_type);
215           return arg2;
216         }
217     }
218
219   if (current_language->c_style_arrays
220       && TYPE_CODE (type2) == TYPE_CODE_ARRAY)
221     arg2 = value_coerce_array (arg2);
222
223   if (TYPE_CODE (type2) == TYPE_CODE_FUNC)
224     arg2 = value_coerce_function (arg2);
225
226   type2 = check_typedef (VALUE_TYPE (arg2));
227   COERCE_VARYING_ARRAY (arg2, type2);
228   code2 = TYPE_CODE (type2);
229
230   if (code1 == TYPE_CODE_COMPLEX)
231     return cast_into_complex (type, arg2);
232   if (code1 == TYPE_CODE_BOOL)
233     {
234       code1 = TYPE_CODE_INT;
235       convert_to_boolean = 1;
236     }
237   if (code1 == TYPE_CODE_CHAR)
238     code1 = TYPE_CODE_INT;
239   if (code2 == TYPE_CODE_BOOL || code2 == TYPE_CODE_CHAR)
240     code2 = TYPE_CODE_INT;
241
242   scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
243             || code2 == TYPE_CODE_ENUM || code2 == TYPE_CODE_RANGE);
244
245   if (   code1 == TYPE_CODE_STRUCT
246       && code2 == TYPE_CODE_STRUCT
247       && TYPE_NAME (type) != 0)
248     {
249       /* Look in the type of the source to see if it contains the
250          type of the target as a superclass.  If so, we'll need to
251          offset the object in addition to changing its type.  */
252       value_ptr v = search_struct_field (type_name_no_tag (type),
253                                          arg2, 0, type2, 1);
254       if (v)
255         {
256           VALUE_TYPE (v) = type;
257           return v;
258         }
259     }
260   if (code1 == TYPE_CODE_FLT && scalar)
261     return value_from_double (type, value_as_double (arg2));
262   else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM
263             || code1 == TYPE_CODE_RANGE)
264            && (scalar || code2 == TYPE_CODE_PTR))
265     {
266       LONGEST longest;
267       
268       if (hp_som_som_object_present &&  /* if target compiled by HP aCC */ 
269           (code2 == TYPE_CODE_PTR))
270         {
271           unsigned int * ptr;
272           value_ptr retvalp;
273           
274           switch (TYPE_CODE (TYPE_TARGET_TYPE (type2)))
275             {
276               /* With HP aCC, pointers to data members have a bias */ 
277               case TYPE_CODE_MEMBER:
278                 retvalp = value_from_longest (type, value_as_long (arg2));
279                 ptr = (unsigned int *) VALUE_CONTENTS (retvalp); /* force evaluation */
280                 *ptr &= ~0x20000000; /* zap 29th bit to remove bias */ 
281                 return retvalp;
282
283               /* While pointers to methods don't really point to a function */ 
284               case TYPE_CODE_METHOD:
285                 error ("Pointers to methods not supported with HP aCC");
286
287               default:
288                 break; /* fall out and go to normal handling */ 
289             }
290         }
291       longest = value_as_long (arg2);
292       return value_from_longest (type, convert_to_boolean ? (LONGEST) (longest ? 1 : 0) : longest);
293     }
294   else if (TYPE_LENGTH (type) == TYPE_LENGTH (type2))
295     {
296       if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
297         {
298           struct type *t1 = check_typedef (TYPE_TARGET_TYPE (type));
299           struct type *t2 = check_typedef (TYPE_TARGET_TYPE (type2));
300           if (   TYPE_CODE (t1) == TYPE_CODE_STRUCT
301               && TYPE_CODE (t2) == TYPE_CODE_STRUCT
302               && !value_logical_not (arg2))
303             {
304               value_ptr v;
305
306               /* Look in the type of the source to see if it contains the
307                  type of the target as a superclass.  If so, we'll need to
308                  offset the pointer rather than just change its type.  */
309               if (TYPE_NAME (t1) != NULL)
310                 {
311                   v = search_struct_field (type_name_no_tag (t1),
312                                            value_ind (arg2), 0, t2, 1);
313                   if (v)
314                     {
315                       v = value_addr (v);
316                       VALUE_TYPE (v) = type;
317                       return v;
318                     }
319                 }
320
321               /* Look in the type of the target to see if it contains the
322                  type of the source as a superclass.  If so, we'll need to
323                  offset the pointer rather than just change its type.
324                  FIXME: This fails silently with virtual inheritance.  */
325               if (TYPE_NAME (t2) != NULL)
326                 {
327                   v = search_struct_field (type_name_no_tag (t2),
328                                            value_zero (t1, not_lval), 0, t1, 1);
329                   if (v)
330                     {
331                       value_ptr v2 = value_ind (arg2);
332                       VALUE_ADDRESS (v2) -= VALUE_ADDRESS (v)
333                                             + VALUE_OFFSET (v);
334                       v2 = value_addr (v2);
335                       VALUE_TYPE (v2) = type;
336                       return v2;
337                     }
338                 }
339             }
340           /* No superclass found, just fall through to change ptr type.  */
341         }
342       VALUE_TYPE (arg2) = type;
343       VALUE_ENCLOSING_TYPE (arg2) = type;  /* pai: chk_val */
344       VALUE_POINTED_TO_OFFSET (arg2) = 0;  /* pai: chk_val */
345       return arg2;
346     }
347   else if (chill_varying_type (type))
348     {
349       struct type *range1, *range2, *eltype1, *eltype2;
350       value_ptr val;
351       int count1, count2;
352       LONGEST low_bound, high_bound;
353       char *valaddr, *valaddr_data;
354       /* For lint warning about eltype2 possibly uninitialized: */
355       eltype2 = NULL;
356       if (code2 == TYPE_CODE_BITSTRING)
357         error ("not implemented: converting bitstring to varying type");
358       if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
359           || (eltype1 = check_typedef (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1))),
360               eltype2 = check_typedef (TYPE_TARGET_TYPE (type2)),
361               (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
362                /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
363         error ("Invalid conversion to varying type");
364       range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
365       range2 = TYPE_FIELD_TYPE (type2, 0);
366       if (get_discrete_bounds (range1, &low_bound, &high_bound) < 0)
367         count1 = -1;
368       else
369         count1 = high_bound - low_bound + 1;
370       if (get_discrete_bounds (range2, &low_bound, &high_bound) < 0)
371         count1 = -1, count2 = 0;  /* To force error before */
372       else
373         count2 = high_bound - low_bound + 1;
374       if (count2 > count1)
375         error ("target varying type is too small");
376       val = allocate_value (type);
377       valaddr = VALUE_CONTENTS_RAW (val);
378       valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
379       /* Set val's __var_length field to count2. */
380       store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
381                             count2);
382       /* Set the __var_data field to count2 elements copied from arg2. */
383       memcpy (valaddr_data, VALUE_CONTENTS (arg2),
384               count2 * TYPE_LENGTH (eltype2));
385       /* Zero the rest of the __var_data field of val. */
386       memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
387               (count1 - count2) * TYPE_LENGTH (eltype2));
388       return val;
389     }
390   else if (VALUE_LVAL (arg2) == lval_memory)
391     {
392       return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2),
393                             VALUE_BFD_SECTION (arg2));
394     }
395   else if (code1 == TYPE_CODE_VOID)
396     {
397       return value_zero (builtin_type_void, not_lval);
398     }
399   else
400     {
401       error ("Invalid cast.");
402       return 0;
403     }
404 }
405
406 /* Create a value of type TYPE that is zero, and return it.  */
407
408 value_ptr
409 value_zero (type, lv)
410      struct type *type;
411      enum lval_type lv;
412 {
413   register value_ptr val = allocate_value (type);
414
415   memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (check_typedef (type)));
416   VALUE_LVAL (val) = lv;
417
418   return val;
419 }
420
421 /* Return a value with type TYPE located at ADDR.  
422
423    Call value_at only if the data needs to be fetched immediately;
424    if we can be 'lazy' and defer the fetch, perhaps indefinately, call
425    value_at_lazy instead.  value_at_lazy simply records the address of
426    the data and sets the lazy-evaluation-required flag.  The lazy flag 
427    is tested in the VALUE_CONTENTS macro, which is used if and when 
428    the contents are actually required. 
429
430    Note: value_at does *NOT* handle embedded offsets; perform such
431    adjustments before or after calling it. */
432
433 value_ptr
434 value_at (type, addr, sect)
435      struct type *type;
436      CORE_ADDR addr;
437      asection *sect;
438 {
439   register value_ptr val;
440
441   if (TYPE_CODE (check_typedef (type)) == TYPE_CODE_VOID)
442     error ("Attempt to dereference a generic pointer.");
443
444   val = allocate_value (type);
445
446 #ifdef GDB_TARGET_IS_D10V
447   if (TYPE_CODE (type) == TYPE_CODE_PTR
448       && TYPE_TARGET_TYPE (type)
449       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_FUNC))
450     {
451       /* pointer to function */
452       unsigned long num;
453       unsigned short snum;
454       snum = read_memory_unsigned_integer (addr, 2);
455       num = D10V_MAKE_IADDR(snum);
456       store_address ( VALUE_CONTENTS_RAW (val), 4, num);
457     }
458   else if (TYPE_CODE(type) == TYPE_CODE_PTR)
459     {
460       /* pointer to data */
461       unsigned long num;
462       unsigned short snum;
463       snum = read_memory_unsigned_integer (addr, 2);
464       num = D10V_MAKE_DADDR(snum);
465       store_address ( VALUE_CONTENTS_RAW (val), 4, num); 
466     }
467   else
468 #endif
469     read_memory_section (addr, VALUE_CONTENTS_ALL_RAW (val), TYPE_LENGTH (type), sect);
470
471   VALUE_LVAL (val) = lval_memory;
472   VALUE_ADDRESS (val) = addr;
473   VALUE_BFD_SECTION (val) = sect;
474
475   return val;
476 }
477
478 /* Return a lazy value with type TYPE located at ADDR (cf. value_at).  */
479
480 value_ptr
481 value_at_lazy (type, addr, sect)
482      struct type *type;
483      CORE_ADDR addr;
484      asection *sect;
485 {
486   register value_ptr val;
487
488   if (TYPE_CODE (check_typedef (type)) == TYPE_CODE_VOID)
489     error ("Attempt to dereference a generic pointer.");
490
491   val = allocate_value (type);
492
493   VALUE_LVAL (val) = lval_memory;
494   VALUE_ADDRESS (val) = addr;
495   VALUE_LAZY (val) = 1;
496   VALUE_BFD_SECTION (val) = sect;
497
498   return val;
499 }
500
501 /* Called only from the VALUE_CONTENTS and VALUE_CONTENTS_ALL macros, 
502    if the current data for a variable needs to be loaded into 
503    VALUE_CONTENTS(VAL).  Fetches the data from the user's process, and 
504    clears the lazy flag to indicate that the data in the buffer is valid.
505
506    If the value is zero-length, we avoid calling read_memory, which would
507    abort.  We mark the value as fetched anyway -- all 0 bytes of it.
508
509    This function returns a value because it is used in the VALUE_CONTENTS
510    macro as part of an expression, where a void would not work.  The
511    value is ignored.  */
512
513 int
514 value_fetch_lazy (val)
515      register value_ptr val;
516 {
517   CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
518   int length = TYPE_LENGTH (VALUE_ENCLOSING_TYPE (val));
519
520 #ifdef GDB_TARGET_IS_D10V
521   struct type *type = VALUE_TYPE(val);
522   if (TYPE_CODE (type) == TYPE_CODE_PTR
523       && TYPE_TARGET_TYPE (type)
524       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_FUNC))
525     {
526       /* pointer to function */
527       unsigned long num;
528       unsigned short snum;
529       snum = read_memory_unsigned_integer (addr, 2);
530       num = D10V_MAKE_IADDR(snum);
531       store_address ( VALUE_CONTENTS_RAW (val), 4, num);
532     }
533   else if (TYPE_CODE(type) == TYPE_CODE_PTR)
534     {
535       /* pointer to data */
536       unsigned long num;
537       unsigned short snum;
538       snum = read_memory_unsigned_integer (addr, 2);
539       num = D10V_MAKE_DADDR(snum);
540       store_address ( VALUE_CONTENTS_RAW (val), 4, num); 
541     }
542   else
543 #endif
544
545   if (length)
546     read_memory_section (addr, VALUE_CONTENTS_ALL_RAW (val), length,
547                          VALUE_BFD_SECTION (val));
548   VALUE_LAZY (val) = 0;
549   return 0;
550 }
551
552
553 /* Store the contents of FROMVAL into the location of TOVAL.
554    Return a new value with the location of TOVAL and contents of FROMVAL.  */
555
556 value_ptr
557 value_assign (toval, fromval)
558      register value_ptr toval, fromval;
559 {
560   register struct type *type;
561   register value_ptr val;
562   char raw_buffer[MAX_REGISTER_RAW_SIZE];
563   int use_buffer = 0;
564
565   if (!toval->modifiable)
566     error ("Left operand of assignment is not a modifiable lvalue.");
567
568   COERCE_REF (toval);
569
570   type = VALUE_TYPE (toval);
571   if (VALUE_LVAL (toval) != lval_internalvar)
572     fromval = value_cast (type, fromval);
573   else
574     COERCE_ARRAY (fromval);
575   CHECK_TYPEDEF (type);
576
577   /* If TOVAL is a special machine register requiring conversion
578      of program values to a special raw format,
579      convert FROMVAL's contents now, with result in `raw_buffer',
580      and set USE_BUFFER to the number of bytes to write.  */
581
582 #ifdef REGISTER_CONVERTIBLE
583   if (VALUE_REGNO (toval) >= 0
584       && REGISTER_CONVERTIBLE (VALUE_REGNO (toval)))
585     {
586       int regno = VALUE_REGNO (toval);
587       if (REGISTER_CONVERTIBLE (regno))
588         {
589           struct type *fromtype = check_typedef (VALUE_TYPE (fromval));
590           REGISTER_CONVERT_TO_RAW (fromtype, regno,
591                                    VALUE_CONTENTS (fromval), raw_buffer);
592           use_buffer = REGISTER_RAW_SIZE (regno);
593         }
594     }
595 #endif
596
597   switch (VALUE_LVAL (toval))
598     {
599     case lval_internalvar:
600       set_internalvar (VALUE_INTERNALVAR (toval), fromval);
601       val = value_copy (VALUE_INTERNALVAR (toval)->value);
602       VALUE_ENCLOSING_TYPE (val) = VALUE_ENCLOSING_TYPE (fromval);
603       VALUE_EMBEDDED_OFFSET (val) = VALUE_EMBEDDED_OFFSET (fromval);
604       VALUE_POINTED_TO_OFFSET (val) = VALUE_POINTED_TO_OFFSET (fromval);
605       return val;
606
607     case lval_internalvar_component:
608       set_internalvar_component (VALUE_INTERNALVAR (toval),
609                                  VALUE_OFFSET (toval),
610                                  VALUE_BITPOS (toval),
611                                  VALUE_BITSIZE (toval),
612                                  fromval);
613       break;
614
615     case lval_memory:
616       if (VALUE_BITSIZE (toval))
617         {
618           char buffer[sizeof (LONGEST)];
619           /* We assume that the argument to read_memory is in units of
620              host chars.  FIXME:  Is that correct?  */
621           int len = (VALUE_BITPOS (toval)
622                      + VALUE_BITSIZE (toval)
623                      + HOST_CHAR_BIT - 1)
624                     / HOST_CHAR_BIT;
625
626           if (len > (int) sizeof (LONGEST))
627             error ("Can't handle bitfields which don't fit in a %d bit word.",
628                    sizeof (LONGEST) * HOST_CHAR_BIT);
629
630           read_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
631                        buffer, len);
632           modify_field (buffer, value_as_long (fromval),
633                         VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
634           write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
635                         buffer, len);
636         }
637       else if (use_buffer)
638         write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
639                       raw_buffer, use_buffer);
640       else
641         write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
642                       VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
643       break;
644
645     case lval_register:
646       if (VALUE_BITSIZE (toval))
647         {
648           char buffer[sizeof (LONGEST)];
649           int len = REGISTER_RAW_SIZE (VALUE_REGNO (toval));
650
651           if (len > (int) sizeof (LONGEST))
652             error ("Can't handle bitfields in registers larger than %d bits.",
653                    sizeof (LONGEST) * HOST_CHAR_BIT);
654
655           if (VALUE_BITPOS (toval) + VALUE_BITSIZE (toval)
656               > len * HOST_CHAR_BIT)
657             /* Getting this right would involve being very careful about
658                byte order.  */
659             error ("\
660 Can't handle bitfield which doesn't fit in a single register.");
661
662           read_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
663                                buffer, len);
664           modify_field (buffer, value_as_long (fromval),
665                         VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
666           write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
667                                 buffer, len);
668         }
669       else if (use_buffer)
670         write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
671                               raw_buffer, use_buffer);
672       else
673         {
674           /* Do any conversion necessary when storing this type to more
675              than one register.  */
676 #ifdef REGISTER_CONVERT_FROM_TYPE
677           memcpy (raw_buffer, VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
678           REGISTER_CONVERT_FROM_TYPE(VALUE_REGNO (toval), type, raw_buffer);
679           write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
680                                 raw_buffer, TYPE_LENGTH (type));
681 #else
682           write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
683                                 VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
684 #endif
685         }
686       /* Assigning to the stack pointer, frame pointer, and other
687          (architecture and calling convention specific) registers may
688          cause the frame cache to be out of date.  We just do this
689          on all assignments to registers for simplicity; I doubt the slowdown
690          matters.  */
691       reinit_frame_cache ();
692       break;
693
694     case lval_reg_frame_relative:
695       {
696         /* value is stored in a series of registers in the frame
697            specified by the structure.  Copy that value out, modify
698            it, and copy it back in.  */
699         int amount_to_copy = (VALUE_BITSIZE (toval) ? 1 : TYPE_LENGTH (type));
700         int reg_size = REGISTER_RAW_SIZE (VALUE_FRAME_REGNUM (toval));
701         int byte_offset = VALUE_OFFSET (toval) % reg_size;
702         int reg_offset = VALUE_OFFSET (toval) / reg_size;
703         int amount_copied;
704
705         /* Make the buffer large enough in all cases.  */
706         char *buffer = (char *) alloca (amount_to_copy
707                                         + sizeof (LONGEST)
708                                         + MAX_REGISTER_RAW_SIZE);
709
710         int regno;
711         struct frame_info *frame;
712
713         /* Figure out which frame this is in currently.  */
714         for (frame = get_current_frame ();
715              frame && FRAME_FP (frame) != VALUE_FRAME (toval);
716              frame = get_prev_frame (frame))
717           ;
718
719         if (!frame)
720           error ("Value being assigned to is no longer active.");
721
722         amount_to_copy += (reg_size - amount_to_copy % reg_size);
723
724         /* Copy it out.  */
725         for ((regno = VALUE_FRAME_REGNUM (toval) + reg_offset,
726               amount_copied = 0);
727              amount_copied < amount_to_copy;
728              amount_copied += reg_size, regno++)
729           {
730             get_saved_register (buffer + amount_copied,
731                                 (int *)NULL, (CORE_ADDR *)NULL,
732                                 frame, regno, (enum lval_type *)NULL);
733           }
734
735         /* Modify what needs to be modified.  */
736         if (VALUE_BITSIZE (toval))
737           modify_field (buffer + byte_offset,
738                         value_as_long (fromval),
739                         VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
740         else if (use_buffer)
741           memcpy (buffer + byte_offset, raw_buffer, use_buffer);
742         else
743           memcpy (buffer + byte_offset, VALUE_CONTENTS (fromval),
744                   TYPE_LENGTH (type));
745
746         /* Copy it back.  */
747         for ((regno = VALUE_FRAME_REGNUM (toval) + reg_offset,
748               amount_copied = 0);
749              amount_copied < amount_to_copy;
750              amount_copied += reg_size, regno++)
751           {
752             enum lval_type lval;
753             CORE_ADDR addr;
754             int optim;
755
756             /* Just find out where to put it.  */
757             get_saved_register ((char *)NULL,
758                                 &optim, &addr, frame, regno, &lval);
759             
760             if (optim)
761               error ("Attempt to assign to a value that was optimized out.");
762             if (lval == lval_memory)
763               write_memory (addr, buffer + amount_copied, reg_size);
764             else if (lval == lval_register)
765               write_register_bytes (addr, buffer + amount_copied, reg_size);
766             else
767               error ("Attempt to assign to an unmodifiable value.");
768           }
769       }
770       break;
771         
772
773     default:
774       error ("Left operand of assignment is not an lvalue.");
775     }
776
777   /* If the field does not entirely fill a LONGEST, then zero the sign bits.
778      If the field is signed, and is negative, then sign extend. */
779   if ((VALUE_BITSIZE (toval) > 0)
780       && (VALUE_BITSIZE (toval) < 8 * (int) sizeof (LONGEST)))
781     {
782       LONGEST fieldval = value_as_long (fromval);
783       LONGEST valmask = (((ULONGEST) 1) << VALUE_BITSIZE (toval)) - 1;
784
785       fieldval &= valmask;
786       if (!TYPE_UNSIGNED (type) && (fieldval & (valmask ^ (valmask >> 1))))
787         fieldval |= ~valmask;
788
789       fromval = value_from_longest (type, fieldval);
790     }
791
792   val = value_copy (toval);
793   memcpy (VALUE_CONTENTS_RAW (val), VALUE_CONTENTS (fromval),
794           TYPE_LENGTH (type));
795   VALUE_TYPE (val) = type;
796   VALUE_ENCLOSING_TYPE (val) = VALUE_ENCLOSING_TYPE (fromval);
797   VALUE_EMBEDDED_OFFSET (val) = VALUE_EMBEDDED_OFFSET (fromval);
798   VALUE_POINTED_TO_OFFSET (val) = VALUE_POINTED_TO_OFFSET (fromval);
799   
800   return val;
801 }
802
803 /* Extend a value VAL to COUNT repetitions of its type.  */
804
805 value_ptr
806 value_repeat (arg1, count)
807      value_ptr arg1;
808      int count;
809 {
810   register value_ptr val;
811
812   if (VALUE_LVAL (arg1) != lval_memory)
813     error ("Only values in memory can be extended with '@'.");
814   if (count < 1)
815     error ("Invalid number %d of repetitions.", count);
816
817   val = allocate_repeat_value (VALUE_ENCLOSING_TYPE (arg1), count);
818
819   read_memory (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1),
820                VALUE_CONTENTS_ALL_RAW (val),
821                TYPE_LENGTH (VALUE_ENCLOSING_TYPE (val)));
822   VALUE_LVAL (val) = lval_memory;
823   VALUE_ADDRESS (val) = VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1);
824
825   return val;
826 }
827
828 value_ptr
829 value_of_variable (var, b)
830      struct symbol *var;
831      struct block *b;
832 {
833   value_ptr val;
834   struct frame_info *frame = NULL;
835
836   if (!b)
837     frame = NULL;               /* Use selected frame.  */
838   else if (symbol_read_needs_frame (var))
839     {
840       frame = block_innermost_frame (b);
841       if (!frame)
842         {
843           if (BLOCK_FUNCTION (b)
844               && SYMBOL_SOURCE_NAME (BLOCK_FUNCTION (b)))
845             error ("No frame is currently executing in block %s.",
846                    SYMBOL_SOURCE_NAME (BLOCK_FUNCTION (b)));
847           else
848             error ("No frame is currently executing in specified block");
849         }
850     }
851
852   val = read_var_value (var, frame);
853   if (!val)
854     error ("Address of symbol \"%s\" is unknown.", SYMBOL_SOURCE_NAME (var));
855
856   return val;
857 }
858
859 /* Given a value which is an array, return a value which is a pointer to its
860    first element, regardless of whether or not the array has a nonzero lower
861    bound.
862
863    FIXME:  A previous comment here indicated that this routine should be
864    substracting the array's lower bound.  It's not clear to me that this
865    is correct.  Given an array subscripting operation, it would certainly
866    work to do the adjustment here, essentially computing:
867
868    (&array[0] - (lowerbound * sizeof array[0])) + (index * sizeof array[0])
869
870    However I believe a more appropriate and logical place to account for
871    the lower bound is to do so in value_subscript, essentially computing:
872
873    (&array[0] + ((index - lowerbound) * sizeof array[0]))
874
875    As further evidence consider what would happen with operations other
876    than array subscripting, where the caller would get back a value that
877    had an address somewhere before the actual first element of the array,
878    and the information about the lower bound would be lost because of
879    the coercion to pointer type.
880    */
881
882 value_ptr
883 value_coerce_array (arg1)
884      value_ptr arg1;
885 {
886   register struct type *type = check_typedef (VALUE_TYPE (arg1));
887
888   if (VALUE_LVAL (arg1) != lval_memory)
889     error ("Attempt to take address of value not located in memory.");
890
891   return value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
892                        (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
893 }
894
895 /* Given a value which is a function, return a value which is a pointer
896    to it.  */
897
898 value_ptr
899 value_coerce_function (arg1)
900      value_ptr arg1;
901 {
902   value_ptr retval;
903
904   if (VALUE_LVAL (arg1) != lval_memory)
905     error ("Attempt to take address of value not located in memory.");
906
907   retval = value_from_longest (lookup_pointer_type (VALUE_TYPE (arg1)),
908                                (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
909   VALUE_BFD_SECTION (retval) = VALUE_BFD_SECTION (arg1);
910   return retval;
911 }  
912
913 /* Return a pointer value for the object for which ARG1 is the contents.  */
914
915 value_ptr
916 value_addr (arg1)
917      value_ptr arg1;
918 {
919   value_ptr arg2;
920
921   struct type *type = check_typedef (VALUE_TYPE (arg1));
922   if (TYPE_CODE (type) == TYPE_CODE_REF)
923     {
924       /* Copy the value, but change the type from (T&) to (T*).
925          We keep the same location information, which is efficient,
926          and allows &(&X) to get the location containing the reference. */
927       arg2 = value_copy (arg1);
928       VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
929       return arg2;
930     }
931   if (TYPE_CODE (type) == TYPE_CODE_FUNC)
932     return value_coerce_function (arg1);
933
934   if (VALUE_LVAL (arg1) != lval_memory)
935     error ("Attempt to take address of value not located in memory.");
936
937   /* Get target memory address */  
938   arg2 = value_from_longest (lookup_pointer_type (VALUE_TYPE (arg1)),
939                                (LONGEST) (VALUE_ADDRESS (arg1) 
940                                           + VALUE_OFFSET (arg1)
941                                           + VALUE_EMBEDDED_OFFSET (arg1)));
942
943   /* This may be a pointer to a base subobject; so remember the
944      full derived object's type ... */ 
945   VALUE_ENCLOSING_TYPE (arg2) = lookup_pointer_type (VALUE_ENCLOSING_TYPE (arg1));
946   /* ... and also the relative position of the subobject in the full object */ 
947   VALUE_POINTED_TO_OFFSET (arg2) = VALUE_EMBEDDED_OFFSET (arg1);  
948   VALUE_BFD_SECTION (arg2) = VALUE_BFD_SECTION (arg1);
949   return arg2;
950 }
951
952 /* Given a value of a pointer type, apply the C unary * operator to it.  */
953
954 value_ptr
955 value_ind (arg1)
956      value_ptr arg1;
957 {
958   struct type *base_type;
959   value_ptr arg2;
960   value_ptr real_val;
961
962   COERCE_ARRAY (arg1);
963
964   base_type = check_typedef (VALUE_TYPE (arg1));
965
966   if (TYPE_CODE (base_type) == TYPE_CODE_MEMBER)
967     error ("not implemented: member types in value_ind");
968
969   /* Allow * on an integer so we can cast it to whatever we want.
970      This returns an int, which seems like the most C-like thing
971      to do.  "long long" variables are rare enough that
972      BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
973   if (TYPE_CODE (base_type) == TYPE_CODE_INT)
974     return value_at (builtin_type_int,
975                      (CORE_ADDR) value_as_long (arg1),
976                      VALUE_BFD_SECTION (arg1));
977   else if (TYPE_CODE (base_type) == TYPE_CODE_PTR)
978     {
979       struct type *enc_type;
980       /* We may be pointing to something embedded in a larger object */
981       /* Get the real type of the enclosing object */ 
982       enc_type = check_typedef (VALUE_ENCLOSING_TYPE (arg1));
983       enc_type = TYPE_TARGET_TYPE (enc_type);
984       /* Retrieve the enclosing object pointed to */ 
985       arg2 =  value_at_lazy (enc_type, 
986                              value_as_pointer (arg1) - VALUE_POINTED_TO_OFFSET (arg1),
987                              VALUE_BFD_SECTION (arg1));
988       /* Re-adjust type */ 
989       VALUE_TYPE (arg2) = TYPE_TARGET_TYPE (base_type);
990       /* Add embedding info */
991       VALUE_ENCLOSING_TYPE (arg2) = enc_type;
992       VALUE_EMBEDDED_OFFSET (arg2) = VALUE_POINTED_TO_OFFSET (arg1);
993
994       /* We may be pointing to an object of some derived type */
995       arg2 = value_full_object (arg2, NULL, 0, 0, 0);
996       return arg2;
997     }
998
999   error ("Attempt to take contents of a non-pointer value.");
1000   return 0;  /* For lint -- never reached */
1001 }
1002 \f
1003 /* Pushing small parts of stack frames.  */
1004
1005 /* Push one word (the size of object that a register holds).  */
1006
1007 CORE_ADDR
1008 push_word (sp, word)
1009      CORE_ADDR sp;
1010      ULONGEST word;
1011 {
1012   register int len = REGISTER_SIZE;
1013   char buffer[MAX_REGISTER_RAW_SIZE];
1014
1015   store_unsigned_integer (buffer, len, word);
1016   if (INNER_THAN (1, 2))
1017     {
1018       /* stack grows downward */
1019       sp -= len;
1020       write_memory (sp, buffer, len);
1021     }
1022   else
1023     {
1024       /* stack grows upward */
1025       write_memory (sp, buffer, len);
1026       sp += len;
1027     }
1028
1029   return sp;
1030 }
1031
1032 /* Push LEN bytes with data at BUFFER.  */
1033
1034 CORE_ADDR
1035 push_bytes (sp, buffer, len)
1036      CORE_ADDR sp;
1037      char *buffer;
1038      int len;
1039 {
1040   if (INNER_THAN (1, 2))
1041     {
1042       /* stack grows downward */
1043       sp -= len;
1044       write_memory (sp, buffer, len);
1045     }
1046   else
1047     {
1048       /* stack grows upward */
1049       write_memory (sp, buffer, len);
1050       sp += len;
1051     }
1052
1053   return sp;
1054 }
1055
1056 /* Push onto the stack the specified value VALUE.  */
1057
1058 #ifndef PUSH_ARGUMENTS
1059
1060 static CORE_ADDR
1061 value_push (sp, arg)
1062      register CORE_ADDR sp;
1063      value_ptr arg;
1064 {
1065   register int len = TYPE_LENGTH (VALUE_ENCLOSING_TYPE (arg));
1066
1067   if (INNER_THAN (1, 2))
1068     {
1069       /* stack grows downward */
1070       sp -= len;
1071       write_memory (sp, VALUE_CONTENTS_ALL (arg), len);
1072     }
1073   else
1074     {
1075       /* stack grows upward */
1076       write_memory (sp, VALUE_CONTENTS_ALL (arg), len);
1077       sp += len;
1078     }
1079
1080   return sp;
1081 }
1082
1083 #endif  /* !PUSH_ARGUMENTS */
1084
1085 #ifdef CALL_DUMMY
1086 /* Perform the standard coercions that are specified
1087    for arguments to be passed to C functions.
1088
1089    If PARAM_TYPE is non-NULL, it is the expected parameter type.
1090    IS_PROTOTYPED is non-zero if the function declaration is prototyped.  */
1091
1092 static value_ptr
1093 value_arg_coerce (arg, param_type, is_prototyped)
1094      value_ptr arg;
1095      struct type *param_type;
1096      int is_prototyped;
1097 {
1098   register struct type *arg_type = check_typedef (VALUE_TYPE (arg));
1099   register struct type *type
1100     = param_type ? check_typedef (param_type) : arg_type;
1101
1102   switch (TYPE_CODE (type))
1103     {
1104     case TYPE_CODE_REF:
1105       if (TYPE_CODE (arg_type) != TYPE_CODE_REF)
1106         {
1107           arg = value_addr (arg);
1108           VALUE_TYPE (arg) = param_type;
1109           return arg;
1110         }
1111       break;
1112     case TYPE_CODE_INT:
1113     case TYPE_CODE_CHAR:
1114     case TYPE_CODE_BOOL:
1115     case TYPE_CODE_ENUM:
1116       /* If we don't have a prototype, coerce to integer type if necessary.  */
1117       if (!is_prototyped)
1118         {
1119           if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
1120             type = builtin_type_int;
1121         }
1122       /* Currently all target ABIs require at least the width of an integer
1123          type for an argument.  We may have to conditionalize the following
1124          type coercion for future targets.  */
1125       if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
1126         type = builtin_type_int;
1127       break;
1128     case TYPE_CODE_FLT:
1129       /* FIXME: We should always convert floats to doubles in the
1130          non-prototyped case.  As many debugging formats include
1131          no information about prototyping, we have to live with
1132          COERCE_FLOAT_TO_DOUBLE for now.  */
1133       if (!is_prototyped && COERCE_FLOAT_TO_DOUBLE)
1134         {
1135           if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_double))
1136             type = builtin_type_double;
1137           else if (TYPE_LENGTH (type) > TYPE_LENGTH (builtin_type_double))
1138             type = builtin_type_long_double;
1139         }
1140       break;
1141     case TYPE_CODE_FUNC:
1142       type = lookup_pointer_type (type);
1143       break;
1144     case TYPE_CODE_ARRAY:
1145       if (current_language->c_style_arrays)
1146         type = lookup_pointer_type (TYPE_TARGET_TYPE (type));
1147       break;
1148     case TYPE_CODE_UNDEF:
1149     case TYPE_CODE_PTR:
1150     case TYPE_CODE_STRUCT:
1151     case TYPE_CODE_UNION:
1152     case TYPE_CODE_VOID:
1153     case TYPE_CODE_SET:
1154     case TYPE_CODE_RANGE:
1155     case TYPE_CODE_STRING:
1156     case TYPE_CODE_BITSTRING:
1157     case TYPE_CODE_ERROR:
1158     case TYPE_CODE_MEMBER:
1159     case TYPE_CODE_METHOD:
1160     case TYPE_CODE_COMPLEX:
1161     default:
1162       break;
1163     }
1164
1165   return value_cast (type, arg);
1166 }
1167
1168 /* Determine a function's address and its return type from its value. 
1169    Calls error() if the function is not valid for calling.  */
1170
1171 static CORE_ADDR
1172 find_function_addr (function, retval_type)
1173      value_ptr function;
1174      struct type **retval_type;
1175 {
1176   register struct type *ftype = check_typedef (VALUE_TYPE (function));
1177   register enum type_code code = TYPE_CODE (ftype);
1178   struct type *value_type;
1179   CORE_ADDR funaddr;
1180
1181   /* If it's a member function, just look at the function
1182      part of it.  */
1183
1184   /* Determine address to call.  */
1185   if (code == TYPE_CODE_FUNC || code == TYPE_CODE_METHOD)
1186     {
1187       funaddr = VALUE_ADDRESS (function);
1188       value_type = TYPE_TARGET_TYPE (ftype);
1189     }
1190   else if (code == TYPE_CODE_PTR)
1191     {
1192       funaddr = value_as_pointer (function);
1193       ftype = check_typedef (TYPE_TARGET_TYPE (ftype));
1194       if (TYPE_CODE (ftype) == TYPE_CODE_FUNC
1195           || TYPE_CODE (ftype) == TYPE_CODE_METHOD)
1196         {
1197 #ifdef CONVERT_FROM_FUNC_PTR_ADDR
1198           /* FIXME: This is a workaround for the unusual function
1199              pointer representation on the RS/6000, see comment
1200              in config/rs6000/tm-rs6000.h  */
1201           funaddr = CONVERT_FROM_FUNC_PTR_ADDR (funaddr);
1202 #endif
1203           value_type = TYPE_TARGET_TYPE (ftype);
1204         }
1205       else
1206         value_type = builtin_type_int;
1207     }
1208   else if (code == TYPE_CODE_INT)
1209     {
1210       /* Handle the case of functions lacking debugging info.
1211          Their values are characters since their addresses are char */
1212       if (TYPE_LENGTH (ftype) == 1)
1213         funaddr = value_as_pointer (value_addr (function));
1214       else
1215         /* Handle integer used as address of a function.  */
1216         funaddr = (CORE_ADDR) value_as_long (function);
1217
1218       value_type = builtin_type_int;
1219     }
1220   else
1221     error ("Invalid data type for function to be called.");
1222
1223   *retval_type = value_type;
1224   return funaddr;
1225 }
1226
1227 /* All this stuff with a dummy frame may seem unnecessarily complicated
1228    (why not just save registers in GDB?).  The purpose of pushing a dummy
1229    frame which looks just like a real frame is so that if you call a
1230    function and then hit a breakpoint (get a signal, etc), "backtrace"
1231    will look right.  Whether the backtrace needs to actually show the
1232    stack at the time the inferior function was called is debatable, but
1233    it certainly needs to not display garbage.  So if you are contemplating
1234    making dummy frames be different from normal frames, consider that.  */
1235
1236 /* Perform a function call in the inferior.
1237    ARGS is a vector of values of arguments (NARGS of them).
1238    FUNCTION is a value, the function to be called.
1239    Returns a value representing what the function returned.
1240    May fail to return, if a breakpoint or signal is hit
1241    during the execution of the function.
1242
1243    ARGS is modified to contain coerced values. */
1244
1245 value_ptr
1246 call_function_by_hand (function, nargs, args)
1247      value_ptr function;
1248      int nargs;
1249      value_ptr *args;
1250 {
1251   register CORE_ADDR sp;
1252   register int i;
1253   CORE_ADDR start_sp;
1254   /* CALL_DUMMY is an array of words (REGISTER_SIZE), but each word
1255      is in host byte order.  Before calling FIX_CALL_DUMMY, we byteswap it
1256      and remove any extra bytes which might exist because ULONGEST is
1257      bigger than REGISTER_SIZE.  
1258
1259      NOTE: This is pretty wierd, as the call dummy is actually a
1260            sequence of instructions.  But CISC machines will have
1261            to pack the instructions into REGISTER_SIZE units (and
1262            so will RISC machines for which INSTRUCTION_SIZE is not
1263            REGISTER_SIZE). */
1264
1265   static ULONGEST dummy[] = CALL_DUMMY;
1266   char dummy1[REGISTER_SIZE * sizeof dummy / sizeof (ULONGEST)];
1267   CORE_ADDR old_sp;
1268   struct type *value_type;
1269   unsigned char struct_return;
1270   CORE_ADDR struct_addr = 0;
1271   struct inferior_status inf_status;
1272   struct cleanup *old_chain;
1273   CORE_ADDR funaddr;
1274   int using_gcc;        /* Set to version of gcc in use, or zero if not gcc */
1275   CORE_ADDR real_pc;
1276   struct type *param_type = NULL;
1277   struct type *ftype = check_typedef (SYMBOL_TYPE (function));
1278
1279   if (!target_has_execution)
1280     noprocess();
1281
1282   save_inferior_status (&inf_status, 1);
1283   old_chain = make_cleanup ((make_cleanup_func) restore_inferior_status, 
1284                             &inf_status);
1285
1286   /* PUSH_DUMMY_FRAME is responsible for saving the inferior registers
1287      (and POP_FRAME for restoring them).  (At least on most machines)
1288      they are saved on the stack in the inferior.  */
1289   PUSH_DUMMY_FRAME;
1290
1291   old_sp = sp = read_sp ();
1292
1293   if (INNER_THAN (1, 2))
1294     {
1295       /* Stack grows down */
1296       sp -= sizeof dummy1;
1297       start_sp = sp;
1298     }
1299   else
1300     {
1301       /* Stack grows up */
1302       start_sp = sp;
1303       sp += sizeof dummy1;
1304     }
1305
1306   funaddr = find_function_addr (function, &value_type);
1307   CHECK_TYPEDEF (value_type);
1308
1309   {
1310     struct block *b = block_for_pc (funaddr);
1311     /* If compiled without -g, assume GCC 2.  */
1312     using_gcc = (b == NULL ? 2 : BLOCK_GCC_COMPILED (b));
1313   }
1314
1315   /* Are we returning a value using a structure return or a normal
1316      value return? */
1317
1318   struct_return = using_struct_return (function, funaddr, value_type,
1319                                        using_gcc);
1320
1321   /* Create a call sequence customized for this function
1322      and the number of arguments for it.  */
1323   for (i = 0; i < (int) (sizeof (dummy) / sizeof (dummy[0])); i++)
1324     store_unsigned_integer (&dummy1[i * REGISTER_SIZE],
1325                             REGISTER_SIZE,
1326                             (ULONGEST)dummy[i]);
1327
1328 #ifdef GDB_TARGET_IS_HPPA
1329   real_pc = FIX_CALL_DUMMY (dummy1, start_sp, funaddr, nargs, args,
1330                             value_type, using_gcc);
1331 #else
1332   FIX_CALL_DUMMY (dummy1, start_sp, funaddr, nargs, args,
1333                   value_type, using_gcc);
1334   real_pc = start_sp;
1335 #endif
1336
1337 #if CALL_DUMMY_LOCATION == ON_STACK
1338   write_memory (start_sp, (char *)dummy1, sizeof dummy1);
1339 #endif /* On stack.  */
1340
1341 #if CALL_DUMMY_LOCATION == BEFORE_TEXT_END
1342   /* Convex Unix prohibits executing in the stack segment. */
1343   /* Hope there is empty room at the top of the text segment. */
1344   {
1345     extern CORE_ADDR text_end;
1346     static checked = 0;
1347     if (!checked)
1348       for (start_sp = text_end - sizeof dummy1; start_sp < text_end; ++start_sp)
1349         if (read_memory_integer (start_sp, 1) != 0)
1350           error ("text segment full -- no place to put call");
1351     checked = 1;
1352     sp = old_sp;
1353     real_pc = text_end - sizeof dummy1;
1354     write_memory (real_pc, (char *)dummy1, sizeof dummy1);
1355   }
1356 #endif /* Before text_end.  */
1357
1358 #if CALL_DUMMY_LOCATION == AFTER_TEXT_END
1359   {
1360     extern CORE_ADDR text_end;
1361     int errcode;
1362     sp = old_sp;
1363     real_pc = text_end;
1364     errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy1);
1365     if (errcode != 0)
1366       error ("Cannot write text segment -- call_function failed");
1367   }
1368 #endif /* After text_end.  */
1369
1370 #if CALL_DUMMY_LOCATION == AT_ENTRY_POINT
1371   real_pc = funaddr;
1372 #endif /* At entry point.  */
1373
1374 #ifdef lint
1375   sp = old_sp;          /* It really is used, for some ifdef's... */
1376 #endif
1377
1378   if (nargs < TYPE_NFIELDS (ftype))
1379     error ("too few arguments in function call");
1380
1381   for (i = nargs - 1; i >= 0; i--)
1382     {
1383       /* If we're off the end of the known arguments, do the standard
1384          promotions.  FIXME: if we had a prototype, this should only
1385          be allowed if ... were present.  */
1386       if (i >= TYPE_NFIELDS (ftype))
1387         args[i] = value_arg_coerce (args[i], NULL, 0);
1388
1389       else 
1390         {
1391           int is_prototyped = TYPE_FLAGS (ftype) & TYPE_FLAG_PROTOTYPED;
1392           param_type = TYPE_FIELD_TYPE (ftype, i);
1393
1394           args[i] = value_arg_coerce (args[i], param_type, is_prototyped);
1395         }
1396
1397       /*elz: this code is to handle the case in which the function to be called 
1398         has a pointer to function as parameter and the corresponding actual argument 
1399         is the address of a function and not a pointer to function variable.
1400         In aCC compiled code, the calls through pointers to functions (in the body
1401         of the function called by hand) are made via $$dyncall_external which
1402         requires some registers setting, this is taken care of if we call 
1403         via a function pointer variable, but not via a function address. 
1404         In cc this is not a problem. */
1405
1406       if (using_gcc == 0)
1407         if (param_type)
1408           /* if this parameter is a pointer to function*/
1409           if (TYPE_CODE (param_type) == TYPE_CODE_PTR)
1410             if (TYPE_CODE (param_type->target_type) == TYPE_CODE_FUNC)
1411               /* elz: FIXME here should go the test about the compiler used 
1412                     to compile the target. We want to issue the error
1413                     message only if the compiler used was HP's aCC. 
1414                     If we used HP's cc, then there is no problem and no need 
1415                     to return at this point */
1416               if (using_gcc == 0) /* && compiler == aCC*/
1417                 /* go see if the actual parameter is a variable of type
1418                 pointer to function or just a function */
1419                 if (args[i]->lval == not_lval)
1420                   {
1421                     char *arg_name;
1422                     if (find_pc_partial_function((CORE_ADDR)args[i]->aligner.contents[0], &arg_name, NULL, NULL))
1423                       error("\
1424 You cannot use function <%s> as argument. \n\
1425 You must use a pointer to function type variable. Command ignored.", arg_name);
1426                   }   
1427     }
1428
1429 #if defined (REG_STRUCT_HAS_ADDR)
1430   {
1431     /* This is a machine like the sparc, where we may need to pass a pointer
1432        to the structure, not the structure itself.  */
1433     for (i = nargs - 1; i >= 0; i--)
1434       {
1435         struct type *arg_type = check_typedef (VALUE_TYPE (args[i]));
1436         if ((TYPE_CODE (arg_type) == TYPE_CODE_STRUCT
1437              || TYPE_CODE (arg_type) == TYPE_CODE_UNION
1438              || TYPE_CODE (arg_type) == TYPE_CODE_ARRAY
1439              || TYPE_CODE (arg_type) == TYPE_CODE_STRING
1440              || TYPE_CODE (arg_type) == TYPE_CODE_BITSTRING
1441              || TYPE_CODE (arg_type) == TYPE_CODE_SET
1442              || (TYPE_CODE (arg_type) == TYPE_CODE_FLT
1443                  && TYPE_LENGTH (arg_type) > 8)
1444              )
1445           && REG_STRUCT_HAS_ADDR (using_gcc, arg_type))
1446           {
1447             CORE_ADDR addr;
1448             int len; /*  = TYPE_LENGTH (arg_type); */ 
1449             int aligned_len;
1450             arg_type = check_typedef (VALUE_ENCLOSING_TYPE (args[i])); 
1451             len = TYPE_LENGTH (arg_type);
1452
1453 #ifdef STACK_ALIGN
1454   /* MVS 11/22/96: I think at least some of this stack_align code is
1455      really broken.  Better to let PUSH_ARGUMENTS adjust the stack in
1456      a target-defined manner.  */
1457             aligned_len = STACK_ALIGN (len);
1458 #else
1459             aligned_len = len;
1460 #endif
1461             if (INNER_THAN (1, 2))
1462               {
1463                 /* stack grows downward */
1464                 sp -= aligned_len;
1465               }
1466             else
1467               {
1468                 /* The stack grows up, so the address of the thing we push
1469                    is the stack pointer before we push it.  */
1470                 addr = sp;
1471               }
1472             /* Push the structure.  */
1473             write_memory (sp, VALUE_CONTENTS_ALL (args[i]), len);
1474             if (INNER_THAN (1, 2))
1475               {
1476                 /* The stack grows down, so the address of the thing we push
1477                    is the stack pointer after we push it.  */
1478                 addr = sp;
1479               }
1480             else
1481               {
1482                 /* stack grows upward */
1483                 sp += aligned_len;
1484               }
1485             /* The value we're going to pass is the address of the thing
1486                we just pushed.  */
1487             /*args[i] = value_from_longest (lookup_pointer_type (value_type),
1488                                           (LONGEST) addr);*/
1489             args[i] = value_from_longest (lookup_pointer_type (arg_type), 
1490                                           (LONGEST) addr);
1491           }
1492       }
1493   }
1494 #endif /* REG_STRUCT_HAS_ADDR.  */
1495
1496   /* Reserve space for the return structure to be written on the
1497      stack, if necessary */
1498
1499   if (struct_return)
1500     {
1501       int len = TYPE_LENGTH (value_type);
1502 #ifdef STACK_ALIGN
1503   /* MVS 11/22/96: I think at least some of this stack_align code is
1504      really broken.  Better to let PUSH_ARGUMENTS adjust the stack in
1505      a target-defined manner.  */
1506       len = STACK_ALIGN (len);
1507 #endif
1508       if (INNER_THAN (1, 2))
1509         {
1510           /* stack grows downward */
1511           sp -= len;
1512           struct_addr = sp;
1513         }
1514       else
1515         {
1516           /* stack grows upward */
1517           struct_addr = sp;
1518           sp += len;
1519         }
1520     }
1521
1522 /* elz: on HPPA no need for this extra alignment, maybe it is needed
1523    on other architectures. This is because all the alignment is taken care
1524    of in the above code (ifdef REG_STRUCT_HAS_ADDR) and in 
1525    hppa_push_arguments*/
1526 #ifndef NO_EXTRA_ALIGNMENT_NEEDED
1527
1528 #if defined(STACK_ALIGN)
1529   /* MVS 11/22/96: I think at least some of this stack_align code is
1530      really broken.  Better to let PUSH_ARGUMENTS adjust the stack in
1531      a target-defined manner.  */
1532   if (INNER_THAN (1, 2))
1533     {
1534       /* If stack grows down, we must leave a hole at the top. */
1535       int len = 0;
1536
1537       for (i = nargs - 1; i >= 0; i--)
1538         len += TYPE_LENGTH (VALUE_ENCLOSING_TYPE (args[i]));
1539 #ifdef CALL_DUMMY_STACK_ADJUST
1540       len += CALL_DUMMY_STACK_ADJUST;
1541 #endif
1542       sp -= STACK_ALIGN (len) - len;
1543     }
1544 #endif /* STACK_ALIGN */
1545 #endif /* NO_EXTRA_ALIGNMENT_NEEDED */
1546
1547 #ifdef PUSH_ARGUMENTS
1548   PUSH_ARGUMENTS(nargs, args, sp, struct_return, struct_addr);
1549 #else /* !PUSH_ARGUMENTS */
1550   for (i = nargs - 1; i >= 0; i--)
1551     sp = value_push (sp, args[i]);
1552 #endif /* !PUSH_ARGUMENTS */
1553
1554 #ifdef PUSH_RETURN_ADDRESS      /* for targets that use no CALL_DUMMY */
1555   /* There are a number of targets now which actually don't write any
1556      CALL_DUMMY instructions into the target, but instead just save the
1557      machine state, push the arguments, and jump directly to the callee
1558      function.  Since this doesn't actually involve executing a JSR/BSR
1559      instruction, the return address must be set up by hand, either by
1560      pushing onto the stack or copying into a return-address register
1561      as appropriate.  Formerly this has been done in PUSH_ARGUMENTS, 
1562      but that's overloading its functionality a bit, so I'm making it
1563      explicit to do it here.  */
1564   sp = PUSH_RETURN_ADDRESS(real_pc, sp);
1565 #endif  /* PUSH_RETURN_ADDRESS */
1566
1567 #if defined(STACK_ALIGN)
1568   if (! INNER_THAN (1, 2))
1569     {
1570       /* If stack grows up, we must leave a hole at the bottom, note
1571          that sp already has been advanced for the arguments!  */
1572 #ifdef CALL_DUMMY_STACK_ADJUST
1573       sp += CALL_DUMMY_STACK_ADJUST;
1574 #endif
1575       sp = STACK_ALIGN (sp);
1576     }
1577 #endif /* STACK_ALIGN */
1578
1579 /* XXX This seems wrong.  For stacks that grow down we shouldn't do
1580    anything here!  */
1581   /* MVS 11/22/96: I think at least some of this stack_align code is
1582      really broken.  Better to let PUSH_ARGUMENTS adjust the stack in
1583      a target-defined manner.  */
1584 #ifdef CALL_DUMMY_STACK_ADJUST
1585   if (INNER_THAN (1, 2))
1586     {
1587       /* stack grows downward */
1588       sp -= CALL_DUMMY_STACK_ADJUST;
1589     }
1590 #endif /* CALL_DUMMY_STACK_ADJUST */
1591
1592   /* Store the address at which the structure is supposed to be
1593      written.  Note that this (and the code which reserved the space
1594      above) assumes that gcc was used to compile this function.  Since
1595      it doesn't cost us anything but space and if the function is pcc
1596      it will ignore this value, we will make that assumption.
1597
1598      Also note that on some machines (like the sparc) pcc uses a 
1599      convention like gcc's.  */
1600
1601   if (struct_return)
1602     STORE_STRUCT_RETURN (struct_addr, sp);
1603
1604   /* Write the stack pointer.  This is here because the statements above
1605      might fool with it.  On SPARC, this write also stores the register
1606      window into the right place in the new stack frame, which otherwise
1607      wouldn't happen.  (See store_inferior_registers in sparc-nat.c.)  */
1608   write_sp (sp);
1609
1610   {
1611     char retbuf[REGISTER_BYTES];
1612     char *name;
1613     struct symbol *symbol;
1614
1615     name = NULL;
1616     symbol = find_pc_function (funaddr);
1617     if (symbol)
1618       {
1619         name = SYMBOL_SOURCE_NAME (symbol);
1620       }
1621     else
1622       {
1623         /* Try the minimal symbols.  */
1624         struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (funaddr);
1625
1626         if (msymbol)
1627           {
1628             name = SYMBOL_SOURCE_NAME (msymbol);
1629           }
1630       }
1631     if (name == NULL)
1632       {
1633         char format[80];
1634         sprintf (format, "at %s", local_hex_format ());
1635         name = alloca (80);
1636         /* FIXME-32x64: assumes funaddr fits in a long.  */
1637         sprintf (name, format, (unsigned long) funaddr);
1638       }
1639
1640     /* Execute the stack dummy routine, calling FUNCTION.
1641        When it is done, discard the empty frame
1642        after storing the contents of all regs into retbuf.  */
1643     if (run_stack_dummy (real_pc + CALL_DUMMY_START_OFFSET, retbuf))
1644       {
1645         /* We stopped somewhere besides the call dummy.  */
1646
1647         /* If we did the cleanups, we would print a spurious error message
1648            (Unable to restore previously selected frame), would write the
1649            registers from the inf_status (which is wrong), and would do other
1650            wrong things (like set stop_bpstat to the wrong thing).  */
1651         discard_cleanups (old_chain);
1652         /* Prevent memory leak.  */
1653         bpstat_clear (&inf_status.stop_bpstat);
1654
1655         /* The following error message used to say "The expression
1656            which contained the function call has been discarded."  It
1657            is a hard concept to explain in a few words.  Ideally, GDB
1658            would be able to resume evaluation of the expression when
1659            the function finally is done executing.  Perhaps someday
1660            this will be implemented (it would not be easy).  */
1661
1662         /* FIXME: Insert a bunch of wrap_here; name can be very long if it's
1663            a C++ name with arguments and stuff.  */
1664         error ("\
1665 The program being debugged stopped while in a function called from GDB.\n\
1666 When the function (%s) is done executing, GDB will silently\n\
1667 stop (instead of continuing to evaluate the expression containing\n\
1668 the function call).", name);
1669       }
1670
1671     do_cleanups (old_chain);
1672
1673     /* Figure out the value returned by the function.  */
1674 /* elz: I defined this new macro for the hppa architecture only.
1675    this gives us a way to get the value returned by the function from the stack,
1676    at the same address we told the function to put it.
1677    We cannot assume on the pa that r28 still contains the address of the returned
1678    structure. Usually this will be overwritten by the callee.
1679    I don't know about other architectures, so I defined this macro
1680 */
1681
1682 #ifdef VALUE_RETURNED_FROM_STACK
1683     if (struct_return)
1684       return (value_ptr) VALUE_RETURNED_FROM_STACK (value_type, struct_addr);
1685 #endif
1686
1687     return value_being_returned (value_type, retbuf, struct_return);
1688   }
1689 }
1690 #else /* no CALL_DUMMY.  */
1691 value_ptr
1692 call_function_by_hand (function, nargs, args)
1693      value_ptr function;
1694      int nargs;
1695      value_ptr *args;
1696 {
1697   error ("Cannot invoke functions on this machine.");
1698 }
1699 #endif /* no CALL_DUMMY.  */
1700
1701 \f
1702 /* Create a value for an array by allocating space in the inferior, copying
1703    the data into that space, and then setting up an array value.
1704
1705    The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
1706    populated from the values passed in ELEMVEC.
1707
1708    The element type of the array is inherited from the type of the
1709    first element, and all elements must have the same size (though we
1710    don't currently enforce any restriction on their types). */
1711
1712 value_ptr
1713 value_array (lowbound, highbound, elemvec)
1714      int lowbound;
1715      int highbound;
1716      value_ptr *elemvec;
1717 {
1718   int nelem;
1719   int idx;
1720   unsigned int typelength;
1721   value_ptr val;
1722   struct type *rangetype;
1723   struct type *arraytype;
1724   CORE_ADDR addr;
1725
1726   /* Validate that the bounds are reasonable and that each of the elements
1727      have the same size. */
1728
1729   nelem = highbound - lowbound + 1;
1730   if (nelem <= 0)
1731     {
1732       error ("bad array bounds (%d, %d)", lowbound, highbound);
1733     }
1734   typelength = TYPE_LENGTH (VALUE_ENCLOSING_TYPE (elemvec[0]));
1735   for (idx = 1; idx < nelem; idx++)
1736     {
1737       if (TYPE_LENGTH (VALUE_ENCLOSING_TYPE (elemvec[idx])) != typelength)
1738         {
1739           error ("array elements must all be the same size");
1740         }
1741     }
1742
1743   rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
1744                                  lowbound, highbound);
1745   arraytype = create_array_type ((struct type *) NULL, 
1746                                  VALUE_ENCLOSING_TYPE (elemvec[0]), rangetype);
1747
1748   if (!current_language->c_style_arrays)
1749     {
1750       val = allocate_value (arraytype);
1751       for (idx = 0; idx < nelem; idx++)
1752         {
1753           memcpy (VALUE_CONTENTS_ALL_RAW (val) + (idx * typelength),
1754                   VALUE_CONTENTS_ALL (elemvec[idx]),
1755                   typelength);
1756         }
1757       VALUE_BFD_SECTION (val) = VALUE_BFD_SECTION (elemvec[0]);
1758       return val;
1759     }
1760
1761   /* Allocate space to store the array in the inferior, and then initialize
1762      it by copying in each element.  FIXME:  Is it worth it to create a
1763      local buffer in which to collect each value and then write all the
1764      bytes in one operation? */
1765
1766   addr = allocate_space_in_inferior (nelem * typelength);
1767   for (idx = 0; idx < nelem; idx++)
1768     {
1769       write_memory (addr + (idx * typelength), VALUE_CONTENTS_ALL (elemvec[idx]),
1770                     typelength);
1771     }
1772
1773   /* Create the array type and set up an array value to be evaluated lazily. */
1774
1775   val = value_at_lazy (arraytype, addr, VALUE_BFD_SECTION (elemvec[0]));
1776   return (val);
1777 }
1778
1779 /* Create a value for a string constant by allocating space in the inferior,
1780    copying the data into that space, and returning the address with type
1781    TYPE_CODE_STRING.  PTR points to the string constant data; LEN is number
1782    of characters.
1783    Note that string types are like array of char types with a lower bound of
1784    zero and an upper bound of LEN - 1.  Also note that the string may contain
1785    embedded null bytes. */
1786
1787 value_ptr
1788 value_string (ptr, len)
1789      char *ptr;
1790      int len;
1791 {
1792   value_ptr val;
1793   int lowbound = current_language->string_lower_bound;
1794   struct type *rangetype = create_range_type ((struct type *) NULL,
1795                                               builtin_type_int,
1796                                               lowbound, len + lowbound - 1);
1797   struct type *stringtype
1798     = create_string_type ((struct type *) NULL, rangetype);
1799   CORE_ADDR addr;
1800
1801   if (current_language->c_style_arrays == 0)
1802     {
1803       val = allocate_value (stringtype);
1804       memcpy (VALUE_CONTENTS_RAW (val), ptr, len);
1805       return val;
1806     }
1807
1808
1809   /* Allocate space to store the string in the inferior, and then
1810      copy LEN bytes from PTR in gdb to that address in the inferior. */
1811
1812   addr = allocate_space_in_inferior (len);
1813   write_memory (addr, ptr, len);
1814
1815   val = value_at_lazy (stringtype, addr, NULL);
1816   return (val);
1817 }
1818
1819 value_ptr
1820 value_bitstring (ptr, len)
1821      char *ptr;
1822      int len;
1823 {
1824   value_ptr val;
1825   struct type *domain_type = create_range_type (NULL, builtin_type_int,
1826                                                 0, len - 1);
1827   struct type *type = create_set_type ((struct type*) NULL, domain_type);
1828   TYPE_CODE (type) = TYPE_CODE_BITSTRING;
1829   val = allocate_value (type);
1830   memcpy (VALUE_CONTENTS_RAW (val), ptr, TYPE_LENGTH (type));
1831   return val;
1832 }
1833 \f
1834 /* See if we can pass arguments in T2 to a function which takes arguments
1835    of types T1.  Both t1 and t2 are NULL-terminated vectors.  If some
1836    arguments need coercion of some sort, then the coerced values are written
1837    into T2.  Return value is 0 if the arguments could be matched, or the
1838    position at which they differ if not.
1839
1840    STATICP is nonzero if the T1 argument list came from a
1841    static member function.
1842
1843    For non-static member functions, we ignore the first argument,
1844    which is the type of the instance variable.  This is because we want
1845    to handle calls with objects from derived classes.  This is not
1846    entirely correct: we should actually check to make sure that a
1847    requested operation is type secure, shouldn't we?  FIXME.  */
1848
1849 static int
1850 typecmp (staticp, t1, t2)
1851      int staticp;
1852      struct type *t1[];
1853      value_ptr t2[];
1854 {
1855   int i;
1856
1857   if (t2 == 0)
1858     return 1;
1859   if (staticp && t1 == 0)
1860     return t2[1] != 0;
1861   if (t1 == 0)
1862     return 1;
1863   if (TYPE_CODE (t1[0]) == TYPE_CODE_VOID) return 0;
1864   if (t1[!staticp] == 0) return 0;
1865   for (i = !staticp; t1[i] && TYPE_CODE (t1[i]) != TYPE_CODE_VOID; i++)
1866     {
1867     struct type *tt1, *tt2;
1868       if (! t2[i])
1869         return i+1;
1870       tt1 = check_typedef (t1[i]);
1871       tt2 = check_typedef (VALUE_TYPE(t2[i]));
1872       if (TYPE_CODE (tt1) == TYPE_CODE_REF
1873           /* We should be doing hairy argument matching, as below.  */
1874           && (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (tt1))) == TYPE_CODE (tt2)))
1875         {
1876           if (TYPE_CODE (tt2) == TYPE_CODE_ARRAY)
1877             t2[i] = value_coerce_array (t2[i]);
1878           else
1879             t2[i] = value_addr (t2[i]);
1880           continue;
1881         }
1882
1883       while (TYPE_CODE (tt1) == TYPE_CODE_PTR
1884           && (   TYPE_CODE (tt2) == TYPE_CODE_ARRAY
1885               || TYPE_CODE (tt2) == TYPE_CODE_PTR))
1886         {
1887            tt1 = check_typedef (TYPE_TARGET_TYPE(tt1)); 
1888            tt2 = check_typedef (TYPE_TARGET_TYPE(tt2));
1889         }
1890       if (TYPE_CODE(tt1) == TYPE_CODE(tt2)) continue;
1891       /* Array to pointer is a `trivial conversion' according to the ARM.  */
1892
1893       /* We should be doing much hairier argument matching (see section 13.2
1894          of the ARM), but as a quick kludge, just check for the same type
1895          code.  */
1896       if (TYPE_CODE (t1[i]) != TYPE_CODE (VALUE_TYPE (t2[i])))
1897         return i+1;
1898     }
1899   if (!t1[i]) return 0;
1900   return t2[i] ? i+1 : 0;
1901 }
1902
1903 /* Helper function used by value_struct_elt to recurse through baseclasses.
1904    Look for a field NAME in ARG1. Adjust the address of ARG1 by OFFSET bytes,
1905    and search in it assuming it has (class) type TYPE.
1906    If found, return value, else return NULL.
1907
1908    If LOOKING_FOR_BASECLASS, then instead of looking for struct fields,
1909    look for a baseclass named NAME.  */
1910
1911 static value_ptr
1912 search_struct_field (name, arg1, offset, type, looking_for_baseclass)
1913      char *name;
1914      register value_ptr arg1;
1915      int offset;
1916      register struct type *type;
1917      int looking_for_baseclass;
1918 {
1919   int found = 0;
1920   char found_class[1024];
1921   value_ptr v;
1922   struct type *vbase = NULL;
1923
1924   found_class[0] = '\000';
1925   
1926   v = search_struct_field_aux (name, arg1, offset, type, looking_for_baseclass, &found, found_class, &vbase);
1927   if (found > 1)
1928     warning ("%s ambiguous; using %s::%s. Use a cast to disambiguate.",
1929              name, found_class, name);
1930
1931   return v;
1932 }
1933
1934
1935 static value_ptr
1936 search_struct_field_aux (name, arg1, offset, type, looking_for_baseclass, found, found_class_name, vbase)
1937      char *name;
1938      register value_ptr arg1;
1939      int offset;
1940      register struct type *type;
1941      int looking_for_baseclass;
1942      int * found;
1943      char * found_class_name;
1944      struct type ** vbase;
1945 {
1946   int i;
1947   value_ptr retval = NULL;
1948   char tmp_class_name[1024];
1949   int tmp_found = 0;
1950   int assigned = 0;
1951   int nbases = TYPE_N_BASECLASSES (type);
1952   
1953   tmp_class_name[0] = '\000';
1954
1955   CHECK_TYPEDEF (type);
1956
1957   if (! looking_for_baseclass)
1958     for (i = TYPE_NFIELDS (type) - 1; i >= nbases; i--)
1959       {
1960         char *t_field_name = TYPE_FIELD_NAME (type, i);
1961
1962         if (t_field_name && STREQ (t_field_name, name))
1963           {
1964             value_ptr v = NULL;
1965             if (TYPE_FIELD_STATIC (type, i))
1966               v = value_static_field (type, i);
1967             if (v != NULL)
1968               {
1969                 if (!*found)
1970                   {
1971                     /* Record return value and class name, and continue
1972                        looking for possible ambiguous members */ 
1973                     char *class_name = TYPE_TAG_NAME (type);
1974                     retval = v;
1975                     if (class_name) 
1976                       strcpy (found_class_name, class_name);
1977                     else 
1978                       found_class_name = NULL;
1979                   }
1980                 (*found)++;
1981               }
1982             else
1983               {
1984                 v = value_primitive_field (arg1, offset, i, type);
1985                 if (v != NULL)
1986                   {
1987                     if (!*found)
1988                       {
1989                         /* Record return value and class name, and continue
1990                            looking for possible ambiguous members */ 
1991                         char *class_name = TYPE_TAG_NAME (type);
1992                         retval = v;
1993                         if (class_name) 
1994                           strcpy (found_class_name, class_name);
1995                         else 
1996                           found_class_name = NULL;
1997                       }
1998                     (*found)++;
1999                   }
2000               }
2001
2002             if (v == 0)
2003               error("Couldn't retrieve field named %s", name);
2004           }
2005
2006         if (t_field_name
2007             && (t_field_name[0] == '\0'
2008                 || (TYPE_CODE (type) == TYPE_CODE_UNION
2009                     && STREQ (t_field_name, "else"))))
2010           {
2011             struct type *field_type = TYPE_FIELD_TYPE (type, i);
2012             if (TYPE_CODE (field_type) == TYPE_CODE_UNION
2013                 || TYPE_CODE (field_type) == TYPE_CODE_STRUCT)
2014               {
2015                 /* Look for a match through the fields of an anonymous union,
2016                    or anonymous struct.  C++ provides anonymous unions.
2017
2018                    In the GNU Chill implementation of variant record types,
2019                    each <alternative field> has an (anonymous) union type,
2020                    each member of the union represents a <variant alternative>.
2021                    Each <variant alternative> is represented as a struct,
2022                    with a member for each <variant field>.  */
2023                    
2024                 value_ptr v;
2025                 int new_offset = offset;
2026
2027                 /* This is pretty gross.  In G++, the offset in an anonymous
2028                    union is relative to the beginning of the enclosing struct.
2029                    In the GNU Chill implementation of variant records,
2030                    the bitpos is zero in an anonymous union field, so we
2031                    have to add the offset of the union here. */
2032                 if (TYPE_CODE (field_type) == TYPE_CODE_STRUCT
2033                     || (TYPE_NFIELDS (field_type) > 0
2034                         && TYPE_FIELD_BITPOS (field_type, 0) == 0))
2035                   new_offset += TYPE_FIELD_BITPOS (type, i) / 8;
2036
2037                 v = search_struct_field_aux (name, arg1, new_offset, field_type,
2038                                              looking_for_baseclass, &tmp_found, 
2039                                              tmp_class_name, vbase);
2040                 if (!*found && v)
2041                   {
2042                     /* Record return value and class name, and continue
2043                        looking for possible ambiguous members */ 
2044                     retval = v;
2045                     /* TYPE_TAG_NAME can be null in case of an anonymous union */
2046                     if (TYPE_TAG_NAME (type))
2047                       strcpy (found_class_name, TYPE_TAG_NAME (type));
2048                     else 
2049                       strcpy (found_class_name, " ");
2050                     strcat (found_class_name, "::");
2051                     strcat (found_class_name, tmp_class_name);
2052                   }
2053                 *found += tmp_found;
2054                 tmp_found = 0;
2055               }
2056           }
2057       }
2058
2059   for (i = 0;  i < nbases;  i++)
2060     {
2061       value_ptr v;
2062       struct type *basetype = check_typedef (TYPE_BASECLASS (type, i));
2063       /* If we are looking for baseclasses, this is what we get when we
2064          hit them.  But it could happen that the base part's member name
2065          is not yet filled in.  */
2066       int found_baseclass = (looking_for_baseclass
2067                              && TYPE_BASECLASS_NAME (type, i) != NULL
2068                              && STREQ (name, TYPE_BASECLASS_NAME (type, i)));
2069
2070       if (BASETYPE_VIA_VIRTUAL (type, i))
2071         {
2072           int boffset;
2073           value_ptr v2 = allocate_value (VALUE_ENCLOSING_TYPE (arg1));
2074
2075           if (TYPE_HAS_VTABLE (type))
2076             {
2077               /* HP aCC compiled type, use Taligent/HP runtime model */ 
2078               int skip;
2079               find_rt_vbase_offset (type, TYPE_BASECLASS (type, i),
2080                                     VALUE_CONTENTS_ALL (arg1),
2081                                     offset + VALUE_EMBEDDED_OFFSET (arg1),
2082                                     &boffset, &skip);
2083               if (skip >= 0)
2084                 error ("Virtual base class offset not found from vtable");
2085             }
2086  
2087           else
2088            {
2089
2090               boffset = baseclass_offset (type, i,
2091                                            VALUE_CONTENTS_ALL (arg1) + offset,
2092                                            VALUE_ADDRESS (arg1)
2093                                             + VALUE_OFFSET (arg1) + offset);
2094               if (boffset == -1)
2095               error ("virtual baseclass botch");
2096
2097           /* The virtual base class pointer might have been clobbered by the
2098              user program. Make sure that it still points to a valid memory
2099              location.  */
2100
2101              if ((boffset + offset) < 0 || 
2102                  (boffset + offset) >= TYPE_LENGTH (type))
2103                {
2104                  CORE_ADDR base_addr;
2105         
2106                  base_addr = VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1) + 
2107                              boffset + offset;
2108                  if (target_read_memory (base_addr, VALUE_CONTENTS_RAW (v2),
2109                                       TYPE_LENGTH (basetype)) != 0)
2110                    error ("virtual baseclass botch");
2111                 VALUE_LVAL (v2) = lval_memory;
2112                 VALUE_ADDRESS (v2) = base_addr;
2113                 assigned = 1;
2114                }
2115            }
2116         
2117           if (!assigned)   
2118            {
2119              VALUE_LVAL (v2) = VALUE_LVAL (arg1);
2120              VALUE_ADDRESS (v2) = VALUE_ADDRESS (arg1);
2121            }
2122
2123           /* Earlier, this code used to allocate a value of type
2124              basetype and copy the contents of arg1 at the
2125              appropriate offset into the new value.  This doesn't
2126              work because there is important stuff (virtual bases,
2127              for example) that could be anywhere in the contents
2128              of arg1, and not just within the length of a basetype
2129              object.  In particular the boffset below could be
2130              negative, with the HP/Taligent C++ runtime system.
2131              So, the only way to ensure that required information
2132              is not lost is to always allocate a value of the same
2133              type as arg1 and to fill it with the _entire_
2134              contents of arg1.  It sounds wasteful, but there is
2135              really no way around it if later member lookup,
2136              casts, etc. have to work correctly with the returned
2137              value.  */
2138  
2139
2140           VALUE_TYPE (v2) = basetype;
2141           VALUE_OFFSET (v2) = VALUE_OFFSET (arg1);
2142           VALUE_EMBEDDED_OFFSET(v2)
2143              = VALUE_EMBEDDED_OFFSET(arg1) + offset + boffset;
2144           if (VALUE_LAZY (arg1))
2145              VALUE_LAZY (v2) = 1;
2146           else
2147              memcpy ((char *) (v2)->aligner.contents,
2148                      (char *) (arg1)->aligner.contents,
2149                      TYPE_LENGTH (VALUE_ENCLOSING_TYPE (arg1)));
2150
2151           if (found_baseclass)
2152             {     
2153               /*return v2;*/
2154
2155               if (!*found) /* not yet found anything */ 
2156                 {
2157                   /* Record return value and class name, and continue
2158                      looking for possible ambiguous members */ 
2159                   retval = v2;
2160                   strcpy (found_class_name, TYPE_TAG_NAME (type));
2161                 }
2162               /* Don't count virtual bases twice when deciding ambiguity */ 
2163               if (*vbase != basetype) /* works for null *vbase */ 
2164                 (*found)++;
2165               /* Is this the first virtual base where we "found" something? */ 
2166               if (!*vbase)
2167                 *vbase = basetype;
2168             }
2169           else /* base not found, or looking for member */ 
2170             {
2171               v = search_struct_field_aux (name, arg1, offset + boffset,
2172                                            TYPE_BASECLASS (type, i),
2173                                            looking_for_baseclass, &tmp_found,
2174                                            tmp_class_name, vbase);
2175               if (!*found && v)
2176                 {
2177                   /* Record return value and class name, and continue
2178                      looking for possible ambiguous members */ 
2179                   retval = v;
2180                   /* TYPE_TAG_NAME can be null in case of an anonymous union */
2181                   if (TYPE_TAG_NAME (type))
2182                     strcpy (found_class_name, TYPE_TAG_NAME (type));
2183                   else
2184                     strcpy (found_class_name, " ");
2185                   strcat (found_class_name, "::");
2186                   strcat (found_class_name, tmp_class_name);
2187                 }
2188               /* Don't count virtual bases twice when deciding ambiguity */ 
2189               if (*vbase != basetype) /* works for null *vbase */ 
2190                 *found += tmp_found;
2191               /* Is this the first virtual base where we "found" something? */ 
2192               if (!*vbase)
2193                   *vbase =  basetype;
2194               tmp_found = 0;
2195             }
2196         }
2197       else if (found_baseclass)
2198         {
2199           v = value_primitive_field (arg1, offset, i, type);
2200           if (!*found)
2201             {
2202               /* Record return value and class name, and continue
2203                  looking for possible ambiguous members */ 
2204               retval = v;
2205               strcpy (found_class_name, TYPE_TAG_NAME (type));
2206             }
2207           (*found)++;
2208         }
2209       else
2210         {
2211           v = search_struct_field_aux (name, arg1,
2212                                        offset + TYPE_BASECLASS_BITPOS (type, i) / 8,
2213                                        basetype, looking_for_baseclass, &tmp_found,
2214                                        tmp_class_name, vbase);
2215           if (!*found && v)
2216             {
2217               /* Record return value and class name, and continue
2218                  looking for possible ambiguous members */ 
2219               retval = v;
2220               /* TYPE_TAG_NAME can be null in case of an anonymous union */
2221               if (TYPE_TAG_NAME (type))
2222                 strcpy (found_class_name, TYPE_TAG_NAME (type));
2223               else 
2224                 strcpy (found_class_name, " ");
2225               strcat (found_class_name, "::");
2226               strcat (found_class_name, tmp_class_name);
2227             }
2228           *found += tmp_found;
2229           tmp_found = 0;
2230         }
2231     }
2232   return retval;
2233 }
2234
2235
2236 /* Return the offset (in bytes) of the virtual base of type BASETYPE
2237  * in an object pointed to by VALADDR (on the host), assumed to be of
2238  * type TYPE.  OFFSET is number of bytes beyond start of ARG to start
2239  * looking (in case VALADDR is the contents of an enclosing object).
2240  *
2241  * This routine recurses on the primary base of the derived class because
2242  * the virtual base entries of the primary base appear before the other
2243  * virtual base entries.
2244  *
2245  * If the virtual base is not found, a negative integer is returned.
2246  * The magnitude of the negative integer is the number of entries in
2247  * the virtual table to skip over (entries corresponding to various
2248  * ancestral classes in the chain of primary bases).
2249  *
2250  * Important: This assumes the HP / Taligent C++ runtime
2251  * conventions. Use baseclass_offset() instead to deal with g++
2252  * conventions.  */
2253
2254 void
2255 find_rt_vbase_offset(type, basetype, valaddr, offset, boffset_p, skip_p)
2256   struct type * type;
2257   struct type * basetype;
2258   char * valaddr;
2259   int offset;
2260   int * boffset_p;
2261   int * skip_p;
2262 {
2263   int boffset;           /* offset of virtual base */
2264   int index;             /* displacement to use in virtual table */
2265   int skip;
2266   
2267   value_ptr vp;      
2268   CORE_ADDR vtbl;      /* the virtual table pointer */
2269   struct type * pbc;   /* the primary base class */
2270
2271   /* Look for the virtual base recursively in the primary base, first.
2272    * This is because the derived class object and its primary base
2273    * subobject share the primary virtual table.  */
2274   
2275   boffset = 0;
2276   pbc = TYPE_PRIMARY_BASE(type);
2277   if (pbc)
2278     {
2279       find_rt_vbase_offset (pbc, basetype, valaddr, offset, &boffset, &skip);
2280       if (skip < 0)
2281         {
2282           *boffset_p = boffset;
2283           *skip_p = -1;
2284           return;
2285         }
2286     }
2287   else
2288     skip = 0;
2289
2290
2291   /* Find the index of the virtual base according to HP/Taligent
2292      runtime spec. (Depth-first, left-to-right.)  */
2293   index = virtual_base_index_skip_primaries (basetype, type);
2294
2295   if (index < 0) {
2296     *skip_p = skip + virtual_base_list_length_skip_primaries (type);
2297     *boffset_p = 0;
2298     return;
2299   }
2300
2301   /* pai: FIXME -- 32x64 possible problem */ 
2302   /* First word (4 bytes) in object layout is the vtable pointer */
2303   vtbl = * (CORE_ADDR *) (valaddr + offset);
2304
2305   /* Before the constructor is invoked, things are usually zero'd out. */ 
2306   if (vtbl == 0)
2307     error ("Couldn't find virtual table -- object may not be constructed yet.");
2308
2309
2310   /* Find virtual base's offset -- jump over entries for primary base
2311    * ancestors, then use the index computed above.  But also adjust by
2312    * HP_ACC_VBASE_START for the vtable slots before the start of the
2313    * virtual base entries.  Offset is negative -- virtual base entries
2314    * appear _before_ the address point of the virtual table. */
2315   
2316   /* pai: FIXME -- 32x64 problem, if word = 8 bytes, change multiplier 
2317      & use long type */ 
2318
2319   /* epstein : FIXME -- added param for overlay section. May not be correct */
2320    vp = value_at (builtin_type_int, vtbl + 4 * (- skip - index - HP_ACC_VBASE_START), NULL);
2321   boffset = value_as_long (vp);
2322   *skip_p = -1;
2323   *boffset_p = boffset;
2324   return;
2325 }
2326
2327
2328 /* Helper function used by value_struct_elt to recurse through baseclasses.
2329    Look for a field NAME in ARG1. Adjust the address of ARG1 by OFFSET bytes,
2330    and search in it assuming it has (class) type TYPE.
2331    If found, return value, else if name matched and args not return (value)-1,
2332    else return NULL. */
2333
2334 static value_ptr
2335 search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
2336      char *name;
2337      register value_ptr *arg1p, *args;
2338      int offset, *static_memfuncp;
2339      register struct type *type;
2340 {
2341   int i;
2342   value_ptr v;
2343   int name_matched = 0;
2344   char dem_opname[64];
2345
2346   CHECK_TYPEDEF (type);
2347   for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; i--)
2348     {
2349       char *t_field_name = TYPE_FN_FIELDLIST_NAME (type, i);
2350       /* FIXME!  May need to check for ARM demangling here */
2351       if (strncmp(t_field_name, "__", 2)==0 ||
2352         strncmp(t_field_name, "op", 2)==0 ||
2353         strncmp(t_field_name, "type", 4)==0 )
2354         {
2355           if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
2356             t_field_name = dem_opname;
2357           else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
2358             t_field_name = dem_opname; 
2359         }
2360       if (t_field_name && STREQ (t_field_name, name))
2361         {
2362           int j = TYPE_FN_FIELDLIST_LENGTH (type, i) - 1;
2363           struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
2364           name_matched = 1; 
2365
2366           if (j > 0 && args == 0)
2367             error ("cannot resolve overloaded method `%s': no arguments supplied", name);
2368           while (j >= 0)
2369             {
2370               if (TYPE_FN_FIELD_STUB (f, j))
2371                 check_stub_method (type, i, j);
2372               if (!typecmp (TYPE_FN_FIELD_STATIC_P (f, j),
2373                             TYPE_FN_FIELD_ARGS (f, j), args))
2374                 {
2375                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
2376                     return value_virtual_fn_field (arg1p, f, j, type, offset);
2377                   if (TYPE_FN_FIELD_STATIC_P (f, j) && static_memfuncp)
2378                     *static_memfuncp = 1;
2379                   v = value_fn_field (arg1p, f, j, type, offset);
2380                   if (v != NULL) return v;
2381                 }
2382               j--;
2383             }
2384         }
2385     }
2386
2387   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
2388     {
2389       int base_offset;
2390
2391       if (BASETYPE_VIA_VIRTUAL (type, i))
2392         {
2393          if (TYPE_HAS_VTABLE (type))
2394             {
2395               /* HP aCC compiled type, search for virtual base offset
2396                  according to HP/Taligent runtime spec.  */
2397               int skip;
2398               find_rt_vbase_offset (type, TYPE_BASECLASS (type, i),
2399                                     VALUE_CONTENTS_ALL (*arg1p),
2400                                     offset + VALUE_EMBEDDED_OFFSET (*arg1p),
2401                                     &base_offset, &skip);
2402               if (skip >= 0)
2403                 error ("Virtual base class offset not found in vtable");
2404             }
2405          else
2406            {
2407              struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
2408              char *base_valaddr;
2409
2410              /* The virtual base class pointer might have been clobbered by the
2411                 user program. Make sure that it still points to a valid memory
2412                 location.  */
2413
2414              if (offset < 0 || offset >= TYPE_LENGTH (type))
2415                {
2416                  base_valaddr = (char *) alloca (TYPE_LENGTH (baseclass));
2417                  if (target_read_memory (VALUE_ADDRESS (*arg1p)
2418                                          + VALUE_OFFSET (*arg1p) + offset,
2419                                          base_valaddr,
2420                                          TYPE_LENGTH (baseclass)) != 0)
2421                    error ("virtual baseclass botch");
2422                }
2423             else
2424                base_valaddr = VALUE_CONTENTS (*arg1p) + offset;
2425
2426             base_offset =
2427                baseclass_offset (type, i, base_valaddr,
2428                                  VALUE_ADDRESS (*arg1p)
2429                                    + VALUE_OFFSET (*arg1p) + offset);
2430             if (base_offset == -1)
2431                error ("virtual baseclass botch");
2432            }
2433         }
2434       else
2435         {
2436           base_offset = TYPE_BASECLASS_BITPOS (type, i) / 8;
2437         }
2438       v = search_struct_method (name, arg1p, args, base_offset + offset,
2439                                 static_memfuncp, TYPE_BASECLASS (type, i));
2440       if (v == (value_ptr) -1)
2441         {
2442           name_matched = 1;
2443         }
2444       else if (v)
2445         {
2446 /* FIXME-bothner:  Why is this commented out?  Why is it here?  */
2447 /*        *arg1p = arg1_tmp;*/
2448           return v;
2449         }
2450     }
2451   if (name_matched) return (value_ptr) -1;
2452   else return NULL;
2453 }
2454
2455 /* Given *ARGP, a value of type (pointer to a)* structure/union,
2456    extract the component named NAME from the ultimate target structure/union
2457    and return it as a value with its appropriate type.
2458    ERR is used in the error message if *ARGP's type is wrong.
2459
2460    C++: ARGS is a list of argument types to aid in the selection of
2461    an appropriate method. Also, handle derived types.
2462
2463    STATIC_MEMFUNCP, if non-NULL, points to a caller-supplied location
2464    where the truthvalue of whether the function that was resolved was
2465    a static member function or not is stored.
2466
2467    ERR is an error message to be printed in case the field is not found.  */
2468
2469 value_ptr
2470 value_struct_elt (argp, args, name, static_memfuncp, err)
2471      register value_ptr *argp, *args;
2472      char *name;
2473      int *static_memfuncp;
2474      char *err;
2475 {
2476   register struct type *t;
2477   value_ptr v;
2478
2479   COERCE_ARRAY (*argp);
2480
2481   t = check_typedef (VALUE_TYPE (*argp));
2482
2483   /* Follow pointers until we get to a non-pointer.  */
2484
2485   while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
2486     {
2487       *argp = value_ind (*argp);
2488       /* Don't coerce fn pointer to fn and then back again!  */
2489       if (TYPE_CODE (VALUE_TYPE (*argp)) != TYPE_CODE_FUNC)
2490         COERCE_ARRAY (*argp);
2491       t = check_typedef (VALUE_TYPE (*argp));
2492     }
2493
2494   if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
2495     error ("not implemented: member type in value_struct_elt");
2496
2497   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
2498       && TYPE_CODE (t) != TYPE_CODE_UNION)
2499     error ("Attempt to extract a component of a value that is not a %s.", err);
2500
2501   /* Assume it's not, unless we see that it is.  */
2502   if (static_memfuncp)
2503     *static_memfuncp =0;
2504
2505   if (!args)
2506     {
2507       /* if there are no arguments ...do this...  */
2508
2509       /* Try as a field first, because if we succeed, there
2510          is less work to be done.  */
2511       v = search_struct_field (name, *argp, 0, t, 0);
2512       if (v)
2513         return v;
2514
2515       /* C++: If it was not found as a data field, then try to
2516          return it as a pointer to a method.  */
2517
2518       if (destructor_name_p (name, t))
2519         error ("Cannot get value of destructor");
2520
2521       v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
2522
2523       if (v == (value_ptr) -1)
2524         error ("Cannot take address of a method");
2525       else if (v == 0)
2526         {
2527           if (TYPE_NFN_FIELDS (t))
2528             error ("There is no member or method named %s.", name);
2529           else
2530             error ("There is no member named %s.", name);
2531         }
2532       return v;
2533     }
2534
2535   if (destructor_name_p (name, t))
2536     {
2537       if (!args[1])
2538         {
2539           /* Destructors are a special case.  */
2540           int m_index, f_index;
2541
2542           v = NULL;
2543           if (get_destructor_fn_field (t, &m_index, &f_index))
2544             {
2545               v = value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, m_index),
2546                                   f_index, NULL, 0);
2547             }
2548           if (v == NULL)
2549             error ("could not find destructor function named %s.", name);
2550           else
2551             return v;
2552         }
2553       else
2554         {
2555           error ("destructor should not have any argument");
2556         }
2557     }
2558   else
2559     v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
2560
2561   if (v == (value_ptr) -1)
2562     {
2563         error("Argument list of %s mismatch with component in the structure.", name);
2564     }
2565   else if (v == 0)
2566     {
2567       /* See if user tried to invoke data as function.  If so,
2568          hand it back.  If it's not callable (i.e., a pointer to function),
2569          gdb should give an error.  */
2570       v = search_struct_field (name, *argp, 0, t, 0);
2571     }
2572
2573   if (!v)
2574     error ("Structure has no component named %s.", name);
2575   return v;
2576 }
2577
2578
2579 /* Search through the methods of an object (and its bases)
2580  * to find a specified method. Return the pointer to the
2581  * fn_field list of overloaded instances.
2582  * Helper function for value_find_oload_list.
2583  * ARGP is a pointer to a pointer to a value (the object)
2584  * METHOD is a string containing the method name
2585  * OFFSET is the offset within the value
2586  * STATIC_MEMFUNCP is set if the method is static
2587  * TYPE is the assumed type of the object
2588  * NUM_FNS is the number of overloaded instances
2589  * BASETYPE is set to the actual type of the subobject where the method is found
2590  * BOFFSET is the offset of the base subobject where the method is found */
2591
2592 struct fn_field *
2593 find_method_list (argp, method, offset, static_memfuncp, type, num_fns, basetype, boffset)
2594   value_ptr *argp;
2595   char * method;
2596   int offset;
2597   int * static_memfuncp;
2598   struct type * type;
2599   int * num_fns;
2600   struct type ** basetype;
2601   int * boffset;
2602 {
2603   int i;
2604   struct fn_field * f;
2605   CHECK_TYPEDEF (type);
2606
2607   *num_fns = 0;
2608
2609   /* First check in object itself */ 
2610   for (i = TYPE_NFN_FIELDS (type) -1; i >= 0; i--)
2611     {
2612       /* pai: FIXME What about operators and type conversions? */
2613       char * fn_field_name = TYPE_FN_FIELDLIST_NAME (type, i);
2614       if (fn_field_name && STREQ (fn_field_name, method))
2615         {
2616           *num_fns = TYPE_FN_FIELDLIST_LENGTH (type, i);
2617           *basetype = type;
2618           *boffset = offset;
2619           return TYPE_FN_FIELDLIST1 (type, i);
2620         }
2621     }
2622   
2623   /* Not found in object, check in base subobjects */
2624   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
2625     {
2626       int base_offset;
2627       if (BASETYPE_VIA_VIRTUAL (type, i))
2628         {
2629           if (TYPE_HAS_VTABLE (type))
2630             {
2631               /* HP aCC compiled type, search for virtual base offset
2632                * according to HP/Taligent runtime spec.  */
2633               int skip;
2634               find_rt_vbase_offset (type, TYPE_BASECLASS (type, i),
2635                                     VALUE_CONTENTS_ALL (*argp),
2636                                     offset + VALUE_EMBEDDED_OFFSET (*argp),
2637                                     &base_offset, &skip);
2638               if (skip >= 0)
2639                 error ("Virtual base class offset not found in vtable");
2640             }
2641           else
2642             {
2643               /* probably g++ runtime model */ 
2644               base_offset = VALUE_OFFSET (*argp) + offset;
2645               base_offset =
2646                 baseclass_offset (type, i,
2647                                   VALUE_CONTENTS (*argp) + base_offset,
2648                                   VALUE_ADDRESS (*argp) + base_offset);
2649               if (base_offset == -1)
2650                 error ("virtual baseclass botch");
2651             }
2652         }
2653       else /* non-virtual base, simply use bit position from debug info */
2654         {
2655           base_offset = TYPE_BASECLASS_BITPOS (type, i) / 8;
2656         }
2657       f = find_method_list (argp, method, base_offset + offset,
2658                             static_memfuncp, TYPE_BASECLASS (type, i), num_fns, basetype, boffset);
2659       if (f)
2660         return f;
2661     }
2662   return NULL;  
2663 }
2664
2665 /* Return the list of overloaded methods of a specified name.
2666  * ARGP is a pointer to a pointer to a value (the object)
2667  * METHOD is the method name
2668  * OFFSET is the offset within the value contents
2669  * STATIC_MEMFUNCP is set if the method is static
2670  * NUM_FNS is the number of overloaded instances
2671  * BASETYPE is set to the type of the base subobject that defines the method
2672  * BOFFSET is the offset of the base subobject which defines the method */
2673
2674 struct fn_field *
2675 value_find_oload_method_list (argp, method, offset, static_memfuncp, num_fns, basetype, boffset)
2676   value_ptr *argp;
2677   char * method;
2678   int offset;
2679   int * static_memfuncp;
2680   int * num_fns;
2681   struct type ** basetype;
2682   int * boffset;
2683 {
2684   struct type * t;
2685   value_ptr v;
2686
2687   t = check_typedef (VALUE_TYPE (*argp));
2688
2689   /* code snarfed from value_struct_elt */ 
2690   while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
2691     {
2692       *argp = value_ind (*argp);
2693       /* Don't coerce fn pointer to fn and then back again!  */
2694       if (TYPE_CODE (VALUE_TYPE (*argp)) != TYPE_CODE_FUNC)
2695         COERCE_ARRAY (*argp);
2696       t = check_typedef (VALUE_TYPE (*argp));
2697     }
2698   
2699   if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
2700     error ("Not implemented: member type in value_find_oload_lis");
2701   
2702   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
2703          && TYPE_CODE (t) != TYPE_CODE_UNION)
2704     error ("Attempt to extract a component of a value that is not a struct or union");
2705   
2706   /* Assume it's not static, unless we see that it is.  */
2707   if (static_memfuncp)
2708     *static_memfuncp =0;
2709
2710   return find_method_list (argp, method, 0, static_memfuncp, t, num_fns, basetype, boffset);
2711   
2712 }
2713
2714 /* C++: return 1 is NAME is a legitimate name for the destructor
2715    of type TYPE.  If TYPE does not have a destructor, or
2716    if NAME is inappropriate for TYPE, an error is signaled.  */
2717 int
2718 destructor_name_p (name, type)
2719      const char *name;
2720      const struct type *type;
2721 {
2722   /* destructors are a special case.  */
2723
2724   if (name[0] == '~')
2725     {
2726       char *dname = type_name_no_tag (type);
2727       char *cp = strchr (dname, '<');
2728       unsigned int len;
2729
2730       /* Do not compare the template part for template classes.  */
2731       if (cp == NULL)
2732         len = strlen (dname);
2733       else
2734         len = cp - dname;
2735       if (strlen (name + 1) != len || !STREQN (dname, name + 1, len))
2736         error ("name of destructor must equal name of class");
2737       else
2738         return 1;
2739     }
2740   return 0;
2741 }
2742
2743 /* Helper function for check_field: Given TYPE, a structure/union,
2744    return 1 if the component named NAME from the ultimate
2745    target structure/union is defined, otherwise, return 0. */
2746
2747 static int
2748 check_field_in (type, name)
2749      register struct type *type;
2750      const char *name;
2751 {
2752   register int i;
2753
2754   for (i = TYPE_NFIELDS (type) - 1; i >= TYPE_N_BASECLASSES (type); i--)
2755     {
2756       char *t_field_name = TYPE_FIELD_NAME (type, i);
2757       if (t_field_name && STREQ (t_field_name, name))
2758         return 1;
2759     }
2760
2761   /* C++: If it was not found as a data field, then try to
2762      return it as a pointer to a method.  */
2763
2764   /* Destructors are a special case.  */
2765   if (destructor_name_p (name, type))
2766     {
2767       int m_index, f_index;
2768
2769       return get_destructor_fn_field (type, &m_index, &f_index);
2770     }
2771
2772   for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; --i)
2773     {
2774       if (STREQ (TYPE_FN_FIELDLIST_NAME (type, i), name))
2775         return 1;
2776     }
2777
2778   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
2779     if (check_field_in (TYPE_BASECLASS (type, i), name))
2780       return 1;
2781       
2782   return 0;
2783 }
2784
2785
2786 /* C++: Given ARG1, a value of type (pointer to a)* structure/union,
2787    return 1 if the component named NAME from the ultimate
2788    target structure/union is defined, otherwise, return 0.  */
2789
2790 int
2791 check_field (arg1, name)
2792      register value_ptr arg1;
2793      const char *name;
2794 {
2795   register struct type *t;
2796
2797   COERCE_ARRAY (arg1);
2798
2799   t = VALUE_TYPE (arg1);
2800
2801   /* Follow pointers until we get to a non-pointer.  */
2802
2803   for (;;)
2804     {
2805       CHECK_TYPEDEF (t);
2806       if (TYPE_CODE (t) != TYPE_CODE_PTR && TYPE_CODE (t) != TYPE_CODE_REF)
2807         break;
2808       t = TYPE_TARGET_TYPE (t);
2809     }
2810
2811   if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
2812     error ("not implemented: member type in check_field");
2813
2814   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
2815       && TYPE_CODE (t) != TYPE_CODE_UNION)
2816     error ("Internal error: `this' is not an aggregate");
2817
2818   return check_field_in (t, name);
2819 }
2820
2821 /* C++: Given an aggregate type CURTYPE, and a member name NAME,
2822    return the address of this member as a "pointer to member"
2823    type.  If INTYPE is non-null, then it will be the type
2824    of the member we are looking for.  This will help us resolve
2825    "pointers to member functions".  This function is used
2826    to resolve user expressions of the form "DOMAIN::NAME".  */
2827
2828 value_ptr
2829 value_struct_elt_for_reference (domain, offset, curtype, name, intype)
2830      struct type *domain, *curtype, *intype;
2831      int offset;
2832      char *name;
2833 {
2834   register struct type *t = curtype;
2835   register int i;
2836   value_ptr v;
2837
2838   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
2839       && TYPE_CODE (t) != TYPE_CODE_UNION)
2840     error ("Internal error: non-aggregate type to value_struct_elt_for_reference");
2841
2842   for (i = TYPE_NFIELDS (t) - 1; i >= TYPE_N_BASECLASSES (t); i--)
2843     {
2844       char *t_field_name = TYPE_FIELD_NAME (t, i);
2845       
2846       if (t_field_name && STREQ (t_field_name, name))
2847         {
2848           if (TYPE_FIELD_STATIC (t, i))
2849             {
2850               v = value_static_field (t, i);
2851               if (v == NULL)
2852                 error ("Internal error: could not find static variable %s",
2853                        name);
2854               return v;
2855             }
2856           if (TYPE_FIELD_PACKED (t, i))
2857             error ("pointers to bitfield members not allowed");
2858           
2859           return value_from_longest
2860             (lookup_reference_type (lookup_member_type (TYPE_FIELD_TYPE (t, i),
2861                                                         domain)),
2862              offset + (LONGEST) (TYPE_FIELD_BITPOS (t, i) >> 3));
2863         }
2864     }
2865
2866   /* C++: If it was not found as a data field, then try to
2867      return it as a pointer to a method.  */
2868
2869   /* Destructors are a special case.  */
2870   if (destructor_name_p (name, t))
2871     {
2872       error ("member pointers to destructors not implemented yet");
2873     }
2874
2875   /* Perform all necessary dereferencing.  */
2876   while (intype && TYPE_CODE (intype) == TYPE_CODE_PTR)
2877     intype = TYPE_TARGET_TYPE (intype);
2878
2879   for (i = TYPE_NFN_FIELDS (t) - 1; i >= 0; --i)
2880     {
2881       char *t_field_name = TYPE_FN_FIELDLIST_NAME (t, i);
2882       char dem_opname[64];
2883
2884       if (strncmp(t_field_name, "__", 2)==0 ||
2885         strncmp(t_field_name, "op", 2)==0 ||
2886         strncmp(t_field_name, "type", 4)==0 )
2887         {
2888           if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
2889             t_field_name = dem_opname;
2890           else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
2891             t_field_name = dem_opname; 
2892         }
2893       if (t_field_name && STREQ (t_field_name, name))
2894         {
2895           int j = TYPE_FN_FIELDLIST_LENGTH (t, i);
2896           struct fn_field *f = TYPE_FN_FIELDLIST1 (t, i);
2897           
2898           if (intype == 0 && j > 1)
2899             error ("non-unique member `%s' requires type instantiation", name);
2900           if (intype)
2901             {
2902               while (j--)
2903                 if (TYPE_FN_FIELD_TYPE (f, j) == intype)
2904                   break;
2905               if (j < 0)
2906                 error ("no member function matches that type instantiation");
2907             }
2908           else
2909             j = 0;
2910           
2911           if (TYPE_FN_FIELD_STUB (f, j))
2912             check_stub_method (t, i, j);
2913           if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
2914             {
2915               return value_from_longest
2916                 (lookup_reference_type
2917                  (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
2918                                       domain)),
2919                  (LONGEST) METHOD_PTR_FROM_VOFFSET (TYPE_FN_FIELD_VOFFSET (f, j)));
2920             }
2921           else
2922             {
2923               struct symbol *s = lookup_symbol (TYPE_FN_FIELD_PHYSNAME (f, j),
2924                                                 0, VAR_NAMESPACE, 0, NULL);
2925               if (s == NULL)
2926                 {
2927                   v = 0;
2928                 }
2929               else
2930                 {
2931                   v = read_var_value (s, 0);
2932 #if 0
2933                   VALUE_TYPE (v) = lookup_reference_type
2934                     (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
2935                                          domain));
2936 #endif
2937                 }
2938               return v;
2939             }
2940         }
2941     }
2942   for (i = TYPE_N_BASECLASSES (t) - 1; i >= 0; i--)
2943     {
2944       value_ptr v;
2945       int base_offset;
2946
2947       if (BASETYPE_VIA_VIRTUAL (t, i))
2948         base_offset = 0;
2949       else
2950         base_offset = TYPE_BASECLASS_BITPOS (t, i) / 8;
2951       v = value_struct_elt_for_reference (domain,
2952                                           offset + base_offset,
2953                                           TYPE_BASECLASS (t, i),
2954                                           name,
2955                                           intype);
2956       if (v)
2957         return v;
2958     }
2959   return 0;
2960 }
2961
2962
2963 /* Find the real run-time type of a value using RTTI.
2964  * V is a pointer to the value.
2965  * A pointer to the struct type entry of the run-time type
2966  * is returneed.
2967  * FULL is a flag that is set only if the value V includes
2968  * the entire contents of an object of the RTTI type.
2969  * TOP is the offset to the top of the enclosing object of
2970  * the real run-time type.  This offset may be for the embedded
2971  * object, or for the enclosing object of V.
2972  * USING_ENC is the flag that distinguishes the two cases.
2973  * If it is 1, then the offset is for the enclosing object,
2974  * otherwise for the embedded object.
2975  * 
2976  * This currently works only for RTTI information generated
2977  * by the HP ANSI C++ compiler (aCC).  g++ today (1997-06-10)
2978  * does not appear to support RTTI. This function returns a
2979  * NULL value for objects in the g++ runtime model. */
2980
2981 struct type *
2982 value_rtti_type (v, full, top, using_enc)
2983   value_ptr v;
2984   int * full;
2985   int * top;
2986   int * using_enc;
2987 {
2988   struct type * known_type;
2989   struct type * rtti_type;
2990   CORE_ADDR coreptr;
2991   value_ptr vp;
2992   int using_enclosing = 0;
2993   long top_offset = 0;
2994   char rtti_type_name[256];
2995
2996   if (full)
2997     *full = 0;
2998   if (top)
2999     *top = -1;
3000   if (using_enc)
3001     *using_enc = 0;
3002
3003   /* Get declared type */ 
3004   known_type = VALUE_TYPE (v);
3005   CHECK_TYPEDEF (known_type);
3006   /* RTTI works only or class objects */ 
3007   if (TYPE_CODE (known_type) != TYPE_CODE_CLASS)
3008     return NULL;
3009
3010   /* If neither the declared type nor the enclosing type of the
3011    * value structure has a HP ANSI C++ style virtual table,
3012    * we can't do anything. */
3013   if (!TYPE_HAS_VTABLE (known_type))
3014     {
3015       known_type = VALUE_ENCLOSING_TYPE (v);
3016       CHECK_TYPEDEF (known_type);
3017       if ((TYPE_CODE (known_type) != TYPE_CODE_CLASS) ||
3018           !TYPE_HAS_VTABLE (known_type))
3019         return NULL; /* No RTTI, or not HP-compiled types */
3020       CHECK_TYPEDEF (known_type);
3021       using_enclosing = 1;
3022     }
3023
3024   if (using_enclosing && using_enc)
3025     *using_enc = 1;
3026
3027   /* First get the virtual table address */
3028   coreptr = * (CORE_ADDR *) ((VALUE_CONTENTS_ALL (v))
3029                              + VALUE_OFFSET (v) 
3030                              + (using_enclosing ? 0 : VALUE_EMBEDDED_OFFSET (v)));
3031   if (coreptr == 0)
3032     return NULL; /* return silently -- maybe called on gdb-generated value */
3033
3034   /* Fetch the top offset of the object */ 
3035   /* FIXME possible 32x64 problem with pointer size & arithmetic */
3036   vp = value_at (builtin_type_int, 
3037                  coreptr + 4 * HP_ACC_TOP_OFFSET_OFFSET, 
3038                  VALUE_BFD_SECTION (v));
3039   top_offset = value_as_long (vp);
3040   if (top)
3041     *top = top_offset;
3042
3043   /* Fetch the typeinfo pointer */
3044   /* FIXME possible 32x64 problem with pointer size & arithmetic */
3045   vp = value_at (builtin_type_int, coreptr + 4 * HP_ACC_TYPEINFO_OFFSET, VALUE_BFD_SECTION (v));
3046   /* Indirect through the typeinfo pointer and retrieve the pointer
3047    * to the string name */
3048   coreptr = * (CORE_ADDR *) (VALUE_CONTENTS (vp));
3049   if (!coreptr)
3050     error ("Retrieved null typeinfo pointer in trying to determine run-time type");
3051   vp = value_at (builtin_type_int, coreptr + 4, VALUE_BFD_SECTION (v));  /* 4 -> offset of name field */
3052                                                   /* FIXME possible 32x64 problem */
3053
3054   coreptr = * (CORE_ADDR *) (VALUE_CONTENTS (vp));
3055
3056   read_memory_string (coreptr, rtti_type_name, 256);
3057
3058   if (strlen (rtti_type_name) == 0)
3059     error ("Retrieved null type name from typeinfo");
3060   
3061   /* search for type */
3062   rtti_type = lookup_typename (rtti_type_name, (struct block *) 0, 1);
3063   
3064   if (!rtti_type)
3065     error ("Could not find run-time type: invalid type name %s in typeinfo??", rtti_type_name);
3066   CHECK_TYPEDEF (rtti_type);
3067
3068 #if 0 /* debugging*/
3069   printf("RTTI type name %s, tag %s, full? %d\n", TYPE_NAME (rtti_type), TYPE_TAG_NAME (rtti_type), full ? *full : -1); 
3070 #endif
3071
3072   /* Check whether we have the entire object */
3073   if (full /* Non-null pointer passed */ 
3074
3075       &&
3076            /* Either we checked on the whole object in hand and found the
3077               top offset to be zero */
3078       (((top_offset == 0) &&         
3079        using_enclosing &&     
3080        TYPE_LENGTH (known_type) == TYPE_LENGTH (rtti_type))
3081       ||
3082            /* Or we checked on the embedded object and top offset was the
3083               same as the embedded offset */
3084       ((top_offset == VALUE_EMBEDDED_OFFSET (v)) &&
3085        !using_enclosing &&
3086        TYPE_LENGTH (VALUE_ENCLOSING_TYPE (v)) == TYPE_LENGTH (rtti_type))))
3087     
3088     *full = 1;
3089   
3090   return rtti_type;
3091 }
3092
3093 /* Given a pointer value V, find the real (RTTI) type
3094    of the object it points to.
3095    Other parameters FULL, TOP, USING_ENC as with value_rtti_type()
3096    and refer to the values computed for the object pointed to. */
3097
3098 struct type *
3099 value_rtti_target_type (v, full, top, using_enc)
3100   value_ptr v;
3101   int * full;
3102   int * top;
3103   int * using_enc;
3104 {
3105   value_ptr target;
3106
3107   target = value_ind (v);
3108
3109   return value_rtti_type (target, full, top, using_enc);
3110 }
3111
3112 /* Given a value pointed to by ARGP, check its real run-time type, and
3113    if that is different from the enclosing type, create a new value
3114    using the real run-time type as the enclosing type (and of the same
3115    type as ARGP) and return it, with the embedded offset adjusted to
3116    be the correct offset to the enclosed object
3117    RTYPE is the type, and XFULL, XTOP, and XUSING_ENC are the other
3118    parameters, computed by value_rtti_type(). If these are available,
3119    they can be supplied and a second call to value_rtti_type() is avoided.
3120    (Pass RTYPE == NULL if they're not available */
3121
3122 value_ptr
3123 value_full_object (argp, rtype, xfull, xtop, xusing_enc)
3124   value_ptr argp;
3125   struct type * rtype;
3126   int xfull;
3127   int xtop;
3128   int xusing_enc;
3129   
3130 {
3131   struct type * real_type;
3132   int full = 0;
3133   int top = -1;
3134   int using_enc = 0;
3135   value_ptr new_val;
3136
3137   if (rtype)
3138     {
3139       real_type = rtype;
3140       full = xfull;
3141       top = xtop;
3142       using_enc = xusing_enc;
3143     }
3144   else
3145     real_type = value_rtti_type (argp, &full, &top, &using_enc);
3146
3147   /* If no RTTI data, or if object is already complete, do nothing */
3148   if (!real_type || real_type == VALUE_ENCLOSING_TYPE (argp))
3149     return argp;
3150
3151   /* If we have the full object, but for some reason the enclosing
3152      type is wrong, set it */ /* pai: FIXME -- sounds iffy */
3153   if (full)
3154     {
3155       VALUE_ENCLOSING_TYPE (argp) = real_type;
3156       return argp;
3157     }
3158
3159   /* Check if object is in memory */
3160   if (VALUE_LVAL (argp) != lval_memory)
3161     {
3162       warning ("Couldn't retrieve complete object of RTTI type %s; object may be in register(s).", TYPE_NAME (real_type));
3163       
3164       return argp;
3165     }
3166   
3167   /* All other cases -- retrieve the complete object */
3168   /* Go back by the computed top_offset from the beginning of the object,
3169      adjusting for the embedded offset of argp if that's what value_rtti_type
3170      used for its computation. */
3171   new_val = value_at_lazy (real_type, VALUE_ADDRESS (argp) - top +
3172                            (using_enc ? 0 : VALUE_EMBEDDED_OFFSET (argp)), 
3173                            VALUE_BFD_SECTION (argp));
3174   VALUE_TYPE (new_val) = VALUE_TYPE (argp);
3175   VALUE_EMBEDDED_OFFSET (new_val) = using_enc ? top + VALUE_EMBEDDED_OFFSET (argp) : top;
3176   return new_val;
3177 }
3178
3179
3180
3181
3182 /* C++: return the value of the class instance variable, if one exists.
3183    Flag COMPLAIN signals an error if the request is made in an
3184    inappropriate context.  */
3185
3186 value_ptr
3187 value_of_this (complain)
3188      int complain;
3189 {
3190   struct symbol *func, *sym;
3191   struct block *b;
3192   int i;
3193   static const char funny_this[] = "this";
3194   value_ptr this;
3195
3196   if (selected_frame == 0)
3197     {
3198       if (complain)
3199         error ("no frame selected");
3200       else return 0;
3201     }
3202
3203   func = get_frame_function (selected_frame);
3204   if (!func)
3205     {
3206       if (complain)
3207         error ("no `this' in nameless context");
3208       else return 0;
3209     }
3210
3211   b = SYMBOL_BLOCK_VALUE (func);
3212   i = BLOCK_NSYMS (b);
3213   if (i <= 0)
3214     {
3215       if (complain)
3216         error ("no args, no `this'");
3217       else return 0;
3218     }
3219
3220   /* Calling lookup_block_symbol is necessary to get the LOC_REGISTER
3221      symbol instead of the LOC_ARG one (if both exist).  */
3222   sym = lookup_block_symbol (b, funny_this, VAR_NAMESPACE);
3223   if (sym == NULL)
3224     {
3225       if (complain)
3226         error ("current stack frame not in method");
3227       else
3228         return NULL;
3229     }
3230
3231   this = read_var_value (sym, selected_frame);
3232   if (this == 0 && complain)
3233     error ("`this' argument at unknown address");
3234   return this;
3235 }
3236
3237 /* Create a slice (sub-string, sub-array) of ARRAY, that is LENGTH elements
3238    long, starting at LOWBOUND.  The result has the same lower bound as
3239    the original ARRAY.  */
3240
3241 value_ptr
3242 value_slice (array, lowbound, length)
3243      value_ptr array;
3244      int lowbound, length;
3245 {
3246   struct type *slice_range_type, *slice_type, *range_type;
3247   LONGEST lowerbound, upperbound, offset;
3248   value_ptr slice;
3249   struct type *array_type;
3250   array_type = check_typedef (VALUE_TYPE (array));
3251   COERCE_VARYING_ARRAY (array, array_type);
3252   if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
3253       && TYPE_CODE (array_type) != TYPE_CODE_STRING
3254       && TYPE_CODE (array_type) != TYPE_CODE_BITSTRING)
3255     error ("cannot take slice of non-array");
3256   range_type = TYPE_INDEX_TYPE (array_type);
3257   if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
3258     error ("slice from bad array or bitstring");
3259   if (lowbound < lowerbound || length < 0
3260       || lowbound + length - 1 > upperbound
3261       /* Chill allows zero-length strings but not arrays. */
3262       || (current_language->la_language == language_chill
3263           && length == 0 && TYPE_CODE (array_type) == TYPE_CODE_ARRAY))
3264     error ("slice out of range");
3265   /* FIXME-type-allocation: need a way to free this type when we are
3266      done with it.  */
3267   slice_range_type = create_range_type ((struct type*) NULL,
3268                                         TYPE_TARGET_TYPE (range_type),
3269                                         lowbound, lowbound + length - 1);
3270   if (TYPE_CODE (array_type) == TYPE_CODE_BITSTRING)
3271     {
3272       int i;
3273       slice_type = create_set_type ((struct type*) NULL, slice_range_type);
3274       TYPE_CODE (slice_type) = TYPE_CODE_BITSTRING;
3275       slice = value_zero (slice_type, not_lval);
3276       for (i = 0; i < length; i++)
3277         {
3278           int element = value_bit_index (array_type,
3279                                          VALUE_CONTENTS (array),
3280                                          lowbound + i);
3281           if (element < 0)
3282             error ("internal error accessing bitstring");
3283           else if (element > 0)
3284             {
3285               int j = i % TARGET_CHAR_BIT;
3286               if (BITS_BIG_ENDIAN)
3287                 j = TARGET_CHAR_BIT - 1 - j;
3288               VALUE_CONTENTS_RAW (slice)[i / TARGET_CHAR_BIT] |= (1 << j);
3289             }
3290         }
3291       /* We should set the address, bitssize, and bitspos, so the clice
3292          can be used on the LHS, but that may require extensions to
3293          value_assign.  For now, just leave as a non_lval.  FIXME.  */
3294     }
3295   else
3296     {
3297       struct type *element_type = TYPE_TARGET_TYPE (array_type);
3298       offset
3299         = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
3300       slice_type = create_array_type ((struct type*) NULL, element_type,
3301                                       slice_range_type);
3302       TYPE_CODE (slice_type) = TYPE_CODE (array_type);
3303       slice = allocate_value (slice_type);
3304       if (VALUE_LAZY (array))
3305         VALUE_LAZY (slice) = 1;
3306       else
3307         memcpy (VALUE_CONTENTS (slice), VALUE_CONTENTS (array) + offset,
3308                 TYPE_LENGTH (slice_type));
3309       if (VALUE_LVAL (array) == lval_internalvar)
3310         VALUE_LVAL (slice) = lval_internalvar_component;
3311       else
3312         VALUE_LVAL (slice) = VALUE_LVAL (array);
3313       VALUE_ADDRESS (slice) = VALUE_ADDRESS (array);
3314       VALUE_OFFSET (slice) = VALUE_OFFSET (array) + offset;
3315     }
3316   return slice;
3317 }
3318
3319 /* Assuming chill_varying_type (VARRAY) is true, return an equivalent
3320    value as a fixed-length array. */
3321
3322 value_ptr
3323 varying_to_slice (varray)
3324      value_ptr varray;
3325 {
3326   struct type *vtype = check_typedef (VALUE_TYPE (varray));
3327   LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
3328                                 VALUE_CONTENTS (varray)
3329                                 + TYPE_FIELD_BITPOS (vtype, 0) / 8);
3330   return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length);
3331 }
3332
3333 /* Create a value for a FORTRAN complex number.  Currently most of 
3334    the time values are coerced to COMPLEX*16 (i.e. a complex number 
3335    composed of 2 doubles.  This really should be a smarter routine 
3336    that figures out precision inteligently as opposed to assuming 
3337    doubles. FIXME: fmb */ 
3338
3339 value_ptr
3340 value_literal_complex (arg1, arg2, type)
3341      value_ptr arg1;
3342      value_ptr arg2;
3343      struct type *type;
3344 {
3345   register value_ptr val;
3346   struct type *real_type = TYPE_TARGET_TYPE (type);
3347
3348   val = allocate_value (type);
3349   arg1 = value_cast (real_type, arg1);
3350   arg2 = value_cast (real_type, arg2);
3351
3352   memcpy (VALUE_CONTENTS_RAW (val),
3353           VALUE_CONTENTS (arg1), TYPE_LENGTH (real_type));
3354   memcpy (VALUE_CONTENTS_RAW (val) + TYPE_LENGTH (real_type),
3355           VALUE_CONTENTS (arg2), TYPE_LENGTH (real_type));
3356   return val;
3357 }
3358
3359 /* Cast a value into the appropriate complex data type. */
3360
3361 static value_ptr
3362 cast_into_complex (type, val)
3363      struct type *type;
3364      register value_ptr val;
3365 {
3366   struct type *real_type = TYPE_TARGET_TYPE (type);
3367   if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_COMPLEX)
3368     {
3369       struct type *val_real_type = TYPE_TARGET_TYPE (VALUE_TYPE (val));
3370       value_ptr re_val = allocate_value (val_real_type);
3371       value_ptr im_val = allocate_value (val_real_type);
3372
3373       memcpy (VALUE_CONTENTS_RAW (re_val),
3374               VALUE_CONTENTS (val), TYPE_LENGTH (val_real_type));
3375       memcpy (VALUE_CONTENTS_RAW (im_val),
3376               VALUE_CONTENTS (val) + TYPE_LENGTH (val_real_type),
3377                TYPE_LENGTH (val_real_type));
3378
3379       return value_literal_complex (re_val, im_val, type);
3380     }
3381   else if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_FLT
3382            || TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_INT)
3383     return value_literal_complex (val, value_zero (real_type, not_lval), type);
3384   else
3385     error ("cannot cast non-number to complex");
3386 }
3387
3388 void
3389 _initialize_valops ()
3390 {
3391 #if 0
3392   add_show_from_set
3393     (add_set_cmd ("abandon", class_support, var_boolean, (char *)&auto_abandon,
3394                   "Set automatic abandonment of expressions upon failure.",
3395                   &setlist),
3396      &showlist);
3397 #endif
3398
3399   add_show_from_set
3400     (add_set_cmd ("overload-resolution", class_support, var_boolean, (char *)&overload_resolution,
3401                   "Set overload resolution in evaluating C++ functions.",
3402                   &setlist),
3403      &showlist);
3404   overload_resolution = 1;
3405
3406 }