[RFC] New file fpc-abi.c

[RFC] New file fpc-abi.c

[Pierre Muller]

[-- Attachment #1: Type: text/plain, Size: 783 bytes --]

  This patch adds a new file fpc-abi.c
to the gdb directory.

  The purpose of this file is rather clear:
it allows to recognize Free Pascal compiled 
objects and to handle ABI stuff in a more 
adequate way.

Should I submit this in several RFA?


ChangeLog entry:

2003-02-17  Pierre Muller  <muller@ics.u-strasbg.fr>

        * fpc-abi.c: New file.
        Implements Free Pascal specific ABI.
        * minsyms.c (install_minimal_symbols): Recognize
        Free Pascal compiled objects by the presence of
        'fpc_compiled' minimal symbol.
        * Makefile.in: Add fpc-abi.c compilation rules.





Pierre Muller
Institut Charles Sadron
6,rue Boussingault
F 67083 STRASBOURG CEDEX (France)
mailto:muller@ics.u-strasbg.fr
Phone : (33)-3-88-41-40-07  Fax : (33)-3-88-41-40-99

[-- Attachment #2: fpc-abi.dif --]
[-- Type: text/plain, Size: 15328 bytes --]

Index: fpc-abi.c
===================================================================
RCS file: fpc-abi.c
diff -N fpc-abi.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ fpc-abi.c	17 Feb 2003 17:09:05 -0000
@@ -0,0 +1,408 @@
+/* Abstraction of FPC abi.
+   Contributed by Pierre Muller  <muller@ics.u-strasbg.fr>
+   Copyright 2003 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   This program is free software; you can redistribute it and/or
+   modify
+   it under the terms of the GNU General Public License as published
+   by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.  */
+
+#include "defs.h"
+#include "gdb_string.h"
+#include "symtab.h"
+#include "gdbtypes.h"
+#include "value.h"
+#include "demangle.h"
+#include "cp-abi.h"
+
+/* #include <ctype.h> */
+
+struct cp_abi_ops fpc_abi_ops;
+
+static int vb_match (struct type *, int, struct type *);
+int fpc_baseclass_offset (struct type *type, int index, char *valaddr,
+			    CORE_ADDR address);
+
+static enum dtor_kinds
+fpc_is_destructor_name (const char *name)
+{
+  if ((name[0] == '_' && is_cplus_marker (name[1]) && name[2] == '_')
+      || strncmp (name, "__dt__", 6) == 0)
+    return complete_object_dtor;
+  else
+    return 0;
+}
+
+static enum ctor_kinds
+fpc_is_constructor_name (const char *name)
+{
+  if ((name[0] == '_' && name[1] == '_'
+       && (isdigit (name[2]) || strchr ("Qt", name[2])))
+      || strncmp (name, "__ct__", 6) == 0)
+    return complete_object_ctor;
+  else
+    return 0;
+}
+
+static int
+fpc_is_vtable_name (const char *name)
+{
+  return ((name)[0] == 'V'
+	  && (name)[1] == 'M' && (name)[2] == 'T'
+	  && (name)[3] == '_');
+}
+
+static int
+fpc_is_operator_name (const char *name)
+{
+  return strncmp (name, "operator", 8) == 0;
+}
+
+\f
+/* Return a virtual function as a value.
+   ARG1 is the object which provides the virtual function
+   table pointer.  *ARG1P is side-effected in calling this function.
+   F is the list of member functions which contains the desired virtual
+   function.
+   J is an index into F which provides the desired virtual function.
+
+   TYPE is the type in which F is located.  */
+static struct value *
+fpc_virtual_fn_field (struct value **arg1p, struct fn_field * f, int j,
+			struct type * type, int offset)
+{
+  struct value *arg1 = *arg1p;
+  struct type *type1 = check_typedef (VALUE_TYPE (arg1));
+
+
+  struct type *entry_type;
+  /* First, get the virtual function table pointer.  That comes
+     with a strange type, so cast it to type `pointer to long' (which
+     should serve just fine as a function type).  Then, index into
+     the table, and convert final value to appropriate function type.  */
+  struct value *entry;
+  struct value *vfn;
+  struct value *vtbl;
+  struct value *vi = value_from_longest (builtin_type_int,
+				     (LONGEST) TYPE_FN_FIELD_VOFFSET (f, j));
+  struct type *fcontext = TYPE_FN_FIELD_FCONTEXT (f, j);
+  struct type *context;
+  if (fcontext == NULL)
+    /* We don't have an fcontext (e.g. the program was compiled with
+       g++ version 1).  Try to get the vtbl from the TYPE_VPTR_BASETYPE.
+       This won't work right for multiple inheritance, but at least we
+       should do as well as GDB 3.x did.  */
+    fcontext = TYPE_VPTR_BASETYPE (type);
+  context = lookup_pointer_type (fcontext);
+  /* Now context is a pointer to the basetype containing the vtbl.  */
+  if (TYPE_TARGET_TYPE (context) != type1)
+    {
+      struct value *tmp = value_cast (context, value_addr (arg1));
+      arg1 = value_ind (tmp);
+      type1 = check_typedef (VALUE_TYPE (arg1));
+    }
+
+  context = type1;
+  /* Now context is the basetype containing the vtbl.  */
+
+  /* This type may have been defined before its virtual function table
+     was.  If so, fill in the virtual function table entry for the
+     type now.  */
+  if (TYPE_VPTR_FIELDNO (context) < 0)
+    fill_in_vptr_fieldno (context);
+
+  /* The virtual function table is now an array of structures
+     which have the form { int16 offset, delta; void *pfn; }.  */
+  vtbl = value_primitive_field (arg1, 0, TYPE_VPTR_FIELDNO (context),
+				TYPE_VPTR_BASETYPE (context));
+
+  /* With older versions of g++, the vtbl field pointed to an array
+     of structures.  Nowadays it points directly to the structure. */
+  if (TYPE_CODE (VALUE_TYPE (vtbl)) == TYPE_CODE_PTR
+      && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (vtbl))) == TYPE_CODE_ARRAY)
+    {
+      /* Handle the case where the vtbl field points to an
+         array of structures. */
+      vtbl = value_ind (vtbl);
+
+      /* Index into the virtual function table.  This is hard-coded because
+         looking up a field is not cheap, and it may be important to save
+         time, e.g. if the user has set a conditional breakpoint calling
+         a virtual function.  */
+      entry = value_subscript (vtbl, vi);
+    }
+  else
+    {
+      /* Handle the case where the vtbl field points directly to a structure. */
+      vtbl = value_add (vtbl, vi);
+      entry = value_ind (vtbl);
+    }
+
+  entry_type = check_typedef (VALUE_TYPE (entry));
+
+  if (TYPE_CODE (entry_type) == TYPE_CODE_STRUCT)
+    {
+      /* Move the `this' pointer according to the virtual function table. */
+      VALUE_OFFSET (arg1) += value_as_long (value_field (entry, 0));
+
+      if (!VALUE_LAZY (arg1))
+	{
+	  VALUE_LAZY (arg1) = 1;
+	  value_fetch_lazy (arg1);
+	}
+
+      vfn = value_field (entry, 2);
+    }
+  else if (TYPE_CODE (entry_type) == TYPE_CODE_PTR)
+    vfn = entry;
+  else
+    error ("I'm confused:  virtual function table has bad type");
+  /* Reinstantiate the function pointer with the correct type.  */
+  VALUE_TYPE (vfn) = lookup_pointer_type (TYPE_FN_FIELD_TYPE (f, j));
+
+  *arg1p = arg1;
+  return vfn;
+}
+
+
+struct type *
+fpc_value_rtti_type (struct value *v, int *full, int *top, int *using_enc)
+{
+  struct type *known_type;
+  struct type *rtti_type;
+  CORE_ADDR coreptr;
+  struct value *vp;
+  long top_offset = 0;
+  char rtti_type_name[256];
+  CORE_ADDR vtbl;
+  struct minimal_symbol *minsym;
+  struct symbol *sym;
+  char *demangled_name;
+  char *mangled_name;
+  struct type *btype;
+
+  if (full)
+    *full = 0;
+  if (top)
+    *top = -1;
+  if (using_enc)
+    *using_enc = 0;
+
+  /* Get declared type */
+  known_type = VALUE_TYPE (v);
+  CHECK_TYPEDEF (known_type);
+  /* RTTI works only or class objects */
+  if (TYPE_CODE (known_type) != TYPE_CODE_CLASS)
+    return NULL;
+
+  /* Plan on this changing in the future as i get around to setting
+     the vtables properly for G++ compiled stuff.  Also, I'll be using
+     the type info functions, which are always right.  Deal with it
+     until then.  */
+
+  /* If the type has no vptr fieldno, try to get it filled in */
+  if (TYPE_VPTR_FIELDNO(known_type) < 0)
+    fill_in_vptr_fieldno(known_type);
+
+  /* If we still can't find one, give up */
+  if (TYPE_VPTR_FIELDNO(known_type) < 0)
+    return NULL;
+
+  /* Make sure our basetype and known type match, otherwise, cast
+     so we can get at the vtable properly.
+  */
+  btype = TYPE_VPTR_BASETYPE (known_type);
+  CHECK_TYPEDEF (btype);
+  if (btype != known_type )
+    {
+      v = value_cast (btype, v);
+      if (using_enc)
+        *using_enc=1;
+    }
+  /*
+    We can't use value_ind here, because it would want to use RTTI, and
+    we'd waste a bunch of time figuring out we already know the type.
+    Besides, we don't care about the type, just the actual pointer
+  */
+  if (VALUE_ADDRESS (value_field (v, TYPE_VPTR_FIELDNO (known_type))) == 0)
+    return NULL;
+
+  vtbl=value_as_address(value_ind(value_field(v,TYPE_VPTR_FIELDNO(known_type))));
+
+  /* Try to find a symbol that is the vtable */
+  minsym=lookup_minimal_symbol_by_pc(vtbl);
+  if (minsym==NULL
+      || (mangled_name=SYMBOL_NAME(minsym))==NULL
+      || !is_vtable_name (mangled_name))
+    return NULL;
+
+  /* If we just skip the prefix, we get screwed by namespaces */
+  if (strchr (mangled_name, '$'))
+    {
+      demangled_name = strchr (mangled_name, '$') + 2;
+    }
+  else
+    demangled_name = mangled_name;
+  /* Lookup the type for the name */
+  rtti_type=lookup_typename(demangled_name, (struct block *)0,1);
+
+  if (rtti_type==NULL)
+    return NULL;
+
+  if (TYPE_N_BASECLASSES(rtti_type) > 1 &&  full && (*full) != 1)
+    {
+      if (top)
+        *top=TYPE_BASECLASS_BITPOS(rtti_type,TYPE_VPTR_FIELDNO(rtti_type))/8;
+      if (top && ((*top) >0))
+        {
+          if (TYPE_LENGTH(rtti_type) > TYPE_LENGTH(known_type))
+            {
+              if (full)
+                *full=0;
+            }
+          else
+            {
+              if (full)
+                *full=1;
+            }
+        }
+    }
+  else
+    {
+      if (full)
+        *full=1;
+    }
+
+  return rtti_type;
+}
+
+/* Return true if the INDEXth field of TYPE is a virtual baseclass
+   pointer which is for the base class whose type is BASECLASS.  */
+
+static int
+vb_match (struct type *type, int index, struct type *basetype)
+{
+  struct type *fieldtype;
+  char *name = TYPE_FIELD_NAME (type, index);
+  char *field_class_name = NULL;
+
+  if (*name != '_')
+    return 0;
+  /* gcc 2.4 uses _vb$.  */
+  if (name[1] == 'v' && name[2] == 'b' && is_cplus_marker (name[3]))
+    field_class_name = name + 4;
+  /* gcc 2.5 will use __vb_.  */
+  if (name[1] == '_' && name[2] == 'v' && name[3] == 'b' && name[4] == '_')
+    field_class_name = name + 5;
+
+  if (field_class_name == NULL)
+    /* This field is not a virtual base class pointer.  */
+    return 0;
+
+  /* It's a virtual baseclass pointer, now we just need to find out whether
+     it is for this baseclass.  */
+  fieldtype = TYPE_FIELD_TYPE (type, index);
+  if (fieldtype == NULL
+      || TYPE_CODE (fieldtype) != TYPE_CODE_PTR)
+    /* "Can't happen".  */
+    return 0;
+
+  /* What we check for is that either the types are equal (needed for
+     nameless types) or have the same name.  This is ugly, and a more
+     elegant solution should be devised (which would probably just push
+     the ugliness into symbol reading unless we change the stabs format).  */
+  if (TYPE_TARGET_TYPE (fieldtype) == basetype)
+    return 1;
+
+  if (TYPE_NAME (basetype) != NULL
+      && TYPE_NAME (TYPE_TARGET_TYPE (fieldtype)) != NULL
+      && STREQ (TYPE_NAME (basetype),
+		TYPE_NAME (TYPE_TARGET_TYPE (fieldtype))))
+    return 1;
+  return 0;
+}
+
+/* Compute the offset of the baseclass which is
+   the INDEXth baseclass of class TYPE,
+   for value at VALADDR (in host) at ADDRESS (in target).
+   The result is the offset of the baseclass value relative
+   to (the address of)(ARG) + OFFSET.
+
+   -1 is returned on error. */
+
+int
+fpc_baseclass_offset (struct type *type, int index, char *valaddr,
+		  CORE_ADDR address)
+{
+  struct type *basetype = TYPE_BASECLASS (type, index);
+
+  if (BASETYPE_VIA_VIRTUAL (type, index))
+    {
+      /* Must hunt for the pointer to this virtual baseclass.  */
+      register int i, len = TYPE_NFIELDS (type);
+      register int n_baseclasses = TYPE_N_BASECLASSES (type);
+
+      /* First look for the virtual baseclass pointer
+         in the fields.  */
+      for (i = n_baseclasses; i < len; i++)
+	{
+	  if (vb_match (type, i, basetype))
+	    {
+	      CORE_ADDR addr
+	      = unpack_pointer (TYPE_FIELD_TYPE (type, i),
+				valaddr + (TYPE_FIELD_BITPOS (type, i) / 8));
+
+	      return addr - (LONGEST) address;
+	    }
+	}
+      /* Not in the fields, so try looking through the baseclasses.  */
+      for (i = index + 1; i < n_baseclasses; i++)
+	{
+	  int boffset =
+	  baseclass_offset (type, i, valaddr, address);
+	  if (boffset)
+	    return boffset;
+	}
+      /* Not found.  */
+      return -1;
+    }
+
+  /* Baseclass is easily computed.  */
+  return TYPE_BASECLASS_BITPOS (type, index) / 8;
+}
+
+static void
+init_fpc_ops (void)
+{
+  fpc_abi_ops.shortname = "fpc";
+  fpc_abi_ops.longname = "Free Pascal ABI";
+  fpc_abi_ops.doc = "Free Pascal v1.0 ABI";
+  fpc_abi_ops.is_destructor_name = fpc_is_destructor_name;
+  fpc_abi_ops.is_constructor_name = fpc_is_constructor_name;
+  fpc_abi_ops.is_vtable_name = fpc_is_vtable_name;
+  fpc_abi_ops.is_operator_name = fpc_is_operator_name;
+  fpc_abi_ops.virtual_fn_field = fpc_virtual_fn_field;
+  fpc_abi_ops.rtti_type = fpc_value_rtti_type;
+  fpc_abi_ops.baseclass_offset = fpc_baseclass_offset;
+}
+
+void
+_initialize_fpc_abi (void)
+{
+  init_fpc_ops ();
+  register_cp_abi (fpc_abi_ops);
+}
Index: minsyms.c
===================================================================
RCS file: /cvs/src/src/gdb/minsyms.c,v
retrieving revision 1.25
diff -u -p -r1.25 minsyms.c
--- minsyms.c	4 Feb 2003 18:07:01 -0000	1.25
+++ minsyms.c	17 Feb 2003 17:09:05 -0000
@@ -919,6 +919,12 @@ install_minimal_symbols (struct objfile 
 	for (i = 0; i < mcount; i++)
 	  {
 	    const char *name = SYMBOL_NAME (&objfile->msymbols[i]);
+	    if (strcmp (name, "fpc_compiled") == 0)
+	      {
+		switch_to_cp_abi ("fpc");
+		break;
+	      }
+	
 	    if (name[0] == '_' && name[1] == 'Z')
 	      {
 		switch_to_cp_abi ("gnu-v3");
Index: Makefile.in
===================================================================
RCS file: /cvs/src/src/gdb/Makefile.in,v
retrieving revision 1.331
diff -u -p -r1.331 Makefile.in
--- Makefile.in	14 Feb 2003 13:58:05 -0000	1.331
+++ Makefile.in	17 Feb 2003 17:09:06 -0000
@@ -518,7 +518,8 @@ SFILES = ada-exp.y ada-lang.c ada-typepr
 	dbxread.c demangle.c disasm.c doublest.c \
 	dummy-frame.c dwarfread.c dwarf2read.c \
 	elfread.c environ.c eval.c event-loop.c event-top.c expprint.c \
-	f-exp.y f-lang.c f-typeprint.c f-valprint.c findvar.c frame.c \
+	f-exp.y f-lang.c f-typeprint.c f-valprint.c findvar.c fpc-abi.c \
+	frame.c \
 	frame-unwind.c \
 	gdbarch.c arch-utils.c gdbtypes.c gnu-v2-abi.c gnu-v3-abi.c \
 	hpacc-abi.c \
@@ -851,7 +852,7 @@ COMMON_OBS = version.o blockframe.o brea
 	nlmread.o serial.o mdebugread.o top.o utils.o \
 	ui-file.o \
 	frame.o frame-unwind.o doublest.o \
-	gnu-v2-abi.o gnu-v3-abi.o hpacc-abi.o cp-abi.o cp-support.o \
+	fpc-abi.o gnu-v2-abi.o gnu-v3-abi.o hpacc-abi.o cp-abi.o cp-support.o \
 	reggroups.o
 
 OBS = $(COMMON_OBS) $(ANNOTATE_OBS)
@@ -1673,6 +1674,8 @@ findvar.o: findvar.c $(defs_h) $(symtab_
 fork-child.o: fork-child.c $(defs_h) $(gdb_string_h) $(frame_h) \
 	$(inferior_h) $(target_h) $(gdb_wait_h) $(gdb_vfork_h) $(gdbcore_h) \
 	$(terminal_h) $(gdbthread_h) $(command_h)
+fpc-abi.o: fpc-abi.c $(defs_h) $(gdb_string_h) $(symtab_h) \
+	$(gdbtypes_h) $(value_h) $(demangle_h) $(cp_abi_h)
 frame.o: frame.c $(defs_h) $(frame_h) $(target_h) $(value_h) $(inferior_h) \
 	$(regcache_h) $(gdb_assert_h) $(gdb_string_h) $(builtin_regs_h) \
 	$(gdb_obstack_h) $(dummy_frame_h) $(gdbcore_h) $(annotate_h) \

Re: [RFC] New file fpc-abi.c

[Daniel Jacobowitz]

On Mon, Feb 17, 2003 at 06:12:17PM +0100, Pierre Muller wrote:
>   This patch adds a new file fpc-abi.c
> to the gdb directory.
> 
>   The purpose of this file is rather clear:
> it allows to recognize Free Pascal compiled 
> objects and to handle ABI stuff in a more 
> adequate way.
> 
> Should I submit this in several RFA?
> 
> 
> ChangeLog entry:
> 
> 2003-02-17  Pierre Muller  <muller@ics.u-strasbg.fr>
> 
>         * fpc-abi.c: New file.
>         Implements Free Pascal specific ABI.
>         * minsyms.c (install_minimal_symbols): Recognize
>         Free Pascal compiled objects by the presence of
>         'fpc_compiled' minimal symbol.
>         * Makefile.in: Add fpc-abi.c compilation rules.

A lot of this file looks like it was just copied from one of the GNU
C++ ABI files.  Certainly the comments are now wrong.  Is a lot of the
code really appropriate?  i.e. does Free Pascal have the concept of an
RTTI type, or virtual functions, or operator names?

These are listed as C++ ABIs.  Adding one for Pascal feels dodgy.

-- 
Daniel Jacobowitz
MontaVista Software                         Debian GNU/Linux Developer

Re: [RFC] New file fpc-abi.c

[Pierre Muller]

At 18:31 17/02/2003, Daniel Jacobowitz wrote:
>On Mon, Feb 17, 2003 at 06:12:17PM +0100, Pierre Muller wrote:
>>   This patch adds a new file fpc-abi.c
>> to the gdb directory.
>> 
>>   The purpose of this file is rather clear:
>> it allows to recognize Free Pascal compiled 
>> objects and to handle ABI stuff in a more 
>> adequate way.
>> 
>> Should I submit this in several RFA?
>> 
>> 
>> ChangeLog entry:
>> 
>> 2003-02-17  Pierre Muller  <muller@ics.u-strasbg.fr>
>> 
>>         * fpc-abi.c: New file.
>>         Implements Free Pascal specific ABI.
>>         * minsyms.c (install_minimal_symbols): Recognize
>>         Free Pascal compiled objects by the presence of
>>         'fpc_compiled' minimal symbol.
>>         * Makefile.in: Add fpc-abi.c compilation rules.
>
>A lot of this file looks like it was just copied from one of the GNU
>C++ ABI files.  Certainly the comments are now wrong.  Is a lot of the
>code really appropriate?  i.e. does Free Pascal have the concept of an
>RTTI type, or virtual functions, or operator names?
>
>These are listed as C++ ABIs.  Adding one for Pascal feels dodgy.


Free Pascal does have most of these.

 - The pascal objects are a little bit different from 
the C++ classes, in the sense that they are basically 
struct that can (but do not always) have a
hidden field, that contains the address of a Virtual Method Table
i.e. a structure that contains information about
the virtual methods of the give object type.
- Free Pascal also knows Delphi like classes
which are more similar to C++ classes, in the sense
that they are just pointers to strucutures allocated on heap
in constructor calls.

- Run Time Type Information is also supported for 
Free Pascal classes, but I did not yet check this part of the code,
because I did never really use it until now.
My idea was that these parts can still be corrected after 
this file is in CVS.

 - operators are also supported in Free Pascal,
but the fpc_is_operator_name is not yet correctly implemented.

I should probably add explicit comments about the
state of the different funtions implemented in this file.


The fact that several functions are the same as in gnu-v2-abi.c
are due to the fact that, we I tried to add correct object/class 
debugging stabs generation, I tried to generate 
gnu-v2 compatible output.
This explains for instance that the is_(cons/des)tructor_name 
functions are the same.

fpc_is_vtable_name is completely Fre Pascal specific.
The other important point is that the recognition of 
Free Pascal compiled objects avoid to treat them as gnu-v3 
files, which can be the case with current head CVS GDB if they are linked together with
C files that use this ABI.
Indeed, the gnu-v3 code leads to crashes inside the GDB
code itself when trying to get class informations.

I do not claim that the fpc-abi.c is a completely correct code,
but:
  1) it avoids some internal GDB crashes when trying to debug executables
that contain both FPC and GNU C v3 generated code.
  2) It enhances the class recognition with respect to the gnu-v2
ABI.
  3) It is only used if the object has a fpc_compiled minimal symbol,
which should be enough to avoid any interference with other compiler, no?

Re: [RFC] New file fpc-abi.c

[Daniel Jacobowitz]

On Tue, Feb 18, 2003 at 09:13:28AM +0100, Pierre Muller wrote:
> At 18:31 17/02/2003, Daniel Jacobowitz wrote:
> >On Mon, Feb 17, 2003 at 06:12:17PM +0100, Pierre Muller wrote:
> >>   This patch adds a new file fpc-abi.c
> >> to the gdb directory.
> >> 
> >>   The purpose of this file is rather clear:
> >> it allows to recognize Free Pascal compiled 
> >> objects and to handle ABI stuff in a more 
> >> adequate way.
> >> 
> >> Should I submit this in several RFA?
> >> 
> >> 
> >> ChangeLog entry:
> >> 
> >> 2003-02-17  Pierre Muller  <muller@ics.u-strasbg.fr>
> >> 
> >>         * fpc-abi.c: New file.
> >>         Implements Free Pascal specific ABI.
> >>         * minsyms.c (install_minimal_symbols): Recognize
> >>         Free Pascal compiled objects by the presence of
> >>         'fpc_compiled' minimal symbol.
> >>         * Makefile.in: Add fpc-abi.c compilation rules.
> >
> >A lot of this file looks like it was just copied from one of the GNU
> >C++ ABI files.  Certainly the comments are now wrong.  Is a lot of the
> >code really appropriate?  i.e. does Free Pascal have the concept of an
> >RTTI type, or virtual functions, or operator names?
> >
> >These are listed as C++ ABIs.  Adding one for Pascal feels dodgy.
> 
> 
> Free Pascal does have most of these.
> 
>  - The pascal objects are a little bit different from 
> the C++ classes, in the sense that they are basically 
> struct that can (but do not always) have a
> hidden field, that contains the address of a Virtual Method Table
> i.e. a structure that contains information about
> the virtual methods of the give object type.
> - Free Pascal also knows Delphi like classes
> which are more similar to C++ classes, in the sense
> that they are just pointers to strucutures allocated on heap
> in constructor calls.
> 
> - Run Time Type Information is also supported for 
> Free Pascal classes, but I did not yet check this part of the code,
> because I did never really use it until now.
> My idea was that these parts can still be corrected after 
> this file is in CVS.
> 
>  - operators are also supported in Free Pascal,
> but the fpc_is_operator_name is not yet correctly implemented.
> 
> I should probably add explicit comments about the
> state of the different funtions implemented in this file.
> 
> 
> The fact that several functions are the same as in gnu-v2-abi.c
> are due to the fact that, we I tried to add correct object/class 
> debugging stabs generation, I tried to generate 
> gnu-v2 compatible output.
> This explains for instance that the is_(cons/des)tructor_name 
> functions are the same.
> 
> fpc_is_vtable_name is completely Fre Pascal specific.
> The other important point is that the recognition of 
> Free Pascal compiled objects avoid to treat them as gnu-v3 
> files, which can be the case with current head CVS GDB if they are linked together with
> C files that use this ABI.
> Indeed, the gnu-v3 code leads to crashes inside the GDB
> code itself when trying to get class informations.

Great, I recall you mentioning that v3 and FPC code can be linked
together.  Someday GDB will be ready for that....

> I do not claim that the fpc-abi.c is a completely correct code,
> but:
>   1) it avoids some internal GDB crashes when trying to debug executables
> that contain both FPC and GNU C v3 generated code.
>   2) It enhances the class recognition with respect to the gnu-v2
> ABI.
>   3) It is only used if the object has a fpc_compiled minimal symbol,
> which should be enough to avoid any interference with other compiler, no?

