gistfile1.clj

(defstruct virtualmachine :mem :counter :inport :outport :status :firstrun :user)

(defn increment-counter
  [vm]
  (assoc vm :counter (inc (:counter vm))))

(defn memory-put
  "Update the memory specified by the key with the address to the given value"
  [vm key addr val]
  (assoc vm key (assoc (key vm) addr val)))

(defn memory-read
  "Return the value in key at address"
  [vm key addr]
  ((key vm) addr))

(defn mem-read
  [vm addr]
  ((:mem vm) addr))

(defn numeric-op
  "D-type General numeric op"
  [vm [x y] f]
  (memory-put vm :mem (:counter vm) (f (mem-read vm x) (mem-read vm y))))

(defn phi
  "D-type"
  [vm [x y]]
  (let [m (:mem vm)]
    (trace 'Phi (format "%s ? %s : %s --> %s" (:status vm) (m x) (m y) (if (:status vm) (m x) (m y))))
    (memory-put vm :mem (:counter vm)
	     (if (:status vm) (m x) (m y)))))

(defn print-args
  [vm op x y]
  (format "%s %s // %s %s %s" x y (mem-read vm x) op (mem-read vm y)))
    
(defn add
  "D-type Add instruction"
  [vm [x y]]
  (trace 'Add (print-args vm '+ x y))
  (numeric-op vm [x y] +))

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

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

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

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

(defn copy
  "S-Type: Copy instruction"
  [vm [x]]
  (trace 'Copy (format "%s // %s" x (mem-read vm x)))
  (memory-put vm :mem (:counter vm) (mem-read vm x)))

(defn sqrt
  "S-Type: Square root instruction: undefined for negative values"
  [vm [x]]
  (trace 'Sqrt)
  (assert (not (neg? (mem-read vm x))))
  (memory-put vm :mem (:counter vm) (Math/sqrt (mem-read vm x))))

(defn input
  "S-Type: Set the memory from the inport"
  [vm [x]]
  (trace 'Input)
  (memory-put vm :mem (:counter vm) (memory-read vm :inport x)))

(defn output
  "Output instruction: Set the memory on the outport"
  [vm [x y]]
  (trace 'Output (format "%s %s // %s" x y (mem-read vm y)))
  (memory-put vm :outport x (mem-read vm y)))

(defn cmpz
  "Comparison function"
  [vm [cmp y]]
  (let [val (mem-read 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 'Cmpz (format "%s %s --> %s" cmp y status))
    (assoc vm :status 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})