--- a/AssignNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/AssignNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#AssignmentNode
- instanceVariableNames:'variable expression'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'variable expression'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!AssignmentNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/AssignNd.st,v 1.13 1995-11-11 15:29:49 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing assignments
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/AssignNd.st,v 1.14 1995-11-23 02:12:04 cg Exp $'
! !
!AssignmentNode class methodsFor:'instance creation'!
@@ -49,32 +49,15 @@
^ (self basicNew) variable:v expression:e
! !
-!AssignmentNode methodsFor:'evaluating'!
-
-evaluate
- |value|
- value := expression evaluate.
- variable store:value.
- ^ value
-! !
+!AssignmentNode methodsFor:'accessing'!
-!AssignmentNode methodsFor:'queries'!
-
-isAssignment
- "return true, if this is a node for an assignment"
-
- ^ true
-! !
-
-!AssignmentNode methodsFor:'accessing'!
+expression
+ ^ expression
+!
variable:v expression:e
variable := v.
expression := e
-!
-
-expression
- ^ expression
! !
!AssignmentNode methodsFor:'code generation'!
@@ -126,6 +109,15 @@
variable codeStoreOn:aStream inBlock:b valueNeeded:true for:aCompiler
! !
+!AssignmentNode methodsFor:'evaluating'!
+
+evaluate
+ |value|
+ value := expression evaluate.
+ variable store:value.
+ ^ value
+! !
+
!AssignmentNode methodsFor:'printing'!
printOn:aStream indent:i
@@ -133,3 +125,12 @@
aStream nextPutAll:' := '.
expression printOn:aStream
! !
+
+!AssignmentNode methodsFor:'queries'!
+
+isAssignment
+ "return true, if this is a node for an assignment"
+
+ ^ true
+! !
+
--- a/AssignmentNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/AssignmentNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#AssignmentNode
- instanceVariableNames:'variable expression'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'variable expression'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!AssignmentNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/AssignmentNode.st,v 1.13 1995-11-11 15:29:49 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing assignments
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/AssignmentNode.st,v 1.14 1995-11-23 02:12:04 cg Exp $'
! !
!AssignmentNode class methodsFor:'instance creation'!
@@ -49,32 +49,15 @@
^ (self basicNew) variable:v expression:e
! !
-!AssignmentNode methodsFor:'evaluating'!
-
-evaluate
- |value|
- value := expression evaluate.
- variable store:value.
- ^ value
-! !
+!AssignmentNode methodsFor:'accessing'!
-!AssignmentNode methodsFor:'queries'!
-
-isAssignment
- "return true, if this is a node for an assignment"
-
- ^ true
-! !
-
-!AssignmentNode methodsFor:'accessing'!
+expression
+ ^ expression
+!
variable:v expression:e
variable := v.
expression := e
-!
-
-expression
- ^ expression
! !
!AssignmentNode methodsFor:'code generation'!
@@ -126,6 +109,15 @@
variable codeStoreOn:aStream inBlock:b valueNeeded:true for:aCompiler
! !
+!AssignmentNode methodsFor:'evaluating'!
+
+evaluate
+ |value|
+ value := expression evaluate.
+ variable store:value.
+ ^ value
+! !
+
!AssignmentNode methodsFor:'printing'!
printOn:aStream indent:i
@@ -133,3 +125,12 @@
aStream nextPutAll:' := '.
expression printOn:aStream
! !
+
+!AssignmentNode methodsFor:'queries'!
+
+isAssignment
+ "return true, if this is a node for an assignment"
+
+ ^ true
+! !
+
--- a/BinaryNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/BinaryNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
MessageNode subclass:#BinaryNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!BinaryNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/BinaryNd.st,v 1.17 1995-11-11 15:30:10 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing binary message sends
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/BinaryNd.st,v 1.18 1995-11-23 02:12:23 cg Exp $'
! !
!BinaryNode class methodsFor:'queries'!
@@ -62,27 +62,12 @@
^ false
! !
-!BinaryNode methodsFor:'queries'!
-
-isBinaryMessage
- ^ true
-! !
-
!BinaryNode methodsFor:'accessing'!
arg
^ argArray at:1
! !
-!BinaryNode methodsFor:'evaluating'!
-
-evaluate
- receiver isSuper ifTrue:[
- ^ super evaluate
- ].
- ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
-! !
-
!BinaryNode methodsFor:'code generation'!
codeOn:aStream inBlock:b for:aCompiler
@@ -188,6 +173,15 @@
^ super codeOn:aStream inBlock:b for:aCompiler
! !
+!BinaryNode methodsFor:'evaluating'!
+
+evaluate
+ receiver isSuper ifTrue:[
+ ^ super evaluate
+ ].
+ ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
+! !
+
!BinaryNode methodsFor:'printing'!
printOn:aStream indent:i
@@ -225,3 +219,10 @@
aStream nextPutAll:') '
].
! !
+
+!BinaryNode methodsFor:'queries'!
+
+isBinaryMessage
+ ^ true
+! !
+
--- a/BinaryNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/BinaryNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
MessageNode subclass:#BinaryNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!BinaryNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/BinaryNode.st,v 1.17 1995-11-11 15:30:10 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing binary message sends
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/BinaryNode.st,v 1.18 1995-11-23 02:12:23 cg Exp $'
! !
!BinaryNode class methodsFor:'queries'!
@@ -62,27 +62,12 @@
^ false
! !
-!BinaryNode methodsFor:'queries'!
-
-isBinaryMessage
- ^ true
-! !
-
!BinaryNode methodsFor:'accessing'!
arg
^ argArray at:1
! !
-!BinaryNode methodsFor:'evaluating'!
-
-evaluate
- receiver isSuper ifTrue:[
- ^ super evaluate
- ].
- ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
-! !
-
!BinaryNode methodsFor:'code generation'!
codeOn:aStream inBlock:b for:aCompiler
@@ -188,6 +173,15 @@
^ super codeOn:aStream inBlock:b for:aCompiler
! !
+!BinaryNode methodsFor:'evaluating'!
+
+evaluate
+ receiver isSuper ifTrue:[
+ ^ super evaluate
+ ].
+ ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
+! !
+
!BinaryNode methodsFor:'printing'!
printOn:aStream indent:i
@@ -225,3 +219,10 @@
aStream nextPutAll:') '
].
! !
+
+!BinaryNode methodsFor:'queries'!
+
+isBinaryMessage
+ ^ true
+! !
+
--- a/BlockNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/BlockNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,12 +11,11 @@
"
ParseNode subclass:#BlockNode
- instanceVariableNames:'blockArgs statements home inlineBlock exitBlock
- blockVars
- needsHome lineNr'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'blockArgs statements home inlineBlock exitBlock blockVars
+ needsHome lineNr'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!BlockNode class methodsFor:'documentation'!
@@ -35,14 +34,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.18 1995-11-11 15:30:12 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing blocks
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.19 1995-11-23 02:12:33 cg Exp $'
! !
!BlockNode class methodsFor:'instance creation'!
@@ -51,16 +50,6 @@
^ (self basicNew) setArguments:argList home:h variables:vars
! !
-!BlockNode methodsFor:'private accessing'!
-
-setArguments:argList home:h variables:vars
- inlineBlock := false.
- needsHome := false.
- blockArgs := argList.
- home := h.
- blockVars := vars
-! !
-
!BlockNode methodsFor:'accessing'!
arguments
@@ -71,30 +60,14 @@
blockArgs := argList
!
-variables
- ^ blockVars
-!
-
-variables:varList
- blockVars := varList
-!
-
-statements
- ^ statements
-!
-
-statements:s
- statements := s
+home
+ ^ home
!
home:aBlock
home := aBlock
!
-home
- ^ home
-!
-
inlineBlock
^ inlineBlock
!
@@ -103,6 +76,10 @@
inlineBlock := aBoolean
!
+lineNumber:aNumber
+ lineNr := aNumber
+!
+
needsHome
^ needsHome
!
@@ -111,20 +88,238 @@
needsHome := aBoolean
!
-lineNumber:aNumber
- lineNr := aNumber
+statements
+ ^ statements
+!
+
+statements:s
+ statements := s
+!
+
+variables
+ ^ blockVars
+!
+
+variables:varList
+ blockVars := varList
+! !
+
+!BlockNode methodsFor:'block messages'!
+
+doesNotUnderstand:aMessage
+ |numArgs kludgeBlock|
+
+ (Block implements:(aMessage selector)) ifTrue:[
+ "mhmh - a message which I dont understand, but Block implements
+ send it to a kludgeblock, which will evaluate me again ..."
+ numArgs := blockArgs size.
+ numArgs == 0 ifTrue:[
+ kludgeBlock := [self value]
+ ] ifFalse:[
+ numArgs == 1 ifTrue:[
+ kludgeBlock := [:a1 | self value:a1].
+ ] ifFalse:[
+ numArgs == 2 ifTrue:[
+ kludgeBlock := [:a1 :a2 | self value:a1 value:a2].
+ ] ifFalse:[
+ numArgs == 3 ifTrue:[
+ kludgeBlock := [:a1 :a2 :a3| self value:a1 value:a2 value:a3].
+ ] ifFalse:[
+ numArgs == 4 ifTrue:[
+ kludgeBlock := [:a1 :a2 :a3 :a4| self value:a1 value:a2 value:a3 value:a4].
+ ] ifFalse:[
+ ^ self error:'only support blocks with up-to 4 args'
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ kludgeBlock perform:aMessage selector withArguments:aMessage arguments
+ ].
+ ^ super doesNotUnderstand:aMessage
! !
-!BlockNode methodsFor:'queries'!
+!BlockNode methodsFor:'code generation'!
+
+checkForSimpleBlock
+ "simple things can be made cheap blocks right now -
+ resulting in a simple pushLit instruction ..."
+
+ |cheapy e val code|
+
+ statements isNil ifTrue:[
+ "a []-block"
+
+ val := nil
+ ] ifFalse:[
+ statements nextStatement notNil ifTrue:[^ nil].
+ (statements isMemberOf:StatementNode) ifFalse:[^ nil].
+
+ e := statements expression.
+ e isConstant ifFalse:[^ nil].
+
+ val := e value.
+ ].
+
+ val == 0 ifTrue:[
+ "a [0]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#ret0).
+ ].
+ val == 1 ifTrue:[
+ "a [1]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#push1)
+ with:(ByteCodeCompiler byteCodeFor:#retTop).
+ ].
+
+ val == true ifTrue:[
+ "a [true]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retTrue).
+ ].
+
+ val == false ifTrue:[
+ "a [false]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retFalse).
+ ].
+
+ val == nil ifTrue:[
+ "a [nil]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retNil).
+ ].
+
+ code notNil ifTrue:[
+ cheapy := Block code:nil
+ byteCode:code
+ numArgs:(blockArgs size)
+ sourcePosition:nil
+ initialPC:nil
+ literals:nil
+ dynamic:false.
+ ^ ConstantNode type:#Block value:cheapy
+ ].
+
+ ^ nil
+!
+
+codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ "generate code for this statement - value not needed.
+ For blocks, no code is generated at all."
+
+ ^ self
+!
+
+codeInlineOn:aStream inBlock:b for:aCompiler
+ self codeInlineOn:aStream inBlock:b valueNeeded:true for:aCompiler
+!
+
+codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ |thisStatement nextStatement|
+
+ blockVars notNil ifTrue:[
+ "cannot currently compile this block inline (have to move blockvars into
+ surrounding method. generate a make-block and send it value"
-isBlock
- "a kludge, to have blocknodes mimic blocks"
+"/ Transcript showCr:'cannot (yet) compile block with blockvars inline'.
+ self codeOn:aStream inBlock:b for:aCompiler.
+ aStream nextPut:#value.
+ (MessageNode hasLineNumber:#value) ifTrue:[
+ aStream nextPut:lineNr.
+ ].
+ valueNeeded ifFalse:[
+ aStream nextPut:#drop
+ ].
+ ^ self
+ ].
+ inlineBlock := true.
+ statements isNil ifTrue:[
+ valueNeeded ifTrue:[
+ aStream nextPut:#pushNil
+ ]
+ ] ifFalse:[
+ thisStatement := statements.
+ [thisStatement notNil] whileTrue:[
+ nextStatement := thisStatement nextStatement.
+ (nextStatement notNil or:[valueNeeded not]) ifTrue:[
+ thisStatement codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ ] ifFalse:[
+ thisStatement codeOn:aStream inBlock:b for:aCompiler
+ ].
+ thisStatement := nextStatement
+ ]
+ ]
+!
+
+codeOn:aStream inBlock:b for:aCompiler
+ |thisStatement nextStatement pos code cheapy|
+
+ cheapy := self checkForSimpleBlock.
+ cheapy notNil ifTrue:[
+ cheapy codeOn:aStream inBlock:b for:aCompiler.
+ ^ self
+ ].
+
+ pos := aStream position.
- ^ true
+ aStream nextPut:#makeBlock. "+0"
+ aStream nextPut:0. "+1"
+ aStream nextPut:(blockVars size). "+2"
+ aStream nextPut:(blockArgs size). "+3"
+ statements isNil ifTrue:[
+ aStream nextPut:#pushNil "+4"
+ ] ifFalse:[
+ thisStatement := statements.
+ [thisStatement notNil] whileTrue:[
+ nextStatement := thisStatement nextStatement.
+ nextStatement notNil ifTrue:[
+ thisStatement codeForSideEffectOn:aStream inBlock:self for:aCompiler
+ ] ifFalse:[
+ thisStatement codeOn:aStream inBlock:self for:aCompiler
+ ].
+ thisStatement := nextStatement
+ ]
+ ].
+ aStream nextPut:#retTop.
+
+ "check for [0]-block;
+ these are sometimes used as in ... ifAbsent:[0]
+ "
+ code := (aStream contents).
+ (code at:pos+4) == #push0 ifTrue:[
+ (code at:pos+5) == #retTop ifTrue:[
+ aStream position:pos.
+ code grow:pos.
+ aStream nextPut:#mk0Block.
+ ^ self
+ ]
+ ].
+
+ "check for [nil]-block;
+ these come to play when code in blocks is commented
+ out, or as dummy exception blocks
+ "
+ code := (aStream contents).
+ (code at:pos+4) == #pushNil ifTrue:[
+ (code at:pos+5) == #retTop ifTrue:[
+ aStream position:pos.
+ code grow:pos.
+ aStream nextPut:#mkNilBlock.
+ ^ self
+ ]
+ ].
+
+ (aStream contents) at:pos+1 put:(aStream position)
! !
!BlockNode methodsFor:'evaluating'!
+evaluate
+ ^ self
+!
+
exitWith:something
"return via return-statement"
@@ -135,17 +330,6 @@
^ something
!
-evaluate
- ^ self
-!
-
-wrongNumberOfArguments:numberGiven
- Block argumentSignal
- raiseRequestWith:self
- errorString:('block got ' , numberGiven printString ,
- ' args while ' , blockArgs size printString , ' where expected')
-!
-
value
(blockArgs size ~~ 0) ifTrue:[
^ self wrongNumberOfArguments:0
@@ -265,7 +449,7 @@
(blockArgs at:3) value:oldValue3.
(blockArgs at:4) value:oldValue4.
^ val
-!
+!
valueWithArguments:argArray
|oldValues val|
@@ -293,230 +477,27 @@
(blockArgs at:i) value:(oldValues at:i)
].
^ val
+!
+
+wrongNumberOfArguments:numberGiven
+ Block argumentSignal
+ raiseRequestWith:self
+ errorString:('block got ' , numberGiven printString ,
+ ' args while ' , blockArgs size printString , ' where expected')
! !
!BlockNode methodsFor:'looping'!
-whileTrue:aBlock
- self value ifFalse:[^ nil].
- aBlock value.
- thisContext restart
-!
-
whileFalse:aBlock
self value ifTrue:[^ nil].
aBlock value.
thisContext restart
-! !
-
-!BlockNode methodsFor:'block messages'!
-
-doesNotUnderstand:aMessage
- |numArgs kludgeBlock|
-
- (Block implements:(aMessage selector)) ifTrue:[
- "mhmh - a message which I dont understand, but Block implements
- send it to a kludgeblock, which will evaluate me again ..."
- numArgs := blockArgs size.
- numArgs == 0 ifTrue:[
- kludgeBlock := [self value]
- ] ifFalse:[
- numArgs == 1 ifTrue:[
- kludgeBlock := [:a1 | self value:a1].
- ] ifFalse:[
- numArgs == 2 ifTrue:[
- kludgeBlock := [:a1 :a2 | self value:a1 value:a2].
- ] ifFalse:[
- numArgs == 3 ifTrue:[
- kludgeBlock := [:a1 :a2 :a3| self value:a1 value:a2 value:a3].
- ] ifFalse:[
- numArgs == 4 ifTrue:[
- kludgeBlock := [:a1 :a2 :a3 :a4| self value:a1 value:a2 value:a3 value:a4].
- ] ifFalse:[
- ^ self error:'only support blocks with up-to 4 args'
- ]
- ]
- ]
- ]
- ].
- ^ kludgeBlock perform:aMessage selector withArguments:aMessage arguments
- ].
- ^ super doesNotUnderstand:aMessage
-! !
-
-!BlockNode methodsFor:'code generation'!
-
-codeOn:aStream inBlock:b for:aCompiler
- |thisStatement nextStatement pos code cheapy|
-
- cheapy := self checkForSimpleBlock.
- cheapy notNil ifTrue:[
- cheapy codeOn:aStream inBlock:b for:aCompiler.
- ^ self
- ].
-
- pos := aStream position.
-
- aStream nextPut:#makeBlock. "+0"
- aStream nextPut:0. "+1"
- aStream nextPut:(blockVars size). "+2"
- aStream nextPut:(blockArgs size). "+3"
- statements isNil ifTrue:[
- aStream nextPut:#pushNil "+4"
- ] ifFalse:[
- thisStatement := statements.
- [thisStatement notNil] whileTrue:[
- nextStatement := thisStatement nextStatement.
- nextStatement notNil ifTrue:[
- thisStatement codeForSideEffectOn:aStream inBlock:self for:aCompiler
- ] ifFalse:[
- thisStatement codeOn:aStream inBlock:self for:aCompiler
- ].
- thisStatement := nextStatement
- ]
- ].
- aStream nextPut:#retTop.
-
- "check for [0]-block;
- these are sometimes used as in ... ifAbsent:[0]
- "
- code := (aStream contents).
- (code at:pos+4) == #push0 ifTrue:[
- (code at:pos+5) == #retTop ifTrue:[
- aStream position:pos.
- code grow:pos.
- aStream nextPut:#mk0Block.
- ^ self
- ]
- ].
-
- "check for [nil]-block;
- these come to play when code in blocks is commented
- out, or as dummy exception blocks
- "
- code := (aStream contents).
- (code at:pos+4) == #pushNil ifTrue:[
- (code at:pos+5) == #retTop ifTrue:[
- aStream position:pos.
- code grow:pos.
- aStream nextPut:#mkNilBlock.
- ^ self
- ]
- ].
-
- (aStream contents) at:pos+1 put:(aStream position)
!
-codeForSideEffectOn:aStream inBlock:b for:aCompiler
- "generate code for this statement - value not needed.
- For blocks, no code is generated at all."
-
- ^ self
-!
-
-codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- |thisStatement nextStatement|
-
- blockVars notNil ifTrue:[
- "cannot currently compile this block inline (have to move blockvars into
- surrounding method. generate a make-block and send it value"
-
-"/ Transcript showCr:'cannot (yet) compile block with blockvars inline'.
- self codeOn:aStream inBlock:b for:aCompiler.
- aStream nextPut:#value.
- (MessageNode hasLineNumber:#value) ifTrue:[
- aStream nextPut:lineNr.
- ].
- valueNeeded ifFalse:[
- aStream nextPut:#drop
- ].
- ^ self
- ].
- inlineBlock := true.
- statements isNil ifTrue:[
- valueNeeded ifTrue:[
- aStream nextPut:#pushNil
- ]
- ] ifFalse:[
- thisStatement := statements.
- [thisStatement notNil] whileTrue:[
- nextStatement := thisStatement nextStatement.
- (nextStatement notNil or:[valueNeeded not]) ifTrue:[
- thisStatement codeForSideEffectOn:aStream inBlock:b for:aCompiler
- ] ifFalse:[
- thisStatement codeOn:aStream inBlock:b for:aCompiler
- ].
- thisStatement := nextStatement
- ]
- ]
-!
-
-codeInlineOn:aStream inBlock:b for:aCompiler
- self codeInlineOn:aStream inBlock:b valueNeeded:true for:aCompiler
-!
-
-checkForSimpleBlock
- "simple things can be made cheap blocks right now -
- resulting in a simple pushLit instruction ..."
-
- |cheapy e val code|
-
- statements isNil ifTrue:[
- "a []-block"
-
- val := nil
- ] ifFalse:[
- statements nextStatement notNil ifTrue:[^ nil].
- (statements isMemberOf:StatementNode) ifFalse:[^ nil].
-
- e := statements expression.
- e isConstant ifFalse:[^ nil].
-
- val := e value.
- ].
-
- val == 0 ifTrue:[
- "a [0]-block"
-
- code := ByteArray with:(ByteCodeCompiler byteCodeFor:#ret0).
- ].
- val == 1 ifTrue:[
- "a [1]-block"
-
- code := ByteArray with:(ByteCodeCompiler byteCodeFor:#push1)
- with:(ByteCodeCompiler byteCodeFor:#retTop).
- ].
-
- val == true ifTrue:[
- "a [true]-block"
-
- code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retTrue).
- ].
-
- val == false ifTrue:[
- "a [false]-block"
-
- code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retFalse).
- ].
-
- val == nil ifTrue:[
- "a [nil]-block"
-
- code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retNil).
- ].
-
- code notNil ifTrue:[
- cheapy := Block code:nil
- byteCode:code
- numArgs:(blockArgs size)
- sourcePosition:nil
- initialPC:nil
- literals:nil
- dynamic:false.
- ^ ConstantNode type:#Block value:cheapy
- ].
-
- ^ nil
+whileTrue:aBlock
+ self value ifFalse:[^ nil].
+ aBlock value.
+ thisContext restart
! !
!BlockNode methodsFor:'printing'!
@@ -550,3 +531,22 @@
].
aStream nextPut:$]
! !
+
+!BlockNode methodsFor:'private accessing'!
+
+setArguments:argList home:h variables:vars
+ inlineBlock := false.
+ needsHome := false.
+ blockArgs := argList.
+ home := h.
+ blockVars := vars
+! !
+
+!BlockNode methodsFor:'queries'!
+
+isBlock
+ "a kludge, to have blocknodes mimic blocks"
+
+ ^ true
+! !
+
--- a/CascadeNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/CascadeNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
MessageNode subclass:#CascadeNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!CascadeNode class methodsFor:'documentation'!
@@ -33,30 +33,65 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/CascadeNd.st,v 1.11 1995-11-11 15:30:15 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing cascade message sends
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/CascadeNd.st,v 1.12 1995-11-23 02:12:44 cg Exp $'
! !
-!CascadeNode methodsFor: 'code generation'!
-
-codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
- self codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
-!
+!CascadeNode methodsFor:'code generation'!
codeForCascadeOn:aStream inBlock:b for:aCompiler
receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
aStream nextPut:#dup.
self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
+!
+
+codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
+ self codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
! !
-!CascadeNode methodsFor: 'printing'!
+!CascadeNode methodsFor:'evaluating'!
+
+evaluate
+ |t argValueArray|
+
+ receiver isSuper ifTrue:[
+ ^ super evaluate
+ ].
+
+ t := receiver evaluateForCascade.
+ argArray isNil ifTrue:[
+ t perform:selector.
+ ^ t
+ ].
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ ^ t perform:selector withArguments:argValueArray
+!
+
+evaluateForCascade
+ |t argValueArray|
+
+ receiver isSuper ifTrue:[
+ ^ super evaluateForCascade
+ ].
+
+ t := receiver evaluateForCascade.
+ argArray isNil ifTrue:[
+ t perform:selector.
+ ^ t
+ ].
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ t perform:selector withArguments:argValueArray.
+ ^ t
+! !
+
+!CascadeNode methodsFor:'printing'!
printOn:aStream indent:i
|needParen selectorParts index index2 arg nargs|
@@ -103,37 +138,3 @@
]
! !
-!CascadeNode methodsFor: 'evaluating'!
-
-evaluate
- |t argValueArray|
-
- receiver isSuper ifTrue:[
- ^ super evaluate
- ].
-
- t := receiver evaluateForCascade.
- argArray isNil ifTrue:[
- t perform:selector.
- ^ t
- ].
- argValueArray := argArray collect:[:arg | arg evaluate].
- ^ t perform:selector withArguments:argValueArray
-!
-
-evaluateForCascade
- |t argValueArray|
-
- receiver isSuper ifTrue:[
- ^ super evaluateForCascade
- ].
-
- t := receiver evaluateForCascade.
- argArray isNil ifTrue:[
- t perform:selector.
- ^ t
- ].
- argValueArray := argArray collect:[:arg | arg evaluate].
- t perform:selector withArguments:argValueArray.
- ^ t
-! !
--- a/CascadeNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/CascadeNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
MessageNode subclass:#CascadeNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!CascadeNode class methodsFor:'documentation'!
@@ -33,30 +33,65 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.11 1995-11-11 15:30:15 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing cascade message sends
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.12 1995-11-23 02:12:44 cg Exp $'
! !
-!CascadeNode methodsFor: 'code generation'!
-
-codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
- self codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
-!
+!CascadeNode methodsFor:'code generation'!
codeForCascadeOn:aStream inBlock:b for:aCompiler
receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
aStream nextPut:#dup.
self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
+!
+
+codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
+ self codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
! !
-!CascadeNode methodsFor: 'printing'!
+!CascadeNode methodsFor:'evaluating'!
+
+evaluate
+ |t argValueArray|
+
+ receiver isSuper ifTrue:[
+ ^ super evaluate
+ ].
+
+ t := receiver evaluateForCascade.
+ argArray isNil ifTrue:[
+ t perform:selector.
+ ^ t
+ ].
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ ^ t perform:selector withArguments:argValueArray
+!
+
+evaluateForCascade
+ |t argValueArray|
+
+ receiver isSuper ifTrue:[
+ ^ super evaluateForCascade
+ ].
+
+ t := receiver evaluateForCascade.
+ argArray isNil ifTrue:[
+ t perform:selector.
+ ^ t
+ ].
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ t perform:selector withArguments:argValueArray.
+ ^ t
+! !
+
+!CascadeNode methodsFor:'printing'!
printOn:aStream indent:i
|needParen selectorParts index index2 arg nargs|
@@ -103,37 +138,3 @@
]
! !
-!CascadeNode methodsFor: 'evaluating'!
-
-evaluate
- |t argValueArray|
-
- receiver isSuper ifTrue:[
- ^ super evaluate
- ].
-
- t := receiver evaluateForCascade.
- argArray isNil ifTrue:[
- t perform:selector.
- ^ t
- ].
- argValueArray := argArray collect:[:arg | arg evaluate].
- ^ t perform:selector withArguments:argValueArray
-!
-
-evaluateForCascade
- |t argValueArray|
-
- receiver isSuper ifTrue:[
- ^ super evaluateForCascade
- ].
-
- t := receiver evaluateForCascade.
- argArray isNil ifTrue:[
- t perform:selector.
- ^ t
- ].
- argValueArray := argArray collect:[:arg | arg evaluate].
- t perform:selector withArguments:argValueArray.
- ^ t
-! !
--- a/ConstNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/ConstNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,11 +11,10 @@
"
PrimaryNode subclass:#ConstantNode
- instanceVariableNames:''
- classVariableNames:'TrueNode FalseNode NilNode Const0Node Const1Node
- Float0Node'
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:'TrueNode FalseNode NilNode Const0Node Const1Node Float0Node'
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!ConstantNode class methodsFor:'documentation'!
@@ -34,55 +33,18 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/ConstNode.st,v 1.17 1995-11-11 15:30:17 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing literal constants
"
-! !
-
-!ConstantNode class methodsFor:'queries'!
-
-typeOfConstant:anObject
- "return the constantNode type for an object"
-
- "the most common case first ..."
-
- (anObject isMemberOf:SmallInteger) ifTrue:[
- ^ #Integer
- ].
-
- anObject isNil ifTrue:[
- ^ #Nil
- ].
+!
- anObject isNumber ifTrue:[
- "the most common case first ..."
- (anObject isMemberOf:Float) ifTrue:[
- ^ #Float
- ].
- anObject isInteger ifTrue:[
- ^ #Integer
- ].
- ].
- (anObject == true) ifTrue:[
- ^ #True
- ].
- (anObject == false) ifTrue:[
- ^ #False
- ].
- ^ #Literal
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/ConstNode.st,v 1.18 1995-11-23 02:12:53 cg Exp $'
! !
!ConstantNode class methodsFor:'instance creation'!
-value:val
- ^ self type:(self typeOfConstant:val) value:val
-!
-
type:t value:val
"some constant nodes are used so often, its worth caching them"
(t == #True) ifTrue:[
@@ -126,6 +88,43 @@
]
].
^ (self basicNew) type:t value:val
+!
+
+value:val
+ ^ self type:(self typeOfConstant:val) value:val
+! !
+
+!ConstantNode class methodsFor:'queries'!
+
+typeOfConstant:anObject
+ "return the constantNode type for an object"
+
+ "the most common case first ..."
+
+ (anObject isMemberOf:SmallInteger) ifTrue:[
+ ^ #Integer
+ ].
+
+ anObject isNil ifTrue:[
+ ^ #Nil
+ ].
+
+ anObject isNumber ifTrue:[
+ "the most common case first ..."
+ (anObject isMemberOf:Float) ifTrue:[
+ ^ #Float
+ ].
+ anObject isInteger ifTrue:[
+ ^ #Integer
+ ].
+ ].
+ (anObject == true) ifTrue:[
+ ^ #True
+ ].
+ (anObject == false) ifTrue:[
+ ^ #False
+ ].
+ ^ #Literal
! !
!ConstantNode methodsFor:'accessing'!
@@ -135,25 +134,6 @@
value := val
! !
-!ConstantNode methodsFor:'queries'!
-
-isConstant
- ^ true
-! !
-
-!ConstantNode methodsFor:'evaluating'!
-
-evaluate
- ^ value
-!
-
-store:aValue
- "not reached - parser checks for this"
-
- self error:'store not allowed'.
- ^ aValue
-! !
-
!ConstantNode methodsFor:'code generation'!
codeOn:aStream inBlock:b for:aCompiler
@@ -225,6 +205,19 @@
^ self error:'assignment to literals not allowed'
! !
+!ConstantNode methodsFor:'evaluating'!
+
+evaluate
+ ^ value
+!
+
+store:aValue
+ "not reached - parser checks for this"
+
+ self error:'store not allowed'.
+ ^ aValue
+! !
+
!ConstantNode methodsFor:'printing'!
displayString
@@ -234,3 +227,10 @@
printOn:aStream indent:i
value storeOn:aStream
! !
+
+!ConstantNode methodsFor:'queries'!
+
+isConstant
+ ^ true
+! !
+
--- a/ConstantNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/ConstantNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,11 +11,10 @@
"
PrimaryNode subclass:#ConstantNode
- instanceVariableNames:''
- classVariableNames:'TrueNode FalseNode NilNode Const0Node Const1Node
- Float0Node'
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:'TrueNode FalseNode NilNode Const0Node Const1Node Float0Node'
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!ConstantNode class methodsFor:'documentation'!
@@ -34,55 +33,18 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/ConstantNode.st,v 1.17 1995-11-11 15:30:17 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing literal constants
"
-! !
-
-!ConstantNode class methodsFor:'queries'!
-
-typeOfConstant:anObject
- "return the constantNode type for an object"
-
- "the most common case first ..."
-
- (anObject isMemberOf:SmallInteger) ifTrue:[
- ^ #Integer
- ].
-
- anObject isNil ifTrue:[
- ^ #Nil
- ].
+!
- anObject isNumber ifTrue:[
- "the most common case first ..."
- (anObject isMemberOf:Float) ifTrue:[
- ^ #Float
- ].
- anObject isInteger ifTrue:[
- ^ #Integer
- ].
- ].
- (anObject == true) ifTrue:[
- ^ #True
- ].
- (anObject == false) ifTrue:[
- ^ #False
- ].
- ^ #Literal
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/ConstantNode.st,v 1.18 1995-11-23 02:12:53 cg Exp $'
! !
!ConstantNode class methodsFor:'instance creation'!
-value:val
- ^ self type:(self typeOfConstant:val) value:val
-!
-
type:t value:val
"some constant nodes are used so often, its worth caching them"
(t == #True) ifTrue:[
@@ -126,6 +88,43 @@
]
].
^ (self basicNew) type:t value:val
+!
+
+value:val
+ ^ self type:(self typeOfConstant:val) value:val
+! !
+
+!ConstantNode class methodsFor:'queries'!
+
+typeOfConstant:anObject
+ "return the constantNode type for an object"
+
+ "the most common case first ..."
+
+ (anObject isMemberOf:SmallInteger) ifTrue:[
+ ^ #Integer
+ ].
+
+ anObject isNil ifTrue:[
+ ^ #Nil
+ ].
+
+ anObject isNumber ifTrue:[
+ "the most common case first ..."
+ (anObject isMemberOf:Float) ifTrue:[
+ ^ #Float
+ ].
+ anObject isInteger ifTrue:[
+ ^ #Integer
+ ].
+ ].
+ (anObject == true) ifTrue:[
+ ^ #True
+ ].
+ (anObject == false) ifTrue:[
+ ^ #False
+ ].
+ ^ #Literal
! !
!ConstantNode methodsFor:'accessing'!
@@ -135,25 +134,6 @@
value := val
! !
-!ConstantNode methodsFor:'queries'!
-
-isConstant
- ^ true
-! !
-
-!ConstantNode methodsFor:'evaluating'!
-
-evaluate
- ^ value
-!
-
-store:aValue
- "not reached - parser checks for this"
-
- self error:'store not allowed'.
- ^ aValue
-! !
-
!ConstantNode methodsFor:'code generation'!
codeOn:aStream inBlock:b for:aCompiler
@@ -225,6 +205,19 @@
^ self error:'assignment to literals not allowed'
! !
+!ConstantNode methodsFor:'evaluating'!
+
+evaluate
+ ^ value
+!
+
+store:aValue
+ "not reached - parser checks for this"
+
+ self error:'store not allowed'.
+ ^ aValue
+! !
+
!ConstantNode methodsFor:'printing'!
displayString
@@ -234,3 +227,10 @@
printOn:aStream indent:i
value storeOn:aStream
! !
+
+!ConstantNode methodsFor:'queries'!
+
+isConstant
+ ^ true
+! !
+
--- a/ImmArray.st Sat Nov 18 17:59:14 1995 +0100
+++ b/ImmArray.st Thu Nov 23 03:15:59 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 20-feb-1995 at 6:26:23 am'!
-
Array subclass:#ImmutableArray
instanceVariableNames:''
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/ImmArray.st,v 1.10 1995-11-11 15:30:26 cg Exp $'
-!
-
documentation
"
By default, array literals in smalltalk are mutable objects. That
@@ -60,6 +54,60 @@
Turn the ImmutableArray feature on by setting the Parsers class variable
'ArraysAreImmutable' to true or use the new launchers settings menu.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/ImmArray.st,v 1.11 1995-11-23 02:13:03 cg Exp $'
+! !
+
+!ImmutableArray methodsFor:'accessing'!
+
+at: index put: value
+ "Trigger an error if an immutable array is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger."
+
+ self notifyStoreError.
+ ^ super at: index put: value
+!
+
+basicAt: index put: value
+ "Trigger an error if an immutable array is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger."
+
+ self notifyStoreError.
+ ^ super basicAt: index put: value
+! !
+
+!ImmutableArray methodsFor:'copying'!
+
+copyEmpty
+ "when copying, return a real (mutable) Array"
+
+ ^ Array new:self size
+!
+
+copyEmptyAndGrow:size
+ "when copying, return a real (mutable) Array"
+
+ ^ Array new:size
+!
+
+postCopy
+ "when copied, make it me a real (mutable) Array"
+
+ self changeClassTo:Array.
+!
+
+shallowCopy
+ "when copying, return a real (mutable) Array"
+
+ |sz|
+
+ sz := self size.
+ ^ (Array new:sz)
+ replaceFrom:1 to:sz with:self startingAt:1
! !
!ImmutableArray methodsFor:'error handling'!
@@ -99,24 +147,23 @@
self error:msg
! !
-!ImmutableArray methodsFor:'accessing'!
+!ImmutableArray methodsFor:'private'!
-at: index put: value
- "Trigger an error if an immutable array is stored into.
- The store will be performed (for compatibility reasons) if you continue
- in the debugger."
+species
+ "Copies should be mutable"
+
+ ^Array
+! !
- self notifyStoreError.
- ^ super at: index put: value
-!
+!ImmutableArray methodsFor:'queries'!
-basicAt: index put: value
- "Trigger an error if an immutable array is stored into.
- The store will be performed (for compatibility reasons) if you continue
- in the debugger."
+isLiteral
+ "return true, if the receiver can be used as a literal
+ (i.e. can be used in constant arrays)"
- self notifyStoreError.
- ^ super basicAt: index put: value
+ "yes, I must be"
+ ^ true
+
! !
!ImmutableArray methodsFor:'specials'!
@@ -137,51 +184,3 @@
^ super becomeNil
! !
-!ImmutableArray methodsFor:'private'!
-
-species
- "Copies should be mutable"
-
- ^Array
-! !
-
-!ImmutableArray methodsFor:'queries'!
-
-isLiteral
- "return true, if the receiver can be used as a literal
- (i.e. can be used in constant arrays)"
-
- "yes, I must be"
- ^ true
-
-! !
-
-!ImmutableArray methodsFor:'copying'!
-
-copyEmptyAndGrow:size
- "when copying, return a real (mutable) Array"
-
- ^ Array new:size
-!
-
-copyEmpty
- "when copying, return a real (mutable) Array"
-
- ^ Array new:self size
-!
-
-shallowCopy
- "when copying, return a real (mutable) Array"
-
- |sz|
-
- sz := self size.
- ^ (Array new:sz)
- replaceFrom:1 to:sz with:self startingAt:1
-!
-
-postCopy
- "when copied, make it me a real (mutable) Array"
-
- self changeClassTo:Array.
-! !
--- a/ImmutableArray.st Sat Nov 18 17:59:14 1995 +0100
+++ b/ImmutableArray.st Thu Nov 23 03:15:59 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 20-feb-1995 at 6:26:23 am'!
-
Array subclass:#ImmutableArray
instanceVariableNames:''
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/ImmutableArray.st,v 1.10 1995-11-11 15:30:26 cg Exp $'
-!
-
documentation
"
By default, array literals in smalltalk are mutable objects. That
@@ -60,6 +54,60 @@
Turn the ImmutableArray feature on by setting the Parsers class variable
'ArraysAreImmutable' to true or use the new launchers settings menu.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/ImmutableArray.st,v 1.11 1995-11-23 02:13:03 cg Exp $'
+! !
+
+!ImmutableArray methodsFor:'accessing'!
+
+at: index put: value
+ "Trigger an error if an immutable array is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger."
+
+ self notifyStoreError.
+ ^ super at: index put: value
+!
+
+basicAt: index put: value
+ "Trigger an error if an immutable array is stored into.
+ The store will be performed (for compatibility reasons) if you continue
+ in the debugger."
+
+ self notifyStoreError.
+ ^ super basicAt: index put: value
+! !
+
+!ImmutableArray methodsFor:'copying'!
+
+copyEmpty
+ "when copying, return a real (mutable) Array"
+
+ ^ Array new:self size
+!
+
+copyEmptyAndGrow:size
+ "when copying, return a real (mutable) Array"
+
+ ^ Array new:size
+!
+
+postCopy
+ "when copied, make it me a real (mutable) Array"
+
+ self changeClassTo:Array.
+!
+
+shallowCopy
+ "when copying, return a real (mutable) Array"
+
+ |sz|
+
+ sz := self size.
+ ^ (Array new:sz)
+ replaceFrom:1 to:sz with:self startingAt:1
! !
!ImmutableArray methodsFor:'error handling'!
@@ -99,24 +147,23 @@
self error:msg
! !
-!ImmutableArray methodsFor:'accessing'!
+!ImmutableArray methodsFor:'private'!
-at: index put: value
- "Trigger an error if an immutable array is stored into.
- The store will be performed (for compatibility reasons) if you continue
- in the debugger."
+species
+ "Copies should be mutable"
+
+ ^Array
+! !
- self notifyStoreError.
- ^ super at: index put: value
-!
+!ImmutableArray methodsFor:'queries'!
-basicAt: index put: value
- "Trigger an error if an immutable array is stored into.
- The store will be performed (for compatibility reasons) if you continue
- in the debugger."
+isLiteral
+ "return true, if the receiver can be used as a literal
+ (i.e. can be used in constant arrays)"
- self notifyStoreError.
- ^ super basicAt: index put: value
+ "yes, I must be"
+ ^ true
+
! !
!ImmutableArray methodsFor:'specials'!
@@ -137,51 +184,3 @@
^ super becomeNil
! !
-!ImmutableArray methodsFor:'private'!
-
-species
- "Copies should be mutable"
-
- ^Array
-! !
-
-!ImmutableArray methodsFor:'queries'!
-
-isLiteral
- "return true, if the receiver can be used as a literal
- (i.e. can be used in constant arrays)"
-
- "yes, I must be"
- ^ true
-
-! !
-
-!ImmutableArray methodsFor:'copying'!
-
-copyEmptyAndGrow:size
- "when copying, return a real (mutable) Array"
-
- ^ Array new:size
-!
-
-copyEmpty
- "when copying, return a real (mutable) Array"
-
- ^ Array new:self size
-!
-
-shallowCopy
- "when copying, return a real (mutable) Array"
-
- |sz|
-
- sz := self size.
- ^ (Array new:sz)
- replaceFrom:1 to:sz with:self startingAt:1
-!
-
-postCopy
- "when copied, make it me a real (mutable) Array"
-
- self changeClassTo:Array.
-! !
--- a/MessageNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/MessageNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#MessageNode
- instanceVariableNames:'receiver selector argArray lineNr'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'receiver selector argArray lineNr'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!MessageNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/MessageNd.st,v 1.31 1995-11-11 15:30:33 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing message sends
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/MessageNd.st,v 1.32 1995-11-23 02:13:47 cg Exp $'
! !
!MessageNode class methodsFor:'instance creation'!
@@ -49,6 +49,52 @@
^ (self basicNew) receiver:recNode selector:selectorString args:nil lineno:0
!
+receiver:recNode selector:selectorString arg1:argNode1 arg2:argNode2 fold:folding
+ |result recVal argVal selector|
+
+ "
+ This is just a demonstration - of how complex constants can be folded.
+ This was inspired by some discussion in c.l.s about enhancing the language - I prefer
+ enhancing the compiler ....
+ The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,
+ allowing a constant arrays of complex objects.
+
+ Notice: this method is normally disabled - its just a demo after all.
+ "
+ folding ifTrue:[
+ "do constant folding ..."
+ (recNode isConstant and:[argNode1 isConstant]) ifTrue:[
+ "check if we can do it ..."
+ selector := selectorString asSymbolIfInterned.
+ selector notNil ifTrue:[
+ recVal := recNode evaluate.
+ (recVal respondsTo:selector) 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 ...)
+ "
+ argVal := argNode1 evaluate.
+ ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
+ (selector == #with:collect:) ifTrue:[
+ (argNode2 isMemberOf:BlockNode) ifTrue:[
+ (SignalSet anySignal catch:[
+ result := recVal perform:selector with:argVal with:(argNode2 evaluate).
+ ]) ifTrue:[
+ ^ 'error in constant expression'
+ ].
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0
+!
+
receiver:recNode selector:selectorString arg:argNode
^ self receiver:recNode selector:selectorString arg:argNode fold:true
!
@@ -132,52 +178,6 @@
^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
!
-receiver:recNode selector:selectorString arg1:argNode1 arg2:argNode2 fold:folding
- |result recVal argVal selector|
-
- "
- This is just a demonstration - of how complex constants can be folded.
- This was inspired by some discussion in c.l.s about enhancing the language - I prefer
- enhancing the compiler ....
- The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,
- allowing a constant arrays of complex objects.
-
- Notice: this method is normally disabled - its just a demo after all.
- "
- folding ifTrue:[
- "do constant folding ..."
- (recNode isConstant and:[argNode1 isConstant]) ifTrue:[
- "check if we can do it ..."
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
- recVal := recNode evaluate.
- (recVal respondsTo:selector) 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 ...)
- "
- argVal := argNode1 evaluate.
- ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
- (selector == #with:collect:) ifTrue:[
- (argNode2 isMemberOf:BlockNode) ifTrue:[
- (SignalSet anySignal catch:[
- result := recVal perform:selector with:argVal with:(argNode2 evaluate).
- ]) ifTrue:[
- ^ 'error in constant expression'
- ].
- ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0
-!
-
receiver:recNode selector:selectorString args:anArray
^ self receiver:recNode selector:selectorString args:anArray fold:true
!
@@ -205,45 +205,6 @@
"Modified: 3.9.1995 / 16:41:39 / claus"
! !
-!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
- ^ lineNr
-!
-
-lineNumber:num
- lineNr := num
-! !
-
-!MessageNode methodsFor:'queries'!
-
-isMessage
- ^ true
-! !
-
!MessageNode class methodsFor:'queries'!
hasLineNumber:sel
@@ -257,6 +218,27 @@
^ true
!
+isBuiltIn1ArgSelector:sel
+ "return true, if selector sel is built-in.
+ (i.e. there is a single bytecode for it)"
+
+ (sel == #at:) ifTrue:[^ true].
+ (sel == #value:) ifTrue:[^ true].
+ (sel == #bitAnd:) ifTrue:[^ true].
+ (sel == #bitOr:) ifTrue:[^ true].
+ (sel == #new:) ifTrue:[^ true].
+ (sel == #basicNew:) ifTrue:[^ true].
+ ^ false
+!
+
+isBuiltIn2ArgSelector:sel
+ "return true, if selector sel is built-in.
+ (i.e. there is a single bytecode for it)"
+
+ (sel == #at:put:) ifTrue:[^ true].
+ ^ false
+!
+
isBuiltInUnarySelector:sel
"return true, if unary selector sel is built-in.
(i.e. there is a single bytecode for it)"
@@ -280,115 +262,39 @@
(sel == #new) ifTrue:[^ true].
(sel == #basicNew) ifTrue:[^ true].
^ false
-!
-
-isBuiltIn1ArgSelector:sel
- "return true, if selector sel is built-in.
- (i.e. there is a single bytecode for it)"
-
- (sel == #at:) ifTrue:[^ true].
- (sel == #value:) ifTrue:[^ true].
- (sel == #bitAnd:) ifTrue:[^ true].
- (sel == #bitOr:) ifTrue:[^ true].
- (sel == #new:) ifTrue:[^ true].
- (sel == #basicNew:) ifTrue:[^ true].
- ^ false
-!
-
-isBuiltIn2ArgSelector:sel
- "return true, if selector sel is built-in.
- (i.e. there is a single bytecode for it)"
-
- (sel == #at:put:) ifTrue:[^ true].
- ^ false
! !
-!MessageNode methodsFor:'printing'!
-
-printOn:aStream indent:i
- |needParen selectorParts index index2 arg|
-
- (#(whileTrue: whileFalse:) includes:selector) ifTrue:[
- receiver isBlock ifTrue:[
- ^ self printWhileOn:aStream indent:i
- ].
- ].
+!MessageNode methodsFor:'accessing'!
- 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
- ].
+arg1
+ ^ argArray at:1
+!
- 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:')'
- ].
+args
+ ^ argArray
+!
- 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:') '
- ].
- ]
+lineNumber
+ ^ lineNr
!
-printWhileOn:aStream indent:i
- |needParen arg|
+lineNumber:num
+ lineNr := num
+!
- "special handling of whileTrue/whileFalse"
-
- aStream nextPutAll:'['.
- receiver statements printOn:aStream indent:i.
- aStream nextPutAll:'] whileTrue: '.
+receiver
+ ^ receiver
+!
- 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:') '
- ].
+receiver:r selector:s args:a lineno:l
+ receiver := r.
+ selector := s asSymbol.
+ argArray := a.
+ lineNr := l
+!
+
+selector
+ ^ selector
! !
!MessageNode methodsFor:'checks'!
@@ -481,238 +387,8 @@
^ nil
! !
-!MessageNode methodsFor:'evaluating'!
-
-evaluate
- |r nargs argValueArray class|
-
- receiver isSuper ifTrue:[
- r := receiver value.
- receiver isHere ifTrue:[
- class := receiver definingClass.
- ] ifFalse:[
- class := receiver definingClass superclass.
- ].
- argArray notNil ifTrue:[
- argValueArray := argArray collect:[:arg | arg evaluate].
- ] ifFalse:[
- argValueArray := #()
- ].
- ^ r perform:selector inClass:class withArguments:argValueArray
- ].
-
-
- 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 := argArray collect:[:arg | arg evaluate].
- ^ r perform:selector withArguments:argValueArray
-!
-
-evaluateForCascade
- |r nargs argValueArray class|
-
- receiver isSuper ifTrue:[
- r := receiver value.
- class := receiver definingClass.
- receiver isHere ifFalse:[
- class := class superclass.
- ].
- argArray notNil ifTrue:[
- argValueArray := argArray collect:[:arg | arg evaluate].
- ] ifFalse:[
- argValueArray := #()
- ].
- r perform:selector inClass:class withArguments:argValueArray.
- ^ r
- ].
-
- 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 := argArray collect:[:arg | arg evaluate].
- r perform:selector withArguments:argValueArray.
- ^ r
-! !
-
!MessageNode methodsFor:'code generation'!
-codeForSideEffectOn:aStream inBlock:b for:aCompiler
- self codeOn:aStream inBlock:b valueNeeded:false for:aCompiler
-!
-
-codeOn:aStream inBlock:b for:aCompiler
- self codeOn:aStream inBlock:b valueNeeded:true for:aCompiler
-!
-
-optimizedConditionFor:aReceiver with:aByteCode
- |rec sel|
-
- rec := aReceiver.
- (rec isBlock) ifTrue:[
- rec statements nextStatement isNil ifTrue:[
- rec := rec statements expression
- ]
- ].
- (rec isUnaryMessage) ifTrue:[
- sel := rec selector.
- (sel == #isNil) ifTrue:[
- "/
- "/ isNil trueJmp -> nilJump
- "/ isNil falseJmp -> notNilJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #nilJump].
- (aByteCode == #falseJump) ifTrue:[^ #notNilJump]
- ].
- (sel == #notNil) ifTrue:[
- "/
- "/ notNil trueJmp -> notNilJump
- "/ notNil falseJmp -> nilJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #notNilJump].
- (aByteCode == #falseJump) ifTrue:[^ #nilJump]
- ].
- (sel == #not) ifTrue:[
- "/
- "/ not trueJmp -> falseJump
- "/ not falseJmp -> trueJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #falseJump].
- (aByteCode == #falseJump) ifTrue:[^ #trueJump]
- ].
- ^ nil
- ].
- (rec isBinaryMessage) ifTrue:[
- sel := rec selector.
- rec arg1 isConstant ifTrue:[
- (rec arg1 value == 0) ifTrue:[
- "/
- "/ ==0 trueJmp -> zeroJump
- "/ ==0 falseJmp -> notZeroJump
- "/
- (sel == #==) ifTrue:[
- (aByteCode == #trueJump) ifTrue:[^ #zeroJump].
- (aByteCode == #falseJump) ifTrue:[^ #notZeroJump]
- ].
- "/
- "/ ~~0 trueJmp -> notZeroJump
- "/ ~~0 falseJmp -> zeroJump
- "/
- (sel == #~~) ifTrue:[
- (aByteCode == #falseJump) ifTrue:[^ #zeroJump].
- (aByteCode == #trueJump) ifTrue:[^ #notZeroJump]
- ].
- ^ nil
- ]
- ].
- (sel == #==) ifTrue:[
- "/
- "/ == trueJmp -> eqJump
- "/ == falseJmp -> notEqJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #eqJump].
- (aByteCode == #falseJump) ifTrue:[^ #notEqJump]
- ].
- (sel == #~~) ifTrue:[
- "/
- "/ ~~ trueJmp -> notEqJump
- "/ ~~ falseJmp -> eqJump
- "/
- (aByteCode == #falseJump) ifTrue:[^ #eqJump].
- (aByteCode == #trueJump) ifTrue:[^ #notEqJump]
- ]
- ].
- ^ nil
-!
-
-codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "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
- ].
-
-"/ OLD:
-"/ valueNeeded ifTrue:[aStream nextPut:#pushNil].
-"/
- pos := aStream position.
- optByteCode notNil ifTrue:[
- theReceiver codeOn:aStream inBlock:b for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ]
- ] ifFalse:[
- theReceiver codeInlineOn:aStream inBlock:b for:aCompiler
- ].
-
- (lineNr between:1 and:255) ifTrue:[
- aStream nextPut:#lineno; nextPut:lineNr.
- ].
-
- aStream nextPut:theByteCode.
- pos2 := aStream position.
- aStream nextPut:0.
-"/ OLD:
-"/ valueNeeded ifTrue:[aStream nextPut:#drop].
-"/
-"/ OLD:
-"/ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
-"/ NEW:
- (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
- aStream nextPut:#jump; nextPut:pos.
- (aStream contents) at:pos2 put:(aStream position).
-"/ NEW:
- valueNeeded ifTrue:[aStream nextPut:#pushNil].
-!
-
XXcodeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
"generate code for [...] whilexxx:[ ... ]"
@@ -758,27 +434,182 @@
(aStream contents) at:pos2 put:(aStream position).
!
-codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "generate code for n timesRepeat:[ ... ]"
+codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for (x and:[y]) ifxxx:[ ... ]"
+
+ |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
+
+
+ theByteCode := #falseJump.
+ theReceiver := receiver receiver.
- |pos pos2 theReceiver|
-
- theReceiver := 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 for:aCompiler.
- valueNeeded ifTrue:[aStream nextPut:#dup].
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ].
+ aStream nextPut:theByteCode.
+ pos1 := aStream position.
+ aStream nextPut:0.
- pos := aStream position.
-"/ aStream nextPut:#dup; nextPut:#push0; nextPut:#>; nextPut:lineNr; nextPut:#falseJump.
-"/ aStream nextPut:#dup; nextPut:#gt0; nextPut:lineNr; nextPut:#falseJump.
- aStream nextPut:#pushgt0; nextPut:lineNr; nextPut:#falseJump.
+ theReceiver := receiver arg1.
+ theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
+ (selector == #ifTrue:) ifTrue:[
+ jmp := #falseJump
+ ] ifFalse:[
+ jmp := #trueJump
+ ].
+ aStream nextPut:jmp.
pos2 := aStream position.
aStream nextPut:0.
- (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
- aStream nextPut:#minus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
+ code := aStream contents.
+ (selector == #ifFalse:) ifTrue:[
+ code at:pos1 put:(aStream position)
+ ].
+ (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
+
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos3 := aStream position.
+ aStream nextPut:0.
+ here := aStream position.
+ (selector == #ifTrue:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here.
+ aStream nextPut:#pushNil.
+ code at:pos3 put:(aStream position)
+ ] ifFalse:[
+ here := aStream position.
+ (selector == #ifTrue:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here
+ ]
+!
+
+codeAndOrOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "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 for:aCompiler.
+ aStream nextPut:theByteCode.
+ pos := aStream position.
+ aStream nextPut:0.
+ (argArray at: 1) codeInlineOn:aStream inBlock:b for:aCompiler.
+ (aStream contents) at:pos put:(aStream position).
+ valueNeeded ifFalse:[aStream nextPut:#drop]
+!
+
+codeForCascadeOn:aStream inBlock:b for:aCompiler
+ "like codeOn, but always leave the receiver instead of the result"
+
+ |nargs isBuiltIn code litIndex|
+
+ argArray isNil ifTrue:[
+ nargs := 0
+ ] ifFalse:[
+ nargs := argArray size
+ ].
+
+ isBuiltIn := false.
- (aStream contents) at:pos2 put:(aStream position).
- aStream nextPut:#drop.
+ (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 for:aCompiler.
+ aStream nextPut:#dup.
+
+ "can we use a send-bytecode ?"
+ isBuiltIn ifTrue:[
+ receiver isSuper ifFalse:[
+ (nargs > 0) ifTrue:[
+ (argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
+ (nargs > 1) ifTrue:[
+ (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
+ ]
+ ].
+ aStream nextPut:selector.
+ (self class hasLineNumber:selector) ifTrue:[
+ aStream nextPut:lineNr.
+ ].
+ aStream nextPut:#drop.
+ ^ self
+ ]
+ ].
+
+ "no - generate a send"
+ argArray notNil ifTrue:[
+ argArray do:[:arg |
+ arg codeOn:aStream inBlock:b for:aCompiler
+ ]
+ ].
+ litIndex := aCompiler addLiteral:selector.
+ litIndex <= 255 ifTrue:[
+ receiver isSuper ifTrue:[
+ receiver isHere ifTrue:[
+ code := #hereSend
+ ] ifFalse:[
+ code := #superSend.
+ ].
+ aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:nil; nextPut:#drop.
+ ^ self
+ ].
+ (nargs <= 3) ifTrue:[
+ code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
+ aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
+ ^ self
+ ].
+
+ aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
+ ^ self
+ ].
+ "need 16bit litIndex"
+ receiver isSuper ifTrue:[
+ receiver isHere ifTrue:[
+ code := #hereSendL
+ ] ifFalse:[
+ code := #superSendL.
+ ].
+ aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:nil; nextPut:#drop.
+ ^ self
+ ].
+ aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+!
+
+codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ self codeOn:aStream inBlock:b valueNeeded:false for:aCompiler
!
codeIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
@@ -915,183 +746,8 @@
]
!
-codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "generate code for (x and:[y]) ifxxx:[ ... ]"
-
- |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
-
-
- 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 for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ].
- aStream nextPut:theByteCode.
- pos1 := aStream position.
- aStream nextPut:0.
-
- theReceiver := receiver arg1.
- theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
- (selector == #ifTrue:) ifTrue:[
- jmp := #falseJump
- ] ifFalse:[
- jmp := #trueJump
- ].
- aStream nextPut:jmp.
- pos2 := aStream position.
- aStream nextPut:0.
-
- code := aStream contents.
- (selector == #ifFalse:) ifTrue:[
- code at:pos1 put:(aStream position)
- ].
- (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
-
- valueNeeded ifTrue:[
- aStream nextPut:#jump.
- pos3 := aStream position.
- aStream nextPut:0.
- here := aStream position.
- (selector == #ifTrue:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here.
- aStream nextPut:#pushNil.
- code at:pos3 put:(aStream position)
- ] ifFalse:[
- here := aStream position.
- (selector == #ifTrue:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here
- ]
-!
-
-codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "generate code for (x or:[y]) ifxxx:[ ... ]"
-
- |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
-
- 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 for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ].
- aStream nextPut:theByteCode.
- pos1 := aStream position.
- aStream nextPut:0.
-
-
- theReceiver := receiver arg1.
-
-"new:"
- (selector == #ifTrue:) ifTrue:[
- theByteCode := #falseJump
- ] ifFalse:[
- theByteCode := #trueJump
- ].
- optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
- optByteCode notNil ifTrue:[
- theReceiver isBlock ifTrue:[
- theReceiver := theReceiver statements expression
- ].
- ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
- theArg := theReceiver arg1
- ].
- theReceiver := theReceiver receiver.
- theByteCode := optByteCode.
-
- theReceiver codeOn:aStream inBlock:b for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ].
- aStream nextPut:theByteCode.
-
- ] ifFalse:[
-"org"
- theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
- (selector == #ifTrue:) ifTrue:[
- jmp := #falseJump
- ] ifFalse:[
- jmp := #trueJump
- ].
- aStream nextPut:jmp
- ].
- 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 for:aCompiler.
-
- code := aStream contents.
- valueNeeded ifTrue:[
- aStream nextPut:#jump.
- pos3 := aStream position.
- aStream nextPut:0.
- here := aStream position.
- (selector == #ifFalse:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here.
- aStream nextPut:#pushNil.
- code at:pos3 put:(aStream position)
- ] ifFalse:[
- here := aStream position.
- (selector == #ifFalse:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here
- ]
-!
-
-codeAndOrOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "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 for:aCompiler.
- aStream nextPut:theByteCode.
- pos := aStream position.
- aStream nextPut:0.
- (argArray at: 1) codeInlineOn:aStream inBlock:b for:aCompiler.
- (aStream contents) at:pos put:(aStream position).
- valueNeeded ifFalse:[aStream nextPut:#drop]
+codeOn:aStream inBlock:b for:aCompiler
+ self codeOn:aStream inBlock:b valueNeeded:true for:aCompiler
!
codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
@@ -1328,6 +984,94 @@
"Modified: 3.9.1995 / 12:55:42 / claus"
!
+codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for (x or:[y]) ifxxx:[ ... ]"
+
+ |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
+
+ 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 for:aCompiler.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ].
+ aStream nextPut:theByteCode.
+ pos1 := aStream position.
+ aStream nextPut:0.
+
+
+ theReceiver := receiver arg1.
+
+"new:"
+ (selector == #ifTrue:) ifTrue:[
+ theByteCode := #falseJump
+ ] ifFalse:[
+ theByteCode := #trueJump
+ ].
+ optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
+ optByteCode notNil ifTrue:[
+ theReceiver isBlock ifTrue:[
+ theReceiver := theReceiver statements expression
+ ].
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := theReceiver arg1
+ ].
+ theReceiver := theReceiver receiver.
+ theByteCode := optByteCode.
+
+ theReceiver codeOn:aStream inBlock:b for:aCompiler.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ].
+ aStream nextPut:theByteCode.
+
+ ] ifFalse:[
+"org"
+ theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
+ (selector == #ifTrue:) ifTrue:[
+ jmp := #falseJump
+ ] ifFalse:[
+ jmp := #trueJump
+ ].
+ aStream nextPut:jmp
+ ].
+ 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 for:aCompiler.
+
+ code := aStream contents.
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos3 := aStream position.
+ aStream nextPut:0.
+ here := aStream position.
+ (selector == #ifFalse:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here.
+ aStream nextPut:#pushNil.
+ code at:pos3 put:(aStream position)
+ ] ifFalse:[
+ here := aStream position.
+ (selector == #ifFalse:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here
+ ]
+!
+
codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
"like code on, but assumes that receiver has already been
coded onto stack - needed for cascade"
@@ -1441,85 +1185,342 @@
aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
!
-codeForCascadeOn:aStream inBlock:b for:aCompiler
- "like codeOn, but always leave the receiver instead of the result"
+codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for n timesRepeat:[ ... ]"
+
+ |pos pos2 theReceiver|
+
+ theReceiver := receiver.
+ theReceiver codeOn:aStream inBlock:b for:aCompiler.
+ valueNeeded ifTrue:[aStream nextPut:#dup].
- |nargs isBuiltIn code litIndex|
+ pos := aStream position.
+"/ aStream nextPut:#dup; nextPut:#push0; nextPut:#>; nextPut:lineNr; nextPut:#falseJump.
+"/ aStream nextPut:#dup; nextPut:#gt0; nextPut:lineNr; nextPut:#falseJump.
+ aStream nextPut:#pushgt0; nextPut:lineNr; nextPut:#falseJump.
+ pos2 := aStream position.
+ aStream nextPut:0.
+
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+ aStream nextPut:#minus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
+
+ (aStream contents) at:pos2 put:(aStream position).
+ aStream nextPut:#drop.
+!
+
+codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for [...] whilexxx:[ ... ]"
+
+ |pos pos2 theReceiver theArg theByteCode optByteCode|
- argArray isNil ifTrue:[
- nargs := 0
+ (selector == #whileTrue:) ifTrue:[
+ theByteCode := #falseJump
] ifFalse:[
- nargs := argArray size
+ 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
+ ].
+
+"/ OLD:
+"/ valueNeeded ifTrue:[aStream nextPut:#pushNil].
+"/
+ pos := aStream position.
+ optByteCode notNil ifTrue:[
+ theReceiver codeOn:aStream inBlock:b for:aCompiler.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ]
+ ] ifFalse:[
+ theReceiver codeInlineOn:aStream inBlock:b for:aCompiler
+ ].
+
+ (lineNr between:1 and:255) ifTrue:[
+ aStream nextPut:#lineno; nextPut:lineNr.
].
- isBuiltIn := false.
+ aStream nextPut:theByteCode.
+ pos2 := aStream position.
+ aStream nextPut:0.
+"/ OLD:
+"/ valueNeeded ifTrue:[aStream nextPut:#drop].
+"/
+"/ OLD:
+"/ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
+"/ NEW:
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+ aStream nextPut:#jump; nextPut:pos.
+ (aStream contents) at:pos2 put:(aStream position).
+"/ NEW:
+ valueNeeded ifTrue:[aStream nextPut:#pushNil].
+!
+
+optimizedConditionFor:aReceiver with:aByteCode
+ |rec sel|
- (nargs == 0) ifTrue:[
- isBuiltIn := self class isBuiltInUnarySelector:selector
+ rec := aReceiver.
+ (rec isBlock) ifTrue:[
+ rec statements nextStatement isNil ifTrue:[
+ rec := rec statements expression
+ ]
+ ].
+ (rec isUnaryMessage) ifTrue:[
+ sel := rec selector.
+ (sel == #isNil) ifTrue:[
+ "/
+ "/ isNil trueJmp -> nilJump
+ "/ isNil falseJmp -> notNilJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #nilJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notNilJump]
+ ].
+ (sel == #notNil) ifTrue:[
+ "/
+ "/ notNil trueJmp -> notNilJump
+ "/ notNil falseJmp -> nilJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #notNilJump].
+ (aByteCode == #falseJump) ifTrue:[^ #nilJump]
+ ].
+ (sel == #not) ifTrue:[
+ "/
+ "/ not trueJmp -> falseJump
+ "/ not falseJmp -> trueJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #falseJump].
+ (aByteCode == #falseJump) ifTrue:[^ #trueJump]
+ ].
+ ^ nil
].
+ (rec isBinaryMessage) ifTrue:[
+ sel := rec selector.
+ rec arg1 isConstant ifTrue:[
+ (rec arg1 value == 0) ifTrue:[
+ "/
+ "/ ==0 trueJmp -> zeroJump
+ "/ ==0 falseJmp -> notZeroJump
+ "/
+ (sel == #==) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #zeroJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notZeroJump]
+ ].
+ "/
+ "/ ~~0 trueJmp -> notZeroJump
+ "/ ~~0 falseJmp -> zeroJump
+ "/
+ (sel == #~~) ifTrue:[
+ (aByteCode == #falseJump) ifTrue:[^ #zeroJump].
+ (aByteCode == #trueJump) ifTrue:[^ #notZeroJump]
+ ].
+ ^ nil
+ ]
+ ].
+ (sel == #==) ifTrue:[
+ "/
+ "/ == trueJmp -> eqJump
+ "/ == falseJmp -> notEqJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #eqJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notEqJump]
+ ].
+ (sel == #~~) ifTrue:[
+ "/
+ "/ ~~ trueJmp -> notEqJump
+ "/ ~~ falseJmp -> eqJump
+ "/
+ (aByteCode == #falseJump) ifTrue:[^ #eqJump].
+ (aByteCode == #trueJump) ifTrue:[^ #notEqJump]
+ ]
+ ].
+ ^ nil
+! !
+
+!MessageNode methodsFor:'evaluating'!
+
+evaluate
+ |r nargs argValueArray class|
+
+ receiver isSuper ifTrue:[
+ r := receiver value.
+ receiver isHere ifTrue:[
+ class := receiver definingClass.
+ ] ifFalse:[
+ class := receiver definingClass superclass.
+ ].
+ argArray notNil ifTrue:[
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ ] ifFalse:[
+ argValueArray := #()
+ ].
+ ^ r perform:selector inClass:class withArguments:argValueArray
+ ].
+
+
+ argArray isNil ifTrue:[
+ ^ (receiver evaluate) perform:selector
+ ].
+ nargs := argArray size.
(nargs == 1) ifTrue:[
- isBuiltIn := self class isBuiltIn1ArgSelector:selector
+ ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
].
(nargs == 2) ifTrue:[
- isBuiltIn := self class isBuiltIn2ArgSelector:selector
+ ^ (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 := argArray collect:[:arg | arg evaluate].
+ ^ r perform:selector withArguments:argValueArray
+!
+
+evaluateForCascade
+ |r nargs argValueArray class|
+
+ receiver isSuper ifTrue:[
+ r := receiver value.
+ class := receiver definingClass.
+ receiver isHere ifFalse:[
+ class := class superclass.
+ ].
+ argArray notNil ifTrue:[
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ ] ifFalse:[
+ argValueArray := #()
+ ].
+ r perform:selector inClass:class withArguments:argValueArray.
+ ^ r
].
- receiver codeOn:aStream inBlock:b for:aCompiler.
- aStream nextPut:#dup.
+ 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 := argArray collect:[:arg | arg evaluate].
+ r perform:selector withArguments:argValueArray.
+ ^ r
+! !
+
+!MessageNode methodsFor:'printing'!
+
+printOn:aStream indent:i
+ |needParen selectorParts index index2 arg|
+
+ (#(whileTrue: whileFalse:) includes:selector) ifTrue:[
+ receiver isBlock ifTrue:[
+ ^ self printWhileOn:aStream indent:i
+ ].
+ ].
- "can we use a send-bytecode ?"
- isBuiltIn ifTrue:[
- receiver isSuper ifFalse:[
- (nargs > 0) ifTrue:[
- (argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
- (nargs > 1) ifTrue:[
- (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
+ 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
]
].
- aStream nextPut:selector.
- (self class hasLineNumber:selector) ifTrue:[
- aStream nextPut:lineNr.
- ].
- aStream nextPut:#drop.
- ^ self
- ]
- ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+ ]
+!
+
+printWhileOn:aStream indent:i
+ |needParen arg|
- "no - generate a send"
- argArray notNil ifTrue:[
- argArray do:[:arg |
- arg codeOn:aStream inBlock:b for:aCompiler
- ]
+ "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
+ ]
+ ].
].
- litIndex := aCompiler addLiteral:selector.
- litIndex <= 255 ifTrue:[
- receiver isSuper ifTrue:[
- receiver isHere ifTrue:[
- code := #hereSend
- ] ifFalse:[
- code := #superSend.
- ].
- aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:nil; nextPut:#drop.
- ^ self
- ].
- (nargs <= 3) ifTrue:[
- code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
- aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
- ^ self
- ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+! !
- aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
- ^ self
- ].
- "need 16bit litIndex"
- receiver isSuper ifTrue:[
- receiver isHere ifTrue:[
- code := #hereSendL
- ] ifFalse:[
- code := #superSendL.
- ].
- aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:nil; nextPut:#drop.
- ^ self
- ].
- aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+!MessageNode methodsFor:'queries'!
+
+isMessage
+ ^ true
! !
+
--- a/MessageNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/MessageNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#MessageNode
- instanceVariableNames:'receiver selector argArray lineNr'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'receiver selector argArray lineNr'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!MessageNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.31 1995-11-11 15:30:33 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing message sends
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.32 1995-11-23 02:13:47 cg Exp $'
! !
!MessageNode class methodsFor:'instance creation'!
@@ -49,6 +49,52 @@
^ (self basicNew) receiver:recNode selector:selectorString args:nil lineno:0
!
+receiver:recNode selector:selectorString arg1:argNode1 arg2:argNode2 fold:folding
+ |result recVal argVal selector|
+
+ "
+ This is just a demonstration - of how complex constants can be folded.
+ This was inspired by some discussion in c.l.s about enhancing the language - I prefer
+ enhancing the compiler ....
+ The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,
+ allowing a constant arrays of complex objects.
+
+ Notice: this method is normally disabled - its just a demo after all.
+ "
+ folding ifTrue:[
+ "do constant folding ..."
+ (recNode isConstant and:[argNode1 isConstant]) ifTrue:[
+ "check if we can do it ..."
+ selector := selectorString asSymbolIfInterned.
+ selector notNil ifTrue:[
+ recVal := recNode evaluate.
+ (recVal respondsTo:selector) 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 ...)
+ "
+ argVal := argNode1 evaluate.
+ ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
+ (selector == #with:collect:) ifTrue:[
+ (argNode2 isMemberOf:BlockNode) ifTrue:[
+ (SignalSet anySignal catch:[
+ result := recVal perform:selector with:argVal with:(argNode2 evaluate).
+ ]) ifTrue:[
+ ^ 'error in constant expression'
+ ].
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0
+!
+
receiver:recNode selector:selectorString arg:argNode
^ self receiver:recNode selector:selectorString arg:argNode fold:true
!
@@ -132,52 +178,6 @@
^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
!
-receiver:recNode selector:selectorString arg1:argNode1 arg2:argNode2 fold:folding
- |result recVal argVal selector|
-
- "
- This is just a demonstration - of how complex constants can be folded.
- This was inspired by some discussion in c.l.s about enhancing the language - I prefer
- enhancing the compiler ....
- The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,
- allowing a constant arrays of complex objects.
-
- Notice: this method is normally disabled - its just a demo after all.
- "
- folding ifTrue:[
- "do constant folding ..."
- (recNode isConstant and:[argNode1 isConstant]) ifTrue:[
- "check if we can do it ..."
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
- recVal := recNode evaluate.
- (recVal respondsTo:selector) 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 ...)
- "
- argVal := argNode1 evaluate.
- ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
- (selector == #with:collect:) ifTrue:[
- (argNode2 isMemberOf:BlockNode) ifTrue:[
- (SignalSet anySignal catch:[
- result := recVal perform:selector with:argVal with:(argNode2 evaluate).
- ]) ifTrue:[
- ^ 'error in constant expression'
- ].
- ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0
-!
-
receiver:recNode selector:selectorString args:anArray
^ self receiver:recNode selector:selectorString args:anArray fold:true
!
@@ -205,45 +205,6 @@
"Modified: 3.9.1995 / 16:41:39 / claus"
! !
-!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
- ^ lineNr
-!
-
-lineNumber:num
- lineNr := num
-! !
-
-!MessageNode methodsFor:'queries'!
-
-isMessage
- ^ true
-! !
-
!MessageNode class methodsFor:'queries'!
hasLineNumber:sel
@@ -257,6 +218,27 @@
^ true
!
+isBuiltIn1ArgSelector:sel
+ "return true, if selector sel is built-in.
+ (i.e. there is a single bytecode for it)"
+
+ (sel == #at:) ifTrue:[^ true].
+ (sel == #value:) ifTrue:[^ true].
+ (sel == #bitAnd:) ifTrue:[^ true].
+ (sel == #bitOr:) ifTrue:[^ true].
+ (sel == #new:) ifTrue:[^ true].
+ (sel == #basicNew:) ifTrue:[^ true].
+ ^ false
+!
+
+isBuiltIn2ArgSelector:sel
+ "return true, if selector sel is built-in.
+ (i.e. there is a single bytecode for it)"
+
+ (sel == #at:put:) ifTrue:[^ true].
+ ^ false
+!
+
isBuiltInUnarySelector:sel
"return true, if unary selector sel is built-in.
(i.e. there is a single bytecode for it)"
@@ -280,115 +262,39 @@
(sel == #new) ifTrue:[^ true].
(sel == #basicNew) ifTrue:[^ true].
^ false
-!
-
-isBuiltIn1ArgSelector:sel
- "return true, if selector sel is built-in.
- (i.e. there is a single bytecode for it)"
-
- (sel == #at:) ifTrue:[^ true].
- (sel == #value:) ifTrue:[^ true].
- (sel == #bitAnd:) ifTrue:[^ true].
- (sel == #bitOr:) ifTrue:[^ true].
- (sel == #new:) ifTrue:[^ true].
- (sel == #basicNew:) ifTrue:[^ true].
- ^ false
-!
-
-isBuiltIn2ArgSelector:sel
- "return true, if selector sel is built-in.
- (i.e. there is a single bytecode for it)"
-
- (sel == #at:put:) ifTrue:[^ true].
- ^ false
! !
-!MessageNode methodsFor:'printing'!
-
-printOn:aStream indent:i
- |needParen selectorParts index index2 arg|
-
- (#(whileTrue: whileFalse:) includes:selector) ifTrue:[
- receiver isBlock ifTrue:[
- ^ self printWhileOn:aStream indent:i
- ].
- ].
+!MessageNode methodsFor:'accessing'!
- 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
- ].
+arg1
+ ^ argArray at:1
+!
- 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:')'
- ].
+args
+ ^ argArray
+!
- 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:') '
- ].
- ]
+lineNumber
+ ^ lineNr
!
-printWhileOn:aStream indent:i
- |needParen arg|
+lineNumber:num
+ lineNr := num
+!
- "special handling of whileTrue/whileFalse"
-
- aStream nextPutAll:'['.
- receiver statements printOn:aStream indent:i.
- aStream nextPutAll:'] whileTrue: '.
+receiver
+ ^ receiver
+!
- 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:') '
- ].
+receiver:r selector:s args:a lineno:l
+ receiver := r.
+ selector := s asSymbol.
+ argArray := a.
+ lineNr := l
+!
+
+selector
+ ^ selector
! !
!MessageNode methodsFor:'checks'!
@@ -481,238 +387,8 @@
^ nil
! !
-!MessageNode methodsFor:'evaluating'!
-
-evaluate
- |r nargs argValueArray class|
-
- receiver isSuper ifTrue:[
- r := receiver value.
- receiver isHere ifTrue:[
- class := receiver definingClass.
- ] ifFalse:[
- class := receiver definingClass superclass.
- ].
- argArray notNil ifTrue:[
- argValueArray := argArray collect:[:arg | arg evaluate].
- ] ifFalse:[
- argValueArray := #()
- ].
- ^ r perform:selector inClass:class withArguments:argValueArray
- ].
-
-
- 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 := argArray collect:[:arg | arg evaluate].
- ^ r perform:selector withArguments:argValueArray
-!
-
-evaluateForCascade
- |r nargs argValueArray class|
-
- receiver isSuper ifTrue:[
- r := receiver value.
- class := receiver definingClass.
- receiver isHere ifFalse:[
- class := class superclass.
- ].
- argArray notNil ifTrue:[
- argValueArray := argArray collect:[:arg | arg evaluate].
- ] ifFalse:[
- argValueArray := #()
- ].
- r perform:selector inClass:class withArguments:argValueArray.
- ^ r
- ].
-
- 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 := argArray collect:[:arg | arg evaluate].
- r perform:selector withArguments:argValueArray.
- ^ r
-! !
-
!MessageNode methodsFor:'code generation'!
-codeForSideEffectOn:aStream inBlock:b for:aCompiler
- self codeOn:aStream inBlock:b valueNeeded:false for:aCompiler
-!
-
-codeOn:aStream inBlock:b for:aCompiler
- self codeOn:aStream inBlock:b valueNeeded:true for:aCompiler
-!
-
-optimizedConditionFor:aReceiver with:aByteCode
- |rec sel|
-
- rec := aReceiver.
- (rec isBlock) ifTrue:[
- rec statements nextStatement isNil ifTrue:[
- rec := rec statements expression
- ]
- ].
- (rec isUnaryMessage) ifTrue:[
- sel := rec selector.
- (sel == #isNil) ifTrue:[
- "/
- "/ isNil trueJmp -> nilJump
- "/ isNil falseJmp -> notNilJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #nilJump].
- (aByteCode == #falseJump) ifTrue:[^ #notNilJump]
- ].
- (sel == #notNil) ifTrue:[
- "/
- "/ notNil trueJmp -> notNilJump
- "/ notNil falseJmp -> nilJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #notNilJump].
- (aByteCode == #falseJump) ifTrue:[^ #nilJump]
- ].
- (sel == #not) ifTrue:[
- "/
- "/ not trueJmp -> falseJump
- "/ not falseJmp -> trueJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #falseJump].
- (aByteCode == #falseJump) ifTrue:[^ #trueJump]
- ].
- ^ nil
- ].
- (rec isBinaryMessage) ifTrue:[
- sel := rec selector.
- rec arg1 isConstant ifTrue:[
- (rec arg1 value == 0) ifTrue:[
- "/
- "/ ==0 trueJmp -> zeroJump
- "/ ==0 falseJmp -> notZeroJump
- "/
- (sel == #==) ifTrue:[
- (aByteCode == #trueJump) ifTrue:[^ #zeroJump].
- (aByteCode == #falseJump) ifTrue:[^ #notZeroJump]
- ].
- "/
- "/ ~~0 trueJmp -> notZeroJump
- "/ ~~0 falseJmp -> zeroJump
- "/
- (sel == #~~) ifTrue:[
- (aByteCode == #falseJump) ifTrue:[^ #zeroJump].
- (aByteCode == #trueJump) ifTrue:[^ #notZeroJump]
- ].
- ^ nil
- ]
- ].
- (sel == #==) ifTrue:[
- "/
- "/ == trueJmp -> eqJump
- "/ == falseJmp -> notEqJump
- "/
- (aByteCode == #trueJump) ifTrue:[^ #eqJump].
- (aByteCode == #falseJump) ifTrue:[^ #notEqJump]
- ].
- (sel == #~~) ifTrue:[
- "/
- "/ ~~ trueJmp -> notEqJump
- "/ ~~ falseJmp -> eqJump
- "/
- (aByteCode == #falseJump) ifTrue:[^ #eqJump].
- (aByteCode == #trueJump) ifTrue:[^ #notEqJump]
- ]
- ].
- ^ nil
-!
-
-codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "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
- ].
-
-"/ OLD:
-"/ valueNeeded ifTrue:[aStream nextPut:#pushNil].
-"/
- pos := aStream position.
- optByteCode notNil ifTrue:[
- theReceiver codeOn:aStream inBlock:b for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ]
- ] ifFalse:[
- theReceiver codeInlineOn:aStream inBlock:b for:aCompiler
- ].
-
- (lineNr between:1 and:255) ifTrue:[
- aStream nextPut:#lineno; nextPut:lineNr.
- ].
-
- aStream nextPut:theByteCode.
- pos2 := aStream position.
- aStream nextPut:0.
-"/ OLD:
-"/ valueNeeded ifTrue:[aStream nextPut:#drop].
-"/
-"/ OLD:
-"/ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
-"/ NEW:
- (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
- aStream nextPut:#jump; nextPut:pos.
- (aStream contents) at:pos2 put:(aStream position).
-"/ NEW:
- valueNeeded ifTrue:[aStream nextPut:#pushNil].
-!
-
XXcodeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
"generate code for [...] whilexxx:[ ... ]"
@@ -758,27 +434,182 @@
(aStream contents) at:pos2 put:(aStream position).
!
-codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "generate code for n timesRepeat:[ ... ]"
+codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for (x and:[y]) ifxxx:[ ... ]"
+
+ |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
+
+
+ theByteCode := #falseJump.
+ theReceiver := receiver receiver.
- |pos pos2 theReceiver|
-
- theReceiver := 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 for:aCompiler.
- valueNeeded ifTrue:[aStream nextPut:#dup].
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ].
+ aStream nextPut:theByteCode.
+ pos1 := aStream position.
+ aStream nextPut:0.
- pos := aStream position.
-"/ aStream nextPut:#dup; nextPut:#push0; nextPut:#>; nextPut:lineNr; nextPut:#falseJump.
-"/ aStream nextPut:#dup; nextPut:#gt0; nextPut:lineNr; nextPut:#falseJump.
- aStream nextPut:#pushgt0; nextPut:lineNr; nextPut:#falseJump.
+ theReceiver := receiver arg1.
+ theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
+ (selector == #ifTrue:) ifTrue:[
+ jmp := #falseJump
+ ] ifFalse:[
+ jmp := #trueJump
+ ].
+ aStream nextPut:jmp.
pos2 := aStream position.
aStream nextPut:0.
- (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
- aStream nextPut:#minus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
+ code := aStream contents.
+ (selector == #ifFalse:) ifTrue:[
+ code at:pos1 put:(aStream position)
+ ].
+ (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
+
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos3 := aStream position.
+ aStream nextPut:0.
+ here := aStream position.
+ (selector == #ifTrue:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here.
+ aStream nextPut:#pushNil.
+ code at:pos3 put:(aStream position)
+ ] ifFalse:[
+ here := aStream position.
+ (selector == #ifTrue:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here
+ ]
+!
+
+codeAndOrOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "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 for:aCompiler.
+ aStream nextPut:theByteCode.
+ pos := aStream position.
+ aStream nextPut:0.
+ (argArray at: 1) codeInlineOn:aStream inBlock:b for:aCompiler.
+ (aStream contents) at:pos put:(aStream position).
+ valueNeeded ifFalse:[aStream nextPut:#drop]
+!
+
+codeForCascadeOn:aStream inBlock:b for:aCompiler
+ "like codeOn, but always leave the receiver instead of the result"
+
+ |nargs isBuiltIn code litIndex|
+
+ argArray isNil ifTrue:[
+ nargs := 0
+ ] ifFalse:[
+ nargs := argArray size
+ ].
+
+ isBuiltIn := false.
- (aStream contents) at:pos2 put:(aStream position).
- aStream nextPut:#drop.
+ (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 for:aCompiler.
+ aStream nextPut:#dup.
+
+ "can we use a send-bytecode ?"
+ isBuiltIn ifTrue:[
+ receiver isSuper ifFalse:[
+ (nargs > 0) ifTrue:[
+ (argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
+ (nargs > 1) ifTrue:[
+ (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
+ ]
+ ].
+ aStream nextPut:selector.
+ (self class hasLineNumber:selector) ifTrue:[
+ aStream nextPut:lineNr.
+ ].
+ aStream nextPut:#drop.
+ ^ self
+ ]
+ ].
+
+ "no - generate a send"
+ argArray notNil ifTrue:[
+ argArray do:[:arg |
+ arg codeOn:aStream inBlock:b for:aCompiler
+ ]
+ ].
+ litIndex := aCompiler addLiteral:selector.
+ litIndex <= 255 ifTrue:[
+ receiver isSuper ifTrue:[
+ receiver isHere ifTrue:[
+ code := #hereSend
+ ] ifFalse:[
+ code := #superSend.
+ ].
+ aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:nil; nextPut:#drop.
+ ^ self
+ ].
+ (nargs <= 3) ifTrue:[
+ code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
+ aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
+ ^ self
+ ].
+
+ aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
+ ^ self
+ ].
+ "need 16bit litIndex"
+ receiver isSuper ifTrue:[
+ receiver isHere ifTrue:[
+ code := #hereSendL
+ ] ifFalse:[
+ code := #superSendL.
+ ].
+ aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:nil; nextPut:#drop.
+ ^ self
+ ].
+ aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+!
+
+codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ self codeOn:aStream inBlock:b valueNeeded:false for:aCompiler
!
codeIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
@@ -915,183 +746,8 @@
]
!
-codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "generate code for (x and:[y]) ifxxx:[ ... ]"
-
- |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
-
-
- 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 for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ].
- aStream nextPut:theByteCode.
- pos1 := aStream position.
- aStream nextPut:0.
-
- theReceiver := receiver arg1.
- theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
- (selector == #ifTrue:) ifTrue:[
- jmp := #falseJump
- ] ifFalse:[
- jmp := #trueJump
- ].
- aStream nextPut:jmp.
- pos2 := aStream position.
- aStream nextPut:0.
-
- code := aStream contents.
- (selector == #ifFalse:) ifTrue:[
- code at:pos1 put:(aStream position)
- ].
- (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
-
- valueNeeded ifTrue:[
- aStream nextPut:#jump.
- pos3 := aStream position.
- aStream nextPut:0.
- here := aStream position.
- (selector == #ifTrue:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here.
- aStream nextPut:#pushNil.
- code at:pos3 put:(aStream position)
- ] ifFalse:[
- here := aStream position.
- (selector == #ifTrue:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here
- ]
-!
-
-codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "generate code for (x or:[y]) ifxxx:[ ... ]"
-
- |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
-
- 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 for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ].
- aStream nextPut:theByteCode.
- pos1 := aStream position.
- aStream nextPut:0.
-
-
- theReceiver := receiver arg1.
-
-"new:"
- (selector == #ifTrue:) ifTrue:[
- theByteCode := #falseJump
- ] ifFalse:[
- theByteCode := #trueJump
- ].
- optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
- optByteCode notNil ifTrue:[
- theReceiver isBlock ifTrue:[
- theReceiver := theReceiver statements expression
- ].
- ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
- theArg := theReceiver arg1
- ].
- theReceiver := theReceiver receiver.
- theByteCode := optByteCode.
-
- theReceiver codeOn:aStream inBlock:b for:aCompiler.
- theArg notNil ifTrue:[
- theArg codeOn:aStream inBlock:b for:aCompiler
- ].
- aStream nextPut:theByteCode.
-
- ] ifFalse:[
-"org"
- theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
- (selector == #ifTrue:) ifTrue:[
- jmp := #falseJump
- ] ifFalse:[
- jmp := #trueJump
- ].
- aStream nextPut:jmp
- ].
- 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 for:aCompiler.
-
- code := aStream contents.
- valueNeeded ifTrue:[
- aStream nextPut:#jump.
- pos3 := aStream position.
- aStream nextPut:0.
- here := aStream position.
- (selector == #ifFalse:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here.
- aStream nextPut:#pushNil.
- code at:pos3 put:(aStream position)
- ] ifFalse:[
- here := aStream position.
- (selector == #ifFalse:) ifTrue:[
- code at:pos1 put:here
- ].
- code at:pos2 put:here
- ]
-!
-
-codeAndOrOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
- "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 for:aCompiler.
- aStream nextPut:theByteCode.
- pos := aStream position.
- aStream nextPut:0.
- (argArray at: 1) codeInlineOn:aStream inBlock:b for:aCompiler.
- (aStream contents) at:pos put:(aStream position).
- valueNeeded ifFalse:[aStream nextPut:#drop]
+codeOn:aStream inBlock:b for:aCompiler
+ self codeOn:aStream inBlock:b valueNeeded:true for:aCompiler
!
codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
@@ -1328,6 +984,94 @@
"Modified: 3.9.1995 / 12:55:42 / claus"
!
+codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for (x or:[y]) ifxxx:[ ... ]"
+
+ |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|
+
+ 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 for:aCompiler.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ].
+ aStream nextPut:theByteCode.
+ pos1 := aStream position.
+ aStream nextPut:0.
+
+
+ theReceiver := receiver arg1.
+
+"new:"
+ (selector == #ifTrue:) ifTrue:[
+ theByteCode := #falseJump
+ ] ifFalse:[
+ theByteCode := #trueJump
+ ].
+ optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
+ optByteCode notNil ifTrue:[
+ theReceiver isBlock ifTrue:[
+ theReceiver := theReceiver statements expression
+ ].
+ ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
+ theArg := theReceiver arg1
+ ].
+ theReceiver := theReceiver receiver.
+ theByteCode := optByteCode.
+
+ theReceiver codeOn:aStream inBlock:b for:aCompiler.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ].
+ aStream nextPut:theByteCode.
+
+ ] ifFalse:[
+"org"
+ theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
+ (selector == #ifTrue:) ifTrue:[
+ jmp := #falseJump
+ ] ifFalse:[
+ jmp := #trueJump
+ ].
+ aStream nextPut:jmp
+ ].
+ 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 for:aCompiler.
+
+ code := aStream contents.
+ valueNeeded ifTrue:[
+ aStream nextPut:#jump.
+ pos3 := aStream position.
+ aStream nextPut:0.
+ here := aStream position.
+ (selector == #ifFalse:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here.
+ aStream nextPut:#pushNil.
+ code at:pos3 put:(aStream position)
+ ] ifFalse:[
+ here := aStream position.
+ (selector == #ifFalse:) ifTrue:[
+ code at:pos1 put:here
+ ].
+ code at:pos2 put:here
+ ]
+!
+
codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
"like code on, but assumes that receiver has already been
coded onto stack - needed for cascade"
@@ -1441,85 +1185,342 @@
aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
!
-codeForCascadeOn:aStream inBlock:b for:aCompiler
- "like codeOn, but always leave the receiver instead of the result"
+codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for n timesRepeat:[ ... ]"
+
+ |pos pos2 theReceiver|
+
+ theReceiver := receiver.
+ theReceiver codeOn:aStream inBlock:b for:aCompiler.
+ valueNeeded ifTrue:[aStream nextPut:#dup].
- |nargs isBuiltIn code litIndex|
+ pos := aStream position.
+"/ aStream nextPut:#dup; nextPut:#push0; nextPut:#>; nextPut:lineNr; nextPut:#falseJump.
+"/ aStream nextPut:#dup; nextPut:#gt0; nextPut:lineNr; nextPut:#falseJump.
+ aStream nextPut:#pushgt0; nextPut:lineNr; nextPut:#falseJump.
+ pos2 := aStream position.
+ aStream nextPut:0.
+
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+ aStream nextPut:#minus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
+
+ (aStream contents) at:pos2 put:(aStream position).
+ aStream nextPut:#drop.
+!
+
+codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
+ "generate code for [...] whilexxx:[ ... ]"
+
+ |pos pos2 theReceiver theArg theByteCode optByteCode|
- argArray isNil ifTrue:[
- nargs := 0
+ (selector == #whileTrue:) ifTrue:[
+ theByteCode := #falseJump
] ifFalse:[
- nargs := argArray size
+ 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
+ ].
+
+"/ OLD:
+"/ valueNeeded ifTrue:[aStream nextPut:#pushNil].
+"/
+ pos := aStream position.
+ optByteCode notNil ifTrue:[
+ theReceiver codeOn:aStream inBlock:b for:aCompiler.
+ theArg notNil ifTrue:[
+ theArg codeOn:aStream inBlock:b for:aCompiler
+ ]
+ ] ifFalse:[
+ theReceiver codeInlineOn:aStream inBlock:b for:aCompiler
+ ].
+
+ (lineNr between:1 and:255) ifTrue:[
+ aStream nextPut:#lineno; nextPut:lineNr.
].
- isBuiltIn := false.
+ aStream nextPut:theByteCode.
+ pos2 := aStream position.
+ aStream nextPut:0.
+"/ OLD:
+"/ valueNeeded ifTrue:[aStream nextPut:#drop].
+"/
+"/ OLD:
+"/ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
+"/ NEW:
+ (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+ aStream nextPut:#jump; nextPut:pos.
+ (aStream contents) at:pos2 put:(aStream position).
+"/ NEW:
+ valueNeeded ifTrue:[aStream nextPut:#pushNil].
+!
+
+optimizedConditionFor:aReceiver with:aByteCode
+ |rec sel|
- (nargs == 0) ifTrue:[
- isBuiltIn := self class isBuiltInUnarySelector:selector
+ rec := aReceiver.
+ (rec isBlock) ifTrue:[
+ rec statements nextStatement isNil ifTrue:[
+ rec := rec statements expression
+ ]
+ ].
+ (rec isUnaryMessage) ifTrue:[
+ sel := rec selector.
+ (sel == #isNil) ifTrue:[
+ "/
+ "/ isNil trueJmp -> nilJump
+ "/ isNil falseJmp -> notNilJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #nilJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notNilJump]
+ ].
+ (sel == #notNil) ifTrue:[
+ "/
+ "/ notNil trueJmp -> notNilJump
+ "/ notNil falseJmp -> nilJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #notNilJump].
+ (aByteCode == #falseJump) ifTrue:[^ #nilJump]
+ ].
+ (sel == #not) ifTrue:[
+ "/
+ "/ not trueJmp -> falseJump
+ "/ not falseJmp -> trueJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #falseJump].
+ (aByteCode == #falseJump) ifTrue:[^ #trueJump]
+ ].
+ ^ nil
].
+ (rec isBinaryMessage) ifTrue:[
+ sel := rec selector.
+ rec arg1 isConstant ifTrue:[
+ (rec arg1 value == 0) ifTrue:[
+ "/
+ "/ ==0 trueJmp -> zeroJump
+ "/ ==0 falseJmp -> notZeroJump
+ "/
+ (sel == #==) ifTrue:[
+ (aByteCode == #trueJump) ifTrue:[^ #zeroJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notZeroJump]
+ ].
+ "/
+ "/ ~~0 trueJmp -> notZeroJump
+ "/ ~~0 falseJmp -> zeroJump
+ "/
+ (sel == #~~) ifTrue:[
+ (aByteCode == #falseJump) ifTrue:[^ #zeroJump].
+ (aByteCode == #trueJump) ifTrue:[^ #notZeroJump]
+ ].
+ ^ nil
+ ]
+ ].
+ (sel == #==) ifTrue:[
+ "/
+ "/ == trueJmp -> eqJump
+ "/ == falseJmp -> notEqJump
+ "/
+ (aByteCode == #trueJump) ifTrue:[^ #eqJump].
+ (aByteCode == #falseJump) ifTrue:[^ #notEqJump]
+ ].
+ (sel == #~~) ifTrue:[
+ "/
+ "/ ~~ trueJmp -> notEqJump
+ "/ ~~ falseJmp -> eqJump
+ "/
+ (aByteCode == #falseJump) ifTrue:[^ #eqJump].
+ (aByteCode == #trueJump) ifTrue:[^ #notEqJump]
+ ]
+ ].
+ ^ nil
+! !
+
+!MessageNode methodsFor:'evaluating'!
+
+evaluate
+ |r nargs argValueArray class|
+
+ receiver isSuper ifTrue:[
+ r := receiver value.
+ receiver isHere ifTrue:[
+ class := receiver definingClass.
+ ] ifFalse:[
+ class := receiver definingClass superclass.
+ ].
+ argArray notNil ifTrue:[
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ ] ifFalse:[
+ argValueArray := #()
+ ].
+ ^ r perform:selector inClass:class withArguments:argValueArray
+ ].
+
+
+ argArray isNil ifTrue:[
+ ^ (receiver evaluate) perform:selector
+ ].
+ nargs := argArray size.
(nargs == 1) ifTrue:[
- isBuiltIn := self class isBuiltIn1ArgSelector:selector
+ ^ (receiver evaluate) perform:selector with:(argArray at:1) evaluate
].
(nargs == 2) ifTrue:[
- isBuiltIn := self class isBuiltIn2ArgSelector:selector
+ ^ (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 := argArray collect:[:arg | arg evaluate].
+ ^ r perform:selector withArguments:argValueArray
+!
+
+evaluateForCascade
+ |r nargs argValueArray class|
+
+ receiver isSuper ifTrue:[
+ r := receiver value.
+ class := receiver definingClass.
+ receiver isHere ifFalse:[
+ class := class superclass.
+ ].
+ argArray notNil ifTrue:[
+ argValueArray := argArray collect:[:arg | arg evaluate].
+ ] ifFalse:[
+ argValueArray := #()
+ ].
+ r perform:selector inClass:class withArguments:argValueArray.
+ ^ r
].
- receiver codeOn:aStream inBlock:b for:aCompiler.
- aStream nextPut:#dup.
+ 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 := argArray collect:[:arg | arg evaluate].
+ r perform:selector withArguments:argValueArray.
+ ^ r
+! !
+
+!MessageNode methodsFor:'printing'!
+
+printOn:aStream indent:i
+ |needParen selectorParts index index2 arg|
+
+ (#(whileTrue: whileFalse:) includes:selector) ifTrue:[
+ receiver isBlock ifTrue:[
+ ^ self printWhileOn:aStream indent:i
+ ].
+ ].
- "can we use a send-bytecode ?"
- isBuiltIn ifTrue:[
- receiver isSuper ifFalse:[
- (nargs > 0) ifTrue:[
- (argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
- (nargs > 1) ifTrue:[
- (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
+ 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
]
].
- aStream nextPut:selector.
- (self class hasLineNumber:selector) ifTrue:[
- aStream nextPut:lineNr.
- ].
- aStream nextPut:#drop.
- ^ self
- ]
- ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+ ]
+!
+
+printWhileOn:aStream indent:i
+ |needParen arg|
- "no - generate a send"
- argArray notNil ifTrue:[
- argArray do:[:arg |
- arg codeOn:aStream inBlock:b for:aCompiler
- ]
+ "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
+ ]
+ ].
].
- litIndex := aCompiler addLiteral:selector.
- litIndex <= 255 ifTrue:[
- receiver isSuper ifTrue:[
- receiver isHere ifTrue:[
- code := #hereSend
- ] ifFalse:[
- code := #superSend.
- ].
- aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:nil; nextPut:#drop.
- ^ self
- ].
- (nargs <= 3) ifTrue:[
- code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
- aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
- ^ self
- ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+! !
- aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
- ^ self
- ].
- "need 16bit litIndex"
- receiver isSuper ifTrue:[
- receiver isHere ifTrue:[
- code := #hereSendL
- ] ifFalse:[
- code := #superSendL.
- ].
- aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:nil; nextPut:#drop.
- ^ self
- ].
- aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+!MessageNode methodsFor:'queries'!
+
+isMessage
+ ^ true
! !
+
--- a/ParseNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/ParseNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
Object subclass:#ParseNode
- instanceVariableNames:'type comments parenthized'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'type comments parenthized'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!ParseNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/ParseNode.st,v 1.13 1995-11-11 15:31:02 cg Exp $'
-!
-
documentation
"
node for parse-trees; abstract class
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/ParseNode.st,v 1.14 1995-11-23 02:14:03 cg Exp $'
! !
!ParseNode class methodsFor:'instance creation'!
@@ -49,8 +49,91 @@
^ (self basicNew) type:t
! !
+!ParseNode methodsFor:'accessing'!
+
+lineNumber:dummy
+ "set linenumber - ignored here"
+
+ ^ self
+!
+
+parenthized
+ ^ parenthized
+!
+
+parenthized:aBoolean
+ parenthized := aBoolean
+!
+
+type
+ "return the nodes type"
+
+ ^ type
+! !
+
+!ParseNode methodsFor:'checks'!
+
+plausibilityCheck
+ ^ nil
+! !
+
+!ParseNode methodsFor:'code generation'!
+
+codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ "generate code for this statement - value not needed"
+
+ self codeOn:aStream inBlock:b for:aCompiler.
+ aStream nextPut:#drop
+! !
+
+!ParseNode methodsFor:'evaluation'!
+
+evaluateForCascade
+ ^ self evaluate
+! !
+
+!ParseNode methodsFor:'printing'!
+
+printOn:aStream
+ self printOn:aStream indent:0
+!
+
+printString
+ |stream|
+
+ stream := WriteStream on:String new.
+ self printOn:stream indent:0.
+ ^ stream contents
+! !
+
+!ParseNode methodsFor:'private'!
+
+type:t
+ "set the nodes type"
+
+ type := t
+! !
+
!ParseNode methodsFor:'queries'!
+isAssignment
+ "return true, if this is a node for an assignment"
+
+ ^ false
+!
+
+isBinaryMessage
+ "return true, if this is a node for a binary send"
+
+ ^ false
+!
+
+isBlockNode
+ "return true, if this is a node for a block"
+
+ ^ false
+!
+
isConstant
"return true, if this is a node for a constant"
@@ -63,14 +146,14 @@
^ false
!
-isPrimary
- "return true, if this is a node for a primary (i.e. non-send)"
+isMessage
+ "return true, if this is a node for a message expression"
^ false
!
-isSuper
- "return true, if this is a super-node"
+isPrimary
+ "return true, if this is a node for a primary (i.e. non-send)"
^ false
!
@@ -81,26 +164,8 @@
^ false
!
-isBlockNode
- "return true, if this is a node for a block"
-
- ^ false
-!
-
-isAssignment
- "return true, if this is a node for an assignment"
-
- ^ false
-!
-
-isMessage
- "return true, if this is a node for a message expression"
-
- ^ false
-!
-
-isBinaryMessage
- "return true, if this is a node for a binary send"
+isSuper
+ "return true, if this is a super-node"
^ false
!
@@ -111,67 +176,3 @@
^ false
! !
-!ParseNode methodsFor:'accessing'!
-
-type
- "return the nodes type"
-
- ^ type
-!
-
-lineNumber:dummy
- "set linenumber - ignored here"
-
- ^ self
-!
-
-parenthized:aBoolean
- parenthized := aBoolean
-!
-
-parenthized
- ^ parenthized
-! !
-
-!ParseNode methodsFor:'private'!
-
-type:t
- "set the nodes type"
-
- type := t
-! !
-
-!ParseNode methodsFor:'printing'!
-
-printString
- |stream|
-
- stream := WriteStream on:String new.
- self printOn:stream indent:0.
- ^ stream contents
-!
-
-printOn:aStream
- self printOn:aStream indent:0
-! !
-
-!ParseNode methodsFor:'checks'!
-
-plausibilityCheck
- ^ nil
-! !
-
-!ParseNode methodsFor:'evaluation'!
-
-evaluateForCascade
- ^ self evaluate
-! !
-
-!ParseNode methodsFor:'code generation'!
-
-codeForSideEffectOn:aStream inBlock:b for:aCompiler
- "generate code for this statement - value not needed"
-
- self codeOn:aStream inBlock:b for:aCompiler.
- aStream nextPut:#drop
-! !
--- a/PrimNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/PrimNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
StatementNode subclass:#PrimitiveNode
- instanceVariableNames:'code primNumber optional'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'code primNumber optional'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!PrimitiveNode class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/PrimNd.st,v 1.11 1995-11-11 15:31:26 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing primitive code
@@ -55,6 +51,10 @@
optional primitive; these are compiled on systems which do support binary code
loading, and ignored completely on others.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/PrimNd.st,v 1.12 1995-11-23 02:14:23 cg Exp $'
! !
!PrimitiveNode class methodsFor:'instance creation'!
@@ -67,16 +67,6 @@
^ self basicNew primitiveNumber:anInteger
! !
-!PrimitiveNode methodsFor:'queries'!
-
-isConstant
- ^ false
-!
-
-isOptional
- ^ optional
-! !
-
!PrimitiveNode methodsFor:'accessing'!
code:aString
@@ -104,22 +94,6 @@
primNumber := anInteger
! !
-!PrimitiveNode methodsFor:'evaluating'!
-
-evaluateExpression
- "catch evaluation"
-
- optional ifTrue:[^ nil].
- self error:'cannot evaluate primitives'
-!
-
-evaluate
- "catch evaluation"
-
- optional ifTrue:[^ nil].
- self error:'cannot evaluate primitives'
-! !
-
!PrimitiveNode methodsFor:'code generation'!
codeForSideEffectOn:aStream inBlock:b for:aCompiler
@@ -135,3 +109,30 @@
optional ifTrue:[^ self].
self error:'cannot compile primitives (as yet)'
! !
+
+!PrimitiveNode methodsFor:'evaluating'!
+
+evaluate
+ "catch evaluation"
+
+ optional ifTrue:[^ nil].
+ self error:'cannot evaluate primitives'
+!
+
+evaluateExpression
+ "catch evaluation"
+
+ optional ifTrue:[^ nil].
+ self error:'cannot evaluate primitives'
+! !
+
+!PrimitiveNode methodsFor:'queries'!
+
+isConstant
+ ^ false
+!
+
+isOptional
+ ^ optional
+! !
+
--- a/PrimaryNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/PrimaryNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#PrimaryNode
- instanceVariableNames:'value'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'value'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!PrimaryNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/PrimaryNd.st,v 1.12 1995-11-11 15:31:27 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing primaries (variables & literals)
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/PrimaryNd.st,v 1.13 1995-11-23 02:14:13 cg Exp $'
! !
!PrimaryNode methodsFor:'accessing'!
@@ -49,24 +49,6 @@
^ value
! !
-!PrimaryNode methodsFor:'queries'!
-
-isPrimary
- "return true, if this is a node for a primary (i.e. non-send)"
-
- ^ true
-! !
-
-!PrimaryNode methodsFor:'evaluating'!
-
-evaluate
- ^ self subclassResponsibility
-!
-
-store:aValue
- ^ self subclassResponsibility
-! !
-
!PrimaryNode methodsFor:'code generation'!
codeForSideEffectOn:aStream inBlock:b for:aCompiler
@@ -82,6 +64,16 @@
^ self subclassResponsibility
! !
+!PrimaryNode methodsFor:'evaluating'!
+
+evaluate
+ ^ self subclassResponsibility
+!
+
+store:aValue
+ ^ self subclassResponsibility
+! !
+
!PrimaryNode methodsFor:'printing'!
displayString
@@ -91,3 +83,12 @@
printOn:aStream indent:i
^ self subclassResponsibility
! !
+
+!PrimaryNode methodsFor:'queries'!
+
+isPrimary
+ "return true, if this is a node for a primary (i.e. non-send)"
+
+ ^ true
+! !
+
--- a/PrimaryNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/PrimaryNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#PrimaryNode
- instanceVariableNames:'value'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'value'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!PrimaryNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/PrimaryNode.st,v 1.12 1995-11-11 15:31:27 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing primaries (variables & literals)
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/PrimaryNode.st,v 1.13 1995-11-23 02:14:13 cg Exp $'
! !
!PrimaryNode methodsFor:'accessing'!
@@ -49,24 +49,6 @@
^ value
! !
-!PrimaryNode methodsFor:'queries'!
-
-isPrimary
- "return true, if this is a node for a primary (i.e. non-send)"
-
- ^ true
-! !
-
-!PrimaryNode methodsFor:'evaluating'!
-
-evaluate
- ^ self subclassResponsibility
-!
-
-store:aValue
- ^ self subclassResponsibility
-! !
-
!PrimaryNode methodsFor:'code generation'!
codeForSideEffectOn:aStream inBlock:b for:aCompiler
@@ -82,6 +64,16 @@
^ self subclassResponsibility
! !
+!PrimaryNode methodsFor:'evaluating'!
+
+evaluate
+ ^ self subclassResponsibility
+!
+
+store:aValue
+ ^ self subclassResponsibility
+! !
+
!PrimaryNode methodsFor:'printing'!
displayString
@@ -91,3 +83,12 @@
printOn:aStream indent:i
^ self subclassResponsibility
! !
+
+!PrimaryNode methodsFor:'queries'!
+
+isPrimary
+ "return true, if this is a node for a primary (i.e. non-send)"
+
+ ^ true
+! !
+
--- a/PrimitiveNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/PrimitiveNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
StatementNode subclass:#PrimitiveNode
- instanceVariableNames:'code primNumber optional'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'code primNumber optional'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!PrimitiveNode class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/PrimitiveNode.st,v 1.11 1995-11-11 15:31:26 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing primitive code
@@ -55,6 +51,10 @@
optional primitive; these are compiled on systems which do support binary code
loading, and ignored completely on others.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/PrimitiveNode.st,v 1.12 1995-11-23 02:14:23 cg Exp $'
! !
!PrimitiveNode class methodsFor:'instance creation'!
@@ -67,16 +67,6 @@
^ self basicNew primitiveNumber:anInteger
! !
-!PrimitiveNode methodsFor:'queries'!
-
-isConstant
- ^ false
-!
-
-isOptional
- ^ optional
-! !
-
!PrimitiveNode methodsFor:'accessing'!
code:aString
@@ -104,22 +94,6 @@
primNumber := anInteger
! !
-!PrimitiveNode methodsFor:'evaluating'!
-
-evaluateExpression
- "catch evaluation"
-
- optional ifTrue:[^ nil].
- self error:'cannot evaluate primitives'
-!
-
-evaluate
- "catch evaluation"
-
- optional ifTrue:[^ nil].
- self error:'cannot evaluate primitives'
-! !
-
!PrimitiveNode methodsFor:'code generation'!
codeForSideEffectOn:aStream inBlock:b for:aCompiler
@@ -135,3 +109,30 @@
optional ifTrue:[^ self].
self error:'cannot compile primitives (as yet)'
! !
+
+!PrimitiveNode methodsFor:'evaluating'!
+
+evaluate
+ "catch evaluation"
+
+ optional ifTrue:[^ nil].
+ self error:'cannot evaluate primitives'
+!
+
+evaluateExpression
+ "catch evaluation"
+
+ optional ifTrue:[^ nil].
+ self error:'cannot evaluate primitives'
+! !
+
+!PrimitiveNode methodsFor:'queries'!
+
+isConstant
+ ^ false
+!
+
+isOptional
+ ^ optional
+! !
+
--- a/RetNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/RetNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
StatementNode subclass:#ReturnNode
- instanceVariableNames:'myHome blockHome'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'myHome blockHome'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!ReturnNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/RetNode.st,v 1.12 1995-11-11 15:31:30 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing return expressions
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/RetNode.st,v 1.13 1995-11-23 02:14:34 cg Exp $'
! !
!ReturnNode methodsFor:'accessing'!
@@ -50,30 +50,6 @@
blockHome := aBlockNode
! !
-!ReturnNode methodsFor:'queries'!
-
-isConstant
- ^ false
-!
-
-isReturnNode
- ^ true
-! !
-
-!ReturnNode methodsFor:'evaluating'!
-
-evaluateExpression
- |val|
-
- val := expression evaluate.
- myHome exitWith:val.
- "when we arrive here, the parser context is already gone
- - try block-return"
- blockHome notNil ifTrue:[blockHome exitWith:val].
- "well - what else can be done"
- ^ val
-! !
-
!ReturnNode methodsFor:'code generation'!
codeForSideEffectOn:aStream inBlock:b for:aCompiler
@@ -152,9 +128,34 @@
aStream nextPut:#retTop
! !
+!ReturnNode methodsFor:'evaluating'!
+
+evaluateExpression
+ |val|
+
+ val := expression evaluate.
+ myHome exitWith:val.
+ "when we arrive here, the parser context is already gone
+ - try block-return"
+ blockHome notNil ifTrue:[blockHome exitWith:val].
+ "well - what else can be done"
+ ^ val
+! !
+
!ReturnNode methodsFor:'printing'!
printOn:aStream indent:i
aStream nextPutAll:'^ '.
expression printOn:aStream
! !
+
+!ReturnNode methodsFor:'queries'!
+
+isConstant
+ ^ false
+!
+
+isReturnNode
+ ^ true
+! !
+
--- a/ReturnNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/ReturnNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
StatementNode subclass:#ReturnNode
- instanceVariableNames:'myHome blockHome'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'myHome blockHome'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!ReturnNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/ReturnNode.st,v 1.12 1995-11-11 15:31:30 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing return expressions
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/ReturnNode.st,v 1.13 1995-11-23 02:14:34 cg Exp $'
! !
!ReturnNode methodsFor:'accessing'!
@@ -50,30 +50,6 @@
blockHome := aBlockNode
! !
-!ReturnNode methodsFor:'queries'!
-
-isConstant
- ^ false
-!
-
-isReturnNode
- ^ true
-! !
-
-!ReturnNode methodsFor:'evaluating'!
-
-evaluateExpression
- |val|
-
- val := expression evaluate.
- myHome exitWith:val.
- "when we arrive here, the parser context is already gone
- - try block-return"
- blockHome notNil ifTrue:[blockHome exitWith:val].
- "well - what else can be done"
- ^ val
-! !
-
!ReturnNode methodsFor:'code generation'!
codeForSideEffectOn:aStream inBlock:b for:aCompiler
@@ -152,9 +128,34 @@
aStream nextPut:#retTop
! !
+!ReturnNode methodsFor:'evaluating'!
+
+evaluateExpression
+ |val|
+
+ val := expression evaluate.
+ myHome exitWith:val.
+ "when we arrive here, the parser context is already gone
+ - try block-return"
+ blockHome notNil ifTrue:[blockHome exitWith:val].
+ "well - what else can be done"
+ ^ val
+! !
+
!ReturnNode methodsFor:'printing'!
printOn:aStream indent:i
aStream nextPutAll:'^ '.
expression printOn:aStream
! !
+
+!ReturnNode methodsFor:'queries'!
+
+isConstant
+ ^ false
+!
+
+isReturnNode
+ ^ true
+! !
+
--- a/SelfNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/SelfNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
PrimaryNode subclass:#SelfNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!SelfNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/SelfNode.st,v 1.7 1995-11-11 15:31:37 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing self
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/SelfNode.st,v 1.8 1995-11-23 02:14:45 cg Exp $'
! !
!SelfNode class methodsFor:'instance creation'!
@@ -56,6 +56,18 @@
value := val.
! !
+!SelfNode methodsFor:'code generation'!
+
+codeOn:aStream inBlock:codeBlock for:aCompiler
+ aStream nextPut:#pushSelf
+!
+
+codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded for:aCompiler
+ "not reached - parser has already checked this"
+
+ ^ self error:'store into self - cannot happen'
+! !
+
!SelfNode methodsFor:'evaluating'!
evaluate
@@ -68,18 +80,6 @@
self error:'store into self - cannot happen'
! !
-!SelfNode methodsFor:'code generation'!
-
-codeOn:aStream inBlock:codeBlock for:aCompiler
- aStream nextPut:#pushSelf
-!
-
-codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded for:aCompiler
- "not reached - parser has already checked this"
-
- ^ self error:'store into self - cannot happen'
-! !
-
!SelfNode methodsFor:'printing'!
displayString
@@ -89,3 +89,4 @@
printOn:aStream indent:i
aStream nextPutAll:'self'
! !
+
--- a/StatNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/StatNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#StatementNode
- instanceVariableNames:'expression nextStatement'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'expression nextStatement'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!StatementNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/StatNode.st,v 1.11 1995-11-11 15:31:39 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing statements
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/StatNode.st,v 1.12 1995-11-23 02:14:55 cg Exp $'
! !
!StatementNode class methodsFor:'instance creation'!
@@ -49,40 +49,16 @@
^ (self basicNew) expression:e
! !
-!StatementNode methodsFor:'evaluating'!
+!StatementNode methodsFor:'accessing'!
-evaluateExpression
- ^ expression evaluate
+expression
+ ^ expression
!
-evaluate
- |lastValue thisStatement|
-
- "this could be done more elegant - but with lots of recursion"
- thisStatement := self.
- [thisStatement notNil] whileTrue:[
- lastValue := thisStatement evaluateExpression.
- thisStatement := thisStatement nextStatement
- ].
- ^ lastValue
-! !
-
-!StatementNode methodsFor:'code generation'!
-
-codeOn:aStream inBlock:b for:aCompiler
- "generate code for this statement"
-
- expression codeOn:aStream inBlock:b for:aCompiler
+expression:e
+ expression := e
!
-codeForSideEffectOn:aStream inBlock:b for:aCompiler
- "generate code for this statement - value not needed"
-
- expression codeForSideEffectOn:aStream inBlock:b for:aCompiler
-! !
-
-!StatementNode methodsFor:'accessing'!
-
last
"return the last statement in a list"
@@ -98,35 +74,48 @@
^ last
!
-nextStatement:s
- nextStatement := s
-!
-
nextStatement
^ nextStatement
!
-expression:e
- expression := e
+nextStatement:s
+ nextStatement := s
+! !
+
+!StatementNode methodsFor:'code generation'!
+
+codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ "generate code for this statement - value not needed"
+
+ expression codeForSideEffectOn:aStream inBlock:b for:aCompiler
!
-expression
- ^ expression
+codeOn:aStream inBlock:b for:aCompiler
+ "generate code for this statement"
+
+ expression codeOn:aStream inBlock:b for:aCompiler
! !
-!StatementNode methodsFor:'queries'!
+!StatementNode methodsFor:'evaluating'!
+
+evaluate
+ |lastValue thisStatement|
-isConstant
- nextStatement notNil ifTrue:[^ false].
- ^ expression isConstant
+ "this could be done more elegant - but with lots of recursion"
+ thisStatement := self.
+ [thisStatement notNil] whileTrue:[
+ lastValue := thisStatement evaluateExpression.
+ thisStatement := thisStatement nextStatement
+ ].
+ ^ lastValue
+!
+
+evaluateExpression
+ ^ expression evaluate
! !
!StatementNode methodsFor:'printing'!
-printOn:aStream indent:i
- expression printOn:aStream indent:i.
-!
-
printAllOn:aStream
self printAllOn:aStream indent:4
!
@@ -144,4 +133,16 @@
].
thisStatement := thisStatement nextStatement
]
+!
+
+printOn:aStream indent:i
+ expression printOn:aStream indent:i.
! !
+
+!StatementNode methodsFor:'queries'!
+
+isConstant
+ nextStatement notNil ifTrue:[^ false].
+ ^ expression isConstant
+! !
+
--- a/StatementNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/StatementNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
ParseNode subclass:#StatementNode
- instanceVariableNames:'expression nextStatement'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'expression nextStatement'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!StatementNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/StatementNode.st,v 1.11 1995-11-11 15:31:39 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing statements
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/StatementNode.st,v 1.12 1995-11-23 02:14:55 cg Exp $'
! !
!StatementNode class methodsFor:'instance creation'!
@@ -49,40 +49,16 @@
^ (self basicNew) expression:e
! !
-!StatementNode methodsFor:'evaluating'!
+!StatementNode methodsFor:'accessing'!
-evaluateExpression
- ^ expression evaluate
+expression
+ ^ expression
!
-evaluate
- |lastValue thisStatement|
-
- "this could be done more elegant - but with lots of recursion"
- thisStatement := self.
- [thisStatement notNil] whileTrue:[
- lastValue := thisStatement evaluateExpression.
- thisStatement := thisStatement nextStatement
- ].
- ^ lastValue
-! !
-
-!StatementNode methodsFor:'code generation'!
-
-codeOn:aStream inBlock:b for:aCompiler
- "generate code for this statement"
-
- expression codeOn:aStream inBlock:b for:aCompiler
+expression:e
+ expression := e
!
-codeForSideEffectOn:aStream inBlock:b for:aCompiler
- "generate code for this statement - value not needed"
-
- expression codeForSideEffectOn:aStream inBlock:b for:aCompiler
-! !
-
-!StatementNode methodsFor:'accessing'!
-
last
"return the last statement in a list"
@@ -98,35 +74,48 @@
^ last
!
-nextStatement:s
- nextStatement := s
-!
-
nextStatement
^ nextStatement
!
-expression:e
- expression := e
+nextStatement:s
+ nextStatement := s
+! !
+
+!StatementNode methodsFor:'code generation'!
+
+codeForSideEffectOn:aStream inBlock:b for:aCompiler
+ "generate code for this statement - value not needed"
+
+ expression codeForSideEffectOn:aStream inBlock:b for:aCompiler
!
-expression
- ^ expression
+codeOn:aStream inBlock:b for:aCompiler
+ "generate code for this statement"
+
+ expression codeOn:aStream inBlock:b for:aCompiler
! !
-!StatementNode methodsFor:'queries'!
+!StatementNode methodsFor:'evaluating'!
+
+evaluate
+ |lastValue thisStatement|
-isConstant
- nextStatement notNil ifTrue:[^ false].
- ^ expression isConstant
+ "this could be done more elegant - but with lots of recursion"
+ thisStatement := self.
+ [thisStatement notNil] whileTrue:[
+ lastValue := thisStatement evaluateExpression.
+ thisStatement := thisStatement nextStatement
+ ].
+ ^ lastValue
+!
+
+evaluateExpression
+ ^ expression evaluate
! !
!StatementNode methodsFor:'printing'!
-printOn:aStream indent:i
- expression printOn:aStream indent:i.
-!
-
printAllOn:aStream
self printAllOn:aStream indent:4
!
@@ -144,4 +133,16 @@
].
thisStatement := thisStatement nextStatement
]
+!
+
+printOn:aStream indent:i
+ expression printOn:aStream indent:i.
! !
+
+!StatementNode methodsFor:'queries'!
+
+isConstant
+ nextStatement notNil ifTrue:[^ false].
+ ^ expression isConstant
+! !
+
--- a/SuperNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/SuperNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
SelfNode subclass:#SuperNode
- instanceVariableNames:'class isHere'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'class isHere'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!SuperNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/SuperNode.st,v 1.7 1995-11-11 15:31:40 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing super
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/SuperNode.st,v 1.8 1995-11-23 02:15:05 cg Exp $'
! !
!SuperNode class methodsFor:'instance creation'!
@@ -55,27 +55,15 @@
!SuperNode methodsFor:'accessing'!
+definingClass
+ ^ class
+!
+
value:val inClass:cls here:h
type := #Super.
value := val.
class := cls.
isHere := h
-!
-
-definingClass
- ^ class
-! !
-
-!SuperNode methodsFor:'queries'!
-
-isSuper
- "return true, if this is a super-node"
-
- ^ true
-!
-
-isHere
- ^ isHere
! !
!SuperNode methodsFor:'printing'!
@@ -87,3 +75,16 @@
aStream nextPutAll:'super'
]
! !
+
+!SuperNode methodsFor:'queries'!
+
+isHere
+ ^ isHere
+!
+
+isSuper
+ "return true, if this is a super-node"
+
+ ^ true
+! !
+
--- a/UnaryNd.st Sat Nov 18 17:59:14 1995 +0100
+++ b/UnaryNd.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
MessageNode subclass:#UnaryNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!UnaryNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.17 1995-11-11 15:31:42 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing unary messages
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.18 1995-11-23 02:15:16 cg Exp $'
! !
!UnaryNode class methodsFor:'instance creation'!
@@ -139,13 +139,6 @@
^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
! !
-!UnaryNode methodsFor:'queries'!
-
-isUnaryMessage
- "return true, if this node is one for a unary message"
- ^ true
-! !
-
!UnaryNode methodsFor:'checks'!
plausibilityCheck
@@ -167,17 +160,6 @@
^ nil
! !
-!UnaryNode methodsFor:'evaluating'!
-
-evaluate
- "evaluate the expression represented by the receiver"
-
- receiver isSuper ifTrue:[
- ^ super evaluate
- ].
- ^ (receiver evaluate) perform:selector
-! !
-
!UnaryNode methodsFor:'code generation'!
codeOn:aStream inBlock:b for:aCompiler
@@ -223,6 +205,17 @@
^ super codeOn:aStream inBlock:b for:aCompiler
! !
+!UnaryNode methodsFor:'evaluating'!
+
+evaluate
+ "evaluate the expression represented by the receiver"
+
+ receiver isSuper ifTrue:[
+ ^ super evaluate
+ ].
+ ^ (receiver evaluate) perform:selector
+! !
+
!UnaryNode methodsFor:'printing'!
printOn:aStream indent:i
@@ -247,3 +240,11 @@
selector printString printOn:aStream.
" aStream space. "
! !
+
+!UnaryNode methodsFor:'queries'!
+
+isUnaryMessage
+ "return true, if this node is one for a unary message"
+ ^ true
+! !
+
--- a/UnaryNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/UnaryNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
MessageNode subclass:#UnaryNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!UnaryNode class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.17 1995-11-11 15:31:42 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing unary messages
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.18 1995-11-23 02:15:16 cg Exp $'
! !
!UnaryNode class methodsFor:'instance creation'!
@@ -139,13 +139,6 @@
^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
! !
-!UnaryNode methodsFor:'queries'!
-
-isUnaryMessage
- "return true, if this node is one for a unary message"
- ^ true
-! !
-
!UnaryNode methodsFor:'checks'!
plausibilityCheck
@@ -167,17 +160,6 @@
^ nil
! !
-!UnaryNode methodsFor:'evaluating'!
-
-evaluate
- "evaluate the expression represented by the receiver"
-
- receiver isSuper ifTrue:[
- ^ super evaluate
- ].
- ^ (receiver evaluate) perform:selector
-! !
-
!UnaryNode methodsFor:'code generation'!
codeOn:aStream inBlock:b for:aCompiler
@@ -223,6 +205,17 @@
^ super codeOn:aStream inBlock:b for:aCompiler
! !
+!UnaryNode methodsFor:'evaluating'!
+
+evaluate
+ "evaluate the expression represented by the receiver"
+
+ receiver isSuper ifTrue:[
+ ^ super evaluate
+ ].
+ ^ (receiver evaluate) perform:selector
+! !
+
!UnaryNode methodsFor:'printing'!
printOn:aStream indent:i
@@ -247,3 +240,11 @@
selector printString printOn:aStream.
" aStream space. "
! !
+
+!UnaryNode methodsFor:'queries'!
+
+isUnaryMessage
+ "return true, if this node is one for a unary message"
+ ^ true
+! !
+
--- a/UndefVar.st Sat Nov 18 17:59:14 1995 +0100
+++ b/UndefVar.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
Object subclass:#UndefinedVariable
- instanceVariableNames:'name'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'name'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!UndefinedVariable class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/UndefVar.st,v 1.8 1995-11-11 15:31:44 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing undefined variables
@@ -47,6 +43,10 @@
The error message will then be 'UndefinedVariable ...'
instead of 'UndefineObject ...', which is somewhat more informative.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/UndefVar.st,v 1.9 1995-11-23 02:15:29 cg Exp $'
! !
!UndefinedVariable class methodsFor:'instance creation'!
@@ -55,38 +55,6 @@
^ (self basicNew) setName:aString
! !
-!UndefinedVariable methodsFor:'error reporting'!
-
-methodError
- self error:('trying to define methods for undefined class: ', name)
-!
-
-subclassingError
- self error:('trying to create subclass of undefined class: ', name)
-! !
-
-!UndefinedVariable methodsFor:'file skipping'!
-
-fileInFrom:aStream notifying:someOne passChunk:passChunk
- "this is sent, if you continue after a warning about
- methods for undefined class.
- It simply skips chunks and sends a warning to the Transcript."
-
- |aString done|
-
- done := false.
- [done] whileFalse:[
- done := aStream atEnd.
- done ifFalse:[
- aString := aStream nextChunk.
- done := aString isNil or:[aString isEmpty].
- done ifFalse:[
- Transcript showCr:'*** skipping method for undefined class: ' , name
- ]
- ]
- ].
-! !
-
!UndefinedVariable methodsFor:'catching messages'!
class
@@ -124,10 +92,36 @@
self subclassingError
! !
-!UndefinedVariable methodsFor:'private accessing'!
+!UndefinedVariable methodsFor:'error reporting'!
+
+methodError
+ self error:('trying to define methods for undefined class: ', name)
+!
+
+subclassingError
+ self error:('trying to create subclass of undefined class: ', name)
+! !
+
+!UndefinedVariable methodsFor:'file skipping'!
-setName:aString
- name := aString
+fileInFrom:aStream notifying:someOne passChunk:passChunk
+ "this is sent, if you continue after a warning about
+ methods for undefined class.
+ It simply skips chunks and sends a warning to the Transcript."
+
+ |aString done|
+
+ done := false.
+ [done] whileFalse:[
+ done := aStream atEnd.
+ done ifFalse:[
+ aString := aStream nextChunk.
+ done := aString isNil or:[aString isEmpty].
+ done ifFalse:[
+ Transcript showCr:'*** skipping method for undefined class: ' , name
+ ]
+ ]
+ ].
! !
!UndefinedVariable methodsFor:'printing & storing'!
@@ -137,3 +131,10 @@
^ 'UndefinedVariable(' , name , ')'
! !
+
+!UndefinedVariable methodsFor:'private accessing'!
+
+setName:aString
+ name := aString
+! !
+
--- a/UndefinedVariable.st Sat Nov 18 17:59:14 1995 +0100
+++ b/UndefinedVariable.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
Object subclass:#UndefinedVariable
- instanceVariableNames:'name'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'name'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!UndefinedVariable class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/UndefinedVariable.st,v 1.8 1995-11-11 15:31:44 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing undefined variables
@@ -47,6 +43,10 @@
The error message will then be 'UndefinedVariable ...'
instead of 'UndefineObject ...', which is somewhat more informative.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/UndefinedVariable.st,v 1.9 1995-11-23 02:15:29 cg Exp $'
! !
!UndefinedVariable class methodsFor:'instance creation'!
@@ -55,38 +55,6 @@
^ (self basicNew) setName:aString
! !
-!UndefinedVariable methodsFor:'error reporting'!
-
-methodError
- self error:('trying to define methods for undefined class: ', name)
-!
-
-subclassingError
- self error:('trying to create subclass of undefined class: ', name)
-! !
-
-!UndefinedVariable methodsFor:'file skipping'!
-
-fileInFrom:aStream notifying:someOne passChunk:passChunk
- "this is sent, if you continue after a warning about
- methods for undefined class.
- It simply skips chunks and sends a warning to the Transcript."
-
- |aString done|
-
- done := false.
- [done] whileFalse:[
- done := aStream atEnd.
- done ifFalse:[
- aString := aStream nextChunk.
- done := aString isNil or:[aString isEmpty].
- done ifFalse:[
- Transcript showCr:'*** skipping method for undefined class: ' , name
- ]
- ]
- ].
-! !
-
!UndefinedVariable methodsFor:'catching messages'!
class
@@ -124,10 +92,36 @@
self subclassingError
! !
-!UndefinedVariable methodsFor:'private accessing'!
+!UndefinedVariable methodsFor:'error reporting'!
+
+methodError
+ self error:('trying to define methods for undefined class: ', name)
+!
+
+subclassingError
+ self error:('trying to create subclass of undefined class: ', name)
+! !
+
+!UndefinedVariable methodsFor:'file skipping'!
-setName:aString
- name := aString
+fileInFrom:aStream notifying:someOne passChunk:passChunk
+ "this is sent, if you continue after a warning about
+ methods for undefined class.
+ It simply skips chunks and sends a warning to the Transcript."
+
+ |aString done|
+
+ done := false.
+ [done] whileFalse:[
+ done := aStream atEnd.
+ done ifFalse:[
+ aString := aStream nextChunk.
+ done := aString isNil or:[aString isEmpty].
+ done ifFalse:[
+ Transcript showCr:'*** skipping method for undefined class: ' , name
+ ]
+ ]
+ ].
! !
!UndefinedVariable methodsFor:'printing & storing'!
@@ -137,3 +131,10 @@
^ 'UndefinedVariable(' , name , ')'
! !
+
+!UndefinedVariable methodsFor:'private accessing'!
+
+setName:aString
+ name := aString
+! !
+
--- a/VarNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/VarNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
PrimaryNode subclass:#VariableNode
- instanceVariableNames:'name token selfValue selfClass index block'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'name token selfValue selfClass index block'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!VariableNode class methodsFor:'documentation'!
@@ -33,26 +33,18 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.12 1995-11-11 15:31:46 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing variables
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.13 1995-11-23 02:15:59 cg Exp $'
! !
!VariableNode class methodsFor:'instance creation'!
-type:t token:tok
- ^ (self basicNew) type:t token:tok
-!
-
-type:t name:n
- ^ (self basicNew) type:t name:n
-!
-
type:t class:class name:n
^ (self basicNew) type:t class:class name:n
!
@@ -61,24 +53,32 @@
^ (self basicNew) type:t index:i selfValue:s
!
-type:t name:n value:val
- ^ (self basicNew) type:t name:n value:val
+type:t name:n
+ ^ (self basicNew) type:t name:n
+!
+
+type:t name:n index:i selfClass:s
+ ^ (self basicNew) type:t name:n index:i selfClass:s
+!
+
+type:t name:n index:i selfValue:s
+ ^ (self basicNew) type:t name:n index:i selfValue:s
!
type:t name:n token:tok index:i
^ (self basicNew) type:t name:n token:tok index:i
!
-type:t name:n index:i selfValue:s
- ^ (self basicNew) type:t name:n index:i selfValue:s
+type:t name:n token:tok index:i block:b
+ ^ (self basicNew) type:t name:n token:tok index:i block:b
!
-type:t name:n index:i selfClass:s
- ^ (self basicNew) type:t name:n index:i selfClass:s
+type:t name:n value:val
+ ^ (self basicNew) type:t name:n value:val
!
-type:t name:n token:tok index:i block:b
- ^ (self basicNew) type:t name:n token:tok index:i block:b
+type:t token:tok
+ ^ (self basicNew) type:t token:tok
!
type:t token:tok index:i
@@ -89,38 +89,21 @@
^ (self basicNew) type:t token:tok index:i block:b
! !
-!VariableNode methodsFor:'queries'!
-
-isGlobal
- "return true, if this is a node for a global variable"
-
- ^ (type == #GlobalVariable) and:[Smalltalk includesKey:name]
-! !
-
!VariableNode methodsFor:'accessing'!
-type:t token:tok
- type := t.
- token := tok
+index
+ ^ index
!
-type:t token:tok index:i
- type := t.
- index := i.
- token := tok
+name
+ ^ name
!
-type:t token:tok index:i block:b
- type := t.
- index := i.
- block := b.
- token := tok
-!
-
-type:t name:n
+type:t class:class name:n
type := t.
value := nil.
- name := n
+ name := n.
+ selfClass := class
!
type:t index:i selfValue:s
@@ -130,24 +113,9 @@
selfValue := s
!
-type:t class:class name:n
+type:t name:n
type := t.
value := nil.
- name := n.
- selfClass := class
-!
-
-type:t name:n value:val
- type := t.
- name := n.
- value := val
-!
-
-type:t name:n index:i selfValue:s
- type := t.
- value := nil.
- index := i.
- selfValue := s.
name := n
!
@@ -159,6 +127,14 @@
name := n
!
+type:t name:n index:i selfValue:s
+ type := t.
+ value := nil.
+ index := i.
+ selfValue := s.
+ name := n
+!
+
type:t name:n token:tok index:i
type := t.
index := i.
@@ -174,70 +150,28 @@
name := n
!
-name
- ^ name
+type:t name:n value:val
+ type := t.
+ name := n.
+ value := val
+!
+
+type:t token:tok
+ type := t.
+ token := tok
!
-index
- ^ index
-! !
-
-!VariableNode methodsFor:'evaluating'!
-
-evaluate
- (type == #MethodVariable
- or:[type == #BlockArg
- or:[type == #BlockVariable]]) ifTrue:[
- ^ token variableValue
- ].
- (type == #InstanceVariable) ifTrue:[
- ^ selfValue instVarAt:index
- ].
- (type == #GlobalVariable) ifTrue:[
- (Smalltalk includesKey:name) ifTrue:[
- ^ Smalltalk at:name
- ].
-"
- self error:('global ' , name , ' is undefined').
-"
-
- ^ UndefinedVariable name:name.
- ^ nil
- ].
- (type == #ClassVariable) ifTrue:[
- ^ Smalltalk at:(selfClass name , ':' , name) asSymbol
- ].
- (type == #ClassInstanceVariable) ifTrue:[
- ^ selfClass instVarAt:index
- ].
- (type == #ThisContext) ifTrue:[
- ^ thisContext
- ].
- "not reached"
- self halt:'bad type'.
- ^ value
+type:t token:tok index:i
+ type := t.
+ index := i.
+ token := tok
!
-store:aValue
- (type == #MethodVariable
- or:[type == #BlockVariable]) ifTrue:[
- token value:aValue. ^ aValue
- ].
- (type == #InstanceVariable) ifTrue:[
- ^ selfValue instVarAt:index put:aValue
- ].
- (type == #GlobalVariable) ifTrue:[
- ^ Smalltalk at:name put:aValue
- ].
- (type == #ClassVariable) ifTrue:[
- ^ Smalltalk at:(selfClass name , ':' , name) asSymbol put:aValue
- ].
- (type == #ClassInstanceVariable) ifTrue:[
- ^ selfClass instVarAt:index put:aValue
- ].
- "not reached"
- self halt:'bad type'.
- ^ aValue
+type:t token:tok index:i block:b
+ type := t.
+ index := i.
+ block := b.
+ token := tok
! !
!VariableNode methodsFor:'code generation'!
@@ -454,6 +388,64 @@
^ self error:'bad assignment'
! !
+!VariableNode methodsFor:'evaluating'!
+
+evaluate
+ (type == #MethodVariable
+ or:[type == #BlockArg
+ or:[type == #BlockVariable]]) ifTrue:[
+ ^ token variableValue
+ ].
+ (type == #InstanceVariable) ifTrue:[
+ ^ selfValue instVarAt:index
+ ].
+ (type == #GlobalVariable) ifTrue:[
+ (Smalltalk includesKey:name) ifTrue:[
+ ^ Smalltalk at:name
+ ].
+"
+ self error:('global ' , name , ' is undefined').
+"
+
+ ^ UndefinedVariable name:name.
+ ^ nil
+ ].
+ (type == #ClassVariable) ifTrue:[
+ ^ Smalltalk at:(selfClass name , ':' , name) asSymbol
+ ].
+ (type == #ClassInstanceVariable) ifTrue:[
+ ^ selfClass instVarAt:index
+ ].
+ (type == #ThisContext) ifTrue:[
+ ^ thisContext
+ ].
+ "not reached"
+ self halt:'bad type'.
+ ^ value
+!
+
+store:aValue
+ (type == #MethodVariable
+ or:[type == #BlockVariable]) ifTrue:[
+ token value:aValue. ^ aValue
+ ].
+ (type == #InstanceVariable) ifTrue:[
+ ^ selfValue instVarAt:index put:aValue
+ ].
+ (type == #GlobalVariable) ifTrue:[
+ ^ Smalltalk at:name put:aValue
+ ].
+ (type == #ClassVariable) ifTrue:[
+ ^ Smalltalk at:(selfClass name , ':' , name) asSymbol put:aValue
+ ].
+ (type == #ClassInstanceVariable) ifTrue:[
+ ^ selfClass instVarAt:index put:aValue
+ ].
+ "not reached"
+ self halt:'bad type'.
+ ^ aValue
+! !
+
!VariableNode methodsFor:'printing'!
displayString
@@ -478,3 +470,12 @@
"not reached"
self halt:'bad type'.
! !
+
+!VariableNode methodsFor:'queries'!
+
+isGlobal
+ "return true, if this is a node for a global variable"
+
+ ^ (type == #GlobalVariable) and:[Smalltalk includesKey:name]
+! !
+
--- a/Variable.st Sat Nov 18 17:59:14 1995 +0100
+++ b/Variable.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
Object subclass:#Variable
- instanceVariableNames:'value name used'
- classVariableNames: ''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'value name used'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!Variable class methodsFor:'documentation'!
@@ -33,14 +33,14 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/Variable.st,v 1.9 1995-11-11 15:31:47 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing variables
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/Variable.st,v 1.10 1995-11-23 02:15:47 cg Exp $'
! !
!Variable class methodsFor:'instance creation'!
@@ -52,10 +52,10 @@
!Variable methodsFor:'accessing'!
-value:v
- "set the value of the (simulated) variable"
+name
+ "return the name of the variable"
- value := v
+ ^ name
!
name:aString
@@ -64,10 +64,16 @@
name := aString
!
-name
- "return the name of the variable"
+used
+ "return the flag marking that this variable has been used"
- ^ name
+ ^ used
+!
+
+used:aBoolean
+ "set/clear the flag marking that this variable has been used"
+
+ used := aBoolean
!
value
@@ -76,20 +82,15 @@
^ value
!
+value:v
+ "set the value of the (simulated) variable"
+
+ value := v
+!
+
variableValue
"return the value of the variable"
^ value
-!
-
-used:aBoolean
- "set/clear the flag marking that this variable has been used"
+! !
- used := aBoolean
-!
-
-used
- "return the flag marking that this variable has been used"
-
- ^ used
-! !
--- a/VariableNode.st Sat Nov 18 17:59:14 1995 +0100
+++ b/VariableNode.st Thu Nov 23 03:15:59 1995 +0100
@@ -11,10 +11,10 @@
"
PrimaryNode subclass:#VariableNode
- instanceVariableNames:'name token selfValue selfClass index block'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Compiler-Support'
+ instanceVariableNames:'name token selfValue selfClass index block'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Compiler-Support'
!
!VariableNode class methodsFor:'documentation'!
@@ -33,26 +33,18 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.12 1995-11-11 15:31:46 cg Exp $'
-!
-
documentation
"
node for parse-trees, representing variables
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.13 1995-11-23 02:15:59 cg Exp $'
! !
!VariableNode class methodsFor:'instance creation'!
-type:t token:tok
- ^ (self basicNew) type:t token:tok
-!
-
-type:t name:n
- ^ (self basicNew) type:t name:n
-!
-
type:t class:class name:n
^ (self basicNew) type:t class:class name:n
!
@@ -61,24 +53,32 @@
^ (self basicNew) type:t index:i selfValue:s
!
-type:t name:n value:val
- ^ (self basicNew) type:t name:n value:val
+type:t name:n
+ ^ (self basicNew) type:t name:n
+!
+
+type:t name:n index:i selfClass:s
+ ^ (self basicNew) type:t name:n index:i selfClass:s
+!
+
+type:t name:n index:i selfValue:s
+ ^ (self basicNew) type:t name:n index:i selfValue:s
!
type:t name:n token:tok index:i
^ (self basicNew) type:t name:n token:tok index:i
!
-type:t name:n index:i selfValue:s
- ^ (self basicNew) type:t name:n index:i selfValue:s
+type:t name:n token:tok index:i block:b
+ ^ (self basicNew) type:t name:n token:tok index:i block:b
!
-type:t name:n index:i selfClass:s
- ^ (self basicNew) type:t name:n index:i selfClass:s
+type:t name:n value:val
+ ^ (self basicNew) type:t name:n value:val
!
-type:t name:n token:tok index:i block:b
- ^ (self basicNew) type:t name:n token:tok index:i block:b
+type:t token:tok
+ ^ (self basicNew) type:t token:tok
!
type:t token:tok index:i
@@ -89,38 +89,21 @@
^ (self basicNew) type:t token:tok index:i block:b
! !
-!VariableNode methodsFor:'queries'!
-
-isGlobal
- "return true, if this is a node for a global variable"
-
- ^ (type == #GlobalVariable) and:[Smalltalk includesKey:name]
-! !
-
!VariableNode methodsFor:'accessing'!
-type:t token:tok
- type := t.
- token := tok
+index
+ ^ index
!
-type:t token:tok index:i
- type := t.
- index := i.
- token := tok
+name
+ ^ name
!
-type:t token:tok index:i block:b
- type := t.
- index := i.
- block := b.
- token := tok
-!
-
-type:t name:n
+type:t class:class name:n
type := t.
value := nil.
- name := n
+ name := n.
+ selfClass := class
!
type:t index:i selfValue:s
@@ -130,24 +113,9 @@
selfValue := s
!
-type:t class:class name:n
+type:t name:n
type := t.
value := nil.
- name := n.
- selfClass := class
-!
-
-type:t name:n value:val
- type := t.
- name := n.
- value := val
-!
-
-type:t name:n index:i selfValue:s
- type := t.
- value := nil.
- index := i.
- selfValue := s.
name := n
!
@@ -159,6 +127,14 @@
name := n
!
+type:t name:n index:i selfValue:s
+ type := t.
+ value := nil.
+ index := i.
+ selfValue := s.
+ name := n
+!
+
type:t name:n token:tok index:i
type := t.
index := i.
@@ -174,70 +150,28 @@
name := n
!
-name
- ^ name
+type:t name:n value:val
+ type := t.
+ name := n.
+ value := val
+!
+
+type:t token:tok
+ type := t.
+ token := tok
!
-index
- ^ index
-! !
-
-!VariableNode methodsFor:'evaluating'!
-
-evaluate
- (type == #MethodVariable
- or:[type == #BlockArg
- or:[type == #BlockVariable]]) ifTrue:[
- ^ token variableValue
- ].
- (type == #InstanceVariable) ifTrue:[
- ^ selfValue instVarAt:index
- ].
- (type == #GlobalVariable) ifTrue:[
- (Smalltalk includesKey:name) ifTrue:[
- ^ Smalltalk at:name
- ].
-"
- self error:('global ' , name , ' is undefined').
-"
-
- ^ UndefinedVariable name:name.
- ^ nil
- ].
- (type == #ClassVariable) ifTrue:[
- ^ Smalltalk at:(selfClass name , ':' , name) asSymbol
- ].
- (type == #ClassInstanceVariable) ifTrue:[
- ^ selfClass instVarAt:index
- ].
- (type == #ThisContext) ifTrue:[
- ^ thisContext
- ].
- "not reached"
- self halt:'bad type'.
- ^ value
+type:t token:tok index:i
+ type := t.
+ index := i.
+ token := tok
!
-store:aValue
- (type == #MethodVariable
- or:[type == #BlockVariable]) ifTrue:[
- token value:aValue. ^ aValue
- ].
- (type == #InstanceVariable) ifTrue:[
- ^ selfValue instVarAt:index put:aValue
- ].
- (type == #GlobalVariable) ifTrue:[
- ^ Smalltalk at:name put:aValue
- ].
- (type == #ClassVariable) ifTrue:[
- ^ Smalltalk at:(selfClass name , ':' , name) asSymbol put:aValue
- ].
- (type == #ClassInstanceVariable) ifTrue:[
- ^ selfClass instVarAt:index put:aValue
- ].
- "not reached"
- self halt:'bad type'.
- ^ aValue
+type:t token:tok index:i block:b
+ type := t.
+ index := i.
+ block := b.
+ token := tok
! !
!VariableNode methodsFor:'code generation'!
@@ -454,6 +388,64 @@
^ self error:'bad assignment'
! !
+!VariableNode methodsFor:'evaluating'!
+
+evaluate
+ (type == #MethodVariable
+ or:[type == #BlockArg
+ or:[type == #BlockVariable]]) ifTrue:[
+ ^ token variableValue
+ ].
+ (type == #InstanceVariable) ifTrue:[
+ ^ selfValue instVarAt:index
+ ].
+ (type == #GlobalVariable) ifTrue:[
+ (Smalltalk includesKey:name) ifTrue:[
+ ^ Smalltalk at:name
+ ].
+"
+ self error:('global ' , name , ' is undefined').
+"
+
+ ^ UndefinedVariable name:name.
+ ^ nil
+ ].
+ (type == #ClassVariable) ifTrue:[
+ ^ Smalltalk at:(selfClass name , ':' , name) asSymbol
+ ].
+ (type == #ClassInstanceVariable) ifTrue:[
+ ^ selfClass instVarAt:index
+ ].
+ (type == #ThisContext) ifTrue:[
+ ^ thisContext
+ ].
+ "not reached"
+ self halt:'bad type'.
+ ^ value
+!
+
+store:aValue
+ (type == #MethodVariable
+ or:[type == #BlockVariable]) ifTrue:[
+ token value:aValue. ^ aValue
+ ].
+ (type == #InstanceVariable) ifTrue:[
+ ^ selfValue instVarAt:index put:aValue
+ ].
+ (type == #GlobalVariable) ifTrue:[
+ ^ Smalltalk at:name put:aValue
+ ].
+ (type == #ClassVariable) ifTrue:[
+ ^ Smalltalk at:(selfClass name , ':' , name) asSymbol put:aValue
+ ].
+ (type == #ClassInstanceVariable) ifTrue:[
+ ^ selfClass instVarAt:index put:aValue
+ ].
+ "not reached"
+ self halt:'bad type'.
+ ^ aValue
+! !
+
!VariableNode methodsFor:'printing'!
displayString
@@ -478,3 +470,12 @@
"not reached"
self halt:'bad type'.
! !
+
+!VariableNode methodsFor:'queries'!
+
+isGlobal
+ "return true, if this is a node for a global variable"
+
+ ^ (type == #GlobalVariable) and:[Smalltalk includesKey:name]
+! !
+