* inftarg.c (child_thread_alive): New function to see if a
[deliverable/binutils-gdb.git] / gdb / valops.c
index 0ec52609d3e1d8ca4fe7b0600c3fc9da96c03776..ea0a3437b0004c7b7a31ad1c33a02c89d1dc3fbc 100644 (file)
@@ -1,5 +1,6 @@
 /* Perform non-arithmetic operations on values, for GDB.
-   Copyright 1986, 1987, 1989, 1991, 1992 Free Software Foundation, Inc.
+   Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994
+   Free Software Foundation, Inc.
 
 This file is part of GDB.
 
@@ -29,33 +30,30 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "language.h"
 
 #include <errno.h>
+#include <string.h>
 
 /* Local functions.  */
 
-static int
-typecmp PARAMS ((int staticp, struct type *t1[], value t2[]));
+static int typecmp PARAMS ((int staticp, struct type *t1[], value_ptr t2[]));
 
-static CORE_ADDR
-find_function_addr PARAMS ((value, struct type **));
+static CORE_ADDR find_function_addr PARAMS ((value_ptr, struct type **));
 
-static CORE_ADDR
-value_push PARAMS ((CORE_ADDR, value));
+static CORE_ADDR value_push PARAMS ((CORE_ADDR, value_ptr));
 
-static CORE_ADDR
-value_arg_push PARAMS ((CORE_ADDR, value));
+static value_ptr search_struct_field PARAMS ((char *, value_ptr, int,
+                                             struct type *, int));
 
-static value
-search_struct_field PARAMS ((char *, value, int, struct type *, int));
+static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
+                                              value_ptr *,
+                                              int, int *, struct type *));
 
-static value
-search_struct_method PARAMS ((char *, value *, value *, int, int *,
-                             struct type *));
+static int check_field_in PARAMS ((struct type *, const char *));
 
-static int
-check_field_in PARAMS ((struct type *, const char *));
+static CORE_ADDR allocate_space_in_inferior PARAMS ((int));
 
-static CORE_ADDR
-allocate_space_in_inferior PARAMS ((int));
+static value_ptr cast_into_complex PARAMS ((struct type *, value_ptr));
+
+#define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
 
 \f
 /* Allocate NBYTES of space in the inferior using the inferior's malloc
@@ -65,11 +63,11 @@ static CORE_ADDR
 allocate_space_in_inferior (len)
      int len;
 {
-  register value val;
+  register value_ptr val;
   register struct symbol *sym;
   struct minimal_symbol *msymbol;
   struct type *type;
-  value blocklen;
+  value_ptr blocklen;
   LONGEST maddr;
 
   /* Find the address of malloc in the inferior.  */
@@ -85,7 +83,7 @@ allocate_space_in_inferior (len)
     }
   else
     {
-      msymbol = lookup_minimal_symbol ("malloc", (struct objfile *) NULL);
+      msymbol = lookup_minimal_symbol ("malloc", NULL, NULL);
       if (msymbol != NULL)
        {
          type = lookup_pointer_type (builtin_type_char);
@@ -114,24 +112,65 @@ allocate_space_in_inferior (len)
    and if ARG2 is an lvalue it can be cast into anything at all.  */
 /* In C++, casts may change pointer or object representations.  */
 
-value
+value_ptr
 value_cast (type, arg2)
      struct type *type;
-     register value arg2;
+     register value_ptr arg2;
 {
-  register enum type_code code1;
+  register enum type_code code1 = TYPE_CODE (type);
   register enum type_code code2;
   register int scalar;
 
-  /* Coerce arrays but not enums.  Enums will work as-is
-     and coercing them would cause an infinite recursion.  */
-  if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ENUM)
-    COERCE_ARRAY (arg2);
+  if (VALUE_TYPE (arg2) == type)
+    return arg2;
+
+  COERCE_REF(arg2);
+
+  /* A cast to an undetermined-length array_type, such as (TYPE [])OBJECT,
+     is treated like a cast to (TYPE [N])OBJECT,
+     where N is sizeof(OBJECT)/sizeof(TYPE). */
+  if (code1 == TYPE_CODE_ARRAY
+      && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
+      && TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
+    {
+      struct type *element_type = TYPE_TARGET_TYPE (type);
+      struct type *range_type = TYPE_INDEX_TYPE (type);
+      int low_bound = TYPE_LOW_BOUND (range_type);
+      int val_length = TYPE_LENGTH (VALUE_TYPE (arg2));
+      int new_length = val_length / TYPE_LENGTH (element_type);
+      if (val_length % TYPE_LENGTH (element_type) != 0)
+       warning("array element type size does not divide object size in cast");
+      /* FIXME-type-allocation: need a way to free this type when we are
+        done with it.  */
+      range_type = create_range_type ((struct type *) NULL,
+                                     TYPE_TARGET_TYPE (range_type),
+                                     low_bound, new_length + low_bound - 1);
+      VALUE_TYPE (arg2) = create_array_type ((struct type *) NULL,
+                                            element_type, range_type);
+      return arg2;
+    }
+
+  if (current_language->c_style_arrays
+      && (VALUE_REPEATED (arg2)
+         || TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_ARRAY))
+    arg2 = value_coerce_array (arg2);
+
+  if (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_FUNC)
+    arg2 = value_coerce_function (arg2);
+
+  COERCE_VARYING_ARRAY (arg2);
 
-  code1 = TYPE_CODE (type);
   code2 = TYPE_CODE (VALUE_TYPE (arg2));
+
+  if (code1 == TYPE_CODE_COMPLEX) 
+    return cast_into_complex (type, arg2); 
+  if (code1 == TYPE_CODE_BOOL) 
+    code1 = TYPE_CODE_INT; 
+  if (code2 == TYPE_CODE_BOOL) 
+    code2 = TYPE_CODE_INT;
+
   scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
-           || code2 == TYPE_CODE_ENUM);
+           || code2 == TYPE_CODE_ENUM || code2 == TYPE_CODE_RANGE);
 
   if (   code1 == TYPE_CODE_STRUCT
       && code2 == TYPE_CODE_STRUCT
@@ -140,8 +179,8 @@ value_cast (type, arg2)
       /* Look in the type of the source to see if it contains the
         type of the target as a superclass.  If so, we'll need to
         offset the object in addition to changing its type.  */
-      value v = search_struct_field (type_name_no_tag (type),
-                                    arg2, 0, VALUE_TYPE (arg2), 1);
+      value_ptr v = search_struct_field (type_name_no_tag (type),
+                                        arg2, 0, VALUE_TYPE (arg2), 1);
       if (v)
        {
          VALUE_TYPE (v) = type;
@@ -150,7 +189,8 @@ value_cast (type, arg2)
     }
   if (code1 == TYPE_CODE_FLT && scalar)
     return value_from_double (type, value_as_double (arg2));
-  else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM)
+  else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM
+           || code1 == TYPE_CODE_RANGE)
           && (scalar || code2 == TYPE_CODE_PTR))
     return value_from_longest (type, value_as_long (arg2));
   else if (TYPE_LENGTH (type) == TYPE_LENGTH (VALUE_TYPE (arg2)))
