From 6f565539a9e67d965124a4d7bf032370634da604 Mon Sep 17 00:00:00 2001 From: "hyunghwan.chung" Date: Mon, 22 Jun 2015 14:21:46 +0000 Subject: [PATCH] enhanced the compiler to handle cascaded messages. implemented block-context local temporaries. changed primitive_block_context_value() to support block context reentrancy by activating a shallow-copied block context --- stix/lib/comp.c | 313 +++++++++++++++++++++++++++++----- stix/lib/exec.c | 403 ++++++++++++++++++++++++++++++++++---------- stix/lib/stix-prv.h | 7 +- stix/lib/stix.h | 9 +- 4 files changed, 591 insertions(+), 141 deletions(-) diff --git a/stix/lib/comp.c b/stix/lib/comp.c index b228efb..6698846 100644 --- a/stix/lib/comp.c +++ b/stix/lib/comp.c @@ -1520,7 +1520,6 @@ done: * the position returned here doesn't consider * class instance variables that can be potentially * placed before the class variables. */ - //???? var->cls = (stix_oop_class_t)super; /* THIS PART IS WRONG. FIX IT??? */ break; case VAR_CLASSINST: @@ -2038,7 +2037,7 @@ static int compile_block_expression (stix_t* stix) { stix_size_t i, jump_inst_pos; stix_size_t saved_tmpr_count, saved_tmprs_len; - stix_size_t block_arg_count, block_tmpr_count; + stix_size_t block_arg_count/*, block_tmpr_count*/; stix_size_t block_code_size; stix_ioloc_t block_loc, colon_loc, tmpr_loc; @@ -2114,20 +2113,22 @@ static int compile_block_expression (stix_t* stix) tmpr_loc = stix->c->tok.loc; if (compile_block_temporaries(stix) <= -1) return -1; +#if 0 block_tmpr_count = stix->c->mth.tmpr_count - saved_tmpr_count; if (block_tmpr_count > MAX_CODE_NBLKTMPRS) { set_syntax_error (stix, STIX_SYNERR_BLKTMPRFLOOD, &tmpr_loc, STIX_NULL); return -1; } +#endif -printf ("\tpush_context nargs %d ntmprs %d\n", (int)block_arg_count, (int)block_tmpr_count); +printf ("\tpush_context nargs %d ntmprs %d\n", (int)block_arg_count, (int)stix->c->mth.tmpr_count /*block_tmpr_count*/); printf ("\tpush smint %d\n", (int)block_arg_count); -printf ("\tpush smint %d\n", (int)block_tmpr_count); +printf ("\tpush smint %d\n", (int)stix->c->mth.tmpr_count /*block_tmpr_count*/); printf ("\tsend_block_copy\n"); if (emit_byte_instruction(stix, CODE_PUSH_CONTEXT) <= -1 || emit_push_smint_literal(stix, block_arg_count) <= -1 || - emit_push_smint_literal(stix, block_tmpr_count) <= -1 || + emit_push_smint_literal(stix, stix->c->mth.tmpr_count/*block_tmpr_count*/) <= -1 || emit_byte_instruction(stix, CODE_SEND_BLOCK_COPY) <= -1) return -1; printf ("\tjump\n"); @@ -2137,21 +2138,6 @@ printf ("\tjump\n"); emit_byte_instruction(stix, 0) <= -1 || emit_byte_instruction(stix, 0) <= -1) return -1; - for (i = 0; i < block_arg_count; i++) - { - /* arrange to store the top of the stack to a block argument - * when evaluation of a block begins. this is for copying - * pushed arguments for 'aBlock value'. - * - * For the following statements, - * a := [:x :y | | k | k := x + y ]. - * a value: 10 value 20. - * these instructions copy 10 to x and 20 to y when #value:value: is - * sent to a. - */ - if (emit_positional_instruction(stix, CMD_STORE_INTO_TEMPVAR, saved_tmpr_count + i) <= -1) return -1; - } - /* compile statements inside a block */ if (stix->c->tok.type == STIX_IOTOK_RBRACK) { @@ -2388,16 +2374,27 @@ static stix_byte_t send_message_cmd[] = CMD_SEND_MESSAGE_TO_SUPER }; +#if 0 static int compile_unary_message (stix_t* stix, int to_super) { stix_size_t index; while (stix->c->tok.type == STIX_IOTOK_IDENT) { - if (add_symbol_literal(stix, &stix->c->tok.name, &index) <= -1 || - emit_double_positional_instruction(stix, send_message_cmd[to_super], 0, index) <= -1) return -1; -printf ("\tsend message %d with 0 arguments to %s\n", (int)index, (to_super? "super": "self")); + if (add_symbol_literal(stix, &stix->c->tok.name, &index) <= -1) return -1; + +printf ("adding binary symbol..."); +print_ucs (&stix->c->tok.name); +printf ("\n"); GET_TOKEN (stix); + +if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) printf ("\tdup_stack for cascading\n"); + /* check adhead if it will be followed by a cascaded message */ + if (stix->c->tok.type == STIX_IOTOK_SEMICOLON && + emit_byte_instruction(stix, CODE_DUP_STACKTOP) <= -1) return -1; + + if (emit_double_positional_instruction(stix, send_message_cmd[to_super], 0, index) <= -1) return -1; +printf ("\tsend message %d with 0 arguments to %s\n", (int)index, (to_super? "super": "self")); } return 0; @@ -2412,28 +2409,40 @@ static int compile_binary_message (stix_t* stix, int to_super) stix_size_t index; int to_super2; stix_ucs_t binsel; + stix_size_t saved_binsels_len; if (compile_unary_message(stix, to_super) <= -1) return -1; while (stix->c->tok.type == STIX_IOTOK_BINSEL) { binsel = stix->c->tok.name; - if (clone_binary_selector(stix, &binsel) <= -1) return -1; + saved_binsels_len = stix->c->mth.binsels.len; + + if (clone_binary_selector(stix, &binsel) <= -1) goto oops; GET_TOKEN (stix); if (compile_expression_primary(stix, STIX_NULL, STIX_NULL, &to_super2) <= -1 || compile_unary_message(stix, to_super2) <= -1 || - add_symbol_literal(stix, &binsel, &index) <= -1 || - emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) - { - stix->c->mth.binsels.len -= binsel.len; - return -1; - } -printf ("send message %d with 1 arguments%s\n", (int)index, (to_super? " to super": "")); - stix->c->mth.binsels.len -= binsel.len; + add_symbol_literal(stix, &binsel, &index) <= -1) goto oops; + +if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) printf ("\tdup_stack for cascading\n"); + /* check ahead message cascading */ + if (stix->c->tok.type == STIX_IOTOK_SEMICOLON && + emit_byte_instruction(stix, CODE_DUP_STACKTOP) <= -1) goto oops; + + if (emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) goto oops; +printf ("\tsend message %d with 1 arguments%s\n", (int)index, (to_super? " to super": "")); + + /*stix->c->mth.binsels.len -= binsel.len;*/ + stix->c->mth.binsels.len = saved_binsels_len; } return 0; + +oops: + /*stix->c->mth.binsels.len -= binsel.len;*/ + stix->c->mth.binsels.len -= saved_binsels_len; + return -1; } static int compile_keyword_message (stix_t* stix, int to_super) @@ -2456,7 +2465,6 @@ static int compile_keyword_message (stix_t* stix, int to_super) kwsel_loc = stix->c->tok.loc; kwsel_len = stix->c->mth.kwsels.len; - do { kw = stix->c->tok.name; @@ -2468,7 +2476,11 @@ static int compile_keyword_message (stix_t* stix, int to_super) if (nargs >= MAX_CODE_NARGS) { - set_syntax_error (stix, STIX_SYNERR_ARGFLOOD, &kwsel_loc, &kwsel); + /* 'kw' points to only one segment of the full keyword message. + * if it parses an expression like 'aBlock value: 10 with: 20', + * 'kw' may point to 'value:' or 'with:'. + */ + set_syntax_error (stix, STIX_SYNERR_ARGFLOOD, &kwsel_loc, &kw); goto oops; } @@ -2479,9 +2491,15 @@ static int compile_keyword_message (stix_t* stix, int to_super) kwsel.ptr = &stix->c->mth.kwsels.ptr[kwsel_len]; kwsel.len = stix->c->mth.kwsels.len - kwsel_len; - if (add_symbol_literal(stix, &kwsel, &index) <= -1 || - emit_double_positional_instruction(stix, send_message_cmd[to_super], nargs, index) <= -1) goto oops; -printf ("\tSend message %d [", (int)index); + if (add_symbol_literal(stix, &kwsel, &index) <= -1) goto oops; + +if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) printf ("\tdup_stack for cascading\n"); + + if (stix->c->tok.type == STIX_IOTOK_SEMICOLON && + emit_byte_instruction(stix, CODE_DUP_STACKTOP) <= -1) goto oops; + + if (emit_double_positional_instruction(stix, send_message_cmd[to_super], nargs, index) <= -1) goto oops; +printf ("\tsend message %d [", (int)index); print_ucs (&kwsel); printf ("] with %d arguments to %s\n", (int)nargs, (to_super? "super": "self")); stix->c->mth.kwsels.len = kwsel_len; @@ -2491,6 +2509,129 @@ oops: stix->c->mth.kwsels.len = kwsel_len; return -1; } +#endif + +static int compile_unary_message (stix_t* stix, int to_super) +{ + stix_size_t index; + + STIX_ASSERT (stix->c->tok.type == STIX_IOTOK_IDENT); + + do + { +printf ("adding binary symbol..."); +print_ucs (&stix->c->tok.name); +printf ("\n"); + if (add_symbol_literal(stix, &stix->c->tok.name, &index) <= -1 || + emit_double_positional_instruction(stix, send_message_cmd[to_super], 0, index) <= -1) return -1; +printf ("\tsend message %d with 0 arguments to %s\n", (int)index, (to_super? "super": "self")); + + GET_TOKEN (stix); + } + while (stix->c->tok.type == STIX_IOTOK_IDENT); + + return 0; +} + +static int compile_binary_message (stix_t* stix, int to_super) +{ + /* + * binary-message := binary-selector binary-argument + * binary-argument := expression-primary unary-message* + */ + stix_size_t index; + int to_super2; + stix_ucs_t binsel; + stix_size_t saved_binsels_len; + + STIX_ASSERT (stix->c->tok.type == STIX_IOTOK_BINSEL); + + do + { + binsel = stix->c->tok.name; + saved_binsels_len = stix->c->mth.binsels.len; + + if (clone_binary_selector(stix, &binsel) <= -1) goto oops; + + GET_TOKEN (stix); + + if (compile_expression_primary(stix, STIX_NULL, STIX_NULL, &to_super2) <= -1) goto oops; + + if (stix->c->tok.type == STIX_IOTOK_IDENT && compile_unary_message(stix, to_super2) <= -1) goto oops; + + if (add_symbol_literal(stix, &binsel, &index) <= -1 || + emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) goto oops; +printf ("\tsend message %d with 1 arguments%s\n", (int)index, (to_super? " to super": "")); + + stix->c->mth.binsels.len = saved_binsels_len; + } + while (stix->c->tok.type == STIX_IOTOK_BINSEL); + + return 0; + +oops: + stix->c->mth.binsels.len = saved_binsels_len; + return -1; +} + +static int compile_keyword_message (stix_t* stix, int to_super) +{ + /* + * keyword-message := (keyword keyword-argument)+ + * keyword-argument := expression-primary unary-message* binary-message* + */ + + stix_size_t index; + int to_super2; + stix_ucs_t kw, kwsel; + stix_ioloc_t saved_kwsel_loc; + stix_size_t saved_kwsel_len; + stix_size_t nargs = 0; + + saved_kwsel_loc = stix->c->tok.loc; + saved_kwsel_len = stix->c->mth.kwsels.len; + + do + { + kw = stix->c->tok.name; + if (clone_keyword(stix, &kw) <= -1) goto oops; + + GET_TOKEN (stix); + + if (compile_expression_primary(stix, STIX_NULL, STIX_NULL, &to_super2) <= -1) goto oops; + if (stix->c->tok.type == STIX_IOTOK_IDENT && compile_unary_message(stix, to_super2) <= -1) goto oops; + if (stix->c->tok.type == STIX_IOTOK_BINSEL && compile_binary_message(stix, to_super2) <= -1) goto oops; + + if (nargs >= MAX_CODE_NARGS) + { + /* 'kw' points to only one segment of the full keyword message. + * if it parses an expression like 'aBlock value: 10 with: 20', + * 'kw' may point to 'value:' or 'with:'. + */ + set_syntax_error (stix, STIX_SYNERR_ARGFLOOD, &saved_kwsel_loc, &kw); + goto oops; + } + + nargs++; + } + while (stix->c->tok.type == STIX_IOTOK_KEYWORD); + + kwsel.ptr = &stix->c->mth.kwsels.ptr[saved_kwsel_len]; + kwsel.len = stix->c->mth.kwsels.len - saved_kwsel_len; + + if (add_symbol_literal(stix, &kwsel, &index) <= -1 || + emit_double_positional_instruction(stix, send_message_cmd[to_super], nargs, index) <= -1) goto oops; + +printf ("\tsend message %d [", (int)index); +print_ucs (&kwsel); +printf ("] with %d arguments to %s\n", (int)nargs, (to_super? "super": "self")); + stix->c->mth.kwsels.len = saved_kwsel_len; + return 0; + +oops: + stix->c->mth.kwsels.len = saved_kwsel_len; + return -1; +} static int compile_message_expression (stix_t* stix, int to_super) { @@ -2507,23 +2648,104 @@ static int compile_message_expression (stix_t* stix, int to_super) * binary-argument := expression-primary unary-message* * unary-message := unary-selector * cascaded-message := (";" single-message)* - * cascaded-message := (";" single-message)* */ + stix_size_t noop_pos; + do + { + switch (stix->c->tok.type) + { + case STIX_IOTOK_IDENT: + /* insert NOOP to change to DUP_STACKTOP if there is a + * cascaded message */ + noop_pos = stix->c->mth.code.len; + if (emit_byte_instruction(stix, CODE_NOOP) <= -1) return -1; + + if (compile_unary_message(stix, to_super) <= -1) return -1; + + if (stix->c->tok.type == STIX_IOTOK_BINSEL) + { + STIX_ASSERT (stix->c->mth.code.len > noop_pos); + STIX_MEMMOVE (&stix->c->mth.code.ptr[noop_pos], &stix->c->mth.code.ptr[noop_pos + 1], stix->c->mth.code.len - noop_pos - 1); + stix->c->mth.code.len--; + + noop_pos = stix->c->mth.code.len; + if (emit_byte_instruction(stix, CODE_NOOP) <= -1) return -1; + if (compile_binary_message(stix, to_super) <= -1) return -1; + } + if (stix->c->tok.type == STIX_IOTOK_KEYWORD) + { + STIX_ASSERT (stix->c->mth.code.len > noop_pos); + STIX_MEMMOVE (&stix->c->mth.code.ptr[noop_pos], &stix->c->mth.code.ptr[noop_pos + 1], stix->c->mth.code.len - noop_pos - 1); + stix->c->mth.code.len--; + + noop_pos = stix->c->mth.code.len; + if (emit_byte_instruction(stix, CODE_NOOP) <= -1) return -1; + if (compile_keyword_message(stix, to_super) <= -1) return -1; + } + break; + + case STIX_IOTOK_BINSEL: + noop_pos = stix->c->mth.code.len; + if (emit_byte_instruction(stix, CODE_NOOP) <= -1) return -1; + + if (compile_binary_message(stix, to_super) <= -1) return -1; + if (stix->c->tok.type == STIX_IOTOK_KEYWORD) + { + STIX_ASSERT (stix->c->mth.code.len > noop_pos); + STIX_MEMMOVE (&stix->c->mth.code.ptr[noop_pos], &stix->c->mth.code.ptr[noop_pos + 1], stix->c->mth.code.len - noop_pos - 1); + stix->c->mth.code.len--; + + noop_pos = stix->c->mth.code.len; + if (emit_byte_instruction(stix, CODE_NOOP) <= -1) return -1; + + if (compile_keyword_message(stix, to_super) <= -1) return -1; + } + break; + + case STIX_IOTOK_KEYWORD: + noop_pos = stix->c->mth.code.len; + if (emit_byte_instruction(stix, CODE_NOOP) <= -1) return -1; + + if (compile_keyword_message(stix, to_super) <= -1) return -1; + break; + + default: + goto done; + + } + + if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) + { + printf ("\tdup_stacktop for cascading\n"); + stix->c->mth.code.ptr[noop_pos] = CODE_DUP_STACKTOP; + if (emit_byte_instruction(stix, CODE_POP_STACKTOP) <= -1) return -1; + GET_TOKEN(stix); + } + else + { + /* delete the NOOP instruction inserted */ + STIX_ASSERT (stix->c->mth.code.len > noop_pos); + STIX_MEMMOVE (&stix->c->mth.code.ptr[noop_pos], &stix->c->mth.code.ptr[noop_pos + 1], stix->c->mth.code.len - noop_pos - 1); + stix->c->mth.code.len--; + goto done; + } + } + while (1); + +#if 0 if (compile_keyword_message(stix, to_super) <= -1) return -1; while (stix->c->tok.type == STIX_IOTOK_SEMICOLON) { - /* handle message cascading */ -printf ("TODO: DoSpecial(DUP_RECEIVER(CASCADE)) ....\n"); -/*T ODO: emit code */ + printf ("\tpop_stacktop for cascading\n"); + if (emit_byte_instruction(stix, CODE_POP_STACKTOP) <= -1) return -1; GET_TOKEN (stix); - if (compile_keyword_message(stix, 0) <= -1) return -1; -printf ("\tTODO: DoSpecial(POP_TOP) ....\n"); -/*T ODO: emit code */ } +#endif +done: return 0; } @@ -2537,7 +2759,8 @@ static int compile_basic_expression (stix_t* stix, const stix_ucs_t* ident, cons if (compile_expression_primary(stix, ident, ident_loc, &to_super) <= -1) return -1; if (stix->c->tok.type != STIX_IOTOK_EOF && stix->c->tok.type != STIX_IOTOK_RBRACE && - stix->c->tok.type != STIX_IOTOK_PERIOD) + stix->c->tok.type != STIX_IOTOK_PERIOD && + stix->c->tok.type != STIX_IOTOK_SEMICOLON) { if (compile_message_expression(stix, to_super) <= -1) return -1; } diff --git a/stix/lib/exec.c b/stix/lib/exec.c index 85443d6..7890fea 100644 --- a/stix/lib/exec.c +++ b/stix/lib/exec.c @@ -39,22 +39,22 @@ #define STORE_ACTIVE_SP(stix) STORE_SP(stix, (stix)->active_context) -#define STACK_PUSH(stix,v) \ +#define ACTIVE_STACK_PUSH(stix,v) \ do { \ (stix)->sp = (stix)->sp + 1; \ (stix)->active_context->slot[(stix)->sp] = v; \ } while (0) -#define STACK_POP(stix) ((stix)->sp = (stix)->sp - 1) -#define STACK_UNPOP(stix) ((stix)->sp = (stix)->sp + 1) -#define STACK_POPS(stix,count) ((stix)->sp = (stix)->sp - (count)) +#define ACTIVE_STACK_POP(stix) ((stix)->sp = (stix)->sp - 1) +#define ACTIVE_STACK_UNPOP(stix) ((stix)->sp = (stix)->sp + 1) +#define ACTIVE_STACK_POPS(stix,count) ((stix)->sp = (stix)->sp - (count)) -#define STACK_GET(stix,v_sp) ((stix)->active_context->slot[v_sp]) -#define STACK_SET(stix,v_sp,v_obj) ((stix)->active_context->slot[v_sp] = v_obj) -#define STACK_GETTOP(stix) STACK_GET(stix, (stix)->sp) -#define STACK_SETTOP(stix,v_obj) STACK_SET(stix, (stix)->sp, v_obj) +#define ACTIVE_STACK_GET(stix,v_sp) ((stix)->active_context->slot[v_sp]) +#define ACTIVE_STACK_SET(stix,v_sp,v_obj) ((stix)->active_context->slot[v_sp] = v_obj) +#define ACTIVE_STACK_GETTOP(stix) ACTIVE_STACK_GET(stix, (stix)->sp) +#define ACTIVE_STACK_SETTOP(stix,v_obj) ACTIVE_STACK_SET(stix, (stix)->sp, v_obj) -#define STACK_ISEMPTY(stix) ((stix)->sp <= -1) +#define ACTIVE_STACK_ISEMPTY(stix) ((stix)->sp <= -1) #define SWITCH_ACTIVE_CONTEXT(stix,v_ctx) \ do \ @@ -136,6 +136,7 @@ static int activate_new_method (stix_t* stix, stix_oop_method_t mth) * if no temporaries exist, the initial sp is -1. */ ctx->sp = STIX_OOP_FROM_SMINT(ntmprs - 1); + ctx->ntmprs = STIX_OOP_FROM_SMINT(ntmprs); ctx->method = mth; /*ctx->home = stix->_nil;*/ ctx->origin = ctx; /* point to self */ @@ -164,12 +165,12 @@ static int activate_new_method (stix_t* stix, stix_oop_method_t mth) for (i = nargs; i > 0; ) { /* copy argument */ - ctx->slot[--i] = STACK_GETTOP (stix); - STACK_POP (stix); + ctx->slot[--i] = ACTIVE_STACK_GETTOP (stix); + ACTIVE_STACK_POP (stix); } /* copy receiver */ - ctx->receiver = STACK_GETTOP (stix); - STACK_POP (stix); + ctx->receiver = ACTIVE_STACK_GETTOP (stix); + ACTIVE_STACK_POP (stix); STIX_ASSERT (stix->sp >= -1); @@ -294,7 +295,7 @@ TODO: overcome this problem STIX_ASSERT (stix->active_context == STIX_NULL); /* i can't use SWITCH_ACTIVE_CONTEXT() macro as there is no active context before switching */ stix->active_context = ctx; - STACK_PUSH (stix, ass->value); /* push the receiver */ + ACTIVE_STACK_PUSH (stix, ass->value); /* push the receiver */ STORE_ACTIVE_IP (stix); STORE_ACTIVE_SP (stix); @@ -310,17 +311,17 @@ static int primitive_dump (stix_t* stix, stix_ooi_t nargs) STIX_ASSERT (nargs >= 0); printf ("RECEIVER:"); - print_object (stix, STACK_GET(stix, stix->sp - nargs)); + print_object (stix, ACTIVE_STACK_GET(stix, stix->sp - nargs)); printf ("\n"); for (i = nargs; i > 0; ) { --i; printf ("ARGUMENT:"); - print_object (stix, STACK_GET(stix, stix->sp - i)); + print_object (stix, ACTIVE_STACK_GET(stix, stix->sp - i)); printf ("\n"); } - STACK_POPS (stix, nargs); + ACTIVE_STACK_POPS (stix, nargs); return 1; /* success */ } @@ -330,7 +331,7 @@ static int primitive_new (stix_t* stix, stix_ooi_t nargs) STIX_ASSERT (nargs == 0); - rcv = STACK_GETTOP (stix); + rcv = ACTIVE_STACK_GETTOP (stix); if (STIX_CLASSOF(stix, rcv) != stix->_class) { @@ -342,7 +343,7 @@ static int primitive_new (stix_t* stix, stix_ooi_t nargs) if (!obj) return -1; /* emulate 'pop receiver' and 'push result' */ - STACK_SETTOP (stix, obj); + ACTIVE_STACK_SETTOP (stix, obj); return 1; /* success */ } @@ -353,14 +354,14 @@ static int primitive_new_with_size (stix_t* stix, stix_ooi_t nargs) STIX_ASSERT (nargs == 1); - rcv = STACK_GET(stix, stix->sp - 1); + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); if (STIX_CLASSOF(stix, rcv) != stix->_class) { /* the receiver is not a class object */ return 0; } - szoop = STACK_GET(stix, stix->sp); + szoop = ACTIVE_STACK_GET(stix, stix->sp); if (STIX_OOP_IS_SMINT(szoop)) { size = STIX_OOP_TO_SMINT(szoop); @@ -384,8 +385,8 @@ static int primitive_new_with_size (stix_t* stix, stix_ooi_t nargs) /* remove the argument and replace the receiver with a new object * instantiated */ - STACK_POP (stix); - STACK_SETTOP (stix, obj); + ACTIVE_STACK_POP (stix); + ACTIVE_STACK_SETTOP (stix, obj); return 1; /* success */ } @@ -396,8 +397,8 @@ static int primitive_basic_size (stix_t* stix, stix_ooi_t nargs) STIX_ASSERT (nargs == 0); - rcv = STACK_GETTOP(stix); - STACK_SETTOP(stix, STIX_OOP_FROM_SMINT(STIX_OBJ_GET_SIZE(rcv))); + rcv = ACTIVE_STACK_GETTOP(stix); + ACTIVE_STACK_SETTOP(stix, STIX_OOP_FROM_SMINT(STIX_OBJ_GET_SIZE(rcv))); /* TODO: use LargeInteger if the size is very big */ return 1; } @@ -409,14 +410,14 @@ static int primitive_basic_at (stix_t* stix, stix_ooi_t nargs) STIX_ASSERT (nargs == 1); - rcv = STACK_GET(stix, stix->sp - 1); + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); if (!STIX_OOP_IS_POINTER(rcv)) { /* the receiver is a special numeric object, not a normal pointer */ return 0; } - pos = STACK_GET(stix, stix->sp); + pos = ACTIVE_STACK_GET(stix, stix->sp); if (!STIX_OOP_IS_SMINT(pos)) { /* TODO: handle LargeInteger */ @@ -458,8 +459,8 @@ static int primitive_basic_at (stix_t* stix, stix_ooi_t nargs) return -1; } - STACK_POP (stix); - STACK_SETTOP (stix, v); + ACTIVE_STACK_POP (stix); + ACTIVE_STACK_SETTOP (stix, v); return 1; } @@ -472,14 +473,14 @@ static int primitive_basic_at_put (stix_t* stix, stix_ooi_t nargs) /* TODO: disallow change of some key kernel objects */ - rcv = STACK_GET(stix, stix->sp - 2); + rcv = ACTIVE_STACK_GET(stix, stix->sp - 2); if (!STIX_OOP_IS_POINTER(rcv)) { /* the receiver is a special numeric object, not a normal pointer */ return 0; } - pos = STACK_GET(stix, stix->sp - 1); + pos = ACTIVE_STACK_GET(stix, stix->sp - 1); if (!STIX_OOP_IS_SMINT(pos)) { /* TODO: handle LargeInteger */ @@ -487,7 +488,7 @@ static int primitive_basic_at_put (stix_t* stix, stix_ooi_t nargs) return 0; } - val = STACK_GET(stix, stix->sp); + val = ACTIVE_STACK_GET(stix, stix->sp); idx = STIX_OOP_TO_SMINT(pos); if (idx < 1 || idx > STIX_OBJ_GET_SIZE(rcv)) @@ -540,30 +541,72 @@ static int primitive_basic_at_put (stix_t* stix, stix_ooi_t nargs) return -1; } - STACK_POPS (stix, 2); + ACTIVE_STACK_POPS (stix, 2); /* TODO: return receiver or value? */ - STACK_SETTOP (stix, val); + ACTIVE_STACK_SETTOP (stix, val); return 1; } static int primitive_block_context_value (stix_t* stix, stix_ooi_t nargs) { - stix_oop_block_context_t blkctx; + stix_oop_block_context_t blkctx, org_blkctx; + stix_ooi_t local_ntmprs, i; - blkctx = (stix_oop_block_context_t)STACK_GET(stix, stix->sp - nargs); - STIX_ASSERT (STIX_CLASSOF(stix, blkctx) == stix->_block_context); + /* TODO: find a better way to support a reentrant block context. */ - if (STIX_OOP_TO_SMINT(blkctx->nargs) != nargs) + /* | sum | + * sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ]. + * (sum value: 10). + * + * For the code above, sum is a block context and it is sent value: inside + * itself. Let me simply clone a block context to allow reentrancy like this + * while the block context is active + */ + org_blkctx = (stix_oop_block_context_t)ACTIVE_STACK_GET(stix, stix->sp - nargs); + STIX_ASSERT (STIX_CLASSOF(stix, org_blkctx) == stix->_block_context); + + if (STIX_OOP_TO_SMINT(org_blkctx->nargs) != nargs) { /* the number of argument doesn't match */ +/* TODO: better handling of primitive failure */ printf ("PRIM BlockContext value FAIL - NARGS MISMATCH\n"); return 0; } - STACK_POPS (stix, nargs + 1); /* pop arguments and receiver */ +/* TODO: what is the right stack size? is 255 too large? any good way to determine it? */ + /* create a new block context to clone org_blkctx */ + blkctx = (stix_oop_block_context_t) stix_instantiate (stix, stix->_block_context, STIX_NULL, 255); + if (!blkctx) return -1; - blkctx->ip = blkctx->iip; - blkctx->sp = STIX_OOP_FROM_SMINT(nargs); + org_blkctx = (stix_oop_block_context_t)ACTIVE_STACK_GET(stix, stix->sp - nargs); /* to be GC-safe */ + STIX_ASSERT (STIX_CLASSOF(stix, org_blkctx) == stix->_block_context); + + /* shallow-copy the named part. leave the stack part untouched. + * the stack is set up futher down */ + for (i = 0; i < STIX_BLOCK_CONTEXT_NAMED_INSTVARS; i++) + { + ((stix_oop_oop_t)blkctx)->slot[i] = ((stix_oop_oop_t)org_blkctx)->slot[i]; + } + +/* TODO: check the stack size of a block context to see if it's large enough to hold arguments */ + for (i = 0; i < nargs; i++) + { + blkctx->slot[i] = ACTIVE_STACK_GET(stix, stix->sp - nargs + i + 1); + } + ACTIVE_STACK_POPS (stix, nargs + 1); /* pop arguments and receiver */ + + /*blkctx->ip = blkctx->iip;*/ + + STIX_ASSERT (blkctx->home != stix->_nil); + + /* the number of temporaries stored in the block context + * accumulates the number of temporaries starting from the origin. + * simple calculation is needed to find the number of local temporaries */ + local_ntmprs = STIX_OOP_TO_SMINT(blkctx->ntmprs) - + STIX_OOP_TO_SMINT(((stix_oop_context_t)blkctx->home)->ntmprs); + STIX_ASSERT (local_ntmprs >= nargs); + + blkctx->sp = STIX_OOP_FROM_SMINT(local_ntmprs); blkctx->caller = (stix_oop_t)stix->active_context; SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)blkctx); @@ -577,16 +620,16 @@ static int primitive_integer_add (stix_t* stix, stix_ooi_t nargs) STIX_ASSERT (nargs == 1); - rcv = STACK_GET(stix, stix->sp - 1); - arg = STACK_GET(stix, stix->sp); + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); + arg = ACTIVE_STACK_GET(stix, stix->sp); if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg)) { tmp = STIX_OOP_TO_SMINT(rcv) + STIX_OOP_TO_SMINT(arg); /* TODO: check overflow. if so convert it to LargeInteger */ - STACK_POP (stix); - STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(tmp)); + ACTIVE_STACK_POP (stix); + ACTIVE_STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(tmp)); return 1; } @@ -594,6 +637,87 @@ static int primitive_integer_add (stix_t* stix, stix_ooi_t nargs) return 0; } +static int primitive_integer_sub (stix_t* stix, stix_ooi_t nargs) +{ + stix_ooi_t tmp; + stix_oop_t rcv, arg; + + STIX_ASSERT (nargs == 1); + + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); + arg = ACTIVE_STACK_GET(stix, stix->sp); + + if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg)) + { + tmp = STIX_OOP_TO_SMINT(rcv) - STIX_OOP_TO_SMINT(arg); + /* TODO: check overflow. if so convert it to LargeInteger */ + + ACTIVE_STACK_POP (stix); + ACTIVE_STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(tmp)); + return 1; + } + +/* TODO: handle LargeInteger */ + return 0; +} + +static int primitive_integer_lt (stix_t* stix, stix_ooi_t nargs) +{ + stix_oop_t rcv, arg; + + STIX_ASSERT (nargs == 1); + + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); + arg = ACTIVE_STACK_GET(stix, stix->sp); + + if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg)) + { + ACTIVE_STACK_POP (stix); + if (STIX_OOP_TO_SMINT(rcv) < STIX_OOP_TO_SMINT(arg)) + { + ACTIVE_STACK_SETTOP (stix, stix->_true); + } + else + { + ACTIVE_STACK_SETTOP (stix, stix->_false); + } + + return 1; + } + +/* TODO: handle LargeInteger */ + return 0; +} + +static int primitive_integer_gt (stix_t* stix, stix_ooi_t nargs) +{ + stix_oop_t rcv, arg; + + STIX_ASSERT (nargs == 1); + + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); + arg = ACTIVE_STACK_GET(stix, stix->sp); + + if (STIX_OOP_IS_SMINT(rcv) && STIX_OOP_IS_SMINT(arg)) + { + ACTIVE_STACK_POP (stix); + if (STIX_OOP_TO_SMINT(rcv) > STIX_OOP_TO_SMINT(arg)) + { + ACTIVE_STACK_SETTOP (stix, stix->_true); + } + else + { + ACTIVE_STACK_SETTOP (stix, stix->_false); + } + + return 1; + } + +/* TODO: handle LargeInteger */ + return 0; +} + + typedef int (*primitive_handler_t) (stix_t* stix, stix_ooi_t nargs); struct primitive_t @@ -613,6 +737,9 @@ static primitive_t primitives[] = { 2, primitive_basic_at_put }, { -1, primitive_block_context_value }, { 1, primitive_integer_add }, + { 1, primitive_integer_sub }, + { 1, primitive_integer_lt }, + { 1, primitive_integer_gt } }; int stix_execute (stix_t* stix) @@ -630,7 +757,9 @@ int stix_execute (stix_t* stix) mth = stix->active_context->origin->method; code = mth->code; +#if 0 printf ("IP => %d ", (int)stix->ip); +#endif bc = code->slot[stix->ip++]; /*if (bc == CODE_NOOP) continue; TODO: DO I NEED THIS???*/ @@ -658,41 +787,120 @@ printf ("IP => %d ", (int)stix->ip); b1 = bc & 0xF; } +#if 0 printf ("CMD => %d, B1 = %d, SP = %d, IP AFTER INC %d\n", (int)cmd, (int)b1, (int)stix->sp, (int)stix->ip); +#endif switch (cmd) { case CMD_PUSH_INSTVAR: printf ("PUSH_INSTVAR %d\n", (int)b1); STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(stix->active_context->receiver) == STIX_OBJ_TYPE_OOP); - STACK_PUSH (stix, ((stix_oop_oop_t)stix->active_context->origin->receiver)->slot[b1]); + ACTIVE_STACK_PUSH (stix, ((stix_oop_oop_t)stix->active_context->origin->receiver)->slot[b1]); break; case CMD_PUSH_TEMPVAR: /* TODO: consider temp offset, block context, etc */ printf ("PUSH_TEMPVAR idx=%d - ", (int)b1); -print_object (stix, STACK_GET(stix, b1)); + if (stix->active_context->home != stix->_nil) + { +/*TODO: improve this slow temporary access */ + /* this code assuments that the method context and + * the block context places some key fields in the + * same offset. such fields include 'home', 'ntmprs' */ + stix_oop_context_t ctx; + stix_oop_t home; + stix_ooi_t home_ntmprs; + + ctx = stix->active_context; + home = ctx->home; + + do + { + home_ntmprs = STIX_OOP_TO_SMINT(((stix_oop_context_t)home)->ntmprs); + if (b1 >= home_ntmprs) break; + + ctx = (stix_oop_context_t)home; + home = ((stix_oop_context_t)home)->home; + if (home == stix->_nil) + { + home_ntmprs = 0; + break; + } + } + while (1); + +print_object (stix, ctx->slot[b1 - home_ntmprs]); printf ("\n"); - STACK_PUSH (stix, STACK_GET(stix, b1)); + +printf (" XXCTX %p STACK TEMPVAR PTR=>%p ADJOFF=%d B1=%d HOME_NTMPRS=%d\n", ctx, &ctx->slot[b1-home_ntmprs], (int)(b1 - home_ntmprs), (int)b1, (int)home_ntmprs); + ACTIVE_STACK_PUSH (stix, ctx->slot[b1 - home_ntmprs]); + } + else + { +print_object (stix, ACTIVE_STACK_GET(stix, b1)); +printf ("\n"); + +printf (" YYCTX %p STACK TEMPVAR PTR=>%p ADJOFF=%d\n", stix->active_context, &stix->active_context->slot[b1], (int)b1); + ACTIVE_STACK_PUSH (stix, ACTIVE_STACK_GET(stix, b1)); + } + break; case CMD_PUSH_LITERAL: printf ("PUSH_LITERAL idx=%d - ", (int)b1); print_object (stix, stix->active_context->origin->method->slot[b1]); printf ("\n"); - STACK_PUSH (stix, stix->active_context->origin->method->slot[b1]); + ACTIVE_STACK_PUSH (stix, stix->active_context->origin->method->slot[b1]); break; case CMD_STORE_INTO_INSTVAR: printf ("STORE_INSTVAR %d\n", (int)b1); STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(stix->active_context->receiver) == STIX_OBJ_TYPE_OOP); - ((stix_oop_oop_t)stix->active_context->origin->receiver)->slot[b1] = STACK_GETTOP(stix); + ((stix_oop_oop_t)stix->active_context->origin->receiver)->slot[b1] = ACTIVE_STACK_GETTOP(stix); break; case CMD_STORE_INTO_TEMPVAR: -printf ("STORE_TEMPVAR %d\n", (int)b1); /* TODO: consider temp offset block context etc */ - STACK_SET (stix, b1, STACK_GETTOP(stix)); +printf ("STORE_TEMPVAR idx=%d - ", (int)b1); +print_object (stix, ACTIVE_STACK_GETTOP(stix)); +printf ("\n"); + if (stix->active_context->home != stix->_nil) + { +/*TODO: improve this slow temporary access */ + /* this code assuments that the method context and + * the block context places some key fields in the + * same offset. such fields include 'home', 'ntmprs' */ + stix_oop_context_t ctx; + stix_oop_t home; + stix_ooi_t home_ntmprs; + + ctx = stix->active_context; + home = ctx->home; + + do + { + home_ntmprs = STIX_OOP_TO_SMINT(((stix_oop_context_t)home)->ntmprs); + if (b1 >= home_ntmprs) break; + + ctx = (stix_oop_context_t)home; + home = ((stix_oop_context_t)home)->home; + if (home == stix->_nil) + { + home_ntmprs = 0; + break; + } + } + while (1); + +printf (" XXCTX %p STACK TEMPVAR PTR=>%p ADJOFF=%d B1=%d HOME_NTMPRS=%d\n", ctx, &ctx->slot[b1-home_ntmprs], (int)(b1 - home_ntmprs), (int)b1, (int)home_ntmprs); + ctx->slot[b1 - home_ntmprs] = ACTIVE_STACK_GETTOP(stix); + } + else + { +printf (" YYCTX %p STACK TEMPVAR PTR=>%p ADJOFF=%d\n", stix->active_context, &stix->active_context->slot[b1], (int)b1); + ACTIVE_STACK_SET (stix, b1, ACTIVE_STACK_GETTOP(stix)); + } break; /* -------------------------------------------------------- */ @@ -725,7 +933,7 @@ printf ("PUSH OBJVAR index=%d object_index_in_literal_frame=%d - ", (int)b1, (in STIX_ASSERT (obj_index < STIX_OBJ_GET_SIZE(obj)); print_object (stix, obj->slot[b1]); printf ("\n"); - STACK_PUSH (stix, obj->slot[b1]); + ACTIVE_STACK_PUSH (stix, obj->slot[b1]); break; } @@ -741,7 +949,7 @@ printf ("STORE OBJVAR index=%d object_index_in_literal_frame=%d - ", (int)b1, (i obj = (stix_oop_oop_t)stix->active_context->origin->method->slot[obj_index]; STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(obj) == STIX_OBJ_TYPE_OOP); STIX_ASSERT (obj_index < STIX_OBJ_GET_SIZE(obj)); - obj->slot[b1] = STACK_GETTOP(stix); + obj->slot[b1] = ACTIVE_STACK_GETTOP(stix); print_object (stix, obj->slot[b1]); printf ("\n"); break; @@ -771,12 +979,12 @@ printf ("\n"); selector = (stix_oop_char_t)stix->active_context->origin->method->slot[selector_index]; if (cmd == CMD_SEND_MESSAGE) -printf ("SEND_MESSAGE TO RECEIVER AT %d NARGS=%d\n", (int)(stix->sp - b1), (int)b1); +printf ("SEND_MESSAGE TO RECEIVER AT STACKPOS=%d NARGS=%d RECEIER=", (int)(stix->sp - b1), (int)b1); else -printf ("SEND_MESSAGE_TO_SUPER TO RECEIVER AT %d NARGS=%d\n", (int)(stix->sp - b1), (int)b1); +printf ("SEND_MESSAGE_TO_SUPER TO RECEIVER AT STACKPOS=%d NARGS=%d RECEIVER=", (int)(stix->sp - b1), (int)b1); STIX_ASSERT (STIX_CLASSOF(stix, selector) == stix->_symbol); - newrcv = STACK_GET(stix, stix->sp - b1); + newrcv = ACTIVE_STACK_GET(stix, stix->sp - b1); print_object(stix, newrcv); printf ("\n"); mthname.ptr = selector->slot; @@ -798,21 +1006,21 @@ printf ("]\n"); { case STIX_METHOD_PREAMBLE_RETURN_RECEIVER: printf ("RETURN RECEIVER AT PREAMBLE\n"); - STACK_POPS (stix, b1); /* pop arguments only*/ + ACTIVE_STACK_POPS (stix, b1); /* pop arguments only*/ break; case STIX_METHOD_PREAMBLE_RETURN_INSTVAR: { stix_oop_oop_t rcv; - STACK_POPS (stix, b1); /* pop arguments only */ + ACTIVE_STACK_POPS (stix, b1); /* pop arguments only */ printf ("RETURN INSTVAR AT PREAMBLE\n"); /* replace the receiver by an instance variable of the receiver */ - rcv = (stix_oop_oop_t)STACK_GETTOP(stix); + rcv = (stix_oop_oop_t)ACTIVE_STACK_GETTOP(stix); STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(rcv) == STIX_OBJ_TYPE_OOP); STIX_ASSERT (STIX_OBJ_GET_SIZE(rcv) > STIX_METHOD_GET_PREAMBLE_INDEX(preamble)); - STACK_SET (stix, stix->sp, rcv->slot[STIX_METHOD_GET_PREAMBLE_INDEX(preamble)]); + ACTIVE_STACK_SET (stix, stix->sp, rcv->slot[STIX_METHOD_GET_PREAMBLE_INDEX(preamble)]); break; } @@ -850,42 +1058,42 @@ printf ("RETURN INSTVAR AT PREAMBLE\n"); { case SUBCMD_PUSH_RECEIVER: printf ("PUSH_RECEIVER %p TO STACK INDEX %d\n", stix->active_context->origin->receiver, (int)stix->sp); - STACK_PUSH (stix, stix->active_context->origin->receiver); + ACTIVE_STACK_PUSH (stix, stix->active_context->origin->receiver); break; case SUBCMD_PUSH_NIL: printf ("PUSH_NIL\n"); - STACK_PUSH (stix, stix->_nil); + ACTIVE_STACK_PUSH (stix, stix->_nil); break; case SUBCMD_PUSH_TRUE: printf ("PUSH_TRUE\n"); - STACK_PUSH (stix, stix->_true); + ACTIVE_STACK_PUSH (stix, stix->_true); break; case SUBCMD_PUSH_FALSE: printf ("PUSH_FALSE\n"); - STACK_PUSH (stix, stix->_false); + ACTIVE_STACK_PUSH (stix, stix->_false); break; case SUBCMD_PUSH_CONTEXT: printf ("PUSH_CONTEXT\n"); - STACK_PUSH (stix, (stix_oop_t)stix->active_context); + ACTIVE_STACK_PUSH (stix, (stix_oop_t)stix->active_context); break; case SUBCMD_PUSH_NEGONE: printf ("PUSH_NEGONE\n"); - STACK_PUSH (stix, STIX_OOP_FROM_SMINT(-1)); + ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(-1)); break; case SUBCMD_PUSH_ZERO: printf ("PUSH_ZERO\n"); - STACK_PUSH (stix, STIX_OOP_FROM_SMINT(0)); + ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(0)); break; case SUBCMD_PUSH_ONE: printf ("PUSH_SMINT\n"); - STACK_PUSH (stix, STIX_OOP_FROM_SMINT(1)); + ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(1)); break; } break; /* CMD_PUSH_SPECIAL */ @@ -898,16 +1106,26 @@ printf ("PUSH_SMINT\n"); switch (b1) { + case SUBCMD_DUP_STACKTOP: + { + stix_oop_t tmp; +printf ("DUP_STACKTOP SP=%d\n", (int)stix->sp); + STIX_ASSERT (!ACTIVE_STACK_ISEMPTY(stix)); + tmp = ACTIVE_STACK_GETTOP(stix); + ACTIVE_STACK_PUSH (stix, tmp); + break; + } + case SUBCMD_POP_STACKTOP: printf ("POP_STACKTOP\n"); - STIX_ASSERT (!STACK_ISEMPTY(stix)); - STACK_POP (stix); + STIX_ASSERT (!ACTIVE_STACK_ISEMPTY(stix)); + ACTIVE_STACK_POP (stix); break; case SUBCMD_RETURN_STACKTOP: printf ("RETURN_STACKTOP\n"); - return_value = STACK_GETTOP(stix); - STACK_POP (stix); + return_value = ACTIVE_STACK_GETTOP(stix); + ACTIVE_STACK_POP (stix); goto handle_return; case SUBCMD_RETURN_RECEIVER: @@ -922,10 +1140,10 @@ printf ("RETURN_RECEIVER\n"); STIX_ASSERT(STIX_CLASSOF(stix, stix->active_context) == stix->_block_context); - return_value = STACK_GETTOP(stix); + return_value = ACTIVE_STACK_GETTOP(stix); blkctx = (stix_oop_block_context_t)stix->active_context; SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)blkctx->caller); - STACK_PUSH (stix, return_value); + ACTIVE_STACK_PUSH (stix, return_value); break; } @@ -939,30 +1157,39 @@ printf ("SEND_BLOCK_COPY\n"); /* it emulates thisContext blockCopy: nargs ofTmprCount: ntmprs */ STIX_ASSERT (stix->sp >= 2); - STIX_ASSERT (STIX_CLASSOF(stix, STACK_GETTOP(stix)) == stix->_small_integer); - ntmprs = STIX_OOP_TO_SMINT(STACK_GETTOP(stix)); - STACK_POP (stix); + STIX_ASSERT (STIX_CLASSOF(stix, ACTIVE_STACK_GETTOP(stix)) == stix->_small_integer); + ntmprs = STIX_OOP_TO_SMINT(ACTIVE_STACK_GETTOP(stix)); + ACTIVE_STACK_POP (stix); - STIX_ASSERT (STIX_CLASSOF(stix, STACK_GETTOP(stix)) == stix->_small_integer); - nargs = STIX_OOP_TO_SMINT(STACK_GETTOP(stix)); - STACK_POP (stix); + STIX_ASSERT (STIX_CLASSOF(stix, ACTIVE_STACK_GETTOP(stix)) == stix->_small_integer); + nargs = STIX_OOP_TO_SMINT(ACTIVE_STACK_GETTOP(stix)); + ACTIVE_STACK_POP (stix); STIX_ASSERT (nargs >= 0); STIX_ASSERT (ntmprs >= nargs); - blkctx = (stix_oop_block_context_t)stix_instantiate (stix, stix->_block_context, STIX_NULL, 255); /* TODO: proper stack size */ + /* the block context object created here is used + * as a base object for block context activation. + * primitive_block_context_value() clones a block + * context and activates the cloned context. + * this base block context is created with no + * stack for this reason. */ + blkctx = (stix_oop_block_context_t)stix_instantiate (stix, stix->_block_context, STIX_NULL, 0); if (!blkctx) return -1; /* get the receiver to the block copy message after block context instantiation * not to get affected by potential GC */ - rctx = STACK_GETTOP(stix); + rctx = ACTIVE_STACK_GETTOP(stix); /* blkctx->caller is left to nil */ - blkctx->ip = STIX_OOP_FROM_SMINT(stix->ip + 3); /* skip the following JUMP */ - blkctx->sp = STIX_OOP_FROM_SMINT(0); + /*blkctx->iip = STIX_OOP_FROM_SMINT(stix->ip + 3); */ + blkctx->ip = STIX_OOP_FROM_SMINT(stix->ip + 3); /* TOOD: change +3 to the configured JUMP SIZE */ + blkctx->sp = STIX_OOP_FROM_SMINT(-1); + /* the number of arguments for a block context is local to the block */ blkctx->nargs = STIX_OOP_FROM_SMINT(nargs); + /* the number of temporaries here is an accumulated count including + * the number of temporaries of a home context */ blkctx->ntmprs = STIX_OOP_FROM_SMINT(ntmprs); - blkctx->iip = STIX_OOP_FROM_SMINT(stix->ip + 3); /* TOOD: change +3 to the configured JUMP SIZE */ blkctx->home = rctx; if (((stix_oop_context_t)rctx)->home == stix->_nil) @@ -979,7 +1206,7 @@ printf ("SEND_BLOCK_COPY\n"); blkctx->origin = ((stix_oop_block_context_t)rctx)->origin; } - STACK_SETTOP (stix, (stix_oop_t)blkctx); + ACTIVE_STACK_SETTOP (stix, (stix_oop_t)blkctx); break; } @@ -993,7 +1220,7 @@ printf ("SEND_BLOCK_COPY\n"); SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->sender); /* push the return value to the stack of the new active context */ - STACK_PUSH (stix, return_value); + ACTIVE_STACK_PUSH (stix, return_value); printf ("<>\n"); if (stix->active_context->sender == stix->_nil) diff --git a/stix/lib/stix-prv.h b/stix/lib/stix-prv.h index 4687f88..8aecf26 100644 --- a/stix/lib/stix-prv.h +++ b/stix/lib/stix-prv.h @@ -40,9 +40,10 @@ #include #include -#define STIX_MEMSET(dst,src,size) memset(dst,src,size) -#define STIX_MEMCPY(dst,src,size) memcpy(dst,src,size) -#define STIX_ASSERT(x) assert(x) +#define STIX_MEMSET(dst,src,size) memset(dst,src,size) +#define STIX_MEMCPY(dst,src,size) memcpy(dst,src,size) +#define STIX_MEMMOVE(dst,src,size) memmove(dst,src,size) +#define STIX_ASSERT(x) assert(x) #define STIX_ALIGN(x,y) ((((x) + (y) - 1) / (y)) * (y)) diff --git a/stix/lib/stix.h b/stix/lib/stix.h index def4238..387cef5 100644 --- a/stix/lib/stix.h +++ b/stix/lib/stix.h @@ -606,9 +606,8 @@ struct stix_context_t stix_oop_t sender; /* message sending context - active context before new context activation*/ stix_oop_t ip; /* instruction pointer */ stix_oop_t sp; /* stack pointer */ - - stix_oop_method_t method; /* CompiledMethod */ - stix_oop_t unused; + stix_oop_t ntmprs; /* SmallInteger. */ + stix_oop_method_t method; /* CompiledMethod */ stix_oop_t receiver; /* receiver of the message. For a statement '#xxx do: #yyyy', #xxx is the receiver.*/ stix_oop_t home; /* nil */ stix_oop_context_t origin; /* nil */ @@ -627,9 +626,9 @@ struct stix_block_context_t stix_oop_t caller; stix_oop_t ip; /* SmallInteger. instruction pointer */ stix_oop_t sp; /* SmallInteger. stack pointer */ - stix_oop_t nargs; /* SmallInteger */ stix_oop_t ntmprs; /* SmallInteger. total number of temporaries */ - stix_oop_t iip; /* SmallInteger. initial instruction pointer */ + stix_oop_t nargs; /* SmallInteger */ + stix_oop_t unused/*iip*/; /* SmallInteger. initial instruction pointer */ stix_oop_t home; /* MethodContext or BlockContext */ stix_oop_context_t origin; /* MethodContext */