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       else
 220         fprintf_filtered(stream,",");
 221
 222       retcode = f77_get_dynamic_lowerbound (type,&lower_bound);
 223
 224       lower_bound_was_default = 0;
 225
 226       if (retcode == BOUND_FETCH_ERROR)
 227         fprintf_filtered (stream,"???");
 228       else
 229         if (lower_bound == 1) /* The default */
 230           lower_bound_was_default = 1;
 231         else
 232           fprintf_filtered (stream,"%d",lower_bound);
 233
 234       if (lower_bound_was_default)
 235         lower_bound_was_default = 0;
 236       else
 237         fprintf_filtered(stream,":");
 238
 239       /* Make sure that, if we have an assumed size array, we
 240          print out a warning and print the upperbound as '*' */
 241
 242       if (TYPE_ARRAY_UPPER_BOUND_TYPE(type) == BOUND_CANNOT_BE_DETERMINED)
 243         fprintf_filtered (stream, "*");
 244        else
 245          {
 246            retcode = f77_get_dynamic_upperbound(type,&upper_bound);
 247
 248            if (retcode == BOUND_FETCH_ERROR)
 249              fprintf_filtered(stream,"???");
 250            else
 251              fprintf_filtered(stream,"%d",upper_bound);
 252          }
 253
 254       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 255       if (arrayprint_recurse_level == 1)
 256         fprintf_filtered (stream, ")");
 257       arrayprint_recurse_level--;
 258       break;
 259
 260     case TYPE_CODE_PTR:
 261     case TYPE_CODE_REF:
 262       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
 263       fprintf_filtered(stream,")");
 264       break;
 265
 266     case TYPE_CODE_FUNC:
 267       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 268                                  passed_a_ptr, 0);
 269       if (passed_a_ptr)
 270         fprintf_filtered (stream, ")");
 271
 272       fprintf_filtered (stream, "()");
 273       break;
 274
 275     case TYPE_CODE_UNDEF:
 276     case TYPE_CODE_STRUCT:
 277     case TYPE_CODE_UNION:
 278     case TYPE_CODE_ENUM:
 279     case TYPE_CODE_INT:
 280     case TYPE_CODE_FLT:
 281     case TYPE_CODE_VOID:
 282     case TYPE_CODE_ERROR:
 283     case TYPE_CODE_CHAR:
 284     case TYPE_CODE_BOOL:
 285     case TYPE_CODE_SET:
 286     case TYPE_CODE_RANGE:
 287     case TYPE_CODE_STRING:
 288     case TYPE_CODE_BITSTRING:
 289     case TYPE_CODE_METHOD:
 290     case TYPE_CODE_MEMBER:
 291     case TYPE_CODE_COMPLEX:
 292       /* These types do not need a suffix.  They are listed so that
 293          gcc -Wall will report types that may not have been considered.  */
 294       break;
 295     }
 296 }
 297
 298 void
 299 print_equivalent_f77_float_type (type, stream)
 300      struct type *type;
 301      FILE *stream;
 302 {
 303   /* Override type name "float" and make it the
 304      appropriate real. XLC stupidly outputs -12 as a type
 305      for real when it really should be outputting -18 */
 306
 307   switch (TYPE_LENGTH (type))
 308     {
 309     case 4:
 310       fprintf_filtered (stream, "real*4");
 311       break;
 312
 313     case 8:
 314       fprintf_filtered(stream,"real*8");
 315       break;
 316     }
 317 }
 318
 319 /* Print the name of the type (or the ultimate pointer target,
 320    function value or array element), or the description of a
 321    structure or union.
 322
 323    SHOW nonzero means don't print this type as just its name;
 324    show its real definition even if it has a name.
 325    SHOW zero means print just typename or struct tag if there is one
 326    SHOW negative means abbreviate structure elements.
 327    SHOW is decremented for printing of structure elements.
 328
 329    LEVEL is the depth to indent by.
 330    We increase it for some recursive calls.  */
 331
 332 void
 333 f_type_print_base (type, stream, show, level)
 334      struct type *type;
 335      FILE *stream;
 336      int show;
 337      int level;
 338 {
 339   int retcode;
 340   int upper_bound;
 341
 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       if (TYPE_CODE (type) == TYPE_CODE_FLT)
 357         print_equivalent_f77_float_type (type, stream);
 358       else
 359         fputs_filtered (TYPE_NAME (type), stream);
 360       return;
 361     }
 362
 363   switch (TYPE_CODE (type))
 364     {
 365     case TYPE_CODE_ARRAY:
 366       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 367       break;
 368
 369     case TYPE_CODE_FUNC:
 370       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 371       break;
 372
 373    case TYPE_CODE_PTR:
 374       fprintf_filtered (stream, "PTR TO -> ( ");
 375       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 376       break;
 377
 378     case TYPE_CODE_VOID:
 379       fprintf_filtered (stream, "VOID");
 380       break;
 381
 382     case TYPE_CODE_UNDEF:
 383       fprintf_filtered (stream, "struct <unknown>");
 384       break;
 385
 386     case TYPE_CODE_ERROR:
 387       fprintf_filtered (stream, "<unknown type>");
 388       break;
 389
 390     case TYPE_CODE_RANGE:
 391       /* This should not occur */
 392       fprintf_filtered (stream, "<range type>");
 393       break;
 394
 395     case TYPE_CODE_CHAR:
 396       /* Override name "char" and make it "character" */
 397       fprintf_filtered (stream, "character");
 398       break;
 399
 400     case TYPE_CODE_INT:
 401       /* There may be some character types that attempt to come
 402          through as TYPE_CODE_INT since dbxstclass.h is so
 403          C-oriented, we must change these to "character" from "char".  */
 404
 405       if (STREQ (TYPE_NAME (type), "char"))
 406         fprintf_filtered (stream, "character");
 407       else
 408         goto default_case;
 409       break;
 410
 411     case TYPE_CODE_COMPLEX:
 412       fprintf_filtered (stream, "complex*");
 413       fprintf_filtered (stream, "%d", TYPE_LENGTH (type));
 414       break;
 415
 416     case TYPE_CODE_FLT:
 417       print_equivalent_f77_float_type (type, stream);
 418       break;
 419
 420     case TYPE_CODE_STRING:
 421       /* Strings may have dynamic upperbounds (lengths) like arrays. */
 422
 423       if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
 424         fprintf_filtered ("character*(*)");
 425       else
 426         {
 427           retcode = f77_get_dynamic_upperbound (type, &upper_bound);
 428
 429           if (retcode == BOUND_FETCH_ERROR)
 430             fprintf_filtered (stream, "character*???");
 431           else
 432             fprintf_filtered (stream, "character*%d", upper_bound);
 433         }
 434       break;
 435
 436     default_case:
 437     default:
 438       /* Handle types not explicitly handled by the other cases,
 439          such as fundamental types.  For these, just print whatever
 440          the type name is, as recorded in the type itself.  If there
 441          is no type name, then complain. */
 442       if (TYPE_NAME (type) != NULL)
 443         fputs_filtered (TYPE_NAME (type), stream);
 444       else
 445         error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type));
 446       break;
 447     }
 448 }