fixed a bug of producing wrong argument count for a binary message.

added primitives for basicSize, basicAt:, basicAt:Put:

stix/lib/comp.c

@@ -1701,7 +1701,15 @@ static int compile_binary_method_name (stix_t* stix)
 	 * a duplcate name will shade a previsouly defined variable. */
 	if (add_temporary_variable(stix, &stix->c->tok.name) <= -1) return -1;
 	stix->c->mth.tmpr_nargs++;
-/* TODO: check if tmpr_nargs exceededs LIMIT (SMINT MAX). also bytecode max */
+
+	STIX_ASSERT (stix->c->mth.tmpr_nargs == 1);
+	/* this check should not be not necessary
+	if (stix->c->mth.tmpr_nargs > MAX_CODE_NARGS)
+	{
+		set_syntax_error (stix, STIX_SYNERR_ARGFLOOD, &stix->c->tok.loc, &stix->c->tok.name);
+		return -1;
+	}
+	*/
 
 	GET_TOKEN (stix);
 	return 0;
@@ -1784,6 +1792,7 @@ static int compile_method_name (stix_t* stix)
  		}
 	}
 
+	STIX_ASSERT (stix->c->mth.tmpr_nargs < MAX_CODE_NARGS);
 	/* the total number of temporaries is equal to the number of 
 	 * arguments after having processed the message pattern. it's because
 	 * stix treats arguments the same as temporaries */
@@ -2412,12 +2421,12 @@ static int compile_binary_message (stix_t* stix, int to_super)
 		if (compile_expression_primary(stix, STIX_NULL, STIX_NULL, &to_super2) <= -1  ||
 		    compile_unary_message(stix, to_super2) <= -1 ||
 		    add_symbol_literal(stix, &binsel, &index) <= -1 ||
-		    emit_double_positional_instruction(stix, send_message_cmd[to_super], 2, index) <= -1) 
+		    emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) 
 		{
 			stix->c->mth.binsels.len -= binsel.len;
 			return -1;
 		}
-printf ("send message %d with 2 arguments%s\n", (int)index, (to_super? " to super": ""));
+printf ("send message %d with 1 arguments%s\n", (int)index, (to_super? " to super": ""));
 		stix->c->mth.binsels.len -= binsel.len;
 	}
 
@@ -3190,9 +3199,14 @@ printf ("\n");
 
 		ass = stix_lookupsysdic(stix, &stix->c->cls.name);
 		if (ass && 
-		    STIX_CLASSOF(stix, ass->value) != stix->_class &&
+		    STIX_CLASSOF(stix, ass->value) == stix->_class &&
 		    STIX_OBJ_GET_FLAGS_KERNEL(ass->value) != 1)
 		{
+			/* the value must be a class object.
+			 * and it must be either a user-defined(0) or 
+			 * completed kernel built-in(2). 
+			 * an incomplete kernel built-in class object(1) can not be
+			 * extended */
 			stix->c->cls.self_oop = (stix_oop_class_t)ass->value;
 		}
 		else

stix/lib/debug.c

@@ -83,6 +83,69 @@ void print_ucs (const stix_ucs_t* name)
 }
 
 
