From c270f548992eba116567e046d935f5d435285535 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Thu, 14 Oct 2021 18:30:52 +0200 Subject: [PATCH] Messing with structure. --- ez.el | 300 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 300 insertions(+) create mode 100644 ez.el diff --git a/ez.el b/ez.el new file mode 100644 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 +;; 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 . + +;;; 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 -- 2.20.1