steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

builder: bit refactoring

db4
Eduardo Cavazos 2008-02-14 00:43:50 -06:00
parent 2f5ad0324b
commit eca7c0b739
2 changed files with 112 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
extra/builder/builder.factor
View File

@ -3,39 +3,19 @@ USING: kernel parser io io.files io.launcher io.sockets hashtables math threads
arrays system continuations namespaces sequences splitting math.parser arrays system continuations namespaces sequences splitting math.parser
prettyprint tools.time calendar bake vars http.client prettyprint tools.time calendar bake vars http.client
combinators bootstrap.image bootstrap.image.download combinators bootstrap.image bootstrap.image.download
combinators.cleave benchmark ; combinators.cleave benchmark
classes strings quotations words parser-combinators new-slots accessors
assocs.lib smtp builder.util ;
IN: builder IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: runtime ( quot -- time ) benchmark nip ;
: minutes>ms ( min -- ms ) 60 * 1000 * ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: builder-recipients SYMBOL: builder-recipients
: host-name* ( -- name ) host-name "." split first ; : tag-subject ( str -- str ) { "builder@" host-name* ": " , } bake to-string ;
: tag-subject ( str -- str ) `{ "builder@" ,[ host-name* ] ": " , } concat ; : target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ;
: email-string ( subject -- )
`{ "mutt" "-s" ,[ tag-subject ] %[ builder-recipients get ] }
[ ] with-process-stream drop ;
: email-file ( subject file -- )
`{
{ +stdin+ , }
{ +arguments+
{ "mutt" "-s" ,[ tag-subject ] %[ builder-recipients get ] } }
}
>hashtable run-process drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
: factor-binary ( -- name ) : factor-binary ( -- name )
os os
@ -57,14 +37,6 @@ SYMBOL: builder-recipients
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: datestamp ( -- string )
now `{ ,[ dup timestamp-year ]
,[ dup timestamp-month ]
,[ dup timestamp-day ]
,[ dup timestamp-hour ]
,[ timestamp-minute ] }
[ pad-00 ] map "-" join ;
VAR: stamp VAR: stamp
: enter-build-dir ( -- ) : enter-build-dir ( -- )
@ -82,49 +54,31 @@ VAR: stamp
: make-clean ( -- desc ) { "make" "clean" } ; : make-clean ( -- desc ) { "make" "clean" } ;
: make-vm ( -- ) : make-vm ( -- desc )
`{ <process*>
{ +arguments+ { "make" ,[ target ] } } { "make" target } to-strings >>arguments
{ +stdout+ "../compile-log" } "../compile-log" >>stdout
{ +stderr+ +stdout+ } +stdout+ >>stderr
} >desc ;
>hashtable ;
: bootstrap-cmd ( -- cmd )
{ factor-binary [ "-i=" my-boot-image-name append ] "-no-user-init" }
to-strings ;
: bootstrap ( -- desc ) : bootstrap ( -- desc )
`{ <process*>
{ +arguments+ { bootstrap-cmd >>arguments
,[ factor-binary ] "../boot-log" >>stdout
,[ "-i=" my-boot-image-name append ] +stdout+ >>stderr
"-no-user-init" 20 minutes>ms >>timeout
} } >desc ;
{ +stdout+ "../boot-log" }
{ +stderr+ +stdout+ }
{ +timeout+ ,[ 20 minutes>ms ] }
} ;
: builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ; : builder-test ( -- desc ) { factor-binary "-run=builder.test" } to-strings ;
SYMBOL: build-status SYMBOL: build-status
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: milli-seconds>time ( n -- string )
1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
: eval-file ( file -- obj ) <file-reader> contents eval ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: cat ( file -- ) <file-reader> contents print ;
: run-or-bail ( desc quot -- )
[ [ try-process ] curry ]
[ [ throw ] curry ]
bi*
recover ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: (build) ( -- ) : (build) ( -- )
enter-build-dir enter-build-dir
@ -182,7 +136,12 @@ SYMBOL: build-status
: build ( -- ) : build ( -- )
[ (build) ] [ drop ] recover [ (build) ] [ drop ] recover
"report" "../report" email-file ; <email>
"ed@factorcode.org" >>from
builder-recipients get >>to
"report" tag-subject >>subject
"../report" file>string >>body
send ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

82
extra/builder/util/util.factor Normal file
View File

@ -0,0 +1,82 @@
USING: kernel words namespaces classes parser continuations
io io.files io.launcher io.sockets
math math.parser
combinators sequences splitting quotations arrays strings tools.time
parser-combinators accessors assocs.lib
combinators.cleave bake calendar new-slots ;
IN: builder.util
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: runtime ( quot -- time ) benchmark nip ;
: minutes>ms ( min -- ms ) 60 * 1000 * ;
: file>string ( file -- string ) [ stdio get contents ] with-file-in ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: process* arguments stdout stderr timeout ;
: <process*> process* construct-empty ;
: >desc ( process* -- desc )
H{ } clone
over arguments>> [ +arguments+ swap put-at ] when*
over stdout>> [ +stdout+ swap put-at ] when*
over stderr>> [ +stderr+ swap put-at ] when*
over timeout>> [ +timeout+ swap put-at ] when*
nip ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: host-name* ( -- name ) host-name "." split first ;
: datestamp ( -- string )
now `{ ,[ dup timestamp-year ]
,[ dup timestamp-month ]
,[ dup timestamp-day ]
,[ dup timestamp-hour ]
,[ timestamp-minute ] }
[ 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 ) <file-reader> contents eval ;
: cat ( file -- ) <file-reader> contents print ;
: run-or-bail ( desc quot -- )
[ [ try-process ] curry ]
[ [ throw ] curry ]
bi*
recover ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!