[Mew-dist 10934] mew-header-decode-base64

[Masaki KONUMA]

mew-header-decode-base64 が、

o 遅いように見える

o mew-header-sanity-check-string しているので実質的な問題はないが、
  (mew-header-decode-base64 (mew-header-encode-base64 "abcd"))
    ==> "abcd^@^@"
  となって気持ち悪い

のでパッチです。mew-header-encode-base64 も少し速くなります。

-- 小沼雅樹
-------------- next part --------------
--- mew-bq.el.orig	Mon Aug 30 12:43:14 1999
+++ mew-bq.el	Wed Sep 29 14:26:24 1999
@@ -18,10 +18,15 @@
   (list (cons "B" 'mew-header-decode-base64)
 	(cons "Q" 'mew-header-decode-qp)))
 
-(defconst mew-base64-boundary1 26)
-(defconst mew-base64-boundary2 52)
-(defconst mew-base64-boundary3 62)
-(defconst mew-base64-boundary4 63)
+(defconst mew-base64-char64
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+
+(defconst mew-base64-char256
+  (let ((i 0) (len (length mew-base64-char64)) (s (make-string 256 0)))
+    (while (< i len)
+      (aset s (aref mew-base64-char64 i) i)
+      (setq i (1+ i)))
+    s))
 
 (defconst mew-header-decode-regex 
   "=\\?\\([^? \t]+\\)\\?\\(.\\)\\?\\([^? \t]+\\)\\?=")
@@ -73,100 +78,79 @@
 ;;; Base64 encoding
 ;;;
 
-(defun mew-base64-char256 (ch64)
-  (cond
-   ((null ch64) 0)
-   ((and (<= ?A ch64) (<= ch64 ?Z)) (- ch64 ?A))
-   ((and (<= ?a ch64) (<= ch64 ?z)) (+ (- ch64 ?a) mew-base64-boundary1))
-   ((and (<= ?0 ch64) (<= ch64 ?9)) (+ (- ch64 ?0) mew-base64-boundary2))
-   ((char-equal ch64 ?+) mew-base64-boundary3)
-   ((char-equal ch64 ?/) mew-base64-boundary4)
-   ((char-equal ch64 ?=) 0)))
-
 (defun mew-header-encode-base64 (str256)
   (let* ((len (length str256))
 	 (ret (make-string (* (/ (+ len 2) 3) 4) ?=))
-	 (lim (* (/ len 3) 3))
 	 (pad (% len 3))
-	 (i 0) (j 0) char0 char1 char2)
-    (while (< i lim)
-      (setq char0 (aref str256 i))
-      (setq i (1+ i))
-      (setq char1 (aref str256 i))
-      (setq i (1+ i))
-      (setq char2 (aref str256 i))
-      (setq i (1+ i))
-      (aset ret j (mew-base64-char64 (lsh char0 -2)))
-      (setq j (1+ j))
-      (aset ret j (mew-base64-char64 (logior (lsh (logand char0 3) 4)
-					     (lsh char1 -4))))
-      (setq j (1+ j))
-      (aset ret j (mew-base64-char64 (logior (lsh (logand char1 15) 2)
-					     (lsh char2 -6))))
-      (setq j (1+ j))
-      (aset ret j (mew-base64-char64 (logand char2 63)))
-      (setq j (1+ j)))
+	 (lim (- len pad))
+	 (i -1) (j -1) c)
+    (while (< (setq i (1+ i)) lim)
+      (setq c (logior (lsh (aref str256 i) 16)
+		      (lsh (aref str256 (setq i (1+ i))) 8)
+		      (aref str256 (setq i (1+ i)))))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (lsh c -18)))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (logand (lsh c -12) 63)))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (logand (lsh c -6) 63)))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (logand c 63))))
     (cond
-     ((equal pad 1)
-      (setq char0 (aref str256 i))
-      (setq char1 0)
-      (aset ret j (mew-base64-char64 (lsh char0 -2)))
-      (setq j (1+ j))
-      (aset ret j (mew-base64-char64 (logior (lsh (logand char0 3) 4)
-					     (lsh char1 -4))))
-      (setq j (1+ j)))
-     ((equal pad 2)
-      (setq char0 (aref str256 i))
-      (setq i (1+ i))
-      (setq char1 (aref str256 i))
-      (setq char2 0)
-      (aset ret j (mew-base64-char64 (lsh char0 -2)))
-      (setq j (1+ j))
-      (aset ret j (mew-base64-char64 (logior (lsh (logand char0 3) 4)
-					     (lsh char1 -4))))
-      (setq j (1+ j))
-      (aset ret j (mew-base64-char64 (logior (lsh (logand char1 15) 2)
-					     (lsh char2 -6))))
-      (setq j (1+ j))))
+     ((= pad 1)
+      (setq c (aref str256 i))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (lsh c -2)))
+      (aset ret (1+ j)
+	    (aref mew-base64-char64 (lsh (logand c 3) 4))))
+     ((= pad 2)
+      (setq c (logior (lsh (aref str256 i) 8)
+		      (aref str256 (1+ i))))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (lsh c -10)))
+      (aset ret (setq j (1+ j))
+	    (aref mew-base64-char64 (logand (lsh c -4) 63)))
+      (aset ret (1+ j)
+	    (aref mew-base64-char64 (logand (lsh c 2) 63)))))
     ret))
