interim commit while attempting to primitive calls

stix/kernel/test-014.st

@@ -96,7 +96,7 @@
 	{
 		| v1 v2 |
 
-"		v2 := 'have fun'.
+		v2 := 'have fun'.
 
 		v2 at: 0 put: $H.
 
@@ -109,7 +109,7 @@
 		v1 write: S'하하하하하하하하 좋아좋아 可愛くってしょうがない(^o^) ほのかちゃん、しおりちゃん元気そうだね！ 久しぶりに見た。しおりちゃんどうしたのかな？좋아 하라하하\n'.
 		v1 close.
 
-		self main2."
+		self main2.
 
 		System logNl: (9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
 		             * 8888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) asString.

stix/lib/exec.c

@@ -3016,22 +3016,32 @@ static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t narg
 			stix_ooi_t prim_name_index;
 			stix_oop_t name;
 			stix_prim_impl_t handler;
-			register stix_oow_t w;
+			stix_oow_t w;
+			stix_ooi_t sp, nargs, sb;
+
+			sp = stix->sp;
+			nargs = STIX_OOP_TO_SMOOI(method->tmpr_nargs);
+			sb = stix->sp - nargs - 1; /* stack base before receiver and arguments */
 
 			prim_name_index = STIX_METHOD_GET_PREAMBLE_INDEX(preamble);
 			LOG_INST_1 (stix, "preamble_named_primitive %zd", prim_name_index);
 
-			name = method->slot[prim_name_index];
-
-			STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR));
-			STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name));
-			STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol);
-
 			/* merge two SmallIntegers to get a full pointer */
 			w = (stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[0]) << (STIX_OOW_BITS / 2) | 
-					(stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[1]);
+			    (stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[1]);
 			handler = (stix_prim_impl_t)w;
-			if (!handler) handler = query_prim_module (stix, ((stix_oop_char_t)name)->slot, STIX_OBJ_GET_SIZE(name));
+			if (handler) goto exec_handler;
+			else
+			{
+				STIX_ASSERT (prim_name_index >= 0);
+				name = method->slot[prim_name_index];
+
+				STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR));
+				STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name));
+				STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol);
+
+				handler = query_prim_module (stix, ((stix_oop_char_t)name)->slot, STIX_OBJ_GET_SIZE(name));
+			}
 
 			if (handler)
 			{
@@ -3041,15 +3051,42 @@ static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t narg
 				method->preamble_data[0] = STIX_SMOOI_TO_OOP((stix_oow_t)handler >> (STIX_OOW_BITS / 2));
 				method->preamble_data[1] = STIX_SMOOI_TO_OOP((stix_oow_t)handler & STIX_LBMASK(stix_oow_t, STIX_OOW_BITS / 2));
 
+			exec_handler:
 				stix_pushtmp (stix, (stix_oop_t*)&method);
 				n = handler (stix, nargs);
+				
 				stix_poptmp (stix);
-				if (n <= -1) return -1; /* hard primitive failure */
+				if (n <= -1) 
+				{
+					STIX_DEBUG2 (stix, "Hard failure indicated by primitive function %p - return code %d\n", handler, n);
+					return -1; /* hard primitive failure */
+				}
 				if (n >= 1) break; /* primitive ok*/
 			}
 
-			/* soft primitive failure or handler not found*/
+			/* soft primitive failure or handler not found. 
-			if (activate_new_method (stix, method) <= -1) return -1;
+			 * if handler is not found, 0 must be printed in the debug message. */
+			STIX_DEBUG1 (stix, "Soft failure indicated by primitive function %p\n", handler);
+
+		#if defined(STIX_USE_OBJECT_TRAILER)
+			STIX_ASSERT (STIX_OBJ_GET_FLAGS_TRAILER(method));
+			if (method->slot[STIX_OBJ_GET_SIZE(method)] == 0) /* this trailer size field not a small integer */
+		#else
+			if (method->code == stix->_nil)
+		#endif
+			{
+				/* no byte code to execute */
+/* TODO: what is the best tactics? emulate "self primitiveFailed"? */
+
+				/* force restore stack pointers */
+				stix->sp = sb;
+				STIX_STACK_PUSH (stix, stix->_nil);
+				return -1;
+			}
+			else
+			{
+				if (activate_new_method (stix, method) <= -1) return -1;
+			}
 			break;
 		}
 

stix/lib/mod-con.c

@@ -221,6 +221,34 @@ static int prim_setcursor (stix_t* stix, stix_ooi_t nargs)
 	return 1;
 }
 
