some more work on process switching and exception handling

stix/configure

@@ -18194,7 +18194,7 @@ done
 
 
 
-for ac_func in gettimeofday settimeofday clock_gettime clock_settime
+for ac_func in gettimeofday settimeofday clock_gettime clock_settime getitimer setitimer
 do :
   as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
 ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"

stix/configure.ac

@@ -152,7 +152,7 @@ dnl	[],
 dnl	[#include <stddef.h>])
 
 dnl check functions
-AC_CHECK_FUNCS([gettimeofday settimeofday clock_gettime clock_settime])
+AC_CHECK_FUNCS([gettimeofday settimeofday clock_gettime clock_settime getitimer setitimer])
 AC_CHECK_FUNCS([backtrace backtrace_symbols])
 AC_CHECK_FUNCS([makecontext swapcontext getcontext setcontext])
 AC_CHECK_FUNCS([snprintf _vsnprintf _vsnwprintf])

stix/kernel/Apex.st

@@ -267,14 +267,6 @@
 		self class primitiveFailed.
 	}
 
-	#method(#class) doesNotUnderstand: messageSymbol
-	{
-		## TODO: implement this
-		## UnrecognizedMessage signal.
-		self class dump.
-		'does not understand' dump.
-	}
-
 	#method doesNotUnderstand: messageSymbol
 	{
 		self class doesNotUnderstand: messageSymbol

stix/kernel/Context.st

@@ -1,3 +1,10 @@
+#class Exception(Apex)
+{
+	#dcl signalContext handlerContext handlerBlock messageText.
+
+	## To be extended below.
+}
+
 #class(#pointer) Context(Apex)
 {
 	#dcl sender ip sp ntmprs.
@@ -309,20 +316,18 @@ thisContext isExceptionHandlerContext dump.
 
 	#method ensure: aBlock
 	{
-		"##
-		| complete returnValue |
-		<ensure>
 
-		returnValue := self valueNoContextSwitch.
+## TODO: ensure that the ensured block is executed after exception handler...
-		complete ifNil: [
+		| value |
-			complete := true.
+		value := self on: Exception do: [:ex | aBlock value. ex pass].
-			aBlock value.
+		## value := self valueAndResumeOnUnwind.
-		].
+		aBlock value.
-		^returnValue. ##"
+		^value
 	}
 
 	#method ifCurtailed: aBlock
 	{
+		^self on: Exception do: [:ex | aBlock value. ex pass ]
 	}
 
 	"------ TODO: -------------------------------------"
@@ -330,9 +335,9 @@ thisContext isExceptionHandlerContext dump.
 
 ## TODO: is it better to inherit from Object???
 ##       or treat Exception specially like UndefinedObject or Class???
-#class Exception(Apex)
+#extend Exception
 {
-	#dcl signalContext handlerContext handlerBlock messageText.
+	
 
 	#method(#class) signal
 	{
@@ -403,9 +408,8 @@ thisContext isExceptionHandlerContext dump.
 			]
 	}
 
-	## ####################################################################
+	## ####################################################################	## ####################################################################
-	## ####################################################################
+  	#method handleException
-	#method handleException
 	{
 		self.handlerContext notNil
 			ifTrue: [ 
@@ -418,12 +422,12 @@ thisContext isExceptionHandlerContext dump.
 			].
 	}
 
-	#method handlerContext
+##	#method handlerContext
-	{
+##	{
-		(self.handlerContext notNil) ifTrue: [ ^self.handlerContext ].
+##		(self.handlerContext notNil) ifTrue: [ ^self.handlerContext ].
-		self.handlerContext := self findHandlerContextStartingFrom: self.signalContext.
+##		self findHandlerContextStartingFrom: self.signalContext.
-		^self.handlerContext.
+##		^self.handlerContext.
-	}
+##	}
 
 	#method findHandlerContextStartingFrom: aContext
 	{
@@ -444,6 +448,10 @@ thisContext isExceptionHandlerContext dump.
 				].
 				ctx := ctx sender
 			].
+
+		## no handler is found
+		self.handlerBlock := nil.
+		self.handlerContext := nil.
 		^nil
 	}
 }
