1.0.45.10: tools-for-build/Makefile path fixes

[sbcl.git] / src / compiler / generic / genesis.lisp

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index de143e5..fac1eb4 100644 (file)
--- 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,6 +1598,13 @@ 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
+                  ;; _function but dlsym expects us to look up
+                  ;; function, without the leading _ . Therefore, we
+                  ;; strip it off here.
+                  #!+darwin
+                  (when (equal (char name 0) #\_)
+                    (setf name (subseq name 1)))
                   (multiple-value-bind (old-value found)
                       (gethash name *cold-foreign-symbol-table*)
                     (when (and found
@@ -1604,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)
@@ -1933,8 +1953,6 @@ core and return a descriptor to it."
   ;; modified.
   (copy-seq *fop-funs*))
 
-(defvar *normal-fop-funs*)
-
 ;;; Cause a fop to have a special definition for cold load.
 ;;;
 ;;; This is similar to DEFINE-FOP, but unlike DEFINE-FOP, this version
@@ -1978,8 +1996,7 @@ core and return a descriptor to it."
 (defun cold-load (filename)
   #!+sb-doc
   "Load the file named by FILENAME into the cold load image being built."
-  (let* ((*normal-fop-funs* *fop-funs*)
-         (*fop-funs* *cold-fop-funs*)
+  (let* ((*fop-funs* *cold-fop-funs*)
          (*cold-load-filename* (etypecase filename
                                  (string filename)
                                  (pathname (namestring filename)))))
@@ -1996,15 +2013,6 @@ core and return a descriptor to it."
 (define-cold-fop (fop-empty-list) nil)
 (define-cold-fop (fop-truth) t)
 
-(define-cold-fop (fop-normal-load :stackp nil)
-  (setq *fop-funs* *normal-fop-funs*))
-
-(define-fop (fop-maybe-cold-load 82 :stackp nil)
-  (when *cold-load-filename*
-    (setq *fop-funs* *cold-fop-funs*)))
-
-(define-cold-fop (fop-maybe-cold-load :stackp nil))
-
 (clone-cold-fop (fop-struct)
                 (fop-small-struct)
   (let* ((size (clone-arg))