ew-ccl.el

   1 (require 'ccl)
   2 (require 'emu)
   3
   4 (provide 'ew-ccl)
   5
   6 ;;;
   7
   8 (eval-when-compile
   9
  10 (defconst ew-ccl-4-table
  11   '(  0   1   2   3))
  12
  13 (defconst ew-ccl-16-table
  14   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15))
  15
  16 (defconst ew-ccl-64-table
  17   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  18      16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
  19      32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
  20      48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63))
  21
  22 (defconst ew-ccl-256-table
  23   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  24      16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
  25      32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
  26      48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63
  27      64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79
  28      80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95
  29      96  97  98  99 100 101 102 103 104 105 106 107 108 109 110 111
  30     112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
  31     128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
  32     144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
  33     160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
  34     176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
  35     192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
  36     208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
  37     224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
  38     240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
  39
  40 (defconst ew-ccl-256-to-16-table
  41   '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  42     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  43     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  44       0   1   2   3   4   5   6   7   8   9 nil nil nil nil nil nil
  45     nil  10  11  12  13  14  15 nil nil nil nil nil nil nil nil nil
  46     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  47     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  48     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  49     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  50     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  51     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  52     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  53     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  54     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  55     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  56     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
  57
  58 (defconst ew-ccl-16-to-256-table
  59   '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
  60
  61 (defconst ew-ccl-high-table
  62   (vconcat
  63    (mapcar
  64     (lambda (v) (nth (lsh v -4) ew-ccl-16-to-256-table))
  65     ew-ccl-256-table)))
  66
  67 (defconst ew-ccl-low-table
  68   (vconcat
  69    (mapcar
  70     (lambda (v) (nth (logand v 15) ew-ccl-16-to-256-table))
  71     ew-ccl-256-table)))
  72
  73 (defconst ew-ccl-u-raw
  74   (append
  75    "0123456789"
  76    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  77    "abcdefghijklmnopqrstuvwxyz"
  78    "!@#$%&'()*+,-./:;<>@[\\]^`{|}~"
  79    ()))
  80
  81 (defconst ew-ccl-c-raw
  82   (append
  83    "0123456789"
  84    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  85    "abcdefghijklmnopqrstuvwxyz"
  86    "!@#$%&'*+,-./:;<>@[]^`{|}~"
  87    ()))
  88
  89 (defconst ew-ccl-p-raw
  90   (append
  91    "0123456789"
  92    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  93    "abcdefghijklmnopqrstuvwxyz"
  94    "!*+-/"
  95    ()))
  96
  97 (defconst ew-ccl-256-to-64-table
  98   '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  99     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 100     nil nil nil nil nil nil nil nil nil nil nil  62 nil nil nil  63
 101      52  53  54  55  56  57  58  59  60  61 nil nil nil   t nil nil
 102     nil   0   1   2   3   4   5   6   7   8   9  10  11  12  13  14
 103      15  16  17  18  19  20  21  22  23  24  25 nil nil nil nil nil
 104     nil  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40
 105      41  42  43  44  45  46  47  48  49  50  51 nil nil nil nil nil
 106     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 107     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 108     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 109     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 110     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 111     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 112     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 113     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
 114
 115 (defconst ew-ccl-64-to-256-table
 116   '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P
 117     ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d ?e ?f
 118     ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v
 119     ?w ?x ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?+ ?/))
 120
 121 (defconst ew-ccl-qp-table
 122   [enc enc enc enc enc enc enc enc enc wsp enc enc enc cr  enc enc
 123    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 124    wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 125    raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
 126    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 127    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 128    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 129    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
 130    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 131    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 132    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 133    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 134    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 135    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 136    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 137    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
 138
 139 )
 140
 141 (define-ccl-program ew-ccl-decode-q
 142   `(1
 143     ((loop
 144       (read-branch
 145        r0
 146        ,@(mapcar
 147           (lambda (r0)
 148             (cond
 149              ((= r0 ?_)
 150               `(write-repeat ? ))
 151              ((= r0 ?=)
 152               `((loop
 153                  (read-branch
 154                   r1
 155                   ,@(mapcar
 156                      (lambda (v)
 157                        (if (integerp v)
 158                            `((r0 = ,v) (break))
 159                          '(repeat)))
 160                      ew-ccl-256-to-16-table)))
 161                 (loop
 162                  (read-branch
 163                   r1
 164                   ,@(mapcar
 165                      (lambda (v)
 166                        (if (integerp v)
 167                            `((write r0 ,(vconcat
 168                                          (mapcar
 169                                           (lambda (r0)
 170                                             (logior (lsh r0 4) v))
 171                                           ew-ccl-16-table)))
 172                              (break))
 173                          '(repeat)))
 174                      ew-ccl-256-to-16-table)))
 175                 (repeat)))
 176              (t
 177               `(write-repeat ,r0))))
 178           ew-ccl-256-table))))))
 179
 180 (define-ccl-program ew-ccl-encode-uq
 181   `(3
 182     (loop
 183      (loop
 184       (read-branch
 185        r0
 186        ,@(mapcar
 187           (lambda (r0)
 188             (cond
 189              ((= r0 32) `(write-repeat ?_))
 190              ((member r0 ew-ccl-u-raw) `(write-repeat ,r0))
 191              (t '(break))))
 192           ew-ccl-256-table)))
 193      (write ?=)
 194      (write r0 ,ew-ccl-high-table)
 195      (write r0 ,ew-ccl-low-table)
 196      (repeat))))
 197
 198 (define-ccl-program ew-ccl-encode-cq
 199   `(3
 200     (loop
 201      (loop
 202       (read-branch
 203        r0
 204        ,@(mapcar
 205           (lambda (r0)
 206             (cond
 207              ((= r0 32) `(write-repeat ?_))
 208              ((member r0 ew-ccl-c-raw) `(write-repeat ,r0))
 209              (t '(break))))
 210           ew-ccl-256-table)))
 211      (write ?=)
 212      (write r0 ,ew-ccl-high-table)
 213      (write r0 ,ew-ccl-low-table)
 214      (repeat))))
 215
 216 (define-ccl-program ew-ccl-encode-pq
 217   `(3
 218     (loop
 219      (loop
 220       (read-branch
 221        r0
 222        ,@(mapcar
 223           (lambda (r0)
 224             (cond
 225              ((= r0 32) `(write-repeat ?_))
 226              ((member r0 ew-ccl-p-raw) `(write-repeat ,r0))
 227              (t '(break))))
 228           ew-ccl-256-table)))
 229      (write ?=)
 230      (write r0 ,ew-ccl-high-table)
 231      (write r0 ,ew-ccl-low-table)
 232      (repeat))))
 233
 234 (eval-when-compile
 235 (defun ew-ccl-decode-b-bit-ex (v)
 236   (logior
 237    (lsh (logand v (lsh 255 16)) -16)
 238    (logand v (lsh 255 8))
 239    (lsh (logand v 255) 16)))
 240
 241 (defconst ew-ccl-decode-b-0-table
 242   (vconcat
 243    (mapcar
 244     (lambda (v)
 245       (if (integerp v)
 246           (ew-ccl-decode-b-bit-ex (lsh v 18))
 247         (lsh 1 24)))
 248     ew-ccl-256-to-64-table)))
 249
 250 (defconst ew-ccl-decode-b-1-table
 251   (vconcat
 252    (mapcar
 253     (lambda (v)
 254       (if (integerp v)
 255           (ew-ccl-decode-b-bit-ex (lsh v 12))
 256         (lsh 1 25)))
 257     ew-ccl-256-to-64-table)))
 258
 259 (defconst ew-ccl-decode-b-2-table
 260   (vconcat
 261    (mapcar
 262     (lambda (v)
 263       (if (integerp v)
 264           (ew-ccl-decode-b-bit-ex (lsh v 6))
 265         (lsh 1 26)))
 266     ew-ccl-256-to-64-table)))
 267
 268 (defconst ew-ccl-decode-b-3-table
 269   (vconcat
 270    (mapcar
 271     (lambda (v)
 272       (if (integerp v)
 273           (ew-ccl-decode-b-bit-ex v)
 274         (lsh 1 27)))
 275     ew-ccl-256-to-64-table)))
 276
 277 )
 278
 279 (define-ccl-program ew-ccl-decode-b
 280   `(1
 281     (loop
 282      (read r0 r1 r2 r3)
 283      (r4 = r0 ,ew-ccl-decode-b-0-table)
 284      (r5 = r1 ,ew-ccl-decode-b-1-table)
 285      (r4 |= r5)
 286      (r5 = r2 ,ew-ccl-decode-b-2-table)
 287      (r4 |= r5)
 288      (r5 = r3 ,ew-ccl-decode-b-3-table)
 289      (r4 |= r5)
 290      (if (r4 & ,(lognot (1- (lsh 1 24))))
 291          ((loop
 292            (if (r4 & ,(lsh 1 24))
 293                ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
 294                 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 295                 (r5 = r3 ,ew-ccl-decode-b-3-table)
 296                 (r4 |= r5)
 297                 (repeat))
 298              (break)))
 299           (loop
 300            (if (r4 & ,(lsh 1 25))
 301                ((r1 = r2) (r2 = r3) (read r3)
 302                 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 303                 (r5 = r3 ,ew-ccl-decode-b-3-table)
 304                 (r4 |= r5)
 305                 (repeat))
 306              (break)))
 307           (loop
 308            (if (r2 != ?=)
 309                (if (r4 & ,(lsh 1 26))
 310                    ((r2 = r3) (read r3)
 311                     (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 312                     (r5 = r3 ,ew-ccl-decode-b-3-table)
 313                     (r4 |= r5)
 314                     (repeat))
 315                  ((r6 = 0)
 316                   (break)))
 317              ((r6 = 1)
 318               (break))))
 319           (loop
 320            (if (r3 != ?=)
 321                (if (r4 & ,(lsh 1 27))
 322                    ((read r3)
 323                     (r4 = r3 ,ew-ccl-decode-b-3-table)
 324                     (repeat))
 325                  (break))
 326              ((r6 |= 2)
 327               (break))))
 328           (r4 = r0 ,ew-ccl-decode-b-0-table)
 329           (r5 = r1 ,ew-ccl-decode-b-1-table)
 330           (r4 |= r5)
 331           (branch
 332            r6
 333            ;; BBBB
 334            ((r5 = r2 ,ew-ccl-decode-b-2-table)
 335             (r4 |= r5)
 336             (r5 = r3 ,ew-ccl-decode-b-3-table)
 337             (r4 |= r5)
 338             (r4 >8= 0)
 339             (write r7)
 340             (r4 >8= 0)
 341             (write r7)
 342             (write-repeat r4))
 343            ;; error: BB=B
 344            ((write r4)
 345             (end))
 346            ;; BBB=
 347            ((r5 = r2 ,ew-ccl-decode-b-2-table)
 348             (r4 |= r5)
 349             (r4 >8= 0)
 350             (write r7)
 351             (write r4)
 352             (end))
 353            ;; BB==
 354            ((write r4)
 355             (end))))
 356        ((r4 >8= 0)
 357         (write r7)
 358         (r4 >8= 0)
 359         (write r7)
 360         (write-repeat r4))))))
 361
 362 ;; ew-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
 363 ;; is not executed on 20.2 (or former?).
 364 (define-ccl-program ew-ccl-encode-b
 365   `(2
 366     (loop
 367      (r2 = 0)
 368      (read-branch
 369       r1
 370       ,@(mapcar
 371          (lambda (r1)
 372            `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
 373              (r0 = ,(logand r1 3))))
 374          ew-ccl-256-table))
 375      (r2 = 1)
 376      (read-branch
 377       r1
 378       ,@(mapcar
 379          (lambda (r1)
 380            `((write r0 ,(vconcat
 381                          (mapcar
 382                           (lambda (r0)
 383                             (nth (logior (lsh r0 4)
 384                                          (lsh r1 -4))
 385                                  ew-ccl-64-to-256-table))
 386                           ew-ccl-4-table)))
 387              (r0 = ,(logand r1 15))))
 388          ew-ccl-256-table))
 389      (r2 = 2)
 390      (read-branch
 391       r1
 392       ,@(mapcar
 393          (lambda (r1)
 394            `((write r0 ,(vconcat
 395                          (mapcar
 396                           (lambda (r0)
 397                             (nth (logior (lsh r0 2)
 398                                          (lsh r1 -6))
 399                                  ew-ccl-64-to-256-table))
 400                           ew-ccl-16-table)))))
 401          ew-ccl-256-table))
 402      (r1 &= 63)
 403      (write r1 ,(vconcat
 404                  (mapcar
 405                   (lambda (r1)
 406                     (nth r1 ew-ccl-64-to-256-table))
 407                   ew-ccl-64-table)))
 408      (repeat))
 409     (branch
 410      r2
 411      (end)
 412      ((write r0 ,(vconcat
 413                   (mapcar
 414                    (lambda (r0)
 415                      (nth (lsh r0 4) ew-ccl-64-to-256-table))
 416                    ew-ccl-4-table)))
 417       (write "=="))
 418      ((write r0 ,(vconcat
 419                   (mapcar
 420                    (lambda (r0)
 421                      (nth (lsh r0 2) ew-ccl-64-to-256-table))
 422                    ew-ccl-16-table)))
 423       (write ?=)))
 424     ))
 425
 426 ;;;
 427
 428 ;; ew-ccl-encode-base64 does not works on 20.2 by same reason of ew-ccl-encode-b
 429 (define-ccl-program ew-ccl-encode-base64
 430   `(2
 431     ((r3 = 0)
 432      (loop
 433       (r2 = 0)
 434       (read-branch
 435        r1
 436        ,@(mapcar
 437           (lambda (r1)
 438             `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
 439               (r0 = ,(logand r1 3))))
 440           ew-ccl-256-table))
 441       (r2 = 1)
 442       (read-branch
 443        r1
 444        ,@(mapcar
 445           (lambda (r1)
 446             `((write r0 ,(vconcat
 447                           (mapcar
 448                            (lambda (r0)
 449                              (nth (logior (lsh r0 4)
 450                                           (lsh r1 -4))
 451                                   ew-ccl-64-to-256-table))
 452                            ew-ccl-4-table)))
 453               (r0 = ,(logand r1 15))))
 454           ew-ccl-256-table))
 455       (r2 = 2)
 456       (read-branch
 457        r1
 458        ,@(mapcar
 459           (lambda (r1)
 460             `((write r0 ,(vconcat
 461                           (mapcar
 462                            (lambda (r0)
 463                              (nth (logior (lsh r0 2)
 464                                           (lsh r1 -6))
 465                                   ew-ccl-64-to-256-table))
 466                            ew-ccl-16-table)))))
 467           ew-ccl-256-table))
 468       (r1 &= 63)
 469       (write r1 ,(vconcat
 470                   (mapcar
 471                    (lambda (r1)
 472                      (nth r1 ew-ccl-64-to-256-table))
 473                    ew-ccl-64-table)))
 474       (r3 += 1)
 475       (if (r3 == 19) ; 4 * 19 = 76 --> line break.
 476           ((write "\r\n")
 477            (r3 = 0)))
 478       (repeat)))
 479     (branch
 480      r2
 481      (if (r0 > 0) (write "\r\n"))
 482      ((write r0 ,(vconcat
 483                   (mapcar
 484                    (lambda (r0)
 485                      (nth (lsh r0 4) ew-ccl-64-to-256-table))
 486                    ew-ccl-4-table)))
 487       (write "==\r\n"))
 488      ((write r0 ,(vconcat
 489                   (mapcar
 490                    (lambda (r0)
 491                      (nth (lsh r0 2) ew-ccl-64-to-256-table))
 492                    ew-ccl-16-table)))
 493       (write "=\r\n")))
 494     ))
 495
 496 ;; ew-ccl-encode-quoted-printable does not works on 20.2 by same reason of ew-ccl-encode-b
 497 (define-ccl-program ew-ccl-encode-quoted-printable
 498   `(4
 499     ((r6 = 0) ; column
 500      (r5 = 0) ; previous character is white space
 501      (r4 = 0)
 502      (read r0)
 503      (loop ; r6 <= 75
 504       (loop
 505        (loop
 506         (branch
 507          r0
 508          ,@(mapcar
 509             (lambda (r0)
 510               (let ((tmp (aref ew-ccl-qp-table r0)))
 511                 (cond
 512                  ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
 513                  ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
 514                  ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
 515                  ((eq tmp 'cr) '((r3 = 3) (break))) ; CR
 516                  )))
 517             ew-ccl-256-table)))
 518        (branch
 519         r3
 520         ;; r0:r3=RAW
 521         (if (r6 < 75)
 522             ((r6 += 1)
 523              (r5 = 0)
 524              (r4 = 1)
 525              (write-read-repeat r0))
 526           (break))
 527         ;; r0:r3=ENC
 528         ((r5 = 0)
 529          (if (r6 < 73)
 530              ((r6 += 3)
 531               (write "=")
 532               (write r0 ,ew-ccl-high-table)
 533               (r4 = 2)
 534               (write-read-repeat r0 ,ew-ccl-low-table))
 535            (if (r6 > 73)
 536                ((r6 = 3)
 537                 (write "=\r\n=")
 538                 (write r0 ,ew-ccl-high-table)
 539                 (r4 = 3)
 540                 (write-read-repeat r0 ,ew-ccl-low-table))
 541              (break))))
 542         ;; r0:r3=WSP
 543         ((r5 = 1)
 544          (if (r6 < 75)
 545              ((r6 += 1)
 546               (r4 = 4)
 547               (write-read-repeat r0))
 548            ((r6 = 1)
 549             (write "=\r\n")
 550             (r4 = 5)
 551             (write-read-repeat r0))))
 552         ;; r0:r3=CR
 553         ((if ((r6 > 73) & r5)
 554              ((r6 = 0)
 555               (r5 = 0)
 556               (write "=\r\n")))
 557          (break))))
 558       ;; r0:r3={RAW,ENC,CR}
 559       (loop
 560        (if (r0 == ?\r)
 561            ;; r0=\r:r3=CR
 562            ((r4 = 6)
 563             (read r0)
 564             ;; CR:r3=CR r0
 565             (if (r0 == ?\n)
 566                 ;; CR:r3=CR r0=LF
 567                 (if r5
 568                     ;; r5=WSP ; CR:r3=CR r0=LF
 569                     ((r6 = 0)
 570                      (r5 = 0)
 571                      (write "=\r\n\r\n")
 572                      (r4 = 7)
 573                      (read r0)
 574                      (break))
 575                   ;; r5=noWSP ; CR:r3=CR r0=LF
 576                   ((r6 = 0)
 577                    (r5 = 0)
 578                    (write "\r\n")
 579                    (r4 = 8)
 580                    (read r0)
 581                    (break)))
 582               ;; CR:r3=CR r0=noLF
 583               (if (r6 < 73)
 584                   ((r6 += 3)
 585                    (r5 = 0)
 586                    (write "=0D")
 587                    (break))
 588                 (if (r6 == 73)
 589                     (if (r0 == ?\r)
 590                         ;; CR:r3=CR r0=CR
 591                         ((r4 = 9)
 592                          (read r0)
 593                          ;; CR:r3=CR CR r0
 594                          (if (r0 == ?\n)
 595                              ;; CR:r3=CR CR LF
 596                              ((r6 = 0)
 597                               (r5 = 0)
 598                               (write "=0D\r\n")
 599                               (r4 = 10)
 600                               (read r0)
 601                               (break))
 602                            ;; CR:r3=CR CR noLF
 603                            ((r6 = 6)
 604                             (r5 = 0)
 605                             (write "=\r\n=0D=0D")
 606                             (break))))
 607                       ;; CR:r3=CR r0=noLFnorCR
 608                       ((r6 = 3)
 609                        (r5 = 0)
 610                        (write "=\r\n=0D")
 611                        (break)))
 612                   ((r6 = 3)
 613                    (r5 = 0)
 614                    (write "=\r\n=0D")
 615                    (break))))))
 616          ;; r0:r3={RAW,ENC}
 617          ((r4 = 11)
 618           (read r1)
 619           ;; r0:r3={RAW,ENC} r1
 620           (if (r1 == ?\r)
 621               ;; r0:r3={RAW,ENC} r1=CR
 622               ((r4 = 12)
 623                (read r1)
 624                ;; r0:r3={RAW,ENC} CR r1
 625                (if (r1 == ?\n)
 626                    ;; r0:r3={RAW,ENC} CR r1=LF
 627                    ((r6 = 0)
 628                     (r5 = 0)
 629                     (branch
 630                      r3
 631                      ;; r0:r3=RAW CR r1=LF
 632                      ((write r0)
 633                       (write "\r\n")
 634                       (r4 = 13)
 635                       (read r0)
 636                       (break))
 637                      ;; r0:r3=ENC CR r1=LF
 638                      ((write ?=)
 639                       (write r0 ,ew-ccl-high-table)
 640                       (write r0 ,ew-ccl-low-table)
 641                       (write "\r\n")
 642                       (r4 = 14)
 643                       (read r0)
 644                       (break))))
 645                  ;; r0:r3={RAW,ENC} CR r1=noLF
 646                  ((branch
 647                    r3
 648                    ;; r0:r3=RAW CR r1:noLF
 649                    ((r6 = 4)
 650                     (r5 = 0)
 651                     (write "=\r\n")
 652                     (write r0)
 653                     (write "=0D")
 654                     (r0 = r1)
 655                     (break))
 656                    ;; r0:r3=ENC CR r1:noLF
 657                    ((r6 = 6)
 658                     (r5 = 0)
 659                     (write "=\r\n=")
 660                     (write r0 ,ew-ccl-high-table)
 661                     (write r0 ,ew-ccl-low-table)
 662                     (write "=0D")
 663                     (r0 = r1)
 664                     (break))))
 665                  ))
 666             ;; r0:r3={RAW,ENC} r1:noCR
 667             ((branch
 668               r3
 669               ;; r0:r3=RAW r1:noCR
 670               ((r6 = 1)
 671                (r5 = 0)
 672                (write "=\r\n")
 673                (write r0)
 674                (r0 = r1)
 675                (break))
 676               ;; r0:r3=ENC r1:noCR
 677               ((r6 = 3)
 678                (r5 = 0)
 679                (write "=\r\n=")
 680                (write r0 ,ew-ccl-high-table)
 681                (write r0 ,ew-ccl-low-table)
 682                (r0 = r1)
 683                (break))))))))
 684       (repeat)))
 685     (;(write "[EOF:") (write r4 ,ew-ccl-high-table) (write r4 ,ew-ccl-low-table) (write "]")
 686      (branch
 687       r4
 688       ;; 0: (start) ;
 689       (end)
 690       ;; 1: RAW ;
 691       (end)
 692       ;; 2: r0:r3=ENC ;
 693       (end)
 694       ;; 3: SOFTBREAK r0:r3=ENC ;
 695       (end)
 696       ;; 4: r0:r3=WSP ;
 697       ((write "=\r\n") (end))
 698       ;; 5: SOFTBREAK r0:r3=WSP ;
 699       ((write "=\r\n") (end))
 700       ;; 6: ; r0=\r:r3=CR
 701       (if (r6 <= 73)
 702           ((write "=0D") (end))
 703          ((write "=\r\n=0D") (end)))
 704       ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
 705       (end)
 706       ;; 8: r5=noWSP CR:r3=CR r0=LF ;
 707       (end)
 708       ;; 9: (r6=73) ; CR:r3=CR r0=CR
 709       ((write "=\r\n=0D=0D") (end))
 710       ;; 10: (r6=73) CR:r3=CR CR LF ;
 711       (end)
 712       ;; 11: ; r0:r3={RAW,ENC}
 713       (branch
 714        r3
 715        ((write r0) (end))
 716        ((write "=")
 717         (write r0 ,ew-ccl-high-table)
 718         (write r0 ,ew-ccl-low-table)
 719         (end)))
 720       ;; 12: ; r0:r3={RAW,ENC} r1=CR
 721       (branch
 722        r3
 723        ((write "=\r\n")
 724         (write r0)
 725         (write "=0D")
 726         (end))
 727        ((write "=\r\n=")
 728         (write r0 ,ew-ccl-high-table)
 729         (write r0 ,ew-ccl-low-table)
 730         (write "=0D")
 731         (end)))
 732       ;; 13: r0:r3=RAW CR LF ;
 733       (end)
 734       ;; 14: r0:r3=ENC CR LF ;
 735       (end)
 736       ))
 737     ))
 738
 739 (define-ccl-program ew-ccl-decode-quoted-printable
 740   `(1
 741     ((read r0)
 742      (loop
 743       (branch
 744        r0
 745        ,@(mapcar
 746           (lambda (r0)
 747             (let ((tmp (aref ew-ccl-qp-table r0)))
 748               (cond
 749                ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0))
 750                ((eq r0 ?=)
 751                 ;; r0='='
 752                 `((read r0)
 753                   ;; '=' r0
 754                   (r1 = (r0 == ?\t))
 755                   (if ((r0 == ? ) | r1)
 756                       ;; '=' r0:[\t ]
 757                       ;; Skip transport-padding.
 758                       ;; It should check CR LF after
 759                       ;; transport-padding.
 760                       (loop
 761                        (read-if (r0 == ?\t)
 762                                 (repeat)
 763                                 (if (r0 == ? )
 764                                     (repeat)
 765                                   (break)))))
 766                   ;; '=' [\t ]* r0:[^\t ]
 767                   (branch
 768                    r0
 769                    ,@(mapcar
 770                       (lambda (r0)
 771                         (cond
 772                          ((eq r0 ?\r)
 773                           ;; '=' [\t ]* r0='\r'
 774                           `((read r0)
 775                             ;; '=' [\t ]* '\r' r0
 776                             (if (r0 == ?\n)
 777                                 ;; '=' [\t ]* '\r' r0='\n'
 778                                 ;; soft line break found.
 779                                 ((read r0)
 780                                  (repeat))
 781                               ;; '=' [\t ]* '\r' r0:[^\n]
 782                               ;; invalid input ->
 783                               ;; output "=\r" and rescan from r0.
 784                               ((write "=\r")
 785                                (repeat)))))
 786                          ((setq tmp (nth r0 ew-ccl-256-to-16-table))
 787                           ;; '=' [\t ]* r0:[0-9A-F]
 788                           `(r0 = ,tmp))
 789                          (t
 790                           ;; '=' [\t ]* r0:[^\r0-9A-F]
 791                           ;; invalid input ->
 792                           ;; output "=" and rescan from r0.
 793                           `((write ?=)
 794                             (repeat)))))
 795                       ew-ccl-256-table))
 796                   ;; '=' [\t ]* r0:[0-9A-F]
 797                   (read-branch
 798                    r1
 799                    ,@(mapcar
 800                       (lambda (r1)
 801                         (if (setq tmp (nth r1 ew-ccl-256-to-16-table))
 802                             ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F]
 803                             `(write-read-repeat
 804                               r0
 805                               ,(vconcat
 806                                 (mapcar
 807                                  (lambda (r0)
 808                                    (logior (lsh r0 4) tmp))
 809                                  ew-ccl-16-table)))
 810                           ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
 811                           ;; invalid input
 812                           `(r2 = 0)     ; nop
 813                           ))
 814                       ew-ccl-256-table))
 815                   ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
 816                   ;; invalid input
 817                   (write ?=)
 818                   (write r0 ,(vconcat ew-ccl-16-to-256-table))
 819                   (write r1)
 820                   (read r0)
 821                   (repeat)))
 822                ((eq tmp 'cr)
 823                 ;; r0='\r'
 824                 `((read r0)
 825                   ;; '\r' r0
 826                   (if (r0 == ?\n)
 827                       ;; '\r' r0='\n'
 828                       ;; hard line break found.
 829                       ((write ?\r)
 830                        (write-read-repeat r0))
 831                     ;; '\r' r0:[^\n]
 832                     ;; invalid control character (bare CR) found.
 833                     ;; -> ignore it and rescan from r0.
 834                     (repeat))))
 835                (t
 836                 ;; r0:[^\t\r -~]
 837                 ;; invalid character found.
 838                 ;; -> ignore.
 839                 `((read r0)
 840                   (repeat))))))
 841           ew-ccl-256-table))))))
 842
 843 ;;;
 844
 845 (make-ccl-coding-system
 846  'ew-ccl-uq ?Q "MIME Q-encoding in unstructured field"
 847  'ew-ccl-decode-q 'ew-ccl-encode-uq)
 848
 849 (make-ccl-coding-system
 850  'ew-ccl-cq ?Q "MIME Q-encoding in comment"
 851  'ew-ccl-decode-q 'ew-ccl-encode-cq)
 852
 853 (make-ccl-coding-system
 854  'ew-ccl-pq ?Q "MIME Q-encoding in phrase"
 855  'ew-ccl-decode-q 'ew-ccl-encode-pq)
 856
 857 (make-ccl-coding-system
 858  'ew-ccl-b ?B "MIME B-encoding"
 859  'ew-ccl-decode-b 'ew-ccl-encode-b)
 860
 861 (make-ccl-coding-system
 862  'ew-ccl-quoted-printable ?Q "MIME Quoted-Printable-encoding"
 863  'ew-ccl-decode-quoted-printable 'ew-ccl-encode-quoted-printable)
 864
 865 (make-ccl-coding-system
 866  'ew-ccl-base64 ?B "MIME Base64-encoding"
 867  'ew-ccl-decode-b 'ew-ccl-encode-base64)
 868
 869 ;;;
 870
 871 '(
 872
 873 (require 'mel)
 874 (defvar ew-bq-use-mel nil)
 875
 876 (defun ew-encode-uq (str)
 877   (encode-coding-string (string-as-unibyte str) 'ew-ccl-uq))
 878
 879 (defun ew-encode-cq (str)
 880   (encode-coding-string (string-as-unibyte str) 'ew-ccl-cq))
 881
 882 (defun ew-encode-pq (str)
 883   (encode-coding-string (string-as-unibyte str) 'ew-ccl-pq))
 884
 885 (if ew-bq-use-mel
 886     (defalias 'ew-decode-q 'q-encoding-decode-string)
 887   (defun ew-decode-q (str)
 888     (string-as-unibyte (decode-coding-string str 'ew-ccl-uq))))
 889
 890 (if (or ew-bq-use-mel base64-dl-module ccl-encoder-eof-block-is-broken)
 891     (defalias 'ew-encode-b 'base64-encode-string)
 892   (defun ew-encode-b (str)
 893     (encode-coding-string (string-as-unibyte str) 'ew-ccl-b)))
 894
 895 (if (or ew-bq-use-mel base64-dl-module)
 896     (defalias 'ew-decode-b 'base64-decode-string)
 897   (defun ew-decode-b (str)
 898     (string-as-unibyte (decode-coding-string str 'ew-ccl-b))))
 899
 900 )
 901
 902 '(
 903
 904 (ew-encode-uq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 905 (ew-encode-cq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 906 (ew-encode-pq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 907 (ew-encode-b "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 908
 909 (ew-decode-q "a_b=20c")
 910 (ew-decode-q "=92=A4=A2")
 911 (ew-decode-b "SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=")
 912
 913 (let ((i 1000))
 914   (while (< 0 i)
 915     (setq i (1- i))
 916     (ew-decode-b
 917      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 918
 919 (let ((i 1000))
 920   (while (< 0 i)
 921     (setq i (1- i))
 922     (ew-decode-q
 923      "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
 924
 925 (require 'mel)
 926
 927 (let ((i 1000))
 928   (while (< 0 i)
 929     (setq i (1- i))
 930     (base64-decode-string
 931      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 932
 933 (let ((i 1000))
 934   (while (< 0 i)
 935     (setq i (1- i))
 936     (q-encoding-decode-string
 937      "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
 938
 939 (let (a b) ; CCL
 940   (setq a (current-time))
 941   (let ((i 1000))
 942     (while (< 0 i)
 943       (setq i (1- i))
 944       (ew-decode-b
 945        "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 946   (setq b (current-time))
 947   (elp-elapsed-time a b))
 948
 949 (let (a b) ; Emacs Lisp
 950   (setq a (current-time))
 951   (let ((i 1000))
 952     (while (< 0 i)
 953       (setq i (1- i))
 954       (base64-decode-string
 955        "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 956   (setq b (current-time))
 957   (elp-elapsed-time a b))
 958
 959 (let (a b) ; DL
 960   (setq a (current-time))
 961   (let ((i 1000))
 962     (while (< 0 i)
 963       (setq i (1- i))
 964       (decode-base64-string
 965        "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 966   (setq b (current-time))
 967   (elp-elapsed-time a b))
 968
 969 (let ((i 100000) (status (make-vector 9 nil)) a b)
 970   (setq a (current-time))
 971   (while (< 0 i)
 972     (setq i (1- i))
 973     (ccl-execute-on-string
 974      ew-ccl-decode-b ; or ew-ccl-decode-b-2 or -3
 975      status
 976      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8="))
 977   (setq b (current-time))
 978   (elp-elapsed-time a b))
 979
 980
 981 )