diff options
| -rw-r--r-- | 2019/05/puzzles.lisp | 19 | ||||
| -rw-r--r-- | 2019/07/Makefile | 1 | ||||
| -rwxr-xr-x | 2019/07/machine.lisp | 9 | ||||
| -rw-r--r-- | 2019/interpreter.lisp | 149 | ||||
| -rw-r--r-- | Makefiles/lisp.mk | 8 |
5 files changed, 102 insertions, 84 deletions
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 diff --git a/Makefiles/lisp.mk b/Makefiles/lisp.mk index b9122df..d181127 100644 --- a/Makefiles/lisp.mk +++ b/Makefiles/lisp.mk @@ -1,8 +1,12 @@ .POSIX: all: - sed '/START PART 2/,/END PART 2/d' puzzles.lisp >puzzle-1.lisp - sed '/START PART 1/,/END PART 1/d' puzzles.lisp >puzzle-2.lisp + sed -e '/START PART 2/,/END PART 2/d' \ + -e '1a(defconstant +puzzle-part+ 1)' \ + puzzles.lisp >puzzle-1.lisp + sed -e '/START PART 1/,/END PART 1/d' \ + -e '1a(defconstant +puzzle-part+ 2)' \ + puzzles.lisp >puzzle-2.lisp chmod +x puzzle-[12].lisp clean: |