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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gdb-7.2/] [gdb/] [scm-exp.c] - Blame information for rev 841

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 330 jeremybenn
/* Scheme/Guile language support routines for GDB, the GNU debugger.
2
 
3
   Copyright (C) 1995, 1996, 2000, 2003, 2005, 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
#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 "value.h"
28
#include "c-lang.h"
29
#include "scm-lang.h"
30
#include "scm-tags.h"
31
 
32
#define USE_EXPRSTRING 0
33
 
34
static void scm_lreadparen (int);
35
static int scm_skip_ws (void);
36
static void scm_read_token (int, int);
37
static LONGEST scm_istring2number (char *, int, int);
38
static LONGEST scm_istr2int (char *, int, int);
39
static void scm_lreadr (int);
40
 
41
static LONGEST
42
scm_istr2int (char *str, int len, int radix)
43
{
44
  int i = 0;
45
  LONGEST inum = 0;
46
  int c;
47
  int sign = 0;
48
 
49
  if (0 >= len)
50
    return SCM_BOOL_F;          /* zero scm_length */
51
  switch (str[0])
52
    {                           /* leading sign */
53
    case '-':
54
    case '+':
55
      sign = str[0];
56
      if (++i == len)
57
        return SCM_BOOL_F;      /* bad if lone `+' or `-' */
58
    }
59
  do
60
    {
61
      switch (c = str[i++])
62
        {
63
        case '0':
64
        case '1':
65
        case '2':
66
        case '3':
67
        case '4':
68
        case '5':
69
        case '6':
70
        case '7':
71
        case '8':
72
        case '9':
73
          c = c - '0';
74
          goto accumulate;
75
        case 'A':
76
        case 'B':
77
        case 'C':
78
        case 'D':
79
        case 'E':
80
        case 'F':
81
          c = c - 'A' + 10;
82
          goto accumulate;
83
        case 'a':
84
        case 'b':
85
        case 'c':
86
        case 'd':
87
        case 'e':
88
        case 'f':
89
          c = c - 'a' + 10;
90
        accumulate:
91
          if (c >= radix)
92
            return SCM_BOOL_F;  /* bad digit for radix */
93
          inum *= radix;
94
          inum += c;
95
          break;
96
        default:
97
          return SCM_BOOL_F;    /* not a digit */
98
        }
99
    }
100
  while (i < len);
101
  if (sign == '-')
102
    inum = -inum;
103
  return SCM_MAKINUM (inum);
104
}
105
 
106
static LONGEST
107
scm_istring2number (char *str, int len, int radix)
108
{
109
  int i = 0;
110
  char ex = 0;
111
  char ex_p = 0, rx_p = 0;        /* Only allow 1 exactness and 1 radix prefix */
112
#if 0
113
  SCM res;
114
#endif
115
 
116
  if (len == 1)
117
    if (*str == '+' || *str == '-')     /* Catches lone `+' and `-' for speed */
118
      return SCM_BOOL_F;
119
 
120
  while ((len - i) >= 2 && str[i] == '#' && ++i)
121
    switch (str[i++])
122
      {
123
      case 'b':
124
      case 'B':
125
        if (rx_p++)
126
          return SCM_BOOL_F;
127
        radix = 2;
128
        break;
129
      case 'o':
130
      case 'O':
131
        if (rx_p++)
132
          return SCM_BOOL_F;
133
        radix = 8;
134
        break;
135
      case 'd':
136
      case 'D':
137
        if (rx_p++)
138
          return SCM_BOOL_F;
139
        radix = 10;
140
        break;
141
      case 'x':
142
      case 'X':
143
        if (rx_p++)
144
          return SCM_BOOL_F;
145
        radix = 16;
146
        break;
147
      case 'i':
148
      case 'I':
149
        if (ex_p++)
150
          return SCM_BOOL_F;
151
        ex = 2;
152
        break;
153
      case 'e':
154
      case 'E':
155
        if (ex_p++)
156
          return SCM_BOOL_F;
157
        ex = 1;
158
        break;
159
      default:
160
        return SCM_BOOL_F;
161
      }
162
 
163
  switch (ex)
164
    {
165
    case 1:
166
      return scm_istr2int (&str[i], len - i, radix);
167
    case 0:
168
      return scm_istr2int (&str[i], len - i, radix);
169
#if 0
170
      if NFALSEP
171
        (res) return res;
172
#ifdef FLOATS
173
    case 2:
174
      return scm_istr2flo (&str[i], len - i, radix);
175
#endif
176
#endif
177
    }
178
  return SCM_BOOL_F;
179
}
180
 
