From fa1c4ac8961f8247503b9dd3a6527568ed4bfe7c Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Mon, 21 Mar 2022 15:38:31 +0000 Subject: [PATCH] added the experimental plus opcode --- lib/comp.c | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++- lib/decode.c | 6 ++++ lib/exec.c | 19 +++++++++++- lib/gc.c | 1 + lib/hcl-prv.h | 5 ++-- lib/hcl.h | 2 ++ 6 files changed, 109 insertions(+), 4 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index bb34bcf..ee7971d 100644 --- a/lib/comp.c +++ b/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; diff --git a/lib/decode.c b/lib/decode.c index 609c2c6..4b24482 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -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; diff --git a/lib/exec.c b/lib/exec.c index 337462b..de9bbcd 100644 --- a/lib/exec.c +++ b/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; diff --git a/lib/gc.c b/lib/gc.c index bfeaaf9..43559d5 100644 --- a/lib/gc.c +++ b/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) }, diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index ff697db..a8c74ff 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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 ## */ diff --git a/lib/hcl.h b/lib/hcl.h index d8e6b3a..977a64c 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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,