[Vm-dev] VM Maker: VMMaker.oscog-eem.1684.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Feb 20 00:11:09 UTC 2016


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1684.mcz

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

Name: VMMaker.oscog-eem.1684
Author: eem
Time: 19 February 2016, 4:09:29.090179 pm
UUID: 001ebe3f-c0df-4d8a-9fdb-ccd6b34ab469
Ancestors: VMMaker.oscog-tfel.1683

Spur:
Fix bug in markAndTraceWeaklingsFrom:.  Fileds of weaklings may be immediate so must use followOopField:ofObject: not followObjField:ofObject:.

FFIPlugin:
First cut (untested) of FFI support for x86-64 on System V and WIN64.

Simulation:
Revert two of Tim's changes that break the VM simulator.

=============== Diff against VMMaker.oscog-tfel.1683 ===============

Item was changed:
  ----- Method: BitBltSimulator>>halftoneAt: (in category 'memory access') -----
  halftoneAt: idx
  
+ 	^self
+ 		cCode: [(halftoneBase + (idx \\ halftoneHeight * 4)) long32At: 0]
+ 		inSmalltalk: [self long32At: halftoneBase + (idx \\ halftoneHeight * 4)]!
- 	^ (halftoneBase + (idx \\ halftoneHeight * 4)) long32At: 0!

