compiler/PPCCompiler.st
changeset 459 4751c407bb40
parent 452 9f4558b3be66
child 460 87a3d30ab570
child 464 f6d77fee9811
--- a/compiler/PPCCompiler.st	Sun May 10 06:28:36 2015 +0100
+++ b/compiler/PPCCompiler.st	Tue May 12 01:24:03 2015 +0100
@@ -48,6 +48,10 @@
     ^ compiledParserSuperclass ifNil: [ PPCompiledParser ]
 !
 
+currentMethod
+    ^ currentMethod 
+!
+
 currentNonInlineMethod
     ^ compilerStack 
         detect:[:m | m isInline not ] 
@@ -82,13 +86,16 @@
 cleanGeneratedMethods: class
     ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
         class methodsDo: [ :mthd |
-            mthd category = #generated ifTrue:[
+            (mthd category beginsWith: 'generated') ifTrue:[
                 class removeSelector: mthd selector.
             ]
         ]
     ] ifFalse: [ 
-        (class allSelectorsInProtocol: #generated) do: [ :selector | 
-            class removeSelectorSilently: selector ].
+        (class allProtocolsUpTo: class) do: [ :protocol |
+            (protocol beginsWith: 'generated') ifTrue: [ 
+                class removeProtocol: protocol.
+            ]
+        ]
     ]
 !
 
@@ -171,9 +178,9 @@
     (variable == #whatever) ifFalse: [ 
         "Do not assign, if somebody does not care!!"
         self add: variable ,' := ', code.
- 	] ifTrue: [ 
+ 		] ifTrue: [ 
         "In case code hava a side effect"
- 		self add: code	
+ 				self add: code	
     ]
 !
 
@@ -190,9 +197,13 @@
 !
 
 codeHaltIfShiftPressed
-    arguments debug ifTrue: [ 
-        self add: 'Halt ifShiftPressed.'
+    arguments debug ifTrue: [
+        ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[  
+            self add: 'Halt ifShiftPressed.'
+        ]
     ]
+
+    "Modified: / 10-05-2015 / 07:39:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 codeNextToken
@@ -204,13 +215,13 @@
 
 codeReturn
    currentMethod isInline ifTrue: [
-		"If inlined, the return variable already holds the value"
-	] ifFalse: [
-		self add: '^ ', currentMethod returnVariable  
+				"If inlined, the return variable already holds the value"
+		] ifFalse: [
+				self add: '^ ', currentMethod returnVariable  
    ].
 
-    "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 codeReturn: code
@@ -260,10 +271,17 @@
     "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
     
     | toUse |
- 	toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+
+    toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
     (toUse isEmpty or: [ toUse first isLetter not ])
         ifTrue: [ toUse := 'v', toUse ].
-    ^ toUse uncapitalized asSymbol.
+    toUse first isUppercase ifFalse:[
+        toUse := toUse copy.
+        toUse at: 1 put: toUse first asLowercase
+    ].
+    ^toUse
+
+    "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 idFor: object
@@ -379,10 +397,10 @@
 stopMethod
     self cache: currentMethod methodName as: currentMethod.
     
-    arguments profile ifTrue: [ Transcript crShow: currentMethod code ].
+    arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ].
     ^ self pop.
 
-    "Modified: / 23-04-2015 / 18:36:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-05-2015 / 14:18:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 top
@@ -431,7 +449,7 @@
 
 installMethods
     cache keysAndValuesDo: [ :key :method |
-        compiledParser compileSilently: method code classified: 'generated'.
+        compiledParser compileSilently: method code classified: method category.
     ]
 !