first working vm

This commit is contained in:
Thorn Avery 2020-06-09 16:53:59 +12:00
parent 2be553db25
commit db18ea0563
2 changed files with 145 additions and 45 deletions

View File

@ -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
# notes
register numbering is following how the LR35902 decodes instructions, as such:
* 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`

126
vm.rkt
View File

@ -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)