@@ -470,6 +478,7 @@ ctx := thisContext.
 	## TODO: include blockcontext???
 	ctx := ctx sender.
 ].
+'------ END OF BACKTRACE -----------' dump.
 		PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
 	}
 
@@ -477,4 +486,10 @@ ctx := thisContext.
 	{
 		Exception signal: 'Cannot instantiate'.
 	}
+
+	#method(#class) doesNotUnderstand: messageSymbol
+	{
+		## TODO: implement this properly
+		NoSuchMessageException signal: (messageSymbol, ' not understood by ', (self name)).
+	}
 }

stix/kernel/Process.st

@@ -102,6 +102,14 @@
 		self primitiveFailed
 	}
 
+	#method critical: aBlock
+	{
+'CRITICAL....11' dump.
+		self wait.
+'CRITICAL....22' dump.
+		^aBlock ensure: [ self signal ]
+	}
+
 	## ==================================================================
 
 	#method heapIndex

stix/kernel/test-010.st

@@ -45,7 +45,52 @@
 		'END OF MAIN' dump.
 	}
 
+	
 	#method(#class) main
+	{
+		## test critical region
+		|t1 t2 s1 s2 s3|
+
+		'START OF MAIN' dump.
+
+		s1 := Semaphore new.
+		s2 := Semaphore new.
+
+		t1 := [ 
+			1000 timesRepeat: ['BLOCK #1' dump].
+			##s2 critical: [
+			##	10 timesRepeat: ['BLOCK #1' dump ]
+			##]
+		] newProcess.
+		t2 := [ 
+			1000 timesRepeat: ['BLOCK #2' dump].
+			##s2 critical: [
+			##	10 timesRepeat: ['BLOCK #2' dump. ]
+			##].
+
+			s1 signal.
+		] newProcess.
+
+		t1 resume.
+		t2 resume.
+
+		s1 wait.
+
+		'END OF MAIN' dump.   
+
+"
+		| v1 |
+		'START OF MAIN' dump.
+		##[1 xxx] ifCurtailed: ['XXXXXXXX CURTAILED XXXXXXXXX' dump].
+		##['ENSURE TEST' dump] ensure: ['XXXXXXXXX ENSURE XXXXXXXXXXXXXx' dump].
+
+		v1 := [ ['kkk' dump.] ensure: ['XXXXXXXXX ENSURE XXXXXXXXXXXXXx' dump. 30] ] on: Exception do: [:ex | 'EXCEPTION OUTSIDE ENSURE...' dump.  ].
+		v1 dump.
+
+		'END OF MAIN' dump."
+	}
+	
+	#method(#class) main22222
 	{
 		|t1 t2 s1 s2 s3|
 

stix/lib/exec.c

@@ -41,6 +41,7 @@
 #	if defined(HAVE_SYS_TIME_H)
 #		include <sys/time.h>
 #	endif
+
 #endif
 
 #define PROC_STATE_RUNNING 3
@@ -2865,19 +2866,38 @@ printf ("\n");
 	method = find_method (stix, receiver, &mthname, to_super);
 	if (!method) 
 	{
-/* TODO: implement doesNotUnderstand: XXXXX  instead of returning -1. */
+		static stix_uch_t fbm[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' };
-stix_oop_t c;
+		mthname.ptr = fbm;
+		mthname.len = 18;
 
-c = STIX_CLASSOF(stix,receiver);
+		method = find_method (stix, receiver, &mthname, 0);
-printf ("ERROR [NOT IMPLEMENTED YET] - receiver [");
+		if (!method)
-print_object (stix, receiver);
+		{
-printf ("] class ");
+			/* TODO: improve this hard error handling */
-print_object (stix, c);
+			stix_oop_t c;
-printf (" doesNotUnderstand: [");
-print_oocs (&mthname);
-printf ("]\n");
 
-		return -1;
+			c = STIX_CLASSOF(stix,receiver);
+			printf ("HARD FAILURE ERROR [IMAGE PROBLEM] - receiver [");
+			print_object (stix, receiver);
+			printf ("] class ");
+			print_object (stix, c);
+			printf (" doesNotUnderstand: [");
+			print_oocs (&mthname);
+			printf ("]\n");
+
+			stix->errnum = STIX_EMSGSND;
+			return -1;
+		}
+		else
+		{
+			/* manipulate the stack as if 'receier doesNotUnderstand: select' 
+			 * has been called. */
+/* TODO: if i manipulate the stack this way here, the stack track for the last call is kind of lost.
+ *       how can i preserve it gracefully? */
+			ACTIVE_STACK_POPS (stix, nargs);
+			nargs = 1;
+			ACTIVE_STACK_PUSH (stix, selector);
+		}
 	}
 
 	STIX_ASSERT (STIX_OOP_TO_SMOOI(method->tmpr_nargs) == nargs);
@@ -3129,7 +3149,13 @@ printf ("REALLY NO MORE RUNNABLE PROCESS...\n");
 		}*/
 
 		/* TODO: implement different process switching scheme - time-slice or clock based??? */
+#if defined(STIX_EXTERNAL_PROCESS_SWITCH)
+		if (!stix->proc_switched && stix->switch_proc) { switch_to_next_runnable_process (stix); }
+		stix->switch_proc = 0;
+#else
 		if (!stix->proc_switched) { switch_to_next_runnable_process (stix); }
+#endif
+
 		stix->proc_switched = 0;
 
 		FETCH_BYTE_CODE_TO (stix, bcode);

stix/lib/main.c

@@ -52,6 +52,16 @@
 #	include <unistd.h>
 #	include <ltdl.h>
 #	define USE_LTDL
+
+#	if defined(HAVE_TIME_H)
+#		include <time.h>
+#	endif
+#	if defined(HAVE_SYS_TIME_H)
+#		include <sys/time.h>
+#	endif
+#	if defined(HAVE_SIGNAL_H)
+#		include <signal.h>
+#	endif
 #endif
 
 #if !defined(STIX_DEFAULT_MODPREFIX)
@@ -375,6 +385,52 @@ stix_ooch_t str_my_object[] = { 'M', 'y', 'O', 'b','j','e','c','t' };
 stix_ooch_t str_main[] = { 'm', 'a', 'i', 'n' };
 
 
+stix_t* g_stix = STIX_NULL;
+
+static void arrange_process_switching (int sig)
+{
+	if (g_stix) stix_switchprocess (g_stix);
+}
+
+static void setup_tick (void)
+{
+#if defined(HAVE_SETITIMER) && defined(SIGVTALRM) && defined(ITIMER_VIRTUAL)
+	struct itimerval itv;
+	struct sigaction act;
+
+	sigemptyset (&act.sa_mask);
+	act.sa_handler = arrange_process_switching;
+	act.sa_flags = 0;
+	sigaction (SIGVTALRM, &act, STIX_NULL);
+
+	itv.it_interval.tv_sec = 0;
+	itv.it_interval.tv_usec = 100; /* 100 microseconds */
+	itv.it_value.tv_sec = 0;
+	itv.it_value.tv_usec = 100;
+	setitimer (ITIMER_VIRTUAL, &itv, STIX_NULL);
+#endif
+}
+
+static void cancel_tick (void)
+{
+#if defined(HAVE_SETITIMER) && defined(SIGVTALRM) && defined(ITIMER_VIRTUAL)
+	struct itimerval itv;
+	struct sigaction act;
+
+	itv.it_interval.tv_sec = 0;
+	itv.it_interval.tv_usec = 0;
+	itv.it_value.tv_sec = 0;
+	itv.it_value.tv_usec = 0;
+	setitimer (ITIMER_VIRTUAL, &itv, STIX_NULL);
+
+
+	sigemptyset (&act.sa_mask);
+	act.sa_handler = SIG_DFL;
+	act.sa_flags = 0;
+	sigaction (SIGVTALRM, &act, STIX_NULL);
+#endif
+}
+
 int main (int argc, char* argv[])
 {
 	stix_t* stix;
@@ -382,7 +438,7 @@ int main (int argc, char* argv[])
 	stix_oocs_t objname;
 	stix_oocs_t mthname;
 	stix_vmprim_t vmprim;
-	int i;
+	int i, xret;
 
 	printf ("Stix 1.0.0 - max named %lu max indexed %lu max class %lu max classinst %lu oowmax %lu, ooimax %ld ooimin %ld smooimax %ld smooimax %ld\n", 
 		(unsigned long int)STIX_MAX_NAMED_INSTVARS, 
@@ -593,6 +649,11 @@ printf ("%p\n", a);
 		}
 	}
 
+
+	xret = 0;
+	g_stix = stix;
+	setup_tick ();
+
 /*	objname.ptr = str_system;
 	objname.len = 6;*/
 	objname.ptr = str_my_object;
@@ -602,13 +663,11 @@ printf ("%p\n", a);
 	if (stix_invoke (stix, &objname, &mthname) <= -1)
 	{
 		printf ("ERROR: cannot execute code - %d\n", stix_geterrnum(stix));
-		stix_close (stix);
+		xret = -1;
-#if defined(USE_LTDL)
-		lt_dlexit ();
-#endif
-		return -1;
 	}
 
+	cancel_tick ();
+	g_stix = STIX_NULL;
 
 /*	dump_dictionary (stix, stix->sysdic, "System dictionary");*/
 	stix_close (stix);
@@ -620,5 +679,5 @@ printf ("%p\n", a);
 #if defined(_WIN32) && defined(_DEBUG)
 getchar();
 #endif
-	return 0;
+	return xret;
 }

