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