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

commits at source.squeak.org commits at source.squeak.org
Wed Jul 8 18:26:14 UTC 2015


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

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

Name: VMMaker.oscog-eem.1408
Author: eem
Time: 8 July 2015, 11:24:12.884 am
UUID: 51bc4e0f-a338-4394-8c6a-22b4b3e07c61
Ancestors: VMMaker.oscog-eem.1407

ThreadedFFIPlugin:
Allow ffiCreateIntegralResultOop:ofAtomicType:in: to be inlined.  reduce the number of tests leading to the common case of an integral return in ffiCalloutTo:SpecOnStack:in: etc.

Refactor the remapOop:in: idiom up into InterpreterPlugin and use it in the ThreadedFFIPlugin.

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

Item was added:
+ ----- Method: InterpreterPlugin>>remapOop:in: (in category 'simulation') -----
+ remapOop: oopOrList in: aBlock
+ 	"Call remapOop: for the variable oopOrList (or all of the variables in oopOrList) before evaluating
+ 	 aBlock, and restore them after.  If this is Spur, do nothing, since Spur does not GC on allocation
+ 	 and the  SmartSyntaxPluginCodeGenerator generates null code for this op in Spur."
+ 	<doNotGenerate>
+ 	| ctxt tempNames tempIndices |
+ 	interpreterProxy hasSpurMemoryManagerAPI ifTrue:
+ 		[^aBlock value].
+ 	ctxt := thisContext sender.
+ 	tempNames := ctxt tempNames.
+ 	oopOrList isArray
+ 		ifTrue:
+ 			[tempIndices := oopOrList collect: [:tempName| tempNames indexOf: tempName].
+ 			 tempIndices do:
+ 				[:index| interpreterProxy pushRemappableOop: (ctxt namedTempAt: index)]]
+ 		ifFalse: [interpreterProxy pushRemappableOop: oopOrList].
+ 	^aBlock ensure:
+ 		[oopOrList isArray
+ 			ifTrue:
+ 				[tempIndices reverseDo:
+ 					[:index| ctxt namedTempAt: index put: interpreterProxy popRemappableOop]]
+ 			ifFalse:
+ 				[1 to: ctxt numTemps do:
+ 					[:index|
+ 					(ctxt tempAt: index) = oopOrList ifTrue:
+ 						[ctxt tempAt: index put: interpreterProxy topRemappableOop]].
+ 				 interpreterProxy popRemappableOop]]!

Item was removed:
- ----- Method: Object>>remapOop:in: (in category '*VMMaker-translation support') -----
- remapOop: oopOrList in: aBlock
- 	"For translation only; noop when running in Smalltalk."
- 	^aBlock value!

