[Openmcl-cvs-notifications] r14432 - in /trunk/source: level-0/l0-cfm-support.lisp level-1/linux-files.lisp

[gb at clozure.com]

Author: gb
Date: Sun Nov 14 19:10:38 2010
New Revision: 14432

Log:
Move (windows-specific) NBACKSLASH-TO-FORWARD-SLASH from level-1/linux-files
to level-0/l0-cfm-support.lisp.

Implement REVIVE-SHARED-LIBRARIES and REOPEN-USER-LIBRARIES for Windows.
Fix (windows-specific) HMODULE-PATHNAME.

Modified:
    trunk/source/level-0/l0-cfm-support.lisp
    trunk/source/level-1/linux-files.lisp

Modified: trunk/source/level-0/l0-cfm-support.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-0/l0-cfm-support.lisp (original)
+++ trunk/source/level-0/l0-cfm-support.lisp Sun Nov 14 19:10:38 2010
@@ -478,6 +478,10 @@
   (defvar *get-module-base-name-addr*)
   (defvar *get-module-handle-ex-addr*)
 =

+  (defun nbackslash-to-forward-slash (namestring)
+    (dotimes (i (length namestring) namestring)
+      (when (eql (schar namestring i) #\\)
+        (setf (schar namestring i) #\/))))
 =

   (defun init-windows-ffi ()
     (%revive-macptr *windows-invalid-handle*)
@@ -490,20 +494,19 @@
   (init-windows-ffi)
   =

   (defun hmodule-pathname (hmodule)
-    (do* ((bufsize 64))
+    (do* ((bufsize 128))
          ()
       (%stack-block ((name bufsize))
         (let* ((needed (ff-call *get-module-file-name-addr*
-                                :address *current-process-handle*
                                 :address hmodule
                                 :address name
                                 :signed-fullword bufsize
                                 :signed-fullword)))
           (if (eql 0 needed)
             (return nil)
-            (if (< bufsize needed)
-              (setq bufsize needed)
-              (return (%str-from-ptr name needed))))))))
+            (if (<=3D bufsize needed)
+              (setq bufsize (+ bufsize bufsize))
+              (return (nbackslash-to-forward-slash (%str-from-ptr name nee=
ded)))))))))
 =

   (defun hmodule-basename (hmodule)
     (do* ((bufsize 64))
@@ -593,10 +596,47 @@
           shlib)
         (values nil (%windows-error-string (get-last-windows-error))))))
 =

-(init-shared-libraries)
+  (init-shared-libraries)
+
+  (defun revive-shared-libraries ()
+    (dolist (lib *shared-libraries*)
+      (setf (shlib.map lib) nil
+            (shlib.handle lib) nil
+            (shlib.pathname lib) nil
+            (shlib.base lib) nil)
+      (let* ((soname (shlib.soname lib))
+             (soname-len (length soname)))
+        (block found
+          (for-each-loaded-module
+           (lambda (m)
+             (let* ((module-soname (hmodule-basename m)))
+               (when (%simple-string=3D soname module-soname 0 0 soname-le=
n (length module-soname))
+                 (let* ((m (%inc-ptr m 0)))
+                   (setf (shlib.base lib) m
+                         (shlib.map lib) m
+                         (shlib.pathname lib) (hmodule-pathname m)))
+                 (return-from found)))))))))
+
+  (defun reopen-user-libraries ()
+    (dolist (lib *shared-libraries*)
+      (unless (shlib.map lib)
+        (let* ((handle (with-cstrs ((name (shlib.soname lib)))
+                         (ff-call
+                          (%kernel-import target::kernel-import-GetSharedL=
ibrary)
+                          :address name
+                          :unsigned-fullword 0
+                          :address))))
+          (unless (%null-ptr-p handle)
+            (setf (shlib.handle lib) handle
+                  (shlib.base lib) handle
+                  (shlib.map lib) handle
+                  (shlib.pathname lib) (hmodule-pathname handle)
+                  (shlib.opencount lib) 1))))))
+           =

+              =

 =

 ;;; end windows-target
-)  =

+  )  =

 =

 =

 (defun ensure-open-shlib (c force)
@@ -958,7 +998,10 @@
     (setup-lookup-calls)
     (reopen-user-libraries))
   #+windows-target
-  (init-windows-ffi)
+  (progn
+    (init-windows-ffi)
+    (revive-shared-libraries)
+    (reopen-user-libraries))
   (when *eeps*
     (without-interrupts =

      (maphash #'(lambda (k v) =


Modified: trunk/source/level-1/linux-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/linux-files.lisp (original)
+++ trunk/source/level-1/linux-files.lisp Sun Nov 14 19:10:38 2010
@@ -25,10 +25,7 @@
 =

             =

 =

-(defun nbackslash-to-forward-slash (namestring)
-  (dotimes (i (length namestring) namestring)
-    (when (eql (schar namestring i) #\\)
-      (setf (schar namestring i) #\/))))
+
 =

 (defconstant univeral-time-start-in-windows-seconds 9435484800)
 =