From f7e09d72c2ee6cfe4a839b24b52761a8135ffa91 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 27 Mar 2018 20:18:34 -0700 Subject: compiler: implement prof special op. * share/txr/stdlib/compiler.tl (compiler compile): Handle prof via comp-prof method. (comp-prof): New method. --- share/txr/stdlib/compiler.tl | 10 ++++++++++ 1 file changed, 10 insertions(+) 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)))) -- cgit v1.2.3