[Commit] gdb/pascal language 2 or 4 byte char support in strings

[Commit] gdb/pascal language 2 or 4 byte char support in strings

[Pierre Muller]

  I committed the patch below to add
support for fixed width chars
greater than 1 for pascal language.

  This works nicely for Free Pascal,
I couldn't test it for GPC
because I didn't find out if those kind of
char are supported...


Pierre Muller
Pascal language support maintainer for GDB




ChangeLog entry:

2009-02-08  Pierre Muller  <muller@ics.u-strasbg.fr>

	* p-lang.c (is_pascal_string_type): Fix comment.
	Determine exact size of char elements for GPC
	strings.
	(pascal_printstr): Handle char width of 2 or 4.
	* p-valprint.c (pascal_val_print): Handle char
	of width 2 or 4.
	
	
Index: gdb/p-lang.c
===================================================================
RCS file: /cvs/src/src/gdb/p-lang.c,v
retrieving revision 1.45
diff -u -p -r1.45 p-lang.c
--- gdb/p-lang.c	5 Feb 2009 12:16:25 -0000	1.45
+++ gdb/p-lang.c	9 Feb 2009 23:54:58 -0000
@@ -86,7 +86,7 @@ pascal_main_name (void)
 }
 
 /* Determines if type TYPE is a pascal string type.
-   Returns 1 if the type is a known pascal type
+   Returns a positive value if the type is a known pascal string 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
@@ -126,14 +126,20 @@ is_pascal_string_type (struct type *type
           && strcmp (TYPE_FIELDS (type)[0].name, "Capacity") == 0
           && strcmp (TYPE_FIELDS (type)[1].name, "length") == 0)
         {
-          if (length_pos)
+	  struct type *char_type;
+	  if (length_pos)
 	    *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
-          if (length_size)
+	  if (length_size)
 	    *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1));
-          if (string_pos)
+	  if (string_pos)
 	    *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT;
           /* FIXME: how can I detect wide chars in GPC ?? */
-          if (char_size)
+	  char_type = TYPE_FIELD_TYPE (type,2);
+	  if (char_size && TYPE_CODE (char_type) == TYPE_CODE_ARRAY)
+	    {
+	      *char_size = TYPE_LENGTH (TYPE_TARGET_TYPE (char_type));
+	    }
+	  else if (char_size)
 	    *char_size = 1;
  	  if (arrayname)
 	    *arrayname = TYPE_FIELDS (type)[2].name;
