malyon.el

;;; malyon.el --- mode to execute Z-code files version 3, 5, 8

;; Author: Peter Ilberg <peter.ilberg@gmail.com>, Christopher Madsen <cjm@cjmweb.net>, Erik Selberg <erik@selberg.org>
;; Maintainer: Christopher Madsen <cjm@cjmweb.net>, Erik Selberg <erik@selberg.org>
;; Version: 20161204
;; Package-Requires: ((cl-lib "0.5"))
;; Keywords: games, emulations
;; URL: https://github.com/speedenator/malyon

;; Old-Maintainer: Peter Ilberg <peter.ilberg@gmail.com>
;; (I am unable to continue supporting malyon.el. Please send me an
;;  email if you are interested in taking over the project. Thanks.)

;; Copyright (C) 1999-2016 Peter Ilberg, Christopher Madsen, Erik Selberg

;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.

;;; Credits:

;;   The author would like to thank the following people for reporting
;;   bugs, testing, suggesting and/or contributing improvements:
;;     Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko

;;; Commentary:

;; This package provides a basic interpreter for version 3, 5, 8 Z-code
;; story files as generated by Inform (C) Graham Nelson and Infocom.

;; If you encounter a bug please send a report to Peter Ilberg at
;; peter.ilberg@gmail.com. Thank you!

;; To play a story file simply type M-x malyon and enter the path to the
;; story file. If anything goes wrong and you want to manually clean
;; up type M-x malyon-quit. In addition, you can switch back to a game in
;; progress by typing M-x malyon-restore.

;; A note on the format of saved game states:

;; As of version 1.0, Malyon supports the quetzal file format for saved
;; games. Support for this format required changes to several internal
;; data structures (stack frames and catch-throw) that are incompatible
;; with the old implementation. Unfortunately, the old file format for
;; saved games cannot be converted into quetzal.

;; For backwards compatibility, however, Malyon still supports the old
;; file format. And you can continue to play your old game states.

;; Because of the incompatibility of the two file formats, Malyon now
;; runs, as follows, in either of two modes: quetzal and compatibility.

;; - in quetzal mode, game states are saved in quetzal format
;; - in compatibility mode, games states are saved in the old format
;; - loading a game state in quetzal format switches to quetzal mode
;; - loading an old game state switches to compatibility mode
;; - quetzal mode is the default setting

;; In other words, Malyon will only use the old file format if you've
;; restored a game state saved in the old file format.

;; Enjoy!

;;; Code:

;; global variables - moved here to appease the byte-code compiler

;; requirements

