diff --git a/lab/ikarus-debugger.ss b/lab/ikarus-debugger.ss
new file mode 100644
index 0000000..1151e11
--- /dev/null
+++ b/lab/ikarus-debugger.ss
@@ -0,0 +1,102 @@
+
+(import (ikarus) (ikarus.debugger))
+
+(define (operator? x)
+ (and (pair? x)
+      (eq? (car x) 'primitive)
+      (guard (con [(assertion-violation? con) #t])
+        (system-value (cadr x))
+        #f)))
+
+(define (get-src/expr ae)
+  (if (annotation? ae)
+      (cons (annotation-source ae) (annotation-stripped ae))
+      (cons #f (syntax->datum ae))))
+
+(define (add-debug-calls expr)
+  (define who 'add-debug-calls)
+  (define (direct-call? op rands)
+    (define n (length rands))
+    (define (test cls*)
+      (and (pair? cls*)
+           (or
+             (let ([fmls (caar cls*)])
+               (and (list? fmls) (= (length fmls) n)))
+             (test (cdr cls*)))))
+    (and (pair? op)
+         (case (car op)
+           [(lambda) (test (list (cdr op)))]
+           [(case-lambda) (test (cdr op))]
+           [(annotated-case-lambda) (test (cddr op))]
+           [else #f])))
+  (define (E-call src/expr op rands)
+    (cond
+      [(or (operator? op) (direct-call? op rands))
+       `(,(E op) ,@(map E rands))]
+      [else
+        `(',debug-call ',src/expr ,(E op) ,@(map E rands))]))
+  (define (E expr)
+    (cond
+      [(symbol? expr) expr]
+      [(and (pair? expr) (list? expr))
+       (let ([a (car expr)] [d (cdr expr)])
+         (case a
+           [(quote) expr]
+           [(primitive) expr]
+           [(set!) `(set! ,(car d) ,(E (cadr d)))]
+           [(if) `(if ,(E (car d)) ,(E (cadr d)) ,(E (caddr d)))]
+           [(begin) (cons 'begin (map E d))]
+           [(lambda) (list 'lambda (car d) (E (cadr d)))]
+           [(case-lambda)
+            (cons 'case-lambda
+              (map (lambda (x) (list (car x) (E (cadr x)))) d))]
+           [(annotated-case-lambda)
+            (cons* 'annotated-case-lambda (car d)
+              (map (lambda (x) (list (car x) (E (cadr x)))) (cdr d)))]
+           [(letrec letrec*)
+            (list a 
+              (map (lambda (x) (list (car x) (E (cadr x)))) (car d))
+              (E (cadr d)))]
+           [(foreign-call) 
+            (cons* 'foreign-call (car d) (map E (cdr d)))]
+           [(library-letrec*)
+            (list a 
+              (map (lambda (x) (list (car x) (cadr x) (E (caddr x)))) (car d))
+              (E (cadr d)))]
+           [(annotated-call)
+            (E-call (get-src/expr (car d)) (cadr d) (cddr d))]
+           [else (E-call #f a d)]))]
+      [else
+       (die who "invalid expression" expr)]))
+  (E expr))
+
+(define (start-repl)
+  (display "Ikarus Interpreter\n\n")
+  (new-cafe
+    (lambda (x)
+      (guarded-start
+        (lambda ()
+          (eval x (interaction-environment)))))))
+
+(define (start-script script-name args)
+  (command-line-arguments (cons script-name args))
+  (guarded-start
+    (lambda ()
+      (load-r6rs-script script-name #f #t))))
+ 
+(current-core-eval
+  (let ([ev (current-core-eval)])
+    (lambda (x)
+      (let ([x (add-debug-calls x)])
+        (ev x)))))
+
+(apply
+  (case-lambda
+    [(interpreter flag script-name . rest) 
+     (if (string=? flag "--r6rs-script") 
+         (start-script script-name rest)
+         (error interpreter "invalid args" (cons* flag script-name rest)))]
+    [(interpreter) (start-repl)]
+    [(interpreter . rest)
+     (error interpreter "invalid args" rest)])
+  (command-line-arguments))
diff --git a/lab/ikarus.debugger.ss b/lab/ikarus.debugger.ss
deleted file mode 100644
index 08fb769..0000000
--- a/lab/ikarus.debugger.ss
+++ /dev/null
@@ -1,307 +0,0 @@
-
-(import (ikarus))
-
-(define (with-output-to-string/limit x len)
-  (define n 0)
-  (define str (make-string len))
-  (call/cc
-    (lambda (k)
-      (define p
-        (make-custom-textual-output-port 
-          "*limited-port*"
-          (lambda (buf i count)
-            (let f ([i i] [count count])
-              (unless (zero? count)
-                (if (= n len)
-                    (k str)
-                    (begin
-                      (string-set! str n (string-ref buf i))
-                      (set! n (+ n 1))
-                      (f (+ i 1) (- count 1))))))
-            count)
-          #f #f #f))
-      (parameterize ([print-graph #f])
-        (write x p)
-        (flush-output-port p))
-      (substring str 0 n))))
-
-
-
-(define (make-annotated-procedure ann proc)
-  (import (ikarus system $codes))
-  ($make-annotated-procedure ann proc))
-
-(define-struct trace (src expr rator rands))
-
-(module (get-traces debug-call)
-
-  (define outer-ring-size 30)
-  (define inner-ring-size 10)
-
-  (define end-marker -1)
-
-  (define-struct icell (prev next num content))
-  (define-struct ocell (prev next num cf icell))
-
-  (define (make-ring n cell-prev cell-next cell-prev-set! cell-next-set! make-cell)
-    (let ([ring (make-cell)])
-      (cell-prev-set! ring ring)
-      (cell-next-set! ring ring)
-      (do ((n n (- n 1)))
-        ((<= n 1))
-        (let ([cell (make-cell)]
-              [next (cell-next ring)])
-          (cell-prev-set! cell ring)
-          (cell-next-set! cell next)
-          (cell-prev-set! next cell)
-          (cell-next-set! ring cell)))
-      ring))
-  
-  (define (make-double-ring n m)
-    (make-ring n
-      ocell-prev ocell-next set-ocell-prev! set-ocell-next!
-      (lambda ()
-        (make-ocell #f #f end-marker #f 
-          (make-ring m 
-            icell-prev icell-next set-icell-prev! set-icell-next!
-            (lambda () (make-icell #f #f end-marker (lambda () #f))))))))
-
-  (define (ring->list x cell-num cell-prev cell-content)
-    (let f ([x x] [orig #f])
-      (if (or (eq? x orig) (eqv? (cell-num x) end-marker))
-          '()
-           (cons (cons (cell-num x) (cell-content x))
-             (f (cell-prev x) (or orig x))))))
-   
-  (define (get-traces)
-    (ring->list step-ring ocell-num ocell-prev
-      (lambda (x)
-        (ring->list (ocell-icell x) icell-num icell-prev icell-content))))
-
-  (define step-ring 
-    (make-double-ring outer-ring-size inner-ring-size))
-
-  (define (debug-call src expr rator . rands)
-    (call/cf
-      (lambda (cf)
-        (if (eq? cf (ocell-cf step-ring))
-            (reduce src expr rator rands)
-            (let ([cf #f] [pcf #f])
-              (dynamic-wind
-                (lambda () 
-                  (let ([prev step-ring])
-                    (let ([next (ocell-next prev)])
-                      (set! pcf (ocell-cf prev))
-                      (set-ocell-num! next (+ (ocell-num prev) 1))
-                      (set-icell-num! (ocell-icell next) end-marker)
-                      (set! step-ring next)
-                      (set-ocell-cf! step-ring cf))))
-                (lambda ()
-                  (call/cf
-                    (lambda (cf2)
-                      (set! cf cf2)
-                      (set-ocell-cf! step-ring cf)
-                      (reduce src expr rator rands))))
-                (lambda ()
-                  (let ([next step-ring])
-                    (let ([prev (ocell-prev next)])
-                      (set-ocell-num! prev (- (ocell-num next) 1))
-                      (set-ocell-num! next end-marker)
-                      (set-icell-num! (ocell-icell next) end-marker)
-                      (set-ocell-cf! prev pcf)
-                      (set! step-ring prev))))))))))
-
-  (define (reduce src expr rator rands)
-    (define (mark-reduction! x)
-      (let ([prev (ocell-icell step-ring)])
-        (let ([next (icell-next prev)])
-          (set-icell-content! next x)
-          (set-icell-num! next (+ (icell-num prev) 1))
-          (set-ocell-icell! step-ring next))))
-    (mark-reduction! (make-trace src expr rator rands))
-    (apply rator rands))
-
-)
-
-
-(define (operator? x)
- (and (pair? x)
-      (eq? (car x) 'primitive)
-      (guard (con [(assertion-violation? con) #t])
-        (system-value (cadr x))
-        #f)))
-
-
-(define (get-src/expr ae)
-  (if (annotation? ae)
-      (values (annotation-source ae) (annotation-stripped ae))
-      (values #f (syntax->datum ae))))
-
-
-(define (add-debug-calls expr)
-  (define who 'add-debug-calls)
-  (define (direct-call? op rands)
-    (define n (length rands))
-    (define (test cls*)
-      (and (pair? cls*)
-           (or
-             (let ([fmls (caar cls*)])
-               (and (list? fmls) (= (length fmls) n)))
-             (test (cdr cls*)))))
-    (and (pair? op)
-         (case (car op)
-           [(lambda) (test (list (cdr op)))]
-           [(case-lambda) (test (cdr op))]
-           [(annotated-case-lambda) (test (cddr op))]
-           [else #f])))
-  (define (E-call src expr op rands)
-    (cond
-      [(or (operator? op) (direct-call? op rands))
-       `(,op ,@(map E rands))]
-      [else
-        `(',debug-call ',src ',expr ,(E op) ,@(map E rands))]))
-  (define (E expr)
-    (cond
-      [(symbol? expr) expr]
-      [(and (pair? expr) (list? expr))
-       (let ([a (car expr)] [d (cdr expr)])
-         (case a
-           [(quote) expr]
-           [(primitive) expr]
-           [(set!) `(set! ,(car d) ,(E (cadr d)))]
-           [(if) `(if ,(E (car d)) ,(E (cadr d)) ,(E (caddr d)))]
-           [(begin) (cons 'begin (map E d))]
-           [(lambda) (list 'lambda (car d) (E (cadr d)))]
-           [(case-lambda)
-            (cons 'case-lambda
-              (map (lambda (x) (list (car x) (E (cadr x)))) d))]
-           [(annotated-case-lambda)
-            (cons* 'annotated-case-lambda (car d)
-              (map (lambda (x) (list (car x) (E (cadr x)))) (cdr d)))]
-           [(letrec letrec*)
-            (list a 
-              (map (lambda (x) (list (car x) (E (cadr x)))) (car d))
-              (E (cadr d)))]
-           [(foreign-call) 
-            (cons* 'foreign-call (car d) (map E (cdr d)))]
-           [(library-letrec*)
-            (list a 
-              (map (lambda (x) (list (car x) (cadr x) (E (caddr x)))) (car d))
-              (E (cadr d)))]
-           [(annotated-call)
-            (let-values ([(src expr) (get-src/expr (car d))])
-              (E-call src expr (cadr d) (cddr d)))]
-           [else (E-call #f #f a d)]))]
-      [else
-       (die who "invalid expression" expr)]))
-  (E expr))
-
-
-(define (print-trace x)
-  (define (chop x)
-    (if (> (string-length x) 60)
-        (format "~a#..." (substring x 0 56))
-        x))
-  (let ([n (car x)] [x (cdr x)])
-    (printf " [~a] ~s\n" n (trace-expr x))
-    (let ([src (trace-src x)])
-      (when (pair? src)
-        (printf "     source: char ~a of ~a\n" (cdr src) (car src))))
-    (printf "     operator: ~s\n" (trace-rator x))
-    (printf "     operands: ")
-    (let ([ls (map (lambda (x) 
-                     (with-output-to-string/limit x 80))
-                   (trace-rands x))])
-      (if (< (apply + 1 (length ls) (map string-length ls)) 60)
-          (write (trace-rands x))
-          (begin
-            (display "(")
-            (let f ([a (car ls)] [ls (cdr ls)])
-              (display (chop a))
-              (if (null? ls)
-                  (display ")")
-                  (begin 
-                    (display "\n                ") 
-                    (f (car ls) (cdr ls))))))))
-    (newline)))
-
-(define (print-step x)
-  (let ([n (car x)] [ls (cdr x)])
-    (unless (null? ls)
-      (printf "FRAME ~s:\n" n)
-      (for-each print-trace (reverse ls)))))
-
-(define (print-all-traces)
-  (let ([ls (reverse (get-traces))])
-    (printf "CALL FRAMES:\n")
-    (for-each print-step ls)))
-
-(define (guarded-start proc)
-  (with-exception-handler
-    (lambda (con)
-      (define (help)
-        (printf "Condition trapped by debugger.\n")
-        (print-condition con)
-        (printf "~a\n" 
-          (string-append 
-            "[t] Trace. "
-            "[r] Reraise condition. "
-            "[c] Continue "
-            "[q] Quit "
-            "[?] Help. ")))
-      (help)
-      ((call/cc
-         (lambda (k)
-           (new-cafe
-             (lambda (x)
-               (case x
-                [(R r) (k (lambda () (raise-continuable con)))]
-                [(Q q) (exit 0)]
-                [(T t) (print-all-traces)]
-                [(C c) (k void)]
-                [(?)   (help)]
-                [else (printf "invalid option\n")])))
-           void))))
-    proc))
-
-(define (start-repl)
-  (display "Ikarus Interpreter\n\n")
-  (new-cafe
-    (lambda (x)
-      (guarded-start
-        (lambda ()
-          (eval x (interaction-environment)))))))
-
-(define (start-script script-name args)
-  (command-line-arguments (cons script-name args))
-  (guarded-start
-    (lambda ()
-      (load-r6rs-script script-name #f #t))))
- 
-(current-core-eval
-  (let ([ev (current-core-eval)])
-    (lambda (x)
-      (ev (add-debug-calls x)))))
-
-(apply
-  (case-lambda
-    [(interpreter flag script-name . rest) 
-     (if (string=? flag "--r6rs-script") 
-         (start-script script-name rest)
-         (error interpreter "invalid args" (cons* flag script-name rest)))]
-    [(interpreter) (start-repl)]
-    [(interpreter . rest)
-     (error interpreter "invalid args" rest)])
-  (command-line-arguments))
-
-
- 
-
-
-#!eof
-
-(print-graph #t)
-
-;(write (make-double-rib 5 5))
-(write (make-ring 10 (lambda () #f)))
-(newline)
diff --git a/scheme/Makefile.am b/scheme/Makefile.am
index d00fb97..88c13d3 100644
--- a/scheme/Makefile.am
+++ b/scheme/Makefile.am
@@ -38,6 +38,7 @@ EXTRA_DIST=ikarus.boot.4.prebuilt ikarus.boot.8.prebuilt last-revision \
   ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
   ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss \
   ikarus.symbol-table.ss ikarus.apropos.ss ikarus.include-src.ss \
+  ikarus.debugger.ss \
   tests/SRFI-1.ss \
   tests/bignum-to-flonum.ss \
   tests/bignums.ss \
diff --git a/scheme/Makefile.in b/scheme/Makefile.in
index b28660e..afac5d8 100644
--- a/scheme/Makefile.in
+++ b/scheme/Makefile.in
@@ -193,6 +193,7 @@ EXTRA_DIST = ikarus.boot.4.prebuilt ikarus.boot.8.prebuilt last-revision \
   ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
   ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss \
   ikarus.symbol-table.ss ikarus.apropos.ss ikarus.include-src.ss \
+  ikarus.debugger.ss \
   tests/SRFI-1.ss \
   tests/bignum-to-flonum.ss \
   tests/bignums.ss \
diff --git a/scheme/ikarus.compiler.ss b/scheme/ikarus.compiler.ss
index a0bd079..5ad8595 100644
--- a/scheme/ikarus.compiler.ss
+++ b/scheme/ikarus.compiler.ss
@@ -22,7 +22,7 @@
           compile-core-expr expand/optimize optimizer-output
           cp0-effort-limit cp0-size-limit optimize-level 
           perform-tag-analysis tag-analysis-output
-          strip-source-info)
+          strip-source-info generate-debug-calls)
   (import 
     (rnrs hashtables)
     (ikarus system $fx)
@@ -44,6 +44,7 @@
 
 
 (define strip-source-info (make-parameter #f))
+(define generate-debug-calls (make-parameter #f))
 
 (define-syntax struct-case
   (lambda (x)
@@ -309,7 +310,7 @@
                     (list? fml*)) 
                   body))))))
            cls*))
-  (define (E-make-parameter args ctxt)
+  (define (E-make-parameter mk-call args ctxt)
     (case (length args)
       [(1)
        (let ([val-expr (car args)]
@@ -345,15 +346,15 @@
               ,guard-expr)
             ctxt))]
       [else 
-       (make-funcall 
+       (mk-call 
          (make-primref 'make-parameter)
          (map (lambda (x) (E x #f)) args))]))
-  (define (E-app rator args ctxt)
+  (define (E-app mk-call rator args ctxt)
     (equal-case rator
-      [((primitive make-parameter)) (E-make-parameter args ctxt)]
+      [((primitive make-parameter)) (E-make-parameter mk-call args ctxt)]
       [else
        (let ([names (get-fmls rator args)])
-         (make-funcall 
+         (mk-call 
            (E rator (list ctxt))
            (let f ([args args] [names names])
              (cond
@@ -443,8 +444,29 @@
           (let ([var (cadr x)])
             (make-primref var))]
          [(annotated-call) 
-          (E-app (caddr x) (cdddr x) ctxt)]
-         [else (E-app (car x) (cdr x) ctxt)])]
+          (E-app
+            (if (generate-debug-calls)
+                (lambda (op rands)
+                  (define (operator? x)
+                    (struct-case x
+                      [(primref x) 
+                       (guard (con [(assertion-violation? con) #t])
+                         (system-value x)
+                         #f)]
+                      [else #f]))
+                  (define (get-src/expr ae)
+                    (if (annotation? ae)
+                        (cons (annotation-source ae) (annotation-stripped ae))
+                        (cons #f (syntax->datum ae))))
+                  (define src/expr 
+                    (make-constant (get-src/expr (cadr x))))
+                  (if (operator? op)
+                      (make-funcall op rands)
+                      (make-funcall (make-primref 'debug-call)
+                        (cons* src/expr op rands))))
+                make-funcall)
+            (caddr x) (cdddr x) ctxt)]
+         [else (E-app make-funcall (car x) (cdr x) ctxt)])]
       [(symbol? x)
        (cond
          [(lexical x) =>
@@ -684,7 +706,7 @@
       [(null? cls*) default]
       [(inline-case (car cls*) rand*)]
       [else (try-inline (cdr cls*) rand* default)]))
-  (define (inline rator rand*)
+  (define (inline mk rator rand*)
     (define (valid-mv-consumer? x)
       (struct-case x
         [(clambda L cases F)
@@ -714,7 +736,7 @@
     (struct-case rator
       [(clambda g cls*)
        (try-inline cls* rand*
-          (make-funcall rator rand*))]
+          (mk rator rand*))]
       [(primref op)
        (case op
          ;;; FIXME HERE
@@ -732,36 +754,42 @@
                  [else 
                   (make-funcall rator rand*)]))]
             [else
-             (make-funcall rator rand*)])]
+             (mk rator rand*)])]
+         [(debug-call)
+          (inline 
+            (lambda (op^ rand*^) 
+              (mk rator (cons* (car rand*) op^ rand*^)))
+            (cadr rand*)
+            (cddr rand*))]
          [else
-          (make-funcall rator rand*)])]
+          (mk rator rand*)])]
       [(bind lhs* rhs* body)
        (if (null? lhs*)
-           (inline body rand*)
+           (inline mk body rand*)
            (make-bind lhs* rhs* 
-             (call-expr body rand*)))]
+             (call-expr mk body rand*)))]
       [(recbind lhs* rhs* body)
        (if (null? lhs*)
-           (inline body rand*)
+           (inline mk body rand*)
            (make-recbind lhs* rhs* 
-             (call-expr body rand*)))]
+             (call-expr mk body rand*)))]
       [(rec*bind lhs* rhs* body)
        (if (null? lhs*)
-           (inline body rand*)
+           (inline mk body rand*)
            (make-rec*bind lhs* rhs* 
-             (call-expr body rand*)))] 
-      [else (make-funcall rator rand*)]))
-  (define (call-expr x rand*)
+             (call-expr mk body rand*)))] 
+      [else (mk rator rand*)]))
+  (define (call-expr mk x rand*)
     (cond
-      [(clambda? x) (inline x rand*)]
+      [(clambda? x) (inline mk x rand*)]
       [(and (prelex? x) (not (prelex-source-assigned? x))) 
        ;;; FIXME: did we do the analysis yet?
-       (make-funcall x rand*)]
+       (mk x rand*)]
       [else
        (let ([t (make-prelex 'tmp #f)])
          (set-prelex-source-referenced?! t #t)
          (make-bind (list t) (list x)
-           (make-funcall t rand*)))]))
+           (mk t rand*)))]))
   (define (Expr x)
     (struct-case x
       [(constant) x]
@@ -789,7 +817,7 @@
               cls*)
          cp free name)]
       [(funcall rator rand*)
-       (inline (Expr rator) (map Expr rand*))]
+       (inline make-funcall (Expr rator) (map Expr rand*))]
       [(forcall rator rand*) 
        (make-forcall rator (map Expr rand*))]
       [(assign lhs rhs)
diff --git a/scheme/ikarus.debugger.ss b/scheme/ikarus.debugger.ss
new file mode 100644
index 0000000..c61df9b
--- /dev/null
+++ b/scheme/ikarus.debugger.ss
@@ -0,0 +1,194 @@
+
+(library (ikarus.debugger)
+  (export debug-call guarded-start)
+  (import (ikarus))
+
+  (define (with-output-to-string/limit x len)
+    (define n 0)
+    (define str (make-string len))
+    (call/cc
+      (lambda (k)
+        (define p
+          (make-custom-textual-output-port
+            "*limited-port*"
+            (lambda (buf i count)
+              (let f ([i i] [count count])
+                (unless (zero? count)
+                  (if (= n len)
+                      (k str)
+                      (begin
+                        (string-set! str n (string-ref buf i))
+                        (set! n (+ n 1))
+                        (f (+ i 1) (- count 1))))))
+              count)
+            #f #f #f))
+        (parameterize ([print-graph #f])
+          (write x p)
+          (flush-output-port p))
+        (substring str 0 n))))
+
+  (define-struct trace (src/expr rator rands))
+
+  (define (trace-src x) 
+    (let ([x (trace-src/expr x)])
+      (if (pair? x) (car x) #f)))
+  (define (trace-expr x) 
+    (let ([x (trace-src/expr x)])
+      (if (pair? x) (cdr x) #f)))
+
+  (module (get-traces debug-call)
+
+    (define outer-ring-size 16)
+    (define inner-ring-size 8)
+
+    (define end-marker -1)
+
+    (define-struct icell (prev next num content))
+    (define-struct ocell (prev next num cf icell))
+
+    (define (make-ring n cell-prev cell-next cell-prev-set! cell-next-set! make-cell)
+      (let ([ring (make-cell)])
+        (cell-prev-set! ring ring)
+        (cell-next-set! ring ring)
+        (do ((n n (- n 1)))
+          ((<= n 1))
+          (let ([cell (make-cell)]
+                [next (cell-next ring)])
+            (cell-prev-set! cell ring)
+            (cell-next-set! cell next)
+            (cell-prev-set! next cell)
+            (cell-next-set! ring cell)))
+        ring))
+
+    (define (make-double-ring n m)
+      (make-ring n
+        ocell-prev ocell-next set-ocell-prev! set-ocell-next!
+        (lambda ()
+          (make-ocell #f #f end-marker #f
+            (make-ring m
+              icell-prev icell-next set-icell-prev! set-icell-next!
+              (lambda () (make-icell #f #f end-marker (lambda () #f))))))))
+
+    (define (ring->list x cell-num cell-prev cell-content)
+      (let f ([x x] [orig #f])
+        (if (or (eq? x orig) (eqv? (cell-num x) end-marker))
+            '()
+             (cons (cons (cell-num x) (cell-content x))
+               (f (cell-prev x) (or orig x))))))
+
+    (define (get-traces)
+      (ring->list step-ring ocell-num ocell-prev
+        (lambda (x)
+          (ring->list (ocell-icell x) icell-num icell-prev icell-content))))
+
+    (define step-ring
+      (make-double-ring outer-ring-size inner-ring-size))
+
+    (define (debug-call src/expr rator . rands)
+      (call/cf
+        (lambda (cf)
+          (if (eq? cf (ocell-cf step-ring))
+              (reduce src/expr rator rands)
+              (let ([cf #f] [pcf #f])
+                (dynamic-wind
+                  (lambda ()
+                    (let ([prev step-ring])
+                      (let ([next (ocell-next prev)])
+                        (set! pcf (ocell-cf prev))
+                        (set-ocell-num! next (+ (ocell-num prev) 1))
+                        (set-icell-num! (ocell-icell next) end-marker)
+                        (set! step-ring next)
+                        (set-ocell-cf! step-ring cf))))
+                  (lambda ()
+                    (call/cf
+                      (lambda (cf2)
+                        (set! cf cf2)
+                        (set-ocell-cf! step-ring cf)
+                        (reduce src/expr rator rands))))
+                  (lambda ()
+                    (let ([next step-ring])
+                      (let ([prev (ocell-prev next)])
+                        (set-ocell-num! prev (- (ocell-num next) 1))
+                        (set-ocell-num! next end-marker)
+                        (set-icell-num! (ocell-icell next) end-marker)
+                        (set-ocell-cf! prev pcf)
+                        (set! step-ring prev))))))))))
+
+    (define (reduce src/expr rator rands)
+      (define (mark-reduction! x)
+        (let ([prev (ocell-icell step-ring)])
+          (let ([next (icell-next prev)])
+            (set-icell-content! next x)
+            (set-icell-num! next (+ (icell-num prev) 1))
+            (set-ocell-icell! step-ring next))))
+      (mark-reduction! (make-trace src/expr rator rands))
+      (apply rator rands)))
+
+  (define (print-trace x)
+    (define (chop x)
+      (if (> (string-length x) 60)
+          (format "~a#..." (substring x 0 56))
+          x))
+    (let ([n (car x)] [x (cdr x)])
+      (printf " [~a] ~s\n" n (trace-expr x))
+      (let ([src (trace-src x)])
+        (when (pair? src)
+          (printf "     source: char ~a of ~a\n" (cdr src) (car src))))
+      (printf "     operator: ~s\n" (trace-rator x))
+      (printf "     operands: ")
+      (let ([ls (map (lambda (x)
+                       (with-output-to-string/limit x 80))
+                     (trace-rands x))])
+        (if (< (apply + 1 (length ls) (map string-length ls)) 60)
+            (write (trace-rands x))
+            (begin
+              (display "(")
+              (let f ([a (car ls)] [ls (cdr ls)])
+                (display (chop a))
+                (if (null? ls)
+                    (display ")")
+                    (begin
+                      (display "\n                ")
+                      (f (car ls) (cdr ls))))))))
+      (newline)))
+
+  (define (print-step x)
+    (let ([n (car x)] [ls (cdr x)])
+      (unless (null? ls)
+        (printf "FRAME ~s:\n" n)
+        (for-each print-trace (reverse ls)))))
+
+  (define (print-all-traces)
+    (let ([ls (reverse (get-traces))])
+      (printf "CALL FRAMES:\n")
+      (for-each print-step ls)))
+
+  (define (guarded-start proc)
+    (with-exception-handler
+      (lambda (con)
+        (define (help)
+          (printf "Condition trapped by debugger.\n")
+          (print-condition con)
+          (printf "~a\n"
+            (string-append
+              "[t] Trace. "
+              "[r] Reraise condition. "
+              "[c] Continue. "
+              "[q] Quit. "
+              "[?] Help. ")))
+        (help)
+        ((call/cc
+           (lambda (k)
+             (new-cafe
+               (lambda (x)
+                 (case x
+                  [(R r) (k (lambda () (raise-continuable con)))]
+                  [(Q q) (exit 0)]
+                  [(T t) (print-all-traces)]
+                  [(C c) (k void)]
+                  [(?)   (help)]
+                  [else (printf "invalid option\n")])))
+             void))))
+      proc))
+
+)
diff --git a/scheme/ikarus.main.ss b/scheme/ikarus.main.ss
index eb4b75e..dadd6fd 100644
--- a/scheme/ikarus.main.ss
+++ b/scheme/ikarus.main.ss
@@ -76,6 +76,8 @@
   (export)
   (import (except (ikarus) load-r6rs-script)
           (except (ikarus startup) host-info)
+          (only (ikarus.compiler) generate-debug-calls)
+          (ikarus.debugger)
           (only (psyntax library-manager) current-library-expander)
           (only (ikarus.reader.annotated) read-source-file)
           (only (ikarus.symbol-table) initialize-symbol-table!)
@@ -86,6 +88,12 @@
                 (let f ([args (command-line-arguments)])
                   (cond
                     [(null? args) (values '() #f #f '())]
+                    [(member (car args) '("-d" "--debug"))
+                     (generate-debug-calls #t)
+                     (f (cdr args))]
+                    [(member (car args) '("-nd" "--no-debug"))
+                     (generate-debug-calls #f)
+                     (f (cdr args))]
                     [(string=? (car args) "-O2")
                      (optimize-level 2)
                      (f (cdr args))]
@@ -127,31 +135,44 @@
         (apply die 'ikarus
           (format "load files not allowed for ~a" who)
           files)))
+
+    (define (start proc)
+      (if (generate-debug-calls)
+          (guarded-start proc)
+          (proc)))
+    (define-syntax doit
+      (syntax-rules ()
+        [(_ e e* ...)
+         (start (lambda () e e* ...))]))
+    
     (cond
       [(eq? script-type 'r6rs-script)
-       (command-line-arguments (cons script args))
-       (for-each
-         (lambda (filename)
-           (for-each
-             (lambda (src)
-               ((current-library-expander) src))
-             (read-source-file filename)))
-         files)
-       (load-r6rs-script script #f #t)
-       (exit 0)]
+       (doit
+         (command-line-arguments (cons script args))
+         (for-each
+           (lambda (filename)
+             (for-each
+               (lambda (src)
+                 ((current-library-expander) src))
+               (read-source-file filename)))
+           files)
+         (load-r6rs-script script #f #t))]
       [(eq? script-type 'compile)
        (assert-null files "--compile-dependencies")
-       (command-line-arguments (cons script args))
-       (load-r6rs-script script #t #f)
-       (exit 0)]
+       (doit
+         (command-line-arguments (cons script args))
+         (load-r6rs-script script #t #f))]
       [(eq? script-type 'script) ; no greeting, no cafe
        (command-line-arguments (cons script args))
-       (for-each load files)
-       (load script)
-       (exit 0)]
+       (doit
+         (for-each load files)
+         (load script))]
       [else
        (print-greeting)
        (command-line-arguments (cons "*interactive*" args))
-       (for-each load files)
-       (new-cafe)
-       (exit 0)])))
+       (doit (for-each load files))
+       (new-cafe
+         (lambda (x)
+           (doit (eval x (interaction-environment)))))])
+
+    (exit 0)))
diff --git a/scheme/last-revision b/scheme/last-revision
index adafbb5..838cfd7 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1779
+1780
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 67f2b7b..e63d7c7 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -111,6 +111,7 @@
     "ikarus.command-line.ss"
     "ikarus.pointers.ss"
     "ikarus.not-yet-implemented.ss"
+    "ikarus.debugger.ss"
     "ikarus.main.ss"
     ))
 
@@ -1530,7 +1531,8 @@
     [pointer-set-c-double!             $for]
     [make-c-callout                    $for]
     [make-c-callback                   $for]
-    [host-info                       i]
+    [host-info                         i]
+    [debug-call                        ]
 
   ))