X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fcell.lisp;h=3220e7d771baee4e83fe05931f3f9ca72a709d33;hb=2546d61e3e230629978781602f82cee66f579d07;hp=cdee9585e1e4461e793fc4b27789ad8aeaaea60f;hpb=82653abf5573c22c691e2243b70647ecdaa6aea8;p=sbcl.git

diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp
index cdee958..3220e7d 100644
--- a/src/compiler/alpha/cell.lisp
+++ b/src/compiler/alpha/cell.lisp
@@ -25,15 +25,15 @@
 (define-vop (set-slot)
   (:args (object :scs (descriptor-reg))
 	 (value :scs (descriptor-reg any-reg null zero)))
-  (:info name offset lowtag #+gengc remember)
+  (:info name offset lowtag #!+gengc remember)
   (:ignore name)
   (:results)
   (:generator 1
-    #+gengc
+    #!+gengc
     (if remember
 	(storew-and-remember-slot value object offset lowtag)
 	(storew value object offset lowtag))
-    #-gengc
+    #!-gengc
     (storew value object offset lowtag)))
 
 ;;;; symbol hacking VOPs
@@ -87,7 +87,19 @@
   (:policy :fast)
   (:translate symbol-value))
 
-
+(define-vop (symbol-hash)
+  (:policy :fast-safe)
+  (:translate symbol-hash)
+  (:args (symbol :scs (descriptor-reg)))
+  (:results (res :scs (any-reg)))
+  (:result-types positive-fixnum)
+  (:generator 2
+    ;; The symbol-hash slot of NIL holds NIL because it is also the
+    ;; cdr slot, so we have to strip off the two low bits to make sure
+    ;; it is a fixnum.  The lowtag selection magic that is required to
+    ;; ensure this is explained in the comment in objdef.lisp
+    (loadw res symbol symbol-hash-slot other-pointer-lowtag)
+    (inst bic res #.(ash lowtag-mask -1) res)))
 
 ;;;; fdefinition (FDEFN) objects
 
@@ -104,7 +116,7 @@
   (:generator 10
     (move object obj-temp)
     (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag)
-    (let ((err-lab (generate-error-code vop undefined-symbol-error obj-temp)))
+    (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp)))
       (inst cmpeq value null-tn temp)
       (inst bne temp err-lab))))
 
@@ -156,7 +168,7 @@
     (inst addq bsp-tn (* 2 n-word-bytes) bsp-tn)
     (storew temp bsp-tn (- binding-value-slot binding-size))
     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
-    (#+gengc storew-and-remember-slot #-gengc storew
+    (#!+gengc storew-and-remember-slot #!-gengc storew
 	     val symbol symbol-value-slot other-pointer-lowtag)))
 
 
@@ -165,7 +177,7 @@
   (:generator 0
     (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
     (loadw value bsp-tn (- binding-value-slot binding-size))
-    (#+gengc storew-and-remember-slot #-gengc storew
+    (#!+gengc storew-and-remember-slot #!-gengc storew
 	     value symbol symbol-value-slot other-pointer-lowtag)
     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
     (inst subq bsp-tn (* 2 n-word-bytes) bsp-tn)))
@@ -188,7 +200,7 @@
       (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
       (loadw value bsp-tn (- binding-value-slot binding-size))
       (inst beq symbol skip)
-      (#+gengc storew-and-remember-slot #-gengc storew
+      (#!+gengc storew-and-remember-slot #!-gengc storew
 	       value symbol symbol-value-slot other-pointer-lowtag)
       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
 
@@ -270,7 +282,7 @@
 
 ;;;; mutator accessing
 
-#+gengc
+#!+gengc
 (progn
 
 (eval-when (:compile-toplevel :load-toplevel :execute)