[Vm-dev] VM Maker: VMMaker.oscog-mt.3040.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Aug 17 10:17:23 UTC 2021 

Marcel Taeumel uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-mt.3040.mcz

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

Name: VMMaker.oscog-mt.3040
Author: mt
Time: 17 August 2021, 12:17:08.912505 pm
UUID: 1bacb016-6198-ae4c-8ada-6de9a5db8b55
Ancestors: VMMaker.oscog-mt.3039

Complements FFI-Pools-mt34 and FFI-Kernel-mt.207.

Current version of the FFI plugin is 1. Changes to the atomic-type codes or known classes in special-objects array should bump that version number so that image code can adapt.

=============== Diff against VMMaker.oscog-mt.3039 ===============

Item was changed:
  ----- Method: FFIPlugin>>ffiAtomicArgByReference:Class: (in category 'callout support') -----
  ffiAtomicArgByReference: oop Class: oopClass
  	"Support for generic callout. Prepare a pointer reference to an atomic type for callout. Note: for type 'void*' we allow either one of ByteArray/String/Symbol or wordVariableSubclass."
  	| atomicType isString |
  	<inline: true>
  	atomicType := self atomicTypeOf: ffiArgHeader.
  	(atomicType = FFITypeBool) "No bools on input"
  		ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
+ 	((atomicType >> 1) = (FFITypeSignedChar8 >> 1)) ifTrue:["string value (char*)"
- 	((atomicType >> 1) = (FFITypeSignedChar >> 1)) ifTrue:["string value (char*)"
  		"note: the only types allowed for passing into char* types are
  		ByteArray, String, Symbol and *no* other byte indexed objects
  		(e.g., CompiledMethod, LargeInteger). We only check for strings
  		here and fall through to the byte* check otherwise."
  		isString := interpreterProxy 
  					includesBehavior: oopClass 
  					ThatOf: interpreterProxy classString.
  		isString ifTrue:["String/Symbol"
  			"Strings must be allocated by the ffi support code"
  			^self ffiPushString: (self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'int') OfLength: (interpreterProxy byteSizeOf: oop)].
  		"Fall through to byte* test"
  		atomicType := FFITypeUnsignedInt8].
  
  	(atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedInt8 >> 1)]) ifTrue:[
  		"byte* -- see comment on string above"
  		oopClass = interpreterProxy classByteArray ifTrue:["ByteArray"
  			^self ffiPushPointer: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int')].
  		isString := interpreterProxy includesBehavior: oopClass 
  					ThatOf: interpreterProxy classString.
  		isString ifTrue:["String/Symbol"
  			^self ffiPushPointer: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int')].
  		atomicType = FFITypeVoid ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
  		"note: type void falls through"
  	].
  
  	(atomicType <= FFITypeSignedInt32 "void/short/int"
  		or:[atomicType = FFITypeSingleFloat]) ifTrue:[
  			"require a word subclass to work"
  			(interpreterProxy isWords: oop) ifTrue:[
  				^self ffiPushPointer: (self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int')]].
  
  	^self ffiFail: FFIErrorCoercionFailed.!

Item was changed:
  ----- Method: FFIPlugin>>ffiCreateReturnPointer: (in category 'callout support') -----
  ffiCreateReturnPointer: retVal
  	"Generic callout support. Create a pointer return value from an external function call"
  	| atomicType retOop oop ptr classOop |
  	<var: #ptr type:'int *'>
  	interpreterProxy failed ifTrue:[^nil].
  	interpreterProxy pop: interpreterProxy methodArgumentCount+1.
  	(ffiRetClass == interpreterProxy nilObject) ifTrue:[
  		"Create ExternalData upon return"
  		atomicType := self atomicTypeOf: ffiRetHeader.
+ 		(atomicType >> 1) = (FFITypeSignedChar8 >> 1) ifTrue:["String return"
- 		(atomicType >> 1) = (FFITypeSignedChar >> 1) ifTrue:["String return"
  			^self ffiReturnCStringFrom: retVal].
  		"generate external data"
  		interpreterProxy pushRemappableOop: ffiRetOop.
  		oop := interpreterProxy 
  				instantiateClass: interpreterProxy classExternalAddress 
  				indexableSize: 4.
  		ptr := interpreterProxy firstIndexableField: oop.
  		ptr at: 0 put: retVal.
  		interpreterProxy pushRemappableOop: oop. "preserve for gc"
  		retOop := interpreterProxy 
  				instantiateClass: interpreterProxy classExternalData 
  				indexableSize: 0.
  		oop := interpreterProxy popRemappableOop. "external address"
  		interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  		oop := interpreterProxy popRemappableOop. "return type"
  		interpreterProxy storePointer: 1 ofObject: retOop withValue: oop.
  		^interpreterProxy push: retOop.
  	].
  	"non-atomic pointer return"
  	interpreterProxy pushRemappableOop: ffiRetClass. "preserve for gc"
  	(ffiRetHeader anyMask: FFIFlagStructure)
  		ifTrue:[classOop := interpreterProxy classByteArray]
  		ifFalse:[classOop := interpreterProxy classExternalAddress].
  	oop := interpreterProxy 
  			instantiateClass: classOop
  			indexableSize: 4.
  	ptr := interpreterProxy firstIndexableField: oop.
  	ptr at: 0 put: retVal.
  	ffiRetClass := interpreterProxy popRemappableOop. "return class"
  	interpreterProxy pushRemappableOop: oop. "preserve for gc"
  	retOop := interpreterProxy instantiateClass: ffiRetClass indexableSize: 0.
  	oop := interpreterProxy popRemappableOop. "external address"
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^interpreterProxy push: retOop.!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiAtomicArgByReference:Class:in: (in category 'callout support') -----
  ffiAtomicArgByReference: oop Class: oopClass in: calloutState
  	<var: #calloutState type: #'CalloutState *'>
  	"Support for generic callout. Prepare a pointer reference to an atomic type for callout.
  	 Note: 
  		for type 'void*' we allow ByteArray/String/Symbol, wordVariableSubclass, Alien or ExternalAddress.
  		for other types we allow ByteArray, wordVariableSubclass, Alien or ExternalAddress."
  	| atomicType isString argIsAlien |
  	<inline: #always>
  	atomicType := self atomicTypeOf: calloutState ffiArgHeader.
  	(atomicType = FFITypeBool) ifTrue: "No bools on input"
  		[^FFIErrorCoercionFailed].
  	argIsAlien := (isString := interpreterProxy 
  								includesBehavior: oopClass 
  								ThatOf: interpreterProxy classString)
  					ifTrue: [false]
  					ifFalse:
  						[interpreterProxy 
  							includesBehavior: oopClass 
  							ThatOf: interpreterProxy classAlien].
+ 	((atomicType >> 1) = (FFITypeSignedChar8 >> 1)) ifTrue:"string value (char*)"
- 	((atomicType >> 1) = (FFITypeSignedChar >> 1)) ifTrue:"string value (char*)"
  		"note: the only types allowed for passing into char* types are
  		ByteArray, String, Symbol, Alien and *no* other byte indexed objects
  		(e.g., CompiledMethod, LargeInteger). We only check for strings
  		here and fall through to the byte* check otherwise."
  		[isString ifTrue:"String/Symbol"
  			"Strings must be allocated by the ffi support code"
  			[^self ffiPushString: (interpreterProxy firstIndexableField: oop)
  				OfLength: (interpreterProxy byteSizeOf: oop)
  				in: calloutState].
  		"Fall through to byte* test"
  		atomicType := FFITypeUnsignedInt8].
  
  	self cppIf: COGMTVM ifTrue:
  	["Since all the following pass the address of the first indexable field we need to fail
  	 the call if it is threaded and the object is young, since it may move during the call."
  	((calloutState callFlags anyMask: FFICallFlagThreaded)
  	and: [(argIsAlien not or: [self isDirectAlien: oop])
  	and: [interpreterProxy isYoung: oop]]) ifTrue:
  		[^PrimErrObjectMayMove negated]].
  
  	(atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedInt8 >> 1)]) ifTrue:
  		"byte* -- see comment on string above"
  		[(isString or: [oopClass = interpreterProxy classByteArray]) ifTrue: "String/Symbol/ByteArray"
  			[^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
  		(oopClass = interpreterProxy classExternalAddress) ifTrue: 
  			[^self ffiPushPointer: (self longAt: oop + interpreterProxy baseHeaderSize) in: calloutState].
  		argIsAlien ifTrue:
  			[^self ffiPushPointer: (self pointerForOop: (self startOfData: oop)) in: calloutState].
  		atomicType = FFITypeVoid ifFalse:
  			[^FFIErrorCoercionFailed]].
  		"note: type void falls through"
  
  	"I can push pointers to any type (take for instance calls who receive int* output arguments, etc.)
  	 but I need to store them into a ByteArray, ExternalAddress or Alien"
  	(atomicType <= FFITypeDoubleFloat) ifTrue:
  		[((interpreterProxy isWords: oop) or: [oopClass = interpreterProxy classByteArray]) ifTrue:
  			[^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
  		(oopClass = interpreterProxy classExternalAddress) ifTrue: 
  			[^self ffiPushPointer: (self longAt: oop + interpreterProxy baseHeaderSize) in: calloutState].
  		argIsAlien ifTrue:
  			[^self ffiPushPointer: (self pointerForOop: (self startOfData: oop)) in: calloutState]].
  
  	^FFIErrorCoercionFailed!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiReturnPointer:ofType:in: (in category 'callout support') -----
  ffiReturnPointer: retVal ofType: retType in: calloutState
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #retVal type: #usqLong>
  	"Generic callout support. Create a pointer return value from an external function call"
  	| retClass atomicType retOop oop ptr classOop |
  	<var: #ptr type: #'sqInt *'>
  	retClass := interpreterProxy fetchPointer: 1 ofObject: retType.
  	retClass = interpreterProxy nilObject ifTrue:
  		["Create ExternalData upon return"
  		atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ 		(atomicType >> 1) = (FFITypeSignedChar8 >> 1) ifTrue: "String return"
- 		(atomicType >> 1) = (FFITypeSignedChar >> 1) ifTrue: "String return"
  			[retOop := self ffiReturnCStringFrom: (self cCoerceSimple: retVal to: #usqInt).
  			 ^retOop].
  		"generate external data"
  		self remapOop: retType in:
  			[oop := interpreterProxy
  						instantiateClass: interpreterProxy classExternalAddress 
  						indexableSize: BytesPerWord.
  			ptr := interpreterProxy firstIndexableField: oop.
  			ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
  			self remapOop: oop in:
  				[retOop := interpreterProxy 
  								instantiateClass: interpreterProxy classExternalData 
  								indexableSize: 0].
  			interpreterProxy storePointer: 0 ofObject: retOop withValue: oop].
  		interpreterProxy storePointer: 1 ofObject: retOop withValue: retType.
  		^retOop].
  	"non-atomic pointer return"
  	classOop := (calloutState ffiRetHeader anyMask: FFIFlagStructure)
  					ifTrue:[interpreterProxy classByteArray]
  					ifFalse:[interpreterProxy classExternalAddress].
  	self remapOop: retClass in:
  		[oop := interpreterProxy 
  					instantiateClass: classOop
  					indexableSize: BytesPerWord].
  	ptr := interpreterProxy firstIndexableField: oop.
  	ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
  	self remapOop: oop in:
  		[retOop := interpreterProxy instantiateClass: retClass indexableSize: 0].
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^retOop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiValidateExternalData:AtomicType: (in category 'callout support') -----
  ffiValidateExternalData: oop AtomicType: atomicType
  	"Validate if the given oop (an instance of ExternalData) can be passed as a pointer to the given atomic type."
  	| ptrType specOop spec specType |
  	<inline: true>
  	ptrType := interpreterProxy fetchPointer: 1 ofObject: oop.
  	((interpreterProxy isPointers: ptrType)
  	and: [(interpreterProxy slotSizeOf: ptrType) >= 2]) ifFalse:
  		[^FFIErrorWrongType].
  	specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType.
  	((interpreterProxy isWords: specOop)
  	and: [(interpreterProxy slotSizeOf: specOop) > 0]) ifFalse:
  		[^FFIErrorWrongType].
  	spec := interpreterProxy fetchPointer: 0 ofObject: specOop.
  	(self isAtomicType: spec) ifFalse:
  		[^FFIErrorWrongType].
  	specType := self atomicTypeOf: spec.
  	specType ~= atomicType ifTrue:
  		"Allow for signed/unsigned conversion but nothing else.
  		 See FFIConstants class>>#initializeTypeConstants"
  		[(atomicType >= FFITypeUnsignedInt8
+ 		  and: [atomicType <= FFITypeSignedChar32
- 		  and: [atomicType <= FFITypeSignedChar
  		  and: [(atomicType >> 1) = (specType >> 1)]]) ifFalse:
  			[^FFIErrorCoercionFailed]].
  	^0!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitivePluginVersion (in category 'primitives') -----
+ primitivePluginVersion
+ 	"Answer the plugins current version to ensure compatibility with data structures shared between plugin an image code such as:
+ 		- Type codes in FFIConstants
+ 		- Known classes in the special-objects array"
+ 	<export: true flags: #FastCPrimitiveFlag>
+ 	^ interpreterProxy methodReturnInteger: 1!

More information about the Vm-dev mailing list