fixed the stack growth issue when manipulating the instruction pointer by intruducing a new primitive method MethodContext>>goto:

stix/kernel/Context.st

@@ -34,10 +34,15 @@
 		^self.ip + 1
 	}
 
+	#method goto: anInteger
+	{
+		<primitive: #_context_goto>
+		self primitiveFailed. ## TODO: need to make this a hard failure?
+	}
+
 	#method pc: anInteger
 	{
 		self.ip := anInteger.
-		"self.sp := self.sp - 1."  "whould this always work??? "
 	}
 
 	#method sp
@@ -184,11 +189,18 @@
 		## --------------------------------------------------
 		## If VM is built with STIX_USE_PROCSTK
 		## --------------------------------------------------
-		| pc |
+		| pc sp |
+
 		pc := thisContext pcplus1.
-		(self value) ifFalse: [ ^nil "^self" ].
+		(self value) ifFalse: [ ^nil ].
 		aBlock value.
-		thisContext pc: pc.
+
+		## the pc: method leaves thisContext and pc in the stack after
+		## having changes the instruction poointer.
+		## as a result, the stack keeps growing. the goto method
+		## clears thisContext and pc off the stack unlike normal methods.
+		##thisContext pc: pc.
+		thisContext goto: pc.
 		## --------------------------------------------------
 	}
 
@@ -202,8 +214,8 @@
 		## --------------------------------------------------
 		| pc |
 		pc := thisContext pcplus1.
-		(self value) ifFalse: [ ^nil "^self" ].
+		(self value) ifFalse: [ ^nil ].
-		thisContext pc: pc.
+		thisContext goto: pc.
 		## --------------------------------------------------
 	}
 
@@ -247,7 +259,7 @@
 		pc := thisContext pcplus1.
 		(self value) ifTrue: [ ^nil "^self" ].
 		aBlock value.
-		thisContext pc: pc.
+		thisContext goto: pc.
 		## --------------------------------------------------
 	}
 
@@ -262,7 +274,7 @@
 		| pc |
 		pc := thisContext pcplus1.
 		(self value) ifTrue: [ ^nil "^self" ].
-		thisContext pc: pc.
+		thisContext goto: pc.
 		## --------------------------------------------------
 	}
 

stix/kernel/Process.st

@@ -104,10 +104,11 @@
 
 	#method critical: aBlock
 	{
-'CRITICAL....11' dump.
+## TODO: implement this
+"
 		self wait.
-'CRITICAL....22' dump.
 		^aBlock ensure: [ self signal ]
+"
 	}
 
 	## ==================================================================

stix/kernel/test-010.st

@@ -48,7 +48,8 @@
 	
 	#method(#class) main
 	{
-		## test critical region
+
+	## THIS CRASHES VM. PLEASE CHECK. CRASHES WHEN REPETITION IS 1000
 		|t1 t2 s1 s2 s3|
 
 		'START OF MAIN' dump.
@@ -57,13 +58,13 @@
 		s2 := Semaphore new.
 
 		t1 := [ 
-			1000 timesRepeat: ['BLOCK #1' dump].
+			10000 timesRepeat: ['BLOCK #1' dump].
 			##s2 critical: [
 			##	10 timesRepeat: ['BLOCK #1' dump ]
 			##]
 		] newProcess.
 		t2 := [ 
-			1000 timesRepeat: ['BLOCK #2' dump].
+			10000 timesRepeat: ['BLOCK #2' dump].
 			##s2 critical: [
 			##	10 timesRepeat: ['BLOCK #2' dump. ]
 			##].
@@ -78,6 +79,18 @@
 
 		'END OF MAIN' dump.   
 
+
+"
+
+		|s1|
+		s1 := Semaphore new.
+		s1 signal.
+		'XXXXXXXXXXXXXXXX' dump.
+		s1 wait.
+"
+
+
+
 "
 		| v1 |
 		'START OF MAIN' dump.

stix/lib/exec.c

@@ -1539,6 +1539,45 @@ static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs)
 	return 1;
 }
 
