GDB (xrefs)
/tmp/gdb-7.10/gdb/p-lang.c
Go to the documentation of this file.
1 /* Pascal language support routines for GDB, the GNU debugger.
2 
3  Copyright (C) 2000-2015 Free Software Foundation, Inc.
4 
5  This file is part of GDB.
6 
7  This program is free software; you can redistribute it and/or modify
8  it under the terms of the GNU General Public License as published by
9  the Free Software Foundation; either version 3 of the License, or
10  (at your option) any later version.
11 
12  This program is distributed in the hope that it will be useful,
13  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15  GNU General Public License for more details.
16 
17  You should have received a copy of the GNU General Public License
18  along with this program. If not, see <http://www.gnu.org/licenses/>. */
19 
20 /* This file is derived from c-lang.c */
21 
22 #include "defs.h"
23 #include "symtab.h"
24 #include "gdbtypes.h"
25 #include "expression.h"
26 #include "parser-defs.h"
27 #include "language.h"
28 #include "varobj.h"
29 #include "p-lang.h"
30 #include "valprint.h"
31 #include "value.h"
32 #include <ctype.h>
33 
34 extern void _initialize_pascal_language (void);
35 
36 
37 /* All GPC versions until now (2007-09-27) also define a symbol called
38  '_p_initialize'. Check for the presence of this symbol first. */
39 static const char GPC_P_INITIALIZE[] = "_p_initialize";
40 
41 /* The name of the symbol that GPC uses as the name of the main
42  procedure (since version 20050212). */
43 static const char GPC_MAIN_PROGRAM_NAME_1[] = "_p__M0_main_program";
44 
45 /* Older versions of GPC (versions older than 20050212) were using
46  a different name for the main procedure. */
47 static const char GPC_MAIN_PROGRAM_NAME_2[] = "pascal_main_program";
48 
49 /* Function returning the special symbol name used
50  by GPC for the main procedure in the main program
51  if it is found in minimal symbol list.
52  This function tries to find minimal symbols generated by GPC
53  so that it finds the even if the program was compiled
54  without debugging information.
55  According to information supplied by Waldeck Hebisch,
56  this should work for all versions posterior to June 2000. */
57 
58 const char *
60 {
61  struct bound_minimal_symbol msym;
62 
63  msym = lookup_minimal_symbol (GPC_P_INITIALIZE, NULL, NULL);
64 
65  /* If '_p_initialize' was not found, the main program is likely not
66  written in Pascal. */
67  if (msym.minsym == NULL)
68  return NULL;
69 
71  if (msym.minsym != NULL)
72  {
74  }
75 
77  if (msym.minsym != NULL)
78  {
80  }
81 
82  /* No known entry procedure found, the main program is probably
83  not compiled with GPC. */
84  return NULL;
85 }
86 
87 /* Determines if type TYPE is a pascal string type.
88  Returns a positive value if the type is a known pascal string type.
89  This function is used by p-valprint.c code to allow better string display.
90  If it is a pascal string type, then it also sets info needed
91  to get the length and the data of the string
92  length_pos, length_size and string_pos are given in bytes.
93  char_size gives the element size in bytes.
94  FIXME: if the position or the size of these fields
95  are not multiple of TARGET_CHAR_BIT then the results are wrong
96  but this does not happen for Free Pascal nor for GPC. */
97 int
98 is_pascal_string_type (struct type *type,int *length_pos,
99  int *length_size, int *string_pos,
100  struct type **char_type,
101  const char **arrayname)
102 {
103  if (type != NULL && TYPE_CODE (type) == TYPE_CODE_STRUCT)
104  {
105  /* Old Borland type pascal strings from Free Pascal Compiler. */
106  /* Two fields: length and st. */
107  if (TYPE_NFIELDS (type) == 2
108  && TYPE_FIELD_NAME (type, 0)
109  && strcmp (TYPE_FIELD_NAME (type, 0), "length") == 0
110  && TYPE_FIELD_NAME (type, 1)
111  && strcmp (TYPE_FIELD_NAME (type, 1), "st") == 0)
112  {
113  if (length_pos)
114  *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT;
115  if (length_size)
116  *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
117  if (string_pos)
118  *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
119  if (char_type)
120  *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1));
121  if (arrayname)
122  *arrayname = TYPE_FIELD_NAME (type, 1);
123  return 2;
124  };
125  /* GNU pascal strings. */
126  /* Three fields: Capacity, length and schema$ or _p_schema. */
127  if (TYPE_NFIELDS (type) == 3
128  && TYPE_FIELD_NAME (type, 0)
129  && strcmp (TYPE_FIELD_NAME (type, 0), "Capacity") == 0
130  && TYPE_FIELD_NAME (type, 1)
131  && strcmp (TYPE_FIELD_NAME (type, 1), "length") == 0)
132  {
133  if (length_pos)
134  *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
135  if (length_size)
136  *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1));
137  if (string_pos)
138  *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT;
139  /* FIXME: how can I detect wide chars in GPC ?? */
140  if (char_type)
141  {
142  *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 2));
143 
144  if (TYPE_CODE (*char_type) == TYPE_CODE_ARRAY)
145  *char_type = TYPE_TARGET_TYPE (*char_type);
146  }
147  if (arrayname)
148  *arrayname = TYPE_FIELD_NAME (type, 2);
149  return 3;
150  };
151  }
152  return 0;
153 }
154 
155 static void pascal_one_char (int, struct ui_file *, int *);
156 
157 /* Print the character C on STREAM as part of the contents of a literal
158  string.
159  In_quotes is reset to 0 if a char is written with #4 notation. */
160 
161 static void
162 pascal_one_char (int c, struct ui_file *stream, int *in_quotes)
163 {
164  if (c == '\'' || ((unsigned int) c <= 0xff && (PRINT_LITERAL_FORM (c))))
165  {
166  if (!(*in_quotes))
167  fputs_filtered ("'", stream);
168  *in_quotes = 1;
169  if (c == '\'')
170  {
171  fputs_filtered ("''", stream);
172  }
173  else
174  fprintf_filtered (stream, "%c", c);
175  }
176  else
177  {
178  if (*in_quotes)
179  fputs_filtered ("'", stream);
180  *in_quotes = 0;
181  fprintf_filtered (stream, "#%d", (unsigned int) c);
182  }
183 }
184 
185 static void pascal_emit_char (int c, struct type *type,
186  struct ui_file *stream, int quoter);
187 
188 /* Print the character C on STREAM as part of the contents of a literal
189  string whose delimiter is QUOTER. Note that that format for printing
190  characters and strings is language specific. */
191 
192 static void
193 pascal_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
194 {
195  int in_quotes = 0;
196 
197  pascal_one_char (c, stream, &in_quotes);
198  if (in_quotes)
199  fputs_filtered ("'", stream);
200 }
201 
202 void
203 pascal_printchar (int c, struct type *type, struct ui_file *stream)
204 {
205  int in_quotes = 0;
206 
207  pascal_one_char (c, stream, &in_quotes);
208  if (in_quotes)
209  fputs_filtered ("'", stream);
210 }
211 
212 /* Print the character string STRING, printing at most LENGTH characters.
213  Printing stops early if the number hits print_max; repeat counts
214  are printed as appropriate. Print ellipses at the end if we
215  had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
216 
217 void
218 pascal_printstr (struct ui_file *stream, struct type *type,
219  const gdb_byte *string, unsigned int length,
220  const char *encoding, int force_ellipses,
221  const struct value_print_options *options)
222 {
223  enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
224  unsigned int i;
225  unsigned int things_printed = 0;
226  int in_quotes = 0;
227  int need_comma = 0;
228  int width;
229 
230  /* Preserve TYPE's original type, just set its LENGTH. */
231  check_typedef (type);
232  width = TYPE_LENGTH (type);
233 
234  /* If the string was not truncated due to `set print elements', and
235  the last byte of it is a null, we don't print that, in traditional C
236  style. */
237  if ((!force_ellipses) && length > 0
238  && extract_unsigned_integer (string + (length - 1) * width, width,
239  byte_order) == 0)
240  length--;
241 
242  if (length == 0)
243  {
244  fputs_filtered ("''", stream);
245  return;
246  }
247 
248  for (i = 0; i < length && things_printed < options->print_max; ++i)
249  {
250  /* Position of the character we are examining
251  to see whether it is repeated. */
252  unsigned int rep1;
253  /* Number of repetitions we have detected so far. */
254  unsigned int reps;
255  unsigned long int current_char;
256 
257  QUIT;
258 
259  if (need_comma)
260  {
261  fputs_filtered (", ", stream);
262  need_comma = 0;
263  }
264 
265  current_char = extract_unsigned_integer (string + i * width, width,
266  byte_order);
267 
268  rep1 = i + 1;
269  reps = 1;
270  while (rep1 < length
271  && extract_unsigned_integer (string + rep1 * width, width,
272  byte_order) == current_char)
273  {
274  ++rep1;
275  ++reps;
276  }
277 
278  if (reps > options->repeat_count_threshold)
279  {
280  if (in_quotes)
281  {
282  fputs_filtered ("', ", stream);
283  in_quotes = 0;
284  }
285  pascal_printchar (current_char, type, stream);
286  fprintf_filtered (stream, " <repeats %u times>", reps);
287  i = rep1 - 1;
288  things_printed += options->repeat_count_threshold;
289  need_comma = 1;
290  }
291  else
292  {
293  if ((!in_quotes) && (PRINT_LITERAL_FORM (current_char)))
294  {
295  fputs_filtered ("'", stream);
296  in_quotes = 1;
297  }
298  pascal_one_char (current_char, stream, &in_quotes);
299  ++things_printed;
300  }
301  }
302 
303  /* Terminate the quotes if necessary. */
304  if (in_quotes)
305  fputs_filtered ("'", stream);
306 
307  if (force_ellipses || i < length)
308  fputs_filtered ("...", stream);
309 }
310 
311 
312 /* Table mapping opcodes into strings for printing operators
313  and precedences of the operators. */
314 
315 const struct op_print pascal_op_print_tab[] =
316 {
317  {",", BINOP_COMMA, PREC_COMMA, 0},
318  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
319  {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
320  {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
321  {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
322  {"=", BINOP_EQUAL, PREC_EQUAL, 0},
323  {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
324  {"<=", BINOP_LEQ, PREC_ORDER, 0},
325  {">=", BINOP_GEQ, PREC_ORDER, 0},
326  {">", BINOP_GTR, PREC_ORDER, 0},
327  {"<", BINOP_LESS, PREC_ORDER, 0},
328  {"shr", BINOP_RSH, PREC_SHIFT, 0},
329  {"shl", BINOP_LSH, PREC_SHIFT, 0},
330  {"+", BINOP_ADD, PREC_ADD, 0},
331  {"-", BINOP_SUB, PREC_ADD, 0},
332  {"*", BINOP_MUL, PREC_MUL, 0},
333  {"/", BINOP_DIV, PREC_MUL, 0},
334  {"div", BINOP_INTDIV, PREC_MUL, 0},
335  {"mod", BINOP_REM, PREC_MUL, 0},
336  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
337  {"-", UNOP_NEG, PREC_PREFIX, 0},
338  {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
339  {"^", UNOP_IND, PREC_SUFFIX, 1},
340  {"@", UNOP_ADDR, PREC_PREFIX, 0},
341  {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0},
342  {NULL, 0, 0, 0}
343 };
344 
364 };
365 
366 static void
368  struct language_arch_info *lai)
369 {
370  const struct builtin_type *builtin = builtin_type (gdbarch);
371 
372  lai->string_char_type = builtin->builtin_char;
375  struct type *);
377  = builtin->builtin_int;
379  = builtin->builtin_long;
381  = builtin->builtin_short;
383  = builtin->builtin_char;
385  = builtin->builtin_float;
387  = builtin->builtin_double;
389  = builtin->builtin_void;
391  = builtin->builtin_long_long;
393  = builtin->builtin_signed_char;
395  = builtin->builtin_unsigned_char;
397  = builtin->builtin_unsigned_short;
399  = builtin->builtin_unsigned_int;
401  = builtin->builtin_unsigned_long;
403  = builtin->builtin_unsigned_long_long;
405  = builtin->builtin_long_double;
407  = builtin->builtin_complex;
409  = builtin->builtin_double_complex;
410 
411  lai->bool_type_symbol = "boolean";
412  lai->bool_type_default = builtin->builtin_bool;
413 }
414 
415 const struct language_defn pascal_language_defn =
416 {
417  "pascal", /* Language name */
418  "Pascal",
425  pascal_parse,
426  pascal_error,
428  pascal_printchar, /* Print a character constant */
429  pascal_printstr, /* Function to print string constant */
430  pascal_emit_char, /* Print a single char */
431  pascal_print_type, /* Print a type using appropriate syntax */
432  pascal_print_typedef, /* Print a typedef using appropriate syntax */
433  pascal_val_print, /* Print a value using appropriate syntax */
434  pascal_value_print, /* Print a top-level value */
435  default_read_var_value, /* la_read_var_value */
436  NULL, /* Language specific skip_trampoline */
437  "this", /* name_of_this */
438  basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
439  basic_lookup_transparent_type,/* lookup_transparent_type */
440  NULL, /* Language specific symbol demangler */
441  NULL, /* Language specific class_name_from_physname */
442  pascal_op_print_tab, /* expression operators for printing */
443  1, /* c-style arrays */
444  0, /* String lower bound */
446  default_make_symbol_completion_list,
451  NULL, /* la_get_symbol_name_cmp */
454  NULL,
455  NULL,
456  LANG_MAGIC
457 };
458 
459 void
461 {
462  add_language (&pascal_language_defn);
463 }
ULONGEST extract_unsigned_integer(const gdb_byte *, int, enum bfd_endian)
Definition: findvar.c:84
unsigned int repeat_count_threshold
Definition: valprint.h:57
struct type * builtin_long_double
Definition: gdbtypes.h:1492
#define TYPE_FIELD_NAME(thistype, n)
Definition: gdbtypes.h:1369
struct type * builtin_unsigned_int
Definition: gdbtypes.h:1488
struct type * builtin_double_complex
Definition: gdbtypes.h:1494
#define GDBARCH_OBSTACK_CALLOC(GDBARCH, NR, TYPE)
Definition: gdbarch.h:1614
static const char GPC_MAIN_PROGRAM_NAME_1[]
Definition: p-lang.c:43
const struct builtin_type * builtin_type(struct gdbarch *gdbarch)
Definition: gdbtypes.c:4766
void pascal_error(char *)
struct value * default_read_var_value(struct symbol *var, struct frame_info *frame)
Definition: findvar.c:416
static const char GPC_P_INITIALIZE[]
Definition: p-lang.c:39
struct type * string_char_type
Definition: language.h:120
struct type * builtin_complex
Definition: gdbtypes.h:1493
int is_pascal_string_type(struct type *type, int *length_pos, int *length_size, int *string_pos, struct type **char_type, const char **arrayname)
Definition: p-lang.c:98
const char * pascal_main_name(void)
Definition: p-lang.c:59
#define TYPE_FIELD_TYPE(thistype, n)
Definition: gdbtypes.h:1368
void add_language(const struct language_defn *lang)
Definition: language.c:518
struct type * builtin_short
Definition: gdbtypes.h:1482
const struct op_print pascal_op_print_tab[]
Definition: p-lang.c:315
char * default_word_break_characters(void)
Definition: language.c:669
int pascal_parse(struct parser_state *par_state)
Definition: p-exp.c:3376
struct type * check_typedef(struct type *type)
Definition: gdbtypes.c:2217
struct type * builtin_unsigned_long
Definition: gdbtypes.h:1489
struct type * bool_type_default
Definition: language.h:125
void null_post_parser(struct expression **exp, int void_context_p)
Definition: parse.c:1358
#define PRINT_LITERAL_FORM(c)
Definition: language.h:517
static void pascal_one_char(int, struct ui_file *, int *)
Definition: p-lang.c:162
void fprintf_filtered(struct ui_file *stream, const char *format,...)
Definition: utils.c:2351
void fputs_filtered(const char *linebuffer, struct ui_file *stream)
Definition: utils.c:2145
const char * bool_type_symbol
Definition: language.h:123
int default_pass_by_reference(struct type *type)
Definition: language.c:659
enum bfd_endian gdbarch_byte_order(struct gdbarch *gdbarch)
Definition: gdbarch.c:1420
pascal_primitive_types
Definition: p-lang.c:345
struct type * basic_lookup_transparent_type(const char *name)
Definition: symtab.c:2851
static void pascal_language_arch_info(struct gdbarch *gdbarch, struct language_arch_info *lai)
Definition: p-lang.c:367
#define TARGET_CHAR_BIT
Definition: host-defs.h:29
Definition: gdbtypes.h:749
struct gdbarch * get_type_arch(const struct type *type)
Definition: gdbtypes.c:232
void iterate_over_symbols(const struct block *block, const char *name, const domain_enum domain, symbol_found_callback_ftype *callback, void *data)
Definition: symtab.c:2912
struct type * builtin_long
Definition: gdbtypes.h:1484
void pascal_value_print(struct value *, struct ui_file *, const struct value_print_options *)
Definition: p-valprint.c:417
void 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)
Definition: p-lang.c:218
void default_print_array_index(struct value *index_value, struct ui_file *stream, const struct value_print_options *options)
Definition: language.c:677
struct type * builtin_unsigned_char
Definition: gdbtypes.h:1486
static char encoding[]
Definition: remote-mips.c:2988
struct type * builtin_bool
Definition: gdbtypes.h:1496
struct type * builtin_unsigned_long_long
Definition: gdbtypes.h:1498
struct type * builtin_signed_char
Definition: gdbtypes.h:1485
#define TYPE_FIELD_BITPOS(thistype, n)
Definition: gdbtypes.h:1371
void pascal_val_print(struct type *, const gdb_byte *, int, CORE_ADDR, struct ui_file *, int, const struct value *, const struct value_print_options *)
Definition: p-valprint.c:59
struct type * builtin_unsigned_short
Definition: gdbtypes.h:1487
void pascal_printchar(int c, struct type *type, struct ui_file *stream)
Definition: p-lang.c:203
bfd_byte gdb_byte
Definition: common-types.h:38
struct type * builtin_char
Definition: gdbtypes.h:1481
void _initialize_pascal_language(void)
Definition: p-lang.c:460
#define TYPE_TARGET_TYPE(thistype)
Definition: gdbtypes.h:1229
struct type * builtin_double
Definition: gdbtypes.h:1491
void default_get_string(struct value *value, gdb_byte **buffer, int *length, struct type **char_type, const char **charset)
Definition: language.c:686
#define TYPE_CODE(thistype)
Definition: gdbtypes.h:1240
#define default_varobj_ops
Definition: varobj.h:233
void pascal_print_type(struct type *, const char *, struct ui_file *, int, int, const struct type_print_options *)
Definition: p-typeprint.c:48
const struct exp_descriptor exp_descriptor_standard
Definition: parse.c:56
#define TYPE_NFIELDS(thistype)
Definition: gdbtypes.h:1241
struct type * builtin_long_long
Definition: gdbtypes.h:1497
void pascal_print_typedef(struct type *, struct symbol *, struct ui_file *)
Definition: p-typeprint.c:96
static const char GPC_MAIN_PROGRAM_NAME_2[]
Definition: p-lang.c:47
struct symbol * basic_lookup_symbol_nonlocal(const struct language_defn *langdef, const char *name, const struct block *block, const domain_enum domain)
Definition: symtab.c:2481
unsigned int print_max
Definition: valprint.h:53
#define TYPE_LENGTH(thistype)
Definition: gdbtypes.h:1237
#define LANG_MAGIC
Definition: language.h:402
#define QUIT
Definition: defs.h:160
struct type ** primitive_type_vector
Definition: language.h:113
struct bound_minimal_symbol lookup_minimal_symbol(const char *name, const char *sfile, struct objfile *objf)
Definition: minsyms.c:163
struct type * builtin_void
Definition: gdbtypes.h:1480
static void pascal_emit_char(int c, struct type *type, struct ui_file *stream, int quoter)
Definition: p-lang.c:193
struct type * builtin_float
Definition: gdbtypes.h:1490
struct type * builtin_int
Definition: gdbtypes.h:1483