Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1687.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1687 Author: eem Time: 20 February 2016, 12:07:16.278693 pm UUID: fde8cc46-be93-419f-8087-ef54c0b4f237 Ancestors: VMMaker.oscog-eem.1686
Fix the signature of characterbjectOf:.
Fix slips in ThreadedFFICalloutStateForX64>>initialize.
Fix 32-bit int vs 64-bit pointers issues in primitiveFFI[Allocate|Free].
Get X64SysVFFI plugin to deal with sixteen byte struct return.
=============== Diff against VMMaker.oscog-eem.1686 ===============
Item was changed: ----- Method: InterpreterProxy>>characterObjectOf: (in category 'object access') ----- characterObjectOf: characterCode <option: #(atLeastVMProxyMajor:minor: 1 13)> + <var: #cPtr type: #int> ^StackInterpreter objectMemoryClass characterObjectOf: characterCode!
Item was changed: ----- Method: ThreadedFFICalloutStateForX64>>initialize (in category 'initialize-release') ----- initialize super initialize. + integerRegisterIndex := floatRegisterIndex := 0. - registerIndex := 0. integerRegisters := CArrayAccessor on: (Array new: self class pluginClass numRegArgs). floatRegisters := CArrayAccessor on: (Array new: self class pluginClass numFloatRegArgs)!
Item was changed: ----- Method: ThreadedFFIPlugin>>ffiCheckReturn:With:in: (in category 'callout support') ----- ffiCheckReturn: retSpec With: retClass in: calloutState <var: #calloutState type: #'CalloutState *'> "Make sure we can return an object of the given type" <inline: true> + retClass = interpreterProxy nilObject ifFalse: + [(interpreterProxy + includesBehavior: retClass + ThatOf: interpreterProxy classExternalStructure) ifFalse: + [^FFIErrorBadReturn]]. - | ffiRetSpec | - retClass = interpreterProxy nilObject ifFalse:[ - (interpreterProxy includesBehavior: retClass - ThatOf: interpreterProxy classExternalStructure) - ifFalse:[^FFIErrorBadReturn]].
+ ((interpreterProxy isWords: retSpec) + and: [(interpreterProxy slotSizeOf: retSpec) > 0]) ifFalse: + [^FFIErrorWrongType]. + + calloutState ffiRetHeader: (interpreterProxy fetchLong32: 0 ofObject: retSpec). + (self isAtomicType: calloutState ffiRetHeader) ifFalse: + [retClass = interpreterProxy nilObject ifTrue: + [^FFIErrorBadReturn]]. - (interpreterProxy isWords: retSpec) - ifFalse:[^FFIErrorWrongType]. - (interpreterProxy slotSizeOf: retSpec) = 0 ifTrue:[^FFIErrorWrongType]. - ffiRetSpec := self cCoerce: (interpreterProxy firstIndexableField: retSpec) to: #int. - calloutState ffiRetHeader: (interpreterProxy longAt: ffiRetSpec). - (self isAtomicType: calloutState ffiRetHeader) ifFalse:[ - (retClass = interpreterProxy nilObject) - ifTrue:[^FFIErrorBadReturn]]. (calloutState ffiRetHeader bitAnd: (FFIFlagPointer bitOr: FFIFlagStructure)) = FFIFlagStructure ifTrue: [calloutState structReturnSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask)]. ^0!
Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIAllocate (in category 'primitives') ----- primitiveFFIAllocate "Primitive. Allocate an object on the external heap." | byteSize addr oop ptr | <export: true> <inline: false> + <var: #ptr type: #'long *'> - <var: #ptr type:'int *'> byteSize := interpreterProxy stackIntegerValue: 0. + interpreterProxy failed ifTrue: + [^nil]. - interpreterProxy failed ifTrue:[^nil]. addr := self ffiAlloc: byteSize. + addr = 0 ifTrue: + [^interpreterProxy primitiveFail]. - addr = 0 ifTrue:[^interpreterProxy primitiveFail]. oop := interpreterProxy instantiateClass: interpreterProxy classExternalAddress + indexableSize: (self sizeof: #long). - indexableSize: 4. ptr := interpreterProxy firstIndexableField: oop. ptr at: 0 put: addr. ^interpreterProxy pop: 2 thenPush: oop!
Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIFree (in category 'primitives') ----- primitiveFFIFree "Primitive. Free the object pointed to on the external heap." | addr oop ptr | <export: true> <inline: false> + <var: #ptr type: #'long *'> - <var: #ptr type:'int *'> oop := interpreterProxy stackObjectValue: 0. + ((interpreterProxy fetchClassOf: oop) = interpreterProxy classExternalAddress + and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #long)]) ifFalse: + [^interpreterProxy primitiveFail]. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy fetchClassOf: oop) = (interpreterProxy classExternalAddress) - ifFalse:[^interpreterProxy primitiveFail]. - (interpreterProxy byteSizeOf: oop) = 4 - ifFalse:[^interpreterProxy primitiveFail]. ptr := interpreterProxy firstIndexableField: oop. addr := ptr at: 0. "Don't you dare to free Squeak's memory!!" + (addr = 0 + or: [(addr asUnsignedLong bitAnd: (self sizeof: #long) - 1) ~= 0 + or: [interpreterProxy isInMemory: addr]]) ifTrue: + [^interpreterProxy primitiveFail]. - (addr = 0 or:[interpreterProxy isInMemory: addr]) - ifTrue:[^interpreterProxy primitiveFail]. self ffiFree: addr. + ^ptr at: 0 put: 0 "cleanup"! - ^ptr at: 0 put: 0. "cleanup" - !
Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveLoadSymbolFromModule (in category 'primitives') ----- primitiveLoadSymbolFromModule "Attempt to find the address of a symbol in a loaded library. loadSymbol: aSymbol fromModule: moduleName <primitive: 'primitiveLoadSymbolFromModule' error: errorCode module: 'SqueakFFIPrims'> " <export: true>
| symbol module moduleHandle address oop ptr |
<var: #address type: #'void *'> <var: #ptr type:'unsigned int *'> interpreterProxy methodArgumentCount = 2 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
module := interpreterProxy stackValue: 0. symbol := interpreterProxy stackValue: 1.
moduleHandle := self ffiLoadCalloutModule: module. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. address := interpreterProxy ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: symbol) to: #sqInt) OfLength: (interpreterProxy byteSizeOf: symbol) FromModule: moduleHandle. (interpreterProxy failed or: [address = 0]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. oop := interpreterProxy instantiateClass: interpreterProxy classExternalAddress indexableSize: 4. ptr := interpreterProxy firstIndexableField: oop. ptr at: 0 put: address. + ^interpreterProxy methodReturnValue: oop! - interpreterProxy methodReturnValue: oop!
Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveSetManualSurfacePointer (in category 'primitives - surfaces') ----- primitiveSetManualSurfacePointer "Create a 'manual surface' data-structure. See the ExternalForm class in the FFI package for example usage." "arguments: name(type, stack offset) surfaceID(Integer, 1) + ptr(uint32/uint64, 0)" - ptr(uint32, 0)" | surfaceID ptr result | <export: true> + <var: #ptr type: #'unsigned long'> - <var: #ptr type: #'unsigned int'> + interpreterProxy methodArgumentCount = 2 ifFalse: [^interpreterProxy primitiveFail]. - interpreterProxy methodArgumentCount == 2 ifFalse: [^interpreterProxy primitiveFail]. surfaceID := interpreterProxy stackIntegerValue: 1. + ptr := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0). - ptr := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifTrue: [^nil].
self touch: surfaceID; touch: ptr. + result := self setManualSurface: surfaceID Pointer: ptr asVoidPointer. - result := self cCode: 'setManualSurfacePointer(surfaceID, (void*)ptr)'. result = 0 ifTrue: [^interpreterProxy primitiveFail]. ^interpreterProxy pop: 2 !
Item was added: + ----- Method: ThreadedFFIX64SixteenByteReturn class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- + instVarNamesAndTypesForTranslationDo: aBinaryBlock + "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BlockStart struct." + + self instVarNames do: + [:ivn| + aBinaryBlock value: ivn value: #sqInt]!
Item was added: + ----- Method: ThreadedFFIX64SixteenByteReturn>>a (in category 'accessing') ----- + a + + ^ a!
Item was added: + ----- Method: ThreadedFFIX64SixteenByteReturn>>a: (in category 'accessing') ----- + a: anObject + + ^a := anObject!
Item was added: + ----- Method: ThreadedFFIX64SixteenByteReturn>>b (in category 'accessing') ----- + b + + ^ b!
Item was added: + ----- Method: ThreadedFFIX64SixteenByteReturn>>b: (in category 'accessing') ----- + b: anObject + + ^b := anObject!
Item was added: + ----- Method: ThreadedX64SysVFFIPlugin class>>ancilliaryClasses: (in category 'translation') ----- + ancilliaryClasses: options + ^{ self calloutStateClass. ThreadedFFIX64SixteenByteReturn }!
Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" | myThreadIndex atomicType floatRet intRet loadFloatRegs oop | <var: #floatRet type: #double> <var: #intRet type: 'SixteenByteReturn'> <inline: true> self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class]. self cppIf: COGMTVM ifTrue: [(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue: [myThreadIndex := interpreterProxy disownVM: 0]].
self registerArgsSlop + self cStackAlignment > 0 ifTrue: [self setsp: calloutState argVector].
calloutState floatRegisterIndex > 0 ifTrue: [self load: (calloutState floatRegisters at: 0) Flo: (calloutState floatRegisters at: 1) a: (calloutState floatRegisters at: 2) t: (calloutState floatRegisters at: 3) R: (calloutState floatRegisters at: 4) e: (calloutState floatRegisters at: 5) g: (calloutState floatRegisters at: 6) s: (calloutState floatRegisters at: 7)].
atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat > 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long, long, long)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(long, long, long, long, long, long)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)]] ifFalse: [intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturn (*)(long, long, long, long, long, long)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)]. "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector].
self cppIf: COGMTVM ifTrue: [(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue: [interpreterProxy ownVM: myThreadIndex]].
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: ["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: + [oop := self ffiReturnPointer: intRet a ofType: (self ffiReturnType: specOnStack) in: calloutState] - [oop := self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState] ifFalse: [oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^oop]. (atomicType >> 1) = (FFITypeSingleFloat > 1) ifTrue: [oop := interpreterProxy floatObjectOf: floatRet] ifFalse: + [oop := self ffiCreateIntegralResultOop: intRet a - [oop := self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState]. ^interpreterProxy methodReturnValue: oop!
Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') ----- ffiReturnStruct: sixteenByteRet ofType: ffiRetType in: calloutState <var: #sixteenByteRet type: 'SixteenByteReturn'> <var: #calloutState type: #'CalloutState *'> "Create a structure return value from an external function call. The value has been stored in alloca'ed space pointed to by the calloutState or in the return value." | retOop retClass oop | <inline: true> retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType. retOop := interpreterProxy instantiateClass: retClass indexableSize: 0. self remapOop: retOop in: [oop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: calloutState structReturnSize]. self mem: (interpreterProxy firstIndexableField: oop) cp: ((self returnStructInRegisters: calloutState structReturnSize) + ifTrue: [(self addressOf: sixteenByteRet) asVoidPointer] - ifTrue: [self addressOf: sixteenByteRet] ifFalse: [calloutState limit]) y: calloutState structReturnSize. interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. ^interpreterProxy methodReturnValue: retOop!
vm-dev@lists.squeakfoundation.org