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

removed the ensure_block field from the context object and added the <ensure> code to the preamble field of a method.

Browse Source
This commit is contained in:
hyunghwan.chung 2016-06-22 03:23:14 +00:00
parent 8b678c21fb
commit 73885dc552
10 changed files with 114 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
stix/kernel/Collect.st
View File

@ -56,12 +56,15 @@
## concatenate two strings.
## TOOD: make this a primitive for performance.
| newsize newstr self_ubound |
newsize := self basicSize + aString basicSize.
##newstr := self class basicNew: newsize.
newstr := String basicNew: newsize. ## TODO: redefine , for symbol... it's a work arouind... symbols are not concatenated to a symbol at this moment.
self_ubound := self ubound.
0 to: self_ubound do: [:i | newstr at: i put: (self at: i)].
0 to: (aString ubound) do: [:i | newstr at: (i + self_ubound + 1) put: (aString at: i)].
0 to: self_ubound do: [:i | newstr at: i put: (self at: i) ].
0 to: (aString ubound) do: [:i | newstr at: (i + self_ubound + 1) put: (aString at: i) ].
^newstr
}
}

82
stix/kernel/Context.st
View File

@ -7,7 +7,7 @@
#class(#pointer) Context(Apex)
{
#dcl sender ip sp ntmprs ensure_block.
#dcl sender ip sp ntmprs.
#method sender
{
@ -19,9 +19,14 @@
^false
}
#method hasEnsureBlock
{
^false
}
#method ensureBlock
{
^self.ensure_block
^nil
}
}
@ -75,7 +80,22 @@
#method isExceptionHandlerContext
{
## 10 - STIX_METHOD_PREAMBLE_EXCEPTION in VM.
^self.method preambleCode == 10.
^self.method preambleCode == 10.
}
#method hasEnsureBlock
{
## 10 - STIX_METHOD_PREAMBLE_ENSURE in VM.
^self.method preambleCode == 11
}
#method ensureBlock
{
## TODO: 9 is the number of named instance variables of a context.
## TODO: change 9 to a constant when stix is enhanced to support constant definition
(self.method preambleCode == 11) ifFalse: [^nil].
^self basicAt: 8.
}
#method findExceptionHandlerBlock: anExceptionClass
@ -92,22 +112,38 @@
| bound exc |
## NOTE: if on:do: has a temporary varible, bound must be adjusted to reflect it.
bound := self basicSize - 1.
## TODO: change 9 to a constant when stix is enhanced to support constant definition
## TODO: change 8 to a constant when stix is enhanced to support constant definition
## or calcuate the minimum size using the class information.
9 to: bound by: 2 do: [ :i |
8 to: bound by: 2 do: [ :i |
exc := self basicAt: i.
((anExceptionClass == exc) or: [anExceptionClass inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)].
]
].
^nil.
}
#method unwindTo: aContext return: anObject
{
## private: called by VM upon unwinding
| ctx eb |
ctx := self.
[ctx ~~ aContext] whileTrue: [
eb := ctx ensureBlock.
(eb notNil) ifTrue: [eb value].
ctx := ctx sender.
].
eb := ctx ensureBlock.
(eb notNil) ifTrue: [eb value].
^anObject
}
}
#class(#pointer) BlockContext(Context)
{
#dcl nargs source home origin.
#method fork
#method fork
{
"crate a new process in the runnable state"
^self newProcess resume.
@ -337,47 +373,31 @@ thisContext isExceptionHandlerContext dump.
#method ensure: aBlock
{
## TODO: ensure that the ensured block is executed after exception handler...
| v |
self.ensure_block := aBlock.
v := self on: Exception do: [:ex |
aBlock value.
ex pass
].
<ensure>
"v := self on: Exception do: [:ex | aBlock value. ex pass ]."
v := self value.
aBlock value.
^v
}
#method ifCurtailed: aBlock
{
^self on: Exception do: [:ex | aBlock value. ex pass ]
}
| v ok |
#method unwindTo: aContext return: anObject
{
## private: called by VM upon unwinding
| ctx eb |
ctx := self.
[ctx ~~ aContext] whileTrue: [
eb := ctx ensureBlock.
(eb notNil) ifTrue: [eb value].
ctx := ctx sender.
].
eb := ctx ensureBlock.
(eb notNil) ifTrue: [eb value].
^anObject
ok := false.
[ v := self value. ok := true. ] ensure: [ ok ifFalse: [aBlock value] ].
^v.
}
}
##
## TODO: is it better to inherit from Object???
## or treat Exception specially like UndefinedObject or Class???
##
#extend Exception
{
#method(#class) signal
{
self new signal

2
stix/kernel/Process.st
View File

@ -401,7 +401,7 @@
self primitiveFailed.
}
#method returnTo: anObject andEval: aBlock with: arg
#method returnTo: aContext andEval: aBlock with: arg
{
<primitive: #_processor_return_to_and_eval>
self primitiveFailed.

4
stix/kernel/Stix.st
View File

@ -176,13 +176,13 @@
[ i <= end ] whileTrue: [
aBlock value: i.
i := i + step.
]
].
]
ifFalse: [
[ i >= end ] whileTrue: [
aBlock value: i.
i := i - step.
]
].
].
}

