- (ensure-lisp-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))))
- (if (zerop (sap-int sap))
- (error "can't open object ~S: ~S" file (dlerror))
- (pushnew sap *tables-from-dlopen* :test #'sap=)))
- (values))
-
-(defun get-dynamic-foreign-symbol-address (symbol)
- (ensure-lisp-table-opened)
- ;; Find the symbol in any of the loaded object files. Search in
- ;; reverse order of loading, so that later loadings take precedence.
- ;;
- ;; FIXME: The way that we use PUSHNEW SAP in LOAD-1-FOREIGN means
- ;; 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*)
- ;; 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))))
- (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*))
- #+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))
- (let ((output-file (pick-temporary-file-name
- (concatenate 'string "/tmp/~D~C" (string (gensym)))))
- (error-output (make-string-output-stream)))
-
- (/show "running" *dso-linker*)
- (force-output)
- (unwind-protect
- (let ((proc (sb-ext:run-program
- *dso-linker*
- (append *dso-linker-options*
- (list output-file)
- (append (mapcar #'(lambda (name)
- (unix-namestring name nil))
- (if (atom files)
- (list files)
- files))
- libraries))
- :env env
- :input nil
- :output error-output
- :error :output)))
- (unless proc
- (error "could not run ~A" *dso-linker*))
- (unless (zerop (sb-ext:process-exit-code proc))
- (sb-sys:serve-all-events 0)
- (error "~A failed:~%~A" *dso-linker*
- (get-output-stream-string error-output)))
- (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
+ (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* ((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" real-file (dlerror))
+ (pushnew sap *handles-from-dlopen* :test #'sap=)))
+ (values))
+
+ (defun get-dynamic-foreign-symbol-address (symbol)
+ (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.
+ ;;
+ ;; FIXME: The way that we use PUSHNEW SAP in LOAD-SHARED-OBJECT means
+ ;; 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 (handle (reverse *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 handle symbol))))
+ (unless (zerop possible-result)
+ (return possible-result)))))
+
+ (defun foreign-symbol-in-address (sap)
+ (declare (ignore sap)))
+
+ (when (ignore-errors (foreign-symbol-address "dladdr"))
+ (setf (symbol-function 'foreign-symbol-in-address)
+ ;; KLUDGE: This COMPILE trick is to avoid trying to
+ ;; compile a reference to dladdr on platforms without it.
+ (compile nil
+ '(lambda (sap)
+ (let ((addr (sap-int sap)))
+ (with-alien ((info
+ (struct dl-info
+ (filename c-string)
+ (base unsigned)
+ (symbol c-string)
+ (symbol-address unsigned)))
+ (dladdr
+ (function unsigned
+ unsigned (* (struct dl-info)))
+ :extern "dladdr"))
+ (let ((err (alien-funcall dladdr addr (addr info))))
+ (if (zerop err)
+ nil
+ (values (slot info 'symbol)
+ (slot info 'filename)
+ addr
+ (- addr (slot info 'symbol-address)))))))))))
+
+ )) ; PROGN, MACROLET