(require 'cl-lib)
(require 'bindat)

(defconst malyon-version "1.2" "Malyon version number")

(defgroup malyon nil
  "Play Z-machine interactive fiction games."
  :prefix "malyon-"
  :group 'games)

;; customizable variables

(defcustom malyon-stories-directory nil
  "The default directory to look for story files.
Nil means use the buffer's default directory."
  :type '(choice (const nil) directory)
  :group 'malyon)


;; story file information

(defvar malyon-story-file-name nil
  "The name of the story file being executed.")

(defvar malyon-story-file nil
  "The story file which is currently being run.")

(defvar malyon-story-version nil
  "The story file version.")

(defvar malyon-supported-versions '(3 5 8)
  "A list of supported story file versions.")

;; status and transcript buffers

(defvar malyon-transcript-buffer nil
  "The main transcript buffer of the story file execution.")

(defvar malyon-transcript-buffer-buffered nil
  "Is output in the transcript buffer buffered?")

(defvar malyon-status-buffer nil
  "The status bar buffer of the story file execution.")

(defvar malyon-status-buffer-lines nil
  "The number of lines in the status bar buffer.")

(defvar malyon-status-buffer-delayed-split nil
  "If the number of lines in the status buffer is reduced,
the window configuration is not changed immediately. It
is changed after the next turn (read or read_char).")

(defvar malyon-status-buffer-point nil
  "The point location in the status bar buffer.")

(defvar malyon-max-column 72
  "Maximum column for text display.")

;; window management

(defvar malyon-window-configuration nil
  "The current window configuration of the malyon interpreter.")

(defvar malyon-current-window nil
  "The currently active window for text output.")

;; z machine registers

(defvar malyon-stack nil
  "The stack of the z machine.")

(defvar malyon-stack-pointer nil
  "The stack pointer of the z machine.")

(defvar malyon-frame-pointer nil
  "The frame pointer of the z machine.")

(defvar malyon-instruction-pointer nil
  "The instruction pointer of the z machine.")

;; game file related global variables

(defvar malyon-score-game nil
  "A flag indicating whether this story uses score or time.")

(defvar malyon-packed-multiplier nil
  "The amount by which packed addresses are multiplied to get byte
addresses.")

(defvar malyon-global-variables nil
  "A pointer to the global variable section in the story file.")

(defvar malyon-abbreviations nil
  "A pointer to the abbreviations in the story file.")

(defvar malyon-alphabet nil
  "The z machine's text alphabet.")

(defvar malyon-whitespace nil
  "A string of whitespace characters recognized by the interpreter.")

;; object tables

(defvar malyon-object-table nil
  "A pointer to the object table in the story file.")

(defvar malyon-object-table-entry-size nil
  "The size of one entry in the object table.")

(defvar malyon-object-properties nil
  "The number of properties per object minus one.")

(defvar malyon-object-property-offset nil
  "The byte offset of the properties table in the object.")

;; dictionaries

(defvar malyon-dictionary nil
  "A pointer to the dictionary of the story file.")

(defvar malyon-dictionary-entry-length nil
  "The length of a dictionary entry.")

(defvar malyon-dictionary-num-entries nil
  "The number of dictionary entries.")

(defvar malyon-dictionary-entries nil
  "A pointer to the first dictionary entry.")

(defvar malyon-dictionary-word-length nil
  "The length of a dictionary word.")

;; game state information

(defvar malyon-game-state-restart nil
  "The machine state for implementing restart.")

(defvar malyon-game-state-undo nil
  "The machine state for implementing undo.")

(defvar malyon-game-state-quetzal t
  "Store game state information for quetzal.")

;; various

(defvar malyon-current-face nil
  "The current face in which to display text.")

(defvar malyon-last-cursor-position-after-input nil
  "The last cursor position after reading input from the keyboard.")

;; error trapping

(defmacro malyon-hide-internal-errors (message bodyform)
  "Evaluate BODYFORM, substituting MESSAGE for any error."
  (declare (indent 1))
  `(condition-case nil
      ,bodyform
    (error
     (malyon-fatal-error ,message))))

;; when debugging, uncomment this NOP version of malyon-hide-internal-errors
;(defmacro malyon-hide-internal-errors (msg body) (declare (indent 1)) body)

;; interactive functions
;;;###autoload
(defun malyon (file-name)
  "Play a Z-machine interactive fiction game.
If a game is in progress, restores the game's window configuration.
Otherwise, you are prompted for a story file to load, which may be
either a raw Z-code file or one packaged in a Blorb file.
Z-code versions 3, 5, and 8 are supported."
  (interactive
   (list
    (if malyon-story-file nil
      (read-file-name "Story file name: " malyon-stories-directory nil t))))
  (if malyon-story-file
      (if file-name
          (error "You are already playing a game.")
        (malyon-restore))
    ;; Otherwise, we're starting a new game:
    (cond
     ((string-match "\\.\\(?:z?blorb\\|blb\\|zlb\\)$" file-name)
      (malyon-load-blorb-file file-name))
     ((string-match "\\.z[358]$" file-name)
      (malyon-hide-internal-errors "loading of story file failed."
        (malyon-load-story-file file-name)))
     (t
      (error "%s is not a version 3, 5, or 8 story file." file-name)))
    (setq malyon-story-version (aref malyon-story-file 0))
    (cond ((memq malyon-story-version malyon-supported-versions)
           (malyon-hide-internal-errors "initialization of interpreter failed."
             (malyon-initialize))
           (malyon-interpreter))
          (t
           (message "%s is not a version 3, 5, or 8 story file." file-name)
           (malyon-cleanup)))))

(defun malyon-restore ()
  "Restore the save window configuration for the interpreter."
  (interactive)
  (malyon-hide-internal-errors "restoring window configuration failed."
    (progn
      (malyon-restore-window-configuration)
      (malyon-adjust-transcript))))

(defun malyon-quit ()
  "Exit the malyon interpreter."
  (interactive)
  (if malyon-story-file
      (progn
        (malyon-restore)
        (if (malyon-yes-or-no-p-minibuf "Do you really want to quit? ")
            (malyon-cleanup)))))

;;;###autoload
(defun malyon-mode ()
  "This mode provides a basic interpreter for version 3, 5, 8 Z-code
story files as generated by Inform (C) Graham Nelson and Infocom.

Note that this package is by no means complete and bug free.
If you encounter a bug please send a report to Peter Ilberg at
peter.ilberg@natinst.com. Thank you!

To play a story file simple type M-x malyon and enter the path to the
story file. If anything goes wrong and you want to manually clean
up type M-x malyon-quit. In addition, you can switch back to a game in
progress by typing M-x malyon-restore.

The author would like to thank the following people for reporting
bugs, testing, suggesting and/or contributing improvements:
    Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko"
  (message "Use M-x malyon if you want to play a zcode game."))

;; compatibility functions for GNU emacs
;; nuked 12/4/16 by erik@selberg.org --- these aren't needed

;; (if (fboundp 'cadr)
;;     (defalias 'malyon-cadr 'cadr)
;;   (defun malyon-cadr (list)
;;     "Take the cadr of the list."
;;     (car (cdr list))))

;; (if (fboundp 'caddr)
;;     (defalias 'malyon-caddr 'caddr)
;;   (defun malyon-caddr (list)
;;     "Take the caddr of the list."
;;     (car (cdr (cdr list)))))

;; (if (fboundp 'cdddr)
;;     (defalias 'malyon-cdddr 'cdddr)
;;   (defun malyon-cdddr (list)
;;     "Take the cdddr of the list."
;;     (cdr (cdr (cdr list)))))

;; (if (fboundp 'char-before)
;;     (defalias 'malyon-char-before 'char-before)
;;   (defun malyon-char-before ()
;;     "Return the character before the point."
;;     (char-after (- (point) 1))))

(defun malyon-char-to-int (c)
  "Convert a character into an integer."
  (if (fboundp 'char-to-int)
      (char-to-int c)
    c))

;; (if (fboundp 'characterp)
;;     (defalias 'malyon-characterp 'characterp)
;;   (defun malyon-characterp (x)
;;     "Test for a character."
;;     (and (numberp x) (<= 0 x) (< x 256))))

(defun malyon-disable-multibyte ()
  "Disable multibyte support in the current buffer."
  (condition-case nil (set-buffer-multibyte nil) (error)))

(defun malyon-erase-buffer (&optional buffer)
  "Erase the given buffer."
  (save-excursion
    (if buffer (set-buffer buffer))
    (if (and buffer (eq buffer malyon-transcript-buffer))
        (malyon-begin-section)
      (erase-buffer))))

(defun malyon-int-to-char (i)
  "Convert an integer into a character."
  (if (fboundp 'int-to-char)
    (int-to-char i)
    i))

;; (if (fboundp 'mapc)
;;     (defalias 'malyon-mapc 'mapc)
;;   (defun malyon-mapc (function list)
;;     "Apply fun to every element of args ignoring the results."
;;     (if (null list)
;; 	'()
;;       (funcall function (car list))
;;       (malyon-mapc function (cdr list)))))

;; (if (fboundp 'mapcan)
;;     (defalias 'malyon-mapcan 'mapcan)
;;   (defun malyon-mapcan (function list)
;;     "Apply fun to every element of args nconc'ing the result."
;;     (if (null list)
;; 	'()
;;       (nconc (funcall function (car list))
;; 	     (malyon-mapcan function (cdr list))))))


; Do not use the built-in conversion via 'multibyte-char-to-unibyte.
(defun malyon-multibyte-char-to-unibyte (char)
  "Convert a multibyte character to unibyte."
  char)

(defun malyon-point-max (&optional buffer)
  "Get the point-max of the given buffer."
  (save-excursion
    (if buffer (set-buffer buffer))
    (point-max)))

(defun malyon-redisplay-frame (frame &rest ignore)
  "Redisplay the given frame."
  (if (fboundp 'redisplay-frame)
      (redisplay-frame frame ignore)))


;; (if (fboundp 'remove)
;;     (defalias 'malyon-remove 'remove)
;;   (defun malyon-remove (element list)
;;     "Remove the element from the list."
;;     (cond ((null list)
;; 	   '())
;; 	  ((eq element (car list))
;; 	   (malyon-remove element (cdr list)))
;; 	  ((equal element (car list))
;; 	   (malyon-remove element (cdr list)))
;; 	  (t
;; 	   (cons (car list)
;; 		 (malyon-remove element (cdr list)))))))

;; legacy thing... normally this is a noop for FSF Emacs
(defun malyon-set-keymap-name (keymap name)
  "Set the name of the keymap."
  (if (fboundp 'set-keymap-name)
      (set-keymap-name keymap name)))

;; (if (fboundp 'string-to-list)
;;     (defalias 'malyon-string-to-list 'string-to-list)
;;   (defun malyon-string-to-list (s)
;;     "Convert a string into a list of characters."
;;     (let ((i (- (length s) 1)) (l '()))
;;       (while (<= 0 i)
;; 	(setq l (cons (aref s i) l)
;; 	      i (- i 1)))
;;       l)))

;; (if (fboundp 'string-to-vector)
;;     (defalias 'malyon-string-to-vector 'string-to-vector)
;;   (defun malyon-string-to-vector (s)
;;     "Convert a string into a vector of characters."
;;     (let* ((i 0) (l (length s)) (v (make-vector l 0)))
;;       (while (< i l)
;; 	(aset v i (aref s i))
;; 	(setq i (+ 1 i)))
;;       v)))

; Do not use the built-in conversion via 'unibyte-char-to-multibyte.
(defun malyon-unibyte-char-to-multibyte (char)
  "Convert a unibyte character to multibyte."
  char)

(defun malyon-vector-to-list (v begin end)
  "Return a list of elements in v in the range [begin, end)."
  (let ((result '()))
    (while (< begin end)
      (setq result (cons (aref v begin) result))
      (setq begin (+ 1 begin)))
    (reverse result)))


(defun malyon-window-displayed-height (&optional window)
  "Get the height of the window's displayed region."
  (if (fboundp 'window-displayed-height)
      (window-displayed-height window)
    (- (window-height) 1)))

(defun malyon-yes-or-no-p-minibuf (prompt)
  "Ask a yes or no question."
  (if (fboundp 'yes-or-no-p-minibuf)
      (yes-or-no-p-minibuf prompt)
    (yes-or-no-p prompt)))

;; global variables for the malyon mode

(defvar malyon-syntax-table nil
  "Syntax table used while in malyon mode (same as in text-mode).")

(if malyon-syntax-table
    '()
  (setq malyon-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\" ".   " malyon-syntax-table)
  (modify-syntax-entry ?\\ ".   " malyon-syntax-table)
  (modify-syntax-entry ?'  "w   " malyon-syntax-table))

(defvar malyon-keymap-read nil
  "Keymap for malyon mode for reading input into a buffer.")

(defvar malyon-history-saved-up nil
  "The saved binding for the up arrow key.")

(defvar malyon-history-saved-down nil
  "The saved binding for the down arrow key.")

(if malyon-keymap-read
    '()
  (setq malyon-keymap-read (make-sparse-keymap))
  (malyon-set-keymap-name malyon-keymap-read 'malyon-keymap-read)
  (setq malyon-history-saved-up   (global-key-binding [up]))
  (setq malyon-history-saved-down (global-key-binding [down]))
  (define-key malyon-keymap-read "\r"        'malyon-end-input)
  (define-key malyon-keymap-read [up]        'malyon-history-previous-char)
  (define-key malyon-keymap-read [down]      'malyon-history-next-char)
  (define-key malyon-keymap-read "\M-p"      'malyon-history-previous-char)
  (define-key malyon-keymap-read "\M-n"      'malyon-history-next-char)
  (define-key malyon-keymap-read "\C-a"      'malyon-beginning-of-line)
  (define-key malyon-keymap-read "\C-w"      'malyon-kill-region)
  (define-key malyon-keymap-read "\C-k"      'malyon-kill-line)
  (define-key malyon-keymap-read "\M-d"      'malyon-kill-word)
  (define-key malyon-keymap-read "\C-y"      'malyon-yank)
  (define-key malyon-keymap-read "\M-y"      'malyon-yank-pop)
  (define-key malyon-keymap-read "\C-d"      'malyon-delete-char)
  (define-key malyon-keymap-read "\d"        'malyon-backward-delete-char)
  (define-key malyon-keymap-read [del]       'malyon-delete-char)
  (define-key malyon-keymap-read [backspace] 'malyon-backward-delete-char)
  (substitute-key-definition (lookup-key (current-global-map) "a")
                             'malyon-self-insert-command
                             malyon-keymap-read (current-global-map)))

(defvar malyon-keymap-readchar nil
  "Keymap for malyon mode for waiting for input.")

(if malyon-keymap-readchar
    '()
  (setq malyon-keymap-readchar (make-sparse-keymap))
  (malyon-set-keymap-name malyon-keymap-readchar 'malyon-keymap-readchar)
  (define-key malyon-keymap-readchar "\r" 'malyon-wait-char)
  (substitute-key-definition (lookup-key (current-global-map) "a")
                             'malyon-wait-char
                             malyon-keymap-readchar (current-global-map)))

(defvar malyon-keymap-more nil
  "Keymap for malyon mode for browsing through text.")

(if malyon-keymap-more
    '()
  (setq malyon-keymap-more (make-sparse-keymap))
  (malyon-set-keymap-name malyon-keymap-more 'malyon-keymap-more)
  (define-key malyon-keymap-more "\r" 'malyon-more-char)
  (substitute-key-definition (lookup-key (current-global-map) "a")
                             'malyon-more-char
                             malyon-keymap-more (current-global-map)))

(defvar malyon-keymap-more-status nil
  "Keymap for malyon mode for browsing through the status buffer.")

(if malyon-keymap-more-status
    '()
  (setq malyon-keymap-more-status (make-sparse-keymap))
  (malyon-set-keymap-name malyon-keymap-more-status 'malyon-keymap-more-status)
  (define-key malyon-keymap-more-status "\r" 'malyon-more-char-status)
  (substitute-key-definition (lookup-key (current-global-map) "a")
                             'malyon-more-char-status
                             malyon-keymap-more-status (current-global-map)))

(defface malyon-face-plain
  '((t :inherit default))
  "Basic face for game text."
  :group 'malyon)

(defface malyon-face-bold
  '((t :inherit bold))
  "Bold face for game text."
  :group 'malyon)

(defface malyon-face-error
  '((t :inherit error))
  "Face for game errors."
  :group 'malyon)

(defface malyon-face-italic
  '((t :inherit italic))
  "Italic face for game text."
  :group 'malyon)

(defface malyon-face-reverse
  '((t :inherit default :inverse-video t))
  "Face for reverse-video text."
  :group 'malyon)

(defvar malyon-faces
  '((0 . malyon-face-plain)
    (1 . malyon-face-reverse)
    (2 . malyon-face-bold)
    (4 . malyon-face-italic)
    (8 . malyon-face-plain))
  "An association list of text faces used by the malyon mode.")

(defvar malyon-print-separator nil
  "A flag indicating whether to print the * * * separator.")

(defun malyon-begin-section ()
  "Print a section divider and begin a new section."
  (if malyon-print-separator
      (progn
        (mapc 'malyon-putchar-transcript '(?\n ?\n ?* ?  ?* ?  ?*))
        (center-line)
        (mapc 'malyon-putchar-transcript '(?\n ?\n))
        (setq malyon-print-separator nil)))
  (narrow-to-region (point-max) (point-max)))

(if malyon-whitespace
    '()
  (setq malyon-whitespace (list (malyon-char-to-int ? )
                                (malyon-char-to-int ?\t)
                                (malyon-char-to-int ?\n)
                                (malyon-char-to-int ?\r))))

;; memory utilities

(defsubst malyon-read-byte (address)
  "Read a byte at address in the story file."
  (if (<= 0 address)
      (aref malyon-story-file address)
    (aref malyon-story-file (+ 65536 address))))

(defsubst malyon-store-byte (address value)
  "Store a byte at address in the story file."
  (if (<= 0 address)
      (aset malyon-story-file address (logand 255 value))
    (aset malyon-story-file (+ 65536 address) (logand 255 value))))

(defsubst malyon-read-word (address)
  "Read a word at address in the story file."
  (if (<= 0 address)
      (logior (lsh (aref malyon-story-file address) 8)
              (aref malyon-story-file (+ 1 address)))
    (logior (lsh (aref malyon-story-file (+ 65536 address)) 8)
            (aref malyon-story-file (+ 65537 address)))))

(defsubst malyon-store-word (address value)
  "Store a word at address in the story file."
  (if (<= 0 address)
      (progn
        (aset malyon-story-file address (logand 255 (lsh value -8)))
        (aset malyon-story-file (+ 1 address) (logand 255 value)))
    (aset malyon-story-file (+ 65536 address) (logand 255 (lsh value -8)))
    (aset malyon-story-file (+ 65537 address) (logand 255 value))))

(defsubst malyon-read-code-byte ()
  "Read the next byte at the program counter location."
  (setq malyon-instruction-pointer (+ malyon-instruction-pointer 1))
  (malyon-read-byte (- malyon-instruction-pointer 1)))

(defsubst malyon-read-code-word ()
  "Read the next word at the program counter location."
  (setq malyon-instruction-pointer (+ malyon-instruction-pointer 2))
  (malyon-read-word (- malyon-instruction-pointer 2)))

(defsubst malyon-pop-stack ()
  "Pop a value off the stack."
  (if (> 0 malyon-stack-pointer)
      (malyon-fatal-error "stack underflow."))
  (setq malyon-stack-pointer (- malyon-stack-pointer 1))
  (aref malyon-stack (+ malyon-stack-pointer 1)))

(defsubst malyon-read-local-variable (variable)
  "Read a local variable."
  (aref malyon-stack (+ variable malyon-frame-pointer)))

(defsubst malyon-read-global-variable (variable)
  "Read a global variable."
  (malyon-read-word (+ malyon-global-variables (* 2 variable))))

(defsubst malyon-read-variable (variable)
  "Read a variable."
  (cond ((= variable 0)  (malyon-pop-stack))
        ((< variable 16) (malyon-read-local-variable variable))
        (t               (malyon-read-global-variable (- variable 16)))))

(defsubst malyon-push-stack (value)
  "Push a value onto the stack."
  (setq malyon-stack-pointer (+ malyon-stack-pointer 1))
  (aset malyon-stack malyon-stack-pointer value))

(defsubst malyon-store-local-variable (variable value)
  "Store a value in a local variable."
  (aset malyon-stack (+ variable malyon-frame-pointer) value))

(defsubst malyon-store-global-variable (variable value)
  "Store a value in a global variable."
  (malyon-store-word (+ malyon-global-variables (* 2 variable)) value))

(defsubst malyon-store-variable (var value)
  "Store the value in a variable."
  (setq value (logand 65535 value))
  (cond ((= var 0)  (malyon-push-stack value))
        ((< var 16) (malyon-store-local-variable var value))
        (t          (malyon-store-global-variable (- var 16) value))))

;; list of opcodes

(defvar malyon-opcodes
  [malyon-opcode-nop
   malyon-opcode-je              malyon-opcode-jl
   malyon-opcode-jg              malyon-opcode-dec-chk
   malyon-opcode-inc-chk         malyon-opcode-jin
   malyon-opcode-test            malyon-opcode-or
   malyon-opcode-and             malyon-opcode-test-attr
   malyon-opcode-set-attr        malyon-opcode-clear-attr
   malyon-opcode-store           malyon-opcode-insert-obj
   malyon-opcode-loadw           malyon-opcode-loadb
   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
   malyon-opcode-get-next-prop   malyon-opcode-add
   malyon-opcode-sub             malyon-opcode-mul
   malyon-opcode-div             malyon-opcode-mod
   malyon-opcode-calls           malyon-opcode-calln
   malyon-opcode-set-color       malyon-opcode-throw
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-je              malyon-opcode-jl
   malyon-opcode-jg              malyon-opcode-dec-chk
   malyon-opcode-inc-chk         malyon-opcode-jin
   malyon-opcode-test            malyon-opcode-or
   malyon-opcode-and             malyon-opcode-test-attr
   malyon-opcode-set-attr        malyon-opcode-clear-attr
   malyon-opcode-store           malyon-opcode-insert-obj
   malyon-opcode-loadw           malyon-opcode-loadb
   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
   malyon-opcode-get-next-prop   malyon-opcode-add
   malyon-opcode-sub             malyon-opcode-mul
   malyon-opcode-div             malyon-opcode-mod
   malyon-opcode-calls           malyon-opcode-calln
   malyon-opcode-set-color       malyon-opcode-throw
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-je              malyon-opcode-jl
   malyon-opcode-jg              malyon-opcode-dec-chk
   malyon-opcode-inc-chk         malyon-opcode-jin
   malyon-opcode-test            malyon-opcode-or
   malyon-opcode-and             malyon-opcode-test-attr
   malyon-opcode-set-attr        malyon-opcode-clear-attr
   malyon-opcode-store           malyon-opcode-insert-obj
   malyon-opcode-loadw           malyon-opcode-loadb
   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
   malyon-opcode-get-next-prop   malyon-opcode-add
   malyon-opcode-sub             malyon-opcode-mul
   malyon-opcode-div             malyon-opcode-mod
   malyon-opcode-calls           malyon-opcode-calln
   malyon-opcode-set-color       malyon-opcode-throw
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-je              malyon-opcode-jl
   malyon-opcode-jg              malyon-opcode-dec-chk
   malyon-opcode-inc-chk         malyon-opcode-jin
   malyon-opcode-test            malyon-opcode-or
   malyon-opcode-and             malyon-opcode-test-attr
   malyon-opcode-set-attr        malyon-opcode-clear-attr
   malyon-opcode-store           malyon-opcode-insert-obj
   malyon-opcode-loadw           malyon-opcode-loadb
   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
   malyon-opcode-get-next-prop   malyon-opcode-add
   malyon-opcode-sub             malyon-opcode-mul
   malyon-opcode-div             malyon-opcode-mod
   malyon-opcode-calls           malyon-opcode-calln
   malyon-opcode-set-color       malyon-opcode-throw
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-nop             malyon-opcode-jz
   malyon-opcode-get-sibling     malyon-opcode-get-child
   malyon-opcode-get-parent      malyon-opcode-get-prop-len
   malyon-opcode-inc             malyon-opcode-dec
   malyon-opcode-print-addr      malyon-opcode-calls
   malyon-opcode-remove-obj      malyon-opcode-print-obj
   malyon-opcode-ret             malyon-opcode-jump
   malyon-opcode-print-paddr     malyon-opcode-load
   malyon-opcode-calln           malyon-opcode-jz
   malyon-opcode-get-sibling     malyon-opcode-get-child
   malyon-opcode-get-parent      malyon-opcode-get-prop-len
   malyon-opcode-inc             malyon-opcode-dec
   malyon-opcode-print-addr      malyon-opcode-calls
   malyon-opcode-remove-obj      malyon-opcode-print-obj
   malyon-opcode-ret             malyon-opcode-jump
   malyon-opcode-print-paddr     malyon-opcode-load
   malyon-opcode-calln           malyon-opcode-jz
   malyon-opcode-get-sibling     malyon-opcode-get-child
   malyon-opcode-get-parent      malyon-opcode-get-prop-len
   malyon-opcode-inc             malyon-opcode-dec
   malyon-opcode-print-addr      malyon-opcode-calls
   malyon-opcode-remove-obj      malyon-opcode-print-obj
   malyon-opcode-ret             malyon-opcode-jump
   malyon-opcode-print-paddr     malyon-opcode-load
   malyon-opcode-calln           malyon-opcode-rtrue
   malyon-opcode-rfalse          malyon-opcode-print
   malyon-opcode-print-ret       malyon-opcode-nop
   malyon-opcode-illegal         malyon-opcode-illegal
   malyon-opcode-restart         malyon-opcode-ret-popped
   malyon-opcode-catch           malyon-opcode-quit
   malyon-opcode-new-line        malyon-opcode-illegal
   malyon-opcode-verify          malyon-opcode-illegal
   malyon-opcode-piracy          malyon-opcode-nop
   malyon-opcode-je              malyon-opcode-jl
   malyon-opcode-jg              malyon-opcode-dec-chk
   malyon-opcode-inc-chk         malyon-opcode-jin
   malyon-opcode-test            malyon-opcode-or
   malyon-opcode-and             malyon-opcode-test-attr
   malyon-opcode-set-attr        malyon-opcode-clear-attr
   malyon-opcode-store           malyon-opcode-insert-obj
   malyon-opcode-loadw           malyon-opcode-loadb
   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
   malyon-opcode-get-next-prop   malyon-opcode-add
   malyon-opcode-sub             malyon-opcode-mul
   malyon-opcode-div             malyon-opcode-mod
   malyon-opcode-calls           malyon-opcode-calln
   malyon-opcode-set-color       malyon-opcode-throw
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-nop             malyon-opcode-calls
   malyon-opcode-storew          malyon-opcode-storeb
   malyon-opcode-put-prop        malyon-opcode-aread
   malyon-opcode-print-char      malyon-opcode-print-num
   malyon-opcode-random          malyon-opcode-push
   malyon-opcode-pull            malyon-opcode-split-window
   malyon-opcode-set-window      malyon-opcode-calls
   malyon-opcode-erase-window    malyon-opcode-erase-line
   malyon-opcode-set-cursor      malyon-opcode-get-cursor
   malyon-opcode-set-text-style  malyon-opcode-buffer-mode
   malyon-opcode-output-stream   malyon-opcode-input-stream
   malyon-opcode-nop             malyon-opcode-read-char
   malyon-opcode-scan-table      malyon-opcode-not
   malyon-opcode-calln           malyon-opcode-calln
   malyon-opcode-tokenise        malyon-opcode-encode-text
   malyon-opcode-copy-table      malyon-opcode-print-table
   malyon-opcode-check-arg-count malyon-opcode-save
   malyon-opcode-restore         malyon-opcode-log-shift
   malyon-opcode-art-shift       malyon-opcode-set-font
   malyon-opcode-illegal         malyon-opcode-illegal
   malyon-opcode-illegal         malyon-opcode-illegal
   malyon-opcode-save-undo       malyon-opcode-restore-undo
   malyon-opcode-print-unicode   malyon-opcode-check-unicode
   malyon-opcode-nop             malyon-opcode-nop
   malyon-opcode-nop]
  "A vector of all known legal Z-code opcodes.")

;; initialization

(defun malyon-load-story-from-buffer (min max)
  "Load a Z-code story into an internal vector."
  (setq malyon-story-file (string-to-vector
                           (buffer-substring-no-properties min max)))
  (if (not (eq ?\^A 1))
      (let ((i 0))
        (while (< i (length malyon-story-file))
          (aset malyon-story-file
                i
                (malyon-char-to-int (aref malyon-story-file i)))
          (setq i (+ 1 i)))))
  )

(defun malyon-load-file (file-name)
  "Load a binary file into the current buffer."
  (malyon-disable-multibyte)
  (malyon-erase-buffer)
  (let ((coding-system-for-read 'binary))
    (insert-file-contents file-name)))

(defconst malyon-iff-chunk-spec
  '((:id     str 4)
    (:length u32))
  "Description of an IFF chunk header.")

(defconst malyon-RIdx-spec
  '((:num u32)
    (:resources repeat (:num) (:usage str 4) (:number u32) (:start u32)))
  "Description of the RIdx chunk.")

(defun malyon-unpack (spec start length)
  "Unpack LENGTH bytes at 0-based offset START according to SPEC."
  (bindat-unpack spec (buffer-substring-no-properties (1+ start)
                                                      (+ 1 start length))))

(defun malyon-load-blorb-file (file-name)
  "Load a Z-code Blorb file into an internal vector."
  (require 'bindat)
  (require 'cl-lib)
  (with-temp-buffer
    (malyon-load-file file-name)
    ;; Check the signature.  Must be an IFF file of type IFRS
    ;; starting with an RIdx chunk.
    (or (and (string= "FORM" (buffer-substring-no-properties 1 5))
             (string= "IFRSRIdx" (buffer-substring-no-properties 9 17)))
        (error "Not a Blorb file"))
    ;; Unpack the RIdx chunk, find the Exec chunck, and unpack its header.
    (let* ((ridx-header (malyon-unpack malyon-iff-chunk-spec 12 8))
           (ridx        (malyon-unpack malyon-RIdx-spec 20
                                       (cdr (assq :length ridx-header))))
           (exec (cl-find-if
                  (function
                   (lambda (r)
                     (and (= 0 (cdr (assq :number r)))
                          (string= "Exec" (cdr (assq :usage r))))))
                  (cdr (assq :resources ridx))))
           (story-start (cdr (assq :start exec)))
           (exec-header (malyon-unpack malyon-iff-chunk-spec story-start 8)))
      ;; Ensure that the Exec chunk is Z-code.
      (or (string= "ZCOD" (cdr (assq :id exec-header)))
          (error "Not a Z-code Blorb file"))
      ;; Load the Z-code from the chunk.
      (setq malyon-story-file-name file-name)
      (malyon-load-story-from-buffer (+ 9 story-start)
                                     (+ 9 story-start
                                        (cdr (assq :length exec-header)))))))

(defun malyon-load-story-file (file-name)
  "Load a Z-code story file into an internal vector."
  (with-temp-buffer
    (malyon-load-file file-name)
    (setq malyon-story-file-name file-name)
    (malyon-load-story-from-buffer (point-min) (point-max))))

(defun malyon-initialize ()
  "Initialize the Z-code interpreter."
;  (malyon-trace-file)
  (setq malyon-game-state-quetzal t)
  (malyon-initialize-status)
  (malyon-initialize-transcript)
  (malyon-initialize-windows)
  (malyon-initialize-story-header)
  (malyon-initialize-registers)
  (malyon-initialize-opcodes)
  (malyon-history-clear)
  (setq malyon-game-state-restart (malyon-current-game-state))
  (malyon-print-header))

(defun malyon-initialize-status ()
  "Initialize the status buffer."
  (setq malyon-status-buffer (get-buffer-create "Malyon Status"))
  (switch-to-buffer malyon-status-buffer)
  (malyon-erase-buffer)
  (kill-all-local-variables)
  (setq cursor-in-non-selected-windows nil)
  (setq mode-line-format nil)
  (setq malyon-status-buffer-point (point))
  (setq malyon-status-buffer-lines 0)
  (setq malyon-status-buffer-delayed-split nil)
  (use-local-map malyon-keymap-read)
  (set-syntax-table malyon-syntax-table)
  (setq mode-name "Malyon")
  (setq major-mode 'malyon-mode)
  (run-hooks 'malyon-mode-hook))

(defun malyon-initialize-transcript ()
  "Initialize the transcript buffer."
  (setq malyon-transcript-buffer (get-buffer-create "Malyon Transcript"))
  (switch-to-buffer malyon-transcript-buffer)
  (malyon-erase-buffer)
  (kill-all-local-variables)
  (setq malyon-last-cursor-position-after-input
        (malyon-point-max malyon-transcript-buffer))
  (use-local-map malyon-keymap-read)
  (set-syntax-table malyon-syntax-table)
  (setq fill-column malyon-max-column)
  (auto-fill-mode 1)
  (setq mode-name "Malyon")
  (setq major-mode 'malyon-mode)
  (run-hooks 'malyon-mode-hook))

(defun malyon-initialize-windows ()
  "Initialize the window configuration for the z machine."
  (setq malyon-transcript-buffer-buffered t)
  (malyon-set-window-configuration 0)
  (malyon-opcode-set-window 0))

(defun malyon-initialize-story-header ()
  "Initializes the header section of the story file."
  (malyon-store-byte 1
                     (if (>= malyon-story-version 5)
                         28
                       (logior #x20 (logand #b111 (malyon-read-byte 1)))))
  (malyon-store-byte 16 (logand 440 (malyon-read-byte 16)))
  (malyon-store-byte 30 1)
  (malyon-store-byte 31 65)
  (malyon-store-byte 32 255)
  (malyon-store-byte 33 (- malyon-max-column 1))
  (malyon-store-word 34 (- malyon-max-column 1))
  (malyon-store-word 36 255)
  (malyon-store-word 38 1)
  (malyon-store-word 39 1)
  (malyon-store-byte 44 0)
  (malyon-store-byte 45 0)
  (malyon-store-byte 50 1)
  (malyon-store-byte 51 0))

(defun malyon-initialize-registers ()
  "Initialize the interpreter's internal registers."
  (setq malyon-stack (make-vector 1024 0))
  (setq malyon-stack-pointer -1)
  (malyon-push-initial-frame)
  (setq malyon-frame-pointer malyon-stack-pointer)
  (setq malyon-instruction-pointer (malyon-read-word 6))
  (setq malyon-global-variables (malyon-read-word 12))
  (setq malyon-object-table (malyon-read-word 10))
  (cond ((< malyon-story-version 5)
         (setq malyon-object-table-entry-size 9)
         (setq malyon-object-properties       31)
         (setq malyon-object-property-offset  7))
        (t
         (setq malyon-object-table-entry-size 14)
         (setq malyon-object-properties       63)
         (setq malyon-object-property-offset  12)))
  (setq malyon-abbreviations (malyon-read-word 24))
  (if (< malyon-story-version 5)
      (setq malyon-score-game (zerop (logand 2 (malyon-read-byte 1)))))
  (setq malyon-packed-multiplier
        (cadr (assq malyon-story-version '((3 2) (5 4) (8 8)))))
  (if (or (< malyon-story-version 5) (zerop (malyon-read-word 52)))
      (setq malyon-alphabet (concat "abcdefghijklmnopqrstuvwxyz"
                                    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                                    " \n0123456789.,!?_#'\"/\\-:()"))
    (setq malyon-alphabet (make-string 78 ? ))
    (let ((i 0))
      (while (< i 78)
        (aset malyon-alphabet i
              (malyon-read-byte (+ i (malyon-read-word 52))))
        (setq i (+ 1 i)))))
  (malyon-initialize-unicode-table)
  (setq malyon-dictionary (malyon-read-word 8))
  (setq malyon-dictionary-entry-length
        (malyon-read-byte
         (+ 1 malyon-dictionary (malyon-read-byte malyon-dictionary))))
  (setq malyon-dictionary-num-entries
        (malyon-read-word
         (+ 2 malyon-dictionary (malyon-read-byte malyon-dictionary))))
  (setq malyon-dictionary-entries
        (+ 4 malyon-dictionary (malyon-read-byte malyon-dictionary)))
  (setq malyon-dictionary-word-length (if (< malyon-story-version 5) 3 5))
  (setq malyon-current-face 'malyon-face-plain)
  (setq malyon-print-separator nil)
  (malyon-initialize-output-streams))

(defun malyon-initialize-opcodes ()
  "Initialize the opcode table used by the story file."
  (cond ((< malyon-story-version 5)
         (aset malyon-opcodes 143 'malyon-opcode-not)
         (aset malyon-opcodes 181 'malyon-opcode-save)
         (aset malyon-opcodes 182 'malyon-opcode-restore)
         (aset malyon-opcodes 185 'malyon-opcode-pop)
         (aset malyon-opcodes 188 'malyon-opcode-show-status))
        (t
         (aset malyon-opcodes 143 'malyon-opcode-calln)
         (aset malyon-opcodes 181 'malyon-opcode-illegal)
         (aset malyon-opcodes 182 'malyon-opcode-illegal)
         (aset malyon-opcodes 185 'malyon-opcode-catch)
         ;; Technically, 188 (show_status) is v3 only, but Version 5 Release 23
         ;; of Wishbringer contains it by accident, so treat it as NOP instead.
         (aset malyon-opcodes 188 'malyon-opcode-nop))))

(defun malyon-print-header ()
  "Print malyon mode header information."
  (malyon-opcode-set-text-style 2)
  (malyon-print (concat "Malyon V " malyon-version))
  (malyon-opcode-set-text-style 0)
  (malyon-newline)
  (malyon-print "A z-code interpreter for version 3, 5, and 8 games.")
  (malyon-newline)
  (malyon-print "(c) 1999-2011 by Peter Ilberg <peter.ilberg@gmail.com>")
  (malyon-newline)
  (malyon-print "(c) 2016 by Erik Selberg <erik@selberg.org>")
  (malyon-newline)
  (malyon-newline))

;; cleanup

(defun malyon-cleanup ()
  "Clean up the Z-code interpreter."
  (malyon-hide-internal-errors "cleanup failed."
    (progn
      (setq malyon-story-file nil)
      (setq malyon-window-configuration nil)
      (setq malyon-game-state-restart nil)
      (setq malyon-game-state-undo nil)
      (if (get-buffer "Malyon Status")
          (kill-buffer (get-buffer "Malyon Status")))
      (if (get-buffer "Malyon Transcript")
          (progn
            (switch-to-buffer (get-buffer "Malyon Transcript"))
            (malyon-redisplay-frame (selected-frame) t)
            (delete-other-windows (get-buffer-window (current-buffer)))
            (widen)
            (text-mode)))
      (setq malyon-status-buffer nil)
      (setq malyon-transcript-buffer nil))))

;; error handling

(defun malyon-fatal-error (message)
  "Print error message and abort."
  (setq message (concat "Malyon fatal error: " message))
  (unwind-protect
      (with-current-buffer malyon-transcript-buffer
        (goto-char (point-max))
        (newline)
        (newline)
        (put-text-property 0
                           (length message)
                           'face
                           'malyon-face-error
                           message)
        (insert message)
        (newline))
    (malyon-cleanup)
    (malyon-redisplay-frame (selected-frame) t)
    (error message)))

;; conversion of zscii to ascii

(defvar malyon-unicode-table nil
  "An array mapping zscii characters to latin-1 ones.")

(defvar malyon-default-unicode-table nil
  "The default array mapping zscii characters to latin-1 ones.")

(if malyon-default-unicode-table
    '()
  (setq malyon-default-unicode-table
        [32
         0   0   0   0   0   0   0       ;   1 -   7
         8   0   0   0   0   10  0   0   ;   8 -  15
         0   0   0   0   0   0   0   0   ;  16 -  23
         0   0   0   39  0   0   0   0   ;  24 -  31
         32  33  34  35  36  37  38  39  ;  32 -  39
         40  41  42  43  44  45  46  47  ;  40 -  47
         48  49  50  51  52  53  54  55  ;  48 -  55
         56  57  58  59  60  61  62  63  ;  56 -  63
         64  65  66  67  68  69  70  71  ;  64 -  71
         72  73  74  75  76  77  78  79  ;  72 -  79
         80  81  82  83  84  85  86  87  ;  80 -  87
         88  89  90  91  92  93  94  95  ;  88 -  95
         96  97  98  99  100 101 102 103 ;  96 - 103
         104 105 106 107 108 109 110 111 ; 104 - 111
         112 113 114 115 116 117 118 119 ; 112 - 119
         120 121 122 123 124 125 126 0   ; 120 - 127
         0   0   0   0   0   0   0   0   ; 128 - 135
         0   0   0   0   0   0   0   0   ; 136 - 143
         0   48  49  50  51  52  53  54  ; 144 - 151
         55  56  57  228 246 252 196 214 ; 152 - 159
         220 223 187 171 235 239 255 203 ; 160 - 167
         207 225 233 237 243 250 253 193 ; 168 - 175
         201 205 211 218 221 224 232 236 ; 176 - 183
         242 249 192 200 204 210 217 226 ; 184 - 191
         234 238 244 251 194 202 206 212 ; 192 - 199
         219 229 197 248 216 227 241 245 ; 200 - 207
         195 209 213 230 198 231 199 254 ; 208 - 215
         240 222 208 163 63  63  161 191 ; 216 - 223
         0   0   0   0   0   0   0   0   ; 224 - 231
         0   0   0   0   0   0   0   0   ; 232 - 239
         0   0   0   0   0   0   0   0   ; 240 - 247
         0   0   0   0   0   0   0   0   ; 248 - 255
         ]))

(defun malyon-initialize-unicode-table ()
  "Initializes the zscii-to-unicode conversion table."
  (setq malyon-unicode-table
        (copy-sequence malyon-default-unicode-table))
  (let* ((ext   (malyon-read-word 54))
         (len   (if (zerop ext) 0 (malyon-read-word ext)))
         (table (if (< len 3)   0 (malyon-read-word (+ ext 6)))))
    (if (or (< malyon-story-version 5) (zerop table))
        '()
      (let ((i 0))
        (while (< i 96)
          (aset malyon-unicode-table (+ 155 i) (malyon-char-to-int ??))
          (setq i (+ 1 i))))
      (setq len (malyon-read-byte table))
      (let ((i 0))
        (while (< i len)
          (aset malyon-unicode-table (+ 155 i)
                (malyon-read-word (+ table 1 i)))
          (setq i (+ 1 i)))))))

(defsubst malyon-zscii-to-unicode (char)
  "Converts a zscii character to unicode."
  (if (or (< char 0) (> char 255))
      ??
    (let ((uni (aref malyon-unicode-table char)))
      (if (zerop uni)
          ??
        (malyon-unibyte-char-to-multibyte (malyon-int-to-char uni))))))

(defsubst malyon-unicode-to-zscii (char)
  "Converts a unicode character to zscii."
  (setq char (malyon-multibyte-char-to-unibyte char))
  (setq char (if (characterp char) (malyon-char-to-int char) char))
  (if (= 13 char)
      ?\r
    (let ((i 1) (found 0))
      (while (and (< i 255) (zerop found))
        (if (= char (aref malyon-unicode-table i))
            (setq found i))
        (setq i (+ i 1)))
      (malyon-int-to-char found))))

;; output streams

(defvar malyon-output-streams nil
  "Valid output streams for the interpreter.")

(defvar malyon-output-streams-tables nil
  "A list of active tables for stream 3.")

(defun malyon-initialize-output-streams ()
  "Initializes the output streams."
  (setq malyon-output-streams '())
  (setq malyon-output-streams-tables '())
  (malyon-add-output-stream 1 0))

(defun malyon-output-stream-function (stream)
  "Returns the output function representing the given stream."
  (cond ((= 1 stream) (if (zerop malyon-current-window)
                          'malyon-putchar-transcript
                        'malyon-putchar-status))
        ((= 2 stream) 'malyon-putchar-printer)))

(defun malyon-add-output-stream (stream table)
  "Add a new output stream."
  (if (= stream 3)
      (progn
        (setq malyon-output-streams-tables
              (cons table malyon-output-streams-tables))
        (malyon-store-word table 0))
    (let ((function (malyon-output-stream-function stream)))
      (setq malyon-output-streams
            (if (member function malyon-output-streams)
                malyon-output-streams
              (cons function malyon-output-streams))))))

(defun malyon-remove-output-stream (stream)
  "Remove an output stream."
  (if (= stream 3)
      (setq malyon-output-streams-tables (cdr malyon-output-streams-tables))
    (setq malyon-output-streams
	  (remove (malyon-output-stream-function stream)
			 malyon-output-streams))))

(defun malyon-update-output-streams ()
  "Update output streams when the output window has changed."
  (let ((one (or (member 'malyon-putchar-transcript malyon-output-streams)
                 (member 'malyon-putchar-status     malyon-output-streams))))
    (setq malyon-output-streams
	  (remove 'malyon-putchar-transcript
			 (remove 'malyon-putchar-status
					malyon-output-streams)))
    (if one
        (malyon-add-output-stream 1 0))))

(defsubst malyon-output-character (char)
  "Output a single character on all active streams."
  (setq char (malyon-zscii-to-unicode char))
  (if malyon-output-streams-tables
      (malyon-putchar-table char (car malyon-output-streams-tables))
    (mapc (lambda (s) (funcall s char)) malyon-output-streams)))

;; printing text

(defsubst malyon-abbrev (abbrev x)
  "Print an abbreviation."
  (malyon-print-ztext
   (* 2 (malyon-read-word (+ malyon-abbreviations
                             (* 2 (+ x (* 32 (1- abbrev)))))))))

(defun malyon-newline ()
  "Print a newline."
  (if (eq malyon-status-buffer (current-buffer))
      (goto-char malyon-status-buffer-point)
    (goto-char (point-max)))
  (malyon-output-character ?\r)
  (if (eq malyon-status-buffer (current-buffer))
      (setq malyon-status-buffer-point (point))
    (goto-char malyon-last-cursor-position-after-input))
  (malyon-redisplay-frame (selected-frame) nil))

(defun malyon-print (object)
  "Print text." 
  (let ((text (if (characterp object) (char-to-string object) object))
	(start))
    (if (eq malyon-transcript-buffer (current-buffer))
        (goto-char (point-max))
      (goto-char malyon-status-buffer-point))
    (setq start (point))
    (malyon-print-characters (string-to-list text))
    (put-text-property start (point) 'face malyon-current-face)
    (if (eq malyon-status-buffer (current-buffer))
        (setq malyon-status-buffer-point (point))
      (goto-char malyon-last-cursor-position-after-input))))

(defun malyon-print-characters (text)
  "Print a list of characters."
  (mapc 'malyon-output-character text))

(defsubst malyon-print-state-new (char shift abbr zscii zcode)
  "Generate a new print state."
  (list char shift abbr zscii zcode))

(defsubst malyon-print-state-initial ()
  "Returns an initial state for the ztext decoder."
  (malyon-print-state-new nil -6 0 0 0))

(defsubst malyon-print-state-next (x ignore shift abbr zscii z)
  "Print state transition function."
  (cond ((= zscii 2)
         (malyon-print-state-new (+ z x) -6 0 0 0))
        ((= zscii 1)
         (malyon-print-state-new nil     -6 0 2 (* 32 x)))
        ((> abbr 0)
         (malyon-abbrev abbr x)
         (malyon-print-state-initial))
        ((= x 0)
         (malyon-print-state-new ?       -6 0 0 0))
        ((< x 4)
         (malyon-print-state-new nil     -6 x 0 0))
        ((= x 4)
         (malyon-print-state-new nil     20 0 0 0))
        ((= x 5)
         (malyon-print-state-new nil     46 0 0 0))
        ((and (= shift 46) (= x 6))
         (malyon-print-state-new nil     -6 0 1 0))
        ((and (= shift 46) (= x 7))
         (malyon-print-state-new ?\r     -6 0 0 0))
        (t
         (malyon-print-state-new
          (aref malyon-alphabet (+ shift x)) -6 0 0 0))))

(defun malyon-print-text (address)
  "Print text at address and return the address of the following byte."
  (let ((start))
    (if (eq malyon-transcript-buffer (current-buffer))
        (goto-char (point-max))
      (goto-char malyon-status-buffer-point))
    (setq start (point))
    (setq address (malyon-print-ztext address))
    (put-text-property start (point) 'face malyon-current-face)
    (if (eq malyon-status-buffer (current-buffer))
        (setq malyon-status-buffer-point (point))
      (goto-char malyon-last-cursor-position-after-input))
    (malyon-redisplay-frame (selected-frame) nil)
    address))

(defun malyon-print-ztext (address)
  "Print the ztext stored at the given address."
  (let ((high 0) (low) (a) (b) (c) (state (malyon-print-state-initial)))
    (while (zerop (logand 128 high))
      (setq high (malyon-read-byte address))
      (setq low  (malyon-read-byte (+ 1 address)))
      (setq a    (logand 31 (lsh high -2)))
      (setq b    (logand 31 (logior (lsh high 3) (lsh low -5))))
      (setq c    (logand 31 low))
      (setq state (apply 'malyon-print-state-next a state))
      (if (car state) (malyon-output-character (car state)))
      (setq state (apply 'malyon-print-state-next b state))
      (if (car state) (malyon-output-character (car state)))
      (setq state (apply 'malyon-print-state-next c state))
      (if (car state) (malyon-output-character (car state)))
      (setq address (+ 2 address)))
    address))

(defun malyon-putchar-transcript (char)
  "Print a single character in the transcript window."
  (if (char-equal char ?\n)
      (newline 1)
    (insert char)
    (setq malyon-print-separator (null (member char malyon-whitespace))))
  (if (and malyon-transcript-buffer-buffered
           (> (current-column) (current-fill-column)))
      (progn
        (end-of-line)
        (forward-word -1)
        (if (< 0 (current-column))
            (newline 1))
        (end-of-line))))

(defun malyon-putchar-status (char)
  "Print a single character in the status window."
  (if malyon-status-buffer-delayed-split
      (progn
        (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
        (other-window 1)))
  (if (char-equal char ?\n)
      (progn
        (beginning-of-line)
        (forward-line 1)
        (if (= (point) (point-max))
            (forward-line -1)))
    (if (> (current-column) (current-fill-column))
        '()
      (insert char)
      (delete-char 1))))

(defun malyon-putchar-table (char table)
  "Print a single character into a table."
  (setq char (malyon-unicode-to-zscii char))
  (malyon-store-byte (+ 2 table (malyon-read-word table)) char)
  (malyon-store-word table (+ 1 (malyon-read-word table))))

(defun malyon-putchar-printer (char)
  "Print a single character onto a printer."); not yet implemented

;; more

(defvar malyon-more-continue-keymap nil
  "The keymap with which to continue after More has finished.")

(defun malyon-more (keymap)
  "Enter More mode."
  (if (eq malyon-status-buffer (current-buffer))
      (use-local-map keymap)
    (if (< malyon-story-version 5) (malyon-opcode-show-status))
    (if (< (count-lines malyon-last-cursor-position-after-input (point-max))
           (malyon-window-displayed-height))
        (progn
          (malyon-adjust-transcript)
          (use-local-map keymap))
      (goto-char malyon-last-cursor-position-after-input)
      (beginning-of-line)
      (recenter 1)
      (setq malyon-more-continue-keymap keymap)
      (use-local-map malyon-keymap-more)
      (message "[More]"))))

(defun malyon-more-status-buffer ()
  "Enter More mode for the status buffer."
  (setq malyon-more-continue-keymap (current-local-map))
  (use-local-map malyon-keymap-more-status)
  (message "[More]")
  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))

;; input history

(defvar malyon-history nil
  "The input history.")

(defun malyon-history-previous ()
  "Move one entry up in the input history."
  (let ((prev (aref malyon-history 0))
        (curr (aref malyon-history 1))
        (next (aref malyon-history 2)))
    (if (null prev)
        curr
      (aset malyon-history 2 (if curr (cons curr next) next))
      (aset malyon-history 0 (cdr prev))
      (aset malyon-history 1 (car prev)))))

(defun malyon-history-next ()
  "Move one entry down in the input history."
  (let ((prev (aref malyon-history 0))
        (curr (aref malyon-history 1))
        (next (aref malyon-history 2)))
    (if (null next)
        curr
      (aset malyon-history 0 (if curr (cons curr prev) prev))
      (aset malyon-history 2 (cdr next))
      (aset malyon-history 1 (car next)))))

(defun malyon-history-clear ()
  "Clear the input history."
  (setq malyon-history (vector '() nil '())))

(defun malyon-history-insert (entry)
  "Insert an entry into the input history."
  (let* ((prev (aref malyon-history 0))
	 (curr (aref malyon-history 1))
	 (next (aref malyon-history 2))
	 (l    (remove entry
			      (append (nreverse prev)
				      (if curr (cons curr next) next))))
	 (cut  (- (length l) 19)))
    (while (> cut 0)
      (setq l   (cdr l)
            cut (- cut 1)))
    (aset malyon-history 0
	  (remove nil (remove "" (cons entry (nreverse l)))))
    (aset malyon-history 1 nil)
    (aset malyon-history 2 '())))

;; dictionary lookup

(defun malyon-dictionary-word (chars)
  "Convert a list of characters into a dictionary word."
  (list (car (car chars))
	(length chars)
	(malyon-encode-dictionary-word (append (cl-mapcan 'cdr chars)
					       '(5 5 5 5 5 5 5 5)))))

(defsubst malyon-join-characters (stop list)
  "Joins three ztext characters into two bytes."
  (let ((a (car          list))
	(b (cadr  list))
	(c (cl-caddr list))
	(x (if (zerop stop) 0 128)))
    (list (logior x (logand 255 (logior (lsh a 2) (lsh b -3))))
          (logand 255 (logior (lsh b 5) c)))))

(defun malyon-encode-dictionary-word (l)
  "Converts a list of ztext characters into a dictionary word."
  (let* ((first  l)
	 (second (cl-cdddr first))
	 (third  (cl-cdddr second)))
    (apply 'vector
           (if (< malyon-story-version 5)
               (append (malyon-join-characters 0 first)
                       (malyon-join-characters 1 second))
             (append (malyon-join-characters 0 first)
                     (malyon-join-characters 0 second)
                     (malyon-join-characters 1 third))))))

(defun malyon-lookup (dict code)
  "Look for the given code in the dictionary and return its address."
  (cond ((not code)                 0)
        ((not dict)                 (malyon-binary-search code))
        ((= dict malyon-dictionary) (malyon-binary-search code))
        (t                          (malyon-linear-search dict code))))

(defsubst malyon-compare-words (word address)
  "Compares the given word to the word stored at address."
  (let* ((i 0)
         (j address)
         (x (aref word i))
         (y (malyon-read-byte j)))
    (while (not (or (/= x y) (= i malyon-dictionary-word-length)))
      (setq i (+ 1 i)
            j (+ 1 j)
            x (aref word i)
            y (malyon-read-byte j)))
    (- x y)))

;; search functions

(defun malyon-binary-search (code)
  "Binary search through the main dictionary."
  (let* ((lower   0)
         (upper   (- malyon-dictionary-num-entries 1))
         (median  (/ (+ lower upper) 2))
         (entry   (+ malyon-dictionary-entries
                     (* malyon-dictionary-entry-length median)))
         (looking (malyon-compare-words code entry)))
    (while (not (or (> lower upper) (zerop looking)))
      (setq lower   (if (< 0 looking) (+ median 1) lower)
            upper   (if (> 0 looking) (- median 1) upper)
            median  (/ (+ lower upper) 2)
            entry   (+ malyon-dictionary-entries
                       (* malyon-dictionary-entry-length median))
            looking (malyon-compare-words code entry)))
    (if (zerop looking) entry 0)))

(defun malyon-linear-search (dictionary code)
  "Linear search through the given dictionary."
  (let* ((length  (malyon-read-byte (+ dictionary 1
                                       (malyon-read-byte dictionary))))
         (number  (malyon-read-word (+ dictionary 2
                                       (malyon-read-byte dictionary))))
         (entries (+ dictionary 4 (malyon-read-byte dictionary)))
         (i       0)
         (entry   (+ entries (* length i)))
         (looking (malyon-compare-words code entry)))
    (while (not (or (>= i number) (zerop looking)))
      (setq i       (+ 1 i)
            entry   (+ entries (* length i))
            looking (malyon-compare-words code entry)))
    (if (zerop looking) entry 0)))

;; encoding text and lexical analysis

(defun malyon-split-list (sep list &optional x)
  "Split a list into sublists as indicated by the separators."
  (cond ((null list)
         (list (nreverse x)))
        ((eq sep (car list))
         (cons (nreverse x) (malyon-split-list sep (cdr list) '())))
        (t
         (malyon-split-list sep (cdr list) (cons (car list) x)))))

(defun malyon-characters-to-words (list)
  "Turn the list of characters into a list of words."
  (mapcar 'malyon-dictionary-word
          (delete '() (malyon-split-list 'malyon-word-separator list))))

(defsubst malyon-char-in-string (c s)
  "Returns the index of c in s if found, or length of s."
  (let ((i 0))
    (while (not (or (= i (length s)) (= c (aref s i))))
      (setq i (+ 1 i)))
    i))

(defsubst malyon-encode-into-ztext (c)
  "Convert a character into ztext."
  (let* ((index (malyon-char-in-string c malyon-alphabet))
         (shift (floor index 26))
         (char  (+ 6 (mod index 26))))
    (cond ((> shift 2) (list 5 6 (logand 31 (lsh c -5)) (logand 31 c)))
          ((= shift 2) (list 5 char))
          ((= shift 1) (list 4 char))
          (t           (list char)))))

(defun malyon-encode-single-character (terminating-characters char)
  "Encode a character into ztext."
  (let ((pos (car char))
        (c   (cdr char)))
    (cond ((member c malyon-whitespace)
           (list 'malyon-word-separator))
          ((member c terminating-characters)
           (list 'malyon-word-separator
                 (cons pos (malyon-encode-into-ztext c))
                 'malyon-word-separator))
          (t (list (cons pos (malyon-encode-into-ztext c)))))))

(defun malyon-encode-character-list (dict list)
  "Encode the list of characters into ztext."
  (let ((l '())
        (i 0))
    (while (< i (malyon-read-byte dict))
      (setq l (cons (malyon-read-byte (+ dict 1 i)) l)
	    i (+ 1 i)))
    (cl-mapcan (lambda (x) (malyon-encode-single-character l x)) list)))

(defun malyon-text-length (address)
  "Return the length of the input text."
  (if (>= malyon-story-version 5)
      (malyon-read-byte (+ 1 address))
    (let ((i 0))
      (while (not (zerop (malyon-read-byte (+ i 1 address))))
        (setq i (+ i 1)))
      i)))

(defun malyon-text-to-character-list (address)
  "Convert the input text into a list of characters."
  (let ((i    (malyon-text-length address))
        (text '()))
    (while (< 0 i)
      (setq text (cons
                  (cons (if (< malyon-story-version 5) i (+ 1 i))
                        (malyon-read-byte
                         (+ i address (if (< malyon-story-version 5) 0 1))))
                  text)
            i    (- i 1)))
    text))

(defun malyon-text-to-words (address dictionary)
  "Turn ztext into a list of dictionary words."
  (malyon-characters-to-words
   (malyon-encode-character-list (if dictionary dictionary malyon-dictionary)
                                 (malyon-text-to-character-list address))))

;; window management

(defvar malyon-status-buffer-grew-this-turn nil
  "A flag signalling if the status buffer grew this turn.")

(defun malyon-adjust-transcript ()
  "Adjust the position of the transcript text."
  (with-current-buffer malyon-transcript-buffer
    (setq malyon-status-buffer-grew-this-turn nil)
    (goto-char (point-max))
    (recenter (- (malyon-window-displayed-height) 2))))

(defun malyon-prepare-status-buffer (status)
  "Fill the status buffer with empty lines."
  (with-current-buffer malyon-status-buffer
    (let ((lines (count-lines (point-min) (point-max)))
          (new   status))
      (if (zerop lines)
          (newline 1))
      (goto-char (point-max))
      (setq status (- status lines -1))
      (while (> status 0)
        (insert (make-string (+ 3 malyon-max-column) ? ))
        (newline 1)
        (setq status (- status 1)))
      (goto-char (point-min))
      (forward-line (+ 1 new))
      (kill-region (point) (point-max))
      (insert (make-string (+ 3 malyon-max-column) ? ))
      (newline 1))))

(defun malyon-restore-window-configuration ()
  "Restore the saved window configuration."
  (let ((buffer (window-buffer (selected-window))))
    (if malyon-window-configuration
        (set-window-configuration malyon-window-configuration))
    (cond ((eq malyon-status-buffer buffer)     (other-window 1))
          ((eq malyon-transcript-buffer buffer) (goto-char (point-max))))))

(defun malyon-set-window-configuration (status)
  "Set up the new window configuration."
  (cond ((< status malyon-status-buffer-lines)
         (setq malyon-status-buffer-delayed-split status)
         (if malyon-status-buffer-grew-this-turn
             (malyon-more-status-buffer)))
        ((> status malyon-status-buffer-lines)
         (malyon-split-buffer-windows status)
         (setq malyon-status-buffer-grew-this-turn t))
        ((not malyon-window-configuration)
         (malyon-split-buffer-windows status))))

(defun malyon-split-buffer-windows (status)
  "Split the buffer windows.
The status buffer gets 'status' lines while the transcript buffer
gets the remaining lines."
  (delete-other-windows (get-buffer-window (current-buffer)))
  (setq malyon-status-buffer-lines status)
  (setq malyon-status-buffer-delayed-split nil)
  (if (zerop status)
      '()
    (split-window (get-buffer-window (current-buffer)) status)
    (switch-to-buffer malyon-status-buffer)
    (malyon-prepare-status-buffer status)
    (malyon-opcode-set-cursor 1 1)
    (other-window 1))
  (switch-to-buffer malyon-transcript-buffer)
  (setq malyon-window-configuration (current-window-configuration)))

;; getting and setting the machine state

(defun malyon-current-game-state ()
  "Return the current state of the interpreter."
  (vector malyon-instruction-pointer
          malyon-stack-pointer
          malyon-frame-pointer
          (copy-sequence malyon-stack)
          (copy-sequence malyon-story-file)
          malyon-game-state-quetzal))

(defun malyon-set-game-state (state)
  "Installs the given state as the new state of the interpreter."
  (setq malyon-instruction-pointer       (aref state 0))
  (setq malyon-stack-pointer             (aref state 1))
  (setq malyon-frame-pointer             (aref state 2))
  (setq malyon-stack (copy-sequence      (aref state 3)))
  (setq malyon-story-file (copy-sequence (aref state 4)))
  (setq malyon-game-state-quetzal        (aref state 5))
  (with-current-buffer  malyon-status-buffer
    (malyon-erase-buffer malyon-status-buffer)
    (malyon-split-buffer-windows 0)
    (setq malyon-last-cursor-position-after-input
          (malyon-point-max malyon-transcript-buffer))))

;; file utilities

(defsubst malyon-write-byte-to-file (byte)
  "Write a byte to a file."
  (insert-char (logand 255 byte) 1))

(defsubst malyon-write-word-to-file (word)
  "Write a word to the last opened file."
  (insert-char (logand 255 (lsh word -8)) 1)
  (insert-char (logand 255 word) 1))

(defsubst malyon-write-dword-to-file (dword)
  "Write a dword to the last opened file."
  (insert-char (logand 255 (lsh dword -24)) 1)
  (insert-char (logand 255 (lsh dword -16)) 1)
  (insert-char (logand 255 (lsh dword -8)) 1)
  (insert-char (logand 255 dword) 1))

(defsubst malyon-write-chunk-id-to-file (id)
  "Write a quetzal chunk id to the last opened file."
  (insert id))

(defsubst malyon-read-byte-from-file ()
  "Read the next byte from a file."
  (if (= (point) (point-max))
      0
    (forward-char 1)
    (malyon-char-to-int (char-before))))

(defsubst malyon-read-word-from-file ()
  "Read the next word from the last opened file."
  (logior (lsh (malyon-read-byte-from-file) 8) (malyon-read-byte-from-file)))

(defsubst malyon-read-dword-from-file ()
  "Read the next dword from the last opened file."
  (logior (lsh (malyon-read-byte-from-file) 24)
          (lsh (malyon-read-byte-from-file) 16)
          (lsh (malyon-read-byte-from-file) 8)
          (malyon-read-byte-from-file)))

(defsubst malyon-read-chunk-id-from-file ()
  "Read a quetzal chunk id from the last opened file."
  (string (malyon-int-to-char (malyon-read-byte-from-file))
          (malyon-int-to-char (malyon-read-byte-from-file))
          (malyon-int-to-char (malyon-read-byte-from-file))
          (malyon-int-to-char (malyon-read-byte-from-file))))

(defun malyon-get-file-name (address)
  "Retrieves the file name stored at address."
  (let ((name (make-string (malyon-read-byte address) ? ))
        (i    0))
    (while (< i (length name))
      (aset name i (malyon-read-byte (+ address 1 i)))
      (setq i (+ 1 i)))
    name))

;; saving data to disk

(defun malyon-save-file (file &optional table length)
  "Save the current game state or a memory section to disk."
  (interactive "FSave file: ")
  (condition-case nil
      (let ((coding-system-for-write 'binary))
        (with-temp-file file
          (malyon-disable-multibyte)
          (malyon-erase-buffer)
          (cond (table (malyon-save-table table length))
                (malyon-game-state-quetzal
                 (malyon-save-quetzal-state (malyon-current-game-state)))
                (t
                 (malyon-save-game-state (malyon-current-game-state))))
          1))
      (error 0)))

(defun malyon-save-table (table length)
  "Save the given section of memory to the file."
  (let ((i 0)
        (j table))
    (while (< i length)
      (malyon-write-byte-to-file (malyon-read-byte j))
      (setq i (+ 1 i)
            j (+ 1 j)))))

(defun malyon-save-game-state (state)
  "Saves the game state to disk."
  (let ((ip    (aref state 0))
        (sp    (aref state 1))
        (fp    (aref state 2))
        (stack (aref state 3))
        (mem   (aref state 4))
        (dyn   (malyon-read-word 14))
        (i     0))
    (malyon-write-word-to-file (length malyon-story-file-name))
    (while (< i (length malyon-story-file-name))
      (malyon-write-byte-to-file (aref malyon-story-file-name i))
      (setq i (+ 1 i)))
    (malyon-write-dword-to-file ip)
    (malyon-write-word-to-file  sp)
    (malyon-write-word-to-file  fp)
    (malyon-write-word-to-file  dyn)
    (setq i 0)
    (while (<= i sp)
      (malyon-write-dword-to-file (aref stack i))
      (setq i (+ 1 i)))
    (setq i 0)
    (while (< i dyn)
      (malyon-write-byte-to-file (aref mem i))
      (setq i (+ 1 i)))))

(defun malyon-save-quetzal-state (state)
  "Saves the game state to disk in quetzal format."
  (goto-char (point-min))
  (malyon-save-quetzal-ifhd state)
  (malyon-save-quetzal-cmem state)
  (malyon-save-quetzal-stks state)
  (goto-char (point-min))
  (malyon-write-chunk-id-to-file "IFZS")
  (goto-char (point-min))
  (malyon-write-dword-to-file (- (point-max) (point-min)))
  (goto-char (point-min))
  (malyon-write-chunk-id-to-file "FORM"))

(defun malyon-save-quetzal-ifhd (state)
  "Saves the IFhd chunk of the quetzal format."
  (malyon-write-chunk-id-to-file "IFhd")
  (malyon-write-dword-to-file 13)
  (malyon-write-word-to-file (malyon-read-word 2))
  (malyon-write-word-to-file (malyon-read-word 18))
  (malyon-write-word-to-file (malyon-read-word 20))
  (malyon-write-word-to-file (malyon-read-word 22))
  (malyon-write-word-to-file (malyon-read-word 28))
  (malyon-write-byte-to-file (lsh (aref state 0) -16))
  (malyon-write-byte-to-file (lsh (aref state 0) -8))
  (malyon-write-byte-to-file (aref state 0))
  (malyon-write-byte-to-file 0))

(defun malyon-save-quetzal-cmem (state)
  "Saves the CMem chunk of the quetzal format."
  (let ((beginning (point-max))
        (original  (aref malyon-game-state-restart 4))
        (current   (aref state 4))
        (size      (malyon-read-word 14))
        (byte      0)
        (count     0)
        (i         0))
    (goto-char (point-max))
    (while (< i size)
      (setq byte (logxor (aref current i) (aref original i)))
      (if (zerop byte)
          (setq count (+ 1 count))
        (while (> count 0)
          (malyon-write-byte-to-file 0)
          (setq count (- count 1))
          (malyon-write-byte-to-file (min 255 count))
          (setq count (- count (min 255 count))))
        (malyon-write-byte-to-file byte))
      (setq i (+ 1 i)))
    (setq size (- (point-max) beginning))
    (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
    (goto-char beginning)
    (malyon-write-chunk-id-to-file "CMem")
    (malyon-write-dword-to-file size)))

(defun malyon-save-quetzal-stks (state)
  "Saves the Stks chunk of the quetzal format."
  (let ((beginning (point-max))
        (size      0))
    (goto-char (point-max))
    (malyon-save-quetzal-stack-frame (- (aref state 2) 4)
                                     (aref state 1)
                                     (aref state 3))
    (setq size (- (point-max) beginning))
    (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
    (goto-char beginning)
    (malyon-write-chunk-id-to-file "Stks")
    (malyon-write-dword-to-file size)))

(defun malyon-save-quetzal-stack-frame (fp sp stack)
  "Saves the stack frames for the Stks chunk."
  (let* ((frame       (malyon-get-stack-frame fp sp stack))
         (frame-id    (aref frame 0))
         (previous-fp (aref frame 1))
         (previous-sp (aref frame 2))
         (return-addr (aref frame 3))
         (result-addr (aref frame 4))
         (local-vars  (aref frame 5))
         (num-args    (aref frame 6))
         (eval-stack  (aref frame 7)))
    (if (> frame-id 0)
        (malyon-save-quetzal-stack-frame previous-fp previous-sp stack))
    (malyon-write-byte-to-file (lsh return-addr -16))
    (malyon-write-byte-to-file (lsh return-addr -8))
    (malyon-write-byte-to-file return-addr)
    (if (zerop frame-id)
        (malyon-write-byte-to-file 0)
      (malyon-write-byte-to-file (logior (if result-addr 0 16)
                                         (length local-vars))))
    (malyon-write-byte-to-file (if result-addr result-addr 0))
    (malyon-write-byte-to-file (- (lsh 1 num-args) 1))
    (malyon-write-word-to-file (length eval-stack))
    (while (not (null local-vars))
      (malyon-write-word-to-file (car local-vars))
      (setq local-vars (cdr local-vars)))
    (while (not (null eval-stack))
      (malyon-write-word-to-file (car eval-stack))
      (setq eval-stack (cdr eval-stack)))))

;; restoring data from disk

(defvar malyon-restore-data-error nil
  "An error message if restoring data from a file failed.")

(defvar malyon-restore-quetzal-stack nil
  "A temporary stack for restoring quetzal game states.")

(defvar malyon-restore-quetzal-stack-pointer nil
  "A temporary stack pointer for restoring quetzal game states.")

(defvar malyon-restore-quetzal-frame-pointer nil
  "A temporary frame-pointer for restoring quetzal game states.")

(defun malyon-restore-file (file &optional table length)
  "Restore a game state or a memory section from disk."
  (interactive "fLoad file: ")
  (if (not (and (file-exists-p file) (file-readable-p file)))
      0
    (condition-case nil
        (save-excursion
          (setq malyon-restore-data-error nil)
          (set-buffer (create-file-buffer file))
          (malyon-load-file file)
          (goto-char (point-min))
          (if table
              (malyon-restore-table table length)
            (let* ((first  (malyon-read-chunk-id-from-file))
                   (second (malyon-read-dword-from-file))
                   (third  (malyon-read-chunk-id-from-file)))
              (if (and (string= "FORM" first) (string= "IFZS" third))
                  (malyon-restore-quetzal-state (+ 8 second))
                (goto-char (point-min))
                (malyon-restore-game-state))))
          (kill-buffer nil)
          (if (null malyon-restore-data-error)
              2
            (message malyon-restore-data-error)
            0))
      (error 0))))

(defun malyon-restore-table (table length)
  "Restore the given section of memory from a file."
  (let ((i 0)
        (j table))
    (while (< i length)
      (malyon-store-byte j (malyon-read-byte-from-file))
      (setq i (+ 1 i)
            j (+ 1 j)))))

(defun malyon-restore-game-state ()
  "Restore a saved game state from disk."
  (let ((len   0)
        (name  0)
        (story 0)
        (ip    0)
        (sp    0)
        (fp    0)
        (dyn   0)
        (stack (copy-sequence malyon-stack))
        (mem   (copy-sequence malyon-story-file))
        (i     0))
    (setq len (malyon-read-word-from-file))
    (setq name (make-string len ? ))
    (while (< i len)
      (aset name i (malyon-read-byte-from-file))
      (setq i (+ 1 i)))
    (setq ip  (malyon-read-dword-from-file))
    (setq sp  (malyon-read-word-from-file))
    (setq fp  (malyon-read-word-from-file))
    (setq dyn (malyon-read-word-from-file))
    (setq i 0)
    (while (<= i sp)
      (aset stack i (malyon-read-dword-from-file))
      (setq i (+ 1 i)))
    (setq i 0)
    (while (< i dyn)
      (aset mem i (malyon-read-byte-from-file))
      (setq i (+ 1 i)))
    (setq name  (file-name-nondirectory name))
    (setq story (file-name-nondirectory malyon-story-file-name))
    (if (or (string-match name story) (string-match story name))
        (malyon-set-game-state (vector ip sp fp stack mem nil))
      (setq malyon-restore-data-error "Invalid save file."))))

(defun malyon-restore-quetzal-state (size)
  "Restore a saved quetzal game state from disk."
  (let ((chunk-id  nil)
        (chunk-len 0)
        (ip        0)
        (memory    nil)
        (stack     nil)
        (beginning 0))
    (while (< (point) size)
      (setq chunk-id  (malyon-read-chunk-id-from-file))
      (setq chunk-len (malyon-read-dword-from-file))
      (setq beginning (point))
      (cond ((string= chunk-id "IFhd")
             (setq ip (malyon-restore-quetzal-ifhd chunk-len)))
            ((string= chunk-id "CMem")
             (setq memory (malyon-restore-quetzal-cmem chunk-len)))
            ((string= chunk-id "UMem")
             (setq memory (malyon-restore-quetzal-umem chunk-len)))
            ((string= chunk-id "Stks")
             (setq stack (malyon-restore-quetzal-stks chunk-len))))
      (if (zerop (mod chunk-len 2)) '() (setq chunk-len (+ 1 chunk-len)))
      (goto-char (+ beginning chunk-len)))
    (cond ((and ip memory stack)
           (malyon-set-game-state (vector ip
                                          (aref stack 0)
                                          (aref stack 1)
                                          (aref stack 2)
                                          memory
                                          t)))
          ((null malyon-restore-data-error)
           (setq malyon-restore-data-error "invalid quetzal file.")))))

(defun malyon-restore-quetzal-ifhd (size)
  "Restore an IFhd chunk from disk. Return the instruction pointer."
  (if (and (= (malyon-read-word-from-file) (malyon-read-word 2))
           (= (malyon-read-word-from-file) (malyon-read-word 18))
           (= (malyon-read-word-from-file) (malyon-read-word 20))
           (= (malyon-read-word-from-file) (malyon-read-word 22))
           (= (malyon-read-word-from-file) (malyon-read-word 28)))
      (logior (lsh (malyon-read-byte-from-file) 16)
              (lsh (malyon-read-byte-from-file) 8)
              (malyon-read-byte-from-file))
    (setq malyon-restore-data-error "quetzal file doesn't belong to game.")
    nil))

(defun malyon-restore-quetzal-cmem (size)
  "Restore a CMem chunk from disk. Return the entire memory layout."
  (let ((memory   (copy-sequence (aref malyon-game-state-restart 4)))
        (max-size (+ (point) size))
        (byte     0)
        (i        0))
    (while (< (point) max-size)
      (setq byte (malyon-read-byte-from-file))
      (if (zerop byte)
          (setq i (+ 1 i (malyon-read-byte-from-file)))
        (aset memory i (logxor byte (aref memory i)))
        (setq i (+ 1 i))))
    memory))

(defun malyon-restore-quetzal-umem (size)
  "Restore a UMem chunk from disk. Return the entire memory layout."
  (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
        (i      0))
    (while (< i size)
      (aset memory i (malyon-read-byte-from-file))
      (setq i (+ 1 i)))
    memory))

(defun malyon-restore-quetzal-stks (size)
  "Restore a Stks chunk from disk. Return a vector containing the
stack pointer, the frame pointer, and the stack itself."
  (let ((i 0) (frame-id 0))
    (setq malyon-restore-quetzal-stack
          (copy-sequence (aref malyon-game-state-restart 3)))
    (setq malyon-restore-quetzal-stack-pointer -1)
    (setq malyon-restore-quetzal-frame-pointer 2)
    (while (< i size)
      (let* ((beginning     (point))
             (return3       (malyon-read-byte-from-file))
             (return2       (malyon-read-byte-from-file))
             (return1       (malyon-read-byte-from-file))
             (return-addr   (logior (lsh return3 16) (lsh return2 8) return1))
             (result-locals (malyon-read-byte-from-file))
             (has-result    (zerop (logand 16 result-locals)))
             (num-locals    (logand 15 result-locals))
             (result-addr   (malyon-read-byte-from-file))
             (arg-flags     (+ 1 (malyon-read-byte-from-file)))
             (num-args      0)
             (eval-size     (malyon-read-word-from-file))
             (local-vars    '())
             (eval-stack    '()))
        (while (> num-locals 0)
          (setq local-vars (cons (malyon-read-word-from-file) local-vars))
          (setq num-locals (- num-locals 1)))
        (while (> eval-size 0)
          (setq eval-stack (cons (malyon-read-word-from-file) eval-stack))
          (setq eval-size (- eval-size 1)))
        (while (> arg-flags 1)
          (setq arg-flags (lsh arg-flags -1))
          (setq num-args (+ num-args 1)))
        (malyon-push-stack-frame frame-id
                                 return-addr
                                 (if (zerop frame-id)
                                     nil
                                   (if has-result result-addr nil))
                                 (reverse local-vars)
                                 num-args
                                 (reverse eval-stack))
        (setq frame-id (+ 1 frame-id))
        (setq i (+ i (- (point) beginning)))))
    (vector malyon-restore-quetzal-stack-pointer
            malyon-restore-quetzal-frame-pointer
            malyon-restore-quetzal-stack)))

;; object table management

(defsubst malyon-object-address (object)
  "Compute the address at which the object is stored."
  (+ malyon-object-table
     (* 2 malyon-object-properties)
     (* malyon-object-table-entry-size (- object 1))))

(defsubst malyon-object-read-parent (address)
  "Return the parent."
  (if (< malyon-story-version 5)
      (malyon-read-byte (+ 4 address))
    (malyon-read-word (+ 6 address))))

(defsubst malyon-object-read-sibling (address)
  "Return the next sibling."
  (if (< malyon-story-version 5)
      (malyon-read-byte (+ 5 address))
    (malyon-read-word (+ 8 address))))

(defsubst malyon-object-read-child (address)
  "Return the first child."
  (if (< malyon-story-version 5)
      (malyon-read-byte (+ 6 address))
    (malyon-read-word (+ 10 address))))

(defsubst malyon-object-store-parent (address value)
  "Set the parent."
  (if (< malyon-story-version 5)
      (malyon-store-byte (+ 4 address) value)
    (malyon-store-word (+ 6 address) value)))

(defsubst malyon-object-store-sibling (address value)
  "Set the next sibling."
  (if (< malyon-story-version 5)
      (malyon-store-byte (+ 5 address) value)
    (malyon-store-word (+ 8 address) value)))

(defsubst malyon-object-store-child (address value)
  "Set the first child."
  (if (< malyon-story-version 5)
      (malyon-store-byte (+ 6 address) value)
    (malyon-store-word (+ 10 address) value)))

(defun malyon-find-property (object property)
  "Return the address of the object's property, or 0 if it doesn't exist."
  (let ((next (malyon-first-property object))
        (number 0))
    (setq number (logand (malyon-read-byte next) malyon-object-properties))
    (while (> number property)
      (setq next (malyon-next-property next))
      (setq number (logand (malyon-read-byte next) malyon-object-properties)))
    (if (= number property) next 0)))

(defun malyon-first-property (object)
  "Get the address of the object's first property."
  (let ((header (malyon-read-word (+ malyon-object-property-offset
                                     (malyon-object-address object)))))
    (+ header 1 (* 2 (malyon-read-byte header)))))

(defun malyon-next-property (property)
  "Get the address of the following property."
  (let ((size (malyon-read-byte property))
        (addr (+ property 1)))
    (+ 1 addr (cond ((< malyon-story-version 5) (lsh size -5))
                    ((zerop (logand 128 size))  (lsh size -6))
                    (t
                     (let ((second (logand 63 (malyon-read-byte addr))))
                       (if (= 0 second) 64 second)))))))

(defun malyon-remove-object (object)
  "Remove the object from the children list of its parent."
  (let* ((address (malyon-object-address object))
         (parent  (malyon-object-read-parent address))
         (sibling (malyon-object-read-sibling address)))
    (malyon-object-store-parent address 0)
    (malyon-object-store-sibling address 0)
    (if (/= parent 0)
        (let ((parent-addr (malyon-object-address parent)))
          (let ((children (malyon-object-read-child parent-addr)))
            (if (or (= children 0) (= children object))
                (malyon-object-store-child parent-addr sibling)
              (let ((this (malyon-object-address children)))
                (let ((next (malyon-object-read-sibling this)))
                  (while (/= next object)
                    (setq this (malyon-object-address next))
                    (setq next (malyon-object-read-sibling this)))
                  (malyon-object-store-sibling this sibling)))))))))

;; function calls and code branches

(defun malyon-call-routine (routine arguments &optional result)
  "Call a routine with the given arguments and return its result."
  (if (= routine 0)
      (if result (malyon-store-variable result 0) 0)
    (malyon-push-stack (if result 0 1))
    (malyon-push-stack (if result result 0))
    (malyon-push-stack malyon-instruction-pointer)
    (malyon-push-stack
     (logior (lsh (- malyon-stack-pointer malyon-frame-pointer) 8)
             (length arguments)))
    (setq malyon-instruction-pointer (* malyon-packed-multiplier routine))
    (let ((args (malyon-read-code-byte)) (value nil))
      (if malyon-game-state-quetzal
          (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
            (malyon-push-stack (logior (lsh (+ 1 id) 8) args))))
      (setq malyon-frame-pointer malyon-stack-pointer)
      (while (> args 0)
        (setq value (if (< malyon-story-version 5) (malyon-read-code-word) 0))
        (malyon-push-stack (if (null arguments) value (car arguments)))
        (setq arguments (cdr arguments))
        (setq args (- args 1))))))

(defun malyon-jump-if (condition)
  "Jump depending on the condition and the following jump data."
  (let ((byte   (malyon-read-code-byte))
        (offset nil)
        (iftrue nil))
    (setq iftrue (/= 0 (logand byte 128)))
    (setq offset (logand byte 63))
    (if (= 0 (logand byte 64))
        (progn
          (setq offset (logior (lsh offset 8) (malyon-read-code-byte)))
          (if (>= offset 8192) (setq offset (- offset 16384)))))
    (if (or (and iftrue condition) (and (not iftrue) (not condition)))
        (progn
          (cond ((= offset 0) (malyon-opcode-rfalse))
                ((= offset 1) (malyon-opcode-rtrue))
                (t            (setq
                               malyon-instruction-pointer
                               (+ malyon-instruction-pointer offset -2))))))))

(defun malyon-return (value)
  "Return from a routine."
  (setq malyon-stack-pointer malyon-frame-pointer)
  (if malyon-game-state-quetzal (malyon-pop-stack))
  (setq malyon-frame-pointer
        (- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
  (setq malyon-instruction-pointer (malyon-pop-stack))
  (let ((result (malyon-pop-stack))
        (store  (malyon-pop-stack)))
    (if (zerop store)
        (malyon-return-store result value)
      (malyon-return-ignore result value))))

(defun malyon-return-ignore (where value)
  "Return from a routine ignoring the result.")

(defun malyon-return-store (where value)
  "Return from a routine storing the result."
  (malyon-store-variable where value))

(defun malyon-push-initial-frame ()
  "Push the initial stack frame required in quetzal mode."
  (if malyon-game-state-quetzal
      (progn
        (malyon-push-stack 1)
        (malyon-push-stack 0)
        (malyon-push-stack 0)
        (malyon-push-stack 0)
        (malyon-push-stack 0))))

(defun malyon-get-stack-frame (fp sp stack)
  "Return a decoded stack frame in quetzal mode.
The result is a vector containing the frame id, the fp of the
previous frame, the sp of the previous frame, the return address,
the result variable if any, a list of local variables, the number
of arguments, and a list of the evaluation stack elements."
  (let* ((has-result   (zerop (aref stack fp)))
         (result-addr  (if has-result (aref stack (+ 1 fp)) nil))
         (return-addr  (aref stack (+ 2 fp)))
         (offset       (lsh (aref stack (+ 3 fp)) -8))
         (num-args     (logand 255 (aref stack (+ 3 fp))))
         (frame-id     (lsh (aref stack (+ 4 fp)) -8))
         (num-locals   (logand 255 (aref stack (+ 4 fp))))
         (start-locals (+ 5 fp))
         (start-eval   (+ 5 fp num-locals))
         (local-vars   '())
         (eval-stack   '()))
    (if (not (zerop num-locals))
        (setq local-vars
              (malyon-vector-to-list stack start-locals start-eval)))
    (if (> sp start-eval)
        (setq eval-stack
              (malyon-vector-to-list stack start-eval (+ 1 sp))))
    (vector frame-id
            (- fp offset 2)
            (- fp 1)
            return-addr
            result-addr
            local-vars
            num-args
            eval-stack)))

(defsubst malyon-restore-quetzal-push-stack (value)
  "Push a value onto the restore quetzal stack."
  (setq malyon-restore-quetzal-stack-pointer
        (+ malyon-restore-quetzal-stack-pointer 1))
  (aset malyon-restore-quetzal-stack
        malyon-restore-quetzal-stack-pointer
        value))

(defun malyon-push-stack-frame
  (frame-id return-addr result local-vars num-args eval-stack)
  "Pushes a new stack frame in quetzal mode."
  (malyon-restore-quetzal-push-stack (if result 0 1))
  (malyon-restore-quetzal-push-stack (if result result 0))
  (malyon-restore-quetzal-push-stack return-addr)
  (malyon-restore-quetzal-push-stack
   (logior (lsh (- malyon-restore-quetzal-stack-pointer
                   malyon-restore-quetzal-frame-pointer) 8)
           num-args))
  (malyon-restore-quetzal-push-stack
   (logior (lsh frame-id 8) (length local-vars)))
  (setq malyon-restore-quetzal-frame-pointer
        malyon-restore-quetzal-stack-pointer)
  (while (not (null local-vars))
    (malyon-restore-quetzal-push-stack (car local-vars))
    (setq local-vars (cdr local-vars)))
  (while (not (null eval-stack))
    (malyon-restore-quetzal-push-stack (car eval-stack))
    (setq eval-stack (cdr eval-stack))))

;; other stuff

(defvar malyon-aread-text nil
  "Text buffer for user input.")

(defvar malyon-aread-parse nil
  "Parse buffer for user input.")

(defvar malyon-aread-beginning-of-line nil
  "The beginning of the input line.")

;; execution

(defun malyon-interpreter ()
  "Run the Z-code interpreter on the given story file."
  (malyon-hide-internal-errors "unspecified internal runtime error."
    (progn
      (malyon-restore-window-configuration)
      (if malyon-story-file
          (catch 'malyon-end-of-interpreter-loop
            (setq malyon-last-cursor-position-after-input
                  (malyon-point-max malyon-transcript-buffer))
            (malyon-execute))))))

(defsubst malyon-fetch-variable-operands (specifier)
  "Fetch a variable number of operands based on the specifier argument."
  (let ((var  (logand specifier 49152))
        (op   '()))
    (setq specifier (logand 65535 specifier))
    (while (/= 0 specifier)
      (cond ((= var 0)     (setq op (cons (malyon-read-code-word) op)))
            ((= var 16384) (setq op (cons (malyon-read-code-byte) op)))
            ((= var 32768) (setq op (cons (malyon-read-variable
                                           (malyon-read-code-byte)) op)))
            (t             (setq specifier 0)))
      (setq specifier (logand 65535 (lsh specifier 2)))
      (setq var  (logand specifier 49152)))
    (nreverse op)))

(defsubst malyon-fetch-extended (opcode)
  "Fetch operands for an extended instruction."
  (malyon-fetch-variable-operands
   (logior (lsh (malyon-read-code-byte) 8) 255)))

(defsubst malyon-fetch-variable (opcode)
  "Fetch operands for a variable instruction."
  (malyon-fetch-variable-operands
   (if (or (= opcode 236) (= opcode 250))
       (malyon-read-code-word)
     (logior (lsh (malyon-read-code-byte) 8) 255))))

(defsubst malyon-fetch-short (opcode)
  "Fetch operands for a short instruction."
  (let ((op (logand opcode 48)))
    (cond ((= op 0)  (list (malyon-read-code-word)))
          ((= op 16) (list (malyon-read-code-byte)))
          ((= op 32) (list (malyon-read-variable (malyon-read-code-byte)))))))

(defsubst malyon-fetch-long (instr)
  "Fetch operands for a long instruction."
  (let ((byte1 (malyon-read-code-byte))
        (byte2 (malyon-read-code-byte)))
    (list (if (= (logand instr 64) 0) byte1 (malyon-read-variable byte1))
          (if (= (logand instr 32) 0) byte2 (malyon-read-variable byte2)))))

(defun malyon-execute ()
  "Execute Z-code instructions.
Load the next instruction opcode and its operands and execute it.
Repeat ad infinitum."
  (let ((opcode) (operands)); (pc))
    (while t
;      (setq pc malyon-instruction-pointer)
      (setq opcode (malyon-read-code-byte))
      (setq operands (cond ((=  opcode 190)
                            (setq opcode (+ 256 (malyon-read-code-byte)))
                            (malyon-fetch-extended opcode))
                           ((>= opcode 192)
                            (malyon-fetch-variable opcode))
                           ((>= opcode 128)
                            (malyon-fetch-short opcode))
                           (t
                            (malyon-fetch-long opcode))))
;      (malyon-trace-opcode pc opcode operands)
      (apply (aref malyon-opcodes opcode) operands))))

;; opcodes

(defsubst malyon-number (n)
  "Convert an unsigned number into a signed one."
  (if (< n 32768) n (- n 65536)))

(defun malyon-opcode-add (a b)
  "Addition."
  (malyon-store-variable (malyon-read-code-byte)
                         (+ (malyon-number a) (malyon-number b))))

(defun malyon-opcode-and (a b)
  "Bitwise and."
  (malyon-store-variable (malyon-read-code-byte) (logand a b)))

(defun malyon-opcode-aread (text parse &optional time routine)
  "Read input text."
  (setq malyon-aread-text text)
  (setq malyon-aread-parse parse)
  (goto-char (point-max))
  (setq malyon-aread-beginning-of-line (point))
; Some games violate these assumptions for the "Quit" question.
;  (if (> 3 (malyon-read-byte text))
;      (malyon-fatal-error "text buffer less than 3 bytes."))
;  (if (and (not (zerop parse)) (> 2 (malyon-read-byte parse)))
;      (malyon-fatal-error "parse buffer less than 2 bytes."))
  (malyon-more malyon-keymap-read)
  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))

(defun malyon-opcode-art-shift (value places)
  "Arithmetic shift."
  (malyon-store-variable (malyon-read-code-byte) (ash value places)))

(defun malyon-opcode-buffer-mode (mode)
  "Toggles buffering of text in the transcript window."
  (setq malyon-transcript-buffer-buffered (/= 0 mode)))

(defun malyon-opcode-calln (routine &rest arguments)
  "Call a routine and ignore the result."
  (malyon-call-routine routine arguments))

(defun malyon-opcode-calls (routine &rest arguments)
  "Call a routine and store the result."
  (malyon-call-routine routine arguments (malyon-read-code-byte)))

(defun malyon-opcode-catch ()
  "Return the current stack frame."
  (malyon-store-variable
   (malyon-read-code-byte)
   (if malyon-game-state-quetzal
       (lsh (aref malyon-stack malyon-frame-pointer) -8)
     malyon-frame-pointer)))

(defun malyon-opcode-check-arg-count (count)
  "Tests the number of arguments passed to routine."
  (malyon-jump-if
   (<= count (logand 255 (aref malyon-stack
                               (if malyon-game-state-quetzal
                                   (- malyon-frame-pointer 1)
                                 malyon-frame-pointer))))))

(defun malyon-opcode-check-unicode (char)
  "Check whether the given character is valid for input/output."
  (malyon-store-variable (malyon-read-code-byte) 0))

(defun malyon-opcode-clear-attr (object attribute)
  "Clear the given attribute in the given object."
  (let ((attributes (malyon-object-address object))
        (byte       (lsh attribute -3)))
    (malyon-store-byte (+ attributes byte)
                       (logand (malyon-read-byte (+ attributes byte))
                               (logxor (lsh 128 (- (logand attribute 7)))
                                       255)))))

(defun malyon-opcode-copy-table (first second size)
  "Copies first table onto second one."
  (let* ((length  (abs (malyon-number size)))
         (zero    (zerop second))
         (forward (or (< (malyon-number size) 0) (> first second)))
         (i       0)
         (a       (if forward first (+ first length -1)))
         (b       (if forward (if zero first second) (+ second length -1))))
    (while (< i length)
      (malyon-store-byte b (if zero 0 (malyon-read-byte a)))
      (setq i (+ i 1)
            a (if forward (+ a 1) (- a 1))
            b (if forward (+ b 1) (- b 1))))))

(defun malyon-opcode-dec (var)
  "Decrement variable."
  (malyon-store-variable var
                         (- (malyon-number (malyon-read-variable var)) 1)))

(defun malyon-opcode-dec-chk (variable threshold)
  "Decrement variable and jump if it's less than the given value."
  (let ((value (malyon-number (malyon-read-variable variable))))
    (malyon-store-variable variable (- value 1))
    (malyon-jump-if (< (- value 1) (malyon-number threshold)))))

(defun malyon-opcode-div (a b)
  "Division."
  (if (zerop b) (malyon-fatal-error "division by 0."))
  (malyon-store-variable (malyon-read-code-byte)
                         (/ (malyon-number a) (malyon-number b))))

(defun malyon-opcode-encode-text (text length from encoded)
  "Encode the zscii text starting at from with the given length.
The result is stored at encoded."
  (let* ((i     length)
         (j     encoded)
         (l     '())
         (word  '()))
    (while (< 0 i)
      (setq l (cons (malyon-read-byte (+ text from i -1)) l)
            i (- i 1)))
    (setq word (malyon-encode-dictionary-word
		(append (cl-mapcan 'malyon-encode-into-ztext l)
			'(5 5 5 5 5 5 5 5))))
    (while (< i 6)
      (malyon-store-byte j (car l))
      (setq i (+ 1 i)
            j (+ 1 j)
            l (cdr word)))))

(defun malyon-opcode-erase-line (value)
  "Erases the rest of the line."
  (if (= value 1)
      (if (eq malyon-transcript-buffer (current-buffer))
          (kill-line nil)
        (save-excursion
          (let ((i (current-column)))
            (while (<= i malyon-max-column)
              (insert ? )
              (delete-char 1)
              (setq i (+ 1 i))))))))

(defun malyon-opcode-erase-window (window)
  "Erase the contents of the given window."
  (save-excursion
    (let ((w (malyon-number window)))
      (if (or (= w 0) (= w -1) (= w -2))
          (malyon-erase-buffer malyon-transcript-buffer))
      (if (or (= w 1) (= w -1) (= w -2))
          (malyon-erase-buffer malyon-status-buffer))
      (if (= w -1)
          (malyon-split-buffer-windows 0)))
    (setq malyon-last-cursor-position-after-input
          (malyon-point-max malyon-transcript-buffer))))

(defun malyon-opcode-get-child (object)
  "Get the first child of the given object and jump."
  (let ((child (malyon-object-read-child (malyon-object-address object))))
    (malyon-store-variable (malyon-read-code-byte) child)
    (malyon-jump-if (/= 0 child))))

(defun malyon-opcode-get-cursor (array)
  "Retrieves the current cursor position."
  (with-current-buffer malyon-status-buffer
    (malyon-store-word array (- (count-lines (point-min) (point)) 1))
    (malyon-store-word (+ 2 array) (+ 1 (current-column)))))

(defun malyon-opcode-get-next-prop (object property)
  "Retrieve the first or next property id of object."
  (let ((next (malyon-first-property object))
        (number 0))
    (if (zerop property)
        '()
      (setq number (logand (malyon-read-byte next)
                           malyon-object-properties))
      (setq next (malyon-next-property next))
      (while (> number property)
        (setq number (logand (malyon-read-byte next)
                             malyon-object-properties))
        (setq next (malyon-next-property next)))
      (if (/= number property)
          (malyon-fatal-error "property does not exist.")))
    (setq number (logand (malyon-read-byte next) malyon-object-properties))
    (malyon-store-variable (malyon-read-code-byte) number)))

(defun malyon-opcode-get-parent (object)
  "Get the parent of the given object."
  (malyon-store-variable (malyon-read-code-byte)
                         (malyon-object-read-parent
                          (malyon-object-address object))))

(defun malyon-opcode-get-prop (object property)
  "Get the value of the object's property."
  (let* ((address (malyon-find-property object property))
         (size    (malyon-read-byte address)))
    (malyon-store-variable
     (malyon-read-code-byte)
     (cond ((zerop address)
            (malyon-read-word (+ malyon-object-table (* 2 (- property 1)))))
           ((and (<  malyon-story-version 5) (zerop (lsh size -5)))
            (malyon-read-byte (+ address 1)))
           ((and (>= malyon-story-version 5) (zerop (logand 192 size)))
            (malyon-read-byte (+ address 1)))
           (t
            (malyon-read-word (+ address 1)))))))

(defun malyon-opcode-get-prop-addr (object property)
  "Get the address of the object's property."
  (let* ((address (malyon-find-property object property))
         (size    (malyon-read-byte address))
         (offset  (if (< malyon-story-version 5)
                      1
                    (if (zerop (logand 128 size)) 1 2))))
    (malyon-store-variable (malyon-read-code-byte)
                           (if (zerop address) 0 (+ address offset)))))

(defun malyon-opcode-get-prop-len (property)
  "Get the length of the object's property."
  (let ((size (malyon-read-byte (- property 1))))
    (malyon-store-variable
     (malyon-read-code-byte)
     (cond ((< malyon-story-version 5) (+ 1 (lsh size -5)))
           ((zerop (logand 128 size))  (+ 1 (lsh size -6)))
           ((zerop (logand  63 size))  64)
           (t                          (logand 63 size))))))

(defun malyon-opcode-get-sibling (object)
  "Get the next object in the tree and jump."
  (let ((sibling (malyon-object-read-sibling (malyon-object-address object))))
    (malyon-store-variable (malyon-read-code-byte) sibling)
    (malyon-jump-if (/= 0 sibling))))

(defun malyon-opcode-illegal (&rest ignore)
  "Print an error message and exit the interpreter."
  (malyon-fatal-error "illegal opcode."))

(defun malyon-opcode-inc (var)
  "Increment variable."
  (malyon-store-variable var
                         (+ (malyon-number (malyon-read-variable var)) 1)))

(defun malyon-opcode-inc-chk (variable threshold)
  "Increment variable and jump if it's greater than the given value."
  (let ((value (malyon-number (malyon-read-variable variable))))
    (malyon-store-variable variable (+ value 1))
    (malyon-jump-if (> (+ value 1) (malyon-number threshold)))))

(defun malyon-opcode-input-stream (number)
  "Select the given input stream. Only the keyboard is supported."
  (if (zerop (malyon-number number))
      '()
    (message "Only the keyboard is supported as an input stream.")))

(defun malyon-opcode-insert-obj (object destination)
  "Insert an object into the children list of another."
  (let ((child  (malyon-object-address object))
        (parent (malyon-object-address destination)))
    (malyon-remove-object object)
    (malyon-object-store-parent  child destination)
    (malyon-object-store-sibling child (malyon-object-read-child parent))
    (malyon-object-store-child   parent object)))

(defun malyon-opcode-je (a &rest rest)
  "Jump if first operand equals any of the following."
  (malyon-jump-if (member (malyon-number a) (mapcar 'malyon-number rest))))

(defun malyon-opcode-jg (a b)
  "Jump if first operand > second operand."
  (malyon-jump-if (> (malyon-number a) (malyon-number b))))

(defun malyon-opcode-jin (child parent)
  "Jump if second object is parent of the first one."
    (malyon-jump-if
     (= parent (malyon-object-read-parent (malyon-object-address child)))))

(defun malyon-opcode-jl (a b)
  "Jump if first operand < second operand."
  (malyon-jump-if (< (malyon-number a) (malyon-number b))))

(defun malyon-opcode-jump (offset)
  "Jump unconditionally."
  (setq malyon-instruction-pointer (+ malyon-instruction-pointer
                                      (malyon-number offset) -2)))

(defun malyon-opcode-jz (a)
  "Jump if operand = 0."
  (malyon-jump-if (zerop a)))

(defun malyon-opcode-load (variable)
  "Load a variable."
  (malyon-store-variable (malyon-read-code-byte)
                         (malyon-read-variable variable)))

(defun malyon-opcode-loadb (array index)
  "Load an array element into a variable."
  (malyon-store-variable (malyon-read-code-byte)
                         (malyon-read-byte (+ array index))))

(defun malyon-opcode-loadw (array index)
  "Load an array element into a variable."
  (malyon-store-variable (malyon-read-code-byte)
                         (malyon-read-word (+ array (* 2 index)))))

(defun malyon-opcode-log-shift (value places)
  "Logical shift."
  (malyon-store-variable (malyon-read-code-byte) (lsh value places)))

(defun malyon-opcode-mod (a b)
  "Modulo."
  (malyon-store-variable (malyon-read-code-byte)
                         (mod (malyon-number a) (malyon-number b))))

(defun malyon-opcode-mul (a b)
  "Multiplication."
  (malyon-store-variable (malyon-read-code-byte)
                         (* (malyon-number a) (malyon-number b))))

(defun malyon-opcode-new-line ()
  "Print a newline."
  (malyon-newline))

(defun malyon-opcode-nop (&rest ignore)
  "Do nothing.")

(defun malyon-opcode-not (a)
  "Bitwise not."
  (malyon-store-variable (malyon-read-code-byte) (logand 65535 (lognot a))))

(defun malyon-opcode-or (a b)
  "Bitwise or."
  (malyon-store-variable (malyon-read-code-byte) (logior a b)))

(defun malyon-opcode-output-stream (stream &optional table)
  "Select an output stream."
  (let ((stream (malyon-number stream)))
    (cond ((< 0 stream) (malyon-add-output-stream stream table))
          ((> 0 stream) (malyon-remove-output-stream (- stream))))))

(defun malyon-opcode-piracy ()
  "Piracy check, effectively an unconditional jump."
  (malyon-jump-if 1))

(defun malyon-opcode-pop ()
  "Pop a value off the stack."
  (malyon-pop-stack))

(defun malyon-opcode-print ()
  "Print a string."
  (setq malyon-instruction-pointer
        (malyon-print-text malyon-instruction-pointer)))

(defun malyon-opcode-print-addr (address)
  "Print a string."
  (malyon-print-text address))

(defun malyon-opcode-print-char (c)
  "Print a character."
  (malyon-print (char-to-string c)))

(defun malyon-opcode-print-num (n)
  "Print a number."
  (malyon-print (number-to-string (malyon-number n))))

(defun malyon-opcode-print-obj (obj)
  "Print the short name of the object."
  (malyon-print-text
   (+ 1 (malyon-read-word (+ malyon-object-property-offset
                             (malyon-object-address obj))))))

(defun malyon-opcode-print-paddr (address)
  "Print a string."
  (malyon-print-text (* malyon-packed-multiplier address)))

(defun malyon-opcode-print-ret ()
  "Print a string, print a newline, return true/1."
  (setq malyon-instruction-pointer
        (malyon-print-text malyon-instruction-pointer))
  (malyon-newline)
  (malyon-return 1))

(defun malyon-opcode-print-table (text width &optional height skip)
  "Print the given table."
  (if (not height) (setq height 1))
  (if (not skip)   (setq skip 0))
  (let ((column  (current-column))
        (address text)
        (y       0)
        (x       0))
    (while (< y height)
      (if (zerop y)
          '()
        (malyon-newline)
        (malyon-print-characters (make-string column ? )))
      (setq x 0)
      (while (< x width)
        (malyon-output-character (malyon-read-byte address))
        (setq address (+ 1 address))
        (setq x (+ 1 x)))
      (setq address (+ skip address))
      (setq y (+ 1 y)))))

(defun malyon-opcode-print-unicode (char)
  "Prints a unicode character.")

(defun malyon-opcode-pull (variable)
  "Pull value off stack."
  (malyon-store-variable variable (malyon-pop-stack)))

(defun malyon-opcode-push (value)
  "Push value onto stack."
  (malyon-push-stack value))

(defun malyon-opcode-put-prop (object property value)
  "Set the object's property to the given value."
  (let* ((address (malyon-find-property object property))
         (size    (malyon-read-byte address)))
    (cond ((= address 0)
           (malyon-fatal-error "property does not exist."))
          ((and (<  malyon-story-version 5) (zerop (lsh size -5)))
           (malyon-store-byte (+ 1 address) (logand 255 value)))
          ((and (>= malyon-story-version 5) (zerop (logand size 192)))
           (malyon-store-byte (+ 1 address) (logand 255 value)))
          (t
           (malyon-store-word (+ 1 address) value)))))

(defun malyon-opcode-quit ()
  "End the game immediately."
  (malyon-adjust-transcript)
  (malyon-cleanup)
  (throw 'malyon-end-of-interpreter-loop 'malyon-opcode-quit))

(defun malyon-opcode-random (limit)
  "Generate a random number or set the seed value."
  (malyon-store-variable (malyon-read-code-byte)
                         (if (>= 0 (malyon-number limit))
                             0
                           (+ 1 (random (malyon-number limit))))))

(defun malyon-opcode-read-char (&optional device &rest ignore)
  "Read a character."
  (if (and device (/= 1 device))
      (malyon-fatal-error "illegal device specified in read_char."))
  (if (eq malyon-transcript-buffer (current-buffer))
      (goto-char (point-max)))
  (message "[Press a key.]")
  (malyon-more malyon-keymap-readchar)
  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-character))

(defun malyon-opcode-remove-obj (object)
  "Remove an object from its parent's children list."
  (malyon-remove-object object))

(defun malyon-opcode-restart ()
  "Restart the game."
  (malyon-set-game-state malyon-game-state-restart))

(defun malyon-opcode-restore (&optional table bytes name)
  "Restore a saved game state or a section of memory from a file."
  (let ((result (if name
                    (malyon-restore-file
                     (malyon-get-file-name name) table bytes)
                  (call-interactively 'malyon-restore-file))))
    (if (< malyon-story-version 5)
        (malyon-jump-if (not (zerop result)))
      (malyon-store-variable (malyon-read-code-byte) result))))

(defun malyon-opcode-restore-undo ()
  "Restore game state for undo."
  (if malyon-game-state-undo
      (malyon-set-game-state malyon-game-state-undo))
  (malyon-store-variable (malyon-read-code-byte) 2))

(defun malyon-opcode-ret (value)
  "Return a value."
  (malyon-return value))

(defun malyon-opcode-ret-popped ()
  "Return top of stack."
  (malyon-return (malyon-pop-stack)))

(defun malyon-opcode-rfalse ()
  "Return false/0."
  (malyon-return 0))

(defun malyon-opcode-rtrue ()
  "Return true/1."
  (malyon-return 1))

(defun malyon-opcode-save (&optional table bytes name)
  "Save the current game state or a section of memory to a file."
  (let ((result (if name
                    (malyon-save-file (malyon-get-file-name name) table bytes)
                  (call-interactively 'malyon-save-file))))
    (if (< malyon-story-version 5)
        (malyon-jump-if (not (zerop result)))
      (malyon-store-variable (malyon-read-code-byte) result))))

(defun malyon-opcode-save-undo ()
  "Save game state for undo."
  (setq malyon-game-state-undo (malyon-current-game-state))
  (malyon-store-byte (malyon-read-code-byte) 1))

(defun malyon-opcode-scan-table (x table len &optional form)
  "Scan the given table for the first occurrence of x."
  (if (not form) (setq form 130))
  (let ((inc (logand 127 form))
        (byte (zerop (logand 128 form)))
        (addr table)
        (found 0)
        (index 0))
    (while (and (zerop found) (< index len))
      (setq found
            (if byte
                (if (= x (malyon-read-byte addr)) addr 0)
              (if (= x (malyon-read-word addr)) addr 0)))
      (setq addr (+ addr inc))
      (setq index (+ index 1)))
    (malyon-store-variable (malyon-read-code-byte) found)
    (malyon-jump-if (not (zerop found)))))

(defun malyon-opcode-set-attr (object attribute)
  "Set the given attribute in the given object."
  (let ((attributes (malyon-object-address object))
        (byte       (lsh attribute -3)))
    (malyon-store-byte (+ attributes byte)
                       (logior (malyon-read-byte (+ attributes byte))
                               (lsh 128 (- (logand attribute 7)))))))

(defun malyon-opcode-set-color (foreground background)
  "Sets the fore- and background colors ie. does nothing.")

(defun malyon-opcode-set-cursor (&optional line column)
  "Set the cursor."
  (if (eq malyon-transcript-buffer (current-buffer))
      ;; set-cursor is not currently supported in the transcript buffer.
      ;; It just jumps to the end.
      (goto-char (point-max))
    ;; We're setting the position in the status buffer
    (if malyon-status-buffer-delayed-split
        (progn
          (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
          (other-window 1)))
    (if line   '() (setq line   (count-lines (point-min) (point))))
    (if column '() (setq column (current-column)))
    (if (> line malyon-status-buffer-lines)
        (progn
          (malyon-split-buffer-windows line)
          (other-window 1)))
    (goto-char (point-min))
    (if (and (< 1 line) (<= line malyon-status-buffer-lines))
        (forward-line (1- line))
      (beginning-of-line))
    (if (and (< 1 column) (<= column malyon-max-column))
        (forward-char (1- column))
      (beginning-of-line))
    (setq malyon-status-buffer-point (point))))

(defun malyon-opcode-set-font (font)
  "Sets the font if available or 0 otherwise."
  (malyon-store-variable (malyon-read-code-byte) 0))

(defun malyon-opcode-set-text-style (style)
  "Set the text style/face."
  (let ((face (assq style malyon-faces)))
    (setq malyon-current-face (if face (cdr face) 'malyon-face-plain))))

(defun malyon-opcode-set-window (window)
  "Set the current window."
  (malyon-restore-window-configuration)
  (setq malyon-current-window window)
  (malyon-update-output-streams)
  (if (zerop window)
      (if (not (eq malyon-transcript-buffer (current-buffer)))
          (other-window 1))
    (if (not (eq malyon-status-buffer (current-buffer)))
        (other-window 1))
    (malyon-opcode-set-cursor 1 1)))

(defun malyon-opcode-show-status ()
  "Display the status line."
  (save-excursion
    (let ((malyon-current-face 'malyon-face-reverse))
      (malyon-opcode-split-window 1)
      (malyon-restore-window-configuration)
      (malyon-opcode-set-window 1)
      (malyon-prepare-status-buffer 1)
      (put-text-property (point-min) (point-max) 'face 'malyon-face-reverse)
      (malyon-opcode-set-cursor 1 1)
      (malyon-opcode-print-obj (malyon-read-global-variable 0))
      (if (<= (current-column) (- (current-fill-column) 10))
          (let* ((x     (malyon-read-global-variable 1))
                 (y     (malyon-read-global-variable 2))
                 (hours (if (> x 12) (- x 12) x))
                 (ampm  (if (> x 12) "PM" "AM"))
                 (score (format "%4d/%4d" x y))
                 (time  (format "%02d:%02d%s" hours y ampm)))
            (malyon-opcode-set-cursor 1 (- (current-fill-column) 10))
            (malyon-print (if malyon-score-game score time)))))
    (malyon-opcode-set-window 0)
    (malyon-adjust-transcript)))

(defun malyon-opcode-split-window (size)
  "Split upper and lower window."
  (malyon-set-window-configuration size))

(defun malyon-opcode-store (variable value)
  "Store a value in a variable."
  (malyon-store-variable variable value))

(defun malyon-opcode-storeb (array index value)
  "Store a value in an array at the given index."
  (malyon-store-byte (+ array index) value))

(defun malyon-opcode-storew (array index value)
  "Store a value in an array at the given index."
  (malyon-store-word (+ array (* 2 index)) value))

(defun malyon-opcode-sub (a b)
  "Subtraction."
  (malyon-store-variable (malyon-read-code-byte)
                         (- (malyon-number a) (malyon-number b))))

(defun malyon-opcode-test (bitmap flags)
  "Test if all of the flags are set in the bitmap."
  (malyon-jump-if (= flags (logand bitmap flags))))

(defun malyon-opcode-test-attr (object attribute)
  "Jump depending on the given attribute in the given object."
  (malyon-jump-if
   (/= 0 (logand (malyon-read-byte (+ (malyon-object-address object)
                                      (lsh attribute -3)))
                 (lsh 128 (- (logand attribute 7)))))))

(defun malyon-opcode-throw (value frame)
  "Return from the given stack frame."
  (if malyon-game-state-quetzal
      (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
        (while (/= frame id)
          (setq malyon-stack-pointer malyon-frame-pointer)
          (malyon-pop-stack)
          (setq malyon-frame-pointer
                (- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
          (malyon-pop-stack)
          (malyon-pop-stack)
          (setq id (lsh (aref malyon-stack malyon-frame-pointer) -8))))
    (setq malyon-frame-pointer frame))
  (malyon-return value))

(defun malyon-opcode-tokenise (text parse &optional dict flag)
  "Perform lexical analysis on the text buffer."
  (let* ((words (malyon-text-to-words text dict))
	 (word  (car           words))
	 (start (car           word))
	 (len   (cadr   word))
	 (code  (cl-caddr  word))
	 (entry (malyon-lookup dict code))
	 (i     0))
    (while (not (or (null words) (= i (malyon-read-byte parse))))
      (if (and (zerop entry) flag (/= 0 flag))
          '()
        (malyon-store-word (+ 2 parse (* 4 i)) entry)
        (malyon-store-byte (+ 4 parse (* 4 i)) len)
        (malyon-store-byte (+ 5 parse (* 4 i)) start))
      (setq words (cdr           words)
	    word  (car           words)
	    start (car           word)
	    len   (cadr   word)
	    code  (cl-caddr  word)
	    entry (malyon-lookup dict code)
	    i     (+ 1 i)))
    (malyon-store-byte (+ 1 parse) i)))

(defun malyon-opcode-verify ()
  "Verify the correctness of the story file."
  (let ((length (+ 1 (* malyon-packed-multiplier (malyon-read-word 26))))
        (sum    0)
        (i      64))
    (while (< i length)
      (setq sum (mod (+ sum (malyon-read-byte i)) 65536)
            i   (+ 1 i)))
    (malyon-jump-if (= (malyon-read-word 28) sum))))

;; keymap utilities

(defun malyon-end-input ()
  "Store the input line in a text buffer and perform lexical analysis."
  (interactive)
  (malyon-hide-internal-errors "unspecified internal runtime error."
    (progn
      (malyon-adjust-transcript)
      (switch-to-buffer malyon-transcript-buffer)
      (goto-char (point-max))
      (let* ((input (downcase
                     (buffer-substring-no-properties
                      (if (< malyon-aread-beginning-of-line (point))
                          malyon-aread-beginning-of-line
                        (point))
                      (point))))
             (vec  (string-to-vector input))
             (text (apply 'vector (mapcar 'malyon-unicode-to-zscii vec)))
             (len  (min (malyon-read-byte malyon-aread-text) (length text)))
             (i    0))
        (malyon-history-insert input)
        (if (>= malyon-story-version 5)
            (malyon-store-byte (+ malyon-aread-text 1) len))
        (while (< i len)
          (malyon-store-byte
           (+ malyon-aread-text (if (< malyon-story-version 5) 1 2) i)
           (malyon-char-to-int (aref text i)))
          (setq i (+ 1 i)))
        (if (< malyon-story-version 5)
            (malyon-store-byte (+ malyon-aread-text 1 len) 0)))
      (if (/= 0 malyon-aread-parse)
          (malyon-opcode-tokenise malyon-aread-text malyon-aread-parse))
      (newline)
      (if (>= malyon-story-version 5)
          (malyon-store-variable (malyon-read-code-byte) 10))
      (malyon-interpreter))))

(defun malyon-more-char ()
  "Page down in More mode."
  (interactive)
  (condition-case nil
      (scroll-up)
    (error))
  (if (>= (count-lines (point) (point-max))
          (malyon-window-displayed-height))
      (message "[More]")
    (goto-char (point-max))
    (malyon-adjust-transcript)
    (use-local-map malyon-more-continue-keymap)))

(defun malyon-more-char-status ()
  "Wait for a key then continue."
  (interactive)
  (malyon-hide-internal-errors "unspecified internal runtime error."
    (progn
      (malyon-adjust-transcript)
      (use-local-map malyon-more-continue-keymap)
      (malyon-interpreter))))

(defun malyon-wait-char ()
  "Store the input character in a variable and resume execution."
  (interactive)
  (malyon-hide-internal-errors "unspecified internal runtime error."
    (progn
      (malyon-store-variable
       (malyon-read-code-byte)
       (malyon-char-to-int (malyon-unicode-to-zscii last-command-event)))
      (use-local-map malyon-keymap-read)
      (malyon-interpreter))))

(defun malyon-history-previous-char (arg)
  "Display the previous item in the input history."
  (interactive "p")
  (let ((input (malyon-history-previous)))
    (cond ((> malyon-aread-beginning-of-line (point))
           (funcall malyon-history-saved-up arg))
          (input
           (with-current-buffer malyon-transcript-buffer
             (delete-region malyon-aread-beginning-of-line (point-max)))
           (goto-char (point-max))
           (insert input)
           (malyon-adjust-transcript)))))

(defun malyon-history-next-char (arg)
  "Display the next item in the input history."
  (interactive "p")
  (let ((input (malyon-history-next)))
    (cond ((> malyon-aread-beginning-of-line (point))
           (funcall malyon-history-saved-down arg))
          (input
           (with-current-buffer malyon-transcript-buffer
             (delete-region malyon-aread-beginning-of-line (point-max)))
           (goto-char (point-max))
           (insert input)
           (malyon-adjust-transcript)))))

(defun malyon-beginning-of-line (arg)
  "Go to the beginning of the line."
  (interactive "p")
  (if (> malyon-aread-beginning-of-line (point))
      (beginning-of-line)
    (goto-char malyon-aread-beginning-of-line)))

(defun malyon-kill-region (arg)
  "Kill region."
  (interactive "p")
  (if (<= malyon-aread-beginning-of-line (point))
      (kill-region (point) (mark))
    (message "Editing is restricted to the input prompt.")))

(defun malyon-kill-line (arg)
  "Kill rest of the current line."
  (interactive "p")
  (if (<= malyon-aread-beginning-of-line (point))
      (kill-line)
    (message "Editing is restricted to the input prompt.")))

(defun malyon-kill-word (arg)
  "Kill the current word."
  (interactive "p")
  (if (<= malyon-aread-beginning-of-line (point))
      (kill-word 1)
    (message "Editing is restricted to the input prompt.")))

(defun malyon-yank (arg)
  "Yank."
  (interactive "p")
  (if (<= malyon-aread-beginning-of-line (point))
      (yank)
    (message "Editing is restricted to the input prompt.")))

(defun malyon-yank-pop (arg)
  "Yank pop."
  (interactive "p")
  (if (<= malyon-aread-beginning-of-line (point))
      (yank-pop 1)
    (message "Editing is restricted to the input prompt.")))

(defun malyon-delete-char (arg)
  "Delete a character."
  (interactive "p")
  (if (<= malyon-aread-beginning-of-line (point))
      (delete-char 1)
    (message "Editing is restricted to the input prompt.")))

(defun malyon-backward-delete-char (arg)
  "Delete a character backwards."
  (interactive "p")
  (if (< malyon-aread-beginning-of-line (point))
      (backward-delete-char-untabify 1)
    (message "Editing is restricted to the input prompt.")))

(defun malyon-self-insert-command (arg)
  "Insert a character."
  (interactive "p")
  (if (> malyon-aread-beginning-of-line (point))
      (goto-char (point-max)))
  (self-insert-command 1))

;; tracing utility

(defun malyon-trace-file ()
  "Turn tracing on for a particular file."
  (let ((trace
         (get-buffer-create
          (concat "Malyon Trace " malyon-story-file-name))))
    (if trace
        (with-current-buffer trace
          (malyon-erase-buffer)
          (insert (concat "Tracing " malyon-story-file-name "..."))
          (newline)))))

(defun malyon-trace-newline ()
  "Output tracing newline."
  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
    (if trace
        (with-current-buffer trace
          (goto-char (point-max))
          (newline)))))

(defun malyon-trace-opcode (pc opcode operands)
  "Output a Z-code instruction."
  (malyon-trace-string
   (format "%8d   %-3d %-25s %s\n"
	   pc
	   opcode
	   (symbol-name (aref malyon-opcodes opcode))
	   (apply 'concat (cl-mapcan
			   (lambda (x)
			     (list " "
				   (number-to-string
				    (if (characterp x)
					(malyon-char-to-int x)
				      x))))
			   operands)))))

(defun malyon-trace-string (s)
  "Output tracing string."
  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
    (if (and trace s)
        (with-current-buffer trace
          (goto-char (point-max))
          (insert s)))))

(defun malyon-trace-object (o)
  "Output tracing object."
  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
    (if (and trace o)
        (with-current-buffer trace
          (goto-char (point-max))
          (prin1 o trace)))))

;;; announce malyon-mode

(provide 'malyon-mode)
(provide 'malyon)

;;; malyon.el ends here