added a name field to a complied method class.

wrote more code for implementing exception handling

stix/kernel/Apex.st

@@ -74,7 +74,6 @@
 	#method initialize
 	{
 		"a subclass may override this method."
-		
 		^self.
 	}
 
@@ -123,6 +122,7 @@
 	#method basicAt: anInteger
 	{
 		<primitive: #_basic_at>
+## TODO: chagne it to 'self outOfRangeError' or something.
 		self error: 'out of range'.
 	}
 
@@ -219,7 +219,7 @@
 	## -------------------------------------------------------
 	## -------------------------------------------------------
 
-	## #method(#class) primitiveFailed
+	## method(#class) primitiveFailed
 	## {
 	## 	this method will be added after Exception class has been defined.
 	## }
@@ -254,4 +254,8 @@
 		self class error: aString.
 	}
 
+	#method cannotInstantiate
+	{
+		self class cannotInstantiate
+	}
 }

stix/kernel/Class.st

@@ -2,4 +2,43 @@
 #class(#pointer) Class(Apex)
 {
 	#dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic.
+
+	#method(#class) basicNew
+	{
+		## you must not instantiate a new class this way.
+		self cannotInstantiate.
+	}
+
+	#method(#class) initialize
+	{
+		^self.
+	}
+
+	#method name
+	{
+		^self.name
+	}
+
+	#method superclass
+	{
+		^self.superclass
+	}
+
+	#method specNumInstVars
+	{
+		## shift right by 7 bits.
+		## see stix-prv.h for details.
+		^self.spec bitShift: -7
+	}
+
+	#method inheritsFrom: aSuperclass
+	{
+		| c |
+		c := self superclass.
+		[c notNil] whileTrue: [
+			[ c == aSuperclass ] ifTrue: [^true].
+			c := c superclass.
+		].
+		^false
+	}
 }

stix/kernel/Collection-Array.st

@@ -43,8 +43,21 @@
 
 #class(#character) String(Array)
 {
+	#method , aString
+	{
+		## concatenate two strings.
+## TOOD: make this a primitive for performance.
+		| newsize newstr self_ubound|
+		newsize := self basicSize + aString basicSize.
+		##newstr := self class basicNew: newsize.
+		newstr := String basicNew: newsize.  ## TODO: redefine , for symbol... it's a work arouind... symbols are not contacated to a symbol at this moment.
+		self_ubound := self ubound.
+		0 to: self_ubound do: [:i | newstr at: i put: (self at: i)].
+		0 to: (aString ubound) do: [:i | newstr at: (i + self_ubound + 1) put: (aString at: i)].
+		^newstr
+	}
 }
 
-#class(#character) Symbol(Array)
+#class(#character) Symbol(String)
 {
 }

stix/kernel/Context.st

@@ -7,20 +7,10 @@
 		^self.sender
 	}
 
-"	#method isHandlerContext
+	#method isExceptionHandlerContext
 	{
-		return ^false
+		^false
-	}"
-
-	#method handles: anException
-	{
-		^false.
 	}
-
-##	#method parent
-##	{
-##		^self.sender
-##	}
 }
 
 #class(#pointer) MethodContext(Context)
@@ -29,53 +19,61 @@
 
 	#method pc
 	{
-		^ip
+		^self.ip
 	}
 
 	#method pc: anInteger
 	{
-		ip := anInteger.
+		self.ip := anInteger.
-		"sp := sp - 1."  "whould this always work??? "
+		"self.sp := self.sp - 1."  "whould this always work??? "
 	}
 
 	#method sp
 	{
-		^sp.
+		^self.sp.
 
 	}
 	#method sp: anInteger
 	{
-		sp := anInteger.
+		self.sp := anInteger.
 	}
 
 	#method pc: aPC sp: aSP
 	{
-		ip := aPC.
+		self.ip := aPC.
-		sp := aSP.
+		self.sp := aSP.
 		##sp := sp - 1.
 	}
 
