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

@ -66,6 +66,14 @@
^self. ^self.
} }
## -------------------------------------------------------
## -------------------------------------------------------
#method shallowCopy
{
<primitive: #_shallow_copy>
self primitiveFailed.
}
## ------------------------------------------------------- ## -------------------------------------------------------
## ------------------------------------------------------- ## -------------------------------------------------------
@ -107,7 +115,6 @@
self error: 'out of range'. self error: 'out of range'.
} }
#method(#class) basicAt: anInteger #method(#class) basicAt: anInteger
{ {
<primitive: #_basic_at> <primitive: #_basic_at>
@ -177,6 +184,7 @@
^true. ^true.
} }
## ------------------------------------------------------- ## -------------------------------------------------------
## ------------------------------------------------------- ## -------------------------------------------------------
" "

View File

@ -241,6 +241,9 @@
ffi close. ffi close.
" "
"
PROCESS TESTING
| p | | p |
'000000000000000000' dump. '000000000000000000' dump.
## p := [ | 'xxxxxxxxxxx' dump. 'yyyyyyyyyy' dump. ^10. ] newProcess. ## p := [ | 'xxxxxxxxxxx' dump. 'yyyyyyyyyy' dump. ^10. ] newProcess.
@ -252,7 +255,8 @@
'222222222222222222' dump. '222222222222222222' dump.
'333333333333333333' dump. '333333333333333333' dump.
'444444444444444444' dump. '444444444444444444' dump.
"
(-2305843009213693952 - 1) dump.
" "
FFI isNil dump. FFI isNil dump.
FFI notNil dump. FFI notNil dump.
@ -261,6 +265,7 @@
nil class dump. nil class dump.
nil class class class dump. nil class class class dump.
" "
} }
} }

View File