@@ -218,7 +224,8 @@ pascal_printstr (struct ui_file *stream,
   /* If the string was not truncated due to `set print elements', and
      the last byte of it is a null, we don't print that, in traditional C
      style.  */
-  if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
+  if ((!force_ellipses) && length > 0
+	&& extract_unsigned_integer (string + (length - 1) * width, width)
== 0)
     length--;
 
   if (length == 0)
@@ -234,6 +241,7 @@ pascal_printstr (struct ui_file *stream,
       unsigned int rep1;
       /* Number of repetitions we have detected so far.  */
       unsigned int reps;
+      unsigned long int current_char;
 
       QUIT;
 
@@ -243,9 +251,13 @@ pascal_printstr (struct ui_file *stream,
 	  need_comma = 0;
 	}
 
+      current_char = extract_unsigned_integer (string + i * width, width);
+
       rep1 = i + 1;
       reps = 1;
-      while (rep1 < length && string[rep1] == string[i])
+      while (rep1 < length 
+	     && extract_unsigned_integer (string + rep1 * width, width) 
+		== current_char)
 	{
 	  ++rep1;
 	  ++reps;
@@ -261,7 +273,7 @@ pascal_printstr (struct ui_file *stream,
 		fputs_filtered ("', ", stream);
 	      in_quotes = 0;
 	    }
-	  pascal_printchar (string[i], stream);
+	  pascal_printchar (current_char, stream);
 	  fprintf_filtered (stream, " <repeats %u times>", reps);
 	  i = rep1 - 1;
 	  things_printed += options->repeat_count_threshold;
@@ -269,8 +281,7 @@ pascal_printstr (struct ui_file *stream,
 	}
       else
 	{
-	  int c = string[i];
-	  if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
+	  if ((!in_quotes) && (PRINT_LITERAL_FORM (current_char)))
 	    {
 	      if (options->inspect_it)
 		fputs_filtered ("\\'", stream);
@@ -278,7 +289,7 @@ pascal_printstr (struct ui_file *stream,
 		fputs_filtered ("'", stream);
 	      in_quotes = 1;
 	    }
-	  pascal_one_char (c, stream, &in_quotes);
+	  pascal_one_char (current_char, stream, &in_quotes);
 	  ++things_printed;
 	}
     }
Index: gdb/p-valprint.c
===================================================================
RCS file: /cvs/src/src/gdb/p-valprint.c,v
retrieving revision 1.59
diff -u -p -r1.59 p-valprint.c
--- gdb/p-valprint.c	3 Jan 2009 05:57:52 -0000	1.59
+++ gdb/p-valprint.c	9 Feb 2009 23:54:58 -0000
@@ -79,7 +79,7 @@ pascal_val_print (struct type *type, con
 	      print_spaces_filtered (2 + 2 * recurse, stream);
 	    }
 	  /* For an array of chars, print with string syntax.  */
-	  if (eltlen == 1 
+	  if ((eltlen == 1 || eltlen == 2 || eltlen == 4)
 	      && ((TYPE_CODE (elttype) == TYPE_CODE_INT)
 	       || ((current_language->la_language == language_pascal)
 		   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
@@ -93,14 +93,15 @@ pascal_val_print (struct type *type, con
 
 		  /* Look for a NULL char. */
 		  for (temp_len = 0;
-		       (valaddr + embedded_offset)[temp_len]
+		       extract_unsigned_integer (valaddr + embedded_offset +
+						 temp_len * eltlen, eltlen)
 		       && temp_len < len && temp_len < options->print_max;
 		       temp_len++);
 		  len = temp_len;
 		}
 
-	      LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0,
-			       options);
+	      LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 
+			       eltlen, 0, options);
 	      i = len;
 	    }
 	  else
@@ -165,14 +166,17 @@ pascal_val_print (struct type *type, con
 
 	  /* For a pointer to char or unsigned char, also print the string
 	     pointed to, unless pointer is null.  */
-	  if (TYPE_LENGTH (elttype) == 1
-	      && (TYPE_CODE (elttype) == TYPE_CODE_INT
-		  || TYPE_CODE(elttype) == TYPE_CODE_CHAR)
+	  if (((TYPE_LENGTH (elttype) == 1
+	       && (TYPE_CODE (elttype) == TYPE_CODE_INT
+		  || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
+	      || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
+		  && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 	      && (options->format == 0 || options->format == 's')
 	      && addr != 0)
 	    {
 	      /* no wide string yet */
-	      i = val_print_string (addr, -1, 1, stream, options);
+	      i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream,

+		    options);
 	    }
 	  /* also for pointers to pascal strings */
 	  /* Note: this is Free Pascal specific:

Re: [Commit] gdb/pascal language 2 or 4 byte char support in strings

[Jonas Maebe]

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


On 10 Feb 2009, at 01:15, Pierre Muller wrote:

>  I committed the patch below to add
> support for fixed width chars
> greater than 1 for pascal language.
>
>  This works nicely for Free Pascal,
> I couldn't test it for GPC
> because I didn't find out if those kind of
> char are supported...

Hi Pierre,

A while ago I wrote a similar patch. I didn't submit it yet because I  
didn't find time to write explanations why I did everything and on  
writing test cases for all changes.

Anyway, it's in attachment (it's against the p-*.c files before your  
patch though). Some comments:
* pascal-dwarf-char.patch:
This one is independent from and complementary to your patch : it  
properly sets the TYPE_CODE DW_ATE_signed_char/DW_ATE_unsigned_char to  
TYPE_CODE_CHAR in case of Pascal (rather than only for Ada and Modula-2)

* pascalchar.patch:
a) I removed all situations in the Pascal string handling where  
"TYPE_CODE (elttype) == TYPE_CODE_INT" is interpreted as a character.  
I don't know the original reason for having it there though, but maybe  
it was because of the lack of a)? At least the stabs debug info of  
both FPC and GPC results in a char (negative type number -2, as  
mentioned at http://sourceware.org/gdb/current/onlinedocs/stabs_5.html#SEC35) 
, which gdb turns into a TYPE_CODE_CHAR. I don't know about GPC and  
Dwarf, but FPC and Dwarf results in DW_ATE_unsigned_char. The main  
problem with considering TYPE_CODE_INT as characters is that arrays of  
bytes (and now presumably also of words and cardinals) are printed as  
character arrays, which is quite annoying.
b) my changes to p-lang.c were basically a copy/paste if all changes  
in the C version of print_string to support characters of different  
widths

I noticed that I did miss this change you did to p-valprint.c in your  
patch:

-		       (valaddr + embedded_offset)[temp_len]
+		       extract_unsigned_integer (valaddr + embedded_offset +
+						 temp_len * eltlen, eltlen)

The patches are against the gdb archer branch, but applied cleanly  
against trunk gdb cvs when I tried it last month. Sorry for not  
informing you earlier about this patch.


Jonas

[-- Attachment #2: pascal-dwarf-char.patch --]
[-- Type: application/octet-stream, Size: 766 bytes --]

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 6b226be..295a6d8 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -5177,11 +5177,11 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
 	type_flags |= TYPE_FLAG_UNSIGNED;
 	break;
       case DW_ATE_signed_char:
-	if (cu->language == language_ada || cu->language == language_m2)
+	if (cu->language == language_ada || cu->language == language_m2 || cu->language == language_pascal)
 	  code = TYPE_CODE_CHAR;
 	break;
       case DW_ATE_unsigned_char:
-	if (cu->language == language_ada || cu->language == language_m2)
+	if (cu->language == language_ada || cu->language == language_m2 || cu->language == language_pascal)
 	  code = TYPE_CODE_CHAR;
 	type_flags |= TYPE_FLAG_UNSIGNED;
 	break;

[-- Attachment #3: pascalchar.patch --]
[-- Type: application/octet-stream, Size: 3933 bytes --]

diff --git a/gdb/p-lang.c b/gdb/p-lang.c
index 0e0de2e..39f6d1d 100644
--- a/gdb/p-lang.c
+++ b/gdb/p-lang.c
@@ -218,7 +218,10 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
   /* If the string was not truncated due to `set print elements', and
      the last byte of it is a null, we don't print that, in traditional C
      style.  */
-  if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
+  if (!force_ellipses
+      && length > 0
+      && (extract_unsigned_integer (string + (length - 1) * width, width)
+          == '\0'))
     length--;
 
   if (length == 0)
@@ -234,6 +237,7 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
       unsigned int rep1;
       /* Number of repetitions we have detected so far.  */
       unsigned int reps;
+      unsigned long current_char;
 
       QUIT;
 
@@ -243,9 +247,13 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
 	  need_comma = 0;
 	}
 
+      current_char = extract_unsigned_integer (string + i * width, width);
+
       rep1 = i + 1;
       reps = 1;
-      while (rep1 < length && string[rep1] == string[i])
+      while (rep1 < length
+	     && extract_unsigned_integer (string + rep1 * width, width)
+	     == current_char)
 	{
 	  ++rep1;
 	  ++reps;
@@ -262,15 +270,14 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
 	      in_quotes = 0;
 	    }
 	  pascal_printchar (string[i], stream);
-	  fprintf_filtered (stream, " <repeats %u times>", reps);
+	  fprintf_filtered (stream, _(" <repeats %u times>"), reps);
 	  i = rep1 - 1;
 	  things_printed += options->repeat_count_threshold;
 	  need_comma = 1;
 	}
       else
 	{
-	  int c = string[i];
-	  if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
+	  if ((!in_quotes) && (PRINT_LITERAL_FORM (current_char)))
 	    {
 	      if (options->inspect_it)
 		fputs_filtered ("\\'", stream);
@@ -278,7 +285,7 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
 		fputs_filtered ("'", stream);
 	      in_quotes = 1;
 	    }
-	  pascal_one_char (c, stream, &in_quotes);
+	  pascal_one_char (current_char, stream, &in_quotes);
 	  ++things_printed;
 	}
     }
diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c
index 9b1b7ff..3e3b688 100644
--- a/gdb/p-valprint.c
+++ b/gdb/p-valprint.c
@@ -79,10 +79,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 	      print_spaces_filtered (2 + 2 * recurse, stream);
 	    }
 	  /* For an array of chars, print with string syntax.  */
-	  if (eltlen == 1 
-	      && ((TYPE_CODE (elttype) == TYPE_CODE_INT)
-	       || ((current_language->la_language == language_pascal)
-		   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
+	  if (TYPE_CODE (elttype) == TYPE_CODE_CHAR
 	      && (options->format == 0 || options->format == 's'))
 	    {
 	      /* If requested, look for the first null char and only print
@@ -99,7 +96,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 		  len = temp_len;
 		}
 
-	      LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0,
+	      LA_PRINT_STRING (stream, valaddr + embedded_offset, len, TYPE_LENGTH (elttype), 0,
 			       options);
 	      i = len;
 	    }
@@ -165,14 +162,11 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 
 	  /* For a pointer to char or unsigned char, also print the string
 	     pointed to, unless pointer is null.  */
-	  if (TYPE_LENGTH (elttype) == 1
-	      && (TYPE_CODE (elttype) == TYPE_CODE_INT
-		  || TYPE_CODE(elttype) == TYPE_CODE_CHAR)
+	  if (TYPE_CODE(elttype) == TYPE_CODE_CHAR
 	      && (options->format == 0 || options->format == 's')
 	      && addr != 0)
 	    {
-	      /* no wide string yet */
-	      i = val_print_string (addr, -1, 1, stream, options);
+	      i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream, options);
 	    }
 	  /* also for pointers to pascal strings */
 	  /* Note: this is Free Pascal specific:

RE: [Commit] gdb/pascal language 2 or 4 byte char support in strings

[Pierre Muller]

> -----Message d'origine-----
> De : gdb-patches-owner@sourceware.org [mailto:gdb-patches-
> owner@sourceware.org] De la part de Jonas Maebe
> Envoyé : Tuesday, February 10, 2009 3:32 PM
> À : Pierre Muller
> Cc : 'gdb-patches ml'; 'FPC Core Developer List'; gpc@gnu.de
> Objet : Re: [Commit] gdb/pascal language 2 or 4 byte char support in
> strings
> 
> 
> On 10 Feb 2009, at 01:15, Pierre Muller wrote:
> 
> >  I committed the patch below to add
> > support for fixed width chars
> > greater than 1 for pascal language.
> >
> >  This works nicely for Free Pascal,
> > I couldn't test it for GPC
> > because I didn't find out if those kind of char are supported...
> 
> Hi Pierre,
> 
> A while ago I wrote a similar patch. I didn't submit it yet because I
> didn't find time to write explanations why I did everything and on
> writing test cases for all changes.
> 
> Anyway, it's in attachment (it's against the p-*.c files before your
> patch though). Some comments:
> * pascal-dwarf-char.patch:
> This one is independent from and complementary to your patch : it
> properly sets the TYPE_CODE DW_ATE_signed_char/DW_ATE_unsigned_char to
> TYPE_CODE_CHAR in case of Pascal (rather than only for Ada and Modula-
> 2)
 OK, I will submit this patch to the dwarf maintainer.
 
> * pascalchar.patch:
> a) I removed all situations in the Pascal string handling where
> "TYPE_CODE (elttype) == TYPE_CODE_INT" is interpreted as a character.
> I don't know the original reason for having it there though, but maybe
> it was because of the lack of a)? At least the stabs debug info of both
> FPC and GPC results in a char (negative type number -2, as mentioned at
> http://sourceware.org/gdb/current/onlinedocs/stabs_5.html#SEC35)

  I agree with you with one exception:
I think that TYPE_CODE_INT should be accepted if the /s format option was
specified.

> , which gdb turns into a TYPE_CODE_CHAR. I don't know about GPC and
> Dwarf, but FPC and Dwarf results in DW_ATE_unsigned_char. The main
> problem with considering TYPE_CODE_INT as characters is that arrays of
> bytes (and now presumably also of words and cardinals) are printed as
> character arrays, which is quite annoying.
> b) my changes to p-lang.c were basically a copy/paste if all changes in
> the C version of print_string to support characters of different widths

  I will try to modify the pascal code so that 
only TYPE_CODE_CHAR and /s generated string output.


Pierre Muller
Pascal language support maintainer for GDB