From d37274a6c61c5b4c7638518bb2c76499758cb9d1 Mon Sep 17 00:00:00 2001 From: plugd Date: Tue, 11 Apr 2023 22:51:05 +0200 Subject: [PATCH] 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