1 /* Scheme/Guile language support routines for GDB, the GNU debugger.
3 Copyright 1995, 1996, 2000, 2003, 2005 Free Software Foundation,
6 This file is part of GDB.
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 2 of the License, or
11 (at your option) any later version.
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.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
26 #include "expression.h"
27 #include "parser-defs.h"
34 #define USE_EXPRSTRING 0
36 static void scm_lreadparen (int);
37 static int scm_skip_ws (void);
38 static void scm_read_token (int, int);
39 static LONGEST scm_istring2number (char *, int, int);
40 static LONGEST scm_istr2int (char *, int, int);
41 static void scm_lreadr (int);
44 scm_istr2int (char *str, int len, int radix)
52 return SCM_BOOL_F; /* zero scm_length */
59 return SCM_BOOL_F; /* bad if lone `+' or `-' */
94 return SCM_BOOL_F; /* bad digit for radix */
99 return SCM_BOOL_F; /* not a digit */
105 return SCM_MAKINUM (inum);
109 scm_istring2number (char *str, int len, int radix)
113 char ex_p = 0, rx_p = 0; /* Only allow 1 exactness and 1 radix prefix */
118 if (*str == '+' || *str == '-') /* Catches lone `+' and `-' for speed */
121 while ((len - i) >= 2 && str[i] == '#' && ++i)
167 return scm_istr2int (&str[i], len - i, radix);
169 return scm_istr2int (&str[i], len - i, radix);
175 return scm_istr2flo (&str[i], len - i, radix);
183 scm_read_token (int c, int weird)
203 case '\0': /* End of line */
244 switch ((c = *lexptr++))
251 switch ((c = *lexptr++))
272 scm_lreadparen (int skipping)
276 int c = scm_skip_ws ();
277 if (')' == c || ']' == c)
281 error ("missing close paren");
282 scm_lreadr (skipping);
287 scm_lreadr (int skipping)
301 scm_lreadparen (skipping);
305 error ("unexpected #\\%c", c);
309 str.ptr = lexptr - 1;
310 scm_lreadr (skipping);
313 struct value *val = scm_evaluate_string (str.ptr, lexptr - str.ptr);
314 if (!is_scmvalue_type (value_type (val)))
315 error ("quoted scm form yields non-SCM value");
316 svalue = extract_signed_integer (value_contents (val),
317 TYPE_LENGTH (value_type (val)));
318 goto handle_immediate;
325 scm_lreadr (skipping);
333 scm_lreadparen (skipping);
338 goto handle_immediate;
342 goto handle_immediate;
358 case '*': /* bitvector */
359 scm_read_token (c, 0);
362 scm_read_token (c, 1);
364 case '\\': /* character */
366 scm_read_token (c, 0);
369 j = 1; /* here j is the comment nesting depth */
376 error ("unbalanced comment");
380 if ('#' != (c = *lexptr++))
386 if ('|' != (c = *lexptr++))
397 scm_lreadr (skipping);
401 while ('\"' != (c = *lexptr++))
404 switch (c = *lexptr++)
407 error ("non-terminated string literal");
436 str.ptr = lexptr - 1;
437 scm_read_token (c, 0);
440 svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);
441 if (svalue != SCM_BOOL_F)
442 goto handle_immediate;
448 scm_read_token ('-', 0);
454 str.ptr = lexptr - 1;
455 scm_read_token (c, 0);
459 str.length = lexptr - str.ptr;
460 if (str.ptr[0] == '$')
462 write_dollar_variable (str);
465 write_exp_elt_opcode (OP_NAME);
466 write_exp_string (str);
467 write_exp_elt_opcode (OP_NAME);
474 write_exp_elt_opcode (OP_LONG);
475 write_exp_elt_type (builtin_type_scm);
476 write_exp_elt_longcst (svalue);
477 write_exp_elt_opcode (OP_LONG);
485 while (*lexptr == ' ')
488 scm_lreadr (USE_EXPRSTRING);
490 str.length = lexptr - start;
492 write_exp_elt_opcode (OP_EXPRSTRING);
493 write_exp_string (str);
494 write_exp_elt_opcode (OP_EXPRSTRING);