1.0.13.20: added SB-EXT:*EXIT-HOOKS*
[sbcl.git] / src / code / target-load.lisp
index ddfb683..ed607ff 100644 (file)
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB!IMPL")
+(in-package "SB!FASL")
 
-(file-comment
-  "$Header$")
-
-(defvar *load-source-types* '("lisp" "l" "cl" "lsp")
-  #!+sb-doc
-  "The source file types which LOAD recognizes.")
-
-(defvar *load-object-types*
-  '(#.sb!c:*backend-fasl-file-type*
-    #.(sb!c:backend-byte-fasl-file-type)
-    "fasl")
+(defvar *load-source-default-type* "lisp"
   #!+sb-doc
-  "A list of the object file types recognized by LOAD.")
-
-(declaim (list *load-source-types* *load-object-types*))
+  "The source file types which LOAD looks for by default.")
 
+(declaim (type (or pathname null) *load-truename* *load-pathname*))
 (defvar *load-truename* nil
   #!+sb-doc
   "the TRUENAME of the file that LOAD is currently loading")
-
 (defvar *load-pathname* nil
   #!+sb-doc
   "the defaulted pathname that LOAD is currently loading")
-
-(declaim (type (or pathname null) *load-truename* *load-pathname*))
 \f
-;;;; SLOLOAD
-
-;;; something not EQ to anything read from a file
-;;; FIXME: shouldn't be DEFCONSTANT; and maybe make a shared EOF cookie in
-;;; SB-INT:*EOF-VALUE*?
-(defconstant load-eof-value '(()))
+;;;; LOAD-AS-SOURCE
 
-;;; Load a text file.
-(defun sloload (stream verbose print)
-  (do-load-verbose stream verbose)
-  (do ((sexpr (read stream nil load-eof-value)
-             (read stream nil load-eof-value)))
-      ((eq sexpr load-eof-value)
+;;; Load a text file.  (Note that load-as-fasl is in another file.)
+(defun load-as-source (stream verbose print)
+  (maybe-announce-load stream verbose)
+  (do ((sexpr (read stream nil *eof-object*)
+              (read stream nil *eof-object*)))
+      ((eq sexpr *eof-object*)
        t)
     (if print
-       (let ((results (multiple-value-list (eval sexpr))))
-         (load-fresh-line)
-         (format t "~{~S~^, ~}~%" results))
-       (eval sexpr))))
+        (let ((results (multiple-value-list (eval sexpr))))
+          (load-fresh-line)
+          (format t "~{~S~^, ~}~%" results))
+      (eval sexpr))))
 \f
 ;;;; LOAD itself
 
-;;; a helper function for LOAD: Load the stuff in a file when we have the name.
-(defun internal-load (pathname truename if-does-not-exist verbose print
-                     &optional contents)
-  (declare (type (member nil :error) if-does-not-exist))
-  (unless truename
-    (if if-does-not-exist
-       (error 'simple-file-error
-              :pathname pathname
-              :format-control "~S does not exist."
-              :format-arguments (list (namestring pathname)))
-       (return-from internal-load nil)))
+(define-condition fasl-header-missing (invalid-fasl)
+  ((fhsss :reader invalid-fasl-fhsss :initarg :fhsss))
+  (:report
+   (lambda (condition stream)
+     (format stream "~@<File ~S has a fasl file type, but no fasl header:~%~
+                     Expected ~S, but got ~S.~:@>"
+             (invalid-fasl-stream condition)
+             (invalid-fasl-expected condition)
+             (invalid-fasl-fhsss condition)))))
 
-  (let ((*load-truename* truename)
-       (*load-pathname* pathname))
-    (case contents
-      (:source
-       (with-open-file (stream truename
-                              :direction :input
-                              :if-does-not-exist if-does-not-exist)
-        (sloload stream verbose print)))
-      (:binary
-       (with-open-file (stream truename
-                              :direction :input
-                              :if-does-not-exist if-does-not-exist
-                              :element-type '(unsigned-byte 8))
-        (fasload stream verbose print)))
-      (t
-       (let ((first-line (with-open-file (stream truename :direction :input)
-                          (read-line stream nil)))
-            (fhs sb!c:*fasl-header-string-start-string*))
-        (cond
-         ((and first-line
-               (>= (length (the simple-string first-line))
-                   (length fhs))
-               (string= first-line fhs :end1 (length fhs)))
-          (internal-load pathname truename if-does-not-exist verbose print
-                         :binary))
-         (t
-          (when (member (pathname-type truename)
-                        *load-object-types*
-                        :test #'string=)
-            (error "File has a fasl file type, but no fasl file header:~%  ~S"
-                   (namestring truename)))
-          (internal-load pathname truename if-does-not-exist verbose print
-                         :source))))))))
+;; Pretty well any way of doing LOAD will expose race conditions: for
+;; example, a file might get deleted or renamed after we open it but
+;; before we find its truename.  It seems useful to say that
+;; detectible ways the file system can fail to be static are good
+;; enough reason to stop loading, but to stop in a way that
+;; distinguishes errors that occur mid-way through LOAD from the
+;; initial failure to OPEN the file, so that handlers can try do
+;; defaulting only when the file didn't exist at the start of LOAD,
+;; while allowing race conditions to get through.
+(define-condition load-race-condition (error)
+  ((pathname :reader load-race-condition-pathname :initarg :pathname))
+  (:report (lambda (condition stream)
+             (format stream "~@<File ~S was deleted or renamed during LOAD.~:>"
+                     (load-race-condition-pathname condition)))))
 
-;;; a helper function for INTERNAL-LOAD-DEFAULT-TYPE
-(defun try-default-types (pathname types lp-type)
-  ;; Modified 18-Jan-97/pw for logical-pathname support.
-  ;;
-  ;; FIXME: How does logical-pathname support interact with
-  ;; *LOAD-SOURCE-TYPES* and *LOAD-OBJECT-TYPES*?
-  (flet ((frob (pathname type)
-          (let* ((pn (make-pathname :type type :defaults pathname))
-                 (tn (probe-file pn)))
-            (values pn tn))))
-    (if (typep pathname 'logical-pathname)
-       (frob pathname lp-type)
-       (dolist (type types (values nil nil))
-         (multiple-value-bind (pn tn) (frob pathname type)
-           (when tn
-             (return (values pn tn))))))))
+(defmacro resignal-race-condition (&body body)
+  `(handler-case (progn ,@body)
+     (file-error (error)
+       (error 'load-race-condition :pathname (file-error-pathname error)))))
 
-;;; a helper function for LOAD: Handle the case of INTERNAL-LOAD where the file
-;;; does not exist.
-(defun internal-load-default-type (pathname if-does-not-exist verbose print)
-  (declare (type (member nil :error) if-does-not-exist))
-  ;; FIXME: How do the fixed "LISP" and "FASL" types interact with the
-  ;; *LOAD-SOURCE-TYPES* and *LOAD-OBJECT-TYPES* values?
-  (multiple-value-bind (src-pn src-tn)
-      (try-default-types pathname *load-source-types* "LISP")
-    (multiple-value-bind (obj-pn obj-tn)
-       (try-default-types pathname *load-object-types* "FASL")
-      (cond
-       ((and obj-tn
-            src-tn
-            (> (file-write-date src-tn) (file-write-date obj-tn)))
-       (restart-case
-        (error "The object file ~A is~@
-               older than the presumed source:~%  ~A."
-               (namestring obj-tn)
-               (namestring src-tn))
-        ;; FIXME: In CMU CL one of these was a CONTINUE case.
-        ;; There's not one now. I don't remember how restart-case
-        ;; works very well, make sure that it doesn't do anything
-        ;; weird when we don't specify the CONTINUE case.
-        (source () :report "load source file"
-          (internal-load src-pn src-tn if-does-not-exist verbose print
-                         :source))
-        (object () :report "load object file"
-           (internal-load src-pn obj-tn if-does-not-exist verbose print
-                          :binary))))
-       (obj-tn
-       (internal-load obj-pn obj-tn if-does-not-exist verbose print :binary))
-       (src-pn
-       (internal-load src-pn src-tn if-does-not-exist verbose print :source))
-       (t
-       (internal-load pathname nil if-does-not-exist verbose print nil))))))
+;;; The following comment preceded the pre 1.0.12.36 definition of
+;;; LOAD; it may no longer be accurate:
 
-;;; This function mainly sets up special bindings and then calls sub-functions.
-;;; We conditionally bind the switches with PROGV so that people can set them
-;;; in their init files and have the values take effect. If the compiler is
-;;; loaded, we make the compiler-policy local to LOAD by binding it to itself.
-;;;
-;;; FIXME: ANSI specifies an EXTERNAL-FORMAT keyword argument.
-;;;
-;;; FIXME: Daniel Barlow's ilsb.tar ILISP-for-SBCL patches contain an
-;;; implementation of "DEFUN SOURCE-FILE" which claims, in a comment, that CMU
-;;; CL does not correctly record source file information when LOADing a
-;;; non-compiled file. Check whether this bug exists in SBCL and fix it if so.
-(defun load (filespec
-            &key
-            (verbose *load-verbose*)
-            (print *load-print*)
-            (if-does-not-exist t))
-  #!+sb-doc
-  "Loads the file given by FILESPEC into the Lisp environment, returning
-   T on success. These options are defined:
+;; FIXME: Daniel Barlow's ilsb.tar ILISP-for-SBCL patches contain an
+;; implementation of "DEFUN SOURCE-FILE" which claims, in a comment,
+;; that CMU CL does not correctly record source file information when
+;; LOADing a non-compiled file. Check whether this bug exists in SBCL
+;; and fix it if so.
 
-   :IF-DOES-NOT-EXIST
-       What should we do if the file can't be located? If true (the
-       default), signal an error. If NIL, simply return NIL.
+;;; This is our real LOAD.  The LOAD below is just a wrapper that does
+;;; some defaulting in case the user asks us to load a file that
+;;; doesn't exist at the time we start.
+(defun %load (pathspec &key (verbose *load-verbose*) (print *load-print*)
+              (if-does-not-exist t) (external-format :default))
+  (when (streamp pathspec)
+    (let* ( ;; Bindings required by ANSI.
+           (*readtable* *readtable*)
+           (*package* (sane-package))
+           ;; FIXME: we should probably document the circumstances
+           ;; where *LOAD-PATHNAME* and *LOAD-TRUENAME* aren't
+           ;; pathnames during LOAD.  ANSI makes no exceptions here.
+           (*load-pathname* (handler-case (pathname pathspec)
+                              ;; FIXME: it should probably be a type
+                              ;; error to try to get a pathname for a
+                              ;; stream that doesn't have one, but I
+                              ;; don't know if we guarantee that.
+                              (error () nil)))
+           (*load-truename* (when *load-pathname*
+                              (handler-case (truename *load-pathname*)
+                                (file-error () nil))))
+           ;; Bindings used internally.
+           (*load-depth* (1+ *load-depth*))
+           ;; KLUDGE: I can't find in the ANSI spec where it says
+           ;; that DECLAIM/PROCLAIM of optimization policy should
+           ;; have file scope. CMU CL did this, and it seems
+           ;; reasonable, but it might not be right; after all,
+           ;; things like (PROCLAIM '(TYPE ..)) don't have file
+           ;; scope, and I can't find anything under PROCLAIM or
+           ;; COMPILE-FILE or LOAD or OPTIMIZE which justifies this
+           ;; behavior. Hmm. -- WHN 2001-04-06
+           (sb!c::*policy* sb!c::*policy*))
+      (return-from %load
+        (if (equal (stream-element-type pathspec) '(unsigned-byte 8))
+            (load-as-fasl pathspec verbose print)
+            (load-as-source pathspec verbose print)))))
+  ;; If we're here, PATHSPEC isn't a stream, so must be some other
+  ;; kind of pathname designator.
+  (with-open-file (stream pathspec
+                          :element-type '(unsigned-byte 8)
+                          :if-does-not-exist
+                          (if if-does-not-exist :error nil))
+    (unless stream
+      (return-from %load nil))
+    (let* ((header-line (make-array
+                         (length *fasl-header-string-start-string*)
+                         :element-type '(unsigned-byte 8))))
+      (read-sequence header-line stream)
+      (if (mismatch header-line *fasl-header-string-start-string*
+                    :test #'(lambda (code char) (= code (char-code char))))
+          (let ((truename (resignal-race-condition (probe-file stream))))
+            (when (and truename
+                       (string= (pathname-type truename) *fasl-file-type*))
+              (error 'fasl-header-missing
+                     :stream (namestring truename)
+                     :fhsss header-line
+                     :expected *fasl-header-string-start-string*)))
+          (progn
+            (file-position stream :start)
+            (return-from %load
+              (%load stream :verbose verbose :print print))))))
+  ;; Because we're just opening for input, we don't need
+  ;; WITH-OPEN-FILE's abort handling semantics, and we want to say
+  ;; it's an error for PATHSPEC to have existed before but not now, so
+  ;; WITH-OPEN-STREAM it is.
+  (with-open-stream (stream (resignal-race-condition
+                              (open pathspec
+                                    :external-format external-format)))
+    (%load stream :verbose verbose :print print)))
 
-   :VERBOSE
-       If true, print a line describing each file loaded. The default
-       is *LOAD-VERBOSE*.
-
-   :PRINT
-       If true, print information about loaded values. When loading the
-       source, the result of evaluating each top-level form is printed.
-       The default is *LOAD-PRINT*."
+;; Given a simple %LOAD like the above, one can implement any
+;; particular defaulting strategy with a wrapper like this one:
+(defun load (pathspec &key (verbose *load-verbose*) (print *load-print*)
+            (if-does-not-exist :error) (external-format :default))
+  #!+sb-doc
+  "Load the file given by FILESPEC into the Lisp environment, returning
+   T on success."
+  (handler-bind ((file-error
+                  #'(lambda (error)
+                      ;; This handler will run if %LOAD failed to OPEN
+                      ;; the file to look for a fasl header.
+                      (let ((pathname (file-error-pathname error)))
+                        ;; As PROBE-FILE returned NIL, the file
+                        ;; doesn't exist.  If the filename we tried to
+                        ;; open lacked a type, try loading a filename
+                        ;; determined by our defaulting.
+                        (when (null (handler-case (probe-file pathname)
+                                      (file-error (error) error)))
+                          (when (null (pathname-type pathname))
+                            (let ((default (probe-load-defaults pathname)))
+                              (when default
+                                (return-from load
+                                  (resignal-race-condition
+                                    (%load default
+                                           :verbose verbose
+                                           :print print
+                                           :external-format
+                                           external-format
+                                           :if-does-not-exist
+                                           if-does-not-exist))))))))
+                      ;; If we're here, one of three things happened:
+                      ;; (1) %LOAD errored and PROBE-FILE succeeded,
+                      ;; in which case the file must be a bad symlink,
+                      ;; unreadable, or it was created between %LOAD
+                      ;; and PROBE-FILE; (2) %LOAD errored and
+                      ;; PROBE-FILE errored, and so things are amiss
+                      ;; in the file system (albeit possibly
+                      ;; differently now than when OPEN errored); (3)
+                      ;; our defaulting did not find a file.  In any
+                      ;; of these cases, decline to handle the
+                      ;; original error or return NIL, depending on
+                      ;; IF-DOES-NOT-EXIST.
+                      (if if-does-not-exist
+                          nil
+                          (return-from load nil)))))
+    (%load pathspec :verbose verbose :print print
+           :external-format external-format)))
 
-  (let ((sb!c::*default-cookie* sb!c::*default-cookie*)
-       (sb!c::*default-interface-cookie* sb!c::*default-interface-cookie*)
-       (*package* *package*)
-       (*readtable* *readtable*)
-       (*load-depth* (1+ *load-depth*))
-       ;; The old CMU CL LOAD function used an IF-DOES-NOT-EXIST argument of
-       ;; (MEMBER :ERROR NIL) type. ANSI constrains us to accept a generalized
-       ;; boolean argument value for this externally-visible function, but the
-       ;; internal functions still use the old convention.
-       (internal-if-does-not-exist (if if-does-not-exist :error nil)))
-    ;; FIXME: This VALUES wrapper is inherited from CMU CL.
-    ;; Once SBCL gets function return type checking right, we can
-    ;; achieve a similar effect better by adding FTYPE declarations.
-    (values
-     (if (streamp filespec)
-        (if (or (equal (stream-element-type filespec)
-                       '(unsigned-byte 8)))
-            (fasload filespec verbose print)
-            (sloload filespec verbose print))
-        (let ((pn (merge-pathnames (pathname filespec)
-                                   *default-pathname-defaults*)))
-          (if (wild-pathname-p pn)
-              (let ((files (directory pn)))
-                #!+high-security
-                (when (null files)
-                  (error 'file-error :pathname filespec))
-                (dolist (file files t)
-                  (internal-load pn
-                                 file
-                                 internal-if-does-not-exist
-                                 verbose
-                                 print)))
-              (let ((tn (probe-file pn)))
-                (if (or tn (pathname-type pn))
-                    (internal-load pn
-                                   tn
-                                   internal-if-does-not-exist
-                                   verbose
-                                   print)
-                    (internal-load-default-type
-                     pn
-                     internal-if-does-not-exist
-                     verbose
-                     print)))))))))
+;; This implements the defaulting SBCL seems to have inherited from
+;; CMU.  This routine does not try to perform any loading; all it does
+;; is return the pathname (not the truename) of a file to be loaded,
+;; or NIL if no such file can be found.  This routine is supposed to
+;; signal an error if a fasl's timestamp is older than its source
+;; file, but we protect against errors in PROBE-FILE, because any of
+;; the ways that we might fail to find a defaulted file are reasons
+;; not to load it, but not worth exposing to the user who didn't
+;; expicitly ask us to load a file with a made-up name (e.g., the
+;; defaulted filename might exceed filename length limits).
+(defun probe-load-defaults (pathname)
+  (destructuring-bind (defaulted-source-pathname
+                       defaulted-source-truename
+                       defaulted-fasl-pathname
+                       defaulted-fasl-truename)
+      (loop for type in (list *load-source-default-type*
+                              *fasl-file-type*)
+            as probe-pathname = (make-pathname :type type
+                                               :defaults pathname)
+            collect probe-pathname
+            collect (handler-case (probe-file probe-pathname)
+                      (file-error () nil)))
+    (cond ((and defaulted-fasl-truename
+                defaulted-source-truename
+                (> (resignal-race-condition
+                     (file-write-date defaulted-source-truename))
+                   (resignal-race-condition
+                     (file-write-date defaulted-fasl-truename))))
+           (restart-case
+               (error "The object file ~A is~@
+                       older than the presumed source:~%  ~A."
+                      defaulted-fasl-truename
+                      defaulted-source-truename)
+             (source () :report "load source file"
+                     defaulted-source-pathname)
+             (object () :report "load object file"
+                     defaulted-fasl-pathname)))
+          (defaulted-fasl-truename defaulted-fasl-pathname)
+          (defaulted-source-truename defaulted-source-pathname))))
 \f
 ;;; Load a code object. BOX-NUM objects are popped off the stack for
 ;;; the boxed storage section, then SIZE bytes of code are read in.
   (declare (fixnum box-num code-length))
   (with-fop-stack t
     (let ((code (%primitive sb!c:allocate-code-object box-num code-length))
-         (index (+ #!-gengc sb!vm:code-trace-table-offset-slot
-                   #!+gengc sb!vm:code-debug-info-slot
-                   box-num)))
+          (index (+ sb!vm:code-trace-table-offset-slot box-num)))
       (declare (type index index))
-      #!-gengc (setf (%code-debug-info code) (pop-stack))
+      (setf (%code-debug-info code) (pop-stack))
       (dotimes (i box-num)
-       (declare (fixnum i))
-       (setf (code-header-ref code (decf index)) (pop-stack)))
+        (declare (fixnum i))
+        (setf (code-header-ref code (decf index)) (pop-stack)))
       (sb!sys:without-gcing
-       (read-n-bytes *fasl-file*
-                     (code-instructions code)
-                     0
-                     #!-gengc code-length
-                     #!+gengc (* code-length sb!vm:word-bytes)))
+        (read-n-bytes *fasl-input-stream*
+                      (code-instructions code)
+                      0
+                      code-length))
       code)))
 
+;;; Moving native code during a GC or purify is not so trivial on the
+;;; x86 port.
+;;;
+;;; Our strategy for allowing the loading of x86 native code into the
+;;; dynamic heap requires that the addresses of fixups be saved for
+;;; all these code objects. After a purify these fixups can be
+;;; dropped. In CMU CL, this policy was enabled with
+;;; *ENABLE-DYNAMIC-SPACE-CODE*; in SBCL it's always used.
 #!+x86
 (defun load-code (box-num code-length)
   (declare (fixnum box-num code-length))
   (with-fop-stack t
     (let ((stuff (list (pop-stack))))
       (dotimes (i box-num)
-       (declare (fixnum i))
-       (push (pop-stack) stuff))
-      (let* ((dbi (car (last stuff)))  ; debug-info
-            (tto (first stuff))        ; trace-table-offset
-            (load-to-dynamic-space
-             (or *enable-dynamic-space-code*
-                 ;; definitely byte-compiled code?
-                 (and *load-byte-compiled-code-to-dynamic-space*
-                      (sb!c::debug-info-p dbi)
-                      (not (sb!c::compiled-debug-info-p dbi)))
-                 ;; or a x86 top level form?
-                 (and *load-x86-tlf-to-dynamic-space*
-                      (sb!c::compiled-debug-info-p dbi)
-                      (string= (sb!c::compiled-debug-info-name dbi)
-                               "top-level form")))) )
+        (declare (fixnum i))
+        (push (pop-stack) stuff))
+      (let* ((dbi (car (last stuff)))   ; debug-info
+             (tto (first stuff)))       ; trace-table-offset
 
-       (setq stuff (nreverse stuff))
+        (setq stuff (nreverse stuff))
 
-       ;; Check that tto is always a list for byte-compiled
-       ;; code. Could be used an alternate check.
-       (when (and (typep tto 'list)
-                  (not (and (sb!c::debug-info-p dbi)
-                            (not (sb!c::compiled-debug-info-p dbi)))))
-         ;; FIXME: What is this for?
-         (format t "* tto list on non-bc code: ~S~% ~S ~S~%"
-                 stuff dbi tto))
-       
-       ;; FIXME: *LOAD-CODE-VERBOSE* should probably be #!+SB-SHOW.
-       (when *load-code-verbose*
-             (format t "stuff: ~S~%" stuff)
-             (format t
-                     "   : ~S ~S ~S ~S~%"
-                     (sb!c::compiled-debug-info-p dbi)
-                     (sb!c::debug-info-p dbi)
-                     (sb!c::compiled-debug-info-name dbi)
-                     tto)
-             (if load-to-dynamic-space
-                 (format t "   loading to the dynamic space~%")
-                 (format t "   loading to the static space~%")))
+        ;; FIXME: *LOAD-CODE-VERBOSE* should probably be #!+SB-SHOW.
+        (when *load-code-verbose*
+              (format t "stuff: ~S~%" stuff)
+              (format t
+                      "   : ~S ~S ~S ~S~%"
+                      (sb!c::compiled-debug-info-p dbi)
+                      (sb!c::debug-info-p dbi)
+                      (sb!c::compiled-debug-info-name dbi)
+                      tto)
+              (format t "   loading to the dynamic space~%"))
 
-       (let ((code
-              (if load-to-dynamic-space
-                  (%primitive sb!c:allocate-dynamic-code-object
-                              box-num
-                              code-length)
-                  (%primitive sb!c:allocate-code-object
-                              box-num
-                              code-length)))
-             (index (+ sb!vm:code-trace-table-offset-slot box-num)))
-         (declare (type index index))
-         (when *load-code-verbose*
-           (format t
-                   "  obj addr=~X~%"
-                   (sb!kernel::get-lisp-obj-address code)))
-         (setf (%code-debug-info code) (pop stuff))
-         (dotimes (i box-num)
-           (declare (fixnum i))
-           (setf (code-header-ref code (decf index)) (pop stuff)))
-         (sb!sys:without-gcing
-          (read-n-bytes *fasl-file* (code-instructions code) 0 code-length))
-         code)))))
+        (let ((code (%primitive sb!c:allocate-code-object
+                                box-num
+                                code-length))
+              (index (+ sb!vm:code-trace-table-offset-slot box-num)))
+          (declare (type index index))
+          (when *load-code-verbose*
+            (format t
+                    "  obj addr=~X~%"
+                    (sb!kernel::get-lisp-obj-address code)))
+          (setf (%code-debug-info code) (pop stuff))
+          (dotimes (i box-num)
+            (declare (fixnum i))
+            (setf (code-header-ref code (decf index)) (pop stuff)))
+          (sb!sys:without-gcing
+           (read-n-bytes *fasl-input-stream*
+                         (code-instructions code)
+                         0
+                         code-length))
+          code)))))
 \f
 ;;;; linkage fixups
 
-;;; how we learn about assembler routines and foreign symbols at startup
+;;; how we learn about assembler routines at startup
 (defvar *!initial-assembler-routines*)
-(defvar *!initial-foreign-symbols*)
+
 (defun !loader-cold-init ()
+  (/show0 "/!loader-cold-init")
   (dolist (routine *!initial-assembler-routines*)
-    (setf (gethash (car routine) *assembler-routines*) (cdr routine)))
-  (dolist (symbol *!initial-foreign-symbols*)
-    (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))))
-
-(declaim (ftype (function (string) sb!vm:word) foreign-symbol-address-as-integer))
-(defun foreign-symbol-address-as-integer (foreign-symbol)
-  (or (gethash foreign-symbol *static-foreign-symbols*)
-      (gethash (concatenate 'simple-string
-                           #!+linux "ldso_stub__"
-                           #!+openbsd "_"
-                           #!+freebsd ""
-                           foreign-symbol)
-              *static-foreign-symbols*)
-      (sb!sys:get-dynamic-foreign-symbol-address foreign-symbol)
-      (error "unknown foreign symbol: ~S" foreign-symbol)))
-
-(defun foreign-symbol-address (symbol)
-  (int-sap (foreign-symbol-address-as-integer (sb!vm:extern-alien-name symbol))))
+    (setf (gethash (car routine) *assembler-routines*) (cdr routine))))