stix/lib/stix-cfg.h.in

@@ -115,6 +115,9 @@
 /* Define to 1 if you have the `getcontext' function. */
 #undef HAVE_GETCONTEXT
 
+/* Define to 1 if you have the `getitimer' function. */
+#undef HAVE_GETITIMER
+
 /* Define to 1 if you have the `gettimeofday' function. */
 #undef HAVE_GETTIMEOFDAY
 
@@ -169,6 +172,9 @@
 /* Define to 1 if you have the `setcontext' function. */
 #undef HAVE_SETCONTEXT
 
+/* Define to 1 if you have the `setitimer' function. */
+#undef HAVE_SETITIMER
+
 /* Define to 1 if you have the `settimeofday' function. */
 #undef HAVE_SETTIMEOFDAY
 

stix/lib/stix-prv.h

@@ -54,7 +54,7 @@
 
 /* this is for gc debugging */
 /*#define STIX_DEBUG_PROCESSOR*/
-/*#define STIX_DEBUG_GC_001*/
+#define STIX_DEBUG_GC_001
 /*#define STIX_DEBUG_GC_002*/
 #define STIX_DEBUG_COMP_001
 /*#define STIX_DEBUG_COMP_002*/
@@ -62,6 +62,9 @@
 /*#define STIX_DEBUG_EXEC_002*/
 #define STIX_PROFILE_EXEC
 
