mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 01:10:24 +02:00
Code Activity

(try-load-module): Bracket calls to try-module-linked

Browse source 
and try-module-dynamic-link with `begin-deprecated'.
(split-c-module-name, convert-c-registered-modules,
registered-modules, register-modules, warn-autoload-deprecation,
init-dynamic-module, dynamic-maybe-call, dynamic-maybe-link,
find-and-link-dynamic-module, try-using-libtool-name,
try-using-sharlib-name, link-dynamic-module, try-module-linked,
try-module-dynamic-link): Deprecated.  Activate deprecation
message.
This commit is contained in:
Marius Vollmer 2001-06-03 01:02:53 +00:00
parent 691f5a4d2d
commit 99a34d6e6a
1 changed files with 135 additions and 137 deletions
Download patch file Download diff file Expand all files Collapse all files

272
ice-9/boot-9.scm
View file

@ -1610,9 +1610,9 @@
;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module))) ;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
(define (try-load-module name) (define (try-load-module name)
(or (try-module-linked name) (or (begin-deprecated (try-module-linked name))
(try-module-autoload name) (try-module-autoload name)
(try-module-dynamic-link name))) (begin-deprecated (try-module-dynamic-link name))))
(define (purify-module! module) (define (purify-module! module)
"Removes bindings in MODULE which are inherited from the (guile) module." "Removes bindings in MODULE which are inherited from the (guile) module."
@ -1803,152 +1803,150 @@
;;; Dynamic linking of modules ;;; Dynamic linking of modules
;; This method of dynamically linking Guile Extensions is deprecated. ;; This method of dynamically linking Guile Extensions is deprecated.
;; Use `dynamic-link' and `dynamic-call' explicitely from Scheme code ;; Use `load-extension' explicitely from Scheme code instead.
;; instead.
;; XXX - We can not offer the removal of this code thru the (begin-deprecated
;; deprecation mechanism since we have no complete replacement yet.
(define (split-c-module-name str) (define (split-c-module-name str)
(let loop ((rev '()) (let loop ((rev '())
(start 0) (start 0)
(pos 0) (pos 0)
(end (string-length str))) (end (string-length str)))
(cond (cond
((= pos end) ((= pos end)
(reverse (cons (string->symbol (substring str start pos)) rev))) (reverse (cons (string->symbol (substring str start pos)) rev)))
((eq? (string-ref str pos) #\space) ((eq? (string-ref str pos) #\space)
(loop (cons (string->symbol (substring str start pos)) rev) (loop (cons (string->symbol (substring str start pos)) rev)
(+ pos 1) (+ pos 1)
(+ pos 1) (+ pos 1)
end)) end))
(else (else
(loop rev start (+ pos 1) end))))) (loop rev start (+ pos 1) end)))))
(define (convert-c-registered-modules dynobj) (define (convert-c-registered-modules dynobj)
(let ((res (map (lambda (c) (let ((res (map (lambda (c)
(list (split-c-module-name (car c)) (cdr c) dynobj)) (list (split-c-module-name (car c)) (cdr c) dynobj))
(c-registered-modules)))) (c-registered-modules))))
(c-clear-registered-modules) (c-clear-registered-modules)
res)) res))
(define registered-modules '()) (define registered-modules '())
(define (register-modules dynobj) (define (register-modules dynobj)
(set! registered-modules (set! registered-modules
(append! (convert-c-registered-modules dynobj) (append! (convert-c-registered-modules dynobj)
registered-modules))) registered-modules)))
(define (warn-autoload-deprecation modname) (define (warn-autoload-deprecation modname)
;; Do nothing here until we can deprecate the code for real. (issue-deprecation-warning
(if #f "Autoloading of compiled code modules is deprecated."
(issue-deprecation-warning "Write a Scheme file instead that uses `load-extension'.")
"Autoloading of compiled code modules is deprecated." (issue-deprecation-warning
"Write a Scheme file instead that uses `dynamic-link' directly."))) (simple-format #f "(You just autoloaded module ~S.)" modname)))
(define (init-dynamic-module modname)
;; Register any linked modules which have been registered on the C level
(register-modules #f)
(or-map (lambda (modinfo)
(if (equal? (car modinfo) modname)
(begin
(warn-autoload-deprecation modname)
(set! registered-modules (delq! modinfo registered-modules))
(let ((mod (resolve-module modname #f)))
(save-module-excursion
(lambda ()
(set-current-module mod)
(set-module-public-interface! mod mod)
(dynamic-call (cadr modinfo) (caddr modinfo))
))
#t))
#f))
registered-modules))
(define (init-dynamic-module modname) (define (dynamic-maybe-call name dynobj)
;; Register any linked modules which have been registered on the C level (catch #t ; could use false-if-exception here
(register-modules #f) (lambda ()
(or-map (lambda (modinfo) (dynamic-call name dynobj))
(if (equal? (car modinfo) modname) (lambda args
(begin #f)))
(warn-autoload-deprecation modname)
(set! registered-modules (delq! modinfo registered-modules))
(let ((mod (resolve-module modname #f)))
(save-module-excursion
(lambda ()
(set-current-module mod)
(set-module-public-interface! mod mod)
(dynamic-call (cadr modinfo) (caddr modinfo))
))
#t))
#f))
registered-modules))
(define (dynamic-maybe-call name dynobj) (define (dynamic-maybe-link filename)
(catch #t ; could use false-if-exception here (catch #t ; could use false-if-exception here
(lambda () (lambda ()
(dynamic-call name dynobj)) (dynamic-link filename))
(lambda args (lambda args
#f))) #f)))
(define (dynamic-maybe-link filename) (define (find-and-link-dynamic-module module-name)
(catch #t ; could use false-if-exception here (define (make-init-name mod-name)
(lambda () (string-append "scm_init"
(dynamic-link filename)) (list->string (map (lambda (c)
(lambda args (if (or (char-alphabetic? c)
#f))) (char-numeric? c))
c
(define (find-and-link-dynamic-module module-name) #\_))
(define (make-init-name mod-name) (string->list mod-name)))
(string-append "scm_init" "_module"))
(list->string (map (lambda (c)
(if (or (char-alphabetic? c)
(char-numeric? c))
c
#\_))
(string->list mod-name)))
"_module"))
;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
;; and the `libname' (the name of the module prepended by `lib') in the cdr
;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then
;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
(let ((subdir-and-libname
(let loop ((dirs "")
(syms module-name))
(if (null? (cdr syms))
(cons dirs (string-append "lib" (symbol->string (car syms))))
(loop (string-append dirs (symbol->string (car syms)) "/")
(cdr syms)))))
(init (make-init-name (apply string-append
(map (lambda (s)
(string-append "_"
(symbol->string s)))
module-name)))))
(let ((subdir (car subdir-and-libname))
(libname (cdr subdir-and-libname)))
;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
;; file exists, fetch the dlname from that file and attempt to link
;; against it. If `subdir/libfoo.la' does not exist, or does not seem
;; to name any shared library, look for `subdir/libfoo.so' instead and
;; link against that.
(let check-dirs ((dir-list %load-path))
(if (null? dir-list)
#f
(let* ((dir (in-vicinity (car dir-list) subdir))
(sharlib-full
(or (try-using-libtool-name dir libname)
(try-using-sharlib-name dir libname))))
(if (and sharlib-full (file-exists? sharlib-full))
(link-dynamic-module sharlib-full init)
(check-dirs (cdr dir-list)))))))))
(define (try-using-libtool-name libdir libname)
(let ((libtool-filename (in-vicinity libdir
(string-append libname ".la"))))
(and (file-exists? libtool-filename)
libtool-filename)))
(define (try-using-sharlib-name libdir libname)
(in-vicinity libdir (string-append libname ".so")))
(define (link-dynamic-module filename initname)
;; Register any linked modules which has been registered on the C level
(register-modules #f)
(let ((dynobj (dynamic-link filename)))
(dynamic-call initname dynobj)
(register-modules dynobj)))
(define (try-module-linked module-name)
(init-dynamic-module module-name))
(define (try-module-dynamic-link module-name)
(and (find-and-link-dynamic-module module-name)
(init-dynamic-module module-name)))
;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
;; and the `libname' (the name of the module prepended by `lib') in the cdr
;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then
;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
(let ((subdir-and-libname
(let loop ((dirs "")
(syms module-name))
(if (null? (cdr syms))
(cons dirs (string-append "lib" (symbol->string (car syms))))
(loop (string-append dirs (symbol->string (car syms)) "/")
(cdr syms)))))
(init (make-init-name (apply string-append
(map (lambda (s)
(string-append "_"
(symbol->string s)))
module-name)))))
(let ((subdir (car subdir-and-libname))
(libname (cdr subdir-and-libname)))
;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
;; file exists, fetch the dlname from that file and attempt to link
;; against it. If `subdir/libfoo.la' does not exist, or does not seem
;; to name any shared library, look for `subdir/libfoo.so' instead and
;; link against that.
(let check-dirs ((dir-list %load-path))
(if (null? dir-list)
#f
(let* ((dir (in-vicinity (car dir-list) subdir))
(sharlib-full
(or (try-using-libtool-name dir libname)
(try-using-sharlib-name dir libname))))
(if (and sharlib-full (file-exists? sharlib-full))
(link-dynamic-module sharlib-full init)
(check-dirs (cdr dir-list)))))))))
(define (try-using-libtool-name libdir libname)
(let ((libtool-filename (in-vicinity libdir
(string-append libname ".la"))))
(and (file-exists? libtool-filename)
libtool-filename)))
(define (try-using-sharlib-name libdir libname)
(in-vicinity libdir (string-append libname ".so")))
(define (link-dynamic-module filename initname)
;; Register any linked modules which have been registered on the C level
(register-modules #f)
(let ((dynobj (dynamic-link filename)))
(dynamic-call initname dynobj)
(register-modules dynobj)))
(define (try-module-linked module-name)
(init-dynamic-module module-name))
(define (try-module-dynamic-link module-name)
(and (find-and-link-dynamic-module module-name)
(init-dynamic-module module-name))))
;; end of deprecated section
(define autoloads-done '((guile . guile))) (define autoloads-done '((guile . guile)))