Misc improvements 10

pharo/GNUmakefile

@@ -76,7 +76,6 @@ $(PROJECT).image: ../src/*/*.st
 	$(call pharo-load-local, $@, SmallRSP,         $(SMALLRSP_DIR)/src)
 	$(call pharo-load-local, $@, LibUnix,          $(PHARO_HACKS_DIR)/src)
 	$(call pharo-load-local, $@, LibCompat,        $(PHARO_HACKS_DIR)/src)
-	$(call pharo-load-local, $@, LibUnix,          $(PHARO_HACKS_DIR)/src)
 	$(call pharo-load-local, $@, PTerm,            $(PTERM_DIR))
 	$(call pharo-load-local, $@, LibGDBs,          $(LIBGDBS_DIR)/ports/pharo/src-generated)
 	$(call pharo-load-local, $@, Tinyrossa,        ../src)

src/Tinyrossa-Tests/TRCompilationTestCase.class.st

@@ -11,6 +11,14 @@ Class {
 	#category : #'Tinyrossa-Tests'
 }
 
+{ #category : #accessing }
+TRCompilationTestCase class >> compiler [
+	Smalltalk isPharo ifTrue:[
+		^super compiler options: #(+ optionSkipSemanticWarnings)
+	].
+	^super compiler
+]
+
 { #category : #testing }
 TRCompilationTestCase class >> isAbstract [
 	^ self == TRCompilationTestCase

src/Tinyrossa-Tests/TRCompilationTestShellRemoteUsingSSH.class.st

@@ -22,13 +22,20 @@ TRCompilationTestShellRemoteUsingSSH >> setUp [
 	| scpCmd |
 	super setUp.
 
-	scpCmd := 'scp ' , debugger pathName , ' ' , self class host , ':/tmp'.
+	scpCmd := 'scp ' , binary pathName , ' ' , self class host , ':/tmp'.
 
 
-	self assert: (OperatingSystem executeCommand: scpCmd)
+	self assert: (OSProcess new command: scpCmd) execute
 		 description: 'Cannot upload shell'.
 
-	target := GDBDebugger new.
-	target executable: debugger.
-	target send: 'target extended-remote | ssh -C ', self class host , ' gdbserver - /tmp/' , debugger baseName.
+	(Smalltalk includesKey: #GDBDebugger) ifTrue:[
+		"Use LibGDBs if available..."
+
+		debugger := (Smalltalk at: #GDBDebugger) new.
+		debugger executable: binary.
+		target send: 'target extended-remote | ssh -C ', self class host , ' gdbserver - /tmp/' , binary baseName.
+		^self
+	] ifFalse:[
+		self error: 'This shell require libgdbs'
+	].
 ]

src/Tinyrossa-Tests/TRILXmul2XshlTests.class.st

@@ -0,0 +1,51 @@
+Class {
+	#name : #TRILXmul2XshlTests,
+	#superclass : #TRILTestCase,
+	#pools : [
+		'TRDataTypes',
+		'TRILOpcodes'
+	],
+	#category : #'Tinyrossa-Tests'
+}
+
+{ #category : #running }
+TRILXmul2XshlTests >> setUp [
+	super setUp.
+	compilation config optimizationPasses: { TRILXmul2Xshl }.
+]
+
+{ #category : #tests }
+TRILXmul2XshlTests >> test_imul2ishl_01 [
+	| b |
+
+	b := TRILFunctionBuilder forCompilation: compilation.
+	b defineName: testSelector type: Int32.
+	b defineParameter: 'x' type: Int32.
+	b ireturn: {
+		b imul: {
+			b iload: 'x' .
+			b iconst: 2  } }.
+
+	compilation optimize.
+
+	self assert: compilation cfg treetops second child1 opcode = ishl.
+	self assert: compilation cfg treetops second child1 child2 constant = 1.
+]
+
+{ #category : #tests }
+TRILXmul2XshlTests >> test_imul2ishl_02 [
+	| b |
+
+	b := TRILFunctionBuilder forCompilation: compilation.
+	b defineName: testSelector type: Int32.
+	b defineParameter: 'x' type: Int32.
+	b ireturn: {
+		b imul: {
+			b iload: 'x' .
+			b iconst: 3  } }.
+
+	compilation optimize.
+
+	self assert: compilation cfg treetops second child1 opcode = imul.
+	self assert: compilation cfg treetops second child1 child2 constant = 3.
+]

src/Tinyrossa/TRCodeGenerator.class.st

@@ -1,11 +1,9 @@
 Class {
 	#name : #TRCodeGenerator,
-	#superclass : #Object,
+	#superclass : #TRCodeGeneratorBase,
 	#instVars : [
-		'compilation',
 		'virtualRegisters',
 		'linkage',
-		'evaluator',
 		'generate',
 		'linkRegisterKilled'
 	],
@@ -15,16 +13,6 @@ Class {
 	#category : #'Tinyrossa-Codegen'
 }
 
-{ #category : #'instance creation' }
-TRCodeGenerator class >> forCompilation: aTRCompilation [
-	^ self basicNew initializeWithCompilation: aTRCompilation
-]
-
-{ #category : #'instance creation' }
-TRCodeGenerator class >> new [
-	self shouldNotImplement. "Use #forCompilation:"
-]
-
 { #category : #registers }
 TRCodeGenerator >> allocateRegister [
 	^ self allocateRegister: GPR
@@ -62,21 +50,11 @@ TRCodeGenerator >> codeBuffer [
 	^ generate memory
 ]
 
-{ #category : #accessing }
-TRCodeGenerator >> compilation [
-	^ compilation
-]
-
 { #category : #'instance creation' }
 TRCodeGenerator >> createAssembler [
 	^ self assemblerClass new
 ]
 
-{ #category : #'instance creation' }
-TRCodeGenerator >> createEvaluator [
-	^ self evaluatorClass forCodeGenerator: self
-]
-
 { #category : #'instance creation' }
 TRCodeGenerator >> createLinkage: linkageClass [
 	^ linkageClass forCodeGenerator: self
@@ -92,16 +70,6 @@ TRCodeGenerator >> cursor: anInteger [
 	generate cursor: anInteger
 ]
 
-{ #category : #accessing }
-TRCodeGenerator >> evaluator [
-	^ evaluator
-]
-
-{ #category : #'accessing - config' }
-TRCodeGenerator >> evaluatorClass [
-	^ self subclassResponsibility
-]
-
 { #category : #'code gen-phases' }
 TRCodeGenerator >> fixupBranches [
 	compilation isAOT ifTrue: [
@@ -237,7 +205,7 @@ TRCodeGenerator >> generatePrologue [
 
 { #category : #initialization }
 TRCodeGenerator >> initializeWithCompilation: aTRCompilation [ 
-	compilation := aTRCompilation.
+	super initializeWithCompilation: aTRCompilation.
 	virtualRegisters := Dictionary new.
 	generate := self createAssembler.
 	evaluator := self createEvaluator.

src/Tinyrossa/TRCodeGeneratorBase.class.st

@@ -0,0 +1,47 @@
+Class {
+	#name : #TRCodeGeneratorBase,
+	#superclass : #Object,
+	#instVars : [
+		'compilation',
+		'evaluator'
+	],
+	#pools : [
+		'TRRegisterKinds'
+	],
+	#category : #'Tinyrossa-Codegen'
+}
+
+{ #category : #'instance creation' }
+TRCodeGeneratorBase class >> forCompilation: aTRCompilation [
+	^ self basicNew initializeWithCompilation: aTRCompilation
+]
+
+{ #category : #'instance creation' }
+TRCodeGeneratorBase class >> new [
+	self shouldNotImplement. "Use #forCompilation:"
+]
+
+{ #category : #accessing }
+TRCodeGeneratorBase >> compilation [
+	^ compilation
+]
+
+{ #category : #'instance creation' }
+TRCodeGeneratorBase >> createEvaluator [
+	^ self evaluatorClass forCodeGenerator: self
+]
+
+{ #category : #accessing }
+TRCodeGeneratorBase >> evaluator [
+	^ evaluator
+]
+
+{ #category : #'accessing - config' }
+TRCodeGeneratorBase >> evaluatorClass [
+	^ self subclassResponsibility
+]
+
+{ #category : #initialization }
+TRCodeGeneratorBase >> initializeWithCompilation: aTRCompilation [
+	compilation := aTRCompilation.
+]

src/Tinyrossa/TRCompilationExamples.class.st

@@ -13,6 +13,14 @@ Class {
 	#category : #'Tinyrossa-Compile-Examples'
 }
 
+{ #category : #accessing }
+TRCompilationExamples class >> compiler [
+	Smalltalk isPharo ifTrue:[
+		^super compiler options: #(+ optionSkipSemanticWarnings)
+	].
+	^super compiler
+]
+
 { #category : #accessing }
 TRCompilationExamples class >> testSelectors [
 	^ self selectors select: [ :each | each beginsWith:'example' ]

src/Tinyrossa/TRILOpcode.class.st

@@ -234,6 +234,21 @@ TRILOpcode >> isReturn [
 	^ props1 anyMask: Return
 ]
 
+{ #category : #testing }
+TRILOpcode >> isShift [
+	^ props1 anyMask: LeftShift | RightShift
+]
+
+{ #category : #testing }
+TRILOpcode >> isShiftLeft [
+	^ props1 anyMask: LeftShift
+]
+
+{ #category : #testing }
+TRILOpcode >> isShiftRight [
+	^ props1 anyMask: RightShift
+]
+
 { #category : #testing }
 TRILOpcode >> isStore [
 	^ props1 anyMask: Store

src/Tinyrossa/TRILOpcodeTables.class.st

@@ -6,6 +6,7 @@ Class {
 		'CompareOpcodes',
 		'ConstOpcodes',
 		'LoadOpcodes',
+		'ShiftLeftOpcodes',
 		'StoreOpcodes'
 	],
 	#pools : [
@@ -189,4 +190,15 @@ TRILOpcodeTables class >> initialize [
 					Rem  . invalid .
 				  }.
 	}.
+
+	ShiftLeftOpcodes := SmallDictionary newFromPairs: {
+		Int8    . bshl .
+		Int16   . sshl .
+		Int32   . ishl .
+		Int64   . lshl .
+		Address . invalid .
+		Float   . invalid .
+		Double  . invalid .
+		Void    . invalid .
+	}.
 ]

src/Tinyrossa/TRILXmul2Xshl.class.st

@@ -0,0 +1,23 @@
+Class {
+	#name : #TRILXmul2Xshl,
+	#superclass : #TRILRewritingPass,
+	#pools : [
+		'TRILOpcodes'
+	],
+	#category : #'Tinyrossa-Optimizer'
+}
+
+{ #category : #rewriting }
+TRILXmul2Xshl >> rewrite: node [
+	node opcode isMul ifFalse:[ ^ node ].
+	node opcode type isIntegerType ifFalse:[ ^ node ].
+	node child2 opcode isLoadConst ifFalse: [ ^ node ].
+	node child2 constant isPowerOfTwo ifFalse: [ ^ node ].
+
+	^TRILNode opcode: ishl children:
+		{ node child1 .
+		  TRILNode opcode: iconst constant: (node child2 constant log:2) asInteger }
+
+
+
+]