Handle case where debugging-info has an old-style pathname.

diff --git a/src/runtime/infstr.scm b/src/runtime/infstr.scm
index 322b8a63869e190f87ad6a21d7022c7deb450361..1c6b459cf3954069b13653db1edf420dd41d8cd9 100644 (file)
--- a/src/runtime/infstr.scm
+++ b/src/runtime/infstr.scm
@@ -247,7 +247,7 @@ USA.
 (define (debugging-wrapper? wrapper)
   (and (vector? wrapper)
        (fix:= (vector-length wrapper) 6)
-       (eq? (vector-ref wrapper 0) 'DEBUGGING-INFO-WRAPPER)
+       (eq? (vector-ref wrapper 0) 'debugging-info-wrapper)
        (or (fix:= (vector-ref wrapper 1) 1)
           (fix:= (vector-ref wrapper 1) 2))
        (or (and (not (vector-ref wrapper 2))
@@ -269,7 +269,7 @@ USA.
   (vector-ref wrapper 2))
 
 (define (debugging-wrapper/pathname wrapper)
-  (vector-ref wrapper 3))
+  (convert-old-style-pathname (vector-ref wrapper 3)))
 
 (define (set-debugging-wrapper/pathname! wrapper pathname)
   (vector-set! wrapper 3 pathname))
@@ -286,7 +286,9 @@ USA.
 (define (convert-old-debugging-wrapper wrapper)
   (let ((make-wrapper
         (lambda (pathname index info)
-          (vector 'DEBUGGING-INFO-WRAPPER 1 #f pathname index info))))
+          (vector 'DEBUGGING-INFO-WRAPPER 1 #f
+                  (convert-old-style-pathname pathname)
+                  index info))))
     (cond ((dbg-info? wrapper)
           (make-wrapper #f #f wrapper))
          ((debug-info-pathname? wrapper)
@@ -367,7 +369,31 @@ USA.
 
 (define (dbg-info-key=? a b)
   (equal? a b))
-
+\f
 (define (debug-info-pathname? object)
-  (or (pathname? object)
-      (string? object)))
\ No newline at end of file
+  (or (string? object)
+      (old-style-pathname? object)))
+
+;; This can be removed after the 9.3 release.
+(define (old-style-pathname? object)
+  (and (vector? object)
+       (fix:= 7 (vector-length object))
+       (eq? '|#[(runtime pathname)pathname]| (vector-ref object 0))))
+
+;; This can be removed after the 9.3 release.
+(define (convert-old-style-pathname object)
+  (if (old-style-pathname? object)
+      (%make-pathname (let ((host (vector-ref object 1)))
+                       (if (and (vector? host)
+                                (fix:= 3 (vector-length host))
+                                (eq? '|#[(runtime pathname)host]|
+                                     (vector-ref host 0)))
+                           (%make-host (vector-ref host 1)
+                                       (vector-ref host 2))
+                           host))
+                     (vector-ref object 2)
+                     (vector-ref object 3)
+                     (vector-ref object 4)
+                     (vector-ref object 5)
+                     (vector-ref object 6))
+      object))
\ No newline at end of file

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 10881b824ab7ff18c2d4467a2c150477ccf7ca26..00e1dce0bb0100ceb87e01c6cb086d8cedf81cde 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3439,6 +3439,9 @@ USA.
          system-library-pathname
          uri->pathname
          user-homedir-pathname)
+  (export (runtime compiler-info)
+         %make-host
+         %make-pathname)
   (export (runtime load)
          library-directory-path)
   (initialization (initialize-package!)))