diff --git a/stix/kernel/Collect.st b/stix/kernel/Collect.st index 8c2c9d2..ca066ac 100644 --- a/stix/kernel/Collect.st +++ b/stix/kernel/Collect.st @@ -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 } } diff --git a/stix/kernel/Context.st b/stix/kernel/Context.st index a3e565a..d199f0b 100644 --- a/stix/kernel/Context.st +++ b/stix/kernel/Context.st @@ -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 - ]. + + "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 diff --git a/stix/kernel/Process.st b/stix/kernel/Process.st index 055bb13..e704f69 100644 --- a/stix/kernel/Process.st +++ b/stix/kernel/Process.st @@ -401,7 +401,7 @@ self primitiveFailed. } - #method returnTo: anObject andEval: aBlock with: arg + #method returnTo: aContext andEval: aBlock with: arg { self primitiveFailed. diff --git a/stix/kernel/Stix.st b/stix/kernel/Stix.st index 05c1a84..65e2a29 100644 --- a/stix/kernel/Stix.st +++ b/stix/kernel/Stix.st @@ -176,13 +176,13 @@ [ i <= end ] whileTrue: [ aBlock value: i. i := i + step. - ] + ]. ] ifFalse: [ [ i >= end ] whileTrue: [ aBlock value: i. i := i - step. - ] + ]. ]. } diff --git a/stix/kernel/test-010.st b/stix/kernel/test-010.st index 9d06d09..3514b9c 100644 --- a/stix/kernel/test-010.st +++ b/stix/kernel/test-010.st @@ -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. } diff --git a/stix/lib/comp.c b/stix/lib/comp.c index d6bf1cd..e564849 100644 --- a/stix/lib/comp.c +++ b/stix/lib/comp.c @@ -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; } diff --git a/stix/lib/exec.c b/stix/lib/exec.c index 7e9ae03..3c8fe64 100644 --- a/stix/lib/exec.c +++ b/stix/lib/exec.c @@ -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); diff --git a/stix/lib/main.c b/stix/lib/main.c index 3ce30d2..f18672a 100644 --- a/stix/lib/main.c +++ b/stix/lib/main.c @@ -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 (); diff --git a/stix/lib/stix-prv.h b/stix/lib/stix-prv.h index f3f02da..f445d14 100644 --- a/stix/lib/stix-prv.h +++ b/stix/lib/stix-prv.h @@ -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*/ diff --git a/stix/lib/stix.h b/stix/lib/stix.h index bcff642..bc616d8 100644 --- a/stix/lib/stix.h +++ b/stix/lib/stix.h @@ -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 */