static size_t
frscm_free_frame_smob (SCM self)
{
frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
if (f_smob->inferior != NULL)
{
htab_t htab = frscm_inferior_frame_map (f_smob->inferior);
gdbscm_clear_eqable_gsmob_ptr_slot (htab, &f_smob->base);
}
/* Not necessary, done to catch bugs. */
f_smob->inferior = NULL;
return 0;
}
static int ragnarok_print_epoll_event_set(SCM ees_smob ,SCM port,
scm_print_state *pstate)
{
scm_rag_epoll_event_set *ees = (scm_rag_epoll_event_set *)SCM_SMOB_DATA(ees_smob);
scm_puts("#<rag_epoll_event_set_smob 0x" ,port);
scm_intprint((long)ees ,16 ,port);
scm_puts(" epfd:" ,port);
scm_intprint((int)ees->epfd ,10 ,port);
scm_puts(" size:" ,port);
scm_intprint((unsigned int)ees->size ,10 ,port);
scm_puts(" count:" ,port);
scm_intprint((unsigned int)ees->count ,10 ,port);
scm_puts(" >" ,port);
return 1;
}
static size_t
syscm_free_symbol_smob (SCM self)
{
symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
if (s_smob->symbol != NULL)
{
htab_t htab = syscm_get_symbol_map (s_smob->symbol);
gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base);
}
/* Not necessary, done to catch bugs. */
s_smob->symbol = NULL;
return 0;
}
static SCM scm_focus_client(SCM client_smob)
{
client_t *client = NULL;
if (scm_is_eq(client_smob, SCM_UNSPECIFIED))
client = client_list; // Use first client in list if we aren't given a good client_smob
else
client = (client_t *)SCM_SMOB_DATA(client_smob);
if (!client)
return SCM_UNSPECIFIED;
if (!is_mapped(client))
return SCM_UNSPECIFIED;
set_focus_client(client);
return SCM_UNSPECIFIED;
}
static int
stscm_print_symtab_smob (SCM self, SCM port, scm_print_state *pstate)
{
symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
gdbscm_printf (port, "#<%s ", symtab_smob_name);
gdbscm_printf (port, "%s",
st_smob->symtab != NULL
? symtab_to_filename_for_display (st_smob->symtab)
: "<invalid>");
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
SCM
stscm_scm_from_sal (struct symtab_and_line sal)
{
SCM st_scm, s_scm;
sal_smob *s_smob;
st_scm = SCM_BOOL_F;
if (sal.symtab != NULL)
st_scm = stscm_scm_from_symtab (sal.symtab);
s_scm = stscm_make_sal_smob ();
s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm);
s_smob->symtab_scm = st_scm;
s_smob->sal = sal;
return s_scm;
}
static SCM
guile_sock_send_buffer_size (SCM sock, SCM size)
{
svz_socket_t *xsock;
int len;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if (!SCM_UNBNDP (size))
{
SCM_ASSERT (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME);
len = scm_to_int (size);
svz_sock_resize_buffers (xsock, len, xsock->recv_buffer_size);
}
return scm_cons (scm_from_int (xsock->send_buffer_size),
scm_from_int (xsock->send_buffer_fill));
}
static size_t
stscm_free_symtab_smob (SCM self)
{
symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
if (st_smob->symtab != NULL)
{
htab_t htab = stscm_objfile_symtab_map (st_smob->symtab);
gdbscm_clear_eqable_gsmob_ptr_slot (htab, &st_smob->base);
}
/* Not necessary, done to catch bugs. */
st_smob->symtab = NULL;
return 0;
}
size_t
free_plotter (SCM x)
{
plPlotter *plotter;
assert (SCM_SMOB_PREDICATE (plotter_tag, x));
plotter = (plPlotter *) SCM_SMOB_DATA (x);
/* Plotters should already be null if delwin has been called on them */
if (plotter != NULL)
{
pl_deletepl_r (plotter);
SCM_SET_SMOB_DATA (x, 0);
}
return 0;
}
static int scm_print_rag_select_event_set(SCM event_set_smob ,SCM port,
scm_print_state *pstate)
{
scm_rag_select_event_set *ses =
(scm_rag_select_event_set*)SCM_SMOB_DATA(event_set_smob);
scm_puts("#<rag_select_event_set_smob 0x" ,port);
scm_intprint((long)ses ,16 ,port) ;
scm_puts(" nfds:");
scm_intprint((int)ses->nfds ,10 ,port);
scm_puts(" size:");
scm_intprint((unsigned int)ses->size ,10 ,port);
scm_puts(" count:");
scm_intprint((unsigned int)ses->count ,10 ,port);
scm_puts(" >", port);
return 1;
}
static SCM
gdbscm_lazy_string_to_value (SCM self)
{
SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
struct value *value = NULL;
volatile struct gdb_exception except;
if (ls_smob->address == 0)
{
gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
_("cannot create a value from NULL")));
}
TRY_CATCH (except, RETURN_MASK_ALL)
{
value = value_at_lazy (ls_smob->type, ls_smob->address);
}
/*! \brief Print a representation of a #GschemToplevel smob.
* \par Function Description
* Outputs a string representing the \a smob to a Scheme output
* \a port. The format used is "#<gschem-window b7ef65d0>".
*
* Used internally to Guile.
*/
static int
smob_print (SCM smob, SCM port, scm_print_state *pstate)
{
gchar *hexstring;
scm_puts ("#<gschem-window", port);
scm_dynwind_begin (0);
hexstring = g_strdup_printf (" %zx", SCM_SMOB_DATA (smob));
scm_dynwind_unwind_handler (g_free, hexstring, SCM_F_WIND_EXPLICITLY);
scm_puts (hexstring, port);
scm_dynwind_end ();
scm_puts (">", port);
/* Non-zero means success */
return 1;
}
static int
lsscm_print_lazy_string_smob (SCM self, SCM port, scm_print_state *pstate)
{
lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
gdbscm_printf (port, "#<%s", lazy_string_smob_name);
gdbscm_printf (port, " @%s", hex_string (ls_smob->address));
if (ls_smob->length >= 0)
gdbscm_printf (port, " length %d", ls_smob->length);
if (ls_smob->encoding != NULL)
gdbscm_printf (port, " encoding %s", ls_smob->encoding);
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
SCM apply_rule (SCM board_smob, SCM rule_func) {
SCM cell;
struct board *board;
int i;
int j;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
for (i = 0; i < board->height; i++) {
for (j = 0; j < board->width; j++) {
cell = scm_list_ref(scm_list_ref(board->cell_list, scm_from_int(j)), scm_from_int(i));
scm_call_2(rule_func, cell, get_living_neighbors(board_smob, cell));
}
}
return SCM_UNSPECIFIED;
}
static SCM
ppscm_pretty_print_one_value (SCM printer, struct value **out_value,
struct gdbarch *gdbarch,
const struct language_defn *language)
{
volatile struct gdb_exception except;
SCM result = SCM_BOOL_F;
*out_value = NULL;
TRY_CATCH (except, RETURN_MASK_ALL)
{
int rc;
pretty_printer_worker_smob *w_smob
= (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
result = gdbscm_safe_call_1 (w_smob->to_string, printer,
gdbscm_memory_error_p);
if (gdbscm_is_false (result))
; /* Done. */
else if (scm_is_string (result)
|| lsscm_is_lazy_string (result))
; /* Done. */
else if (vlscm_is_value (result))
{
SCM except_scm;
*out_value
= vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
result, &except_scm,
gdbarch, language);
if (*out_value != NULL)
result = SCM_BOOL_T;
else
result = except_scm;
}
else if (gdbscm_is_exception (result))
; /* Done. */
else
{
/* Invalid result from to-string. */
result = ppscm_make_pp_type_error_exception
(_("invalid result from pretty-printer to-string"), result);
}
}
static int
syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate)
{
symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
if (pstate->writingp)
gdbscm_printf (port, "#<%s ", symbol_smob_name);
gdbscm_printf (port, "%s",
s_smob->symbol != NULL
? SYMBOL_PRINT_NAME (s_smob->symbol)
: "<invalid>");
if (pstate->writingp)
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
static int
cmdscm_print_command_smob (SCM self, SCM port, scm_print_state *pstate)
{
command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (self);
gdbscm_printf (port, "#<%s", command_smob_name);
gdbscm_printf (port, " %s",
c_smob->name != NULL ? c_smob->name : "{unnamed}");
if (! cmdscm_is_valid (c_smob))
scm_puts (" {invalid}", port);
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}
static SCM pg_map_rows(SCM res, SCM rest) {
struct pg_res *pgr;
SCM bag, row;
scm_assert_smob_type(pg_res_tag, res);
bag = row = SCM_EOL;
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
while (pgr->cursor < pgr->tuples) {
row = build_row(pgr);
if (!scm_is_null(rest))
bag = scm_cons(scm_call_1(SCM_CAR(rest), row), bag);
else bag = scm_cons(row, bag);
pgr->cursor++;
}
PQclear(pgr->res);
pgr->res = NULL;
bag = scm_reverse(bag);
scm_remember_upto_here_2(bag, row);
scm_remember_upto_here_2(res, rest);
return bag;
}
SCM get_living_neighbors (SCM board_smob, SCM cell_smob) {
SCM list; struct cell *cell;
int i;
int count;
scm_assert_smob_type(board_tag, board_smob);
scm_assert_smob_type(cell_tag, cell_smob);
list = get_neighbors(board_smob, cell_smob);
count = 0;
for (i = 0; i < scm_to_int(scm_length(list)); i++) {
cell = (struct cell *) SCM_SMOB_DATA(scm_list_ref(list, scm_from_int(i)));
if (cell->status > 0) {
count++;
}
}
return scm_from_int(count);
}
SCM
_scm_from_termios (struct termios *x)
{
SCM s_termios;
assert (x != NULL);
SCM_NEWSMOB (s_termios, termios_tag, x);
assert (x == (struct termios *) SCM_SMOB_DATA (s_termios));
#if 0
if (0)
{
fprintf (stderr, "Making smob from termios based on *%p\n", x);
}
#endif
return (s_termios);
}
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;
}
SCM
thit_get_missingness_pattern(SCM s_model) {
scm_assert_smob_type(thit_model_tag, s_model);
banmi_model_t *model = (banmi_model_t*)SCM_SMOB_DATA(s_model);
SCM s_rows = scm_c_make_vector(model->n_rows, SCM_BOOL_F);
int n_cols = model->n_disc + model->n_cont;
int i, j;
for (i = 0; i < model->n_rows; i++) {
SCM this_row = scm_c_make_vector(n_cols, scm_from_int(0));
int mask = 0;
for (j = 0; j < n_cols; j++) {
if ((model->mis_pat[i] | mask) > 0)
scm_vector_set_x(this_row, scm_from_int(j), scm_from_int(1));
}
scm_vector_set_x(s_rows, scm_from_int(i), this_row);
}
return s_rows;
}
SCM
clear_image (SCM image_smob)
{
int area;
struct image *image;
scm_assert_smob_type (image_tag, image_smob);
image = (struct image *) SCM_SMOB_DATA (image_smob);
area = image->width * image->height;
memset (image->pixels, 0, area);
/* Invoke the image's update function.
*/
if (scm_is_true (image->update_func))
scm_call_0 (image->update_func);
scm_remember_upto_here_1 (image_smob);
return SCM_UNSPECIFIED;
}
static int
gram_keysym_print (SCM keysym_smob, SCM port, scm_print_state * pstate)
{
struct gram_keysym *keysym =
(struct gram_keysym *) SCM_SMOB_DATA (keysym_smob);
scm_puts ("#<keysym ", port);
if (keysym->mods.mods & WLC_BIT_MOD_LOGO)
{
scm_puts ("S-", port);
}
if (keysym->mods.mods & WLC_BIT_MOD_CTRL)
{
scm_puts ("C-", port);
}
if (keysym->mods.mods & WLC_BIT_MOD_ALT)
{
scm_puts ("M-", port);
}
if(keysym->mouse) {
scm_puts ("Mouse", port);
scm_putc(keysym->mouse_button + '0', port);
} else {
char buf[64];
xkb_keysym_to_utf8 (keysym->sym, buf, 64);
if (buf[0] > 0 && buf[0] <= 0x7F)
{
xkb_keysym_get_name (keysym->sym, buf, 64);
}
SCM name = scm_from_utf8_string (buf);
scm_display (name, port);
}
scm_puts (">", port);
return 1;
}
static SCM
guile_sock_local_address (SCM sock, SCM address)
{
svz_socket_t *xsock;
uint16_t port;
SCM pair;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
pair = scm_cons (scm_from_ulong (xsock->local_addr),
scm_from_int ((int) xsock->local_port));
if (!SCM_UNBNDP (address))
{
SCM_ASSERT (scm_is_pair (address) && scm_is_integer (SCM_CAR (address))
&& scm_is_integer (SCM_CDR (address)), address, SCM_ARG2,
FUNC_NAME);
port = scm_to_uint16 (SCM_CDR (address));
xsock->local_addr = scm_to_ulong (SCM_CAR (address));
xsock->local_port = (unsigned short) port;
}
return pair;
}
static SCM scm_dump_client(SCM client_smob)
{
client_t *client = (client_t *)SCM_SMOB_DATA(client_smob);
SCM out_port = scm_current_output_port();
char *str = NULL;
int len;
const char *fmt = "window: %u\nposition: (%d, %d)\nsize: %u x %u\nborder width: %u\n";
if ((len = asprintf(&str, fmt,
client->window,
client->rect.x, client->rect.y,
client->rect.width, client->rect.height,
client->border_width)) < 0) {
fprintf(stderr, "asprintf failed\n");
/* not sure what to return here, will figure it out later */
return SCM_UNSPECIFIED;
}
scm_c_write(out_port, str, len);
free(str);
xcb_query_tree_cookie_t c = xcb_query_tree(wm_conf.connection, client->window);
xcb_query_tree_reply_t *r = xcb_query_tree_reply(wm_conf.connection, c, NULL);
if ((len = asprintf(&str, "root: %u\nparent: %u\nchildren_len: %u\n",
r->root,
r->parent,
r->children_len)) < 0) {
fprintf(stderr, "asprintf failed\n");
return SCM_UNSPECIFIED;
}
scm_c_write(out_port, str, len);
free(str);
if (r)
free(r);
return SCM_UNSPECIFIED;
}
static SCM
guile_sock_receive_buffer_reduce (SCM sock, SCM length)
{
svz_socket_t *xsock;
int len;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
/* Check if second length argument is given. */
if (!SCM_UNBNDP (length))
{
SCM_ASSERT (scm_is_integer (length), length, SCM_ARG2, FUNC_NAME);
len = scm_to_signed_integer (length, 0, xsock->recv_buffer_fill);
}
else
{
len = xsock->recv_buffer_fill;
}
svz_sock_reduce_recv (xsock, len);
return scm_from_int (len);
}
static SCM touch_node(SCM doc, SCM args) {
MAKE_NODE *node;
node = (MAKE_NODE *)SCM_SMOB_DATA(doc);
scm_lock_mutex(node->mutex);
invalidate(node);
if (scm_is_null(args)) {
scm_unlock_mutex(node->mutex);
return SCM_BOOL_T;
}
switch (node->type) {
case TYPE_DATUM:
node->payload = SCM_CAR(args);
break;
case TYPE_FILE:
free(node->filepath);
node->filepath = scm_to_locale_string(SCM_CAR(args));
break;
}
scm_unlock_mutex(node->mutex);
scm_remember_upto_here_2(doc, args);
return SCM_BOOL_T;
}
static SCM pg_format_sql(SCM conn, SCM obj) {
struct pg_conn *pgc;
SCM out;
if (SCM_SMOB_PREDICATE(time_tag, obj)) {
out = format_time(obj, c2s("'%Y-%m-%d %H:%M:%S'"));
}
else if (scm_boolean_p(obj) == SCM_BOOL_T) {
if (scm_is_true(obj)) out = c2s("'t'");
else out = c2s("'f'");
}
else if (scm_is_number(obj)) {
out = scm_number_to_string(obj,
scm_from_signed_integer(10));
}
else if (scm_is_symbol(obj)) {
out = pg_format_sql(conn, scm_symbol_to_string(obj));
}
else if (scm_is_string(obj)) {
if (scm_string_null_p(obj) == SCM_BOOL_T) out = c2s("NULL");
else {
char *src = scm_to_utf8_string(obj);
scm_assert_smob_type(pg_conn_tag, conn);
pgc = (struct pg_conn *)SCM_SMOB_DATA(conn);
scm_lock_mutex(pgc->mutex);
char *sql = PQescapeLiteral(pgc->conn,
src, strlen(src));
out = safe_from_utf8(sql);
scm_unlock_mutex(pgc->mutex);
free(src);
PQfreemem(sql);
}
}
else if (scm_is_null(obj)) out = c2s("NULL");
else out = c2s("NULL");
scm_remember_upto_here_1(out);
scm_remember_upto_here_2(conn, obj);
return out;
}
static int
bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
{
breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
struct breakpoint *b = bp_smob->bp;
gdbscm_printf (port, "#<%s", breakpoint_smob_name);
/* Only print what we export to the user.
The rest are possibly internal implementation details. */
gdbscm_printf (port, " #%d", bp_smob->number);
/* Careful, the breakpoint may be invalid. */
if (b != NULL)
{
const char *str;
gdbscm_printf (port, " %s %s %s",
bpscm_type_to_string (b->type),
bpscm_enable_state_to_string (b->enable_state),
b->silent ? "silent" : "noisy");
gdbscm_printf (port, " hit:%d", b->hit_count);
gdbscm_printf (port, " ignore:%d", b->ignore_count);
str = event_location_to_string (b->location);
if (str != NULL)
gdbscm_printf (port, " @%s", str);
}
scm_puts (">", port);
scm_remember_upto_here_1 (self);
/* Non-zero means success. */
return 1;
}