646d00acb54a

--- a/advent.asd	Wed Dec 04 12:04:52 2019 -0500
+++ b/advent.asd	Thu Dec 05 19:36:23 2019 -0500
@@ -42,5 +42,6 @@
                (:module "src" :serial t
                 :components ((:file "utils")
                              (:file "number-spiral")
+                             (:file "intcode")
                              (:auto-module "2018")
                              (:auto-module "2019")))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/data/2019/05.txt	Thu Dec 05 19:36:23 2019 -0500
@@ -0,0 +1,1 @@
+3,225,1,225,6,6,1100,1,238,225,104,0,1101,65,73,225,1101,37,7,225,1101,42,58,225,1102,62,44,224,101,-2728,224,224,4,224,102,8,223,223,101,6,224,224,1,223,224,223,1,69,126,224,101,-92,224,224,4,224,1002,223,8,223,101,7,224,224,1,223,224,223,1102,41,84,225,1001,22,92,224,101,-150,224,224,4,224,102,8,223,223,101,3,224,224,1,224,223,223,1101,80,65,225,1101,32,13,224,101,-45,224,224,4,224,102,8,223,223,101,1,224,224,1,224,223,223,1101,21,18,225,1102,5,51,225,2,17,14,224,1001,224,-2701,224,4,224,1002,223,8,223,101,4,224,224,1,223,224,223,101,68,95,224,101,-148,224,224,4,224,1002,223,8,223,101,1,224,224,1,223,224,223,1102,12,22,225,102,58,173,224,1001,224,-696,224,4,224,1002,223,8,223,1001,224,6,224,1,223,224,223,1002,121,62,224,1001,224,-1302,224,4,224,1002,223,8,223,101,4,224,224,1,223,224,223,4,223,99,0,0,0,677,0,0,0,0,0,0,0,0,0,0,0,1105,0,99999,1105,227,247,1105,1,99999,1005,227,99999,1005,0,256,1105,1,99999,1106,227,99999,1106,0,265,1105,1,99999,1006,0,99999,1006,227,274,1105,1,99999,1105,1,280,1105,1,99999,1,225,225,225,1101,294,0,0,105,1,0,1105,1,99999,1106,0,300,1105,1,99999,1,225,225,225,1101,314,0,0,106,0,0,1105,1,99999,1008,226,677,224,102,2,223,223,1005,224,329,1001,223,1,223,7,677,226,224,102,2,223,223,1006,224,344,1001,223,1,223,1007,226,677,224,1002,223,2,223,1006,224,359,1001,223,1,223,1007,677,677,224,102,2,223,223,1005,224,374,1001,223,1,223,108,677,677,224,102,2,223,223,1006,224,389,101,1,223,223,8,226,677,224,102,2,223,223,1005,224,404,101,1,223,223,7,226,677,224,1002,223,2,223,1005,224,419,101,1,223,223,8,677,226,224,1002,223,2,223,1005,224,434,101,1,223,223,107,677,677,224,1002,223,2,223,1006,224,449,101,1,223,223,7,677,677,224,1002,223,2,223,1006,224,464,101,1,223,223,1107,226,226,224,102,2,223,223,1006,224,479,1001,223,1,223,1007,226,226,224,102,2,223,223,1006,224,494,101,1,223,223,108,226,677,224,1002,223,2,223,1006,224,509,101,1,223,223,1108,226,677,224,102,2,223,223,1006,224,524,1001,223,1,223,1008,226,226,224,1002,223,2,223,1005,224,539,101,1,223,223,107,226,226,224,102,2,223,223,1006,224,554,101,1,223,223,8,677,677,224,102,2,223,223,1005,224,569,101,1,223,223,107,226,677,224,102,2,223,223,1005,224,584,101,1,223,223,1108,226,226,224,1002,223,2,223,1005,224,599,1001,223,1,223,1008,677,677,224,1002,223,2,223,1005,224,614,101,1,223,223,1107,226,677,224,102,2,223,223,1005,224,629,101,1,223,223,1108,677,226,224,1002,223,2,223,1005,224,644,1001,223,1,223,1107,677,226,224,1002,223,2,223,1006,224,659,1001,223,1,223,108,226,226,224,102,2,223,223,1006,224,674,101,1,223,223,4,223,99,226

