diff --git a/extra/benchmark/crc32/crc32.factor b/extra/benchmark/crc32/crc32.factor new file mode 100644 index 0000000000..7dad272296 --- /dev/null +++ b/extra/benchmark/crc32/crc32.factor @@ -0,0 +1,10 @@ +USING: io.crc32 io.files kernel math ; +IN: benchmark.crc32 + +: crc32-primes-list ( -- ) + 10 [ + "extra/math/primes/list/list.factor" resource-path + file-contents crc32 drop + ] times ; + +MAIN: crc32-primes-list diff --git a/extra/benchmark/md5/md5.factor b/extra/benchmark/md5/md5.factor new file mode 100644 index 0000000000..3043725acd --- /dev/null +++ b/extra/benchmark/md5/md5.factor @@ -0,0 +1,7 @@ +USING: crypto.md5 io.files kernel ; +IN: benchmark.md5 + +: md5-primes-list ( -- ) + "extra/math/primes/list/list.factor" resource-path file>md5 drop ; + +MAIN: md5-primes-list diff --git a/extra/benchmark/random/random.factor b/extra/benchmark/random/random.factor new file mode 100644 index 0000000000..95c797cddd --- /dev/null +++ b/extra/benchmark/random/random.factor @@ -0,0 +1,14 @@ +USING: io.files random math.parser io math ; +IN: benchmark.random + +: random-numbers-path "random-numbers.txt" temp-file ; + +: write-random-numbers ( n -- ) + random-numbers-path [ + [ 200 random 100 - number>string print ] times + ] with-file-writer ; + +: random-main ( -- ) + 1000000 write-random-numbers ; + +MAIN: random-main diff --git a/extra/benchmark/sort/sort.factor b/extra/benchmark/sort/sort.factor index 0a31bf0ca4..a54480692a 100644 --- a/extra/benchmark/sort/sort.factor +++ b/extra/benchmark/sort/sort.factor @@ -1,7 +1,8 @@ -USING: kernel sequences sorting random ; +USING: kernel sequences sorting benchmark.random math.parser +io.files ; IN: benchmark.sort : sort-benchmark - 100000 [ drop 100000 random ] map natural-sort drop ; + random-numbers-path file-lines [ string>number ] map natural-sort drop ; MAIN: sort-benchmark diff --git a/extra/benchmark/sum-file/sum-file.factor b/extra/benchmark/sum-file/sum-file.factor index e17765d542..1d52beebfc 100644 --- a/extra/benchmark/sum-file/sum-file.factor +++ b/extra/benchmark/sum-file/sum-file.factor @@ -1,4 +1,5 @@ -USING: io io.files math math.parser kernel prettyprint ; +USING: io io.files math math.parser kernel prettyprint +benchmark.random ; IN: benchmark.sum-file : sum-file-loop ( n -- n' ) @@ -8,6 +9,6 @@ IN: benchmark.sum-file [ 0 sum-file-loop ] with-file-reader . ; : sum-file-main ( -- ) - home "sum-file-in.txt" path+ sum-file ; + random-numbers-path sum-file ; MAIN: sum-file-main diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 6660ddf218..178b7a5d35 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -199,6 +199,7 @@ ARTICLE: "tools" "Developer tools" "Debugging tools:" { $subsection "tools.annotations" } { $subsection "tools.test" } +{ $subsection "tools.threads" } "Performance tools:" { $subsection "tools.memory" } { $subsection "profiling" } diff --git a/extra/help/help.factor b/extra/help/help.factor index 77b9f699aa..490374a384 100755 --- a/extra/help/help.factor +++ b/extra/help/help.factor @@ -122,18 +122,31 @@ M: word set-article-parent swap "help-parent" set-word-prop ; : (:help-multi) "This error has multiple delegates:" print - ($index) nl ; + ($index) nl + "Use \\ ... help to get help about a specific delegate." print ; : (:help-none) drop "No help for this error. " print ; +: (:help-debugger) + nl + "Debugger commands:" print + nl + ":help - documentation for this error" print + ":s - data stack at exception time" print + ":r - retain stack at exception time" print + ":c - call stack at exception time" print + ":edit - jump to source location (parse errors only)" print + + ":get ( var -- value ) accesses variables at time of the error" print ; + : :help ( -- ) error get delegates [ error-help ] map [ ] subset { { [ dup empty? ] [ (:help-none) ] } { [ dup length 1 = ] [ first help ] } { [ t ] [ (:help-multi) ] } - } cond ; + } cond (:help-debugger) ; : remove-article ( name -- ) dup articles get key? [ diff --git a/extra/opengl/gl/extensions/extensions.factor b/extra/opengl/gl/extensions/extensions.factor index e05e3a1af5..01725ee9a9 100644 --- a/extra/opengl/gl/extensions/extensions.factor +++ b/extra/opengl/gl/extensions/extensions.factor @@ -17,7 +17,7 @@ SYMBOL: +gl-function-pointers+ : reset-gl-function-pointers ( -- ) 100 +gl-function-pointers+ set-global ; -[ reset-gl-function-pointers ] "opengl.gl init hook" add-init-hook +[ reset-gl-function-pointers ] "opengl.gl" add-init-hook reset-gl-function-pointers reset-gl-function-number-counter diff --git a/extra/tools/threads/threads-docs.factor b/extra/tools/threads/threads-docs.factor new file mode 100644 index 0000000000..d4c5be9c17 --- /dev/null +++ b/extra/tools/threads/threads-docs.factor @@ -0,0 +1,17 @@ +IN: tools.threads +USING: help.markup help.syntax threads ; + +HELP: threads. +{ $description "Prints a list of running threads and their state. The ``Waiting on'' column displays one of the following:" + { $list + "``running'' if the thread is the current thread" + "``yield'' if the thread is waiting to run" + { "the string given to " { $link suspend } " if the thread is suspended" } + } +} ; + +ARTICLE: "tools.threads" "Listing threads" +"Printing a list of running threads:" +{ $subsection threads. } ; + +ABOUT: "tools.threads" diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor index cf6d1a9ed9..defd5aa38a 100755 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/extra/ui/gadgets/buttons/buttons.factor @@ -88,7 +88,6 @@ TUPLE: repeat-button ; repeat-button H{ { T{ drag } [ button-clicked ] } - { T{ button-down } [ button-clicked ] } } set-gestures : ( label quot -- button ) diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor index 0577ae38bd..c4c366bb7d 100755 --- a/extra/ui/tools/listener/listener.factor +++ b/extra/ui/tools/listener/listener.factor @@ -40,9 +40,14 @@ M: listener-gadget call-tool* ( input listener -- ) M: listener-gadget tool-scroller listener-gadget-output find-scroller ; +: wait-for-listener ( listener -- ) + #! Wait for the listener to start. + listener-gadget-input interactor-flag wait-for-flag ; + : workspace-busy? ( workspace -- ? ) - workspace-listener listener-gadget-input - interactor-busy? ; + workspace-listener + dup wait-for-listener + listener-gadget-input interactor-busy? ; : get-listener ( -- listener ) [ workspace-busy? not ] get-workspace* workspace-listener ; @@ -134,10 +139,6 @@ M: stack-display tool-scroller : start-listener-thread ( listener -- ) [ listener-thread ] curry "Listener" spawn drop ; -: wait-for-listener ( listener -- ) - #! Wait for the listener to start. - listener-gadget-input interactor-flag wait-for-flag ; - : restart-listener ( listener -- ) #! Returns when listener is ready to receive input. dup com-end dup clear-output diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor index 0156fe80ea..b3b24cf749 100755 --- a/extra/ui/tools/tools.factor +++ b/extra/ui/tools/tools.factor @@ -1,15 +1,14 @@ -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs debugger ui.tools.workspace -ui.tools.operations ui.tools.browser ui.tools.inspector -ui.tools.listener ui.tools.profiler +ui.tools.operations ui.tools.traceback ui.tools.browser +ui.tools.inspector ui.tools.listener ui.tools.profiler ui.tools.operations inspector io kernel math models namespaces prettyprint quotations sequences ui ui.commands ui.gadgets -ui.gadgets.books ui.gadgets.buttons -ui.gadgets.labelled ui.gadgets.scrollers ui.gadgets.tracks -ui.gadgets.worlds ui.gadgets.presentations ui.gestures words -vocabs.loader tools.test ui.gadgets.buttons -ui.gadgets.status-bar mirrors ; +ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled +ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds +ui.gadgets.presentations ui.gestures words vocabs.loader +tools.test ui.gadgets.buttons ui.gadgets.status-bar mirrors ; IN: ui.tools : ( -- tabs ) @@ -83,7 +82,13 @@ workspace "workflow" f { } define-command-map [ - - dup "Factor workspace" open-status-window - workspace-listener wait-for-listener + "Factor workspace" open-status-window ] workspace-window-hook set-global + +: inspect-continuation ( traceback -- ) + control-value [ inspect ] curry call-listener ; + +traceback-gadget "toolbar" f { + { T{ key-down f f "v" } variables } + { T{ key-down f f "n" } inspect-continuation } +} define-command-map diff --git a/extra/ui/tools/traceback/traceback.factor b/extra/ui/tools/traceback/traceback.factor index d4a0544f0a..3c3ff9da44 100755 --- a/extra/ui/tools/traceback/traceback.factor +++ b/extra/ui/tools/traceback/traceback.factor @@ -54,7 +54,3 @@ M: variables-gadget pref-dim* drop { 400 400 } ; : traceback-window ( continuation -- ) "Traceback" open-window ; - -traceback-gadget "toolbar" f { - { T{ key-down f f "v" } variables } -} define-command-map diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor index ea38b9c8db..bc038cd244 100755 --- a/extra/ui/tools/walker/walker.factor +++ b/extra/ui/tools/walker/walker.factor @@ -7,7 +7,7 @@ ui.tools.workspace ui.gestures ui.gadgets.labels ui threads namespaces tools.walker assocs ; IN: ui.tools.walker -TUPLE: walker-gadget status continuation thread ; +TUPLE: walker-gadget status continuation thread traceback ; : walker-command ( walker msg -- ) over walker-gadget-thread thread-registered? @@ -29,6 +29,9 @@ TUPLE: walker-gadget status continuation thread ; M: walker-gadget ungraft* dup delegate ungraft* detach walker-command ; +M: walker-gadget focusable-child* + walker-gadget-traceback ; + : walker-state-string ( status thread -- string ) [ "Thread: " % @@ -48,10 +51,10 @@ M: walker-gadget ungraft* [ walker-state-string ] curry ; : ( status continuation thread -- gadget ) - walker-gadget construct-boa [ + over walker-gadget construct-boa [ toolbar, g walker-gadget-status self f track, - g walker-gadget-continuation 1 track, + g walker-gadget-traceback 1 track, ] { 0 1 } build-track ; : walker-help "ui-walker" help-window ;