@@ -166,8 +206,8 @@ value_cast (type, arg2)
              && TYPE_CODE (t2) == TYPE_CODE_STRUCT
              && TYPE_NAME (t1) != 0) /* if name unknown, can't have supercl */
            {
-             value v = search_struct_field (type_name_no_tag (t1),
-                                            value_ind (arg2), 0, t2, 1);
+             value_ptr v = search_struct_field (type_name_no_tag (t1),
+                                                value_ind (arg2), 0, t2, 1);
              if (v)
                {
                  v = value_addr (v);
@@ -180,6 +220,40 @@ value_cast (type, arg2)
       VALUE_TYPE (arg2) = type;
       return arg2;
     }
+  else if (chill_varying_type (type))
+    {
+      struct type *range1, *range2, *eltype1, *eltype2;
+      value_ptr val;
+      int count1, count2;
+      char *valaddr, *valaddr_data;
+      if (code2 == TYPE_CODE_BITSTRING)
+       error ("not implemented: converting bitstring to varying type");
+      if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
+         || (eltype1 = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)),
+             eltype2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2)),
+             (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
+              /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
+       error ("Invalid conversion to varying type");
+      range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
+      range2 = TYPE_FIELD_TYPE (VALUE_TYPE (arg2), 0);
+      count1 = TYPE_HIGH_BOUND (range1) - TYPE_LOW_BOUND (range1) + 1;
+      count2 = TYPE_HIGH_BOUND (range2) - TYPE_LOW_BOUND (range2) + 1;
+      if (count2 > count1)
+       error ("target varying type is too small");
+      val = allocate_value (type);
+      valaddr = VALUE_CONTENTS_RAW (val);
+      valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
+      /* Set val's __var_length field to count2. */
+      store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
+                           count2);
+      /* Set the __var_data field to count2 elements copied from arg2. */
+      memcpy (valaddr_data, VALUE_CONTENTS (arg2),
+             count2 * TYPE_LENGTH (eltype2));
+      /* Zero the rest of the __var_data field of val. */
+      memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
+             (count1 - count2) * TYPE_LENGTH (eltype2));
+      return val;
+    }
   else if (VALUE_LVAL (arg2) == lval_memory)
     {
       return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2));
@@ -197,12 +271,12 @@ value_cast (type, arg2)
 
 /* Create a value of type TYPE that is zero, and return it.  */
 
-value
+value_ptr
 value_zero (type, lv)
      struct type *type;
      enum lval_type lv;
 {
-  register value val = allocate_value (type);
+  register value_ptr val = allocate_value (type);
 
   memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (type));
   VALUE_LVAL (val) = lv;
@@ -219,12 +293,17 @@ value_zero (type, lv)
    is tested in the VALUE_CONTENTS macro, which is used if and when 
    the contents are actually required.  */
 
