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

did something on temporary variable and argument handling

Browse Source
This commit is contained in:
hyung-hwan 2016-09-29 13:20:09 +00:00
parent 06156b1a45
commit 55a5d2c3c6
6 changed files with 284 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

206
lib/comp.c
View File

@ -32,6 +32,9 @@ enum
VAR_ARGUMENT VAR_ARGUMENT
}; };
#define TV_BUFFER_ALIGN 256
#define BLK_TMPRCNT_BUFFER_ALIGN 128
#define EMIT_BYTE_INSTRUCTION(hcl,code) \ #define EMIT_BYTE_INSTRUCTION(hcl,code) \
do { if (emit_byte_instruction(hcl,code) <= -1) return -1; } while(0) do { if (emit_byte_instruction(hcl,code) <= -1) return -1; } while(0)
@ -72,6 +75,82 @@ static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
return 0; return 0;
} }
static int add_temporary_variable (hcl_t* hcl, hcl_oop_t name, hcl_oow_t dup_check_start)
{
hcl_oow_t i;
HCL_ASSERT (HCL_IS_SYMBOL (hcl, name));
for (i = dup_check_start; i < hcl->c->tv.size; i++)
{
HCL_ASSERT (HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
if (hcl->c->tv.ptr[i] == name)
{
hcl->errnum = HCL_EEXIST;
return -1;
}
}
if (hcl->c->tv.size >= hcl->c->tv.capa)
{
hcl_oop_t* tmp;
hcl_oow_t newcapa;
newcapa = HCL_ALIGN (hcl->c->tv.capa + 1, TV_BUFFER_ALIGN); /* TODO: set a better resizing policy */
tmp = hcl_reallocmem (hcl, hcl->c->tv.ptr, newcapa);
if (!tmp) return -1;
hcl->c->tv.capa = newcapa;
hcl->c->tv.ptr = tmp;
}
hcl->c->tv.ptr[hcl->c->tv.size++] = name;
return 0;
}
static int find_temporary_variable_backward (hcl_t* hcl, hcl_oop_t name, hcl_oow_t* index)
{
hcl_oow_t i;
HCL_ASSERT (HCL_IS_SYMBOL (hcl, name));
for (i = hcl->c->tv.size; i > 0; )
{
--i;
HCL_ASSERT (HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
if (hcl->c->tv.ptr[i] == name)
{
*index = i;
return 0;
}
}
hcl->errnum = HCL_ENOENT;
return -1;
}
static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count)
{
HCL_ASSERT (hcl->c->blk.depth >= 0);
if (hcl->c->blk.depth >= hcl->c->blk.tmprcnt_capa)
{
hcl_oow_t* tmp;
hcl_oow_t newcapa;
newcapa = HCL_ALIGN (hcl->c->blk.depth + 1, BLK_TMPRCNT_BUFFER_ALIGN);
tmp = (hcl_oow_t*)hcl_reallocmem (hcl, hcl->c->blk.tmprcnt, newcapa * HCL_SIZEOF(*tmp));
if (!tmp) return -1;
hcl->c->blk.tmprcnt_capa = newcapa;
hcl->c->blk.tmprcnt = tmp;
}
hcl->c->blk.tmprcnt[hcl->c->blk.depth] = tmpr_count;
return 0;
}
/* ========================================================================= */
static HCL_INLINE void patch_instruction (hcl_t* hcl, hcl_oow_t index, hcl_oob_t bc) static HCL_INLINE void patch_instruction (hcl_t* hcl, hcl_oow_t index, hcl_oob_t bc)
{ {
HCL_ASSERT (index < hcl->code.bc.len); HCL_ASSERT (index < hcl->code.bc.len);
@ -150,7 +229,7 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case HCL_CODE_PUSH_OBJECT_0: case HCL_CODE_PUSH_OBJECT_0:
case HCL_CODE_STORE_INTO_OBJECT_0: case HCL_CODE_STORE_INTO_OBJECT_0:
case HCL_CODE_POP_INTO_OBJECT_0: case BCODE_POP_INTO_OBJECT_0:
case HCL_CODE_JUMP_FORWARD_0: case HCL_CODE_JUMP_FORWARD_0:
case HCL_CODE_JUMP_BACKWARD_0: case HCL_CODE_JUMP_BACKWARD_0:
#if 0 #if 0
@ -229,15 +308,17 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
switch (cmd) switch (cmd)
{ {
#if 0
case HCL_CODE_STORE_INTO_CTXTEMPVAR_0: case HCL_CODE_STORE_INTO_CTXTEMPVAR_0:
case HCL_CODE_POP_INTO_CTXTEMPVAR_0: /*case BCODE_POP_INTO_CTXTEMPVAR_0:*/
case HCL_CODE_PUSH_CTXTEMPVAR_0: case HCL_CODE_PUSH_CTXTEMPVAR_0:
#if 0
case HCL_CODE_PUSH_OBJVAR_0: case HCL_CODE_PUSH_OBJVAR_0:
case HCL_CODE_STORE_INTO_OBJVAR_0: case HCL_CODE_STORE_INTO_OBJVAR_0:
case HCL_CODE_POP_INTO_OBJVAR_0: case BCODE_POP_INTO_OBJVAR_0:
case HCL_CODE_SEND_MESSAGE_0: case HCL_CODE_SEND_MESSAGE_0:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_0: case HCL_CODE_SEND_MESSAGE_TO_SUPER_0:
#endif
if (param_1 < 4 && param_2 < 0xFF) if (param_1 < 4 && param_2 < 0xFF)
{ {
/* low 2 bits of the instruction code is the first parameter */ /* low 2 bits of the instruction code is the first parameter */
@ -247,10 +328,10 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
else else
{ {
/* convert the code to a long version */ /* convert the code to a long version */
bc = cmd | 0x80; bc = cmd | 0x80;
goto write_long; goto write_long;
} }
#endif
case HCL_CODE_MAKE_BLOCK: case HCL_CODE_MAKE_BLOCK:
bc = cmd; bc = cmd;
@ -469,10 +550,12 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
hcl_oop_t obj, args, arg, ptr; hcl_oop_t obj, args, arg, ptr;
hcl_oow_t nargs, ntmprs; hcl_oow_t nargs, ntmprs;
hcl_oow_t jump_inst_pos; hcl_oow_t jump_inst_pos;
hcl_oow_t saved_tv_count;
HCL_ASSERT (HCL_BRANDOF(hcl,src) == HCL_BRAND_CONS); HCL_ASSERT (HCL_BRANDOF(hcl,src) == HCL_BRAND_CONS);
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_lambda); HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_lambda);
saved_tv_count = hcl->c->tv.size;
obj = HCL_CONS_CDR(src); obj = HCL_CONS_CDR(src);
if (HCL_IS_NIL(hcl, obj)) if (HCL_IS_NIL(hcl, obj))
@ -496,6 +579,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
} }
else else
{ {
hcl_oow_t tv_dup_start;
if (HCL_BRANDOF(hcl, args) != HCL_BRAND_CONS) if (HCL_BRANDOF(hcl, args) != HCL_BRAND_CONS)
{ {
HCL_DEBUG1 (hcl, "Syntax error - not a lambda argument list - %O\n", args); HCL_DEBUG1 (hcl, "Syntax error - not a lambda argument list - %O\n", args);
@ -503,6 +587,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
return -1; return -1;
} }
tv_dup_start = hcl->c->tv.size;
nargs = 0; nargs = 0;
ptr = args; ptr = args;
do do
@ -510,12 +595,23 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
arg = HCL_CONS_CAR(ptr); arg = HCL_CONS_CAR(ptr);
if (HCL_BRANDOF(hcl, arg) != HCL_BRAND_SYMBOL) if (HCL_BRANDOF(hcl, arg) != HCL_BRAND_SYMBOL)
{ {
HCL_DEBUG1 (hcl, "Syntax error - ldamba argument not a symbol - %O\n", arg); HCL_DEBUG1 (hcl, "Syntax error - lambda argument not a symbol - %O\n", arg);
hcl_setsynerr (hcl, HCL_SYNERR_ARGNAME, HCL_NULL, HCL_NULL); /* TODO: error location */ hcl_setsynerr (hcl, HCL_SYNERR_ARGNAME, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1; return -1;
} }
/* TODO: check duplicates within only the argument list. duplicates against outer-scope are ok. /* TODO: check duplicates within only the argument list. duplicates against outer-scope are ok.
* is this check necessary? */ * is this check necessary? */
if (add_temporary_variable (hcl, arg, tv_dup_start) <= -1)
{
if (hcl->errnum == HCL_EEXIST)
{
HCL_DEBUG1 (hcl, "Syntax error - lambda argument duplicate - %O\n", arg);
hcl_setsynerr (hcl, HCL_SYNERR_ARGNAME, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
return -1;
}
nargs++; nargs++;
ptr = HCL_CONS_CDR(ptr); ptr = HCL_CONS_CDR(ptr);
@ -533,9 +629,42 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
while (1); while (1);
} }
ntmprs = nargs; ntmprs = nargs;
/* TODO: handle local temporary variables */ /* TODO: handle local temporary variables */
HCL_ASSERT (nargs == hcl->c->tv.size - saved_tv_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
* block arguments, evaluation which is done by message passing
* limits the number of arguments that can be passed. so the
* check is implemented */
HCL_DEBUG1 (hcl, "Syntax error - too many arguments - %O\n", args);
hcl_setsynerr (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL);
return -1;
}
#if 0
/* TODO: block local temporary variables... */
/* ntmprs: number of temporary variables including arguments */
HCL_ASSERT (ntmprs == hcl->c->tv.size - saved_tv_count);
if (ntmprs > MAX_CODE_NBLKTMPRS)
{
HCL_DEBUG1 (hcl, "Syntax error - too many local temporary variables - %O\n", args);
hcl_setsynerr (hcl, HCL_SYNERR_BLKTMPRFLOOD, HCL_NULL, HCL_NULL);
return -1;
}
#endif
if (hcl->c->blk.depth == HCL_TYPE_MAX(hcl_ooi_t))
{
HCL_DEBUG1 (hcl, "Syntax error - lambda block depth too deep - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_BLKDEPTH, HCL_NULL, HCL_NULL);
return -1;
}
hcl->c->blk.depth++;
if (store_temporary_variable_count_for_block (hcl, hcl->c->tv.size) <= -1) return -1;
if (emit_double_param_instruction (hcl, HCL_CODE_MAKE_BLOCK, nargs, ntmprs) <= -1) return -1; if (emit_double_param_instruction (hcl, HCL_CODE_MAKE_BLOCK, nargs, ntmprs) <= -1) return -1;
/* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to /* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to
@ -544,8 +673,9 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP) <= -1) return -1; if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP) <= -1) return -1;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, HCL_CONS_CDR(obj)); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, HCL_CONS_CDR(obj));
PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, hcl->_nil); /* operand field is not used for COP_EMIT_LAMBDA */ PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, hcl->_nil); /* operand field is not used for COP_EMIT_LAMBDA */
cf = GET_SUBCFRAME (hcl); cf = GET_SUBCFRAME (hcl); /* modify the EMIT_LAMBDA frame */
cf->u.lambda.jip = jump_inst_pos; cf->u.lambda.jip = jump_inst_pos;
cf->u.lambda.nargs = nargs; cf->u.lambda.nargs = nargs;
cf->u.lambda.ntmprs = ntmprs; cf->u.lambda.ntmprs = ntmprs;
@ -610,7 +740,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
} }
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val);
PUSH_SUBCFRAME (hcl, COP_EMIT_SET, var); PUSH_SUBCFRAME (hcl, COP_EMIT_SET, var); /* set doesn't evaluate the variable name */
cf = GET_SUBCFRAME (hcl); cf = GET_SUBCFRAME (hcl);
cf->u.set.var_type = VAR_NAMED; cf->u.set.var_type = VAR_NAMED;
@ -719,11 +849,44 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_oop_t obj)
HCL_ASSERT (HCL_BRANDOF(hcl,obj) == HCL_BRAND_SYMBOL); HCL_ASSERT (HCL_BRANDOF(hcl,obj) == HCL_BRAND_SYMBOL);
/* check if a symbol is a local variable */ /* check if a symbol is a local variable */
/*if (emit_single_param_instruction (hcl, HCL_CODE_PUSH_TEMPVAR_0, xxx) <= -1) return -1;*/ if (find_temporary_variable_backward (hcl, obj, &index) <= -1)
{
/* global variable */
if (add_literal(hcl, obj, &index) <= -1 ||
emit_single_param_instruction (hcl, HCL_CODE_PUSH_OBJECT_0, index) <= -1) return -1;
}
else
{
#if defined(HCL_USE_CTXTEMPVAR)
if (hcl->c->blk.depth >= 0)
{
hcl_oow_t i;
/* global variable */ /* if a temporary variable is accessed inside a block,
if (add_literal(hcl, obj,&index) <= -1 || * use a special instruction to indicate it */
emit_single_param_instruction (hcl, HCL_CODE_PUSH_OBJECT_0, index) <= -1) return -1; HCL_ASSERT (index < hcl->c->blk.tmprcnt[hcl->c->blk.depth]);
for (i = hcl->c->blk.depth; i > 0; i--) /* excluded the top level -- TODO: change this code depending on global variable handling */
{
if (index >= hcl->c->blk.tmprcnt[i - 1])
{
hcl_oow_t ctx_offset, index_in_ctx;
ctx_offset = hcl->c->blk.depth - i;
index_in_ctx = index - hcl->c->blk.tmprcnt[i - 1];
/* ctx_offset 0 means the current context.
* 1 means current->home.
* 2 means current->home->home.
* index_in_ctx is a relative index within the context found.
*/
if (emit_double_param_instruction(hcl, HCL_CODE_PUSH_CTXTEMPVAR_0, ctx_offset, index_in_ctx) <= -1) return -1;
return 0;
}
}
}
#endif
/* TODO: top-level... verify this. this will vary depending on how i implement the top-level and global variables... */
if (emit_single_param_instruction (hcl, HCL_CODE_PUSH_TEMPVAR_0, index) <= -1) return -1;
}
return 0; return 0;
} }
@ -832,6 +995,9 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
HCL_ASSERT (cf->opcode == COP_EMIT_LAMBDA); HCL_ASSERT (cf->opcode == COP_EMIT_LAMBDA);
HCL_ASSERT (HCL_IS_NIL(hcl, cf->operand)); HCL_ASSERT (HCL_IS_NIL(hcl, cf->operand));
hcl->c->blk.depth--;
hcl->c->tv.size = hcl->c->blk.tmprcnt[hcl->c->blk.depth];
/* 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 - cf->u.lambda.jip - (HCL_BCODE_LONG_PARAM_SIZE + 1); block_code_size = hcl->code.bc.len - cf->u.lambda.jip - (HCL_BCODE_LONG_PARAM_SIZE + 1);
@ -944,6 +1110,13 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
saved_bc_len = hcl->code.bc.len; saved_bc_len = hcl->code.bc.len;
saved_lit_len = hcl->code.lit.len; saved_lit_len = hcl->code.lit.len;
HCL_ASSERT (hcl->c->tv.size == 0);
HCL_ASSERT (hcl->c->blk.depth == -1);
/* TODO: in case i implement all global variables as block arguments at the top level... */
hcl->c->blk.depth++;
if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.size) <= -1) return -1;
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj); PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj);
while (GET_TOP_CFRAME_INDEX(hcl) >= 0) while (GET_TOP_CFRAME_INDEX(hcl) >= 0)
@ -990,6 +1163,9 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
done: done:
HCL_ASSERT (GET_TOP_CFRAME_INDEX(hcl) < 0); HCL_ASSERT (GET_TOP_CFRAME_INDEX(hcl) < 0);
HCL_ASSERT (hcl->c->tv.size == 0);
HCL_ASSERT (hcl->c->blk.depth == 0);
hcl->c->blk.depth--;
return 0; return 0;
oops: oops:
@ -999,5 +1175,7 @@ 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->tv.size = 0;
hcl->c->blk.depth = 0;
return -1; return -1;
} }

