From 9d5b944ec1dbbd035ef6ce34060cfa5938a739ff Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 30 Jan 2008 23:16:20 -0600 Subject: [PATCH 1/2] io.launcher: update docs --- extra/io/launcher/launcher-docs.factor | 15 ++++++++++----- extra/io/launcher/launcher.factor | 10 +++++----- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 28063bae0d..072cfcf959 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -93,7 +93,7 @@ HELP: run-process* { $notes "User code should call " { $link run-process } " instead." } ; HELP: >descriptor -{ $values { "obj" object } { "desc" "a launch descriptor" } } +{ $values { "desc" "a launch descriptor" } { "desc" "a launch descriptor" } } { $description "Creates a launch descriptor from an object, which must be one of the following:" { $list { "a string -- this is wrapped in a launch descriptor with a single " { $link +command+ } " key" } @@ -103,12 +103,12 @@ HELP: >descriptor } ; HELP: run-process -{ $values { "obj" object } { "process" process } } +{ $values { "desc" "a launch descriptor" } { "process" process } } { $description "Launches a process. The object can either be a string, a sequence of strings or a launch descriptor. See " { $link >descriptor } " for details." } { $notes "The output value can be passed to " { $link wait-for-process } " to get an exit code." } ; HELP: run-detached -{ $values { "obj" object } { "process" process } } +{ $values { "desc" "a launch descriptor" } { "process" process } } { $contract "Launches a process without waiting for it to complete. The object can either be a string, a sequence of strings or a launch descriptor. See " { $link >descriptor } " for details." } { $notes "This word is functionally identical to passing a launch descriptor to " { $link run-process } " having the " { $link +detached+ } " key set." @@ -127,12 +127,17 @@ HELP: process-stream { $class-description "A bidirectional stream for interacting with a running process. Instances are created by calling " { $link } ". The " { $link process-stream-process } " slot holds a " { $link process } " instance." } ; HELP: -{ $values { "obj" object } { "stream" "a bidirectional stream" } } +{ $values + { "desc" "a launch descriptor" } + { "stream" "a bidirectional stream" } } { $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream." } { $notes "Closing the stream will block until the process exits." } ; HELP: with-process-stream -{ $values { "obj" object } { "quot" quotation } { "process" process } } +{ $values + { "desc" "a launch descriptor" } + { "quot" quotation } + { "process" process } } { $description "Calls " { $snippet "quot" } " in a dynamic scope where " { $link stdio } " is rebound to a " { $link process-stream } ". When the quotation returns, the " { $link process } " instance is output." } ; HELP: wait-for-process diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 7cf9d51ed0..9fb24fb51a 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -63,7 +63,7 @@ SYMBOL: append-environment { replace-environment [ ] } } case ; -GENERIC: >descriptor ( obj -- desc ) +GENERIC: >descriptor ( desc -- desc ) M: string >descriptor +command+ associate ; M: sequence >descriptor +arguments+ associate ; @@ -76,24 +76,24 @@ HOOK: run-process* io-backend ( desc -- handle ) dup [ processes get at push stop ] curry callcc0 ] when process-status ; -: run-process ( obj -- process ) +: run-process ( desc -- process ) >descriptor dup run-process* +detached+ rot at [ dup wait-for-process drop ] unless ; -: run-detached ( obj -- process ) +: run-detached ( desc -- process ) >descriptor H{ { +detached+ t } } union run-process ; HOOK: process-stream* io-backend ( desc -- stream process ) TUPLE: process-stream process ; -: ( obj -- stream ) +: ( desc -- stream ) >descriptor process-stream* { set-delegate set-process-stream-process } process-stream construct ; -: with-process-stream ( obj quot -- process ) +: with-process-stream ( desc quot -- process ) swap [ swap with-stream ] keep process-stream-process ; inline From ce260a07aba18370485f2176823015d2e53dc107 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 31 Jan 2008 00:25:06 -0600 Subject: [PATCH 2/2] Add builder vocab --- extra/builder/builder.factor | 113 +++++++++++++++++++++++++++++++++++ 1 file changed, 113 insertions(+) create mode 100644 extra/builder/builder.factor diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor new file mode 100644 index 0000000000..a2b5dffb4d --- /dev/null +++ b/extra/builder/builder.factor @@ -0,0 +1,113 @@ + +USING: kernel io io.files io.launcher + system namespaces sequences splitting math.parser + unix prettyprint tools.time calendar bake vars ; + +IN: builder + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: datestamp ( -- string ) + now `{ ,[ dup timestamp-year ] + ,[ dup timestamp-month ] + ,[ dup timestamp-day ] + ,[ dup timestamp-hour ] + ,[ timestamp-minute ] } + [ number>string 2 CHAR: 0 pad-left ] map "-" join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: builder-recipients + +: quote ( str -- str ) "'" swap "'" 3append ; + +: email-file ( subject file -- ) + `{ + "cat" , + "| mutt -s" ,[ quote ] + "-x" %[ builder-recipients get ] + } + " " join system drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: boot-image ( -- filename ) `{ "boot" ,[ cpu ] "image" } "." join ; + +: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: stamp + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: build ( -- ) + +datestamp >stamp + +"/builds/factor" cd +"git pull git://factorcode.org/git/factor.git" system +0 = +[ ] +[ + "builder: git pull" "/dev/null" email-file + "builder: git pull" throw +] +if + +"/builds/" stamp> append make-directory +"/builds/" stamp> append cd +"git clone /builds/factor" system drop + +"factor" cd + +{ "/usr/bin/git" "show" } +[ readln ] with-stream +" " split second +"../git-id" [ print ] with-stream + +"make clean" system drop + +"make " target " > ../compile-log" 3append system +0 = +[ ] +[ + "builder: vm compile" "../compile-log" email-file + "builder: vm compile" throw +] if + +"wget http://factorcode.org/images/latest/" boot-image append system +0 = +[ ] +[ + "builder: image download" "/dev/null" email-file + "builder: image download" throw +] if + +[ "./factor -i=" boot-image " -no-user-init > ../boot-log" 3append system ] +benchmark nip +"../boot-time" [ . ] with-stream +0 = +[ ] +[ + "builder: bootstrap" "../boot-log" email-file + "builder: bootstrap" throw +] if + +[ + "./factor -e='USE: tools.browser load-everything' > ../load-everything-log" + system +] benchmark nip +"../load-everything-time" [ . ] with-stream +0 = +[ ] +[ + "builder: load-everything" "../load-everything-log" email-file + "builder: load-everything" throw +] if + +; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MAIN: build \ No newline at end of file