MessageNode.st
changeset 1045 ee448a958d19
parent 1035 8848672cb893
child 1046 8e5818442eb9
--- a/MessageNode.st	Sat Jun 17 19:20:22 2000 +0200
+++ b/MessageNode.st	Sat Jun 17 19:52:51 2000 +0200
@@ -10,6 +10,8 @@
  hereby transferred.
 "
 
+"{ Package: 'stx:libcomp' }"
+
 ParseNode subclass:#MessageNode
 	instanceVariableNames:'receiver selector argArray lineNr selectorPosition'
 	classVariableNames:''
@@ -1170,7 +1172,9 @@
 
 codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
     |recType nargs isBuiltIn litIndex cls clsLitIndex code isSpecial
-     specialCode stackTop arg1 arg2 arg3 isSuper realReceiver|
+     specialCode stackTop arg1 arg2 arg3 isSuper realReceiver noSendDrop|
+
+    noSendDrop := NewCodeSet == true.
 
     realReceiver := self realReceiver.
     isSuper := realReceiver isSuper.
@@ -1439,7 +1443,7 @@
         (nargs <= 3) ifTrue:[
             |codes|
 
-            valueNeeded ifTrue:[
+            (noSendDrop or:[valueNeeded]) ifTrue:[
                 (recType == #Self) ifTrue:[
                     codes := #(sendSelf0 sendSelf1 sendSelf2 sendSelf3)
                 ] ifFalse:[
@@ -1453,13 +1457,16 @@
                 ]
             ].
             aStream nextPut:(codes at:(nargs + 1)); nextPut:lineNr; nextPut:litIndex.
+            (valueNeeded not and:[noSendDrop]) ifTrue:[
+                aStream nextPut:#drop
+            ].
             ^ self
         ].
 
         (recType == #Self) ifTrue:[
             code := #sendSelf
         ] ifFalse:[
-            valueNeeded ifTrue:[
+            (noSendDrop or:[valueNeeded]) ifTrue:[
                 code := #send
             ] ifFalse:[
                 code := #sendDrop
@@ -1467,9 +1474,9 @@
         ].
         aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
         valueNeeded ifFalse:[
-            (recType == #Self) ifTrue:[
+            (noSendDrop or:[recType == #Self]) ifTrue:[
                 aStream nextPut:#drop
-            ]
+            ].
         ].
         ^ self
     ].
@@ -1734,8 +1741,9 @@
     "like code on, but assumes that receiver has already been
      coded onto stack - needed for cascade"
 
-    |nargs isBuiltIn code codeL litIndex cls clsLitIndex isSuper realReceiver|
-
+    |nargs isBuiltIn code codeL litIndex cls clsLitIndex isSuper realReceiver noSendDrop|
+
+    noSendDrop := NewCodeSet == true.
     selector := selector asSymbol.
 
     realReceiver := self realReceiver.
@@ -1823,30 +1831,39 @@
     litIndex := aCompiler addLiteral:selector.
     litIndex <= 255 ifTrue:[
         (nargs <= 3) ifTrue:[
-            valueNeeded ifTrue:[
+            (noSendDrop or:[valueNeeded]) ifTrue:[
                 code := #(send0 send1 send2 send3) at:(nargs+1).
             ] ifFalse:[
                 code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
             ].
             aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
+            (valueNeeded not and:[noSendDrop]) ifTrue:[
+                aStream nextPut:#drop
+            ].
             ^ self
         ].
 
-        valueNeeded ifTrue:[
+        (noSendDrop or:[valueNeeded]) ifTrue:[
             code := #send
         ] ifFalse:[
             code := #sendDrop
         ].
         aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
+        (valueNeeded not and:[noSendDrop]) ifTrue:[
+            aStream nextPut:#drop
+        ].
         ^ self
     ].
 
-    valueNeeded ifTrue:[
+    (noSendDrop or:[valueNeeded]) ifTrue:[
         code := #sendL
     ] ifFalse:[
         code := #sendDropL
     ].
-    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs.
+    (valueNeeded not and:[noSendDrop]) ifTrue:[
+        aStream nextPut:#drop
+    ].
 
     "Modified: / 16.7.1998 / 20:26:52 / cg"
 !
@@ -2812,5 +2829,5 @@
 !MessageNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.109 2000-02-12 15:32:56 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.110 2000-06-17 17:52:51 cg Exp $'
 ! !