Changeset 10192

Timestamp:

05/14/04 13:40:19 (5 years ago)

Author:

rtoy

Message:

Add support for storing the symbol hash into a slot in the symbol
itself. Only for sparc currently.

Doesn't lazily compute the symbol hash yet. Simple test shows a 5%
increase in compilation speed, despite making make-symbol
significantly slower.

• src/code/hash-new.lisp (internal-sxhash): Use the symbol-hash slot instead of computing the hash value.

• src/compiler/generic/new-genesis.lisp (allocate-symbol): Write out the sxhash value of the symbol into the symbol-hash slot.

• src/compiler/globaldb.lisp (info-hash): Update to use the symbol hash instead of computing the sxhash.

• src/code/symbol.lisp (make-symbol): Compute the symbol hash when creating the symbol.

• src/compiler/sparc/cell.lisp ((symbol-hash)): Add vop to extract out the symbol hash from a symbol.

• src/compiler/generic/objdef.lisp: Rename the unused slot to hash, so we can make it the symbol hash.

Location:

trunk/src

Files:

• code/hash-new.lisp (modified) (2 diffs)
• code/symbol.lisp (modified) (2 diffs)
• compiler/generic/new-genesis.lisp (modified) (3 diffs)
• compiler/sparc/cell.lisp (modified) (2 diffs)

trunk/src/code/hash-new.lisp

@@ -185 +185 @@
 ;;; 
 (defun make-hash-table (&key (test 'eql) (size 65) (rehash-size 1.5)
-                             (rehash-threshold 1) (weak-p nil))
+                             (rehash-threshold 1.0) (weak-p nil))
   "Creates and returns a new hash table.  The keywords are as follows:
      :TEST -- Indicates what kind of test to use.  Only EQ, EQL, EQUAL,
@@ -230 +230 @@
       (let* ((size (max 36 size)) ; Needs to be at least 1, say 36.
              (size+1 (1+ size))   ; The first element is not usable.
+             ;; Don't let rehash-threshold get too small to cause
+             ;; overflows or division by zero.  It's a hint, not a
+             ;; requirement, anyway.
+             (rehash-threshold (max 0.1 (float rehash-threshold 1.0)))
              (scaled-size (round (/ (float size+1) rehash-threshold)))
              (length (if (<= scaled-size 37) 37 (almost-primify scaled-size))))

trunk/src/code/symbol.lisp

@@ -158 +158 @@
       ((null plist) default)
     (cond ((atom (cdr plist))
-           (simple-program-error "~S is a malformed property list." place))
+           (error 'simple-type-error
+                  :datum place
+                  :expected-type 'list
+                  :format-control "Malformed property list: ~S"
+                  :format-arguments (list place)))         
           ((eq (car plist) indicator)
            (return (cadr plist))))))
@@ -179 +183 @@
       ((null plist) (values nil nil nil))
     (cond ((atom (cdr plist))
-           (simple-program-error "~S is a malformed property list." place))
+           (error 'simple-type-error
+                  :datum place
+                  :expected-type 'list
+                  :format-control "Malformed property list: ~S"
+                  :format-arguments (list place)))
           ((memq (car plist) indicator-list)
            (return (values (car plist) (cadr plist) plist))))))

trunk/src/compiler/generic/new-genesis.lisp

@@ -708 +708 @@
       (frob kernel::yellow-zone-hit)
       (frob kernel::red-zone-hit))
+    #+heap-overflow-check
+    (progn
+      (frob kernel::dynamic-space-overflow-error-hit)
+      (frob kernel::dynamic-space-overflow-warning-hit))
     (frob di::handle-breakpoint)
     (frob di::handle-function-end-breakpoint)
@@ -1926 +1930 @@
   (cold-register-foreign-linkage "resolve_linkage_tramp" :code)
   #+sparc
-  (cold-register-foreign-linkage "call_into_c" :code))
+  (progn
+    (cold-register-foreign-linkage "call_into_c" :code)
+    (cold-register-foreign-linkage "undefined_tramp" :data)
+    (cold-register-foreign-linkage "closure_tramp" :data)
+    ))
 
 (defvar *cold-assembler-routines* nil)
@@ -2224 +2232 @@
             (test-head "TRACE-TABLE-" "tracetab_" 4)
             (test-tail "-SC-NUMBER" "sc_" 5)
-            (test-head "TARGET-FOREIGN-" "" 6)))))
+            (test-head "TARGET-FOREIGN" "" 6)
+            (test-head "PSEUDO-ATOMIC-" "pseudo_atomic_" 7)
+            (test-head "LOWTAG-" "lowtag_" 8)
+            (test-head "TYPE-" "type_" 9)
+            (test-tail "-SPACE-START" "SpaceStart_" 10)))))
     (setf constants
           (sort constants

trunk/src/compiler/sparc/cell.lisp

@@ -264 +264 @@
   (:generator 4
     (loadw temp struct 0 instance-pointer-type)
-    (inst srl res temp vm:type-bits)))
+    (inst srln res temp vm:type-bits)))
 
 (define-vop (instance-ref slot-ref)
@@ -274 +274 @@
 (define-vop (instance-set slot-set)
   (:policy :fast-safe)
-  (:translate %instance-set)
+  ;; This is an invalid translation because %instance-set needs a
+  ;; return value, and this VOP doesn't return anything.  I (RLT)
+  ;; don't know how to fix this so that this VOP returns a value and
+  ;; still works correctly when it is called directly by the compiler.
+  ;; However, disabling the translation works around the bug.
+  
+  ;;(:translate %instance-set)
   (:variant instance-slots-offset instance-pointer-type)
   (:arg-types instance (:constant index) *))