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, Boston, MA 02111-1307, USA. */
23 #include "expression.h"
24 #include "parser-defs.h"
31 #define USE_EXPRSTRING 0
33 static void scm_lreadr
PARAMS ((int));
36 scm_istr2int(str
, len
, radix
)
47 if (0 >= len
) return SCM_BOOL_F
; /* zero scm_length */
54 return SCM_BOOL_F
; /* bad if lone `+' or `-' */
57 switch (c
= str
[i
++]) {
58 case '0': case '1': case '2': case '3': case '4':
59 case '5': case '6': case '7': case '8': case '9':
62 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
65 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
68 if (c
>= radix
) return SCM_BOOL_F
; /* bad digit for radix */
73 return SCM_BOOL_F
; /* not a digit */
78 return SCM_MAKINUM (inum
);
82 scm_istring2number(str
, len
, radix
)
89 char ex_p
= 0, rx_p
= 0; /* Only allow 1 exactness and 1 radix prefix */
92 if (*str
=='+' || *str
=='-') /* Catches lone `+' and `-' for speed */
95 while ((len
-i
) >= 2 && str
[i
]=='#' && ++i
)
97 case 'b': case 'B': if (rx_p
++) return SCM_BOOL_F
; radix
= 2; break;
98 case 'o': case 'O': if (rx_p
++) return SCM_BOOL_F
; radix
= 8; break;
99 case 'd': case 'D': if (rx_p
++) return SCM_BOOL_F
; radix
= 10; break;
100 case 'x': case 'X': if (rx_p
++) return SCM_BOOL_F
; radix
= 16; break;
101 case 'i': case 'I': if (ex_p
++) return SCM_BOOL_F
; ex
= 2; break;
102 case 'e': case 'E': if (ex_p
++) return SCM_BOOL_F
; ex
= 1; break;
103 default: return SCM_BOOL_F
;
108 return scm_istr2int(&str
[i
], len
-i
, radix
);
110 return scm_istr2int(&str
[i
], len
-i
, radix
);
112 if NFALSEP(res
) return res
;
114 case 2: return scm_istr2flo(&str
[i
], len
-i
, radix
);
122 scm_read_token (c
, weird
)
137 case ' ': case '\t': case '\r': case '\f':
141 case '\0': /* End of line */
182 switch ((c
= *lexptr
++))
189 switch ((c
= *lexptr
++))
198 case ' ': case '\t': case '\r': case '\f': case '\n':
206 scm_lreadparen (skipping
)
211 int c
= scm_skip_ws ();
212 if (')' == c
|| ']' == c
)
216 error ("missing close paren");
217 scm_lreadr (skipping
);
222 scm_lreadr (skipping
)
237 scm_lreadparen (skipping
);
241 error ("unexpected #\\%c", c
);
245 str
.ptr
= lexptr
- 1;
246 scm_lreadr (skipping
);
249 value_ptr val
= scm_evaluate_string (str
.ptr
, lexptr
- str
.ptr
);
250 if (!is_scmvalue_type (VALUE_TYPE (val
)))
251 error ("quoted scm form yields non-SCM value");
252 svalue
= extract_signed_integer (VALUE_CONTENTS (val
),
253 TYPE_LENGTH (VALUE_TYPE (val
)));
254 goto handle_immediate
;
261 scm_lreadr (skipping
);
269 scm_lreadparen (skipping
);
273 goto handle_immediate
;
276 goto handle_immediate
;
286 case '*': /* bitvector */
287 scm_read_token (c
, 0);
290 scm_read_token (c
, 1);
292 case '\\': /* character */
294 scm_read_token (c
, 0);
297 j
= 1; /* here j is the comment nesting depth */
304 error ("unbalanced comment");
308 if ('#' != (c
= *lexptr
++))
314 if ('|' != (c
= *lexptr
++))
323 scm_lreadr (skipping
);
327 while ('\"' != (c
= *lexptr
++))
330 switch (c
= *lexptr
++)
333 error ("non-terminated string literal");
347 case '0': case '1': case '2': case '3': case '4':
348 case '5': case '6': case '7': case '8': case '9':
355 scm_read_token (c
, 0);
358 svalue
= scm_istring2number (str
.ptr
, lexptr
- str
.ptr
, 10);
359 if (svalue
!= SCM_BOOL_F
)
360 goto handle_immediate
;
366 scm_read_token ('-', 0);
371 scm_read_token (c
, 0);
375 str
.length
= lexptr
- str
.ptr
;
376 if (str
.ptr
[0] == '$')
378 write_dollar_variable (str
);
381 write_exp_elt_opcode (OP_NAME
);
382 write_exp_string (str
);
383 write_exp_elt_opcode (OP_NAME
);
390 write_exp_elt_opcode (OP_LONG
);
391 write_exp_elt_type (builtin_type_scm
);
392 write_exp_elt_longcst (svalue
);
393 write_exp_elt_opcode (OP_LONG
);
402 while (*lexptr
== ' ')
405 scm_lreadr (USE_EXPRSTRING
);
407 str
.length
= lexptr
- start
;
409 write_exp_elt_opcode (OP_EXPRSTRING
);
410 write_exp_string (str
);
411 write_exp_elt_opcode (OP_EXPRSTRING
);
This page took 0.039728 seconds and 4 git commands to generate.