+
+static int prim_context_goto (stix_t* stix, stix_ooi_t nargs)
+{
+	stix_oop_t rcv;
+	stix_oop_t pc;
+	stix_oow_t pcw;
+
+	/* this primivie provides the similar functionality to  MethodContext>>pc:
+	 * except that it pops the receiver and arguments and doesn't push a
+	 * return value. it's useful when you want to change the instruction
+	 * pointer while maintaining the stack level before the call */
+
+	STIX_ASSERT (nargs == 1);
+
+	rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
+	if (STIX_CLASSOF(stix, rcv) != stix->_method_context)
+	{
+#if defined(STIX_DEBUG_EXEC_001)
+printf ("prim_context_goto: PRIMITVE RECEIVER IS NOT A METHOD CONTEXT\n");
+#endif
+		return 0;
+	}
+
+	pc = ACTIVE_STACK_GET(stix, stix->sp);
+	if (!STIX_OOP_IS_SMOOI(pc) || STIX_OOP_TO_SMOOI(pc) < 0)
+	{
+#if defined(STIX_DEBUG_EXEC_001)
+printf ("prim_context_goto: PRIMITVE ARGUMENT IS INVALID\n");
+#endif
+		return 0;
+	}
+
+	((stix_oop_context_t)rcv)->ip = pc;
+	LOAD_ACTIVE_IP (stix);
+
+	ACTIVE_STACK_POPS (stix, 2); /* pop both the argument and the receiver */
+	return 1;
+}
+
 static int __block_value (stix_t* stix, stix_ooi_t rcv_blkctx_offset, stix_ooi_t nargs, stix_ooi_t num_first_arg_elems, stix_oop_context_t* pblkctx)
 {
 	/* prepare a new block context for activation.
@@ -2635,6 +2674,7 @@ static prim_t primitives[] =
 	{   2,  2,  prim_basic_at_put,         "_basic_at_put"        },
 
 
+	{   1,  1,  prim_context_goto,                     "_context_goto"        },
 	{   0, MAX_NARGS,  prim_block_value,               "_block_value"         },
 	{   0, MAX_NARGS,  prim_block_new_process,         "_block_new_process"   },
 
@@ -2866,7 +2906,7 @@ printf ("\n");
 	method = find_method (stix, receiver, &mthname, to_super);
 	if (!method) 
 	{
-		static stix_uch_t fbm[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' };
+		static stix_ooch_t fbm[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' };
 		mthname.ptr = fbm;
 		mthname.len = 18;
 
@@ -2876,6 +2916,7 @@ printf ("\n");
 			/* TODO: improve this hard error handling */
 			stix_oop_t c;
 
+/* TODO: remove this print out.... or have it gracefully returned to the caller side */
 			c = STIX_CLASSOF(stix,receiver);
 			printf ("HARD FAILURE ERROR [IMAGE PROBLEM] - receiver [");
 			print_object (stix, receiver);
@@ -2896,7 +2937,7 @@ printf ("\n");
  *       how can i preserve it gracefully? */
 			ACTIVE_STACK_POPS (stix, nargs);
 			nargs = 1;
-			ACTIVE_STACK_PUSH (stix, selector);
+			ACTIVE_STACK_PUSH (stix, (stix_oop_t)selector);
 		}
 	}
 
@@ -3133,6 +3174,15 @@ int stix_execute (stix_t* stix)
 			/* no more waiting semaphore and no more process */
 			STIX_ASSERT (stix->processor->tally = STIX_SMOOI_TO_OOP(0));
 printf ("REALLY NO MORE RUNNABLE PROCESS...\n");
+
+
+#if 0
+if (there is semaphore awaited.... )
+{
+/* DO SOMETHING */
+}
+#endif
+
 			break;
 		}
 

stix/lib/main.c

@@ -380,7 +380,6 @@ static char* syntax_error_msg[] =
 	"literal expected"
 };
 
-stix_ooch_t str_system[] = { 'S', 'y', 's', 't', 'e', 'm' };
 stix_ooch_t str_my_object[] = { 'M', 'y', 'O', 'b','j','e','c','t' };
 stix_ooch_t str_main[] = { 'm', 'a', 'i', 'n' };
 
@@ -461,27 +460,6 @@ int main (int argc, char* argv[])
 	}
 #endif
 