Item was changed:
  ----- Method: SpurMemoryManager>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') -----
  markAndTraceWeaklingsFrom: startIndex
  	"Mark weaklings on the weaklingStack, ignoring startIndex
  	 number of elements on the bottom of the stack.  Answer
  	 the size of the stack *before* the enumeration began."
  	^self objStack: weaklingStack from: startIndex do:
  		[:weakling|
  		 self deny: (self isForwarded: weakling).
  		 self markAndTraceClassOf: weakling.
  		"N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve"
  		 0 to: (self numStrongSlotsOfWeakling: weakling) - 1 do:
  			[:i| | field |
+ 			field := self followOopField: i ofObject: weakling.
- 			field := self followObjField: i ofObject: weakling.
  			((self isImmediate: field) or: [self isMarked: field]) ifFalse:
  				[self markAndTrace: field]]]!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 loadFloatRegs oop |
  	<var: #floatRet type: #double>
  	<var: #intRet type: #usqLong>
  	<inline: true>
  	self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class].
  	self cppIf: COGMTVM ifTrue:
  	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
  		[myThreadIndex := interpreterProxy disownVM: 0]].
  
  	self registerArgsSlop + self cStackAlignment > 0 ifTrue:
  		[self setsp: calloutState argVector].
  
  	calloutState floatRegisterIndex > 0 ifTrue:
  		[self 
  			load: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: 'double *') at: 0)
  			Flo: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: 'double *') at: 0)
  			a: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: 'double *') at: 0)
  			t: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: 'double *') at: 0)
  			R: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: 'double *') at: 0)
  			e: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: 'double *') at: 0)
  			g: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: 'double *') at: 0)
  			s: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: 'double *') at: 0)].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  	(atomicType >> 1) = (FFITypeSingleFloat > 1)
  		ifTrue:
  			[atomicType = FFITypeSingleFloat
  				ifTrue:
  					[floatRet := self 
+ 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long)') 
- 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(int, int, int, int)') 
  						with: (calloutState integerRegisters at: 0)
  						with: (calloutState integerRegisters at: 1)
  						with: (calloutState integerRegisters at: 2)
  						with: (calloutState integerRegisters at: 3)]
  				ifFalse: "atomicType = FFITypeDoubleFloat"
  					[floatRet := self 
+ 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(long, long, long, long)') 
- 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(int, int, int, int)') 
  						with: (calloutState integerRegisters at: 0)
  						with: (calloutState integerRegisters at: 1)
  						with: (calloutState integerRegisters at: 2)
  						with: (calloutState integerRegisters at: 3)]]
  		ifFalse:
  			[intRet := self 
+ 				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(long, long, long, long)') 
- 				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(int, int, int, int)') 
  				with: (calloutState integerRegisters at: 0)
  				with: (calloutState integerRegisters at: 1)
  				with: (calloutState integerRegisters at: 2)
  				with: (calloutState integerRegisters at: 3)].
  	"undo any callee argument pops because it may confuse stack management with the alloca."
  	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
  		[self setsp: calloutState argVector].
  
  	self cppIf: COGMTVM ifTrue:
  	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
  		[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:
  				[oop := self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
  			ifFalse:
  				[oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  		 ^oop].
  	
  	(atomicType >> 1) = (FFITypeSingleFloat > 1)
  		ifTrue:
  			[oop := interpreterProxy floatObjectOf: floatRet]
  		ifFalse:
  			[oop := self ffiCreateIntegralResultOop: intRet
  						ofAtomicType: atomicType
  						in: calloutState].
  	^interpreterProxy methodReturnValue: oop!

Item was added:
+ ThreadedFFICalloutState subclass: #ThreadedFFICalloutStateForX64
+ 	instanceVariableNames: 'registerIndex integerRegisters floatRegisters'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !ThreadedFFICalloutStateForX64 commentStamp: 'eem 2/16/2016 19:13' prior: 0!
+ A ThreadedFFICalloutStateForX64 is a holder for the callout state maintained while marshalling an FFI call on an X64 (x86-64) system.!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64 class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ 	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
+ 
+ 	ThreadedFFICalloutState instVarNamesAndTypesForTranslationDo: aBinaryBlock.
+ 	self instVarNames do:
+ 		[:ivn|
+ 		aBinaryBlock
+ 			value: ivn
+ 			value: (ivn caseOf: {
+ 						['integerRegisters']	-> [{#sqInt. '[', self pluginClass numRegArgs printString, ']'}].
+ 						['floatRegisters']	-> [{#double. '[', self pluginClass numFloatRegArgs printString, ']'}] }
+ 					otherwise:
+ 						[#sqInt])]!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64 class>>pluginClass (in category 'translation') -----
+ pluginClass
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>floatRegisters (in category 'accessing') -----
+ floatRegisters
+ 	"Answer the value of floatRegisters"
+ 
+ 	^ floatRegisters!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>floatRegisters: (in category 'accessing') -----
+ floatRegisters: anObject
+ 
+ 	^floatRegisters := anObject!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>initialize (in category 'initialize-release') -----
+ initialize
+ 	super initialize.
+ 	registerIndex := 0.
+ 	integerRegisters := CArrayAccessor on: (Array new: self class pluginClass numRegArgs).
+ 	floatRegisters := CArrayAccessor on: (Array new: self class pluginClass numFloatRegArgs)!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>integerRegisters (in category 'accessing') -----
+ integerRegisters
+ 	"Answer the value of integerRegisters"
+ 
+ 	^ integerRegisters!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>integerRegisters: (in category 'accessing') -----
+ integerRegisters: anObject
+ 
+ 	^integerRegisters := anObject!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>registerIndex (in category 'accessing') -----
+ registerIndex
+ 
+ 	^ registerIndex!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64>>registerIndex: (in category 'accessing') -----
+ registerIndex: anObject
+ 
+ 	^registerIndex := anObject!

Item was added:
+ ThreadedFFICalloutStateForX64 subclass: #ThreadedFFICalloutStateForX64SysV
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64SysV class>>pluginClass (in category 'accessing') -----
+ pluginClass
+ 	^ThreadedX64SysVFFIPlugin!

Item was added:
+ ThreadedFFICalloutStateForX64 subclass: #ThreadedFFICalloutStateForX64Win64
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForX64Win64 class>>pluginClass (in category 'accessing') -----
+ pluginClass
+ 	^ThreadedX64Win64FFIPlugin!

Item was added:
+ ----- Method: ThreadedFFIPlugin class>>excludingPredefinedMacros (in category 'translation') -----
+ excludingPredefinedMacros
+ 	"Answer the predefined macros that disqualify the platforms a subclass handles, if any.
+ 	 These are anded together and with includingPredefinedMacros, whereas
+ 	 identifyingPredefinedMacros are ored together.
+ 	 This can be used to differentiate e.g. x64 Sys V from x64 Win64."
+ 	^nil!

Item was changed:
  ----- Method: ThreadedFFIPlugin class>>generateCodeStringForPrimitives (in category 'translation') -----
  generateCodeStringForPrimitives
  	"Output a skeletal SqueakFFIPrims.c that includes the relevant FooFFIPlugin.c for
  	 each subclass based on the identifyingPredefinedMacros the subclass defines."
  	 
  	^String streamContents:
  		[:s|
  		 s nextPutAll: '/* Automatically generated by\	' withCRs.
  		 s nextPutAll: (CCodeGenerator monticelloDescriptionFor: self).
  		 s cr; nextPutAll: ' */'.
  		 s cr; cr; nextPut: $#.
  		 (self subclasses sort: [:a :b| a name < b name]) do:
  			[:class |
  			class identifyingPredefinedMacros ifNotNil:
  				[:predefinedMacros|
  				 s nextPutAll: 'if '.
+ 				class includingPredefinedMacros ifNotNil:
+ 					[:includingMacros|
+ 					 includingMacros do:
+ 						[:predefinedMacro| s nextPutAll: 'defined('; nextPutAll: predefinedMacro; nextPutAll: ') && '].
+ 					 s nextPut: $(].
+ 				class excludingPredefinedMacros ifNotNil:
+ 					[:excludingMacros|
+ 					 excludingMacros do:
+ 						[:predefinedMacro| s nextPutAll: '!!defined('; nextPutAll: predefinedMacro; nextPutAll: ') && '].
+ 					 s nextPut: $(].
  				 predefinedMacros
  					do: [:predefinedMacro| s nextPutAll: 'defined('; nextPutAll: predefinedMacro; nextPut: $)]
  					separatedBy: [s nextPutAll: ' || '].
+ 				class excludingPredefinedMacros ifNotNil:
+ 					[s nextPut: $)].
+ 				class includingPredefinedMacros ifNotNil:
+ 					[s nextPut: $)].
  				 s cr; cr; nextPutAll: '#	include "'; nextPutAll: class moduleName; nextPutAll: '.c"'.
  				 s cr; cr; nextPutAll: '#el']].
  		 s nextPutAll: 'se'.
  		 #(	'As yet no FFI implementation appears to exist for your platform.'
  			'Consider implementing it, starting by adding a subclass of ThreadedFFIPlugin.') do:
  			[:msg| s cr; nextPutAll: '#	error '; nextPutAll: msg].
  		 s cr; nextPutAll: '#endif'; cr]!

Item was changed:
  ----- Method: ThreadedFFIPlugin class>>identifyingPredefinedMacros (in category 'translation') -----
  identifyingPredefinedMacros
  	"Answer the predefined macros that identify the platforms a subclass handles, if any.
+ 	 These are ored together.
  	 If the subclass isn't yet ready for production (a work in progress) simply answer nil."
  	^nil!

Item was added:
+ ----- Method: ThreadedFFIPlugin class>>includingPredefinedMacros (in category 'translation') -----
+ includingPredefinedMacros
+ 	"Answer the predefined macros that qualify the platforms a subclass handles, if any.
+ 	 These are anded together and with excludingPredefinedMacros, whereas
+ 	 identifyingPredefinedMacros are ored together.
+ 	 This can be used to differentiate e.g. x64 Sys V from x64 Win64."
+ 	^nil!

Item was added:
+ ----- Method: ThreadedIA32FFIPlugin class>>moduleName (in category 'translation') -----
+ moduleName
+ 	^'IA32FFIPlugin'!

Item was removed:
- ----- Method: ThreadedPPCBEFFIPlugin>>ffiPushUnsignedLong:in: (in category 'marshalling') -----
- ffiPushUnsignedLong: value in: calloutState
- 	<var: #calloutState type: #'CalloutState *'>
- 	<inline: true>
- 	self shouldBeImplemented.
- 	^0!

Item was added:
+ ThreadedFFIPlugin subclass: #ThreadedX64FFIPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'NumFloatRegArgs NumIntRegArgs WordSize'
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !ThreadedX64FFIPlugin commentStamp: 'eem 2/19/2016 15:03' prior: 0!
+ This is an abstract superclass for the System V and WIN64 x86-64 ABIs that share a lot of code other than for structure passing.!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ 	^ThreadedFFICalloutStateForX64SysV!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>excludingPredefinedMacros (in category 'translation') -----
+ excludingPredefinedMacros
+ 	"Answer the predefined macros that disqualify the platforms a subclass handles, if any.
+ 	 This can be used to differentiate e.g. x64 Sys V from x64 Win64."
+ 	^#('WIN64')!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>identifyingPredefinedMacros (in category 'translation') -----
+ identifyingPredefinedMacros
+ 	"Answer the predefined macros that identify the platforms a subclass handles, if any.
+ 	 If the subclass isn't yet ready for production (a work in progress) simply answer nil."
+ 	^#('x86_64' '__amd64' '__x86_64' '__amd64__' '__x86_64__')!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ 	WordSize := 8.
+ 	NumIntRegArgs := 6.
+ 	NumFloatRegArgs := 8!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>moduleName (in category 'translation') -----
+ moduleName
+ 	^'X64SysVFFIPlugin'!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>numFloatRegArgs (in category 'accessing') -----
+ numFloatRegArgs
+ 	^NumFloatRegArgs!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin class>>numRegArgs (in category 'accessing') -----
+ numRegArgs
+ 	^NumIntRegArgs!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ 	<var: #value type: #double>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 
+ 	calloutState floatRegisterIndex < NumFloatRegArgs
+ 		ifTrue:
+ 			[calloutState floatRegisters at: calloutState floatRegisterIndex put: value.
+ 			 calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy storeFloatAtPointer: calloutState currentArg from: value.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
+ ffiPushPointer: pointer in: calloutState
+ 	<var: #pointer type: #'void *'>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: pointer asInteger.
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: pointer.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
+ ffiPushSignedByte: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char').
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
+ ffiPushSignedChar: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char').
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
+ ffiPushSignedInt: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0
+ !

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ 	<var: #value type: #sqLong>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt).
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
+ ffiPushSignedShort: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short').
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short').
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ 	<var: #value type: #float>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 
+ 	calloutState floatRegisterIndex < NumFloatRegArgs
+ 		ifTrue:
+ 			[calloutState floatRegisters at: calloutState floatRegisterIndex put: value.
+ 			 calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy storeFloatAtPointer: calloutState currentArg from: value.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
+ ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
+ 	<var: #pointer type: #'void *'>
+ 	<var: #argSpec type: #'sqInt *'>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushUnsignedByte: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char').
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0
+ !

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushUnsignedChar: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char').
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushUnsignedInt: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0
+ 
+ !

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ 	<var: #value type: #usqLong>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushUnsignedShort: value in: calloutState
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	calloutState integerRegisterIndex < NumIntRegArgs
+ 		ifTrue:
+ 			[calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short').
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + WordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short').
+ 			 calloutState currentArg: calloutState currentArg + WordSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>registerArgsSlop (in category 'marshalling') -----
+ registerArgsSlop
+ 	"Answer any space needed to prevent the alloca'ed outgoing arguments marshalling area from
+ 	 being overwritten by any register arguments during calls during marshalling.  On ARM we
+ 	 believe this is zero."
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64FFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ 	"Answer if a struct result of a given size is returned in memory or not."
+ 	self subclassResponsibility!

Item was added:
+ ThreadedX64FFIPlugin subclass: #ThreadedX64SysVFFIPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !ThreadedX64SysVFFIPlugin commentStamp: 'eem 2/17/2016 20:03' prior: 0!
+ This subclass is for the System V x86-64 ABI.  The System V ABI uses 6 integer registers and 8 double-precision floating-point registers.  See http://www.x86-64.org/documentation/abi.pdf.  It seems that Mac OS X and linux use draft version 0.90, http://people.freebsd.org/~obrien/amd64-elf-abi.pdf.
+ 
+ Note that the System V x86-64 ABI decomposes structs of 2 eightbytes or smaller passed by value across available parameter registers.  double fields will be passed in an xmm register.!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ 	^ThreadedFFICalloutStateForX64SysV!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>excludingPredefinedMacros (in category 'translation') -----
+ excludingPredefinedMacros
+ 	"Answer the predefined macros that disqualify the platforms a subclass handles, if any.
+ 	 This can be used to differentiate e.g. x64 Sys V from x64 Win64."
+ 	^#('WIN64')!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>identifyingPredefinedMacros (in category 'translation') -----
+ identifyingPredefinedMacros
+ 	"Answer the predefined macros that identify the platforms a subclass handles, if any.
+ 	 If the subclass isn't yet ready for production (a work in progress) simply answer nil."
+ 	^#('x86_64' '__amd64' '__x86_64' '__amd64__' '__x86_64__')!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ 	WordSize := 8.
+ 	NumIntRegArgs := 6.
+ 	NumFloatRegArgs := 8!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>moduleName (in category 'translation') -----
+ moduleName
+ 	^'X64SysVFFIPlugin'!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>numFloatRegArgs (in category 'accessing') -----
+ numFloatRegArgs
+ 	^NumFloatRegArgs!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>numRegArgs (in category 'accessing') -----
+ numRegArgs
+ 	^NumIntRegArgs!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin>>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 loadFloatRegs oop |
+ 	<var: #floatRet type: #double>
+ 	<var: #intRet type: #usqLong>
+ 	<inline: true>
+ 	self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class].
+ 	self cppIf: COGMTVM ifTrue:
+ 	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
+ 		[myThreadIndex := interpreterProxy disownVM: 0]].
+ 
+ 	self registerArgsSlop + self cStackAlignment > 0 ifTrue:
+ 		[self setsp: calloutState argVector].
+ 
+ 	calloutState floatRegisterIndex > 0 ifTrue:
+ 		[self 
+ 			load: ((calloutState floatRegisters at: 0) at: 0)
+ 			Flo: ((calloutState floatRegisters at: 1) at: 0)
+ 			a: ((calloutState floatRegisters at: 2) at: 0)
+ 			t: ((calloutState floatRegisters at: 3) at: 0)
+ 			R: ((calloutState floatRegisters at: 4) at: 0)
+ 			e: ((calloutState floatRegisters at: 5) at: 0)
+ 			g: ((calloutState floatRegisters at: 6) at: 0)
+ 			s: ((calloutState floatRegisters at: 7) at: 0)].
+ 
+ 	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
+ 		ifTrue:
+ 			[atomicType = FFITypeSingleFloat
+ 				ifTrue:
+ 					[floatRet := self 
+ 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long, long, long)') 
+ 						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)]
+ 				ifFalse: "atomicType = FFITypeDoubleFloat"
+ 					[floatRet := self 
+ 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(long, long, long, long, long, long)') 
+ 						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)]]
+ 		ifFalse:
+ 			[intRet := self 
+ 				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(long, long, long, long, long, long)') 
+ 				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)].
+ 	"undo any callee argument pops because it may confuse stack management with the alloca."
+ 	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
+ 		[self setsp: calloutState argVector].
+ 
+ 	self cppIf: COGMTVM ifTrue:
+ 	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
+ 		[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:
+ 				[oop := self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
+ 			ifFalse:
+ 				[oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
+ 		 ^oop].
+ 	
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
+ 		ifTrue:
+ 			[oop := interpreterProxy floatObjectOf: floatRet]
+ 		ifFalse:
+ 			[oop := self ffiCreateIntegralResultOop: intRet
+ 						ofAtomicType: atomicType
+ 						in: calloutState].
+ 	^interpreterProxy methodReturnValue: oop!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
+ ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
+ 	<var: #pointer type: #'void *'>
+ 	<var: #argSpec type: #'sqInt *'>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	| roundedSize doubleType floatType numDoubleRegisters numIntegerRegisters passField0InXmmReg passField1InXmmReg |
+ 	structSize <= 16 ifTrue:
+ 		["See sec 3.2.3 of http://people.freebsd.org/~obrien/amd64-elf-abi.pdf. (dravft version 0.90).
+ 		  All of the folowing are passed in registers:
+ 			typedef struct { long a; } s0;
+ 			typedef struct { double a; } s1;
+ 			typedef struct { long a; double b; } s2;
+ 			typedef struct { int a; int b; double c; } s2a;
+ 			typedef struct { short a; short b; short c; short d; double e; } s2b;
+ 			typedef struct { long a; float b; } s2f;
+ 			typedef struct { long a; float b; float c; } s2g;
+ 		  but not ones like this:
+ 			typedef struct { int a; float b; int c; float d; } s2h;"
+ 		 doubleType := FFITypeDoubleFloat << FFIAtomicTypeShift + FFITypeDoubleFloat.
+ 		 floatType := FFITypeDoubleFloat << FFIAtomicTypeShift + FFITypeSingleFloat.
+ 		 passField0InXmmReg := doubleType = ((self cCoerce: argSpec to: #'int *') at: 1) "0th field is struct type and size"
+ 								or: [floatType = ((self cCoerce: argSpec to: #'int *') at: 1)
+ 									and: [floatType = ((self cCoerce: argSpec to: #'int *') at: 2)]].
+ 		 structSize <= 8
+ 			ifTrue:
+ 				[numDoubleRegisters := passField0InXmmReg ifTrue: [1] ifFalse: [0].
+ 				 numIntegerRegisters := 1 - numDoubleRegisters]
+ 			ifFalse:
+ 				[passField1InXmmReg := doubleType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 1) "Nth field is last field of struct"
+ 										or: [floatType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 2)
+ 											and: [floatType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 1)]].
+ 				 numDoubleRegisters := (passField0InXmmReg ifTrue: [1] ifFalse: [0]) + (passField1InXmmReg ifTrue: [1] ifFalse: [0]).
+ 				 numIntegerRegisters := 2 - numDoubleRegisters].
+ 		 (calloutState floatRegisterIndex + numDoubleRegisters <= NumFloatRegArgs
+ 		  and: [calloutState integerRegisterIndex + numIntegerRegisters <= NumIntRegArgs]) ifTrue:
+ 			[passField0InXmmReg
+ 				ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 0) in: calloutState]
+ 				ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 0) in: calloutState].
+ 			 structSize > 8 ifTrue:
+ 				[passField1InXmmReg
+ 					ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 1) in: calloutState]
+ 					ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 1) in: calloutState]].
+ 			 ^0].
+ 
+ 	roundedSize := structSize + 7 bitClear: 7.
+ 	calloutState currentArg + roundedSize > calloutState limit ifTrue:
+ 		 [^FFIErrorCallFrameTooBig].
+ 	self mem: calloutState currentArg cp: (self cCoerceSimple: pointer to: 'char *') y: structSize.
+ 	calloutState currentArg: calloutState currentArg + roundedSize].
+ 	^0!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ 	"Answer if a struct result of a given size is returned in memory or not."
+ 	^returnStructSize <= (WordSize * 2)!

Item was added:
+ ThreadedX64FFIPlugin subclass: #ThreadedX64Win64FFIPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !ThreadedX64Win64FFIPlugin commentStamp: 'eem 2/16/2016 19:39' prior: 0!
+ This subclass is for the Win64 x86-64 ABI.  The System V ABI uses 4 integer registers and 4 double-precision floating-point registers.  See w.g. https://msdn.microsoft.com/en-us/library/ms235286.aspx, or google for "Overview of x64 Calling Conventions - MSDN - Microsoft".
+ 
+ Note that unlike the System V x86-64 ABI, the Win64 ABI does /not/ decompose structs passed by value across available parameter registers.!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ 	^ThreadedFFICalloutStateForX64SysV!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>identifyingPredefinedMacros (in category 'translation') -----
+ identifyingPredefinedMacros
+ 	"Answer the predefined macros that identify the platforms a subclass handles, if any.
+ 	 If the subclass isn't yet ready for production (a work in progress) simply answer nil."
+ 	^#('x86_64' '__amd64' '__x86_64' '__amd64__' '__x86_64__' '_M_AMD64' '_M_X64')!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>includingPredefinedMacros (in category 'translation') -----
+ includingPredefinedMacros
+ 	"Answer the predefined macros that qualify the platforms a subclass handles, if any.
+ 	 These are anded together and with excludingPredefinedMacros, whereas
+ 	 identifyingPredefinedMacros are ored together.
+ 	 This can be used to differentiate e.g. x64 Sys V from x64 Win64."
+ 	^#('WIN64')!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ 	WordSize := 8.
+ 	NumIntRegArgs := 6.
+ 	NumFloatRegArgs := 8!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>moduleName (in category 'translation') -----
+ moduleName
+ 	^'X64Win64FFIPlugin'!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>numFloatRegArgs (in category 'accessing') -----
+ numFloatRegArgs
+ 	^NumFloatRegArgs!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin class>>numRegArgs (in category 'accessing') -----
+ numRegArgs
+ 	^NumIntRegArgs!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin>>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)'>
+ 	"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 loadFloatRegs oop |
+ 	<var: #floatRet type: #double>
+ 	<var: #intRet type: #usqLong>
+ 	<inline: true>
+ 	self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class].
+ 	self cppIf: COGMTVM ifTrue:
+ 	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
+ 		[myThreadIndex := interpreterProxy disownVM: 0]].
+ 
+ 	self registerArgsSlop + self cStackAlignment > 0 ifTrue:
+ 		[self setsp: calloutState argVector].
+ 
+ 	calloutState floatRegisterIndex > 0 ifTrue:
+ 		[self 
+ 			load: ((calloutState floatRegisters at: 0) at: 0)
+ 			Flo: ((calloutState floatRegisters at: 1) at: 0)
+ 			at: ((calloutState floatRegisters at: 2) at: 0)
+ 			Re: ((calloutState floatRegisters at: 3) at: 0)
+ 			gs: ((calloutState floatRegisters at: 4) at: 0)].
+ 
+ 	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
+ 		ifTrue:
+ 			[atomicType = FFITypeSingleFloat
+ 				ifTrue:
+ 					[floatRet := self 
+ 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long)') 
+ 						with: (calloutState integerRegisters at: 0)
+ 						with: (calloutState integerRegisters at: 1)
+ 						with: (calloutState integerRegisters at: 2)
+ 						with: (calloutState integerRegisters at: 3)]
+ 				ifFalse: "atomicType = FFITypeDoubleFloat"
+ 					[floatRet := self 
+ 						dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(long, long, long, long)') 
+ 						with: (calloutState integerRegisters at: 0)
+ 						with: (calloutState integerRegisters at: 1)
+ 						with: (calloutState integerRegisters at: 2)
+ 						with: (calloutState integerRegisters at: 3)]]
+ 		ifFalse:
+ 			[intRet := self 
+ 				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(long, long, long, long)') 
+ 				with: (calloutState integerRegisters at: 0)
+ 				with: (calloutState integerRegisters at: 1)
+ 				with: (calloutState integerRegisters at: 2)
+ 				with: (calloutState integerRegisters at: 3)].
+ 	"undo any callee argument pops because it may confuse stack management with the alloca."
+ 	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
+ 		[self setsp: calloutState argVector].
+ 
+ 	self cppIf: COGMTVM ifTrue:
+ 	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
+ 		[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:
+ 				[oop := self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
+ 			ifFalse:
+ 				[oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
+ 		 ^oop].
+ 	
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
+ 		ifTrue:
+ 			[oop := interpreterProxy floatObjectOf: floatRet]
+ 		ifFalse:
+ 			[oop := self ffiCreateIntegralResultOop: intRet
+ 						ofAtomicType: atomicType
+ 						in: calloutState].
+ 	^interpreterProxy methodReturnValue: oop!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
+ ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
+ 	<var: #pointer type: #'void *'>
+ 	<var: #argSpec type: #'sqInt *'>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: true>
+ 	structSize <= 0 ifTrue:
+ 		[^FFIErrorStructSize].
+ 	(structSize <= 16
+ 	 and: [(structSize bitAnd: structSize - 1) = 0 "a.k.a. structSize isPowerOfTwo"]) ifTrue:
+ 		[^self ffiPushUnsignedLongLong: (self cCoerceSimple: pointer to: #usqLong) in: calloutState].
+ 
+ 	"For now just push the pointer; we should copy the struct to the outgoing stack frame!!!!"
+ 	self flag: 'quick hack'.
+ 	^self ffiPushPointer: pointer in: calloutState!

Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ 	"Answer if a struct result of a given size is returned in memory or not."
+ 	^returnStructSize <= WordSize!

Item was changed:
  ----- Method: VMClass>>oopForPointer: (in category 'memory access') -----
  oopForPointer: pointerOrSurrogate
  	"This gets implemented by Macros in C, where its types will also be checked.
  	 oop is the width of a machine word, and pointer is a raw address."
  	<doNotGenerate>
+ 	^pointerOrSurrogate asInteger!
- 	^pointerOrSurrogate!

Item was changed:
  ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') -----
  generateVMPlugins
  	^VMMaker
  		generatePluginsTo: (FileDirectory default pathFromURI: self sourceTree, '/src')
  		options: #()
  		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
  		including:#(	ADPCMCodecPlugin AsynchFilePlugin
  					BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation
  					BochsIA32Plugin BochsX64Plugin
  					CameraPlugin CroquetPlugin DSAPlugin DeflatePlugin DropPlugin
  					"FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin
  					GeniePlugin GdbARMPlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin
  					JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
  					LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
  					MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin
  					ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin
  					SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin
+ 					ThreadedFFIPlugin ThreadedARMFFIPlugin ThreadedIA32FFIPlugin ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
- 					ThreadedFFIPlugin ThreadedARMFFIPlugin ThreadedIA32FFIPlugin
  					UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin
  					Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin
  					XDisplayControlPlugin)!

Item was removed:
- ----- Method: VMPluginCodeGenerator>>preDeclareExternFunction:on: (in category 'C code generator') -----
- preDeclareExternFunction: tMethod on: aStream
- 	self withOptionalVerbiageFor: tMethod selector
- 		on: aStream
- 		do: [aStream cr.
- 			tMethod static: false; export: false; emitCFunctionPrototype: aStream generator: self.
- 			aStream nextPut: $;]
- 		ifOptionalDo:
- 			[aStream cr; nextPutAll: '# define '.
- 			 (TSendNode new
- 				setSelector: tMethod selector
- 					receiver: (TVariableNode new setName: 'interpreterProxy')
- 						arguments: (tMethod args collect: [:a| TVariableNode new setName: a]))
- 				emitCCodeAsArgumentOn: aStream
- 					level: 0
- 						generator: self.
- 			 aStream nextPutAll: ' 0']	!

Item was removed:
- ----- Method: VMPluginCodeGenerator>>preDeclareStaticFunction:on: (in category 'C code generator') -----
- preDeclareStaticFunction: tMethod on: aStream
- 	| functionName |
- 	functionName := self cFunctionNameFor: tMethod selector.
- 	self withOptionalVerbiageFor: tMethod selector
- 		on: aStream
- 		do: 
- 			[aStream cr; nextPutAll:
- 				((String streamContents: 
- 					[:s|
- 						tMethod
- 							static: true;
- 							emitCFunctionPrototype: s generator: self])
- 					copyReplaceAll: functionName
- 					with: '(*', functionName, ')'
- 					tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]]).
- 			aStream nextPut: $;]
- 		ifOptionalDo: [aStream cr; nextPutAll: '# define '.
- 			 (TSendNode new
- 				setSelector: tMethod selector
- 					receiver: (TVariableNode new setName: 'interpreterProxy')
- 						arguments: (tMethod args collect: [:a| TVariableNode new setName: a]))
- 				emitCCodeAsArgumentOn: aStream
- 					level: 0
- 						generator: self.
- 			 aStream nextPutAll: ' 0'].	
- !

Item was removed:
- ----- Method: VMPluginCodeGenerator>>withOptionalVerbiageFor:on:do: (in category 'C translation') -----
- withOptionalVerbiageFor: selector on: aStream do: mainBlock
- 	^ self 
- 		withOptionalVerbiageFor: selector 
- 		on: aStream 
- 		do: mainBlock 
- 		ifOptionalDo: nil		!



More information about the Vm-dev mailing list