diff --git a/stix/kernel/Context.st b/stix/kernel/Context.st index c56f6f9..7607cbe 100644 --- a/stix/kernel/Context.st +++ b/stix/kernel/Context.st @@ -1,10 +1,16 @@ #class(#pointer) Context(Apex) { + #dcl sender ip sp ntmprs. + + #method sender + { + ^self.sender + } } #class(#pointer) MethodContext(Context) { - #dcl sender ip sp ntmprs method receiver home origin. + #dcl method receiver home origin. #method pc { @@ -33,11 +39,16 @@ sp := aSP. ##sp := sp - 1. } + + #method isHandlerContext + { + ^self.method primitive == 512 + } } #class(#pointer) BlockContext(Context) { - #dcl caller ip sp ntmprs nargs source home origin. + #dcl nargs source home origin. #method fork { @@ -146,6 +157,12 @@ ## self value ifTrue: [ aBlock value. thisContext restart. ]. } + #method whileTrue + { + (self value) ifFalse: [^nil]. + self whileTrue. + } + #method whileFalse: aBlock { (self value) ifTrue: [^nil]. @@ -153,6 +170,12 @@ self whileFalse: aBlock. } + #method whileFalse + { + (self value) ifTrue: [^nil]. + self whileFalse. + } + #method pc { ^ip @@ -179,16 +202,30 @@ } - "------ TODO: -------------------------------------" #method on: anException do: anExceptionBlock { - - self primitiveFailed. + | handlerActive | + + handlerActive := true. + +(thisContext basicAt: 9) dump. + + ^self value. } #method ensure: aBlock { + "## + | complete returnValue | + + + returnValue := self valueNoContextSwitch. + complete ifNil: [ + complete := true. + aBlock value. + ]. + ^returnValue. ##" } #method ifCurtailed: aBlock @@ -198,3 +235,78 @@ "------ TODO: -------------------------------------" } +#class Exception(Object) +{ + #dcl signalContext handlerContext messageText. + + #method(#class) signal + { + self new signal + } + + #method(#class) signal: text + { + self new signal: text + } + + #method signal + { + self.signalContext := thisContext. + self isHandled + ifTrue: [ self handle ] + ifFalse: [ self notHandled ]. + } + + #method signal: text + { + self.messageText := text. + self signal. + } + + #method isHandled + { + ^self handlerContext notNil + } + + #method handle + { + self return: (self.handlerContext handlerBlock value: self) + } + + #method notHandle + { +'EXCEPTION NOT HANDLED' dump. +## TODO: debug the current process???? " +Processor activeProcess terminate. + } + + #method handlerContext + { + (self.handlerContext notNil) ifTrue: [ ^self.handlerContext ]. + ^self handlerContextStartingFrom: self.signalContext sender. + } + + #method handlerContextStartingFrom: aContext + { + ## Find exception handling context starting from a given context + + | ctx | + + ctx := aContext. + [ ctx notNil ] + whileTrue: [ + (ctx handles: self) ifTrue: [ ^self.handlerContext := ctx ]. + ctx := ctx sender + ]. + ^nil + } + + #method return: anObject + { + Processor return: anObject to: (self.handlerContext parent) + } +} + +#class NoSuchMessageException(Exception) +{ +} diff --git a/stix/kernel/Process.st b/stix/kernel/Process.st index a51e95f..4f5da04 100644 --- a/stix/kernel/Process.st +++ b/stix/kernel/Process.st @@ -380,4 +380,10 @@ "#method signal: aSemaphore onOutput: file { }" + + #method return: anObject to: aContext + { + + self primitiveFailed. + } } diff --git a/stix/kernel/Stix.st b/stix/kernel/Stix.st index cab4f06..d88c3e6 100644 --- a/stix/kernel/Stix.st +++ b/stix/kernel/Stix.st @@ -254,6 +254,11 @@ #class(#pointer) CompiledMethod(Object) { #dcl owner preamble preamble_data_1 preamble_data_2 ntmprs nargs code source. + + #method preamble + { + ^self.preamble + } } #include 'Context.st'. diff --git a/stix/lib/comp.c b/stix/lib/comp.c index 3973a91..8ca8def 100644 --- a/stix/lib/comp.c +++ b/stix/lib/comp.c @@ -87,6 +87,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' } }, + { 9, { 'e','x','c','e','p','t','i','o','n' } }, { 6, { 'e','x','t','e','n','d' } }, { 5, { 'f','a','l','s','e' } }, { 8, { 'h','a','l','f','w','o','r','d' } }, @@ -120,6 +121,7 @@ enum voca_id_t VOCA_CLASSINST, VOCA_DCL, VOCA_DECLARE, + VOCA_EXCEPTION, VOCA_EXTEND, VOCA_FALSE, VOCA_HALFWORD, @@ -2606,7 +2608,8 @@ static int compile_method_temporaries (stix_t* stix) static int compile_method_primitive (stix_t* stix) { /* - * method-primitive := "<" "primitive:" integer ">" + * method-primitive := "<" "primitive:" integer ">" | + * "<" "exception" ">" */ stix_ooi_t prim_no; const stix_ooch_t* ptr, * end; @@ -2618,80 +2621,84 @@ static int compile_method_primitive (stix_t* stix) } GET_TOKEN (stix); - if (!is_token_keyword(stix, VOCA_PRIMITIVE_COLON)) +print_oocs (&stix->c->tok.name); +printf ("]]]]]]]]]]]]]]]]]]]]]]\n"); + if (is_token_keyword(stix, VOCA_PRIMITIVE_COLON)) { - set_syntax_error (stix, STIX_SYNERR_PRIMITIVE, &stix->c->tok.loc, &stix->c->tok.name); - return -1; - } + GET_TOKEN (stix); + switch (stix->c->tok.type) + { + case STIX_IOTOK_NUMLIT: /* TODO: allow only an integer */ + /*TODO: more checks the validity of the primitive number. support number with radix and so on support more extensive syntax. support primitive name, not number*/ + ptr = stix->c->tok.name.ptr; + end = ptr + stix->c->tok.name.len; + prim_no = 0; + while (ptr < end && is_digitchar(*ptr)) + { + prim_no = prim_no * 10 + (*ptr - '0'); + if (!STIX_OOI_IN_PREAMBLE_INDEX_RANGE(prim_no)) + { + set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name); + return -1; + } -/* TODO: other modifiers than primitive: ? - * - * - * - */ + ptr++; + } - GET_TOKEN (stix); - switch (stix->c->tok.type) - { - case STIX_IOTOK_NUMLIT: /* TODO: allow only an integer */ -/*TODO: more checks the validity of the primitive number. support number with radix and so on support more extensive syntax. support primitive name, not number*/ - ptr = stix->c->tok.name.ptr; - end = ptr + stix->c->tok.name.len; - prim_no = 0; - while (ptr < end && is_digitchar(*ptr)) - { - prim_no = prim_no * 10 + (*ptr - '0'); - if (!STIX_OOI_IN_PREAMBLE_INDEX_RANGE(prim_no)) + stix->c->mth.prim_no = prim_no; + break; + + case STIX_IOTOK_SYMLIT: + prim_no = stix_getprimno (stix, &stix->c->tok.name); + if (prim_no <= -1) + { + const stix_ooch_t* us; + /* the primitive is not found */ + us = stix_findoochar (stix->c->tok.name.ptr, stix->c->tok.name.len, '_'); + if (us > stix->c->tok.name.ptr && us < stix->c->tok.name.ptr + stix->c->tok.name.len - 1) + { + stix_oow_t lit_idx; + /* the symbol literal contains an underscore. + * and it is none of the first of the last character */ + if (add_symbol_literal(stix, &stix->c->tok.name, &lit_idx) >= 0 && + STIX_OOI_IN_PREAMBLE_INDEX_RANGE(lit_idx)) + { + stix->c->mth.prim_type = 2; /* named primitive */ + stix->c->mth.prim_no = lit_idx; + break; + } + } + + set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name); + return -1; + } + else if (!STIX_OOI_IN_PREAMBLE_INDEX_RANGE(prim_no)) { set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name); return -1; } - ptr++; - } + stix->c->mth.prim_type = 1; + stix->c->mth.prim_no = prim_no; + break; - stix->c->mth.prim_no = prim_no; - break; - - case STIX_IOTOK_SYMLIT: - prim_no = stix_getprimno (stix, &stix->c->tok.name); - if (prim_no <= -1) - { - const stix_ooch_t* us; - /* the primitive is not found */ - us = stix_findoochar (stix->c->tok.name.ptr, stix->c->tok.name.len, '_'); - if (us > stix->c->tok.name.ptr && us < stix->c->tok.name.ptr + stix->c->tok.name.len - 1) - { - stix_oow_t lit_idx; - /* the symbol literal contains an underscore. - * and it is none of the first of the last character */ - if (add_symbol_literal(stix, &stix->c->tok.name, &lit_idx) >= 0 && - STIX_OOI_IN_PREAMBLE_INDEX_RANGE(lit_idx)) - { - stix->c->mth.prim_type = 2; /* named primitive */ - stix->c->mth.prim_no = lit_idx; - break; - } - } - - set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name); + default: + set_syntax_error (stix, STIX_SYNERR_INTEGER, &stix->c->tok.loc, &stix->c->tok.name); return -1; - } - else if (!STIX_OOI_IN_PREAMBLE_INDEX_RANGE(prim_no)) - { - set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name); - return -1; - } + } - stix->c->mth.prim_type = 1; - stix->c->mth.prim_no = prim_no; - break; - - default: - set_syntax_error (stix, STIX_SYNERR_INTEGER, &stix->c->tok.loc, &stix->c->tok.name); - return -1; } - + else if (is_token_word(stix, VOCA_EXCEPTION)) + { +/* TODO: exception handler is supposed to be used by BlockContext on:do:. + * it needs to check the number of arguments at least */ + stix->c->mth.prim_type = 3; + } + else + { + set_syntax_error (stix, STIX_SYNERR_PRIMITIVE, &stix->c->tok.loc, &stix->c->tok.name); + return -1; + } GET_TOKEN (stix); if (!is_token_binary_selector(stix, VOCA_GT)) @@ -4273,12 +4280,17 @@ static int add_compiled_method (stix_t* stix) preamble_code = STIX_METHOD_PREAMBLE_PRIMITIVE; preamble_index = stix->c->mth.prim_no; } - else + else if (stix->c->mth.prim_type == 2) { - STIX_ASSERT (stix->c->mth.prim_type == 2); preamble_code = STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE; preamble_index = stix->c->mth.prim_no; } + else + { + STIX_ASSERT (stix->c->mth.prim_type == 3); + preamble_code = STIX_METHOD_PREAMBLE_EXCEPTION; + preamble_index = 0; + } STIX_ASSERT (STIX_OOI_IN_PREAMBLE_INDEX_RANGE(preamble_index)); diff --git a/stix/lib/exec.c b/stix/lib/exec.c index b2e3097..a1f3d57 100644 --- a/stix/lib/exec.c +++ b/stix/lib/exec.c @@ -1608,32 +1608,43 @@ printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n"); static int prim_block_on_do (stix_t* stix, stix_ooi_t nargs) { int x; - stix_oop_t exblk, excls; + stix_oop_oop_t exarr; stix_oop_context_t blkctx; + stix_ooi_t i, j; - STIX_ASSERT (nargs == 2); + STIX_ASSERT (nargs >= 2); - exblk = ACTIVE_STACK_GET(stix, stix->sp); - excls = ACTIVE_STACK_GET(stix, stix->sp - 1); + if ((stix_oow_t)nargs & 1) return 0; /* it expects even number of arguments */ + + //for (i = 0; i < nargs; i += 2) + //{ + // exblk = ACTIVE_STACK_GET(stix, stix->sp); + // excls = ACTIVE_STACK_GET(stix, stix->sp - 1); + //} - stix_pushtmp (stix, &exblk); - stix_pushtmp (stix, &excls); x = __block_value (stix, nargs, 0, 0, &blkctx); - stix_poptmps (stix, 2); if (x <= 0) return x; /* hard failure and soft failure */ /* TOOD: implement zero-cost exception handling. * this implementation requires allocation of a new array * every time on:do: is executed */ - /* - * stix_pushtmp (stix, &blkctx); - blkctx->exception_info = stix_instantiate (stix, stix->_array, ); + + stix_pushtmp (stix, (stix_oop_t*)&blkctx); + exarr = (stix_oop_oop_t)stix_instantiate (stix, stix->_array, STIX_NULL, nargs); stix_poptmp (stix); - */ - + if (!exarr) return -1; /* hard failure */ /* TOOD: can't this be treated as a soft failure? */ + + for (i = nargs, j = 0; i > 0;) + { + --i; + exarr->slot[j++] = ACTIVE_STACK_GET(stix, stix->sp - i); + --i; + exarr->slot[j++] = ACTIVE_STACK_GET(stix, stix->sp - i); + } + #if defined(STIX_DEBUG_EXEC_001) -printf ("<> SP=%ld\n", (long int)stix->sp); +printf ("<> SP=%ld\n", (long int)stix->sp); #endif SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)blkctx); return 1; @@ -1816,6 +1827,25 @@ static int prim_processor_remove_semaphore (stix_t* stix, stix_ooi_t nargs) return 1; } +static int prim_processor_return_to (stix_t* stix, stix_ooi_t nargs) +{ + stix_oop_t rcv, ret, ctx; + + STIX_ASSERT (nargs == 2); + + rcv = ACTIVE_STACK_GET(stix, stix->sp - 2); + ret = ACTIVE_STACK_GET(stix, stix->sp - 1); + ctx = ACTIVE_STACK_GET(stix, stix->sp); + + if (rcv != (stix_oop_t)stix->processor) return 0; +/* TODO: check if ctx is a block context or a method context */ + + ACTIVE_STACK_POPS (stix, nargs + 1); /* pop arguments and receiver */ + SWITCH_ACTIVE_CONTEXT (stix, ctx); + + return 1; +} + static int prim_integer_add (stix_t* stix, stix_ooi_t nargs) { stix_oop_t rcv, arg, res; @@ -2493,7 +2523,7 @@ static prim_t primitives[] = { 0, MAX_NARGS, prim_block_value, "_block_value" }, { 0, MAX_NARGS, prim_block_new_process, "_block_new_process" }, - { 2, 2, prim_block_on_do, "_block_on_do" }, + { 2, MAX_NARGS, prim_block_on_do, "_block_on_do" }, { 0, 0, prim_process_resume, "_process_resume" }, { 0, 0, prim_process_terminate, "_process_terminate" }, @@ -2504,6 +2534,7 @@ static prim_t primitives[] = { 1, 1, prim_processor_schedule, "_processor_schedule" }, { 2, 3, prim_processor_add_timed_semaphore, "_processor_add_timed_semaphore" }, { 1, 1, prim_processor_remove_semaphore, "_processor_remove_semaphore" }, + { 2, 2, prim_processor_return_to, "_processor_return_to" }, { 1, 1, prim_integer_add, "_integer_add" }, { 1, 1, prim_integer_sub, "_integer_sub" }, @@ -2878,7 +2909,8 @@ printf ("]\n"); } default: - STIX_ASSERT (preamble_code == STIX_METHOD_PREAMBLE_NONE); + STIX_ASSERT (preamble_code == STIX_METHOD_PREAMBLE_NONE || + preamble_code == STIX_METHOD_PREAMBLE_EXCEPTION); if (activate_new_method (stix, method) <= -1) return -1; break; } @@ -3642,8 +3674,6 @@ printf ("<> SP=%d\n", (int)stix->sp); /* place the instruction pointer back at the return instruction. * even if the context is reentered, it will just return. *stix->ip--;*/ - - #if defined(STIX_DEBUG_EXEC_002) printf ("TERMINATING A PROCESS RETURNING old_active context %p\n", stix->active_context); #endif @@ -3659,8 +3689,6 @@ printf ("TERMINATED A PROCESS RETURNING %lld new active_context %p\n", (long lon printf ("ERROR: CAN'T RETURN FROM DEAD METHOD CONTEXT orgin->ip %ld origin->sender->ip %ld\n", (long int)STIX_OOP_TO_SMOOI(stix->active_context->origin->ip), (long int)STIX_OOP_TO_SMOOI(stix->active_context->origin->sender->ip)); printf ("ERROR: CAN'T RETURN FROM DEAD METHOD CONTEXT origin %p origin->sender %p\n", stix->active_context->origin, stix->active_context->origin->sender); -printf ("ERROR: CAN'T RETURN FROM DEAD METHOD CONTEXT\n"); - /* TODO: proper error handling */ stix->errnum = STIX_EINTERN; /* TODO: this should be caughtable at the stix level... */ return -1; @@ -3714,7 +3742,6 @@ printf (">>>>>>>>>>>>>>>> METHOD RETURN FROM WITHIN A BLOCK. NON-LOCAL RETURN.. printf ("<<>> TERMINATING SP => %ld\n", (long int)stix->sp); #endif - /* the stack contains the final return value so the stack pointer must be 0. */ STIX_ASSERT (stix->sp == 0); @@ -3723,14 +3750,12 @@ printf ("<<>> TERMINATING SP => %ld\n", (long else goto done; - /* TODO: store the return value to the VM register. * the caller to stix_execute() can fetch it to return it to the system */ } } #endif - break; case BCODE_RETURN_FROM_BLOCK: diff --git a/stix/lib/stix-prv.h b/stix/lib/stix-prv.h index bf19870..1b0a8e4 100644 --- a/stix/lib/stix-prv.h +++ b/stix/lib/stix-prv.h @@ -342,7 +342,6 @@ struct stix_iotok_t STIX_IOTOK_IDENT_DOTTED, STIX_IOTOK_BINSEL, STIX_IOTOK_KEYWORD, - STIX_IOTOK_PRIMITIVE, STIX_IOTOK_ASSIGN, STIX_IOTOK_COLON, STIX_IOTOK_RETURN, diff --git a/stix/lib/stix.h b/stix/lib/stix.h index 5f4a715..7c0bd18 100644 --- a/stix/lib/stix.h +++ b/stix/lib/stix.h @@ -462,8 +462,10 @@ struct stix_method_t * 4 - return false * 5 - return index. * 6 - return -index. - * 7 - return instvar[index] + * 7 - return instvar[index] * 8 - do primitive[index] + * 9 - do named primitive[index] + * 10 - exception handler */ #define STIX_METHOD_MAKE_PREAMBLE(code,index) ((((stix_ooi_t)index) << 8) | ((stix_ooi_t)code)) #define STIX_METHOD_GET_PREAMBLE_CODE(preamble) (((stix_ooi_t)preamble) & 0xFF) @@ -479,13 +481,14 @@ struct stix_method_t #define STIX_METHOD_PREAMBLE_RETURN_INSTVAR 7 #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 /* 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_PREAMBLE_INDEX_RANGE(num) ((num) >= STIX_METHOD_PREAMBLE_INDEX_MIN && (num) <= STIX_METHOD_PREAMBLE_INDEX_MAX) -#define STIX_CONTEXT_NAMED_INSTVARS 10 +#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 @@ -537,10 +540,6 @@ struct stix_context_t * the source block context. */ stix_oop_context_t origin; - /* each even position (0, 2, 4, etc) contains an exception class - * each odd position (1, 3, 5, etc) contains an exception handler block */ - stix_oop_t exception_info; - /* variable indexed part */ stix_oop_t slot[1]; /* stack */ };