diff options
author | Per Bothner <per@bothner.com> | 1995-02-12 18:51:42 +0000 |
---|---|---|
committer | Per Bothner <per@bothner.com> | 1995-02-12 18:51:42 +0000 |
commit | 5222ca60be5bf56265a53aad3df6303de53fd0af (patch) | |
tree | b2ecc1aa51ee2abe68d3c3dd864c8517e165ebd6 | |
parent | 27202b6a4746af217ab914394a1ab9b111b1db3c (diff) | |
download | gdb-5222ca60be5bf56265a53aad3df6303de53fd0af.zip gdb-5222ca60be5bf56265a53aad3df6303de53fd0af.tar.gz gdb-5222ca60be5bf56265a53aad3df6303de53fd0af.tar.bz2 |
* valops.c (value_arg_coerce): Now takes param_type argument.
(call_function_by_hand): Convert arguments with value_arg_coerce
early, and overwrite original args with converted args.
No longer need multiple calls to value_arg_coerce.
(value_arg_push): Removed.
* hppa-tdep.c (hppa_push_arguments): No longer call value_arg_coerce.
* mips-tdep.c (mips_push_arguments): Likewise.
* alpha-tdep.c (alpha_push_arguments): Likewise.
* rs6000-tdep.c (push_arguments, ran_out_of_registers_for_arguments):
Likewise.
* value.h (value_arg_coerce): Remove declaration. (It's now static.)
* valops.c (value_cast): Do COERCE_VARYING_ARRAY after COERCE_REF.
-rw-r--r-- | gdb/ChangeLog | 14 | ||||
-rw-r--r-- | gdb/alpha-tdep.c | 2 | ||||
-rw-r--r-- | gdb/hppa-tdep.c | 3 | ||||
-rw-r--r-- | gdb/rs6000-tdep.c | 6 | ||||
-rw-r--r-- | gdb/valops.c | 788 | ||||
-rw-r--r-- | gdb/value.h | 31 |
6 files changed, 103 insertions, 741 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 42ea03e..f30f8ec 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -14,6 +14,20 @@ Sun Feb 12 10:02:16 1995 Per Bothner <bothner@cygnus.com> (recursive_dump_type): Don't print TYPE_FUNCTION_TYPE. * dwarfread.c (read_subroutine_type): Don't set TYPE_FUNCTION_TYPE. + * valops.c (value_arg_coerce): Now takes param_type argument. + (call_function_by_hand): Convert arguments with value_arg_coerce + early, and overwrite original args with converted args. + No longer need multiple calls to value_arg_coerce. + (value_arg_push): Removed. + * hppa-tdep.c (hppa_push_arguments): No longer call value_arg_coerce. + * mips-tdep.c (mips_push_arguments): Likewise. + * alpha-tdep.c (alpha_push_arguments): Likewise. + * rs6000-tdep.c (push_arguments, ran_out_of_registers_for_arguments): + Likewise. + * value.h (value_arg_coerce): Remove declaration. (It's now static.) + + * valops.c (value_cast): Do COERCE_VARYING_ARRAY after COERCE_REF. + Sun Feb 12 09:03:47 1995 Jim Kingdon (kingdon@lioth.cygnus.com) * buildsym.c (start_subfile): Set language for f2c like for cfront. diff --git a/gdb/alpha-tdep.c b/gdb/alpha-tdep.c index ea6591f..b08fb20 100644 --- a/gdb/alpha-tdep.c +++ b/gdb/alpha-tdep.c @@ -680,7 +680,7 @@ alpha_push_arguments (nargs, args, sp, struct_return, struct_addr) for (i = 0, m_arg = alpha_args; i < nargs; i++, m_arg++) { - value_ptr arg = value_arg_coerce (args[i]); + value_ptr arg = args[i]; /* Cast argument to long if necessary as the compiler does it too. */ if (TYPE_LENGTH (VALUE_TYPE (arg)) < TYPE_LENGTH (builtin_type_long)) arg = value_cast (builtin_type_long, arg); diff --git a/gdb/hppa-tdep.c b/gdb/hppa-tdep.c index c227b94..52f9b93 100644 --- a/gdb/hppa-tdep.c +++ b/gdb/hppa-tdep.c @@ -1367,9 +1367,6 @@ hppa_push_arguments (nargs, args, sp, struct_return, struct_addr) for (i = 0; i < nargs; i++) { - /* Coerce chars to int & float to double if necessary */ - args[i] = value_arg_coerce (args[i]); - cum += TYPE_LENGTH (VALUE_TYPE (args[i])); /* value must go at proper alignment. Assume alignment is a diff --git a/gdb/rs6000-tdep.c b/gdb/rs6000-tdep.c index dad2211..6cac92e 100644 --- a/gdb/rs6000-tdep.c +++ b/gdb/rs6000-tdep.c @@ -731,7 +731,7 @@ push_arguments (nargs, args, sp, struct_return, struct_addr) for (argno=0, argbytes=0; argno < nargs && ii<8; ++ii) { - arg = value_arg_coerce (args[argno]); + arg = args[argno]; len = TYPE_LENGTH (VALUE_TYPE (arg)); if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FLT) { @@ -796,7 +796,7 @@ ran_out_of_registers_for_arguments: jj = argno; for (; jj < nargs; ++jj) { - val = value_arg_coerce (args[jj]); + val = args[jj]; space += ((TYPE_LENGTH (VALUE_TYPE (val))) + 3) & -4; } @@ -824,7 +824,7 @@ ran_out_of_registers_for_arguments: /* push the rest of the arguments into stack. */ for (; argno < nargs; ++argno) { - arg = value_arg_coerce (args[argno]); + arg = args[argno]; len = TYPE_LENGTH (VALUE_TYPE (arg)); diff --git a/gdb/valops.c b/gdb/valops.c index e5e5734..a08dfc5 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -40,8 +40,6 @@ static CORE_ADDR find_function_addr PARAMS ((value_ptr, struct type **)); static CORE_ADDR value_push PARAMS ((CORE_ADDR, value_ptr)); -static CORE_ADDR value_arg_push PARAMS ((CORE_ADDR, value_ptr)); - static value_ptr search_struct_field PARAMS ((char *, value_ptr, int, struct type *, int)); @@ -53,13 +51,7 @@ static int check_field_in PARAMS ((struct type *, const char *)); 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)); +static value_ptr cast_into_complex PARAMS ((struct type *, value_ptr)); #define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL) @@ -91,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); @@ -132,18 +124,18 @@ value_cast (type, arg2) if (VALUE_TYPE (arg2) == type) return arg2; - COERCE_VARYING_ARRAY (arg2); - /* 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); + COERCE_VARYING_ARRAY (arg2); + code1 = TYPE_CODE (type); code2 = TYPE_CODE (VALUE_TYPE (arg2)); if (code1 == TYPE_CODE_COMPLEX) - return f77_cast_into_complex (type, arg2); + return cast_into_complex (type, arg2); if (code1 == TYPE_CODE_BOOL) code1 = TYPE_CODE_INT; if (code2 == TYPE_CODE_BOOL) @@ -352,19 +344,6 @@ value_assign (toval, fromval) 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."); @@ -822,54 +801,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_ptr -value_arg_coerce (arg) + If PARAM_TYPE is non-NULL, it is the expected parameter type. */ + +static value_ptr +value_arg_coerce (arg, param_type) value_ptr arg; + struct type *param_type; { - register struct type *type; + register struct type *type = param_type ? param_type : VALUE_TYPE (arg); - /* 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. */ - - 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 (SYMBOL_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 (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_ptr 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. @@ -945,7 +921,9 @@ 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_ptr call_function_by_hand (function, nargs, args) @@ -971,6 +949,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(); @@ -1064,6 +1043,16 @@ call_function_by_hand (function, nargs, args) sp = old_sp; /* It really is used, for some ifdef's... */ #endif + 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); + } + #ifdef STACK_ALIGN /* If stack grows down, we must leave a hole at the top. */ { @@ -1076,7 +1065,7 @@ call_function_by_hand (function, nargs, args) len += TYPE_LENGTH (value_type); for (i = nargs - 1; i >= 0; i--) - len += TYPE_LENGTH (VALUE_TYPE (value_arg_coerce (args[i]))); + len += TYPE_LENGTH (VALUE_TYPE (args[i])); #ifdef CALL_DUMMY_STACK_ADJUST len += CALL_DUMMY_STACK_ADJUST; #endif @@ -1135,7 +1124,7 @@ call_function_by_hand (function, nargs, args) 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 @@ -1320,8 +1309,10 @@ value_string (ptr, len) int len; { value_ptr val; + int lowbound = current_language->string_lower_bound; struct type *rangetype = create_range_type ((struct type *) NULL, - builtin_type_int, 0, len - 1); + builtin_type_int, + lowbound, len + lowbound - 1); struct type *stringtype = create_string_type ((struct type *) NULL, rangetype); CORE_ADDR addr; @@ -2015,80 +2006,6 @@ value_of_this (complain) 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 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. */ @@ -2152,116 +2069,6 @@ varying_to_slice (varray) return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length); } -/* 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 @@ -2269,477 +2076,50 @@ f77_value_substring (str, from, to) doubles. FIXME: fmb */ value_ptr -f77_value_literal_complex (arg1, arg2, size) +value_literal_complex (arg1, arg2, type) value_ptr arg1; value_ptr arg2; - int size; + struct type *type; { - 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; + struct type *real_type = TYPE_TARGET_TYPE (type); - /* Since this is a literal value, make sure that value_lval indicates - this fact */ + val = allocate_value (type); + arg1 = value_cast (real_type, arg1); + arg2 = value_cast (real_type, arg2); - VALUE_LVAL (val) = not_lval; + 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. Only works - if both values are complex. */ +/* Cast a value into the appropriate complex data type. */ static value_ptr -f77_cast_into_complex (type, val) +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) + struct type *real_type = TYPE_TARGET_TYPE (type); + if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_COMPLEX) { - /* 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. */ + 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); - /* 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. */ + 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)); - 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)); + 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 - { - /* 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; + error ("cannot cast non-number to complex"); } diff --git a/gdb/value.h b/gdb/value.h index 8979dbe..82140ae 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -147,29 +147,6 @@ extern int value_fetch_lazy PARAMS ((value_ptr val)); #define VALUE_REGNO(val) (val)->regno #define VALUE_OPTIMIZED_OUT(val) ((val)->optimized_out) -/* This is probably not the right thing to do for in-gdb arrays. FIXME */ -/* Overload the contents field to store literal data for - arrays. */ - -#define VALUE_LITERAL_DATA(val) ((val)->aligner.literal_data) - -/* Pointer to - the base substring, for F77 string substring operators. - We use this ONLY when doing operations of the form - - FOO= 'hello' - FOO(2:4) = 'foo' - - In the above case VALUE_SUBSTRING_* would point to - FOO(2) in the original FOO string. - - Depending on whether the base object is allocated in the - inferior or the superior process, use VALUE_SUBSTRING_MYADDR or - VALUE_SUBSTRING_MEMADDR. */ - -#define VALUE_SUBSTRING_MEMADDR(val) (val)->substring_addr.memaddr -#define VALUE_SUBSTRING_MYADDR(val) (val)->substring_addr.myaddr - /* Convert a REF to the object referenced. */ #define COERCE_REF(arg) \ @@ -484,8 +461,6 @@ extern void print_variable_value PARAMS ((struct symbol *var, struct frame_info *frame, GDB_FILE *stream)); -extern value_ptr value_arg_coerce PARAMS ((value_ptr)); - extern int check_field PARAMS ((value_ptr, const char *)); extern void @@ -514,10 +489,6 @@ extern value_ptr value_slice PARAMS ((value_ptr, int, int)); extern value_ptr call_function_by_hand PARAMS ((value_ptr, int, value_ptr *)); -extern value_ptr f77_value_literal_complex PARAMS ((value_ptr, value_ptr, int)); - -extern value_ptr f77_value_literal_string PARAMS ((int, int, value_ptr *)); - -extern value_ptr f77_value_substring PARAMS ((value_ptr, int, int)); +extern value_ptr value_literal_complex PARAMS ((value_ptr, value_ptr, struct type*)); #endif /* !defined (VALUE_H) */ |