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

View File

@ -442,7 +442,7 @@ M: curry '
PRIVATE> PRIVATE>
: make-image ( architecture -- ) : make-image ( arch -- )
[ [
parse-hook off parse-hook off
prepare-image prepare-image
@ -452,6 +452,9 @@ PRIVATE>
image get image-name write-image image get image-name write-image
] with-scope ; ] with-scope ;
: my-arch ( -- arch )
cpu dup "ppc" = [ os "-" rot 3append ] when ;
: make-images ( -- ) : make-images ( -- )
{ {
"x86.32" "x86.64" "linux-ppc" "macosx-ppc" "arm" "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 continuations math definitions mirrors splitting parser classes
inspector layouts vocabs.loader prettyprint.config prettyprint inspector layouts vocabs.loader prettyprint.config prettyprint
debugger io.streams.c io.streams.duplex io.files io.backend 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 IN: tools.deploy
<PRIVATE <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 ) : (copy-lines) ( stream -- stream )
dup stream-readln [ print flush (copy-lines) ] when* ; dup stream-readln [ print flush (copy-lines) ] when* ;
: copy-lines ( stream -- ) : copy-lines ( stream -- )
[ (copy-lines) ] [ stream-close ] [ ] cleanup ; [ (copy-lines) ] [ stream-close ] [ ] cleanup ;
: boot-image-name ( -- string )
cpu dup "ppc" = [ os "-" rot 3append ] when ;
: stage2 ( vm flags -- ) : stage2 ( vm flags -- )
[ [
"\"" % swap % "\" -i=boot." % "\"" % swap % "\" -i=" %
boot-image-name boot-image-name %
% ".image" %
[ " " % % ] each [ " " % % ] each
] "" make ] "" make
dup print <process-stream> dup print <process-stream>
@ -57,7 +62,7 @@ IN: tools.deploy
PRIVATE> PRIVATE>
: deploy* ( vm image vocab config -- ) : deploy* ( vm image vocab config -- )
deploy-command-line stage2 ; stage1 deploy-command-line stage2 ;
SYMBOL: deploy-implementation SYMBOL: deploy-implementation