Added support for JavaContext's in code generator
In Smalltalk/X, for Java a special context class - JavaContext - is
used. This commit adds support to backend so when compiling for a
Java class, a JavaContext is created.
--- a/c1/DragonFly__C1BackendTests.st Wed Aug 10 22:35:23 2016 +0100
+++ b/c1/DragonFly__C1BackendTests.st Sun Aug 07 21:52:39 2016 +0100
@@ -113,6 +113,40 @@
"Created: / 24-06-2016 / 00:11:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-07-2016 / 19:01:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_thisContext_02
+ | method compiler ctx |
+
+ method := JavaMethod new.
+ method numberOfArgs:0.
+ method numberOfVars:0.
+ method stackSize:0.
+ method setAccessFlags: JavaConstants ACC_PUBLIC.
+ compiler := C1CompilerBackend new.
+ compiler method:method.
+ compiler prepare.
+ compiler emitPrologue.
+ compiler emitReturn:(compiler
+ emitSend:#returnSenderContext
+ to:(compiler loadLiteral:self)
+ with:#()).
+ compiler emitEpilogue.
+ compiler finish.
+ self assert:method code notNil.
+ ctx := method
+ valueWithReceiver:self
+ arguments:#()
+ selector:testSelector.
+ self assert:ctx isJavaContext.
+ self assert:ctx receiver == self.
+ self assert:ctx selector == testSelector.
+ self assert:ctx method == method.
+ self assert:ctx numArgs == 0.
+ self assert:ctx numVars == 0.
+ self assert:ctx numTemps == 0.
+
+ "Created: / 07-08-2016 / 21:53:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!C1BackendTests methodsFor:'tests - building blocks'!
--- a/c1/DragonFly__C1CompilerBackendX86_64.st Wed Aug 10 22:35:23 2016 +0100
+++ b/c1/DragonFly__C1CompilerBackendX86_64.st Sun Aug 07 21:52:39 2016 +0100
@@ -17,7 +17,8 @@
C1CompilerBackend subclass:#C1CompilerBackendX86_64
instanceVariableNames:'method numArgs numVars module function asm prologue epilogue
- contextSetup literals literalsBaseAddr context'
+ contextSetup literals literalsBaseAddr context
+ contextFieldIndexCVars'
classVariableNames:''
poolDictionaries:'DragonFly::C1LLVMTypes LLVMIntPredicate VMData VMOffsets
VMConstants DragonFly::C1CompilerDebugFlags'
@@ -97,9 +98,12 @@
method:aMethod
method := aMethod.
numArgs := aMethod numArgs.
+ method isJavaMethod ifTrue:[
+ numArgs := (method isStatic ifTrue:[0] ifFalse:[1])
+ ].
numVars := aMethod numVars.
- "Modified: / 01-08-2016 / 20:39:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 22:54:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!C1CompilerBackendX86_64 methodsFor:'codegen-load / store'!
@@ -158,14 +162,14 @@
loadContextVarAt: index
index <= numArgs ifTrue:[
context isNil ifTrue:[
- ^ function parameterAt: OBJFUNCArgIndexArgBase + index
+ ^ function parameterAt: OBJFUNCArgIndexArgBase + ((method isJavaMethod and: [method isStatic not]) ifTrue:[-1] ifFalse:[0]) + index.
].
].
self assert: context notNil description: 'No context!!'.
- ^ asm load: (asm gep: context at:{ 0 . TyContextFieldIndexCVars . index - 1 })
+ ^ asm load: (asm gep: context at:{ 0 . contextFieldIndexCVars . index - 1 })
"Created: / 31-07-2016 / 23:10:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 01-08-2016 / 20:56:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 22:56:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
loadLiteral: anObject
@@ -243,10 +247,10 @@
storeContextVar: value at: index
self assert: context notNil description: 'No context!!'.
- ^ asm store: value at: (asm gep: context at:{ 0 . TyContextFieldIndexCVars . index - 1 })
+ ^ asm store: value at: (asm gep: context at:{ 0 . contextFieldIndexCVars . index - 1 })
"Created: / 31-07-2016 / 23:07:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 01-08-2016 / 20:56:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 22:30:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
storeRetvalTemp: value
@@ -325,19 +329,39 @@
!C1CompilerBackendX86_64 methodsFor:'codegen-prologue / epilogue'!
emitContextSetup
- | flags ctx |
+ | flags arg1Index ctxSize ctxTy ctx |
contextSetup := function addBasicBlockNamed:'context-setup'.
asm continue:contextSetup.
- ctx := asm alloca:(C1LLVMTypes tyContext:(method numArgs + method numVars + method stackSize))
- as:'__context'.
+
+ arg1Index := 1.
+ ctxSize := numArgs + method numVars + method stackSize.
+
+ method isJavaMethod ifTrue:[
+ arg1Index := method isStatic ifTrue:[ 1 ] ifFalse:[ 2 ].
+ ctxTy := C1LLVMTypes tyJContext: ctxSize.
+ contextFieldIndexCVars := TyJContextFieldIndexCVars
+ ] ifFalse:[method isBlock ifTrue:[
+ ctxTy := C1LLVMTypes tyBContext: ctxSize.
+ contextFieldIndexCVars := TyBContextFieldIndexCVars
+ ] ifFalse:[
+ ctxTy := C1LLVMTypes tyMContext: ctxSize.
+ contextFieldIndexCVars := TyMContextFieldIndexCVars
+ ]].
+
+
+ (method isJavaMethod and:[ method isStatic not]) ifTrue:[
+ ctxSize := ctxSize + 1.
+ ].
+ ctxTy := (method isJavaMethod ifTrue:[ C1LLVMTypes tyJContext: ctxSize ] ifFalse:[ method isBlock ifTrue:[ C1LLVMTypes tyBContext: ctxSize ] ifFalse:[ C1LLVMTypes tyMContext: ctxSize ]]).
+ ctx := asm alloca:ctxTy as:'__context'.
"/ Nil out contents...
asm memset: ctx _: (LLVMConstant uint8: 0) _: (LLVMConstant uint64: ctx type pointee sizeInBytes) _: ctx type alignmentInBytes _: false.
flags := (method isJavaMethod ifTrue:[ __LAZYJCON ] ifFalse:[ method isBlock ifTrue:[ __LAZYBCON ] ifFalse:[ __LAZYMCON ]])
| __CANNOT_RETURN "/ For now, we don't (yet) fill setjmp() buffer
| __METHOD_VALID
- | (method numArgs bitShift:__NARG_SHIFT)
+ | ( numArgs bitShift:__NARG_SHIFT)
| (method numVars bitShift:__NVAR_SHIFT)
| (method stackSize bitShift:__NTMP_SHIFT).
asm store:(self makeSmallInteger:flags)
@@ -353,11 +377,11 @@
asm store:(asm bitcast:self loadThisContext to:LLVMType intptr pointer)
at:(asm gep:ctx at:{ 0 . TyContextFieldIndexSenderS }).
"/ Store arguments
- 1 to: numArgs do:[:i |
+ 1 to: method numArgs do:[:i |
| arg |
arg := function parameterAt: OBJFUNCArgIndexArgBase + i.
- asm store: arg at: (asm gep: ctx at:{ 0 . TyContextFieldIndexCVars . i - 1 })
+ asm store: arg at: (asm gep: ctx at:{ 0 . contextFieldIndexCVars . i + arg1Index - 2 })
].
self storeThisContext:ctx.
context := ctx.
@@ -366,7 +390,7 @@
].
"Created: / 20-04-2016 / 23:12:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 02-08-2016 / 00:09:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 23:17:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
emitEpilogue
--- a/c1/DragonFly__C1Int64Value.st Wed Aug 10 22:35:23 2016 +0100
+++ b/c1/DragonFly__C1Int64Value.st Sun Aug 07 21:52:39 2016 +0100
@@ -71,3 +71,10 @@
"Created: / 06-08-2016 / 18:06:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!C1Int64Value class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/c1/DragonFly__C1LLVMTypes.st Wed Aug 10 22:35:23 2016 +0100
+++ b/c1/DragonFly__C1LLVMTypes.st Sun Aug 07 21:52:39 2016 +0100
@@ -23,13 +23,17 @@
TyInstanceFieldIndexHashLow TyOBJ TyOBJVec TyInlineCache
TyInlineCacheIndexFunc TyInlineCacheIndexClass
TyInlineCacheIndexLineNo TyInlineCachePtr TyOBJFUNC TyOBJFUNCs
- TyContextFields TyContextFieldIndexCVars TyContexts
+ TyMContextFields TyMContextFieldIndexCVars TyMContexts
TyContextFieldIndexFlags TyContextFieldIndexSenderS
TyContextFieldIndexHome TyContextFieldIndexReceiver
TyContextFieldIndexSelector TyContextFieldIndexSearchClass
TyContextFieldIndexMethod TyContextFieldIndexLineNr
TyContextFieldIndexRetvalTemp TyContextFieldIndexHandleS
- TyMKREALCONTEXT5 TySSENDSs'
+ TyMKREALCONTEXT5 TySSENDSs TyJContexts TyJContextFields
+ TyJContextFieldIndexExArg TyJContextFieldIndexExPC
+ TyJContextFieldIndexByteCode TyJContextFieldIndexConstPool
+ TyJContextFieldIndexAcqrMonitors TyJContextFieldIndexCVars
+ TyBContextFieldIndexCVars'
poolDictionaries:''
category:'DragonFly-C1'
!
@@ -80,7 +84,7 @@
TyInstanceFieldIndexAge := 4.
TyInstanceFieldIndexHashLow := 5.
- TyContextFields := TyInstanceFields , (Context instVarNames collect: [ :nm | nm last == $* ifTrue:[ LLVMType intptr pointer ] ifFalse:[ TyOBJ ] ]).
+ TyMContextFields := TyInstanceFields , (Context instVarNames collect: [ :nm | nm last == $* ifTrue:[ LLVMType intptr pointer ] ifFalse:[ TyOBJ ] ]).
TyContextFieldIndexFlags := TyInstanceFields size - 1 + (Context instVarIndexFor: #flags).
TyContextFieldIndexSenderS := TyInstanceFields size - 1 + (Context instVarIndexFor: #'sender*').
TyContextFieldIndexHome := TyInstanceFields size - 1 + (Context instVarIndexFor: #home).
@@ -91,9 +95,22 @@
TyContextFieldIndexLineNr := TyInstanceFields size - 1 + (Context instVarIndexFor: #lineNr).
TyContextFieldIndexRetvalTemp := TyInstanceFields size - 1 + (Context instVarIndexFor: #retvalTemp).
TyContextFieldIndexHandleS := TyInstanceFields size - 1 + (Context instVarIndexFor: #'handle*').
- TyContextFieldIndexCVars := TyInstanceFields size + Context instSize.
+ TyMContextFieldIndexCVars := TyInstanceFields size + Context instSize.
+
+ self assert: Context instSize == BlockContext instSize.
+ TyBContextFieldIndexCVars := TyInstanceFields size + Context instSize.
+
+ TyMContexts := #().
- TyContexts := #().
+ TyJContextFields := TyMContextFields , (JavaContext instVarNames collect: [ :nm | nm last == $* ifTrue:[ LLVMType intptr pointer ] ifFalse:[ TyOBJ ] ]).
+ TyJContextFieldIndexExArg := TyInstanceFields size - 1 + (JavaContext instVarIndexFor: #exArg).
+ TyJContextFieldIndexExPC := TyInstanceFields size - 1 + (JavaContext instVarIndexFor: #exPC).
+ TyJContextFieldIndexByteCode := TyInstanceFields size - 1 + (JavaContext instVarIndexFor: #byteCode).
+ TyJContextFieldIndexConstPool := TyInstanceFields size - 1 + (JavaContext instVarIndexFor: #constPool).
+ TyJContextFieldIndexAcqrMonitors := TyInstanceFields size - 1 + (JavaContext instVarIndexFor: #acqrMonitors).
+ TyJContextFieldIndexCVars := TyInstanceFields size + JavaContext instSize.
+
+ TyJContexts := #().
TyInlineCache := LLVMType named: 'inlineCache'.
TyInlineCachePtr := TyInlineCache pointer.
@@ -361,42 +378,97 @@
} returning: TyOBJ .
}.
- "Modified: / 01-08-2016 / 20:50:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 22:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!C1LLVMTypes class methodsFor:'accessing'!
-tyContext: size
- "Return a type for context with given `size`. Size should
- be numArgs + numVars + numTemps"
+tyBContext:size
+ "Return a type for (Smalltalk) block context with given `size`. Size
+ should be numArgs + numVars + numTemps"
+
+ "/ In Smalltalk/X, Context and BlockContext are the same (i.e., have the same
+ "/ slots. See BlockContext class. Hence, do the same as for (Smalltalk) method
+ "/ context.
+ ^ self tyMContext: size
+ "Created: / 07-08-2016 / 10:07:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tyJContext:size
+ "Return a type for Java method context with given `size`. Size
+ should be numArgs + numVars + numTemps. Note, that `long` and
+ `double` arguments take two slots, this MUST be reflected in `size`
+ parameter (i.e., caller must compute size properly - this method does
+ not care).
+ "
+
| tyContext |
- TyContexts size < (size + 1) ifTrue:[
- | tmp |
+ TyJContexts size < (size + 1) ifTrue:[
+ | tmp |
- tmp := Array new: size + 1.
- tmp replaceFrom: 1 to: TyContexts size with: TyContexts.
- TyContexts := tmp.
+ tmp := Array new:size + 1.
+ tmp
+ replaceFrom:1
+ to:TyJContexts size
+ with:TyJContexts.
+ TyJContexts := tmp.
].
- tyContext := TyContexts at: size + 1.
+ tyContext := TyJContexts at:size + 1.
tyContext isNil ifTrue:[
- tyContext := LLVMType named: '__context' , size printString.
- size == 0 ifTrue:[
- tyContext elementTypes: TyContextFields
- ] ifFalse:[
- tyContext elementTypes: (TyContextFields copyWith: (LLVMType arrayOf: TyOBJ size: size))
- ].
- TyContexts at: size + 1 put: tyContext.
+ tyContext := LLVMType named:'__context' , size printString.
+ size == 0 ifTrue:[
+ tyContext elementTypes:TyJContextFields
+ ] ifFalse:[
+ tyContext
+ elementTypes:(TyJContextFields copyWith:(LLVMType arrayOf:TyOBJ size:size))
+ ].
+ TyJContexts at:size + 1 put:tyContext.
].
^ tyContext
"
- DragonFly::C1LLVMTypes tyContext: 3
+ DragonFly::C1LLVMTypes tyContext: 3"
+
+ "Created: / 07-08-2016 / 10:09:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 22:32:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tyMContext:size
+ "Return a type for (Smalltalk) method context with given `size`. Size
+ should be numArgs + numVars + numTemps"
+
+ | tyContext |
+
+ TyMContexts size < (size + 1) ifTrue:[
+ | tmp |
+
+ tmp := Array new:size + 1.
+ tmp
+ replaceFrom:1
+ to:TyMContexts size
+ with:TyMContexts.
+ TyMContexts := tmp.
+ ].
+ tyContext := TyMContexts at:size + 1.
+ tyContext isNil ifTrue:[
+ tyContext := LLVMType named:'__context' , size printString.
+ size == 0 ifTrue:[
+ tyContext elementTypes:TyMContextFields
+ ] ifFalse:[
+ tyContext
+ elementTypes:(TyMContextFields copyWith:(LLVMType arrayOf:TyOBJ size:size))
+ ].
+ TyMContexts at:size + 1 put:tyContext.
+ ].
+ ^ tyContext
+
"
+ DragonFly::C1LLVMTypes tyMContext: 3"
"Created: / 20-04-2016 / 23:06:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 21-04-2016 / 08:41:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2016 / 21:34:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!C1LLVMTypes class methodsFor:'documentation'!
--- a/c1/DragonFly__C1NumericValue.st Wed Aug 10 22:35:23 2016 +0100
+++ b/c1/DragonFly__C1NumericValue.st Sun Aug 07 21:52:39 2016 +0100
@@ -103,3 +103,10 @@
"Created: / 06-08-2016 / 09:24:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!C1NumericValue class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+