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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-7.2/] [gdb/] [m2-lang.c] - Blame information for rev 446

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

Line No. Rev Author Line
1 330 jeremybenn
/* Modula 2 language support routines for GDB, the GNU debugger.
2
 
3
   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
4
   2005, 2007, 2008, 2009, 2010 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
#include "defs.h"
22
#include "symtab.h"
23
#include "gdbtypes.h"
24
#include "expression.h"
25
#include "parser-defs.h"
26
#include "language.h"
27
#include "m2-lang.h"
28
#include "c-lang.h"
29
#include "valprint.h"
30
 
31
extern void _initialize_m2_language (void);
32
static void m2_printchar (int, struct type *, struct ui_file *);
33
static void m2_emit_char (int, struct type *, struct ui_file *, int);
34
 
35
/* Print the character C on STREAM as part of the contents of a literal
36
   string whose delimiter is QUOTER.  Note that that format for printing
37
   characters and strings is language specific.
38
   FIXME:  This is a copy of the same function from c-exp.y.  It should
39
   be replaced with a true Modula version.  */
40
 
41
static void
42
m2_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
43
{
44
 
45
  c &= 0xFF;                    /* Avoid sign bit follies */
46
 
47
  if (PRINT_LITERAL_FORM (c))
48
    {
49
      if (c == '\\' || c == quoter)
50
        {
51
          fputs_filtered ("\\", stream);
52
        }
53
      fprintf_filtered (stream, "%c", c);
54
    }
55
  else
56
    {
57
      switch (c)
58
        {
59
        case '\n':
60
          fputs_filtered ("\\n", stream);
61
          break;
62
        case '\b':
63
          fputs_filtered ("\\b", stream);
64
          break;
65
        case '\t':
66
          fputs_filtered ("\\t", stream);
67
          break;
68
        case '\f':
69
          fputs_filtered ("\\f", stream);
70
          break;
71
        case '\r':
72
          fputs_filtered ("\\r", stream);
73
          break;
74
        case '\033':
75
          fputs_filtered ("\\e", stream);
76
          break;
77
        case '\007':
78
          fputs_filtered ("\\a", stream);
79
          break;
80
        default:
81
          fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
82
          break;
83
        }
84
    }
85
}
86
 
87
/* FIXME:  This is a copy of the same function from c-exp.y.  It should
88
   be replaced with a true Modula version.  */
89
 
90
static void
91
m2_printchar (int c, struct type *type, struct ui_file *stream)
92
{
93
  fputs_filtered ("'", stream);
94
  LA_EMIT_CHAR (c, type, stream, '\'');
95
  fputs_filtered ("'", stream);
96
}
97
 
98
/* Print the character string STRING, printing at most LENGTH characters.
99
   Printing stops early if the number hits print_max; repeat counts
100
   are printed as appropriate.  Print ellipses at the end if we
101
   had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
102
   FIXME:  This is a copy of the same function from c-exp.y.  It should
103
   be replaced with a true Modula version.  */
104
 
105
static void
106
m2_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
107
             unsigned int length, const char *encoding, int force_ellipses,
108
             const struct value_print_options *options)
109
{
110
  unsigned int i;
111
  unsigned int things_printed = 0;
112
  int in_quotes = 0;
113
  int need_comma = 0;
114
 
115
  if (length == 0)
116
    {
117
      fputs_filtered ("\"\"", gdb_stdout);
118
      return;
119
    }
120
 
121
  for (i = 0; i < length && things_printed < options->print_max; ++i)
122
    {
123
      /* Position of the character we are examining
124
         to see whether it is repeated.  */
125
      unsigned int rep1;
126
      /* Number of repetitions we have detected so far.  */
127
      unsigned int reps;
128
 
129
      QUIT;
130
 
131
      if (need_comma)
132
        {
133
          fputs_filtered (", ", stream);
134
          need_comma = 0;
135
        }
136
 
137
      rep1 = i + 1;
138
      reps = 1;
139
      while (rep1 < length && string[rep1] == string[i])
140
        {
141
          ++rep1;
142
          ++reps;
143
        }
144
 
145
      if (reps > options->repeat_count_threshold)
146
        {
147
          if (in_quotes)
148
            {
149
              if (options->inspect_it)
150
                fputs_filtered ("\\\", ", stream);
151
              else
152
                fputs_filtered ("\", ", stream);
153
              in_quotes = 0;
154
            }
155
          m2_printchar (string[i], type, stream);
156
          fprintf_filtered (stream, " <repeats %u times>", reps);
157
          i = rep1 - 1;
158
          things_printed += options->repeat_count_threshold;
159
          need_comma = 1;
160
        }
161
      else
162
        {
163
          if (!in_quotes)
164
            {
165
              if (options->inspect_it)
166
                fputs_filtered ("\\\"", stream);
167
              else
168
                fputs_filtered ("\"", stream);
169
              in_quotes = 1;
170
            }
171
          LA_EMIT_CHAR (string[i], type, stream, '"');
172
          ++things_printed;
173
        }
174
    }
175
 
176
  /* Terminate the quotes if necessary.  */
177
  if (in_quotes)
178
    {
179
      if (options->inspect_it)
180
        fputs_filtered ("\\\"", stream);
181
      else
182
        fputs_filtered ("\"", stream);
183
    }
184
 
185
  if (force_ellipses || i < length)
186
    fputs_filtered ("...", stream);
187
}
188
 
