Changeset 15264


Ignore:
Timestamp:
Mar 21, 2012, 10:11:46 PM (7 years ago)
Author:
gb
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:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/X86/x86-hash.lisp

    r13067 r15264  
    125125;;; Strip the tag bits to turn x into a fixnum
    126126(defx86lapfunction strip-tag-to-fixnum ((x arg_z))
    127   (andb ($ (lognot x8664::fixnummask)) (%b x))
     127  (movq (% x) (% imm0))
     128  (shlq ($ x8664::ntagbits) (% imm0))
     129  (box-fixnum imm0 arg_z)
    128130  (single-value-return))
    129131
  • trunk/source/level-0/l0-hash.lisp

    r15093 r15264  
    4545  (declaim (inline hash-lock-free-p lock-free-gethash)))
    4646
     47#+eq-hash-monitor
     48(progn
     49(defparameter eq-hash-find-calls 0)
     50(defparameter eq-hash-find-probes 0)
     51(defparameter eq-hash-find-for-put-calls 0)
     52(defparameter eq-hash-find-for-put-probes 0)
     53)
    4754
    4855
     
    99106             (logbitp (the (integer 0 (#.(- target::nbits-in-word target::fixnumshift)))
    100107                        typecode)
    101                       (logior (ash 1 target::tag-fixnum)
    102                               (ash 1 target::subtag-bignum)
     108                      (logior (ash 1 target::subtag-bignum)
     109                              #-64-bit-target
    103110                              (ash 1 target::subtag-single-float)
    104111                              (ash 1 target::subtag-double-float)
     
    141148(defun mixup-hash-code (fixnum)
    142149  (declare (fixnum fixnum))
     150  #+mixup-hash-code-nop
     151  fixnum
     152  #-mixup-hash-code-nop
    143153  (the fixnum
    144154    (+ fixnum
     
    149159(defun mixup-hash-code (fixnum)
    150160  (declare (fixnum fixnum))
     161  #+mixup-hash-code-nop
     162  fixnum
     163  #-mixup-hash-code-nop
    151164  (the fixnum
    152165    (+ fixnum
     
    12771290(defun eq-hash-find (hash key)
    12781291  (declare (optimize (speed 3) (safety 0)))
     1292  #+eq-hash-monitor (progn
     1293                      (incf eq-hash-find-calls)
     1294                      (incf eq-hash-find-probes))
    12791295  (let* ((vector (nhash.vector hash))
    12801296         (hash-code
     
    13021318          (declare (fixnum secondary-hash initial-index count length))
    13031319          (loop
     1320            #+eq-hash-monitor (incf eq-hash-find-probes)
    13041321            (incf vector-index secondary-hash)
    13051322            (when (>= vector-index length)
     
    13191336(defun eq-hash-find-for-put (hash key)
    13201337  (declare (optimize (speed 3) (safety 0)))
     1338  #+eq-hash-monitor (progn
     1339                      (incf eq-hash-find-for-put-calls)
     1340                      (incf eq-hash-find-for-put-probes))
    13211341  (let* ((vector (nhash.vector hash))
    13221342         (hash-code
     
    13501370        (declare (fixnum secondary-hash initial-index count length))
    13511371        (loop
     1372          #+eq-hash-monitor (incf eq-hash-find-for-put-probes)
    13521373          (incf vector-index secondary-hash)
    13531374          (when (>= vector-index length)
  • trunk/source/lib/compile-ccl.lisp

    r15125 r15264  
    110110(defparameter *arm-xdev-modules* '(arm-lapmacros ))
    111111
     112(defmacro with-global-optimization-settings ((&key speed
     113                                                   space
     114                                                   safety
     115                                                   debug
     116                                                   compilation-speed)
     117                                             &body body
     118                                             &environment env)
     119  (flet ((check-quantity (val default)
     120           (if val
     121             (require-type val '(mod 4))
     122             default)))
     123    (multiple-value-bind (body decls) (parse-body body env)
     124      `(let* ((*nx-speed* ,(check-quantity speed '*nx-speed*))
     125              (*nx-space* ,(check-quantity space '*nx-space*))
     126              (*nx-safety* ,(check-quantity safety '*nx-safety*))
     127              (*nx-debug* ,(check-quantity debug '*nx-debug*))
     128              (*nx-cspeed* ,(check-quantity compilation-speed '*nx-cspeed*)))
     129        ,@decls
     130        ,@body))))
     131 
    112132(defun target-xdev-modules (&optional (target
    113133                                       (backend-target-arch-name
     
    330350)
    331351
    332 (defmacro with-global-optimization-settings ((&rest override) &body body)
    333   `(let* ((*nx-speed* ,(or (cadr (assoc 'speed override)) 1))
    334           (*nx-space* ,(or (cadr (assoc 'space override)) 1))
    335           (*nx-cspeed* ,(or (cadr (assoc 'compilation-speed override)) 1))
    336           (*nx-safety* ,(or (cadr (assoc 'safety override)) 1))
    337           (*nx-debug* ,(or (cadr (assoc 'debug override)) 1)))
    338     ,@body))
     352
    339353
    340354(defun compile-ccl (&optional force-compile)
     
    562576        (format nil "Error executing ~a: ~a~&~a" procname string reminder)))))
    563577
    564 (defparameter *known-optional-features* '(:count-gf-calls :monitor-futex-wait :unique-dcode :qres-ccl))
     578(defparameter *known-optional-features* '(:count-gf-calls :monitor-futex-wait :unique-dcode :qres-ccl :eq-hash-monitor :mixup-hash-code-nop))
    565579(defvar *build-time-optional-features* nil)
    566580(defvar *ccl-save-source-locations* :no-text)
     
    851865  (with-preserved-working-directory ()
    852866    (let* ((*package* (find-package "CL-USER")))
    853       (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl)
     867      (with-global-optimization-settings ()
     868        (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl))
    854869      (cwd "ccl:tests;ansi-tests;")
    855870      (let ((do-tests (find-symbol "DO-TESTS" "REGRESSION-TEST"))
Note: See TracChangeset for help on using the changeset viewer.