1 /* Scheme/Guile language support routines for GDB, the GNU debugger.
2 Copyright 1995 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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. */
24 #include "expression.h"
25 #include "parser-defs.h"
32 #define USE_EXPRSTRING 0
34 static void scm_lreadparen PARAMS ((int));
35 static int scm_skip_ws PARAMS ((void));
36 static void scm_read_token PARAMS ((int, int));
37 static LONGEST scm_istring2number PARAMS ((char *, int, int));
38 static LONGEST scm_istr2int PARAMS ((char *, int, int));
39 static void scm_lreadr PARAMS ((int));
42 scm_istr2int (str, len, radix)
53 return SCM_BOOL_F; /* zero scm_length */
60 return SCM_BOOL_F; /* bad if lone `+' or `-' */
95 return SCM_BOOL_F; /* bad digit for radix */
100 return SCM_BOOL_F; /* not a digit */
106 return SCM_MAKINUM (inum);
110 scm_istring2number (str, len, radix)
117 char ex_p = 0, rx_p = 0; /* Only allow 1 exactness and 1 radix prefix */
122 if (*str == '+' || *str == '-') /* Catches lone `+' and `-' for speed */
125 while ((len - i) >= 2 && str[i] == '#' && ++i)
171 return scm_istr2int (&str[i], len - i, radix);
173 return scm_istr2int (&str[i], len - i, radix);
179 return scm_istr2flo (&str[i], len - i, radix);
187 scm_read_token (c, weird)
209 case '\0': /* End of line */
250 switch ((c = *lexptr++))
257 switch ((c = *lexptr++))
278 scm_lreadparen (skipping)
283 int c = scm_skip_ws ();
284 if (')' == c || ']' == c)
288 error ("missing close paren");
289 scm_lreadr (skipping);
294 scm_lreadr (skipping)
309 scm_lreadparen (skipping);
313 error ("unexpected #\\%c", c);
317 str.ptr = lexptr - 1;
318 scm_lreadr (skipping);
321 value_ptr val = scm_evaluate_string (str.ptr, lexptr - str.ptr);
322 if (!is_scmvalue_type (VALUE_TYPE (val)))
323 error ("quoted scm form yields non-SCM value");
324 svalue = extract_signed_integer (VALUE_CONTENTS (val),
325 TYPE_LENGTH (VALUE_TYPE (val)));
326 goto handle_immediate;
333 scm_lreadr (skipping);
341 scm_lreadparen (skipping);
346 goto handle_immediate;
350 goto handle_immediate;
366 case '*': /* bitvector */
367 scm_read_token (c, 0);
370 scm_read_token (c, 1);
372 case '\\': /* character */
374 scm_read_token (c, 0);
377 j = 1; /* here j is the comment nesting depth */
384 error ("unbalanced comment");
388 if ('#' != (c = *lexptr++))
394 if ('|' != (c = *lexptr++))
405 scm_lreadr (skipping);
409 while ('\"' != (c = *lexptr++))
412 switch (c = *lexptr++)
415 error ("non-terminated string literal");
444 str.ptr = lexptr - 1;
445 scm_read_token (c, 0);
448 svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);
449 if (svalue != SCM_BOOL_F)
450 goto handle_immediate;
456 scm_read_token ('-', 0);
462 str.ptr = lexptr - 1;
463 scm_read_token (c, 0);
467 str.length = lexptr - str.ptr;
468 if (str.ptr[0] == '$')
470 write_dollar_variable (str);
473 write_exp_elt_opcode (OP_NAME);
474 write_exp_string (str);
475 write_exp_elt_opcode (OP_NAME);
482 write_exp_elt_opcode (OP_LONG);
483 write_exp_elt_type (builtin_type_scm);
484 write_exp_elt_longcst (svalue);
485 write_exp_elt_opcode (OP_LONG);
493 while (*lexptr == ' ')
496 scm_lreadr (USE_EXPRSTRING);
498 str.length = lexptr - start;
500 write_exp_elt_opcode (OP_EXPRSTRING);
501 write_exp_string (str);
502 write_exp_elt_opcode (OP_EXPRSTRING);