vm: groundwork for sampling profiler

Set up the state necessary to collect samples. We still need to add GC support for walking the sample set, and the compiler needs to register GC roots before safepoints as well. We also need primitives to expose the data to Factor for reporting.

GNUmakefile

@@ -34,6 +34,7 @@ ifdef CONFIG
 		vm/code_heap.o \
 		vm/compaction.o \
 		vm/contexts.o \
+		vm/counting_profiler.o \
 		vm/data_heap.o \
 		vm/data_heap_checker.o \
 		vm/debug.o \
@@ -56,9 +57,9 @@ ifdef CONFIG
 		vm/object_start_map.o \
 		vm/objects.o \
 		vm/primitives.o \
-		vm/counting_profiler.o \
 		vm/quotations.o \
 		vm/run.o \
+		vm/sampling_profiler.o \
 		vm/strings.o \
 		vm/to_tenured_collector.o \
 		vm/tuples.o \

Nmakefile

@@ -21,7 +21,7 @@ PLAF_DLL_OBJS = vm\os-windows-x86.64.obj vm\cpu-x86.obj
 
 ML_FLAGS = /nologo /safeseh
 
-EXE_OBJS = vm/main-windows.obj vm\factor.res
+EXE_OBJS = vm\main-windows.obj vm\factor.res
 
 DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm\os-windows.obj \
@@ -37,6 +37,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm\code_heap.obj \
 	vm\compaction.obj \
 	vm\contexts.obj \
+	vm\counting_profiler.obj \
 	vm\data_heap.obj \
 	vm\data_heap_checker.obj \
 	vm\debug.obj \
@@ -60,9 +61,9 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm\object_start_map.obj \
 	vm\objects.obj \
 	vm\primitives.obj \
-	vm\counting_profiler.obj \
 	vm\quotations.obj \
 	vm\run.obj \
+	vm\sampling_profiler.obj \
 	vm\strings.obj \
 	vm\to_tenured_collector.obj \
 	vm\tuples.obj \

vm/errors.cpp

@@ -173,18 +173,27 @@ void factor_vm::enqueue_safepoint_fep()
 void factor_vm::enqueue_safepoint_sample()
 {
 	if (sampling_profiler_p)
-		++safepoint_sample_count;
+	{
+		FACTOR_ATOMIC_ADD(&safepoint_sample_count, 1);
+		if (current_gc)
+			FACTOR_ATOMIC_ADD(&safepoint_gc_sample_count, 1);
+	}
 }
 
 void factor_vm::handle_safepoint()
 {
 	code->unguard_safepoint();
 	if (safepoint_fep)
 	{
+		if (sampling_profiler_p)
+			end_sampling_profiler();
 		std::cout << "Interrupted\n";
 		factorbug();
 		safepoint_fep = false;
-		return;
+	}
+	else if (sampling_profiler_p)
+	{
+		record_sample();
 	}
 }
 

vm/master.hpp

@@ -95,6 +95,7 @@ namespace factor
 #include "run.hpp"
 #include "objects.hpp"
 #include "counting_profiler.hpp"
+#include "sampling_profiler.hpp"
 #include "errors.hpp"
 #include "bignumint.hpp"
 #include "bignum.hpp"

vm/os-unix.cpp

@@ -153,6 +153,22 @@ void factor_vm::enqueue_safepoint_signal(cell signal)
 	*/
 }
 
