added the experimental plus opcode

This commit is contained in:
hyung-hwan 2022-03-21 15:38:31 +00:00
parent 63c9adf3fc
commit fa1c4ac896
6 changed files with 109 additions and 4 deletions

View File

@ -1307,6 +1307,7 @@ enum
COP_EMIT_POP_INTO_CONS_CDR,
COP_EMIT_LAMBDA,
COP_EMIT_PLUS,
COP_EMIT_POP_STACKTOP,
COP_EMIT_RETURN,
COP_EMIT_SET,
@ -1521,6 +1522,75 @@ static HCL_INLINE int compile_or_p2 (hcl_t* hcl)
/* ========================================================================= */
/* EXPERIMENT WITH BINOP */
static int compile_plus (hcl_t* hcl, hcl_cnode_t* src)
{
hcl_cnode_t* obj, * expr;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_PLUS));
obj = HCL_CNODE_CONS_CDR(src);
if (!obj)
{
/* no value */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in plus");
return -1;
}
else if (!HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in plus");
return -1;
}
expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
if (!obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no second expression specified in plus");
return -1;
}
else if (!HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in plus");
return -1;
}
expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CNODE_CONS_CDR(obj);
if (obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in plus");
return -1;
}
/* TODO: more check on obj */
PUSH_SUBCFRAME (hcl, COP_EMIT_PLUS, src); /* 3 */
PUSH_SUBCFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 2 */
return 0;
}
static HCL_INLINE int emit_plus (hcl_t* hcl)
{
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_PLUS);
if (emit_byte_instruction(hcl, HCL_CODE_PLUS, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
POP_CFRAME (hcl);
return 0;
}
/* ========================================================================= */
static int compile_break (hcl_t* hcl, hcl_cnode_t* src)
{
/* (break) */
@ -1924,11 +1994,11 @@ static int collect_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t** nextobj,
hcl_oow_t ndcls = 0;
hcl_cnode_t* dcl;
hcl_cnode_t* var;
dcl = HCL_CNODE_CONS_CAR(obj);
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST));
hcl_cnode_t* var;
do
{
var = HCL_CNODE_CONS_CAR(dcl);
@ -3398,6 +3468,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
if (compile_or(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_PLUS:
if (compile_plus(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_SET:
/* (set x 10)
* (set x (lambda (x y) (+ x y)) */
@ -5304,6 +5378,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
if (emit_lambda(hcl) <= -1) goto oops;
break;
case COP_EMIT_PLUS:
if (emit_plus(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_STACKTOP:
if (emit_pop_stacktop(hcl) <= -1) goto oops;
break;

View File

@ -81,6 +81,12 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
switch (bcode)
{
/* -------------------------------------------------------- */
case HCL_CODE_PLUS:
LOG_INST_0 (hcl, "plus");
break;
/* -------------------------------------------------------- */
case HCL_CODE_PUSH_IVAR_X:
FETCH_PARAM_CODE_TO (hcl, b1);
goto push_ivar;

View File

@ -3312,8 +3312,25 @@ static int execute (hcl_t* hcl)
switch (bcode)
{
/* ------------------------------------------------- */
/* -------------------------------------------------------- */
case HCL_CODE_PLUS:
{
/* TODO: support other binary arithmetic operators */
hcl_oop_t x1, x2, x3;
LOG_INST_0 (hcl, "plus");
x2 = HCL_STACK_GETTOP(hcl); HCL_STACK_POP (hcl);
x1 = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
x3 = hcl_addnums(hcl, x1, x2);
if (HCL_UNLIKELY(!x3))
{
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
goto oops_with_errmsg_supplement;
}
HCL_STACK_PUSH(hcl, x3);
break;
}
/* ------------------------------------------------- */
case HCL_CODE_PUSH_IVAR_X:
FETCH_PARAM_CODE_TO (hcl, b1);
goto push_ivar;

View File

@ -51,6 +51,7 @@ static struct
{ 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) },
{ 2, { 'o','r' }, HCL_SYNCODE_OR, HCL_OFFSETOF(hcl_t,_or) },
{ 4, { 'p','l','u','s' }, HCL_SYNCODE_PLUS, HCL_OFFSETOF(hcl_t,_plus) },
{ 6, { 'r','e','t','u','r','n'}, HCL_SYNCODE_RETURN, HCL_OFFSETOF(hcl_t,_return) },
{ 16, { 'r','e','t','u','r','n','-','f','r','o','m','-','h','o','m','e'},
HCL_SYNCODE_RETURN_FROM_HOME, HCL_OFFSETOF(hcl_t,_return_from_home) },

View File

@ -873,7 +873,7 @@ enum hcl_bcode_t
HCL_CODE_PUSH_FALSE = 0x84, /* 132 */
HCL_CODE_PUSH_CONTEXT = 0x85, /* 133 */
HCL_CODE_PUSH_PROCESS = 0x86, /* 134 */
/* UNUSED 135 */
/* UNUSED 0x87 */
HCL_CODE_POP_INTO_IVAR_X = 0x88, /* 136 ## */
@ -894,7 +894,8 @@ enum hcl_bcode_t
HCL_CODE_PUSH_NEGINTLIT = 0xB3, /* 179 */
HCL_CODE_PUSH_CHARLIT = 0xB4, /* 180 */
/* UNUSED - 0xB5 - 0xB7 */
HCL_CODE_PLUS = 0xB5, /* 181 TOOD: move it to a lower code number later after killing OBJVAR instructions */
/* UNUSED - 0xB6 - 0xB7 */
HCL_CODE_STORE_INTO_OBJECT_X = 0xB8, /* 184 ## */
HCL_CODE_POP_INTO_OBJECT_X = 0xBC, /* 188 ## */

View File

@ -1543,6 +1543,7 @@ struct hcl_t
hcl_oop_t _if; /* symbol */
hcl_oop_t _lambda; /* symbol */
hcl_oop_t _or; /* symbol */
hcl_oop_t _plus; /* symbol */
hcl_oop_t _return; /* symbol */
hcl_oop_t _return_from_home; /* symbol */
hcl_oop_t _set; /* symbol */
@ -1847,6 +1848,7 @@ enum hcl_syncode_t
HCL_SYNCODE_IF,
HCL_SYNCODE_LAMBDA,
HCL_SYNCODE_OR,
HCL_SYNCODE_PLUS,
HCL_SYNCODE_RETURN,
HCL_SYNCODE_RETURN_FROM_HOME,
HCL_SYNCODE_SET,