Artifact 141996582599a9e8e9a2c91bc6ffa230a13e6f4c:
- File base64.sls — part of check-in [ac71b34f1f] at 2017-09-11 21:18:41 on branch trunk — added base64 library (user: aldo size: 6581)
0000: 3b 3b 0a 3b 3b 20 20 20 43 6f 70 79 72 69 67 68 ;;.;; Copyrigh 0010: 74 20 28 63 29 20 32 30 30 39 20 54 61 6b 65 73 t (c) 2009 Takes 0020: 68 69 20 41 62 65 2e 20 41 6c 6c 20 72 69 67 68 hi Abe. All righ 0030: 74 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b 0a ts reserved..;;. 0040: 3b 3b 20 20 20 52 65 64 69 73 74 72 69 62 75 74 ;; Redistribut 0050: 69 6f 6e 20 61 6e 64 20 75 73 65 20 69 6e 20 73 ion and use in s 0060: 6f 75 72 63 65 20 61 6e 64 20 62 69 6e 61 72 79 ource and binary 0070: 20 66 6f 72 6d 73 2c 20 77 69 74 68 20 6f 72 20 forms, with or 0080: 77 69 74 68 6f 75 74 0a 3b 3b 20 20 20 6d 6f 64 without.;; mod 0090: 69 66 69 63 61 74 69 6f 6e 2c 20 61 72 65 20 70 ification, are p 00a0: 65 72 6d 69 74 74 65 64 20 70 72 6f 76 69 64 65 ermitted provide 00b0: 64 20 74 68 61 74 20 74 68 65 20 66 6f 6c 6c 6f d that the follo 00c0: 77 69 6e 67 20 63 6f 6e 64 69 74 69 6f 6e 73 0a wing conditions. 00d0: 3b 3b 20 20 20 61 72 65 20 6d 65 74 3a 0a 3b 3b ;; are met:.;; 00e0: 0a 3b 3b 20 20 20 20 31 2e 20 52 65 64 69 73 74 .;; 1. Redist 00f0: 72 69 62 75 74 69 6f 6e 73 20 6f 66 20 73 6f 75 ributions of sou 0100: 72 63 65 20 63 6f 64 65 20 6d 75 73 74 20 72 65 rce code must re 0110: 74 61 69 6e 20 74 68 65 20 61 62 6f 76 65 20 63 tain the above c 0120: 6f 70 79 72 69 67 68 74 0a 3b 3b 20 20 20 20 20 opyright.;; 0130: 20 20 6e 6f 74 69 63 65 2c 20 74 68 69 73 20 6c notice, this l 0140: 69 73 74 20 6f 66 20 63 6f 6e 64 69 74 69 6f 6e ist of condition 0150: 73 20 61 6e 64 20 74 68 65 20 66 6f 6c 6c 6f 77 s and the follow 0160: 69 6e 67 20 64 69 73 63 6c 61 69 6d 65 72 2e 0a ing disclaimer.. 0170: 3b 3b 0a 3b 3b 20 20 20 20 32 2e 20 52 65 64 69 ;;.;; 2. Redi 0180: 73 74 72 69 62 75 74 69 6f 6e 73 20 69 6e 20 62 stributions in b 0190: 69 6e 61 72 79 20 66 6f 72 6d 20 6d 75 73 74 20 inary form must 01a0: 72 65 70 72 6f 64 75 63 65 20 74 68 65 20 61 62 reproduce the ab 01b0: 6f 76 65 20 63 6f 70 79 72 69 67 68 74 0a 3b 3b ove copyright.;; 01c0: 20 20 20 20 20 20 20 6e 6f 74 69 63 65 2c 20 74 notice, t 01d0: 68 69 73 20 6c 69 73 74 20 6f 66 20 63 6f 6e 64 his list of cond 01e0: 69 74 69 6f 6e 73 20 61 6e 64 20 74 68 65 20 66 itions and the f 01f0: 6f 6c 6c 6f 77 69 6e 67 20 64 69 73 63 6c 61 69 ollowing disclai 0200: 6d 65 72 20 69 6e 20 74 68 65 0a 3b 3b 20 20 20 mer in the.;; 0210: 20 20 20 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f documentatio 0220: 6e 20 61 6e 64 2f 6f 72 20 6f 74 68 65 72 20 6d n and/or other m 0230: 61 74 65 72 69 61 6c 73 20 70 72 6f 76 69 64 65 aterials provide 0240: 64 20 77 69 74 68 20 74 68 65 20 64 69 73 74 72 d with the distr 0250: 69 62 75 74 69 6f 6e 2e 0a 3b 3b 0a 3b 3b 20 20 ibution..;;.;; 0260: 20 20 33 2e 20 4e 65 69 74 68 65 72 20 74 68 65 3. Neither the 0270: 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 61 75 74 name of the aut 0280: 68 6f 72 73 20 6e 6f 72 20 74 68 65 20 6e 61 6d hors nor the nam 0290: 65 73 20 6f 66 20 69 74 73 20 63 6f 6e 74 72 69 es of its contri 02a0: 62 75 74 6f 72 73 0a 3b 3b 20 20 20 20 20 20 20 butors.;; 02b0: 6d 61 79 20 62 65 20 75 73 65 64 20 74 6f 20 65 may be used to e 02c0: 6e 64 6f 72 73 65 20 6f 72 20 70 72 6f 6d 6f 74 ndorse or promot 02d0: 65 20 70 72 6f 64 75 63 74 73 20 64 65 72 69 76 e products deriv 02e0: 65 64 20 66 72 6f 6d 20 74 68 69 73 0a 3b 3b 20 ed from this.;; 02f0: 20 20 20 20 20 20 73 6f 66 74 77 61 72 65 20 77 software w 0300: 69 74 68 6f 75 74 20 73 70 65 63 69 66 69 63 20 ithout specific 0310: 70 72 69 6f 72 20 77 72 69 74 74 65 6e 20 70 65 prior written pe 0320: 72 6d 69 73 73 69 6f 6e 2e 0a 3b 3b 0a 3b 3b 20 rmission..;;.;; 0330: 20 20 54 48 49 53 20 53 4f 46 54 57 41 52 45 20 THIS SOFTWARE 0340: 49 53 20 50 52 4f 56 49 44 45 44 20 42 59 20 54 IS PROVIDED BY T 0350: 48 45 20 43 4f 50 59 52 49 47 48 54 20 48 4f 4c HE COPYRIGHT HOL 0360: 44 45 52 53 20 41 4e 44 20 43 4f 4e 54 52 49 42 DERS AND CONTRIB 0370: 55 54 4f 52 53 0a 3b 3b 20 20 20 22 41 53 20 49 UTORS.;; "AS I 0380: 53 22 20 41 4e 44 20 41 4e 59 20 45 58 50 52 45 S" AND ANY EXPRE 0390: 53 53 20 4f 52 20 49 4d 50 4c 49 45 44 20 57 41 SS OR IMPLIED WA 03a0: 52 52 41 4e 54 49 45 53 2c 20 49 4e 43 4c 55 44 RRANTIES, INCLUD 03b0: 49 4e 47 2c 20 42 55 54 20 4e 4f 54 0a 3b 3b 20 ING, BUT NOT.;; 03c0: 20 20 4c 49 4d 49 54 45 44 20 54 4f 2c 20 54 48 LIMITED TO, TH 03d0: 45 20 49 4d 50 4c 49 45 44 20 57 41 52 52 41 4e E IMPLIED WARRAN 03e0: 54 49 45 53 20 4f 46 20 4d 45 52 43 48 41 4e 54 TIES OF MERCHANT 03f0: 41 42 49 4c 49 54 59 20 41 4e 44 20 46 49 54 4e ABILITY AND FITN 0400: 45 53 53 20 46 4f 52 0a 3b 3b 20 20 20 41 20 50 ESS FOR.;; A P 0410: 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f 53 ARTICULAR PURPOS 0420: 45 20 41 52 45 20 44 49 53 43 4c 41 49 4d 45 44 E ARE DISCLAIMED 0430: 2e 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 48 . IN NO EVENT SH 0440: 41 4c 4c 20 54 48 45 20 43 4f 50 59 52 49 47 48 ALL THE COPYRIGH 0450: 54 0a 3b 3b 20 20 20 4f 57 4e 45 52 20 4f 52 20 T.;; OWNER OR 0460: 43 4f 4e 54 52 49 42 55 54 4f 52 53 20 42 45 20 CONTRIBUTORS BE 0470: 4c 49 41 42 4c 45 20 46 4f 52 20 41 4e 59 20 44 LIABLE FOR ANY D 0480: 49 52 45 43 54 2c 20 49 4e 44 49 52 45 43 54 2c IRECT, INDIRECT, 0490: 20 49 4e 43 49 44 45 4e 54 41 4c 2c 0a 3b 3b 20 INCIDENTAL,.;; 04a0: 20 20 53 50 45 43 49 41 4c 2c 20 45 58 45 4d 50 SPECIAL, EXEMP 04b0: 4c 41 52 59 2c 20 4f 52 20 43 4f 4e 53 45 51 55 LARY, OR CONSEQU 04c0: 45 4e 54 49 41 4c 20 44 41 4d 41 47 45 53 20 28 ENTIAL DAMAGES ( 04d0: 49 4e 43 4c 55 44 49 4e 47 2c 20 42 55 54 20 4e INCLUDING, BUT N 04e0: 4f 54 20 4c 49 4d 49 54 45 44 0a 3b 3b 20 20 20 OT LIMITED.;; 04f0: 54 4f 2c 20 50 52 4f 43 55 52 45 4d 45 4e 54 20 TO, PROCUREMENT 0500: 4f 46 20 53 55 42 53 54 49 54 55 54 45 20 47 4f OF SUBSTITUTE GO 0510: 4f 44 53 20 4f 52 20 53 45 52 56 49 43 45 53 3b ODS OR SERVICES; 0520: 20 4c 4f 53 53 20 4f 46 20 55 53 45 2c 20 44 41 LOSS OF USE, DA 0530: 54 41 2c 20 4f 52 0a 3b 3b 20 20 20 50 52 4f 46 TA, OR.;; PROF 0540: 49 54 53 3b 20 4f 52 20 42 55 53 49 4e 45 53 53 ITS; OR BUSINESS 0550: 20 49 4e 54 45 52 52 55 50 54 49 4f 4e 29 20 48 INTERRUPTION) H 0560: 4f 57 45 56 45 52 20 43 41 55 53 45 44 20 41 4e OWEVER CAUSED AN 0570: 44 20 4f 4e 20 41 4e 59 20 54 48 45 4f 52 59 20 D ON ANY THEORY 0580: 4f 46 0a 3b 3b 20 20 20 4c 49 41 42 49 4c 49 54 OF.;; LIABILIT 0590: 59 2c 20 57 48 45 54 48 45 52 20 49 4e 20 43 4f Y, WHETHER IN CO 05a0: 4e 54 52 41 43 54 2c 20 53 54 52 49 43 54 20 4c NTRACT, STRICT L 05b0: 49 41 42 49 4c 49 54 59 2c 20 4f 52 20 54 4f 52 IABILITY, OR TOR 05c0: 54 20 28 49 4e 43 4c 55 44 49 4e 47 0a 3b 3b 20 T (INCLUDING.;; 05d0: 20 20 4e 45 47 4c 49 47 45 4e 43 45 20 4f 52 20 NEGLIGENCE OR 05e0: 4f 54 48 45 52 57 49 53 45 29 20 41 52 49 53 49 OTHERWISE) ARISI 05f0: 4e 47 20 49 4e 20 41 4e 59 20 57 41 59 20 4f 55 NG IN ANY WAY OU 0600: 54 20 4f 46 20 54 48 45 20 55 53 45 20 4f 46 20 T OF THE USE OF 0610: 54 48 49 53 0a 3b 3b 20 20 20 53 4f 46 54 57 41 THIS.;; SOFTWA 0620: 52 45 2c 20 45 56 45 4e 20 49 46 20 41 44 56 49 RE, EVEN IF ADVI 0630: 53 45 44 20 4f 46 20 54 48 45 20 50 4f 53 53 49 SED OF THE POSSI 0640: 42 49 4c 49 54 59 20 4f 46 20 53 55 43 48 20 44 BILITY OF SUCH D 0650: 41 4d 41 47 45 2e 0a 0a 28 6c 69 62 72 61 72 79 AMAGE...(library 0660: 20 28 62 61 73 65 36 34 29 0a 20 20 28 65 78 70 (base64). (exp 0670: 6f 72 74 20 65 6e 63 6f 64 65 0a 20 20 20 20 20 ort encode. 0680: 20 20 20 20 20 65 6e 63 6f 64 65 2d 62 79 74 65 encode-byte 0690: 76 65 63 74 6f 72 0a 20 20 20 20 20 20 20 20 20 vector. 06a0: 20 64 65 63 6f 64 65 0a 20 20 20 20 20 20 20 20 decode. 06b0: 20 20 64 65 63 6f 64 65 2d 73 74 72 69 6e 67 0a decode-string. 06c0: 20 20 20 20 20 20 20 20 20 20 26 69 6e 76 61 6c &inval 06d0: 69 64 2d 65 6e 63 6f 64 69 6e 67 0a 20 20 20 20 id-encoding. 06e0: 20 20 20 20 20 20 69 6e 76 61 6c 69 64 2d 65 6e invalid-en 06f0: 63 6f 64 69 6e 67 3f 0a 20 20 20 20 20 20 20 20 coding?. 0700: 20 20 69 6e 76 61 6c 69 64 2d 65 6e 63 6f 64 69 invalid-encodi 0710: 6e 67 2d 70 6f 73 69 74 69 6f 6e 0a 20 20 20 20 ng-position. 0720: 20 20 20 20 20 20 26 75 6e 6b 6e 6f 77 6e 2d 61 &unknown-a 0730: 6c 70 68 61 62 65 74 0a 20 20 20 20 20 20 20 20 lphabet. 0740: 20 20 75 6e 6b 6e 6f 77 6e 2d 61 6c 70 68 61 62 unknown-alphab 0750: 65 74 3f 0a 20 20 20 20 20 20 20 20 20 20 75 6e et?. un 0760: 6b 6e 6f 77 6e 2d 61 6c 70 68 61 62 65 74 2d 63 known-alphabet-c 0770: 68 61 72 29 0a 20 20 28 69 6d 70 6f 72 74 20 28 har). (import ( 0780: 72 6e 72 73 29 29 0a 0a 20 20 28 64 65 66 69 6e rnrs)).. (defin 0790: 65 20 2a 74 61 62 6c 65 2a 0a 20 20 20 20 27 23 e *table*. '# 07a0: 28 23 5c 41 20 23 5c 42 20 23 5c 43 20 23 5c 44 (#\A #\B #\C #\D 07b0: 20 23 5c 45 20 23 5c 46 20 23 5c 47 20 23 5c 48 #\E #\F #\G #\H 07c0: 0a 20 20 20 20 20 20 20 23 5c 49 20 23 5c 4a 20 . #\I #\J 07d0: 23 5c 4b 20 23 5c 4c 20 23 5c 4d 20 23 5c 4e 20 #\K #\L #\M #\N 07e0: 23 5c 4f 20 23 5c 50 0a 20 20 20 20 20 20 20 23 #\O #\P. # 07f0: 5c 51 20 23 5c 52 20 23 5c 53 20 23 5c 54 20 23 \Q #\R #\S #\T # 0800: 5c 55 20 23 5c 56 20 23 5c 57 20 23 5c 58 0a 20 \U #\V #\W #\X. 0810: 20 20 20 20 20 20 23 5c 59 20 23 5c 5a 20 23 5c #\Y #\Z #\ 0820: 61 20 23 5c 62 20 23 5c 63 20 23 5c 64 20 23 5c a #\b #\c #\d #\ 0830: 65 20 23 5c 66 0a 20 20 20 20 20 20 20 23 5c 67 e #\f. #\g 0840: 20 23 5c 68 20 23 5c 69 20 23 5c 6a 20 23 5c 6b #\h #\i #\j #\k 0850: 20 23 5c 6c 20 23 5c 6d 20 23 5c 6e 0a 20 20 20 #\l #\m #\n. 0860: 20 20 20 20 23 5c 6f 20 23 5c 70 20 23 5c 71 20 #\o #\p #\q 0870: 23 5c 72 20 23 5c 73 20 23 5c 74 20 23 5c 75 20 #\r #\s #\t #\u 0880: 23 5c 76 0a 20 20 20 20 20 20 20 23 5c 77 20 23 #\v. #\w # 0890: 5c 78 20 23 5c 79 20 23 5c 7a 20 23 5c 30 20 23 \x #\y #\z #\0 # 08a0: 5c 31 20 23 5c 32 20 23 5c 33 0a 20 20 20 20 20 \1 #\2 #\3. 08b0: 20 20 23 5c 34 20 23 5c 35 20 23 5c 36 20 23 5c #\4 #\5 #\6 #\ 08c0: 37 20 23 5c 38 20 23 5c 39 20 23 5c 2b 20 23 5c 7 #\8 #\9 #\+ #\ 08d0: 2f 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 /)).. (define ( 08e0: 65 6e 63 6f 64 65 20 69 70 6f 72 74 20 6f 70 6f encode iport opo 08f0: 72 74 29 0a 0a 20 20 20 20 28 64 65 66 69 6e 65 rt).. (define 0900: 20 28 70 75 74 2d 61 6c 70 68 61 62 65 74 20 69 (put-alphabet i 0910: 29 0a 20 20 20 20 20 20 28 70 75 74 2d 63 68 61 ). (put-cha 0920: 72 20 6f 70 6f 72 74 20 28 76 65 63 74 6f 72 2d r oport (vector- 0930: 72 65 66 20 2a 74 61 62 6c 65 2a 20 69 29 29 29 ref *table* i))) 0940: 0a 0a 20 20 20 20 28 61 73 73 65 72 74 20 28 62 .. (assert (b 0950: 69 6e 61 72 79 2d 70 6f 72 74 3f 20 69 70 6f 72 inary-port? ipor 0960: 74 29 29 0a 20 20 20 20 28 61 73 73 65 72 74 20 t)). (assert 0970: 28 74 65 78 74 75 61 6c 2d 70 6f 72 74 3f 20 6f (textual-port? o 0980: 70 6f 72 74 29 29 0a 0a 20 20 20 20 28 6c 65 74 port)).. (let 0990: 20 6c 6f 6f 70 20 28 28 62 30 20 28 67 65 74 2d loop ((b0 (get- 09a0: 75 38 20 69 70 6f 72 74 29 29 0a 20 20 20 20 20 u8 iport)). 09b0: 20 20 20 20 20 20 20 20 20 20 28 6e 20 30 29 29 (n 0)) 09c0: 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 65 . (cond ((e 09d0: 6f 66 2d 6f 62 6a 65 63 74 3f 20 62 30 29 0a 20 of-object? b0). 09e0: 20 20 20 20 20 20 20 20 20 20 20 20 6e 29 0a 20 n). 09f0: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else 0a00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 . (p 0a10: 75 74 2d 61 6c 70 68 61 62 65 74 20 28 66 78 61 ut-alphabet (fxa 0a20: 72 69 74 68 6d 65 74 69 63 2d 73 68 69 66 74 2d rithmetic-shift- 0a30: 72 69 67 68 74 20 62 30 20 32 29 29 0a 20 20 20 right b0 2)). 0a40: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let ( 0a50: 28 70 30 20 28 66 78 61 72 69 74 68 6d 65 74 69 (p0 (fxarithmeti 0a60: 63 2d 73 68 69 66 74 2d 6c 65 66 74 20 28 66 78 c-shift-left (fx 0a70: 62 69 74 2d 66 69 65 6c 64 20 62 30 20 30 20 32 bit-field b0 0 2 0a80: 29 20 34 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) 4)). 0a90: 20 20 20 20 20 20 20 20 20 28 62 31 20 28 67 65 (b1 (ge 0aa0: 74 2d 75 38 20 69 70 6f 72 74 29 29 29 0a 20 20 t-u8 iport))). 0ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co 0ac0: 6e 64 20 28 28 65 6f 66 2d 6f 62 6a 65 63 74 3f nd ((eof-object? 0ad0: 20 62 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 b1). 0ae0: 20 20 20 20 20 20 20 20 20 20 20 28 70 75 74 2d (put- 0af0: 61 6c 70 68 61 62 65 74 20 70 30 29 0a 20 20 20 alphabet p0). 0b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0b10: 20 20 20 28 70 75 74 2d 73 74 72 69 6e 67 20 6f (put-string o 0b20: 70 6f 72 74 20 22 3d 3d 22 29 0a 20 20 20 20 20 port "=="). 0b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0b40: 20 28 2b 20 6e 20 34 29 29 0a 20 20 20 20 20 20 (+ n 4)). 0b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 0b60: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else. 0b70: 20 20 20 20 20 20 20 20 20 20 20 28 70 75 74 2d (put- 0b80: 61 6c 70 68 61 62 65 74 20 28 66 78 69 6f 72 20 alphabet (fxior 0b90: 70 30 20 28 66 78 61 72 69 74 68 6d 65 74 69 63 p0 (fxarithmetic 0ba0: 2d 73 68 69 66 74 2d 72 69 67 68 74 20 62 31 20 -shift-right b1 0bb0: 34 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 4))). 0bc0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let 0bd0: 28 28 70 31 20 28 66 78 61 72 69 74 68 6d 65 74 ((p1 (fxarithmet 0be0: 69 63 2d 73 68 69 66 74 2d 6c 65 66 74 20 28 66 ic-shift-left (f 0bf0: 78 62 69 74 2d 66 69 65 6c 64 20 62 31 20 30 20 xbit-field b1 0 0c00: 34 29 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 4) 2)). 0c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0c20: 20 20 20 28 62 32 20 28 67 65 74 2d 75 38 20 69 (b2 (get-u8 i 0c30: 70 6f 72 74 29 29 29 0a 20 20 20 20 20 20 20 20 port))). 0c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0c50: 28 63 6f 6e 64 20 28 28 65 6f 66 2d 6f 62 6a 65 (cond ((eof-obje 0c60: 63 74 3f 20 62 32 29 0a 20 20 20 20 20 20 20 20 ct? b2). 0c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0c80: 20 20 20 20 20 20 20 28 70 75 74 2d 61 6c 70 68 (put-alph 0c90: 61 62 65 74 20 70 31 29 0a 20 20 20 20 20 20 20 abet p1). 0ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0cb0: 20 20 20 20 20 20 20 20 28 70 75 74 2d 63 68 61 (put-cha 0cc0: 72 20 6f 70 6f 72 74 20 23 5c 3d 29 0a 20 20 20 r oport #\=). 0cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0ce0: 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 6e (+ n 0cf0: 20 34 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 4)). 0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0d10: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else. 0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0d30: 20 20 20 20 20 20 20 20 28 70 75 74 2d 61 6c 70 (put-alp 0d40: 68 61 62 65 74 20 28 66 78 69 6f 72 20 70 31 20 habet (fxior p1 0d50: 28 66 78 61 72 69 74 68 6d 65 74 69 63 2d 73 68 (fxarithmetic-sh 0d60: 69 66 74 2d 72 69 67 68 74 20 62 32 20 36 29 29 ift-right b2 6)) 0d70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0d90: 20 28 70 75 74 2d 61 6c 70 68 61 62 65 74 20 28 (put-alphabet ( 0da0: 66 78 62 69 74 2d 66 69 65 6c 64 20 62 32 20 30 fxbit-field b2 0 0db0: 20 36 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 6)). 0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0dd0: 20 20 20 20 28 6c 6f 6f 70 20 28 67 65 74 2d 75 (loop (get-u 0de0: 38 20 69 70 6f 72 74 29 20 28 2b 20 6e 20 34 29 8 iport) (+ n 4) 0df0: 29 29 29 29 29 29 29 29 29 29 29 0a 0a 20 20 28 ))))))))))).. ( 0e00: 64 65 66 69 6e 65 20 28 65 6e 63 6f 64 65 2d 62 define (encode-b 0e10: 79 74 65 76 65 63 74 6f 72 20 62 76 29 0a 20 20 ytevector bv). 0e20: 20 20 28 61 73 73 65 72 74 20 28 62 79 74 65 76 (assert (bytev 0e30: 65 63 74 6f 72 3f 20 62 76 29 29 0a 20 20 20 20 ector? bv)). 0e40: 28 63 61 6c 6c 2d 77 69 74 68 2d 70 6f 72 74 20 (call-with-port 0e50: 28 6f 70 65 6e 2d 62 79 74 65 76 65 63 74 6f 72 (open-bytevector 0e60: 2d 69 6e 70 75 74 2d 70 6f 72 74 20 62 76 29 0a -input-port bv). 0e70: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 (lambda (i 0e80: 70 6f 72 74 29 0a 20 20 20 20 20 20 20 20 28 63 port). (c 0e90: 61 6c 6c 2d 77 69 74 68 2d 73 74 72 69 6e 67 2d all-with-string- 0ea0: 6f 75 74 70 75 74 2d 70 6f 72 74 0a 20 20 20 20 output-port. 0eb0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 70 (lambda (op 0ec0: 6f 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ort). 0ed0: 28 65 6e 63 6f 64 65 20 69 70 6f 72 74 20 6f 70 (encode iport op 0ee0: 6f 72 74 29 29 29 29 29 29 0a 0a 20 20 28 64 65 ort)))))).. (de 0ef0: 66 69 6e 65 2d 63 6f 6e 64 69 74 69 6f 6e 2d 74 fine-condition-t 0f00: 79 70 65 20 26 69 6e 76 61 6c 69 64 2d 65 6e 63 ype &invalid-enc 0f10: 6f 64 69 6e 67 20 26 63 6f 6e 64 69 74 69 6f 6e oding &condition 0f20: 0a 20 20 20 20 6d 61 6b 65 2d 69 6e 76 61 6c 69 . make-invali 0f30: 64 2d 65 6e 63 6f 64 69 6e 67 20 69 6e 76 61 6c d-encoding inval 0f40: 69 64 2d 65 6e 63 6f 64 69 6e 67 3f 0a 20 20 20 id-encoding?. 0f50: 20 28 70 6f 73 69 74 69 6f 6e 20 69 6e 76 61 6c (position inval 0f60: 69 64 2d 65 6e 63 6f 64 69 6e 67 2d 70 6f 73 69 id-encoding-posi 0f70: 74 69 6f 6e 29 29 0a 0a 20 20 28 64 65 66 69 6e tion)).. (defin 0f80: 65 2d 63 6f 6e 64 69 74 69 6f 6e 2d 74 79 70 65 e-condition-type 0f90: 20 26 75 6e 6b 6e 6f 77 6e 2d 61 6c 70 68 61 62 &unknown-alphab 0fa0: 65 74 20 26 63 6f 6e 64 69 74 69 6f 6e 0a 20 20 et &condition. 0fb0: 20 20 6d 61 6b 65 2d 75 6e 6b 6e 6f 77 6e 2d 61 make-unknown-a 0fc0: 6c 70 68 61 62 65 74 20 75 6e 6b 6e 6f 77 6e 2d lphabet unknown- 0fd0: 61 6c 70 68 61 62 65 74 3f 0a 20 20 20 20 28 63 alphabet?. (c 0fe0: 68 61 72 20 75 6e 6b 6e 6f 77 6e 2d 61 6c 70 68 har unknown-alph 0ff0: 61 62 65 74 2d 63 68 61 72 29 29 0a 20 0a 20 20 abet-char)). . 1000: 28 64 65 66 69 6e 65 20 28 64 65 63 6f 64 65 20 (define (decode 1010: 69 70 6f 72 74 20 6f 70 6f 72 74 29 0a 0a 20 20 iport oport).. 1020: 20 20 28 64 65 66 69 6e 65 20 28 63 2d 3e 69 20 (define (c->i 1030: 63 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 c). (let (( 1040: 6e 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 n (char->integer 1050: 20 63 29 29 29 0a 20 20 20 20 20 20 20 20 28 63 c))). (c 1060: 6f 6e 64 20 28 28 3c 3d 20 36 35 20 6e 20 39 30 ond ((<= 65 n 90 1070: 29 20 20 20 28 2d 20 6e 20 36 35 29 29 0a 20 20 ) (- n 65)). 1080: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3c 3d ((<= 1090: 20 39 37 20 6e 20 31 32 32 29 20 20 28 2d 20 6e 97 n 122) (- n 10a0: 20 37 31 29 29 20 3b 20 28 2b 20 28 2d 20 6e 20 71)) ; (+ (- n 10b0: 39 37 29 20 32 36 29 0a 20 20 20 20 20 20 20 20 97) 26). 10c0: 20 20 20 20 20 20 28 28 3c 3d 20 34 38 20 6e 20 ((<= 48 n 10d0: 35 37 29 20 20 20 28 2b 20 6e 20 34 29 29 20 20 57) (+ n 4)) 10e0: 3b 20 28 2b 20 28 2d 20 6e 20 34 38 29 20 35 32 ; (+ (- n 48) 52 10f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 1100: 28 28 63 68 61 72 3d 3f 20 23 5c 2b 20 63 29 20 ((char=? #\+ c) 1110: 36 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 62). 1120: 20 20 28 28 63 68 61 72 3d 3f 20 23 5c 2f 20 63 ((char=? #\/ c 1130: 29 20 36 33 29 0a 20 20 20 20 20 20 20 20 20 20 ) 63). 1140: 20 20 20 20 28 65 6c 73 65 20 28 72 61 69 73 65 (else (raise 1150: 20 28 6d 61 6b 65 2d 75 6e 6b 6e 6f 77 6e 2d 61 (make-unknown-a 1160: 6c 70 68 61 62 65 74 20 63 29 29 29 29 29 29 0a lphabet c)))))). 1170: 0a 20 20 20 20 28 64 65 66 69 6e 65 2d 73 79 6e . (define-syn 1180: 74 61 78 20 70 75 74 2d 62 79 74 65 73 0a 20 20 tax put-bytes. 1190: 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 (syntax-rule 11a0: 73 20 28 29 0a 20 20 20 20 20 20 20 20 28 28 5f s (). ((_ 11b0: 20 63 30 20 63 31 29 0a 20 20 20 20 20 20 20 20 c0 c1). 11c0: 20 28 6c 65 74 2a 20 28 28 69 30 20 28 63 2d 3e (let* ((i0 (c-> 11d0: 69 20 63 30 29 29 0a 20 20 20 20 20 20 20 20 20 i c0)). 11e0: 20 20 20 20 20 20 20 28 69 31 20 28 63 2d 3e 69 (i1 (c->i 11f0: 20 63 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 c1)). 1200: 20 20 20 20 20 20 28 62 30 20 28 66 78 69 6f 72 (b0 (fxior 1210: 20 28 66 78 61 72 69 74 68 6d 65 74 69 63 2d 73 (fxarithmetic-s 1220: 68 69 66 74 2d 6c 65 66 74 20 69 30 20 32 29 0a hift-left i0 2). 1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1240: 20 20 20 20 20 20 20 20 20 20 20 28 66 78 62 69 (fxbi 1250: 74 2d 66 69 65 6c 64 20 69 31 20 34 20 36 29 29 t-field i1 4 6)) 1260: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 )). (p 1270: 75 74 2d 75 38 20 6f 70 6f 72 74 20 62 30 29 0a ut-u8 oport b0). 1280: 20 20 20 20 20 20 20 20 20 20 20 69 31 29 29 0a i1)). 1290: 20 20 20 20 20 20 20 20 28 28 5f 20 63 30 20 63 ((_ c0 c 12a0: 31 20 63 32 29 0a 20 20 20 20 20 20 20 20 20 28 1 c2). ( 12b0: 6c 65 74 2a 20 28 28 69 31 20 28 70 75 74 2d 62 let* ((i1 (put-b 12c0: 79 74 65 73 20 63 30 20 63 31 29 29 0a 20 20 20 ytes c0 c1)). 12d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 32 (i2 12e0: 20 28 63 2d 3e 69 20 63 32 29 29 0a 20 20 20 20 (c->i c2)). 12f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 31 20 (b1 1300: 28 66 78 69 6f 72 20 28 66 78 61 72 69 74 68 6d (fxior (fxarithm 1310: 65 74 69 63 2d 73 68 69 66 74 2d 6c 65 66 74 20 etic-shift-left 1320: 28 66 78 62 69 74 2d 66 69 65 6c 64 20 69 31 20 (fxbit-field i1 1330: 30 20 34 29 20 34 29 0a 20 20 20 20 20 20 20 20 0 4) 4). 1340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1350: 20 20 20 28 66 78 62 69 74 2d 66 69 65 6c 64 20 (fxbit-field 1360: 69 32 20 32 20 36 29 29 29 29 0a 20 20 20 20 20 i2 2 6)))). 1370: 20 20 20 20 20 20 28 70 75 74 2d 75 38 20 6f 70 (put-u8 op 1380: 6f 72 74 20 62 31 29 0a 20 20 20 20 20 20 20 20 ort b1). 1390: 20 20 20 69 32 29 29 0a 20 20 20 20 20 20 20 20 i2)). 13a0: 28 28 5f 20 63 30 20 63 31 20 63 32 20 63 33 29 ((_ c0 c1 c2 c3) 13b0: 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 . (let* 13c0: 28 28 69 32 20 28 70 75 74 2d 62 79 74 65 73 20 ((i2 (put-bytes 13d0: 63 30 20 63 31 20 63 32 29 29 0a 20 20 20 20 20 c0 c1 c2)). 13e0: 20 20 20 20 20 20 20 20 20 20 20 28 62 32 20 28 (b2 ( 13f0: 66 78 69 6f 72 20 28 66 78 61 72 69 74 68 6d 65 fxior (fxarithme 1400: 74 69 63 2d 73 68 69 66 74 2d 6c 65 66 74 20 28 tic-shift-left ( 1410: 66 78 62 69 74 2d 66 69 65 6c 64 20 69 32 20 30 fxbit-field i2 0 1420: 20 32 29 20 36 29 0a 20 20 20 20 20 20 20 20 20 2) 6). 1430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1440: 20 20 28 63 2d 3e 69 20 63 33 29 29 29 29 0a 20 (c->i c3)))). 1450: 20 20 20 20 20 20 20 20 20 20 28 70 75 74 2d 75 (put-u 1460: 38 20 6f 70 6f 72 74 20 62 32 29 29 29 29 29 0a 8 oport b2))))). 1470: 0a 20 20 20 20 28 61 73 73 65 72 74 20 28 74 65 . (assert (te 1480: 78 74 75 61 6c 2d 70 6f 72 74 3f 20 69 70 6f 72 xtual-port? ipor 1490: 74 29 29 0a 20 20 20 20 28 61 73 73 65 72 74 20 t)). (assert 14a0: 28 62 69 6e 61 72 79 2d 70 6f 72 74 3f 20 6f 70 (binary-port? op 14b0: 6f 72 74 29 29 0a 0a 20 20 20 20 28 6c 65 74 20 ort)).. (let 14c0: 6c 6f 6f 70 20 28 28 63 30 20 28 67 65 74 2d 63 loop ((c0 (get-c 14d0: 68 61 72 20 69 70 6f 72 74 29 29 0a 20 20 20 20 har iport)). 14e0: 20 20 20 20 20 20 20 20 20 20 20 28 6e 20 30 29 (n 0) 14f0: 29 0a 20 20 20 20 20 20 28 69 66 20 28 65 6f 66 ). (if (eof 1500: 2d 6f 62 6a 65 63 74 3f 20 63 30 29 0a 20 20 20 -object? c0). 1510: 20 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 n. 1520: 20 20 20 28 6c 65 74 20 28 28 63 31 20 28 67 65 (let ((c1 (ge 1530: 74 2d 63 68 61 72 20 69 70 6f 72 74 29 29 29 0a t-char iport))). 1540: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if 1550: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 63 31 29 (eof-object? c1) 1560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1570: 20 28 72 61 69 73 65 20 28 6d 61 6b 65 2d 69 6e (raise (make-in 1580: 76 61 6c 69 64 2d 65 6e 63 6f 64 69 6e 67 20 28 valid-encoding ( 1590: 2b 20 6e 20 31 29 29 29 29 0a 20 20 20 20 20 20 + n 1)))). 15a0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 32 20 (let ((c2 15b0: 28 67 65 74 2d 63 68 61 72 20 69 70 6f 72 74 29 (get-char iport) 15c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 15d0: 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (if (eof-object 15e0: 3f 20 63 32 29 0a 20 20 20 20 20 20 20 20 20 20 ? c2). 15f0: 20 20 20 20 20 20 20 20 28 72 61 69 73 65 20 28 (raise ( 1600: 6d 61 6b 65 2d 69 6e 76 61 6c 69 64 2d 65 6e 63 make-invalid-enc 1610: 6f 64 69 6e 67 20 28 2b 20 6e 20 32 29 29 29 29 oding (+ n 2)))) 1620: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . ( 1630: 6c 65 74 20 28 28 63 33 20 28 67 65 74 2d 63 68 let ((c3 (get-ch 1640: 61 72 20 69 70 6f 72 74 29 29 29 0a 20 20 20 20 ar iport))). 1650: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con 1660: 64 20 28 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 d ((eof-object? 1670: 63 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c3). 1680: 20 20 20 20 20 20 20 20 20 20 20 28 72 61 69 73 (rais 1690: 65 20 28 6d 61 6b 65 2d 69 6e 76 61 6c 69 64 2d e (make-invalid- 16a0: 65 6e 63 6f 64 69 6e 67 20 28 2b 20 6e 20 33 29 encoding (+ n 3) 16b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 16c0: 20 20 20 20 20 20 20 20 20 20 28 28 63 68 61 72 ((char 16d0: 3d 3f 20 23 5c 3d 20 63 32 29 0a 20 20 20 20 20 =? #\= c2). 16e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 16f0: 20 20 28 63 6f 6e 64 20 28 28 63 68 61 72 3d 3f (cond ((char=? 1700: 20 23 5c 3d 20 63 33 29 0a 20 20 20 20 20 20 20 #\= c3). 1710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1720: 20 20 20 20 20 20 20 28 70 75 74 2d 62 79 74 65 (put-byte 1730: 73 20 63 30 20 63 31 29 0a 20 20 20 20 20 20 20 s c0 c1). 1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1750: 20 20 20 20 20 20 20 28 2b 20 6e 20 31 29 29 0a (+ n 1)). 1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1770: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el 1780: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se. 1790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 17a0: 20 28 72 61 69 73 65 20 28 6d 61 6b 65 2d 69 6e (raise (make-in 17b0: 76 61 6c 69 64 2d 65 6e 63 6f 64 69 6e 67 20 28 valid-encoding ( 17c0: 2b 20 6e 20 33 29 29 29 29 29 29 0a 20 20 20 20 + n 3)))))). 17d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 17e0: 20 20 28 28 63 68 61 72 3d 3f 20 23 5c 3d 20 63 ((char=? #\= c 17f0: 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3). 1800: 20 20 20 20 20 20 20 20 20 20 28 70 75 74 2d 62 (put-b 1810: 79 74 65 73 20 63 30 20 63 31 20 63 32 29 0a 20 ytes c0 c1 c2). 1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1830: 20 20 20 20 20 20 28 2b 20 6e 20 32 29 29 0a 20 (+ n 2)). 1840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1850: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else. 1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1870: 20 20 28 70 75 74 2d 62 79 74 65 73 20 63 30 20 (put-bytes c0 1880: 63 31 20 63 32 20 63 33 29 0a 20 20 20 20 20 20 c1 c2 c3). 1890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 18a0: 20 28 6c 6f 6f 70 20 28 67 65 74 2d 63 68 61 72 (loop (get-char 18b0: 20 69 70 6f 72 74 29 20 28 2b 20 6e 20 33 29 29 iport) (+ n 3)) 18c0: 29 29 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 )))))))).. (def 18d0: 69 6e 65 20 28 64 65 63 6f 64 65 2d 73 74 72 69 ine (decode-stri 18e0: 6e 67 20 73 74 72 29 0a 20 20 20 20 28 61 73 73 ng str). (ass 18f0: 65 72 74 20 28 73 74 72 69 6e 67 3f 20 73 74 72 ert (string? str 1900: 29 29 0a 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 )). (call-wit 1910: 68 2d 70 6f 72 74 20 28 6f 70 65 6e 2d 73 74 72 h-port (open-str 1920: 69 6e 67 2d 69 6e 70 75 74 2d 70 6f 72 74 20 73 ing-input-port s 1930: 74 72 29 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 tr). (lambd 1940: 61 20 28 69 70 6f 72 74 29 0a 20 20 20 20 20 20 a (iport). 1950: 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 62 79 74 (call-with-byt 1960: 65 76 65 63 74 6f 72 2d 6f 75 74 70 75 74 2d 70 evector-output-p 1970: 6f 72 74 0a 20 20 20 20 20 20 20 20 20 28 6c 61 ort. (la 1980: 6d 62 64 61 20 28 6f 70 6f 72 74 29 0a 20 20 20 mbda (oport). 1990: 20 20 20 20 20 20 20 20 28 64 65 63 6f 64 65 20 (decode 19a0: 69 70 6f 72 74 20 6f 70 6f 72 74 29 29 29 29 29 iport oport))))) 19b0: 29 0a 0a 29 0a )..).