touched up primitive failure handling a bit

moo/kernel/Apex.moo

@@ -53,28 +53,17 @@ extend Apex
 
 	method(#class,#primitive) basicNew.
 	method(#class,#primitive) basicNew: size.
-	
+	(* the following definition is almost equivalent to the simpler definition
-	(*
+	 *    method(#class,#primitive) basicNew: size.
-	method(#class) basicNew
+	 * found above.
-	{
+	 * in the following defintion, the primitiveFailed method is executed 
-		| perr |
+	 * from the basicNew: context. but in the simpler definition, it is executed
-		<primitive: #Apex__basicNew>
+	 * in the context of the caller of the basicNew:. the context of the basicNew:
-		self primitiveFailed.
+	 * method is not even created
-
-	##	perr := thisProcess primError.
-	##	if (perr == xxxx) { self cannotInstantiate }
-	##	else { self primitiveFailed }.
-	}
-	
 	method(#class) basicNew: size
 	{
-		| perr |
 		<primitive: #Apex__basicNew:>
-		self primitiveFailed.
+		self primitiveFailed(thisContext method)
-
-	##	perr := thisProcess primError.
-	##	if (perr == xxxx) { self cannotInstantiate }
-	##	else { self primitiveFailed }.
 	}*)
 
 	method(#class) new

moo/kernel/Class.moo

@@ -2,19 +2,13 @@
 ## the Class object should be a variable-pointer object because
 ## it needs to accomodate class instance variables.
 ##
-class(#pointer) Class(Apex)
+class(#pointer,#limited) Class(Apex)
 {
 	var spec, selfspec, superclass, subclasses, name, modname.
 	var instvars, classinstvars, classvars, pooldics.
 	var instmthdic, classmthdic, nsdic, cdic.
 	var trsize, initv, initv_ci.
 
-	method(#class) basicNew
-	{
-		## you must not instantiate a new class this way.
-		self cannotInstantiate.
-	}
-
 	method(#class) initialize
 	{
 		^self.

moo/kernel/Except.moo

@@ -379,10 +379,6 @@ class PrimitiveFailureException(Exception)
 {
 }
 
-class InstantiationFailureException(Exception)
-{
-}
-
 class NoSuchMessageException(Exception)
 {
 }
@@ -413,30 +409,22 @@ class ProhibitedMessageException(Exception)
 
 extend Apex
 {
-	method(#dual,#variadic) primitiveFailed()
+	method(#dual,#liberal) primitiveFailed(method)
 	{
-		| a b |
+		| a b msg |
 
-		thisContext vargCount dump.
+		(*System logNl: 'Arguments: '.
-		a := 1.
+		a := 0.
 		b := thisContext vargCount.
-'PRIMITIVE FAILED............................................' dump.
-self dump.
 		while (a < b)
 		{
-			(thisContext vargAt: a) dump.
+			System logNl: (thisContext vargAt: a) asString.
 			a := a + 1.
-		}.
+		}.*)
 		
-('PRIMITIVE FAILED....' & (thisContext vargAt: 0)) dump.
+		msg := thisProcess primError asString.
-	
+		if (method notNil) { msg := msg & ' - ' & (method owner name) & '<<' & (method name) }.
-		PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
+		PrimitiveFailureException signal: msg.
-	}
-
-	method(#dual) cannotInstantiate
-	{
-		## TODO: use displayString or something like that instead of name....
-		InstantiationFailureException signal: 'Cannot instantiate ' & (self name).
 	}
 
 	method(#dual) doesNotUnderstand: message_name

moo/kernel/Process.moo

@@ -3,18 +3,6 @@ class(#pointer,#final,#limited) Process(Object)
 {
 	var initial_context, current_context, state, sp, prev, next, sem, perr.
 
-	method(#class) basicNew
-	{
-		(* instantiation is not allowed. a process is strictly a VM managed object *)
-		self cannotInstantiate
-	}
-	
-	method(#class) basicNew: size 
-	{
-		(* instantiation is not allowed. a process is strictly a VM managed object *)
-		self cannotInstantiate
-	}
-
 	method prev { ^self.prev }
 	method next { ^self.next }
 

moo/kernel/X11.moo

@@ -229,22 +229,10 @@ class X11.GC(Object) from 'x11.gc'
 ## ---------------------------------------------------------------------------
 
 
-class X11.Component(Object)
+class(#limited) X11.Component(Object)
 {
 	var parent.
 
-	method new
-	{
-		## you must call new: parent instead.
-		self cannotInstantiate
-	}
-
-	method new: parent
-	{
-		## you must call new: parent instead.
-		self cannotInstantiate
-	}
-
 	method parent
 	{
 		^self.parent

moo/lib/exec.c

@@ -4087,15 +4087,30 @@ static int start_method (moo_t* moo, moo_oop_method_t method, moo_oow_t nargs)
 				};
 				moo_oow_t i;
 
-				MOO_DEBUG2 (moo, "Sending primitiveFailed for empty primitive body - %.*js\n", MOO_OBJ_GET_SIZE(method->name), MOO_OBJ_GET_CHAR_SLOT(method->name));
+				if (stack_base != moo->sp - nargs - 1)
+				{
+					/* a primitive function handler must not touch the stack when it returns soft failure */
+					MOO_DEBUG3 (moo, "Stack seems to get corrupted by a primitive handler function - %O<<%.*js\n", method->owner, MOO_OBJ_GET_SIZE(method->name), MOO_OBJ_GET_CHAR_SLOT(method->name));
+					moo->errnum = MOO_EINTERN;
+					return -1;
+				}
 
-			//////	//moo->sp = stack_base + 1; /* keep the receiver only. drop all arguments */
+				MOO_DEBUG3 (moo, "Sending primitiveFailed for empty primitive body - %O<<%.*js\n", method->owner, MOO_OBJ_GET_SIZE(method->name), MOO_OBJ_GET_CHAR_SLOT(method->name));
 
-//if the primitive handler function screwed the stack??? partially popped??? can't handle excessive pops...
+				/* 
+				 *  | arg1     | <---- stack_base + 3
+				 *  | arg0     | <---- stack_base + 2
+				 *  | receiver | <---- stack_base + 1
+				 *  |          | <---- stack_base
+				 */
 
+				/* push out arguments by one slot */
 				MOO_STACK_PUSH (moo, moo->_nil); /* fake */
 				for (i = moo->sp; i > stack_base + 2; i--) MOO_STACK_SET (moo, i, MOO_STACK_GET(moo, i - 1));
-				MOO_STACK_SET (moo, stack_base + 2, (moo_oop_t)method->name);
+				/* inject the method as the first argument */
+				MOO_STACK_SET (moo, stack_base + 2, (moo_oop_t)method);
+
+				/* send primitiveFailed to self */
 				if (send_private_message (moo, prim_fail_msg, 15, 0, nargs + 1) <= -1) return -1;
 				break;
 #endif

moo/lib/gc.c

@@ -153,7 +153,7 @@ static int ignite_1 (moo_t* moo)
 	 * The instance of Class can have indexed instance variables 
 	 * which are actually class variables.
 	 * -------------------------------------------------------------- */
-	moo->_class = alloc_kernel_class (moo, 0, 0, MOO_CLASS_SPEC_MAKE(MOO_CLASS_NAMED_INSTVARS, 1, MOO_OBJ_TYPE_OOP));
+	moo->_class = alloc_kernel_class (moo, MOO_CLASS_SELFSPEC_FLAG_LIMITED, 0, MOO_CLASS_SPEC_MAKE(MOO_CLASS_NAMED_INSTVARS, 1, MOO_OBJ_TYPE_OOP));
 	if (!moo->_class) return -1;
 
 	MOO_ASSERT (moo, MOO_OBJ_GET_CLASS(moo->_class) == MOO_NULL);