STCompiler repeats evaluation of "receiver" for CascadeNodes

Have a look:

GNU Smalltalk ready

st> PackageLoader fileInPackage: 'Compiler'!
...
st> UndefinedObject compile: 'scTest (1 + 2) negated;
yourself'!
st> (UndefinedObject >> #scTest) inspect!
An instance of CompiledMethod
  header: 64
  Header Flags:
    flags: 0
    primitive index: 0
    number of arguments: 0
    number of temporaries: 0
    number of literals: 0
    needed stack slots: 8
  descriptor: a MethodInfo
  byte codes: [
    [1] push 1
    [3] push 2
        send 1 args message #+
    [5] dup stack top
        send 0 args message #negated
    [7] pop stack top
    [9] push 1
   [11] push 2
        send 1 args message #+
   [13] send 0 args message #yourself
   [15] push self
        return stack top
  ]

I am using 2.3 on GNU/Linux x86.  This does not happen for
the standard
compiler.

-- 
Stephen Compall
http://scompall.no
candysw.com/blog
_______________________________________________
help-smalltalk mailing list
help-smalltalkgnu.org

http://lists.gnu.org/mailman/listinfo/help-smalltalk

Stephen Compall wrote:
> Have a look:

That's a bug.  The attached patch should do the job, but I
have to test 
it a bit more before committing, since I took the occasion
to do some 
simple refactoring.

Paolo
2006-12-29  Paolo Bonzini  <bonzinignu.org>

	* compiler/STCompLit.st: Don't use "nil" slots
from VMSpecialMethods.
	* compiler/STCompiler.st: Remove dupReceiver.  Adjust for
above change.
	Compile receiver in compileTimesRepeat: and compileLoop:,
test for
	receiver being a block in compileWhileLoop:.  Extract part
of
	acceptMessageNode: to compileMessage:.  Compile receiver in
	acceptCascadeNode: and call compileMessage: to avoid
compiling the
	receiver of a cascaded message repeatedly (reported by
Stephen Compall).

--- orig/compiler/STCompLit.st
+++ mod/compiler/STCompLit.st
 -88,10
+88,10  VMOtherConstants at: #VMSpecialIdentifie
     yourself).
     
 VMOtherConstants at: #VMSpecialMethods put:
((IdentityDictionary new: 32)
-    at: #whileTrue		put: nil		 ;
-    at: #whileFalse		put: nil		 ;
-    at: #whileTrue:		put: nil		 ;
-    at: #whileFalse:		put: nil		 ;
+    at: #whileTrue		put: #compileWhileLoop:  ;
+    at: #whileFalse		put: #compileWhileLoop:  ;
+    at: #whileTrue:		put: #compileWhileLoop:  ;
+    at: #whileFalse:		put: #compileWhileLoop:  ;
     at: #timesRepeat:		put: #compileTimesRepeat:;
     at: #to:do:			put: #compileLoop:	 ;
     at: #to:by:do:		put: #compileLoop:	 ;


--- orig/compiler/STCompiler.st
+++ mod/compiler/STCompiler.st
 -55,7
+55,7  compile: methodDefNode for: aBehavior cl
 ! !
 
 STFakeCompiler subclass: #STCompiler
-       instanceVariableNames: 'node destClass symTable
parser bytecodes depth maxDepth isInsideBlock dupReceiver'
+       instanceVariableNames: 'node destClass symTable
parser bytecodes depth maxDepth isInsideBlock '
        classVariableNames: 'OneNode TrueNode FalseNode
NilNode SuperVariable SelfVariable ThisContextVariable
DoitToken'
        poolDictionaries: ''
        category: 'System-Compiler'
 -162,7
+162,6  class: aBehavior parser: aParser
     symTable := STSymbolTable new.
     parser := aParser.
     bytecodes := WriteStream on: (ByteArray new: 240).
-    dupReceiver := false.
     isInsideBlock := 0.
 
     symTable declareEnvironment: aBehavior.
 -560,18
+559,18  acceptCascadeNode: aNode
 	^aNode
     ].
 
