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

fixed some compiler bugs

Browse Source
This commit is contained in:
hyung-hwan 2021-02-01 13:20:46 +00:00
parent 65c23a3ff5
commit 2d22b53c96
5 changed files with 230 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
lib/comp.c
View File

@ -171,22 +171,22 @@ static int add_temporary_variable (hcl_t* hcl, const hcl_oocs_t* name, hcl_oow_t
hcl_oocs_t s; hcl_oocs_t s;
int x; int x;
s.ptr = hcl->c->tv2.s.ptr + dup_check_start; s.ptr = hcl->c->tv.s.ptr + dup_check_start;
s.len = hcl->c->tv2.s.len - dup_check_start; s.len = hcl->c->tv.s.len - dup_check_start;
if (__find_word_in_string(&s, name, 0, HCL_NULL) >= 0) if (__find_word_in_string(&s, name, 0, HCL_NULL) >= 0)
{ {
hcl_seterrnum (hcl, HCL_EEXIST); hcl_seterrnum (hcl, HCL_EEXIST);
return -1; return -1;
} }
x = copy_string_to(hcl, name, &hcl->c->tv2.s, &hcl->c->tv2.capa, 1, ' '); x = copy_string_to(hcl, name, &hcl->c->tv.s, &hcl->c->tv.capa, 1, ' ');
if (HCL_LIKELY(x >= 0)) hcl->c->tv2.wcount++; if (HCL_LIKELY(x >= 0)) hcl->c->tv.wcount++;
return x; return x;
} }
static int find_temporary_variable_backward (hcl_t* hcl, const hcl_oocs_t* name, hcl_oow_t* index) static int find_temporary_variable_backward (hcl_t* hcl, const hcl_oocs_t* name, hcl_oow_t* index)
{ {
/* find the last element */ /* find the last element */
return __find_word_in_string(&hcl->c->tv2.s, name, 1, index); return __find_word_in_string(&hcl->c->tv.s, name, 1, index);
} }
static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, hcl_oow_t tmpr_len, hcl_oow_t lfbase) static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, hcl_oow_t tmpr_len, hcl_oow_t lfbase)
@ -794,6 +794,8 @@ enum
COP_SUBCOMPILE_ELIF, COP_SUBCOMPILE_ELIF,
COP_SUBCOMPILE_ELSE, COP_SUBCOMPILE_ELSE,
COP_SUBCOMPILE_AND_EXPR,
COP_SUBCOMPILE_OR_EXPR,
COP_EMIT_CALL, COP_EMIT_CALL,
@ -813,12 +815,6 @@ enum
COP_EMIT_RETURN, COP_EMIT_RETURN,
COP_EMIT_SET, COP_EMIT_SET,
COP_SUBCOMPILE_AND_EXPR,
COP_SUBCOMPILE_OR_EXPR,
COP_POST_AND_EXPR,
COP_POST_OR_EXPR,
COP_POST_IF_COND, COP_POST_IF_COND,
COP_POST_IF_BODY, COP_POST_IF_BODY,
@ -827,7 +823,11 @@ enum
COP_POST_WHILE_BODY, COP_POST_WHILE_BODY,
COP_POST_WHILE_COND, COP_POST_WHILE_COND,
COP_UPDATE_BREAK COP_POST_LAMBDA,
COP_POST_AND_EXPR,
COP_POST_OR_EXPR,
COP_POST_BREAK
}; };
/* ========================================================================= */ /* ========================================================================= */
@ -941,7 +941,7 @@ static int compile_break (hcl_t* hcl, hcl_cnode_t* src)
jump_inst_pos = hcl->code.bc.len; jump_inst_pos = hcl->code.bc.len;
if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
INSERT_CFRAME (hcl, i, COP_UPDATE_BREAK, cmd); INSERT_CFRAME (hcl, i, COP_POST_BREAK, cmd);
cf = GET_CFRAME(hcl, i); cf = GET_CFRAME(hcl, i);
cf->u._break.jump_inst_pos = jump_inst_pos; cf->u._break.jump_inst_pos = jump_inst_pos;
@ -1063,7 +1063,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
saved_tv_wcount = hcl->c->tv2.wcount; saved_tv_wcount = hcl->c->tv.wcount;
cmd = HCL_CNODE_CONS_CAR(src); cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src); obj = HCL_CNODE_CONS_CDR(src);
@ -1100,6 +1100,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
else else
{ {
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_LAMBDA)); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_LAMBDA));
defun_name = HCL_NULL;
} }
if (!obj) if (!obj)
@ -1114,22 +1115,22 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
} }
args = HCL_CNODE_CONS_CAR(obj); args = HCL_CNODE_CONS_CAR(obj);
if (!args) HCL_ASSERT (hcl, args != HCL_NULL);
if (HCL_CNODE_IS_ELIST_CONCODED(args, HCL_CONCODE_XLIST))
{ {
/* no argument - (lambda () (+ 10 20)) */ /* no argument - (lambda () (+ 10 20)) */
nargs = 0; nargs = 0;
} }
else if (!HCL_CNODE_IS_CONS(args))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "not an argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
else else
{ {
hcl_cnode_t* arg, * dcl; hcl_cnode_t* arg, * dcl;
if (!HCL_CNODE_IS_CONS(args)) tv_dup_start = hcl->c->tv.s.len;
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "not an argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
tv_dup_start = hcl->c->tv2.s.len;
nargs = 0; nargs = 0;
dcl = args; dcl = args;
do do
@ -1169,7 +1170,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
while (1); while (1);
} }
HCL_ASSERT (hcl, nargs == hcl->c->tv2.wcount - saved_tv_wcount); HCL_ASSERT (hcl, nargs == hcl->c->tv.wcount - saved_tv_wcount);
if (nargs > MAX_CODE_NBLKARGS) /*TODO: change this limit to max call argument count */ if (nargs > MAX_CODE_NBLKARGS) /*TODO: change this limit to max call argument count */
{ {
/* while an integer object is pused to indicate the number of /* while an integer object is pused to indicate the number of
@ -1183,7 +1184,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
ntmprs = nargs; ntmprs = nargs;
obj = HCL_CNODE_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
tv_dup_start = hcl->c->tv2.s.len; tv_dup_start = hcl->c->tv.s.len;
while (obj && HCL_CNODE_IS_CONS(obj)) while (obj && HCL_CNODE_IS_CONS(obj))
{ {
hcl_cnode_t* dcl; hcl_cnode_t* dcl;
@ -1239,7 +1240,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
} }
/* ntmprs: number of temporary variables including arguments */ /* ntmprs: number of temporary variables including arguments */
HCL_ASSERT (hcl, ntmprs == hcl->c->tv2.wcount - saved_tv_wcount); HCL_ASSERT (hcl, ntmprs == hcl->c->tv.wcount - saved_tv_wcount);
if (ntmprs > MAX_CODE_NBLKTMPRS) if (ntmprs > MAX_CODE_NBLKTMPRS)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) variables in %.*js", ntmprs, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) variables in %.*js", ntmprs, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
@ -1252,7 +1253,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
return -1; return -1;
} }
hcl->c->blk.depth++; hcl->c->blk.depth++;
if (store_temporary_variable_count_for_block(hcl, hcl->c->tv2.wcount, hcl->c->tv2.s.len, hcl->code.lit.len) <= -1) return -1; if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.wcount, hcl->c->tv.s.len, hcl->code.lit.len) <= -1) return -1;
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
@ -1275,33 +1276,10 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
* produce the long jump instruction (HCL_CODE_JUMP_FORWARD_X) */ * produce the long jump instruction (HCL_CODE_JUMP_FORWARD_X) */
if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_LAMBDA, defun_name); /* 3*/
if (defun)
{
hcl_oow_t index;
hcl_cframe_t* cf;
if (find_temporary_variable_backward(hcl, HCL_CNODE_GET_TOK(defun_name), &index) <= -1)
{
PUSH_SUBCFRAME (hcl, COP_EMIT_SET, defun_name); /* set doesn't evaluate the variable name */
cf = GET_SUBCFRAME(hcl);
cf->u.set.var_type = VAR_NAMED;
}
else
{
/* the check in compile_lambda() must ensure this condition */
HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX);
PUSH_SUBCFRAME (hcl, COP_EMIT_SET, defun_name);
cf = GET_SUBCFRAME(hcl);
cf->u.set.var_type = VAR_INDEXED;
cf->u.set.index = index;
}
}
PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, src);
PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, src); /* 2 */
cf = GET_SUBCFRAME (hcl); cf = GET_SUBCFRAME (hcl);
cf->u.lambda.jump_inst_pos = jump_inst_pos; cf->u.lambda.jump_inst_pos = jump_inst_pos;
@ -2873,13 +2851,13 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
/* ========================================================================= */ /* ========================================================================= */
static int update_break (hcl_t* hcl) static int post_break (hcl_t* hcl)
{ {
hcl_cframe_t* cf; hcl_cframe_t* cf;
hcl_ooi_t jip, jump_offset; hcl_ooi_t jip, jump_offset;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_UPDATE_BREAK); HCL_ASSERT (hcl, cf->opcode == COP_POST_BREAK);
HCL_ASSERT (hcl, cf->operand != HCL_NULL); HCL_ASSERT (hcl, cf->operand != HCL_NULL);
jip = cf->u._break.jump_inst_pos;; jip = cf->u._break.jump_inst_pos;;
@ -2914,6 +2892,8 @@ static HCL_INLINE int emit_call (hcl_t* hcl)
return n; return n;
} }
/* ========================================================================= */
static HCL_INLINE int emit_make_array (hcl_t* hcl) static HCL_INLINE int emit_make_array (hcl_t* hcl)
{ {
hcl_cframe_t* cf; hcl_cframe_t* cf;
@ -3036,6 +3016,8 @@ static HCL_INLINE int emit_pop_into_cons (hcl_t* hcl, int cmd)
return n; return n;
} }
/* ========================================================================= */
static HCL_INLINE int emit_lambda (hcl_t* hcl) static HCL_INLINE int emit_lambda (hcl_t* hcl)
{ {
hcl_cframe_t* cf; hcl_cframe_t* cf;
@ -3051,10 +3033,6 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
lfsize = hcl->code.lit.len - hcl->c->blk.info[hcl->c->blk.depth].lfbase; lfsize = hcl->code.lit.len - hcl->c->blk.info[hcl->c->blk.depth].lfbase;
hcl->c->blk.depth--;
hcl->c->tv2.s.len = hcl->c->blk.info[hcl->c->blk.depth].tmprlen;
hcl->c->tv2.wcount = hcl->c->blk.info[hcl->c->blk.depth].tmprcnt;
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */ /* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
block_code_size = hcl->code.bc.len - jip - (HCL_CODE_LONG_PARAM_SIZE + 1); block_code_size = hcl->code.bc.len - jip - (HCL_CODE_LONG_PARAM_SIZE + 1);
@ -3083,6 +3061,54 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
return 0; return 0;
} }
static HCL_INLINE int post_lambda (hcl_t* hcl)
{
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_LAMBDA);
hcl->c->blk.depth--;
hcl->c->tv.s.len = hcl->c->blk.info[hcl->c->blk.depth].tmprlen;
hcl->c->tv.wcount = hcl->c->blk.info[hcl->c->blk.depth].tmprcnt;
if (cf->operand)
{
/* (defun x() ; this x refers to a variable in the outer scope.
* | t1 t2 x |
* (set x 10) ; this x refers to the local variable.
* )
*
* the block has been exited(blk.depth--) before finding 'x' in the outer scope.
*/
hcl_cnode_t* defun_name = cf->operand;
hcl_oow_t index;
if (find_temporary_variable_backward(hcl, HCL_CNODE_GET_TOK(defun_name), &index) <= -1)
{
SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name);
cf = GET_SUBCFRAME(hcl);
cf->u.set.var_type = VAR_NAMED;
}
else
{
HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX);
SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name);
cf = GET_SUBCFRAME(hcl);
cf->u.set.var_type = VAR_INDEXED;
cf->u.set.index = index;
}
}
else
{
POP_CFRAME (hcl);
}
return 0;
}
/* ========================================================================= */
static HCL_INLINE int emit_pop_stacktop (hcl_t* hcl) static HCL_INLINE int emit_pop_stacktop (hcl_t* hcl)
{ {
hcl_cframe_t* cf; hcl_cframe_t* cf;
@ -3166,8 +3192,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
log_default_type_mask = hcl->log.default_type_mask; log_default_type_mask = hcl->log.default_type_mask;
hcl->log.default_type_mask |= HCL_LOG_COMPILER; hcl->log.default_type_mask |= HCL_LOG_COMPILER;
HCL_ASSERT (hcl, hcl->c->tv2.s.len == 0); HCL_ASSERT (hcl, hcl->c->tv.s.len == 0);
HCL_ASSERT (hcl, hcl->c->tv2.wcount == 0); HCL_ASSERT (hcl, hcl->c->tv.wcount == 0);
HCL_ASSERT (hcl, hcl->c->blk.depth == -1); HCL_ASSERT (hcl, hcl->c->blk.depth == -1);
/* TODO: in case i implement all global variables as block arguments at the top level...what should i do? */ /* TODO: in case i implement all global variables as block arguments at the top level...what should i do? */
@ -3204,7 +3230,7 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
* @0 (a) * @0 (a)
* @1 (set-a) * @1 (set-a)
*/ */
if (store_temporary_variable_count_for_block(hcl, hcl->c->tv2.wcount, hcl->c->tv2.s.len, 0) <= -1) return -1; if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.wcount, hcl->c->tv.s.len, 0) <= -1) return -1;
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj); PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj);
@ -3245,6 +3271,22 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
if (compile_qlist(hcl) <= -1) goto oops; if (compile_qlist(hcl) <= -1) goto oops;
break; break;
case COP_SUBCOMPILE_ELIF:
if (subcompile_elif(hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_ELSE:
if (subcompile_else(hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_AND_EXPR:
if (subcompile_and_expr(hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_OR_EXPR:
if (subcompile_or_expr(hcl) <= -1) goto oops;
break;
case COP_EMIT_CALL: case COP_EMIT_CALL:
if (emit_call(hcl) <= -1) goto oops; if (emit_call(hcl) <= -1) goto oops;
break; break;
@ -3305,22 +3347,6 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
if (emit_set(hcl) <= -1) goto oops; if (emit_set(hcl) <= -1) goto oops;
break; break;
case COP_SUBCOMPILE_AND_EXPR:
if (subcompile_and_expr(hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_OR_EXPR:
if (subcompile_or_expr(hcl) <= -1) goto oops;
break;
case COP_POST_AND_EXPR:
if (post_and_expr(hcl) <= -1) goto oops;
break;
case COP_POST_OR_EXPR:
if (post_or_expr(hcl) <= -1) goto oops;
break;
case COP_POST_IF_COND: case COP_POST_IF_COND:
if (post_if_cond(hcl) <= -1) goto oops; if (post_if_cond(hcl) <= -1) goto oops;
break; break;
@ -3339,16 +3365,20 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
if (post_while_cond(hcl) <= -1) goto oops; if (post_while_cond(hcl) <= -1) goto oops;
break; break;
case COP_SUBCOMPILE_ELIF: case COP_POST_LAMBDA:
if (subcompile_elif(hcl) <= -1) goto oops; if (post_lambda(hcl) <= -1) goto oops;
break; break;
case COP_SUBCOMPILE_ELSE: case COP_POST_AND_EXPR:
if (subcompile_else(hcl) <= -1) goto oops; if (post_and_expr(hcl) <= -1) goto oops;
break; break;
case COP_UPDATE_BREAK: case COP_POST_OR_EXPR:
if (update_break(hcl) <= -1) goto oops; if (post_or_expr(hcl) <= -1) goto oops;
break;
case COP_POST_BREAK:
if (post_break(hcl) <= -1) goto oops;
break; break;
default: default:
@ -3363,8 +3393,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) goto oops; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) goto oops;
HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0); HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0);
HCL_ASSERT (hcl, hcl->c->tv2.s.len == 0); HCL_ASSERT (hcl, hcl->c->tv.s.len == 0);
HCL_ASSERT (hcl, hcl->c->tv2.wcount == 0); HCL_ASSERT (hcl, hcl->c->tv.wcount == 0);
HCL_ASSERT (hcl, hcl->c->blk.depth == 0); HCL_ASSERT (hcl, hcl->c->blk.depth == 0);
hcl->c->blk.depth--; hcl->c->blk.depth--;
@ -3380,8 +3410,8 @@ oops:
hcl->code.bc.len = saved_bc_len; hcl->code.bc.len = saved_bc_len;
hcl->code.lit.len = saved_lit_len; hcl->code.lit.len = saved_lit_len;
hcl->c->tv2.s.len = 0; hcl->c->tv.s.len = 0;
hcl->c->tv2.wcount = 0; hcl->c->tv.wcount = 0;
hcl->c->blk.depth = -1; hcl->c->blk.depth = -1;
return -1; return -1;
} }

89
lib/exec.c
View File

@ -527,7 +527,6 @@ static HCL_INLINE void switch_to_process_from_nil (hcl_t* hcl, hcl_oop_process_t
static HCL_INLINE hcl_oop_process_t find_next_runnable_process (hcl_t* hcl) static HCL_INLINE hcl_oop_process_t find_next_runnable_process (hcl_t* hcl)
{ {
hcl_oop_process_t nrp; hcl_oop_process_t nrp;
HCL_ASSERT (hcl, hcl->processor->active->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING)); HCL_ASSERT (hcl, hcl->processor->active->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING));
nrp = hcl->processor->active->ps.next; nrp = hcl->processor->active->ps.next;
if ((hcl_oop_t)nrp == hcl->_nil) nrp = hcl->processor->runnable.first; if ((hcl_oop_t)nrp == hcl->_nil) nrp = hcl->processor->runnable.first;
@ -537,7 +536,6 @@ static HCL_INLINE hcl_oop_process_t find_next_runnable_process (hcl_t* hcl)
static HCL_INLINE void switch_to_next_runnable_process (hcl_t* hcl) static HCL_INLINE void switch_to_next_runnable_process (hcl_t* hcl)
{ {
hcl_oop_process_t nrp; hcl_oop_process_t nrp;
nrp = find_next_runnable_process (hcl); nrp = find_next_runnable_process (hcl);
if (nrp != hcl->processor->active) switch_to_process (hcl, nrp, PROC_STATE_RUNNABLE); if (nrp != hcl->processor->active) switch_to_process (hcl, nrp, PROC_STATE_RUNNABLE);
} }
@ -2441,6 +2439,7 @@ switch_to_next:
return 1; return 1;
} }
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
static HCL_INLINE int do_return (hcl_t* hcl, hcl_oop_t return_value) static HCL_INLINE int do_return (hcl_t* hcl, hcl_oop_t return_value)
@ -2979,15 +2978,15 @@ static int execute (hcl_t* hcl)
switch (HCL_OBJ_GET_FLAGS_BRAND(rcv)) switch (HCL_OBJ_GET_FLAGS_BRAND(rcv))
{ {
case HCL_BRAND_FUNCTION: case HCL_BRAND_FUNCTION:
if (activate_function(hcl, b1) <= -1) goto oops; if (activate_function(hcl, b1) <= -1) goto call_failed;
break; break;
case HCL_BRAND_BLOCK: case HCL_BRAND_BLOCK:
if (activate_block(hcl, b1) <= -1) goto oops; if (activate_block(hcl, b1) <= -1) goto call_failed;
break; break;
case HCL_BRAND_PRIM: case HCL_BRAND_PRIM:
if (call_primitive(hcl, b1) <= -1) goto oops; if (call_primitive(hcl, b1) <= -1) goto call_failed;
break; break;
default: default:
@ -2999,6 +2998,7 @@ static int execute (hcl_t* hcl)
cannot_call: cannot_call:
/* run time error */ /* run time error */
hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv); hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv);
call_failed:
supplement_errmsg (hcl, fetched_instruction_pointer); supplement_errmsg (hcl, fetched_instruction_pointer);
goto oops; goto oops;
} }
@ -3722,3 +3722,82 @@ void hcl_abort (hcl_t* hcl)
{ {
hcl->abort_req = 1; hcl->abort_req = 1;
} }
/* ------------------------------------------------------------------------- */
hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t blk;
hcl_oop_context_t newctx;
hcl_oop_process_t newprc;
blk = (hcl_oop_t)HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_BLOCK(hcl, blk))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not block - %O", blk);
return HCL_PF_FAILURE;
}
/* TODO: fill arguments. check argument count... */
newctx = make_context(hcl, 0);
if (HCL_UNLIKELY(!newctx)) return HCL_PF_FAILURE;
newprc = make_process(hcl, newctx);
if (HCL_UNLIKELY(!newprc)) return HCL_PF_FAILURE;
chain_into_processor (hcl, newprc, PROC_STATE_RUNNABLE);
HCL_STACK_SETRET (hcl, nargs, (hcl_oop_t)newprc);
return HCL_PF_SUCCESS;
}
hcl_pfrc_t hcl_pf_process_resume (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_process_t prc;
prc = (hcl_oop_process_t)HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_PROCESS(hcl, prc))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not process - %O", prc);
return HCL_PF_FAILURE;
}
resume_process (hcl, prc);
return HCL_PF_SUCCESS;
}
hcl_pfrc_t hcl_pf_process_yield (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
yield_process (hcl, hcl->processor->active);
return HCL_PF_SUCCESS;
}
hcl_pfrc_t hcl_pf_process_suspend (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_process_t prc;
if (nargs >= 1)
{
prc = (hcl_oop_process_t)HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_PROCESS(hcl, prc))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not process - %O", prc);
return HCL_PF_FAILURE;
}
}
else
{
prc = hcl->processor->active;
}
suspend_process (hcl, prc);
return HCL_PF_SUCCESS;
}
hcl_pfrc_t hcl_pf_process_sleep (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
/* TODO: sleep the current process */
return HCL_PF_SUCCESS;
}

