URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-7.1/] [gdb/] [scm-exp.c] - Blame information for rev 252

Go to most recent revision | Details | Compare with Previous | View Log


/* Scheme/Guile language support routines for GDB, the GNU debugger.
 
   Copyright (C) 1995, 1996, 2000, 2003, 2005, 2008, 2009, 2010
   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)),
                                           gdbarch_byte_order (parse_gdbarch));
          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_scm_type (parse_gdbarch)->builtin_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;
}

Browse

Tools

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-7.1/] [gdb/] [scm-exp.c] - Blame information for rev 252

Line No.	Rev	Author	Line
1	227	jeremybenn	`/* Scheme/Guile language support routines for GDB, the GNU debugger.`
2
3			`Copyright (C) 1995, 1996, 2000, 2003, 2005, 2008, 2009, 2010`
4			`Free Software Foundation, Inc.`
5
6			`This file is part of GDB.`
7
8			`This program is free software; you can redistribute it and/or modify`
9			`it under the terms of the GNU General Public License as published by`
10			`the Free Software Foundation; either version 3 of the License, or`
11			`(at your option) any later version.`
12
13			`This program is distributed in the hope that it will be useful,`
14			`but WITHOUT ANY WARRANTY; without even the implied warranty of`
15			`MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
16			`GNU General Public License for more details.`
17
18			`You should have received a copy of the GNU General Public License`
19			`along with this program. If not, see <http://www.gnu.org/licenses/>. */`
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 (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);`
40
41			`static LONGEST`
42			`scm_istr2int (char *str, int len, int radix)`
43			`{`
44			`int i = 0;`
45			`LONGEST inum = 0;`
46			`int c;`
47			`int sign = 0;`
48
49			`if (0 >= len)`
50			`return SCM_BOOL_F; /* zero scm_length */`
51			`switch (str[0])`
52			`{ /* leading sign */`
53			`case '-':`
54			`case '+':`
55			`sign = str[0];`
56			`if (++i == len)`
57			return SCM_BOOL_F; /* bad if lone `+' or `-' */
58			`}`
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			`}`
99			`}`
100			`while (i < len);`
101			`if (sign == '-')`
102			`inum = -inum;`
103			`return SCM_MAKINUM (inum);`
104			`}`
105
106			`static LONGEST`
107			`scm_istring2number (char *str, int len, int radix)`
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`
115			`if (len == 1)`
116			if (str == '+' \|\| str == '-') /* Catches lone `+' and `-' for speed */
117			`return SCM_BOOL_F;`
118
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			`}`
161
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);`
168			`#if 0`
169			`if NFALSEP`
170			`(res) return res;`
171			`#ifdef FLOATS`
172			`case 2:`
173			`return scm_istr2flo (&str[i], len - i, radix);`
174			`#endif`
175			`#endif`
176			`}`
177			`return SCM_BOOL_F;`
178			`}`
179
180			`static void`
181			`scm_read_token (int c, int weird)`
182			`{`
183			`while (1)`
184			`{`
185			`c = *lexptr++;`
186			`switch (c)`
187			`{`
188			`case '[':`
189			`case ']':`
190			`case '(':`
191			`case ')':`
192			`case '\"':`
193			`case ';':`
194			`case ' ':`
195			`case '\t':`
196			`case '\r':`
197			`case '\f':`
198			`case '\n':`
199			`if (weird)`
200			`goto default_case;`
201			`case '\0': /* End of line */`
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
237			`static int`
238			`scm_skip_ws (void)`
239			`{`
240			`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			`}`
258			`case ' ':`
259			`case '\t':`
260			`case '\r':`
261			`case '\f':`
262			`case '\n':`
263			`break;`
264			`default:`
265			`return c;`
266			`}`
267			`}`
268
269			`static void`
270			`scm_lreadparen (int skipping)`
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`
285			`scm_lreadr (int skipping)`
286			`{`
287			`int c, j;`
288			`struct stoken str;`
289			`LONGEST svalue = 0;`
290			`tryagain:`
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			`{`
311			`struct value *val = scm_evaluate_string (str.ptr, lexptr - str.ptr);`
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			`gdbarch_byte_order (parse_gdbarch));`
317			`goto handle_immediate;`
318			`}`
319			`return;`
320			`case ',':`
321			`c = *lexptr++;`
322			`if ('@' != c)`
323			`lexptr--;`
324			`scm_lreadr (skipping);`
325			`return;`
326			`case '#':`
327			`c = *lexptr++;`
328			`switch (c)`
329			`{`
330			`case '[':`
331			`case '(':`
332			`scm_lreadparen (skipping);`
333			`return;`
334			`case 't':`
335			`case 'T':`
336			`svalue = SCM_BOOL_T;`
337			`goto handle_immediate;`
338			`case 'f':`
339			`case 'F':`
340			`svalue = SCM_BOOL_F;`
341			`goto handle_immediate;`
342			`case 'b':`
343			`case 'B':`
344			`case 'o':`
345			`case 'O':`
346			`case 'd':`
347			`case 'D':`
348			`case 'x':`
349			`case 'X':`
350			`case 'i':`
351			`case 'I':`
352			`case 'e':`
353			`case 'E':`
354			`lexptr--;`
355			`c = '#';`
356			`goto num;`
357			`case '': / bitvector */`
358			`scm_read_token (c, 0);`
359			`return;`
360			`case '{':`
361			`scm_read_token (c, 1);`
362			`return;`
363			`case '\\': /* character */`
364			`c = *lexptr++;`
365			`scm_read_token (c, 0);`
366			`return;`
367			`case '\|':`
368			`j = 1; /* here j is the comment nesting depth */`
369			`lp:`
370			`c = *lexptr++;`
371			`lpc:`
372			`switch (c)`
373			`{`
374			`case '\0':`
375			`error ("unbalanced comment");`
376			`default:`
377			`goto lp;`
378			`case '\|':`
379			`if ('#' != (c = *lexptr++))`
380			`goto lpc;`
381			`if (--j)`
382			`goto lp;`
383			`break;`
384			`case '#':`
385			`if ('\|' != (c = *lexptr++))`
386			`goto lpc;`
387			`++j;`
388			`goto lp;`
389			`}`
390			`goto tryagain;`
391			`case '.':`
392			`default:`
393			`#if 0`
394			`callshrp:`
395			`#endif`
396			`scm_lreadr (skipping);`
397			`return;`
398			`}`
399			`case '\"':`
400			`while ('\"' != (c = *lexptr++))`
401			`{`
402			`if (c == '\\')`
403			`switch (c = *lexptr++)`
404			`{`
405			`case '\0':`
406			`error ("non-terminated string literal");`
407			`case '\n':`
408			`continue;`
409			`case '0':`
410			`case 'f':`
411			`case 'n':`
412			`case 'r':`
413			`case 't':`
414			`case 'a':`
415			`case 'v':`
416			`break;`
417			`}`
418			`}`
419			`return;`
420			`case '0':`
421			`case '1':`
422			`case '2':`
423			`case '3':`
424			`case '4':`
425			`case '5':`
426			`case '6':`
427			`case '7':`
428			`case '8':`
429			`case '9':`
430			`case '.':`
431			`case '-':`
432			`case '+':`
433			`num:`
434			`{`
435			`str.ptr = lexptr - 1;`
436			`scm_read_token (c, 0);`
437			`if (!skipping)`
438			`{`
439			`svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);`
440			`if (svalue != SCM_BOOL_F)`
441			`goto handle_immediate;`
442			`goto tok;`
443			`}`
444			`}`
445			`return;`
446			`case ':':`
447			`scm_read_token ('-', 0);`
448			`return;`
449			`#if 0`
450			`do_symbol:`
451			`#endif`
452			`default:`
453			`str.ptr = lexptr - 1;`
454			`scm_read_token (c, 0);`
455			`tok:`
456			`if (!skipping)`
457			`{`
458			`str.length = lexptr - str.ptr;`
459			`if (str.ptr[0] == '$')`
460			`{`
461			`write_dollar_variable (str);`
462			`return;`
463			`}`
464			`write_exp_elt_opcode (OP_NAME);`
465			`write_exp_string (str);`
466			`write_exp_elt_opcode (OP_NAME);`
467			`}`
468			`return;`
469			`}`
470			`handle_immediate:`
471			`if (!skipping)`
472			`{`
473			`write_exp_elt_opcode (OP_LONG);`
474			`write_exp_elt_type (builtin_scm_type (parse_gdbarch)->builtin_scm);`
475			`write_exp_elt_longcst (svalue);`
476			`write_exp_elt_opcode (OP_LONG);`
477			`}`
478			`}`
479
480			`int`
481			`scm_parse (void)`
482			`{`
483			`char *start;`
484			`while (*lexptr == ' ')`
485			`lexptr++;`
486			`start = lexptr;`
487			`scm_lreadr (USE_EXPRSTRING);`
488			`#if USE_EXPRSTRING`
489			`str.length = lexptr - start;`
490			`str.ptr = start;`
491			`write_exp_elt_opcode (OP_EXPRSTRING);`
492			`write_exp_string (str);`
493			`write_exp_elt_opcode (OP_EXPRSTRING);`
494			`#endif`
495			`return 0;`
496			`}`