80 lines
2.8 KiB
Scheme
80 lines
2.8 KiB
Scheme
(define-module (scmvm debugger)
|
|
#:use-module (scmvm assembler)
|
|
#:use-module (scmvm vm)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (ice-9 control)
|
|
#:use-module (ice-9 binary-ports)
|
|
#:use-module (ice-9 exceptions)
|
|
#:use-module (ice-9 match)
|
|
#:export ((make-debugger* . make-debugger) debugger-vm debugger-source
|
|
debugger-breakpoints debugger-breakpoints-set!
|
|
debugger-breakpoint-add! debugger-breakpoint-ref
|
|
debugger-breakpoint-enable! debugger-breakpoint-disable!
|
|
debugger-breakpoint-delete!
|
|
debugger-continue))
|
|
|
|
(define-record-type <debugger>
|
|
(make-debugger vm source breakpoints continuation)
|
|
debugger?
|
|
(vm debugger-vm)
|
|
(source debugger-source)
|
|
(breakpoints debugger-breakpoints)
|
|
(continuation debugger-continuation debugger-continuation-set!))
|
|
|
|
(define (make-breakpoints labels)
|
|
(define the-breakpoints '())
|
|
(define (->index index/label)
|
|
(if (number? index/label)
|
|
index/label
|
|
(assq-ref labels index/label)))
|
|
(define-syntax-rule (ilambda (i) e ...)
|
|
(lambda (v) (let ([i (->index v)]) e ...)))
|
|
(match-lambda
|
|
['add
|
|
(ilambda (i) (set! the-breakpoints (acons i #t the-breakpoints)))]
|
|
['delete
|
|
(ilambda (i) (set! the-breakpoints (assq-remove! the-breakpoints i)))]
|
|
['enable
|
|
(ilambda (i) (set! the-breakpoints (assq-set! the-breakpoints i #t)))]
|
|
['disable
|
|
(ilambda (i) (set! the-breakpoints (assq-set! the-breakpoints i #f)))]
|
|
['ref
|
|
(ilambda (i) (assq-ref the-breakpoints i))]))
|
|
|
|
(define (make-debugger* source)
|
|
(define-values (prgm symbols)
|
|
(call-with-values open-bytevector-output-port
|
|
(lambda (port get-bv)
|
|
(define symbols (assemble source port))
|
|
(values (get-bv) symbols))))
|
|
(define the-debugger #f)
|
|
(define (debug)
|
|
(shift k
|
|
(if (((debugger-breakpoints the-debugger) 'ref) (vm-pc (debugger-vm the-debugger)))
|
|
(debugger-continuation-set! the-debugger k)
|
|
(k))))
|
|
(define vm (make-vm #:debugger debug))
|
|
(vm-load-program! vm prgm)
|
|
(set! the-debugger (make-debugger vm source (make-breakpoints symbols) #f))
|
|
(reset (run-vm vm))
|
|
the-debugger)
|
|
|
|
(define (debugger-continue debugger)
|
|
((debugger-continuation debugger)))
|
|
|
|
(define (debugger-breakpoint-add! debugger breakpoint)
|
|
(((debugger-breakpoints debugger) 'add) breakpoint))
|
|
|
|
(define (debugger-breakpoint-ref debugger breakpoint)
|
|
(((debugger-breakpoints debugger) 'ref) breakpoint))
|
|
|
|
(define (debugger-breakpoint-enable! debugger breakpoint)
|
|
(((debugger-breakpoints debugger) 'enable) breakpoint))
|
|
|
|
(define (debugger-breakpoint-disable! debugger breakpoint)
|
|
(((debugger-breakpoints debugger) 'disable) breakpoint))
|
|
|
|
(define (debugger-breakpoint-delete! debugger breakpoint)
|
|
(((debugger-breakpoints debugger) 'delete) breakpoint))
|