+
+#if 0
+static int prim_setcursorto (stix_t* stix, stix_ooi_t nargs)
+{
+	console_t* con;
+	stix_oop_oop_t point;
+	char* cup;
+
+	rcv = STIX_STACK_GETRCV(stix, nargs);
+	con = STIX_OOP_TO_SMOOI(
+
+	con = STIX_OOP_TO_SMOOI(STIX_STACK_GETARG(stix, nargs, 0));
+	point = STIX_STACK_GETARG(stix, nargs, 1);
+
+/* TODO: error check, class check, size check.. */
+	if (STIX_OBJ_GET_SIZE(point) != 2)
+	{
+		return 0;
+	}
+
+	cup = tiparm (con->cup, STIX_OOP_TO_SMOOI(point->slot[1]), STIX_OOP_TO_SMOOI(point->slot[0]));
+	write (con->fd, cup, strlen(cup)); /* TODO: error check */
+
+	STIX_STACK_SETRETTORCV (stix, nargs);
+	return 1;
+}
+#endif
+
 /* ------------------------------------------------------------------------ */
 
 typedef struct fnctab_t fnctab_t;

stix/lib/stix.c

@@ -350,6 +350,8 @@ void stix_freemem (stix_t* stix, void* ptr)
 
 
 
+/* -------------------------------------------------------------------------- */
+
 stix_oop_t stix_makersrc (stix_t* stix, stix_oow_t v)
 {
 	stix_oop_t imm;
@@ -405,3 +407,62 @@ stix_oow_t stix_getrsrcval (stix_t* stix, stix_oop_t imm)
 	STIX_ASSERT (STIX_OOP_IS_RSRC(imm));
 	return stix->rsrc.ptr[STIX_OOP_TO_RSRC(imm)];
 }
+
+/* -------------------------------------------------------------------------- */
+
+/* add a new primitive method */
+int stix_addmethod (stix_t* stix, stix_oop_t _class, const stix_ooch_t* name, stix_prim_impl_t func)
+{
+	/* NOTE: this function is a subset of add_compiled_method() in comp.c */
+
+	stix_oop_char_t nsym;
+	stix_oop_method_t mth;
+	stix_oop_class_t cls;
+	stix_oow_t tmp_count = 0, i;
+	stix_ooi_t arg_count = 0;
+
+	STIX_ASSERT (STIX_CLASSOF(stix, _class) == stix->_class);
+
+	cls = (stix_oop_class_t)_class;
+
+	/* TODO: check if name is a valid method name */
+	for (i = 0; name[i]; i++)
+	{
+		if (name[i] == ':') arg_count++;
+	}
+	nsym = (stix_oop_char_t)stix_makesymbol (stix, name, i);
+	if (!nsym) return -1;
+
+	stix_pushtmp (stix, (stix_oop_t*)&name); tmp_count++;
+
+#if defined(STIX_USE_OBJECT_TRAILER)
+	mth = (stix_oop_method_t)stix_instantiatewithtrailer (stix, stix->_method, 1, STIX_NULL, 0); 
+#else
+	mth = (stix_oop_method_t)stix_instantiate (stix, stix->_method, STIX_NULL, 1);
+#endif
+	if (!mth) goto oops;
+
+	/* store the symbol name to the literal frame */
+	mth->slot[0] = (stix_oop_t)nsym;
+
+	/* add the primitive as a name primitive with index of -1.
+	 * set the preamble_data to the pointer to the primitive function. */
+	mth->owner = cls;
+	mth->name = nsym;
+	mth->preamble = STIX_SMOOI_TO_OOP(STIX_METHOD_MAKE_PREAMBLE(STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE, -1));
+	mth->preamble_data[0] = STIX_SMOOI_TO_OOP((stix_oow_t)func >> (STIX_OOW_BITS / 2));
+	mth->preamble_data[1] = STIX_SMOOI_TO_OOP((stix_oow_t)func & STIX_LBMASK(stix_oow_t, STIX_OOW_BITS / 2));
+	mth->tmpr_count = STIX_SMOOI_TO_OOP(arg_count);
+	mth->tmpr_nargs = STIX_SMOOI_TO_OOP(arg_count);
+	stix_poptmps (stix, tmp_count); tmp_count = 0;
+
+/* TODO: class method? */
+	/* instance method */
+	if (!stix_putatdic (stix, cls->mthdic[STIX_CLASS_MTHDIC_INSTANCE], (stix_oop_t)nsym, (stix_oop_t)mth)) goto oops;
+	return 0;
+
+oops:
+	stix_poptmps (stix, tmp_count);
+	return -1;
+}
+