Changeset 15264

Timestamp:

Mar 21, 2012, 3:11:46 PM (13 years ago)

Author:

Gary Byers

Message:

lib/compile-ccl.lisp: Define some "optional features" for testing
hashing algorithms. :EQ-HASH-MONITOR causes EQ-hashing routines to
record the number of calls/probes involved. (The INCFs here aren't
thread-safe.) :MIXUP-HASH-CODE-NOP makes the function
CCL::MIXUP-HASH-CODE return its argument.

Implement WITH-GLOBAL-OPTIMIZATION-SETTINGS a little differently;
use it in TEST-CCL.

level-0/X86/x86-hash.lisp: in STRIP-TAG-TO-FIXNUM, shift by an
extra bit (so that results aren't always odd/even depending on
tag bits of arg.) This seems to be the right thing and should
likely be implemented on all architectures.

level-0/l0-hash.lisp: conditionally implement the new optional
features.

NEED-USE-EQL: can use EQ if arg is a fixnum or #+64-bit-target
a SINGLE-FLOAT.

Location:

trunk/source

Files:

• level-0/X86/x86-hash.lisp (modified) (1 diff)
• level-0/l0-hash.lisp (modified) (8 diffs)
• lib/compile-ccl.lisp (modified) (4 diffs)

trunk/source/level-0/X86/x86-hash.lisp

@@ -125 +125 @@
 ;;; Strip the tag bits to turn x into a fixnum
 (defx86lapfunction strip-tag-to-fixnum ((x arg_z))
-  (andb ($ (lognot x8664::fixnummask)) (%b x))
+  (movq (% x) (% imm0))
+  (shlq ($ x8664::ntagbits) (% imm0))
+  (box-fixnum imm0 arg_z)
   (single-value-return))
 

trunk/source/level-0/l0-hash.lisp

@@ -45 +45 @@
   (declaim (inline hash-lock-free-p lock-free-gethash)))
 
+#+eq-hash-monitor
+(progn
+(defparameter eq-hash-find-calls 0)
+(defparameter eq-hash-find-probes 0)
+(defparameter eq-hash-find-for-put-calls 0)
+(defparameter eq-hash-find-for-put-probes 0)
+)
 
 
@@ -99 +106 @@
              (logbitp (the (integer 0 (#.(- target::nbits-in-word target::fixnumshift)))
                         typecode)
-                      (logior (ash 1 target::tag-fixnum)
-                              (ash 1 target::subtag-bignum)
+                      (logior (ash 1 target::subtag-bignum)
+                              #-64-bit-target
                               (ash 1 target::subtag-single-float)
                               (ash 1 target::subtag-double-float)
@@ -141 +148 @@
 (defun mixup-hash-code (fixnum)
   (declare (fixnum fixnum))
+  #+mixup-hash-code-nop
+  fixnum
+  #-mixup-hash-code-nop
   (the fixnum
     (+ fixnum
@@ -149 +159 @@
 (defun mixup-hash-code (fixnum)
   (declare (fixnum fixnum))
+  #+mixup-hash-code-nop
+  fixnum
+  #-mixup-hash-code-nop
   (the fixnum
     (+ fixnum
@@ -1277 +1290 @@
 (defun eq-hash-find (hash key)
   (declare (optimize (speed 3) (safety 0)))
+  #+eq-hash-monitor (progn
+                      (incf eq-hash-find-calls)
+                      (incf eq-hash-find-probes))
   (let* ((vector (nhash.vector hash))
          (hash-code
@@ -1302 +1318 @@
           (declare (fixnum secondary-hash initial-index count length))
           (loop
+            #+eq-hash-monitor (incf eq-hash-find-probes)
             (incf vector-index secondary-hash)
             (when (>= vector-index length)
@@ -1319 +1336 @@
 (defun eq-hash-find-for-put (hash key)
   (declare (optimize (speed 3) (safety 0)))
+  #+eq-hash-monitor (progn
+                      (incf eq-hash-find-for-put-calls)
+                      (incf eq-hash-find-for-put-probes))
   (let* ((vector (nhash.vector hash))
          (hash-code
@@ -1350 +1370 @@
         (declare (fixnum secondary-hash initial-index count length))
         (loop
+          #+eq-hash-monitor (incf eq-hash-find-for-put-probes)
           (incf vector-index secondary-hash)
           (when (>= vector-index length)

trunk/source/lib/compile-ccl.lisp

@@ -110 +110 @@
 (defparameter *arm-xdev-modules* '(arm-lapmacros ))
 
+(defmacro with-global-optimization-settings ((&key speed
+                                                   space
+                                                   safety
+                                                   debug
+                                                   compilation-speed)
+                                             &body body
+                                             &environment env)
+  (flet ((check-quantity (val default)
+           (if val
+             (require-type val '(mod 4))
+             default)))
+    (multiple-value-bind (body decls) (parse-body body env)
+      `(let* ((*nx-speed* ,(check-quantity speed '*nx-speed*))
+              (*nx-space* ,(check-quantity space '*nx-space*))
+              (*nx-safety* ,(check-quantity safety '*nx-safety*))
+              (*nx-debug* ,(check-quantity debug '*nx-debug*))
+              (*nx-cspeed* ,(check-quantity compilation-speed '*nx-cspeed*)))
+        ,@decls
+        ,@body))))
+  
 (defun target-xdev-modules (&optional (target
                                        (backend-target-arch-name
@@ -330 +350 @@
 )
 
-(defmacro with-global-optimization-settings ((&rest override) &body body)
-  `(let* ((*nx-speed* ,(or (cadr (assoc 'speed override)) 1))
-          (*nx-space* ,(or (cadr (assoc 'space override)) 1))
-          (*nx-cspeed* ,(or (cadr (assoc 'compilation-speed override)) 1))
-          (*nx-safety* ,(or (cadr (assoc 'safety override)) 1))
-          (*nx-debug* ,(or (cadr (assoc 'debug override)) 1)))
-    ,@body))
+
 
 (defun compile-ccl (&optional force-compile)
@@ -562 +576 @@
         (format nil "Error executing ~a: ~a~&~a" procname string reminder)))))
 
-(defparameter *known-optional-features* '(:count-gf-calls :monitor-futex-wait :unique-dcode :qres-ccl))
+(defparameter *known-optional-features* '(:count-gf-calls :monitor-futex-wait :unique-dcode :qres-ccl :eq-hash-monitor :mixup-hash-code-nop))
 (defvar *build-time-optional-features* nil)
 (defvar *ccl-save-source-locations* :no-text)
@@ -851 +865 @@
   (with-preserved-working-directory ()
     (let* ((*package* (find-package "CL-USER")))
-      (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl)
+      (with-global-optimization-settings ()
+        (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl))
       (cwd "ccl:tests;ansi-tests;")
       (let ((do-tests (find-symbol "DO-TESTS" "REGRESSION-TEST"))