diff --git a/lib/dic.c b/lib/dic.c index e2a7634..5bdcd54 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -456,6 +456,7 @@ found: hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize) { +/* TODO: use hcl_instantiate() */ hcl_oop_dic_t obj; obj = (hcl_oop_dic_t)hcl_allocoopobj(hcl, HCL_BRAND_DIC, 2); diff --git a/lib/exec.c b/lib/exec.c index 964ef8f..396aea3 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -4453,7 +4453,8 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc LOG_INST_1 (hcl, "make_array %zu", b1); /* create an empty array */ - t = hcl_makearray(hcl, b1, 0); + /*t = hcl_makearray(hcl, b1, 0);*/ + t = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, b1); if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; HCL_STACK_PUSH (hcl, t); /* push the array created */ @@ -4487,7 +4488,8 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc LOG_INST_1 (hcl, "make_bytearray %zu", b1); /* create an empty array */ - t = hcl_makebytearray(hcl, HCL_NULL, b1); + /*t = hcl_makebytearray(hcl, HCL_NULL, b1);*/ + t = hcl_instantiate(hcl, hcl->c_byte_array, HCL_NULL, b1); if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; HCL_STACK_PUSH (hcl, t); /* push the byte array created */ diff --git a/lib/hcl.h b/lib/hcl.h index 31aa172..6b9e415 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -357,15 +357,16 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; * size calculation and the access to the payload fields become more complex. * Therefore, i've dropped the idea. * ========================================================================= */ -#define HCL_OBJ_FLAGS_TYPE_BITS 6 -#define HCL_OBJ_FLAGS_UNIT_BITS 5 -#define HCL_OBJ_FLAGS_EXTRA_BITS 1 -#define HCL_OBJ_FLAGS_KERNEL_BITS 2 -#define HCL_OBJ_FLAGS_MOVED_BITS 2 -#define HCL_OBJ_FLAGS_NGC_BITS 1 -#define HCL_OBJ_FLAGS_TRAILER_BITS 1 -#define HCL_OBJ_FLAGS_SYNCODE_BITS 5 -#define HCL_OBJ_FLAGS_BRAND_BITS 6 +#define HCL_OBJ_FLAGS_TYPE_BITS (6) +#define HCL_OBJ_FLAGS_UNIT_BITS (5) +#define HCL_OBJ_FLAGS_EXTRA_BITS (1) +#define HCL_OBJ_FLAGS_KERNEL_BITS (2) +#define HCL_OBJ_FLAGS_MOVED_BITS (2) +#define HCL_OBJ_FLAGS_NGC_BITS (1) +#define HCL_OBJ_FLAGS_TRAILER_BITS (1) +#define HCL_OBJ_FLAGS_SYNCODE_BITS (5) +#define HCL_OBJ_FLAGS_BRAND_BITS (6) +#define HCL_OBJ_FLAGS_FLEXI_BITS (1) /* #define HCL_OBJ_FLAGS_PERM_BITS 1 @@ -378,35 +379,38 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_FLAGS_UNCOPYABLE_BITS 1 */ -#define HCL_OBJ_FLAGS_TYPE_SHIFT (HCL_OBJ_FLAGS_UNIT_BITS + HCL_OBJ_FLAGS_UNIT_SHIFT) -#define HCL_OBJ_FLAGS_UNIT_SHIFT (HCL_OBJ_FLAGS_EXTRA_BITS + HCL_OBJ_FLAGS_EXTRA_SHIFT) -#define HCL_OBJ_FLAGS_EXTRA_SHIFT (HCL_OBJ_FLAGS_KERNEL_BITS + HCL_OBJ_FLAGS_KERNEL_SHIFT) -#define HCL_OBJ_FLAGS_KERNEL_SHIFT (HCL_OBJ_FLAGS_MOVED_BITS + HCL_OBJ_FLAGS_MOVED_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_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 (0) +#define HCL_OBJ_FLAGS_TYPE_SHIFT (HCL_OBJ_FLAGS_UNIT_BITS + HCL_OBJ_FLAGS_UNIT_SHIFT) +#define HCL_OBJ_FLAGS_UNIT_SHIFT (HCL_OBJ_FLAGS_EXTRA_BITS + HCL_OBJ_FLAGS_EXTRA_SHIFT) +#define HCL_OBJ_FLAGS_EXTRA_SHIFT (HCL_OBJ_FLAGS_KERNEL_BITS + HCL_OBJ_FLAGS_KERNEL_SHIFT) +#define HCL_OBJ_FLAGS_KERNEL_SHIFT (HCL_OBJ_FLAGS_MOVED_BITS + HCL_OBJ_FLAGS_MOVED_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_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_FLEXI_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) -#define HCL_OBJ_GET_FLAGS_EXTRA(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_EXTRA_SHIFT, HCL_OBJ_FLAGS_EXTRA_BITS) -#define HCL_OBJ_GET_FLAGS_KERNEL(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_KERNEL_SHIFT, HCL_OBJ_FLAGS_KERNEL_BITS) -#define HCL_OBJ_GET_FLAGS_MOVED(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_MOVED_SHIFT, HCL_OBJ_FLAGS_MOVED_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_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_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) +#define HCL_OBJ_GET_FLAGS_EXTRA(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_EXTRA_SHIFT, HCL_OBJ_FLAGS_EXTRA_BITS) +#define HCL_OBJ_GET_FLAGS_KERNEL(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_KERNEL_SHIFT, HCL_OBJ_FLAGS_KERNEL_BITS) +#define HCL_OBJ_GET_FLAGS_MOVED(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_MOVED_SHIFT, HCL_OBJ_FLAGS_MOVED_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_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_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) -#define HCL_OBJ_SET_FLAGS_EXTRA(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_EXTRA_SHIFT, HCL_OBJ_FLAGS_EXTRA_BITS, v) -#define HCL_OBJ_SET_FLAGS_KERNEL(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_KERNEL_SHIFT, HCL_OBJ_FLAGS_KERNEL_BITS, v) -#define HCL_OBJ_SET_FLAGS_MOVED(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_MOVED_SHIFT, HCL_OBJ_FLAGS_MOVED_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_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_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) +#define HCL_OBJ_SET_FLAGS_EXTRA(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_EXTRA_SHIFT, HCL_OBJ_FLAGS_EXTRA_BITS, v) +#define HCL_OBJ_SET_FLAGS_KERNEL(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_KERNEL_SHIFT, HCL_OBJ_FLAGS_KERNEL_BITS, v) +#define HCL_OBJ_SET_FLAGS_MOVED(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_MOVED_SHIFT, HCL_OBJ_FLAGS_MOVED_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_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_GET_SIZE(oop) ((oop)->_size) #define HCL_OBJ_GET_CLASS(oop) ((oop)->_class) diff --git a/lib/obj.c b/lib/obj.c index 1f0f6e1..b0f182c 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -513,7 +513,15 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t class_name, hcl_oop_t superclass, return (hcl_oop_t)c; } -static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t num_flexi_fields, hcl_obj_type_t* type, hcl_oow_t* outlen) +struct decoded_spec_t +{ + hcl_obj_type_t type; + hcl_oow_t alloclen; + int flexi; +}; +typedef struct decoded_spec_t decoded_spec_t; + +static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t num_flexi_fields, decoded_spec_t* dspec) { hcl_oow_t spec; hcl_oow_t num_fixed_fields; @@ -560,32 +568,30 @@ static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t } HCL_ASSERT (hcl, num_fixed_fields + num_flexi_fields <= HCL_OBJ_SIZE_MAX); - *type = indexed_type; - - /* TODO: THIS PART IS WRONG.. nivars_super and nivars should be encoded to the spec.... */ - *outlen = num_fixed_fields + num_flexi_fields + HCL_OOP_TO_SMOOI(_class->nivars_super) /*+ HCL_OOP_TO_SMOOI(_class->nivars)*/; + dspec->flexi = !!HCL_CLASS_SPEC_IS_INDEXED(spec); + dspec->type = indexed_type; + dspec->alloclen = num_fixed_fields + num_flexi_fields + HCL_OOP_TO_SMOOI(_class->nivars_super); return 0; } hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, hcl_oow_t vlen) { hcl_oop_t oop; - hcl_obj_type_t type; - hcl_oow_t alloclen; + decoded_spec_t dspec; hcl_oow_t tmp_count = 0; HCL_ASSERT (hcl, hcl->_nil != HCL_NULL); - if (decode_spec(hcl, _class, vlen, &type, &alloclen) <= -1) return HCL_NULL; + if (decode_spec(hcl, _class, vlen, &dspec) <= -1) return HCL_NULL; hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++; - switch (type) + switch (dspec.type) { case HCL_OBJ_TYPE_OOP: /* both the fixed part(named instance variables) and * the variable part(indexed instance variables) are allowed. */ - oop = hcl_allocoopobj(hcl, HCL_BRAND_INSTANCE, alloclen); + oop = hcl_allocoopobj(hcl, HCL_BRAND_INSTANCE, dspec.alloclen); if (HCL_LIKELY(oop)) { #if 0 @@ -626,19 +632,19 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, break; case HCL_OBJ_TYPE_CHAR: - oop = hcl_alloccharobj(hcl, HCL_BRAND_INSTANCE, (const hcl_ooch_t*)vptr, alloclen); + oop = hcl_alloccharobj(hcl, HCL_BRAND_INSTANCE, (const hcl_ooch_t*)vptr, dspec.alloclen); break; case HCL_OBJ_TYPE_BYTE: - oop = hcl_allocbyteobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oob_t*)vptr, alloclen); + oop = hcl_allocbyteobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oob_t*)vptr, dspec.alloclen); break; case HCL_OBJ_TYPE_HALFWORD: - oop = hcl_allochalfwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oohw_t*)vptr, alloclen); + oop = hcl_allochalfwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oohw_t*)vptr, dspec.alloclen); break; case HCL_OBJ_TYPE_WORD: - oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oow_t*)vptr, alloclen); + oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oow_t*)vptr, dspec.alloclen); break; /* TODO: more types... HCL_OBJ_TYPE_INT... HCL_OBJ_TYPE_FLOAT, HCL_OBJ_TYPE_UINT16, etc*/ @@ -660,6 +666,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, 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); return oop; @@ -668,20 +675,19 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t vlen, const hcl_oob_t* trptr, hcl_oow_t trlen) { hcl_oop_t oop; - hcl_obj_type_t type; - hcl_oow_t alloclen; + decoded_spec_t dspec; hcl_oow_t tmp_count = 0; HCL_ASSERT (hcl, hcl->_nil != HCL_NULL); - if (decode_spec(hcl, _class, vlen, &type, &alloclen) <= -1) return HCL_NULL; + if (decode_spec(hcl, _class, vlen, &dspec) <= -1) return HCL_NULL; hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++; - switch (type) + switch (dspec.type) { case HCL_OBJ_TYPE_OOP: - oop = hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_INSTANCE, alloclen, trptr, trlen); + oop = hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_INSTANCE, dspec.alloclen, trptr, trlen); if (HCL_LIKELY(oop)) { /* initialize named instance variables with default values */ @@ -719,7 +725,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo break; } - if (oop) + if (HCL_LIKELY(oop)) { #if 0 hcl_ooi_t spec; @@ -733,6 +739,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo */ #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); return oop; diff --git a/mod/core.c b/mod/core.c index 18465e4..f9bd7e2 100644 --- a/mod/core.c +++ b/mod/core.c @@ -61,7 +61,182 @@ static hcl_pfrc_t pf_core_basic_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_core_get_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +static hcl_pfrc_t pf_core_basic_at (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +{ + hcl_oop_t obj, val; + hcl_oop_t pos; + hcl_ooi_t index; + + obj = HCL_STACK_GETARG(hcl, nargs, 0); + pos = HCL_STACK_GETARG(hcl, nargs, 1); + + if (!HCL_OOP_IS_POINTER(obj) || !HCL_OBJ_GET_FLAGS_FLEXI(obj)) + { + unindexable: + hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not indexable - %O", obj); + return HCL_PF_FAILURE; + } + + if (!HCL_OOP_IS_SMOOI(pos)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos); + return HCL_PF_FAILURE; + } + index = HCL_OOP_TO_SMOOI(pos); + if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj)); + return HCL_PF_FAILURE; + } + + switch (HCL_OBJ_GET_FLAGS_TYPE(obj)) + { + case HCL_OBJ_TYPE_OOP: + val = HCL_OBJ_GET_OOP_VAL(obj, index); + break; + + case HCL_OBJ_TYPE_CHAR: + { + hcl_ooch_t c; + c = HCL_OBJ_GET_CHAR_VAL(obj, index); + val = HCL_CHAR_TO_OOP(c); + break; + } + + case HCL_OBJ_TYPE_BYTE: + { + hcl_ooi_t b; + b = HCL_OBJ_GET_BYTE_VAL(obj, index); + val = HCL_SMOOI_TO_OOP(b); + break; + } + + case HCL_OBJ_TYPE_HALFWORD: + val = hcl_oowtoint(hcl, HCL_OBJ_GET_HALFWORD_VAL(obj, index)); + if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE; + break; + + case HCL_OBJ_TYPE_WORD: + val = hcl_oowtoint(hcl, HCL_OBJ_GET_WORD_VAL(obj, index)); + if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE; + break; + + default: + goto unindexable; + break; + } + + HCL_STACK_SETRET (hcl, nargs, val); + return HCL_PF_SUCCESS; +} + +static hcl_pfrc_t pf_core_basic_at_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +{ + hcl_oop_t obj, val; + hcl_oop_t pos; + hcl_ooi_t index; + + obj = HCL_STACK_GETARG(hcl, nargs, 0); + pos = HCL_STACK_GETARG(hcl, nargs, 1); + val = HCL_STACK_GETARG(hcl, nargs, 2); + + if (!HCL_OOP_IS_POINTER(obj) || !HCL_OBJ_GET_FLAGS_FLEXI(obj)) + { + unindexable: + hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not indexable - %O", obj); + return HCL_PF_FAILURE; + } + + if (!HCL_OOP_IS_SMOOI(pos)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos); + return HCL_PF_FAILURE; + } + index = HCL_OOP_TO_SMOOI(pos); + if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj)); + return HCL_PF_FAILURE; + } + + switch (HCL_OBJ_GET_FLAGS_TYPE(obj)) + { + case HCL_OBJ_TYPE_OOP: + HCL_OBJ_SET_OOP_VAL(obj, index, val); + break; + + case HCL_OBJ_TYPE_CHAR: + { + hcl_ooch_t c; + if (!HCL_OOP_IS_CHAR(val)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "value not character - %O", val); + return HCL_PF_FAILURE; + } + c = HCL_OOP_TO_CHAR(val); + HCL_OBJ_SET_CHAR_VAL(obj, index, c); + break; + } + + case HCL_OBJ_TYPE_BYTE: + { + hcl_ooi_t b; + if (!HCL_OOP_IS_SMOOI(val)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "value not byte - %O", val); + return HCL_PF_FAILURE; + } + b = HCL_OOP_TO_SMOOI(val); + HCL_OBJ_SET_BYTE_VAL(obj, index, b); + break; + } + + case HCL_OBJ_TYPE_HALFWORD: + { + hcl_oow_t w; + if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE; + HCL_OBJ_SET_HALFWORD_VAL(obj, index, w); + break; + } + + case HCL_OBJ_TYPE_WORD: + { + hcl_oow_t w; + if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE; + HCL_OBJ_SET_WORD_VAL(obj, index, w); + break; + } + + default: + goto unindexable; + break; + } + + HCL_STACK_SETRET (hcl, nargs, val); + return HCL_PF_SUCCESS; +} + +static hcl_pfrc_t pf_core_basic_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +{ + hcl_oop_oop_t src; + hcl_oop_t size; + + src = (hcl_oop_oop_t)HCL_STACK_GETARG(hcl, nargs, 0); + + if (!HCL_OOP_IS_POINTER(src)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "source not sizable - %O", src); + return HCL_PF_FAILURE; + } + + size = hcl_oowtoint(hcl, HCL_OBJ_GET_SIZE(src)); + if (!size) return HCL_PF_FAILURE; + + HCL_STACK_SETRET (hcl, nargs, size); + return HCL_PF_SUCCESS; +} + +static hcl_pfrc_t pf_core_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t obj; @@ -125,26 +300,6 @@ static hcl_pfrc_t pf_core_inst_responds_to (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_ return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_core_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) -{ - hcl_oop_oop_t src; - hcl_oop_t size; - - src = (hcl_oop_oop_t)HCL_STACK_GETARG(hcl, nargs, 0); - - if (!HCL_OOP_IS_POINTER(src)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "source not sizable - %O", src); - return HCL_PF_FAILURE; - } - - size = hcl_oowtoint(hcl, HCL_OBJ_GET_SIZE(src)); - if (!size) return HCL_PF_FAILURE; - - HCL_STACK_SETRET (hcl, nargs, size); - return HCL_PF_SUCCESS; -} - static hcl_pfrc_t pf_core_slice (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t src, slice, a1, a2; @@ -220,172 +375,17 @@ static hcl_pfrc_t pf_core_slice (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_core_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) -{ - hcl_oop_t obj, val; - hcl_oop_t pos; - hcl_ooi_t index; - - obj = HCL_STACK_GETARG(hcl, nargs, 0); - pos = HCL_STACK_GETARG(hcl, nargs, 1); - - if (!HCL_OOP_IS_POINTER(obj)) - { - unindexable: - hcl_seterrbfmt (hcl, HCL_EINVAL, "object not indexable - %O", obj); - return HCL_PF_FAILURE; - } - - if (!HCL_OOP_IS_SMOOI(pos)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos); - return HCL_PF_FAILURE; - } - index = HCL_OOP_TO_SMOOI(pos); - if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj)); - return HCL_PF_FAILURE; - } - - switch (HCL_OBJ_GET_FLAGS_TYPE(obj)) - { - case HCL_OBJ_TYPE_OOP: - val = HCL_OBJ_GET_OOP_VAL(obj, index); - break; - - case HCL_OBJ_TYPE_CHAR: - { - hcl_ooch_t c; - c = HCL_OBJ_GET_CHAR_VAL(obj, index); - val = HCL_CHAR_TO_OOP(c); - break; - } - - case HCL_OBJ_TYPE_BYTE: - { - hcl_ooi_t b; - b = HCL_OBJ_GET_BYTE_VAL(obj, index); - val = HCL_SMOOI_TO_OOP(b); - break; - } - - case HCL_OBJ_TYPE_HALFWORD: - val = hcl_oowtoint(hcl, HCL_OBJ_GET_HALFWORD_VAL(obj, index)); - if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE; - break; - - case HCL_OBJ_TYPE_WORD: - val = hcl_oowtoint(hcl, HCL_OBJ_GET_WORD_VAL(obj, index)); - if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE; - break; - - default: - goto unindexable; - break; - } - - HCL_STACK_SETRET (hcl, nargs, val); - return HCL_PF_SUCCESS; -} - -static hcl_pfrc_t pf_core_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) -{ - hcl_oop_t obj, val; - hcl_oop_t pos; - hcl_ooi_t index; - - obj = HCL_STACK_GETARG(hcl, nargs, 0); - pos = HCL_STACK_GETARG(hcl, nargs, 1); - val = HCL_STACK_GETARG(hcl, nargs, 2); - - if (!HCL_OOP_IS_POINTER(obj)) - { - unindexable: - hcl_seterrbfmt (hcl, HCL_EINVAL, "object not indexable - %O", obj); - return HCL_PF_FAILURE; - } - - if (!HCL_OOP_IS_SMOOI(pos)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos); - return HCL_PF_FAILURE; - } - index = HCL_OOP_TO_SMOOI(pos); - if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj)); - return HCL_PF_FAILURE; - } - - switch (HCL_OBJ_GET_FLAGS_TYPE(obj)) - { - case HCL_OBJ_TYPE_OOP: - HCL_OBJ_SET_OOP_VAL(obj, index, val); - break; - - case HCL_OBJ_TYPE_CHAR: - { - hcl_ooch_t c; - if (!HCL_OOP_IS_CHAR(val)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "value not character - %O", val); - return HCL_PF_FAILURE; - } - c = HCL_OOP_TO_CHAR(val); - HCL_OBJ_SET_CHAR_VAL(obj, index, c); - break; - } - - case HCL_OBJ_TYPE_BYTE: - { - hcl_ooi_t b; - if (!HCL_OOP_IS_SMOOI(val)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "value not byte - %O", val); - return HCL_PF_FAILURE; - } - b = HCL_OOP_TO_SMOOI(val); - HCL_OBJ_SET_BYTE_VAL(obj, index, b); - break; - } - - case HCL_OBJ_TYPE_HALFWORD: - { - hcl_oow_t w; - if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE; - HCL_OBJ_SET_HALFWORD_VAL(obj, index, w); - break; - } - - case HCL_OBJ_TYPE_WORD: - { - hcl_oow_t w; - if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE; - HCL_OBJ_SET_WORD_VAL(obj, index, w); - break; - } - - default: - goto unindexable; - break; - } - - HCL_STACK_SETRET (hcl, nargs, val); - return HCL_PF_SUCCESS; -} static hcl_pfinfo_t pfinfos[] = { - { "basic_new", { HCL_PFBASE_FUNC, pf_core_basic_new, 2, 2 } }, - { "class_name", { HCL_PFBASE_FUNC, pf_core_get_class_name, 1, 1 } }, - { "class_responds_to", { HCL_PFBASE_FUNC, pf_core_class_responds_to, 2, 2 } }, - { "get", { HCL_PFBASE_FUNC, pf_core_get, 2, 2 } }, - { "inst_responds_to", { HCL_PFBASE_FUNC, pf_core_inst_responds_to, 2, 2 } }, - { "length", { HCL_PFBASE_FUNC, pf_core_size, 1, 1 } }, - { "put", { HCL_PFBASE_FUNC, pf_core_put, 3, 3 } }, - { "size", { HCL_PFBASE_FUNC, pf_core_size, 1, 1 } }, - { "slice", { HCL_PFBASE_FUNC, pf_core_slice, 3, 3 } } + { "basicAt", { HCL_PFBASE_FUNC, pf_core_basic_at, 2, 2 } }, + { "basicAtPut", { HCL_PFBASE_FUNC, pf_core_basic_at_put, 3, 3 } }, + { "basicNew", { HCL_PFBASE_FUNC, pf_core_basic_new, 2, 2 } }, + { "basicSize", { HCL_PFBASE_FUNC, pf_core_basic_size, 1, 1 } }, + { "className", { HCL_PFBASE_FUNC, pf_core_class_name, 1, 1 } }, + { "classRespondsTo", { HCL_PFBASE_FUNC, pf_core_class_responds_to, 2, 2 } }, + { "instRespondsTo", { HCL_PFBASE_FUNC, pf_core_inst_responds_to, 2, 2 } }, + { "slice", { HCL_PFBASE_FUNC, pf_core_slice, 3, 3 } } }; /* ------------------------------------------------------------------------ */ diff --git a/src/kernel.hcl b/src/kernel.hcl index 8877aff..7ff3740 100644 --- a/src/kernel.hcl +++ b/src/kernel.hcl @@ -1,22 +1,26 @@ class Apex { fun ::basicNew(size) { - return (core.basic_new self size) + return (core.basicNew self size) } fun ::respondsTo(mth) { - return (core.class_responds_to self mth) + return (core.classRespondsTo self mth) } fun respondsTo(mth) { - return (core.inst_responds_to self mth) + return (core.instRespondsTo self mth) } fun basicAt(pos) { - return (core.get self index) + return (core.basicAt self pos) } - fun basicAtPut(index value) { - return (core.put self index value) + fun basicAtPut(pos value) { + return (core.basicAtPut self pos value) + } + + fun basicSize() { + return (core.basicSize self) } } @@ -35,7 +39,7 @@ class Class :: Apex [ _cvarnames ] { fun name() { - ##return (core.class_name self) + ##return (core.className self) return _class } @@ -52,7 +56,7 @@ class Class :: Apex [ class Collection :: Object { fun length() { - return (core.length self) + return (core.basicSize self) } } @@ -62,23 +66,23 @@ class IndexedCollection :: Collection { } fun at(index) { - return (core.get self index) + return (core.basicAt self index) } fun atPut(index value) { - return (core.put self index value) + return (core.basicAtPut self index value) } } class FixedSizedCollection :: IndexedCollection { fun ::new(size) { | obj iv | - obj := (core.basic_new self size) + obj := (core.basicNew self size) if (self:respondsTo "initValue") { ## TODO: change "initValue" to a symbol once supported i := 0 iv := (self:initValue) while (i < size) { - core.put obj i iv + core.basicAtPut obj i iv i := (i + 1) } } @@ -147,3 +151,23 @@ printf "[%O]\n" (" ":respondsTo "length") ##printf "[%O]\n" (String:instanceVariableNames) ##printf "%O\n" #"abcdefg" + + +printf "----------------------------------------\n" + +k := #[1 2 3] +printf "%O\n" (k:basicAt 2) + +class X :: Object [ a b c ] { + fun :* new() { + self.a := 10 + self.b := 20 + self.c := 30 + } +} +##k := (X:basicNew 0) +k := (X:new) +printf "%O\n" (k:basicAt 2) + + + diff --git a/t/class-5001.err b/t/class-5001.err index 9523c48..03783c2 100644 --- a/t/class-5001.err +++ b/t/class-5001.err @@ -110,7 +110,7 @@ fun X:xxx() { ##ERROR: exception not handled - "not class" ## you can't place an item in the arrya at all. fun Array:*boom() { - core.put self 0 10 ##ERROR: exception not handled - "position(0) out of range - negative or greater than or equal to 0" + core.basicAtPut self 0 10 ##ERROR: exception not handled - "position(0) out of range - negative or greater than or equal to 0" printf "%O" self return self }