-##	#method methodName
+	#method method
-##	{
+	{
-##		^self.method basicAt: 0.
+		^self.method
-##	}
+	}
 
-	#method isHandlerContext
+	#method isExceptionHandlerContext
 	{
 		## 10 - STIX_METHOD_PREAMBLE_EXCEPTION in VM.
 		^self.method preambleCode == 10. 
 	}
 
-	#method handles: anException
+	#method findExceptionHandlerBlock: anException
 	{
-		(self isHandlerContext) ifTrue: [^true]. ## TODO: check if xxxx
+		## for this to work, self must be an exception handler context.
-		^false
+		## For a single on:do: call,
-	}
+		##   self class specNumInstVars must return 8.
+		##   basicAt: 8 must be the on: argument.
+		##   basicAt: 9 must be the do: argument
 
-	#method handlerBlock
+		(self isExceptionHandlerContext) ifTrue: [
-	{
+			| bound exc |
-		## for this to work, self must be a handler context.
+			## NOTE: if on:do: has a temporary varible, bound must be adjusted to reflect it.
-		^self basicAt: 9
+			bound := self basicSize - 1.
+			8 to: bound by: 2 do: [ :i | 
+				exc := self basicAt: i.
+				((anException == exc) or: [anException inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)].
+			]
+		].
+		^nil.
 	}
 }
 
@@ -237,11 +235,11 @@
 	"------ TODO: -------------------------------------"
 	#method on: anException do: anExceptionBlock
 	{
-		| handlerActive |
+"		| handlerActive |"
 		<exception>
-		handlerActive := true.
+"		handlerActive := true.
 
-"thisContext isHandlerContext dump.
+thisContext isExceptionHandlerContext dump.
 (thisContext basicSize) dump.
 (thisContext basicAt: 8) dump.  ## this should be anException
 (thisContext basicAt: 9) dump.  ## this should be anExceptionBlock
@@ -251,6 +249,11 @@
 		^self value.
 	}
 
+	#method on: exc1 do: blk1 on: exc2 do: blk2
+	{
+		<exception>
+		^self value.
+	}
 
 
 	#method ensure: aBlock
@@ -274,9 +277,11 @@
 	"------ TODO: -------------------------------------"
 }
 
