diff --git a/stix/kernel/Apex.st b/stix/kernel/Apex.st index f63723f..0da1317 100644 --- a/stix/kernel/Apex.st +++ b/stix/kernel/Apex.st @@ -7,12 +7,12 @@ #method(#class) dump { - + } #method dump { - + } ## ------------------------------------------------------- @@ -31,16 +31,39 @@ ## ------------------------------------------------------- ## ------------------------------------------------------- + #method(#class) basicNew + { + + self primitiveFailed. + } + + #method(#class) basicNew: anInteger + { + + self primitiveFailed. + } + #method(#class) new { - - self primitiveFailed. + | x | + x := self basicNew. + x initialize. "TODO: assess if it's good to call 'initialize' from new." + ^x. } #method(#class) new: anInteger { - - self primitiveFailed. + | x | + x := self basicNew: anInteger. + x initialize. "TODO: assess if it's good to call 'initialize' from new." + ^x. + } + + #method initialize + { + "a subclass may override this method." + + ^self. } ## ------------------------------------------------------- @@ -48,12 +71,12 @@ #method class { - + } #method(#class) class { - + ^Class } @@ -62,37 +85,38 @@ #method basicSize { - - ^0 + + self primitiveFailed. + } + + #method(#class) basicSize + { + + self primitiveFailed. } #method basicAt: anInteger { - + self error: 'out of range'. } #method basicAt: anInteger put: anObject { - + self error: 'out of range'. } - #method(#class) basicSize - { - - ^0 - } #method(#class) basicAt: anInteger { - + self error: 'out of range'. } #method(#class) basicAt: anInteger put: anObject { - + self error: 'out of range'. } @@ -103,12 +127,12 @@ { "check if the receiver is identical to anObject. this doesn't compare the contents" - + } #method ~~ anObject { - + ^(self == anObject) not. } @@ -116,12 +140,12 @@ { "check if the receiver is identical to anObject. this doesn't compare the contents" - + } #method(#class) ~~ anObject { - + ^(self == anObject) not. } diff --git a/stix/kernel/Context.st b/stix/kernel/Context.st new file mode 100644 index 0000000..6cc6c39 --- /dev/null +++ b/stix/kernel/Context.st @@ -0,0 +1,186 @@ +#class(#pointer) Context(Apex) +{ +} + +#class(#pointer) MethodContext(Context) +{ + #dcl sender ip sp ntmprs method receiver home origin. + + #method pc + { + ^ip + } + + #method pc: anInteger + { + ip := anInteger. + "sp := sp - 1." "whould this always work??? " + } + + #method sp + { + ^sp. + + } + #method sp: anInteger + { + sp := anInteger. + } + + #method pc: aPC sp: aSP + { + ip := aPC. + sp := aSP. + ##sp := sp - 1. + } +} + +#class(#pointer) BlockContext(Context) +{ + #dcl caller ip sp ntmprs nargs source home origin. + + #method fork + { + "crate a new process in the runnable state" +## TODO + } + + #method newProcess + { + "create a new process in the suspended state" +## TODO + } + + #method newProcessWith: anArray + { + "create a new process in the suspended state passing the elements + of anArray as block arguments" +## TODO + } + + #method value + { + + } + + #method value: a + { + + } + + #method value: a value: b + { + + } + + #method value: a value: b value: c + { + + } + + #method ifTrue: aBlock + { + ^(self value) ifTrue: aBlock. + } + + #method ifFalse: aBlock + { + ^(self value) ifFalse: aBlock. + } + + #method ifTrue: trueBlock ifFalse: falseBlock + { + ^(self value) ifTrue: trueBlock ifFalse: falseBlock + } + + #method whileTrue: aBlock + { +## http://stackoverflow.com/questions/2500483/is-there-a-way-in-a-message-only-language-to-define-a-whiletrue-message-without + +## ---------------------------------------------------------------------------- + +## ^(self value) ifTrue: [aBlock value. self whileTrue: aBlock]. + +## ---------------------------------------------------------------------------- + + ## less block context before whileTrue: is recursively sent. + ## whileTrue: is sent in a method context. +## (self value) ifFalse: [^nil]. +## aBlock value. +## self whileTrue: aBlock. + +## ---------------------------------------------------------------------------- + +## ---------------------------------------------------------------------------- + | pc sp xsp | + + sp := thisContext sp. + sp := sp - 1. "decrement sp by 1 becuase thisContext pushed above affects the sp method" + pc := thisContext pc. + self value ifFalse: [ ^nil "^self" ]. + aBlock value. + ##thisContext pc: pc - 3 sp: sp. + ##thisContext pc: pc + 2 sp: sp. + thisContext pc: pc + 1 sp: sp. + ## this +2 or - 3 above is dependent on the byte code instruction size used for 'store' + ## +2 to skip STORE_INTO_TEMP(pc) and POP_STACKTOP. + ## TODO: make it independent of the byte code size + +## ---------------------------------------------------------------------------- + +## #