/* 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.
/* 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 CORE_ADDR value_arg_push PARAMS ((CORE_ADDR, value_ptr));
-static value
-search_struct_field PARAMS ((char *, value, int, struct type *, int));
+static value_ptr search_struct_field PARAMS ((char *, value_ptr, int,
+ struct type *, int));
-static value
-search_struct_method PARAMS ((char *, value *, value *, int, int *,
- struct type *));
+static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
+ value_ptr *,
+ 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 f77_cast_into_complex PARAMS ((struct type *, value_ptr));
+
+static value_ptr f77_assign_from_literal_string PARAMS ((value_ptr,
+ value_ptr));
+
+static value_ptr f77_assign_from_literal_complex PARAMS ((value_ptr,
+ value_ptr));
+
+#define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
\f
/* Allocate NBYTES of space in the inferior using the inferior's malloc
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. */
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 code2;
code1 = TYPE_CODE (type);
code2 = TYPE_CODE (VALUE_TYPE (arg2));
+
+ if (code1 == TYPE_CODE_COMPLEX)
+ return f77_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);
/* 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;
&& 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);
/* 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;
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));
/* 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;
int
value_fetch_lazy (val)
- register value val;
+ register value_ptr val;
{
CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (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 (current_language->la_language == language_fortran)
+ {
+ /* Deal with literal assignment in F77. All composite (i.e. string
+ and complex number types) types are allocated in the superior
+ NOT the inferior. Therefore assigment is somewhat tricky. */
+
+ if (TYPE_CODE (VALUE_TYPE (fromval)) == TYPE_CODE_LITERAL_STRING)
+ return f77_assign_from_literal_string (toval, fromval);
+
+ if (TYPE_CODE (VALUE_TYPE (fromval)) == TYPE_CODE_LITERAL_COMPLEX)
+ return f77_assign_from_literal_complex (toval, fromval);
+ }
+
+ 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);
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
/* 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 '@'.");
return val;
}
-value
+value_ptr
value_of_variable (var, b)
struct symbol *var;
struct block *b;
{
- value val;
+ value_ptr val;
FRAME fr;
if (b == NULL)
the coercion to pointer type.
*/
-value
+value_ptr
value_coerce_array (arg1)
- value arg1;
+ value_ptr arg1;
{
register struct type *type;
error ("Attempt to take address of value not located in memory.");
/* Get type of elements. */
- if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY)
+ if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY
+ || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_STRING)
type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
else
/* A phony array made by value_repeat.
/* 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)
/* 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)
/* 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;
}
/* 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);
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);
static CORE_ADDR
value_push (sp, arg)
register CORE_ADDR sp;
- value arg;
+ value_ptr arg;
{
register int len = TYPE_LENGTH (VALUE_TYPE (arg));
/* Perform the standard coercions that are specified
for arguments to be passed to C functions. */
-value
+value_ptr
value_arg_coerce (arg)
- value arg;
+ value_ptr arg;
{
register struct type *type;
static CORE_ADDR
value_arg_push (sp, arg)
register CORE_ADDR sp;
- value arg;
+ value_ptr arg;
{
return value_push (sp, value_arg_coerce (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);
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;
}
May fail to return, if a breakpoint or signal is hit
during the execution of the function. */
-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;
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);
/* 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
#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
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. */
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");
}
#if defined (REG_STRUCT_HAS_ADDR)
{
- /* This is a machine like the sparc, where we need to pass a pointer
+ /* This is a machine like the sparc, where we may 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;
+ for (i = nargs - 1; i >= 0; i--)
+ if (TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT
+ && REG_STRUCT_HAS_ADDR (using_gcc, VALUE_TYPE (args[i])))
+ {
+ 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;
+ /* The stack grows up, so the address of the thing we push
+ is the stack pointer before we push it. */
+ addr = sp;
#endif
- /* Push the structure. */
- sp = value_push (sp, args[i]);
+ /* 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;
+ /* The stack grows down, so the address of the thing we push
+ is the stack pointer after we push it. */
+ addr = sp;
#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);
- }
+ /* 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. */
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);
}
}
}
#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.");
}
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;
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;
+ value_ptr val;
struct type *rangetype;
struct type *stringtype;
CORE_ADDR addr;
typecmp (staticp, t1, t2)
int staticp;
struct type *t1[];
- value t2[];
+ value_ptr t2[];
{
int i;
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;
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);
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. */
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);
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);
for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; i--)
{
char *t_field_name = TYPE_FN_FIELDLIST_NAME (type, i);
+ if (strncmp(t_field_name, "__", 2)==0 ||
+ strncmp(t_field_name, "op", 2)==0 ||
+ strncmp(t_field_name, "type", 4)==0 )
+ {
+ if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
+ t_field_name = dem_opname;
+ else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
+ t_field_name = dem_opname;
+ }
if (t_field_name && STREQ (t_field_name, name))
{
int j = TYPE_FN_FIELDLIST_LENGTH (type, i) - 1;
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--;
}
}
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;
}
return v;
}
}
- if (name_matched) return (value) -1;
+ if (name_matched) return (value_ptr) -1;
else return NULL;
}
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);
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);
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;
}
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);
}
int
check_field (arg1, name)
- register value arg1;
+ register value_ptr arg1;
const char *name;
{
register struct type *t;
"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;
{
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)
for (i = TYPE_NFN_FIELDS (t) - 1; i >= 0; --i)
{
- if (STREQ (TYPE_FN_FIELDLIST_NAME (t, i), name))
+ char *t_field_name = TYPE_FN_FIELDLIST_NAME (t, i);
+ char dem_opname[64];
+
+ if (strncmp(t_field_name, "__", 2)==0 ||
+ strncmp(t_field_name, "op", 2)==0 ||
+ strncmp(t_field_name, "type", 4)==0 )
+ {
+ if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
+ t_field_name = dem_opname;
+ else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
+ t_field_name = dem_opname;
+ }
+ if (t_field_name && STREQ (t_field_name, name))
{
int j = TYPE_FN_FIELDLIST_LENGTH (t, i);
struct fn_field *f = TYPE_FN_FIELDLIST1 (t, i);
}
for (i = TYPE_N_BASECLASSES (t) - 1; i >= 0; i--)
{
- value v;
+ value_ptr v;
int base_offset;
if (BASETYPE_VIA_VIRTUAL (t, i))
/* 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;
{
struct block *b;
int i;
static const char funny_this[] = "this";
- value this;
+ value_ptr this;
if (selected_frame == 0)
if (complain)
error ("`this' argument at unknown address");
return this;
}
+
+/* Create a value for a literal string. We copy data into a local
+ (NOT inferior's memory) buffer, and then set up an array value.
+
+ The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
+ populated from the values passed in ELEMVEC.
+
+ The element type of the array is inherited from the type of the
+ first element, and all elements must have the same size (though we
+ don't currently enforce any restriction on their types). */
+
+value_ptr
+f77_value_literal_string (lowbound, highbound, elemvec)
+ int lowbound;
+ int highbound;
+ value_ptr *elemvec;
+{
+ int nelem;
+ int idx;
+ int typelength;
+ register value_ptr val;
+ struct type *rangetype;
+ struct type *arraytype;
+ char *addr;
+
+ /* Validate that the bounds are reasonable and that each of the elements
+ have the same size. */
+
+ nelem = highbound - lowbound + 1;
+ if (nelem <= 0)
+ error ("bad array bounds (%d, %d)", lowbound, highbound);
+ typelength = TYPE_LENGTH (VALUE_TYPE (elemvec[0]));
+ for (idx = 0; idx < nelem; idx++)
+ {
+ if (TYPE_LENGTH (VALUE_TYPE (elemvec[idx])) != typelength)
+ error ("array elements must all be the same size");
+ }
+
+ /* Make sure we are dealing with characters */
+
+ if (typelength != 1)
+ error ("Found a non character type in a literal string ");
+
+ /* Allocate space to store the array */
+
+ addr = xmalloc (nelem);
+ for (idx = 0; idx < nelem; idx++)
+ {
+ memcpy (addr + (idx), VALUE_CONTENTS (elemvec[idx]), 1);
+ }
+
+ rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
+ lowbound, highbound);
+
+ arraytype = f77_create_literal_string_type ((struct type *) NULL,
+ rangetype);
+
+ val = allocate_value (arraytype);
+
+ /* Make sure that this the rest of the world knows that this is
+ a standard literal string, not one that is a substring of
+ some base */
+
+ VALUE_SUBSTRING_MEMADDR (val) = (CORE_ADDR)0;
+
+ VALUE_LAZY (val) = 0;
+ VALUE_LITERAL_DATA (val) = addr;
+
+ /* Since this is a standard literal string with no real lval,
+ make sure that value_lval indicates this fact */
+
+ VALUE_LVAL (val) = not_lval;
+ return val;
+}
+
+/* Create a value for a substring. We copy data into a local
+ (NOT inferior's memory) buffer, and then set up an array value.
+
+ The array bounds for the string are (1:(to-from +1))
+ The elements of the string are all characters. */
+
+value_ptr
+f77_value_substring (str, from, to)
+ value_ptr str;
+ int from;
+ int to;
+{
+ int nelem;
+ register value_ptr val;
+ struct type *rangetype;
+ struct type *arraytype;
+ struct internalvar *var;
+ char *addr;
+
+ /* Validate that the bounds are reasonable. */
+
+ nelem = to - from + 1;
+ if (nelem <= 0)
+ error ("bad substring bounds (%d, %d)", from, to);
+
+ rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
+ 1, nelem);
+
+ arraytype = f77_create_literal_string_type ((struct type *) NULL,
+ rangetype);
+
+ val = allocate_value (arraytype);
+
+ /* Allocate space to store the substring array */
+
+ addr = xmalloc (nelem);
+
+ /* Copy over the data */
+
+ /* In case we ever try to use this substring on the LHS of an assignment
+ remember where the SOURCE substring begins, for lval_memory
+ types this ptr is to a location in legal inferior memory,
+ for lval_internalvars it is a ptr. to superior memory. This
+ helps us out later when we do assigments like:
+
+ set var ARR(2:3) = 'ab'
+
+ */
+
+
+ if (VALUE_LVAL (str) == lval_memory)
+ {
+ if (VALUE_SUBSTRING_MEMADDR (str) == (CORE_ADDR)0)
+ {
+ /* This is a regular lval_memory string located in the
+ inferior */
+
+ VALUE_SUBSTRING_MEMADDR (val) = VALUE_ADDRESS (str) + (from - 1);
+ target_read_memory (VALUE_SUBSTRING_MEMADDR (val), addr, nelem);
+ }
+ else
+ {
+
+#if 0
+ /* str is a substring allocated in the superior. Just
+ do a memcpy */
+
+ VALUE_SUBSTRING_MYADDR (val) = VALUE_LITERAL_DATA(str)+(from - 1);
+ memcpy(addr, VALUE_SUBSTRING_MYADDR (val), nelem);
+#else
+ error ("Cannot get substrings of substrings");
+#endif
+ }
+ }
+ else
+ if (VALUE_LVAL(str) == lval_internalvar)
+ {
+ /* Internal variables of type TYPE_CODE_LITERAL_STRING
+ have their data located in the superior
+ process not the inferior */
+
+ var = VALUE_INTERNALVAR (str);
+
+ if (VALUE_SUBSTRING_MEMADDR (str) == (CORE_ADDR)0)
+ VALUE_SUBSTRING_MYADDR (val) =
+ ((char *) VALUE_LITERAL_DATA (var->value)) + (from - 1);
+ else
+#if 0
+ VALUE_SUBSTRING_MYADDR (val) = VALUE_LITERAL_DATA(str)+(from -1);
+#else
+ error ("Cannot get substrings of substrings");
+#endif
+ memcpy (addr, VALUE_SUBSTRING_MYADDR (val), nelem);
+ }
+ else
+ error ("Substrings can not be applied to this data item");
+
+ VALUE_LAZY (val) = 0;
+ VALUE_LITERAL_DATA (val) = addr;
+
+ /* This literal string's *data* is located in the superior BUT
+ we do need to know where it came from (i.e. was the source
+ string an internalvar or a regular lval_memory variable), so
+ we set the lval field to indicate this. This will be useful
+ when we use this value on the LHS of an expr. */
+
+ VALUE_LVAL (val) = VALUE_LVAL (str);
+ return val;
+}
+
+/* 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
+f77_value_literal_complex (arg1, arg2, size)
+ value_ptr arg1;
+ value_ptr arg2;
+ int size;
+{
+ struct type *complex_type;
+ register value_ptr val;
+ char *addr;
+
+ if (size != 8 && size != 16 && size != 32)
+ error ("Cannot create number of type 'complex*%d'", size);
+
+ /* If either value comprising a complex number is a non-floating
+ type, cast to double. */
+
+ if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT)
+ arg1 = value_cast (builtin_type_f_real_s8, arg1);
+
+ if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT)
+ arg2 = value_cast (builtin_type_f_real_s8, arg2);
+
+ complex_type = f77_create_literal_complex_type (VALUE_TYPE (arg1),
+ VALUE_TYPE (arg2)
+#if 0
+/* FIXME: does f77_create_literal_complex_type need to do something with
+ this? */
+ ,
+ size
+#endif
+ );
+
+ val = allocate_value (complex_type);
+
+ /* Now create a pointer to enough memory to hold the the two args */
+
+ addr = xmalloc (TYPE_LENGTH (complex_type));
+
+ /* Copy over the two components */
+
+ memcpy (addr, VALUE_CONTENTS_RAW (arg1), TYPE_LENGTH (VALUE_TYPE (arg1)));
+
+ memcpy (addr + TYPE_LENGTH (VALUE_TYPE (arg1)), VALUE_CONTENTS_RAW (arg2),
+ TYPE_LENGTH (VALUE_TYPE (arg2)));
+
+ VALUE_ADDRESS (val) = 0; /* Not located in the inferior */
+ VALUE_LAZY (val) = 0;
+ VALUE_LITERAL_DATA (val) = addr;
+
+ /* Since this is a literal value, make sure that value_lval indicates
+ this fact */
+
+ VALUE_LVAL (val) = not_lval;
+ return val;
+}
+
+/* Cast a value into the appropriate complex data type. Only works
+ if both values are complex. */
+
+static value_ptr
+f77_cast_into_complex (type, val)
+ struct type *type;
+ register value_ptr val;
+{
+ register enum type_code valcode;
+ float tmp_f;
+ double tmp_d;
+ register value_ptr piece1, piece2;
+
+ int lenfrom, lento;
+
+ valcode = TYPE_CODE (VALUE_TYPE (val));
+
+ /* This casting will only work if the right hand side is
+ either a regular complex type or a literal complex type.
+ I.e: this casting is only for size adjustment of
+ complex numbers not anything else. */
+
+ if ((valcode != TYPE_CODE_COMPLEX) &&
+ (valcode != TYPE_CODE_LITERAL_COMPLEX))
+ error ("Cannot cast from a non complex type!");
+
+ lenfrom = TYPE_LENGTH (VALUE_TYPE (val));
+ lento = TYPE_LENGTH (type);
+
+ if (lento == lenfrom)
+ error ("Value to be cast is already of type %s", TYPE_NAME (type));
+
+ if (lento == 32 || lenfrom == 32)
+ error ("Casting into/out of complex*32 unsupported");
+
+ switch (lento)
+ {
+ case 16:
+ {
+ /* Since we have excluded lenfrom == 32 and
+ lenfrom == 16, it MUST be 8 */
+
+ if (valcode == TYPE_CODE_LITERAL_COMPLEX)
+ {
+ /* Located in superior's memory. Routine should
+ deal with both real literal complex numbers
+ as well as internal vars */
+
+ /* Grab the two 4 byte reals that make up the complex*8 */
+
+ tmp_f = *((float *) VALUE_LITERAL_DATA (val));
+
+ piece1 = value_from_double(builtin_type_f_real_s8,tmp_f);
+
+ tmp_f = *((float *) (((char *) VALUE_LITERAL_DATA (val))
+ + sizeof(float)));
+
+ piece2 = value_from_double (builtin_type_f_real_s8, tmp_f);
+ }
+ else
+ {
+ /* Located in inferior memory, so first we need
+ to read the 2 floats that make up the 8 byte
+ complex we are are casting from */
+
+ read_memory ((CORE_ADDR) VALUE_CONTENTS (val),
+ (char *) &tmp_f, sizeof(float));
+
+ piece1 = value_from_double (builtin_type_f_real_s8, tmp_f);
+
+ read_memory ((CORE_ADDR) VALUE_CONTENTS (val) + sizeof(float),
+ (char *) &tmp_f, sizeof(float));
+
+ piece2 = value_from_double (builtin_type_f_real_s8, tmp_f);
+ }
+ return f77_value_literal_complex (piece1, piece2, 16);
+ }
+
+ case 8:
+ {
+ /* Since we have excluded lenfrom == 32 and
+ lenfrom == 8, it MUST be 16. NOTE: in this
+ case data may be since we are dropping precison */
+
+ if (valcode == TYPE_CODE_LITERAL_COMPLEX)
+ {
+ /* Located in superior's memory. Routine should
+ deal with both real literal complex numbers
+ as well as internal vars */
+
+ /* Grab the two 8 byte reals that make up the complex*16 */
+
+ tmp_d = *((double *) VALUE_LITERAL_DATA (val));
+
+ piece1 = value_from_double (builtin_type_f_real, tmp_d);
+
+ tmp_d = *((double *) (((char *) VALUE_LITERAL_DATA (val))
+ + sizeof(double)));
+
+ piece2 = value_from_double (builtin_type_f_real, tmp_d);
+ }
+ else
+ {
+ /* Located in inferior memory, so first we need to read the
+ 2 floats that make up the 8 byte complex we are are
+ casting from. */
+
+ read_memory ((CORE_ADDR) VALUE_CONTENTS (val),
+ (char *) &tmp_d, sizeof(double));
+
+ piece1 = value_from_double (builtin_type_f_real, tmp_d);
+
+ read_memory ((CORE_ADDR) VALUE_CONTENTS (val) + sizeof(double),
+ (char *) &tmp_f, sizeof(double));
+
+ piece2 = value_from_double (builtin_type_f_real, tmp_d);
+ }
+ return f77_value_literal_complex (piece1, piece2, 8);
+ }
+
+ default:
+ error ("Invalid F77 complex number cast");
+ }
+}
+
+/* The following function is called in order to assign
+ a literal F77 array to either an internal GDB variable
+ or to a real array variable in the inferior.
+ This function is necessary because in F77, literal
+ arrays are allocated in the superior's memory space
+ NOT the inferior's. This function provides a way to
+ get the F77 stuff to work without messing with the
+ way C deals with this issue. NOTE: we are assuming
+ that all F77 array literals are STRING array literals. F77
+ users have no good way of expressing non-string
+ literal strings.
+
+ This routine now also handles assignment TO literal strings
+ in the peculiar case of substring assignments of the
+ form:
+
+ STR(2:3) = 'foo'
+
+ */
+
+static value_ptr
+f77_assign_from_literal_string (toval, fromval)
+ register value_ptr toval, fromval;
+{
+ register struct type *type = VALUE_TYPE (toval);
+ register value_ptr val;
+ struct internalvar *var;
+ int lenfrom, lento;
+ CORE_ADDR tmp_addr;
+ char *c;
+
+ lenfrom = TYPE_LENGTH (VALUE_TYPE (fromval));
+ lento = TYPE_LENGTH (VALUE_TYPE (toval));
+
+ if ((VALUE_LVAL (toval) == lval_internalvar
+ || VALUE_LVAL (toval) == lval_memory)
+ && VALUE_SUBSTRING_START (toval) != 0)
+ {
+ /* We are assigning TO a substring type. This is of the form:
+
+ set A(2:5) = 'foov'
+
+ The result of this will be a modified toval not a brand new
+ value. This is high F77 weirdness. */
+
+ /* Simply overwrite the relevant memory, wherever it
+ exists. Use standard F77 character assignment rules
+ (if len(toval) > len(fromval) pad with blanks,
+ if len(toval) < len(fromval) truncate else just copy. */
+
+ if (VALUE_LVAL (toval) == lval_internalvar)
+ {
+ /* Memory in superior. */
+ var = VALUE_INTERNALVAR (toval);
+ memcpy ((char *) VALUE_SUBSTRING_START (toval),
+ (char *) VALUE_LITERAL_DATA (fromval),
+ (lento > lenfrom) ? lenfrom : lento);
+
+ /* Check to see if we have to pad. */
+
+ if (lento > lenfrom)
+ {
+ memset((char *) VALUE_SUBSTRING_START(toval) + lenfrom,
+ ' ', lento - lenfrom);
+ }
+ }
+ else
+ {
+ /* Memory in inferior. */
+ write_memory ((CORE_ADDR) VALUE_SUBSTRING_START (toval),
+ (char *) VALUE_LITERAL_DATA (fromval),
+ (lento > lenfrom) ? lenfrom : lento);
+
+ /* Check to see if we have to pad. */
+
+ if (lento > lenfrom)
+ {
+ c = alloca (lento-lenfrom);
+ memset (c, ' ', lento - lenfrom);
+
+ tmp_addr = VALUE_SUBSTRING_START (toval) + lenfrom;
+ write_memory (tmp_addr, c, lento - lenfrom);
+ }
+ }
+ return fromval;
+ }
+ else
+ {
+ if (VALUE_LVAL (toval) == lval_internalvar)
+ type = VALUE_TYPE (fromval);
+
+ val = allocate_value (type);
+
+ switch (VALUE_LVAL (toval))
+ {
+ case lval_internalvar:
+
+ /* Internal variables are funny. Their value information
+ is stored in the location.internalvar sub structure. */
+
+ var = VALUE_INTERNALVAR (toval);
+
+ /* The item in toval is a regular internal variable
+ and this assignment is of the form:
+
+ set var $foo = 'hello' */
+
+ /* First free up any old stuff in this internalvar. */
+
+ free (VALUE_LITERAL_DATA (var->value));
+ VALUE_LITERAL_DATA (var->value) = 0;
+ VALUE_LAZY (var->value) = 0; /* Disable lazy fetches since this
+ is not located in inferior. */
+
+ /* Copy over the relevant value data from 'fromval' */
+
+ set_internalvar (VALUE_INTERNALVAR (toval), fromval);
+
+ /* Now replicate the VALUE_LITERAL_DATA field so that
+ we may later safely de-allocate fromval. */
+
+ VALUE_LITERAL_DATA (var->value) =
+ malloc (TYPE_LENGTH (VALUE_TYPE (fromval)));
+
+ memcpy((char *) VALUE_LITERAL_DATA (var->value),
+ (char *) VALUE_LITERAL_DATA (fromval),
+ lenfrom);
+
+ /* Copy over all relevant value data from 'toval'. into
+ the structure to returned */
+
+ memcpy (val, toval, sizeof(struct value));
+
+ /* Lastly copy the pointer to the area where the
+ internalvar data is stored to the VALUE_CONTENTS field.
+ This will be a helpful shortcut for printout
+ routines later */
+
+ VALUE_LITERAL_DATA (val) = VALUE_LITERAL_DATA (var->value);
+ break;
+
+ case lval_memory:
+
+ /* We are copying memory from the local (superior)
+ literal string to a legitimate address in the
+ inferior. VALUE_ADDRESS is the address in
+ the inferior. VALUE_OFFSET is not used because
+ structs do not exist in F77. */
+
+ /* Copy over all relevant value data from 'toval'. */
+
+ memcpy (val, toval, sizeof(struct value));
+
+ write_memory ((CORE_ADDR) VALUE_ADDRESS (val),
+ (char *) VALUE_LITERAL_DATA (fromval),
+ (lento > lenfrom) ? lenfrom : lento);
+
+ /* Check to see if we have to pad */
+
+ if (lento > lenfrom)
+ {
+ c = alloca (lento - lenfrom);
+ memset (c, ' ', lento - lenfrom);
+ tmp_addr = VALUE_ADDRESS (val) + lenfrom;
+ write_memory (tmp_addr, c, lento - lenfrom);
+ }
+ break;
+
+ default:
+ error ("Unknown lval type in f77_assign_from_literal_string");
+ }
+
+ /* Now free up the transient literal string's storage. */
+
+ free (VALUE_LITERAL_DATA (fromval));
+
+ VALUE_TYPE (val) = type;
+
+ return val;
+ }
+}
+
+
+/* The following function is called in order to assign a literal F77
+ complex to either an internal GDB variable or to a real complex
+ variable in the inferior. This function is necessary because in F77,
+ composite literals are allocated in the superior's memory space
+ NOT the inferior's. This function provides a way to get the F77 stuff
+ to work without messing with the way C deals with this issue. */
+
+static value_ptr
+f77_assign_from_literal_complex (toval, fromval)
+ register value_ptr toval, fromval;
+{
+ register struct type *type = VALUE_TYPE (toval);
+ register value_ptr val;
+ struct internalvar *var;
+ float tmp_float=0;
+ double tmp_double = 0;
+
+ if (VALUE_LVAL (toval) == lval_internalvar)
+ type = VALUE_TYPE (fromval);
+
+ /* Allocate a value node for the result. */
+
+ val = allocate_value (type);
+
+ if (VALUE_LVAL (toval) == lval_internalvar)
+ {
+ /* Internal variables are funny. Their value information
+ is stored in the location.internalvar sub structure. */
+
+ var = VALUE_INTERNALVAR (toval);
+
+ /* First free up any old stuff in this internalvar. */
+
+ free (VALUE_LITERAL_DATA (var->value));
+ VALUE_LITERAL_DATA (var->value) = 0;
+ VALUE_LAZY (var->value) = 0; /* Disable lazy fetches since
+ this is not located in inferior. */
+
+ /* Copy over the relevant value data from 'fromval'. */
+
+ set_internalvar (VALUE_INTERNALVAR (toval), fromval);
+
+ /* Now replicate the VALUE_LITERAL_DATA field so that
+ we may later safely de-allocate fromval. */
+
+ VALUE_LITERAL_DATA (var->value) =
+ malloc (TYPE_LENGTH (VALUE_TYPE (fromval)));
+
+ memcpy ((char *) VALUE_LITERAL_DATA (var->value),
+ (char *) VALUE_LITERAL_DATA (fromval),
+ TYPE_LENGTH (VALUE_TYPE (fromval)));
+
+ /* Copy over all relevant value data from 'toval' into the
+ structure to be returned. */
+
+ memcpy (val, toval, sizeof(struct value));
+ }
+ else
+ {
+ /* We are copying memory from the local (superior) process to a
+ legitimate address in the inferior. VALUE_ADDRESS is the
+ address in the inferior. */
+
+ /* Copy over all relevant value data from 'toval'. */
+
+ memcpy (val, toval, sizeof(struct value));
+
+ if (TYPE_LENGTH (VALUE_TYPE (fromval))
+ > TYPE_LENGTH (VALUE_TYPE (toval)))
+ {
+ /* Since all literals are actually complex*16 types, deal with
+ the case when one tries to assign a literal to a complex*8. */
+
+ if ((TYPE_LENGTH(VALUE_TYPE(fromval)) == 16) &&
+ (TYPE_LENGTH(VALUE_TYPE(toval)) == 8))
+ {
+ tmp_double = *((double *) VALUE_LITERAL_DATA (fromval));
+
+ tmp_float = (float) tmp_double;
+
+ write_memory (VALUE_ADDRESS(val),
+ (char *) &tmp_float, sizeof(float));
+
+ tmp_double = *((double *)
+ (((char *) VALUE_LITERAL_DATA (fromval))
+ + sizeof(double)));
+
+ tmp_float = (float) tmp_double;
+
+ write_memory(VALUE_ADDRESS(val) + sizeof(float),
+ (char *) &tmp_float, sizeof(float));
+ }
+ else
+ error ("Cannot assign literal complex to variable!");
+ }
+ else
+ {
+ write_memory (VALUE_ADDRESS (val),
+ (char *) VALUE_LITERAL_DATA (fromval),
+ TYPE_LENGTH (VALUE_TYPE (fromval)));
+ }
+ }
+
+ /* Now free up the transient literal string's storage */
+
+ free (VALUE_LITERAL_DATA (fromval));
+
+ VALUE_TYPE (val) = type;
+
+ return val;
+}
projects / deliverable / binutils-gdb.git / blobdiff