+++ /dev/null
-
-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
+++ /dev/null
-
-USING: kernel debugger io.files threads calendar
- builder.common
- builder.updates
- builder.build ;
-
-IN: builder
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: build-loop ( -- )
- builds-check
- [
- builds/factor set-current-directory
- new-code-available? [ build ] when
- ]
- try
- 5 minutes sleep
- build-loop ;
-
-MAIN: build-loop
\ No newline at end of file
+++ /dev/null
-
-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" set-current-directory
- [ (build-child) ] try
- ".." set-current-directory ;
\ No newline at end of file
+++ /dev/null
-
-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 ;
-
+++ /dev/null
-
-USING: kernel namespaces sequences splitting
- io io.files io.launcher io.encodings.utf8 prettyprint
- vars builder.util ;
-
-IN: builder.common
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: upload-to-factorcode
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: builds-dir
-
-: builds ( -- path )
- builds-dir get
- home "/builds" append
- or ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: stamp
-
-: 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 ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-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 ;
+++ /dev/null
-
-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 ;
-
+++ /dev/null
-
-USING: kernel combinators system sequences io.files io.launcher prettyprint
- builder.util
- builder.common ;
-
-IN: builder.release.archive
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: base-name ( -- string )
- { "factor" [ os unparse ] cpu- stamp> } to-strings "-" join ;
-
-: extension ( -- extension )
- {
- { [ os winnt? ] [ ".zip" ] }
- { [ os macosx? ] [ ".dmg" ] }
- { [ os unix? ] [ ".tar.gz" ] }
- }
- cond ;
-
-: archive-name ( -- string ) base-name extension append ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: windows-archive-cmd ( -- cmd ) { "zip" "-r" archive-name "factor" } ;
-
-! : macosx-archive-cmd ( -- cmd )
-! { "hdiutil" "create"
-! "-srcfolder" "factor"
-! "-fs" "HFS+"
-! "-volname" "factor"
-! archive-name } ;
-
-: macosx-archive-cmd ( -- cmd )
- { "mkdir" "dmg-root" } try-process
- { "cp" "-r" "factor" "dmg-root" } try-process
- { "hdiutil" "create"
- "-srcfolder" "dmg-root"
- "-fs" "HFS+"
- "-volname" "factor"
- archive-name } to-strings try-process
- { "rm" "-rf" "dmg-root" } try-process
- { "true" } ;
-
-: unix-archive-cmd ( -- cmd ) { "tar" "-cvzf" archive-name "factor" } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: archive-cmd ( -- cmd )
- {
- { [ os windows? ] [ windows-archive-cmd ] }
- { [ os macosx? ] [ macosx-archive-cmd ] }
- { [ os unix? ] [ unix-archive-cmd ] }
- }
- cond ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: make-archive ( -- ) archive-cmd to-strings try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: releases ( -- path )
- builds "releases" append-path
- dup exists? not
- [ dup make-directory ]
- when ;
-
-: save-archive ( -- ) archive-name releases move-file-into ;
\ No newline at end of file
+++ /dev/null
-
-USING: kernel system namespaces sequences prettyprint io.files io.launcher
- bootstrap.image
- builder.util
- builder.common ;
-
-IN: builder.release.branch
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: branch-name ( -- string ) "clean-" platform append ;
-
-: refspec ( -- string ) "master:" branch-name append ;
-
-: push-to-clean-branch ( -- )
- { "git" "push" "factorcode.org:/git/factor.git" refspec }
- to-strings
- try-process ;
-
-: upload-clean-image ( -- )
- {
- "scp"
- my-boot-image-name
- { "factorcode.org:/var/www/factorcode.org/newsite/images/clean/" platform }
- }
- to-strings
- try-process ;
-
-: (update-clean-branch) ( -- )
- "factor"
- [
- push-to-clean-branch
- upload-clean-image
- ]
- with-directory ;
-
-: update-clean-branch ( -- )
- upload-to-factorcode get
- [ (update-clean-branch) ]
- when ;
+++ /dev/null
-
-USING: kernel debugger system namespaces sequences splitting combinators
- io io.files io.launcher prettyprint bootstrap.image
- combinators.cleave
- builder.util
- builder.common
- builder.release.branch
- builder.release.tidy
- builder.release.archive
- builder.release.upload ;
-
-IN: builder.release
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: (release) ( -- )
- update-clean-branch
- tidy
- make-archive
- upload
- save-archive
- status-release on ;
-
-: clean-build? ( -- ? )
- { "load-everything-vocabs" "test-all-vocabs" } [ eval-file empty? ] all? ;
-
-: release ( -- ) [ clean-build? [ (release) ] when ] try ;
\ No newline at end of file
+++ /dev/null
-
-USING: kernel system io.files io.launcher builder.util ;
-
-IN: builder.release.tidy
-
-: common-files ( -- seq )
- {
- "boot.x86.32.image"
- "boot.x86.64.image"
- "boot.macosx-ppc.image"
- "boot.linux-ppc.image"
- "vm"
- "temp"
- "logs"
- ".git"
- ".gitignore"
- "Makefile"
- "unmaintained"
- "build-support"
- } ;
-
-: remove-common-files ( -- )
- { "rm" "-rf" common-files } to-strings try-process ;
-
-: remove-factor-app ( -- )
- os macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ;
-
-: tidy ( -- )
- "factor" [ remove-factor-app remove-common-files ] with-directory ;
+++ /dev/null
-
-USING: kernel namespaces make sequences arrays io io.files
- builder.util
- builder.common
- builder.release.archive ;
-
-IN: builder.release.upload
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: upload-host
-
-SYMBOL: upload-username
-
-SYMBOL: upload-directory
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: remote-location ( -- dest )
- upload-directory get platform append ;
-
-: remote-archive-name ( -- dest )
- remote-location "/" archive-name 3append ;
-
-: temp-archive-name ( -- dest )
- remote-archive-name ".incomplete" append ;
-
-: upload-command ( -- args )
- "scp"
- archive-name
- [ upload-username get % "@" % upload-host get % ":" % temp-archive-name % ] "" make
- 3array ;
-
-: rename-command ( -- args )
- [
- "ssh" ,
- upload-host get ,
- "-l" ,
- upload-username get ,
- "mv" ,
- temp-archive-name ,
- remote-archive-name ,
- ] { } make ;
-
-: upload-temp-file ( -- )
- upload-command [ "Error uploading binary to factorcode" print ] run-or-bail ;
-
-: rename-temp-file ( -- )
- rename-command [ "Error renaming binary on factorcode" print ] run-or-bail ;
-
-: upload ( -- )
- upload-to-factorcode get
- [ upload-temp-file rename-temp-file ]
- when ;
+++ /dev/null
-
-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" 100 cat-n "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
+++ /dev/null
-
-USING: kernel namespaces assocs
- io.files io.encodings.utf8 prettyprint
- help.lint
- benchmark
- tools.time
- bootstrap.stage2
- tools.test tools.vocabs
- builder.util ;
-
-IN: builder.test
-
-: do-load ( -- )
- try-everything keys "../load-everything-vocabs" utf8 [ . ] with-file-writer ;
-
-: do-tests ( -- )
- run-all-tests
- [ keys "../test-all-vocabs" utf8 [ . ] with-file-writer ]
- [ "../test-failures" utf8 [ test-failures. ] with-file-writer ]
- bi ;
-
-: do-help-lint ( -- )
- "" run-help-lint "../help-lint" utf8 [ typos. ] with-file-writer ;
-
-: do-benchmarks ( -- )
- run-benchmarks "../benchmarks" utf8 [ . ] with-file-writer ;
-
-: do-all ( -- )
- bootstrap-time get "../boot-time" utf8 [ . ] with-file-writer
- [ do-load ] benchmark "../load-time" utf8 [ . ] with-file-writer
- [ do-tests ] benchmark "../test-time" utf8 [ . ] with-file-writer
- do-help-lint
- do-benchmarks ;
-
-MAIN: do-all
\ No newline at end of file
+++ /dev/null
-
-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
+++ /dev/null
-
-USING: kernel words namespaces classes parser continuations
- io io.files io.launcher io.sockets
- math math.parser
- system
- combinators sequences splitting quotations arrays strings tools.time
- sequences.deep accessors assocs.lib
- io.encodings.utf8
- combinators.cleave calendar calendar.format eval ;
-
-IN: builder.util
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: minutes>ms ( min -- ms ) 60 * 1000 * ;
-
-: file>string ( file -- string ) utf8 file-contents ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-DEFER: to-strings
-
-: to-string ( obj -- str )
- dup class
- {
- { \ string [ ] }
- { \ quotation [ call ] }
- { \ word [ execute ] }
- { \ fixnum [ number>string ] }
- { \ array [ to-strings concat ] }
- }
- case ;
-
-: to-strings ( seq -- str )
- dup [ string? ] all?
- [ ]
- [ [ to-string ] map flatten ]
- if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: host-name* ( -- name ) host-name "." split first ;
-
-: datestamp ( -- string )
- now
- { year>> month>> day>> hour>> minute>> } <arr>
- [ pad-00 ] map "-" join ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: milli-seconds>time ( n -- string )
- 1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
-
-: eval-file ( file -- obj ) utf8 file-contents eval ;
-
-: cat ( file -- ) utf8 file-contents print ;
-
-: run-or-bail ( desc quot -- )
- [ [ try-process ] curry ]
- [ [ throw ] compose ]
- bi*
- recover ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: bootstrap.image bootstrap.image.download io.streams.null ;
-
-: retrieve-image ( -- ) [ my-arch download-image ] with-null-stream ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: longer? ( seq seq -- ? ) [ length ] bi@ > ;
-
-: maybe-tail* ( seq n -- seq )
- 2dup longer?
- [ tail* ]
- [ drop ]
- if ;
-
-: cat-n ( file n -- )
- [ utf8 file-lines ] [ ] bi*
- maybe-tail*
- [ print ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USE: prettyprint
-
-: to-file ( object file -- ) utf8 [ . ] with-file-writer ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: cpu- ( -- cpu ) cpu unparse "." split "-" join ;
-
-: 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-reader> [ readln ] with-input-stream
- " " split second ;
projects / factor.git / commitdiff