198944Sobrien/* Support for printing Pascal types for GDB, the GNU debugger.
298944Sobrien   Copyright 2000, 2001, 2002
398944Sobrien   Free Software Foundation, Inc.
498944Sobrien
598944Sobrien   This file is part of GDB.
698944Sobrien
798944Sobrien   This program is free software; you can redistribute it and/or modify
898944Sobrien   it under the terms of the GNU General Public License as published by
998944Sobrien   the Free Software Foundation; either version 2 of the License, or
1098944Sobrien   (at your option) any later version.
1198944Sobrien
1298944Sobrien   This program is distributed in the hope that it will be useful,
1398944Sobrien   but WITHOUT ANY WARRANTY; without even the implied warranty of
1498944Sobrien   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1598944Sobrien   GNU General Public License for more details.
1698944Sobrien
1798944Sobrien   You should have received a copy of the GNU General Public License
1898944Sobrien   along with this program; if not, write to the Free Software
1998944Sobrien   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
2098944Sobrien
2198944Sobrien/* This file is derived from p-typeprint.c */
2298944Sobrien
2398944Sobrien#include "defs.h"
24130803Smarcel#include "gdb_obstack.h"
2598944Sobrien#include "bfd.h"		/* Binary File Description */
2698944Sobrien#include "symtab.h"
2798944Sobrien#include "gdbtypes.h"
2898944Sobrien#include "expression.h"
2998944Sobrien#include "value.h"
3098944Sobrien#include "gdbcore.h"
3198944Sobrien#include "target.h"
3298944Sobrien#include "language.h"
3398944Sobrien#include "p-lang.h"
3498944Sobrien#include "typeprint.h"
3598944Sobrien
3698944Sobrien#include "gdb_string.h"
3798944Sobrien#include <errno.h>
3898944Sobrien#include <ctype.h>
3998944Sobrien
4098944Sobrienstatic void pascal_type_print_varspec_suffix (struct type *, struct ui_file *, int, int, int);
4198944Sobrien
4298944Sobrienstatic void pascal_type_print_derivation_info (struct ui_file *, struct type *);
4398944Sobrien
4498944Sobrienvoid pascal_type_print_varspec_prefix (struct type *, struct ui_file *, int, int);
4598944Sobrien
4698944Sobrien
4798944Sobrien/* LEVEL is the depth to indent lines by.  */
4898944Sobrien
4998944Sobrienvoid
5098944Sobrienpascal_print_type (struct type *type, char *varstring, struct ui_file *stream,
5198944Sobrien		   int show, int level)
5298944Sobrien{
53130803Smarcel  enum type_code code;
5498944Sobrien  int demangled_args;
5598944Sobrien
5698944Sobrien  code = TYPE_CODE (type);
5798944Sobrien
5898944Sobrien  if (show > 0)
5998944Sobrien    CHECK_TYPEDEF (type);
6098944Sobrien
6198944Sobrien  if ((code == TYPE_CODE_FUNC ||
6298944Sobrien       code == TYPE_CODE_METHOD))
6398944Sobrien    {
6498944Sobrien      pascal_type_print_varspec_prefix (type, stream, show, 0);
6598944Sobrien    }
6698944Sobrien  /* first the name */
6798944Sobrien  fputs_filtered (varstring, stream);
6898944Sobrien
6998944Sobrien  if ((varstring != NULL && *varstring != '\0') &&
7098944Sobrien      !(code == TYPE_CODE_FUNC ||
7198944Sobrien	code == TYPE_CODE_METHOD))
7298944Sobrien    {
7398944Sobrien      fputs_filtered (" : ", stream);
7498944Sobrien    }
7598944Sobrien
7698944Sobrien  if (!(code == TYPE_CODE_FUNC ||
7798944Sobrien	code == TYPE_CODE_METHOD))
7898944Sobrien    {
7998944Sobrien      pascal_type_print_varspec_prefix (type, stream, show, 0);
8098944Sobrien    }
8198944Sobrien
8298944Sobrien  pascal_type_print_base (type, stream, show, level);
8398944Sobrien  /* For demangled function names, we have the arglist as part of the name,
8498944Sobrien     so don't print an additional pair of ()'s */
8598944Sobrien
8698944Sobrien  demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
8798944Sobrien  pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
8898944Sobrien
8998944Sobrien}
9098944Sobrien
9198944Sobrien/* If TYPE is a derived type, then print out derivation information.
9298944Sobrien   Print only the actual base classes of this type, not the base classes
9398944Sobrien   of the base classes.  I.E.  for the derivation hierarchy:
9498944Sobrien
9598944Sobrien   class A { int a; };
9698944Sobrien   class B : public A {int b; };
9798944Sobrien   class C : public B {int c; };
9898944Sobrien
9998944Sobrien   Print the type of class C as:
10098944Sobrien
10198944Sobrien   class C : public B {
10298944Sobrien   int c;
10398944Sobrien   }
10498944Sobrien
10598944Sobrien   Not as the following (like gdb used to), which is not legal C++ syntax for
10698944Sobrien   derived types and may be confused with the multiple inheritance form:
10798944Sobrien
10898944Sobrien   class C : public B : public A {
10998944Sobrien   int c;
11098944Sobrien   }
11198944Sobrien
11298944Sobrien   In general, gdb should try to print the types as closely as possible to
11398944Sobrien   the form that they appear in the source code. */
11498944Sobrien
11598944Sobrienstatic void
11698944Sobrienpascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
11798944Sobrien{
11898944Sobrien  char *name;
11998944Sobrien  int i;
12098944Sobrien
12198944Sobrien  for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
12298944Sobrien    {
12398944Sobrien      fputs_filtered (i == 0 ? ": " : ", ", stream);
12498944Sobrien      fprintf_filtered (stream, "%s%s ",
12598944Sobrien			BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
12698944Sobrien			BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : "");
12798944Sobrien      name = type_name_no_tag (TYPE_BASECLASS (type, i));
12898944Sobrien      fprintf_filtered (stream, "%s", name ? name : "(null)");
12998944Sobrien    }
13098944Sobrien  if (i > 0)
13198944Sobrien    {
13298944Sobrien      fputs_filtered (" ", stream);
13398944Sobrien    }
13498944Sobrien}
13598944Sobrien
13698944Sobrien/* Print the Pascal method arguments ARGS to the file STREAM.  */
13798944Sobrien
13898944Sobrienvoid
13998944Sobrienpascal_type_print_method_args (char *physname, char *methodname,
14098944Sobrien			       struct ui_file *stream)
14198944Sobrien{
142130803Smarcel  int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6);
143130803Smarcel  int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6);
14498944Sobrien
14598944Sobrien  if (is_constructor || is_destructor)
14698944Sobrien    {
14798944Sobrien      physname += 6;
14898944Sobrien    }
14998944Sobrien
15098944Sobrien  fputs_filtered (methodname, stream);
15198944Sobrien
15298944Sobrien  if (physname && (*physname != 0))
15398944Sobrien    {
15498944Sobrien      int i = 0;
15598944Sobrien      int len = 0;
15698944Sobrien      char storec;
15798944Sobrien      char *argname;
15898944Sobrien      fputs_filtered (" (", stream);
15998944Sobrien      /* we must demangle this */
16098944Sobrien      while (isdigit (physname[0]))
16198944Sobrien	{
16298944Sobrien	  while (isdigit (physname[len]))
16398944Sobrien	    {
16498944Sobrien	      len++;
16598944Sobrien	    }
16698944Sobrien	  i = strtol (physname, &argname, 0);
16798944Sobrien	  physname += len;
16898944Sobrien	  storec = physname[i];
16998944Sobrien	  physname[i] = 0;
17098944Sobrien	  fputs_filtered (physname, stream);
17198944Sobrien	  physname[i] = storec;
17298944Sobrien	  physname += i;
17398944Sobrien	  if (physname[0] != 0)
17498944Sobrien	    {
17598944Sobrien	      fputs_filtered (", ", stream);
17698944Sobrien	    }
17798944Sobrien	}
17898944Sobrien      fputs_filtered (")", stream);
17998944Sobrien    }
18098944Sobrien}
18198944Sobrien
18298944Sobrien/* Print any asterisks or open-parentheses needed before the
18398944Sobrien   variable name (to describe its type).
18498944Sobrien
18598944Sobrien   On outermost call, pass 0 for PASSED_A_PTR.
18698944Sobrien   On outermost call, SHOW > 0 means should ignore
18798944Sobrien   any typename for TYPE and show its details.
18898944Sobrien   SHOW is always zero on recursive calls.  */
18998944Sobrien
19098944Sobrienvoid
19198944Sobrienpascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
19298944Sobrien				  int show, int passed_a_ptr)
19398944Sobrien{
19498944Sobrien  char *name;
19598944Sobrien  if (type == 0)
19698944Sobrien    return;
19798944Sobrien
19898944Sobrien  if (TYPE_NAME (type) && show <= 0)
19998944Sobrien    return;
20098944Sobrien
20198944Sobrien  QUIT;
20298944Sobrien
20398944Sobrien  switch (TYPE_CODE (type))
20498944Sobrien    {
20598944Sobrien    case TYPE_CODE_PTR:
20698944Sobrien      fprintf_filtered (stream, "^");
20798944Sobrien      pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
20898944Sobrien      break;			/* pointer should be handled normally in pascal */
20998944Sobrien
21098944Sobrien    case TYPE_CODE_MEMBER:
21198944Sobrien      if (passed_a_ptr)
21298944Sobrien	fprintf_filtered (stream, "(");
21398944Sobrien      pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
21498944Sobrien      fprintf_filtered (stream, " ");
21598944Sobrien      name = type_name_no_tag (TYPE_DOMAIN_TYPE (type));
21698944Sobrien      if (name)
21798944Sobrien	fputs_filtered (name, stream);
21898944Sobrien      else
21998944Sobrien	pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
22098944Sobrien      fprintf_filtered (stream, "::");
22198944Sobrien      break;
22298944Sobrien
22398944Sobrien    case TYPE_CODE_METHOD:
22498944Sobrien      if (passed_a_ptr)
22598944Sobrien	fprintf_filtered (stream, "(");
22698944Sobrien      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
22798944Sobrien	{
22898944Sobrien	  fprintf_filtered (stream, "function  ");
22998944Sobrien	}
23098944Sobrien      else
23198944Sobrien	{
23298944Sobrien	  fprintf_filtered (stream, "procedure ");
23398944Sobrien	}
23498944Sobrien
23598944Sobrien      if (passed_a_ptr)
23698944Sobrien	{
23798944Sobrien	  fprintf_filtered (stream, " ");
23898944Sobrien	  pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
23998944Sobrien	  fprintf_filtered (stream, "::");
24098944Sobrien	}
24198944Sobrien      break;
24298944Sobrien
24398944Sobrien    case TYPE_CODE_REF:
24498944Sobrien      pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
24598944Sobrien      fprintf_filtered (stream, "&");
24698944Sobrien      break;
24798944Sobrien
24898944Sobrien    case TYPE_CODE_FUNC:
24998944Sobrien      if (passed_a_ptr)
25098944Sobrien	fprintf_filtered (stream, "(");
25198944Sobrien
25298944Sobrien      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
25398944Sobrien	{
25498944Sobrien	  fprintf_filtered (stream, "function  ");
25598944Sobrien	}
25698944Sobrien      else
25798944Sobrien	{
25898944Sobrien	  fprintf_filtered (stream, "procedure ");
25998944Sobrien	}
26098944Sobrien
26198944Sobrien      break;
26298944Sobrien
26398944Sobrien    case TYPE_CODE_ARRAY:
26498944Sobrien      if (passed_a_ptr)
26598944Sobrien	fprintf_filtered (stream, "(");
26698944Sobrien      fprintf_filtered (stream, "array ");
26798944Sobrien      if (TYPE_LENGTH (type) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
26898944Sobrien	&& TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
26998944Sobrien	fprintf_filtered (stream, "[%d..%d] ",
27098944Sobrien			  TYPE_ARRAY_LOWER_BOUND_VALUE (type),
27198944Sobrien			  TYPE_ARRAY_UPPER_BOUND_VALUE (type)
27298944Sobrien	  );
27398944Sobrien      fprintf_filtered (stream, "of ");
27498944Sobrien      break;
27598944Sobrien
27698944Sobrien    case TYPE_CODE_UNDEF:
27798944Sobrien    case TYPE_CODE_STRUCT:
27898944Sobrien    case TYPE_CODE_UNION:
27998944Sobrien    case TYPE_CODE_ENUM:
28098944Sobrien    case TYPE_CODE_INT:
28198944Sobrien    case TYPE_CODE_FLT:
28298944Sobrien    case TYPE_CODE_VOID:
28398944Sobrien    case TYPE_CODE_ERROR:
28498944Sobrien    case TYPE_CODE_CHAR:
28598944Sobrien    case TYPE_CODE_BOOL:
28698944Sobrien    case TYPE_CODE_SET:
28798944Sobrien    case TYPE_CODE_RANGE:
28898944Sobrien    case TYPE_CODE_STRING:
28998944Sobrien    case TYPE_CODE_BITSTRING:
29098944Sobrien    case TYPE_CODE_COMPLEX:
29198944Sobrien    case TYPE_CODE_TYPEDEF:
29298944Sobrien    case TYPE_CODE_TEMPLATE:
29398944Sobrien      /* These types need no prefix.  They are listed here so that
29498944Sobrien         gcc -Wall will reveal any types that haven't been handled.  */
29598944Sobrien      break;
29698944Sobrien    default:
29798944Sobrien      error ("type not handled in pascal_type_print_varspec_prefix()");
29898944Sobrien      break;
29998944Sobrien    }
30098944Sobrien}
30198944Sobrien
30298944Sobrienstatic void
30398944Sobrienpascal_print_func_args (struct type *type, struct ui_file *stream)
30498944Sobrien{
30598944Sobrien  int i, len = TYPE_NFIELDS (type);
30698944Sobrien  if (len)
30798944Sobrien    {
30898944Sobrien      fprintf_filtered (stream, "(");
30998944Sobrien    }
31098944Sobrien  for (i = 0; i < len; i++)
31198944Sobrien    {
31298944Sobrien      if (i > 0)
31398944Sobrien	{
31498944Sobrien	  fputs_filtered (", ", stream);
31598944Sobrien	  wrap_here ("    ");
31698944Sobrien	}
31798944Sobrien      /*  can we find if it is a var parameter ??
31898944Sobrien         if ( TYPE_FIELD(type, i) == )
31998944Sobrien         {
32098944Sobrien         fprintf_filtered (stream, "var ");
32198944Sobrien         } */
32298944Sobrien      pascal_print_type (TYPE_FIELD_TYPE (type, i), ""	/* TYPE_FIELD_NAME seems invalid ! */
32398944Sobrien			 ,stream, -1, 0);
32498944Sobrien    }
32598944Sobrien  if (len)
32698944Sobrien    {
32798944Sobrien      fprintf_filtered (stream, ")");
32898944Sobrien    }
32998944Sobrien}
33098944Sobrien
33198944Sobrien/* Print any array sizes, function arguments or close parentheses
33298944Sobrien   needed after the variable name (to describe its type).
33398944Sobrien   Args work like pascal_type_print_varspec_prefix.  */
33498944Sobrien
33598944Sobrienstatic void
33698944Sobrienpascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
33798944Sobrien				  int show, int passed_a_ptr,
33898944Sobrien				  int demangled_args)
33998944Sobrien{
34098944Sobrien  if (type == 0)
34198944Sobrien    return;
34298944Sobrien
34398944Sobrien  if (TYPE_NAME (type) && show <= 0)
34498944Sobrien    return;
34598944Sobrien
34698944Sobrien  QUIT;
34798944Sobrien
34898944Sobrien  switch (TYPE_CODE (type))
34998944Sobrien    {
35098944Sobrien    case TYPE_CODE_ARRAY:
35198944Sobrien      if (passed_a_ptr)
35298944Sobrien	fprintf_filtered (stream, ")");
35398944Sobrien      break;
35498944Sobrien
35598944Sobrien    case TYPE_CODE_MEMBER:
35698944Sobrien      if (passed_a_ptr)
35798944Sobrien	fprintf_filtered (stream, ")");
35898944Sobrien      pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
35998944Sobrien      break;
36098944Sobrien
36198944Sobrien    case TYPE_CODE_METHOD:
36298944Sobrien      if (passed_a_ptr)
36398944Sobrien	fprintf_filtered (stream, ")");
36498944Sobrien      pascal_type_print_method_args ("",
36598944Sobrien				     "",
36698944Sobrien				     stream);
36798944Sobrien      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
36898944Sobrien	{
36998944Sobrien	  fprintf_filtered (stream, " : ");
37098944Sobrien	  pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
37198944Sobrien	  pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
37298944Sobrien	  pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
37398944Sobrien					    passed_a_ptr, 0);
37498944Sobrien	}
37598944Sobrien      break;
37698944Sobrien
37798944Sobrien    case TYPE_CODE_PTR:
37898944Sobrien    case TYPE_CODE_REF:
37998944Sobrien      pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
38098944Sobrien      break;
38198944Sobrien
38298944Sobrien    case TYPE_CODE_FUNC:
38398944Sobrien      if (passed_a_ptr)
38498944Sobrien	fprintf_filtered (stream, ")");
38598944Sobrien      if (!demangled_args)
38698944Sobrien	pascal_print_func_args (type, stream);
38798944Sobrien      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
38898944Sobrien	{
38998944Sobrien	  fprintf_filtered (stream, " : ");
39098944Sobrien	  pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
39198944Sobrien	  pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
39298944Sobrien	  pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
39398944Sobrien					    passed_a_ptr, 0);
39498944Sobrien	}
39598944Sobrien      break;
39698944Sobrien
39798944Sobrien    case TYPE_CODE_UNDEF:
39898944Sobrien    case TYPE_CODE_STRUCT:
39998944Sobrien    case TYPE_CODE_UNION:
40098944Sobrien    case TYPE_CODE_ENUM:
40198944Sobrien    case TYPE_CODE_INT:
40298944Sobrien    case TYPE_CODE_FLT:
40398944Sobrien    case TYPE_CODE_VOID:
40498944Sobrien    case TYPE_CODE_ERROR:
40598944Sobrien    case TYPE_CODE_CHAR:
40698944Sobrien    case TYPE_CODE_BOOL:
40798944Sobrien    case TYPE_CODE_SET:
40898944Sobrien    case TYPE_CODE_RANGE:
40998944Sobrien    case TYPE_CODE_STRING:
41098944Sobrien    case TYPE_CODE_BITSTRING:
41198944Sobrien    case TYPE_CODE_COMPLEX:
41298944Sobrien    case TYPE_CODE_TYPEDEF:
41398944Sobrien    case TYPE_CODE_TEMPLATE:
41498944Sobrien      /* These types do not need a suffix.  They are listed so that
41598944Sobrien         gcc -Wall will report types that may not have been considered.  */
41698944Sobrien      break;
41798944Sobrien    default:
41898944Sobrien      error ("type not handled in pascal_type_print_varspec_suffix()");
41998944Sobrien      break;
42098944Sobrien    }
42198944Sobrien}
42298944Sobrien
42398944Sobrien/* Print the name of the type (or the ultimate pointer target,
42498944Sobrien   function value or array element), or the description of a
42598944Sobrien   structure or union.
42698944Sobrien
42798944Sobrien   SHOW positive means print details about the type (e.g. enum values),
42898944Sobrien   and print structure elements passing SHOW - 1 for show.
42998944Sobrien   SHOW negative means just print the type name or struct tag if there is one.
43098944Sobrien   If there is no name, print something sensible but concise like
43198944Sobrien   "struct {...}".
43298944Sobrien   SHOW zero means just print the type name or struct tag if there is one.
43398944Sobrien   If there is no name, print something sensible but not as concise like
43498944Sobrien   "struct {int x; int y;}".
43598944Sobrien
43698944Sobrien   LEVEL is the number of spaces to indent by.
43798944Sobrien   We increase it for some recursive calls.  */
43898944Sobrien
43998944Sobrienvoid
44098944Sobrienpascal_type_print_base (struct type *type, struct ui_file *stream, int show,
44198944Sobrien			int level)
44298944Sobrien{
443130803Smarcel  int i;
444130803Smarcel  int len;
445130803Smarcel  int lastval;
44698944Sobrien  enum
44798944Sobrien    {
44898944Sobrien      s_none, s_public, s_private, s_protected
44998944Sobrien    }
45098944Sobrien  section_type;
45198944Sobrien  QUIT;
45298944Sobrien
45398944Sobrien  wrap_here ("    ");
45498944Sobrien  if (type == NULL)
45598944Sobrien    {
45698944Sobrien      fputs_filtered ("<type unknown>", stream);
45798944Sobrien      return;
45898944Sobrien    }
45998944Sobrien
46098944Sobrien  /* void pointer */
46198944Sobrien  if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
46298944Sobrien    {
463130803Smarcel      fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
464130803Smarcel		      stream);
46598944Sobrien      return;
46698944Sobrien    }
46798944Sobrien  /* When SHOW is zero or less, and there is a valid type name, then always
46898944Sobrien     just print the type name directly from the type.  */
46998944Sobrien
47098944Sobrien  if (show <= 0
47198944Sobrien      && TYPE_NAME (type) != NULL)
47298944Sobrien    {
47398944Sobrien      fputs_filtered (TYPE_NAME (type), stream);
47498944Sobrien      return;
47598944Sobrien    }
47698944Sobrien
47798944Sobrien  CHECK_TYPEDEF (type);
47898944Sobrien
47998944Sobrien  switch (TYPE_CODE (type))
48098944Sobrien    {
48198944Sobrien    case TYPE_CODE_TYPEDEF:
48298944Sobrien    case TYPE_CODE_PTR:
48398944Sobrien    case TYPE_CODE_MEMBER:
48498944Sobrien    case TYPE_CODE_REF:
48598944Sobrien      /* case TYPE_CODE_FUNC:
48698944Sobrien         case TYPE_CODE_METHOD: */
48798944Sobrien      pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
48898944Sobrien      break;
48998944Sobrien
49098944Sobrien    case TYPE_CODE_ARRAY:
49198944Sobrien      /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
49298944Sobrien         pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
49398944Sobrien         pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
49498944Sobrien      pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
49598944Sobrien      break;
49698944Sobrien
49798944Sobrien    case TYPE_CODE_FUNC:
49898944Sobrien    case TYPE_CODE_METHOD:
49998944Sobrien      /*
50098944Sobrien         pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
50198944Sobrien         only after args !! */
50298944Sobrien      break;
50398944Sobrien    case TYPE_CODE_STRUCT:
50498944Sobrien      if (TYPE_TAG_NAME (type) != NULL)
50598944Sobrien	{
50698944Sobrien	  fputs_filtered (TYPE_TAG_NAME (type), stream);
50798944Sobrien	  fputs_filtered (" = ", stream);
50898944Sobrien	}
50998944Sobrien      if (HAVE_CPLUS_STRUCT (type))
51098944Sobrien	{
51198944Sobrien	  fprintf_filtered (stream, "class ");
51298944Sobrien	}
51398944Sobrien      else
51498944Sobrien	{
51598944Sobrien	  fprintf_filtered (stream, "record ");
51698944Sobrien	}
51798944Sobrien      goto struct_union;
51898944Sobrien
51998944Sobrien    case TYPE_CODE_UNION:
52098944Sobrien      if (TYPE_TAG_NAME (type) != NULL)
52198944Sobrien	{
52298944Sobrien	  fputs_filtered (TYPE_TAG_NAME (type), stream);
52398944Sobrien	  fputs_filtered (" = ", stream);
52498944Sobrien	}
52598944Sobrien      fprintf_filtered (stream, "case <?> of ");
52698944Sobrien
52798944Sobrien    struct_union:
52898944Sobrien      wrap_here ("    ");
52998944Sobrien      if (show < 0)
53098944Sobrien	{
53198944Sobrien	  /* If we just printed a tag name, no need to print anything else.  */
53298944Sobrien	  if (TYPE_TAG_NAME (type) == NULL)
53398944Sobrien	    fprintf_filtered (stream, "{...}");
53498944Sobrien	}
53598944Sobrien      else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
53698944Sobrien	{
53798944Sobrien	  pascal_type_print_derivation_info (stream, type);
53898944Sobrien
53998944Sobrien	  fprintf_filtered (stream, "\n");
54098944Sobrien	  if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
54198944Sobrien	    {
54298944Sobrien	      if (TYPE_STUB (type))
54398944Sobrien		fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
54498944Sobrien	      else
54598944Sobrien		fprintfi_filtered (level + 4, stream, "<no data fields>\n");
54698944Sobrien	    }
54798944Sobrien
54898944Sobrien	  /* Start off with no specific section type, so we can print
54998944Sobrien	     one for the first field we find, and use that section type
55098944Sobrien	     thereafter until we find another type. */
55198944Sobrien
55298944Sobrien	  section_type = s_none;
55398944Sobrien
55498944Sobrien	  /* If there is a base class for this type,
55598944Sobrien	     do not print the field that it occupies.  */
55698944Sobrien
55798944Sobrien	  len = TYPE_NFIELDS (type);
55898944Sobrien	  for (i = TYPE_N_BASECLASSES (type); i < len; i++)
55998944Sobrien	    {
56098944Sobrien	      QUIT;
56198944Sobrien	      /* Don't print out virtual function table.  */
562130803Smarcel	      if (DEPRECATED_STREQN (TYPE_FIELD_NAME (type, i), "_vptr", 5)
56398944Sobrien		  && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
56498944Sobrien		continue;
56598944Sobrien
56698944Sobrien	      /* If this is a pascal object or class we can print the
56798944Sobrien	         various section labels. */
56898944Sobrien
56998944Sobrien	      if (HAVE_CPLUS_STRUCT (type))
57098944Sobrien		{
57198944Sobrien		  if (TYPE_FIELD_PROTECTED (type, i))
57298944Sobrien		    {
57398944Sobrien		      if (section_type != s_protected)
57498944Sobrien			{
57598944Sobrien			  section_type = s_protected;
57698944Sobrien			  fprintfi_filtered (level + 2, stream,
57798944Sobrien					     "protected\n");
57898944Sobrien			}
57998944Sobrien		    }
58098944Sobrien		  else if (TYPE_FIELD_PRIVATE (type, i))
58198944Sobrien		    {
58298944Sobrien		      if (section_type != s_private)
58398944Sobrien			{
58498944Sobrien			  section_type = s_private;
58598944Sobrien			  fprintfi_filtered (level + 2, stream, "private\n");
58698944Sobrien			}
58798944Sobrien		    }
58898944Sobrien		  else
58998944Sobrien		    {
59098944Sobrien		      if (section_type != s_public)
59198944Sobrien			{
59298944Sobrien			  section_type = s_public;
59398944Sobrien			  fprintfi_filtered (level + 2, stream, "public\n");
59498944Sobrien			}
59598944Sobrien		    }
59698944Sobrien		}
59798944Sobrien
59898944Sobrien	      print_spaces_filtered (level + 4, stream);
59998944Sobrien	      if (TYPE_FIELD_STATIC (type, i))
60098944Sobrien		{
60198944Sobrien		  fprintf_filtered (stream, "static ");
60298944Sobrien		}
60398944Sobrien	      pascal_print_type (TYPE_FIELD_TYPE (type, i),
60498944Sobrien				 TYPE_FIELD_NAME (type, i),
60598944Sobrien				 stream, show - 1, level + 4);
60698944Sobrien	      if (!TYPE_FIELD_STATIC (type, i)
60798944Sobrien		  && TYPE_FIELD_PACKED (type, i))
60898944Sobrien		{
60998944Sobrien		  /* It is a bitfield.  This code does not attempt
61098944Sobrien		     to look at the bitpos and reconstruct filler,
61198944Sobrien		     unnamed fields.  This would lead to misleading
61298944Sobrien		     results if the compiler does not put out fields
61398944Sobrien		     for such things (I don't know what it does).  */
61498944Sobrien		  fprintf_filtered (stream, " : %d",
61598944Sobrien				    TYPE_FIELD_BITSIZE (type, i));
61698944Sobrien		}
61798944Sobrien	      fprintf_filtered (stream, ";\n");
61898944Sobrien	    }
61998944Sobrien
62098944Sobrien	  /* If there are both fields and methods, put a space between. */
62198944Sobrien	  len = TYPE_NFN_FIELDS (type);
62298944Sobrien	  if (len && section_type != s_none)
62398944Sobrien	    fprintf_filtered (stream, "\n");
62498944Sobrien
62598944Sobrien	  /* Pbject pascal: print out the methods */
62698944Sobrien
62798944Sobrien	  for (i = 0; i < len; i++)
62898944Sobrien	    {
62998944Sobrien	      struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
63098944Sobrien	      int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
63198944Sobrien	      char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
63298944Sobrien	      char *name = type_name_no_tag (type);
63398944Sobrien	      /* this is GNU C++ specific
63498944Sobrien	         how can we know constructor/destructor?
63598944Sobrien	         It might work for GNU pascal */
63698944Sobrien	      for (j = 0; j < len2; j++)
63798944Sobrien		{
63898944Sobrien		  char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
63998944Sobrien
640130803Smarcel		  int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6);
641130803Smarcel		  int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6);
64298944Sobrien
64398944Sobrien		  QUIT;
64498944Sobrien		  if (TYPE_FN_FIELD_PROTECTED (f, j))
64598944Sobrien		    {
64698944Sobrien		      if (section_type != s_protected)
64798944Sobrien			{
64898944Sobrien			  section_type = s_protected;
64998944Sobrien			  fprintfi_filtered (level + 2, stream,
65098944Sobrien					     "protected\n");
65198944Sobrien			}
65298944Sobrien		    }
65398944Sobrien		  else if (TYPE_FN_FIELD_PRIVATE (f, j))
65498944Sobrien		    {
65598944Sobrien		      if (section_type != s_private)
65698944Sobrien			{
65798944Sobrien			  section_type = s_private;
65898944Sobrien			  fprintfi_filtered (level + 2, stream, "private\n");
65998944Sobrien			}
66098944Sobrien		    }
66198944Sobrien		  else
66298944Sobrien		    {
66398944Sobrien		      if (section_type != s_public)
66498944Sobrien			{
66598944Sobrien			  section_type = s_public;
66698944Sobrien			  fprintfi_filtered (level + 2, stream, "public\n");
66798944Sobrien			}
66898944Sobrien		    }
66998944Sobrien
67098944Sobrien		  print_spaces_filtered (level + 4, stream);
67198944Sobrien		  if (TYPE_FN_FIELD_STATIC_P (f, j))
67298944Sobrien		    fprintf_filtered (stream, "static ");
67398944Sobrien		  if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
67498944Sobrien		    {
67598944Sobrien		      /* Keep GDB from crashing here.  */
67698944Sobrien		      fprintf_filtered (stream, "<undefined type> %s;\n",
67798944Sobrien					TYPE_FN_FIELD_PHYSNAME (f, j));
67898944Sobrien		      break;
67998944Sobrien		    }
68098944Sobrien
68198944Sobrien		  if (is_constructor)
68298944Sobrien		    {
68398944Sobrien		      fprintf_filtered (stream, "constructor ");
68498944Sobrien		    }
68598944Sobrien		  else if (is_destructor)
68698944Sobrien		    {
68798944Sobrien		      fprintf_filtered (stream, "destructor  ");
68898944Sobrien		    }
68998944Sobrien		  else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
69098944Sobrien			   TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
69198944Sobrien		    {
69298944Sobrien		      fprintf_filtered (stream, "function  ");
69398944Sobrien		    }
69498944Sobrien		  else
69598944Sobrien		    {
69698944Sobrien		      fprintf_filtered (stream, "procedure ");
69798944Sobrien		    }
69898944Sobrien		  /* this does not work, no idea why !! */
69998944Sobrien
70098944Sobrien		  pascal_type_print_method_args (physname,
70198944Sobrien						 method_name,
70298944Sobrien						 stream);
70398944Sobrien
70498944Sobrien		  if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
70598944Sobrien		      TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
70698944Sobrien		    {
70798944Sobrien		      fputs_filtered (" : ", stream);
70898944Sobrien		      type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
70998944Sobrien				  "", stream, -1);
71098944Sobrien		    }
71198944Sobrien		  if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
71298944Sobrien		    fprintf_filtered (stream, "; virtual");
71398944Sobrien
71498944Sobrien		  fprintf_filtered (stream, ";\n");
71598944Sobrien		}
71698944Sobrien	    }
71798944Sobrien	  fprintfi_filtered (level, stream, "end");
71898944Sobrien	}
71998944Sobrien      break;
72098944Sobrien
72198944Sobrien    case TYPE_CODE_ENUM:
72298944Sobrien      if (TYPE_TAG_NAME (type) != NULL)
72398944Sobrien	{
72498944Sobrien	  fputs_filtered (TYPE_TAG_NAME (type), stream);
72598944Sobrien	  if (show > 0)
72698944Sobrien	    fputs_filtered (" ", stream);
72798944Sobrien	}
72898944Sobrien      /* enum is just defined by
72998944Sobrien         type enume_name = (enum_member1,enum_member2,...) */
73098944Sobrien      fprintf_filtered (stream, " = ");
73198944Sobrien      wrap_here ("    ");
73298944Sobrien      if (show < 0)
73398944Sobrien	{
73498944Sobrien	  /* If we just printed a tag name, no need to print anything else.  */
73598944Sobrien	  if (TYPE_TAG_NAME (type) == NULL)
73698944Sobrien	    fprintf_filtered (stream, "(...)");
73798944Sobrien	}
73898944Sobrien      else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
73998944Sobrien	{
74098944Sobrien	  fprintf_filtered (stream, "(");
74198944Sobrien	  len = TYPE_NFIELDS (type);
74298944Sobrien	  lastval = 0;
74398944Sobrien	  for (i = 0; i < len; i++)
74498944Sobrien	    {
74598944Sobrien	      QUIT;
74698944Sobrien	      if (i)
74798944Sobrien		fprintf_filtered (stream, ", ");
74898944Sobrien	      wrap_here ("    ");
74998944Sobrien	      fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
75098944Sobrien	      if (lastval != TYPE_FIELD_BITPOS (type, i))
75198944Sobrien		{
75298944Sobrien		  fprintf_filtered (stream, " := %d", TYPE_FIELD_BITPOS (type, i));
75398944Sobrien		  lastval = TYPE_FIELD_BITPOS (type, i);
75498944Sobrien		}
75598944Sobrien	      lastval++;
75698944Sobrien	    }
75798944Sobrien	  fprintf_filtered (stream, ")");
75898944Sobrien	}
75998944Sobrien      break;
76098944Sobrien
76198944Sobrien    case TYPE_CODE_VOID:
76298944Sobrien      fprintf_filtered (stream, "void");
76398944Sobrien      break;
76498944Sobrien
76598944Sobrien    case TYPE_CODE_UNDEF:
76698944Sobrien      fprintf_filtered (stream, "record <unknown>");
76798944Sobrien      break;
76898944Sobrien
76998944Sobrien    case TYPE_CODE_ERROR:
77098944Sobrien      fprintf_filtered (stream, "<unknown type>");
77198944Sobrien      break;
77298944Sobrien
77398944Sobrien      /* this probably does not work for enums */
77498944Sobrien    case TYPE_CODE_RANGE:
77598944Sobrien      {
77698944Sobrien	struct type *target = TYPE_TARGET_TYPE (type);
77798944Sobrien	if (target == NULL)
77898944Sobrien	  target = builtin_type_long;
77998944Sobrien	print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
78098944Sobrien	fputs_filtered ("..", stream);
78198944Sobrien	print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
78298944Sobrien      }
78398944Sobrien      break;
78498944Sobrien
78598944Sobrien    case TYPE_CODE_SET:
78698944Sobrien      fputs_filtered ("set of ", stream);
78798944Sobrien      pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
78898944Sobrien			 show - 1, level);
78998944Sobrien      break;
79098944Sobrien
791130803Smarcel    case TYPE_CODE_BITSTRING:
792130803Smarcel      fputs_filtered ("BitString", stream);
793130803Smarcel      break;
794130803Smarcel
795130803Smarcel    case TYPE_CODE_STRING:
796130803Smarcel      fputs_filtered ("String", stream);
797130803Smarcel      break;
798130803Smarcel
79998944Sobrien    default:
80098944Sobrien      /* Handle types not explicitly handled by the other cases,
80198944Sobrien         such as fundamental types.  For these, just print whatever
80298944Sobrien         the type name is, as recorded in the type itself.  If there
80398944Sobrien         is no type name, then complain. */
80498944Sobrien      if (TYPE_NAME (type) != NULL)
80598944Sobrien	{
80698944Sobrien	  fputs_filtered (TYPE_NAME (type), stream);
80798944Sobrien	}
80898944Sobrien      else
80998944Sobrien	{
81098944Sobrien	  /* At least for dump_symtab, it is important that this not be
81198944Sobrien	     an error ().  */
81298944Sobrien	  fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
81398944Sobrien			    TYPE_CODE (type));
81498944Sobrien	}
81598944Sobrien      break;
81698944Sobrien    }
81798944Sobrien}
818