Mercurial Mercurial > hg > stx-libcomp / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | zip | gz | bz2 | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
newCode (for rel5)
authorClaus Gittinger <cg@exept.de>
Mon, 19 Jun 2000 14:03:02 +0200
changeset 1046 8e5818442eb9
parent 1045 ee448a958d19
child 1047 d0b95ceaffe3
newCode (for rel5)
AssignmentNode.st file | annotate | diff | comparison | revisions
ByteCodeCompiler.st file | annotate | diff | comparison | revisions
MessageNode.st file | annotate | diff | comparison | revisions
ParseNode.st file | annotate | diff | comparison | revisions
PrimitiveNode.st file | annotate | diff | comparison | revisions 
--- a/AssignmentNode.st	Sat Jun 17 19:52:51 2000 +0200
+++ b/AssignmentNode.st	Mon Jun 19 14:03:02 2000 +0200
@@ -10,6 +10,8 @@
  hereby transferred.
 "
 
+"{ Package: 'stx:libcomp' }"
+
 ParseNode subclass:#AssignmentNode
 	instanceVariableNames:'variable expression lineNr'
 	classVariableNames:''
@@ -161,10 +163,11 @@
 
         selLitIdx := aCompiler addLiteral:#value:.
         selLitIdx <= 255 ifTrue:[
-            aStream nextPut:#sendDrop1; nextPut:(lineNr ? 1); nextPut:selLitIdx.
+            aStream nextPut:#send1; nextPut:(lineNr ? 1); nextPut:selLitIdx.
         ] ifFalse:[
-            aStream nextPut:#sendDropL; nextPut:(lineNr ? 1); nextPut:selLitIdx; nextPut:0; nextPut:1 "nargs".
+            aStream nextPut:#sendL; nextPut:(lineNr ? 1); nextPut:selLitIdx; nextPut:0; nextPut:1 "nargs".
         ].
