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

updated lambda/return/return-from-home compiling code in the new compiler

Browse Source
This commit is contained in:
hyung-hwan 2021-01-21 14:59:01 +00:00
parent 16557a970c
commit 58165aad49
6 changed files with 180 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/main.c
View File

@ -1175,7 +1175,7 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789);
#if 0 #if 1
//////////////////////////// ////////////////////////////
{ {
hcl_cnode_t* xx; hcl_cnode_t* xx;

1
lib/comp.c
View File

@ -2735,7 +2735,6 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SET); HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SET);
if (cf->u.set.var_type == VAR_NAMED) if (cf->u.set.var_type == VAR_NAMED)
{ {
hcl_oow_t index; hcl_oow_t index;

323
lib/comp2.c
View File

@ -67,14 +67,14 @@ literals -->
------------------------------ */ ------------------------------ */
static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocx_t* dst, int append, hcl_ooch_t delim_char) static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, hcl_oow_t* dstcapa, int append, hcl_ooch_t delim_char)
{ {
hcl_oow_t len, pos; hcl_oow_t len, pos;
if (append) if (append)
{ {
pos = dst->s.len; pos = dst->len;
len = dst->s.len + src->len; len = dst->len + src->len;
if (delim_char != '\0') len++; if (delim_char != '\0') len++;
} }
else else
@ -83,28 +83,28 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocx_t* dst, i
len = src->len; len = src->len;
} }
if (len >= dst->capa) if (len >= *dstcapa)
{ {
hcl_ooch_t* tmp; hcl_ooch_t* tmp;
hcl_oow_t capa; hcl_oow_t capa;
capa = HCL_ALIGN(len + 1, TV_BUFFER_ALIGN); capa = HCL_ALIGN(len + 1, TV_BUFFER_ALIGN);
tmp = (hcl_ooch_t*)hcl_reallocmem(hcl, dst->s.ptr, HCL_SIZEOF(*tmp) * capa); tmp = (hcl_ooch_t*)hcl_reallocmem(hcl, dst->ptr, HCL_SIZEOF(*tmp) * capa);
if (HCL_UNLIKELY(!tmp)) return -1; if (HCL_UNLIKELY(!tmp)) return -1;
dst->s.ptr = tmp; dst->ptr = tmp;
dst->capa = capa - 1; *dstcapa = capa - 1;
} }
if (append && delim_char != '\0') dst->s.ptr[pos++] = delim_char; if (append && delim_char != '\0') dst->ptr[pos++] = delim_char;
hcl_copy_oochars (&dst->s.ptr[pos], src->ptr, src->len); hcl_copy_oochars (&dst->ptr[pos], src->ptr, src->len);
dst->s.ptr[len] = '\0'; dst->ptr[len] = '\0';
dst->s.len = len; dst->len = len;
return 0; return 0;
} }
static int find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* name, int last, hcl_oow_t* xindex) static int __find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* name, int last, hcl_oow_t* xindex)
{ {
/* this function is inefficient. but considering the typical number /* this function is inefficient. but considering the typical number
* of arguments and temporary variables, the inefficiency can be * of arguments and temporary variables, the inefficiency can be
@ -138,7 +138,7 @@ static int find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* na
else else
{ {
if (xindex) *xindex = index; if (xindex) *xindex = index;
return 0; return 0; /* found */
} }
} }
@ -159,77 +159,37 @@ static int find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* na
if (found != HCL_TYPE_MAX(hcl_oow_t)) if (found != HCL_TYPE_MAX(hcl_oow_t))
{ {
if (xindex) *xindex = found; if (xindex) *xindex = found;
return 0; return 0; /* foudn */
} }
return -1; return -1; /* not found */
} }
static int add_temporary_variable (hcl_t* hcl, const hcl_oocs_t* name, hcl_oow_t dup_check_start) static int add_temporary_variable (hcl_t* hcl, const hcl_oocs_t* name, hcl_oow_t dup_check_start)
{ {
#if 0 hcl_oocs_t s;
hcl_oow_t i; int x;
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, name)); s.ptr = hcl->c->tv2.s.ptr + dup_check_start;
s.len = hcl->c->tv2.s.len - dup_check_start;
for (i = dup_check_start; i < hcl->c->tv.size; i++) if (__find_word_in_string(&s, name, 0, HCL_NULL) >= 0)
{
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
if (hcl->c->tv.ptr[i] == name)
{ {
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, ' ');
if (HCL_LIKELY(x >= 0)) hcl->c->tv2.wcount++;
if (hcl->c->tv.size >= hcl->c->tv.capa) return x;
{
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_oop_t*)hcl_reallocmem(hcl, hcl->c->tv.ptr, newcapa);
if (HCL_UNLIKELY(!tmp)) return -1;
hcl->c->tv.capa = newcapa;
hcl->c->tv.ptr = tmp;
}
hcl->c->tv.ptr[hcl->c->tv.size++] = name;
return 0;
#else
/* TODO: dupcheck??? */
return copy_string_to(hcl, name, &hcl->c->tv2, 1, ' ');
#endif
} }
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)
{ {
#if 0
hcl_oow_t i;
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, name));
for (i = hcl->c->tv.size; i > 0; )
{
--i;
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
if (hcl->c->tv.ptr[i] == name)
{
*index = i;
return 0;
}
}
hcl_seterrnum (hcl, HCL_ENOENT);
return -1;
#else
/* 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->tv2.s, name, 1, index);
#endif
} }
static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, 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)
{ {
HCL_ASSERT (hcl, hcl->c->blk.depth >= 0); HCL_ASSERT (hcl, hcl->c->blk.depth >= 0);
@ -238,7 +198,7 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_
hcl_blk_info_t* tmp; hcl_blk_info_t* tmp;
hcl_oow_t newcapa; hcl_oow_t newcapa;
newcapa = HCL_ALIGN (hcl->c->blk.depth + 1, BLK_INFO_BUFFER_ALIGN); newcapa = HCL_ALIGN(hcl->c->blk.depth + 1, BLK_INFO_BUFFER_ALIGN);
tmp = (hcl_blk_info_t*)hcl_reallocmem(hcl, hcl->c->blk.info, newcapa * HCL_SIZEOF(*tmp)); tmp = (hcl_blk_info_t*)hcl_reallocmem(hcl, hcl->c->blk.info, newcapa * HCL_SIZEOF(*tmp));
if (!tmp) return -1; if (!tmp) return -1;
@ -246,6 +206,7 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_
hcl->c->blk.info = tmp; hcl->c->blk.info = tmp;
} }
hcl->c->blk.info[hcl->c->blk.depth].tmprlen = tmpr_len;
hcl->c->blk.info[hcl->c->blk.depth].tmprcnt = tmpr_count; hcl->c->blk.info[hcl->c->blk.depth].tmprcnt = tmpr_count;
hcl->c->blk.info[hcl->c->blk.depth].lfbase = lfbase; hcl->c->blk.info[hcl->c->blk.depth].lfbase = lfbase;
return 0; return 0;
@ -1025,191 +986,194 @@ static int compile_if (hcl_t* hcl, hcl_oop_t src)
*/ */
return 0; return 0;
} }
#endif
static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun) static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
{ {
hcl_oop_t obj, args; hcl_cnode_t* obj, * args;
hcl_oow_t nargs, ntmprs; hcl_oow_t nargs, ntmprs;
hcl_ooi_t jump_inst_pos, lfbase_pos, lfsize_pos; hcl_ooi_t jump_inst_pos, lfbase_pos, lfsize_pos;
hcl_oow_t saved_tv_count, tv_dup_start; hcl_oow_t saved_tv_wcount, tv_dup_start;
hcl_oop_t defun_name; hcl_cnode_t* defun_name;
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src)); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
saved_tv_count = hcl->c->tv.size; saved_tv_wcount = hcl->c->tv2.wcount;
obj = HCL_CONS_CDR(src); obj = HCL_CNODE_CONS_CDR(src);
if (defun) if (defun)
{ {
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_defun); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DEFUN));
if (HCL_IS_NIL(hcl, obj)) if (!obj)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(src), HCL_NULL, "no defun name");
"no defun name - %O", src); /* TODO: error location */
return -1; return -1;
} }
else if (!HCL_IS_CONS(hcl, obj)) else if (!HCL_CNODE_IS_CONS(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in defun");
"redundant cdr in defun - %O", src); /* TODO: error location */
return -1; return -1;
} }
defun_name = HCL_CONS_CAR(obj); defun_name = HCL_CNODE_CONS_CAR(obj);
if (!HCL_IS_SYMBOL(hcl, defun_name)) if (!HCL_CNODE_IS_SYMBOL(defun_name))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(defun_name), HCL_CNODE_GET_TOK(defun_name), "defun name not a symbol");
"defun name not a symbol - %O", defun_name); /* TODO: error location */
return -1; return -1;
} }
if (HCL_OBJ_GET_FLAGS_SYNCODE(defun_name) || HCL_OBJ_GET_FLAGS_KERNEL(defun_name) >= 1) if (HCL_CNODE_SYMBOL_SYNCODE(defun_name)) /*|| HCL_OBJ_GET_FLAGS_KERNEL(defun_name) >= 1) */
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(defun_name), HCL_CNODE_GET_TOK(defun_name), "special symbol not to be used as a variable name");
"special symbol not to be used as a defun name - %O", defun_name); /* TOOD: error location */
return -1; return -1;
} }
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
} }
else else
{ {
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_lambda); HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_lambda);
} }
if (HCL_IS_NIL(hcl, obj)) if (!obj)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(src), HCL_NULL, "no argument list in lambda");
"no argument list in lambda - %O", src); /* TODO: error location */
return -1; return -1;
} }
else if (!HCL_IS_CONS(hcl, obj)) else if (!HCL_CNODE_IS_CONS(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in lambda");
"redundant cdr in lambda - %O", src); /* TODO: error location */
return -1; return -1;
} }
args = HCL_CONS_CAR(obj); args = HCL_CNODE_CONS_CAR(obj);
if (HCL_IS_NIL(hcl, args)) if (!args)
{ {
/* no argument - (lambda () (+ 10 20)) */ /* no argument - (lambda () (+ 10 20)) */
nargs = 0; nargs = 0;
} }
else else
{ {
hcl_oop_t arg, ptr; hcl_cnode_t* arg, * dcl;
if (!HCL_IS_CONS(hcl, args)) if (!HCL_CNODE_IS_CONS(args))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "not a lambda argument list");
"not a lambda argument list - %O", args); /* TODO: error location */
return -1; return -1;
} }
tv_dup_start = hcl->c->tv.size; tv_dup_start = hcl->c->tv2.s.len;
nargs = 0; nargs = 0;
ptr = args; dcl = args;
do do
{ {
arg = HCL_CONS_CAR(ptr); arg = HCL_CNODE_CONS_CAR(dcl);
if (!HCL_IS_SYMBOL(hcl, arg)) if (!HCL_CNODE_IS_SYMBOL(arg))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "lambda argument not a symbol");
"lambda argument not a symbol - %O", arg); /* TODO: error location */
return -1; return -1;
} }
if (HCL_OBJ_GET_FLAGS_SYNCODE(arg) || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2) if (HCL_CNODE_IS_SYMBOL(arg) && HCL_CNODE_SYMBOL_SYNCODE(arg) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "special symbol not to be declared as an argument");
"special symbol not to be declared as an argument - %O", arg); /* TOOD: error location */
return -1; return -1;
} }
if (add_temporary_variable(hcl, arg, tv_dup_start) <= -1) if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1)
{ {
if (hcl->errnum == HCL_EEXIST) if (hcl->errnum == HCL_EEXIST)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "lambda argument duplicate");
"lambda argument duplicate - %O", arg); /* TODO: error location */
} }
return -1; return -1;
} }
nargs++; nargs++;
ptr = HCL_CONS_CDR(ptr); dcl = HCL_CNODE_CONS_CDR(dcl);
if (!HCL_IS_CONS(hcl, ptr)) if (!dcl) break;
if (!HCL_CNODE_IS_CONS(dcl))
{ {
if (!HCL_IS_NIL(hcl, ptr)) hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(dcl), HCL_CNODE_GET_TOK(dcl), "redundant cdr in lambda argument list");
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in lambda argument list - %O", args); /* TODO: error location */
return -1; return -1;
} }
break;
}
} }
while (1); while (1);
} }
HCL_ASSERT (hcl, nargs == hcl->c->tv.size - saved_tv_count); HCL_ASSERT (hcl, nargs == hcl->c->tv2.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
* block arguments, evaluation which is done by message passing * block arguments, evaluation which is done by message passing
* limits the number of arguments that can be passed. so the * limits the number of arguments that can be passed. so the
* check is implemented */ * check is implemented */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zu) arguments - %O", nargs, args); hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) arguments", nargs);
return -1; return -1;
} }
ntmprs = nargs; ntmprs = nargs;
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
tv_dup_start = hcl->c->tv.size; tv_dup_start = hcl->c->tv2.s.len;
while (HCL_IS_CONS(hcl, obj)) while (obj && HCL_CNODE_IS_CONS(obj))
{ {
hcl_oop_t dcl; hcl_cnode_t* dcl;
dcl = HCL_CONS_CAR(obj); dcl = HCL_CNODE_CONS_CAR(obj);
if (HCL_IS_SYMBOL_ARRAY(hcl, dcl)) if (HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST))
{ {
hcl_oow_t i, sz; hcl_cnode_t* var;
do
sz = HCL_OBJ_GET_SIZE(dcl);
for (i = 0; i < sz; i++)
{ {
if (HCL_OBJ_GET_FLAGS_SYNCODE(((hcl_oop_oop_t)dcl)->slot[i]) || var = HCL_CNODE_CONS_CAR(dcl);
HCL_OBJ_GET_FLAGS_KERNEL(((hcl_oop_oop_t)dcl)->slot[i]) >= 2) #if 0
if (!HCL_CNODE_IS_SYMBOL(var))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "local variable not a symbol");
"special symbol not to be declared as a variable - %O", obj); /* TOOD: error location */
return -1; return -1;
} }
if (add_temporary_variable(hcl, ((hcl_oop_oop_t)dcl)->slot[i], tv_dup_start) <= -1) if (HCL_CNODE_IS_SYMBOL(var) && HCL_CNODE_SYMBOL_SYNCODE(var) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2 */)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "special symbol not to be declared as a local variable");
return -1;
}
#else
/* the above checks are not needed as the reader guarantees the followings */
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(var) && !HCL_CNODE_SYMBOL_SYNCODE(var));
#endif
if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(var), tv_dup_start) <= -1)
{ {
if (hcl->errnum == HCL_EEXIST) if (hcl->errnum == HCL_EEXIST)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAMEDUP, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "duplicate local variable");
"local variable duplicate - %O", ((hcl_oop_oop_t)dcl)->slot[i]); /* TODO: error location */
} }
return -1; return -1;
} }
ntmprs++; ntmprs++;
}
obj = HCL_CONS_CDR(obj); dcl = HCL_CNODE_CONS_CDR(dcl);
if (!dcl) break;
if (!HCL_CNODE_IS_CONS(dcl))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(dcl), HCL_CNODE_GET_TOK(dcl), "redundant cdr in local variable list");
return -1;
}
}
while (1);
obj = HCL_CNODE_CONS_CDR(obj);
} }
else break; else break;
} }
/* ntmprs: number of temporary variables including arguments */ /* ntmprs: number of temporary variables including arguments */
HCL_ASSERT (hcl, ntmprs == hcl->c->tv.size - saved_tv_count); HCL_ASSERT (hcl, ntmprs == hcl->c->tv2.wcount - saved_tv_wcount);
if (ntmprs > MAX_CODE_NBLKTMPRS) if (ntmprs > MAX_CODE_NBLKTMPRS)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_NULL, HCL_NULL, "too many(%zu) variables - %O", ntmprs, args); hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_NULL, HCL_NULL, "too many(%zu) variables - %O", ntmprs, args);
@ -1222,7 +1186,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_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->tv.size, hcl->code.lit.len) <= -1) return -1; 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 (hcl->option.trait & HCL_TRAIT_INTERACTIVE) if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
@ -1252,7 +1216,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
hcl_oow_t index; hcl_oow_t index;
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
if (find_temporary_variable_backward(hcl, defun_name, &index) <= -1) 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 */ PUSH_SUBCFRAME (hcl, COP_EMIT_SET, defun_name); /* set doesn't evaluate the variable name */
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
@ -1282,35 +1246,37 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
return 0; return 0;
} }
static int compile_return (hcl_t* hcl, hcl_oop_t src, int mode) static int compile_return (hcl_t* hcl, hcl_cnode_t* src, int mode)
{ {
hcl_oop_t obj, val; hcl_cnode_t* obj, * val;
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src)); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_return || HCL_CONS_CAR(src) == hcl->_return_from_home); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) || HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN_FROM_HOME));
obj = HCL_CONS_CDR(src); obj = HCL_CNODE_CONS_CDR(src);
/* TODO: error message - cater for return-from home */ if (!obj)
if (HCL_IS_NIL(hcl, obj))
{ {
/* TODO: should i allow (return)? does it return the last value on the stack? */ /* TODO: should i allow (return)? does it return the last value on the stack? */
/* no value */ /* no value */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, "no value specified in return - %O", src); /* TODO: error location */ hcl_cnode_t* tmp = HCL_CNODE_CONS_CAR(src);
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no value specified in %.*js", HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp));
return -1; return -1;
} }
else if (!HCL_IS_CONS(hcl, obj)) else if (!HCL_CNODE_IS_CONS(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, "redundant cdr in return - %O", src); /* TODO: error location */ hcl_cnode_t* tmp = HCL_CNODE_CONS_CAR(src);
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp));
return -1; return -1;
} }
val = HCL_CONS_CAR(obj); val = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
if (!HCL_IS_NIL(hcl, obj)) if (obj)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, "more than 1 argument to return - %O", src); /* TODO: error location */ hcl_cnode_t* tmp = HCL_CNODE_CONS_CAR(src);
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "more than 1 argument to %.*js", HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp));
return -1; return -1;
} }
@ -1321,6 +1287,7 @@ static int compile_return (hcl_t* hcl, hcl_oop_t src, int mode)
return 0; return 0;
} }
#if 0
static int compile_set (hcl_t* hcl, hcl_oop_t src) static int compile_set (hcl_t* hcl, hcl_oop_t src)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
@ -1632,11 +1599,11 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
if (compile_break(hcl, obj) <= -1) return -1; if (compile_break(hcl, obj) <= -1) return -1;
break; break;
#if 0
case HCL_SYNCODE_DEFUN: case HCL_SYNCODE_DEFUN:
if (compile_lambda(hcl, obj, 1) <= -1) return -1; if (compile_lambda(hcl, obj, 1) <= -1) return -1;
break; break;
#if 0
case HCL_SYNCODE_DO: case HCL_SYNCODE_DO:
if (compile_do(hcl, obj) <= -1) return -1; if (compile_do(hcl, obj) <= -1) return -1;
break; break;
@ -1668,6 +1635,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
* (set x (lambda (x y) (+ x y)) */ * (set x (lambda (x y) (+ x y)) */
if (compile_set(hcl, obj) <= -1) return -1; if (compile_set(hcl, obj) <= -1) return -1;
break; break;
#endif
case HCL_SYNCODE_RETURN: case HCL_SYNCODE_RETURN:
/* (return 10) /* (return 10)
@ -1675,10 +1643,12 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
if (compile_return(hcl, obj, 0) <= -1) return -1; if (compile_return(hcl, obj, 0) <= -1) return -1;
break; break;
case HCL_SYNCODE_RETURN_FROM_HOME: case HCL_SYNCODE_RETURN_FROM_HOME:
if (compile_return(hcl, obj, 1) <= -1) return -1; if (compile_return(hcl, obj, 1) <= -1) return -1;
break; break;
#if 0
case HCL_SYNCODE_UNTIL: case HCL_SYNCODE_UNTIL:
if (compile_while(hcl, obj, COP_POST_UNTIL_COND) <= -1) return -1; if (compile_while(hcl, obj, COP_POST_UNTIL_COND) <= -1) return -1;
break; break;
@ -1786,10 +1756,9 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(obj)); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(obj));
if (hcl_getsyncodebyoocs_noseterr(hcl, HCL_CNODE_GET_TOK(obj)) > 0) if (HCL_CNODE_SYMBOL_SYNCODE(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(obj), HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "special symbol not to be used as a variable name - %.*js");
"special symbol not to be used as a variable name - %.*js", HCL_CNODE_GET_TOKLEN(obj), HCL_CNODE_GET_TOKPTR(obj));
return -1; return -1;
} }
@ -2950,7 +2919,8 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
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->blk.depth--;
hcl->c->tv.size = hcl->c->blk.info[hcl->c->blk.depth].tmprcnt; 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_HCL_CODE_LONG_PARAM_SIZE + 1); block_code_size = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1);
@ -2988,7 +2958,7 @@ static HCL_INLINE int emit_pop_stacktop (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_STACKTOP); HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_STACKTOP);
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, cf->operand)); HCL_ASSERT (hcl, cf->operand == HCL_NULL);
n = emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL); n = emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL);
@ -3021,15 +2991,17 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
if (cf->u.set.var_type == VAR_NAMED) if (cf->u.set.var_type == VAR_NAMED)
{ {
hcl_oow_t index; hcl_oow_t index;
hcl_oop_t cons; hcl_oop_t cons, sym;
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(cf->operand)); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(cf->operand));
/* TODO: make a symbol now */
cons = (hcl_oop_t)hcl_getatsysdic(hcl, cf->operand); sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(cf->operand), HCL_CNODE_GET_TOKLEN(cf->operand));
if (HCL_UNLIKELY(!sym)) return -1;
cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym);
if (!cons) if (!cons)
{ {
cons = (hcl_oop_t)hcl_putatsysdic(hcl, cf->operand, hcl->_nil); cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_nil);
if (!cons) return -1; if (!cons) return -1;
} }
@ -3065,7 +3037,8 @@ int hcl_compile2 (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->tv.size == 0); HCL_ASSERT (hcl, hcl->c->tv2.s.len == 0);
HCL_ASSERT (hcl, hcl->c->tv2.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? */
@ -3102,7 +3075,7 @@ int hcl_compile2 (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->tv.size, 0) <= -1) return -1; if (store_temporary_variable_count_for_block(hcl, hcl->c->tv2.wcount, hcl->c->tv2.s.len, 0) <= -1) return -1;
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj); PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj);
@ -3253,7 +3226,8 @@ int hcl_compile2 (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->tv.size == 0); HCL_ASSERT (hcl, hcl->c->tv2.s.len == 0);
HCL_ASSERT (hcl, hcl->c->tv2.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--;
@ -3269,7 +3243,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->tv.size = 0; hcl->c->tv2.s.len = 0;
hcl->c->tv2.wcount = 0;
hcl->c->blk.depth = -1; hcl->c->blk.depth = -1;
return -1; return -1;
} }

