Merge pull request #54 from janvrany/pr/misc-improvements-11

Misc improvements 11

src/Tinyrossa-Tests/TRCompilationTestCase.class.st

@@ -69,7 +69,8 @@ TRCompilationTestCase >> setUp [
 
 	compilation := TRCompilation forTarget: target.
 	compilation config stressRA: (testParameters at: #stressRA).
-	shell := TRCompilationTestShell forCompilation: compilation.
+
+	shell := TRCompilationTestShell forTarget: target.
 ]
 
 { #category : #accessing }
@@ -200,7 +201,7 @@ TRCompilationTestCase >> test01_bytecode_abs [
 
 	compilation compile.
 
-	self assert: (shell call: 2) equals: 2 abs.
+	self assert: (shell inject: compilation andInvokeWith: { 2 }) equals: 2 abs.
 ]
 
 { #category : #tests }
@@ -218,7 +219,7 @@ TRCompilationTestCase >> test02_iconst [
 	compilation optimize.
 	compilation compile.
 
-	self assert: (shell call) equals: x.
+	self assert: (shell inject: compilation andInvokeWith: #()) equals: x.
 
 	"
 	 TRRV64GCompilationTests debug: #test02_iconst_p
@@ -244,7 +245,7 @@ TRCompilationTestCase >> test03_lconst [
 	compilation optimize.
 	compilation compile.
 
-	self assert: (shell call) equals: x.
+	self assert: (shell inject: compilation andInvokeWith: #()) equals: x.
 
 	"
 	TRRV64GCompilationTests debug: #test03_lconst_n 
@@ -273,7 +274,7 @@ TRCompilationTestCase >> test06_iadd_discarding_value [
 	compilation optimize.
 	compilation compile.
 
-	self assert: (shell call: x ) equals: -1.
+	self assert: (shell inject: compilation andInvokeWith: { x }) equals: -1.
 
 	"
 	TRRV64GCompilationTests debug: #test06_iadd_discarding_value
@@ -316,7 +317,7 @@ TRCompilationTestCase >> test07_call_discarding_value [
 	compilation compile.
 
 
-	self assert: (shell call: x) equals: ((x == 0) ifTrue:[ -1 ] ifFalse:[ x ]).
+	self assert: (shell inject: compilation andInvokeWith: {x }) equals: ((x == 0) ifTrue:[ -1 ] ifFalse:[ x ]).
 
 	"
 	TRRV64GCompilationTests debug: #test07_call_discarding_value
@@ -330,7 +331,7 @@ TRCompilationTestCase >> test_example01_meaningOfLife [
 		compilation: compilation;
 		example01_meaningOfLife.
 
-	self assert: (shell call) equals: 42.
+	self assert: (shell inject: compilation andInvokeWith: #()) equals: 42.
 ]
 
 { #category : #'tests - examples' }
@@ -339,7 +340,7 @@ TRCompilationTestCase >> test_example03_signum [
 		compilation: compilation;
 		example03_signum.
 
-	self assert: (shell call:-5) equals: -5 sign.
+	self assert: (shell inject: compilation andInvokeWith: { -5 }) equals: -5 sign.
 ]
 
 { #category : #'tests - examples' }
@@ -348,7 +349,7 @@ TRCompilationTestCase >> test_example04_factorial_i [
 		compilation: compilation;
 		example04_factorial_i.
 
-	self assert: (shell call:5) equals: 5 factorial.
+	self assert: (shell inject: compilation andInvokeWith: { 5 }) equals: 5 factorial.
 ]
 
 { #category : #'tests - examples' }
@@ -360,15 +361,15 @@ TRCompilationTestCase >> test_example05_factorial_r [
 		compilation: compilation;
 		example05_factorial_r.
 
-	self assert: (shell call:5) equals:  5 factorial.
+	self assert: (shell inject: compilation andInvokeWith: { 5 }) equals:  5 factorial.
 ]
 
 { #category : #'tests - examples' }
 TRCompilationTestCase >> test_example08_bytecode_compiler [
 	TRCompilationExamples new
 		compilation: compilation;
 		example08_bytecode_compiler.
-	self assert: (shell call:2) equals: 2 factorial.
+	self assert: (shell inject: compilation andInvokeWith: { 2 }) equals: 2 factorial.
 ]
 
 { #category : #'tests - examples' }
@@ -381,7 +382,7 @@ TRCompilationTestCase >> test_example09_signum_2 [
 		compilation: compilation;
 		example09_signum_2.
 
-	self assert: (shell call:-1) equals: -1 sign.
+	self assert: (shell inject: compilation andInvokeWith: { -1 }) equals: -1 sign.
 ]
 
 { #category : #'tests - examples' }
@@ -393,7 +394,7 @@ TRCompilationTestCase >> test_example15_add_with_overflow_check [
 	TRCompilationExamples new
 		compilation: compilation;
 		example15_add_with_overflow_check.
-	self assert: (shell call: 16r7FFFFFFE _: 2 ) equals: 0.
+	self assert: (shell inject: compilation andInvokeWith: { 16r7FFFFFFE . 2 }) equals: 0.
 ]
 
 { #category : #'tests - examples' }
@@ -405,7 +406,7 @@ TRCompilationTestCase >> test_example16_factorial_i_with_overflow [
 	TRCompilationExamples new
 		compilation: compilation;
 		example16_factorial_i_with_overflow.
-	self assert: (shell call:13)equals: -1.
+	self assert: (shell inject: compilation andInvokeWith: { 13 })equals: -1.
 
 
 	"

src/Tinyrossa-Tests/TRCompilationTestShell.class.st

@@ -2,7 +2,7 @@ Class {
 	#name : #TRCompilationTestShell,
 	#superclass : #TestAsserter,
 	#instVars : [
-		'compilation',
+		'target',
 		'binary',
 		'debugger'
 	],
@@ -12,7 +12,7 @@ Class {
 	#pools : [
 		'TRRegisterKinds'
 	],
-	#category : #'Tinyrossa-Tests-Shells-SmalltalkX'
+	#category : #'Tinyrossa-Tests-Shells'
 }
 
 { #category : #accessing }
@@ -30,11 +30,11 @@ TRCompilationTestShell class >> defaultImpl: aClass [
 ]
 
 { #category : #'instance creation' }
-TRCompilationTestShell class >> forCompilation: aTRCompilation [
+TRCompilationTestShell class >> forTarget: aTRCompilationTarget [
 	self == TRCompilationTestShell ifTrue: [ 
-		^ self defaultImpl forCompilation: aTRCompilation
+		^ self defaultImpl forTarget: aTRCompilationTarget
 	] ifFalse: [ 
-		^ self new initializeWithCompilation: aTRCompilation
+		^ self new initializeWithTarget: aTRCompilationTarget
 	].
 ]
 
@@ -76,48 +76,63 @@ TRCompilationTestShell class >> shellDirectory [
 	"
 ]
 
-{ #category : #utilities }
-TRCompilationTestShell >> call [
-	^ self callWithArguments: #()
+{ #category : #accessing }
+TRCompilationTestShell >> debugger [
+	self assert: debugger notNil.
+	^ debugger
+]
+
+{ #category : #initialization }
+TRCompilationTestShell >> initializeWithTarget: aTRCompilationTarget [
+	target := aTRCompilationTarget.
+	self setUp.
 ]
 
 { #category : #utilities }
-TRCompilationTestShell >> call: arg1 [
-	^ self callWithArguments: { arg1 }
+TRCompilationTestShell >> inject: compilation [
+	"Utility: inject compiled code into the shell" 
+
+	debugger memoryAt: self nzone put: compilation codeBuffer bytes
 ]
 
 { #category : #utilities }
-TRCompilationTestShell >> call: arg1 _:arg2 [
-	^ self callWithArguments: { arg1 . arg2 }
+TRCompilationTestShell >> inject: compilation andInvokeWith: arguments [
+	| argumentTypes |
+
+	self inject: compilation.
+
+	argumentTypes := ((compilation symbolManager lookupSymbolsByType: TRParameterSymbol)
+							sorted: [ :a :b | a index < b index ])
+							collect:[ :e | e type ].
+
+	^ self invoke: compilation functionSymbol with: arguments types: argumentTypes.
 ]
 
-{ #category : #'utilities-private' }
-TRCompilationTestShell >> callWithArguments: values [
-	| params |
+{ #category : #utilities }
+TRCompilationTestShell >> invoke: symbol with: arguments types: argumentTypes [
+	| linkage |
 
-	"Inject compiled code into shell"
-	debugger memoryAt: self nzone put: compilation codeBuffer bytes.
+	linkage := symbol linkageClass basicNew.
 
-	"Prepare parameters"
-	params := (compilation symbolManager lookupSymbolsByType: TRParameterSymbol) sorted: [ :a :b | a index < b index ].
-	self assert: values size == params size description: 'Number of formal paramerers does not match actual'.
-	1 to: values size do: [:i |
-		| param value |
+	self assert: arguments size == argumentTypes size description: 'Number of formal paramerers does not match actual'.
+	1 to: arguments size do: [:i |
+		| typ arg |
 
-		param := params at: i.
-		value := values at: i.
+		typ := argumentTypes at: i.
+		arg := arguments at: i.
 
-		param type validateConstant: value.
+		typ validateConstant: arg.
 
-		param type isIntegerType ifTrue: [
+		typ isIntegerType ifTrue: [
 			| argReg |
 
-			argReg := (compilation codegen linkage parameterRegisters: GPR) at: i.
-			debugger setRegister: argReg nameInGDB to: value.
+			argReg := (linkage parameterRegisters: GPR) at: i.
+			debugger setRegister: argReg nameInGDB to: arg.
 		] ifFalse: [
-			self error: 'Parameter type not supported yet: ' , param type name
+			self error: 'Parameter type not supported yet: ' , typ name
 		].
 	].
+	self debugger setRegister: 'pc' to: self nzone.
 
 	"Call injected function"
 	"
@@ -126,48 +141,31 @@ TRCompilationTestShell >> callWithArguments: values [
 	debugger c.
 
 	"Retrieve return value"
-	compilation functionSymbol type isIntegerType ifTrue: [
+	symbol type isIntegerType ifTrue: [
 		| retReg |
 
-		retReg := (compilation codegen linkage returnRegisters: GPR) at: 1.
+		retReg := (linkage returnRegisters: GPR) at: 1.
 		^ debugger getRegister: retReg nameInGDB
 	] ifFalse: [
-		self error: 'Return type not supported yet: ' , compilation functionSymbol type name
+		self error: 'Return type not supported yet: ' , symbol type name
 	].
 ]
 
-{ #category : #accessing }
-TRCompilationTestShell >> debugger [
-	self assert: debugger notNil.
-	^ debugger
-]
-
-{ #category : #initialization }
-TRCompilationTestShell >> initializeWithCompilation: aTRCompilation [
-	compilation := aTRCompilation.
-	self setUp; reset.
-]
-
 { #category : #accessing }
 TRCompilationTestShell >> nzone [
 	"Return the address of nzone. See shell.link linker script."
 
 	^ 16r00080000
 ]
 
-{ #category : #running }
-TRCompilationTestShell >> reset [
-	self debugger setRegister: 'pc' to: self nzone
-]
-
 { #category : #running }
 TRCompilationTestShell >> setUp [
 	| shellDir |
 
 	shellDir := self class shellDirectory.
 	self assert: shellDir notNil description:'Could not determine directory with test shells!'.
 
-	binary := shellDir / ('shell-' , (compilation config target name readStream upTo: $-)).
+	binary := shellDir / ('shell-' , (target name readStream upTo: $-)).
 	self assert: binary isExecutable.
 ]
 
@@ -202,18 +200,20 @@ TRCompilationTestShell >> tearDownDebugger [
 
 		(debugger notNil and: [ debugger isConnected ]) ifTrue: [
 			| shouldQuitDebugger |
-
-			debugger send: 'kill'.
+
+			(debugger inferiors anySatisfy: [:e | e isRunning ]) ifTrue: [ 
+				debugger send: 'kill'
+			].
 
 			shouldQuitDebugger := (Smalltalk includesKey: #VDBDebuggerApplication) not 
 														or:[(Smalltalk at: #VDBDebuggerApplication) allInstances allSatisfy:[:vdbApp | vdbApp debugger ~~ debugger]].
 			shouldQuitDebugger ifTrue: [ 
-					debugger send: 'quit' andWait: false.				
+					debugger send: 'quit' andWait: false.                               
 			].
-		].		
+		].              
 	] ifFalse:[
 		"debugger is either nil or SmallRSP's RemoteGDB"
-		debugger notNil ifTrue:[		
+		debugger notNil ifTrue:[                
 			debugger disconnect.
 		].
 	].

src/Tinyrossa-Tests/TRCompilationTestShellGem5.class.st

@@ -7,7 +7,7 @@ Class {
 	#classVars : [
 		'Host'
 	],
-	#category : #'Tinyrossa-Tests-Shells-SmalltalkX'
+	#category : #'Tinyrossa-Tests-Shells'
 }
 
 { #category : #accessing }
@@ -37,13 +37,13 @@ TRCompilationTestShellGem5 >> setUp [
 		gem5exe := gem5dir asFileReference / 'build' / 'ALL' / 'gem5.debug'.
 	].
 	gem5exe exists ifFalse: [ 
-		gem5exe := gem5dir asFileReference / 'build' / compilation config target gem5 / 'gem5.opt'.
+		gem5exe := gem5dir asFileReference / 'build' / target gem5 / 'gem5.opt'.
 	].
 	gem5exe exists ifFalse: [ 
-		gem5exe := gem5dir asFileReference / 'build' / compilation config target gem5 / 'gem5.opt'.
+		gem5exe := gem5dir asFileReference / 'build' / target gem5 / 'gem5.opt'.
 	].
 
-	self assert: gem5exe exists description: 'No gem5.debug nor gem5.opt found in GEM5_DIR/build/ALL nor GEM5_DIR/build/',compilation config target gem5.
+	self assert: gem5exe exists description: 'No gem5.debug nor gem5.opt found in GEM5_DIR/build/ALL nor GEM5_DIR/build/',target gem5.
 
 	gem5cmd := '<1s> --listener-mode on "--debug-flags=Decode" <2s>/shell-gem5.py -c <3s> --wait-gdb --param ''system.shared_backstore = "/gem5"'''
 				expandMacrosWith: gem5exe pathString with: shellDir pathString with: binary pathString.

src/Tinyrossa-Tests/TRCompilationTestShellQEMU.class.st

@@ -4,7 +4,7 @@ Class {
 	#instVars : [
 		'qemu'
 	],
-	#category : #'Tinyrossa-Tests-Shells-SmalltalkX'
+	#category : #'Tinyrossa-Tests-Shells'
 }
 
 { #category : #running }
@@ -13,7 +13,7 @@ TRCompilationTestShellQEMU >> setUp [
 
 	super setUp.
 
-	qemuCmd := compilation config target qemu, ' -g 1234 ', binary pathString.
+	qemuCmd := target qemu, ' -g 1234 ', binary pathString.
 
 	"First, start QEMU... "
 	qemu := OSProcess new command: qemuCmd. 

src/Tinyrossa-Tests/TRCompilationTestShellRemoteUsingSSH.class.st

@@ -4,7 +4,7 @@ Class {
 	#classVars : [
 		'Host'
 	],
-	#category : #'Tinyrossa-Tests-Shells-SmalltalkX'
+	#category : #'Tinyrossa-Tests-Shells'
 }
 
 { #category : #accessing }

src/Tinyrossa/TRFunctionSymbol.class.st

@@ -3,7 +3,6 @@ Class {
 	#superclass : #TRSymbol,
 	#instVars : [
 		'linkageClass',
-		'parameters',
 		'address'
 	],
 	#pools : [
@@ -40,7 +39,6 @@ TRFunctionSymbol >> initializeWithName:nameArg type:typeArg linkage: linkageClas
 	name := nameArg.
 	type := typeArg.
 	linkageClass := linkageClassArg.
-	parameters := OrderedCollection new.
 ]
 
 { #category : #testing }