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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gdb-7.1/] [gdb/] [p-lang.c] - Blame information for rev 823

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

Line No. Rev Author Line
1 227 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
              if (TYPE_CODE (*char_type) == TYPE_CODE_ARRAY)
141
                *char_type = TYPE_TARGET_TYPE (*char_type);
142
            }
143
          if (arrayname)
144
            *arrayname = TYPE_FIELDS (type)[2].name;
145
         return 3;
146
        };
147
    }
148
  return 0;
149
}
150
 
151
static void pascal_one_char (int, struct ui_file *, int *);
152
 
153
/* Print the character C on STREAM as part of the contents of a literal
154
   string.
155
   In_quotes is reset to 0 if a char is written with #4 notation */
156
 
157
static void
158
pascal_one_char (int c, struct ui_file *stream, int *in_quotes)
159
{
160
 
161
  c &= 0xFF;                    /* Avoid sign bit follies */
162
 
163
  if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
164
    {
165
      if (!(*in_quotes))
166
        fputs_filtered ("'", stream);
167
      *in_quotes = 1;
168
      if (c == '\'')
169
        {
170
          fputs_filtered ("''", stream);
171
        }
172
      else
173
        fprintf_filtered (stream, "%c", c);
174
    }
175
  else
176
    {
177
      if (*in_quotes)
178
        fputs_filtered ("'", stream);
179
      *in_quotes = 0;
180
      fprintf_filtered (stream, "#%d", (unsigned int) c);
181
    }
182
}
183
 
184
static void pascal_emit_char (int c, struct type *type,
185
                              struct ui_file *stream, int quoter);
186
 
187
/* Print the character C on STREAM as part of the contents of a literal
188
   string whose delimiter is QUOTER.  Note that that format for printing
189
   characters and strings is language specific. */
190
 
191
static void
192
pascal_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
193
{
194
  int in_quotes = 0;
195
  pascal_one_char (c, stream, &in_quotes);
196
  if (in_quotes)
197
    fputs_filtered ("'", stream);
198
}
199
 
200
void
201
pascal_printchar (int c, struct type *type, struct ui_file *stream)
202
{
203
  int in_quotes = 0;
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
  lai->string_char_type = builtin->builtin_char;
376
  lai->primitive_type_vector
377
    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_pascal_primitive_types + 1,
378
                              struct type *);
379
  lai->primitive_type_vector [pascal_primitive_type_int]
380
    = builtin->builtin_int;
381
  lai->primitive_type_vector [pascal_primitive_type_long]
382
    = builtin->builtin_long;
383
  lai->primitive_type_vector [pascal_primitive_type_short]
384
    = builtin->builtin_short;
385
  lai->primitive_type_vector [pascal_primitive_type_char]
386
    = builtin->builtin_char;
387
  lai->primitive_type_vector [pascal_primitive_type_float]
388
    = builtin->builtin_float;
389
  lai->primitive_type_vector [pascal_primitive_type_double]
390
    = builtin->builtin_double;
391
  lai->primitive_type_vector [pascal_primitive_type_void]
392
    = builtin->builtin_void;
393
  lai->primitive_type_vector [pascal_primitive_type_long_long]
394
    = builtin->builtin_long_long;
395
  lai->primitive_type_vector [pascal_primitive_type_signed_char]
396
    = builtin->builtin_signed_char;
397
  lai->primitive_type_vector [pascal_primitive_type_unsigned_char]
398
    = builtin->builtin_unsigned_char;
399
  lai->primitive_type_vector [pascal_primitive_type_unsigned_short]
400
    = builtin->builtin_unsigned_short;
401
  lai->primitive_type_vector [pascal_primitive_type_unsigned_int]
402
    = builtin->builtin_unsigned_int;
403
  lai->primitive_type_vector [pascal_primitive_type_unsigned_long]
404
    = builtin->builtin_unsigned_long;
405
  lai->primitive_type_vector [pascal_primitive_type_unsigned_long_long]
406
    = builtin->builtin_unsigned_long_long;
407
  lai->primitive_type_vector [pascal_primitive_type_long_double]
408
    = builtin->builtin_long_double;
409
  lai->primitive_type_vector [pascal_primitive_type_complex]
410
    = builtin->builtin_complex;
411
  lai->primitive_type_vector [pascal_primitive_type_double_complex]
412
    = builtin->builtin_double_complex;
413
 
414
  lai->bool_type_symbol = "boolean";
415
  lai->bool_type_default = builtin->builtin_bool;
416
}
417
 
418
const struct language_defn pascal_language_defn =
419
{
420
  "pascal",                     /* Language name */
421
  language_pascal,
422
  range_check_on,
423
  type_check_on,
424
  case_sensitive_on,
425
  array_row_major,
426
  macro_expansion_no,
427
  &exp_descriptor_standard,
428
  pascal_parse,
429
  pascal_error,
430
  null_post_parser,
431
  pascal_printchar,             /* Print a character constant */
432
  pascal_printstr,              /* Function to print string constant */
433
  pascal_emit_char,             /* Print a single char */
434
  pascal_print_type,            /* Print a type using appropriate syntax */
435
  pascal_print_typedef,         /* Print a typedef using appropriate syntax */
436
  pascal_val_print,             /* Print a value using appropriate syntax */
437
  pascal_value_print,           /* Print a top-level value */
438
  NULL,                         /* Language specific skip_trampoline */
439
  "this",                       /* name_of_this */
440
  basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
441
  basic_lookup_transparent_type,/* lookup_transparent_type */
442
  NULL,                         /* Language specific symbol demangler */
443
  NULL,                         /* Language specific class_name_from_physname */
444
  pascal_op_print_tab,          /* expression operators for printing */
445
  1,                            /* c-style arrays */
446
  0,                             /* String lower bound */
447
  default_word_break_characters,
448
  default_make_symbol_completion_list,
449
  pascal_language_arch_info,
450
  default_print_array_index,
451
  default_pass_by_reference,
452
  default_get_string,
453
  LANG_MAGIC
454
};
455
 
456
void
457
_initialize_pascal_language (void)
458
{
459
  add_language (&pascal_language_defn);
460
}

powered by: WebSVN 2.1.0

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