fixed a bug in return handling

stix/lib/debug.c

@@ -159,6 +159,19 @@ void print_object (stix_t* stix, stix_oop_t oop)
 			}
 			printf (")");
 		}
+		else if ((stix_oop_t)c == stix->_class)
+		{
+			/* print the class name */
+			for (i = 0; i < STIX_OBJ_GET_SIZE(((stix_oop_class_t)oop)->name); i++)
+			{
+				bcslen = STIX_COUNTOF(bcs);
+				ucslen = 1;
+				if (stix_ucstoutf8 (&((stix_oop_class_t)oop)->name->slot[i], &ucslen, bcs, &bcslen) >= 0)
+				{
+					printf ("%.*s", (int)bcslen, bcs);
+				}
+			}
+		}
 		else
 		{
 			s.ptr = ((stix_oop_char_t)c->name)->slot;

stix/lib/exec.c

@@ -110,18 +110,29 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth,
 	STIX_ASSERT (stix->sp >= nargs);
 
 #if 0
-	if (!(stix->option.trait & STIX_NOTCO) && next_inst == CODE_RETURN_FROM_BLOCK)
+	if (!(stix->option.trait & STIX_NOTCO))
+	{
+		if (stix->active_context->home == stix->_nil)
+		{
+			/* method context */
+			STIX_ASSERT (STIX_CLASSOF(stix, stix->active_context) == stix->_method_context);
+
+			if (next_inst == ((CODE_POP_STACKTOP << 8) | CODE_RETURN_STACKTOP) ||
+			    next_inst == ((CODE_POP_STACKTOP << 8) | CODE_RETURN_RECEIVER) ||
+			    next_inst == CODE_RETURN_STACKTOP ||
+			    next_inst == CODE_RETURN_RECEIVER)
 			{
 				/* don't allocate a new method context. reuse the active context. 
 				 *
 				 * [NOTE]
 				 *  a context stored into a variable by way of 'thisContext' may
-		 *  present different contents after this reuse.
+				 *  present a different context from the original after this reuse.
 				 */
-		STIX_ASSERT (STIX_CLASSOF(stix, stix->active_context) == stix->_block_context);
 				ctx = stix->active_context;
 				goto reuse_context;
 			}
+		}
+	}
 #endif
 
 	stix_pushtmp (stix, (stix_oop_t*)&mth);
@@ -129,39 +140,7 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth,
 	stix_poptmp (stix);
 	if (!ctx) return -1;
 
-#if 0
-	if (stix->option.trait & STIX_NOTCO)
-	{
-#endif
 	ctx->sender = (stix_oop_t)stix->active_context; 
-#if 0
-	}
-	else
-	{
-		switch (next_inst)
-		{
-			case (CODE_POP_STACKTOP << 8) | CODE_RETURN_STACKTOP:
-			case (CODE_POP_STACKTOP << 8) | CODE_RETUCEIVER:
-			case CODE_RETURN_STACKTOP:
-			case CODE_RETURN_RECEIVER:
-				/* tail-call optimization */
-	/* TODO: is this correct? */
-				ctx->sender = stix->active_context->sender;
-				break;
-
-			/* RETURN_FROM_BLOCK is never preceeded by POP_STACKPOP */
-			case CODE_RETURN_FROM_BLOCK:
-				/* tail-call optimization */
-				ctx->sender = stix->active_context->sender;
-				break;
-
-			default:
-				ctx->sender = (stix_oop_t)stix->active_context; 
-				break;
-		}
-	}
-#endif
-
 	ctx->ip = STIX_OOP_FROM_SMINT(0);
 	/* the stack front has temporary variables including arguments.
 	 *
@@ -228,7 +207,7 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth,
 	/* swtich the active context */
 	SWITCH_ACTIVE_CONTEXT (stix, ctx);
 
-printf ("<<ENTERING>>\n");
+printf ("<<ENTERING>> SP=%d\n", (int)stix->sp);
 	return 0;
 
 #if 0
@@ -961,6 +940,7 @@ printf ("PUSH_INSTVAR %d\n", (int)b1);
 
 			case CMD_PUSH_TEMPVAR:
 printf ("PUSH_TEMPVAR idx=%d - ", (int)b1);
+fflush(stdout);
 				if (stix->active_context->home != stix->_nil)
 				{
 /*TODO: improve this slow temporary access */
@@ -1122,12 +1102,15 @@ printf ("\n");
 				selector = (stix_oop_char_t)stix->active_method->slot[b2];
 
 if (cmd == CMD_SEND_MESSAGE)
-printf ("SEND_MESSAGE TO RECEIVER AT STACKPOS=%d NARGS=%d RECEIER=", (int)(stix->sp - b1), (int)b1);
+printf ("SEND_MESSAGE TO RECEIVER AT STACKPOS=%d NARGS=%d SELECTOR=", (int)(stix->sp - b1), (int)b1);
 else
-printf ("SEND_MESSAGE_TO_SUPER TO RECEIVER AT STACKPOS=%d NARGS=%d RECEIVER=", (int)(stix->sp - b1), (int)b1);
+printf ("SEND_MESSAGE_TO_SUPER TO RECEIVER AT STACKPOS=%d NARGS=%d SELECTOR=", (int)(stix->sp - b1), (int)b1);
+print_object (stix, (stix_oop_t)selector);
+fflush (stdout);
 				STIX_ASSERT (STIX_CLASSOF(stix, selector) == stix->_symbol);
 
 				newrcv = ACTIVE_STACK_GET(stix, stix->sp - b1);
+printf (" RECEIVER = ");
 print_object(stix, newrcv);
 printf ("\n");
 				mthname.ptr = selector->slot;
@@ -1163,6 +1146,23 @@ printf ("RETURN INSTVAR AT PREAMBLE\n");
 						rcv = (stix_oop_oop_t)ACTIVE_STACK_GETTOP(stix);
 						STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(rcv) == STIX_OBJ_TYPE_OOP);
 						STIX_ASSERT (STIX_OBJ_GET_SIZE(rcv) > STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
+
+						if (rcv == (stix_oop_oop_t)stix->active_context)
+						{
+							/* the active context object doesn't keep
+							 * the most up-to-date information in the 
+							 * 'ip' and 'sp' field. commit these fields
+							 * when the object to be accessed is 
+							 * the active context. this manual commit
+							 * is required because this premable handling
+							 * skips activation of a new method context
+							 * that would commit these fields. 
+							 */
+							STORE_ACTIVE_IP (stix);
+							STORE_ACTIVE_SP (stix);
+						}
+
+						/* this accesses the instance variable of the receiver */
 						ACTIVE_STACK_SET (stix, stix->sp, rcv->slot[STIX_METHOD_GET_PREAMBLE_INDEX(preamble)]);
 						break;
 					}
@@ -1188,6 +1188,7 @@ printf ("RETURN INSTVAR AT PREAMBLE\n");
 					}
 
 					default:
