Changeset 14432

Timestamp:

Nov 14, 2010, 5:10:38 PM (14 years ago)

Author:

Gary Byers

Message:

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.

Location:

trunk/source

Files:

• level-0/l0-cfm-support.lisp (modified) (5 diffs)
• level-1/linux-files.lisp (modified) (1 diff)

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

@@ -479 +479 @@
   (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 ()
@@ -491 +495 @@
   
   (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
@@ -502 +505 @@
           (if (eql 0 needed)
             (return nil)
-            (if (< bufsize needed)
-              (setq bufsize needed)
-              (return (%str-from-ptr name needed))))))))
+            (if (<= bufsize needed)
+              (setq bufsize (+ bufsize bufsize))
+              (return (nbackslash-to-forward-slash (%str-from-ptr name needed)))))))))
 
   (defun hmodule-basename (hmodule)
@@ -594 +597 @@
         (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= soname module-soname 0 0 soname-len (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-GetSharedLibrary)
+                          :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
-)  
+  )  
 
 
@@ -959 +999 @@
     (reopen-user-libraries))
   #+windows-target
-  (init-windows-ffi)
+  (progn
+    (init-windows-ffi)
+    (revive-shared-libraries)
+    (reopen-user-libraries))
   (when *eeps*
     (without-interrupts 

trunk/source/level-1/linux-files.lisp

@@ -26 +26 @@
             
 
-(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)