#include "backtrace.h"
#include "bytecode.h"
+#include "elhash.h"
#include "hash.h"
#include "syssignal.h"
#include "systime.h"
+#ifndef HAVE_SETITIMER
+#error Sorry charlie. We need a scalpel and all we have is a lawnmower.
+#endif
+
/* We implement our own profiling scheme so that we can determine
things like which Lisp functions are occupying the most time. Any
standard OS-provided profiling works on C functions, which is
(ITIMER_PROF), which generates a SIGPROF every so often. (This
runs not in real time but rather when the process is executing or
the system is running on behalf of the process.) When the signal
- goes off, we see what we're in, and add by 1 the count associated
+ goes off, we see what we're in, and add 1 to the count associated
with that function.
It would be nice to use the Lisp allocation mechanism etc. to keep
track of the profiling information, but we can't because that's not
- safe, and trying to make it safe would be much more work than is
+ safe, and trying to make it safe would be much more work than it's
worth.
Jan 1998: In addition to this, I have added code to remember call
counts of Lisp funcalls. The profile_increase_call_count()
- function is called from funcall_recording_as(), and serves to add
- data to Vcall_count_profile_table. This mechanism is much simpler
- and independent of the SIGPROF-driven one. It uses the Lisp
- allocation mechanism normally, since it is not called from a
- handler. It may even be useful to provide a way to turn on only
- one profiling mechanism, but I haven't done so yet. --hniksic */
-
-c_hashtable big_profile_table;
+ function is called from Ffuncall(), and serves to add data to
+ Vcall_count_profile_table. This mechanism is much simpler and
+ independent of the SIGPROF-driven one. It uses the Lisp allocation
+ mechanism normally, since it is not called from a handler. It may
+ even be useful to provide a way to turn on only one profiling
+ mechanism, but I haven't done so yet. --hniksic */
+
+static struct hash_table *big_profile_table;
Lisp_Object Vcall_count_profile_table;
-int default_profiling_interval;
+Fixnum default_profiling_interval;
int profiling_active;
and is not set the whole time we're in redisplay. */
int profiling_redisplay_flag;
-Lisp_Object QSin_redisplay;
-Lisp_Object QSin_garbage_collection;
-Lisp_Object QSprocessing_events_at_top_level;
-Lisp_Object QSunknown;
+static Lisp_Object QSin_redisplay;
+static Lisp_Object QSin_garbage_collection;
+static Lisp_Object QSprocessing_events_at_top_level;
+static Lisp_Object QSunknown;
/* We use inside_profiling to prevent the handler from writing to
the table while another routine is operating on it. We also set
enough to catch us while we're already in there. */
static volatile int inside_profiling;
-/* Increase the value of OBJ in Vcall_count_profile_table hashtable.
- If hashtable is nil, create it first. */
+/* Increase the value of OBJ in Vcall_count_profile_table hash table.
+ If the hash table is nil, create it first. */
void
profile_increase_call_count (Lisp_Object obj)
{
Lisp_Object count;
if (NILP (Vcall_count_profile_table))
- Vcall_count_profile_table = Fmake_hashtable (make_int (100), Qeq);
+ Vcall_count_profile_table =
+ make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
count = Fgethash (obj, Vcall_count_profile_table, Qzero);
if (!INTP (count))
{
fun = *backtrace_list->function;
- if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun))
- fun = QSunknown;
+ if (!SYMBOLP (fun)
+ && !COMPILED_FUNCTIONP (fun)
+ && !SUBRP (fun)
+ && !CONSP (fun))
+ fun = QSunknown;
}
else
fun = QSprocessing_events_at_top_level;
lose because of this. Even worse, if the memory allocation
fails, the `error' generated whacks everything hard. */
long count;
- CONST void *vval;
+ const void *vval;
if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
count = (long) vval;
else
count = 0;
count++;
- vval = (CONST void *) count;
+ vval = (const void *) count;
puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
}
struct itimerval foo;
/* #### The hash code can safely be called from a signal handler
- except when it has to grow the hashtable. In this case, it calls
- realloc(), which is not (in general) re-entrant. We just be
+ except when it has to grow the hash table. In this case, it calls
+ realloc(), which is not (in general) re-entrant. We'll just be
sleazy and make the table large enough that it (hopefully) won't
need to be realloc()ed. */
if (!big_profile_table)
- big_profile_table = make_hashtable (10000);
+ big_profile_table = make_hash_table (10000);
+
if (NILP (microsecs))
msecs = default_profiling_interval;
else
foo.it_interval = foo.it_value;
profiling_active = 1;
inside_profiling = 0;
- setitimer (ITIMER_PROF, &foo, 0);
+ qxe_setitimer (ITIMER_PROF, &foo, 0);
return Qnil;
}
foo.it_value.tv_sec = 0;
foo.it_value.tv_usec = 0;
foo.it_interval = foo.it_value;
- setitimer (ITIMER_PROF, &foo, 0);
+ qxe_setitimer (ITIMER_PROF, &foo, 0);
profiling_active = 0;
signal (SIGPROF, fatal_error_signal);
return Qnil;
};
static int
-get_profiling_info_maphash (CONST void *void_key,
+get_profiling_info_maphash (const void *void_key,
void *void_val,
void *void_closure)
{
return closure.accum;
}
-struct mark_profiling_info_closure
-{
- void (*markfun) (Lisp_Object);
-};
-
static int
-mark_profiling_info_maphash (CONST void *void_key,
+mark_profiling_info_maphash (const void *void_key,
void *void_val,
void *void_closure)
{
Lisp_Object key;
CVOID_TO_LISP (key, void_key);
- (((struct mark_profiling_info_closure *) void_closure)->markfun) (key);
+ mark_object (key);
return 0;
}
void
-mark_profiling_info (void (*markfun) (Lisp_Object))
+mark_profiling_info (void)
{
- /* This function does not GC (if markfun doesn't) */
- struct mark_profiling_info_closure closure;
-
- closure.markfun = markfun;
+ /* This function does not GC */
if (big_profile_table)
{
inside_profiling = 1;
- maphash (mark_profiling_info_maphash, big_profile_table, &closure);
+ maphash (mark_profiling_info_maphash, big_profile_table, 0);
inside_profiling = 0;
}
}
clrhash (big_profile_table);
inside_profiling = 0;
}
- if (!NILP(Vcall_count_profile_table))
+ if (!NILP (Vcall_count_profile_table))
Fclrhash (Vcall_count_profile_table);
return Qnil;
}
vars_of_profile (void)
{
DEFVAR_INT ("default-profiling-interval", &default_profiling_interval /*
-Default time in microseconds between profiling queries.
+Default CPU time in microseconds between profiling sampling.
Used when the argument to `start-profiling' is nil or omitted.
Note that the time in question is CPU time (when the program is executing
or the kernel is executing on behalf of the program) and not real time.
DEFVAR_LISP ("call-count-profile-table", &Vcall_count_profile_table /*
The table where call-count information is stored by the profiling primitives.
-This is a hashtable whose keys are funcallable objects, and whose
- values are their call counts (integers).
+This is a hash table whose keys are funcallable objects, and whose
+values are their call counts (integers).
*/ );
Vcall_count_profile_table = Qnil;
projects / chise / xemacs-chise.git.1 / blobdiff