From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 8 Dec 2018 16:37:04 +0000 (+0000)
Subject: Handle reference traps and interpreter return addresses.
X-Git-Tag: mit-scheme-pucked-10.1.9~3^2~35^2~53
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b7a9061671f4630e42fe5bbbb4abe08d41f7e896;p=mit-scheme.git

Handle reference traps and interpreter return addresses.
---

diff --git a/src/compiler/base/fasdump.scm b/src/compiler/base/fasdump.scm
index ccf09cf96..dceb63f5a 100644
--- a/src/compiler/base/fasdump.scm
+++ b/src/compiler/base/fasdump.scm
@@ -1020,9 +1020,6 @@ USA.
 (define trap:unbound 2)
 (define trap-max-immediate 9)
 
-(define (reference-trap-kind trap)
-  (error 'reference-trap-kind trap))
-
 (define (reference-trap-extra trap)
   (error 'reference-trap-extra trap))
 
diff --git a/tests/compiler/test-fasdump.scm b/tests/compiler/test-fasdump.scm
index ceda79438..a80faa808 100644
--- a/tests/compiler/test-fasdump.scm
+++ b/tests/compiler/test-fasdump.scm
@@ -43,6 +43,10 @@ USA.
                 (eqv? (flo:sign-negative? x) (flo:sign-negative? y))
                 (eqv? (flo:nan-quiet? x) (flo:nan-quiet? y))
                 (eqv? (flo:nan-payload x) (flo:nan-payload y))))
+          ((reference-trap? x)
+           (and (reference-trap? y)
+                (eqv? (reference-trap-kind x) (reference-trap-kind y))
+                (<= (reference-trap-kind x) trap-max-immediate)))
           ((scode-access? x)
            (and (scode-access? y)
                 (loop (scode-access-environment x)
@@ -217,8 +221,8 @@ USA.
     (xyz)
     ;; XXX uninterned symbols
     (,(make-primitive-procedure 'quagga 42))
-    ;; XXX reference trap
-    ;; XXX interpreter return address, wtf?
+    (,(make-unassigned-reference-trap))
+    (,(make-return-address 42))
     (#\U+0)
     (#\0)
     (#\U+1000)
@@ -277,7 +281,10 @@ USA.
             (lambda (pathname)
               (let ((format fasdump-format:amd64))
                 (portable-fasdump object pathname format))
-              (let ((object* (fasload pathname)))
+              (let ((object*
+                     (map-reference-trap
+                      (lambda ()
+                        (fasload pathname)))))
                 (if (not (equal-nan-scode? object object*))
                     (begin
                       (pp 'fail)