diff --git a/lib/comp.c b/lib/comp.c index 5e4768a..68305ad 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -2314,7 +2314,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl) /* (defclass A | x y | ; instance variables - ::: | x y z | ; class variables <--- how to initialize the class variables??? + :: | x y z | ; class variables <--- how to initialize the class variables??? ; everything inside defclass after the variable declarations are normal expressions. ; however, the resolution of some variables will fall under the enclosing class. @@ -2331,7 +2331,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl) ) ) - (defclass B ::: A ; A is a parent class + (defclass B :: A ; A is a parent class | p q | .... ) @@ -2661,7 +2661,7 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl) pop_cblk (hcl); pop_clsblk (hcl); /* end of the class block */ - if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PEXIT, &class_loc) <= -1) return -1; + if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PEXIT, &class_loc) <= -1) return -1; /* pop + exit */ if (class_name) /* defclass requires a name. but class doesn't */ { @@ -4498,8 +4498,8 @@ redo: case HCL_CNODE_SELF: case HCL_CNODE_SUPER: - /* if super is not sent a message, super represents the receiver - * just like self does */ + /* if super is not sent a message, super represents the receiver just like self does */ +/* TODO: SELF and SUPER must be limited to methods or is it ok if it just pushes the fake receiver in a normal function call?? */ if (emit_byte_instruction(hcl, HCL_CODE_PUSH_RECEIVER, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; goto done; @@ -5645,12 +5645,34 @@ static HCL_INLINE int post_lambda (hcl_t* hcl) #else hcl_oow_t index; - hcl_oop_t lit; + hcl_oop_t lit, cons; /* TODO: CLASS_LOAD_X must be emited before the defun method code instruction is emitted ? */ + /* treat this like a global variable for now */ lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(class_name), HCL_CNODE_GET_TOKLEN(class_name)); if (HCL_UNLIKELY(!lit)) return -1; - if (add_literal(hcl, lit, &index) <= -1) return -1; + cons = (hcl_oop_t)hcl_getatsysdic(hcl, lit); + if (!cons) + { + cons = (hcl_oop_t)hcl_putatsysdic(hcl, lit, hcl->_undef); + if (HCL_UNLIKELY(!cons)) return -1; + } +/* +2024-04-01 23:39:21 +0900 0000000041 make_lambda 0 0 0 0 0 +2024-04-01 23:39:21 +0900 0000000046 jump_forward 6 +2024-04-01 23:39:21 +0900 0000000055 store_into_object @4 +2024-04-01 23:39:21 +0900 0000000058 return_from_block + + +2024-04-01 23:40:11 +0900 0000000041 make_lambda 0 0 0 0 0 +2024-04-01 23:40:11 +0900 0000000046 jump_forward 6 +2024-04-01 23:40:11 +0900 0000000055 class_load @2 +2024-04-01 23:40:11 +0900 0000000058 class_imstore 4 +2024-04-01 23:40:11 +0900 0000000061 class_exit +2024-04-01 23:40:11 +0900 0000000062 return_from_block +*/ + + if (add_literal(hcl, cons, &index) <= -1) return -1; if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_LOAD_X, index, HCL_CNODE_GET_LOC(class_name)) <= -1) return -1; lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(defun_name), HCL_CNODE_GET_TOKLEN(defun_name)); diff --git a/lib/decode.c b/lib/decode.c index a0cd523..35babeb 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -407,17 +407,17 @@ int hcl_decode (hcl_t* hcl, const hcl_code_t* code, hcl_oow_t start, hcl_oow_t e case HCL_CODE_CLASS_CMSTORE: FETCH_PARAM_CODE_TO (hcl, b1); - LOG_INST_1 (hcl, "class_cmstore %zu", b1); + LOG_INST_1 (hcl, "class_cmstore @%zu", b1); break; case HCL_CODE_CLASS_CIMSTORE: FETCH_PARAM_CODE_TO (hcl, b1); - LOG_INST_1 (hcl, "class_cimstore %zu", b1); + LOG_INST_1 (hcl, "class_cimstore @%zu", b1); break; case HCL_CODE_CLASS_IMSTORE: FETCH_PARAM_CODE_TO (hcl, b1); - LOG_INST_1 (hcl, "class_imstore %zu", b1); + LOG_INST_1 (hcl, "class_imstore @%zu", b1); break; /* -------------------------------------------------------- */ diff --git a/lib/exec.c b/lib/exec.c index 90d8bc7..1ad7a70 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -3811,12 +3811,18 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) /* push the class indiciated by the literal at the given literal frame index * to the class stack */ LOG_INST_1 (hcl, "class_load @%zu", b1); - /* this literal must be a symbol. find a class with the symbol and push it */ + t = (hcl_oop_cons_t)hcl->active_function->literal_frame[b1]; - HCL_ASSERT (hcl, HCL_IS_CONS(hcl, t)); + if (!HCL_IS_CONS(hcl,t)) + { + /* this is an uncatchable internal error that must not happen - is the bytecode compromised? */ + hcl_seterrbfmt(hcl, HCL_EINTERN, "internal error - invalid operand to CLASS_LOAD"); + goto oops_with_errmsg_supplement; + } + if (!HCL_IS_CLASS(hcl, t->cdr)) { - hcl_seterrbfmt(hcl, HCL_EUNDEFVAR, "%.js is not class", HCL_OBJ_GET_SIZE(t->car), HCL_OBJ_GET_CHAR_SLOT(t->car)); + hcl_seterrbfmt(hcl, HCL_EUNDEFVAR, "%.*js is not class", HCL_OBJ_GET_SIZE(t->car), HCL_OBJ_GET_CHAR_SLOT(t->car)); if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; goto oops_with_errmsg_supplement; } @@ -3857,7 +3863,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) if (b1 > 0) { - HCL_STACK_POP_TO (hcl, sc); /* TODO: support more than 1 later when the compiler supports more */ + HCL_STACK_POP_TO (hcl, sc); /* TODO: support more than 1 superclass later when the compiler supports more */ if (!HCL_IS_CLASS(hcl, sc)) { hcl_seterrbfmt (hcl, HCL_ECALL, "invalid superclass %O", sc); @@ -3887,7 +3893,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) break; } - case HCL_CODE_CLASS_PEXIT: + case HCL_CODE_CLASS_PEXIT: /* pop + exit */ { hcl_oop_t c; diff --git a/lib/gc.c b/lib/gc.c index e498a89..aba570c 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -903,7 +903,7 @@ void hcl_gc (hcl_t* hcl, int full) if (!full && hcl->gci.lazy_sweep) { - /* set the lazy sweeping point to the head of the allocated blocks. + /* set the lazy sweeping pointer to the head of the allocated blocks. * hawk_allocbytes() updates hcl->gci.ls.prev if it is called while * hcl->gci.ls.curr stays at hcl->gci.b */ hcl->gci.ls.prev = HCL_NULL; @@ -1042,8 +1042,8 @@ void hcl_gc (hcl_t* hcl) } /* scan the new heap to move referenced objects */ - ptr = (hcl_uint8_t*) HCL_ALIGN ((hcl_uintptr_t)hcl->newheap->base, HCL_SIZEOF(hcl_oop_t)); - ptr = scan_new_heap (hcl, ptr); + ptr = (hcl_uint8_t*)HCL_ALIGN((hcl_uintptr_t)hcl->newheap->base, HCL_SIZEOF(hcl_oop_t)); + ptr = scan_new_heap(hcl, ptr); /* traverse the symbol table for unreferenced symbols. * if the symbol has not moved to the new heap, the symbol @@ -1381,16 +1381,17 @@ oops: return -1; } -#if 0 static int ignite_3 (hcl_t* hcl) { /* Register kernel classes manually created so far to the system dictionary */ +#if 0 static hcl_ooch_t str_processor[] = { 'P', 'r', 'o', 'c', 'e', 's', 's', 'o', 'r' }; static hcl_ooch_t str_dicnew[] = { 'n', 'e', 'w', ':' }; static hcl_ooch_t str_dicputassoc[] = { '_','_','p', 'u', 't', '_', 'a', 's', 's', 'o', 'c', ':' }; static hcl_ooch_t str_does_not_understand[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' }; static hcl_ooch_t str_primitive_failed[] = { 'p', 'r', 'i', 'm', 'i', 't', 'i', 'v', 'e', 'F', 'a', 'i', 'l', 'e', 'd' }; static hcl_ooch_t str_unwindto_return[] = { 'u', 'n', 'w', 'i', 'n', 'd', 'T', 'o', ':', 'r', 'e', 't', 'u', 'r', 'n', ':' }; +#endif hcl_oow_t i; hcl_oop_t sym; @@ -1398,16 +1399,19 @@ static int ignite_3 (hcl_t* hcl) for (i = 0; i < HCL_COUNTOF(kernel_classes); i++) { - sym = hcl_makesymbol(hcl, kernel_classes[i].name, kernel_classes[i].len); - if (!sym) return -1; + sym = hcl_makesymbol(hcl, kernel_classes[i].name, hcl_count_oocstr(kernel_classes[i].name)); + if (HCL_UNLIKELY(!sym)) return -1; cls = *(hcl_oop_class_t*)((hcl_uint8_t*)hcl + kernel_classes[i].offset); +#if 0 HCL_STORE_OOP (hcl, (hcl_oop_t*)&cls->name, sym); HCL_STORE_OOP (hcl, (hcl_oop_t*)&cls->nsup, (hcl_oop_t)hcl->sysdic); +#endif if (!hcl_putatsysdic(hcl, sym, (hcl_oop_t)cls)) return -1; } +#if 0 /* Attach the system dictionary to the nsdic field of the System class */ HCL_STORE_OOP (hcl, (hcl_oop_t*)&hcl->_system->nsdic, (hcl_oop_t)hcl->sysdic); /* Set the name field of the system dictionary */ @@ -1439,11 +1443,11 @@ static int ignite_3 (hcl_t* hcl) sym = hcl_makesymbol(hcl, str_unwindto_return, HCL_COUNTOF(str_unwindto_return)); if (!sym) return -1; hcl->unwindto_return_sym = (hcl_oop_char_t)sym; +#endif return 0; } -#endif static int make_kernel_objs (hcl_t* hcl) { @@ -1476,9 +1480,9 @@ static int make_kernel_objs (hcl_t* hcl) if (ignite_2(hcl) <= -1) goto oops; -#if 0 if (ignite_3(hcl) <= -1) goto oops; +#if 0 hcl->igniting = 0; #endif return 0; diff --git a/lib/print.c b/lib/print.c index fc4de19..0466dea 100644 --- a/lib/print.c +++ b/lib/print.c @@ -101,10 +101,10 @@ static struct hcl_ooch_t ptr[20]; } word[] = { - { 8, { '#', '<', 'U', 'N', 'D', 'D', 'F', '>' } }, - { 4, { 'n', 'u', 'l', 'l' } }, - { 4, { 't', 'r', 'u', 'e' } }, - { 5, { 'f', 'a', 'l', 's', 'e' } }, + { 8, { '#','<','U','N','D','E','F','>' } }, + { 4, { 'n','u','l','l' } }, + { 4, { 't','r','u','e' } }, + { 5, { 'f','a','l','s','e' } }, { 6, { '#','<','S','E','T','>' } }, { 7, { '#','<','P','R','I','M','>' } }, diff --git a/lib/read.c b/lib/read.c index 5e540a5..3a76f86 100644 --- a/lib/read.c +++ b/lib/read.c @@ -1550,8 +1550,8 @@ static int feed_process_token (hcl_t* hcl) hcl_setsynerrbfmt (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), TOKEN_NAME(hcl), "semicolon expected"); goto oops; #else - /* if the expression inside {} is an auto-forged xlist expression and there is no semiclon provided, - * treat it as if the semiclon is placed before }. e.g. { printf "hello\n" } */ + /* if the expression inside {} is an auto-forged xlist expression and there is no semicolon provided, + * treat it as if the semicolon is placed before }. e.g. { printf "hello\n" } */ rbrace_again = 1; goto semicolon; #endif