interim commit while attempting to primitive calls
This commit is contained in:
parent
bb45bdc480
commit
dab3423f12
@ -96,7 +96,7 @@
|
|||||||
{
|
{
|
||||||
| v1 v2 |
|
| v1 v2 |
|
||||||
|
|
||||||
" v2 := 'have fun'.
|
v2 := 'have fun'.
|
||||||
|
|
||||||
v2 at: 0 put: $H.
|
v2 at: 0 put: $H.
|
||||||
|
|
||||||
@ -109,7 +109,7 @@
|
|||||||
v1 write: S'하하하하하하하하 좋아좋아 可愛くってしょうがない(^o^) ほのかちゃん、しおりちゃん元気そうだね! 久しぶりに見た。しおりちゃんどうしたのかな?좋아 하라하하\n'.
|
v1 write: S'하하하하하하하하 좋아좋아 可愛くってしょうがない(^o^) ほのかちゃん、しおりちゃん元気そうだね! 久しぶりに見た。しおりちゃんどうしたのかな?좋아 하라하하\n'.
|
||||||
v1 close.
|
v1 close.
|
||||||
|
|
||||||
self main2."
|
self main2.
|
||||||
|
|
||||||
System logNl: (9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
|
System logNl: (9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
|
||||||
* 8888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) asString.
|
* 8888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) asString.
|
||||||
|
@ -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_ooi_t prim_name_index;
|
||||||
stix_oop_t name;
|
stix_oop_t name;
|
||||||
stix_prim_impl_t handler;
|
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);
|
prim_name_index = STIX_METHOD_GET_PREAMBLE_INDEX(preamble);
|
||||||
LOG_INST_1 (stix, "preamble_named_primitive %zd", prim_name_index);
|
LOG_INST_1 (stix, "preamble_named_primitive %zd", prim_name_index);
|
||||||
|
|
||||||
|
/* 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]);
|
||||||
|
handler = (stix_prim_impl_t)w;
|
||||||
|
if (handler) goto exec_handler;
|
||||||
|
else
|
||||||
|
{
|
||||||
|
STIX_ASSERT (prim_name_index >= 0);
|
||||||
name = method->slot[prim_name_index];
|
name = method->slot[prim_name_index];
|
||||||
|
|
||||||
STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR));
|
STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR));
|
||||||
STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name));
|
STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name));
|
||||||
STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol);
|
STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol);
|
||||||
|
|
||||||
/* merge two SmallIntegers to get a full pointer */
|
handler = query_prim_module (stix, ((stix_oop_char_t)name)->slot, STIX_OBJ_GET_SIZE(name));
|
||||||
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]);
|
|
||||||
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)
|
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[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));
|
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);
|
stix_pushtmp (stix, (stix_oop_t*)&method);
|
||||||
n = handler (stix, nargs);
|
n = handler (stix, nargs);
|
||||||
|
|
||||||
stix_poptmp (stix);
|
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*/
|
if (n >= 1) break; /* primitive ok*/
|
||||||
}
|
}
|
||||||
|
|
||||||
/* soft primitive failure or handler not found*/
|
/* soft primitive failure or handler not found.
|
||||||
|
* 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;
|
if (activate_new_method (stix, method) <= -1) return -1;
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -221,6 +221,34 @@ static int prim_setcursor (stix_t* stix, stix_ooi_t nargs)
|
|||||||
return 1;
|
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;
|
typedef struct fnctab_t fnctab_t;
|
||||||
|
@ -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 stix_makersrc (stix_t* stix, stix_oow_t v)
|
||||||
{
|
{
|
||||||
stix_oop_t imm;
|
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));
|
STIX_ASSERT (STIX_OOP_IS_RSRC(imm));
|
||||||
return stix->rsrc.ptr[STIX_OOP_TO_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;
|
||||||
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user