SCM usb_device(SCM name)
{
io_iterator_t iterator = 0;
CFDictionaryRef matchDict = IOServiceMatching(kIOUSBDeviceClassName);
IOServiceGetMatchingServices(kIOMasterPortDefault, matchDict, &iterator);
io_service_t device;
int cnt = 0;
int found_device = false;
while(device = IOIteratorNext(iterator))
{
io_name_t dev_name;
if(IORegistryEntryGetName(device, dev_name) == KERN_SUCCESS)
if(!strncmp(dev_name,scm_to_locale_string(name),strlen(scm_to_locale_string(name))))
found_device = true;
IOObjectRelease(device);
++cnt;
}
IOObjectRelease(iterator);
return scm_from_int(found_device);
}
SCM script_ogre_create_entity(SCM s_name, SCM s_mesh_path)
{
const char *name = scm_to_locale_string(s_name),
*mesh_path = scm_to_locale_string(s_mesh_path);
uint64_t ret = ogre_create_entity(name, mesh_path);
return scm_from_uint64(ret);
}
SCM tf_set_attr_string(SCM scm_description, SCM scm_name, SCM scm_value)
{
struct tf_description_t *self = get_tf_description(scm_description);
char *name = scm_to_locale_string(scm_name);
char *value = scm_to_locale_string(scm_value);
TF_SetAttrString(self->description, name, value, scm_c_string_length(scm_value));
free(value);
free(name);
return SCM_UNDEFINED;
}
SCM make_description(SCM scm_graph, SCM scm_op, SCM scm_name)
{
SCM retval;
struct tf_graph_t *graph = get_tf_graph(scm_graph);
struct tf_description_t *self = (struct tf_description_t *)scm_gc_calloc(sizeof(struct tf_description_t), "make-description");
SCM_NEWSMOB(retval, tf_description_tag, self);
char *op = scm_to_locale_string(scm_op);
char *name = scm_to_locale_string(scm_name);
self->description = TF_NewOperation(graph->graph, op, name);
free(name);
free(op);
return retval;
}
static SCM unpatch_out(SCM left, SCM right) {
char source[64];
char *dest;
if (jack_client == NULL) return SCM_BOOL_F;
dest = scm_to_locale_string(left);
sprintf(source, "%s:out%02d", client_name, 1);
jack_disconnect(jack_client, source, dest);
free(dest);
dest = scm_to_locale_string(right);
sprintf(source, "%s:out%02d", client_name, 2);
jack_disconnect(jack_client, source, dest);
free(dest);
return SCM_BOOL_T;
}
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
decode_scm_col_list (GttGhtml *ghtml, SCM col_list)
{
SCM col_name;
char * tok = NULL;
/* reset the parser */
ghtml->ninvl_cols = 0;
ghtml->ntask_cols = 0;
while (!scm_is_null (col_list))
{
col_name = SCM_CAR (col_list);
/* either a 'symbol or a "quoted string" */
if (!scm_is_symbol(col_name) && !scm_is_string (col_name))
{
col_list = SCM_CDR (col_list);
continue;
}
tok = scm_to_locale_string (col_name);
decode_column (ghtml, tok);
free (tok);
col_list = SCM_CDR (col_list);
}
return SCM_UNSPECIFIED;
}
/********************************************************************\
* gnc_get_credit_string *
* return a credit string for a given account type *
* *
* Args: account_type - type of account to get credit string for *
* Return: g_malloc'd credit string or NULL *
\********************************************************************/
char *
gnc_get_credit_string(GNCAccountType account_type)
{
const gchar *string;
SCM result;
SCM arg;
initialize_scm_functions();
if (gnc_gconf_get_bool(GCONF_GENERAL, KEY_ACCOUNTING_LABELS, NULL))
return g_strdup(_("Credit"));
if ((account_type < ACCT_TYPE_NONE) || (account_type >= NUM_ACCOUNT_TYPES))
account_type = ACCT_TYPE_NONE;
arg = scm_long2num(account_type);
result = scm_call_1(getters.credit_string, arg);
if (!scm_is_string(result))
return NULL;
string = scm_to_locale_string(result);
if (string)
return g_strdup(string);
return NULL;
}
static SCM make_doc(SCM ingredients, SCM recipe) {
MAKE_NODE *node;
FILE_NODE *fnode;
SCM smob, cursor;
if (scm_is_symbol(ingredients)) {
if (ingredients == file_sym) {
node = make_node(TYPE_FILE);
node->filepath = scm_to_locale_string(recipe);
node->dirty = 1;
fnode = (FILE_NODE *)malloc(sizeof(FILE_NODE));
fnode->node = node;
fnode->mtime = 0;
fnode->next = file_nodes;
file_nodes = fnode;
}
else {
node = make_node(TYPE_DATUM);
node->dirty = 0;
node->payload = recipe;
}
SCM_RETURN_NEWSMOB(make_node_tag, node);
}
node = make_node(TYPE_CHAIN);
node->dirty = 1;
node->callback = recipe;
SCM_NEWSMOB(smob, make_node_tag, node);
cursor = ingredients;
while (cursor != SCM_EOL) {
add_ascendant(SCM_CAR(cursor), smob);
cursor = SCM_CDR(cursor);
}
scm_remember_upto_here_2(ingredients, recipe);
scm_remember_upto_here_2(smob, cursor);
return smob;
}
SCM Event::On(SCM e, SCM cb){
CheckArgType(e, scm_string_p, "event-on", 1);
CheckArgType(cb, scm_procedure_p, "event-on", 2);
string ev = scm_to_locale_string(e);
events_g->On(ev, cb);
return e;
}
SCM
guile_comm_init (SCM args) // MPI_Init
{
int argc, i;
char **argv;
// count number of arguments:
argc = scm_to_int (scm_length (args));
argv = malloc ((argc + 1) * sizeof (char *));
argv[argc] = NULL;
for (i = 0; i < argc; i++)
{
argv[i] = scm_to_locale_string (scm_car (args));
args = scm_cdr (args);
}
int ierr = MPI_Init (&argc, &argv);
assert (MPI_SUCCESS==ierr);
/* FIXME: In fact we dont know if MPI_Init replaced the argv
completely and who is responsible for freeing these
resources. So we do not attempt to free them. */
return scm_from_comm (MPI_COMM_WORLD);
}
/* We assume that data is actually a char**. The way we return results
* from this function is to malloc a fresh string, and store it in
* this pointer. It is the caller's responsibility to do something
* smart with this freshly allocated storage. the caller can determine
* whether there was an error by initializing the char* passed in to
* NULL. If there is an error, the char string will not be NULL on
* return. */
static SCM
gfec_catcher(void *data, SCM tag, SCM throw_args)
{
SCM func;
SCM result;
const char *msg = NULL;
func = scm_c_eval_string("gnc:error->string");
if (scm_is_procedure(func))
{
result = scm_call_2(func, tag, throw_args);
if (scm_is_string(result))
{
char * str;
scm_dynwind_begin (0);
str = scm_to_locale_string (result);
msg = g_strdup (str);
scm_dynwind_free (str);
scm_dynwind_end ();
}
}
if (msg == NULL)
{
msg = "Error running guile function.";
}
*(char**)data = strdup(msg);
return SCM_UNDEFINED;
}
SCM
set_thread_name (SCM name)
{
char *n = scm_to_locale_string (name);
prctl (PR_SET_NAME, n);
return SCM_UNDEFINED;
}
SCM Event::Run(SCM e, SCM args){
CheckArgType(e, scm_string_p, "event-run", 1);
CheckArgType(args, scm_list_p, "event-run", 2);
string ev = scm_to_locale_string(e);
events_g->Run(ev, args);
return e;
}
struct t_hashtable *
weechat_guile_alist_to_hashtable (SCM alist, int size, const char *type_keys,
const char *type_values)
{
struct t_hashtable *hashtable;
int length, i;
SCM pair;
char *str, *str2;
hashtable = weechat_hashtable_new (size,
type_keys,
type_values,
NULL,
NULL);
if (!hashtable)
return NULL;
length = scm_to_int (scm_length (alist));
for (i = 0; i < length; i++)
{
pair = scm_list_ref (alist, scm_from_int (i));
if (strcmp (type_values, WEECHAT_HASHTABLE_STRING) == 0)
{
str = scm_to_locale_string (scm_list_ref (pair, scm_from_int (0)));
str2 = scm_to_locale_string (scm_list_ref (pair, scm_from_int (1)));
weechat_hashtable_set (hashtable, str, str2);
if (str)
free (str);
if (str2)
free (str2);
}
else if (strcmp (type_values, WEECHAT_HASHTABLE_POINTER) == 0)
{
str = scm_to_locale_string (scm_list_ref (pair, scm_from_int (0)));
str2 = scm_to_locale_string (scm_list_ref (pair, scm_from_int (1)));
weechat_hashtable_set (hashtable, str,
plugin_script_str2ptr (weechat_guile_plugin,
NULL, NULL, str2));
if (str)
free (str);
if (str2)
free (str2);
}
}
return hashtable;
}
static void
load_extension (SCM lib, SCM init)
{
extension_t *head;
scm_i_pthread_mutex_lock (&ext_lock);
head = registered_extensions;
scm_i_pthread_mutex_unlock (&ext_lock);
/* Search the registry. */
if (head != NULL)
{
extension_t *ext;
char *clib, *cinit;
int found = 0;
scm_dynwind_begin (0);
clib = scm_to_locale_string (lib);
scm_dynwind_free (clib);
cinit = scm_to_locale_string (init);
scm_dynwind_free (cinit);
for (ext = head; ext; ext = ext->next)
if ((ext->lib == NULL || !strcmp (ext->lib, clib))
&& !strcmp (ext->init, cinit))
{
ext->func (ext->data);
found = 1;
break;
}
scm_dynwind_end ();
if (found)
return;
}
/* Dynamically link the library. */
#if HAVE_MODULES
scm_dynamic_call (init, scm_dynamic_link (lib));
#else
scm_misc_error ("load-extension",
"extension ~S:~S not registered and dynamic-link disabled",
scm_list_2 (init, lib));
#endif
}
SCM tf_set_attr_bool(SCM scm_description, SCM scm_name, SCM scm_value)
{
struct tf_description_t *self = get_tf_description(scm_description);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrBool(self->description, name, scm_is_true(scm_value));
free(name);
return SCM_UNDEFINED;
}
SCM scheme_write_to_stderr(SCM output)
{
char *str = scm_to_locale_string(output);
fprintf(stderr, "%s", str);
free(str);
return SCM_UNSPECIFIED;
}
SCM tf_set_attr_float(SCM scm_description, SCM scm_name, SCM scm_value)
{
struct tf_description_t *self = get_tf_description(scm_description);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrFloat(self->description, name, (float)scm_to_double(scm_value));
free(name);
return SCM_UNDEFINED;
}
SCM llvm_get_function_address(SCM scm_llvm, SCM scm_name)
{
struct llvm_module_t *self = get_llvm(scm_llvm);
char *name = scm_to_locale_string(scm_name);
void *address = (void *)LLVMGetFunctionAddress(self->engine, name);
free(name);
return scm_from_pointer(address, NULL);
}
SCM script_ogre_create_child_scene_node(SCM s_parent, SCM s_name)
{
void *parent = (void*)scm_to_uint64(s_parent);
const char *name = scm_to_locale_string(s_name);
uint64_t ret = ogre_create_child_scene_node(parent, name);
return scm_from_uint64(ret);
}
SCM tf_set_attr_type(SCM scm_description, SCM scm_name, SCM scm_type)
{
struct tf_description_t *self = get_tf_description(scm_description);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrType(self->description, name, scm_to_int(scm_type));
free(name);
return SCM_UNDEFINED;
}
static SCM scm_nwm_log(SCM msg)
{
scm_dynwind_begin(0);
char *c_msg = scm_to_locale_string(msg);
scm_dynwind_free(c_msg);
fprintf(stderr, "%s\n", c_msg);
scm_dynwind_end();
return SCM_UNSPECIFIED;
}
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;
}
SWIGINTERN char *
SWIG_Guile_scm2newstr(SCM str, size_t *len) {
#define FUNC_NAME "SWIG_Guile_scm2newstr"
size_t l;
SCM_ASSERT (scm_string_p(str), str, 1, FUNC_NAME);
return scm_to_locale_string( str );
#undef FUNC_NAME
}
SCM tf_set_attr_tensor(SCM scm_description, SCM scm_name, SCM scm_value)
{
struct tf_description_t *self = get_tf_description(scm_description);
struct tf_tensor_t *value = get_tf_tensor(scm_value);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrTensor(self->description, name, value->tensor, status());
free(name);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-set-attr-tensor", TF_Message(_status), SCM_EOL);
return SCM_UNDEFINED;
}
static SCM sched_has_entry(SCM tag) {
SCM out;
char *target = scm_to_locale_string(tag);
scm_remember_upto_here_1(tag);
pthread_mutex_lock(&pmutex);
SCHED_EVENT *event = find_node(target);
free(target);
if (event != NULL) out = SCM_BOOL_T;
else out = SCM_BOOL_F;
pthread_mutex_unlock(&pmutex);
return out;
}
void print_scheme_list(SCM lst){
/* Calculate the size of the list returned from Scheme */
int i, length;
length = scm_to_int(scm_length (lst));
/* Start from 1 as the zero-th element only denotes query type */
for(i = 1; i < length; i++){
SCM elm = scm_list_ref(lst, scm_from_int(i));
char *anton = scm_to_locale_string (elm);
printf("%s ", anton);
}
printf("\n");
}
SCM make_llvm_basic_block(SCM scm_function, SCM scm_name)
{
SCM retval;
struct llvm_function_t *function = get_llvm_function(scm_function);
struct llvm_basic_block_t *self;
self = (struct llvm_basic_block_t *)scm_gc_calloc(sizeof(struct llvm_basic_block_t), "llvm basic block");
SCM_NEWSMOB(retval, llvm_basic_block_tag, self);
char *name = scm_to_locale_string(scm_name);
self->basic_block = LLVMAppendBasicBlock(function->function, name);
free(name);
return retval;
}
