--- /dev/null
+USING: base91 byte-arrays kernel sequences tools.test ;
+
+{ t } [ 256 <iota> >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
--- /dev/null
+! 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 ;
+
+<PRIVATE
+
+<<
+CONSTANT: alphabet $[
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~\""
+ >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 ;