[binutils.git] / gdb / scm-exp.c

/* 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;
}
Commit	Line	Data
c906108c SS	1	/* Scheme/Guile language support routines for GDB, the GNU debugger.
	2	Copyright 1995 Free Software Foundation, Inc.
	3
c5aa993b	4	This file is part of GDB.
c906108c	5
c5aa993b JM	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.
c906108c	10
c5aa993b JM	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.
c906108c	15
c5aa993b JM	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. */
c906108c SS	20
	21	#include "defs.h"
	22	#include "symtab.h"
	23	#include "gdbtypes.h"
	24	#include "expression.h"
	25	#include "parser-defs.h"
	26	#include "language.h"
	27	#include "value.h"
	28	#include "c-lang.h"
	29	#include "scm-lang.h"
	30	#include "scm-tags.h"
	31
	32	#define USE_EXPRSTRING 0
	33
	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));
	40
	41	static LONGEST
c5aa993b	42	scm_istr2int (str, len, radix)
c906108c SS	43	char *str;
	44	int len;
	45	int radix;
	46	{
	47	int i = 0;
	48	LONGEST inum = 0;
	49	int c;
	50	int sign = 0;
	51
c5aa993b JM	52	if (0 >= len)
c5aa993b JM	53	return SCM_BOOL_F; /* zero scm_length */
c906108c	54	switch (str[0])
c5aa993b	55	{ /* leading sign */
c906108c SS	56	case '-':
	57	case '+':
	58	sign = str[0];
c5aa993b JM	59	if (++i == len)
c5aa993b JM	60	return SCM_BOOL_F; /* bad if lone `+' or `-' */
c906108c	61	}
c5aa993b JM	62	do
	63	{
	64	switch (c = str[i++])
	65	{
	66	case '0':
	67	case '1':
	68	case '2':
	69	case '3':
	70	case '4':
	71	case '5':
	72	case '6':
	73	case '7':
	74	case '8':
	75	case '9':
	76	c = c - '0';
	77	goto accumulate;
	78	case 'A':
	79	case 'B':
	80	case 'C':
	81	case 'D':
	82	case 'E':
	83	case 'F':
	84	c = c - 'A' + 10;
	85	goto accumulate;
	86	case 'a':
	87	case 'b':
	88	case 'c':
	89	case 'd':
	90	case 'e':
	91	case 'f':
	92	c = c - 'a' + 10;
	93	accumulate:
	94	if (c >= radix)
	95	return SCM_BOOL_F; /* bad digit for radix */
	96	inum *= radix;
	97	inum += c;
	98	break;
	99	default:
	100	return SCM_BOOL_F; /* not a digit */
	101	}
c906108c	102	}
c5aa993b	103	while (i < len);
c906108c SS	104	if (sign == '-')
	105	inum = -inum;
	106	return SCM_MAKINUM (inum);
	107	}
	108
	109	static LONGEST
