diff --git a/src/ftracetool.c b/src/ftracetool.c index 81e5a60..4b96b06 100644 --- a/src/ftracetool.c +++ b/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) { diff --git a/src/ftracetool.scm b/src/ftracetool.scm index 85e17d1..7ceb477 100644 --- a/src/ftracetool.scm +++ b/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