--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MessageNd.st Fri Jul 16 11:38:57 1993 +0200
@@ -0,0 +1,1120 @@
+"
+ COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+ParseNode subclass:#MessageNode
+ instanceVariableNames:'receiver selector argArray lineNr'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
+!
+
+MessageNode comment:'
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+'!
+
+!MessageNode class methodsFor:'instance creation'!
+
+receiver:recNode selector:selectorString
+ ^ (self basicNew) receiver:recNode selector:selectorString args:nil lineno:0
+!
+
+receiver:recNode selector:selectorString arg:argNode
+ ^ self receiver:recNode selector:selectorString arg:argNode fold:true
+!
+
+receiver:recNode selector:selectorString arg:argNode fold:folding
+ |result recVal argVal selector|
+
+"
+ The constant folding code can usually not optimize things - this may change
+ when some kind of constant declaration is added to smalltalk.
+"
+ folding ifTrue:[
+ "do constant folding ..."
+ (recNode isConstant and:[argNode isConstant]) ifTrue:[
+ "check if we can do it ..."
+ selectorString knownAsSymbol ifTrue:[
+ (recNode respondsTo:selectorString asSymbol) ifTrue:[
+ "we could do much more here - but then, we need a dependency from
+ the folded selectors method to the method we generate code for ...
+ limit optimizations to those that will never change
+ (or - if you change them - you will crash so bad ...)
+ "
+ selector := selectorString asSymbol.
+ recVal := recNode evaluate.
+ argVal := argNode evaluate.
+ (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
+ (#( @ + - * / // \\ min: max:) includes:selector) ifTrue:[
+ (#( / // \\ ) includes:selector) ifTrue:[
+ argVal = 0 ifTrue:[
+ ^ 'division by zero'
+ ].
+ ].
+ result := recVal perform:selector with:argVal.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+ value:result
+ ]
+ ].
+ (recVal isMemberOf:String) ifTrue:[
+ argVal respondsToArithmetic ifTrue:[
+ (selector == #at:) ifTrue:[
+ result := recVal perform:selector with:argVal.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+ value:result
+ ]
+ ].
+ (argVal isMemberOf:String) ifTrue:[
+ (selector == #',') ifTrue:[
+ result := recVal perform:selector with:argVal.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+ value:result
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
+!
+
+receiver:recNode selector:selectorString args:anArray
+ ^ self receiver:recNode selector:selectorString args:anArray fold:true
+!
+
+receiver:recNode selector:selectorString args:argArray fold:folding
+ (argArray size == 1) ifTrue:[
+ ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:folding
+ ].
+ ^ (self basicNew) receiver:recNode selector:selectorString args:argArray lineno:0
+! !
+
+!MessageNode methodsFor:'accessing'!
+
+receiver:r selector:s args:a lineno:l
+ receiver := r.
+ selector := s asSymbol.
+ argArray := a.
+ lineNr := l
+!
+
+receiver
+ ^ receiver
+!
+
+selector
+ ^ selector
+!
+
+args
+ ^ argArray
+!
+
+arg1
+ ^ argArray at:1
+!
+
+lineNumber:num
+ lineNr := num
+! !
+
+!MessageNode class methodsFor:'queries'!
+
+isMessage
+ ^ true
+!
+
+isBuiltInUnarySelector:sel
+ "return true, if unary selector sel is built in"
+
+ (sel == #peek) ifTrue:[^ true].
+ (sel == #value) ifTrue:[^ true].
+ (sel == #next) ifTrue:[^ true].
+ (sel == #class) ifTrue:[^ true].
+ (sel == #size) ifTrue:[^ true].
+ (sel == #x) ifTrue:[^ true].
+ (sel == #y) ifTrue:[^ true].
+ (sel == #width) ifTrue:[^ true].
+ (sel == #height) ifTrue:[^ true].
+ (sel == #origin) ifTrue:[^ true].
+ (sel == #extent) ifTrue:[^ true].
+ ^ false
+!
+
+isBuiltIn1ArgSelector:sel
+ "return true, if selector sel is built in"
+
+ (sel == #at:) ifTrue:[^ true].
+ (sel == #value:) ifTrue:[^ true].
+ (sel == #bitAnd:) ifTrue:[^ true].
+ (sel == #bitOr:) ifTrue:[^ true].
+ ^ false
+!
+
+isBuiltIn2ArgSelector:sel
+ "return true, if selector sel is built in"
+
+ (sel == #at:put:) ifTrue:[^ true].
+ ^ false
+! !
+
+!MessageNode methodsFor:'printing'!
+
+printOn:aStream indent:i
+ |needParen selectorParts index index2 arg|
+
+ (#(whileTrue: whileFalse:) includes:selector) ifTrue:[
+ (receiver isKindOf:BlockNode) ifTrue:[
+ ^ self printWhileOn:aStream indent:i
+ ].
+ ].
+
+ index := 1.
+ selectorParts := OrderedCollection new.
+ [index == 0] whileFalse:[
+ index2 := selector indexOf:$: startingAt:index.
+ index2 ~~ 0 ifTrue:[
+ selectorParts add:(selector copyFrom:index to:index2).
+ index2 := index2 + 1
+ ].
+ index := index2
+ ].
+
+ needParen := false.
+ receiver isMessage ifTrue:[
+ receiver isUnaryMessage ifFalse:[
+ receiver isBinaryMessage ifFalse:[
+ needParen := true
+ ].
+ ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ receiver printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:')'
+ ].
+
+ 1 to:(argArray size) do:[:argIndex |
+ aStream space.
+ (selectorParts at:argIndex) printOn:aStream.
+ aStream space.
+ arg := argArray at:argIndex.
+ needParen := false.
+ arg isMessage ifTrue:[
+ arg isBinaryMessage ifFalse:[
+ arg isUnaryMessage ifFalse:[
+ needParen := true
+ ]
+ ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+ ]
+!
+
+printWhileOn:aStream indent:i
+ |needParen selectorParts index index2 arg|
+
+ "special handling of whileTrue/whileFalse"
+
+ aStream nextPutAll:'['.
+ receiver statements printOn:aStream indent:i.
+ aStream nextPutAll:'] whileTrue: '.
+
+ arg := argArray at:1.
+ needParen := false.
+ arg isMessage ifTrue:[
+ arg isBinaryMessage ifFalse:[
+ arg isUnaryMessage ifFalse:[
+ needParen := true
+ ]
+ ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+! !
+
+!MessageNode methodsFor:'checks'!
+
+plausibilityCheck
+ |rec arg operand|
+
+ "it once costed me 1h, to find a '==' which
+ should have been an '=' (well, I saw it 50 times but
+ didn't think about it ...).
+ reason enough to add this check here.
+ "
+ ((selector == #==) or:[selector == #~~]) ifTrue:[
+ receiver isConstant ifTrue:[
+ rec := receiver evaluate.
+ ((rec isMemberOf:String) or:[
+ (rec isMemberOf:Float) or:[
+ (rec isMemberOf:Fraction)]]) ifTrue:[
+ operand := rec
+ ].
+ ].
+ (argArray at:1) isConstant ifTrue:[
+ arg := (argArray at:1) evaluate.
+ ((arg isMemberOf:String) or:[
+ (arg isMemberOf:Float) or:[
+ (arg isMemberOf:Fraction)]]) ifTrue:[
+ operand := arg
+ ].
+ ].
+ operand notNil ifTrue:[
+ (selector == #==) ifTrue:[
+ ^ 'identity compare is unsafe here'
+ ].
+ ^ 'identity compare will usually return true here'
+ ]
+ ].
+ ^ nil
+! !
+
+!MessageNode methodsFor:'evaluating'!
+
+evaluate
+ |r nargs argValueArray index|
+
+ argArray isNil ifTrue:[
+ ^ (receiver evaluate) perform:selector
+ ].
+ nargs := argArray size.
+ (nargs == 1) ifTrue:[
+ ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
+ ].
+ (nargs == 2) ifTrue:[
+ ^ (receiver evaluate) perform:selector
+ with:(argArray at:1) evaluate
+ with:(argArray at:2) evaluate
+ ].
+ (nargs == 3) ifTrue:[
+ ^ (receiver evaluate) perform:selector
+ with:(argArray at:1) evaluate
+ with:(argArray at:2) evaluate
+ with:(argArray at:3) evaluate
+ ].
+ r := receiver evaluate.
+ argValueArray := Array new:nargs.
+ index := 1.
+ [index <= nargs] whileTrue:[
+ argValueArray at:index put:((argArray at:index) evaluate).
+ index := index + 1
+ ].
+ ^ r perform:selector withArguments:argValueArray
+!
+
+evaluateForCascade
+ |r nargs argValueArray index|
+
+ r := receiver evaluate.
+ argArray isNil ifTrue:[
+ r perform:selector.
+ ^ r
+ ].
+ nargs := argArray size.
+ (nargs == 1) ifTrue:[
+ r perform:selector with:(argArray at:1) evaluate.
+ ^ r
+ ].
+ (nargs == 2) ifTrue:[
+ r perform:selector with:(argArray at:1) evaluate
+ with:(argArray at:2) evaluate.
+ ^ r
+ ].
+ (nargs == 3) ifTrue:[
+ r perform:selector with:(argArray at:1) evaluate
+ with:(argArray at:2) evaluate
+ with:(argArray at:3) evaluate.
+ ^ r
+ ].
+ argValueArray := Array new:nargs.
+ index := 1.
+ [index <= nargs] whileTrue:[
+ argValueArray at:index put:((argArray at:index) evaluate).
+ index := index + 1
+ ].
+ r perform:selector withArguments:argValueArray.
+ ^ r
+! !
+
+!MessageNode methodsFor:'code generation'!
+
+codeForSideEffectOn:aStream inBlock:b
+ self codeOn:aStream inBlock:b valueNeeded:false
+!
+
+codeOn:aStream inBlock:b
+ self codeOn:aStream inBlock:b valueNeeded:true
+!
+
+optimizedConditionFor:aReceiver with:aByteCode
+ |rec sel|
+
+ rec := aReceiver.
+ (rec class == BlockNode) ifTrue:[
+ rec statements nextStatement isNil ifTrue:[
+ rec := rec statements expression
+ ]
+ ].
+ (rec class == UnaryNode) ifTrue:[
+ sel := rec selector.
+ (sel == #isNil) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #nilJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notNilJump]
+ ].
+ (sel == #notNil) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #notNilJump].
+ (aByteCode == #falseJump) ifTrue:[^ #nilJump]
+ ].
+ (sel == #not) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #falseJump].
+ (aByteCode == #falseJump) ifTrue:[^ #trueJump]
+ ].
+ ^ nil
+ ].
+ (rec class == BinaryNode) ifTrue:[
+ sel := rec selector.
+ rec arg1 isConstant ifTrue:[
+ (rec arg1 value == 0) ifTrue:[
+ (sel == #==) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #zeroJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notZeroJump]
+ ].
+ (sel == #~~) ifTrue:[
+ (aByteCode == #falseJump) ifTrue:[^ #zeroJump].
+ (aByteCode == #trueJump) ifTrue:[^ #notZeroJump]
+ ].
+ ^ nil
+ ]
+ ].
+ (sel == #==) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #eqJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notEqJump]
+ ].
+ (sel == #~~) ifTrue:[
+ (aByteCode == #falseJump) ifTrue:[^ #eqJump].
+ (aByteCode == #trueJump) ifTrue:[^ #notEqJump]
+ ]
+ ].
+ ^ nil
+!
+
+codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for [...] whilexxx:[ ... ]"
+
+ |pos pos2 theReceiver theArg theByteCode optByteCode|
+
+ (selector == #whileTrue:) ifTrue:[
+ theByteCode := #falseJump
+ ] ifFalse:[
+ theByteCode := #trueJump
+ ].
+
+ theReceiver := receiver.
+ optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
+ optByteCode notNil ifTrue:[
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := receiver statements expression arg1
+ ].
+ theReceiver := receiver statements expression receiver.
+ theByteCode := optByteCode
+ ].
+
+ valueNeeded ifTrue:[aStream nextPut:#pushNil].
+ pos := aStream position.
+ optByteCode notNil ifTrue:[
+ theReceiver codeOn:aStream inBlock:b.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b
+ ]
+ ] ifFalse:[
+ theReceiver codeInlineOn:aStream inBlock:b
+ ].
+ aStream nextPut:theByteCode.
+ pos2 := aStream position.
+ aStream nextPut:0.
+ valueNeeded ifTrue:[aStream nextPut:#drop].
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded.
+ aStream nextPut:#jump.
+ aStream nextPut:pos.
+ (aStream contents) at:pos2 put:(aStream position)
+!
+
+codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for n timesRepeat:[ ... ]"
+
+ |pos pos2 theReceiver theArg theByteCode optByteCode|
+
+ theReceiver := receiver.
+ theReceiver codeOn:aStream inBlock:b.
+ valueNeeded ifTrue:[aStream nextPut:#dup].
+
+ pos := aStream position.
+ aStream nextPut:#dup.
+ aStream nextPut:#push0.
+ aStream nextPut:#>.
+ aStream nextPut:#falseJump.
+ pos2 := aStream position.
+ aStream nextPut:0.
+
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false.
+ aStream nextPut:#minus1.
+ aStream nextPut:#jump.
+ aStream nextPut:pos.
+
+ (aStream contents) at:pos2 put:(aStream position)
+!
+
+codeIfElseOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for x ifxxx:[ ... ] yyy:[ ...]"
+
+ |pos pos2 theReceiver theArg theByteCode optByteCode|
+
+ theReceiver := receiver.
+ (selector == #ifTrue:ifFalse:) ifTrue:[
+ theByteCode := #falseJump
+ ] ifFalse:[
+ (selector == #ifFalse:ifTrue:) ifTrue:[
+ theByteCode := #trueJump
+ ]
+ ].
+ optByteCode := self optimizedConditionFor:theReceiver
+ with:theByteCode.
+ optByteCode notNil ifTrue:[
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := theReceiver arg1
+ ].
+ theReceiver := theReceiver receiver.
+ theByteCode := optByteCode
+ ].
+ theByteCode notNil ifTrue:[
+ theReceiver codeOn:aStream inBlock:b.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b
+ ].
+ aStream nextPut:theByteCode.
+ pos := aStream position.
+ aStream nextPut:0.
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded.
+ aStream nextPut:#jump.
+ pos2 := aStream position.
+ aStream nextPut:0.
+ (aStream contents) at:pos put:(aStream position).
+ (argArray at:2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded.
+ (aStream contents) at:pos2 put:(aStream position)
+ ]
+!
+
+codeIfOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for x ifxxx:[ ... ]"
+
+ |pos pos2 theReceiver theArg theByteCode optByteCode subsel|
+
+ theReceiver := receiver.
+
+ (theReceiver class == MessageNode) ifTrue:[
+ subsel := theReceiver selector.
+ (subsel == #and:) ifTrue:[
+ self codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded.
+ ^ self
+ ].
+ (subsel == #or:) ifTrue:[
+ self codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded.
+ ^ self
+ ]
+ ].
+ (selector == #ifTrue:) ifTrue:[
+ theByteCode := #falseJump
+ ] ifFalse:[
+ theByteCode := #trueJump
+ ].
+ optByteCode := self optimizedConditionFor:theReceiver
+ with:theByteCode.
+ optByteCode notNil ifTrue:[
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := theReceiver arg1
+ ].
+ theReceiver := theReceiver receiver.
+ theByteCode := optByteCode
+ ].
+
+ theReceiver codeOn:aStream inBlock:b.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b
+ ].
+ aStream nextPut:theByteCode.
+ pos := aStream position.
+ aStream nextPut:0.
+ (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded.
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos2 := aStream position.
+ aStream nextPut:0.
+ (aStream contents) at:pos put:(aStream position).
+ aStream nextPut:#pushNil.
+ (aStream contents) at:pos2 put:(aStream position)
+ ] ifFalse:[
+ (aStream contents) at:pos put:(aStream position)
+ ]
+!
+
+codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for (x and:[y]) ifxxx:[ ... ]"
+
+ |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3|
+
+
+ theByteCode := #falseJump.
+ theReceiver := receiver receiver.
+
+ optByteCode := self optimizedConditionFor:theReceiver
+ with:theByteCode.
+ optByteCode notNil ifTrue:[
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := theReceiver arg1
+ ].
+ theReceiver := theReceiver receiver.
+ theByteCode := optByteCode
+ ].
+ theReceiver codeOn:aStream inBlock:b.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b
+ ].
+ aStream nextPut:theByteCode.
+ pos1 := aStream position.
+ aStream nextPut:0.
+
+ theReceiver := receiver arg1.
+ theReceiver codeInlineOn:aStream inBlock:b.
+ (selector == #ifTrue:) ifTrue:[
+ aStream nextPut:#falseJump
+ ] ifFalse:[
+ aStream nextPut:#trueJump
+ ].
+ pos2 := aStream position.
+ aStream nextPut:0.
+ (selector == #ifFalse:) ifTrue:[
+ (aStream contents) at:pos1 put:(aStream position)
+ ].
+ (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded.
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos3 := aStream position.
+ aStream nextPut:0.
+ (selector == #ifTrue:) ifTrue:[
+ (aStream contents) at:pos1 put:(aStream position)
+ ].
+ (aStream contents) at:pos2 put:(aStream position).
+ aStream nextPut:#pushNil.
+ (aStream contents) at:pos3 put:(aStream position)
+ ] ifFalse:[
+ (selector == #ifTrue:) ifTrue:[
+ (aStream contents) at:pos1 put:(aStream position)
+ ].
+ (aStream contents) at:pos2 put:(aStream position)
+ ]
+!
+
+codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for (x or:[y]) ifxxx:[ ... ]"
+
+ |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3|
+
+
+ theByteCode := #trueJump.
+ theReceiver := receiver receiver.
+
+ optByteCode := self optimizedConditionFor:theReceiver
+ with:theByteCode.
+ optByteCode notNil ifTrue:[
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := theReceiver arg1
+ ].
+ theReceiver := theReceiver receiver.
+ theByteCode := optByteCode
+ ].
+ theReceiver codeOn:aStream inBlock:b.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b
+ ].
+ aStream nextPut:theByteCode.
+ pos1 := aStream position.
+ aStream nextPut:0.
+
+ theReceiver := receiver arg1.
+ theReceiver codeInlineOn:aStream inBlock:b.
+ (selector == #ifTrue:) ifTrue:[
+ aStream nextPut:#falseJump
+ ] ifFalse:[
+ aStream nextPut:#trueJump
+ ].
+ pos2 := aStream position.
+ aStream nextPut:0.
+ (selector == #ifTrue:) ifTrue:[
+ (aStream contents) at:pos1 put:(aStream position)
+ ].
+ (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded.
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos3 := aStream position.
+ aStream nextPut:0.
+ (selector == #ifFalse:) ifTrue:[
+ (aStream contents) at:pos1 put:(aStream position)
+ ].
+ (aStream contents) at:pos2 put:(aStream position).
+ aStream nextPut:#pushNil.
+ (aStream contents) at:pos3 put:(aStream position)
+ ] ifFalse:[
+ (selector == #ifFalse:) ifTrue:[
+ (aStream contents) at:pos1 put:(aStream position)
+ ].
+ (aStream contents) at:pos2 put:(aStream position)
+ ]
+!
+
+codeAndOrOn:aStream inBlock:b valueNeeded:valueNeeded
+ "generate code for x and/or:[y] - but not in an if"
+
+ |pos theReceiver theByteCode|
+
+self halt.
+ theReceiver := receiver.
+ (selector == #and:) ifTrue:[
+ theByteCode := #falseJump
+ ] ifFalse:[
+ theByteCode := #trueJump
+ ].
+"
+ (self canOptimizeConditionFor:receiver) ifTrue:[
+ theByteCode := self optimizedConditionFor:theReceiver
+ with:theByteCode.
+ theReceiver := theReceiver receiver
+ ].
+"
+ theReceiver codeOn:aStream inBlock:b.
+ aStream nextPut:theByteCode.
+ pos := aStream position.
+ aStream nextPut:0.
+ (argArray at: 1) codeInlineOn:aStream inBlock:b.
+ (aStream contents) at:pos put:(aStream position).
+ valueNeeded ifFalse:[aStream nextPut:#drop]
+!
+
+codeOn:aStream inBlock:b valueNeeded:valueNeeded
+ |nargs isBuiltIn|
+
+ argArray isNil ifTrue:[
+ nargs := 0
+ ] ifFalse:[
+ nargs := argArray size
+ ].
+
+ isBuiltIn := false.
+
+ (nargs == 0) ifTrue:[
+ isBuiltIn := self class isBuiltInUnarySelector:selector
+ ].
+
+ (nargs == 1) ifTrue:[
+ ((argArray at:1) class == BlockNode) ifTrue:[
+ ((selector == #ifTrue:) or:[selector == #ifFalse:]) ifTrue:[
+ self codeIfOn:aStream inBlock:b valueNeeded:valueNeeded.
+ ^ self
+ ].
+"
+ ((selector == #and:) or:[selector == #or:]) ifTrue:[
+ self codeAndOrOn:aStream inBlock:b valueNeeded:valueNeeded.
+ ^ self
+ ].
+"
+ receiver isConstant ifTrue:[
+ (receiver evaluate isKindOf:Number) ifTrue:[
+ self codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded.
+ ^ self
+ ]
+ ].
+
+ (receiver class == BlockNode) ifTrue:[
+ ((selector == #whileTrue:)
+ or:[selector == #whileFalse:]) ifTrue:[
+ self codeWhileOn:aStream inBlock:b
+ valueNeeded:valueNeeded.
+ ^ self
+ ]
+ ]
+ ].
+ isBuiltIn := self class isBuiltIn1ArgSelector:selector
+ ].
+
+ (nargs == 2) ifTrue:[
+ ((argArray at:1) class == BlockNode) ifTrue:[
+ ((argArray at:2) class == BlockNode) ifTrue:[
+ ((selector == #ifTrue:ifFalse:)
+ or:[selector == #ifFalse:ifTrue:]) ifTrue:[
+ self codeIfElseOn:aStream inBlock:b
+ valueNeeded:valueNeeded.
+ ^ self
+ ]
+ ]
+ ].
+ isBuiltIn := self class isBuiltIn2ArgSelector:selector
+ ].
+
+ "can we use a send-bytecode ?"
+ isBuiltIn ifTrue:[
+ (receiver type == #Super) ifFalse:[
+ receiver codeOn:aStream inBlock:b.
+ (nargs > 0) ifTrue:[
+ (argArray at:1) codeOn:aStream inBlock:b.
+ (nargs > 1) ifTrue:[
+ (argArray at:2) codeOn:aStream inBlock:b
+ ]
+ ].
+ aStream nextPut:selector.
+ valueNeeded ifFalse:[
+ aStream nextPut:#drop
+ ].
+ ^ self
+ ]
+ ].
+
+ ((nargs == 0) and:[selector == #yourself]) ifTrue:[
+ "yourself is often added to get the receiver -
+ we get it without the yourself-message"
+
+ valueNeeded ifTrue:[
+ receiver codeOn:aStream inBlock:b
+ ].
+ ^ self
+ ].
+
+ "no - generate a send"
+ ((receiver type ~~ #Self)
+ or:[nargs > 3]) ifTrue:[
+ receiver codeOn:aStream inBlock:b
+ ].
+ argArray notNil ifTrue:[
+ argArray do:[:arg |
+ arg codeOn:aStream inBlock:b
+ ]
+ ].
+ (receiver type == #Super) ifTrue:[
+ aStream nextPut:#superSend.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ aStream nextPut:nargs.
+ aStream nextPut:nil.
+ valueNeeded ifFalse:[
+ aStream nextPut:#drop
+ ].
+ ^ self
+ ].
+ (nargs == 0) ifTrue:[
+ valueNeeded ifTrue:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelf0
+ ] ifFalse:[
+ aStream nextPut:#send0
+ ]
+ ] ifFalse:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelfDrop0
+ ] ifFalse:[
+ aStream nextPut:#sendDrop0
+ ]
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 1) ifTrue:[
+ valueNeeded ifTrue:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelf1
+ ] ifFalse:[
+ aStream nextPut:#send1
+ ]
+ ] ifFalse:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelfDrop1
+ ] ifFalse:[
+ aStream nextPut:#sendDrop1
+ ]
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 2) ifTrue:[
+ valueNeeded ifTrue:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelf2
+ ] ifFalse:[
+ aStream nextPut:#send2
+ ]
+ ] ifFalse:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelfDrop2
+ ] ifFalse:[
+ aStream nextPut:#sendDrop2
+ ]
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 3) ifTrue:[
+ valueNeeded ifTrue:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelf3
+ ] ifFalse:[
+ aStream nextPut:#send3
+ ]
+ ] ifFalse:[
+ (receiver type == #Self) ifTrue:[
+ aStream nextPut:#sendSelfDrop3
+ ] ifFalse:[
+ aStream nextPut:#sendDrop3
+ ]
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ valueNeeded ifTrue:[
+ aStream nextPut:#send
+ ] ifFalse:[
+ aStream nextPut:#sendDrop
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ aStream nextPut:nargs
+!
+
+codeSendOn:aStream inBlock:b valueNeeded:valueNeeded
+ "like code on, but assumes that receiver has already been
+ coded onto stack - needed for cascade"
+
+ |nargs isBuiltIn|
+
+ argArray isNil ifTrue:[
+ nargs := 0
+ ] ifFalse:[
+ nargs := argArray size
+ ].
+
+ isBuiltIn := false.
+
+ (nargs == 0) ifTrue:[
+ isBuiltIn := self class isBuiltInUnarySelector:selector
+ ].
+ (nargs == 1) ifTrue:[
+ isBuiltIn := self class isBuiltIn1ArgSelector:selector
+ ].
+ (nargs == 2) ifTrue:[
+ isBuiltIn := self class isBuiltIn2ArgSelector:selector
+ ].
+
+ "can we use a send-bytecode ?"
+ isBuiltIn ifTrue:[
+ (receiver type == #Super) ifFalse:[
+ (nargs > 0) ifTrue:[
+ (argArray at:1) codeOn:aStream inBlock:b.
+ (nargs > 1) ifTrue:[
+ (argArray at:2) codeOn:aStream inBlock:b
+ ]
+ ].
+ aStream nextPut:selector.
+ valueNeeded ifFalse:[
+ aStream nextPut:#drop
+ ].
+ ^ self
+ ]
+ ].
+
+ argArray notNil ifTrue:[
+ argArray do:[:arg |
+ arg codeOn:aStream inBlock:b
+ ]
+ ].
+
+ (receiver type == #Super) ifTrue:[
+ aStream nextPut:#superSend.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ aStream nextPut:nargs.
+ aStream nextPut:nil.
+ valueNeeded ifFalse:[
+ aStream nextPut:#drop
+ ].
+ ^ self
+ ].
+ (nargs == 0) ifTrue:[
+ (selector == #yourself) ifTrue:[
+ "yourself is often added to get the receiver -
+ we get it without the yourself-message"
+
+ valueNeeded ifFalse:[
+ aStream nextPut:#drop
+ ].
+ ^ self
+ ].
+
+ valueNeeded ifTrue:[
+ aStream nextPut:#send0
+ ] ifFalse:[
+ aStream nextPut:#sendDrop0
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 1) ifTrue:[
+ valueNeeded ifTrue:[
+ aStream nextPut:#send1
+ ] ifFalse:[
+ aStream nextPut:#sendDrop1
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 2) ifTrue:[
+ valueNeeded ifTrue:[
+ aStream nextPut:#send2
+ ] ifFalse:[
+ aStream nextPut:#sendDrop2
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 3) ifTrue:[
+ valueNeeded ifTrue:[
+ aStream nextPut:#send3
+ ] ifFalse:[
+ aStream nextPut:#sendDrop3
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ valueNeeded ifTrue:[
+ aStream nextPut:#send
+ ] ifFalse:[
+ aStream nextPut:#sendDrop
+ ].
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ aStream nextPut:nargs
+!
+
+codeForCascadeOn:aStream inBlock:b
+ "like codeOn, but always leave the receiver instead of the result"
+ |nargs isBuiltIn|
+
+ argArray isNil ifTrue:[
+ nargs := 0
+ ] ifFalse:[
+ nargs := argArray size
+ ].
+
+ isBuiltIn := false.
+
+ (nargs == 0) ifTrue:[
+ isBuiltIn := self class isBuiltInUnarySelector:selector
+ ].
+ (nargs == 1) ifTrue:[
+ isBuiltIn := self class isBuiltIn1ArgSelector:selector
+ ].
+ (nargs == 2) ifTrue:[
+ isBuiltIn := self class isBuiltIn2ArgSelector:selector
+ ].
+
+ receiver codeOn:aStream inBlock:b.
+ aStream nextPut:#dup.
+
+ "can we use a send-bytecode ?"
+ isBuiltIn ifTrue:[
+ (receiver type == #Super) ifFalse:[
+ (nargs > 0) ifTrue:[
+ (argArray at:1) codeOn:aStream inBlock:b.
+ (nargs > 1) ifTrue:[
+ (argArray at:2) codeOn:aStream inBlock:b
+ ]
+ ].
+ aStream nextPut:selector.
+ aStream nextPut:#drop.
+ ^ self
+ ]
+ ].
+
+ "no - generate a send"
+ argArray notNil ifTrue:[
+ argArray do:[:arg |
+ arg codeOn:aStream inBlock:b
+ ]
+ ].
+ (receiver type == #Super) ifTrue:[
+ aStream nextPut:#superSend.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ aStream nextPut:nargs.
+ aStream nextPut:nil.
+ aStream nextPut:#drop.
+ ^ self
+ ].
+ (nargs == 0) ifTrue:[
+ aStream nextPut:#sendDrop0.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 1) ifTrue:[
+ aStream nextPut:#sendDrop1.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 2) ifTrue:[
+ aStream nextPut:#sendDrop2.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ (nargs == 3) ifTrue:[
+ aStream nextPut:#sendDrop3.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ ^ self
+ ].
+ aStream nextPut:#sendDrop.
+ aStream nextPut:lineNr.
+ aStream nextPut:selector.
+ aStream nextPut:nargs
+! !