Merge remote-tracking branch 'upstream/master'

db4
John Benediktsson 2011-09-06 09:32:48 -07:00
commit b6bd35fd4b
18 changed files with 179 additions and 100 deletions

View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2010 Slava Pestov, Daniel Ehrenberg.
! Copyright (C) 2004, 2011 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors alien.private arrays
byte-arrays classes continuations.private effects generic
@ -10,7 +10,7 @@ quotations.private sbufs sbufs.private sequences
sequences.private slots.private strings strings.private system
threads.private classes.tuple classes.tuple.private vectors
vectors.private words words.private definitions assocs summary
compiler.units system.private combinators
compiler.units system.private combinators tools.memory.private
combinators.short-circuit locals locals.backend locals.types
combinators.private stack-checker.values generic.single
generic.single.private alien.libraries tools.dispatch.private
@ -348,13 +348,13 @@ M: object infer-call* \ call bad-macro-input ;
\ callstack-for { c-ptr } { callstack } define-primitive \ callstack make-flushable
\ callstack>array { callstack } { array } define-primitive \ callstack>array make-flushable
\ check-datastack { array integer integer } { object } define-primitive \ check-datastack make-flushable
\ code-room { } { byte-array } define-primitive \ code-room make-flushable
\ (code-room) { } { byte-array } define-primitive \ (code-room) make-flushable
\ compact-gc { } { } define-primitive
\ compute-identity-hashcode { object } { } define-primitive
\ context-object { fixnum } { object } define-primitive \ context-object make-flushable
\ context-object-for { fixnum c-ptr } { object } define-primitive \ context-object-for make-flushable
\ current-callback { } { fixnum } define-primitive \ current-callback make-flushable
\ data-room { } { byte-array } define-primitive \ data-room make-flushable
\ (data-room) { } { byte-array } define-primitive \ (data-room) make-flushable
\ datastack { } { array } define-primitive \ datastack make-flushable
\ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable
\ die { } { } define-primitive

View File

@ -48,3 +48,11 @@ HELP: gc-summary.
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." } ;
HELP: data-room
{ $values { "data-heap-room" data-heap-room } }
{ $description "Queries the VM for memory usage information." } ;
HELP: code-room
{ $values { "mark-sweep-sizes" mark-sweep-sizes } }
{ $description "Queries the VM for memory usage information." } ;

View File