+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;
+	setitimer(ITIMER_REAL, &timer, NULL);
+}
+
+void factor_vm::end_sampling_profiler_timer()
+{
+	struct itimerval timer;
+	memset((void*)&timer, 0, sizeof(struct itimerval));
+	setitimer(ITIMER_REAL, &timer, NULL);
+}
+
 void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
 {
 	factor_vm *vm = current_vm();
@@ -239,21 +255,6 @@ static void init_sigaction_with_handler(struct sigaction *act,
 
 void factor_vm::unix_init_signals()
 {
-	/* OpenBSD doesn't support sigaltstack() if we link against
-	libpthread. See http://redmine.ruby-lang.org/issues/show/1239 */
-
-#ifndef __OpenBSD__
-	signal_callstack_seg = new segment(callstack_size,false);
-
-	stack_t signal_callstack;
-	signal_callstack.ss_sp = (char *)signal_callstack_seg->start;
-	signal_callstack.ss_size = signal_callstack_seg->size;
-	signal_callstack.ss_flags = 0;
-
-	if(sigaltstack(&signal_callstack,(stack_t *)NULL) < 0)
-		fatal_error("sigaltstack() failed",0);
-#endif
-
 	struct sigaction memory_sigaction;
 	struct sigaction synchronous_sigaction;
 	struct sigaction enqueue_sigaction;

vm/primitives.hpp

@@ -45,6 +45,7 @@ namespace factor
 	_(context_object) \
 	_(context_object_for) \
 	_(current_callback) \
+	_(counting_profiler) \
 	_(data_room) \
 	_(datastack) \
 	_(datastack_for) \
@@ -100,7 +101,6 @@ namespace factor
 	_(modify_code_heap) \
 	_(nano_count) \
 	_(optimized_p) \
-	_(counting_profiler) \
 	_(quot_compiled_p) \
 	_(quotation_code) \
 	_(reset_dispatch_stats) \
@@ -109,6 +109,7 @@ namespace factor
 	_(resize_string) \
 	_(retainstack) \
 	_(retainstack_for) \
+	_(sampling_profiler) \
 	_(save_image) \
 	_(save_image_and_exit) \
 	_(set_context_object) \

vm/sampling_profiler.cpp

@@ -0,0 +1,62 @@
+#include "master.hpp"
+
+namespace factor
+{
+
+void factor_vm::record_sample()
+{
+	cell recorded_sample_count;
+	cell recorded_gc_sample_count;
+
+	recorded_sample_count = safepoint_sample_count;
+	recorded_gc_sample_count = safepoint_gc_sample_count;
+	if (recorded_sample_count == 0 && recorded_gc_sample_count == 0)
+		return;
+
+	/* Another sample signal could be raised while we record these counts */
+	FACTOR_ATOMIC_SUB(&safepoint_sample_count, recorded_sample_count);
+	FACTOR_ATOMIC_SUB(&safepoint_gc_sample_count, recorded_gc_sample_count);
+
+	samples.push_back(profiling_sample(
+		recorded_sample_count,
+		recorded_gc_sample_count,
+		ctx,
+		capture_callstack(ctx)
+	));
+}
+
+void factor_vm::set_sampling_profiler(bool sampling_p)
+{
+	if (sampling_p == sampling_profiler_p)
+		return;
+
+	if (sampling_p)
+		start_sampling_profiler();
+	else
+		end_sampling_profiler();
+}
+
+void factor_vm::start_sampling_profiler()
+{
+	safepoint_sample_count = 0;
+	safepoint_gc_sample_count = 0;
+	samples.clear();
+	samples.reserve(10*FACTOR_PROFILE_SAMPLES_PER_SECOND);
+	sampling_profiler_p = true;
+	start_sampling_profiler_timer();
+}
+
+void factor_vm::end_sampling_profiler()
+{
+	end_sampling_profiler_timer();
+	record_sample();
+	sampling_profiler_p = false;
+}
+
+void factor_vm::primitive_sampling_profiler()
+{
+	set_sampling_profiler(to_boolean(ctx->pop()));
+}
+
+
+}

vm/sampling_profiler.hpp

@@ -0,0 +1,30 @@
+namespace factor
+{
+
+#define FACTOR_PROFILE_SAMPLES_PER_SECOND 1000
+
+struct profiling_sample
+{
+	// Number of samples taken before the safepoint that recorded the sample
+	cell sample_count;
+	// Number of samples taken during GC
+	cell gc_sample_count;
+	// Active context during sample
+	context *ctx;
+	// The callstack at safepoint time
+	cell callstack;
+
+	profiling_sample(cell sample_count,
+		cell gc_sample_count,
+		context *ctx,
+		cell callstack)
+		:
+		sample_count(sample_count),
+		gc_sample_count(gc_sample_count),
+		ctx(ctx),
+		callstack(callstack)
+	{
+	}
+};
+
+}

vm/utilities.hpp

@@ -53,4 +53,45 @@ vm_char *safe_strdup(const vm_char *str);
 cell read_cell_hex();
 VM_C_API void *factor_memcpy(void *dst, void *src, size_t len);
 
+#if defined(WINDOWS)
+
+	#if defined(FACTOR_64)
+
+		#define FACTOR_ATOMIC_CAS(ptr, old_val, new_val) \
+			(InterlockedCompareExchange64(ptr, new_val, old_val) == old_val)
+
+		#define FACTOR_ATOMIC_ADD(ptr, val) \
+			InterlockedAdd64(ptr, val)
+
+		#define FACTOR_ATOMIC_SUB(ptr, val) \
+			InterlockedSub64(ptr, val)
+
+	#else
+
+		#define FACTOR_ATOMIC_CAS(ptr, old_val, new_val) \
+			(InterlockedCompareExchange(ptr, new_val, old_val) == old_val)
+
+		#define FACTOR_ATOMIC_ADD(ptr, val) \
+			InterlockedAdd(ptr, val)
+
+		#define FACTOR_ATOMIC_SUB(ptr, val) \
+			InterlockedSub(ptr, val)
+
+	#endif
+
+#elif defined(__GNUC__) || defined(__clang__)
+
+	#define FACTOR_ATOMIC_CAS(ptr, old_val, new_val) \
+		__sync_bool_compare_and_swap(ptr, old_val, new_val)
+
+	#define FACTOR_ATOMIC_ADD(ptr, val) \
+		__sync_add_and_fetch(ptr, val)
+
+	#define FACTOR_ATOMIC_SUB(ptr, val) \
+		__sync_sub_and_fetch(ptr, val)
+
+#else
+	#error "Unsupported compiler"
+#endif
+
 }

vm/vm.cpp

@@ -11,6 +11,7 @@ factor_vm::factor_vm() :
 	sampling_profiler_p(false),
 	safepoint_fep(false),
 	safepoint_sample_count(0),
+	safepoint_gc_sample_count(0),
 	gc_off(false),
 	current_gc(NULL),
 	gc_events(NULL),

vm/vm.hpp

@@ -60,9 +60,8 @@ struct factor_vm
 	/* External entry points */
 	c_to_factor_func_type c_to_factor_func;
 
-	/* Is call counting enabled? */
+	/* Is profiling enabled? */
 	bool counting_profiler_p;
-	/* Is sampling profiler enabled? */
 	bool sampling_profiler_p;
 
 	/* Global variables used to pass fault handler state from signal handler
@@ -71,8 +70,12 @@ struct factor_vm
 	cell signal_number;
 	cell signal_fault_addr;
 	unsigned int signal_fpu_status;
-	bool safepoint_fep;
-	cell safepoint_sample_count;
+	volatile bool safepoint_fep;
+
+	/* State kept by the sampling profiler */
+	std::vector<profiling_sample> samples;
+	volatile cell safepoint_sample_count;
+	volatile cell safepoint_gc_sample_count;
 
 	/* GC is off during heap walking */
 	bool gc_off;
@@ -186,6 +189,13 @@ struct factor_vm
 	void set_counting_profiler(bool counting_profiler);
 	void primitive_counting_profiler();
 
+	/* Sampling profiler */
+	void record_sample();
+	void start_sampling_profiler();
+	void end_sampling_profiler();
+	void set_sampling_profiler(bool sampling);
+	void primitive_sampling_profiler();
+
 	// errors
 	void general_error(vm_error_type error, cell arg1, cell arg2);
 	void type_error(cell type, cell tagged);
@@ -383,7 +393,7 @@ struct factor_vm
 	void find_data_references_step(cell *scan);
 	void find_data_references(cell look_for_);
 	void dump_code_heap();
-	void factorbug_usage();
+	void factorbug_usage(bool advanced_p);
 	void factorbug();
 	void primitive_die();
 
@@ -705,6 +715,8 @@ struct factor_vm
 	void ffi_dlclose(dll *dll);
 	void c_to_factor_toplevel(cell quot);
 	void init_signals();
+	void start_sampling_profiler_timer();
+	void end_sampling_profiler_timer();
 
 	// os-windows
   #if defined(WINDOWS)