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

Clean up bootstrap.image

db4
Slava Pestov 2008-02-10 01:49:27 -06:00
parent 125e949200
commit d8edd7b0d4
1 changed files with 17 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
core/bootstrap/image/image.factor
View File

@ -135,10 +135,8 @@ SYMBOL: undefined-quot
: here-as ( tag -- pointer ) here swap bitor ; : here-as ( tag -- pointer ) here swap bitor ;
USE: continuations
: align-here ( -- ) : align-here ( -- )
here 8 mod 4 = [ break heap-size drop 0 emit ] when ; here 8 mod 4 = [ heap-size drop 0 emit ] when ;
: emit-fixnum ( n -- ) tag-fixnum emit ; : emit-fixnum ( n -- ) tag-fixnum emit ;
@ -217,10 +215,6 @@ M: f '
: 1, 1 >bignum ' 1-offset fixup ; : 1, 1 >bignum ' 1-offset fixup ;
: -1, -1 >bignum ' -1-offset fixup ; : -1, -1 >bignum ' -1-offset fixup ;
! Beginning of the image
: begin-image ( -- )
emit-header t, 0, 1, -1, ;
! Words ! Words
: emit-word ( word -- ) : emit-word ( word -- )
@ -388,7 +382,10 @@ M: curry '
: fixup-header ( -- ) : fixup-header ( -- )
heap-size data-heap-size-offset fixup ; heap-size data-heap-size-offset fixup ;
: end-image ( -- ) : build-image ( -- image )
800000 <vector> image set
20000 <hashtable> objects set
emit-header t, 0, 1, -1,
"Serializing words..." print flush "Serializing words..." print flush
emit-words emit-words
"Serializing JIT data..." print flush "Serializing JIT data..." print flush
@ -403,7 +400,8 @@ M: curry '
fixup-header fixup-header
"Image length: " write image get length . "Image length: " write image get length .
"Object cache size: " write objects get assoc-size . "Object cache size: " write objects get assoc-size .
\ word global delete-at ; \ word global delete-at
image get ;
! Image output ! Image output
@ -414,28 +412,23 @@ M: curry '
[ >le write ] curry each [ >le write ] curry each
] if ; ] if ;
: write-image ( image filename -- ) : write-image ( image -- )
"Writing image to " write dup write "..." print flush "Writing image to " write
architecture get boot-image-name resource-path
dup write "..." print flush
<file-writer> [ (write-image) ] with-stream ; <file-writer> [ (write-image) ] with-stream ;
: prepare-image ( -- )
bootstrapping? on
load-help? off
800000 <vector> image set
20000 <hashtable> objects set ;
PRIVATE> PRIVATE>
: make-image ( arch -- ) : make-image ( arch -- )
architecture [ [
prepare-image architecture set
bootstrapping? on
load-help? off
"resource:/core/bootstrap/stage1.factor" run-file "resource:/core/bootstrap/stage1.factor" run-file
begin-image build-image
end-image
image get
architecture get boot-image-name resource-path
write-image write-image
] with-variable ; ] with-scope ;
: make-images ( -- ) : make-images ( -- )
images [ make-image ] each ; images [ make-image ] each ;