diff --git a/scmvm/debugger.scm b/scmvm/debugger.scm index 2ec2df1..98e7b77 100644 --- a/scmvm/debugger.scm +++ b/scmvm/debugger.scm @@ -23,25 +23,19 @@ (continuation debugger-continuation debugger-continuation-set!) (stepping debugger-stepping? debugger-stepping-set!)) -(define (make-breakpoints asm) - (define the-breakpoints '()) - (define (->index index/label) +(define* (make-breakpoints #:optional (convert identity)) + (define the-breakpoints (make-hash-table)) + (match-lambda + [(or 'add 'enable) (lambda (key) (hashq-set! the-breakpoints (convert key) #t))] + ['disable (lambda (key) (hashq-set! the-breakpoints (convert key) #f))] + ['delete (lambda (key) (hashq-remove! the-breakpoints (convert key)))] + ['ref (lambda (key) (hashq-ref the-breakpoints (convert key) #f))])) + +(define (label-converter asm) + (lambda (index/label) (if (number? index/label) index/label - (car (hash-ref (assembler-labels asm) 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))])) + (car (hash-ref (assembler-labels asm) index/label))))) (define (make-debugger* asm) (define prgm @@ -52,13 +46,13 @@ (define the-debugger #f) (define (debug) (shift k - (if (or (debugger-stepping? the-debugger) - (((debugger-breakpoints the-debugger) 'ref) (vm-pc (debugger-vm the-debugger)))) - (debugger-continuation-set! the-debugger k) - (k)))) + (if (or (debugger-stepping? the-debugger) + (((debugger-breakpoints the-debugger) 'ref) (vm-pc (debugger-vm the-debugger)))) + (debugger-continuation-set! the-debugger k) + (k)))) (define vm (make-vm (assembler-instruction-set asm) #:debugger debug)) (vm-load-program! vm prgm) - (set! the-debugger (make-debugger vm asm (make-breakpoints asm) #f #f)) + (set! the-debugger (make-debugger vm asm (make-breakpoints (label-converter asm)) #f #f)) (debugger-breakpoint-add! the-debugger 1) (reset (run-vm vm)) the-debugger)