diff --git a/lib/comp.c b/lib/comp.c index 7de3b7c..7904cc7 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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); diff --git a/lib/decode.c b/lib/decode.c index a326bcf..dd97ab9 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -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; diff --git a/lib/exec.c b/lib/exec.c index 69aaa5e..021c79a 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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; diff --git a/lib/gc.c b/lib/gc.c index 98ba4e8..0629070 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -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) diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 5a4066d..c767868 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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 */