hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

switching GC from semi-space copying to mark-sweep

Browse Source
This commit is contained in:
hyung-hwan 2020-12-31 17:48:47 +00:00
parent fbb7ce853a
commit 11e831bbcc
15 changed files with 826 additions and 348 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

224
lib/bigint.c
View File

@ -679,9 +679,9 @@ static HCL_INLINE hcl_oop_t expand_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t
return HCL_NULL;
}
hcl_pushtmp (hcl, &oop);
hcl_pushvolat (hcl, &oop);
z = hcl_makebigint(hcl, HCL_OBJ_GET_FLAGS_BRAND(oop), HCL_NULL, count + inc);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
for (i = 0; i < count; i++)
@ -699,9 +699,9 @@ static HCL_INLINE hcl_oop_t _clone_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(oop));
if (count <= 0) count = HCL_OBJ_GET_SIZE(oop);
hcl_pushtmp (hcl, &oop);
hcl_pushvolat (hcl, &oop);
z = hcl_makebigint(hcl, brand, HCL_NULL, count);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
for (i = 0; i < count; i++)
@ -2044,10 +2044,10 @@ static hcl_oop_t add_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
}
zs++;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = hcl_makebigint(hcl, HCL_OBJ_GET_FLAGS_BRAND(x), HCL_NULL, zs);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
add_unsigned_array (
@ -2065,10 +2065,10 @@ static hcl_oop_t subtract_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t
HCL_ASSERT (hcl, !is_less_unsigned(x, y));
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(x));
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
subtract_unsigned_array (hcl,
@ -2092,10 +2092,10 @@ static hcl_oop_t multiply_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t
return HCL_NULL;
}
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, xs + ys);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
#if defined(HCL_ENABLE_KARATSUBA)
@ -2129,9 +2129,9 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y,
rr = clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x));
if (!rr) return HCL_NULL;
hcl_pushtmp (hcl, &rr);
hcl_pushvolat (hcl, &rr);
qq = make_bigint_with_ooi(hcl, 0); /* TODO: inefficient. no need to create a bigint object for zero. */
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (qq) *r = rr;
return qq;
@ -2141,9 +2141,9 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y,
rr = make_bigint_with_ooi(hcl, 0); /* TODO: inefficient. no need to create a bigint object for zero. */
if (!rr) return HCL_NULL;
hcl_pushtmp (hcl, &rr);
hcl_pushvolat (hcl, &rr);
qq = make_bigint_with_ooi(hcl, 1); /* TODO: inefficient. no need to create a bigint object for zero. */
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (qq) *r = rr;
return qq;
@ -2151,8 +2151,8 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y,
/* the caller must ensure that x >= y */
HCL_ASSERT (hcl, !is_less_unsigned(x, y));
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
#define USE_DIVIDE_UNSIGNED_ARRAY2
/*#define USE_DIVIDE_UNSIGNED_ARRAY3*/
@ -2166,11 +2166,11 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y,
#endif
if (!qq)
{
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
return HCL_NULL;
}
hcl_pushtmp (hcl, &qq);
hcl_pushvolat (hcl, &qq);
#if defined(USE_DIVIDE_UNSIGNED_ARRAY3)
rr = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(y));
#elif defined(USE_DIVIDE_UNSIGNED_ARRAY2)
@ -2178,7 +2178,7 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y,
#else
rr = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(y) + 1);
#endif
hcl_poptmps (hcl, 3);
hcl_popvolats (hcl, 3);
if (!rr) return HCL_NULL;
@ -2228,9 +2228,9 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(x);
if (v == 0) return clone_bigint (hcl, y, HCL_OBJ_GET_SIZE(y));
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
}
else if (HCL_OOP_IS_SMOOI(y))
@ -2240,9 +2240,9 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(y);
if (v == 0) return clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x));
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
}
else
@ -2336,9 +2336,9 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return clone_bigint_negated (hcl, y, HCL_OBJ_GET_SIZE(y));
}
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
}
else if (HCL_OOP_IS_SMOOI(y))
@ -2348,9 +2348,9 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(y);
if (v == 0) return clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x));
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
}
else
@ -2414,14 +2414,14 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
/* overflowed - convert x and y normal objects and carry on */
/* no need to call hcl_pushtmp before creating x because
/* no need to call hcl_pushvolat before creating x because
* xv and yv contains actual values needed */
x = make_bigint_with_ooi (hcl, xv);
if (!x) return HCL_NULL;
hcl_pushtmp (hcl, &x); /* protect x made above */
hcl_pushvolat (hcl, &x); /* protect x made above */
y = make_bigint_with_ooi (hcl, yv);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
goto full_multiply;
@ -2453,9 +2453,9 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return clone_bigint_negated (hcl, y, HCL_OBJ_GET_SIZE(y));
}
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
}
else if (HCL_OOP_IS_SMOOI(y))
@ -2473,9 +2473,9 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return clone_bigint_negated (hcl, x, HCL_OBJ_GET_SIZE(x));
}
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
}
else
@ -2627,9 +2627,9 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
}
/* carry on to the full bigint division */
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi(hcl, xv);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
}
else if (HCL_OOP_IS_SMOOI(y))
@ -2706,10 +2706,10 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
if (!z) return HCL_NULL;
if (rem)
{
hcl_pushtmp (hcl, &z);
hcl_pushvolat (hcl, &z);
r = hcl_addints(hcl, HCL_SMOOI_TO_OOP(ri), HCL_SMOOI_TO_OOP(yv));
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!r) return HCL_NULL;
*rem = r;
@ -2725,9 +2725,9 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
}
/* carry on to the full bigint division */
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, yv);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
}
else
@ -2740,10 +2740,10 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
x_neg_sign = HCL_IS_NBIGINT(hcl, x);
y_neg_sign = HCL_IS_NBIGINT(hcl, y);
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = divide_unsigned_integers (hcl, x, y, &r);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
if (x_neg_sign)
@ -2757,30 +2757,30 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
{
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
hcl_pushtmp (hcl, &z);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &z);
hcl_pushvolat (hcl, &y);
r = normalize_bigint (hcl, r);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!r) return HCL_NULL;
if (r != HCL_SMOOI_TO_OOP(0) && modulo)
{
if (rem)
{
hcl_pushtmp (hcl, &z);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &z);
hcl_pushvolat (hcl, &y);
r = hcl_addints (hcl, r, y);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!r) return HCL_NULL;
hcl_pushtmp (hcl, &r);
hcl_pushvolat (hcl, &r);
z = normalize_bigint (hcl, z);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
hcl_pushtmp (hcl, &r);
hcl_pushvolat (hcl, &r);
z = hcl_subints (hcl, z, HCL_SMOOI_TO_OOP(1));
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
*rem = r;
@ -2798,15 +2798,15 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
}
else
{
hcl_pushtmp (hcl, &z);
hcl_pushvolat (hcl, &z);
r = normalize_bigint (hcl, r);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!r) return HCL_NULL;
}
hcl_pushtmp (hcl, &r);
hcl_pushvolat (hcl, &r);
z = normalize_bigint(hcl, z);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (z && rem) *rem = r;
return z;
@ -2952,9 +2952,9 @@ hcl_oop_t hcl_bitatint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
HCL_ASSERT (hcl, sign == 0);
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
quo = hcl_divints (hcl, y, HCL_SMOOI_TO_OOP(HCL_LIW_BITS), 0, &rem);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!quo) return HCL_NULL;
sign = integer_to_oow (hcl, quo, &wp);
@ -3023,9 +3023,9 @@ hcl_oop_t hcl_bitandints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(x);
if (v == 0) return HCL_SMOOI_TO_OOP(0);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -3039,9 +3039,9 @@ hcl_oop_t hcl_bitandints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(y);
if (v == 0) return HCL_SMOOI_TO_OOP(0);
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -3093,10 +3093,10 @@ hcl_oop_t hcl_bitandints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
zs = ys;
}
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
if (negx && negy)
@ -3236,9 +3236,9 @@ hcl_oop_t hcl_bitorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(x);
if (v == 0) return clone_bigint(hcl, y, HCL_OBJ_GET_SIZE(y));
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -3252,9 +3252,9 @@ hcl_oop_t hcl_bitorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(y);
if (v == 0) return clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x));
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -3313,10 +3313,10 @@ hcl_oop_t hcl_bitorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return HCL_NULL;
}
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
if (negx && negy)
@ -3454,9 +3454,9 @@ hcl_oop_t hcl_bitxorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(x);
if (v == 0) return clone_bigint(hcl, y, HCL_OBJ_GET_SIZE(y));
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -3470,9 +3470,9 @@ hcl_oop_t hcl_bitxorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
v = HCL_OOP_TO_SMOOI(y);
if (v == 0) return clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x));
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -3531,10 +3531,10 @@ hcl_oop_t hcl_bitxorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return HCL_NULL;
}
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!z) return HCL_NULL;
if (negx && negy)
@ -3690,9 +3690,9 @@ hcl_oop_t hcl_bitinvint (hcl_t* hcl, hcl_oop_t x)
return HCL_NULL;
}
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
if (negx)
@ -3761,10 +3761,10 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint (hcl_t* hcl, hcl_oop_t x, hcl
HCL_ASSERT (hcl, HCL_IS_NBIGINT(hcl, x));
xs = HCL_OBJ_GET_SIZE(x);
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
/* +1 for the second inversion below */
z = hcl_makebigint(hcl, HCL_BRAND_NBIGINT, HCL_NULL, xs + 1);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
/* the following lines roughly for 'z = hcl_bitinv (hcl, x)' */
@ -3832,15 +3832,15 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint_and_normalize (hcl_t* hcl, hc
shift = HCL_SMOOI_MAX;
do
{
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
z = rshift_negative_bigint (hcl, x, shift);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
/* y is a negative number. use hcl_addints() until it becomes 0 */
hcl_pushtmp (hcl, &z);
hcl_pushvolat (hcl, &z);
y = hcl_addints (hcl, y, HCL_SMOOI_TO_OOP(shift));
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
sign = integer_to_oow (hcl, y, &shift);
@ -3855,9 +3855,9 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint_and_normalize (hcl_t* hcl, hc
HCL_ASSERT (hcl, sign <= -1);
}
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = normalize_bigint (hcl, z);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
if (HCL_OOP_IS_SMOOI(x))
@ -3905,9 +3905,9 @@ static HCL_INLINE hcl_oop_t rshift_positive_bigint_and_normalize (hcl_t* hcl, hc
zs = HCL_OBJ_GET_SIZE(x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
z = clone_bigint (hcl, x, zs);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
/* for convenience in subtraction below.
@ -3926,9 +3926,9 @@ static HCL_INLINE hcl_oop_t rshift_positive_bigint_and_normalize (hcl_t* hcl, hc
}
/* y is a negative number. use hcl_addints() until it becomes 0 */
hcl_pushtmp (hcl, &z);
hcl_pushvolat (hcl, &z);
y = hcl_addints (hcl, y, HCL_SMOOI_TO_OOP(shift));
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
sign = integer_to_oow (hcl, y, &shift);
@ -3967,21 +3967,21 @@ static HCL_INLINE hcl_oop_t lshift_bigint_and_normalize (hcl_t* hcl, hcl_oop_t x
wshift = shift / HCL_LIW_BITS;
if (shift > wshift * HCL_LIW_BITS) wshift++;
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
z = expand_bigint (hcl, x, wshift);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!z) return HCL_NULL;
lshift_unsigned_array (((hcl_oop_liword_t)z)->slot, HCL_OBJ_GET_SIZE(z), shift);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = normalize_bigint (hcl, z);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
hcl_pushtmp (hcl, &x);
hcl_pushvolat (hcl, &x);
y = hcl_subints (hcl, y, HCL_SMOOI_TO_OOP(shift));
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
sign = integer_to_oow (hcl, y, &shift);
@ -4103,9 +4103,9 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return (v < 0)? HCL_SMOOI_TO_OOP(-1): HCL_SMOOI_TO_OOP(0);
}
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
goto bigint_and_bigint;
@ -4642,11 +4642,11 @@ hcl_oop_t hcl_sqrtint (hcl_t* hcl, hcl_oop_t x)
m = hcl->_nil;
m2 = hcl->_nil;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &a);
hcl_pushtmp (hcl, &b);
hcl_pushtmp (hcl, &m);
hcl_pushtmp (hcl, &m2);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &a);
hcl_pushvolat (hcl, &b);
hcl_pushvolat (hcl, &m);
hcl_pushvolat (hcl, &m2);
a = hcl_ltints(hcl, x, HCL_SMOOI_TO_OOP(0));
if (!a) goto oops;
@ -4692,7 +4692,7 @@ hcl_oop_t hcl_sqrtint (hcl_t* hcl, hcl_oop_t x)
}
}
hcl_poptmps (hcl, 5);
hcl_popvolats (hcl, 5);
x = hcl_subints(hcl, a, HCL_SMOOI_TO_OOP(1));
if (!x) return HCL_NULL;
@ -4700,7 +4700,7 @@ hcl_oop_t hcl_sqrtint (hcl_t* hcl, hcl_oop_t x)
return x;
oops:
hcl_poptmps (hcl, 5);
hcl_popvolats (hcl, 5);
return HCL_NULL;
}

