1 /* Support for printing Fortran types for GDB, the GNU debugger.
2 Copyright 1986, 1988, 1989, 1991, 1993, 1994 Free Software Foundation, Inc.
3 Contributed by Motorola. Adapted from the C version by Farooq Butt
4 (fmbutt@engage.sps.mot.com).
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
27 #include "expression.h"
36 #include "typeprint.h"
37 #include "frame.h" /* ??? */
39 #include "gdb_string.h"
42 #if 0 /* Currently unused */
43 static void f_type_print_args
PARAMS ((struct type
*, FILE *));
46 static void f_type_print_varspec_suffix
PARAMS ((struct type
*, FILE *,
49 void f_type_print_varspec_prefix
PARAMS ((struct type
*, FILE *, int, int));
51 void f_type_print_base
PARAMS ((struct type
*, FILE *, int, int));
54 /* LEVEL is the depth to indent lines by. */
57 f_print_type (type
, varstring
, stream
, show
, level
)
64 register enum type_code code
;
67 f_type_print_base (type
, stream
, show
, level
);
68 code
= TYPE_CODE (type
);
69 if ((varstring
!= NULL
&& *varstring
!= '\0')
71 /* Need a space if going to print stars or brackets;
72 but not if we will print just a type name. */
73 ((show
> 0 || TYPE_NAME (type
) == 0)
75 (code
== TYPE_CODE_PTR
|| code
== TYPE_CODE_FUNC
76 || code
== TYPE_CODE_METHOD
77 || code
== TYPE_CODE_ARRAY
78 || code
== TYPE_CODE_MEMBER
79 || code
== TYPE_CODE_REF
)))
80 fputs_filtered (" ", stream
);
81 f_type_print_varspec_prefix (type
, stream
, show
, 0);
83 fputs_filtered (varstring
, stream
);
85 /* For demangled function names, we have the arglist as part of the name,
86 so don't print an additional pair of ()'s */
88 demangled_args
= varstring
[strlen(varstring
) - 1] == ')';
89 f_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
);
92 /* Print any asterisks or open-parentheses needed before the
93 variable name (to describe its type).
95 On outermost call, pass 0 for PASSED_A_PTR.
96 On outermost call, SHOW > 0 means should ignore
97 any typename for TYPE and show its details.
98 SHOW is always zero on recursive calls. */
101 f_type_print_varspec_prefix (type
, stream
, show
, passed_a_ptr
)
110 if (TYPE_NAME (type
) && show
<= 0)
115 switch (TYPE_CODE (type
))
118 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
122 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
124 fprintf_filtered (stream
, "(");
127 case TYPE_CODE_ARRAY
:
128 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
131 case TYPE_CODE_UNDEF
:
132 case TYPE_CODE_STRUCT
:
133 case TYPE_CODE_UNION
:
138 case TYPE_CODE_ERROR
:
142 case TYPE_CODE_RANGE
:
143 case TYPE_CODE_STRING
:
144 case TYPE_CODE_BITSTRING
:
145 case TYPE_CODE_METHOD
:
146 case TYPE_CODE_MEMBER
:
148 case TYPE_CODE_COMPLEX
:
149 case TYPE_CODE_TYPEDEF
:
150 /* These types need no prefix. They are listed here so that
151 gcc -Wall will reveal any types that haven't been handled. */
156 #if 0 /* Currently unused */
159 f_type_print_args (type
, stream
)
166 fprintf_filtered (stream
, "(");
167 args
= TYPE_ARG_TYPES (type
);
172 fprintf_filtered (stream
, "...");
176 for (i
= 1; args
[i
] != NULL
&& args
[i
]->code
!= TYPE_CODE_VOID
; i
++)
178 f_print_type (args
[i
], "", stream
, -1, 0);
179 if (args
[i
+1] == NULL
)
180 fprintf_filtered (stream
, "...");
181 else if (args
[i
+1]->code
!= TYPE_CODE_VOID
)
183 fprintf_filtered (stream
, ",");
189 fprintf_filtered (stream
, ")");
194 /* Print any array sizes, function arguments or close parentheses
195 needed after the variable name (to describe its type).
196 Args work like c_type_print_varspec_prefix. */
199 f_type_print_varspec_suffix (type
, stream
, show
, passed_a_ptr
, demangled_args
)
206 int upper_bound
, lower_bound
;
207 int lower_bound_was_default
= 0;
208 static int arrayprint_recurse_level
= 0;
214 if (TYPE_NAME (type
) && show
<= 0)
219 switch (TYPE_CODE (type
))
221 case TYPE_CODE_ARRAY
:
222 arrayprint_recurse_level
++;
224 if (arrayprint_recurse_level
== 1)
225 fprintf_filtered(stream
,"(");
227 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_ARRAY
)
228 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 0, 0);
230 retcode
= f77_get_dynamic_lowerbound (type
,&lower_bound
);
232 lower_bound_was_default
= 0;
234 if (retcode
== BOUND_FETCH_ERROR
)
235 fprintf_filtered (stream
,"???");
237 if (lower_bound
== 1) /* The default */
238 lower_bound_was_default
= 1;
240 fprintf_filtered (stream
,"%d",lower_bound
);
242 if (lower_bound_was_default
)
243 lower_bound_was_default
= 0;
245 fprintf_filtered(stream
,":");
247 /* Make sure that, if we have an assumed size array, we
248 print out a warning and print the upperbound as '*' */
250 if (TYPE_ARRAY_UPPER_BOUND_TYPE(type
) == BOUND_CANNOT_BE_DETERMINED
)
251 fprintf_filtered (stream
, "*");
254 retcode
= f77_get_dynamic_upperbound(type
,&upper_bound
);
256 if (retcode
== BOUND_FETCH_ERROR
)
257 fprintf_filtered(stream
,"???");
259 fprintf_filtered(stream
,"%d",upper_bound
);
262 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_ARRAY
)
263 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 0, 0);
264 if (arrayprint_recurse_level
== 1)
265 fprintf_filtered (stream
, ")");
267 fprintf_filtered(stream
,",");
268 arrayprint_recurse_level
--;
273 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0);
274 fprintf_filtered(stream
,")");
278 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
281 fprintf_filtered (stream
, ")");
283 fprintf_filtered (stream
, "()");
286 case TYPE_CODE_UNDEF
:
287 case TYPE_CODE_STRUCT
:
288 case TYPE_CODE_UNION
:
293 case TYPE_CODE_ERROR
:
297 case TYPE_CODE_RANGE
:
298 case TYPE_CODE_STRING
:
299 case TYPE_CODE_BITSTRING
:
300 case TYPE_CODE_METHOD
:
301 case TYPE_CODE_MEMBER
:
302 case TYPE_CODE_COMPLEX
:
303 case TYPE_CODE_TYPEDEF
:
304 /* These types do not need a suffix. They are listed so that
305 gcc -Wall will report types that may not have been considered. */
311 print_equivalent_f77_float_type (type
, stream
)
315 /* Override type name "float" and make it the
316 appropriate real. XLC stupidly outputs -12 as a type
317 for real when it really should be outputting -18 */
319 fprintf_filtered (stream
, "real*%d", TYPE_LENGTH (type
));
322 /* Print the name of the type (or the ultimate pointer target,
323 function value or array element), or the description of a
326 SHOW nonzero means don't print this type as just its name;
327 show its real definition even if it has a name.
328 SHOW zero means print just typename or struct tag if there is one
329 SHOW negative means abbreviate structure elements.
330 SHOW is decremented for printing of structure elements.
332 LEVEL is the depth to indent by.
333 We increase it for some recursive calls. */
336 f_type_print_base (type
, stream
, show
, level
)
350 fputs_filtered ("<type unknown>", stream
);
354 /* When SHOW is zero or less, and there is a valid type name, then always
355 just print the type name directly from the type. */
357 if ((show
<= 0) && (TYPE_NAME (type
) != NULL
))
359 if (TYPE_CODE (type
) == TYPE_CODE_FLT
)
360 print_equivalent_f77_float_type (type
, stream
);
362 fputs_filtered (TYPE_NAME (type
), stream
);
366 if (TYPE_CODE (type
) != TYPE_CODE_TYPEDEF
)
367 CHECK_TYPEDEF (type
);
369 switch (TYPE_CODE (type
))
371 case TYPE_CODE_TYPEDEF
:
372 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, 0, level
);
375 case TYPE_CODE_ARRAY
:
377 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
381 fprintf_filtered (stream
, "PTR TO -> ( ");
382 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, 0, level
);
386 fprintf_filtered (stream
, "VOID");
389 case TYPE_CODE_UNDEF
:
390 fprintf_filtered (stream
, "struct <unknown>");
393 case TYPE_CODE_ERROR
:
394 fprintf_filtered (stream
, "<unknown type>");
397 case TYPE_CODE_RANGE
:
398 /* This should not occur */
399 fprintf_filtered (stream
, "<range type>");
403 /* Override name "char" and make it "character" */
404 fprintf_filtered (stream
, "character");
408 /* There may be some character types that attempt to come
409 through as TYPE_CODE_INT since dbxstclass.h is so
410 C-oriented, we must change these to "character" from "char". */
412 if (STREQ (TYPE_NAME (type
), "char"))
413 fprintf_filtered (stream
, "character");
418 case TYPE_CODE_COMPLEX
:
419 fprintf_filtered (stream
, "complex*%d", TYPE_LENGTH (type
));
423 print_equivalent_f77_float_type (type
, stream
);
426 case TYPE_CODE_STRING
:
427 /* Strings may have dynamic upperbounds (lengths) like arrays. */
429 if (TYPE_ARRAY_UPPER_BOUND_TYPE (type
) == BOUND_CANNOT_BE_DETERMINED
)
430 fprintf_filtered (stream
, "character*(*)");
433 retcode
= f77_get_dynamic_upperbound (type
, &upper_bound
);
435 if (retcode
== BOUND_FETCH_ERROR
)
436 fprintf_filtered (stream
, "character*???");
438 fprintf_filtered (stream
, "character*%d", upper_bound
);
444 /* Handle types not explicitly handled by the other cases,
445 such as fundamental types. For these, just print whatever
446 the type name is, as recorded in the type itself. If there
447 is no type name, then complain. */
448 if (TYPE_NAME (type
) != NULL
)
449 fputs_filtered (TYPE_NAME (type
), stream
);
451 error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type
));