diff --git a/lib/comp.c b/lib/comp.c index f7f67bc..bb34bcf 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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; diff --git a/lib/decode.c b/lib/decode.c index e2e2d67..609c2c6 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -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; diff --git a/lib/dic.c b/lib/dic.c index c30ccf6..b678bf9 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -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; diff --git a/lib/exec.c b/lib/exec.c index 5299537..337462b 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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 */ diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index c8a682a..6888597 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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 ## */ diff --git a/lib/hcl.h b/lib/hcl.h index f2a4802..d8e6b3a 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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 diff --git a/lib/prim.c b/lib/prim.c index 01819e7..943c45a 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -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) { diff --git a/lib/rbt.c b/lib/rbt.c index c16ef22..00cc2f2 100644 --- a/lib/rbt.c +++ b/lib/rbt.c @@ -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; diff --git a/t/Makefile.am b/t/Makefile.am index df8bc71..25074d7 100644 --- a/t/Makefile.am +++ b/t/Makefile.am @@ -1,6 +1,7 @@ AUTOMAKE_OPTIONS = nostdinc check_SCRIPTS = \ + insta-01.hcl \ ret-01.hcl \ retvar-01.hcl diff --git a/t/Makefile.in b/t/Makefile.in index bedb78c..da21ec5 100644 --- a/t/Makefile.in +++ b/t/Makefile.in @@ -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 diff --git a/t/insta-01.hcl b/t/insta-01.hcl new file mode 100644 index 0000000..9c06de0 --- /dev/null +++ b/t/insta-01.hcl @@ -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) + +