migrated some primitives from Processor to System.

Fixed a bug in manipulating moo->sem_io_wait_count.
Experimenting to add a shortcut exception handling syntax

moo/kernel/Except.moo

@@ -69,7 +69,7 @@ TODO: can i convert 'thisProcess primError' to a relevant exception?
 				exctx basicAt: actpos put: false.
 				[ retval := exblk value: self ] ensure: [ exctx basicAt: actpos put: true ].
 				thisContext unwindTo: (exctx sender) return: nil.
-				Processor return: retval to: (exctx sender).
+				System return: retval to: (exctx sender).
 			}.
 			exctx := (exctx sender) findExceptionContext.
 		}.
@@ -113,7 +113,7 @@ System logNl: '== END OF BACKTRACE =='.
 
 	method return: value
 	{
-		if (self.handlerContext notNil) { Processor return: value to: self.handlerContext }
+		if (self.handlerContext notNil) { System return: value to: self.handlerContext }
 	}
 
 	method retry
@@ -122,7 +122,7 @@ System logNl: '== END OF BACKTRACE =='.
 		if (self.handlerContext notNil) 
 		{
 			self.handlerContext pc: 0.
-			Processor return: self to: self.handlerContext.
+			System return: self to: self.handlerContext.
 		}
 	}
 
@@ -136,7 +136,7 @@ System logNl: '== END OF BACKTRACE =='.
 			ctx := self.signalContext sender.
 			self.signalContext := nil.
 			self.handlerContext := nil.
-			Processor return: value to: ctx.
+			System return: value to: ctx.
 		}.
 	}
 
@@ -212,31 +212,45 @@ extend Context
 }
 
 ##============================================================================
+pooldic MethodContext.Preamble
+{
+	## this must follow MOO_METHOD_PREAMBLE_EXCEPTION in moo.h
+	EXCEPTION := 13.
+
+	## this must follow MOO_METHOD_PREAMBLE_ENSURE in moo.h
+	ENSURE := 14.
+}
+
+pooldic MethodContext.Index
+{
+	## [ value-block ] ensure: [ ensure-block ]
+	## assuming ensure block is a parameter the ensure: method to a 
+	## block context, the first parameter is placed after the fixed
+	## instance variables of the method context. As MethodContex has
+	## instance variables, the ensure block must be at the 9th position
+	## which translates to index 8 
+	ENSURE := 8.
+
+
+	## [ ... ] on: Exception: do: [:ex | ... ]
+	FIRST_ON := 8.
+}
+
 extend MethodContext
 {
 	method isExceptionContext
 	{
-		## 12 - MOO_METHOD_PREAMBLE_EXCEPTION in VM.
+		^self.method preambleCode == MethodContext.Preamble.EXCEPTION.
-		^self.method preambleCode == 13.
 	}
 
 	method isEnsureContext
 	{
-		## 13 - MOO_METHOD_PREAMBLE_ENSURE in VM.
+		^self.method preambleCode == MethodContext.Preamble.ENSURE.
-		^self.method preambleCode == 14
 	}
 
 	method ensureBlock
 	{
-## TODO: change 8 to a constant when moo is enhanced to support constant definition
+		^if (self.method preambleCode == MethodContext.Preamble.ENSURE) { self basicAt: MethodContext.Index.ENSURE } else { nil }
-
-		(* [ value-block ] ensure: [ ensure-block ]
-		 * assuming ensure block is a parameter the ensure: method to a 
-		 * block context, the first parameter is placed after the fixed
-		 * instance variables of the method context. As MethodContex has
-		 * 8 instance variables, the ensure block must be at the 9th position
-		 * which translates to index 8 *)
-		^if (self.method preambleCode == 14) { self basicAt: 8 } else { nil }
 	}
 
 
@@ -250,10 +264,7 @@ extend MethodContext
 		 *   basicAt: 8 must be the on: argument.
 		 *   basicAt: 9 must be the do: argument  *)
 
-## TODO: change 8 to a constant when moo is enhanced to support constant definition
+		| size exc i |
-##       or calcuate the minimum size using the class information.
-
-		| size exc |
 		
 		if (self isExceptionContext) 
 		{
@@ -262,10 +273,20 @@ extend MethodContext
 			 *       those must be skipped from scanning. *)
 
 			size := self basicSize.
