From d87927c7f84291024e681c03b2eb87782b7dc79c Mon Sep 17 00:00:00 2001
From: ueno <ueno>
Date: Thu, 19 Aug 1999 22:24:21 +0000
Subject: [PATCH] (mel-ccl-decode-b): Use <(` ...)>, <(, ...)> and <(,@ ...)>
 instead of <`...>, <,...> and <,@...>.
 (mel-ccl-encode-base64-generic): Likewise.

---
 mel-b-ccl.el |  334 +++++++++++++++++++++++-----------------------------------
 1 file changed, 132 insertions(+), 202 deletions(-)

diff --git a/mel-b-ccl.el b/mel-b-ccl.el
index fa12483..90484b3 100644
--- a/mel-b-ccl.el
+++ b/mel-b-ccl.el
@@ -151,134 +151,64 @@ abcdefghijklmnopqrstuvwxyz\
 
 (if-broken ccl-cascading-read
     (define-ccl-program mel-ccl-decode-b
-      `(1
-	(loop
-	 (loop
-	  (read-branch
-	   r1
-	   ,@(mapcar
-	      (lambda (v)
-		(cond
-		 ((or (eq v nil) (eq v t)) '(repeat))
-		 (t `((r0 = ,(lsh v 2)) (break)))))
-	      mel-ccl-256-to-64-table)))
-	 (loop
-	  (read-branch
-	   r1
-	   ,@(mapcar
-	      (lambda (v)
-		(cond
-		 ((or (eq v nil) (eq v t)) '(repeat))
-		 ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))
-		 (t `((r0 |= ,(lsh v -4)) (write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))))
-	      mel-ccl-256-to-64-table)))
-	 (loop
-	  (read-branch
-	   r1
-	   ,@(mapcar
-	      (lambda (v)
-		(cond
-		 ((eq v nil) '(repeat))
-		 ((eq v t) '(end))
-		 ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))
-		 (t `((r0 |= ,(lsh v -2)) (write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))))
-	      mel-ccl-256-to-64-table)))
-	 (loop
-	  (read-branch
-	   r1
-	   ,@(mapcar
-	      (lambda (v)
-		(cond
-		 ((eq v nil) '(repeat))
-		 ((eq v t) '(end))
-		 (t `((r0 |= ,v) (write r0) (break)))))
-	      mel-ccl-256-to-64-table)))
-	 (repeat))))
-  (define-ccl-program mel-ccl-decode-b
-    `(1
-      (loop
-       (read r0 r1 r2 r3)
-       (r4 = r0 ,mel-ccl-decode-b-0-table)
-       (r5 = r1 ,mel-ccl-decode-b-1-table)
-       (r4 |= r5)
-       (r5 = r2 ,mel-ccl-decode-b-2-table)
-       (r4 |= r5)
-       (r5 = r3 ,mel-ccl-decode-b-3-table)
-       (r4 |= r5)
-       (if (r4 & ,(lognot (1- (lsh 1 24))))
-	   ((loop
-	     (if (r4 & ,(lsh 1 24))
-		 ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
-		  (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
-		  (r5 = r3 ,mel-ccl-decode-b-3-table)
-		  (r4 |= r5)
-		  (repeat))
-	       (break)))
-	    (loop
-	     (if (r4 & ,(lsh 1 25))
-		 ((r1 = r2) (r2 = r3) (read r3)
-		  (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
-		  (r5 = r3 ,mel-ccl-decode-b-3-table)
-		  (r4 |= r5)
-		  (repeat))
-	       (break)))
-	    (loop
-	     (if (r2 != ?=)
-		 (if (r4 & ,(lsh 1 26))
-		     ((r2 = r3) (read r3)
-		      (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
-		      (r5 = r3 ,mel-ccl-decode-b-3-table)
-		      (r4 |= r5)
-		      (repeat))
-		   ((r6 = 0)
-		    (break)))
-	       ((r6 = 1)
-		(break))))
-	    (loop
-	     (if (r3 != ?=)
-		 (if (r4 & ,(lsh 1 27))
-		     ((read r3)
-		      (r4 = r3 ,mel-ccl-decode-b-3-table)
-		      (repeat))
-		   (break))
-	       ((r6 |= 2)
-		(break))))
-	    (r4 = r0 ,mel-ccl-decode-b-0-table)
-	    (r5 = r1 ,mel-ccl-decode-b-1-table)
-	    (r4 |= r5)
-	    (branch
-	     r6
-	     ;; BBBB
-	     ((r5 = r2 ,mel-ccl-decode-b-2-table)
-	      (r4 |= r5)
-	      (r5 = r3 ,mel-ccl-decode-b-3-table)
-	      (r4 |= r5)
-	      (r4 >8= 0)
-	      (write r7)
-	      (r4 >8= 0)
-	      (write r7)
-	      (write-repeat r4))
-	     ;; error: BB=B 
-	     ((write (r4 & 255))
-	      (end))
-	     ;; BBB=
-	     ((r5 = r2 ,mel-ccl-decode-b-2-table)
-	      (r4 |= r5)
-	      (r4 >8= 0)
-	      (write r7)
-	      (write (r4 & 255))
-	      (end)			; Excessive (end) is workaround for XEmacs 21.0.
-					; Without this, "AAA=" is converted to "^@^@^@".
-	      (end))
-	     ;; BB==
-	     ((write (r4 & 255))
-	      (end))))
-	 ((r4 >8= 0)
-	  (write r7)
-	  (r4 >8= 0)
-	  (write r7)
-	  (write-repeat r4))))))
-  )
+      (` (1
+	  (loop
+	   (loop
+	    (read-branch
+	     r1
+	     (,@ (mapcar
+		  (lambda (v)
+		    (cond
+		     ((or (eq v nil) (eq v t)) '(repeat))
+		     (t (` ((r0 = (, (lsh v 2))) (break))))))
+		  mel-ccl-256-to-64-table))))
+	   (loop
+	    (read-branch
+	     r1
+	     (,@ (mapcar
+		  (lambda (v)
+		    (cond
+		     ((or (eq v nil) (eq v t)) '(repeat))
+		     ((= (lsh v -4) 0)
+		      (` ((write r0)
+			  (r0 = (, (lsh (logand v 15) 4)))
+			  (break))))
+		     (t 
+		      (` ((r0 |= (, (lsh v -4))) 
+			  (write r0) 
+			  (r0 = (, (lsh (logand v 15) 4))) 
+			  (break))))))
+		  mel-ccl-256-to-64-table))))
+	   (loop
+	    (read-branch
+	     r1
+	     (,@ (mapcar
+		  (lambda (v)
+		    (cond
+		     ((eq v nil) '(repeat))
+		     ((eq v t) '(end))
+		     ((= (lsh v -2) 0)
+		      (` ((write r0) 
+			  (r0 = (, (lsh (logand v 3) 6)))
+			  (break))))
+		     (t
+		      (` ((r0 |= (, (lsh v -2)))
+			  (write r0) 
+			  (r0 = (, (lsh (logand v 3) 6)))
+			  (break))))))
+		  mel-ccl-256-to-64-table))))
+	   (loop
+	    (read-branch
+	     r1
+	     (,@ (mapcar
+		  (lambda (v)
+		    (cond
+		     ((eq v nil) '(repeat))
+		     ((eq v t) '(end))
+		     (t (` ((r0 |= (, v)) (write r0) (break))))))
+		  mel-ccl-256-to-64-table))))
+	   (repeat)))))
+    )
 
 (eval-when-compile
 
@@ -286,81 +216,81 @@ abcdefghijklmnopqrstuvwxyz\
 ;; is not executed.
 (defun mel-ccl-encode-base64-generic
   (&optional quantums-per-line output-crlf terminate-with-newline)
-  `(2
-    ((r3 = 0)
-     (r2 = 0)
-     (read r1)
-     (loop
+  (` (2
+      ((r3 = 0)
+       (r2 = 0)
+       (read r1)
+       (loop
+	(branch
+	 r1
+	 (,@ (mapcar
+	      (lambda (r1)
+		(` ((write (, (nth (lsh r1 -2) mel-ccl-64-to-256-table)))
+		    (r0 = (, (logand r1 3))))))
+	      mel-ccl-256-table)))
+	(r2 = 1)
+	(read-branch
+	 r1
+	 (,@ (mapcar
+	      (lambda (r1)
+		(` ((write r0 (, (vconcat
+				  (mapcar
+				   (lambda (r0)
+				     (nth (logior (lsh r0 4)
+						  (lsh r1 -4))
+					  mel-ccl-64-to-256-table))
+				   mel-ccl-4-table))))
+		    (r0 = (, (logand r1 15))))))
+	      mel-ccl-256-table)))
+	(r2 = 2)
+	(read-branch
+	 r1
+	 (,@ (mapcar
+	      (lambda (r1)
+		(` ((write r0 (, (vconcat
+				  (mapcar
+				   (lambda (r0)
+				     (nth (logior (lsh r0 2)
+						  (lsh r1 -6))
+					  mel-ccl-64-to-256-table))
+				   mel-ccl-16-table)))))))
+	      mel-ccl-256-table)))
+	(r1 &= 63)
+	(write r1 (, (vconcat
+		      (mapcar
+		       (lambda (r1)
+			 (nth r1 mel-ccl-64-to-256-table))
+		       mel-ccl-64-table))))
+	(r3 += 1)
+	(r2 = 0)
+	(read r1)
+	(,@ (when quantums-per-line
+	      (` ((if (r3 == (, quantums-per-line))
+		      ((write (, (if output-crlf "\r\n" "\n")))
+		       (r3 = 0)))))))
+	(repeat)))
       (branch
-       r1
-       ,@(mapcar
-          (lambda (r1)
-            `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
-              (r0 = ,(logand r1 3))))
-          mel-ccl-256-table))
-      (r2 = 1)
-      (read-branch
-       r1
-       ,@(mapcar
-          (lambda (r1)
-            `((write r0 ,(vconcat
-                          (mapcar
-                           (lambda (r0)
-                             (nth (logior (lsh r0 4)
-                                          (lsh r1 -4))
-                                  mel-ccl-64-to-256-table))
-                           mel-ccl-4-table)))
-              (r0 = ,(logand r1 15))))
-          mel-ccl-256-table))
-      (r2 = 2)
-      (read-branch
-       r1
-       ,@(mapcar
-          (lambda (r1)
-            `((write r0 ,(vconcat
-                          (mapcar
-                           (lambda (r0)
-                             (nth (logior (lsh r0 2)
-                                          (lsh r1 -6))
-                                  mel-ccl-64-to-256-table))
-                           mel-ccl-16-table)))))
-          mel-ccl-256-table))
-      (r1 &= 63)
-      (write r1 ,(vconcat
-                  (mapcar
-                   (lambda (r1)
-                     (nth r1 mel-ccl-64-to-256-table))
-                   mel-ccl-64-table)))
-      (r3 += 1)
-      (r2 = 0)
-      (read r1)
-      ,@(when quantums-per-line
-	  `((if (r3 == ,quantums-per-line)
-		((write ,(if output-crlf "\r\n" "\n"))
-		 (r3 = 0)))))
-      (repeat)))
-    (branch
-     r2
-     ,(if terminate-with-newline
-	  `(if (r3 > 0) (write ,(if output-crlf "\r\n" "\n")))
-	`(r0 = 0))
-     ((write r0 ,(vconcat
-                  (mapcar
-                   (lambda (r0)
-                     (nth (lsh r0 4) mel-ccl-64-to-256-table))
-                   mel-ccl-4-table)))
-      (write ,(if terminate-with-newline
-		  (if output-crlf "==\r\n" "==\n")
-		"==")))
-     ((write r0 ,(vconcat
-                  (mapcar
-                   (lambda (r0)
-                     (nth (lsh r0 2) mel-ccl-64-to-256-table))
-                   mel-ccl-16-table)))
-      (write ,(if terminate-with-newline
-		  (if output-crlf "=\r\n" "=\n")
-		"="))))
-    ))
+       r2
+       (, (if terminate-with-newline
+	      (` (if (r3 > 0) (write (, (if output-crlf "\r\n" "\n")))))
+	    (` (r0 = 0))))
+       ((write r0 (, (vconcat
+		      (mapcar
+		       (lambda (r0)
+			 (nth (lsh r0 4) mel-ccl-64-to-256-table))
+		       mel-ccl-4-table))))
+	(write (, (if terminate-with-newline
+		      (if output-crlf "==\r\n" "==\n")
+		    "=="))))
+       ((write r0 (, (vconcat
+		      (mapcar
+		       (lambda (r0)
+			 (nth (lsh r0 2) mel-ccl-64-to-256-table))
+		       mel-ccl-16-table))))
+	(write (, (if terminate-with-newline
+		      (if output-crlf "=\r\n" "=\n")
+		    "=")))))
+      )))
 )
 
 (define-ccl-program mel-ccl-encode-b
-- 
1.7.10.4