X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=fac1eb4e4bb49438cb05bba6f618ec0bf0943031;hb=2e5263a05f55e2b56a3194ad7853e9ae18ad69af;hp=bfea5daa338fbc9d19d64da27b6a3ba28e201c4d;hpb=bd2df60f7c3f579a9c7610925c79a0e783adaa0e;p=sbcl.git diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index bfea5da..fac1eb4 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -936,6 +936,7 @@ core and return a descriptor to it." (cold-set-layout-slot result 'info *nil-descriptor*) (cold-set-layout-slot result 'pure *nil-descriptor*) (cold-set-layout-slot result 'n-untagged-slots nuntagged) + (cold-set-layout-slot result 'source-location *nil-descriptor*) (cold-set-layout-slot result 'for-std-class-p *nil-descriptor*) (setf (gethash name *cold-layouts*) @@ -1597,11 +1598,11 @@ core and return a descriptor to it." (subseq line (1+ p2))) (values (parse-integer line :end p1 :radix 16) (subseq line (1+ p2)))) - ; KLUDGE CLH 2010-05-31: on darwin, nm gives us + ;; KLUDGE CLH 2010-05-31: on darwin, nm gives us ;; _function but dlsym expects us to look up ;; function, without the leading _ . Therefore, we ;; strip it off here. - #!+(and darwin (not dlshim)) + #!+darwin (when (equal (char name 0) #\_) (setf name (subseq name 1))) (multiple-value-bind (old-value found) @@ -1611,7 +1612,19 @@ core and return a descriptor to it." (warn "redefining ~S from #X~X to #X~X" name old-value value))) (/show "adding to *cold-foreign-symbol-table*:" name value) - (setf (gethash name *cold-foreign-symbol-table*) value)))))) + (setf (gethash name *cold-foreign-symbol-table*) value) + #!+win32 + (let ((at-position (position #\@ name))) + (when at-position + (let ((name (subseq name 0 at-position))) + (multiple-value-bind (old-value found) + (gethash name *cold-foreign-symbol-table*) + (when (and found + (not (= old-value value))) + (warn "redefining ~S from #X~X to #X~X" + name old-value value))) + (setf (gethash name *cold-foreign-symbol-table*) + value))))))))) (values)) ;; PROGN (defun cold-foreign-symbol-address (name)