Messing with structure.

diff --git a/ez.el b/ez.el
new file mode 100644 (file)
index 0000000..906b370
--- /dev/null
+++ b/ez.el
@@ -0,0 +1,300 @@
+;;; ez.el --- Emacs Z-machine
+
+;; Copyright (C) 2021 Tim Vaughan
+
+;; Author: Tim Vaughan <timv@ughan.xyz>
+;; Created: 13 Oct 2021
+;; Version: 1.0
+;; Keywords: game
+;; Homepage: http://thelambdalab.xyz/ez
+;; Package-Requires: ((emacs "26"))
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+;; Character set tables
+
+;; Memory
+
+(defvar ez-memory nil
+  "Memory of z-machine.")
+
+(defvar ez-version nil)
+
+(defvar ez-start-pc nil)
+(defvar ez-himem-base nil)
+(defvar ez-dict-addr nil)
+(defvar ez-objtab-addr nil)
+(defvar ez-abbrevtab-addr nil)
+(defvar ez-globalvartab-addr nil)
+
+(defun ez-mem-ref-byte (addr)
+  (aref ez-memory addr))
+
+(defun ez-mem-set-byte (addr val)
+  (aset ez-memory addr val))
+
+(defun ez-mem-ref-word (addr)
+  (+ (* 256 (aref ez-memory addr))
+     (aref ez-memory (+ addr 1))))
+
+(defun ez-mem-set-word (addr val)
+  (let ((byte-high (/ val 256))
+        (byte-low (mod val 256)))
+    (aset ez-memory addr byte-high)
+    (aset ez-memory (+ addr 1) byte-low)))
+
+(defun ez-parse-header ()
+  (setq ez-version (ez-mem-ref-byte #x0))
+  (setq ez-himem-addr (ez-mem-ref-word #x4))
+  (setq ez-start-pc (ez-mem-ref-word #x6))
+  (setq ez-dict-base (ez-mem-ref-word #x8))
+  (setq ez-objtab-addr (ez-mem-ref-word #xA))
+  (setq ez-globalvartab-addr (ez-mem-ref-word #xC))
+  (setq ez-abbrevtab-addr (ez-mem-ref-word #x18)))
+
+(defun ez-load-file (filename)
+  "Load story file into memory."
+  (with-temp-buffer
+    (insert-file-contents-literally filename)
+    (setq ez-memory (encode-coding-string (buffer-string) 'raw-text))))
+
+;; Global variables
+
+(defun ez-get-global-var (gvar)
+  (ez-mem-ref-word (+ (* 2 gvar) (ez-mem-ref-word ez-globalvartab-addr))))
+
+(defun ez-set-global-var (gvar val)
+  (ez-mem-set-word (+ (* 2 gvar) (ez-mem-ref-word ez-globalvartab-addr)) val))
+
+;; Object tree
+
+(defun ez-make-obj (&optional name attribs props parent first-child next-sibling)
+    (list name attribs props parent first-child next-sibling))
+
+(defun ez-obj-name (obj) (elt obj 0))
+(defun ez-obj-attribs (obj) (elt obj 1))
+(defun ez-obj-props (obj) (elt obj 2))
+(defun ez-obj-parent (obj) (elt obj 3))
+(defun ez-obj-first-child (obj) (elt obj 4))
+(defun ez-obj-next-sibling (obj) (elt obj 5))
+
+(defvar ez-property-defaults nil)
+
+(defun ez-load-property-defaults ()
+  (setq ez-property-defaults (make-vector 31 0))
+  (dotimes (i 31)
+    (aset ez-property-defaults i (aref ez-memory (+ ez-objtab-addr (* 2 i))))))
+
+(defun ez-get-obj (obj-id)
+  (let ((addr (+ ez-objtab-addr
+                 (* 2 31)
+                 (* 9 (- obj-id 1)))))
+    (list
+     obj-id
+     (ez-mem-ref-byte (+ addr 4))
+     (ez-mem-ref-byte (+ addr 5))
+     (ez-mem-ref-byte (+ addr 6))
+     (ez-mem-ref-word (+ addr 7))
+     (let ((plist-addr (ez-mem-ref-word (+ addr 7))))
+       (if (> (ez-mem-ref-byte plist-addr) 0)
+           (ez-get-zstring (+ 1 plist-addr))
+         "")))))
+
+
+;; Z-strings
+
+(defvar ez-zstring-alphabets
+  ;                1    1    2    2    3
+  ;      0    5    0    5    0    5    0
+  (list "      abcdefghijklmnopqrstuvwxyz"
+        "      ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+        "       \n0123456789.,!?_#'\"/\\-:()")
+  "Alphabets used by V3")
+
+(defun ez-parse-zstring-word (word)
+  (list (lsh word -15)
+        (logand (lsh word -10) #b11111)
+        (logand (lsh word -5) #b11111)
+        (logand word #b11111)))
+
+(defun ez-get-zstring-chars (base-addr)
+  (let ((addr base-addr)
+        (chars nil)
+        (not-done t))
+    (while not-done
+      (let ((components (ez-parse-zstring-word (ez-mem-ref-word addr))))
+        (setq chars (append chars (cdr components)))
+        (setq addr (+ addr 2))
+        (when (= (car components) 1)
+          (setq not-done nil))))
+    chars))
+
+(defun ez-get-zstring (base-addr)
+  (let ((chars (ez-get-zstring-chars base-addr))
+        (cur 0)
+        (lock 0)
+        (abbrev-char nil)
+        (s ""))
+    (dolist (char chars)
+      (cond
+       (abbrev-char
+        (let ((abbrev-addr
+               (* 2 (ez-mem-ref-word (+ ez-abbrevtab-addr
+                                        (* 2 (+ (* (- abbrev-char 1) 32) char)))))))
+          (setq s (concat s (ez-get-zstring abbrev-addr))))
+        (setq abbrev-char nil))
+       ((memq char '(1 2 3)) ;Abbreviation
+        (setq abbrev-char char))
+       ((= char 4)
+        (setq cur (mod (+ cur 1) 2)))
+       ((= char 5)
+        (setq cur (mod (+ 2 (- cur 1)) 2)))
+       (t 
+        (setq s (concat s (substring (elt ez-zstring-alphabets cur)
+                                     char (+ char 1))))
+        (setq cur lock))))
+    s))
+
+
+;; Call stack
+
+(defvar ez-call-stack nil)
+
+(defun ez-make-call-stack-frame (pc &optional call-method)
+  (list pc
+        nil
+        (make-vector 15 0)
+        call-method))
+
+(defun ez-add-call-stack-frame (pc &optional call-method)
+  (push (ez-make-call-stack-frame pc call-method) ez-call-stack))
+
+(defun ez-pop-call-stack-frame ()
+  (pop ez-call-stack))
+
+(defun ez-routine-stack ()
+  (elt (car ez-call-stack) 1))
+
+(defun ez-routine-stack-push (val)
+  (let ((frame (car ez-call-stack)))
+    (setf (elt frame 1) (cons val (elt frame 1)))))
+
+(defun ez-routine-stack-pop ()
+  (let* ((frame (car ez-call-stack))
+         (rs-head (car (elt frame 1))))
+    (setf (elt frame 1) (cdr (elt frame 1)))
+    rs-head))
+
+(defun ez-get-local-var (lvar)
+  (let ((frame (car ez-call-stack)))
+    (aref (elt frame 2) (- lvar 1))))
+
+(defun ez-set-local-var (lvar val)
+  (let ((frame (car ez-call-stack)))
+    (aset (elt frame 2) (- lvar 1) val)))
+
+(defun ez-get-pc ()
+  (caar ez-call-stack))
+
+(defun ez-set-pc (new-pc)
+  (setf (car (car ez-call-stack)) new-pc))
+
+(defun ez-increment-pc (inc)
+  (ez-set-pc (+ (ez-get-pc) inc)))
+
+
+;; Instruction execution
+
+(defun ez-get-var (var)
+  (cond
+   ((= var 0)
+    (ez-routine-stack-pop))
+   ((< var 16)
+    (ez-get-local-var (- var 1)))
+   (t
+    (ez-get-global-var (- var 16)))))
+
+(defun ez-set-var (var val)
+  (cond
+   ((= var 0)
+    (ez-routine-stack-push val))
+   ((< var 16)
+    (ez-set-local-var (- var 1) val))
+   (t
+    (ez-set-global-var (- var 16) val))))
+
+(defun ez-execute-instr ()
+  (let ((op-byte (ez-mem-ref-byte (ez-get-pc))))
+    (ez-inc-pc 1)
+    (cond
+     ((<= #x0 op-byte #x1f) (list '2op op-byte 'b 'b))
+     ((<= #x20 op-byte #x3F) (list '2op (- op-byte #x20) 'b 'v))
+     ((<= #x40 op-byte #x5F) (list '2op (- op-byte #x40) 'v 'b))
+     ((<= #x60 op-byte #x7F) (list '2op (- op-byte #x60) 'v 'v))
+     ((<= #x80 op-byte #x8F) (list '1op (- op-byte #x80) 'w))
+     ((<= #x90 op-byte #x9F) (list '1op (- op-byte #x90) 'b))
+     ((<= #xA0 op-byte #xAF) (list '1op (- op-byte #xa0) 'v))
+     ((<= #xB0 op-byte #xBF) (list '0op (- op-byte #xb0)))
+     ((<= #xC0 op-byte #xDF) (list '2op (- op-byte #xc0) 'var-instr-format))
+     ((<= #xE0 op-byte #xFF) (list 'var (- op-byte #xe0))
+      (let ((opcode (- op-byte #xe0))
+            (types (ez-mem-ref-byte (ez-get-pc))))
+        ))
+     )))
+
+(ez-get-instr ez-start-pc)
+(ez-mem-ref-byte ez-start-pc)
+
+(binformat #xe0)
+(binformat #x03)
+
+
+;; Main
+
+(defun ez-run (filename)
+  (ez-load-file filename)
+  (ez-parse-header)
+  (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
+
+  (while (ez-execute-inst)))
+
+;; Scratch
+
+(ez-load-file "zork1.z3")
+(ez-parse-header)
+(setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
+
+(ez-get-obj 1)
+
+(defun binformat (n &optional s)
+  (unless s
+    (setq s ""))
+  (let ((d (/ n 2))
+        (new-s (concat (number-to-string (mod n 2)) s)))
+    (if (= d 0)
+        new-s
+      (binformat d new-s))))
+
+
+(binformat (ez-mem-ref-byte ez-start-pc))
+"11100000"
+
+
+;;; ez.el ends here