darkkirb/old-cross-binutils
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

* eval.c (evaluate_subexp): Clean up handling of

Browse source 
OP_UNDETERMINED_ARGLIST (no backtracking, more general).

	* f-valprint.c (f_val_print):  Print TYPE_CODE_STRING using
	LA_PRINT_STRING, and not val_print_string (which reads from inferior).

	* ch-lang.c (chill_is_varying_struct), ch-lang.h:  Remve function
	duplicate function made redundant by chill_varying_type.

	Re-write of f77 string and complex number support:

	* language.h (struct language_defn):  New fields string_lower_bound
	and string_char_type.
	* c-lang.c (c_language_defn, cplus_language_defn, asm_language_defn),
	language.c (unknown_language_defn, auto_language_defn,
	local_language_defn), m2-lang.c (m2_language_defn), f-lang.c
	(f_language_defn), ch-lang.c (chill_language_defn):  Set new fields.
	* gdbtypes.c (create_string_type):  Use new string_char_type field.
	* valops.c (value_string):  Use new string_lower_bound field.

	* defs.h (TARGET_COMPLEX_BIT, TARGET_DOUBLE_COMPLEX_BIT):  Removed.
	* f-lang.c (f_create_fundamental_type, _initialize_f_language),
	m2-lang.c (m2_create_fundamental_type),
	gdbtypes.c (_initialize_gdbtypes):  Set TYPE_TARGET_TYPE of complex
	types.  Set their TYPE_CODEs to TYPE_CODE_COMPLEX.
	* mdebugread.c (mdebug_type_complex, mdebug_type_double_complex):
	Removed.  Use builtin_type_complex and builtin_type_double_complex.

	* gdbtypes.h (enum type_code):  Removed TYPE_CODE_LITERAL_STRING
	and TYPE_CODE_LITERAL_COMPLEX.
	* c-typeprint.c, f-typeprint.c, f-valprint.c, eval.c:  Removed uses of
	TYPE_CODE_LITERAL_STRING and TYPE_CODE_LITERAL_COMPLEX.
	* gdbtypes.c, gdbtypes.h (f77_create_literal_complex_type,
	f77_create_literal_string_type):  Removed.
	* value.h (VALUE_LITERAL_DATA, VALUE_SUBSTRING_MEMADDR,
	VALUE_SUBSTRING_MYADDR):  Removed.

	* expression.h (enum exp_opcode):  Rename OP_F77_LITERAL_COMPLEX to
	OP_COMPLEX.
	* parse.c:  Update accordingly.

	* f-valprint.c (f77_print_cmplx):  Removed.
	(f_val_print case TYPE_CODE_COMPLEX):  Re-write to use print_floating.

	* f-exp.y (STRING_LITERAL):  Use OP_STRING instead of OP_ARRAY.
	* eval.c (evaluate_subexp):  For case OP_ARRAY, don't call
	f77_value_literal_string.
	* valops.c, value.h (f77_value_literal_string, f77_value_substring,
	f77_assign_from_literal_string, f77_assign_from_literal_complex):
	Removed.
	(value_assign):  No longer need to handle literal types.
	* valops.c (f77_value_literal_complex), value.h:  Re-written and
	renamed to value_literal_complex.  Last arg is now a (complex) type.
	* valops.c (f77_cast_into_complex):  Re-written and renamed to
	cast_into_complex.
	* eval.c (evaluate_subexp):  Update accordingly.
This commit is contained in:
Per Bothner 1995-02-02 03:37:26 +00:00
parent 6073b8deba
commit ead95f8ac2
18 changed files with 180 additions and 424 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
gdb/ChangeLog
View file

