Initial creation of sourceware repository

1 files changed, 0 insertions, 423 deletions

diff --git a/gdb/scm-exp.c b/gdb/scm-exp.c
deleted file mode 100644
index 63995639dc..0000000000
--- 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;
-}