commit 513920b834538a72776b9ce6932d9f74567a39d6
parent 73a392ee8a61281cc9fdcf7d60047683d826966f
Author: Oto Havle <havleoto@gmail.com>
Date: Sat, 12 Nov 2011 18:23:21 +0100
Improved FFI: ffi-klisp-state (not tested on windows)
Diffstat:
5 files changed, 172 insertions(+), 1 deletion(-)
diff --git a/src/Makefile b/src/Makefile
@@ -107,7 +107,7 @@ mingw:
posix:
$(MAKE) all \
"MYCFLAGS=-DKLISP_USE_POSIX $(if $(USE_LIBFFI),-DKUSE_LIBFFI=1 -Dread=klisp_read -Dwrite=klisp_write)" \
- "MYLIBS=$(if $(USE_LIBFFI), -ldl -lffi)"
+ "MYLIBS=$(if $(USE_LIBFFI), -rdynamic -ldl -lffi)"
# list targets that do not create files (but not all makes understand .PHONY)
.PHONY: all default o clean
diff --git a/src/examples/ffi-signal.c b/src/examples/ffi-signal.c
@@ -0,0 +1,87 @@
+/*
+** ffi-signal.c
+**
+** Example of interpreter extension. Please follow instructions
+** in ffi-signal.k.
+**
+*/
+
+#include <signal.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <string.h>
+#include <stdio.h>
+
+#include "kstate.h"
+#include "kstring.h"
+#include "kport.h"
+#include "kghelpers.h"
+
+#if !defined(KLISP_USE_POSIX) || !defined(KUSE_LIBFFI)
+# error "Bad klisp configuration."
+#endif
+
+static int self_pipe[2];
+
+static void handler(int signo)
+{
+ uint8_t message = (uint8_t) signo;
+ write(self_pipe[1], &message, 1);
+}
+
+static void install_signal_handler(klisp_State *K, TValue *xparams,
+ TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_1tp(K, ptree, "string", ttisstring, signame);
+ int signo;
+
+ if (!strcmp(kstring_buf(signame), "SIGINT")) {
+ signo = SIGINT;
+ } else if (!strcmp(kstring_buf(signame), "SIGCLD")) {
+ signo = SIGCLD;
+ } else {
+ klispE_throw_simple_with_irritants(K, "unsupported signal", 1, signame);
+ return;
+ }
+ signal(signo, handler);
+ kapply_cc(K, KINERT);
+}
+
+static void open_signal_port(klisp_State *K, TValue *xparams,
+ TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ FILE *fw = fdopen(self_pipe[0], "r");
+ TValue filename = kstring_new_b_imm(K, "**SIGNAL**");
+ krooted_tvs_push(K, filename);
+ TValue port = kmake_std_port(K, filename, false, fw);
+ krooted_tvs_pop(K);
+ kapply_cc(K, port);
+}
+
+static void safe_add_applicative(klisp_State *K, TValue env,
+ const char *name,
+ klisp_Ofunc fn)
+{
+ TValue symbol = ksymbol_new(K, name, KNIL);
+ krooted_tvs_push(K, symbol);
+ TValue value = kmake_applicative(K, fn, 0);
+ krooted_tvs_push(K, value);
+ kadd_binding(K, env, symbol, value);
+ krooted_tvs_pop(K);
+ krooted_tvs_pop(K);
+}
+
+void kinit_signal_example(klisp_State *K)
+{
+ pipe(self_pipe);
+ fcntl(self_pipe[1], F_SETFL, O_NONBLOCK);
+ safe_add_applicative(K, K->next_env, "install-signal-handler", install_signal_handler);
+ safe_add_applicative(K, K->next_env, "open-signal-port", open_signal_port);
+ klisp_assert(K->rooted_tvs_top == 0);
+ klisp_assert(K->rooted_vars_top == 0);
+}
diff --git a/src/examples/ffi-signal.k b/src/examples/ffi-signal.k
@@ -0,0 +1,58 @@
+;;
+;; Dynamic FFI example.
+;; Signal handling and interpreter extension implemented in C.
+;;
+;; usage:
+;; .../src$ make posix USE_LIBFFI=1
+;; $ cd examples
+;; $ make -f ffi-signal.makefile
+;; $ ../klisp ffi-signal.k
+;;
+;; files:
+;; ffi-signal.so ......... interpreter extension compiled to a DLL
+;; ffi-signal.k .......... example of client code
+;; ffi-signal.c ......... C source of the extension
+;; ffi-signal.makefile ... build script
+;;
+
+;; (ffi-klisp-state) returns a value which encodes pointer
+;; to the interpreter global state (klisp_State *).
+;;
+;; The following code loads the dynamic library ffi-signal.so
+;; and passes the klisp_State pointer to the initialization
+;; function kinit_signal_example(). Having access to the
+;; internal interpreter structures, the initialization function
+;; adds new bindings to the current dynamic environment.
+;;
+((ffi-make-applicative
+ (ffi-load-library "./ffi-signal.so")
+ "kinit_signal_example"
+ (ffi-make-call-interface
+ "FFI_DEFAULT_ABI" "void" (list "pointer")))
+ (ffi-klisp-state))
+
+;; The dynamic environment now contains two new bindings:
+;;
+;; (install-signal-handler SIGNAME) installs handler for
+;; the signal named SIGNAME (e.g. "SIGINT"). Whenever
+;; a signal arrives, the handler writes a byte into
+;; an internal pipe.
+;;
+;; (open-signal-port) opens the read-end of the internal pipe
+;; as a port.
+;;
+;; The following code demonstrates the signal handling (it is not
+;; possible to install arbitrary klisp procedure as a signal handler,
+;; because the interpreter is not reentrant).
+;;
+(install-signal-handler "SIGINT")
+($define! signal-port (open-signal-port))
+(display "Installed signal handler for SIGINT. Press Ctrl-C to continue...")
+(read-char signal-port)
+(newline)
+(display "Signal detected. Press Ctrl-C again...")
+(read-char signal-port)
+(newline)
+(display "Done.")
+(newline)
+
diff --git a/src/examples/ffi-signal.makefile b/src/examples/ffi-signal.makefile
@@ -0,0 +1,16 @@
+#
+# ffi-signal.makefile
+#
+# Build script for ffi-signal.so. Please follow instructions
+# in ffi-signal.k.
+#
+
+INCLUDES := -I..
+CFLAGS := -O2 -g -std=gnu99 -Wall -m32 -shared -fPIC \
+ -DKLISP_USE_POSIX -DKUSE_LIBFFI=1
+
+ffi-signal.so: ffi-signal.c
+ gcc $(CFLAGS) $(INCLUDES) -o $@ ffi-signal.c
+
+clean:
+ rm -f ffi-signal.so
diff --git a/src/kgffi.c b/src/kgffi.c
@@ -1078,6 +1078,15 @@ void ffi_type_suite(klisp_State *K, TValue *xparams,
kapply_cc(K, suite_tv);
}
+void ffi_klisp_state(klisp_State *K, TValue *xparams,
+ TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ check_0p(K, ptree);
+ kapply_cc(K, p2tv(K));
+}
+
/* init ground */
void kinit_ffi_ground_env(klisp_State *K)
{
@@ -1106,6 +1115,7 @@ void kinit_ffi_ground_env(klisp_State *K)
add_applicative(K, ground_env, "ffi-make-callback", ffi_make_callback, 2, cif_key, cb_tab);
add_applicative(K, ground_env, "ffi-memmove", ffi_memmove, 0);
add_applicative(K, ground_env, "ffi-type-suite", ffi_type_suite, 0);
+ add_applicative(K, ground_env, "ffi-klisp-state", ffi_klisp_state, 0);
add_applicative(K, ground_env, "ffi-library?", enc_typep, 1, dll_key);
add_applicative(K, ground_env, "ffi-call-interface?", enc_typep, 1, cif_key);
}
