diff options
| -rw-r--r-- | share/txr/stdlib/asm.tl | 19 | ||||
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 4 |
2 files changed, 19 insertions, 4 deletions
diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index eafc322d..ed7ae1a0 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -285,6 +285,15 @@ (1 (intern (fmt "d~,02X" ix))) (t (intern (fmt "v~,02X~,03X" (ssucc lv) ix)))))) +(defun operand-to-exp (val) + (with-lev-idx (lv ix) val + (caseql lv + (0 (if (zerop ix) + nil + ^(t ,ix))) + (1 ^(d ,ix)) + (t ^(v ,lv ,ix))))) + (defun bits-to-obj (bits width) (let ((tag (logtrunc bits 2)) (val (ash bits -2))) @@ -676,7 +685,10 @@ (defopcode op-getv getv auto (:method asm (me asm syntax) me.(chk-arg-count 2 syntax) - (tree-bind (reg name) asm.(parse-args me syntax '(d rs)) + (tree-bind (reg name) asm.(parse-args me syntax '(d r)) + (unless (small-op-p name) + asm.(asm-one ^(mov (t 1) ,(operand-to-exp name))) + (set name 1)) asm.(put-insn me.code (enc-small-op name) reg))) (:method dis (me asm name reg) ^(,me.symbol ,(operand-to-sym reg) ,(small-op-to-sym name)))) @@ -694,7 +706,10 @@ (defopcode op-setv setv auto (:method asm (me asm syntax) me.(chk-arg-count 2 syntax) - (tree-bind (reg name) asm.(parse-args me syntax '(r rs)) + (tree-bind (reg name) asm.(parse-args me syntax '(r r)) + (unless (small-op-p name) + asm.(asm-one ^(mov (t 1) ,(operand-to-exp name))) + (set name 1)) asm.(put-insn me.code (enc-small-op name) reg))) (:method dis (me asm name reg) ^(,me.symbol ,(operand-to-sym reg) ,(small-op-to-sym name)))) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 0571e10c..f649b8e9 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -107,7 +107,7 @@ (compile-only (defstruct compiler nil - (treg-cntr 1) + (treg-cntr 2) (dreg-cntr 0) (fidx-cntr 0) (nlev 2) @@ -215,7 +215,7 @@ me.(free-treg treg))) (defmeth compiler check-treg-leak (me) - (let ((balance (- (pred me.treg-cntr) (len me.tregs)))) + (let ((balance (- (ppred me.treg-cntr) (len me.tregs)))) (unless (zerop balance) (error "t-register leak in compiler: ~s outstanding" balance)))) |