49
lib/decode.c
View File

@ -1,4 +1,3 @@
/*
/* /*
* $Id$ * $Id$
* *
@ -120,7 +119,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
/* ------------------------------------------------- */ /* ------------------------------------------------- */
case HCL_CODE_PUSH_TEMPVAR_X: case HCL_CODE_PUSH_TEMPVAR_X:
case BCODE_STORE_INTO_TEMPVAR_X: case HCL_CODE_STORE_INTO_TEMPVAR_X:
case BCODE_POP_INTO_TEMPVAR_X: case BCODE_POP_INTO_TEMPVAR_X:
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
goto handle_tempvar; goto handle_tempvar;
@ -133,14 +132,14 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
case HCL_CODE_PUSH_TEMPVAR_5: case HCL_CODE_PUSH_TEMPVAR_5:
case HCL_CODE_PUSH_TEMPVAR_6: case HCL_CODE_PUSH_TEMPVAR_6:
case HCL_CODE_PUSH_TEMPVAR_7: case HCL_CODE_PUSH_TEMPVAR_7:
case BCODE_STORE_INTO_TEMPVAR_0: case HCL_CODE_STORE_INTO_TEMPVAR_0:
case BCODE_STORE_INTO_TEMPVAR_1: case HCL_CODE_STORE_INTO_TEMPVAR_1:
case BCODE_STORE_INTO_TEMPVAR_2: case HCL_CODE_STORE_INTO_TEMPVAR_2:
case BCODE_STORE_INTO_TEMPVAR_3: case HCL_CODE_STORE_INTO_TEMPVAR_3:
case BCODE_STORE_INTO_TEMPVAR_4: case HCL_CODE_STORE_INTO_TEMPVAR_4:
case BCODE_STORE_INTO_TEMPVAR_5: case HCL_CODE_STORE_INTO_TEMPVAR_5:
case BCODE_STORE_INTO_TEMPVAR_6: case HCL_CODE_STORE_INTO_TEMPVAR_6:
case BCODE_STORE_INTO_TEMPVAR_7: case HCL_CODE_STORE_INTO_TEMPVAR_7:
case BCODE_POP_INTO_TEMPVAR_0: case BCODE_POP_INTO_TEMPVAR_0:
case BCODE_POP_INTO_TEMPVAR_1: case BCODE_POP_INTO_TEMPVAR_1:
case BCODE_POP_INTO_TEMPVAR_2: case BCODE_POP_INTO_TEMPVAR_2:
@ -203,7 +202,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
/* ------------------------------------------------- */ /* ------------------------------------------------- */
case HCL_CODE_PUSH_OBJECT_X: case HCL_CODE_PUSH_OBJECT_X:
case HCL_CODE_STORE_INTO_OBJECT_X: case HCL_CODE_STORE_INTO_OBJECT_X:
case HCL_CODE_POP_INTO_OBJECT_X: case BCODE_POP_INTO_OBJECT_X:
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
goto handle_object; goto handle_object;
@ -215,10 +214,10 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
case HCL_CODE_STORE_INTO_OBJECT_1: case HCL_CODE_STORE_INTO_OBJECT_1:
case HCL_CODE_STORE_INTO_OBJECT_2: case HCL_CODE_STORE_INTO_OBJECT_2:
case HCL_CODE_STORE_INTO_OBJECT_3: case HCL_CODE_STORE_INTO_OBJECT_3:
case HCL_CODE_POP_INTO_OBJECT_0: case BCODE_POP_INTO_OBJECT_0:
case HCL_CODE_POP_INTO_OBJECT_1: case BCODE_POP_INTO_OBJECT_1:
case HCL_CODE_POP_INTO_OBJECT_2: case BCODE_POP_INTO_OBJECT_2:
case HCL_CODE_POP_INTO_OBJECT_3: case BCODE_POP_INTO_OBJECT_3:
b1 = bcode & 0x3; /* low 2 bits */ b1 = bcode & 0x3; /* low 2 bits */
handle_object: handle_object:
if ((bcode >> 3) & 1) if ((bcode >> 3) & 1)
@ -306,20 +305,20 @@ return -1;
/* -------------------------------------------------------- */ /* -------------------------------------------------------- */
case BCODE_PUSH_CTXTEMPVAR_X: case HCL_CODE_PUSH_CTXTEMPVAR_X:
case BCODE_STORE_INTO_CTXTEMPVAR_X: case HCL_CODE_STORE_INTO_CTXTEMPVAR_X:
case BCODE_POP_INTO_CTXTEMPVAR_X: case BCODE_POP_INTO_CTXTEMPVAR_X:
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2); FETCH_PARAM_CODE_TO (hcl, b2);
goto handle_ctxtempvar; goto handle_ctxtempvar;
case BCODE_PUSH_CTXTEMPVAR_0: case HCL_CODE_PUSH_CTXTEMPVAR_0:
case BCODE_PUSH_CTXTEMPVAR_1: case HCL_CODE_PUSH_CTXTEMPVAR_1:
case BCODE_PUSH_CTXTEMPVAR_2: case HCL_CODE_PUSH_CTXTEMPVAR_2:
case BCODE_PUSH_CTXTEMPVAR_3: case HCL_CODE_PUSH_CTXTEMPVAR_3:
case BCODE_STORE_INTO_CTXTEMPVAR_0: case HCL_CODE_STORE_INTO_CTXTEMPVAR_0:
case BCODE_STORE_INTO_CTXTEMPVAR_1: case HCL_CODE_STORE_INTO_CTXTEMPVAR_1:
case BCODE_STORE_INTO_CTXTEMPVAR_2: case HCL_CODE_STORE_INTO_CTXTEMPVAR_2:
case BCODE_STORE_INTO_CTXTEMPVAR_3: case HCL_CODE_STORE_INTO_CTXTEMPVAR_3:
case BCODE_POP_INTO_CTXTEMPVAR_0: case BCODE_POP_INTO_CTXTEMPVAR_0:
case BCODE_POP_INTO_CTXTEMPVAR_1: case BCODE_POP_INTO_CTXTEMPVAR_1:
case BCODE_POP_INTO_CTXTEMPVAR_2: case BCODE_POP_INTO_CTXTEMPVAR_2:

