[Vm-dev] VM Maker: VMMaker.oscog-djm.676.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 17 05:50:59 UTC 2014


Douglas McPherson uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-djm.676.mcz

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

Name: VMMaker.oscog-djm.676
Author: djm
Time: 16 April 2014, 10:47:05.424 pm
UUID: 18df673d-875b-4fe9-9e0a-aa75fb44820c
Ancestors: VMMaker.oscog-eem.675

Filling in pieces of ThreadedARMFFIPlugin. This version of ThreadedARMFFIPlugin DOES NOT WORK (OR COMPILE). It is being captured to facilitate chasing of a potential bug in slang inlining. 

The only changes outside of ThreadedARMFFIPlugin are arm-specific macros in ThreadedFFIPlugin class>>preambleCCode, minor tweaks to ThreadedFFICalloutStateForARM, and cosmetic changes to ThreadedFFICalloutStateForPPC.

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

Item was changed:
  ThreadedFFIPlugin subclass: #ThreadedARMFFIPlugin
  	instanceVariableNames: ''
+ 	classVariableNames: 'NumFloatRegArgs NumIntRegArgs'
- 	classVariableNames: 'NumRegArgs'
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins'!
  
  !ThreadedARMFFIPlugin commentStamp: '<historical>' prior: 0!
  This subclass is for the 32-bit ARM ABI.  It typically has 4 integer registers.!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin class>>initialize (in category 'class initialization') -----
  initialize
+ 	NumIntRegArgs := 4.
+ 	NumFloatRegArgs := 16!
- 	NumRegArgs := 4!

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

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

Item was added:
+ ----- Method: ThreadedARMFFIPlugin>>dispatchFunctionPointer:with:with:with:with: (in category 'callout support') -----
+ dispatchFunctionPointer: aFunctionPointer with: int1 with: int2 with: int3 with: int4
+ 	"In C aFunctionPointer is void (*aFunctionPointer)(int, int, int, int)"
+ 	<cmacro: '(aFunctionPointer, int1, int2, int3, int4) (aFunctionPointer)(int1, int2, int3, int4)'>
+ 	^self perform: aFunctionPointer!

Item was added:
+ ----- Method: ThreadedARMFFIPlugin>>dummyFloatFunction:with:with:with:with:with:with:with: (in category 'callout support') -----
+ dummyFloatFunction: d1 with: d2 with: d3 with: d4 with: d5 with: d6 with: d7 with: d8
+ 	<var: #d1 type: #'double'>
+ 	<var: #d2 type: #'double'>
+ 	<var: #d3 type: #'double'>
+ 	<var: #d4 type: #'double'>
+ 	<var: #d5 type: #'double'>
+ 	<var: #d6 type: #'double'>
+ 	<var: #d7 type: #'double'>
+ 	<var: #d8 type: #'double'>
+ 	<returnTypeC: 'void'>
+ 	<inline: false>
+ 
+ !

Item was added:
+ ----- Method: ThreadedARMFFIPlugin>>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 |
+ 	<var: #floatRet type: #double>
+ 	<var: #intRet type: #usqLong>
+ 	<inline: true>
+ 	self cppIf: COGMTVM ifTrue:
+ 	[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
+ 		[myThreadIndex := interpreterProxy disownVM: 0]].
+ 
+ 	self msg: 'calling out to C function'.
+ 
+ 	self registerArgsSlop + self cStackAlignment > 0 ifTrue:
+ 		[self setsp: calloutState argVector].
+ 
+ 	calloutState floatRegisterIndex > 0
+ 		ifTrue:
+ 			[self 
+ 				dummyFloatFunction: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: 'double *') at: 0)
+ 				with: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: 'double *') at: 0)
+ 			].
+ 
+ 	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ 	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)].
+ 	 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]].
+ 
+ 	"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 = FFITypeSingleFloat
+ 	 or: [atomicType = FFITypeDoubleFloat]) ifTrue:
+ 		[^interpreterProxy methodReturnValue: (interpreterProxy floatObjectOf: floatRet)].
+ 
+ 	^interpreterProxy methodReturnValue: (self ffiCreateIntegralResultOop: intRet
+ 												ofAtomicType: atomicType
+ 												in: calloutState)!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
  ffiPushDoubleFloat: value in: calloutState
