SCM tf_run(SCM scm_session, SCM scm_input, SCM scm_output)
{
SCM retval;
if (scm_is_true(scm_list_p(scm_output))) {
struct tf_session_t *session = get_tf_session(scm_session);
int ninputs = scm_ilength(scm_input);
TF_Output *inputs = scm_gc_malloc(sizeof(TF_Output) * ninputs, "tf-run");
TF_Tensor **input_values = scm_gc_malloc(sizeof(TF_Tensor *) * ninputs, "tf-run");
for (int i=0; i<ninputs; i++) {
memcpy(&inputs[i], &get_tf_output(scm_caar(scm_input))->output, sizeof(TF_Output));
input_values[i] = get_tf_tensor(scm_cdar(scm_input))->tensor;
scm_input = scm_cdr(scm_input);
};
int noutputs = scm_ilength(scm_output);
TF_Output *output = scm_gc_malloc(sizeof(TF_Output) * noutputs, "tf-run");
TF_Tensor **output_values = scm_gc_malloc(sizeof(TF_Tensor *) * noutputs, "tf-run");
for (int i=0; i<noutputs; i++) {
output[i] = get_tf_output(scm_car(scm_output))->output;
scm_output = scm_cdr(scm_output);
};
TF_SessionRun(session->session, NULL, inputs, input_values, ninputs, output, output_values, noutputs, NULL, 0, NULL, status());
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-run", TF_Message(_status), SCM_EOL);
retval = SCM_EOL;
for (int i=noutputs-1; i>=0; i--) {
SCM element;
struct tf_tensor_t *result = (struct tf_tensor_t *)scm_gc_calloc(sizeof(struct tf_tensor_t), "make-tensor");
SCM_NEWSMOB(element, tf_tensor_tag, result);
result->tensor = output_values[i];
retval = scm_cons(element, retval);
};
} else
retval = scm_car(tf_run(scm_session, scm_input, scm_list_1(scm_output)));
return retval;
}
SCM scm_make_epoll_event_set(SCM size ,int epfd)
#define FUNC_NAME "make-epoll-event-set"
{
unsigned int n = 0;
int i;
int t;
struct epoll_event *ee_set = NULL;
scm_rag_epoll_event_set *ees = NULL;
SCM_VALIDATE_NUMBER(1 ,size);
n = scm_to_int(size);
ee_set = (struct epoll_event*)scm_gc_malloc(n*sizeof(struct epoll_event),
"rag-epoll-event-inner-set");
// NOTE: clear ee_set array to 0, it's CRITICAL!
memset(ee_set ,0 ,n*sizeof(struct epoll_event));
ees = (scm_rag_epoll_event_set*)scm_gc_malloc(sizeof(scm_rag_epoll_event_set),
"rag-epoll-event-set");
ees->size = n;
ees->count = 0;
ees->ee_set = ee_set;
ees->epfd = epfd;
return scm_rag_epoll_event_set2scm(ees);
}
SCM scm_make_select_event_set(SCM nfds ,SCM size ,SCM type)
#define FUNC_NAME "make-event-set"
{
int t;
unsigned int n = 0;
int fd;
SCM_VALIDATE_NUMBER(1 ,nfds);
SCM_VALIDATE_NUMBER(2 ,size);
SCM_VALIDATE_NUMBER(3 ,type);
t = scm_to_int(type);
n = scm_to_uint(size);
fd = scm_to_int(nfds);
scm_rag_fd_set *rfd = (scm_rag_fd_set*)scm_gc_malloc(sizeof(scm_rag_fd_set));
scm_rag_select_event_set *ses =
(scm_rag_select_event_set*)scm_gc_malloc(sizeof(scm_rag_select_event_set),
"select-event-set");
ses->type = t;
ses->count = 0;
ses->size = n;
ses->nfds = fd;
ses->set = rfd;
return scm_rag_select_event_set2scm(ses);
}
static SCM
make_image (SCM name, SCM s_width, SCM s_height)
{
SCM smob;
struct image *image;
int width = scm_to_int (s_width);
int height = scm_to_int (s_height);
/* Step 1: Allocate the memory block.
*/
image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
/* Step 2: Initialize it with straight code.
*/
image->width = width;
image->height = height;
image->pixels = NULL;
image->name = SCM_BOOL_F;
image->update_func = SCM_BOOL_F;
/* Step 3: Create the smob.
*/
SCM_NEWSMOB (smob, image_tag, image);
/* Step 4: Finish the initialization.
*/
image->name = name;
image->pixels = scm_gc_malloc_pointerless (width * height, "image pixels");
return smob;
}
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 tf_graph_import_(SCM scm_graph, SCM scm_file_name)
{
struct tf_graph_t *graph = get_tf_graph(scm_graph);
char *file_name = scm_to_locale_string(scm_file_name);
FILE *file = fopen(file_name, "r");
free(file_name);
if (!file)
scm_misc_error("tf-graph-import_", strerror(errno), SCM_EOL);
int fd = fileno(file);
struct stat st;
fstat(fd, &st);
size_t size = st.st_size;
TF_Buffer *buffer = TF_NewBuffer();
void *data = scm_gc_malloc(size, "tf-graph-import_");
fread(data, size, 1, file);
buffer->data = data;
buffer->length = size;
fclose(file);
TF_ImportGraphDefOptions* opts = TF_NewImportGraphDefOptions();
TF_GraphImportGraphDef(graph->graph, buffer, opts, status());
TF_DeleteImportGraphDefOptions(opts);
TF_DeleteBuffer(buffer);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-graph-import_", TF_Message(_status), SCM_EOL);
return SCM_UNDEFINED;
}
static SCM
make_game ()
{
SCM smob;
Game *game;
/* Step 1: Allocate the memory block.
*/
game = (Game *) scm_gc_malloc (sizeof (Game), "game");
/* Step 2: Initialize it with straight code.
*/
game->display = NULL;
game->event_queue = NULL;
game->timer = NULL;
game->timestep = 1.0 / 60.0;
game->time_accumulator = 0;
game->last_update_time = 0;
game->on_start = SCM_BOOL_F;
game->on_update = SCM_BOOL_F;
game->on_draw = SCM_BOOL_F;
game->on_key_pressed = SCM_BOOL_F;
game->on_key_released = SCM_BOOL_F;
game->running = true;
game->redraw = true;
/* Step 3: Create the smob.
*/
SCM_NEWSMOB (smob, game_tag, game);
return smob;
}
static SCM make_board (SCM s_width, SCM s_height) {
int i;
int j;
SCM smob;
struct board *board;
int width = scm_to_int(s_width);
int height = scm_to_int(s_height);
board = (struct board *) scm_gc_malloc(sizeof(struct board), "board");
board->width = width;
board->height = height;
board->update_func = SCM_BOOL_F;
board->cell_list = SCM_EOL;
for (i = height - 1; i >= 0; i--) {
SCM row = SCM_EOL;
for (j = width - 1; j >= 0; j--) {
SCM y_offset = scm_from_int(i);
SCM x_offset = scm_from_int(j);
row = scm_cons(make_cell(x_offset, y_offset, scm_from_int(0)), row);
}
board->cell_list = scm_cons(row, board->cell_list);
}
SCM_NEWSMOB(smob, board_tag, board);
return smob;
}
/* Ensure space for N additional words. */
static void
dynstack_ensure_space (scm_t_dynstack *dynstack, size_t n)
{
size_t capacity = SCM_DYNSTACK_CAPACITY (dynstack);
size_t height = SCM_DYNSTACK_HEIGHT (dynstack);
n += SCM_DYNSTACK_HEADER_LEN;
if (capacity < height + n)
{
scm_t_bits *new_base;
while (capacity < height + n)
capacity = (capacity < 4) ? 8 : (capacity * 2);
new_base = scm_gc_malloc (capacity * sizeof(scm_t_bits), "dynstack");
copy_scm_t_bits (new_base, dynstack->base, height);
clear_scm_t_bits (dynstack->base, height);
dynstack->base = new_base;
dynstack->top = new_base + height;
dynstack->limit = new_base + capacity;
}
}
SCM gc_malloc(SCM scm_size)
{
size_t size = scm_to_int(scm_size);
void *ptr = scm_gc_malloc(size, "gc-malloc");
SCM *p = ptr;
int i;
for (i=0; i<size; i+=8)
*p++ = SCM_BOOL_F;
return scm_from_pointer(ptr, NULL);
}
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);
}
SCM
mu_scm_mailbox_create0 (mu_mailbox_t mbox, int noclose)
{
struct mu_mailbox *mum;
mum = scm_gc_malloc (sizeof (struct mu_mailbox), "mailbox");
mum->mbox = mbox;
mum->itr = NULL;
mum->noclose = noclose;
SCM_RETURN_NEWSMOB (mailbox_tag, mum);
}
static MAKE_NODE *make_node(int type) {
MAKE_NODE *node;
node = (MAKE_NODE *)scm_gc_malloc(sizeof(MAKE_NODE), "make-node");
node->filepath = NULL;
node->callback = SCM_BOOL_F;
node->payload = SCM_BOOL_F;
node->ascendants = SCM_EOL;
node->mutex = scm_make_mutex();
node->type = type;
return node;
}
SCM
_scm_from_ssh_key (ssh_key key, SCM parent)
{
struct key_data *key_data;
SCM key_smob;
key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data),
"ssh key");
key_data->ssh_key = key;
key_data->parent = parent;
SCM_NEWSMOB (key_smob, key_tag, key_data);
return key_smob;
}
SCM
gmk_scm_from_vector2 (GmkVector2 v)
{
SCM smob;
GmkVector2 *new_v = (GmkVector2 *) scm_gc_malloc (sizeof (GmkVector2), "vector2");
*new_v = v;
SCM_NEWSMOB (smob, vector2_tag, new_v);
return smob;
}
void
scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
{
struct scm_t_chained_finalizer *chained_data;
chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
chained_data->resuscitating_p = 1;
chained_data->proc = proc;
chained_data->data = data;
GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
&chained_data->prev,
&chained_data->prev_data);
}
SCM
mu_guile_msg_to_scm (MuMsg *msg)
{
MuMsgWrapper *msgwrap;
g_return_val_if_fail (msg, SCM_UNDEFINED);
msgwrap = scm_gc_malloc (sizeof (MuMsgWrapper), "msg");
msgwrap->_msg = msg;
msgwrap->_unrefme = FALSE;
SCM_RETURN_NEWSMOB (MSG_TAG, msgwrap);
}
SCM
scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
scm_t_uint8 *ip, scm_t_ptrdiff offset)
{
struct scm_frame *p = scm_gc_malloc (sizeof (struct scm_frame),
"vmframe");
p->stack_holder = stack_holder;
p->fp = fp;
p->sp = sp;
p->ip = ip;
p->offset = offset;
return scm_cell (scm_tc7_frame, (scm_t_bits)p);
}
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;
}
SCM tf_set_attr_float_list(SCM scm_description, SCM scm_name, SCM scm_values)
{
struct tf_description_t *self = get_tf_description(scm_description);
int num_values = scm_ilength(scm_values);
float *values = scm_gc_malloc(sizeof(float) * num_values, "tf-set-attr-float-list");
for (int i=0; i<num_values; i++) {
values[i] = (float)scm_to_double(scm_car(scm_values));
scm_values = scm_cdr(scm_values);
};
char *name = scm_to_locale_string(scm_name);
TF_SetAttrFloatList(self->description, name, values, num_values);
free(name);
return SCM_UNDEFINED;
}
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;
}
SCM tf_set_attr_shape(SCM scm_description, SCM scm_name, SCM scm_shape)
{
struct tf_description_t *self = get_tf_description(scm_description);
int num_dims = scm_ilength(scm_shape);
int64_t *dims = scm_gc_malloc(sizeof(int64_t) * num_dims, "tf-set-attr-shape");
for (int i=0; i<num_dims; i++) {
dims[i] = scm_to_int(scm_car(scm_shape));
scm_shape = scm_cdr(scm_shape);
};
char *name = scm_to_locale_string(scm_name);
TF_SetAttrShape(self->description, name, dims, num_dims);
free(name);
return SCM_UNDEFINED;
}
SCM
mu_scm_body_create (SCM msg, mu_body_t body)
{
struct mu_body *mbp;
mbp = scm_gc_malloc (sizeof (struct mu_body), "body");
mbp->msg = msg;
mbp->body = body;
mbp->stream = NULL;
mbp->offset = 0;
mbp->buffer = NULL;
mbp->bufsize = 0;
SCM_RETURN_NEWSMOB (body_tag, mbp);
}
static SCM
make_x ()
{
static int i = 0;
SCM s_x;
x_t *c_x;
i++;
c_x = (x_t *) scm_gc_malloc (sizeof (x_t), "x");
c_x->scm_value = scm_from_int (i);
c_x->c_value = i;
SCM_NEWSMOB (s_x, x_tag, c_x);
return s_x;
}
SCM Display::scm_load_image(SCM file) {
SCM smob;
#ifdef WITH_SDL
struct image *img = (struct image *) scm_gc_malloc(sizeof(struct image), "image");
img->surface = IMG_Load(scm_to_locale_string(file));
if (!img->surface) {
std::cout << "Error loading image : "
<< IMG_GetError() << std::endl;
}
#endif
SCM_NEWSMOB(smob, get()->m_tImageTag, img);
return smob;
}
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;
}
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
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;
}
