vm: parameterize sampling rate

basis/tools/profiler/sampling/sampling.factor

@@ -1,19 +1,23 @@
 ! (c)2011 Joe Groff bsd license
 USING: assocs calendar continuations kernel math.statistics
-namespaces sequences tools.profiler.sampling.private ;
+math namespaces sequences tools.profiler.sampling.private ;
 IN: tools.profiler.sampling
 
-: TIME-PER-SAMPLE ( -- n ) 1 milliseconds ; inline
-
 SYMBOL: raw-profile-data
+SYMBOL: samples-per-second
+
+CONSTANT: default-samples-per-second 1000
 
 : get-raw-profile-data ( -- data )
     raw-profile-data get-global [ "No profile data" throw ] unless* ;
 
-: profile ( quot -- )
-    t profiling [ f profiling ] [ ] cleanup
+: profile* ( rate quot -- )
+    [ [ samples-per-second set-global ] [ profiling ] bi ] dip
+    [ 0 profiling ] [ ] cleanup
     (get-samples) raw-profile-data set-global ; inline
 
+: profile ( quot -- ) default-samples-per-second swap profile* ; inline
+
 : total-sample-count ( sample -- count ) first ;
 : gc-sample-count ( sample -- count ) second ;
 : foreign-sample-count ( sample -- count ) third ;
@@ -22,7 +26,7 @@ SYMBOL: raw-profile-data
 : sample-callstack ( sample -- array ) 5 swap nth ;
 
 : samples>time ( samples -- time )
-    TIME-PER-SAMPLE time* ;
+    samples-per-second get-global / seconds ;
 
 : (total-time) ( samples -- n )
     [ total-sample-count ] map-sum samples>time ;

vm/os-unix.cpp

@@ -157,8 +157,8 @@ void factor_vm::start_sampling_profiler_timer()
 {
 	struct itimerval timer;
 	memset((void*)&timer, 0, sizeof(struct itimerval));
-	timer.it_value.tv_usec = 1000000/FACTOR_PROFILE_SAMPLES_PER_SECOND;
-	timer.it_interval.tv_usec = 1000000/FACTOR_PROFILE_SAMPLES_PER_SECOND;
+	timer.it_value.tv_usec = 1000000/samples_per_second;
+	timer.it_interval.tv_usec = 1000000/samples_per_second;
 	setitimer(ITIMER_REAL, &timer, NULL);
 }
 

vm/os-windows.cpp

@@ -308,12 +308,12 @@ void factor_vm::sampler_thread_loop()
 	assert(QueryPerformanceFrequency(&units_per_second));
 
 	assert(QueryPerformanceCounter(&counter));
-	counter.QuadPart *= FACTOR_PROFILE_SAMPLES_PER_SECOND;
+	counter.QuadPart *= samples_per_second;
 	while (atomic::fence(), sampling_profiler_p)
 	{
 		SwitchToThread();
 		assert(QueryPerformanceCounter(&new_counter));
-		new_counter.QuadPart *= FACTOR_PROFILE_SAMPLES_PER_SECOND;
+		new_counter.QuadPart *= samples_per_second;
 		cell samples = 0;
 		while (new_counter.QuadPart - counter.QuadPart > units_per_second.QuadPart) {
 			// We would have to suspend the thread to sample the PC
@@ -348,7 +348,7 @@ void factor_vm::end_sampling_profiler_timer()
 	sampling_profiler_p = false;
 	atomic::fence();
 	DWORD wait_result = WaitForSingleObject(sampler_thread,
-		3000/FACTOR_PROFILE_SAMPLES_PER_SECOND);
+		3000/samples_per_second);
 	if (wait_result != WAIT_OBJECT_0)
 		TerminateThread(sampler_thread, 0);
 	sampler_thread = NULL;

vm/sampling_profiler.cpp

@@ -57,13 +57,14 @@ void factor_vm::record_callstack_sample(cell *begin, cell *end)
 	*end = sample_callstacks.size();
 }
 
-void factor_vm::set_sampling_profiler(bool sampling_p)
+void factor_vm::set_sampling_profiler(int rate)
 {
+	bool sampling_p = !!rate;
 	if (sampling_p == sampling_profiler_p)
 		return;
 	
 	if (sampling_p)
-		start_sampling_profiler();
+		start_sampling_profiler(rate);
 	else
 		end_sampling_profiler();
 }
@@ -78,12 +79,13 @@ void factor_vm::clear_samples()
 	sample_callstacks.swap(sample_callstack_graveyard);
 }
 
-void factor_vm::start_sampling_profiler()
+void factor_vm::start_sampling_profiler(int rate)
 {
+	samples_per_second = rate;
 	safepoint_sample_counts.clear();
 	clear_samples();
-	samples.reserve(10*FACTOR_PROFILE_SAMPLES_PER_SECOND);
-	sample_callstacks.reserve(100*FACTOR_PROFILE_SAMPLES_PER_SECOND);
+	samples.reserve(10*rate);
+	sample_callstacks.reserve(100*rate);
 	sampling_profiler_p = true;
 	start_sampling_profiler_timer();
 }
@@ -98,7 +100,7 @@ void factor_vm::end_sampling_profiler()
 
 void factor_vm::primitive_sampling_profiler()
 {
-	set_sampling_profiler(to_boolean(ctx->pop()));
+	set_sampling_profiler(to_fixnum(ctx->pop()));
 }
 
 void factor_vm::primitive_get_samples()

vm/sampling_profiler.hpp

@@ -1,8 +1,6 @@
 namespace factor
 {
 
-#define FACTOR_PROFILE_SAMPLES_PER_SECOND 1000
-
 struct profiling_sample_count
 {
 	// Number of samples taken before the safepoint that recorded the sample

vm/vm.hpp

@@ -63,6 +63,7 @@ struct factor_vm
 	/* Is profiling enabled? */
 	bool counting_profiler_p;
 	volatile bool sampling_profiler_p;
+	int samples_per_second;
 
 	/* Global variables used to pass fault handler state from signal handler
 	to VM */
@@ -194,9 +195,9 @@ struct factor_vm
 	void clear_samples();
 	void record_sample();
 	void record_callstack_sample(cell *begin, cell *end);
-	void start_sampling_profiler();
+	void start_sampling_profiler(int rate);
 	void end_sampling_profiler();
-	void set_sampling_profiler(bool sampling);
+	void set_sampling_profiler(int rate);
 	void enqueue_safepoint_sample(cell samples, cell pc, bool foreign_thread_p);
 	void primitive_sampling_profiler();
 	void primitive_get_samples();