16
lib/hcl-prv.h
View File

@ -349,6 +349,7 @@ typedef struct hcl_cframe2_t hcl_cframe2_t;
struct hcl_blk_info_t struct hcl_blk_info_t
{ {
hcl_oow_t tmprlen;
hcl_oow_t tmprcnt; hcl_oow_t tmprcnt;
hcl_oow_t lfbase; hcl_oow_t lfbase;
}; };
@ -365,14 +366,6 @@ struct hcl_rstl_t /* reader stack for list reading */
hcl_rstl_t* prev; hcl_rstl_t* prev;
}; };
typedef struct hcl_oocx_t hcl_oocx_t;
struct hcl_oocx_t
{
hcl_oocs_t s;
hcl_oow_t capa;
};
struct hcl_compiler_t struct hcl_compiler_t
{ {
/* output handler */ /* output handler */
@ -455,7 +448,12 @@ struct hcl_compiler_t
hcl_oow_t capa; hcl_oow_t capa;
} tv; /* temporary variables including arguments */ } tv; /* temporary variables including arguments */
hcl_oocx_t tv2; struct
{
hcl_oocs_t s; /* buffer */
hcl_oow_t capa; /* bufer capacity */
hcl_oow_t wcount; /* word count */
} tv2;
struct struct
{ {

11
lib/read.c
View File

@ -2272,6 +2272,17 @@ static void fini_compiler (hcl_t* hcl)
hcl->c->tv.capa = 0; hcl->c->tv.capa = 0;
} }
if (hcl->c->tv2.s.ptr)
{
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)
{ {
hcl_freemem (hcl, hcl->c->blk.info); hcl_freemem (hcl, hcl->c->blk.info);

9
lib/read2.c
View File

@ -2127,6 +2127,15 @@ static void fini_compiler (hcl_t* hcl)
hcl->c->tv.capa = 0; hcl->c->tv.capa = 0;
} }
if (hcl->c->tv2.ptr)
{
hcl_freemem (hcl, hcl->c->tv2.ptr);
hcl->c->tv2.ptr = HCL_NULL;
hcl->c->tv2.len = 0;
hcl->c->tv2.capa = 0;
hcl->c->tv2.wcount = 0;
}
if (hcl->c->blk.info) if (hcl->c->blk.info)
{ {
hcl_freemem (hcl, hcl->c->blk.info); hcl_freemem (hcl, hcl->c->blk.info);