~ubuntu-branches/ubuntu/lucid/gauche-c-wrapper/lucid

« back to all changes in this revision

Viewing changes to lib/c-wrapper/c-ffi.scm

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2008-07-16 10:51:00 UTC
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20080716105100-ye2wkbrk9087iwr8
Tags: upstream-0.5.4
ImportĀ upstreamĀ versionĀ 0.5.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
38
38
  (use c-wrapper.config)
39
39
  (use util.match)
40
40
  (use util.list)
 
41
  (use gauche.parameter)
41
42
 
42
43
  (export c-load-library
43
44
          c-ld
136
137
 
137
138
(select-module c-wrapper.c-ffi)
138
139
 
 
140
(define handle-list (make-parameter '(#f)))
 
141
 
139
142
(define (find-dylib-from-la lafile)
140
143
  (call-with-input-file lafile
141
144
    (lambda (in)
185
188
                   ((#/GROUP\s*\((.*)\)/ str) (#f libs)
186
189
                    (or (and-let* ((dl (find (cut #/\.so/ <>)
187
190
                                             (string-split libs #[,\s]))))
188
 
                          (dlopen dl (logior RTLD_NOW RTLD_GLOBAL)))
 
191
                          (dlopen dl))
189
192
                        #f))
190
193
                   (else
191
194
                    (loop (read-line in)))))))))
199
202
                                 (find-library lib
200
203
                                               (append search-paths
201
204
                                                       (sys-library-paths)))))))
202
 
                   (handle (or (dlopen dlfile (logior RTLD_NOW RTLD_GLOBAL))
 
205
                   (handle (or (dlopen dlfile)
203
206
                               (try-ld-script dlfile))))
204
207
          handle)
205
208
        (errorf "can't load ~a ~a" lib (or (and-let* ((errmsg (dlerror)))
217
220
      (define (opt) (car rest-opts))
218
221
      (cond
219
222
       ((null? rest-opts)
220
 
        (for-each (cut lib-load <> (reverse paths)) (reverse libs)))
 
223
        (for-each (lambda (lib)
 
224
                    (and-let* ([handle (lib-load lib (reverse paths))])
 
225
                      (handle-list (cons handle (handle-list)))))
 
226
                  (reverse libs)))
221
227
       ((string-prefix? "-l" (opt))
222
228
        (loop (cons (string-append "lib"
223
229
                                   (substring (opt) 2 (string-length (opt)))
247
253
  (c-load-library '() :option option))
248
254
 
249
255
(define (c-lookup-symbol sym)
250
 
  (dlsym-default (symbol->string sym)))
 
256
  (let ([str (symbol->string sym)])
 
257
    (any (cut dlsym <> str) (handle-list))))
251
258
 
252
259
;; for Objective-C functions
253
260
(define (@ str)