Changeset 14155

Timestamp:

Aug 7, 2010, 12:31:17 AM (14 years ago)

Author:

Gary Byers

Message:

Add a PROCESS arg to OPEN-SHARED-LIBRARY, whose value can be :INITIAL,
:CURRENT, or a PROCESS object. If :INITIAL, do the open on the initial
process; if :CURRENT, do it in the current process, else do it in the
specified process. Defaults to :INITIAL on OSX, to :CURRENT (the status
quo) on other platforms.

File:

• trunk/source/level-0/l0-cfm-support.lisp (modified) (4 diffs)

trunk/source/level-0/l0-cfm-support.lisp

@@ -311 +311 @@
                      
 
-(defun open-shared-library (name)
-  "If the library denoted by name can be loaded by the operating system,
-return an object of type SHLIB that describes the library; if the library
-is already open, increment a reference count. If the library can't be
-loaded, signal a SIMPLE-ERROR which contains an often-cryptic message from
-the operating system."
+(defun open-shared-library-internal (name)
   (let* ((handle (with-cstrs ((name name))
                         (ff-call
@@ -401 +396 @@
 
 
-(defun open-shared-library (name)
-  "If the library denoted by name can be loaded by the operating system,
-return an object of type SHLIB that describes the library; if the library
-is already open, increment a reference count. If the library can't be
-loaded, signal a SIMPLE-ERROR which contains an often-cryptic message from
-the operating system."
+(defun open-shared-library-internal (name)
   (rlet ((type :signed))
     (let ((result (with-cstrs ((cname name))
@@ -589 +579 @@
 
 
-  (defun open-shared-library (name)
-    "If the library denoted by name can be loaded by the operating system,
-return an object of type SHLIB that describes the library; if the library
-is already open, increment a reference count. If the library can't be
-loaded, signal a SIMPLE-ERROR which contains an often-cryptic message from
-the operating system."
+  (defun open-shared-library-internal (name)
     (let* ((hmodule (with-cstrs ((name name))
                       (ff-call
@@ -990 +975 @@
               *fvs*))))
 
-
+(defun open-shared-library (name &optional (process #+darwin-target :initial
+                                                    #-darwin-target :current))
+  "If the library denoted by name can be loaded by the operating system,
+return an object of type SHLIB that describes the library; if the library
+is already open, increment a reference count. If the library can't be
+loaded, signal a SIMPLE-ERROR which contains an often-cryptic message from
+the operating system."
+  (if (or (eq process :current)
+          (eq process *current-process*)
+          (and (eq process :initial)
+               (eq *current-process* *initial-process*)))
+    (open-shared-library-internal name)
+    (call-in-process (lambda () (open-shared-library name))
+                     (if (eq process :initial)
+                       *initial-process*
+                       process))))
+
+