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

added a new identifier - self

Browse Source
This commit is contained in:
hyung-hwan 2022-02-05 17:35:10 +00:00
parent d1c12bc543
commit 495cea5704
7 changed files with 126 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lib/cnode.c
View File

@ -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); 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) 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); return make_cnode(hcl, HCL_CNODE_ELLIPSIS, loc, tok);

14
lib/comp.c
View File

@ -1983,14 +1983,13 @@ static int check_if_plain_cnode (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t* prev
/* /*
(defclass A (defclass A
| x y | ; instance variables | 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. ; everything inside defclass after the variable declarations are normal expressions.
; however, the resolution of some variables will fall under the enclosing class. ; however, the resolution of some variables will fall under the enclosing class.
(set x 20) (set x 20)
(printf "normal statement ....\n"); (printf "normal statement ....\n");
(defun new (a b c) (defun new (a b c)
(printf "%O\n" self) ; self is A (printf "%O\n" self) ; self is A
(set obj super.new) (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; 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; 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]; 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->tmprlen == hcl->c->tv.s.len - HCL_CNODE_GET_TOKLEN(exarg) - 1);
HCL_ASSERT (hcl, fbi->tmprcnt == vi.index_in_ctx + par_tmprcnt); 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 differentiate module access and dictioary member access...
* must implementate dictionary member access syntax... */ * must implementate dictionary member access syntax... */
#if 0
the dot notation collides with car/cdr separator???
{ /* HACK FOR NOW */ { /* HACK FOR NOW */
const hcl_ooch_t* sep; const hcl_ooch_t* sep;
@ -3642,6 +3642,7 @@ HCL_DEBUG1 (hcl, ">>>> instance variable or method %js\n", sep + 1);
} }
/* TODO: super? */ /* TODO: super? */
} }
#endif
sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(obj), HCL_CNODE_GET_TOKLEN(obj)); sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(obj), HCL_CNODE_GET_TOKLEN(obj));
if (HCL_UNLIKELY(!sym)) return -1; 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; if (emit_byte_instruction(hcl, HCL_CODE_PUSH_FALSE, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
goto done; 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: case HCL_CNODE_CHARLIT:
lit = HCL_CHAR_TO_OOP(oprnd->u.charlit.v); lit = HCL_CHAR_TO_OOP(oprnd->u.charlit.v);
goto literal; 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 (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; if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_MSTORE, index, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
POP_CFRAME (hcl); POP_CFRAME (hcl);
return 0; return 0;
} }

102
lib/exec.c
View File

@ -88,6 +88,8 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' };
#define LOAD_ACTIVE_SP(hcl) LOAD_SP(hcl, (hcl)->processor->active) #define LOAD_ACTIVE_SP(hcl) LOAD_SP(hcl, (hcl)->processor->active)
#define STORE_ACTIVE_SP(hcl) STORE_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) \ #define SWITCH_ACTIVE_CONTEXT(hcl,v_ctx) \
do \ do \
{ \ { \
@ -98,6 +100,18 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' };
LOAD_ACTIVE_IP (hcl); \ LOAD_ACTIVE_IP (hcl); \
(hcl)->processor->active->current_context = (hcl)->active_context; \ (hcl)->processor->active->current_context = (hcl)->active_context; \
} while (0) } 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)->code.bc.arr->slot[(hcl)->ip++])*/
#define FETCH_BYTE_CODE(hcl) ((hcl)->active_code[(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->ip = op_blk->ip;
blkctx->req_nrets = HCL_SMOOI_TO_OOP(req_nrvars); blkctx->req_nrets = HCL_SMOOI_TO_OOP(req_nrvars);
blkctx->tmpr_mask = op_blk->tmpr_mask; blkctx->tmpr_mask = op_blk->tmpr_mask;
blkctx->base = (hcl_oop_t)op_blk; //blkctx->base = (hcl_oop_t)op_blk;
blkctx->home = op_blk->home; blkctx->base = op_blk->home->base;
/* blkctx->origin = op_blk->origin; */
blkctx->origin = op_blk->home->origin; 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 #endif
if (HCL_LIKELY(copy_args)) 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) 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. /* prepare a new block context for activation */
* the receiver must be a block context which becomes the base
* for a new block context. */
hcl_oop_context_t functx; hcl_oop_context_t functx;
hcl_ooi_t i, j; 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)) (printf ">>>> %d\n" (sum 10))
*/ */
/* the receiver must be a function */
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op_func)); HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op_func));
tmpr_mask = HCL_OOP_TO_SMOOI(op_func->tmpr_mask); 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->ip = HCL_SMOOI_TO_OOP(0);
functx->req_nrets = HCL_SMOOI_TO_OOP(1); functx->req_nrets = HCL_SMOOI_TO_OOP(1);
functx->tmpr_mask = op_func->tmpr_mask; functx->tmpr_mask = op_func->tmpr_mask;
functx->base = (hcl_oop_t)op_func; functx->base = op_func;
functx->home = op_func->home; functx->home = op_func->home;
functx->origin = functx; /* the origin of the context over a function should be itself */ functx->origin = functx; /* the origin of the context over a function should be itself */
functx->receiver = HCL_STACK_GETRCV(hcl, nargs); 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) static HCL_INLINE int activate_function (hcl_t* hcl, hcl_ooi_t nargs)
{ {
int x; int x;
hcl_oop_function_t op; hcl_oop_function_t op_func;
hcl_oop_context_t newctx; hcl_oop_context_t newctx;
op = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs); op_func = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs);
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op)); 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; if (HCL_UNLIKELY(x <= -1)) return -1;
SWITCH_ACTIVE_CONTEXT (hcl, newctx); SWITCH_ACTIVE_CONTEXT (hcl, newctx);
@ -3029,7 +3049,7 @@ static int execute (hcl_t* hcl)
b1 = bcode & 0x7; /* low 3 bits */ b1 = bcode & 0x7; /* low 3 bits */
push_instvar: push_instvar:
LOG_INST_1 (hcl, "push_instvar %zu", b1); 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... */ /* 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->origin->receiver)->slot[b1]);
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->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: store_instvar:
LOG_INST_1 (hcl, "store_into_instvar %zu", b1); 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_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; break;
/* ------------------------------------------------- */ /* ------------------------------------------------- */
@ -3071,11 +3092,14 @@ static int execute (hcl_t* hcl)
pop_into_instvar: pop_into_instvar:
LOG_INST_1 (hcl, "pop_into_instvar %zu", b1); 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_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); HCL_STACK_POP (hcl);
break; break;
/* ------------------------------------------------- */ /* ------------------------------------------------- */
#if 0
// the compiler never emits these instructions. reuse these instructions for other purposes
case HCL_CODE_PUSH_TEMPVAR_X: case HCL_CODE_PUSH_TEMPVAR_X:
case HCL_CODE_STORE_INTO_TEMPVAR_X: case HCL_CODE_STORE_INTO_TEMPVAR_X:
case HCL_CODE_POP_INTO_TEMPVAR_X: case HCL_CODE_POP_INTO_TEMPVAR_X:
@ -3147,6 +3171,7 @@ static int execute (hcl_t* hcl)
break; break;
} }
#endif
/* ------------------------------------------------- */ /* ------------------------------------------------- */
case HCL_CODE_PUSH_LITERAL_X2: 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: case HCL_CODE_PUSH_CLSVAR_I_X:
{ {
hcl_oop_class_t t; 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: case HCL_CODE_PUSH_CLSVAR_M_X:
{ {
hcl_oop_class_t t; hcl_oop_class_t t;
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "push_clsvar_m %zu", 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)) if (!HCL_IS_INSTANCE(hcl, t))
{ {
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver"); 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; hcl_oop_class_t t;
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "store_into_clsvar_m %zu", 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)) if (!HCL_IS_INSTANCE(hcl, t))
{ {
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver"); 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; hcl_oop_class_t t;
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "pop_into_clsvar_m %zu", 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)) if (!HCL_IS_INSTANCE(hcl, t))
{ {
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver"); 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 */ case HCL_CODE_PUSH_RECEIVER: /* push self or super */
LOG_INST_0 (hcl, "push_receiver"); 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; break;
case HCL_CODE_PUSH_NIL: 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: case HCL_CODE_RETURN_RECEIVER:
LOG_INST_0 (hcl, "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: handle_return:
hcl->last_retv = return_value; 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: case HCL_CODE_MAKE_FUNCTION:
{ {
hcl_oop_function_t func; hcl_oop_function_t funcobj;
hcl_oow_t b3, b4; hcl_oow_t b3, b4;
hcl_oow_t joff; 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 */ /* copy the byte codes from the active context to the new context */
#if (HCL_CODE_LONG_PARAM_SIZE == 2) #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 #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 #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 */ /* 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; break;
} }
@ -4338,7 +4372,7 @@ oops:
hcl_oop_t hcl_execute (hcl_t* hcl) hcl_oop_t hcl_execute (hcl_t* hcl)
{ {
hcl_oop_function_t func; hcl_oop_function_t funcobj;
int n; int n;
hcl_bitmask_t log_default_type_mask; 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 */ /* 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); funcobj = 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; if (HCL_UNLIKELY(!funcobj)) return HCL_NULL;
/* pass nil for the home context of the initial function */ /* 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 #if 0
/* unless the system is buggy, hcl->proc_map_used should be 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; if (HCL_UNLIKELY(x <= -1)) return HCL_PF_FAILURE;
HCL_ASSERT (hcl, (hcl_oop_t)newctx->sender == hcl->_nil); 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); hcl_pushvolat (hcl, (hcl_oop_t*)&newctx);
newprc = make_process(hcl, newctx); newprc = make_process(hcl, newctx);

3
lib/hcl-prv.h
View File

@ -144,6 +144,7 @@ enum hcl_iotok_type_t
HCL_IOTOK_NIL, HCL_IOTOK_NIL,
HCL_IOTOK_TRUE, HCL_IOTOK_TRUE,
HCL_IOTOK_FALSE, HCL_IOTOK_FALSE,
HCL_IOTOK_SELF,
HCL_IOTOK_IDENT, HCL_IOTOK_IDENT,
HCL_IOTOK_IDENT_DOTTED, HCL_IOTOK_IDENT_DOTTED,
@ -198,6 +199,7 @@ enum hcl_cnode_type_t
HCL_CNODE_NIL, HCL_CNODE_NIL,
HCL_CNODE_TRUE, HCL_CNODE_TRUE,
HCL_CNODE_FALSE, HCL_CNODE_FALSE,
HCL_CNODE_SELF,
HCL_CNODE_ELLIPSIS, HCL_CNODE_ELLIPSIS,
HCL_CNODE_TRPCOLONS, 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_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_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_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_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_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); hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok);

47
lib/hcl.h
View File

@ -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_MOVED_BITS 2
#define HCL_OBJ_FLAGS_NGC_BITS 1 #define HCL_OBJ_FLAGS_NGC_BITS 1
#define HCL_OBJ_FLAGS_TRAILER_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 #define HCL_OBJ_FLAGS_BRAND_BITS 6
@ -624,7 +624,31 @@ struct hcl_context_t
/* SmallInteger, instruction pointer */ /* SmallInteger, instruction pointer */
hcl_oop_t ip; 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 /* it points to the active context at the moment when
* this context object has been activated. a new method context * this context object has been activated. a new method context
@ -645,22 +669,6 @@ struct hcl_context_t
* an activated block context copies this field from the base block context. */ * 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 */ /* variable indexed part */
hcl_oop_t slot[1]; /* arguments, return variables, local variables, other arguments, etc */ hcl_oop_t slot[1]; /* arguments, return variables, local variables, other arguments, etc */
@ -1842,7 +1850,8 @@ enum hcl_syncode_t
HCL_SYNCODE_THROW, HCL_SYNCODE_THROW,
HCL_SYNCODE_TRY, HCL_SYNCODE_TRY,
HCL_SYNCODE_UNTIL, HCL_SYNCODE_UNTIL,
HCL_SYNCODE_WHILE HCL_SYNCODE_WHILE,
}; };
typedef enum hcl_syncode_t hcl_syncode_t; typedef enum hcl_syncode_t hcl_syncode_t;

7
lib/read.c
View File

@ -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, { 'n','u','l','l' }, HCL_IOTOK_NIL },
{ 4, { 't','r','u','e' }, HCL_IOTOK_TRUE }, { 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++) 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)); obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
break; break;
case HCL_IOTOK_SELF:
obj = hcl_makecnodeself(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
break;
case HCL_IOTOK_ELLIPSIS: case HCL_IOTOK_ELLIPSIS:
obj = hcl_makecnodeellipsis(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); obj = hcl_makecnodeellipsis(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
break; break;