From fe40afd6c7161683ad2d0548276ad43cbedeed58 Mon Sep 17 00:00:00 2001
From: emarsden <emarsden>
Date: Tue, 25 Feb 2003 15:54:57 +0000
Subject: [PATCH] Add support for hardware cycle counters for Pentium and
 UltraSPARC. This uses the CPUID + RDTSC instructions on Pentium, and reads
 the %TICK register on UltraSPARC. Accessible via the VM::READ-CYCLE-COUNTER
 VOP that returns two (unsigned-byte 32) values, that are the lower and upper
 components of a 64-bit cycle count (actually 63 bits for UltraSPARC). Basic
 support for counting the number of CPU cycles has been added to the TIME
 macro.

---
 code/time.lisp               | 17 ++++++++++++-
 compiler/sparc/insts.lisp    | 17 ++++++++++---
 compiler/sparc/system.lisp   | 33 +++++++++++++++++++++++-
 compiler/x86/insts.lisp      | 16 +++++++++++-
 compiler/x86/system.lisp     | 49 +++++++++++++++++++++++++++++++++++-
 general-info/release-18e.txt |  2 ++
 6 files changed, 127 insertions(+), 7 deletions(-)

diff --git a/code/time.lisp b/code/time.lisp
index 59bc1275f..839a7532f 100644
--- a/code/time.lisp
+++ b/code/time.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.21 2003/01/06 15:10:16 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.22 2003/02/25 15:54:54 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -281,6 +281,16 @@
 		       (system:get-system-info)
     (values user sys faults (get-bytes-consed))))
 
+#+(or pentium sparc-v9)
+(defun cycle-count/float ()
+  (multiple-value-bind (lo hi)
+      (vm::read-cycle-counter)
+    (+ (* hi (expt 2.0d0 32)) lo)))
+
+#-(or pentium sparc-v9)
+(defun cycle-count/float () 0.0)
+
+
 ;;; %TIME  --  Internal
 ;;;
 ;;;    The guts of the TIME macro.  Compute overheads, run the (compiled)
@@ -299,6 +309,7 @@
         real-time-overhead
         run-utime-overhead
         run-stime-overhead
+        cycle-count
         page-faults-overhead
         old-bytes-consed
         new-bytes-consed
@@ -328,9 +339,11 @@
         (old-run-utime old-run-stime old-page-faults old-bytes-consed)
       (time-get-sys-info))
     (let ((start-gc-run-time *gc-run-time*))
+    (setq cycle-count (- (cycle-count/float)))
     (multiple-value-prog1
         ;; Execute the form and return its values.
         (funcall fun)
+      (incf cycle-count (cycle-count/float))
       (multiple-value-setq
 	  (new-run-utime new-run-stime new-page-faults new-bytes-consed)
 	(time-get-sys-info))
@@ -343,6 +356,7 @@
 		 ~S second~:P of real time~%  ~
 		 ~S second~:P of user run time~%  ~
 		 ~S second~:P of system run time~%  ~
+                 ~D CPU cycles~%  ~
 		 ~@[[Run times include ~S second~:P GC run time]~%  ~]~
 		 ~S page fault~:P and~%  ~
 		 ~:D bytes consed.~%"
@@ -351,6 +365,7 @@
 		       0.0)
 		  (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
 		  (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
+                  (truncate cycle-count)
 		  (unless (zerop gc-run-time)
 		    (/ (float gc-run-time)
 		       (float internal-time-units-per-second)))
diff --git a/compiler/sparc/insts.lisp b/compiler/sparc/insts.lisp
index ff9d3299e..408523c31 100644
--- a/compiler/sparc/insts.lisp
+++ b/compiler/sparc/insts.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.37 2002/09/12 15:59:29 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.38 2003/02/25 15:54:55 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,7 +21,7 @@
 
 (def-assembler-params
     :scheduler-p t
-  :max-locations 100)
+  :max-locations 101)
 
 
 ;;;; Constants, types, conversion functions, some disassembler stuff.
@@ -90,7 +90,8 @@ Otherwise, use the Sparc register names")
        (:memory 0)
        (:psr 97)
        (:fsr 98)
-       (:y 99)))))
+       (:y 99)
+       (:tick 100)))))
 
 ;;; symbols used for disassembly printing
 ;;;
@@ -1266,6 +1267,16 @@ about function addresses and register values.")
       (emit-format-3-immed segment #b10 0 #b110000 (reg-tn-encoding src1) 1
 			   src2)))))
 
