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

bootstrap.image: 6-7% speedup to make-image.

db4
John Benediktsson 2013-03-25 16:58:39 -07:00
parent 86649ce1c0
commit d25fb6161e
1 changed files with 39 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,17 +1,16 @@
! Copyright (C) 2004, 2011 Slava Pestov. ! Copyright (C) 2004, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.strings arrays byte-arrays generic hashtables USING: accessors arrays assocs bootstrap.image.syntax
hashtables.private io io.binary io.files io.encodings.binary byte-arrays classes classes.builtin classes.private
io.pathnames kernel kernel.private math namespaces make parser classes.tuple classes.tuple.private combinators
prettyprint sequences combinators.smart strings sbufs vectors combinators.short-circuit combinators.smart
words quotations assocs system layouts splitting grouping compiler.codegen.relocation compiler.units fry generic
growable classes classes.private classes.builtin classes.tuple generic.single.private grouping hashtables hashtables.private
classes.tuple.private vocabs vocabs.loader source-files io io.binary io.encodings.binary io.files io.pathnames kernel
definitions debugger quotations.private combinators kernel.private layouts locals make math math.order namespaces
combinators.short-circuit math.order math.private accessors namespaces.private parser parser.notes prettyprint quotations
slots.private generic.single.private compiler.units sequences sequences.private source-files strings system vectors
compiler.constants compiler.codegen.relocation fry locals vocabs words ;
bootstrap.image.syntax parser.notes namespaces.private ;
IN: bootstrap.image IN: bootstrap.image
: arch ( os cpu -- arch ) : arch ( os cpu -- arch )
@ -52,11 +51,12 @@ GENERIC: (eql?) ( obj1 obj2 -- ? )
M: fixnum (eql?) eq? ; M: fixnum (eql?) eq? ;
M: bignum (eql?) = ; M: bignum (eql?) { bignum bignum } declare = ;
M: float (eql?) fp-bitwise= ; M: float (eql?) fp-bitwise= ;
M: sequence (eql?) 2dup [ length ] same? [ [ eql? ] 2all? ] [ 2drop f ] if ; M: sequence (eql?)
2dup [ length ] same? [ [ eql? ] 2all? ] [ 2drop f ] if ;
M: object (eql?) = ; M: object (eql?) = ;
@ -81,9 +81,11 @@ SYMBOL: objects
: cache-eq-object ( obj quot -- value ) : cache-eq-object ( obj quot -- value )
[ <eq-wrapper> objects get ] dip '[ obj>> @ ] cache ; inline [ <eq-wrapper> objects get ] dip '[ obj>> @ ] cache ; inline
: lookup-object ( obj -- n/f ) <eq-wrapper> objects get at ; : lookup-object ( obj -- n/f )
<eq-wrapper> objects get at ;
: put-object ( n obj -- ) <eq-wrapper> objects get set-at ; : put-object ( n obj -- )
<eq-wrapper> objects get set-at ;
! Constants ! Constants
@ -343,17 +345,17 @@ M: f ' drop \ f type-number ;
[ [
[ [
{ {
[ hashcode <fake-bignum> , ] [ hashcode <fake-bignum> ]
[ name>> , ] [ name>> ]
[ vocabulary>> , ] [ vocabulary>> ]
[ def>> , ] [ def>> ]
[ props>> , ] [ props>> ]
[ pic-def>> , ] [ pic-def>> ]
[ pic-tail-def>> , ] [ pic-tail-def>> ]
[ word-sub-primitive , ] [ word-sub-primitive ]
[ drop 0 , ] ! entry point [ drop 0 ] ! entry point
} cleave } cleave
] { } make [ ' ] map ] output>array [ ' ] map!
] bi ] bi
\ word [ emit-seq ] emit-object \ word [ emit-seq ] emit-object
] keep put-object ; ] keep put-object ;
@ -469,10 +471,11 @@ M: array ' [ emit-array ] cache-eq-object ;
! them a built-in type is not worth it. ! them a built-in type is not worth it.
PREDICATE: tuple-layout-array < array PREDICATE: tuple-layout-array < array
dup length 5 >= [ dup length 5 >= [
[ first tuple-class? ] {
[ second fixnum? ] [ first-unsafe tuple-class? ]
[ third fixnum? ] [ second-unsafe fixnum? ]
tri and and [ third-unsafe fixnum? ]
} 1&&
] [ drop f ] if ; ] [ drop f ] if ;
M: tuple-layout-array ' M: tuple-layout-array '
@ -547,8 +550,8 @@ M: quotation '
] with-compilation-unit ; ] with-compilation-unit ;
: build-image ( -- image ) : build-image ( -- image )
800000 <vector> image set 600,000 <vector> image set
20000 <hashtable> objects set 60,000 <hashtable> objects set
emit-image-header t, 0, 1, -1, emit-image-header t, 0, 1, -1,
"Building generic words..." print flush "Building generic words..." print flush
build-generics build-generics
@ -572,9 +575,10 @@ M: quotation '
! Image output ! Image output
: (write-image) ( image -- ) : (write-image) ( image -- )
bootstrap-cell big-endian get bootstrap-cell output-stream get
[ '[ _ >be write ] each ] big-endian get
[ '[ _ >le write ] each ] if ; [ '[ _ >be _ stream-write ] each ]
[ '[ _ >le _ stream-write ] each ] if ;
: write-image ( image -- ) : write-image ( image -- )
"Writing image to " write "Writing image to " write