diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | 302e3218b7d487539ec305bf23881a6ee7d5be99 (patch) | |
tree | bf1adafe552a17b3b78522048bb7c24787696dd3 /Link.scm | |
parent | c7d035ae1a729232579a0fe41ed5affa131d3623 (diff) | |
download | scm-302e3218b7d487539ec305bf23881a6ee7d5be99.tar.gz scm-302e3218b7d487539ec305bf23881a6ee7d5be99.zip |
Import Upstream version 5e1upstream/5e1
Diffstat (limited to 'Link.scm')
-rw-r--r-- | Link.scm | 31 |
1 files changed, 14 insertions, 17 deletions
@@ -57,7 +57,6 @@ (map char-downcase (string->list name)))))) (define link:link (lambda (file . libs) - (define oloadpath *load-pathname*) (let* ((sl (string-length file)) (lasl (string-length link:able-suffix)) (fname (let loop ((i (- sl 1))) @@ -72,26 +71,23 @@ (substring fname 0 (- nsl lasl))) (else fname))) (linkobj #f)) - (set! *load-pathname* file) (if (and (provided? 'sun-dl) (< 3 sl) (not (eqv? (string-ref file 0) '#\/))) (set! file (string-append "./" file))) - (set! linkobj (or (provided? 'sun-dl) (dyn:link file))) - (and linkobj - (for-each (lambda (lib) - (or (dyn:link lib) (slib:error "couldn't link: " lib))) - libs)) - (if (provided? 'sun-dl) (set! linkobj (dyn:link file))) - (cond ((not linkobj) - (set! *load-pathname* oloadpath) #f) - ((dyn:call (file->init_name name) linkobj) - (set! *load-pathname* oloadpath) #t) - (else - (dyn:unlink linkobj) - (set! *load-pathname* oloadpath) #f))))))) + (with-load-pathname file + (lambda () + (set! linkobj (or (provided? 'sun-dl) (dyn:link file))) + (and linkobj + (for-each (lambda (lib) + (or (dyn:link lib) + (slib:error "couldn't link: " lib))) + libs)) + (if (provided? 'sun-dl) (set! linkobj (dyn:link file))) + (cond ((not linkobj) #f) + ((dyn:call (file->init_name name) linkobj) #t) + (else (dyn:unlink linkobj) #f)))))))) -(cond ((defined? vms:dynamic-link-call) (define link:able-suffix #f) (define (link:link file) @@ -103,7 +99,8 @@ (set! dir (substring file 0 (+ i 1))) (set! fil (substring file (+ i 1) (string-length file)))) (else (loop (- i 1))))) - (vms:dynamic-link-call dir fil (file->init_name fil))))) + (with-load-pathname file + (lambda () (vms:dynamic-link-call dir fil (file->init_name fil))))))) (cond ((provided? 'sun-dl) |