fixed an error in moo_seterrbfmt() and moo_seterrufmt()

moo/kernel/Apex.moo

@@ -90,12 +90,13 @@ extend Apex
 
 	## -------------------------------------------------------
 	## -------------------------------------------------------
-	##method(#primitive,#lenient) _shallowCopy.
+	##method(#dual,#primitive,#lenient) _shallowCopy.
+	##method(#dual,#primitive) shallowCopy.
 	
 	method(#dual) shallowCopy
 	{
 		<primitive: #_shallow_copy>
-		self primitiveFailed.
+		self primitiveFailed(thisContext method).
 	}
 
 	

moo/kernel/Collect.moo

@@ -112,6 +112,12 @@ class(#character) String(Array)
 	{
 	}
 	*)
+
+
+	(* The strlen method returns the number of characters before a terminating null.
+	 * if no terminating null character exists, it returns the same value as the size method *)
+	method(#primitive,#lenient) _strlen.
+	method(#primitive) strlen.
 }
 
 ## -------------------------------------------------------------------------------

moo/kernel/Except.moo

@@ -431,12 +431,34 @@ class ProhibitedMessageException(Exception)
 {
 }
 
+(*
+pooldic ErrorToException
+{
+	ErrorCode.EINVAL := InvalidArgumentException.
+	ErrorCode.ENOIMPL := NotImplementedException.
+}
+*)
+
 extend Apex
 {
 	method(#dual,#liberal) primitiveFailed(method)
 	{
 		| a b msg ec ex |
 
+		(* since method is an argument, the caller can call this method
+		 * from a context chain where the method context actually doesn't exist.
+		 * when a primitive method is defined using the #primitive method,
+		 * the VM invokes this primtiveFailed method without creating 
+		 * the context for the primitive method.
+		 *    method(#primitive) xxx.
+		 *    method(#primitive) xxx { <primitive: #_xxx> ^self primitiveFailed(thisContext method). }
+		 * in the former definition, primitiveFailed is called without
+		 * an activate context for the method xxx if the primitive fails.
+		 * on the other handle, in the latter definition, the context
+		 * for the method is activated first before primitiveFailed is 
+		 * invoked. in the context chain, the method for xxx is found.
+		 *)
+		 
 		(*System logNl: 'Arguments: '.
 		a := 0.
 		b := thisContext vargCount.
@@ -445,11 +467,13 @@ extend Apex
 			System logNl: (thisContext vargAt: a) asString.
 			a := a + 1.
 		}.*)
-		
+
 		ec := thisProcess primError.
-		msg := ec asString.
+		msg := thisProcess primErrorMessage.
+		if (msg isNil) { msg := ec asString }.
 		if (method notNil) { msg := msg & ' - ' & (method owner name) & '>>' & (method name) }.
-		(PrimitiveFailureException withErrorCode: ec) signal: msg.
+
+		(PrimitiveFailureException (* in: method *) withErrorCode: ec) signal: msg.
 	}
 
 	method(#dual) doesNotUnderstand: message_name

moo/kernel/Process.moo

@@ -1,7 +1,7 @@
 
 class(#pointer,#final,#limited) Process(Object)
 {
-	var initial_context, current_context, state, sp, prev, next, sem, perr.
+	var initial_context, current_context, state, sp, prev, next, sem, perr, perrmsg.
 
 	method prev { ^self.prev }
 	method next { ^self.next }
@@ -10,30 +10,16 @@ class(#pointer,#final,#limited) Process(Object)
 	method prev: process { self.prev := process }
 
 	method primError { ^self.perr }
+	method primErrorMessage { ^self.perrmsg }
 
-	method resume
+	method(#primitive) resume.
-	{
+	method(#primitive) yield.
-		<primitive: #_process_resume>
+	method(#primitive) _terminate.
-		self primitiveFailed
+	method(#primitive) _suspend.
-
-		##^Processor resume: self.
-	}
-
-	method _terminate
-	{
-		<primitive: #_process_terminate>
-		self primitiveFailed
-	}
-
-	method _suspend
-	{
-		<primitive: #_process_suspend>
-		self primitiveFailed
-	}
 
 	method terminate
 	{
-##search from the top contextof the process down to intial_contextand find ensure blocks and execute them.
+##search from the top contextof the process down to intial_context and find ensure blocks and execute them.
 		## if a different process calls 'terminate' on a process,
 		## the ensureblock is not executed in the context of the
 		## process being terminated, but in the context of terminatig process.
@@ -62,12 +48,6 @@ class(#pointer,#final,#limited) Process(Object)
 		^self _terminate
 	}
 
-	method yield
-	{
-		<primitive: #_process_yield>
-		self primitiveFailed
-	}
-
 	method sp
 	{
 		^self.sp.

moo/lib/comp.c

@@ -3797,6 +3797,113 @@ static int compile_method_pragma (moo_t* moo)
 	return 0;
 }
 
+static int find_dotted_ident (moo_t* moo, const moo_oocs_t* name, const moo_ioloc_t* name_loc, var_info_t* var)
+{
+	/* if a name is dotted,
+	 * 
+	 *   self.XXX - instance variable
+	 *   A.B.C    - namespace or pool dictionary related reference.
+	 *   self.B.C - B.C under the current class where B is not an instance variable
+	 */
+
+	moo_oocs_t last;
+	moo_oop_set_t ns_oop;
+	moo_oop_association_t ass;
+	const moo_ooch_t* dot;
+
+	dot = moo_findoochar (name->ptr, name->len, '.');
+	MOO_ASSERT (moo, dot != MOO_NULL);
+	if (dot - (const moo_ooch_t*)name->ptr == 4 && 
+	    moo_equaloochars(name->ptr, vocas[VOCA_SELF].str, 4))
+	{
+		/* special case. the dotted name begins with self. */
+		dot = moo_findoochar (dot + 1, name->len - 5, '.');
+		if (!dot)
+		{
+			/* the dotted name is composed of 2 segments only */
+			last.ptr = name->ptr + 5;
+			last.len = name->len - 5;
+			if (is_reserved_word(&last))
+			{
+				/* self. is followed by a reserved word.
+				 * a proper variable name is expected. */
+				set_syntax_error (moo, MOO_SYNERR_VARNAME, name_loc, name);
+				return -1;
+			}
+
+			if (find_class_level_variable(moo, moo->c->cls.self_oop, &last, var) >= 0)
+			{
+				/* indicate that it's not a global variable */
+				return 1;
+			}
+			else
+			{
+				/* undeclared identifier */
+				set_syntax_error (moo, MOO_SYNERR_VARUNDCL, name_loc, name);
+				return -1;
+			}
+		}
+	}
+
+	if (preprocess_dotted_name (moo, PDN_DONT_ADD_NS | PDN_ACCEPT_POOLDIC_AS_NS, MOO_NULL, name, name_loc, &last, &ns_oop) <= -1) return -1;
+
+	ass = moo_lookupdic (moo, ns_oop, &last);
+	if (!ass)
+	{
+		/* undeclared identifier */
+		set_syntax_error (moo, MOO_SYNERR_VARUNDCL, name_loc, name);
+		return -1;
+	}
+
+	var->type = VAR_GLOBAL;
+	var->gbl = ass;
+	return 0;
+}
+
+static int find_ident_in_nsdic_and_sysdic (moo_t* moo, const moo_oocs_t* name, const moo_ioloc_t* name_loc, var_info_t* var)
+{
+	moo_oop_association_t ass;
+
+	/* find an undotted identifier in dictionaries */
+
+	ass = moo_lookupdic (moo, moo->c->cls.ns_oop, name); /* in the current name space */
+	if (!ass && moo->c->cls.ns_oop != moo->sysdic) 
+		ass = moo_lookupdic (moo, moo->sysdic, name); /* in the top-level system dictionary */
+
+	if (!ass)
+	{
+		moo_oow_t i;
+		moo_oop_association_t ass2 = MOO_NULL;
+
+		/* attempt to find the variable in pool dictionaries */
+		for (i = 0; i < moo->c->cls.pooldic_count; i++)
+		{
+			ass = moo_lookupdic (moo, moo->c->cls.pooldic_imp_oops[i], name);
+			if (ass)
+			{
+				if (ass2)
+				{
+					/* the variable name has been found at least in 2 dictionaries - ambiguous */
+					set_syntax_error (moo, MOO_SYNERR_VARAMBIG, name_loc, name);
+					return -1;
+				}
+				ass2 = ass;
+			}
+		}
+
+		ass = ass2;
+		if (!ass) 
+		{
+			set_syntax_error (moo, MOO_SYNERR_VARUNDCL, name_loc, name);
+			return -1;
+		}
+	}
+
+	var->type = VAR_GLOBAL;
+	var->gbl = ass;
+	return 0;
+}
+
 static int get_variable_info (moo_t* moo, const moo_oocs_t* name, const moo_ioloc_t* name_loc, int name_dotted, var_info_t* var)
 {
 	moo_oow_t index;
@@ -3805,61 +3912,9 @@ static int get_variable_info (moo_t* moo, const moo_oocs_t* name, const moo_iolo
 
 	if (name_dotted)
 	{
-		/* if a name is dotted,
+		int n;
-		 * 
+		if ((n = find_dotted_ident (moo, name, name_loc, var)) <= -1) return -1;
-		 *   self.XXX - instance variable
+		if (n >= 1) goto class_level_variable;
-		 *   A.B.C    - namespace or pool dictionary related reference.
-		 *   self.B.C - B.C under the current class where B is not an instance variable
-		 */
-
-		moo_oocs_t last;
-		moo_oop_set_t ns_oop;
-		moo_oop_association_t ass;
-		const moo_ooch_t* dot;
-
-		dot = moo_findoochar (name->ptr, name->len, '.');
-		MOO_ASSERT (moo, dot != MOO_NULL);
-		if (dot - (const moo_ooch_t*)name->ptr == 4 && 
-		    moo_equaloochars(name->ptr, vocas[VOCA_SELF].str, 4))
-		{
-			/* the dotted name begins with self. */
-			dot = moo_findoochar (dot + 1, name->len - 5, '.');
-			if (!dot)
-			{
-				/* the dotted name is composed of 2 segments only */
-				last.ptr = name->ptr + 5;
-				last.len = name->len - 5;
-				if (!is_reserved_word(&last))
-				{
-					if (find_class_level_variable(moo, moo->c->cls.self_oop, &last, var) >= 0)
-					{
-						goto class_level_variable;
-					}
-					else
-					{
-						/* undeclared identifier */
-						set_syntax_error (moo, MOO_SYNERR_VARUNDCL, name_loc, name);
-						return -1;
-					}
-				}
-			}
-		}
-
-		if (preprocess_dotted_name (moo, PDN_DONT_ADD_NS | PDN_ACCEPT_POOLDIC_AS_NS, MOO_NULL, name, name_loc, &last, &ns_oop) <= -1) return -1;
-
-		ass = moo_lookupdic (moo, ns_oop, &last);
-		if (ass)
-		{
-			var->type = VAR_GLOBAL;
-			var->gbl = ass;
-		}
-		else
-		{
-			/* undeclared identifier */
-			set_syntax_error (moo, MOO_SYNERR_VARUNDCL, name_loc, name);
-			return -1;
-		}
-
 		return 0;
 	}
 
@@ -3918,50 +3973,7 @@ static int get_variable_info (moo_t* moo, const moo_oocs_t* name, const moo_iolo
 		}
 		else 
 		{
-			moo_oop_association_t ass;
+			if (find_ident_in_nsdic_and_sysdic (moo, name, name_loc, var) <= -1) return -1;
-			/*ass = moo_lookupsysdic (moo, name);*/
-			ass = moo_lookupdic (moo, moo->c->cls.ns_oop, name);
-			if (!ass && moo->c->cls.ns_oop != moo->sysdic) 
-				ass = moo_lookupdic (moo, moo->sysdic, name);
-
-			if (ass)
-			{
-				var->type = VAR_GLOBAL;
-				var->gbl = ass;
-			}
-			else
-			{
-				moo_oow_t i;
-				moo_oop_association_t ass2 = MOO_NULL;
-
-				/* attempt to find the variable in pool dictionaries */
-				for (i = 0; i < moo->c->cls.pooldic_count; i++)
-				{
-					ass = moo_lookupdic (moo, moo->c->cls.pooldic_imp_oops[i], name);
-					if (ass)
-					{
-						if (ass2)
-						{
-							/* the variable name has been found at least in 2 dictionaries */
-							set_syntax_error (moo, MOO_SYNERR_VARAMBIG, name_loc, name);
-							return -1;
-						}
-						ass2 = ass;
-					}
-				}
-
-				if (ass2)
-				{
-					var->type = VAR_GLOBAL;
-					var->gbl = ass2;
-				}
-				else
-				{
-					/* undeclared identifier */
-					set_syntax_error (moo, MOO_SYNERR_VARUNDCL, name_loc, name);
-					return -1;
-				}
-			}
 		}
 	}
 
@@ -4356,6 +4368,31 @@ static int __read_array_literal (moo_t* moo, int rdonly, moo_oop_t* xlit)
 				}
 				break;
 
+			case MOO_IOTOK_IDENT:
+			{
+				var_info_t var;
+				if (find_ident_in_nsdic_and_sysdic (moo, TOKEN_NAME(moo), TOKEN_LOC(moo), &var) <= -1) return -1;
+				MOO_ASSERT (moo, var.type == VAR_GLOBAL);
+				lit = var.gbl->value;
+				/* [NOTE] i don't mark RDONLY on an array member resolved via an identifier */
+				break;
+			}
+
+			case MOO_IOTOK_IDENT_DOTTED:
+			{
+				var_info_t var;
+				if (find_dotted_ident (moo, TOKEN_NAME(moo), TOKEN_LOC(moo), &var) <= -1) return -1;
+				if (var.type != VAR_GLOBAL)
+				{
+/* TODO: XXXXXXXXXXXXXXXXXXXXXXXXxx */
+					return -1;
+				}
+
+				lit = var.gbl->value;
+				/* [NOTE] i don't mark RDONLY on an array member resolved via an identifier */
+				break;
+			}
+
 			case MOO_IOTOK_BABRACK: /* #[ */
 				GET_TOKEN (moo);
 				if (__read_byte_array_literal (moo, &lit) <= -1) return -1;
@@ -7371,6 +7408,11 @@ static int compile_pooldic_definition (moo_t* moo)
 	moo->c->mth.balit_count = 0;
 	moo->c->mth.arlit_count = 0;
 
+	/* these 2 are pooldic import information. pooldic definition doesn't
+	 * have another pooldic import in it */
+	moo->c->cls.pooldic_count = 0;
+	moo->c->cls.pooldic.len = 0;
+
 	n = __compile_pooldic_definition (moo);
 
 	/* reset these oops plus literal pointers not to confuse gc_compiler() */
@@ -7379,6 +7421,9 @@ static int compile_pooldic_definition (moo_t* moo)
 	moo->c->mth.balit_count = 0;
 	moo->c->mth.arlit_count = 0;
 
+	MOO_ASSERT (moo, moo->c->cls.pooldic_count == 0);
+	MOO_ASSERT (moo, moo->c->cls.pooldic.len == 0);
+
 	return n;
 }
 

moo/lib/exec.c

@@ -162,6 +162,7 @@ static moo_oop_process_t make_process (moo_t* moo, moo_oop_context_t c)
 	proc->current_context = c;
 	proc->sp = MOO_SMOOI_TO_OOP(-1);
 	proc->perr = MOO_ERROR_TO_OOP(MOO_ENOERR);
+	proc->perrmsg = moo->_nil;
 
 	MOO_ASSERT (moo, (moo_oop_t)c->sender == moo->_nil);
 
@@ -1472,7 +1473,7 @@ static MOO_INLINE moo_pfrc_t pf_basic_new (moo_t* moo, moo_ooi_t nargs)
 	if (MOO_CLASS_SELFSPEC_FLAGS(MOO_OOP_TO_SMOOI(_class->selfspec)) & MOO_CLASS_SELFSPEC_FLAG_LIMITED)
 	{
 		MOO_DEBUG1 (moo, "<pf_basic_new> Receiver is #limited - %O\n", _class);
-		moo_seterrbfmt (moo, MOO_EPERM, "#limited receiver - %O", _class);
+		moo_seterrbfmt (moo, MOO_EPERM, "limited receiver - %O", _class);
 		return MOO_PF_FAILURE;
 	}
 
@@ -2098,13 +2099,18 @@ static moo_pfrc_t pf_block_new_process (moo_t* moo, moo_ooi_t nargs)
 	return MOO_PF_SUCCESS;
 }
 
+/* ------------------------------------------------------------------ */
+
 static moo_pfrc_t pf_process_resume (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv;
-	MOO_ASSERT (moo, nargs == 0);
 
 	rcv = MOO_STACK_GETRCV(moo, nargs);
-	if (MOO_CLASSOF(moo,rcv) != moo->_process) return MOO_PF_FAILURE;
+	if (MOO_CLASSOF(moo,rcv) != moo->_process) 
+	{
+		moo_seterrnum (moo, MOO_EMSGRCV);
+		return MOO_PF_FAILURE;
+	}
 
 	resume_process (moo, (moo_oop_process_t)rcv); /* TODO: error check */
 
@@ -2115,12 +2121,15 @@ static moo_pfrc_t pf_process_resume (moo_t* moo, moo_ooi_t nargs)
 static moo_pfrc_t pf_process_terminate (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv;
-	MOO_ASSERT (moo, nargs == 0);
 
 /* TODO: need to run ensure blocks here..
  * when it's executed here. it does't have to be in Exception>>handleException when there is no exception handler */
 	rcv = MOO_STACK_GETRCV(moo, nargs);
-	if (MOO_CLASSOF(moo,rcv) != moo->_process) return MOO_PF_FAILURE;
+	if (MOO_CLASSOF(moo,rcv) != moo->_process) 
+	{
+		moo_seterrnum (moo, MOO_EMSGRCV);
+		return MOO_PF_FAILURE;
+	}
 
 	terminate_process (moo, (moo_oop_process_t)rcv);
 
@@ -2131,10 +2140,13 @@ static moo_pfrc_t pf_process_terminate (moo_t* moo, moo_ooi_t nargs)
 static moo_pfrc_t pf_process_yield (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv;
-	MOO_ASSERT (moo, nargs == 0);
 
 	rcv = MOO_STACK_GETRCV(moo, nargs);
-	if (MOO_CLASSOF(moo,rcv) != moo->_process) return MOO_PF_FAILURE;
+	if (MOO_CLASSOF(moo,rcv) != moo->_process) 
+	{
+		moo_seterrnum (moo, MOO_EMSGRCV);
+		return MOO_PF_FAILURE;
+	}
 
 	yield_process (moo, (moo_oop_process_t)rcv);
 
@@ -2145,10 +2157,13 @@ static moo_pfrc_t pf_process_yield (moo_t* moo, moo_ooi_t nargs)
 static moo_pfrc_t pf_process_suspend (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv;
-	MOO_ASSERT (moo, nargs == 0);
 
 	rcv = MOO_STACK_GETRCV(moo, nargs);
-	if (MOO_CLASSOF(moo,rcv) != moo->_process) return MOO_PF_FAILURE;
+	if (MOO_CLASSOF(moo,rcv) != moo->_process) 
+	{
+		moo_seterrnum (moo, MOO_EMSGRCV);
+		return MOO_PF_FAILURE;
+	}
 
 	suspend_process (moo, (moo_oop_process_t)rcv);
 
@@ -2156,6 +2171,25 @@ static moo_pfrc_t pf_process_suspend (moo_t* moo, moo_ooi_t nargs)
 	return MOO_PF_SUCCESS;
 }
 
+static moo_pfrc_t pf_process_primerr_msg (moo_t* moo, moo_ooi_t nargs)
+{
+	moo_oop_t rcv, msg;
+
+	rcv = MOO_STACK_GETRCV(moo, nargs);
+	if (MOO_CLASSOF(moo,rcv) != moo->_process) 
+	{
+		moo_seterrnum (moo, MOO_EMSGRCV);
+		return MOO_PF_FAILURE;
+	}
+
+	msg = moo_makestring (moo, (moo_ooch_t*)MOO_OBJ_GET_TRAILER_BYTE(rcv), moo_countoocstr((moo_ooch_t*)MOO_OBJ_GET_TRAILER_BYTE(rcv)));
+	if (!msg) return MOO_PF_FAILURE;
+
+	MOO_STACK_SETRET (moo, nargs, msg);
+	return MOO_PF_SUCCESS;
+}
+
+/* ------------------------------------------------------------------ */
 static moo_pfrc_t pf_semaphore_signal (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv;
@@ -2432,6 +2466,8 @@ static moo_pfrc_t pf_processor_return_to (moo_t* moo, moo_ooi_t nargs)
 	return MOO_PF_SUCCESS;
 }
 
+/* ------------------------------------------------------------------ */
+
 static moo_pfrc_t pf_integer_add (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv, arg, res;
@@ -2775,6 +2811,8 @@ static moo_pfrc_t pf_integer_inttostr (moo_t* moo, moo_ooi_t nargs)
 	return MOO_PF_SUCCESS;
 }
 
+/* ------------------------------------------------------------------ */
+
 static moo_pfrc_t pf_character_as_smooi (moo_t* moo, moo_ooi_t nargs)
 {
 	moo_oop_t rcv;
@@ -2907,6 +2945,36 @@ static moo_pfrc_t pf_error_as_string (moo_t* moo, moo_ooi_t nargs)
 	return MOO_PF_SUCCESS;
 }
 
+static moo_pfrc_t pf_strlen (moo_t* moo, moo_ooi_t nargs)
+{
+	moo_oop_t rcv, ret;
+	moo_oow_t i, limit;
+	moo_ooch_t* ptr;
+
+	rcv = MOO_STACK_GETRCV(moo, nargs);
+	if (!MOO_OBJ_IS_CHAR_POINTER(rcv))
+	{
+		moo_seterrnum (moo, MOO_EMSGRCV);
+		return MOO_PF_FAILURE;
+	}
+
+	/* [NOTE] the length check loop is directly implemented
+	 *        here to be able to handle character objects
+	 *        regardless of the existence of the EXTRA flag */
+	limit = MOO_OBJ_GET_SIZE(rcv);
+	ptr = MOO_OBJ_GET_CHAR_SLOT(rcv);
+	for (i = 0; i < limit; i++)
+	{
+		if (*ptr == '\0') break;
+		ptr++;
+	}
+	ret = moo_oowtoint (moo, i);
+	if (!ret) return MOO_PF_FAILURE;
+
+	MOO_STACK_SETRET (moo, nargs, ret);
+	return MOO_PF_SUCCESS;
+}
+
 static MOO_INLINE moo_pfrc_t _system_alloc (moo_t* moo, moo_ooi_t nargs, int clear)
 {
 	moo_oop_t tmp;
@@ -3690,11 +3758,7 @@ static pf_t pftab[] =
 	{ "_block_value",                          { pf_block_value,                          0, MA } },
 	{ "_block_new_process",                    { pf_block_new_process,                    0, 1  } },
 
-	{ "_process_resume",                       { pf_process_resume,                       0, 0 } },
+	
-	{ "_process_terminate",                    { pf_process_terminate,                    0, 0 } },
-	{ "_process_yield",                        { pf_process_yield,                        0, 0 } },
-	{ "_process_suspend",                      { pf_process_suspend,                      0, 0 } },
-
 	{ "_processor_schedule",                   { pf_processor_schedule,                   1, 1 } },
 	{ "_processor_add_timed_semaphore",        { pf_processor_add_timed_semaphore,        2, 3 } },
 	{ "_processor_add_input_semaphore",        { pf_processor_add_input_semaphore,        2, 2 } },
@@ -3739,6 +3803,11 @@ static pf_t pftab[] =
 	{ "Error_asInteger",                       { pf_error_as_integer,                     0, 0 } },
 	{ "Error_asString",                        { pf_error_as_string,                      0, 0 } },
 
+	{ "Process__suspend",                      { pf_process_suspend,                      0, 0 } },
+	{ "Process__terminate",                    { pf_process_terminate,                    0, 0 } },
+	{ "Process_resume",                        { pf_process_resume,                       0, 0 } },
+	{ "Process_yield",                         { pf_process_yield,                        0, 0 } },
+
 	{ "Semaphore_signal",                      { pf_semaphore_signal,                     0, 0 } },
 	{ "Semaphore_wait",                        { pf_semaphore_wait,                       0, 0 } },
 
@@ -3764,6 +3833,9 @@ static pf_t pftab[] =
 	{ "SmallPointer_putUint32",                { pf_smptr_put_uint32,                     2, 2 } },
 	{ "SmallPointer_putUint64",                { pf_smptr_put_uint64,                     2, 2 } },
 
+	{ "String__strlen",                        { pf_strlen,                               0, 0 } },
+	{ "String_strlen",                         { pf_strlen,                               0, 0 } },
+
 	{ "System__calloc",                        { pf_system_calloc,                        1, 1 } },
 	{ "System__free",                          { pf_system_free,                          1, 1 } },
 	{ "System__getInt16",                      { pf_system_get_int16,                     2, 2 } },
@@ -4027,6 +4099,7 @@ static int start_method (moo_t* moo, moo_oop_method_t method, moo_oow_t nargs)
 				 * directly in the stack unlik a normal activated method context where the
 				 * arguments are copied to the back. */
 
+				moo_seterrnum (moo, MOO_ENOERR);
 				n = pfbase->handler (moo, nargs);
 
 				moo_poptmp (moo);
@@ -4057,6 +4130,23 @@ static int start_method (moo_t* moo, moo_oop_method_t method, moo_oow_t nargs)
 
 			/* set the error number in the current process for 'thisProcess primError' */
 			moo->processor->active->perr = MOO_ERROR_TO_OOP(moo->errnum);
+			if (moo->errmsg.len > 0)
+			{
+				/* compose an error message string. */
+				/* TODO: i don't like to do this here.
+				 *       is it really a good idea to compose a string here which
+				 *       is not really failure safe without losing integrity???? */
+				moo_oop_t tmp;
+				moo_pushtmp (moo, (moo_oop_t*)&method);
+				tmp = moo_makestring (moo, moo->errmsg.buf, moo->errmsg.len);
+				moo_poptmp (moo);
+				/* [NOTE] carry on even if instantiation fails */
+				moo->processor->active->perrmsg = tmp? tmp: moo->_nil;
+			}
+			else
+			{
+				moo->processor->active->perrmsg = moo->_nil;
+			}
 
 		#if defined(MOO_USE_METHOD_TRAILER)
 			MOO_ASSERT (moo, MOO_OBJ_GET_FLAGS_TRAILER(method));

moo/lib/logfmt.c

@@ -375,35 +375,37 @@ redo:
 
 /* ------------------------------------------------------------------------- */
 
-static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop)
+typedef moo_ooi_t (*outbfmt_t) (moo_t* moo, moo_oow_t mask, const moo_bch_t* fmt, ...);
+
+static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop, outbfmt_t outbfmt)
 {
 	if (oop == moo->_nil)
 	{
-		moo_logbfmt (moo, mask, "nil");
+		outbfmt (moo, mask, "nil");
 	}
 	else if (oop == moo->_true)
 	{
-		moo_logbfmt (moo, mask, "true");
+		outbfmt (moo, mask, "true");
 	}
 	else if (oop == moo->_false)
 	{
-		moo_logbfmt (moo, mask, "false");
+		outbfmt (moo, mask, "false");
 	}
 	else if (MOO_OOP_IS_SMOOI(oop))
 	{
-		moo_logbfmt (moo, mask, "%zd", MOO_OOP_TO_SMOOI(oop));
+		outbfmt (moo, mask, "%zd", MOO_OOP_TO_SMOOI(oop));
 	}
 	else if (MOO_OOP_IS_SMPTR(oop))
 	{
-		moo_logbfmt (moo, mask, "%p", MOO_OOP_TO_SMPTR(oop));
+		outbfmt (moo, mask, "%p", MOO_OOP_TO_SMPTR(oop));
 	}
 	else if (MOO_OOP_IS_CHAR(oop))
 	{
-		moo_logbfmt (moo, mask, "$%.1C", MOO_OOP_TO_CHAR(oop));
+		outbfmt (moo, mask, "$%.1C", MOO_OOP_TO_CHAR(oop));
 	}
 	else if (MOO_OOP_IS_ERROR(oop))
 	{
-		moo_logbfmt (moo, mask, "error(%zd)", MOO_OOP_TO_ERROR(oop));
+		outbfmt (moo, mask, "error(%zd)", MOO_OOP_TO_ERROR(oop));
 	}
 	else
 	{
@@ -416,26 +418,26 @@ static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop)
 		if (c == moo->_large_negative_integer)
 		{
 			moo_oow_t i;
-			moo_logbfmt (moo, mask, "-16r");
+			outbfmt (moo, mask, "-16r");
 			for (i = MOO_OBJ_GET_SIZE(oop); i > 0;)
 			{
-				moo_logbfmt (moo, mask, "%0*lX", (int)(MOO_SIZEOF(moo_liw_t) * 2), (unsigned long)((moo_oop_liword_t)oop)->slot[--i]);
+				outbfmt (moo, mask, "%0*lX", (int)(MOO_SIZEOF(moo_liw_t) * 2), (unsigned long)((moo_oop_liword_t)oop)->slot[--i]);
 			}
 		}
 		else if (c == moo->_large_positive_integer)
 		{
 			moo_oow_t i;
-			moo_logbfmt (moo, mask, "16r");
+			outbfmt (moo, mask, "16r");
 			for (i = MOO_OBJ_GET_SIZE(oop); i > 0;)
 			{
-				moo_logbfmt (moo, mask, "%0*lX", (int)(MOO_SIZEOF(moo_liw_t) * 2), (unsigned long)((moo_oop_liword_t)oop)->slot[--i]);
+				outbfmt (moo, mask, "%0*lX", (int)(MOO_SIZEOF(moo_liw_t) * 2), (unsigned long)((moo_oop_liword_t)oop)->slot[--i]);
 			}
 		}
 		else if (MOO_OBJ_GET_FLAGS_TYPE(oop) == MOO_OBJ_TYPE_CHAR)
 		{
 			if (c == moo->_symbol) 
 			{
-				moo_logbfmt (moo, mask, "#%.*js", MOO_OBJ_GET_SIZE(oop), ((moo_oop_char_t)oop)->slot);
+				outbfmt (moo, mask, "#%.*js", MOO_OBJ_GET_SIZE(oop), ((moo_oop_char_t)oop)->slot);
 			}
 			else /*if ((moo_oop_t)c == moo->_string)*/
 			{
@@ -456,7 +458,7 @@ static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop)
 				{
 					moo_ooch_t escaped;
 
-					moo_logbfmt (moo, mask, "S'");
+					outbfmt (moo, mask, "S'");
 					for (i = 0; i < MOO_OBJ_GET_SIZE(oop); i++)
 					{
 						ch = ((moo_oop_char_t)oop)->slot[i];
@@ -494,74 +496,74 @@ static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop)
 							}
 
 							if (escaped == ch)
-								moo_logbfmt (moo, mask, "\\x%X", ch);
+								outbfmt (moo, mask, "\\x%X", ch);
 							else
-								moo_logbfmt (moo, mask, "\\%jc", escaped);
+								outbfmt (moo, mask, "\\%jc", escaped);
 						}
 						else
 						{
-							moo_logbfmt (moo, mask, "%jc", ch);
+							outbfmt (moo, mask, "%jc", ch);
 						}
 					}
 					
-					moo_logbfmt (moo, mask, "'");
+					outbfmt (moo, mask, "'");
 				}
 				else
 				{
-					moo_logbfmt (moo, mask, "'%.*js'", MOO_OBJ_GET_SIZE(oop), ((moo_oop_char_t)oop)->slot);
+					outbfmt (moo, mask, "'%.*js'", MOO_OBJ_GET_SIZE(oop), ((moo_oop_char_t)oop)->slot);
 				}
 			}
 		}
 		else if (MOO_OBJ_GET_FLAGS_TYPE(oop) == MOO_OBJ_TYPE_BYTE)
 		{
-			moo_logbfmt (moo, mask, "#[");
+			outbfmt (moo, mask, "#[");
 			for (i = 0; i < MOO_OBJ_GET_SIZE(oop); i++)
 			{
-				moo_logbfmt (moo, mask, " %d", ((moo_oop_byte_t)oop)->slot[i]);
+				outbfmt (moo, mask, " %d", ((moo_oop_byte_t)oop)->slot[i]);
 			}
-			moo_logbfmt (moo, mask, "]");
+			outbfmt (moo, mask, "]");
 		}
 		
 		else if (MOO_OBJ_GET_FLAGS_TYPE(oop) == MOO_OBJ_TYPE_HALFWORD)
 		{
-			moo_logbfmt (moo, mask, "#[["); /* TODO: fix this symbol/notation */
+			outbfmt (moo, mask, "#[["); /* TODO: fix this symbol/notation */
 			for (i = 0; i < MOO_OBJ_GET_SIZE(oop); i++)
 			{
-				moo_logbfmt (moo, mask, " %zX", (moo_oow_t)((moo_oop_halfword_t)oop)->slot[i]);
+				outbfmt (moo, mask, " %zX", (moo_oow_t)((moo_oop_halfword_t)oop)->slot[i]);
 			}
-			moo_logbfmt (moo, mask, "]]");
+			outbfmt (moo, mask, "]]");
 		}
 		else if (MOO_OBJ_GET_FLAGS_TYPE(oop) == MOO_OBJ_TYPE_WORD)
 		{
-			moo_logbfmt (moo, mask, "#[[["); /* TODO: fix this symbol/notation */
+			outbfmt (moo, mask, "#[[["); /* TODO: fix this symbol/notation */
 			for (i = 0; i < MOO_OBJ_GET_SIZE(oop); i++)
 			{
-				moo_logbfmt (moo, mask, " %zX", ((moo_oop_word_t)oop)->slot[i]);
+				outbfmt (moo, mask, " %zX", ((moo_oop_word_t)oop)->slot[i]);
 			}
-			moo_logbfmt (moo, mask, "]]]");
+			outbfmt (moo, mask, "]]]");
 		}
 		else if (c == moo->_array)
 		{
-			moo_logbfmt (moo, mask, "#(");
+			outbfmt (moo, mask, "#(");
 			for (i = 0; i < MOO_OBJ_GET_SIZE(oop); i++)
 			{
-				moo_logbfmt (moo, mask, " ");
+				outbfmt (moo, mask, " ");
-				print_object (moo, mask, ((moo_oop_oop_t)oop)->slot[i]);
+				print_object (moo, mask, ((moo_oop_oop_t)oop)->slot[i], outbfmt);
 			}
-			moo_logbfmt (moo, mask, ")");
+			outbfmt (moo, mask, ")");
 		}
 		else if (c == moo->_class)
 		{
 			/* print the class name */
-			moo_logbfmt (moo, mask, "%.*js", MOO_OBJ_GET_SIZE(((moo_oop_class_t)oop)->name), ((moo_oop_class_t)oop)->name->slot);
+			outbfmt (moo, mask, "%.*js", MOO_OBJ_GET_SIZE(((moo_oop_class_t)oop)->name), ((moo_oop_class_t)oop)->name->slot);
 		}
 		else if (c == moo->_association)
 		{
-			moo_logbfmt (moo, mask, "%O -> %O", ((moo_oop_association_t)oop)->key, ((moo_oop_association_t)oop)->value);
+			outbfmt (moo, mask, "%O -> %O", ((moo_oop_association_t)oop)->key, ((moo_oop_association_t)oop)->value);
 		}
 		else
 		{
-			moo_logbfmt (moo, mask, "instance of %.*js(%p)", MOO_OBJ_GET_SIZE(c->name), ((moo_oop_char_t)c->name)->slot, oop);
+			outbfmt (moo, mask, "instance of %.*js(%p)", MOO_OBJ_GET_SIZE(c->name), ((moo_oop_char_t)c->name)->slot, oop);
 		}
 	}
 }
@@ -574,7 +576,7 @@ static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop)
 #undef fmtchar_t
 #undef logfmtv
 #define fmtchar_t moo_bch_t
-#define logfmtv moo_logbfmtv
+#define logfmtv __logbfmtv
 #define FMTCHAR_IS_BCH
 #if defined(MOO_OOCH_IS_BCH)
 #	define FMTCHAR_IS_OOCH
@@ -587,13 +589,25 @@ static void print_object (moo_t* moo, moo_oow_t mask, moo_oop_t oop)
 #undef fmtchar_t
 #undef logfmtv
 #define fmtchar_t moo_uch_t
-#define logfmtv moo_logufmtv
+#define logfmtv __logufmtv
 #define FMTCHAR_IS_UCH
 #if defined(MOO_OOCH_IS_UCH)
 #	define FMTCHAR_IS_OOCH
 #endif
 #include "logfmtv.h" 
 
+
+static int _logbfmtv (moo_t* moo, const moo_bch_t* fmt, moo_fmtout_t* data, va_list ap)
+{
+	return __logbfmtv (moo, fmt, data, ap, moo_logbfmt);
+}
+
+static int _logufmtv (moo_t* moo, const moo_uch_t* fmt, moo_fmtout_t* data, va_list ap)
+{
+	return __logufmtv (moo, fmt, data, ap, moo_logbfmt);
+}
+
+
 moo_ooi_t moo_logbfmt (moo_t* moo, moo_oow_t mask, const moo_bch_t* fmt, ...)
 {
 	int x;
@@ -605,7 +619,7 @@ moo_ooi_t moo_logbfmt (moo_t* moo, moo_oow_t mask, const moo_bch_t* fmt, ...)
 	fo.putcs = put_oocs;
 
 	va_start (ap, fmt);
-	x = moo_logbfmtv (moo, fmt, &fo, ap);
+	x = _logbfmtv (moo, fmt, &fo, ap);
 	va_end (ap);
 
 	if (moo->log.len > 0 && moo->log.ptr[moo->log.len - 1] == '\n')
@@ -627,7 +641,7 @@ moo_ooi_t moo_logufmt (moo_t* moo, moo_oow_t mask, const moo_uch_t* fmt, ...)
 	fo.putcs = put_oocs;
 
 	va_start (ap, fmt);
-	x = moo_logufmtv (moo, fmt, &fo, ap);
+	x = _logufmtv (moo, fmt, &fo, ap);
 	va_end (ap);
 
 	if (moo->log.len > 0 && moo->log.ptr[moo->log.len - 1] == '\n')
@@ -679,6 +693,35 @@ static int put_errcs (moo_t* moo, moo_oow_t mask, const moo_ooch_t* ptr, moo_oow
 	return 1; /* success */
 }
 
+
+static moo_ooi_t __errbfmtv (moo_t* moo, moo_oow_t mask, const moo_bch_t* fmt, ...);
+
+static int _errbfmtv (moo_t* moo, const moo_bch_t* fmt, moo_fmtout_t* data, va_list ap)
+{
+	return __logbfmtv (moo, fmt, data, ap, __errbfmtv);
+}
+
+static int _errufmtv (moo_t* moo, const moo_uch_t* fmt, moo_fmtout_t* data, va_list ap)
+{
+	return __logufmtv (moo, fmt, data, ap, __errbfmtv);
+}
+
+static moo_ooi_t __errbfmtv (moo_t* moo, moo_oow_t mask, const moo_bch_t* fmt, ...)
+{
+	va_list ap;
+	moo_fmtout_t fo;
+
+	fo.mask = 0; /* not used */
+	fo.putch = put_errch;
+	fo.putcs = put_errcs;
+
+	va_start (ap, fmt);
+	_errbfmtv (moo, fmt, &fo, ap);
+	va_end (ap);
+
+	return fo.count;
+}
+
 void moo_seterrbfmt (moo_t* moo, moo_errnum_t errnum, const moo_bch_t* fmt, ...)
 {
 	va_list ap;
@@ -692,7 +735,7 @@ void moo_seterrbfmt (moo_t* moo, moo_errnum_t errnum, const moo_bch_t* fmt, ...)
 	fo.putcs = put_errcs;
 
 	va_start (ap, fmt);
-	moo_logbfmtv (moo, fmt, &fo, ap);
+	_errbfmtv (moo, fmt, &fo, ap);
 	va_end (ap);
 }
 
@@ -709,6 +752,6 @@ void moo_seterrufmt (moo_t* moo, moo_errnum_t errnum, const moo_uch_t* fmt, ...)
 	fo.putcs = put_errcs;
 
 	va_start (ap, fmt);
-	moo_logufmtv (moo, fmt, &fo, ap);
+	_errufmtv (moo, fmt, &fo, ap);
 	va_end (ap);
 }

moo/lib/logfmtv.h

@@ -85,7 +85,7 @@
 	data->count += len; \
 } while (0)
 
-int logfmtv (moo_t* moo, const fmtchar_t* fmt, moo_fmtout_t* data, va_list ap)
+static int logfmtv (moo_t* moo, const fmtchar_t* fmt, moo_fmtout_t* data, va_list ap, outbfmt_t outbfmt)
 {
 	const fmtchar_t* percent;
 #if defined(FMTCHAR_IS_OOCH)
@@ -549,7 +549,7 @@ reswitch:
 		}
 
 		case 'O': /* object - ignore precision, width, adjustment */
-			print_object (moo, data->mask, va_arg (ap, moo_oop_t));
+			print_object (moo, data->mask, va_arg (ap, moo_oop_t), outbfmt);
 			break;
 
 #if 0

moo/lib/moo.h

@@ -709,7 +709,7 @@ struct moo_context_t
 };
 
 
-#define MOO_PROCESS_NAMED_INSTVARS 8
+#define MOO_PROCESS_NAMED_INSTVARS 9
 typedef struct moo_process_t moo_process_t;
 typedef struct moo_process_t* moo_oop_process_t;
 
@@ -731,6 +731,7 @@ struct moo_process_t
 
 	moo_oop_semaphore_t sem;
 	moo_oop_t           perr; /* last error set by a primitive function */
+	moo_oop_t           perrmsg;
 
 	/* == variable indexed part == */
 	moo_oop_t slot[1]; /* process stack */