From 6a8f22a5f03a455c5cc4a6af1bfcbf117c9084ee Mon Sep 17 00:00:00 2001 From: plugd Date: Fri, 19 Nov 2021 16:09:10 +0100 Subject: [PATCH 01/10] Everything required up until first input implemented. --- ez.el | 49 ++++++++++++++++++------------------------------- 1 file changed, 18 insertions(+), 31 deletions(-) diff --git a/ez.el b/ez.el index 95547d1..af348a9 100644 --- a/ez.el +++ b/ez.el @@ -535,6 +535,7 @@ ((1op #x05) inc ez-op-inc) ((1op #x06) dec ez-op-dec) ((1op #x0B) ret ez-op-ret) + ((0op #x08) ret_pulled ez-op-ret-pulled) ((1op #x0C) jump ez-op-jump) ((2op #x05) inc_jg ez-op-inc-jg) ((2op #x04) dec_jg ez-op-dec-jg) @@ -546,7 +547,9 @@ ((2op #x10) loadb ez-op-loadb) ((2op #x01) je ez-op-je) ((2op #x02) jl ez-op-jl) + ((2op #x03) jg ez-op-jg) ((2op #x06) jin ez-op-jin) + ((2op #x07) test ez-op-test) ((2op #x08) or ez-op-or) ((2op #x09) and ez-op-and) ((2op #x14) add ez-op-add) @@ -578,6 +581,12 @@ (ez-set-var (ez-read-pc-byte-and-inc) retval)) t) +(defun ez-op-ret-pulled (operands operand-types) + (let ((retval (ez-routine-stack-pop))) + (message "\tReturning value %x" retval) + (ez-op-ret (list retval))) + t) + (defun ez-op-rtrue (&optional operands operand-types) (ez-op-ret (list 1)) t) @@ -625,6 +634,12 @@ (= n (ez-get-obj-parent obj))))) t) +(defun ez-op-test (operands operand-types) + (let ((a (car operands)) + (b (cadr operands))) + (ez-do-branch (= (logand a b) b))) + t) + (defun ez-op-jump (operands operand-types) (let ((offset (if (eq (car operand-types) 'b) (ez-decode-signed-byte (car operands)) @@ -831,52 +846,24 @@ ;;; Buffer and I/O ;; -(defun ez-render-prompt () - (with-current-buffer "*ez*" - (let ((update-point (= ez-input-marker (point))) - (update-window-points (mapcar (lambda (w) - (list (= (window-point w) ez-input-marker) - w)) - (get-buffer-window-list nil nil t)))) - (save-excursion - (set-marker-insertion-type ez-prompt-marker nil) - (set-marker-insertion-type ez-input-marker t) - (let ((inhibit-read-only t)) - (delete-region ez-prompt-marker ez-input-marker) - (goto-char ez-prompt-marker) - (insert - ">" - (propertize " " ; Need this to be separate to mark it as rear-nonsticky - 'read-only t - 'rear-nonsticky t))) - (set-marker-insertion-type ez-input-marker nil)) - (goto-char ez-input-marker)))) - -(defvar ez-prompt-marker nil - "Marker for prompt position in buffer.") - (defvar ez-input-marker nil - "Marker for prompt position in buffer.") + "Marker for input position in buffer.") (defun ez-setup-buffer () (with-current-buffer (get-buffer-create "*ez*") (let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) (setq-local scroll-conservatively 1) - (if (markerp ez-prompt-marker) - (set-marker ez-prompt-marker (point-max)) - (setq ez-prompt-marker (point-max-marker))) (if (markerp ez-input-marker) (set-marker ez-input-marker (point-max)) (setq ez-input-marker (point-max-marker))) - (goto-char (point-max)) - (ez-render-prompt))) + (goto-char (point-max)))) (defun ez-print (string) (with-current-buffer "*ez*" (save-excursion - (goto-char ez-prompt-marker) + (goto-char ez-input-marker) (insert-before-markers string)))) ;; Mode -- 2.20.1 From 6f7b0f5e308675a8c11e2d48482d23f10bb99599 Mon Sep 17 00:00:00 2001 From: plugd Date: Sun, 2 Oct 2022 18:02:57 +0200 Subject: [PATCH 02/10] Reorganised execution loop to cater for input. --- ez.el | 121 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 73 insertions(+), 48 deletions(-) diff --git a/ez.el b/ez.el index af348a9..7a91e57 100644 --- a/ez.el +++ b/ez.el @@ -26,6 +26,13 @@ ;;; Commentary: +;; There are many Z-machine interpreters, but this one is mine. +;; It only capable of interpreting the subset of Z-code necessary +;; to run the first Zork game in z3 format. +;; +;; It is based entirely on the description of the Z-machine contained +;; Marnix Klooster's wonderful document, "The Z-machine And How to Emulate It." + ;;; Code: ;; Utility functions @@ -312,7 +319,6 @@ (defun ez-get-zstring (base-addr) (cdr (ez-get-zstring-and-length base-addr))) - ;; Call stack (defvar ez-call-stack nil) @@ -572,157 +578,158 @@ ((0op #x0B) new_line ez-op-new-line) ((var #x06) print_num ez-op-print-num) ((var #x05) print_char ez-op-print-char) - ((1op #x0A) print_obj ez-op-print-obj))) + ((1op #x0A) print_obj ez-op-print-obj) + ((var #x04) read ez-op-read))) (defun ez-op-ret (operands &optional operand-types) (let ((retval (car operands))) (message "\tReturning value %x" retval) (ez-pop-call-stack-frame) (ez-set-var (ez-read-pc-byte-and-inc) retval)) - t) + 'run) (defun ez-op-ret-pulled (operands operand-types) (let ((retval (ez-routine-stack-pop))) (message "\tReturning value %x" retval) (ez-op-ret (list retval))) - t) + 'run) (defun ez-op-rtrue (&optional operands operand-types) (ez-op-ret (list 1)) - t) + 'run) (defun ez-op-rfalse (&optional operands operand-types) (ez-op-ret (list 0)) - t) + 'run) (defun ez-op-jz (operands operand-types) (ez-do-branch (= (car operands) 0)) - t) + 'run) (defun ez-op-je (operands operand-types) (ez-do-branch (memq (car operands) (cdr operands))) - t) + 'run) (defun ez-op-jg (operands operand-types) (let ((s1 (ez-decode-signed-operand (car operands) (car operand-types))) (s2 (ez-decode-signed-operand (cadr operands) (cadr operand-types)))) (ez-do-branch (> s1 s2))) - t) + 'run) (defun ez-op-jl (operands operand-types) (let ((s1 (ez-decode-signed-operand (car operands) (car operand-types))) (s2 (ez-decode-signed-operand (cadr operands) (cadr operand-types)))) (ez-do-branch (< s1 s2))) - t) + 'run) (defun ez-op-inc-jg (operands operand-types) (let ((var (car operands))) (ez-op-inc (list var)) (ez-op-jg (cons (ez-get-var var) (cdr operands)) (cons 'w (cdr operand-types)))) - t) + 'run) (defun ez-op-dec-jl (operands operand-types) (let ((var (car operands))) (ez-op-dec (list var)) (ez-op-jl (cons (ez-get-var var) (cdr operands)) (cons 'w (cdr operand-types)))) - t) + 'run) (defun ez-op-jin (operands operand-types) (let ((obj (car operands)) (n (cadr operands))) (ez-do-branch (or (= n 0) (= n (ez-get-obj-parent obj))))) - t) + 'run) (defun ez-op-test (operands operand-types) (let ((a (car operands)) (b (cadr operands))) (ez-do-branch (= (logand a b) b))) - t) + 'run) (defun ez-op-jump (operands operand-types) (let ((offset (if (eq (car operand-types) 'b) (ez-decode-signed-byte (car operands)) (ez-decode-signed-word (car operands))))) (ez-set-pc (+ (ez-get-pc) offset -2))) - t) + 'run) (defun ez-op-inc (operands &optional operand-types) (let ((var (car operands))) (ez-set-var var (mod (+ 1 (ez-get-var var)) #x10000))) - t) + 'run) (defun ez-op-dec (operands &optional operand-types) (let ((var (car operands))) (ez-set-var var (mod (+ (ez-get-var var) 1) #x10000))) - t) + 'run) (defun ez-op-store (operands operand-types) (let ((var (car operands)) (a (cadr operands))) (ez-set-var var a)) - t) + 'run) (defun ez-op-load (operands operand-types) (let ((var (car operands))) (ez-set-var (ez-read-pc-byte-and-inc) (ez-get-var var))) - t) + 'run) (defun ez-op-storew (operands operand-types) (let ((baddr (car operands)) (n (cadr operands)) (a (caddr operands))) (ez-mem-set-word (+ baddr (* 2 n)) a)) - t) + 'run) (defun ez-op-loadw (operands operand-types) (let ((baddr (car operands)) (n (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (ez-mem-ref-word (+ baddr (* 2 n))))) - t) + 'run) (defun ez-op-storeb (operands operand-types) (let ((baddr (car operands)) (n (cadr operands)) (a (caddr operands))) (ez-mem-set-byte (+ baddr n) a)) - t) + 'run) (defun ez-op-loadb (operands operand-types) (let ((baddr (car operands)) (n (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (ez-mem-ref-byte (+ baddr n)))) - t) + 'run) (defun ez-op-and (operands operand-types) (let ((a (car operands)) (b (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (logand a b))) - t) + 'run) (defun ez-op-or (operands operand-types) (let ((a (car operands)) (b (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (logior a b))) - t) + 'run) (defun ez-op-add (operands operand-types) (let ((a (car operands)) (b (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (mod (+ a b) #x10000))) - t) + 'run) (defun ez-op-sub (operands operand-types) (let ((a (car operands)) (b (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (mod (+ (- a b) #x10000) #x10000))) - t) + 'run) (defun ez-op-mul (a b) (let ((a (car operands)) (b (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (mod (* a b) #x10000))) - t) + 'run) (defun ez-op-div (a b) (error "Not implemented")) @@ -744,67 +751,67 @@ (if (< i n) (ez-set-local-var (+ i 1) (elt call-operands i)) (ez-set-local-var (+ i 1) (ez-mem-ref-word (+ r 1 (* 2 i)))))))) - t) + 'run) (defun ez-op-test-attr (operands operand-types) (let ((obj (car operands)) (attr (cadr operands))) (ez-do-branch (= 1 (ez-get-obj-attr obj attr))) - t)) + 'run)) (defun ez-op-set-attr (operands operand-types) (let ((obj (car operands)) (attr (cadr operands))) (ez-set-obj-attr obj attr 1)) - t) + 'run) (defun ez-op-clear-attr (operands operand-types) (let ((obj (car operands)) (attr (cadr operands))) (ez-set-obj-attr obj attr 0)) - t) + 'run) (defun ez-op-get-sibling (operands operand-types) (let ((sib (ez-get-obj-sibling (car operands)))) (ez-set-var (ez-read-pc-byte-and-inc) sib) (ez-do-branch (> sib 0))) - t) + 'run) (defun ez-op-get-child (operands operand-types) (let ((child (ez-get-obj-child (car operands)))) (ez-set-var (ez-read-pc-byte-and-inc) child) (ez-do-branch (> child 0))) - t) + 'run) (defun ez-op-get-parent (operands operand-types) (let ((parent (ez-get-obj-parent (car operands)))) (ez-set-var (ez-read-pc-byte-and-inc) parent)) - t) + 'run) (defun ez-op-remove-obj (operands operand-types) (let ((obj (car operands))) (ez-remove-obj obj)) - t) + 'run) (defun ez-op-insert-obj (operands operand-types) (let ((obj1 (car operands)) (obj2 (cadr operands))) (ez-insert-obj obj1 obj2)) - t) + 'run) (defun ez-op-put-prop (operands operand-types) (let* ((obj (car operands)) (prop (cadr operands)) (a (caddr operands))) (ez-set-obj-prop obj prop a)) - t) + 'run) (defun ez-op-get-prop (operands operand-types) (let* ((obj (car operands)) (prop (cadr operands))) (ez-set-var (ez-read-pc-byte-and-inc) (ez-get-obj-prop obj prop))) - t) + 'run) (defun ez-op-print (operands operand-types) (let* ((word-count-and-string (ez-get-zstring-and-length (ez-get-pc))) @@ -812,36 +819,49 @@ (string (cdr word-count-and-string))) (ez-print string) (ez-increment-pc (* 2 word-count))) - t) + 'run) (defun ez-op-new-line (operands operand-types) (ez-print "\n") - t) + 'run) (defun ez-op-print-num (operands operand-types) (let ((s (ez-decode-signed-operand (car operands) (car operand-types)))) (ez-print (number-to-string s))) - t) + 'run) (defun ez-op-print-char (operands operand-types) (let ((c (car operands))) (ez-print (string c))) - t) + 'run) (defun ez-op-print-obj (operands operand-types) (let ((obj (car operands))) (ez-print (ez-get-obj-name obj))) - t) + 'run) + +(defun ez-op-read (operands operand-types) + (let ((baddr1 (car operands)) + (baddr2 (cadr operands))) + ) + 'wait-for-input) ;; Execution loop -(defun ez-run (filename) +(defun ez-load-and-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-instr))) + (ez-run)) +(defvar ez-machine-state nil + "Identifies the current executation state of the Z-machine.") + +(defun ez-run () + (setq ez-machine-state 'run) + (while (eq ez-machine-state 'run) + (setq ez-machine-state (ez-execute-instr)))) ;;; Buffer and I/O ;; @@ -866,6 +886,11 @@ (goto-char ez-input-marker) (insert-before-markers string)))) +(defun ez-enter () + (interactive) + (with-current-buffer "*ez*" + (buffer-substring ez-input-marker (point-max)))) + ;; Mode (defvar ez-mode-map @@ -886,7 +911,7 @@ (switch-to-buffer "*ez*") (ez-mode) (ez-setup-buffer) - (ez-run zfile)) + (ez-load-and-run zfile)) "Started EZ.") (defun ez-debug () @@ -894,6 +919,6 @@ (switch-to-buffer "*ez*") (ez-mode) (ez-setup-buffer) - (ez-run "zork1.z3")) + (ez-load-and-run "zork1.z3")) ;;; ez.el ends here -- 2.20.1 From c2bf7428388aedee98c42c52c3c1bf2ac75f29bc Mon Sep 17 00:00:00 2001 From: plugd Date: Tue, 4 Oct 2022 09:15:09 +0200 Subject: [PATCH 03/10] Scaffolding for input processing. --- ez.el | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/ez.el b/ez.el index 7a91e57..f96005a 100644 --- a/ez.el +++ b/ez.el @@ -840,12 +840,19 @@ (ez-print (ez-get-obj-name obj))) 'run) +(defvar ez--next-read-args nil) (defun ez-op-read (operands operand-types) (let ((baddr1 (car operands)) (baddr2 (cadr operands))) - ) + (setq ez--next-read-args (list baddr1 baddr2))) 'wait-for-input) +(defun ez-op-read2 (input-string) + (ez-tokenize-string input-string + (car ez--next-read-args) + (cadr ez--next-read-args)) + 'run) + ;; Execution loop (defun ez-load-and-run (filename) @@ -888,8 +895,12 @@ (defun ez-enter () (interactive) - (with-current-buffer "*ez*" - (buffer-substring ez-input-marker (point-max)))) + (if (not (eq ez-machine-state 'wait-for-input)) + (error "Z-machine not ready for input.")) + (let ((input-string (with-current-buffer "*ez*" + (buffer-substring ez-input-marker (point-max))))) + (ez-op-read2 input-string) + (ez-run))) ;; Mode -- 2.20.1 From fcb66a431dd743fd06547505ab8476d7d961f853 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 10 Apr 2023 10:16:39 +0200 Subject: [PATCH 04/10] Added trace and memory buffers. --- ez.el | 57 ++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 44 insertions(+), 13 deletions(-) diff --git a/ez.el b/ez.el index f96005a..65990b7 100644 --- a/ez.el +++ b/ez.el @@ -123,12 +123,12 @@ (error "Invalid global variable %d" gvar)) (let ((val (ez-mem-ref-word (+ (* 2 gvar) ez-globalvartab-addr)))) - (message "\tRetrieved %x from global variable %x" val gvar) + (ez-debug-message "\tRetrieved %x from global variable %x" val gvar) val)) (defun ez-set-global-var (gvar val) (ez-mem-set-word (+ (* 2 gvar) ez-globalvartab-addr) val) - (message "\tSet global variabl %x to %x" gvar val)) + (ez-debug-message "\tSet global variabl %x to %x" gvar val)) ;; Object tree @@ -340,25 +340,25 @@ (defun ez-routine-stack-push (val) (let ((frame (car ez-call-stack))) - (message "\tPushed %x to stack" val) + (ez-debug-message "\tPushed %x to stack" val) (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))) - (message "\tPopped %x from stack" rs-head) + (ez-debug-message "\tPopped %x from stack" rs-head) rs-head)) (defun ez-get-local-var (lvar) (let* ((frame (car ez-call-stack)) (val (aref (elt frame 2) (- lvar 1)))) - (message "\tRetrieved value %x from local variable %x" val lvar) + (ez-debug-message "\tRetrieved value %x from local variable %x" val lvar) val)) (defun ez-set-local-var (lvar val) (let ((frame (car ez-call-stack))) - (message "\tSet local variable %x to %x" lvar val) + (ez-debug-message "\tSet local variable %x to %x" lvar val) (aset (elt frame 2) (- lvar 1) val))) (defun ez-get-pc () @@ -469,7 +469,7 @@ (error "Unsupported op PC:%x Optype:%s Opcode:%x Operands:%s Operand-types:%s" instr-pc optype opcode (ez-list-to-string-hex operands) operand-types)) (let ((mnemonic (elt table-row 1))) - (message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s Operand-types:%s" + (ez-debug-message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s Operand-types:%s" instr-pc optype opcode mnemonic (ez-list-to-string-hex operands) operand-types)) (funcall (elt table-row 2) operands operand-types)))) @@ -583,14 +583,14 @@ (defun ez-op-ret (operands &optional operand-types) (let ((retval (car operands))) - (message "\tReturning value %x" retval) + (ez-debug-message "\tReturning value %x" retval) (ez-pop-call-stack-frame) (ez-set-var (ez-read-pc-byte-and-inc) retval)) 'run) (defun ez-op-ret-pulled (operands operand-types) (let ((retval (ez-routine-stack-pop))) - (message "\tReturning value %x" retval) + (ez-debug-message "\tReturning value %x" retval) (ez-op-ret (list retval))) 'run) @@ -878,8 +878,9 @@ (defun ez-setup-buffer () (with-current-buffer (get-buffer-create "*ez*") + (ez-mode) (let ((inhibit-read-only t)) - (delete-region (point-min) (point-max))) + (erase-buffer)) (setq-local scroll-conservatively 1) (if (markerp ez-input-marker) (set-marker ez-input-marker (point-max)) @@ -899,9 +900,41 @@ (error "Z-machine not ready for input.")) (let ((input-string (with-current-buffer "*ez*" (buffer-substring ez-input-marker (point-max))))) + (delete-region ez-input-marker (point-max)) + (ez-print (concat input-string "\n")) + (ez-debug-message "\tReceived string \"%s\"" input-string) (ez-op-read2 input-string) (ez-run))) +;; Debugging info + +(defun ez-setup-debug-buffer () + (with-current-buffer (get-buffer-create "*ez-debug-trace*") + (setq-local buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "--- Trace Start ---\n\n")))) + +(defun ez-debug-message (&rest strings) + (with-current-buffer (get-buffer-create "*ez-debug-trace*") + (save-excursion + (goto-char (point-max)) + (let ((inhibit-read-only t)) + (insert (apply #'format-message strings) "\n"))))) + +(defun ez-debug-memory () + (interactive) + (with-current-buffer (get-buffer-create "*ez-debug-memory*") + (setq-local buffer-read-only t) + (let ((inhibit-read-only t) + (old-point (point))) + (hexl-mode-exit) + (erase-buffer) + (insert ez-memory) + (setq-local buffer-undo-list nil) + (hexl-mode) + (goto-char old-point)))) + ;; Mode (defvar ez-mode-map @@ -920,16 +953,14 @@ (if (get-buffer "*ez*") (switch-to-buffer "*ez*") (switch-to-buffer "*ez*") - (ez-mode) (ez-setup-buffer) (ez-load-and-run zfile)) "Started EZ.") (defun ez-debug () (interactive) - (switch-to-buffer "*ez*") - (ez-mode) (ez-setup-buffer) + (ez-setup-debug-buffer) (ez-load-and-run "zork1.z3")) ;;; ez.el ends here -- 2.20.1 From 4b61e7a8949dee61d40e59710fd1af733926c498 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 10 Apr 2023 10:17:50 +0200 Subject: [PATCH 05/10] Working on tokenizer. --- ez.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/ez.el b/ez.el index 65990b7..268becd 100644 --- a/ez.el +++ b/ez.el @@ -848,10 +848,14 @@ 'wait-for-input) (defun ez-op-read2 (input-string) - (ez-tokenize-string input-string - (car ez--next-read-args) - (cadr ez--next-read-args)) - 'run) + (let ((baddr1 (car ez--next-read-args)) + (baddr2 (cadr ez--next-read-args))) + + (dotimes (i (length input-string)) + (ez-mem-set-byte (+ baddr1 1 i) (downcase (elt input-string i)))) + (ez-mem-set-byte (+ baddr1 1 (length input-string)) 0) + + )) ;; Execution loop -- 2.20.1 From 923646120250ac9d0987e521e8d835809a64aa6c Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 10 Apr 2023 10:18:04 +0200 Subject: [PATCH 06/10] Dictionary parsing and Z-string decoding. --- ez.el | 57 ++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/ez.el b/ez.el index 268becd..a4cf5e7 100644 --- a/ez.el +++ b/ez.el @@ -294,31 +294,50 @@ (chars (cdr word-count-and-chars)) (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 (cdr (ez-get-zstring-and-length abbrev-addr))))) - (setq abbrev-char nil)) - ((memq char '(1 2 3)) ;Abbreviation - (setq abbrev-char char)) - ((= char 4) - (setq cur (mod (+ cur 1) 3))) - ((= char 5) - (setq cur (mod (+ 3 (- cur 1)) 3))) - (t - (setq s (concat s (substring (elt ez-zstring-alphabets cur) - char (+ char 1)))) - (setq cur lock)))) + (while (> (length chars) 0) + (let ((char (pop chars))) + (cond + ((memq char '(1 2 3)) ;Abbreviation + (let* ((abbrev-char char) + (abbrev-addr + (* 2 (ez-mem-ref-word (+ ez-abbrevtab-addr + (* 2 (+ (* (- abbrev-char 1) 32) (pop chars)))))))) + (setq s (concat s (cdr (ez-get-zstring-and-length abbrev-addr)))))) + ((= char 4) + (setq cur (mod (+ cur 1) 3))) + ((= char 5) + (setq cur (mod (+ 3 (- cur 1)) 3))) + ((and (= cur 2) (= char 6)) + (setq s (concat s (char-to-string (+ (lsh (pop chars) 5) (pop chars))))) + (setq cur lock)) + (t + (setq s (concat s (substring (elt ez-zstring-alphabets cur) + char (+ char 1)))) + (setq cur lock))))) (cons word-count s))) (defun ez-get-zstring (base-addr) (cdr (ez-get-zstring-and-length base-addr))) +;; Dictionary + +(defun ez-get-dictionary () + (let* ((nseps (ez-mem-ref-byte ez-dict-base)) + (separators + (mapcar (lambda (i) (ez-mem-ref-byte (+ ez-dict-base i))) + (number-sequence 1 nseps))) + (bytes-per-entry (ez-mem-ref-byte (+ ez-dict-base 1 nseps))) + (nentries (ez-mem-ref-word (+ ez-dict-base 1 nseps 1))) + (entries-base (+ ez-dict-base nseps 4)) + (entries nil)) + (dotimes (i nentries) + (let ((this-base (+ entries-base (* 7 i)))) + (setq entries (cons (cons this-base + (ez-get-zstring this-base)) + entries)))) + (list entries separators entries))) + ;; Call stack (defvar ez-call-stack nil) -- 2.20.1 From d37274a6c61c5b4c7638518bb2c76499758cb9d1 Mon Sep 17 00:00:00 2001 From: plugd Date: Tue, 11 Apr 2023 22:51:05 +0200 Subject: [PATCH 07/10] Z-string encoding. --- ez.el | 78 ++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 64 insertions(+), 14 deletions(-) diff --git a/ez.el b/ez.el index a4cf5e7..2dec2d7 100644 --- a/ez.el +++ b/ez.el @@ -1,6 +1,6 @@ ;;; ez.el --- Emacs Z-machine -;; Copyright (C) 2021 Tim Vaughan +;; Copyright (C) 2021,2022,2023 Tim Vaughan ;; Author: Tim Vaughan ;; Created: 13 Oct 2021 @@ -84,6 +84,12 @@ (defvar ez-abbrevtab-addr nil) (defvar ez-globalvartab-addr nil) +(defvar ez-dict-entries nil + "Parsed dictionary") + +(defvar ez-dict-separators nil + "Parsed dictionary") + (defun ez-mem-ref-byte (addr) (aref ez-memory addr)) @@ -320,23 +326,44 @@ (defun ez-get-zstring (base-addr) (cdr (ez-get-zstring-and-length base-addr))) +(defun ez-encode (string) + "Encodes a string as a 2-word 5-padded Z-string. +Used for matching input with dictionary entries when tokenizing." + (let ((chars + (mapcan + (lambda (c) + (cond + ((seq-contains-p (elt ez-zstring-alphabets 0) c) + (list (seq-position (elt ez-zstring-alphabets 0) c))) + ((seq-contains-p (elt ez-zstring-alphabets 1) c) + (list 4 (seq-position (elt ez-zstring-alphabets 1) c))) + ((seq-contains-p (elt ez-zstring-alphabets 2) c) + (list 5 (seq-position (elt ez-zstring-alphabets 2) c))) + (t + (list 5 6 (lsh c -5) (logand c #b11111))))) + string))) + (if (< (length chars) 6) + (append chars (make-list (- 6 (length chars)) 5)) + (take 6 chars)))) + ;; Dictionary -(defun ez-get-dictionary () +(defun ez-parse-dictionary () (let* ((nseps (ez-mem-ref-byte ez-dict-base)) (separators (mapcar (lambda (i) (ez-mem-ref-byte (+ ez-dict-base i))) (number-sequence 1 nseps))) (bytes-per-entry (ez-mem-ref-byte (+ ez-dict-base 1 nseps))) - (nentries (ez-mem-ref-word (+ ez-dict-base 1 nseps 1))) + (nentries (ez-mem-ref-word (+ ez-dict-base 2 nseps))) (entries-base (+ ez-dict-base nseps 4)) (entries nil)) (dotimes (i nentries) (let ((this-base (+ entries-base (* 7 i)))) - (setq entries (cons (cons this-base - (ez-get-zstring this-base)) + (setq entries (cons (cons (ez-get-zstring this-base) + this-base) entries)))) - (list entries separators entries))) + (setq ez-dict-entries (reverse entries)) + (setq ez-dict-separators separators))) ;; Call stack @@ -867,20 +894,40 @@ 'wait-for-input) (defun ez-op-read2 (input-string) - (let ((baddr1 (car ez--next-read-args)) - (baddr2 (cadr ez--next-read-args))) + (let* ((baddr1 (car ez--next-read-args)) + (baddr2 (cadr ez--next-read-args)) + (dict (ez-get-dictionary)) + (separators (car dict)) + (wordlist (cdr dict)) + (token-start 0)) (dotimes (i (length input-string)) - (ez-mem-set-byte (+ baddr1 1 i) (downcase (elt input-string i)))) + (let ((char (elt input-string i))) + (ez-mem-set-byte (+ baddr1 1 i) char) (ez-mem-set-byte (+ baddr1 1 (length input-string)) 0) - - )) + + (ez--tokenize baddr1 baddr2))))) + +(defun ez--tokenize (taddr baddr) + + (let ((unfinished t) + (token-start 0) + (token-end 0) + (token-string "")) + (while unfinished + (let ((char (ez-mem-ref-byte (+ taddr 1 token-end)))) + (cond + ((eq char ?\s)) + ((memq char ez-dict-separators)) + ) + )))) ;; Execution loop (defun ez-load-and-run (filename) (ez-load-file filename) (ez-parse-header) + (ez-parse-dictionary) (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc))) (ez-run)) @@ -921,8 +968,10 @@ (interactive) (if (not (eq ez-machine-state 'wait-for-input)) (error "Z-machine not ready for input.")) - (let ((input-string (with-current-buffer "*ez*" - (buffer-substring ez-input-marker (point-max))))) + (let ((input-string + (downcase + (with-current-buffer "*ez*" + (buffer-substring ez-input-marker (point-max)))))) (delete-region ez-input-marker (point-max)) (ez-print (concat input-string "\n")) (ez-debug-message "\tReceived string \"%s\"" input-string) @@ -951,7 +1000,8 @@ (setq-local buffer-read-only t) (let ((inhibit-read-only t) (old-point (point))) - (hexl-mode-exit) + (if (eq major-mode 'hexl-mode) + (hexl-mode-exit)) (erase-buffer) (insert ez-memory) (setq-local buffer-undo-list nil) -- 2.20.1 From 7f9ce877293321348e0ce0eaf20162199b39e2ad Mon Sep 17 00:00:00 2001 From: plugd Date: Thu, 1 Jun 2023 13:23:48 +0200 Subject: [PATCH 08/10] Updated contact details. --- ez.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ez.el b/ez.el index 2dec2d7..f4f698e 100644 --- a/ez.el +++ b/ez.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2021,2022,2023 Tim Vaughan -;; Author: Tim Vaughan +;; Author: Tim Vaughan ;; Created: 13 Oct 2021 ;; Version: 1.0 ;; Keywords: game -- 2.20.1 From 6e55cb573c7ac085cddca49a5834af4f71aea4a7 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 6 Nov 2023 00:09:41 +0100 Subject: [PATCH 09/10] Work on tokenizing, but outa energy. --- ez.el | 89 +++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 69 insertions(+), 20 deletions(-) diff --git a/ez.el b/ez.el index f4f698e..a9d63e3 100644 --- a/ez.el +++ b/ez.el @@ -96,6 +96,10 @@ (defun ez-mem-set-byte (addr val) (aset ez-memory addr val)) +(defun ez-mem-set-bytes (addr vals) + (dotimes (i (length vals)) + (ez-mem-set-byte (+ addr i) (elt vals i)))) + (defun ez-mem-ref-word (addr) (+ (* 256 (aref ez-memory addr)) (aref ez-memory (+ addr 1)))) @@ -106,6 +110,9 @@ (aset ez-memory addr byte-high) (aset ez-memory (+ addr 1) byte-low))) +(defun ez-mem-ref-string (addr1 addr2) + (substring ez-memory addr1 addr2)) + (defun ez-parse-header () (setq ez-version (ez-mem-ref-byte #x0)) (setq ez-himem-addr (ez-mem-ref-word #x4)) @@ -348,7 +355,7 @@ Used for matching input with dictionary entries when tokenizing." ;; Dictionary -(defun ez-parse-dictionary () +(defun ez-parse-dictionary-header () (let* ((nseps (ez-mem-ref-byte ez-dict-base)) (separators (mapcar (lambda (i) (ez-mem-ref-byte (+ ez-dict-base i))) @@ -357,14 +364,41 @@ Used for matching input with dictionary entries when tokenizing." (nentries (ez-mem-ref-word (+ ez-dict-base 2 nseps))) (entries-base (+ ez-dict-base nseps 4)) (entries nil)) - (dotimes (i nentries) - (let ((this-base (+ entries-base (* 7 i)))) - (setq entries (cons (cons (ez-get-zstring this-base) - this-base) - entries)))) - (setq ez-dict-entries (reverse entries)) + ;; (dotimes (i nentries) + ;; (let ((this-base (+ entries-base (* bytes-per-entry i)))) + ;; (setq entries (cons (cons (ez-get-zstring this-base) + ;; this-base) + ;; entries)))) + ;; (setq ez-dict-entries (reverse entries)) (setq ez-dict-separators separators))) +(defun ez-is-separator (char) + (let* ((nseps (ez-mem-ref-byte ez-dict-base))) + (while (and (> nseps 0) + (not (= (ez-mem-ref-byte (+ ez-dict-base nseps)) + char))) + (setq nseps (- nseps 1))) + (> nseps 0))) + +(defun ez-lookup-dictionary (text) + (let ((encoded-text (ez-encode text)) + (nseps (ez-mem-ref-byte ez-dict-base)) + (bytes-per-entry (ez-mem-ref-byte (+ ez-dict-base 1 nseps))) + (nentries (ez-mem-ref-word (+ ez-dict-base 2 nseps))) + (entries-seen 0) + (this-entry (+ ez-dict-base nseps 4))) + + (while (and (< entries-seen nentries) + (not (equal + (ez-mem-ref-bytes this-entry 4) + encoded-text))) + (setq entries-seen (+ entries-seen 1)) + (setq this-entry (+ this-entry bytes-per-entry))) + + (if (< entries-seen nentries) + this-entry + 0))) + ;; Call stack (defvar ez-call-stack nil) @@ -895,31 +929,46 @@ Used for matching input with dictionary entries when tokenizing." (defun ez-op-read2 (input-string) (let* ((baddr1 (car ez--next-read-args)) - (baddr2 (cadr ez--next-read-args)) - (dict (ez-get-dictionary)) - (separators (car dict)) - (wordlist (cdr dict)) - (token-start 0)) + (baddr2 (cadr ez--next-read-args))) (dotimes (i (length input-string)) (let ((char (elt input-string i))) - (ez-mem-set-byte (+ baddr1 1 i) char) + (ez-mem-set-byte (+ baddr1 1 i) char))) (ez-mem-set-byte (+ baddr1 1 (length input-string)) 0) - (ez--tokenize baddr1 baddr2))))) + (ez--tokenize baddr1 baddr2))) -(defun ez--tokenize (taddr baddr) +(defun ez--tokenize (tb-baddr pb-baddr) (let ((unfinished t) (token-start 0) (token-end 0) - (token-string "")) + (token-count 0)) + (while unfinished - (let ((char (ez-mem-ref-byte (+ taddr 1 token-end)))) + (let ((next-char (ez-mem-ref-byte (+ tb-baddr 1 token-end)))) (cond - ((eq char ?\s)) - ((memq char ez-dict-separators)) - ) + ((eq char ?\s) + ;; Add token + (setq token-end (- token-end 1)) + (let* ((text (ez-mem-ref-string (+ tb-baddr 1 token-start) + (+ tb-baddr 1 token-end))) + (dict-entry (ez-lookup-dictionary text))) + (setq token-count (+ token-count 1)) + (ez-mem-set-word (+ pb-baddr 2 (* token-count 4)) + dict-entry) + (ez-mem-set-bytes (+ pb-baddr 2 (* token-count 4) 2) + (length text) + token-start)) + (setq token-start (+ token-end 1)) + (setq token-end token-start)) + + ((ez-is-separator char) + ;; Add token and separator token + ) + ((eq char 0) + (setq unfinished nil)) + (setq token-end (+ token-end 1))) )))) ;; Execution loop -- 2.20.1 From 0d998277127b2133d8c36c8d604956020b2622a5 Mon Sep 17 00:00:00 2001 From: plugd Date: Sat, 11 Nov 2023 14:15:57 +0100 Subject: [PATCH 10/10] Dictionary lookup working. --- ez.el | 62 ++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 46 insertions(+), 16 deletions(-) diff --git a/ez.el b/ez.el index a9d63e3..a6f1f9c 100644 --- a/ez.el +++ b/ez.el @@ -93,6 +93,10 @@ (defun ez-mem-ref-byte (addr) (aref ez-memory addr)) +(defun ez-mem-ref-bytes (addr count) + (mapcar (lambda (offset) (ez-mem-ref-byte (+ addr offset))) + (number-sequence 0 (- count 1)))) + (defun ez-mem-set-byte (addr val) (aset ez-memory addr val)) @@ -101,8 +105,12 @@ (ez-mem-set-byte (+ addr i) (elt vals i)))) (defun ez-mem-ref-word (addr) - (+ (* 256 (aref ez-memory addr)) - (aref ez-memory (+ addr 1)))) + (logior (lsh (aref ez-memory addr) 8) + (aref ez-memory (+ addr 1)))) + +(defun ez-mem-ref-words (addr count) + (mapcar (lambda (offset) (ez-mem-ref-word (+ addr offset))) + (number-sequence 0 (- (* 2 count) 1) 2))) (defun ez-mem-set-word (addr val) (let ((byte-high (/ val 256)) @@ -287,6 +295,12 @@ (logand (lsh word -5) #b11111) (logand word #b11111))) +(defun ez-make-zstring-word (zchar-triple) + (let ((c1 (elt zchar-triple 0)) + (c2 (elt zchar-triple 1)) + (c3 (elz zchar-triple 2))) + (logand ))) + (defun ez-get-zstring-chars-and-length (base-addr) (let ((addr base-addr) (chars nil) @@ -335,7 +349,8 @@ (defun ez-encode (string) "Encodes a string as a 2-word 5-padded Z-string. -Used for matching input with dictionary entries when tokenizing." +Used for matching input with dictionary entries when tokenizing. +Returns a length-2 list of words for comparison with a dictionary entry." (let ((chars (mapcan (lambda (c) @@ -349,9 +364,24 @@ Used for matching input with dictionary entries when tokenizing." (t (list 5 6 (lsh c -5) (logand c #b11111))))) string))) - (if (< (length chars) 6) - (append chars (make-list (- 6 (length chars)) 5)) - (take 6 chars)))) + (let* ((zstring-chars + (if (< (length chars) 6) + (append chars (make-list (- 6 (length chars)) 5)) + (take 6 chars))) + (c1 (elt zstring-chars 0)) + (c2 (elt zstring-chars 1)) + (c3 (elt zstring-chars 2)) + (c4 (elt zstring-chars 3)) + (c5 (elt zstring-chars 4)) + (c6 (elt zstring-chars 5))) + (list + (logior (lsh c1 10) + (lsh c2 5) + c3) + (logior (lsh 1 15) + (lsh c4 10) + (lsh c5 5) + c6))))) ;; Dictionary @@ -381,16 +411,16 @@ Used for matching input with dictionary entries when tokenizing." (> nseps 0))) (defun ez-lookup-dictionary (text) - (let ((encoded-text (ez-encode text)) - (nseps (ez-mem-ref-byte ez-dict-base)) - (bytes-per-entry (ez-mem-ref-byte (+ ez-dict-base 1 nseps))) - (nentries (ez-mem-ref-word (+ ez-dict-base 2 nseps))) - (entries-seen 0) - (this-entry (+ ez-dict-base nseps 4))) + (let* ((encoded-text (ez-encode text)) + (nseps (ez-mem-ref-byte ez-dict-base)) + (bytes-per-entry (ez-mem-ref-byte (+ ez-dict-base 1 nseps))) + (nentries (ez-mem-ref-word (+ ez-dict-base 2 nseps))) + (entries-seen 0) + (this-entry (+ ez-dict-base nseps 4))) (while (and (< entries-seen nentries) (not (equal - (ez-mem-ref-bytes this-entry 4) + (ez-mem-ref-words this-entry 2) encoded-text))) (setq entries-seen (+ entries-seen 1)) (setq this-entry (+ this-entry bytes-per-entry))) @@ -936,7 +966,8 @@ Used for matching input with dictionary entries when tokenizing." (ez-mem-set-byte (+ baddr1 1 i) char))) (ez-mem-set-byte (+ baddr1 1 (length input-string)) 0) - (ez--tokenize baddr1 baddr2))) + (ez--tokenize baddr1 baddr2)) + 'run) (defun ez--tokenize (tb-baddr pb-baddr) @@ -948,7 +979,7 @@ Used for matching input with dictionary entries when tokenizing." (while unfinished (let ((next-char (ez-mem-ref-byte (+ tb-baddr 1 token-end)))) (cond - ((eq char ?\s) + ((eq next-char ?\s) ;; Add token (setq token-end (- token-end 1)) (let* ((text (ez-mem-ref-string (+ tb-baddr 1 token-start) @@ -976,7 +1007,6 @@ Used for matching input with dictionary entries when tokenizing." (defun ez-load-and-run (filename) (ez-load-file filename) (ez-parse-header) - (ez-parse-dictionary) (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc))) (ez-run)) -- 2.20.1