From 071ea11e85eb9d529cc5eb3d35f6247466a21b99 Mon Sep 17 00:00:00 2001 From: Stan Shebs Date: Fri, 16 Apr 1999 01:34:07 +0000 Subject: Initial creation of sourceware repository --- gdb/scm-exp.c | 423 ---------------------------------------------------------- 1 file changed, 423 deletions(-) delete mode 100644 gdb/scm-exp.c (limited to 'gdb/scm-exp.c') diff --git a/gdb/scm-exp.c b/gdb/scm-exp.c deleted file mode 100644 index 6399563..0000000 --- a/gdb/scm-exp.c +++ /dev/null @@ -1,423 +0,0 @@ -/* Scheme/Guile language support routines for GDB, the GNU debugger. - Copyright 1995 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 2 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, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - -#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 PARAMS ((int)); -static int scm_skip_ws PARAMS ((void)); -static void scm_read_token PARAMS ((int, int)); -static LONGEST scm_istring2number PARAMS ((char *, int, int)); -static LONGEST scm_istr2int PARAMS ((char *, int, int)); -static void scm_lreadr PARAMS ((int)); - -static LONGEST -scm_istr2int(str, len, radix) - 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(str, len, radix) - 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 (c, weird) - 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 () -{ - register 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 (skipping) - 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 (skipping) - 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) - { - value_ptr 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 () -{ - 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; -} -- cgit v1.1