diff --git a/harness/memory.org b/harness/memory.org index ab385a9..2cd2db1 100644 --- a/harness/memory.org +++ b/harness/memory.org @@ -128,7 +128,12 @@ Because objects are stored immutably in the `*history-store*`, a snapshot is a l (defun snapshot-memory () "Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers." - (let ((snapshot (copy-hash-table *memory*))) + ;; To prevent live modification of objects from affecting snapshots, + ;; we must copy the objects themselves when creating the snapshot. + (let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*)))) + (maphash (lambda (k v) + (setf (gethash k snapshot) (copy-org-object v))) + *memory*) (push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*) (when (> (length *object-store-snapshots*) 20) (setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20))) diff --git a/harness/tui-client.org b/harness/tui-client.org index e777154..4964260 100644 --- a/harness/tui-client.org +++ b/harness/tui-client.org @@ -129,17 +129,17 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU (defun enqueue-msg (msg) "Thread-safe addition to incoming message queue." (bt:with-lock-held (*queue-lock*) - (push msg *incoming-msgs*))) -#+end_src + (setf *incoming-msgs* (append *incoming-msgs* (list msg))))) #+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness")) (defun dequeue-msgs () "Thread-safe retrieval of incoming messages." (bt:with-lock-held (*queue-lock*) - (let ((msgs (nreverse *incoming-msgs*))) + (let ((msgs *incoming-msgs*)) (setf *incoming-msgs* nil) msgs))) #+end_src +#+end_src ** Styling Engine #+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness")) @@ -193,7 +193,7 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU :PAYLOAD (list :SENSOR :user-input :TEXT cmd)))) (finish-output stream)) (error (c) - (push "ERROR: Connection to daemon lost." *chat-history*) + (enqueue-msg "ERROR: Connection to daemon lost.") (setf *is-running* nil)))) (when (string= cmd "/exit") (setf *is-running* nil)) (when (string= cmd "/clear") (setf *chat-history* nil))))