39
lib/hcl-prv.h
View File

@ -222,7 +222,7 @@ typedef enum hcl_cnode_type_t hcl_cnode_type_t;
#define HCL_CNODE_IS_ELIST(x) ((x)->cn_type == HCL_CNODE_ELIST) #define HCL_CNODE_IS_ELIST(x) ((x)->cn_type == HCL_CNODE_ELIST)
#define HCL_CNODE_IS_ELIST_CONCODED(x) ((x)->cn_type == HCL_CNODE_ELIST && (x)->u.elist.concode == (code)) #define HCL_CNODE_IS_ELIST_CONCODED(x, code) ((x)->cn_type == HCL_CNODE_ELIST && (x)->u.elist.concode == (code))
#define HCL_CNODE_ELIST_CONCODE(x) ((x)->u.elist.concode) #define HCL_CNODE_ELIST_CONCODE(x) ((x)->u.elist.concode)
/* NOTE: hcl_cnode_t used by the built-in compiler is not an OOP object */ /* NOTE: hcl_cnode_t used by the built-in compiler is not an OOP object */
@ -347,7 +347,7 @@ struct hcl_cframe_t
int from_home; int from_home;
} _return; } _return;
/* COP_UPDATE_BREAK */ /* COP_POST_BREAK */
struct struct
{ {
hcl_ooi_t jump_inst_pos; hcl_ooi_t jump_inst_pos;
@ -417,20 +417,6 @@ struct hcl_compiler_t
hcl_oop_t s; /* stack for reading */ hcl_oop_t s; /* stack for reading */
hcl_oop_t e; /* last object read */ hcl_oop_t e; /* last object read */
hcl_rstl_t* st; hcl_rstl_t* st;
struct
{
hcl_oob_t* ptr;
hcl_oow_t size;
hcl_oow_t capa;
} balit;
struct
{
hcl_oop_t* ptr;
hcl_oow_t size;
hcl_oow_t capa;
} salit;
} r; /* reading */ } r; /* reading */
/* == END READER == */ /* == END READER == */
@ -443,19 +429,12 @@ struct hcl_compiler_t
} cfs; } cfs;
/* == END COMPILER STACK == */ /* == END COMPILER STACK == */
struct
{
hcl_oop_t* ptr;
hcl_oow_t size;
hcl_oow_t capa;
} tv; /* temporary variables including arguments */
struct struct
{ {
hcl_oocs_t s; /* buffer */ hcl_oocs_t s; /* buffer */
hcl_oow_t capa; /* bufer capacity */ hcl_oow_t capa; /* bufer capacity */
hcl_oow_t wcount; /* word count */ hcl_oow_t wcount; /* word count */
} tv2; } tv; /* temporary variables including arguments */
struct struct
{ {
@ -1362,9 +1341,21 @@ void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c);
void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c); void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c);
hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons); hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons);
/* ========================================================================= */
/* exec.c */
/* ========================================================================= */
hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
hcl_pfrc_t hcl_pf_process_resume (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
hcl_pfrc_t hcl_pf_process_suspend (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
hcl_pfrc_t hcl_pf_process_yield (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
hcl_pfrc_t hcl_pf_process_sleep (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
#if defined(__cplusplus) #if defined(__cplusplus)
} }
#endif #endif
#endif #endif

5
lib/prim.c
View File

@ -838,6 +838,11 @@ static pf_t builtin_prims[] =
{ 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_rem, 3, { 'r','e','m' } }, { 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_rem, 3, { 'r','e','m' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mquo, 4, { 'm','d','i','v' } }, { 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mquo, 4, { 'm','d','i','v' } },
{ 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mod, 3, { 'm','o','d' } }, { 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mod, 3, { 'm','o','d' } },
{ 1, 1, hcl_pf_process_fork, 4, { 'f','o','r','k'} },
{ 1, 1, hcl_pf_process_resume, 7, { 'r','e','s','u','m','e' } },
{ 0, 1, hcl_pf_process_suspend, 8, { 's','u','s','p','e','n','d' } },
{ 0, 0, hcl_pf_process_yield, 5, { 'y','i','e','l','d'} }
}; };

50
lib/read.c
View File

@ -2102,20 +2102,8 @@ hcl_cnodetoobj (hcl_t* hcl, hcl_cnode_t* x)
static void gc_compiler (hcl_t* hcl) static void gc_compiler (hcl_t* hcl)
{ {
hcl_ooi_t i;
hcl->c->r.s = hcl_moveoop(hcl, hcl->c->r.s); hcl->c->r.s = hcl_moveoop(hcl, hcl->c->r.s);
hcl->c->r.e = hcl_moveoop(hcl, hcl->c->r.e); hcl->c->r.e = hcl_moveoop(hcl, hcl->c->r.e);
for (i = 0; i < hcl->c->tv.size; i++)
{
hcl->c->tv.ptr[i] = hcl_moveoop(hcl, hcl->c->tv.ptr[i]);
}
for (i = 0; i < hcl->c->r.salit.size; i++)
{
hcl->c->r.salit.ptr[i] = hcl_moveoop(hcl, hcl->c->r.salit.ptr[i]);
}
} }
static void fini_compiler (hcl_t* hcl) static void fini_compiler (hcl_t* hcl)
@ -2123,22 +2111,6 @@ static void fini_compiler (hcl_t* hcl)
/* called before the hcl object is closed */ /* called before the hcl object is closed */
if (hcl->c) if (hcl->c)
{ {
if (hcl->c->r.balit.ptr)
{
hcl_freemem (hcl, hcl->c->r.balit.ptr);
hcl->c->r.balit.ptr = HCL_NULL;
hcl->c->r.balit.size = 0;
hcl->c->r.balit.capa = 0;
}
if (hcl->c->r.salit.ptr)
{
hcl_freemem (hcl, hcl->c->r.salit.ptr);
hcl->c->r.salit.ptr = HCL_NULL;
hcl->c->r.salit.size = 0;
hcl->c->r.salit.capa = 0;
}
if (hcl->c->cfs.ptr) if (hcl->c->cfs.ptr)
{ {
hcl_freemem (hcl, hcl->c->cfs.ptr); hcl_freemem (hcl, hcl->c->cfs.ptr);
@ -2147,24 +2119,16 @@ static void fini_compiler (hcl_t* hcl)
hcl->c->cfs.capa = 0; hcl->c->cfs.capa = 0;
} }
if (hcl->c->tv.ptr) if (hcl->c->tv.s.ptr)
{ {
hcl_freemem (hcl, hcl->c->tv.ptr); hcl_freemem (hcl, hcl->c->tv.s.ptr);
hcl->c->tv.ptr = HCL_NULL; hcl->c->tv.s.ptr = HCL_NULL;
hcl->c->tv.size = 0; hcl->c->tv.s.len = 0;
hcl->c->tv.capa = 0; hcl->c->tv.capa = 0;
hcl->c->tv.wcount = 0;
} }
HCL_ASSERT (hcl, hcl->c->tv.capa == 0);
if (hcl->c->tv2.s.ptr) HCL_ASSERT (hcl, hcl->c->tv.wcount == 0);
{
hcl_freemem (hcl, hcl->c->tv2.s.ptr);
hcl->c->tv2.s.ptr = HCL_NULL;
hcl->c->tv2.s.len = 0;
hcl->c->tv2.capa = 0;
hcl->c->tv2.wcount = 0;
}
HCL_ASSERT (hcl, hcl->c->tv2.capa == 0);
HCL_ASSERT (hcl, hcl->c->tv2.wcount == 0);
if (hcl->c->blk.info) if (hcl->c->blk.info)
{ {