-			8 priorTo: size by: 2 do: [ :i | 
+			##8 priorTo: size by: 2 do: [ :i | 
+			##	exc := self basicAt: i.
+			##	if ((exception_class == exc) or: [exception_class inheritsFrom: exc]) { ^self basicAt: (i + 1) }.
+			##]
+			i := MethodContext.Index.FIRST_ON.
+			while (i < size)
+			{
 				exc := self basicAt: i.
-				if ((exception_class == exc) or: [exception_class inheritsFrom: exc]) { ^self basicAt: (i + 1) }.
+				if ((exception_class == exc) or: [exception_class inheritsFrom: exc]) 
-			]
+				{ 
+					^self basicAt: (i + 1).
+				}.
+				i := i + 2.
+			}.
 		}.
 		^nil.
 	}
@@ -319,7 +340,7 @@ extend MethodContext
 		 * [ [Exception signal: 'xxx'] ensure: [20] ] on: Exception do: [:ex | ...]
 		 * ---------------------------------------------------------------- *)
 		thisContext unwindTo: self.sender return: nil.
-		Processor return: retval to: self.sender.
+		System return: retval to: self.sender.
 	}
 }
 

moo/kernel/Process.moo

@@ -239,6 +239,54 @@ method(#class,#abstract) xxx. => method(#class) xxx { self subclassResponsibilit
 		^x
 	}
 
+	method _waitWithTimeout: seconds
+	{
+		| s r |
+
+		## create an internal semaphore for timeout notification.
+		s := Semaphore _new.
+		if (s isError) { ^s }.
+
+		## grant the partial membership to the internal semaphore.
+		## it's partial because it's not added to self.semarr.
+		##s _group: self. 
+		if ((r := (self addSemaphore: s)) isError) { ^r }.
+
+		## arrange the processor to notify upon timeout.
+		if ((r := (System _signal: s after: seconds)) isError) { ^r }.
+
+		if ((r := self _wait) isError) 
+		{
+			System _unsignal: s.
+			^r.
+		}.
+
+		## if the internal semaphore has been signaled, 
+		## arrange to return nil to indicate timeout.
+		if (r == s) { r := nil }
+		elsif (r signalAction notNil) { r signalAction value: r }.
+
+		## nullify the membership
+		self _removeSemaphore: s.
+
+		## cancel the notification arrangement in case it didn't time out.
+		System _unsignal: s.
+
+		^r.
+	}
+
+	method waitWithTimeout: seconds
+	{
+		| r |
+		r := self _waitWithTimeout: seconds.
+		if (r isError)  
+		{
+			Exception signal: 'Error has occurred...' error: r.
+		}.
+		^r
+	}
+
+(*
 	method waitWithTimeout: seconds
 	{
 		| s r |
@@ -254,8 +302,13 @@ method(#class,#abstract) xxx. => method(#class) xxx { self subclassResponsibilit
 		## arrange the processor to notify upon timeout.
 		System signal: s after: seconds.
 
-		## wait on the semaphore group.
+		[
-		r := self wait.
+			## wait on the semaphore group.
+			r := self wait.
+		] on: Exception do: [:ex |
+			System _unsignal: s.
+			ex throw
+		].
 
 		## if the internal semaphore has been signaled, 
 		## arrange to return nil to indicate timeout.
@@ -270,6 +323,7 @@ method(#class,#abstract) xxx. => method(#class) xxx { self subclassResponsibilit
 
 		^r.
 	} 
+*)
 }
 
 class SemaphoreHeap(Object)
@@ -471,10 +525,4 @@ class(#final,#limited) ProcessScheduler(Object)
 			].
 		*)
 	}
-
-	method return: object to: context
-	{
-		<primitive: #_processor_return_to>
-		self primitiveFailed.
-	}
 }

moo/kernel/System.moo

