diff --git a/lib/bigint.c b/lib/bigint.c index 7fffb89..2e049df 100644 --- a/lib/bigint.c +++ b/lib/bigint.c @@ -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); diff --git a/lib/exec.c b/lib/exec.c index feccea0..e672bdc 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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; diff --git a/lib/gc.c b/lib/gc.c index 6c3e38b..f2200d6 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -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; diff --git a/lib/hcl.h b/lib/hcl.h index b5171f9..ae013f8 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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) diff --git a/lib/obj.c b/lib/obj.c index ed72246..c2a8544 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -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 */ diff --git a/lib/prim.c b/lib/prim.c index df5e9d3..ad36b7b 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -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; } diff --git a/lib/print.c b/lib/print.c index c33d4f0..1547cb6 100644 --- a/lib/print.c +++ b/lib/print.c @@ -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: diff --git a/lib/xchg.c b/lib/xchg.c index 2ecd6da..6acfff5 100644 --- a/lib/xchg.c +++ b/lib/xchg.c @@ -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; }