\ (save-image-and-exit) { byte-array } { } define-primitive
-\ data-room { } { array } define-primitive
+\ data-room { } { byte-array } define-primitive
\ data-room make-flushable
-\ code-room { } { array } define-primitive
+\ code-room { } { byte-array } define-primitive
\ code-room make-flushable
\ micros { } { integer } define-primitive
\ strip-stack-traces { } { } define-primitive
\ <callback> { word } { alien } define-primitive
+
+\ enable-gc-events { } { } define-primitive
+\ disable-gc-events { } { object } define-primitive
USING: kernel sequences arrays generic assocs io math
namespaces parser prettyprint strings io.styles words
system sorting splitting grouping math.parser classes memory
-combinators fry ;
+combinators fry vm specialized-arrays accessors continuations
+classes.struct ;
+SPECIALIZED-ARRAY: gc-event
IN: tools.memory
<PRIVATE
dup length 4 > [ 3 cut* "," glue ] when
" KB" append ;
-: fancy-table. ( seq alist -- )
- [ [ nip first ] [ second call( obj -- str ) ] 2bi 2array ] 2map
+: fancy-table. ( obj alist -- )
+ [ [ nip first ] [ second call( obj -- str ) ] 2bi 2array ] with map
simple-table. ;
-: young-room. ( seq -- )
+: copying-room. ( copying-sizes -- )
{
- { "Total:" [ kilobytes ] }
- { "Allocated:" [ kilobytes ] }
- { "Free:" [ kilobytes ] }
+ { "Size:" [ size>> kilobytes ] }
+ { "Occupied:" [ occupied>> kilobytes ] }
+ { "Free:" [ free>> kilobytes ] }
} fancy-table. ;
-: nursery-room. ( seq -- ) "- Nursery space" print young-room. ;
+: nursery-room. ( data-room -- )
+ "- Nursery space" print nursery>> copying-room. ;
-: aging-room. ( seq -- ) "- Aging space" print young-room. ;
+: aging-room. ( data-room -- )
+ "- Aging space" print aging>> copying-room. ;
-: mark-sweep-table. ( sizes -- )
+: mark-sweep-table. ( mark-sweep-sizes -- )
{
- { "Total:" [ kilobytes ] }
- { "Allocated:" [ kilobytes ] }
- { "Total free:" [ kilobytes ] }
- { "Contiguous free:" [ kilobytes ] }
- { "Free list entries:" [ number>string ] }
+ { "Size:" [ size>> kilobytes ] }
+ { "Occupied:" [ occupied>> kilobytes ] }
+ { "Total free:" [ total-free>> kilobytes ] }
+ { "Contiguous free:" [ contiguous-free>> kilobytes ] }
+ { "Free block count:" [ free-block-count>> number>string ] }
} fancy-table. ;
-: tenured-room. ( seq -- ) "- Tenured space" print mark-sweep-table. ;
+: tenured-room. ( data-room -- )
+ "- Tenured space" print tenured>> mark-sweep-table. ;
-: misc-room. ( seq -- )
+: misc-room. ( data-room -- )
"- Miscellaneous buffers" print
{
- { "Card array:" [ kilobytes ] }
- { "Deck array:" [ kilobytes ] }
- { "Mark stack:" [ kilobytes ] }
+ { "Card array:" [ cards>> kilobytes ] }
+ { "Deck array:" [ decks>> kilobytes ] }
+ { "Mark stack:" [ mark-stack>> kilobytes ] }
} fancy-table. ;
: data-room. ( -- )
"==== DATA HEAP" print nl
- data-room
- 3 cut [ nursery-room. nl ] dip
- 3 cut [ aging-room. nl ] dip
- 5 cut [ tenured-room. nl ] dip
- misc-room. ;
+ data-room data-heap-room memory>struct {
+ [ nursery-room. nl ]
+ [ aging-room. nl ]
+ [ tenured-room. nl ]
+ [ misc-room. ]
+ } cleave ;
: code-room. ( -- )
"==== CODE HEAP" print nl
- code-room mark-sweep-table. ;
+ code-room mark-sweep-sizes memory>struct mark-sweep-table. ;
+
+PRIVATE>
+
+: room. ( -- ) data-room. nl code-room. ;
+
+<PRIVATE
: heap-stat-step ( obj counts sizes -- )
[ [ class ] dip inc-at ]
PRIVATE>
-: room. ( -- ) data-room. nl code-room. ;
-
: heap-stats ( -- counts sizes )
[ ] instances H{ } clone H{ } clone
[ '[ _ _ heap-stat-step ] each ] 2keep ;
] with-row
] 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 ;
USING: classes.struct alien.c-types alien.syntax ;
IN: vm
-TYPEDEF: void* cell
+TYPEDEF: intptr_t cell
C-TYPE: context
STRUCT: zone
{ userenv cell[70] } ;
: vm-field-offset ( field -- offset ) vm offset-of ; inline
+
+C-ENUM:
+collect-nursery-op
+collect-aging-op
+collect-to-tenured-op
+collect-full-op
+collect-compact-op
+collect-growing-heap-op ;
+
+STRUCT: gc-event
+{ op uint }
+{ nursery-size-before cell }
+{ aging-size-before cell }
+{ tenured-size-before cell }
+{ tenured-free-block-count-before cell }
+{ code-size-before cell }
+{ code-free-block-count-before cell }
+{ nursery-size-after cell }
+{ aging-size-after cell }
+{ tenured-size-after cell }
+{ tenured-free-block-count-after cell }
+{ code-size-after cell }
+{ code-free-block-count-after cell }
+{ cards-scanned cell }
+{ decks-scanned cell }
+{ code-blocks-scanned cell }
+{ start-time ulonglong }
+{ total-time cell }
+{ card-scan-time cell }
+{ code-scan-time cell }
+{ data-sweep-time cell }
+{ code-sweep-time cell }
+{ compaction-time cell } ;
+
+STRUCT: copying-sizes
+{ size cell }
+{ occupied cell }
+{ free cell } ;
+
+STRUCT: mark-sweep-sizes
+{ size cell }
+{ occupied cell }
+{ total-free cell }
+{ contiguous-free cell }
+{ free-block-count cell } ;
+
+STRUCT: data-heap-room
+{ nursery copying-sizes }
+{ aging copying-sizes }
+{ tenured mark-sweep-sizes }
+{ cards cell }
+{ decks cell }
+{ mark-stack cell } ;
{ "set-retainstack" "kernel" (( rs -- )) }
{ "set-callstack" "kernel" (( cs -- )) }
{ "exit" "system" (( n -- )) }
- { "data-room" "memory" (( -- cards decks generations )) }
- { "code-room" "memory" (( -- code-total code-used code-free largest-free-block )) }
+ { "data-room" "memory" (( -- data-room )) }
+ { "code-room" "memory" (( -- code-room )) }
{ "micros" "system" (( -- us )) }
{ "modify-code-heap" "compiler.units" (( alist -- )) }
{ "(dlopen)" "alien.libraries" (( path -- dll )) }
{ "vm-ptr" "vm" (( -- ptr )) }
{ "strip-stack-traces" "kernel.private" (( -- )) }
{ "<callback>" "alien" (( word -- alien )) }
+ { "enable-gc-events" "memory" (( -- )) }
+ { "disable-gc-events" "memory" (( -- events )) }
} [ [ first3 ] dip swap make-primitive ] each-index
! Bump build number
void trim();
};
+template<typename T> byte_array *factor_vm::byte_array_from_value(T *value)
+{
+ return byte_array_from_values(value,1);
+}
+
+template<typename T> byte_array *factor_vm::byte_array_from_values(T *values, cell len)
+{
+ cell size = sizeof(T) * len;
+ byte_array *data = allot_uninitialized_array<byte_array>(size);
+ memcpy(data->data<char>(),values,size);
+ return data;
+}
+
}
update_code_heap_words();
}
-/* Push the free space and total size of the code heap */
void factor_vm::primitive_code_room()
{
- growable_array a(this);
+ code_heap_room room;
- a.add(tag_fixnum(code->allocator->size));
- a.add(tag_fixnum(code->allocator->occupied_space()));
- a.add(tag_fixnum(code->allocator->free_space()));
- a.add(tag_fixnum(code->allocator->free_blocks.largest_free_block()));
- a.add(tag_fixnum(code->allocator->free_blocks.free_block_count));
+ room.size = code->allocator->size;
+ room.occupied_space = code->allocator->occupied_space();
+ room.total_free = code->allocator->free_space();
+ room.contiguous_free = code->allocator->free_blocks.largest_free_block();
+ room.free_block_count = code->allocator->free_blocks.free_block_count;
- a.trim();
- dpush(a.elements.value());
+ dpush(tag<byte_array>(byte_array_from_value(&room)));
}
struct stack_trace_stripper {
void code_heap_free(code_block *compiled);
};
+struct code_heap_room {
+ cell size;
+ cell occupied_space;
+ cell total_free;
+ cell contiguous_free;
+ cell free_block_count;
+};
+
}
box_unsigned_cell(object_size(dpop()));
}
-/* Push memory usage statistics in data heap */
void factor_vm::primitive_data_room()
{
- growable_array a(this);
-
- a.add(tag_fixnum(nursery.size));
- a.add(tag_fixnum(nursery.occupied_space()));
- a.add(tag_fixnum(nursery.free_space()));
-
- a.add(tag_fixnum(data->aging->size));
- a.add(tag_fixnum(data->aging->occupied_space()));
- a.add(tag_fixnum(data->aging->free_space()));
-
- a.add(tag_fixnum(data->tenured->size));
- a.add(tag_fixnum(data->tenured->occupied_space()));
- a.add(tag_fixnum(data->tenured->free_space()));
- a.add(tag_fixnum(data->tenured->free_blocks.largest_free_block()));
- a.add(tag_fixnum(data->tenured->free_blocks.free_block_count));
-
- a.add(tag_fixnum(data->cards_end - data->cards));
- a.add(tag_fixnum(data->decks_end - data->decks));
- a.add(tag_fixnum(data->tenured->mark_stack.capacity()));
-
- a.trim();
- dpush(a.elements.value());
+ data_heap_room room;
+
+ room.nursery_size = nursery.size;
+ room.nursery_occupied = nursery.occupied_space();
+ room.nursery_free = nursery.free_space();
+ room.aging_size = data->aging->size;
+ room.aging_occupied = data->aging->occupied_space();
+ room.aging_free = data->aging->free_space();
+ room.tenured_size = data->tenured->size;
+ room.tenured_occupied = data->tenured->occupied_space();
+ room.tenured_total_free = data->tenured->free_space();
+ room.tenured_contiguous_free = data->tenured->free_blocks.largest_free_block();
+ room.tenured_free_block_count = data->tenured->free_blocks.free_block_count;
+ room.cards = data->cards_end - data->cards;
+ room.decks = data->decks_end - data->decks;
+ room.mark_stack = data->tenured->mark_stack.capacity();
+
+ dpush(tag<byte_array>(byte_array_from_value(&room)));
}
/* Disables GC and activates next-object ( -- obj ) primitive */
void reset_generation(tenured_space *gen);
};
+struct data_heap_room {
+ cell nursery_size;
+ cell nursery_occupied;
+ cell nursery_free;
+ cell aging_size;
+ cell aging_occupied;
+ cell aging_free;
+ cell tenured_size;
+ cell tenured_occupied;
+ cell tenured_total_free;
+ cell tenured_contiguous_free;
+ cell tenured_free_block_count;
+ cell cards;
+ cell decks;
+ cell mark_stack;
+};
+
}
event = NULL;
}
-void gc_state::start_again(gc_op op_, factor_vm *parent)
+void factor_vm::end_gc()
{
- event->ended_gc(parent);
- if(parent->verbose_gc) std::cout << event << std::endl;
- delete event;
- event = new gc_event(op_,parent);
- op = op_;
+ current_gc->event->ended_gc(this);
+ if(verbose_gc) std::cout << current_gc->event << std::endl;
+ if(gc_events) gc_events->push_back(*current_gc->event);
+ delete current_gc->event;
+ current_gc->event = NULL;
+}
+
+void factor_vm::start_gc_again()
+{
+ end_gc();
+
+ switch(current_gc->op)
+ {
+ case collect_nursery_op:
+ current_gc->op = collect_aging_op;
+ break;
+ case collect_aging_op:
+ 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:
+ critical_error("Bad GC op",current_gc->op);
+ break;
+ }
+
+ current_gc->event = new gc_event(current_gc->op,this);
}
void factor_vm::update_code_heap_for_minor_gc(std::set<code_block *> *remembered_set)
if(setjmp(current_gc->gc_unwind))
{
/* We come back here if a generation is full */
- switch(current_gc->op)
- {
- case collect_nursery_op:
- current_gc->start_again(collect_aging_op,this);
- break;
- case collect_aging_op:
- current_gc->start_again(collect_to_tenured_op,this);
- break;
- case collect_to_tenured_op:
- current_gc->start_again(collect_full_op,this);
- break;
- case collect_full_op:
- case collect_compact_op:
- current_gc->start_again(collect_growing_heap_op,this);
- break;
- default:
- critical_error("Bad GC op",current_gc->op);
- break;
- }
+ start_gc_again();
}
switch(current_gc->op)
break;
}
- current_gc->event->ended_gc(this);
-
- if(verbose_gc) std::cout << current_gc->event << std::endl;
+ end_gc();
delete current_gc;
current_gc = NULL;
return obj;
}
+void factor_vm::primitive_enable_gc_events()
+{
+ gc_events = new std::vector<gc_event>();
+}
+
+void factor_vm::primitive_disable_gc_events()
+{
+ if(gc_events)
+ {
+ byte_array *data = byte_array_from_values(&gc_events->front(),gc_events->size());
+ dpush(tag<byte_array>(data));
+
+ delete gc_events;
+ gc_events = NULL;
+ }
+ else
+ dpush(false_object);
+}
+
}
PRIMITIVE_FORWARD(vm_ptr)
PRIMITIVE_FORWARD(strip_stack_traces)
PRIMITIVE_FORWARD(callback)
+PRIMITIVE_FORWARD(enable_gc_events)
+PRIMITIVE_FORWARD(disable_gc_events)
const primitive_type primitives[] = {
primitive_bignum_to_fixnum,
primitive_vm_ptr,
primitive_strip_stack_traces,
primitive_callback,
+ primitive_enable_gc_events,
+ primitive_disable_gc_events,
};
}
profiling_p(false),\r
gc_off(false),\r
current_gc(NULL),\r
+ gc_events(NULL),\r
fep_disabled(false),\r
full_output(false)\r
{ }\r
/* Only set if we're performing a GC */
gc_state *current_gc;
+ /* If not NULL, we push GC events here */
+ std::vector<gc_event> *gc_events;
+
/* If a runtime function needs to call another function which potentially
allocates memory, it must wrap any local variable references to Factor
objects in gc_root instances */
}
// gc
+ void end_gc();
+ void start_gc_again();
void update_code_heap_for_minor_gc(std::set<code_block *> *remembered_set);
void collect_nursery();
void collect_aging();
void primitive_become();
void inline_gc(cell *gc_roots_base, cell gc_roots_size);
object *allot_object(header header, cell size);
+ void primitive_enable_gc_events();
+ void primitive_disable_gc_events();
template<typename Type> Type *allot(cell size)
{
void primitive_uninitialized_byte_array();
void primitive_resize_byte_array();
+ template<typename T> byte_array *byte_array_from_value(T *value);
+ template<typename T> byte_array *byte_array_from_values(T *values, cell len);
+
//tuples
tuple *allot_tuple(cell layout_);
void primitive_tuple();
projects / factor.git / commitdiff