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