ez.el

   1 ;;; ez.el --- Emacs Z-machine
   2
   3 ;; Copyright (C) 2021 Tim Vaughan
   4
   5 ;; Author: Tim Vaughan <timv@ughan.xyz>
   6 ;; Created: 13 Oct 2021
   7 ;; Version: 1.0
   8 ;; Keywords: game
   9 ;; Homepage: http://thelambdalab.xyz/ez
  10 ;; Package-Requires: ((emacs "26"))
  11
  12 ;; This file is not part of GNU Emacs.
  13
  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.
  18
  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.
  23
  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/>.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;; Character set tables
  32
  33 ;; Memory
  34
  35 (defvar ez-memory nil
  36   "Memory of z-machine.")
  37
  38 (defvar ez-version nil)
  39
  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)
  46
  47 (defun ez-mem-ref-byte (addr)
  48   (aref ez-memory addr))
  49
  50 (defun ez-mem-set-byte (addr val)
  51   (aset ez-memory addr val))
  52
  53 (defun ez-mem-ref-word (addr)
  54   (+ (* 256 (aref ez-memory addr))
  55      (aref ez-memory (+ addr 1))))
  56
  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)))
  62
  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)))
  71
  72 (defun ez-load-file (filename)
  73   "Load story file into memory."
  74   (with-temp-buffer
  75     (insert-file-contents-literally filename)
  76     (setq ez-memory (encode-coding-string (buffer-string) 'raw-text))))
  77
  78 ;; Global variables
  79
  80 (defun ez-get-global-var (gvar)
  81   (ez-mem-ref-word (+ (* 2 gvar) (ez-mem-ref-word ez-globalvartab-addr))))
  82
  83 (defun ez-set-global-var (gvar val)
  84   (ez-mem-set-word (+ (* 2 gvar) (ez-mem-ref-word ez-globalvartab-addr)) val))
  85
  86 ;; Object tree
  87
  88 (defun ez-make-obj (&optional name attribs props parent first-child next-sibling)
  89     (list name attribs props parent first-child next-sibling))
  90
  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))
  97
  98 (defvar ez-property-defaults nil)
  99
 100 (defun ez-load-property-defaults ()
 101   (setq ez-property-defaults (make-vector 31 0))
 102   (dotimes (i 31)
 103     (aset ez-property-defaults i (aref ez-memory (+ ez-objtab-addr (* 2 i))))))
 104
 105 (defun ez-get-obj (obj-id)
 106   (let ((addr (+ ez-objtab-addr
 107                  (* 2 31)
 108                  (* 9 (- obj-id 1)))))
 109     (list
 110      obj-id
 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))
 118          "")))))
 119
 120
 121 ;; Z-strings
 122
 123 (defvar ez-zstring-alphabets
 124   ;                1    1    2    2    3
 125   ;      0    5    0    5    0    5    0
 126   (list "      abcdefghijklmnopqrstuvwxyz"
 127         "      ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 128         "       \n0123456789.,!?_#'\"/\\-:()")
 129   "Alphabets used by V3")
 130
 131 (defun ez-parse-zstring-word (word)
 132   (list (lsh word -15)
 133         (logand (lsh word -10) #b11111)
 134         (logand (lsh word -5) #b11111)
 135         (logand word #b11111)))
 136
 137 (defun ez-get-zstring-chars (base-addr)
 138   (let ((addr base-addr)
 139         (chars nil)
 140         (not-done t))
 141     (while not-done
 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))))
 147     chars))
 148
 149 (defun ez-get-zstring (base-addr)
 150   (let ((chars (ez-get-zstring-chars base-addr))
 151         (cur 0)
 152         (lock 0)
 153         (abbrev-char nil)
 154         (s ""))
 155     (dolist (char chars)
 156       (cond
 157        (abbrev-char
 158         (let ((abbrev-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))
 165        ((= char 4)
 166         (setq cur (mod (+ cur 1) 2)))
 167        ((= char 5)
 168         (setq cur (mod (+ 2 (- cur 1)) 2)))
 169        (t
 170         (setq s (concat s (substring (elt ez-zstring-alphabets cur)
 171                                      char (+ char 1))))
 172         (setq cur lock))))
 173     s))
 174
 175
 176 ;; Call stack
 177
 178 (defvar ez-call-stack nil)
 179
 180 (defun ez-make-call-stack-frame (pc &optional call-method)
 181   (list pc
 182         nil
 183         (make-vector 15 0)
 184         call-method))
 185
 186 (defun ez-add-call-stack-frame (pc &optional call-method)
 187   (push (ez-make-call-stack-frame pc call-method) ez-call-stack))
 188
 189 (defun ez-pop-call-stack-frame ()
 190   (pop ez-call-stack))
 191
 192 (defun ez-routine-stack ()
 193   (elt (car ez-call-stack) 1))
 194
 195 (defun ez-routine-stack-push (val)
 196   (let ((frame (car ez-call-stack)))
 197     (setf (elt frame 1) (cons val (elt frame 1)))))
 198
 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)))
 203     rs-head))
 204
 205 (defun ez-get-local-var (lvar)
 206   (let ((frame (car ez-call-stack)))
 207     (aref (elt frame 2) (- lvar 1))))
 208
 209 (defun ez-set-local-var (lvar val)
 210   (let ((frame (car ez-call-stack)))
 211     (aset (elt frame 2) (- lvar 1) val)))
 212
 213 (defun ez-get-pc ()
 214   (caar ez-call-stack))
 215
 216 (defun ez-set-pc (new-pc)
 217   (setf (car (car ez-call-stack)) new-pc))
 218
 219 (defun ez-increment-pc (inc)
 220   (ez-set-pc (+ (ez-get-pc) inc)))
 221
 222
 223 ;; Instruction execution
 224
 225 (defun ez-get-var (var)
 226   (cond
 227    ((= var 0)
 228     (ez-routine-stack-pop))
 229    ((< var 16)
 230     (ez-get-local-var (- var 1)))
 231    (t
 232     (ez-get-global-var (- var 16)))))
 233
 234 (defun ez-set-var (var val)
 235   (cond
 236    ((= var 0)
 237     (ez-routine-stack-push val))
 238    ((< var 16)
 239     (ez-set-local-var (- var 1) val))
 240    (t
 241     (ez-set-global-var (- var 16) val))))
 242
 243 (defun ez-execute-instr ()
 244   (let ((op-byte (ez-mem-ref-byte (ez-get-pc))))
 245     (ez-inc-pc 1)
 246     (cond
 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))))
 259         ))
 260      )))
 261
 262 (ez-get-instr ez-start-pc)
 263 (ez-mem-ref-byte ez-start-pc)
 264
 265 (binformat #xe0)
 266 (binformat #x03)
 267
 268
 269 ;; Main
 270
 271 (defun ez-run (filename)
 272   (ez-load-file filename)
 273   (ez-parse-header)
 274   (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
 275
 276   (while (ez-execute-inst)))
 277
 278 ;; Scratch
 279
 280 (ez-load-file "zork1.z3")
 281 (ez-parse-header)
 282 (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
 283
 284 (ez-get-obj 1)
 285
 286 (defun binformat (n &optional s)
 287   (unless s
 288     (setq s ""))
 289   (let ((d (/ n 2))
 290         (new-s (concat (number-to-string (mod n 2)) s)))
 291     (if (= d 0)
 292         new-s
 293       (binformat d new-s))))
 294
 295
 296 (binformat (ez-mem-ref-byte ez-start-pc))
 297 "11100000"
 298
 299
 300 ;;; ez.el ends here