1 ;;;; Copyright (C) 2003, 2005, 2006 Free Software Foundation, Inc.
3 ;;;; This library is free software; you can redistribute it and/or
4 ;;;; modify it under the terms of the GNU Lesser General Public
5 ;;;; License as published by the Free Software Foundation; either
6 ;;;; version 2.1 of the License, or (at your option) any later version.
8 ;;;; This library is distributed in the hope that it will be useful,
9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 ;;;; Lesser General Public License for more details.
13 ;;;; You should have received a copy of the GNU Lesser General Public
14 ;;;; License along with this library; if not, write to the Free Software
15 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18 ;;;; Deprecated definitions.
20 (define substring-move-left! substring-move!)
21 (define substring-move-right! substring-move!)
23 ;; This method of dynamically linking Guile Extensions is deprecated.
24 ;; Use `load-extension' explicitly from Scheme code instead.
26 (define (split-c-module-name str)
30 (end (string-length str)))
33 (reverse (cons (string->symbol (substring str start pos)) rev)))
34 ((eq? (string-ref str pos) #\space)
35 (loop (cons (string->symbol (substring str start pos)) rev)
40 (loop rev start (+ pos 1) end)))))
42 (define (convert-c-registered-modules dynobj)
43 (let ((res (map (lambda (c)
44 (list (split-c-module-name (car c)) (cdr c) dynobj))
45 (c-registered-modules))))
46 (c-clear-registered-modules)
49 (define registered-modules '())
51 (define (register-modules dynobj)
52 (set! registered-modules
53 (append! (convert-c-registered-modules dynobj)
56 (define (warn-autoload-deprecation modname)
57 (issue-deprecation-warning
58 "Autoloading of compiled code modules is deprecated."
59 "Write a Scheme file instead that uses `load-extension'.")
60 (issue-deprecation-warning
61 (simple-format #f "(You just autoloaded module ~S.)" modname)))
63 (define (init-dynamic-module modname)
64 ;; Register any linked modules which have been registered on the C level
66 (or-map (lambda (modinfo)
67 (if (equal? (car modinfo) modname)
69 (warn-autoload-deprecation modname)
70 (set! registered-modules (delq! modinfo registered-modules))
71 (let ((mod (resolve-module modname #f)))
72 (save-module-excursion
74 (set-current-module mod)
75 (set-module-public-interface! mod mod)
76 (dynamic-call (cadr modinfo) (caddr modinfo))
82 (define (dynamic-maybe-call name dynobj)
83 (catch #t ; could use false-if-exception here
85 (dynamic-call name dynobj))
89 (define (dynamic-maybe-link filename)
90 (catch #t ; could use false-if-exception here
92 (dynamic-link filename))
96 (define (find-and-link-dynamic-module module-name)
97 (define (make-init-name mod-name)
98 (string-append "scm_init"
99 (list->string (map (lambda (c)
100 (if (or (char-alphabetic? c)
104 (string->list mod-name)))
107 ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
108 ;; and the `libname' (the name of the module prepended by `lib') in the cdr
109 ;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then
110 ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
111 (let ((subdir-and-libname
114 (if (null? (cdr syms))
115 (cons dirs (string-append "lib" (symbol->string (car syms))))
116 (loop (string-append dirs (symbol->string (car syms)) "/")
118 (init (make-init-name (apply string-append
123 (let ((subdir (car subdir-and-libname))
124 (libname (cdr subdir-and-libname)))
126 ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
127 ;; file exists, fetch the dlname from that file and attempt to link
128 ;; against it. If `subdir/libfoo.la' does not exist, or does not seem
129 ;; to name any shared library, look for `subdir/libfoo.so' instead and
130 ;; link against that.
131 (let check-dirs ((dir-list %load-path))
134 (let* ((dir (in-vicinity (car dir-list) subdir))
136 (or (try-using-libtool-name dir libname)
137 (try-using-sharlib-name dir libname))))
138 (if (and sharlib-full (file-exists? sharlib-full))
139 (link-dynamic-module sharlib-full init)
140 (check-dirs (cdr dir-list)))))))))
142 (define (try-using-libtool-name libdir libname)
143 (let ((libtool-filename (in-vicinity libdir
144 (string-append libname ".la"))))
145 (and (file-exists? libtool-filename)
148 (define (try-using-sharlib-name libdir libname)
149 (in-vicinity libdir (string-append libname ".so")))
151 (define (link-dynamic-module filename initname)
152 ;; Register any linked modules which have been registered on the C level
153 (register-modules #f)
154 (let ((dynobj (dynamic-link filename)))
155 (dynamic-call initname dynobj)
156 (register-modules dynobj)))
158 (define (try-module-linked module-name)
159 (init-dynamic-module module-name))
161 (define (try-module-dynamic-link module-name)
162 (and (find-and-link-dynamic-module module-name)
163 (init-dynamic-module module-name)))
165 (define (list* . args)
166 (issue-deprecation-warning "'list*' is deprecated. Use 'cons*' instead.")
169 ;; The strange prototype system for uniform arrays has been
172 (define uniform-vector-fill! array-fill!)
174 (define make-uniform-vector dimensions->uniform-array)
176 (define (make-uniform-array prot . bounds)
177 (dimensions->uniform-array bounds prot))
179 (define (list->uniform-vector prot lst)
180 (list->uniform-array 1 prot lst))