diff --git a/extra/builder/benchmark/benchmark.factor b/extra/builder/benchmark/benchmark.factor new file mode 100644 index 0000000000..48891593d2 --- /dev/null +++ b/extra/builder/benchmark/benchmark.factor @@ -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 ; \ No newline at end of file diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 0c9f4ab099..bc65035747 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -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 ) @@ -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 ) + + 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 ] diff --git a/extra/builder/server/server.factor b/extra/builder/server/server.factor deleted file mode 100644 index f3ec349557..0000000000 --- a/extra/builder/server/server.factor +++ /dev/null @@ -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 ; - diff --git a/misc/factor.el b/misc/factor.el index 19b7f28e22..7225ef91fd 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -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))