(mel-ccl-decode-b): Use <(` ...)>, <(, ...)> and <(,@ ...)> instead of
authorueno <ueno>
Thu, 19 Aug 1999 22:24:21 +0000 (22:24 +0000)
committerueno <ueno>
Thu, 19 Aug 1999 22:24:21 +0000 (22:24 +0000)
<`...>, <,...> and <,@...>.
(mel-ccl-encode-base64-generic): Likewise.

mel-b-ccl.el

index fa12483..90484b3 100644 (file)
@@ -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