22
lib/dic.c
View File

@ -66,9 +66,9 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
newsz = oldsz + inc;
}
hcl_pushtmp (hcl, (hcl_oop_t*)&oldbuc);
hcl_pushvolat (hcl, (hcl_oop_t*)&oldbuc);
newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!newbuc) return HCL_NULL;
while (oldsz > 0)
@ -172,9 +172,9 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k
return HCL_NULL;
}
hcl_pushtmp (hcl, (hcl_oop_t*)&dic); tmp_count++;
hcl_pushtmp (hcl, (hcl_oop_t*)&key); tmp_count++;
hcl_pushtmp (hcl, &value); tmp_count++;
hcl_pushvolat (hcl, (hcl_oop_t*)&dic); tmp_count++;
hcl_pushvolat (hcl, (hcl_oop_t*)&key); tmp_count++;
hcl_pushvolat (hcl, &value); tmp_count++;
/* no conversion to hcl_oow_t is necessary for tally + 1.
* the maximum value of tally is checked to be HCL_SMOOI_MAX - 1.
@ -220,11 +220,11 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k
dic->tally = HCL_SMOOI_TO_OOP(tally + 1);
dic->bucket->slot[index] = (hcl_oop_t)ass;
hcl_poptmps (hcl, tmp_count);
hcl_popvolats (hcl, tmp_count);
return ass;
oops:
hcl_poptmps (hcl, tmp_count);
hcl_popvolats (hcl, tmp_count);
return HCL_NULL;
}
@ -370,9 +370,9 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
obj->tally = HCL_SMOOI_TO_OOP(0);
hcl_pushtmp (hcl, (hcl_oop_t*)&obj);
hcl_pushvolat (hcl, (hcl_oop_t*)&obj);
bucket = (hcl_oop_oop_t)hcl_makearray(hcl, inisize, 0);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!bucket) obj = HCL_NULL;
else obj->bucket = bucket;
@ -385,7 +385,7 @@ int hcl_walkdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_dic_walker_t walker, void* c
{
hcl_oow_t i;
hcl_pushtmp (hcl, (hcl_oop_t*)&dic);
hcl_pushvolat (hcl, (hcl_oop_t*)&dic);
for (i = 0; i < HCL_OBJ_GET_SIZE(dic->bucket); i++)
{
@ -393,7 +393,7 @@ int hcl_walkdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_dic_walker_t walker, void* c
if (HCL_IS_CONS(hcl, tmp) && walker(hcl, dic, (hcl_oop_cons_t)tmp, ctx) <= -1) return -1;
}
hcl_poptmp (hcl);
hcl_popvolat (hcl);
return 0;
}

55
lib/exec.c
View File

@ -413,9 +413,9 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
if (stksize > HCL_TYPE_MAX(hcl_oow_t) - HCL_PROCESS_NAMED_INSTVARS)
stksize = HCL_TYPE_MAX(hcl_oow_t) - HCL_PROCESS_NAMED_INSTVARS;
hcl_pushtmp (hcl, (hcl_oop_t*)&c);
hcl_pushvolat (hcl, (hcl_oop_t*)&c);
proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!proc)) return HCL_NULL;
#if 0
@ -1070,7 +1070,7 @@ static hcl_oop_process_t signal_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem)
{
proc = sem->waiting.first;
/* [NOTE] no GC must occur as 'proc' isn't protected with hcl_pushtmp(). */
/* [NOTE] no GC must occur as 'proc' isn't protected with hcl_pushvolat(). */
/* detach a process from a semaphore's waiting list and
* make it runnable */
@ -1451,9 +1451,9 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi
new_mask = ((hcl_ooi_t)1 << io_type);
hcl_pushtmp (hcl, (hcl_oop_t*)&sem);
hcl_pushvolat (hcl, (hcl_oop_t*)&sem);
n = hcl->vmprim.vm_muxadd(hcl, io_handle, new_mask);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
}
else
{
@ -1466,9 +1466,9 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi
new_mask = hcl->sem_io_tuple[index].mask; /* existing mask */
new_mask |= ((hcl_ooi_t)1 << io_type);
hcl_pushtmp (hcl, (hcl_oop_t*)&sem);
hcl_pushvolat (hcl, (hcl_oop_t*)&sem);
n = hcl->vmprim.vm_muxmod(hcl, io_handle, new_mask);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
}
if (n <= -1)
@ -1534,10 +1534,10 @@ static int delete_sem_from_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, in
new_mask = hcl->sem_io_tuple[index].mask;
new_mask &= ~((hcl_ooi_t)1 << io_type); /* this is the new mask after deletion */
hcl_pushtmp (hcl, (hcl_oop_t*)&sem);
hcl_pushvolat (hcl, (hcl_oop_t*)&sem);
x = new_mask? hcl->vmprim.vm_muxmod(hcl, io_handle, new_mask):
hcl->vmprim.vm_muxdel(hcl, io_handle);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (x <= -1)
{
HCL_LOG3 (hcl, HCL_LOG_WARN, "Failed to delete IO semaphore at index %zd handle %zd for %hs\n", index, io_handle, io_type_str[io_type]);
@ -1742,9 +1742,9 @@ static int __activate_block (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t narg
HCL_ASSERT (hcl, local_ntmprs >= nargs);
/* create a new block context to clone rcv_blk */
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_blk);
hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_blk);
blkctx = make_context(hcl, local_ntmprs);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!blkctx)) return -1;
#if 0
@ -1829,9 +1829,9 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
HCL_ASSERT (hcl, local_ntmprs >= nargs);
/* create a new block context to clone rcv_func */
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_func);
hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_func);
functx = make_context(hcl, local_ntmprs);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!functx)) return -1;
functx->ip = HCL_SMOOI_TO_OOP(0);
@ -2137,9 +2137,9 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
* let's force set active_context to ctx directly. */
hcl->active_context = ctx;
hcl_pushtmp (hcl, (hcl_oop_t*)&ctx);
hcl_pushvolat (hcl, (hcl_oop_t*)&ctx);
proc = start_initial_process(hcl, ctx);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!proc)) return -1;
/* the stack must contain nothing as it should emulate the expresssion - (the-initial-function).
@ -2550,6 +2550,14 @@ static HCL_INLINE void do_return_from_block (hcl_t* hcl)
}
/* ------------------------------------------------------------------------- */
static void xma_dumper (void* ctx, const char* fmt, ...)
{
va_list ap;
va_start (ap, fmt);
hcl_logbfmtv ((hcl_t*)ctx, HCL_LOG_IC | HCL_LOG_INFO, fmt, ap);
va_end (ap);
}
static int execute (hcl_t* hcl)
{
hcl_oob_t bcode;
@ -2570,6 +2578,11 @@ static int execute (hcl_t* hcl)
if (vm_startup(hcl) <= -1) return -1;
hcl->proc_switched = 0;
hcl->gci.lazy_sweep = 1; /* TODO: make it configurable?? */
HCL_INIT_NTIME (&hcl->gci.stat.alloc, 0, 0);
HCL_INIT_NTIME (&hcl->gci.stat.mark, 0, 0);
HCL_INIT_NTIME (&hcl->gci.stat.sweep, 0, 0);
while (1)
{
/* stop requested or no more runnable process */
@ -3395,6 +3408,8 @@ static int execute (hcl_t* hcl)
}
done:
hcl->gci.lazy_sweep = 1;
vm_cleanup (hcl);
#if defined(HCL_PROFILE_VM)
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TOTAL INST COUTNER = %zu\n", inst_counter);
@ -3402,6 +3417,8 @@ done:
return 0;
oops:
hcl->gci.lazy_sweep = 1;
/* TODO: anything to do here? */
if (hcl->processor->active != hcl->nil_process)
{
@ -3489,6 +3506,14 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
hcl->initial_context = HCL_NULL;
hcl->active_context = HCL_NULL;
#if defined(HCL_PROFILE_VM)
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "GC - gci.bsz: %zu, gci.stack.max: %zu\n", hcl->gci.bsz, hcl->gci.stack.max);
if (hcl->heap->xma) hcl_xma_dump (hcl->heap->xma, xma_dumper, hcl);
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "GC - gci.stat.alloc: %ld.%09u\n", (unsigned long int)hcl->gci.stat.alloc.sec, (unsigned int)hcl->gci.stat.alloc.nsec);
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "GC - gci.stat.mark: %ld.%09u\n", (unsigned long int)hcl->gci.stat.mark.sec, (unsigned int)hcl->gci.stat.mark.nsec);
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "GC - gci.stat.sweep: %ld.%09u\n", (unsigned long int)hcl->gci.stat.sweep.sec, (unsigned int)hcl->gci.stat.sweep.nsec);
#endif
hcl->log.default_type_mask = log_default_type_mask;
return (n <= -1)? HCL_NULL: hcl->last_retv;
}

