bool scm_write_zips(scm *s, uint8_t **zv,
uint64_t *oo,
uint64_t *lo,
uint16_t *sc, uint64_t *o, uint32_t *l)
{
size_t c = (size_t) (*sc);
long long t;
// Write each strip to the file, noting all offsets.
for (size_t i = 0; i < c; i++)
if ((t = scm_write(s, zv[i], (size_t) l[i])) > 0)
o[i] = (uint64_t) t;
else
return false;
// Write the strip offset and length arrays.
if ((t = scm_write(s, o, c * sizeof (uint64_t))) > 0)
*oo = (uint64_t) t;
else
return false;
if ((t = scm_write(s, l, c * sizeof (uint32_t))) > 0)
*lo = (uint64_t) t;
else
return false;
return true;
}
static SCM
eval_string_catch_handler (const char *string, SCM key, SCM args)
{
scm_write(key, scm_current_error_port());
scm_write(args, scm_current_error_port());
g_error ("scm_c_eval_string of \"%s\" failed", string);
return SCM_BOOL_F;
}
long long scm_write_ifd(scm *s, ifd *d, long long o)
{
assert(s);
assert(d);
if (o)
{
if (scm_seek(s, o))
{
return scm_write(s, d, sizeof (ifd));
}
else return -1;
}
else return scm_write(s, d, sizeof (ifd));
}
static int
exscm_print_exception_smob (SCM self, SCM port, scm_print_state *pstate)
{
exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
gdbscm_printf (port, "#<%s ", exception_smob_name);
scm_write (e_smob->key, port);
scm_puts (" ", port);
scm_write (e_smob->args, port);
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
static int
scm_print_memoized (SCM memoized, SCM port, scm_print_state *pstate)
{
scm_puts_unlocked ("#<memoized ", port);
scm_write (scm_unmemoize_expression (memoized), port);
scm_puts_unlocked (">", port);
return 1;
}
void
gdbscm_debug_write (SCM obj)
{
SCM port = scm_current_output_port ();
scm_write (obj, port);
scm_newline (port);
scm_force_output (port);
}
void
scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate)
{
scm_puts_unlocked ("#<frame ", port);
scm_uintprint (SCM_UNPACK (frame), 16, port);
scm_putc_unlocked (' ', port);
scm_write (scm_frame_procedure (frame), port);
/* don't write args, they can get us into trouble. */
scm_puts_unlocked (">", port);
}
static int
ppscm_print_pretty_printer_worker_smob (SCM self, SCM port,
scm_print_state *pstate)
{
pretty_printer_worker_smob *w_smob
= (pretty_printer_worker_smob *) SCM_SMOB_DATA (self);
gdbscm_printf (port, "#<%s ", pretty_printer_worker_smob_name);
scm_write (w_smob->display_hint, port);
scm_puts (" ", port);
scm_write (w_smob->to_string, port);
scm_puts (" ", port);
scm_write (w_smob->children, port);
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
long long scm_write_header(scm *s, header *h)
{
assert(s);
assert(h);
if (scm_seek(s, 0))
{
return scm_write(s, h, sizeof (header));
}
return -1;
}
static int
ppscm_print_pretty_printer_smob (SCM self, SCM port, scm_print_state *pstate)
{
pretty_printer_smob *pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (self);
gdbscm_printf (port, "#<%s ", pretty_printer_smob_name);
scm_write (pp_smob->name, port);
scm_puts (gdbscm_is_true (pp_smob->enabled) ? " enabled" : " disabled",
port);
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
static void *
scscm_eval_scheme_string (void *datap)
{
struct eval_scheme_string_data *data = datap;
SCM result = scm_c_eval_string (data->string);
if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED))
{
SCM port = scm_current_output_port ();
scm_write (result, port);
scm_newline (port);
}
/* If we get here the eval succeeded. */
return NULL;
}
static int
stscm_print_sal_smob (SCM self, SCM port, scm_print_state *pstate)
{
sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self);
symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm);
gdbscm_printf (port, "#<%s ", symtab_smob_name);
scm_write (s_smob->symtab_scm, port);
if (s_smob->sal.line != 0)
gdbscm_printf (port, " line %d", s_smob->sal.line);
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
