[movitz-cvs] CVS update: movitz/losp/muerte/environment.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv7716

Modified Files:
	environment.lisp 
Log Message:
Changed read-time-stamp-counter to return two 29-bit fixnums, which
seems more useful for most cases, even if the upper 6 bits are lost.

Date: Fri Apr 23 09:00:24 2004
Author: ffjeld

Index: movitz/losp/muerte/environment.lisp
diff -u movitz/losp/muerte/environment.lisp:1.5 movitz/losp/muerte/environment.lisp:1.6
--- movitz/losp/muerte/environment.lisp:1.5	Thu Mar 25 20:35:29 2004
+++ movitz/losp/muerte/environment.lisp	Fri Apr 23 09:00:24 2004
@@ -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.5 2004/03/26 01:35:29 ffjeld Exp $
+;;;; $Id: environment.lisp,v 1.6 2004/04/23 13:00:24 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -120,28 +120,42 @@
 	(delete name *trace-map* :key 'car))))
   (values))
 
+(defun time-skew-measure (mem x-lo x-hi)
+  (declare (ignore mem))
+  (multiple-value-bind (y-lo y-hi)
+      (read-time-stamp-counter)
+    (assert (<= x-hi y-hi))
+    (- y-lo x-lo (if (< y-lo x-lo) most-negative-fixnum 0))))
+
+(defun report-time (start-mem start-time-lo start-time-hi)
+  (multiple-value-bind (end-time-lo end-time-hi)
+      (read-time-stamp-counter)
+    (let* ((skew (or (get 'report-time 'skew)
+		     (setf (get 'report-time 'skew)
+		       (multiple-value-bind (x-lo x-hi)
+			   (read-time-stamp-counter)
+			 (time-skew-measure start-mem x-lo x-hi)))))
+	   (clumps (- (malloc-cons-pointer) start-mem))
+	   (delta-hi (- end-time-hi start-time-hi))
+	   (delta-lo (- end-time-lo start-time-lo skew)))
+      (if (= 0 delta-hi)
+	  (format t "~&;; CPU cycles: ~D.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%"
+		  delta-lo clumps clumps)
+	(format t "~&;; CPU cycles: ~DM.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%"
+		(+ (ash delta-hi 9) (ash delta-lo -20)) clumps clumps)))))
+
 (defmacro time (form)
   `(let ((start-mem (malloc-cons-pointer)))
      (multiple-value-bind (start-time-lo start-time-hi)
 	 (read-time-stamp-counter)
        (multiple-value-prog1
 	   ,form
-	 (multiple-value-bind (end-time-lo end-time-hi)
-	     (read-time-stamp-counter)
-	   (let ((clumps (- (malloc-cons-pointer) start-mem))
-		 (delta-hi (- end-time-hi start-time-hi))
-		 (delta-lo (- end-time-lo start-time-lo)))
-	     (if (< delta-hi #x1f)
-		 (format t "~&;; CPU cycles: ~D.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%"
-			 (+ (ash delta-hi 24) delta-lo) clumps clumps)
-	       (format t "~&;; CPU cycles: ~D000.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%"
-		       (+ (ash delta-hi 14) (ash delta-lo -10)) clumps clumps))))))))
+	 (report-time start-mem start-time-lo start-time-hi)))))
 
 (defun describe (object &optional stream)
   (describe-object object (output-stream-designator stream))
   (values))
   
-
 (defmethod describe-object (object stream)
   (format stream "Don't know how to describe ~S." object))