c5aa993b	110	scm_istring2number (str, len, radix)
c906108c SS	111	char *str;
	112	int len;
	113	int radix;
	114	{
	115	int i = 0;
	116	char ex = 0;
	117	char ex_p = 0, rx_p = 0; /* Only allow 1 exactness and 1 radix prefix */
	118	#if 0
	119	SCM res;
	120	#endif
c5aa993b JM	121	if (len == 1)
c5aa993b JM	122	if (str == '+' \|\| str == '-') /* Catches lone `+' and `-' for speed */
c906108c SS	123	return SCM_BOOL_F;
c906108c SS	124
c5aa993b JM	125	while ((len - i) >= 2 && str[i] == '#' && ++i)
	126	switch (str[i++])
	127	{
	128	case 'b':
	129	case 'B':
	130	if (rx_p++)
	131	return SCM_BOOL_F;
	132	radix = 2;
	133	break;
	134	case 'o':
	135	case 'O':
	136	if (rx_p++)
	137	return SCM_BOOL_F;
	138	radix = 8;
	139	break;
	140	case 'd':
	141	case 'D':
	142	if (rx_p++)
	143	return SCM_BOOL_F;
	144	radix = 10;
	145	break;
	146	case 'x':
	147	case 'X':
	148	if (rx_p++)
	149	return SCM_BOOL_F;
	150	radix = 16;
	151	break;
	152	case 'i':
	153	case 'I':
	154	if (ex_p++)
	155	return SCM_BOOL_F;
	156	ex = 2;
	157	break;
	158	case 'e':
	159	case 'E':
	160	if (ex_p++)
	161	return SCM_BOOL_F;
	162	ex = 1;
	163	break;
	164	default:
	165	return SCM_BOOL_F;
	166	}
c906108c	167
c5aa993b JM	168	switch (ex)
	169	{
	170	case 1:
	171	return scm_istr2int (&str[i], len - i, radix);
	172	case 0:
	173	return scm_istr2int (&str[i], len - i, radix);
c906108c	174	#if 0
c5aa993b JM	175	if NFALSEP
c5aa993b JM	176	(res) return res;
c906108c	177	#ifdef FLOATS
c5aa993b JM	178	case 2:
c5aa993b JM	179	return scm_istr2flo (&str[i], len - i, radix);
c906108c SS	180	#endif
c906108c SS	181	#endif
c5aa993b	182	}
c906108c SS	183	return SCM_BOOL_F;
	184	}
	185
	186	static void
	187	scm_read_token (c, weird)
	188	int c;
	189	int weird;
	190	{
	191	while (1)
	192	{
	193	c = *lexptr++;
	194	switch (c)
	195	{
	196	case '[':
	197	case ']':
	198	case '(':
	199	case ')':
	200	case '\"':
	201	case ';':
c5aa993b JM	202	case ' ':
	203	case '\t':
	204	case '\r':
	205	case '\f':
c906108c SS	206	case '\n':
	207	if (weird)
	208	goto default_case;
c5aa993b	209	case '\0': /* End of line */
c906108c SS	210	eof_case:
	211	--lexptr;
	212	return;
	213	case '\\':
	214	if (!weird)
	215	goto default_case;
	216	else
	217	{
	218	c = *lexptr++;
	219	if (c == '\0')
	220	goto eof_case;
	221	else
	222	goto default_case;
	223	}
	224	case '}':
	225	if (!weird)
	226	goto default_case;
	227
	228	c = *lexptr++;
	229	if (c == '#')
	230	return;
	231	else
	232	{
	233	--lexptr;
	234	c = '}';
	235	goto default_case;
	236	}
	237
	238	default:
	239	default_case:
	240	;
	241	}
	242	}
	243	}
	244
