From: plugd <plugd@thelambdalab.xyz>
Date: Mon, 10 Apr 2023 08:16:39 +0000 (+0200)
Subject: Added trace and memory buffers.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=fcb66a431dd743fd06547505ab8476d7d961f853;p=ez.git

Added trace and memory buffers.
---

diff --git a/ez.el b/ez.el
index f96005a..65990b7 100644
--- a/ez.el
+++ b/ez.el
@@ -123,12 +123,12 @@
       (error "Invalid global variable %d" gvar))
   (let ((val
          (ez-mem-ref-word (+ (* 2 gvar) ez-globalvartab-addr))))
-    (message "\tRetrieved %x from global variable %x" val gvar)
+    (ez-debug-message "\tRetrieved %x from global variable %x" val gvar)
     val))
 
 (defun ez-set-global-var (gvar val)
   (ez-mem-set-word (+ (* 2 gvar) ez-globalvartab-addr) val)
-  (message "\tSet global variabl %x to %x" gvar val))
+  (ez-debug-message "\tSet global variabl %x to %x" gvar val))
 
 ;; Object tree
 
@@ -340,25 +340,25 @@
 
 (defun ez-routine-stack-push (val)
   (let ((frame (car ez-call-stack)))
-    (message "\tPushed %x to stack" val)
+    (ez-debug-message "\tPushed %x to stack" val)
     (setf (elt frame 1) (cons val (elt frame 1)))))
 
 (defun ez-routine-stack-pop ()
   (let* ((frame (car ez-call-stack))
          (rs-head (car (elt frame 1))))
     (setf (elt frame 1) (cdr (elt frame 1)))
-    (message "\tPopped %x from stack" rs-head)
+    (ez-debug-message "\tPopped %x from stack" rs-head)
     rs-head))
 
 (defun ez-get-local-var (lvar)
   (let* ((frame (car ez-call-stack))
          (val (aref (elt frame 2) (- lvar 1))))
-    (message "\tRetrieved value %x from local variable %x" val lvar)
+    (ez-debug-message "\tRetrieved value %x from local variable %x" val lvar)
     val))
 
 (defun ez-set-local-var (lvar val)
   (let ((frame (car ez-call-stack)))
-    (message "\tSet local variable %x to %x" lvar val)
+    (ez-debug-message "\tSet local variable %x to %x" lvar val)
     (aset (elt frame 2) (- lvar 1) val)))
 
 (defun ez-get-pc ()
@@ -469,7 +469,7 @@
         (error "Unsupported op PC:%x Optype:%s Opcode:%x Operands:%s Operand-types:%s"
                instr-pc optype opcode (ez-list-to-string-hex operands) operand-types))
       (let ((mnemonic (elt table-row 1)))
-        (message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s Operand-types:%s"
+        (ez-debug-message "PC:%x Optype:%s Opcode:%x Mnemonic:%s Operands:%s Operand-types:%s"
                  instr-pc optype opcode mnemonic
                  (ez-list-to-string-hex operands) operand-types))
       (funcall (elt table-row 2) operands operand-types))))
@@ -583,14 +583,14 @@
 
 (defun ez-op-ret (operands &optional operand-types)
   (let ((retval (car operands)))
-    (message "\tReturning value %x" retval)
+    (ez-debug-message "\tReturning value %x" retval)
     (ez-pop-call-stack-frame)
     (ez-set-var (ez-read-pc-byte-and-inc) retval))
   'run)
 
 (defun ez-op-ret-pulled (operands operand-types)
   (let ((retval (ez-routine-stack-pop)))
-    (message "\tReturning value %x" retval)
+    (ez-debug-message "\tReturning value %x" retval)
     (ez-op-ret (list retval)))
   'run)
 
@@ -878,8 +878,9 @@
 
 (defun ez-setup-buffer ()
   (with-current-buffer (get-buffer-create "*ez*")
+    (ez-mode)
     (let ((inhibit-read-only t))
-      (delete-region (point-min) (point-max)))
+      (erase-buffer))
     (setq-local scroll-conservatively 1)
     (if (markerp ez-input-marker)
         (set-marker ez-input-marker (point-max))
@@ -899,9 +900,41 @@
       (error "Z-machine not ready for input."))
   (let ((input-string (with-current-buffer "*ez*"
                         (buffer-substring ez-input-marker (point-max)))))
+    (delete-region ez-input-marker (point-max))
+    (ez-print (concat input-string "\n"))
+    (ez-debug-message "\tReceived string \"%s\"" input-string)
     (ez-op-read2 input-string)
     (ez-run)))
 
+;; Debugging info
+
+(defun ez-setup-debug-buffer ()
+  (with-current-buffer (get-buffer-create "*ez-debug-trace*")
+    (setq-local buffer-read-only t)
+    (let ((inhibit-read-only t))
+      (erase-buffer)
+      (insert "--- Trace Start ---\n\n"))))
+
+(defun ez-debug-message (&rest strings)
+  (with-current-buffer (get-buffer-create "*ez-debug-trace*")
+    (save-excursion
+      (goto-char (point-max))
+      (let ((inhibit-read-only t))
+        (insert (apply #'format-message strings) "\n")))))
+
+(defun ez-debug-memory ()
+  (interactive)
+  (with-current-buffer (get-buffer-create "*ez-debug-memory*")
+    (setq-local buffer-read-only t)
+    (let ((inhibit-read-only t)
+          (old-point (point)))
+      (hexl-mode-exit)
+      (erase-buffer)
+      (insert ez-memory)
+      (setq-local buffer-undo-list nil)
+      (hexl-mode)
+      (goto-char old-point))))
+
 ;; Mode
 
 (defvar ez-mode-map
@@ -920,16 +953,14 @@
   (if (get-buffer "*ez*")
       (switch-to-buffer "*ez*")
     (switch-to-buffer "*ez*")
-    (ez-mode)
     (ez-setup-buffer)
     (ez-load-and-run zfile))
   "Started EZ.")
 
 (defun ez-debug ()
   (interactive)
-  (switch-to-buffer "*ez*")
-  (ez-mode)
   (ez-setup-buffer)
+  (ez-setup-debug-buffer)
   (ez-load-and-run "zork1.z3"))
 
 ;;; ez.el ends here