From: plugd Date: Fri, 19 Nov 2021 14:00:45 +0000 (+0100) Subject: Added missing edge case to call_fv implementation. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=ez.git;a=commitdiff_plain;h=a316c1617cb4f41efc85cda74e749286ca22169a Added missing edge case to call_fv implementation. --- diff --git a/ez.el b/ez.el index 3948f4c..9dcfdee 100644 --- a/ez.el +++ b/ez.el @@ -114,10 +114,14 @@ (defun ez-get-global-var (gvar) (if (> gvar 239) (error "Invalid global variable %d" gvar)) - (ez-mem-ref-word (+ (* 2 gvar) ez-globalvartab-addr))) + (let ((val + (ez-mem-ref-word (+ (* 2 gvar) ez-globalvartab-addr)))) + (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)) + (ez-mem-set-word (+ (* 2 gvar) ez-globalvartab-addr) val) + (message "\tSet global variabl %x to %x" gvar val)) ;; Object tree @@ -330,20 +334,25 @@ (defun ez-routine-stack-push (val) (let ((frame (car ez-call-stack))) + (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) rs-head)) (defun ez-get-local-var (lvar) - (let ((frame (car ez-call-stack))) - (aref (elt frame 2) (- lvar 1)))) + (let* ((frame (car ez-call-stack)) + (val (aref (elt frame 2) (- lvar 1)))) + (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) (aset (elt frame 2) (- lvar 1) val))) (defun ez-get-pc () @@ -379,13 +388,10 @@ (defun ez-set-var (var val) (cond ((= var 0) - (message "Pushed %x to stack" val) (ez-routine-stack-push val)) ((< var 16) - (message "Saved %x to local variable %x" val var) (ez-set-local-var var val)) (t - (message "Saved %x to global variable %x" val (- var 16)) (ez-set-global-var (- var 16) val)))) (defun ez-read-pc-var-and-inc () @@ -548,7 +554,7 @@ ((2op #x16) mul ez-op-mul) ((2op #x17) div ez-op-div) ((2op #x18) mod ez-op-mod) - ((var #x00) call_fv ez-op-callf) + ((var #x00) call_fv ez-op-callfv) ((1op #x01) get_sibling ez-op-get-sibling) ((1op #x02) get_child ez-op-get-child) ((1op #x03) get_parent ez-op-get-parent) @@ -567,6 +573,7 @@ (defun ez-op-ret (operands &optional operand-types) (let ((retval (car operands))) + (message "\tReturning value %x" retval) (ez-pop-call-stack-frame) (ez-set-var (ez-read-pc-byte-and-inc) retval)) t) @@ -708,18 +715,20 @@ (defun ez-op-mod (a b) (error "Not implemented")) -(defun ez-op-callf (operands operand-types) +(defun ez-op-callfv (operands operand-types) (let* ((raddr (car operands)) (call-operands (cdr operands)) (r (* 2 raddr)) (L (ez-mem-ref-byte r)) (n (length call-operands)) (new-pc (+ r 1 (* L 2)))) - (ez-add-call-stack-frame new-pc) - (dotimes (i L) - (if (< i n) - (ez-set-local-var (+ i 1) (elt call-operands i)) - (ez-set-local-var (+ i 1) (ez-mem-ref-word (+ r 1 (* 2 i))))))) + (if (= raddr 0) + (ez-set-var (ez-read-pc-byte-and-inc) 0) ; Simply return 0 + (ez-add-call-stack-frame new-pc) + (dotimes (i L) + (if (< i n) + (ez-set-local-var (+ i 1) (elt call-operands i)) + (ez-set-local-var (+ i 1) (ez-mem-ref-word (+ r 1 (* 2 i)))))))) t) (defun ez-op-test-attr (operands operand-types)