+/* TOOD: remove it only in the instructions that requires reading ahead */
 						/* read ahead the next instruction for tail-call optimization */
 						next_inst = stix->active_code->slot[stix->ip];
 							if (next_inst == CODE_POP_STACKTOP)
@@ -1388,26 +1389,56 @@ printf ("SEND_BLOCK_COPY\n");
 
 
 					handle_return:
-#if 0
-						if (stix->active_context->home == stix->_nil)
-						{
-							/* a method context is active. */
-							SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->sender);
-						}
-						else
-						{
-							/* a block context is active */
-							SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->origin->sender);
-						}
-#else
-						SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->origin->sender);
-#endif
 
+printf ("<<LEAVING>> SP=%d\n", (int)stix->sp);
+
+						/* put the instruction pointer back to the return
+						 * instruction (RETURN_RECEIVER or RETURN_RECEIVER)
+						 * if a context returns into this context again,
+						 * it'll be able to return as well again.
+						 * 
+						 * Consider a program like this:
+						 *
+						 * #class MyObject(Object)
+						 * {
+						 *   #declare(#classinst) t1 t2.
+						 *   #method(#class) xxxx
+						 *   {
+						 *     | g1 g2 |
+						 *     t1 dump.
+						 *     t2 := [ g1 := 50. g2 := 100. ^g1 + g2 ].
+						 *     (t1 < 100) ifFalse: [ ^self ].
+						 *     t1 := t1 + 1. 
+						 *     ^self xxxx.
+						 *   }
+						 *   #method(#class) main
+						 *   {
+						 *     t1 := 1.
+						 *     self xxxx.
+						 *     t2 := t2 value.  
+						 *     t2 dump.
+						 *   }
+						 * }
+						 *
+						 * the 'xxxx' method invoked by 'self xxxx' has 
+						 * returned even before 't2 value' is executed.
+						 * the '^' operator makes the active context to
+						 * switch to its 'origin->sender' which is the
+						 * method context of 'xxxx' itself. placing its
+						 * instruction pointer at the 'return' instruction
+						 * helps execute another return when the switching
+						 * occurs.
+						 * 
+						 * TODO: verify if this really works
+						 *
+						 */
+						stix->ip--; 
+
+						SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->origin->sender);
 
 						/* push the return value to the stack of the new active context */
 						ACTIVE_STACK_PUSH (stix, return_value);
 
