From f8697a854edd878d8787cc450a2c4d98c8d1b755 Mon Sep 17 00:00:00 2001
From: Thomas Voss <mail@thomasvoss.com>
Date: Mon, 16 Dec 2024 03:57:38 +0100
Subject: Add 2019 day 5 solutions

---
 2019/05/.gitignore    |   1 +
 2019/05/Makefile      |   1 +
 2019/05/puzzles.lisp  |  11 ++++
 2019/interpreter.lisp | 137 ++++++++++++++++++++++++++++++++++++++++++--------
 4 files changed, 129 insertions(+), 21 deletions(-)
 create mode 100644 2019/05/.gitignore
 create mode 100644 2019/05/Makefile
 create mode 100644 2019/05/puzzles.lisp

diff --git a/2019/05/.gitignore b/2019/05/.gitignore
new file mode 100644
index 0000000..5fcaefb
--- /dev/null
+++ b/2019/05/.gitignore
@@ -0,0 +1 @@
+puzzle-[12].lisp
\ No newline at end of file
diff --git a/2019/05/Makefile b/2019/05/Makefile
new file mode 100644
index 0000000..5a21270
--- /dev/null
+++ b/2019/05/Makefile
@@ -0,0 +1 @@
+include ../../Makefiles/lisp.mk
\ No newline at end of file
diff --git a/2019/05/puzzles.lisp b/2019/05/puzzles.lisp
new file mode 100644
index 0000000..e81b352
--- /dev/null
+++ b/2019/05/puzzles.lisp
@@ -0,0 +1,11 @@
+#!/usr/bin/sbcl --script
+
+(load "../interpreter.lisp")
+
+(format t "~a~%" (car (last (intcode:run (intcode:parse "input")
+                                         ;; START PART 1
+                                         '(1)
+                                         ;; END PART 1 START PART 2
+                                         '(5)
+                                         ;; END PART 2
+                                         ))))
\ No newline at end of file
diff --git a/2019/interpreter.lisp b/2019/interpreter.lisp
index 30bee82..0ce6057 100644
--- a/2019/interpreter.lisp
+++ b/2019/interpreter.lisp
@@ -6,27 +6,119 @@
 
 ;;; Interpreter
 
-(defun run (ram)
-  (let ((ip 0))
-    (loop
-     (let ((opcode (aref ram ip))
-           (arg-1 (try-aref ram (+ ip 1)))
-           (arg-2 (try-aref ram (+ ip 2)))
-           (arg-3 (try-aref ram (+ ip 3))))
-       (case opcode
-         (1
-          (setf (aref ram arg-3)
-                (+ (aref ram arg-1)
-                   (aref ram arg-2))))
-         (2
-          (setf (aref ram arg-3)
-                (* (aref ram arg-1)
-                   (aref ram arg-2))))
-         (99
-          (return-from run))
-         (otherwise
-          (error (format nil "Invalid opcode ‘~d’" opcode)))))
-     (incf ip 4))))
+(defstruct opcode
+  instr
+  param-count
+  param-modes
+  last-outputs-p)
+
+(defconstant +instr-add+   1)
+(defconstant +instr-mul+   2)
+(defconstant +instr-set+   3)
+(defconstant +instr-out+   4)
+(defconstant +instr-jt+    5)
+(defconstant +instr-jn+    6)
+(defconstant +instr-le+    7)
+(defconstant +instr-eq+    8)
+(defconstant +instr-quit+ 99)
+
+(defparameter *handlers* (make-array 100))
+
+;; Interpreter State
+(defparameter *ip* 0)
+(defparameter *inputs* nil)
+(defparameter *outputs* nil)
+(defparameter *ram* nil)
+
+(defun run (ram &optional inputs)
+  (setq *ip* 0 *inputs* inputs *outputs* nil *ram* ram)
+  (loop
+    (let* ((opcode (decode-next-opcode))
+           (handler (aref *handlers* (opcode-instr opcode))))
+      (when (eq (apply handler (fetch-arguments opcode)) 'quit)
+        (return-from run (nreverse *outputs*))))))
+
+(defun decode-next-opcode ()
+  (let* ((opcode
+           (aref *ram* *ip*))
+         (instr
+           (mod opcode 100))
+         (param-count
+           (ecase instr
+             (#.+instr-add+  3)
+             (#.+instr-mul+  3)
+             (#.+instr-set+  1)
+             (#.+instr-out+  1)
+             (#.+instr-jt+   2)
+             (#.+instr-jn+   2)
+             (#.+instr-le+   3)
+             (#.+instr-eq+   3)
+             (#.+instr-quit+ 0)))
+         (param-modes
+           (make-array 3 :initial-contents
+                       (list (mod (floor opcode   100) 10)
+                             (mod (floor opcode  1000) 10)
+                             (mod (floor opcode 10000) 10))))
+         (last-outputs-p
+           (member instr '(#.+instr-add+ #.+instr-mul+ #.+instr-set+
+                           #.+instr-le+ #.+instr-eq+))))
+    (make-opcode :instr instr
+                 :param-count param-count
+                 :param-modes param-modes
+                 :last-outputs-p last-outputs-p)))
+
+(defun fetch-arguments (opcode)
+  (when (opcode-last-outputs-p opcode)
+    (setf (aref (opcode-param-modes opcode)
+                (1- (opcode-param-count opcode)))
+          1))
+  (loop for i from 1 to (opcode-param-count opcode)
+        collect (ecase (aref (opcode-param-modes opcode) (1- i))
+                  (0 (aref *ram* (aref *ram* (+ *ip* i))))
+                  (1             (aref *ram* (+ *ip* i))))))
+
+;;; Instructions
+
+(defmacro definstruction (name (&rest params) &body forms)
+  (let ((instr (intern (format nil "+INSTR-~:@(~a~)+" name))))
+    `(setf (aref *handlers* ,instr)
+           (lambda ,params
+             (case (progn ,@forms)
+               ('jumpedp nil)
+               ('quit 'quit)
+               (otherwise (incf *ip* ,(1+ (length params)))))))))
+
+(definstruction add (x y dst)
+  (setf (aref *ram* dst) (+ x y)))
+
+(definstruction mul (x y dst)
+  (setf (aref *ram* dst) (* x y)))
+
+(definstruction set (dst)
+  (setf (aref *ram* dst) (car *inputs*))
+  (setq *inputs* (cdr *inputs*)))
+
+(definstruction out (x)
+  (push x *outputs*))
+
+(definstruction jt (x addr)
+  (unless (zerop x)
+    (setq *ip* addr)
+    'jumpedp))
+
+(definstruction jn (x addr)
+  (when (zerop x)
+    (setq *ip* addr)
+    'jumpedp))
+
+(definstruction le (x y dst)
+  (setf (aref *ram* dst) (bool->int (< x y))))
+
+(definstruction eq (x y dst)
+  (setf (aref *ram* dst) (bool->int (= x y))))
+
+(definstruction quit ()
+  'quit)
 
 ;;; Input Parsing
 
@@ -48,6 +140,9 @@
 (defun commap (char)
   (char= char #\,))
 
+(defun bool->int (bool)
+  (if bool 1 0))
+
 (defun try-aref (array &rest subscripts)
   (loop for i in subscripts
         for j in (array-dimensions array)
-- 
cgit v1.2.3