diff options
| -rw-r--r-- | mixguile/mixguile.c | 12 | ||||
| -rw-r--r-- | mixguile/mixguile.h | 11 | ||||
| -rw-r--r-- | mixguile/mixguile_cmd_dispatcher.c | 24 | ||||
| -rw-r--r-- | mixguile/xmixguile_cmd_dispatcher.c | 117 |
4 files changed, 88 insertions, 76 deletions
diff --git a/mixguile/mixguile.c b/mixguile/mixguile.c index 55483fe..866fd6d 100644 --- a/mixguile/mixguile.c +++ b/mixguile/mixguile.c @@ -1,7 +1,7 @@ /* -*-c-*- -------------- mixguile.c : * Implementation of the functions declared in mixguile.h * ------------------------------------------------------------------ - * Copyright (C) 2001, 2002, 2006, 2007 Free Software Foundation, Inc. + * Copyright (C) 2001, 2002, 2006, 2007, 2009 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -33,14 +33,14 @@ static gboolean init_file_; /* do local initialisation and enter the user provided main */ static void -real_main_ (int argc, char *argv[]) +real_main_ (void *closure, int argc, char *argv[]) { if (vm_dispatcher_) { mixguile_set_cmd_dispatcher (vm_dispatcher_); mixguile_load_bootstrap (init_file_); } - (*main_fun_)(argc, argv); + (*main_fun_)(NULL, argc, argv); } /* @@ -55,7 +55,7 @@ mixguile_init (int argc, char *argv[], gboolean initfile, main_fun_ = main_fun; vm_dispatcher_ = dis; init_file_ = initfile; - gh_enter (argc, argv, real_main_); + scm_boot_guile (argc, argv, real_main_, 0); } /* load bootstrap file */ @@ -85,9 +85,9 @@ mixguile_load_bootstrap (gboolean loadlocal) /* enter the guile repl */ void -mixguile_enter_repl (int argc, char *argv[]) +mixguile_enter_repl (void *closure, int argc, char *argv[]) { - gh_repl (argc, argv); + scm_shell (argc, argv); } /* set the command dispatcher */ diff --git a/mixguile/mixguile.h b/mixguile/mixguile.h index 3481433..dfa8219 100644 --- a/mixguile/mixguile.h +++ b/mixguile/mixguile.h @@ -1,7 +1,7 @@ /* -*-c-*- ---------------- mixguile.h : * Interface to the mixguile interpreter. * ------------------------------------------------------------------ - * Copyright (C) 2001, 2006, 2007 Free Software Foundation, Inc. + * Copyright (C) 2001, 2006, 2007, 2009 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -25,14 +25,15 @@ #include <mixlib/mix.h> #include <mixlib/mix_vm_command.h> -#include <guile/gh.h> +#include <libguile.h> /* the main function type */ -typedef void (*main_func_t) (int argc, char *argv[]); +typedef void (*main_func_t) (void *closure, int argc, char *argv[]); /* enter and do the initialisation manually inside the guile world */ -#define mixguile_enter(argc,argv,main_fun) gh_enter (argc, argv, main_fun) +#define mixguile_enter(argc,argv,main_fun) \ + scm_boot_guile (argc, argv, main_fun, 0) /* load mixguile startup file */ extern void @@ -52,7 +53,7 @@ mixguile_set_cmd_dispatcher (mix_vm_cmd_dispatcher_t *dis); /* enter the guile repl */ extern void -mixguile_enter_repl (int argc, char *argv[]); +mixguile_enter_repl (void *closure,int argc, char *argv[]); /* access the comand dispatcher */ extern mix_vm_cmd_dispatcher_t * diff --git a/mixguile/mixguile_cmd_dispatcher.c b/mixguile/mixguile_cmd_dispatcher.c index e5b9cce..b302f39 100644 --- a/mixguile/mixguile_cmd_dispatcher.c +++ b/mixguile/mixguile_cmd_dispatcher.c @@ -1,7 +1,7 @@ /* -*-c-*- -------------- mixguile_cmd_dispatcher.c : * Implementation of the functions declared in mixguile_cmd_dispatcher.h * ------------------------------------------------------------------ - * Copyright (C) 2001, 2007 Free Software Foundation, Inc. + * Copyright (C) 2001, 2007, 2009 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,23 +32,38 @@ #define SCMF_CMD "scmf" /*local commands */ + +static SCM eval_ (void *code) +{ + scm_c_eval_string ((char *)code); + return SCM_BOOL_T; +} + static gboolean cmd_scm_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg) { - (void) gh_eval_str_with_catch ((char *)arg, scm_handle_by_message_noexit); + scm_c_catch (SCM_BOOL_T, eval_, (void*) arg, + scm_handle_by_message_noexit, NULL, NULL, NULL); return TRUE; } +static SCM load_ (void *path) +{ + scm_c_primitive_load ((char *)path); + return SCM_BOOL_T; +} + static gboolean cmd_scmf_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg) { - (void) gh_eval_file_with_catch ((char *)arg, scm_handle_by_message_noexit); + scm_c_catch (SCM_BOOL_T, load_, (void*) arg, + scm_handle_by_message_noexit, NULL, NULL, NULL); return TRUE; } static mix_vm_command_info_t commands_[] = { { SCM_CMD, cmd_scm_, N_("Eval Scheme command using Guile"), "scm COMMAND"}, - { SCMF_CMD, cmd_scmf_, N_("Eval Scheme file using Guile"), "scm PATH"}, + { SCMF_CMD, cmd_scmf_, N_("Eval Scheme file using Guile"), "scmf PATH"}, {NULL} }; @@ -82,7 +97,6 @@ mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis) return result; } - void mixguile_cmd_dispatcher_delete (mixguile_cmd_dispatcher_t *dis) { diff --git a/mixguile/xmixguile_cmd_dispatcher.c b/mixguile/xmixguile_cmd_dispatcher.c index 9bc76a1..4cb327b 100644 --- a/mixguile/xmixguile_cmd_dispatcher.c +++ b/mixguile/xmixguile_cmd_dispatcher.c @@ -1,7 +1,7 @@ /* -*-c-*- -------------- xmixguile_cmd_dispatcher.c : * Implementation of the functions declared in xmixguile_cmd_dispatcher.h * ------------------------------------------------------------------ - * Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + * Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -39,9 +39,11 @@ register_scm_commands_ (const scm_command_t *commands) g_return_if_fail (commands != NULL); while (commands[k].name) { - gh_new_procedure (commands[k].name, commands[k].func, - commands[k].argno, commands[k].opt_argno, - commands[k].restp); + scm_c_define_gsubr (commands[k].name, + commands[k].argno, + commands[k].opt_argno, + commands[k].restp, + commands[k].func); ++k; } } @@ -61,7 +63,6 @@ static SCM mixvm_cmd_ (SCM cmd, SCM arg) { char *com = NULL, *argu = NULL; - size_t len; gboolean result; SCM_ASSERT (SCM_STRINGP (cmd) || SCM_SYMBOLP (cmd), @@ -70,8 +71,8 @@ mixvm_cmd_ (SCM cmd, SCM arg) arg, SCM_ARG2, "mixvm-cmd"); SCM_DEFER_INTS; - com = gh_scm2newstr (cmd, &len); - argu = gh_scm2newstr (arg, &len); + com = scm_to_locale_string (cmd); + argu = scm_to_locale_string (arg); result = mix_vm_cmd_dispatcher_dispatch (vm_dispatcher_, mix_vm_command_from_string (com), argu); @@ -86,13 +87,13 @@ mixvm_cmd_ (SCM cmd, SCM arg) static SCM mixvm_status_ (void) { - return gh_long2scm (mix_vm_get_run_status (vm_)); + return scm_from_long (mix_vm_get_run_status (vm_)); } static SCM mix_last_result_ (void) { - return gh_bool2scm (mix_vm_cmd_dispatcher_get_last_result (vm_dispatcher_)); + return scm_from_bool (mix_vm_cmd_dispatcher_get_last_result (vm_dispatcher_)); } static long @@ -113,14 +114,13 @@ static SCM mix_reg_ (SCM reg) { char *regis; - size_t len; long val = MIX_WORD_MAX + 1; SCM_ASSERT (SCM_STRINGP (reg) || SCM_SYMBOLP (reg), reg, SCM_ARG1, "mix-reg"); SCM_DEFER_INTS; if (SCM_SYMBOLP (reg)) reg = scm_symbol_to_string (reg); - regis = gh_scm2newstr (reg, &len); + regis = scm_to_locale_string (reg); switch (regis[0]) { case 'A': @@ -144,14 +144,13 @@ mix_reg_ (SCM reg) SCM_ASSERT (val <= MIX_WORD_MAX, reg, SCM_ARG1, "mix-reg"); - return gh_long2scm (val); + return scm_from_long (val); } static SCM mix_set_reg_ (SCM reg, SCM value) { char *regis; - size_t len; long val; gboolean result = TRUE; @@ -161,8 +160,8 @@ mix_set_reg_ (SCM reg, SCM value) SCM_DEFER_INTS; if (SCM_SYMBOLP (reg)) reg = scm_symbol_to_string (reg); - regis = gh_scm2newstr (reg, &len); - val = gh_scm2long (value); + regis = scm_to_locale_string (reg); + val = scm_to_long (value); switch (regis[0]) { case 'A': @@ -187,7 +186,7 @@ mix_set_reg_ (SCM reg, SCM value) SCM_ASSERT (result, reg, SCM_ARG1, "mix-set-reg!"); - return gh_symbol2scm ("ok"); + return SCM_BOOL_T; } static SCM @@ -197,10 +196,10 @@ mix_cell_ (SCM no) long result; SCM_ASSERT (SCM_NUMBERP (no), no, SCM_ARG1, "mix-cell"); - cell = gh_scm2int (no); + cell = scm_to_int (no); SCM_ASSERT (cell < MIX_VM_CELL_NO, no, SCM_ARG1, "mix-cell"); result = word_to_long_ (mix_vm_get_addr_contents (vm_, cell)); - return gh_long2scm (result); + return scm_from_long (result); } static SCM @@ -211,30 +210,30 @@ mix_set_cell_ (SCM no, SCM val) SCM_ASSERT (SCM_NUMBERP (no), no, SCM_ARG1, "mix-set-cell!"); SCM_ASSERT (SCM_NUMBERP (val), no, SCM_ARG2, "mix-set-cell!"); - cell = gh_scm2int (no); + cell = scm_to_int (no); SCM_ASSERT (cell < MIX_VM_CELL_NO, no, SCM_ARG1, "mix-set-cell!"); - result = gh_scm2long (val); + result = scm_to_long (val); mix_vm_set_addr_contents (vm_, cell, mix_word_new (result)); - return gh_symbol2scm ("ok"); + return SCM_BOOL_T; } static SCM mix_over_ (void) { - return gh_bool2scm (mix_vm_get_overflow (vm_)); + return scm_from_bool (mix_vm_get_overflow (vm_)); } static SCM mix_set_over_ (SCM over) { - mix_vm_set_overflow (vm_, gh_scm2bool (over)); - return gh_symbol2scm ("ok"); + mix_vm_set_overflow (vm_, scm_to_bool (over)); + return SCM_BOOL_T; } static SCM mix_loc_ (void) { - return gh_long2scm (mix_vm_get_prog_count (vm_)); + return scm_from_long (mix_vm_get_prog_count (vm_)); } static SCM @@ -248,21 +247,20 @@ mix_cmp_ (void) case mix_GREAT: result = "G"; break; default: g_assert_not_reached (); } - return gh_symbol2scm (result); + return scm_from_locale_symbol (result); } static SCM mix_set_cmp_ (SCM value) { gchar *val = NULL; - size_t len; mix_cmpflag_t result = -1; SCM_ASSERT (SCM_STRINGP (value) || SCM_SYMBOLP (value), value, SCM_ARG1, "mix-set-cmp!"); SCM_DEFER_INTS; - val = gh_scm2newstr (value, &len); + val = scm_to_locale_string (value); if (strlen (val) == 1) { switch (val[0]) @@ -277,59 +275,59 @@ mix_set_cmp_ (SCM value) SCM_ALLOW_INTS; SCM_ASSERT (result != -1, value, SCM_ARG1, "mix-set-cmp!"); mix_vm_set_cmpflag (vm_, result); - return gh_symbol2scm ("ok"); + return SCM_BOOL_T; } static SCM mix_src_name_ (void) { const gchar *path = mix_vm_cmd_dispatcher_get_src_file_path (vm_dispatcher_); - return gh_str02scm (path? g_path_get_basename (path) : ""); + return scm_from_locale_string (path? g_path_get_basename (path) : ""); } static SCM mix_src_path_ (void) { const gchar *path = mix_vm_cmd_dispatcher_get_src_file_path (vm_dispatcher_); - return gh_str02scm (path? (char *)path : ""); + return scm_from_locale_string (path? (char *)path : ""); } static SCM mix_prog_name_ (void) { const gchar *path = mix_vm_cmd_dispatcher_get_program_path (vm_dispatcher_); - return gh_str02scm (path? g_path_get_basename (path) : ""); + return scm_from_locale_string (path? g_path_get_basename (path) : ""); } static SCM mix_prog_path_ (void) { const gchar *path = mix_vm_cmd_dispatcher_get_program_path (vm_dispatcher_); - return gh_str02scm (path? (char *)path : ""); + return scm_from_locale_string (path? (char *)path : ""); } static SCM mix_ddir_ (void) { - return gh_str02scm ((char *)mix_device_get_dir ()); + return scm_from_locale_string ((char *)mix_device_get_dir ()); } static SCM mix_uptime_ (void) { - return gh_long2scm (mix_vm_cmd_dispatcher_get_uptime (vm_dispatcher_)); + return scm_from_long (mix_vm_cmd_dispatcher_get_uptime (vm_dispatcher_)); } static SCM mix_progtime_ (void) { - return gh_long2scm (mix_vm_cmd_dispatcher_get_progtime (vm_dispatcher_)); + return scm_from_long (mix_vm_cmd_dispatcher_get_progtime (vm_dispatcher_)); } static SCM mix_laptime_ (void) { - return gh_long2scm (mix_vm_cmd_dispatcher_get_laptime (vm_dispatcher_)); + return scm_from_long (mix_vm_cmd_dispatcher_get_laptime (vm_dispatcher_)); } static SCM @@ -340,7 +338,7 @@ mix_src_line_ (SCM opt) if (opt != SCM_UNDEFINED) { SCM_ASSERT (SCM_NUMBERP (opt), opt, SCM_ARG1, "mix-src-line"); - no = gh_scm2long (opt); + no = scm_to_ulong (opt); } else no = mix_vm_cmd_dispatcher_get_src_file_lineno (vm_dispatcher_); @@ -350,14 +348,14 @@ mix_src_line_ (SCM opt) if (no > 0) line = mix_vm_cmd_dispatcher_get_src_file_line (vm_dispatcher_, no, FALSE); - return gh_str02scm ((char *)line); + return scm_from_locale_string ((char *)line); } static SCM mix_src_line_no_ (void) { return - gh_long2scm (mix_vm_cmd_dispatcher_get_src_file_lineno (vm_dispatcher_)); + scm_from_long (mix_vm_cmd_dispatcher_get_src_file_lineno (vm_dispatcher_)); } /* ----- hook functions ---- */ @@ -367,13 +365,13 @@ static SCM make_arg_list_ (const gchar *arg) { gchar **arglist = g_strsplit (arg, " ", -1); - SCM argument = gh_list (SCM_UNDEFINED, SCM_EOL); + SCM argument = scm_list_n (SCM_UNDEFINED, SCM_EOL); if (arglist && arglist[0]) { int k = 0; while (arglist[k]) - argument = gh_cons (gh_str02scm (arglist[k++]), argument); - argument = gh_reverse (argument); + argument = scm_cons (scm_from_locale_string (arglist[k++]), argument); + argument = scm_reverse (argument); } g_strfreev (arglist); return argument; @@ -394,7 +392,7 @@ static SCM hook_catch_body_ (void *data) { hook_data_t *h = (hook_data_t *)data; - return gh_call1 (h->function, h->args); + return scm_call_1 (h->function, h->args); } static void @@ -403,13 +401,13 @@ scm_hook_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg, gpointer data) hook_data_t h; h.function = (SCM) data; - g_assert (gh_procedure_p (h.function)); + g_assert (scm_is_true (scm_procedure_p (h.function))); h.args = make_arg_list_ (arg); - g_assert (gh_list_p (h.args)); + g_assert (scm_is_true (scm_list_p (h.args))); - gh_catch (SCM_BOOL_T, hook_catch_body_, &h, - scm_handle_by_message_noexit, dis); + scm_internal_catch (SCM_BOOL_T, hook_catch_body_, &h, + scm_handle_by_message_noexit, dis); } /* global hook auxiliar functions and types */ @@ -424,7 +422,7 @@ static SCM global_hook_catch_body_ (void *data) { global_hook_data_t *h = (global_hook_data_t *)data; - return gh_call2 (h->function, h->cmd, h->args); + return scm_call_2 (h->function, h->cmd, h->args); } static void @@ -433,10 +431,10 @@ scm_global_hook_ (mix_vm_cmd_dispatcher_t *dis, mix_vm_command_t cmd, { global_hook_data_t h; h.function = (SCM) data; - h.cmd = gh_str02scm ((char *)mix_vm_command_to_string (cmd)); + h.cmd = scm_from_locale_string ((char *)mix_vm_command_to_string (cmd)); h.args = make_arg_list_ (arg); - gh_catch (SCM_BOOL_T, global_hook_catch_body_, &h, - scm_handle_by_message_noexit, NULL); + scm_internal_catch (SCM_BOOL_T, global_hook_catch_body_, &h, + scm_handle_by_message_noexit, NULL); } static SCM @@ -447,8 +445,8 @@ define_hook_procedure_ (SCM function) static const gchar *PATTERN = "____mix__hook__%d____"; static int K = 0; g_snprintf (BUFFER, BUFF_SIZE, PATTERN, K++); - /* gh_define (name, val) returns a pair: (symbol . symbol-value) */ - return gh_cdr (gh_define ((char *)BUFFER, function)); + /* scm_c__define (name, val) returns a pair: (symbol . symbol-value) */ + return scm_cdr (scm_c_define ((char *)BUFFER, function)); } static SCM @@ -456,13 +454,12 @@ mix_add_hook_ (SCM cmd, SCM function, gboolean pre) { gchar *cmdstr = NULL; mix_vm_command_t command; - size_t len; const gchar *fun = pre? "mix-add-pre-hook" : "mix-add-post-hook"; SCM_ASSERT (SCM_STRINGP (cmd) || SCM_SYMBOLP (cmd), cmd, SCM_ARG1, fun); - SCM_ASSERT (gh_procedure_p (function), function, SCM_ARG2, fun); + SCM_ASSERT (scm_is_true (scm_procedure_p (function)), function, SCM_ARG2, fun); SCM_DEFER_INTS; - cmdstr = gh_scm2newstr (cmd, &len); + cmdstr = scm_to_locale_string (cmd); command = mix_vm_command_from_string (cmdstr); g_free (cmdstr); SCM_ALLOW_INTS; @@ -477,7 +474,7 @@ mix_add_hook_ (SCM cmd, SCM function, gboolean pre) (gpointer) define_hook_procedure_ (function)); SCM_ALLOW_INTS; - return gh_symbol2scm ("ok"); + return SCM_BOOL_T; } static SCM @@ -486,7 +483,7 @@ mix_add_global_hook_ (SCM function, gboolean pre) const gchar *fun = pre? "mix-add-global-pre-hook" : "mix-add-global-post-hook"; - SCM_ASSERT (gh_procedure_p (function), function, SCM_ARG1, fun); + SCM_ASSERT (scm_is_true (scm_procedure_p (function)), function, SCM_ARG1, fun); SCM_DEFER_INTS; if (pre) mix_vm_cmd_dispatcher_global_pre_hook (vm_dispatcher_, scm_global_hook_, @@ -497,7 +494,7 @@ mix_add_global_hook_ (SCM function, gboolean pre) (gpointer) define_hook_procedure_ (function)); SCM_ALLOW_INTS; - return gh_symbol2scm ("ok"); + return SCM_BOOL_T; } static SCM |