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., 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   if (type == 0)
 106     return;
 107
 108   if (TYPE_NAME (type) && show <= 0)
 109     return;
 110
 111   QUIT;
 112
 113   switch (TYPE_CODE (type))
 114     {
 115     case TYPE_CODE_PTR:
 116       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 117       break;
 118
 119     case TYPE_CODE_FUNC:
 120       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 121       if (passed_a_ptr)
 122         fprintf_filtered (stream, "(");
 123       break;
 124
 125     case TYPE_CODE_ARRAY:
 126       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 127       break;
 128
 129     case TYPE_CODE_UNDEF:
 130     case TYPE_CODE_STRUCT:
 131     case TYPE_CODE_UNION:
 132     case TYPE_CODE_ENUM:
 133     case TYPE_CODE_INT:
 134     case TYPE_CODE_FLT:
 135     case TYPE_CODE_VOID:
 136     case TYPE_CODE_ERROR:
 137     case TYPE_CODE_CHAR:
 138     case TYPE_CODE_BOOL:
 139     case TYPE_CODE_SET:
 140     case TYPE_CODE_RANGE:
 141     case TYPE_CODE_STRING:
 142     case TYPE_CODE_BITSTRING:
 143     case TYPE_CODE_METHOD:
 144     case TYPE_CODE_MEMBER:
 145     case TYPE_CODE_REF:
 146     case TYPE_CODE_COMPLEX:
 147     case TYPE_CODE_LITERAL_COMPLEX:
 148     case TYPE_CODE_LITERAL_STRING:
 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 static void
 156 f_type_print_args (type, stream)
 157      struct type *type;
 158      FILE *stream;
 159 {
 160   int i;
 161   struct type **args;
 162
 163   fprintf_filtered (stream, "(");
 164   args = TYPE_ARG_TYPES (type);
 165   if (args != NULL)
 166     {
 167       if (args[1] == NULL)
 168         {
 169           fprintf_filtered (stream, "...");
 170         }
 171       else
 172         {
 173           for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++)
 174             {
 175               f_print_type (args[i], "", stream, -1, 0);
 176               if (args[i+1] == NULL)
 177                 fprintf_filtered (stream, "...");
 178               else if (args[i+1]->code != TYPE_CODE_VOID)
 179                 {
 180                   fprintf_filtered (stream, ",");
 181                   wrap_here ("    ");
 182                 }
 183             }
 184         }
 185     }
 186   fprintf_filtered (stream, ")");
 187 }
 188
 189 /* Print any array sizes, function arguments or close parentheses
 190    needed after the variable name (to describe its type).
 191    Args work like c_type_print_varspec_prefix.  */
 192
 193 static void
 194 f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
 195      struct type *type;
 196      FILE *stream;
 197      int show;
 198      int passed_a_ptr;
 199      int demangled_args;
 200 {
 201   int upper_bound, lower_bound;
 202   int lower_bound_was_default = 0;
 203   static int arrayprint_recurse_level = 0;
 204   int retcode;
 205
 206   if (type == 0)
 207     return;
 208
 209   if (TYPE_NAME (type) && show <= 0)
 210     return;
 211
 212   QUIT;
 213
 214   switch (TYPE_CODE (type))
 215     {
 216     case TYPE_CODE_ARRAY:
 217       arrayprint_recurse_level++;
 218
 219       if (arrayprint_recurse_level == 1)
 220         fprintf_filtered(stream,"(");
 221       else
 222         fprintf_filtered(stream,",");
 223
 224       retcode = f77_get_dynamic_lowerbound (type,&lower_bound);
 225
 226       lower_bound_was_default = 0;
 227
 228       if (retcode == BOUND_FETCH_ERROR)
 229         fprintf_filtered (stream,"???");
 230       else
 231         if (lower_bound == 1) /* The default */
 232           lower_bound_was_default = 1;
 233         else
 234           fprintf_filtered (stream,"%d",lower_bound);
 235
 236       if (lower_bound_was_default)
 237         lower_bound_was_default = 0;
 238       else
 239         fprintf_filtered(stream,":");
 240
 241       /* Make sure that, if we have an assumed size array, we
 242          print out a warning and print the upperbound as '*' */
 243
 244       if (TYPE_ARRAY_UPPER_BOUND_TYPE(type) == BOUND_CANNOT_BE_DETERMINED)
 245         fprintf_filtered (stream, "*");
 246        else
 247          {
 248            retcode = f77_get_dynamic_upperbound(type,&upper_bound);
 249
 250            if (retcode == BOUND_FETCH_ERROR)
 251              fprintf_filtered(stream,"???");
 252            else
 253              fprintf_filtered(stream,"%d",upper_bound);
 254          }
 255
 256       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 257       if (arrayprint_recurse_level == 1)
 258         fprintf_filtered (stream, ")");
 259       arrayprint_recurse_level--;
 260       break;
 261
 262     case TYPE_CODE_PTR:
 263     case TYPE_CODE_REF:
 264       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
 265       fprintf_filtered(stream,")");
 266       break;
 267
 268     case TYPE_CODE_FUNC:
 269       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 270                                  passed_a_ptr, 0);
 271       if (passed_a_ptr)
 272         fprintf_filtered (stream, ")");
 273
 274       fprintf_filtered (stream, "()");
 275       break;
 276
 277     case TYPE_CODE_UNDEF:
 278     case TYPE_CODE_STRUCT:
 279     case TYPE_CODE_UNION:
 280     case TYPE_CODE_ENUM:
 281     case TYPE_CODE_INT:
 282     case TYPE_CODE_FLT:
 283     case TYPE_CODE_VOID:
 284     case TYPE_CODE_ERROR:
 285     case TYPE_CODE_CHAR:
 286     case TYPE_CODE_BOOL:
 287     case TYPE_CODE_SET:
 288     case TYPE_CODE_RANGE:
 289     case TYPE_CODE_STRING:
 290     case TYPE_CODE_BITSTRING:
 291     case TYPE_CODE_METHOD:
 292     case TYPE_CODE_MEMBER:
 293     case TYPE_CODE_COMPLEX:
 294     case TYPE_CODE_LITERAL_COMPLEX:
 295     case TYPE_CODE_LITERAL_STRING:
 296       /* These types do not need a suffix.  They are listed so that
 297          gcc -Wall will report types that may not have been considered.  */
 298       break;
 299     }
 300 }
 301
 302 void
 303 print_equivalent_f77_float_type (type, stream)
 304      struct type *type;
 305      FILE *stream;
 306 {
 307   /* Override type name "float" and make it the
 308      appropriate real. XLC stupidly outputs -12 as a type
 309      for real when it really should be outputting -18 */
 310
 311   switch (TYPE_LENGTH (type))
 312     {
 313     case 4:
 314       fprintf_filtered (stream, "real*4");
 315       break;
 316
 317     case 8:
 318       fprintf_filtered(stream,"real*8");
 319       break;
 320     }
 321 }
 322
 323 /* Print the name of the type (or the ultimate pointer target,
 324    function value or array element), or the description of a
 325    structure or union.
 326
 327    SHOW nonzero means don't print this type as just its name;
 328    show its real definition even if it has a name.
 329    SHOW zero means print just typename or struct tag if there is one
 330    SHOW negative means abbreviate structure elements.
 331    SHOW is decremented for printing of structure elements.
 332
 333    LEVEL is the depth to indent by.
 334    We increase it for some recursive calls.  */
 335
 336 void
 337 f_type_print_base (type, stream, show, level)
 338      struct type *type;
 339      FILE *stream;
 340      int show;
 341      int level;
 342 {
 343   int retcode;
 344   int upper_bound;
 345
 346   QUIT;
 347
 348   wrap_here ("    ");
 349   if (type == NULL)
 350     {
 351       fputs_filtered ("<type unknown>", stream);
 352       return;
 353     }
 354
 355   /* When SHOW is zero or less, and there is a valid type name, then always
 356      just print the type name directly from the type. */
 357
 358   if ((show <= 0) && (TYPE_NAME (type) != NULL))
 359     {
 360       if (TYPE_CODE (type) == TYPE_CODE_FLT)
 361         print_equivalent_f77_float_type (type, stream);
 362       else
 363         fputs_filtered (TYPE_NAME (type), stream);
 364       return;
 365     }
 366
 367   switch (TYPE_CODE (type))
 368     {
 369     case TYPE_CODE_ARRAY:
 370       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 371       break;
 372
 373     case TYPE_CODE_FUNC:
 374       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 375       break;
 376
 377    case TYPE_CODE_PTR:
 378       fprintf_filtered (stream, "PTR TO -> ( ");
 379       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 380       break;
 381
 382     case TYPE_CODE_VOID:
 383       fprintf_filtered (stream, "VOID");
 384       break;
 385
 386     case TYPE_CODE_UNDEF:
 387       fprintf_filtered (stream, "struct <unknown>");
 388       break;
 389
 390     case TYPE_CODE_ERROR:
 391       fprintf_filtered (stream, "<unknown type>");
 392       break;
 393
 394     case TYPE_CODE_RANGE:
 395       /* This should not occur */
 396       fprintf_filtered (stream, "<range type>");
 397       break;
 398
 399     case TYPE_CODE_CHAR:
 400       /* Override name "char" and make it "character" */
 401       fprintf_filtered (stream, "character");
 402       break;
 403
 404     case TYPE_CODE_INT:
 405       /* There may be some character types that attempt to come
 406          through as TYPE_CODE_INT since dbxstclass.h is so
 407          C-oriented, we must change these to "character" from "char".  */
 408
 409       if (STREQ (TYPE_NAME (type), "char"))
 410         fprintf_filtered (stream, "character");
 411       else
 412         goto default_case;
 413       break;
 414
 415     case TYPE_CODE_COMPLEX:
 416     case TYPE_CODE_LITERAL_COMPLEX:
 417       fprintf_filtered (stream, "complex*");
 418       fprintf_filtered (stream, "%d", TYPE_LENGTH (type));
 419       break;
 420
 421     case TYPE_CODE_FLT:
 422       print_equivalent_f77_float_type (type, stream);
 423       break;
 424
 425     case TYPE_CODE_LITERAL_STRING:
 426        fprintf_filtered (stream, "character*%d",
 427                          TYPE_ARRAY_UPPER_BOUND_VALUE (type));
 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 ("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 }