189
static struct value *
190
evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
191
                         int *pos, enum noside noside)
192
{
193
  enum exp_opcode op = exp->elts[*pos].opcode;
194
  struct value *arg1;
195
  struct value *arg2;
196
  struct type *type;
197
 
198
  switch (op)
199
    {
200
    case UNOP_HIGH:
201
      (*pos)++;
202
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
203
 
204
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
205
        return arg1;
206
      else
207
        {
208
          arg1 = coerce_ref (arg1);
209
          type = check_typedef (value_type (arg1));
210
 
211
          if (m2_is_unbounded_array (type))
212
            {
213
              struct value *temp = arg1;
214
 
215
              type = TYPE_FIELD_TYPE (type, 1);
216
              /* i18n: Do not translate the "_m2_high" part!  */
217
              arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
218
                                       _("unbounded structure "
219
                                         "missing _m2_high field"));
220
 
221
              if (value_type (arg1) != type)
222
                arg1 = value_cast (type, arg1);
223
            }
224
        }
225
      return arg1;
226
 
227
    case BINOP_SUBSCRIPT:
228
      (*pos)++;
229
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
230
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
231
      if (noside == EVAL_SKIP)
232
        goto nosideret;
233
      /* If the user attempts to subscript something that is not an
234
         array or pointer type (like a plain int variable for example),
235
         then report this as an error.  */
236
 
237
      arg1 = coerce_ref (arg1);
238
      type = check_typedef (value_type (arg1));
239
 
240
      if (m2_is_unbounded_array (type))
241
        {
242
          struct value *temp = arg1;
243
          type = TYPE_FIELD_TYPE (type, 0);
244
          if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR))
245
            {
246
              warning (_("internal error: unbounded array structure is unknown"));
247
              return evaluate_subexp_standard (expect_type, exp, pos, noside);
248
            }
249
          /* i18n: Do not translate the "_m2_contents" part!  */
250
          arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
251
                                   _("unbounded structure "
252
                                     "missing _m2_contents field"));
253
 
254
          if (value_type (arg1) != type)
255
            arg1 = value_cast (type, arg1);
256
 
257
          type = check_typedef (value_type (arg1));
258
          return value_ind (value_ptradd (arg1, value_as_long (arg2)));
259
        }
260
      else
261
        if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
262
          {
263
            if (TYPE_NAME (type))
264
              error (_("cannot subscript something of type `%s'"),
265
                     TYPE_NAME (type));
266
            else
267
              error (_("cannot subscript requested type"));
268
          }
269
 
270
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
271
        return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
272
      else
273
        return value_subscript (arg1, value_as_long (arg2));
274
 
275
    default:
276
      return evaluate_subexp_standard (expect_type, exp, pos, noside);
277
    }
278
 
279
 nosideret:
280
  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
281
}
282
 
283
 
284
/* Table of operators and their precedences for printing expressions.  */
285
 
