Delete old vm

scmvm/debugger.scm

@@ -1,13 +1,14 @@
 (define-module (scmvm debugger)
   #:use-module (scmvm assembler)
   #:use-module (scmvm vm)
+  #:use-module (scmvm vm forth)
   #: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
+  #:export (make-forth-debugger debugger-vm debugger-source
             debugger-breakpoints debugger-breakpoints-set!
             debugger-breakpoint-add! debugger-breakpoint-ref
             debugger-breakpoint-enable! debugger-breakpoint-disable!
@@ -37,7 +38,7 @@
         index/label
         (car (hash-ref (assembler-labels asm) index/label)))))
 
-(define (make-debugger* asm)
+(define (make-forth-debugger asm)
   (define prgm
     (call-with-values open-bytevector-output-port
       (lambda (port get-bv)
@@ -47,14 +48,14 @@
   (define (debug)
     (shift k
            (if (or (debugger-stepping? the-debugger)
-                   (((debugger-breakpoints the-debugger) 'ref) (vm-pc (debugger-vm the-debugger))))
+                   (((debugger-breakpoints the-debugger) 'ref) (forth-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)
+  (define vm (make-forth-vm (assembler-instruction-set asm)))
+  (forth-vm-load-program! vm prgm)
   (set! the-debugger (make-debugger vm asm (make-breakpoints (label-converter asm)) #f #f))
   (debugger-breakpoint-add! the-debugger 1)
-  (reset (run-vm vm))
+  (reset (forth-vm-run! vm debug))
   the-debugger)
 
 (define (debugger-continue debugger)

scmvm/util/stack.scm

@@ -1,7 +1,8 @@
 (define-module (scmvm util stack)
   #:use-module (srfi srfi-43)
-  #:export (make-stack stack-ref stack->list stack-set!
-                       (push . stack-push) (pop . stack-pop) (peek . stack-peek) (swap . stack-swap)))
+  #:replace (make-stack)
+  #:export (stack-ref stack->list stack-set!
+            (push . stack-push) (pop . stack-pop) (peek . stack-peek) (swap . stack-swap)))
 
 ;; Stack data structure. I made this a closure implementation for some reason
 

scmvm/vm.scm

@@ -1,37 +1,16 @@
 (define-module (scmvm vm)
-  #:use-module ((scheme base)
-                #:select (read-u8 read-bytevector))
-  #:use-module (rnrs bytevectors)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-43)
-  #:use-module (ice-9 format)
-  #:use-module (scmvm util stack)
-  #:export ((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-debugger vm-debugger-set!
-	    vm-pc vm-pc-set!
-            vm-instruction-set
-            instruction-lookup instruction-name instruction-code
-	    forth-instruction-set))
-
-;;; IO
-(define *memory-size* 2048)
+  #:use-module (ice-9 hash-table)
+  #:export (define-instruction-set
+             instruction-lookup
+             instruction-set-caller
+             instruction-name
+             instruction-code
+             register-set))
 
-(define* (make-ram #:optional (memory-size *memory-size*))
-  (make-bytevector memory-size #x00))
-
-(define (read-word)
-  "Read the next 32-bit value from (current-input-port)"
-  (let ([bv (read-bytevector 4)])
-    (bytevector-s32-ref bv 0 (native-endianness))))
-
 ;;; Instructions
 (define-syntax define-instruction-set
   (syntax-rules (define-instruction)
-    [(_ set-name (define-instruction (name opcode) impl ...) ...)
+    [(_ (set-name reg ...) (define-instruction (name opcode) impl ...) ...)
      (define (set-name dispatch)
        (case dispatch
          [(lookup)
@@ -40,207 +19,21 @@
               [(name) '(name opcode)] ...
               [else #f]))]
          [(call)
-          (lambda (op)
-            (case op
-              [(opcode) impl ...] ...))]))]))
+          (lambda (registers)
+            (let ([reg (hash-ref registers 'reg)] ...)
+              (parameterize ([reg #f] ...)
+                (lambda (op)
+                  (case op
+                    [(opcode) impl ...] ...)))))]))]))
 
 (define (instruction-lookup isa name)
   ((isa 'lookup) name))
 
-(define (instruction-set-call isa op)
-  ((isa 'call) op))
+(define (instruction-set-caller instruction-set registers)
+  ((instruction-set 'call) registers))
 
 (define instruction-name car)
 (define instruction-code cadr)
 
-(define-instruction-set forth-instruction-set
-  (define-instruction (push #x01)
-    (stack-push (*data-stack*) (fetch-word!)))
-  (define-instruction (! #x02)
-    (let ([addr (stack-pop (*data-stack*))]
-          [v (stack-pop (*data-stack*))])
-      (ram-word-set! addr v)))
-  (define-instruction (@ #x03)
-    (let* ([addr (stack-pop (*data-stack*))]
-           [v (ram-word-ref addr)])
-      (stack-push (*data-stack*) v)))
-  (define-instruction (+ #x04)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (+ v1 v2))))
-  (define-instruction (- #x05)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (- v1 v2))))
-  (define-instruction (and #x06)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (logand v1 v2))))
-  (define-instruction (or #x07)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (logior v1 v2))))
-  (define-instruction (nand #x08)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (if (zero? (logand v1 v2)) 1 0))))
-  (define-instruction (nor #x09)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (if (zero? (logior v1 v2)) 1 0))))
-  (define-instruction (xor #x0a)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (logxor v1 v2))))
-  (define-instruction (= #x0b)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (if (= v1 v2)
-          (stack-push (*data-stack*) 1)
-          (stack-push (*data-stack*) 0))))
-  (define-instruction (> #x0c)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (if (> v1 v2)
-          (stack-push (*data-stack*) 1)
-          (stack-push (*data-stack*) 0))))
-  (define-instruction (< #x0d)
-    (let ([v2 (stack-pop (*data-stack*))]
-          [v1 (stack-pop (*data-stack*))])
-      (if (< v1 v2)
-          (stack-push (*data-stack*) 1)
-          (stack-push (*data-stack*) 0))))
-  (define-instruction (jmp #x0e)
-    (jump! (stack-pop (*data-stack*))))
-  (define-instruction (branch #x0f)
-    (let* ([addr (stack-pop (*data-stack*))]
-           [test (stack-pop (*data-stack*))])
-      (when (zero? test)
-        (jump! addr))))
-  (define-instruction (call #x10)
-    (let ([addr (stack-pop (*data-stack*))])
-      (stack-push (*ret-stack*) (vm-pc (*vm*)))
-      (jump! addr)))
-  (define-instruction (return #x11)
-    (jump! (stack-pop (*ret-stack*))))
-  (define-instruction (>R #x12)
-    (stack-push (*ret-stack*) (stack-pop (*data-stack*))))
-  (define-instruction (R> #x13)
-    (stack-push (*data-stack*) (stack-pop (*ret-stack*))))
-  (define-instruction (drop #x14)
-    (stack-pop (*data-stack*)))
-  (define-instruction (nip #x15)
-    (let ([v (stack-pop (*data-stack*))])
-      (stack-pop (*data-stack*))
-      (stack-push (*data-stack*) v)))
-  (define-instruction (dup #x16)
-    (stack-push (*data-stack*) (stack-peek (*data-stack*))))
-  (define-instruction (swap #x17)
-    (stack-swap (*data-stack*)))
-  (define-instruction (rot #x18)
-    (let* ([a (stack-pop (*data-stack*))]
-           [b (stack-pop (*data-stack*))]
-           [c (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) a)
-      (stack-push (*data-stack*) c)
-      (stack-push (*data-stack*) b)))
-  (define-instruction (over #x19)
-    (let* ([a (stack-pop (*data-stack*))]
-           [b (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) b)
-      (stack-push (*data-stack*) a)
-      (stack-push (*data-stack*) b)))
-  (define-instruction (not #x1a)
-    (let ([a (stack-pop (*data-stack*))])
-      (stack-push (*data-stack*) (if (zero? a) 1 0))))
-  (define-instruction (set! #x1b)
-    ;; use let* to induce an order of evaluation
-    (let* ([idx (stack-pop (*data-stack*))]
-           [obj (stack-pop (*data-stack*))])
-      (stack-set! (*data-stack*) idx obj)))
-  (define-instruction (bye #xff)
-    (*vm-exit* #t)))
-
-
-;;; VM
-(define-record-type <vm>
-  (make-vm data-stack ret-stack memory pc debugger instruction-set)
-  vm?
-  (data-stack vm-data-stack)
-  (ret-stack vm-ret-stack)
-  (memory vm-memory)
-  (pc vm-pc vm-pc-set!)
-  (debugger vm-debugger vm-debugger-set!)
-  (instruction-set vm-instruction-set vm-instruction-set-set!))
-
-(define* (make-vm* instruction-set #:key stack-size memory-size debugger)
-  "Create a fresh VM, with optional stack and memory sizes"
-  (define data-stack (if stack-size (make-stack stack-size) (make-stack)))
-  (define ret-stack (if stack-size (make-stack stack-size) (make-stack)))
-  (define ram (if memory-size (make-ram memory-size) (make-ram)))
-  (define isa (if instruction-set instruction-set forth-instruction-set))
-  (make-vm data-stack ret-stack ram 1 debugger isa))
-
-(define *vm* (make-parameter #f))
-(define *data-stack* (make-parameter #f))
-(define *ret-stack* (make-parameter #f))
-(define *vm-exit* (make-parameter #f))
-
-(define (ram-word-ref k)
-  (vm-memory-ref (*vm*) k))
-
-(define (ram-byte-ref k)
-  (vm-memory-byte-ref (*vm*) k))
-
-(define (ram-word-set! k v)
-  (vm-memory-set! (*vm*) k v))
-
-(define (jump! x)
-  (vm-pc-set! (*vm*) (logand #x2fffffff x)))
-
-(define (fetch-byte!)
-  (let* ([vm (*vm*)]
-         [byte (ram-byte-ref (vm-pc vm))])
-    (vm-pc-set! vm (+ (vm-pc vm) 1))
-    byte))
-
-(define (fetch-word!)
-  (let* ([vm (*vm*)]
-         [word (ram-word-ref (vm-pc vm))])
-    (vm-pc-set! vm (+ (vm-pc vm) 4))
-    word))
-
-;;; Execution
-(define (run-vm vm)
-  "Begin execution at pc"
-  (parameterize ([*vm* vm]
-                 [*data-stack* (vm-data-stack vm)]
-                 [*ret-stack* (vm-ret-stack vm)]
-                 [*vm-exit* #f])
-    (define debugger (vm-debugger vm))
-    (let lp () 
-      (when debugger
-        (debugger))
-      (define op (fetch-byte!))
-      (instruction-set-call (vm-instruction-set (*vm*)) op)
-      (unless (*vm-exit*) (lp)))))
-
-(define (vm-memory-ref vm k)
-  (if (< k 1)
-      (error "null memory read")
-      (bytevector-s32-native-ref (vm-memory vm) (1- k))))
-(define (vm-memory-byte-ref vm k)
-  (if (< k 1)
-      (error "null memory read")
-      (bytevector-u8-ref (vm-memory vm) (1- k))))
-(define (vm-memory-set! vm k v)
-  (if (< k 1)
-      (error "null memory write")
-      (bytevector-s32-native-set! (vm-memory vm) (1- k) v)))
-
-(define (vm-load-program! vm prgm)
-  "Loads the bytevector into the vm, starting at memory address 1"
-  (let ([ram (vm-memory vm)])
-    (bytevector-copy! prgm 0
-                      ram 0
-                      (bytevector-length prgm))))
+(define (register-set names)
+  (alist->hash-table (map (lambda (n) (cons n (make-parameter #f))) names)))

scmvm/vm/forth.scm

@@ -0,0 +1,279 @@
+(define-module (scmvm vm forth)
+  #:use-module (scmvm vm)
+  #:use-module (scmvm util stack)
+  #:use-module ((scheme base)
+                #:select (read-u8 read-bytevector))
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-9)
+  #:export ((make-forth-vm* . make-forth-vm)
+            forth-instruction-set
+            forth-vm-load-program!
+            forth-vm-run!
+            forth-vm-pc
+            forth-vm-pc-set!
+            forth-vm-memory-set!
+            forth-vm-memory-ref
+            forth-vm-data-stack))
+
+;;; IO
+(define *memory-size* 2048)
+
+(define* (make-ram #:optional (memory-size *memory-size*))
+  (make-bytevector memory-size #x00))
+
+(define (read-word)
+  "Read the next 32-bit value from (current-input-port)"
+  (let ([bv (read-bytevector 4)])
+    (bytevector-s32-ref bv 0 (native-endianness))))
+
+
+;;; VM
+(define-record-type <forth-vm>
+  (make-forth-vm instruction-set registers)
+  forth-vm?
+  (instruction-set forth-vm-instruction-set)
+  (registers forth-vm-registers forth-vm-registers-set!))
+
+(define* (make-forth-vm* instruction-set #:key stack-size memory-size)
+  "Create a fresh VM, with optional stack and memory sizes"
+  (define registers (register-set '(*data-stack* *ret-stack* *pc* *ram* *vm-exit*)))
+  ((hash-ref registers '*pc*) 1)
+  ((hash-ref registers '*data-stack*) (if stack-size (make-stack stack-size) (make-stack)))
+  ((hash-ref registers '*ret-stack*) (if stack-size (make-stack stack-size) (make-stack)))
+  ((hash-ref registers '*ram*) (if memory-size (make-ram memory-size) (make-ram)))
+  (make-forth-vm instruction-set registers))
+
+(define *vm* (make-parameter #f))
+
+(define-syntax-rule (with-forth-vm-registers (reg ...) expr ...)
+  (let ([reg (hash-ref (forth-vm-registers (*vm*)) 'reg)] ...)
+    expr ...))
+
+(define (ram-word-ref k)
+  (with-forth-vm-registers
+   (*ram*)
+   (if (< k 1)
+       (error "null memory read")
+       (bytevector-s32-native-ref (*ram*) (1- k)))))
+
+(define (ram-byte-ref k)
+  (with-forth-vm-registers
+   (*ram*)
+   (if (< k 1)
+       (error "null memory read")
+       (bytevector-u8-ref (*ram*) (1- k)))))
+
+(define (ram-word-set! k v)
+  (with-forth-vm-registers
+   (*ram*)
+   (if (< k 1)
+       (error "null memory write")
+       (bytevector-s32-native-set! (*ram*) (1- k) v))))
+
+(define (jump! x)
+  (with-forth-vm-registers
+   (*pc*)
+   (*pc* (logand #x2fffffff x))))
+
+(define (fetch-byte!)
+  (with-forth-vm-registers
+   (*pc*)
+   (let* ([byte (ram-byte-ref (*pc*))])
+     (*pc* (+ (*pc*) 1))
+     byte)))
+
+(define (fetch-word!)
+  (with-forth-vm-registers
+   (*ram* *pc*)
+   (let* ([word (ram-word-ref (*pc*))])
+     (*pc* (+ (*pc*) 4))
+     word)))
+
+(define (forth-vm-pc vm)
+  (parameterize ([*vm* vm])
+    (with-forth-vm-registers
+     (*pc*)
+     (*pc*))))
+
+(define (forth-vm-pc-set! vm k)
+  (parameterize ([*vm* vm])
+    (with-forth-vm-registers
+     (*pc*)
+     (*pc* k))))
+
+(define (forth-vm-memory-set! vm k v)
+  (parameterize ([*vm* vm])
+    (ram-word-set! k v)))
+
+(define (forth-vm-memory-ref vm k)
+  (parameterize ([*vm* vm])
+    (with-forth-vm-registers
+     (*ram*)
+     (ram-word-ref k))))
+
+(define (forth-vm-data-stack vm)
+  (parameterize ([*vm* vm])
+    (with-forth-vm-registers
+     (*data-stack*)
+     (*data-stack*))))
+
+ ;;; Instruction set
+(define-instruction-set (forth-instruction-set *pc* *ram* *data-stack* *ret-stack* *vm-exit*)
+  (define-instruction (push #x01)
+    (stack-push (*data-stack*) (fetch-word!)))
+  
+  (define-instruction (! #x02)
+    (let ([addr (stack-pop (*data-stack*))]
+          [v (stack-pop (*data-stack*))])
+      (ram-word-set! addr v)))
+  
+  (define-instruction (@ #x03)
+    (let* ([addr (stack-pop (*data-stack*))]
+           [v (ram-word-ref addr)])
+      (stack-push (*data-stack*) v)))
+  
+  (define-instruction (+ #x04)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (+ v1 v2))))
+  
+  (define-instruction (- #x05)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (- v1 v2))))
+  
+  (define-instruction (and #x06)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (logand v1 v2))))
+
+  (define-instruction (or #x07)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (logior v1 v2))))
+
+  (define-instruction (nand #x08)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (if (zero? (logand v1 v2)) 1 0))))
+
+  (define-instruction (nor #x09)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (if (zero? (logior v1 v2)) 1 0))))
+
+  (define-instruction (xor #x0a)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (logxor v1 v2))))
+
+  (define-instruction (= #x0b)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (if (= v1 v2)
+          (stack-push (*data-stack*) 1)
+          (stack-push (*data-stack*) 0))))
+
+  (define-instruction (> #x0c)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (if (> v1 v2)
+          (stack-push (*data-stack*) 1)
+          (stack-push (*data-stack*) 0))))
+
+  (define-instruction (< #x0d)
+    (let ([v2 (stack-pop (*data-stack*))]
+          [v1 (stack-pop (*data-stack*))])
+      (if (< v1 v2)
+          (stack-push (*data-stack*) 1)
+          (stack-push (*data-stack*) 0))))
+
+  (define-instruction (jmp #x0e)
+    (jump! (stack-pop (*data-stack*))))
+
+  (define-instruction (branch #x0f)
+    (let* ([addr (stack-pop (*data-stack*))]
+           [test (stack-pop (*data-stack*))])
+      (when (zero? test)
+        (jump! addr))))
+
+  (define-instruction (call #x10)
+    (let ([addr (stack-pop (*data-stack*))])
+      (stack-push (*ret-stack*) (*pc*))
+      (jump! addr)))
+
+  (define-instruction (return #x11)
+    (jump! (stack-pop (*ret-stack*))))
+
+  (define-instruction (>R #x12)
+    (stack-push (*ret-stack*) (stack-pop (*data-stack*))))
+
+  (define-instruction (R> #x13)
+    (stack-push (*data-stack*) (stack-pop (*ret-stack*))))
+
+  (define-instruction (drop #x14)
+    (stack-pop (*data-stack*)))
+
+  (define-instruction (nip #x15)
+    (let ([v (stack-pop (*data-stack*))])
+      (stack-pop (*data-stack*))
+      (stack-push (*data-stack*) v)))
+
+  (define-instruction (dup #x16)
+    (stack-push (*data-stack*) (stack-peek (*data-stack*))))
+
+  (define-instruction (swap #x17)
+    (stack-swap (*data-stack*)))
+
+  (define-instruction (rot #x18)
+    (let* ([a (stack-pop (*data-stack*))]
+           [b (stack-pop (*data-stack*))]
+           [c (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) a)
+      (stack-push (*data-stack*) c)
+      (stack-push (*data-stack*) b)))
+
+  (define-instruction (over #x19)
+    (let* ([a (stack-pop (*data-stack*))]
+           [b (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) b)
+      (stack-push (*data-stack*) a)
+      (stack-push (*data-stack*) b)))
+
+  (define-instruction (not #x1a)
+    (let ([a (stack-pop (*data-stack*))])
+      (stack-push (*data-stack*) (if (zero? a) 1 0))))
+
+  (define-instruction (set! #x1b)
+    ;; use let* to induce an order of evaluation
+    (let* ([idx (stack-pop (*data-stack*))]
+           [obj (stack-pop (*data-stack*))])
+      (stack-set! (*data-stack*) idx obj)))
+
+  (define-instruction (bye #xff)
+    (*vm-exit* #t)))
+
+;;; Execution
+(define* (forth-vm-run! vm #:optional debugger)
+  "Begin execution at pc"
+  (define caller (instruction-set-caller (forth-vm-instruction-set vm)
+                                         (forth-vm-registers vm)))
+  (parameterize ([*vm* vm])
+    (with-forth-vm-registers
+     (*vm-exit*)
+     (let lp () 
+       (when debugger
+         (debugger))
+       (define op (fetch-byte!))
+       (caller op)
+       (unless (*vm-exit*) (lp))))))
+
+(define (forth-vm-load-program! vm prgm)
+  "Loads the bytevector into the vm, starting at memory address 1"
+  (parameterize ([*vm* vm])
+    (with-forth-vm-registers
+     (*ram*)
+     (let ([ram (*ram*)])
+       (bytevector-copy! prgm 0
+                         ram 0
+                         (bytevector-length prgm))))))

tests.scm

@@ -1,6 +1,6 @@
 (use-modules (d- test)
 	     (scmvm assembler)
-             (scmvm vm)
+             (scmvm vm forth)
              (scmvm util stack)
 	     (scmvm debugger)
 	     (scmvm language assembly)
@@ -120,51 +120,51 @@
 
 (define-test-suite "vm"
   (define-test "adder"
-    (define my-vm (make-vm forth-instruction-set))
-    (vm-load-program! my-vm adder-program-bytecode)
-    (vm-pc-set! my-vm 5)
-    (run-vm my-vm)
-    (assert-equal 3 (vm-memory-ref my-vm 1)))
+    (define my-vm (make-forth-vm forth-instruction-set))
+    (forth-vm-load-program! my-vm adder-program-bytecode)
+    (forth-vm-pc-set! my-vm 5)
+    (forth-vm-run! my-vm)
+    (assert-equal 3 (forth-vm-memory-ref my-vm 1)))
   (define-test "fib"
-    (define my-vm (make-vm forth-instruction-set))
-    (vm-load-program! my-vm fib-program-bytecode)
-    (vm-memory-set! my-vm 1 10)
-    (vm-pc-set! my-vm 5)
-    (run-vm my-vm)
-    (assert-equal 55 (vm-memory-ref my-vm 1))))
+    (define my-vm (make-forth-vm forth-instruction-set))
+    (forth-vm-load-program! my-vm fib-program-bytecode)
+    (forth-vm-memory-set! my-vm 1 10)
+    (forth-vm-pc-set! my-vm 5)
+    (forth-vm-run! my-vm)
+    (assert-equal 55 (forth-vm-memory-ref my-vm 1))))
 
 (define-test-suite "debugger"
   (define-test "modify-running-program"
     (define fib-program-asm (make-assembler forth-instruction-set))
     (assemble-instructions! fib-program-asm fib-program-assembly)
     (assembler-backpatch! fib-program-asm)
-    (define my-debugger (make-debugger fib-program-asm))
+    (define my-debugger (make-forth-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)
+    (define my-data (forth-vm-data-stack my-vm))
+    (forth-vm-memory-set! my-vm 1 10)
+    (forth-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)))
+    (assert-equal 1 (forth-vm-memory-ref my-vm 1)))
   (define-test "stepping"
     (define fib-program-asm (make-assembler forth-instruction-set))
     (assemble-instructions! fib-program-asm fib-program-assembly)
     (assembler-backpatch! fib-program-asm)
-    (define my-debugger (make-debugger fib-program-asm))
+    (define my-debugger (make-forth-debugger fib-program-asm))
     (define my-vm (debugger-vm my-debugger))
-    (vm-memory-set! my-vm 1 10)
-    (vm-pc-set! my-vm 5)
+    (forth-vm-memory-set! my-vm 1 10)
+    (forth-vm-pc-set! my-vm 5)
     (debugger-breakpoint-add! my-debugger 'fib)
     (debugger-continue my-debugger)
-    (assert-equal 23 (vm-pc my-vm))
+    (assert-equal 23 (forth-vm-pc my-vm))
     (debugger-step my-debugger)
-    (assert-equal 24 (vm-pc my-vm)) ;; dup is a 1 byte instruction
+    (assert-equal 24 (forth-vm-pc my-vm)) ;; dup is a 1 byte instruction
     (debugger-step my-debugger)
-    (assert-equal 29 (vm-pc my-vm)) ;; push is a 5 byte instruction
+    (assert-equal 29 (forth-vm-pc my-vm)) ;; push is a 5 byte instruction
     (debugger-continue my-debugger)
-    (assert-equal 23 (vm-pc my-vm)) ;; continue stops stepping
+    (assert-equal 23 (forth-vm-pc my-vm)) ;; continue stops stepping
     ))