klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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 }