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

96
lib/bigint.c
View File

@ -938,20 +938,10 @@ 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) 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)) 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 HCL_IS_NBIGINT(hcl, x);
}
if (HCL_IS_PBIGINT(hcl, x))
{
return is_less_unsigned (x, y);
}
else
{
return is_less_unsigned (y, x); 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) 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,20 +966,10 @@ 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) 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)) 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 HCL_IS_NBIGINT(hcl, y);
}
if (HCL_IS_PBIGINT(hcl, x))
{
return is_greater_unsigned (x, y);
}
else
{
return is_greater_unsigned (y, x); 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) 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 */ /* 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) && /*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;*/ 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) static void complement2_unsigned_array (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs, hcl_liw_t* z)
@ -2336,7 +2316,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; 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)) if (HCL_IS_NBIGINT(hcl, x))
{ {
@ -2344,13 +2324,13 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
if (is_less_unsigned (x, y)) if (is_less_unsigned (x, y))
{ {
z = subtract_unsigned_integers(hcl, y, x); z = subtract_unsigned_integers(hcl, y, x);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!z)) return HCL_NULL;
} }
else else
{ {
z = subtract_unsigned_integers(hcl, x, y); z = subtract_unsigned_integers(hcl, x, y);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!z)) return HCL_NULL;
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT); HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
} }
} }
else else
@ -2359,13 +2339,13 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
if (is_less_unsigned(x, y)) if (is_less_unsigned(x, y))
{ {
z = subtract_unsigned_integers(hcl, y, x); z = subtract_unsigned_integers(hcl, y, x);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!z)) return HCL_NULL;
HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT); HCL_OBJ_SET_CLASS (z, (hcl_oop_t)hcl->c_large_negative_integer);
} }
else else
{ {
z = subtract_unsigned_integers(hcl, x, y); z = subtract_unsigned_integers(hcl, x, y);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!z)) return HCL_NULL;
} }
} }
} }
@ -2375,8 +2355,8 @@ hcl_oop_t hcl_addints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
/* both are positive or negative */ /* both are positive or negative */
neg = HCL_IS_NBIGINT(hcl, x); 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 (HCL_UNLIKELY(!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);
} }
} }
@ -2444,12 +2424,12 @@ 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_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); 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 (!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 else
{ {
@ -2458,15 +2438,15 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{ {
neg = HCL_IS_NBIGINT(hcl, x); neg = HCL_IS_NBIGINT(hcl, x);
z = subtract_unsigned_integers(hcl, y, x); z = subtract_unsigned_integers(hcl, y, x);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!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 else
{ {
neg = HCL_IS_NBIGINT(hcl, x); neg = HCL_IS_NBIGINT(hcl, x);
z = subtract_unsigned_integers(hcl, x, y); /* take x's sign */ z = subtract_unsigned_integers(hcl, x, y); /* take x's sign */
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!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);
} }
} }
} }
@ -2502,12 +2482,12 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
/* no need to call hcl_pushvolat before creating x because /* no need to call hcl_pushvolat before creating x because
* xv and yv contains actual values needed */ * xv and yv contains actual values needed */
x = make_bigint_with_ooi(hcl, xv); x = make_bigint_with_ooi(hcl, xv);
if (!x) return HCL_NULL; if (HCL_UNLIKELY(!x)) return HCL_NULL;
hcl_pushvolat (hcl, &x); /* protect x made above */ 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); hcl_popvolat (hcl);
if (!y) return HCL_NULL; if (HCL_UNLIKELY(!y)) return HCL_NULL;
goto full_multiply; 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); hcl_pushvolat (hcl, &y);
x = make_bigint_with_ooi (hcl, v); x = make_bigint_with_ooi (hcl, v);
hcl_popvolat (hcl); hcl_popvolat (hcl);
if (!x) return HCL_NULL; if (HCL_UNLIKELY(!x)) return HCL_NULL;
} }
else if (HCL_OOP_IS_SMOOI(y)) 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); hcl_pushvolat (hcl, &x);
y = make_bigint_with_ooi (hcl, v); y = make_bigint_with_ooi (hcl, v);
hcl_popvolat (hcl); hcl_popvolat (hcl);
if (!y) return HCL_NULL; if (HCL_UNLIKELY(!y)) return HCL_NULL;
} }
else else
{ {
@ -2570,10 +2550,10 @@ hcl_oop_t hcl_mulints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
} }
full_multiply: full_multiply:
neg = (HCL_OBJ_GET_FLAGS_BRAND(x) != HCL_OBJ_GET_FLAGS_BRAND(y)); neg = (HCL_OBJ_GET_CLASS(x) != HCL_OBJ_GET_CLASS(y));
z = multiply_unsigned_integers(hcl, x, y); z = multiply_unsigned_integers(hcl, x, y);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!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);
} }
return normalize_bigint(hcl, z); return normalize_bigint(hcl, z);
@ -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; if (x_neg_sign) ri = -ri;
z = normalize_bigint(hcl, z); z = normalize_bigint(hcl, z);
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (x_neg_sign != y_neg_sign) 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) if (ri && modulo)
{ {
z = hcl_subints(hcl, z, HCL_SMOOI_TO_OOP(1)); z = hcl_subints(hcl, z, HCL_SMOOI_TO_OOP(1));
if (!z) return HCL_NULL; if (HCL_UNLIKELY(!z)) return HCL_NULL;
if (rem) if (rem)
{ {
hcl_pushvolat (hcl, &z); hcl_pushvolat (hcl, &z);
r = hcl_addints(hcl, HCL_SMOOI_TO_OOP(ri), HCL_SMOOI_TO_OOP(yv)); r = hcl_addints(hcl, HCL_SMOOI_TO_OOP(ri), HCL_SMOOI_TO_OOP(yv));
hcl_popvolat (hcl); hcl_popvolat (hcl);
if (!r) return HCL_NULL; if (HCL_UNLIKELY(!r)) return HCL_NULL;
*rem = r; *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() /* the class on r must be set before normalize_bigint()
* because it can get changed to a small integer */ * 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) 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, &z);
hcl_pushvolat (hcl, &y); 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_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) 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_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) 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_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) 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); HCL_ASSERT (hcl, (carry >> HCL_LIW_BITS) == 0);
#endif #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); 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); op = HCL_STACK_GETOP(hcl, b1);
if (HCL_OOP_IS_POINTER(op)) 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: case HCL_BRAND_FUNCTION:
if (activate_function(hcl, b1) <= -1) goto call_failed; 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) 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_oop_t z;
hcl_oow_t total_bytes; 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_NGC_BITS (1) /* 17 */
#define HCL_OBJ_FLAGS_TRAILER_BITS (1) /* 18 */ #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_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) /* 24 */
#define HCL_OBJ_FLAGS_FLEXI_BITS (1) /* 30 */ #define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 25 */
#define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 31 */ #define HCL_OBJ_FLAGS_PROC_BITS (1) /* 26 */
#define HCL_OBJ_FLAGS_PROC_BITS (1) /* 32 */
/* /*
#define HCL_OBJ_FLAGS_PERM_BITS 1 #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_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_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_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_SYNCODE_SHIFT (HCL_OBJ_FLAGS_FLEXI_BITS + HCL_OBJ_FLAGS_FLEXI_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_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_RDONLY_SHIFT (HCL_OBJ_FLAGS_PROC_BITS + HCL_OBJ_FLAGS_PROC_SHIFT)
#define HCL_OBJ_FLAGS_PROC_SHIFT (0) #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_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_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_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_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_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_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_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_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_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_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_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_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. /* [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 * make sure that the value of each bit fields given falls within the
* possible range of the defined bits */ * 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)(t)) << HCL_OBJ_FLAGS_TYPE_SHIFT) | \
(((hcl_oow_t)(u)) << HCL_OBJ_FLAGS_UNIT_SHIFT) | \ (((hcl_oow_t)(u)) << HCL_OBJ_FLAGS_UNIT_SHIFT) | \
(((hcl_oow_t)(e)) << HCL_OBJ_FLAGS_EXTRA_SHIFT) | \ (((hcl_oow_t)(e)) << HCL_OBJ_FLAGS_EXTRA_SHIFT) | \
(((hcl_oow_t)(k)) << HCL_OBJ_FLAGS_KERNEL_SHIFT) | \ (((hcl_oow_t)(k)) << HCL_OBJ_FLAGS_KERNEL_SHIFT) | \
(((hcl_oow_t)(m)) << HCL_OBJ_FLAGS_MOVED_SHIFT) | \ (((hcl_oow_t)(m)) << HCL_OBJ_FLAGS_MOVED_SHIFT) | \
(((hcl_oow_t)(g)) << HCL_OBJ_FLAGS_NGC_SHIFT) | \ (((hcl_oow_t)(g)) << HCL_OBJ_FLAGS_NGC_SHIFT) | \
(((hcl_oow_t)(r)) << HCL_OBJ_FLAGS_TRAILER_SHIFT) | \ (((hcl_oow_t)(r)) << HCL_OBJ_FLAGS_TRAILER_SHIFT) \
(((hcl_oow_t)(b)) << HCL_OBJ_FLAGS_BRAND_SHIFT) \
) )
#define HCL_OBJ_FLAGS_KERNEL_USER 0 /* not a kernel object */ #define HCL_OBJ_FLAGS_KERNEL_USER 0 /* not a kernel object */
@ -937,13 +932,6 @@ struct hcl_class_t
}; };
#endif #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 * The HCL_CLASSOF() macro return the class of an object including a numeric
* object encoded into a pointer. * 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_TRUE(hcl,v) (v == (hcl)->_true)
#define HCL_IS_FALSE(hcl,v) (v == (hcl)->_false) #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_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_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_PBIGINT(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_large_positive_integer) #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_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_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_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_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; 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_SIZE (hdr, size);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/ /*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/
/*HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);*/
while (size > 0) hdr->slot[--size] = hcl->_nil; 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); hdr = (hcl_oop_oop_t)hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
if (HCL_UNLIKELY(!hdr)) return HCL_NULL; 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_SIZE (hdr, size);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/ /*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; 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); hdr = (hcl_oop_t)hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
if (HCL_UNLIKELY(!hdr)) return HCL_NULL; 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; hdr->_size = len;
HCL_OBJ_SET_SIZE (hdr, len); HCL_OBJ_SET_SIZE (hdr, len);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/ /*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/
/*HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);*/
if (ptr) 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 0 /* TODO: revive this part */
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1); if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
#endif #endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi); HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi);
} }
hcl_popvolats (hcl, tmp_count); 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); if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
*/ */
#endif #endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi); HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi);
} }
hcl_popvolats (hcl, tmp_count); 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)); 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)); 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 */ 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 */ /* visit only 1-level down into an array-like object */
hcl_oop_t inner; hcl_oop_t inner;
hcl_oow_t i; hcl_oow_t i;
int brand;
brand = HCL_OBJ_GET_FLAGS_BRAND(msg); if (HCL_OBJ_GET_CLASS(msg) != (hcl_oop_t)hcl->c_array) goto dump_object;
if (brand != HCL_BRAND_ARRAY) goto dump_object;
for (i = 0; i < HCL_OBJ_GET_SIZE(msg); i++) 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); a0 = HCL_STACK_GETARG(hcl, nargs, 0);
a1 = HCL_STACK_GETARG(hcl, nargs, 1); 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); HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS; 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); a0 = HCL_STACK_GETARG(hcl, nargs, 0);
a1 = HCL_STACK_GETARG(hcl, nargs, 1); 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); HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS; 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; hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0); 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); HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS; 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; hcl_oop_t cur;
print_stack_t ps; print_stack_t ps;
hcl_oop_class_t _class;
int brand; int brand;
int word_index; int word_index;
int json; 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); json = !!(fmtout->mask & HCL_LOG_PREFER_JSON);
next: 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: case HCL_BRAND_SMOOI:
if (hcl_bfmt_out(hcl, fmtout, "%zd", HCL_OOP_TO_SMOOI(obj)) <= -1) return -1; 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 */ * indicates the end of a list. break the loop */
break; 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. */ /* The CDR part does not point to a pair. */
if (hcl_bfmt_out(hcl, fmtout, " . ") <= -1) return -1; if (hcl_bfmt_out(hcl, fmtout, " . ") <= -1) return -1;
@ -818,9 +821,9 @@ next:
} }
default: default:
HCL_DEBUG3 (hcl, "Internal error - unknown object type %d at %s:%d\n", (int)brand, __FILE__, __LINE__); HCL_DEBUG3 (hcl, "Internal error - unknown object brand %d at %s:%d\n", (int)brand, __FILE__, __LINE__);
HCL_ASSERT (hcl, "Unknown object type" == HCL_NULL); HCL_ASSERT (hcl, "Unknown object brand" == HCL_NULL);
hcl_seterrbfmt (hcl, HCL_EINTERN, "unknown object type %d", (int)brand); hcl_seterrbfmt (hcl, HCL_EINTERN, "unknown object brand %d", (int)brand);
return -1; return -1;
print_word: 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_oow_t i, lfbase = 0;
hcl_oop_t tmp; hcl_oop_t tmp;
hcl_oop_class_t _class;
int brand; int brand;
hcl_oow_t tsize; hcl_oow_t tsize;
hcl_uint8_t b; 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; 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); tsize = HCL_OBJ_GET_SIZE(tmp);
switch (brand) switch (brand)
@ -159,7 +161,6 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
else else
{ {
tmp = f->value; tmp = f->value;
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(tmp); tsize = HCL_OBJ_GET_SIZE(tmp);
goto bigint_body; 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.*/ /* get the symbol at CAR and make it as if it is the current object processed.*/
tmp = HCL_CONS_CAR(tmp); tmp = HCL_CONS_CAR(tmp);
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(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; goto string_body;
} }