static SCM
lsscm_make_lazy_string_smob (CORE_ADDR address, int length,
const char *encoding, struct type *type)
{
lazy_string_smob *ls_smob = (lazy_string_smob *)
scm_gc_malloc (sizeof (lazy_string_smob), lazy_string_smob_name);
SCM ls_scm;
/* Caller must verify this. */
gdb_assert (!(address == 0 && length != 0));
gdb_assert (type != NULL);
ls_smob->address = address;
/* Coerce all values < 0 to -1. */
ls_smob->length = length < 0 ? -1 : length;
if (encoding == NULL || strcmp (encoding, "") == 0)
ls_smob->encoding = NULL;
else
ls_smob->encoding = xstrdup (encoding);
ls_smob->type = type;
ls_scm = scm_new_smob (lazy_string_smob_tag, (scm_t_bits) ls_smob);
gdbscm_init_gsmob (&ls_smob->base);
return ls_scm;
}
SCM __api_build_projectile_prototype(SCM name, SCM speed, SCM w, SCM h, SCM longevity, SCM dmg)
{
char *s = scm_to_locale_string(name);
projectile *p = build_projectile_prototype(s, scm_to_double(speed), scm_to_int(w), scm_to_int(h), scm_to_int(longevity), scm_to_int(dmg));
free(s);
SCM ret = scm_new_smob(__api_projectile_tag, (unsigned long) p);
scm_gc_protect_object(ret);
return ret;
}
SCM __api_make_projectile(SCM name, SCM x, SCM y, SCM rotation, SCM spawned_by)
{
char *s = scm_to_locale_string(name);
item *sb = (item *) SCM_SMOB_DATA(spawned_by);
projectile *p = make_projectile(s, scm_to_double(x), scm_to_double(y), scm_to_double(rotation), sb);
free(s);
SCM ret = scm_new_smob(__api_projectile_tag, (unsigned long) p);
scm_gc_protect_object(ret);
return ret;
}
SCM __api_make_fx(SCM type, SCM col, SCM x, SCM y, SCM dim, SCM radius, SCM speed)
{
color c = *((color *) SCM_SMOB_DATA(col));
SCM ret = scm_new_smob(__api_effect_tag,
(unsigned long) make_fx(scm_to_int(type), c,
scm_to_double(x), scm_to_double(y), scm_to_int(dim),
scm_to_int(radius), scm_to_double(speed)));
scm_gc_protect_object(ret);
return ret;
}
SCM
gram_keysym_scm (struct gram_keysym * _keysym)
{
struct gram_keysym *keysym = (struct gram_keysym *)
scm_gc_malloc (sizeof (struct gram_keysym), "keysym");
memcpy (keysym, _keysym, sizeof (struct gram_keysym));
return scm_new_smob (gram_keysym_tag, (scm_t_bits) keysym);
}
static SCM
syscm_make_symbol_smob (void)
{
symbol_smob *s_smob = (symbol_smob *)
scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name);
SCM s_scm;
s_smob->symbol = NULL;
s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob);
gdbscm_init_eqable_gsmob (&s_smob->base, s_scm);
return s_scm;
}
static SCM
arscm_make_arch_smob (struct gdbarch *gdbarch)
{
arch_smob *a_smob = (arch_smob *)
scm_gc_malloc (sizeof (arch_smob), arch_smob_name);
SCM a_scm;
a_smob->gdbarch = gdbarch;
a_scm = scm_new_smob (arch_smob_tag, (scm_t_bits) a_smob);
gdbscm_init_gsmob (&a_smob->base);
return a_scm;
}
static SCM
stscm_make_sal_smob (void)
{
sal_smob *s_smob
= (sal_smob *) scm_gc_malloc (sizeof (sal_smob), sal_smob_name);
SCM s_scm;
s_smob->symtab_scm = SCM_BOOL_F;
memset (&s_smob->sal, 0, sizeof (s_smob->sal));
s_scm = scm_new_smob (sal_smob_tag, (scm_t_bits) s_smob);
gdbscm_init_gsmob (&s_smob->base);
return s_scm;
}
static SCM
gdbscm_make_pretty_printer_worker (SCM display_hint, SCM to_string,
SCM children)
{
pretty_printer_worker_smob *w_smob = (pretty_printer_worker_smob *)
scm_gc_malloc (sizeof (pretty_printer_worker_smob),
pretty_printer_worker_smob_name);
SCM w_scm;
w_smob->display_hint = display_hint;
w_smob->to_string = to_string;
w_smob->children = children;
w_scm = scm_new_smob (pretty_printer_worker_smob_tag, (scm_t_bits) w_smob);
gdbscm_init_gsmob (&w_smob->base);
return w_scm;
}
static SCM
frscm_make_frame_smob (void)
{
frame_smob *f_smob = (frame_smob *)
scm_gc_malloc (sizeof (frame_smob), frame_smob_name);
SCM f_scm;
f_smob->frame_id = null_frame_id;
f_smob->gdbarch = NULL;
f_smob->inferior = NULL;
f_smob->frame_id_is_next = 0;
f_scm = scm_new_smob (frame_smob_tag, (scm_t_bits) f_smob);
gdbscm_init_eqable_gsmob (&f_smob->base, f_scm);
return f_scm;
}
static SCM
bpscm_make_breakpoint_smob (void)
{
breakpoint_smob *bp_smob = (breakpoint_smob *)
scm_gc_malloc (sizeof (breakpoint_smob), breakpoint_smob_name);
SCM bp_scm;
memset (bp_smob, 0, sizeof (*bp_smob));
bp_smob->number = -1;
bp_smob->stop = SCM_BOOL_F;
bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
bp_smob->containing_scm = bp_scm;
gdbscm_init_gsmob (&bp_smob->base);
return bp_scm;
}
SCM
gdbscm_make_exception (SCM key, SCM args)
{
exception_smob *e_smob = (exception_smob *)
scm_gc_malloc (sizeof (exception_smob), exception_smob_name);
SCM smob;
e_smob->key = key;
e_smob->args = args;
smob = scm_new_smob (exception_smob_tag, (scm_t_bits) e_smob);
gdbscm_init_gsmob (&e_smob->base);
++gdbscm_exception_count;
return smob;
}
static SCM
cmdscm_make_command_smob (void)
{
command_smob *c_smob = (command_smob *)
scm_gc_malloc (sizeof (command_smob), command_smob_name);
SCM c_scm;
memset (c_smob, 0, sizeof (*c_smob));
c_smob->cmd_class = no_class;
c_smob->invoke = SCM_BOOL_F;
c_smob->complete = SCM_BOOL_F;
c_scm = scm_new_smob (command_smob_tag, (scm_t_bits) c_smob);
c_smob->containing_scm = c_scm;
gdbscm_init_gsmob (&c_smob->base);
return c_scm;
}
static SCM
pascm_make_param_smob (void)
{
param_smob *p_smob = (param_smob *)
scm_gc_malloc (sizeof (param_smob), param_smob_name);
SCM p_scm;
memset (p_smob, 0, sizeof (*p_smob));
p_smob->cmd_class = no_class;
p_smob->type = var_boolean; /* ARI: var_boolean */
p_smob->set_func = SCM_BOOL_F;
p_smob->show_func = SCM_BOOL_F;
p_scm = scm_new_smob (parameter_smob_tag, (scm_t_bits) p_smob);
p_smob->containing_scm = p_scm;
gdbscm_init_gsmob (&p_smob->base);
return p_scm;
}
static SCM
gdbscm_make_pretty_printer (SCM name, SCM lookup)
{
pretty_printer_smob *pp_smob = (pretty_printer_smob *)
scm_gc_malloc (sizeof (pretty_printer_smob),
pretty_printer_smob_name);
SCM smob;
SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, FUNC_NAME,
_("string"));
SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup), lookup, SCM_ARG2, FUNC_NAME,
_("procedure"));
pp_smob->name = name;
pp_smob->lookup = lookup;
pp_smob->enabled = SCM_BOOL_T;
smob = scm_new_smob (pretty_printer_smob_tag, (scm_t_bits) pp_smob);
gdbscm_init_gsmob (&pp_smob->base);
return smob;
}
//get scm symbols: scm_from_utf8_symbol(name)
SCM scm_connect_tls(SCM host, SCM port){
char hostbuf[256], portbuf[16];
//Assume the current locale is utf8, as the only function that lets
//use use our own buffers implicitly uses the current locale
if(!scm_is_string(host)){
scm_raise_error("wrong-type-arg", "expected string in position 1");
} else {
size_t len = scm_to_locale_stringbuf(host, hostbuf, 256);
if(len >= 256){
scm_raise_error("too-long", "hostname too long");
} else {
hostbuf[len] = '\0';
}
}
if(scm_is_string(port)){
//make sure port looks like a number
if(scm_is_false(scm_string_to_number(port, scm_from_int(10)))){
scm_raise_error("wrong-type-arg",
"expected number or number as string in position 2");
}
size_t len = scm_to_locale_stringbuf(port, portbuf, 32);
if(len >= 16){
scm_raise_error("out-of-range", "Maximum port number is 65535");
} else {
portbuf[len] = '\0';
}
} else if(scm_is_integer(port)){
uint16_t portno = scm_to_uint16(port);
snprintf(portbuf, 16, "%d", portno);
} else {
scm_raise_error("wrong-type-arg",
"expected number or number as string in position 2");
}
BIO *bio = connect_tls(hostbuf, portbuf);
if(!bio){
scm_raise_error("system-error", "Failed to make tls connection");
}
return scm_new_smob(tls_tag, (scm_t_bits)bio);
}
