reset the sender field to stix->_nil when creating a new process over a block context .

touched up exception handling implementation code

stix/kernel/Context.st

@@ -241,12 +241,12 @@
 		<exception>
 		handlerActive := true.
 
-thisContext isHandlerContext dump.
+"thisContext isHandlerContext dump.
 (thisContext basicSize) dump.
 (thisContext basicAt: 8) dump.  ## this should be anException
 (thisContext basicAt: 9) dump.  ## this should be anExceptionBlock
 (thisContext basicAt: 10) dump.  ## this should be handlerActive
-'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump.
+'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump."
 
 		^self value.
 	}
@@ -288,6 +288,11 @@ thisContext isHandlerContext dump.
 		self new signal: text
 	}
 
+	#method messageText
+	{
+		^self.messageText
+	}
+
 	#method signal 
 	{
 		self.signalContext := thisContext.
@@ -299,10 +304,6 @@ thisContext isHandlerContext dump.
 		self.handlerContext isNil 
 			ifTrue: [ self notHandled ]
 			ifFalse: [ self handle ].
-
-		## self isHandled
-		##	ifTrue: [ self handle ]
-		##	ifFalse: [ self notHandled ].
 	}
 
 	#method signal: text
@@ -314,7 +315,8 @@ thisContext isHandlerContext dump.
 	#method pass
 	{
 		## pass the exception to the outer context
-		## TODO:
+
+		## TODO: Should i change the signalContex to thisContext???
 		self.handlerContext := self findHandlerContextStartingFrom: (self.handlerContext sender).
 		self.handlerContext isNil 
 			ifTrue: [ self notHandled ]
@@ -330,23 +332,23 @@ thisContext isHandlerContext dump.
 
 	#method retry
 	{
-		## ##>>> Processor return: nil to: (self.signalContext sender).
+		## TODO: verify if return:to: causes unnecessary stack growth.
+
+		self.handlerContext pc: 0.
+		Processor return: self to: self.handlerContext.
+		##Processor forceContext: self.handlerContext.
 	}
 
 	#method resume
 	{
+		## TODO: verify if return:to: causes unnecessary stack growth.
 		## is this correct???
-		Processor return: nil to: (self.signalContext sender).
+		Processor return: self to: (self.signalContext sender).
 	}
 
 	## ####################################################################
 	## ####################################################################
 
-	#method isHandled
-	{
-		^self handlerContext notNil
-	}
-
 	#method handle
 	{
 		Processor return: (self.handlerContext handlerBlock value: self) to: (self.handlerContext sender)
@@ -383,4 +385,8 @@ Processor activeProcess terminate.
 
 #class NoSuchMessageException(Exception)
 {
+	#method signal
+	{
+		self signal: 'no such message'.
+	}
 }

stix/kernel/Process.st

@@ -386,4 +386,11 @@
 		<primitive: #_processor_return_to>
 		self primitiveFailed.
 	}
+
+	#method forceContext: aContext
+	{
+		<primitive: #_processor_force_context>
+		self primitiveFailed.
+	}
+
 }

stix/kernel/test-011.st

@@ -40,13 +40,18 @@
 	#method(#class) main2
 	{
 		| k |
-		k := ['this is test-011' dump. Exception signal. 8888 dump. ] 
+		k := ['this is test-011' dump. Exception signal: 'main2 screwed...'. 8888 dump. ] 
-			on: Exception do: [ :ex | 'Exception occurred' dump.  ex dump. 'Getting back to' dump. ex return: 9999. 'AFTER RETURN' dump. ].
+			on: Exception do: [ :ex | 'Exception occurred' dump.  ex messageText dump. 'Getting back to....' dump. "ex return: 9999." ex pass. 'AFTER RETURN' dump. ].
 
 		k dump.
 		'END OF test-011' dump.
 	}
 
