1 /* Scheme/Guile language support routines for GDB, the GNU debugger.
3 Copyright (C) 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., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, 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
);
This page took 0.038767 seconds and 4 git commands to generate.