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

added the flexi object bit
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-08-10 14:42:21 +09:00
parent acb8a3cd68
commit 17cde13cbb
7 changed files with 293 additions and 255 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lib/dic.c
View File

@ -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);

6
lib/exec.c
View File

@ -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 */

76
lib/hcl.h
View File

@ -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)

47
lib/obj.c
View File

@ -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;

368
mod/core.c
View File

@ -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 } }
};
/* ------------------------------------------------------------------------ */

48
src/kernel.hcl
View File

@ -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)

2
t/class-5001.err
View File

@ -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
}