-    dupReceiver := true.
-    first acceptVisitor: self.
+    first receiver acceptVisitor: self.
+    self depthIncr; compileByte: DupStackTop.
+    self compileMessage: first.
 
     messages
 	from: 2 to: messages size - 1
 	do: [ :each |
 	    self compileByte: PopStackTop; compileByte:
DupStackTop.
-	    each acceptVisitor: self ].
+	    self compileMessage: each ].
 
-    self compileByte: PopStackTop.
-    self depthDecr: 1.
-    (messages at: messages size) acceptVisitor: self.
+    self depthDecr: 1; compileByte: PopStackTop.
+    self compileMessage: messages last.
 ! !
 
 "-----------------------------------------------------
---------------"
 -619,29
+618,26  acceptAssignmentNode: aNode
 acceptMessageNode: aNode
     "RBMessageNode contains a message send. Its
instance variable are
      a receiver, selector, and arguments."
-    | dup specialSelector args litIndex |
+    | specialSelector |
 
-    dup := dupReceiver. dupReceiver := false.
- 
     aNode receiver = SuperVariable ifTrue: [
 	self compileSendToSuper: aNode.
 	^true
     ].
 
-    (VMSpecialMethods includesKey: aNode selector) ifTrue:
[
-	specialSelector := VMSpecialMethods at: aNode selector.
-	(specialSelector isNil and: [aNode receiver isBlock and: [
dup not ]])
-	    ifTrue: [
-		(self compileWhileLoop: aNode) ifTrue: [^false]
-	    ]
-	].
+    specialSelector := VMSpecialMethods at: aNode selector
ifAbsent: [ nil ].
+    specialSelector isNil ifFalse: [
+	(self perform: specialSelector with: aNode) ifTrue: [
^false ] ].
 
     aNode receiver acceptVisitor: self.
-    dup ifTrue: [ self depthIncr; compileByte: DupStackTop
].
-    specialSelector isNil ifFalse: [
-	(self perform: specialSelector with: aNode) ifTrue:
[^false]
-    ].
+    self compileMessage: aNode
+!
 
+compileMessage: aNode
+    "RBMessageNode contains a message send. Its
instance variable are
+     a receiver, selector, and arguments.  The receiver has
already
+     been compiled."
+    | args litIndex |
     aNode arguments do: [ :each | each acceptVisitor: self
].
 
     VMSpecialSelectors at: aNode selector ifPresent: [ :idx
|
 -662,6
+658,7  compileWhileLoop: aNode
 
     | whileBytecodes argBytecodes jumpOffsets |
 
+    aNode receiver isBlock ifFalse: [ ^false ].
     (aNode receiver arguments isEmpty and: [
 	aNode receiver body temporaries isEmpty ]) ifFalse: [
^false ].
 
 -731,6
+728,7  compileSendToSuper: aNode
 
 compileTimesRepeat: aNode
     | block |
+    aNode receiver acceptVisitor: self.
     block := aNode arguments first.
     (block arguments isEmpty and: [
 	block body temporaries isEmpty ]) ifFalse: [ ^false ].
 -740,6
+738,7  compileTimesRepeat: aNode
 
 compileLoop: aNode
     | stop step block |
+    aNode receiver acceptVisitor: self.
     aNode arguments do: [ :each |
 	stop := step.			"to:"
 	step := block.			"by:"
 -757,6
+756,7  compileLoop: aNode
 
 compileBoolean: aNode
     | bc1 ret1 bc2 selector |
+    aNode receiver acceptVisitor: self.
     aNode arguments do: [ :each |
         (each arguments isEmpty and: [
 	    each body temporaries isEmpty ]) ifFalse: [ ^false ].



_______________________________________________
help-smalltalk mailing list
help-smalltalkgnu.org

http://lists.gnu.org/mailman/listinfo/help-smalltalk