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

fixed initialization of hcl->nil_process

Browse Source 
got rid of HCL_CODE_MAKE_CLASS and merged its feature to HCL_CODE_CLASS_ENTER
This commit is contained in:
hyung-hwan
2021-06-25 16:07:29 +00:00
parent 2033072791
commit e74a4efd29
5 changed files with 69 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
hcl/lib/comp.c
View File

@ -1974,13 +1974,11 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl)
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(obj)); /* must not get CDR. the reader must ensure this */
printf ("VLIST....\n");
vars = HCL_CNODE_CONS_CAR(obj);
if (!HCL_CNODE_IS_CONS_CONCODED(vars, HCL_CONCODE_VLIST)) break;
// TODO increment nivars and ncvars
// also remember actual variable names...
printf ("22222222222\n");
obj = HCL_CNODE_CONS_CDR(obj);
}
@ -2005,21 +2003,17 @@ printf ("22222222222\n");
if (push_clsblk(hcl, &cf->u._class.start_loc, nivars, ncvars) <= -1) return -1;
/* make_class nsuperclasses, nivars, ncvars - this will use the pushed literal */
if (emit_byte_instruction(hcl, HCL_CODE_MAKE_CLASS, &cf->u._class.start_loc) <= -1) return -1;
/* class_enter nsuperclasses, nivars, ncvars */
if (emit_byte_instruction(hcl, HCL_CODE_CLASS_ENTER, &cf->u._class.start_loc) <= -1) return -1;
if (emit_long_param(hcl, cf->u._class.nsuperclasses) <= -1) return -1;
if (emit_long_param(hcl, nivars) <= -1) return -1;
if (emit_long_param(hcl, ncvars) <= -1) return -1;
if (emit_byte_instruction(hcl, HCL_CODE_CLASS_ENTER, &cf->u._class.start_loc) <= -1) return -1; // TODO: do i need this separater instruction?
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */
return 0;
}
static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
{
hcl_cframe_t* cf;
@ -2068,6 +2062,8 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
#else
/* should i make the assignment in POST? or after variable declarations immediately? */
/* 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);

25
hcl/lib/decode.c
View File

@ -378,9 +378,17 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
break;
/* -------------------------------------------------------- */
case HCL_CODE_CLASS_ENTER:
LOG_INST_0 (hcl, "class_enter");
break;
{
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
FETCH_PARAM_CODE_TO (hcl, b3);
LOG_INST_3 (hcl, "class_enter %zu %zu %zu", b1, b2, b3);
break;
}
case HCL_CODE_CLASS_EXIT:
LOG_INST_0 (hcl, "class_exit");
break;
@ -602,19 +610,6 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
break;
/* -------------------------------------------------------- */
case HCL_CODE_MAKE_CLASS:
{
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
FETCH_PARAM_CODE_TO (hcl, b3);
LOG_INST_3 (hcl, "make_class %zu %zu %zu", b1, b2, b3);
break;
}
/* -------------------------------------------------------- */
case HCL_CODE_DUP_STACKTOP:
LOG_INST_0 (hcl, "dup_stacktop");
break;

94
hcl/lib/exec.c
View File

@ -513,7 +513,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
stksize = hcl->option.dfl_procstk_size; /* stack */
exstksize = 128; /* exception stack size */ /* TODO: make it configurable */
clstksize = 64; /* class stack size */ /* TODO: make it configurable too */
maxsize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 3;
if (stksize > maxsize) stksize = maxsize;
@ -3306,22 +3306,58 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
if (do_throw(hcl, return_value, fetched_instruction_pointer) <= -1) goto oops;
break;
/* -------------------------------------------------------- */
case HCL_CODE_CLASS_ENTER:
{
/* push superclass
push ivars
push cvars
class_enter nsuperclasses nivars ncvars
*/
hcl_oop_t t, sc, nivars, ncvars;
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */
FETCH_PARAM_CODE_TO (hcl, b2); /* nivars */
FETCH_PARAM_CODE_TO (hcl, b3); /* ncvars */
LOG_INST_3 (hcl, "class_enter %zu %zu %zu", b1, b2, b3);
/* TODO: get extra information from the stack according to b1, b2, b3*/
/* critical error if the superclass is not a class ...
* critical error if ivars is not a string...
* critical errro if cvars is not a string ....
*/
t = hcl_makeclass(hcl, hcl->_nil, b2, b3); // TOOD: pass variable information...
if (HCL_UNLIKELY(!t))
{
supplement_errmsg (hcl, fetched_instruction_pointer);
goto oops;
}
HCL_CLSTACK_PUSH (hcl, t); /* push the class created to the class stack*/
break;
}
/*case HCL_CODE_MAKE_METHOD:
{
}*/
case HCL_CODE_CLASS_EXIT:
{
hcl_oop_t c;
/* the class_enter instruct must follow the class_make instruction... */
LOG_INST_0 (hcl, "class_enter");
c = HCL_STACK_GETTOP(hcl); /* the class object created with make_class */
HCL_CLSTACK_PUSH (hcl, c);
break;
}
case HCL_CODE_CLASS_EXIT:
LOG_INST_0 (hcl, "class_exit");
/* TODO: stack underflow check? */
#if 0
HCL_CLSTACK_POP_TO (hcl, c);
HCL_STACK_PUSH (hcl, c);
#else
HCL_CLSTACK_POP (hcl);
#endif
break;
}
/* -------------------------------------------------------- */
case HCL_CODE_PUSH_CTXTEMPVAR_X:
@ -3788,46 +3824,6 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
}
/* -------------------------------------------------------- */
case HCL_CODE_MAKE_CLASS:
{
/* push superclass
push ivars
push cvars
make_classs
*/
hcl_oop_t t, sc, nivars, ncvars;
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */
FETCH_PARAM_CODE_TO (hcl, b2); /* nivars */
FETCH_PARAM_CODE_TO (hcl, b3); /* ncvars */
LOG_INST_3 (hcl, "make_class %zu %zu %zu", b1, b2, b3);
/* TODO: get extra information from the stack according to b1, b2, b3*/
/* critical error if the superclass is not a class ...
* critical error if ivars is not a string...
* critical errro if cvars is not a string ....
*/
t = hcl_makeclass(hcl, hcl->_nil, b2, b3); // TOOD: pass variable information...
if (HCL_UNLIKELY(!t))
{
supplement_errmsg (hcl, fetched_instruction_pointer);
goto oops;
}
HCL_STACK_PUSH (hcl, t); /* push the class created */
break;
}
/*case HCL_CODE_MAKE_METHOD:
{
}*/
/* -------------------------------------------------------- */
case HCL_CODE_DUP_STACKTOP:
{
hcl_oop_t t;

9
hcl/lib/gc.c
View File

@ -813,7 +813,16 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
* only accessible by VM. not exported via the global dictionary. */
hcl->nil_process = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS);
if (HCL_UNLIKELY(!hcl->nil_process)) return -1;
/* unusable stack */
hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->st = HCL_SMOOI_TO_OOP(-1);
/* unusable exception stack */
hcl->nil_process->exsp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->exst = HCL_SMOOI_TO_OOP(-1);
/* unusable class stack */
hcl->nil_process->clsp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->clst = HCL_SMOOI_TO_OOP(-1);
}
if (!hcl->processor)

2
hcl/lib/hcl-prv.h
View File

@ -912,7 +912,7 @@ enum hcl_bcode_t
HCL_CODE_POP_INTO_CONS_CDR = 0xF5, /* 245 */
/* -------------------------------------- */
HCL_CODE_MAKE_CLASS = 0xF6, /* 246 ## ## */
/* UNUSED - 0xF6 */
HCL_CODE_DUP_STACKTOP = 0xF7, /* 247 */
HCL_CODE_POP_STACKTOP = 0xF8, /* 248 */
HCL_CODE_RETURN_STACKTOP = 0xF9, /* 249 */