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

first successful implementation of class instantion methods

Browse Source
This commit is contained in:
hyung-hwan 2022-03-17 13:22:17 +00:00
parent 4f37815caf
commit 8747afba63
11 changed files with 252 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lib/comp.c
View File

@ -299,7 +299,7 @@ static int find_variable_backward (hcl_t* hcl, const hcl_cnode_t* token, hcl_var
for (fi = hcl->c->fnblk.depth + 1; fi > i; ) /* TOOD: review this loop for correctness */
{
/* 'i' is the function level that hold the class defintion block. the check must not go past it */
/* 'i' is the function level that holds the class defintion block. the check must not go past it */
if (hcl->c->fnblk.info[--fi].fun_type == FUN_CM)
{
/* the function where this variable is defined is a class method or an plain function block within a class method*/
@ -578,6 +578,7 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case HCL_CODE_POP_INTO_CVAR_M_X:
case HCL_CODE_CLASS_CMSTORE:
case HCL_CODE_CLASS_CIMSTORE:
case HCL_CODE_CLASS_IMSTORE:
case HCL_CODE_TRY_ENTER:
case HCL_CODE_TRY_ENTER2:
@ -1106,7 +1107,7 @@ static void pop_fnblk (hcl_t* hcl)
if (fbi->make_inst_pos < hcl->code.bc.len)
{
hcl_oow_t tmpr_mask;
hcl_oow_t attr_mask;
/* patch the temporaries mask parameter for the MAKE_BLOCK or MAKE_FUNCTION instruction */
HCL_ASSERT (hcl, hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_BLOCK ||
@ -1118,8 +1119,8 @@ static void pop_fnblk (hcl_t* hcl)
/* the temporaries mask is a bit-mask that encodes the counts of different temporary variables.
* and it's split to two intruction parameters when used with MAKE_BLOCK and MAKE_FUNCTION */
tmpr_mask = ENCODE_BLKTMPR_MASK(fbi->tmpr_va, fbi->tmpr_nargs, fbi->tmpr_nrvars, fbi->tmpr_nlvars);
patch_double_long_params_with_oow (hcl, fbi->make_inst_pos + 1, tmpr_mask);
attr_mask = ENCODE_BLK_MASK((fbi->fun_type == FUN_CIM), fbi->tmpr_va, fbi->tmpr_nargs, fbi->tmpr_nrvars, fbi->tmpr_nlvars);
patch_double_long_params_with_oow (hcl, fbi->make_inst_pos + 1, attr_mask);
}
}
@ -1310,6 +1311,7 @@ enum
COP_EMIT_RETURN,
COP_EMIT_SET,
COP_EMIT_CLASS_CMSTORE,
COP_EMIT_CLASS_CIMSTORE,
COP_EMIT_CLASS_IMSTORE,
COP_EMIT_THROW,
@ -2581,7 +2583,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
{
/* MAKE_FUNCTION tmpr_mask_1 tmpr_mask_2 lfbase lfsize */
/* MAKE_FUNCTION attr_mask_1 attr_mask_2 lfbase lfsize */
if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_FUNCTION, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
lfbase_pos = hcl->code.bc.len;
if (emit_long_param(hcl, hcl->code.lit.len - hcl->c->fnblk.info[hcl->c->fnblk.depth - 1].lfbase) <= -1) return -1; /* literal frame base */
@ -2590,7 +2592,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
}
else
{
/* MAKE_BLOCK tmpr_mask_1 tmpr_mask_2 - will patch tmpr_mask in pop_fnblk() */
/* MAKE_BLOCK attr_mask_1 attr_mask_2 - will patch attr_mask in pop_fnblk() */
if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
}
@ -4888,10 +4890,13 @@ static HCL_INLINE int post_lambda (hcl_t* hcl)
switch (cf->u.lambda.fun_type)
{
case FUN_CM: /* class method */
case FUN_CIM: /* class instantiation method */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_CLASS_CMSTORE, defun_name);
break;
case FUN_CIM: /* class instantiation method */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_CLASS_CIMSTORE, defun_name);
break;
case FUN_IM: /* instance method */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_CLASS_IMSTORE, defun_name);
break;
@ -5021,7 +5026,26 @@ static HCL_INLINE int emit_class_cmstore (hcl_t* hcl)
if (HCL_UNLIKELY(!lit)) return -1;
if (add_literal(hcl, lit, &index) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_CMSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_CMSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
POP_CFRAME (hcl);
return 0;
}
static HCL_INLINE int emit_class_cimstore (hcl_t* hcl)
{
hcl_cframe_t* cf;
hcl_oop_t lit;
hcl_oow_t index;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CLASS_CIMSTORE);
lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(cf->operand), HCL_CNODE_GET_TOKLEN(cf->operand));
if (HCL_UNLIKELY(!lit)) return -1;
if (add_literal(hcl, lit, &index) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_CIMSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
POP_CFRAME (hcl);
return 0;
@ -5040,7 +5064,7 @@ static HCL_INLINE int emit_class_imstore (hcl_t* hcl)
if (HCL_UNLIKELY(!lit)) return -1;
if (add_literal(hcl, lit, &index) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_IMSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_IMSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
POP_CFRAME (hcl);
return 0;
@ -5296,6 +5320,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
if (emit_class_cmstore(hcl) <= -1) goto oops;
break;
case COP_EMIT_CLASS_CIMSTORE:
if (emit_class_cimstore(hcl) <= -1) goto oops;
break;
case COP_EMIT_CLASS_IMSTORE:
if (emit_class_imstore(hcl) <= -1) goto oops;
break;

36
lib/decode.c
View File

@ -35,6 +35,7 @@
#define LOG_INST_4(hcl,fmt,a1,a2,a3,a4) HCL_LOG5(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4)
#define LOG_INST_5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG6(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4, a5)
#define LOG_INST_6(hcl,fmt,a1,a2,a3,a4,a5,a6) HCL_LOG7(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4, a5, a6)
#define LOG_INST_7(hcl,fmt,a1,a2,a3,a4,a5,a6,a7) HCL_LOG8(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4, a5, a6, a7)
#define FETCH_BYTE_CODE(hcl) (cdptr[ip++])
@ -391,6 +392,11 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
LOG_INST_1 (hcl, "class_cmstore %zu", b1);
break;
case HCL_CODE_CLASS_CIMSTORE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "class_cimstore %zu", b1);
break;
case HCL_CODE_CLASS_IMSTORE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "class_imstore %zu", b1);
@ -678,8 +684,8 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
case HCL_CODE_MAKE_FUNCTION:
{
hcl_oow_t b3, b4;
/* b1 - block temporaries mask
* b2 - block temporaries mask
/* b1 - block mask
* b2 - block mask
* b3 - base literal frame start
* b4 - base literal frame end */
FETCH_PARAM_CODE_TO (hcl, b1);
@ -688,11 +694,12 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
FETCH_PARAM_CODE_TO (hcl, b4);
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
LOG_INST_6 (hcl, "make_function %zu %zu %zu %zu %zu %zu",
GET_BLKTMPR_MASK_VA(b1),
GET_BLKTMPR_MASK_NARGS(b1),
GET_BLKTMPR_MASK_NRVARS(b1),
GET_BLKTMPR_MASK_NLVARS(b1),
LOG_INST_7 (hcl, "make_function %zu %zu %zu %zu %zu %zu %zu",
GET_BLK_MASK_INSTA(b1),
GET_BLK_MASK_VA(b1),
GET_BLK_MASK_NARGS(b1),
GET_BLK_MASK_NRVARS(b1),
GET_BLK_MASK_NLVARS(b1),
b3, b4);
HCL_ASSERT (hcl, b1 >= 0);
@ -700,17 +707,18 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
}
case HCL_CODE_MAKE_BLOCK:
/* b1 - block temporaries mask
* b2 - block temporaries mask */
/* b1 - block mask
* b2 - block mask */
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
LOG_INST_4 (hcl, "make_block %zu %zu %zu %zu",
GET_BLKTMPR_MASK_VA(b1),
GET_BLKTMPR_MASK_NARGS(b1),
GET_BLKTMPR_MASK_NRVARS(b1),
GET_BLKTMPR_MASK_NLVARS(b1));
LOG_INST_5 (hcl, "make_block %zu %zu %zu %zu %zu",
GET_BLK_MASK_INSTA(b1),
GET_BLK_MASK_VA(b1),
GET_BLK_MASK_NARGS(b1),
GET_BLK_MASK_NRVARS(b1),
GET_BLK_MASK_NLVARS(b1));
HCL_ASSERT (hcl, b1 >= 0);
break;

2
lib/dic.c
View File

@ -192,7 +192,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k
* make sure that it has at least one free slot left
* after having added a new symbol. this is to help
* traversal end at a _nil slot if no entry is found. */
bucket = expand_bucket (hcl, dic->bucket);
bucket = expand_bucket(hcl, dic->bucket);
if (!bucket) goto oops;
dic->bucket = bucket;

185
lib/exec.c
View File

@ -123,7 +123,7 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' };
# define LOG_INST_4(hcl,fmt,a1,a2,a3,a4) HCL_LOG5(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4)
# define LOG_INST_5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG6(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4, a5)
# define LOG_INST_6(hcl,fmt,a1,a2,a3,a4,a5,a6) HCL_LOG7(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4, a5, a6)
# define LOG_INST_7(hcl,fmt,a1,a2,a3,a4,a5,a6,a7) HCL_LOG8(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4, a5, a6, a7)
#else
# define LOG_INST_0(hcl,fmt)
# define LOG_INST_1(hcl,fmt,a1)
@ -132,6 +132,7 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' };
# define LOG_INST_4(hcl,fmt,a1,a2,a3,a4)
# define LOG_INST_5(hcl,fmt,a1,a2,a3,a4,a5)
# define LOG_INST_6(hcl,fmt,a1,a2,a3,a4,a5,a6)
# define LOG_INST_7(hcl,fmt,a1,a2,a3,a4,a5,a6,a7)
#endif
static int delete_sem_from_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, int force);
@ -403,13 +404,13 @@ static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize
return func;
}
static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, hcl_ooi_t tmpr_mask, hcl_oop_context_t homectx, const hcl_oop_t* lfptr, hcl_oow_t lfsize)
static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, hcl_ooi_t attr_mask, hcl_oop_context_t homectx, const hcl_oop_t* lfptr, hcl_oow_t lfsize)
{
/* Although this function could be integrated into make_function(),
* this function has been separated from make_function() to make GC handling simpler */
hcl_oow_t i;
HCL_ASSERT (hcl, tmpr_mask >= 0 && tmpr_mask <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, attr_mask >= 0 && attr_mask <= HCL_SMOOI_MAX);
/* copy literal frames */
HCL_ASSERT (hcl, lfsize <= HCL_OBJ_GET_SIZE(func) - HCL_FUNCTION_NAMED_INSTVARS);
@ -423,7 +424,7 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func,
/* initialize other fields */
func->home = homectx;
func->tmpr_mask = HCL_SMOOI_TO_OOP(tmpr_mask);
func->attr_mask = HCL_SMOOI_TO_OOP(attr_mask);
}
static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl)
@ -432,14 +433,14 @@ static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl)
return (hcl_oop_block_t)hcl_allocoopobj(hcl, HCL_BRAND_BLOCK, HCL_BLOCK_NAMED_INSTVARS);
}
static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_block_t blk, hcl_ooi_t tmpr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx)
static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_block_t blk, hcl_ooi_t attr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx)
{
HCL_ASSERT (hcl, tmpr_mask >= 0 && tmpr_mask <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, attr_mask >= 0 && attr_mask <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, ip >= 0 && ip <= HCL_SMOOI_MAX);
blk->home = homectx;
blk->ip = HCL_SMOOI_TO_OOP(ip);
blk->tmpr_mask = HCL_SMOOI_TO_OOP(tmpr_mask);
blk->attr_mask = HCL_SMOOI_TO_OOP(attr_mask);
}
static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl)
@ -1902,22 +1903,22 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na
* the passed block context becomes the base for a new block context. */
hcl_oop_context_t blkctx;
hcl_ooi_t tmpr_mask;
hcl_ooi_t attr_mask;
hcl_ooi_t fblk_nrvars, fblk_nlvars;
hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs;
/* the receiver must be a block context */
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
tmpr_mask = HCL_OOP_TO_SMOOI(op_blk->tmpr_mask);
attr_mask = HCL_OOP_TO_SMOOI(op_blk->attr_mask);
fblk_nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
fblk_nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
fblk_nrvars = GET_BLK_MASK_NRVARS(attr_mask);
fblk_nlvars = GET_BLK_MASK_NLVARS(attr_mask);
fixed_nargs = GET_BLK_MASK_NARGS(attr_mask);
actual_nargs = nargs - nargs_offset;
excess_nargs = actual_nargs - fixed_nargs;
if (actual_nargs < fixed_nargs || (!GET_BLKTMPR_MASK_VA(tmpr_mask) && actual_nargs > fixed_nargs))
if (actual_nargs < fixed_nargs || (!GET_BLK_MASK_VA(attr_mask) && actual_nargs > fixed_nargs))
{
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
"Error - wrong number of arguments to a block %O - expecting %zd, got %zd\n",
@ -1950,7 +1951,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na
#else
blkctx->ip = op_blk->ip;
blkctx->req_nrets = HCL_SMOOI_TO_OOP(req_nrvars);
blkctx->tmpr_mask = op_blk->tmpr_mask;
blkctx->attr_mask = op_blk->attr_mask;
blkctx->base = op_blk->home->base;
if (is_msgsend)
@ -2039,7 +2040,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_
hcl_oop_context_t functx;
hcl_ooi_t i, j;
hcl_ooi_t tmpr_mask;
hcl_ooi_t attr_mask;
hcl_ooi_t nrvars, nlvars, fixed_nargs, actual_nargs, excess_nargs;
hcl_ooi_t nargs_offset = 0;
@ -2052,14 +2053,14 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op_func));
tmpr_mask = HCL_OOP_TO_SMOOI(op_func->tmpr_mask);
nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
attr_mask = HCL_OOP_TO_SMOOI(op_func->attr_mask);
nrvars = GET_BLK_MASK_NRVARS(attr_mask);
nlvars = GET_BLK_MASK_NLVARS(attr_mask);
fixed_nargs = GET_BLK_MASK_NARGS(attr_mask);
actual_nargs = nargs - nargs_offset;
excess_nargs = actual_nargs - fixed_nargs;
if (actual_nargs < fixed_nargs || (!GET_BLKTMPR_MASK_VA(tmpr_mask) && actual_nargs > fixed_nargs))
if (actual_nargs < fixed_nargs || (!GET_BLK_MASK_VA(attr_mask) && actual_nargs > fixed_nargs))
{
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
"Error - wrong number of arguments to a function %O - expecting %zd, got %zd\n",
@ -2076,7 +2077,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_
functx->ip = HCL_SMOOI_TO_OOP(0);
functx->req_nrets = HCL_SMOOI_TO_OOP(1);
functx->tmpr_mask = op_func->tmpr_mask;
functx->attr_mask = op_func->attr_mask;
functx->base = op_func;
functx->home = op_func->home;
functx->receiver = HCL_STACK_GETRCV(hcl, nargs);
@ -2142,7 +2143,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
/* ------------------------------------------------------------------------- */
static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_oop_class_t* owner)
static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner)
{
hcl_oocs_t name;
@ -2165,7 +2166,7 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
hcl_oop_t dic;
dic = class_->cdic;
dic = class_->mdic;
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, dic) || HCL_IS_DIC(hcl, dic));
if (HCL_LIKELY(!HCL_IS_NIL(hcl, dic)))
@ -2176,11 +2177,14 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
{
hcl_oop_t val;
val = HCL_CONS_CDR(ass);
if (HCL_IS_BLOCK(hcl, val))
if (HCL_IS_CONS(hcl, val) && !HCL_IS_NIL(hcl, HCL_CONS_CAR(val)))
{
/* TODO: futher check if it's a method block? */
*owner = class_;
return (hcl_oop_block_t)val;
/* ivaroff isn't useful for a clas smethod but is useful for class instatiation method
* (INSTA bit on in the mask field) */
*ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super);
return (hcl_oop_block_t)HCL_CONS_CAR(val); /* car - class method, cdr - instance method */
}
}
}
@ -2212,7 +2216,7 @@ static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
{
hcl_oop_t dic;
dic = class_->idic;
dic = class_->mdic;
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, dic) || HCL_IS_DIC(hcl, dic));
if (HCL_LIKELY(!HCL_IS_NIL(hcl, dic)))
@ -2223,12 +2227,12 @@ static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
{
hcl_oop_t val;
val = HCL_CONS_CDR(ass);
if (HCL_IS_BLOCK(hcl, val))
if (HCL_IS_CONS(hcl, val) && !HCL_IS_NIL(hcl, HCL_CONS_CDR(val)))
{
/* TODO: futher check if it's a method block? */
*owner = class_;
*ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super);
return (hcl_oop_block_t)val;
return (hcl_oop_block_t)HCL_CONS_CDR(val); /* car - class method, cdr - instance method */
}
}
}
@ -2256,7 +2260,23 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
if (HCL_IS_CLASS(hcl, rcv))
{
class_ = (hcl_oop_class_t)rcv;
mth_blk = find_cmethod_noseterr(hcl, class_, msg, to_super, &owner);
mth_blk = find_cmethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
if (!mth_blk) goto msg_not_found;
if (GET_BLK_MASK_INSTA(HCL_OOP_TO_SMOOI(mth_blk->attr_mask)))
{
hcl_oop_t newrcv;
hcl_pushvolat (hcl, (hcl_oop_t*)&mth_blk);
hcl_pushvolat (hcl, &msg);
hcl_pushvolat (hcl, &rcv);
newrcv = hcl_instantiate(hcl, (hcl_oop_class_t)class_, HCL_NULL, 0);
hcl_popvolats (hcl, 3);
if (HCL_UNLIKELY(!newrcv)) return -1;
HCL_STACK_SETRCV (hcl, nargs, newrcv); /* prepare_new_context() will take this as a receiver */
}
}
else
{
@ -2264,11 +2284,12 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv->_class));
class_ = (hcl_oop_class_t)rcv->_class;
mth_blk = find_imethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
}
if (!mth_blk)
{
hcl_seterrbfmt (hcl, HCL_ENOENT, "'%.*js' not found in %O", HCL_OBJ_GET_SIZE(msg), HCL_OBJ_GET_CHAR_SLOT(msg), class_);
return -1;
if (!mth_blk)
{
msg_not_found:
hcl_seterrbfmt (hcl, HCL_ENOENT, "'%.*js' not found in %O", HCL_OBJ_GET_SIZE(msg), HCL_OBJ_GET_CHAR_SLOT(msg), class_);
return -1;
}
}
x = __activate_block(hcl, mth_blk, nargs, nrvars, 1 /* is_msgsend */, ivaroff, &newctx);
@ -2580,9 +2601,9 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip,
{
hcl_oop_context_t ctx;
hcl_oop_process_t proc;
hcl_ooi_t tmpr_mask;
hcl_ooi_t attr_mask;
tmpr_mask = ENCODE_BLKTMPR_MASK(0, 0, 0, nlvars);
attr_mask = ENCODE_BLK_MASK(0, 0, 0, 0, nlvars);
/* create the initial context over the initial function */
ctx = make_context(hcl, nlvars);
if (HCL_UNLIKELY(!ctx)) return -1;
@ -2592,7 +2613,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip,
ctx->ip = HCL_SMOOI_TO_OOP(initial_ip);
ctx->req_nrets = HCL_SMOOI_TO_OOP(1);
ctx->tmpr_mask = HCL_SMOOI_TO_OOP(tmpr_mask);
ctx->attr_mask = HCL_SMOOI_TO_OOP(attr_mask);
ctx->home = hcl->initial_function->home; /* this should be nil */
ctx->sender = (hcl_oop_context_t)hcl->_nil; /* the initial context has nil in the sender field */
ctx->base = hcl->initial_function;
@ -3607,7 +3628,7 @@ static int execute (hcl_t* hcl)
{
hcl_oop_context_t ctx;
hcl_oow_t i;
hcl_ooi_t tmpr_mask, fixed_nargs, req_nrets;
hcl_ooi_t attr_mask, fixed_nargs, req_nrets;
LOG_INST_0 (hcl, "push_return_r");
@ -3615,8 +3636,8 @@ static int execute (hcl_t* hcl)
ctx = hcl->active_context;
tmpr_mask = HCL_OOP_TO_SMOOI(ctx->tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
attr_mask = HCL_OOP_TO_SMOOI(ctx->attr_mask);
fixed_nargs = GET_BLK_MASK_NARGS(attr_mask);
req_nrets = HCL_OOP_TO_SMOOI(ctx->req_nrets);
@ -3845,42 +3866,14 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
}
case HCL_CODE_CLASS_CMSTORE:
{
hcl_oop_t class_;
hcl_oop_t dic;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "class_cmstore %zu", b1);
/* store the stack top in the member dictionary of the currect class with the key indicated by 'b1' */
HCL_ASSERT (hcl, !HCL_CLSTACK_IS_EMPTY(hcl));
HCL_CLSTACK_FETCH_TOP_TO (hcl, class_);
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_));
dic = ((hcl_oop_class_t)class_)->cdic; /* class-side dictionary */
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, dic) || HCL_IS_DIC(hcl, dic));
if (HCL_IS_NIL(hcl, dic))
{
hcl_pushvolat (hcl, (hcl_oop_t*)&class_);
dic = hcl_makedic(hcl, 16); /* TODO: configurable initial size? */
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!dic)) goto oops_with_errmsg_supplement;
((hcl_oop_class_t)class_)->cdic = dic;
}
if (!hcl_putatdic(hcl, (hcl_oop_dic_t)dic, hcl->active_function->literal_frame[b1], HCL_STACK_GETTOP(hcl))) goto oops_with_errmsg_supplement;
break;
}
case HCL_CODE_CLASS_CIMSTORE:
case HCL_CODE_CLASS_IMSTORE:
{
hcl_oop_t class_;
hcl_oop_t dic;
hcl_oop_t mdic, cons, blk;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "class_imstore %zu", b1);
LOG_INST_2 (hcl, "class_%hsmstore %zu", (bcode == HCL_CODE_CLASS_CMSTORE? "c": (bcode == HCL_CODE_CLASS_CIMSTORE? "ci": "i")), b1);
/* store the stack top in the member dictionary of the currect class with the key indicated by 'b1' */
@ -3889,18 +3882,24 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
HCL_CLSTACK_FETCH_TOP_TO (hcl, class_);
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_));
dic = ((hcl_oop_class_t)class_)->idic; /* instance-side dictionary */
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, dic) || HCL_IS_DIC(hcl, dic));
if (HCL_IS_NIL(hcl, dic))
mdic = ((hcl_oop_class_t)class_)->mdic; /* instance-side dictionary */
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, mdic) || HCL_IS_DIC(hcl, mdic));
if (HCL_IS_NIL(hcl, mdic))
{
hcl_pushvolat (hcl, (hcl_oop_t*)&class_);
dic = hcl_makedic(hcl, 16); /* TODO: configurable initial size? */
mdic = hcl_makedic(hcl, 16); /* TODO: configurable initial size? */
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!dic)) goto oops_with_errmsg_supplement;
((hcl_oop_class_t)class_)->idic = dic;
if (HCL_UNLIKELY(!mdic)) goto oops_with_errmsg_supplement;
((hcl_oop_class_t)class_)->mdic = mdic;
}
if (!hcl_putatdic(hcl, (hcl_oop_dic_t)dic, hcl->active_function->literal_frame[b1], HCL_STACK_GETTOP(hcl))) goto oops_with_errmsg_supplement;
blk = HCL_STACK_GETTOP(hcl);
hcl_pushvolat (hcl, (hcl_oop_t*)&mdic);
cons = hcl_makecons(hcl, (bcode == HCL_CODE_CLASS_IMSTORE? hcl->_nil: blk), (bcode == HCL_CODE_CLASS_CMSTORE? hcl->_nil: blk));
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!cons)) goto oops_with_errmsg_supplement;
if (!hcl_putatdic(hcl, (hcl_oop_dic_t)mdic, hcl->active_function->literal_frame[b1], cons)) goto oops_with_errmsg_supplement;
break;
}
/* -------------------------------------------------------- */
@ -4063,8 +4062,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
handle_send_2:
rcv = HCL_STACK_GETRCV(hcl, b1);
op = HCL_STACK_GETOP(hcl, b1);
/*if (!HCL_IS_SYMBOL(hcl, op))*/
if (!HCL_OBJ_IS_CHAR_POINTER(op))
if (!HCL_OBJ_IS_CHAR_POINTER(op)) /*if (!HCL_IS_SYMBOL(hcl, op))*/
{
hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid message", op, rcv); /* TODO: change to HCL_ESEND?? */
goto cannot_send;
@ -4073,7 +4071,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
if (send_message(hcl, rcv, op, ((bcode >> 2) & 1) /* to_super */, b1 /* nargs */, b2 /* nrvars */) <= -1)
{
const hcl_ooch_t* msg = hcl_backuperrmsg (hcl);
const hcl_ooch_t* msg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - %js", op, rcv, msg); /* TODO: change to HCL_ESEND?? */
goto cannot_send;
}
@ -4083,7 +4081,6 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid receiver", op, rcv); /* TODO: change to HCL_ESEND?? */
cannot_send:
//HCL_STACK_POPS (hcl, b1 + 2); /* pop the receiver, message, and arguments as the call fails. TODO: check if this clearing is correct */
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
goto oops_with_errmsg_supplement;
}
@ -4561,11 +4558,12 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
FETCH_PARAM_CODE_TO (hcl, b4);
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
LOG_INST_6 (hcl, "make_function %zu %zu %zu %zu %zu %zu",
GET_BLKTMPR_MASK_VA(b1),
GET_BLKTMPR_MASK_NARGS(b1),
GET_BLKTMPR_MASK_NRVARS(b1),
GET_BLKTMPR_MASK_NLVARS(b1),
LOG_INST_7 (hcl, "make_function %zu %zu %zu %zu %zu %zu %zu",
GET_BLK_MASK_INSTA(b1),
GET_BLK_MASK_VA(b1),
GET_BLK_MASK_NARGS(b1),
GET_BLK_MASK_NRVARS(b1),
GET_BLK_MASK_NLVARS(b1),
b3, b4);
HCL_ASSERT (hcl, b1 >= 0);
@ -4603,11 +4601,12 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
LOG_INST_4 (hcl, "make_block %zu %zu %zu %zu",
GET_BLKTMPR_MASK_VA(b1),
GET_BLKTMPR_MASK_NARGS(b1),
GET_BLKTMPR_MASK_NRVARS(b1),
GET_BLKTMPR_MASK_NLVARS(b1));
LOG_INST_5 (hcl, "make_block %zu %zu %zu %zu %zu",
GET_BLK_MASK_INSTA(b1),
GET_BLK_MASK_VA(b1),
GET_BLK_MASK_NARGS(b1),
GET_BLK_MASK_NRVARS(b1),
GET_BLK_MASK_NLVARS(b1));
HCL_ASSERT (hcl, b1 >= 0);
@ -4697,7 +4696,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
if (HCL_UNLIKELY(!funcobj)) return HCL_NULL;
/* pass nil for the home context of the initial function */
fill_function_data (hcl, funcobj, ENCODE_BLKTMPR_MASK(0,0,0,hcl->code.ngtmprs), (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len);
fill_function_data (hcl, funcobj, ENCODE_BLK_MASK(0,0,0,0,hcl->code.ngtmprs), (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len);
hcl->initial_function = funcobj; /* the initial function is ready */

46
lib/hcl-prv.h
View File

@ -596,35 +596,37 @@ struct hcl_compiler_t
#if defined(HCL_CODE_LONG_PARAM_SIZE) && (HCL_CODE_LONG_PARAM_SIZE == 1)
# define MAX_CODE_NBLKARGS (0xFu) /* 15 */
# define MAX_CODE_NBLKRVARS (0xFu) /* 15 */
# define MAX_CODE_NBLKLVARS (0x7Fu) /* 127 */
# define MAX_CODE_NBLKARGS (0xFu) /* 15 - 4 bits*/
# define MAX_CODE_NBLKRVARS (0xFu) /* 15 - 4 bits*/
# define MAX_CODE_NBLKLVARS (0x3Fu) /* 63 - 6 bits */
# define ENCODE_BLKTMPR_MASK(va,nargs,nrvars,nlvars) \
((((va) & 0x1) << 15) | (((nargs) & 0xF) << 11) | (((nrvars) & 0xF) << 7) | (((nlvars) & 0x7F)))
# define GET_BLKTMPR_MASK_VA(x) (((x) >> 15) & 0x1)
# define GET_BLKTMPR_MASK_NARGS(x) (((x) >> 11) & 0xF)
# define GET_BLKTMPR_MASK_NRVARS(x) (((x) >> 7) & 0xF)
# define GET_BLKTMPR_MASK_NLVARS(x) ((x) & 0x7F)
# define ENCODE_BLK_MASK(insta,va,nargs,nrvars,nlvars) \
((((insta) & 0x1) << 15) | (((va) & 0x1) << 14) | (((nargs) & 0xF) << 10) | (((nrvars) & 0xF) << 6) | (((nlvars) & 0x3FF)))
# define GET_BLK_MASK_INSTA(x) (((x) >> 15) & 0x1)
# define GET_BLK_MASK_VA(x) (((x) >> 14) & 0x1)
# define GET_BLK_MASK_NARGS(x) (((x) >> 10) & 0xF)
# define GET_BLK_MASK_NRVARS(x) (((x) >> 6) & 0xF)
# define GET_BLK_MASK_NLVARS(x) ((x) & 0x3F)
# define MAX_CODE_JUMP (0xFFu)
# define MAX_CODE_PARAM (0xFFu)
# define MAX_CODE_PARAM2 (0xFFFFu)
# define MAX_CODE_PARAM2 (0xFFFFu) /* 16 bits */
#elif defined(HCL_CODE_LONG_PARAM_SIZE) && (HCL_CODE_LONG_PARAM_SIZE == 2)
# define MAX_CODE_NBLKARGS (0xFFu) /* 255 */
# define MAX_CODE_NBLKRVARS (0xFFu) /* 255 */
# define MAX_CODE_NBLKLVARS (0xFFFu) /* 4095 */
# define ENCODE_BLKTMPR_MASK(va,nargs,nrvars,nlvars) \
((((va) & 0x1) << 28) | (((nargs) & 0xFF) << 20) | (((nrvars) & 0xFF) << 12) | (((nlvars) & 0xFFF)))
# define GET_BLKTMPR_MASK_VA(x) (((x) >> 28) & 0x1)
# define GET_BLKTMPR_MASK_NARGS(x) (((x) >> 20) & 0xFF)
# define GET_BLKTMPR_MASK_NRVARS(x) (((x) >> 12) & 0xFF)
# define GET_BLKTMPR_MASK_NLVARS(x) ((x) & 0xFFF)
# define MAX_CODE_NBLKARGS (0xFFu) /* 255, 8 bits */
# define MAX_CODE_NBLKRVARS (0xFFu) /* 255, 8 bits */
# define MAX_CODE_NBLKLVARS (0xFFFu) /* 4095, 12 bits */
# define ENCODE_BLK_MASK(insta,va,nargs,nrvars,nlvars) \
((((insta) & 0x1) << 29) | (((va) & 0x1) << 28) | (((nargs) & 0xFF) << 20) | (((nrvars) & 0xFF) << 12) | (((nlvars) & 0xFFF)))
# define GET_BLK_MASK_INSTA(x) (((x) >> 29) & 0x1)
# define GET_BLK_MASK_VA(x) (((x) >> 28) & 0x1)
# define GET_BLK_MASK_NARGS(x) (((x) >> 20) & 0xFF)
# define GET_BLK_MASK_NRVARS(x) (((x) >> 12) & 0xFF)
# define GET_BLK_MASK_NLVARS(x) ((x) & 0xFFF)
# define MAX_CODE_JUMP (0xFFFFu)
# define MAX_CODE_PARAM (0xFFFFu)
# define MAX_CODE_PARAM2 (0xFFFFFFFFu)
# define MAX_CODE_PARAM2 (0xFFFFFFFFu) /* 32 bits */
#else
# error Unsupported HCL_CODE_LONG_PARAM_SIZE
#endif
@ -940,8 +942,8 @@ enum hcl_bcode_t
HCL_CODE_PUSH_OBJVAR_X = 0xE4, /* 228 ## */
HCL_CODE_CLASS_CMSTORE = 0xE5, /* 229 */
HCL_CODE_CLASS_IMSTORE = 0xE6, /* 230 */
/* UNUSED - 0xE7 */
HCL_CODE_CLASS_CIMSTORE = 0xE6, /* 230 */
HCL_CODE_CLASS_IMSTORE = 0xE7, /* 231 */
HCL_CODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 ## */
HCL_CODE_MAKE_ARRAY = 0xE9, /* 233 ## */

14
lib/hcl.h
View File

@ -587,7 +587,7 @@ struct hcl_function_t
{
HCL_OBJ_HEADER;
hcl_oop_t tmpr_mask; /* smooi */
hcl_oop_t attr_mask; /* smooi */
hcl_oop_context_t home; /* home context. nil for the initial function */
hcl_oop_t dbgi; /* byte array containing debug information. nil if not available */
@ -606,7 +606,7 @@ struct hcl_block_t
{
HCL_OBJ_HEADER;
hcl_oop_t tmpr_mask; /* smooi */
hcl_oop_t attr_mask; /* smooi */
hcl_oop_context_t home; /* home context */
hcl_oop_t ip; /* smooi. instruction pointer where the byte code begins in home->base */
};
@ -619,7 +619,7 @@ struct hcl_context_t
hcl_oop_t req_nrets;
/* SmallInteger. */
hcl_oop_t tmpr_mask;
hcl_oop_t attr_mask;
/* SmallInteger, instruction pointer */
hcl_oop_t ip;
@ -846,15 +846,14 @@ struct hcl_process_scheduler_t
};
#define HCL_CLASS_NAMED_INSTVARS 8
#define HCL_CLASS_NAMED_INSTVARS 7
typedef struct hcl_class_t hcl_class_t;
typedef struct hcl_class_t* hcl_oop_class_t;
struct hcl_class_t
{
HCL_OBJ_HEADER;
hcl_oop_t idic; /* nil or dictionary of named elements including instance methods and variables */
hcl_oop_t cdic; /* nil or dictionary of named elements including class methods and variables */
hcl_oop_t mdic; /* method dictioanry. nil or a dictionary object */
hcl_oop_t superclass;
hcl_oop_t nivars; /* smooi. */
@ -1761,6 +1760,9 @@ struct hcl_t
/* get the operator such as the called function/block/method */
#define HCL_STACK_GETOP(hcl,nargs) HCL_STACK_GET(hcl, (hcl)->sp - nargs)
/* change the receiver of a message */
#define HCL_STACK_SETRCV(hcl,nargs,newrcv) HCL_STACK_SET(hcl, (hcl)->sp - nargs - 1, newrcv)
/*
* .....
* argument 1

24
lib/prim.c
View File

@ -784,7 +784,7 @@ static hcl_pfrc_t pf_va_context (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_va_count (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_context_t* ctx;
hcl_ooi_t tmpr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs;
hcl_ooi_t attr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs;
if (nargs >= 1)
{
@ -800,12 +800,12 @@ static hcl_pfrc_t pf_va_count (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
ctx = hcl->active_context;
}
tmpr_mask = HCL_OOP_TO_SMOOI(ctx->tmpr_mask);
attr_mask = HCL_OOP_TO_SMOOI(ctx->attr_mask);
va = GET_BLKTMPR_MASK_VA(tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
va = GET_BLK_MASK_VA(attr_mask);
fixed_nargs = GET_BLK_MASK_NARGS(attr_mask);
nrvars = GET_BLK_MASK_NRVARS(attr_mask);
nlvars = GET_BLK_MASK_NLVARS(attr_mask);
/*if (!va) TODO: need this check?
{
@ -820,7 +820,7 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t ret;
hcl_context_t* ctx;
hcl_ooi_t tmpr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs;
hcl_ooi_t attr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs;
hcl_oow_t index;
if (nargs >= 2)
@ -836,12 +836,12 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
ctx = hcl->active_context;
}
tmpr_mask = HCL_OOP_TO_SMOOI(ctx->tmpr_mask);
attr_mask = HCL_OOP_TO_SMOOI(ctx->attr_mask);
va = GET_BLKTMPR_MASK_VA(tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
va = GET_BLK_MASK_VA(attr_mask);
fixed_nargs = GET_BLK_MASK_NARGS(attr_mask);
nrvars = GET_BLK_MASK_NRVARS(attr_mask);
nlvars = GET_BLK_MASK_NLVARS(attr_mask);
if (hcl_inttooow(hcl, HCL_STACK_GETARG(hcl, nargs, 0), &index) == 0)
{

2
lib/rbt.c
View File

@ -67,7 +67,7 @@ HCL_INLINE hcl_rbt_pair_t* hcl_rbt_allocpair (
if (kcop == HCL_RBT_COPIER_INLINE) as += HCL_ALIGN_POW2(KTOB(rbt,klen), HCL_SIZEOF_VOID_P);
if (vcop == HCL_RBT_COPIER_INLINE) as += VTOB(rbt,vlen);
pair = (hcl_rbt_pair_t*) HCL_MMGR_ALLOC (hcl_getmmgr(rbt->hcl), as);
pair = (hcl_rbt_pair_t*)HCL_MMGR_ALLOC(hcl_getmmgr(rbt->hcl), as);
if (pair == HCL_NULL) return HCL_NULL;
pair->color = HCL_RBT_RED;

1
t/Makefile.am
View File

@ -1,6 +1,7 @@
AUTOMAKE_OPTIONS = nostdinc
check_SCRIPTS = \
insta-01.hcl \
ret-01.hcl \
retvar-01.hcl

1
t/Makefile.in
View File

@ -462,6 +462,7 @@ top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = nostdinc
check_SCRIPTS = \
insta-01.hcl \
ret-01.hcl \
retvar-01.hcl

53
t/insta-01.hcl Normal file
View File

@ -0,0 +1,53 @@
; test class instantiation methods
(defclass A
| a b c |
(defun ::* newInstance(x y z)
(set a x)
(set b y)
(set c z)
(return self)
)
(defun get-a() a)
(defun get-b() b)
(defun get-c() c)
)
(defclass B ::: A
| d e f |
(defun ::* newInstance(x y z)
(:super newInstance (* x 2) (* y 2) (* z 2))
(set d x)
(set e y)
(set f z)
(return self)
)
(defun sum()
(+ (:super get-a) (:super get-b) (:super get-c) d e f)
)
)
(set a (:(:B newInstance 1 2 3) sum))
(if (/= a 18) (printf "ERROR: a must be 18\n"))
(printf "OK %d\n" a)
(set b (:B newInstance 2 3 4))
(set a (:b get-a))
(if (/= a 4) (printf "ERROR: a must be 4\n"))
(printf "OK %d\n" a)
(set a (:b get-b))
(if (/= a 6) (printf "ERROR: a must be 6\n"))
(printf "OK %d\n" a)
(set a (:b get-c))
(if (/= a 8) (printf "ERROR: a must be 8\n"))
(printf "OK %d\n" a)
(set a (:b sum))
(if (/= a 27) (printf "ERROR: a must be 27\n"))
(printf "OK %d\n" a)