Handle SIGINT

src/ftracetool.c

@@ -35,7 +35,7 @@ struct ftt_mapping
     struct ftt_mapping *next;
 };
 
-static double g_wait_sec = 0;
+static double g_wait_sec = -1;
 static int g_max_lines = 0;
 
 static struct ftt_mapping *gs_mappings;
@@ -100,9 +100,15 @@ static int embed_options(sexp ctx)
 {
     sexp_gc_var2(option_name, option_value);
     sexp_gc_preserve2(ctx, option_name, option_value);
+
     option_name = sexp_intern(ctx, "*max-lines*", -1);
     option_value = sexp_make_fixnum(g_max_lines);
     sexp_env_define(ctx, sexp_context_env(ctx), option_name, option_value);
+
+    option_name = sexp_intern(ctx, "*wait-sec*", -1);
+    option_value = sexp_make_fixnum(g_wait_sec);
+    sexp_env_define(ctx, sexp_context_env(ctx), option_name, option_value);
+
     sexp_gc_release2(ctx);
 }
 
@@ -323,12 +329,12 @@ static sexp sexp_sleep_stub(sexp ctx, sexp self, sexp_sint_t n, sexp arg0)
     struct timespec ts;
     sexp res;
     if (!sexp_flonump(arg0))
-        return sexp_type_exception(ctx, self, SEXP_FLONUM, arg0);
+        return sexp_type_exception(ctx, self, SEXP_NUMBER, arg0);
     float sleep_sec = sexp_flonum_value(arg0);
     ts.tv_sec = sleep_sec;
     ts.tv_nsec = (sleep_sec - ts.tv_sec) * 1e9;
-    nanosleep(&ts, NULL);
-    return res;
+    int ret = nanosleep(&ts, NULL);
+    return ret ? SEXP_FALSE : SEXP_TRUE;
 }
 
 static int parse_ftrace_entry(const char *str,
@@ -581,10 +587,10 @@ static int register_sleep(sexp ctx)
     sexp_gc_var1(op);
     sexp_gc_preserve1(ctx, op);
     op = sexp_define_foreign(
-        ctx, sexp_context_env(ctx), "sleep", 1, sexp_sleep_stub);
+        ctx, sexp_context_env(ctx), "sleep-frac", 1, sexp_sleep_stub);
     if (sexp_opcodep(op))
     {
-        sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_NULL);
+        sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
         sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FLONUM);
     }
     sexp_gc_release1(ctx);
@@ -725,7 +731,7 @@ int main(int argc, char **argv)
     char filename[NAME_MAX] = {};
     bool execute_script = false;
     bool show_symbols_in_file = false;
-    while ((opt = getopt(argc, argv, "vhs:e:m:l:")) != -1)
+    while ((opt = getopt(argc, argv, "vhs:e:m:l:w:")) != -1)
     {
         switch (opt)
         {

src/ftracetool.scm

@@ -1,9 +1,11 @@
 (import (scheme base))
 (import (srfi 1))
 (import (srfi 16))
+(import (srfi 18))
 (import (srfi 115))
 (import (srfi 130))
 (import (chibi string))
+(import (chibi process))
 
 (define (mapping-str key)
   (let ((pair (assoc key *ftt-mappings*)))
@@ -25,6 +27,7 @@
       (lambda () (let ((res (thunk))) (close-output-port tmp-out) res))
       (lambda () (current-output-port old-out)))))
 
+
 (define-record-type probe
   (make-probe
    install-handler
@@ -61,11 +64,34 @@
   (pid trace-event-pid)
   (arguments trace-event-arguments))
 
+(define (with-signal-handler sig handler thunk)
+  (let ((old-handler #f))
+    (dynamic-wind
+      (lambda () (set! old-handler (set-signal-action! sig handler)))
+      thunk
+      (lambda () (set-signal-action! sig old-handler)))))
+
 (define define-probes
   (case-lambda
    (()
-    (display "Do waiting\n")
-    (sleep 1.0))
+    (if (> *wait-sec* 0)
+        (begin
+          (display "Waiting ")
+          (display *wait-sec*)
+          (newline)
+          (sleep *wait-sec*))
+        (begin
+          (display "Waiting for Ctrl+C\n")
+          (let ((stop #f))
+            (with-signal-handler
+             signal/interrupt
+             (lambda (x) (set! stop #t))
+             (lambda ()
+               (let loop ()
+                 (unless stop
+                   (set! stop (not (sleep-frac 0.1)))
+                   (loop))))))
+          (display "Stop..\n"))))
    ((probe . rest)
     (let ((token ((probe-install-handler probe))))
       (guard (x