diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 21a49beffc..4aecd1376e 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -523,6 +523,9 @@ M: bad-executable summary \ 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 diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index 82c47a5c84..ee77268e22 100644 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -1,11 +1,10 @@ ! 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 << @@ -105,7 +104,7 @@ FUNCTION: char* ud_lookup_mnemonic ( int c ) ; dup UD_SYN_INTEL ud_set_syntax ; : with-ud ( quot: ( ud -- ) -- ) - [ [ [ ] dip call ] with-destructors ] with-word-entry-points ; inline + [ [ [ ] dip call ] with-destructors ] with-code-blocks ; inline SINGLETON: udis-disassembler diff --git a/basis/tools/disassembler/utils/utils.factor b/basis/tools/disassembler/utils/utils.factor index 60e094ac34..11981c81ae 100644 --- a/basis/tools/disassembler/utils/utils.factor +++ b/basis/tools/disassembler/utils/utils.factor @@ -1,43 +1,20 @@ -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 diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor index 6746031a3d..dd44b24c3e 100644 --- a/basis/tools/memory/memory.factor +++ b/basis/tools/memory/memory.factor @@ -1,10 +1,11 @@ -! 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 { "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 } ; + + ( seq -- code-block ) + 6 firstn-unsafe { + [ ] + [ ] + [ ] + [ code-block-type ] + [ ] + [ tag-bits get shift ] + } spread code-block boa ; inline + +: ( seq -- code-blocks ) + 6 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 ] cache ; inline + +INSTANCE: code-blocks immutable-sequence + +: code-blocks ( -- 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 ; diff --git a/basis/tools/memory/summary.txt b/basis/tools/memory/summary.txt index 71a88d92af..1779522821 100644 --- a/basis/tools/memory/summary.txt +++ b/basis/tools/memory/summary.txt @@ -1 +1 @@ -Heap introspection tools +Data and code heap introspection tools diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 826da41f95..57035860d8 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -506,6 +506,7 @@ 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 )) } { "compact-gc" "memory" "primitive_compact_gc" (( -- )) } { "data-room" "memory" "primitive_data_room" (( -- data-room )) } diff --git a/vm/arrays.cpp b/vm/arrays.cpp index cdfee274c7..0d599a6c96 100644 --- a/vm/arrays.cpp +++ b/vm/arrays.cpp @@ -60,6 +60,19 @@ void factor_vm::primitive_resize_array() ctx->push(tag(reallot_array(a.untagged(),capacity))); } +cell factor_vm::std_vector_to_array(std::vector &elements) +{ + cell element_count = elements.size(); + data_roots.push_back(data_root_range(&elements[0],element_count)); + + tagged objects(allot_uninitialized_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; diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 495b167f11..40fe00b0e9 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -202,4 +202,40 @@ void factor_vm::primitive_strip_stack_traces() each_code_block(stripper); } +struct code_block_accumulator { + std::vector 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()); +} + } diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index f5946d648b..d1809f09ce 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -250,16 +250,7 @@ cell factor_vm::instances(cell type) { 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(objects); + return std_vector_to_array(accum.objects); } void factor_vm::primitive_all_instances() diff --git a/vm/primitives.cpp b/vm/primitives.cpp index f288a796c2..1eedab85b8 100644 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -43,6 +43,7 @@ PRIMITIVE(callstack) PRIMITIVE(callstack_to_array) PRIMITIVE(check_datastack) PRIMITIVE(clone) +PRIMITIVE(code_blocks) PRIMITIVE(code_room) PRIMITIVE(compact_gc) PRIMITIVE(compute_identity_hashcode) diff --git a/vm/primitives.hpp b/vm/primitives.hpp index 1ace3c0f7e..049b44d389 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -39,6 +39,7 @@ DECLARE_PRIMITIVE(callstack) 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) diff --git a/vm/vm.hpp b/vm/vm.hpp index f352f8833d..bdbd465d78 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -348,13 +348,14 @@ struct factor_vm 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 &elements); //strings cell string_nth(const string *str, cell index); @@ -521,11 +522,11 @@ struct factor_vm 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 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); @@ -536,11 +537,8 @@ struct factor_vm code_heap_room code_room(); void primitive_code_room(); void primitive_strip_stack_traces(); - - template void each_code_block(Iterator &iter) - { - code->allocator->iterate(iter); - } + cell code_blocks(); + void primitive_code_blocks(); //callbacks void init_callbacks(cell size);