-printf ("<<LEAVING>>\n");
 						if (stix->active_context->sender == stix->_nil)
 						{
 							/* the sending context of the intial context has been set to nil.

stix/lib/main.c

@@ -279,6 +279,13 @@ printf ("%ld\n", (long int)STIX_OOP_TO_SMINT(k));
 		stix_setoption (stix, STIX_DFL_SYSDIC_SIZE, &tab_size);
 	}
 
+	{
+		int trait = 0;
+
+		/*trait |= STIX_NOTCO;*/
+		stix_setoption (stix, STIX_TRAIT, &trait);
+	}
+
 	if (stix_ignite(stix) <= -1)
 	{
 		printf ("cannot ignite stix - %d\n", stix_geterrnum(stix));

stix/lib/stix-prv.h

@@ -485,6 +485,80 @@ struct stix_compiler_t
 #define MAX_CODE_BLKCODE             MAX_CODE_JUMP
 #define MAKE_CODE(x,y) (((x) << 4) | y)
 
+
+/*
+--------------------------------------
+
+  0  000000XX PUSH_INSTVAR
+  1  000001XX PUSH_TEMPVAR
+  2  000010XX PUSH_LITERAL
+  3  000011XX STORE_INTO_INSTVAR
+  4  000100XX STORE_INTO_TEMPVAR
+  5  000101XX POP_INTO_INSTVAR
+  6  000110XX POP_INTO_TEMPVAR
+
+  7  000111XX JUMP_FORWARD
+  8  001000XX JUMP_BACKWARD
+  9  001001XX JUMP_IF_TRUE
+ 10  001010XX JUMP_IF_FALSE
+
+ 11  001011XX 
+ 12  001100XX 
+ 13  001101XX 
+ 14  001110XX 
+ 15  001111XX 
+
+---------------------------------------
+ 16  010000XX YYYYYYYY PUSH_XTEMPVAR          XXXth outer-frame, YYYYYYYY local variable
+ 17  010001XX YYYYYYYY STORE_INTO_XTEMPVAR
+ 18  010010XX YYYYYYYY POP_INTO_XTEMPVAR
+
+ 19  010011XX YYYYYYYY PUSH_OBJVAR
+ 20  010100XX YYYYYYYY STORE_INTO_OBJVAR
+ 21  010101XX YYYYYYYY POP_INTO_OBJVAR        XXXth instance variable of YYYYYYYY object
+ 22  010110XX YYYYYYYY SEND_MESSAGE
+ 23  010111XX YYYYYYYY SEND_MESSAGE_TO_SUPER  XXX args, YYYYYYYY message
+
+ 24  011000XX
+ 25  011001XX
+ 26  011010XX
+ 27  011011XX
+ 28  011100XX
+ 29  011101XX
+ 30  011110XX
+ 31  011111XX
+
+-------------------------------------
+
+
+
+switch (binst)
+{
+	case XXX:
+	case YYY:
+
+
+	default:
+	{
+		cmd = binst >> 2;
+
+		switch (cmd)
+		{
+			case PUSH_INSTVAR:
+
+			case PUSHX_INSTVAR:
+
+
+
+			default:
+				treated as no op???
+		}
+	}
+}
+
+*/
+
+
 enum stix_cmdcode_t
 {
 	CMD_EXTEND                     = 0x0,

stix/lib/test-005.st

@@ -248,6 +248,24 @@
 	#method pc: anInteger
 	{
 		ip := anInteger.
+		"sp := sp - 1."  "whould this always work??? "
+	}
+
+	#method sp
+	{
+		^sp.
+
+	}
+	#method sp: anInteger
+	{
+		sp := anInteger.
+	}
+
+	#method pc: aPC sp: aSP
+	{
+		ip := aPC.
+		sp := aSP.
+		##sp := sp - 1.
 	}
 }
 
@@ -279,20 +297,45 @@
 	{
 ## http://stackoverflow.com/questions/2500483/is-there-a-way-in-a-message-only-language-to-define-a-whiletrue-message-without
 
+## ----------------------------------------------------------------------------
+
 ##		^(self value) ifTrue: [aBlock value. self whileTrue: aBlock].
 
-		| start |
+## ----------------------------------------------------------------------------
-		start := thisContext pc.
+
+		## less block context before whileTrue: is recursively sent.
+		## whileTrue: is sent in a method context.
+##		(self value) ifFalse: [^nil].
+##		aBlock value. 
+##		self whileTrue: aBlock.
+
+## ----------------------------------------------------------------------------
+
+## ----------------------------------------------------------------------------
+		| pc sp xsp |
+
+		sp := thisContext sp.
+		sp := sp - 1. "decrement sp by 1 becuase thisContext pushed above affects the sp method"
+		pc := thisContext pc.
 		self value ifFalse: [ ^nil "^self" ].
 		aBlock value.
-		thisContext pc: start.
+		##thisContext pc: pc - 3 sp: sp.
+		thisContext pc: pc + 2 sp: sp.   
+		## this +2 or - 3 above is dependent on the byte code instruction size used for 'store'  
+		## +2 to skip STORE_INTO_TEMP(pc) and POP_STACKTOP.
+		## TODO: make it independent of the byte code size 
 
-##		| start |
+## ----------------------------------------------------------------------------
-##		start := thisContext pc.
-##		^self value ifTrue: [aBlock value. thisContext pc: start]
 
+##        #<label>:
+##		thisContext pc: #<label> sp: sp.
+##
+##		| pc |
+##		pc := thisContext pc.
+##		^self value ifTrue: [aBlock value. thisContext pc: pc]
+
+## ----------------------------------------------------------------------------
 
-## TODO: add restart method.
 ##		self value ifTrue: [ aBlock value. thisContext restart. ].
 	}
 
@@ -315,6 +358,11 @@
 	{
 		sp := anInteger.
 	}
+
+	#method restart
+	{
+		ip := source pc.
+	}
 }
 
 #class(#pointer) CompiledMethod(Object)
