X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fforeign.lisp;h=ac0df2330adb2ff3eedace62d777509e0f755345;hb=d3862cc781cabf52f15c2d3a164f992dbbba84f4;hp=636a4d2034a2a44f27a1b941c27f8a8d6efc1a92;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp
index 636a4d2..ac0df23 100644
--- a/src/code/foreign.lisp
+++ b/src/code/foreign.lisp
@@ -1,4 +1,5 @@
-;;;; support for dynamically loading foreign object files
+;;;; support for dynamically loading foreign object files and
+;;;; resolving symbols therein
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -9,10 +10,8 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB-SYS")
+(in-package "SB-SYS") ; (SB-SYS, not SB!SYS, since we're built in warm load.)
 
-;;; not needed until we implement full-blown LOAD-FOREIGN
-#|
 (defun pick-temporary-file-name (&optional
 				 ;; KLUDGE: There are various security
 				 ;; nastyisms associated with easily
@@ -35,9 +34,9 @@
 		 (sb-unix:unix-close fd)
 		 (return name))
 		((not (= errno sb-unix:eexist))
-		 (error "could not create temporary file ~S: ~A"
-			name
-			(sb-unix:get-unix-error-msg errno)))
+		 (simple-file-perror "couldn't create temporary file ~S"
+				     name
+				     errno))
 		;; KLUDGE: depends on ASCII character ordering -- WHN 20000128
 		((= code (char-code #\Z))
 		 (setf code (char-code #\a)))
@@ -45,7 +44,7 @@
 		 (return nil))
 		(t
 		 (incf code))))))))
-|#
+
 
 ;;; On any OS where we don't support foreign object file loading, any
 ;;; query of a foreign symbol value is answered with "no definition
@@ -54,12 +53,16 @@
 ;;; (On any OS which *does* support foreign object file loading, this
 ;;; placeholder implementation is overwritten by a subsequent real
 ;;; implementation.)
+;;;
+;;; You may want to use sb-sys:foreign-symbol-address instead of
+;;; calling this directly; see code/target-load.lisp.
 (defun get-dynamic-foreign-symbol-address (symbol)
   (declare (type simple-string symbol) (ignore symbol))
   nil)
 
-;;; Linux implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
-;;; and functions (e.g. LOAD-FOREIGN) which affect it
+;;; dlsym()-based implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
+;;; and functions (e.g. LOAD-FOREIGN) which affect it.  This should 
+;;; work on any ELF system with dlopen(3) and dlsym(3)
 #+(or linux FreeBSD)
 (progn
 
@@ -72,15 +75,16 @@
 					; obj file were linked directly
 					; into the program)?
 
