diff --git a/extra/builder/build/build.factor b/extra/builder/build/build.factor
new file mode 100644
index 0000000000..e9f58980ea
--- /dev/null
+++ b/extra/builder/build/build.factor
@@ -0,0 +1,46 @@
+
+USING: io.files io.launcher io.encodings.utf8 prettyprint
+ builder.util builder.common builder.child builder.release
+ builder.report builder.email builder.cleanup ;
+
+IN: builder.build
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: create-build-dir ( -- )
+ datestamp >stamp
+ build-dir make-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: enter-build-dir ( -- ) build-dir set-current-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: clone-builds-factor ( -- )
+ { "git" "clone" builds/factor } to-strings try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: record-id ( -- )
+ "factor"
+ [ git-id "../git-id" utf8 [ . ] with-file-writer ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: build ( -- )
+ reset-status
+ create-build-dir
+ enter-build-dir
+ clone-builds-factor
+ record-id
+ build-child
+ release
+ report
+ email-report
+ cleanup ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: build
\ No newline at end of file
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
index d81b934f2c..29daa8160b 100644
--- a/extra/builder/builder.factor
+++ b/extra/builder/builder.factor
@@ -1,259 +1,21 @@
-USING: kernel namespaces sequences splitting system combinators continuations
- parser io io.files io.launcher io.sockets prettyprint threads
- bootstrap.image benchmark vars bake smtp builder.util accessors
- debugger io.encodings.utf8
- calendar
- tools.test
+USING: kernel debugger io.files threads calendar
builder.common
- builder.benchmark
- builder.release ;
+ builder.updates
+ builder.build ;
IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: cd ( path -- ) set-current-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: builds/factor ( -- path ) builds "factor" append-path ;
-: build-dir ( -- path ) builds stamp> append-path ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: prepare-build-machine ( -- )
- builds make-directory
- builds
- [
- { "git" "clone" "git://factorcode.org/git/factor.git" } try-process
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: builds-check ( -- ) builds exists? not [ prepare-build-machine ] when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: enter-build-dir ( -- )
- datestamp >stamp
- builds cd
- stamp> make-directory
- stamp> cd ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: git-id ( -- id )
- { "git" "show" } utf8 <process-stream>
- [ readln ] with-stream " " split second ;
-
-: record-git-id ( -- ) git-id "../git-id" utf8 [ . ] with-file-writer ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: gnu-make ( -- string )
- os { freebsd openbsd netbsd } member?
- [ "gmake" ]
- [ "make" ]
- if ;
-
-: do-make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: make-vm ( -- desc )
- <process>
- { gnu-make } to-strings >>command
- "../compile-log" >>stdout
- +stdout+ >>stderr ;
-
-: do-make-vm ( -- )
- make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: copy-image ( -- )
- builds/factor my-boot-image-name append-path ".." copy-file-into
- builds/factor my-boot-image-name append-path "." copy-file-into ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: bootstrap-cmd ( -- cmd )
- { "./factor" { "-i=" my-boot-image-name } "-no-user-init" } to-strings ;
-
-: bootstrap ( -- desc )
- <process>
- bootstrap-cmd >>command
- +closed+ >>stdin
- "../boot-log" >>stdout
- +stdout+ >>stderr
- 60 minutes >>timeout ;
-
-: do-bootstrap ( -- )
- bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail ;
-
-: builder-test-cmd ( -- cmd )
- { "./factor" "-run=builder.test" } to-strings ;
-
-: builder-test ( -- desc )
- <process>
- builder-test-cmd >>command
- +closed+ >>stdin
- "../test-log" >>stdout
- +stdout+ >>stderr
- 240 minutes >>timeout ;
-
-: do-builder-test ( -- )
- builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: build-status
-
-: (build) ( -- )
-
- builds-check
-
- build-status off
-
- enter-build-dir
-
- "report" utf8
- [
- "Build machine: " write host-name print
- "CPU: " write cpu .
- "OS: " write os .
- "Build directory: " write current-directory get print
-
- git-clone [ "git clone failed" print ] run-or-bail
-
- "factor"
- [
- record-git-id
- do-make-clean
- do-make-vm
- copy-image
- do-bootstrap
- do-builder-test
- ]
- with-directory
-
- "test-log" delete-file
-
- "git id: " write "git-id" eval-file print nl
-
- "Boot time: " write "boot-time" eval-file milli-seconds>time print
- "Load time: " write "load-time" eval-file milli-seconds>time print
- "Test time: " write "test-time" eval-file milli-seconds>time print nl
-
- "Did not pass load-everything: " print "load-everything-vocabs" cat
-
- "Did not pass test-all: " print "test-all-vocabs" cat
- "test-failures" cat
-
- "help-lint results:" print "help-lint" cat
-
- "Benchmarks: " print "benchmarks" eval-file benchmarks.
-
- nl
-
- show-benchmark-deltas
-
- "benchmarks" ".." copy-file-into
-
- release
- ]
- with-file-writer
-
- build-status on ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: builder-from
-
-SYMBOL: builder-recipients
-
-: tag-subject ( str -- str ) { "builder@" host-name* ": " , } bake to-string ;
-
-: subject ( -- str ) build-status get [ "report" ] [ "error" ] if tag-subject ;
-
-: send-builder-email ( -- )
- <email>
- builder-from get >>from
- builder-recipients get >>to
- subject >>subject
- "./report" file>string >>body
- send-email ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: compress-image ( -- ) { "bzip2" my-boot-image-name } to-strings try-process ;
-
-! : build ( -- )
-! [ (build) ] try
-! builds cd stamp> cd
-! [ send-builder-email ] try
-! { "rm" "-rf" "factor" } [ ] run-or-bail
-! [ compress-image ] try ;
-
-: build ( -- )
- [
- (build)
- build-dir
- [
- { "rm" "-rf" "factor" } try-process
- compress-image
- ]
- with-directory
- ]
- try
- send-builder-email ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USE: bootstrap.image.download
-
-: git-pull ( -- desc )
- {
- "git"
- "pull"
- "--no-summary"
- "git://factorcode.org/git/factor.git"
- "master"
- } ;
-
-: updates-available? ( -- ? )
- git-id
- git-pull try-process
- git-id
- = not ;
-
-: new-image-available? ( -- ? )
- my-boot-image-name need-new-image?
- [ download-my-image t ]
- [ f ]
- if ;
-
: build-loop ( -- )
builds-check
[
- builds/factor
- [
- updates-available? new-image-available? or
- [ build ]
- when
- ]
- with-directory
+ builds/factor set-current-directory
+ new-code-available? [ build ] when
]
try
5 minutes sleep
build-loop ;
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: build-loop
+MAIN: build-loop
\ No newline at end of file
diff --git a/extra/builder/child/child.factor b/extra/builder/child/child.factor
new file mode 100644
index 0000000000..a63ae88f7f
--- /dev/null
+++ b/extra/builder/child/child.factor
@@ -0,0 +1,70 @@
+
+USING: namespaces debugger io.files io.launcher accessors bootstrap.image
+ calendar builder.util builder.common ;
+
+IN: builder.child
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: make-vm ( -- )
+ <process>
+ gnu-make >>command
+ "../compile-log" >>stdout
+ +stdout+ >>stderr
+ try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: builds-factor-image ( -- img ) builds/factor my-boot-image-name append-path ;
+
+: copy-image ( -- )
+ builds-factor-image ".." copy-file-into
+ builds-factor-image "." copy-file-into ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: boot-cmd ( -- cmd )
+ { "./factor" { "-i=" my-boot-image-name } "-no-user-init" } to-strings ;
+
+: boot ( -- )
+ <process>
+ boot-cmd >>command
+ +closed+ >>stdin
+ "../boot-log" >>stdout
+ +stdout+ >>stderr
+ 60 minutes >>timeout
+ try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: test-cmd ( -- cmd ) { "./factor" "-run=builder.test" } ;
+
+: test ( -- )
+ <process>
+ test-cmd >>command
+ +closed+ >>stdin
+ "../test-log" >>stdout
+ +stdout+ >>stderr
+ 240 minutes >>timeout
+ try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (build-child) ( -- )
+ make-clean
+ make-vm status-vm on
+ copy-image
+ boot status-boot on
+ test status-test on
+ status on ;
+
+! : build-child ( -- ) "factor" [ (build-child) ] with-directory ;
+
+: build-child ( -- )
+ "factor" set-current-directory
+ [ (build-child) ] try
+ ".." set-current-directory ;
diff --git a/extra/builder/cleanup/cleanup.factor b/extra/builder/cleanup/cleanup.factor
new file mode 100644
index 0000000000..327b90e01f
--- /dev/null
+++ b/extra/builder/cleanup/cleanup.factor
@@ -0,0 +1,24 @@
+
+USING: kernel namespaces io.files io.launcher bootstrap.image
+ builder.util builder.common ;
+
+IN: builder.cleanup
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: builder-debug
+
+: compress-image ( -- ) { "bzip2" my-boot-image-name } to-strings try-process ;
+
+: delete-child-factor ( -- )
+ build-dir [ { "rm" "-rf" "factor" } try-process ] with-directory ;
+
+: cleanup ( -- )
+ builder-debug get f =
+ [
+ "test-log" delete-file
+ delete-child-factor
+ compress-image
+ ]
+ when ;
+
diff --git a/extra/builder/common/common.factor b/extra/builder/common/common.factor
index 2fe2aa06ab..e3c207eaaa 100644
--- a/extra/builder/common/common.factor
+++ b/extra/builder/common/common.factor
@@ -1,5 +1,7 @@
-USING: kernel namespaces io.files sequences vars ;
+USING: kernel namespaces sequences splitting
+ io io.files io.launcher io.encodings.utf8 prettyprint
+ vars builder.util ;
IN: builder.common
@@ -16,4 +18,47 @@ SYMBOL: builds-dir
VAR: stamp
-SYMBOL: upload-to-factorcode
\ No newline at end of file
+: builds/factor ( -- path ) builds "factor" append-path ;
+: build-dir ( -- path ) builds stamp> append-path ;
+
+: create-build-dir ( -- )
+ datestamp >stamp
+ build-dir make-directory ;
+
+: enter-build-dir ( -- ) build-dir set-current-directory ;
+
+: clone-builds-factor ( -- )
+ { "git" "clone" builds/factor } to-strings try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: prepare-build-machine ( -- )
+ builds make-directory
+ builds
+ [ { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: builds-check ( -- ) builds exists? not [ prepare-build-machine ] when ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: status-vm
+SYMBOL: status-boot
+SYMBOL: status-test
+SYMBOL: status-build
+SYMBOL: status-release
+SYMBOL: status
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: reset-status ( -- )
+ { status-vm status-boot status-test status-build status-release status }
+ [ off ]
+ each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: upload-to-factorcode
+
diff --git a/extra/builder/email/email.factor b/extra/builder/email/email.factor
new file mode 100644
index 0000000000..eed48cb177
--- /dev/null
+++ b/extra/builder/email/email.factor
@@ -0,0 +1,22 @@
+
+USING: kernel namespaces accessors smtp builder.util builder.common ;
+
+IN: builder.email
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: builder-from
+SYMBOL: builder-recipients
+
+: subject-status ( -- str ) status get [ "report" ] [ "error" ] if ;
+
+: subject ( -- str ) { "builder@" host-name* ": " subject-status } to-string ;
+
+: email-report ( -- )
+ <email>
+ builder-from get >>from
+ builder-recipients get >>to
+ subject >>subject
+ "report" file>string >>body
+ send-email ;
+
diff --git a/extra/builder/release/branch/branch.factor b/extra/builder/release/branch/branch.factor
index 838a74394b..6218a2ea90 100644
--- a/extra/builder/release/branch/branch.factor
+++ b/extra/builder/release/branch/branch.factor
@@ -36,5 +36,5 @@ IN: builder.release.branch
: update-clean-branch ( -- )
upload-to-factorcode get
- [ update-clean-branch ]
+ [ (update-clean-branch) ]
when ;
diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor
index 33e5edfbf9..8f4c0e30f5 100644
--- a/extra/builder/release/release.factor
+++ b/extra/builder/release/release.factor
@@ -1,5 +1,5 @@
-USING: kernel system namespaces sequences splitting combinators
+USING: kernel debugger system namespaces sequences splitting combinators
io io.files io.launcher prettyprint bootstrap.image
bake combinators.cleave
builder.util
@@ -18,9 +18,10 @@ IN: builder.release
tidy
make-archive
upload
- save-archive ;
+ save-archive
+ status-release on ;
: clean-build? ( -- ? )
{ "load-everything-vocabs" "test-all-vocabs" } [ eval-file empty? ] all? ;
-: release ( -- ) clean-build? [ (release) ] when ;
\ No newline at end of file
+: release ( -- ) [ clean-build? [ (release) ] when ] try ;
\ No newline at end of file
diff --git a/extra/builder/report/report.factor b/extra/builder/report/report.factor
new file mode 100644
index 0000000000..101d259f7c
--- /dev/null
+++ b/extra/builder/report/report.factor
@@ -0,0 +1,35 @@
+
+USING: kernel namespaces debugger system io io.files io.sockets
+ io.encodings.utf8 prettyprint benchmark
+ builder.util builder.common ;
+
+IN: builder.report
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (report) ( -- )
+
+ "Build machine: " write host-name print
+ "CPU: " write cpu .
+ "OS: " write os .
+ "Build directory: " write build-dir print
+ "git id: " write "git-id" eval-file print nl
+
+ status-vm get f = [ "compile-log" cat "vm compile error" throw ] when
+ status-boot get f = [ "boot-log" cat "Boot error" throw ] when
+ status-test get f = [ "test-log" 100 cat-n "Test error" throw ] when
+
+ "Boot time: " write "boot-time" eval-file milli-seconds>time print
+ "Load time: " write "load-time" eval-file milli-seconds>time print
+ "Test time: " write "test-time" eval-file milli-seconds>time print nl
+
+ "Did not pass load-everything: " print "load-everything-vocabs" cat
+
+ "Did not pass test-all: " print "test-all-vocabs" cat
+ "test-failures" cat
+
+ "help-lint results:" print "help-lint" cat
+
+ "Benchmarks: " print "benchmarks" eval-file benchmarks. ;
+
+: report ( -- ) "report" utf8 [ [ (report) ] try ] with-file-writer ;
\ No newline at end of file
diff --git a/extra/builder/updates/updates.factor b/extra/builder/updates/updates.factor
new file mode 100644
index 0000000000..a8184550e0
--- /dev/null
+++ b/extra/builder/updates/updates.factor
@@ -0,0 +1,31 @@
+
+USING: kernel io.launcher bootstrap.image bootstrap.image.download
+ builder.util builder.common ;
+
+IN: builder.updates
+
+: git-pull-cmd ( -- cmd )
+ {
+ "git"
+ "pull"
+ "--no-summary"
+ "git://factorcode.org/git/factor.git"
+ "master"
+ } ;
+
+: updates-available? ( -- ? )
+ git-id
+ git-pull-cmd try-process
+ git-id
+ = not ;
+
+: new-image-available? ( -- ? )
+ my-boot-image-name need-new-image?
+ [ download-my-image t ]
+ [ f ]
+ if ;
+
+: new-code-available? ( -- ? )
+ updates-available?
+ new-image-available?
+ or ;
\ No newline at end of file
diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor
index e80d83e24c..3b0834b190 100644
--- a/extra/builder/util/util.factor
+++ b/extra/builder/util/util.factor
@@ -25,11 +25,11 @@ DEFER: to-strings
: to-string ( obj -- str )
dup class
{
- { string [ ] }
- { quotation [ call ] }
- { word [ execute ] }
- { fixnum [ number>string ] }
- { array [ to-strings concat ] }
+ { \ string [ ] }
+ { \ quotation [ call ] }
+ { \ word [ execute ] }
+ { \ fixnum [ number>string ] }
+ { \ array [ to-strings concat ] }
}
case ;
@@ -97,4 +97,15 @@ USE: prettyprint
: cpu- ( -- cpu ) cpu unparse "." split "-" join ;
-: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
\ No newline at end of file
+: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gnu-make ( -- string )
+ os { freebsd openbsd netbsd } member? [ "gmake" ] [ "make" ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: git-id ( -- id )
+ { "git" "show" } utf8 <process-stream> [ readln ] with-stream
+ " " split second ;