src/profiler.c

   1 /* Profiler implementation.
   2
   3 Copyright (C) 2012 Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 #include <config.h>
  21 #include <stdio.h>
  22 #include <limits.h>
  23 #include <sys/time.h>
  24 #include <signal.h>
  25 #include <setjmp.h>
  26 #include "lisp.h"
  27
  28 /* True if sampling profiler is running.  */
  29
  30 bool sample_profiler_running;
  31
  32 /* True if memory profiler is running.  */
  33
  34 bool memory_profiler_running;
  35
  36 static void sigprof_handler (int, siginfo_t *, void *);
  37
  38 \f
  39 /* Logs.  */
  40
  41 typedef struct Lisp_Hash_Table log_t;
  42
  43 static Lisp_Object
  44 make_log (int heap_size, int max_stack_depth)
  45 {
  46   /* We use a standard Elisp hash-table object, but we use it in
  47      a special way.  This is OK as long as the object is not exposed
  48      to Elisp, i.e. until it is returned by *-profiler-log, after which
  49      it can't be used any more.  */
  50   Lisp_Object log = make_hash_table (Qequal, make_number (heap_size),
  51                                      make_float (DEFAULT_REHASH_SIZE),
  52                                      make_float (DEFAULT_REHASH_THRESHOLD),
  53                                      Qnil, Qnil, Qnil);
  54   struct Lisp_Hash_Table *h = XHASH_TABLE (log);
  55
  56   /* What is special about our hash-tables is that the keys are pre-filled
  57      with the vectors we'll put in them.  */
  58   int i = ASIZE (h->key_and_value) / 2;
  59   while (0 < i)
  60     set_hash_key_slot (h, --i,
  61                        Fmake_vector (make_number (max_stack_depth), Qnil));
  62   return log;
  63 }
  64
  65 /* Evict the least used half of the hash_table.
  66
  67    When the table is full, we have to evict someone.
  68    The easiest and most efficient is to evict the value we're about to add
  69    (i.e. once the table is full, stop sampling).
  70
  71    We could also pick the element with the lowest count and evict it,
  72    but finding it is O(N) and for that amount of work we get very
  73    little in return: for the next sample, this latest sample will have
  74    count==1 and will hence be a prime candidate for eviction :-(
  75
  76    So instead, we take O(N) time to eliminate more or less half of the
  77    entries (the half with the lowest counts).  So we get an amortized
  78    cost of O(1) and we get O(N) time for a new entry to grow larger
  79    than the other least counts before a new round of eviction.  */
  80
  81 static EMACS_INT approximate_median (log_t *log,
  82                                      ptrdiff_t start, ptrdiff_t size)
  83 {
  84   eassert (size > 0);
  85   if (size < 2)
  86     return XINT (HASH_VALUE (log, start));
  87   if (size < 3)
  88     /* Not an actual median, but better for our application than
  89        choosing either of the two numbers.  */
  90     return ((XINT (HASH_VALUE (log, start))
  91              + XINT (HASH_VALUE (log, start + 1)))
  92             / 2);
  93   else
  94     {
  95       ptrdiff_t newsize = size / 3;
  96       ptrdiff_t start2 = start + newsize;
  97       EMACS_INT i1 = approximate_median (log, start, newsize);
  98       EMACS_INT i2 = approximate_median (log, start2, newsize);
  99       EMACS_INT i3 = approximate_median (log, start2 + newsize,
 100                                          size - 2 * newsize);
 101       return (i1 < i2
 102               ? (i2 < i3 ? i2 : (i1 < i3 ? i3 : i1))
 103               : (i1 < i3 ? i1 : (i2 < i3 ? i3 : i2)));
 104     }
 105 }
 106
 107 static void evict_lower_half (log_t *log)
 108 {
 109   ptrdiff_t size = ASIZE (log->key_and_value) / 2;
 110   EMACS_INT median = approximate_median (log, 0, size);
 111   ptrdiff_t i;
 112
 113   for (i = 0; i < size; i++)
 114     /* Evict not only values smaller but also values equal to the median,
 115        so as to make sure we evict something no matter what.  */
 116     if (XINT (HASH_VALUE (log, i)) <= median)
 117       {
 118         Lisp_Object key = HASH_KEY (log, i);
 119         { /* FIXME: we could make this more efficient.  */
 120           Lisp_Object tmp;
 121           XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr.  */
 122           Fremhash (key, tmp);
 123         }
 124         eassert (EQ (log->next_free, make_number (i)));
 125         {
 126           int j;
 127           eassert (VECTORP (key));
 128           for (j = 0; j < ASIZE (key); j++)
 129             ASET (key, j, Qnil);
 130         }
 131         set_hash_key_slot (log, i, key);
 132       }
 133 }
 134
 135 /* Record the current backtrace in LOG. BASE is a special name for
 136    describing which the backtrace come from. BASE can be nil. COUNT is
 137    a number how many times the profiler sees the backtrace at the
 138    time.  ELAPSED is a elapsed time in millisecond that the backtrace
 139    took.  */
 140
 141 static void
 142 record_backtrace (log_t *log, size_t count)
 143 {
 144   struct backtrace *backlist = backtrace_list;
 145   Lisp_Object backtrace;
 146   ptrdiff_t index, i = 0;
 147   ptrdiff_t asize;
 148
 149   if (!INTEGERP (log->next_free))
 150     evict_lower_half (log);
 151   index = XINT (log->next_free);
 152
 153   /* Get a "working memory" vector.  */
 154   backtrace = HASH_KEY (log, index);
 155   asize = ASIZE (backtrace);
 156
 157   /* Copy the backtrace contents into working memory.  */
 158   for (; i < asize && backlist; i++, backlist = backlist->next)
 159     ASET (backtrace, i, *backlist->function);
 160
 161   /* Make sure that unused space of working memory is filled with nil.  */
 162   for (; i < asize; i++)
 163     ASET (backtrace, i, Qnil);
 164
 165   { /* We basically do a `gethash+puthash' here, except that we have to be
 166        careful to avoid memory allocation since we're in a signal
 167        handler, and we optimize the code to try and avoid computing the
 168        hash+lookup twice.  See fns.c:Fputhash for reference.  */
 169     EMACS_UINT hash;
 170     ptrdiff_t j = hash_lookup (log, backtrace, &hash);
 171     if (j >= 0)
 172       set_hash_value_slot (log, j,
 173                            make_number (count + XINT (HASH_VALUE (log, j))));
 174     else
 175       { /* BEWARE!  hash_put in general can allocate memory.
 176            But currently it only does that if log->next_free is nil.  */
 177         int j;
 178         eassert (!NILP (log->next_free));
 179         j = hash_put (log, backtrace, make_number (count), hash);
 180         /* Let's make sure we've put `backtrace' right where it
 181            already was to start with.  */
 182         eassert (index == j);
 183
 184         /* FIXME: If the hash-table is almost full, we should set
 185            some global flag so that some Elisp code can offload its
 186            data elsewhere, so as to avoid the eviction code.  */
 187       }
 188   }
 189 }
 190 \f
 191 /* Sample profiler.  */
 192
 193 #if defined SIGPROF && defined HAVE_SETITIMER
 194 #define PROFILER_CPU_SUPPORT
 195
 196 static Lisp_Object cpu_log;
 197 /* Separate counter for the time spent in the GC.  */
 198 static EMACS_INT cpu_gc_count;
 199
 200 /* The current sample interval in millisecond.  */
 201
 202 static int current_sample_interval;
 203
 204 DEFUN ("sample-profiler-start", Fsample_profiler_start, Ssample_profiler_start,
 205        1, 1, 0,
 206        doc: /* Start or restart sample profiler.  Sample profiler will
 207 take samples each SAMPLE-INTERVAL in millisecond.  See also
 208 `profiler-slot-heap-size' and `profiler-max-stack-depth'.  */)
 209   (Lisp_Object sample_interval)
 210 {
 211   struct sigaction sa;
 212   struct itimerval timer;
 213
 214   if (sample_profiler_running)
 215     error ("Sample profiler is already running");
 216
 217   if (NILP (cpu_log))
 218     {
 219       cpu_gc_count = 0;
 220       cpu_log = make_log (profiler_slot_heap_size,
 221                           profiler_max_stack_depth);
 222     }
 223
 224   current_sample_interval = XINT (sample_interval);
 225
 226   sa.sa_sigaction = sigprof_handler;
 227   sa.sa_flags = SA_RESTART | SA_SIGINFO;
 228   sigemptyset (&sa.sa_mask);
 229   sigaction (SIGPROF, &sa, 0);
 230
 231   timer.it_interval.tv_sec = 0;
 232   timer.it_interval.tv_usec = current_sample_interval * 1000;
 233   timer.it_value = timer.it_interval;
 234   setitimer (ITIMER_PROF, &timer, 0);
 235
 236   sample_profiler_running = 1;
 237
 238   return Qt;
 239 }
 240
 241 DEFUN ("sample-profiler-stop", Fsample_profiler_stop, Ssample_profiler_stop,
 242        0, 0, 0,
 243        doc: /* Stop sample profiler.  Profiler log will be kept.  */)
 244   (void)
 245 {
 246   if (!sample_profiler_running)
 247     error ("Sample profiler is not running");
 248   sample_profiler_running = 0;
 249
 250   setitimer (ITIMER_PROF, 0, 0);
 251
 252   return Qt;
 253 }
 254
 255 DEFUN ("sample-profiler-running-p",
 256        Fsample_profiler_running_p, Ssample_profiler_running_p,
 257        0, 0, 0,
 258        doc: /* Return t if sample profiler is running.  */)
 259   (void)
 260 {
 261   return sample_profiler_running ? Qt : Qnil;
 262 }
 263
 264 DEFUN ("sample-profiler-log",
 265        Fsample_profiler_log, Ssample_profiler_log,
 266        0, 0, 0,
 267        doc: /* Return sample profiler log.  The data is a list of
 268 (sample nil TIMESTAMP SLOTS), where TIMESTAMP is a timestamp when the
 269 log is collected and SLOTS is a list of slots.  */)
 270   (void)
 271 {
 272   Lisp_Object result = cpu_log;
 273   /* Here we're making the log visible to Elisp , so it's not safe any
 274      more for our use afterwards since we can't rely on its special
 275      pre-allocated keys anymore.  So we have to allocate a new one.  */
 276   cpu_log = (sample_profiler_running
 277              ? make_log (profiler_slot_heap_size, profiler_max_stack_depth)
 278              : Qnil);
 279   Fputhash (Fmake_vector (make_number (1), Qautomatic_gc),
 280             make_number (cpu_gc_count),
 281             result);
 282   cpu_gc_count = 0;
 283   return result;
 284 }
 285 #endif
 286 \f
 287 /* Memory profiler.  */
 288
 289 static Lisp_Object memory_log;
 290
 291 DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start,
 292        0, 0, 0,
 293        doc: /* Start/restart memory profiler.  See also
 294 `profiler-slot-heap-size' and `profiler-max-stack-depth'.  */)
 295   (void)
 296 {
 297   if (memory_profiler_running)
 298     error ("Memory profiler is already running");
 299
 300   if (NILP (memory_log))
 301     memory_log = make_log (profiler_slot_heap_size,
 302                            profiler_max_stack_depth);
 303
 304   memory_profiler_running = 1;
 305
 306   return Qt;
 307 }
 308
 309 DEFUN ("memory-profiler-stop",
 310        Fmemory_profiler_stop, Smemory_profiler_stop,
 311        0, 0, 0,
 312        doc: /* Stop memory profiler.  Profiler log will be kept.  */)
 313   (void)
 314 {
 315   if (!memory_profiler_running)
 316     error ("Memory profiler is not running");
 317   memory_profiler_running = 0;
 318
 319   return Qt;
 320 }
 321
 322 DEFUN ("memory-profiler-running-p",
 323        Fmemory_profiler_running_p, Smemory_profiler_running_p,
 324        0, 0, 0,
 325        doc: /* Return t if memory profiler is running.  */)
 326   (void)
 327 {
 328   return memory_profiler_running ? Qt : Qnil;
 329 }
 330
 331 DEFUN ("memory-profiler-log",
 332        Fmemory_profiler_log, Smemory_profiler_log,
 333        0, 0, 0,
 334        doc: /* Return memory profiler log.  The data is a list of
 335 (memory nil TIMESTAMP SLOTS), where TIMESTAMP is a timestamp when the
 336 log is collected and SLOTS is a list of slots.  */)
 337   (void)
 338 {
 339   Lisp_Object result = memory_log;
 340   /* Here we're making the log visible to Elisp , so it's not safe any
 341      more for our use afterwards since we can't rely on its special
 342      pre-allocated keys anymore.  So we have to allocate a new one.  */
 343   memory_log = (memory_profiler_running
 344                 ? make_log (profiler_slot_heap_size, profiler_max_stack_depth)
 345                 : Qnil);
 346   return result;
 347 }
 348
 349 \f
 350 /* Signals and probes.  */
 351
 352 /* Signal handler for sample profiler.  */
 353
 354 static void
 355 sigprof_handler (int signal, siginfo_t *info, void *ctx)
 356 {
 357   eassert (HASH_TABLE_P (cpu_log));
 358   if (backtrace_list && EQ (*backtrace_list->function, Qautomatic_gc))
 359     /* Special case the time-count inside GC because the hash-table
 360        code is not prepared to be used while the GC is running.
 361        More specifically it uses ASIZE at many places where it does
 362        not expect the ARRAY_MARK_FLAG to be set.  We could try and
 363        harden the hash-table code, but it doesn't seem worth the
 364        effort.  */
 365     cpu_gc_count += current_sample_interval;
 366   else
 367     record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval);
 368 }
 369
 370 /* Record that the current backtrace allocated SIZE bytes.  */
 371 void
 372 malloc_probe (size_t size)
 373 {
 374   eassert (HASH_TABLE_P (memory_log));
 375   record_backtrace (XHASH_TABLE (memory_log), size);
 376 }
 377
 378 void
 379 syms_of_profiler (void)
 380 {
 381   DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth,
 382               doc: /* FIXME */);
 383   profiler_max_stack_depth = 16;
 384   DEFVAR_INT ("profiler-slot-heap-size", profiler_slot_heap_size,
 385               doc: /* FIXME */);
 386   profiler_slot_heap_size = 10000;
 387
 388   /* FIXME: Rename things to start with "profiler-", to use "cpu" instead of
 389      "sample", and to make them sound like they're internal or something.  */
 390 #ifdef PROFILER_CPU_SUPPORT
 391   cpu_log = Qnil;
 392   staticpro (&cpu_log);
 393   defsubr (&Ssample_profiler_start);
 394   defsubr (&Ssample_profiler_stop);
 395   defsubr (&Ssample_profiler_running_p);
 396   defsubr (&Ssample_profiler_log);
 397 #endif
 398   memory_log = Qnil;
 399   staticpro (&memory_log);
 400   defsubr (&Smemory_profiler_start);
 401   defsubr (&Smemory_profiler_stop);
 402   defsubr (&Smemory_profiler_running_p);
 403   defsubr (&Smemory_profiler_log);
 404 }