From 495cea5704bc37048b8d088f98141095ede3d774 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Sat, 5 Feb 2022 17:35:10 +0000 Subject: [PATCH] added a new identifier - self --- lib/cnode.c | 5 +++ lib/comp.c | 14 +++++-- lib/exec.c | 104 +++++++++++++++++++++++++++++++++----------------- lib/gc.c | 6 +-- lib/hcl-prv.h | 3 ++ lib/hcl.h | 51 +++++++++++++++---------- lib/read.c | 7 +++- 7 files changed, 126 insertions(+), 64 deletions(-) diff --git a/lib/cnode.c b/lib/cnode.c index aa82853..586c34d 100644 --- a/lib/cnode.c +++ b/lib/cnode.c @@ -67,6 +67,11 @@ hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ return make_cnode(hcl, HCL_CNODE_FALSE, loc, tok); } +hcl_cnode_t* hcl_makecnodeself (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) +{ + return make_cnode(hcl, HCL_CNODE_SELF, loc, tok); +} + hcl_cnode_t* hcl_makecnodeellipsis (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { return make_cnode(hcl, HCL_CNODE_ELLIPSIS, loc, tok); diff --git a/lib/comp.c b/lib/comp.c index 212c825..af1e840 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -1983,14 +1983,13 @@ static int check_if_plain_cnode (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t* prev /* (defclass A | x y | ; instance variables - | ::: x y z | ; class variables <--- how to initialize the class variables??? + ::: | x y z | ; class variables <--- how to initialize the class variables??? ; everything inside defclass after the variable declarations are normal expressions. ; however, the resolution of some variables will fall under the enclosing class. (set x 20) (printf "normal statement ....\n"); - (defun new (a b c) (printf "%O\n" self) ; self is A (set obj super.new) @@ -2990,7 +2989,6 @@ static HCL_INLINE int compile_catch (hcl_t* hcl) vi.index_in_ctx = hcl->c->tv.wcount - par_tmprcnt; if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(exarg), hcl->c->tv.s.len) <= -1) return -1; - fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; HCL_ASSERT (hcl, fbi->tmprlen == hcl->c->tv.s.len - HCL_CNODE_GET_TOKLEN(exarg) - 1); HCL_ASSERT (hcl, fbi->tmprcnt == vi.index_in_ctx + par_tmprcnt); @@ -3630,6 +3628,8 @@ static HCL_INLINE int compile_dsymbol (hcl_t* hcl, hcl_cnode_t* obj) * must differentiate module access and dictioary member access... * must implementate dictionary member access syntax... */ +#if 0 +the dot notation collides with car/cdr separator??? { /* HACK FOR NOW */ const hcl_ooch_t* sep; @@ -3642,6 +3642,7 @@ HCL_DEBUG1 (hcl, ">>>> instance variable or method %js\n", sep + 1); } /* TODO: super? */ } +#endif sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(obj), HCL_CNODE_GET_TOKLEN(obj)); if (HCL_UNLIKELY(!sym)) return -1; @@ -3832,6 +3833,12 @@ redo: if (emit_byte_instruction(hcl, HCL_CODE_PUSH_FALSE, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; goto done; + case HCL_CNODE_SELF: + if (emit_byte_instruction(hcl, HCL_CODE_PUSH_RECEIVER, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; + goto done; + + /* TODO: super, this-context */ + case HCL_CNODE_CHARLIT: lit = HCL_CHAR_TO_OOP(oprnd->u.charlit.v); goto literal; @@ -4919,7 +4926,6 @@ static HCL_INLINE int emit_class_mstore (hcl_t* hcl) if (add_literal(hcl, lit, &index) <= -1) return -1; if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_MSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; - POP_CFRAME (hcl); return 0; } diff --git a/lib/exec.c b/lib/exec.c index 205bfbf..9e3b9fe 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -88,6 +88,8 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' }; #define LOAD_ACTIVE_SP(hcl) LOAD_SP(hcl, (hcl)->processor->active) #define STORE_ACTIVE_SP(hcl) STORE_SP(hcl, (hcl)->processor->active) +#if 0 +// THIS PART IS TO BE REMOVED #define SWITCH_ACTIVE_CONTEXT(hcl,v_ctx) \ do \ { \ @@ -98,6 +100,18 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' }; LOAD_ACTIVE_IP (hcl); \ (hcl)->processor->active->current_context = (hcl)->active_context; \ } while (0) +#else +#define SWITCH_ACTIVE_CONTEXT(hcl,v_ctx) \ + do \ + { \ + STORE_ACTIVE_IP (hcl); \ + (hcl)->active_context = (v_ctx); \ + (hcl)->active_function = (hcl)->active_context->base; \ + (hcl)->active_code = HCL_FUNCTION_GET_CODE_BYTE((hcl)->active_function); \ + LOAD_ACTIVE_IP (hcl); \ + (hcl)->processor->active->current_context = (hcl)->active_context; \ + } while (0) +#endif /*#define FETCH_BYTE_CODE(hcl) ((hcl)->code.bc.arr->slot[(hcl)->ip++])*/ #define FETCH_BYTE_CODE(hcl) ((hcl)->active_code[(hcl)->ip++]) @@ -1940,11 +1954,20 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na blkctx->ip = op_blk->ip; blkctx->req_nrets = HCL_SMOOI_TO_OOP(req_nrvars); blkctx->tmpr_mask = op_blk->tmpr_mask; - blkctx->base = (hcl_oop_t)op_blk; - blkctx->home = op_blk->home; - /* blkctx->origin = op_blk->origin; */ + //blkctx->base = (hcl_oop_t)op_blk; + blkctx->base = op_blk->home->base; blkctx->origin = op_blk->home->origin; - blkctx->receiver = is_msgsend? HCL_STACK_GETRCV(hcl, nargs): op_blk->home->receiver; + + if (is_msgsend) + { + blkctx->home = blkctx; /* itself */ + blkctx->receiver = HCL_STACK_GETRCV(hcl, nargs); + } + else + { + blkctx->home = op_blk->home; + blkctx->receiver = op_blk->home->receiver; + } #endif if (HCL_LIKELY(copy_args)) @@ -2014,9 +2037,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrv static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_t nargs, hcl_oop_context_t* pnewctx) { - /* prepare a new block context for activation. - * the receiver must be a block context which becomes the base - * for a new block context. */ + /* prepare a new block context for activation */ hcl_oop_context_t functx; hcl_ooi_t i, j; @@ -2031,7 +2052,6 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_ (printf ">>>> %d\n" (sum 10)) */ - /* the receiver must be a function */ HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op_func)); tmpr_mask = HCL_OOP_TO_SMOOI(op_func->tmpr_mask); @@ -2059,7 +2079,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->base = (hcl_oop_t)op_func; + functx->base = op_func; functx->home = op_func->home; functx->origin = functx; /* the origin of the context over a function should be itself */ functx->receiver = HCL_STACK_GETRCV(hcl, nargs); @@ -2088,13 +2108,13 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_ static HCL_INLINE int activate_function (hcl_t* hcl, hcl_ooi_t nargs) { int x; - hcl_oop_function_t op; + hcl_oop_function_t op_func; hcl_oop_context_t newctx; - op = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs); - HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op)); + op_func = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs); + HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op_func)); - x = __activate_function(hcl, op, nargs, &newctx); + x = __activate_function(hcl, op_func, nargs, &newctx); if (HCL_UNLIKELY(x <= -1)) return -1; SWITCH_ACTIVE_CONTEXT (hcl, newctx); @@ -3029,7 +3049,7 @@ static int execute (hcl_t* hcl) b1 = bcode & 0x7; /* low 3 bits */ push_instvar: LOG_INST_1 (hcl, "push_instvar %zu", b1); - HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver) == HCL_OBJ_TYPE_OOP); + HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP); /* TODO: FIX TO OFFSET THE INHERTED PART... */ //HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1]); HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1]); @@ -3052,7 +3072,8 @@ static int execute (hcl_t* hcl) store_instvar: LOG_INST_1 (hcl, "store_into_instvar %zu", b1); HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP); - ((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); + //((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); + ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); break; /* ------------------------------------------------- */ @@ -3071,17 +3092,20 @@ static int execute (hcl_t* hcl) pop_into_instvar: LOG_INST_1 (hcl, "pop_into_instvar %zu", b1); HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP); - ((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); + //((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); + ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); HCL_STACK_POP (hcl); break; /* ------------------------------------------------- */ + #if 0 + // the compiler never emits these instructions. reuse these instructions for other purposes case HCL_CODE_PUSH_TEMPVAR_X: case HCL_CODE_STORE_INTO_TEMPVAR_X: case HCL_CODE_POP_INTO_TEMPVAR_X: FETCH_PARAM_CODE_TO (hcl, b1); goto handle_tempvar; - + case HCL_CODE_PUSH_TEMPVAR_0: case HCL_CODE_PUSH_TEMPVAR_1: case HCL_CODE_PUSH_TEMPVAR_2: @@ -3147,6 +3171,7 @@ static int execute (hcl_t* hcl) break; } + #endif /* ------------------------------------------------- */ case HCL_CODE_PUSH_LITERAL_X2: @@ -3776,6 +3801,9 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] } /* -------------------------------------------------------- */ + + /* access the class variables in the initialization context. + * the class object is at the class stack top */ case HCL_CODE_PUSH_CLSVAR_I_X: { hcl_oop_class_t t; @@ -3821,13 +3849,15 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] /* -------------------------------------------------------- */ + /* access the class variables in the instance method context. + * the receiver's class is accessed. */ case HCL_CODE_PUSH_CLSVAR_M_X: { hcl_oop_class_t t; FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "push_clsvar_m %zu", b1); - /* TODO: finish implementing CLSVAR_M_X instructions ....*/ - t = (hcl_oop_oop_t)hcl->active_context->origin->receiver; + //t = (hcl_oop_oop_t)hcl->active_context->origin->receiver; + t = (hcl_oop_oop_t)hcl->active_context->receiver; if (!HCL_IS_INSTANCE(hcl, t)) { hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver"); @@ -3844,7 +3874,8 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] hcl_oop_class_t t; FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "store_into_clsvar_m %zu", b1); - t = (hcl_oop_oop_t)hcl->active_context->origin->receiver; + //t = (hcl_oop_oop_t)hcl->active_context->origin->receiver; + t = (hcl_oop_oop_t)hcl->active_context->receiver; if (!HCL_IS_INSTANCE(hcl, t)) { hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver"); @@ -3861,7 +3892,8 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] hcl_oop_class_t t; FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "pop_into_clsvar_m %zu", b1); - t = (hcl_oop_oop_t)hcl->active_context->origin->receiver; + //t = (hcl_oop_oop_t)hcl->active_context->origin->receiver; + t = (hcl_oop_oop_t)hcl->active_context->receiver; if (!HCL_IS_INSTANCE(hcl, t)) { hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver"); @@ -3877,7 +3909,8 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] case HCL_CODE_PUSH_RECEIVER: /* push self or super */ LOG_INST_0 (hcl, "push_receiver"); - HCL_STACK_PUSH (hcl, hcl->active_context->origin->receiver); + //HCL_STACK_PUSH (hcl, hcl->active_context->origin->receiver); + HCL_STACK_PUSH (hcl, hcl->active_context->receiver); break; case HCL_CODE_PUSH_NIL: @@ -4204,7 +4237,8 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] case HCL_CODE_RETURN_RECEIVER: LOG_INST_0 (hcl, "return_receiver"); - return_value = hcl->active_context->origin->receiver; + //return_value = hcl->active_context->origin->receiver; + return_value = hcl->active_context->receiver; handle_return: hcl->last_retv = return_value; @@ -4222,7 +4256,7 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] case HCL_CODE_MAKE_FUNCTION: { - hcl_oop_function_t func; + hcl_oop_function_t funcobj; hcl_oow_t b3, b4; hcl_oow_t joff; @@ -4256,16 +4290,16 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1] /* copy the byte codes from the active context to the new context */ #if (HCL_CODE_LONG_PARAM_SIZE == 2) - func = make_function(hcl, b4, &hcl->active_code[hcl->ip + 3], joff, HCL_NULL); + funcobj = make_function(hcl, b4, &hcl->active_code[hcl->ip + 3], joff, HCL_NULL); #else - func = make_function(hcl, b4, &hcl->active_code[hcl->ip + 2], joff, HCL_NULL); + funcobj = make_function(hcl, b4, &hcl->active_code[hcl->ip + 2], joff, HCL_NULL); #endif - if (HCL_UNLIKELY(!func)) goto oops; + if (HCL_UNLIKELY(!funcobj)) goto oops; - fill_function_data (hcl, func, b1, hcl->active_context, &hcl->active_function->literal_frame[b3], b4); + fill_function_data (hcl, funcobj, b1, hcl->active_context, &hcl->active_function->literal_frame[b3], b4); /* push the new function to the stack of the active context */ - HCL_STACK_PUSH (hcl, (hcl_oop_t)func); + HCL_STACK_PUSH (hcl, (hcl_oop_t)funcobj); break; } @@ -4338,7 +4372,7 @@ oops: hcl_oop_t hcl_execute (hcl_t* hcl) { - hcl_oop_function_t func; + hcl_oop_function_t funcobj; int n; hcl_bitmask_t log_default_type_mask; @@ -4369,13 +4403,13 @@ hcl_oop_t hcl_execute (hcl_t* hcl) } /* create a virtual function object that hold the bytes codes generated plus the literal frame */ - func = make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len, hcl->code.dbgi); - if (HCL_UNLIKELY(!func)) return HCL_NULL; + funcobj = make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len, hcl->code.dbgi); + if (HCL_UNLIKELY(!funcobj)) return HCL_NULL; /* pass nil for the home context of the initial function */ - fill_function_data (hcl, func, 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_BLKTMPR_MASK(0,0,0,hcl->code.ngtmprs), (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len); - hcl->initial_function = func; /* the initial function is ready */ + hcl->initial_function = funcobj; /* the initial function is ready */ #if 0 /* unless the system is buggy, hcl->proc_map_used should be 0. @@ -4478,7 +4512,7 @@ hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) if (HCL_UNLIKELY(x <= -1)) return HCL_PF_FAILURE; HCL_ASSERT (hcl, (hcl_oop_t)newctx->sender == hcl->_nil); - newctx->home = hcl->_nil; /* the new context is the initial context in the new process. so reset it to nil */ + newctx->home = (hcl_oop_context_t)hcl->_nil; /* the new context is the initial context in the new process. so reset it to nil */ hcl_pushvolat (hcl, (hcl_oop_t*)&newctx); newprc = make_process(hcl, newctx); diff --git a/lib/gc.c b/lib/gc.c index 0629070..fbc8ad3 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -55,9 +55,9 @@ static struct { 16, { 'r','e','t','u','r','n','-','f','r','o','m','-','h','o','m','e'}, HCL_SYNCODE_RETURN_FROM_HOME, HCL_OFFSETOF(hcl_t,_return_from_home) }, { 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,_set) }, - { 5, { 's','e','t','-','r' }, HCL_SYNCODE_SET_R, HCL_OFFSETOF(hcl_t,_set_r) }, - { 5, { 't','h','r','o','w' }, HCL_SYNCODE_THROW, HCL_OFFSETOF(hcl_t,_throw) }, - { 3, { 't','r','y' }, HCL_SYNCODE_TRY, HCL_OFFSETOF(hcl_t,_try) }, + { 5, { 's','e','t','-','r' }, HCL_SYNCODE_SET_R, HCL_OFFSETOF(hcl_t,_set_r) }, + { 5, { 't','h','r','o','w' }, HCL_SYNCODE_THROW, HCL_OFFSETOF(hcl_t,_throw) }, + { 3, { 't','r','y' }, HCL_SYNCODE_TRY, HCL_OFFSETOF(hcl_t,_try) }, { 5, { 'u','n','t','i','l' }, HCL_SYNCODE_UNTIL, HCL_OFFSETOF(hcl_t,_until) }, { 5, { 'w','h','i','l','e' }, HCL_SYNCODE_WHILE, HCL_OFFSETOF(hcl_t,_while) } }; diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index aacb968..bd7fa50 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -144,6 +144,7 @@ enum hcl_iotok_type_t HCL_IOTOK_NIL, HCL_IOTOK_TRUE, HCL_IOTOK_FALSE, + HCL_IOTOK_SELF, HCL_IOTOK_IDENT, HCL_IOTOK_IDENT_DOTTED, @@ -198,6 +199,7 @@ enum hcl_cnode_type_t HCL_CNODE_NIL, HCL_CNODE_TRUE, HCL_CNODE_FALSE, + HCL_CNODE_SELF, HCL_CNODE_ELLIPSIS, HCL_CNODE_TRPCOLONS, @@ -1501,6 +1503,7 @@ int hcl_emitbyteinstruction ( hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodeself (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodeellipsis (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, const hcl_ooch_t v); hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); diff --git a/lib/hcl.h b/lib/hcl.h index f6ec1cc..cc0d5b4 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -376,7 +376,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_FLAGS_MOVED_BITS 2 #define HCL_OBJ_FLAGS_NGC_BITS 1 #define HCL_OBJ_FLAGS_TRAILER_BITS 1 -#define HCL_OBJ_FLAGS_SYNCODE_BITS 4 +#define HCL_OBJ_FLAGS_SYNCODE_BITS 5 #define HCL_OBJ_FLAGS_BRAND_BITS 6 @@ -624,7 +624,31 @@ struct hcl_context_t /* SmallInteger, instruction pointer */ hcl_oop_t ip; - hcl_oop_t base; /* either a block or a function */ + /* the initial context is created with the initial function object in this field. + * a function-based context is created with the activating function object. + * a block-based context is created with the function object that the base field of + * the home context of the activating block context points to. */ + hcl_oop_function_t base; /* function */ + +/* TODO: get rid of origin. or rename base to origin??? with the base pointing to + * the originating function object and a separate receiver pointer, + * the originating function context isn't that useful.... */ + /* a function context is created with itself in this field. The function + * context creation is based on a function object(initial or lambda/defun). + * + * a block context is created over a block object. it stores + * a function context that points to itself in this field. a block context + * points to the function context where it is created. another block context + * created within the block context also points to the same function context. + * + * take note of the following points: + * ctx->origin: function context + * ctx->origin->base: actual function containing byte codes pertaining to ctx. + * + * a base of a block context is a block object but ctx->origin is guaranteed to be + * a function context. so its base is also a function object all the time. + */ + hcl_oop_context_t origin; /* it points to the active context at the moment when * this context object has been activated. a new method context @@ -643,24 +667,8 @@ struct hcl_context_t * 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 */ + hcl_oop_context_t home; /* context or nil */ - /* a function context is created with itself in this field. The function - * context creation is based on a function object(initial or lambda/defun). - * - * a block context is created over a block object. it stores - * a function context that points to itself in this field. a block context - * points to the function context where it is created. another block context - * created within the block context also points to the same function context. - * - * take note of the following points: - * ctx->origin: function context - * ctx->origin->base: actual function containing byte codes pertaining to ctx. - * - * a base of a block context is a block object but ctx->origin is guaranteed to be - * a function context. so its base is also a function object all the time. - */ - hcl_oop_context_t origin; /* variable indexed part */ hcl_oop_t slot[1]; /* arguments, return variables, local variables, other arguments, etc */ @@ -1528,7 +1536,7 @@ struct hcl_t hcl_oop_t _and; /* symbol */ hcl_oop_t _break; /* symbol */ - hcl_oop_t _catch; /* symbol */ + hcl_oop_t _catch; /* symbol */ hcl_oop_t _continue; /* symbol */ hcl_oop_t _defclass; /* symbol */ hcl_oop_t _defun; /* symbol */ @@ -1842,7 +1850,8 @@ enum hcl_syncode_t HCL_SYNCODE_THROW, HCL_SYNCODE_TRY, HCL_SYNCODE_UNTIL, - HCL_SYNCODE_WHILE + HCL_SYNCODE_WHILE, + }; typedef enum hcl_syncode_t hcl_syncode_t; diff --git a/lib/read.c b/lib/read.c index 261f354..34c4091 100644 --- a/lib/read.c +++ b/lib/read.c @@ -992,7 +992,8 @@ static hcl_iotok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v) { { 4, { 'n','u','l','l' }, HCL_IOTOK_NIL }, { 4, { 't','r','u','e' }, HCL_IOTOK_TRUE }, - { 5, { 'f','a','l','s','e' }, HCL_IOTOK_FALSE } + { 5, { 'f','a','l','s','e' }, HCL_IOTOK_FALSE }, + { 4, { 's','e','l','f' }, HCL_IOTOK_SELF } }; for (i = 0; i < HCL_COUNTOF(tab); i++) @@ -1990,6 +1991,10 @@ static hcl_cnode_t* read_object (hcl_t* hcl) obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; + case HCL_IOTOK_SELF: + obj = hcl_makecnodeself(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); + break; + case HCL_IOTOK_ELLIPSIS: obj = hcl_makecnodeellipsis(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break;