4
stix/kernel/test-010.st
View File

@ -121,7 +121,7 @@
[
[
##[ Exception signal: 'simulated error' ] ensure: [('ensure 1 ', (k asString)) dump ].
[ ^20 ] ensure: [('ensure 1 ', (k asString)) dump ].
[ ^ 20 ] ensure: [ ('ensure 1 ', (k asString)) dump. ].
] ensure: ['ensure 2' dump ].
] ensure: ['ensure 3' dump ].
] on: Exception do: [:ex |
@ -163,9 +163,11 @@
## Exception signal: 'qqq'.
].
"
v1 := self aaa_123.
'--------------------------------' dump.
v1 dump.
'--------------------------------' dump.
'END OF MAIN' dump.
}

15
stix/lib/comp.c
View File

@ -86,6 +86,7 @@ static struct voca_t
{ 9, { 'c','l','a','s','s','i','n','s','t' } },
{ 3, { 'd','c','l' } },
{ 7, { 'd','e','c','l','a','r','e' } },
{ 6, { 'e','n','s','u','r','e', } },
{ 9, { 'e','x','c','e','p','t','i','o','n' } },
{ 6, { 'e','x','t','e','n','d' } },
{ 5, { 'f','a','l','s','e' } },
@ -120,6 +121,7 @@ enum voca_id_t
VOCA_CLASSINST,
VOCA_DCL,
VOCA_DECLARE,
VOCA_ENSURE,
VOCA_EXCEPTION,
VOCA_EXTEND,
VOCA_FALSE,
@ -2667,6 +2669,10 @@ static int compile_method_primitive (stix_t* stix)
* it needs to check the number of arguments at least */
stix->c->mth.prim_type = 3;
}
else if (is_token_word(stix, VOCA_ENSURE))
{
stix->c->mth.prim_type = 4;
}
else
{
set_syntax_error (stix, STIX_SYNERR_PRIMITIVE, &stix->c->tok.loc, &stix->c->tok.name);
@ -4202,10 +4208,15 @@ static int add_compiled_method (stix_t* stix)
preamble_code = STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE;
preamble_index = stix->c->mth.prim_no;
}
else if (stix->c->mth.prim_type == 3)
{
preamble_code = STIX_METHOD_PREAMBLE_EXCEPTION;
preamble_index = 0;
}
else
{
STIX_ASSERT (stix->c->mth.prim_type == 3);
preamble_code = STIX_METHOD_PREAMBLE_EXCEPTION;
STIX_ASSERT (stix->c->mth.prim_type == 4);
preamble_code = STIX_METHOD_PREAMBLE_ENSURE;
preamble_index = 0;
}

66
stix/lib/exec.c
View File

