From 2fbb2eda6c868135e36df8089b9fa7aa9f70f9d9 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 25 Jun 2021 15:19:11 +0000 Subject: [PATCH] wrote more code to support classes --- lib/comp.c | 321 ++++++++++++++++++++++++++++++++++++++++++-------- lib/decode.c | 10 +- lib/exec.c | 129 +++++++++++++------- lib/gc.c | 34 ++++-- lib/hcl-prv.h | 8 +- lib/hcl.h | 13 +- 6 files changed, 403 insertions(+), 112 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index abf968d..7de3b7c 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -389,7 +389,6 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1 case HCL_CODE_PUSH_NEGINTLIT: case HCL_CODE_PUSH_CHARLIT: - case HCL_CODE_MAKE_DIC: /* TODO: don't these need write_long2? */ case HCL_CODE_MAKE_ARRAY: case HCL_CODE_MAKE_BYTEARRAY: @@ -1057,11 +1056,20 @@ enum COP_COMPILE_DIC_LIST, COP_COMPILE_QLIST, /* compile data list */ - COP_COMPILE_AND_EXPR, - COP_COMPILE_OR_EXPR, COP_COMPILE_ELIF, COP_COMPILE_ELSE, COP_COMPILE_CATCH, + + COP_COMPILE_AND_P1, + COP_COMPILE_AND_P2, + + COP_COMPILE_BREAK_P1, + + COP_COMPILE_OR_P1, + COP_COMPILE_OR_P2, + + COP_COMPILE_CLASS_P1, + COP_COMPILE_CLASS_P2, COP_EMIT_CALL, @@ -1094,11 +1102,7 @@ enum COP_POST_CATCH, COP_POST_LAMBDA, - COP_POST_CLASS, - COP_POST_AND_EXPR, - COP_POST_OR_EXPR, - COP_POST_BREAK }; /* ========================================================================= */ @@ -1129,20 +1133,20 @@ static int compile_and (hcl_t* hcl, hcl_cnode_t* src) obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ - if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_EXPR, obj); /* 2 */ + if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P1, obj); /* 2 */ return 0; } -static HCL_INLINE int compile_and_expr (hcl_t* hcl) +static HCL_INLINE int compile_and_p1 (hcl_t* hcl) { hcl_cnode_t* obj, * expr; hcl_cframe_t* cf; hcl_ooi_t jump_inst_pos; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_EXPR); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_P1); HCL_ASSERT (hcl, cf->operand != HCL_NULL); /* TODO: optimization - eat away all true expressions */ @@ -1156,37 +1160,38 @@ static HCL_INLINE int compile_and_expr (hcl_t* hcl) HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); jump_inst_pos = hcl->code.bc.len; + /* this conditional jump make evaluation short-circuited. the actual jump point is to be patched in compile_and_p2() */ if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; expr = HCL_CNODE_CONS_CAR(obj); obj = HCL_CNODE_CONS_CDR(obj); - SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 - compile the current part */ - PUSH_SUBCFRAME (hcl, COP_POST_AND_EXPR, expr); /* 3 */ + PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P2, expr); /* 3 - patch the conditional jump instruction */ cf = GET_SUBCFRAME(hcl); cf->u.post_and.jump_inst_pos = jump_inst_pos; - if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_EXPR, obj); /* 2 */ - + if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P1, obj); /* 2 - recurse to compile remaining parts */ return 0; } -static HCL_INLINE int post_and_expr (hcl_t* hcl) +static HCL_INLINE int compile_and_p2 (hcl_t* hcl) { hcl_cframe_t* cf; hcl_ooi_t jip; hcl_oow_t jump_offset; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_POST_AND_EXPR); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_P2); HCL_ASSERT (hcl, cf->operand != HCL_NULL); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); jip = cf->u.post_and.jump_inst_pos; - /* patch the jump insruction emitted after each expression inside the 'and' expression */ + /* patch the jump insruction emitted after each expression inside the 'and' expression + * the jump make evaluation short-circuited. */ jump_offset = hcl->code.bc.len - jip - (HCL_CODE_LONG_PARAM_SIZE + 1); patch_long_jump (hcl, jip, jump_offset); @@ -1222,20 +1227,20 @@ static int compile_or (hcl_t* hcl, hcl_cnode_t* src) obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ - PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_EXPR, obj); /* 2 */ + PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_P1, obj); /* 2 */ return 0; } -static HCL_INLINE int compile_or_expr (hcl_t* hcl) +static HCL_INLINE int compile_or_p1 (hcl_t* hcl) { hcl_cnode_t* obj, * expr; hcl_cframe_t* cf; hcl_ooi_t jump_inst_pos; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_EXPR); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_P1); HCL_ASSERT (hcl, cf->operand != HCL_NULL); /* TODO: optimization - eat away all false expressions */ @@ -1250,6 +1255,7 @@ static HCL_INLINE int compile_or_expr (hcl_t* hcl) HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); jump_inst_pos = hcl->code.bc.len; + /* this conditional jump makes evaluation short-circuited. the actual jump point is to be patched in compile_or_p2() */ if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_TRUE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; @@ -1258,23 +1264,23 @@ static HCL_INLINE int compile_or_expr (hcl_t* hcl) SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ - PUSH_SUBCFRAME (hcl, COP_POST_OR_EXPR, expr); /* 3 */ + PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_P2, expr); /* 3 */ cf = GET_SUBCFRAME(hcl); cf->u.post_or.jump_inst_pos = jump_inst_pos; - if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_EXPR, obj); /* 2 */ + if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_P1, obj); /* 2 */ return 0; } -static HCL_INLINE int post_or_expr (hcl_t* hcl) +static HCL_INLINE int compile_or_p2 (hcl_t* hcl) { hcl_cframe_t* cf; hcl_ooi_t jip; hcl_oow_t jump_offset; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_POST_OR_EXPR); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_P2); HCL_ASSERT (hcl, cf->operand != HCL_NULL); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); @@ -1359,7 +1365,7 @@ inside_loop: jump_inst_pos = hcl->code.bc.len; if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; - INSERT_CFRAME (hcl, i, COP_POST_BREAK, cmd); + INSERT_CFRAME (hcl, i, COP_COMPILE_BREAK_P1, cmd); cf = GET_CFRAME(hcl, i); cf->u._break.jump_inst_pos = jump_inst_pos; @@ -1374,13 +1380,13 @@ inside_loop: return -1; } -static int post_break (hcl_t* hcl) +static int compile_break_p1 (hcl_t* hcl) { hcl_cframe_t* cf; hcl_ooi_t jip, jump_offset; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_POST_BREAK); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_BREAK_P1); HCL_ASSERT (hcl, cf->operand != HCL_NULL); jip = cf->u._break.jump_inst_pos;; @@ -1702,6 +1708,7 @@ static int check_if_plain_cnode (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t* prev return 0; } +#if 0 static int compile_class (hcl_t* hcl, hcl_cnode_t* src) { /* @@ -1733,6 +1740,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src) */ hcl_cnode_t* cmd, * obj, * tmp; hcl_cnode_t* class_name, * superclass_name; + hcl_ooi_t nsuperclasses, nivars, ncvars; cmd = HCL_CNODE_CONS_CAR(src); obj = HCL_CNODE_CONS_CDR(src); @@ -1758,11 +1766,30 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src) if (obj) { /* superclass */ + + + + tmp = HCL_CNODE_CONS_CAR(obj); if (HCL_CNODE_IS_TRPCOLONS(tmp)) { obj = HCL_CNODE_CONS_CDR(obj); +/* TODO: this can actually be dynamic. so it doesn't have to be a symbol name, + * even an expression is possible ... + * (defclass A + * ... + * ) + * (defun get-your-class() A) + * (defclass B ::: (get-your-class) + * .... + * ) + * + * this code is wrong... + */ + + +#if 0 /* TODO: multiple subclasses? interfaces? */ if (check_if_plain_cnode(hcl, obj, tmp, cmd, HCL_SYNERR_VARNAME, "superclass name") <= -1) return -1; superclass_name = HCL_CNODE_CONS_CAR(obj); @@ -1780,10 +1807,31 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src) hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(superclass_name), HCL_CNODE_GET_TOK(superclass_name), "non-symbol not to be used as a superclass name"); return -1; } +#else + + + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ + + PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P2, expr); /* 3 */ + cf = GET_SUBCFRAME(hcl); + cf->u.post_and.jump_inst_pos = jump_inst_pos; + + if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P1, obj); /* 2 */ + + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, obj); /* 1 */ +#endif + } + else + { + SWITCH_TO_CFRAME (hcl, COP_EMIT_PUSH_NIL, obj); /* 1*/ } } + + PUSH_SUBCFRAME (hcl, COP_CLASS_SUPERCLASS +#if 0 //HCL_DEBUG2 (hcl, ">>> [%js] [%js]\n", HCL_CNODE_GET_TOKPTR(class_name), HCL_CNODE_GET_TOKPTR(superclass_name)); + nivars = ncvars = 0; while (obj) { /* instance variables and/or class variables */ @@ -1793,15 +1841,44 @@ 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); } + +#else + PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_VARS, obj); +#endif + +// superclass name? +// nivars and ncvars.. must include inherited ones... + if (push_clsblk(hcl, HCL_CNODE_GET_LOC(cmd), nivars, ncvars) <= -1) return -1; - if (push_clsblk(hcl, HCL_CNODE_GET_LOC(cmd), 0, 0) <= -1) return -1; - /* TODO: emit make_class code... - */ + +/* TODO: push the instance variables string and class variables string */ +// superclass name is an variable... + + //if (emit_push_literal(hcl, tmp, HCL_CNODE_GET_LOC(cmd)) + if (nivars > 0) + { + tmp = hcl_makestring(hcl, varg, len, 0); + if (HCL_UNLIKELY(!tmp)) return -1; + if (emit_push_literal(hcl, tmp, HCL_CNODE_GET_LOC(cmd)) <= -1) return-1; + } + + if (ncvars > 0) + { + + } + + /* make_class nsuperclasses, nivars, ncvars - this will use the pushed literal */ + if (emit_byte_instruction(hcl, HCL_CODE_MAKE_CLASS, HCL_CNODE_GET_LOC(cmd)) <= -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, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */ @@ -1809,14 +1886,146 @@ printf ("22222222222\n"); return 0; } +#endif + +static int compile_class (hcl_t* hcl, hcl_cnode_t* src) +{ + hcl_cnode_t* cmd, * obj; + hcl_cnode_t* class_name; + hcl_cframe_t* cf; + + cmd = HCL_CNODE_CONS_CAR(src); + obj = HCL_CNODE_CONS_CDR(src); + + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_DEFCLASS)); + + class_name = HCL_NULL; + + if (check_if_plain_cnode(hcl, obj, src, cmd, HCL_SYNERR_VARNAME, "class name") <= -1) return -1; + class_name = HCL_CNODE_CONS_CAR(obj); + if (HCL_CNODE_IS_SYMBOL(class_name)) + { +/* TODO: make the classname optional? */ + /* defclass followed by a class name */ + if (HCL_CNODE_SYMBOL_SYNCODE(class_name)) /*|| HCL_OBJ_GET_FLAGS_KERNEL(class_name) >= 1) */ + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name), "special symbol not to be used as a class name"); + return -1; + } + obj = HCL_CNODE_CONS_CDR(obj); + } + + if (obj) + { + hcl_cnode_t* tmp; + + tmp = HCL_CNODE_CONS_CAR(obj); + if (!HCL_CNODE_IS_TRPCOLONS(tmp)) goto no_superclass; + { + obj = HCL_CNODE_CONS_CDR(obj); + + /* superclass part */ + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, obj); /* 1 */ + + PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 */ + cf = GET_SUBCFRAME(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? */ + + obj = HCL_CNODE_CONS_CDR(obj); + PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 */ + cf = GET_SUBCFRAME(hcl); + cf->u._class.nsuperclasses = 1; /* this one needs to change if we support multiple superclasses... */ + } + } + else + { + no_superclass: + SWITCH_TOP_CFRAME(hcl, COP_COMPILE_CLASS_P1, obj); /* 1 */ + cf = GET_TOP_CFRAME(hcl); + cf->u._class.nsuperclasses = 0; /* this one 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? */ + + PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 2 */ + cf = GET_SUBCFRAME(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? */ + } + + return 0; +} + +static HCL_INLINE int compile_class_p1 (hcl_t* hcl) +{ + /* collect information about declared variables */ + hcl_cframe_t* cf; + hcl_ooi_t nivars, ncvars; + hcl_cnode_t* obj; + hcl_oop_t tmp; + + cf = GET_TOP_CFRAME(hcl); + obj = cf->operand; + + nivars = ncvars = 0; + while (obj) + { + /* instance variables and/or class variables */ + hcl_cnode_t* vars; + + 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); + } + + /* TODO: push the instance variables string and class variables string */ +// superclass name is an variable... + + //if (emit_push_literal(hcl, tmp, HCL_CNODE_GET_LOC(cmd)) + if (nivars > 0) + { + //tmp = hcl_makestring(hcl, varg, len, 0); + tmp = hcl_makestring(hcl, HCL_NULL, 0, 0); + if (HCL_UNLIKELY(!tmp)) return -1; + if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) return-1; + } + + if (ncvars > 0) + { + tmp = hcl_makestring(hcl, HCL_NULL, 0, 0); + if (HCL_UNLIKELY(!tmp)) return -1; + if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) return-1; + } + + 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; + 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 post_class (hcl_t* hcl) +static HCL_INLINE int compile_class_p2 (hcl_t* hcl) { hcl_cframe_t* cf; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_POST_CLASS); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_CLASS_P2); pop_clsblk (hcl); @@ -1858,6 +2067,7 @@ static HCL_INLINE int post_class (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...? */ 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); @@ -4409,14 +4619,37 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) if (compile_catch(hcl) <= -1) goto oops; break; - case COP_COMPILE_AND_EXPR: - if (compile_and_expr(hcl) <= -1) goto oops; + + + case COP_COMPILE_AND_P1: + if (compile_and_p1(hcl) <= -1) goto oops; break; - case COP_COMPILE_OR_EXPR: - if (compile_or_expr(hcl) <= -1) goto oops; + case COP_COMPILE_AND_P2: + if (compile_and_p2(hcl) <= -1) goto oops; break; + case COP_COMPILE_BREAK_P1: + if (compile_break_p1(hcl) <= -1) goto oops; + break; + + case COP_COMPILE_CLASS_P1: + if (compile_class_p1(hcl) <= -1) goto oops; + break; + + case COP_COMPILE_CLASS_P2: + if (compile_class_p2(hcl) <= -1) goto oops; + break; + + case COP_COMPILE_OR_P1: + if (compile_or_p1(hcl) <= -1) goto oops; + break; + + case COP_COMPILE_OR_P2: + if (compile_or_p2(hcl) <= -1) goto oops; + break; + + case COP_EMIT_CALL: if (emit_call(hcl) <= -1) goto oops; break; @@ -4510,22 +4743,6 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) if (post_lambda(hcl) <= -1) goto oops; break; - case COP_POST_CLASS: - if (post_class(hcl) <= -1) goto oops; - break; - - case COP_POST_AND_EXPR: - if (post_and_expr(hcl) <= -1) goto oops; - break; - - case COP_POST_OR_EXPR: - if (post_or_expr(hcl) <= -1) goto oops; - break; - - case COP_POST_BREAK: - if (post_break(hcl) <= -1) goto oops; - break; - default: HCL_DEBUG1 (hcl, "Internal error - invalid compiler opcode %d\n", cf->opcode); hcl_seterrbfmt (hcl, HCL_EINTERN, "invalid compiler opcode %d", cf->opcode); diff --git a/lib/decode.c b/lib/decode.c index b742db6..a326bcf 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -603,8 +603,16 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) /* -------------------------------------------------------- */ case HCL_CODE_MAKE_CLASS: - LOG_INST_0 (hcl, "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: diff --git a/lib/exec.c b/lib/exec.c index b4a3f8c..69aaa5e 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -144,14 +144,13 @@ static void terminate_all_processes (hcl_t* hcl); do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \ - hcl_ooi_t ss = HCL_OOP_TO_SMOOI(ap->ss); \ - if (exsp >= HCL_OOP_TO_SMOOI(ap->exss) - 2) \ + if (exsp >= HCL_OOP_TO_SMOOI(ap->exst) - 1) \ { \ hcl_seterrbfmt (hcl, HCL_EOOMEM, "process exception stack overflow"); \ (hcl)->abort_req = -1; \ } \ - exsp++; ap->slot[ss + exsp] = (ctx); \ - exsp++; ap->slot[ss + exsp] = HCL_SMOOI_TO_OOP(ip); \ + exsp++; ap->slot[exsp] = (ctx); \ + exsp++; ap->slot[exsp] = HCL_SMOOI_TO_OOP(ip); \ ap->exsp = HCL_SMOOI_TO_OOP(exsp); \ } while (0) @@ -167,13 +166,46 @@ static void terminate_all_processes (hcl_t* hcl); do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \ - hcl_ooi_t ss = HCL_OOP_TO_SMOOI(ap->ss); \ - ip = HCL_OOP_TO_SMOOI(ap->slot[ss + exsp]); exsp--; \ - ctx = ap->slot[ss + exsp]; exsp--; \ + ip = HCL_OOP_TO_SMOOI(ap->slot[exsp]); exsp--; \ + ctx = ap->slot[exsp]; exsp--; \ ap->exsp = HCL_SMOOI_TO_OOP(exsp); \ } while (0) -#define HCL_EXSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exsp) <= -1) +#define HCL_EXSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exsp) <= HCL_OOP_TO_SMOOI(((hcl)->processor->active)->st)) + + +/* ------------------------------------------------------------------------- */ + +#define HCL_CLSTACK_PUSH(hcl, v) \ + do { \ + hcl_oop_process_t ap = (hcl)->processor->active; \ + hcl_ooi_t clsp = HCL_OOP_TO_SMOOI(ap->clsp); \ + if (clsp >= HCL_OOP_TO_SMOOI(ap->clst)) \ + { \ + hcl_seterrbfmt (hcl, HCL_EOOMEM, "process class stack overflow"); \ + (hcl)->abort_req = -1; \ + } \ + clsp++; ap->slot[clsp] = (v); \ + ap->clsp = HCL_SMOOI_TO_OOP(clsp); \ + } while (0) + +#define HCL_CLSTACK_POP(hcl) \ + do { \ + hcl_oop_process_t ap = (hcl)->processor->active; \ + hcl_ooi_t clsp = HCL_OOP_TO_SMOOI(ap->clsp); \ + clsp--; \ + ap->clsp = HCL_SMOOI_TO_OOP(clsp); \ + } while (0) + +#define HCL_CLSTACK_POP_TO(hcl, v) \ + do { \ + hcl_oop_process_t ap = (hcl)->processor->active; \ + hcl_ooi_t clsp = HCL_OOP_TO_SMOOI(ap->clsp); \ + v = ap->slot[clsp]; clsp--; \ + ap->clsp = HCL_SMOOI_TO_OOP(clsp); \ + } while (0) + +#define HCL_CLSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->clsp) <= HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exst)) /* ------------------------------------------------------------------------- */ @@ -462,7 +494,7 @@ static HCL_INLINE void free_pid (hcl_t* hcl, hcl_oop_process_t proc) static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) { hcl_oop_process_t proc; - hcl_oow_t stksize, exstksize; + hcl_oow_t stksize, exstksize, clstksize, maxsize; hcl_ooi_t total_count; hcl_ooi_t suspended_count; @@ -478,24 +510,23 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) if (hcl->proc_map_free_first <= -1 && prepare_to_alloc_pid(hcl) <= -1) return HCL_NULL; - stksize = hcl->option.dfl_procstk_size; + 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 0 - if (stksize > HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) - stksize = HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS; - else if (stksize < 128) stksize = 128; -#else - if (stksize > (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2) - stksize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2; - else if (stksize < 128) stksize = 128; - if (exstksize > (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2) - exstksize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2; + if (stksize > maxsize) stksize = maxsize; + else if (stksize < 192) stksize = 192; + + if (exstksize > maxsize) exstksize = maxsize; else if (exstksize < 128) exstksize = 128; -#endif + + if (clstksize > maxsize) clstksize = maxsize; + else if (clstksize < 32) clstksize = 32; hcl_pushvolat (hcl, (hcl_oop_t*)&c); - proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize + exstksize); + proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize + exstksize + clstksize); hcl_popvolat (hcl); if (HCL_UNLIKELY(!proc)) return HCL_NULL; @@ -512,10 +543,18 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) proc->initial_context = c; proc->current_context = c; - proc->sp = HCL_SMOOI_TO_OOP(-1); - proc->ss = HCL_SMOOI_TO_OOP(stksize); - proc->exsp = HCL_SMOOI_TO_OOP(-1); - proc->exss = HCL_SMOOI_TO_OOP(exstksize); + + /* stack */ + proc->sp = HCL_SMOOI_TO_OOP(-1); /* no item */ + proc->st = HCL_SMOOI_TO_OOP(stksize); + + /* exception stack */ + proc->exsp = proc->st; /* no item pushed yet*/ + proc->exst = HCL_SMOOI_TO_OOP(stksize + exstksize - 1); + + /* class stack */ + proc->clsp = proc->exst; /* no item pushed yet */ + proc->clst = HCL_SMOOI_TO_OOP(stksize + exstksize + clstksize - 1); HCL_ASSERT (hcl, (hcl_oop_t)c->sender == hcl->_nil); @@ -3264,7 +3303,6 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) LOG_INST_0 (hcl, "throw"); return_value = HCL_STACK_GETTOP(hcl); HCL_STACK_POP (hcl); - if (do_throw(hcl, return_value, fetched_instruction_pointer) <= -1) goto oops; break; /* -------------------------------------------------------- */ @@ -3274,15 +3312,15 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) /* the class_enter instruct must follow the class_make instruction... */ LOG_INST_0 (hcl, "class_enter"); - c = HCL_STACK_GETTOP(hcl); /* the class object */ - //HCL_CLSTACK_PUSH (hcl, c); + 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? */ - //HCL_CLSTACK_POP (hcl); + HCL_CLSTACK_POP (hcl); break; /* -------------------------------------------------------- */ @@ -3753,23 +3791,26 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) case HCL_CODE_MAKE_CLASS: { - /* push nivars - push ncvars - push superclass - //push ivarnames - //push cvarnames + /* 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); - LOG_INST_0 (hcl, "make_class"); - - sc = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl); - ncvars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl); - nivars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl); - HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(ncvars)); - HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(nivars)); - t = hcl_makeclass(hcl, sc, HCL_OOP_TO_SMOOI(nivars), HCL_OOP_TO_SMOOI(ncvars)); + /* 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)) { @@ -3980,7 +4021,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl) #endif } - /* create a virtual function object that hold the bytes codes generated */ + /* create a virtual function object that hold the bytes codes generated plus the literal frame */ func = make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len, hcl->code.dbgi); if (HCL_UNLIKELY(!func)) return HCL_NULL; diff --git a/lib/gc.c b/lib/gc.c index c190100..98ba4e8 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -233,31 +233,45 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl) { oop = hcl->gci.stack.ptr[--hcl->gci.stack.len]; - /*gc_ms_mark_object (hcl, (hcl_oop_t)HCL_OBJ_GET_CLASS(oop));*/ + gc_ms_mark_object (hcl, (hcl_oop_t)HCL_OBJ_GET_CLASS(oop)); if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP) { - hcl_oow_t size, i; + hcl_ooi_t i, ll; /* is it really better to use a flag bit in the header to * determine that it is an instance of process? */ /* if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) */ if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS) { + hcl_oop_process_t proc; + /* the stack in a process object doesn't need to be * scanned in full. the slots above the stack pointer * are garbages. */ - size = HCL_PROCESS_NAMED_INSTVARS + HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1; - HCL_ASSERT (hcl, size <= HCL_OBJ_GET_SIZE(oop)); + proc = (hcl_oop_process_t)oop; + + /* the fixed part */ + ll = HCL_PROCESS_NAMED_INSTVARS; + for (i = 0; i < ll; i++) gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i)); + + /* stack */ + ll = HCL_OOP_TO_SMOOI(proc->sp); + HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); + for (i = 0; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]); + /* exception stack */ + ll = HCL_OOP_TO_SMOOI(proc->exsp); + HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); + for (i = HCL_OOP_TO_SMOOI(proc->st) + 1; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]); + /* class stack */ + ll = HCL_OOP_TO_SMOOI(proc->clsp); + HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); + for (i = HCL_OOP_TO_SMOOI(proc->exst) + 1; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]); } else { - size = HCL_OBJ_GET_SIZE(oop); - } - - for (i = 0; i < size; i++) - { - gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i)); + ll = HCL_OBJ_GET_SIZE(oop); + for (i = 0; i < ll; i++) gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i)); } } } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 0cbf0b3..5a4066d 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -380,6 +380,13 @@ struct hcl_cframe_t { hcl_ooi_t jump_inst_pos; } _break; + + /* COP_COMPILE_CLASS_P1, COP_COMPILE_CLASS_P2 */ + struct + { + hcl_ooi_t nsuperclasses; + hcl_ioloc_t start_loc; + } _class; } u; }; typedef struct hcl_cframe_t hcl_cframe_t; @@ -448,7 +455,6 @@ struct hcl_rstl_t hcl_rstl_t* prev; }; - struct hcl_compiler_t { /* output handler */ diff --git a/lib/hcl.h b/lib/hcl.h index aaa83c6..c4a5846 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -646,7 +646,7 @@ struct hcl_context_t hcl_oop_t slot[1]; /* arguments, return variables, local variables, other arguments, etc */ }; -#define HCL_PROCESS_NAMED_INSTVARS 13 +#define HCL_PROCESS_NAMED_INSTVARS 15 typedef struct hcl_process_t hcl_process_t; typedef struct hcl_process_t* hcl_oop_process_t; @@ -666,10 +666,15 @@ struct hcl_process_t hcl_oop_t id; /* SmallInteger */ hcl_oop_t state; /* SmallInteger */ + hcl_oop_t sp; /* stack pointer. SmallInteger */ - hcl_oop_t ss; /* process stack size. SmallInteger */ + hcl_oop_t st; /* stack top */ + hcl_oop_t exsp; /* exception stack pointer. SmallInteger */ - hcl_oop_t exss; /* exception stack size. SmallInteger */ + hcl_oop_t exst; /* exception stack top */ + + hcl_oop_t clsp; /* class stack pointer */ + hcl_oop_t clst; /* class stack top */ struct { @@ -1690,7 +1695,7 @@ struct hcl_t /* TODO: stack bound check when pushing */ #define HCL_STACK_PUSH(hcl,v) \ do { \ - if ((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->ss) - 1) \ + if ((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->st)) \ { \ hcl_seterrbfmt (hcl, HCL_EOOMEM, "process stack overflow"); \ (hcl)->abort_req = -1; \