@ -1,5 +1,62 @@
Wed Feb 1 15:44:11 1995 Per Bothner <bothner@kalessin.cygnus.com>
* eval.c (evaluate_subexp): Clean up handling of
OP_UNDETERMINED_ARGLIST (no backtracking, more general).
* f-valprint.c (f_val_print): Print TYPE_CODE_STRING using
LA_PRINT_STRING, and not val_print_string (which reads from inferior).
* ch-lang.c (chill_is_varying_struct), ch-lang.h: Remve function
duplicate function made redundant by chill_varying_type.
Re-write of f77 string and complex number support:
* language.h (struct language_defn): New fields string_lower_bound
and string_char_type.
* c-lang.c (c_language_defn, cplus_language_defn, asm_language_defn),
language.c (unknown_language_defn, auto_language_defn,
local_language_defn), m2-lang.c (m2_language_defn), f-lang.c
(f_language_defn), ch-lang.c (chill_language_defn): Set new fields.
* gdbtypes.c (create_string_type): Use new string_char_type field.
* valops.c (value_string): Use new string_lower_bound field.
* defs.h (TARGET_COMPLEX_BIT, TARGET_DOUBLE_COMPLEX_BIT): Removed.
* f-lang.c (f_create_fundamental_type, _initialize_f_language),
m2-lang.c (m2_create_fundamental_type),
gdbtypes.c (_initialize_gdbtypes): Set TYPE_TARGET_TYPE of complex
types. Set their TYPE_CODEs to TYPE_CODE_COMPLEX.
* mdebugread.c (mdebug_type_complex, mdebug_type_double_complex):
Removed. Use builtin_type_complex and builtin_type_double_complex.
* gdbtypes.h (enum type_code): Removed TYPE_CODE_LITERAL_STRING
and TYPE_CODE_LITERAL_COMPLEX.
* c-typeprint.c, f-typeprint.c, f-valprint.c, eval.c: Removed uses of
TYPE_CODE_LITERAL_STRING and TYPE_CODE_LITERAL_COMPLEX.
* gdbtypes.c, gdbtypes.h (f77_create_literal_complex_type,
f77_create_literal_string_type): Removed.
* value.h (VALUE_LITERAL_DATA, VALUE_SUBSTRING_MEMADDR,
VALUE_SUBSTRING_MYADDR): Removed.
* expression.h (enum exp_opcode): Rename OP_F77_LITERAL_COMPLEX to
OP_COMPLEX.
* parse.c: Update accordingly.
* f-valprint.c (f77_print_cmplx): Removed.
(f_val_print case TYPE_CODE_COMPLEX): Re-write to use print_floating.
* f-exp.y (STRING_LITERAL): Use OP_STRING instead of OP_ARRAY.
* eval.c (evaluate_subexp): For case OP_ARRAY, don't call
f77_value_literal_string.
* valops.c, value.h (f77_value_literal_string, f77_value_substring,
f77_assign_from_literal_string, f77_assign_from_literal_complex):
Removed.
(value_assign): No longer need to handle literal types.
* valops.c (f77_value_literal_complex), value.h: Re-written and
renamed to value_literal_complex. Last arg is now a (complex) type.
* valops.c (f77_cast_into_complex): Re-written and renamed to
cast_into_complex.
* eval.c (evaluate_subexp): Update accordingly.
* ch-valprint.c (chill_val_print): On TYPE_CODE_STRING, don't
print address for non-'s'-formats.
* ch-typeprint.c, ch-valprint.c: Use chill_varying_type instead

6
gdb/c-lang.c
View file

@ -411,6 +411,8 @@ const struct language_defn c_language_defn = {
{"0x%lx", "0x", "x", ""}, /* Hex format info */
c_op_print_tab, /* expression operators for printing */
1, /* c-style arrays */
0, /* String lower bound */
&builtin_type_char, /* Type of string elements */
LANG_MAGIC
};
@ -434,6 +436,8 @@ const struct language_defn cplus_language_defn = {
{"0x%lx", "0x", "x", ""}, /* Hex format info */
c_op_print_tab, /* expression operators for printing */
1, /* c-style arrays */
0, /* String lower bound */
&builtin_type_char, /* Type of string elements */
LANG_MAGIC
};
@ -457,6 +461,8 @@ const struct language_defn asm_language_defn = {
{"0x%lx", "0x", "x", ""}, /* Hex format info */
c_op_print_tab, /* expression operators for printing */
1, /* c-style arrays */
0, /* String lower bound */
&builtin_type_char, /* Type of string elements */
LANG_MAGIC
};

4
gdb/c-typeprint.c
View file

@ -315,8 +315,6 @@ c_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
case TYPE_CODE_STRING:
case TYPE_CODE_BITSTRING:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_LITERAL_COMPLEX:
case TYPE_CODE_LITERAL_STRING:
/* These types need no prefix. They are listed here so that
gcc -Wall will reveal any types that haven't been handled. */
break;
@ -442,8 +440,6 @@ c_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
case TYPE_CODE_STRING:
case TYPE_CODE_BITSTRING:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_LITERAL_COMPLEX:
case TYPE_CODE_LITERAL_STRING:
/* These types do not need a suffix. They are listed so that
gcc -Wall will report types that may not have been considered. */
break;

17
gdb/ch-lang.c
View file

@ -182,21 +182,6 @@ chill_printstr (stream, string, length, force_ellipses)
}
}
/* Return 1 if TYPE is a varying string or array. */
int
chill_is_varying_struct (type)
struct type *type;
{
if (TYPE_CODE (type) != TYPE_CODE_STRUCT)
return 0;
if (TYPE_NFIELDS (type) != 2)
return 0;
if (strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0)
return 0;
return 1;
}
static struct type *
chill_create_fundamental_type (objfile, typeid)
struct objfile *objfile;
@ -324,6 +309,8 @@ const struct language_defn chill_language_defn = {
{"H'%lx", "H'", "x", ""}, /* Hex format info */
chill_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */
0, /* String lower bound */
&builtin_type_chill_char, /* Type of string elements */
LANG_MAGIC
};

5
gdb/ch-lang.h
View file

