From 48d8d60c7c57ad34c027c665aae5ef47ac2958da Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Oct 2007 13:37:47 -0400 Subject: [PATCH] Clean up and update tools.deploy --- extra/tools/deploy/app/app.factor | 4 +- extra/tools/deploy/config/config-docs.factor | 105 ++++++++ extra/tools/deploy/config/config.factor | 53 ++++ extra/tools/deploy/deploy-docs.factor | 99 +------- extra/tools/deploy/deploy.factor | 247 +------------------ extra/tools/deploy/shaker/shaker.factor | 194 +++++++++++++++ 6 files changed, 365 insertions(+), 337 deletions(-) create mode 100644 extra/tools/deploy/config/config-docs.factor create mode 100644 extra/tools/deploy/config/config.factor create mode 100644 extra/tools/deploy/shaker/shaker.factor diff --git a/extra/tools/deploy/app/app.factor b/extra/tools/deploy/app/app.factor index df33581c98..3672c9a586 100644 --- a/extra/tools/deploy/app/app.factor +++ b/extra/tools/deploy/app/app.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io io.files io.launcher kernel namespaces sequences -system cocoa.plists cocoa.application tools.deploy assocs -hashtables prettyprint ; +system cocoa.plists cocoa.application tools.deploy +tools.deploy.config assocs hashtables prettyprint ; IN: tools.deploy.app : mkdir ( path -- ) diff --git a/extra/tools/deploy/config/config-docs.factor b/extra/tools/deploy/config/config-docs.factor new file mode 100644 index 0000000000..6f683f9c44 --- /dev/null +++ b/extra/tools/deploy/config/config-docs.factor @@ -0,0 +1,105 @@ +USING: help.markup help.syntax words alien.c-types assocs +kernel ; +IN: tools.deploy.config + +ARTICLE: "deploy-config" "Deployment configuration" +"The deployment configuration is a key/value mapping stored in the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If this file does not exist, the default deployment configuration is used:" +{ $subsection default-config } +"The deployment configuration can be read and written with a pair of words:" +{ $subsection deploy-config } +{ $subsection set-deploy-config } +"A utility word is provided to load the configuration, change a flag, and store it back to disk:" +{ $subsection set-deploy-flag } ; + +ARTICLE: "deploy-flags" "Deployment flags" +"There are two types of flags. The first set controls the major subsystems which are to be included in the deployment image:" +{ $subsection deploy-math? } +{ $subsection deploy-compiled? } +{ $subsection deploy-io? } +{ $subsection deploy-ui? } +"The second set of flags controls the level of stripping to be performed on the deployment image; there is a trade-off between image size, and retaining functionality which is required by the application:" +{ $subsection strip-globals? } +{ $subsection strip-word-props? } +{ $subsection strip-word-names? } +{ $subsection strip-dictionary? } +{ $subsection strip-debugger? } +{ $subsection strip-prettyprint? } +{ $subsection strip-c-types? } ; + +ARTICLE: "prepare-deploy" "Preparing to deploy an application" +"In order to deploy an application as a stand-alone image, the application's vocabulary must first be given a " { $link POSTPONE: MAIN: } " hook. Then, a " { $emphasis "deployment configuration" } " must be created." +{ $subsection "deploy-config" } +{ $subsection "deploy-flags" } ; + +ABOUT: "prepare-deploy" + +HELP: strip-globals? +{ $description "Deploy flag. If set, the deploy tool applies various heuristics to strip out un-needed variables from the global namespace." +$nl +"On by default. Disable this if the heuristics strip out required variables." } ; + +HELP: strip-word-props? +{ $description "Deploy flag. If set, the deploy tool applies various heuristics to strip out un-needed word properties from words in the dictionary." +$nl +"On by default. Disable this if the heuristics strip out required word properties." } ; + +HELP: strip-word-names? +{ $description "Deploy flag. If set, the deploy tool strips word names from words in the dictionary." +$nl +"On by default. Disable this if your program calls " { $link word-name } "." } ; + +HELP: strip-dictionary? +{ $description "Deploy flag. If set, the deploy tool strips unused words." +$nl +"On by default. Disable this if your program calls " { $link lookup } " to look up words by name, or needs to parse code at run-time." } ; + +HELP: strip-debugger? +{ $description "Deploy flag. If set, the deploy tool strips the verbose error reporting facility; any errors thrown by the program will start the low-level debugger in the VM." +$nl +"On by default. Disable this if you need to debug a problem which only occurs when your program is running deployed." } ; + +HELP: strip-prettyprint? +{ $description "Deploy flag. If set, the deploy tool strips variables used by the prettyprinter." +$nl +"On by default. Disable this if your program uses the prettyprinter." } ; + +HELP: strip-c-types? +{ $description "Deploy flag. If set, the deploy tool strips out the " { $link c-types } " table." +$nl +"On by default. Disable this if your program calls " { $link c-type } ", " { $link heap-size } ", " { $link } ", " { $link } ", " { $link malloc-object } ", or " { $link malloc-array } " with a C type name which is not a literal pushed directly at the call site. In this situation, the compiler is unable to fold away the C type lookup, and thus must use the global table at runtime." } ; + +HELP: deploy-math? +{ $description "Deploy flag. If set, the deployed image will contain the full number tower." +$nl +"On by default. Most programs require the number tower, in particular, any program deployed with " { $link deploy-compiled? } " set." } ; + +HELP: deploy-compiled? +{ $description "Deploy flag. If set, words in the deployed image will be compiled when possible." +$nl +"On by default. Most programs should be compiled, not only for performance but because features which depend on the C library interface only function after compilation." } ; + +HELP: deploy-ui? +{ $description "Deploy flag. If set, the Factor UI will be included in the deployed image." +$nl +"Off by default. Programs wishing to use the UI must be deployed with this flag on." } ; + +HELP: deploy-io? +{ $description "Deploy flag. If set, support for non-blocking I/O and networking will be included in the deployed image." +$nl +"Off by default. Programs wishing to use non-blocking I/O or networking must be deployed with this flag on." } ; + +HELP: default-config +{ $values { "assoc" assoc } } +{ $description "Outputs the default deployment configuration." } ; + +HELP: deploy-config +{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } } +{ $description "Loads a vocabulary's deployment configuration from the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If the file does not exist, the " { $link default-config } " is output." } ; + +HELP: set-deploy-config +{ $values { "assoc" assoc } { "vocab" "a vocabulary specifier" } } +{ $description "Stores a vocabulary's deployment configuration to the " { $snippet "deploy.factor" } " file in the vocabulary's directory." } ; + +HELP: set-deploy-flag +{ $values { "value" object } { "key" object } { "vocab" "a vocabulary specifier" } } +{ $description "Modifies an entry in a vocabulary's deployment configuration on disk." } ; diff --git a/extra/tools/deploy/config/config.factor b/extra/tools/deploy/config/config.factor new file mode 100644 index 0000000000..832f9f4a1a --- /dev/null +++ b/extra/tools/deploy/config/config.factor @@ -0,0 +1,53 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: vocabs.loader io.files io kernel sequences assocs +splitting parser prettyprint ; +IN: tools.deploy.config + +SYMBOL: strip-globals? +SYMBOL: strip-word-props? +SYMBOL: strip-word-names? +SYMBOL: strip-dictionary? +SYMBOL: strip-debugger? +SYMBOL: strip-prettyprint? +SYMBOL: strip-c-types? + +SYMBOL: deploy-math? +SYMBOL: deploy-compiled? +SYMBOL: deploy-io? +SYMBOL: deploy-ui? + +SYMBOL: deploy-vm +SYMBOL: deploy-image + +: default-config ( -- assoc ) + V{ + { strip-prettyprint? t } + { strip-globals? t } + { strip-word-props? t } + { strip-word-names? t } + { strip-dictionary? t } + { strip-debugger? t } + { strip-c-types? t } + { deploy-math? t } + { deploy-compiled? t } + { deploy-io? f } + { deploy-ui? f } + ! default value for deploy.app + { "stop-after-last-window?" t } + } clone ; + +: deploy-config-path ( vocab -- string ) + vocab-dir "deploy.factor" path+ ; + +: deploy-config ( vocab -- assoc ) + default-config swap + dup deploy-config-path vocab-file-contents + parse-fresh dup empty? [ drop ] [ first union ] if ; + +: set-deploy-config ( assoc vocab -- ) + >r unparse-use string-lines r> + dup deploy-config-path set-vocab-file-contents ; + +: set-deploy-flag ( value key vocab -- ) + [ deploy-config [ set-at ] keep ] keep set-deploy-config ; diff --git a/extra/tools/deploy/deploy-docs.factor b/extra/tools/deploy/deploy-docs.factor index 1f25f68ff9..29e0da1f5c 100644 --- a/extra/tools/deploy/deploy-docs.factor +++ b/extra/tools/deploy/deploy-docs.factor @@ -2,30 +2,6 @@ USING: help.markup help.syntax words alien.c-types assocs kernel ; IN: tools.deploy -ARTICLE: "deploy-config" "Deployment configuration" -"The deployment configuration is a key/value mapping stored in the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If this file does not exist, the default deployment configuration is used:" -{ $subsection default-config } -"The deployment configuration can be read and written with a pair of words:" -{ $subsection deploy-config } -{ $subsection set-deploy-config } -"A utility word is provided to load the configuration, change a flag, and store it back to disk:" -{ $subsection set-deploy-flag } ; - -ARTICLE: "deploy-flags" "Deployment flags" -"There are two types of flags. The first set controls the major subsystems which are to be included in the deployment image:" -{ $subsection deploy-math? } -{ $subsection deploy-compiled? } -{ $subsection deploy-io? } -{ $subsection deploy-ui? } -"The second set of flags controls the level of stripping to be performed on the deployment image; there is a trade-off between image size, and retaining functionality which is required by the application:" -{ $subsection strip-globals? } -{ $subsection strip-word-props? } -{ $subsection strip-word-names? } -{ $subsection strip-dictionary? } -{ $subsection strip-debugger? } -{ $subsection strip-prettyprint? } -{ $subsection strip-c-types? } ; - ARTICLE: "tools.deploy" "Stand-alone image deployment" "The stand-alone image deployment tool takes a vocabulary and generates an image, which when passed to the VM, runs the vocabulary's " { $link POSTPONE: MAIN: } " hook." $nl @@ -33,85 +9,12 @@ $nl { $code "\"hello-world\" deploy" } "This generates an image file named " { $snippet "hello-world.image" } ". Now we can start this image from the operating system's command line (see " { $link "runtime-cli-args" } "):" { $code "./factor -i=hello-world.image" "Hello world" } -"In order to deploy an application as a stand-alone image, the application's vocabulary must first be given a " { $link POSTPONE: MAIN: } " hook. Then, a " { $emphasis "deployment configuration" } " must be created." -{ $subsection "deploy-config" } -{ $subsection "deploy-flags" } + "Once the necessary deployment flags have been set, a deployment image can be generated:" { $subsection deploy } ; ABOUT: "tools.deploy" -HELP: strip-globals? -{ $description "Deploy flag. If set, the deploy tool applies various heuristics to strip out un-needed variables from the global namespace." -$nl -"On by default. Disable this if the heuristics strip out required variables." } ; - -HELP: strip-word-props? -{ $description "Deploy flag. If set, the deploy tool applies various heuristics to strip out un-needed word properties from words in the dictionary." -$nl -"On by default. Disable this if the heuristics strip out required word properties." } ; - -HELP: strip-word-names? -{ $description "Deploy flag. If set, the deploy tool strips word names from words in the dictionary." -$nl -"On by default. Disable this if your program calls " { $link word-name } "." } ; - -HELP: strip-dictionary? -{ $description "Deploy flag. If set, the deploy tool strips unused words." -$nl -"On by default. Disable this if your program calls " { $link lookup } " to look up words by name, or needs to parse code at run-time." } ; - -HELP: strip-debugger? -{ $description "Deploy flag. If set, the deploy tool strips the verbose error reporting facility; any errors thrown by the program will start the low-level debugger in the VM." -$nl -"On by default. Disable this if you need to debug a problem which only occurs when your program is running deployed." } ; - -HELP: strip-prettyprint? -{ $description "Deploy flag. If set, the deploy tool strips variables used by the prettyprinter." -$nl -"On by default. Disable this if your program uses the prettyprinter." } ; - -HELP: strip-c-types? -{ $description "Deploy flag. If set, the deploy tool strips out the " { $link c-types } " table." -$nl -"On by default. Disable this if your program calls " { $link c-type } ", " { $link heap-size } ", " { $link } ", " { $link } ", " { $link malloc-object } ", or " { $link malloc-array } " with a C type name which is not a literal pushed directly at the call site. In this situation, the compiler is unable to fold away the C type lookup, and thus must use the global table at runtime." } ; - -HELP: deploy-math? -{ $description "Deploy flag. If set, the deployed image will contain the full number tower." -$nl -"On by default. Most programs require the number tower, in particular, any program deployed with " { $link deploy-compiled? } " set." } ; - -HELP: deploy-compiled? -{ $description "Deploy flag. If set, words in the deployed image will be compiled when possible." -$nl -"On by default. Most programs should be compiled, not only for performance but because features which depend on the C library interface only function after compilation." } ; - -HELP: deploy-ui? -{ $description "Deploy flag. If set, the Factor UI will be included in the deployed image." -$nl -"Off by default. Programs wishing to use the UI must be deployed with this flag on." } ; - -HELP: deploy-io? -{ $description "Deploy flag. If set, support for non-blocking I/O and networking will be included in the deployed image." -$nl -"Off by default. Programs wishing to use non-blocking I/O or networking must be deployed with this flag on." } ; - -HELP: default-config -{ $values { "assoc" assoc } } -{ $description "Outputs the default deployment configuration." } ; - -HELP: deploy-config -{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } } -{ $description "Loads a vocabulary's deployment configuration from the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If the file does not exist, the " { $link default-config } " is output." } ; - -HELP: set-deploy-config -{ $values { "assoc" assoc } { "vocab" "a vocabulary specifier" } } -{ $description "Stores a vocabulary's deployment configuration to the " { $snippet "deploy.factor" } " file in the vocabulary's directory." } ; - -HELP: set-deploy-flag -{ $values { "value" object } { "key" object } { "vocab" "a vocabulary specifier" } } -{ $description "Modifies an entry in a vocabulary's deployment configuration on disk." } ; - HELP: deploy* { $values { "vm" "a pathname string" } { "image" "a pathname string" } { "vocab" "a vocabulary specifier" } { "config" assoc } } { $description "Deploys " { $snippet "vocab" } ", which must have a " { $link POSTPONE: MAIN: } " hook, using the specified VM and configuration. The deployed image is saved as " { $snippet "image" } "." } diff --git a/extra/tools/deploy/deploy.factor b/extra/tools/deploy/deploy.factor index dfa31ed06d..9a7f99a99d 100644 --- a/extra/tools/deploy/deploy.factor +++ b/extra/tools/deploy/deploy.factor @@ -5,255 +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 ; +quotations io.launcher words.private tools.deploy.config ; IN: tools.deploy -SYMBOL: strip-globals? -SYMBOL: strip-word-props? -SYMBOL: strip-word-names? -SYMBOL: strip-dictionary? -SYMBOL: strip-debugger? -SYMBOL: strip-prettyprint? -SYMBOL: strip-c-types? - -SYMBOL: deploy-math? -SYMBOL: deploy-compiled? -SYMBOL: deploy-io? -SYMBOL: deploy-ui? - -SYMBOL: deploy-vm -SYMBOL: deploy-image - -: default-config ( -- assoc ) - V{ - { strip-prettyprint? t } - { strip-globals? t } - { strip-word-props? t } - { strip-word-names? t } - { strip-dictionary? t } - { strip-debugger? t } - { strip-c-types? t } - { deploy-math? t } - { deploy-compiled? t } - { deploy-io? f } - { deploy-ui? f } - ! default value for deploy.app - { "stop-after-last-window?" t } - } clone ; - -: deploy-config-path ( vocab -- string ) - vocab-dir "deploy.factor" path+ ; - -: deploy-config ( vocab -- assoc ) - default-config swap - dup deploy-config-path vocab-file-contents - parse-fresh dup empty? [ drop ] [ first union ] if ; - -: set-deploy-config ( assoc vocab -- ) - >r unparse-use string-lines r> - dup deploy-config-path set-vocab-file-contents ; - -: set-deploy-flag ( value key vocab -- ) - [ deploy-config [ set-at ] keep ] keep set-deploy-config ; - r V{ } set-datastack r> - V{ } set-retainstack - V{ } set-callstack - V{ } set-namestack - V{ } set-catchstack - "Saving final image" show - [ save-image-and-exit ] call ; - -SYMBOL: deploy-vocab - -: set-boot-quot* ( word -- ) - [ - \ boot , - init-hooks get values concat % - , - "io.backend" init-hooks get at [ \ flush , ] when - ] [ ] make "Boot quotation: " write dup . flush - set-boot-quot ; - -: retained-globals ( -- seq ) - [ - builtins , - io-backend , - - strip-dictionary? get [ - { - builtins - dictionary - inspector-hook - lexer-factory - load-vocab-hook - num-tags - num-types - tag-bits - tag-mask - tag-numbers - typemap - vocab-roots - } % - ] unless - - strip-prettyprint? get [ - { - tab-size - margin - } % - ] unless - - strip-c-types? get not deploy-ui? get or [ - "c-types" "alien.c-types" lookup , - ] when - - deploy-ui? get [ - "ui" child-vocabs - "cocoa" child-vocabs - deploy-vocab get child-vocabs 3append - global keys [ word? ] subset - swap [ >r word-vocabulary r> member? ] curry - subset % - ] when - ] { } make dup . ; - -: normalize-strip-flags - strip-prettyprint? get [ - strip-word-names? off - ] unless - strip-dictionary? get [ - strip-prettyprint? off - strip-word-names? off - strip-word-props? off - ] unless ; - -: strip ( -- ) - normalize-strip-flags - strip-cocoa - strip-debugger - strip-init-hooks - deploy-vocab get vocab-main set-boot-quot* - retained-props >r - retained-globals strip-environment - r> strip-words ; - -: (deploy) ( final-image vocab config -- ) - #! Does the actual work of a deployment in the slave - #! stage2 image - [ - [ - deploy-vocab set - parse-hook get >r - parse-hook off - deploy-vocab get require - r> call - strip - finish-deploy - ] [ - print-error flush 1 exit - ] recover - ] bind ; - -: do-deploy ( -- ) - "output-image" get - "deploy-vocab" get - "Deploying " write dup write "..." print - dup deploy-config dup . - (deploy) ; - : (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." % cpu % ".image" % + "\"" % swap % "\" -i=boot." % + boot-image-name + % ".image" % [ " " % % ] each ] "" make - dup print copy-lines ; + dup print + dup duplex-stream-out stream-close + copy-lines ; : profile-string ( config -- string ) { @@ -283,5 +58,3 @@ PRIVATE> : deploy ( vocab -- ) vm over ".image" append rot dup deploy-config deploy* ; - -MAIN: do-deploy diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor new file mode 100644 index 0000000000..9eabf1a67e --- /dev/null +++ b/extra/tools/deploy/shaker/shaker.factor @@ -0,0 +1,194 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces continuations.private kernel.private init +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 words.private tools.deploy.config ; +IN: tools.deploy.shaker + +: show ( msg -- ) + #! Use primitives directly so that we can print stuff even + #! after most of the image has been stripped away + "\r\n" append stdout fwrite stdout fflush ; + +: strip-init-hooks ( -- ) + "Stripping startup hooks" show + "command-line" init-hooks get delete-at ; + +: strip-debugger ( -- ) + strip-debugger? get [ + "Stripping debugger" show + "resource:extra/tools/deploy/strip-debugger.factor" + run-file + ] when ; + +: strip-cocoa ( -- ) + "cocoa" vocab [ + "Stripping unused Cocoa methods" show + "resource:extra/tools/deploy/strip-cocoa.factor" + run-file + ] when ; + +: strip-assoc ( retained-keys assoc -- newassoc ) + swap [ nip member? ] curry assoc-subset ; + +: strip-word-names ( words -- ) + "Stripping word names" show + [ f over set-word-name f swap set-word-vocabulary ] each ; + +: strip-word-defs ( words -- ) + "Stripping unoptimized definitions from optimized words" show + [ compiled? ] subset [ [ ] swap set-word-def ] each ; + +: strip-word-props ( retain-props words -- ) + "Stripping word properties" show + [ + [ word-props strip-assoc f assoc-like ] keep + set-word-props + ] curry* each ; + +: retained-props ( -- seq ) + [ + "class" , + "metaclass" , + "slot-names" , + deploy-ui? get [ + "gestures" , + "commands" , + { "+nullary+" "+listener+" "+description+" } + [ "ui.commands" lookup , ] each + ] when + ] { } make ; + +: strip-words ( props -- ) + [ word? ] instances + strip-word-props? get [ tuck strip-word-props ] [ nip ] if + strip-word-names? get [ dup strip-word-names ] when + strip-word-defs ; + +USING: bit-arrays byte-arrays io.streams.nested ; + +: strip-classes ( -- ) + "Stripping classes" show + io-backend get [ + c-reader forget + c-writer forget + ] when + { style-stream mirror enum } [ forget ] each ; + +: strip-environment ( retain-globals -- ) + "Stripping environment" show + strip-globals? get [ + global strip-assoc 21 setenv + ] [ drop ] if ; + +: finish-deploy ( final-image -- ) + "Finishing up" show + >r { } set-datastack r> + { } set-retainstack + V{ } set-namestack + V{ } set-catchstack + "Saving final image" show + [ save-image-and-exit ] call-clear ; + +SYMBOL: deploy-vocab + +: set-boot-quot* ( word -- ) + [ + \ boot , + init-hooks get values concat % + , + "io.backend" init-hooks get at [ \ flush , ] when + ] [ ] make "Boot quotation: " write dup . flush + set-boot-quot ; + +: retained-globals ( -- seq ) + [ + builtins , + io-backend , + + strip-dictionary? get [ + { + builtins + dictionary + inspector-hook + lexer-factory + load-vocab-hook + num-tags + num-types + tag-bits + tag-mask + tag-numbers + typemap + vocab-roots + } % + ] unless + + strip-prettyprint? get [ + { + tab-size + margin + } % + ] unless + + strip-c-types? get not deploy-ui? get or [ + "c-types" "alien.c-types" lookup , + ] when + + deploy-ui? get [ + "ui" child-vocabs + "cocoa" child-vocabs + deploy-vocab get child-vocabs 3append + global keys [ word? ] subset + swap [ >r word-vocabulary r> member? ] curry + subset % + ] when + ] { } make dup . ; + +: normalize-strip-flags + strip-prettyprint? get [ + strip-word-names? off + ] unless + strip-dictionary? get [ + strip-prettyprint? off + strip-word-names? off + strip-word-props? off + ] unless ; + +: strip ( -- ) + normalize-strip-flags + strip-cocoa + strip-debugger + strip-init-hooks + deploy-vocab get vocab-main set-boot-quot* + retained-props >r + retained-globals strip-environment + r> strip-words ; + +: (deploy) ( final-image vocab config -- ) + #! Does the actual work of a deployment in the slave + #! stage2 image + [ + [ + deploy-vocab set + parse-hook get >r + parse-hook off + deploy-vocab get require + r> [ call ] when* + strip + finish-deploy + ] [ + print-error flush 1 exit + ] recover + ] bind ; + +: do-deploy ( -- ) + "output-image" get + "deploy-vocab" get + "Deploying " write dup write "..." print + dup deploy-config dup . + (deploy) ; + +MAIN: do-deploy