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 }