summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2018-03-27 20:18:34 -0700
committerKaz Kylheku <kaz@kylheku.com>2018-03-27 20:18:34 -0700
commit4adb942347bfdcdebdfd29625a41846cc0bb9cf8 (patch)
treec3dcf3ee43bde18d88bcdce10b7d34909d5f32df
parent2ebb3a32d4afa367712f0291b2ca517cba711529 (diff)
downloadtxr-4adb942347bfdcdebdfd29625a41846cc0bb9cf8.tar.gz
txr-4adb942347bfdcdebdfd29625a41846cc0bb9cf8.tar.bz2
txr-4adb942347bfdcdebdfd29625a41846cc0bb9cf8.zip
compiler: implement prof special op.
* share/txr/stdlib/compiler.tl (compiler compile): Handle prof via comp-prof method. (comp-prof): New method.
-rw-r--r--share/txr/stdlib/compiler.tl10
1 files changed, 10 insertions, 0 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index f14ec329..fe9bfce8 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -200,6 +200,7 @@
(tree-case me.(comp-tree-case oreg env form))
(sys:lisp1-value me.(comp-lisp1-value oreg env form))
(dwim me.(comp-dwim oreg env form))
+ (prof me.(comp-prof oreg env form))
(defvarl me.(compile oreg env (expand-defvarl form)))
(defun me.(compile oreg env (expand-defun form)))
(defmacro me.(compile oreg env (expand-defmacro form)))
@@ -951,6 +952,15 @@
me.(compile oreg env
^(call ,*(mapcar (op list 'sys:lisp1-value) l1-exprs))))))
+(defmeth compiler comp-prof (me oreg env form)
+ (mac-param-bind form (op . forms) form
+ (let ((bfrag me.(comp-progn oreg env forms)))
+ (new (frag bfrag.oreg
+ ^((prof ,bfrag.oreg)
+ ,*bfrag.code
+ (end ,bfrag.oreg))
+ bfrag.fvars bfrag.ffuns)))))
+
(defun maybe-mov (to-reg from-reg)
(if (nequal to-reg from-reg)
^((mov ,to-reg ,from-reg))))