+/* allow the caller to drive process switching by calling
+ * stix_switchprocess(). */
+#define STIX_EXTERNAL_PROCESS_SWITCH
 
 /* limit the maximum object size such that:
  *   1. an index to an object field can be represented in a small integer.

stix/lib/stix.h

@@ -48,6 +48,7 @@ enum stix_errnum_t
 	STIX_ESYSMEM, /**< insufficient system memory */
 	STIX_EOOMEM,  /**< insufficient object memory */
 	STIX_EINVAL,  /**< invalid parameter or data */
+	STIX_EMSGSND, /**< message sending error. even doesNotUnderstand: is not found */
 	STIX_ERANGE,  /**< range error. overflow and underflow */
 	STIX_ENOENT,  /**< no matching entry */
 	STIX_EDFULL,  /**< dictionary full */
@@ -804,6 +805,7 @@ struct stix_t
 	stix_ooi_t sp;
 	stix_ooi_t ip;
 	int proc_switched; /* TODO: this is temporary. implement something else to skip immediate context switching */
+	int switch_proc;
 	/* == END EXECUTION REGISTERS == */
 
 	/* == BIGINT CONVERSION == */
@@ -819,11 +821,13 @@ struct stix_t
 #endif
 };
 
-
 #if defined(__cplusplus)
 extern "C" {
 #endif
 
+#define stix_switchprocess(stix) ((stix)->switch_proc = 1)
+
+
 STIX_EXPORT stix_t* stix_open (
 	stix_mmgr_t*         mmgr,
 	stix_oow_t           xtnsize,