OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gdb-7.2/] [gdb/] [p-lang.c] - Blame information for rev 816

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.