Fix guile thingsHEADmaster

2 files changed, 51 insertions, 12 deletions

diff --git a/src/guile/guile.rs b/src/guile/guile.rs
index fc49c70..e8e9b4d 100644
--- a/src/guile/guile.rs
+++ b/src/guile/guile.rs
@@ -2,9 +2,6 @@ use crate::macro_processor::macro_processor::MacroProcessor;
 use std::ffi::{CStr, CString};
 use std::os::raw::{c_char, c_int, c_void};
 
-use std::sync::mpsc;
-use std::thread;
-
 macro_rules! dprint {
     ($($x:tt)*) => {
         #[cfg(debug_assertions)]
@@ -17,7 +14,6 @@ extern "C" {
     fn scm_init_guile();
     fn scm_c_eval_string(expr: *const c_char) -> *mut c_void;
     fn scm_from_utf8_string(expr: *const c_char) -> *mut c_void;
-    fn scm_from_locale_string(scm_obj: *const c_char) -> *mut c_void;
     fn scm_to_locale_string(scm_obj: *mut c_void) -> *const c_char;
     fn scm_is_string(scm_obj: *mut c_void) -> c_int;
     fn scm_object_to_string(scm_obj: *mut c_void, printer: *mut c_void) -> *mut c_void;
@@ -29,20 +25,24 @@ extern "C" {
         rst: c_int,
         func: extern "C" fn(scm_obj: *mut c_void) -> *mut c_void,
     );
+    fn scm_c_catch(
+        tag: *mut c_void,
+        body: extern "C" fn(*mut c_void) -> *mut c_void,
+        body_data: *mut c_void,
+        handler: extern "C" fn(*mut c_void, *mut c_void, *mut c_void) -> *mut c_void,
+        handler_data: *mut c_void,
+        pre_unwind_handler: extern "C" fn(*mut c_void, *mut c_void, *mut c_void) -> *mut c_void,
+        pre_unwind_handler_data: *mut c_void,
+    ) -> *mut c_void;
     fn scm_c_define(name: *const c_char, value: *mut c_void);
     fn scm_from_pointer(value: *mut c_void) -> *mut c_void;
-    //fn scm_with_guile(func: extern "C" fn(data: *mut c_void) -> *mut c_void, data: *mut c_void) -> *mut c_void;
-    //fn scm_is_number(scm_obj: *mut c_void) -> c_int;
-    //fn scm_without_guile(func: extern "C" fn(data: *mut c_void) -> *mut c_void, data: *mut c_void) -> *mut c_void;
-    //fn scm_c_write(scm_obj: *mut c_void, port: *mut c_void);
-    //fn scm_get_output_string(port: *mut c_void) -> *mut c_void;
-    //fn scm_open_output_string() -> *mut c_void;
 }
 
 #[link(name = "guiledefs")]
 extern "C" {
     pub static scm_undefined: *mut c_void;
     pub static scm_unspecified: *mut c_void;
+    pub static scm_bool_t: *mut c_void;
     fn defs_scm_is_eq(x: *mut c_void, y: *mut c_void) -> c_int;
     fn defs_scm_define_string(name: *const c_char, value: *const c_char);
 }
@@ -99,6 +99,37 @@ extern "C" fn scm_smp_macro(arg: *mut c_void) -> *mut c_void {
 #[derive(Debug)]
 pub struct Guile {}
 
+extern "C" fn error_handler(
+    _data: *mut c_void,
+    _tag: *mut c_void,
+    _args: *mut c_void,
+) -> *mut c_void {
+    eprintln!("Guile error occurred!");
+    unsafe { scm_undefined }
+}
+
+/*
+/* A "pre-unwind handler" to scm_c_catch that prints the exception
+   according to "set guile print-stack".  */
+static SCM scscm_printing_pre_unwind_handler (void *data, SCM key, SCM args) {
+  SCM stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
+  gdbscm_print_exception_with_stack (SCM_BOOL_F, stack, key, args);
+  return SCM_UNSPECIFIED;
+}
+*/
+extern "C" fn pre_unwind_handler(
+    _data: *mut c_void,
+    _tag: *mut c_void,
+    _args: *mut c_void,
+) -> *mut c_void {
+    unsafe { scm_undefined }
+}
+
+extern "C" fn eval_body(data: *mut c_void) -> *mut c_void {
+    let expr = data as *const c_char;
+    unsafe { scm_c_eval_string(expr) }
+}
+
 impl Guile {
     pub fn new() -> Self {
         unsafe {
@@ -116,7 +147,15 @@ impl Guile {
         dprint!("(eval \"{}\")\n", expr);
         unsafe {
             let c_expr = CString::new(expr).map_err(|_| ())?;
-            let result = scm_c_eval_string(c_expr.as_ptr());
+            let result = scm_c_catch(
+                scm_bool_t,
+                eval_body,
+                c_expr.as_ptr() as *mut c_void,
+                error_handler,
+                scm_bool_t,
+                pre_unwind_handler,
+                scm_bool_t,
+            );
             string_from_scm(result)
         }
     }
diff --git a/src/guile/guiledefs.c b/src/guile/guiledefs.c
index bf050af..db7bf72 100644
--- a/src/guile/guiledefs.c
+++ b/src/guile/guiledefs.c
@@ -2,6 +2,7 @@
 
 struct scm_unused_struct * scm_undefined = SCM_UNDEFINED;
 struct scm_unused_struct * scm_unspecified = SCM_UNSPECIFIED;
+void * scm_bool_t = SCM_BOOL_T;
 
 int defs_scm_is_eq(SCM x, SCM y) {
     return scm_is_eq(x, y);
@@ -10,4 +11,3 @@ int defs_scm_is_eq(SCM x, SCM y) {
 void defs_scm_define_string(const char* name, const char* value) {
     scm_c_define(name, scm_from_utf8_string(value));
 }
-