-value
+value_ptr
 value_at (type, addr)
      struct type *type;
      CORE_ADDR addr;
 {
-  register value val = allocate_value (type);
+  register value_ptr val;
+
+  if (TYPE_CODE (type) == TYPE_CODE_VOID)
+    error ("Attempt to dereference a generic pointer.");
+
+  val = allocate_value (type);
 
   read_memory (addr, VALUE_CONTENTS_RAW (val), TYPE_LENGTH (type));
 
@@ -236,12 +315,17 @@ value_at (type, addr)
 
 /* Return a lazy value with type TYPE located at ADDR (cf. value_at).  */
 
-value
+value_ptr
 value_at_lazy (type, addr)
      struct type *type;
      CORE_ADDR addr;
 {
-  register value val = allocate_value (type);
+  register value_ptr val;
+
+  if (TYPE_CODE (type) == TYPE_CODE_VOID)
+    error ("Attempt to dereference a generic pointer.");
+
+  val = allocate_value (type);
 
   VALUE_LVAL (val) = lval_memory;
   VALUE_ADDRESS (val) = addr;
@@ -264,7 +348,7 @@ value_at_lazy (type, addr)
 
 int
 value_fetch_lazy (val)
-     register value val;
+     register value_ptr val;
 {
   CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
 
@@ -279,18 +363,22 @@ value_fetch_lazy (val)
 /* Store the contents of FROMVAL into the location of TOVAL.
    Return a new value with the location of TOVAL and contents of FROMVAL.  */
 
-value
+value_ptr
 value_assign (toval, fromval)
-     register value toval, fromval;
+     register value_ptr toval, fromval;
 {
-  register struct type *type = VALUE_TYPE (toval);
-  register value val;
+  register struct type *type;
+  register value_ptr val;
   char raw_buffer[MAX_REGISTER_RAW_SIZE];
   int use_buffer = 0;
 
+  if (!toval->modifiable)
+    error ("Left operand of assignment is not a modifiable lvalue.");
+
   COERCE_ARRAY (fromval);
   COERCE_REF (toval);
 
+  type = VALUE_TYPE (toval);
   if (VALUE_LVAL (toval) != lval_internalvar)
     fromval = value_cast (type, fromval);
 
@@ -423,7 +511,7 @@ Can't handle bitfield which doesn't fit in a single register.");
                                        + MAX_REGISTER_RAW_SIZE);
 
        int regno;
-       FRAME frame;
+       struct frame_info *frame;
 
        /* Figure out which frame this is in currently.  */
        for (frame = get_current_frame ();
@@ -486,7 +574,7 @@ Can't handle bitfield which doesn't fit in a single register.");
        
 
     default:
-      error ("Left side of = operation is not an lvalue.");
+      error ("Left operand of assignment is not an lvalue.");
     }
 
   /* Return a value just like TOVAL except with the contents of FROMVAL
@@ -509,17 +597,19 @@ Can't handle bitfield which doesn't fit in a single register.");
 
 /* Extend a value VAL to COUNT repetitions of its type.  */
 
-value
+value_ptr
 value_repeat (arg1, count)
-     value arg1;
+     value_ptr arg1;
      int count;
 {
-  register value val;
+  register value_ptr val;
 
   if (VALUE_LVAL (arg1) != lval_memory)
     error ("Only values in memory can be extended with '@'.");
   if (count < 1)
     error ("Invalid number %d of repetitions.", count);
+  if (VALUE_REPEATED (arg1))
+    error ("Cannot create artificial arrays of artificial arrays.");
 
   val = allocate_repeat_value (VALUE_TYPE (arg1), count);
 
@@ -532,21 +622,21 @@ value_repeat (arg1, count)
   return val;
 }
 
-value
+value_ptr
 value_of_variable (var, b)
      struct symbol *var;
      struct block *b;
 {
-  value val;
-  FRAME fr;
+  value_ptr val;
+  struct frame_info *frame;
 
   if (b == NULL)
     /* Use selected frame.  */
-    fr = NULL;
+    frame = NULL;
   else
     {
-      fr = block_innermost_frame (b);
-      if (fr == NULL && symbol_read_needs_frame (var))
+      frame = block_innermost_frame (b);
+      if (frame == NULL && symbol_read_needs_frame (var))
        {
          if (BLOCK_FUNCTION (b) != NULL
              && SYMBOL_NAME (BLOCK_FUNCTION (b)) != NULL)
@@ -556,7 +646,7 @@ value_of_variable (var, b)
            error ("No frame is currently executing in specified block");
        }
     }
-  val = read_var_value (var, fr);
+  val = read_var_value (var, frame);
   if (val == 0)
     error ("Address of symbol \"%s\" is unknown.", SYMBOL_SOURCE_NAME (var));
   return val;
@@ -585,9 +675,9 @@ value_of_variable (var, b)
    the coercion to pointer type.
    */
 
-value
+value_ptr
 value_coerce_array (arg1)
-     value arg1;
+     value_ptr arg1;
 {
   register struct type *type;
 
@@ -610,9 +700,9 @@ value_coerce_array (arg1)
 /* Given a value which is a function, return a value which is a pointer
    to it.  */
 
-value
+value_ptr
 value_coerce_function (arg1)
-     value arg1;
+     value_ptr arg1;
 {
 
   if (VALUE_LVAL (arg1) != lval_memory)
@@ -624,9 +714,9 @@ value_coerce_function (arg1)
 
 /* Return a pointer value for the object for which ARG1 is the contents.  */
 
-value
+value_ptr
 value_addr (arg1)
-     value arg1;
+     value_ptr arg1;
 {
   struct type *type = VALUE_TYPE (arg1);
   if (TYPE_CODE (type) == TYPE_CODE_REF)
@@ -634,12 +724,13 @@ value_addr (arg1)
       /* Copy the value, but change the type from (T&) to (T*).
         We keep the same location information, which is efficient,
         and allows &(&X) to get the location containing the reference. */
-      value arg2 = value_copy (arg1);
+      value_ptr arg2 = value_copy (arg1);
       VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
       return arg2;
     }
-  if (VALUE_REPEATED (arg1)
-      || TYPE_CODE (type) == TYPE_CODE_ARRAY)
+  if (current_language->c_style_arrays
+      && (VALUE_REPEATED (arg1)
+         || TYPE_CODE (type) == TYPE_CODE_ARRAY))
     return value_coerce_array (arg1);
   if (TYPE_CODE (type) == TYPE_CODE_FUNC)
     return value_coerce_function (arg1);
@@ -653,9 +744,9 @@ value_addr (arg1)
 
 /* Given a value of a pointer type, apply the C unary * operator to it.  */
 
-value
+value_ptr
 value_ind (arg1)
-     value arg1;
+     value_ptr arg1;
 {
   COERCE_ARRAY (arg1);
 
@@ -683,9 +774,9 @@ value_ind (arg1)
 CORE_ADDR
 push_word (sp, word)
      CORE_ADDR sp;
-     REGISTER_TYPE word;
+     unsigned LONGEST word;
 {
-  register int len = sizeof (REGISTER_TYPE);
+  register int len = REGISTER_SIZE;
   char buffer[MAX_REGISTER_RAW_SIZE];
 
   store_unsigned_integer (buffer, len, word);
@@ -724,7 +815,7 @@ push_bytes (sp, buffer, len)
 static CORE_ADDR
 value_push (sp, arg)
      register CORE_ADDR sp;
-     value arg;
+     value_ptr arg;
 {
   register int len = TYPE_LENGTH (VALUE_TYPE (arg));
 
@@ -740,53 +831,51 @@ value_push (sp, arg)
 }
 
 /* Perform the standard coercions that are specified
-   for arguments to be passed to C functions.  */
+   for arguments to be passed to C functions.
 
-value
-value_arg_coerce (arg)
-     value arg;
-{
-  register struct type *type;
+   If PARAM_TYPE is non-NULL, it is the expected parameter type. */
 
-  /* FIXME: We should coerce this according to the prototype (if we have
-     one).  Right now we do a little bit of this in typecmp(), but that
-     doesn't always get called.  For example, if passing a ref to a function
-     without a prototype, we probably should de-reference it.  Currently
-     we don't.  */
+static value_ptr
+value_arg_coerce (arg, param_type)
+     value_ptr arg;
+     struct type *param_type;
+{
+  register struct type *type = param_type ? param_type : VALUE_TYPE (arg);
 
-  if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ENUM)
-    arg = value_cast (builtin_type_unsigned_int, arg);
+  switch (TYPE_CODE (type))
+    {
+    case TYPE_CODE_REF:
+      if (TYPE_CODE (VALUE_TYPE (arg)) != TYPE_CODE_REF)
+       {
+         arg = value_addr (arg);
+         VALUE_TYPE (arg) = param_type;
+         return arg;
+       }
+      break;
+    case TYPE_CODE_INT:
+    case TYPE_CODE_CHAR:
+    case TYPE_CODE_BOOL:
+    case TYPE_CODE_ENUM:
+      if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
+       type = builtin_type_int;
+      break;
+    case TYPE_CODE_FLT:
+      if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_double))
+       type = builtin_type_double;
+      break;
+    case TYPE_CODE_FUNC:
+      type = lookup_pointer_type (type);
+      break;
+    }
 
 #if 1  /* FIXME:  This is only a temporary patch.  -fnf */
-  if (VALUE_REPEATED (arg)
-      || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)
+  if (current_language->c_style_arrays
+      && (VALUE_REPEATED (arg)
+         || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY))
     arg = value_coerce_array (arg);
-  if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)
-    arg = value_coerce_function (arg);
 #endif
 
-  type = VALUE_TYPE (arg);
-
-  if (TYPE_CODE (type) == TYPE_CODE_INT
-      && TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
-    return value_cast (builtin_type_int, arg);
-
-  if (TYPE_CODE (type) == TYPE_CODE_FLT
-      && TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_double))
-    return value_cast (builtin_type_double, arg);
-
-  return arg;
-}
-
-/* Push the value ARG, first coercing it as an argument
-   to a C function.  */
-
-static CORE_ADDR
-value_arg_push (sp, arg)
-     register CORE_ADDR sp;
-     value arg;
-{
-  return value_push (sp, value_arg_coerce (arg));
+  return value_cast (type, arg);
 }
 
 /* Determine a function's address and its return type from its value. 
@@ -794,7 +883,7 @@ value_arg_push (sp, arg)
 
 static CORE_ADDR
 find_function_addr (function, retval_type)
-     value function;
+     value_ptr function;
      struct type **retval_type;
 {
   register struct type *ftype = VALUE_TYPE (function);
@@ -816,7 +905,15 @@ find_function_addr (function, retval_type)
       funaddr = value_as_pointer (function);
       if (TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_FUNC
          || TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_METHOD)
-       value_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype));
+       {
+#ifdef CONVERT_FROM_FUNC_PTR_ADDR
+         /* FIXME: This is a workaround for the unusual function
+            pointer representation on the RS/6000, see comment
+            in config/rs6000/tm-rs6000.h  */
+         funaddr = CONVERT_FROM_FUNC_PTR_ADDR (funaddr);
+#endif
+         value_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype));
+       }
       else
        value_type = builtin_type_int;
     }
@@ -854,22 +951,25 @@ find_function_addr (function, retval_type)
    FUNCTION is a value, the function to be called.
    Returns a value representing what the function returned.
    May fail to return, if a breakpoint or signal is hit
-   during the execution of the function.  */
+   during the execution of the function.
+
+   ARGS is modified to contain coerced values. */
 
-value
+value_ptr
 call_function_by_hand (function, nargs, args)
-     value function;
+     value_ptr function;
      int nargs;
-     value *args;
+     value_ptr *args;
 {
   register CORE_ADDR sp;
   register int i;
   CORE_ADDR start_sp;
-  /* CALL_DUMMY is an array of words (REGISTER_TYPE), but each word
-     is in host byte order.  It is switched to target byte order before calling
-     FIX_CALL_DUMMY.  */
-  static REGISTER_TYPE dummy[] = CALL_DUMMY;
-  REGISTER_TYPE dummy1[sizeof dummy / sizeof (REGISTER_TYPE)];
+  /* CALL_DUMMY is an array of words (REGISTER_SIZE), but each word
+     is in host byte order.  Before calling FIX_CALL_DUMMY, we byteswap it
+     and remove any extra bytes which might exist because unsigned LONGEST is
+     bigger than REGISTER_SIZE.  */
+  static unsigned LONGEST dummy[] = CALL_DUMMY;
+  char dummy1[REGISTER_SIZE * sizeof dummy / sizeof (unsigned LONGEST)];
   CORE_ADDR old_sp;
   struct type *value_type;
   unsigned char struct_return;
@@ -879,6 +979,7 @@ call_function_by_hand (function, nargs, args)
   CORE_ADDR funaddr;
   int using_gcc;
   CORE_ADDR real_pc;
+  struct type *ftype = SYMBOL_TYPE (function);
 
   if (!target_has_execution)
     noprocess();
@@ -894,11 +995,11 @@ call_function_by_hand (function, nargs, args)
   old_sp = sp = read_sp ();
 
 #if 1 INNER_THAN 2             /* Stack grows down */
-  sp -= sizeof dummy;
+  sp -= sizeof dummy1;
   start_sp = sp;
 #else                          /* Stack grows up */
   start_sp = sp;
-  sp += sizeof dummy;
+  sp += sizeof dummy1;
 #endif
 
   funaddr = find_function_addr (function, &value_type);
@@ -906,7 +1007,7 @@ call_function_by_hand (function, nargs, args)
   {
     struct block *b = block_for_pc (funaddr);
     /* If compiled without -g, assume GCC.  */
-    using_gcc = b == NULL || BLOCK_GCC_COMPILED (b);
+    using_gcc = b == NULL ? 0 : BLOCK_GCC_COMPILED (b);
   }
 
   /* Are we returning a value using a structure return or a normal
@@ -917,8 +1018,9 @@ call_function_by_hand (function, nargs, args)
 
   /* Create a call sequence customized for this function
      and the number of arguments for it.  */
-  for (i = 0; i < sizeof dummy / sizeof (REGISTER_TYPE); i++)
-    store_unsigned_integer (&dummy1[i], sizeof (REGISTER_TYPE),
+  for (i = 0; i < sizeof dummy / sizeof (dummy[0]); i++)
+    store_unsigned_integer (&dummy1[i * REGISTER_SIZE],
+                           REGISTER_SIZE,
                            (unsigned LONGEST)dummy[i]);
 
 #ifdef GDB_TARGET_IS_HPPA
@@ -931,7 +1033,7 @@ call_function_by_hand (function, nargs, args)
 #endif
 
 #if CALL_DUMMY_LOCATION == ON_STACK
-  write_memory (start_sp, (char *)dummy1, sizeof dummy);
+  write_memory (start_sp, (char *)dummy1, sizeof dummy1);
 #endif /* On stack.  */
 
 #if CALL_DUMMY_LOCATION == BEFORE_TEXT_END
@@ -941,13 +1043,13 @@ call_function_by_hand (function, nargs, args)
     extern CORE_ADDR text_end;
     static checked = 0;
     if (!checked)
-      for (start_sp = text_end - sizeof dummy; start_sp < text_end; ++start_sp)
+      for (start_sp = text_end - sizeof dummy1; start_sp < text_end; ++start_sp)
        if (read_memory_integer (start_sp, 1) != 0)
          error ("text segment full -- no place to put call");
     checked = 1;
     sp = old_sp;
-    real_pc = text_end - sizeof dummy;
-    write_memory (real_pc, (char *)dummy1, sizeof dummy);
+    real_pc = text_end - sizeof dummy1;
+    write_memory (real_pc, (char *)dummy1, sizeof dummy1);
   }
 #endif /* Before text_end.  */
 
@@ -957,7 +1059,7 @@ call_function_by_hand (function, nargs, args)
     int errcode;
     sp = old_sp;
     real_pc = text_end;
-    errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy);
+    errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy1);
     if (errcode != 0)
       error ("Cannot write text segment -- call_function failed");
   }
