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

removed the brand field from the object header
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-09-20 03:14:48 +09:00
parent 41cf6e95ce
commit e81bcbab61
8 changed files with 86 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
lib/bigint.c
View File

@ -938,19 +938,9 @@ static HCL_INLINE int is_less_unsigned (hcl_oop_t x, hcl_oop_t y)
static HCL_INLINE int is_less (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
if (HCL_OBJ_GET_FLAGS_BRAND(x) != HCL_OBJ_GET_FLAGS_BRAND(y))
{
return HCL_IS_NBIGINT(hcl, x);
}
if (HCL_IS_PBIGINT(hcl, x))
{
return is_less_unsigned (x, y);
}
else
{
return is_less_unsigned (y, x);
}
if (HCL_OBJ_GET_CLASS(x) != HCL_OBJ_GET_CLASS(y)) return HCL_IS_NBIGINT(hcl, x);
if (HCL_IS_PBIGINT(hcl, x)) return is_less_unsigned(x, y);
return is_less_unsigned (y, x);
}
static HCL_INLINE int is_greater_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs, const hcl_liw_t* y, hcl_oow_t ys)
@ -976,19 +966,9 @@ static HCL_INLINE int is_greater_unsigned (hcl_oop_t x, hcl_oop_t y)
static HCL_INLINE int is_greater (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
if (HCL_OBJ_GET_FLAGS_BRAND(x) != HCL_OBJ_GET_FLAGS_BRAND(y))
{
return HCL_IS_NBIGINT(hcl, y);
}
if (HCL_IS_PBIGINT(hcl, x))
{
return is_greater_unsigned (x, y);
}
else
{
return is_greater_unsigned (y, x);
}
if (HCL_OBJ_GET_CLASS(x) != HCL_OBJ_GET_CLASS(y)) return HCL_IS_NBIGINT(hcl, y);
if (HCL_IS_PBIGINT(hcl, x)) return is_greater_unsigned (x, y);
return is_greater_unsigned (y, x);
}
static HCL_INLINE int is_equal_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs, const hcl_liw_t* y, hcl_oow_t ys)
@ -1008,7 +988,7 @@ static HCL_INLINE int is_equal (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
/* check if two large integers are equal to each other */
/*return HCL_OBJ_GET_FLAGS_BRAND(x) == HCL_OBJ_GET_FLAGS_BRAND(y) && HCL_OBJ_GET_SIZE(x) == HCL_OBJ_GET_SIZE(y) &&
HCL_MEMCMP(((hcl_oop_liword_t)x)->slot, ((hcl_oop_liword_t)y)->slot, HCL_OBJ_GET_SIZE(x) * HCL_SIZEOF(hcl_liw_t)) == 0;*/
return HCL_OBJ_GET_FLAGS_BRAND(x) == HCL_OBJ_GET_FLAGS_BRAND(y) && HCL_OBJ_GET_SIZE(x) == HCL_OBJ_GET_SIZE(y) && is_equal_unsigned(x, y);
return HCL_OBJ_GET_CLASS(x) == HCL_OBJ_GET_CLASS(y) && HCL_OBJ_GET_SIZE(x) == HCL_OBJ_GET_SIZE(y) && is_equal_unsigned(x, y);
}
static void complement2_unsigned_array (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs, hcl_liw_t* z)
@ -2336,36 +2316,36 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
if (!hcl_isbigint(hcl,y)) goto oops_einval;
}
if (HCL_OBJ_GET_FLAGS_BRAND(x) != HCL_OBJ_GET_FLAGS_BRAND(y))
if (HCL_OBJ_GET_CLASS(x) != HCL_OBJ_GET_CLASS(y))
{
if (HCL_IS_NBIGINT(hcl, x))
{
/* x is negative, y is positive */
if (is_less_unsigned (x, y))
{
z = subtract_unsigned_integers (hcl, y, x);
if (!z) return HCL_NULL;
z = subtract_unsigned_integers(hcl, y, x);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
}
else
{
z = subtract_unsigned_integers (hcl, x, y);
if (!z) return HCL_NULL;
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
z = subtract_unsigned_integers(hcl, x, y);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
}
else
{
/* x is positive, y is negative */
if (is_less_unsigned (x, y))
if (is_less_unsigned(x, y))
{
z = subtract_unsigned_integers (hcl, y, x);
if (!z) return HCL_NULL;
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
z = subtract_unsigned_integers(hcl, y, x);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
else
{
z = subtract_unsigned_integers (hcl, x, y);
if (!z) return HCL_NULL;
z = subtract_unsigned_integers(hcl, x, y);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
}
}
}
@ -2374,9 +2354,9 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
int neg;
/* both are positive or negative */
neg = HCL_IS_NBIGINT(hcl, x);
z = add_unsigned_integers (hcl, x, y);
if (!z) return HCL_NULL;
if (neg) HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
z = add_unsigned_integers(hcl, x, y);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (neg) HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
}
@ -2444,29 +2424,29 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
if (!hcl_isbigint(hcl,y)) goto oops_einval;
}
if (HCL_OBJ_GET_FLAGS_BRAND(x) != HCL_OBJ_GET_FLAGS_BRAND(y))
if (HCL_OBJ_GET_CLASS(x) != HCL_OBJ_GET_CLASS(y))
{
neg = HCL_IS_NBIGINT(hcl, x);
z = add_unsigned_integers (hcl, x, y);
z = add_unsigned_integers(hcl, x, y);
if (!z) return HCL_NULL;
if (neg) HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
if (neg) HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
else
{
/* both are positive or negative */
if (is_less_unsigned (x, y))
if (is_less_unsigned(x, y))
{
neg = HCL_IS_NBIGINT(hcl, x);
z = subtract_unsigned_integers (hcl, y, x);
if (!z) return HCL_NULL;
if (!neg) HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
z = subtract_unsigned_integers(hcl, y, x);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (!neg) HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
else
{
neg = HCL_IS_NBIGINT(hcl, x);
z = subtract_unsigned_integers (hcl, x, y); /* take x's sign */
if (!z) return HCL_NULL;
if (neg) HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
z = subtract_unsigned_integers(hcl, x, y); /* take x's sign */
if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (neg) HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
}
}
@ -2488,26 +2468,26 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
hcl_intmax_t i;
i = (hcl_intmax_t)HCL_OOP_TO_SMOOI(x) * (hcl_intmax_t)HCL_OOP_TO_SMOOI(y);
if (HCL_IN_SMOOI_RANGE(i)) return HCL_SMOOI_TO_OOP((hcl_ooi_t)i);
return make_bigint_with_intmax (hcl, i);
return make_bigint_with_intmax(hcl, i);
#else
hcl_ooi_t i;
hcl_ooi_t xv, yv;
xv = HCL_OOP_TO_SMOOI(x);
yv = HCL_OOP_TO_SMOOI(y);
if (shcli_mul_overflow (hcl, xv, yv, &i))
if (shcli_mul_overflow(hcl, xv, yv, &i))
{
/* overflowed - convert x and y normal objects and carry on */
/* 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;
x = make_bigint_with_ooi(hcl, xv);
if (HCL_UNLIKELY(!x)) return HCL_NULL;
hcl_pushvolat (hcl, &x); /* protect x made above */
y = make_bigint_with_ooi (hcl, yv);
y = make_bigint_with_ooi(hcl, yv);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
if (HCL_UNLIKELY(!y)) return HCL_NULL;
goto full_multiply;
}
@ -2541,7 +2521,7 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v);
hcl_popvolat (hcl);
if (!x) return HCL_NULL;
if (HCL_UNLIKELY(!x)) return HCL_NULL;
}
else if (HCL_OOP_IS_SMOOI(y))
{
@ -2561,7 +2541,7 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v);
hcl_popvolat (hcl);
if (!y) return HCL_NULL;
if (HCL_UNLIKELY(!y)) return HCL_NULL;
}
else
{
@ -2570,13 +2550,13 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
}
full_multiply:
neg = (HCL_OBJ_GET_FLAGS_BRAND(x) != HCL_OBJ_GET_FLAGS_BRAND(y));
z = multiply_unsigned_integers (hcl, x, y);
if (!z) return HCL_NULL;
if (neg) HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
neg = (HCL_OBJ_GET_CLASS(x) != HCL_OBJ_GET_CLASS(y));
z = multiply_unsigned_integers(hcl, x, y);
if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (neg) HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
return normalize_bigint (hcl, z);
return normalize_bigint(hcl, z);
oops_einval:
hcl_seterrbfmt (hcl, HCL_EINVAL, "not integer - %O, %O", x, y);
@ -2780,23 +2760,21 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
if (x_neg_sign) ri = -ri;
z = normalize_bigint(hcl, z);
if (!z) return HCL_NULL;
if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (x_neg_sign != y_neg_sign)
{
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
if (ri && modulo)
{
z = hcl_subints(hcl, z, HCL_SMOOI_TO_OOP(1));
if (!z) return HCL_NULL;
if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (rem)
{
hcl_pushvolat (hcl, &z);
r = hcl_addints(hcl, HCL_SMOOI_TO_OOP(ri), HCL_SMOOI_TO_OOP(yv));
hcl_popvolat (hcl);
if (!r) return HCL_NULL;
if (HCL_UNLIKELY(!r)) return HCL_NULL;
*rem = r;
}
@ -2835,12 +2813,12 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop
{
/* the class on r must be set before normalize_bigint()
* because it can get changed to a small integer */
HCL_OBJ_SET_FLAGS_BRAND (r, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (r, (hcl_oop_t)hcl->c_large_negative_integer);
}
if (x_neg_sign != y_neg_sign)
{
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
hcl_pushvolat (hcl, &z);
hcl_pushvolat (hcl, &y);
@ -3226,7 +3204,7 @@ hcl_oop_t hcl_bitandints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
}
HCL_ASSERT (hcl, carry[0] == 0);
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
else if (negx)
{
@ -3441,7 +3419,7 @@ hcl_oop_t hcl_bitorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
}
HCL_ASSERT (hcl, carry[0] == 0);
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
else if (negx)
{
@ -3686,7 +3664,7 @@ hcl_oop_t hcl_bitxorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
}
HCL_ASSERT (hcl, carry == 0);
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
else if (negy)
{
@ -3825,7 +3803,7 @@ hcl_oop_t hcl_bitinvint (hcl_t* hcl, hcl_oop_t x)
HCL_ASSERT (hcl, (carry >> HCL_LIW_BITS) == 0);
#endif
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT);
HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
}
return normalize_bigint(hcl, z);

4
lib/exec.c
View File

@ -3925,7 +3925,9 @@ static int execute (hcl_t* hcl)
op = HCL_STACK_GETOP(hcl, b1);
if (HCL_OOP_IS_POINTER(op))
{
switch (HCL_OBJ_GET_FLAGS_BRAND(op))
hcl_oop_class_t c;
c = (hcl_oop_class_t)HCL_OBJ_GET_CLASS(op);
switch (HCL_OOP_TO_SMOOI(c->ibrand))
{
case HCL_BRAND_FUNCTION:
if (activate_function(hcl, b1) <= -1) goto call_failed;

2
lib/gc.c
View File

@ -1393,7 +1393,7 @@ void hcl_popvolats (hcl_t* hcl, hcl_oow_t count)
hcl_oop_t hcl_shallowcopy (hcl_t* hcl, hcl_oop_t oop)
{
if (HCL_OOP_IS_POINTER(oop) && HCL_OBJ_GET_FLAGS_BRAND(oop) != HCL_BRAND_SYMBOL)
if (HCL_OOP_IS_POINTER(oop) && HCL_OBJ_GET_CLASS(oop) != hcl->c_symbol)
{
hcl_oop_t z;
hcl_oow_t total_bytes;

57
lib/hcl.h
View File

@ -366,10 +366,9 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_FLAGS_NGC_BITS (1) /* 17 */
#define HCL_OBJ_FLAGS_TRAILER_BITS (1) /* 18 */
#define HCL_OBJ_FLAGS_SYNCODE_BITS (5) /* 23 - syncode for symbol, concode for cons */
#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_FLEXI_BITS (1) /* 24 */
#define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 25 */
#define HCL_OBJ_FLAGS_PROC_BITS (1) /* 26 */
/*
#define HCL_OBJ_FLAGS_PERM_BITS 1
@ -387,8 +386,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_FLAGS_MOVED_SHIFT (HCL_OBJ_FLAGS_NGC_BITS + HCL_OBJ_FLAGS_NGC_SHIFT)
#define HCL_OBJ_FLAGS_NGC_SHIFT (HCL_OBJ_FLAGS_TRAILER_BITS + HCL_OBJ_FLAGS_TRAILER_SHIFT)
#define HCL_OBJ_FLAGS_TRAILER_SHIFT (HCL_OBJ_FLAGS_SYNCODE_BITS + HCL_OBJ_FLAGS_SYNCODE_SHIFT)
#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_SYNCODE_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 (HCL_OBJ_FLAGS_PROC_BITS + HCL_OBJ_FLAGS_PROC_SHIFT)
#define HCL_OBJ_FLAGS_PROC_SHIFT (0)
@ -401,7 +399,6 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_GET_FLAGS_NGC(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_NGC_SHIFT, HCL_OBJ_FLAGS_NGC_BITS)
#define HCL_OBJ_GET_FLAGS_TRAILER(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TRAILER_SHIFT, HCL_OBJ_FLAGS_TRAILER_BITS)
#define HCL_OBJ_GET_FLAGS_SYNCODE(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT, HCL_OBJ_FLAGS_SYNCODE_BITS)
#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)
@ -414,7 +411,6 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_SET_FLAGS_NGC(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_NGC_SHIFT, HCL_OBJ_FLAGS_NGC_BITS, v)
#define HCL_OBJ_SET_FLAGS_TRAILER(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TRAILER_SHIFT, HCL_OBJ_FLAGS_TRAILER_BITS, v)
#define HCL_OBJ_SET_FLAGS_SYNCODE(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT, HCL_OBJ_FLAGS_SYNCODE_BITS, v)
#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)
@ -422,15 +418,14 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
/* [NOTE] this macro doesn't check the range of the actual value.
* make sure that the value of each bit fields given falls within the
* possible range of the defined bits */
#define HCL_OBJ_MAKE_FLAGS(t,u,e,k,m,g,r,b) ( \
#define HCL_OBJ_MAKE_FLAGS(t,u,e,k,m,g,r) ( \
(((hcl_oow_t)(t)) << HCL_OBJ_FLAGS_TYPE_SHIFT) | \
(((hcl_oow_t)(u)) << HCL_OBJ_FLAGS_UNIT_SHIFT) | \
(((hcl_oow_t)(e)) << HCL_OBJ_FLAGS_EXTRA_SHIFT) | \
(((hcl_oow_t)(k)) << HCL_OBJ_FLAGS_KERNEL_SHIFT) | \
(((hcl_oow_t)(m)) << HCL_OBJ_FLAGS_MOVED_SHIFT) | \
(((hcl_oow_t)(g)) << HCL_OBJ_FLAGS_NGC_SHIFT) | \
(((hcl_oow_t)(r)) << HCL_OBJ_FLAGS_TRAILER_SHIFT) | \
(((hcl_oow_t)(b)) << HCL_OBJ_FLAGS_BRAND_SHIFT) \
(((hcl_oow_t)(r)) << HCL_OBJ_FLAGS_TRAILER_SHIFT) \
)
#define HCL_OBJ_FLAGS_KERNEL_USER 0 /* not a kernel object */
@ -937,13 +932,6 @@ struct hcl_class_t
};
#endif
/**
* The HCL_BRANDOF() macro return the brand of an object including a numeric
* object encoded into a pointer.
*/
#define HCL_BRANDOF(hcl,oop) \
(HCL_OOP_GET_TAG(oop)? ((hcl)->tagged_brands[HCL_OOP_GET_TAG(oop)]): HCL_OBJ_GET_FLAGS_BRAND(oop))
/**
* The HCL_CLASSOF() macro return the class of an object including a numeric
* object encoded into a pointer.
@ -2089,58 +2077,25 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_TRUE(hcl,v) (v == (hcl)->_true)
#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_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_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_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_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_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_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_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_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_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_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_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_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_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_CONS_CAR(v) (((hcl_cons_t*)(v))->car)

13
lib/obj.c
View File

@ -134,10 +134,9 @@ static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t si
}
if (!hdr) return HCL_NULL;
hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, ngc, 0, brand);
hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, ngc, 0);
HCL_OBJ_SET_SIZE (hdr, size);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/
/*HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);*/
while (size > 0) hdr->slot[--size] = hcl->_nil;
@ -163,10 +162,9 @@ hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, int brand, hcl_oow_t size, con
hdr = (hcl_oop_oop_t)hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
if (HCL_UNLIKELY(!hdr)) return HCL_NULL;
hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, 0, 1, brand);
hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, 0, 1);
HCL_OBJ_SET_SIZE (hdr, size);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/
/*HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);*/
for (i = 0; i < size; i++) hdr->slot[i] = hcl->_nil;
@ -203,11 +201,10 @@ static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const vo
hdr = (hcl_oop_t)hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
if (HCL_UNLIKELY(!hdr)) return HCL_NULL;
hdr->_flags = HCL_OBJ_MAKE_FLAGS(type, unit, extra, 0, 0, ngc, 0, brand);
hdr->_flags = HCL_OBJ_MAKE_FLAGS(type, unit, extra, 0, 0, ngc, 0);
hdr->_size = len;
HCL_OBJ_SET_SIZE (hdr, len);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/
/*HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);*/
if (ptr)
{
@ -731,7 +728,6 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
#if 0 /* TODO: revive this part */
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
#endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi);
}
hcl_popvolats (hcl, tmp_count);
@ -802,7 +798,6 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
*/
#endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi);
}
hcl_popvolats (hcl, tmp_count);
@ -1048,7 +1043,7 @@ int hcl_equalobjs (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t arg)
{
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(rcv));
if (HCL_OBJ_GET_FLAGS_BRAND(rcv) != HCL_OBJ_GET_FLAGS_BRAND(arg)) return 0; /* different class, not equal */
if (HCL_OBJ_GET_CLASS(rcv) != HCL_OBJ_GET_CLASS(arg)) return 0; /* different class, not equal */
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(rcv) == HCL_OBJ_GET_FLAGS_TYPE(arg));
if (HCL_OBJ_GET_SIZE(rcv) != HCL_OBJ_GET_SIZE(arg)) return 0; /* different size, not equal */

