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

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

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

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

Name: VMMaker.oscog-eem.1687
Author: eem
Time: 20 February 2016, 12:07:16.278693 pm
UUID: fde8cc46-be93-419f-8087-ef54c0b4f237
Ancestors: VMMaker.oscog-eem.1686

Fix the signature of characterbjectOf:.

Fix slips in ThreadedFFICalloutStateForX64>>initialize.

Fix 32-bit int vs 64-bit pointers issues in primitiveFFI[Allocate|Free].

Get X64SysVFFI plugin to deal with sixteen byte struct return.

=============== Diff against VMMaker.oscog-eem.1686 ===============

Item was changed:
  ----- Method: InterpreterProxy>>characterObjectOf: (in category 'object access') -----
  characterObjectOf: characterCode
  	<option: #(atLeastVMProxyMajor:minor: 1 13)>
+ 	<var: #cPtr type: #int>
  	^StackInterpreter objectMemoryClass characterObjectOf: characterCode!

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

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCheckReturn:With:in: (in category 'callout support') -----
  ffiCheckReturn: retSpec With: retClass in: calloutState
  	<var: #calloutState type: #'CalloutState *'>
  	"Make sure we can return an object of the given type"
  	<inline: true>
+ 	retClass = interpreterProxy nilObject ifFalse:
+ 		[(interpreterProxy
+ 				includesBehavior: retClass 
+ 				ThatOf: interpreterProxy classExternalStructure) ifFalse:
+ 			[^FFIErrorBadReturn]].
- 	| ffiRetSpec |
- 	retClass = interpreterProxy nilObject ifFalse:[
- 		(interpreterProxy includesBehavior: retClass 
- 						ThatOf: interpreterProxy classExternalStructure)
- 			ifFalse:[^FFIErrorBadReturn]].
  
+ 	((interpreterProxy isWords: retSpec)
+ 	 and: [(interpreterProxy slotSizeOf: retSpec) > 0]) ifFalse:
+ 		[^FFIErrorWrongType].
+ 
+ 	calloutState ffiRetHeader: (interpreterProxy fetchLong32: 0 ofObject: retSpec).
+ 	(self isAtomicType: calloutState ffiRetHeader) ifFalse:
+ 		[retClass = interpreterProxy nilObject ifTrue:
+ 			[^FFIErrorBadReturn]].
- 	(interpreterProxy isWords: retSpec)
- 		ifFalse:[^FFIErrorWrongType].
- 	(interpreterProxy slotSizeOf: retSpec) = 0 ifTrue:[^FFIErrorWrongType].
- 	ffiRetSpec := self cCoerce: (interpreterProxy firstIndexableField: retSpec) to: #int.
- 	calloutState ffiRetHeader: (interpreterProxy longAt: ffiRetSpec).
- 	(self isAtomicType: calloutState ffiRetHeader) ifFalse:[
- 		(retClass = interpreterProxy nilObject)
- 			ifTrue:[^FFIErrorBadReturn]].
  	(calloutState ffiRetHeader bitAnd: (FFIFlagPointer bitOr: FFIFlagStructure)) = FFIFlagStructure ifTrue:
  		[calloutState structReturnSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask)].
  	^0!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIAllocate (in category 'primitives') -----
  primitiveFFIAllocate
  	"Primitive. Allocate an object on the external heap."
  	| byteSize addr oop ptr |
  	<export: true>
  	<inline: false>
+ 	<var: #ptr type: #'long *'>
- 	<var: #ptr type:'int *'>
  	byteSize := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue:
+ 		[^nil].
- 	interpreterProxy failed ifTrue:[^nil].
  	addr := self ffiAlloc: byteSize.
+ 	addr = 0 ifTrue:
+ 		[^interpreterProxy primitiveFail].
- 	addr = 0 ifTrue:[^interpreterProxy primitiveFail].
  	oop := interpreterProxy 
  			instantiateClass: interpreterProxy classExternalAddress 
