From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Mon, 20 Sep 1993 19:12:59 +0000 (+0000)
Subject: Simplify interface to purify.
X-Git-Tag: 20090517-FFI~7821
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d877969670746ced74b18731dc3884b5715ee655;p=mit-scheme.git

Simplify interface to purify.
---

diff --git a/v7/src/runtime/gc.scm b/v7/src/runtime/gc.scm
index 56cf31754..a0767b8cb 100644
--- a/v7/src/runtime/gc.scm
+++ b/v7/src/runtime/gc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: gc.scm,v 14.11 1993/09/20 19:10:58 gjr Exp $
+$Id: gc.scm,v 14.12 1993/09/20 19:12:59 gjr Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -81,7 +81,10 @@ MIT in each case. |#
 
   (cond ((not (null? pure-space-queue))
 	 (let ((result (purify-internal pure-space-queue true safety-margin)))
-	   (cond ((not (car result))
+	   (cond ((not (pair? result))
+		  ;; Wrong phase -- wait until next time.
+		  (real-default))
+		 ((not (car result))
 		  (set! pure-space-queue (cdr pure-space-queue))
 		  (queued-purification-failure))
 		 ((eq? (car result) true)
@@ -93,7 +96,9 @@ MIT in each case. |#
 	((not (null? constant-space-queue))
 	 (let ((result
 		(purify-internal constant-space-queue false safety-margin)))
-	   (cond ((not (car result))
+	   (cond ((not (pair? result))
+		  (real-default))
+		 ((not (car result))
 		  (set! constant-space-queue (cdr constant-space-queue))
 		  (queued-purification-failure))
 		 ((eq? (car result) true)
@@ -116,12 +121,12 @@ MIT in each case. |#
 		      (purify-internal item
 				       pure-space?
 				       default-safety-margin)))
-		 (cond ((not (car result))
-			(error "PURIFY: not enough room in constant space"
-			       item))
-		       ((not (eq? (car result) true))
+		 (cond ((not (pair? result))
 			;; Wrong phase -- try again.
 			(loop))
+		       ((not (car result))
+			(error "PURIFY: not enough room in constant space"
+			       item))
 		       (else
 			unspecific)))))
 	    (pure-space?