11
lib/prim.c
View File

@ -148,10 +148,8 @@ static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
/* visit only 1-level down into an array-like object */
hcl_oop_t inner;
hcl_oow_t i;
int brand;
brand = HCL_OBJ_GET_FLAGS_BRAND(msg);
if (brand != HCL_BRAND_ARRAY) goto dump_object;
if (HCL_OBJ_GET_CLASS(msg) != (hcl_oop_t)hcl->c_array) goto dump_object;
for (i = 0; i < HCL_OBJ_GET_SIZE(msg); i++)
{
@ -575,7 +573,7 @@ static hcl_pfrc_t pf_eqk (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
a0 = HCL_STACK_GETARG(hcl, nargs, 0);
a1 = HCL_STACK_GETARG(hcl, nargs, 1);
rv = (HCL_BRANDOF(hcl, a0) == HCL_BRANDOF(hcl, a1)? hcl->_true: hcl->_false);
rv = (HCL_CLASSOF(hcl, a0) == HCL_CLASSOF(hcl, a1)? hcl->_true: hcl->_false);
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
@ -612,7 +610,7 @@ static hcl_pfrc_t pf_nqk (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
a0 = HCL_STACK_GETARG(hcl, nargs, 0);
a1 = HCL_STACK_GETARG(hcl, nargs, 1);
rv = (HCL_BRANDOF(hcl, a0) != HCL_BRANDOF(hcl, a1)? hcl->_true: hcl->_false);
rv = (HCL_CLASSOF(hcl, a0) != HCL_CLASSOF(hcl, a1)? hcl->_true: hcl->_false);
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
@ -741,7 +739,8 @@ static hcl_pfrc_t pf_is_object (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_INSTANCE(hcl, x))? hcl->_true: hcl->_false;
/*rv = (HCL_IS_INSTANCE(hcl, x))? hcl->_true: hcl->_false;*/
rv = (!HCL_IS_CLASS(hcl, x))? hcl->_true: hcl->_false; /* true if not a class object itself */
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}

13
lib/print.c
View File

@ -269,6 +269,7 @@ int hcl_fmt_object (hcl_t* hcl, hcl_fmtout_t* fmtout, hcl_oop_t obj)
{
hcl_oop_t cur;
print_stack_t ps;
hcl_oop_class_t _class;
int brand;
int word_index;
int json;
@ -313,7 +314,9 @@ int hcl_fmt_object (hcl_t* hcl, hcl_fmtout_t* fmtout, hcl_oop_t obj)
json = !!(fmtout->mask & HCL_LOG_PREFER_JSON);
next:
switch ((brand = HCL_BRANDOF(hcl, obj)))
_class = (hcl_oop_class_t)HCL_CLASSOF(hcl, obj);
brand = HCL_OOP_TO_SMOOI(_class->ibrand);
switch (brand)
{
case HCL_BRAND_SMOOI:
if (hcl_bfmt_out(hcl, fmtout, "%zd", HCL_OOP_TO_SMOOI(obj)) <= -1) return -1;
@ -561,7 +564,7 @@ next:
* indicates the end of a list. break the loop */
break;
}
if (!HCL_OOP_IS_POINTER(cur) || HCL_OBJ_GET_FLAGS_BRAND(cur) != HCL_BRAND_CONS)
if (!HCL_OOP_IS_POINTER(cur) || HCL_OBJ_GET_CLASS(cur) != (hcl_oop_t)hcl->c_cons)
{
/* The CDR part does not point to a pair. */
if (hcl_bfmt_out(hcl, fmtout, " . ") <= -1) return -1;
@ -818,9 +821,9 @@ next:
}
default:
HCL_DEBUG3 (hcl, "Internal error - unknown object type %d at %s:%d\n", (int)brand, __FILE__, __LINE__);
HCL_ASSERT (hcl, "Unknown object type" == HCL_NULL);
hcl_seterrbfmt (hcl, HCL_EINTERN, "unknown object type %d", (int)brand);
HCL_DEBUG3 (hcl, "Internal error - unknown object brand %d at %s:%d\n", (int)brand, __FILE__, __LINE__);
HCL_ASSERT (hcl, "Unknown object brand" == HCL_NULL);
hcl_seterrbfmt (hcl, HCL_EINTERN, "unknown object brand %d", (int)brand);
return -1;
print_word:

8
lib/xchg.c
View File

@ -64,6 +64,7 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
{
hcl_oow_t i, lfbase = 0;
hcl_oop_t tmp;
hcl_oop_class_t _class;
int brand;
hcl_oow_t tsize;
hcl_uint8_t b;
@ -97,7 +98,8 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
continue;
}
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
_class = (hcl_oop_class_t)HCL_CLASSOF(hcl, tmp);
brand = HCL_OOP_TO_SMOOI(_class->ibrand);
tsize = HCL_OBJ_GET_SIZE(tmp);
switch (brand)
@ -159,7 +161,6 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
else
{
tmp = f->value;
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(tmp);
goto bigint_body;
}
@ -178,10 +179,9 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
/* get the symbol at CAR and make it as if it is the current object processed.*/
tmp = HCL_CONS_CAR(tmp);
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(tmp);
HCL_ASSERT(hcl, brand == HCL_BRAND_SYMBOL);
HCL_ASSERT(hcl, HCL_CLASSOF(hcl, tmp) == (hcl_oop_t)hcl->c_symbol);
goto string_body;
}