# HG changeset patch # User Jan Vrany # Date 1470603159 -3600 # Node ID ce82ecc2ca57d62c09a4adf22431fd16c8ad17f3 # Parent ec41dca68283643ec22805245ee31abf50ae8e28 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. diff -r ec41dca68283 -r ce82ecc2ca57 c1/DragonFly__C1BackendTests.st --- 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 " "Modified: / 25-07-2016 / 19:01:27 / Jan Vrany " +! + +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 " ! ! !C1BackendTests methodsFor:'tests - building blocks'! diff -r ec41dca68283 -r ce82ecc2ca57 c1/DragonFly__C1CompilerBackendX86_64.st --- 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 " + "Modified: / 07-08-2016 / 22:54:17 / Jan Vrany " ! ! !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 " - "Modified: / 01-08-2016 / 20:56:33 / Jan Vrany " + "Modified: / 07-08-2016 / 22:56:11 / Jan Vrany " ! 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 " - "Modified: / 01-08-2016 / 20:56:45 / Jan Vrany " + "Modified: / 07-08-2016 / 22:30:08 / Jan Vrany " ! 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 " - "Modified: / 02-08-2016 / 00:09:03 / Jan Vrany " + "Modified: / 07-08-2016 / 23:17:58 / Jan Vrany " ! emitEpilogue diff -r ec41dca68283 -r ce82ecc2ca57 c1/DragonFly__C1Int64Value.st --- 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 " ! ! +!C1Int64Value class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! + diff -r ec41dca68283 -r ce82ecc2ca57 c1/DragonFly__C1LLVMTypes.st --- 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 " + "Modified: / 07-08-2016 / 22:27:21 / Jan Vrany " ! ! !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 " +! + +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 " + "Modified: / 07-08-2016 / 22:32:15 / Jan Vrany " +! + +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 " - "Modified (comment): / 21-04-2016 / 08:41:25 / Jan Vrany " + "Modified: / 07-08-2016 / 21:34:42 / Jan Vrany " ! ! !C1LLVMTypes class methodsFor:'documentation'! diff -r ec41dca68283 -r ce82ecc2ca57 c1/DragonFly__C1NumericValue.st --- 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 " ! ! +!C1NumericValue class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! +