gdb/f-typeprint.c

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