diff --git a/code/foreign.lisp b/code/foreign.lisp
index e6bafcd93069bb783c21e321616d8981daaf11c4..99282bb108baf644c7293f6bde0759d5170c9140 100644
--- a/code/foreign.lisp
+++ b/code/foreign.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.52 2005/07/07 14:45:37 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.53 2005/09/21 11:32:43 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -241,21 +241,94 @@
 (defconstant mh-bundle        #x8)
 (defconstant mh-dylib-stub    #x9)
 
+;;; Support for loading multi-arch ("fat") shared libraries.
+(alien:def-alien-type fat-header
+  (alien:struct nil
+    (magic       (alien:unsigned 32))
+    (nfat-arch   (alien:unsigned 32))))
+
+(alien:def-alien-type fat-arch
+  (alien:struct nil
+    (cputype     (alien:signed 32))
+    (cpusubtype  (alien:signed 32))
+    (offset      (alien:unsigned 32))
+    (size        (alien:unsigned 32))
+    (align       (alien:unsigned 32))))
+
+(defconstant fat-header-magic #xcafebabe)
+
 (defun mach-o-p (h)
   "Make sure the header starts with the mach-o magic value."
   (eql (alien:slot h 'magic) mh-magic))
 
+;;; Read an unsigned 32-bit big-endian number from STREAM.
+(defun read-u32-be (stream)
+  (let ((n 0))
+    (setf (ldb (byte 8 24) n) (read-byte stream))
+    (setf (ldb (byte 8 16) n) (read-byte stream))
+    (setf (ldb (byte 8 8)  n) (read-byte stream))
+    (setf (ldb (byte 8 0)  n) (read-byte stream))
+    n))
+
+;;; Read the 32-bit magic number from STREAM then rewind it.
+(defun read-object-file-magic (stream)
+  (let ((pos (file-position stream)))
+    (prog1
+        (read-u32-be stream)
+      (file-position stream pos))))
+
+;;; XXX For a Darwin/x86 port, these functions will need to swap the
+;;; byte order of the structure members. Apple's documentation states
+;;; that all the fields of FAT-HEADER and FAT-ARCH are big-endian.
+(defun read-mach-header (stream sap)
+  (unix:unix-read (lisp::fd-stream-fd stream) sap
+                  (alien:alien-size machheader :bytes)))
+
+(defun read-fat-header (stream sap)
+  (unix:unix-read (lisp::fd-stream-fd stream) sap
+                  (alien:alien-size fat-header :bytes)))
+
+(defun read-fat-arch (stream sap)
+  (unix:unix-read (lisp::fd-stream-fd stream) sap
+                  (alien:alien-size fat-arch :bytes)))
+
+;;; Return a list of offsets in STREAM which contain Mach-O headers.
+;;; For single-architecture binaries, this will return (0), emulating
+;;; the previous behavior of loading the header from the start of the
+;;; file.  For fat binaries, there will be one offset in the result
+;;; list for each architecture present in the file.
+(defun read-mach-header-offsets (stream)
+  (let ((magic (read-object-file-magic stream)))
+    (cond ((eql magic mh-magic)
+           (list 0))
+          ((eql magic fat-header-magic)
+           (alien:with-alien ((fat-header fat-header)
+                              (fat-arch fat-arch))
+             (read-fat-header stream (alien:alien-sap fat-header))
+             (loop
+                for i from 0 below (alien:slot fat-header 'nfat-arch)
+                do (read-fat-arch stream (alien:alien-sap fat-arch))
+                collect (alien:slot fat-arch 'offset))))
+          (t nil))))
+
+;;; Return true if the Mach-O HEADER represents a shared library.
+(defun shared-mach-header-p (header)
+  (and (eql (alien:slot header 'magic) mh-magic)
+       (or (eql (alien:slot header 'filetype) mh-dylib)
+           (eql (alien:slot header 'filetype) mh-bundle))))
+
 (defun file-shared-library-p (pathname)
   (with-open-file (obj pathname
                        :direction :input
                        :element-type '(unsigned-byte 8))
-    (let ((fd (lisp::fd-stream-fd obj)))
-      (alien:with-alien ((header machheader))
-        (unix:unix-read fd (alien:alien-sap header)
-	                (alien:alien-size machheader :bytes))
-        (when (mach-o-p header)
-	  (or (eql mh-dylib (alien:slot header 'filetype))
-	      (eql mh-bundle (alien:slot header 'filetype))))))))
+    (let ((offsets (read-mach-header-offsets obj)))
+      (when offsets
+        (alien:with-alien ((header machheader))
+          (loop
+             for offset in offsets
+             do (file-position obj offset)
+                (read-mach-header obj (alien:alien-sap header))
+             thereis (shared-mach-header-p header)))))))
 ) ; #+darwin