diff --git a/CMakeLists.txt b/CMakeLists.txt index 2e69d83..02dbbe7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.10) +cmake_minimum_required(VERSION 3.30) project(ftracetool C) set(CMAKE_C_STANDARD 23) @@ -24,8 +24,13 @@ message(STATUS "Libelf libraries: ${LIBELF_LIBRARIES}") message(STATUS "Chibi-scheme include dirs: ${CHIBI_SCHEME_INCLUDE_DIRS}") message(STATUS "Chibi-scheme libraries: ${CHIBI_SCHEME_LIBRARIES}") +add_custom_target(ftracetool_scm.h + COMMAND xxd -i < ${CMAKE_SOURCE_DIR}/src/ftracetool.scm > ${CMAKE_CURRENT_BINARY_DIR}/ftracetool_scm.h) + add_executable(ftracetool ${SOURCES}) +add_dependencies(ftracetool ftracetool_scm.h) +target_include_directories(ftracetool PRIVATE ${CMAKE_CURRENT_BINARY_DIR}) target_include_directories(ftracetool PRIVATE ${LIBELF_INCLUDE_DIRS} ${CHIBI_SCHEME_INCLUDE_DIRS}) target_link_libraries(ftracetool PRIVATE ${LIBELF_LIBRARIES} ${CHIBI_SCHEME_LIBRARIES}) diff --git a/src/ftracetool.c b/src/ftracetool.c index 1a7dbd1..f86e777 100644 --- a/src/ftracetool.c +++ b/src/ftracetool.c @@ -17,6 +17,10 @@ #define CLEANUP(f) __attribute__((cleanup(f))) +static const char gs_ftracetool_scm[] = { +#include "ftracetool_scm.h" +}; + struct ftt_mapping { char *key; @@ -300,11 +304,28 @@ static int register_ftracetool_api(sexp ctx) sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING); sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING); } - sexp_gc_release3(ctx); + sexp_gc_release1(ctx); return 0; } +static int eval_ftracetool_scm(sexp ctx) +{ + sexp_gc_var2(ret, fname); + sexp_gc_preserve2(ctx, ret, fname); + fname = sexp_c_string(ctx, "ftracetool.scm", -1); + ret = sexp_load(ctx, fname, sexp_context_env(ctx)); + if (sexp_exceptionp(ret)) + { + fprintf(stderr, "Exception occured while eval ftracetool_scm:\n"); + sexp_print_exception(ctx, ret, sexp_current_output_port(ctx)); + return EXIT_FAILURE; + } + + sexp_gc_release2(ctx); + return 0; +} + static int do_execute_script(const char *const filename) { int ret = EXIT_SUCCESS; @@ -324,6 +345,12 @@ static int do_execute_script(const char *const filename) return EXIT_FAILURE; } + if (eval_ftracetool_scm(ctx)) + { + fprintf(stderr, "Unable to register ftracetool.scm API\n"); + return EXIT_FAILURE; + } + filename_obj = sexp_c_string(ctx, filename, -1); scheme_ret = sexp_load(ctx, filename_obj, NULL); if (sexp_exceptionp(scheme_ret)) diff --git a/src/ftracetool.scm b/src/ftracetool.scm new file mode 100644 index 0000000..8612f45 --- /dev/null +++ b/src/ftracetool.scm @@ -0,0 +1,51 @@ +(import (scheme base)) +(import (srfi 16)) + +(define (mapping-str key) + (let ((pair (assoc key *ftt-mappings*))) + (if pair + (cdr pair) + (raise (string-append "No mapping: " key))))) + +(define (mapping-int key) + (let ((value (mapping-str key))) + (when value + (string->number value)))) + +(define-record-type probe + (make-probe + install-handler + remove-handler + process-handler) + probe? + (install-handler probe-install-handler) + (remove-handler probe-remove-handler) + (process-handler probe-process-handler)) + +(define define-probes + (case-lambda + (() (display "Do waiting\n")) + ((probe . rest) + (display "Got probe: ") + (display probe) + (newline) + (let ((token ((probe-install-handler probe)))) + (guard (x + (else + (display "Error:") + (display x) + (newline))) + (apply define-probes rest) + ((probe-process-handler probe))) + ((probe-remove-handler probe) token)) + )) + ) + +(define (ftrace-uprobe probe-name binary-path symbol args handler) + (list 'uprobe probe-name binary-path symbol args handler)) + +(define (tracing-probe ctx install remove process) + (make-probe (lambda () (install ctx)) + (lambda (_) (remove ctx)) + (lambda () (process ctx)))) +