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

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