diff --git a/stix/lib/comp.c b/stix/lib/comp.c index 8d8973b..51c4944 100644 --- a/stix/lib/comp.c +++ b/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 diff --git a/stix/lib/debug.c b/stix/lib/debug.c index 7256674..9d5415d 100644 --- a/stix/lib/debug.c +++ b/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; diff --git a/stix/lib/exec.c b/stix/lib/exec.c index 69696cf..7ea2672 100644 --- a/stix/lib/exec.c +++ b/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); - STACK_PUSH (stix, stix->active_context->slot[b1]); +/* TODO: consider temp offset, block context, etc */ + +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)); diff --git a/stix/lib/stix-prv.h b/stix/lib/stix-prv.h index ace3168..de75eaa 100644 --- a/stix/lib/stix-prv.h +++ b/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)