X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fsystem.lisp;h=ce91fb436651e8b64d1b5d1c72465e0b72093632;hb=45bc305be4e269d2e1a477c8e0ae9a64df1ccd1c;hp=f86f77424180aabf4f89df45a83c2fd24399ad7e;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git

diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp
index f86f774..ce91fb4 100644
--- a/src/compiler/x86-64/system.lisp
+++ b/src/compiler/x86-64/system.lisp
@@ -126,14 +126,16 @@
     (storew eax x 0 other-pointer-lowtag)
     (move res x)))
 
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg) :target res))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
     (move res ptr)
-    (inst shl res 4)
+    ;; Mask the lowtag, and shift the whole address into a positive
+    ;; fixnum.
+    (inst and res (lognot lowtag-mask))
     (inst shr res 1)))
 
 (define-vop (make-other-immediate-type)
@@ -163,7 +165,7 @@
   (:translate binding-stack-pointer-sap)
   (:policy :fast-safe)
   (:generator 1
-    (load-tl-symbol-value int *binding-stack-pointer*)))
+    (load-binding-stack-pointer int)))
 
 (defknown (setf binding-stack-pointer-sap)
     (system-area-pointer) system-area-pointer ())
@@ -173,11 +175,10 @@
   (:arg-types system-area-pointer)
   (:results (int :scs (sap-reg)))
   (:result-types system-area-pointer)
-  #!+sb-thread (:temporary (:sc any-reg) temp)
   (:translate (setf binding-stack-pointer-sap))
   (:policy :fast-safe)
   (:generator 1
-    (store-tl-symbol-value new-value *binding-stack-pointer* temp)
+    (store-binding-stack-pointer new-value)
     (move int new-value)))
 
 (define-vop (control-stack-pointer-sap)
@@ -235,9 +236,6 @@
 (define-source-transform %closure-fun (closure)
   `(%simple-fun-self ,closure))
 
-(define-source-transform %funcallable-instance-fun (fin)
-  `(%simple-fun-self ,fin))
-
 (define-vop (%set-fun-self)
   (:policy :fast-safe)
   (:translate (setf %simple-fun-self))
@@ -252,20 +250,6 @@
                             fun-pointer-lowtag)))
     (storew temp function simple-fun-self-slot fun-pointer-lowtag)
     (move result new-self)))
-
-;;; KLUDGE: This seems to be some kind of weird override of the way
-;;; that the objdef.lisp code would ordinarily set up the slot
-;;; accessor. It's inherited from CMU CL, and it works, and naively
-;;; deleting it seemed to cause problems, but it's not obvious why
-;;; it's done this way. Any ideas? -- WHN 2001-08-02
-(defknown ((setf %funcallable-instance-fun)) (function function) function
-  (unsafe))
-;;; CMU CL comment:
-;;;   We would have really liked to use a source-transform for this, but
-;;;   they don't work with SETF functions.
-;;; FIXME: Can't we just use DEFSETF or something?
-(deftransform (setf %funcallable-instance-fun) ((value fin))
-  '(setf (%simple-fun-self fin) value))
 
 ;;;; other miscellaneous VOPs
 
@@ -306,7 +290,68 @@
     (note-next-instruction vop :internal-error)
     (inst wait)))
 
-;;;; dynamic vop count collection support
+;;;; Miscellany
+
+;;; 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 and after 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 and
+;;; before any others. CPUID writes to EBX and ECX in addition to EAX
+;;; and EDX, so they need to be added as temporaries.
+;;;
+;;; 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.
+;;;
+;;; FIXME: This about the WITH-CYCLE-COUNTER interface a bit, and then
+;;; perhaps export it from SB-SYS.
+
+(defknown %read-cycle-counter () (values (unsigned-byte 32) (unsigned-byte 32)) ())
+
+(define-vop (%read-cycle-counter)
+  (:policy :fast-safe)
+  (:translate %read-cycle-counter)
+  (:temporary (:sc unsigned-reg :offset eax-offset :target lo) eax)
+  (:temporary (:sc unsigned-reg :offset edx-offset :target hi) edx)
+  (:temporary (:sc unsigned-reg :offset ebx-offset) ebx)
+  (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
+  (:ignore ebx ecx)
+  (:results (hi :scs (unsigned-reg))
+            (lo :scs (unsigned-reg)))
+  (:result-types unsigned-num unsigned-num)
+  (:generator 5
+     (zeroize eax)
+     ;; Intel docs seem quite consistent on only using CPUID before RDTSC,
+     ;; not both before and after. Go figure.
+     (inst cpuid)
+     (inst rdtsc)
+     (move lo eax)
+     (move hi edx)))
+
+(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. EXPERIMENTAL."
+  (with-unique-names (hi0 hi1 lo0 lo1)
+    `(multiple-value-bind (,hi0 ,lo0) (%read-cycle-counter)
+       (values (locally ,@body)
+               (multiple-value-bind (,hi1 ,lo1) (%read-cycle-counter)
+                 (+ (ash (- ,hi1 ,hi0) 32)
+                    (- ,lo1 ,lo0)))))))
 
 #!+sb-dyncount
 (define-vop (count-me)