64
lib/hcl-prv.h
View File

@ -351,6 +351,20 @@ struct hcl_compiler_t
hcl_oow_t capa; hcl_oow_t capa;
} 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
{
hcl_ooi_t depth;
hcl_oow_t* tmprcnt;
hcl_oow_t tmprcnt_capa;
} blk; /* lambda block */
}; };
#endif #endif
@ -489,15 +503,15 @@ enum hcl_bcode_t
HCL_CODE_PUSH_TEMPVAR_6 = 0x1E, HCL_CODE_PUSH_TEMPVAR_6 = 0x1E,
HCL_CODE_PUSH_TEMPVAR_7 = 0x1F, HCL_CODE_PUSH_TEMPVAR_7 = 0x1F,
BCODE_STORE_INTO_TEMPVAR_0 = 0x20, HCL_CODE_STORE_INTO_TEMPVAR_0 = 0x20,
BCODE_STORE_INTO_TEMPVAR_1 = 0x21, HCL_CODE_STORE_INTO_TEMPVAR_1 = 0x21,
BCODE_STORE_INTO_TEMPVAR_2 = 0x22, HCL_CODE_STORE_INTO_TEMPVAR_2 = 0x22,
BCODE_STORE_INTO_TEMPVAR_3 = 0x23, HCL_CODE_STORE_INTO_TEMPVAR_3 = 0x23,
BCODE_STORE_INTO_TEMPVAR_4 = 0x24, HCL_CODE_STORE_INTO_TEMPVAR_4 = 0x24,
BCODE_STORE_INTO_TEMPVAR_5 = 0x25, HCL_CODE_STORE_INTO_TEMPVAR_5 = 0x25,
BCODE_STORE_INTO_TEMPVAR_6 = 0x26, HCL_CODE_STORE_INTO_TEMPVAR_6 = 0x26,
BCODE_STORE_INTO_TEMPVAR_7 = 0x27, HCL_CODE_STORE_INTO_TEMPVAR_7 = 0x27,
BCODE_POP_INTO_TEMPVAR_0 = 0x28, BCODE_POP_INTO_TEMPVAR_0 = 0x28,
BCODE_POP_INTO_TEMPVAR_1 = 0x29, BCODE_POP_INTO_TEMPVAR_1 = 0x29,
@ -526,10 +540,10 @@ enum hcl_bcode_t
HCL_CODE_STORE_INTO_OBJECT_2 = 0x3A, HCL_CODE_STORE_INTO_OBJECT_2 = 0x3A,
HCL_CODE_STORE_INTO_OBJECT_3 = 0x3B, HCL_CODE_STORE_INTO_OBJECT_3 = 0x3B,
HCL_CODE_POP_INTO_OBJECT_0 = 0x3C, BCODE_POP_INTO_OBJECT_0 = 0x3C,
HCL_CODE_POP_INTO_OBJECT_1 = 0x3D, BCODE_POP_INTO_OBJECT_1 = 0x3D,
HCL_CODE_POP_INTO_OBJECT_2 = 0x3E, BCODE_POP_INTO_OBJECT_2 = 0x3E,
HCL_CODE_POP_INTO_OBJECT_3 = 0x3F, BCODE_POP_INTO_OBJECT_3 = 0x3F,
HCL_CODE_PUSH_OBJECT_0 = 0x40, HCL_CODE_PUSH_OBJECT_0 = 0x40,
HCL_CODE_PUSH_OBJECT_1 = 0x41, HCL_CODE_PUSH_OBJECT_1 = 0x41,
@ -561,20 +575,20 @@ enum hcl_bcode_t
HCL_CODE_CALL_2 = 0x56, /* 86 */ HCL_CODE_CALL_2 = 0x56, /* 86 */
HCL_CODE_CALL_3 = 0x57, /* 87 */ HCL_CODE_CALL_3 = 0x57, /* 87 */
BCODE_STORE_INTO_CTXTEMPVAR_0 = 0x58, /* 88 */ HCL_CODE_STORE_INTO_CTXTEMPVAR_0 = 0x58, /* 88 */
BCODE_STORE_INTO_CTXTEMPVAR_1 = 0x59, /* 89 */ HCL_CODE_STORE_INTO_CTXTEMPVAR_1 = 0x59, /* 89 */
BCODE_STORE_INTO_CTXTEMPVAR_2 = 0x5A, /* 90 */ HCL_CODE_STORE_INTO_CTXTEMPVAR_2 = 0x5A, /* 90 */
BCODE_STORE_INTO_CTXTEMPVAR_3 = 0x5B, /* 91 */ HCL_CODE_STORE_INTO_CTXTEMPVAR_3 = 0x5B, /* 91 */
BCODE_POP_INTO_CTXTEMPVAR_0 = 0x5C, /* 92 */ BCODE_POP_INTO_CTXTEMPVAR_0 = 0x5C, /* 92 */
BCODE_POP_INTO_CTXTEMPVAR_1 = 0x5D, /* 93 */ BCODE_POP_INTO_CTXTEMPVAR_1 = 0x5D, /* 93 */
BCODE_POP_INTO_CTXTEMPVAR_2 = 0x5E, /* 94 */ BCODE_POP_INTO_CTXTEMPVAR_2 = 0x5E, /* 94 */
BCODE_POP_INTO_CTXTEMPVAR_3 = 0x5F, /* 95 */ BCODE_POP_INTO_CTXTEMPVAR_3 = 0x5F, /* 95 */
BCODE_PUSH_CTXTEMPVAR_0 = 0x60, /* 96 */ HCL_CODE_PUSH_CTXTEMPVAR_0 = 0x60, /* 96 */
BCODE_PUSH_CTXTEMPVAR_1 = 0x61, /* 97 */ HCL_CODE_PUSH_CTXTEMPVAR_1 = 0x61, /* 97 */
BCODE_PUSH_CTXTEMPVAR_2 = 0x62, /* 98 */ HCL_CODE_PUSH_CTXTEMPVAR_2 = 0x62, /* 98 */
BCODE_PUSH_CTXTEMPVAR_3 = 0x63, /* 99 */ HCL_CODE_PUSH_CTXTEMPVAR_3 = 0x63, /* 99 */
BCODE_PUSH_OBJVAR_0 = 0x64, BCODE_PUSH_OBJVAR_0 = 0x64,
BCODE_PUSH_OBJVAR_1 = 0x65, BCODE_PUSH_OBJVAR_1 = 0x65,
@ -608,7 +622,7 @@ enum hcl_bcode_t
BCODE_PUSH_INSTVAR_X = 0x90, /* 144 */ BCODE_PUSH_INSTVAR_X = 0x90, /* 144 */
HCL_CODE_PUSH_TEMPVAR_X = 0x98, /* 152 */ HCL_CODE_PUSH_TEMPVAR_X = 0x98, /* 152 */
BCODE_STORE_INTO_TEMPVAR_X = 0xA0, /* 160 */ HCL_CODE_STORE_INTO_TEMPVAR_X = 0xA0, /* 160 */
BCODE_POP_INTO_TEMPVAR_X = 0xA8, /* 168 */ BCODE_POP_INTO_TEMPVAR_X = 0xA8, /* 168 */
HCL_CODE_PUSH_LITERAL_X = 0xB0, /* 176 */ HCL_CODE_PUSH_LITERAL_X = 0xB0, /* 176 */
@ -616,8 +630,8 @@ enum hcl_bcode_t
/* SEE FURTHER DOWN FOR SPECIAL CODES - 0xB2 - 0xB7 */ /* SEE FURTHER DOWN FOR SPECIAL CODES - 0xB2 - 0xB7 */
HCL_CODE_STORE_INTO_OBJECT_X = 0xB8, /* 184 */ HCL_CODE_STORE_INTO_OBJECT_X = 0xB8, /* 184 */
HCL_CODE_POP_INTO_OBJECT_X = 0xBC, /* 188 */ BCODE_POP_INTO_OBJECT_X = 0xBC, /* 188 */
HCL_CODE_PUSH_OBJECT_X = 0xC0, /* 192 */ HCL_CODE_PUSH_OBJECT_X = 0xC0, /* 192 */
HCL_CODE_JUMP_FORWARD_X = 0xC4, /* 196 */ HCL_CODE_JUMP_FORWARD_X = 0xC4, /* 196 */
@ -627,9 +641,9 @@ enum hcl_bcode_t
HCL_CODE_CALL_X = 0xD4, /* 212 */ HCL_CODE_CALL_X = 0xD4, /* 212 */
BCODE_STORE_INTO_CTXTEMPVAR_X = 0xD8, /* 216 */ HCL_CODE_STORE_INTO_CTXTEMPVAR_X = 0xD8, /* 216 */
BCODE_POP_INTO_CTXTEMPVAR_X = 0xDC, /* 220 */ BCODE_POP_INTO_CTXTEMPVAR_X = 0xDC, /* 220 */
BCODE_PUSH_CTXTEMPVAR_X = 0xE0, /* 224 */ HCL_CODE_PUSH_CTXTEMPVAR_X = 0xE0, /* 224 */
BCODE_PUSH_OBJVAR_X = 0xE4, /* 228 */ BCODE_PUSH_OBJVAR_X = 0xE4, /* 228 */
BCODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 */ BCODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 */

