SCM get_neighbors (SCM board_smob, SCM cell_smob) {
struct board *board;
struct cell *cell;
SCM list;
SCM neighbor;
int i;
int j;
int x;
int y;
scm_assert_smob_type(board_tag, board_smob);
scm_assert_smob_type(cell_tag, cell_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
list = SCM_EOL;
for (i = -1; i < 2; i++) {
for (j = -1; j < 2; j++) {
if (i == 0 && j == 0) {
continue;
}
x = cell->x + i;
y = cell->y + j;
if (x >= 0 && x < board->width && y >= 0 && y < board->height) {
neighbor = scm_list_ref(scm_list_ref(board->cell_list, scm_from_int(y)), scm_from_int(x));
list = scm_cons(neighbor, list);
}
}
}
return list;
}
static SCM
guile_server_clients (SCM server)
{
svz_server_t *xserver = NULL;
svz_array_t *clients;
svz_socket_t *sock;
char *str;
unsigned long i;
SCM list = SCM_EOL;
/* If the server instance name is given, try to translate it. */
if ((str = guile_to_string (server)) != NULL)
{
xserver = svz_server_get (str);
free (str);
}
/* If the above failed it is possibly a real server smob. */
if (xserver == NULL)
{
scm_assert_smob_type (guile_svz_server_tag, server);
xserver = (svz_server_t *) SCM_SMOB_DATA (server);
}
/* Create a list of socket smobs for the server. */
if ((clients = svz_server_clients (xserver)) != NULL)
{
SCM socket_smob;
svz_array_foreach (clients, sock, i)
{
SCM_NEWSMOB (socket_smob, guile_svz_socket_tag, sock);
list = scm_cons (socket_smob, list);
}
SCM scm_tls_recv_x(SCM tls_smob, SCM buf){
scm_assert_smob_type(tls_tag, tls_smob);
BIO *bio = (BIO*)SCM_SMOB_DATA(tls_smob);
size_t buflen = scm_c_bytevector_length(buf);
char *bufptr = (char*)SCM_BYTEVECTOR_CONTENTS(buf);
return scm_from_int(BIO_read(bio, bufptr, buflen));
}
Sample*
check_sample (SCM sample_smob)
{
scm_assert_smob_type (sample_tag, sample_smob);
return (Sample *) SCM_SMOB_DATA (sample_smob);
}
static SCM pg_fields(SCM res) {
struct pg_res *pgr;
scm_assert_smob_type(pg_res_tag, res);
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
scm_remember_upto_here_1(res);
return pgr->fields;
}
GmkVector2
gmk_scm_to_vector2 (SCM s_v)
{
scm_assert_smob_type (vector2_tag, s_v);
return *((GmkVector2 *) SCM_SMOB_DATA (s_v));
}
static SCM pg_done(SCM res) {
struct pg_res *pgr;
scm_assert_smob_type(pg_res_tag, res);
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
scm_remember_upto_here_1(res);
return (pgr->res == NULL ? SCM_BOOL_T : SCM_BOOL_F);
}
static GmkFont *
check_font (SCM font_smob)
{
scm_assert_smob_type (font_tag, font_smob);
return (GmkFont *) SCM_SMOB_DATA (font_smob);
}
static Game*
check_game (SCM game_smob)
{
scm_assert_smob_type (game_tag, game_smob);
return (Game *) SCM_SMOB_DATA (game_smob);
}
SCM status_list (SCM board_smob) {
struct board *board;
struct cell *cell;
int i;
int j;
SCM cell_smob;
SCM list;
SCM row;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
list = SCM_EOL;
for (i = board->height - 1; i >= 0; i--) {
row = SCM_EOL;
for (j = board->width - 1; j >= 0; j--) {
cell_smob = scm_list_ref(scm_list_ref(board->cell_list, scm_from_int(j)), scm_from_int(i));
cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
row = scm_cons(get_status(cell_smob), row);
}
list = scm_cons(row, list);
}
return list;
}
static SCM
guile_sock_no_delay (SCM sock, SCM enable)
{
svz_socket_t *xsock;
int old = 0, set = 0;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if (xsock->proto & PROTO_TCP)
{
if (!SCM_UNBNDP (enable))
{
SCM_ASSERT (scm_is_bool (enable) || scm_is_integer (enable), enable,
SCM_ARG2, FUNC_NAME);
if ((scm_is_bool (enable) && scm_is_true (enable)) ||
(scm_is_integer (enable) && scm_to_int (enable) != 0))
set = 1;
}
if (svz_tcp_nodelay (xsock->sock_desc, set, &old) < 0)
old = 0;
else if (SCM_UNBNDP (enable))
svz_tcp_nodelay (xsock->sock_desc, old, NULL);
}
return SCM_BOOL (old);
}
size_t
gc_free_termios (SCM x)
{
struct termios *gp;
scm_assert_smob_type (termios_tag, x);
gp = (struct termios *) SCM_SMOB_DATA (x);
assert (gp != NULL);
if (0)
{
fprintf (stderr, "Freeing termios at %p\n", gp);
fprintf (stderr, "Flags: I %u O %u C %u L %u\n", gp->c_iflag,
gp->c_oflag, gp->c_cflag, gp->c_lflag);
fprintf (stderr, "Speed: O %u I %u\n", cfgetospeed(gp),
cfgetispeed(gp));
fflush (stderr);
sleep (1);
}
scm_gc_free (gp, sizeof (struct termios), "termios");
SCM_SET_SMOB_DATA (x, NULL);
return 0;
}
static SCM pg_error_msg(SCM res) {
struct pg_res *pgr;
scm_assert_smob_type(pg_res_tag, res);
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
if ((pgr->status != PGRES_FATAL_ERROR) &&
(pgr->status != PGRES_NONFATAL_ERROR)) return SCM_BOOL_F;
return c2s(PQresultErrorMessage(pgr->res));
}
SCM get_status (SCM cell_smob) {
struct cell *cell;
scm_assert_smob_type(cell_tag, cell_smob);
cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
return scm_from_int(cell->status);
}
SCM
thit_data_augmentation_x(SCM s_model, SCM s_n_iter) {
scm_assert_smob_type(thit_model_tag, s_model);
banmi_model_t *model = (banmi_model_t*)SCM_SMOB_DATA(s_model);
int n_iter = scm_to_int(s_n_iter);
banmi_data_augmentation(rng, model, n_iter);
return SCM_BOOL_T;
}
SCM get_cell (SCM board_smob, SCM s_x, SCM s_y) {
struct board *board;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
return scm_list_ref(scm_list_ref(board->cell_list, s_y), s_x);
}
static SCM
guile_sock_referrer (SCM sock, SCM referrer)
{
SCM oreferrer = SCM_EOL;
svz_socket_t *xsock, *xreferrer;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xreferrer = svz_sock_getreferrer (xsock)) != NULL)
SCM_NEWSMOB (oreferrer, guile_svz_socket_tag, xreferrer);
if (!SCM_UNBNDP (referrer))
{
scm_assert_smob_type (guile_svz_socket_tag, referrer);
xreferrer = (svz_socket_t *) SCM_SMOB_DATA (referrer);
svz_sock_setreferrer (xsock, xreferrer);
}
return oreferrer;
}
static SCM pg_clear(SCM res) {
struct pg_res *pgr;
scm_assert_smob_type(pg_res_tag, res);
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
if (pgr->res != NULL) PQclear(pgr->res);
pgr->res = NULL;
scm_remember_upto_here_1(res);
return SCM_UNSPECIFIED;
}
SCM scm_tls_get_fd(SCM tls_smob){
scm_assert_smob_type(tls_tag, tls_smob);
BIO *bio = (BIO*)SCM_SMOB_DATA(tls_smob);
int fd = BIO_get_fd(bio, NULL);
SCM port = scm_fdopen(scm_from_int(fd),
scm_from_utf8_string("r+"));
scm_set_port_encoding_x(port, scm_from_utf8_string("UTF-8"));
return port;
}
static SCM pg_cmd_tuples(SCM res) {
struct pg_res *pgr;
SCM out;
scm_assert_smob_type(pg_res_tag, res);
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
out = scm_from_signed_integer(pgr->cmd_tuples);
scm_remember_upto_here_2(res, out);
return out;
}
SCM scm_tls_send(SCM tls_smob, SCM msg){
scm_assert_smob_type(tls_tag, tls_smob);
BIO *bio = (BIO*)SCM_SMOB_DATA(tls_smob);
size_t msglen = scm_c_string_length(msg);
char *buf = alloca(msglen+1);
size_t buflen = scm_to_locale_stringbuf(msg, buf, msglen);
buf[buflen] = '\0';
return scm_from_int(BIO_puts(bio, buf));
}
static SCM
guile_sock_parent (SCM sock, SCM parent)
{
SCM oparent = SCM_EOL;
svz_socket_t *xsock, *xparent;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xparent = svz_sock_getparent (xsock)) != NULL)
SCM_NEWSMOB (oparent, guile_svz_socket_tag, xparent);
if (!SCM_UNBNDP (parent))
{
scm_assert_smob_type (guile_svz_socket_tag, parent);
xparent = (svz_socket_t *) SCM_SMOB_DATA (parent);
svz_sock_setparent (xsock, xparent);
}
return oparent;
}
static SCM
guile_sock_protocol (SCM sock)
{
svz_socket_t *xsock;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
return scm_from_int (xsock->proto);
}
static SCM pg_close(SCM conn) {
struct pg_conn *pgc;
scm_assert_smob_type(pg_conn_tag, conn);
pgc = (struct pg_conn *)SCM_SMOB_DATA(conn);
scm_lock_mutex(pgc->mutex);
if (pgc->conn != NULL) PQfinish(pgc->conn);
pgc->conn = NULL;
scm_unlock_mutex(pgc->mutex);
return SCM_UNSPECIFIED;
}
static SCM
guile_sock_final_print (SCM sock)
{
svz_socket_t *xsock;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
xsock->flags |= SOCK_FLAG_FINAL_WRITE;
return SCM_UNSPECIFIED;
}
SCM set_cell (SCM cell_smob, SCM s_status) {
struct cell *cell;
scm_assert_smob_type(cell_tag, cell_smob);
cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
cell->status = scm_to_int(s_status);
return SCM_UNSPECIFIED;
}
static SCM pg_get_row(SCM res) {
struct pg_res *pgr;
SCM row;
scm_assert_smob_type(pg_res_tag, res);
pgr = (struct pg_res *)SCM_SMOB_DATA(res);
if (pgr->cursor >= pgr->tuples) return SCM_BOOL_F;
row = build_row(pgr);
pgr->cursor++;
scm_remember_upto_here_2(res, row);
return row;
}
struct termios *
_scm_to_termios (SCM x)
{
struct termios *gp;
scm_assert_smob_type (termios_tag, x);
gp = (struct termios *) SCM_SMOB_DATA (x);
return gp;
}
size_t free_Segment2(SCM smob)
{
Segment2 * seg;
scm_assert_smob_type(tag_Segment2, smob);
seg = (Segment2 *)SCM_SMOB_DATA(smob);
DB_PRINTF("free_Segment2\n");
free(seg);
return (0);
}
static SCM
guile_sock_server (SCM sock, SCM server)
{
SCM oserver = SCM_EOL;
svz_socket_t *xsock;
svz_server_t *xserver;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xserver = svz_server_find (xsock->cfg)) != NULL)
SCM_NEWSMOB (oserver, guile_svz_server_tag, xserver);
if (!SCM_UNBNDP (server))
{
scm_assert_smob_type (guile_svz_server_tag, server);
xserver = (svz_server_t *) SCM_SMOB_DATA (server);
xsock->cfg = xserver->cfg;
}
return oserver;
}