-#class Exception(Object)
+## TODO: is it better to inherit from Object???
+##       or treat Exception specially like UndefinedObject or Class???
+#class Exception(Apex)
 {
-	#dcl signalContext handlerContext messageText.
+	#dcl signalContext handlerContext handlerBlock messageText.
 
 	#method(#class) signal
 	{
@@ -296,14 +301,8 @@
 	#method signal 
 	{
 		self.signalContext := thisContext.
-
+		self findHandlerContextStartingFrom: self.signalContext.
-		self.handlerContext isNil ifTrue: [
+		self handleException.
-			self.handlerContext := self findHandlerContextStartingFrom: self.signalContext
-		].
-
-		self.handlerContext isNil 
-			ifTrue: [ self notHandled ]
-			ifFalse: [ self handle ].
 	}
 
 	#method signal: text
@@ -315,17 +314,17 @@
 	#method pass
 	{
 		## pass the exception to the outer context
-
+		self.signalContext notNil 
+			ifTrue: [ ## it's signaled earlier
 				## TODO: Should i change the signalContex to thisContext???
-		self.handlerContext := self findHandlerContextStartingFrom: (self.handlerContext sender).
+				self findHandlerContextStartingFrom: (self.handlerContext sender).
-		self.handlerContext isNil 
+				self handleException.
-			ifTrue: [ self notHandled ]
+			]
-			ifFalse: [ self handle ].
 	}
 
 	#method return: value
 	{
-		self.handlerContext isNil ifFalse: [
+		self.handlerContext notNil ifTrue: [
 			Processor return: value to: (self.handlerContext sender)
 		]
 	}
@@ -333,32 +332,39 @@
 	#method retry
 	{
 		## TODO: verify if return:to: causes unnecessary stack growth.
-
+		self.handlerContext notNil 
+			ifTrue: [
+				## TODO: should i reset self.handlerContext and self.signalContext to nil? 
 				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???
+		self.signalContext notNil
+			ifTrue: [
+				## TODO: should i reset self.handlerContext and self.signalContext to nil? 
 				Processor return: self to: (self.signalContext sender).
+			]
 	}
 
 	## ####################################################################
 	## ####################################################################
-
+	#method handleException
-	#method handle
 	{
-		Processor return: (self.handlerContext handlerBlock value: self) to: (self.handlerContext sender)
+		self.handlerContext notNil
-	}
+			ifTrue: [ 
-
+				Processor return: (self.handlerBlock value: self) to: (self.handlerContext sender)
-	#method notHandled
+			]
-	{
+			ifFalse: [ 
-'####################### EXCEPTION NOT HANDLED ###############################' dump.
+				('### EXCEPTION NOT HANDLED #### ', self class name, ' - ', self messageText) dump.
 				## TODO: debug the current process???? "
 				Processor activeProcess terminate.
+			].
 	}
 
 	#method handlerContext
@@ -374,9 +380,17 @@ Processor activeProcess terminate.
 		| ctx |
 
 		ctx := aContext.
-		[ ctx notNil ]
+		[ ctx notNil ] whileTrue: [
-			whileTrue: [
+				##(ctx handles: self) ifTrue: [ ^ ctx ].
-				(ctx handles: self) ifTrue: [ ^ ctx ].
+				(ctx isExceptionHandlerContext) ifTrue: [
+					| blk |
+					blk := ctx findExceptionHandlerBlock: (self class).
+					(blk notNil) ifTrue: [ 
+						self.handlerBlock := blk. 
+						self.handlerContext := ctx. 
+						^ctx 
+					].
+				].
 				ctx := ctx sender
 			].
 		^nil
@@ -385,22 +399,31 @@ Processor activeProcess terminate.
 
 #class NoSuchMessageException(Exception)
 {
-	#method signal
-	{
-		self signal: 'no such message'.
-	}
 }
 
+#class PrimitiveFailureException(Exception)
+{
+}
 
 #extend Apex
 {
 	#method(#class) primitiveFailed
 	{
 		## TODO: implement this
-		## PrimitiveFailureError signal.
+## experimental backtrace...
-		self dump.
+| ctx |
-		##'primitive failed' dump.
+ctx := thisContext.
-# TODO: define a specialized exception class for primitive failure and use it.
+[ctx notNil] whileTrue: [
-		Exception signal: 'PRIMITIVE FAILED...'.
+	(ctx class == MethodContext) 
+		ifTrue: [ (ctx method owner name, ' - ', ctx method name) dump ].
+	## TODO: include blockcontext???
+	ctx := ctx sender.
+].
+		PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
+	}
+  
+	#method(#class) cannotInstantiate
+	{
+		Exception signal: 'Cannot instantiate'.
 	}
 }

stix/kernel/Stix.st

@@ -253,7 +253,7 @@
 
 #class(#pointer) CompiledMethod(Object)
 {
-	#dcl owner preamble preamble_data_1 preamble_data_2 ntmprs nargs code source.
+	#dcl owner name preamble preamble_data_1 preamble_data_2 ntmprs nargs code source.
 
 	#method preamble
 	{
@@ -264,6 +264,16 @@
 	{
 		^self.preamble bitAnd: 16rFF.
 	}
+
+	#method owner
+	{
+		^self.owner
+	}
+
+	#method name
+	{
+		^self.name
+	}
 }
 
 #include 'Context.st'.

stix/kernel/test-011.st

@@ -54,14 +54,20 @@
 
 	#method(#class) test3
 	{
-		| k j |
+		| k j g_ex |
 		j := 20.
 		k := [
 			'>>> TEST3 METHOD >>> ' dump.
 			j dump.
 			(j < 25) ifTrue: [ | t | 
-				t := Exception signal: 'bad exceptinon'.  ## when resume, t should get Exception.
+				t := Exception signal: 'bad exceptinon'.  ## when resumed, t should get Exception, the leftover in the stack...
-				t := self raise_exception.  ## when resumed, t should get 'self'
+				t signal: 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. ## so it should be ok to signal again..
+				##t := self raise_exception.  ## when resumed, t should get 'self'
+
+				##g_ex retry. # You should not do these as the following 3 lines make things very complicated.
+				##g_ex signal.
+				##g_ex pass.
+
 				'RESUMED???' dump. 
 				t dump.
 				j dump.
@@ -69,7 +75,7 @@
 
 			'OOOOOOOOOOOOOOOOOOOOOOO' dump.
 			'JJJJJJJJJJJJJJ' dump. 
-		] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex resume. ].
+		] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. g_ex := ex. ex resume. ].
 
 		k dump.
 		'END OF TEST3' dump.
@@ -152,6 +158,7 @@
 		] on: Exception do: [:ex | 'EXCEPTION ----------' dump. ex messageText dump ].
 	}
 
+	
 	#method(#class) main
 	{
 
@@ -163,14 +170,18 @@
 	##	self test3.
 	##	self test4.
 
-		self test5.
+	##	self test5.
 	##	self test11.
 	##	self test12.
-
 		##100 timesRepeat: ['>>>>> END OF MAIN' dump].
 
+		'@@@@@@@@@@@@@@@@@@@@@@@@@@@@' dump.
 		## the following line(return:to:) must cause primitive failure...
-		##[ Processor return: 10 to: 20. ] on: Exception do: [:ex | ex messageText dump].
+		[ Processor return: 10 to: 20. ] on: Exception do: [:ex | ex messageText dump].
+
+		##[ Processor return: 10 to: 20. ] 
+		##	on: PrimitiveFailureException do: [:ex | 'PRIMITIVE FAILURE CAUGHT HERE HERE HERE' dump]
+		##	on: Exception do: [:ex | ex messageText dump].
 
 		'>>>>> END OF MAIN' dump.
 	}

stix/lib/comp.c

@@ -4133,7 +4133,7 @@ printf ("\treturn_receiver\n");
 
 static int add_compiled_method (stix_t* stix)
 {
-	stix_oop_t name; /* selector */
+	stix_oop_char_t name; /* selector */
 	stix_oop_method_t mth; /* method */
 #if defined(STIX_USE_OBJECT_TRAILER)
 	/* nothing extra */
@@ -4144,9 +4144,9 @@ static int add_compiled_method (stix_t* stix)
 	stix_oow_t i;
 	stix_ooi_t preamble_code, preamble_index;
 
-	name = stix_makesymbol (stix, stix->c->mth.name.ptr, stix->c->mth.name.len);
+	name = (stix_oop_char_t)stix_makesymbol (stix, stix->c->mth.name.ptr, stix->c->mth.name.len);
 	if (!name) return -1;
-	stix_pushtmp (stix, &name); tmp_count++;
+	stix_pushtmp (stix, (stix_oop_t*)&name); tmp_count++;
 
 	/* The variadic data part passed to stix_instantiate() is not GC-safe */
 #if defined(STIX_USE_OBJECT_TRAILER)
@@ -4295,6 +4295,7 @@ static int add_compiled_method (stix_t* stix)
 	STIX_ASSERT (STIX_OOI_IN_PREAMBLE_INDEX_RANGE(preamble_index));
 
 	mth->owner = stix->c->cls.self_oop;
+	mth->name = name;
 	mth->preamble = STIX_SMOOI_TO_OOP(STIX_METHOD_MAKE_PREAMBLE(preamble_code, preamble_index));
 	mth->preamble_data[0] = STIX_SMOOI_TO_OOP(0);
 	mth->preamble_data[1] = STIX_SMOOI_TO_OOP(0);
@@ -4314,7 +4315,7 @@ need to write code to collect string.
 
 	stix_poptmps (stix, tmp_count); tmp_count = 0;
 
-	if (!stix_putatdic(stix, stix->c->cls.mthdic_oop[stix->c->mth.type], name, (stix_oop_t)mth)) goto oops;
+	if (!stix_putatdic(stix, stix->c->cls.mthdic_oop[stix->c->mth.type], (stix_oop_t)name, (stix_oop_t)mth)) goto oops;
 	return 0;
 
 oops:

stix/lib/exec.c

@@ -942,6 +942,8 @@ static stix_oop_method_t find_method (stix_t* stix, stix_oop_t receiver, const s
 
 #if defined(STIX_DEBUG_EXEC_002)
 printf ("==== FINDING METHOD FOR %p [", receiver);
+print_object (stix, receiver);
+printf ("] - ["); 
 print_oocs (message);
 printf ("] in ");
 #endif
@@ -949,7 +951,7 @@ printf ("] in ");
 	cls = (stix_oop_class_t)STIX_CLASSOF(stix, receiver);
 	if ((stix_oop_t)cls == stix->_class)
 	{
-		/* receiver is a class object */
+		/* receiver is a class object (an instance of Class) */
 		c = receiver; 
 		dic_no = STIX_CLASS_MTHDIC_CLASS;
 #if defined(STIX_DEBUG_EXEC_002)
@@ -969,7 +971,6 @@ printf ("\n");
 #endif
 	}
 
-
 	if (c != stix->_nil)
 	{
 		if (super) 
@@ -997,6 +998,22 @@ printf ("\n");
 	}
 
 not_found:
+	if ((stix_oop_t)cls == stix->_class)
+	{
+		/* the object is an instance of Class. find the method
+		 * in an instance method dictionary of Class also */
+		mthdic = ((stix_oop_class_t)cls)->mthdic[STIX_CLASS_MTHDIC_INSTANCE];
+		STIX_ASSERT ((stix_oop_t)mthdic != stix->_nil);
+		STIX_ASSERT (STIX_CLASSOF(stix, mthdic) == stix->_method_dictionary);
+
+		ass = (stix_oop_association_t)stix_lookupdic (stix, mthdic, message);
+		if (ass) 
+		{
+			STIX_ASSERT (STIX_CLASSOF(stix, ass->value) == stix->_method);
+			return (stix_oop_method_t)ass->value;
+		}
+	}
+
 	stix->errnum = STIX_ENOENT;
 	return STIX_NULL;
 }
@@ -1054,7 +1071,7 @@ TODO: overcome this problem
 	ctx->ip = STIX_SMOOI_TO_OOP(0); /* point to the beginning */
 	ctx->sp = STIX_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */
 	ctx->origin = ctx; /* point to self */
-	ctx->method_or_nargs = (stix_oop_t)mth; /* fake. help SWITCH_ACTIVE_CONTEXT() not fail*/
+	ctx->method_or_nargs = (stix_oop_t)mth; /* fake. help SWITCH_ACTIVE_CONTEXT() not fail. TODO: create a static fake method and use it... instead of 'mth' */
 
 	/* [NOTE]
 	 *  the receiver field and the sender field of ctx are nils.

stix/lib/stix.h

@@ -416,9 +416,9 @@ struct stix_association_t
 };
 
 #if defined(STIX_USE_OBJECT_TRAILER)
-#	define STIX_METHOD_NAMED_INSTVARS 7
-#else
 #	define STIX_METHOD_NAMED_INSTVARS 8
+#else
+#	define STIX_METHOD_NAMED_INSTVARS 9
 #endif
 typedef struct stix_method_t stix_method_t;
 typedef struct stix_method_t* stix_oop_method_t;
@@ -428,6 +428,8 @@ struct stix_method_t
 
 	stix_oop_class_t owner; /* Class */
 
+	stix_oop_char_t  name; /* Symbol, method name */
+
 	/* primitive number */
 	stix_oop_t       preamble; /* SmallInteger */