+void print_object (stix_t* stix, stix_oop_t oop)
+{
+	if (oop == stix->_nil)
+	{
+		printf ("nil");
+	}
+	else if (oop == stix->_true)
+	{
+		printf ("true");
+	}
+	else if (oop == stix->_false)
+	{
+		printf ("false");
+	}
+	else if (STIX_OOP_IS_SMINT(oop))
+	{
+		printf ("%ld", (long int)STIX_OOP_TO_SMINT(oop));
+	}
+	else if (STIX_OOP_IS_CHAR(oop))
+	{
+		stix_bch_t bcs[32];
+		stix_uch_t uch;
+		stix_size_t ucslen, bcslen;
+
+		uch = STIX_OOP_TO_CHAR(oop);
+		bcslen = STIX_COUNTOF(bcs);
+		ucslen = 1;
+		if (stix_ucstoutf8 (&uch, &ucslen, bcs, &bcslen) >= 0)
+		{
+			printf ("$%.*s", (int)bcslen, bcs);
+		}
+	}
+	else
+	{
+		stix_oop_class_t c;
+		stix_ucs_t s;
+		stix_size_t i;
+		stix_bch_t bcs[32];
+		stix_size_t ucslen, bcslen;
+
+		c = (stix_oop_class_t)STIX_CLASSOF(stix, oop);
+		if ((stix_oop_t)c == stix->_symbol || (stix_oop_t)c == stix->_string)
+		{
+			for (i = 0; i < STIX_OBJ_GET_SIZE(oop); i++)
+			{
+				bcslen = STIX_COUNTOF(bcs);
+				ucslen = 1;
+				if (stix_ucstoutf8 (&((stix_oop_char_t)oop)->slot[i], &ucslen, bcs, &bcslen) >= 0)
+				{
+					printf ("%.*s", (int)bcslen, bcs);
+				}
+			}
+		}
+		else
+		{
+			s.ptr = ((stix_oop_char_t)c->name)->slot;
+			s.len = STIX_OBJ_GET_SIZE(c->name);
+			printf ("instance of ");
+			print_ucs (&s);
+		}
+	}
+}
+
 void __dump_object (stix_t* stix, stix_oop_t oop, int depth)
 {
 	stix_oop_class_t c;

stix/lib/exec.c

@@ -198,7 +198,7 @@ printf ("] in ");
 		c = receiver; 
 		dic_no = STIX_CLASS_MTHDIC_CLASS;
 printf ("class method dictioanry of ");
-dump_object(stix, ((stix_oop_class_t)c)->name, ""); 
+print_object(stix, (stix_oop_t)((stix_oop_class_t)c)->name); 
 printf ("\n");
 	}
 	else
@@ -206,7 +206,7 @@ printf ("\n");
 		c = (stix_oop_t)cls;
 		dic_no = STIX_CLASS_MTHDIC_INSTANCE;
 printf ("instance method dictioanry of ");
-dump_object(stix, ((stix_oop_class_t)c)->name, "XX");
+print_object(stix, (stix_oop_t)((stix_oop_class_t)c)->name);
 printf ("\n");
 	}
 
@@ -301,7 +301,7 @@ TODO: overcome this problem
 }
 
 
-int primitive_dump (stix_t* stix, stix_ooi_t nargs)
+static int primitive_dump (stix_t* stix, stix_ooi_t nargs)
 {
 	stix_ooi_t i;
 
@@ -318,9 +318,8 @@ int primitive_dump (stix_t* stix, stix_ooi_t nargs)
 	return 1; /* success */
 }
 
-int primitive_new (stix_t* stix, stix_ooi_t nargs)
+static int primitive_new (stix_t* stix, stix_ooi_t nargs)
 {
-
 	stix_oop_t rcv, obj;
 
 	STIX_ASSERT (nargs ==  0);
@@ -337,11 +336,11 @@ int primitive_new (stix_t* stix, stix_ooi_t nargs)
 	if (!obj) return -1;
 
 	/* emulate 'pop receiver' and 'push result' */
-	STACK_SET (stix, stix->sp, obj);
+	STACK_SETTOP (stix, obj);
 	return 1; /* success */
 }
 
-int primitive_new_with_size (stix_t* stix, stix_ooi_t nargs)
+static int primitive_new_with_size (stix_t* stix, stix_ooi_t nargs)
 {
 	stix_oop_t rcv, szoop, obj;
 	stix_oow_t size;
@@ -380,12 +379,168 @@ int primitive_new_with_size (stix_t* stix, stix_ooi_t nargs)
 	/* remove the argument and replace the receiver with a new object
 	 * instantiated */
 	STACK_POP (stix);
-	STACK_SET (stix, stix->sp, obj);
+	STACK_SETTOP (stix, obj);
 
 	return 1; /* success */
 }
 
