src/lsp/shlib.lsp

   1 (defpackage "SHARED-LIBRARY" (:use "XLISP") (:nicknames "SHLIB"))
   2 (in-package "SHARED-LIBRARY")
   3
   4 ;;;;
   5 ;;;; Data Structure for Library
   6 ;;;;
   7
   8 (defstruct (shared-library
   9             (:constructor (make-shared-library (name path handle subrs)))
  10             (:print-function print-shlib))
  11   name path handle subrs)
  12
  13 (defun print-shlib (shlib stream depth)
  14   (format stream "#<shared library ~s>" (shared-library-name shlib)))
  15
  16
  17 ;;;;
  18 ;;;; Public Functions
  19 ;;;;
  20
  21 (export '(load-shared-library close-shared-library
  22           shared-library-information))
  23
  24 (defun load-shared-library (path &optional
  25                                  (name (pathname-name path))
  26                                  (version -1)
  27                                  (oldest version))
  28   (let ((*package* *package*)
  29         (handle (shlib-open path))
  30         (success nil))
  31     (unwind-protect
  32         (let* ((init (shlib-symaddr handle (format nil "~a__init" name)))
  33                (ftab (call-by-address init))
  34                (subrs (shlib-init ftab version oldest))
  35                (shlib (make-shared-library name path handle subrs)))
  36           ;;(register-saver shlib #'close-shared-library)
  37           (setf success t)
  38           shlib)
  39       (unless success (shlib-close handle)))))
  40
  41 (defun close-shared-library (shlib)
  42   ;;(unregister-saver shlib)
  43   (dolist (s (shared-library-subrs shlib))
  44     (clear-subr s))
  45   (shlib-close (shared-library-handle shlib)))
  46
  47 (defun shared-library-information (path &optional (name (pathname-name path)))
  48   (let ((*package* *package*)
  49         (handle (shlib-open path)))
  50     (unwind-protect
  51         (let* ((init (shlib-symaddr handle (format nil "~a__init" name)))
  52                (ftab (call-by-address init)))
  53           (shlib-info ftab))
  54       (shlib-close handle))))