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; }