From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 15 Feb 2017 04:16:49 +0000 (-0800)
Subject: Change make-signal-combiner to be iterative.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~109
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=42bf3fda396fee95cb6dbc55bee760cb475ce08e;p=mit-scheme.git

Change make-signal-combiner to be iterative.
---

diff --git a/src/runtime/chrset.scm b/src/runtime/chrset.scm
index f98bb11f5..bea5185a7 100644
--- a/src/runtime/chrset.scm
+++ b/src/runtime/chrset.scm
@@ -208,52 +208,56 @@ USA.
 
 (define (make-signal-combiner combine)
 
-  (define (loop v start sig1 sig2)
-    (cond ((not (pair? sig1)) (tail v 2 start sig2))
-	  ((not (pair? sig2)) (tail v 1 start sig1))
+  (define (loop v start sig1 sig2 result)
+    (cond ((not (pair? sig1)) (tail v 2 start sig2 result))
+	  ((not (pair? sig2)) (tail v 1 start sig1 result))
 	  (else
 	   (let ((end (fix:min (car sig1) (car sig2))))
-	     (process v start end
-		      (cond ((fix:> (car sig2) end)
-			     (loop (fix:xor v 1)
-				   end
-				   (cdr sig1)
-				   sig2))
-			    ((fix:> (car sig1) end)
-			     (loop (fix:xor v 2)
-				   end
-				   sig1
-				   (cdr sig2)))
-			    (else
-			     (loop (fix:xor v 3)
-				   end
-				   (cdr sig1)
-				   (cdr sig2)))))))))
-
-  (define (tail v vi start signal)
+	     (let ((result* (process v start end result)))
+	       (cond ((fix:> (car sig2) end)
+		      (loop (fix:xor v 1)
+			    end
+			    (cdr sig1)
+			    sig2
+			    result*))
+		     ((fix:> (car sig1) end)
+		      (loop (fix:xor v 2)
+			    end
+			    sig1
+			    (cdr sig2)
+			    result*))
+		     (else
+		      (loop (fix:xor v 3)
+			    end
+			    (cdr sig1)
+			    (cdr sig2)
+			    result*))))))))
+
+  (define (tail v vi start signal result)
     (if (pair? signal)
 	(let ((end (car signal)))
-	  (process v start end
-		   (tail (fix:xor v vi)
-			 vi
-			 end
-			 (cdr signal))))
-	(if (fix:< start #x110000)
-	    (process v start #x110000 '())
-	    '())))
-
-  (define (process v start end signal)
+	  (tail (fix:xor v vi)
+		vi
+		end
+		(cdr signal)
+		(process v start end result)))
+	(reverse!
+	 (if (fix:< start #x110000)
+	     (process v start #x110000 result)
+	     result))))
+
+  (define (process v start end result)
     (if (and (fix:< start end)
 	     (combine (fix:= 1 (fix:and v 1))
 		      (fix:= 2 (fix:and v 2))))
-	(if (and (pair? signal)
-		 (fix:= end (car signal)))
-	    (scons start (cadr signal) (cddr signal))
-	    (scons start end signal))
-	signal))
+	(if (and (pair? result)
+		 (fix:= start (car result)))
+	    (rcons (cadr result) end (cddr result))
+	    (rcons start end result))
+	result))
 
   (lambda (sig1 sig2)
-    (loop 0 0 sig1 sig2)))
+    (loop 0 0 sig1 sig2 '())))
 
 ;;;; Constructors