\ <array> { integer object } { array } define-primitive
\ <array> make-flushable
-\ begin-scan { } { } define-primitive
-
-\ next-object { } { object } define-primitive
-
-\ end-scan { } { } define-primitive
+\ all-instances { } { array } define-primitive
\ size { object } { fixnum } define-primitive
\ size make-flushable
data-room
code-room
}
-"There are a pair of combinators, analogous to " { $link each } " and " { $link filter } ", which operate on the entire collection of objects in the object heap:"
-{ $subsections
- each-object
- instances
-}
+"A combinator to get objects from the heap:"
+{ $subsections instances }
"You can check an object's the heap memory usage:"
{ $subsections size }
"The garbage collector can be invoked manually:"
{ "resize-array" "arrays" (( n array -- newarray )) }
{ "resize-string" "strings" (( n str -- newstr )) }
{ "<array>" "arrays" (( n elt -- array )) }
- { "begin-scan" "memory" (( -- )) }
- { "next-object" "memory" (( -- obj )) }
- { "end-scan" "memory" (( -- )) }
+ { "all-instances" "memory" (( -- array )) }
{ "size" "memory" (( obj -- n )) }
{ "die" "kernel" (( -- )) }
{ "(fopen)" "io.streams.c" (( path mode -- alien )) }
! Create a boot quotation for the target
[
[
- ! Rehash hashtables, since bootstrap.image creates them
- ! using the host image's hashing algorithms. We don't
- ! use each-object here since the catch stack isn't yet
- ! set up.
- gc
- begin-scan
- [ hashtable? ] pusher [ (each-object) ] dip
- end-scan
- [ rehash ] each
+ ! Rehash hashtables first, since bootstrap.image creates
+ ! them using the host image's hashing algorithms.
+ [ hashtable? ] instances [ rehash ] each
boot
] %
"math.integers" require
"math.floats" require
"memory" require
-
+
"io.streams.c" require
"vocabs.loader" require
-
+
"syntax" require
"bootstrap.layouts" require
quotations math ;
IN: memory
-HELP: begin-scan ( -- )
-{ $description "Disables the garbage collector and resets the heap scan pointer to point at the first object in the heap. The " { $link next-object } " word can then be called to advance the heap scan pointer and return successive objects."
-$nl
-"This word must always be paired with a call to " { $link end-scan } "." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: next-object ( -- obj )
-{ $values { "obj" object } }
-{ $description "Outputs the object at the heap scan pointer, and then advances the heap scan pointer. If the end of the heap has been reached, outputs " { $link f } ". This is unambiguous since the " { $link f } " object is tagged immediate and not actually stored in the heap." }
-{ $errors "Throws a " { $link heap-scan-error. } " if called outside a " { $link begin-scan } "/" { $link end-scan } " pair." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: end-scan ( -- )
-{ $description "Finishes a heap iteration by re-enabling the garbage collector. This word must always be paired with a call to " { $link begin-scan } "." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: each-object
-{ $values { "quot" { $quotation "( obj -- )" } } }
-{ $description "Applies a quotation to each object in the heap. The garbage collector is switched off while this combinator runs, so the given quotation must not allocate too much memory." }
-{ $notes "This word is the low-level facility used to implement the " { $link instances } " word." } ;
-
HELP: instances
{ $values { "quot" { $quotation "( obj -- ? )" } } { "seq" "a fresh sequence" } }
-{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." }
-{ $notes "This word relies on " { $link each-object } ", so in particular the garbage collector is switched off while it runs and the given quotation must not allocate too much memory." } ;
+{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." } ;
HELP: gc ( -- )
{ $description "Performs a full garbage collection." } ;
HELP: save
{ $description "Saves a snapshot of the heap to the current image file." } ;
-HELP: count-instances
-{ $values
- { "quot" quotation }
- { "n" integer } }
-{ $description "Applies the predicate quotation to each object in the heap and returns the number of objects that match. Since this word uses " { $link each-object } " with the garbage collector switched off, avoid allocating too much memory in the quotation." }
-{ $examples { $unchecked-example
- "USING: memory words prettyprint ;"
- "[ word? ] count-instances ."
- "24210"
-} } ;
-
ARTICLE: "images" "Images"
"Factor has the ability to save the entire state of the system into an " { $emphasis "image file" } ". The image contains a complete dump of all data and code in the current Factor instance."
{ $subsections
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences vectors arrays system math
+USING: kernel continuations sequences system
io.backend alien.strings memory.private ;
IN: memory
-: (each-object) ( quot: ( obj -- ) -- )
- next-object dup [
- swap [ call ] keep (each-object)
- ] [ 2drop ] if ; inline recursive
-
-: each-object ( quot -- )
- gc begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline
-
-: count-instances ( quot -- n )
- 0 swap [ 1 0 ? + ] compose each-object ; inline
-
: instances ( quot -- seq )
- #! To ensure we don't need to grow the vector while scanning
- #! the heap, we do two scans, the first one just counts the
- #! number of objects that satisfy the predicate.
- [ count-instances 100 + <vector> ] keep swap
- [ [ push-if ] 2curry each-object ] keep >array ; inline
+ [ all-instances ] dip filter ; inline
: save-image ( path -- )
normalize-path native-string>alien (save-image) ;
explicit object_code_block_updater(code_block_visitor<forwarder<code_block> > *visitor_) :
visitor(visitor_) {}
- void operator()(cell obj)
+ void operator()(object *obj)
{
- visitor->visit_object_code_block(tagged<object>(obj).untagged());
+ visitor->visit_object_code_block(obj);
}
};
dpush(tag<byte_array>(byte_array_from_value(&room)));
}
-/* Disables GC and activates next-object ( -- obj ) primitive */
-void factor_vm::begin_scan()
-{
- heap_scan_ptr = data->tenured->first_object();
- gc_off = true;
-}
-
-void factor_vm::end_scan()
-{
- gc_off = false;
-}
-
-void factor_vm::primitive_begin_scan()
-{
- begin_scan();
-}
+struct object_accumulator {
+ cell type;
+ std::vector<cell> objects;
-cell factor_vm::next_object()
-{
- if(!gc_off)
- general_error(ERROR_HEAP_SCAN,false_object,false_object,NULL);
+ explicit object_accumulator(cell type_) : type(type_) {}
- if(heap_scan_ptr)
+ void operator()(object *obj)
{
- cell current = heap_scan_ptr;
- heap_scan_ptr = data->tenured->next_object_after(heap_scan_ptr);
- return tag_dynamic((object *)current);
+ if(type == TYPE_COUNT || obj->h.hi_tag() == type)
+ objects.push_back(tag_dynamic(obj));
}
- else
- return false_object;
-}
+};
-/* Push object at heap scan cursor and advance; pushes f when done */
-void factor_vm::primitive_next_object()
+cell factor_vm::instances(cell type)
{
- dpush(next_object());
-}
+ object_accumulator accum(type);
+ each_object(accum);
+ cell object_count = accum.objects.size();
-/* Re-enables GC */
-void factor_vm::primitive_end_scan()
-{
+ gc_off = true;
+ array *objects = allot_array(object_count,false_object);
+ memcpy(objects->data(),&accum.objects[0],object_count * sizeof(cell));
gc_off = false;
-}
-
-struct word_counter {
- cell count;
-
- explicit word_counter() : count(0) {}
-
- void operator()(cell obj)
- {
- if(tagged<object>(obj).type_p(WORD_TYPE))
- count++;
- }
-};
-struct word_accumulator {
- growable_array words;
-
- explicit word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
+ return tag<array>(objects);
+}
- void operator()(cell obj)
- {
- if(tagged<object>(obj).type_p(WORD_TYPE))
- words.add(obj);
- }
-};
+void factor_vm::primitive_all_instances()
+{
+ primitive_full_gc();
+ dpush(instances(TYPE_COUNT));
+}
cell factor_vm::find_all_words()
{
- word_counter counter;
- each_object(counter);
- word_accumulator accum(counter.count,this);
- each_object(accum);
- accum.words.trim();
- return accum.words.elements.value();
+ return instances(WORD_TYPE);
}
}
explicit object_dumper(factor_vm *parent_, cell type_) :
parent(parent_), type(type_) {}
- void operator()(cell obj)
+ void operator()(object *obj)
{
- if(type == TYPE_COUNT || tagged<object>(obj).type_p(type))
+ if(type == TYPE_COUNT || obj->h.hi_tag() == type)
{
- std::cout << padded_address(obj) << " ";
- parent->print_nested_obj(obj,2);
+ std::cout << padded_address((cell)obj) << " ";
+ parent->print_nested_obj(tag_dynamic(obj),2);
std::cout << std::endl;
}
}
}
struct data_reference_slot_visitor {
- cell look_for, obj;
+ cell look_for;
+ object *obj;
factor_vm *parent;
- explicit data_reference_slot_visitor(cell look_for_, cell obj_, factor_vm *parent_) :
+ explicit data_reference_slot_visitor(cell look_for_, object *obj_, factor_vm *parent_) :
look_for(look_for_), obj(obj_), parent(parent_) { }
void operator()(cell *scan)
{
if(look_for == *scan)
{
- std::cout << padded_address(obj) << " ";
- parent->print_nested_obj(obj,2);
+ std::cout << padded_address((cell)obj) << " ";
+ parent->print_nested_obj(tag_dynamic(obj),2);
std::cout << std::endl;
}
}
explicit data_reference_object_visitor(cell look_for_, factor_vm *parent_) :
look_for(look_for_), parent(parent_) {}
- void operator()(cell obj)
+ void operator()(object *obj)
{
data_reference_slot_visitor visitor(look_for,obj,parent);
- parent->do_slots(UNTAG(obj),visitor);
+ parent->do_slots(obj,visitor);
}
};
else
{
object_fixupper fixupper(this,data_relocation_base);
- do_slots((cell)object,fixupper);
+ do_slots(object,fixupper);
switch(hi_tag)
{
explicit object_become_visitor(slot_visitor<slot_become_visitor> *workhorse_) :
workhorse(workhorse_) {}
- void operator()(cell obj)
+ void operator()(object *obj)
{
- workhorse->visit_slots(tagged<object>(obj).untagged());
+ workhorse->visit_slots(obj);
}
};
/* Since we may have introduced old->new references, need to revisit
all objects on a minor GC. */
data->mark_all_cards();
+ primitive_minor_gc();
/* If a word's definition quotation was in old_objects and the
quotation in new_objects is not compiled, we might leak memory
PRIMITIVE_FORWARD(resize_array)
PRIMITIVE_FORWARD(resize_string)
PRIMITIVE_FORWARD(array)
-PRIMITIVE_FORWARD(begin_scan)
-PRIMITIVE_FORWARD(next_object)
-PRIMITIVE_FORWARD(end_scan)
+PRIMITIVE_FORWARD(all_instances)
PRIMITIVE_FORWARD(size)
PRIMITIVE_FORWARD(die)
PRIMITIVE_FORWARD(fopen)
primitive_resize_array,
primitive_resize_string,
primitive_array,
- primitive_begin_scan,
- primitive_next_object,
- primitive_end_scan,
+ primitive_all_instances,
primitive_size,
primitive_die,
primitive_fopen,
unsigned int signal_fpu_status;
stack_frame *signal_callstack_top;
- /* A heap walk allows useful things to be done, like finding all
- references to an object for debugging purposes. */
- cell heap_scan_ptr;
-
/* GC is off during heap walking */
bool gc_off;
void primitive_data_room();
void begin_scan();
void end_scan();
- void primitive_begin_scan();
- cell next_object();
- void primitive_next_object();
- void primitive_end_scan();
+ cell instances(cell type);
+ void primitive_all_instances();
cell find_all_words();
template<typename Generation, typename Iterator>
cell obj = gen->first_object();
while(obj)
{
- iterator(obj);
+ iterator((object *)obj);
obj = gen->next_object_after(obj);
}
}
/* Every object has a regular representation in the runtime, which makes GC
much simpler. Every slot of the object until binary_payload_start is a pointer
to some other object. */
- template<typename Iterator> void do_slots(cell obj, Iterator &iter)
+ template<typename Iterator> void do_slots(object *obj, Iterator &iter)
{
- cell scan = obj;
- cell payload_start = ((object *)obj)->binary_payload_start();
- cell end = obj + payload_start;
+ cell scan = (cell)obj;
+ cell payload_start = obj->binary_payload_start();
+ cell end = scan + payload_start;
scan += sizeof(cell);
projects / factor.git / commitdiff