diff --git a/extra/base91/authors.txt b/extra/base91/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/base91/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/base91/base91-tests.factor b/extra/base91/base91-tests.factor new file mode 100644 index 0000000000..040599a04d --- /dev/null +++ b/extra/base91/base91-tests.factor @@ -0,0 +1,23 @@ +USING: base91 byte-arrays kernel sequences tools.test ; + +{ t } [ 256 >byte-array dup >base91 base91> = ] unit-test + +{ B{ } } [ f >base91 ] unit-test +{ "AA" } [ B{ 0 } >base91 "" like ] unit-test +{ "GB" } [ "a" >base91 "" like ] unit-test +{ "#GD" } [ "ab" >base91 "" like ] unit-test +{ "#G(I" } [ "abc" >base91 "" like ] unit-test +{ "#G(IZ" } [ "abcd" >base91 "" like ] unit-test +{ "#G(Ic,A" } [ "abcde" >base91 "" like ] unit-test +{ "#G(Ic,WC" } [ "abcdef" >base91 "" like ] unit-test +{ "#G(Ic,5pG" } [ "abcdefg" >base91 "" like ] unit-test + +{ B{ } } [ f base91> ] unit-test +{ "\0" } [ "AA" base91> "" like ] unit-test +{ "a" } [ "GB" base91> "" like ] unit-test +{ "ab" } [ "#GD" base91> "" like ] unit-test +{ "abc" } [ "#G(I" base91> "" like ] unit-test +{ "abcd" } [ "#G(IZ" base91> "" like ] unit-test +{ "abcde" } [ "#G(Ic,A" base91> "" like ] unit-test +{ "abcdef" } [ "#G(Ic,WC" base91> "" like ] unit-test +{ "abcdefg" } [ "#G(Ic,5pG" base91> "" like ] unit-test diff --git a/extra/base91/base91.factor b/extra/base91/base91.factor new file mode 100644 index 0000000000..05a07842fe --- /dev/null +++ b/extra/base91/base91.factor @@ -0,0 +1,83 @@ +! Copyright (C) 2019 John Benediktsson. +! See http://factorcode.org/license.txt for BSD license. +USING: base64.private byte-arrays kernel literals locals math +sequences ; +IN: base91 + +ERROR: malformed-base91 ; + +?@[]^_`{|}~\"" + >byte-array +] +>> + +: ch>base91 ( ch -- ch ) + alphabet nth ; inline + +: base91>ch ( ch -- ch ) + $[ alphabet alphabet-inverse ] nth + [ malformed-base91 ] unless* ; inline + +PRIVATE> + +:: >base91 ( seq -- base91 ) + 0 :> b! + 0 :> n! + BV{ } clone :> accum + + seq [ + n shift b bitor b! + n 8 + n! + n 13 > [ + b 0x1fff bitand dup 88 > [ + b -13 shift b! + n 13 - n! + ] [ + drop b 0x3fff bitand + b -14 shift b! + n 14 - n! + ] if 91 /mod swap [ ch>base91 accum push ] bi@ + ] when + ] each + + n 0 > [ + b 91 mod ch>base91 accum push + n 7 > b 90 > or [ + b 91 /i ch>base91 accum push + ] when + ] when + + accum B{ } like ; + +:: base91> ( base91 -- seq ) + f :> v! + 0 :> b! + 0 :> n! + BV{ } clone :> accum + + base91 [ + base91>ch + v [ + 91 * v + v! + v n shift b bitor b! + v 0x1fff bitand 88 > 13 14 ? n + n! + [ n 7 > ] [ + b 0xff bitand accum push + b -8 shift b! + n 8 - n! + ] do while + f v! + ] [ + v! + ] if + ] each + + v [ + b v n shift bitor 0xff bitand accum push + ] when + + accum B{ } like ; diff --git a/extra/base91/summary.txt b/extra/base91/summary.txt new file mode 100644 index 0000000000..cb9b5c7fcf --- /dev/null +++ b/extra/base91/summary.txt @@ -0,0 +1 @@ +Base91 encoding/decoding