From dd45011141ea99496255dd6001ebeed71f9869c8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 29 Aug 2004 07:20:19 +0000 Subject: [PATCH] improved CPU profiler; memory profiler --- TODO.FACTOR.txt | 1 + library/cross-compiler.factor | 10 +++- library/image.factor | 4 +- library/platform/native/debugger.factor | 2 +- library/platform/native/parse-syntax.factor | 12 +++-- library/platform/native/profiler.factor | 58 ++++++++++++++++----- native/bignum.h | 8 +-- native/factor.h | 2 +- native/gc.c | 4 ++ native/gc.h | 1 + native/memory.c | 39 ++++++++++++++ native/memory.h | 8 +++ native/primitives.c | 5 +- native/primitives.h | 2 +- native/run.c | 10 ++-- native/run.h | 6 +-- native/word.c | 11 ++++ native/word.h | 5 ++ 18 files changed, 154 insertions(+), 34 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 2d7180aa60..673606eb13 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -5,6 +5,7 @@ - directory listings - index.html - if a directory is requested and URL does not end with /, redirect +- minimize stage2 initialization code, just move it to source files + bignums: diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index 2313aff55f..9f2d8dac11 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -85,9 +85,12 @@ IN: parser DEFER: str>float IN: profiler -DEFER: profiling +DEFER: call-profiling DEFER: call-count DEFER: set-call-count +DEFER: allot-profiling +DEFER: allot-count +DEFER: set-allot-count IN: random DEFER: init-random @@ -244,9 +247,12 @@ IN: cross-compiler (random-int) type-of size-of - profiling + call-profiling call-count set-call-count + allot-profiling + allot-count + set-allot-count dump ] [ swap succ tuck primitive, diff --git a/library/image.factor b/library/image.factor index e98f06df65..5465e42678 100644 --- a/library/image.factor +++ b/library/image.factor @@ -294,7 +294,9 @@ IN: cross-compiler r> ( primitive -- ) emit r> ( parameter -- ) emit ( plist -- ) emit - 0 emit ( padding ) ; + 0 emit ( padding ) + 0 emit + 0 emit ; : primitive, ( word primitive -- ) f (worddef,) ; : compound, ( word definition -- ) 1 swap (worddef,) ; diff --git a/library/platform/native/debugger.factor b/library/platform/native/debugger.factor index 03cd97b2ae..09a17db0d5 100644 --- a/library/platform/native/debugger.factor +++ b/library/platform/native/debugger.factor @@ -84,7 +84,7 @@ USE: words "Operating system signal " write . ; : profiling-disabled-error ( obj -- ) - drop "Recompile with the EXTRA_CALL_INFO flag." print ; + drop "Recompile with the FACTOR_PROFILER flag." print ; : negative-array-size-error ( obj -- ) "Cannot allocate array with negative size " write . ; diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor index 325738811e..5a258dbc60 100644 --- a/library/platform/native/parse-syntax.factor +++ b/library/platform/native/parse-syntax.factor @@ -166,11 +166,17 @@ USE: unparser : ! until-eol drop ; parsing +: documentation+ ( str word -- ) + [ + "documentation" swap word-property [ + swap "\n" swap cat3 + ] when* + ] keep + "documentation" swap set-word-property ; + : parsed-documentation ( parsed str -- parsed ) over doc-comment-here? [ - "documentation" word word-property [ - swap "\n" swap cat3 - ] when* "documentation" word set-word-property + word documentation+ ] [ drop ] ifte ; diff --git a/library/platform/native/profiler.factor b/library/platform/native/profiler.factor index 199a411314..18d6300d8d 100644 --- a/library/platform/native/profiler.factor +++ b/library/platform/native/profiler.factor @@ -30,15 +30,19 @@ USE: combinators USE: kernel USE: lists USE: math +USE: namespaces USE: prettyprint USE: stack USE: words USE: vectors -: reset-call-counts ( -- ) - vocabs [ words [ 0 swap set-call-count ] each ] each ; +! The variable "profile-top-only" toggles between +! culminative counts, and top of call stack counts. -: sort-call-counts ( alist -- alist ) +: reset-counts ( -- ) + [ 0 over set-call-count 0 swap set-allot-count ] each-word ; + +: sort-counts ( alist -- alist ) [ swap cdr swap cdr > ] sort ; : call-count, ( word -- ) @@ -49,14 +53,44 @@ USE: vectors cons , ] ifte ; -: call-counts ( -- alist ) - #! Push an alist of all word/call count pairs. - [, [ call-count, ] each-word ,] sort-call-counts ; +: counts. ( alist -- ) + sort-counts [ . ] each ; -: profile ( quot -- ) - #! Execute a quotation with the profiler enabled. - reset-call-counts - callstack vector-length profiling +: call-counts. ( -- ) + #! Print word/call count pairs. + [, [ call-count, ] each-word ,] counts. ; + +: profile-depth ( -- n ) + "profile-top-only" get [ + -1 + ] [ + callstack vector-length + ] ifte ; + +: call-profile ( quot -- ) + #! Execute a quotation with the CPU profiler enabled. + reset-counts + profile-depth call-profiling call - f profiling - call-counts [ . ] each ; + f call-profiling + call-counts. ; + +: allot-count, ( word -- ) + #! Add to constructing list if allot count is non-zero. + dup allot-count dup 0 = [ + 2drop + ] [ + cons , + ] ifte ; + +: allot-counts. ( -- alist ) + #! Print word/allot count pairs. + [, [ allot-count, ] each-word ,] counts. ; + +: allot-profile ( quot -- ) + #! Execute a quotation with the memory profiler enabled. + reset-counts + profile-depth allot-profiling + call + f allot-profiling + allot-counts. ; diff --git a/native/bignum.h b/native/bignum.h index feab8de600..8810eddc5d 100644 --- a/native/bignum.h +++ b/native/bignum.h @@ -1,13 +1,13 @@ +CELL bignum_zero; +CELL bignum_pos_one; +CELL bignum_neg_one; + INLINE ARRAY* untag_bignum(CELL tagged) { type_check(BIGNUM_TYPE,tagged); return (ARRAY*)UNTAG(tagged); } -CELL bignum_zero; -CELL bignum_pos_one; -CELL bignum_neg_one; - void primitive_bignump(void); ARRAY* to_bignum(CELL tagged); void primitive_to_bignum(void); diff --git a/native/factor.h b/native/factor.h index cb7912b7df..bc5e0010c8 100644 --- a/native/factor.h +++ b/native/factor.h @@ -38,7 +38,7 @@ typedef unsigned short CHAR; /* This decreases performance slightly but gives more readable backtraces, and allows profiling. */ -#define EXTRA_CALL_INFO +#define FACTOR_PROFILER #include "memory.h" #include "error.h" diff --git a/native/gc.c b/native/gc.c index 838030cb77..a529390197 100644 --- a/native/gc.c +++ b/native/gc.c @@ -137,6 +137,8 @@ void collect_roots(void) void primitive_gc(void) { + gc_in_progress = true; + flip_zones(); scan = active->here = active->base; collect_roots(); @@ -147,4 +149,6 @@ void primitive_gc(void) collect_next(); } gc_debug("gc done",0); + + gc_in_progress = false; } diff --git a/native/gc.h b/native/gc.h index 9059c8412e..f90f3fc147 100644 --- a/native/gc.h +++ b/native/gc.h @@ -1,4 +1,5 @@ CELL scan; +bool gc_in_progress; void* copy_untagged_object(void* pointer, CELL size); void copy_object(CELL* handle); diff --git a/native/memory.c b/native/memory.c index 94ba7dd832..cef3c5edc8 100644 --- a/native/memory.c +++ b/native/memory.c @@ -38,8 +38,31 @@ void init_arena(CELL size) z1 = zalloc(size); z2 = zalloc(size); active = z1; + allot_profiling = false; + gc_in_progress = false; } +#ifdef FACTOR_PROFILER +void allot_profile_step(CELL a) +{ + CELL depth = (cs - cs_bot) / CELLS; + int i; + CELL obj; + + if(gc_in_progress) + return; + + for(i = profile_depth; i < depth; i++) + { + obj = get(cs_bot + i * CELLS); + if(TAG(obj) == WORD_TYPE) + untag_word(obj)->allot_count += a; + } + + executing->allot_count += a; +} +#endif + void check_memory(void) { if(active->here > active->alarm) @@ -84,3 +107,19 @@ void primitive_room(void) dpush(tag_fixnum_or_bignum(active->limit - active->here)); dpush(tag_fixnum_or_bignum(active->limit - active->base)); } + +void primitive_allot_profiling(void) +{ +#ifndef FACTOR_PROFILER + general_error(ERROR_PROFILING_DISABLED,F); +#else + CELL d = dpop(); + if(d == F) + allot_profiling = false; + else + { + allot_profiling = true; + profile_depth = to_fixnum(d); + } +#endif +} diff --git a/native/memory.h b/native/memory.h index c08025f7f2..02d96f6be1 100644 --- a/native/memory.h +++ b/native/memory.h @@ -10,12 +10,15 @@ ZONE* z2; ZONE* active; /* either z1 or z2 */ ZONE* prior; /* if active==z1, z2; if active==z2, z1 */ +bool allot_profiling; + void* alloc_guarded(CELL size); ZONE* zalloc(CELL size); void init_arena(CELL size); void flip_zones(); void check_memory(void); +void allot_profile_step(CELL a); INLINE CELL align8(CELL a) { @@ -26,6 +29,10 @@ INLINE void* allot(CELL a) { CELL h = active->here; active->here += align8(a); +#ifdef FACTOR_PROFILER + if(allot_profiling) + allot_profile_step(align8(a)); +#endif check_memory(); return (void*)h; } @@ -63,3 +70,4 @@ INLINE void bput(CELL where, char what) bool in_zone(ZONE* z, CELL pointer); void primitive_room(void); +void primitive_allot_profiling(void); diff --git a/native/primitives.c b/native/primitives.c index 209a163027..6fc8020b0b 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -138,9 +138,12 @@ XT primitives[] = { primitive_random_int, primitive_type_of, primitive_size_of, - primitive_profiling, + primitive_call_profiling, primitive_word_call_count, primitive_set_word_call_count, + primitive_allot_profiling, + primitive_word_allot_count, + primitive_set_word_allot_count, primitive_dump }; diff --git a/native/primitives.h b/native/primitives.h index 9990a9d11e..7304689766 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,4 +1,4 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 141 +#define PRIMITIVE_COUNT 144 CELL primitive_to_xt(CELL primitive); diff --git a/native/run.c b/native/run.c index 19836cb7f9..f78d3f9f19 100644 --- a/native/run.c +++ b/native/run.c @@ -6,7 +6,7 @@ void signal_handler(int signal, siginfo_t* siginfo, void* uap) } /* Called from a signal handler. XXX - is this safe? */ -void profiling_step(int signal, siginfo_t* siginfo, void* uap) +void call_profiling_step(int signal, siginfo_t* siginfo, void* uap) { CELL depth = (cs - cs_bot) / CELLS; int i; @@ -28,7 +28,7 @@ void init_signals(void) struct sigaction ign_sigaction; custom_sigaction.sa_sigaction = signal_handler; custom_sigaction.sa_flags = SA_SIGINFO; - profiling_sigaction.sa_sigaction = profiling_step; + profiling_sigaction.sa_sigaction = call_profiling_step; profiling_sigaction.sa_flags = SA_SIGINFO; ign_sigaction.sa_handler = SIG_IGN; sigaction(SIGABRT,&custom_sigaction,NULL); @@ -61,7 +61,7 @@ void run(void) if(callframe == F) { callframe = cpop(); -#ifdef EXTRA_CALL_INFO +#ifdef FACTOR_PROFILER cpop(); #endif continue; @@ -129,9 +129,9 @@ void primitive_setenv(void) userenv[e] = value; } -void primitive_profiling(void) +void primitive_call_profiling(void) { -#ifndef EXTRA_CALL_INFO +#ifndef FACTOR_PROFILER general_error(ERROR_PROFILING_DISABLED,F); #else CELL d = dpop(); diff --git a/native/run.h b/native/run.h index 94c5ad0d0d..de773c5bc0 100644 --- a/native/run.h +++ b/native/run.h @@ -87,7 +87,7 @@ INLINE void call(CELL quot) /* tail call optimization */ if(callframe != F) { -#ifdef EXTRA_CALL_INFO +#ifdef FACTOR_PROFILER cpush(tag_word(executing)); #endif cpush(callframe); @@ -96,7 +96,7 @@ INLINE void call(CELL quot) } void signal_handler(int signal, siginfo_t* siginfo, void* uap); -void profiling_step(int signal, siginfo_t* siginfo, void* uap); +void call_profiling_step(int signal, siginfo_t* siginfo, void* uap); void init_signals(void); void clear_environment(void); @@ -110,4 +110,4 @@ void primitive_getenv(void); void primitive_setenv(void); void primitive_exit(void); void primitive_os_env(void); -void primitive_profiling(void); +void primitive_call_profiling(void); diff --git a/native/word.c b/native/word.c index 90d0f742c4..90a05a85b6 100644 --- a/native/word.c +++ b/native/word.c @@ -80,6 +80,17 @@ void primitive_set_word_call_count(void) word->call_count = to_fixnum(dpop()); } +void primitive_word_allot_count(void) +{ + drepl(tag_fixnum(untag_word(dpeek())->allot_count)); +} + +void primitive_set_word_allot_count(void) +{ + WORD* word = untag_word(dpop()); + word->allot_count = to_fixnum(dpop()); +} + void fixup_word(WORD* word) { word->xt = primitive_to_xt(word->primitive); diff --git a/native/word.h b/native/word.h index 174ac21eea..eece411c32 100644 --- a/native/word.h +++ b/native/word.h @@ -13,6 +13,9 @@ typedef struct { CELL plist; /* UNTAGGED call count incremented by profiler */ CELL call_count; + /* UNTAGGED amount of memory allocated in word */ + CELL allot_count; + CELL padding; } WORD; INLINE WORD* untag_word(CELL tagged) @@ -38,5 +41,7 @@ void primitive_word_plist(void); void primitive_set_word_plist(void); void primitive_word_call_count(void); void primitive_set_word_call_count(void); +void primitive_word_allot_count(void); +void primitive_set_word_allot_count(void); void fixup_word(WORD* word); void collect_word(WORD* word);