safer evaluation

src/guileapi.c

@@ -1,4 +1,8 @@
 #include "machine.h"
+//TODO: 
+// - support for multiple locales, not just utf-8
+// - full API implementation
+// - control precompilation?
 
 //#if defined(TIC_BUILD_WITH_GUILE)
 
@@ -13,12 +17,57 @@ static const char TicMachine[] = "_TIC80";
 // pls hide this inside the guile interpreter
 tic_mem* memory = NULL;
 
+static char* guile_prelude = "\
+(define (eval-string-with-error-handling cmd)\
+  (let ((captured-stack #f)\
+        (captured-error #f)\
+        (result #f))\
+    (catch #t\
+        (lambda ()\
+            (if (procedure? cmd)\
+                (set! result (apply cmd '())))\
+            (if (string? cmd)\
+                (set! result (eval-string cmd))))\
+        (lambda (key . parameters)\
+            (let* ((str-port (open-output-string)))\
+                    (display-backtrace captured-stack str-port)\
+                    (display \"\\n\" str-port)\
+                    (print-exception str-port #f key parameters)\
+                    (set! captured-error (get-output-string str-port))))\
+        (lambda (key . parameters)\
+                (set! captured-stack (make-stack #t 3))))\
+    (list result captured-error)))";
+
 /* Utils */
 static s32 getGuileNumber(SCM num)
 {
   return (s32)scm_to_signed_integer(num, INT_MIN, INT_MAX);
 }
 
+
+// TODO: pre-compilation
+// TODO: error handling much?
+static void evalGuile(tic_mem* tic, const char* code)
+{
+  tic_machine* machine = (tic_machine*)tic;
+  SCM func = scm_c_eval_string("eval-string-with-error-handling");
+  if (scm_to_bool(scm_procedure_p(func)))
+    {
+      char * err_msg = NULL;
+      SCM s_string = scm_from_utf8_string(code);
+      SCM call_result = scm_call_1 (func, s_string);
+      SCM error = scm_list_ref (call_result, scm_from_uint (1));
+      if (scm_is_true (error))
+        err_msg = scm_to_utf8_string (error);
+      if (err_msg != NULL)
+        {
+          machine->data->error(machine->data->data, err_msg);
+          free(err_msg);
+        }
+
+    }
+}
+
 /* Implementing the TIC-80 API */
 static SCM guile_btn(SCM id)
 {
@@ -104,17 +153,12 @@ static void* guile_register_functions(void * data) {
   return NULL;
 }
 
-// TODO: pre-compilation
-// TODO: error handling much?
-static void evalGuile(tic_mem* tic, const char* code)
-{
-  scm_c_eval_string(code);
-}
 
 static bool initGuile(tic_mem* tic, const char* code)
 {
   memory = tic;
   scm_with_guile (&guile_register_functions, NULL);
+  scm_c_eval_string(guile_prelude);
   evalGuile(tic, code);
   return true;
 }
@@ -125,17 +169,7 @@ static void closeGuile(tic_mem* tic)
 
 static void callGuileTick(tic_mem* tic)
 {
-  SCM ticProc = scm_c_eval_string("TIC");
+  evalGuile(tic, "(TIC)");
-  // TODO, pre-load this in init
-  if (scm_procedure_p(ticProc))
-    {
-      // TODO: check for errors
-      scm_call_0(ticProc);
-    }
-  else
-    {
-      printf("OwO not a procedure heh");
-    }
 }
 
 static void callGuileScanline(tic_mem* memory, s32 row, void* data)