@@ -971,78 +1073,102 @@ call_function_by_hand (function, nargs, args)
   sp = old_sp;         /* It really is used, for some ifdef's... */
 #endif
 
-#ifdef STACK_ALIGN
-  /* If stack grows down, we must leave a hole at the top. */
-  {
-    int len = 0;
+  if (nargs < TYPE_NFIELDS (ftype))
+    error ("too few arguments in function call");
 
-    /* Reserve space for the return structure to be written on the
-       stack, if necessary */
+  for (i = nargs - 1; i >= 0; i--)
+    {
+      struct type *param_type;
+      if (TYPE_NFIELDS (ftype) > i)
+       param_type = TYPE_FIELD_TYPE (ftype, i);
+      else
+       param_type = 0;
+      args[i] = value_arg_coerce (args[i], param_type);
+    }
 
-    if (struct_return)
-      len += TYPE_LENGTH (value_type);
-    
+#if defined (REG_STRUCT_HAS_ADDR)
+  {
+    /* This is a machine like the sparc, where we may need to pass a pointer
+       to the structure, not the structure itself.  */
     for (i = nargs - 1; i >= 0; i--)
-      len += TYPE_LENGTH (VALUE_TYPE (value_arg_coerce (args[i])));
-#ifdef CALL_DUMMY_STACK_ADJUST
-    len += CALL_DUMMY_STACK_ADJUST;
+      if ((TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT
+          || TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_UNION
+          || TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_ARRAY
+          || TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRING)
+         && REG_STRUCT_HAS_ADDR (using_gcc, VALUE_TYPE (args[i])))
+       {
+         CORE_ADDR addr;
+         int len = TYPE_LENGTH (VALUE_TYPE (args[i]));
+#ifdef STACK_ALIGN
+         int aligned_len = STACK_ALIGN (len);
+#else
+         int aligned_len = len;
 #endif
+#if !(1 INNER_THAN 2)
+         /* The stack grows up, so the address of the thing we push
+            is the stack pointer before we push it.  */
+         addr = sp;
+#else
+         sp -= aligned_len;
+#endif
+         /* Push the structure.  */
+         write_memory (sp, VALUE_CONTENTS (args[i]), len);
 #if 1 INNER_THAN 2
-    sp -= STACK_ALIGN (len) - len;
+         /* The stack grows down, so the address of the thing we push
+            is the stack pointer after we push it.  */
+         addr = sp;
 #else
-    sp += STACK_ALIGN (len) - len;
+         sp += aligned_len;
 #endif
+         /* The value we're going to pass is the address of the thing
+            we just pushed.  */
+         args[i] = value_from_longest (lookup_pointer_type (value_type),
+                                       (LONGEST) addr);
+       }
   }
-#endif /* STACK_ALIGN */
+#endif /* REG_STRUCT_HAS_ADDR.  */
 
-    /* Reserve space for the return structure to be written on the
-       stack, if necessary */
+  /* Reserve space for the return structure to be written on the
+     stack, if necessary */
 
-    if (struct_return)
-      {
+  if (struct_return)
+    {
+      int len = TYPE_LENGTH (value_type);
+#ifdef STACK_ALIGN
+      len = STACK_ALIGN (len);
+#endif
 #if 1 INNER_THAN 2
-       sp -= TYPE_LENGTH (value_type);
-       struct_addr = sp;
+      sp -= len;
+      struct_addr = sp;
 #else
-       struct_addr = sp;
-       sp += TYPE_LENGTH (value_type);
+      struct_addr = sp;
+      sp += len;
 #endif
-      }
+    }
 
-#if defined (REG_STRUCT_HAS_ADDR)
+#ifdef STACK_ALIGN
+  /* If stack grows down, we must leave a hole at the top. */
   {
-    /* This is a machine like the sparc, where we need to pass a pointer
-       to the structure, not the structure itself.  */
-    if (REG_STRUCT_HAS_ADDR (using_gcc))
-      for (i = nargs - 1; i >= 0; i--)
-       if (TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT)
-         {
-           CORE_ADDR addr;
-#if !(1 INNER_THAN 2)
-           /* The stack grows up, so the address of the thing we push
-              is the stack pointer before we push it.  */
-           addr = sp;
+    int len = 0;
+
+    for (i = nargs - 1; i >= 0; i--)
+      len += TYPE_LENGTH (VALUE_TYPE (args[i]));
+#ifdef CALL_DUMMY_STACK_ADJUST
+    len += CALL_DUMMY_STACK_ADJUST;
 #endif
-           /* Push the structure.  */
-           sp = value_push (sp, args[i]);
 #if 1 INNER_THAN 2
-           /* The stack grows down, so the address of the thing we push
-              is the stack pointer after we push it.  */
-           addr = sp;
+    sp -= STACK_ALIGN (len) - len;
+#else
+    sp += STACK_ALIGN (len) - len;
 #endif
-           /* The value we're going to pass is the address of the thing
-              we just pushed.  */
-           args[i] = value_from_longest (lookup_pointer_type (value_type),
-                                      (LONGEST) addr);
-         }
   }
-#endif /* REG_STRUCT_HAS_ADDR.  */
+#endif /* STACK_ALIGN */
 
 #ifdef PUSH_ARGUMENTS
   PUSH_ARGUMENTS(nargs, args, sp, struct_return, struct_addr);
 #else /* !PUSH_ARGUMENTS */
   for (i = nargs - 1; i >= 0; i--)
-    sp = value_arg_push (sp, args[i]);
+    sp = value_push (sp, args[i]);
 #endif /* !PUSH_ARGUMENTS */
 
 #ifdef CALL_DUMMY_STACK_ADJUST
@@ -1097,6 +1223,7 @@ call_function_by_hand (function, nargs, args)
        char format[80];
        sprintf (format, "at %s", local_hex_format ());
        name = alloca (80);
+       /* FIXME-32x64: assumes funaddr fits in a long.  */
        sprintf (name, format, (unsigned long) funaddr);
       }
 
