first working vm
This commit is contained in:
parent
2be553db25
commit
db18ea0563
64
README.md
64
README.md
@ -2,50 +2,44 @@
|
|||||||
|
|
||||||
very early days for now.
|
very early days for now.
|
||||||
|
|
||||||
in the racket repl:
|
in the racket repl (comments for reader comprehension, remove before running):
|
||||||
|
|
||||||
```
|
```
|
||||||
(run-lines (list
|
(run-vm #x150 #x150 #x16 ; start-address, end-memory-view-addr, number-bytes-view
|
||||||
(8b-ld-reg-imm 4 #x01)
|
'(#x3E #x69 ; LD A, $69
|
||||||
(8b-ld-reg-imm 5 #x50)
|
#x26 #x01 ; LD H, $01
|
||||||
(8b-ld-reg-imm 7 #x69)
|
#x2E #x62 ; LD L, $62
|
||||||
(8b-ld-reg-reg 6 7)
|
#x77 ; LD (HL), A
|
||||||
(8b-ld-reg-reg 7 4)
|
#x2E #x5B ; LD L, $5B
|
||||||
(8b-ld-reg-imm 5 #x51)
|
#x36 #xE6 ; LD (HL), $E6 ($E6 is the opcode for XOR $xx)
|
||||||
(8b-ld-reg-reg 6 7)))
|
#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:
|
will evaluate to:
|
||||||
|
|
||||||
```
|
```
|
||||||
PC: $07, SP: $00, Flags: %00000000
|
PC: $16, SP: $00, Flags: %00000000
|
||||||
BC: $0000, DE: $0000
|
BC: $0000, DE: $0000
|
||||||
HL: $0151, AF: $0100
|
HL: $0163, AF: $6000
|
||||||
(HL): $01
|
(HL): $60
|
||||||
$0150 > $69 $01 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 $00 < $0160
|
$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.
|
||||||
|
|
||||||
```
|
## notes
|
||||||
LD H, $01
|
|
||||||
LD L, $50
|
|
||||||
LD A, $69
|
|
||||||
LD (HL), A
|
|
||||||
LD A, H
|
|
||||||
LD L, $51
|
|
||||||
LD (HL), A
|
|
||||||
```
|
|
||||||
|
|
||||||
# notes
|
currently supported instructions are:
|
||||||
|
* `LD [reg], #imm`
|
||||||
register numbering is following how the LR35902 decodes instructions, as such:
|
* `LD [reg], [reg]`
|
||||||
|
* `XOR #imm`
|
||||||
* 0: B
|
* `AND #imm`
|
||||||
* 1: C
|
* `OR #imm`
|
||||||
* 2: D
|
* `STOP`
|
||||||
* 3: E
|
* `NOP`
|
||||||
* 4: H
|
all other instructions treated as `NOP`
|
||||||
* 5: L
|
|
||||||
* 6: (HL)
|
|
||||||
* 7: A
|
|
||||||
|
120
vm.rkt
120
vm.rkt
@ -3,12 +3,13 @@
|
|||||||
(struct mem
|
(struct mem
|
||||||
(regs pc sp flags bank))
|
(regs pc sp flags bank))
|
||||||
|
|
||||||
(define (make-mem)
|
(define (make-mem [start #x00] [bs '()])
|
||||||
|
(set-bytes start bs
|
||||||
(mem (make-regs)
|
(mem (make-regs)
|
||||||
|
start
|
||||||
0
|
0
|
||||||
0
|
0
|
||||||
0
|
(make-bank))))
|
||||||
(make-bank)))
|
|
||||||
|
|
||||||
(define (make-regs)
|
(define (make-regs)
|
||||||
(make-vector 8 0))
|
(make-vector 8 0))
|
||||||
@ -38,8 +39,8 @@
|
|||||||
(struct-copy mem m [bank newbank]))))
|
(struct-copy mem m [bank newbank]))))
|
||||||
(error "unknown register index")))
|
(error "unknown register index")))
|
||||||
|
|
||||||
(define (make-bank)
|
(define (make-bank [def #x00])
|
||||||
(make-vector 65536 #x00))
|
(make-vector 65536 def))
|
||||||
|
|
||||||
(define (mod-8bit val)
|
(define (mod-8bit val)
|
||||||
(modulo val 256))
|
(modulo val 256))
|
||||||
@ -51,6 +52,10 @@
|
|||||||
(begin
|
(begin
|
||||||
(struct-copy mem m [pc (mod-16bit addr)])))
|
(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)
|
(define (get-byte addr m)
|
||||||
(let ([b (mem-bank m)])
|
(let ([b (mem-bank m)])
|
||||||
(if (and (>= addr 0)
|
(if (and (>= addr 0)
|
||||||
@ -74,16 +79,50 @@
|
|||||||
(cdr bs)
|
(cdr bs)
|
||||||
(set-byte addr (car bs) m))))
|
(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)
|
(define (inc-sp m)
|
||||||
(struct-copy mem m [sp (add1 (mem-sp m))]))
|
(struct-copy mem m [sp (add1 (mem-sp m))]))
|
||||||
|
|
||||||
(define (inc-pc m)
|
(define (inc-pc m)
|
||||||
(struct-copy mem m [pc (add1 (mem-pc m))]))
|
(struct-copy mem m [pc (add1 (mem-pc m))]))
|
||||||
|
|
||||||
|
|
||||||
(define (make-16b-addr x y)
|
(define (make-16b-addr x y)
|
||||||
(bitwise-ior y (arithmetic-shift x 8)))
|
(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)
|
(define (8b-ld-reg-imm reg imm)
|
||||||
(lambda (m)
|
(lambda (m)
|
||||||
(set-reg reg imm m)))
|
(set-reg reg imm m)))
|
||||||
@ -94,6 +133,33 @@
|
|||||||
(get-reg src m)
|
(get-reg src m)
|
||||||
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)
|
(define (display-byte-hex v)
|
||||||
(~a #:align 'right #:left-pad-string "0" #:width 2
|
(~a #:align 'right #:left-pad-string "0" #:width 2
|
||||||
(format "~x" v)))
|
(format "~x" v)))
|
||||||
@ -134,7 +200,7 @@
|
|||||||
(define (print-mem v)
|
(define (print-mem v)
|
||||||
(display (format " $~a" (display-byte-hex v))))
|
(display (format " $~a" (display-byte-hex v))))
|
||||||
(let ([s (display-word-hex start)]
|
(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))
|
(display (format "$~a >" s))
|
||||||
(let ([splice (vector-take
|
(let ([splice (vector-take
|
||||||
(vector-drop (mem-bank m) start)
|
(vector-drop (mem-bank m) start)
|
||||||
@ -143,6 +209,46 @@
|
|||||||
(display (format " < $~a\n" e) ))
|
(display (format " < $~a\n" e) ))
|
||||||
(void))
|
(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-lines ls)
|
||||||
(define (run-line-help ls m)
|
(define (run-line-help ls m)
|
||||||
(if (null? ls)
|
(if (null? ls)
|
||||||
|
Loading…
Reference in New Issue
Block a user