/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 1985-2023, University of Amsterdam VU University Amsterdam CWI, Amsterdam SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /*#define O_DEBUG 1*/ #include "pl-incl.h" #include "pl-comp.h" #include "pl-prof.h" #include "pl-wam.h" #include "pl-setup.h" #include "pl-fli.h" #include "pl-proc.h" #include "pl-gc.h" #include "pl-util.h" #include "pl-pro.h" #include "pl-modul.h" #undef LD #define LD LOCAL_LD #ifdef O_PROFILE #define PROFTYPE_MAGIC 0x639a2fb1 #if USE_LD_MACROS #define profile(count) LDFUNC(profile, count) #define thread_prof_ticks(_) LDFUNC(thread_prof_ticks, _) #endif #define LDFUNC_DECLARATIONS static int identify_def(term_t t, void *handle); static int get_def(term_t t, void **handle); static void prof_release_def(void *handle); static void profile(intptr_t count); static int thread_prof_ticks(void); #undef LDFUNC_DECLARATIONS static PL_prof_type_t prof_default_type = { identify_def, /* unify a Definition */ get_def, /* Find a definition */ NULL, /* Acquire */ prof_release_def, /* Release a definition */ .magic = PROFTYPE_MAGIC }; #define MAX_PROF_TYPES 10 static PL_prof_type_t *types[MAX_PROF_TYPES] = { &prof_default_type }; #define PROFNODE_MAGIC 0x7ae38f24 typedef struct call_node { int magic; /* PROFNODE_MAGIC */ struct call_node *parent; void * handle; /* handle to procedure-id */ PL_prof_type_t *type; uint64_t calls; /* Calls from the parent */ uint64_t fails; /* fails back to choicepoint */ uint64_t exits; /* exits to the parent */ uint64_t recur; /* recursive calls */ uint64_t ticks; /* time-statistics */ uint64_t sibling_ticks; /* ticks in a siblings */ struct call_node *next; /* next in siblings chain */ struct call_node *siblings; /* my offspring */ } call_node; #if USE_LD_MACROS #define collectSiblingsTime(_) LDFUNC(collectSiblingsTime, _) #endif /*USE_LD_MACROS*/ #define LDFUNC_DECLARATIONS static void freeProfileData(void); static void collectSiblingsTime(void); #undef LDFUNC_DECLARATIONS #define WITH_LD_IF_PROFILING(_) WITH_LD(GD->profile.thread) if(LD _) #define WITH_LD_IF_PROFILING_AND(cond) WITH_LD_IF_PROFILING( && (cond)) int activateProfiler(DECL_LD prof_status active) { int i; PL_local_data_t *profiling; PL_LOCK(L_THREAD); if ( active && (profiling=GD->profile.thread) ) { term_t tid = PL_new_term_ref(); char msg[100]; PL_unify_thread_id(tid, LD->thread.info->pl_tid); Ssprintf(msg, "Already profiling thread %d", profiling->thread.info->pl_tid); PL_UNLOCK(L_THREAD); return PL_error(NULL, 0, msg, ERR_PERMISSION, ATOM_profile, ATOM_thread, tid); } LD->profile.active = active; for(i=0; iactivate ) (*types[i]->activate)(active); } if ( active ) { LD->profile.time_at_last_tick = LD->profile.time_at_start = active == PROF_CPU ? ThreadCPUTime(CPU_USER) : WallTime(); GD->profile.thread = LD; } else { GD->profile.thread = NULL; } PL_UNLOCK(L_THREAD); updateAlerted(LD); LD->profile.sum_ok = FALSE; return TRUE; } static int thread_prof_ticks(DECL_LD) { double t0 = LD->profile.time_at_last_tick; double t1 = LD->profile.active == PROF_CPU ? ThreadCPUTime(CPU_USER) : WallTime(); LD->profile.time_at_last_tick = t1; DEBUG(MSG_PROF_TICKS, Sdprintf("%d ms\n", (int)((t1-t0)*1000.0))); return (int)((t1-t0)*1000.0); /* milliseconds */ } #ifdef __WINDOWS__ #include static UINT timer; /* our MM timer */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - MS-Windows version - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #if (_MSC_VER < 1400) && !defined(__MINGW32__) typedef DWORD DWORD_PTR; #endif static void CALLBACK callTimer(UINT id, UINT msg, DWORD_PTR dwuser, DWORD_PTR dw1, DWORD_PTR dw2) { WITH_LD_IF_PROFILING() { int newticks; if ( (newticks = thread_prof_ticks()) ) { if ( newticks < 0 ) /* Windows 95/98/... */ newticks = 1; } profile(newticks); } } static bool startProfiler(prof_status how) { GET_LD MMRESULT rval; (void)how; rval = timeSetEvent(10, round(LD->profile.sample_period/1000), /* resolution (milliseconds) */ callTimer, (DWORD_PTR)0, TIME_PERIODIC); if ( rval ) timer = rval; else return PL_error(NULL, 0, NULL, ERR_SYSCALL, "timeSetEvent"); return activateProfiler(PROF_CPU); } void stopItimer(void) { if ( timer ) { timeKillEvent(timer); timer = 0; } } #else /*__WINDOWS__*/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - POSIX version - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif static struct itimerval value, ovalue; /* itimer controlling structures */ static int itimer = -1; /* ITIMER_* */ static int timer_signal; /* SIG* */ static void sig_profile(int sig) { (void)sig; #if !defined(BSD_SIGNALS) && !defined(HAVE_SIGACTION) signal(SIGPROF, sig_profile); #endif WITH_LD_IF_PROFILING() { int newticks; if ( (newticks = thread_prof_ticks()) ) { if ( newticks < 0 ) /* Windows 95/98/... */ newticks = 1; } profile(newticks); } } static bool startProfiler(prof_status how) { GET_LD int sig, timer; if ( how == PROF_CPU ) { sig = SIGPROF; timer = ITIMER_PROF; } else { sig = SIGALRM; timer = ITIMER_REAL; } set_sighandler(sig, sig_profile); timer_signal = sig; value.it_interval.tv_sec = 0; value.it_interval.tv_usec = LD->profile.sample_period; // period in usecs. value.it_value.tv_sec = 0; /* on systems where 0 means now */ value.it_value.tv_usec = LD->profile.sample_period; if ( setitimer(timer, &value, &ovalue) != 0 ) return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, setitimer); itimer = timer; return activateProfiler(how); } void stopItimer(void) { if ( itimer != -1 ) { value.it_interval.tv_sec = 0; value.it_interval.tv_usec = 0; value.it_value.tv_sec = 0; value.it_value.tv_usec = 0; if ( setitimer(itimer, &value, &ovalue) != 0 ) { warning("Failed to stop interval timer: %s", OsError()); return; } itimer = -1; } } #endif /*__WINDOWS__*/ static int stopProfiler(void) { WITH_LD_IF_PROFILING_AND(LD->profile.active) { double tend = LD->profile.active == PROF_CPU ? ThreadCPUTime(CPU_USER) : WallTime(); LD->profile.time += tend - LD->profile.time_at_start; stopItimer(); activateProfiler(PROF_INACTIVE); #ifndef __WINDOWS__ set_sighandler(timer_signal, SIG_IGN); timer_signal = 0; #endif } return TRUE; } /** profiler(-Old, +New) Unify Old with the state of the profiler and set it according to New. */ static int get_prof_status(term_t t, prof_status *s) { GET_LD atom_t a; if ( PL_get_atom_ex(t, &a) ) { switch(a) { case ATOM_false: *s = PROF_INACTIVE; return TRUE; case ATOM_true: case ATOM_cputime: *s = PROF_CPU; return TRUE; case ATOM_walltime: *s = PROF_WALL; return TRUE; default: PL_domain_error("profile_status", t); return FALSE; } } return FALSE; } static PRED_IMPL("profiler", 2, profiler, 0) { PRED_LD prof_status val; if ( !PL_unify_atom(A1, LD->profile.active == PROF_INACTIVE ? ATOM_false : LD->profile.active == PROF_CPU ? ATOM_cputime : ATOM_walltime) ) return FALSE; if ( PL_compare(A1, A2) == 0 ) return TRUE; if ( !get_prof_status(A2, &val) ) return FALSE; if ( val == LD->profile.active ) succeed; if ( val ) return startProfiler(val); else return stopProfiler(); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Prolog query API: $prof_sibling_of(?Child, ?Parent) Generate hierachy. If Parent is '-', generate the roots $prof_node(+Node, -Pred, -Calls, -Redos, -Exits, -Recursive, -Ticks, -SiblingTicks) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #define get_node(t, node) LDFUNC(get_node, t, node) static int get_node(DECL_LD term_t t, call_node **node) { if ( PL_is_functor(t, FUNCTOR_dprof_node1) ) { term_t a = PL_new_term_ref(); void *ptr; _PL_get_arg(1, t, a); if ( PL_get_pointer(a, &ptr) ) { call_node *n = ptr; if ( n->magic == PROFNODE_MAGIC ) { *node = n; succeed; } } } return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_profile_node, t); } #define unify_node(t, node) LDFUNC(unify_node, t, node) static int unify_node(DECL_LD term_t t, call_node *node) { return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dprof_node1, PL_POINTER, node); } static PRED_IMPL("$prof_sibling_of", 2, prof_sibling_of, PL_FA_NONDETERMINISTIC) { PRED_LD call_node *parent = NULL; call_node *sibling = NULL; switch( CTX_CNTRL ) { case FRG_FIRST_CALL: { atom_t a; if ( !PL_is_variable(A1) ) { if ( get_node(A1, &sibling) ) { if ( sibling->parent ) return unify_node(A2, sibling->parent); } fail; } else { if ( PL_get_atom(A2, &a) && a == ATOM_minus ) sibling = LD->profile.roots; else if ( get_node(A2, &parent) ) sibling = parent->siblings; else fail; } if ( !sibling ) fail; goto return_sibling; } case FRG_REDO: { sibling = CTX_PTR; return_sibling: if ( !unify_node(A1, sibling) ) fail; if ( sibling->next ) ForeignRedoPtr(sibling->next); succeed; } case FRG_CUTTED: default: succeed; } } static int identify_def(term_t t, void *handle) { return unify_definition(MODULE_user, t, handle, 0, GP_QUALIFY|GP_NAMEARITY); } static int unify_node_id(term_t t, call_node *n) { if ( n->type->magic == PROFTYPE_MAGIC ) { return (*n->type->unify)(t, n->handle); } else { GET_LD return PL_unify_pointer(t, n->handle); } } static PRED_IMPL("$prof_node", 8, prof_node, 0) { PRED_LD call_node *n = NULL; if ( !get_node(A1, &n) ) return FALSE; collectSiblingsTime(); return ( unify_node_id(A2, n) && PL_unify_uint64(A3, n->calls) && PL_unify_uint64(A4, n->exits + n->fails - n->calls) && PL_unify_uint64(A5, n->exits) && PL_unify_uint64(A6, n->recur) && PL_unify_uint64(A7, n->ticks) && PL_unify_uint64(A8, n->sibling_ticks) ); } /******************************* * COLLECT DATA * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - prof_procedure_data(+PredicateIndicator, -TimeSelf, -TimeSiblings, -Parents, -Siblings) Where Parents = list_of(Relative) And Siblings = list_of(Relative) and Relative = node(Pred, CycleID, Ticks, SiblingTicks, Calls, Redos, Exits) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ typedef struct prof_ref { struct prof_ref *next; /* next in chain */ void * handle; /* Procedure handle */ PL_prof_type_t *type; int cycle; uint64_t ticks; uint64_t sibling_ticks; uint64_t calls; /* calls to/from this predicate */ uint64_t redos; /* redos to/from this predicate */ uint64_t exits; /* exits to/from this predicate */ } prof_ref; typedef struct { Definition def; uint64_t ticks; uint64_t sibling_ticks; uint64_t calls; uint64_t redos; uint64_t exits; uint64_t recur; prof_ref *callers; prof_ref *callees; } node_sum; static void free_relatives(prof_ref *r) { prof_ref *n; for( ; r; r=n) { n = r->next; freeHeap(r, sizeof(*r)); } } #define DEF_SPONTANEOUS (Definition)0 #define DEF_RECURSIVE (Definition)1 static void add_parent_ref(node_sum *sum, call_node *self, void *handle, PL_prof_type_t *type, int cycle) { prof_ref *r; sum->calls += self->calls; sum->redos += self->exits + self->fails - self->calls; sum->exits += self->exits; for(r=sum->callers; r; r=r->next) { if ( r->handle == handle && r->cycle == cycle ) { r->calls += self->calls; r->redos += self->exits + self->fails - self->calls; r->exits += self->exits; r->ticks += self->ticks; r->sibling_ticks += self->sibling_ticks; return; } } r = allocHeapOrHalt(sizeof(*r)); r->calls = self->calls; r->redos = self->exits + self->fails - self->calls; r->exits = self->exits; r->ticks = self->ticks; r->sibling_ticks = self->sibling_ticks; r->handle = handle; r->type = type; r->cycle = cycle; r->next = sum->callers; sum->callers = r; } static void add_recursive_ref(node_sum *sum, uint64_t count, int cycle) { prof_ref *r; for(r=sum->callers; r; r=r->next) { if ( r->handle == DEF_RECURSIVE && r->cycle == cycle ) { r->calls += count; return; } } r = allocHeapOrHalt(sizeof(*r)); memset(r, 0, sizeof(*r)); r->calls = count; r->handle = DEF_RECURSIVE; r->cycle = cycle; r->next = sum->callers; sum->callers = r; } static void add_sibling_ref(node_sum *sum, call_node *sibling, int cycle) { prof_ref *r; for(r=sum->callees; r; r=r->next) { if ( r->handle == sibling->handle && r->cycle == cycle ) { r->calls += sibling->calls; r->redos += sibling->exits + sibling->fails - sibling->calls; r->exits += sibling->exits; r->ticks += sibling->ticks; r->sibling_ticks += sibling->sibling_ticks; return; } } r = allocHeapOrHalt(sizeof(*r)); r->calls = sibling->calls; r->redos = sibling->exits + sibling->fails - sibling->calls; r->exits = sibling->exits; r->ticks = sibling->ticks; r->sibling_ticks = sibling->sibling_ticks; r->handle = sibling->handle; r->type = sibling->type; r->cycle = cycle; r->next = sum->callees; sum->callees = r; } #define sumProfile(n, handle, type, sum, seen) LDFUNC(sumProfile, n, handle, type, sum, seen) static int sumProfile(DECL_LD call_node *n, void *handle, PL_prof_type_t *type, node_sum *sum, int seen) { call_node *s; int count = 0; if ( n->handle == handle ) { count++; if ( !seen ) { sum->ticks += n->ticks; sum->sibling_ticks += n->sibling_ticks; } if ( n->parent ) add_parent_ref(sum, n, n->parent->handle, n->parent->type, seen); else add_parent_ref(sum, n, DEF_SPONTANEOUS, NULL, seen); if ( n->recur ) add_recursive_ref(sum, n->recur, seen); for(s=n->siblings; s; s = s->next) add_sibling_ref(sum, s, seen); seen++; } for(s=n->siblings; s; s = s->next) count += sumProfile(s, handle, type, sum, seen); return count; } #define unify_relatives(list, r) LDFUNC(unify_relatives, list, r) static int unify_relatives(DECL_LD term_t list, prof_ref *r) { term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); term_t tmp = PL_new_term_ref(); for( ; r; r=r->next) { int rc; if ( !PL_unify_list(tail, head, tail) ) fail; PL_put_variable(tmp); if ( r->handle == DEF_SPONTANEOUS ) rc=PL_unify_atom_chars(tmp, ""); else if ( r->handle == DEF_RECURSIVE ) rc=PL_unify_atom_chars(tmp, ""); else rc=(*r->type->unify)(tmp, r->handle); if ( !rc || !PL_unify_term(head, PL_FUNCTOR, FUNCTOR_node7, PL_TERM, tmp, PL_INT, r->cycle, PL_INT64, r->ticks, PL_INT64, r->sibling_ticks, PL_INT64, r->calls, PL_INT64, r->redos, PL_INT64, r->exits) ) fail; } return PL_unify_nil(tail); } static int get_def(term_t t, void **handle) { Procedure proc; if ( get_procedure(t, &proc, 0, GP_FIND|GP_NAMEARITY) ) { *handle = proc->definition; succeed; } fail; } static int get_handle(term_t t, void **handle) { int i; for(i=0; iget ) { switch( (*types[i]->get)(t, handle) ) { case TRUE: succeed; case FALSE: break; default: assert(0); } } } fail; } static void prof_release_def(void *handle) { Definition def = handle; releaseModule(def->module); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - $prof_procedure_data(+PredicateIndicator, -Ticks, -TicksSiblings, -Calls, -Redos, -Exits, -Callers, -Callees) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static PRED_IMPL("$prof_procedure_data", 8, prof_procedure_data, PL_FA_TRANSPARENT) { PRED_LD void *handle; node_sum sum; call_node *n; int rc; int count = 0; if ( !get_handle(A1, &handle) ) fail; collectSiblingsTime(); memset(&sum, 0, sizeof(sum)); for(n=LD->profile.roots; n; n=n->next) count += sumProfile(n, handle, &prof_default_type, &sum, 0); if ( count == 0 ) fail; /* nothing known about this one */ rc = ( PL_unify_uint64(A2, sum.ticks) && PL_unify_uint64(A3, sum.sibling_ticks) && PL_unify_uint64(A4, sum.calls) && PL_unify_uint64(A5, sum.redos) && PL_unify_uint64(A6, sum.exits) && unify_relatives(A7, sum.callers) && unify_relatives(A8, sum.callees) ); free_relatives(sum.callers); free_relatives(sum.callees); return rc ? TRUE : FALSE; } /** '$prof_statistics'(-Samples, -Ticks, -AccountingTicks, -Time, -Nodes, -Period, -Ports) @arg Samples is the number of times the statistical profiler was called. @arg Ticks is the number of virtual ticks during profiling @arg AccountingTicks are tick spent on accounting @arg Time is the total CPU time spent profiling @arg Nodes is the number of nodes in the call tree @arg Period is the number of microseconds between samples @arg Ports is one of `true`, `false` or `classic` */ static PRED_IMPL("$prof_statistics", 7, prof_statistics, 0) { PRED_LD return ( PL_unify_uint64(A1, LD->profile.samples) && PL_unify_uint64(A2, LD->profile.ticks) && PL_unify_uint64(A3, LD->profile.accounting_ticks) && PL_unify_float( A4, LD->profile.time) && PL_unify_uint64(A5, LD->profile.nodes) && PL_unify_integer(A6, LD->profile.sample_period) && PL_unify_atom(A7, LD->profile.ports_control == PROFC_FALSE ? ATOM_false : LD->profile.ports_control == PROFC_TRUE ? ATOM_true : ATOM_classic) ); } /******************************* * RESET * *******************************/ #if USE_LD_MACROS #define prof_clear_environments(fr) LDFUNC(prof_clear_environments, fr) #define prof_clear_choicepoints(ch) LDFUNC(prof_clear_choicepoints, ch) #define prof_clear_stacks(fr, ch) LDFUNC(prof_clear_stacks, fr, ch) #endif static QueryFrame prof_clear_environments(DECL_LD LocalFrame fr) { if ( fr == NULL ) return NULL; for(;;) { if ( true(fr, FR_MARKED) ) return NULL; set(fr, FR_MARKED); LD->gc._local_frames++; fr->prof_node = NULL; if ( fr->parent ) fr = fr->parent; else /* Prolog --> C --> Prolog calls */ return queryOfFrame(fr); } } static void prof_clear_choicepoints(DECL_LD Choice ch) { for( ; ch; ch = ch->parent ) { LD->gc._choice_count++; prof_clear_environments(ch->frame); } } static void prof_clear_stacks(DECL_LD LocalFrame fr, Choice ch) { QueryFrame qf; while(fr) { qf = prof_clear_environments(fr); assert(qf->magic == QID_MAGIC); prof_clear_choicepoints(ch); if ( qf->parent ) { QueryFrame pqf = qf->parent; if ( !(fr = pqf->registers.fr) ) fr = qf->saved_environment; ch = qf->saved_bfr; } else break; } } bool resetProfiler(DECL_LD) { stopProfiler(); assert(LD->gc._local_frames == 0); assert(LD->gc._choice_count == 0); prof_clear_stacks(environment_frame, LD->choicepoints); unmark_stacks(environment_frame, LD->choicepoints, FR_MARKED); assert(LD->gc._local_frames == 0); assert(LD->gc._choice_count == 0); freeProfileData(); LD->profile.samples = 0; LD->profile.ticks = 0; LD->profile.accounting_ticks = 0; LD->profile.time = 0.0; LD->profile.accounting = FALSE; succeed; } static PRED_IMPL("reset_profiler", 0, reset_profiler, 0) { resetProfiler(); succeed; } /******************************* * TOPLEVEL * *******************************/ static PRED_IMPL("$profile", 4, profile, PL_FA_TRANSPARENT) { int rc; prof_status val; if ( !get_prof_status(A2, &val) ) return FALSE; atom_t ports_opt; PL_get_atom_ex(A3, &ports_opt); switch (ports_opt) { case ATOM_false: LD->profile.ports_control = PROFC_FALSE; break; case ATOM_true: LD->profile.ports_control = PROFC_TRUE; break; default: LD->profile.ports_control = PROFC_CLASSIC; } LD->profile.sample_period = 5000; // default period in usecs. double rate; if ( PL_get_float_ex(A4, &rate) ) LD->profile.sample_period = (unsigned int)(1000000/rate); else return FALSE; resetProfiler(); startProfiler(val); rc = callProlog(NULL, A1, PL_Q_PASS_EXCEPTION, NULL); stopProfiler(); return rc; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This function is responsible for collection the profiling statistics at run time. It is called from a dedicated profiler thread that by default triggers this function every 5ms. First, this calls thread_prof_ticks() to determine the number of ms the relevant clock (CPU or wall) has progressed and then calls this function with `count` set to the relevant clock increment, i.e., count is a number in the range 0..5. This function just ticks the leaf node in the dynamic call graph. The function collectSiblingsTime() propagates these upward when collecting statistics. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static void profile(DECL_LD intptr_t count) { call_node *node; if ( !HAS_LD ) return; LD->profile.samples++; LD->profile.ticks += count; if ( LD->profile.accounting ) /* we are updating nodes */ { LD->profile.accounting_ticks += count; } else if ( (node=LD->profile.current) && node->magic == PROFNODE_MAGIC ) { node->ticks += count; } } /******************************* * HIERARCHY ACCOUNTING * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - profCall(Definition handle) A call was made from the current node to handle. This builds up a dynamic call tree. THe tree is constructed as follows: - If there is no current node - If the root-set contains a node for `handle`, use it - Else create a new root node. - If the current node has the same handle, increment `node->recur` - If somewhere in the parent chain we find the same parent-child transition, we tick this node and return it. For example, given p->q->r->p, a call to q returns the q parent node and increments it recursion count. JW: This seems wrong - It breaks the propagation of self-ticks in the tree. - I think the second `p` also creates a second cycle. - If the current node has a sibling with `handle`, return it. - Else, add a new sibling. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifdef O_DEBUG static char * node_name(call_node *n) { static char buf[100]; if ( n->type == &prof_default_type ) return predicateName(n->handle); Ssprintf(buf, "%p", n->handle); return buf; } #endif #define prof_call(handle, type) LDFUNC(prof_call, handle, type) static call_node * prof_call(DECL_LD void *handle, PL_prof_type_t *type) { call_node *node = LD->profile.current; LD->profile.accounting = TRUE; if ( !node ) /* root-node of the profile */ { for(node = LD->profile.roots; node; node=node->next) { if ( node->handle == handle ) { node->calls++; LD->profile.current = node; DEBUG(MSG_PROF_CALLTREE, Sdprintf("Call: existing root %s\n", node_name(node))); LD->profile.accounting = FALSE; return node; } } node = allocHeapOrHalt(sizeof(*node)); memset(node, 0, sizeof(*node)); LD->profile.nodes++; node->magic = PROFNODE_MAGIC; node->handle = handle; node->type = type; node->calls++; node->next = LD->profile.roots; LD->profile.roots = node; LD->profile.current = node; LD->profile.accounting = FALSE; DEBUG(MSG_PROF_CALLTREE, Sdprintf("Call: new root %s\n", node_name(node))); return node; } /* straight recursion */ if ( node->handle == handle ) { node->recur++; DEBUG(MSG_PROF_CALLTREE, Sdprintf("Call: direct recursion on %s\n", node_name(node))); LD->profile.accounting = FALSE; return node; } else if ( LD->profile.ports_control != PROFC_TRUE ) { void *parent = node->handle; for(node=node->parent; node; node = node->parent) { if ( node->handle == handle && node->parent && node->parent->handle == parent ) { node->recur++; LD->profile.current = node; DEBUG(MSG_PROF_CALLTREE, Sdprintf("Call: indirect recursion on %s\n", node_name(node))); LD->profile.accounting = FALSE; return node; } } } for(node=LD->profile.current->siblings; node; node=node->next) { if ( node->handle == handle ) { LD->profile.current = node; node->calls++; DEBUG(MSG_PROF_CALLTREE, Sdprintf("Call: existing child %s\n", node_name(node))); LD->profile.accounting = FALSE; return node; } } node = allocHeapOrHalt(sizeof(*node)); memset(node, 0, sizeof(*node)); LD->profile.nodes++; node->magic = PROFNODE_MAGIC; node->handle = handle; node->type = type; node->parent = LD->profile.current; node->calls++; node->next = LD->profile.current->siblings; LD->profile.current->siblings = node; LD->profile.current = node; DEBUG(MSG_PROF_CALLTREE, Sdprintf("Call: new child %s\n", node_name(node))); LD->profile.accounting = FALSE; return node; } call_node * profCall(DECL_LD Definition def) { if ( true(def, P_NOPROFILE) ) return LD->profile.current; acquireModulePtr(def->module); return prof_call(def, &prof_default_type); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Exit, resuming execution in node. Note that we ignore the node if the magic doesn't fit. That can happen using tprofile/1 because the stop doesn't need to match the start. Actually, we should clear prof_node references when clearing the data, but this is rather complicated (must be synchornised with atom-gc) and it still doesn't cope with foreign code. Considering this is development only, we'll leave this for now. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void profResumeParent(DECL_LD struct call_node *node) { call_node *n; if ( node && node->magic != PROFNODE_MAGIC ) return; LD->profile.accounting = TRUE; if ( LD->profile.ports_control != PROFC_FALSE ) { for(n=LD->profile.current; n && n != node; n=n->parent) { DEBUG(MSG_PROF_CALLTREE, Sdprintf("Exit: %s\n", node_name(n))); n->exits++; } } LD->profile.current = node; LD->profile.accounting = FALSE; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - profExit(call_node from_node) Exit to the parent of from_node. Note that all nodes from the current node back to and including from_node are deemed to have exited. This catches all normal exits (from_node == current) and last calls (from_node is an ancestor of current). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void profExit(DECL_LD struct call_node *node) { if ( !node || node->magic != PROFNODE_MAGIC ) return; profResumeParent(node->parent); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - profFail(call_node cp_node) Fail to choicepoint node. All nodes in the branch from the current node back to a common ancestor with cp_node are deemed to have failed. Note that if the current node is the choicepoint node, nothing fails as this is internal to the predicate (doesn't pass through Fail port). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static int lookback(call_node *from_node, call_node *to_node) { struct call_node *node = from_node; while( node ) { if ( node == to_node ) return TRUE; else node = node->parent; } return FALSE; } static void profFailToCP(struct call_node *current, struct call_node *cp_node) { while (current && (!lookback(cp_node, current))) { DEBUG(MSG_PROF_CALLTREE, Sdprintf("Fail: %s\n", node_name(current))); if (current->magic == PROFNODE_MAGIC) current->fails++; current = current->parent; } } void profFail(DECL_LD struct call_node *cp_node) { LD->profile.accounting = TRUE; if ( LD->profile.ports_control != PROFC_FALSE ) profFailToCP(LD->profile.current, cp_node); LD->profile.current = cp_node; LD->profile.accounting = FALSE; } void profSetHandle(struct call_node *node, void *handle) { node->handle = handle; } /******************************* * FOREIGN ACCESS * *******************************/ int PL_register_profile_type(PL_prof_type_t *type) { int i; for(i=0; imagic = PROFTYPE_MAGIC; return TRUE; } } assert(0); return FALSE; } void * PL_prof_call(void *handle, PL_prof_type_t *type) { GET_LD return prof_call(handle, type); } void PL_prof_exit(void *node) { GET_LD struct call_node *n = node; profResumeParent(n->parent); } /******************************* * COLLECT * *******************************/ static uint64_t collectSiblingsNode(call_node *n) { call_node *s; uint64_t count = 0; for(s=n->siblings; s; s=s->next) { count += collectSiblingsNode(s); n->sibling_ticks = count; } return count+n->ticks; } static void collectSiblingsTime(DECL_LD) { if ( !LD->profile.sum_ok ) { call_node *n; for(n=LD->profile.roots; n; n=n->next) collectSiblingsNode(n); LD->profile.sum_ok = TRUE; } } #define freeProfileNode(node) LDFUNC(freeProfileNode, node) static void freeProfileNode(DECL_LD call_node *node) { call_node *n, *next; assert(node->magic == PROFNODE_MAGIC); for(n=node->siblings; n; n=next) { next = n->next; if ( n->type && n->type->release ) (*n->type->release)(n->handle); freeProfileNode(n); } node->magic = 0; freeHeap(node, sizeof(*node)); LD->profile.nodes--; } static void freeProfileData(void) { GET_LD call_node *n, *next; n = LD->profile.roots; LD->profile.roots = NULL; LD->profile.current = NULL; for(; n; n=next) { next = n->next; freeProfileNode(n); } assert(LD->profile.nodes == 0); } #else /* !O_PROFILE */ int PL_register_profile_type(PL_prof_type_t *type) { return FALSE; } void * PL_prof_call(void *handle, PL_prof_type_t *type) { return NULL; } void PL_prof_exit(void *node) { } #endif /* O_PROFILE */ /******************************* * PUBLISH PREDICATES * *******************************/ BeginPredDefs(profile) #if O_PROFILE PRED_DEF("$profile", 4, profile, PL_FA_TRANSPARENT) PRED_DEF("profiler", 2, profiler, 0) PRED_DEF("reset_profiler", 0, reset_profiler, 0) PRED_DEF("$prof_node", 8, prof_node, 0) PRED_DEF("$prof_sibling_of", 2, prof_sibling_of, PL_FA_NONDETERMINISTIC) PRED_DEF("$prof_procedure_data", 8, prof_procedure_data, PL_FA_TRANSPARENT) PRED_DEF("$prof_statistics", 7, prof_statistics, 0) #endif EndPredDefs