@@ -457,7 +505,7 @@
 		##a dump.
 	}
 
-	#method(#class) main99
+	#method(#class) main55
 	{
 		|a b c|
 
@@ -471,6 +519,48 @@
 		^10
 	}
 
+## ---------------------------------------------------------------------------
+
+" this sample demonstrates what happens when a block context returns to the origin's caller
+  after the caller has already returned. "
+
+	#method(#class) xxxx
+	{
+		| g1 g2 |
+		t1 dump.
+		t2 := [ |tmp| g1 := 50. g2 := 100. tmp := g1 + g2. tmp dump. ^tmp ].
+		(t1 < 100) ifFalse: [ ^self ].
+
+		t1 := t1 + 1. 
+		self xxxx
+	}
+	#method(#class) yyyy
+	{
+		|c1|
+		t1 := 1.
+		c1 :=self xxxx.
+		888 dump.
+		999 dump.
+		^c1.
+	}
+	#method(#class) main66
+	{
+		self yyyy.
+		t2 := t2 value.  "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
+		t2 dump.
+	}
+
+	#method(#class) mainj
+	{
+		|k1|
+		t1 := 1.
+		self xxxx.
+
+		t2 := t2 value.  "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
+		t2 dump.
+	}
+## ----------------------------------------------------------------------
+
 	#method(#class) main
 	{
 		|a b sum |
@@ -480,7 +570,11 @@
 
 		'-------------------------' dump.
 		b := 0.
-		[ b < 1000 ] whileTrue: [ b dump. b := b + 1 ].
+		[ b < 2000 ] whileTrue: [ b dump. b := b + 1 ].
+
+		'-------------------------' dump.
+		b := 0.
+		[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
 
 		'-------------------------' dump.
 		 a := #[4 5 6 7] at: 3. 
@@ -495,6 +589,7 @@
 
 		[self getTen] value dump.
 	}
+
 }