181
static void
182
scm_read_token (int c, int weird)
183
{
184
  while (1)
185
    {
186
      c = *lexptr++;
187
      switch (c)
188
        {
189
        case '[':
190
        case ']':
191
        case '(':
192
        case ')':
193
        case '\"':
194
        case ';':
195
        case ' ':
196
        case '\t':
197
        case '\r':
198
        case '\f':
199
        case '\n':
200
          if (weird)
201
            goto default_case;
202
        case '\0':              /* End of line */
203
        eof_case:
204
          --lexptr;
205
          return;
206
        case '\\':
207
          if (!weird)
208
            goto default_case;
209
          else
210
            {
211
              c = *lexptr++;
212
              if (c == '\0')
213
                goto eof_case;
214
              else
215
                goto default_case;
216
            }
217
        case '}':
218
          if (!weird)
219
            goto default_case;
220
 
221
          c = *lexptr++;
222
          if (c == '#')
223
            return;
224
          else
225
            {
226
              --lexptr;
227
              c = '}';
228
              goto default_case;
229
            }
230
 
231
        default:
232
        default_case:
233
          ;
234
        }
235
    }
236
}
237
 
238
static int
239
scm_skip_ws (void)
240
{
241
  int c;
242
 
243
  while (1)
244
    switch ((c = *lexptr++))
245
      {
246
      case '\0':
247
      goteof:
248
        return c;
249
      case ';':
250
      lp:
251
        switch ((c = *lexptr++))
252
          {
253
          case '\0':
254
            goto goteof;
255
          default:
256
            goto lp;
257
          case '\n':
258
            break;
259
          }
260
      case ' ':
261
      case '\t':
262
      case '\r':
263
      case '\f':
264
      case '\n':
265
        break;
266
      default:
267
        return c;
268
      }
269
}
270
 
271
static void
272
scm_lreadparen (int skipping)
273
{
274
  for (;;)
275
    {
276
      int c = scm_skip_ws ();
277
 
278
      if (')' == c || ']' == c)
279
        return;
280
      --lexptr;
281
      if (c == '\0')
282
        error ("missing close paren");
283
      scm_lreadr (skipping);
284
    }
285
}
286
 
