diff --git a/stix/kernel/Context.st b/stix/kernel/Context.st index 829be6b..9a073bd 100644 --- a/stix/kernel/Context.st +++ b/stix/kernel/Context.st @@ -34,10 +34,15 @@ ^self.ip + 1 } + #method goto: anInteger + { + + self primitiveFailed. ## TODO: need to make this a hard failure? + } + #method pc: anInteger { self.ip := anInteger. - "self.sp := self.sp - 1." "whould this always work??? " } #method sp @@ -184,11 +189,18 @@ ## -------------------------------------------------- ## If VM is built with STIX_USE_PROCSTK ## -------------------------------------------------- - | pc | + | pc sp | + pc := thisContext pcplus1. - (self value) ifFalse: [ ^nil "^self" ]. + (self value) ifFalse: [ ^nil ]. aBlock value. - thisContext pc: pc. + + ## the pc: method leaves thisContext and pc in the stack after + ## having changes the instruction poointer. + ## as a result, the stack keeps growing. the goto method + ## clears thisContext and pc off the stack unlike normal methods. + ##thisContext pc: pc. + thisContext goto: pc. ## -------------------------------------------------- } @@ -202,8 +214,8 @@ ## -------------------------------------------------- | pc | pc := thisContext pcplus1. - (self value) ifFalse: [ ^nil "^self" ]. - thisContext pc: pc. + (self value) ifFalse: [ ^nil ]. + thisContext goto: pc. ## -------------------------------------------------- } @@ -247,7 +259,7 @@ pc := thisContext pcplus1. (self value) ifTrue: [ ^nil "^self" ]. aBlock value. - thisContext pc: pc. + thisContext goto: pc. ## -------------------------------------------------- } @@ -262,7 +274,7 @@ | pc | pc := thisContext pcplus1. (self value) ifTrue: [ ^nil "^self" ]. - thisContext pc: pc. + thisContext goto: pc. ## -------------------------------------------------- } diff --git a/stix/kernel/Process.st b/stix/kernel/Process.st index 8d4e410..5bd34a5 100644 --- a/stix/kernel/Process.st +++ b/stix/kernel/Process.st @@ -104,10 +104,11 @@ #method critical: aBlock { -'CRITICAL....11' dump. +## TODO: implement this +" self wait. -'CRITICAL....22' dump. ^aBlock ensure: [ self signal ] +" } ## ================================================================== diff --git a/stix/kernel/test-010.st b/stix/kernel/test-010.st index c7f8e15..e463ef3 100644 --- a/stix/kernel/test-010.st +++ b/stix/kernel/test-010.st @@ -48,7 +48,8 @@ #method(#class) main { - ## test critical region + + ## THIS CRASHES VM. PLEASE CHECK. CRASHES WHEN REPETITION IS 1000 |t1 t2 s1 s2 s3| 'START OF MAIN' dump. @@ -57,13 +58,13 @@ s2 := Semaphore new. t1 := [ - 1000 timesRepeat: ['BLOCK #1' dump]. + 10000 timesRepeat: ['BLOCK #1' dump]. ##s2 critical: [ ## 10 timesRepeat: ['BLOCK #1' dump ] ##] ] newProcess. t2 := [ - 1000 timesRepeat: ['BLOCK #2' dump]. + 10000 timesRepeat: ['BLOCK #2' dump]. ##s2 critical: [ ## 10 timesRepeat: ['BLOCK #2' dump. ] ##]. @@ -78,6 +79,18 @@ 'END OF MAIN' dump. + +" + + |s1| + s1 := Semaphore new. + s1 signal. + 'XXXXXXXXXXXXXXXX' dump. + s1 wait. +" + + + " | v1 | 'START OF MAIN' dump. diff --git a/stix/lib/exec.c b/stix/lib/exec.c index 5d77c31..66d7ba4 100644 --- a/stix/lib/exec.c +++ b/stix/lib/exec.c @@ -1539,6 +1539,45 @@ static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs) return 1; } + +static int prim_context_goto (stix_t* stix, stix_ooi_t nargs) +{ + stix_oop_t rcv; + stix_oop_t pc; + stix_oow_t pcw; + + /* this primivie provides the similar functionality to MethodContext>>pc: + * except that it pops the receiver and arguments and doesn't push a + * return value. it's useful when you want to change the instruction + * pointer while maintaining the stack level before the call */ + + STIX_ASSERT (nargs == 1); + + rcv = ACTIVE_STACK_GET(stix, stix->sp - 1); + if (STIX_CLASSOF(stix, rcv) != stix->_method_context) + { +#if defined(STIX_DEBUG_EXEC_001) +printf ("prim_context_goto: PRIMITVE RECEIVER IS NOT A METHOD CONTEXT\n"); +#endif + return 0; + } + + pc = ACTIVE_STACK_GET(stix, stix->sp); + if (!STIX_OOP_IS_SMOOI(pc) || STIX_OOP_TO_SMOOI(pc) < 0) + { +#if defined(STIX_DEBUG_EXEC_001) +printf ("prim_context_goto: PRIMITVE ARGUMENT IS INVALID\n"); +#endif + return 0; + } + + ((stix_oop_context_t)rcv)->ip = pc; + LOAD_ACTIVE_IP (stix); + + ACTIVE_STACK_POPS (stix, 2); /* pop both the argument and the receiver */ + return 1; +} + static int __block_value (stix_t* stix, stix_ooi_t rcv_blkctx_offset, stix_ooi_t nargs, stix_ooi_t num_first_arg_elems, stix_oop_context_t* pblkctx) { /* prepare a new block context for activation. @@ -2635,6 +2674,7 @@ static prim_t primitives[] = { 2, 2, prim_basic_at_put, "_basic_at_put" }, + { 1, 1, prim_context_goto, "_context_goto" }, { 0, MAX_NARGS, prim_block_value, "_block_value" }, { 0, MAX_NARGS, prim_block_new_process, "_block_new_process" }, @@ -2866,7 +2906,7 @@ printf ("\n"); method = find_method (stix, receiver, &mthname, to_super); if (!method) { - static stix_uch_t fbm[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' }; + static stix_ooch_t fbm[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' }; mthname.ptr = fbm; mthname.len = 18; @@ -2876,6 +2916,7 @@ printf ("\n"); /* TODO: improve this hard error handling */ stix_oop_t c; +/* TODO: remove this print out.... or have it gracefully returned to the caller side */ c = STIX_CLASSOF(stix,receiver); printf ("HARD FAILURE ERROR [IMAGE PROBLEM] - receiver ["); print_object (stix, receiver); @@ -2896,7 +2937,7 @@ printf ("\n"); * how can i preserve it gracefully? */ ACTIVE_STACK_POPS (stix, nargs); nargs = 1; - ACTIVE_STACK_PUSH (stix, selector); + ACTIVE_STACK_PUSH (stix, (stix_oop_t)selector); } } @@ -3133,6 +3174,15 @@ int stix_execute (stix_t* stix) /* no more waiting semaphore and no more process */ STIX_ASSERT (stix->processor->tally = STIX_SMOOI_TO_OOP(0)); printf ("REALLY NO MORE RUNNABLE PROCESS...\n"); + + +#if 0 +if (there is semaphore awaited.... ) +{ +/* DO SOMETHING */ +} +#endif + break; } diff --git a/stix/lib/main.c b/stix/lib/main.c index ad3f430..a175934 100644 --- a/stix/lib/main.c +++ b/stix/lib/main.c @@ -380,7 +380,6 @@ static char* syntax_error_msg[] = "literal expected" }; -stix_ooch_t str_system[] = { 'S', 'y', 's', 't', 'e', 'm' }; stix_ooch_t str_my_object[] = { 'M', 'y', 'O', 'b','j','e','c','t' }; stix_ooch_t str_main[] = { 'm', 'a', 'i', 'n' }; @@ -461,27 +460,6 @@ int main (int argc, char* argv[]) } #endif - /* - { - stix_oop_t k; - stix_oow_t x; - - k = STIX_SMOOI_TO_OOP(-1); - printf ("%ld %ld %ld %lX\n", (long int)STIX_OOP_TO_SMOOI(k), (long int)STIX_SMOOI_MIN, (long int)STIX_SMOOI_MAX, (long)LONG_MIN); - - k = STIX_SMOOI_TO_OOP(STIX_SMOOI_MAX); - printf ("%ld\n", (long int)STIX_OOP_TO_SMOOI(k)); - - k = STIX_SMOOI_TO_OOP(STIX_SMOOI_MIN); - printf ("%ld\n", (long int)STIX_OOP_TO_SMOOI(k)); - - printf ("%u\n", STIX_BITS_MAX(unsigned int, 5)); - x = STIX_CLASS_SPEC_MAKE (10, 1, STIX_OBJ_TYPE_CHAR); - printf ("%lu %lu %lu %lu\n", (unsigned long int)x, (unsigned long int)STIX_SMOOI_TO_OOP(x), - (unsigned long int)STIX_CLASS_SPEC_NAMED_INSTVAR(x), - (unsigned long int)STIX_CLASS_SPEC_INDEXED_TYPE(x)); - }*/ - vmprim.mod_open = mod_open; vmprim.mod_close = mod_close; vmprim.mod_getsym = mod_getsym; @@ -524,63 +502,6 @@ int main (int argc, char* argv[]) return -1; } -#if 0 -{ - -/*const stix_bch_t* xxx = "9999999999999999999999999999999999999999999999999999999999999999999999999999999999";*/ - -//const stix_bch_t* xxx = "2305843009213693953"; -//const stix_bch_t* xxx = "184467440737095516161111"; -const stix_bch_t* xxx = "999999999999999999999999"; -const stix_bch_t* yyy = "1000000000000000000000000000000000000000000000000"; -//const stix_bch_t* yyy = "1290812390812903812903812903812903812903481290381209381290381290381290831290381290381290831209381293712897361287361278631278361278631278631287361278361278"; - -stix_ooch_t buf[10240]; -stix_oow_t xxxlen; -stix_oow_t buflen; - -xxxlen = stix_countbcstr(xxx); -buflen = STIX_COUNTOF(buf); -stix_utf8toucs (xxx, &xxxlen, buf, &buflen); -dump_object (stix, stix_strtoint (stix, buf, buflen, 10), "STRINT"); - -xxxlen = stix_countbcstr(yyy); -buflen = STIX_COUNTOF(buf); -stix_utf8toucs (yyy, &xxxlen, buf, &buflen); -dump_object (stix, stix_strtoint (stix, buf, buflen, 3), "STRINT"); -} - -{ -stix_ooch_t x[] = { 'X', 't', 'r', 'i', 'n', 'g', '\0' }; -stix_ooch_t y[] = { 'S', 'y', 'm', 'b', 'o', 'l', '\0' }; -stix_oop_t a, b, k; - -a = stix_makesymbol (stix, x, 6); -b = stix_makesymbol (stix, y, 6); - -printf ("%p %p\n", a, b); - - - dump_symbol_table (stix); - -/* -stix_pushtmp (stix, &a); -stix_pushtmp (stix, &b); -k = stix_instantiate (stix, stix->_byte_array, STIX_NULL, 100); -stix_poptmps (stix, 2); -stix_putatsysdic (stix, a, k); -*/ - -stix_gc (stix); -a = stix_findsymbol (stix, x, 6); -printf ("%p\n", a); - dump_symbol_table (stix); - - - dump_dictionary (stix, stix->sysdic, "System dictionary"); -} -#endif - xtn = stix_getxtn (stix); #if defined(macintosh) @@ -654,8 +575,6 @@ printf ("%p\n", a); g_stix = stix; setup_tick (); -/* objname.ptr = str_system; - objname.len = 6;*/ objname.ptr = str_my_object; objname.len = 8; mthname.ptr = str_main; @@ -669,7 +588,6 @@ printf ("%p\n", a); cancel_tick (); g_stix = STIX_NULL; -/* dump_dictionary (stix, stix->sysdic, "System dictionary");*/ stix_close (stix); #if defined(USE_LTDL)