added 'class_push_exit'
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:
parent
a24f591074
commit
3d4e161a5f
34
lib/comp.c
34
lib/comp.c
@ -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;
|
||||
|
@ -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++)
|
||||
|
@ -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
17
lib/exec.c
@ -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;
|
||||
}
|
||||
/* -------------------------------------------------------- */
|
||||
|
@ -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;
|
||||
|
||||
@ -902,8 +903,8 @@ 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_EXIT = 0xE2, /* 226 */
|
||||
HCL_CODE_CLASS_PUSH_EXIT = 0xE3, /* 227 */
|
||||
|
||||
HCL_CODE_PUSH_OBJVAR_X = 0xE4, /* 228 ## */
|
||||
/* UNUSED - 0xE5 - 0xE7 */
|
||||
|
Loading…
Reference in New Issue
Block a user