[Vm-dev] VM Maker: VMMaker-oscog.19.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sat Jul 10 00:59:12 UTC 2010
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://www.squeaksource.com/VMMaker/VMMaker-oscog.19.mcz
==================== Summary ====================
Name: VMMaker-oscog.19
Author: eem
Time: 9 July 2010, 3:53:09 am
UUID: e2e1dd83-f427-4df3-a971-aababe804331
Ancestors: VMMaker-oscog.18
CogVM:
Fix primitiveObjectPointsTo for multiple of 4 length methods.
FFI Plugin:
Add ReentrantFFIPlugin that can replace the existing FFI
(currently only x86) and doesn't need any assembler
support. Skeletons for PPC and ARM provided for brave
souls looking for fun work.
=============== Diff against VMMaker-oscog.18 ===============
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushUnsignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForARM>>regIndex (in category 'accessing') -----
+ regIndex
+ "Answer the value of regIndex"
+
+ ^ regIndex!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>stringArgIndex: (in category 'accessing') -----
+ stringArgIndex: anObject
+ "Set the value of stringArgIndex"
+
+ ^stringArgIndex := anObject!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ <var: #calloutState type: #double>
+ <var: #calloutState type: #'CalloutState *'>
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRet ofType: ffiRetClass 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 oop |
+ <inline: true>
+ retOop := interpreterProxy instantiateClass: ffiRetClass 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: ReentrantFFIPlugin>>ffiFloatValueOf: (in category 'callout support') -----
+ ffiFloatValueOf: oop
+ "Support for generic callout. Return a float value that is coerced as C would do."
+ | oopClass |
+ <returnTypeC:'double'>
+ oopClass := interpreterProxy fetchClassOf: oop.
+ oopClass == interpreterProxy classFloat
+ ifTrue:[^interpreterProxy floatValueOf: oop].
+ "otherwise try the integer coercions and return its float value"
+ ^(self ffiIntegerValueOf: oop) asFloat!
Item was changed:
----- Method: StackInterpreter>>primitiveObjectPointsTo (in category 'object access primitives') -----
primitiveObjectPointsTo
+ "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
+ N.B. Written to use literalHeaderOf: so that in Cog subclasses cogged methods (whose headers
+ point to the machine code method) are still correctly scanned, for the header as well as literals."
- "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so"
| rcvr thang header fmt lastField methodHeader |
thang := self stackTop.
rcvr := self stackValue: 1.
(self isIntegerObject: rcvr) ifTrue:
[^self pop: 2 thenPushBool: false].
"Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
header := self baseHeader: rcvr.
fmt := self formatOfHeader: header.
fmt <= 4
ifTrue:
[(fmt = 3
and: [self isContextHeader: header])
ifTrue:
[(self isMarriedOrWidowedContext: rcvr) ifTrue:
[self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: rcvr) ifTrue:
[^self pop: 2
thenPushBool: (self marriedContext: rcvr
pointsTo: thang
stackDeltaForCurrentFrame: 2)]].
"contexts end at the stack pointer"
lastField := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr) * BytesPerWord]
ifFalse:
[lastField := (self sizeBitsOfSafe: rcvr) - BaseHeaderSize]]
ifFalse:
+ [fmt < 12 "no pointers" ifTrue:
- [fmt <= 12 "no pointers" ifTrue:
[^self pop: 2 thenPushBool: false].
"CompiledMethod: contains both pointers and bytes:"
+ methodHeader := self headerOf: rcvr.
+ methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
+ lastField := ((self literalCountOfHeader: methodHeader) + 1) * BytesPerWord].
- methodHeader := self longAt: rcvr + BaseHeaderSize.
- lastField := (self literalCountOfHeader: methodHeader) * BytesPerWord + BaseHeaderSize].
BaseHeaderSize to: lastField by: BytesPerWord do:
[:i |
(self longAt: rcvr + i) = thang ifTrue:
[^self pop: 2 thenPushBool: true]].
self pop: 2 thenPushBool: false!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>externalFunctionHasStackSizeSlot (in category 'symbol loading') -----
+ externalFunctionHasStackSizeSlot
+ <inline: true>
+ ^externalFunctionInstSize > ExternalFunctionStackSizeIndex!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIAllocate (in category 'primitives') -----
+ primitiveFFIAllocate
+ "Primitive. Allocate an object on the external heap."
+ | byteSize addr oop ptr |
+ <export: true>
+ <inline: false>
+ <var: #ptr type:'int *'>
+ byteSize := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifTrue:[^nil].
+ addr := self ffiAlloc: byteSize.
+ addr = 0 ifTrue:[^interpreterProxy primitiveFail].
+ oop := interpreterProxy
+ instantiateClass: interpreterProxy classExternalAddress
+ indexableSize: 4.
+ ptr := interpreterProxy firstIndexableField: oop.
+ ptr at: 0 put: addr.
+ interpreterProxy pop: 2.
+ ^interpreterProxy push: oop.
+ !
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ "Answer if a struct result of a given size is returned in memory or not.
+ The ABI spec defines return in registers, but some linux gcc versions implemented an
+ erroneous draft which does not return any struct in memory. Implement the SysV ABI."
+ ^returnStructSize <= 8!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>cleanupCalloutState: (in category 'callout support') -----
+ cleanupCalloutState: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <returnTypeC: #void>
+ "Free any temporary arg strings."
+ <inline: true>
+ [calloutState stringArgIndex > 0] whileTrue:
+ [self free: (calloutState stringArgs at: (calloutState stringArgIndex: calloutState stringArgIndex - 1))]!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ 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!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveLogCallsTo (in category 'primitives') -----
+ primitiveLogCallsTo
+ "Enable logging of FFI calls by providing it with a log file name."
+ | logFile ok |
+ <export: true>
+ interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFail].
+ logFile := interpreterProxy stackObjectValue: 0.
+ logFile == interpreterProxy nilObject ifTrue:[ "disable logging"
+ ok := self ffiLogFileName: nil OfLength: 0.
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ ffiLogEnabled := false.
+ ] ifFalse:[ "enable logging"
+ (interpreterProxy isBytes: logFile) ifFalse:[^interpreterProxy primitiveFail].
+ ok := self ffiLogFileName: (interpreterProxy firstIndexableField: logFile)
+ OfLength: (interpreterProxy byteSizeOf: logFile).
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ ffiLogEnabled := true.
+ ].
+ ^interpreterProxy pop: 1. "pop arg; return rcvr"
+ !
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveForceLoad (in category 'primitives') -----
+ primitiveForceLoad
+ "Primitive. Force loading the receiver (an instance of ExternalLibrary)."
+ | rcvr moduleHandlePtr moduleHandle ffiModuleName ptr |
+ <export: true>
+ <inline: false>
+ <var: #ptr type: #'int *'>
+ interpreterProxy methodArgumentCount = 0 ifFalse:
+ [^interpreterProxy primitiveFail].
+ rcvr := interpreterProxy stackValue: 0.
+ (interpreterProxy is: rcvr KindOfClass: interpreterProxy classExternalLibrary) ifFalse:
+ [^self ffiFail: FFIErrorBadExternalLibrary].
+ moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
+ moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary.
+ interpreterProxy failed ifTrue:
+ [^0].
+ ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr.
+ (interpreterProxy isBytes: ffiModuleName) ifFalse:
+ [^self ffiFail: FFIErrorBadExternalLibrary].
+ moduleHandle := interpreterProxy
+ ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to: #int)
+ OfLength: (interpreterProxy byteSizeOf: ffiModuleName).
+ interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed"
+ "and store back"
+ ptr := interpreterProxy firstIndexableField: moduleHandlePtr.
+ ptr at: 0 put: moduleHandle.
+ ^0 "done"!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIGetLastError (in category 'primitives') -----
+ primitiveFFIGetLastError
+ "Primitive. Return the error code from a failed call to the foreign function interface.
+ Always fail. In the thread-enabled FFI access errors via the primitive error code."
+ <export: true>
+ <inline: false>
+ ^interpreterProxy primitiveFailFor: PrimErrUnsupported!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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, 0)"
+ | surfaceID ptr result |
+ <export: true>
+ <var: #ptr type: #'unsigned int'>
+
+ interpreterProxy methodArgumentCount == 2 ifFalse: [^interpreterProxy primitiveFail].
+ surfaceID := interpreterProxy stackIntegerValue: 1.
+ ptr := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
+ interpreterProxy failed ifTrue: [^nil].
+
+ self touch: surfaceID; touch: ptr.
+
+ result := self cCode: 'setManualSurfacePointer(surfaceID, (void*)ptr)'.
+ result = 0 ifTrue: [^interpreterProxy primitiveFail].
+ ^interpreterProxy pop: 2
+ !
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ NumRegArgs := 8!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ "c.f. ExternalFunction allInstVarNames
+ old: #('handle' 'flags' 'argTypes')
+ new: #('handle' 'flags' 'argTypes' 'stackSize')"
+ ExternalFunctionAddressIndex := 0.
+ ExternalFunctionFlagsIndex := 1.
+ ExternalFunctionArgTypesIndex := 2.
+ ExternalFunctionStackSizeIndex := 3.
+
+ "c.f. e.g. CoInterpreter class initializeMiscConstants"
+ MaxNumArgs := 15.
+
+ DefaultMaxStackSize := 1024 * 16!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin class>>numRegArgs (in category 'accessing') -----
+ numRegArgs
+ ^NumRegArgs!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForARM>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ regIndex := 0.
+ integerRegisters := CArrayAccessor on: (Array new: ReentrantARMFFIPlugin numRegArgs)!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushUnsignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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 isIntegerObject: ptrType)
+ ifTrue:[^FFIErrorWrongType].
+ (interpreterProxy isPointers: ptrType)
+ ifFalse:[^FFIErrorWrongType].
+ (interpreterProxy slotSizeOf: ptrType) < 2
+ ifTrue:[^FFIErrorWrongType].
+ specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType.
+ (interpreterProxy isIntegerObject: specOop)
+ ifTrue:[^FFIErrorWrongType].
+ (interpreterProxy isWords: specOop)
+ ifFalse:[^FFIErrorWrongType].
+ (interpreterProxy slotSizeOf: specOop) = 0
+ ifTrue:[^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"
+ (atomicType > FFITypeBool and:[atomicType < FFITypeSingleFloat])
+ ifFalse:[^FFIErrorCoercionFailed].
+ ((atomicType >> 1) = (specType >> 1))
+ ifFalse:[^FFIErrorCoercionFailed]].
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
+ ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
+ "Generic callout. Does the actual work. If argArrayOrNil is nil it takes args from the stack
+ and the spec from the method. If argArrayOrNil is not nil takes args from argArrayOrNil
+ and the spec from the receiver."
+ | flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result |
+ <inline: true>
+ <var: #theCalloutState type: #'CalloutState'>
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #allocation type: #'char *'>
+
+ (interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
+ [^self ffiFail: FFIErrorNotFunction].
+ "Load and check the values in the externalFunction before we call out"
+ flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
+ interpreterProxy failed ifTrue:
+ [^self ffiFail: FFIErrorBadArgs].
+ argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
+ "must be array of arg types"
+ ((interpreterProxy isArray: argTypeArray)
+ and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
+ [^self ffiFail: FFIErrorBadArgs].
+ "check if the calling convention is supported"
+ (self ffiSupportsCallingConvention: flags) ifFalse:
+ [^self ffiFail: FFIErrorCallType].
+
+ address := self ffiLoadCalloutAddress: externalFunction.
+ interpreterProxy failed ifTrue:
+ [^0 "error code already set by ffiLoadCalloutAddress:"].
+ requiredStackSize := self externalFunctionHasStackSizeSlot
+ ifTrue: [interpreterProxy fetchInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction]
+ ifFalse: [-1].
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
+ ifTrue: [PrimErrBadMethod]
+ ifFalse: [PrimErrBadReceiver])].
+ stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
+ self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
+ calloutState := self addressOf: theCalloutState.
+ self cCode: [self me: calloutState ms: 0 et: (self sizeof: #CalloutState asSymbol)].
+ calloutState callFlags: flags.
+ "Fetch return type and args"
+ argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
+ argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
+ argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
+ (err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
+ [^self ffiFail: err]. "cannot return"
+ "alloca the outgoing stack frame, leaving room for register args while marshalling, and including space for the return struct, if any."
+ allocation := self alloca: stackSize + calloutState structReturnSize + self registerArgsSlop + self cStackAlignment.
+ self allocaLiesSoUseGetsp ifTrue:
+ [allocation := self getsp].
+ self cStackAlignment ~= 0 ifTrue:
+ [allocation := self cCoerce: (allocation asUnsignedInteger bitAnd: (self cStackAlignment - 1) bitInvert32)
+ to: #'char *'].
+ calloutState
+ argVector: allocation;
+ currentArg: allocation + self registerArgsSlop;
+ limit: allocation + stackSize + self registerArgsSlop.
+ (calloutState structReturnSize > 0
+ and: [self nonRegisterStructReturnIsViaImplicitFirstArgument]) ifTrue:
+ [self ffiPushPointer: calloutState limit in: calloutState].
+ 1 to: nArgs do:
+ [:i|
+ argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
+ argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
+ argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
+ oop := argArrayOrNil isNil
+ ifTrue: [interpreterProxy stackValue: nArgs - i]
+ ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
+ err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
+ err ~= 0 ifTrue:
+ [self cleanupCalloutState: calloutState.
+ ^self ffiFail: err]]. "coercion failed or out of stack space"
+ "Failures must be reported back from ffiArgument:Spec:Class:in:.
+ Should not fail form here on in."
+ self assert: interpreterProxy failed not.
+ self ffiLogCallout: externalFunction.
+ (requiredStackSize < 0
+ and: [self externalFunctionHasStackSizeSlot]) ifTrue:
+ [stackSize := calloutState currentArg - calloutState argVector.
+ interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
+ "Go out and call this guy"
+ result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
+ self cleanupCalloutState: calloutState.
+ ^result!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushUnsignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>structReturnSize (in category 'accessing') -----
+ structReturnSize
+ "Answer the value of structReturnSize"
+
+ ^ structReturnSize!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>atomicTypeOf: (in category 'primitive support') -----
+ atomicTypeOf: typeSpec
+ ^(typeSpec bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiAtomicStructByReference:Class:in: (in category 'callout support') -----
+ ffiAtomicStructByReference: oop Class: oopClass in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ "Support for generic callout. Prepare an external pointer reference to an atomic type for callout."
+ | atomicType err valueOop |
+ <inline: true>
+ "must be external data to pass pointers to atomic type"
+ oopClass == interpreterProxy classExternalData
+ ifFalse:[^FFIErrorCoercionFailed].
+ atomicType := self atomicTypeOf: calloutState ffiArgHeader.
+ "no type checks for void pointers"
+ atomicType ~= FFITypeVoid ifTrue:[
+ err := self ffiValidateExternalData: oop AtomicType: atomicType.
+ err ~= 0 ifTrue:[^err].
+ ].
+ "and push pointer contents"
+ valueOop := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushPointerContentsOf: valueOop in: calloutState!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiLoadCalloutAddress: (in category 'symbol loading') -----
+ ffiLoadCalloutAddress: lit
+ "Load the address of the foreign function from the given object"
+ | addressPtr address ptr |
+ <var: #ptr type: #'int *'>
+ "Lookup the address"
+ addressPtr := interpreterProxy fetchPointer: 0 ofObject: lit.
+ "Make sure it's an external handle"
+ address := self ffiContentsOfHandle: addressPtr errCode: FFIErrorBadAddress.
+ interpreterProxy failed ifTrue:
+ [^0].
+ address = 0 ifTrue:"Go look it up in the module"
+ [self externalFunctionHasStackSizeSlot ifTrue:
+ [interpreterProxy
+ storePointer: ExternalFunctionStackSizeIndex
+ ofObject: lit
+ withValue: (interpreterProxy integerObjectOf: -1)].
+ (interpreterProxy slotSizeOf: lit) < 5 ifTrue:
+ [^self ffiFail: FFIErrorNoModule].
+ address := self ffiLoadCalloutAddressFrom: lit.
+ interpreterProxy failed ifTrue:
+ [^0].
+ "Store back the address"
+ ptr := interpreterProxy firstIndexableField: addressPtr.
+ ptr at: 0 put: address].
+ ^address!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForARM 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 '[', ReentrantARMFFIPlugin numRegArgs printString, ']')] }
+ otherwise:
+ [#sqInt])]!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiFail: (in category 'callout support') -----
+ ffiFail: reason
+ <inline: false>
+ "Map the FFI error code into a primitive error code. If reason is negative it encodes one of the
+ standard PrimErr... codes, negated to distinguish it from the FFIError codes. If it is an FFIError...
+ code then add the size of the primitive error table + 2 to disambiguate it from the PrimErr... codes.
+ For historic reasons the FFIError codes range from -1 on up hence adding size + 2 maps them to
+ size of table + 1 on up. This OFFSET IS undone by ExternalFunction class>>externalCallFailedWith:.
+ Thus we can communicate back both PrimErr.. and FFIError codes. Complex but necessary.
+ Do not record the error code because as yet there is no per-process mechanism to do this, and since
+ the error is accessible through the primitive errror code there is no need."
+ ^interpreterProxy primitiveFailFor:
+ (reason >= FFINoCalloutAvailable
+ ifTrue: [reason + 2 + (interpreterProxy slotSizeOf: interpreterProxy primitiveErrorTable)]
+ ifFalse: [reason negated])!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiArgument:Spec:Class:in: (in category 'callout support') -----
+ ffiArgument: oop Spec: argSpec Class: argClass in: calloutState
+ "Callout support. Prepare the given oop as argument.
+ argSpec defines the compiled spec for the argument.
+ argClass (if non-nil) defines the required (super)class for the argument."
+ <var: #calloutState type: #'CalloutState *'>
+ | valueOop oopClass isStruct nilOop |
+ <inline: false>
+ oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)"
+ nilOop := interpreterProxy nilObject.
+ "Do the necessary type checks"
+ argClass == nilOop ifFalse:[
+ "Type check 1:
+ Is the required class of the argument a subclass of ExternalStructure?"
+ (interpreterProxy includesBehavior: argClass
+ ThatOf: interpreterProxy classExternalStructure)
+ ifFalse:[^FFIErrorWrongType]. "Nope. Fail."
+ "Type check 2:
+ Is the class of the argument a subclass of required class?"
+ ((nilOop == oop) or:[interpreterProxy includesBehavior: oopClass ThatOf: argClass])
+ ifFalse:[^FFIErrorCoercionFailed]. "Nope. Fail."
+ "Okay, we've passed the type check (so far)"
+ ].
+
+ "Check if oopClass is a subclass of ExternalStructure.
+ If this is the case we'll work on it's handle and not the actual oop."
+ isStruct := false.
+ ((interpreterProxy isIntegerObject: oop) or:[oop == nilOop]) ifFalse:[
+ "#isPointers: will fail if oop is SmallInteger so don't even attempt to use it"
+ (interpreterProxy isPointers: oop)
+ ifTrue:[isStruct := interpreterProxy includesBehavior: oopClass
+ ThatOf: interpreterProxy classExternalStructure.
+ (argClass == nilOop or:[isStruct])
+ ifFalse:[^FFIErrorCoercionFailed]].
+ "note: the test for #isPointers: above should speed up execution since no pointer type ST objects are allowed in external calls and thus if #isPointers: is true then the arg must be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue"
+ ].
+
+ "Determine valueOop (e.g., the actual oop to pass as argument)"
+ isStruct
+ ifTrue:[valueOop := interpreterProxy fetchPointer: 0 ofObject: oop]
+ ifFalse:[valueOop := oop].
+
+ "Fetch and check the contents of the compiled spec"
+ (interpreterProxy isIntegerObject: argSpec)
+ ifTrue:[^FFIErrorWrongType].
+ (interpreterProxy isWords: argSpec)
+ ifFalse:[^FFIErrorWrongType].
+ calloutState ffiArgSpecSize: (interpreterProxy slotSizeOf: argSpec).
+ calloutState ffiArgSpecSize = 0 ifTrue:[^FFIErrorWrongType].
+ calloutState ffiArgSpec: (interpreterProxy firstIndexableField: argSpec).
+ calloutState ffiArgHeader: (interpreterProxy longAt: calloutState ffiArgSpec).
+
+ "Do the actual preparation of the argument"
+ "Note: Order is important since FFIFlagStructure + FFIFlagPointer is used to represent 'typedef void* VoidPointer' and VoidPointer really is *struct* not pointer."
+
+ (calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[
+ "argument must be ExternalStructure"
+ isStruct ifFalse:[^FFIErrorCoercionFailed].
+ (calloutState ffiArgHeader anyMask: FFIFlagAtomic)
+ ifTrue:[^FFIErrorWrongType]. "bad combination"
+ ^self ffiPushStructureContentsOf: valueOop in: calloutState].
+
+ (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[
+ "no integers for pointers please"
+ (interpreterProxy isIntegerObject: oop)
+ ifTrue:[^FFIErrorIntAsPointer].
+
+ "but allow passing nil pointer for any pointer type"
+ oop == interpreterProxy nilObject ifTrue:[^self ffiPushPointer: nil in: calloutState].
+
+ "argument is reference to either atomic or structure type"
+ (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
+ isStruct "e.g., ExternalData"
+ ifTrue:[^self ffiAtomicStructByReference: oop Class: oopClass in: calloutState]
+ ifFalse:[^self ffiAtomicArgByReference: oop Class: oopClass in: calloutState].
+ "********* NOTE: The above uses 'oop' not 'valueOop' (for ExternalData) ******"
+ ].
+
+ "Needs to be external structure here"
+ isStruct ifFalse:[^FFIErrorCoercionFailed].
+ ^self ffiPushPointerContentsOf: valueOop in: calloutState].
+
+ (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
+ "argument is atomic value"
+ ^self ffiArgByValue: valueOop in: calloutState].
+ "None of the above - bad spec"
+ ^FFIErrorWrongType!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushUnsignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short').
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
+ ffiPushSignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') -----
+ primitiveFFIFloatAtPut
+ "Return a (signed or unsigned) n byte integer from the given byte offset."
+ | byteOffset rcvr addr floatValue floatOop |
+ <export: true>
+ <inline: false>
+ <var: #floatValue type:'float '>
+ floatOop := interpreterProxy stackValue: 0.
+ (interpreterProxy isIntegerObject: floatOop)
+ ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'float']
+ ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'float'].
+ byteOffset := interpreterProxy stackIntegerValue: 1.
+ rcvr := interpreterProxy stackObjectValue: 2.
+ interpreterProxy failed ifTrue:[^0].
+ addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
+ interpreterProxy failed ifTrue:[^0].
+ self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
+ interpreterProxy pop: 3.
+ ^interpreterProxy push: floatOop!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
+ ffiPushSignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRet ofType: ffiRetClass 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."
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>allocaLiesSoUseGetsp (in category 'marshalling') -----
+ allocaLiesSoUseGetsp
+ "At least one alloca implementation does not answer the actual top of stack.
+ If so we need to get the actual stack pointer. Answer whether this is necessary."
+ <cmacro: '() ALLOCA_LIES_SO_USE_GETSP'>
+ ^false!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
+ ffiPushSignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short').
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>prepareToBeAddedToCodeGenerator: (in category 'translation') -----
+ prepareToBeAddedToCodeGenerator: aCodeGen
+ "Remove the methods of ReentrantFFIPlugin any concrete subclass overrides."
+ self class ~~ thisContext methodClass ifTrue:
+ [self selectors do:
+ [:sel|
+ (superclass includesSelector: sel) ifTrue:
+ [aCodeGen removeMethodForSelector: sel]]]!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ ^ReentrantFFICalloutStateForPPC!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ ^ReentrantFFICalloutState!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') -----
+ primitiveFFIDoubleAtPut
+ "Return a (signed or unsigned) n byte integer from the given byte offset."
+ | byteOffset rcvr addr floatValue floatOop |
+ <export: true>
+ <inline: false>
+ <var: #floatValue type:'double '>
+ floatOop := interpreterProxy stackValue: 0.
+ (interpreterProxy isIntegerObject: floatOop)
+ ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'double']
+ ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'double'].
+ byteOffset := interpreterProxy stackIntegerValue: 1.
+ rcvr := interpreterProxy stackObjectValue: 2.
+ interpreterProxy failed ifTrue:[^0].
+ addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
+ interpreterProxy failed ifTrue:[^0].
+ self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
+ self cCode:'((int*)addr)[1] = ((int*)(&floatValue))[1]'.
+ interpreterProxy pop: 3.
+ ^interpreterProxy push: floatOop!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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: ReentrantPPCBEFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIIntegerAt (in category 'primitives') -----
+ primitiveFFIIntegerAt
+ "Return a (signed or unsigned) n byte integer from the given byte offset."
+ | isSigned byteSize byteOffset rcvr addr value mask |
+ <export: true>
+ <inline: false>
+ isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ byteSize := interpreterProxy stackIntegerValue: 1.
+ byteOffset := interpreterProxy stackIntegerValue: 2.
+ rcvr := interpreterProxy stackObjectValue: 3.
+ interpreterProxy failed ifTrue:[^0].
+ (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]])
+ ifFalse:[^interpreterProxy primitiveFail].
+ addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
+ interpreterProxy failed ifTrue:[^0].
+ byteSize < 4 ifTrue:[
+ "short/byte"
+ byteSize = 1
+ ifTrue:[value := interpreterProxy byteAt: addr]
+ ifFalse:[ value := self cCode: '*((short int *) addr)'
+ inSmalltalk: [interpreterProxy shortAt: addr]].
+ isSigned ifTrue:["sign extend value"
+ mask := 1 << (byteSize * 8 - 1).
+ value := (value bitAnd: mask-1) - (value bitAnd: mask)].
+ "note: byte/short never exceed SmallInteger range"
+ value := interpreterProxy integerObjectOf: value.
+ ] ifFalse:[
+ "general 32 bit integer"
+ value := interpreterProxy longAt: addr.
+ isSigned
+ ifTrue:[value := interpreterProxy signed32BitIntegerFor: value]
+ ifFalse:[value := interpreterProxy positive32BitIntegerFor: value].
+ ].
+ interpreterProxy pop: 4.
+ ^interpreterProxy push: value
+ !
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveDestroyManualSurface (in category 'primitives - surfaces') -----
+ primitiveDestroyManualSurface
+ "arguments: name(type, stack offset)
+ surfaceID(Integer, 0)"
+ | surfaceID result |
+ <export: true>
+
+ interpreterProxy methodArgumentCount == 1 ifFalse: [^interpreterProxy primitiveFail].
+ surfaceID := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifTrue: [^nil].
+ result := self destroyManualSurface: surfaceID.
+ result = 0 ifTrue: [^interpreterProxy primitiveFail].
+ ^interpreterProxy pop: 1
+ !
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveCreateManualSurface (in category 'primitives - surfaces') -----
+ primitiveCreateManualSurface
+ "arguments: name(type, stack offset)
+ width(Integer, 4)
+ height(Integer, 3)
+ rowPitch(Integer, 2)
+ depth(Integer, 1)
+ isMSB(Boolean, 0)"
+ | width height rowPitch depth isMSB result |
+ <export: true>
+
+ interpreterProxy methodArgumentCount == 5 ifFalse: [^interpreterProxy primitiveFail].
+ width := interpreterProxy stackIntegerValue: 4.
+ height := interpreterProxy stackIntegerValue: 3.
+ rowPitch := interpreterProxy stackIntegerValue: 2.
+ depth := interpreterProxy stackIntegerValue: 1.
+ isMSB := interpreterProxy stackObjectValue: 0.
+ isMSB := interpreterProxy booleanValueOf: isMSB.
+ interpreterProxy failed ifTrue: [^nil].
+
+ self touch: width; touch: height; touch: rowPitch; touch: depth; touch: isMSB.
+
+ result := self cCode: 'createManualSurface(width, height, rowPitch, depth, isMSB)'.
+ result < 0 ifTrue: [^interpreterProxy primitiveFail].
+ result := interpreterProxy signed32BitIntegerFor: result.
+ ^interpreterProxy pop: 6 thenPush: result
+ !
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIIntegerAtPut (in category 'primitives') -----
+ primitiveFFIIntegerAtPut
+ "Store a (signed or unsigned) n byte integer at the given byte offset."
+ | isSigned byteSize byteOffset rcvr addr value max valueOop |
+ <export: true>
+ <inline: false>
+ isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ byteSize := interpreterProxy stackIntegerValue: 1.
+ valueOop := interpreterProxy stackValue: 2.
+ byteOffset := interpreterProxy stackIntegerValue: 3.
+ rcvr := interpreterProxy stackObjectValue: 4.
+ interpreterProxy failed ifTrue:[^0].
+ (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]])
+ ifFalse:[^interpreterProxy primitiveFail].
+ addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
+ interpreterProxy failed ifTrue:[^0].
+ isSigned
+ ifTrue:[value := interpreterProxy signed32BitValueOf: valueOop]
+ ifFalse:[value := interpreterProxy positive32BitValueOf: valueOop].
+ interpreterProxy failed ifTrue:[^0].
+ byteSize < 4 ifTrue:[
+ isSigned ifTrue:[
+ max := 1 << (8 * byteSize - 1).
+ value >= max ifTrue:[^interpreterProxy primitiveFail].
+ value < (0 - max) ifTrue:[^interpreterProxy primitiveFail].
+ ] ifFalse:[
+ value >= (1 << (8*byteSize)) ifTrue:[^interpreterProxy primitiveFail].
+ ].
+ "short/byte"
+ byteSize = 1
+ ifTrue:[interpreterProxy byteAt: addr put: value]
+ ifFalse:[ self cCode: '*((short int *) addr) = value'
+ inSmalltalk: [interpreterProxy shortAt: addr put: value]].
+ ] ifFalse:[interpreterProxy longAt: addr put: value].
+ interpreterProxy pop: 5.
+ ^interpreterProxy push: valueOop.!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>initialiseModule (in category 'initialize') -----
+ initialiseModule
+ <export: true>
+ "By default, disable logging"
+ ffiLogEnabled := false.
+ "Get the instSize of ExternalFunction to know whether it contains a cache of the stackSize,
+ and what the offset of ExternalLibraryFunction's functionName and moduleName slots are."
+ externalFunctionInstSize := interpreterProxy instanceSizeOf: interpreterProxy classExternalFunction.
+ self initSurfacePluginFunctionPointers.
+ ^1!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ NumRegArgs := 8!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveCallout (in category 'primitives') -----
+ primitiveCallout
+ "IMPORTANT: IF YOU CHANGE THE NAME OF THIS METHOD YOU MUST CHANGE
+ Interpreter>>primitiveCalloutToFFI
+ TO REFLECT THE CHANGE."
+
+ "Perform a function call to a foreign function.
+ Only invoked from method containing explicit external call spec."
+
+ <returnTypeC: #void>
+ <export: true>
+ | meth externalFunction |
+ meth := interpreterProxy primitiveMethod.
+ (interpreterProxy literalCountOf: meth) > 0 ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadMethod].
+ externalFunction := interpreterProxy literal: 0 ofMethod: meth.
+ self ffiCall: externalFunction ArgArrayOrNil: nil NumArgs: interpreterProxy methodArgumentCount.
+ ^0!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ <var: #value type: #float>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value.
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiArgSpecSize (in category 'accessing') -----
+ ffiArgSpecSize
+ "Answer the value of ffiArgSpecSize"
+
+ ^ ffiArgSpecSize!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
+ ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
+ <var: #procAddr type: #'void *'>
+ <arg: #calloutState type: #'CalloutState *'>
+ "Perform the callout, collect the result and and create the return value. If
+ there are floating-point arguments that are passed in registers then call a
+ dummy function to load them. This *must* be inlined because of the alloca of
+ the outgoing stack frame in ffiCall:SpecOnStack:Flags:NumArgs:Args:AndTypes:"
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushUnsignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>stringArgs (in category 'accessing') -----
+ stringArgs
+ "Answer the value of stringArgs"
+
+ ^ stringArgs!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushUnsignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForARM>>integerRegisters (in category 'accessing') -----
+ integerRegisters
+ "Answer the value of integerRegisters"
+
+ ^ integerRegisters!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
+ ffiPushSignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiArgHeader: (in category 'accessing') -----
+ ffiArgHeader: anObject
+ "Set the value of ffiArgHeader"
+
+ ^ffiArgHeader := anObject!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiRetHeader: (in category 'accessing') -----
+ ffiRetHeader: anObject
+ "Set the value of ffiRetHeader"
+
+ ^ffiRetHeader := anObject!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushUnsignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiReturnCStringFrom: (in category 'callout support') -----
+ ffiReturnCStringFrom: cPointer
+ "Create a Smalltalk string from a zero terminated C string"
+ | strLen strOop cString strPtr |
+ <var: #cString type: #'char *'>
+ <var: #strPtr type: #'char *'>
+ cPointer = nil ifTrue:[
+ ^interpreterProxy methodReturnValue: interpreterProxy nilObject]. "nil always returns as nil"
+ cString := self cCoerce: cPointer to:'char *'.
+ strLen := 0.
+ [(cString at: strLen) = 0] whileFalse:[strLen := strLen+1].
+ strOop := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: strLen.
+ strPtr := interpreterProxy firstIndexableField: strOop.
+ 0 to: strLen-1 do:[:i| strPtr at: i put: (cString at: i)].
+ ^interpreterProxy methodReturnValue: strOop!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
+ ffiPushSignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushPointerContentsOf:in: (in category 'marshalling') -----
+ ffiPushPointerContentsOf: oop in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ "Push the contents of the given external structure"
+ | ptrClass ptrAddress |
+ <inline: false>
+ ptrClass := interpreterProxy fetchClassOf: oop.
+ ptrClass == interpreterProxy classExternalAddress ifTrue:[
+ ptrAddress := interpreterProxy fetchPointer: 0 ofObject: oop.
+ "Don't you dare to pass pointers into object memory"
+ (interpreterProxy isInMemory: ptrAddress) ifTrue:
+ [^FFIErrorInvalidPointer].
+ ^self ffiPushPointer: ptrAddress in: calloutState].
+
+ ptrClass == interpreterProxy classByteArray ifTrue:
+ [ptrAddress := self cCoerce: (interpreterProxy firstIndexableField: oop) to: #int.
+ ^self ffiPushPointer: ptrAddress in: calloutState].
+ ^FFIErrorBadArg!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ ^ReentrantFFICalloutStateForARM!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
+ ffiPushSignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForARM>>regIndex: (in category 'accessing') -----
+ regIndex: anObject
+ "Set the value of regIndex"
+
+ ^regIndex := anObject!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiArgHeader (in category 'accessing') -----
+ ffiArgHeader
+ "Answer the value of ffiArgHeader"
+
+ ^ ffiArgHeader!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
+ ffiPushSignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiIntegerValueOf: (in category 'callout support') -----
+ ffiIntegerValueOf: oop
+ "Support for generic callout. Return an integer value that is coerced as C would do."
+ | oopClass |
+ <inline: true>
+ (interpreterProxy isIntegerObject: oop) ifTrue:[^interpreterProxy integerValueOf: oop].
+ oop == interpreterProxy nilObject ifTrue:[^0]. "@@: should we really allow this????"
+ oop == interpreterProxy falseObject ifTrue:[^0].
+ oop == interpreterProxy trueObject ifTrue:[^1].
+ oopClass := interpreterProxy fetchClassOf: oop.
+ oopClass == interpreterProxy classFloat
+ ifTrue:[^(interpreterProxy floatValueOf: oop) asInteger].
+ oopClass == interpreterProxy classCharacter
+ ifTrue:[^interpreterProxy fetchInteger: 0 ofObject: oop].
+ oopClass == interpreterProxy classLargePositiveInteger
+ ifTrue:[^interpreterProxy positive32BitValueOf: oop].
+ ^interpreterProxy signed32BitValueOf: oop "<- will fail if not integer"!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>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 |
+ roundedSize := structSize + 3 bitAnd: 3 bitInvert32.
+ calloutState currentArg + roundedSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ self mem: calloutState currentArg cp: pointer y: structSize.
+ calloutState currentArg: calloutState currentArg + roundedSize.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>structReturnSize: (in category 'accessing') -----
+ structReturnSize: anObject
+ "Set the value of structReturnSize"
+
+ ^structReturnSize := anObject!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') -----
+ ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState
+ <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 = 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"
+ 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
+ fetchPointer: (retVal bitAnd: 255)
+ ofObject: interpreterProxy characterTable]!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushUnsignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin 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 */
+ #undef halt /* sqAssert.h provides a halt used in the interpreter */
+
+ #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;})
+ #endif
+ #if !!defined(getsp)
+ # define getsp() 0
+ #endif
+ #if !!defined(setsp)
+ # define setsp(ignored) 0
+ #endif
+
+ #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
+ #else
+ # define STACK_ALIGN_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
+ # 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
+ # endif
+ #endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */
+
+ #if !!defined(ALLOCA_LIES_SO_USE_GETSP)
+ # define ALLOCA_LIES_SO_USE_GETSP 0
+ #endif
+
+ /* 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);
+ }
+ '!
Item was added:
+ ReentrantFFICalloutState subclass: #ReentrantFFICalloutStateForARM
+ instanceVariableNames: 'regIndex integerRegisters'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForPPC>>regIndex (in category 'accessing') -----
+ regIndex
+ "Answer the value of regIndex"
+
+ ^ regIndex!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushUnsignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>isTypePointerToStruct: (in category 'translation') -----
+ isTypePointerToStruct: type "<String>"
+ ^type isString and: [type beginsWith: 'CalloutState *']!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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>
+ | ffiRetSpec returnStructSize |
+ retClass == interpreterProxy nilObject ifFalse:[
+ (interpreterProxy includesBehavior: retClass
+ ThatOf: interpreterProxy classExternalStructure)
+ ifFalse:[^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 | FFIFlagStructure)) = FFIFlagStructure ifTrue:
+ [returnStructSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
+ (self returnStructInRegisters: returnStructSize) ifFalse:
+ [calloutState structReturnSize: returnStructSize]].
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiLoadCalloutAddressFrom: (in category 'symbol loading') -----
+ ffiLoadCalloutAddressFrom: oop
+ "Load the function address for a call out to an external function"
+ | module moduleHandle functionName functionLength address |
+ <inline: false>
+ "First find and load the module"
+ module := interpreterProxy fetchPointer: externalFunctionInstSize + 1 ofObject: oop.
+ moduleHandle := self ffiLoadCalloutModule: module.
+ interpreterProxy failed ifTrue:
+ [^0]. "failed"
+ "fetch the function name"
+ functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: oop.
+ (interpreterProxy isBytes: functionName) ifFalse:
+ [^self ffiFail: FFIErrorBadExternalFunction].
+ functionLength := interpreterProxy byteSizeOf: functionName.
+ address := interpreterProxy
+ ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: functionName) to: #int)
+ OfLength: functionLength
+ FromModule: moduleHandle.
+ (interpreterProxy failed or: [address = 0]) ifTrue:
+ [^self ffiFail: FFIErrorAddressNotFound].
+ ^address!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ <var: #value type: #float>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>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:"
+ | atomicType floatRet intRet |
+ <var: #floatRet type: #double>
+ <var: #intRet type: #usqLong>
+ <inline: true>
+
+ self registerArgsSlop + self cStackAlignment > 0 ifTrue:
+ [self setsp: calloutState argVector].
+
+ atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ (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].
+
+ "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 added:
+ ----- Method: ReentrantFFIPlugin class>>moduleName (in category 'accessing') -----
+ moduleName
+ "IMPORTANT: IF YOU CHANGE THE NAME OF THIS PLUGIN YOU MUST CHANGE
+ Interpreter>>primitiveCalloutToFFI
+ TO REFLECT THE CHANGE."
+ ^#('SqueakFFIPrims' 'FFIPlugin') first!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>initialize (in category 'initialize-release') -----
+ initialize
+ <doNotGenerate>
+ stringArgs := CArrayAccessor on: (Array new: ReentrantFFIPlugin maxNumArgs).
+ stringArgIndex := 0.
+ structReturnSize := 0!
Item was added:
+ ReentrantFFIPlugin subclass: #ReentrantPPCBEFFIPlugin
+ instanceVariableNames: ''
+ classVariableNames: 'NumRegArgs'
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForPPC>>floatRegisters (in category 'accessing') -----
+ floatRegisters
+ "Answer the value of floatRegisters"
+
+ ^ floatRegisters!
Item was added:
+ InterpreterPlugin subclass: #ReentrantFFIPlugin
+ instanceVariableNames: 'ffiLogEnabled externalFunctionInstSize'
+ classVariableNames: 'DefaultMaxStackSize ExternalFunctionAddressIndex ExternalFunctionArgTypesIndex ExternalFunctionFlagsIndex ExternalFunctionStackSizeIndex MaxNumArgs'
+ poolDictionaries: 'FFIConstants'
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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"
+ 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"
+ (calloutState 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: (self cCoerceSimple: retVal to: #sqInt).
+ 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 added:
+ ----- Method: ReentrantFFIPlugin>>ffiFree: (in category 'primitive support') -----
+ ffiFree: pointer
+ "Default to malloc/free. If a platform needs a different allocator define
+ something in the preamble and redefine this to take account of that."
+ <cmacro: '(pointer) free((void *)(pointer))'>
+ ^self!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushVoid:in: (in category 'callout support') -----
+ ffiPushVoid: ignored in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ "This is a fallback in case somebody tries to pass a 'void' value.
+ We could simply ignore the argument but I think it's better to let
+ the caller know what he did"
+ ^FFIErrorAttemptToPassVoid!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ 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!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
+ ffiPushSignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForPPC>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ regIndex := 0.
+ integerRegisters := CArrayAccessor on: (Array new: ReentrantPPCBEFFIPlugin numRegArgs).
+ floatRegisters := CArrayAccessor on: (Array new: ReentrantPPCBEFFIPlugin numRegArgs)!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
+ ffiPushPointer: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState 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."
+
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['argVector'] -> [#'char *'].
+ ['currentArg'] -> [#'char *'].
+ ['limit'] -> [#'char *'].
+ ['ffiArgSpec'] -> [#'void *'].
+ ['stringArgs'] -> [{#'char *'. '[', ReentrantFFIPlugin maxNumArgs printString, ']'}] }
+ otherwise:
+ [#sqInt])]!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIFloatAt (in category 'primitives') -----
+ primitiveFFIFloatAt
+ "Return a (signed or unsigned) n byte integer from the given byte offset."
+ | byteOffset rcvr addr floatValue |
+ <export: true>
+ <inline: false>
+ <var: #floatValue type:'float '>
+ byteOffset := interpreterProxy stackIntegerValue: 0.
+ rcvr := interpreterProxy stackObjectValue: 1.
+ interpreterProxy failed ifTrue:[^0].
+ addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
+ interpreterProxy failed ifTrue:[^0].
+ self cCode:'((int*)(&floatValue))[0] = ((int*)addr)[0]'.
+ interpreterProxy pop: 2.
+ ^interpreterProxy pushFloat: floatValue!
Item was added:
+ ReentrantFFIPlugin subclass: #ReentrantARMFFIPlugin
+ instanceVariableNames: ''
+ classVariableNames: 'NumRegArgs'
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiLoadCalloutModule: (in category 'symbol loading') -----
+ ffiLoadCalloutModule: module
+ "Load the given module and return its handle"
+ | moduleHandlePtr moduleHandle ffiModuleName moduleLength rcvr ptr |
+ <var: #ptr type:'int *'>
+ (interpreterProxy isBytes: module) ifTrue:[
+ "plain module name"
+ ffiModuleName := module.
+ moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
+ moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength.
+ (interpreterProxy failed
+ or: [moduleHandle = 0]) ifTrue:
+ [^self ffiFail: FFIErrorModuleNotFound]. "failed"
+ ^moduleHandle].
+ "Check if the external method is defined in an external library"
+ rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
+ (interpreterProxy is: rcvr KindOfClass: interpreterProxy classExternalLibrary) ifFalse:
+ [^self ffiFail: FFIErrorNoModule].
+ "external library"
+ moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
+ moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary.
+ interpreterProxy failed ifTrue:[^0].
+ moduleHandle = 0 ifTrue:["need to reload module"
+ ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr.
+ (interpreterProxy isBytes: ffiModuleName) ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary].
+ moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
+ moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength.
+ (interpreterProxy failed
+ or: [moduleHandle = 0]) ifTrue:
+ [^self ffiFail: FFIErrorModuleNotFound]. "failed"
+ "and store back"
+ ptr := interpreterProxy firstIndexableField: moduleHandlePtr.
+ ptr at: 0 put: moduleHandle].
+ ^moduleHandle!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForARM>>integerRegisters: (in category 'accessing') -----
+ integerRegisters: anObject
+ "Set the value of integerRegisters"
+
+ ^integerRegisters := anObject!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiLogCallout: (in category 'symbol loading') -----
+ ffiLogCallout: lit
+ <returnTypeC: #void>
+ "fetch the function name"
+ | functionName |
+ ffiLogEnabled ifTrue:[
+ functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: lit.
+ (interpreterProxy isBytes: functionName) ifFalse:[^nil].
+ self ffiLogCall: (interpreterProxy firstIndexableField: functionName)
+ OfLength: (interpreterProxy byteSizeOf: functionName).
+ ].!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>argVector: (in category 'accessing') -----
+ argVector: anObject
+ "Set the value of argVector"
+
+ ^argVector := anObject!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
+ ffiPushPointer: pointer in: calloutState
+ <var: #pointer type: #'void *'>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: pointer.
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>isCalleePopsConvention: (in category 'callout support') -----
+ isCalleePopsConvention: callType
+ <cmacro: '(callType) (PLATFORM_API_USES_CALLEE_POPS_CONVENTION && (callType) == FFICallTypeApi)'>
+ ^callType == FFICallTypeApi!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') -----
+ primitiveFFIDoubleAt
+ "Return a (signed or unsigned) n byte integer from the given byte offset."
+ | byteOffset rcvr addr floatValue |
+ <export: true>
+ <inline: false>
+ <var: #floatValue type:'double '>
+ byteOffset := interpreterProxy stackIntegerValue: 0.
+ rcvr := interpreterProxy stackObjectValue: 1.
+ interpreterProxy failed ifTrue:[^0].
+ addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
+ interpreterProxy failed ifTrue:[^0].
+ self cCode:'((int*)(&floatValue))[0] = ((int*)addr)[0]'.
+ self cCode:'((int*)(&floatValue))[1] = ((int*)addr)[1]'.
+ interpreterProxy pop: 2.
+ ^interpreterProxy pushFloat: floatValue
+ !
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushUnsignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>maxNumArgs (in category 'accessing') -----
+ maxNumArgs
+ ^MaxNumArgs!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushUnsignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushUnsignedLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLong: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForPPC 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 '[', ReentrantPPCBEFFIPlugin numRegArgs printString, ']')].
+ ['floatRegisters'] -> [#(#double '[', ReentrantPPCBEFFIPlugin numRegArgs printString, ']')] }
+ otherwise:
+ [#sqInt])]!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiArgSpec (in category 'accessing') -----
+ ffiArgSpec
+ "Answer the value of ffiArgSpec"
+
+ ^ ffiArgSpec!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>limit (in category 'accessing') -----
+ limit
+ "Answer the value of limit"
+
+ ^ limit!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>isAtomicType: (in category 'primitive support') -----
+ isAtomicType: typeSpec
+ ^typeSpec anyMask: FFIFlagAtomic!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushUnsignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>nonRegisterStructReturnIsViaImplicitFirstArgument (in category 'marshalling') -----
+ nonRegisterStructReturnIsViaImplicitFirstArgument
+ "Answer if a struct returned in memory is returned to the
+ referent of a pointer passed as an implciit first argument.
+ It almost always is. Subclasses can override if not."
+ ^true!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiArgSpecSize: (in category 'accessing') -----
+ ffiArgSpecSize: anObject
+ "Set the value of ffiArgSpecSize"
+
+ ^ffiArgSpecSize := anObject!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
+ ffiPushSignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ VMStructType subclass: #ReentrantFFICalloutState
+ instanceVariableNames: 'argVector currentArg limit structReturnSize callFlags ffiArgSpec ffiArgSpecSize ffiArgHeader ffiRetHeader stringArgIndex stringArgs'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiSupportsCallingConvention: (in category 'callout support') -----
+ ffiSupportsCallingConvention: aCallingConvention
+ "Currently all target platforms (Mac OS X ppc or x86, linux x86, Win32) answer true
+ for the two calling conventions, FFICallTypeCDecl FFICallTypeApi, so let's not waste
+ time by testing for these. The only issue is whether the FFICallTypeApi is callee pops
+ or not (which itself is of little importance to an alloca-based implementation, but does
+ save a few instructions if not). Subclasses can still override if necessary."
+
+ ^true "or: [aCallingConvention = FFICallTypeCDecl or: [callType == FFICallTypeApi]]"!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
+ ffiPushSignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ <var: #value type: #sqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>stringArgIndex (in category 'accessing') -----
+ stringArgIndex
+ "Answer the value of stringArgIndex"
+
+ ^ stringArgIndex!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ <var: #value type: #sqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>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 PowerPC, which
+ has 8 register arguments in the calling convention, register arguments are also written to the stack.
+ So we must leave room for 8 * 4 bytes to avoid overwriting the marshalling stack as register
+ arguments are written to the stack during calls to interpreterProxy etc."
+ ^32!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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. For example, on
+ PowerPC, which has 8 register arguments in the calling convention, register arguments are also
+ written to the stack. So unless space is left for them, calls during marshalling prior to the actual
+ callout (e.g. to interpreterProxy object manipulation routines) can end up overwriting the
+ marshalling stack as register arguments are written to the stack during calls."
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiAlloc: (in category 'primitive support') -----
+ ffiAlloc: bytes
+ "Default to malloc/free. If a platform needs a different allocator define
+ something in the preamble and redefine this to take account of that."
+ <cmacro: '(bytes) (usqInt)malloc(bytes)'>
+ ^ByteArray new: bytes!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>callFlags: (in category 'accessing') -----
+ callFlags: anObject
+ "Set the value of callFlags"
+
+ ^callFlags := anObject!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSignedLongLongOop:in: (in category 'callout support') -----
+ ffiPushSignedLongLongOop: oop in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ "Push a longlong type (e.g., a 64bit integer).
+ Note: Coercions from float are *not* supported."
+ | value |
+ <var: #value type: #sqLong>
+ (oop == interpreterProxy nilObject
+ or: [oop == interpreterProxy falseObject])
+ ifTrue:[value := 0] ifFalse:
+ [oop == interpreterProxy trueObject
+ ifTrue:[value := 1] ifFalse:
+ [value := interpreterProxy signed64BitValueOf: oop.
+ interpreterProxy failed ifTrue:
+ [^FFIErrorCoercionFailed]]].
+ ^self ffiPushSignedLongLong: value in: calloutState!
Item was added:
+ ReentrantFFICalloutState subclass: #ReentrantFFICalloutStateForPPC
+ instanceVariableNames: 'regIndex integerRegisters floatRegisters'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>primitiveCalloutWithArgs (in category 'primitives') -----
+ primitiveCalloutWithArgs
+ "Perform a function call to a foreign function.
+ Only invoked from ExternalFunction>>invokeWithArguments:"
+
+ <returnTypeC: #void>
+ <export: true>
+ | externalFunction argArray nArgs |
+ interpreterProxy methodArgumentCount = 1 ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ externalFunction := interpreterProxy stackValue: 1.
+ argArray := interpreterProxy stackValue: 0.
+ (interpreterProxy isArray: argArray) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ nArgs := interpreterProxy slotSizeOf: argArray.
+ self ffiCall: externalFunction ArgArrayOrNil: argArray NumArgs: nArgs.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>alloca: (in category 'simulation') -----
+ alloca: size
+ <doNotGenerate>
+ ^ByteArray new: size!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
+ ffiPushPointer: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForPPC>>integerRegisters (in category 'accessing') -----
+ integerRegisters
+ "Answer the value of integerRegisters"
+
+ ^ integerRegisters!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>dispatchFunctionPointer: (in category 'callout support') -----
+ dispatchFunctionPointer: aFunctionPointer
+ "In C aFunctionPointer is void (*aFunctionPointer)()"
+ <cmacro: '(aFunctionPointer) (aFunctionPointer)()'>
+ ^self perform: aFunctionPointer!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
+ ffiPushPointer: pointer in: calloutState
+ <var: #pointer type: #'void *'>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushUnsignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
+ ffiPushSignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushUnsignedLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLong: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushUnsignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 4 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ calloutState currentArg: calloutState currentArg + 4.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutStateForPPC>>regIndex: (in category 'accessing') -----
+ regIndex: anObject
+ "Set the value of regIndex"
+
+ ^regIndex := anObject!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiAddressOf:startingAt:size: (in category 'primitive support') -----
+ ffiAddressOf: rcvr startingAt: byteOffset size: byteSize
+ "return an int of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr. Nominally intended for use with ExternalAddress objects, this code will work (for obscure historical reasons) with plain Byte or Word Arrays as well. "
+ | rcvrClass rcvrSize addr |
+ (interpreterProxy isBytes: rcvr) ifFalse:[^interpreterProxy primitiveFail].
+ (byteOffset > 0) ifFalse:[^interpreterProxy primitiveFail].
+ rcvrClass := interpreterProxy fetchClassOf: rcvr.
+ rcvrSize := interpreterProxy byteSizeOf: rcvr.
+ rcvrClass == interpreterProxy classExternalAddress ifTrue:[
+ (rcvrSize = 4) ifFalse:[^interpreterProxy primitiveFail].
+ addr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
+ "don't you dare to read from object memory!!"
+ (addr == 0 or:[interpreterProxy isInMemory: addr])
+ ifTrue:[^interpreterProxy primitiveFail].
+ ] ifFalse:[
+ (byteOffset+byteSize-1 <= rcvrSize)
+ ifFalse:[^interpreterProxy primitiveFail].
+ addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: 'int'.
+ ].
+ addr := addr + byteOffset - 1.
+ ^addr!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>limit: (in category 'accessing') -----
+ limit: anObject
+ "Set the value of limit"
+
+ ^limit := anObject!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ <var: #value type: #sqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantARMFFIPlugin>>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: ReentrantARMFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ <arg: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
+ ffiPushSignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushUnsignedLongLongOop:in: (in category 'callout support') -----
+ ffiPushUnsignedLongLongOop: oop in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ "Push an unsigned longlong type (e.g., a 64bit integer).
+ Note: Coercions from float are *not* supported."
+ | value |
+ <var: #value type: #usqLong>
+ (oop == interpreterProxy nilObject
+ or: [oop == interpreterProxy falseObject])
+ ifTrue:[value := 0] ifFalse:
+ [oop == interpreterProxy trueObject
+ ifTrue:[value := 1] ifFalse:
+ [value := interpreterProxy positive64BitValueOf: oop.
+ interpreterProxy failed ifTrue:
+ [^FFIErrorCoercionFailed]]].
+ ^self ffiPushUnsignedLongLong: value in: calloutState!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
+ ffiPushSignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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:'int *'>
+ oop := interpreterProxy stackObjectValue: 0.
+ 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:[interpreterProxy isInMemory: addr])
+ ifTrue:[^interpreterProxy primitiveFail].
+ self ffiFree: addr.
+ ^ptr at: 0 put: 0. "cleanup"
+ !
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiReturnType: (in category 'symbol loading') -----
+ ffiReturnType: specOnStack
+ "Answer the return type object for the current invocation"
+ | specLiteral argTypes |
+ specLiteral := specOnStack
+ ifTrue: [interpreterProxy stackValue: 1]
+ ifFalse: [interpreterProxy literal: 0 ofMethod: interpreterProxy primitiveMethod].
+ argTypes := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: specLiteral.
+ ^interpreterProxy fetchPointer: 0 ofObject: argTypes!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>callFlags (in category 'accessing') -----
+ callFlags
+ "Answer the value of callFlags"
+
+ ^ callFlags!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>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 x86 this is 0"
+ ^0!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ <var: #value type: #double>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState currentArg + 8 > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy storeFloatAtPointer: calloutState currentArg from: value.
+ calloutState currentArg: calloutState currentArg + 8.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiArgSpec: (in category 'accessing') -----
+ ffiArgSpec: anObject
+ "Set the value of ffiArgSpec"
+
+ ^ffiArgSpec := anObject!
Item was added:
+ ----- Method: ReentrantIA32FFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ "Answer if a struct result of a given size is returned in memory or not."
+ <cmacro: '(sz) (WIN32_X86_STRUCT_RETURN && (sz) <= 8 && !!((sz)&((sz)-1)))'>
+ ^returnStructSize <= 8 and: [(returnStructSize bitAnd: returnStructSize - 1) = 0]!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>currentArg: (in category 'accessing') -----
+ currentArg: anObject
+ "Set the value of currentArg"
+
+ ^currentArg := anObject!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>currentArg (in category 'accessing') -----
+ currentArg
+ "Answer the value of currentArg"
+
+ ^ currentArg!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushStructureContentsOf:in: (in category 'callout support') -----
+ ffiPushStructureContentsOf: oop in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ "Push the contents of the given external structure"
+ | ptrClass ptrAddress |
+ <inline: true>
+ ptrClass := interpreterProxy fetchClassOf: oop.
+ ptrClass == interpreterProxy classExternalAddress ifTrue:["ExternalAddress is bytes"
+ ptrAddress :=interpreterProxy fetchPointer: 0 ofObject: oop.
+ "There is no way we can make sure the structure is valid.
+ But we can at least check for attempts to pass pointers to ST memory."
+ (interpreterProxy isInMemory: ptrAddress)
+ ifTrue:[^FFIErrorInvalidPointer].
+ ^self ffiPushStructure: (self cCoerceSimple: ptrAddress to: #'void *')
+ ofSize: (calloutState ffiArgHeader bitAnd: FFIStructSizeMask)
+ typeSpec: calloutState ffiArgSpec
+ ofLength: calloutState ffiArgSpecSize
+ in: calloutState].
+ ptrClass == interpreterProxy classByteArray ifTrue:[
+ "The following is a somewhat pessimistic test but I like being sure..."
+ (interpreterProxy byteSizeOf: oop) = (calloutState ffiArgHeader bitAnd: FFIStructSizeMask)
+ ifFalse:[^FFIErrorStructSize].
+ ptrAddress := self cCoerceSimple: (interpreterProxy firstIndexableField: oop) to: #int.
+ (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:[
+ ^self ffiPushStructure: (self cCoerceSimple: ptrAddress to: #'void *')
+ ofSize: (calloutState ffiArgHeader bitAnd: FFIStructSizeMask)
+ typeSpec: calloutState ffiArgSpec
+ ofLength: calloutState ffiArgSpecSize
+ in: calloutState].
+ "If FFIFlagPointer + FFIFlagStructure is set use ffiPushPointer on the contents"
+ (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = 4
+ ifFalse:[^FFIErrorStructSize].
+ ptrAddress := interpreterProxy fetchPointer: 0 ofObject: oop.
+ (interpreterProxy isInMemory: ptrAddress)
+ ifTrue:[^FFIErrorInvalidPointer].
+ ^self ffiPushPointer: ptrAddress in: calloutState].
+ ^FFIErrorBadArg!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushString:OfLength:in: (in category 'marshalling') -----
+ ffiPushString: pointer OfLength: length in: calloutState
+ <var: #pointer type: #'char *'>
+ <var: #calloutState type: #'CalloutState *'>
+ | copy |
+ <var: #copy type: #'char *'>
+ <inline: true>
+ calloutState stringArgIndex >= MaxNumArgs ifTrue:
+ [^PrimErrBadNumArgs negated].
+ copy := self malloc: length + 1.
+ copy isNil ifTrue:
+ [^PrimErrNoCMemory negated].
+ self mem: copy cp: pointer y: length.
+ copy at: length put: 0.
+ calloutState stringArgs at: calloutState stringArgIndex put: copy.
+ calloutState stringArgIndex: calloutState stringArgIndex + 1.
+ ^self ffiPushPointer: copy in: calloutState!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
+ ffiPushSignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiLogCallsTo: (in category 'initialize') -----
+ ffiLogCallsTo: fileName
+ "This is a special entry point exposed such that client code can
+ enable and disable logging of FFI calls."
+ | ok |
+ <export: true>
+ <var: #fileName type: 'char*'>
+ fileName == nil ifTrue:[ "disable logging"
+ ok := self ffiLogFileName: nil OfLength: 0.
+ ok ifFalse:[^false].
+ ffiLogEnabled := false.
+ ] ifFalse:[ "enable logging"
+ ok := self ffiLogFileName: fileName OfLength: (self strlen: fileName).
+ ok ifFalse:[^false].
+ ffiLogEnabled := true.
+ ].
+ ^true!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
+ ffiPushSignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ReentrantFFIPlugin subclass: #ReentrantIA32FFIPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushUnsignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ self shouldBeImplemented.
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>hasHeaderFile (in category 'C support code') -----
+ hasHeaderFile
+ "If there is a single intrinsic header file to be associated with the plugin, here is where you want to flag"
+ ^false!
Item was added:
+ ----- Method: ReentrantFFICalloutState class>>structTypeName (in category 'translation') -----
+ structTypeName
+ ^'CalloutState' "Drop verbiage and platform specifics"!
Item was added:
+ ----- Method: ReentrantPPCBEFFIPlugin class>>numRegArgs (in category 'accessing') -----
+ numRegArgs
+ ^NumRegArgs!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiArgByValue:in: (in category 'callout support') -----
+ ffiArgByValue: oop in: calloutState
+ "Support for generic callout. Prepare an argument by value for a callout."
+ <var: #calloutState type: #'CalloutState *'>
+ | atomicType intValue floatValue |
+ <inline: true>
+ <var: #floatValue type: #double>
+ atomicType := self atomicTypeOf: calloutState ffiArgHeader.
+ "check if the range is valid"
+ (atomicType < 0 or:[atomicType > FFITypeDoubleFloat])
+ ifTrue:[^FFIErrorBadAtomicType].
+ atomicType < FFITypeSingleFloat ifTrue:["integer types"
+ (atomicType >> 1) = (FFITypeSignedLongLong >> 1)
+ ifTrue:[intValue := oop] "ffi support code must coerce longlong"
+ ifFalse:[intValue := self ffiIntegerValueOf: oop]. "does all the coercions"
+ interpreterProxy failed ifTrue:[^FFIErrorCoercionFailed].
+ ^self dispatchOn: atomicType
+ in: #(
+ ffiPushVoid:in:
+ ffiPushUnsignedInt:in:
+ ffiPushUnsignedByte:in:
+ ffiPushSignedByte:in:
+ ffiPushUnsignedShort:in:
+ ffiPushSignedShort:in:
+ ffiPushUnsignedInt:in:
+ ffiPushSignedInt:in:
+ ffiPushUnsignedLongLongOop:in:
+ ffiPushSignedLongLongOop:in:
+ ffiPushUnsignedChar:in:
+ ffiPushSignedChar:in:)
+ with: intValue
+ with: calloutState].
+ "either float or double"
+ floatValue := self ffiFloatValueOf: oop.
+ interpreterProxy failed ifTrue:
+ [^FFIErrorCoercionFailed].
+ atomicType = FFITypeSingleFloat
+ ifTrue: [^self ffiPushSingleFloat: floatValue in: calloutState]
+ ifFalse:[^self ffiPushDoubleFloat: floatValue in: calloutState]!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>ffiContentsOfHandle:errCode: (in category 'callout support') -----
+ ffiContentsOfHandle: oop errCode: errCode
+ "Make sure that the given oop is a valid external handle"
+ <inline: true>
+ (interpreterProxy isIntegerObject: oop)
+ ifTrue:[^self ffiFail: errCode].
+ (interpreterProxy isBytes: oop)
+ ifFalse:[^self ffiFail: errCode].
+ ((interpreterProxy byteSizeOf: oop) == 4)
+ ifFalse:[^self ffiFail: errCode].
+ ^interpreterProxy fetchPointer: 0 ofObject: oop!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>argVector (in category 'accessing') -----
+ argVector
+ "Answer the value of argVector"
+
+ ^ argVector!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>cStackAlignment (in category 'marshalling') -----
+ cStackAlignment
+ "Many ABIs mandate a particular stack alignment greater than the natural word size.
+ If so, this macro will answer that alignment. If not, this macro will answer 0. See
+ class-side preambleCCode."
+ <cmacro: '() STACK_ALIGN_BYTES'>
+ ^0!
Item was added:
+ ----- Method: ReentrantFFIPlugin class>>ancilliaryStructClasses (in category 'translation') -----
+ ancilliaryStructClasses
+ ^{ self calloutStateClass }!
Item was added:
+ ----- Method: ReentrantFFICalloutState>>ffiRetHeader (in category 'accessing') -----
+ ffiRetHeader
+ "Answer the value of ffiRetHeader"
+
+ ^ ffiRetHeader!
Item was added:
+ ----- Method: ReentrantFFIPlugin>>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 either one of ByteArray/String/Symbol or wordVariableSubclass."
+ | atomicType isString |
+ <inline: true>
+ atomicType := self atomicTypeOf: calloutState ffiArgHeader.
+ (atomicType = FFITypeBool) "No bools on input"
+ ifTrue:[^FFIErrorCoercionFailed].
+ ((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: (interpreterProxy firstIndexableField: oop)
+ OfLength: (interpreterProxy byteSizeOf: oop)
+ in: calloutState].
+ "Fall through to byte* test"
+ atomicType := FFITypeUnsignedByte].
+
+ (atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedByte >> 1)]) ifTrue:[
+ "byte* -- see comment on string above"
+ oopClass = interpreterProxy classByteArray ifTrue:["ByteArray"
+ ^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
+ isString := interpreterProxy includesBehavior: oopClass
+ ThatOf: interpreterProxy classString.
+ isString ifTrue:["String/Symbol"
+ ^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
+ atomicType = FFITypeVoid ifFalse:[^FFIErrorCoercionFailed].
+ "note: type void falls through"
+ ].
+
+ (atomicType <= FFITypeSignedInt "void/short/int"
+ or:[atomicType = FFITypeSingleFloat]) ifTrue:[
+ "require a word subclass to work"
+ (interpreterProxy isWords: oop) ifTrue:[
+ ^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState]].
+
+ ^FFIErrorCoercionFailed!
Item was removed:
- ----- Method: CoInterpreter>>primitiveObjectPointsTo (in category 'object access primitives') -----
- primitiveObjectPointsTo
- "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
- Override to handle Cogged methods where the method header is in the CogMethod."
- | rcvr thang header fmt lastField methodHeader |
- thang := self stackTop.
- rcvr := self stackValue: 1.
- (self isIntegerObject: rcvr) ifTrue:
- [^self pop: 2 thenPushBool: false].
-
- "Inlined version of lastPointerOf: for speed in determining if rcvr is a context or a compiled method."
- header := self baseHeader: rcvr.
- fmt := self formatOfHeader: header.
- fmt <= 4
- ifTrue:
- [(fmt = 3
- and: [self isContextHeader: header])
- ifTrue:
- [(self isMarriedOrWidowedContext: rcvr) ifTrue:
- [self externalWriteBackHeadFramePointers.
- (self isStillMarriedContext: rcvr) ifTrue:
- [^self pop: 2
- thenPushBool: (self marriedContext: rcvr
- pointsTo: thang
- stackDeltaForCurrentFrame: 2)]].
- "contexts end at the stack pointer"
- lastField := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr) * BytesPerWord]
- ifFalse:
- [lastField := (self sizeBitsOfSafe: rcvr) - BaseHeaderSize]]
- ifFalse:
- [fmt <= 12 "no pointers" ifTrue:
- [^self pop: 2 thenPushBool: false].
- "CompiledMethod: contains both pointers and bytes; may have an associated CogMethod"
- methodHeader := self longAt: rcvr + BaseHeaderSize.
- (self isCogMethodReference: methodHeader) ifTrue:
- [methodHeader := (self cCoerceSimple: methodHeader to: #'CogMethod *') methodHeader.
- methodHeader = thang ifTrue:
- [^self pop: 2 thenPushBool: true]].
- lastField := (self literalCountOfHeader: methodHeader) * BytesPerWord + BaseHeaderSize].
-
- BaseHeaderSize to: lastField by: BytesPerWord do:
- [:i |
- (self longAt: rcvr + i) = thang ifTrue:
- [^self pop: 2 thenPushBool: true]].
- self pop: 2 thenPushBool: false!
More information about the Vm-dev
mailing list