Deploy generates a stage1 image now if necessary

release
Slava Pestov 2007-11-05 01:37:07 -05:00
parent b85af601c0
commit 86f98eac40
2 changed files with 17 additions and 9 deletions
core/bootstrap/image
extra/tools/deploy

View File

@ -442,7 +442,7 @@ M: curry '
PRIVATE>
: make-image ( architecture -- )
: make-image ( arch -- )
[
parse-hook off
prepare-image
@ -452,6 +452,9 @@ PRIVATE>
image get image-name write-image
] with-scope ;
: my-arch ( -- arch )
cpu dup "ppc" = [ os "-" rot 3append ] when ;
: make-images ( -- )
{
"x86.32" "x86.64" "linux-ppc" "macosx-ppc" "arm"

View File

@ -5,25 +5,30 @@ assocs kernel vocabs words sequences memory io system arrays
continuations math definitions mirrors splitting parser classes
inspector layouts vocabs.loader prettyprint.config prettyprint
debugger io.streams.c io.streams.duplex io.files io.backend
quotations io.launcher words.private tools.deploy.config ;
quotations io.launcher words.private tools.deploy.config
bootstrap.image ;
IN: tools.deploy
<PRIVATE
: boot-image-name ( -- string )
"boot." my-arch ".image" 3append ;
: stage1 ( -- )
#! If stage1 image doesn't exist, create one.
boot-image-name resource-path exists?
[ my-arch make-image ] unless ;
: (copy-lines) ( stream -- stream )
dup stream-readln [ print flush (copy-lines) ] when* ;
: copy-lines ( stream -- )
[ (copy-lines) ] [ stream-close ] [ ] cleanup ;
: boot-image-name ( -- string )
cpu dup "ppc" = [ os "-" rot 3append ] when ;
: stage2 ( vm flags -- )
[
"\"" % swap % "\" -i=boot." %
boot-image-name
% ".image" %
"\"" % swap % "\" -i=" %
boot-image-name %
[ " " % % ] each
] "" make
dup print <process-stream>
@ -57,7 +62,7 @@ IN: tools.deploy
PRIVATE>
: deploy* ( vm image vocab config -- )
deploy-command-line stage2 ;
stage1 deploy-command-line stage2 ;
SYMBOL: deploy-implementation