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
);