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    ([email protected]).
   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   fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type));
 318 }
 319
 320 /* Print the name of the type (or the ultimate pointer target,
 321    function value or array element), or the description of a
 322    structure or union.
 323
 324    SHOW nonzero means don't print this type as just its name;
 325    show its real definition even if it has a name.
 326    SHOW zero means print just typename or struct tag if there is one
 327    SHOW negative means abbreviate structure elements.
 328    SHOW is decremented for printing of structure elements.
 329
 330    LEVEL is the depth to indent by.
 331    We increase it for some recursive calls.  */
 332
 333 void
 334 f_type_print_base (type, stream, show, level)
 335      struct type *type;
 336      FILE *stream;
 337      int show;
 338      int level;
 339 {
 340   int retcode;
 341   int upper_bound;
 342
 343   QUIT;
 344
 345   wrap_here ("    ");
 346   if (type == NULL)
 347     {
 348       fputs_filtered ("<type unknown>", stream);
 349       return;
 350     }
 351
 352   /* When SHOW is zero or less, and there is a valid type name, then always
 353      just print the type name directly from the type. */
 354
 355   if ((show <= 0) && (TYPE_NAME (type) != NULL))
 356     {
 357       if (TYPE_CODE (type) == TYPE_CODE_FLT)
 358         print_equivalent_f77_float_type (type, stream);
 359       else
 360         fputs_filtered (TYPE_NAME (type), stream);
 361       return;
 362     }
 363
 364   if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
 365     CHECK_TYPEDEF (type);
 366
 367   switch (TYPE_CODE (type))
 368     {
 369     case TYPE_CODE_TYPEDEF:
 370       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
 371       break;
 372
 373     case TYPE_CODE_ARRAY:
 374     case TYPE_CODE_FUNC:
 375       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 376       break;
 377
 378    case TYPE_CODE_PTR:
 379       fprintf_filtered (stream, "PTR TO -> ( ");
 380       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
 381       break;
 382
 383     case TYPE_CODE_VOID:
 384       fprintf_filtered (stream, "VOID");
 385       break;
 386
 387     case TYPE_CODE_UNDEF:
 388       fprintf_filtered (stream, "struct <unknown>");
 389       break;
 390
 391     case TYPE_CODE_ERROR:
 392       fprintf_filtered (stream, "<unknown type>");
 393       break;
 394
 395     case TYPE_CODE_RANGE:
 396       /* This should not occur */
 397       fprintf_filtered (stream, "<range type>");
 398       break;
 399
 400     case TYPE_CODE_CHAR:
 401       /* Override name "char" and make it "character" */
 402       fprintf_filtered (stream, "character");
 403       break;
 404
 405     case TYPE_CODE_INT:
 406       /* There may be some character types that attempt to come
 407          through as TYPE_CODE_INT since dbxstclass.h is so
 408          C-oriented, we must change these to "character" from "char".  */
 409
 410       if (STREQ (TYPE_NAME (type), "char"))
 411         fprintf_filtered (stream, "character");
 412       else
 413         goto default_case;
 414       break;
 415
 416     case TYPE_CODE_COMPLEX:
 417       fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type));
 418       break;
 419
 420     case TYPE_CODE_FLT:
 421       print_equivalent_f77_float_type (type, stream);
 422       break;
 423
 424     case TYPE_CODE_STRING:
 425       /* Strings may have dynamic upperbounds (lengths) like arrays. */
 426
 427       if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
 428         fprintf_filtered (stream, "character*(*)");
 429       else
 430         {
 431           retcode = f77_get_dynamic_upperbound (type, &upper_bound);
 432
 433           if (retcode == BOUND_FETCH_ERROR)
 434             fprintf_filtered (stream, "character*???");
 435           else
 436             fprintf_filtered (stream, "character*%d", upper_bound);
 437         }
 438       break;
 439
 440     default_case:
 441     default:
 442       /* Handle types not explicitly handled by the other cases,
 443          such as fundamental types.  For these, just print whatever
 444          the type name is, as recorded in the type itself.  If there
 445          is no type name, then complain. */
 446       if (TYPE_NAME (type) != NULL)
 447         fputs_filtered (TYPE_NAME (type), stream);
 448       else
 449         error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type));
 450       break;
 451     }
 452 }