URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

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

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_me

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

Line No.	Rev	Author	Line
1	330	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
116			`if (len == 1)`
117			if (str == '+' \|\| str == '-') /* Catches lone `+' and `-' for speed */
118			`return SCM_BOOL_F;`
119
120			`while ((len - i) >= 2 && str[i] == '#' && ++i)`
121			`switch (str[i++])`
122			`{`
123			`case 'b':`
124			`case 'B':`
125			`if (rx_p++)`
126			`return SCM_BOOL_F;`
127			`radix = 2;`
128			`break;`
129			`case 'o':`
130			`case 'O':`
131			`if (rx_p++)`
132			`return SCM_BOOL_F;`
133			`radix = 8;`
134			`break;`
135			`case 'd':`
136			`case 'D':`
137			`if (rx_p++)`
138			`return SCM_BOOL_F;`
139			`radix = 10;`
140			`break;`
141			`case 'x':`
142			`case 'X':`
143			`if (rx_p++)`
144			`return SCM_BOOL_F;`
145			`radix = 16;`
146			`break;`
147			`case 'i':`
148			`case 'I':`
149			`if (ex_p++)`
150			`return SCM_BOOL_F;`
151			`ex = 2;`
152			`break;`
153			`case 'e':`
154			`case 'E':`
155			`if (ex_p++)`
156			`return SCM_BOOL_F;`
157			`ex = 1;`
158			`break;`
159			`default:`
160			`return SCM_BOOL_F;`
161			`}`
162
163			`switch (ex)`
164			`{`
165			`case 1:`
166			`return scm_istr2int (&str[i], len - i, radix);`
167			`case 0:`
168			`return scm_istr2int (&str[i], len - i, radix);`
169			`#if 0`
170			`if NFALSEP`
171			`(res) return res;`
172			`#ifdef FLOATS`
173			`case 2:`
174			`return scm_istr2flo (&str[i], len - i, radix);`
175			`#endif`
176			`#endif`
177			`}`
178			`return SCM_BOOL_F;`
179			`}`
180
181			`static void`
182			`scm_read_token (int c, int weird)`
183			`{`
184			`while (1)`
185			`{`
186			`c = *lexptr++;`
187			`switch (c)`
188			`{`
189			`case '[':`
190			`case ']':`
191			`case '(':`
192			`case ')':`
193			`case '\"':`
194			`case ';':`
195			`case ' ':`
196			`case '\t':`
197			`case '\r':`
198			`case '\f':`
199			`case '\n':`
200			`if (weird)`
201			`goto default_case;`
202			`case '\0': /* End of line */`
203			`eof_case:`
204			`--lexptr;`
205			`return;`
206			`case '\\':`
207			`if (!weird)`
208			`goto default_case;`
209			`else`
210			`{`
211			`c = *lexptr++;`
212			`if (c == '\0')`
213			`goto eof_case;`
214			`else`
215			`goto default_case;`
216			`}`
217			`case '}':`
218			`if (!weird)`
219			`goto default_case;`
220
221			`c = *lexptr++;`
222			`if (c == '#')`
223			`return;`
224			`else`
225			`{`
226			`--lexptr;`
227			`c = '}';`
228			`goto default_case;`
229			`}`
230
231			`default:`
232			`default_case:`
233			`;`
234			`}`
235			`}`
236			`}`
237
238			`static int`
239			`scm_skip_ws (void)`
240			`{`
241			`int c;`
242
243			`while (1)`
244			`switch ((c = *lexptr++))`
245			`{`
246			`case '\0':`
247			`goteof:`
248			`return c;`
249			`case ';':`
250			`lp:`
251			`switch ((c = *lexptr++))`
252			`{`
253			`case '\0':`
254			`goto goteof;`
255			`default:`
256			`goto lp;`
257			`case '\n':`
258			`break;`
259			`}`
260			`case ' ':`
261			`case '\t':`
262			`case '\r':`
263			`case '\f':`
264			`case '\n':`
265			`break;`
266			`default:`
267			`return c;`
268			`}`
269			`}`
270
271			`static void`
272			`scm_lreadparen (int skipping)`
273			`{`
274			`for (;;)`
275			`{`
276			`int c = scm_skip_ws ();`
277
278			`if (')' == c \|\| ']' == c)`
279			`return;`
280			`--lexptr;`
281			`if (c == '\0')`
282			`error ("missing close paren");`
283			`scm_lreadr (skipping);`
284			`}`
285			`}`
286
287			`static void`
288			`scm_lreadr (int skipping)`
289			`{`
290			`int c, j;`
291			`struct stoken str;`
292			`LONGEST svalue = 0;`
293
294			`tryagain:`
295			`c = *lexptr++;`
296			`switch (c)`
297			`{`
298			`case '\0':`
299			`lexptr--;`
300			`return;`
301			`case '[':`
302			`case '(':`
303			`scm_lreadparen (skipping);`
304			`return;`
305			`case ']':`
306			`case ')':`
307			`error ("unexpected #\\%c", c);`
308			`goto tryagain;`
309			`case '\'':`
310			case '`':
311			`str.ptr = lexptr - 1;`
312			`scm_lreadr (skipping);`
313			`if (!skipping)`
314			`{`
315			`struct value *val = scm_evaluate_string (str.ptr, lexptr - str.ptr);`
316
317			`if (!is_scmvalue_type (value_type (val)))`
318			`error ("quoted scm form yields non-SCM value");`
319			`svalue = extract_signed_integer (value_contents (val),`
320			`TYPE_LENGTH (value_type (val)),`
321			`gdbarch_byte_order (parse_gdbarch));`
322			`goto handle_immediate;`
323			`}`
324			`return;`
325			`case ',':`
326			`c = *lexptr++;`
327			`if ('@' != c)`
328			`lexptr--;`
329			`scm_lreadr (skipping);`
330			`return;`
331			`case '#':`
332			`c = *lexptr++;`
333			`switch (c)`
334			`{`
335			`case '[':`
336			`case '(':`
337			`scm_lreadparen (skipping);`
338			`return;`
339			`case 't':`
340			`case 'T':`
341			`svalue = SCM_BOOL_T;`
342			`goto handle_immediate;`
343			`case 'f':`
344			`case 'F':`
345			`svalue = SCM_BOOL_F;`
346			`goto handle_immediate;`
347			`case 'b':`
348			`case 'B':`
349			`case 'o':`
350			`case 'O':`
351			`case 'd':`
352			`case 'D':`
353			`case 'x':`
354			`case 'X':`
355			`case 'i':`
356			`case 'I':`
357			`case 'e':`
358			`case 'E':`
359			`lexptr--;`
360			`c = '#';`
361			`goto num;`
362			`case '': / bitvector */`
363			`scm_read_token (c, 0);`
364			`return;`
365			`case '{':`
366			`scm_read_token (c, 1);`
367			`return;`
368			`case '\\': /* character */`
369			`c = *lexptr++;`
370			`scm_read_token (c, 0);`
371			`return;`
372			`case '\|':`
373			`j = 1; /* here j is the comment nesting depth */`
374			`lp:`
375			`c = *lexptr++;`
376			`lpc:`
377			`switch (c)`
378			`{`
379			`case '\0':`
380			`error ("unbalanced comment");`
381			`default:`
382			`goto lp;`
383			`case '\|':`
384			`if ('#' != (c = *lexptr++))`
385			`goto lpc;`
386			`if (--j)`
387			`goto lp;`
388			`break;`
389			`case '#':`
390			`if ('\|' != (c = *lexptr++))`
391			`goto lpc;`
392			`++j;`
393			`goto lp;`
394			`}`
395			`goto tryagain;`
396			`case '.':`
397			`default:`
398			`#if 0`
399			`callshrp:`
400			`#endif`
401			`scm_lreadr (skipping);`
402			`return;`
403			`}`
404			`case '\"':`
405			`while ('\"' != (c = *lexptr++))`
406			`{`
407			`if (c == '\\')`
408			`switch (c = *lexptr++)`
409			`{`
410			`case '\0':`
411			`error ("non-terminated string literal");`
412			`case '\n':`
413			`continue;`
414			`case '0':`
415			`case 'f':`
416			`case 'n':`
417			`case 'r':`
418			`case 't':`
419			`case 'a':`
420			`case 'v':`
421			`break;`
422			`}`
423			`}`
424			`return;`
425			`case '0':`
426			`case '1':`
427			`case '2':`
428			`case '3':`
429			`case '4':`
430			`case '5':`
431			`case '6':`
432			`case '7':`
433			`case '8':`
434			`case '9':`
435			`case '.':`
436			`case '-':`
437			`case '+':`
438			`num:`
439			`{`
440			`str.ptr = lexptr - 1;`
441			`scm_read_token (c, 0);`
442			`if (!skipping)`
443			`{`
444			`svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10);`
445			`if (svalue != SCM_BOOL_F)`
446			`goto handle_immediate;`
447			`goto tok;`
448			`}`
449			`}`
450			`return;`
451			`case ':':`
452			`scm_read_token ('-', 0);`
453			`return;`
454			`#if 0`
455			`do_symbol:`
456			`#endif`
457			`default:`
458			`str.ptr = lexptr - 1;`
459			`scm_read_token (c, 0);`
460			`tok:`
461			`if (!skipping)`
462			`{`
463			`str.length = lexptr - str.ptr;`
464			`if (str.ptr[0] == '$')`
465			`{`
466			`write_dollar_variable (str);`
467			`return;`
468			`}`
469			`write_exp_elt_opcode (OP_NAME);`
470			`write_exp_string (str);`
471			`write_exp_elt_opcode (OP_NAME);`
472			`}`
473			`return;`
474			`}`
475			`handle_immediate:`
476			`if (!skipping)`
477			`{`
478			`write_exp_elt_opcode (OP_LONG);`
479			`write_exp_elt_type (builtin_scm_type (parse_gdbarch)->builtin_scm);`
480			`write_exp_elt_longcst (svalue);`
481			`write_exp_elt_opcode (OP_LONG);`
482			`}`
483			`}`
484
485			`int`
486			`scm_parse (void)`
487			`{`
488			`char *start;`
489
490			`while (*lexptr == ' ')`
491			`lexptr++;`
492			`start = lexptr;`
493			`scm_lreadr (USE_EXPRSTRING);`
494			`#if USE_EXPRSTRING`
495			`str.length = lexptr - start;`
496			`str.ptr = start;`
497			`write_exp_elt_opcode (OP_EXPRSTRING);`
498			`write_exp_string (str);`
499			`write_exp_elt_opcode (OP_EXPRSTRING);`
500			`#endif`
501			`return 0;`
502			`}`