From b1e6b624739552c19cd4c3b033716360fda64e94 Mon Sep 17 00:00:00 2001 From: plugd Date: Thu, 18 Nov 2021 10:46:21 +0100 Subject: [PATCH] Added object removal/insertion operations. --- ez.el | 90 ++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 67 insertions(+), 23 deletions(-) diff --git a/ez.el b/ez.el index 8ebed7b..1efc2d6 100644 --- a/ez.el +++ b/ez.el @@ -120,21 +120,33 @@ (dotimes (i 31) (aset ez-property-defaults i (aref ez-memory (+ ez-objtab-addr (* 2 i)))))) -(defun ez-get-obj-addr (obj-id) - (+ ez-objtab-addr (* 2 31) (* 9 (- obj-id 1)))) +(defun ez-get-obj-addr (obj) + (+ ez-objtab-addr (* 2 31) (* 9 (- obj 1)))) -(defun ez-get-obj-parent (obj-id) - (let ((addr (ez-get-obj-addr obj-id))) +(defun ez-get-obj-parent (obj) + (let ((addr (ez-get-obj-addr obj))) (ez-mem-ref-byte (+ addr 4)))) -(defun ez-get-obj-sibling (obj-id) - (let ((addr (ez-get-obj-addr obj-id))) +(defun ez-set-obj-parent (obj new-parent) + (let ((addr (ez-get-obj-addr obj))) + (ez-mem-set-byte (+ addr 4) new-parent))) + +(defun ez-get-obj-sibling (obj) + (let ((addr (ez-get-obj-addr obj))) (ez-mem-ref-byte (+ addr 5)))) -(defun ez-get-obj-child (obj-id) - (let ((addr (ez-get-obj-addr obj-id))) +(defun ez-set-obj-sibling (obj new-sibling) + (let ((addr (ez-get-obj-addr obj))) + (ez-mem-set-byte (+ addr 5) new-sibling))) + +(defun ez-get-obj-child (obj) + (let ((addr (ez-get-obj-addr obj))) (ez-mem-ref-byte (+ addr 6)))) +(defun ez-set-obj-child (obj new-child) + (let ((addr (ez-get-obj-addr obj))) + (ez-mem-set-byte (+ addr 6) new-child))) + (defun ez-get-obj-plist-addr (obj-id) (let ((addr (ez-get-obj-addr obj-id))) (ez-mem-ref-word (+ addr 7)))) @@ -145,21 +157,6 @@ (ez-get-zstring (+ 1 (ez-get-obj-plist-addr obj-id))) nil))) -(defun ez-get-obj (obj-id) - (let ((addr (+ ez-objtab-addr - (* 2 31) - (* 9 (- obj-id 1))))) - (list - obj-id - (ez-mem-ref-byte (+ addr 4)) - (ez-mem-ref-byte (+ addr 5)) - (ez-mem-ref-byte (+ addr 6)) - (ez-mem-ref-word (+ addr 7)) - (let ((plist-addr (ez-mem-ref-word (+ addr 7)))) - (if (> (ez-mem-ref-byte plist-addr) 0) - (ez-get-zstring (+ 1 plist-addr)) - nil))))) - (defun ez-get-prop-default (prop) (ez-mem-ref-word (+ ez-objtab-addr (* 2 (+ 1 prop))))) @@ -222,6 +219,26 @@ (and (not current-set) (> val 0))) (ez-mem-set-byte byte-addr (logxor byte bit-mask))))) + +(defun ez-remove-obj (obj) + (let ((parent (ez-get-obj-parent obj)) + (sibling (ez-get-obj-sibling obj))) + (unless (= parent 0) + (let ((child (ez-get-obj-child parent))) + (if (= child obj) + (ez-set-obj-child parent sibling) + (while (not (= obj (ez-get-obj-sibling child))) + (setq child (ez-get-obj-sibling child))) + (ez-set-obj-sibling child (ez-get-obj-sibling obj)))) + (ez-set-obj-parent obj 0)) + (ez-set-obj-sibling obj 0))) + +(defun ez-insert-obj (obj new-parent) + (ez-remove-obj obj) + (unless (= new-parent 0) + (ez-set-obj-sibling obj (ez-get-obj-child new-parent)) + (ez-set-obj-child new-parent obj))) + ;; Z-strings (defvar ez-zstring-alphabets @@ -522,6 +539,10 @@ ((1op #x02) get_child ez-op-get-child) ((1op #x03) get_parent ez-op-get-parent) ((2op #x0A) test_attr ez-op-test-attr) + ((2op #x0B) set_attr ez-op-set-attr) + ((2op #x0C) clear_attr ez-op-clear-attr) + ((1op #x09) remove_obj ez-op-remove-obj) + ((2op #x0E) insert_obj ez-op-insert-obj) ((var #x03) put_prop ez-op-put-prop) ((0op #x02) print ez-op-print) ((0op #x0B) new_line ez-op-new-line) @@ -685,6 +706,18 @@ (ez-do-branch (= 1 (ez-get-obj-attr obj attr))) t)) +(defun ez-op-set-attr (operands operand-types) + (let ((obj (car operands)) + (attr (cadr operands))) + (ez-set-obj-attr obj attr 1)) + t) + +(defun ez-op-clear-attr (operands operand-types) + (let ((obj (car operands)) + (attr (cadr operands))) + (ez-set-obj-attr obj attr 0)) + t) + (defun ez-op-get-sibling (operands operand-types) (let ((sib (ez-get-obj-sibling (car operands)))) (ez-set-var (ez-read-pc-byte-and-inc) sib) @@ -703,6 +736,17 @@ (ez-do-branch (> parent 0)) t)) +(defun ez-op-remove-obj (operands operand-types) + (let ((obj (car operands))) + (ez-remove-obj obj)) + t) + +(defun ez-op-insert-obj (operands operand-types) + (let ((obj1 (car operands)) + (obj2 (cadr operands))) + (ez-insert-obj obj1 obj2)) + t) + (defun ez-op-put-prop (operands operand-types) (let* ((obj (car operands)) (prop (cadr operands)) -- 2.20.1