[Help-smalltalk] Re: STCompiler repeats evaluation of "receiver" for CascadeNodes

[Paolo Bonzini]

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  <address@hidden>

        * 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 ].