# HG changeset patch # User Steve Losh # Date 1575592583 18000 # Node ID 646d00acb54a2886357522ab5e2dcc93bc8fe264 # Parent 946ad8d992858ea381995e7f404554cec4686ef0 2019/05 diff -r 946ad8d99285 -r 646d00acb54a advent.asd --- 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"))))) diff -r 946ad8d99285 -r 646d00acb54a data/2019/05.txt --- /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 diff -r 946ad8d99285 -r 646d00acb54a src/2019/day-02.lisp --- 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)))))) - diff -r 946ad8d99285 -r 646d00acb54a src/2019/day-05.lisp --- /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))))) diff -r 946ad8d99285 -r 646d00acb54a src/intcode.lisp --- /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)