Make changes to the interpreter

2 files changed, 118 insertions, 96 deletions

diff --git a/2019/05/puzzles.lisp b/2019/05/puzzles.lisp
index 1d42479..c358e5a 100644
--- a/2019/05/puzzles.lisp
+++ b/2019/05/puzzles.lisp
@@ -2,10 +2,21 @@
 
 (load "../interpreter.lisp")
 
-(format t "~d~%" (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
+(defun main (filename)
+  (let ((stdin (make-string-input-stream
+                ;; START PART 1
+                "1"
+                ;; END PART 1 START PART 2
+                "5"
+                ;; END PART 2
+                ))
+        (stdout (make-string-output-stream)))
+    (intcode:run (intcode:parse "input") stdin stdout)
+    (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)))
+
+(format t "~d~%" (main "input"))
\ No newline at end of file
diff --git a/2019/interpreter.lisp b/2019/interpreter.lisp
index 0ce6057..a1b4838 100644
--- a/2019/interpreter.lisp
+++ b/2019/interpreter.lisp
@@ -6,119 +6,130 @@
 
 ;;; Interpreter
 
-(defstruct opcode
-  instr
-  param-count
-  param-modes
+(defstruct (machine (:conc-name mach-)
+                    (:constructor make-machine
+                        (program stdin stdout))
+                    (:type (vector t)))
+  (ip        0 :type integer)
+  (program nil :type array)
+  (stdin   nil :type (or null stream))
+  (stdout  nil :type (or null stream)))
+
+(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)
 
-(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)
+(defconstant +op-add+   1)
+(defconstant +op-mul+   2)
+(defconstant +op-set+   3)
+(defconstant +op-out+   4)
+(defconstant +op-jt+    5)
+(defconstant +op-jn+    6)
+(defconstant +op-le+    7)
+(defconstant +op-eq+    8)
+(defconstant +op-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))
+(define-condition machine-sysjump (error) ())
+(define-condition machine-sysexit (error) ())
+
+(defun run (program &optional stdin stdout)
+  (loop with mach = (make-machine program stdin stdout) 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)
+        (machine-sysjump (c)
+          (declare (ignore c))
+          (decf (mach-ip mach) ip-shift))
+        (machine-sysexit (c)
+          (declare (ignore c))
+          (return-from run)))
+      (incf (mach-ip mach) ip-shift))))
+
+(defun decode-next-instr (mach)
+  (let* ((raw-instr
+           (aref (mach-program mach) (mach-ip mach)))
+         (opcode
+           (mod raw-instr 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)))
+           (ecase opcode
+             (#.+op-add+  3)
+             (#.+op-mul+  3)
+             (#.+op-set+  1)
+             (#.+op-out+  1)
+             (#.+op-jt+   2)
+             (#.+op-jn+   2)
+             (#.+op-le+   3)
+             (#.+op-eq+   3)
+             (#.+op-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))))
+                       (list (mod (floor raw-instr   100) 10)
+                             (mod (floor raw-instr  1000) 10)
+                             (mod (floor raw-instr 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)))
+           (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 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))))))
+  (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))))))
 
 ;;; 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)))))))))
+  (let ((instr (intern (format nil "+OP-~:@(~a~)+" name))))
+    `(setf (aref *handlers* ,instr) (lambda ,params ,@forms))))
 
-(definstruction add (x y dst)
-  (setf (aref *ram* dst) (+ x y)))
+(definstruction add (mach x y dst)
+  (setf (aref (mach-program mach) dst) (+ x y)))
 
-(definstruction mul (x y dst)
-  (setf (aref *ram* dst) (* x y)))
+(definstruction mul (mach x y dst)
+  (setf (aref (mach-program mach) dst) (* x y)))
 
-(definstruction set (dst)
-  (setf (aref *ram* dst) (car *inputs*))
-  (setq *inputs* (cdr *inputs*)))
+(definstruction set (mach dst)
+  (setf (aref (mach-program mach) dst)
+        (parse-integer (read-line (mach-stdin mach)))))
 
-(definstruction out (x)
-  (push x *outputs*))
+(definstruction out (mach x)
+  (format (mach-stdout mach) "~d~%" x))
 
-(definstruction jt (x addr)
+(definstruction jt (mach x addr)
   (unless (zerop x)
-    (setq *ip* addr)
-    'jumpedp))
+    (setf (mach-ip mach) addr)
+    (error 'machine-sysjump)))
 
-(definstruction jn (x addr)
+(definstruction jn (mach x addr)
   (when (zerop x)
-    (setq *ip* addr)
-    'jumpedp))
+    (setf (mach-ip mach) addr)
+    (error 'machine-sysjump)))
 
-(definstruction le (x y dst)
-  (setf (aref *ram* dst) (bool->int (< x y))))
+(definstruction le (mach x y dst)
+  (setf (aref (mach-program mach) dst) (bool-to-int (< x y))))
 
-(definstruction eq (x y dst)
-  (setf (aref *ram* dst) (bool->int (= x y))))
+(definstruction eq (mach x y dst)
+  (setf (aref (mach-program mach) dst) (bool-to-int (= x y))))
 
-(definstruction quit ()
-  'quit)
+(definstruction quit (mach)
+  (declare (ignore mach))
+  (error 'machine-sysexit))
 
 ;;; Input Parsing
 
@@ -140,7 +151,7 @@
 (defun commap (char)
   (char= char #\,))
 
-(defun bool->int (bool)
+(defun bool-to-int (bool)
   (if bool 1 0))
 
 (defun try-aref (array &rest subscripts)