1 ! Copyright (C) 2007, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces make 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 debugger
7 io.streams.c io.files io.files.temp io.pathnames io.directories
8 io.directories.hierarchy io.backend quotations io.launcher
9 tools.deploy.config tools.deploy.config.editor bootstrap.image
10 io.encodings.utf8 destructors accessors hashtables
11 tools.deploy.libraries vocabs.metadata.resources
12 tools.deploy.embed locals ;
13 IN: tools.deploy.backend
15 : copy-vm ( executable bundle-name -- vm-path )
16 prepend-path vm-path over copy-file ;
18 TUPLE: vocab-manifest vocabs libraries ;
20 : copy-resources ( manifest name dir -- )
21 append-path swap vocabs>> [ copy-vocab-resources ] with each ;
23 ERROR: can't-deploy-library-file library ;
25 : copy-library ( dir library -- )
27 [ swap over file-name append-path copy-file ]
28 [ throw-can't-deploy-library-file ] ?if ;
30 : copy-libraries ( manifest name dir -- )
31 append-path swap libraries>> [ copy-library ] with each ;
33 : deployed-image-name ( vocab -- str )
34 ".image" append temp-file ;
37 readln [ print flush copy-lines ] when* ;
39 : run-with-output ( arguments -- )
44 +low-priority+ >>priority
45 utf8 [ copy-lines ] with-process-reader ;
47 : make-boot-image ( -- )
48 #! If stage1 image doesn't exist, create one.
49 my-boot-image-name resource-path exists?
50 [ make-my-image ] unless ;
52 : bootstrap-profile ( -- profile )
54 deploy-math? get [ "math" , ] when
55 deploy-threads? get [ "threads" , ] when
57 deploy-help? get [ "help" , ] when
58 native-io? [ "io" , ] when
59 deploy-ui? get [ "ui" , ] when
60 deploy-unicode? get [ "unicode" , ] when
64 : staging-image-name ( profile -- name )
65 "-" join "." my-arch-name 3append
66 "staging." ".image" surround cache-file ;
68 : delete-staging-images ( -- )
70 [ "staging." head? ] filter
71 "." my-arch-name ".image" 3append [ tail? ] curry filter
73 ] with-directory-files ;
75 : staging-command-line ( profile -- flags )
78 "-staging" , "-no-user-init" , "-pic=0" ,
79 [ staging-image-name "-output-image=" prepend , ]
80 [ " " join "-include=" prepend , ] bi
82 [ "-i=" my-boot-image-name append , ] [
83 but-last staging-image-name "-i=" prepend ,
84 "-resource-path=" "" resource-path append ,
85 "-run=tools.deploy.restage" ,
90 : run-factor ( vm-path flags -- )
91 swap prefix dup . run-with-output ; inline
93 DEFER: ?make-staging-image
95 : make-staging-image ( profile -- )
96 dup [ but-last ?make-staging-image ] unless-empty
97 vm-path swap staging-command-line run-factor ;
99 : ?make-staging-image ( profile -- )
100 dup staging-image-name exists?
101 [ drop ] [ make-staging-image ] if ;
103 : make-deploy-config ( vocab -- file )
104 [ deploy-config vocab-roots get vocab-roots associate assoc-union unparse-use ]
105 [ "deploy-config-" prepend temp-file ] bi
106 [ utf8 set-file-contents ] keep ;
108 : deploy-command-line ( image vocab manifest-file profile -- flags )
111 staging-image-name "-i=" prepend ,
112 "-vocab-manifest-out=" prepend ,
113 [ "-deploy-vocab=" prepend , ]
114 [ make-deploy-config "-deploy-config=" prepend , ] bi
115 "-output-image=" prepend ,
116 "-resource-path=" "" resource-path append ,
117 "-run=tools.deploy.shaker" ,
120 : parse-vocab-manifest-file ( path -- vocab-manifest )
121 utf8 file-lines [ "empty vocab manifest!" throw ] [
122 unclip-slice "VOCABS:" =
123 [ { "LIBRARIES:" } split1 vocab-manifest boa ]
124 [ "invalid vocab manifest!" throw ] if
127 :: make-deploy-image ( vm image vocab config -- manifest )
130 bootstrap-profile :> profile
131 vocab "vocab-manifest-" prepend temp-file :> manifest-file
132 image vocab manifest-file profile deploy-command-line :> flags
133 profile ?make-staging-image
135 manifest-file parse-vocab-manifest-file
138 :: make-deploy-image-executable ( vm image vocab config -- manifest )
139 vm image vocab config make-deploy-image
140 image vm embed-image ;
142 SYMBOL: open-directory-after-deploy?
143 t open-directory-after-deploy? set-global
145 HOOK: deploy* os ( vocab -- )
147 HOOK: deploy-path os ( vocab -- path )