+;; Read the tick register available on sparc v9
+(define-instruction rdtick (segment dst)
+  (:declare (type tn dst))
+  (:printer format-3-immed ((op #b10) (op3 #b101000) (rs1 4) (immed 0))
+            '('RD :tab '%TICK ", " rd))
+  (:dependencies (reads :tick) (writes dst))
+  (:delay 0)
+  (:emitter (emit-format-3-immed segment #b10 (reg-tn-encoding dst) #b101000
+				 4 0 0)))
+
 (defun snarf-error-junk (sap offset &optional length-only)
   (let* ((length (system:sap-ref-8 sap offset))
          (vector (make-array length :element-type '(unsigned-byte 8))))
diff --git a/compiler/sparc/system.lisp b/compiler/sparc/system.lisp
index 497ac4d90..ab6991642 100644
--- a/compiler/sparc/system.lisp
+++ b/compiler/sparc/system.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/system.lisp,v 1.12 1994/10/31 04:46:41 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/system.lisp,v 1.13 2003/02/25 15:54:55 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -246,3 +246,34 @@
       (inst ld count count-vector offset)
       (inst add count 1)
       (inst st count count-vector offset))))
+
+;; The RDTICK instruction on Sparc V9s allows access to a 63-bit cycle
+;; counter.
+
+(defknown read-cycle-counter ()
+  (values (unsigned-byte 32) (unsigned-byte 32)))
+
+;; Note: This should probably really only be used sparc-v8plus because
+;; the tick counter is returned in a 64-bit register.
+(define-vop (read-cycle-counter)
+  (:translate read-cycle-counter)
+  (:guard (backend-featurep :sparc-v9))
+  (:args)
+  (:policy :fast-safe)
+  (:results (lo :scs (unsigned-reg))
+	    (hi :scs (unsigned-reg)))
+  (:result-types unsigned-num unsigned-num)
+  ;; The temporary can be any of the 64-bit non-descriptor regs.  It
+  ;; can't be any non-descriptor reg because they might not get saved
+  ;; on a task switch, since we're still a 32-bit app.  Arbitrarily
+  ;; select nl5.
+  (:temporary (:sc unsigned-reg :offset nl5-offset) tick)
+  (:generator 3
+    (inst rdtick tick)
+    ;; Get the hi and low parts of the counter into the results.
+    (inst srlx hi tick 32)
+    (inst srl lo tick 0)))
+
+#+sparc-v9
+(defun read-cycle-counter ()
+  (read-cycle-counter))
diff --git a/compiler/x86/insts.lisp b/compiler/x86/insts.lisp
index 2173386e0..dbac0ddf1 100644
--- a/compiler/x86/insts.lisp
+++ b/compiler/x86/insts.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.24 2002/09/19 17:46:03 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.25 2003/02/25 15:54:56 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2053,6 +2053,20 @@
   (:emitter
    (emit-byte segment #b11001111)))
 
+;; read-time-stamp instruction, that counts executed cycles, present
+;; from Pentium onwards
+(define-instruction rdtsc (segment)
+  (:printer two-bytes ((op '(#x0f #x31))))
+  (:emitter
+   (emit-byte segment #x0f)
+   (emit-byte segment #x31)))
+
+(define-instruction cpuid (segment)
+  (:printer two-bytes ((op '(#x0f #xa2))))
+  (:emitter
+   (emit-byte segment #x0f)
+   (emit-byte segment #xa2)))
+
 
 ;;;; Processor control
 
diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp
index ae392894f..e25097055 100644
--- a/compiler/x86/system.lisp
+++ b/compiler/x86/system.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.11 2002/08/27 22:18:29 moore Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.12 2003/02/25 15:54:56 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -559,3 +559,50 @@
     ;; Pop the frame pointer, and resume at the return address.
     (inst pop ebp-tn)
     (inst ret)))
+
+
+;; 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
+;; in EDX.
+;;
+;; In order to obtain more significant results on out-of-order
+;; processors (such as the Pentium II and later), we issue a
+;; serializing CPUID instruction before reading the cycle counter.
+;; This instruction is used for its side effect of emptying the
+;; processor pipeline, to ensure that the RDTSC instruction is
+;; executed once all pending instructions have been completed.
+;;
+;; Note that cache effects mean that the cycle count can vary for
+;; different executions of the same code (it counts cycles, not
+;; retired instructions). Furthermore, the results are per-processor
+;; and not per-process, so are unreliable on multiprocessor machines
+;; where processes can migrate between processors.
+;;
+;; This method of obtaining a cycle count has the advantage of being
+;; very fast (around 20 cycles), and of not requiring a system call.
+;; However, you need to know your processor's clock speed to translate
+;; this into real execution time.
+
+(defknown read-cycle-counter () (values (unsigned-byte 32) (unsigned-byte 32)) ())
+
+(define-vop (read-cycle-counter)
+  (:translate read-cycle-counter)
+  (:guard (backend-featurep :pentium))
+  (:args )
+  (:policy :fast-safe)
+  (:results (lo :scs (unsigned-reg))
+            (hi :scs (unsigned-reg)))
+  (:result-types unsigned-num unsigned-num)
+  (:temporary (:sc unsigned-reg :offset eax-offset :target lo) eax)
+  (:temporary (:sc unsigned-reg :offset edx-offset :target hi) edx)
+  (:generator 1
+     (inst cpuid)
+     (inst rdtsc)
+     (move hi edx)
+     (move lo eax)))
+
+#+pentium
+(defun read-cycle-counter ()
+  (read-cycle-counter))
diff --git a/general-info/release-18e.txt b/general-info/release-18e.txt
index fcd1a02e6..6cc3e3977 100644
--- a/general-info/release-18e.txt
+++ b/general-info/release-18e.txt
@@ -36,6 +36,8 @@ New in this release:
      - Support for generalized function names of the form
        (<SYMBOL> ...) has been added.  See EXT:DEFINE-FUNCTION-NAME-SYNTAX
        and EXT:VALID-FUNCTION-NAME-P.
+     - Access to the hardware cycle counters on Pentium and UltraSPARC
+       processors has been added, and is reported by the TIME macro.
 
   * Numerous ANSI compliance fixes:
      - SYMBOL-MACROLET signals an error when an attempt is made to
-- 
GitLab