fixed the bug accessing the wrong context in IVAR and CVAR_M instructions
All checks were successful
continuous-integration/drone/push Build is passing
All checks were successful
continuous-integration/drone/push Build is passing
This commit is contained in:
parent
c25f0dabdb
commit
75580f5235
16
lib/comp.c
16
lib/comp.c
@ -777,9 +777,9 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
|
||||
/* MAKE_FUNCTION is a quad-parameter instruction.
|
||||
* The caller must emit two more parameters after the call to this function.
|
||||
* however the instruction format is the same up to the second
|
||||
* parameters between MAKE_FUNCTION and MAKE_LAMBDA.
|
||||
* parameters between MAKE_FUNCTION and MAKE_BLOCK.
|
||||
*/
|
||||
case HCL_CODE_MAKE_LAMBDA:
|
||||
case HCL_CODE_MAKE_BLOCK:
|
||||
case HCL_CODE_MAKE_FUNCTION:
|
||||
case HCL_CODE_CALL_R:
|
||||
case HCL_CODE_SEND_R:
|
||||
@ -1236,8 +1236,8 @@ static void pop_fnblk (hcl_t* hcl)
|
||||
{
|
||||
hcl_oow_t attr_mask;
|
||||
|
||||
/* patch the temporaries mask parameter for the MAKE_LAMBDA or MAKE_FUNCTION instruction */
|
||||
HCL_ASSERT (hcl, hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_LAMBDA ||
|
||||
/* 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 ||
|
||||
hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_FUNCTION);
|
||||
|
||||
/* the total number of temporaries in this function block must be the sum of
|
||||
@ -1245,7 +1245,7 @@ static void pop_fnblk (hcl_t* hcl)
|
||||
HCL_ASSERT (hcl, fbi->tmprcnt - hcl->c->tv.wcount == fbi->tmpr_nargs + fbi->tmpr_nrvars + fbi->tmpr_nlvars);
|
||||
|
||||
/* 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_LAMBDA and MAKE_FUNCTION.
|
||||
* and it's split to two intruction parameters when used with MAKE_BLOCK and MAKE_FUNCTION.
|
||||
* the INSTA bit is on if fbi->fun_type == FUN_CIM */
|
||||
attr_mask = ENCODE_BLK_MASK(((fbi->fun_type & 0xFF) == 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);
|
||||
@ -3093,8 +3093,8 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
|
||||
}
|
||||
else
|
||||
{
|
||||
/* MAKE_LAMBDA attr_mask_1 attr_mask_2 - will patch attr_mask in pop_fnblk() */
|
||||
if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_LAMBDA, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
|
||||
/* 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;
|
||||
}
|
||||
|
||||
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */
|
||||
@ -6030,7 +6030,7 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
|
||||
|
||||
/* keep a virtual function block for the top-level compilation.
|
||||
* pass HCL_TYPE_MAX(hcl_oow_t) as make_inst_pos because there is
|
||||
* no actual MAKE_LAMBDA/MAKE_FUNCTION instruction which otherwise
|
||||
* no actual MAKE_BLOCK/MAKE_FUNCTION instruction which otherwise
|
||||
* would be patched in pop_fnblk(). */
|
||||
|
||||
if (push_fnblk(
|
||||
|
@ -716,14 +716,14 @@ int hcl_decode (hcl_t* hcl, const hcl_code_t* code, hcl_oow_t start, hcl_oow_t e
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_MAKE_LAMBDA:
|
||||
case HCL_CODE_MAKE_BLOCK:
|
||||
/* 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_5 (hcl, "make_lambda %zu %zu %zu %zu %zu",
|
||||
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),
|
||||
|
50
lib/exec.c
50
lib/exec.c
@ -421,10 +421,11 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func,
|
||||
func->attr_mask = HCL_SMOOI_TO_OOP(attr_mask);
|
||||
}
|
||||
|
||||
static HCL_INLINE hcl_oop_lambda_t make_lambda (hcl_t* hcl)
|
||||
static HCL_INLINE hcl_oop_lambda_t make_block (hcl_t* hcl)
|
||||
{
|
||||
/* create a base block used for creation of a block context */
|
||||
return (hcl_oop_lambda_t)hcl_allocoopobj(hcl, HCL_BRAND_LAMBDA, HCL_BLOCK_NAMED_INSTVARS);
|
||||
/*return (hcl_oop_lambda_t)hcl_allocoopobj(hcl, HCL_BRAND_BLOCK, HCL_BLOCK_NAMED_INSTVARS);*/
|
||||
return (hcl_oop_function_t)hcl_instantiate(hcl, hcl->c_block, HCL_NULL, 0);
|
||||
}
|
||||
|
||||
static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_lambda_t blk, hcl_ooi_t attr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx)
|
||||
@ -1902,7 +1903,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl_ooi_t n
|
||||
hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs;
|
||||
|
||||
/* the receiver must be a block context */
|
||||
HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk));
|
||||
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
|
||||
|
||||
attr_mask = HCL_OOP_TO_SMOOI(op_blk->attr_mask);
|
||||
|
||||
@ -1950,13 +1951,16 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl_ooi_t n
|
||||
|
||||
if (is_msgsend)
|
||||
{
|
||||
blkctx->home = blkctx; /* itself */
|
||||
/*blkctx->home = blkctx;*/ /* itself */
|
||||
blkctx->home = op_blk->home;
|
||||
blkctx->mthhome = blkctx;
|
||||
blkctx->receiver = HCL_STACK_GETRCV(hcl, nargs);
|
||||
blkctx->ivaroff = HCL_SMOOI_TO_OOP(msg_ivaroff);
|
||||
}
|
||||
else
|
||||
{
|
||||
blkctx->home = op_blk->home;
|
||||
blkctx->mthhome = hcl->_nil;
|
||||
blkctx->receiver = op_blk->home->receiver;
|
||||
blkctx->ivaroff = HCL_SMOOI_TO_OOP(0); /* not useful if it's not message send */
|
||||
}
|
||||
@ -1990,7 +1994,7 @@ static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl
|
||||
{
|
||||
int x;
|
||||
|
||||
HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk));
|
||||
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
|
||||
|
||||
x = prepare_new_context(
|
||||
hcl,
|
||||
@ -2017,7 +2021,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrv
|
||||
int x;
|
||||
|
||||
op_blk = (hcl_oop_lambda_t)HCL_STACK_GETOP(hcl, nargs);
|
||||
HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk));
|
||||
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
|
||||
|
||||
x = __activate_block(hcl, op_blk, nargs, nrvars, 0, 0, &newctx);
|
||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||
@ -3344,9 +3348,9 @@ static int execute (hcl_t* hcl)
|
||||
case HCL_CODE_PUSH_IVAR_7:
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
push_ivar:
|
||||
LOG_INST_2 (hcl, "push_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
|
||||
LOG_INST_2 (hcl, "push_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff));
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
|
||||
b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
|
||||
b1 += HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff);
|
||||
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1]);
|
||||
break;
|
||||
|
||||
@ -3365,9 +3369,9 @@ static int execute (hcl_t* hcl)
|
||||
case HCL_CODE_STORE_INTO_IVAR_7:
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
store_instvar:
|
||||
LOG_INST_2 (hcl, "store_into_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
|
||||
LOG_INST_2 (hcl, "store_into_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context/*->mthhome*/->ivaroff));
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
|
||||
b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->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);
|
||||
break;
|
||||
|
||||
@ -3692,7 +3696,7 @@ static int execute (hcl_t* hcl)
|
||||
LOG_INST_2 (hcl, "call %zu %zu", b1, b2);
|
||||
|
||||
rcv = HCL_STACK_GETOP(hcl, b1);
|
||||
if (HCL_IS_LAMBDA(hcl, rcv))
|
||||
if (HCL_IS_BLOCK(hcl, rcv))
|
||||
{
|
||||
if (activate_block(hcl, b1, b2) <= -1) goto call2_failed;
|
||||
break;
|
||||
@ -3733,7 +3737,7 @@ static int execute (hcl_t* hcl)
|
||||
if (activate_function(hcl, b1) <= -1) goto call_failed;
|
||||
break;
|
||||
|
||||
case HCL_BRAND_LAMBDA:
|
||||
case HCL_BRAND_BLOCK:
|
||||
if (activate_block(hcl, b1, 0) <= -1) goto call_failed;
|
||||
break;
|
||||
|
||||
@ -3913,7 +3917,7 @@ static int execute (hcl_t* hcl)
|
||||
hcl_oop_t mdic, cons, blk, car, cdr, name;
|
||||
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
LOG_INST_2 (hcl, "class_%hsmstore %zu", (bcode == HCL_CODE_CLASS_CMSTORE? "c": (bcode == HCL_CODE_CLASS_CIMSTORE? "ci": "i")), 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' */
|
||||
|
||||
@ -4198,8 +4202,8 @@ static int execute (hcl_t* hcl)
|
||||
hcl_oop_t t;
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
LOG_INST_1 (hcl, "push_cvar_m %zu", b1);
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->home != hcl->_nil);
|
||||
t = hcl->active_context->home->owner;
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context/*->mthhome*/ != hcl->_nil);
|
||||
t = hcl->active_context/*->mthhome*/->owner;
|
||||
if (HCL_UNLIKELY(!HCL_IS_CLASS(hcl, t)))
|
||||
{
|
||||
/* this is an internal error or the bytecodes are compromised */
|
||||
@ -4215,8 +4219,8 @@ static int execute (hcl_t* hcl)
|
||||
hcl_oop_t t;
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
LOG_INST_1 (hcl, "store_into_cvar_m %zu", b1);
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->home != hcl->_nil);
|
||||
t = hcl->active_context->home->owner;
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context/*->mthhome*/ != hcl->_nil);
|
||||
t = hcl->active_context/*->mthhome*/->owner;
|
||||
if (HCL_UNLIKELY(!HCL_IS_CLASS(hcl, t)))
|
||||
{
|
||||
/* this is an internal error or the bytecodes are compromised */
|
||||
@ -4232,8 +4236,8 @@ static int execute (hcl_t* hcl)
|
||||
hcl_oop_t t;
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
LOG_INST_1 (hcl, "pop_into_cvar_m %zu", b1);
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->home != hcl->_nil);
|
||||
t = hcl->active_context->home->owner;
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context/*->mthhome*/ != hcl->_nil);
|
||||
t = hcl->active_context/*->mthhome*/->owner;
|
||||
if (HCL_UNLIKELY(!HCL_IS_CLASS(hcl, t)))
|
||||
{
|
||||
/* this is an internal error or the bytecodes are compromised */
|
||||
@ -4643,7 +4647,7 @@ static int execute (hcl_t* hcl)
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_MAKE_LAMBDA:
|
||||
case HCL_CODE_MAKE_BLOCK:
|
||||
{
|
||||
hcl_oop_lambda_t blkobj;
|
||||
|
||||
@ -4652,7 +4656,7 @@ static int execute (hcl_t* hcl)
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
FETCH_PARAM_CODE_TO (hcl, b2);
|
||||
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
|
||||
LOG_INST_5 (hcl, "make_lambda %zu %zu %zu %zu %zu",
|
||||
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),
|
||||
@ -4661,7 +4665,7 @@ static int execute (hcl_t* hcl)
|
||||
|
||||
HCL_ASSERT (hcl, b1 >= 0);
|
||||
|
||||
blkobj = make_lambda(hcl);
|
||||
blkobj = make_block(hcl);
|
||||
if (HCL_UNLIKELY(!blkobj)) goto oops;
|
||||
|
||||
/* the long forward jump instruction has the format of
|
||||
@ -4828,7 +4832,7 @@ hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
||||
int x;
|
||||
|
||||
blk = (hcl_oop_lambda_t)HCL_STACK_GETARG(hcl, nargs, 0);
|
||||
if (!HCL_IS_LAMBDA(hcl, blk))
|
||||
if (!HCL_IS_BLOCK(hcl, blk))
|
||||
{
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not block - %O", blk);
|
||||
return HCL_PF_FAILURE;
|
||||
|
2
lib/gc.c
2
lib/gc.c
@ -304,7 +304,7 @@ static kernel_class_info_t kernel_classes[] =
|
||||
HCL_OFFSETOF(hcl_t, c_prim) },
|
||||
#endif
|
||||
|
||||
{ "CompiledBlock", 0,
|
||||
{ "CompiledBlock", HCL_BRAND_BLOCK,
|
||||
0,
|
||||
0,
|
||||
HCL_BLOCK_NAMED_INSTVARS,
|
||||
|
@ -969,13 +969,13 @@ struct hcl_compiler_t
|
||||
|
||||
|
||||
|
||||
/* hcl_context_t, hcl_lambda_t, hcl_function_t stores the local variable information
|
||||
/* hcl_context_t, hcl_block_t, hcl_function_t stores the local variable information
|
||||
*
|
||||
* Use up to 29 bits in a 32-bit hcl_ooi_t. Exclude the tag bit and the sign bit.
|
||||
* | SIGN | INSTA | VA | NARGS | NRVARS | NLVARS | TAG |
|
||||
* 1 1 8 8 11 2 <= 32
|
||||
* -----------------------------------------------------------
|
||||
* Parameters to the MAKE_LAMBDA or MAKE_FUNCTION instructions
|
||||
* Parameters to the MAKE_BLOCK or MAKE_FUNCTION instructions
|
||||
* | INSTA | VA | NARGS | NRVARS | NLVARS
|
||||
* 1 1 4 4 6 <= 16 (HCL_CODE_LONG_PARAM_SIZE 1, two params)
|
||||
* 1 1 8 8 11 <= 32 (HCL_CODE_LONG_PARAM_SIZE 2, two params, use 29 bits to avoid collection when converted to a smooi)
|
||||
@ -1371,7 +1371,7 @@ enum hcl_bcode_t
|
||||
HCL_CODE_RETURN_FROM_BLOCK = 0xFC, /* 252, return the stack top from a block */
|
||||
|
||||
HCL_CODE_MAKE_FUNCTION = 0xFD, /* 253 */
|
||||
HCL_CODE_MAKE_LAMBDA = 0xFE, /* 254 */
|
||||
HCL_CODE_MAKE_BLOCK = 0xFE, /* 254 */
|
||||
HCL_CODE_NOOP = 0xFF /* 255 */
|
||||
};
|
||||
|
||||
|
23
lib/hcl.h
23
lib/hcl.h
@ -578,10 +578,10 @@ typedef struct hcl_function_t hcl_function_t;
|
||||
typedef struct hcl_function_t* hcl_oop_function_t;
|
||||
|
||||
#define HCL_BLOCK_NAMED_INSTVARS 3
|
||||
typedef struct hcl_lambda_t hcl_lambda_t;
|
||||
typedef struct hcl_lambda_t* hcl_oop_lambda_t;
|
||||
typedef struct hcl_block_t hcl_block_t;
|
||||
typedef struct hcl_block_t* hcl_oop_lambda_t;
|
||||
|
||||
#define HCL_CONTEXT_NAMED_INSTVARS 9
|
||||
#define HCL_CONTEXT_NAMED_INSTVARS 10
|
||||
typedef struct hcl_context_t hcl_context_t;
|
||||
typedef struct hcl_context_t* hcl_oop_context_t;
|
||||
|
||||
@ -603,10 +603,10 @@ struct hcl_function_t
|
||||
};
|
||||
|
||||
/* hcl_function_t copies the byte codes and literal frames into itself
|
||||
* hlc_lambda_t contains minimal information(ip) for referening byte codes
|
||||
* and literal frames available in home->origin.
|
||||
* hcl_block_t contains minimal information(ip) for referening byte codes
|
||||
* and literal frames available in home->origin. it represents the compiled block.
|
||||
*/
|
||||
struct hcl_lambda_t
|
||||
struct hcl_block_t
|
||||
{
|
||||
HCL_OBJ_HEADER;
|
||||
|
||||
@ -646,13 +646,16 @@ struct hcl_context_t
|
||||
* points to a function object */
|
||||
hcl_oop_t receiver;
|
||||
|
||||
/* it is set to itself for a method context.
|
||||
* for a block context, it points to the active context at the
|
||||
/* for a block context, it points to the active context at the
|
||||
* moment the block context was created. that is, it points to
|
||||
* a method context where the base block has been defined.
|
||||
* an activated block context copies this field from the base block context. */
|
||||
hcl_oop_context_t home; /* context or nil */
|
||||
|
||||
/* it is set to itself for a method context, nil for other contexts.
|
||||
* TODO: this field may not be needed.. mthhome access has been commented out.. so remove this field */
|
||||
hcl_oop_context_t mthhome;
|
||||
|
||||
/* instance variable access instructions hold the index to a variable within
|
||||
* the the containing class. If the class inherits from a superclass and the
|
||||
* superclass chain contains instance variables, the actual index must be
|
||||
@ -2005,7 +2008,7 @@ enum hcl_brand_t
|
||||
HCL_BRAND_PRIM,
|
||||
|
||||
HCL_BRAND_FUNCTION,
|
||||
HCL_BRAND_LAMBDA,
|
||||
HCL_BRAND_BLOCK,
|
||||
HCL_BRAND_CONTEXT,
|
||||
HCL_BRAND_PROCESS,
|
||||
HCL_BRAND_PROCESS_SCHEDULER,
|
||||
@ -2076,7 +2079,7 @@ 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_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_LAMBDA(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_LAMBDA)
|
||||
#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)
|
||||
|
@ -699,11 +699,11 @@ static hcl_pfrc_t pf_is_dictionary (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
||||
return HCL_PF_SUCCESS;
|
||||
}
|
||||
|
||||
static hcl_pfrc_t pf_is_lambda (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
||||
static hcl_pfrc_t pf_is_block (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
||||
{
|
||||
hcl_oop_t rv, x;
|
||||
x = HCL_STACK_GETARG(hcl, nargs, 0);
|
||||
rv = (HCL_IS_LAMBDA(hcl, x))? hcl->_true: hcl->_false;
|
||||
rv = (HCL_IS_BLOCK(hcl, x))? hcl->_true: hcl->_false;
|
||||
HCL_STACK_SETRET (hcl, nargs, rv);
|
||||
return HCL_PF_SUCCESS;
|
||||
}
|
||||
@ -1261,8 +1261,8 @@ static pf_t builtin_prims[] =
|
||||
{ 1, 1, pf_is_array, 6, { 'a','r','r','a','y','?' } },
|
||||
{ 1, 1, pf_is_bytearray, 10, { 'b','y','t','e','a','r','r','a','y','?' } },
|
||||
{ 1, 1, pf_is_dictionary, 11, { 'd','i','c','t','i','o','n','a','r','y','?' } },
|
||||
{ 1, 1, pf_is_lambda, 7, { 'l','a','m','b','d','a','?' } },
|
||||
{ 1, 1, pf_is_lambda, 4, { 'f','u','n','?' } },
|
||||
{ 1, 1, pf_is_block, 7, { 'l','a','m','b','d','a','?' } },
|
||||
{ 1, 1, pf_is_block, 4, { 'f','u','n','?' } },
|
||||
{ 1, 1, pf_is_class, 6, { 'c','l','a','s','s','?' } },
|
||||
{ 1, 1, pf_is_object, 7, { 'o','b','j','e','c','t','?' } },
|
||||
|
||||
|
@ -85,7 +85,7 @@ enum
|
||||
WORD_PRIM,
|
||||
|
||||
WORD_FUNCTION,
|
||||
WORD_LAMBDA,
|
||||
WORD_BLOCK,
|
||||
WORD_CONTEXT,
|
||||
WORD_PROCESS,
|
||||
WORD_PROCESS_SCHEDULER,
|
||||
@ -110,7 +110,7 @@ static struct
|
||||
{ 7, { '#','<','P','R','I','M','>' } },
|
||||
|
||||
{ 11, { '#','<','F','U','N','C','T','I','O','N','>' } },
|
||||
{ 9, { '#','<','L','A','M','B','D','A','>' } },
|
||||
{ 8, { '#','<','B','L','O','C','K','>' } },
|
||||
{ 10, { '#','<','C','O','N','T','E','X','T','>' } },
|
||||
{ 10, { '#','<','P','R','O','C','E','S','S','>' } },
|
||||
{ 20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
|
||||
@ -667,8 +667,8 @@ next:
|
||||
word_index = WORD_FUNCTION;
|
||||
goto print_word;
|
||||
|
||||
case HCL_BRAND_LAMBDA:
|
||||
word_index = WORD_LAMBDA;
|
||||
case HCL_BRAND_BLOCK:
|
||||
word_index = WORD_BLOCK;
|
||||
goto print_word;
|
||||
|
||||
case HCL_BRAND_CONTEXT:
|
||||
|
@ -51,3 +51,44 @@ else { printf "OK: value is %d\n" v }
|
||||
v := ((a:y) 20);
|
||||
if (nqv? v 21) { printf "ERROR: v is not 21\n" } \
|
||||
else { printf "OK: value is %d\n" v }
|
||||
|
||||
## --------------------------------------------------------------
|
||||
|
||||
class F | j t | {
|
||||
}
|
||||
|
||||
class X | a b c | {
|
||||
fun :* new () {
|
||||
self.a := 20
|
||||
return self
|
||||
}
|
||||
|
||||
fun getA() { return self.a }
|
||||
|
||||
fun make(t a b) {
|
||||
| v |
|
||||
v := 50
|
||||
if (t > 5) {
|
||||
fun X:get_j() { return (((1 + t) + a) + b) }
|
||||
} else {
|
||||
fun X:get_j() { return ((2 * (t + a)) + b) }
|
||||
}
|
||||
return self
|
||||
}
|
||||
}
|
||||
|
||||
fun X:get_a() {
|
||||
return (self:getA)
|
||||
}
|
||||
|
||||
v := ((X:new):get_a)
|
||||
if (nqv? v 20) { printf "ERROR: v is not 20 - %d\n" v } \
|
||||
else { printf "OK: value is %d\n" v }
|
||||
|
||||
v := (((X:new):make 5 6 7):get_j)
|
||||
if (nqv? v 29) { printf "ERROR: v is not 29 - %d\n" v } \
|
||||
else { printf "OK: value is %d\n" v }
|
||||
|
||||
v := (((X:new):make 6 6 7):get_j)
|
||||
if (nqv? v 20) { printf "ERROR: v is not 20 - %d\n" v } \
|
||||
else { printf "OK: value is %d\n" v }
|
||||
|
Loading…
Reference in New Issue
Block a user