@@ -1138,11 +1265,11 @@ the function call).", name);
   }
 }
 #else /* no CALL_DUMMY.  */
-value
+value_ptr
 call_function_by_hand (function, nargs, args)
-     value function;
+     value_ptr function;
      int nargs;
-     value *args;
+     value_ptr *args;
 {
   error ("Cannot invoke functions on this machine.");
 }
@@ -1159,16 +1286,16 @@ call_function_by_hand (function, nargs, args)
    first element, and all elements must have the same size (though we
    don't currently enforce any restriction on their types). */
 
-value
+value_ptr
 value_array (lowbound, highbound, elemvec)
      int lowbound;
      int highbound;
-     value *elemvec;
+     value_ptr *elemvec;
 {
   int nelem;
   int idx;
   int typelength;
-  value val;
+  value_ptr val;
   struct type *rangetype;
   struct type *arraytype;
   CORE_ADDR addr;
@@ -1220,31 +1347,52 @@ value_array (lowbound, highbound, elemvec)
    zero and an upper bound of LEN - 1.  Also note that the string may contain
    embedded null bytes. */
 
-value
+value_ptr
 value_string (ptr, len)
      char *ptr;
      int len;
 {
-  value val;
-  struct type *rangetype;
-  struct type *stringtype;
+  value_ptr val;
+  int lowbound = current_language->string_lower_bound;
+  struct type *rangetype = create_range_type ((struct type *) NULL,
+                                             builtin_type_int,
+                                             lowbound, len + lowbound - 1);
+  struct type *stringtype
+    = create_string_type ((struct type *) NULL, rangetype);
   CORE_ADDR addr;
 
+  if (current_language->c_style_arrays == 0)
+    {
+      val = allocate_value (stringtype);
+      memcpy (VALUE_CONTENTS_RAW (val), ptr, len);
+      return val;
+    }
+
+
   /* Allocate space to store the string in the inferior, and then
      copy LEN bytes from PTR in gdb to that address in the inferior. */
 
   addr = allocate_space_in_inferior (len);
   write_memory (addr, ptr, len);
 
-  /* Create the string type and set up a string value to be evaluated
-     lazily. */
-
-  rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
-                                0, len - 1);
-  stringtype = create_string_type ((struct type *) NULL, rangetype);
   val = value_at_lazy (stringtype, addr);
   return (val);
 }
+
+value_ptr
+value_bitstring (ptr, len)
+     char *ptr;
+     int len;
+{
+  value_ptr val;
+  struct type *domain_type = create_range_type (NULL, builtin_type_int,
+                                               0, len - 1);
+  struct type *type = create_set_type ((struct type*) NULL, domain_type);
+  TYPE_CODE (type) = TYPE_CODE_BITSTRING;
+  val = allocate_value (type);
+  memcpy (VALUE_CONTENTS_RAW (val), ptr, TYPE_LENGTH (type) / TARGET_CHAR_BIT);
+  return val;
+}
 \f
 /* See if we can pass arguments in T2 to a function which takes arguments
    of types T1.  Both t1 and t2 are NULL-terminated vectors.  If some
@@ -1265,7 +1413,7 @@ static int
 typecmp (staticp, t1, t2)
      int staticp;
      struct type *t1[];
-     value t2[];
+     value_ptr t2[];
 {
   int i;
 
@@ -1319,10 +1467,10 @@ typecmp (staticp, t1, t2)
    If LOOKING_FOR_BASECLASS, then instead of looking for struct fields,
    look for a baseclass named NAME.  */
 
-static value
+static value_ptr
 search_struct_field (name, arg1, offset, type, looking_for_baseclass)
      char *name;
-     register value arg1;
+     register value_ptr arg1;
      int offset;
      register struct type *type;
      int looking_for_baseclass;
@@ -1338,7 +1486,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
 
        if (t_field_name && STREQ (t_field_name, name))
          {
-           value v;
+           value_ptr v;
            if (TYPE_FIELD_STATIC (type, i))
              {
                char *phys_name = TYPE_FIELD_STATIC_PHYSNAME (type, i);
@@ -1356,11 +1504,22 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
              error("there is no field named %s", name);
            return v;
          }
+       if (t_field_name && t_field_name[0] == '\0'
+           && TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_UNION)
+         {
+           /* Look for a match through the fields of an anonymous union.  */
+           value_ptr v;
+           v = search_struct_field (name, arg1, offset,
+                                    TYPE_FIELD_TYPE (type, i),
+                                    looking_for_baseclass);
+           if (v)
+             return v;
+         }
       }
 
   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
     {
-      value v;
+      value_ptr v;
       /* If we are looking for baseclasses, this is what we get when we
         hit them.  But it could happen that the base part's member name
         is not yet filled in.  */
@@ -1370,7 +1529,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
 
       if (BASETYPE_VIA_VIRTUAL (type, i))
        {
-         value v2;
+         value_ptr v2;
          /* Fix to use baseclass_offset instead. FIXME */
          baseclass_addr (type, i, VALUE_CONTENTS (arg1) + offset,
                          &v2, (int *)NULL);
@@ -1399,16 +1558,16 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
    If found, return value, else if name matched and args not return (value)-1,
    else return NULL. */
 
-static value
+static value_ptr
 search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
      char *name;
-     register value *arg1p, *args;
+     register value_ptr *arg1p, *args;
      int offset, *static_memfuncp;
      register struct type *type;
 {
   int i;
-  value v;
-  static int name_matched = 0;
+  value_ptr v;
+  int name_matched = 0;
   char dem_opname[64];
 
   check_stub_type (type);
@@ -1440,11 +1599,11 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
                            TYPE_FN_FIELD_ARGS (f, j), args))
                {
                  if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
-                   return (value)value_virtual_fn_field (arg1p, f, j, type, offset);
+                   return value_virtual_fn_field (arg1p, f, j, type, offset);
                  if (TYPE_FN_FIELD_STATIC_P (f, j) && static_memfuncp)
                    *static_memfuncp = 1;
-                 v = (value)value_fn_field (arg1p, f, j, type, offset);
-                 if (v != (value)NULL) return v;
+                 v = value_fn_field (arg1p, f, j, type, offset);
+                 if (v != NULL) return v;
                }
              j--;
            }
@@ -1467,7 +1626,7 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
         }
       v = search_struct_method (name, arg1p, args, base_offset + offset,
                                static_memfuncp, TYPE_BASECLASS (type, i));
