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       /* These types need no prefix.  They are listed here so that
 148          gcc -Wall will reveal any types that haven't been handled.  */
 149       break;
 150     }
 151 }
 152
 153 static void
 154 f_type_print_args (type, stream)
 155      struct type *type;
 156      FILE *stream;
 157 {
 158   int i;
 159   struct type **args;
 160
 161   fprintf_filtered (stream, "(");
 162   args = TYPE_ARG_TYPES (type);
 163   if (args != NULL)
 164     {
 165       if (args[1] == NULL)
 166         {
 167           fprintf_filtered (stream, "...");
 168         }
 169       else
 170         {
 171           for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++)
 172             {
 173               f_print_type (args[i], "", stream, -1, 0);
 174               if (args[i+1] == NULL)
 175                 fprintf_filtered (stream, "...");
 176               else if (args[i+1]->code != TYPE_CODE_VOID)
 177                 {
 178                   fprintf_filtered (stream, ",");
 179                   wrap_here ("    ");
 180                 }
 181             }
 182         }
 183     }
 184   fprintf_filtered (stream, ")");
 185 }
 186
 187 /* Print any array sizes, function arguments or close parentheses
 188    needed after the variable name (to describe its type).
 189    Args work like c_type_print_varspec_prefix.  */
 190
 191 static void
 192 f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
 193      struct type *type;
 194      FILE *stream;
 195      int show;
 196      int passed_a_ptr;
 197      int demangled_args;
 198 {
 199   int upper_bound, lower_bound;
 200   int lower_bound_was_default = 0;
 201   static int arrayprint_recurse_level = 0;
 202   int retcode;
 203
 204   if (type == 0)
 205     return;
 206
 207   if (TYPE_NAME (type) && show <= 0)
 208     return;
 209
 210   QUIT;
 211
 212   switch (TYPE_CODE (type))
 213     {
 214     case TYPE_CODE_ARRAY:
 215       arrayprint_recurse_level++;
 216
 217       if (arrayprint_recurse_level == 1)
 218         fprintf_filtered(stream,"(");
 219
 220       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
 221         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 222
 223       retcode = f77_get_dynamic_lowerbound (type,&lower_bound);
 224
 225       lower_bound_was_default = 0;
 226
 227       if (retcode == BOUND_FETCH_ERROR)
 228         fprintf_filtered (stream,"???");
 229       else
 230         if (lower_bound == 1) /* The default */
 231           lower_bound_was_default = 1;
 232         else
 233           fprintf_filtered (stream,"%d",lower_bound);
 234
 235       if (lower_bound_was_default)
 236         lower_bound_was_default = 0;
 237       else
 238         fprintf_filtered(stream,":");
 239
 240       /* Make sure that, if we have an assumed size array, we
 241          print out a warning and print the upperbound as '*' */
 242
 243       if (TYPE_ARRAY_UPPER_BOUND_TYPE(type) == BOUND_CANNOT_BE_DETERMINED)
 244         fprintf_filtered (stream, "*");
 245        else
 246          {
 247            retcode = f77_get_dynamic_upperbound(type,&upper_bound);
 248
 249            if (retcode == BOUND_FETCH_ERROR)
 250              fprintf_filtered(stream,"???");
 251            else
 252              fprintf_filtered(stream,"%d",upper_bound);
 253          }
 254
 255       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
 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       else
 260         fprintf_filtered(stream,",");
 261       arrayprint_recurse_level--;
 262       break;
 263
 264     case TYPE_CODE_PTR:
 265     case TYPE_CODE_REF:
 266       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
 267       fprintf_filtered(stream,")");
 268       break;
 269
 270     case TYPE_CODE_FUNC:
 271       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 272                                  passed_a_ptr, 0);
 273       if (passed_a_ptr)
 274         fprintf_filtered (stream, ")");
 275
 276       fprintf_filtered (stream, "()");
 277       break;
 278
 279     case TYPE_CODE_UNDEF:
 280     case TYPE_CODE_STRUCT:
 281     case TYPE_CODE_UNION:
 282     case TYPE_CODE_ENUM:
 283     case TYPE_CODE_INT:
 284     case TYPE_CODE_FLT:
 285     case TYPE_CODE_VOID:
 286     case TYPE_CODE_ERROR:
 287     case TYPE_CODE_CHAR:
 288     case TYPE_CODE_BOOL:
 289     case TYPE_CODE_SET:
 290     case TYPE_CODE_RANGE:
 291     case TYPE_CODE_STRING:
 292     case TYPE_CODE_BITSTRING:
 293     case TYPE_CODE_METHOD:
 294     case TYPE_CODE_MEMBER:
 295     case TYPE_CODE_COMPLEX:
 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       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_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 ("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 }