[Vm-dev] VM Maker Inbox: VMMaker.oscog-KenD.2519.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 7 00:09:42 UTC 2019


A new version of VMMaker was added to project VM Maker Inbox:
http://source.squeak.org/VMMakerInbox/VMMaker.oscog-KenD.2519.mcz

==================== Summary ====================

Name: VMMaker.oscog-KenD.2519
Author: KenD
Time: 6 February 2019, 4:07:54.509792 pm
UUID: cd615691-dbfb-4024-9b1b-4f05f0ae7d01
Ancestors: VMMaker.oscog-KenD.2518

Non-register struct returns now work.
[Needs corresponding vm]

=============== Diff against VMMaker.oscog-KenD.2518 ===============

Item was changed:
  SystemOrganization addCategory: #'VMMaker-Building'!
  SystemOrganization addCategory: #'VMMaker-Interpreter'!
  SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
  SystemOrganization addCategory: #'VMMaker-InterpreterSimulation-Morphic'!
  SystemOrganization addCategory: #'VMMaker-JIT'!
  SystemOrganization addCategory: #'VMMaker-JITSimulation'!
  SystemOrganization addCategory: #'VMMaker-Multithreading'!
  SystemOrganization addCategory: #'VMMaker-Plugins'!
  SystemOrganization addCategory: #'VMMaker-Plugins-FFI'!
  SystemOrganization addCategory: #'VMMaker-Plugins-IOS'!
  SystemOrganization addCategory: #'VMMaker-PostProcessing'!
  SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
  SystemOrganization addCategory: #'VMMaker-SpurMemoryManager'!
  SystemOrganization addCategory: #'VMMaker-SpurMemoryManagerSimulation'!
  SystemOrganization addCategory: #'VMMaker-Support'!
  SystemOrganization addCategory: #'VMMaker-Tests'!
  SystemOrganization addCategory: #'VMMaker-Translation to C'!
+ SystemOrganization addCategory: #VMMaker!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  	<var: #procAddr type: #'void *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'>
  	"Go out, call this guy and create the return value.  This *must* be inlined because of
  	 the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:"
  	| myThreadIndex atomicType floatRet intRet x1Ret |
  	<var: #floatRet type: #double>
  	<var: #intRet type: #usqLong>
  	<var: #x1Ret type: #usqLong>
  	<inline: true>
  	myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
  	
- 	"If struct address used, place it in x8"
- 	(calloutState structReturnSize > 0
- 	 and: [(self returnStructInRegisters: calloutState structReturnSize) not]) ifTrue:
- 		[self setReturnRegister: calloutState limit]. "stack alloca'd struct"
- 
  	calloutState floatRegisterIndex > 0 ifTrue:
  		[self loadFloatRegs:
  			   (calloutState floatRegisters at: 0)
  			_: (calloutState floatRegisters at: 1)
  			_: (calloutState floatRegisters at: 2)
  			_: (calloutState floatRegisters at: 3)
  			_: (calloutState floatRegisters at: 4)
  			_: (calloutState floatRegisters at: 5)
  			_: (calloutState floatRegisters at: 6)
  			_: (calloutState floatRegisters at: 7)].
  
  	(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
  		[self setsp: calloutState argVector].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  	(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
  		[atomicType = FFITypeSingleFloat
  			ifTrue:
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5)
  					with: (calloutState integerRegisters at: 6)
  					with: (calloutState integerRegisters at: 7)]
  			ifFalse: "atomicType = FFITypeDoubleFloat"
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5)
  					with: (calloutState integerRegisters at: 6)
  					with: (calloutState integerRegisters at: 7)].
  
  		 "undo any callee argument pops because it may confuse stack management with the alloca."
  		 (self isCalleePopsConvention: calloutState callFlags) ifTrue:
  			[self setsp: calloutState argVector].
  		 interpreterProxy ownVM: myThreadIndex.
  
  		 ^interpreterProxy floatObjectOf: floatRet].
  
