added the experimental plus opcode
This commit is contained in:
parent
63c9adf3fc
commit
fa1c4ac896
80
lib/comp.c
80
lib/comp.c
@ -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;
|
||||
|
@ -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;
|
||||
|
19
lib/exec.c
19
lib/exec.c
@ -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;
|
||||
|
1
lib/gc.c
1
lib/gc.c
@ -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) },
|
||||
|
@ -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 ## */
|
||||
|
@ -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,
|
||||
|
Loading…
Reference in New Issue
Block a user