+ 			indexableSize: (self sizeof: #long).
- 			indexableSize: 4.
  	ptr := interpreterProxy firstIndexableField: oop.
  	ptr at: 0 put: addr.
  	^interpreterProxy pop: 2 thenPush: oop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIFree (in category 'primitives') -----
  primitiveFFIFree
  	"Primitive. Free the object pointed to on the external heap."
  	| addr oop ptr |
  	<export: true>
  	<inline: false>
+ 	<var: #ptr type: #'long *'>
- 	<var: #ptr type:'int *'>
  	oop := interpreterProxy stackObjectValue: 0.
+ 	((interpreterProxy fetchClassOf: oop) = interpreterProxy classExternalAddress
+ 	 and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #long)]) ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy failed ifTrue:[^nil].
- 	(interpreterProxy fetchClassOf: oop) = (interpreterProxy classExternalAddress)
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	(interpreterProxy byteSizeOf: oop) = 4
- 		ifFalse:[^interpreterProxy primitiveFail].
  	ptr := interpreterProxy firstIndexableField: oop.
  	addr := ptr at: 0.
  	"Don't you dare to free Squeak's memory!!"
+ 	(addr = 0
+ 	 or: [(addr asUnsignedLong bitAnd: (self sizeof: #long) - 1) ~= 0
+ 	 or: [interpreterProxy isInMemory: addr]]) ifTrue:
+ 		[^interpreterProxy primitiveFail].
- 	(addr = 0 or:[interpreterProxy isInMemory: addr])
- 		ifTrue:[^interpreterProxy primitiveFail].
  	self ffiFree: addr.
+ 	^ptr at: 0 put: 0 "cleanup"!
- 	^ptr at: 0 put: 0. "cleanup"
- !

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveLoadSymbolFromModule (in category 'primitives') -----
  primitiveLoadSymbolFromModule
  	"Attempt to find the address of a symbol in a loaded library.
  	loadSymbol: aSymbol fromModule: moduleName
  		<primitive: 'primitiveLoadSymbolFromModule' error: errorCode module: 'SqueakFFIPrims'>
  	"
  	<export: true>
  
  	| symbol module moduleHandle address oop ptr |
  
  	<var: #address type: #'void *'>
  	<var: #ptr type:'unsigned int *'>
  	
  	interpreterProxy methodArgumentCount = 2 ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].	
  
  	module := interpreterProxy stackValue: 0.
  	symbol := interpreterProxy stackValue: 1.
  
  	moduleHandle := self ffiLoadCalloutModule: module.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNotFound].
  	address := interpreterProxy
  		ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: symbol) to: #sqInt)
  		OfLength: (interpreterProxy byteSizeOf: symbol)
  		FromModule: moduleHandle.
  	(interpreterProxy failed
  	 or: [address = 0]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNotFound].
  	
  	oop := interpreterProxy 
  		instantiateClass: interpreterProxy classExternalAddress 
  		indexableSize: 4.
  	ptr := interpreterProxy firstIndexableField: oop.
  	ptr at: 0 put: address.
  	
+ 	^interpreterProxy methodReturnValue: oop!
- 	interpreterProxy methodReturnValue: oop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveSetManualSurfacePointer (in category 'primitives - surfaces') -----
  primitiveSetManualSurfacePointer
  	"Create a 'manual surface' data-structure.  See the ExternalForm class in the FFI package for example usage."
  	"arguments: name(type, stack offset)
  		surfaceID(Integer, 1)
+ 		ptr(uint32/uint64, 0)"
- 		ptr(uint32, 0)"
  	| surfaceID ptr result |
  	<export: true>
+ 	<var: #ptr type: #'unsigned long'>
- 	<var: #ptr type: #'unsigned int'>
  	
+ 	interpreterProxy methodArgumentCount = 2 ifFalse: [^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount == 2 ifFalse: [^interpreterProxy primitiveFail].
  	surfaceID := interpreterProxy stackIntegerValue: 1.
+ 	ptr := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
- 	ptr := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
  	interpreterProxy failed ifTrue: [^nil].
  
  	self touch: surfaceID; touch: ptr.
  	
+ 	result := self setManualSurface: surfaceID Pointer: ptr asVoidPointer.
- 	result := self cCode: 'setManualSurfacePointer(surfaceID, (void*)ptr)'.
  	result = 0 ifTrue: [^interpreterProxy primitiveFail].
  	^interpreterProxy pop: 2
  	!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturn class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ 	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BlockStart struct."
+ 
+ 	self instVarNames do:
+ 		[:ivn|
+ 		aBinaryBlock value: ivn value: #sqInt]!

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

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

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

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

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin class>>ancilliaryClasses: (in category 'translation') -----
+ ancilliaryClasses: options
+ 	^{ self calloutStateClass. ThreadedFFIX64SixteenByteReturn }!

Item was changed:
  ----- 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: 'SixteenByteReturn'>
  	<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)
  			Flo: (calloutState floatRegisters at: 1)
  			a: (calloutState floatRegisters at: 2)
  			t: (calloutState floatRegisters at: 3)
  			R: (calloutState floatRegisters at: 4)
  			e: (calloutState floatRegisters at: 5)
  			g: (calloutState floatRegisters at: 6)
  			s: (calloutState floatRegisters at: 7)].
  
  	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: 'SixteenByteReturn (*)(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 a ofType: (self ffiReturnType: specOnStack) in: calloutState]
- 				[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 a
- 			[oop := self ffiCreateIntegralResultOop: intRet
  						ofAtomicType: atomicType
  						in: calloutState].
  	^interpreterProxy methodReturnValue: oop!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: sixteenByteRet ofType: ffiRetType in: calloutState
  	<var: #sixteenByteRet type: 'SixteenByteReturn'>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value has been stored in
  	 alloca'ed space pointed to by the calloutState or in the return value."
  	| retOop retClass oop |
  	<inline: true>
  	retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
  	retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
  	self remapOop: retOop
  		in: [oop := interpreterProxy 
  					instantiateClass: interpreterProxy classByteArray 
  					indexableSize: calloutState structReturnSize].
  	self mem: (interpreterProxy firstIndexableField: oop)
  		cp: ((self returnStructInRegisters: calloutState structReturnSize)
+ 				ifTrue: [(self addressOf: sixteenByteRet) asVoidPointer]
- 				ifTrue: [self addressOf: sixteenByteRet]
  				ifFalse: [calloutState limit])
  		 y: calloutState structReturnSize.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^interpreterProxy methodReturnValue: retOop!

More information about the Vm-dev mailing list