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

enhanced the compiler to handle cascaded messages.

Browse Source 
implemented block-context local temporaries.
changed primitive_block_context_value() to support block context reentrancy by activating a shallow-copied block context
This commit is contained in:
hyunghwan.chung 2015-06-22 14:21:46 +00:00
parent b9ee190dec
commit 6f565539a9
4 changed files with 591 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

313
stix/lib/comp.c
View File

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

403
stix/lib/exec.c
View File

@ -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 ("<<LEAVING>>\n");
if (stix->active_context->sender == stix->_nil)

7
stix/lib/stix-prv.h
View File

@ -40,9 +40,10 @@
#include <string.h>
#include <assert.h>
#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))

9
stix/lib/stix.h
View File

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