I'm new to racket/scheme, so i decided to learn by implemeting an emulator for the DCPU-16, a simple 16 bit processor.
My question is thus: What is a better way to implement my solution?
This is the solution I hacked together to control the cpu's registers. The main point was to allow functions which modify a register to be chained together. For example:
; Increment value stored in register r-id
; returns the updated register
;
; Reg - the register structure
; (reg-inc Reg 'SP)
(define (reg-inc reg r-id)
(reg-write reg r-id (+ (reg-read reg r-id) 1 )))
; chain them together
;(reg-inc (reg-inc Reg 'SP)
; 'PC)
;
; returns structure with both 'SP and 'PC incremented
The full text of my register solution is below. My full program is also on github. There is so much repeated logic, I know there must be an easier way:
(struct registers (A B C X Y Z I J SP PC O Pa Pb Paadr Pbadr CLK)
#:transparent)
(define Reg (registers 0 0 0 0 0 0 0 0 #x10000 0 0 0 0 0 0 0))
(define (reg-name n)
(case n
[(0) 'A]
[(1) 'B]
[(2) 'C]
[(3) 'X]
[(4) 'Y]
[(5) 'Z]
[(6) 'I]
[(7) 'J]
[(8) 'SP]
[(9) 'PC]
[(10) 'O]
[(11) 'Pa]
[(12) 'Pb]
[(13) 'Paadr]
[(14) 'Pbadr]
[(15) 'CLK]
[else (error "Invalid register")]))
(define (reg-id s)
(cond
[(eq? 'A s) 0]
[(eq? 'B s) 1]
[(eq? 'C s) 2]
[(eq? 'X s) 3]
[(eq? 'Y s) 4]
[(eq? 'Z s) 5]
[(eq? 'I s) 6]
[(eq? 'J s) 7]
[(eq? 'SP s) 8]
[(eq? 'PC s) 9]
[(eq? 'O s) 10]
[(eq? 'Pa s) 11]
[(eq? 'Pb s) 12]
[(eq? 'Paadr s) 13]
[(eq? 'Pbadr s) 14]
[(eq? 'CLK s) 15]))
(define (reg-read reg r)
(if (symbol? r)
(reg-read reg (reg-id r))
(case r
[(0) (registers-A reg)]
[(1) (registers-B reg)]
[(2) (registers-C reg)]
[(3) (registers-X reg)]
[(4) (registers-Y reg)]
[(5) (registers-Z reg)]
[(6) (registers-I reg)]
[(7) (registers-J reg)]
[(8) (registers-SP reg)]
[(9) (registers-PC reg)]
[(10) (registers-O reg)]
[(11) (registers-Pa reg)]
[(12) (registers-Pb reg)]
[(13) (registers-Paadr reg)]
[(14) (registers-Pbadr reg)]
[(15) (registers-CLK reg)]
[else (error "Invalid register")])))
(define (reg-write reg r val)
(if (symbol? r)
(reg-write reg (reg-id r) val)
(let ([mask-val (bitwise-and val #xffff)])
(case r
[(0) (struct-copy registers reg [A mask-val])]
[(1) (struct-copy registers reg [B mask-val])]
[(2) (struct-copy registers reg [C mask-val])]
[(3) (struct-copy registers reg [X mask-val])]
[(4) (struct-copy registers reg [Y mask-val])]
[(5) (struct-copy registers reg [Z mask-val])]
[(6) (struct-copy registers reg [I mask-val])]
[(7) (struct-copy registers reg [J mask-val])]
[(8) (struct-copy registers reg [SP mask-val])]
[(9) (struct-copy registers reg [PC mask-val])]
[(10) (struct-copy registers reg [O mask-val])]
[(11) (struct-copy registers reg [Pa mask-val])]
[(12) (struct-copy registers reg [Pb mask-val])]
[(13) (struct-copy registers reg [Paadr mask-val])]
[(14) (struct-copy registers reg [Pbadr mask-val])]
[(15) (struct-copy registers reg [CLK mask-val])]
[else (error "Invalid register")]))))
Update:
Thanks to oobviat's sugestions I've refactored using lists. The only tricky part was updating a value in the list. I wrote a procedure for map that would update the desired register and leave the others with their original value:
;; a-list of registers and initial values
(define (build-reg)
'((A . 0) (B . 0) (C . 0) (X . 0)
(Y . 0) (Z . 0) (I . 0) (J . 0)
(SP . 0) (PC . 0) (O . 0) (Pa . 0)
(Pb . 0) (Paadr . 0) (Pbadr . 0) (CLK . 0)))
(define *REF-REG* (build-reg)) ; used to determine structure
(define (reg-name n)
(if (symbol? n)
n
(car (list-ref *REF-REG* n))))
(define (reg-id s)
(- (length *REF-REG*)
(length (memf (lambda (arg)
(eq? s (car arg)))
*REF-REG*))))
(define (reg-write reg r val)
(let ([r-name (reg-name r)])
(define (reg-write-helper entry)
(if (eq? r-name
(car entry))
(cons r-name val)
entry))
(map reg-write-helper reg)))
(define (reg-read reg r)
(cdr (assoc (reg-name r) reg)))
This wasn't written in Racket, so it may not run for you as is.. if it throws errors try specifying the R5RS code type at the top of the file. For simplicity, I would do something like this using an a-list rather than structs.
;; a-list of registers and initial values
(define *reg*
'((A . 0) (B . 0) (C . 0) (X . 0) (Y . 0) (Z . 0)
(I . 0) (J . 0) (SP . #X10000) (PC . 0) (O . 0)
(Pa . 0) (Pb . 0) (Paadr . 0) (Pbadr . 0) (CLK . 0)))
(define (reg-write register val)
(set-cdr! (assoc register *reg*) val) ;write new value to register
val) ; return newly written value
(define (reg-read register)
(cdr (assoc register *reg*)))
(define (reg-inc register)
(reg-write register (+ 1 (reg-read register))))
;; to do many operations
;; input: a list of registers
;; EX: '(a b x)
(define (do-incs registers)
(if (null? registers)
'done ; return something when the incs are done
(begin ; lets you evaluate multiple expressions since `if` doesn't
(reg-inc (car registers))
(do-incs (cdr registers)))))
I'm assuming that Racket has a built in like assoc that returns the proper list from the a-list. Also, note that *reg* is defined as a global variable in this case so that we can just define it once then use set-cdr! to write values to it.
finally, this might do strange things to your SP register. My scheme sees it as 65536.. if that's not right, you may have to add an if to reg-write and reg-read to make sure you're getting the right values there.
<EDIT>
So, I read up a little bit on Racket procedures, and this code almost certainly won't run in normal Racket because they apparently have both mutable and non-mutable pairs. The changes you will have to make if you want to run this under Racket and not R5RS are as follows:
Rather than just using a quoted list you will probably need to make your list of registers with the mutable list/pair constructors (define *reg* (mlist (mcons 'A 0) (mcons 'B 0) ... ).
Instead of using set-cdr! the Racket version is set-mcdr! and only works on mutable pairs.</EDIT>