+	#method(#class) raise_exception
+	{
+		Exception signal: 'bad exceptinon'.
+	}
+
 	#method(#class) test3
 	{
 		| k j |
@@ -54,23 +59,115 @@
 		k := [
 			'>>> TEST3 METHOD >>> ' dump.
 			j dump.
-			(j < 25) ifTrue: [Exception signal]. 
+			(j < 25) ifTrue: [ | t | 
+				t := Exception signal: 'bad exceptinon'.  ## when resume, t should get Exception.
+				t := self raise_exception.  ## when resumed, t should get 'self'
+				'RESUMED???' dump. 
+				t dump.
+				j dump.
+			]. 
+
 			'OOOOOOOOOOOOOOOOOOOOOOO' dump.
 			'JJJJJJJJJJJJJJ' dump. 
-		] on: Exception do: [ :ex | 'Exception occurred' dump.  j := j + 1. ex resume. ].
+		] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex resume. ].
 
 		k dump.
-		'END OF test-011' dump.
+		'END OF TEST3' dump.
+	}
+
+	#method(#class) test4_1
+	{
+		| k j |
+		j := 20.
+		k := [
+			'>>> TEST4_1 METHOD >>> ' dump.
+			j dump.
+			(j < 25) ifTrue: [ | t | 
+				##t := Exception signal: 'bad exceptinon'.  ## when resume, t should get Exception.
+				t := self raise_exception.  ## when resumed, t should get 'self'
+				'RESUMED???' dump. 
+				t dump.
+				j dump.
+			]. 
+
+			'OOOOOOOOOOOOOOOOOOOOOOO' dump.
+			'JJJJJJJJJJJJJJ' dump. 
+		] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex pass. ].
+
+		k dump.
+		'END OF TEST4_1' dump.
+	}
+
+	#method(#class) test4
+	{
+		'BEGINNING OF TEST4' dump.
+		[ self test4_1 ] on: Exception do: [:ex | 'Excepton in test4_1' dump. ex messageText dump. ex resume].
+		'END OF TEST4' dump.
+	}
+
+
+	#method(#class) test5
+	{
+		| k j |
+		'BEGINNING OF TEST5' dump.
+		j := 20.
+		k := [
+			'>>> TEST5 BLOCK >>> ' dump.
+			j dump.
+			(j < 25) ifTrue: [ | t | 
+				##t := Exception signal: 'bad exceptinon'.  ## when resume, t should get Exception.
+				t := self raise_exception.  ## when resumed, t should get 'self'
+			]. 
+
+			'OOOOOOOOOOOOOOOOOOOOOOO' dump.
+			'JJJJJJJJJJJJJJ' dump. 
+		] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex retry. ].
+
+		k dump.
+		'END OF TEST5' dump.
+	}
+
+	#method(#class) test11
+	{
+		## exception is raised in a new process. it can't be captured
+		## by an exception handler of a calling process.
+		## exception handling must not cross the process boundary.
+		[ 
+			|p | 
+			p := [Exception signal: 'Sample Exception' ] newProcess.
+			'JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ' dump.
+			p resume.
+		] on: Exception do: [:ex | 'EXCEPTION ----------' dump. ex messageText dump ].
+	}
+
+	#method(#class) test12
+	{
+		[ 
+			|p | 
+			p := [ 
+				[ Exception signal: 'Sample Exception' ] on: Exception do: [:ex | 'EXCEPTION CAUGHT...' dump. ex messageText dump. ]
+			] newProcess.
+			'JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ' dump.
+			p resume.
+		] on: Exception do: [:ex | 'EXCEPTION ----------' dump. ex messageText dump ].
 	}
 
 	#method(#class) main
 	{
+
 		'>>>>> BEGINNING OF MAIN' dump.
 
-		[ self main2 ] on: Exception do: [ :ex | 'EXCEPTION CAUGHT IN MAIN....' dump. "ex pass" ].
+	##	[ self main2 ] on: Exception do: [ :ex | 'EXCEPTION CAUGHT IN MAIN....' dump. ex messageText dump. "ex pass." ex resume. ].
 
 		'##############################' dump.
-		self test3.
+	##	self test3.
+	##	self test4.
+
+		self test5.
+	##	self test11.
+	##	self test12.
+
+		##100 timesRepeat: ['>>>>> END OF MAIN' dump].
 		'>>>>> END OF MAIN' dump.
 	}
 }