@ -1,12 +1,11 @@
! Copyright (C) 2005, 2010 Slava Pestov.
! Copyright (C) 2005, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs binary-search classes
classes.struct combinators combinators.smart continuations fry
generalizations generic grouping io io.styles kernel make math
math.order math.parser math.statistics memory memory.private
layouts namespaces parser prettyprint sequences
sequences.generalizations sorting splitting strings system vm
words hints hashtables ;
math.order math.parser math.statistics memory layouts namespaces
parser prettyprint sequences sequences.generalizations sorting
splitting strings system vm words hints hashtables ;
IN: tools.memory
<PRIVATE
@ -58,9 +57,12 @@ IN: tools.memory
PRIVATE>
: data-room ( -- data-heap-room )
(data-room) data-heap-room memory>struct ;
: data-room. ( -- )
"== Data heap ==" print nl
data-room data-heap-room memory>struct {
data-room {
[ nursery-room. nl ]
[ aging-room. nl ]
[ tenured-room. nl ]
@ -286,9 +288,12 @@ INSTANCE: code-blocks immutable-sequence
PRIVATE>
: code-room ( -- mark-sweep-sizes )
(code-room) mark-sweep-sizes memory>struct ;
: code-room. ( -- )
"== Code heap ==" print nl
code-room mark-sweep-sizes memory>struct mark-sweep-table. nl
code-room mark-sweep-table. nl
code-blocks code-block-stats code-block-table. ;
: room. ( -- )

View File

@ -103,6 +103,7 @@ call( -- )
"system.private"
"threads.private"
"tools.dispatch.private"
"tools.memory.private"
"tools.profiler.private"
"words"
"words.private"
@ -515,12 +516,12 @@ tuple
{ "float>bignum" "math.private" "primitive_float_to_bignum" (( x -- y )) }
{ "float>fixnum" "math.private" "primitive_float_to_fixnum" (( x -- y )) }
{ "all-instances" "memory" "primitive_all_instances" (( -- array )) }
{ "(code-blocks)" "memory.private" "primitive_code_blocks" (( -- array )) }
{ "code-room" "memory" "primitive_code_room" (( -- code-room )) }
{ "(code-blocks)" "tools.memory.private" "primitive_code_blocks" (( -- array )) }
{ "(code-room)" "tools.memory.private" "primitive_code_room" (( -- code-room )) }
{ "compact-gc" "memory" "primitive_compact_gc" (( -- )) }
{ "data-room" "memory" "primitive_data_room" (( -- data-room )) }
{ "disable-gc-events" "memory" "primitive_disable_gc_events" (( -- events )) }
{ "enable-gc-events" "memory" "primitive_enable_gc_events" (( -- )) }
{ "(data-room)" "tools.memory.private" "primitive_data_room" (( -- data-room )) }
{ "disable-gc-events" "tools.memory.private" "primitive_disable_gc_events" (( -- events )) }
{ "enable-gc-events" "tools.memory.private" "primitive_enable_gc_events" (( -- )) }
{ "gc" "memory" "primitive_full_gc" (( -- )) }
{ "minor-gc" "memory" "primitive_minor_gc" (( -- )) }
{ "size" "memory" "primitive_size" (( obj -- n )) }

View File

@ -9,14 +9,6 @@ HELP: instances
HELP: gc ( -- )
{ $description "Performs a full garbage collection." } ;
HELP: data-room ( -- data-room )
{ $values { "data-room" data-room } }
{ $description "Queries the VM for memory usage information." } ;
HELP: code-room ( -- code-room )
{ $values { "code-room" code-room } }
{ $description "Queries the VM for memory usage information." } ;
HELP: size ( obj -- n )
{ $values { "obj" "an object" } { "n" "a size in bytes" } }
{ $description "Outputs the size of the object in memory, in bytes. Tagged immediate objects such as fixnums and " { $link f } " will yield a size of 0." } ;

View File

@ -1,34 +1,56 @@
USING: generic kernel kernel.private math memory prettyprint io
sequences tools.test words namespaces layouts classes
classes.builtin arrays quotations io.launcher system ;
USING: accessors kernel kernel.private math memory prettyprint
io sequences tools.test words namespaces layouts classes
classes.builtin arrays quotations system ;
FROM: tools.memory => data-room code-room ;
IN: memory.tests
[ save-image-and-exit ] must-fail
! Tests for 'instances'
[ [ ] instances ] must-infer
2 [ [ [ 3 throw ] instances ] must-fail ] times
! Tests for 'become'
[ ] [ { } { } become ] unit-test
! LOL
[ ] [
vm
"-i=" image append
"-generations=2"
"-e=USING: memory io prettyprint system ; input-stream gc . 0 exit"
4array try-process
] unit-test
! Bug found on Windows build box, having too many words in the
! image breaks 'become'
[ ] [ 100000 [ f <uninterned-word> ] replicate { } { } become drop ] unit-test
[ [ ] instances ] must-infer
! Code GC wasn't kicking in when needed
! Bug: code heap collection had to be done when data heap was
! full, not just when code heap was full. If the code heap
! contained dead code blocks referring to large data heap
! objects, those large objects would continue to live on even
! if the code blocks were not reachable, as long as the code
! heap did not fill up.
: leak-step ( -- ) 800000 f <array> 1quotation call( -- obj ) drop ;
: leak-loop ( -- ) 100 [ leak-step ] times ;
[ ] [ leak-loop ] unit-test
TUPLE: testing x y z ;
! Bug: allocation of large objects directly into tenured space
! can proceed past the high water mark.
!
! Suppose the nursery and aging spaces are mostly comprised of
! reachable objects. When doing a full GC, objects from young
! generations ere promoted *before* unreachable objects in
! tenured space are freed by the sweep phase. So if large object
! allocation filled up the heap past the high water mark, this
! promotion might trigger heap growth, even if most of those
! large objects are unreachable.
SYMBOL: foo
[ save-image-and-exit ] must-fail
[ ] [
gc
! Erg's bug
2 [ [ [ 3 throw ] instances ] must-fail ] times
data-room tenured>> size>>
! Bug found on Windows build box, having too many words in the image breaks 'become'
[ ] [ 100000 [ f <uninterned-word> ] replicate { } { } become drop ] unit-test
10 [
4 [ 120 1024 * f <array> ] replicate foo set-global
100 [ 256 1024 * f <array> drop ] times
] times
data-room tenured>> size>>
assert=
] unit-test

View File

@ -2,11 +2,13 @@ USING: tools.deploy.config ;
H{
{ deploy-name "Bunny" }
{ deploy-ui? t }
{ deploy-help? f }
{ deploy-c-types? f }
{ deploy-console? t }
{ deploy-unicode? f }
{ "stop-after-last-window?" t }
{ deploy-io 3 }
{ deploy-reflection 2 }
{ deploy-reflection 1 }
{ deploy-word-props? f }
{ deploy-math? t }
{ deploy-threads? t }

View File

@ -0,0 +1,37 @@
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types classes.struct game.loop
game.loop.private kernel sequences specialized-vectors
tools.time.struct ;
IN: game.loop.benchmark
STRUCT: game-loop-benchmark
{ benchmark-data-pair benchmark-data-pair }
{ tick# ulonglong }
{ frame# ulonglong } ;
SPECIALIZED-VECTOR: game-loop-benchmark
: <game-loop-benchmark> ( benchmark-data-pair tick frame -- obj )
\ game-loop-benchmark <struct>
swap >>frame#
swap >>tick#
swap >>benchmark-data-pair ; inline
: ensure-benchmark-data ( loop -- vector )
dup benchmark-data>> [
game-loop-benchmark-vector{ } clone
>>benchmark-data
] unless
benchmark-data>> ; inline
M: game-loop record-benchmarking ( loop quot: ( loop -- benchmark-data-pair ) -- )
[
[ [ call( loop -- ) ] with-benchmarking ]
[ drop tick#>> ]
[ drop frame#>> ]
2tri
<game-loop-benchmark>
]
[ drop ensure-benchmark-data ]
2bi push ;

View File

@ -1,9 +1,8 @@
! (c)2009 Joe Groff bsd license
USING: accessors timers alien.c-types calendar classes.struct
continuations destructors fry kernel math math.order memory
namespaces sequences specialized-vectors system
ui ui.gadgets.worlds vm vocabs.loader arrays
tools.time.struct locals ;
namespaces sequences system ui ui.gadgets.worlds vm
vocabs.loader arrays locals ;
IN: game.loop
TUPLE: game-loop
@ -17,19 +16,6 @@ TUPLE: game-loop
draw-timer
benchmark-data ;
STRUCT: game-loop-benchmark
{ benchmark-data-pair benchmark-data-pair }
{ tick# ulonglong }
{ frame# ulonglong } ;
SPECIALIZED-VECTOR: game-loop-benchmark
: <game-loop-benchmark> ( benchmark-data-pair tick frame -- obj )
\ game-loop-benchmark <struct>
swap >>frame#
swap >>tick#
swap >>benchmark-data-pair ; inline
GENERIC: tick* ( delegate -- )
GENERIC: draw* ( tick-slice delegate -- )
@ -48,26 +34,24 @@ TUPLE: game-loop-error game-loop error ;
<PRIVATE
: record-benchmarking ( benchark-data-pair loop -- )
[ tick#>> ]
[ frame#>> <game-loop-benchmark> ]
[ benchmark-data>> ] tri push ;
: last-tick-percent-offset ( loop -- float )
[ draw-timer>> iteration-start-nanos>> nano-count swap - ]
[ tick-interval-nanos>> ] bi /f 1.0 min ;
GENERIC# record-benchmarking 1 ( loop quot -- )
M: object record-benchmarking
call( loop -- ) ;
: redraw ( loop -- )
[ 1 + ] change-frame#
[
[ last-tick-percent-offset ] [ draw-delegate>> ] bi
[ draw* ] with-benchmarking
] keep record-benchmarking ;
draw*
] record-benchmarking ;
: tick ( loop -- )
[
[ tick-delegate>> tick* ] with-benchmarking
] keep record-benchmarking ;
[ tick-delegate>> tick* ] record-benchmarking ;
: increment-tick ( loop -- )
[ 1 + ] change-tick#
@ -105,9 +89,7 @@ PRIVATE>
[ tick-timer>> ] [ draw-timer>> ] bi [ stop-timer ] bi@ ;
: <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
f 0 0 f f
game-loop-benchmark-vector{ } clone
game-loop boa ;
f 0 0 f f f game-loop boa ;
: <game-loop> ( tick-interval-nanos delegate -- loop )
dup <game-loop*> ; inline
@ -116,3 +98,4 @@ M: game-loop dispose
stop-loop ;
{ "game.loop" "prettyprint" } "game.loop.prettyprint" require-when
{ "game.loop" "tools.memory" } "game.loop.benchmark" require-when

View File

@ -0,0 +1 @@
unix

View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types classes.struct kernel memory
system vm ;
tools.memory system vm ;
IN: tools.time.struct
STRUCT: benchmark-data

View File

@ -14,10 +14,8 @@ void factor_vm::collect_aging()
/* Promote objects referenced from tenured space to tenured space, copy
everything else to the aging semi-space, and reset the nursery pointer. */
{
/* Change the op so that if we fail here, we proceed to a full
tenured collection. We are collecting to tenured space, and
cards were unmarked, so we can't proceed with a to_tenured
collection. */
/* Change the op so that if we fail here, an assertion will be
raised. */
current_gc->op = collect_to_tenured_op;
to_tenured_collector collector(this);

View File

@ -330,14 +330,22 @@ void factor_vm::collect_compact(bool trace_contexts_p)
{
collect_mark_impl(trace_contexts_p);
collect_compact_impl(trace_contexts_p);
if(data->high_fragmentation_p())
{
/* Compaction did not free up enough memory. Grow the heap. */
set_current_gc_op(collect_growing_heap_op);
collect_growing_heap(0,trace_contexts_p);
}
code->flush_icache();
}
void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p)
void factor_vm::collect_growing_heap(cell requested_size, bool trace_contexts_p)
{
/* Grow the data heap and copy all live objects to the new heap. */
data_heap *old = data;
set_data_heap(data->grow(requested_bytes));
set_data_heap(data->grow(requested_size));
collect_mark_impl(trace_contexts_p);
collect_compact_code_impl(trace_contexts_p);
code->flush_icache();

View File

@ -100,12 +100,12 @@ void data_heap::reset_generation(tenured_space *gen)
bool data_heap::high_fragmentation_p()
{
return (tenured->largest_free_block() <= nursery->size + aging->size);
return (tenured->largest_free_block() <= high_water_mark());
}
bool data_heap::low_memory_p()
{
return (tenured->free_space() <= nursery->size + aging->size);
return (tenured->free_space() <= high_water_mark());
}
void data_heap::mark_all_cards()

View File

@ -32,6 +32,9 @@ struct data_heap {
bool high_fragmentation_p();
bool low_memory_p();
void mark_all_cards();
cell high_water_mark() {
return nursery->size + aging->size;
}
};
struct data_heap_room {

View File

@ -112,11 +112,14 @@ void factor_vm::collect_full(bool trace_contexts_p)
if(data->low_memory_p())
{
/* Full GC did not free up enough memory. Grow the heap. */
set_current_gc_op(collect_growing_heap_op);
collect_growing_heap(0,trace_contexts_p);
}
else if(data->high_fragmentation_p())
{
/* Enough free memory, but it is not contiguous. Perform a
compaction. */
set_current_gc_op(collect_compact_op);
collect_compact_impl(trace_contexts_p);
}

View File

@ -116,19 +116,19 @@ void factor_vm::start_gc_again()
switch(current_gc->op)
{
case collect_nursery_op:
/* Nursery collection can fail if aging does not have enough
free space to fit all live objects from nursery. */
current_gc->op = collect_aging_op;
break;
case collect_aging_op:
/* Aging collection can fail if the aging semispace cannot fit
all the live objects from the other aging semispace and the
nursery. */
current_gc->op = collect_to_tenured_op;
break;
case collect_to_tenured_op:
current_gc->op = collect_full_op;
break;
case collect_full_op:
case collect_compact_op:
current_gc->op = collect_growing_heap_op;
break;
default:
/* Nothing else should fail mid-collection due to insufficient
space in the target generation. */
critical_error("Bad GC op",current_gc->op);
break;
}
@ -143,15 +143,21 @@ void factor_vm::set_current_gc_op(gc_op op)
if(gc_events) current_gc->event->op = op;
}
void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
void factor_vm::gc(gc_op op, cell requested_size, bool trace_contexts_p)
{
assert(!gc_off);
assert(!current_gc);
/* Important invariant: tenured space must have enough contiguous free
space to fit the entire contents of the aging space and nursery. This is
because when doing a full collection, objects from younger generations
are promoted before any unreachable tenured objects are freed. */
assert(!data->high_fragmentation_p());
current_gc = new gc_state(op,this);
/* Keep trying to GC higher and higher generations until we don't run out
of space */
/* Keep trying to GC higher and higher generations until we don't run
out of space in the target generation. */
for(;;)
{
try
@ -164,17 +170,23 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
collect_nursery();
break;
case collect_aging_op:
/* We end up here if the above fails. */
collect_aging();
if(data->high_fragmentation_p())
{
/* Change GC op so that if we fail again,
we crash. */
set_current_gc_op(collect_full_op);
collect_full(trace_contexts_p);
}
break;
case collect_to_tenured_op:
/* We end up here if the above fails. */
collect_to_tenured();
if(data->high_fragmentation_p())
{
/* Change GC op so that if we fail again,
we crash. */
set_current_gc_op(collect_full_op);
collect_full(trace_contexts_p);
}
@ -186,7 +198,7 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
collect_compact(trace_contexts_p);
break;
case collect_growing_heap_op:
collect_growing_heap(requested_bytes,trace_contexts_p);
collect_growing_heap(requested_size,trace_contexts_p);
break;
default:
critical_error("Bad GC op",current_gc->op);
@ -197,7 +209,7 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
}
catch(const must_start_gc_again &)
{
/* We come back here if a generation is full */
/* We come back here if the target generation is full. */
start_gc_again();
continue;
}
@ -207,6 +219,9 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
delete current_gc;
current_gc = NULL;
/* Check the invariant again, just in case. */
assert(!data->high_fragmentation_p());
}
/* primitive_minor_gc() is invoked by inline GC checks, and it needs to fill in
@ -283,12 +298,13 @@ void factor_vm::primitive_compact_gc()
object *factor_vm::allot_large_object(cell type, cell size)
{
/* If tenured space does not have enough room, collect and compact */
if(!data->tenured->can_allot_p(size))
cell requested_size = size + data->high_water_mark();
if(!data->tenured->can_allot_p(requested_size))
{
primitive_compact_gc();
/* If it still won't fit, grow the heap */
if(!data->tenured->can_allot_p(size))
if(!data->tenured->can_allot_p(requested_size))
{
gc(collect_growing_heap_op,
size, /* requested size */

View File

@ -314,8 +314,8 @@ struct factor_vm
void collect_compact_impl(bool trace_contexts_p);
void collect_compact_code_impl(bool trace_contexts_p);
void collect_compact(bool trace_contexts_p);
void collect_growing_heap(cell requested_bytes, bool trace_contexts_p);
void gc(gc_op op, cell requested_bytes, bool trace_contexts_p);
void collect_growing_heap(cell requested_size, bool trace_contexts_p);
void gc(gc_op op, cell requested_size, bool trace_contexts_p);
void scrub_context(context *ctx);
void scrub_contexts();
void primitive_minor_gc();