+ 	"If struct address used for return value, call is special"
+ 	(self mustReturnStructOnStack: calloutState structReturnSize) 
+ 	ifTrue: [
+ 		intRet := 0.
+ 		self setReturnRegister: (self cCoerceSimple: calloutState limit to: 'sqLong') "stack alloca'd struct"
+ 			 andCall: (self cCoerceSimple: procAddr to: 'sqLong')
+ 			 withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: 'sqLong').
+ 	] ifFalse: [
+ 		intRet := self 
- 	intRet := self 
  				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
  				with: (calloutState integerRegisters at: 0)
  				with: (calloutState integerRegisters at: 1)
  				with: (calloutState integerRegisters at: 2)
  				with: (calloutState integerRegisters at: 3)
  				with: (calloutState integerRegisters at: 4)
  				with: (calloutState integerRegisters at: 5)
  				with: (calloutState integerRegisters at: 6)
  				with: (calloutState integerRegisters at: 7).
- 	"Capture x1 immediately. No problem if unused"
- 	 x1Ret := self getX1register.
  	
+ 	 x1Ret := self getX1register. "Capture x1 immediately. No problem if unused"
+ 	].
  	"If struct returned in registers, 
  	 place register values into calloutState integerRegisters"
  	(calloutState structReturnSize > 0
  	 and: [self returnStructInRegisters: calloutState structReturnSize]) ifTrue: 
  		["Only 2 regs used in ARMv8/Aarch64 current"
  		 calloutState integerRegisters at: 0 put: intRet. "X0"
  		 calloutState integerRegisters at: 1 put: x1Ret]. "X1"
  
  	"undo any callee argument pops because it may confuse stack management with the alloca."
  	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
  		[self setsp: calloutState argVector].
  	interpreterProxy ownVM: myThreadIndex.
  
  	(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue:
  		["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
  		 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
  		 (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
  			[^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  		 ^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  	
  	^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>mustReturnStructOnStack: (in category 'marshalling') -----
+ mustReturnStructOnStack: returnStructSize
+ 	"Answer if a struct result of a given size is unable to be returned in registers."
+ 	^returnStructSize > (2 * self wordSize)!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
  returnStructInRegisters: returnStructSize
+ 	"Answer if a struct result of a given size is able to be returned in registers.
+ 	NB: this is a predicate!! #returnStructInRegisters: does NOT return a struct in anything!!"
- 	"Answer if a struct result of a given size is able to be returned in registers."
  	^returnStructSize <= (2 * self wordSize)!

Item was removed:
- ----- Method: ThreadedARM64FFIPlugin>>setReturnRegister: (in category 'callout support') -----
- setReturnRegister: structAddr
- 
- 	<inline: true>
- 	<var: #structAddr type: #'sqLong'>
- 	<var: #setStructReturnAddressRegister declareC: 'extern void setStructReturnAddressRegister(sqLong structAddr)'>
- 
- 	self setStructReturnAddressRegister: structAddr!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>setReturnRegister:andCall:withArgsArray: (in category 'callout support') -----
+ setReturnRegister: structAddr andCall: procAddr withArgsArray: arrayAddr
+ 
+ 	<inline: true>
+ 	<var: #structAddr type: #'sqLong'>
+ 	<var: #procAddr  type: #'sqLong'>
+ 	<var: #arrayAddr type: #'sqLong'>
+ 	<var: #callAndReturnWithStructAddr declareC: 'extern void callAndReturnWithStructAddr(sqLong structAddr,sqLong procAddr,sqLong arrayAddr)'>
+ 
+ 	self callAndReturnWithStructAddr: structAddr _: procAddr _: arrayAddr!

Item was added:
+ ServiceProvider subclass: #VMMakerServiceProvider
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker'!

Item was added:
+ ----- Method: VMMakerServiceProvider class>>initialize (in category 'initialization') -----
+ initialize 
+ 	ServiceRegistry current buildProvider: self new!



More information about the Vm-dev mailing list