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

call hcl_instantiate() with hcl->c_primitive in hcl_makeprim()
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-09-12 00:26:23 +09:00
parent b5c24eb440
commit 8604c6ddf1
5 changed files with 59 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lib/comp.c
View File

@ -4279,7 +4279,8 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
if (nargs < sdv->slot[1] || nargs > sdv->slot[2]) if (nargs < sdv->slot[1] || nargs > sdv->slot[2])
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL,
"parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters", nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]); "parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters",
nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]);
return -1; return -1;
} }
} }

4
lib/exec.c
View File

@ -2135,7 +2135,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
rcv = (hcl_oop_prim_t)HCL_STACK_GETOP(hcl, nargs); rcv = (hcl_oop_prim_t)HCL_STACK_GETOP(hcl, nargs);
HCL_ASSERT (hcl, HCL_IS_PRIM(hcl, rcv)); HCL_ASSERT (hcl, HCL_IS_PRIM(hcl, rcv));
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv) == HCL_PRIM_NUM_WORDS); HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv) == HCL_PRIM_NAMED_INSTVARS);
if (nargs < rcv->min_nargs && nargs > rcv->max_nargs) if (nargs < rcv->min_nargs && nargs > rcv->max_nargs)
{ {
@ -3432,6 +3432,8 @@ static int execute (hcl_t* hcl)
b1 = bcode & 0x7; /* low 3 bits */ b1 = bcode & 0x7; /* low 3 bits */
store_instvar: store_instvar:
LOG_INST_2 (hcl, "store_into_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff)); LOG_INST_2 (hcl, "store_into_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff));
/* TODO: support if the receiver is an object with named/flexi pure-numeric fields (e.g. word, byte, etc).
* the following assertion must be lifted... */
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP); HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
b1 += HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff); b1 += HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff);
((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl);

26
lib/gc.c
View File

@ -141,8 +141,8 @@ enum {
KCI_CONS, KCI_CONS,
KCI_METHOD_DICTIONARY, KCI_METHOD_DICTIONARY,
KCI_FUNCTION, KCI_FUNCTION,
KCI_PRIMITIVE,
KCI_COMPILED_BLOCK, KCI_COMPILED_BLOCK,
KCI_METHOD_CONTEXT,
KCI_BLOCK_CONTEXT, KCI_BLOCK_CONTEXT,
KCI_PROCESS, KCI_PROCESS,
KCI_SEMAPHORE, KCI_SEMAPHORE,
@ -448,15 +448,17 @@ static kernel_class_info_t kernel_classes[__KCI_MAX__] =
HCL_OFFSETOF(hcl_t, c_function) HCL_OFFSETOF(hcl_t, c_function)
}, },
#if 0 KCI(KCI_PRIMITIVE) {
{ "Primitive", HCL_BRAND_PRIM, "Primitive",
KCI_OBJECT,
HCL_BRAND_PRIM,
0, 0,
0, 0,
HCL_PRIM_NAMED_INSTVARS, HCL_PRIM_NAMED_INSTVARS,
0, 0,
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_WORD,
HCL_OFFSETOF(hcl_t, c_prim) }, HCL_OFFSETOF(hcl_t, c_primitive)
#endif },
KCI(KCI_COMPILED_BLOCK) { KCI(KCI_COMPILED_BLOCK) {
"CompiledBlock", "CompiledBlock",
@ -470,18 +472,6 @@ static kernel_class_info_t kernel_classes[__KCI_MAX__] =
HCL_OFFSETOF(hcl_t, c_block) HCL_OFFSETOF(hcl_t, c_block)
}, },
KCI(KCI_METHOD_CONTEXT) {
"MethodContext",
KCI_OBJECT,
0,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_context)
},
KCI(KCI_BLOCK_CONTEXT) { KCI(KCI_BLOCK_CONTEXT) {
"BlockContext", "BlockContext",
KCI_OBJECT, KCI_OBJECT,

29
lib/hcl.h
View File

@ -531,7 +531,7 @@ struct hcl_trailer_t
#define HCL_OBJ_GET_TRAILER_BYTE(oop) ((hcl_oob_t*)&((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop) + 1]) #define HCL_OBJ_GET_TRAILER_BYTE(oop) ((hcl_oob_t*)&((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop) + 1])
#define HCL_OBJ_GET_TRAILER_SIZE(oop) ((hcl_oow_t)((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop)]) #define HCL_OBJ_GET_TRAILER_SIZE(oop) ((hcl_oow_t)((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop)])
#define HCL_PRIM_NUM_WORDS 4 #define HCL_PRIM_NAMED_INSTVARS 4
typedef struct hcl_prim_t hcl_prim_t; typedef struct hcl_prim_t hcl_prim_t;
typedef struct hcl_prim_t* hcl_oop_prim_t; typedef struct hcl_prim_t* hcl_oop_prim_t;
struct hcl_prim_t struct hcl_prim_t
@ -1737,7 +1737,6 @@ struct hcl_t
hcl_oop_class_t c_primitive; /* Primitive */ hcl_oop_class_t c_primitive; /* Primitive */
hcl_oop_class_t c_block; /* CompiledBlock */ hcl_oop_class_t c_block; /* CompiledBlock */
hcl_oop_class_t c_method_context; /* MethodContext */
hcl_oop_class_t c_block_context; /* BlockContext */ hcl_oop_class_t c_block_context; /* BlockContext */
hcl_oop_class_t c_process; /* Process */ hcl_oop_class_t c_process; /* Process */
hcl_oop_class_t c_semaphore; /* Semaphore */ hcl_oop_class_t c_semaphore; /* Semaphore */
@ -2090,12 +2089,22 @@ typedef enum hcl_concode_t hcl_concode_t;
/*#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_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_STRING(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_STRING)*/
#define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION) #define HCL_IS_STRING(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_string)
#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_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_BLOCK(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BLOCK)*/
#define HCL_IS_BLOCK(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_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_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(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)hcl->c_cons)
@ -2110,12 +2119,14 @@ typedef enum hcl_concode_t hcl_concode_t;
/*#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_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_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_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) #define HCL_IS_NBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT)
#define HCL_IS_BIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && (HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT || HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT)) #define HCL_IS_BIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && (HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT || HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT))
#define HCL_IS_STRING(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_STRING)
#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_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FPDEC)
#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_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_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_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_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_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SEMAPHORE_GROUP)

24
lib/prim.c
View File

@ -39,9 +39,10 @@ typedef struct pf_t pf_t;
hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs, hcl_mod_t* mod) hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs, hcl_mod_t* mod)
{ {
hcl_oop_prim_t obj; /* in principle, hcl_oop_word_t with HCL_PRIM_NUM_WORDS elements */ #if 0
hcl_oop_prim_t obj; /* in principle, hcl_oop_word_t with HCL_PRIM_NAMED_INSTVARS elements */
obj = (hcl_oop_prim_t)hcl_allocwordobj(hcl, HCL_BRAND_PRIM, HCL_NULL, HCL_PRIM_NUM_WORDS); obj = (hcl_oop_prim_t)hcl_allocwordobj(hcl, HCL_BRAND_PRIM, HCL_NULL, HCL_PRIM_NAMED_INSTVARS);
if (HCL_LIKELY(obj)) if (HCL_LIKELY(obj))
{ {
obj->impl = (hcl_oow_t)primimpl; obj->impl = (hcl_oow_t)primimpl;
@ -51,6 +52,25 @@ hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hc
} }
return (hcl_oop_t)obj; return (hcl_oop_t)obj;
#else
hcl_oop_prim_t v; /* in principle, hcl_oop_word_t with HCL_PRIM_NUM_WORDS elements */
v = (hcl_oop_prim_t)hcl_instantiate(hcl, hcl->c_primitive, HCL_NULL, 0);
if (HCL_UNLIKELY(!v))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make primitive - %js", orgmsg);
}
else
{
v->impl = (hcl_oow_t)primimpl;
v->min_nargs = minargs;
v->max_nargs = maxargs;
v->mod = (hcl_oow_t)mod;
}
return (hcl_oop_t)v;
#endif
} }
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */