From 35236b50521f7514f09b1ce7ed60451b56b3425c Mon Sep 17 00:00:00 2001
From: haskal <haskal@awoo.systems>
Date: Wed, 14 Oct 2020 18:17:24 -0400
Subject: [PATCH] add demo of static binary ffi

this adds a demo where the embedding C wrapper creates a new primitive
module with an ffi table which can be accessed and used from the racket
side to call functions, even when the runtime is hosted in a static
binary
---
 .gitignore |  2 ++
 main_bc.c  | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++---
 run.rkt    | 14 ++++++++++++++
 3 files changed, 70 insertions(+), 3 deletions(-)

diff --git a/.gitignore b/.gitignore
index 48e0332..6c0c136 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,5 @@
 *.o
 *.zo
 *.dep
+.vimrc
+.ycm_extra_conf.py
diff --git a/main_bc.c b/main_bc.c
index ea911bb..e741e26 100644
--- a/main_bc.c
+++ b/main_bc.c
@@ -6,9 +6,58 @@
 extern const char _binary_app_zo_start;
 extern const char _binary_app_zo_end;
 
-static int run_bc(Scheme_Env *e, int argc, char *argv[]) {
-    Scheme_Object *l = NULL;
-    Scheme_Object *a[2] = { NULL, NULL };
+// ffi example call
+
+void example_func() {
+    printf("hello world ffi call\n");
+}
+
+// ffi defs
+typedef struct {
+    const char* name;
+    uintptr_t ptr;
+} ffi_ent;
+
+static const ffi_ent ffi_table[] = {
+    {"example_func", (uintptr_t) example_func}
+};
+static const size_t ffi_table_size = sizeof(ffi_table)/sizeof(ffi_ent);
+
+// setup ffi table to be passed to racket
+static void bc_setup_ffi_table(Scheme_Env* parent) {
+    Scheme_Env* mod = NULL;
+    Scheme_Object* table = NULL;
+    Scheme_Object* table_ent = NULL;
+
+    MZ_GC_DECL_REG(4);
+    MZ_GC_VAR_IN_REG(0, parent);
+    MZ_GC_VAR_IN_REG(1, mod);
+    MZ_GC_VAR_IN_REG(2, table);
+    MZ_GC_VAR_IN_REG(3, table_ent);
+    MZ_GC_REG();
+
+    mod = scheme_primitive_module(scheme_intern_symbol("static-ffi"), parent);
+
+    table = scheme_make_null();
+    for (size_t i = 0; i < ffi_table_size; i++) {
+        table_ent = scheme_make_null();
+        table_ent = scheme_make_pair(scheme_make_integer(ffi_table[i].ptr), table_ent);
+        table_ent = scheme_make_pair(scheme_intern_symbol(ffi_table[i].name), table_ent);
+
+        table = scheme_make_pair(table_ent, table);
+    }
+
+    scheme_add_global("table", table, mod);
+    scheme_finish_primitive_module(mod);
+
+    MZ_GC_UNREG();
+}
+
+static int run_bc(Scheme_Env* e, int argc, char* argv[]) {
+    (void)argc;
+    (void)argv;
+    Scheme_Object* l = NULL;
+    Scheme_Object* a[2] = { NULL, NULL };
 
     MZ_GC_DECL_REG(5);
     MZ_GC_VAR_IN_REG(0, e);
@@ -16,6 +65,8 @@ static int run_bc(Scheme_Env *e, int argc, char *argv[]) {
     MZ_GC_ARRAY_VAR_IN_REG(2, a, 2);
     MZ_GC_REG();
 
+    bc_setup_ffi_table(e);
+
     size_t load_size = ((uintptr_t) &_binary_app_zo_end) - ((uintptr_t) &_binary_app_zo_start);
     scheme_register_embedded_load(load_size, &_binary_app_zo_start);
     scheme_embedded_load(load_size, &_binary_app_zo_start, 1);
diff --git a/run.rkt b/run.rkt
index 7cc98ee..f1c6f7a 100644
--- a/run.rkt
+++ b/run.rkt
@@ -1,3 +1,17 @@
 #lang racket/base
 
+(require ffi/unsafe)
+
 (displayln "hello world")
+
+(void (for/list ([i (in-list '(1 2 3 4 5))]) (printf "loop: ~a\n" i)))
+
+(define table (dynamic-require ''static-ffi 'table))
+(displayln "ffi table")
+(displayln table)
+
+(define func (cast (cadr (car table)) _int64 (_fun -> _void)))
+
+(displayln "calling")
+(func)
+(displayln "back")