[Vm-dev] VM Maker: VMMaker.oscog-EstebanLorenzano.1503.mcz
Eliot Miranda
eliot.miranda at gmail.com
Tue Nov 3 02:05:25 UTC 2015
Hi Esteban,
I *think* I understand the point of
"don't you dare to read from object memory!!"
+ (addr == 0 "or:[interpreterProxy isInMemory: addr]")
- (addr == 0 or:[interpreterProxy isInMemory: addr])
there are circumstances in which we *do* want to pass in an address in
object memory. But this seems a bit drastic. Could you give a specific
example? Also, shouldn't we be doing something like checking that the
address is associated with an object that is pinned?
So this change makes me nervous and I want you to calm my nerves ;-)
On Fri, Oct 30, 2015 at 9:39 AM, <commits at source.squeak.org> wrote:
>
> Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-EstebanLorenzano.1503.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-EstebanLorenzano.1503
> Author: EstebanLorenzano
> Time: 30 October 2015, 2:37:07.998518 pm
> UUID: 2cc25296-b733-4968-bd6b-8f3db5277693
> Ancestors: VMMaker.oscog-eem.1502
>
> general:
> - applying correct cast so compiler does not fails.
>
> ThreadedFFIPlugin:
> - ExternalAddress now are taken correctly (nor as ByteArray or Alien,
> because they are different beasts).
> - allow pushing of pointers to any type (into a ByteArray, an
> ExternalAddress or an Alien), to allow passing parameters style int*,
> float*, etc.
> - allow reading in memory to allow read chunks of ByteArray
>
> =============== Diff against VMMaker.oscog-eem.1502 ===============
>
> Item was changed:
> ----- Method: Cogit>>addressIsInInstructions: (in category 'testing')
> -----
> addressIsInInstructions: address
> <var: #address type: #'AbstractInstruction *'>
> + ^self cCode: '!!((((unsigned)address) & BytesPerWord-1)) \
> - ^self cCode: '!!((unsigned)((address) & BytesPerWord-1)) \
> && (address) >= &abstractOpcodes[0] \
> && (address) <
> &abstractOpcodes[opcodeIndex]'
> inSmalltalk: [(abstractOpcodes object identityIndexOf:
> address) between: 1 and: opcodeIndex]!
>
> Item was changed:
> ----- Method: ThreadedFFIPlugin>>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]")
> - (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 changed:
> ----- Method: ThreadedFFIPlugin>>ffiAtomicArgByReference:Class:in: (in
> category 'callout support') -----
> ffiAtomicArgByReference: oop Class: oopClass in: calloutState
> <var: #calloutState type: #'CalloutState *'>
> "Support for generic callout. Prepare a pointer reference to an
> atomic type for callout.
> + Note:
> + for type 'void*' we allow ByteArray/String/Symbol,
> wordVariableSubclass, Alien or ExternalAddress.
> + for other types we allow ByteArray, wordVariableSubclass,
> Alien or ExternalAddress."
> - Note: for type 'void*' we allow ByteArray/String/Symbol,
> wordVariableSubclass or Alien."
> | atomicType isString isAlien |
> <inline: true>
> atomicType := self atomicTypeOf: calloutState ffiArgHeader.
> (atomicType = FFITypeBool) ifTrue: "No bools on input"
> [^FFIErrorCoercionFailed].
> isAlien := (isString := interpreterProxy
> includesBehavior: oopClass
> ThatOf: interpreterProxy
> classString)
> ifTrue: [false]
> ifFalse:
> [interpreterProxy
> includesBehavior: oopClass
> ThatOf: interpreterProxy
> classAlien].
> ((atomicType >> 1) = (FFITypeSignedChar >> 1)) ifTrue:"string
> value (char*)"
> "note: the only types allowed for passing into char* types
> are
> ByteArray, String, Symbol, Alien and *no* other byte
> indexed objects
> (e.g., CompiledMethod, LargeInteger). We only check for
> strings
> here and fall through to the byte* check otherwise."
> [isString ifTrue:"String/Symbol"
> "Strings must be allocated by the ffi support code"
> [^self ffiPushString: (interpreterProxy
> firstIndexableField: oop)
> OfLength: (interpreterProxy byteSizeOf:
> oop)
> in: calloutState].
> "Fall through to byte* test"
> atomicType := FFITypeUnsignedByte].
>
> self cppIf: COGMTVM ifTrue:
> ["Since all the following pass the address of the first indexable
> field we need to fail
> the call if it is threaded and the object is young, since it may
> move during the call."
> ((calloutState callFlags anyMask: FFICallFlagThreaded)
> and: [(isAlien not or: [self isDirectAlien: oop])
> and: [interpreterProxy isYoung: oop]]) ifTrue:
> [^PrimErrObjectMayMove negated]].
>
> (atomicType = FFITypeVoid or:[(atomicType >> 1) =
> (FFITypeSignedByte >> 1)]) ifTrue:
> "byte* -- see comment on string above"
> + [(isString or: [oopClass = interpreterProxy
> classByteArray]) ifTrue: "String/Symbol/ByteArray"
> - [(isString
> - or: [oopClass = interpreterProxy classByteArray])
> ifTrue:"String/Symbol/ByteArray"
> [^self ffiPushPointer: (interpreterProxy
> firstIndexableField: oop) in: calloutState].
> + (oopClass = interpreterProxy classExternalAddress) ifTrue:
> + [^self ffiPushPointer: (self longAt: oop +
> interpreterProxy baseHeaderSize) in: calloutState].
> + isAlien ifTrue:
> - (isAlien or: [oopClass = interpreterProxy
> classExternalAddress]) ifTrue:
> [^self ffiPushPointer: (self pointerForOop: (self
> startOfData: oop)) in: calloutState].
> atomicType = FFITypeVoid ifFalse:
> [^FFIErrorCoercionFailed]].
> "note: type void falls through"
>
> + "I can push pointers to any type (take for instance calls who
> receive int* output arguments, etc.)
> + but I need to store them into a ByteArray, ExternalAddress or
> Alien"
> + (atomicType <= FFITypeDoubleFloat) ifTrue:
> + [((interpreterProxy isWords: oop) or: [oopClass =
> interpreterProxy classByteArray]) ifTrue:
> + [^self ffiPushPointer: (interpreterProxy
> firstIndexableField: oop) in: calloutState].
> + (oopClass = interpreterProxy classExternalAddress) ifTrue:
> + [^self ffiPushPointer: (self longAt: oop +
> interpreterProxy baseHeaderSize) in: calloutState].
> + isAlien ifTrue:
> + [^self ffiPushPointer: (self pointerForOop: (self
> startOfData: oop)) in: calloutState]].
> - (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!
>
>
--
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20151102/f9b25711/attachment-0001.htm
More information about the Vm-dev
mailing list