1 ;;; ez.el --- Emacs Z-machine
3 ;; Copyright (C) 2021 Tim Vaughan
5 ;; Author: Tim Vaughan <timv@ughan.xyz>
6 ;; Created: 13 Oct 2021
9 ;; Homepage: http://thelambdalab.xyz/ez
10 ;; Package-Requires: ((emacs "26"))
12 ;; This file is not part of GNU Emacs.
14 ;; This program is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this file. If not, see <http://www.gnu.org/licenses/>.
31 ;; Character set tables
36 "Memory of z-machine.")
38 (defvar ez-version nil)
40 (defvar ez-start-pc nil)
41 (defvar ez-himem-base nil)
42 (defvar ez-dict-addr nil)
43 (defvar ez-objtab-addr nil)
44 (defvar ez-abbrevtab-addr nil)
45 (defvar ez-globalvartab-addr nil)
47 (defun ez-mem-ref-byte (addr)
48 (aref ez-memory addr))
50 (defun ez-mem-set-byte (addr val)
51 (aset ez-memory addr val))
53 (defun ez-mem-ref-word (addr)
54 (+ (* 256 (aref ez-memory addr))
55 (aref ez-memory (+ addr 1))))
57 (defun ez-mem-set-word (addr val)
58 (let ((byte-high (/ val 256))
59 (byte-low (mod val 256)))
60 (aset ez-memory addr byte-high)
61 (aset ez-memory (+ addr 1) byte-low)))
63 (defun ez-parse-header ()
64 (setq ez-version (ez-mem-ref-byte #x0))
65 (setq ez-himem-addr (ez-mem-ref-word #x4))
66 (setq ez-start-pc (ez-mem-ref-word #x6))
67 (setq ez-dict-base (ez-mem-ref-word #x8))
68 (setq ez-objtab-addr (ez-mem-ref-word #xA))
69 (setq ez-globalvartab-addr (ez-mem-ref-word #xC))
70 (setq ez-abbrevtab-addr (ez-mem-ref-word #x18)))
72 (defun ez-load-file (filename)
73 "Load story file into memory."
75 (insert-file-contents-literally filename)
76 (setq ez-memory (encode-coding-string (buffer-string) 'raw-text))))
80 (defun ez-get-global-var (gvar)
81 (ez-mem-ref-word (+ (* 2 gvar) (ez-mem-ref-word ez-globalvartab-addr))))
83 (defun ez-set-global-var (gvar val)
84 (ez-mem-set-word (+ (* 2 gvar) (ez-mem-ref-word ez-globalvartab-addr)) val))
88 (defun ez-make-obj (&optional name attribs props parent first-child next-sibling)
89 (list name attribs props parent first-child next-sibling))
91 (defun ez-obj-name (obj) (elt obj 0))
92 (defun ez-obj-attribs (obj) (elt obj 1))
93 (defun ez-obj-props (obj) (elt obj 2))
94 (defun ez-obj-parent (obj) (elt obj 3))
95 (defun ez-obj-first-child (obj) (elt obj 4))
96 (defun ez-obj-next-sibling (obj) (elt obj 5))
98 (defvar ez-property-defaults nil)
100 (defun ez-load-property-defaults ()
101 (setq ez-property-defaults (make-vector 31 0))
103 (aset ez-property-defaults i (aref ez-memory (+ ez-objtab-addr (* 2 i))))))
105 (defun ez-get-obj (obj-id)
106 (let ((addr (+ ez-objtab-addr
108 (* 9 (- obj-id 1)))))
111 (ez-mem-ref-byte (+ addr 4))
112 (ez-mem-ref-byte (+ addr 5))
113 (ez-mem-ref-byte (+ addr 6))
114 (ez-mem-ref-word (+ addr 7))
115 (let ((plist-addr (ez-mem-ref-word (+ addr 7))))
116 (if (> (ez-mem-ref-byte plist-addr) 0)
117 (ez-get-zstring (+ 1 plist-addr))
123 (defvar ez-zstring-alphabets
126 (list " abcdefghijklmnopqrstuvwxyz"
127 " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
128 " \n0123456789.,!?_#'\"/\\-:()")
129 "Alphabets used by V3")
131 (defun ez-parse-zstring-word (word)
133 (logand (lsh word -10) #b11111)
134 (logand (lsh word -5) #b11111)
135 (logand word #b11111)))
137 (defun ez-get-zstring-chars (base-addr)
138 (let ((addr base-addr)
142 (let ((components (ez-parse-zstring-word (ez-mem-ref-word addr))))
143 (setq chars (append chars (cdr components)))
144 (setq addr (+ addr 2))
145 (when (= (car components) 1)
146 (setq not-done nil))))
149 (defun ez-get-zstring (base-addr)
150 (let ((chars (ez-get-zstring-chars base-addr))
159 (* 2 (ez-mem-ref-word (+ ez-abbrevtab-addr
160 (* 2 (+ (* (- abbrev-char 1) 32) char)))))))
161 (setq s (concat s (ez-get-zstring abbrev-addr))))
162 (setq abbrev-char nil))
163 ((memq char '(1 2 3)) ;Abbreviation
164 (setq abbrev-char char))
166 (setq cur (mod (+ cur 1) 2)))
168 (setq cur (mod (+ 2 (- cur 1)) 2)))
170 (setq s (concat s (substring (elt ez-zstring-alphabets cur)
178 (defvar ez-call-stack nil)
180 (defun ez-make-call-stack-frame (pc &optional call-method)
186 (defun ez-add-call-stack-frame (pc &optional call-method)
187 (push (ez-make-call-stack-frame pc call-method) ez-call-stack))
189 (defun ez-pop-call-stack-frame ()
192 (defun ez-routine-stack ()
193 (elt (car ez-call-stack) 1))
195 (defun ez-routine-stack-push (val)
196 (let ((frame (car ez-call-stack)))
197 (setf (elt frame 1) (cons val (elt frame 1)))))
199 (defun ez-routine-stack-pop ()
200 (let* ((frame (car ez-call-stack))
201 (rs-head (car (elt frame 1))))
202 (setf (elt frame 1) (cdr (elt frame 1)))
205 (defun ez-get-local-var (lvar)
206 (let ((frame (car ez-call-stack)))
207 (aref (elt frame 2) (- lvar 1))))
209 (defun ez-set-local-var (lvar val)
210 (let ((frame (car ez-call-stack)))
211 (aset (elt frame 2) (- lvar 1) val)))
214 (caar ez-call-stack))
216 (defun ez-set-pc (new-pc)
217 (setf (car (car ez-call-stack)) new-pc))
219 (defun ez-increment-pc (inc)
220 (ez-set-pc (+ (ez-get-pc) inc)))
223 ;; Instruction execution
225 (defun ez-get-var (var)
228 (ez-routine-stack-pop))
230 (ez-get-local-var (- var 1)))
232 (ez-get-global-var (- var 16)))))
234 (defun ez-set-var (var val)
237 (ez-routine-stack-push val))
239 (ez-set-local-var (- var 1) val))
241 (ez-set-global-var (- var 16) val))))
243 (defun ez-execute-instr ()
244 (let ((op-byte (ez-mem-ref-byte (ez-get-pc))))
247 ((<= #x0 op-byte #x1f) (list '2op op-byte 'b 'b))
248 ((<= #x20 op-byte #x3F) (list '2op (- op-byte #x20) 'b 'v))
249 ((<= #x40 op-byte #x5F) (list '2op (- op-byte #x40) 'v 'b))
250 ((<= #x60 op-byte #x7F) (list '2op (- op-byte #x60) 'v 'v))
251 ((<= #x80 op-byte #x8F) (list '1op (- op-byte #x80) 'w))
252 ((<= #x90 op-byte #x9F) (list '1op (- op-byte #x90) 'b))
253 ((<= #xA0 op-byte #xAF) (list '1op (- op-byte #xa0) 'v))
254 ((<= #xB0 op-byte #xBF) (list '0op (- op-byte #xb0)))
255 ((<= #xC0 op-byte #xDF) (list '2op (- op-byte #xc0) 'var-instr-format))
256 ((<= #xE0 op-byte #xFF) (list 'var (- op-byte #xe0))
257 (let ((opcode (- op-byte #xe0))
258 (types (ez-mem-ref-byte (ez-get-pc))))
262 (ez-get-instr ez-start-pc)
263 (ez-mem-ref-byte ez-start-pc)
271 (defun ez-run (filename)
272 (ez-load-file filename)
274 (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
276 (while (ez-execute-inst)))
280 (ez-load-file "zork1.z3")
282 (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
286 (defun binformat (n &optional s)
290 (new-s (concat (number-to-string (mod n 2)) s)))
293 (binformat d new-s))))
296 (binformat (ez-mem-ref-byte ez-start-pc))