+;;; 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
The Lambda Lab / projects / ez.git / commitdiff