Item was removed:
- ----- Method: SmartSyntaxInterpreterPlugin>>remapOop:in: (in category 'simulation') -----
- remapOop: oopOrList in: aBlock
- 	"Call remapOop: for the variable oopOrList (or all of the variables in oopOrList) before evaluating
- 	 aBlock, and restore them after.  If this is Spur, do nothing, since Spur does not GC on allocation
- 	 and the  SmartSyntaxPluginCodeGenerator generates null code for this op in Spur."
- 	<doNotGenerate>
- 	| ctxt tempNames tempIndices |
- 	interpreterProxy hasSpurMemoryManagerAPI ifTrue:
- 		[^aBlock value].
- 	ctxt := thisContext sender.
- 	tempNames := ctxt tempNames.
- 	oopOrList isArray
- 		ifTrue:
- 			[tempIndices := oopOrList collect: [:tempName| tempNames indexOf: tempName].
- 			 tempIndices do:
- 				[:index| interpreterProxy pushRemappableOop: (ctxt namedTempAt: index)]]
- 		ifFalse: [interpreterProxy pushRemappableOop: oopOrList].
- 	^aBlock ensure:
- 		[oopOrList isArray
- 			ifTrue:
- 				[tempIndices reverseDo:
- 					[:index| ctxt namedTempAt: index put: interpreterProxy popRemappableOop]]
- 			ifFalse:
- 				[1 to: ctxt numTemps do:
- 					[:index|
- 					(ctxt tempAt: index) = oopOrList ifTrue:
- 						[ctxt tempAt: index put: interpreterProxy topRemappableOop]].
- 				 interpreterProxy popRemappableOop]]!

Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'translating builtins') -----
- generateRemapOopIn: aNode on: aStream indent: level
- 	"Generate the C code for this message onto the given stream."
- 
- 	aStream cr; nextPutAll: '#if SPURVM'; cr.
- 	self generateSpurRemapOopIn: aNode on: aStream indent: level.
- 	aStream cr; nextPutAll: '#else /* SPURVM */'; cr.
- 	self generateV3RemapOopIn: aNode on: aStream indent: level.
- 	aStream cr; nextPutAll: '#endif /* SPURVM */'; cr!

Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateSpurRemapOopIn:on:indent: (in category 'translating builtins') -----
- generateSpurRemapOopIn: aNode on: aStream indent: level
- 	"Generate just the block argument for this message as Spur does not GC on allocation."
- 
- 	aNode args second emitCCodeOn: aStream level: level generator: self!

Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateV3RemapOopIn:on:indent: (in category 'translating builtins') -----
- generateV3RemapOopIn: aNode on: aStream indent: level
- 	"Generate call on remapOop: for the variable oopOrList (or all of the
- 	 variables in oopOrList) before evaluating aBlock, and restore them after.
- 	 This keeps the oops valid if, as V3 will, there is a GC on allocation."
- 
- 	| idList |
- 	pluginFunctionsUsed add: #pushRemappableOop:; add: #popRemappableOop.
- 	idList := aNode args first nameOrValue.
- 	idList class == Array ifFalse: [idList := Array with: idList].
- 	idList do:
- 		[:each | 
- 		 aStream 
- 			nextPutAll: 'pushRemappableOop(';
- 			nextPutAll: each asString;
- 			nextPutAll: ');']
- 		separatedBy: [aStream crtab: level].
- 	aStream cr.
- 	aNode args second emitCCodeOn: aStream level: level generator: self.
- 	level timesRepeat: [aStream tab].
- 	idList reversed do:
- 		[:each |
- 		 aStream 
- 			nextPutAll: each asString;
- 			nextPutAll: ' = popRemappableOop()']
- 		separatedBy: [aStream nextPut: $;; crtab: level]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>initializeCTranslationDictionary (in category 'translating builtins') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	super initializeCTranslationDictionary.
  	pairs := #(
  		#asCInt						#generateAsCInt:on:indent:
  		#asCUnsigned				#generateAsCUnsigned:on:indent:
  		#asCBoolean					#generateAsCBoolean:on:indent:
  		#asCDouble					#generateAsCDouble:on:indent:
  
  		#asSmallIntegerObj			#generateAsSmallIntegerObj:on:indent:
  		#asPositiveIntegerObj		#generateAsPositiveIntegerObj:on:indent:
  		#asBooleanObj				#generateAsBooleanObj:on:indent:
  		#asFloatObj					#generateAsFloatObj:on:indent:
  
  		#asIf:var:					#generateAsIfVar:on:indent:
  		#asIf:var:asValue:			#generateAsIfVarAsValue:on:indent:
  		#asIf:var:put:				#generateAsIfVarPut:on:indent:
  		#field:						#generateField:on:indent:
  		#field:put:					#generateFieldPut:on:indent:
  		
  		#class						#generateClass:on:indent:
  
  		#stSize						#generateStSize:on:indent:
  		#stAt:						#generateStAt:on:indent:
  		#stAt:put:					#generateStAtPut:on:indent:
  
  		#asCharPtr					#generateAsCharPtr:on:indent:
  		#asIntPtr					#generateAsIntPtr:on:indent:
  		#cPtrAsOop					#generateCPtrAsOop:on:indent:
  		#next						#generateNext:on:indent:
  
  		#asOop:						#generateAsOop:on:indent:
  		#asValue:					#generateAsValue:on:indent:
  
  		#isFloat						#generateIsFloat:on:indent:
  		#isIndexable					#generateIsIndexable:on:indent:
  		#isIntegerOop				#generateIsIntegerOop:on:indent:
  		#isIntegerValue				#generateIsIntegerValue:on:indent:
  		"#FloatOop					#generateIsFloatValue:on:indent:"		"unused, never implemented"
  		#isWords					#generateIsWords:on:indent:
  		#isWordsOrBytes				#generateIsWordsOrBytes:on:indent:
  		#isPointers					#generateIsPointers:on:indent:
  		#isNil						#generateIsNil:on:indent:
  		#isMemberOf:				#generateIsMemberOf:on:indent:
  		#isKindOf:					#generateIsKindOf:on:indent:
  
  		#fromStack:					#generateFromStack:on:indent:
  		"#clone						#generateClone:on:indent:"				"unused, never implemented"
  		"#new						#generateNew:on:indent:"				"unused, never implemented"
  		"#new:						#generateNewSize:on:indent:"			"unused, never implemented"
  		"#superclass					#generateSuperclass:on:indent:"	"unused, never implemented"
