tools.time: overhaul

basis/bootstrap/tools/tools.factor

@@ -12,6 +12,7 @@ IN: bootstrap.tools
     "tools.deploy"
     "tools.destructors"
     "tools.disassembler"
+    "tools.dispatch"
     "tools.memory"
     "tools.profiler"
     "tools.test"

basis/listener/listener.factor

@@ -163,8 +163,10 @@ SYMBOL: interactive-vocabs
     "syntax"
     "tools.annotations"
     "tools.crossref"
+    "tools.deprecation"
     "tools.destructors"
     "tools.disassembler"
+    "tools.dispatch"
     "tools.errors"
     "tools.memory"
     "tools.profiler"

basis/prettyprint/prettyprint.factor

@@ -110,3 +110,7 @@ SYMBOL: pprint-string-cells?
             ] with-row
         ] each
     ] tabular-output nl ;
+
+: object-table. ( obj alist -- )
+    [ [ nip first ] [ second call( obj -- str ) ] 2bi 2array ] with map
+    simple-table. ;

basis/stack-checker/known-words/known-words.factor

@@ -13,7 +13,7 @@ words.private definitions assocs summary compiler.units
 system.private combinators combinators.short-circuit locals
 locals.backend locals.types combinators.private
 stack-checker.values generic.single generic.single.private
-alien.libraries
+alien.libraries tools.dispatch.private tools.profiler.private
 stack-checker.alien
 stack-checker.state
 stack-checker.errors
@@ -705,8 +705,6 @@ M: bad-executable summary
 
 \ reset-dispatch-stats { } { } define-primitive
 \ dispatch-stats { } { array } define-primitive
-\ reset-inline-cache-stats { } { } define-primitive
-\ inline-cache-stats { } { array } define-primitive
 
 \ optimized? { word } { object } define-primitive
 
@@ -716,3 +714,5 @@ M: bad-executable summary
 
 \ enable-gc-events { } { } define-primitive
 \ disable-gc-events { } { object } define-primitive
+
+\ profiling { object } { } define-primitive

basis/tools/memory/memory-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax memory sequences ;
+USING: help.markup help.syntax memory sequences vm ;
 IN: tools.memory
 
 ARTICLE: "tools.memory" "Object memory tools"
@@ -39,3 +39,15 @@ HELP: heap-stats.
 { $description "For each class, prints the number of instances and total memory consumed by those instances." } ;
 
 { heap-stats heap-stats. } related-words
+
+HELP: gc-events.
+{ $description "Prints all garbage collection events that took place during the last call to " { $link collect-gc-events } "." } ;
+
+HELP: gc-stats.
+{ $description "Prints a breakdown of different garbage collection events that took place during the last call to " { $link collect-gc-events } "." } ;
+
+HELP: gc-summary.
+{ $description "Prints aggregate garbage collection statistics from the last call to " { $link collect-gc-events } "." } ;
+
+HELP: gc-events
+{ $var-description "A sequence of " { $link gc-event } " instances, set by " { $link collect-gc-events } ". Can be inspected directly, or with the " { $link gc-events. } ", " { $link gc-stats. } " and " { $link gc-summary. } " words." } ;

basis/tools/memory/memory-tests.factor

@@ -1,5 +1,9 @@
-USING: tools.test tools.memory ;
+USING: tools.test tools.memory memory ;
 IN: tools.memory.tests
 
 [ ] [ room. ] unit-test
 [ ] [ heap-stats. ] unit-test
+[ ] [ [ gc gc ] collect-gc-events ] unit-test
+[ ] [ gc-events. ] unit-test
+[ ] [ gc-stats. ] unit-test
+[ ] [ gc-summary. ] unit-test

basis/tools/memory/memory.factor

@@ -22,16 +22,12 @@ IN: tools.memory
 : micros>string ( n -- str )
     commas " µs" append ;
 
-: fancy-table. ( obj alist -- )
-    [ [ nip first ] [ second call( obj -- str ) ] 2bi 2array ] with map
-    simple-table. ;
-
 : copying-room. ( copying-sizes -- )
     {
         { "Size:" [ size>> kilobytes ] }
         { "Occupied:" [ occupied>> kilobytes ] }
         { "Free:" [ free>> kilobytes ] }
-    } fancy-table. ;
+    } object-table. ;
 
 : nursery-room. ( data-room -- )
     "- Nursery space" print nursery>> copying-room. ;
