{ "(exists?)" "io.files.private" }
{ "(directory)" "io.files.private" }
{ "gc" "memory" }
- { "gc-time" "memory" }
+ { "gc-stats" "memory" }
{ "save-image" "memory" }
{ "save-image-and-exit" "memory" }
{ "datastack" "kernel" }
\ gc { } { } <effect> set-primitive-effect
-\ gc-time { } { integer } <effect> set-primitive-effect
+\ gc-stats { } { array } <effect> set-primitive-effect
\ save-image { string } { } <effect> set-primitive-effect
IN: benchmark
: run-benchmark ( vocab -- result )
- [ [ require ] [ [ run ] benchmark nip ] bi ] curry
+ [ [ require ] [ [ run ] benchmark ] bi ] curry
[ error. f ] recover ;
: run-benchmarks ( -- assoc )
[\r
dup [\r
word-dataflow nip 1 count-optimization-passes\r
- ] benchmark nip 2array\r
+ ] benchmark 2array\r
] { } map>assoc\r
[ first ] "Worst number of optimizer passes:" results\r
[ second ] "Worst compile times:" results ;\r
"This word can be used to compare performance of the non-optimizing and optimizing compilers."
$nl
"First, we time a quotation directly; quotations are compiled by the non-optimizing quotation compiler:"
- { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] 10 ave-time" "1116 ms run / 6 ms GC ave time - 10 trials" }
+ { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] 10 ave-time" "1116 ms run time - 10 trials" }
"Now we define a word and compile it with the optimizing word compiler. This results is faster execution:"
- { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] 10 ave-time" "202 ms run / 13 ms GC ave time - 10 trials" }
+ { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] 10 ave-time" "202 ms run time - 10 trials" }
} ;
-
-{ benchmark collect-benchmarks gc-time millis time ave-time } related-words
math.statistics namespaces sequences tools.time ;
IN: project-euler.ave-time
-<PRIVATE
-
-: ave-benchmarks ( seq -- pair )
- flip [ mean round ] map ;
-
-PRIVATE>
-
: collect-benchmarks ( quot n -- seq )
[
- >r >r datastack r> [ benchmark 2array , ] curry tuck
+ >r >r datastack r> [ benchmark , ] curry tuck
[ with-datastack drop ] 2curry r> swap times call
] { } make ;
: ave-time ( quot n -- )
- [ collect-benchmarks ] keep swap ave-benchmarks [
- dup second # " ms run / " % first # " ms GC ave time - " % # " trials" %
+ [ collect-benchmarks ] keep swap mean round [
+ # " ms run time - " % # " trials" %
] "" make print flush ; inline
[\r
dup [\r
word-dataflow nip 1 count-optimization-passes\r
- ] benchmark nip 2array\r
+ ] benchmark 2array\r
] { } map>assoc ;\r
\r
: optimizer-measurements. ( alist -- )\r
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces arrays prettyprint sequences kernel
vectors quotations words parser assocs combinators
-continuations debugger io io.files vocabs tools.time
+continuations debugger io io.files vocabs
vocabs.loader source-files compiler.units inspector
inference effects tools.vocabs ;
IN: tools.test
: (unit-test) ( what quot -- )
swap dup . flush this-test set
- [ time ] curry failures get [
+ failures get [
[ this-test get failure ] recover
] [
call
{ $subsection time }
"A lower-level word puts timings on the stack, intead of printing:"
{ $subsection benchmark }
-"You can also read the system clock and total garbage collection time directly:"
+"You can also read the system clock and garbage collection statistics directly:"
{ $subsection millis }
-{ $subsection gc-time }
+{ $subsection gc-stats }
{ $see-also "profiling" } ;
ABOUT: "timing"
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math memory io namespaces system
-math.parser ;
+USING: kernel math math.vectors memory io io.styles prettyprint
+namespaces system sequences assocs ;
IN: tools.time
: benchmark ( quot -- gctime runtime )
- millis >r gc-time >r call gc-time r> - millis r> - ;
- inline
+ millis >r call millis r> - ; inline
+
+: stats. ( data -- )
+ {
+ "Run time"
+ "GC time"
+ "Nursery collections"
+ "Aging collections"
+ "Tenured collections"
+ "Cards checked"
+ "Cards scanned"
+ "Code literal collections"
+ } swap zip [ nip 0 > ] assoc-filter
+ standard-table-style [
+ [
+ [
+ [ [ write ] with-cell ] [ pprint-cell ] bi*
+ ] with-row
+ ] assoc-each
+ ] tabular-output ;
+
+: stats gc-stats millis prefix ;
: time ( quot -- )
- benchmark
- [ # " ms run / " % # " ms GC time" % ] "" make print flush ;
- inline
+ stats >r call stats r> v- stats. ; inline
gc_time = 0;
aging_collections = 0;
nursery_collections = 0;
+ tenured_collections = 0;
+ cards_checked = 0;
cards_scanned = 0;
+ code_heap_scans = 0;
secure_gc = secure_gc_;
}
}
/* Scan all the objects in the card */
-INLINE void collect_card(F_CARD *ptr, CELL gen, CELL here)
+void collect_card(F_CARD *ptr, CELL gen, CELL here)
{
F_CARD c = *ptr;
CELL offset = (c & CARD_BASE_MASK);
cards_scanned++;
}
-/* Copy all newspace objects referenced from marked cards to the destination */
-INLINE void collect_gen_cards(CELL gen)
+void collect_card_deck(CELL gen,
+ F_CARD *first_card, F_CARD *last_card,
+ F_CARD mask, F_CARD unmask)
{
- F_CARD *ptr = ADDR_TO_CARD(data_heap->generations[gen].start);
CELL here = data_heap->generations[gen].here;
- F_CARD *last_card = ADDR_TO_CARD(here - 1);
- CELL mask, unmask;
+ long long cards_checked_ = 0;
+
+ u32 *quad_ptr;
+ u32 quad_mask = mask | (mask << 8) | (mask << 16) | (mask << 24);
+
+ u32 *last_card_aligned = (u32 *)(((CELL)last_card + 3) & ~3);
+
+ for(quad_ptr = (u32 *)first_card; quad_ptr <= (u32 *)last_card_aligned; quad_ptr++)
+ {
+ cards_checked_ += 4;
+
+ if(*quad_ptr & quad_mask)
+ {
+ F_CARD *ptr = (F_CARD *)quad_ptr;
+
+ int card;
+ for(card = 0; card < 4; card++)
+ {
+ if(ptr[card] & mask)
+ {
+ collect_card(&ptr[card],gen,here);
+ ptr[card] &= ~unmask;
+ }
+ }
+ }
+ }
+
+ cards_checked += cards_checked_;
+}
+
+/* Copy all newspace objects referenced from marked cards to the destination */
+void collect_gen_cards(CELL gen)
+{
+ F_CARD *first_card = ADDR_TO_CARD(data_heap->generations[gen].start);
+ F_CARD *last_card = ADDR_TO_CARD(data_heap->generations[gen].here - 1);
+
+ F_CARD mask, unmask;
/* if we are collecting the nursery, we care about old->nursery pointers
but not old->aging pointers */
return;
}
- for(; ptr <= last_card; ptr++)
- {
- if(*ptr & mask)
- {
- collect_card(ptr,gen,here);
- *ptr &= ~unmask;
- }
- }
+ collect_card_deck(gen,first_card,last_card,mask,unmask);
}
/* Scan cards in all generations older than the one being collected, copying
if(collecting_gen == TENURED)
{
+ tenured_collections++;
GC_PRINT(END_AGING_GC,aging_collections,cards_scanned);
- aging_collections = 0;
- cards_scanned = 0;
}
else if(HAVE_AGING_P && collecting_gen == AGING)
{
aging_collections++;
-
GC_PRINT(END_NURSERY_GC,nursery_collections,cards_scanned);
- nursery_collections = 0;
- cards_scanned = 0;
}
}
else
literals from any code block which gets marked as live.
if we are not doing code GC, just consider all literals
as roots. */
+ code_heap_scans++;
+
collect_literals();
+
if(collecting_accumulation_gen_p())
last_code_heap_scan = collecting_gen;
else
}
/* Push total time spent on GC */
-DEFINE_PRIMITIVE(gc_time)
-{
- box_unsigned_8(gc_time);
+DEFINE_PRIMITIVE(gc_stats)
+{
+ CELL array = tag_object(allot_array(ARRAY_TYPE,7,F));
+ REGISTER_ROOT(array);
+ set_array_nth(untag_object(array),0,tag_bignum(long_long_to_bignum(gc_time)));
+ set_array_nth(untag_object(array),1,allot_cell(nursery_collections));
+ set_array_nth(untag_object(array),2,allot_cell(aging_collections));
+ set_array_nth(untag_object(array),3,allot_cell(tenured_collections));
+ set_array_nth(untag_object(array),4,tag_bignum(long_long_to_bignum(cards_scanned)));
+ set_array_nth(untag_object(array),5,tag_bignum(long_long_to_bignum(cards_checked)));
+ set_array_nth(untag_object(array),6,allot_cell(code_heap_scans));
+ UNREGISTER_ROOT(array);
+ dpush(array);
}
DEFINE_PRIMITIVE(become)
s64 gc_time;
CELL nursery_collections;
CELL aging_collections;
-CELL cards_scanned;
+CELL tenured_collections;
+s64 cards_checked;
+s64 cards_scanned;
+CELL code_heap_scans;
/* only meaningful during a GC */
bool performing_gc;
CELL collect_next(CELL scan);
DECLARE_PRIMITIVE(gc);
-DECLARE_PRIMITIVE(gc_time);
+DECLARE_PRIMITIVE(gc_stats);
DECLARE_PRIMITIVE(become);
CELL find_all_words(void);
primitive_existsp,
primitive_read_dir,
primitive_gc,
- primitive_gc_time,
+ primitive_gc_stats,
primitive_save_image,
primitive_save_image_and_exit,
primitive_datastack,
projects / factor.git / commitdiff