287
static void
288
scm_lreadr (int skipping)
289
{
290
  int c, j;
291
  struct stoken str;
292
  LONGEST svalue = 0;
293
 
294
tryagain:
295
  c = *lexptr++;
296
  switch (c)
297
    {
298
    case '\0':
299
      lexptr--;
300
      return;
301
    case '[':
302
    case '(':
303
      scm_lreadparen (skipping);
304
      return;
305
    case ']':
306
    case ')':
307
      error ("unexpected #\\%c", c);
308
      goto tryagain;
309
    case '\'':
310
    case '`':
311
      str.ptr = lexptr - 1;
312
      scm_lreadr (skipping);
313
      if (!skipping)
314
        {
315
          struct value *val = scm_evaluate_string (str.ptr, lexptr - str.ptr);
316
 
317
          if (!is_scmvalue_type (value_type (val)))
318
            error ("quoted scm form yields non-SCM value");
319
          svalue = extract_signed_integer (value_contents (val),
320
                                           TYPE_LENGTH (value_type (val)),
321
                                           gdbarch_byte_order (parse_gdbarch));
322
          goto handle_immediate;
323
        }
324
      return;
325
    case ',':
326
      c = *lexptr++;
327
      if ('@' != c)
328
        lexptr--;
329
      scm_lreadr (skipping);
330
      return;
331
    case '#':
332
      c = *lexptr++;
333
      switch (c)
334
        {
335
        case '[':
336
        case '(':
337
          scm_lreadparen (skipping);
338
          return;
339
        case 't':
340
        case 'T':
341
          svalue = SCM_BOOL_T;
342
          goto handle_immediate;
343
        case 'f':
344
        case 'F':
345
          svalue = SCM_BOOL_F;
346
          goto handle_immediate;
347
        case 'b':
348
        case 'B':
349
        case 'o':
350
        case 'O':
351
        case 'd':
352
        case 'D':
353
        case 'x':
354
        case 'X':
355
        case 'i':
356
        case 'I':
357
        case 'e':
358
        case 'E':
359
          lexptr--;
360
          c = '#';
361
          goto num;
362
        case '*':               /* bitvector */
363
          scm_read_token (c, 0);
364
          return;
365
        case '{':
366
          scm_read_token (c, 1);
367
          return;
368
        case '\\':              /* character */
369
          c = *lexptr++;
370
          scm_read_token (c, 0);
371
          return;
372
        case '|':
373
          j = 1;                /* here j is the comment nesting depth */
374
        lp:
375
          c = *lexptr++;
376
        lpc:
377
          switch (c)
378
            {
379
            case '\0':
380
              error ("unbalanced comment");
381
            default:
382
              goto lp;
383
            case '|':
384
              if ('#' != (c = *lexptr++))
385
                goto lpc;
386
              if (--j)
387
                goto lp;
388
              break;
389
            case '#':
390
              if ('|' != (c = *lexptr++))
391
                goto lpc;
392
              ++j;
393
              goto lp;
394
            }
395
          goto tryagain;
396
        case '.':
397
        default:
398
#if 0
399
        callshrp:
400
#endif
401
          scm_lreadr (skipping);
402
          return;
403
        }
404
    case '\"':
405
      while ('\"' != (c = *lexptr++))
406
        {
407
          if (c == '\\')
408
            switch (c = *lexptr++)
409
              {
410
              case '\0':
411
                error ("non-terminated string literal");
412
              case '\n':
413
                continue;
414
              case '0':
415
              case 'f':
416
              case 'n':
417
              case 'r':
418
              case 't':
419
              case 'a':
420
              case 'v':
421
                break;
422
              }
423
        }
424
      return;
425
    case '0':
426
    case '1':
427
    case '2':
428
    case '3':
429
    case '4':
430
    case '5':
431
    case '6':
432
    case '7':
433
    case '8':
434
    case '9':
435
    case '.':
436
    case '-':
437
    case '+':
438
    num:
439
      {
440
        str.ptr = lexptr - 1;
441
        scm_read_token (c, 0);
442
        if (!skipping)
443
          {
444
            svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);
445
            if (svalue != SCM_BOOL_F)
446
              goto handle_immediate;
447
            goto tok;
448
          }
449
      }
450
      return;
451
    case ':':
452
      scm_read_token ('-', 0);
453
      return;
454
#if 0
455
    do_symbol:
456
#endif
457
    default:
458
      str.ptr = lexptr - 1;
459
      scm_read_token (c, 0);
460
    tok:
461
      if (!skipping)
462
        {
463
          str.length = lexptr - str.ptr;
464
          if (str.ptr[0] == '$')
465
            {
466
              write_dollar_variable (str);
467
              return;
468
            }
469
          write_exp_elt_opcode (OP_NAME);
470
          write_exp_string (str);
471
          write_exp_elt_opcode (OP_NAME);
472
        }
473
      return;
474
    }
475
handle_immediate:
476
  if (!skipping)
477
    {
478
      write_exp_elt_opcode (OP_LONG);
479
      write_exp_elt_type (builtin_scm_type (parse_gdbarch)->builtin_scm);
480
      write_exp_elt_longcst (svalue);
481
      write_exp_elt_opcode (OP_LONG);
482
    }
483
}
484
 
485
int
486
scm_parse (void)
487
{
488
  char *start;
489
 
490
  while (*lexptr == ' ')
491
    lexptr++;
492
  start = lexptr;
493
  scm_lreadr (USE_EXPRSTRING);
494
#if USE_EXPRSTRING
495
  str.length = lexptr - start;
496
  str.ptr = start;
497
  write_exp_elt_opcode (OP_EXPRSTRING);
498
  write_exp_string (str);
499
  write_exp_elt_opcode (OP_EXPRSTRING);
500
#endif
501
  return 0;
502
}

powered by: WebSVN 2.1.0

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