- 		#remapOop:in:				#generateRemapOopIn:on:indent:
  		#debugCode:					#generateDebugCode:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

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 |
- 	| myThreadIndex atomicType floatRet intRet loadFloatRegs |
  	<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)].
- 	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)
- 	atomicType = FFITypeSingleFloat
  		ifTrue:
+ 			[atomicType = FFITypeSingleFloat
+ 				ifTrue:
+ 					[floatRet := self 
+ 						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 (*)(int, int, int, int)') 
+ 						with: (calloutState integerRegisters at: 0)
+ 						with: (calloutState integerRegisters at: 1)
+ 						with: (calloutState integerRegisters at: 2)
+ 						with: (calloutState integerRegisters at: 3)]]
- 			[floatRet := self 
- 				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)].
- 	 atomicType = FFITypeDoubleFloat
- 		ifTrue:
- 			[floatRet := self 
- 				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 (*)(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:
+ 				[self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
+ 			ifFalse:
+ 				[self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]].
- 	"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].
- 
- 	(calloutState ffiRetHeader anyMask: FFIFlagStructure) ifTrue:
- 		[^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  	
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
+ 		ifTrue:
+ 			[oop := interpreterProxy floatObjectOf: floatRet]
+ 		ifFalse:
+ 			[oop := self ffiCreateIntegralResultOop: intRet
+ 						ofAtomicType: atomicType
+ 						in: calloutState].
+ 	^interpreterProxy methodReturnValue: oop!
- 	(atomicType = FFITypeSingleFloat
- 	 or: [atomicType = FFITypeDoubleFloat]) ifTrue:
- 		[^interpreterProxy methodReturnValue: (interpreterProxy floatObjectOf: floatRet)].
- 
- 	^interpreterProxy methodReturnValue: (self ffiCreateIntegralResultOop: intRet
- 												ofAtomicType: atomicType
- 												in: calloutState)!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
  	<var: #longLongRet type: #usqLong>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value as been stored in
  	 alloca'ed space pointed to by the calloutState."
  	| 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].
- 	interpreterProxy pushRemappableOop: retOop.
- 	oop := interpreterProxy 
- 			instantiateClass: interpreterProxy classByteArray 
- 			indexableSize: calloutState structReturnSize.
  	(self returnStructInRegisters: calloutState structReturnSize)
  		ifTrue:
  			[self mem: (interpreterProxy firstIndexableField: oop) cp: (self addressOf: longLongRet) y: calloutState structReturnSize]
  		ifFalse:
  			[self mem: (interpreterProxy firstIndexableField: oop) cp: calloutState limit y: calloutState structReturnSize].
- 	retOop := interpreterProxy popRemappableOop.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^interpreterProxy methodReturnValue: retOop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') -----
  ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState
+ 	<inline: true>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #retVal type: #usqLong>
  	"Callout support. Return the appropriate oop for the given atomic type"
  	| shift value mask byteSize |
  	self assert: atomicType < FFITypeSingleFloat.
  
+ 	atomicType = FFITypeBool ifTrue:
+ 		["Make sure bool honors the byte size requested"
+ 		 byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
+ 		 value := byteSize = (self sizeof: retVal)
+ 					ifTrue:[retVal]
+ 					ifFalse:[retVal bitAnd: 1 << (byteSize * 8) - 1].
+ 		 ^value = 0
+ 			ifTrue:[interpreterProxy falseObject]
+ 			ifFalse:[interpreterProxy trueObject]].
+ 	atomicType <= FFITypeSignedInt ifTrue:
+ 		["these are all generall integer returns"
+ 		atomicType <= FFITypeSignedShort ifTrue:
+ 			["byte/short. first extract partial word, then sign extend"
- 	atomicType = FFITypeBool ifTrue:[
- 			"Make sure bool honors the byte size requested"
- 			byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
- 			value := byteSize = 4
- 						ifTrue:[retVal]
- 						ifFalse:[retVal bitAnd: 1 << (byteSize * 8) - 1].
- 			^value = 0
- 				ifTrue:[interpreterProxy falseObject]
- 				ifFalse:[interpreterProxy trueObject]].
- 	atomicType <= FFITypeSignedInt ifTrue:[
- 		"these are all generall integer returns"
- 		atomicType <= FFITypeSignedShort ifTrue:[
- 			"byte/short. first extract partial word, then sign extend"
  			shift := (atomicType >> 1) * 8. "# of significant bits"
  			value := retVal bitAnd: (1 << shift - 1). 
+ 			(atomicType anyMask: 1) ifTrue:
+ 				["make the guy signed"
- 			(atomicType anyMask: 1) ifTrue:[
- 				"make the guy signed"
  				mask := 1 << (shift-1).
  				value := (value bitAnd: mask-1) - (value bitAnd: mask)].
  			^interpreterProxy integerObjectOf: value].
  		"32bit integer return"
  		^(atomicType anyMask: 1)
  			ifTrue:[interpreterProxy signed32BitIntegerFor: retVal] "signed return"
  			ifFalse:[interpreterProxy positive32BitIntegerFor: retVal]]. "unsigned return"
  
  	"longlong, char"
  	^(atomicType >> 1) = (FFITypeSignedLongLong >> 1) 
  		ifTrue:
  			[(atomicType anyMask: 1)
  				ifTrue:[interpreterProxy signed64BitIntegerFor: retVal] "signed return"
  				ifFalse:[interpreterProxy positive64BitIntegerFor: retVal]]
  		ifFalse:
  			[interpreterProxy characterObjectOf:
  				(retVal bitAnd: (self cppIf: #SPURVM
  									ifTrue: [16rFFFFFFFF]
  									ifFalse: [255]))]!

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) = (FFITypeSignedChar >> 1) ifTrue: "String return"
  			[^self ffiReturnCStringFrom: (self cCoerceSimple: retVal to: #usqInt)].
  		"generate external data"
+ 		self remapOop: retType in:
+ 			[oop := interpreterProxy
+ 						instantiateClass: interpreterProxy classExternalAddress 
+ 						indexableSize: 4.
+ 			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.
- 		interpreterProxy pushRemappableOop: retType.
- 		oop := interpreterProxy 
- 				instantiateClass: interpreterProxy classExternalAddress 
- 				indexableSize: 4.
- 		ptr := interpreterProxy firstIndexableField: oop.
- 		ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
- 		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 methodReturnValue: retOop].
  	"non-atomic pointer return"
- 	interpreterProxy pushRemappableOop: retClass. "preserve for gc"
  	classOop := (calloutState ffiRetHeader anyMask: FFIFlagStructure)
  					ifTrue:[interpreterProxy classByteArray]
  					ifFalse:[interpreterProxy classExternalAddress].
+ 	self remapOop: retClass in:
+ 		[oop := interpreterProxy 
+ 					instantiateClass: classOop
+ 					indexableSize: 4].
- 	oop := interpreterProxy 
- 			instantiateClass: classOop
- 			indexableSize: 4.
  	ptr := interpreterProxy firstIndexableField: oop.
  	ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
+ 	self remapOop: oop in:
+ 		[retOop := interpreterProxy instantiateClass: retClass indexableSize: 0].
- 	retClass := interpreterProxy popRemappableOop. "return class"
- 	interpreterProxy pushRemappableOop: oop. "preserve for gc"
- 	retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
- 	oop := interpreterProxy popRemappableOop. "external address"
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^interpreterProxy methodReturnValue: retOop!

Item was changed:
  ----- Method: ThreadedIA32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  	<var: #procAddr type: #'void *'>
  	<var: #calloutState type: #'CalloutState *'>
  	"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 oop |
- 	| myThreadIndex atomicType floatRet intRet |
  	<var: #floatRet type: #double>
  	<var: #intRet type: #usqLong>
  	<inline: true>
  	self cppIf: COGMTVM ifTrue:
  	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
  		[myThreadIndex := interpreterProxy disownVM: 0]].
  
  	self registerArgsSlop + self cStackAlignment > 0 ifTrue:
  		[self setsp: calloutState argVector].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
- 	(atomicType = FFITypeSingleFloat
- 	 or: [atomicType = FFITypeDoubleFloat])
  		ifTrue:
  			[floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)()')]
  		ifFalse:
  			[intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)()')].
  	"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:
+ 				[self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
+ 			ifFalse:
+ 				[self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]].
- 	"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].
- 
- 	(calloutState ffiRetHeader anyMask: FFIFlagStructure) ifTrue:
- 		[^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  	
+ 	(atomicType >> 1) = (FFITypeSingleFloat > 1)
+ 		ifTrue:
+ 			[oop := interpreterProxy floatObjectOf: floatRet]
+ 		ifFalse:
+ 			[oop := self ffiCreateIntegralResultOop: intRet
+ 						ofAtomicType: atomicType
+ 						in: calloutState].
+ 	^interpreterProxy methodReturnValue: oop!
- 	(atomicType = FFITypeSingleFloat
- 	 or: [atomicType = FFITypeDoubleFloat]) ifTrue:
- 		[^interpreterProxy methodReturnValue: (interpreterProxy floatObjectOf: floatRet)].
- 
- 	^interpreterProxy methodReturnValue: (self ffiCreateIntegralResultOop: intRet
- 												ofAtomicType: atomicType
- 												in: calloutState)!

Item was changed:
  ----- Method: ThreadedIA32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
  	<var: #longLongRet type: #usqLong>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value as been stored in
  	 alloca'ed space pointed to by the calloutState."
  	| 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].
- 	interpreterProxy pushRemappableOop: retOop.
- 	oop := interpreterProxy 
- 			instantiateClass: interpreterProxy classByteArray 
- 			indexableSize: calloutState structReturnSize.
  	(self returnStructInRegisters: calloutState structReturnSize)
  		ifTrue:
  			[self mem: (interpreterProxy firstIndexableField: oop) cp: (self addressOf: longLongRet) y: calloutState structReturnSize]
  		ifFalse:
  			[self mem: (interpreterProxy firstIndexableField: oop) cp: calloutState limit y: calloutState structReturnSize].
- 	retOop := interpreterProxy popRemappableOop.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^interpreterProxy methodReturnValue: retOop!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'C translation') -----
+ generateRemapOopIn: aNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream cr; nextPutAll: '#if SPURVM'; cr.
+ 	self generateSpurRemapOopIn: aNode on: aStream indent: level.
+ 	aStream cr; nextPutAll: '#else /* SPURVM */'; cr.
+ 	self generateV3RemapOopIn: aNode on: aStream indent: level.
+ 	aStream cr; nextPutAll: '#endif /* SPURVM */'; cr!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateSpurRemapOopIn:on:indent: (in category 'C translation') -----
+ generateSpurRemapOopIn: aNode on: aStream indent: level
+ 	"Generate just the block argument for this message as Spur does not GC on allocation."
+ 
+ 	aNode args second emitCCodeOn: aStream level: level generator: self!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateV3RemapOopIn:on:indent: (in category 'C translation') -----
+ generateV3RemapOopIn: aNode on: aStream indent: level
+ 	"Generate call on remapOop: for the variable oopOrList (or all of the
+ 	 variables in oopOrList) before evaluating aBlock, and restore them after.
+ 	 This keeps the oops valid if, as V3 will, there is a GC on allocation."
+ 
+ 	| idList |
+ 	pluginFunctionsUsed add: #pushRemappableOop:; add: #popRemappableOop.
+ 	idList := aNode args first nameOrValue.
+ 	idList class == Array ifFalse: [idList := Array with: idList].
+ 	idList do:
+ 		[:each | 
+ 		 aStream
+ 			tab: level;
+ 			nextPutAll: 'pushRemappableOop(';
+ 			nextPutAll: each asString;
+ 			nextPutAll: ');']
+ 		separatedBy: [aStream cr].
+ 	aStream cr.
+ 	aNode args second emitCCodeOn: aStream level: level generator: self.
+ 	level timesRepeat: [aStream tab].
+ 	idList reversed do:
+ 		[:each |
+ 		 aStream 
+ 			nextPutAll: each asString;
+ 			nextPutAll: ' = popRemappableOop()']
+ 		separatedBy: [aStream nextPut: $;; crtab: level]!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>initializeCTranslationDictionary (in category 'public') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	super initializeCTranslationDictionary.
  	translationDict
  		at: #expandDereferenceInterpreterProxyFunctionTable
+ 			put: #generateInterpreterProxyFunctionDeference:on:indent:;
+ 		at: #remapOop:in:
+ 			put: #generateRemapOopIn:on:indent:!
- 		put: #generateInterpreterProxyFunctionDeference:on:indent:!



More information about the Vm-dev mailing list