From dba1a213eb2c48b31bfeaa2f2be56b97d1690927 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 19 Mar 1990 12:11:26 +0000
Subject: [PATCH] Macroified I-vector dumping a bit.

---
 compiler/old-rt/dump.lisp | 35 ++++++++++++++---------------------
 1 file changed, 14 insertions(+), 21 deletions(-)

diff --git a/compiler/old-rt/dump.lisp b/compiler/old-rt/dump.lisp
index d71a49a12..9f9f75f41 100644
--- a/compiler/old-rt/dump.lisp
+++ b/compiler/old-rt/dump.lisp
@@ -1029,30 +1029,23 @@
 		      ((plusp shift))
 		    (dump-byte (logand (ash int shift) #xFF) file)))))))
 	  (t
+	   (macrolet ((frob (initial step done)
+			`(let ((shift ,initial)
+			       (byte 0))
+			   (dotimes (i len)
+			     (let ((int (aref vec i)))
+			       (setq byte (logior byte (ash int shift)))
+			       (,step shift size))
+			     (when ,done
+			       (dump-byte byte file)
+			       (setq shift ,initial  byte 0)))
+			   (unless (= shift ,initial) (dump-byte byte file)))))
 	   (ecase target-byte-order
 	     (:little-endian
-	      (let ((shift 0)
-		    (byte 0))
-		(dotimes (i len)
-		  (let ((int (aref vec i)))
-		    (setq byte (logior byte (ash int shift)))
-		    (incf shift size))
-		  (when (= shift 8)
-		    (dump-byte byte file)
-		    (setq shift 0  byte 0)))
-		(unless (zerop shift) (dump-byte byte file))))
+	      (frob 0 incf (= shift 8)))
 	     (:big-endian
-	      (let* ((initial-shift (- 8 size))
-		     (shift initial-shift)
-		     (byte 0))
-		(dotimes (i len)
-		  (let ((int (aref vec i)))
-		    (setq byte (logior byte (ash int shift)))
-		    (decf shift size))
-		  (when (minusp shift)
-		    (dump-byte byte file)
-		    (setq shift initial-shift  byte 0)))
-		(unless (= shift initial-shift) (dump-byte byte file)))))))))
+	      (let ((initial-shift (- 8 size)))
+		(frob initial-shift decf (minusp shift))))))))))
 
 
 ;;; Dump a character.
-- 
GitLab