@ -1,13 +1,144 @@
/*
* $Id$
*
Copyright (c) 2014-2015 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WAfRRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "stix-prv.h" #include "stix-prv.h"
/*static normalize_integer (*/ #define MAKE_WORD(hw1,hw2) ((stix_oow_t)(hw1) | (stix_oow_t)(hw2) << STIX_OOHW_BITS)
static stix_oop_t normalize (stix_t* stix, stix_oop_t z) static STIX_INLINE int is_integer (stix_t* stix, stix_oop_t oop)
{ {
stix_oop_t c;
c = STIX_CLASSOF(stix,oop);
/* TODO: is it better to introduct a special integer mark into the class itself */
return c == stix->_small_integer ||
c == stix->_large_positive_integer ||
c == stix->_large_negative_integer;
}
static STIX_INLINE stix_oop_t make_bigint_with_ooi (stix_t* stix, stix_ooi_t i)
{
stix_oohw_t hw[2];
stix_oow_t w;
if (i >= 0)
{
w = i;
hw[0] = w & STIX_LBMASK(stix_oow_t,STIX_OOHW_BITS);
hw[1] = w >> STIX_OOHW_BITS;
return stix_instantiate (stix, stix->_large_positive_integer, &hw, (hw[1] > 0? 2: 1));
}
else
{
w = -i;
hw[0] = w & STIX_LBMASK(stix_oow_t,STIX_OOHW_BITS);
hw[1] = w >> STIX_OOHW_BITS;
return stix_instantiate (stix, stix->_large_negative_integer, &hw, (hw[1] > 0? 2: 1));
}
}
static STIX_INLINE stix_oow_t count_effective_digits (stix_oop_t oop)
{
stix_oow_t i;
for (i = STIX_OBJ_GET_SIZE(oop); i > 1; )
{
--i;
if (((stix_oop_halfword_t)oop)->slot[i] != 0) return i + 1;
}
return 1;
}
static STIX_INLINE stix_oop_t clone_bigint (stix_t* stix, stix_oop_t oop, stix_oow_t count)
{
stix_oop_t z;
stix_oow_t i;
STIX_ASSERT (STIX_OOP_IS_POINTER(oop));
if (count <= 0) count = STIX_OBJ_GET_SIZE(oop);
stix_pushtmp (stix, &oop);
z = stix_instantiate (stix, STIX_OBJ_GET_CLASS(oop), STIX_NULL, count);
stix_poptmp (stix);
if (!z) return STIX_NULL;
for (i = 0; i < count; i++)
{
((stix_oop_halfword_t)z)->slot[i] = ((stix_oop_halfword_t)oop)->slot[i];
}
return z; return z;
} }
static stix_oop_t normalize_bigint (stix_t* stix, stix_oop_t oop)
{
stix_oow_t count;
STIX_ASSERT (STIX_OOP_IS_POINTER(oop));
count = count_effective_digits (oop);
if (count == 1)
{
if (STIX_OBJ_GET_CLASS(oop) == stix->_large_positive_integer)
{
return STIX_OOP_FROM_SMINT(((stix_oop_halfword_t)oop)->slot[0]);
}
else
{
STIX_ASSERT (STIX_OBJ_GET_CLASS(oop) == stix->_large_negative_integer);
return STIX_OOP_FROM_SMINT(-(stix_oow_t)((stix_oop_halfword_t)oop)->slot[0]);
}
}
else if (count == 2)
{
stix_oow_t w;
w = MAKE_WORD (((stix_oop_halfword_t)oop)->slot[0], ((stix_oop_halfword_t)oop)->slot[1]);
if (STIX_OBJ_GET_CLASS(oop) == stix->_large_positive_integer)
{
if (w <= STIX_SMINT_MAX) return STIX_OOP_FROM_SMINT(w);
}
else
{
STIX_ASSERT (STIX_OBJ_GET_CLASS(oop) == stix->_large_negative_integer);
/*if (w <= -STIX_SMINT_MIN) */
if (w <= ((stix_oow_t)STIX_SMINT_MAX + 1)) return STIX_OOP_FROM_SMINT(-(stix_ooi_t)w);
}
}
if (STIX_OBJ_GET_SIZE(oop) == count)
{
/* no compaction is needed. return it as it is */
return oop;
}
return clone_bigint (stix, oop, count);
}
static STIX_INLINE int is_less_unsigned_array (const stix_oohw_t* x, stix_oow_t xs, const stix_oohw_t* y, stix_oow_t ys) static STIX_INLINE int is_less_unsigned_array (const stix_oohw_t* x, stix_oow_t xs, const stix_oohw_t* y, stix_oow_t ys)
{ {
stix_oow_t i; stix_oow_t i;
@ -72,7 +203,6 @@ static STIX_INLINE stix_oow_t add_unsigned_array (const stix_oohw_t* x, stix_oow
return i; return i;
} }
static STIX_INLINE stix_oow_t subtract_unsigned_array (const stix_oohw_t* x, stix_oow_t xs, const stix_oohw_t* y, stix_oow_t ys, stix_oohw_t* z) static STIX_INLINE stix_oow_t subtract_unsigned_array (const stix_oohw_t* x, stix_oow_t xs, const stix_oohw_t* y, stix_oow_t ys, stix_oohw_t* z)
{ {
stix_oow_t i, w; stix_oow_t i, w;
@ -118,7 +248,7 @@ static STIX_INLINE stix_oow_t subtract_unsigned_array (const stix_oohw_t* x, sti
static stix_oop_t add_unsigned_integers (stix_t* stix, stix_oop_t x, stix_oop_t y) static stix_oop_t add_unsigned_integers (stix_t* stix, stix_oop_t x, stix_oop_t y)
{ {
stix_oohw_t* a, * b; stix_oohw_t* a, * b;
stix_oow_t as, bs, zs, ks; stix_oow_t as, bs, zs;
stix_oop_t z; stix_oop_t z;
as = STIX_OBJ_GET_SIZE(x); as = STIX_OBJ_GET_SIZE(x);
@ -141,12 +271,7 @@ static stix_oop_t add_unsigned_integers (stix_t* stix, stix_oop_t x, stix_oop_t
b = ((stix_oop_halfword_t)x)->slot; b = ((stix_oop_halfword_t)x)->slot;
} }
ks = add_unsigned_array (a, as, b, bs, ((stix_oop_halfword_t)z)->slot); add_unsigned_array (a, as, b, bs, ((stix_oop_halfword_t)z)->slot);
if (ks <= zs)
{
/*normalize;*/
}
return z; return z;
} }
@ -154,6 +279,8 @@ static stix_oop_t subtract_unsigned_integers (stix_t* stix, stix_oop_t x, stix_o
{ {
stix_oop_t z; stix_oop_t z;
STIX_ASSERT (!is_less(stix, x, y));
stix_pushtmp (stix, &x); stix_pushtmp (stix, &x);
stix_pushtmp (stix, &y); stix_pushtmp (stix, &y);
z = stix_instantiate (stix, stix->_large_positive_integer, STIX_NULL, STIX_OBJ_GET_SIZE(x)); z = stix_instantiate (stix, stix->_large_positive_integer, STIX_NULL, STIX_OBJ_GET_SIZE(x));
@ -166,48 +293,175 @@ static stix_oop_t subtract_unsigned_integers (stix_t* stix, stix_oop_t x, stix_o
return z; return z;
} }
stix_oop_t stix_addints (stix_t* stix, stix_oop_t x, stix_oop_t y)
stix_oop_t stix_addbigints (stix_t* stix, stix_oop_t x, stix_oop_t y)
{ {
stix_oop_t z; stix_oop_t z;
if (STIX_OOP_IS_SMINT(x) && STIX_OOP_IS_SMINT(y))
{
stix_ooi_t i;
/* no integer overflow/underflow must occur as the possible integer
* range is narrowed by the tag bits used */
i = STIX_OOP_TO_SMINT(x) + STIX_OOP_TO_SMINT(y);
if (STIX_OOI_IN_SMINT_RANGE(i)) return STIX_OOP_FROM_SMINT(i);
return make_bigint_with_ooi (stix, i);
}
else
{
stix_ooi_t v;
int neg;
if (STIX_OOP_IS_SMINT(x))
{
if (!is_integer(stix,y)) goto oops_einval;
v = STIX_OOP_TO_SMINT(x);
if (v == 0) return y;
stix_pushtmp (stix, &y);
x = make_bigint_with_ooi (stix, v);
stix_poptmp (stix);
if (!x) return STIX_NULL;
}
else if (STIX_OOP_IS_SMINT(y))
{
if (!is_integer(stix,x)) goto oops_einval;
v = STIX_OOP_TO_SMINT(y);
if (v == 0) return x;
stix_pushtmp (stix, &x);
y = make_bigint_with_ooi (stix, v);
stix_poptmp (stix);
if (!y) return STIX_NULL;
}
else
{
if (!is_integer(stix,x)) goto oops_einval;
if (!is_integer(stix,y)) goto oops_einval;
}
if (STIX_OBJ_GET_CLASS(x) != STIX_OBJ_GET_CLASS(y)) if (STIX_OBJ_GET_CLASS(x) != STIX_OBJ_GET_CLASS(y))
{ {
if (STIX_OBJ_GET_CLASS(x) == stix->_large_negative_integer) if (STIX_OBJ_GET_CLASS(x) == stix->_large_negative_integer)
z = stix_subbigints (stix, y, x); {
else /* x is negative, y is positive */
z = stix_subbigints (stix, x, y); z = stix_subints (stix, y, x);
} }
else else
{ {
/* x is positive, y is negative */
z = stix_subints (stix, x, y);
}
if (!z) return STIX_NULL;
}
else
{
/* both are positive or negative */
neg = (STIX_OBJ_GET_CLASS(x) == stix->_large_negative_integer);
z = add_unsigned_integers (stix, x, y); z = add_unsigned_integers (stix, x, y);
if (!z) return STIX_NULL;
if (neg) STIX_OBJ_SET_CLASS(z, stix->_large_negative_integer);
}
} }
return normalize(stix, z); return normalize_bigint (stix, z);
oops_einval:
stix->errnum = STIX_EINVAL;
return STIX_NULL;
} }
#if 0 stix_oop_t stix_subints (stix_t* stix, stix_oop_t x, stix_oop_t y)
stix_subbigints (stix_t* stix, stix_oop_t x, stix_oop_t y)
{ {
/* TOOD: ensure both are LargeIntgers */ stix_oop_t z;
if (STIX_OOP_IS_SMINT(x) && STIX_OOP_IS_SMINT(y))
{
stix_ooi_t i;
/* no integer overflow/underflow must occur as the possible integer
* range is narrowed by the tag bits used */
i = STIX_OOP_TO_SMINT(x) - STIX_OOP_TO_SMINT(y);
if (STIX_OOI_IN_SMINT_RANGE(i)) return STIX_OOP_FROM_SMINT(i);
return make_bigint_with_ooi (stix, i);
}
else
{
stix_ooi_t v;
int neg;
if (STIX_OOP_IS_SMINT(x))
{
if (!is_integer(stix,y)) goto oops_einval;
v = STIX_OOP_TO_SMINT(x);
if (v == 0)
{
/* switch the sign to the opposite and return it */
neg = (STIX_OBJ_GET_CLASS(y) == stix->_large_negative_integer);
z = clone_bigint (stix, y, 0);
if (!neg) STIX_OBJ_SET_CLASS(z, stix->_large_negative_integer);
return z;
}
stix_pushtmp (stix, &y);
x = make_bigint_with_ooi (stix, v);
if (!x) return STIX_NULL;
stix_poptmp (stix);
}
else if (STIX_OOP_IS_SMINT(y))
{
if (!is_integer(stix,x)) goto oops_einval;
v = STIX_OOP_TO_SMINT(y);
if (v == 0) return x;
stix_pushtmp (stix, &x);
y = make_bigint_with_ooi (stix, v);
if (!y) return STIX_NULL;
stix_poptmp (stix);
}
else
{
if (!is_integer(stix,x)) goto oops_einval;
if (!is_integer(stix,y)) goto oops_einval;
}
if (STIX_OBJ_GET_CLASS(x) != STIX_OBJ_GET_CLASS(y)) if (STIX_OBJ_GET_CLASS(x) != STIX_OBJ_GET_CLASS(y))
{ {
z = add_unsigned (stix, x, y); neg = (STIX_OBJ_GET_CLASS(x) == stix->_large_negative_integer);
z = add_unsigned_integers (stix, x, y);
if (!z) return STIX_NULL;
if (neg) STIX_OBJ_SET_CLASS(z, stix->_large_negative_integer);
} }
else else
{ {
/* both are positive or negative */
if (is_less_unsigned (x, y)) if (is_less_unsigned (x, y))
{ {
z = subtract_unsigned (stix, y, x); /* get the opposite sign of x; */ neg = (STIX_OBJ_GET_CLASS(x) == stix->_large_negative_integer);
z = subtract_unsigned_integers (stix, y, x);
if (!z) return STIX_NULL;
if (!neg) STIX_OBJ_SET_CLASS(z, stix->_large_negative_integer);
} }
else else
{ {
neg = (STIX_OBJ_GET_CLASS(x) == stix->_large_negative_integer);
z = subtract_unsigned (stix, x, y); /* take x's sign */ z = subtract_unsigned_integers (stix, x, y); /* take x's sign */
if (!z) return STIX_NULL;
if (neg) STIX_OBJ_SET_CLASS(z, stix->_large_negative_integer);
}
} }
} }
return normalize (stix, z); return normalize_bigint (stix, z);
oops_einval:
stix->errnum = STIX_EINVAL;
return STIX_NULL;
} }
#endif

View File

@ -620,6 +620,22 @@ static int prim_basic_new_with_size (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */ 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) static int prim_basic_size (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; 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); STIX_ASSERT (nargs == 2);
/* TODO: disallow change of some key kernel objects */
rcv = ACTIVE_STACK_GET(stix, stix->sp - 2); rcv = ACTIVE_STACK_GET(stix, stix->sp - 2);
if (!STIX_OOP_IS_POINTER(rcv)) 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; 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. */ /* [NOTE] basicAt: and basicAt:put: used a 1-based index. */
idx = idx - 1; 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) static int prim_integer_add (stix_t* stix, stix_ooi_t nargs)
{ {
stix_ooi_t tmp; stix_oop_t rcv, arg, res;
stix_oop_t rcv, arg;
STIX_ASSERT (nargs == 1); STIX_ASSERT (nargs == 1);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
arg = ACTIVE_STACK_GET(stix, stix->sp); arg = ACTIVE_STACK_GET(stix, stix->sp);
#if 0
if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg)) 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); tmp = STIX_OOP_TO_SMINT(rcv) + STIX_OOP_TO_SMINT(arg);
/* TODO: check overflow. if so convert it to LargeInteger */ /* 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 */ /* TODO: handle LargeInteger */
return 0; 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) static int prim_integer_sub (stix_t* stix, stix_ooi_t nargs)
{ {
stix_ooi_t tmp; stix_oop_t rcv, arg, res;
stix_oop_t rcv, arg;
STIX_ASSERT (nargs == 1); STIX_ASSERT (nargs == 1);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
arg = ACTIVE_STACK_GET(stix, stix->sp); arg = ACTIVE_STACK_GET(stix, stix->sp);
#if 0
if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg)) 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); tmp = STIX_OOP_TO_SMINT(rcv) - STIX_OOP_TO_SMINT(arg);
/* TODO: check overflow. if so convert it to LargeInteger */ /* 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 */ /* TODO: handle LargeInteger */
return 0; 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) 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" }, { 0, prim_basic_new, "_basic_new" },
{ 1, prim_basic_new_with_size, "_basic_new_with_size" }, { 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" }, { 1, prim_basic_at, "_basic_at" },
{ 2, prim_basic_at_put, "_basic_at_put" }, { 2, prim_basic_at_put, "_basic_at_put" },
{ -1, prim_block_value, "_block_value" }, { -1, prim_block_value, "_block_value" },
{ -1, prim_block_new_process, "_block_new_process" }, { -1, prim_block_new_process, "_block_new_process" },

View File

@ -83,26 +83,10 @@ static void compact_symbol_table (stix_t* stix, stix_oop_t _nil)
stix->symtab->tally = STIX_OOP_FROM_SMINT(tally); stix->symtab->tally = STIX_OOP_FROM_SMINT(tally);
} }
stix_oop_t stix_moveoop (stix_t* stix, stix_oop_t oop)
static STIX_INLINE stix_oow_t get_payload_bytes (stix_t* stix, stix_oop_t oop)
{ {
#if defined(STIX_SUPPORT_GC_DURING_IGNITION)
if (!oop) return oop;
#endif
if (!STIX_OOP_IS_POINTER(oop)) return oop;
if (STIX_OBJ_GET_FLAGS_MOVED(oop))
{
/* this object has migrated to the new heap.
* the class field has been updated to the new object
* in the 'else' block below. i can simply return it
* without further migration. */
return STIX_OBJ_GET_CLASS(oop);
}
else
{
stix_oow_t nbytes_aligned; stix_oow_t nbytes_aligned;
stix_oop_t tmp;
#if defined(STIX_USE_OBJECT_TRAILER) #if defined(STIX_USE_OBJECT_TRAILER)
if (STIX_OBJ_GET_FLAGS_TRAILER(oop)) if (STIX_OBJ_GET_FLAGS_TRAILER(oop))
@ -138,6 +122,32 @@ stix_oop_t stix_moveoop (stix_t* stix, stix_oop_t oop)
} }
#endif #endif
return nbytes_aligned;
}
stix_oop_t stix_moveoop (stix_t* stix, stix_oop_t oop)
{
#if defined(STIX_SUPPORT_GC_DURING_IGNITION)
if (!oop) return oop;
#endif
if (!STIX_OOP_IS_POINTER(oop)) return oop;
if (STIX_OBJ_GET_FLAGS_MOVED(oop))
{
/* this object has migrated to the new heap.
* the class field has been updated to the new object
* in the 'else' block below. i can simply return it
* without further migration. */
return STIX_OBJ_GET_CLASS(oop);
}
else
{
stix_oow_t nbytes_aligned;
stix_oop_t tmp;
nbytes_aligned = get_payload_bytes (stix, oop);
/* allocate space in the new heap */ /* allocate space in the new heap */
tmp = stix_allocheapmem (stix, stix->newheap, STIX_SIZEOF(stix_obj_t) + nbytes_aligned); tmp = stix_allocheapmem (stix, stix->newheap, STIX_SIZEOF(stix_obj_t) + nbytes_aligned);
@ -380,3 +390,41 @@ void stix_poptmps (stix_t* stix, stix_oow_t count)
STIX_ASSERT (stix->tmp_count >= count); STIX_ASSERT (stix->tmp_count >= count);
stix->tmp_count -= count; stix->tmp_count -= count;
} }
stix_oop_t stix_shallowcopy (stix_t* stix, stix_oop_t oop)
{
if (STIX_OOP_IS_POINTER(oop) && STIX_OBJ_GET_CLASS(oop) != stix->_symbol)
{
#if 0
stix_oop_t z;
stix_oop_class_t c;
c = (stix_oop_class_t)STIX_OBJ_GET_CLASS(oop);
stix_pushtmp (stix, &oop);
z = stix_instantiate (stix, (stix_oop_t)c, STIX_NULL, STIX_OBJ_GET_SIZE(oop) - STIX_CLASS_SPEC_NAMED_INSTVAR(STIX_OOP_TO_SMINT(c->spec)));
stix_poptmp(stix);
if (!z) return z;
/* copy the payload */
STIX_MEMCPY (z + 1, oop + 1, get_payload_bytes(stix, oop));
return z;
#else
stix_oop_t z;
stix_oow_t total_bytes;
total_bytes = STIX_SIZEOF(stix_obj_t) + get_payload_bytes(stix, oop);
stix_pushtmp (stix, &oop);
z = stix_allocbytes (stix, total_bytes);
stix_poptmp(stix);
STIX_MEMCPY (z, oop, total_bytes);
return z;
#endif
}
return oop;
}