@ -1576,7 +1576,7 @@ static int prim_context_goto (stix_t* stix, stix_ooi_t nargs)
if (STIX_CLASSOF(stix, rcv) != stix->_method_context)
{
#if defined(STIX_DEBUG_VM_EXEC)
printf ("prim_context_goto: PRIMITVE RECEIVER IS NOT A METHOD CONTEXT\n");
STIX_DEBUG0 (stix, "prim_context_goto: PRIMITVE RECEIVER IS NOT A METHOD CONTEXT\n");
#endif
return 0;
}
@ -1585,7 +1585,7 @@ printf ("prim_context_goto: PRIMITVE RECEIVER IS NOT A METHOD CONTEXT\n");
if (!STIX_OOP_IS_SMOOI(pc) || STIX_OOP_TO_SMOOI(pc) < 0)
{
#if defined(STIX_DEBUG_VM_EXEC)
printf ("prim_context_goto: PRIMITVE ARGUMENT IS INVALID\n");
STIX_DEBUG0 (stix, "prim_context_goto: PRIMITVE ARGUMENT IS INVALID\n");
#endif
return 0;
}
@ -1624,7 +1624,7 @@ static int __block_value (stix_t* stix, stix_ooi_t rcv_blkctx_offset, stix_ooi_t
{
/* the receiver must be a block context */
#if defined(STIX_DEBUG_VM_EXEC)
printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
STIX_DEBUG0 (stix, "PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
#endif
return 0;
}
@ -1637,7 +1637,7 @@ printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
* For example, [thisContext value] value. */
STIX_ASSERT (STIX_OBJ_GET_SIZE(rcv_blkctx) > STIX_CONTEXT_NAMED_INSTVARS);
#if defined(STIX_DEBUG_VM_EXEC)
printf ("PRIM REVALUING AN BLOCKCONTEXT\n");
STIX_DEBUG0 (stix, "PRIM REVALUING AN BLOCKCONTEXT\n");
#endif
return 0;
}
@ -1648,7 +1648,7 @@ printf ("PRIM REVALUING AN BLOCKCONTEXT\n");
/* the number of argument doesn't match */
#if defined(STIX_DEBUG_VM_EXEC)
/* TODO: better handling of primitive failure */
printf ("PRIM BlockContext value FAIL - NARGS MISMATCH\n");
STIX_DEBUG0 (stix, "PRIM BlockContext value FAIL - NARGS MISMATCH\n");
#endif
return 0;
}
@ -1677,7 +1677,6 @@ printf ("PRIM BlockContext value FAIL - NARGS MISMATCH\n");
#else
blkctx->ip = rcv_blkctx->ip;
blkctx->ntmprs = rcv_blkctx->ntmprs;
blkctx->ensure_block = rcv_blkctx->ensure_block;
blkctx->method_or_nargs = rcv_blkctx->method_or_nargs;
blkctx->receiver_or_source = (stix_oop_t)rcv_blkctx;
blkctx->home = rcv_blkctx->home;
@ -1769,7 +1768,7 @@ static int prim_block_new_process (stix_t* stix, stix_ooi_t nargs)
{
/* the receiver must be a block context */
#if defined(STIX_DEBUG_VM_EXEC)
printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
STIX_DEBUG0 (stix, "PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
#endif
return 0;
}
@ -2489,7 +2488,7 @@ static int prim_ffi_call (stix_t* stix, stix_ooi_t nargs)
if (!STIX_ISTYPEOF(stix, sig, STIX_OBJ_TYPE_CHAR) || STIX_OBJ_GET_SIZE(sig) <= 0)
{
printf ("wrong signature...\n");
STIX_DEBUG0 (stix, "FFI: wrong signature...\n");
return 0;
}
@ -2512,7 +2511,7 @@ printf ("wrong signature...\n");
dc = dcNewCallVM (4096);
if (!dc) return -1; /* TODO: proper error handling */
printf ("CALLING............%p\n", f);
STIX_DEBUG1 (stix, "FFI: CALLING............%p\n", f);
/*dcMode (dc, DC_CALL_C_DEFAULT);
dcReset (dc);*/
@ -2521,7 +2520,7 @@ printf ("CALLING............%p\n", f);
if (((stix_oop_char_t)sig)->slot[i] == '|')
{
dcMode (dc, DC_CALL_C_ELLIPSIS);
printf ("CALL MODE 111 ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MODE);
STIX_DEBUG0 (stix, "CALL MODE 111 ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MODE);
mode_set = 1;
break;
}
@ -2530,14 +2529,14 @@ printf ("CALL MODE 111 ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MOD
for (i = 2; i < STIX_OBJ_GET_SIZE(sig); i++)
{
printf ("CALLING ARG %c\n", ((stix_oop_char_t)sig)->slot[i]);
STIX_DEBUG1 (stix, "FFI: CALLING ARG %c\n", ((stix_oop_char_t)sig)->slot[i]);
switch (((stix_oop_char_t)sig)->slot[i])
{
/* TODO: support more types... */
/*
case '|':
dcMode (dc, DC_CALL_C_ELLIPSIS_VARARGS);
printf ("CALL MODE 222 ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MODE);
STIX_DEBUG2 (stix, "CALL MODE 222 ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MODE);
break;
*/
@ -2594,8 +2593,8 @@ printf ("CALL MODE 222 ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MOD
case 'i':
{
int r = dcCallInt (dc, f);
printf ("CALLED... %d\n", r);
printf ("CALL ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MODE);
STIX_DEBUG1 (stix, "CALLED... %d\n", r);
STIX_DEBUG2 (stix, "CALL ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_MODE);
STIX_STACK_SETTOP (stix, STIX_SMOOI_TO_OOP(r));
break;
}
@ -2668,7 +2667,7 @@ static int prim_ffi_getsym (stix_t* stix, stix_ooi_t nargs)
if (!STIX_ISTYPEOF(stix,fun,STIX_OBJ_TYPE_CHAR))
{
printf ("wrong function name...\n");
STIX_DEBUG0 (stix, "wrong function name...\n");
return 0;
}
@ -3077,7 +3076,8 @@ static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t narg
default:
STIX_ASSERT (preamble_code == STIX_METHOD_PREAMBLE_NONE ||
preamble_code == STIX_METHOD_PREAMBLE_EXCEPTION);
preamble_code == STIX_METHOD_PREAMBLE_EXCEPTION ||
preamble_code == STIX_METHOD_PREAMBLE_ENSURE);
if (activate_new_method (stix, method) <= -1) return -1;
break;
}
@ -3912,14 +3912,6 @@ return -1;
}
else
{
#if 0
if (stix->active_context->origin->ip == STIX_SMOOI_TO_OOP(STIX_SMOOI_MIN))
{
STIX_LOG0 (stix, STIX_LOG_IC | STIX_LOG_ERROR, "Error - cannot return from dead context\n");
stix->errnum = STIX_EINTERN; /* TODO: make this error catchable at the stix level... */
return -1;
}
#endif
unwind_protect = 0;
/* set the instruction pointer to an invalid value.
@ -3941,25 +3933,35 @@ return -1;
ctx = stix->active_context;
while ((stix_oop_t)ctx != stix->_nil)
{
if ((stix_oop_t)ctx->ensure_block != stix->_nil) unwind_protect = 1;
if (STIX_CLASSOF(stix, ctx) == stix->_method_context)
{
stix_ooi_t preamble;
preamble = STIX_OOP_TO_SMOOI(((stix_oop_method_t)ctx->method_or_nargs)->preamble);
if (STIX_METHOD_GET_PREAMBLE_CODE(preamble) == STIX_METHOD_PREAMBLE_ENSURE)
{
if (!unwind_protect)
{
unwind_protect = 1;
unwind_start = ctx;
}
unwind_stop = ctx;
}
}
if (ctx == stix->active_context->origin) goto non_local_return_ok;
ctx = ctx->sender;
}
/* cannot return from a method that has returned already */
STIX_ASSERT (STIX_CLASSOF(stix, stix->active_context->origin) == stix->_method_context);
STIX_ASSERT (stix->active_context->origin->ip == STIX_SMOOI_TO_OOP(STIX_SMOOI_MIN));
STIX_LOG0 (stix, STIX_LOG_IC | STIX_LOG_ERROR, "Error - cannot return from dead context\n");
stix->errnum = STIX_EINTERN; /* TODO: can i make this error catchable at the stix level? */
return -1;
non_local_return_ok:
STIX_DEBUG0 (stix, "NON_LOCAL RETURN OK...\n");
/*STIX_DEBUG2 (stix, "NON_LOCAL RETURN OK TO... %p %p\n", stix->active_context->origin, stix->active_context->origin->sender);*/
stix->active_context->origin->ip = STIX_SMOOI_TO_OOP(STIX_SMOOI_MIN);
if (unwind_protect)
{
unwind_start = stix->active_context;
unwind_stop = stix->active_context->origin;
}
}
STIX_ASSERT (STIX_CLASSOF(stix, stix->active_context->origin) == stix->_method_context);

3
stix/lib/main.c
View File

@ -342,6 +342,8 @@ static void log_write (stix_t* stix, unsigned int mask, const stix_ooch_t* msg,
msgidx = 0;
/*if (mask & STIX_LOG_GC) return;*/ /* don't show gc logs */
/* TODO: beautify the log message.
* do classification based on mask. */
@ -676,7 +678,6 @@ int main (int argc, char* argv[])
}
}
xret = 0;
g_stix = stix;
setup_tick ();

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

@ -45,7 +45,7 @@
#define STIX_USE_MAKE_BLOCK
/* this is for gc debugging */
/* #define STIX_DEBUG_GC */
/*#define STIX_DEBUG_GC*/
#define STIX_DEBUG_COMPILER
/*#define STIX_DEBUG_VM_PROCESSOR*/
/*#define STIX_DEBUG_VM_EXEC*/

5
stix/lib/stix.h
View File

@ -507,13 +507,14 @@ struct stix_method_t
#define STIX_METHOD_PREAMBLE_PRIMITIVE 8
#define STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE 9 /* index is an index to the symbol table */
#define STIX_METHOD_PREAMBLE_EXCEPTION 10
#define STIX_METHOD_PREAMBLE_ENSURE 11
/* the index is an 16-bit unsigned integer. */
#define STIX_METHOD_PREAMBLE_INDEX_MIN 0x0000
#define STIX_METHOD_PREAMBLE_INDEX_MAX 0xFFFF
#define STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(num) ((num) >= STIX_METHOD_PREAMBLE_INDEX_MIN && (num) <= STIX_METHOD_PREAMBLE_INDEX_MAX)
#define STIX_CONTEXT_NAMED_INSTVARS 9
#define STIX_CONTEXT_NAMED_INSTVARS 8
typedef struct stix_context_t stix_context_t;
typedef struct stix_context_t* stix_oop_context_t;
struct stix_context_t
@ -540,8 +541,6 @@ struct stix_context_t
* defined its 'home'. */
stix_oop_t ntmprs;
/* **** */
stix_oop_context_t ensure_block;
/* CompiledMethod for a method context,
* SmallInteger for a block context */