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

some implementation updates to the CLASS_LOAD instruction
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-04-04 21:16:28 +09:00
parent da4e895f6f
commit 4be0299de3
6 changed files with 61 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
lib/comp.c
View File

@ -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));

6
lib/decode.c
View File

@ -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;
/* -------------------------------------------------------- */

16
lib/exec.c
View File

@ -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;

20
lib/gc.c
View File

@ -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;

8
lib/print.c
View File

@ -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','>' } },

4
lib/read.c
View File

@ -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