-      if (v == (value) -1)
+      if (v == (value_ptr) -1)
        {
          name_matched = 1;
        }
@@ -1478,7 +1637,7 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
          return v;
         }
     }
-  if (name_matched) return (value) -1;
+  if (name_matched) return (value_ptr) -1;
   else return NULL;
 }
 
@@ -1496,15 +1655,15 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
 
    ERR is an error message to be printed in case the field is not found.  */
 
-value
+value_ptr
 value_struct_elt (argp, args, name, static_memfuncp, err)
-     register value *argp, *args;
+     register value_ptr *argp, *args;
      char *name;
      int *static_memfuncp;
      char *err;
 {
   register struct type *t;
-  value v;
+  value_ptr v;
 
   COERCE_ARRAY (*argp);
 
@@ -1550,7 +1709,9 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
 
       v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
 
-      if (v == 0)
+      if (v == (value_ptr) -1)
+       error ("Cannot take address of a method");
+      else if (v == 0)
        {
          if (TYPE_NFN_FIELDS (t))
            error ("There is no member or method named %s.", name);
@@ -1565,8 +1726,8 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
       if (!args[1])
        {
          /* destructors are a special case.  */
-         v = (value)value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, 0),
-                               TYPE_FN_FIELDLIST_LENGTH (t, 0), 0, 0);
+         v = value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, 0),
+                             TYPE_FN_FIELDLIST_LENGTH (t, 0), 0, 0);
          if (!v) error("could not find destructor function named %s.", name);
          else return v;
        }
