From 8d75583bb9d07f2103e49aa5795c1e9604b76a55 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Tue, 25 Sep 2012 21:19:05 -0700
Subject: [PATCH] Add WITH-CYCLE-COUNTER for x86, sparc, and ppc.  Sparc and
 ppc versions are untested.

---
 src/compiler/ppc/system.lisp     | 19 +++++++++++++++++++
 src/compiler/sparc/system.lisp   | 18 ++++++++++++++++++
 src/compiler/x86/system.lisp     | 20 +++++++++++++++++++-
 src/general-info/release-20d.txt |  2 ++
 4 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp
index c3fe76a79..edeed9a7d 100644
--- a/src/compiler/ppc/system.lisp
+++ b/src/compiler/ppc/system.lisp
@@ -275,3 +275,22 @@
 
 (defun read-cycle-counter ()
   (read-time-base))
+
+(defmacro with-cycle-counter (&body body)
+  "Returns the primary value of BODY as the primary value, and the
+ number of tick cycles elapsed as secondary value.  To get the number
+ of cycles, multiply by *cycles-per-tick*"
+  (let ((hi0 (gensym))
+	(hi1 (gensym))
+	(lo0 (gensym))
+	(lo1 (gensym)))
+    `(multiple-value-bind (,lo0 ,hi0)
+	 (read-cycle-counter)
+       (values (locally ,@body)
+               (multiple-value-bind (,lo1 ,hi1)
+		   (read-cycle-counter)
+		 ;; Can't do anything about the notes about generic
+		 ;; arithmetic, so silence the notes..
+		 (declare (optimize (inhibit-warnings 3))
+                 (+ (ash (- ,hi1 ,hi0) 32)
+                    (- ,lo1 ,lo0)))))))
diff --git a/src/compiler/sparc/system.lisp b/src/compiler/sparc/system.lisp
index f4f99f94e..2ba0b34fc 100644
--- a/src/compiler/sparc/system.lisp
+++ b/src/compiler/sparc/system.lisp
@@ -284,3 +284,21 @@
 64-bit counter is returned as two 32-bit unsigned integers.  The low 32-bit
 result is the first value."
   (read-cycle-counter))
+
+(defmacro with-cycle-counter (&body body)
+  "Returns the primary value of BODY as the primary value, and the
+ number of CPU cycles elapsed as secondary value."
+  (let ((hi0 (gensym))
+	(hi1 (gensym))
+	(lo0 (gensym))
+	(lo1 (gensym)))
+    `(multiple-value-bind (,lo0 ,hi0)
+	 (read-cycle-counter)
+       (values (locally ,@body)
+               (multiple-value-bind (,lo1 ,hi1)
+		   (read-cycle-counter)
+		 ;; Can't do anything about the notes about generic
+		 ;; arithmetic, so silence the notes..
+		 (declare (optimize (inhibit-warnings 3))
+                 (+ (ash (- ,hi1 ,hi0) 32)
+                    (- ,lo1 ,lo0)))))))
diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp
index bb323326e..9207b5b02 100644
--- a/src/compiler/x86/system.lisp
+++ b/src/compiler/x86/system.lisp
@@ -562,7 +562,7 @@
     (inst ret)))
 
 
-;; the RDTSC instruction (present on Pentium processors and
+;; The RDTSC instruction (present on Pentium processors and
 ;; successors) allows you to access the time-stamp counter, a 64-bit
 ;; model-specific register that counts executed cycles. The
 ;; instruction returns the low cycle count in EAX and high cycle count
@@ -676,3 +676,21 @@
 (defun cpuid (level)
   (declare (type (unsigned-byte 32) level))
   (cpuid level))
+
+(defmacro with-cycle-counter (&body body)
+  "Returns the primary value of BODY as the primary value, and the
+ number of CPU cycles elapsed as secondary value."
+  (let ((hi0 (gensym))
+	(hi1 (gensym))
+	(lo0 (gensym))
+	(lo1 (gensym)))
+    `(multiple-value-bind (,lo0 ,hi0)
+	 (read-cycle-counter)
+       (values (locally ,@body)
+               (multiple-value-bind (,lo1 ,hi1)
+		   (read-cycle-counter)
+		 ;; Can't do anything about the notes about generic
+		 ;; arithmetic, so silence the notes..
+		 (declare (optimize (inhibit-warnings 3))
+                 (+ (ash (- ,hi1 ,hi0) 32)
+                    (- ,lo1 ,lo0)))))))
diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt
index c11c5ee3b..a17c0da35 100644
--- a/src/general-info/release-20d.txt
+++ b/src/general-info/release-20d.txt
@@ -54,6 +54,8 @@ New in this release:
     * OSX 10.4 is no longer supported.
     * Micro optimizations for floats: 2*x -> x+x and x/2^n ->
       (2^(n))*x.
+    * Add VM::WITH-CYCLE-COUNTER to return the number of cycles elapsed
+      when executing the body, as measured by the CPU cycle/tick counter.
 
   * ANSI compliance fixes:
     * CMUCL was not printing pathnames like (make-pathname :directory
-- 
GitLab