blob: f0a0a59319afc726fe2bd47c32329ca8c216449e (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(defpackage #:intcode
(:use :cl)
(:export :run :parse))
(in-package #:intcode)
;;; Interpreter
(defstruct (machine (:conc-name mach-)
(:constructor make-machine
(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)))
(opcode nil :type integer)
(param-count nil :type integer)
(param-modes nil :type array))
(defconstant +op-add+ 1)
(defconstant +op-mul+ 2)
(defconstant +op-read+ 3)
(defconstant +op-out+ 4)
(defconstant +op-jt+ 5)
(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))
(define-condition machine-sysjump (error) ())
(define-condition machine-sysexit (error) ())
(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))
(ip-shift (1+ (instr-param-count instr))))
(handler-case (funcall handler mach instr)
(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
(memref mach (mach-ip mach)))
(opcode
(mod raw-instr 100))
(param-count
(ecase opcode
(#.+op-add+ 3)
(#.+op-mul+ 3)
(#.+op-read+ 1)
(#.+op-out+ 1)
(#.+op-jt+ 2)
(#.+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)))))
(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 ((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 read (mach &out dst)
(setf (memref mach dst) (funcall (mach-input-handler mach))))
(definstruction out (mach x)
(funcall (mach-output-handler mach) x))
(definstruction jt (mach x addr)
(unless (zerop x)
(setf (mach-ip mach) addr)
(error 'machine-sysjump)))
(definstruction jn (mach x addr)
(when (zerop x)
(setf (mach-ip mach) addr)
(error 'machine-sysjump)))
(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 rel (mach x)
(incf (mach-rel-base mach) x))
(definstruction quit (mach)
(declare (ignore mach))
(error 'machine-sysexit))
;;; Input Parsing
(defun parse (filename)
(with-open-file (stream filename)
(let ((contents (make-string (file-length stream))))
(read-sequence contents stream)
(extract-numbers-from-string contents))))
(defun extract-numbers-from-string (string)
(loop for comma-pos = (position-if #'commap string)
collect (parse-integer (subseq string 0 comma-pos)) into numbers
unless comma-pos
return (make-array (length numbers)
:initial-contents numbers
:fill-pointer t)
do (setq string (subseq string (1+ comma-pos)))))
;;; Helper Functions
(defun commap (char)
(char= char #\,))
(defun bool-to-int (bool)
(if bool 1 0))
|
