1/* Support for printing Fortran types for GDB, the GNU debugger. 2 3 Copyright 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, 4 2000, 2001, 2002, 2003 Free Software Foundation, Inc. 5 6 Contributed by Motorola. Adapted from the C version by Farooq Butt 7 (fmbutt@engage.sps.mot.com). 8 9 This file is part of GDB. 10 11 This program is free software; you can redistribute it and/or modify 12 it under the terms of the GNU General Public License as published by 13 the Free Software Foundation; either version 2 of the License, or 14 (at your option) any later version. 15 16 This program is distributed in the hope that it will be useful, 17 but WITHOUT ANY WARRANTY; without even the implied warranty of 18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 GNU General Public License for more details. 20 21 You should have received a copy of the GNU General Public License 22 along with this program; if not, write to the Free Software 23 Foundation, Inc., 59 Temple Place - Suite 330, 24 Boston, MA 02111-1307, USA. */ 25 26#include "defs.h" 27#include "gdb_obstack.h" 28#include "bfd.h" 29#include "symtab.h" 30#include "gdbtypes.h" 31#include "expression.h" 32#include "value.h" 33#include "gdbcore.h" 34#include "target.h" 35#include "f-lang.h" 36 37#include "gdb_string.h" 38#include <errno.h> 39 40#if 0 /* Currently unused */ 41static void f_type_print_args (struct type *, struct ui_file *); 42#endif 43 44static void print_equivalent_f77_float_type (struct type *, 45 struct ui_file *); 46 47static void f_type_print_varspec_suffix (struct type *, struct ui_file *, 48 int, int, int); 49 50void f_type_print_varspec_prefix (struct type *, struct ui_file *, 51 int, int); 52 53void f_type_print_base (struct type *, struct ui_file *, int, int); 54 55 56/* LEVEL is the depth to indent lines by. */ 57 58void 59f_print_type (struct type *type, char *varstring, struct ui_file *stream, 60 int show, int level) 61{ 62 enum type_code code; 63 int demangled_args; 64 65 f_type_print_base (type, stream, show, level); 66 code = TYPE_CODE (type); 67 if ((varstring != NULL && *varstring != '\0') 68 || 69 /* Need a space if going to print stars or brackets; 70 but not if we will print just a type name. */ 71 ((show > 0 || TYPE_NAME (type) == 0) 72 && 73 (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC 74 || code == TYPE_CODE_METHOD 75 || code == TYPE_CODE_ARRAY 76 || code == TYPE_CODE_MEMBER 77 || code == TYPE_CODE_REF))) 78 fputs_filtered (" ", stream); 79 f_type_print_varspec_prefix (type, stream, show, 0); 80 81 fputs_filtered (varstring, stream); 82 83 /* For demangled function names, we have the arglist as part of the name, 84 so don't print an additional pair of ()'s */ 85 86 demangled_args = varstring[strlen (varstring) - 1] == ')'; 87 f_type_print_varspec_suffix (type, stream, show, 0, demangled_args); 88} 89 90/* Print any asterisks or open-parentheses needed before the 91 variable name (to describe its type). 92 93 On outermost call, pass 0 for PASSED_A_PTR. 94 On outermost call, SHOW > 0 means should ignore 95 any typename for TYPE and show its details. 96 SHOW is always zero on recursive calls. */ 97 98void 99f_type_print_varspec_prefix (struct type *type, struct ui_file *stream, 100 int show, int passed_a_ptr) 101{ 102 if (type == 0) 103 return; 104 105 if (TYPE_NAME (type) && show <= 0) 106 return; 107 108 QUIT; 109 110 switch (TYPE_CODE (type)) 111 { 112 case TYPE_CODE_PTR: 113 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1); 114 break; 115 116 case TYPE_CODE_FUNC: 117 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); 118 if (passed_a_ptr) 119 fprintf_filtered (stream, "("); 120 break; 121 122 case TYPE_CODE_ARRAY: 123 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); 124 break; 125 126 case TYPE_CODE_UNDEF: 127 case TYPE_CODE_STRUCT: 128 case TYPE_CODE_UNION: 129 case TYPE_CODE_ENUM: 130 case TYPE_CODE_INT: 131 case TYPE_CODE_FLT: 132 case TYPE_CODE_VOID: 133 case TYPE_CODE_ERROR: 134 case TYPE_CODE_CHAR: 135 case TYPE_CODE_BOOL: 136 case TYPE_CODE_SET: 137 case TYPE_CODE_RANGE: 138 case TYPE_CODE_STRING: 139 case TYPE_CODE_BITSTRING: 140 case TYPE_CODE_METHOD: 141 case TYPE_CODE_MEMBER: 142 case TYPE_CODE_REF: 143 case TYPE_CODE_COMPLEX: 144 case TYPE_CODE_TYPEDEF: 145 /* These types need no prefix. They are listed here so that 146 gcc -Wall will reveal any types that haven't been handled. */ 147 break; 148 } 149} 150 151/* Print any array sizes, function arguments or close parentheses 152 needed after the variable name (to describe its type). 153 Args work like c_type_print_varspec_prefix. */ 154 155static void 156f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, 157 int show, int passed_a_ptr, int demangled_args) 158{ 159 int upper_bound, lower_bound; 160 int lower_bound_was_default = 0; 161 static int arrayprint_recurse_level = 0; 162 int retcode; 163 164 if (type == 0) 165 return; 166 167 if (TYPE_NAME (type) && show <= 0) 168 return; 169 170 QUIT; 171 172 switch (TYPE_CODE (type)) 173 { 174 case TYPE_CODE_ARRAY: 175 arrayprint_recurse_level++; 176 177 if (arrayprint_recurse_level == 1) 178 fprintf_filtered (stream, "("); 179 180 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) 181 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); 182 183 retcode = f77_get_dynamic_lowerbound (type, &lower_bound); 184 185 lower_bound_was_default = 0; 186 187 if (retcode == BOUND_FETCH_ERROR) 188 fprintf_filtered (stream, "???"); 189 else if (lower_bound == 1) /* The default */ 190 lower_bound_was_default = 1; 191 else 192 fprintf_filtered (stream, "%d", lower_bound); 193 194 if (lower_bound_was_default) 195 lower_bound_was_default = 0; 196 else 197 fprintf_filtered (stream, ":"); 198 199 /* Make sure that, if we have an assumed size array, we 200 print out a warning and print the upperbound as '*' */ 201 202 if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) 203 fprintf_filtered (stream, "*"); 204 else 205 { 206 retcode = f77_get_dynamic_upperbound (type, &upper_bound); 207 208 if (retcode == BOUND_FETCH_ERROR) 209 fprintf_filtered (stream, "???"); 210 else 211 fprintf_filtered (stream, "%d", upper_bound); 212 } 213 214 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) 215 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); 216 if (arrayprint_recurse_level == 1) 217 fprintf_filtered (stream, ")"); 218 else 219 fprintf_filtered (stream, ","); 220 arrayprint_recurse_level--; 221 break; 222 223 case TYPE_CODE_PTR: 224 case TYPE_CODE_REF: 225 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0); 226 fprintf_filtered (stream, ")"); 227 break; 228 229 case TYPE_CODE_FUNC: 230 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 231 passed_a_ptr, 0); 232 if (passed_a_ptr) 233 fprintf_filtered (stream, ")"); 234 235 fprintf_filtered (stream, "()"); 236 break; 237 238 case TYPE_CODE_UNDEF: 239 case TYPE_CODE_STRUCT: 240 case TYPE_CODE_UNION: 241 case TYPE_CODE_ENUM: 242 case TYPE_CODE_INT: 243 case TYPE_CODE_FLT: 244 case TYPE_CODE_VOID: 245 case TYPE_CODE_ERROR: 246 case TYPE_CODE_CHAR: 247 case TYPE_CODE_BOOL: 248 case TYPE_CODE_SET: 249 case TYPE_CODE_RANGE: 250 case TYPE_CODE_STRING: 251 case TYPE_CODE_BITSTRING: 252 case TYPE_CODE_METHOD: 253 case TYPE_CODE_MEMBER: 254 case TYPE_CODE_COMPLEX: 255 case TYPE_CODE_TYPEDEF: 256 /* These types do not need a suffix. They are listed so that 257 gcc -Wall will report types that may not have been considered. */ 258 break; 259 } 260} 261 262static void 263print_equivalent_f77_float_type (struct type *type, struct ui_file *stream) 264{ 265 /* Override type name "float" and make it the 266 appropriate real. XLC stupidly outputs -12 as a type 267 for real when it really should be outputting -18 */ 268 269 fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type)); 270} 271 272/* Print the name of the type (or the ultimate pointer target, 273 function value or array element), or the description of a 274 structure or union. 275 276 SHOW nonzero means don't print this type as just its name; 277 show its real definition even if it has a name. 278 SHOW zero means print just typename or struct tag if there is one 279 SHOW negative means abbreviate structure elements. 280 SHOW is decremented for printing of structure elements. 281 282 LEVEL is the depth to indent by. 283 We increase it for some recursive calls. */ 284 285void 286f_type_print_base (struct type *type, struct ui_file *stream, int show, 287 int level) 288{ 289 int retcode; 290 int upper_bound; 291 292 QUIT; 293 294 wrap_here (" "); 295 if (type == NULL) 296 { 297 fputs_filtered ("<type unknown>", stream); 298 return; 299 } 300 301 /* When SHOW is zero or less, and there is a valid type name, then always 302 just print the type name directly from the type. */ 303 304 if ((show <= 0) && (TYPE_NAME (type) != NULL)) 305 { 306 if (TYPE_CODE (type) == TYPE_CODE_FLT) 307 print_equivalent_f77_float_type (type, stream); 308 else 309 fputs_filtered (TYPE_NAME (type), stream); 310 return; 311 } 312 313 if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF) 314 CHECK_TYPEDEF (type); 315 316 switch (TYPE_CODE (type)) 317 { 318 case TYPE_CODE_TYPEDEF: 319 f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level); 320 break; 321 322 case TYPE_CODE_ARRAY: 323 case TYPE_CODE_FUNC: 324 f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); 325 break; 326 327 case TYPE_CODE_PTR: 328 fprintf_filtered (stream, "PTR TO -> ( "); 329 f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level); 330 break; 331 332 case TYPE_CODE_REF: 333 fprintf_filtered (stream, "REF TO -> ( "); 334 f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level); 335 break; 336 337 case TYPE_CODE_VOID: 338 fprintf_filtered (stream, "VOID"); 339 break; 340 341 case TYPE_CODE_UNDEF: 342 fprintf_filtered (stream, "struct <unknown>"); 343 break; 344 345 case TYPE_CODE_ERROR: 346 fprintf_filtered (stream, "<unknown type>"); 347 break; 348 349 case TYPE_CODE_RANGE: 350 /* This should not occur */ 351 fprintf_filtered (stream, "<range type>"); 352 break; 353 354 case TYPE_CODE_CHAR: 355 /* Override name "char" and make it "character" */ 356 fprintf_filtered (stream, "character"); 357 break; 358 359 case TYPE_CODE_INT: 360 /* There may be some character types that attempt to come 361 through as TYPE_CODE_INT since dbxstclass.h is so 362 C-oriented, we must change these to "character" from "char". */ 363 364 if (strcmp (TYPE_NAME (type), "char") == 0) 365 fprintf_filtered (stream, "character"); 366 else 367 goto default_case; 368 break; 369 370 case TYPE_CODE_COMPLEX: 371 fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type)); 372 break; 373 374 case TYPE_CODE_FLT: 375 print_equivalent_f77_float_type (type, stream); 376 break; 377 378 case TYPE_CODE_STRING: 379 /* Strings may have dynamic upperbounds (lengths) like arrays. */ 380 381 if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) 382 fprintf_filtered (stream, "character*(*)"); 383 else 384 { 385 retcode = f77_get_dynamic_upperbound (type, &upper_bound); 386 387 if (retcode == BOUND_FETCH_ERROR) 388 fprintf_filtered (stream, "character*???"); 389 else 390 fprintf_filtered (stream, "character*%d", upper_bound); 391 } 392 break; 393 394 default_case: 395 default: 396 /* Handle types not explicitly handled by the other cases, 397 such as fundamental types. For these, just print whatever 398 the type name is, as recorded in the type itself. If there 399 is no type name, then complain. */ 400 if (TYPE_NAME (type) != NULL) 401 fputs_filtered (TYPE_NAME (type), stream); 402 else 403 error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type)); 404 break; 405 } 406} 407