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.
This commit is contained in:
Pierre Muller 2001-11-09 09:48:09 +00:00
parent 94a716bf57
commit 5598ce1171
4 changed files with 78 additions and 18 deletions

View File

@ -1,3 +1,11 @@
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.
2001-11-06 Pierre Muller <muller@ics.u-strasbg.fr>
* p-exp.y (yylex): Only change case of expression if symbol is found.

View File

@ -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

View File

@ -38,6 +38,8 @@ extern void pascal_type_print_method_args (char *, char *,
/* These are in p-lang.c: */
extern int is_pascal_string_type (struct type *, int *, int *, int *, int*);
extern void pascal_printchar (int, struct ui_file *);
extern void pascal_printstr (struct ui_file *, char *, unsigned int, int, int);

View File

@ -63,6 +63,8 @@ pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
unsigned len;
struct type *elttype;
unsigned eltlen;
int length_pos, length_size, string_pos;
int char_size;
LONGEST val;
CORE_ADDR addr;
@ -187,16 +189,17 @@ pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
as GDB does not recognize stabs pascal strings
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))
{
@ -205,8 +208,8 @@ pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
struct minimal_symbol *msymbol =
lookup_minimal_symbol_by_pc (vt_address);
if ((msymbol != NULL) &&
(vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
if ((msymbol != NULL)
&& (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
{
fputs_filtered (" <", stream);
fputs_filtered (SYMBOL_SOURCE_NAME (msymbol), stream);
@ -315,12 +318,11 @@ pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
}
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,