From aeeb7856d32a904d22c5f1cdeca443bb7fcd7e49 Mon Sep 17 00:00:00 2001
From: Thomas Voss <mail@thomasvoss.com>
Date: Wed, 18 Dec 2024 18:58:32 +0100
Subject: Refactor the intcode machine
---
2019/05/puzzles.lisp | 19 ++-----
2019/07/Makefile | 1 -
2019/07/machine.lisp | 9 ++-
2019/interpreter.lisp | 149 ++++++++++++++++++++++++++++----------------------
4 files changed, 96 insertions(+), 82 deletions(-)
delete mode 100644 2019/07/Makefile
(limited to '2019')
diff --git a/2019/05/puzzles.lisp b/2019/05/puzzles.lisp
index 28eb32d..7602231 100644
--- a/2019/05/puzzles.lisp
+++ b/2019/05/puzzles.lisp
@@ -3,19 +3,10 @@
(load "../interpreter.lisp")
(defun main (filename)
- (let ((stdout (make-string-output-stream)))
- (intcode:run (intcode:parse "input") nil stdout :initial-arguments
- ;; START PART 1
- '(1)
- ;; END PART 1 START PART 2
- '(5)
- ;; END PART 2
- )
- (parse-integer (last-line (get-output-stream-string stdout)))))
-
-(defun last-line (string)
- (let* ((nl-e (position #\Newline string :from-end t))
- (nl-b (position #\Newline string :from-end t :end nl-e)))
- (subseq string (1+ (or nl-b -1)) nl-e)))
+ (let (result)
+ (intcode:run (intcode:parse filename)
+ (lambda () (if (= +puzzle-part+ 1) 1 5))
+ (lambda (x) (setq result x)))
+ result))
(format t "~d~%" (main "input"))
\ No newline at end of file
diff --git a/2019/07/Makefile b/2019/07/Makefile
deleted file mode 100644
index 5a21270..0000000
--- a/2019/07/Makefile
+++ /dev/null
@@ -1 +0,0 @@
-include ../../Makefiles/lisp.mk
\ No newline at end of file
diff --git a/2019/07/machine.lisp b/2019/07/machine.lisp
index 798bbb8..64157c7 100755
--- a/2019/07/machine.lisp
+++ b/2019/07/machine.lisp
@@ -2,5 +2,10 @@
(load "../interpreter.lisp")
-(intcode:run (intcode:parse "input") *standard-input* *standard-output*
- :initial-arguments (mapcar #'parse-integer (cdr *posix-argv*)))
\ No newline at end of file
+(intcode:run (intcode:parse "input")
+ (lambda ()
+ (parse-integer
+ (if (rest *posix-argv*)
+ (first (setf *posix-argv* (rest *posix-argv*)))
+ (read-line))))
+ (lambda (x) (format t "~d~%" x)))
\ No newline at end of file
diff --git a/2019/interpreter.lisp b/2019/interpreter.lisp
index 719ff9e..532d6a9 100644
--- a/2019/interpreter.lisp
+++ b/2019/interpreter.lisp
@@ -8,22 +8,20 @@
(defstruct (machine (:conc-name mach-)
(:constructor make-machine
- (program stdin stdout initial-arguments))
- (:type (vector t)))
- (ip 0 :type integer)
- (program nil :type array)
- (stdin nil :type (or null stream))
- (stdout nil :type (or null stream))
- (initial-arguments nil :type list))
+ (mem input-handler output-handler)))
+ (ip 0 :type integer)
+ (rel-base 0 :type integer)
+ (mem nil :type array)
+ (ext-mem (make-hash-table) :type hash-table)
+ (input-handler nil :type (or null function))
+ (output-handler nil :type (or null function)))
(defstruct (instruction (:conc-name instr-)
(:constructor make-instruction
- (opcode param-count param-modes last-outputs-p))
- (:type (vector t)))
- (opcode nil :type integer)
- (param-count nil :type integer)
- (param-modes nil :type array)
- last-outputs-p)
+ (opcode param-count param-modes)))
+ (opcode nil :type integer)
+ (param-count nil :type integer)
+ (param-modes nil :type array))
(defconstant +op-add+ 1)
(defconstant +op-mul+ 2)
@@ -33,6 +31,7 @@
(defconstant +op-jn+ 6)
(defconstant +op-le+ 7)
(defconstant +op-eq+ 8)
+(defconstant +op-rel+ 9)
(defconstant +op-quit+ 99)
(defparameter *handlers* (make-array 100))
@@ -40,14 +39,13 @@
(define-condition machine-sysjump (error) ())
(define-condition machine-sysexit (error) ())
-(defun run (program &optional stdin stdout &key initial-arguments)
- (loop with mach = (make-machine program stdin stdout initial-arguments) do
+(defun run (program &optional input-handler output-handler)
+ (loop with mach = (make-machine program input-handler output-handler) do
(let* ((instr (decode-next-instr mach))
(opcode (instr-opcode instr))
(handler (aref *handlers* opcode))
- (arguments (fetch-arguments instr mach))
(ip-shift (1+ (instr-param-count instr))))
- (handler-case (apply handler mach arguments)
+ (handler-case (funcall handler mach instr)
(machine-sysjump (c)
(declare (ignore c))
(decf (mach-ip mach) ip-shift))
@@ -58,7 +56,7 @@
(defun decode-next-instr (mach)
(let* ((raw-instr
- (aref (mach-program mach) (mach-ip mach)))
+ (memref mach (mach-ip mach)))
(opcode
(mod raw-instr 100))
(param-count
@@ -71,51 +69,74 @@
(#.+op-jn+ 2)
(#.+op-le+ 3)
(#.+op-eq+ 3)
+ (#.+op-rel+ 1)
(#.+op-quit+ 0)))
(param-modes
(make-array 3 :initial-contents
(list (mod (floor raw-instr 100) 10)
(mod (floor raw-instr 1000) 10)
- (mod (floor raw-instr 10000) 10))))
- (last-outputs-p
- (member opcode '(#.+op-add+ #.+op-mul+ #.+op-set+
- #.+op-le+ #.+op-eq+))))
- (make-instruction opcode param-count param-modes last-outputs-p)))
-
-(defun fetch-arguments (instr mach)
- (when (instr-last-outputs-p instr)
- (setf (aref (instr-param-modes instr)
- (1- (instr-param-count instr)))
- 1))
- (loop with program = (mach-program mach) with ip = (mach-ip mach)
- for i from 1 to (instr-param-count instr)
- collect (ecase (aref (instr-param-modes instr) (1- i))
- (0 (aref program (aref program (+ ip i))))
- (1 (aref program (+ ip i))))))
+ (mod (floor raw-instr 10000) 10)))))
+ (make-instruction opcode param-count param-modes)))
+
+(defun memref (mach i)
+ (let ((mem (mach-mem mach)))
+ (if (< i (length mem))
+ (aref mem i)
+ (gethash i (mach-ext-mem mach) 0))))
+
+(defun (setf memref) (value mach i)
+ (let ((mem (mach-mem mach)))
+ (if (< i (length mem))
+ (setf (aref mem i) value)
+ (setf (gethash i (mach-ext-mem mach)) value))))
+
+(defun fetch-param (mach i in-out mode)
+ (let* ((ip (mach-ip mach))
+ (rel-base (mach-rel-base mach))
+ (argptr (+ ip i)))
+ (ecase in-out
+ (in (ecase mode
+ (0 (memref mach (memref mach argptr)))
+ (1 (memref mach argptr))
+ (2 (memref mach (+ (memref mach argptr) rel-base)))))
+ (out (ecase mode
+ (0 (memref mach argptr))
+ (2 (+ (memref mach argptr) rel-base)))))))
;;; Instructions
(defmacro definstruction (name (&rest params) &body forms)
- (let ((instr (intern (format nil "+OP-~:@(~a~)+" name))))
- `(setf (aref *handlers* ,instr) (lambda ,params ,@forms))))
-
-(definstruction add (mach x y dst)
- (setf (aref (mach-program mach) dst) (+ x y)))
-
-(definstruction mul (mach x y dst)
- (setf (aref (mach-program mach) dst) (* x y)))
-
-(definstruction set (mach dst)
- (setf (aref (mach-program mach) dst)
- (if (mach-initial-arguments mach)
- (destructuring-bind (head &rest tail)
- (mach-initial-arguments mach)
- (setf (mach-initial-arguments mach) tail)
- head)
- (parse-integer (read-line (mach-stdin mach))))))
+ (let ((op-symbol (intern (format nil "+OP-~:@(~a~)+" name))))
+ `(setf (aref *handlers* ,op-symbol)
+ (lambda (mach instr)
+ (let ((ptype 'in)
+ (i 0)
+ in out)
+ (dolist (param ',(cdr params))
+ (if (eq param '&out)
+ (setq ptype 'out)
+ (let ((pval (fetch-param
+ mach (1+ i) ptype
+ (aref (instr-param-modes instr) i))))
+ (if (eq ptype 'in)
+ (push pval in)
+ (push pval out))
+ (incf i))))
+ (apply (lambda ,(remove-if (lambda (sym) (eq sym '&out)) params)
+ ,@forms)
+ mach (append (reverse in) (reverse out))))))))
+
+(definstruction add (mach x y &out dst)
+ (setf (memref mach dst) (+ x y)))
+
+(definstruction mul (mach x y &out dst)
+ (setf (memref mach dst) (* x y)))
+
+(definstruction set (mach &out dst)
+ (setf (memref mach dst) (funcall (mach-input-handler mach))))
(definstruction out (mach x)
- (format (mach-stdout mach) "~d~%" x))
+ (funcall (mach-output-handler mach) x))
(definstruction jt (mach x addr)
(unless (zerop x)
@@ -127,11 +148,14 @@
(setf (mach-ip mach) addr)
(error 'machine-sysjump)))
-(definstruction le (mach x y dst)
- (setf (aref (mach-program mach) dst) (bool-to-int (< x y))))
+(definstruction le (mach x y &out dst)
+ (setf (memref mach dst) (bool-to-int (< x y))))
+
+(definstruction eq (mach x y &out dst)
+ (setf (memref mach dst) (bool-to-int (= x y))))
-(definstruction eq (mach x y dst)
- (setf (aref (mach-program mach) dst) (bool-to-int (= x y))))
+(definstruction rel (mach x)
+ (incf (mach-rel-base mach) x))
(definstruction quit (mach)
(declare (ignore mach))
@@ -149,7 +173,9 @@
(loop for comma-pos = (position-if #'commap string)
collect (parse-integer (subseq string 0 comma-pos)) into numbers
unless comma-pos
- return (coerce numbers 'vector)
+ return (make-array (length numbers)
+ :initial-contents numbers
+ :fill-pointer t)
do (setq string (subseq string (1+ comma-pos)))))
;;; Helper Functions
@@ -158,11 +184,4 @@
(char= char #\,))
(defun bool-to-int (bool)
- (if bool 1 0))
-
-(defun try-aref (array &rest subscripts)
- (loop for i in subscripts
- for j in (array-dimensions array)
- unless (< -1 i j)
- return nil
- finally (return (apply #'aref array subscripts))))
\ No newline at end of file
+ (if bool 1 0))
\ No newline at end of file
--
cgit v1.2.3