Import Upstream version 5e1upstream/5e1

1 files changed, 14 insertions, 17 deletions

diff --git a/Link.scm b/Link.scm
index 8e01de9..e0ea89b 100644
--- a/Link.scm
+++ b/Link.scm
@@ -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)