stix/lib/exec.c

@@ -202,6 +202,8 @@ static stix_oop_process_t make_process (stix_t* stix, stix_oop_context_t c)
 	proc->current_context = c;
 	proc->sp = STIX_SMOOI_TO_OOP(-1);
 
+	STIX_ASSERT ((stix_oop_t)c->sender == stix->_nil);
+
 #if defined(STIX_DEBUG_PROCESSOR)
 printf ("PROCESS %p SIZE => %ld\n", proc, (long int)STIX_OBJ_GET_SIZE(proc));
 #endif
@@ -804,6 +806,14 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth)
 	stix_ooi_t i;
 	stix_ooi_t ntmprs, nargs;
 
+	ntmprs = STIX_OOP_TO_SMOOI(mth->tmpr_count);
+	nargs = STIX_OOP_TO_SMOOI(mth->tmpr_nargs);
+
+	STIX_ASSERT (ntmprs >= 0);
+	STIX_ASSERT (nargs <= ntmprs);
+#if defined(STIX_USE_PROCSTK)
+	/* nothing special */
+#else
 	/* message sending requires a receiver to be pushed. 
 	 * the stack pointer of the sending context cannot be -1.
 	 * if one-argumented message is invoked the stack of the
@@ -826,14 +836,6 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth)
 	 *   |                     | slot[stack_size - 1] 
 	 *   +---------------------+
 	 */
-	ntmprs = STIX_OOP_TO_SMOOI(mth->tmpr_count);
-	nargs = STIX_OOP_TO_SMOOI(mth->tmpr_nargs);
-
-	STIX_ASSERT (ntmprs >= 0);
-	STIX_ASSERT (nargs <= ntmprs);
-#if defined(STIX_USE_PROCSTK)
-	/* nothing special */
-#else
 	STIX_ASSERT (stix->sp >= 0);
 	STIX_ASSERT (stix->sp >= nargs);
 #endif
@@ -845,6 +847,10 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth)
 
 	ctx->sender = stix->active_context; 
 	ctx->ip = STIX_SMOOI_TO_OOP(0);
+	
+#if defined(STIX_USE_PROCSTK)
+	/* ctx->sp will be set further down */
+#else
 	/* the front part of a stack has temporary variables including arguments.
 	 *
 	 * New Context
@@ -867,9 +873,6 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth)
 	 *
 	 * if no temporaries exist, the initial sp is -1.
 	 */
-#if defined(STIX_USE_PROCSTK)
-	/* ctx->sp will be set further down */
-#else
 	ctx->sp = STIX_SMOOI_TO_OOP(ntmprs - 1);
 #endif
 	ctx->ntmprs = STIX_SMOOI_TO_OOP(ntmprs);
@@ -1013,7 +1016,14 @@ static int start_initial_process_and_context (stix_t* stix, const stix_oocs_t* o
 	stix_oop_process_t proc;
 
 	/* create a fake initial context */
+#if defined(STIX_USE_PROCSTK)
+	ctx = (stix_oop_context_t)stix_instantiate (stix, stix->_method_context, STIX_NULL, 0);
+#else
+	/* stack size is set to 1 because it needs sapce to push the receiver 
+	 * referenced by 'objname' */
+/* TODO: increase the stack size to allow arguments to the intial methods */
 	ctx = (stix_oop_context_t)stix_instantiate (stix, stix->_method_context, STIX_NULL, 1);
+#endif
 	if (!ctx) return -1;
 
 	ass = stix_lookupsysdic (stix, objname);
@@ -1072,7 +1082,7 @@ TODO: overcome this problem
 	stix_poptmps (stix, 3);
 	if (!proc) return -1;
 
-	ACTIVE_STACK_PUSH (stix, ass->value); /* push the receiver */
+	ACTIVE_STACK_PUSH (stix, ass->value); /* push the receiver - the object referenced by 'objname' */
 	STORE_ACTIVE_SP (stix); /* stix->active_context->sp = STIX_SMOOI_TO_OOP(stix->sp) */
 
 	STIX_ASSERT (stix->processor->active == proc);
@@ -1080,7 +1090,6 @@ TODO: overcome this problem
 	STIX_ASSERT (stix->processor->active->current_context == ctx);
 	STIX_ASSERT (stix->active_context == ctx);
 
-
 	/* emulate the message sending */
 	return activate_new_method (stix, mth);
 }
