diff --git a/code/foreign.lisp b/code/foreign.lisp
index af6302229ed709c84d883aa108e3f8452f6fe907..45066365800dd5b4e96dd601995953504d3e95ca 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.29 1998/08/30 04:56:49 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.30 2000/04/19 11:33:13 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -57,7 +57,7 @@
 		(t
 		 (incf code))))))))
 
-#+(or FreeBSD (and sparc (not svr4)))
+#+(or (and FreeBSD (not elf)) (and sparc (not svr4)))
 (alien:def-alien-type exec
   (alien:struct nil
     (magic c-call:unsigned-long)
@@ -81,10 +81,156 @@
     (allocate-system-memory-at addr memory-needed)
     addr))
 
+
+;;;
+;;;  Elf object file loading for statically linked CMUCL under
+;;;  FreeBSD.
+;;;
+;;; The following definitions are taken from
+;;; /usr/include/sys/elf_common.h and /usr/include/sys/elf32.h.
+;;;
+#+(and FreeBSD elf)
+(progn
+(alien:def-alien-type elf-address      (alien:unsigned 32))
+(alien:def-alien-type elf-half-word    (alien:unsigned 16))
+(alien:def-alien-type elf-offset       (alien:unsigned 32))
+(alien:def-alien-type elf-signed-word  (alien:integer  32))
+(alien:def-alien-type elf-word         (alien:unsigned 32))
+(alien:def-alien-type elf-size         (alien:unsigned 32))
+
+(alien:def-alien-type eheader
+    ;;"Elf file header."
+  (alien:struct nil
+    (elf-ident                      (alien:array (alien:unsigned 8) 16))
+    (elf-type                        elf-half-word)
+    (elf-machine                     elf-half-word)
+    (elf-version                     elf-word)
+    (elf-entry                       elf-address)
+    (elf-program-header-offset       elf-offset)
+    (elf-section-header-offset       elf-offset)
+    (elf-flags                       elf-word)
+    (elf-header-size                 elf-half-word)
+    (elf-program-header-entry-size   elf-half-word)
+    (elf-program-header-count        elf-half-word)
+    (elf-section-header-entry-size   elf-half-word)
+    (elf-section-header-count        elf-half-word)
+    (elf-section-name-strings        elf-half-word)))
+
+;; values for elf-type
+(defconstant et-relocatable   1)
+(defconstant et-executable    2)
+(defconstant et-shared-object 3)
+(defconstant et-core-file     4)
+
+(alien:def-alien-type pheader
+;;"Program header."
+  (alien:struct nil
+    (p-type             elf-word)      ; Entry type.
+    (p-offset           elf-offset)    ; File offset of contents.
+    (p-virtual-address  elf-address)   ; Virtual address in mem. image.
+    (p-physical-address elf-address)   ; Physical address (not used).
+    (p-file-size        elf-size)      ; Size of contents in file.
+    (p-memory-size      elf-size)      ; Size of contents in memory.
+    (p-flags            elf-word)      ; Access permission flags.
+    (p-alignment        elf-size)))    ; Alignment in memory and file.
+
+(defconstant +elf-magic+
+  (make-array 4 :element-type '(unsigned-byte 8)
+	        :initial-contents '(127 69 76 70))) ; 0x7f-E-L-F
+(defun elf-p (h)
+  "Make sure the header starts with the ELF magic value."
+  (dotimes (i 4 t)
+    (unless (= (alien:deref h i) (aref +elf-magic+ i))
+      (return nil))))
+
+(defun elf-brand (h)
+  "Return the `brand' in the padding of the ELF file."
+  (let ((return (make-string 8 :initial-element #\space)))
+    (dotimes (i 8 return)
+      (let ((code (alien:deref h (+ i 8))))
+	(unless (= code 0)
+	  (setf (aref return i) (code-char code)))))))
+
+(defun elf-executable-p (n)
+  "Given a file type number, determine if the file is executable."
+  (= n et-executable))
+
+(defun load-object-file (name)
+  ;; NAME designates a tempory file created by ld via "load-foreign.csh".
+  ;; Its contents are in a form suitable for stuffing into memory for
+  ;; execution. This function extracts the location and size of the
+  ;; relevant bits and reads them into memory.
+
+  #|| library:load-foreign.csh
+  #!/bin/csh -fx
+  ld -N -R $argv[1] -Ttext $argv[2] -o $argv[3] $argv[5-]
+  if ($status != 0) exit 1
+
+  nm -gp $argv[3] > $argv[4]
+  if ($status != 0) exit 2
+  exit 0
+  ||#
+
+  (format t ";;; Loading object file...~%")
+  (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)
+    (unless fd
+      (error "Could not open ~S: ~A" name (unix:get-unix-error-msg errno)))
+    (unwind-protect
+	(alien:with-alien ((header eheader))
+	  (unix:unix-read fd
+			  (alien:alien-sap header)
+			  (alien:alien-size eheader :bytes))
+	  (unless (elf-p (alien:slot header 'elf-ident))
+	      (error (format nil "~A is not an ELF file." name)))
+
+	  (let ((brand (elf-brand (alien:slot header 'elf-ident))))
+	    (unless (string= brand "FreeBSD" :end1 6 :end2 6)
+	      (error (format nil "~A is not a FreeBSD executable. Brand: ~A"
+			     name brand))))
+
+	  (unless (elf-executable-p (alien:slot header 'elf-type))
+	    (error (format nil "~A is not executable." name)))
+	  
+	  (alien:with-alien ((program-header pheader))
+	    (unix:unix-read fd
+			    (alien:alien-sap program-header)
+			    (alien:alien-size pheader :bytes))
+	    (let* ((addr (system::allocate-space-in-foreign-segment
+			  (alien:slot program-header 'p-memory-size))))
+	      (unix:unix-lseek
+	       fd (alien:slot program-header 'p-offset) unix:l_set)
+	      (unix:unix-read
+	       fd addr (alien:slot program-header 'p-file-size)))))      
+      (unix:unix-close fd))))
+
+(defun parse-symbol-table (name)
+  "Parse symbol table file created by load-foreign script.  Modified
+to skip undefined symbols which don't have an address."
+  (format t ";;; Parsing symbol table...~%")
+  (let ((symbol-table (make-hash-table :test #'equal)))
+    (with-open-file (file name)
+      (loop
+	(let ((line (read-line file nil nil)))
+	  (unless line
+	    (return))
+	  (unless (eql (aref line 0) #\space)   ; Skip undefined symbols....
+	    (let* ((symbol (subseq line 11))
+		   (address (parse-integer line :end 8 :radix 16))
+		   #+FreeBSD (kind (aref line 9))	; filter out .o file names
+		   (old-address (gethash symbol lisp::*foreign-symbols*)))
+	      (unless (or (null old-address) (= address old-address)
+			  #+FreeBSD (char= kind #\F))
+		(warn "~S moved from #x~8,'0X to #x~8,'0X.~%"
+		      symbol old-address address))
+	      (setf (gethash symbol symbol-table) address))))))
+    (setf lisp::*foreign-symbols* symbol-table)))
+)
+
+
 ;;; pw-- This seems to work for FreeBSD. The MAGIC field is not tested
 ;;; for correct file format so it may croak if ld fails to produce the
 ;;; expected results. It is probably good enough for now.
-#+(or FreeBSD (and sparc (not svr4)))
+#+(or (and FreeBSD (not ELF)) (and sparc (not svr4)))
 (defun load-object-file (name)
   (format t ";;; Loading object file...~%")
   (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)
@@ -103,6 +249,7 @@
 	    (unix:unix-read fd addr len-of-text-and-data)))
       (unix:unix-close fd))))
 
+
 #+pmax
 (alien:def-alien-type filehdr
   (alien:struct nil
@@ -288,7 +435,7 @@
             ))
       (unix:unix-close fd))))
 
-#-(or linux solaris irix)
+#-(or linux solaris irix (and FreeBSD elf))
 (defun parse-symbol-table (name)
   (format t ";;; Parsing symbol table...~%")
   (let ((symbol-table (make-hash-table :test #'equal)))