5
lib/hcl.h
View File

@ -52,6 +52,7 @@ enum hcl_errnum_t
HCL_EPERM, /**< operation not permitted */ HCL_EPERM, /**< operation not permitted */
HCL_ERANGE, /**< range error. overflow and underflow */ HCL_ERANGE, /**< range error. overflow and underflow */
HCL_ENOENT, /**< no matching entry */ HCL_ENOENT, /**< no matching entry */
HCL_EEXIST, /**< duplicate entry */
HCL_EDFULL, /**< dictionary full */ HCL_EDFULL, /**< dictionary full */
HCL_EPFULL, /**< processor full */ HCL_EPFULL, /**< processor full */
HCL_ESHFULL, /**< semaphore heap full */ HCL_ESHFULL, /**< semaphore heap full */
@ -90,8 +91,10 @@ enum hcl_synerrnum_t
HCL_SYNERR_ARGNAMELIST, /* argument name list expected */ HCL_SYNERR_ARGNAMELIST, /* argument name list expected */
HCL_SYNERR_ARGNAME, /* argument name expected */ HCL_SYNERR_ARGNAME, /* argument name expected */
HCL_SYNERR_BLKFLOOD, /* lambda block too big */ HCL_SYNERR_BLKFLOOD, /* lambda block too big */
HCL_SYNERR_BLKDEPTH, /* lambda block too deep */
HCL_SYNERR_VARNAME, /* variable name expected */ HCL_SYNERR_VARNAME, /* variable name expected */
HCL_SYNERR_ARGCOUNT /* wrong number of arguments */ HCL_SYNERR_ARGCOUNT, /* wrong number of arguments */
HCL_SYNERR_ARGFLOOD /* too many arguments defined */
}; };
typedef enum hcl_synerrnum_t hcl_synerrnum_t; typedef enum hcl_synerrnum_t hcl_synerrnum_t;

