]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/scm-exp.c
2001-01-16 Michael Snyder <msnyder@cleaver.cygnus.com>
[thirdparty/binutils-gdb.git] / gdb / scm-exp.c
CommitLineData
c906108c
SS
1/* Scheme/Guile language support routines for GDB, the GNU debugger.
2 Copyright 1995 Free Software Foundation, Inc.
3
c5aa993b 4 This file is part of GDB.
c906108c 5
c5aa993b
JM
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
c906108c 10
c5aa993b
JM
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
c906108c 15
c5aa993b
JM
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
c906108c
SS
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
a14ed312
KB
34static void scm_lreadparen (int);
35static int scm_skip_ws (void);
36static void scm_read_token (int, int);
37static LONGEST scm_istring2number (char *, int, int);
38static LONGEST scm_istr2int (char *, int, int);
39static void scm_lreadr (int);
c906108c
SS
40
41static LONGEST
fba45db2 42scm_istr2int (char *str, int len, int radix)
c906108c
SS
43{
44 int i = 0;
45 LONGEST inum = 0;
46 int c;
47 int sign = 0;
48
c5aa993b
JM
49 if (0 >= len)
50 return SCM_BOOL_F; /* zero scm_length */
c906108c 51 switch (str[0])
c5aa993b 52 { /* leading sign */
c906108c
SS
53 case '-':
54 case '+':
55 sign = str[0];
c5aa993b
JM
56 if (++i == len)
57 return SCM_BOOL_F; /* bad if lone `+' or `-' */
c906108c 58 }
c5aa993b
JM
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 }
c906108c 99 }
c5aa993b 100 while (i < len);
c906108c
SS
101 if (sign == '-')
102 inum = -inum;
103 return SCM_MAKINUM (inum);
104}
105
106static LONGEST
fba45db2 107scm_istring2number (char *str, int len, int radix)
c906108c
SS
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
c5aa993b
JM
115 if (len == 1)
116 if (*str == '+' || *str == '-') /* Catches lone `+' and `-' for speed */
c906108c
SS
117 return SCM_BOOL_F;
118
c5aa993b
JM
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 }
c906108c 161
c5aa993b
JM
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);
c906108c 168#if 0
c5aa993b
JM
169 if NFALSEP
170 (res) return res;
c906108c 171#ifdef FLOATS
c5aa993b
JM
172 case 2:
173 return scm_istr2flo (&str[i], len - i, radix);
c906108c
SS
174#endif
175#endif
c5aa993b 176 }
c906108c
SS
177 return SCM_BOOL_F;
178}
179
180static void
fba45db2 181scm_read_token (int c, int weird)
c906108c
SS
182{
183 while (1)
184 {
185 c = *lexptr++;
186 switch (c)
187 {
188 case '[':
189 case ']':
190 case '(':
191 case ')':
192 case '\"':
193 case ';':
c5aa993b
JM
194 case ' ':
195 case '\t':
196 case '\r':
197 case '\f':
c906108c
SS
198 case '\n':
199 if (weird)
200 goto default_case;
c5aa993b 201 case '\0': /* End of line */
c906108c
SS
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
c5aa993b 237static int
fba45db2 238scm_skip_ws (void)
c906108c
SS
239{
240 register 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 }
c5aa993b
JM
258 case ' ':
259 case '\t':
260 case '\r':
261 case '\f':
262 case '\n':
c906108c
SS
263 break;
264 default:
265 return c;
266 }
267}
268
269static void
fba45db2 270scm_lreadparen (int skipping)
c906108c
SS
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
284static void
fba45db2 285scm_lreadr (int skipping)
c906108c
SS
286{
287 int c, j;
288 struct stoken str;
289 LONGEST svalue = 0;
c5aa993b 290tryagain:
c906108c
SS
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 value_ptr 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 goto handle_immediate;
317 }
318 return;
319 case ',':
320 c = *lexptr++;
321 if ('@' != c)
322 lexptr--;
323 scm_lreadr (skipping);
324 return;
325 case '#':
326 c = *lexptr++;
327 switch (c)
328 {
329 case '[':
330 case '(':
331 scm_lreadparen (skipping);
332 return;
c5aa993b
JM
333 case 't':
334 case 'T':
c906108c
SS
335 svalue = SCM_BOOL_T;
336 goto handle_immediate;
c5aa993b
JM
337 case 'f':
338 case 'F':
c906108c
SS
339 svalue = SCM_BOOL_F;
340 goto handle_immediate;
c5aa993b
JM
341 case 'b':
342 case 'B':
343 case 'o':
344 case 'O':
345 case 'd':
346 case 'D':
347 case 'x':
348 case 'X':
349 case 'i':
350 case 'I':
351 case 'e':
352 case 'E':
c906108c
SS
353 lexptr--;
354 c = '#';
355 goto num;
c5aa993b 356 case '*': /* bitvector */
c906108c
SS
357 scm_read_token (c, 0);
358 return;
359 case '{':
360 scm_read_token (c, 1);
361 return;
c5aa993b 362 case '\\': /* character */
c906108c
SS
363 c = *lexptr++;
364 scm_read_token (c, 0);
365 return;
366 case '|':
367 j = 1; /* here j is the comment nesting depth */
368 lp:
369 c = *lexptr++;
370 lpc:
371 switch (c)
372 {
373 case '\0':
374 error ("unbalanced comment");
375 default:
376 goto lp;
377 case '|':
378 if ('#' != (c = *lexptr++))
379 goto lpc;
380 if (--j)
381 goto lp;
382 break;
383 case '#':
384 if ('|' != (c = *lexptr++))
385 goto lpc;
386 ++j;
387 goto lp;
388 }
389 goto tryagain;
390 case '.':
391 default:
392#if 0
393 callshrp:
394#endif
395 scm_lreadr (skipping);
396 return;
397 }
398 case '\"':
399 while ('\"' != (c = *lexptr++))
400 {
401 if (c == '\\')
402 switch (c = *lexptr++)
403 {
404 case '\0':
405 error ("non-terminated string literal");
406 case '\n':
407 continue;
408 case '0':
409 case 'f':
410 case 'n':
411 case 'r':
412 case 't':
413 case 'a':
414 case 'v':
415 break;
416 }
417 }
418 return;
c5aa993b
JM
419 case '0':
420 case '1':
421 case '2':
422 case '3':
423 case '4':
424 case '5':
425 case '6':
426 case '7':
427 case '8':
428 case '9':
c906108c
SS
429 case '.':
430 case '-':
431 case '+':
432 num:
433 {
c5aa993b 434 str.ptr = lexptr - 1;
c906108c
SS
435 scm_read_token (c, 0);
436 if (!skipping)
437 {
438 svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);
439 if (svalue != SCM_BOOL_F)
440 goto handle_immediate;
441 goto tok;
442 }
443 }
444 return;
445 case ':':
446 scm_read_token ('-', 0);
447 return;
448#if 0
449 do_symbol:
450#endif
451 default:
c5aa993b 452 str.ptr = lexptr - 1;
c906108c
SS
453 scm_read_token (c, 0);
454 tok:
455 if (!skipping)
456 {
457 str.length = lexptr - str.ptr;
458 if (str.ptr[0] == '$')
459 {
460 write_dollar_variable (str);
461 return;
462 }
463 write_exp_elt_opcode (OP_NAME);
464 write_exp_string (str);
465 write_exp_elt_opcode (OP_NAME);
466 }
467 return;
468 }
c5aa993b 469handle_immediate:
c906108c
SS
470 if (!skipping)
471 {
472 write_exp_elt_opcode (OP_LONG);
473 write_exp_elt_type (builtin_type_scm);
474 write_exp_elt_longcst (svalue);
475 write_exp_elt_opcode (OP_LONG);
476 }
477}
478
479int
fba45db2 480scm_parse (void)
c906108c 481{
c5aa993b 482 char *start;
c906108c
SS
483 while (*lexptr == ' ')
484 lexptr++;
485 start = lexptr;
486 scm_lreadr (USE_EXPRSTRING);
487#if USE_EXPRSTRING
488 str.length = lexptr - start;
489 str.ptr = start;
490 write_exp_elt_opcode (OP_EXPRSTRING);
491 write_exp_string (str);
492 write_exp_elt_opcode (OP_EXPRSTRING);
493#endif
494 return 0;
495}