Skip to content
Snippets Groups Projects
Commit ba71426a authored by pw's avatar pw
Browse files

Add support for FreeBSD-ELF systems (FreeBSD version 3.x and 4.x).

Based on a contribution from Fred Gilham. Conditionalized by
#+(and freebsd elf). A new version of library:load-foreign.csh is included
in this code as a comment.
parent 141c827a
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -57,7 +57,7 @@
(t (t
(incf code)))))))) (incf code))))))))
#+(or FreeBSD (and sparc (not svr4))) #+(or (and FreeBSD (not elf)) (and sparc (not svr4)))
(alien:def-alien-type exec (alien:def-alien-type exec
(alien:struct nil (alien:struct nil
(magic c-call:unsigned-long) (magic c-call:unsigned-long)
...@@ -81,10 +81,156 @@ ...@@ -81,10 +81,156 @@
(allocate-system-memory-at addr memory-needed) (allocate-system-memory-at addr memory-needed)
addr)) 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 ;;; 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 ;;; for correct file format so it may croak if ld fails to produce the
;;; expected results. It is probably good enough for now. ;;; 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) (defun load-object-file (name)
(format t ";;; Loading object file...~%") (format t ";;; Loading object file...~%")
(multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0) (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)
...@@ -103,6 +249,7 @@ ...@@ -103,6 +249,7 @@
(unix:unix-read fd addr len-of-text-and-data))) (unix:unix-read fd addr len-of-text-and-data)))
(unix:unix-close fd)))) (unix:unix-close fd))))
#+pmax #+pmax
(alien:def-alien-type filehdr (alien:def-alien-type filehdr
(alien:struct nil (alien:struct nil
...@@ -288,7 +435,7 @@ ...@@ -288,7 +435,7 @@
)) ))
(unix:unix-close fd)))) (unix:unix-close fd))))
#-(or linux solaris irix) #-(or linux solaris irix (and FreeBSD elf))
(defun parse-symbol-table (name) (defun parse-symbol-table (name)
(format t ";;; Parsing symbol table...~%") (format t ";;; Parsing symbol table...~%")
(let ((symbol-table (make-hash-table :test #'equal))) (let ((symbol-table (make-hash-table :test #'equal)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment