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

in the course of adding break

Browse Source
This commit is contained in:
hyung-hwan 2016-10-12 09:54:07 +00:00
parent c2216421b7
commit 1f16bc2d11
4 changed files with 144 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
lib/comp.c
View File

@ -448,19 +448,15 @@ static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj)
}
/* ========================================================================= */
static int push_cframe (hcl_t* hcl, int opcode, hcl_oop_t operand)
static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, hcl_oop_t operand)
{
hcl_cframe_t* tmp;
if (hcl->c->cfs.top == HCL_TYPE_MAX(hcl_ooi_t))
{
hcl->errnum = HCL_ETOOBIG;
return -1;
}
HCL_ASSERT (index >= 0);
hcl->c->cfs.top++;
HCL_ASSERT (hcl->c->cfs.top >= 0);
HCL_ASSERT (index <= hcl->c->cfs.top);
if ((hcl_oow_t)hcl->c->cfs.top >= hcl->c->cfs.capa)
{
@ -478,13 +474,40 @@ static int push_cframe (hcl_t* hcl, int opcode, hcl_oop_t operand)
hcl->c->cfs.ptr = tmp;
}
tmp = &hcl->c->cfs.ptr[hcl->c->cfs.top];
if (index < hcl->c->cfs.top)
{
HCL_MEMMOVE (&hcl->c->cfs.ptr[index + 1], &hcl->c->cfs.ptr[index], (hcl->c->cfs.top - index) * HCL_SIZEOF(*tmp));
}
tmp = &hcl->c->cfs.ptr[index];
tmp->opcode = opcode;
tmp->operand = operand;
/* leave tmp->u untouched/uninitialized */
return 0;
}
static int insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, hcl_oop_t operand)
{
if (hcl->c->cfs.top == HCL_TYPE_MAX(hcl_ooi_t))
{
hcl->errnum = HCL_ETOOBIG;
return -1;
}
return _insert_cframe (hcl, index, opcode, operand);
}
static int push_cframe (hcl_t* hcl, int opcode, hcl_oop_t operand)
{
if (hcl->c->cfs.top == HCL_TYPE_MAX(hcl_ooi_t))
{
hcl->errnum = HCL_ETOOBIG;
return -1;
}
return _insert_cframe (hcl, hcl->c->cfs.top + 1, opcode, operand);
}
static HCL_INLINE void pop_cframe (hcl_t* hcl)
{
HCL_ASSERT (hcl->c->cfs.top >= 0);
@ -494,6 +517,9 @@ static HCL_INLINE void pop_cframe (hcl_t* hcl)
#define PUSH_CFRAME(hcl,opcode,operand) \
do { if (push_cframe(hcl,opcode,operand) <= -1) return -1; } while(0)
#define INSERT_CFRAME(hcl,index,opcode,operand) \
do { if (insert_cframe(hcl,index,opcode,operand) <= -1) return -1; } while(0)
#define POP_CFRAME(hcl) pop_cframe(hcl)
#define POP_ALL_CFRAMES(hcl) (hcl->c->cfs.top = -1)
@ -550,11 +576,61 @@ enum
COP_POST_UNTIL_BODY,
COP_POST_UNTIL_COND,
COP_POST_WHILE_BODY,
COP_POST_WHILE_COND
COP_POST_WHILE_COND,
COP_UPDATE_BREAK,
};
/* ========================================================================= */
static int compile_break (hcl_t* hcl, hcl_oop_t src)
{
hcl_oop_t obj;
hcl_ooi_t i;
HCL_ASSERT (HCL_BRANDOF(hcl,src) == HCL_BRAND_CONS);
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_break);
obj = HCL_CONS_CDR(src);
if (!HCL_IS_NIL(hcl,obj))
{
if (HCL_IS_CONS(hcl,obj))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant argument in break - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
}
else
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in break - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
return -1;
}
for (i = hcl->c->cfs.top; i >= 0; --i)
{
const hcl_cframe_t* tcf;
tcf = &hcl->c->cfs.ptr[i];
if (tcf->opcode == COP_POST_UNTIL_BODY || tcf->opcode == COP_POST_WHILE_BODY)
{
hcl_oow_t jump_inst_pos;
jump_inst_pos = hcl->code.bc.len;
HCL_ASSERT (jump_inst_pos < HCL_SMOOI_MAX);
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP) <= -1) return -1;
INSERT_CFRAME (hcl, i, COP_UPDATE_BREAK, HCL_SMOOI_TO_OOP(jump_inst_pos));
POP_CFRAME (hcl);
return 0;
}
}
HCL_DEBUG1 (hcl, "Syntax error - break outside loop - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_BREAK, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
static int compile_if (hcl_t* hcl, hcl_oop_t src)
{
/* TODO: NOT IMPLEMENTED */
@ -580,7 +656,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
hcl_setsynerr (hcl, HCL_SYNERR_ARGNAMELIST, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
else if (HCL_BRANDOF(hcl, obj) != HCL_BRAND_CONS)
else if (!HCL_IS_CONS(hcl, obj))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in lambda - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
@ -597,7 +673,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
{
hcl_oop_t arg, ptr;
if (HCL_BRANDOF(hcl, args) != HCL_BRAND_CONS)
if (!HCL_IS_CONS(hcl, args))
{
HCL_DEBUG1 (hcl, "Syntax error - not a lambda argument list - %O\n", args);
hcl_setsynerr (hcl, HCL_SYNERR_ARGNAMELIST, HCL_NULL, HCL_NULL); /* TODO: error location */
@ -610,7 +686,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
do
{
arg = HCL_CONS_CAR(ptr);
if (HCL_BRANDOF(hcl, arg) != HCL_BRAND_SYMBOL)
if (!HCL_IS_SYMBOL(hcl, 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 */
@ -631,7 +707,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
nargs++;
ptr = HCL_CONS_CDR(ptr);
if (HCL_BRANDOF(hcl, ptr) != HCL_BRAND_CONS)
if (!HCL_IS_CONS(hcl, ptr))
{
if (!HCL_IS_NIL(hcl, ptr))
{
@ -905,7 +981,17 @@ static int compile_cons_expression (hcl_t* hcl, hcl_oop_t obj)
switch (syncode)
{
case HCL_SYNCODE_BEGIN:
HCL_DEBUG0 (hcl, "BEGIN NOT IMPLEMENTED...\n");
/* TODO: not implemented yet */
break;
case HCL_SYNCODE_BREAK:
/* break */
if (compile_break (hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_DEFUN:
HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
/* TODO: not implemented yet */
break;
@ -949,7 +1035,7 @@ static int compile_cons_expression (hcl_t* hcl, hcl_oop_t obj)
/* normal function call
* (<operator> <operand1> ...) */
hcl_ooi_t nargs;
hcl_oow_t oldtop;
hcl_ooi_t oldtop;
hcl_cframe_t* cf;
hcl_oop_t cdr;
@ -1136,7 +1222,7 @@ static int compile_object_list (hcl_t* hcl)
hcl_oop_t car, cdr;
int cop;
if (HCL_BRANDOF(hcl, cf->operand) != HCL_BRAND_CONS)
if (!HCL_IS_CONS(hcl, cf->operand))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in the object list - %O\n", cf->operand);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
@ -1150,7 +1236,9 @@ static int compile_object_list (hcl_t* hcl)
if (!HCL_IS_NIL(hcl, cdr))
{
/* (+ 1 2 3) - argument list. 1, 2, 3 pushed must remain in
/* there is a next statement to compile
*
* (+ 1 2 3) - argument list. 1, 2, 3 pushed must remain in
* the stack until the function '+' is called.
*
* (lambda (x y) (+ x 10) (+ y 20))
@ -1161,7 +1249,23 @@ static int compile_object_list (hcl_t* hcl)
if (cop == COP_COMPILE_OBJECT_LIST)
{
/* let's arrange to emit POP before generating code for the rest of the list */
PUSH_SUBCFRAME (hcl, COP_EMIT_POP, hcl->_nil);
hcl_oop_t tmp;
/* look ahead for some special functions */
tmp = HCL_CONS_CAR(cdr);
if (!HCL_IS_CONS(hcl, tmp))
{
/* this check is duplicate of the check at the beginning
* of this function. if not for look-ahead, this block
* could be removed */
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in the object list - %O\n", cf->operand);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
if (HCL_CONS_CAR(tmp) != hcl->_break) /* TODO: other special forms??? */
PUSH_SUBCFRAME (hcl, COP_EMIT_POP, hcl->_nil);
}
}
}
@ -1255,6 +1359,14 @@ patch_instruction (hcl, jip + 2, jump_offset & 0xFF);
/* ========================================================================= */
static int update_break (hcl_t* hcl)
{
HCL_DEBUG0 (hcl, "TOOD: update break...\n");
return -1;
}
/* ========================================================================= */
static HCL_INLINE int emit_call (hcl_t* hcl)
{
hcl_cframe_t* cf;
@ -1348,7 +1460,6 @@ static HCL_INLINE int emit_pop (hcl_t* hcl)
return n;
}
static HCL_INLINE int emit_return (hcl_t* hcl)
{
hcl_cframe_t* cf;
@ -1471,6 +1582,10 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
if (post_while_cond (hcl) <= -1) goto oops;
break;
case COP_UPDATE_BREAK:
if (update_break (hcl) <= -1) goto oops;
break;
default:
HCL_DEBUG1 (hcl, "Internal error - invalid compiler opcode %d\n", cf->opcode);
hcl->errnum = HCL_EINTERN;

1
lib/gc.c
View File

@ -35,6 +35,7 @@ static struct
} syminfo[] =
{
{ 5, { 'b','e','g','i','n' }, HCL_SYNCODE_BEGIN, HCL_OFFSETOF(hcl_t,_begin) },
{ 5, { 'b','r','e','a','k' }, HCL_SYNCODE_BREAK, HCL_OFFSETOF(hcl_t,_break) },
{ 5, { 'd','e','f','u','n' }, HCL_SYNCODE_DEFUN, HCL_OFFSETOF(hcl_t,_defun) },
{ 2, { 'i','f' }, HCL_SYNCODE_IF, HCL_OFFSETOF(hcl_t,_if) },
{ 6, { 'l','a','m','b','d','a' }, HCL_SYNCODE_LAMBDA, HCL_OFFSETOF(hcl_t,_lambda) },

6
lib/hcl.h
View File

@ -104,7 +104,9 @@ enum hcl_synerrnum_t
HCL_SYNERR_ARGFLOOD, /* too many arguments defined */
HCL_SYNERR_VARFLOOD, /* too many variables defined */
HCL_SYNERR_VARDCLBANNED, /* variable declaration disallowed */
HCL_SYNERR_VARNAMEDUP /* duplicate variable name */
HCL_SYNERR_VARNAMEDUP, /* duplicate variable name */
HCL_SYNERR_BREAK /* break outside loop */
};
typedef enum hcl_synerrnum_t hcl_synerrnum_t;
@ -833,6 +835,7 @@ struct hcl_t
hcl_oop_t _false;
hcl_oop_t _begin; /* symbol */
hcl_oop_t _break; /* symbol */
hcl_oop_t _defun; /* symbol */
hcl_oop_t _if; /* symbol */
hcl_oop_t _lambda; /* symbol */
@ -1020,6 +1023,7 @@ enum
{
/* SYNCODE 0 means it's not a syncode object. so it begins with 1 */
HCL_SYNCODE_BEGIN = 1,
HCL_SYNCODE_BREAK,
HCL_SYNCODE_DEFUN,
HCL_SYNCODE_IF,
HCL_SYNCODE_LAMBDA,

4
lib/main.c
View File

@ -595,7 +595,9 @@ static char* syntax_error_msg[] =
"too many arguments defined",
"too many variables defined",
"variable declaration disallowed",
"duplicate variable name"
"duplicate variable name",
"break outside loop"
};
static void print_synerr (hcl_t* hcl)