Added stix_shallowcopy().
added some code for bigint operations
This commit is contained in:
@ -620,6 +620,22 @@ static int prim_basic_new_with_size (stix_t* stix, stix_ooi_t nargs)
|
||||
return 1; /* success */
|
||||
}
|
||||
|
||||
static int prim_shallow_copy (stix_t* stix, stix_ooi_t nargs)
|
||||
{
|
||||
stix_oop_t rcv, obj;
|
||||
|
||||
STIX_ASSERT (nargs == 0);
|
||||
|
||||
rcv = ACTIVE_STACK_GETTOP (stix);
|
||||
|
||||
obj = stix_shallowcopy (stix, rcv);
|
||||
if (!obj) return -1;
|
||||
|
||||
/* emulate 'pop receiver' and 'push result' */
|
||||
ACTIVE_STACK_SETTOP (stix, obj);
|
||||
return 1; /* success */
|
||||
}
|
||||
|
||||
static int prim_basic_size (stix_t* stix, stix_ooi_t nargs)
|
||||
{
|
||||
stix_oop_t rcv;
|
||||
@ -704,8 +720,6 @@ static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs)
|
||||
|
||||
STIX_ASSERT (nargs == 2);
|
||||
|
||||
/* TODO: disallow change of some key kernel objects */
|
||||
|
||||
rcv = ACTIVE_STACK_GET(stix, stix->sp - 2);
|
||||
if (!STIX_OOP_IS_POINTER(rcv))
|
||||
{
|
||||
@ -730,6 +744,14 @@ static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs)
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (STIX_OBJ_GET_CLASS(rcv) == stix->_symbol)
|
||||
{
|
||||
/* TODO: disallow change of some key kernel objects???? */
|
||||
/* TODO: is it better to introduct a read-only mark in the object header instead of this class check??? */
|
||||
/* read-only object */ /* TODO: DEVISE A WAY TO PASS a proper error from the primitive handler to STIX */
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* [NOTE] basicAt: and basicAt:put: used a 1-based index. */
|
||||
idx = idx - 1;
|
||||
|
||||
@ -987,16 +1009,18 @@ printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
|
||||
|
||||
static int prim_integer_add (stix_t* stix, stix_ooi_t nargs)
|
||||
{
|
||||
stix_ooi_t tmp;
|
||||
stix_oop_t rcv, arg;
|
||||
stix_oop_t rcv, arg, res;
|
||||
|
||||
STIX_ASSERT (nargs == 1);
|
||||
|
||||
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
|
||||
arg = ACTIVE_STACK_GET(stix, stix->sp);
|
||||
|
||||
#if 0
|
||||
if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg))
|
||||
{
|
||||
stix_ooi_t tmp;
|
||||
|
||||
tmp = STIX_OOP_TO_SMINT(rcv) + STIX_OOP_TO_SMINT(arg);
|
||||
/* TODO: check overflow. if so convert it to LargeInteger */
|
||||
|
||||
@ -1007,20 +1031,31 @@ static int prim_integer_add (stix_t* stix, stix_ooi_t nargs)
|
||||
|
||||
/* TODO: handle LargeInteger */
|
||||
return 0;
|
||||
|
||||
#else
|
||||
res = stix_addints (stix, rcv, arg);
|
||||
if (!res) return -1; /* hard failure */
|
||||
|
||||
ACTIVE_STACK_POP (stix);
|
||||
ACTIVE_STACK_SETTOP (stix, res);
|
||||
return 1;
|
||||
#endif
|
||||
|
||||
}
|
||||
|
||||
static int prim_integer_sub (stix_t* stix, stix_ooi_t nargs)
|
||||
{
|
||||
stix_ooi_t tmp;
|
||||
stix_oop_t rcv, arg;
|
||||
stix_oop_t rcv, arg, res;
|
||||
|
||||
STIX_ASSERT (nargs == 1);
|
||||
|
||||
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
|
||||
arg = ACTIVE_STACK_GET(stix, stix->sp);
|
||||
|
||||
#if 0
|
||||
if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg))
|
||||
{
|
||||
stix_ooi_t tmp;
|
||||
tmp = STIX_OOP_TO_SMINT(rcv) - STIX_OOP_TO_SMINT(arg);
|
||||
/* TODO: check overflow. if so convert it to LargeInteger */
|
||||
|
||||
@ -1031,6 +1066,14 @@ static int prim_integer_sub (stix_t* stix, stix_ooi_t nargs)
|
||||
|
||||
/* TODO: handle LargeInteger */
|
||||
return 0;
|
||||
#else
|
||||
res = stix_subints (stix, rcv, arg);
|
||||
if (!res) return -1; /* hard failure */
|
||||
|
||||
ACTIVE_STACK_POP (stix);
|
||||
ACTIVE_STACK_SETTOP (stix, res);
|
||||
return 1;
|
||||
#endif
|
||||
}
|
||||
|
||||
static int prim_integer_mul (stix_t* stix, stix_ooi_t nargs)
|
||||
@ -1547,11 +1590,13 @@ static prim_t primitives[] =
|
||||
|
||||
{ 0, prim_basic_new, "_basic_new" },
|
||||
{ 1, prim_basic_new_with_size, "_basic_new_with_size" },
|
||||
{ 0, prim_basic_size, "_basic_size" },
|
||||
{ 0, prim_shallow_copy, "_shallow_copy" },
|
||||
|
||||
{ 0, prim_basic_size, "_basic_size" },
|
||||
{ 1, prim_basic_at, "_basic_at" },
|
||||
{ 2, prim_basic_at_put, "_basic_at_put" },
|
||||
|
||||
|
||||
{ -1, prim_block_value, "_block_value" },
|
||||
{ -1, prim_block_new_process, "_block_new_process" },
|
||||
|
||||
|
Reference in New Issue
Block a user