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.nocandysw.com/blog

_______________________________________________
help-smalltalk mailing list
[hidden email]
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  <[hidden email]>

        * 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
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk