1 ! Copyright (C) 2007, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces continuations.private kernel.private init
4 assocs kernel vocabs words sequences memory io system arrays
5 continuations math definitions mirrors splitting parser classes
6 summary layouts vocabs.loader prettyprint.config prettyprint
7 debugger io.streams.c io.files io.backend
8 quotations io.launcher words.private tools.deploy.config
9 bootstrap.image io.encodings.utf8 destructors accessors ;
10 IN: tools.deploy.backend
12 : copy-vm ( executable bundle-name extension -- vm )
13 [ prepend-path ] dip append vm over copy-file ;
15 : copy-fonts ( name dir -- )
16 append-path "resource:fonts/" swap copy-tree-into ;
18 : image-name ( vocab bundle-name -- str )
19 prepend-path ".image" append ;
21 : (copy-lines) ( stream -- )
23 [ print flush (copy-lines) ] [ 2drop ] if ;
25 : copy-lines ( stream -- )
26 [ (copy-lines) ] with-disposal ;
28 : run-with-output ( arguments -- )
33 +low-priority+ >>priority
34 utf8 <process-reader*>
36 wait-for-process zero? [ "Deployment failed" throw ] unless ;
38 : make-boot-image ( -- )
39 #! If stage1 image doesn't exist, create one.
40 my-boot-image-name resource-path exists?
41 [ my-arch make-image ] unless ;
43 : bootstrap-profile ( -- profile )
45 { "math" deploy-math? }
46 { "compiler" deploy-compiler? }
48 { "random" deploy-random? }
49 } [ nip get ] assoc-filter keys
50 native-io? [ "io" suffix ] when ;
52 : staging-image-name ( profile -- name )
54 swap strip-word-names? [ "strip" suffix ] when
55 "-" join ".image" 3append temp-file ;
57 DEFER: ?make-staging-image
59 : staging-command-line ( profile -- flags )
62 "-i=" my-boot-image-name append ,
64 dup but-last ?make-staging-image
66 "-resource-path=" "" resource-path append ,
68 "-i=" over but-last staging-image-name append ,
70 "-run=tools.deploy.restage" ,
73 "-output-image=" over staging-image-name append ,
75 "-include=" swap " " join append ,
77 strip-word-names? [ "-no-stack-traces" , ] when
82 : run-factor ( vm flags -- )
83 swap prefix dup . run-with-output ; inline
85 : make-staging-image ( profile -- )
86 vm swap staging-command-line run-factor ;
88 : ?make-staging-image ( profile -- )
89 dup staging-image-name exists?
90 [ drop ] [ make-staging-image ] if ;
92 : deploy-command-line ( image vocab config -- flags )
94 bootstrap-profile ?make-staging-image
97 "-i=" bootstrap-profile staging-image-name append ,
99 "-resource-path=" "" resource-path append ,
101 "-run=tools.deploy.shaker" ,
103 "-deploy-vocab=" prepend ,
105 "-output-image=" prepend ,
107 strip-word-names? [ "-no-stack-traces" , ] when
111 : make-deploy-image ( vm image vocab config -- )
113 deploy-command-line run-factor ;
115 HOOK: deploy* os ( vocab -- )