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.
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
{"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
};
{"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
};
{"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
};
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;
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;
}
}
-/* 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;
{"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
};
extern int
chill_value_print PARAMS ((struct value *, GDB_FILE *,
int, enum val_prettyprint));
-
-extern int
-chill_is_varying_struct PARAMS ((struct type *type));
-
-
struct type *type;
int nargs;
value_ptr *argvec;
- int tmp_pos, tmp1_pos;
struct symbol *tmp_symbol;
int upper, lower, retcode;
int code;
}
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:
{
argvec[0] = arg1;
}
+ do_call_it:
+
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
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,
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_LITERAL_STRING: /* When substring'ing internalvars */
+ case TYPE_CODE_ARRAY:
+ goto multi_f77_subscript;
+
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);
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)
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);
}
return (arg1);
- case MULTI_F77_SUBSCRIPT:
+ multi_f77_subscript:
{
int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of
subscripts, max == 7 */
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));
/* 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
;
exp : '(' complexnum ')'
- { write_exp_elt_opcode(OP_F77_LITERAL_COMPLEX); }
+ { write_exp_elt_opcode(OP_COMPLEX); }
;
exp : '(' type ')' exp %prec UNARY
;
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
#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.
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
{ NULL, 0, 0, 0 }
};
\f
-/* 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,
{"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
};
"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,
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;
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;
break;
case TYPE_CODE_COMPLEX:
- case TYPE_CODE_LITERAL_COMPLEX:
fprintf_filtered (stream, "complex*");
fprintf_filtered (stream, "%d", TYPE_LENGTH (type));
break;
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. */
(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". */
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:
}
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:
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);
}
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
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,
/* 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
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;
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 *
{"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
};
{"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
};
{"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
};
\f
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 */
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);
{"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
};
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;
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 */
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? */
oplen = 3;
break;
- case OP_F77_LITERAL_COMPLEX:
+ case OP_COMPLEX:
oplen = 1;
args = 2;
break;
oplen = 3;
break;
- case OP_F77_LITERAL_COMPLEX:
+ case OP_COMPLEX:
oplen = 1;
args = 2;
break;
projects / thirdparty / binutils-gdb.git / commitdiff