-	/*
-	{
-	stix_oop_t k;
-	stix_oow_t x;
-
-	k = STIX_SMOOI_TO_OOP(-1);
-	printf ("%ld %ld %ld %lX\n", (long int)STIX_OOP_TO_SMOOI(k), (long int)STIX_SMOOI_MIN, (long int)STIX_SMOOI_MAX, (long)LONG_MIN);
-
-	k = STIX_SMOOI_TO_OOP(STIX_SMOOI_MAX);
-	printf ("%ld\n", (long int)STIX_OOP_TO_SMOOI(k));
-
-	k = STIX_SMOOI_TO_OOP(STIX_SMOOI_MIN);
-	printf ("%ld\n", (long int)STIX_OOP_TO_SMOOI(k));
-
-	printf ("%u\n", STIX_BITS_MAX(unsigned int, 5));
-	x = STIX_CLASS_SPEC_MAKE (10, 1, STIX_OBJ_TYPE_CHAR);
-	printf ("%lu %lu %lu %lu\n", (unsigned long int)x, (unsigned long int)STIX_SMOOI_TO_OOP(x),
-		(unsigned long int)STIX_CLASS_SPEC_NAMED_INSTVAR(x),
-		(unsigned long int)STIX_CLASS_SPEC_INDEXED_TYPE(x));
-	}*/
-
 	vmprim.mod_open = mod_open;
 	vmprim.mod_close = mod_close;
 	vmprim.mod_getsym = mod_getsym;
@@ -524,63 +502,6 @@ int main (int argc, char* argv[])
 		return -1;
 	}
 
-#if 0
-{
-
-/*const stix_bch_t* xxx = "9999999999999999999999999999999999999999999999999999999999999999999999999999999999";*/
-
-//const stix_bch_t* xxx = "2305843009213693953";
-//const stix_bch_t* xxx = "184467440737095516161111";
-const stix_bch_t* xxx = "999999999999999999999999";
-const stix_bch_t* yyy = "1000000000000000000000000000000000000000000000000";
-//const stix_bch_t* yyy = "1290812390812903812903812903812903812903481290381209381290381290381290831290381290381290831209381293712897361287361278631278361278631278631287361278361278";
-
-stix_ooch_t buf[10240];
-stix_oow_t xxxlen;
-stix_oow_t buflen;
-
-xxxlen = stix_countbcstr(xxx);
-buflen = STIX_COUNTOF(buf);
-stix_utf8toucs (xxx, &xxxlen, buf, &buflen);
-dump_object (stix, stix_strtoint (stix, buf, buflen, 10), "STRINT");
-
-xxxlen = stix_countbcstr(yyy);
-buflen = STIX_COUNTOF(buf);
-stix_utf8toucs (yyy, &xxxlen, buf, &buflen);
-dump_object (stix, stix_strtoint (stix, buf, buflen, 3), "STRINT");
-}
-
-{
-stix_ooch_t x[] = { 'X', 't', 'r', 'i', 'n', 'g', '\0' };
-stix_ooch_t y[] = { 'S', 'y', 'm', 'b', 'o', 'l', '\0' };
-stix_oop_t a, b, k;
-
-a = stix_makesymbol (stix, x, 6);
-b = stix_makesymbol (stix, y, 6);
-
-printf ("%p %p\n", a, b);
-
-
-	dump_symbol_table (stix);
-
-/*
-stix_pushtmp (stix, &a);
-stix_pushtmp (stix, &b);
-k = stix_instantiate (stix, stix->_byte_array, STIX_NULL, 100);
-stix_poptmps (stix, 2);
-stix_putatsysdic (stix, a, k);
-*/
-
-stix_gc (stix);
-a = stix_findsymbol (stix, x, 6);
-printf ("%p\n", a);
-	dump_symbol_table (stix);
-
-
-	dump_dictionary (stix, stix->sysdic, "System dictionary");
-}
-#endif
-
 	xtn = stix_getxtn (stix);
 
 #if defined(macintosh)
@@ -654,8 +575,6 @@ printf ("%p\n", a);
 	g_stix = stix;
 	setup_tick ();
 
-/*	objname.ptr = str_system;
-	objname.len = 6;*/
 	objname.ptr = str_my_object;
 	objname.len = 8;
 	mthname.ptr = str_main;
@@ -669,7 +588,6 @@ printf ("%p\n", a);
 	cancel_tick ();
 	g_stix = STIX_NULL;
 
-/*	dump_dictionary (stix, stix->sysdic, "System dictionary");*/
 	stix_close (stix);
 
 #if defined(USE_LTDL)