summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--mixguile/mixguile.c12
-rw-r--r--mixguile/mixguile.h11
-rw-r--r--mixguile/mixguile_cmd_dispatcher.c24
-rw-r--r--mixguile/xmixguile_cmd_dispatcher.c117
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