common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

32-bit: Dissociate SYMBOL-HASH and (CAR NIL)

Browse source 
NIL-as-cons is overlayed with SYMBOL-FDEFN which is better since that's
supposed to be NIL.  Wth newfound freedom, assign NIL a name-based hash
so that the xperfecthash30 file is insensitive to NIL's address.

And every so often you should rearrange primitive object slots anyway
to ascertain that it's not impossible.
This commit is contained in:
Douglas Katzman 2024-02-29 20:52:37 -05:00
parent 86a6adff70
commit 1c9e8235ac
15 changed files with 148 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/code/fdefinition.lisp
View file

@ -104,14 +104,18 @@
symbol))
(t def))))
(defglobal *fdefn-of-nil* 0) ; God help you if you access this damn thing
(declaim (ftype (sfunction (t) fdefn) find-or-create-fdefn))
(defun find-or-create-fdefn (name)
(cond
((symbolp name)
(let ((fdefn (sb-vm::%symbol-fdefn name)))
(if (eql fdefn 0)
(if (or (eq fdefn nil) (eq fdefn 0))
(let* ((new (make-fdefn name))
(actual (sb-vm::cas-symbol-fdefn name 0 new)))
(actual
(if name
(sb-vm::cas-symbol-fdefn name 0 new)
(cas *fdefn-of-nil* 0 new))))
(if (eql actual 0) new (the fdefn actual)))
fdefn)))
((find-fdefn name))

11
src/code/string-hash.lisp
View file

@ -82,14 +82,19 @@
(defun symbol-name-hash (symbol) ; emulate our slot reader
(let ((name (symbol-name symbol)))
(calc-symbol-name-hash name (length name))))
;; OMFG other than src/code/symbol being a :NOT-HOST file, why is this repeated?
;; Could this not be the One Definition ?
(defun calc-symbol-name-hash (string length)
;; The reader passes a string buffer and length to avoid consing a new string
;; for each symbol read. That does not occur in cross-compilation.
(aver (= length (length string)))
(if (string= string "NIL") ; :NIL must hash the same as NIL
(cond
#+64-bit
((string= string "NIL") ; :NIL must hash the same as NIL
;; out-of-order with defconstant nil-value
(ash (sb-vm::get-nil-taggedptr) (- sb-vm:n-fixnum-tag-bits))
(logxor (%sxhash-simple-string string) most-positive-fixnum)))
(ash (sb-vm::get-nil-taggedptr) (- sb-vm:n-fixnum-tag-bits)))
(t
(logxor (%sxhash-simple-string string) most-positive-fixnum))))
(defun sb-xc:sxhash (obj)
(let ((answer
(etypecase obj ; croak on anything but these

9
src/code/symbol.lisp
View file

@ -75,7 +75,9 @@ distinct from the global value. Can also be SETF."
;; object sought (having an exceptional hash) until it has been found.
(defun calc-symbol-name-hash (string length)
(declare (simple-string string) (index length))
(if (and (= length 3)
(cond
#+64-bit
((and (= length 3)
(locally
;; SXHASH-SUBSTRING is unsafe, so this is too. but do we know that
;; length is ok, or is it an accident that it can scan too far?
@ -85,10 +87,11 @@ distinct from the global value. Can also be SETF."
(and (char= (schar string 0) #\N)
(char= (schar string 1) #\I)
(char= (schar string 2) #\L)))))
(sxhash nil) ; transformed
(sxhash nil)) ; transformed
(t
;; flip the bits so that a symbol hashes differently from its print name
(logxor (%sxhash-simple-substring string 0 length)
most-positive-fixnum)))
most-positive-fixnum))))
;;; Return the function binding of SYMBOL or NIL if not fboundp.
;;; Don't strip encapsulations.

8
src/compiler/arm/cell.lisp
View file

@ -81,16 +81,10 @@
(:policy :fast-safe)
(:translate symbol-hash)
(:args (symbol :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 2
;; The symbol-hash slot of NIL holds NIL because it is also the
;; car 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 temp symbol symbol-hash-slot other-pointer-lowtag)
(inst bic res temp fixnum-tag-mask)))
(loadw res symbol symbol-hash-slot other-pointer-lowtag)))
;;; On unithreaded builds these are just copies of the non-global versions.
(define-vop (%set-symbol-global-value set))

9
src/compiler/generic/genesis.lisp
View file

@ -1782,7 +1782,14 @@ core and return a descriptor to it."
(write-wordindexed des (+ 1 sb-vm:symbol-value-slot) nil-val)
#+relocatable-static-space
(write-wordindexed des (+ 1 sb-vm::symbol-unused-slot) nil-val)
(write-wordindexed des (+ 1 sb-vm:symbol-hash-slot) nil-val)
;; write the CAR of nil-as-cons. Also for 32-bit, set the hash to the normal hash
;; for the symbol-name.
#+64-bit (write-wordindexed des (+ 1 sb-vm:symbol-hash-slot) nil-val)
#-64-bit (progn (write-wordindexed des (+ 1 sb-vm:symbol-fdefn-slot) nil-val)
(write-wordindexed des (+ 1 sb-vm:symbol-hash-slot)
(make-fixnum-descriptor
(sb-impl::calc-symbol-name-hash "NIL" 3))))
;;
(write-wordindexed des (+ 1 sb-vm:symbol-info-slot) initial-info)
(write-wordindexed des (+ 1 sb-vm:symbol-name-slot) name)
#+ppc64

25
src/compiler/generic/objdef.lisp
View file

@ -365,6 +365,7 @@ during backtrace.
;;;; symbols
#+64-bit
(define-primitive-object (symbol :lowtag other-pointer-lowtag
:widetag symbol-widetag
:alloc-trans %%make-symbol
@ -420,15 +421,31 @@ during backtrace.
:cas-trans sb-impl::cas-symbol-%info
:type (or instance list)
:init :null)
(name :init :arg #-compact-symbol :ref-trans #-compact-symbol symbol-name)
(name :init :arg)
#+relocatable-static-space
(hash :set-trans %set-symbol-hash))
#-64-bit
(define-primitive-object (symbol :lowtag other-pointer-lowtag
:widetag symbol-widetag
:alloc-trans %%make-symbol
:type symbol)
;; As described in the comments above for #+64-bit, the first two slots of SYMBOL
;; have to work for NIL-as-cons, so they have to be NIL and NIL, which have to
;; also be the correct value when reading the slot of NIL-as-symbol.
(fdefn :ref-trans %symbol-fdefn :ref-known () :cas-trans cas-symbol-fdefn)
(value :init :unbound :set-trans %set-symbol-global-value :set-known ())
(info :ref-trans symbol-%info :ref-known (flushable)
:cas-trans sb-impl::cas-symbol-%info
:type (or instance list)
:init :null)
(name :init :arg :ref-trans symbol-name)
;; The remaining slots can be ignored by GC
(hash :set-trans %set-symbol-hash)
#-compact-symbol
(package-id :type index ; actually 16 bits. (Could go in the header)
:ref-trans symbol-package-id
:set-trans sb-impl::set-symbol-package-id :set-known ())
;; 0 tls-index means no tls-index is allocated
;; 64-bit put the tls-index in the header word.
;; For the 32-bit architectures, reading this slot as a descriptor
;; makes it "off" by N-FIXNUM-TAG-BITS, which is bothersome,
;; so there's a transform on SYMBOL-TLS-INDEX to make it sane.
@ -438,7 +455,7 @@ during backtrace.
;; * (sb-vm:hexdump nil)
;; 1100008: 0110000B = NIL ; looks like NIL's TLS index is 0x110
;; 110000C: 0110000B = NIL
#+(and sb-thread (not 64-bit))
#+sb-thread
(tls-index :type (and fixnum unsigned-byte) ; too generous still?
:ref-known (flushable)
:ref-trans %symbol-tls-index))

9
src/compiler/mips/cell.lisp
View file

@ -89,17 +89,10 @@
(:policy :fast-safe)
(:translate symbol-hash)
(:args (symbol :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(: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 temp symbol symbol-hash-slot other-pointer-lowtag)
(inst srl temp n-fixnum-tag-bits)
(inst sll res temp n-fixnum-tag-bits)))
(loadw res symbol symbol-hash-slot other-pointer-lowtag)))
;;; On unithreaded builds these are just copies of the non-global versions.
(define-vop (%set-symbol-global-value set))

8
src/compiler/ppc/cell.lisp
View file

@ -213,13 +213,7 @@
(:result-types positive-fixnum)
(:arg-refs args)
(:generator 2
;; The symbol-hash slot of NIL holds NIL because it is also the
;; car 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)
(unless (not-nil-tn-ref-p args)
(inst clrrwi res res n-fixnum-tag-bits))))
(loadw res symbol symbol-hash-slot other-pointer-lowtag)))
;;;; Fdefinition (fdefn) objects.

8
src/compiler/sparc/cell.lisp
View file

@ -84,13 +84,7 @@
(:result-types positive-fixnum)
(:arg-refs args)
(: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)
(unless (not-nil-tn-ref-p args)
(inst andn res res fixnum-tag-mask))))
(loadw res symbol symbol-hash-slot other-pointer-lowtag)))
;;; On unithreaded builds these are just copies of the non-global versions.
(define-vop (%set-symbol-global-value set))

