>From 1b325fd658c01f3e1a540b9567cf2f53be337da7 Mon Sep 17 00:00:00 2001 From: Evan Hanson
Date: Sun, 22 Jul 2018 22:23:17 +1200 Subject: [PATCH] Some small debugger data and wire protocol improvements These changes are intended to simplify the use of the debugging protocol by client applications by fixing a few oddities that would otherwise need to be coded around on the client side. Populate the "location" slot for call events. Previously, the debugging stub would send Scheme filenames and line number information to clients in the "location" slot for all except for 'call' events, which would instead have the location as a prefix of the "value" slot. Move this source information into the "location" slot so that all events sent to the client use the fields in the same way in all cases. Send missing values to the client as `#f' rather than as strings. Previously, the debugging stub would send missing values to the client as either an empty string or a string containing "#f" (a byproduct of using `->string' during code generation), but it's easier to handle the "real" #f token on the client side. So, introduce a `send_string_value' procedure that sends C strings to the client as either a quoted string or #f if the string is NULL or empty, rather than as strings in all cases. Update call sites to indicate missing events and file locations as NULL in C and #f on the wire. This requires bumping the predefined integer value definitions by one, since event locations may now be NULL if no Scheme or C source information is available. Rename `send_value' to `send_scheme_value' for consistency with `send_string_value'. Update feathers.tcl as necessary. Emit C source info as a single string, rather than as a separate filename and line number, to simplify its use in dbg-stub.c. Use symbols for `##core#debug-event' node event types in core.scm. Previously, these were strings in some places and symbols in others. --- c-backend.scm | 4 +++- chicken.h | 26 ++++++++++++++------------ core.scm | 26 ++++++++++++++------------ dbg-stub.c | 49 +++++++++++++++++++++++++++++++------------------ feathers.tcl | 43 +++++++++++++++++++++++++++---------------- runtime.c | 2 +- support.scm | 12 +++++++----- 7 files changed, 97 insertions(+), 65 deletions(-) diff --git a/c-backend.scm b/c-backend.scm index c6514ecd..ee74d2b9 100644 --- a/c-backend.scm +++ b/c-backend.scm @@ -971,7 +971,9 @@ (gen #t "{" (second info) ",0,") (for-each (lambda (x) - (gen "C_text(\"" (backslashify (->string x)) "\"),")) + (if (not x) + (gen "NULL,") + (gen "C_text(\"" (backslashify (->string x)) "\"),"))) (cddr info)) (gen "},")) (sort dbg-info-table (lambda (i1 i2) (< (car i1) (car i2))))) diff --git a/chicken.h b/chicken.h index 1bbd1ba6..dd65be42 100644 --- a/chicken.h +++ b/chicken.h @@ -784,6 +784,9 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; #define CHICKEN_default_toplevel ((void *)C_default_5fstub_toplevel) +#define C__STR1(x) #x +#define C__STR2(x) C__STR1(x) + #define C_align4(n) (((n) + 3) & ~3) #define C_align8(n) (((n) + 7) & ~7) #define C_align16(n) (((n) + 15) & ~15) @@ -826,10 +829,9 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; */ # define C_VAL1(x) C__PREV_TMPST.n1 # define C_VAL2(x) C__PREV_TMPST.n2 -# define C__STR(x) #x # define C__CHECK_panic(a,s,f,l) \ ((a) ? (void)0 : \ - C_panic_hook(C_text("Low-level type assertion " s " failed at " f ":" C__STR(l)))) + C_panic_hook(C_text("Low-level type assertion " s " failed at " f ":" C__STR1(l)))) # define C__CHECK_core(v,a,s,x) \ ({ struct { \ typeof(v) n1; \ @@ -1644,16 +1646,16 @@ typedef struct C_DEBUG_INFO { C_char *val; } C_DEBUG_INFO; -#define C_DEBUG_CALL 0 -#define C_DEBUG_GLOBAL_ASSIGN 1 -#define C_DEBUG_GC 2 -#define C_DEBUG_ENTRY 3 -#define C_DEBUG_SIGNAL 4 -#define C_DEBUG_CONNECT 5 -#define C_DEBUG_LISTEN 6 -#define C_DEBUG_INTERRUPTED 7 +#define C_DEBUG_CALL 1 +#define C_DEBUG_GLOBAL_ASSIGN 2 +#define C_DEBUG_GC 3 +#define C_DEBUG_ENTRY 4 +#define C_DEBUG_SIGNAL 5 +#define C_DEBUG_CONNECT 6 +#define C_DEBUG_LISTEN 7 +#define C_DEBUG_INTERRUPTED 8 -#define C_debugger(cell, c, av) (C_debugger_hook != NULL ? C_debugger_hook(cell, c, av, C_text(__FILE__), __LINE__) : C_SCHEME_UNDEFINED) +#define C_debugger(cell, c, av) (C_debugger_hook != NULL ? C_debugger_hook(cell, c, av, C_text(__FILE__ ":" C__STR2(__LINE__))) : C_SCHEME_UNDEFINED) /* Variables: */ @@ -1688,7 +1690,7 @@ C_varextern C_TLS void *C_restart_trampoline; C_varextern C_TLS void (*C_pre_gc_hook)(int mode); C_varextern C_TLS void (*C_post_gc_hook)(int mode, C_long ms); C_varextern C_TLS void (*C_panic_hook)(C_char *msg); -C_varextern C_TLS C_word (*C_debugger_hook)(C_DEBUG_INFO *cell, C_word c, C_word *av, char *cloc, int cln); +C_varextern C_TLS C_word (*C_debugger_hook)(C_DEBUG_INFO *cell, C_word c, C_word *av, char *cloc); C_varextern C_TLS int C_abort_on_thread_exceptions, diff --git a/core.scm b/core.scm index 2bbed0b2..ec05bd39 100644 --- a/core.scm +++ b/core.scm @@ -787,7 +787,7 @@ (walk (if emit-debug-info `(##core#begin - (##core#debug-event "C_DEBUG_ENTRY" ',dest) + (##core#debug-event C_DEBUG_ENTRY ',dest) ,body0) body0) (append aliases e) #f #f dest ln #f)))) @@ -1121,7 +1121,7 @@ (when emit-debug-info (set! val `(let ((,var ,val)) - (##core#debug-event "C_DEBUG_GLOBAL_ASSIGN" ',var) + (##core#debug-event C_DEBUG_GLOBAL_ASSIGN ',var) ,var))) ;; We use `var0` instead of `var` because the {macro,current}-environment ;; are keyed by the raw and unqualified name @@ -1144,7 +1144,7 @@ ((##core#debug-event) `(##core#debug-event - ,(unquotify (cadr x)) + ,(cadr x) ,ln ; this arg is added - from this phase on ##core#debug-event has an additional argument! ,@(map (lambda (arg) (unquotify (walk arg e #f #f h ln tl?))) @@ -2500,7 +2500,7 @@ (not (llist-match? llist (cdr subs)))) (quit-compiling "~a: procedure `~a' called with wrong number of arguments" - (source-info->line name) + (source-info->string name) (if (pair? name) (cadr name) name))) (register-direct-call! id) (when custom (register-customizable! varname id)) @@ -2770,11 +2770,12 @@ (walk-var (first params) e e-count #f) ) ((##core#direct_call) - (let* ((name (second params)) - (name-str (source-info->string name)) + (let* ((source-info (second params)) (demand (fourth params))) - (if (and emit-debug-info name) - (let ((info (list dbg-index 'C_DEBUG_CALL "" name-str))) + (if (and emit-debug-info source-info) + (let ((info (list dbg-index 'C_DEBUG_CALL + (source-info->line source-info) + (source-info->name source-info)))) (set! params (cons dbg-index params)) (set! debug-info (cons info debug-info)) (set! dbg-index (add1 dbg-index))) @@ -2937,13 +2938,14 @@ ((##core#call) (let* ((len (length (cdr subs))) (p2 (pair? (cdr params))) - (name (and p2 (second params))) - (name-str (source-info->string name))) + (source-info (and p2 (second params)))) (set! signatures (lset-adjoin/eq? signatures len)) (when (and (>= (length params) 3) (eq? here (third params))) (set! looping (add1 looping)) ) - (if (and emit-debug-info name) - (let ((info (list dbg-index 'C_DEBUG_CALL "" name-str))) + (if (and emit-debug-info source-info) + (let ((info (list dbg-index 'C_DEBUG_CALL + (source-info->line source-info) + (source-info->name source-info)))) (set! params (cons dbg-index params)) (set! debug-info (cons info debug-info)) (set! dbg-index (add1 dbg-index))) diff --git a/dbg-stub.c b/dbg-stub.c index 53d91cc1..e58a8af6 100644 --- a/dbg-stub.c +++ b/dbg-stub.c @@ -118,7 +118,7 @@ static volatile int interrupted = 0; static int dbg_info_count = 0; -static C_word debug_event_hook(C_DEBUG_INFO *cell, C_word c, C_word *av, C_char *cloc, int cln); +static C_word debug_event_hook(C_DEBUG_INFO *cell, C_word c, C_word *av, C_char *cloc); void @@ -238,7 +238,7 @@ enable_debug_info(int n, int f) C_DEBUG_INFO *dinfo; for(dip = dbg_info_list; dip != NULL; dip = dip->next) { - for(dinfo = dip->info; dinfo->loc != NULL; ++dinfo) { + for(dinfo = dip->info; dinfo->event; ++dinfo) { if(i++ == n) { dinfo->enabled = f; return; @@ -251,7 +251,7 @@ enable_debug_info(int n, int f) static void -send_string(char *str) +send_string(C_char *str) { /* fprintf(stderr, "