-int primitive_block_context_value (stix_t* stix, stix_ooi_t nargs)
+static int primitive_basic_size (stix_t* stix, stix_ooi_t nargs)
+{
+	stix_oop_t rcv;
+	STIX_ASSERT (nargs == 0);
+
+
+	rcv = STACK_GETTOP(stix);
+	STACK_SETTOP(stix, STIX_OOP_FROM_SMINT(STIX_OBJ_GET_SIZE(rcv)));
+/* TODO: use LargeInteger if the size is very big */
+	return 1;
+}
+
+static int primitive_basic_at (stix_t* stix, stix_ooi_t nargs)
+{
+	stix_oop_t rcv, pos, v;
+	stix_ooi_t idx;
+
+	STIX_ASSERT (nargs == 1);
+
+	rcv = STACK_GET(stix, stix->sp - 1);
+	if (!STIX_OOP_IS_POINTER(rcv))
+	{
+		/* the receiver is a special numeric object, not a normal pointer */
+		return 0;
+	}
+
+	pos = STACK_GET(stix, stix->sp);
+	if (!STIX_OOP_IS_SMINT(pos))
+	{
+/* TODO: handle LargeInteger */
+		/* the position must be an integer */
+		return 0;
+	}
+
+	idx = STIX_OOP_TO_SMINT(pos);
+	if (idx < 1 || idx > STIX_OBJ_GET_SIZE(rcv))
+	{
+		/* index out of range */
+		return 0;
+	}
+
+	/* [NOTE] basicAt: and basicAt:put: used a 1-based index. */
+	idx = idx - 1;
+
+	switch (STIX_OBJ_GET_FLAGS_TYPE(rcv))
+	{
+		case STIX_OBJ_TYPE_BYTE:
+			v = STIX_OOP_FROM_SMINT(((stix_oop_byte_t)rcv)->slot[idx]);
+			break;
+
+		case STIX_OBJ_TYPE_CHAR:
+			v = STIX_OOP_FROM_CHAR(((stix_oop_char_t)rcv)->slot[idx]);
+			break;
+
+		case STIX_OBJ_TYPE_WORD:
+			/* TODO: largeINteger if the word is too large */
+			v = STIX_OOP_FROM_SMINT(((stix_oop_word_t)rcv)->slot[idx]);
+			break;
+
+		case STIX_OBJ_TYPE_OOP:
+			v = ((stix_oop_oop_t)rcv)->slot[idx];
+			break;
+
+		default:
+			stix->errnum = STIX_EINTERN;
+			return -1;
+	}
+
+	STACK_POP (stix);
+	STACK_SETTOP (stix, v);
+	return 1;
+}
+
+static int primitive_basic_at_put (stix_t* stix, stix_ooi_t nargs)
+{
+	stix_oop_t rcv, pos, val;
+	stix_ooi_t idx;
+
+	STIX_ASSERT (nargs == 2);
+
+/* TODO: disallow change of some key kernel objects */
+ 
+	rcv = STACK_GET(stix, stix->sp - 2);
+	if (!STIX_OOP_IS_POINTER(rcv))
+	{
+		/* the receiver is a special numeric object, not a normal pointer */
+		return 0;
+	}
+
+	pos = STACK_GET(stix, stix->sp - 1);
+	if (!STIX_OOP_IS_SMINT(pos))
+	{
+/* TODO: handle LargeInteger */
+		/* the position must be an integer */
+		return 0;
+	}
+
+	val = STACK_GET(stix, stix->sp);
+
+	idx = STIX_OOP_TO_SMINT(pos);
+	if (idx < 1 || idx > STIX_OBJ_GET_SIZE(rcv))
+	{
+		/* index out of range */
+		return 0;
+	}
+
+	/* [NOTE] basicAt: and basicAt:put: used a 1-based index. */
+	idx = idx - 1;
+
+	switch (STIX_OBJ_GET_FLAGS_TYPE(rcv))
+	{
+		case STIX_OBJ_TYPE_BYTE:
+			if (!STIX_OOP_IS_SMINT(val))
+			{
+				/* the value is not a character */
+				return 0;
+			}
+/* TOOD: must I check the range of the value? */
+			((stix_oop_char_t)rcv)->slot[idx] = STIX_OOP_TO_SMINT(val);
+			break;
+		
+
+		case STIX_OBJ_TYPE_CHAR:
+			if (!STIX_OOP_IS_CHAR(val))
+			{
+				/* the value is not a character */
+				return 0;
+			}
+			((stix_oop_char_t)rcv)->slot[idx] = STIX_OOP_TO_CHAR(val);
+			break;
+
+		case STIX_OBJ_TYPE_WORD:
+			/* TODO: handle largeINteger  */
+			if (!STIX_OOP_IS_SMINT(val))
+			{
+				/* the value is not a character */
+				return 0;
+			}
+			((stix_oop_char_t)rcv)->slot[idx] = STIX_OOP_TO_SMINT(val);
+			break;
+
+		case STIX_OBJ_TYPE_OOP:
+			((stix_oop_oop_t)rcv)->slot[idx] = val;
+			break;
+
+		default:
+			stix->errnum = STIX_EINTERN;
+			return -1;
+	}
+
+	STACK_POPS (stix, 2);
+/* TODO: return receiver or value? */
+	STACK_SETTOP (stix, val);
+	return 1;
+}
+
+static int primitive_block_context_value (stix_t* stix, stix_ooi_t nargs)
 {
 	stix_oop_block_context_t blkctx;
 
@@ -409,7 +564,7 @@ printf ("PRIM BlockContext value FAIL - NARGS MISMATCH\n");
 	return 1;
 }
 