-;;; a list of tables returned from dlopen(3) (or possibly some
+;;; a list of handles returned from dlopen(3) (or possibly some
 ;;; bogus value temporarily during initialization)
-(defvar *tables-from-dlopen* nil)
+(defvar *handles-from-dlopen* nil)
+
 ;;; Dynamically loaded stuff isn't there upon restoring from a save.
 ;;; Clearing the variable this way was originally done primarily for
 ;;; Irix, which resolves tzname at runtime, resulting in
-;;; *TABLES-FROM-DLOPEN* being set in the saved core image, resulting
-;;; in havoc upon restart; but it seems harmless and tidy for other
-;;; OSes too.
+;;; *HANDLES-FROM-DLOPEN* (which was then called *TABLES-FROM-DLOPEN*)
+;;; being set in the saved core image, resulting in havoc upon
+;;; restart; but it seems harmless and tidy for other OSes too.
 ;;;
 ;;; Of course, it can be inconvenient that dynamically loaded stuff
 ;;; goes away when we save and restore. However,
@@ -93,14 +97,16 @@
 ;;;      dynamic loading of foreign files and saving/restoring cores,
 ;;;      he probably has the sophistication to write his own after-save
 ;;;      code to reload the libraries without much difficulty.
-(push (lambda () (setq *tables-from-dlopen* nil))
-      sb-int:*after-save-initializations*)
 
-;;; not needed until we implement full-blown LOAD-FOREIGN
-#|
+;;; dan 2001.05.10 suspects that objection (1) is bogus for
+;;; dlsym()-enabled systems
+
+(push (lambda () (setq *handles-from-dlopen* nil))
+      *after-save-initializations*)
+
 (defvar *dso-linker* "/usr/bin/ld")
 (defvar *dso-linker-options* '("-G" "-o"))
-|#
+
 
 (sb-alien:def-alien-routine dlopen system-area-pointer
   (file sb-c-call:c-string) (mode sb-c-call:int))
@@ -109,25 +115,30 @@
   (name sb-c-call:c-string))
 (sb-alien:def-alien-routine dlerror sb-c-call:c-string)
 
-;;; Ensure that we've opened our own binary so we can resolve global
-;;; variables in the Lisp image that come from libraries. This used to
-;;; happen only in GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS, and only if no
-;;; libraries were dlopen()ed already, but that didn't work if
-;;; something was dlopen()ed before any problem global vars were used.
-;;; So now we do this in any function that can add to the
-;;; *TABLES-FROM-DLOPEN*, as well as in
-;;; GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
-(defun ensure-lisp-table-opened ()
-  (unless *tables-from-dlopen*
+;;; Ensure that we've opened our own binary so we can dynamically resolve 
+;;; symbols in the C runtime.  
+
+;;; Old comment: This used to happen only in
+;;; GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS, and only if no libraries were
+;;; dlopen()ed already, but that didn't work if something was
+;;; dlopen()ed before any problem global vars were used.  So now we do
+;;; this in any function that can add to the *HANDLES-FROM-DLOPEN*, as
+;;; well as in GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
+
+;;; FIXME: It would work just as well to do it once at startup, actually.
+;;; Then at least we know it's done.    -dan 2001.05.10
+
+(defun ensure-runtime-symbol-table-opened ()
+  (unless *handles-from-dlopen*
     ;; Prevent recursive call if dlopen() isn't defined.
-    (setf *tables-from-dlopen* (int-sap 0))
-    (setf *tables-from-dlopen* (list (dlopen nil rtld-lazy)))
-    (when (zerop (sb-sys:sap-int (first *tables-from-dlopen*)))
-      (error "can't open global symbol table: ~S" (dlerror)))))
+    (setf *handles-from-dlopen* (int-sap 0))
+    (setf *handles-from-dlopen* (list (dlopen nil rtld-lazy)))
+    (when (zerop (sb-sys:sap-int (first *handles-from-dlopen*)))
+      (error "can't open our own binary's symbol table: ~S" (dlerror)))))
 
 (defun load-1-foreign (file)
-  "a primitive way to load a foreign object file. (LOAD-FOREIGN is
-  probably preferred, but as of SBCL 0.6.7 is not implemented..)
+  "the primitive upon which the more general LOAD-FOREIGN is built: load
+  a single foreign object file
 
   To use LOAD-1-FOREIGN, at the Unix command line do this:
     echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c
@@ -138,18 +149,19 @@
     (DEF-ALIEN-ROUTINE SUMMISH INT (X INT) (Y INT))
   Now running (SUMMISH 10 20) should return 31.
 "
-  (ensure-lisp-table-opened)
+  (ensure-runtime-symbol-table-opened)
   ;; Note: We use RTLD-GLOBAL so that it can find all the symbols
   ;; previously loaded. We use RTLD-NOW so that dlopen() will fail if
   ;; not all symbols are defined.
-  (let ((sap (dlopen file (logior rtld-now rtld-global))))
+  (let* ((real-file (or (unix-namestring file) file))
+         (sap (dlopen real-file (logior rtld-now rtld-global))))
        (if (zerop (sap-int sap))
-	   (error "can't open object ~S: ~S" file (dlerror))
-	   (pushnew sap *tables-from-dlopen* :test #'sap=)))
+	   (error "can't open object ~S: ~S" real-file (dlerror))
+	   (pushnew sap *handles-from-dlopen* :test #'sap=)))
   (values))
 
 (defun get-dynamic-foreign-symbol-address (symbol)
-  (ensure-lisp-table-opened)
+  (ensure-runtime-symbol-table-opened)
   ;; Find the symbol in any of the loaded object files. Search in
   ;; reverse order of loading, so that later loadings take precedence.
   ;;
@@ -157,38 +169,52 @@
   ;; that the list isn't guaranteed to be in reverse order of loading,
   ;; at least not if a file is loaded more than once. Is this the
   ;; right thing? (In what cases does it matter?)
-  (dolist (table *tables-from-dlopen*)
+  (dolist (handle *handles-from-dlopen*)
     ;; KLUDGE: We implicitly exclude the possibility that the variable
     ;; could actually be NULL, but the man page for dlsym(3) 
     ;; recommends doing a more careful test. -- WHN 20000825
-    (let ((possible-result (sap-int (dlsym table symbol))))
+    (let ((possible-result (sap-int (dlsym handle symbol))))
       (unless (zerop possible-result)
 	(return possible-result)))))
 
-;;; code partially ported from CMU CL to SBCL, but needs RUN-PROGRAM
-#|
-(defun load-foreign (files &key
-			   (libraries '("-lc"))
-			   (base-file nil)
-			   ;; Note: Since SBCL has no *ENVIRONMENT-LIST*
-			   ;; variable, if this code is ever restored,
-			   ;; the default should be taken from the alien
-			   ;; "environ" variable.
-			   ,, ; do it!
-			   (env sb-ext:*environment-list*))
+(defun load-foreign (files
+		     &key
+		     (libraries '("-lc"))
+		     ;; FIXME: The old documentation said
+		     ;;   The BASE-FILE argument is used to specify a
+		     ;;   file to use as the starting place for
+		     ;;   defined symbols. The default is the C start
+		     ;;   up code for Lisp.
+		     ;; But the code ignored the BASE-FILE argument.
+		     ;; The comment above
+		     ;;   (DECLARE (IGNORE BASE-FILE))
+		     ;; said
+		     ;;   dlopen() remembers the name of an object,
+		     ;;   when dlopen()ing the same name twice, the
+		     ;;   old object is reused.
+		     ;; So I deleted all reference to BASE-FILE,
+		     ;; including the now-bogus reference to the
+		     ;; BASE-FILE argument in the documentation. But
+		     ;; are there any other subtleties of the new code
+		     ;; which need to be documented in its place?
+		     (env nil env-p)
+		     (environment (if env-p
+				      (unix-environment-sbcl-from-cmu env)
+				      (posix-environ))
+				  environment-p))
   #+sb-doc
   "LOAD-FOREIGN loads a list of C object files into a running Lisp. The FILES
   argument should be a single file or a list of files. The files may be
   specified as namestrings or as pathnames. The libraries argument should be a
   list of library files as would be specified to ld. They will be searched in
   the order given. The default is just \"-lc\", i.e., the C library. The
-  base-file argument is used to specify a file to use as the starting place for
-  defined symbols. The default is the C start up code for Lisp. The ENV
-  argument is the Unix environment variable definitions for the invocation of
-  the linker. The default is the environment passed to Lisp."
-  ;; Note: dlopen() remembers the name of an object, when dlopen()ing
-  ;; the same name twice, the old object is reused.
-  (declare (ignore base-file))
+  ENVIRONMENT argument is a list of SIMPLE-STRINGs corresponding to the Unix
+  environment (\"man environ\") definitions for the invocation of the linker.
+  The default is the environment that Lisp is itself running in. Instead of
+  using the ENVIRONMENT argument, it is also possible to use the ENV argument,
+  using the older, lossy CMU CL representation."
+  (when (and env-p environment-p)
+    (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
   (let ((output-file (pick-temporary-file-name
 		      (concatenate 'string "/tmp/~D~C" (string (gensym)))))
 	(error-output (make-string-output-stream)))
@@ -200,13 +226,13 @@
 		     *dso-linker*
 		     (append *dso-linker-options*
 			     (list output-file)
-			     (append (mapcar #'(lambda (name)
-						 (unix-namestring name nil))
+			     (append (mapcar (lambda (name)
+					       (unix-namestring name nil))
 					     (if (atom files)
 						 (list files)
 					       files))
 				     libraries))
-		     :env env
+		     :environment environment
 		     :input nil
 		     :output error-output
 		     :error :output)))
@@ -219,6 +245,5 @@
 	  (load-1-foreign output-file))
       #-sb-show (sb-unix:unix-unlink output-file)
       #+sb-show (/show "not unlinking" output-file)))) ; so we can look at it
-|#
 
 ) ; PROGN