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

use hcl_instantiate() in hcl_makedic()
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-09-08 17:26:22 +09:00
parent b39bfaa181
commit c8af7b2fd3
4 changed files with 70 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lib/dic.c
View File

@ -456,7 +456,7 @@ found:
hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
{
/* TODO: use hcl_instantiate() */
#if 0
hcl_oop_dic_t obj;
obj = (hcl_oop_dic_t)hcl_allocoopobj(hcl, HCL_BRAND_DIC, 2);
@ -475,6 +475,37 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
}
return (hcl_oop_t)obj;
#else
hcl_oop_dic_t v;
v = (hcl_oop_dic_t)hcl_instantiate(hcl, hcl->c_dictionary, HCL_NULL, 0);
if (HCL_UNLIKELY(!v))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make dictionary - %js", orgmsg);
}
else
{
hcl_oop_oop_t bucket;
v->tally = HCL_SMOOI_TO_OOP(0);
hcl_pushvolat (hcl, (hcl_oop_t*)&v);
bucket = (hcl_oop_oop_t)hcl_makearray(hcl, inisize);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!bucket))
{
/* TODO: can I remove the instanated object immediately above?
* it must be ok as the dictionary object is never referenced.
* some care must be taken not to screw up gc metadata... */
v = HCL_NULL;
}
else v->bucket = bucket;
}
return (hcl_oop_t)v;
#endif
}
int hcl_walkdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_dic_walker_t walker, void* ctx)

8
lib/hcl.c
View File

@ -172,10 +172,10 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, const hcl_vmprim_t* vmprim)
hcl->tagged_brands[HCL_OOP_TAG_CHAR] = HCL_BRAND_CHARACTER;
hcl->tagged_brands[HCL_OOP_TAG_ERROR] = HCL_BRAND_ERROR;
hcl->tagged_classes[HCL_OOP_TAG_SMOOI] = &hcl->c_small_integer;
hcl->tagged_classes[HCL_OOP_TAG_SMPTR] = &hcl->c_small_pointer;
hcl->tagged_classes[HCL_OOP_TAG_CHAR] = &hcl->c_character;
hcl->tagged_classes[HCL_OOP_TAG_ERROR] = &hcl->c_error;
hcl->tagged_classes[HCL_OOP_TAG_SMOOI] = &hcl->c_small_integer;
hcl->tagged_classes[HCL_OOP_TAG_SMPTR] = &hcl->c_small_pointer;
hcl->tagged_classes[HCL_OOP_TAG_CHAR] = &hcl->c_character;
hcl->tagged_classes[HCL_OOP_TAG_ERROR] = &hcl->c_error;
hcl->proc_map_free_first = -1;
hcl->proc_map_free_last = -1;

25
lib/hcl.h
View File

@ -366,7 +366,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_FLAGS_MOVED_BITS (2) /* 16 */
#define HCL_OBJ_FLAGS_NGC_BITS (1) /* 17 */
#define HCL_OBJ_FLAGS_TRAILER_BITS (1) /* 18 */
#define HCL_OBJ_FLAGS_SYNCODE_BITS (5) /* 23 */
#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 */
@ -2086,19 +2086,30 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_NIL(hcl,v) (v == (hcl)->_nil)
#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_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_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT)
#define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)
#define HCL_IS_BLOCK(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BLOCK)
#define HCL_IS_CLASS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CLASS)
#define HCL_IS_INSTANCE(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_INSTANCE)
#define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS)
#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_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->c_array) TODO: change to check the class instead?? remove brands?? */
#define HCL_IS_BYTEARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_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_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_PBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT)
#define HCL_IS_NBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT)

32
lib/obj.c
View File

@ -259,18 +259,18 @@ hcl_oop_t hcl_hatchundef (hcl_t* hcl)
/* create the undef object for bootstrapping.
* this function doesn't set the class field */
hcl_oop_t o;
o = hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0);
if (HCL_LIKELY(o))
{
HCL_OBJ_SET_FLAGS_KERNEL(o, 1);
}
else
hcl_oop_t v;
v = hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0);
if (HCL_UNLIKELY(!v))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make undef - %js", orgmsg);
}
return o;
else
{
HCL_OBJ_SET_FLAGS_KERNEL(v, 1);
}
return v;
}
hcl_oop_t hcl_hatchnil (hcl_t* hcl)
@ -278,18 +278,18 @@ hcl_oop_t hcl_hatchnil (hcl_t* hcl)
/* create the nil object for bootstrapping.
* this function doesn't set the class field */
hcl_oop_t o;
o = hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0);
if (HCL_LIKELY(o))
{
HCL_OBJ_SET_FLAGS_KERNEL(o, 1);
}
else
hcl_oop_t v;
v = hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0);
if (HCL_UNLIKELY(!v))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make nil - %js", orgmsg);
}
return o;
else
{
HCL_OBJ_SET_FLAGS_KERNEL(v, 1);
}
return v;
}
hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t len)