-int primitive_integer_add (stix_t* stix, stix_ooi_t nargs)
+static int primitive_integer_add (stix_t* stix, stix_ooi_t nargs)
 {
 	stix_ooi_t tmp;
 	stix_oop_t rcv, arg;
@@ -448,6 +603,9 @@ static primitive_t primitives[] =
 	{  -1,   primitive_dump                 },
 	{   0,   primitive_new                  },
 	{   1,   primitive_new_with_size        },
+	{   0,   primitive_basic_size           },
+	{   1,   primitive_basic_at             },
+	{   2,   primitive_basic_at_put         },
 	{  -1,   primitive_block_context_value  },
 	{   1,   primitive_integer_add          },
 };
@@ -510,12 +668,18 @@ printf ("PUSH_INSTVAR %d\n", (int)b1);
 				break;
 
 			case CMD_PUSH_TEMPVAR:
-printf ("PUSH_TEMPVAR %d\n", (int)b1);
+/* TODO: consider temp offset, block context, etc */
-				STACK_PUSH (stix, stix->active_context->slot[b1]);
+
+printf ("PUSH_TEMPVAR idx=%d - ", (int)b1);
+print_object (stix, STACK_GET(stix, b1));
+printf ("\n");
+				STACK_PUSH (stix, STACK_GET(stix, b1));
 				break;
 
 			case CMD_PUSH_LITERAL:
-printf ("PUSH_LITERAL %d\n", (int)b1);
+printf ("PUSH_LITERAL idx=%d - ", (int)b1);
+print_object (stix, mth->slot[b1]);
+printf ("\n");
 				STACK_PUSH (stix, mth->slot[b1]);
 				break;
 
@@ -599,12 +763,14 @@ printf ("STORE OBJVAR %d %d\n", (int)b1, (int)obj_index);
 				selector = (stix_oop_char_t)mth->slot[selector_index];
 
 if (cmd == CMD_SEND_MESSAGE)
-printf ("SEND_MESSAGE TO RECEIVER AT %d\n", (int)(stix->sp - b1));
+printf ("SEND_MESSAGE TO RECEIVER AT %d NARGS=%d\n", (int)(stix->sp - b1), (int)b1);
 else
-printf ("SEND_MESSAGE_TO_SUPER TO RECEIVER AT %d\n", (int)(stix->sp - b1));
+printf ("SEND_MESSAGE_TO_SUPER TO RECEIVER AT %d NARGS=%d\n", (int)(stix->sp - b1), (int)b1);
 				STIX_ASSERT (STIX_CLASSOF(stix, selector) == stix->_symbol);
 
-				newrcv = STACK_GET (stix, stix->sp - b1);
+				newrcv = STACK_GET(stix, stix->sp - b1);
+print_object(stix, newrcv);
+printf ("\n");
 				mthname.ptr = selector->slot;
 				mthname.len = STIX_OBJ_GET_SIZE(selector);
 				newmth = find_method (stix, newrcv, &mthname, (cmd == CMD_SEND_MESSAGE_TO_SUPER));

stix/lib/stix-prv.h

@@ -794,6 +794,7 @@ void stix_getsynerr (
 void dump_symbol_table (stix_t* stix);
 void dump_dictionary (stix_t* stix, stix_oop_set_t dic, const char* title);
 void print_ucs (const stix_ucs_t* name);
+void print_object (stix_t* stix, stix_oop_t oop);
 void dump_object (stix_t* stix, stix_oop_t oop, const char* title);
 
 #if defined(__cplusplus)