View File

@ -382,11 +382,12 @@ int main (int argc, char* argv[])
stix_vmprim_t vmprim; stix_vmprim_t vmprim;
int i; int i;
printf ("Stix 1.0.0 - max named %lu max indexed %lu max class %lu max classinst %lu\n", printf ("Stix 1.0.0 - max named %lu max indexed %lu max class %lu max classinst %lu smintmax %ld smintmax %ld\n",
(unsigned long int)STIX_MAX_NAMED_INSTVARS, (unsigned long int)STIX_MAX_NAMED_INSTVARS,
(unsigned long int)STIX_MAX_INDEXED_INSTVARS(STIX_MAX_NAMED_INSTVARS), (unsigned long int)STIX_MAX_INDEXED_INSTVARS(STIX_MAX_NAMED_INSTVARS),
(unsigned long int)STIX_MAX_CLASSVARS, (unsigned long int)STIX_MAX_CLASSVARS,
(unsigned long int)STIX_MAX_CLASSINSTVARS); (unsigned long int)STIX_MAX_CLASSINSTVARS,
(long)STIX_SMINT_MAX, (long)STIX_SMINT_MIN);
#if !defined(macintosh) #if !defined(macintosh)

View File

@ -109,7 +109,7 @@ stix_oop_t stix_allocoopobjwithtrailer (stix_t* stix, stix_oow_t size, const sti
} }
#endif #endif
static stix_oop_t alloc_numeric_array (stix_t* stix, const void* ptr, stix_oow_t len, stix_obj_type_t type, stix_oow_t unit, int extra) static STIX_INLINE stix_oop_t alloc_numeric_array (stix_t* stix, const void* ptr, stix_oow_t len, stix_obj_type_t type, stix_oow_t unit, int extra)
{ {
/* allocate a variable object */ /* allocate a variable object */
@ -155,19 +155,16 @@ stix_oop_t stix_alloccharobj (stix_t* stix, const stix_ooch_t* ptr, stix_oow_t l
return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_CHAR, STIX_SIZEOF(stix_ooch_t), 1); return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_CHAR, STIX_SIZEOF(stix_ooch_t), 1);
} }
/*
TODO: extra bits must be set ...
stix_oop_t stix_allocmbcharobj (stix_t* stix, const stix_ooch_t* ptr, stix_oow_t len)
{
return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_MBCHAR, STIX_SIZEOF(stix_ooch_t), 1);
}
*/
stix_oop_t stix_allocbyteobj (stix_t* stix, const stix_oob_t* ptr, stix_oow_t len) stix_oop_t stix_allocbyteobj (stix_t* stix, const stix_oob_t* ptr, stix_oow_t len)
{ {
return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_BYTE, STIX_SIZEOF(stix_oob_t), 0); return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_BYTE, STIX_SIZEOF(stix_oob_t), 0);
} }
stix_oop_t stix_allochalfwordobj (stix_t* stix, const stix_oohw_t* ptr, stix_oow_t len)
{
return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_HALFWORD, STIX_SIZEOF(stix_oohw_t), 0);
}
stix_oop_t stix_allocwordobj (stix_t* stix, const stix_oow_t* ptr, stix_oow_t len) stix_oop_t stix_allocwordobj (stix_t* stix, const stix_oow_t* ptr, stix_oow_t len)
{ {
return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_WORD, STIX_SIZEOF(stix_oow_t), 0); return alloc_numeric_array (stix, ptr, len, STIX_OBJ_TYPE_WORD, STIX_SIZEOF(stix_oow_t), 0);
@ -227,7 +224,7 @@ stix_oop_t stix_instantiate (stix_t* stix, stix_oop_t _class, const void* vptr,
case STIX_OBJ_TYPE_OOP: case STIX_OBJ_TYPE_OOP:
/* both the fixed part(named instance variables) and /* both the fixed part(named instance variables) and
* the variable part(indexed instance variables) are allowed. */ * the variable part(indexed instance variables) are allowed. */
oop = stix_allocoopobj(stix, named_instvar + vlen); oop = stix_allocoopobj (stix, named_instvar + vlen);
STIX_ASSERT (vptr == STIX_NULL); STIX_ASSERT (vptr == STIX_NULL);
/* /*
@ -243,15 +240,19 @@ stix_oop_t stix_instantiate (stix_t* stix, stix_oop_t _class, const void* vptr,
break; break;
case STIX_OBJ_TYPE_CHAR: case STIX_OBJ_TYPE_CHAR:
oop = stix_alloccharobj(stix, vptr, vlen); oop = stix_alloccharobj (stix, vptr, vlen);
break; break;
case STIX_OBJ_TYPE_BYTE: case STIX_OBJ_TYPE_BYTE:
oop = stix_allocbyteobj(stix, vptr, vlen); oop = stix_allocbyteobj (stix, vptr, vlen);
break;
case STIX_OBJ_TYPE_HALFWORD:
oop = stix_allochalfwordobj (stix, vptr, vlen);
break; break;
case STIX_OBJ_TYPE_WORD: case STIX_OBJ_TYPE_WORD:
oop = stix_allocwordobj(stix, vptr, vlen); oop = stix_allocwordobj (stix, vptr, vlen);
break; break;
default: default:
@ -343,3 +344,4 @@ einval:
} }
#endif #endif

View File

@ -1038,13 +1038,13 @@ int stix_utf8toucs (
/* ========================================================================= */ /* ========================================================================= */
/* bigint.c */ /* bigint.c */
/* ========================================================================= */ /* ========================================================================= */
stix_oop_t stix_addbigints ( stix_oop_t stix_addints (
stix_t* stix, stix_t* stix,
stix_oop_t x, stix_oop_t x,
stix_oop_t y stix_oop_t y
); );
stix_oop_t stix_subbigints ( stix_oop_t stix_subints (
stix_t* stix, stix_t* stix,
stix_oop_t x, stix_oop_t x,
stix_oop_t y stix_oop_t y

View File

@ -794,6 +794,11 @@ STIX_EXPORT void stix_gc (
stix_t* stix stix_t* stix
); );
STIX_EXPORT stix_oow_t stix_getpayloadbytes (
stix_t* stix,
stix_oop_t oop
);
/** /**
* The stix_instantiate() function creates a new object of the class * The stix_instantiate() function creates a new object of the class
* \a _class. The size of the fixed part is taken from the information * \a _class. The size of the fixed part is taken from the information
@ -810,6 +815,11 @@ STIX_EXPORT stix_oop_t stix_instantiate (
stix_oow_t vlen stix_oow_t vlen
); );
STIX_EXPORT stix_oop_t stix_shallowcopy (
stix_t* stix,
stix_oop_t oop
);
/** /**
* The stix_ignite() function creates key initial objects. * The stix_ignite() function creates key initial objects.
*/ */