4
lib/fmt.c
View File

@ -2650,9 +2650,9 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs,
/* the given number for integer output is a fixed-point decimal.
* i will drop all digits after the fixed point */
hcl_pushtmp (hcl, &arg);
hcl_pushvolat (hcl, &arg);
nv = hcl_truncfpdecval(hcl, fa->value, HCL_OOP_TO_SMOOI(fa->scale), 0);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!nv)
{
HCL_LOG1 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to truncate a fixed-point number %O to an integer for output\n", arg);

439
lib/gc.c
View File

@ -26,6 +26,11 @@
#include "hcl-prv.h"
#if defined(HCL_PROFILE_VM)
#include <sys/time.h>
#include <sys/resource.h> /* getrusage */
#endif
static struct
{
hcl_oow_t len;
@ -84,7 +89,7 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
}
HCL_ASSERT (hcl, hcl->symtab->bucket->slot[index] != _nil);
for (i = 0, x = index, y = index; i < bucket_size; i++)
{
y = (y + 1) % bucket_size;
@ -118,7 +123,7 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
hcl->symtab->tally = HCL_SMOOI_TO_OOP(tally);
}
static HCL_INLINE hcl_oow_t get_payload_bytes (hcl_t* hcl, hcl_oop_t oop)
hcl_oow_t hcl_getobjpayloadbytes (hcl_t* hcl, hcl_oop_t oop)
{
hcl_oow_t nbytes_aligned;
@ -154,86 +159,88 @@ static HCL_INLINE hcl_oow_t get_payload_bytes (hcl_t* hcl, hcl_oop_t oop)
return nbytes_aligned;
}
hcl_oop_t hcl_moveoop (hcl_t* hcl, hcl_oop_t oop)
/* ----------------------------------------------------------------------- */
#if 0
static HCL_INLINE void gc_ms_mark (hcl_t* hcl, hcl_oop_t oop)
{
hcl_oow_t i, sz;
#if defined(HCL_SUPPORT_GC_DURING_IGNITION)
if (!oop) return oop;
if (!oop) return;
#endif
if (!HCL_OOP_IS_POINTER(oop)) return oop;
if (HCL_OBJ_GET_FLAGS_NGC(oop)) return oop; /* non-GC object */
if (!HCL_OOP_IS_POINTER(oop)) return;
if (HCL_OBJ_GET_FLAGS_MOVED(oop)) return; /* already marked */
if (HCL_OBJ_GET_FLAGS_MOVED(oop))
HCL_OBJ_SET_FLAGS_MOVED(oop, 1); /* mark */
gc_ms_mark (hcl, (hcl_oop_t)HCL_OBJ_GET_CLASS(oop)); /* TODO: remove recursion */
if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_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 HCL_OBJ_GET_CLASS(oop);
}
else
{
hcl_oow_t nbytes_aligned;
hcl_oop_t tmp;
hcl_oow_t size, i;
nbytes_aligned = get_payload_bytes(hcl, oop);
/* is it really better to use a flag bit in the header to
* determine that it is an instance of process? */
if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop)))
{
/* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer
* are garbages. */
size = HCL_PROCESS_NAMED_INSTVARS + HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1;
HCL_ASSERT (hcl, size <= HCL_OBJ_GET_SIZE(oop));
}
else
{
size = HCL_OBJ_GET_SIZE(oop);
}
/* allocate space in the new heap */
tmp = (hcl_oop_t)hcl_allocheapmem(hcl, hcl->newheap, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
/* allocation here must not fail because
* i'm allocating the new space in a new heap for
* moving an existing object in the current heap.
*
* assuming the new heap is as large as the old heap,
* and garbage collection doesn't allocate more objects
* than in the old heap, it must not fail. */
HCL_ASSERT (hcl, tmp != HCL_NULL);
/* copy the payload to the new object */
HCL_MEMCPY (tmp, oop, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
/* mark the old object that it has migrated to the new heap */
HCL_OBJ_SET_FLAGS_MOVED(oop, 1);
/* let the class field of the old object point to the new
* object allocated in the new heap. it is returned in
* the 'if' block at the top of this function. */
HCL_OBJ_SET_CLASS (oop, tmp);
/* return the new object */
return tmp;
for (i = 0; i < size; i++)
{
hcl_oop_t tmp = HCL_OBJ_GET_OOP_VAL(oop, i);
if (HCL_OOP_IS_POINTER(tmp)) gc_ms_mark (hcl, tmp); /* TODO: no resursion */
}
}
}
static hcl_uint8_t* scan_new_heap (hcl_t* hcl, hcl_uint8_t* ptr)
#else
static HCL_INLINE void gc_ms_mark_object (hcl_t* hcl, hcl_oop_t oop)
{
while (ptr < hcl->newheap->ptr)
#if defined(HCL_SUPPORT_GC_DURING_IGNITION)
if (!oop) return;
#endif
if (!HCL_OOP_IS_POINTER(oop) || HCL_OBJ_GET_FLAGS_MOVED(oop)) return; /* non-pointer or already marked */
HCL_OBJ_SET_FLAGS_MOVED(oop, 1); /* mark */
HCL_ASSERT (hcl, hcl->gci.stack.len < hcl->gci.stack.capa);
hcl->gci.stack.ptr[hcl->gci.stack.len++] = oop; /* push */
if (hcl->gci.stack.len > hcl->gci.stack.max) hcl->gci.stack.max = hcl->gci.stack.len;
}
static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl)
{
hcl_oop_t oop;
while (hcl->gci.stack.len > 0)
{
hcl_oow_t i;
hcl_oow_t nbytes_aligned;
hcl_oop_t oop, tmp;
oop = hcl->gci.stack.ptr[--hcl->gci.stack.len];
oop = (hcl_oop_t)ptr;
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(oop));
nbytes_aligned = get_payload_bytes(hcl, oop);
tmp = hcl_moveoop(hcl, HCL_OBJ_GET_CLASS(oop));
HCL_OBJ_SET_CLASS (oop, tmp);
gc_ms_mark_object (hcl, (hcl_oop_t)HCL_OBJ_GET_CLASS(oop));
if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP)
{
hcl_oop_oop_t xtmp;
hcl_oow_t size;
hcl_oow_t size, i;
/* is it really better to use a flag bit in the header to
* determine that it is an instance of process? */
/* if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) */
if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS)
{
/* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer
* are garbages. */
size = HCL_PROCESS_NAMED_INSTVARS +
HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1;
size = HCL_PROCESS_NAMED_INSTVARS + HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1;
HCL_ASSERT (hcl, size <= HCL_OBJ_GET_SIZE(oop));
}
else
@ -241,21 +248,285 @@ static hcl_uint8_t* scan_new_heap (hcl_t* hcl, hcl_uint8_t* ptr)
size = HCL_OBJ_GET_SIZE(oop);
}
xtmp = (hcl_oop_oop_t)oop;
for (i = 0; i < size; i++)
{
if (HCL_OOP_IS_POINTER(xtmp->slot[i]))
xtmp->slot[i] = hcl_moveoop (hcl, xtmp->slot[i]);
gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i));
}
}
}
}
static HCL_INLINE void gc_ms_mark (hcl_t* hcl, hcl_oop_t oop)
{
gc_ms_mark_object (hcl, oop);
gc_ms_scan_stack (hcl);
}
#endif
static HCL_INLINE void gc_ms_mark_roots (hcl_t* hcl)
{
hcl_oow_t i;
#if defined(ENABLE_GCFIN)
hcl_oow_t gcfin_count;
#endif
hcl_cb_t* cb;
#if defined(HCL_PROFILE_VM)
struct rusage ru;
hcl_ntime_t rut;
getrusage(RUSAGE_SELF, &ru);
HCL_INIT_NTIME (&rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
#endif
if (hcl->processor && hcl->processor->active)
{
HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor != hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor->active != hcl->_nil);
/* commit the stack pointer to the active process because
* gc needs the correct stack pointer for a process object */
hcl->processor->active->sp = HCL_SMOOI_TO_OOP(hcl->sp);
}
gc_ms_mark (hcl, hcl->_nil);
gc_ms_mark (hcl, hcl->_true);
gc_ms_mark (hcl, hcl->_false);
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
gc_ms_mark (hcl, *(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset));
}
gc_ms_mark (hcl, (hcl_oop_t)hcl->sysdic);
gc_ms_mark (hcl, (hcl_oop_t)hcl->processor);
gc_ms_mark (hcl, (hcl_oop_t)hcl->nil_process);
for (i = 0; i < hcl->code.lit.len; i++)
{
/* the literal array ia a NGC object. but the literal objects
* pointed by the elements of this array must be gabage-collected. */
gc_ms_mark (hcl, ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]);
}
gc_ms_mark (hcl, hcl->p.e);
for (i = 0; i < hcl->sem_list_count; i++)
{
gc_ms_mark (hcl, (hcl_oop_t)hcl->sem_list[i]);
}
for (i = 0; i < hcl->sem_heap_count; i++)
{
gc_ms_mark (hcl, (hcl_oop_t)hcl->sem_heap[i]);
}
for (i = 0; i < hcl->sem_io_tuple_count; i++)
{
if (hcl->sem_io_tuple[i].sem[HCL_SEMAPHORE_IO_TYPE_INPUT])
gc_ms_mark (hcl, (hcl_oop_t)hcl->sem_io_tuple[i].sem[HCL_SEMAPHORE_IO_TYPE_INPUT]);
if (hcl->sem_io_tuple[i].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT])
gc_ms_mark (hcl, (hcl_oop_t)hcl->sem_io_tuple[i].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT]);
}
#if defined(ENABLE_GCFIN)
gc_ms_mark (hcl, (hcl_oop_t)hcl->sem_gcfin);
#endif
for (i = 0; i < hcl->proc_map_capa; i++)
{
gc_ms_mark (hcl, hcl->proc_map[i]);
}
for (i = 0; i < hcl->volat_count; i++)
{
gc_ms_mark (hcl, *hcl->volat_stack[i]);
}
if (hcl->initial_context) gc_ms_mark (hcl, (hcl_oop_t)hcl->initial_context);
if (hcl->active_context) gc_ms_mark (hcl, (hcl_oop_t)hcl->active_context);
if (hcl->initial_function) gc_ms_mark (hcl, (hcl_oop_t)hcl->initial_function);
if (hcl->active_function) gc_ms_mark (hcl, (hcl_oop_t)hcl->active_function);
if (hcl->last_retv) gc_ms_mark (hcl, hcl->last_retv);
/*hcl_rbt_walk (&hcl->modtab, call_module_gc, hcl); */
for (cb = hcl->cblist; cb; cb = cb->next)
{
if (cb->gc) cb->gc (hcl);
}
#if defined(ENABLE_GCFIN)
gcfin_count = move_finalizable_objects(hcl); /* mark finalizable objects */
#endif
if (hcl->symtab)
{
compact_symbol_table (hcl, hcl->_nil); /* delete symbol table entries that are not marked */
#if 0
gc_ms_mark (hcl, (hcl_oop_t)hcl->symtab); /* mark the symbol table */
#else
HCL_OBJ_SET_FLAGS_MOVED(hcl->symtab, 1); /* mark */
HCL_OBJ_SET_FLAGS_MOVED(hcl->symtab->bucket, 1); /* mark */
#endif
}
#if defined(ENABLE_GCFIN)
if (gcfin_count > 0) hcl->sem_gcfin_sigreq = 1;
#endif
if (hcl->active_function) hcl->active_code = HCL_FUNCTION_GET_CODE_BYTE(hcl->active_function); /* update hcl->active_code */
#if defined(HCL_PROFILE_VM)
getrusage(RUSAGE_SELF, &ru);
HCL_SUB_NTIME_SNS (&rut, &rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
HCL_SUB_NTIME (&hcl->gci.stat.mark, &hcl->gci.stat.mark, &rut); /* do subtraction because rut is negative */
#endif
}
void hcl_gc_ms_sweep_lazy (hcl_t* hcl, hcl_oow_t allocsize)
{
hcl_gchdr_t* curr, * next, * prev;
hcl_oop_t obj;
hcl_oow_t freed_size;
#if defined(HCL_PROFILE_VM)
struct rusage ru;
hcl_ntime_t rut;
getrusage(RUSAGE_SELF, &ru);
HCL_INIT_NTIME (&rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
#endif
if (!hcl->gci.ls.curr) goto done;
freed_size = 0;
prev = hcl->gci.ls.prev;
curr = hcl->gci.ls.curr;
while (curr)
{
next = curr->next;
obj = (hcl_oop_t)(curr + 1);
if (HCL_OBJ_GET_FLAGS_MOVED(obj)) /* if marked */
{
HCL_OBJ_SET_FLAGS_MOVED (obj, 0); /* unmark */
prev = curr;
}
else
{
hcl_oow_t objsize;
if (prev) prev->next = next;
else hcl->gci.b = next;
objsize = HCL_SIZEOF(hcl_obj_t) + hcl_getobjpayloadbytes(hcl, obj);
freed_size += objsize;
hcl->gci.bsz -= objsize;
hcl_freeheapmem (hcl, hcl->heap, curr); /* destroy */
/*if (freed_size > allocsize)*/ /* TODO: can it secure large enough space? */
if (objsize == allocsize)
{
hcl->gci.ls.prev = prev;
hcl->gci.ls.curr = next; /* let the next lazy sweeping begin at this point */
goto done;
}
}
ptr = ptr + HCL_SIZEOF(hcl_obj_t) + nbytes_aligned;
curr = next;
}
/* return the pointer to the beginning of the free space in the heap */
return ptr;
hcl->gci.ls.curr = HCL_NULL;
done:
#if defined(HCL_PROFILE_VM)
getrusage(RUSAGE_SELF, &ru);
HCL_SUB_NTIME_SNS (&rut, &rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
HCL_SUB_NTIME (&hcl->gci.stat.sweep, &hcl->gci.stat.sweep, &rut); /* do subtraction because rut is negative */
#endif
return;
}
static HCL_INLINE void gc_ms_sweep (hcl_t* hcl)
{
hcl_gchdr_t* curr, * next, * prev;
hcl_oop_t obj;
#if defined(HCL_PROFILE_VM)
struct rusage ru;
hcl_ntime_t rut;
getrusage(RUSAGE_SELF, &ru);
HCL_INIT_NTIME (&rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
#endif
prev = HCL_NULL;
curr = hcl->gci.b;
while (curr)
{
next = curr->next;
obj = (hcl_oop_t)(curr + 1);
if (HCL_OBJ_GET_FLAGS_MOVED(obj)) /* if marked */
{
HCL_OBJ_SET_FLAGS_MOVED (obj, 0); /* unmark */
prev = curr;
}
else
{
if (prev) prev->next = next;
else hcl->gci.b = next;
hcl->gci.bsz -= HCL_SIZEOF(hcl_obj_t) + hcl_getobjpayloadbytes(hcl, obj);
hcl_freeheapmem (hcl, hcl->heap, curr); /* destroy */
}
curr = next;
}
hcl->gci.ls.curr = HCL_NULL;
#if defined(HCL_PROFILE_VM)
getrusage(RUSAGE_SELF, &ru);
HCL_SUB_NTIME_SNS (&rut, &rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
HCL_SUB_NTIME (&hcl->gci.stat.sweep, &hcl->gci.stat.sweep, &rut); /* do subtraction because rut is negative */
#endif
}
void hcl_gc (hcl_t* hcl, int full)
{
if (hcl->gci.lazy_sweep) hcl_gc_ms_sweep_lazy (hcl, HCL_TYPE_MAX(hcl_oow_t));
HCL_LOG1 (hcl, HCL_LOG_GC | HCL_LOG_INFO, "Starting GC (mark-sweep) - gci.bsz = %zu\n", hcl->gci.bsz);
hcl->gci.stack.len = 0;
/*hcl->gci.stack.max = 0;*/
gc_ms_mark_roots (hcl);
if (!full && hcl->gci.lazy_sweep)
{
/* set the lazy sweeping point to the head of the allocated blocks.
* hawk_allocbytes() updates hcl->gci.ls.prev if it is called while
* hcl->gci.ls.curr stays at hcl->gci.b */
hcl->gci.ls.prev = HCL_NULL;
hcl->gci.ls.curr = hcl->gci.b;
}
else
{
gc_ms_sweep (hcl);
}
HCL_LOG2 (hcl, HCL_LOG_GC | HCL_LOG_INFO, "Finished GC (mark-sweep) - gci.bsz = %zu, gci.stack.max %zu\n", hcl->gci.bsz, hcl->gci.stack.max);
}
hcl_oop_t hcl_moveoop (hcl_t* hcl, hcl_oop_t oop)
{
if (oop) gc_ms_mark (hcl, oop);
return oop;
}
#if 0
void hcl_gc (hcl_t* hcl)
{
/*
@ -343,9 +614,9 @@ void hcl_gc (hcl_t* hcl)
hcl->proc_map[i] = hcl_moveoop(hcl, hcl->proc_map[i]);
}
for (i = 0; i < hcl->tmp_count; i++)
for (i = 0; i < hcl->volat_count; i++)
{
*hcl->tmp_stack[i] = hcl_moveoop(hcl, *hcl->tmp_stack[i]);
*hcl->volat_stack[i] = hcl_moveoop(hcl, *hcl->volat_stack[i]);
}
if (hcl->initial_context)
@ -417,26 +688,26 @@ void hcl_gc (hcl_t* hcl)
"Finished GC curheap base %p ptr %p newheap base %p ptr %p\n",
hcl->curheap->base, hcl->curheap->ptr, hcl->newheap->base, hcl->newheap->ptr);
}
#endif
void hcl_pushtmp (hcl_t* hcl, hcl_oop_t* oop_ptr)
void hcl_pushvolat (hcl_t* hcl, hcl_oop_t* oop_ptr)
{
/* if you have too many temporaries pushed, something must be wrong.
* change your code not to exceede the stack limit */
HCL_ASSERT (hcl, hcl->tmp_count < HCL_COUNTOF(hcl->tmp_stack));
hcl->tmp_stack[hcl->tmp_count++] = oop_ptr;
HCL_ASSERT (hcl, hcl->volat_count < HCL_COUNTOF(hcl->volat_stack));
hcl->volat_stack[hcl->volat_count++] = oop_ptr;
}
void hcl_poptmp (hcl_t* hcl)
void hcl_popvolat (hcl_t* hcl)
{
HCL_ASSERT (hcl, hcl->tmp_count > 0);
hcl->tmp_count--;
HCL_ASSERT (hcl, hcl->volat_count > 0);
hcl->volat_count--;
}
void hcl_poptmps (hcl_t* hcl, hcl_oow_t count)
void hcl_popvolats (hcl_t* hcl, hcl_oow_t count)
{
HCL_ASSERT (hcl, hcl->tmp_count >= count);
hcl->tmp_count -= count;
HCL_ASSERT (hcl, hcl->volat_count >= count);
hcl->volat_count -= count;
}
@ -447,11 +718,11 @@ hcl_oop_t hcl_shallowcopy (hcl_t* hcl, hcl_oop_t oop)
hcl_oop_t z;
hcl_oow_t total_bytes;
total_bytes = HCL_SIZEOF(hcl_obj_t) + get_payload_bytes(hcl, oop);
total_bytes = HCL_SIZEOF(hcl_obj_t) + hcl_getobjpayloadbytes(hcl, oop);
hcl_pushtmp (hcl, &oop);
hcl_pushvolat (hcl, &oop);
z = (hcl_oop_t)hcl_allocbytes (hcl, total_bytes);
hcl_poptmp(hcl);
hcl_popvolat(hcl);
HCL_MEMCPY (z, oop, total_bytes);
return z;
@ -526,12 +797,15 @@ int hcl_ignite (hcl_t* hcl)
hcl->processor->total_count = HCL_SMOOI_TO_OOP(0);
hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0);
hcl->processor->suspended.count = HCL_SMOOI_TO_OOP(0);
/* commit the sp field of the initial active context to hcl->sp */
hcl->sp = HCL_OOP_TO_SMOOI(hcl->processor->active->sp);
}
/* TODO: move code.bc.ptr creation to hcl_init? */
if (!hcl->code.bc.ptr)
{
hcl->code.bc.ptr = (hcl_oop_byte_t)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.bc.ptr) * HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
hcl->code.bc.ptr = (hcl_oob_t*)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.bc.ptr) * HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
if (HCL_UNLIKELY(!hcl->code.bc.ptr)) return -1;
HCL_ASSERT (hcl, hcl->code.bc.len == 0);
hcl->code.bc.capa = HCL_BC_BUFFER_INIT;
@ -546,6 +820,5 @@ int hcl_ignite (hcl_t* hcl)
}
hcl->p.e = hcl->_nil;
return 0;
}

