ffi-signal.c (2086B)
1 /* 2 ** ffi-signal.c 3 ** 4 ** Example of interpreter extension. Please follow instructions 5 ** in ffi-signal.k. 6 ** 7 */ 8 9 #include <signal.h> 10 #include <fcntl.h> 11 #include <unistd.h> 12 #include <string.h> 13 #include <stdio.h> 14 15 #include "kstate.h" 16 #include "kstring.h" 17 #include "kport.h" 18 #include "kghelpers.h" 19 20 #if !defined(KLISP_USE_POSIX) || !defined(KUSE_LIBFFI) 21 # error "Bad klisp configuration." 22 #endif 23 24 static int self_pipe[2]; 25 26 static void handler(int signo) 27 { 28 uint8_t message = (uint8_t) signo; 29 write(self_pipe[1], &message, 1); 30 } 31 32 static void install_signal_handler(klisp_State *K) 33 { 34 bind_1tp(K, K->next_value, "string", ttisstring, signame); 35 int signo; 36 37 if (!strcmp(kstring_buf(signame), "SIGINT")) { 38 signo = SIGINT; 39 } else if (!strcmp(kstring_buf(signame), "SIGCLD")) { 40 signo = SIGCLD; 41 } else { 42 klispE_throw_simple_with_irritants(K, "unsupported signal", 1, signame); 43 return; 44 } 45 signal(signo, handler); 46 kapply_cc(K, KINERT); 47 } 48 49 static void open_signal_port(klisp_State *K) 50 { 51 FILE *fw = fdopen(self_pipe[0], "r"); 52 TValue filename = kstring_new_b_imm(K, "**SIGNAL**"); 53 krooted_tvs_push(K, filename); 54 TValue port = kmake_std_fport(K, filename, false, true, fw); 55 krooted_tvs_pop(K); 56 kapply_cc(K, port); 57 } 58 59 static void safe_add_applicative(klisp_State *K, TValue env, 60 const char *name, 61 klisp_CFunction fn) 62 { 63 TValue symbol = ksymbol_new_b(K, name, KNIL); 64 krooted_tvs_push(K, symbol); 65 TValue value = kmake_applicative(K, fn, 0); 66 krooted_tvs_push(K, value); 67 kadd_binding(K, env, symbol, value); 68 krooted_tvs_pop(K); 69 krooted_tvs_pop(K); 70 } 71 72 void kinit_signal_example(klisp_State *K) 73 { 74 pipe(self_pipe); 75 fcntl(self_pipe[1], F_SETFL, O_NONBLOCK); 76 safe_add_applicative(K, K->next_env, "install-signal-handler", install_signal_handler); 77 safe_add_applicative(K, K->next_env, "open-signal-port", open_signal_port); 78 klisp_assert(K->rooted_tvs_top == 0); 79 klisp_assert(K->rooted_vars_top == 0); 80 }