/* Pascal language support routines for GDB, the GNU debugger.
- Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007, 2008
+ Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
This file is part of GDB.
}
/* 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
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,
+ int *length_size, int *string_pos,
+ struct type **char_type,
char **arrayname)
{
- if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ if (type != NULL && TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
/* Old Borland type pascal strings from Free Pascal Compiler. */
/* Two fields: length and st. */
*length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
if (string_pos)
*string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
- if (char_size)
- *char_size = 1;
+ if (char_type)
+ *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1));
if (arrayname)
*arrayname = TYPE_FIELDS (type)[1].name;
return 2;
&& strcmp (TYPE_FIELDS (type)[0].name, "Capacity") == 0
&& strcmp (TYPE_FIELDS (type)[1].name, "length") == 0)
{
- if (length_pos)
+ 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_size = 1;
+ if (char_type)
+ {
+ *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 2));
+
+ if (TYPE_CODE (*char_type) == TYPE_CODE_ARRAY)
+ *char_type = TYPE_TARGET_TYPE (*char_type);
+ }
if (arrayname)
*arrayname = TYPE_FIELDS (type)[2].name;
return 3;
static void
pascal_one_char (int c, struct ui_file *stream, int *in_quotes)
{
-
- c &= 0xFF; /* Avoid sign bit follies */
-
- if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
+ if (c == '\'' || ((unsigned int) c <= 0xff && (PRINT_LITERAL_FORM (c))))
{
if (!(*in_quotes))
fputs_filtered ("'", stream);
}
}
-static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
+static void pascal_emit_char (int c, struct type *type,
+ struct ui_file *stream, int quoter);
/* Print the character C on STREAM as part of the contents of a literal
string whose delimiter is QUOTER. Note that that format for printing
characters and strings is language specific. */
static void
-pascal_emit_char (int c, struct ui_file *stream, int quoter)
+pascal_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
{
int in_quotes = 0;
+
pascal_one_char (c, stream, &in_quotes);
if (in_quotes)
fputs_filtered ("'", stream);
}
void
-pascal_printchar (int c, struct ui_file *stream)
+pascal_printchar (int c, struct type *type, struct ui_file *stream)
{
int in_quotes = 0;
+
pascal_one_char (c, stream, &in_quotes);
if (in_quotes)
fputs_filtered ("'", stream);
had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
void
-pascal_printstr (struct ui_file *stream, const gdb_byte *string,
- unsigned int length, int width, int force_ellipses)
+pascal_printstr (struct ui_file *stream, struct type *type,
+ const gdb_byte *string, unsigned int length,
+ const char *encoding, int force_ellipses,
+ const struct value_print_options *options)
{
+ enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
unsigned int i;
unsigned int things_printed = 0;
int in_quotes = 0;
int need_comma = 0;
+ int width = TYPE_LENGTH (type);
/* 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,
+ byte_order) == 0)
length--;
if (length == 0)
return;
}
- for (i = 0; i < length && things_printed < print_max; ++i)
+ for (i = 0; i < length && things_printed < options->print_max; ++i)
{
/* Position of the character we are examining
to see whether it is repeated. */
unsigned int rep1;
/* Number of repetitions we have detected so far. */
unsigned int reps;
+ unsigned long int current_char;
QUIT;
need_comma = 0;
}
+ current_char = extract_unsigned_integer (string + i * width, width,
+ byte_order);
+
rep1 = i + 1;
reps = 1;
- while (rep1 < length && string[rep1] == string[i])
+ while (rep1 < length
+ && extract_unsigned_integer (string + rep1 * width, width,
+ byte_order) == current_char)
{
++rep1;
++reps;
}
- if (reps > repeat_count_threshold)
+ if (reps > options->repeat_count_threshold)
{
if (in_quotes)
{
- if (inspect_it)
+ if (options->inspect_it)
fputs_filtered ("\\', ", stream);
else
fputs_filtered ("', ", stream);
in_quotes = 0;
}
- pascal_printchar (string[i], stream);
+ pascal_printchar (current_char, type, stream);
fprintf_filtered (stream, " <repeats %u times>", reps);
i = rep1 - 1;
- things_printed += repeat_count_threshold;
+ 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 (inspect_it)
+ if (options->inspect_it)
fputs_filtered ("\\'", stream);
else
fputs_filtered ("'", stream);
in_quotes = 1;
}
- pascal_one_char (c, stream, &in_quotes);
+ pascal_one_char (current_char, stream, &in_quotes);
++things_printed;
}
}
/* Terminate the quotes if necessary. */
if (in_quotes)
{
- if (inspect_it)
+ if (options->inspect_it)
fputs_filtered ("\\'", stream);
else
fputs_filtered ("'", stream);
struct language_arch_info *lai)
{
const struct builtin_type *builtin = builtin_type (gdbarch);
+
lai->string_char_type = builtin->builtin_char;
lai->primitive_type_vector
= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_pascal_primitive_types + 1,
= builtin->builtin_complex;
lai->primitive_type_vector [pascal_primitive_type_double_complex]
= builtin->builtin_double_complex;
+
+ lai->bool_type_symbol = "boolean";
+ lai->bool_type_default = builtin->builtin_bool;
}
const struct language_defn pascal_language_defn =
type_check_on,
case_sensitive_on,
array_row_major,
+ macro_expansion_no,
&exp_descriptor_standard,
pascal_parse,
pascal_error,
pascal_printstr, /* Function to print string constant */
pascal_emit_char, /* Print a single char */
pascal_print_type, /* Print a type using appropriate syntax */
+ pascal_print_typedef, /* Print a typedef using appropriate syntax */
pascal_val_print, /* Print a value using appropriate syntax */
pascal_value_print, /* Print a top-level value */
NULL, /* Language specific skip_trampoline */
pascal_language_arch_info,
default_print_array_index,
default_pass_by_reference,
+ default_get_string,
LANG_MAGIC
};