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

updated compiler to prohibit redefinition of a named class
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan
2024-07-22 17:24:26 +09:00
parent 2d120f0d0e
commit 28c05ff903
3 changed files with 76 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
lib/comp.c
View File

@ -2588,9 +2588,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
return -1;
}
//SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, tmp); /* 1 - superclass expression */
nsuperclasses = 1;
obj = HCL_CNODE_CONS_CDR(obj);
}
else
@ -2599,24 +2597,45 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
superclass = HCL_NULL;
}
if (class_name)
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 1 - push the class name for a named class */
else
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, &hcl->c->fake_cnode.nil); /* 1 - push nil for class name for anonymous class */
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 - use class name for assignment */
cf = GET_SUBCFRAME(hcl);
if (class_name)
{
//SWITCH_TOP_CFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 1 - push the class name for a named class */
hcl_oow_t index;
hcl_oop_t cons, sym;
sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(class_name), HCL_CNODE_GET_TOKLEN(class_name));
if (HCL_UNLIKELY(!sym)) return -1;
cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym);
if (!cons)
{
cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_nil);
if (HCL_UNLIKELY(!cons)) return -1;
}
if (add_literal(hcl, cons, &index) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_PUSH_LITERAL_0, index, HCL_CNODE_GET_LOC(class_name)) <= -1) return -1;
}
else
{
if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL,HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; /* push nil for class name of an anonymous class */
}
POP_CFRAME (hcl);
PUSH_CFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 - use class name for assignment */
cf = GET_TOP_CFRAME(hcl);
cf->u._class.nsuperclasses = 0; /* unsed for CLASS_P2 */
cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
cf->u._class.cmd_cnode = cmd;
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 - variables declaraions and actual body */
cf = GET_SUBCFRAME(hcl);
PUSH_CFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 - variables declaraions and actual body */
cf = GET_TOP_CFRAME(hcl);
cf->u._class.nsuperclasses = nsuperclasses; /* this needs to change if we support multiple superclasses... */
cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
cf->u._class.cmd_cnode = cmd;
if (superclass) PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, superclass); /* 0 - superclass expression */
if (superclass) PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, superclass); /* 1 - superclass expression */
return 0;
}

32
lib/exec.c
View File

@ -3550,10 +3550,19 @@ static int execute (hcl_t* hcl)
/*ass = hcl->code.lit.arr->slot[b1];*/
ass = (hcl_oop_cons_t)hcl->active_function->literal_frame[b1];
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, ass));
/* this association is an entry in the system dictionary.
* it doesn't need to look up the dictionary for each access
* as the pointer to the association is in the literal frame */
if ((bcode >> 3) & 1)
{
/* store or pop */
if (HCL_IS_CLASS(hcl, ass->cdr) && ((hcl_oop_class_t)ass->cdr)->name == ass->car)
{
hcl_seterrbfmt (hcl, HCL_EPERM, "prohibited redefintion of %.*js", HCL_OBJ_GET_SIZE(ass->car), HCL_OBJ_GET_CHAR_SLOT(ass->car));
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
goto oops_with_errmsg_supplement;
}
ass->cdr = HCL_STACK_GETTOP(hcl);
if ((bcode >> 2) & 1)
@ -3857,13 +3866,13 @@ static int execute (hcl_t* hcl)
case HCL_CODE_CLASS_ENTER:
{
/* push superclass
push class_name
/* push an association with class_name as a key or push nil
push superclass (only if nsuperclassses > 0)
push ivars_string
push cvars_string
class_enter nsuperclasses nivars ncvars
*/
hcl_oop_t t, superclass, ivars_str, cvars_str, class_name;
hcl_oop_t t, superclass, ivars_str, cvars_str, class_name, class_name_ass;
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */
@ -3886,9 +3895,6 @@ static int execute (hcl_t* hcl)
}
else ivars_str = hcl->_nil;
HCL_STACK_POP_TO(hcl, class_name);
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name) || HCL_IS_SYMBOL(hcl, class_name));
if (b1 > 0)
{
HCL_STACK_POP_TO (hcl, superclass); /* TODO: support more than 1 superclass later when the compiler supports more */
@ -3901,14 +3907,25 @@ static int execute (hcl_t* hcl)
}
else superclass = hcl->_nil;
HCL_STACK_POP_TO(hcl, class_name_ass);
/*HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name) || HCL_IS_SYMBOL(hcl, class_name));*/
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name_ass) || HCL_IS_CONS(hcl, class_name_ass));
//////////////
//hcl_logbfmt(hcl, HCL_LOG_STDERR, "class_name in class_enter 111>>>[%O]<<<\n", class_name);
if (HCL_IS_SYMBOL(hcl, class_name))
if (HCL_IS_CONS(hcl, class_name_ass))
{
//hcl_logbfmt(hcl, HCL_LOG_STDERR, "class_name in class_enter >>>[%O]<<<\n", class_name);
/* TODO: check if the class exists.
* check if the class is a incomlete kernel class.
* if so, .... */
class_name = ((hcl_oop_cons_t)(class_name_ass))->car;
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, class_name));
}
else
{
/* anonymous class */
class_name = hcl->_nil;
}
//////////////
@ -4089,7 +4106,6 @@ static int execute (hcl_t* hcl)
if ((bcode >> 3) & 1)
{
/* store or pop */
t->slot[b1] = HCL_STACK_GETTOP(hcl);
if ((bcode >> 2) & 1)