Compare commits

...

2 Commits

2 changed files with 26 additions and 2 deletions

View File

@ -5,8 +5,10 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export ((make-vm* . make-vm) run-vm #:use-module (srfi srfi-43)
vm-memory-ref vm-memory-byte-ref vm-memory-set! vm-memory vm-load-program! #:export (make-stack (push . stack-push) (pop . stack-pop) (peek . stack-peek) stack-ref stack->list
(make-vm* . make-vm) run-vm
vm-memory-ref vm-memory-byte-ref vm-memory-set! vm-memory vm-load-program!
vm-data-stack vm-ret-stack vm-data-stack vm-ret-stack
vm-debugger vm-debugger-set! vm-debugger vm-debugger-set!
vm-pc vm-pc-set! vm-pc vm-pc-set!
@ -52,6 +54,9 @@
[(ref) [(ref)
(lambda (k) (lambda (k)
(vector-ref the-stack k))] (vector-ref the-stack k))]
[(->list)
(lambda ()
(reverse-vector->list the-stack 0 top))]
[else (error "stack dispatch unknown value")]))) [else (error "stack dispatch unknown value")])))
(define (push stack v) (define (push stack v)
@ -72,6 +77,9 @@
(define* (make-ram #:optional (memory-size *memory-size*)) (define* (make-ram #:optional (memory-size *memory-size*))
(make-bytevector memory-size #x00)) (make-bytevector memory-size #x00))
(define (stack->list stack)
((stack '->list)))
;;; IO ;;; IO
(define (read-word) (define (read-word)

View File

@ -1,6 +1,7 @@
(use-modules (d- test) (use-modules (d- test)
(scmvm assembler) (scmvm assembler)
(scmvm vm) (scmvm vm)
(scmvm debugger)
(rnrs bytevectors) (rnrs bytevectors)
(rnrs io ports) (rnrs io ports)
((scheme base) ((scheme base)
@ -129,3 +130,18 @@
(vm-pc-set! my-vm 5) (vm-pc-set! my-vm 5)
(run-vm my-vm) (run-vm my-vm)
(assert-equal 55 (vm-memory-ref my-vm 1)))) (assert-equal 55 (vm-memory-ref my-vm 1))))
(define-test-suite "debugger"
(define-test "modify-running-program"
(define my-debugger (make-debugger fib-program-asm))
(define my-vm (debugger-vm my-debugger))
(define my-data (vm-data-stack my-vm))
(vm-memory-set! my-vm 1 10)
(vm-pc-set! my-vm 5)
(debugger-breakpoint-add! my-debugger 'fib)
(debugger-continue my-debugger)
(assert-equal 10 (stack-peek my-data))
(stack-pop my-data)
(stack-push my-data 1)
(debugger-continue my-debugger)
(assert-equal 1 (vm-memory-ref my-vm 1))))