void
init_wrapper (void)
{
Py_Initialize();
if (atexit(Py_Finalize)) {
fprintf(stderr,"cannot set Python finalization function\n"); // NOT COVERED BY TESTS
exit(1); // NOT COVERED BY TESTS
}
initpyscm();
init_pysmob_type();
init_g2p2g_smob_type();
// The following must happen after init_g2p2g_smob_type().
init_default_guiletopy_templates();
SCM s_default_g2p = scm_variable_ref(scm_c_lookup("guile2python"));
sargtemplate_default = scm_permanent_object(scm_list_2(scm_variable_ref(scm_c_lookup("g2p_list2Tuple")),s_default_g2p));
skwtemplate_default = SCM_UNDEFINED; // guileassoc2pythondict will choose the right default.
srestemplate_default = scm_permanent_object(scm_variable_ref(scm_c_lookup("python2guile")));
scm_c_define_gsubr ("python-eval",1,1,0,python_eval);
scm_c_define_gsubr ("python-apply",3,3,0,python_apply);
scm_c_define_gsubr ("python-import",1,0,0,python_import);
scm_c_define_gsubr ("pyguile-verbosity-set!",1,0,0,pyguile_verbosity_set);
scm_c_define_gsubr ("pyguile-version",0,0,0,pyguile_version);
}
static SCM
expand_env_ref_macro (SCM env, SCM x)
{
SCM var;
if (!expand_env_var_is_free (env, x))
return SCM_BOOL_F; /* lexical */
var = scm_module_variable (scm_current_module (), x);
if (scm_is_true (var) && scm_is_true (scm_variable_bound_p (var))
&& scm_is_true (scm_macro_p (scm_variable_ref (var))))
return scm_variable_ref (var);
else
return SCM_BOOL_F; /* anything else */
}
void test_free_handle_empty_slist_option (SCM option)
{
SCM handle = cl_easy_init();
SCM str_list = scm_list_n(SCM_UNDEFINED);
SCM ret = cl_easy_setopt(handle, scm_variable_ref(option), str_list, SCM_BOOL_F);
gc_free_handle(handle);
}
void test_free_handle_slist_option (SCM option)
{
SCM handle = cl_easy_init();
SCM str_list = scm_list_2(scm_from_locale_string("foo"), scm_from_locale_string("bar"));
SCM ret = cl_easy_setopt(handle, scm_variable_ref(option), str_list, SCM_BOOL_F);
gc_free_handle(handle);
}
/*! \brief Exports the keymap in scheme to a GLib GArray.
* \par Function Description
* This function converts the list of key sequence/action pairs
* returned by the scheme function \c dump-current-keymap into an
* array of C structures.
*
* The returned value must be freed by caller.
*
* \return A GArray with keymap data.
*/
GArray*
g_keys_dump_keymap (void)
{
SCM dump_proc = scm_c_lookup ("dump-current-keymap");
SCM scm_ret;
GArray *ret = NULL;
struct keyseq_action_t {
gchar *keyseq, *action;
};
dump_proc = scm_variable_ref (dump_proc);
g_return_val_if_fail (SCM_NFALSEP (scm_procedure_p (dump_proc)), NULL);
scm_ret = scm_call_0 (dump_proc);
g_return_val_if_fail (SCM_CONSP (scm_ret), NULL);
ret = g_array_sized_new (FALSE,
FALSE,
sizeof (struct keyseq_action_t),
(guint)scm_ilength (scm_ret));
for (; scm_ret != SCM_EOL; scm_ret = SCM_CDR (scm_ret)) {
SCM scm_keymap_entry = SCM_CAR (scm_ret);
struct keyseq_action_t keymap_entry;
g_return_val_if_fail (SCM_CONSP (scm_keymap_entry) &&
scm_is_symbol (SCM_CAR (scm_keymap_entry)) &&
scm_is_string (SCM_CDR (scm_keymap_entry)), ret);
keymap_entry.action = g_strdup (SCM_SYMBOL_CHARS (SCM_CAR (scm_keymap_entry)));
keymap_entry.keyseq = g_strdup (SCM_STRING_CHARS (SCM_CDR (scm_keymap_entry)));
ret = g_array_append_val (ret, keymap_entry);
}
return ret;
}
/*! \brief Add a directory to the Guile load path.
* \par Function Description
* Prepends \a s_path to the Guile system '%load-path', after
* expanding environment variables.
*
* \param [in] s_path Path to be added.
* \return SCM_BOOL_T.
*/
SCM g_rc_scheme_directory(SCM s_path)
{
char *temp;
gchar *expanded;
SCM s_load_path_var;
SCM s_load_path;
SCM_ASSERT (scm_is_string (s_path), s_path,
SCM_ARG1, "scheme-directory");
/* take care of any shell variables */
temp = scm_to_utf8_string (s_path);
expanded = s_expand_env_variables (temp);
s_path = scm_from_utf8_string (expanded);
free (temp);
g_free (expanded);
s_load_path_var = scm_c_lookup ("%load-path");
s_load_path = scm_variable_ref (s_load_path_var);
scm_variable_set_x (s_load_path_var, scm_cons (s_path, s_load_path));
scm_remember_upto_here_2 (s_load_path_var, s_load_path);
scm_remember_upto_here_1 (s_path);
return SCM_BOOL_T;
}
/*! \brief Evaluate a gschem action by name.
* \par Function Description
* Evaluates the action named \a action_name, which should be a UTF-8
* string naming a symbol in the user module. If evaluating the
* action fails, prints a message to the log and returns FALSE;
* otherwise, returns TRUE.
*
* \param w_current Current gschem toplevel structure.
* \param action_name Name of action to evaluate.
*
* \return TRUE on success, FALSE on failure.
*/
gboolean
g_action_eval_by_name (GschemToplevel *w_current, const gchar *action_name)
{
SCM s_eval_action_proc;
SCM s_expr;
SCM s_result;
gboolean result;
g_assert (w_current);
g_assert (action_name);
scm_dynwind_begin (0);
g_dynwind_window (w_current);
/* Get the eval-action procedure */
s_eval_action_proc =
scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
"eval-action!"));
/* Build expression to evaluate */
/* FIXME use SCM_SYMBOL for quote */
s_expr = scm_list_2 (s_eval_action_proc,
scm_list_2 (scm_from_utf8_symbol ("quote"),
scm_from_utf8_symbol (action_name)));
/* Evaluate and get return value */
s_result = g_scm_eval_protected (s_expr, SCM_UNDEFINED);
result = scm_is_true (s_result);
scm_dynwind_end ();
return result;
}
static int mod_load_servlet(lua_State *l)
{
const char *path = luaL_checkstring(l, -1);
SCM module = scm_c_define_module(path, NULL, NULL);
SCM prev_module = scm_set_current_module(module);
// TODO: don't define these functions every time for each servlet
scm_c_define_gsubr("get_arg", 2, 0, 0, &api_get_arg);
scm_c_define_gsubr("get_method", 1, 0, 0, &api_get_method);
scm_c_define_gsubr("get_header", 2, 0, 0, &api_get_header);
scm_c_define_gsubr("set_status", 2, 0, 0, &api_set_status);
scm_c_define_gsubr("set_header", 3, 0, 0, &api_set_header);
scm_c_define_gsubr("rwrite", 2, 0, 0, &api_rwrite);
scm_c_define_gsubr("rflush", 1, 0, 0, &api_rflush);
SCM foo = scm_c_primitive_load(path);
SCM run_symbol = scm_c_lookup("run");
SCM run_ref = scm_variable_ref(run_symbol);
scm_set_current_module(prev_module);
lua_newtable(l);
lua_pushlightuserdata(l, (void*)run_ref);
lua_pushcclosure(l, servlet_run, 1);
lua_setfield(l, -2, "run");
return 1;
}
/*! \brief Get the action position.
* \par Function Description
* Retrieves the current action position and stores it in \a x and \a
* y, optionally snapping it to the grid if \a snap is true. This
* should be interpreted as the position that the user was pointing
* with the mouse pointer when the current action was invoked. If
* there is no valid world position for the current action, returns
* FALSE without modifying the output variables.
*
* This should be used by actions implemented in C to figure out where
* on the schematic the user wants them to apply the action.
*
* See also the (gschem action) Scheme module.
*
* \param w_current Current gschem toplevel structure.
* \param x Location to store x coordinate.
* \param y Location to store y coordinate.
*
* \return TRUE if current action position is set, FALSE otherwise.
*/
gboolean
g_action_get_position (gboolean snap, int *x, int *y)
{
SCM s_action_position_proc;
SCM s_point;
GschemToplevel *w_current = g_current_window ();
g_assert (w_current);
/* Get the action-position procedure */
s_action_position_proc =
scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
"action-position"));
/* Retrieve the action position */
s_point = scm_call_0 (s_action_position_proc);
if (scm_is_false (s_point)) return FALSE;
if (x) {
*x = scm_to_int (scm_car (s_point));
if (snap) {
*x = snap_grid (w_current, *x);
}
}
if (y) {
*y = scm_to_int (scm_cdr (s_point));
if (snap) {
*y = snap_grid (w_current, *y);
}
}
return TRUE;
}
scm_t_bits
scm_dynstack_unwind_1 (scm_t_dynstack *dynstack)
{
scm_t_bits tag;
scm_t_bits *words;
scm_t_dynstack_item_type type;
tag = dynstack_pop (dynstack, &words);
type = SCM_DYNSTACK_TAG_TYPE (tag);
switch (type)
{
case SCM_DYNSTACK_TYPE_FRAME:
break;
case SCM_DYNSTACK_TYPE_UNWINDER:
WINDER_PROC (words) (WINDER_DATA (words));
clear_scm_t_bits (words, WINDER_WORDS);
break;
case SCM_DYNSTACK_TYPE_REWINDER:
clear_scm_t_bits (words, WINDER_WORDS);
break;
case SCM_DYNSTACK_TYPE_WITH_FLUID:
scm_swap_fluid (WITH_FLUID_FLUID (words),
WITH_FLUID_VALUE_BOX (words),
SCM_I_CURRENT_THREAD->dynamic_state);
clear_scm_t_bits (words, WITH_FLUID_WORDS);
break;
case SCM_DYNSTACK_TYPE_PROMPT:
/* we could invalidate the prompt */
clear_scm_t_bits (words, PROMPT_WORDS);
break;
case SCM_DYNSTACK_TYPE_DYNWIND:
{
SCM proc = DYNWIND_LEAVE (words);
clear_scm_t_bits (words, DYNWIND_WORDS);
scm_call_0 (proc);
}
break;
case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (words),
scm_set_current_dynamic_state
(scm_variable_ref (DYNAMIC_STATE_STATE_BOX (words))));
clear_scm_t_bits (words, DYNAMIC_STATE_WORDS);
break;
case SCM_DYNSTACK_TYPE_NONE:
default:
abort ();
}
return tag;
}
SCM g_scm_c_get_uref (OBJECT *object)
{
SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
SCM object_smob = edascm_from_object (object);
SCM exp = scm_list_2 (func, object_smob);
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
SCM g_scm_c_get_uref (TOPLEVEL *toplevel, OBJECT *object)
{
SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
SCM object_smob = g_make_object_smob (toplevel, object);
SCM exp = scm_list_2 (func, object_smob);
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
void test_free_handle_string_postfields(void)
{
extern SCM cl_CURLOPT_POSTFIELDS;
SCM handle = cl_easy_init();
SCM str = scm_from_locale_string("abcdefghijklmnopqrstuvwxyz");
SCM ret = cl_easy_setopt(handle, scm_variable_ref(cl_CURLOPT_POSTFIELDS), str, SCM_BOOL_F);
gc_free_handle(handle);
}
SCM
scm_get_keyword (SCM kw, SCM initargs, SCM default_value)
{
scm_c_issue_deprecation_warning
("scm_get_keyword is deprecated. Use `kw-arg-ref' from Scheme instead.");
return scm_call_3 (scm_variable_ref (var_get_keyword),
kw, initargs, default_value);
}
SCM
scm_for_each (SCM proc, SCM arg1, SCM args)
{
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, init_for_each_var);
return scm_apply_0 (scm_variable_ref (for_each_var),
scm_cons (proc, scm_cons (arg1, args)));
}
static SCM
ppscm_find_pretty_printer_from_gdb (SCM value)
{
SCM pp_list, pp;
/* Fetch the global pretty printer list. */
pp_list = scm_variable_ref (pretty_printer_list_var);
pp = ppscm_search_pp_list (pp_list, value);
return pp;
}
int main( ){
SCM func;
scm_init_guile();
scm_c_primitive_load( "helloworld.scm" );
func = scm_variable_ref( scm_c_lookup( "hello_world" ) );
scm_call_0( func );
return 0;
}
void
scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item)
{
scm_t_bits tag = SCM_DYNSTACK_TAG (item);
scm_t_dynstack_item_type type = SCM_DYNSTACK_TAG_TYPE (tag);
scm_t_bits flags = SCM_DYNSTACK_TAG_FLAGS (tag);
size_t len = SCM_DYNSTACK_TAG_LEN (tag);
switch (type)
{
case SCM_DYNSTACK_TYPE_FRAME:
if (!(flags & SCM_F_DYNSTACK_FRAME_REWINDABLE))
scm_misc_error ("scm_dynstack_wind_1",
"cannot invoke continuation from this context",
SCM_EOL);
break;
case SCM_DYNSTACK_TYPE_UNWINDER:
break;
case SCM_DYNSTACK_TYPE_REWINDER:
WINDER_PROC (item) (WINDER_DATA (item));
break;
case SCM_DYNSTACK_TYPE_WITH_FLUID:
scm_swap_fluid (WITH_FLUID_FLUID (item),
WITH_FLUID_VALUE_BOX (item),
SCM_I_CURRENT_THREAD->dynamic_state);
break;
case SCM_DYNSTACK_TYPE_PROMPT:
/* see vm_reinstate_partial_continuation */
break;
case SCM_DYNSTACK_TYPE_DYNWIND:
scm_call_0 (DYNWIND_ENTER (item));
break;
case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (item),
scm_set_current_dynamic_state
(scm_variable_ref (DYNAMIC_STATE_STATE_BOX (item))));
break;
case SCM_DYNSTACK_TYPE_NONE:
default:
abort ();
}
{
scm_t_bits *words = push_dynstack_entry (dynstack, type, flags, len);
copy_scm_t_bits (words, item, len);
}
}
GshmupPlayer *
gshmup_create_player (GshmupAnimation *anim)
{
GshmupPlayer *player = (GshmupPlayer *) scm_gc_malloc (sizeof (GshmupPlayer),
"player");
player->entity = gshmup_create_entity ("Player");
player->shooting = false;
player->lives = scm_to_int (scm_variable_ref (s_lives_per_credit)) - 1;
player->credits = gshmup_get_initial_player_credits () - 1;
player->speed = scm_to_double (scm_variable_ref (s_player_speed));
player->score = 0;
player->on_shoot = scm_variable_ref (s_player_on_shoot);
player->on_game_over = NULL;
gshmup_player_stop (player);
player->entity.sprite = gshmup_create_sprite_animated (anim);
gshmup_sprite_play_animation (&player->entity.sprite);
return player;
}
void test_free_handle_bytevector_postfields(void)
{
extern SCM cl_CURLOPT_POSTFIELDS;
SCM handle = cl_easy_init();
SCM bv = scm_c_make_bytevector (26);
for (int i = 0; i <= 25; i ++)
SCM_BYTEVECTOR_CONTENTS(bv)[i] = i + 'a';
SCM ret = cl_easy_setopt(handle, scm_variable_ref(cl_CURLOPT_POSTFIELDS), bv, SCM_BOOL_F);
gc_free_handle(handle);
}
SCM
guile_lookup (const char *name)
{
SCM var;
var = scm_sym2var (scm_from_locale_symbol (name),
scm_current_module_lookup_closure (),
SCM_BOOL_F);
if (scm_is_false (var))
return SCM_UNDEFINED;
else
return scm_variable_ref (var);
};
// Does not include the template object in the string representation.
static PyObject *
pyscm_PySCM_str(pyscm_PySCMObject *self)
{
if (0 == self->ob_scm_index) {
return(PyString_FromString("<no SCM association>"));
}
SCM shandle = scm_hashv_get_handle(pyscm_registration_hash,scm_long2num(self->ob_scm_index));
if (SCM_BOOLP(shandle) && SCM_EQ_P(SCM_BOOL_F,shandle)) {
Py_FatalError("PySCM object lost its associated SCM object");
}
SCM sstr = scm_object_to_string(SCM_CADR(shandle),scm_variable_ref(scm_c_lookup("write")));
PyObject *pstr = PyString_FromStringAndSize(SCM_STRING_CHARS(sstr),SCM_STRING_LENGTH(sstr));
return(pstr); // possibly NULL.
}
SCM
scm_dynstack_find_old_fluid_value (scm_t_dynstack *dynstack, SCM fluid,
size_t depth, SCM dflt)
{
scm_t_bits *walk;
for (walk = SCM_DYNSTACK_PREV (dynstack->top); walk;
walk = SCM_DYNSTACK_PREV (walk))
{
scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
switch (SCM_DYNSTACK_TAG_TYPE (tag))
{
case SCM_DYNSTACK_TYPE_WITH_FLUID:
{
if (scm_is_eq (WITH_FLUID_FLUID (walk), fluid))
{
if (depth == 0)
return SCM_VARIABLE_REF (WITH_FLUID_VALUE_BOX (walk));
else
depth--;
}
break;
}
case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
{
SCM state, val;
/* The previous dynamic state may or may not have
established a binding for this fluid. */
state = scm_variable_ref (DYNAMIC_STATE_STATE_BOX (walk));
val = scm_dynamic_state_ref (state, fluid, SCM_UNDEFINED);
if (!SCM_UNBNDP (val))
{
if (depth == 0)
return val;
else
depth--;
}
break;
}
default:
break;
}
}
return dflt;
}
SCM
scm_make_foreign_object_type (SCM name, SCM slot_names,
scm_t_struct_finalize finalizer)
{
SCM type;
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, init_make_fobj_type_var);
type = scm_call_2 (scm_variable_ref (make_fobj_type_var), name, slot_names);
if (finalizer)
SCM_SET_VTABLE_INSTANCE_FINALIZER (type, finalizer);
return type;
}
void
scm_dynstack_unwind_dynamic_state (scm_t_dynstack *dynstack,
scm_t_dynamic_state *dynamic_state)
{
scm_t_bits tag, *words;
size_t len;
tag = dynstack_pop (dynstack, &words);
len = SCM_DYNSTACK_TAG_LEN (tag);
assert (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_DYNAMIC_STATE);
assert (len == DYNAMIC_STATE_WORDS);
scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (words),
scm_set_current_dynamic_state
(scm_variable_ref (DYNAMIC_STATE_STATE_BOX (words))));
clear_scm_t_bits (words, len);
}
/*! \brief Scheme API initialisation worker function.
* \par Function Description
* Called by edascm_init() with current thread in Guile mode.
*/
static void *
edascm_init_impl (void *data)
{
#include "scheme_init.x"
scm_setlocale(scm_variable_ref(scm_c_lookup("LC_ALL")), scm_from_locale_string(""));
edascm_init_smob ();
edascm_init_toplevel ();
edascm_init_object ();
edascm_init_complex ();
edascm_init_page ();
edascm_init_attrib ();
edascm_init_os ();
edascm_init_config ();
edascm_init_closure ();
edascm_init_deprecated ();
return NULL;
}
void process_phrase(char *action, char *word, bool add_to_hist){
/* Add to history */
if(add_to_hist){
int errnum;
errnum = add_to_history(word, hist_fname);
}
/* Look up and call the function */
func_symbol = scm_c_lookup(action);
func = scm_variable_ref(func_symbol);
ret_val = scm_call_1(func, scm_from_locale_string(word));
/* TODO: process output based on the result of the Scheme function */
/* SCM is_list = scm_list_p (ret_val); */
/* Print the output */
print_scheme_list(ret_val);
}
static void
gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
{
SCM printer, status;
if (gdbscm_is_false (port))
port = scm_current_error_port ();
gdb_assert (!scm_is_eq (key, with_stack_error_symbol));
/* This does not use scm_print_exception because we tweak the output a bit.
Compare Guile's print-exception with our %print-exception-message for
details. */
if (gdbscm_is_false (percent_print_exception_message_var))
{
percent_print_exception_message_var
= scm_c_private_variable (gdbscm_init_module_name,
percent_print_exception_message_name);
/* If we can't find %print-exception-message, there's a problem on the
Scheme side. Don't kill GDB, just flag an error and leave it at
that. */
if (gdbscm_is_false (percent_print_exception_message_var))
{
gdbscm_printf (port, _("Error in Scheme exception printing,"
" can't find %s.\n"),
percent_print_exception_message_name);
return;
}
}
printer = scm_variable_ref (percent_print_exception_message_var);
status = gdbscm_safe_call_4 (printer, port, frame, key, args, NULL);
/* If that failed still tell the user something.
But don't use the exception printing machinery! */
if (gdbscm_is_exception (status))
{
gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
scm_display (status, port);
scm_newline (port);
}
}
static void
loop_set_game_update_func (SCM idle)
{
SCM var = scm_lookup (idle);
if (!scm_is_true (var) || !scm_is_true (scm_variable_p (var)))
{
g_critical ("invalid game update func");
return;
}
#if 0
SCM ref = guile_variable_ref_safe (var);
if (!scm_is_true (ref) || !scm_is_true (scm_procedure_p (ref)))
{
g_critical ("invalid game update func");
return;
}
#endif
scm_remember_upto_here_1(var);
do_idle = scm_variable_ref(scm_lookup(idle));
}
/* Start the LazyCat main procedure. */
static void
inner_main (void* closure, int argc, char** argv)
{
SCM main;
SCM args;
SCM module;
scm_c_define_module ("lazycat prctl", init_prctl_module, NULL);
module = scm_c_resolve_module ("lazycat daemon lazycatd");
scm_set_current_module (module);
scm_c_define_gsubr ("c-set-lazycat-signals", 0, 0, 0, set_lazycat_signals);
scm_c_export ("c-set-lazycat-signals", NULL);
main = scm_c_module_lookup (module, "main");
args = scm_program_arguments ();
scm_call_1 (scm_variable_ref (main), args);
}