+ 	<var: #value type: #double>
+ 	<var: #calloutState type: #'CalloutState *'>
- 	<arg: #calloutState type: #'CalloutState *'>
  	<inline: true>
+ 	calloutState floatRegisterIndex < (NumFloatRegArgs - 1)
+ 		ifTrue:
+ 			[calloutState floatRegisterIndex: (calloutState floatRegisterIndex + 1 bitClear: 1).
+ 		  	 (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) 
+ 				 	to: 'double*')
+ 						at: 0
+ 						put: value.
+ 			 calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2]
+ 		ifFalse:
+ 			[calloutState currentArg + 8 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy storeFloatAtPointer: calloutState currentArg from: value.
+ 			 calloutState currentArg: calloutState currentArg + 8].
- 	self shouldBeImplemented.
  	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
  ffiPushPointer: 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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was added:
+ ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + 4].
+ 	^0
+ !

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

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short').
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
  ffiPushSingleFloat: value in: calloutState
  	<var: #calloutState type: #'CalloutState *'>
  	<inline: true>
+ 	calloutState floatRegisterIndex < NumFloatRegArgs
+ 		ifTrue: 
+ 			[calloutState floatRegisters at: calloutState floatRegisterIndex  put: (self cCoerceSimple: value to: #'float').
+ 			 calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value.
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was added:
+ ----- Method: ThreadedARMFFIPlugin>>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 shouldBeImplemented.
+ 	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ 			 calloutState currentArg: calloutState currentArg + 4].
+ 	^0
+ !
- 	self shouldBeImplemented.
- 	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was added:
+ ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: value.
+ 			 calloutState currentArg: calloutState currentArg + 4].
+ 	^0
+ 
+ !

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
  ffiPushUnsignedLongLong: value in: calloutState
  	<var: #value type: #usqLong>
  	<var: #calloutState type: #'CalloutState *'>
  	<inline: true>
+ 	calloutState integerRegisterIndex < (NumIntRegArgs - 1)
+ 		ifTrue:
+ 			[calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1).
+ 			 calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt).
+ 			 calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt).
+ 			 calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2]
+ 		ifFalse:
+ 			[calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy
+ 				longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt);
+ 				longAt: calloutState currentArg + 4 put: (self cCoerceSimple: value >> 32 to: #usqInt).
+ 			 calloutState currentArg: calloutState currentArg + 8].
+ 	^0
+ !
- 	self shouldBeImplemented.
- 	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>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 + 4 > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short').
+ 			 calloutState currentArg: calloutState currentArg + 4].
- 	self shouldBeImplemented.
  	^0!

Item was added:
+ ----- 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.
+ 	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: ThreadedARMFFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ 	"Answer if a struct result of a given size is returned in memory or not."
+ 	^false!

Item was changed:
  ThreadedFFICalloutState subclass: #ThreadedFFICalloutStateForARM
+ 	instanceVariableNames: 'integerRegisterIndex integerRegisters floatRegisterIndex floatRegisters'
- 	instanceVariableNames: 'regIndex integerRegisters'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins'!

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

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

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

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

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

Item was changed:
  ----- Method: ThreadedFFICalloutStateForARM>>initialize (in category 'initialize-release') -----
  initialize
  	super initialize.
+ 	integerRegisterIndex := 0.
+ 	floatRegisterIndex := 0.
+ 	integerRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numIntRegArgs).
+ 	floatRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numFloatRegArgs)!
- 	regIndex := 0.
- 	integerRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numRegArgs)!

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

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

Item was changed:
  ThreadedFFICalloutState subclass: #ThreadedFFICalloutStateForPPC
+ 	instanceVariableNames: 'registerIndex integerRegisters floatRegisters'
- 	instanceVariableNames: 'regIndex integerRegisters floatRegisters'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins'!

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

Item was changed:
  ----- Method: ThreadedFFICalloutStateForPPC>>initialize (in category 'initialize-release') -----
  initialize
  	super initialize.
