steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

make-image can now generate images with Unicode strings

db4
Slava Pestov 2009-01-27 00:03:19 -06:00
parent e32d11a4d0
commit 1dca238581
1 changed files with 23 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
basis/bootstrap/image/image.factor
View File

@ -344,25 +344,37 @@ M: wrapper '
[ emit ] emit-object ; [ emit ] emit-object ;
! Strings ! Strings
: native> ( object -- object )
big-endian get [ [ be> ] map ] [ [ le> ] map ] if ;
: emit-bytes ( seq -- ) : emit-bytes ( seq -- )
bootstrap-cell <groups> bootstrap-cell <groups> native> emit-seq ;
big-endian get [ [ be> ] map ] [ [ le> ] map ] if
emit-seq ;
: pad-bytes ( seq -- newseq ) : pad-bytes ( seq -- newseq )
dup length bootstrap-cell align 0 pad-right ; dup length bootstrap-cell align 0 pad-right ;
: check-string ( string -- ) : extended-part ( str -- str' )
[ 127 > ] contains? dup [ 128 < ] all? [ drop f ] [
[ "Bootstrap cannot emit non-ASCII strings" throw ] when ; [ -7 shift 1 bitxor ] { } map-as
big-endian get
[ [ 2 >be ] { } map-as ]
[ [ 2 >le ] { } map-as ] if
B{ } join
] if ;
: ascii-part ( str -- str' )
[
[ 128 mod ] [ 128 >= ] bi
[ 128 bitor ] when
] B{ } map-as ;
: emit-string ( string -- ptr ) : emit-string ( string -- ptr )
dup check-string [ length ] [ extended-part ' ] [ ] tri
string type-number object tag-number [ string type-number object tag-number [
dup length emit-fixnum [ emit-fixnum ]
f ' emit [ emit ]
f ' emit [ f ' emit ascii-part pad-bytes emit-bytes ]
pad-bytes emit-bytes tri*
] emit-object ; ] emit-object ;
M: string ' M: string '