From db18ea05630b3f4ba63684aeafe4730d9ef2a20e Mon Sep 17 00:00:00 2001 From: tA Date: Tue, 9 Jun 2020 16:53:59 +1200 Subject: [PATCH] first working vm --- README.md | 64 +++++++++++++++---------------- vm.rkt | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 145 insertions(+), 45 deletions(-) diff --git a/README.md b/README.md index 5d66c05..519657e 100644 --- a/README.md +++ b/README.md @@ -2,50 +2,44 @@ very early days for now. -in the racket repl: +in the racket repl (comments for reader comprehension, remove before running): ``` - (run-lines (list - (8b-ld-reg-imm 4 #x01) - (8b-ld-reg-imm 5 #x50) - (8b-ld-reg-imm 7 #x69) - (8b-ld-reg-reg 6 7) - (8b-ld-reg-reg 7 4) - (8b-ld-reg-imm 5 #x51) - (8b-ld-reg-reg 6 7))) +(run-vm #x150 #x150 #x16 ; start-address, end-memory-view-addr, number-bytes-view + '(#x3E #x69 ; LD A, $69 + #x26 #x01 ; LD H, $01 + #x2E #x62 ; LD L, $62 + #x77 ; LD (HL), A + #x2E #x5B ; LD L, $5B + #x36 #xE6 ; LD (HL), $E6 ($E6 is the opcode for XOR $xx) + #x10 ; STOP (this instruction @ address $015B) + #xF0 ; (non-instruction, will be arg for previous byte) + #x2E #x63 ; LD L, $63 + #x77 ; LD (HL), A + #x10 ; STOP + )) ``` will evaluate to: ``` -PC: $07, SP: $00, Flags: %00000000 +PC: $16, SP: $00, Flags: %00000000 BC: $0000, DE: $0000 -HL: $0151, AF: $0100 -(HL): $01 -$0150 > $69 $01 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 < $0160 +HL: $0163, AF: $6000 +(HL): $60 +$0150 > $3e $69 $26 $01 $2e $62 $77 $2e $5b $36 $e6 $e6 $f0 $2e $63 $77 $10 $00 $69 $60 $00 $00 < $0165 ``` -which is the equivilent of: +here we can see the program loaded starting from address `$0150`, including the `XOR` instruction loaded to `$015B` during execution, and the `$69` we loaded to memory, along with the result of `XOR $F0` we loaded to memory, at `$0162` and `$0163` respectively. -``` -LD H, $01 -LD L, $50 -LD A, $69 -LD (HL), A -LD A, H -LD L, $51 -LD (HL), A -``` - -# notes - -register numbering is following how the LR35902 decodes instructions, as such: +## notes - * 0: B - * 1: C - * 2: D - * 3: E - * 4: H - * 5: L - * 6: (HL) - * 7: A +currently supported instructions are: + * `LD [reg], #imm` + * `LD [reg], [reg]` + * `XOR #imm` + * `AND #imm` + * `OR #imm` + * `STOP` + * `NOP` +all other instructions treated as `NOP` diff --git a/vm.rkt b/vm.rkt index 56b6ebf..56183d7 100644 --- a/vm.rkt +++ b/vm.rkt @@ -3,12 +3,13 @@ (struct mem (regs pc sp flags bank)) -(define (make-mem) - (mem (make-regs) - 0 - 0 - 0 - (make-bank))) +(define (make-mem [start #x00] [bs '()]) + (set-bytes start bs + (mem (make-regs) + start + 0 + 0 + (make-bank)))) (define (make-regs) (make-vector 8 0)) @@ -38,8 +39,8 @@ (struct-copy mem m [bank newbank])))) (error "unknown register index"))) -(define (make-bank) - (make-vector 65536 #x00)) +(define (make-bank [def #x00]) + (make-vector 65536 def)) (define (mod-8bit val) (modulo val 256)) @@ -51,6 +52,10 @@ (begin (struct-copy mem m [pc (mod-16bit addr)]))) +(define (set-flags f m) + (begin + (struct-copy mem m [flags (mod-8bit f)]))) + (define (get-byte addr m) (let ([b (mem-bank m)]) (if (and (>= addr 0) @@ -74,16 +79,50 @@ (cdr bs) (set-byte addr (car bs) m)))) +(define (get-x byte) + (arithmetic-shift (bitwise-and #b11000000 byte) -6)) + +(define (get-y byte) + (arithmetic-shift (bitwise-and #b00111000 byte) -3)) + +(define (get-z byte) + (bitwise-and #b00000111 byte)) + (define (inc-sp m) (struct-copy mem m [sp (add1 (mem-sp m))])) (define (inc-pc m) (struct-copy mem m [pc (add1 (mem-pc m))])) - (define (make-16b-addr x y) (bitwise-ior y (arithmetic-shift x 8))) +(define (make-8b-ld-reg-imm y m) + (letrec ([pc (mem-pc m)] + [x (get-byte pc m)]) + (cons (8b-ld-reg-imm y x) + (set-pc (add1pc pc) m)))) + +(define (make-8b-ld-reg-reg y z m) + (cons (8b-ld-reg-reg y z) + m)) + +(define (make-alu-imm z m) + (letrec ([pc (mem-pc m)] + [x (get-byte pc m)]) + (cons (case z + [(4) (8b-and-imm x)] + [(5) (8b-xor-imm x)] + [(6) (8b-or-imm x)] + [else (nop)]) + (inc-pc m)))) + +(define (make-nop m) + (cons (nop) m)) + +(define (make-stop m) + (cons 'STOP m)) + (define (8b-ld-reg-imm reg imm) (lambda (m) (set-reg reg imm m))) @@ -94,6 +133,33 @@ (get-reg src m) m))) +(define (8b-xor-imm imm) + (lambda (m) + (let ([a (bitwise-xor (get-reg 7 m) + (mod-8bit imm))]) + (displayln (format "~a xor ~a = ~a" (display-byte-hex (get-reg 7 m)) + (display-byte-hex (mod-8bit imm)) + a)) + (set-flags (if (= a 0) #b10000000 #x00) + (set-reg 7 a m))))) + +(define (8b-or-imm imm) + (lambda (m) + (let ([a (bitwise-ior (get-reg 7 m) + (mod-8bit imm))]) + (set-flags (if (= a 0) #b10000000 #x00) + (set-reg 7 a m))))) + +(define (8b-and-imm imm) + (lambda (m) + (let ([a (bitwise-and (get-reg 7 m) + (mod-8bit imm))]) + (set-flags (if (= a 0) #b10000000 #x00) + (set-reg 7 a m))))) + +(define (nop) + (lambda (m) m)) + (define (display-byte-hex v) (~a #:align 'right #:left-pad-string "0" #:width 2 (format "~x" v))) @@ -134,7 +200,7 @@ (define (print-mem v) (display (format " $~a" (display-byte-hex v)))) (let ([s (display-word-hex start)] - [e (display-word-hex (mod-16bit (+ start count)))]) + [e (display-word-hex (mod-16bit (+ start (sub1 count))))]) (display (format "$~a >" s)) (let ([splice (vector-take (vector-drop (mem-bank m) start) @@ -143,6 +209,46 @@ (display (format " < $~a\n" e) )) (void)) +(define (add1pc pc) + (mod-16bit (add1 pc))) + +(define (within x y z) + (and (>= x y) (<= x z))) + +(define (decode-op m) + (letrec ([pc (mem-pc m)] + [op (get-byte pc m)] + [npc (add1pc pc)] + [x (get-x op)] + [y (get-y op)] + [z (get-z op)]) + (cond + [(= #x00 op) (make-nop (set-pc npc m))] + [(= #x10 op) (make-stop (set-pc npc m))] + [(= 1 x) + (make-8b-ld-reg-reg y z (set-pc npc m))] + [(and (= 3 x) (within z 4 6)) + (make-alu-imm y (set-pc npc m))] + [(and (= 0 x) (= 6 z)) + (make-8b-ld-reg-imm y (set-pc npc m))] + [else (make-nop (set-pc npc m))]))) + +(define (run-vm start bank-start bank-count bs) + (let ([m (make-mem start bs)]) + (define (fin m) + (begin (print-state m) + (print-regs m) + (print-part-bank bank-start bank-count m))) + (define (run-op m) + (letrec ([op-pc (decode-op m)] + [op (car op-pc)] + [newmem (cdr op-pc)]) + (if (and (not (procedure? op)) + (eq? op 'STOP)) + (fin newmem) + (run-op (op newmem))))) + (run-op m))) + (define (run-lines ls) (define (run-line-help ls m) (if (null? ls)