home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / src / pl-prof.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  6KB  |  243 lines
  1. /*  pl-prof.c,v 1.7 1993/02/23 13:16:43 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: program profiler
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. #if O_PROFILE
  13.  
  14. #include <sys/time.h>
  15.  
  16. #if PROTO && sun
  17. extern int setitimer P((int, struct itimerval *,struct itimerval *));
  18. #endif
  19.  
  20. forwards void profile P((void));
  21.  
  22. struct itimerval value, ovalue;        /* itmer controlling structures */
  23.  
  24. static bool
  25. startProfiler(how)
  26. int how;
  27. { pl_signal(SIGPROF, profile);
  28.  
  29.   value.it_interval.tv_sec  = 0;
  30.   value.it_interval.tv_usec = 1;
  31.   value.it_value.tv_sec  = 0;
  32.   value.it_value.tv_usec = 1;
  33.   
  34.   if (setitimer(ITIMER_PROF, &value, &ovalue) != 0)
  35.     return warning("Failed to start interval timer: %s", OsError());
  36.   statistics.profiling = how;
  37.  
  38.   succeed;
  39. }
  40.  
  41. void
  42. stopItimer()
  43. { value.it_interval.tv_sec  = 0;
  44.   value.it_interval.tv_usec = 0;
  45.   value.it_value.tv_sec  = 0;
  46.   value.it_value.tv_usec = 0;
  47.   
  48.   if ( statistics.profiling == NO_PROFILING )
  49.     return;
  50.   if (setitimer(ITIMER_PROF, &value, &ovalue) != 0)
  51.   { warning("Failed to stop interval timer: %s", OsError());
  52.     return;
  53.   }
  54. }
  55.  
  56. static bool
  57. stopProfiler()
  58. { if ( statistics.profiling == NO_PROFILING )
  59.     succeed;
  60.  
  61.   stopItimer();
  62.   statistics.profiling = NO_PROFILING;
  63. #if _AIX
  64.   pl_signal(SIGPROF, SIG_IGN);
  65. #else
  66.   pl_signal(SIGPROF, SIG_DFL);
  67. #endif
  68.  
  69.   succeed;
  70. }
  71.  
  72. word
  73. pl_profile(old, new)
  74. Word old, new;
  75. { int prof;
  76.  
  77.   TRY(unifyAtomic(old, consNum(statistics.profiling)) );
  78.   if (!isInteger(*new))
  79.     fail;
  80.   if ((prof = valNum(*new)) == statistics.profiling)
  81.     succeed;
  82.   switch(prof)
  83.   { case NO_PROFILING:
  84.     return stopProfiler();
  85.     case CUMULATIVE_PROFILING:
  86.     case PLAIN_PROFILING:
  87.     if (statistics.profiling != NO_PROFILING)
  88.     { stopProfiler();
  89.       pl_reset_profiler();
  90.     }
  91.     return startProfiler(prof);
  92.     default:
  93.     warning("$profile/2: illegal second argument");
  94.     fail;
  95.   }
  96. }
  97.     
  98. word
  99. pl_profile_count(head, calls, prom)
  100. Word head, calls, prom;
  101. { Procedure proc;
  102.   Definition def;
  103.  
  104.   if ((proc = findProcedure(head)) == (Procedure) NULL)
  105.     return warning("profile_count/3: No such predicate");
  106.   def = proc->definition;
  107.  
  108.   TRY(unifyAtomic(calls, consNum(def->profile_calls+def->profile_redos)) );
  109.  
  110.   return unifyAtomic(prom, consNum((1000 * def->profile_ticks) /
  111.                    statistics.profile_ticks) );
  112. }
  113.  
  114.  
  115. word
  116. pl_profile_box(head, calls, redos, exits, fails)
  117. Word head, calls, redos, exits, fails;
  118. { Procedure proc;
  119.   Definition def;
  120.  
  121.   if ((proc = findProcedure(head)) == (Procedure) NULL)
  122.     return warning("profile_box/5: No such predicate");
  123.   def = proc->definition;
  124.  
  125.   TRY(unifyAtomic(calls,    consNum(def->profile_calls)));
  126.   TRY(unifyAtomic(redos,    consNum(def->profile_redos)));
  127.   TRY(unifyAtomic(exits,    consNum(def->profile_calls +
  128.                     def->profile_redos -
  129.                     def->profile_fails)));
  130.   return unifyAtomic(fails, consNum(def->profile_fails));
  131. }
  132.  
  133.  
  134. word
  135. pl_reset_profiler()
  136. { Module module;
  137.   Procedure proc;
  138.   Symbol sm, sp;
  139.  
  140.   if (statistics.profiling != NO_PROFILING)
  141.     stopProfiler();
  142.  
  143.   for_table(sm, moduleTable)
  144.   { module = (Module) sm->value;
  145.     for_table(sp, module->procedures)
  146.     { proc = (Procedure) sp->value;
  147.  
  148.       proc->definition->profile_calls = 0;
  149.       proc->definition->profile_redos = 0;
  150.       proc->definition->profile_fails = 0;
  151.       proc->definition->profile_ticks = 0;
  152.       clear(proc->definition, PROFILE_TICKED);
  153.     }
  154.   }
  155.   statistics.profile_ticks = 0;
  156.  
  157.   succeed;
  158. }
  159.  
  160. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  161. This function is responsible for collection the profiling statistics  at
  162. run time.  It is called by the UNIX interval timer on each clock tick of
  163. the  machine  (every  20  milli seconds).  If profiling is plain we just
  164. increment the profiling tick of the procedure on top of the stack.   For
  165. cumulative  profiling  we  have  to  scan the entire local stack.  As we
  166. don't want to increment each invokation of recursive  functions  on  the
  167. stack  we  maintain a flag on each function.  This flag is set the first
  168. time the function is found on the stack.  If is is found set the profile
  169. counter will not be incremented.  We do a second pass over the frames to
  170. clear the flags again.
  171. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  172.  
  173. static void
  174. profile()
  175. { register LocalFrame fr = environment_frame;
  176.  
  177. #if _AIX
  178.   if ( statistics.profiling == NO_PROFILING )
  179.     return;
  180. #endif
  181.  
  182. #if O_SIG_AUTO_RESET
  183.   signal(SIGPROF, profile);
  184. #endif
  185.  
  186.   if ( gc_status.active )
  187.   { PROCEDURE_garbage_collect0->definition->profile_ticks++;
  188.     return;
  189.   }
  190.  
  191.   if (fr == (LocalFrame) NULL)
  192.     return;
  193.  
  194.   statistics.profile_ticks++;
  195.   if (statistics.profiling == PLAIN_PROFILING)
  196.   { fr->procedure->definition->profile_ticks++;
  197.     return;
  198.   }
  199.  
  200.   for(; fr; fr = parentFrame(fr) )        /* CUMULATIVE_PROFILING */
  201.   { register Procedure proc = fr->procedure;
  202.     if ( false(proc->definition, PROFILE_TICKED) )
  203.     { set(proc->definition, PROFILE_TICKED);
  204.       proc->definition->profile_ticks++;
  205.     }
  206.   }
  207.   
  208.   for(fr = environment_frame; fr; fr = parentFrame(fr) )
  209.     clear(fr->procedure->definition, PROFILE_TICKED);
  210. }
  211.  
  212. #else /* O_PROFILE */
  213.  
  214. void
  215. stopItimer()
  216. {
  217. }
  218.  
  219. word
  220. pl_profile(old, new)
  221. Word old, new;
  222. { return notImplemented("profile", 2);
  223. }
  224.  
  225. word
  226. pl_profile_count(head, calls, prom)
  227. Word head, calls, prom;
  228. { return notImplemented("profile_count", 3);
  229. }
  230.  
  231. word
  232. pl_profile_box(head, calls, redos, exits, fails)
  233. Word head, calls, redos, exits, fails;
  234. { return notImplemented("profile_box", 3);
  235. }
  236.  
  237. word
  238. pl_reset_profiler()
  239. { return notImplemented("reset_profile", 0);
  240. }
  241.  
  242. #endif /* O_PROFILE */
  243.