Add assembler

scmvm/vm.scm

@@ -2,8 +2,10 @@
   #:use-module ((scheme base)
                 #:select (read-u8 read-bytevector))
   #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (make-vm run-vm vm-memory-ref vm-memory-set!))
+  #:export (make-vm run-vm vm-memory-ref vm-memory-set!
+            *instruction-set* instruction-type instruction-code))
 
 ;;; Data Structures
 (define *stack-size* 1000)
@@ -78,31 +80,35 @@
     (bytevector-s32-ref bv 0 (native-endianness))))
 
 ;;; Program execution
-(define *opcodes*
-  '((#x01 . push)
-    (#x02 . pop)
-    (#x03 . store)
-    (#x04 . load)
-    (#x05 . +)
-    (#x06 . -)
-    (#x07 . and)
-    (#x08 . or)
-    (#x09 . nand)
-    (#x0a . nor)
-    (#x0b . xor)
-    (#x0c . if)
-    (#x0d . call)
-    (#x0e . return)
-    (#x0f . >R)
-    (#x10 . R>)
-    (#x11 . =)
-    (#x12 . >)
-    (#x13 . <)
-    (#x14 . dup)
-    (#x15 . swap)
-    (#x16 . jmp)))
+(define *instruction-set*
+  '((push   #x01 i)
+    (pop    #x02 o)
+    (store  #x03 i)
+    (load   #x04 i)
+    (+      #x05 o)
+    (-      #x06 o)
+    (and    #x07 o)
+    (or     #x08 o)
+    (nand   #x09 o)
+    (nor    #x0a o)
+    (xor    #x0b o)
+    (if     #x0c j)
+    (call   #x0d j)
+    (return #x0e o)
+    (>R     #x0f o)
+    (R>     #x10 o)
+    (=      #x11 o)
+    (>      #x12 o)
+    (<      #x13 o)
+    (dup    #x14 o)
+    (swap   #x15 o)
+    (jmp    #x16 j)))
 
-(define op-lookup (cute assq-ref *opcodes* <>))
+(define instruction-code cadr)
+(define instruction-type caddr)
+
+(define (op-lookup code)
+  (car (find (lambda (x) (= (instruction-code x) code)) *instruction-set*)))
 
 (define (binop-lookup op)
   (case (op-lookup op)