42
lib/hcl-prv.h
View File

@ -689,16 +689,26 @@ void hcl_killheap (
hcl_heap_t* heap
);
/**
* The hcl_allocheapmem() function allocates \a size bytes in the heap pointed
* to by \a heap.
*
* \return memory pointer on success and #HCL_NULL on failure.
/**
* The hcl_allocheapmem() function allocates \a size bytes from the given heap
* and clears it with zeros.
*/
void* hcl_allocheapmem (
hcl_t* hcl,
hcl_heap_t* heap,
hcl_oow_t size
void* hcl_callocheapmem (
hcl_t* hcl,
hcl_heap_t* heap,
hcl_oow_t size
);
void* hcl_callocheapmem_noerr (
hcl_t* hcl,
hcl_heap_t* heap,
hcl_oow_t size
);
void hcl_freeheapmem (
hcl_t* hcl,
hcl_heap_t* heap,
void* ptr
);
/* ========================================================================= */
@ -778,6 +788,20 @@ hcl_oop_process_t hcl_makeproc (
hcl_t* hcl
);
/* ========================================================================= */
/* gc.c */
/* ========================================================================= */
hcl_oow_t hcl_getobjpayloadbytes (
hcl_t* hcl,
hcl_oop_t oop
);
void hcl_gc_ms_sweep_lazy (
hcl_t* moo,
hcl_oow_t allocsize
);
/* ========================================================================= */
/* utf8.c */
/* ========================================================================= */

50
lib/hcl.c
View File

@ -138,6 +138,10 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t
hcl->log.ptr = (hcl_ooch_t*)hcl_allocmem(hcl, (hcl->log.capa + 1) * HCL_SIZEOF(*hcl->log.ptr));
if (HCL_UNLIKELY(!hcl->log.ptr)) goto oops;
hcl->gci.stack.capa = HCL_ALIGN_POW2(1, 1024); /* TODO: is this a good initial size? */
hcl->gci.stack.ptr = hcl_allocmem(hcl, (hcl->gci.stack.capa + 1) * HCL_SIZEOF(*hcl->gci.stack.ptr));
if (HCL_UNLIKELY(!hcl->gci.stack.ptr)) goto oops;
n = hcl_rbt_init(&hcl->modtab, hcl, HCL_SIZEOF(hcl_ooch_t), 1);
if (HCL_UNLIKELY(n <= -1)) goto oops;
modtab_inited = 1;
@ -153,21 +157,20 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t
hcl->proc_map_free_first = -1;
hcl->proc_map_free_last = -1;
/*hcl->permheap = hcl_makeheap (hcl, what is the best size???);
if (!hcl->curheap) goto oops; */
hcl->curheap = hcl_makeheap(hcl, heapsz);
if (HCL_UNLIKELY(!hcl->curheap)) goto oops;
hcl->newheap = hcl_makeheap(hcl, heapsz);
if (HCL_UNLIKELY(!hcl->newheap)) goto oops;
hcl->heap = hcl_makeheap(hcl, heapsz);
if (HCL_UNLIKELY(!hcl->heap)) goto oops;
if (hcl->vmprim.dl_startup) hcl->vmprim.dl_startup (hcl);
return 0;
oops:
if (hcl->newheap) hcl_killheap (hcl, hcl->newheap);
if (hcl->curheap) hcl_killheap (hcl, hcl->curheap);
if (hcl->permheap) hcl_killheap (hcl, hcl->permheap);
if (hcl->heap) hcl_killheap (hcl, hcl->heap);
if (modtab_inited) hcl_rbt_fini (&hcl->modtab);
if (hcl->gci.stack.ptr)
{
hcl_freemem (hcl, hcl->gci.stack.ptr);
hcl->gci.stack.capa = 0;
}
if (hcl->log.ptr) hcl_freemem (hcl, hcl->log.ptr);
hcl->log.capa = 0;
return -1;
@ -277,9 +280,30 @@ void hcl_fini (hcl_t* hcl)
hcl->p.s.size = 0;
}
hcl_killheap (hcl, hcl->newheap);
hcl_killheap (hcl, hcl->curheap);
if (hcl->permheap) hcl_killheap (hcl, hcl->permheap);
if (hcl->gci.b)
{
hcl_gchdr_t* next;
do
{
next = hcl->gci.b->next;
hcl->gci.bsz -= HCL_SIZEOF(hcl_obj_t) + hcl_getobjpayloadbytes(hcl, (hcl_oop_t)(hcl->gci.b + 1));
hcl_freeheapmem (hcl, hcl->heap, hcl->gci.b);
hcl->gci.b = next;
}
while (hcl->gci.b);
HCL_ASSERT (hcl, hcl->gci.bsz == 0);
}
if (hcl->gci.stack.ptr)
{
hcl_freemem (hcl, hcl->gci.stack.ptr);
hcl->gci.stack.ptr = 0;
hcl->gci.stack.capa = 0;
hcl->gci.stack.len = 0;
}
hcl_killheap (hcl, hcl->heap);
if (hcl->log.ptr)
{
@ -337,7 +361,7 @@ void hcl_reset (hcl_t* hcl)
hcl->code.lit.len = 0;
/* clean up object memory */
hcl_gc (hcl);
hcl_gc (hcl, 1);
}
void hcl_setinloc (hcl_t* hcl, hcl_oow_t line, hcl_oow_t colm)

75
lib/hcl.h
View File

@ -27,8 +27,9 @@
#ifndef _HCL_H_
#define _HCL_H_
#include "hcl-cmn.h"
#include "hcl-rbt.h"
#include <hcl-cmn.h>
#include <hcl-rbt.h>
#include <hcl-xma.h>
#include <stdarg.h>
/* TODO: move this macro out to the build files.... */
@ -255,6 +256,16 @@ typedef struct hcl_obj_word_t* hcl_oop_word_t;
#endif
/* =========================================================================
* HEADER FOR GC IMPLEMENTATION
* ========================================================================= */
typedef struct hcl_gchdr_t hcl_gchdr_t;
struct hcl_gchdr_t
{
hcl_gchdr_t* next;
};
/* The size of hcl_gchdr_t must be aligned to HCL_SIZEOF_OOP_T */
/* =========================================================================
* OBJECT STRUCTURE
* ========================================================================= */
@ -335,7 +346,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_FLAGS_UNIT_BITS 5
#define HCL_OBJ_FLAGS_EXTRA_BITS 1
#define HCL_OBJ_FLAGS_KERNEL_BITS 2
#define HCL_OBJ_FLAGS_MOVED_BITS 1
#define HCL_OBJ_FLAGS_MOVED_BITS 2
#define HCL_OBJ_FLAGS_NGC_BITS 1
#define HCL_OBJ_FLAGS_TRAILER_BITS 1
#define HCL_OBJ_FLAGS_SYNCODE_BITS 4
@ -803,8 +814,9 @@ typedef struct hcl_heap_t hcl_heap_t;
struct hcl_heap_t
{
hcl_uint8_t* base; /* start of a heap */
hcl_uint8_t* limit; /* end of a heap */
hcl_uint8_t* ptr; /* next allocation pointer */
hcl_oow_t size;
hcl_xma_t* xma;
hcl_mmgr_t xmmgr;
};
/* =========================================================================
@ -1344,9 +1356,7 @@ struct hcl_t
} log;
/* ========================= */
hcl_heap_t* permheap; /* TODO: put kernel objects to here */
hcl_heap_t* curheap;
hcl_heap_t* newheap;
hcl_heap_t* heap;
/* ========================= */
hcl_oop_t _nil; /* pointer to the nil object */
@ -1400,9 +1410,6 @@ struct hcl_t
hcl_oow_t sem_io_map_capa;
/* ============================================================================= */
hcl_oop_t* tmp_stack[256]; /* stack for temporaries */
hcl_oow_t tmp_count;
hcl_oop_t* proc_map;
hcl_oow_t proc_map_capa;
hcl_oow_t proc_map_used;
@ -1414,6 +1421,9 @@ struct hcl_t
* are 3 */
int tagged_brands[16];
hcl_oop_t* volat_stack[256]; /* stack for temporaries */
hcl_oow_t volat_count;
/* == EXECUTION REGISTERS == */
hcl_oop_function_t initial_function;
hcl_oop_context_t initial_context; /* fake initial context */
@ -1493,6 +1503,34 @@ struct hcl_t
} p;
/* == PRINTER == */
struct
{
hcl_gchdr_t* b; /* object blocks allocated */
struct
{
hcl_gchdr_t* curr;
hcl_gchdr_t* prev;
} ls;
hcl_oow_t bsz; /* total size of object blocks allocated */
hcl_oow_t threshold;
int lazy_sweep;
struct
{
hcl_oop_t* ptr;
hcl_oow_t capa;
hcl_oow_t len;
hcl_oow_t max;
} stack;
struct
{
hcl_ntime_t alloc;
hcl_ntime_t mark;
hcl_ntime_t sweep;
} stat;
} gci;
#if defined(HCL_INCLUDE_COMPILER)
hcl_compiler_t* c;
#endif
@ -1797,7 +1835,8 @@ HCL_EXPORT void hcl_deregcb (
* It is not affected by #HCL_TRAIT_NOGC.
*/
HCL_EXPORT void hcl_gc (
hcl_t* hcl
hcl_t* hcl,
int full
);
@ -1812,12 +1851,6 @@ hcl_oop_t hcl_moveoop (
hcl_oop_t oop
);
HCL_EXPORT hcl_oow_t hcl_getpayloadbytes (
hcl_t* hcl,
hcl_oop_t oop
);
HCL_EXPORT hcl_oop_t hcl_shallowcopy (
hcl_t* hcl,
hcl_oop_t oop
@ -1974,16 +2007,16 @@ HCL_EXPORT void hcl_setsynerrufmt (
/* =========================================================================
* TEMPORARY OOP MANAGEMENT FUNCTIONS
* ========================================================================= */
HCL_EXPORT void hcl_pushtmp (
HCL_EXPORT void hcl_pushvolat (
hcl_t* hcl,
hcl_oop_t* oop_ptr
);
HCL_EXPORT void hcl_poptmp (
HCL_EXPORT void hcl_popvolat (
hcl_t* hcl
);
HCL_EXPORT void hcl_poptmps (
HCL_EXPORT void hcl_popvolats (
hcl_t* hcl,
hcl_oow_t count
);

85
lib/heap.c
View File

@ -26,55 +26,96 @@
#include "hcl-prv.h"
static void* xma_alloc (hcl_mmgr_t* mmgr, hcl_oow_t size)
{
return hcl_xma_alloc(mmgr->ctx, size);
}
static void* xma_realloc (hcl_mmgr_t* mmgr, void* ptr, hcl_oow_t size)
{
return hcl_xma_realloc(mmgr->ctx, ptr, size);
}
static void xma_free (hcl_mmgr_t* mmgr, void* ptr)
{
return hcl_xma_free (mmgr->ctx, ptr);
}
hcl_heap_t* hcl_makeheap (hcl_t* hcl, hcl_oow_t size)
{
hcl_heap_t* heap;
heap = (hcl_heap_t*)hcl->vmprim.alloc_heap(hcl, HCL_SIZEOF(*heap) + size);
if (!heap)
if (HCL_UNLIKELY(!heap))
{
hcl_seterrnum (hcl, HCL_ESYSMEM);
const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to allocate a heap - %js", oldmsg);
return HCL_NULL;
}
HCL_MEMSET (heap, 0, HCL_SIZEOF(*heap) + size);
heap->base = (hcl_uint8_t*)(heap + 1);
/* adjust the initial allocation pointer to a multiple of the oop size */
heap->ptr = (hcl_uint8_t*)HCL_ALIGN(((hcl_uintptr_t)heap->base), HCL_SIZEOF(hcl_oop_t));
heap->limit = heap->base + size;
heap->size = size;
HCL_ASSERT (hcl, heap->ptr >= heap->base);
HCL_ASSERT (hcl, heap->limit >= heap->base );
HCL_ASSERT (hcl, heap->limit - heap->base == size);
/* if size is too small, heap->ptr may go past heap->limit even at
* this moment depending on the alignment of heap->base. subsequent
* calls to subhcl_allocheapmem() are bound to fail. Make sure to
* pass a heap size large enough */
if (size <= 0)
{
/* use the existing memory allocator */
heap->xmmgr = *hcl_getmmgr(hcl);
}
else
{
/* create a new memory allocator over the allocated heap */
heap->xma = hcl_xma_open(hcl_getmmgr(hcl), 0, heap->base, heap->size);
if (HCL_UNLIKELY(!heap->xma))
{
hcl->vmprim.free_heap (hcl, heap);
hcl_seterrbfmt (hcl, HCL_ESYSMEM, "unable to allocate xma");
return HCL_NULL;
}
heap->xmmgr.alloc = xma_alloc;
heap->xmmgr.realloc = xma_realloc;
heap->xmmgr.free = xma_free;
heap->xmmgr.ctx = heap->xma;
}
return heap;
}
void hcl_killheap (hcl_t* hcl, hcl_heap_t* heap)
{
if (heap->xma) hcl_xma_close (heap->xma);
hcl->vmprim.free_heap (hcl, heap);
}
void* hcl_allocheapmem (hcl_t* hcl, hcl_heap_t* heap, hcl_oow_t size)
void* hcl_callocheapmem (hcl_t* hcl, hcl_heap_t* heap, hcl_oow_t size)
{
hcl_uint8_t* ptr;
void* ptr;
/* check the heap size limit */
if (heap->ptr >= heap->limit || heap->limit - heap->ptr < size)
ptr = HCL_MMGR_ALLOC(&heap->xmmgr, size);
if (HCL_UNLIKELY(!ptr))
{
HCL_DEBUG2 (hcl, "Cannot callocate %zd bytes from heap - ptr %p\n", size, heap);
hcl_seterrnum (hcl, HCL_EOOMEM);
return HCL_NULL;
}
/* allocation is as simple as moving the heap pointer */
ptr = heap->ptr;
heap->ptr += size;
else
{
HCL_MEMSET (ptr, 0, size);
}
return ptr;
}
void* hcl_callocheapmem_noerr (hcl_t* hcl, hcl_heap_t* heap, hcl_oow_t size)
{
void* ptr;
ptr = HCL_MMGR_ALLOC(&heap->xmmgr, size);
if (HCL_LIKELY(ptr)) HCL_MEMSET (ptr, 0, size);
return ptr;
}
void hcl_freeheapmem (hcl_t* hcl, hcl_heap_t* heap, void* ptr)
{
HCL_MMGR_FREE (&heap->xmmgr, ptr);
}

32
lib/number.c
View File

@ -127,17 +127,17 @@ hcl_oop_t hcl_addnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
{
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
return HCL_NULL;
}
v = hcl_addints(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!v) return HCL_NULL;
return hcl_makefpdec(hcl, v, scale);
@ -156,17 +156,17 @@ hcl_oop_t hcl_subnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
{
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
return HCL_NULL;
}
v = hcl_subints(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
if (!v) return HCL_NULL;
return hcl_makefpdec(hcl, v, scale);
@ -269,19 +269,19 @@ hcl_oop_t hcl_divnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
nv = xv;
hcl_pushtmp (hcl, &yv);
hcl_pushvolat (hcl, &yv);
for (i = 0; i < ys; i++)
{
nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10));
if (!nv)
{
hcl_poptmp (hcl);
hcl_popvolat (hcl);
return HCL_NULL;
}
}
nv = hcl_divints(hcl, nv, yv, 0, HCL_NULL);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!nv) return HCL_NULL;
return hcl_makefpdec(hcl, nv, xs);
@ -299,17 +299,17 @@ static hcl_oop_t comp_nums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, hcl_oop_t (*co
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
hcl_pushvolat (hcl, &x);
hcl_pushvolat (hcl, &y);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
{
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
return HCL_NULL;
}
v = comper(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
return v;
}
}
@ -362,7 +362,7 @@ hcl_oop_t hcl_sqrtnum (hcl_t* hcl, hcl_oop_t x)
v = hcl_mulints(hcl, v, HCL_SMOOI_TO_OOP(10));
if (!v)
{
hcl_poptmp (hcl);
hcl_popvolat (hcl);
return HCL_NULL;
}
}

109
lib/obj.c
View File

@ -26,29 +26,88 @@
#include "hcl-prv.h"
void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size)
{
hcl_uint8_t* ptr;
#if defined(HCL_BUILD_DEBUG)
if ((hcl->option.trait & HCL_TRAIT_DEBUG_GC) && !(hcl->option.trait & HCL_TRAIT_NOGC)) hcl_gc (hcl);
#if defined(HCL_PROFILE_VM)
#include <sys/time.h>
#include <sys/resource.h> /* getrusage */
#endif
ptr = (hcl_uint8_t*)hcl_allocheapmem(hcl, hcl->curheap, size);
if (!ptr && hcl->errnum == HCL_EOOMEM && !(hcl->option.trait & HCL_TRAIT_NOGC))
void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size)
{
hcl_gchdr_t* gch;
hcl_oow_t allocsize;
int gc_called = 0;
#if defined(HCL_BUILD_DEBUG)
if ((hcl->option.trait & HCL_TRAIT_DEBUG_GC) && !(hcl->option.trait & HCL_TRAIT_NOGC)) hcl_gc (hcl, 1);
#endif
#if defined(HCL_PROFILE_VM)
struct rusage ru;
hcl_ntime_t rut;
getrusage(RUSAGE_SELF, &ru);
HCL_INIT_NTIME (&rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
#endif
allocsize = HCL_SIZEOF(*gch) + size;
if (hcl->gci.bsz >= hcl->gci.threshold)
{
hcl_gc (hcl);
HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO,
"GC completed - current heap ptr %p limit %p size %zd free %zd\n",
hcl->curheap->ptr, hcl->curheap->limit,
(hcl_oow_t)(hcl->curheap->limit - hcl->curheap->base),
(hcl_oow_t)(hcl->curheap->limit - hcl->curheap->ptr)
);
ptr = (hcl_uint8_t*)hcl_allocheapmem (hcl, hcl->curheap, size);
/* TODO: grow heap if ptr is still null. */
hcl_gc (hcl, 0);
hcl->gci.threshold = hcl->gci.bsz + 100000; /* TODO: change this fomula */
gc_called = 1;
}
return ptr;
if (hcl->gci.lazy_sweep) hcl_gc_ms_sweep_lazy (hcl, allocsize);
gch = (hcl_gchdr_t*)hcl_callocheapmem_noerr(hcl, hcl->heap, allocsize);
if (!gch)
{
if (HCL_UNLIKELY(hcl->option.trait & HCL_TRAIT_NOGC)) goto calloc_heapmem_fail;
if (gc_called) goto sweep_the_rest;
hcl_gc (hcl, 0);
if (hcl->gci.lazy_sweep) hcl_gc_ms_sweep_lazy (hcl, allocsize);
gch = (hcl_gchdr_t*)hcl_callocheapmem_noerr(hcl, hcl->heap, allocsize);
if (HCL_UNLIKELY(!gch))
{
sweep_the_rest:
if (hcl->gci.lazy_sweep)
{
hcl_gc_ms_sweep_lazy (hcl, HCL_TYPE_MAX(hcl_oow_t)); /* sweep the rest */
gch = (hcl_gchdr_t*)hcl_callocheapmem(hcl, hcl->heap, allocsize);
if (HCL_UNLIKELY(!gch)) return HCL_NULL;
}
else
{
calloc_heapmem_fail:
hcl_seterrnum (hcl, HCL_EOOMEM);
return HCL_NULL;
}
}
}
if (hcl->gci.lazy_sweep && hcl->gci.ls.curr == hcl->gci.b)
{
/* if the lazy sweeping point is at the beginning of the allocation block,
* hcl->gc.ls.prev must get updated */
HCL_ASSERT (hcl, hcl->gci.ls.prev == HCL_NULL);
hcl->gci.ls.prev = gch;
}
gch->next = hcl->gci.b;
hcl->gci.b = gch;
hcl->gci.bsz += size;
#if defined(HCL_PROFILE_VM)
getrusage(RUSAGE_SELF, &ru);
HCL_SUB_NTIME_SNS (&rut, &rut, ru.ru_utime.tv_sec, HCL_USEC_TO_NSEC(ru.ru_utime.tv_usec));
HCL_SUB_NTIME (&hcl->gci.stat.alloc, &hcl->gci.stat.alloc, &rut); /* do subtraction because rut is negative */
#endif
return (hcl_uint8_t*)(gch + 1);
}
static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t size, int ngc)
@ -149,7 +208,7 @@ static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const vo
hdr = (hcl_oop_t)hcl_callocmem(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
else
hdr = (hcl_oop_t)hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
if (!hdr) return HCL_NULL;
if (HCL_UNLIKELY(!hdr)) return HCL_NULL;
hdr->_flags = HCL_OBJ_MAKE_FLAGS(type, unit, extra, 0, 0, ngc, 0, 0);
hdr->_size = len;
@ -235,8 +294,8 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr)
{
hcl_oop_cons_t cons;
hcl_pushtmp (hcl, &car);
hcl_pushtmp (hcl, &cdr);
hcl_pushvolat (hcl, &car);
hcl_pushvolat (hcl, &cdr);
cons = (hcl_oop_cons_t)hcl_allocoopobj(hcl, HCL_BRAND_CONS, 2);
if (cons)
@ -245,7 +304,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr)
cons->cdr = cdr;
}
hcl_poptmps (hcl, 2);
hcl_popvolats (hcl, 2);
return (hcl_oop_t)cons;
}
@ -281,9 +340,9 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale)
return HCL_NULL;
}
hcl_pushtmp (hcl, &value);
hcl_pushvolat (hcl, &value);
f = (hcl_oop_fpdec_t)hcl_allocoopobj (hcl, HCL_BRAND_FPDEC, HCL_FPDEC_NAMED_INSTVARS);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!f) return HCL_NULL;
@ -313,7 +372,7 @@ hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
HCL_ASSERT (hcl, !obj || (HCL_OOP_IS_POINTER(obj) && HCL_OBJ_GET_FLAGS_NGC(obj)));
/* no hcl_pushtmp() is needed because 'obj' is a non-GC object. */
/* no hcl_pushvolat() is needed because 'obj' is a non-GC object. */
/* TODO: improve this by using realloc */
tmp = hcl_makengcbytearray (hcl, HCL_NULL, newsize);
@ -341,7 +400,7 @@ hcl_oop_t hcl_remakengcarray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
HCL_ASSERT (hcl, !obj || (HCL_OOP_IS_POINTER(obj) && HCL_OBJ_GET_FLAGS_NGC(obj)));
/* no hcl_pushtmp() is needed because 'obj' is a non-GC object. */
/* no hcl_pushvolat() is needed because 'obj' is a non-GC object. */
/* TODO: improve this by using realloc */
tmp = hcl_makengcarray (hcl, newsize);

