From f4661d018a1bdc15d265df6492eadd13944528fd Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Sun, 27 Feb 2022 19:35:47 +0000 Subject: [PATCH] fixing bugs related to stack, class stack, exceptio stack handling --- lang.txt | 98 ++++++++++++++++++------------- lib/comp.c | 6 +- lib/exec.c | 166 ++++++++++++++++++++++++++++++++++++++++++----------- lib/gc.c | 6 +- lib/hcl.h | 14 +++-- 5 files changed, 207 insertions(+), 83 deletions(-) diff --git a/lang.txt b/lang.txt index 2ba6844..f0f5e8e 100644 --- a/lang.txt +++ b/lang.txt @@ -33,64 +33,82 @@ ## class declaration with methods. -(defclass X + (defclass X - | x y | ; instance variables - ::: | bob jim | ; class variables + | x y | ; instance variables + ::: | bob jim | ; class variables - ; instance variables and class variables must not collide with those of parent classes. - ; they must not collide with method names of parent classes + ; instance variables and class variables must not collide with those of parent classes. + ; they must not collide with method names of parent classes + + (set bob "Bob") ; can access class variables. disallowed to access instance variables - (set bob "Bob") ; can access class variables. disallowed to access instance variables + (defun setX (a) + (set x a) + ) - (defun setX (a) - (set self.x a) - ;(super.setX a) + ; instance method. a method name must not collide with instance variable names and class variable names. + ; the name can be the same as method names of parent classes. + (defun K (a b) + (:self Y a) + (return (+ a b x y)) + ) + + (defun Y (a) + (printf "Y=>%d [%s]\n" a bob) + ) + + (defun ::: KK (a b) + (printf "K=>%s\n" bob) ; a class method can access class variables but not instance variables + (return (+ a b)) + ) + + (set jim (lambda (a b) (+ a b))) ; an anonymous function created ) - ; instance method. a method name must not collide with instance variable names and class variable names. - ; the name can be the same as method names of parent classes. - (defun K (a b) - (self.Y a) - (return (+ a b x y)) - ) - - (defun Y (a) - (printf ("Y=>%d [%s]\n", a, bob) - ) - - (defun ::: KK (a b) - (printf "K=>%s\n", bob) ; a class method can access class variables but not instance variables - (return (+ a b)) - ) - - (set jim (lambda (a b) (+ a b))) ; the anonymous function created is -) + (set r (object-new X)) + (:r Y 10) + (printf ">>%d\n" (:X KK 77 99)) ## method invocation -a period isn't a good token to use for chaining method invocation. - super.a().b().c() - push super - send_to_super a - send_to_self b - send_to_self c - (send_to_xxx is lookup + call) +send the message aaa to the receiver + (:self aaa) +send the message aaa to the receiver but let it resolve the method in the superclass side. + (:super aaa) -we need a way to swap the first parameter and the called function -(: a b 2 3 4) +send the message dump to the object pointed to by x with arguments 1, 2, 3. + (:x dump 1 2 3) -(a b 2 3 4) - (a.b.c 20 30 40) - ((a:b 20 30):c 30) - +## method types + +- class method +- class instantiation method +- instance method + +## dynamic dispatching by method name + (defclass X + (defun t1 (x) (printf "t1 = %d\n" (+ x x x))) + (defun t2 (x) (printf "t2 = %d\n" (* x x x))) + ) + + (defun get-name-1() "t1") + (defun get-name-2() "t2") + + (set x (object-new X)) + + (:x (get-name-1) 100) ; must be same as (:x t1 100) + (:x (get-name-2) 100) ; must be same as (:x t2 100) + +## Something to look into.. normal function call (f arg1 arg2 arg3) (rcv f arg1 arg2) +## dynamic method invocation??? (:X (f) arg1 arg2) as long as f returns a symbol, it can also invoke a method?? diff --git a/lib/comp.c b/lib/comp.c index 3047ccf..6c4cb8d 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -299,6 +299,7 @@ static int find_variable_backward (hcl_t* hcl, const hcl_cnode_t* token, hcl_var for (fi = hcl->c->fnblk.depth + 1; fi > i; ) /* TOOD: review this loop for correctness */ { + /* 'i' is the function level that hold the class defintion block. the check must not go past it */ if (hcl->c->fnblk.info[--fi].fun_type == FUN_CM) { /* the function where this variable is defined is a class method or an plain function block within a class method*/ @@ -1550,11 +1551,12 @@ static int compile_break (hcl_t* hcl, hcl_cnode_t* src) goto inside_loop; case HCL_CBLK_TYPE_TRY: - /*must emit an instruction to exit from the try loop.*/ + /* emit an instruction to exit from the try loop. */ if (emit_byte_instruction(hcl, HCL_CODE_TRY_EXIT, HCL_CNODE_GET_LOC(src)) <= -1) return -1; break; case HCL_CBLK_TYPE_CLASS: + /* emit an instruction to exit from the class definition scope being defined */ if (emit_byte_instruction(hcl, HCL_CODE_CLASS_EXIT, HCL_CNODE_GET_LOC(src)) <= -1) return -1; break; } @@ -2243,6 +2245,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) } if (push_clsblk(hcl, &cf->u._class.start_loc, nivars, ncvars, &hcl->c->tv.s.ptr[ivar_start], ivar_len, &hcl->c->tv.s.ptr[cvar_start], cvar_len) <= -1) goto oops; + if (push_cblk(hcl, &cf->u._class.start_loc, HCL_CBLK_TYPE_CLASS) <= -1) goto oops; /* the class block shall be treated as a control block, too */ /* discard the instance variables and class variables in the temporary variable collection buffer * because they have been pushed to the class block structure */ @@ -2299,6 +2302,7 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl) if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; } + pop_cblk (hcl); pop_clsblk (hcl); /* end of the class block */ if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PEXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; diff --git a/lib/exec.c b/lib/exec.c index c523516..e43ba71 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -140,7 +140,7 @@ static void terminate_all_processes (hcl_t* hcl); /* ------------------------------------------------------------------------- */ -#define HCL_EXSTACK_PUSH(hcl, ctx_, ip_, clsp_) \ +#define HCL_EXSTACK_PUSH(hcl, ctx_, ip_, clsp_, sp_) \ do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \ @@ -152,6 +152,7 @@ static void terminate_all_processes (hcl_t* hcl); exsp++; ap->slot[exsp] = (ctx_); \ exsp++; ap->slot[exsp] = HCL_SMOOI_TO_OOP(ip_); \ exsp++; ap->slot[exsp] = HCL_SMOOI_TO_OOP(clsp_); \ + exsp++; ap->slot[exsp] = HCL_SMOOI_TO_OOP(sp_); \ ap->exsp = HCL_SMOOI_TO_OOP(exsp); \ } while (0) @@ -159,14 +160,15 @@ 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); \ - exsp -= 3; \ + exsp -= 4; \ ap->exsp = HCL_SMOOI_TO_OOP(exsp); \ } while (0) -#define HCL_EXSTACK_POP_TO(hcl, ctx_, ip_, clsp_) \ +#define HCL_EXSTACK_POP_TO(hcl, ctx_, ip_, clsp_, sp_) \ do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \ + sp_ = HCL_OOP_TO_SMOOI(ap->slot[exsp]); exsp--; \ clsp_ = HCL_OOP_TO_SMOOI(ap->slot[exsp]); exsp--; \ ip_ = HCL_OOP_TO_SMOOI(ap->slot[exsp]); exsp--; \ ctx_ = ap->slot[exsp]; exsp--; \ @@ -602,7 +604,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) static HCL_INLINE void sleep_active_process (hcl_t* hcl, int state) { - STORE_ACTIVE_SP(hcl); + STORE_ACTIVE_SP (hcl); /* store the current active context to the current process. * it is the suspended context of the process to be suspended */ @@ -644,7 +646,7 @@ static void switch_to_process (hcl_t* hcl, hcl_oop_process_t proc, int new_state /* the new process must be in the runnable state */ HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE) || - proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_WAITING)); + proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_WAITING)); sleep_active_process (hcl, new_state_for_old_active); wake_process (hcl, proc); @@ -903,10 +905,12 @@ static void dump_process_info (hcl_t* hcl, hcl_bitmask_t log_mask) static HCL_INLINE void reset_process_stack_pointers (hcl_t* hcl, hcl_oop_process_t proc) { #if defined(HCL_DEBUG_VM_PROCESSOR) - HCL_LOG9 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, - "Processor - process[%zd] SP: %zd ST: %zd EXSP: %zd(%zd) EXST: %zd CLSP: %zd(%zd) CLST: %zd\n", + HCL_LOG4 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + "Processor - process[%zd] SP: %zd(%zd) ST: %zd", HCL_OOP_TO_SMOOI(proc->id), - HCL_OOP_TO_SMOOI(proc->sp), HCL_OOP_TO_SMOOI(proc->st), + HCL_OOP_TO_SMOOI(proc->sp), HCL_OOP_TO_SMOOI(proc->sp) - (-1), HCL_OOP_TO_SMOOI(proc->st)); + HCL_LOG6 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + " EXSP: %zd(%zd) EXST: %zd CLSP: %zd(%zd) CLST: %zd\n", HCL_OOP_TO_SMOOI(proc->exsp), HCL_OOP_TO_SMOOI(proc->exsp) - HCL_OOP_TO_SMOOI(proc->st), HCL_OOP_TO_SMOOI(proc->exst), HCL_OOP_TO_SMOOI(proc->clsp), HCL_OOP_TO_SMOOI(proc->clsp) - HCL_OOP_TO_SMOOI(proc->exst), HCL_OOP_TO_SMOOI(proc->clst)); #endif @@ -930,12 +934,16 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc) { hcl_oop_process_t nrp; + /* terminating the active process */ + HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING)); + nrp = find_next_runnable_process(hcl); + STORE_ACTIVE_SP (hcl); /* commit the stack pointer before termination */ + unchain_from_processor (hcl, proc, PROC_STATE_TERMINATED); reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */ proc->current_context = proc->initial_context; /* not needed but just in case */ - /* a runnable or running process must not be chanined to the * process list of a semaphore */ HCL_ASSERT (hcl, (hcl_oop_t)proc->sem == hcl->_nil); @@ -960,11 +968,14 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc) } else { + /* there are other processes to schedule */ switch_to_process (hcl, nrp, PROC_STATE_TERMINATED); } } else { + /* termiante a runnable process which is not an actively running process */ + HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE)); unchain_from_processor (hcl, proc, PROC_STATE_TERMINATED); reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */ } @@ -2137,7 +2148,8 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ /* TODO: implement method cache */ HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_)); - HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op_name)); + /*HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op_name));*/ + HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(op_name)); name.ptr = HCL_OBJ_GET_CHAR_SLOT(op_name); name.len = HCL_OBJ_GET_SIZE(op_name); @@ -2179,15 +2191,16 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ return HCL_NULL; } -static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner) +static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner) { hcl_oocs_t name; HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_)); - HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op)); + /*HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op_name));*/ + HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(op_name)); - name.ptr = HCL_OBJ_GET_CHAR_SLOT(op); - name.len = HCL_OBJ_GET_SIZE(op); + name.ptr = HCL_OBJ_GET_CHAR_SLOT(op_name); + name.len = HCL_OBJ_GET_SIZE(op_name); if (to_super) { @@ -2234,7 +2247,8 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in hcl_ooi_t ivaroff; int x; - HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, msg)); + HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(msg)); + /*HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, msg));*/ /* ============================= */ /* TODO: implement methods cache */ @@ -2272,7 +2286,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip) { hcl_oop_context_t catch_ctx; - hcl_ooi_t catch_ip, clsp; + hcl_ooi_t catch_ip, clsp, sp; if (HCL_EXSTACK_IS_EMPTY(hcl)) { @@ -2300,7 +2314,7 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip) } /* pop the exception stack to get information to rewind context */ - HCL_EXSTACK_POP_TO (hcl, catch_ctx, catch_ip, clsp); + HCL_EXSTACK_POP_TO (hcl, catch_ctx, catch_ip, clsp, sp); /* discard unfinished class definitions for the exception thrown. * @@ -2319,6 +2333,8 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip) SWITCH_ACTIVE_CONTEXT (hcl, catch_ctx); hcl->ip = catch_ip; /* override the instruction pointer */ + hcl->sp = sp; /* restore the stack pointer of the active process context */ + /* push the exception value to the stack */ HCL_STACK_PUSH (hcl, val); return 0; @@ -2893,7 +2909,7 @@ switch_to_next: /* ------------------------------------------------------------------------- */ -static HCL_INLINE int do_return (hcl_t* hcl, hcl_oop_t return_value) +static HCL_INLINE int do_return_from_home (hcl_t* hcl, hcl_oop_t return_value) { /* if (hcl->active_context == hcl->processor->active->initial_context) // read the interactive mode note below... */ if ((hcl_oop_t)hcl->active_context->home == hcl->_nil) @@ -2967,13 +2983,13 @@ static HCL_INLINE int do_return (hcl_t* hcl, hcl_oop_t return_value) } hcl->active_context->home->ip = HCL_SMOOI_TO_OOP(-1); /* mark that this context has returned */ - hcl->ip = -1; /* mark that the active context has returned. saved into hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT() */ + + hcl->ip = -1; /* mark that the active context has returned. committed to hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT() */ SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->home->sender); /* push the return value to the stack of the new active context */ HCL_STACK_PUSH (hcl, return_value); - #if 0 /* stack dump */ HCL_DEBUG1 (hcl, "****** non local returning %O\n", return_value); @@ -3005,18 +3021,69 @@ static HCL_INLINE void do_return_from_block (hcl_t* hcl) } else { + /* The compiler produces the class_exit instruction and the try_exit instruction + * for return, break, continue in a class defintion scope and in a try-catch scope + * respectively. - /* -TODO: should i restore the class stack pointer too??? - let context remeber the it and use it to restore - + [CASE 1] (defclass X ; .... - (return 20) ; the class defintion isn't over, but return is executed?? or simply disallow return in the class context outside a method? + (return 20) ; the class defintion isn't over, but return is executed, ; .... ) - */ + [CASE 2] + (try + (defclass C + (return 200) + (printf "============================\n")) + catch (e) + (printf "EXCEPTION => %O\n" e) + ) + + [CASE 3] + (defclass C + (try + (return 99) + catch (e) + (printf "EXCEPTOIN => %O\n" e) + ) + (printf "============================\n") + ) + + [CASE 4] + (try + (defclass C + (try + (return 99) + catch (e) + (printf "EXCEPTOIN => %O\n" e) + ) + (printf "============================\n") + ) + catch (e) + (printf "EXCEPTOIN => %O\n" e) + ) + + [CASE 5] + (try + (defclass D + (defclass C + (try + (return 99) + catch (e) + (printf "EXCEPTOIN => %O\n" e) + ) + (printf "============================\n") + ) + } + catch (e) + (printf "EXCEPTOIN => %O\n" e) + ) + + * the actual return instruction handler doesn't need to care about the + * class stack and exception stack. + */ /* it is a normal block return as the active block context * is not the initial context of a process */ @@ -3063,9 +3130,34 @@ static int execute (hcl_t* hcl) if (hcl->abort_req < 0) goto oops; if (hcl->abort_req > 0 || (!hcl->no_proc_switch && switch_process_if_needed(hcl) == 0)) break; - if (HCL_UNLIKELY(hcl->ip >= HCL_FUNCTION_GET_CODE_SIZE(hcl->active_function))) + if (HCL_UNLIKELY(hcl->ip < 0 || hcl->ip >= HCL_FUNCTION_GET_CODE_SIZE(hcl->active_function))) { - HCL_DEBUG2 (hcl, "Stopping execution as IP reached the end of bytecode(%zu) - SP %zd\n", hcl->code.bc.len, hcl->sp); + if (hcl->ip < 0) + { + /* do_return_from_home() implements a simple check against a dead context. + * but the check is far from perfect. there are many ways to return from an + * active context and enter a dead context thereafter. + (defun t(f) + (set q (lambda() + (printf "hello word\n") + (return-from-home 200) + )) + (f) + ) + (defun x() + (t (lambda() (return-from-home 100))) + (printf ">>>>>>>>>>>>>>>>>>>>>>>>\n"); + ) + (x) ; x is exited by (return-from-home 100) triggered by (f) + (printf "------------------------\n") + (q) ; (return-from-home 200) exits t and since t is called from x, it flows back to the dead x. + */ + HCL_DEBUG1 (hcl, "Stopping execution as a dead context gets active - IP %zd\n", hcl->ip); + } + else + { + HCL_DEBUG2 (hcl, "Stopping execution as IP reached the end of bytecode(%zu) - IP %zd\n", hcl->code.bc.len, hcl->ip); + } return_value = hcl->_nil; goto handle_return; } @@ -3531,20 +3623,23 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) catch_ip = hcl->ip + b1; /* TODO: ip overflow check? */ clsp = HCL_CLSTACK_GET_SP(hcl); - HCL_EXSTACK_PUSH (hcl, hcl->active_context, catch_ip, clsp); + + HCL_EXSTACK_PUSH (hcl, hcl->active_context, catch_ip, clsp, hcl->sp); break; } - + case HCL_CODE_TRY_ENTER2: { hcl_ooi_t catch_ip, clsp; FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "try_enter2 %zu", b1); + catch_ip = hcl->ip + MAX_CODE_JUMP + b1; /* TODO: ip overflow check? */ clsp = HCL_CLSTACK_GET_SP(hcl); - HCL_EXSTACK_PUSH (hcl, hcl->active_context, catch_ip, clsp); + + HCL_EXSTACK_PUSH (hcl, hcl->active_context, catch_ip, clsp, hcl->sp); break; } @@ -3860,7 +3955,8 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) handle_send_2: rcv = HCL_STACK_GETRCV(hcl, b1); op = HCL_STACK_GETOP(hcl, b1); - if (!HCL_IS_SYMBOL(hcl, op)) + /*if (!HCL_IS_SYMBOL(hcl, op))*/ + if (!HCL_OBJ_IS_CHAR_POINTER(op)) { hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid message", op, rcv); /* TODO: change to HCL_ESEND?? */ goto cannot_send; @@ -3879,6 +3975,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) { hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid receiver", op, rcv); /* TODO: change to HCL_ESEND?? */ cannot_send: + //HCL_STACK_POPS (hcl, b1 + 2); /* pop the receiver, message, and arguments as the call fails. TODO: check if this clearing is correct */ if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; goto oops_with_errmsg_supplement; } @@ -4315,7 +4412,8 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) break; case HCL_CODE_RETURN_STACKTOP: -/* this implements the non-local return. the non-local return is not compatible with stack based try-catch implementation. */ +/* [NOTE] this implements the non-local return. the non-local return is not compatible with stack based try-catch implementation. + * [TODO] can make it compatiable? */ LOG_INST_0 (hcl, "return_stacktop"); return_value = HCL_STACK_GETTOP(hcl); HCL_STACK_POP (hcl); @@ -4327,7 +4425,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) handle_return: hcl->last_retv = return_value; - if (do_return(hcl, return_value) <= -1) goto oops; + if (do_return_from_home(hcl, return_value) <= -1) goto oops; break; case HCL_CODE_RETURN_FROM_BLOCK: diff --git a/lib/gc.c b/lib/gc.c index d5d6c87..bfeaaf9 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -566,10 +566,10 @@ void hcl_gc (hcl_t* hcl) { HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor != hcl->_nil); HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor->active != hcl->_nil); - /* store the stack pointer to the active process */ + HCL_ASSERT (hcl, HCL_IS_PROCESS(hcl, hcl->processor->active)); + /* commit the stack pointer to the active process */ hcl->processor->active->sp = HCL_SMOOI_TO_OOP(hcl->sp); - - /* store the instruction pointer to the active context */ + /* commit the instruction pointer to the active context */ hcl->active_context->ip = HCL_SMOOI_TO_OOP(hcl->ip); } diff --git a/lib/hcl.h b/lib/hcl.h index 1a99b2d..f2a4802 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -608,7 +608,7 @@ struct hcl_block_t hcl_oop_t tmpr_mask; /* smooi */ hcl_oop_context_t home; /* home context */ - hcl_oop_t ip; /* smooi. instruction pointer where the byte code begins in home->origin */ + hcl_oop_t ip; /* smooi. instruction pointer where the byte code begins in home->base */ }; struct hcl_context_t @@ -1730,12 +1730,16 @@ struct hcl_t (hcl)->processor->active->slot[(hcl)->sp] = v; \ } while (0) -#define HCL_STACK_GET(hcl,v_sp) ((hcl)->processor->active->slot[v_sp]) -#define HCL_STACK_SET(hcl,v_sp,v_obj) ((hcl)->processor->active->slot[v_sp] = v_obj) +#define HCL_STACK_GET(hcl,sp_) ((hcl)->processor->active->slot[sp_]) +#define HCL_STACK_SET(hcl,sp_,obj_) ((hcl)->processor->active->slot[sp_] = obj_) #define HCL_STACK_GETTOP(hcl) HCL_STACK_GET(hcl, (hcl)->sp) -#define HCL_STACK_SETTOP(hcl,v_obj) HCL_STACK_SET(hcl, (hcl)->sp, v_obj) +#define HCL_STACK_SETTOP(hcl,obj_) HCL_STACK_SET(hcl, (hcl)->sp, obj_) +/* [NOTE] + * the following macros don't commit the active stack pointer(hcl->sp) + * to hcl->processor->active->sp immediately. + */ #define HCL_STACK_POP(hcl) ((hcl)->sp = (hcl)->sp - 1) #define HCL_STACK_POPS(hcl,count) ((hcl)->sp = (hcl)->sp - (count)) #define HCL_STACK_POP_TO(hcl,v) \ @@ -1743,7 +1747,7 @@ struct hcl_t v = HCL_STACK_GETTOP(hcl); \ HCL_STACK_POP (hcl); \ } while(0) - + #define HCL_STACK_GET_ST(hcl) HCL_OOP_TO_SMOOI((hcl)->processor->active->st) #define HCL_STACK_GET_SP(hcl) ((hcl)->sp) #define HCL_STACK_IS_EMPTY(hcl) ((hcl)->sp <= -1)