c5aa993b	245	static int
c906108c SS	246	scm_skip_ws ()
	247	{
	248	register int c;
	249	while (1)
	250	switch ((c = *lexptr++))
	251	{
	252	case '\0':
	253	goteof:
	254	return c;
	255	case ';':
	256	lp:
	257	switch ((c = *lexptr++))
	258	{
	259	case '\0':
	260	goto goteof;
	261	default:
	262	goto lp;
	263	case '\n':
	264	break;
	265	}
c5aa993b JM	266	case ' ':
	267	case '\t':
	268	case '\r':
	269	case '\f':
	270	case '\n':
c906108c SS	271	break;
	272	default:
	273	return c;
	274	}
	275	}
	276
	277	static void
	278	scm_lreadparen (skipping)
	279	int skipping;
	280	{
	281	for (;;)
	282	{
	283	int c = scm_skip_ws ();
	284	if (')' == c \|\| ']' == c)
	285	return;
	286	--lexptr;
	287	if (c == '\0')
	288	error ("missing close paren");
	289	scm_lreadr (skipping);
	290	}
	291	}
	292
	293	static void
	294	scm_lreadr (skipping)
	295	int skipping;
	296	{
	297	int c, j;
	298	struct stoken str;
	299	LONGEST svalue = 0;
c5aa993b	300	tryagain:
c906108c SS	301	c = *lexptr++;
	302	switch (c)
	303	{
	304	case '\0':
	305	lexptr--;
	306	return;
	307	case '[':
	308	case '(':
	309	scm_lreadparen (skipping);
	310	return;
	311	case ']':
	312	case ')':
	313	error ("unexpected #\\%c", c);
	314	goto tryagain;
	315	case '\'':
	316	case '`':
	317	str.ptr = lexptr - 1;
	318	scm_lreadr (skipping);
	319	if (!skipping)
	320	{
	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;
	327	}
	328	return;
	329	case ',':
	330	c = *lexptr++;
	331	if ('@' != c)
	332	lexptr--;
	333	scm_lreadr (skipping);
	334	return;
	335	case '#':
	336	c = *lexptr++;
	337	switch (c)
	338	{
	339	case '[':
	340	case '(':
	341	scm_lreadparen (skipping);
	342	return;
c5aa993b JM	343	case 't':
c5aa993b JM	344	case 'T':
c906108c SS	345	svalue = SCM_BOOL_T;
c906108c SS	346	goto handle_immediate;
c5aa993b JM	347	case 'f':
c5aa993b JM	348	case 'F':
c906108c SS	349	svalue = SCM_BOOL_F;
c906108c SS	350	goto handle_immediate;
c5aa993b JM	351	case 'b':
	352	case 'B':
	353	case 'o':
	354	case 'O':
	355	case 'd':
	356	case 'D':
	357	case 'x':
	358	case 'X':
	359	case 'i':
	360	case 'I':
	361	case 'e':
	362	case 'E':
c906108c SS	363	lexptr--;
	364	c = '#';
	365	goto num;
c5aa993b	366	case '': / bitvector */
c906108c SS	367	scm_read_token (c, 0);
	368	return;
	369	case '{':
	370	scm_read_token (c, 1);
	371	return;
c5aa993b	372	case '\\': /* character */
c906108c SS	373	c = *lexptr++;
	374	scm_read_token (c, 0);
	375	return;
	376	case '\|':
	377	j = 1; /* here j is the comment nesting depth */
	378	lp:
	379	c = *lexptr++;
	380	lpc:
	381	switch (c)
	382	{
	383	case '\0':
	384	error ("unbalanced comment");
	385	default:
	386	goto lp;
	387	case '\|':
	388	if ('#' != (c = *lexptr++))
	389	goto lpc;
	390	if (--j)
	391	goto lp;
	392	break;
	393	case '#':
	394	if ('\|' != (c = *lexptr++))
	395	goto lpc;
	396	++j;
	397	goto lp;
	398	}
	399	goto tryagain;
	400	case '.':
	401	default:
	402	#if 0
	403	callshrp:
	404	#endif
	405	scm_lreadr (skipping);
	406	return;
	407	}
	408	case '\"':
	409	while ('\"' != (c = *lexptr++))
	410	{
	411	if (c == '\\')
	412	switch (c = *lexptr++)
	413	{
	414	case '\0':
	415	error ("non-terminated string literal");
	416	case '\n':
	417	continue;
	418	case '0':
	419	case 'f':
	420	case 'n':
	421	case 'r':
	422	case 't':
	423	case 'a':
	424	case 'v':
	425	break;
	426	}
	427	}
	428	return;
c5aa993b JM	429	case '0':
	430	case '1':
	431	case '2':
	432	case '3':
	433	case '4':
	434	case '5':
	435	case '6':
	436	case '7':
	437	case '8':
	438	case '9':
c906108c SS	439	case '.':
	440	case '-':
	441	case '+':
	442	num:
	443	{
c5aa993b	444	str.ptr = lexptr - 1;
c906108c SS	445	scm_read_token (c, 0);
	446	if (!skipping)
	447	{
	448	svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);
	449	if (svalue != SCM_BOOL_F)
	450	goto handle_immediate;
	451	goto tok;
	452	}
	453	}
	454	return;
	455	case ':':
	456	scm_read_token ('-', 0);
	457	return;
	458	#if 0
	459	do_symbol:
	460	#endif
	461	default:
c5aa993b	462	str.ptr = lexptr - 1;
c906108c SS	463	scm_read_token (c, 0);
	464	tok:
	465	if (!skipping)
	466	{
	467	str.length = lexptr - str.ptr;
	468	if (str.ptr[0] == '$')
	469	{
	470	write_dollar_variable (str);
	471	return;
	472	}
	473	write_exp_elt_opcode (OP_NAME);
	474	write_exp_string (str);
	475	write_exp_elt_opcode (OP_NAME);
	476	}
	477	return;
	478	}
c5aa993b	479	handle_immediate:
c906108c SS	480	if (!skipping)
	481	{
	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);
	486	}
	487	}
	488
	489	int
	490	scm_parse ()
	491	{
c5aa993b	492	char *start;
c906108c SS	493	while (*lexptr == ' ')
	494	lexptr++;
	495	start = lexptr;
	496	scm_lreadr (USE_EXPRSTRING);
	497	#if USE_EXPRSTRING
	498	str.length = lexptr - start;
	499	str.ptr = start;
	500	write_exp_elt_opcode (OP_EXPRSTRING);
	501	write_exp_string (str);
	502	write_exp_elt_opcode (OP_EXPRSTRING);
	503	#endif
	504	return 0;
	505	}