work in progress to support the named primitive via shared object loading

stix/kernel/Apex.st

@@ -0,0 +1,209 @@
+#class Apex(nil)
+{
+	#dcl(#class) sysdic.
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method(#class) dump
+	{
+		<primitive: #dump>
+	}
+
+	#method dump
+	{
+		<primitive: #dump>
+	}
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method(#class) yourself
+	{
+		^self.
+	}
+
+	#method yourself
+	{
+		^self.
+	}
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method(#class) new
+	{
+		<primitive: #new>
+		self primitiveFailed.
+	}
+
+	#method(#class) new: anInteger
+	{
+		<primitive: #newWithSize>
+		self primitiveFailed.
+	}
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method class
+	{
+		<primitive: #class>
+	}
+
+	#method(#class) class
+	{
+		<primitive: #class>
+		^Class
+	}
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method basicSize
+	{
+		<primitive: #basicSize>
+		^0
+	}
+
+	#method basicAt: anInteger
+	{
+		<primitive: #basicAt>
+		self error: 'out of range'.
+	}
+
+	#method basicAt: anInteger put: anObject
+	{
+		<primitive: #basicAtPut>
+		self error: 'out of range'.
+	}
+
+	#method(#class) basicSize
+	{
+		<primitive: #basicSize>
+		^0
+	}
+
+	#method(#class) basicAt: anInteger
+	{
+		<primitive: #basicAt>
+		self error: 'out of range'.
+	}
+
+	#method(#class) basicAt: anInteger put: anObject
+	{
+		<primitive: #basicAtPut>
+		self error: 'out of range'.
+	}
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method == anObject
+	{
+		"check if the receiver is identical to anObject.
+		 this doesn't compare the contents"
+		<primitive: #identical>
+	}
+
+	#method ~~ anObject
+	{
+		<primitive: #notIdentical>
+		^(self == anObject) not.
+	}
+
+	#method(#class) == anObject
+	{
+		"check if the receiver is identical to anObject.
+		 this doesn't compare the contents"
+		<primitive: #identical>
+	}
+
+	#method(#class) ~~ anObject
+	{
+		<primitive: #notIdentical>
+		^(self == anObject) not.
+	}
+
+	## TODO: add = and ~= for equality check.
+
+	#method isNil
+	{
+		"^self == nil."
+		^false
+	}
+
+	#method notNil
+	{
+		"^(self == nil) not"
+		"^self ~= nil."
+		^true.
+	}
+
+	#method(#class) isNil
+	{
+		"^self == nil."
+		^false
+	}
+
+	#method(#class) notNil
+	{
+		"^(self == nil) not"
+		"^self ~= nil."
+		^true.
+	}
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+	"
+	#method(#class) respondsTo: selectorSymbol
+	{
+		TODO: find selectorSymbol in the class method dictionary...
+	}
+
+	#method respondsTo: selectorSymbol
+	{
+		TODO: find selectorSymbol in the method dictionary...
+	}
+	"
+
+	## -------------------------------------------------------
+	## -------------------------------------------------------
+
+	#method(#class) primitiveFailed
+	{
+		## TODO: implement this
+		## PrimitiveFailureError signal.
+		'primitive failed' dump.
+	}
+
+	#method primitiveFailed
+	{
+		self class primitiveFailed.
+	}
+
+	#method(#class) doesNotUnderstand: messageSymbol
+	{
+		## TODO: implement this
+		## UnrecognizedMessage signal.
+		'does not understand' dump.
+	}
+
+	#method doesNotUnderstand: messageSymbol
+	{
+		self class doesNotUnderstand: messageSymbol
+	}
+
+	#method(#class) error: msgText
+	{
+		## TODO: implement this
+		## Error signal: msgText.
+		msgText dump.
+	}
+
+	#method error: aString
+	{
+		self class error: aString.
+	}
+
+}

stix/kernel/Boolean.st

@@ -0,0 +1,93 @@
+#class Boolean(Object)
+{
+
+	"TODO: do i need to really define methods defined in True and False here?
+	       and call subclassResponsibiltiy?"
+}
+
+#class True(Boolean)
+{
+	#method not
+	{
+		^false
+	}
+
+	#method & aBoolean
+	{
+		^aBoolean
+	}
+
+	#method | aBoolean
+	{
+		^true
+	}
+
+	#method and: aBlock
+	{
+		^aBlock value
+	}
+
+	#method or: aBlock
+	{
+		^true
+	}
+
+	#method ifTrue: trueBlock ifFalse: falseBlock
+	{
+		^trueBlock value.
+	}
+
+	#method ifTrue: trueBlock
+	{
+		^trueBlock value.
+	}
+
+	#method ifFalse: falseBlock
+	{
+		^nil.
+	}
+}
+
+#class False(Boolean)
+{
+	#method not
+	{
+		^true
+	}
+
+	#method & aBoolean
+	{
+		^false
+	}
+
+	#method | aBoolean
+	{
+		^aBoolean
+	}
+
+	#method and: aBlock
+	{
+		^false
+	}
+
+	#method or: aBlock
+	{
+		^aBlock value
+	}
+
+
+	#method ifTrue: trueBlock ifFalse: falseBlock
+	{
+		^falseBlock value.
+	}
+
+	#method ifTrue: trueBlock
+	{
+		^nil.
+	}
+
+	#method ifFalse: falseBlock
+	{
+		^falseBlock value.
+	}
+}

stix/kernel/Class.st

@@ -0,0 +1,5 @@
+
+#class(#pointer) Class(Apex)
+{
+	#dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic.
+}

stix/kernel/Collection-Array.st

@@ -0,0 +1,40 @@
+#class(#pointer) Array(Collection)
+{
+	#method size
+	{
+		^self basicSize.
+	}
+
+	#method at: anInteger
+	{
+		^self basicAt: anInteger.
+	}
+
+	#method at: anInteger put: aValue
+	{
+		^self basicAt: anInteger put: aValue.
+	}
+
+	#method first
+	{
+		^self at: 1.
+	}
+
+	#method last
+	{
+		^self at: self size.
+	}
+
+	#method do: aBlock
+	{
+		1 to: self size do: [:i | aBlock value: (self at: i)].
+	}
+}
+
+#class(#character) String(Array)
+{
+}
+
+#class(#character) Symbol(Array)
+{
+}

stix/kernel/Collection-ByteArray.st

@@ -0,0 +1,13 @@
+#class(#byte) ByteArray(Collection)
+{
+	#method at: anInteger
+	{
+		^self basicAt: anInteger.
+	}
+
+	#method at: anInteger put: aValue
+	{
+		^self basicAt: anInteger put: aValue.
+	}
+
+}

stix/kernel/Collection-Set.st

@@ -0,0 +1,31 @@
+#class Set(Collection)
+{
+	#dcl tally bucket.
+}
+
+#class SymbolSet(Set)
+{
+}
+
+#class Dictionary(Set)
+{
+}
+
+#class SystemDictionary(Dictionary)
+{
+}
+
+
+#class Namespace(Set)
+{
+}
+
+#class PoolDictionary(Set)
+{
+}
+
+#class MethodDictionary(Dictionary)
+{
+
+}
+

stix/kernel/Collection.st

@@ -0,0 +1,3 @@
+#class Collection(Object)
+{
+}

stix/kernel/Number.st

@@ -0,0 +1,37 @@
+#class Number(Magnitude)
+{
+	#method add: aNumber
+	{
+		<primitive: 7>
+	}
+
+	#method + aNumber
+	{
+		<primitive: 7>
+	}
+
+	#method - aNumber
+	{
+		<primitive: 8>
+	}
+
+	#method * aNumber
+	{
+		<primitive: 8>
+	}
+
+	#method = aNumber
+	{
+		<primitive: 10>
+	}
+
+	#method < aNumber
+	{
+		<primitive: 11>
+	}
+
+	#method > aNumber
+	{
+		<primitive: 12>
+	}
+}

stix/kernel/Object.st

@@ -0,0 +1,4 @@
+#class Object(Apex)
+{
+
+}

stix/kernel/Stix.st

@@ -0,0 +1,331 @@
+#include 'Apex.st'.
+#include 'Object.st'.
+#include 'UndefinedObject.st'.
+#include 'Class.st'.
+#include 'Boolean.st'.
+
+
+#class Error(Object)
+{
+	#method(#class) signal: aString
+	{
+		"accept an arbitary object instead of a string. 
+		 the object can be sent displayString for string conversion"
+	}
+}
+
+#class Magnitude(Object)
+{
+}
+
+#class Association(Magnitude)
+{
+	#dcl key value.
+}
+
+#class Character(Magnitude)
+{
+}
+
+#class Number(Magnitude)
+{
+	#method add: aNumber
+	{
+		<primitive: #integerAdd>
+	}
+
+	#method + aNumber
+	{
+		<primitive: #integerAdd>
+	}
+
+	#method - aNumber
+	{
+		<primitive: #integerSub>
+	}
+
+	#method * aNumber
+	{
+		<primitive: #integerMul>
+	}
+
+	#method = aNumber
+	{
+		<primitive: #integerEQ>
+	}
+
+	#method < aNumber
+	{
+		<primitive: #integerLT>
+	}
+
+	#method > aNumber
+	{
+		<primitive: #integerGT>
+	}
+
+
+	#method to: end by: step do: aBlock
+	{
+		| i |
+
+		i := self.
+		(step > 0) 
+			ifTrue: [
+				[ i <= end ] whileTrue: [ 
+					aBlock value: i.
+					i := i + step.
+				]
+			]
+			ifFalse: [
+				[ i >= end ] whileTrue: [
+					aBlock value: i.
+					i := i - step.
+				]
+			].
+	}
+
+	#method to: end do: aBlock
+	{
+		^self to: end by: 1 do: aBlock.
+	}
+}
+
+#class SmallInteger(Number)
+{
+}
+
+#include 'Collection.st'.
+#include 'Collection-ByteArray.st'.
+#include 'Collection-Array.st'.
+#include 'Collection-Set.st'.
+
+
+#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 value
+	{
+		<primitive: #blockValue>
+	}
+
+	#method value: a 
+	{
+		<primitive: #blockValue>
+	}
+
+	#method value: a value: b
+	{
+		<primitive: #blockValue>
+	}
+
+	#method value: a value: b value: c
+	{
+		<primitive: #blockValue>
+	}
+
+	#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 
+
+## ----------------------------------------------------------------------------
+
+##        #<label>:
+##		thisContext pc: #<label> sp: sp.
+##
+##		| pc |
+##		pc := thisContext pc.
+##		^self value ifTrue: [aBlock value. thisContext pc: pc]
+
+## ----------------------------------------------------------------------------
+
+##		self value ifTrue: [ aBlock value. thisContext restart. ].
+	}
+
+	#method pc
+	{
+		^ip
+	}
+
+	#method pc: anInteger
+	{
+		ip := anInteger.
+	}
+	
+	#method sp
+	{
+		^sp
+	}
+
+	#method sp: anInteger
+	{
+		sp := anInteger.
+	}
+
+	#method restart
+	{
+		ip := source pc.
+	}
+
+
+
+	"------ TODO: -------------------------------------"
+	#method on: anError do: anExceptionBlock
+	{
+		"TODO: handle if anError is an ErrorSet .."
+	}
+
+	#method ensure: aBlock
+	{
+	}
+
+	#method ifCurtailed: aBlock
+	{
+	}
+
+	"------ TODO: -------------------------------------"
+}
+
+#class(#pointer) CompiledMethod(Object)
+{
+	#dcl owner preamble preamble_data_1 preamble_data_2 ntmprs nargs code source.
+}
+
+
+#class FFI(Object)
+{
+	#dcl name handle funcs.
+
+	#method(#class) new: aString
+	{
+		^self new open: aString.
+	}
+
+	#method open: aString
+	{
+		self.funcs := Dictionary new.
+		self.name := aString.
+		self.handle := self privateOpen: self.name.
+
+		"[ self.handle := self privateOpen: self.name ] 
+			on: Error do: [
+			]
+			on: XError do: [
+			]."
+
+		^self.
+	}
+
+	#method close
+	{
+		self privateClose: self.handle.
+		self.handle := nil.
+	}
+
+	#method call: aFunctionName withSig: aString withArgs: anArray
+	{
+		| f |
+
+	##	f := self.funcs at: aFunctionName.
+	##	f isNil ifTrue: [
+	##		f := self privateGetSymbol: aFunctionName in: self.handle.
+	##		f isNil ifTrue: [ self error: 'No such function' ].
+	##		self.funcs at: aFunctionName put: f.
+	##	].
+f := self privateGetSymbol: aFunctionName in: self.handle.
+f isNil ifTrue: [ self error: 'No such function' ].
+
+		^self privateCall: f withSig: aString withArgs: anArray
+	}
+
+	#method privateOpen: aString
+	{
+		<primitive: #ffiOpen>
+		^nil. ## TODO: Error signal: 'can not open'
+	}
+
+	#method privateClose: aHandle
+	{
+		<primitive: #ffiClose>
+	}
+
+	#method privateCall: aSymbol withSig: aString withArgs: anArray
+	{
+		<primitive: #ffiCall>
+	}
+
+	#method privateGetSymbol: aString in: aHandle
+	{
+		<primitive: #ffiGetSym>
+		^nil.
+	}
+}
+
+

stix/kernel/UndefinedObject.st

@@ -0,0 +1,12 @@
+#class UndefinedObject(Apex)
+{
+	#method isNil
+	{
+		^true
+	}
+
+	#method notNil
+	{
+		^false.
+	}
+}

stix/kernel/test-005.st

@@ -0,0 +1,312 @@
+
+#include 'Stix.st'.
+
+#################################################################
+## MAIN
+#################################################################
+
+## TODO: use #define to define a class or use #class to define a class.
+##       use #extend to extend a class
+##       using #class for both feels confusing.
+
+#extend Apex
+{
+
+}
+
+#extend SmallInteger
+{
+	#method getTrue: anInteger
+	{
+		^anInteger + 9999.
+	}
+
+	#method inc
+	{
+		^self + 1.
+	}
+}
+
+#class TestObject(Object)
+{
+	#dcl(#class) Q R.
+	#dcl(#classinst) t1 t2.
+}
+
+
+#class MyObject(TestObject)
+{
+	#dcl(#class) C B A.
+
+	#method getTrue
+	{
+		^true.
+	}
+
+	#method getTrue: anInteger
+	{
+		^ anInteger
+	}
+	#method getFalse
+	{
+		^false
+	}
+
+	#method yyy: aBlock
+	{
+		| a |
+		a := aBlock value.
+		^a + 99.
+
+
+		##a := Stix.MyCOM.HashTable new.
+	}
+
+	#method xxx: aBlock
+	{
+		| a |
+		a := self yyy: aBlock.
+		'KKKKKKKKKKKKKKKKKKKKKKKKKKKKK' dump.
+		^a.
+	}
+	#method(#class) main2 
+	{
+		| a b c sum |
+
+##		##(10 add: 20) dump.
+##		(10 + 20) dump.
+##
+##		a := 10 + 20 + 30.
+##		b := [:x :y | | t z | x := 20. b := 9. x := 10 + 20 ].
+##
+##		(b value: 10 value: 20) dump.
+##		
+##		thisContext basicSize dump.
+##
+##		(thisContext basicAt: (8 + 5)) dump.
+##
+##		^self.
+
+		a := self new.
+		##a yourself.
+		##b := a getTrue; getFalse.
+		##b := a getTrue; getFalse; getTrue: 20 + 10.
+		##b := a getTrue; getFalse; getTrue: 20 + 10; getTrue: 90 + 20.
+		##b := 3 + 5 getTrue: 20; getTrue: 8 + 1; getTrue: 20; yourself.
+
+		b := 3 + 5 inc getTrue: 20 + (30 getTrue: 20; yourself); yourself.
+
+		##b := [:q | q ] value: a getTrue.
+		b dump.
+
+		##^self.
+
+## ############################################################
+##		A := 99.
+		[:x :y | R := y. ] value: 10 value: 6.
+		R := R + 1.
+		R dump.
+
+		sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ].
+		##sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1)) + (sum value: (n - 2))] ].
+		(sum value: R; value: 5) dump.
+
+##sum := [ :n | sum value: 5 ].
+##sum value: 5.
+
+		#[ 1 2 3] dump.
+		#[ 4 5 6] dump.
+	#(abc:def: 2 'string is good' 3 4 (5 6) (7 (8 9)) 10) dump.
+		#([] #[]) dump.
+
+
+	a := #(abc:def: -2 'string is good' 3 #[2 3 4] 4 (5 6) (7 (8 [4 56] 'hello' 9)) 10 -93952 self true false nil thisContext super).
+	a at: 3 put: 'hello world'; dump.
+
+
+	a := self new.
+	(a xxx: [888]) dump.
+	20 dump.
+
+	b := 0.
+	[ b < 9 ] whileTrue: [ b dump. b := b + 1 ].
+
+	S'hello \t\u78966\u8765\u3456\u2723\x20\123world\uD57C\uB85C\uC6B0' dump.
+	C'\n' dump.
+#abc:def: dump.
+
+		##a := (11 < 10) ifTrue: [5] ifFalse: [20].
+		##a dump.
+	}
+
+	#method(#class) main55
+	{
+		|a b c|
+
+		self main2.
+##		b := 0.
+##		[ b < 5 ] whileTrue: [ b dump. b := b + 1 ].
+	}
+
+	#method(#class) getTen
+	{
+		^10
+	}
+
+## ---------------------------------------------------------------------------
+
+" this sample demonstrates what happens when a block context returns to the origin's caller
+  after the caller has already returned. "
+
+	#method(#class) xxxx
+	{
+		| g1 g2 |
+		t1 dump.
+		t2 := [ |tmp| g1 := 50. g2 := 100. tmp := g1 + g2. tmp dump. ^tmp ].
+		(t1 < 100) ifFalse: [ ^self ].
+
+		t1 := t1 + 1. 
+		self xxxx
+	}
+	#method(#class) yyyy
+	{
+		|c1|
+		t1 := 1.
+		c1 :=self xxxx.
+		888 dump.
+		999 dump.
+		^c1.
+	}
+	#method(#class) main66
+	{
+		self yyyy.
+		t2 := t2 value.  "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
+		t2 dump.
+	}
+
+	#method(#class) mainj
+	{
+		|k1|
+		t1 := 1.
+		self xxxx.
+
+		t2 := t2 value.  "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
+		t2 dump.
+	}
+## ----------------------------------------------------------------------
+
+	#method(#class) main22
+	{
+		|a b c d e f g h i j k sum |
+
+		sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ].
+		(sum value: 5) dump.
+
+		'-------------------------' dump.
+		b := 0.
+		[ b < 2000 ] whileTrue: [ b dump. b := b + 1 ].
+
+		'-------------------------' dump.
+		b := 0.
+		[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
+
+		'-------------------------' dump.
+		 a := #[4 5 6 7] at: 3. 
+		(#[3 2 1] at: 3) dump.
+
+
+		## thisContext value. "the message value must be unresolvable as thisContext is a method context"
+		## [thisContext value] value.
+		'-------------------------' dump.
+		b := 0.
+		[ b := b + 1. b dump. thisContext value] value.
+
+		[self getTen] value dump.
+	}
+
+	#method(#class) abc
+	{
+		<primitive: #abc_integer_add>
+	}
+
+	#method(#class) main
+	{
+		"| ffi |
+		ffi := FFI new: 'libc.so.6'.
+		## ffi call: #printf with: #((str '%d') (int 10) (long 20)).
+		 ffi call: #printf withSig: 'i|sii' withArgs: #(S'hello world %d %d\n' 11123 9876543).
+		## ffi call: #puts withSig: 'i|s' withArgs: #('hello world').
+		ffi close."
+		self abc.
+
+		FFI isNil dump.
+		FFI notNil dump.
+		nil isNil dump.
+		nil notNil dump.
+		nil class dump.
+		nil class class class dump.
+	}
+}
+
+
+"
+ [ a := 20.  b := [ a + 20 ].   b value. ] value
+^                 ^               ^        ^              
+p1                p3             p4        p2
+
+--------------------------------------------------------------------------------
+AC
+--------------------------------------------------------------------------------
+		mc1<active>
+		   mc1->sender := fake_initial_context.
+		   mc1->home := nil.
+		   mc1->origin := mc1.
+
+mc1		p1 -> bc1 is created based on mc1 (mc1 blockCopy:)
+		   bc1->caller := nil
+		   bc1->origin := mc1.
+		   bc1->home := mc1. (the active context is a method context. so just use it as a home).
+		   bc1->source := nil.
+		   
+mc1		p2 -> bc2 is shallow-copied of bc1. (bc1 value)
+		   bc2->caller := mc1. (mc1 is the active context at p2 time)
+		   bc2->origin := bc1->origin.
+		   bc2->home := bc1->home.
+		   bc2->source := bc1.
+
+bc2		bc3 is created based on bc2. (bc2 blockCopy:)
+		   bc3->caller := nil 
+		   bc3->origin := bc2->origin
+		   //bc3->home := bc2. 
+		   bc3->home := bc2->source. (the active context is a block context. take from the block context's source */
+		   bc3->source := nil.
+
+bc2		bc4 is shallow-copied of bc3.   (bc3 value)
+		   bc4->caller := bc2. (bc2 is the active context at p2 time)
+		   bc4->origin := bc3->origin
+		   bc4->home := bc3->home
+		   bc4->source = bc3.
+
+bc4.
+--------------------------------------------------------------------------------
+
+'home' is set when the context is created by blockCopy.
+'caller' is set when the context is activated.
+all 'origin' fields point to mc1 as a result.
+self represents the receiver. that is bc->origin->receiver which is mc1->receiver.
+
+--------------------------------------------------------------------------------
+
+#method ifTrue: trueBlock
+{
+	^trueBlock value.
+}
+
+#method whileTrue: aBlock
+{
+	(self value) ifTrue: [aBlock value. self whileTrue: aBlock].
+}
+
+[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
+
+"