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