@@ -1578,7 +1739,7 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
   else
     v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
 
-  if (v == (value) -1)
+  if (v == (value_ptr) -1)
     {
        error("Argument list of %s mismatch with component in the structure.", name);
     }
@@ -1608,7 +1769,15 @@ destructor_name_p (name, type)
   if (name[0] == '~')
     {
       char *dname = type_name_no_tag (type);
-      if (!STREQ (dname, name+1))
+      char *cp = strchr (dname, '<');
+      int len;
+
+      /* Do not compare the template part for template classes.  */
+      if (cp == NULL)
+       len = strlen (dname);
+      else
+       len = cp - dname;
+      if (strlen (name + 1) != len || !STREQN (dname, name + 1, len))
        error ("name of destructor must equal name of class");
       else
        return 1;
@@ -1661,7 +1830,7 @@ check_field_in (type, name)
 
 int
 check_field (arg1, name)
-     register value arg1;
+     register value_ptr arg1;
      const char *name;
 {
   register struct type *t;
@@ -1692,7 +1861,7 @@ check_field (arg1, name)
    "pointers to member functions".  This function is used
    to resolve user expressions of the form "DOMAIN::NAME".  */
 
-value
+value_ptr
 value_struct_elt_for_reference (domain, offset, curtype, name, intype)
      struct type *domain, *curtype, *intype;
      int offset;
@@ -1700,7 +1869,7 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
 {
   register struct type *t = curtype;
   register int i;
-  value v;
+  value_ptr v;
 
   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
       && TYPE_CODE (t) != TYPE_CODE_UNION)
@@ -1786,8 +1955,7 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
                (lookup_reference_type
                 (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
                                      domain)),
-                (LONGEST) METHOD_PTR_FROM_VOFFSET
-                 (TYPE_FN_FIELD_VOFFSET (f, j)));
+                (LONGEST) METHOD_PTR_FROM_VOFFSET (TYPE_FN_FIELD_VOFFSET (f, j)));
            }
          else
            {
@@ -1812,7 +1980,7 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
     }
   for (i = TYPE_N_BASECLASSES (t) - 1; i >= 0; i--)
     {
-      value v;
+      value_ptr v;
       int base_offset;
 
       if (BASETYPE_VIA_VIRTUAL (t, i))
@@ -1833,16 +2001,16 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
 /* C++: return the value of the class instance variable, if one exists.
    Flag COMPLAIN signals an error if the request is made in an
    inappropriate context.  */
-value
+
+value_ptr
 value_of_this (complain)
      int complain;
 {
-  extern FRAME selected_frame;
   struct symbol *func, *sym;
   struct block *b;
   int i;
   static const char funny_this[] = "this";
-  value this;
+  value_ptr this;
 
   if (selected_frame == 0)
     if (complain)
@@ -1880,3 +2048,124 @@ value_of_this (complain)
     error ("`this' argument at unknown address");
   return this;
 }
+
+/* Create a slice (sub-string, sub-array) of ARRAY, that is LENGTH elements
+   long, starting at LOWBOUND.  The result has the same lower bound as
+   the original ARRAY.  */
+
+value_ptr
+value_slice (array, lowbound, length)
+     value_ptr array;
+     int lowbound, length;
+{
+  COERCE_VARYING_ARRAY (array);
+  if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_BITSTRING)
+    error ("not implemented - bitstring slice");
+  if (TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_ARRAY
+      && TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_STRING)
+    error ("cannot take slice of non-array");
+  else
+    {
+      struct type *slice_range_type, *slice_type;
+      value_ptr slice;
+      struct type *range_type = TYPE_FIELD_TYPE (VALUE_TYPE (array), 0);
+      struct type *element_type = TYPE_TARGET_TYPE (VALUE_TYPE (array));
+      int lowerbound = TYPE_LOW_BOUND (range_type);
+      int upperbound = TYPE_HIGH_BOUND (range_type);
+      int offset = (lowbound - lowerbound) * TYPE_LENGTH (element_type);
+      if (lowbound < lowerbound || length < 0
+         || lowbound + length - 1 > upperbound)
+       error ("slice out of range");
+      /* FIXME-type-allocation: need a way to free this type when we are
+        done with it.  */
+      slice_range_type = create_range_type ((struct type*) NULL,
+                                           TYPE_TARGET_TYPE (range_type),
+                                           lowerbound,
+                                           lowerbound + length - 1);
+      slice_type = create_array_type ((struct type*) NULL, element_type,
+                                     slice_range_type);
+      TYPE_CODE (slice_type) = TYPE_CODE (VALUE_TYPE (array));
+      slice = allocate_value (slice_type);
+      if (VALUE_LAZY (array))
+       VALUE_LAZY (slice) = 1;
+      else
+       memcpy (VALUE_CONTENTS (slice), VALUE_CONTENTS (array) + offset,
+               TYPE_LENGTH (slice_type));
+      if (VALUE_LVAL (array) == lval_internalvar)
+       VALUE_LVAL (slice) = lval_internalvar_component;
+      else
+       VALUE_LVAL (slice) = VALUE_LVAL (array);
+      VALUE_ADDRESS (slice) = VALUE_ADDRESS (array);
+      VALUE_OFFSET (slice) = VALUE_OFFSET (array) + offset;
+      return slice;
+    }
+}
+
+/* Assuming chill_varying_type (VARRAY) is true, return an equivalent
+   value as a fixed-length array. */
+
+value_ptr
+varying_to_slice (varray)
+     value_ptr varray;
+{
+  struct type *vtype = VALUE_TYPE (varray);
+  LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
+                               VALUE_CONTENTS (varray)
+                               + TYPE_FIELD_BITPOS (vtype, 0) / 8);
+  return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length);
+}
+
+/* Create a value for a FORTRAN complex number.  Currently most of 
+   the time values are coerced to COMPLEX*16 (i.e. a complex number 
+   composed of 2 doubles.  This really should be a smarter routine 
+   that figures out precision inteligently as opposed to assuming 
+   doubles. FIXME: fmb */ 
+
+value_ptr
+value_literal_complex (arg1, arg2, type)
+     value_ptr arg1;
+     value_ptr arg2;
+     struct type *type;
+{
+  register value_ptr val;
+  struct type *real_type = TYPE_TARGET_TYPE (type);
+
+  val = allocate_value (type);
+  arg1 = value_cast (real_type, arg1);
+  arg2 = value_cast (real_type, arg2);
+
+  memcpy (VALUE_CONTENTS_RAW (val),
+         VALUE_CONTENTS (arg1), TYPE_LENGTH (real_type));
+  memcpy (VALUE_CONTENTS_RAW (val) + TYPE_LENGTH (real_type),
+         VALUE_CONTENTS (arg2), TYPE_LENGTH (real_type));
+  return val;
+}
+
+/* Cast a value into the appropriate complex data type. */
+
+static value_ptr
+cast_into_complex (type, val)
+     struct type *type;
+     register value_ptr val;
+{
+  struct type *real_type = TYPE_TARGET_TYPE (type);
+  if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_COMPLEX)
+    {
+      struct type *val_real_type = TYPE_TARGET_TYPE (VALUE_TYPE (val));
+      value_ptr re_val = allocate_value (val_real_type);
+      value_ptr im_val = allocate_value (val_real_type);
+
+      memcpy (VALUE_CONTENTS_RAW (re_val),
+             VALUE_CONTENTS (val), TYPE_LENGTH (val_real_type));
+      memcpy (VALUE_CONTENTS_RAW (im_val),
+             VALUE_CONTENTS (val) + TYPE_LENGTH (val_real_type),
+              TYPE_LENGTH (val_real_type));
+
+      return value_literal_complex (re_val, im_val, type);
+    }
+  else if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_FLT
+          || TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_INT)
+    return value_literal_complex (val, value_zero (real_type, not_lval), type);
+  else
+    error ("cannot cast non-number to complex");
+}
This page took 0.039666 seconds and 4 git commands to generate.