From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 10 Feb 2019 22:25:12 +0000 (+0000)
Subject: Convert multi-LETREC to internal definitions.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~7^2~17
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5bf626e1a9548dd64f3f9383c1b6c1e34fb63159;p=mit-scheme.git

Convert multi-LETREC to internal definitions.

The compressor turns up hot in profiles.  This doesn't make a big
difference but it saves some closure consing and reduces some
indentation levels.
---

diff --git a/src/runtime/cpress.scm b/src/runtime/cpress.scm
index 4fce40335..9d815961c 100644
--- a/src/runtime/cpress.scm
+++ b/src/runtime/cpress.scm
@@ -144,50 +144,47 @@ USA.
 
 (define (generate-literal state)
   (guarantee-buffer-space state (fix:+ literal-max 2))
-  (letrec
-      ((loop
-	(lambda (nb)
-	  (let ((node (match-first state)))
+  (define (loop nb)
+    (let ((node (match-first state)))
+      (if (not node)
+	  (continue nb)
+	  (let ((node (match-next state node 1)))
 	    (if (not node)
 		(continue nb)
-		(let ((node (match-next state node 1)))
+		(let ((node (match-next state node 2)))
 		  (if (not node)
-		      (continue nb)
-		      (let ((node (match-next state node 2)))
-			(if (not node)
+		      (begin
+			(unread-byte state)
+			(continue nb))
+		      (let ((nb*
+			     (let ((cbp (current-bp state))
+				   (nbp (node-bp node)))
+			       (fix:- (if (fix:< cbp nbp)
+					  (fix:+ cbp buffer-size)
+					  cbp)
+				      nbp))))
+			(if (fix:< nb* 3)
+			    ;; Don't consider matches that
+			    ;; would result in a copy that is
+			    ;; copying from itself.
 			    (begin
-			      (unread-byte state)
+			      (unread-bytes state 2)
 			      (continue nb))
-			    (let ((nb*
-				   (let ((cbp (current-bp state))
-					 (nbp (node-bp node)))
-				     (fix:- (if (fix:< cbp nbp)
-						(fix:+ cbp buffer-size)
-						cbp)
-					    nbp))))
-			      (if (fix:< nb* 3)
-				  ;; Don't consider matches that
-				  ;; would result in a copy that is
-				  ;; copying from itself.
-				  (begin
-				    (unread-bytes state 2)
-				    (continue nb))
-				  (begin
-				    (write-literal state nb)
-				    (generate-copy state node 3))))))))))))
-       (continue
-	(lambda (nb)
-	  (increment-current-pointer state)
-	  (increment-bp state)
-	  (let ((nb (fix:+ nb 1)))
-	    (if (fix:< nb literal-max)
-		(loop nb)
-		(begin
-		  (write-literal state nb)
-		  (idle state)))))))
+			    (begin
+			      (write-literal state nb)
+			      (generate-copy state node 3)))))))))))
+  (define (continue nb)
     (increment-current-pointer state)
     (increment-bp state)
-    (loop 1)))
+    (let ((nb (fix:+ nb 1)))
+      (if (fix:< nb literal-max)
+	  (loop nb)
+	  (begin
+	    (write-literal state nb)
+	    (idle state)))))
+  (increment-current-pointer state)
+  (increment-bp state)
+  (loop 1))
 
 (define (generate-copy state node nb)
   (guarantee-buffer-space state copy-max)