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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-7.1/] [gdb/] [scm-exp.c] - Blame information for rev 313

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

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

powered by: WebSVN 2.1.0

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