@@ -46,7 +42,7 @@ IN: tools.memory
         { "Total free:" [ total-free>> kilobytes ] }
         { "Contiguous free:" [ contiguous-free>> kilobytes ] }
         { "Free block count:" [ free-block-count>> number>string ] }
-    } fancy-table. ;
+    } object-table. ;
 
 : tenured-room. ( data-room -- )
     "- Tenured space" print tenured>> mark-sweep-table. ;
@@ -57,7 +53,7 @@ IN: tools.memory
         { "Card array:" [ cards>> kilobytes ] }
         { "Deck array:" [ decks>> kilobytes ] }
         { "Mark stack:" [ mark-stack>> kilobytes ] }
-    } fancy-table. ;
+    } object-table. ;
 
 : data-room. ( -- )
     "== Data heap ==" print nl
@@ -100,9 +96,12 @@ PRIVATE>
         ] each 2drop
     ] tabular-output nl ;
 
-: collect-gc-events ( quot -- events )
-    enable-gc-events [ ] [ disable-gc-events drop ] cleanup
-    disable-gc-events byte-array>gc-event-array ; inline
+SYMBOL: gc-events
+
+: collect-gc-events ( quot -- )
+    enable-gc-events
+    [ ] [ disable-gc-events drop ] cleanup
+    disable-gc-events byte-array>gc-event-array gc-events set ; inline
 
 <PRIVATE
 
@@ -169,15 +168,6 @@ TUPLE: gc-stats collections times ;
     [ gc-stats-table-row ] map
     { "" "Number" "Total" "Mean" "Median" "Min" "Max" } prefix ;
 
-: heap-sizes ( events -- seq )
-    [
-        [
-            [ [ start-time>> ] [ space-occupied-before ] bi 2array , ]
-            [ [ [ start-time>> ] [ total-time>> ] bi + ] [ space-occupied-after ] bi 2array , ]
-            bi
-        ] each
-    ] { } make ;
-
 PRIVATE>
 
 : gc-event. ( event -- )
@@ -185,13 +175,16 @@ PRIVATE>
         { "Event type:" [ op>> gc-op-string ] }
         { "Total time:" [ total-time>> micros>string ] }
         { "Space reclaimed:" [ space-reclaimed kilobytes ] }
-    } fancy-table. ;
+    } object-table. ;
 
-: gc-stats. ( events -- )
-    compute-gc-stats gc-stats-table simple-table. ;
+: gc-events. ( -- )
+    gc-events get [ gc-event. nl ] each ;
 
-: gc-summary. ( events -- )
-    {
+: gc-stats. ( -- )
+    gc-events get compute-gc-stats gc-stats-table simple-table. ;
+
+: gc-summary. ( -- )
+    gc-events get {
         { "Collections:" [ length commas ] }
         { "Cards scanned:" [ [ cards-scanned>> ] map-sum commas ] }
         { "Decks scanned:" [ [ decks-scanned>> ] map-sum commas ] }
@@ -202,7 +195,4 @@ PRIVATE>
         { "Data heap sweep time:" [ [ data-sweep-time>> ] map-sum micros>string ] }
         { "Code heap sweep time:" [ [ code-sweep-time>> ] map-sum micros>string ] }
         { "Compaction time:" [ [ compaction-time>> ] map-sum micros>string ] }
-    } fancy-table. ;
-
-: heap-sizes. ( events -- )
-    heap-sizes simple-table. ;
+    } object-table. ;

basis/tools/profiler/profiler-docs.factor

@@ -25,7 +25,7 @@ $nl
     method-profile.
     "profiler-limitations"
 }
-{ $see-also "ui.tools.profiler" } ;
+{ $see-also "ui.tools.profiler" "tools.annotations" "timing" } ;
 
 ABOUT: "profiling"
 

basis/tools/time/time-docs.factor

@@ -1,9 +1,12 @@
-USING: help.markup help.syntax memory system ;
+USING: help.markup help.syntax memory system tools.dispatch
+tools.memory quotations vm ;
 IN: tools.time
 
-ARTICLE: "timing" "Timing code"
+ARTICLE: "timing" "Timing code and collecting statistics"
 "You can time the execution of a quotation in the listener:"
 { $subsections time }
+"This word also collects statistics about method dispatch and garbage collection:"
+{ $subsections dispatch-stats. gc-events. gc-stats. gc-summary. }
 "A lower-level word puts timings on the stack, intead of printing:"
 { $subsections benchmark }
 "You can also read the system clock directly:"
