diff --git a/lib/bigint.c b/lib/bigint.c index 7a101be..c7f6cf8 100644 --- a/lib/bigint.c +++ b/lib/bigint.c @@ -73,6 +73,9 @@ static const hcl_uint8_t debruijn_64[64] = 50, 31, 19, 15, 30, 14, 13, 12 }; +#define make_pbigint(hcl, ptr, len) (hcl_instantiate(hcl, hcl->c_large_positive_integer, ptr, len)) +#define make_nbigint(hcl, ptr, len) (hcl_instantiate(hcl, hcl->c_large_negative_integer, ptr, len)) + #if defined(HCL_HAVE_UINT32_T) # define LOG2_FOR_POW2_32(x) (debruijn_32[(hcl_uint32_t)((hcl_uint32_t)(x) * 0x077CB531) >> 27]) #endif @@ -531,12 +534,12 @@ static HCL_INLINE hcl_oop_t make_bigint_with_oow (hcl_t* hcl, hcl_oow_t w) { #if (HCL_LIW_BITS == HCL_OOW_BITS) HCL_ASSERT (hcl, HCL_SIZEOF(hcl_oow_t) == HCL_SIZEOF(hcl_liw_t)); - return hcl_makebigint(hcl, HCL_BRAND_PBIGINT, &w, 1); + return make_pbigint(hcl, &w, 1); #elif (HCL_LIW_BITS == HCL_OOHW_BITS) hcl_liw_t hw[2]; hw[0] = w /*& HCL_LBMASK(hcl_oow_t,HCL_LIW_BITS)*/; hw[1] = w >> HCL_LIW_BITS; - return hcl_makebigint(hcl, HCL_BRAND_PBIGINT, hw, (hw[1] > 0? 2: 1)); + return make_pbigint(hcl, hw, (hw[1] > 0? 2: 1)); #else # error UNSUPPORTED LIW BIT SIZE #endif @@ -551,12 +554,12 @@ static HCL_INLINE hcl_oop_t make_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t i) if (i >= 0) { w = i; - return hcl_makebigint(hcl, HCL_BRAND_PBIGINT, &w, 1); + return make_pbigint(hcl, &w, 1); } else { w = (i == HCL_TYPE_MIN(hcl_ooi_t))? ((hcl_oow_t)HCL_TYPE_MAX(hcl_ooi_t) + 1): -i; - return hcl_makebigint(hcl, HCL_BRAND_NBIGINT, &w, 1); + return make_nbigint(hcl, &w, 1); } #elif (HCL_LIW_BITS == HCL_OOHW_BITS) hcl_liw_t hw[2]; @@ -568,7 +571,7 @@ static HCL_INLINE hcl_oop_t make_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t i) w = i; hw[0] = w /*& HCL_LBMASK(hcl_oow_t,HCL_LIW_BITS)*/; hw[1] = w >> HCL_LIW_BITS; - return hcl_makebigint(hcl, HCL_BRAND_PBIGINT, hw, (hw[1] > 0? 2: 1)); + return make_pbigint(hcl, hw, (hw[1] > 0? 2: 1)); } else { @@ -576,7 +579,7 @@ static HCL_INLINE hcl_oop_t make_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t i) w = (i == HCL_TYPE_MIN(hcl_ooi_t))? ((hcl_oow_t)HCL_TYPE_MAX(hcl_ooi_t) + 1): -i; hw[0] = w /*& HCL_LBMASK(hcl_oow_t,HCL_LIW_BITS)*/; hw[1] = w >> HCL_LIW_BITS; - return hcl_makebigint(hcl, HCL_BRAND_NBIGINT, hw, (hw[1] > 0? 2: 1)); + return make_nbigint(hcl, hw, (hw[1] > 0? 2: 1)); } #else # error UNSUPPORTED LIW BIT SIZE @@ -594,12 +597,12 @@ static HCL_INLINE hcl_oop_t make_bloated_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t if (i >= 0) { w = i; - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, 1 + extra); + z = make_pbigint(hcl, HCL_NULL, 1 + extra); } else { w = (i == HCL_TYPE_MIN(hcl_ooi_t))? ((hcl_oow_t)HCL_TYPE_MAX(hcl_ooi_t) + 1): -i; - z = hcl_makebigint(hcl, HCL_BRAND_NBIGINT, HCL_NULL, 1 + extra); + z = make_nbigint(hcl, HCL_NULL, 1 + extra); } if (!z) return HCL_NULL; @@ -617,14 +620,14 @@ static HCL_INLINE hcl_oop_t make_bloated_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t w = i; hw[0] = w /*& HCL_LBMASK(hcl_oow_t,HCL_LIW_BITS)*/; hw[1] = w >> HCL_LIW_BITS; - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, (hw[1] > 0? 2: 1) + extra); + z = make_pbigint(hcl, HCL_NULL, (hw[1] > 0? 2: 1) + extra); } else { w = (i == HCL_TYPE_MIN(hcl_ooi_t))? ((hcl_oow_t)HCL_TYPE_MAX(hcl_ooi_t) + 1): -i; hw[0] = w /*& HCL_LBMASK(hcl_oow_t,HCL_LIW_BITS)*/; hw[1] = w >> HCL_LIW_BITS; - z = hcl_makebigint(hcl, HCL_BRAND_NBIGINT, HCL_NULL, (hw[1] > 0? 2: 1) + extra); + z = make_nbigint(hcl, HCL_NULL, (hw[1] > 0? 2: 1) + extra); } if (!z) return HCL_NULL; @@ -641,7 +644,7 @@ static HCL_INLINE hcl_oop_t make_bigint_with_intmax (hcl_t* hcl, hcl_intmax_t v) hcl_oow_t len; hcl_liw_t buf[HCL_SIZEOF_INTMAX_T / HCL_SIZEOF_LIW_T]; hcl_uintmax_t ui; - int brand; + hcl_oop_class_t _class; /* this is not a generic function. it can't handle v * if it's HCL_TYPE_MIN(hcl_intmax_t) */ @@ -650,12 +653,12 @@ static HCL_INLINE hcl_oop_t make_bigint_with_intmax (hcl_t* hcl, hcl_intmax_t v) if (v >= 0) { ui = v; - brand = HCL_BRAND_PBIGINT; + _class = hcl->c_large_positive_integer; } else { ui = (v == HCL_TYPE_MIN(hcl_intmax_t))? ((hcl_uintmax_t)HCL_TYPE_MAX(hcl_intmax_t) + 1): -v; - brand = HCL_BRAND_NBIGINT; + _class = hcl->c_large_negative_integer; } len = 0; @@ -666,7 +669,7 @@ static HCL_INLINE hcl_oop_t make_bigint_with_intmax (hcl_t* hcl, hcl_intmax_t v) } while (ui > 0); - return hcl_makebigint(hcl, brand, buf, len); + return hcl_instantiate(hcl, _class, buf, len); } static HCL_INLINE hcl_oop_t make_bigint_with_uintmax (hcl_t* hcl, hcl_uintmax_t ui) @@ -682,7 +685,7 @@ static HCL_INLINE hcl_oop_t make_bigint_with_uintmax (hcl_t* hcl, hcl_uintmax_t } while (ui > 0); - return hcl_makebigint(hcl, HCL_BRAND_PBIGINT, buf, len); + return make_pbigint(hcl, buf, len); } hcl_oop_t hcl_oowtoint (hcl_t* hcl, hcl_oow_t w) @@ -750,14 +753,19 @@ static HCL_INLINE hcl_oop_t expand_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t if (inc > HCL_OBJ_SIZE_MAX - count) { - hcl_seterrnum (hcl, HCL_EOOMEM); /* TODO: is it a soft failure or a hard failure? is this error code proper? */ + hcl_seterrbfmt (hcl, HCL_EOOMEM, "unable to expand bigint %O by %zu liwords", oop, inc); /* TODO: is it a soft failure or a hard failure? is this error code proper? */ return HCL_NULL; } hcl_pushvolat (hcl, &oop); - z = hcl_makebigint(hcl, HCL_OBJ_GET_FLAGS_BRAND(oop), HCL_NULL, count + inc); + z = hcl_instantiate(hcl, HCL_OBJ_GET_CLASS(oop), HCL_NULL, count + inc); hcl_popvolat (hcl); - if (!z) return HCL_NULL; + if (!z) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to clone bigint %O for expansion - %s", oop, orgmsg); + return HCL_NULL; + } for (i = 0; i < count; i++) { @@ -766,7 +774,7 @@ static HCL_INLINE hcl_oop_t expand_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t return z; } -static HCL_INLINE hcl_oop_t _clone_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t count, int brand) +static HCL_INLINE hcl_oop_t _clone_bigint(hcl_t* hcl, hcl_oop_t oop, hcl_oow_t count, hcl_oop_class_t _class) { hcl_oop_t z; hcl_oow_t i; @@ -774,8 +782,10 @@ 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_pushvolat (hcl, &_class); hcl_pushvolat (hcl, &oop); - z = hcl_makebigint(hcl, brand, HCL_NULL, count); + z = hcl_instantiate(hcl, _class, HCL_NULL, count); + hcl_popvolat (hcl); hcl_popvolat (hcl); if (!z) return HCL_NULL; @@ -788,31 +798,31 @@ static HCL_INLINE hcl_oop_t _clone_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t static HCL_INLINE hcl_oop_t clone_bigint (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t count) { - return _clone_bigint (hcl, oop, count, HCL_OBJ_GET_FLAGS_BRAND(oop)); + return _clone_bigint(hcl, oop, count, HCL_OBJ_GET_CLASS(oop)); } static HCL_INLINE hcl_oop_t clone_bigint_negated (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t count) { - int brand; + hcl_oop_class_t _class; HCL_ASSERT (hcl, HCL_IS_BIGINT(hcl,oop)); if (HCL_IS_PBIGINT(hcl, oop)) { - brand = HCL_BRAND_NBIGINT; + _class = hcl->c_large_negative_integer; } else { HCL_ASSERT (hcl, HCL_IS_NBIGINT(hcl, oop)); - brand = HCL_BRAND_PBIGINT; + _class = hcl->c_large_positive_integer; } - return _clone_bigint (hcl, oop, count, brand); + return _clone_bigint(hcl, oop, count, _class); } static HCL_INLINE hcl_oop_t clone_bigint_to_positive (hcl_t* hcl, hcl_oop_t oop, hcl_oow_t count) { - return _clone_bigint (hcl, oop, count, HCL_BRAND_PBIGINT); + return _clone_bigint(hcl, oop, count, hcl->c_large_positive_integer); } static HCL_INLINE hcl_oow_t count_effective (hcl_liw_t* x, hcl_oow_t xs) @@ -902,7 +912,7 @@ static hcl_oop_t normalize_bigint (hcl_t* hcl, hcl_oop_t oop) return oop; } - return clone_bigint (hcl, oop, count); + return clone_bigint(hcl, oop, count); } static HCL_INLINE int is_less_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs, const hcl_liw_t* y, hcl_oow_t ys) @@ -2121,7 +2131,7 @@ static hcl_oop_t add_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); - z = hcl_makebigint(hcl, HCL_OBJ_GET_FLAGS_BRAND(x), HCL_NULL, zs); + z = hcl_instantiate(hcl, HCL_OBJ_GET_CLASS(x), HCL_NULL, zs); hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; @@ -2142,7 +2152,7 @@ static hcl_oop_t subtract_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(x)); + z = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(x)); hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; @@ -2169,7 +2179,7 @@ static hcl_oop_t multiply_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, xs + ys); + z = make_pbigint(hcl, HCL_NULL, xs + ys); hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; @@ -2233,11 +2243,11 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, /*#define USE_DIVIDE_UNSIGNED_ARRAY3*/ #if defined(USE_DIVIDE_UNSIGNED_ARRAY3) - qq = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(x) + 2); + qq = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(x) + 2); #elif defined(USE_DIVIDE_UNSIGNED_ARRAY2) - qq = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(x) + 1); + qq = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(x) + 1); #else - qq = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(x)); + qq = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(x)); #endif if (!qq) { @@ -2247,11 +2257,11 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, hcl_pushvolat (hcl, &qq); #if defined(USE_DIVIDE_UNSIGNED_ARRAY3) - rr = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(y)); + rr = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(y)); #elif defined(USE_DIVIDE_UNSIGNED_ARRAY2) - rr = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(y)); + rr = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(y)); #else - rr = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(y) + 1); + rr = make_pbigint(hcl, HCL_NULL, HCL_OBJ_GET_SIZE(y) + 1); #endif hcl_popvolats (hcl, 3); if (!rr) return HCL_NULL; @@ -2301,7 +2311,7 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl,y)) goto oops_einval; v = HCL_OOP_TO_SMOOI(x); - if (v == 0) return clone_bigint (hcl, y, HCL_OBJ_GET_SIZE(y)); + if (v == 0) return clone_bigint(hcl, y, HCL_OBJ_GET_SIZE(y)); hcl_pushvolat (hcl, &y); x = make_bigint_with_ooi (hcl, v); @@ -2313,7 +2323,7 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl,x)) goto oops_einval; v = HCL_OOP_TO_SMOOI(y); - if (v == 0) return clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x)); + if (v == 0) return clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x)); hcl_pushvolat (hcl, &x); y = make_bigint_with_ooi (hcl, v); @@ -2408,7 +2418,7 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (v == 0) { /* switch the sign to the opposite and return it */ - return clone_bigint_negated (hcl, y, HCL_OBJ_GET_SIZE(y)); + return clone_bigint_negated(hcl, y, HCL_OBJ_GET_SIZE(y)); } hcl_pushvolat (hcl, &y); @@ -2421,7 +2431,7 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl,x)) goto oops_einval; v = HCL_OOP_TO_SMOOI(y); - if (v == 0) return clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x)); + if (v == 0) return clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x)); hcl_pushvolat (hcl, &x); y = make_bigint_with_ooi (hcl, v); @@ -2523,9 +2533,9 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) case 0: return HCL_SMOOI_TO_OOP(0); case 1: - return clone_bigint (hcl, y, HCL_OBJ_GET_SIZE(y)); + return clone_bigint(hcl, y, HCL_OBJ_GET_SIZE(y)); case -1: - return clone_bigint_negated (hcl, y, HCL_OBJ_GET_SIZE(y)); + return clone_bigint_negated(hcl, y, HCL_OBJ_GET_SIZE(y)); } hcl_pushvolat (hcl, &y); @@ -2543,9 +2553,9 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) case 0: return HCL_SMOOI_TO_OOP(0); case 1: - return clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x)); + return clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x)); case -1: - return clone_bigint_negated (hcl, x, HCL_OBJ_GET_SIZE(x)); + return clone_bigint_negated(hcl, x, HCL_OBJ_GET_SIZE(x)); } hcl_pushvolat (hcl, &x); @@ -3170,7 +3180,7 @@ hcl_oop_t hcl_bitandints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc); + z = make_pbigint(hcl, HCL_NULL, zalloc); hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; @@ -3390,7 +3400,7 @@ hcl_oop_t hcl_bitorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc); + z = make_pbigint(hcl, HCL_NULL, zalloc); hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; @@ -3608,7 +3618,7 @@ hcl_oop_t hcl_bitxorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc); + z = make_pbigint(hcl, HCL_NULL, zalloc); hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; @@ -3766,7 +3776,7 @@ hcl_oop_t hcl_bitinvint (hcl_t* hcl, hcl_oop_t x) } hcl_pushvolat (hcl, &x); - z = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, zalloc); + z = make_pbigint(hcl, HCL_NULL, zalloc); hcl_popvolat (hcl); if (!z) return HCL_NULL; @@ -3838,7 +3848,7 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint (hcl_t* hcl, hcl_oop_t x, hcl hcl_pushvolat (hcl, &x); /* +1 for the second inversion below */ - z = hcl_makebigint(hcl, HCL_BRAND_NBIGINT, HCL_NULL, xs + 1); + z = make_nbigint(hcl, HCL_NULL, xs + 1); hcl_popvolat (hcl); if (!z) return HCL_NULL; @@ -3981,7 +3991,7 @@ static HCL_INLINE hcl_oop_t rshift_positive_bigint_and_normalize (hcl_t* hcl, hc zs = HCL_OBJ_GET_SIZE(x); hcl_pushvolat (hcl, &y); - z = clone_bigint (hcl, x, zs); + z = clone_bigint(hcl, x, zs); hcl_popvolat (hcl); if (!z) return HCL_NULL; @@ -4192,7 +4202,7 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl,x)) goto oops_einval; v = HCL_OOP_TO_SMOOI(y); - if (v == 0) return clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x)); + if (v == 0) return clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x)); negx = HCL_IS_NBIGINT(hcl, x); if (v > 0) @@ -4279,12 +4289,12 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (negx) { - z = rshift_negative_bigint (hcl, x, shift); + z = rshift_negative_bigint(hcl, x, shift); if (!z) return HCL_NULL; } else { - z = clone_bigint (hcl, x, HCL_OBJ_GET_SIZE(x)); + z = clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x)); if (!z) return HCL_NULL; rshift_unsigned_array (((hcl_oop_liword_t)z)->slot, HCL_OBJ_GET_SIZE(z), shift); } @@ -4504,7 +4514,7 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra # error UNSUPPORTED LIW BIT SIZE #endif - res = hcl_makebigint(hcl, (sign < 0? HCL_BRAND_NBIGINT: HCL_BRAND_PBIGINT), hwp, hwlen); + res = hcl_instantiate(hcl, (sign < 0? hcl->c_large_negative_integer: hcl->c_large_positive_integer), hwp, hwlen); if (hwp && hw != hwp) hcl_freemem (hcl, hwp); return res; @@ -4794,7 +4804,7 @@ hcl_oop_t hcl_absint (hcl_t* hcl, hcl_oop_t x) } else if (HCL_IS_NBIGINT(hcl, x)) { - x = _clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x), HCL_BRAND_PBIGINT); + x = _clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x), hcl->c_large_positive_integer); } else if (HCL_IS_PBIGINT(hcl, x)) { diff --git a/lib/exec.c b/lib/exec.c index 4b9fe4d..b2d5405 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -568,12 +568,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) return HCL_NULL; } -#if 0 -//////////////////// -//// HCL_OBJ_SET_FLAGS_PROC (proc, proc_flags); /* a special flag to indicate an object is a process instance */ -//////////////////// -#endif - + HCL_OBJ_SET_FLAGS_PROC (proc, 1); /* a special flag to indicate an object is a process instance */ proc->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED); /* assign a process id to the process */ diff --git a/lib/gc.c b/lib/gc.c index 85c19fe..78dc814 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -622,7 +622,7 @@ static kernel_class_info_t kernel_classes[__KCI_MAX__] = KCI(KCI_LARGE_POSITIVE_INTEGER) { "LargePositiveInteger", KCI_NUMBER, - 0, + HCL_BRAND_PBIGINT, HCL_CLASS_SELFSPEC_FLAG_LIMITED, 0, 0, @@ -634,7 +634,7 @@ static kernel_class_info_t kernel_classes[__KCI_MAX__] = KCI(KCI_LARGE_NEGATIVE_INTEGER) { "LargeNegativeInteger", KCI_NUMBER, - 0, + HCL_BRAND_NBIGINT, HCL_CLASS_SELFSPEC_FLAG_LIMITED, 0, 0, @@ -870,11 +870,11 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl) /* 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) /* TODO: use a class or make this a special bit???*/ + if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) { hcl_oop_process_t proc; + HCL_ASSERT (hcl, HCL_IS_PROCESS(hcl, oop)); /* the stack in a process object doesn't need to be * scanned in full. the slots above the stack pointer * are garbages. */ @@ -886,13 +886,14 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl) /* stack */ ll = HCL_OOP_TO_SMOOI(proc->sp); - HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); for (i = 0; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]); + /* exception stack */ ll = HCL_OOP_TO_SMOOI(proc->exsp); HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); for (i = HCL_OOP_TO_SMOOI(proc->st) + 1; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]); + /* class stack */ ll = HCL_OOP_TO_SMOOI(proc->clsp); HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); @@ -1818,8 +1819,14 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) { /* Create a nil process used to simplify nil check in GC. * only accessible by VM. not exported via the global dictionary. */ - hcl->nil_process = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS); - if (HCL_UNLIKELY(!hcl->nil_process)) goto oops; + /*hcl->nil_process = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS);*/ + hcl->nil_process = (hcl_oop_process_t)hcl_instantiate(hcl, hcl->c_process, HCL_NULL, 0); + if (HCL_UNLIKELY(!hcl->nil_process)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make nil process - %js", orgmsg); + goto oops; + } /* unusable stack */ hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1); @@ -1834,8 +1841,15 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (!hcl->processor) { - hcl->processor = (hcl_oop_process_scheduler_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS_SCHEDULER, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS); - if (HCL_UNLIKELY(!hcl->processor)) goto oops; + /*hcl->processor = (hcl_oop_process_scheduler_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS_SCHEDULER, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS);*/ + hcl->processor = (hcl_oop_process_scheduler_t)hcl_instantiate(hcl, hcl->c_process_scheduler, HCL_NULL, 0); + if (HCL_UNLIKELY(!hcl->processor)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make process scheduler - %js", orgmsg); + goto oops; + } + hcl->processor->active = hcl->nil_process; hcl->processor->total_count = HCL_SMOOI_TO_OOP(0); hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0); diff --git a/lib/hcl.h b/lib/hcl.h index 954c4d7..43a0fb7 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -370,11 +370,11 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_FLAGS_BRAND_BITS (6) /* 29 */ #define HCL_OBJ_FLAGS_FLEXI_BITS (1) /* 30 */ #define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 31 */ +#define HCL_OBJ_FLAGS_PROC_BITS (1) /* 32 */ /* #define HCL_OBJ_FLAGS_PERM_BITS 1 #define HCL_OBJ_FLAGS_MOVED_BITS 2 -#define HCL_OBJ_FLAGS_PROC_BITS 2 #define HCL_OBJ_FLAGS_GCFIN_BITS 4 #define HCL_OBJ_FLAGS_TRAILER_BITS 1 #define HCL_OBJ_FLAGS_HASH_BITS 2 @@ -391,7 +391,8 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_FLAGS_SYNCODE_SHIFT (HCL_OBJ_FLAGS_BRAND_BITS + HCL_OBJ_FLAGS_BRAND_SHIFT) #define HCL_OBJ_FLAGS_BRAND_SHIFT (HCL_OBJ_FLAGS_FLEXI_BITS + HCL_OBJ_FLAGS_FLEXI_SHIFT) #define HCL_OBJ_FLAGS_FLEXI_SHIFT (HCL_OBJ_FLAGS_RDONLY_BITS + HCL_OBJ_FLAGS_RDONLY_SHIFT) -#define HCL_OBJ_FLAGS_RDONLY_SHIFT (0) +#define HCL_OBJ_FLAGS_RDONLY_SHIFT (HCL_OBJ_FLAGS_PROC_BITS + HCL_OBJ_FLAGS_PROC_SHIFT) +#define HCL_OBJ_FLAGS_PROC_SHIFT (0) #define HCL_OBJ_GET_FLAGS_TYPE(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TYPE_SHIFT, HCL_OBJ_FLAGS_TYPE_BITS) #define HCL_OBJ_GET_FLAGS_UNIT(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_UNIT_SHIFT, HCL_OBJ_FLAGS_UNIT_BITS) @@ -404,6 +405,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_GET_FLAGS_BRAND(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_BRAND_SHIFT, HCL_OBJ_FLAGS_BRAND_BITS) #define HCL_OBJ_GET_FLAGS_FLEXI(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT, HCL_OBJ_FLAGS_FLEXI_BITS) #define HCL_OBJ_GET_FLAGS_RDONLY(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_RDONLY_SHIFT, HCL_OBJ_FLAGS_RDONLY_BITS) +#define HCL_OBJ_GET_FLAGS_PROC(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_PROC_SHIFT, HCL_OBJ_FLAGS_PROC_BITS) #define HCL_OBJ_SET_FLAGS_TYPE(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TYPE_SHIFT, HCL_OBJ_FLAGS_TYPE_BITS, v) #define HCL_OBJ_SET_FLAGS_UNIT(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_UNIT_SHIFT, HCL_OBJ_FLAGS_UNIT_BITS, v) @@ -416,6 +418,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_SET_FLAGS_BRAND(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_BRAND_SHIFT, HCL_OBJ_FLAGS_BRAND_BITS, v) #define HCL_OBJ_SET_FLAGS_FLEXI(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT, HCL_OBJ_FLAGS_FLEXI_BITS, v) #define HCL_OBJ_SET_FLAGS_RDONLY(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_RDONLY_SHIFT, HCL_OBJ_FLAGS_RDONLY_BITS, v) +#define HCL_OBJ_SET_FLAGS_PROC(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_PROC_SHIFT, HCL_OBJ_FLAGS_PROC_BITS, v) #define HCL_OBJ_GET_SIZE(oop) ((oop)->_size) #define HCL_OBJ_GET_CLASS(oop) ((oop)->_class) @@ -2087,55 +2090,58 @@ typedef enum hcl_concode_t hcl_concode_t; #define HCL_IS_FALSE(hcl,v) (v == (hcl)->_false) /*#define HCL_IS_SYMBOL(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL)*/ -#define HCL_IS_SYMBOL(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_symbol) +#define HCL_IS_SYMBOL(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_symbol) /*#define HCL_IS_STRING(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_STRING)*/ -#define HCL_IS_STRING(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_string) +#define HCL_IS_STRING(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_string) /*#define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT)*/ -#define HCL_IS_CONTEXT(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_block_context) +#define HCL_IS_CONTEXT(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_block_context) /*#define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)*/ -#define HCL_IS_FUNCTION(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_function) +#define HCL_IS_FUNCTION(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_function) /*#define HCL_IS_COMPILED_BLOCK(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BLOCK)*/ -#define HCL_IS_COMPILED_BLOCK(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_compiled_block) +#define HCL_IS_COMPILED_BLOCK(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_compiled_block) /*#define HCL_IS_CLASS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CLASS)*/ -#define HCL_IS_CLASS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_class) +#define HCL_IS_CLASS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_class) #define HCL_IS_INSTANCE(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_INSTANCE) /*#define HCL_IS_CONS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONS)*/ -#define HCL_IS_CONS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_cons) +#define HCL_IS_CONS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_cons) #define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode)) /*#define HCL_IS_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_ARRAY)*/ -#define HCL_IS_ARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_array) +#define HCL_IS_ARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_array) /*#define HCL_IS_BYTEARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BYTE_ARRAY)*/ -#define HCL_IS_BYTEARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_byte_array) +#define HCL_IS_BYTEARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_byte_array) /*#define HCL_IS_DIC(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_DIC)*/ -#define HCL_IS_DIC(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_dictionary) +#define HCL_IS_DIC(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_dictionary) /*#define HCL_IS_PRIM(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PRIM)*/ -#define HCL_IS_PRIM(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_primitive) +#define HCL_IS_PRIM(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_primitive) -#define HCL_IS_PBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT) -#define HCL_IS_NBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT) -#define HCL_IS_BIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && (HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT || HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT)) -#define HCL_IS_FPDEC(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FPDEC) +/*#define HCL_IS_PBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT)*/ +#define HCL_IS_PBIGINT(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_large_positive_integer) +/*#define HCL_IS_NBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT)*/ +#define HCL_IS_NBIGINT(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_large_negative_integer) +#define HCL_IS_BIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && (HCL_OBJ_GET_CLASS(v) == (hcl_oop_t)(hcl)->c_large_positive_integer || HCL_OBJ_GET_CLASS(v) == (hcl_oop_t)(hcl)->c_large_negative_integer)) + +/*#define HCL_IS_FPDEC(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FPDEC)*/ +#define HCL_IS_FPDEC(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_fixed_point_decimal) /*#define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS)*/ -#define HCL_IS_PROCESS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_process) - +#define HCL_IS_PROCESS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_process) /*#define HCL_IS_SEMAPHORE(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SEMAPHORE)*/ -#define HCL_IS_SEMAPHORE(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_semaphore) +#define HCL_IS_SEMAPHORE(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_semaphore) /*#define HCL_IS_SEMAPHORE_GROUP(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SEMAPHORE_GROUP)*/ -#define HCL_IS_SEMAPHORE_GROUP(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_semaphore_group) +#define HCL_IS_SEMAPHORE_GROUP(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_semaphore_group) #define HCL_CONS_CAR(v) (((hcl_cons_t*)(v))->car) #define HCL_CONS_CDR(v) (((hcl_cons_t*)(v))->cdr) @@ -2147,7 +2153,6 @@ typedef int (*hcl_dic_walker_t) ( void* ctx ); - typedef int (*hcl_xchg_reader_t) ( hcl_t* hcl, void* buf, @@ -2974,14 +2979,6 @@ HCL_EXPORT hcl_oop_t hcl_makeprim ( hcl_mod_t* mod ); - -HCL_EXPORT hcl_oop_t hcl_makebigint ( - hcl_t* hcl, - int brand, - const hcl_liw_t* ptr, - hcl_oow_t len -); - HCL_EXPORT hcl_oop_t hcl_oowtoint ( hcl_t* hcl, hcl_oow_t w diff --git a/lib/obj.c b/lib/obj.c index eb445d3..9074d35 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -286,30 +286,6 @@ hcl_oop_t hcl_hatchnil (hcl_t* hcl) return v; } -hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t len) -{ - hcl_oop_t v; - -/* TODO: use hcl_instantiate.. */ - HCL_ASSERT (hcl, brand == HCL_BRAND_PBIGINT || brand == HCL_BRAND_NBIGINT); - -#if (HCL_LIW_BITS == HCL_OOW_BITS) - v = hcl_allocwordobj(hcl, brand, ptr, len); -#elif (HCL_LIW_BITS == HCL_OOHW_BITS) - v = hcl_allochalfwordobj(hcl, brand, ptr, len); -#else -# error UNSUPPORTED LIW BIT SIZE -#endif - if (HCL_UNLIKELY(v)) - { - hcl_oop_class_t _class = (brand == HCL_BRAND_PBIGINT)? - hcl->c_large_positive_integer: hcl->c_large_negative_integer; - HCL_OBJ_SET_FLAGS_BRAND (v, brand); - HCL_OBJ_SET_CLASS (v, (hcl_oop_t)_class); - } - return v; -} - hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) { /* TODO: use hcl_instantiate() */ @@ -522,7 +498,8 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale) } hcl_pushvolat (hcl, &value); - f = (hcl_oop_fpdec_t)hcl_allocoopobj(hcl, HCL_BRAND_FPDEC, HCL_FPDEC_NAMED_INSTVARS); + /* f = (hcl_oop_fpdec_t)hcl_allocoopobj(hcl, HCL_BRAND_FPDEC, HCL_FPDEC_NAMED_INSTVARS); */ + f = (hcl_oop_fpdec_t)hcl_instantiate(hcl, hcl->c_fixed_point_decimal, HCL_NULL, 0); hcl_popvolat (hcl); if (HCL_UNLIKELY(!f)) @@ -534,7 +511,6 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale) { f->value = value; f->scale = HCL_SMOOI_TO_OOP(scale); - HCL_OBJ_SET_CLASS (f, (hcl_oop_t)hcl->c_fixed_point_decimal); } return (hcl_oop_t)f; diff --git a/lib/xchg.c b/lib/xchg.c index 00b6249..2ecd6da 100644 --- a/lib/xchg.c +++ b/lib/xchg.c @@ -446,7 +446,7 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void if (nbytes % HCL_SIZEOF(hcl_liw_t)) goto oops; /* not the right number of bytes */ nwords = nbytes / HCL_SIZEOF(hcl_liw_t); - ns = hcl_makebigint(hcl, ((b == HCL_XCHG_PBIGINT)? HCL_BRAND_PBIGINT: HCL_BRAND_NBIGINT), HCL_NULL, nwords); + ns = hcl_instantiate(hcl, ((b == HCL_XCHG_PBIGINT)? hcl->c_large_positive_integer: hcl->c_large_negative_integer), HCL_NULL, nwords); if (HCL_UNLIKELY(!ns)) goto oops; for (j = 0; j < nwords; j ++) @@ -506,7 +506,7 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void if (nbytes % HCL_SIZEOF(hcl_liw_t)) goto oops; /* not the right number of bytes */ nwords = nbytes / HCL_SIZEOF(hcl_liw_t); - v = hcl_makebigint(hcl, ((b == HCL_XCHG_FPDEC_2) ? HCL_BRAND_PBIGINT : HCL_BRAND_NBIGINT), HCL_NULL, nwords); + v = hcl_instantiate(hcl, ((b == HCL_XCHG_FPDEC_2) ? hcl->c_large_positive_integer : hcl->c_large_negative_integer), HCL_NULL, nwords); if (HCL_UNLIKELY(!v)) goto oops; for (j = 0; j < nwords; j++) diff --git a/t/proc-01.hcl b/t/proc-01.hcl index b90eacc..3b05cb3 100644 --- a/t/proc-01.hcl +++ b/t/proc-01.hcl @@ -47,4 +47,3 @@ if (== z1 101) { printf "OK: z1 is %d\n" z1 } \ else { printf "ERROR: z1 is not 101 - %d\n" z1 } if (== z2 100) { printf "OK: z2 is %d\n" z2 } \ else { printf "ERROR: z1 is not 100 - %d\n" z2 } - diff --git a/t/ret-01.hcl b/t/ret-01.hcl index e20683d..595ed1a 100644 --- a/t/ret-01.hcl +++ b/t/ret-01.hcl @@ -1,11 +1,11 @@ -defun repeat(n f) { +fun repeat(n f) { while (> n 0) { f; set n (- n 1); }; }; -defun test-non-local-ret-1(k) { +fun test-non-local-ret-1(k) { repeat 10 (fun() { set k (+ k 2); if (= k 28) { revert k }; @@ -22,8 +22,21 @@ set a (test-non-local-ret-1 21); if (~= a 41) { printf "ERROR: a must be 41\n" } \ else { printf "OK %d\n" a }; +fun dd() { return (- 99999999999999991111111111111111111111111111111111111111.111111111 999999999999999999999999999999.999999999999) } -defun ff() { return 999 }; +fun ee() { return (+ 1111111111111111111111111111111111111111111111111 999999999999999999999999999999999999999999) } + +fun ff() { return 999 }; + +## test a normal block return with a fixed point decimal +set a (dd); +if (~= a 99999999999999991111111110111111111111111111111111111111.111111111001) { printf "ERROR: a must be 99999999999999991111111110111111111111111111111111111111.111111111001\n" } \ +else { printf "OK %f\n" a }; + +## test a normal block return with a large integer +set a (ee); +if (~= a 1111112111111111111111111111111111111111111111110) { printf "ERROR: a must be 1111112111111111111111111111111111111111111111110\n" } \ +else { printf "OK %d\n" a }; ## test a normal block return set a (ff);