diff --git a/stix/kernel/Apex.st b/stix/kernel/Apex.st index e038ad8..34b5096 100644 --- a/stix/kernel/Apex.st +++ b/stix/kernel/Apex.st @@ -74,7 +74,6 @@ #method initialize { "a subclass may override this method." - ^self. } @@ -123,6 +122,7 @@ #method basicAt: anInteger { +## TODO: chagne it to 'self outOfRangeError' or something. self error: 'out of range'. } @@ -219,7 +219,7 @@ ## ------------------------------------------------------- ## ------------------------------------------------------- - ## #method(#class) primitiveFailed + ## method(#class) primitiveFailed ## { ## this method will be added after Exception class has been defined. ## } @@ -254,4 +254,8 @@ self class error: aString. } + #method cannotInstantiate + { + self class cannotInstantiate + } } diff --git a/stix/kernel/Class.st b/stix/kernel/Class.st index 9f4ee98..f6eb062 100644 --- a/stix/kernel/Class.st +++ b/stix/kernel/Class.st @@ -2,4 +2,43 @@ #class(#pointer) Class(Apex) { #dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic. + + #method(#class) basicNew + { + ## you must not instantiate a new class this way. + self cannotInstantiate. + } + + #method(#class) initialize + { + ^self. + } + + #method name + { + ^self.name + } + + #method superclass + { + ^self.superclass + } + + #method specNumInstVars + { + ## shift right by 7 bits. + ## see stix-prv.h for details. + ^self.spec bitShift: -7 + } + + #method inheritsFrom: aSuperclass + { + | c | + c := self superclass. + [c notNil] whileTrue: [ + [ c == aSuperclass ] ifTrue: [^true]. + c := c superclass. + ]. + ^false + } } diff --git a/stix/kernel/Collection-Array.st b/stix/kernel/Collection-Array.st index 463c684..0c9fd7a 100644 --- a/stix/kernel/Collection-Array.st +++ b/stix/kernel/Collection-Array.st @@ -43,8 +43,21 @@ #class(#character) String(Array) { + #method , aString + { + ## 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 contacated 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)]. + ^newstr + } } -#class(#character) Symbol(Array) +#class(#character) Symbol(String) { } diff --git a/stix/kernel/Context.st b/stix/kernel/Context.st index e25426d..ce9657f 100644 --- a/stix/kernel/Context.st +++ b/stix/kernel/Context.st @@ -7,20 +7,10 @@ ^self.sender } -" #method isHandlerContext + #method isExceptionHandlerContext { - return ^false - }" - - #method handles: anException - { - ^false. + ^false } - -## #method parent -## { -## ^self.sender -## } } #class(#pointer) MethodContext(Context) @@ -29,53 +19,61 @@ #method pc { - ^ip + ^self.ip } #method pc: anInteger { - ip := anInteger. - "sp := sp - 1." "whould this always work??? " + self.ip := anInteger. + "self.sp := self.sp - 1." "whould this always work??? " } #method sp { - ^sp. + ^self.sp. } #method sp: anInteger { - sp := anInteger. + self.sp := anInteger. } #method pc: aPC sp: aSP { - ip := aPC. - sp := aSP. + self.ip := aPC. + self.sp := aSP. ##sp := sp - 1. } -## #method methodName -## { -## ^self.method basicAt: 0. -## } + #method method + { + ^self.method + } - #method isHandlerContext + #method isExceptionHandlerContext { ## 10 - STIX_METHOD_PREAMBLE_EXCEPTION in VM. ^self.method preambleCode == 10. } - #method handles: anException + #method findExceptionHandlerBlock: anException { - (self isHandlerContext) ifTrue: [^true]. ## TODO: check if xxxx - ^false - } + ## for this to work, self must be an exception handler context. + ## For a single on:do: call, + ## self class specNumInstVars must return 8. + ## basicAt: 8 must be the on: argument. + ## basicAt: 9 must be the do: argument - #method handlerBlock - { - ## for this to work, self must be a handler context. - ^self basicAt: 9 + (self isExceptionHandlerContext) ifTrue: [ + | bound exc | + ## NOTE: if on:do: has a temporary varible, bound must be adjusted to reflect it. + bound := self basicSize - 1. + 8 to: bound by: 2 do: [ :i | + exc := self basicAt: i. + ((anException == exc) or: [anException inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)]. + ] + ]. + ^nil. } } @@ -237,11 +235,11 @@ "------ TODO: -------------------------------------" #method on: anException do: anExceptionBlock { - | handlerActive | +" | handlerActive |" - handlerActive := true. +" handlerActive := true. -"thisContext isHandlerContext dump. +thisContext isExceptionHandlerContext dump. (thisContext basicSize) dump. (thisContext basicAt: 8) dump. ## this should be anException (thisContext basicAt: 9) dump. ## this should be anExceptionBlock @@ -251,7 +249,12 @@ ^self value. } - + #method on: exc1 do: blk1 on: exc2 do: blk2 + { + + ^self value. + } + #method ensure: aBlock { @@ -274,9 +277,11 @@ "------ TODO: -------------------------------------" } -#class Exception(Object) +## TODO: is it better to inherit from Object??? +## or treat Exception specially like UndefinedObject or Class??? +#class Exception(Apex) { - #dcl signalContext handlerContext messageText. + #dcl signalContext handlerContext handlerBlock messageText. #method(#class) signal { @@ -296,14 +301,8 @@ #method signal { self.signalContext := thisContext. - - self.handlerContext isNil ifTrue: [ - self.handlerContext := self findHandlerContextStartingFrom: self.signalContext - ]. - - self.handlerContext isNil - ifTrue: [ self notHandled ] - ifFalse: [ self handle ]. + self findHandlerContextStartingFrom: self.signalContext. + self handleException. } #method signal: text @@ -315,17 +314,17 @@ #method pass { ## pass the exception to the outer context - - ## TODO: Should i change the signalContex to thisContext??? - self.handlerContext := self findHandlerContextStartingFrom: (self.handlerContext sender). - self.handlerContext isNil - ifTrue: [ self notHandled ] - ifFalse: [ self handle ]. + self.signalContext notNil + ifTrue: [ ## it's signaled earlier + ## TODO: Should i change the signalContex to thisContext??? + self findHandlerContextStartingFrom: (self.handlerContext sender). + self handleException. + ] } #method return: value { - self.handlerContext isNil ifFalse: [ + self.handlerContext notNil ifTrue: [ Processor return: value to: (self.handlerContext sender) ] } @@ -333,32 +332,39 @@ #method retry { ## TODO: verify if return:to: causes unnecessary stack growth. - - self.handlerContext pc: 0. - Processor return: self to: self.handlerContext. - ##Processor forceContext: self.handlerContext. + self.handlerContext notNil + ifTrue: [ + ## TODO: should i reset self.handlerContext and self.signalContext to nil? + self.handlerContext pc: 0. + Processor return: self to: self.handlerContext. + ##Processor forceContext: self.handlerContext. + ] } #method resume { ## TODO: verify if return:to: causes unnecessary stack growth. ## is this correct??? - Processor return: self to: (self.signalContext sender). + self.signalContext notNil + ifTrue: [ + ## TODO: should i reset self.handlerContext and self.signalContext to nil? + Processor return: self to: (self.signalContext sender). + ] } ## #################################################################### ## #################################################################### - - #method handle + #method handleException { - Processor return: (self.handlerContext handlerBlock value: self) to: (self.handlerContext sender) - } - - #method notHandled - { -'####################### EXCEPTION NOT HANDLED ###############################' dump. -## TODO: debug the current process???? " -Processor activeProcess terminate. + self.handlerContext notNil + ifTrue: [ + Processor return: (self.handlerBlock value: self) to: (self.handlerContext sender) + ] + ifFalse: [ + ('### EXCEPTION NOT HANDLED #### ', self class name, ' - ', self messageText) dump. + ## TODO: debug the current process???? " + Processor activeProcess terminate. + ]. } #method handlerContext @@ -374,9 +380,17 @@ Processor activeProcess terminate. | ctx | ctx := aContext. - [ ctx notNil ] - whileTrue: [ - (ctx handles: self) ifTrue: [ ^ ctx ]. + [ ctx notNil ] whileTrue: [ + ##(ctx handles: self) ifTrue: [ ^ ctx ]. + (ctx isExceptionHandlerContext) ifTrue: [ + | blk | + blk := ctx findExceptionHandlerBlock: (self class). + (blk notNil) ifTrue: [ + self.handlerBlock := blk. + self.handlerContext := ctx. + ^ctx + ]. + ]. ctx := ctx sender ]. ^nil @@ -385,22 +399,31 @@ Processor activeProcess terminate. #class NoSuchMessageException(Exception) { - #method signal - { - self signal: 'no such message'. - } } +#class PrimitiveFailureException(Exception) +{ +} #extend Apex { #method(#class) primitiveFailed { ## TODO: implement this - ## PrimitiveFailureError signal. - self dump. - ##'primitive failed' dump. -# TODO: define a specialized exception class for primitive failure and use it. - Exception signal: 'PRIMITIVE FAILED...'. +## experimental backtrace... +| ctx | +ctx := thisContext. +[ctx notNil] whileTrue: [ + (ctx class == MethodContext) + ifTrue: [ (ctx method owner name, ' - ', ctx method name) dump ]. + ## TODO: include blockcontext??? + ctx := ctx sender. +]. + PrimitiveFailureException signal: 'PRIMITIVE FAILED'. + } + + #method(#class) cannotInstantiate + { + Exception signal: 'Cannot instantiate'. } } diff --git a/stix/kernel/Stix.st b/stix/kernel/Stix.st index 4e5980d..6b38864 100644 --- a/stix/kernel/Stix.st +++ b/stix/kernel/Stix.st @@ -253,7 +253,7 @@ #class(#pointer) CompiledMethod(Object) { - #dcl owner preamble preamble_data_1 preamble_data_2 ntmprs nargs code source. + #dcl owner name preamble preamble_data_1 preamble_data_2 ntmprs nargs code source. #method preamble { @@ -264,6 +264,16 @@ { ^self.preamble bitAnd: 16rFF. } + + #method owner + { + ^self.owner + } + + #method name + { + ^self.name + } } #include 'Context.st'. diff --git a/stix/kernel/test-011.st b/stix/kernel/test-011.st index e9337d1..ec3a41e 100644 --- a/stix/kernel/test-011.st +++ b/stix/kernel/test-011.st @@ -54,14 +54,20 @@ #method(#class) test3 { - | k j | + | k j g_ex | j := 20. k := [ '>>> TEST3 METHOD >>> ' dump. j dump. (j < 25) ifTrue: [ | t | - t := Exception signal: 'bad exceptinon'. ## when resume, t should get Exception. - t := self raise_exception. ## when resumed, t should get 'self' + t := Exception signal: 'bad exceptinon'. ## when resumed, t should get Exception, the leftover in the stack... + t signal: 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. ## so it should be ok to signal again.. + ##t := self raise_exception. ## when resumed, t should get 'self' + + ##g_ex retry. # You should not do these as the following 3 lines make things very complicated. + ##g_ex signal. + ##g_ex pass. + 'RESUMED???' dump. t dump. j dump. @@ -69,7 +75,7 @@ 'OOOOOOOOOOOOOOOOOOOOOOO' dump. 'JJJJJJJJJJJJJJ' dump. - ] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. ex resume. ]. + ] on: Exception do: [ :ex | 'Exception occurred' dump. ex messageText dump. j := j + 1. g_ex := ex. ex resume. ]. k dump. 'END OF TEST3' dump. @@ -152,6 +158,7 @@ ] on: Exception do: [:ex | 'EXCEPTION ----------' dump. ex messageText dump ]. } + #method(#class) main { @@ -163,14 +170,18 @@ ## self test3. ## self test4. - self test5. + ## self test5. ## self test11. ## self test12. - ##100 timesRepeat: ['>>>>> END OF MAIN' dump]. + '@@@@@@@@@@@@@@@@@@@@@@@@@@@@' dump. ## the following line(return:to:) must cause primitive failure... - ##[ Processor return: 10 to: 20. ] on: Exception do: [:ex | ex messageText dump]. + [ Processor return: 10 to: 20. ] on: Exception do: [:ex | ex messageText dump]. + + ##[ Processor return: 10 to: 20. ] + ## on: PrimitiveFailureException do: [:ex | 'PRIMITIVE FAILURE CAUGHT HERE HERE HERE' dump] + ## on: Exception do: [:ex | ex messageText dump]. '>>>>> END OF MAIN' dump. } diff --git a/stix/lib/comp.c b/stix/lib/comp.c index 8ca8def..c95a7c9 100644 --- a/stix/lib/comp.c +++ b/stix/lib/comp.c @@ -4133,7 +4133,7 @@ printf ("\treturn_receiver\n"); static int add_compiled_method (stix_t* stix) { - stix_oop_t name; /* selector */ + stix_oop_char_t name; /* selector */ stix_oop_method_t mth; /* method */ #if defined(STIX_USE_OBJECT_TRAILER) /* nothing extra */ @@ -4144,9 +4144,9 @@ static int add_compiled_method (stix_t* stix) stix_oow_t i; stix_ooi_t preamble_code, preamble_index; - name = stix_makesymbol (stix, stix->c->mth.name.ptr, stix->c->mth.name.len); + name = (stix_oop_char_t)stix_makesymbol (stix, stix->c->mth.name.ptr, stix->c->mth.name.len); if (!name) return -1; - stix_pushtmp (stix, &name); tmp_count++; + stix_pushtmp (stix, (stix_oop_t*)&name); tmp_count++; /* The variadic data part passed to stix_instantiate() is not GC-safe */ #if defined(STIX_USE_OBJECT_TRAILER) @@ -4295,6 +4295,7 @@ static int add_compiled_method (stix_t* stix) STIX_ASSERT (STIX_OOI_IN_PREAMBLE_INDEX_RANGE(preamble_index)); mth->owner = stix->c->cls.self_oop; + mth->name = name; mth->preamble = STIX_SMOOI_TO_OOP(STIX_METHOD_MAKE_PREAMBLE(preamble_code, preamble_index)); mth->preamble_data[0] = STIX_SMOOI_TO_OOP(0); mth->preamble_data[1] = STIX_SMOOI_TO_OOP(0); @@ -4314,7 +4315,7 @@ need to write code to collect string. stix_poptmps (stix, tmp_count); tmp_count = 0; - if (!stix_putatdic(stix, stix->c->cls.mthdic_oop[stix->c->mth.type], name, (stix_oop_t)mth)) goto oops; + if (!stix_putatdic(stix, stix->c->cls.mthdic_oop[stix->c->mth.type], (stix_oop_t)name, (stix_oop_t)mth)) goto oops; return 0; oops: diff --git a/stix/lib/exec.c b/stix/lib/exec.c index 677bf50..70f6c85 100644 --- a/stix/lib/exec.c +++ b/stix/lib/exec.c @@ -942,6 +942,8 @@ static stix_oop_method_t find_method (stix_t* stix, stix_oop_t receiver, const s #if defined(STIX_DEBUG_EXEC_002) printf ("==== FINDING METHOD FOR %p [", receiver); +print_object (stix, receiver); +printf ("] - ["); print_oocs (message); printf ("] in "); #endif @@ -949,7 +951,7 @@ printf ("] in "); cls = (stix_oop_class_t)STIX_CLASSOF(stix, receiver); if ((stix_oop_t)cls == stix->_class) { - /* receiver is a class object */ + /* receiver is a class object (an instance of Class) */ c = receiver; dic_no = STIX_CLASS_MTHDIC_CLASS; #if defined(STIX_DEBUG_EXEC_002) @@ -969,7 +971,6 @@ printf ("\n"); #endif } - if (c != stix->_nil) { if (super) @@ -997,6 +998,22 @@ printf ("\n"); } not_found: + if ((stix_oop_t)cls == stix->_class) + { + /* the object is an instance of Class. find the method + * in an instance method dictionary of Class also */ + mthdic = ((stix_oop_class_t)cls)->mthdic[STIX_CLASS_MTHDIC_INSTANCE]; + STIX_ASSERT ((stix_oop_t)mthdic != stix->_nil); + STIX_ASSERT (STIX_CLASSOF(stix, mthdic) == stix->_method_dictionary); + + ass = (stix_oop_association_t)stix_lookupdic (stix, mthdic, message); + if (ass) + { + STIX_ASSERT (STIX_CLASSOF(stix, ass->value) == stix->_method); + return (stix_oop_method_t)ass->value; + } + } + stix->errnum = STIX_ENOENT; return STIX_NULL; } @@ -1054,7 +1071,7 @@ TODO: overcome this problem ctx->ip = STIX_SMOOI_TO_OOP(0); /* point to the beginning */ ctx->sp = STIX_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */ ctx->origin = ctx; /* point to self */ - ctx->method_or_nargs = (stix_oop_t)mth; /* fake. help SWITCH_ACTIVE_CONTEXT() not fail*/ + ctx->method_or_nargs = (stix_oop_t)mth; /* fake. help SWITCH_ACTIVE_CONTEXT() not fail. TODO: create a static fake method and use it... instead of 'mth' */ /* [NOTE] * the receiver field and the sender field of ctx are nils. diff --git a/stix/lib/stix.h b/stix/lib/stix.h index 7c0bd18..eef0f03 100644 --- a/stix/lib/stix.h +++ b/stix/lib/stix.h @@ -416,9 +416,9 @@ struct stix_association_t }; #if defined(STIX_USE_OBJECT_TRAILER) -# define STIX_METHOD_NAMED_INSTVARS 7 -#else # define STIX_METHOD_NAMED_INSTVARS 8 +#else +# define STIX_METHOD_NAMED_INSTVARS 9 #endif typedef struct stix_method_t stix_method_t; typedef struct stix_method_t* stix_oop_method_t; @@ -428,6 +428,8 @@ struct stix_method_t stix_oop_class_t owner; /* Class */ + stix_oop_char_t name; /* Symbol, method name */ + /* primitive number */ stix_oop_t preamble; /* SmallInteger */