From e9e4a8e452f458358814cb309049030ebc8e8747 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 26 Nov 2015 13:58:12 +0100
Subject: [PATCH] This patch provides a basic form of source-level debugging
 to compiled Scheme code.

The compiler has been extended to decorate code with "debug-event"
forms ("##core#debug-event"). In the code-generation phase these
emit calls to a hook-function ("C_debugger") that is used to
submit debug events to a connected TCP server. Each event has
an associated record of debug-information (line-numbers, etc.)

An extension to the run-time system implements the C_debugger hook
and provides a simple TCP-based connection to a TCP server on
port 9999, sending events, when encountered and reading response
"actions" from the server. The protocol is text- and s-expression
based.

The new debug-level 3 enables the mechanism. If "-d3" is given,
the "debugger-client" unit is invoked, which checks the environment
variable "CHICKEN_DEBUGGER" (that should hold a string of the form
"<servername>:<port>"), tried to connect and, if the connection
can be established, suspends the program, waiting for responses.

A simple Tcl/Tk based debugger "front-end" is provided. It is called
"feathers" and requires Tcl/Tk 8.5.

Basic usage is explained in the new "Debugging" chapter in the
manual. It cointains just the basics, though. I have tested this
on Linux, Windows and Mac. As the version of Tcl/Tk on Mac is
very buggy, I was only able to run it with an X11-based version
(requires XQuartz). It seems to run ok on Windows (using ActiveState
Tcl/Tk), but I have only done very basic tests on that platform.

The front-end currently allows single-stepping, inspecting arguments
and global variables, setting break-points on source lines (only
for those, for which line-number information could be recovered)
and global variables.

The build has been extended to produce and install executable scripts
("feathers" and "feathers.bat"), and the "debugger-client" unit
has been added.

Note that the calls to C_debugger have a performance impact.
"C_trace" is called implicitly in the case of a "procedure call"
event to avoid an additional library function call.
C_debugger is called for the following events: procedure
entry, procedure call, global-variable assignment, GC, error and
termination.
---
 Makefile.mingw                                     |    1 +
 batch-driver.scm                                   |   36 +-
 c-backend.scm                                      |   49 +-
 c-platform.scm                                     |    2 +-
 chicken.h                                          |   27 +
 chicken.scm                                        |    3 +-
 compiler.scm                                       |   66 +-
 csc.scm                                            |    7 +-
 csi.scm                                            |    2 +-
 dbg-stub.c                                         |  569 ++++++
 debugger-client.scm                                |   32 +
 defaults.make                                      |   12 +-
 feathers.bat.in                                    |   26 +
 feathers.in                                        |   38 +
 feathers.tcl                                       | 1892 ++++++++++++++++++++
 library.scm                                        |   20 +
 manual/Debugging                                   |  159 ++
 .../Interface to external functions and variables  |    2 +-
 manual/Supported language                          |    2 +-
 manual/The User's Manual                           |    3 +-
 rules.make                                         |   16 +-
 runtime.c                                          |   42 +-
 support.scm                                        |    7 +
 23 files changed, 2962 insertions(+), 51 deletions(-)
 create mode 100644 dbg-stub.c
 create mode 100644 debugger-client.scm
 create mode 100644 feathers.bat.in
 create mode 100644 feathers.in
 create mode 100755 feathers.tcl
 create mode 100644 manual/Debugging

diff --git a/Makefile.mingw b/Makefile.mingw
index a0ca8d9..f9cda73 100644
--- a/Makefile.mingw
+++ b/Makefile.mingw
@@ -62,6 +62,7 @@ LIBCHICKEN_SO_LINKER_OPTIONS = -Wl,--out-implib,lib$(PROGRAM_PREFIX)chicken$(PRO
 LIBCHICKEN_SO_LIBRARIES = -lm -lws2_32 
 LIBCHICKEN_IMPORT_LIBRARY = lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX).dll.a
 MAKEDIR_COMMAND_OPTIONS =
+GENERATE_DEBUGGER = type $< >$@ & echo wish $(DATADIR)\feathers.tcl %1 %2 %3 %4 %5 %6 %7 %8 %9 >>$@
 
 # special files
 
diff --git a/batch-driver.scm b/batch-driver.scm
index a5fa323..f365ea5 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -52,9 +52,13 @@
 	      arg) ) ) )
   (initialize-compiler)
   (set! explicit-use-flag (memq 'explicit-use options))
+  (set! emit-debug-info (memq 'debug-info options))  
   (let ((initforms `((##core#declare
 		      ,@(append 
 			 default-declarations
+			 (if emit-debug-info
+			     '((uses debugger-client))
+			     '())
 			 (if explicit-use-flag
 			     '()
 			     `((uses ,@units-used-by-default)) ) ) ) ) )
@@ -664,19 +668,19 @@
 			    (when a-only (exit 0))
 			    (begin-time)
 			    ;; Preparation
-			    (receive 
-			     (node literals lliterals lambda-table)
-			     (prepare-for-code-generation node2 db)
-			     (end-time "preparation")
-			     (begin-time)
-			     ;; Code generation
-			     (let ((out (if outfile (open-output-file outfile) (current-output-port))) )
-			       (dribble "generating `~A' ..." outfile)
-			       (generate-code literals lliterals lambda-table out filename dynamic db)
-			       (when outfile
-				 (close-output-port out)))
-			     (end-time "code generation")
-			     (when (memq 't debugging-chicken)
-			       (##sys#display-times (##sys#stop-timer)))
-			     (compiler-cleanup-hook)
-			     (dribble "compilation finished.") ) ) ) ) ) ) ) ) ) ) ) )
+			    (receive (node literals lliterals lambda-table dbg-info)
+				(prepare-for-code-generation node2 db)
+			      (end-time "preparation")
+			      (begin-time)
+			      ;; Code generation
+			      (let ((out (if outfile (open-output-file outfile) (current-output-port))) )
+				(dribble "generating `~A' ..." outfile)
+				(generate-code literals lliterals lambda-table out filename 
+                                     dynamic db dbg-info)
+				(when outfile
+				  (close-output-port out)))
+			      (end-time "code generation")
+			      (when (memq 't debugging-chicken)
+				(##sys#display-times (##sys#stop-timer)))
+			      (compiler-cleanup-hook)
+			      (dribble "compilation finished.") ) ) ) ) ) ) ) ) ) ) ) )
diff --git a/c-backend.scm b/c-backend.scm
index 7374783..c7a0287 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -59,10 +59,12 @@
 
 ;;; Generate target code:
 
