The Lambda Lab
/
projects
/
ez.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
984f78a
)
Added missing edge case to call_fv implementation.
author
plugd
<plugd@thelambdalab.xyz>
Fri, 19 Nov 2021 14:00:45 +0000
(15:00 +0100)
committer
plugd
<plugd@thelambdalab.xyz>
Fri, 19 Nov 2021 14:00:45 +0000
(15:00 +0100)
ez.el
patch
|
blob
|
history
diff --git
a/ez.el
b/ez.el
index
3948f4c
..
9dcfdee
100644
(file)
--- 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))
(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)
(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
;; Object tree
@@
-330,20
+334,25
@@
(defun ez-routine-stack-push (val)
(let ((frame (car ez-call-stack)))
(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)))
(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)
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)))
(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 ()
(aset (elt frame 2) (- lvar 1) val)))
(defun ez-get-pc ()
@@
-379,13
+388,10
@@
(defun ez-set-var (var val)
(cond
((= var 0)
(defun ez-set-var (var val)
(cond
((= var 0)
- (message "Pushed %x to stack" val)
(ez-routine-stack-push val))
((< var 16)
(ez-routine-stack-push val))
((< var 16)
- (message "Saved %x to local variable %x" val var)
(ez-set-local-var var val))
(t
(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 ()
(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)
((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-callf
v
)
((1op #x01) get_sibling ez-op-get-sibling)
((1op #x02) get_child ez-op-get-child)
((1op #x03) get_parent ez-op-get-parent)
((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)))
(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)
(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-mod (a b)
(error "Not implemented"))
-(defun ez-op-callf (operands operand-types)
+(defun ez-op-callf
v
(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))))
(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)
t)
(defun ez-op-test-attr (operands operand-types)