PATCH: Unify pascal string printing

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

This is the follow up of
http://sources.redhat.com/ml/gdb/2001-11/msg00062.html

    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.

   I got several remarks from Andrew that
helped me to generate a better fromatted patch.
Thanks Andrew.

  This is applied to both 5.1 and main branch.
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-lang.h: Add prototype for is_pascal_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 -r1.3 p-lang.c
20c20
< /* This file is derived from p-lang.c */
---
 > /* This file is derived from c-lang.c */
30c30,31
<
---
 > #include <ctype.h>
 >
31a33,79
 >
 >
 > /* 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;
 > }
 >
Index: p-lang.h
===================================================================
RCS file: /cvs/src/src/gdb/p-lang.h,v
retrieving revision 1.2
diff -r1.2 p-lang.h
40a41,42
 > extern int is_pascal_string_type (struct type *, int *, int *, int *, int*);
 >
Index: p-valprint.c
===================================================================
RCS file: /cvs/src/src/gdb/p-valprint.c,v
retrieving revision 1.4
diff -r1.4 p-valprint.c
65a66,67
 >   int length_pos, length_size, string_pos;
 >   int char_size;
190,195c192,194
< 	  /* 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)
197,199c196,202
< 	      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);
208,209c211,212
< 	      if ((msymbol != NULL) &&
< 		  (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
---
 > 	      if ((msymbol != NULL)
 > 		  && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
318,320c321,322
< 	  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))
322,323c324,325
< 	      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);


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