builder: minor cleanups
Eduardo Cavazos
parent
336ad674d7
commit
47566fbfac
|
|
@ -11,21 +11,6 @@ IN: builder
|
||||||
|
|
||||||
: runtime ( quot -- time ) benchmark nip ;
|
: runtime ( quot -- time ) benchmark nip ;
|
||||||
|
|
||||||
! : log-runtime ( quot file -- )
|
|
||||||
! >r runtime r> <file-writer> [ . ] with-stream ;
|
|
||||||
|
|
||||||
! : log-object ( object file -- ) <file-writer> [ . ] with-stream ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: datestamp ( -- string )
|
|
||||||
now `{ ,[ dup timestamp-year ]
|
|
||||||
,[ dup timestamp-month ]
|
|
||||||
,[ dup timestamp-day ]
|
|
||||||
,[ dup timestamp-hour ]
|
|
||||||
,[ timestamp-minute ] }
|
|
||||||
[ pad-00 ] map "-" join ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
SYMBOL: builder-recipients
|
SYMBOL: builder-recipients
|
||||||
|
|
@ -48,23 +33,8 @@ SYMBOL: builder-recipients
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! : run-or-notify ( desc message -- )
|
|
||||||
! [ [ try-process ] curry ]
|
|
||||||
! [ [ email-string throw ] curry ]
|
|
||||||
! bi*
|
|
||||||
! recover ;
|
|
||||||
|
|
||||||
! : run-or-send-file ( desc message file -- )
|
|
||||||
! >r >r [ try-process ] curry
|
|
||||||
! r> r> [ email-file throw ] 2curry
|
|
||||||
! recover ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: factor-binary ( -- name )
|
: factor-binary ( -- name )
|
||||||
os
|
os
|
||||||
{ { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
|
{ { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
|
||||||
|
|
@ -72,12 +42,6 @@ SYMBOL: builder-recipients
|
||||||
[ drop "./factor" ] }
|
[ drop "./factor" ] }
|
||||||
case ;
|
case ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
VAR: stamp
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: git-pull ( -- desc )
|
: git-pull ( -- desc )
|
||||||
{
|
{
|
||||||
"git"
|
"git"
|
||||||
|
|
@ -89,17 +53,29 @@ VAR: stamp
|
||||||
|
|
||||||
: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
|
: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: datestamp ( -- string )
|
||||||
|
now `{ ,[ dup timestamp-year ]
|
||||||
|
,[ dup timestamp-month ]
|
||||||
|
,[ dup timestamp-day ]
|
||||||
|
,[ dup timestamp-hour ]
|
||||||
|
,[ timestamp-minute ] }
|
||||||
|
[ pad-00 ] map "-" join ;
|
||||||
|
|
||||||
|
VAR: stamp
|
||||||
|
|
||||||
: enter-build-dir ( -- )
|
: enter-build-dir ( -- )
|
||||||
datestamp >stamp
|
datestamp >stamp
|
||||||
"/builds" cd
|
"/builds" cd
|
||||||
stamp> make-directory
|
stamp> make-directory
|
||||||
stamp> cd ;
|
stamp> cd ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: git-id ( -- id )
|
: git-id ( -- id )
|
||||||
{ "git" "show" } <process-stream> [ readln ] with-stream " " split second ;
|
{ "git" "show" } <process-stream> [ readln ] with-stream " " split second ;
|
||||||
|
|
||||||
! : record-git-id ( -- ) git-id "../git-id" log-object ;
|
|
||||||
|
|
||||||
: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ;
|
: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ;
|
||||||
|
|
||||||
: make-clean ( -- desc ) { "make" "clean" } ;
|
: make-clean ( -- desc ) { "make" "clean" } ;
|
||||||
|
|
@ -112,13 +88,6 @@ VAR: stamp
|
||||||
}
|
}
|
||||||
>hashtable ;
|
>hashtable ;
|
||||||
|
|
||||||
! : retrieve-boot-image ( -- )
|
|
||||||
! [ my-arch download-image ]
|
|
||||||
! [ ]
|
|
||||||
! [ "builder: image download" email-string ]
|
|
||||||
! cleanup
|
|
||||||
! flush ;
|
|
||||||
|
|
||||||
: bootstrap ( -- desc )
|
: bootstrap ( -- desc )
|
||||||
`{
|
`{
|
||||||
{ +arguments+ {
|
{ +arguments+ {
|
||||||
|
|
@ -133,78 +102,10 @@ VAR: stamp
|
||||||
|
|
||||||
: builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
|
: builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
SYMBOL: build-status
|
SYMBOL: build-status
|
||||||
|
|
||||||
! : build ( -- )
|
|
||||||
|
|
||||||
! enter-build-dir
|
|
||||||
|
|
||||||
! git-clone "git clone error" run-or-notify
|
|
||||||
|
|
||||||
! "factor" cd
|
|
||||||
|
|
||||||
! record-git-id
|
|
||||||
|
|
||||||
! make-clean "make clean error" run-or-notify
|
|
||||||
|
|
||||||
! make-vm "vm compile error" "../compile-log" run-or-send-file
|
|
||||||
|
|
||||||
! retrieve-boot-image
|
|
||||||
|
|
||||||
! bootstrap "bootstrap error" "../boot-log" run-or-send-file
|
|
||||||
|
|
||||||
! builder-test "builder.test fatal error" run-or-notify
|
|
||||||
|
|
||||||
! "../load-everything-log" exists?
|
|
||||||
! [ "load-everything" "../load-everything-log" email-file ]
|
|
||||||
! when
|
|
||||||
|
|
||||||
! "../failing-tests" exists?
|
|
||||||
! [ "failing tests" "../failing-tests" email-file ]
|
|
||||||
! when ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! SYMBOL: report
|
|
||||||
|
|
||||||
! : >>>report ( quot -- ) report get swap with-stream* ;
|
|
||||||
|
|
||||||
! : file>>>report ( file -- ) [ <file-reader> contents write ] curry >>>report ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
! : run-or-report ( desc quot -- )
|
|
||||||
! [ [ try-process ] curry ]
|
|
||||||
! [ [ >>>report throw ] curry ]
|
|
||||||
! bi*
|
|
||||||
! recover ;
|
|
||||||
|
|
||||||
! : run-or-report-file ( desc quot file -- )
|
|
||||||
! [ [ try-process ] curry ]
|
|
||||||
! [ [ >>>report ] curry ]
|
|
||||||
! [ [ file>>>report throw ] curry ]
|
|
||||||
! tri*
|
|
||||||
! compose
|
|
||||||
! recover ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
! : ms>minutes ( ms -- minutes ) 1000.0 / 60 / ;
|
|
||||||
|
|
||||||
! : bootstrap-minutes ( -- )
|
|
||||||
! "../bootstrap-time" <file-reader> contents eval ms>minutes unparse ;
|
|
||||||
|
|
||||||
! : min-and-sec ( milliseconds -- str )
|
|
||||||
! 1000 /i 60 /mod swap
|
|
||||||
! `{ ,[ number>string ] " minutes and " ,[ number>string ] " seconds" }
|
|
||||||
! concat ;
|
|
||||||
|
|
||||||
! : boot-time ( -- string ) "../bootstrap-time" eval-file min-and-sec ;
|
|
||||||
! : load-time ( -- string ) "../load-everything-time" eval-file min-and-sec ;
|
|
||||||
! : test-time ( -- string ) "../test-all-time" eval-file min-and-sec ;
|
|
||||||
|
|
||||||
: milli-seconds>time ( n -- string )
|
: milli-seconds>time ( n -- string )
|
||||||
1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
|
1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
|
||||||
|
|
||||||
|
|
@ -212,60 +113,6 @@ SYMBOL: build-status
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! : (build) ( -- )
|
|
||||||
|
|
||||||
! enter-build-dir
|
|
||||||
|
|
||||||
! "report" <file-writer> report set
|
|
||||||
|
|
||||||
! [
|
|
||||||
! "Build machine: " write host-name write nl
|
|
||||||
! "Build directory: " write cwd write nl
|
|
||||||
! ] >>>report
|
|
||||||
|
|
||||||
! git-clone [ "Builder fatal error: git clone failed" write nl ] run-or-report
|
|
||||||
|
|
||||||
! "factor" cd
|
|
||||||
|
|
||||||
! record-git-id
|
|
||||||
|
|
||||||
! make-clean run-process drop
|
|
||||||
|
|
||||||
! make-vm
|
|
||||||
! [ "Builder fatal error: vm compile error" write nl ]
|
|
||||||
! "../compile-log"
|
|
||||||
! run-or-report-file
|
|
||||||
|
|
||||||
! [ my-arch download-image ]
|
|
||||||
! [ [ "Builder fatal error: image download" write nl ] >>>report throw ]
|
|
||||||
! recover
|
|
||||||
|
|
||||||
! bootstrap [ "Bootstrap error" write nl ] "../boot-log" run-or-report-file
|
|
||||||
|
|
||||||
! builder-test [ "Builder test error" write nl ] run-or-report
|
|
||||||
|
|
||||||
! [
|
|
||||||
! "Bootstrap time: " write boot-time write nl
|
|
||||||
! "Load all time: " write load-time write nl
|
|
||||||
! "Test all time: " write test-time write nl
|
|
||||||
! ] >>>report
|
|
||||||
|
|
||||||
! "../load-everything-vocabs" exists?
|
|
||||||
! [
|
|
||||||
! [ "Did not pass load-everything: " write nl ] >>>report
|
|
||||||
! "../load-everything-vocabs" file>>>report
|
|
||||||
! ]
|
|
||||||
! when
|
|
||||||
|
|
||||||
! "../test-all-vocabs" exists?
|
|
||||||
! [
|
|
||||||
! [ "Did not pass test-all: " write nl ] >>>report
|
|
||||||
! "../test-all-vocabs" file>>>report
|
|
||||||
! ]
|
|
||||||
! when ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: cat ( file -- ) <file-reader> contents print ;
|
: cat ( file -- ) <file-reader> contents print ;
|
||||||
|
|
||||||
: run-or-bail ( desc quot -- )
|
: run-or-bail ( desc quot -- )
|
||||||
|
|
@ -318,18 +165,6 @@ SYMBOL: build-status
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! : send-report ( -- )
|
|
||||||
! report get dispose
|
|
||||||
! "report" "../report" email-file ;
|
|
||||||
|
|
||||||
! : build ( -- )
|
|
||||||
! [ (build) ]
|
|
||||||
! [ drop ]
|
|
||||||
! recover
|
|
||||||
! send-report ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: minutes>ms ( min -- ms ) 60 * 1000 * ;
|
: minutes>ms ( min -- ms ) 60 * 1000 * ;
|
||||||
|
|
||||||
: updates-available? ( -- ? )
|
: updates-available? ( -- ? )
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue