From 11e831bbcc509bc827ecf644cd3c524d78a2275c Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Thu, 31 Dec 2020 17:48:47 +0000 Subject: [PATCH] switching GC from semi-space copying to mark-sweep --- lib/bigint.c | 224 +++++++++++++------------- lib/dic.c | 22 +-- lib/exec.c | 55 +++++-- lib/fmt.c | 4 +- lib/gc.c | 439 ++++++++++++++++++++++++++++++++++++++++---------- lib/hcl-prv.h | 42 +++-- lib/hcl.c | 50 ++++-- lib/hcl.h | 75 ++++++--- lib/heap.c | 85 +++++++--- lib/number.c | 32 ++-- lib/obj.c | 109 ++++++++++--- lib/prim.c | 16 +- lib/read.c | 16 +- lib/sym.c | 4 +- mod/sys.c | 1 - 15 files changed, 826 insertions(+), 348 deletions(-) diff --git a/lib/bigint.c b/lib/bigint.c index 69e936a..f03f5b1 100644 --- a/lib/bigint.c +++ b/lib/bigint.c @@ -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; } diff --git a/lib/dic.c b/lib/dic.c index b43e932..5ce9d6e 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -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; } diff --git a/lib/exec.c b/lib/exec.c index a0c2288..93fb38e 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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; } diff --git a/lib/fmt.c b/lib/fmt.c index 56422ab..46a056c 100644 --- a/lib/fmt.c +++ b/lib/fmt.c @@ -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); diff --git a/lib/gc.c b/lib/gc.c index 4d2d4f4..2594c2c 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -26,6 +26,11 @@ #include "hcl-prv.h" +#if defined(HCL_PROFILE_VM) +#include +#include /* 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; } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index d7dc10b..e7b58bc 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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 */ /* ========================================================================= */ diff --git a/lib/hcl.c b/lib/hcl.c index 509398b..7716194 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -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) diff --git a/lib/hcl.h b/lib/hcl.h index 6dc577d..638ba56 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -27,8 +27,9 @@ #ifndef _HCL_H_ #define _HCL_H_ -#include "hcl-cmn.h" -#include "hcl-rbt.h" +#include +#include +#include #include /* 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 ); diff --git a/lib/heap.c b/lib/heap.c index d14ac79..28a221b 100644 --- a/lib/heap.c +++ b/lib/heap.c @@ -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); +} diff --git a/lib/number.c b/lib/number.c index 9c17b36..917d118 100644 --- a/lib/number.c +++ b/lib/number.c @@ -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; } } diff --git a/lib/obj.c b/lib/obj.c index b3c7585..941b51e 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -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 +#include /* 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); diff --git a/lib/prim.c b/lib/prim.c index 99b99bb..bbd8b5c 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -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 diff --git a/lib/read.c b/lib/read.c index 38852bb..c03f757 100644 --- a/lib/read.c +++ b/lib/read.c @@ -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 */ diff --git a/lib/sym.c b/lib/sym.c index 08a57ad..0066961 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -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) diff --git a/mod/sys.c b/mod/sys.c index 4b60f97..709113e 100644 --- a/mod/sys.c +++ b/mod/sys.c @@ -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 } },