Ignore:
Timestamp:
Nov 15, 2010, 1:10:38 AM (9 years ago)
Author:
gb
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.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-cfm-support.lisp

    r14288 r14432  
    479479  (defvar *get-module-handle-ex-addr*)
    480480
     481  (defun nbackslash-to-forward-slash (namestring)
     482    (dotimes (i (length namestring) namestring)
     483      (when (eql (schar namestring i) #\\)
     484        (setf (schar namestring i) #\/))))
    481485
    482486  (defun init-windows-ffi ()
     
    491495 
    492496  (defun hmodule-pathname (hmodule)
    493     (do* ((bufsize 64))
     497    (do* ((bufsize 128))
    494498         ()
    495499      (%stack-block ((name bufsize))
    496500        (let* ((needed (ff-call *get-module-file-name-addr*
    497                                 :address *current-process-handle*
    498501                                :address hmodule
    499502                                :address name
     
    502505          (if (eql 0 needed)
    503506            (return nil)
    504             (if (< bufsize needed)
    505               (setq bufsize needed)
    506               (return (%str-from-ptr name needed))))))))
     507            (if (<= bufsize needed)
     508              (setq bufsize (+ bufsize bufsize))
     509              (return (nbackslash-to-forward-slash (%str-from-ptr name needed)))))))))
    507510
    508511  (defun hmodule-basename (hmodule)
     
    594597        (values nil (%windows-error-string (get-last-windows-error))))))
    595598
    596 (init-shared-libraries)
     599  (init-shared-libraries)
     600
     601  (defun revive-shared-libraries ()
     602    (dolist (lib *shared-libraries*)
     603      (setf (shlib.map lib) nil
     604            (shlib.handle lib) nil
     605            (shlib.pathname lib) nil
     606            (shlib.base lib) nil)
     607      (let* ((soname (shlib.soname lib))
     608             (soname-len (length soname)))
     609        (block found
     610          (for-each-loaded-module
     611           (lambda (m)
     612             (let* ((module-soname (hmodule-basename m)))
     613               (when (%simple-string= soname module-soname 0 0 soname-len (length module-soname))
     614                 (let* ((m (%inc-ptr m 0)))
     615                   (setf (shlib.base lib) m
     616                         (shlib.map lib) m
     617                         (shlib.pathname lib) (hmodule-pathname m)))
     618                 (return-from found)))))))))
     619
     620  (defun reopen-user-libraries ()
     621    (dolist (lib *shared-libraries*)
     622      (unless (shlib.map lib)
     623        (let* ((handle (with-cstrs ((name (shlib.soname lib)))
     624                         (ff-call
     625                          (%kernel-import target::kernel-import-GetSharedLibrary)
     626                          :address name
     627                          :unsigned-fullword 0
     628                          :address))))
     629          (unless (%null-ptr-p handle)
     630            (setf (shlib.handle lib) handle
     631                  (shlib.base lib) handle
     632                  (shlib.map lib) handle
     633                  (shlib.pathname lib) (hmodule-pathname handle)
     634                  (shlib.opencount lib) 1))))))
     635           
     636             
    597637
    598638;;; end windows-target
    599 
     639 
    600640
    601641
     
    959999    (reopen-user-libraries))
    9601000  #+windows-target
    961   (init-windows-ffi)
     1001  (progn
     1002    (init-windows-ffi)
     1003    (revive-shared-libraries)
     1004    (reopen-user-libraries))
    9621005  (when *eeps*
    9631006    (without-interrupts
Note: See TracChangeset for help on using the changeset viewer.