[movitz-cvs] CVS movitz/losp/muerte

ffjeld ffjeld at common-lisp.net
Sun Apr 27 19:40:25 UTC 2008


Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv3529

Modified Files:
	environment.lisp 
Log Message:
Trace and untrace macros.


--- /project/movitz/cvsroot/movitz/losp/muerte/environment.lisp	2008/04/21 19:39:24	1.17
+++ /project/movitz/cvsroot/movitz/losp/muerte/environment.lisp	2008/04/27 19:40:25	1.18
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sat Oct 20 00:41:57 2001
 ;;;;                
-;;;; $Id: environment.lisp,v 1.17 2008/04/21 19:39:24 ffjeld Exp $
+;;;; $Id: environment.lisp,v 1.18 2008/04/27 19:40:25 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -108,6 +108,15 @@
 	wrapper)))
   (values))
 
+(defmacro trace (&rest names)
+  (if (null names)
+      `(mapcar #'car *trace-map*)
+      `(progn
+	 ,@(mapcar (lambda (name)
+		     `(do-trace ',name))
+		   names)
+	 (values))))
+
 (defun do-untrace (name)
   (let ((map (assoc name *trace-map*)))
     (assert map () "~S is not traced." name)
@@ -119,6 +128,16 @@
 	(delete name *trace-map* :key 'car))))
   (values))
 
+(defmacro untrace (&rest names)
+  (if (null names)
+      '(do () ((null muerte::*trace-map*))
+	(do-untrace (caar muerte::*trace-map*)))
+      `(progn
+	 ,@(mapcar (lambda (name)
+		     `(do-untrace ',name))
+		   names)
+	 (values))))
+
 (defun time-skew-measure (mem x-lo x-hi)
   (declare (ignore mem))
   (multiple-value-bind (y-lo y-hi)




More information about the Movitz-cvs mailing list