286
static const struct op_print m2_op_print_tab[] =
287
{
288
  {"+", BINOP_ADD, PREC_ADD, 0},
289
  {"+", UNOP_PLUS, PREC_PREFIX, 0},
290
  {"-", BINOP_SUB, PREC_ADD, 0},
291
  {"-", UNOP_NEG, PREC_PREFIX, 0},
292
  {"*", BINOP_MUL, PREC_MUL, 0},
293
  {"/", BINOP_DIV, PREC_MUL, 0},
294
  {"DIV", BINOP_INTDIV, PREC_MUL, 0},
295
  {"MOD", BINOP_REM, PREC_MUL, 0},
296
  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
297
  {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
298
  {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
299
  {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
300
  {"=", BINOP_EQUAL, PREC_EQUAL, 0},
301
  {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
302
  {"<=", BINOP_LEQ, PREC_ORDER, 0},
303
  {">=", BINOP_GEQ, PREC_ORDER, 0},
304
  {">", BINOP_GTR, PREC_ORDER, 0},
305
  {"<", BINOP_LESS, PREC_ORDER, 0},
306
  {"^", UNOP_IND, PREC_PREFIX, 0},
307
  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
308
  {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
309
  {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
310
  {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
311
  {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
312
  {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
313
  {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
314
  {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
315
  {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
316
  {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
317
  {NULL, 0, 0, 0}
318
};
319
 
320
/* The built-in types of Modula-2.  */
321
 
322
enum m2_primitive_types {
323
  m2_primitive_type_char,
324
  m2_primitive_type_int,
325
  m2_primitive_type_card,
326
  m2_primitive_type_real,
327
  m2_primitive_type_bool,
328
  nr_m2_primitive_types
329
};
330
 
331
static void
332
m2_language_arch_info (struct gdbarch *gdbarch,
333
                       struct language_arch_info *lai)
334
{
335
  const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
336
 
337
  lai->string_char_type = builtin->builtin_char;
338
  lai->primitive_type_vector
339
    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
340
                              struct type *);
341
 
342
  lai->primitive_type_vector [m2_primitive_type_char]
343
    = builtin->builtin_char;
344
  lai->primitive_type_vector [m2_primitive_type_int]
345
    = builtin->builtin_int;
346
  lai->primitive_type_vector [m2_primitive_type_card]
347
    = builtin->builtin_card;
348
  lai->primitive_type_vector [m2_primitive_type_real]
349
    = builtin->builtin_real;
350
  lai->primitive_type_vector [m2_primitive_type_bool]
351
    = builtin->builtin_bool;
352
 
353
  lai->bool_type_symbol = "BOOLEAN";
354
  lai->bool_type_default = builtin->builtin_bool;
355
}
356
 
357
const struct exp_descriptor exp_descriptor_modula2 =
358
{
359
  print_subexp_standard,
360
  operator_length_standard,
361
  operator_check_standard,
362
  op_name_standard,
363
  dump_subexp_body_standard,
364
  evaluate_subexp_modula2
365
};
366
 
367
const struct language_defn m2_language_defn =
368
{
369
  "modula-2",
370
  language_m2,
371
  range_check_on,
372
  type_check_on,
373
  case_sensitive_on,
374
  array_row_major,
375
  macro_expansion_no,
376
  &exp_descriptor_modula2,
377
  m2_parse,                     /* parser */
378
  m2_error,                     /* parser error function */
379
  null_post_parser,
380
  m2_printchar,                 /* Print character constant */
381
  m2_printstr,                  /* function to print string constant */
382
  m2_emit_char,                 /* Function to print a single character */
383
  m2_print_type,                /* Print a type using appropriate syntax */
384
  m2_print_typedef,             /* Print a typedef using appropriate syntax */
385
  m2_val_print,                 /* Print a value using appropriate syntax */
386
  c_value_print,                /* Print a top-level value */
387
  NULL,                         /* Language specific skip_trampoline */
388
  NULL,                         /* name_of_this */
389
  basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
390
  basic_lookup_transparent_type,/* lookup_transparent_type */
391
  NULL,                         /* Language specific symbol demangler */
392
  NULL,                         /* Language specific class_name_from_physname */
393
  m2_op_print_tab,              /* expression operators for printing */
394
  0,                             /* arrays are first-class (not c-style) */
395
  0,                             /* String lower bound */
396
  default_word_break_characters,
397
  default_make_symbol_completion_list,
398
  m2_language_arch_info,
399
  default_print_array_index,
400
  default_pass_by_reference,
401
  default_get_string,
402
  LANG_MAGIC
403
};
404
 
405
static void *
406
build_m2_types (struct gdbarch *gdbarch)
407
{
408
  struct builtin_m2_type *builtin_m2_type
409
    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
410
 
411
  /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
412
  builtin_m2_type->builtin_int
413
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
414
  builtin_m2_type->builtin_card
415
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
416
  builtin_m2_type->builtin_real
417
    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", NULL);
418
  builtin_m2_type->builtin_char
419
    = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
420
  builtin_m2_type->builtin_bool
421
    = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
422
 
423
  return builtin_m2_type;
424
}
425
 
426
static struct gdbarch_data *m2_type_data;
427
 
428
const struct builtin_m2_type *
429
builtin_m2_type (struct gdbarch *gdbarch)
430
{
431
  return gdbarch_data (gdbarch, m2_type_data);
432
}
433
 
434
 
435
/* Initialization for Modula-2 */
436
 
437
void
438
_initialize_m2_language (void)
439
{
440
  m2_type_data = gdbarch_data_register_post_init (build_m2_types);
441
 
442
  add_language (&m2_language_defn);
443
}

powered by: WebSVN 2.1.0

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