16
lib/prim.c
View File

@ -219,7 +219,7 @@ static hcl_pfrc_t pf_sprintf (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_gc (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_gc (hcl);
hcl_gc (hcl, 1);
HCL_STACK_SETRET (hcl, nargs, hcl->_nil);
return HCL_PF_SUCCESS;
}
@ -850,17 +850,17 @@ int hcl_addbuiltinprims (hcl_t* hcl)
for (i = 0; i < HCL_COUNTOF(builtin_prims); i++)
{
prim = hcl_makeprim(hcl, builtin_prims[i].impl, builtin_prims[i].minargs, builtin_prims[i].maxargs, HCL_NULL);
if (!prim) return -1;
if (HCL_UNLIKELY(!prim)) return -1;
hcl_pushtmp (hcl, &prim);
hcl_pushvolat (hcl, &prim);
name = hcl_makesymbol(hcl, builtin_prims[i].name, builtin_prims[i].namelen);
hcl_poptmp (hcl);
if (!name) return -1;
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!name)) return -1;
hcl_pushtmp (hcl, &name);
hcl_pushvolat (hcl, &name);
cons = hcl_putatsysdic(hcl, name, prim);
hcl_poptmp (hcl);
if (!cons) return -1;
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!cons)) return -1;
/* turn on the kernel bit in the symbol associated with a primitive
* function. 'set' prevents this symbol from being used as a variable

16
lib/read.c
View File

@ -1479,9 +1479,9 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
count++;
}
hcl_pushtmp (hcl, &head);
hcl_pushvolat (hcl, &head);
arr = (hcl_oop_oop_t)hcl_makearray(hcl, count, 0);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!arr) return HCL_NULL;
ptr = head;
@ -1692,9 +1692,9 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_oop_t obj)
return HCL_NULL;
}
hcl_pushtmp (hcl, (hcl_oop_t*)&rsa);
hcl_pushvolat (hcl, (hcl_oop_t*)&rsa);
cons = hcl_makecons(hcl, obj, hcl->_nil);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!cons) return HCL_NULL;
if (HCL_IS_NIL(hcl, rsa->slot[0]))
@ -2094,7 +2094,7 @@ static int read_object (hcl_t* hcl)
return -1;
}
hcl_pushtmp (hcl, &obj);
hcl_pushvolat (hcl, &obj);
switch (pfbase->type)
{
case HCL_PFBASE_FUNC:
@ -2115,17 +2115,17 @@ static int read_object (hcl_t* hcl)
break;
default:
hcl_poptmp (hcl);
hcl_popvolat (hcl);
hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid pfbase type - %d\n", pfbase->type);
return -1;
}
if (!val || !hcl_putatsysdic(hcl, obj, val))
{
hcl_poptmp (hcl);
hcl_popvolat (hcl);
return -1;
}
hcl_poptmp (hcl);
hcl_popvolat (hcl);
/* make this dotted symbol special that it can't get changed
* to a different value */

4
lib/sym.c
View File

@ -60,9 +60,9 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
newsz = oldsz + inc;
}
hcl_pushtmp (hcl, (hcl_oop_t*)&oldbuc);
hcl_pushvolat (hcl, (hcl_oop_t*)&oldbuc);
newbuc = (hcl_oop_oop_t)hcl_makearray(hcl, newsz, 0);
hcl_poptmp (hcl);
hcl_popvolat (hcl);
if (!newbuc) return HCL_NULL;
while (oldsz > 0)

1
mod/sys.c
View File

@ -108,7 +108,6 @@ static hcl_pfrc_t pf_sys_random (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfinfo_t pfinfos[] =
{
/*{ { 'V','A','R','\0' }, { HCL_PFBASE_VAR, HCL_NULL, 0, 0 } },*/
{ { 'r','a','n','d','o','m','\0' }, { HCL_PFBASE_FUNC, pf_sys_random, 0, 0 } },
{ { 's','r','a','n','d','o','m','\0' }, { HCL_PFBASE_FUNC, pf_sys_srandom, 1, 1 } },
{ { 's','t','i','m','e','\0' }, { HCL_PFBASE_FUNC, pf_sys_stime, 1, 1 } },