Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
6278315669
|
|
@ -0,0 +1,41 @@
|
|||
|
||||
USING: kernel continuations arrays assocs sequences sorting math
|
||||
io io.styles prettyprint builder.util ;
|
||||
|
||||
IN: builder.benchmark
|
||||
|
||||
: passing-benchmarks ( table -- table )
|
||||
[ second first2 number? swap number? and ] subset ;
|
||||
|
||||
: simplify-table ( table -- table ) [ first2 second 2array ] map ;
|
||||
|
||||
: benchmark-difference ( old-table benchmark-result -- result-diff )
|
||||
first2 >r
|
||||
tuck swap at
|
||||
r>
|
||||
swap -
|
||||
2array ;
|
||||
|
||||
: compare-tables ( old new -- table )
|
||||
[ passing-benchmarks simplify-table ] 2apply
|
||||
[ benchmark-difference ] with map ;
|
||||
|
||||
: benchmark-deltas ( -- table )
|
||||
"../../benchmarks" "../benchmarks" [ eval-file ] 2apply
|
||||
compare-tables
|
||||
sort-values ;
|
||||
|
||||
: benchmark-deltas. ( deltas -- )
|
||||
standard-table-style
|
||||
[
|
||||
[ [ "Benchmark" write ] with-cell [ "Delta (ms)" write ] with-cell ]
|
||||
with-row
|
||||
[ [ swap [ write ] with-cell pprint-cell ] with-row ]
|
||||
assoc-each
|
||||
]
|
||||
tabular-output ;
|
||||
|
||||
: show-benchmark-deltas ( -- )
|
||||
[ benchmark-deltas benchmark-deltas. ]
|
||||
[ drop "Error generating benchmark deltas" . ]
|
||||
recover ;
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
|
||||
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 ;
|
||||
bootstrap.image benchmark vars bake smtp builder.util accessors
|
||||
builder.benchmark ;
|
||||
|
||||
IN: builder
|
||||
|
||||
|
|
@ -61,6 +62,17 @@ VAR: stamp
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: copy-image ( -- )
|
||||
"../../factor/" my-boot-image-name append
|
||||
"../" my-boot-image-name append
|
||||
copy-file
|
||||
|
||||
"../../factor/" my-boot-image-name append
|
||||
my-boot-image-name
|
||||
copy-file ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: factor-binary ( -- name )
|
||||
os
|
||||
{ { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
|
||||
|
|
@ -69,8 +81,7 @@ VAR: stamp
|
|||
case ;
|
||||
|
||||
: bootstrap-cmd ( -- cmd )
|
||||
{ factor-binary [ "-i=" my-boot-image-name append ] "-no-user-init" }
|
||||
to-strings ;
|
||||
{ factor-binary { "-i=" my-boot-image-name } "-no-user-init" } to-strings ;
|
||||
|
||||
: bootstrap ( -- desc )
|
||||
<process*>
|
||||
|
|
@ -81,8 +92,18 @@ VAR: stamp
|
|||
20 minutes>ms >>timeout
|
||||
>desc ;
|
||||
|
||||
: builder-test ( -- desc ) { factor-binary "-run=builder.test" } to-strings ;
|
||||
|
||||
: builder-test-cmd ( -- cmd )
|
||||
{ factor-binary "-run=builder.test" } to-strings ;
|
||||
|
||||
: builder-test ( -- desc )
|
||||
<process*>
|
||||
builder-test-cmd >>arguments
|
||||
+closed+ >>stdin
|
||||
"../test-log" >>stdout
|
||||
+stdout+ >>stderr
|
||||
45 minutes>ms >>timeout
|
||||
>desc ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: build-status
|
||||
|
|
@ -112,13 +133,13 @@ SYMBOL: build-status
|
|||
|
||||
make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail
|
||||
|
||||
[ retrieve-image ] [ "Image download error" print throw ] recover
|
||||
copy-image
|
||||
|
||||
bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
|
||||
|
||||
[ builder-test try-process ]
|
||||
[ "Builder test error" print throw ]
|
||||
recover
|
||||
builder-test [ "Test error" print "../test-log" cat ] run-or-bail
|
||||
|
||||
"../test-log" delete-file
|
||||
|
||||
"Boot time: " write "../boot-time" eval-file milli-seconds>time print
|
||||
"Load time: " write "../load-time" eval-file milli-seconds>time print
|
||||
|
|
@ -130,6 +151,12 @@ SYMBOL: build-status
|
|||
"Benchmarks: " print
|
||||
"../benchmarks" [ stdio get contents eval ] with-file-reader benchmarks.
|
||||
|
||||
nl
|
||||
|
||||
show-benchmark-deltas
|
||||
|
||||
"../benchmarks" "../../benchmarks" copy-file
|
||||
|
||||
] with-file-writer
|
||||
|
||||
build-status on ;
|
||||
|
|
@ -152,12 +179,17 @@ SYMBOL: builder-recipients
|
|||
"../report" file>string >>body
|
||||
send ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: build ( -- )
|
||||
[ (build) ] [ drop ] recover
|
||||
[ send-builder-email ] [ drop "not sending mail" . ] recover ;
|
||||
[ send-builder-email ] [ drop "not sending mail" . ] recover
|
||||
".." cd { "rm" "-rf" "factor" } run-process drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USE: bootstrap.image.download
|
||||
|
||||
: git-pull ( -- desc )
|
||||
{
|
||||
"git"
|
||||
|
|
@ -173,11 +205,17 @@ SYMBOL: builder-recipients
|
|||
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" append cd
|
||||
updates-available?
|
||||
updates-available? new-image-available? or
|
||||
[ build ]
|
||||
when
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,68 +0,0 @@
|
|||
|
||||
USING: kernel continuations namespaces threads match bake concurrency builder ;
|
||||
|
||||
IN: builder.server
|
||||
|
||||
! : build-server ( -- )
|
||||
! receive
|
||||
! {
|
||||
! {
|
||||
! "start"
|
||||
! [ [ build ] in-thread ]
|
||||
! }
|
||||
|
||||
! {
|
||||
! { ?from ?tag "status" }
|
||||
! [ `{ ?tag ,[ build-status get ] } ?from send ]
|
||||
! }
|
||||
! }
|
||||
! match-cond
|
||||
! build-server ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! : build-server ( -- )
|
||||
! receive
|
||||
! {
|
||||
! {
|
||||
! "start"
|
||||
! [
|
||||
! [ [ build ] [ drop ] recover "idle" build-status set-global ] in-thread
|
||||
! ]
|
||||
! }
|
||||
|
||||
! {
|
||||
! { ?from ?tag "status" }
|
||||
! [ `{ ?tag ,[ build-status get ] } ?from send ]
|
||||
! }
|
||||
! }
|
||||
! match-cond
|
||||
! build-server ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! : build-server ( -- )
|
||||
! receive
|
||||
! {
|
||||
! {
|
||||
! "start"
|
||||
! [
|
||||
! build-status get "idle" =
|
||||
! build-status get f =
|
||||
! or
|
||||
! [
|
||||
! [ [ build ] [ drop ] recover "idle" build-status set-global ]
|
||||
! in-thread
|
||||
! ]
|
||||
! when
|
||||
! ]
|
||||
! }
|
||||
|
||||
! {
|
||||
! { ?from ?tag "status" }
|
||||
! [ `{ ?tag ,[ build-status get ] } ?from send ]
|
||||
! }
|
||||
! }
|
||||
! match-cond
|
||||
! build-server ;
|
||||
|
||||
|
|
@ -110,8 +110,8 @@
|
|||
|
||||
(require 'comint)
|
||||
|
||||
(defvar factor-binary "/scratch/repos/Factor/factor")
|
||||
(defvar factor-image "/scratch/repos/Factor/factor.image")
|
||||
(defvar factor-binary "~/factor/factor")
|
||||
(defvar factor-image "~/factor/factor.image")
|
||||
|
||||
(defun factor-telnet-to-port (port)
|
||||
(interactive "nPort: ")
|
||||
|
|
@ -202,8 +202,8 @@
|
|||
(defun run-factor ()
|
||||
(interactive)
|
||||
(switch-to-buffer
|
||||
(make-comint-in-buffer "factor" nil factor-binary nil
|
||||
(concat "-i=" factor-image)
|
||||
(make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil
|
||||
(concat "-i=" (expand-file-name factor-image))
|
||||
"-run=listener"))
|
||||
(factor-listener-mode))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue