URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gdb-6.8/] [pre-binutils-2.20.1-sync/] [gdb/] [scm-exp.c] - Rev 275
Go to most recent revision | Compare with Previous | Blame | View Log
/* Scheme/Guile language support routines for GDB, the GNU debugger. Copyright (C) 1995, 1996, 2000, 2003, 2005, 2008 Free Software Foundation, Inc. This file is part of GDB. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see <http://www.gnu.org/licenses/>. */ #include "defs.h" #include "symtab.h" #include "gdbtypes.h" #include "expression.h" #include "parser-defs.h" #include "language.h" #include "value.h" #include "c-lang.h" #include "scm-lang.h" #include "scm-tags.h" #define USE_EXPRSTRING 0 static void scm_lreadparen (int); static int scm_skip_ws (void); static void scm_read_token (int, int); static LONGEST scm_istring2number (char *, int, int); static LONGEST scm_istr2int (char *, int, int); static void scm_lreadr (int); static LONGEST scm_istr2int (char *str, int len, int radix) { int i = 0; LONGEST inum = 0; int c; int sign = 0; if (0 >= len) return SCM_BOOL_F; /* zero scm_length */ switch (str[0]) { /* leading sign */ case '-': case '+': sign = str[0]; if (++i == len) return SCM_BOOL_F; /* bad if lone `+' or `-' */ } do { switch (c = str[i++]) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': c = c - '0'; goto accumulate; case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': c = c - 'A' + 10; goto accumulate; case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': c = c - 'a' + 10; accumulate: if (c >= radix) return SCM_BOOL_F; /* bad digit for radix */ inum *= radix; inum += c; break; default: return SCM_BOOL_F; /* not a digit */ } } while (i < len); if (sign == '-') inum = -inum; return SCM_MAKINUM (inum); } static LONGEST scm_istring2number (char *str, int len, int radix) { int i = 0; char ex = 0; char ex_p = 0, rx_p = 0; /* Only allow 1 exactness and 1 radix prefix */ #if 0 SCM res; #endif if (len == 1) if (*str == '+' || *str == '-') /* Catches lone `+' and `-' for speed */ return SCM_BOOL_F; while ((len - i) >= 2 && str[i] == '#' && ++i) switch (str[i++]) { case 'b': case 'B': if (rx_p++) return SCM_BOOL_F; radix = 2; break; case 'o': case 'O': if (rx_p++) return SCM_BOOL_F; radix = 8; break; case 'd': case 'D': if (rx_p++) return SCM_BOOL_F; radix = 10; break; case 'x': case 'X': if (rx_p++) return SCM_BOOL_F; radix = 16; break; case 'i': case 'I': if (ex_p++) return SCM_BOOL_F; ex = 2; break; case 'e': case 'E': if (ex_p++) return SCM_BOOL_F; ex = 1; break; default: return SCM_BOOL_F; } switch (ex) { case 1: return scm_istr2int (&str[i], len - i, radix); case 0: return scm_istr2int (&str[i], len - i, radix); #if 0 if NFALSEP (res) return res; #ifdef FLOATS case 2: return scm_istr2flo (&str[i], len - i, radix); #endif #endif } return SCM_BOOL_F; } static void scm_read_token (int c, int weird) { while (1) { c = *lexptr++; switch (c) { case '[': case ']': case '(': case ')': case '\"': case ';': case ' ': case '\t': case '\r': case '\f': case '\n': if (weird) goto default_case; case '\0': /* End of line */ eof_case: --lexptr; return; case '\\': if (!weird) goto default_case; else { c = *lexptr++; if (c == '\0') goto eof_case; else goto default_case; } case '}': if (!weird) goto default_case; c = *lexptr++; if (c == '#') return; else { --lexptr; c = '}'; goto default_case; } default: default_case: ; } } } static int scm_skip_ws (void) { int c; while (1) switch ((c = *lexptr++)) { case '\0': goteof: return c; case ';': lp: switch ((c = *lexptr++)) { case '\0': goto goteof; default: goto lp; case '\n': break; } case ' ': case '\t': case '\r': case '\f': case '\n': break; default: return c; } } static void scm_lreadparen (int skipping) { for (;;) { int c = scm_skip_ws (); if (')' == c || ']' == c) return; --lexptr; if (c == '\0') error ("missing close paren"); scm_lreadr (skipping); } } static void scm_lreadr (int skipping) { int c, j; struct stoken str; LONGEST svalue = 0; tryagain: c = *lexptr++; switch (c) { case '\0': lexptr--; return; case '[': case '(': scm_lreadparen (skipping); return; case ']': case ')': error ("unexpected #\\%c", c); goto tryagain; case '\'': case '`': str.ptr = lexptr - 1; scm_lreadr (skipping); if (!skipping) { struct value *val = scm_evaluate_string (str.ptr, lexptr - str.ptr); if (!is_scmvalue_type (value_type (val))) error ("quoted scm form yields non-SCM value"); svalue = extract_signed_integer (value_contents (val), TYPE_LENGTH (value_type (val))); goto handle_immediate; } return; case ',': c = *lexptr++; if ('@' != c) lexptr--; scm_lreadr (skipping); return; case '#': c = *lexptr++; switch (c) { case '[': case '(': scm_lreadparen (skipping); return; case 't': case 'T': svalue = SCM_BOOL_T; goto handle_immediate; case 'f': case 'F': svalue = SCM_BOOL_F; goto handle_immediate; case 'b': case 'B': case 'o': case 'O': case 'd': case 'D': case 'x': case 'X': case 'i': case 'I': case 'e': case 'E': lexptr--; c = '#'; goto num; case '*': /* bitvector */ scm_read_token (c, 0); return; case '{': scm_read_token (c, 1); return; case '\\': /* character */ c = *lexptr++; scm_read_token (c, 0); return; case '|': j = 1; /* here j is the comment nesting depth */ lp: c = *lexptr++; lpc: switch (c) { case '\0': error ("unbalanced comment"); default: goto lp; case '|': if ('#' != (c = *lexptr++)) goto lpc; if (--j) goto lp; break; case '#': if ('|' != (c = *lexptr++)) goto lpc; ++j; goto lp; } goto tryagain; case '.': default: #if 0 callshrp: #endif scm_lreadr (skipping); return; } case '\"': while ('\"' != (c = *lexptr++)) { if (c == '\\') switch (c = *lexptr++) { case '\0': error ("non-terminated string literal"); case '\n': continue; case '0': case 'f': case 'n': case 'r': case 't': case 'a': case 'v': break; } } return; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '.': case '-': case '+': num: { str.ptr = lexptr - 1; scm_read_token (c, 0); if (!skipping) { svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10); if (svalue != SCM_BOOL_F) goto handle_immediate; goto tok; } } return; case ':': scm_read_token ('-', 0); return; #if 0 do_symbol: #endif default: str.ptr = lexptr - 1; scm_read_token (c, 0); tok: if (!skipping) { str.length = lexptr - str.ptr; if (str.ptr[0] == '$') { write_dollar_variable (str); return; } write_exp_elt_opcode (OP_NAME); write_exp_string (str); write_exp_elt_opcode (OP_NAME); } return; } handle_immediate: if (!skipping) { write_exp_elt_opcode (OP_LONG); write_exp_elt_type (builtin_type_scm); write_exp_elt_longcst (svalue); write_exp_elt_opcode (OP_LONG); } } int scm_parse (void) { char *start; while (*lexptr == ' ') lexptr++; start = lexptr; scm_lreadr (USE_EXPRSTRING); #if USE_EXPRSTRING str.length = lexptr - start; str.ptr = start; write_exp_elt_opcode (OP_EXPRSTRING); write_exp_string (str); write_exp_elt_opcode (OP_EXPRSTRING); #endif return 0; }
Go to most recent revision | Compare with Previous | Blame | View Log