-(define (generate-code literals lliterals lambda-table out source-file dynamic db)
+(define (generate-code literals lliterals lambda-table out source-file dynamic db
+                       dbg-info-table)
+  (let ((non-av-proc #f))
+
   ;; Don't truncate floating-point precision!
   (flonum-print-precision (+ flonum-maximum-decimal-exponent 1))
-  (let ()
 
     ;; Some helper procedures
 
@@ -227,17 +229,21 @@
 		    (n (length args))
 		    (nc i)
 		    (nf (add1 n)) 
-		    (p2 (pair? (cdr params)))
-		    (name (and p2 (second params)))
+                    (dbi (first params))
+		    (p2 (pair? (cddr params)))
+		    (name (and p2 (third params)))
 		    (name-str (source-info->string name))
-		    (call-id (and p2 (pair? (cddr params)) (third params))) 
-		    (customizable (and call-id (fourth params)))
+		    (call-id (and p2 (pair? (cdddr params)) (fourth params))) 
+		    (customizable (and call-id (fifth params)))
 		    (empty-closure (and customizable (zero? (lambda-literal-closure-size (find-lambda call-id)))))
 		    (fn (car subs)) )
 	       (when name
-		 (if emit-trace-info
-		     (gen #t "C_trace(\"" (slashify name-str) "\");")
-		     (gen #t "/* " (uncommentify name-str) " */") ) )
+		 (cond (emit-debug-info 
+                         (when dbi 
+                           (gen #t "C_debugger(&(C_debug_info[" dbi "])," 
+                                (if non-av-proc "0,NULL" "c,av") ");")))
+		       (emit-trace-info (gen #t "C_trace(\"" (slashify name-str) "\");"))
+		       (else (gen #t "/* " (uncommentify name-str) " */") ) ) )
 	       (cond ((eq? '##core#proc (node-class fn))
 		      (gen #\{)
 		      (push-args args i "0")
@@ -383,6 +389,10 @@
 	     (expr-args subs i)
 	     (gen #\)) )
 
+	    ((##core#debug-event)
+  	     (gen "C_debugger(&(C_debug_info[" (first params) "]),"
+                  (if non-av-proc "0,NULL" "c,av") ")"))
+
 	    ((##core#inline_allocate)
 	     (gen (first params) "(&a," (length subs))
 	     (if (pair? subs)
@@ -780,6 +790,8 @@
 		    (gen #t "C_word *a;"
 			 #t "if(toplevel_initialized) {C_kontinue(t1,C_SCHEME_UNDEFINED);}"
 			 #t "else C_toplevel_entry(C_text(\"" topname "\"));")
+		    (when emit-debug-info
+		      (gen #t "C_register_debug_info(C_debug_info);"))
 		    (when disable-stack-overflow-checking
 		      (gen #t "C_disable_overflow_check=1;") )
 		    (unless unit-name
@@ -850,6 +862,7 @@
 			       (else
 				(gen "C_save_and_reclaim((void *)" id #\, n ",av);}")))]))
 		 (else (gen #\})))
+           (set! non-av-proc customizable)
 	   (expression
 	    (lambda-literal-body ll)
 	    (if rest
@@ -868,11 +881,29 @@
     (prototypes)
     (generate-foreign-callback-stubs foreign-callback-stubs db)
     (trampolines)
+    (when emit-debug-info
+      (generate-debug-info dbg-info-table))
     (procedures)
     (emit-procedure-table-info lambda-table source-file)
     (trailer) ) )
 
 
+;;; Emit global tables for debug-info
+
+(define (generate-debug-info dbg-info-table)
+  (gen #t #t "static C_DEBUG_INFO C_debug_info[]={")
+  (for-each 
+   (lambda (info)
+     (gen #t "{" (second info) ",0,")
+     (for-each
+       (lambda (x)
+         (gen "\"" (slashify (->string x)) "\","))
+       (cddr info))
+     (gen "},"))
+   (sort dbg-info-table (lambda (i1 i2) (< (car i1) (car i2)))))
+  (gen #t "{0,0,NULL,NULL}};\n"))
+
+
 ;;; Emit procedure table:
 
 (define (emit-procedure-table-info lambda-table sf)
diff --git a/c-platform.scm b/c-platform.scm
index ecc97f4..768f972 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -91,7 +91,7 @@
     no-procedure-checks-for-toplevel-bindings module
     no-bound-checks no-procedure-checks-for-usual-bindings no-compiler-syntax
     no-parentheses-synonyms no-symbol-escape r5rs-syntax emit-all-import-libraries
-    strict-types clustering lfa2
+    strict-types clustering lfa2 debug-info
     setup-mode no-module-registration) )
 
 (define valid-compiler-options-with-argument
diff --git a/chicken.h b/chicken.h
index f51d5dc..735caff 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1570,6 +1570,29 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 #define C_i_true3(dummy1, dummy2, dummy3)  ((dummy1), (dummy2), (dummy3), C_SCHEME_TRUE)
 
 
+/* debug client interface */
+
+typedef struct C_DEBUG_INFO {
+  int event;
+  int enabled;
+  C_char *loc;
+  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_debugger(cell, c, av)     (C_debugger_hook != NULL ? C_debugger_hook(cell, c, av, __FILE__, __LINE__) : C_SCHEME_UNDEFINED)
+
+C_fctexport void C_register_debug_info(C_DEBUG_INFO *);
+
+
 /* Variables: */
 
 C_varextern C_TLS time_t C_startup_time_seconds;
@@ -1597,6 +1620,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 int
   C_abort_on_thread_exceptions,
@@ -1606,6 +1630,7 @@ C_varextern C_TLS int
   C_heap_size_is_fixed,
   C_max_pending_finalizers,
   C_trace_buffer_size,
+  C_debugging,
   C_main_argc;
 C_varextern C_TLS C_uword
   C_heap_growth,
@@ -1948,6 +1973,8 @@ C_fctexport C_cpsproc(C_peek_unsigned_integer_32);
 C_fctexport C_word C_fcall C_decode_literal(C_word **ptr, C_char *str) C_regparm;
 C_fctexport C_word C_fcall C_i_pending_interrupt(C_word dummy) C_regparm;
 
+C_fctexport void *C_get_statistics(void);
+
 /* defined in eval.scm: */
 C_fctexport  void  CHICKEN_get_error_message(char *buf,int bufsize);
 C_fctexport  int  CHICKEN_load(char * filename);
diff --git a/chicken.scm b/chicken.scm
index 4851fae..6bf4f33 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -136,7 +136,8 @@
 		 (case level
 		   ((0) (set! options (cons* 'no-lambda-info 'no-trace options)))
 		   ((1) (set! options (cons 'no-trace options)))
-		   (else (set! options (cons 'scrutinize options))))
+		   ((2) (set! options (cons 'scrutinize options)))
+		   (else (set! options (cons* 'scrutinize 'debug-info options))))
 		 (loop (cdr rest)) ) )
 	      ((memq o valid-compiler-options) (loop rest))
 	      ((memq o valid-compiler-options-with-argument)
diff --git a/compiler.scm b/compiler.scm
index 55dbda6..2a03157 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -148,6 +148,7 @@
 ; (##core#let-module-alias ((<alias> <name>) ...) <body>)
 ; (##core#the <type> <strict?> <exp>)
 ; (##core#typecase <info> <exp> (<type> <body>) ... [(else <body>)])
+; (##core#debug-event {<event> <loc>})
 ; (<exp> {<exp>})
 
 ; - Core language:
@@ -166,6 +167,7 @@
 ; [##core#inline_update {<name> <type>} <exp>]
 ; [##core#inline_loc_ref {<type>} <exp>]
 ; [##core#inline_loc_update {<type>} <exp> <exp>]
+; [##core#debug-event {<event> <loc> <ln>}]
 ; [##core#call {<safe-flag> [<debug-info>]} <exp-f> <exp>...]
 ; [##core#callunit {<unitname>} <exp>...]
 ; [##core#switch {<count>} <exp> <const1> <body1> ... <defaultbody>]
@@ -194,6 +196,7 @@
 ; [##core#inline_loc_ref {<type>} <exp>]
 ; [##core#inline_loc_update {<type>} <exp> <exp>]
 ; [##core#inline_unboxed {<op>} <exp> ...]
+; [##core#debug-event {<index> <event> <loc> <ln>}]
 ; [##core#closure {<count>} <exp>...]
 ; [##core#box {} <exp>]
 ; [##core#unbox {} <exp>]
@@ -202,7 +205,7 @@
 ; [##core#updatebox {} <exp> <exp>]
 ; [##core#update_i {<index>} <exp> <exp>]
 ; [##core#updatebox_i {} <exp> <exp>]
-; [##core#call {<safe-flag> [<debug-info> [<call-id> <customizable-flag>]]} <exp-f> <exp>...]
+; [##core#call {<dbg-info-index> <safe-flag> [<debug-info> [<call-id> <customizable-flag>]]} <exp-f> <exp>...]
 ; [##core#callunit {<unitname>} <exp>...]
 ; [##core#cond <exp> <exp> <exp>]
 ; [##core#local {<index>}]
@@ -305,6 +308,7 @@
 (define unsafe #f)
 (define foreign-declarations '())
 (define emit-trace-info #f)
+(define emit-debug-info #f)
 (define block-compilation #f)
 (define line-number-database-size default-line-number-database-size)
 (define target-heap-size #f)
@@ -665,7 +669,13 @@
 				     (se2 (##sys#extend-se se vars aliases))
 				     (body0 (##sys#canonicalize-body 
 					     obody se2 compiler-syntax-enabled))
-				     (body (walk body0 (append aliases e) se2 #f #f dest ln))
+				     (body (walk 
+                                             (if emit-debug-info
+                                                `(##core#begin
+                                                   (##core#debug-event "C_DEBUG_ENTRY" ',dest)
+                                                   ,body0)
+                                                body0)
+                                             (append aliases e) se2 #f #f dest ln))
 				     (llist2 
 				      (build-lambda-list
 				       aliases argc
@@ -966,7 +976,13 @@
 						  (##sys#alias-global-hook var #t dest)))
 				    (when safe-globals-flag
 				      (mark-variable var '##compiler#always-bound-to-procedure)
-				      (mark-variable var '##compiler#always-bound)))
+				      (mark-variable var '##compiler#always-bound))
+				    (when emit-debug-info
+				      (let ((tmp (gensym)))
+					(set! val
+					  `(let ((,tmp ,val))
+					     (##core#debug-event "C_DEBUG_GLOBAL_ASSIGN" ',var)
+					     ,tmp)))))
 				  (cond ((##sys#macro? var)
 					 (warning 
 					  (sprintf "assigned global variable `~S' is syntax ~A"
@@ -980,6 +996,14 @@
 				    (warning (sprintf "assignment to keyword `~S'" var) ))
 				  `(set! ,var ,(walk val e se var0 (memq var e) h ln))))))
 
+			((##core#debug-event)
+  		          `(##core#debug-event
+      			     ,(unquotify (cadr x) se)
+      			     ,ln ; this arg is added - from this phase on ##core#debug-event has an additional argument!
+      			     ,@(map (lambda (arg)
+      			              (unquotify (walk arg e se #f #f h ln) se))
+      			            (cddr x))))
+
 			((##core#inline)
 			 `(##core#inline
 			   ,(unquotify (cadr x) se) ,@(mapwalk (cddr x) e se h ln)))
@@ -1748,7 +1772,7 @@
 	   (mark-variable id '##compiler#callback-lambda)
 	   (cps-lambda id (first (node-parameters lam)) (node-subexpressions lam) k) ) )
 	((##core#inline ##core#inline_allocate ##core#inline_ref ##core#inline_update ##core#inline_loc_ref 
-			##core#inline_loc_update)
+			##core#inline_loc_update ##core#debug-event)
 	 (walk-inline-call class params subs k) )
 	((##core#call) (walk-call (car subs) (cdr subs) params k))
 	((##core#callunit) (walk-call-unit (first params) k))
@@ -2338,7 +2362,7 @@
 		 val) ) )
 
 	  ((if ##core#call ##core#inline ##core#inline_allocate ##core#callunit 
-	       ##core#inline_ref ##core#inline_update 
+	       ##core#inline_ref ##core#inline_update ##core#debug-event
 	       ##core#switch ##core#cond ##core#direct_call ##core#recurse ##core#return 
 	       ##core#inline_loc_ref
 	       ##core#inline_loc_update)
@@ -2520,7 +2544,9 @@
         (signatures '()) 
 	(fastinits 0) 
 	(fastrefs 0) 
-	(fastsets 0) )
+	(fastsets 0) 
+        (dbg-index 0)
+        (debug-info '()))
 
     (define (walk-var var e e-count sf)
       (cond [(posq var e)
@@ -2707,11 +2733,20 @@
 		       (list (walk (car subs) e e-count here boxes)) ) ) ) ) ) )
 
 	  ((##core#call) 
-	   (let ([len (length (cdr subs))])
+	   (let* ((len (length (cdr subs)))
+		  (p2 (pair? (cdr params)))
+		  (name (and p2 (second params)))
+		  (name-str (source-info->string name)))
 	     (set! signatures (lset-adjoin = signatures len)) 
 	     (when (and (>= (length params) 3) (eq? here (third params)))
 	       (set! looping (add1 looping)) )
-	     (make-node class params (mapwalk subs e e-count here boxes)) ) )
+               (if (and emit-debug-info name)
+                 (let ((info (list dbg-index 'C_DEBUG_CALL "" name-str)))
+                   (set! params (cons dbg-index params))
+                   (set! debug-info (cons info debug-info))
+                   (set! dbg-index (add1 dbg-index)))
+                 (set! params (cons #f params)))
+   	     (make-node class params (mapwalk subs e e-count here boxes))))
 
 	  ((##core#recurse)
 	   (when (first params) (set! looping (add1 looping)))
@@ -2763,6 +2798,13 @@
 			const body
 			(loop (sub1 j) (cddr subs) (max (- allocated a0) ma))))))))))
 
+	  ((##core#debug-event)
+            (let* ((i dbg-index)
+                   (params (cons i params)))
+              (set! debug-info (cons params debug-info))
+              (set! dbg-index (add1 dbg-index))
+   	      (make-node class params '())))
+
 	  (else (make-node class params (mapwalk subs e e-count here boxes)) ) ) ) )
     
     (define (mapwalk xs e e-count here boxes)
@@ -2815,5 +2857,9 @@
 	(debugging 'o "fast global references" fastrefs))
       (when (positive? fastsets)
 	(debugging 'o "fast global assignments" fastsets))
-      (values node2 (##sys#fast-reverse literals)
-              (##sys#fast-reverse lambda-info-literals) lambda-table) ) ) )
+      (values node2 
+              (##sys#fast-reverse literals)
+              (##sys#fast-reverse lambda-info-literals) 
+              lambda-table
+              (##sys#fast-reverse debug-info))))
+)
diff --git a/csc.scm b/csc.scm
index 1e5b19b..965ba45 100644
--- a/csc.scm
+++ b/csc.scm
@@ -153,7 +153,7 @@
     -no-argc-checks -no-bound-checks -no-procedure-checks -no-compiler-syntax
     -emit-all-import-libraries -setup-mode -no-elevation -no-module-registration
     -no-procedure-checks-for-usual-bindings -module
-    -specialize -strict-types -clustering -lfa2
+    -specialize -strict-types -clustering -lfa2 -debug-info
     -no-procedure-checks-for-toplevel-bindings))
 
 (define-constant complex-options
@@ -369,9 +369,11 @@ Usage: #{csc} FILENAME | OPTION ...
   Debugging options:
 
     -w  -no-warnings               disable warnings
-    -d0 -d1 -d2 -debug-level NUMBER
+    -d0 -d1 -d2 -d3 -debug-level NUMBER
                                    set level of available debugging information
     -no-trace                      disable rudimentary debugging information
+    -debug-info                    enable debug-information in compiled code for use
+                                    with an external debugger
     -profile                       executable emits profiling information 
     -accumulate-profile            executable emits profiling information in
                                     append mode
@@ -692,6 +694,7 @@ EOF
 	       [(|-d0|) (set! rest (cons* "-debug-level" "0" rest))]
 	       [(|-d1|) (set! rest (cons* "-debug-level" "1" rest))]
 	       [(|-d2|) (set! rest (cons* "-debug-level" "2" rest))]
+	       [(|-d3|) (set! rest (cons* "-debug-level" "3" rest))]
 	       [(-dry-run) 
 		(set! verbose #t)
 		(set! dry-run #t)]
diff --git a/csi.scm b/csi.scm
index e68aa7d..0c45232 100644
--- a/csi.scm
+++ b/csi.scm
@@ -334,7 +334,7 @@ EOF
 				[xn (eval n)] )
 			   (dump xe xn) ) )
 			((r) (report))
-			((q) (##sys#quit-hook))
+			((q) (##sys#quit-hook #f))
 			((l)
 			 (let ((fns (string-split (read-line))))
 			   (for-each load fns)
diff --git a/dbg-stub.c b/dbg-stub.c
new file mode 100644
index 0000000..cfe009a
--- /dev/null
+++ b/dbg-stub.c
@@ -0,0 +1,569 @@
+/* dbg-stub.c - Client-side interface, lowlevel part
+;
+; Copyright (c) 2008-2015, The CHICKEN Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+;     disclaimer. 
+;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+;     disclaimer in the documentation and/or other materials provided with the distribution. 
+;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
+;     products derived from this software without specific prior written permission. 
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+*/
+
+
+/* included from debugger-client.scm */
+
+#include <assert.h>
+
+#ifdef _WIN32
+# include <winsock2.h>
+# include <ws2tcpip.h>
+/* Beware: winsock2.h must come BEFORE windows.h */
+# define socklen_t	 int
+static WSADATA wsa;
+#else
+# include <errno.h>
+# include <fcntl.h>
+# include <sys/socket.h>
+# include <sys/time.h>
+# include <netinet/in.h>
+# include <netdb.h>
+# include <signal.h>
+# define closesocket     close
+# define INVALID_SOCKET    (-1)
+# define SOCKET_ERROR      (-1)
+# ifndef h_addr
+#  define h_addr  h_addr_list[ 0 ]
+# endif
+#endif
+
+
+#define C_DEBUG_PROTOCOL_VERSION         0
+
+#define C_DEBUG_REPLY_UNUSED             0
+#define C_DEBUG_REPLY_SETMASK            1
+#define C_DEBUG_REPLY_TERMINATE          2
+#define C_DEBUG_REPLY_CONTINUE           3
+#define C_DEBUG_REPLY_SET_BREAKPOINT     4
+#define C_DEBUG_REPLY_CLEAR_BREAKPOINT   5
+#define C_DEBUG_REPLY_LIST_EVENTS        6
+#define C_DEBUG_REPLY_GET_BYTES          7
+#define C_DEBUG_REPLY_GET_AV             8
+#define C_DEBUG_REPLY_GET_SLOTS          9
+#define C_DEBUG_REPLY_GET_GLOBAL         10
+#define C_DEBUG_REPLY_GET_STATS          11
+#define C_DEBUG_REPLY_GET_TRACE          12
+
+#define INPUT_BUFFER_SIZE         4096
+#define RW_BUFFER_SIZE            1024
+#define DEFAULT_DEBUGGER_PORT     9999
+
+#ifdef C_SIXTY_FOUR
+# define C_HEADER_BITS_SHIFT      56
+#else
+# define C_HEADER_BITS_SHIFT      24
+#endif
+
+#define C_VALUE_CUTOFF_LIMIT      300
+
+
+struct bp_item {
+  char *name;
+  int len;
+  struct bp_item *next;
+};
+
+struct dbg_info_list {
+  C_DEBUG_INFO *info;
+  struct dbg_info_list *next;
+};
+
+
+static long event_mask = 0;
+static int socket_fd = 0;
+static char input_buffer[ INPUT_BUFFER_SIZE + 1 ];
+static char *input_buffer_top = NULL;
+static int input_buffer_len = 0;
+static char rw_buffer[ RW_BUFFER_SIZE + 1 ];
+static struct bp_item *breakpoints = NULL;
+static struct dbg_info_list
+    *dbg_info_list = NULL, 
+    *last_dbg_info_list = NULL,
+    *unseen_dbg_info_list = NULL;
+static C_word current_c = 0;
+static C_word *current_av;
+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);
+
+
+void 
+C_register_debug_info(C_DEBUG_INFO *info)
+{
+  struct dbg_info_list *node =
+    (struct dbg_info_list *)C_malloc(sizeof(struct dbg_info_list));
+
+  /* fprintf(stderr, "Registering: %p (%s/%s)\n", node, info->loc, info->val); */
+  assert(node);  
+  node->info = info;
+  node->next = NULL;
+
+  if(last_dbg_info_list != NULL) last_dbg_info_list->next = node;
+
+  last_dbg_info_list = node;
+
+  if(unseen_dbg_info_list == NULL) unseen_dbg_info_list = node;
+
+  if(dbg_info_list == NULL) dbg_info_list = node;
+
+  /* fprintf(stderr, "first: %p, last: %p, unseen: %p\n", dbg_info_list, last_dbg_info_list, unseen_dbg_info_list); */
+}
+
+
+static int 
+socket_read()
+{
+  int p = 0, s = 0, e = 0;
+  int n, off = 0;
+  char *ptr = rw_buffer;
+
+  /* copy from input_buffer into rw_buffer until newline: */
+  for(;;) {
+    while(input_buffer_len > 0) {
+      *(ptr++) = *input_buffer_top;
+
+      if(*(input_buffer_top++) == '\n') {
+        *ptr = '\0';
+        --input_buffer_len;
+        return 0;
+      }
+
+      if(++off >= RW_BUFFER_SIZE) return -1; /* read-buffer overflow */
+
+      --input_buffer_len;
+    }
+  
+    n = recv(socket_fd, input_buffer, INPUT_BUFFER_SIZE, 0);
+
+    if(n == SOCKET_ERROR) return -1; /* read failed */
+
+    input_buffer_len = n;
+    input_buffer_top = input_buffer;
+  }
+}
+
+
+static int 
+socket_write(char *buf, int len)
+{
+  int n, m = 0, off = 0;
+
+  while(m < len) {
+    n = send(socket_fd, buf + off, len, 0);
+
+    if(n == SOCKET_ERROR) return -1; /* write failed */
+  
+    off += n;
+    m += n;
+  }
+
+  return 0;
+}
+
+
+static void 
+socket_close()
+{
+  closesocket(socket_fd);
+  socket_fd = 0;
+}
+
+
+static void 
+terminate(char *msg)
+{
+  fprintf(stderr, "%s\n", msg);
+  socket_close();
+  _exit(1);
+}
+
+
+static char *
+name_and_length(char *buf, int *len) 
+{
+    char *str, *ptr;
+
+    for(str = buf; *str && *str != '\"'; ++str);
+
+    if(!*str) return "";
+
+    for(ptr = ++str; *ptr != '\"'; ++ptr) {
+        if(*ptr == '\\') ++ptr;
+    }        
+
+    *len = ptr - str;
+    return str;
+}
+
+
+static void 
+enable_debug_info(int n, int f)
+{
+    int i = 0;
+    struct dbg_info_list *dip;
+    C_DEBUG_INFO *dinfo;
+
+    for(dip = dbg_info_list; dip != NULL; dip = dip->next) {
+        for(dinfo = dip->info; dinfo->loc != NULL; ++dinfo) {
+            if(i++ == n) {
+                dinfo->enabled = f;
+                return;
+            }
+        }
+    }
+
+    terminate("invalid debug-info index");
+}
+
+
+static void 
+send_string(char *str)
+{   
+  /* fprintf(stderr, "<SENT: %s>\n", str); */
+  C_fflush(stderr);
+
+  if(socket_write(str, C_strlen(str)) != 0)
+    terminate("write failed");
+}
+
+
+static void 
+send_value(C_word x)
+{
+  if((x & C_FIXNUM_BIT) != 0)
+    sprintf(rw_buffer, " %ld", (long)C_unfix(x));
+  else if((x & C_IMMEDIATE_MARK_BITS) != 0)
+    sprintf(rw_buffer, " =%lu", (unsigned long)x);
+  else sprintf(rw_buffer, " @%lu", (unsigned long)x);
+
+  send_string(rw_buffer);
+}
+
+
+static void 
+send_event(int event, C_char *loc, C_char *val, C_char *cloc, int cln)
+{
+  int n;
+  int reply, mask;
+  struct bp_item *bp, *prev;
+  C_char *str, *ptr;
+  struct dbg_info_list *dip;
+  C_DEBUG_INFO *dinfo;
+  C_word x;
+  void **stats;
+
+  for(;;) {
+    n = sprintf(rw_buffer, "(%d \"%s\" \"%s\" \"%s:%d\")\n", event, loc, val, cloc, 
+            cln);
+    send_string(rw_buffer);
+    
+    if(socket_read() < 0) terminate("read failed");
+
+    /* fprintf(stderr, "<READ: %s>\n", rw_buffer); */    
+    n = sscanf(rw_buffer, "(%d ", &reply);
+    
+    if(n == 0) terminate("invalid reply");
+    
+    switch(reply) {
+    case C_DEBUG_REPLY_SETMASK:
+      n = sscanf(rw_buffer, "(%d %d)", &reply, &mask);
+
+      if(n != 2) terminate("invalid SETMASK reply");
+
+      event_mask = mask;
+      break;
+
+    case C_DEBUG_REPLY_TERMINATE:
+      terminate("terminated by debugger");
+
+    case C_DEBUG_REPLY_CONTINUE:
+      return;
+
+    case C_DEBUG_REPLY_SET_BREAKPOINT:
+      n = sscanf(rw_buffer, "(%d %d)", &reply, &mask);
+
+      if(n != 2) terminate("invalid SET BREAKPOINT reply");
+
+      enable_debug_info(mask, 1);
+      break;
+
+    case C_DEBUG_REPLY_CLEAR_BREAKPOINT:
+      n = sscanf(rw_buffer, "(%d %d)", &reply, &mask);
+
+      if(n != 2) terminate("invalid CLEAR BREAKPOINT reply");
+
+      enable_debug_info(mask, 0);
+      break;      
+
+    case C_DEBUG_REPLY_LIST_EVENTS:
+      str = name_and_length(rw_buffer, &n);
+      str[ n ] = '\0';
+      str = C_strdup(str);
+
+      for(dip = unseen_dbg_info_list; dip != NULL; dip = dip->next) {
+          for(dinfo = dip->info; dinfo->loc != NULL; ++dinfo) {
+              if(*str == '\0' || strstr(dinfo->val, str)) {
+                  sprintf(rw_buffer, "(* %d %d \"%s\" \"%s\")\n", dbg_info_count++, 
+                    dinfo->event, dinfo->loc, dinfo->val);
+                  send_string(rw_buffer);
+              }
+
+              ++n;
+          }
+      }
+
+      unseen_dbg_info_list = NULL;
+      C_free(str);
+      break;
+
+    case C_DEBUG_REPLY_GET_BYTES:
+      n = sscanf(rw_buffer, "(%d %lu %d)", &reply, &x, &mask);
+
+      if(n != 3) terminate("invalid GET_BYTES reply");
+
+      ptr = (char *)x;
+      
+      send_string("(*");
+                          
+      while(mask--) {
+        sprintf(rw_buffer, " %d", *(ptr++));
+        send_string(rw_buffer);
+      }
+
+      send_string(")\n");
+      break;
+
+    case C_DEBUG_REPLY_GET_AV:
+      send_string("(*");
+
+      for(n = 0; n < current_c; ++n)
+        send_value(current_av[ n ]);
+
+      send_string(")\n");
+      break;
+
+    case C_DEBUG_REPLY_GET_SLOTS:
+      sscanf(rw_buffer, "(%d %ld)", &mask, &x);
+
+      if(mask >= C_VALUE_CUTOFF_LIMIT)
+        mask = C_VALUE_CUTOFF_LIMIT;
+      
+      if((C_header_bits(x) & C_BYTEBLOCK_BIT) != 0) {
+        reply = C_header_size(x);
+        sprintf(rw_buffer, "(* BLOB %ld", C_header_bits(x) >> C_HEADER_BITS_SHIFT);
+        send_string(rw_buffer);
+
+        for(n = 0; n < reply; ++n) {
+          sprintf(rw_buffer, " %lu", (unsigned long)((char *)C_data_pointer(x))[ n ]);
+          send_string(rw_buffer);
+        }
+
+        send_string(")\n");
+        break;
+      }
+
+      n = 0;
+
+      if((C_header_bits(x) & C_SPECIALBLOCK_BIT) != 0) {
+        sprintf(rw_buffer, "(* SPECIAL %ld %lu", C_header_bits(x) >> C_HEADER_BITS_SHIFT,
+          C_block_item(x, 0));
+        n = 1;
+      }
+      else sprintf(rw_buffer, "(* VECTOR %ld", C_header_bits(x) >> C_HEADER_BITS_SHIFT);
+
+      send_string(rw_buffer);
+
+      for(mask = C_header_size(x); n < mask; ++n)
+        send_value(C_block_item(x, n));
+
+      send_string(")\n");
+      break;
+
+    case C_DEBUG_REPLY_GET_GLOBAL:
+      str = name_and_length(rw_buffer, &n);
+      ptr = malloc(sizeof(C_header) + n + 1);
+      memcpy(((C_SCHEME_BLOCK*)ptr)->data, str, n + 1);
+      ((C_SCHEME_BLOCK *)ptr)->header = C_make_header(C_STRING_TYPE, n);
+      x = C_find_symbol((C_word)ptr, NULL);
+
+      if(x == C_SCHEME_FALSE) 
+        send_string("(* UNKNOWN)\n");
+      else {
+        send_string("(*");
+        send_value(C_symbol_value(x));
+        send_string(")\n");
+      }
+
+      break;
+
+    case C_DEBUG_REPLY_GET_STATS:
+      stats = C_get_statistics();
+      send_string("(*");
+    
+      for(n = 0; n < 8; ++n) {
+        sprintf(rw_buffer, " %lu", (unsigned long)stats[ n ]);
+        send_string(rw_buffer);
+      }
+
+      sprintf(rw_buffer, " %lu)\n", (unsigned long)C_stack_pointer);
+      send_string(rw_buffer);
+      break;
+
+    case C_DEBUG_REPLY_GET_TRACE:
+      str = C_dump_trace(0);
+      strcpy(rw_buffer, "(* \"");
+      ptr = rw_buffer + 4;
+
+      while(*str != '\0') {
+        if(*str == '\n') {
+          strcpy(ptr, "\")\n");
+          ptr[ 4 ] = '\0';
+          send_string(rw_buffer);
+          strcpy(rw_buffer, "(* \"");
+          ptr = rw_buffer + 4;
+          ++str;
+        } 
+        else *(ptr++) = *(str++);
+      }
+
+      strcpy(ptr, "\")\n");
+      ptr[ 4 ] = '\0';
+      send_string(rw_buffer);
+      break;
+
+    default: terminate("invalid reply code");
+    }
+
+    event = C_DEBUG_LISTEN;
+    val = unseen_dbg_info_list ? "1" : "0";
+  }
+}
+
+
+#ifndef _WIN32
+static void
+interrupt_signal_handler(int signum) 
+{
+    interrupted = 1;
+    C_signal(SIGUSR2, interrupt_signal_handler);
+}
+#endif
+
+
+static C_word 
+connect_to_debugger()
+{
+  char *addr = getenv("CHICKEN_DEBUGGER");
+  char *host;
+  static char info[ 256 ];
+  struct hostent *he;
+  struct sockaddr_in sa;
+  int i, port;
+  int yes = 1; 
+  int r;
+
+  C_debugger_hook = debug_event_hook;
+
+  if(addr == NULL) return C_SCHEME_FALSE;      /* no debugger address given */
+
+  /* parse host and port number */
+  for(i = C_strlen(addr) - 1; i >= 0; --i) {
+    if(addr[ i ] == ':') break;
+  }
+
+  if(i == 0) host = addr;
+  else {
+    port = atoi(addr + i + 1);
+    host = strndup(addr, i);
+  }
+
+#ifdef _WIN32
+  if(WSAStartup(MAKEWORD(1, 1), &wsa) != 0) 
+    return C_SCHEME_FALSE; /* failed to init sockets */
+#endif
+
+  /* obtain host address */
+  he = gethostbyname(host);
+  
+  if(he == NULL) return C_SCHEME_FALSE;        /* invalid host */
+
+  C_memset(&sa, 0, sizeof(struct sockaddr_in));
+  sa.sin_family = AF_INET;
+  sa.sin_port = htons((short)port);
+  sa.sin_addr = *((struct in_addr *)he->h_addr);
+  socket_fd = socket(AF_INET, SOCK_STREAM, 0);
+
+  if(socket_fd == INVALID_SOCKET) 
+    return C_SCHEME_FALSE; /* can not create socket */
+
+  /* socket options */
+  r = setsockopt(socket_fd, SOL_SOCKET, SO_REUSEADDR, (const char *)&yes, sizeof(int));
+  
+  if(r != 0) return C_SCHEME_FALSE;            /* failed to set socket options */
+
+  /* connect */
+  if(connect(socket_fd, (struct sockaddr *)&sa, sizeof(struct sockaddr_in)) == SOCKET_ERROR) 
+    return C_SCHEME_FALSE;                     /* failed to connect */
+
+  sprintf(info, "%s:%d:%d", C_main_argv[ 0 ], getpid(), C_DEBUG_PROTOCOL_VERSION);
+  send_event(C_DEBUG_CONNECT, info, "", "", 0);  
+#ifndef _WIN32
+  C_signal(SIGUSR2, interrupt_signal_handler);
+#endif
+  return C_SCHEME_TRUE;
+}
+
+
+static C_word 
+debug_event_hook(C_DEBUG_INFO *cell, C_word c, C_word *av, char *cloc, int cln)
+{
+  if(socket_fd != 0) {
+    if(cell->enabled || interrupted || ((1 << cell->event) & event_mask) != 0 ) {
+      /* fprintf(stderr, "event: %s:%d\n", cloc, cln); */
+      current_c = c;
+      current_av = av;
+      send_event(interrupted ? C_DEBUG_INTERRUPTED : cell->event, cell->loc, 
+        cell->val, cloc, cln);
+      interrupted = 0;
+    } 
+  }
+
+  if(cell->event == C_DEBUG_CALL) C_trace(cell->val);
+
+  return C_SCHEME_UNDEFINED;
+}
+
+
+/* TODO:
+
+    - escape '\"' + '\\' in transmitted strings
+    - error-condition (SIGNAL event) doesn't seem to terminate
+
+*/
diff --git a/debugger-client.scm b/debugger-client.scm
new file mode 100644
index 0000000..bb83f16
--- /dev/null
+++ b/debugger-client.scm
@@ -0,0 +1,32 @@
+;;;; debugger-client.scm - client-side support for debugging
+;
+; Copyright (c) 2014, The CHICKEN Team
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+;     disclaimer. 
+;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+;     disclaimer in the documentation and/or other materials provided with the distribution. 
+;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
+;     products derived from this software without specific prior written permission. 
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+
+(declare
+  (unit debugger-client)
+  (disable-interrupts)
+  (foreign-declare "#include \"dbg-stub.c\""))
+
+(##core#inline "connect_to_debugger")
diff --git a/defaults.make b/defaults.make
index ca0cda9..e9e259e 100644
--- a/defaults.make
+++ b/defaults.make
@@ -197,6 +197,7 @@ LIBCHICKEN_SO_LIBRARIES ?= $(LIBRARIES)
 
 ifdef WINDOWS_SHELL
 BUILD_TIME ?= $(shell date /t)
+SCRIPT_EXT = .bat
 COPY_COMMAND = copy /Y
 HOSTNAME ?= $(shell hostname)
 UNAME_SYS ?= Windows
@@ -206,10 +207,13 @@ BUILD_TAG ?= compiled $(BUILD_TIME) on $(HOSTNAME) ($(UNAME_SYS))
 # that systems (Debian, OS X, Haiku, Mingw, Cygwin) are shipping it
 echo = echo $(3)$(1)$(2)
 else
+SCRIPT_EXT =
 COPY_COMMAND = cp
 echo = echo '$(subst ','\'',$(3))'$(1)$(2)
 #' fix Emacs syntax highlighting
 endif
+GENERATE_DEBUGGER ?= cat $< >$@; echo 'exec $$wish "$(DATADIR)/feathers.tcl" -- "$$@"' >>$@
+
 
 # file extensions
 
@@ -236,7 +240,7 @@ CSI ?= csi$(EXE)
 
 CHICKEN_OPTIONS = -optimize-level 2 -include-path . -include-path $(SRCDIR) -inline -ignore-repository -feature chicken-bootstrap
 ifdef DEBUGBUILD
-CHICKEN_OPTIONS += -feature debugbuild -verbose
+CHICKEN_OPTIONS += -feature debugbuild -verbose -debug-info
 else
 CHICKEN_OPTIONS += -no-warnings
 endif
@@ -267,6 +271,7 @@ CHICKEN_INSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-install$(PROGRAM_SUFFIX)
 CHICKEN_UNINSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-uninstall$(PROGRAM_SUFFIX)
 CHICKEN_STATUS_PROGRAM = $(PROGRAM_PREFIX)chicken-status$(PROGRAM_SUFFIX)
 CHICKEN_BUG_PROGRAM = $(PROGRAM_PREFIX)chicken-bug$(PROGRAM_SUFFIX)
+CHICKEN_DEBUGGER_PROGRAM ?= $(PROGRAM_PREFIX)feathers$(PROGRAM_SUFFIX)$(SCRIPT_EXT)
 IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix srfi-13 srfi-69 extras srfi-14 tcp foreign srfi-18 utils csi irregex
 IMPORT_LIBRARIES += setup-api setup-download
 
@@ -279,7 +284,7 @@ TARGETLIBS ?= lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX)$(A)
 TARGETS += $(TARGETLIBS) $(CHICKEN_STATIC_EXECUTABLE) \
 	$(CSI_STATIC_EXECUTABLE) $(CHICKEN_PROFILE_PROGRAM)$(EXE) \
 	$(CSC_PROGRAM)$(EXE) \
-	$(CHICKEN_BUG_PROGRAM)$(EXE)
+	$(CHICKEN_BUG_PROGRAM)$(EXE) $(CHICKEN_DEBUGGER_PROGRAM)
 else
 CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)-static$(EXE)
 CSI_STATIC_EXECUTABLE = $(CSI_PROGRAM)-static$(EXE)
@@ -290,13 +295,14 @@ TARGETS += $(TARGETLIBS) $(CHICKEN_SHARED_EXECUTABLE) \
 	$(CSI_SHARED_EXECUTABLE) $(CHICKEN_PROFILE_PROGRAM)$(EXE) \
 	$(CSC_PROGRAM)$(EXE) $(CHICKEN_INSTALL_PROGRAM)$(EXE) $(CHICKEN_UNINSTALL_PROGRAM)$(EXE) \
 	$(CHICKEN_STATUS_PROGRAM)$(EXE) setup-download.so setup-api.so \
-	$(CHICKEN_BUG_PROGRAM)$(EXE) \
+	$(CHICKEN_BUG_PROGRAM)$(EXE) $(CHICKEN_DEBUGGER_PROGRAM) \
 	$(IMPORT_LIBRARIES:%=%.import.so)
 endif
 ifdef WINDOWS
 TARGETS += chicken.rc$(O)
 endif
 
+
 # main rule
 
 .PHONY: all
diff --git a/feathers.bat.in b/feathers.bat.in
new file mode 100644
index 0000000..093cf70
--- /dev/null
+++ b/feathers.bat.in
@@ -0,0 +1,26 @@
address@hidden off
+
+rem loader for feathers.tcl, the CHICKEN debugger
+rem
+rem Copyright (c) 2015, The CHICKEN Team
+rem All rights reserved.
+rem
+rem Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+rem conditions are met:
+rem
+rem   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+rem     disclaimer. 
+rem   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+rem     disclaimer in the documentation and/or other materials provided with the distribution. 
+rem   Neither the name of the author nor the names of its contributors may be used to endorse or promote
+rem     products derived from this software without specific prior written permission. 
+rem
+rem THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+rem OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+rem AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+rem CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+rem CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+rem SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+rem THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+rem OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+rem POSSIBILITY OF SUCH DAMAGE.
diff --git a/feathers.in b/feathers.in
new file mode 100644
index 0000000..407e6f1
--- /dev/null
+++ b/feathers.in
@@ -0,0 +1,38 @@
+#!/bin/sh
+#
+# loader for feathers.tcl, the CHICKEN debugger
+#
+# Copyright (c) 2015, The CHICKEN Team
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+# conditions are met:
+#
+#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+#     disclaimer. 
+#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+#     disclaimer in the documentation and/or other materials provided with the distribution. 
+#   Neither the name of the author nor the names of its contributors may be used to endorse or promote
+#     products derived from this software without specific prior written permission. 
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+wish=`which wish8.5`
+
+if test \! -x "$wish"; then
+    wish=`which wish`
+fi
+
+if test \! -x "$wish"; then
+    echo 'no "wish" executable found - please put "wish8.5" or "wish" in your PATH' \
+        1>&2
+    exit 1
+fi
diff --git a/feathers.tcl b/feathers.tcl
new file mode 100755
index 0000000..6ff3aeb
--- /dev/null
+++ b/feathers.tcl
@@ -0,0 +1,1892 @@
+#!/usr/bin/env wish
+#
+# a graphical debugger for compiled CHICKEN programs
+#
+# Copyright (c) 2015, The CHICKEN Team
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+# conditions are met:
+#
+#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+#     disclaimer. 
+#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+#     disclaimer in the documentation and/or other materials provided with the distribution. 
+#   Neither the name of the author nor the names of its contributors may be used to endorse or promote
+#     products derived from this software without specific prior written permission. 
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+
+set version 0
+set protocol_version 0
+set debugger_port 9999
+
+set events(0) call
+set events(1) assign
+set events(2) gc
+set events(3) entry
+set events(4) signal
+set events(5) connect
+set events(6) listen
+set events(7) interrupted
+
+set reply(UNUSED) 0
+set reply(SETMASK) 1
+set reply(TERMINATE) 2
+set reply(CONTINUE) 3
+set reply(SET_BREAKPOINT) 4
+set reply(CLEAR_BREAKPOINT) 5
+set reply(LIST_EVENTS) 6
+set reply(GET_BYTES) 7
+set reply(GET_AV) 8
+set reply(GET_SLOTS) 9
+set reply(GET_GLOBAL) 10
+set reply(GET_STATS) 11
+set reply(GET_TRACE) 12
+
+set colors(header_foreground) white
+set colors(header_background) black
+set colors(text_foreground) gray90
+set colors(text_background) "#102e4e"
+set colors(event_foreground) white
+set colors(event_background) "#203e5e"
+set colors(breakpoint_foreground) white
+set colors(breakpoint_background) DarkRed
+set colors(highlight_foreground) white
+set colors(highlight_background) blue
+set colors(mark_foreground) black
+set colors(mark_background) yellow
+set colors(trace_background) gray90
+set colors(trace_foreground) black
+
+set typecode(0) VECTOR
+set typecode(1) SYMBOL
+set typecode(66) STRING
+set typecode(3) PAIR
+set typecode(36) CLOSURE
+set typecode(85) FLONUM
+set typecode(39) PORT
+set typecode(8) STRUCTURE
+set typecode(41) POINTER
+set typecode(42) LOCATIVE
+set typecode(43) TAGGED_POINTER
+set typecode(77) LAMBDA_INFO
+set typecode(15) BUCKET
+
+set EXEC_EVENT_MASK 16; # signal
+set STEP_EVENT_MASK 27; # call, entry, assign, signal
+
+set membar_height 50
+set value_cutoff_limit 200; # must be lower than limit in dbg-stub.c
+
+set the_name "feathers"
+set header_text "$the_name - (c)MMXV The CHICKEN Team - Version $version"
+set startup_file ".$the_name"
+
+set client_addr ""
+set client_file ""
+set current_filename ""
+set current_c_filename ""
+set file_list {}
+set bp_queue {}
+set watched_queue {}
+set value_queue {}
+set current_line ""
+set current_c_line ""
+set current_bp_lines {}
+set current_bp_globals {}
+set font_name "Courier"
+set font_size 11
+set program_name ""
+set search_path {"."}
+set data_view ""
+set c_view ""
+set data_queue {}
+set reply_queue {}
+set starting_up 1
+set stepping 0
+set terminated 0
+set arguments_item_id ""
+set watched_variables {}
+set current_variable ""
+set current_value ""
+set listening 0
+set process_id 0
+set statistics_data ""
+set mark_start_index(.t) ""
+set mark_start_index(.code.t) ""
+set current_c_location ""
+set last_marked_widget .t
+set selected_filename ""
+set trace_data ""
+set last_location ""
+set logging 0
+
+set env(CHICKEN_DEBUGGER) "localhost:9999"
+
+
+proc Log {msg} {
+    global logging
+
+    if {$logging} {puts stderr $msg}
+}
+
+
+proc SetupGUI {} {
+    global font_name font_size colors the_name selected_filename
+    label .h -height 1 -textvariable header_text -anchor w
+    scrollbar .s -command {.t yview}
+    text .t -wrap char -yscrollcommand {.s set} -cursor arrow -state disabled \
+        -font [list $font_name $font_size]
+    frame .f
+    ttk::combobox .files -postcommand FilesList -textvariable selected_filename
+    pack .h -side top -fill x
+    pack .files -side top -fill x
+    pack .f -side bottom -fill x
+    pack .s -fill y -side right
+    pack .t -fill both -expand 1
+
+    for {set i 1} {$i <= 10} {incr i} {
+        button .f.b$i -text "F$i" -font {Helvetica 10} -borderwidth 0 -relief flat \
+            -pady 0
+        pack .f.b$i -side left -expand 1 -fill x
+    }
+
+    .f.b1 configure -text "F1 Run"
+    .f.b2 configure -text "F2 Where"
+    .f.b3 configure -text "F3 AddDir"
+    .f.b4 configure -text "F4 Data"
+    .f.b5 configure -text "F5 Continue"
+    .f.b6 configure -text "F6 Step"
+    .f.b7 configure -text "F7 Find Prev"
+    .f.b8 configure -text "F8 Find Next"
+    .f.b9 configure -text "F9 C"
+    .f.b10 configure -text "F10 Exit"
+    .h configure -background $colors(header_background) \
+        -foreground $colors(header_foreground) -font {Helvetica 12} \
+        -borderwidth 0
+    .t configure -background $colors(text_background) \
+        -foreground $colors(text_foreground) \
+        -insertbackground $colors(text_foreground) -borderwidth 0
+
+    .t tag configure ev -background $colors(event_background) \
+        -foreground $colors(event_foreground)
+    .t tag configure bp -background $colors(breakpoint_background) \
+        -foreground $colors(breakpoint_foreground)
+    .t tag configure hl -background $colors(highlight_background) \
+        -foreground $colors(highlight_foreground)
+    .t tag configure mk -background $colors(mark_background) \
+        -foreground $colors(mark_foreground)
+    .t tag lower mk sel
+    .t tag lower bp mk
+    .t tag lower hl bp
+    .t tag lower ev hl
+    focus .t
+    wm title . $the_name
+}
+
+
+proc SetupBindings {} {
+    for {set i 1} {$i <= 10} {incr i} {
+        bind . <F$i> [list .f.b$i invoke]
+    }
+
+    .f.b1 configure -command RunProcess 
+    .f.b2 configure -command LocateFocus
+    .f.b3 configure -command AddDirectory
+    .f.b4 configure -command ShowData
+    .f.b5 configure -command ContinueExecution
+    .f.b6 configure -command StepExecution
+    .f.b7 configure -command FindPrevious
+    .f.b8 configure -command FindNext
+    .f.b9 configure -command OpenCView
+    .f.b10 configure -command Terminate
+    bind .t <ButtonPress-1> { focus .t; ToggleBreakpoint %y; break }
+    bind .t <ButtonRelease-1> break
+    bind .t <space> {StepExecution; break}
+    bind .t <Return> {ToggleBreakpoint; break}
+    bind .t <Up> {MoveFocus -1; break}
+    bind .t <Down> {MoveFocus 1; break}
+    bind .t <plus> {ResizeFont 1; break}
+    bind .t <minus> {ResizeFont -1; break}
+    bind .t <Escape> {Interrupt}
+    bind .t <ButtonPress-3> {StartMark %W %x %y; break}
+    bind .t <Motion> {MoveMark %W %x %y; break}
+    bind .t <ButtonRelease-3> {EndMark %W; break}
+    bind .files <<ComboboxSelected>> {SelectFile; focus .t}
+    wm protocol . WM_DELETE_WINDOW Terminate
+}
+
+
+proc SetupDataView {} {
+    global colors arguments_item_id stats membar_height the_name font_name font_size
+    toplevel .data
+    ttk::treeview .data.t -yscrollcommand {.data.s set} -columns {Values Addresses} \
+        -selectmode browse
+    .data.t heading 0 -text Value
+    .data.t heading 1 -text Address
+    scrollbar .data.s -command {.data.t yview}
+    entry .data.e
+    canvas .data.c -height $membar_height
+    frame .data.f
+    text .data.f.tr -state disabled -yscrollcommand {.data.f.trs set} -height 20 \
+        -font [list $font_name $font_size] -foreground $colors(trace_foreground) \
+        -background $colors(trace_background)
+    scrollbar .data.f.trs -command {.data.f.tr yview}
+    pack .data.f -side bottom -fill x
+    pack .data.c -side bottom -fill x
+    pack .data.e -side bottom -fill x
+    pack .data.s -fill y -side right
+    pack .data.t -fill both -expand 1
+    pack .data.f.trs -fill y -side right
+    pack .data.f.tr -side bottom -fill both -expand 1
+    .data.t tag configure watched -foreground $colors(breakpoint_foreground) \
+        -background $colors(breakpoint_background)
+    set arguments_item_id [.data.t insert {} end -text "<arguments>"]
+    set stats(fromspace_used) [.data.c create rectangle 0 0 0 0 -fill gray80]
+    set stats(fromspace_unused) [.data.c create rectangle 0 0 0 0 -fill gray40]
+    set stats(scratchspace_used) [.data.c create rectangle 0 0 0 0 -fill gray80]
+    set stats(scratchspace_unused) [.data.c create rectangle 0 0 0 0 -fill gray40]
+    set stats(nursery_used) [.data.c create rectangle 0 0 0 0 -fill gray80]
+    set stats(nursery_unused) [.data.c create rectangle 0 0 0 0 -fill gray40]
+    set mh [expr $membar_height / 3]
+    set stats(fromspace_name) [.data.c create text 10 0 -anchor nw -text "heap"]
+    set stats(scratchspace_name) [.data.c create text 10 $mh -anchor nw -text \
+        "scratch"]
+    set stats(nursery_name) [.data.c create text 10 [expr $mh * 2] -anchor nw \
+        -text "nursery"]
+    set stats(fromspace_percentage) [.data.c create text 0 0 -anchor center]
+    set stats(scratchspace_percentage) [.data.c create text 0 0 -anchor center]
+    set stats(nursery_percentage) [.data.c create text 0 0 -anchor center]
+    set stats(fromspace_size) [.data.c create text 0 0 -anchor ne]
+    set stats(scratchspace_size) [.data.c create text 0 0 -anchor ne]
+    set stats(nursery_size) [.data.c create text 0 0 -anchor ne]
+    wm title .data "$the_name - data view"
+}
+
+
+proc SetupDataViewBindings {} {
+    bind .data <F3> AddDirectory
+    bind .data <F4> ShowData
+    bind .data <F5> ContinueExecution
+    bind .data <F6> StepExecution
+    bind .data <F10> Terminate
+    bind .data.e <Return> {WatchGlobal; break}
+    bind .data.t <BackSpace> {RemoveGlobal; break}
+    bind .data.t <Delete> {RemoveGlobal; break}
+    bind .data.t <<TreeviewOpen>> OpenDataItem
+    bind .data.t <Return> {ToggleVariableWatch; break}
+    bind .data.t <Double-Button-1> {ToggleVariableWatch %x %y; break}
+    bind .data.t <<TreeviewSelect>> {Log [.data.t focus]; break}
+    bind .data.c <Configure> {RedrawStatistics}
+    wm protocol .data WM_DELETE_WINDOW CloseDataView
+}
+
+
+proc SetupCView {} {
+    global font_name font_size colors the_name
+    toplevel .code
+    label .code.h -height 1 -text "" -anchor w
+    scrollbar .code.s -command {.code.t yview}
+    text .code.t -wrap char -yscrollcommand {.code.s set} -cursor arrow -state \
+        disabled -font [list $font_name $font_size]
+    frame .code.f
+    pack .code.h -side top -fill x
+    pack .code.s -fill y -side right
+    pack .code.f -fill x -side bottom
+    pack .code.t -fill both -expand 1
+    .code.h configure -background $colors(header_background) \
+        -foreground $colors(header_foreground) -font {Helvetica 12} \
+        -borderwidth 0
+    .code.t configure -background $colors(text_background) \
+        -foreground $colors(text_foreground) \
+        -insertbackground $colors(text_foreground) -borderwidth 0
+    .code.t tag configure hl -background $colors(highlight_background) \
+        -foreground $colors(highlight_foreground)
+    .code.t tag configure mk -background $colors(mark_background) \
+        -foreground $colors(mark_foreground)
+    .code.t tag lower mk sel
+    .code.t tag lower hl mk
+    wm title .code "$the_name - code view"
+    focus .code.t
+}
+
+
+proc SetupCViewBindings {} {
+    bind .code <F3> AddDirectory
+    bind .code <F4> ShowData
+    bind .code <F5> ContinueExecution
+    bind .code <F6> StepExecution
+    bind .code <F7> {FindPrevious .code.t}
+    bind .code <F8> {FindNext .code.t}
+    bind .code <F10> Terminate
+    bind .code.t <ButtonPress-1> {focus .code.t}
+    bind .code.t <ButtonRelease-1> break
+    bind .code <plus> {ResizeFont 1; break}
+    bind .code <minus> {ResizeFont -1; break}
+    bind .code.t <ButtonPress-3> {StartMark %W %x %y; break}
+    bind .code.t <Motion> {MoveMark %W %x %y; break}
+    bind .code.t <ButtonRelease-3> {EndMark %W; break}
+    wm protocol .code WM_DELETE_WINDOW CloseCView
+}
+
+
+proc FilesList {} {
+    global file_list
+    .files configure -values $file_list
+}
+
+
+proc CloseDataView {} {
+    global data_view
+
+    if {$data_view != ""} {
+        set data_view ""
+        destroy .data
+    }
+}
+
+
+proc CloseCView {} {
+    global c_view
+
+    if {$c_view != ""} {
+        set c_view ""
+        destroy .code
+    }
+}
+
+
+proc ShowData {} {
+    global data_view starting_up client_file program_name the_name
+
+    if {$data_view == ""} {
+        SetupDataView
+        SetupDataViewBindings
+        set data_view .data
+        wm title .data "$the_name - $program_name - data view"
+
+        if {!$starting_up && $client_file != ""} UpdateData
+    }
+}
+
+
+proc OpenCView {} {
+    global c_view starting_up current_c_location the_name program_name
+
+    if {$c_view == ""} {
+        SetupCView
+        SetupCViewBindings
+        set c_view .code
+        wm title .code "$the_name - $program_name - code view"
+
+        Log "$current_c_location"
+
+        if {$current_c_location != ""} {
+            LocateCSource $current_c_location
+        }
+    }
+}
+
+
+proc AddDirectory {} {
+    global search_path current_filename
+    set dir "."
+
+    if {$current_filename != ""} {
+        set dir [file dirname $current_filename]
+    }
+    
+    set dir [tk_chooseDirectory -title "Select directory to add to search path" \
+        -initialdir $dir]
+
+    if {$dir != ""} {
+        lappend search_path $dir
+    }
+}
+
+
+proc ResizeFont {n} {
+    global font_size font_name c_view
+    incr font_size $n
+    .t configure -font [list $font_name $font_size]
+
+    if {$c_view != ""} {
+        .code.t configure -font [list $font_name $font_size]
+    }
+}
+
+
+proc Flash {{color red}} {
+    global colors
+    .t configure -background $color
+    update
+    after 100 {.t configure -background $colors(text_background)}
+}
+
+
+proc CheckListening {} {
+    global listening
+
+    if {!$listening} {
+        Flash
+        return 0
+    }
+
+    return 1
+}
+
+
+proc MoveFocus {amount} {
+    global current_line
+    set ln [expr $current_line + $amount]
+    SetFocus $ln
+}
+
+
+proc LocateFocus {} {
+    global last_location
+
+    if {$last_location != ""} {
+        SetFocus $last_location
+    }
+}
+
+
+proc SetFocus {line} {
+    global current_line
+
+    if {$line > 0 && $line <= [.t count -lines 1.0 end]} {
+        set old [.t tag ranges hl]
+    
+        if {$old != ""} {
+            eval .t tag remove hl $old
+        }
+
+        set current_line $line
+        .t tag add hl $line.0 "$line.0 lineend + 1 chars"
+        .t see $line.0
+    }
+}
+
+
+proc SetCFocus {line} { 
+    global current_c_line
+
+    if {$line > 0 && $line <= [.code.t count -lines 1.0 end]} {
+        set old [.code.t tag ranges hl]
+    
+        if {$old != ""} {
+            eval .code.t tag remove hl $old
+        }
+
+        set current_c_line $line
+        .code.t tag add hl $line.0 "$line.0 lineend + 1 chars"
+        .code.t see $line.0
+    }
+}
+
+
+proc Interrupt {} {
+    global process_id listening
+
+    if {$listening || $process_id == 0} return
+
+    catch {exec kill -USR2 $process_id}
+}
+
+
+proc ToggleBreakpoint {{y ""}} {
+    global current_filename bp_queue current_bp_lines
+    global current_line client_file reply_queue
+
+    if {$client_file == ""} return
+
+    if {$y != ""} {
+        if {[catch {set p [.t index @1,$y]}]} return
+
+        if {![regexp {^(\d+)\.} $p _ line]} return
+    } else {
+        set line $current_line
+    }
+
+    set aname "file:$current_filename"
+    global $aname
+    set aref "$aname\($line\)"
+
+    if {![CheckListening]} return
+
+    if {[info exists $aref]} {
+        set bps [set $aref]
+
+        if {$bps != ""} {
+            set bp1 [lindex $bps 0]
+            set bprest [lrange $bps 1 end]
+            set bp_queue [concat $bp_queue $bprest]
+
+            if {[lsearch -exact $current_bp_lines $line] != -1} {
+                UnmarkBP $line
+                SendReply CLEAR_BREAKPOINT $bp1
+                lappend reply_queue RemoveBPReply
+            } else {
+                MarkBP $line
+                SendReply SET_BREAKPOINT $bp1
+                lappend reply_queue AddBPReply
+            }
+        }
+    }
+}
+
+
+proc ToggleVariableWatch {{x ""} {y ""}} {
+    global globals current_bp_globals bp_queue
+
+    if {![CheckListening]} return
+
+    if {$x == ""} {
+        set item [.data.t focus]
+    } else {
+        if {[catch {.data.t identify item $x $y} item]} return
+    }
+
+    if {$item == ""} return
+
+    if {[.data.t parent $item] != ""} return
+
+    set name [.data.t item $item -text]
+
+    if {$name == "<arguments>"} return
+
+    if {![info exists globals($name)]} return
+
+    Log "globals: $name -> $globals($name)"
+
+    set bps $globals($name)
+
+    if {$bps != ""} {
+        set bp1 [lindex $bps 0]
+        set bprest [lrange $bps 1 end]
+        set bp_queue [concat $bp_queue $bprest]
+
+        if {[lsearch -exact $current_bp_globals $item] != -1} {
+            UnmarkWatchedVariable $item
+            SendReply CLEAR_BREAKPOINT $bp1
+            lappend reply_queue RemoveBPReply
+        } else {
+            MarkWatchedVariable $item
+            SendReply SET_BREAKPOINT $bp1
+            lappend reply_queue AddBPReply
+        }
+    }
+}
+
+
+proc AddBPReply {} {
+    global bp_queue reply_queue
+    
+    if {$bp_queue != ""} {
+        set bp1 [lindex $bp_queue 0]
+        set bp_queue [lrange $bp_queue 1 end]
+        SendReply SET_BREAKPOINT $bp1
+
+        if {$bp_queue != ""} {
+            lappend reply_queue AddBPReply
+        }
+    }
+}
+
+
+proc RemoveBPReply {} {
+    global bp_queue reply_queue
+    
+    if {$bp_queue != ""} {
+        set bp1 [lindex $bp_queue 0]
+        set bp_queue [lrange $bp_queue 1 end]
+        SendReply CLEAR_BREAKPOINT $bp1
+
+        if {$bp_queue != ""} {
+            lappend reply_queue RemoveBPReply
+        }
+    }
+}
+
+
+proc MarkBP {line} {
+    global current_bp_lines
+
+    if {[lsearch -exact $current_bp_lines $line] == -1} {
+        .t tag add bp $line.0 "$line.0 lineend"
+        lappend current_bp_lines $line
+    } 
+}
+
+
+proc UnmarkBP {line} {
+    global current_bp_lines
+    set i [lsearch -exact $current_bp_lines $line]
+
+    if {$i != -1} {
+        set current_bp_lines [lreplace $current_bp_lines $i $i]
+        .t tag remove bp $line.0 "$line.0 lineend"
+    }
+}
+
+
+proc MarkWatchedVariable {item} {
+    global current_bp_globals
+
+    if {[lsearch -exact $current_bp_globals $item] == -1} {
+        .data.t tag add watched $item
+        lappend current_bp_globals $item
+    } 
+}
+
+
+proc UnmarkWatchedVariable {item} {
+    global current_bp_globals
+    set i [lsearch -exact $current_bp_globals $item]
+
+    if {$i != -1} {
+        set current_bp_globals [lreplace $current_bp_globals $i $i]
+        .data.t tag remove watched $item
+    }
+}
+
+
+proc Terminate {} {
+    global client_file process_id
+
+    if {$client_file != ""} {        
+        SendReply TERMINATE
+        set f $client_file
+        set client_file ""
+        close $f
+        catch {exec kill -9 $process_id}
+    }
+
+    exit
+}
+
+
+proc RunProcess {{prg ""}} {
+    global env client_file program_name search_path reply_queue current_filename
+    global data_queue bp_queue starting_up stepping terminated current_bp_lines
+    global terminated watched_variables watched_queue listening file_list
+    global value_queue process_id current_bp_globals data_view statistics_data
+    global arguments_item_id trace_data last_location
+
+    if {$client_file != ""} {
+        if {!$terminated} {SendReply TERMINATE}
+
+        set f $client_file        
+        set client_file ""
+        close $f
+    }
+
+    set program_name $prg
+
+    if {$program_name == ""} {
+        set program_name [tk_getOpenFile -title "Select executable"]
+    }
+
+    if {$program_name == ""} return
+
+    lappend search_path [file dirname [lindex $program_name 0]]
+    set reply_queue {}
+    set data_queue {}
+    set bp_queue {}
+    set watched_queue {}
+    set value_queue {}
+    set last_location ""
+    set starting_up 1
+    set stepping 0
+    set terminated 0
+    set current_bp_lines {}
+    set current_bp_globals {}
+    set current_filename ""
+    set watched_variables {}
+    set listening 0
+    set process_id 0
+    set statistics_data ""
+    set file_list {}
+    set trace_data ""
+    .t configure -state normal
+    .t delete 1.0 end
+    .t configure -state disabled
+
+    if {$data_view != ""} {
+        .data.t delete [lrange [.data.t children {}] 1 end]
+        .data.t delete [.data.t children $arguments_item_id]
+    }
+
+    if {[catch {eval exec $program_name <@ stdin >@ stdout 2>@ stderr &} result]} {
+        .t insert end "Could not start program:\n\n$result"
+    } else {
+        set process_id $result
+    }
+}
+
+
+proc UpdateHeader {{msg ""}} {
+    global header_text current_filename client_addr current_line
+    set header_text $client_addr
+
+    if {$current_filename != ""} {
+        set header_text $current_filename
+
+        if {$current_line != ""} {
+            append header_text ":$current_line"
+        }
+    }
+
+    if {$msg != ""} {
+        append header_text " - $msg"
+    }
+}
+
+
+proc ProcessInput {} {
+    global client_file terminated
+    gets $client_file line
+    
+    if {[eof $client_file]} {
+        close $client_file
+        set client_file ""
+        set terminated 1
+        UpdateHeader "connection closed"
+    } elseif {![fblocked $client_file]} {
+        Log "Input: $line"
+        ProcessLine $line
+    }
+}
+
+
+proc ProcessLine {line} {
+    if {[regexp {^\((\d+)\s+"([^"]*)"\s+"([^"]*)"\s+"([^"]*)"\)$} $line _ evt loc val \
+        cloc]} {
+        ProcessEvent $evt $loc $val $cloc
+    } elseif {[regexp {^\(\*\s*(.*)\)$} $line _ data]} {
+        ProcessData $data
+    } else {
+        UpdateHeader "invalid input: [string range $line 0 40]..."
+    }
+}
+
+
+proc ProcessEvent {evt loc val cloc} {
+    global events reply_queue starting_up EXEC_EVENT_MASK data_queue c_view
+    global STEP_EVENT_MASK stepping data_view listening value_queue statistics_data
+    global current_c_location protocol_version the_name program_name trace_data
+
+    set listening 1
+
+    if {[info exists events($evt)]} {
+        set eventname $events($evt)
+    } else {
+        UpdateHeader "unrecognized event: $evt"
+        return
+    }
+
+    if {$data_queue != ""} {
+        set data_queue [lrange $data_queue 1 end]
+    }
+
+    Log "evt: $eventname, dq: $data_queue, rq: $reply_queue, vq: $value_queue"
+
+    if {$eventname != "listen"} {
+        set statistics_data ""
+        set trace_data ""
+    }
+
+    set current_c_location $cloc
+
+    if {$c_view != ""} {
+        LocateCSource $cloc
+    }
+
+    switch $eventname {
+        connect {
+            if {![regexp {^([^:]+):([^:]+):(\d+)$} $loc _ name pid pv]} {
+                UpdateHeader "invalid connection info: $loc"
+                return
+            }
+
+            if {$pv > $protocol_version} {
+                UpdateHeader "client protocol doesn't match: $pv"
+                return
+            }
+    
+            wm title . "$the_name - $program_name"
+            
+            Log "\n##################### CONNECT ##################"
+            SendReply SETMASK $STEP_EVENT_MASK
+            set stepping 1
+            lappend reply_queue FetchEventListReply FirstStepReply
+        }
+        listen {
+            if {$reply_queue != ""} { 
+                set action [lindex $reply_queue 0]
+                set reply_queue [lrange $reply_queue 1 end]
+                Log "action: $action"
+                $action
+            } elseif {$val == 1} {
+                # new dbg-info was registered
+                lappend reply_queue ApplyTags
+                FetchEventListReply
+            }
+        }
+        default {
+            # call/entry/assign/signal/gc
+            LocateEvent $loc $val
+            UpdateHeader "\[$eventname\]"
+
+            if {$starting_up} {
+                SendReply SETMASK $EXEC_EVENT_MASK
+                set starting_up 0
+            } elseif {$data_view != ""} UpdateData
+        }
+    }
+}
+
+
+proc UpdateData {} {
+    global data_queue reply_queue watched_variables 
+    global watched_queue    
+    set watched_queue $watched_variables
+    lappend reply_queue GetGlobals 
+    lappend data_queue GetAVData
+    SendReply GET_AV
+}
+
+
+proc GetAVData {data} {
+    global arguments_item_id value_queue
+    set vals [ParseValueList $data]
+    set cs [.data.t children $arguments_item_id]
+    set len [llength $vals]
+    set clen [llength $cs]
+
+    for {set i 0} {$i < $len} {incr i} {
+        lassign [ValueData [lindex $vals $i]] type text addr
+
+        if {$i >= $clen} {
+            set c [.data.t insert $arguments_item_id end -text $type -values \
+                [list $text $addr]]
+        } else {
+            set c [lindex $cs $i]
+            .data.t item $c -text $type -values [list $text $addr]
+        }
+
+        if {$addr != ""} {
+            lappend value_queue $c
+        }
+
+        incr i
+    }
+
+    if {$i < $clen} {
+        .data.t delete [lrange $cs $i end]
+    }
+
+    .data.t item $arguments_item_id -open 1
+}
+
+
+proc GetGlobals {} {
+    global data_queue reply_queue watched_queue current_variable
+    global data_view value_queue
+
+    if {$watched_queue != ""} {
+        set current_variable [lindex $watched_queue 0]
+        set watched_queue [lrange $watched_queue 1 end]
+        lappend data_queue GetGlobalData
+        set name [MangleSymbol [.data.t item $current_variable -text]]
+        SendReply GET_GLOBAL "\"$name\""
+        lappend reply_queue GetGlobals
+    } elseif {$data_view != ""} {
+        if {$value_queue != ""} {
+            GetValues
+        } else {
+            GetStatistics
+        }
+    }
+}
+
+
+proc GetValues {} {
+    global data_view value_queue current_value data_queue reply_queue
+
+    if {$data_view != ""} {
+        if {$value_queue != ""} {
+            set current_value [lindex $value_queue 0]
+            Log "get value: $current_value"
+            set value_queue [lrange $value_queue 1 end]
+            lappend data_queue GetValueData
+            scan [.data.t set $current_value 1] %x addr
+            SendReply GET_SLOTS $addr
+            lappend reply_queue GetValues
+        } else {
+            UpdateValueText {}
+            GetTrace
+        }
+    }
+}
+
+
+proc GetTrace {} {
+    global data_queue trace_data reply_queue
+
+    if {$trace_data == ""} {
+        lappend reply_queue GetStatistics
+        lappend data_queue GetTraceData
+        SendReply GET_TRACE
+    } else GetStatistics
+}
+
+
+proc GetTraceData {data} {
+    global trace_data
+    
+    if {![regexp {^"([^"]*)"$} $data _ str]} {
+        append trace_data "<invalid trace data>\n"
+    } else {
+        append trace_data "$str\n"
+    }
+}
+
+
+proc RedrawTrace {} {
+    global trace_data
+    .data.f.tr configure -state normal
+    .data.f.tr delete 1.0 end
+    .data.f.tr insert 1.0 $trace_data
+    .data.f.tr configure -state disabled
+}
+
+
+proc GetStatistics {} {
+    global data_queue statistics_data reply_queue trace_data
+
+    if {$trace_data != ""} RedrawTrace
+
+    if {$statistics_data == ""} {
+        lappend data_queue GetStatisticsData
+        SendReply GET_STATS
+    } 
+}
+
+
+proc GetStatisticsData {data} {
+    global statistics_data
+    set addrs [ParseValueList $data]
+    set statistics_data $addrs
+    RedrawStatistics
+}
+
+
+proc RedrawStatistics {} {
+    global statistics_data stats membar_height
+
+    if {$statistics_data == ""} return
+
+    set w [winfo width .data.c]
+    set w2 [expr $w / 2]
+    set w10 [expr $w - 10]
+    set mh [expr $membar_height / 3]
+    set mh2 [expr $mh * 2]
+
+    # fromspace
+    lassign [CalcSize [lindex $statistics_data 0] [lindex $statistics_data 1] \
+        [lindex $statistics_data 6] $w] p pc sz
+    .data.c coords $stats(fromspace_used) 0 0 $p $mh
+    .data.c coords $stats(fromspace_unused) $p 0 $w $mh
+    .data.c coords $stats(fromspace_percentage) $w2 [expr $mh / 2]
+    .data.c itemconfigure $stats(fromspace_percentage) -text "$pc%"
+    .data.c coords $stats(fromspace_size) $w10 0 
+    .data.c itemconfigure $stats(fromspace_size) -text "${sz}k"
+
+    # scratchspace
+    if {[lindex $statistics_data 2] != 0} {
+        lassign [CalcSize [lindex $statistics_data 2] [lindex $statistics_data 3] \
+            [lindex $statistics_data 7] $w] p pc sz
+        .data.c coords $stats(scratchspace_used) 0 $mh $p $mh2
+        .data.c coords $stats(scratchspace_unused) $p $mh $w $mh2
+        .data.c coords $stats(scratchspace_percentage) $w2 [expr int($mh * 1.5)]
+        .data.c itemconfigure $stats(scratchspace_percentage) -text "$pc%"
+        .data.c coords $stats(scratchspace_size) $w10 $mh 
+        .data.c itemconfigure $stats(scratchspace_size) -text "${sz}k"
+    }
+
+    # nursery
+    lassign [CalcSize [lindex $statistics_data 4] [lindex $statistics_data 5] \
+        [lindex $statistics_data 8] $w 1] p pc sz
+    .data.c coords $stats(nursery_used) 0 $mh2 $p $membar_height
+    .data.c coords $stats(nursery_unused) $p $mh2 $w $membar_height
+    .data.c coords $stats(nursery_percentage) $w2 [expr int($mh * 2.5)]
+    .data.c itemconfigure $stats(nursery_percentage) -text "$pc%"
+    .data.c coords $stats(nursery_size) $w10 $mh2
+    .data.c itemconfigure $stats(nursery_size) -text "${sz}k"
+}
+
+
+proc CalcSize {start limit top width {inv 0}} {
+    set total [expr $limit - $start]
+
+    if {$inv} {
+        set amount [expr $limit - $top]
+    } else {
+        set amount [expr $top - $start]
+    }
+
+    set p [expr int(double($amount) / $total * 100)]
+    set sz [expr $total / 1024]
+    return [list [expr int((double($width) / $total) * $amount)] $p $sz]
+}
+
+
+proc GetValueData {data} {
+    global current_value value_queue typecode value_cutoff_limit
+
+    set vals [ParseValueList $data]
+    set bits [lindex $vals 1]
+
+    if {[info exists typecode($bits)]} {
+        set type $typecode($bits)
+    } else {
+        set type "<invalid: $bits>"
+    }
+
+    .data.t item $current_value -text $type
+    set cs {}
+            
+    switch [lindex $vals 0] {
+        "SPECIAL" {
+            set cs [.data.t children $current_value]
+            
+            if {$cs == ""} {
+                set c1 [.data.t insert $current_value end]
+                set cs {}
+            } else {
+                set c1 [lindex $cs 0]
+                set cs [lrange $cs 1 end]
+            }
+
+            .data.t item $c1 -text "<native pointer>" -values \
+                [list "" [format 0x%x [lindex $vals 2]]]
+            set vals [lrange $vals 3 end]
+        }
+        "VECTOR" {
+            set vals [lrange $vals 2 end]
+            set cs [.data.t children $current_value]
+        }            
+        "BLOB" {
+            if {$type == "STRING" || $type == "LAMBDA_INFO"} {
+                set str "\""
+
+                foreach c [lrange $vals 2 end] {
+                    # XXX escape special chars
+                    append str [format %c $c]
+                }
+    
+                append str "\""
+            } elseif {$type == "FLONUM"} {
+                set bytes [binary format c* $vals]
+                binary scan $bytes d str
+            } else {
+                set str "#\${"
+
+                foreach c [lrange $vals 2 end] {
+                    append str [format %02x $c]
+                }
+    
+                append str "}"
+            }
+
+            .data.t set $current_value 0 $str
+            set cs [.data.t children $current_value]
+
+            if {$cs != ""} {.data.t delete $cs}
+
+            return
+        }
+        default {
+            UpdateHeader "invalid value: $data"
+        }
+    }
+
+    set vlen [llength $vals]
+    set clen [llength $cs]
+
+    for {set i 0} {$i < $vlen} {incr i} {
+        set val [lindex $vals $i]
+        lassign [ValueData $val] type text addr
+
+        if {$i >= $clen} {
+            set c [.data.t insert $current_value end -text $type -values \
+                [list $text $addr]]
+            Log "insert: $c"
+        } else {
+            set c [lindex $cs $i]
+            Log "reuse: $c"
+            .data.t item $c -text $type -values [list $text $addr]
+        }
+
+        if {$i >= $value_cutoff_limit} {
+            .data.t item $c -text ":" -values {"" ""}
+            incr i
+            break
+        }
+
+        if {$addr != ""} {
+            if {[.data.t item [.data.t parent $c] -open]} {
+                lappend value_queue $c
+            }
+        } else {
+            .data.t delete [.data.t children $c]
+        }
+    }
+
+    if {$i < $clen} {
+        .data.t delete [lrange $cs $i end]
+    }
+}
+
+
+proc UpdateValueText {node} {
+    global value_cutoff_limit
+    set cs [.data.t children $node]
+
+    foreach c $cs {
+        UpdateValueText $c
+    }
+
+    if {$node == ""} return
+
+    set addr [.data.t set $node 1]
+
+    if {$addr == ""} return
+
+    set type [.data.t item $node -text]
+
+    if {$type == ":"} return
+
+    set str "..."
+
+    switch $type {
+        "" return
+        "<arguments>" return
+        "<native pointer>" return
+        FLONUM return
+        LAMBDA_INFO return
+        STRING return
+        PAIR {
+            set car [.data.t set [lindex $cs 0] 0]
+            set cdr [.data.t set [lindex $cs 1] 0]
+            set str "($car"
+
+            switch [.data.t item [lindex $cs 1] -text] {
+                NULL {append str ")"}
+                PAIR {append str " [string range $cdr 1 end]"}
+                default {append str " . $cdr)"}
+            }
+        }
+        VECTOR {
+            if {$cs == ""} {
+                set str "#()"
+            } else {
+                set x0 [.data.t set [lindex $cs 0] 0]
+                set str "#($x0"
+            
+                foreach c [lrange $cs 1 end] {
+                    set x [.data.t set $c 0]
+                    append str " $x"
+                }
+
+                append str ")"
+            }
+        }
+        SYMBOL {
+            set name [.data.t set [lindex $cs 1] 0]
+            set str [DemangleSymbol [string range $name 1 "end-1"]]
+        }
+        default {
+            set str "#<$type $addr>"
+        }
+    }
+
+    if {[string length $str] >= $value_cutoff_limit} {
+        set str "[string range $str 0 $value_cutoff_limit]..."
+     }
+
+    .data.t set $node 0 $str
+}
+
+
+proc OpenDataItem {} {
+    global value_queue listening
+    set item [.data.t focus]
+
+    if {$item == ""} return
+
+    if {!$listening} return
+
+    if {[.data.t parent $item] == ""} return
+
+    set cs [.data.t children $item]
+
+    foreach c $cs {
+        if {[.data.t set $c 1] != "" && \
+            [.data.t item $c -text] != "<native pointer>"} {
+            lappend value_queue $c
+        }
+    }
+
+    GetValues
+}
+
+
+proc WatchGlobal {} {
+    global data_queue watched_variables current_variable reply_queue
+
+    if {![CheckListening]} return
+
+    set name [string trim [.data.e get]]
+    .data.e delete 0 end
+
+    if {$name == ""} return
+
+    if {[lsearch -exact $watched_variables $name] != -1} return
+
+    set id [.data.t insert {} end -text $name]
+    lappend watched_variables $id
+    lappend data_queue GetGlobalData
+    set current_variable $id
+    set name [MangleSymbol $name]
+    SendReply GET_GLOBAL "\"$name\""
+    lappend reply_queue GetValues
+}
+
+
+proc RemoveGlobal {} {
+    global watched_variables arguments_item_id
+    set f [.data.t focus]
+
+    if {$f == $arguments_item_id || [.data.t parent $f] == $arguments_item_id} return
+
+    .data.t delete $f
+
+    if {$f == ""} return
+
+    set p [lsearch -exact $watched_variables $f]
+    set watched_variables [lreplace $watched_variables $p $p]
+}
+
+
+proc GetGlobalData {data} {
+    global current_variable watched_variables value_queue
+
+    if {$data == "UNKNOWN"} {
+        .data.t set $current_variable 0 "UNKNOWN"
+        set p [lsearch -exact $watched_variables $current_variable]
+        set watched_variables [lreplace $watched_variables $p $p]
+        return
+    }
+
+    set node [.data.t children $current_variable]
+
+    if {$node == ""} {
+        set node [.data.t insert $current_variable end]
+        .data.t item $current_variable -open 1
+    }
+
+    set val [ParseValueList $data]
+    lassign [ValueData $val] type text addr
+    .data.t item $node -text $type
+    .data.t set $node 0 $text
+    .data.t set $node 1 $addr
+
+    if {$addr != ""} {
+        lappend value_queue $node
+    }
+}
+
+
+# returns type, text and address
+proc ValueData {val} {
+    set c1 [string index $val 0]
+    set rest [string range $val 1 end]
+
+    switch $c1 {
+        "@" { 
+            return [list "" "..." [format "0x%x" $rest]]
+        } 
+        "=" { 
+            switch $rest {
+                6 {return {"BOOLEAN" "#f" ""}}
+                22 {return {"BOOLEAN" "#t" ""}}
+                14 {return {"NULL" "()" ""}}
+                30 {return {"UNDEFINED" "#<undefined>" ""}}
+                46 {return {"UNBOUND" "#<unbound>" ""}}
+                62 {return {"EOF" "#<eof>" ""}}
+                default { 
+                    if {($val & 15) == 10} {
+                        return [list "CHARACTER" [format "#\%c" [expr $val >> 8]] ""]
+                    }
+
+                    return [list "???" [format "#<unknown immediate value 0x%x>" \
+                        $val] ""]
+                }
+            }
+        }
+        default {return [list "FIXNUM" $val ""]}
+    }
+}
+
+
+proc MangleSymbol {str} {
+    if {[regexp {^##([^#]+)#(.+)$} $str _ prefix name]} {
+        set len [string length $prefix]
+        return [binary format ca*a* $len $prefix $name]
+    }
+
+    rerurn $str
+}
+
+
+proc DemangleSymbol {str} {
+    set b1 ""
+    binary scan $str ca* b1 name
+
+    if {$b1 == ""} { 
+        return $str
+    } elseif {$b1 == 0} {
+        return "#:$name"
+    } elseif {$b1 < 32} {
+        return [format "##%s#%s" [string range $name 0 2] [string range $name 3 end]]
+    }
+
+    return $str
+}
+
+
+proc ParseValueList {str} {
+    set vals {}
+
+    while {[regexp {^\s*(\S+)(.*)$} $str _ val rest]} {
+        lappend vals $val
+        set str $rest
+    }
+
+    return $vals
+}
+
+
+proc FirstStepReply {} {
+    global stepping 
+    set stepping 0
+    SendReply CONTINUE
+}
+
+
+proc ProcessData {data} {
+    global data_queue
+
+    if {$data_queue == ""} {
+        UpdateHeader "unexpected data: $data"
+    }
+
+    set handler [lindex $data_queue 0]
+    $handler $data
+}
+
+
+proc ExtractLocation args {
+    foreach data $args {
+        if {[regexp {^([^:]+):(\d+)(: .*)?$} $data _ fname line]} {
+            return [list $fname $line]
+        }
+    }
+
+    return ""
+}
+
+
+proc InsertDebugInfo {index event args} {
+    global file_list globals
+    set loc [eval ExtractLocation $args]
+
+    # chck for assignment event
+    if {$event == 1} {
+        set name [lindex $args 1]
+        lappend globals($name) $index
+    }
+
+    if {$loc != ""} {
+        set fname [file normalize [lindex $loc 0]]
+        set line [lindex $loc 1]
+
+        if {[lsearch -exact $file_list $fname] == -1} {
+            lappend file_list $fname
+        }
+
+        # icky: compute array variable name from filename:
+        set tname "file:$fname"
+        global $tname
+        set xname "$tname\($line\)"
+        lappend $xname $index
+        return 1
+    }
+
+    return 0
+}
+
+
+proc FetchEventListReply {} {
+    global file_list reply_queue data_queue
+    UpdateHeader "fetching debug information ..."
+    lappend data_queue EventInfoData
+    SendReply LIST_EVENTS {""}
+}
+
+
+proc EventInfoData {data} {
+    if {[regexp {(\d+)\s+(\d+)\s+"([^"]*)"\s+"([^"]*)"$} $data _ index event \
+        loc val]} {
+        InsertDebugInfo $index $event $loc $val
+    } else {
+        UpdateHeader "invalid event data: $data"
+    }
+}
+
+
+proc ContinueExecution {} {
+    global client_file EXEC_EVENT_MASK stepping reply_queue listening
+    global value_queue
+
+    if {$client_file == ""} return
+
+    if {![CheckListening]} return
+
+    UpdateHeader "executing ..."
+
+    if {$stepping} {
+        set stepping 0
+        SendReply SETMASK $EXEC_EVENT_MASK
+        lappend reply_queue ContinueExecution
+    } else {
+        set value_queue {}
+        set listening 0
+        SendReply CONTINUE
+    }
+}
+
+
+proc StepExecution {} {
+    global STEP_EVENT_MASK client_file stepping listening value_queue reply_queue
+    global watched_queue
+    
+    if {$client_file == ""} return
+
+    if {![CheckListening]} return
+
+    if {!$stepping} {
+        set stepping 1
+        SendReply SETMASK $STEP_EVENT_MASK
+        lappend reply_queue StepExecution
+    } else {
+        set value_queue {}
+        set watched_queue {}
+        set listening 0
+        SendReply CONTINUE
+    }
+
+    UpdateHeader "stepping ..."
+}
+
+
+proc StartMark {w x y} {
+    global mark_start_index last_marked_widget
+    set mark_start_index($w) ""
+    set last_marked_widget $w
+    set old [$w tag ranges mk]
+
+    if {$old != ""} {
+        eval $w tag remove mk $old
+    }
+
+    if {![catch {$w index "@$x,$y"} pos]} {
+        set mark_start_index($w) $pos
+    }
+}
+
+
+proc EndMark {w} {
+    global mark_start_index
+    set rng [$w tag ranges mk]
+
+    if {$rng != ""} {
+        set text [eval $w get $rng]
+        set len [string length $text]
+        set found [$w search -all $text 1.0 end]
+
+        foreach f $found {
+            $w tag add mk $f "$f + $len chars"
+        }
+    }
+
+    set mark_start_index($w) ""
+}
+
+
+proc MoveMark {w x y} {
+    global mark_start_index
+
+    if {$mark_start_index($w) == ""} return
+
+    if {![catch {$w index "@$x,$y"} pos]} {
+        if {$pos == $mark_start_index($w)} return
+
+        set old [$w tag ranges mk]
+
+        if {$old != ""} {
+            eval $w tag remove $old
+        }
+
+        if {[$w compare $pos < $mark_start_index($w)]} {
+            set tmp $mark_start_index($w)
+            set mark_start_index($w) $pos
+            set pos $tmp
+        }
+
+        $w tag add mk $mark_start_index($w) $pos
+    }
+}
+
+
+proc FindNext {{w ""}} {
+    global last_marked_widget
+
+    if {$w == ""} {set w $last_marked_widget}
+
+    # not sure if this test is needed
+    if {[catch {$w index "@1,1"} pos]} return
+
+    while 1 {
+        set rng [$w tag nextrange mk $pos end]
+        
+        if {$rng == ""} return
+
+        lassign $rng p1 pos
+
+        if {[$w dlineinfo $p1] == ""} {
+            $w see $p1
+            return
+        }
+    }
+}
+
+
+proc FindPrevious {{w ""}} {
+    global last_marked_widget
+
+    if {$w == ""} {set w $last_marked_widget}
+
+    # not sure if this test is needed
+    if {[catch {$w index "@1,1"} pos]} return
+
+    set rng [$w tag prevrange mk $pos 1.0]
+        
+    if {$rng == ""} return
+
+    set p1 [lindex $rng 0]
+    $w see $p1
+}
+
+
+proc SendReply {rep args} {
+    global client_file reply
+    set rest ""
+    
+    if {$args != ""} {
+        set rest " [join $args]"
+    }
+
+    set str "($reply($rep)$rest)"
+    Log "send: $str"
+    puts $client_file $str
+}
+
+
+proc SelectFile {} {
+    global current_filename selected_filename
+
+    if {$current_filename == $selected_filename} return
+
+    if {![LoadFile $selected_filename]} return
+
+    if {[SwitchFile $selected_filename]} ApplyTags
+}
+
+
+proc OpenFile {} {
+    global current_filename file_list
+    set dir "."
+
+    if {$current_filename != ""} {
+        set dir [file dirname $current_filename]
+    }
+
+    set fname [tk_getOpenFile -title "Select source file" -initialdir $dir]
+    set fname [file normalize $fname]
+
+    if {$fname == "" || $fname == $current_filename} return
+
+    if {[lsearch -exact $file_list $fname] == -1} {
+        tk_messageBox -message "No debug information available for \"$fname\"" \
+            -type ok
+        return
+    }
+
+    if {![LoadFile $fname]} return
+
+    if {[SwitchFile $fname]} ApplyTags
+}
+
+
+proc SwitchFile {fname} {
+    global current_bp_lines saved_bp_lines file_list current_filename
+
+    Log "switch: $current_filename -> $fname"
+
+    if {$current_filename != ""} {
+        Log "saving bps: $current_bp_lines"
+        set saved_bp_lines($current_filename) $current_bp_lines
+    }
+
+    set current_filename $fname
+    Log "searching $fname in $file_list"
+
+    if {[lsearch -exact $file_list $fname] != -1} {
+        if {[info exists saved_bp_lines($fname)]} {
+            set current_bp_lines {}
+            foreach line $saved_bp_lines($fname) {MarkBP $line}
+            Log "restoring bps: $current_bp_lines"
+        } else {
+            set current_bp_lines {}
+        }
+    
+        return 1
+    }
+
+    return 0
+}
+
+
+proc LocateEvent {loc val} {
+    global current_filename file_list saved_bp_lines search_path last_location
+    set loc [ExtractLocation $loc $val]
+
+    if {$loc != ""} {
+        set fname [file normalize [lindex $loc 0]]
+        set line [lindex $loc 1]
+
+        if {$fname != $current_filename} {
+            foreach d $search_path {
+                set fn [file join $d $fname]
+
+                if {[file exists $fn]} {
+                    set fname $fn
+                    break
+                }
+            }
+
+            if {![LoadFile $fname]} return
+
+            if {[SwitchFile $fname]} ApplyTags 
+        }
+
+        set last_location $line
+        SetFocus $line
+    }
+}
+
+
+proc LocateCSource {cloc} {
+    global current_c_filename search_path 
+    set loc [ExtractLocation $cloc]
+  
+    if {$loc != ""} {
+        .code.h configure -text $cloc
+        set fname [file normalize [lindex $loc 0]]
+        set line [lindex $loc 1]
+
+        if {$fname != $current_c_filename} {
+            foreach d $search_path {
+                set fn [file join $d $fname]
+
+                if {[file exists $fn]} {
+                    set fname $fn
+                    break
+                }
+            }
+
+            if {![LoadFile $fname .code.t]} return
+        }
+
+        SetCFocus $line
+    }
+}
+
+
+proc LoadFile {fname {w .t}} {
+    $w configure -state normal
+    $w delete 1.0 end
+
+    if {[file exists $fname]} {
+        set f [open $fname]
+        $w insert 1.0 [read $f]
+        close $f
+        $w configure -state disabled
+        return 1
+    } else {
+        $w insert 1.0 "File not found: \"$fname\""
+        $w configure -state disabled
+        return 0
+    }
+}
+
+
+proc ApplyTags {} {
+    global current_filename
+    set aname "file:$current_filename"
+    global $aname   
+    set old [.t tag ranges ev]
+    Log "apply tags: $current_filename"
+    
+    if {$old != ""} {
+        eval .t tag remove $old
+    }
+    
+    foreach line [array names $aname] {
+        set evts [set $aname\($line\)]
+        .t tag add ev $line.0 "$line.0 lineend + 1 chars"
+    }
+
+    UpdateHeader "events tagged"
+}
+
+
+proc Server {channel addr port} {
+    global client_addr client_file
+
+    if {$client_file != ""} {
+        close $channel
+        return
+    }
+
+    fconfigure $channel -buffering line -encoding binary -blocking 0
+    fileevent $channel readable ProcessInput
+    set client_addr $addr
+    set client_file $channel
+}
+
+
+proc SetupServer {} {
+    global debugger_port
+    socket -server Server $debugger_port
+    .t configure -state normal
+    .t insert end "Waiting for connection from client ...\n"
+    .t configure -state disabled
+}
+
+
+proc Usage {code} {
+    global the_name
+    puts stderr {Usage: $the_name [-help] [-n] [-d] [-dir DIRNAME] [-port PORT] [PROGRAM ARGUMENTS ...]}
+    exit $code
+}
+
+
+set load_startup_file 1
+
+for {set i 0} {$i < $argc} {incr i} {
+    set arg [lindex $argv $i]
+
+    switch -regexp -- $arg {
+        {^--?(h|help)$} {Usage 0}
+        {^-dir$} {
+            incr i
+            lappend search_path [lindex $argv $i]
+        }
+        {^-n$} {set load_startup_file 0}
+        {^-port$} {
+            incr i
+            set debugger_port [lindex $argv $i]
+        }
+        {^-d$} {set logging 1}
+        {^-} {Usage 1}
+        default {
+            if {$program_name != ""} {Usage 0}
+
+            set program_name [lrange $argv $i end]
+            break
+        }
+    }
+}
+
+
+if {$load_startup_file} {
+    if {[file exists $env(HOME)/$startup_file]} {
+        source $env(HOME)/$startup_file
+    }
+
+    if {[file exists $startup_file]} {
+        source $startup_file
+    }
+}
+
+
+SetupGUI
+SetupBindings
+SetupServer
+
+if {$program_name != ""} {
+    RunProcess $program_name
+}
+
+
+# TODO:
+#
+# - F2 is mostly pointless
+# - data-view update is slow
+#   - modify only when necessary? or are we creating too many items on the fly?
+#   - or too much TCP-traffic?
+# - allow spawning gdb, probably in separate terminal window(?)
+#   - may be covered by just running "gdb <program>" as client
+# - setting breakpoints on yet unregistered (i.e. dynamically loaded) files
+#   is not possible - a file must be registered first
+# - check whether "listening" check works
+# - backport to chicken4
+#   - feature ("dbg-client")
+# - when retrieved data is wrong, clear queues
+# - must watched globals be mangled, when qualified? (GET_GLOBAL)
+# - dview: monospace font (needs tags, it seems)
+# - https://sourceware.org/gdb/current/onlinedocs/gdb/GDB_002fMI.html#GDB_002fMI
+# - gdb interface:
+#   - toggle bp in C-source line, step/execute
+#   - needs a way to trigger gdb from running program (in dbg-stub.c)
+#     (send signal to self (SIGUSR2?))
+# - allow explicit connection to debugger from Scheme code
+# - multiple dbg-info for identical filenames will cause havoc
+# - interrupt takes rather long (was in bignum-heavy code, try other)
+# - bignums are shown as raw strings (uses string-type for bitvec)
+# - how to handle threads?
diff --git a/library.scm b/library.scm
index 377c882..93f0ade 100644
--- a/library.scm
+++ b/library.scm
@@ -132,6 +132,22 @@ shallow_equal(C_word x, C_word y)
   if(C_header_size(y) != len) return C_SCHEME_FALSE;      
   else return C_mk_bool(!C_memcmp((void *)x, (void *)y, len * sizeof(C_word)));
 }
+
+static C_word
+signal_debug_event(C_word mode, C_word msg, C_word args)
+{
+  C_DEBUG_INFO cell;
+  C_word av[ 3 ];
+  cell.enabled = 1;
+  cell.event = C_DEBUG_SIGNAL;
+  cell.loc = "";
+  cell.val = "";
+  av[ 0 ] = mode;
+  av[ 1 ] = msg;
+  av[ 2 ] = args;
+  C_debugger(&cell, 3, av);
+  return C_SCHEME_UNDEFINED;
+}
 EOF
 ) )
 
@@ -3966,8 +3982,12 @@ EOF
 
 ;;; Condition handling:
 
+(define (##sys#debugger msg . args)
+  (##core#inline "signal_debug_event" #:debugger-invocation msg args) )
+
 (define (##sys#signal-hook mode msg . args)
   (##core#inline "C_dbg_hook" #f)
+  (##core#inline "signal_debug_event" mode msg args)
   (case mode
     [(#:user-interrupt)
      (##sys#abort
diff --git a/manual/Debugging b/manual/Debugging
new file mode 100644
index 0000000..c856838
--- /dev/null
+++ b/manual/Debugging
@@ -0,0 +1,159 @@
+[[tags:manual]]
+
+== Debugging
+
+
+=== Introduction
+
+This document describes "Feathers", a debugger for compiled CHICKEN programs.
+
+"Feathers" is a [[Tcl/Tk|http://tcl.tk]] script, installed together with
+all other components of the CHICKEN system. To use the debugger, Tcl/Tk version
+8.5 must be installed.
+
+Once the debugger is started, it waits for a client program to connect to
+it. You can also run a program explicitly by pressing the {{F1}} key and
+selecting an executable to run. If the executable has been compiled with
+debugging information, it will connect to the debugger and the source code
+of the program will be shown in the debugger window, if the original source
+files of the program are available in the search path (see bwlo for more
+details on this.)
+
+To enable debugging in compiled programs a number of requirements must be met:
+
+* The program must be compiled with debug-level 3 or higher (option {{-d3}}) or by providing the {{-debug-info}} option.
+
+* The environment variable {{CHICKEN_DEBUGGER}} must be set to the address and port of a running instance of the debugger, e.g. {{CHICKEN_DEBUGGER=localhost:9999}} (port 9999 is the default port). If you start a program directly out of the debugger, then this variable does not need to be set.
+
+* The source code files must be in the current directory, or in the current "search path" of the debugger. The search path defaults to the current directory, the directory of the debugged program and any additional directories selected by pressing the {{F3}} key.
+
+You can also run the debugger from the command line and directly pass the program
+to be debugged, including any additional arguments that the program should receive:
+
+{{% feathers myprogram 1 2 3}}
+
+The debugger understands a number of command-line options: {{-port PORT}} changes the
+port on which the debugger listens (the default is 9999), {{-dir DIRECTORY}} adds
+{{DIRECTORY}} to the search path (this option can be given multiple times), and
+{{-n}} disables loading of a custom init file ({{~/.feathers}} or {{./.feathers}}).
+
+Debug-level 3 adds intrumentation to the compiled code to allow interacting with
+it from the debugger. This has a slight performance cost, so it should not be
+enabled with performance sensitive code.
+
+Debugging is mostly unintrusive: timing and dynamic (nursery) allocation may be
+influenced by the debugging, but otherwise the program will behave exactly as it
+would without embedded debugging-information: no additional heap allocation
+takes place, and no Scheme library code will be invoked.
+
+User-interrupts triggered from the debugger use {{SIGUSR2}} to indicate that
+the program should be suspended. Be aware of that in case your program implements
+a signal handler for {{SIGUSR2}}.
+
+Remote debugging should be no problem: all communication between debugger and the
+client program takes place over TCP sockets. Note that the source files for
+the debugged program need to be available on the machine that does the debugging.
+
+
+=== Usage
+
+Initially a single window is shown, holding the contents of the source file that
+contains the currently executing code. When the execution changes to another file,
+the contents of the window will be automatically updated. The combo-box at the
+top shows all source-files for which debug-information is currently available.
+Note that this may change during the execution of the program, as files are
+dynamically loaded or statically linked units are not yet initialized.
+
+The "focus" (a line marked blue) shows at what location the program is currently 
+suspended. You can move the focus up and down with the {{Up}} and {{Down}} arrow
+keys.
+
+Lines that contain "debug events" are highlighted: these lines can be used to
+set breakpoints by clicking with the left mouse button or by pressing {{Enter}} while
+the focus is on that line. Clicking a line that
+contains a breakpoint will disable the breakpoint. Note that a single line
+can contain multiple "debug events". Setting a breakpoint on such a line
+will interrupt the program on any event that exists on that line.
+
+The following debug events exist:
+
+* Procedure call
+
+* Procedure entry
+
+* Assignment to global variable
+
+* Signal (an error or interrupt)
+
+The topmost line shows the current file and also displays "events" as the debugged
+program runs and interacts with the debugger. 
+
+At the bottom the following buttons are visible, each of them can also be activated
+by pressing the function-key shown on the button:
+
+; F1 : Run an executable under the debugger. If a program is already debugged, then the current program will be terminated and the debugger is reinitialized.
+
+; F2 : Move focus back to location where the debugged program has been suspended.
+
+; F3 : Add another directory to the current search path.
+
+; F4 : Open the "data" view (see below.)
+
+; F5 : Continue execution of the program until the next breakpoint is hit, an error occurs, or the program terminates.
+
+; F6 : Execute a single "step", until the next debug-event occurs. You can also press the {{Space}} key to single-step.
+
+; F7 : If text is marked in the current window, search backwards and show the most previous occurrence of the marked text that is not already visible.
+
+: F8 : Search for next occurrence of marked text.
+
+: F9 : Open "C" view (see below.)
+
+: F10 : Terminate the currently debugged program and exit the debugger.
+
+Pressing the {{Esc}} key while the program is executing will suspend it on the
+next debug-event (so this may not take place instantly.)
+
+The keys {{+}} (plus) and {{-}} (minus) increase and decrease the current font-size,
+respectively.
+
+
+=== The "Data" View
+
+When {{F4}} is pressed, a window appears that allows inspection of the current 
+arguments of a suspended procedure, together with any additional global variables
+that have been marked for inspection. By opening value items in the shown tree
+view, values can be inspected to arbitrary depth. Note that the values are retrieved
+from the debug-client on-demand, so the textual representation of a value shown
+will only reflect its currently inspected contents.
+
+The entry-field below the view for variables and arguments can be used to add 
+global variables to the list of watched variables. Double-clicking on a variable 
+(or pressing {{Enter}} while it is
+selected) sets a "watchpoint" - a breakpoint that is trigged when the variable
+is assigned a new value.
+
+The bars indicate current heap-, scratchspace- and nursery
+utilization. These bars update only when the program is suspended.
+
+At the bottom the current call-trace of the executing program is shown. Note
+that this is not a "stack-trace", but a list of recently performed calls,
+ordered from top (earlier) to bottom (later).
+
+
+=== The "C" View
+
+Pressing {{F9}} opens another text-window which shows the current location where
+the program is suspended, but in the compiled C code generated by the {{chicken}}
+compiler. The contents of the window are automatically updated on every suspension
+of the debugged program. 
+This may be useful when you want to understand how CHICKEN compiles
+Scheme to C, or when you are doing low-level debugging.
+
+Text can be marked and searched as in the source-code window with {{F7}} and {{F8}}.
+
+
+---
+Previous: [[Supported language]]
+
+Next: [[Interface to external functions and variables]]
diff --git a/manual/Interface to external functions and variables b/manual/Interface to external functions and variables
index 85cff25..50bbd08 100644
--- a/manual/Interface to external functions and variables	
+++ b/manual/Interface to external functions and variables	
@@ -17,6 +17,6 @@ Note: Using the foreign library directly from the interpreter or the REPL will n
 * [[C interface]]                 
 
 ---
-Previous: [[Supported language]]
+Previous: [[Debugging]]
 
 Next: [[Extensions]]
diff --git a/manual/Supported language b/manual/Supported language
index 7905da0..fc7b171 100644
--- a/manual/Supported language	
+++ b/manual/Supported language	
@@ -35,4 +35,4 @@
 ---
 Previous: [[Using the interpreter]]
 
-Next: [[Interface to external functions and variables]]
+Next: [[Debugging]]
diff --git a/manual/The User's Manual b/manual/The User's Manual
index bea583a..8da51a2 100644
--- a/manual/The User's Manual	
+++ b/manual/The User's Manual	
@@ -18,6 +18,8 @@ This is the manual for CHICKEN Scheme, version 4.10.1
 
 ; [[Supported language]] : The language implemented by CHICKEN (deviations from the standard and extensions).
 
+; [[Debugging]] : Using "Feathers", the CHICKEN debugger.
+
 ; [[Interface to external functions and variables]] : Accessing C and C++ code and data.
 
 ; [[Extensions]] : Packaging and installing extension libraries.
@@ -35,4 +37,3 @@ This is the manual for CHICKEN Scheme, version 4.10.1
 ; [[Acknowledgements]] : A list of some of the people that have contributed to make CHICKEN what it is.
 
 ; [[Bibliography]] : Links to documents that may be of interest.
-
diff --git a/rules.make b/rules.make
index 33c3ffe..77edc36 100644
--- a/rules.make
+++ b/rules.make
@@ -37,7 +37,7 @@ SETUP_API_OBJECTS_1 = setup-api setup-download
 
 LIBCHICKEN_SCHEME_OBJECTS_1 = \
        library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
-       srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler \
+       srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler debugger-client \
        profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version
 LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime
 LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
@@ -280,6 +280,12 @@ $(eval $(call declare-program-from-object,$(CSI_STATIC_EXECUTABLE),csi))
 $(eval $(call declare-program-from-object,$(CHICKEN_BUG_PROGRAM)$(EXE),chicken-bug))
 
 
+# scripts
+
+$(CHICKEN_DEBUGGER_PROGRAM): $(SRCDIR)feathers$(SCRIPT_EXT).in
+	$(GENERATE_DEBUGGER)
+
+
 # installation
 
 .PHONY: install uninstall install-libs
@@ -360,6 +366,9 @@ install-bin: $(TARGETS) install-libs install-dev
 		$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) \
 		$(prog)$(EXE) "$(DESTDIR)$(IBINDIR)" $(NL))
 
+	$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) $(CHICKEN_DEBUGGER_PROGRAM) \
+	  "$(DESTDIR)$(BINDIR)" $(NL)
+
 ifdef STATICBUILD
 	$(foreach lib,$(IMPORT_LIBRARIES),\
 		$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) \
@@ -414,6 +423,7 @@ install-other-files:
 	$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) $(SRCDIR)README "$(DESTDIR)$(IDOCDIR)"
 	$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) $(SRCDIR)LICENSE "$(DESTDIR)$(IDOCDIR)"
 	$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) $(SRCDIR)setup.defaults "$(DESTDIR)$(IDATADIR)"
+	$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) $(SRCDIR)feathers.tcl "$(DESTDIR)$(DATADIR)"
 
 install-wrappers:
 ifeq ($(WRAPPERDIR),)
@@ -430,6 +440,8 @@ uninstall:
 		$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS)\
 		"$(DESTDIR)$(IBINDIR)$(SEP)$(prog)$(EXE)" $(NL))
 
+	$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS)\
+		"$(DESTDIR)$(IBINDIR)$(SEP)$(CHICKEN_DEBUGGER_PROGRAM)" $(NL))
 	$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) "$(DESTDIR)$(ILIBDIR)$(SEP)lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX)$(A)"
 	$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) "$(DESTDIR)$(ILIBDIR)$(SEP)lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX)$(SO)"
 ifdef USES_SONAME
@@ -544,6 +556,8 @@ profiler.c: $(SRCDIR)profiler.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib) 
 stub.c: $(SRCDIR)stub.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib) 
+debugger-client.c: $(SRCDIR)debugger-client.scm $(SRCDIR)common-declarations.scm dbg-stub.c
+	$(bootstrap-lib) 
 build-version.c: $(SRCDIR)build-version.scm buildbranch buildid \
 	  $(SRCDIR)buildversion buildtag.h
 	$(bootstrap-lib)
diff --git a/runtime.c b/runtime.c
index 2d477c0..332aa99 100644
--- a/runtime.c
+++ b/runtime.c
@@ -329,6 +329,7 @@ C_TLS void (*C_gc_trace_hook)(C_word *var, int mode);
 C_TLS void (*C_panic_hook)(C_char *msg) = NULL;
 C_TLS void (*C_pre_gc_hook)(int mode) = NULL;
 C_TLS void (*C_post_gc_hook)(int mode, C_long ms) = NULL;
+C_TLS C_word (*C_debugger_hook)(C_DEBUG_INFO *cell, C_word c, C_word *av, C_char *cloc, int cln) = NULL;
 
 C_TLS int
   C_gui_mode = 0,
@@ -344,6 +345,7 @@ C_TLS int
   C_heap_size_is_fixed,
   C_trace_buffer_size = DEFAULT_TRACE_BUFFER_SIZE,
   C_max_pending_finalizers = C_DEFAULT_MAX_PENDING_FINALIZERS,
+  C_debugging = 0,
   C_main_argc;
 C_TLS C_uword 
   C_heap_growth,
@@ -769,6 +771,21 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
 }
 
 
+void *C_get_statistics(void) {
+    static void *stats[ 8 ];
+
+    stats[ 0 ] = fromspace_start;
+    stats[ 1 ] = C_fromspace_limit;
+    stats[ 2 ] = NULL;
+    stats[ 3 ] = NULL;
+    stats[ 4 ] = C_stack_limit;
+    stats[ 5 ] = stack_bottom;
+    stats[ 6 ] = C_fromspace_top;
+    stats[ 7 ] = NULL;
+    return stats;
+}
+
+
 static C_PTABLE_ENTRY *create_initial_ptable()
 {
   /* IMPORTANT: hardcoded table size -
@@ -975,12 +992,15 @@ C_regparm C_SYMBOL_TABLE *C_find_symbol_table(char *name)
 
 C_regparm C_word C_find_symbol(C_word str, C_SYMBOL_TABLE *stable)
 {
-  char *sptr = C_c_string(str);
-  int 
-    len = C_header_size(str),
-    key = hash_string(len, sptr, stable->size, stable->rand, 0);
+  C_char *sptr = C_c_string(str);
+  int len = C_header_size(str);
+  int key;
   C_word s;
 
+  if(stable == NULL) stable = symbol_table;
+
+  key = hash_string(len, sptr, stable->size, stable->rand, 0);
+
   if(C_truep(s = lookup(key, len, sptr, stable))) return s;
   else return C_SCHEME_FALSE;
 }
@@ -2763,12 +2783,19 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
   volatile int finalizers_checked;
   FINALIZER_NODE *flist;
   TRACE_INFO *tinfo;
+  C_DEBUG_INFO cell;
 
   /* assert(C_timer_interrupt_counter >= 0); */
 
   if(pending_interrupts_count > 0 && C_interrupts_enabled)
     handle_interrupt(trampoline);
 
+  cell.enabled = 0;
+  cell.event = C_DEBUG_GC;
+  cell.loc = "<runtime>";
+  cell.val = "GC_MINOR";
+  C_debugger(&cell, 0, NULL);
+
   /* Note: the mode argument will always be GC_MINOR or GC_REALLOC. */
   if(C_pre_gc_hook != NULL) C_pre_gc_hook(GC_MINOR);
 
@@ -2796,6 +2823,8 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
     tgc = C_cpu_milliseconds();
 
     if(gc_mode == GC_REALLOC) {
+      cell.val = "GC_REALLOC";
+      C_debugger(&cell, 0, NULL);
       C_rereclaim2(percentage(heap_size, C_heap_growth), 0);
       gc_mode = GC_MAJOR;
       count = (C_uword)tospace_top - (C_uword)tospace_start;
@@ -2804,6 +2833,8 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
 
     heap_scan_top = (C_byte *)C_align((C_uword)tospace_top);    
     gc_mode = GC_MAJOR;
+    cell.val = "GC_MAJOR";
+    C_debugger(&cell, 0, NULL);
 
     /* Mark items in forwarding table: */
     for(p = forwarding_table; *p != 0; p += 2) {
@@ -4380,6 +4411,9 @@ C_regparm C_word C_fcall C_fudge(C_word fudge_factor)
   case C_fix(43):		/* minor CHICKEN version */
     return C_fix(C_MINOR_VERSION);
 
+  case C_fix(44):  /* whether debugger is active */
+    return C_mk_bool(C_debugging);
+
   default: return C_SCHEME_UNDEFINED;
   }
 }
diff --git a/support.scm b/support.scm
index df30681..7b42b84 100644
--- a/support.scm
+++ b/support.scm
@@ -580,6 +580,11 @@
 		   (map walk (cddr x)) ) ) )
 	       ((##core#inline ##core#callunit) 
 		(make-node (car x) (list (cadr x)) (map walk (cddr x))) )
+	       ((##core#debug-event) 	; 2nd argument is provided by canonicalization phase
+		(make-node
+		 (car x)
+		 (cdr x)
+		 '()))
 	       ((##core#proc)
 		(make-node '##core#proc (list (cadr x) #t) '()) )
 	       ((set! ##core#set!)
@@ -1684,6 +1689,8 @@ Usage: chicken FILENAME OPTION ...
     -no-warnings                 disable warnings
     -debug-level NUMBER          set level of available debugging information
     -no-trace                    disable tracing information
+    -debug-info                  enable debug-information in compiled code for use
+                                  with an external debugger
     -profile                     executable emits profiling information 
     -profile-name FILENAME       name of the generated profile information file
     -accumulate-profile          executable emits profiling information in
-- 
1.7.9.5