gdb/f-typeprint.c

   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).
   5
   6 This file is part of GDB.
   7
   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.
  12
  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.
  17
  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.  */
  21
  22 #include "defs.h"
  23 #include "obstack.h"
  24 #include "bfd.h"
  25 #include "symtab.h"
  26 #include "gdbtypes.h"
  27 #include "expression.h"
  28 #include "value.h"
  29 #include "gdbcore.h"
  30 #include "target.h"
  31 #include "command.h"
  32 #include "gdbcmd.h"
  33 #include "language.h"
  34 #include "demangle.h"
  35 #include "f-lang.h"
  36 #include "typeprint.h"
  37 #include "frame.h"  /* ??? */
  38
  39 #include "gdb_string.h"
  40 #include <errno.h>
  41
  42 #if 0   /* Currently unused */
  43 static void f_type_print_args PARAMS ((struct type *, FILE *));
  44 #endif
  45
  46 static void f_type_print_varspec_suffix PARAMS ((struct type *, FILE *,
  47                                                  int, int, int));
  48
  49 void f_type_print_varspec_prefix PARAMS ((struct type *, FILE *, int, int));
  50
  51 void f_type_print_base PARAMS ((struct type *, FILE *, int, int));
  52
  53 \f
  54 /* LEVEL is the depth to indent lines by.  */
  55
  56 void
  57 f_print_type (type, varstring, stream, show, level)
  58      struct type *type;
  59      char *varstring;
  60      FILE *stream;
  61      int show;
  62      int level;
  63 {
  64   register enum type_code code;
  65   int demangled_args;
  66
  67   f_type_print_base (type, stream, show, level);
  68   code = TYPE_CODE (type);
  69   if ((varstring != NULL && *varstring != '\0')
  70       ||
  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)
  74        &&
  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);
  82
  83   fputs_filtered (varstring, stream);
  84
  85   /* For demangled function names, we have the arglist as part of the name,
  86      so don't print an additional pair of ()'s */
  87
  88   demangled_args = varstring[strlen(varstring) - 1] == ')';
  89   f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
  90 }
  91
  92 /* Print any asterisks or open-parentheses needed before the
  93    variable name (to describe its type).
  94
  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.  */
  99
 100 void
 101 f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
 102      struct type *type;
 103      FILE *stream;
 104      int show;
 105      int passed_a_ptr;
 106 {
 107   if (type == 0)
 108     return;
 109
 110   if (TYPE_NAME (type) && show <= 0)
 111     return;
 112
 113   QUIT;
 114
 115   switch (TYPE_CODE (type))
 116     {
 117     case TYPE_CODE_PTR:
 118       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 119       break;
 120
 121     case TYPE_CODE_FUNC:
 122       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 123       if (passed_a_ptr)
 124         fprintf_filtered (stream, "(");
 125       break;
 126
 127     case TYPE_CODE_ARRAY:
 128       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 129       break;
 130
 131     case TYPE_CODE_UNDEF:
 132     case TYPE_CODE_STRUCT:
 133     case TYPE_CODE_UNION:
 134     case TYPE_CODE_ENUM:
 135     case TYPE_CODE_INT:
 136     case TYPE_CODE_FLT:
 137     case TYPE_CODE_VOID:
 138     case TYPE_CODE_ERROR:
 139     case TYPE_CODE_CHAR:
 140     case TYPE_CODE_BOOL:
 141     case TYPE_CODE_SET:
 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:
 147     case TYPE_CODE_REF:
 148     case TYPE_CODE_COMPLEX:
 149       /* These types need no prefix.  They are listed here so that
 150          gcc -Wall will reveal any types that haven't been handled.  */
 151       break;
 152     }
 153 }
 154
 155 #if 0   /* Currently unused */
 156
 157 static void
 158 f_type_print_args (type, stream)
 159      struct type *type;
 160      FILE *stream;
 161 {
 162   int i;
 163   struct type **args;
 164
 165   fprintf_filtered (stream, "(");
 166   args = TYPE_ARG_TYPES (type);
 167   if (args != NULL)
 168     {
 169       if (args[1] == NULL)
 170         {
 171           fprintf_filtered (stream, "...");
 172         }
 173       else
 174         {
 175           for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++)
 176             {
 177               f_print_type (args[i], "", stream, -1, 0);
 178               if (args[i+1] == NULL)
 179                 fprintf_filtered (stream, "...");
 180               else if (args[i+1]->code != TYPE_CODE_VOID)
 181                 {
 182                   fprintf_filtered (stream, ",");
 183                   wrap_here ("    ");
 184                 }
 185             }
 186         }
 187     }
 188   fprintf_filtered (stream, ")");
 189 }
 190
 191 #endif  /* 0 */
 192
 193 /* Print any array sizes, function arguments or close parentheses
 194    needed after the variable name (to describe its type).
 195    Args work like c_type_print_varspec_prefix.  */
 196
 197 static void
 198 f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
 199      struct type *type;
 200      FILE *stream;
 201      int show;
 202      int passed_a_ptr;
 203      int demangled_args;
 204 {
 205   int upper_bound, lower_bound;
 206   int lower_bound_was_default = 0;
 207   static int arrayprint_recurse_level = 0;
 208   int retcode;
 209
 210   if (type == 0)
 211     return;
 212
 213   if (TYPE_NAME (type) && show <= 0)
 214     return;
 215
 216   QUIT;
 217
 218   switch (TYPE_CODE (type))
 219     {
 220     case TYPE_CODE_ARRAY:
 221       arrayprint_recurse_level++;
 222
 223       if (arrayprint_recurse_level == 1)
 224         fprintf_filtered(stream,"(");
 225
 226       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
 227         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 228
 229       retcode = f77_get_dynamic_lowerbound (type,&lower_bound);
 230
 231       lower_bound_was_default = 0;
 232
 233       if (retcode == BOUND_FETCH_ERROR)
 234         fprintf_filtered (stream,"???");
 235       else
 236         if (lower_bound == 1) /* The default */
 237           lower_bound_was_default = 1;
 238         else
 239           fprintf_filtered (stream,"%d",lower_bound);
 240
 241       if (lower_bound_was_default)
 242         lower_bound_was_default = 0;
 243       else
 244         fprintf_filtered(stream,":");
 245
 246       /* Make sure that, if we have an assumed size array, we
 247          print out a warning and print the upperbound as '*' */
 248
 249       if (TYPE_ARRAY_UPPER_BOUND_TYPE(type) == BOUND_CANNOT_BE_DETERMINED)
 250         fprintf_filtered (stream, "*");
 251        else
 252          {
 253            retcode = f77_get_dynamic_upperbound(type,&upper_bound);
 254
 255            if (retcode == BOUND_FETCH_ERROR)
 256              fprintf_filtered(stream,"???");
 257            else
 258              fprintf_filtered(stream,"%d",upper_bound);
 259          }
 260
 261       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
 262         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 263       if (arrayprint_recurse_level == 1)
 264         fprintf_filtered (stream, ")");
 265       else
 266         fprintf_filtered(stream,",");
 267       arrayprint_recurse_level--;
 268       break;
 269
 270     case TYPE_CODE_PTR:
 271     case TYPE_CODE_REF:
 272       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
 273       fprintf_filtered(stream,")");
 274       break;
 275
 276     case TYPE_CODE_FUNC:
 277       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 278                                  passed_a_ptr, 0);
 279       if (passed_a_ptr)
 280         fprintf_filtered (stream, ")");
 281
 282       fprintf_filtered (stream, "()");
 283       break;
 284
 285     case TYPE_CODE_UNDEF:
 286     case TYPE_CODE_STRUCT:
 287     case TYPE_CODE_UNION:
 288     case TYPE_CODE_ENUM:
 289     case TYPE_CODE_INT:
 290     case TYPE_CODE_FLT:
 291     case TYPE_CODE_VOID:
 292     case TYPE_CODE_ERROR:
 293     case TYPE_CODE_CHAR:
 294     case TYPE_CODE_BOOL:
 295     case TYPE_CODE_SET:
 296     case TYPE_CODE_RANGE:
 297     case TYPE_CODE_STRING:
 298     case TYPE_CODE_BITSTRING:
 299     case TYPE_CODE_METHOD:
 300     case TYPE_CODE_MEMBER:
 301     case TYPE_CODE_COMPLEX:
 302       /* These types do not need a suffix.  They are listed so that
 303          gcc -Wall will report types that may not have been considered.  */
 304       break;
 305     }
 306 }
 307
 308 void
 309 print_equivalent_f77_float_type (type, stream)
 310      struct type *type;
 311      FILE *stream;
 312 {
 313   /* Override type name "float" and make it the
 314      appropriate real. XLC stupidly outputs -12 as a type
 315      for real when it really should be outputting -18 */
 316
 317   switch (TYPE_LENGTH (type))
 318     {
 319     case 4:
 320       fprintf_filtered (stream, "real*4");
 321       break;
 322
 323     case 8:
 324       fprintf_filtered(stream,"real*8");
 325       break;
 326     }
 327 }
 328
 329 /* Print the name of the type (or the ultimate pointer target,
 330    function value or array element), or the description of a
 331    structure or union.
 332
 333    SHOW nonzero means don't print this type as just its name;
 334    show its real definition even if it has a name.
 335    SHOW zero means print just typename or struct tag if there is one
 336    SHOW negative means abbreviate structure elements.
 337    SHOW is decremented for printing of structure elements.
 338
 339    LEVEL is the depth to indent by.
 340    We increase it for some recursive calls.  */
 341
 342 void
 343 f_type_print_base (type, stream, show, level)
 344      struct type *type;
 345      FILE *stream;
 346      int show;
 347      int level;
 348 {
 349   int retcode;
 350   int upper_bound;
 351
 352   QUIT;
 353
 354   wrap_here ("    ");
 355   if (type == NULL)
 356     {
 357       fputs_filtered ("<type unknown>", stream);
 358       return;
 359     }
 360
 361   /* When SHOW is zero or less, and there is a valid type name, then always
 362      just print the type name directly from the type. */
 363
 364   if ((show <= 0) && (TYPE_NAME (type) != NULL))
 365     {
 366       if (TYPE_CODE (type) == TYPE_CODE_FLT)
 367         print_equivalent_f77_float_type (type, stream);
 368       else
 369         fputs_filtered (TYPE_NAME (type), stream);
 370       return;
 371     }
 372
 373   switch (TYPE_CODE (type))
 374     {
 375     case TYPE_CODE_ARRAY:
 376       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 377       break;
 378
 379     case TYPE_CODE_FUNC:
 380       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 381       break;
 382
 383    case TYPE_CODE_PTR:
 384       fprintf_filtered (stream, "PTR TO -> ( ");
 385       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 386       break;
 387
 388     case TYPE_CODE_VOID:
 389       fprintf_filtered (stream, "VOID");
 390       break;
 391
 392     case TYPE_CODE_UNDEF:
 393       fprintf_filtered (stream, "struct <unknown>");
 394       break;
 395
 396     case TYPE_CODE_ERROR:
 397       fprintf_filtered (stream, "<unknown type>");
 398       break;
 399
 400     case TYPE_CODE_RANGE:
 401       /* This should not occur */
 402       fprintf_filtered (stream, "<range type>");
 403       break;
 404
 405     case TYPE_CODE_CHAR:
 406       /* Override name "char" and make it "character" */
 407       fprintf_filtered (stream, "character");
 408       break;
 409
 410     case TYPE_CODE_INT:
 411       /* There may be some character types that attempt to come
 412          through as TYPE_CODE_INT since dbxstclass.h is so
 413          C-oriented, we must change these to "character" from "char".  */
 414
 415       if (STREQ (TYPE_NAME (type), "char"))
 416         fprintf_filtered (stream, "character");
 417       else
 418         goto default_case;
 419       break;
 420
 421     case TYPE_CODE_COMPLEX:
 422       fprintf_filtered (stream, "complex*");
 423       fprintf_filtered (stream, "%d", TYPE_LENGTH (type));
 424       break;
 425
 426     case TYPE_CODE_FLT:
 427       print_equivalent_f77_float_type (type, stream);
 428       break;
 429
 430     case TYPE_CODE_STRING:
 431       /* Strings may have dynamic upperbounds (lengths) like arrays. */
 432
 433       if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
 434         fprintf_filtered (stream, "character*(*)");
 435       else
 436         {
 437           retcode = f77_get_dynamic_upperbound (type, &upper_bound);
 438
 439           if (retcode == BOUND_FETCH_ERROR)
 440             fprintf_filtered (stream, "character*???");
 441           else
 442             fprintf_filtered (stream, "character*%d", upper_bound);
 443         }
 444       break;
 445
 446     default_case:
 447     default:
 448       /* Handle types not explicitly handled by the other cases,
 449          such as fundamental types.  For these, just print whatever
 450          the type name is, as recorded in the type itself.  If there
 451          is no type name, then complain. */
 452       if (TYPE_NAME (type) != NULL)
 453         fputs_filtered (TYPE_NAME (type), stream);
 454       else
 455         error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type));
 456       break;
 457     }
 458 }