+ 	registerIndex := 0.
- 	regIndex := 0.
  	integerRegisters := CArrayAccessor on: (Array new: ThreadedPPCBEFFIPlugin numRegArgs).
  	floatRegisters := CArrayAccessor on: (Array new: ThreadedPPCBEFFIPlugin numRegArgs)!

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

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

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

Item was changed:
  ----- Method: ThreadedFFIPlugin class>>preambleCCode (in category 'translation') -----
  preambleCCode
  	"For a source of builtin defines grep for builtin_define in a gcc release config directory."
  	^'
  #include "sqAssert.h" /* for assert */
  
  #ifdef _MSC_VER
  # define alloca _alloca
  #endif
  #if defined(__GNUC__) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__))
  # define setsp(sp) asm volatile ("movl %0,%%esp" : : "m"(sp))
  # define getsp() ({ void *esp; asm volatile ("movl %%esp,%0" : "=r"(esp) : ); esp;})
+ # elif defined(__GNUC__) && (defined(__arm__))
+ # define setsp(sp) asm volatile ("ldr %%sp, %0" : : "m"(sp))
+ # define getsp() ({ void *sp; asm volatile ("mov %0, %%sp" : "=r"(sp) : ); sp;})
  #endif
  #if !!defined(getsp)
  # define getsp() 0
  #endif 
  #if !!defined(setsp)
  # define setsp(ignored) 0
  #endif 
  
  #if !!defined(STACK_ALIGN_BYTES)
  # if __APPLE__ && __MACH__ && __i386__
  #  define STACK_ALIGN_BYTES 16
  # elif __linux__ && __i386__
  #  define STACK_ALIGN_BYTES 16
  # elif defined(__amd64__) || defined(__x86_64__) ||  defined(__amd64) || defined(__x86_64)
  #  define STACK_ALIGN_BYTES 16
  # elif defined(powerpc) || defined(__powerpc__) || defined(_POWER) || defined(__POWERPC__) || defined(__PPC__)
  #  define STACK_ALIGN_BYTES 16
  # elif defined(__sparc64__) || defined(__sparcv9__) || defined(__sparc_v9__) /* must preceed 32-bit sparc defs */
  #  define STACK_ALIGN_BYTES 16
  # elif defined(sparc) || defined(__sparc__) || defined(__sparclite__)
  #  define STACK_ALIGN_BYTES 8
+ # elif defined(__arm__) 
+ #  define STACK_ALIGN_BYTES 8
  # else
  #  define STACK_ALIGN_BYTES 0
  # endif
  #endif /* !!defined(STACK_ALIGN_BYTES) */
  
  #if !!defined(STACK_OFFSET_BYTES)
  # define STACK_OFFSET_BYTES 0
  #endif
  
  #if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)
  /* Both Mac OS X x86 and Win32 x86 return structs of a power of two in size
   * less than or equal to eight bytes in length in registers. Linux never does so.
   */
  # if __linux__
  #	define WIN32_X86_STRUCT_RETURN 0
  # else
  #	define WIN32_X86_STRUCT_RETURN 1
  # endif
  # if WIN32
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1
  # else
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0
  # endif
  #endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */
  
+ #if defined(__arm__)
+ #	define WIN32_X86_STRUCT_RETURN 0
+ #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0
+ #endif /* defined(__arm__) */
+ 
  #if !!defined(ALLOCA_LIES_SO_USE_GETSP)
  # if defined(__MINGW32__) && (__GNUC__ >= 3)
      /*
       * cygwin -mno-cygwin (MinGW) gcc 3.4.x''s alloca is a library routine that answers
       * %esp + 4, so the outgoing stack is offset by one word if uncorrected.
       * Grab the actual stack pointer to correct.
       */
  #	define ALLOCA_LIES_SO_USE_GETSP 1
  # else
  #	define ALLOCA_LIES_SO_USE_GETSP 0
  # endif
  #endif /* !!defined(ALLOCA_LIES_SO_USE_GETSP) */
  
  /* The dispatchOn:in:with:with: generates an unwanted call on error.  Just squash it. */
  #define error(foo) 0
  
  /* but print assert failures. */
  void
  warning(char *s) { /* Print an error message but don''t exit. */
  	printf("\n%s\n", s);
  }
  '!



More information about the Vm-dev mailing list