+        aStream nextPut:#drop.
 
         forValue ifTrue:[
             (expression isConstant or:[expression isVariable]) ifTrue:[
@@ -257,5 +260,5 @@
 !AssignmentNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/AssignmentNode.st,v 1.31 2000-02-12 15:33:54 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/AssignmentNode.st,v 1.32 2000-06-19 12:00:53 cg Exp $'
 ! !
--- a/ByteCodeCompiler.st	Sat Jun 17 19:52:51 2000 +0200
+++ b/ByteCodeCompiler.st	Mon Jun 19 14:03:02 2000 +0200
@@ -10,6 +10,8 @@
  hereby transferred.
 "
 
+"{ Package: 'stx:libcomp' }"
+
 Parser subclass:#ByteCodeCompiler
 	instanceVariableNames:'codeBytes codeIndex litArray stackDelta extra lineno extraLiteral
 		maxStackDepth relocList methodTempVars numTemp maxNumTemp'
@@ -17,7 +19,7 @@
 		STCCompilationIncludes STCCompilationOptions STCCompilation
 		ShareCode STCKeepSTIntermediate STCKeepCIntermediate
 		STCModulePath CCCompilationOptions CC STC ListCompiledMethods
-		STCKeepOIntermediate Verbose'
+		STCKeepOIntermediate Verbose NewCodeSet'
 	poolDictionaries:''
 	category:'System-Compiler'
 !
@@ -436,6 +438,7 @@
 !ByteCodeCompiler class methodsFor:'initialization'!
 
 initialize
+    NewCodeSet := false.
     ShareCode := true.
     STCKeepCIntermediate := false.
     STCKeepOIntermediate := false.
@@ -450,6 +453,19 @@
    "
 
     "Modified: / 21.10.1998 / 15:39:52 / cg"
+!
+
+newCodeSet
+    ^ NewCodeSet 
+
+!
+
+newCodeSet:aBoolean
+    NewCodeSet := aBoolean.
+
+    "
+     ByteCodeCompiler newCodeSet:true
+    "
 ! !
 
 !ByteCodeCompiler class methodsFor:'compiling methods'!
@@ -683,7 +699,8 @@
         ((compiler hasNonOptionalPrimitiveCode 
         or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])
         or:[STCCompilation == #always and:[sel ~~ #doIt]]])
-        and:[STCCompilation ~~ #never]) ifTrue:[
+        and:[(STCCompilation ~~ #never)
+        and:[NewCodeSet ~~ true]]) ifTrue:[
             newMethod := compiler 
                             compileToMachineCode:aString 
                             forClass:aClass 
@@ -754,16 +771,21 @@
     ].
 
     compiler hasNonOptionalPrimitiveCode ifTrue:[
-        newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
-        install ifTrue:[
-            aClass addSelector:sel withMethod:newMethod.
+        "/
+        "/ generate a trapping method, if primitive code is present
+        "/
+        NewCodeSet ~~ true ifTrue:[
+            newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
+            install ifTrue:[
+                aClass addSelector:sel withMethod:newMethod.
+            ].
+            Transcript show:'*** '.
+            sel notNil ifTrue:[
+                Transcript show:(sel ,' ')
+            ].
+            Transcript showCR:'not compiled to machine code - created a stub instead.'.
+            ^ newMethod
         ].
-        Transcript show:'*** '.
-        sel notNil ifTrue:[
-            Transcript show:(sel ,' ')
-        ].
-        Transcript showCR:'not compiled to machine code - created a stub instead.'.
-        ^ newMethod
     ].
 
     "
@@ -3645,6 +3667,6 @@
 !ByteCodeCompiler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.164 2000-02-05 13:35:26 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.165 2000-06-19 12:02:38 cg Exp $'
 ! !
 ByteCodeCompiler initialize!
--- a/MessageNode.st	Sat Jun 17 19:52:51 2000 +0200
+++ b/MessageNode.st	Mon Jun 19 14:03:02 2000 +0200
@@ -779,16 +779,32 @@
 
     litIndex <= 255 ifTrue:[
         (nargs <= 3) ifTrue:[
-            code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
-            aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
+            ByteCodeCompiler newCodeSet ifTrue:[
+                code := #(send0 send1 send2 send3) at:(nargs+1).
+                aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
+                aStream nextPut:#drop.
+            ] ifFalse:[
+                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.
+        ByteCodeCompiler newCodeSet ifTrue:[
+            aStream nextPut:#send; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
+            aStream nextPut:#drop.
+        ] ifFalse:[
+            aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
+        ].
         ^ self
     ].
     "need 16bit litIndex"
-    aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+    ByteCodeCompiler newCodeSet ifTrue:[
+        aStream nextPut:#sendL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs.
+        aStream nextPut:#drop.
+    ] ifFalse:[
+        aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
+    ].
 
     "Modified: / 4.7.1999 / 19:06:53 / cg"
 !
@@ -1174,7 +1190,7 @@
     |recType nargs isBuiltIn litIndex cls clsLitIndex code isSpecial
      specialCode stackTop arg1 arg2 arg3 isSuper realReceiver noSendDrop|
 
-    noSendDrop := NewCodeSet == true.
+    noSendDrop := ByteCodeCompiler newCodeSet == true.
 
     realReceiver := self realReceiver.
     isSuper := realReceiver isSuper.
@@ -1743,7 +1759,7 @@
 
     |nargs isBuiltIn code codeL litIndex cls clsLitIndex isSuper realReceiver noSendDrop|
 
-    noSendDrop := NewCodeSet == true.
+    noSendDrop := ByteCodeCompiler newCodeSet == true.
     selector := selector asSymbol.
 
     realReceiver := self realReceiver.
@@ -2829,5 +2845,5 @@
 !MessageNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.110 2000-06-17 17:52:51 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.111 2000-06-19 12:01:35 cg Exp $'
 ! !
--- a/ParseNode.st	Sat Jun 17 19:52:51 2000 +0200
+++ b/ParseNode.st	Mon Jun 19 14:03:02 2000 +0200
@@ -14,7 +14,7 @@
 
 Object subclass:#ParseNode
 	instanceVariableNames:'type comments parenthized'
-	classVariableNames:'NewCodeSet'
+	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Compiler-Support'
 !
@@ -267,5 +267,5 @@
 !ParseNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/ParseNode.st,v 1.28 2000-06-17 17:20:22 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/ParseNode.st,v 1.29 2000-06-19 12:03:02 cg Exp $'
 ! !
--- a/PrimitiveNode.st	Sat Jun 17 19:52:51 2000 +0200
+++ b/PrimitiveNode.st	Mon Jun 19 14:03:02 2000 +0200
@@ -10,6 +10,8 @@
  hereby transferred.
 "
 
+"{ Package: 'stx:libcomp' }"
+
 StatementNode subclass:#PrimitiveNode
 	instanceVariableNames:'code primNumber optional'
 	classVariableNames:''
@@ -100,6 +102,7 @@
     "catch code generation"
 
     optional ifTrue:[^ self].
+    aCompiler class newCodeSet == true ifTrue:[^ self].
     self error:'cannot compile primitives (as yet)' mayProceed:true
 !
 
@@ -107,6 +110,7 @@
     "catch code generation"
 
     optional ifTrue:[^ self].
+    ByteCodeCompiler newCodeSet == true ifTrue:[^ self].
     self error:'cannot compile primitives (as yet)' mayProceed:true
 ! !
 
@@ -139,5 +143,5 @@
 !PrimitiveNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/PrimitiveNode.st,v 1.17 2000-02-12 15:32:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/PrimitiveNode.st,v 1.18 2000-06-19 12:02:09 cg Exp $'
 ! !
hg/stx-libcomp