4
lib/main.c
View File

@ -447,8 +447,10 @@ static char* syntax_error_msg[] =
"argument name list expected", "argument name list expected",
"argument name expected", "argument name expected",
"lambda block too big", "lambda block too big",
"lambda block too deep",
"variable name expected", "variable name expected",
"wrong number of arguments" "wrong number of arguments",
"too many arguments defined"
}; };
static void print_synerr (hcl_t* hcl) static void print_synerr (hcl_t* hcl)

22
lib/read.c
View File

@ -1687,6 +1687,11 @@ static void gc_compiler (hcl_t* hcl)
{ {
hcl->c->cfs.ptr[i].operand = hcl_moveoop(hcl, hcl->c->cfs.ptr[i].operand); hcl->c->cfs.ptr[i].operand = hcl_moveoop(hcl, hcl->c->cfs.ptr[i].operand);
} }
for (i = 0; i < hcl->c->tv.size; i++)
{
hcl->c->tv.ptr[i] = hcl_moveoop (hcl, hcl->c->tv.ptr[i]);
}
} }
static void fini_compiler (hcl_t* hcl) static void fini_compiler (hcl_t* hcl)
@ -1710,6 +1715,22 @@ static void fini_compiler (hcl_t* hcl)
hcl->c->cfs.capa = 0; hcl->c->cfs.capa = 0;
} }
if (hcl->c->tv.ptr)
{
hcl_freemem (hcl, hcl->c->tv.ptr);
hcl->c->tv.ptr = HCL_NULL;
hcl->c->tv.size = 0;
hcl->c->tv.capa = 0;
}
if (hcl->c->blk.tmprcnt)
{
hcl_freemem (hcl, hcl->c->blk.tmprcnt);
hcl->c->blk.tmprcnt = HCL_NULL;
hcl->c->blk.tmprcnt_capa = 0;
hcl->c->blk.depth = -1;
}
clear_io_names (hcl); clear_io_names (hcl);
if (hcl->c->tok.name.ptr) hcl_freemem (hcl, hcl->c->tok.name.ptr); if (hcl->c->tok.name.ptr) hcl_freemem (hcl, hcl->c->tok.name.ptr);
@ -1755,6 +1776,7 @@ int hcl_attachio (hcl_t* hcl, hcl_ioimpl_t reader, hcl_ioimpl_t printer)
hcl->c->r.e = hcl->_nil; hcl->c->r.e = hcl->_nil;
hcl->c->cfs.top = -1; hcl->c->cfs.top = -1;
hcl->c->blk.depth = -1;
} }
else if (hcl->c->reader || hcl->c->printer) else if (hcl->c->reader || hcl->c->printer)
{ {