- modified the ikarus debugger to use the same continuation frame
structure as the one the tracer uses.
This commit is contained in:
parent
1781866f1c
commit
beb3845e9d
|
@ -27,6 +27,41 @@
|
|||
(flush-output-port p))
|
||||
(substring str 0 n))))
|
||||
|
||||
(define-struct scell (cf ocell prev))
|
||||
|
||||
(define (mkcell prev)
|
||||
(make-scell #f #f prev))
|
||||
|
||||
(define *scell* (mkcell #f))
|
||||
|
||||
(define (stacked-call pre thunk post)
|
||||
(call/cf
|
||||
(lambda (cf)
|
||||
(if (eq? cf (scell-cf *scell*))
|
||||
(thunk)
|
||||
(dynamic-wind
|
||||
(let ([scell (mkcell *scell*)])
|
||||
(lambda ()
|
||||
(set! *scell* scell)
|
||||
(pre)))
|
||||
(lambda ()
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(call/cf
|
||||
(lambda (cf)
|
||||
(set-scell-cf! *scell* cf)
|
||||
(thunk))))
|
||||
return-handler))
|
||||
(lambda ()
|
||||
(post)
|
||||
(set! *scell* (scell-prev *scell*))))))))
|
||||
|
||||
(define return-handler
|
||||
(lambda v*
|
||||
(set-scell-ocell! *scell* #f)
|
||||
(apply values v*)))
|
||||
|
||||
|
||||
(define-struct trace (src/expr rator rands))
|
||||
|
||||
(define (trace-src x)
|
||||
|
@ -44,7 +79,7 @@
|
|||
(define end-marker -1)
|
||||
|
||||
(define-struct icell (prev next num content))
|
||||
(define-struct ocell (prev next num cf icell))
|
||||
(define-struct ocell (prev next num icell))
|
||||
|
||||
(define (make-ring n cell-prev cell-next cell-prev-set! cell-next-set! make-cell)
|
||||
(let ([ring (make-cell)])
|
||||
|
@ -64,7 +99,7 @@
|
|||
(make-ring n
|
||||
ocell-prev ocell-next set-ocell-prev! set-ocell-next!
|
||||
(lambda ()
|
||||
(make-ocell #f #f end-marker #f
|
||||
(make-ocell #f #f end-marker
|
||||
(make-ring m
|
||||
icell-prev icell-next set-icell-prev! set-icell-next!
|
||||
(lambda () (make-icell #f #f end-marker (lambda () #f))))))))
|
||||
|
@ -85,44 +120,31 @@
|
|||
(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))))))))))
|
||||
(stacked-call
|
||||
(lambda ()
|
||||
(let ([prev step-ring])
|
||||
(let ([next (ocell-next prev)])
|
||||
(set-ocell-num! next (+ (ocell-num prev) 1))
|
||||
(set-icell-num! (ocell-icell next) end-marker)
|
||||
(set! step-ring next))))
|
||||
(lambda ()
|
||||
(set-scell-ocell! *scell* step-ring)
|
||||
(let ([trace (make-trace src/expr rator rands)])
|
||||
(let ([prev (ocell-icell step-ring)])
|
||||
(let ([next (icell-next prev)])
|
||||
(set-icell-content! next trace)
|
||||
(set-icell-num! next (+ (icell-num prev) 1))
|
||||
(set-ocell-icell! step-ring next))))
|
||||
(apply 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! 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)
|
||||
|
|
|
@ -1 +1 @@
|
|||
1782
|
||||
1783
|
||||
|
|
|
@ -89,7 +89,6 @@
|
|||
"ikarus.reader.annotated.ss"
|
||||
"ikarus.code-objects.ss"
|
||||
"ikarus.intel-assembler.ss"
|
||||
"ikarus.trace.ss"
|
||||
"ikarus.fasl.write.ss"
|
||||
"ikarus.fasl.ss"
|
||||
"ikarus.compiler.ss"
|
||||
|
@ -111,6 +110,7 @@
|
|||
"ikarus.command-line.ss"
|
||||
"ikarus.pointers.ss"
|
||||
"ikarus.not-yet-implemented.ss"
|
||||
"ikarus.trace.ss"
|
||||
"ikarus.debugger.ss"
|
||||
"ikarus.main.ss"
|
||||
))
|
||||
|
|
Loading…
Reference in New Issue