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