Skip to content
Snippets Groups Projects
Commit 956ce339 authored by pmai's avatar pmai
Browse files

Changed the OpenBSD port to use dlopen+ld for FFI linkage, like

current Linux and FreeBSD/ELF do, although OpenBSD is still non-ELF.
Also changed the handling of leading underscores in alien names, by
moving the underscore addition to extern-alien-name, where it belongs,
and not foreign-symbol-address-aux.  This brings the x86 port in line
with the other ports, modulo the PVE_stub_ magic.  The changes
necessitate some bootstrapping code for BSD non-ELF platforms.
parent 48cccfec
No related branches found
No related tags found
No related merge requests found
;;; This file bootstraps the changes in extern-alien-name, which
;;; brings the x86 handling of underscores on non-ELF systems in
;;; line with other ports, by moving the underscore addition to
;;; extern-alien-name, where it belongs, and not f-s-a-aux.
;;; This also makes foreign linking work better on OpenBSD.
;;;
#+x86
(in-package "LISP")
#+x86
(defun foreign-symbol-address-aux (symbol)
(multiple-value-bind
(value found)
(gethash symbol *foreign-symbols* 0)
;; can't make irix linker give values in the symbol table to global vars
;;from dsos, so we have to resolve at runtime (and handle symbols being
;;defined with null values)
(if #-irix found #+irix (and found (not (zerop value)))
value
(let ((value (system:alternate-get-global-address symbol)))
(when (zerop value)
(error "Unknown foreign symbol: ~S" symbol))
value))))
#+x86
(in-package "X86")
#+x86
(defun extern-alien-name (name)
(declare (type simple-string name))
#+(and bsd (not elf))
(concatenate 'string "_" name)
#-(and bsd (not elf))
name)
#+(and x86 (or linux (and freebsd elf)))
(defun lisp::foreign-symbol-address-aux (name)
(multiple-value-bind (value found)
(gethash name lisp::*foreign-symbols* 0)
(if found
value
(multiple-value-bind (value found)
(gethash
(concatenate 'string "PVE_stub_" name)
lisp::*foreign-symbols* 0)
(if found
value
(let ((value (system:alternate-get-global-address name)))
(when (zerop value)
(error "Unknown foreign symbol: ~S" name))
value))))))
...@@ -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.39 2002/03/15 00:37:32 moore Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.40 2002/05/06 18:02:04 pmai Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -31,7 +31,7 @@ ...@@ -31,7 +31,7 @@
(defconstant foreign-segment-size #x02000000) (defconstant foreign-segment-size #x02000000)
(defvar *previous-linked-object-file* nil) (defvar *previous-linked-object-file* nil)
#-(or linux irix) #-(or openbsd linux irix)
(defvar *foreign-segment-free-pointer* foreign-segment-start) (defvar *foreign-segment-free-pointer* foreign-segment-start)
(defun pick-temporary-file-name (&optional (base "/tmp/tmp~D~C")) (defun pick-temporary-file-name (&optional (base "/tmp/tmp~D~C"))
...@@ -57,7 +57,7 @@ ...@@ -57,7 +57,7 @@
(t (t
(incf code)))))))) (incf code))))))))
#+(or OpenBSD (and FreeBSD (not elf)) (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)
...@@ -69,7 +69,7 @@ ...@@ -69,7 +69,7 @@
(trsize c-call:unsigned-long) (trsize c-call:unsigned-long)
(drsize c-call:unsigned-long))) (drsize c-call:unsigned-long)))
#-(or linux svr4) #-(or OpenBSD linux svr4)
(defun allocate-space-in-foreign-segment (bytes) (defun allocate-space-in-foreign-segment (bytes)
(let* ((pagesize-1 (1- (get-page-size))) (let* ((pagesize-1 (1- (get-page-size)))
(memory-needed (logandc2 (+ bytes pagesize-1) pagesize-1)) (memory-needed (logandc2 (+ bytes pagesize-1) pagesize-1))
...@@ -279,8 +279,7 @@ to skip undefined symbols which don't have an address." ...@@ -279,8 +279,7 @@ to skip undefined symbols which don't have an address."
;;; 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.
;;; prm- We assume this works for OpenBSD as well, needs testing... #+(or (and FreeBSD (not ELF)) (and sparc (not svr4)))
#+(or OpenBSD (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)
...@@ -485,7 +484,7 @@ to skip undefined symbols which don't have an address." ...@@ -485,7 +484,7 @@ to skip undefined symbols which don't have an address."
)) ))
(unix:unix-close fd)))) (unix:unix-close fd))))
#-(or linux solaris irix NetBSD (and FreeBSD elf)) #-(or OpenBSD linux solaris irix NetBSD (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)))
...@@ -505,7 +504,7 @@ to skip undefined symbols which don't have an address." ...@@ -505,7 +504,7 @@ to skip undefined symbols which don't have an address."
(setf (gethash symbol symbol-table) address))))) (setf (gethash symbol symbol-table) address)))))
(setf lisp::*foreign-symbols* symbol-table))) (setf lisp::*foreign-symbols* symbol-table)))
#-(or linux irix solaris) #-(or OpenBSD linux irix solaris)
(defun load-foreign (files &key (defun load-foreign (files &key
(libraries '("-lc")) (libraries '("-lc"))
(base-file (base-file
...@@ -591,13 +590,13 @@ to skip undefined symbols which don't have an address." ...@@ -591,13 +590,13 @@ to skip undefined symbols which don't have an address."
(export '(alternate-get-global-address)) (export '(alternate-get-global-address))
#-(or solaris linux irix) #-(or OpenBSD linux solaris irix)
(defun alternate-get-global-address (symbol) (defun alternate-get-global-address (symbol)
(declare (type simple-string symbol) (declare (type simple-string symbol)
(ignore symbol)) (ignore symbol))
0) 0)
#+(or linux solaris irix FreeBSD4) #+(or OpenBSD linux solaris irix FreeBSD4)
(progn (progn
(defconstant rtld-lazy 1 (defconstant rtld-lazy 1
...@@ -622,7 +621,7 @@ to skip undefined symbols which don't have an address." ...@@ -622,7 +621,7 @@ to skip undefined symbols which don't have an address."
(defvar *dso-linker* (defvar *dso-linker*
#+solaris "/usr/ccs/bin/ld" #+solaris "/usr/ccs/bin/ld"
#+(or linux irix FreeBSD4) "/usr/bin/ld") #+(or OpenBSD linux irix FreeBSD4) "/usr/bin/ld")
(alien:def-alien-routine dlopen system-area-pointer (alien:def-alien-routine dlopen system-area-pointer
(file c-call:c-string) (mode c-call:int)) (file c-call:c-string) (mode c-call:int))
...@@ -695,11 +694,12 @@ to skip undefined symbols which don't have an address." ...@@ -695,11 +694,12 @@ to skip undefined symbols which don't have an address."
(let ((proc (ext:run-program (let ((proc (ext:run-program
*dso-linker* *dso-linker*
(list* (list*
#+(or solaris linux FreeBSD4) "-G" #+irix "-shared" #+(or solaris linux FreeBSD4) "-G"
#+(or OpenBSD irix) "-shared"
"-o" "-o"
output-file output-file
;; Cause all specified libs to be loaded in full ;; Cause all specified libs to be loaded in full
#+(or linux FreeBSD4) "--whole-archive" #+(or OpenBSD linux FreeBSD4) "--whole-archive"
#+solaris "-z" #+solaris "allextract" #+solaris "-z" #+solaris "allextract"
(append (mapcar (append (mapcar
#'(lambda (name) #'(lambda (name)
...@@ -715,7 +715,8 @@ to skip undefined symbols which don't have an address." ...@@ -715,7 +715,8 @@ to skip undefined symbols which don't have an address."
files)) files))
;; Return to default ld behaviour for libs ;; Return to default ld behaviour for libs
(list (list
#+(or linux FreeBSD4) "--no-whole-archive" #+(or OpenBSD linux FreeBSD4)
"--no-whole-archive"
#+solaris "-z" #+solaris "defaultextract") #+solaris "-z" #+solaris "defaultextract")
libraries)) libraries))
:env env :env env
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.19 2002/03/13 08:01:58 moore Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.20 2002/05/06 18:02:05 pmai Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -473,8 +473,12 @@ ...@@ -473,8 +473,12 @@
;;; ;;;
(defun extern-alien-name (name) (defun extern-alien-name (name)
(declare (type simple-string name)) (declare (type simple-string name))
#+(and bsd (not elf))
(concatenate 'string "_" name)
#-(and bsd (not elf))
name) name)
#+(or linux (and freebsd elf))
(defun lisp::foreign-symbol-address-aux (name) (defun lisp::foreign-symbol-address-aux (name)
(multiple-value-bind (value found) (multiple-value-bind (value found)
(gethash name lisp::*foreign-symbols* 0) (gethash name lisp::*foreign-symbols* 0)
...@@ -482,9 +486,7 @@ ...@@ -482,9 +486,7 @@
value value
(multiple-value-bind (value found) (multiple-value-bind (value found)
(gethash (gethash
(concatenate 'string #+(or linux (and freebsd elf)) "PVE_stub_" (concatenate 'string "PVE_stub_" name)
#+(and bsd (not elf)) "_"
name)
lisp::*foreign-symbols* 0) lisp::*foreign-symbols* 0)
(if found (if found
value value
......
/* Routines that must be linked into the core for lisp to work. */ /* Routines that must be linked into the core for lisp to work. */
/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.25 2002/01/28 20:17:11 pmai Exp $ */ /* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.26 2002/05/06 18:02:05 pmai Exp $ */
/* Pick up all the syscalls. */ /* Pick up all the syscalls. */
F(accept) F(accept)
...@@ -231,11 +231,15 @@ D(timezone) ...@@ -231,11 +231,15 @@ D(timezone)
D(altzone) D(altzone)
D(daylight) D(daylight)
D(tzname) D(tzname)
#endif
#if defined(SVR4) || defined(__OpenBSD__)
F(dlopen) F(dlopen)
F(dlsym) F(dlsym)
F(dlclose) F(dlclose)
F(dlerror) F(dlerror)
#endif #endif
#if !defined (SOLARIS) || defined(SOLARIS25) #if !defined (SOLARIS) || defined(SOLARIS25)
F(getwd) F(getwd)
#endif #endif
......
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