dan
/
TIC-80-guile
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

safer evaluation

This commit is contained in:
Dan Frumin 2019-06-03 10:15:23 +02:00
parent 746b94599a
commit 9c77cd61cf
1 changed files with 51 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
src/guileapi.c
View File

@ -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");
// 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");
}
evalGuile(tic, "(TIC)");
}
static void callGuileScanline(tic_mem* memory, s32 row, void* data)