base64: much faster base64.
John Benediktsson
parent
d150e5cfe2
commit
2d2ff1ef68
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs byte-arrays combinators fry io io.binary
|
||||
io.encodings.binary io.streams.byte-array kernel kernel.private
|
||||
literals math namespaces sbufs sequences ;
|
||||
USING: arrays assocs byte-arrays combinators fry growable io
|
||||
io.binary io.encodings.binary io.streams.byte-array kernel
|
||||
kernel.private literals locals math math.bitwise namespaces
|
||||
sbufs sequences sequences.private ;
|
||||
IN: base64
|
||||
|
||||
ERROR: malformed-base64 ;
|
||||
|
|
@ -28,80 +29,116 @@ CONSTANT: alphabet $[
|
|||
$[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
|
||||
[ malformed-base64 ] unless* { fixnum } declare ; inline
|
||||
|
||||
: (write-lines) ( column byte-array -- column' )
|
||||
output-stream get dup '[
|
||||
_ stream-write1 1 + dup 76 = [
|
||||
drop B{ CHAR: \r CHAR: \n } _ stream-write 0
|
||||
: encode3 ( x y z -- a b c d )
|
||||
{ fixnum fixnum fixnum } declare {
|
||||
[ [ -2 shift ch>base64 ] [ 2 bits 4 shift ] bi ]
|
||||
[ [ -4 shift bitor ch>base64 ] [ 4 bits 2 shift ] bi ]
|
||||
[ [ -6 shift bitor ch>base64 ] [ 6 bits ch>base64 ] bi ]
|
||||
} spread ; inline
|
||||
|
||||
:: (stream-write-lines) ( column data stream -- column' )
|
||||
column data over 71 > [
|
||||
[
|
||||
stream stream-write1 1 + dup 76 = [
|
||||
drop 0
|
||||
B{ CHAR: \r CHAR: \n } stream stream-write
|
||||
] when
|
||||
] each ; inline
|
||||
] each
|
||||
] [
|
||||
stream stream-write 4 +
|
||||
] if ; inline
|
||||
|
||||
: write-lines ( column byte-array -- column' )
|
||||
over [ (write-lines) ] [ write ] if ; inline
|
||||
: stream-write-lines ( column data stream -- column' )
|
||||
pick [ (stream-write-lines) ] [ stream-write ] if ; inline
|
||||
|
||||
: encode3 ( seq -- byte-array )
|
||||
be> { -18 -12 -6 0 } '[
|
||||
shift 0x3f bitand ch>base64
|
||||
] with B{ } map-as ; inline
|
||||
: write-lines ( column data -- column' )
|
||||
output-stream get stream-write-lines ; inline
|
||||
|
||||
: encode-pad ( seq n -- byte-array )
|
||||
[ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
|
||||
4 CHAR: = pad-tail ; inline
|
||||
|
||||
: (encode-base64) ( stream column -- )
|
||||
3 pick stream-read dup length {
|
||||
{ 0 [ 3drop ] }
|
||||
{ 3 [ encode3 write-lines (encode-base64) ] }
|
||||
[ encode-pad write-lines (encode-base64) ]
|
||||
} case ;
|
||||
:: (encode-base64) ( input output column -- )
|
||||
4 <byte-array> :> data
|
||||
column [ input stream-read1 dup ] [
|
||||
input stream-read1
|
||||
input stream-read1
|
||||
[ [ 0 or ] bi@ encode3 ] 2keep [ 0 1 ? ] bi@ + {
|
||||
{ 0 [ ] }
|
||||
{ 1 [ drop CHAR: = ] }
|
||||
{ 2 [ 2drop CHAR: = CHAR: = ] }
|
||||
} case data (4sequence) output stream-write-lines
|
||||
] while 2drop ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: encode-base64 ( -- )
|
||||
input-stream get f (encode-base64) ;
|
||||
input-stream get output-stream get f (encode-base64) ;
|
||||
|
||||
: encode-base64-lines ( -- )
|
||||
input-stream get 0 (encode-base64) ;
|
||||
input-stream get output-stream get 0 (encode-base64) ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: read1-ignoring ( ignoring stream -- ch )
|
||||
dup stream-read1 pick dupd member?
|
||||
dup stream-read1 pick dupd member-eq?
|
||||
[ drop read1-ignoring ] [ 2nip ] if ; inline recursive
|
||||
|
||||
: push-ignoring ( accum ch -- accum )
|
||||
dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline
|
||||
|
||||
: read-into-ignoring ( accum n ignoring stream -- accum )
|
||||
'[ _ _ read1-ignoring push-ignoring ] times ; inline
|
||||
|
||||
: read-ignoring ( n ignoring stream -- accum )
|
||||
[ [ <sbuf> ] keep ] 2dip read-into-ignoring ; inline
|
||||
pick <sbuf> [
|
||||
'[ _ _ read1-ignoring [ ] _ push-if ] times
|
||||
] keep ;
|
||||
|
||||
: decode4 ( seq -- )
|
||||
[ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
|
||||
[ [ CHAR: = = ] count ] bi
|
||||
[ write ] [ head-slice* write ] if-zero ; inline
|
||||
: decode4 ( a b c d -- x y z )
|
||||
{ fixnum fixnum fixnum fixnum } declare {
|
||||
[ base64>ch 2 shift ]
|
||||
[ base64>ch [ -4 shift bitor ] [ 4 bits 4 shift ] bi ]
|
||||
[ base64>ch [ -2 shift bitor ] [ 2 bits 6 shift ] bi ]
|
||||
[ base64>ch bitor ]
|
||||
} spread ; inline
|
||||
|
||||
: (decode-base64) ( stream -- )
|
||||
4 "\n\r" pick read-ignoring dup length {
|
||||
{ 0 [ 2drop ] }
|
||||
{ 4 [ decode4 (decode-base64) ] }
|
||||
[ drop 4 CHAR: = pad-tail decode4 (decode-base64) ]
|
||||
} case ;
|
||||
:: (decode-base64) ( input output -- )
|
||||
3 <byte-array> :> data
|
||||
[ B{ CHAR: \n CHAR: \r } input read1-ignoring dup ] [
|
||||
B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
|
||||
B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
|
||||
B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
|
||||
[ decode4 data (3sequence) ] 3keep
|
||||
[ CHAR: = eq? 1 0 ? ] tri@ + +
|
||||
[ head-slice* ] unless-zero
|
||||
output stream-write
|
||||
] while drop ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: decode-base64 ( -- )
|
||||
input-stream get (decode-base64) ;
|
||||
input-stream get output-stream get (decode-base64) ;
|
||||
|
||||
: >base64 ( seq -- base64 )
|
||||
binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;
|
||||
<PRIVATE
|
||||
|
||||
: ensure-encode-length ( base64 -- base64 )
|
||||
dup length 3 /mod zero? [ 1 + ] unless 4 *
|
||||
output-stream get expand ;
|
||||
|
||||
: ensure-decode-length ( seq -- seq )
|
||||
dup length 4 /mod zero? [ 1 + ] unless 3 *
|
||||
output-stream get expand ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: >base64 ( base64 -- seq )
|
||||
binary [
|
||||
ensure-encode-length
|
||||
binary [ encode-base64 ] with-byte-reader
|
||||
] with-byte-writer ;
|
||||
|
||||
: base64> ( base64 -- seq )
|
||||
binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ;
|
||||
binary [
|
||||
ensure-decode-length
|
||||
binary [ decode-base64 ] with-byte-reader
|
||||
] with-byte-writer ;
|
||||
|
||||
: >base64-lines ( seq -- base64 )
|
||||
binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ;
|
||||
binary [
|
||||
ensure-encode-length
|
||||
binary [ encode-base64-lines ] with-byte-reader
|
||||
] with-byte-writer ;
|
||||
|
||||
: >urlsafe-base64 ( seq -- base64 )
|
||||
>base64 H{
|
||||
|
|
|
|||
Loading…
Reference in New Issue