-	      
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Base64 decoding
 ;;;
 
-(defun mew-base64-char64 (ch256)
-  (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 
-	ch256))
-
 (defun mew-header-decode-base64 (str64)
   (let* ((len (length str64))
-	 (ret (make-string len ?a))
-	 (i 0) (j 0) (padlen 0) char0 char1 char2 char3)
+	 ret
+	 (i 0) (j -1) (padlen 0) c)
     (if (string-match "=+$" str64)
 	(setq padlen (- (match-end 0) (match-beginning 0))))
-    (if (or (string-match "[^a-zA-Z0-9+/=]" str64)
-	    (not (equal (* (/ len 4) 4) len))
-	    (< padlen 0)
-	    (> padlen 3))
-	mew-error-illegal-base64 ;; return value
-      (setq len (- len padlen))
-      (while (< i len)
-	(setq char0 (mew-base64-char256 (aref str64 i)))
-	(setq i (1+ i))
-	(setq char1 (mew-base64-char256 (aref str64 i)))
-	(setq i (1+ i))
-	(setq char2 (mew-base64-char256 (aref str64 i)))
-	(setq i (1+ i))
-	(setq char3 (mew-base64-char256 (aref str64 i)))
-	(setq i (1+ i))
-	(aset ret j (logand (logior (lsh char0 2) (lsh char1 -4)) 255))
-	(setq j (1+ j))
-	(aset ret j (logand (logior (lsh char1 4) (lsh char2 -2)) 255))
-	(setq j (1+ j))
-	(aset ret j (logand (logior (lsh char2 6) char3) 255))
-	(setq j (1+ j)))
-      (substring ret 0 j))))
+    (cond
+     ((or (string-match "[^a-zA-Z0-9+/=]" str64)
+	  (not (zerop (logand len 3)))
+	  (< padlen 0)
+	  (> padlen 2))
+      mew-error-illegal-base64)  ;; return value
+     ((zerop (setq len (- len padlen))) "")
+     (t
+      (setq ret (make-string (/ (* len 3) 4) ?a))
+      (while 
+	  (progn 
+	    (setq
+	     c (logior
+		(lsh (aref mew-base64-char256 (aref str64 i)) 18)
+		(lsh (aref mew-base64-char256 (aref str64 (setq i (1+ i)))) 12)
+		(lsh (aref mew-base64-char256 (aref str64 (setq i (1+ i)))) 6)
+		(aref mew-base64-char256 (aref str64 (setq i (1+ i))))))
+	    (aset ret (setq j (1+ j)) (lsh c -16))
+	    (< (setq i (1+ i)) len))
+	(aset ret (setq j (1+ j)) (logand (lsh c -8) 255))
+	(aset ret (setq j (1+ j)) (logand c 255)))
+      (if (< padlen 2)
+	  (aset ret (1+ j) (logand (lsh c -8) 255)))
+      (if (zerop padlen)
+	  (aset ret (1+ (1+ j)) (logand c 255)))
+      ret))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;