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

added 'class_push_exit'

Browse Source 
enhanced the compiler to produce 'pop_stacktop' at the end of the class if the class body is not empty
This commit is contained in:
hyung-hwan 2021-12-24 00:05:58 +00:00
parent a24f591074
commit 3d4e161a5f
5 changed files with 42 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lib/comp.c
View File

@ -757,7 +757,7 @@ static HCL_INLINE void patch_double_long_params_with_oow (hcl_t* hcl, hcl_ooi_t
static int emit_variable_access (hcl_t* hcl, int mode, const hcl_var_info_t* vi, const hcl_ioloc_t* srcloc)
{
static hcl_oob_t inst_map[2][3] =
static hcl_oob_t inst_map[][3] =
{
{ HCL_CODE_PUSH_CTXTEMPVAR_0, HCL_CODE_POP_INTO_CTXTEMPVAR_0, HCL_CODE_STORE_INTO_CTXTEMPVAR_0 },
{ HCL_CODE_PUSH_INSTVAR_0, HCL_CODE_POP_INTO_INSTVAR_0, HCL_CODE_STORE_INTO_INSTVAR_0 },
@ -858,15 +858,15 @@ static int push_clsblk (hcl_t* hcl, const hcl_ioloc_t* errloc, hcl_oow_t nivars,
ci->nivars = nivars;
ci->ncvars = ncvars;
if (ivars_str)
if (nivars > 0)
{
HCL_ASSERT (hcl, ci->nivars > 0);
HCL_ASSERT (hcl, ivars_str != HCL_NULL);
ci->ivars_str = hcl_dupoocstr(hcl, ivars_str, HCL_NULL);
if (HCL_UNLIKELY(!ci->ivars_str)) return -1;
}
if (cvars_str)
if (ncvars > 0)
{
HCL_ASSERT (hcl, ci->ncvars > 0);
HCL_ASSERT (hcl, cvars_str != HCL_NULL);
ci->cvars_str = hcl_dupoocstr(hcl, cvars_str, HCL_NULL);
if (HCL_UNLIKELY(!ci->cvars_str))
{
@ -1488,7 +1488,7 @@ inside_loop:
* function call, i generate PUSH_NIL so nil becomes a return value.
* (set x (until #f (break)))
* x will get nill. */
if (emit_byte_instruction (hcl, HCL_CODE_PUSH_NIL, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
/* TODO: study if supporting expression after break is good like return. (break (+ 10 20)) */
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
@ -2056,7 +2056,12 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl)
if (emit_long_param(hcl, nivars) <= -1) goto oops;
if (emit_long_param(hcl, ncvars) <= -1) goto oops;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */
/* remember the first byte code position to be emitted for the body of
* this class. this posistion is used for empty class body check at the
* end of the class before 'class_exit' is generated */
hcl->c->clsblk.info[hcl->c->clsblk.depth].class_start_inst_pos = hcl->code.bc.len;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
return 0;
@ -2077,7 +2082,7 @@ static HCL_INLINE int compile_class_p3 (hcl_t* hcl)
/* TODO: emit instruction to store into the class name...? */
/* TODO: NEED TO EMIT POP_STACKTOP???? IN THIS CASE CLASS_EXIT MUST PUSH SOMETHING? */
if (emit_byte_instruction(hcl, HCL_CODE_CLASS_EXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
printf ("end of CLASS DEFINITION\n");
POP_CFRAME (hcl);
return 0;
}
@ -2090,10 +2095,16 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_CLASS_P2);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
if (hcl->code.bc.len > hcl->c->clsblk.info[hcl->c->clsblk.depth].class_start_inst_pos)
{
/* no instructions generated after the class_enter instruction */
if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
}
pop_clsblk (hcl); /* end of the class block */
if (emit_byte_instruction(hcl, HCL_CODE_CLASS_EXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
printf ("end of CLASS DEFINITION\n");
if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PUSH_EXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
// if (cf->operand)
{
@ -2863,7 +2874,7 @@ static HCL_INLINE int post_catch (hcl_t* hcl)
static int compile_throw (hcl_t* hcl, hcl_cnode_t* src)
{
hcl_cnode_t* obj, * val;
hcl_cframe_t* cf;
/*hcl_cframe_t* cf;*/
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_THROW));
@ -4631,7 +4642,6 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
break;
case COP_COMPILE_AND_P1:
if (compile_and_p1(hcl) <= -1) goto oops;
break;

2
lib/debug.c
View File

@ -32,7 +32,7 @@ void hcl_dumpsymtab (hcl_t* hcl)
hcl_oop_char_t symbol;
HCL_DEBUG0 (hcl, "--------------------------------------------\n");
HCL_DEBUG1 (hcl, "Stix Symbol Table %zu\n", HCL_OBJ_GET_SIZE(hcl->symtab->bucket));
HCL_DEBUG1 (hcl, "HCL Symbol Table %zu\n", HCL_OBJ_GET_SIZE(hcl->symtab->bucket));
HCL_DEBUG0 (hcl, "--------------------------------------------\n");
for (i = 0; i < HCL_OBJ_GET_SIZE(hcl->symtab->bucket); i++)

4
lib/decode.c
View File

@ -381,6 +381,10 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
case HCL_CODE_CLASS_EXIT:
LOG_INST_0 (hcl, "class_exit");
break;
case HCL_CODE_CLASS_PUSH_EXIT:
LOG_INST_0 (hcl, "class_push_exit");
break;
/* -------------------------------------------------------- */
case HCL_CODE_PUSH_CTXTEMPVAR_X:

17
lib/exec.c
View File

@ -3367,16 +3367,21 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
case HCL_CODE_CLASS_EXIT:
{
hcl_oop_t c;
LOG_INST_0 (hcl, "class_exit");
/* TODO: stack underflow check? */
#if 0
HCL_CLSTACK_POP (hcl);
break;
}
case HCL_CODE_CLASS_PUSH_EXIT:
{
hcl_oop_t c;
LOG_INST_0 (hcl, "class_push_exit");
/* TODO: stack underflow check? */
HCL_CLSTACK_POP_TO (hcl, c);
HCL_STACK_PUSH (hcl, c);
#else
HCL_CLSTACK_POP (hcl);
#endif
break;
}
/* -------------------------------------------------------- */

3
lib/hcl-prv.h
View File

@ -454,6 +454,7 @@ struct hcl_clsblk_info_t
hcl_oow_t spec; /* TODO: byte indexed, word indexed? */
hcl_ooi_t fnblk_base;
hcl_ooi_t class_start_inst_pos; /* the position of the first instruction in the class body after CLASS_ENTER */
};
typedef struct hcl_clsblk_info_t hcl_clsblk_info_t;
@ -903,7 +904,7 @@ enum hcl_bcode_t
HCL_CODE_PUSH_CTXTEMPVAR_X = 0xE0, /* 224 ## */
HCL_CODE_CLASS_ENTER = 0xE1, /* 225 ## */
HCL_CODE_CLASS_EXIT = 0xE2, /* 226 */
/* UNUSED - 0xE3 */
HCL_CODE_CLASS_PUSH_EXIT = 0xE3, /* 227 */
HCL_CODE_PUSH_OBJVAR_X = 0xE4, /* 228 ## */
/* UNUSED - 0xE5 - 0xE7 */