--- a/src/2019/day-02.lisp	Wed Dec 04 12:04:52 2019 -0500
+++ b/src/2019/day-02.lisp	Thu Dec 05 19:36:23 2019 -0500
@@ -1,30 +1,17 @@
 (defpackage :advent/2019/02 #.cl-user::*advent-use*)
 (in-package :advent/2019/02)
 
-(defun run-intcode (memory a b)
-  (let ((memory (fresh-vector memory)))
-    (macrolet ((m (addr &rest deltas)
-                 `(aref memory (+ ,addr ,@deltas))))
-      (iterate
-        (initially (setf (m 1) a
-                         (m 2) b))
-        (with pc = 0)
-        (for op   = (m pc))
-        (for x    = (m (m pc 1)))
-        (for y    = (m (m pc 2)))
-        (for dest = (m pc 3))
-        (ecase op
-          (1 (setf (m dest) (+ x y)))
-          (2 (setf (m dest) (* x y)))
-          (99 (return (m 0))))
-        (incf pc 4)))))
+(define-problem (2019 2) (data read-numbers) (3790689 6533)
+  (let ((program (fresh-vector data)))
+    (flet ((run (a b)
+             (setf (aref program 1) a
+                   (aref program 2) b)
+             (advent/intcode:run program)))
+      (values
+        (run 12 2)
+        (iterate
+          (for-nested ((a :from 0 :to 99)
+                       (b :from 0 :to 99)))
+          (when (= 19690720 (run a b))
+            (return (+ (* 100 a) b))))))))
 
-(define-problem (2019 2) (data read-numbers) ()
-  (values
-    (run-intcode data 12 2)
-    (iterate
-      (for-nested ((a :from 0 :to 99)
-                   (b :from 0 :to 99)))
-      (when (= 19690720 (run-intcode data a b))
-        (return (+ (* 100 a) b))))))
-

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/day-05.lisp	Thu Dec 05 19:36:23 2019 -0500
@@ -0,0 +1,9 @@
+(defpackage :advent/2019/05 #.cl-user::*advent-use*)
+(in-package :advent/2019/05)
+
+(define-problem (2019 5) (data read-numbers) (14522484 4)
+  (values
+    (car (last (gathering
+                 (advent/intcode:run data :input (constantly 1) :output #'gather))))
+    (car (gathering
+           (advent/intcode:run data :input (constantly 5) :output #'gather)))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/intcode.lisp	Thu Dec 05 19:36:23 2019 -0500
@@ -0,0 +1,196 @@
+(defpackage :advent/intcode
+  #.cl-user::*advent-use*
+  (:shadow :step :trace)
+  (:export :init :step :run))
+
+(in-package :advent/intcode)
+
+
+;;;; Data Structures ----------------------------------------------------------
+(defclass* machine ()
+  ((pc :type '(integer 0) :initform 0)
+   (memory :type 'vector)
+   (input :type 'function)
+   (output :type 'function)))
+
+(define-with-macro machine pc memory input output)
+
+
+(defclass* operation ()
+  ((opcode :type (integer 0))
+   (name :type 'symbol)
+   (size :type '(integer 1))
+   (parameters :type 'list)
+   (perform :type 'function)))
+
+(defun perform-operation (opcode parameter-modes machine)
+  (funcall (perform (gethash opcode *operations*))
+           parameter-modes machine))
+
+
+;;;; Opcode Definition --------------------------------------------------------
+(defun retrieve (machine parameter-mode operand)
+  (ecase parameter-mode
+    (0 (aref (memory machine) operand))
+    (1 operand)))
+
+(defmacro define-opcode ((opcode name) parameters &body body)
+  ;; Note that (confusingly) output parameters don't use the same addressing
+  ;; scheme as input parameters.  For example: in the instruction 00002,1,2,99
+  ;; all the parameter modes are 0, which means "look up the value at address
+  ;; N to get the parameter".  But for the destination (99) you *don't* look up
+  ;; the value at 99 to find the destination address, you just store directly
+  ;; into 99.  Effectively they're treated as if they were in parameter mode
+  ;; 1 (immediate mode).  So we need to handle output parameters specially.
+  ;;
+  ;; Sigh.
+  (setf parameters (mapcar (lambda (param)
+                             (if (symbolp param)
+                               `(,param in)
+                               param))
+                           parameters))
+  (let ((function-name (alexandria:symbolicate 'op- name)))
+    (alexandria:with-gensyms (machine pmodes pm pms)
+      `(progn
+         (defun ,function-name (,pmodes ,machine)
+           (declare (ignorable ,pmodes))
+           (flet ((pop-mode ()
+                    (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10)
+                      (setf ,pmodes ,pms)
+                      ,pm)))
+             (with-machine (,machine)
+               (let (,@(iterate
+                         (for (param kind) :in parameters)
+                         (for offset :from 0)
+                         (collect
+                           (ecase kind
+                             (in `(,param (retrieve ,machine
+                                                    (pop-mode)
+                                                    (aref memory (+ pc ,offset)))))
+                             (out `(,param (progn
+                                             (pop-mode)
+                                             (aref memory (+ pc ,offset)))))))))
+                 (incf pc ,(length parameters))
+                 ,@body))))
+         (setf (gethash ,opcode *operations*)
+               (make-instance 'operation
+                 :opcode ,opcode
+                 :name ',name
+                 :size ,(1+ (length parameters))
+                 :parameters ',parameters
+                 :perform #',function-name))
+         ',function-name))))
+
+
+;;;; Opcodes ------------------------------------------------------------------
+(defparameter *operations* (make-hash-table))
+
+(define-opcode (99 HLT) ()
+  :halt)
+
+(define-opcode (1 ADD) (x y (dest out))
+  (setf (aref memory dest) (+ x y)))
+
+(define-opcode (2 MUL) (x y (dest out))
+  (setf (aref memory dest) (* x y)))
+
+(define-opcode (3 INP) ((dest out))
+  (setf (aref memory dest) (funcall input)))
+
+(define-opcode (4 OUT) (val)
+  (funcall output val))
+
+(define-opcode (5 JPT) (x addr)
+  (unless (zerop x)
+    (setf pc addr)))
+
+(define-opcode (6 JPF) (x addr)
+  (when (zerop x)
+    (setf pc addr)))
+
+(define-opcode (7 LES) (x y (dest out))
+  (setf (aref memory dest)
+        (if (< x y) 1 0)))
+
+(define-opcode (8 EQL) (x y (dest out))
+  (setf (aref memory dest)
+        (if (= x y) 1 0)))
+
+
+;;;; Disassembly --------------------------------------------------------------
+(defun parse-op (n)
+  (multiple-value-bind (parameter-modes opcode) (truncate n 100)
+    (values opcode parameter-modes)))
+
+(defun disassemble-operation (program address)
+  (multiple-value-bind (opcode parameter-modes)
+      (parse-op (aref program address))
+    (let ((op (gethash opcode *operations*)))
+      (if op
+        (values
+          `(,(name op)
+            ,@(iterate
+                (for (param kind) :in (parameters op))
+                (for value :in-vector program :from (1+ address))
+                (for mode = (mod parameter-modes 10))
+                (collect `(,param ,(ecase kind
+                                     (in (ecase mode
+                                           (0 (vector value))
+                                           (1 value)))
+                                     (out value))))
+                (setf parameter-modes (truncate parameter-modes 10))))
+          (size op))
+        (values `(data ,(aref program address)) 1)))))
+
+(defun disassemble-program (program &key (start 0) (limit nil))
+  (iterate
+    (when limit
+      (if (zerop limit)
+        (return)
+        (decf limit)))
+    (with address = start)
+    (with bound = (length program))
+    (while (< address bound))
+    (for (values instruction size) = (disassemble-operation program address))
+    (for end = (+ address size))
+    (when (> end bound) ; hack to handle trailing data that looks instructionish
+      (setf instruction `(data ,(aref program address))
+            size 1
+            end (1+ address)))
+    (for bytes = (coerce (subseq program address end) 'list))
+    (format t "~4D | ~{~5D~^ ~} ~36T| ~{~A~^ ~}~%" address bytes instruction)
+    (incf address size)))
+
+
+;;;; Running ------------------------------------------------------------------
+(defun init (program &key input output)
+  (make-instance 'machine
+    :memory (fresh-vector program)
+    :input (or input #'read)
+    :output (or output #'print)))
+
+(defun step (machine &key trace)
+  (with-machine (machine)
+    (when trace
+      (disassemble-program (memory machine) :start pc :limit 1))
+    (multiple-value-bind (opcode parameter-modes) (parse-op (aref memory pc))
+      (incf pc)
+      (perform-operation opcode parameter-modes machine))))
+
+(defun run (program &key input output trace)
+  (iterate
+    (with machine = (init program :input input :output output))
+    (case (step machine :trace trace)
+      (:halt (return (aref (memory machine) 0))))))
+
+
+#; Scratch --------------------------------------------------------------------
+
+(defparameter *m* (init '(1101 100 -1 4 99)))
+(dump *m*)
+(disassemble-operation (memory *m*) 0)
+(disassemble-program (memory *m*))
+(step *m*)
+
+(run #( 3 12 6 12 15 1 13 14 13 4 13 99 -1 0 1 9)
+     :input #'read :output #'print)