4
src/compiler/srctran.lisp
View file

@ -6545,6 +6545,10 @@
(deftransform fboundp ((symbol) (symbol))
`(let ((fdefn (sb-vm::%symbol-fdefn symbol)))
(and (not (eq fdefn 0))
;; On 32-bit, where %SYMBOL-FDEFN of NIL returns NIL instead of 0,
;; this is valid code! Watch closely:
;; FDEFN-FUN is "MOV EDX, [EDX+1]"
;; But [NIL+1] is the same as CDR of NIL, which is NIL.
(fdefn-fun (truly-the fdefn fdefn)))))
;;; Normally we don't create fdefns by side-effect of calling FBOUNDP,
;;; but this transform is neutral in terms of the sum of code and data size.

8
src/compiler/x86/cell.lisp
View file

@ -214,13 +214,7 @@
(:result-types positive-fixnum)
(:arg-refs args)
(:generator 2
;; The symbol-hash slot of NIL holds NIL because it is also the
;; car 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)
(unless (not-nil-tn-ref-p args)
(inst and res (lognot #b11)))))
(loadw res symbol symbol-hash-slot other-pointer-lowtag)))
;;;; fdefinition (FDEFN) objects

6
src/runtime/coreparse.c
View file

@ -429,13 +429,17 @@ static void fix_space(uword_t start, lispobj* end, struct heap_adjust* adj)
}
continue;
case SYMBOL_WIDETAG:
{ // Copied from scav_symbol() in gc-common
{ // Modeled on scav_symbol() in gc-common
struct symbol* s = (void*)where;
#ifdef LISP_FEATURE_64_BIT
adjust_pointers(&s->value, 3, adj); // value, fdefn, info
lispobj name = decode_symbol_name(s->name);
lispobj adjusted_name = adjust_word(adj, name);
// writeback the name if it changed
if (adjusted_name != name) FIXUP(set_symbol_name(s, adjusted_name), &s->name);
#else
adjust_pointers(&s->fdefn, 4, adj); // fdefn, value, info, name
#endif
}
continue;
case FDEFN_WIDETAG:

4
src/runtime/gc-common.c
View file

@ -812,14 +812,14 @@ static lispobj trans_boxed(lispobj object) {
static sword_t scav_symbol(lispobj *where,
__attribute__((unused)) lispobj header) {
struct symbol* s = (void*)where;
#ifdef LISP_FEATURE_COMPACT_SYMBOL
#ifdef LISP_FEATURE_64_BIT
scavenge(&s->value, 3); // value, fdefn, info
lispobj name = decode_symbol_name(s->name);
lispobj new = name;
scavenge(&new, 1);
if (new != name) set_symbol_name(s, new);
#else
scavenge(&s->value, 4); // value, fdefn, info, name
scavenge(&s->fdefn, 4); // fdefn, value, info, name
#endif
return ALIGN_UP(SYMBOL_SIZE, 2);
}

2
src/runtime/print.c
View file

@ -491,7 +491,7 @@ static void print_slots(char **slots, int count, lispobj *ptr)
lispobj symbol_function(struct symbol* symbol)
{
if (symbol->fdefn) return FDEFN(symbol->fdefn)->fun;
if (symbol->fdefn && symbol->fdefn != NIL) return FDEFN(symbol->fdefn)->fun;
return NIL;
}

82
xperfecthash30.lisp-expr
View file

@ -902,5 +902,87 @@
(#(6CA905 214F79E 21FDBD3 11E3A7FE 19C62B17)
"(EQ EQL EQUAL CHAR= CHAR-EQUAL)"
"( (& (^ (>> val 1) (>> val 3)) 7))")
(#(69CB71D D01C0A4 1632420E 1AF8CC21)
"(NIL BASE-CHAR CHARACTER *)"
"( (& (>> val 9) 3) )")
(#(85FCC7A 1632420E 1A13A884 1CE6A754)
"(NIL FLOAT RATIONAL INTEGER)"
"( (& (>> val 3) 3) )")
(#(7C94100 F97347B 1632420E 1CFBBF28)
"(NIL :HEAD :TAIL :BOTH)"
"( (& (>> val 8) 3) )")
(#(10BC32E6 1632420E 1D1E3194 1F806395)
"(:SPECIAL-FORM :MACRO :FUNCTION NIL)"
"( (& (>> val 17) 3) )")
(#(5A6F13F 8064CC0 1632420E 195DE993)
"(NIL NOTINLINE MAYBE-INLINE INLINE)"
"( (& (>> val 3) 3) )")
(#(2020E66 87F29FB 10CE71A4 1632420E 1E40E977)
"(NIL :FORTHCOMING-DEFCLASS-TYPE :INSTANCE :DEFINED :PRIMITIVE)"
"( (& (- (>> val 8) (>> val 16)) 7))")
(#(2D9D746 B0FE826 162BDDB3 1632420E)
"(:AUTO :IMMOBILE :DYNAMIC NIL)"
"( (& (>> val 8) 3) )")
(#(121266F1 1632420E 19E4FB07 1ED4A3A6 1EECC275)
"(:DELETED :INITIAL :COMPLEX-TOPLEVEL :TOPLEVEL NIL)"
"( (& (- val (>> val 12)) 7))")
(#(946119B 107BA6B6 1632420E 17BE5DB2)
"(SB-C::INITIAL-UNUSED T SET NIL)"
"( (& (>> val 2) 3) )")
(#(36C1C1A A8F03FB AD1E8BA B2215A5 B9E470B E6153B7 121266F1 1316953C 16139847 1632420E 170F0B58 19E4FB07)
"(:TOPLEVEL-XEP :ZOMBIE :ASSIGNMENT :MV-LET :LET :CLEANUP :ESCAPE :TOPLEVEL :EXTERNAL :DELETED :OPTIONAL NIL)"
"((let ((tab #a((8) (unsigned-byte 8) 3 8 8 11 15 6 0 0)))
(let ((b (& (>> val 7) #x7)))
(let ((a (>> (<< val 5) 29)))
(^ a (aref tab b))))))")
(#(551F3D5 1632420E 17BE5DB2 1B68F328)
"(:COMPUTE-ONLY :FORCE-TO-STACK NIL T)"
"( (& (>> val 1) 3) )")
(#(3FF4B3 14EE526 3CEB7B0 563EB8C 1632420E)
"(:FIXED :KNOWN-RETURN :LOCAL-CALL :FULL-CALL NIL)"
"( (& (+ (>> val 9) (>> val 21)) 7))")
(#(38A0CEF 8DAFFE7 1632420E 169B6C84)
"(:UNSPECIFIC :WILD :NEWEST NIL)"
"( (& (- val (>> val 3)) 3) )")
(#(38A0CEF 68B5166 1632420E 169B6C84)
"(:UNC :WILD :UNSPECIFIC NIL)"
"( (& (>> val 6) 3) )")
(#(4A3C52B A5392C4 1565008D 15878D53 1632420E 1BB5BFF6)
"(:NAMED :PREDICATE :COPIER :CONSTRUCTOR :CONC-NAME NIL)"
"( (& (- (>> val 20) (>> val 22)) 7))")
(#(4D67BB1 C7690D3 D0845D9 10FD1211 15584644 1632420E 18AD9421 1EB82D24)
"(NIL :SUPERSEDE :APPEND :OVERWRITE :RENAME-AND-DELETE :RENAME :NEW-VERSION :ERROR)"
"( (& (+ (>> val 2) (>> val 19)) 7))")
(#(A8F03FB AD1E8BA B2215A5 1632420E)
"(NIL :ASSIGNMENT :OPTIONAL :CLEANUP)"
"( (& (>> val 8) 3) )")
(#(A8F03FB AD1E8BA B2215A5 16139847 1632420E)
"(NIL :ESCAPE :CLEANUP :OPTIONAL :ASSIGNMENT)"
"( (& (- (>> val 9) (>> val 17)) 7))")
(#(A8F03FB B2215A5 B9E470B 16139847 1632420E 19E4FB07)
"(:OPTIONAL :EXTERNAL :TOPLEVEL NIL :ESCAPE :CLEANUP)"
"( (& (^ (>> val 5) (>> val 25)) 7))")
(#(A8F03FB B2215A5 B9E470B 1632420E 19E4FB07)
"(NIL :EXTERNAL :OPTIONAL :TOPLEVEL :CLEANUP)"
"( (& (- (>> val 6) (>> val 15)) 7))")
(#(B570D6F 14792CA0 1632420E 1E362EC1 1EF7DF06)
"(:KEY-OR-VALUE :KEY-AND-VALUE :VALUE :KEY NIL)"
"( (& (- (>> val 8) (>> val 17)) 7))")
(#(7C94100 943F70E 1632420E 1956CA9B)
"(NIL :STRINGS :BOTH :SYMBOLS)"
"( (& (>> val 15) 3) )")
(#(32C5B45 5FDAE36 61DD4A0 DB99C7F 1547E84B 1632420E 1D73BD1E)
"(:VERSION :TYPE :NAME :DIRECTORY :DEVICE :HOST NIL)"
"( (& (- (>> val 24) (>> val 26)) 7))")
(#(85A9D0F B9E470B 1632420E 1FF36ED1)
"(NIL :INHERITED :EXTERNAL :INTERNAL)"
"( (& (>> val 21) 3) )")
(#(2668546 31DAFDC 5306AD9 6344932 706CB28 734DBFC C3DE2BA C6B04A8 D096A28 EEFFD62 15D901F3 16130C9E 1632420E 176FC723 1BCD5E7E
1C540056 1D1D1C45 1D68FF88)
"#(:BO-DNZF :BO-DNZFP :BO-DZF :BO-DZFP :BO-F :BO-FP NIL NIL :BO-DNZT :BO-DNZTP :BO-DZT :BO-DZTP :BO-T :BO-TP NIL NIL :BO-DNZ :BO-DNZP :BO-DZ :BO-DZP :BO-U NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)"
"((let ((tab #a((16) (unsigned-byte 8) 1 1 13 3 7 13 15 0 0 0 1 13 26 0 24 13)))
(let ((b (& (>> val 5) #xf)))
(let ((a (>> (<< val 7) 28)))
(^ a (aref tab b))))))")
)
;; EOF