[RFA] Unify pascal string printing

[Pierre Muller <muller at cerbere dot u-strasbg dot fr>]

    This change will allow to display GPC stings nicely as Free Pascal
strings are already. The method is pretty generic and adding new types
(widestings or ansistrings) should be easy.

ChangeLog:
    2001-11-06 Pierre Muller  <muller@ics.u-strasbg.fr>

	* p-lang.c (is_pascal_string_type): new function to determine if a type is 
a string type.
	*  p-valprint.c (pascal_val_print) : use is_pascal_string_type function to 
display strings nicely.


Index: p-lang.c
===================================================================
RCS file: /cvs/src/src/gdb/p-lang.c,v
retrieving revision 1.3
diff -u -r1.3 p-lang.c
--- p-lang.c    2000/08/11 01:02:35     1.3
+++ p-lang.c    2001/11/06 16:02:53
@@ -17,7 +17,7 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/

-/* This file is derived from p-lang.c */
+/* This file is derived from c-lang.c */

  #include "defs.h"
  #include "symtab.h"
@@ -27,8 +27,56 @@
  #include "language.h"
  #include "p-lang.h"
  #include "valprint.h"
-
+#include <ctype.h>
+
  extern void _initialize_pascal_language (void);
+
+
+/* Determines if type TYPE is a pascal string type.
+   Returns 1 if the type is a known pascal type
+   This function is used by p-valprint.c code to allow better string display.
+   If it is a pascal string type, then it also sets info needed
+   to get the length and the data of the string
+   length_pos, length_size and string_pos are given in bytes.
+   char_size gives the element size in bytes.
+   FIXME: if the position or the size of these fields
+   are not multiple of TARGET_CHAR_BIT then the results are wrong
+   but this does not happen for Free Pascal nor for GPC */
+int
+is_pascal_string_type (struct type *type,int *length_pos,
+                       int * length_size, int *string_pos, int *char_size)
+{
+  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+    {
+      /* Old Borland type pascal strings from Free Pascal Compiler */
+      /* Two fields: length and st */
+      if (TYPE_NFIELDS (type) == 2 &&
+          strcmp (TYPE_FIELDS (type)[0].name, "length") == 0 &&
+          strcmp (TYPE_FIELDS (type)[1].name, "st") == 0)
+        {
+          *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT;
+          *length_size = TYPE_FIELD_TYPE (type, 0)->length;
+          *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
+          *char_size = 1;
+          return 1;
+        };
+      /* GNU pascal strings */
+      /* Three fields: Capacity, length and schema$ or _p_schema */
+      if (TYPE_NFIELDS (type) == 3 &&
+          strcmp (TYPE_FIELDS (type)[0].name, "Capacity") == 0 &&
+          strcmp (TYPE_FIELDS (type)[1].name, "length") == 0)
+        {
+          *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
+          *length_size = TYPE_FIELD_TYPE (type, 1)->length;
+          *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT;
+          /* FIXME: how can I detect wide chars in GPC ?? */
+          *char_size = 1;
+          return 1;
+        };
+    }
+  return 0;
+}
+
  static void pascal_one_char (int, struct ui_file *, int *);

  /* Print the character C on STREAM as part of the contents of a literal
Index: p-valprint.c
===================================================================
RCS file: /cvs/src/src/gdb/p-valprint.c,v
retrieving revision 1.4
diff -u -r1.4 p-valprint.c
--- p-valprint.c        2001/03/27 20:36:24     1.4
+++ p-valprint.c        2001/11/06 16:02:53
@@ -40,6 +40,7 @@



+
  /* Print data of type TYPE located at VALADDR (within GDB), which came from
     the inferior at address ADDRESS, onto stdio stream STREAM according to
     FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
@@ -53,7 +54,6 @@

     The PRETTY parameter controls prettyprinting.  */

-
  int
  pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
                   CORE_ADDR address, struct ui_file *stream, int format,
@@ -63,6 +63,8 @@
    unsigned len;
    struct type *elttype;
    unsigned eltlen;
+  int length_pos, length_size, string_pos;
+  int char_size;
    LONGEST val;
    CORE_ADDR addr;

@@ -188,15 +190,17 @@
              Pascal strings are mapped to records
              with lowercase names PM  */
           /* I don't know what GPC does :( PM */
-         if (TYPE_CODE (elttype) == TYPE_CODE_STRUCT &&
-             TYPE_NFIELDS (elttype) == 2 &&
-             strcmp (TYPE_FIELDS (elttype)[0].name, "length") == 0 &&
-             strcmp (TYPE_FIELDS (elttype)[1].name, "st") == 0 &&
-             addr != 0)
+          if ( is_pascal_string_type (elttype, &length_pos,
+                                    &length_size, &string_pos, &char_size) &&
+              addr != 0)
             {
-             char bytelength;
-             read_memory (addr, &bytelength, 1);
-             i = val_print_string (addr + 1, bytelength, 1, stream);
+             ULONGEST string_length;
+              void *buffer;
+              buffer = xmalloc(length_size);
+              read_memory(addr + length_pos, buffer, length_size);
+             string_length = extract_unsigned_integer (buffer, length_size);
+              xfree(buffer);
+              i = val_print_string (addr + string_pos, string_length, 
char_size
, stream);
             }
           else if (pascal_object_is_vtbl_member (type))
             {
@@ -315,12 +319,11 @@
         }
        else
         {
-         if ((TYPE_NFIELDS (type) == 2) &&
-             (strcmp (TYPE_FIELDS (type)[0].name, "length") == 0) &&
-             (strcmp (TYPE_FIELDS (type)[1].name, "st") == 0))
+          if ( is_pascal_string_type (type, &length_pos, &length_size,
+                                      &string_pos, &char_size))
             {
-             len = (*(valaddr + embedded_offset)) & 0xff;
-             LA_PRINT_STRING (stream, valaddr + embedded_offset + 1, len, 
/* width ?? */ 0, 0);
+             len = extract_unsigned_integer(valaddr + embedded_offset + 
length_pos, length_size);
+             LA_PRINT_STRING (stream, valaddr + embedded_offset + 
string_pos, len, char_size, 0);
             }
           else
             pascal_object_print_value_fields (type, valaddr + 
embedded_offset, address, stream, format,



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