Could you remove or stub out the implementations which are incorrect
for FPC and repost it, please?

-- 
Daniel Jacobowitz
MontaVista Software                         Debian GNU/Linux Developer

Re: [RFC] New file fpc-abi.c

[Andrew Cagney]

> I do not claim that the fpc-abi.c is a completely correct code,
>> but:
>>   1) it avoids some internal GDB crashes when trying to debug executables
>> that contain both FPC and GNU C v3 generated code.
>>   2) It enhances the class recognition with respect to the gnu-v2
>> ABI.
>>   3) It is only used if the object has a fpc_compiled minimal symbol,
>> which should be enough to avoid any interference with other compiler, no?
> 
> 
> Could you remove or stub out the implementations which are incorrect
> for FPC and repost it, please?

Good case for internal_error().  Last thing gdb should do is print bogus 
info.

Andrew

[RFC 2nd] New file fpc-abi.c

[Pierre Muller]

[-- Attachment #1: Type: text/plain, Size: 681 bytes --]



 This is a second version of fpc-abi.c patch.
I tried to take into account all remarks I got.

I checked all functions inside fpc-abi.c,
modified most of them, removed part of the C++ specific code, 
but also left other parts,
because FPC could support such things later or because
C ++ classes might land there by error.


ChangeLog entry:

2003-02-17  Pierre Muller  <muller@ics.u-strasbg.fr>

        * fpc-abi.c: New file.
        Implements Free Pascal specific ABI.
        * minsyms.c (install_minimal_symbols): Recognize
        Free Pascal compiled objects by the presence of
        'fpc_compiled' minimal symbol.
        * Makefile.in: Add fpc-abi.c compilation rules.

[-- Attachment #2: fpc-abi.dif --]
[-- Type: text/plain, Size: 16986 bytes --]

Index: fpc-abi.c
===================================================================
RCS file: fpc-abi.c
diff -N fpc-abi.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ fpc-abi.c	19 Feb 2003 16:34:08 -0000
@@ -0,0 +1,471 @@
+/* Abstraction of FPC abi.
+   Contributed by Pierre Muller  <muller@ics.u-strasbg.fr>
+   Copyright 2003 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   This program is free software; you can redistribute it and/or
+   modify
+   it under the terms of the GNU General Public License as published
+   by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.  */
+
+#include "defs.h"
+#include "gdb_string.h"
+#include "symtab.h"
+#include "gdbtypes.h"
+#include "value.h"
+#include "demangle.h"
+#include "cp-abi.h"
+
+/* #include <ctype.h> */
+
+struct cp_abi_ops fpc_abi_ops;
+
+int fpc_baseclass_offset (struct type *type, int index, char *valaddr,
+			    CORE_ADDR address);
+
+/* 19-02-2003: Free Pascal only knows complete destructors.  */
+static enum dtor_kinds
+fpc_is_destructor_name (const char *name)
+{
+  if (strncmp (name, "__dt__", 6) == 0)
+    return complete_object_dtor;
+  else
+    return 0;
+}
+
+/* 19-02-2003: Free Pascal only knows complete constructors.  */
+static enum ctor_kinds
+fpc_is_constructor_name (const char *name)
+{
+  if (strncmp (name, "__ct__", 6) == 0)
+    return complete_object_ctor;
+  else
+    return 0;
+}
+
+/* Free Pascal Virtual Tables all have names beginning with VMT_,
+   and followed by the unitname '$_' and finally the type name.  */
+static int
+fpc_is_vtable_name (const char *name)
+{
+  return ((name)[0] == 'V'
+	  && (name)[1] == 'M'
+	  && (name)[2] == 'T'
+	  && (name)[3] == '_'
+	  && strstr (name, "$_"));
+}
+
+/* Free Pascal operators have specific prefixes.  */
+/* The generic name for operator oneop defined
+   in unit aunit is _AUNIT$$_oneop followed
+   by operator mangled arguments.  */
+static char *fpc_operator_names[] =
+{
+  "plus",
+  "minus",
+  "star",
+  "slash",
+  "equal",
+  "greater",
+  "lower",
+  "greater_or_equal",
+  "lower_or_equal",
+  "sym_diff",
+  "starstar",
+  "as",
+  "is",
+  "in",
+  "or",
+  "and",
+  "div",
+  "mod",
+  "not",
+  "shl",
+  "shr",
+  "xor",
+  "assign",
+  NULL};
+
+static int
+fpc_is_operator_name (const char *name)
+{
+  int i;
+  char * opname;
+  char *pos = strstr (name, "$$_");
+  if (!pos)
+    return 0;
+  pos+=3;
+  /* The Free Pascal operator list is defined in symtable unit.  */
+  i=0;
+  opname = fpc_operator_names[i];
+  while (opname)
+    {
+      if (strncmp (pos, opname, strlen (opname)) == 0)
+        return 1;
+      opname = fpc_operator_names[++i];
+    };
+  return 0;
+}
+
+\f
+/* Return a virtual function as a value.
+   ARG1 is the object which provides the virtual function
+   table pointer.  *ARG1P is side-effected in calling this function.
+   F is the list of member functions which contains the desired virtual
+   function.
+   J is an index into F which provides the desired virtual function.
+
+   TYPE is the type in which F is located.  */
+static struct value *
+fpc_virtual_fn_field (struct value **arg1p, struct fn_field * f, int j,
+			struct type * type, int offset)
+{
+  struct value *arg1 = *arg1p;
+  struct type *type1 = check_typedef (VALUE_TYPE (arg1));
+
+
+  struct type *entry_type;
+  /* First, get the virtual function table pointer.  That comes
+     with a strange type, so cast it to type `pointer to long' (which
+     should serve just fine as a function type).  Then, index into
+     the table, and convert final value to appropriate function type.  */
+  struct value *entry;
+  struct value *vfn;
+  struct value *vtbl;
+  struct value *vi = value_from_longest (builtin_type_int,
+				     (LONGEST) TYPE_FN_FIELD_VOFFSET (f, j));
+  struct type *fcontext = TYPE_FN_FIELD_FCONTEXT (f, j);
+  struct type *context;
+  if (fcontext == NULL)
+    /* We don't have an fcontext (e.g. the program was compiled with
+       g++ version 1).  Try to get the vtbl from the TYPE_VPTR_BASETYPE.
+       This won't work right for multiple inheritance, but at least we
+       should do as well as GDB 3.x did.  */
+    fcontext = TYPE_VPTR_BASETYPE (type);
+  context = lookup_pointer_type (fcontext);
+  /* Now context is a pointer to the basetype containing the vtbl.  */
+  if (TYPE_TARGET_TYPE (context) != type1)
+    {
+      struct value *tmp = value_cast (context, value_addr (arg1));
+      arg1 = value_ind (tmp);
+      type1 = check_typedef (VALUE_TYPE (arg1));
+    }
+
+  context = type1;
+  /* Now context is the basetype containing the vtbl.  */
+
+  /* This type may have been defined before its virtual function table
+     was.  If so, fill in the virtual function table entry for the
+     type now.  */
+  if (TYPE_VPTR_FIELDNO (context) < 0)
+    fill_in_vptr_fieldno (context);
+
+  /* The virtual function table is now an array of structures
+     which have the form { int16 offset, delta; void *pfn; }.  */
+  vtbl = value_primitive_field (arg1, 0, TYPE_VPTR_FIELDNO (context),
+				TYPE_VPTR_BASETYPE (context));
+
+  /* With older versions of g++, the vtbl field pointed to an array
+     of structures.  Nowadays it points directly to the structure. */
+  if (TYPE_CODE (VALUE_TYPE (vtbl)) == TYPE_CODE_PTR
+      && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (vtbl))) == TYPE_CODE_ARRAY)
+    {
+      /* Handle the case where the vtbl field points to an
+         array of structures. */
+      vtbl = value_ind (vtbl);
+
+      /* Index into the virtual function table.  This is hard-coded because
+         looking up a field is not cheap, and it may be important to save
+         time, e.g. if the user has set a conditional breakpoint calling
+         a virtual function.  */
+      entry = value_subscript (vtbl, vi);
+    }
+  else
+    {
+      /* Handle the case where the vtbl field points directly to a structure. */
+      vtbl = value_add (vtbl, vi);
+      entry = value_ind (vtbl);
+    }
+
+  entry_type = check_typedef (VALUE_TYPE (entry));
+
+  if (TYPE_CODE (entry_type) == TYPE_CODE_STRUCT)
+    {
+      /* Move the `this' pointer according to the virtual function table. */
+      VALUE_OFFSET (arg1) += value_as_long (value_field (entry, 0));
+
+      if (!VALUE_LAZY (arg1))
+	{
+	  VALUE_LAZY (arg1) = 1;
+	  value_fetch_lazy (arg1);
+	}
+
+      vfn = value_field (entry, 2);
+    }
+  else if (TYPE_CODE (entry_type) == TYPE_CODE_PTR)
+    vfn = entry;
+  else
+    error ("I'm confused:  virtual function table has bad type");
+  /* Reinstantiate the function pointer with the correct type.  */
+  VALUE_TYPE (vfn) = lookup_pointer_type (TYPE_FN_FIELD_TYPE (f, j));
+
+  *arg1p = arg1;
+  return vfn;
+}
+
+/* Free Pascal specific way of finding the real type of a class:
+   Search the VMT field which points to the virtual method table
+   which minimal symbol name contains the real type name.  */
+struct type *
+fpc_value_rtti_type (struct value *v, int *full, int *top, int *using_enc)
+{
+  struct type *known_type;
+  struct type *rtti_type;
+  CORE_ADDR coreptr;
+  struct value *vp;
+  long top_offset = 0;
+  char rtti_type_name[256];
+  CORE_ADDR vtbl;
+  struct minimal_symbol *minsym;
+  struct symbol *sym;
+  char *demangled_name;
+  char *mangled_name;
+  struct type *btype;
+
+  if (full)
+    *full = 0;
+  if (top)
+    *top = -1;
+  if (using_enc)
+    *using_enc = 0;
+
+  /* Get declared type */
+  known_type = VALUE_TYPE (v);
+  CHECK_TYPEDEF (known_type);
+  /* RTTI works only or class objects */
+  if (TYPE_CODE (known_type) != TYPE_CODE_CLASS)
+    return NULL;
+
+  /* Plan on this changing in the future as i get around to setting
+     the vtables properly for G++ compiled stuff.  Also, I'll be using
+     the type info functions, which are always right.  Deal with it
+     until then.  */
+
+  /* If the type has no vptr fieldno, try to get it filled in */
+  if (TYPE_VPTR_FIELDNO(known_type) < 0)
+    fill_in_vptr_fieldno(known_type);
+
+  /* If we still can't find one, give up */
+  if (TYPE_VPTR_FIELDNO(known_type) < 0)
+    return NULL;
+
+  /* Make sure our basetype and known type match, otherwise, cast
+     so we can get at the vtable properly.
+  */
+  btype = TYPE_VPTR_BASETYPE (known_type);
+  CHECK_TYPEDEF (btype);
+  if (btype != known_type )
+    {
+      v = value_cast (btype, v);
+      if (using_enc)
+        *using_enc=1;
+    }
+  /*
+    We can't use value_ind here, because it would want to use RTTI, and
+    we'd waste a bunch of time figuring out we already know the type.
+    Besides, we don't care about the type, just the actual pointer
+  */
+  if (VALUE_ADDRESS (value_field (v, TYPE_VPTR_FIELDNO (known_type))) == 0)
+    return NULL;
+
+  vtbl=value_as_address(value_ind(value_field(v,TYPE_VPTR_FIELDNO(known_type))));
+
+  /* Try to find a symbol that is the vtable.
+     The minsym of a vtbl for Free Pascal 
+     type named classname defined in unit unitname 
+     is VMT_UNITNAME$_CLASSNAME.  */
+  minsym=lookup_minimal_symbol_by_pc(vtbl);
+  if (minsym==NULL
+      || (mangled_name=SYMBOL_NAME(minsym))==NULL
+      || !is_vtable_name (mangled_name))
+    return NULL;
+
+  /* Skip past the "$_" position.  */
+  if (strstr (mangled_name, "$_"))
+    {
+      demangled_name = strstr (mangled_name, "$_") + 2;
+    }
+  else
+    demangled_name = mangled_name;
+  /* Lookup the type for the name.  */
+  rtti_type=lookup_typename(demangled_name, (struct block *)0,1);
+
+  if (rtti_type==NULL)
+    return NULL;
+
+  /* Free Pascal supports only one base class,
+     but lets leave this here as a C++ class might 
+     it this code.  */
+
+  if (TYPE_N_BASECLASSES(rtti_type) > 1 &&  full && (*full) != 1)
+    {
+      if (top)
+        *top=TYPE_BASECLASS_BITPOS(rtti_type,TYPE_VPTR_FIELDNO(rtti_type))/8;
+      if (top && ((*top) >0))
+        {
+          if (TYPE_LENGTH(rtti_type) > TYPE_LENGTH(known_type))
+            {
+              if (full)
+                *full=0;
+            }
+          else
+            {
+              if (full)
+                *full=1;
+            }
+        }
+    }
+  else
+    {
+      if (full)
+        *full=1;
+    }
+
+  return rtti_type;
+}
+
+/* Return true if the INDEXth field of TYPE is a virtual baseclass
+   pointer which is for the base class whose type is BASECLASS.
+   19-02-2003: Free Pascal does not support virtual base classes.  
+   Leave that code active in case a C++ class lost its way here.  */
+
+static int
+vb_match (struct type *type, int index, struct type *basetype)
+{
+  struct type *fieldtype;
+  char *name = TYPE_FIELD_NAME (type, index);
+  char *field_class_name = NULL;
+
+  if (*name != '_')
+    return 0;
+  /* gcc 2.4 uses _vb$.  */
+  if (name[1] == 'v' && name[2] == 'b' && is_cplus_marker (name[3]))
+    field_class_name = name + 4;
+  /* gcc 2.5 will use __vb_.  */
+  if (name[1] == '_' && name[2] == 'v' && name[3] == 'b' && name[4] == '_')
+    field_class_name = name + 5;
+
+  if (field_class_name == NULL)
+    /* This field is not a virtual base class pointer.  */
+    return 0;
+
+  /* It's a virtual baseclass pointer, now we just need to find out whether
+     it is for this baseclass.  */
+  fieldtype = TYPE_FIELD_TYPE (type, index);
+  if (fieldtype == NULL
+      || TYPE_CODE (fieldtype) != TYPE_CODE_PTR)
+    /* "Can't happen".  */
+    return 0;
+
+  /* What we check for is that either the types are equal (needed for
+     nameless types) or have the same name.  This is ugly, and a more
+     elegant solution should be devised (which would probably just push
+     the ugliness into symbol reading unless we change the stabs format).  */
+  if (TYPE_TARGET_TYPE (fieldtype) == basetype)
+    return 1;
+
+  if (TYPE_NAME (basetype) != NULL
+      && TYPE_NAME (TYPE_TARGET_TYPE (fieldtype)) != NULL
+      && STREQ (TYPE_NAME (basetype),
+		TYPE_NAME (TYPE_TARGET_TYPE (fieldtype))))
+    return 1;
+  return 0;
+}
+
+/* Compute the offset of the baseclass which is
+   the INDEXth baseclass of class TYPE,
+   for value at VALADDR (in host) at ADDRESS (in target).
+   The result is the offset of the baseclass value relative
+   to (the address of)(ARG) + OFFSET.
+
+   -1 is returned on error. */
+
+int
+fpc_baseclass_offset (struct type *type, int index, char *valaddr,
+		  CORE_ADDR address)
+{
+  struct type *basetype = TYPE_BASECLASS (type, index);
+
+  if (BASETYPE_VIA_VIRTUAL (type, index))
+    {
+      /* Must hunt for the pointer to this virtual baseclass.  */
+      register int i, len = TYPE_NFIELDS (type);
+      register int n_baseclasses = TYPE_N_BASECLASSES (type);
+
+      /* Free Pascal does not support virtual base classes.  */
+      /* First look for the virtual baseclass pointer
+         in the fields.  */
+      for (i = n_baseclasses; i < len; i++)
+	{
+	  if (vb_match (type, i, basetype))
+	    {
+	      warning ("Free Pascal does not support virtual base classes");
+	      /* But it might be a C++ class.  */
+	      CORE_ADDR addr
+	      = unpack_pointer (TYPE_FIELD_TYPE (type, i),
+				valaddr + (TYPE_FIELD_BITPOS (type, i) / 8));
+
+	      return addr - (LONGEST) address;
+	    }
+	}
+
+      /* Not in the fields, so try looking through the baseclasses.  */
+      for (i = index + 1; i < n_baseclasses; i++)
+	{
+	  int boffset =
+	  baseclass_offset (type, i, valaddr, address);
+	  if (boffset)
+	    return boffset;
+	}
+      /* Not found.  */
+      return -1;
+    }
+
+  /* Baseclass is easily computed.  */
+  return TYPE_BASECLASS_BITPOS (type, index) / 8;
+}
+
+static void
+init_fpc_ops (void)
+{
+  fpc_abi_ops.shortname = "fpc";
+  fpc_abi_ops.longname = "Free Pascal ABI";
+  fpc_abi_ops.doc = "Free Pascal v1.0 ABI";
+  fpc_abi_ops.is_destructor_name = fpc_is_destructor_name;
+  fpc_abi_ops.is_constructor_name = fpc_is_constructor_name;
+  fpc_abi_ops.is_vtable_name = fpc_is_vtable_name;
+  fpc_abi_ops.is_operator_name = fpc_is_operator_name;
+  fpc_abi_ops.virtual_fn_field = fpc_virtual_fn_field;
+  fpc_abi_ops.rtti_type = fpc_value_rtti_type;
+  fpc_abi_ops.baseclass_offset = fpc_baseclass_offset;
+}
+
+void
+_initialize_fpc_abi (void)
+{
+  init_fpc_ops ();
+  register_cp_abi (fpc_abi_ops);
+}
Index: minsyms.c
===================================================================
RCS file: /cvs/src/src/gdb/minsyms.c,v
retrieving revision 1.25
diff -u -p -r1.25 minsyms.c
--- minsyms.c	4 Feb 2003 18:07:01 -0000	1.25
+++ minsyms.c	19 Feb 2003 16:34:09 -0000
@@ -919,6 +919,12 @@ install_minimal_symbols (struct objfile 
 	for (i = 0; i < mcount; i++)
 	  {
 	    const char *name = SYMBOL_NAME (&objfile->msymbols[i]);
+	    if (strcmp (name, "fpc_compiled") == 0)
+	      {
+		switch_to_cp_abi ("fpc");
+		break;
+	      }
+	
 	    if (name[0] == '_' && name[1] == 'Z')
 	      {
 		switch_to_cp_abi ("gnu-v3");
Index: Makefile.in
===================================================================
RCS file: /cvs/src/src/gdb/Makefile.in,v
retrieving revision 1.332
diff -u -p -r1.332 Makefile.in
--- Makefile.in	18 Feb 2003 23:27:42 -0000	1.332
+++ Makefile.in	19 Feb 2003 16:34:09 -0000
@@ -518,7 +518,8 @@ SFILES = ada-exp.y ada-lang.c ada-typepr
 	dbxread.c demangle.c disasm.c doublest.c \
 	dummy-frame.c dwarfread.c dwarf2read.c \
 	elfread.c environ.c eval.c event-loop.c event-top.c expprint.c \
-	f-exp.y f-lang.c f-typeprint.c f-valprint.c findvar.c frame.c \
+	f-exp.y f-lang.c f-typeprint.c f-valprint.c findvar.c fpc-abi.c \
+	frame.c \
 	frame-unwind.c \
 	gdbarch.c arch-utils.c gdbtypes.c gnu-v2-abi.c gnu-v3-abi.c \
 	hpacc-abi.c \
@@ -851,7 +852,7 @@ COMMON_OBS = version.o blockframe.o brea
 	nlmread.o serial.o mdebugread.o top.o utils.o \
 	ui-file.o \
 	frame.o frame-unwind.o doublest.o \
-	gnu-v2-abi.o gnu-v3-abi.o hpacc-abi.o cp-abi.o cp-support.o \
+	fpc-abi.o gnu-v2-abi.o gnu-v3-abi.o hpacc-abi.o cp-abi.o cp-support.o \
 	reggroups.o
 
 OBS = $(COMMON_OBS) $(ANNOTATE_OBS)
@@ -1673,6 +1674,8 @@ findvar.o: findvar.c $(defs_h) $(symtab_
 fork-child.o: fork-child.c $(defs_h) $(gdb_string_h) $(frame_h) \
 	$(inferior_h) $(target_h) $(gdb_wait_h) $(gdb_vfork_h) $(gdbcore_h) \
 	$(terminal_h) $(gdbthread_h) $(command_h)
+fpc-abi.o: fpc-abi.c $(defs_h) $(gdb_string_h) $(symtab_h) \
+	$(gdbtypes_h) $(value_h) $(demangle_h) $(cp_abi_h)
 frame.o: frame.c $(defs_h) $(frame_h) $(target_h) $(value_h) $(inferior_h) \
 	$(regcache_h) $(gdb_assert_h) $(gdb_string_h) $(builtin_regs_h) \
 	$(gdb_obstack_h) $(dummy_frame_h) $(gdbcore_h) $(annotate_h) \

Re: [RFC 2nd] New file fpc-abi.c

[Daniel Jacobowitz]

On Wed, Feb 19, 2003 at 05:38:49PM +0100, Pierre Muller wrote:
> 
> 
>  This is a second version of fpc-abi.c patch.
> I tried to take into account all remarks I got.
> 
> I checked all functions inside fpc-abi.c,
> modified most of them, removed part of the C++ specific code, 
> but also left other parts,
> because FPC could support such things later or because
> C ++ classes might land there by error.

C++ classes should not land there by error.  Please don't.  If you want
to support debugging FPC code linked to C++ code, then eventually we
will need to support different ABIs per compilation unit.  Until then,
the user is responsible for specifying the right one.

And it's just as likely it will be GCC v3 as v2, so leaving the v2 code
there is not useful.

> +   This program is free software; you can redistribute it and/or
> +   modify
> +   it under the terms of the GNU General Public License as published
> +   by

Your line wrapping is all messed up.  Please run this through
gdb_indent.sh, and then eyeball it to make sure things look right.

> +/* #include <ctype.h> */

That should be removed.

> +/* 19-02-2003: Free Pascal only knows complete destructors.  */

Please use ISO dates, since they're less ambiguous.  That would be
2003-02-19.

> +    /* We don't have an fcontext (e.g. the program was compiled with
> +       g++ version 1).  Try to get the vtbl from the TYPE_VPTR_BASETYPE.
> +       This won't work right for multiple inheritance, but at least we
> +       should do as well as GDB 3.x did.  */

Comments to g++ version 1 and GDB 3.x shouldn't be in a new file for
Free Pascal support in GDB 5.4.  If this code isn't appropriate for
Free Pascal it should be deleted or replaced with an error.

> +/* Return true if the INDEXth field of TYPE is a virtual baseclass
> +   pointer which is for the base class whose type is BASECLASS.
> +   19-02-2003: Free Pascal does not support virtual base classes.  
> +   Leave that code active in case a C++ class lost its way here.  */

Ditto.

> +      /* Free Pascal does not support virtual base classes.  */
> +      /* First look for the virtual baseclass pointer
> +         in the fields.  */

Then the code shouldn't be here.

Would you mind fixing those and reposting it?  Then I can look at the
actual code more closely.  I'm still thinking about the issues involved
in using the "current C++ ABI" to handle "Free Pascal".  I guess it'll
work...

-- 
Daniel Jacobowitz
MontaVista Software                         Debian GNU/Linux Developer