@@ -97,6 +97,7 @@ class System(Apex)
 
 	method(#class,#primitive) _popCollectable.
 	method(#class,#primitive) collectGarbage.
+	method(#class,#primitive) return: object to: context.
 
 	## =======================================================================================
 

moo/lib/comp.c

@@ -1682,8 +1682,26 @@ retry:
 			break;
 
 		case '{': /* extension */
+#if 0
 			SET_TOKEN_TYPE (moo, MOO_IOTOK_LBRACE);
 			goto single_char_token;
+#else
+			SET_TOKEN_TYPE (moo, MOO_IOTOK_RETURN);
+			ADD_TOKEN_CHAR(moo, c);
+			GET_CHAR_TO (moo, c);
+
+			if (c == '@')
+			{
+				/* {@ */
+				TOKEN_TYPE(moo) = MOO_IOTOK_DEH_BLOCK; /* default exception handling block */ 
+				ADD_TOKEN_CHAR (moo, c);
+			}
+			else
+			{
+				unget_char (moo, &moo->c->lxc);
+			}
+			break;
+#endif
 		case '}': /* extension */
 			SET_TOKEN_TYPE (moo, MOO_IOTOK_RBRACE);
 			goto single_char_token;

moo/lib/exec.c

@@ -541,7 +541,14 @@ static void terminate_process (moo_t* moo, moo_oop_process_t proc)
 			{
 				/* no runnable process after termination */
 				MOO_ASSERT (moo, moo->processor->active == moo->nil_process);
-				MOO_LOG1 (moo, MOO_LOG_IC | MOO_LOG_DEBUG, "No runnable process after termination - process %zd\n", MOO_OOP_TO_SMOOI(proc->id));
+				MOO_LOG5 (moo, MOO_LOG_IC | MOO_LOG_DEBUG, 
+					"No runnable process after termination of process %zd - total %zd runnable/running %zd suspended %zd - sem_io_wait_count %zu\n", 
+					MOO_OOP_TO_SMOOI(proc->id),
+					MOO_OOP_TO_SMOOI(moo->processor->total_count),
+					MOO_OOP_TO_SMOOI(moo->processor->runnable.count),
+					MOO_OOP_TO_SMOOI(moo->processor->suspended.count),
+					moo->sem_io_wait_count
+				);
 			}
 			else
 			{
@@ -891,7 +898,7 @@ static MOO_INLINE moo_oop_t await_semaphore_group (moo_t* moo, moo_oop_semaphore
 	chain_into_semaphore (moo, proc, (moo_oop_semaphore_t)semgrp); 
 	MOO_ASSERT (moo, semgrp->waiting.last == proc);
 
-	if (MOO_OOP_TO_SMOOI(semgrp->sem_io_count) >= 0) 
+	if (MOO_OOP_TO_SMOOI(semgrp->sem_io_count) > 0) 
 	{
 		/* there might be more than 1 IO semaphores in the group
 		 * but i increment moo->sem_io_wait_count by 1 only */
@@ -2597,7 +2604,9 @@ static moo_pfrc_t pf_semaphore_group_add_semaphore (moo_t* moo, moo_ooi_t nargs)
 				moo_oop_process_t wp;
 				/* TODO: add sem_wait_count to process. no traversal... */
 				for (wp = rcv->waiting.first; (moo_oop_t)wp != moo->_nil; wp = wp->sem_wait.next)
+				{
 					moo->sem_io_wait_count++;
+				}
 			}
 		}
 
@@ -2671,7 +2680,9 @@ static moo_pfrc_t pf_semaphore_group_remove_semaphore (moo_t* moo, moo_ooi_t nar
 				moo_oop_process_t wp;
 				/* TODO: add sem_wait_count to process. no traversal... */
 				for (wp = rcv->waiting.first; (moo_oop_t)wp != moo->_nil; wp = wp->sem_wait.next)
+				{
 					moo->sem_io_wait_count--;
+				}
 			}
 		}
 
@@ -2942,7 +2953,7 @@ static moo_pfrc_t pf_system_remove_semaphore (moo_t* moo, moo_ooi_t nargs)
 
 /* ------------------------------------------------------------------ */
 
-static moo_pfrc_t pf_processor_return_to (moo_t* moo, moo_ooi_t nargs)
+static moo_pfrc_t pf_system_return_value_to_context (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t ret, ctx;
 
@@ -2953,15 +2964,11 @@ static moo_pfrc_t pf_processor_return_to (moo_t* moo, moo_ooi_t nargs)
 	ret = MOO_STACK_GETARG(moo, nargs, 0);
 	ctx = MOO_STACK_GETARG(moo, nargs, 1);
 
-	if (MOO_CLASSOF(moo, ctx) != moo->_block_context &&
+	MOO_PF_CHECK_ARGS_STRICT (moo, nargs, MOO_CLASSOF(moo, ctx) == moo->_block_context ||
-	    MOO_CLASSOF(moo, ctx) != moo->_method_context) 
+	                                      MOO_CLASSOF(moo, ctx) == moo->_method_context);
-	{
-		MOO_STACK_SETRETTOERROR (moo, nargs, MOO_EINVAL);
-		return MOO_PF_FAILURE;
-	}
 
 	MOO_STACK_POPS (moo, nargs + 1); /* pop arguments and receiver */
-/* TODO: verify if this is correct? does't it correct restore the stack pointer?
+/* TODO: verify if this is correct? does't it correctly restore the stack pointer?
  *       test complex chains of method contexts and block contexts */
 	if (MOO_CLASSOF(moo, ctx) == moo->_method_context)
 	{
@@ -4322,7 +4329,6 @@ static pf_t pftab[] =
 	{ "_block_value",                          { pf_block_value,                          0, MA } },
 	{ "_block_new_process",                    { pf_block_new_process,                    0, 1  } },
 
-	{ "_processor_return_to",                  { pf_processor_return_to,                  2, 2 } },
 	{ "_processor_schedule",                   { pf_processor_schedule,                   1, 1 } },
 
 	{ "_integer_add",                          { pf_integer_add,                          1, 1 } },
@@ -4430,7 +4436,8 @@ static pf_t pftab[] =
 	{ "System__unsignal:",                     { pf_system_remove_semaphore,              1, 1 } },
 
 	{ "System_collectGarbage",                 { pf_system_collect_garbage,               0, 0 } },
-	{ "System_log",                            { pf_system_log,                           2, MA } }
+	{ "System_log",                            { pf_system_log,                           2, MA } },
+	{ "System_return:to:",                     { pf_system_return_value_to_context,       2, 2 } }
 };
 
 moo_pfbase_t* moo_getpfnum (moo_t* moo, const moo_ooch_t* ptr, moo_oow_t len, moo_ooi_t* pfnum)
@@ -5035,9 +5042,12 @@ static MOO_INLINE int switch_process_if_needed (moo_t* moo)
 				 * to schedule.
 				 */
 
-				MOO_LOG3 (moo, MOO_LOG_IC | MOO_LOG_DEBUG, 
+				MOO_LOG4 (moo, MOO_LOG_IC | MOO_LOG_DEBUG, 
-					"Signaled GCFIN semaphore without gcfin signal request - total - %zd runnable/running - %zd suspended - %zd\n",
+					"Signaled GCFIN semaphore without gcfin signal request - total %zd runnable/running %zd suspended %zd - sem_io_wait_count %zu\n",
-					MOO_OOP_TO_SMOOI(moo->processor->total_count), MOO_OOP_TO_SMOOI(moo->processor->runnable.count), MOO_OOP_TO_SMOOI(moo->processor->suspended.count));
+					MOO_OOP_TO_SMOOI(moo->processor->total_count),
+					MOO_OOP_TO_SMOOI(moo->processor->runnable.count),
+					MOO_OOP_TO_SMOOI(moo->processor->suspended.count),
+					moo->sem_io_wait_count);
 				proc = signal_semaphore (moo, moo->sem_gcfin);
 				if ((moo_oop_t)proc != moo->_nil) 
 				{

moo/lib/moo-prv.h

@@ -361,6 +361,7 @@ struct moo_iotok_t
 		MOO_IOTOK_HASHBRACK,   /* #[ - byte array literal */
 		MOO_IOTOK_PERCPAREN,   /* %( - array expression */
 		MOO_IOTOK_PERCBRACE,   /* %{ - dictionary expression */
+		MOO_IOTOK_DEHBRACE,    /* {% */
 		MOO_IOTOK_PERIOD,
 		MOO_IOTOK_COMMA,
 		MOO_IOTOK_SEMICOLON

moo/lib/moo.h

@@ -1020,6 +1020,9 @@ struct moo_pfinfo_t
 	if (!(cond)) { MOO_STACK_SETRETTOERROR ((moo), (nargs), MOO_EINVAL); return MOO_PF_SUCCESS; } \
 } while(0)
 
+#define MOO_PF_CHECK_ARGS_STRICT(moo,nargs,cond) do { \
+	if (!(cond)) { MOO_STACK_SETRETTOERROR ((moo), (nargs), MOO_EINVAL); return MOO_PF_FAILURE; } \
+} while(0)
 /* =========================================================================
  * MODULE MANIPULATION
  * ========================================================================= */