Monday, 29 June 2009

ICFP Contest 2009 (2)

In my last post about the ICFP 2009 Programming Contest I'd wrestled with some bits and finally correctly (well, it matched up with this at least!) interpreted the instructions for the virtual machine that was provided.

The next challenge is to actually run the virtual machine. I went through lots of bad designs, but in this post and the next I thought I'd highlight two of these.

For reasons known only to myself, I decided the first approach would use mutable state. This seemed like a good model of a virtual machine, the memory would be represented by a vector of atoms; each atom would be the value of the memory at that address and I could use swap! to update the value of the atom.

Previously, I'd use simple symbols to represent the machine instructions. Now that we've got to process instructions, it makes more sense to represent each instruction as a function of the virtual machine.

;;; Virtual machine specification
(defstruct virtualmachine :mem :counter :inport :outport :status :firstrun)

(defn get-val
[vm x]
@((:mem vm) x))

(defn numeric-op
"D-type General numeric op"
[vm [x y] f]
(let [m (:mem vm)]
(swap! (m @(:counter vm)) (constantly (f @(m x) @(m y))))))

(defn phi
[vm [x y]]
(let [m (:mem vm)]
(trace vm 'Phi (format "%s ? %s : %s --> %s" @(:status vm) @(m x) @(m y) (if @(:status vm) @(m x) @(m y))))
(swap! (m @(:counter vm))
(if @(:status vm)
@(m x)
@(m y))))))

(defn print-args
[vm op x y]
(format "%s %s // %s %s %s" x y (get-val vm x) op (get-val vm y)))

(defn add
"D-type Add instruction"
[vm [x y]]
(trace vm 'Add (print-args vm '+ x y))
(numeric-op vm [x y] +))

(defn sub
"D-type Sub instruction"
[vm [x y]]
(trace vm 'Sub (print-args vm '- x y))
(numeric-op vm [x y] -))

(defn mult
"D-type Multiply instruction"
[vm [x y]]
(trace vm 'Mult (print-args vm '* x y))
(numeric-op vm [x y] *))

(defn div
"D-type Divide"
[vm args]
(trace vm 'Div)
(numeric-op vm args (fn [x y] (if (zero? y) 0 (/ x y)))))

(defn noop
"S-type Noop instruction"
[vm args]
(trace vm 'Noop)

(defn copy
"S-Type: Copy instruction"
[vm [x]]
(trace vm 'Copy (format "%s // %s" x (get-val vm x)))
(swap! ((:mem vm) @(:counter vm)) (constantly (get-val vm x))))

(defn sqrt
"S-Type: Square root instruction: undefined for negative values"
[vm [x]]
(trace vm 'Sqrt)
(assert (not (neg? (get-val vm x))))
(swap! ((:mem vm) @(:counter vm)) (constantly (Math/sqrt (get-val vm x)))))

(defn input
"S-Type: Set the memory from the inport"
[vm [x]]
(trace vm 'Input)
(swap! ((:mem vm) @(:counter vm)) (constantly @((:inport vm) x))))

(defn output
"Output instruction: Set the memory on the outport"
[vm [x y]]
(trace vm 'Output (format "%s %s // %s" x y (get-val vm y)))
(swap! ((:outport vm) x) (constantly (get-val vm y))))

(defn cmpz
"Comparison function"
[vm [cmp y]]
(let [val @((:mem vm) y)
status (cond ;; TODO replace this with functions so it becomes (apply cmp val)
(= cmp 'LTZ) (< val 0)
(= cmp 'LEZ) (<= val 0)
(= cmp 'EQZ) (zero? val)
(= cmp 'GEZ) (> val 0)
(= cmp 'GTZ) (>= val 0)
:else (assert false))]
(trace vm 'Cmpz (format "%s %s --> %s" cmp y status))
(swap! (:status vm) (constantly status))))

(def d-type-instructions {1 add, 2 sub, 3 mult, 4 div, 5 output, 6 phi})
(def s-type-instructions {0 noop, 1 cmpz, 2 sqrt, 3 copy, 4 input})
(def comparison {0 'LTZ, 1 'LEZ, 2 'EQZ, 3 'GEZ, 4 'GTZ})

You'll notice an abundance of trace output! This got added as a found repeated bugs in my code. One thing I learnt this time round at ICFP is that the tracing should be built in from the start (not retrofitted as I did here!).

Originally, I wrote my own trace functions (based on ones mentioned in the GPS Problem Sovler post), but I found that Clojure Contrib has a trace package too.

#clojure helped out once again with how to turn tracing off. (alter-var-root (var clojure.contrib.trace/tracer) (constantly (constantly nil))) alters the bindings of trace/tracer to be a function returning nil. alter-var-root's second argument is a function which takes the previous value of the var and returns the new binding.

The code below shows how the VM was implemented. The virtual machine struct is initialized with 16384 (14 bits of address space) atoms, each representing one memory unit. As we run through the list of operations, we simply apply the operations and increment the program counter.

The virtual machine takes an updater function, the goal of the updater function was to read the outputs and adjust the input functions accordingly. Unfortunately, I realized pretty soon into this, that a team of one is not the way to win this contest so I never got far with implementing the Hohmann transfer implementation.

;;; Virtual machine executing instructions
(defn vector-atoms
"Create a vector of atoms, initialized to zero"
(into [] (take n (repeatedly #(atom 0)))))

(defn init-vm
(let [memory (vector-atoms (count data))]
(doall (map (fn [a d] (swap! a (constantly d))) memory data)))
(struct virtualmachine memory (atom 0) (vector-atoms 16384) (vector-atoms 16384) (atom false) (atom true))))

(defn hohmann-updater
(when @(:firstrun vm)
(swap! ((:inport vm) 0x3E80) (constantly 1001))))

(defn create-vm
(init-vm (map second instructions)))

(def bin1 (read-data (get-bytes bin1)))

;; TODO This could be purely functional, if I just returned
;; a copy of the entire VM after each operation was applied.
(defn run-machine
"Run the virtual machine with the decoded instructions.
Reset the program counter when complete"

[vm ops update-input]
(update-input vm)
(doseq [[op args] ops]
(apply op (list vm args)) ;; dodgy side effect
(swap! (:counter vm) inc))
(swap! (:counter vm) (constantly 0))
(swap! (:firstrun vm) (constantly false))

(defn run []
(let [x (create-vm bin1)
ops (map first bin1)]
(count (take 1 (repeatedly #(run-machine x ops hohmann-updater))))))

The speed of the VM is quite important. If it's too slow, you'll spend far too long waiting for satellite transfers, and not enough time working out the right answers. This first version is pretty fast 1000 iterations on my machine takes about 3.5 seconds (about 285 iterations per second). The very first implementation (the very bad one) used refs rather than atoms, and this was about twice as slow. I guess the extra time comes from the STM implementation.

This was the first time I'd made a conscious effort to program with mutable state in Clojure and I really wish I hadn't! The end result is really ugly code that confuses me each time I look at it. In the next post, I'll compare this against the purely functional version.