\ data-room { } { byte-array } define-primitive
\ data-room make-flushable
+\ (code-blocks) { } { array } define-primitive
+\ (code-blocks) make-flushable
+
\ code-room { } { byte-array } define-primitive
\ code-room make-flushable
! Copyright (C) 2008, 2010 Slava Pestov, Jorge Acereda Macia.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.disassembler namespaces combinators
-alien alien.syntax alien.c-types lexer parser kernel
-sequences layouts math math.order alien.libraries
-math.parser system make fry arrays libc destructors
-tools.disassembler.utils tools.disassembler.private splitting
-alien.data classes.struct ;
+USING: tools.disassembler namespaces combinators alien
+alien.syntax alien.c-types lexer parser kernel sequences layouts
+math math.order alien.libraries math.parser system make fry
+arrays libc destructors tools.memory tools.disassembler.utils
+tools.disassembler.private splitting alien.data classes.struct ;
IN: tools.disassembler.udis
<<
dup UD_SYN_INTEL ud_set_syntax ;
: with-ud ( quot: ( ud -- ) -- )
- [ [ [ <ud> ] dip call ] with-destructors ] with-word-entry-points ; inline
+ [ [ [ <ud> ] dip call ] with-destructors ] with-code-blocks ; inline
SINGLETON: udis-disassembler
-USING: accessors arrays binary-search kernel math math.order
-math.parser namespaces sequences sorting splitting vectors vocabs words ;
+USING: accessors kernel math math.parser prettyprint sequences
+splitting tools.memory ;
IN: tools.disassembler.utils
-SYMBOL: word-entry-points
-SYMBOL: smallest-xt
-SYMBOL: greatest-xt
-
-: (word-entry-points) ( -- assoc )
- vocabs [ words ] map concat [ [ word-code ] keep 3array ] map
- [ first ] sort-with ;
+: 0x ( str -- str' ) "0x" prepend ;
: complete-address ( n seq -- str )
- [ first - ] [ third name>> ] bi
- over zero? [ nip ] [ swap 16 >base "0x" prepend "+" glue ] if ;
+ [ nip owner>> unparse-short ] [ entry-point>> - ] 2bi
+ [ 16 >base 0x " + " glue ] unless-zero ;
-: search-xt ( n -- str/f )
- dup [ smallest-xt get < ] [ greatest-xt get > ] bi or [
- drop f
- ] [
- word-entry-points get over [ swap first <=> ] curry search nip
- 2dup second <= [
- [ complete-address ] [ drop f ] if*
- ] [
- 2drop f
- ] if
- ] if ;
+: search-xt ( addr -- str/f )
+ dup lookup-return-address
+ dup [ complete-address ] [ 2drop f ] if ;
: resolve-xt ( str -- str' )
- [ "0x" prepend ] [ 16 base> ] bi
+ [ 0x ] [ 16 base> ] bi
[ search-xt [ " (" ")" surround append ] when* ] when* ;
: resolve-call ( str -- str' )
"0x" split1-last [ resolve-xt "0x" glue ] when* ;
-
-: with-word-entry-points ( quot -- )
- [
- (word-entry-points)
- [ word-entry-points set ]
- [ first first smallest-xt set ]
- [ last second greatest-xt set ] tri
- call
- ] with-scope ; inline
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs classes classes.struct
-combinators combinators.smart continuations fry generalizations
-generic grouping io io.styles kernel make math math.parser
-math.statistics memory namespaces parser prettyprint sequences
-sorting splitting strings system vm words ;
+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 sorting
+splitting strings system vm words hints hashtables ;
IN: tools.memory
<PRIVATE
{ "Code heap sweep time:" [ [ code-sweep-time>> ] map-sum nanos>string ] }
{ "Compaction time:" [ [ compaction-time>> ] map-sum nanos>string ] }
} object-table. ;
+
+SINGLETONS: +unoptimized+ +optimized+ +profiling+ +pic+ ;
+
+TUPLE: code-block
+{ owner read-only }
+{ parameters read-only }
+{ relocation read-only }
+{ type read-only }
+{ size read-only }
+{ entry-point read-only } ;
+
+TUPLE: code-blocks { blocks sliced-groups } { cache hashtable } ;
+
+<PRIVATE
+
+: code-block-type ( n -- type )
+ { +unoptimized+ +optimized+ +profiling+ +pic+ } nth ;
+
+: <code-block> ( seq -- code-block )
+ 6 firstn-unsafe {
+ [ ]
+ [ ]
+ [ ]
+ [ code-block-type ]
+ [ ]
+ [ tag-bits get shift ]
+ } spread code-block boa ; inline
+
+: <code-blocks> ( seq -- code-blocks )
+ 6 <sliced-groups> H{ } clone \ code-blocks boa ;
+
+SYMBOL: code-heap-start
+SYMBOL: code-heap-end
+
+: in-code-heap? ( address -- ? )
+ code-heap-start get code-heap-end get between? ;
+
+: (lookup-return-address) ( addr seq -- code-block )
+ [ entry-point>> <=> ] with search nip ;
+
+HINTS: (lookup-return-address) code-blocks ;
+
+PRIVATE>
+
+M: code-blocks length blocks>> length ; inline
+
+FROM: sequences.private => nth-unsafe ;
+
+M: code-blocks nth-unsafe
+ [ cache>> ] [ blocks>> ] bi
+ '[ _ nth-unsafe <code-block> ] cache ; inline
+
+INSTANCE: code-blocks immutable-sequence
+
+: code-blocks ( -- blocks )
+ (code-blocks) <code-blocks> ;
+
+: with-code-blocks ( quot -- )
+ [
+ code-blocks
+ [ \ code-blocks set ]
+ [ first entry-point>> code-heap-start set ]
+ [ last [ entry-point>> ] [ size>> ] bi + code-heap-end set ] tri
+ call
+ ] with-scope ; inline
+
+: lookup-return-address ( addr -- code-block )
+ dup in-code-heap?
+ [ \ code-blocks get (lookup-return-address) ] [ drop f ] if ;
-Heap introspection tools
+Data and code heap introspection tools
{ "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 )) }
{ "compact-gc" "memory" "primitive_compact_gc" (( -- )) }
{ "data-room" "memory" "primitive_data_room" (( -- data-room )) }
ctx->push(tag<array>(reallot_array(a.untagged(),capacity)));
}
+cell factor_vm::std_vector_to_array(std::vector<cell> &elements)
+{
+ cell element_count = elements.size();
+ data_roots.push_back(data_root_range(&elements[0],element_count));
+
+ tagged<array> objects(allot_uninitialized_array<array>(element_count));
+ memcpy(objects->data(),&elements[0],element_count * sizeof(cell));
+
+ data_roots.pop_back();
+
+ return objects.value();
+}
+
void growable_array::add(cell elt_)
{
factor_vm *parent = elements.parent;
each_code_block(stripper);
}
+struct code_block_accumulator {
+ std::vector<cell> objects;
+
+ void operator()(code_block *compiled, cell size)
+ {
+ objects.push_back(compiled->owner);
+ objects.push_back(compiled->parameters);
+ objects.push_back(compiled->relocation);
+
+ objects.push_back(tag_fixnum(compiled->type()));
+ objects.push_back(tag_fixnum(compiled->size()));
+
+ /* Note: the entry point is always a multiple of the heap
+ alignment (16 bytes). We cannot allocate while iterating
+ through the code heap, so it is not possible to call allot_cell()
+ here. It is OK, however, to add it as if it were a fixnum, and
+ have library code shift it to the left by 4. */
+ cell entry_point = (cell)compiled->entry_point();
+ assert((entry_point & (data_alignment - 1)) == 0);
+ assert((entry_point & TAG_MASK) == FIXNUM_TYPE);
+ objects.push_back(entry_point);
+ }
+};
+
+cell factor_vm::code_blocks()
+{
+ code_block_accumulator accum;
+ each_code_block(accum);
+ return std_vector_to_array(accum.objects);
+}
+
+void factor_vm::primitive_code_blocks()
+{
+ ctx->push(code_blocks());
+}
+
}
{
object_accumulator accum(type);
each_object(accum);
- cell object_count = accum.objects.size();
-
- data_roots.push_back(data_root_range(&accum.objects[0],object_count));
-
- array *objects = allot_array(object_count,false_object);
- memcpy(objects->data(),&accum.objects[0],object_count * sizeof(cell));
-
- data_roots.pop_back();
-
- return tag<array>(objects);
+ return std_vector_to_array(accum.objects);
}
void factor_vm::primitive_all_instances()
PRIMITIVE(callstack_to_array)
PRIMITIVE(check_datastack)
PRIMITIVE(clone)
+PRIMITIVE(code_blocks)
PRIMITIVE(code_room)
PRIMITIVE(compact_gc)
PRIMITIVE(compute_identity_hashcode)
DECLARE_PRIMITIVE(callstack_to_array)
DECLARE_PRIMITIVE(check_datastack)
DECLARE_PRIMITIVE(clone)
+DECLARE_PRIMITIVE(code_blocks)
DECLARE_PRIMITIVE(code_room)
DECLARE_PRIMITIVE(compact_gc)
DECLARE_PRIMITIVE(compute_identity_hashcode)
void primitive_die();
//arrays
+ inline void set_array_nth(array *array, cell slot, cell value);
array *allot_array(cell capacity, cell fill_);
void primitive_array();
cell allot_array_1(cell obj_);
cell allot_array_2(cell v1_, cell v2_);
cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
void primitive_resize_array();
- inline void set_array_nth(array *array, cell slot, cell value);
+ cell std_vector_to_array(std::vector<cell> &elements);
//strings
cell string_nth(const string *str, cell index);
code_block *add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_);
//code heap
- inline void check_code_pointer(cell ptr)
+ inline void check_code_pointer(cell ptr) { }
+
+ template<typename Iterator> void each_code_block(Iterator &iter)
{
- #ifdef FACTOR_DEBUG
- //assert(in_code_heap_p(ptr));
- #endif
+ code->allocator->iterate(iter);
}
void init_code_heap(cell size);
code_heap_room code_room();
void primitive_code_room();
void primitive_strip_stack_traces();
-
- template<typename Iterator> void each_code_block(Iterator &iter)
- {
- code->allocator->iterate(iter);
- }
+ cell code_blocks();
+ void primitive_code_blocks();
//callbacks
void init_callbacks(cell size);
projects / factor.git / commitdiff