diff options
-rw-r--r-- | share/txr/stdlib/asm.tl | 42 | ||||
-rw-r--r-- | share/txr/stdlib/compiler.tl | 35 | ||||
-rw-r--r-- | share/txr/stdlib/path-test.tl | 7 |
3 files changed, 44 insertions, 40 deletions
diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index 5f7bbb02..06a6b258 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -265,12 +265,13 @@ (ix (int-str [str -3..:] 16))) (+ (* %lev-size% (ssucc lv)) ix))))) -(defmacro with-lev-idx ((lev-var idx-var) val-expr . body) - (with-gensyms (val-var) - ^(let* ((,val-var ,val-expr) - (,lev-var (ash ,val-var (macro-time (- %lev-bits%)))) - (,idx-var (logtrunc ,val-var %lev-bits%))) - ,*body))) +(eval-only + (defmacro with-lev-idx ((lev-var idx-var) val-expr . body) + (with-gensyms (val-var) + ^(let* ((,val-var ,val-expr) + (,lev-var (ash ,val-var (macro-time (- %lev-bits%)))) + (,idx-var (logtrunc ,val-var %lev-bits%))) + ,*body)))) (defun operand-to-sym (val) (with-lev-idx (lv ix) val @@ -327,20 +328,21 @@ (defvarl %backpatch-low16% (new backpatch-low16)) (defvarl %backpatch-high16% (new backpatch-high16)) -(defmacro defopcode (class symbol code . slot-defs) - ^(symacrolet ((auto (pinc %oc-code%))) - (defstruct ,class oc-base - (:static symbol ',symbol) - (:static code ,code) - ,*slot-defs) - (register-opcode (new ,class)))) - -(defmacro defopcode-derived (class symbol code orig-class) - ^(symacrolet ((auto (pinc %oc-code%))) - (defstruct ,class ,orig-class - (:static symbol ',symbol) - (:static code ,code)) - (register-opcode (new ,class)))) +(eval-only + (defmacro defopcode (class symbol code . slot-defs) + ^(symacrolet ((auto (pinc %oc-code%))) + (defstruct ,class oc-base + (:static symbol ',symbol) + (:static code ,code) + ,*slot-defs) + (register-opcode (new ,class)))) + + (defmacro defopcode-derived (class symbol code orig-class) + ^(symacrolet ((auto (pinc %oc-code%))) + (defstruct ,class ,orig-class + (:static symbol ',symbol) + (:static code ,code)) + (register-opcode (new ,class))))) (defopcode op-label label nil (:method asm (me asm syntax) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 2ddfeac5..ca5254d5 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -151,23 +151,24 @@ lt-frags last-form)) -(defmacro compile-in-toplevel (comp . body) - (with-gensyms (comp-var saved-tregs saved-treg-cntr saved-nlev) - ^(let* ((,comp-var ,comp) - (,saved-tregs (qref ,comp-var tregs)) - (,saved-treg-cntr (qref ,comp-var treg-cntr)) - (,saved-nlev (qref ,comp-var nlev))) - (unwind-protect - (progn - (set (qref ,comp-var tregs) nil - (qref ,comp-var treg-cntr) 2 - (qref ,comp-var nlev) 2) - (prog1 - (progn ,*body) - (qref ,comp-var (check-treg-leak)))) - (set (qref ,comp-var tregs) ,saved-tregs - (qref ,comp-var treg-cntr) ,saved-treg-cntr - (qref ,comp-var nlev) ,saved-nlev))))) +(eval-only + (defmacro compile-in-toplevel (comp . body) + (with-gensyms (comp-var saved-tregs saved-treg-cntr saved-nlev) + ^(let* ((,comp-var ,comp) + (,saved-tregs (qref ,comp-var tregs)) + (,saved-treg-cntr (qref ,comp-var treg-cntr)) + (,saved-nlev (qref ,comp-var nlev))) + (unwind-protect + (progn + (set (qref ,comp-var tregs) nil + (qref ,comp-var treg-cntr) 2 + (qref ,comp-var nlev) 2) + (prog1 + (progn ,*body) + (qref ,comp-var (check-treg-leak)))) + (set (qref ,comp-var tregs) ,saved-tregs + (qref ,comp-var treg-cntr) ,saved-treg-cntr + (qref ,comp-var nlev) ,saved-nlev)))))) (defvarl %gcall-op% (relate '(apply usr:apply call) '(gapply gapply gcall))) diff --git a/share/txr/stdlib/path-test.tl b/share/txr/stdlib/path-test.tl index 3a7146a8..59b24b13 100644 --- a/share/txr/stdlib/path-test.tl +++ b/share/txr/stdlib/path-test.tl @@ -27,9 +27,10 @@ (defun sys:do-path-test (statfun path testfun) [testfun (if (stringp path) (ignerr [statfun path]) path)]) -(defmacro sys:path-test ((sym statfun path) . body) - ^[sys:do-path-test ,statfun ,path - (lambda (,sym) (when ,sym ,*body))]) +(eval-only + (defmacro sys:path-test ((sym statfun path) . body) + ^[sys:do-path-test ,statfun ,path + (lambda (,sym) (when ,sym ,*body))])) (defun sys:path-test-mode (statfun path mask) (sys:path-test (s statfun path) |