@@ -13,13 +16,23 @@ ARTICLE: "timing" "Timing code"
 ABOUT: "timing"
 
 HELP: benchmark
-{ $values { "quot" "a quotation" }
+{ $values { "quot" quotation }
           { "runtime" "the runtime in microseconds" } }
       { $description "Runs a quotation, measuring the total wall clock time." }
 { $notes "A nicer word for interactive use is " { $link time } "." } ;
 
 HELP: time
-{ $values { "quot" "a quotation" } }
-{ $description "Runs a quotation and then prints the total run time and some statistics." } ;
+{ $values { "quot" quotation } }
+{ $description "Runs a quotation, gathering statistics about method dispatch and garbage collection, and then prints the total run time." } ;
 
 { benchmark micros time } related-words
+
+HELP: collect-gc-events
+{ $values { "quot" quotation } }
+{ $description "Calls the quotation, storing an array of " { $link gc-event } " instances in the " { $link gc-events } " variable." }
+{ $notes "The " { $link time } " combinator automatically calls this combinator." } ;
+
+HELP: collect-dispatch-stats
+{ $values { "quot" quotation } }
+{ $description "Calls the quotation, collecting method dispatch statistics and storing them in the " { $link last-dispatch-stats } " variable. " }
+{ $notes "The " { $link time } " combinator automatically calls this combinator." } ;

basis/tools/time/time.factor

@@ -1,38 +1,22 @@
 ! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math memory io io.styles prettyprint
-namespaces system sequences splitting grouping assocs strings
-generic.single combinators ;
+USING: system kernel math io prettyprint tools.memory
+tools.dispatch ;
 IN: tools.time
 
 : benchmark ( quot -- runtime )
     micros [ call micros ] dip - ; inline
 
 : time. ( time -- )
-    "== Running time ==" print nl 1000000 /f pprint " seconds" print ;
+    "Running time: " write 1000000 /f pprint " seconds" print ;
 
-: dispatch-stats. ( stats -- )
-    "== Megamorphic caches ==" print nl
-    [ { "Hits" "Misses" } ] dip zip simple-table. ;
-
-: inline-cache-stats. ( stats -- )
-    "== Polymorphic inline caches ==" print nl
-    3 cut
-    [
-        "- Transitions:" print
-        [ { "Cold to monomorphic" "Mono to polymorphic" "Poly to megamorphic" } ] dip zip
-        simple-table. nl
-    ] [
-        "- Type check stubs:" print
-        [ { "Tag" "Tuple" } ] dip zip
-        simple-table.
-    ] bi* ;
+: time-banner. ( -- )
+    "Additional information was collected." print
+    "dispatch-stats.  - Print method dispatch statistics" print
+    "gc-events.       - Print all garbage collection events" print
+    "gc-stats.        - Print breakdown of different garbage collection events" print
+    "gc-summary.      - Print aggregate garbage collection statistics" print ;
 
 : time ( quot -- )
-    reset-dispatch-stats
-    reset-inline-cache-stats
-    benchmark dispatch-stats inline-cache-stats
-    [ time. nl ]
-    [ dispatch-stats. nl ]
-    [ inline-cache-stats. ]
-    tri* ; inline
+    [ [ benchmark ] collect-dispatch-stats ] collect-gc-events
+    time. nl time-banner. ; inline

basis/vm/vm.factor

@@ -7,17 +7,17 @@ TYPEDEF: intptr_t cell
 C-TYPE: context
 
 STRUCT: zone
-    { start cell }
-    { here cell }
-    { size cell }
-    { end cell } ;
+{ start cell }
+{ here cell }
+{ size cell }
+{ end cell } ;
 
 STRUCT: vm
-    { stack_chain context* }
-    { nursery zone }
-    { cards_offset cell }
-    { decks_offset cell }
-    { userenv cell[70] } ;
+{ stack_chain context* }
+{ nursery zone }
+{ cards_offset cell }
+{ decks_offset cell }
+{ userenv cell[70] } ;
 
 : vm-field-offset ( field -- offset ) vm offset-of ; inline
 
@@ -66,3 +66,14 @@ STRUCT: gc-event
 { code-sweep-time cell }
 { compaction-time cell }
 { temp-time cell } ;
+
+STRUCT: dispatch-statistics
+{ megamorphic-cache-hits cell }
+{ megamorphic-cache-misses cell }
+
+{ cold-call-to-ic-transitions cell }
+{ ic-to-pic-transitions cell }
+{ pic-to-mega-transitions cell }
+
+{ pic-tag-count cell }
+{ pic-tuple-count cell } ;

core/bootstrap/primitives.factor

@@ -99,6 +99,7 @@ bootstrapping? on
     "system"
     "system.private"
     "threads.private"
+    "tools.dispatch.private"
     "tools.profiler.private"
     "words"
     "words.private"
@@ -511,10 +512,8 @@ tuple
     { "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
     { "mega-cache-miss" "generic.single.private" (( methods index cache -- method )) }
     { "lookup-method" "generic.single.private" (( object methods -- method )) }
-    { "reset-dispatch-stats" "generic.single" (( -- )) }
-    { "dispatch-stats" "generic.single" (( -- stats )) }
-    { "reset-inline-cache-stats" "generic.single" (( -- )) }
-    { "inline-cache-stats" "generic.single" (( -- stats )) }
+    { "reset-dispatch-stats" "tools.dispatch.private" (( -- )) }
+    { "dispatch-stats" "tools.dispatch.private" (( -- stats )) }
     { "optimized?" "words" (( word -- ? )) }
     { "quot-compiled?" "quotations" (( quot -- ? )) }
     { "vm-ptr" "vm" (( -- ptr )) }

vm/code_block.cpp

@@ -178,7 +178,7 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
 	case RT_UNTAGGED:
 		return untag_fixnum(ARG);
 	case RT_MEGAMORPHIC_CACHE_HITS:
-		return (cell)&megamorphic_cache_hits;
+		return (cell)&dispatch_stats.megamorphic_cache_hits;
 	case RT_VM:
 		return (cell)this + untag_fixnum(ARG);
 	case RT_CARDS_OFFSET:

vm/dispatch.cpp

@@ -118,7 +118,7 @@ void factor_vm::update_method_cache(cell cache, cell klass, cell method)
 
 void factor_vm::primitive_mega_cache_miss()
 {
-	megamorphic_cache_misses++;
+	dispatch_stats.megamorphic_cache_misses++;
 
 	cell cache = dpop();
 	fixnum index = untag_fixnum(dpop());
@@ -135,16 +135,12 @@ void factor_vm::primitive_mega_cache_miss()
 
 void factor_vm::primitive_reset_dispatch_stats()
 {
-	megamorphic_cache_hits = megamorphic_cache_misses = 0;
+	memset(&dispatch_stats,0,sizeof(dispatch_statistics));
 }
 
 void factor_vm::primitive_dispatch_stats()
 {
-	growable_array stats(this);
-	stats.add(allot_cell(megamorphic_cache_hits));
-	stats.add(allot_cell(megamorphic_cache_misses));
-	stats.trim();
-	dpush(stats.elements.value());
+	dpush(tag<byte_array>(byte_array_from_value(&dispatch_stats)));
 }
 
 void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)

vm/dispatch.hpp

@@ -1,4 +1,16 @@
 namespace factor
 {
 
+struct dispatch_statistics {
+	cell megamorphic_cache_hits;
+	cell megamorphic_cache_misses;
+
+	cell cold_call_to_ic_transitions;
+	cell ic_to_pic_transitions;
+	cell pic_to_mega_transitions;
+
+	cell pic_tag_count;
+	cell pic_tuple_count;
+};
+
 }

vm/inline_cache.cpp

@@ -6,11 +6,6 @@ namespace factor
 void factor_vm::init_inline_caching(int max_size)
 {
 	max_pic_size = max_size;
-	cold_call_to_ic_transitions = 0;
-	ic_to_pic_transitions = 0;
-	pic_to_mega_transitions = 0;
-	pic_counts[0] = 0;
-	pic_counts[1] = 0;
 }
 
 void factor_vm::deallocate_inline_cache(cell return_address)
@@ -48,7 +43,10 @@ cell factor_vm::determine_inline_cache_type(array *cache_entries)
 
 void factor_vm::update_pic_count(cell type)
 {
-	pic_counts[type - PIC_TAG]++;
+	if(type == PIC_TAG)
+		dispatch_stats.pic_tag_count++;
+	else
+		dispatch_stats.pic_tuple_count++;
 }
 
 struct inline_cache_jit : public jit {
@@ -167,11 +165,11 @@ cell factor_vm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell me
 void factor_vm::update_pic_transitions(cell pic_size)
 {
 	if(pic_size == max_pic_size)
-		pic_to_mega_transitions++;
+		dispatch_stats.pic_to_mega_transitions++;
 	else if(pic_size == 0)
-		cold_call_to_ic_transitions++;
+		dispatch_stats.cold_call_to_ic_transitions++;
 	else if(pic_size == 1)
-		ic_to_pic_transitions++;
+		dispatch_stats.ic_to_pic_transitions++;
 }
 
 /* The cache_entries parameter is empty (on cold call site) or has entries
@@ -241,23 +239,4 @@ VM_C_API void *inline_cache_miss(cell return_address, factor_vm *parent)
 	return parent->inline_cache_miss(return_address);
 }
 
-void factor_vm::primitive_reset_inline_cache_stats()
-{
-	cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
-	pic_counts[0] = 0;
-	pic_counts[1] = 0;
-}
-
-void factor_vm::primitive_inline_cache_stats()
-{
-	growable_array stats(this);
-	stats.add(allot_cell(cold_call_to_ic_transitions));
-	stats.add(allot_cell(ic_to_pic_transitions));
-	stats.add(allot_cell(pic_to_mega_transitions));
-	stats.add(allot_cell(pic_counts[0]));
-	stats.add(allot_cell(pic_counts[1]));
-	stats.trim();
-	dpush(stats.elements.value());
-}
-
 }

vm/master.hpp

@@ -71,6 +71,7 @@ namespace factor
 #include "image.hpp"
 #include "alien.hpp"
 #include "callbacks.hpp"
+#include "dispatch.hpp"
 #include "vm.hpp"
 #include "allot.hpp"
 #include "tagged.hpp"
@@ -93,7 +94,6 @@ namespace factor
 #include "byte_arrays.hpp"
 #include "jit.hpp"
 #include "quotations.hpp"
-#include "dispatch.hpp"
 #include "inline_cache.hpp"
 #include "factor.hpp"
 #include "utilities.hpp"

vm/primitives.cpp

@@ -121,8 +121,6 @@ PRIMITIVE_FORWARD(mega_cache_miss)
 PRIMITIVE_FORWARD(lookup_method)
 PRIMITIVE_FORWARD(reset_dispatch_stats)
 PRIMITIVE_FORWARD(dispatch_stats)
-PRIMITIVE_FORWARD(reset_inline_cache_stats)
-PRIMITIVE_FORWARD(inline_cache_stats)
 PRIMITIVE_FORWARD(optimized_p)
 PRIMITIVE_FORWARD(quot_compiled_p)
 PRIMITIVE_FORWARD(vm_ptr)
@@ -287,8 +285,6 @@ const primitive_type primitives[] = {
 	primitive_lookup_method,
 	primitive_reset_dispatch_stats,
 	primitive_dispatch_stats,
-	primitive_reset_inline_cache_stats,
-	primitive_inline_cache_stats,
 	primitive_optimized_p,
 	primitive_quot_compiled_p,
 	primitive_vm_ptr,

vm/vm.cpp

@@ -11,6 +11,8 @@ factor_vm::factor_vm() :
 	gc_events(NULL),
 	fep_disabled(false),
 	full_output(false)
-	{ }
+{
+	primitive_reset_dispatch_stats();
+}
 
 }

vm/vm.hpp

@@ -80,14 +80,7 @@ struct factor_vm
 	cell bignum_neg_one;
 
 	/* Method dispatch statistics */
-	cell megamorphic_cache_hits;
-	cell megamorphic_cache_misses;
-
-	cell cold_call_to_ic_transitions;
-	cell ic_to_pic_transitions;
-	cell pic_to_mega_transitions;
-	/* Indexed by PIC_TAG, PIC_TUPLE */
-	cell pic_counts[2];
+	dispatch_statistics dispatch_stats;
 
 	/* Number of entries in a polymorphic inline cache */
 	cell max_pic_size;
@@ -646,8 +639,6 @@ struct factor_vm
 	cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_);
 	void update_pic_transitions(cell pic_size);
 	void *inline_cache_miss(cell return_address);
-	void primitive_reset_inline_cache_stats();
-	void primitive_inline_cache_stats();
 
 	//factor
 	void default_parameters(vm_parameters *p);