@ -37,8 +37,3 @@ chill_val_print PARAMS ((struct type *, char *, CORE_ADDR, GDB_FILE *, int, int,
extern int
chill_value_print PARAMS ((struct value *, GDB_FILE *,
int, enum val_prettyprint));
extern int
chill_is_varying_struct PARAMS ((struct type *type));

109
gdb/eval.c
View file

@ -237,7 +237,6 @@ evaluate_subexp (expect_type, exp, pos, noside)
struct type *type;
int nargs;
value_ptr *argvec;
int tmp_pos, tmp1_pos;
struct symbol *tmp_symbol;
int upper, lower, retcode;
int code;
@ -430,11 +429,7 @@ evaluate_subexp (expect_type, exp, pos, noside)
}
if (noside == EVAL_SKIP)
goto nosideret;
if (current_language->la_language == language_fortran)
/* For F77, we need to do special things to literal strings */
return (f77_value_literal_string (tem2, tem3, argvec));
return value_array (tem2, tem3, argvec);
break;
case TERNOP_SLICE:
{
@ -629,6 +624,8 @@ evaluate_subexp (expect_type, exp, pos, noside)
argvec[0] = arg1;
}
do_call_it:
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
@ -652,8 +649,6 @@ evaluate_subexp (expect_type, exp, pos, noside)
case OP_F77_UNDETERMINED_ARGLIST:
tmp_pos = pc; /* Point to this instr */
/* Remember that in F77, functions, substring ops and
array subscript operations cannot be disambiguated
at parse time. We have made all array subscript operations,
@ -673,89 +668,42 @@ evaluate_subexp (expect_type, exp, pos, noside)
instruction sequence */
nargs = longest_to_int (exp->elts[tmp_pos+1].longconst);
tmp_pos += 3; /* size(op_funcall) == 3 elts */
/* We will always have an OP_VAR_VALUE as the next opcode.
The data stored after the OP_VAR_VALUE is the a pointer
to the function/array/string symbol. We should now check and
make sure that the symbols is an array and not a function.
If it is an array type, we have hit a F77 subscript operation and
we have to do some magic. If it is not an array, we check
to see if we found a string here. If there is a string,
we recursively evaluate and let OP_f77_SUBSTR deal with
things. If there is no string, we know there is a function
call at hand and change OP_FUNCALL_OR_SUBSCRIPT -> OP_FUNCALL.
In all cases, we recursively evaluate. */
nargs = longest_to_int (exp->elts[pc+1].longconst);
(*pos) += 2;
/* First determine the type code we are dealing with. */
switch (exp->elts[tmp_pos].opcode)
{
case OP_VAR_VALUE:
tmp_pos += 1; /* To get to the symbol ptr */
tmp_symbol = exp->elts[tmp_pos].symbol;
code = TYPE_CODE (SYMBOL_TYPE (tmp_symbol));
break;
case OP_INTERNALVAR:
tmp_pos += 1;
var = exp->elts[tmp_pos].internalvar;
code = TYPE_CODE(VALUE_TYPE(var->value));
break;
case OP_F77_UNDETERMINED_ARGLIST:
/* Special case when you do stuff like print ARRAY(1,1)(3:4) */
tmp1_pos = tmp_pos ;
arg2 = evaluate_subexp (NULL_TYPE, exp, &tmp1_pos, noside);
code =TYPE_CODE (VALUE_TYPE (arg2));
break;
default:
error ("Cannot perform substring on this type");
}
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
code = TYPE_CODE (VALUE_TYPE (arg1));
switch (code)
{
case TYPE_CODE_ARRAY:
/* Transform this into what it really is: a MULTI_F77_SUBSCRIPT */
tmp_pos = pc;
exp->elts[tmp_pos].opcode = MULTI_F77_SUBSCRIPT;
exp->elts[tmp_pos+2].opcode = MULTI_F77_SUBSCRIPT;
break;
case TYPE_CODE_ARRAY:
goto multi_f77_subscript;
case TYPE_CODE_LITERAL_STRING: /* When substring'ing internalvars */
case TYPE_CODE_STRING:
tmp_pos = pc;
exp->elts[tmp_pos].opcode = OP_F77_SUBSTR;
exp->elts[tmp_pos+2].opcode = OP_F77_SUBSTR;
break;
goto op_f77_substr;
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
/* This is just a regular OP_FUNCALL, transform it
and recursively evaluate */
tmp_pos = pc; /* Point to OP_FUNCALL_OR_SUBSCRIPT */
exp->elts[tmp_pos].opcode = OP_FUNCALL;
exp->elts[tmp_pos+2].opcode = OP_FUNCALL;
break;
/* It's a function call. */
/* Allocate arg vector, including space for the function to be
called in argvec[0] and a terminating NULL */
argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
argvec[0] = arg1;
tem = 1;
for (; tem <= nargs; tem++)
argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
argvec[tem] = 0; /* signal end of arglist */
goto do_call_it;
default:
error ("Cannot perform substring on this type");
}
/* Pretend like you never saw this expression */
*pos -= 1;
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
return arg2;
case OP_F77_SUBSTR:
op_f77_substr:
/* We have a substring operation on our hands here,
let us get the string we will be dealing with */
(*pos) += 2;
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
/* Now evaluate the 'from' and 'to' */
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
@ -763,6 +711,9 @@ evaluate_subexp (expect_type, exp, pos, noside)
if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
error ("Substring arguments must be of type integer");
if (nargs < 2)
return value_subscript (arg1, arg2);
arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
if (TYPE_CODE (VALUE_TYPE (arg3)) != TYPE_CODE_INT)
@ -780,16 +731,15 @@ evaluate_subexp (expect_type, exp, pos, noside)
if (noside == EVAL_SKIP)
goto nosideret;
return f77_value_substring (arg1, tem2, tem3);
return value_slice (arg1, tem2, tem3 - tem2 + 1);
case OP_F77_LITERAL_COMPLEX:
case OP_COMPLEX:
/* We have a complex number, There should be 2 floating
point numbers that compose it */
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
/* Complex*16 is the default size to create */
return f77_value_literal_complex (arg1, arg2, 16);
return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
case STRUCTOP_STRUCT:
tem = longest_to_int (exp->elts[pc + 1].longconst);
@ -1014,7 +964,7 @@ evaluate_subexp (expect_type, exp, pos, noside)
}
return (arg1);
case MULTI_F77_SUBSCRIPT:
multi_f77_subscript:
{
int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of
subscripts, max == 7 */
@ -1024,13 +974,8 @@ evaluate_subexp (expect_type, exp, pos, noside)
int offset_item; /* The array offset where the item lives */
int fixed_subscript;
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
if (nargs > MAX_FORTRAN_DIMS)
error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
ndimensions = calc_f77_array_dims (VALUE_TYPE (arg1));

2
gdb/expression.h
View file

@ -191,7 +191,7 @@ enum exp_opcode
/* The following OP is a special one, it introduces a F77 complex
literal. It is followed by exactly two args that are doubles. */
OP_F77_LITERAL_COMPLEX,
OP_COMPLEX,
/* The following OP introduces a F77 substring operator.
It should have a string type and two integer types that follow

31
gdb/f-exp.y
View file

@ -279,7 +279,7 @@ complexnum: exp ',' exp
;
exp : '(' complexnum ')'
{ write_exp_elt_opcode(OP_F77_LITERAL_COMPLEX); }
{ write_exp_elt_opcode(OP_COMPLEX); }
;
exp : '(' type ')' exp %prec UNARY
@ -436,32 +436,11 @@ exp : BOOLEAN_LITERAL
;
exp : STRING_LITERAL
{ /* In F77, we encounter string literals
basically in only one place:
when we are setting up manual parameter
lists to functions we call by hand or
when setting string vars to manual values.
These are character*N type variables.
They are treated specially behind the
scenes. Remember that the literal strings's
OPs are being emitted in reverse order, thus
we first have the elements and then
the array descriptor itself. */
char *sp = $1.ptr; int count = $1.length;
while (count-- > 0)
{
write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (builtin_type_f_character);
write_exp_elt_longcst ((LONGEST)(*sp++));
write_exp_elt_opcode (OP_LONG);
}
write_exp_elt_opcode (OP_ARRAY);
write_exp_elt_longcst ((LONGEST) 1);
write_exp_elt_longcst ((LONGEST) ($1.length));
write_exp_elt_opcode (OP_ARRAY);
{
write_exp_elt_opcode (OP_STRING);
write_exp_string ($1);
write_exp_elt_opcode (OP_STRING);
}
;
variable: name_not_typename

63
gdb/f-lang.c
View file

@ -28,6 +28,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
#include "language.h"
#include "f-lang.h"
/* The built-in types of F77. FIXME: integer*4 is missing, plain
logical is missing (builtin_type_logical is logical*4). */
struct type *builtin_type_f_character;
struct type *builtin_type_f_logical;
struct type *builtin_type_f_logical_s1;
struct type *builtin_type_f_logical_s2;
struct type *builtin_type_f_integer;
struct type *builtin_type_f_integer_s2;
struct type *builtin_type_f_real;
struct type *builtin_type_f_real_s8;
struct type *builtin_type_f_real_s16;
struct type *builtin_type_f_complex_s8;
struct type *builtin_type_f_complex_s16;
struct type *builtin_type_f_complex_s32;
struct type *builtin_type_f_void;
/* Print the character C on STREAM as part of the contents of a literal
string whose delimiter is QUOTER. Note that that format for printing
characters and strings is language specific.
@ -318,19 +335,22 @@ f_create_fundamental_type (objfile, typeid)
0, "real*16", objfile);
break;
case FT_COMPLEX:
type = init_type (TYPE_CODE_FLT,
TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
type = init_type (TYPE_CODE_COMPLEX,
2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0, "complex*8", objfile);
TYPE_TARGET_TYPE (type) = builtin_type_f_real;
break;
case FT_DBL_PREC_COMPLEX:
type = init_type (TYPE_CODE_FLT,
TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
type = init_type (TYPE_CODE_COMPLEX,
2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "complex*16", objfile);
TYPE_TARGET_TYPE (type) = builtin_type_f_real_s8;
break;
case FT_EXT_PREC_COMPLEX:
type = init_type (TYPE_CODE_FLT,
TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
type = init_type (TYPE_CODE_COMPLEX,
2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "complex*32", objfile);
TYPE_TARGET_TYPE (type) = builtin_type_f_real_s16;
break;
default:
/* FIXME: For now, if we are asked to produce a type not in this
@ -373,23 +393,6 @@ static const struct op_print f_op_print_tab[] = {
{ NULL, 0, 0, 0 }
};
/* The built-in types of F77. FIXME: integer*4 is missing, plain
logical is missing (builtin_type_logical is logical*4). */
struct type *builtin_type_f_character;
struct type *builtin_type_f_logical;
struct type *builtin_type_f_logical_s1;
struct type *builtin_type_f_logical_s2;
struct type *builtin_type_f_integer;
struct type *builtin_type_f_integer_s2;
struct type *builtin_type_f_real;
struct type *builtin_type_f_real_s8;
struct type *builtin_type_f_real_s16;
struct type *builtin_type_f_complex_s8;
struct type *builtin_type_f_complex_s16;
struct type *builtin_type_f_complex_s32;
struct type *builtin_type_f_void;
struct type ** const (f_builtin_types[]) =
{
&builtin_type_f_character,
@ -432,6 +435,8 @@ const struct language_defn f_language_defn = {
{"0x%x", "0x", "x", ""}, /* Hex format info */
f_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */
1, /* String lower bound */
&builtin_type_f_character, /* Type of string elements */
LANG_MAGIC
};
@ -489,24 +494,26 @@ _initialize_f_language ()
"real*16", (struct objfile *) NULL);
builtin_type_f_complex_s8 =
init_type (TYPE_CODE_COMPLEX, TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
init_type (TYPE_CODE_COMPLEX, 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0,
"complex*8", (struct objfile *) NULL);
TYPE_TARGET_TYPE (builtin_type_f_complex_s8) = builtin_type_f_real;
builtin_type_f_complex_s16 =
init_type (TYPE_CODE_COMPLEX, TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
init_type (TYPE_CODE_COMPLEX, 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0,
"complex*16", (struct objfile *) NULL);
TYPE_TARGET_TYPE (builtin_type_f_complex_s16) = builtin_type_f_real_s8;
#if 0
/* We have a new size == 4 double floats for the
complex*32 data type */
builtin_type_f_complex_s32 =
init_type (TYPE_CODE_COMPLEX, TARGET_EXT_COMPLEX_BIT / TARGET_CHAR_BIT,
init_type (TYPE_CODE_COMPLEX, 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
0,
"complex*32", (struct objfile *) NULL);
#endif
TYPE_TARGET_TYPE (builtin_type_f_complex_s32) = builtin_type_f_real_s16;
builtin_type_string =
init_type (TYPE_CODE_STRING, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0,

10
gdb/f-typeprint.c
View file

@ -144,8 +144,6 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
case TYPE_CODE_MEMBER:
case TYPE_CODE_REF:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_LITERAL_COMPLEX:
case TYPE_CODE_LITERAL_STRING:
/* These types need no prefix. They are listed here so that
gcc -Wall will reveal any types that haven't been handled. */
break;
@ -291,8 +289,6 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
case TYPE_CODE_METHOD:
case TYPE_CODE_MEMBER:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_LITERAL_COMPLEX:
case TYPE_CODE_LITERAL_STRING:
/* These types do not need a suffix. They are listed so that
gcc -Wall will report types that may not have been considered. */
break;
@ -413,7 +409,6 @@ f_type_print_base (type, stream, show, level)
break;
case TYPE_CODE_COMPLEX:
case TYPE_CODE_LITERAL_COMPLEX:
fprintf_filtered (stream, "complex*");
fprintf_filtered (stream, "%d", TYPE_LENGTH (type));
break;
@ -422,11 +417,6 @@ f_type_print_base (type, stream, show, level)
print_equivalent_f77_float_type (type, stream);
break;
case TYPE_CODE_LITERAL_STRING:
fprintf_filtered (stream, "character*%d",
TYPE_ARRAY_UPPER_BOUND_VALUE (type));
break;
case TYPE_CODE_STRING:
/* Strings may have dynamic upperbounds (lengths) like arrays. */

148
gdb/f-valprint.c
View file

@ -216,60 +216,6 @@ f77_get_dynamic_length_of_aggregate (type)
(upper_bound - lower_bound + 1) * TYPE_LENGTH (TYPE_TARGET_TYPE (type));
}
/* Print a FORTRAN COMPLEX value of type TYPE, pointed to in GDB by VALADDR,
on STREAM. which_complex indicates precision, which may be regular,
*16, or *32 */
void
f77_print_cmplx (valaddr, type, stream, which_complex)
char *valaddr;
struct type *type;
FILE *stream;
int which_complex;
{
float *f1,*f2;
double *d1, *d2;
switch (which_complex)
{
case TARGET_COMPLEX_BIT:
f1 = (float *) valaddr;
f2 = (float *) (valaddr + sizeof(float));
fprintf_filtered (stream, "(%.7e,%.7e)", *f1, *f2);
break;
case TARGET_DOUBLE_COMPLEX_BIT:
d1 = (double *) valaddr;
d2 = (double *) (valaddr + sizeof(double));
fprintf_filtered (stream, "(%.16e,%.16e)", *d1, *d2);
break;
#if 0
case TARGET_EXT_COMPLEX_BIT:
fprintf_filtered (stream, "<complex*32 format unavailable, "
"printing raw data>\n");
fprintf_filtered (stream, "( [ ");
for (i = 0;i<4;i++)
fprintf_filtered (stream, "0x%x ",
* ( (unsigned int *) valaddr+i));
fprintf_filtered (stream, "],\n [ ");
for (i=4;i<8;i++)
fprintf_filtered (stream, "0x%x ",
* ((unsigned int *) valaddr+i));
fprintf_filtered (stream, "] )");
break;
#endif
default:
fprintf_filtered (stream, "<cannot handle complex of this type>");
break;
}
}
/* Function that sets up the array offset,size table for the array
type "type". */
@ -446,45 +392,9 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
switch (TYPE_CODE (type))
{
case TYPE_CODE_LITERAL_STRING:
/* It is trivial to print out F77 strings allocated in the
superior process. The address field is actually a
pointer to the bytes of the literal. For an internalvar,
valaddr points to a ptr. which points to
VALUE_LITERAL_DATA(value->internalvar->value)
and for straight literals (i.e. of the form 'hello world'),
valaddr points a ptr to VALUE_LITERAL_DATA(value). */
/* First dereference valaddr. This relies on valaddr pointing to the
aligner union of a struct value (so we are now fetching the
literal_data pointer from that union). FIXME: Is this always
true. */
straddr = * (char **) valaddr;
if (straddr)
{
len = TYPE_LENGTH (type);
localstr = alloca (len + 1);
strncpy (localstr, straddr, len);
localstr[len] = '\0';
fprintf_filtered (stream, "'%s'", localstr);
}
else
fprintf_filtered (stream, "Unable to print literal F77 string");
break;
/* Strings are a little bit funny. They can be viewed as
monolithic arrays that are dealt with as atomic data
items. As such they are the only atomic data items whose
contents are not located in the superior process. Instead
instead of having the actual data, they contain pointers
to addresses in the inferior where data is located. Thus
instead of using valaddr, we use address. */
case TYPE_CODE_STRING:
f77_get_dynamic_length_of_aggregate (type);
val_print_string (address, TYPE_LENGTH (type), stream);
LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 0);
break;
case TYPE_CODE_ARRAY:
@ -634,60 +544,20 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
}
break;
case TYPE_CODE_LITERAL_COMPLEX:
/* We know that the literal complex is stored in the superior
process not the inferior and that it is 16 bytes long.
Just like the case above with a literal array, the
bytes for the the literal complex number are stored
at the address pointed to by valaddr */
if (TYPE_LENGTH (type) == 32)
error ("Cannot currently print out complex*32 literals");
/* First dereference valaddr. */
addr = * (CORE_ADDR *) valaddr;
if (addr)
{
fprintf_filtered (stream, "(");
if (TYPE_LENGTH(type) == 16)
{
fprintf_filtered (stream, "%.16f", * (double *) addr);
fprintf_filtered (stream, ", %.16f", * (double *)
(addr + sizeof(double)));
}
else
{
fprintf_filtered (stream, "%.8f", * (float *) addr);
fprintf_filtered (stream, ", %.8f", * (float *)
(addr + sizeof(float)));
}
fprintf_filtered (stream, ") ");
}
else
fprintf_filtered (stream, "Unable to print literal F77 array");
break;
case TYPE_CODE_COMPLEX:
switch (TYPE_LENGTH (type))
{
case 8:
f77_print_cmplx (valaddr, type, stream, TARGET_COMPLEX_BIT);
break;
case 16:
f77_print_cmplx(valaddr, type, stream, TARGET_DOUBLE_COMPLEX_BIT);
break;
#if 0
case 32:
f77_print_cmplx(valaddr, type, stream, TARGET_EXT_COMPLEX_BIT);
break;
#endif
case 8: type = builtin_type_f_real; break;
case 16: type = builtin_type_f_real_s8; break;
case 32: type = builtin_type_f_real_s16; break;
default:
error ("Cannot print out complex*%d variables", TYPE_LENGTH(type));
}
fputs_filtered ("(", stream);
print_floating (valaddr, type, stream);
fputs_filtered (",", stream);
print_floating (valaddr, type, stream);
fputs_filtered (")", stream);
break;
case TYPE_CODE_UNDEF:

90
gdb/gdbtypes.c
View file

@ -451,7 +451,9 @@ create_string_type (result_type, range_type)
struct type *result_type;
struct type *range_type;
{
result_type = create_array_type (result_type, builtin_type_char, range_type);
result_type = create_array_type (result_type,
*current_language->string_char_type,
range_type);
TYPE_CODE (result_type) = TYPE_CODE_STRING;
return (result_type);
}
@ -486,86 +488,6 @@ create_set_type (result_type, domain_type)
return (result_type);
}
/* Create an F77 literal complex type composed of the two types we are
given as arguments. */
struct type *
f77_create_literal_complex_type (type_arg1, type_arg2)
struct type *type_arg1;
struct type *type_arg2;
{
struct type *result;
/* First make sure that the 2 components of the complex
number both have the same type */
if (TYPE_CODE (type_arg1) != TYPE_CODE (type_arg2))
error ("Both components of a F77 complex number must have the same type!");
result = alloc_type (TYPE_OBJFILE (type_arg1));
TYPE_CODE (result) = TYPE_CODE_LITERAL_COMPLEX;
TYPE_LENGTH (result) = TYPE_LENGTH(type_arg1) * 2;
return result;
}
/* Create a F77 LITERAL string type supplied by the user from the keyboard.
Elements will be of type ELEMENT_TYPE, the indices will be of type
RANGE_TYPE.
FIXME: Maybe we should check the TYPE_CODE of RESULT_TYPE to make
sure it is TYPE_CODE_UNDEF before we bash it into an array type?
This is a total clone of create_array_type() except that there are
a few simplyfing assumptions (e.g all bound types are simple). */
struct type *
f77_create_literal_string_type (result_type, range_type)
struct type *result_type;
struct type *range_type;
{
int low_bound;
int high_bound;
if (TYPE_CODE (range_type) != TYPE_CODE_RANGE)
{
/* FIXME: We only handle range types at the moment. Complain and
create a dummy range type to use. */
warning ("internal error: array index type must be a range type");
range_type = lookup_fundamental_type (TYPE_OBJFILE (range_type),
FT_INTEGER);
range_type = create_range_type ((struct type *) NULL, range_type, 0, 0);
}
if (result_type == NULL)
result_type = alloc_type (TYPE_OBJFILE (range_type));
TYPE_CODE (result_type) = TYPE_CODE_LITERAL_STRING;
TYPE_TARGET_TYPE (result_type) = builtin_type_f_character;
low_bound = TYPE_FIELD_BITPOS (range_type, 0);
high_bound = TYPE_FIELD_BITPOS (range_type, 1);
/* Safely can assume that all bound types are simple */
TYPE_LENGTH (result_type) =
TYPE_LENGTH (builtin_type_f_character) * (high_bound - low_bound + 1);
TYPE_NFIELDS (result_type) = 1;
TYPE_FIELDS (result_type) =
(struct field *) TYPE_ALLOC (result_type, sizeof (struct field));
memset (TYPE_FIELDS (result_type), 0, sizeof (struct field));
TYPE_FIELD_TYPE (result_type, 0) = range_type;
TYPE_VPTR_FIELDNO (result_type) = -1;
/* Remember that all literal strings in F77 are of the
character*N type. */
TYPE_ARRAY_LOWER_BOUND_TYPE (result_type) = BOUND_SIMPLE;
TYPE_ARRAY_UPPER_BOUND_TYPE (result_type) = BOUND_SIMPLE;
return result_type;
}
/* Smash TYPE to be a type of members of DOMAIN with type TO_TYPE.
A MEMBER is a wierd thing -- it amounts to a typed offset into
a struct, e.g. "an int at offset 8". A MEMBER TYPE doesn't
@ -1663,13 +1585,15 @@ _initialize_gdbtypes ()
0,
"long double", (struct objfile *) NULL);
builtin_type_complex =
init_type (TYPE_CODE_FLT, TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
init_type (TYPE_CODE_COMPLEX, 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0,
"complex", (struct objfile *) NULL);
TYPE_TARGET_TYPE (builtin_type_complex) = builtin_type_float;
builtin_type_double_complex =
init_type (TYPE_CODE_FLT, TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
init_type (TYPE_CODE_COMPLEX, 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0,
"double complex", (struct objfile *) NULL);
TYPE_TARGET_TYPE (builtin_type_double_complex) = builtin_type_double;
builtin_type_string =
init_type (TYPE_CODE_STRING, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0,

9
gdb/gdbtypes.h
View file

@ -121,8 +121,6 @@ enum type_code
/* Fortran */
TYPE_CODE_COMPLEX, /* Complex float */
TYPE_CODE_LITERAL_COMPLEX, /* */
TYPE_CODE_LITERAL_STRING /* */
};
/* For now allow source to use TYPE_CODE_CLASS for C++ classes, as an
@ -214,6 +212,7 @@ struct type
For an array type, describes the type of the elements.
For a function or method type, describes the type of the return value.
For a range type, describes the type of the full range.
For a complex type, describes the type of each coordinate.
Unused otherwise. */
struct type *target_type;
@ -724,14 +723,8 @@ create_array_type PARAMS ((struct type *, struct type *, struct type *));
extern struct type *
create_string_type PARAMS ((struct type *, struct type *));
extern struct type *f77_create_literal_string_type PARAMS ((struct type *,
struct type *));
extern struct type *create_set_type PARAMS ((struct type *, struct type *));
extern struct type *f77_create_literal_complex_type PARAMS ((struct type *,
struct type *));
extern int chill_varying_type PARAMS ((struct type*));
extern struct type *

6
gdb/language.c
View file

@ -1201,6 +1201,8 @@ const struct language_defn unknown_language_defn = {
{"0x%lx", "0x", "x", ""}, /* Hex format info */
unk_op_print_tab, /* expression operators for printing */
1, /* c-style arrays */
0, /* String lower bound */
&builtin_type_char, /* Type of string elements */
LANG_MAGIC
};
@ -1225,6 +1227,8 @@ const struct language_defn auto_language_defn = {
{"0x%lx", "0x", "x", ""}, /* Hex format info */
unk_op_print_tab, /* expression operators for printing */
1, /* c-style arrays */
0, /* String lower bound */
&builtin_type_char, /* Type of string elements */
LANG_MAGIC
};
@ -1248,6 +1252,8 @@ const struct language_defn local_language_defn = {
{"0x%lx", "0x", "x", ""}, /* Hex format info */
unk_op_print_tab, /* expression operators for printing */
1, /* c-style arrays */
0, /* String lower bound */
&builtin_type_char, /* Type of string elements */
LANG_MAGIC
};

6
gdb/language.h
View file

@ -177,6 +177,12 @@ struct language_defn
char c_style_arrays;
/* Index to use for extracting the first element of a string. */
char string_lower_bound;
/* Type of elements of strings. */
struct type **string_char_type;
/* Add fields above this point, so the magic number is always last. */
/* Magic number for compat checking */

20
gdb/m2-lang.c
View file

@ -330,19 +330,25 @@ m2_create_fundamental_type (objfile, typeid)
0, "long double", objfile);
break;
case FT_COMPLEX:
type = init_type (TYPE_CODE_FLT,
TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
type = init_type (TYPE_CODE_COMPLEX,
2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0, "complex", objfile);
TYPE_TARGET_TYPE (type)
= m2_create_fundamental_type (objfile, FT_FLOAT);
break;
case FT_DBL_PREC_COMPLEX:
type = init_type (TYPE_CODE_FLT,
TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
type = init_type (TYPE_CODE_COMPLEX,
2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "double complex", objfile);
TYPE_TARGET_TYPE (type)
= m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
break;
case FT_EXT_PREC_COMPLEX:
type = init_type (TYPE_CODE_FLT,
TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
type = init_type (TYPE_CODE_COMPLEX,
2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long double complex", objfile);
TYPE_TARGET_TYPE (type)
= m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
break;
}
return (type);
@ -413,6 +419,8 @@ const struct language_defn m2_language_defn = {
{"0%lXH", "0", "X", "H"}, /* Hex format info */
m2_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */
0, /* String lower bound */
&builtin_type_m2_char, /* Type of string elements */
LANG_MAGIC
};

17
gdb/mdebugread.c
View file

@ -274,8 +274,6 @@ static char stabs_symbol[] = STABS_SYMBOL;
be using our own types thoughout this file, instead of sometimes using
builtin_type_*. */
static struct type *mdebug_type_complex;
static struct type *mdebug_type_double_complex;
static struct type *mdebug_type_fixed_dec;
static struct type *mdebug_type_float_dec;
static struct type *mdebug_type_string;
@ -1358,8 +1356,8 @@ parse_type (fd, ax, aux_index, bs, bigend, sym_name)
0, /* btTypedef */
0, /* btRange */
0, /* btSet */
&mdebug_type_complex, /* btComplex */
&mdebug_type_double_complex, /* btDComplex */
&builtin_type_complex, /* btComplex */
&builtin_type_double_complex,/* btDComplex */
0, /* btIndirect */
&mdebug_type_fixed_dec, /* btFixedDec */
&mdebug_type_float_dec, /* btFloatDec */
@ -4065,17 +4063,6 @@ _initialize_mdebugread ()
0, "string",
(struct objfile *) NULL);
mdebug_type_complex =
init_type (TYPE_CODE_ERROR,
TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
0, "complex",
(struct objfile *) NULL);
mdebug_type_double_complex =
init_type (TYPE_CODE_ERROR,
TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
0, "double complex",
(struct objfile *) NULL);
/* We use TYPE_CODE_INT to print these as integers. Does this do any
good? Would we be better off with TYPE_CODE_ERROR? Should
TYPE_CODE_ERROR print things in hex if it knows the size? */

4
gdb/parse.c
View file

@ -470,7 +470,7 @@ length_of_subexp (expr, endpos)
oplen = 3;
break;
case OP_F77_LITERAL_COMPLEX:
case OP_COMPLEX:
oplen = 1;
args = 2;
break;
@ -615,7 +615,7 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg)
oplen = 3;
break;
case OP_F77_LITERAL_COMPLEX:
case OP_COMPLEX:
oplen = 1;
args = 2;
break;