Added stix_shallowcopy().

added some code for bigint operations
This commit is contained in:
hyunghwan.chung
2015-10-30 15:36:37 +00:00
parent 1094d298cb
commit d33ad3749a
9 changed files with 463 additions and 90 deletions

View File

@ -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" },