@@ -1612,6 +1621,12 @@ printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
 	x = __block_value (stix, nargs, nargs, num_first_arg_elems, &blkctx);
 	if (x <= 0) return x; /* both hard failure and soft failure */
 
+	/* reset the sender field to stix->_nil because this block context
+	 * will be the initial context of a new process. you can simply
+	 * inspect the sender field to see if a context is an initial
+	 * context of a process. */
+	blkctx->sender = (stix_oop_context_t)stix->_nil;
+
 	proc = make_process (stix, blkctx);
 	if (!proc) return -1; /* hard failure */ /* TOOD: can't this be treated as a soft failure? */
 
@@ -1856,7 +1871,7 @@ static int prim_processor_return_to (stix_t* stix, stix_ooi_t nargs)
 	if (rcv != (stix_oop_t)stix->processor) return 0;
 
 	if (STIX_CLASSOF(stix, ctx) != stix->_block_context &&
-	    STIX_CLASSOF(stix, ctx) == stix->_method_context) return 0;
+	    STIX_CLASSOF(stix, ctx) != stix->_method_context) return 0;
 
 	ACTIVE_STACK_POPS (stix, nargs + 1); /* pop arguments and receiver */
 
@@ -1866,6 +1881,28 @@ static int prim_processor_return_to (stix_t* stix, stix_ooi_t nargs)
 	return 1;
 }
 
+static int prim_processor_force_context (stix_t* stix, stix_ooi_t nargs)
+{
+	stix_oop_t rcv, ctx;
+
+	STIX_ASSERT (nargs == 1);
+
+	rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
+	ctx = ACTIVE_STACK_GET(stix, stix->sp);
+
+	if (rcv != (stix_oop_t)stix->processor) return 0;
+
+	if (STIX_CLASSOF(stix, ctx) != stix->_block_context &&
+	    STIX_CLASSOF(stix, ctx) != stix->_method_context) return 0;
+
+	ACTIVE_STACK_POPS (stix, nargs + 1); /* pop arguments and receiver */
+	/* TODO: push nothing??? */
+
+	SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)ctx);
+
+	return 1;
+}
+
 static int prim_integer_add (stix_t* stix, stix_ooi_t nargs)
 {
 	stix_oop_t rcv, arg, res;
@@ -2555,6 +2592,7 @@ static prim_t primitives[] =
 	{   2,  3,  prim_processor_add_timed_semaphore,    "_processor_add_timed_semaphore" },
 	{   1,  1,  prim_processor_remove_semaphore,       "_processor_remove_semaphore" },
 	{   2,  2,  prim_processor_return_to,              "_processor_return_to" },
+	{   1,  1,  prim_processor_force_context,          "_processor_force_context" },
 
 	{   1,  1,  prim_integer_add,          "_integer_add"         },
 	{   1,  1,  prim_integer_sub,          "_integer_sub"         },
@@ -3785,6 +3823,7 @@ printf ("<<<RETURNIGN TO THE INITIAL CONTEXT>>> TERMINATING SP => %ld\n", (long
 
 				if (stix->active_context == stix->processor->active->initial_context)
 				{
+					STIX_ASSERT ((stix_oop_t)stix->active_context->sender == stix->_nil);
 #if defined(STIX_DEBUG_EXEC_002)
 printf ("TERMINATE A PROCESS RETURNING FROM BLOCK\n");
 #endif