int
scm_val_print (struct type *type, const gdb_byte *valaddr,
int embedded_offset, CORE_ADDR address,
struct ui_file *stream, int format, int deref_ref,
int recurse, enum val_prettyprint pretty)
{
if (is_scmvalue_type (type))
{
LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
if (scm_inferior_print (svalue, stream, format,
deref_ref, recurse, pretty) >= 0)
{
}
else
{
scm_scmval_print (svalue, stream, format,
deref_ref, recurse, pretty);
}
gdb_flush (stream);
return (0);
}
else
{
return c_val_print (type, valaddr, 0, address, stream, format,
deref_ref, recurse, pretty);
}
}
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);
}
}
