VM Maker: VMMaker.oscog- nice.2366.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
5 messages Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog- nice.2366.mcz

commits-2
 
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog- nice.2366.mcz

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

Name: VMMaker.oscog- nice.2366
Author:  nice
Time: 17 April 2018, 3:37:48.684079 pm
UUID: 6d9bd2fa-c381-5d4b-b31e-c6d21225c848
Ancestors: VMMaker.oscog-VB.2365

Correct a 32bit-hardcoded pointer size in FFI
Correct two copy/paste typos in num32BitUnitsOf:

Note: I don't like the FFI code that I just corrected. IMO, it does the wrong thing.

if I have an argument spec is
    MyLib>>foo: aFoo
        <cdecl: void foo(Foo *)>
where Foo is some ExternalStructure subclass (Foo class>>fields ^#((x 'ushort') (y 'ushort')))

and that I try to pass (MyLib new foo: Foo new), it seems to me that the Foo new getHandle will be (ByteArray new: 4).
What I understand form the code that I just corrected is that we are trying to pass the contents of the ByteArray re-interpreted as a void pointer. Scary and wrong...

If I instead pass (MyLib new foo: Foo externalNew), it seems that we don't even bother to check if the (argSpec anyMask: FFIFlagPointer) and just force passing the structure by value (thru a memcpy on stack). Scary and wrong...

In general, every one use <cdecl: void foo(void *)> to work around this ill-behavior, and thus bypass type checks...

Also note that we can't even pass an ExternalData (think an Array of Foo), because ffiArgument:Spec:Class:in: insists on having actualArg class inheritsFrom: argType referentClass. ExternalData does not inherit from Foo, event if its type matches (ExternalType structTypeNamed: #Foo). That's crazy...
Another reason while people use <cdecl: void foo(void *)>

It's high time to consider a rewrite IMO.

=============== Diff against VMMaker.oscog-VB.2365 ===============

Item was changed:
  ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') -----
  num32BitUnitsOf: objOop
+ "Answer the number of 32-bit units in the given non-immediate object.
- "Answer the number of 16-bit units in the given non-immediate object.
  N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
  Does not adjust the size of contexts by stackPointer."
  ^(self numBytesOf: objOop) >> 2!

Item was changed:
  ----- Method: SpurMemoryManager>>num32BitUnitsOf: (in category 'object access') -----
  num32BitUnitsOf: objOop
+ "Answer the number of 32-bit units in the given non-immediate object.
- "Answer the number of 16-bit units in the given non-immediate object.
  N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
  Does not adjust the size of contexts by stackPointer."
  ^(self numBytesOf: objOop) >> 2!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>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) asVoidPointer.
  "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: ptrAddress
  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 := interpreterProxy firstIndexableField: oop.
  (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:
  "Since this involves passing 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."
  [self cppIf: COGMTVM ifTrue:
  [((calloutState callFlags anyMask: FFICallFlagThreaded)
  and: [interpreterProxy isYoung: oop]) ifTrue:
  [^PrimErrObjectMayMove negated]].
  ^self ffiPushStructure: ptrAddress
  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) = BytesPerWord ifFalse:
- (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = 4 ifFalse:
  [^FFIErrorStructSize].
  ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
  (interpreterProxy isInMemory: ptrAddress) ifTrue:
  [^FFIErrorInvalidPointer].
  ^self ffiPushPointer: ptrAddress in: calloutState].
  ^FFIErrorBadArg!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog- nice.2366.mcz

Eliot Miranda-2
 
Hi Nicolas,

   let's at least try and refactor so the validity checks are performed in methods with intention revealing selectors so we can more easily understand the code.  Alas I think your approach below won't work because it adds to the sqVirtualMachine Interpreter proxy interface.  Instead you could try implementing num32BitUnitsOf: in ThreadedFFIPlugin and use byteSizeOf:.

_,,,^..^,,,_ (phone)

> On Apr 17, 2018, at 5:38 AM, [hidden email] wrote:
>
>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog- nice.2366.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog- nice.2366
> Author:  nice
> Time: 17 April 2018, 3:37:48.684079 pm
> UUID: 6d9bd2fa-c381-5d4b-b31e-c6d21225c848
> Ancestors: VMMaker.oscog-VB.2365
>
> Correct a 32bit-hardcoded pointer size in FFI
> Correct two copy/paste typos in num32BitUnitsOf:
>
> Note: I don't like the FFI code that I just corrected. IMO, it does the wrong thing.
>
> if I have an argument spec is
>    MyLib>>foo: aFoo
>        <cdecl: void foo(Foo *)>
> where Foo is some ExternalStructure subclass (Foo class>>fields ^#((x 'ushort') (y 'ushort')))
>
> and that I try to pass (MyLib new foo: Foo new), it seems to me that the Foo new getHandle will be (ByteArray new: 4).
> What I understand form the code that I just corrected is that we are trying to pass the contents of the ByteArray re-interpreted as a void pointer. Scary and wrong...
>
> If I instead pass (MyLib new foo: Foo externalNew), it seems that we don't even bother to check if the (argSpec anyMask: FFIFlagPointer) and just force passing the structure by value (thru a memcpy on stack). Scary and wrong...
>
> In general, every one use <cdecl: void foo(void *)> to work around this ill-behavior, and thus bypass type checks...
>
> Also note that we can't even pass an ExternalData (think an Array of Foo), because ffiArgument:Spec:Class:in: insists on having actualArg class inheritsFrom: argType referentClass. ExternalData does not inherit from Foo, event if its type matches (ExternalType structTypeNamed: #Foo). That's crazy...
> Another reason while people use <cdecl: void foo(void *)>
>
> It's high time to consider a rewrite IMO.
>
> =============== Diff against VMMaker.oscog-VB.2365 ===============
>
> Item was changed:
>  ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: SpurMemoryManager>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: ThreadedFFIPlugin>>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) asVoidPointer.
>          "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: ptrAddress
>              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 := interpreterProxy firstIndexableField: oop.
>          (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:
>              "Since this involves passing 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."
>              [self cppIf: COGMTVM ifTrue:
>               [((calloutState callFlags anyMask: FFICallFlagThreaded)
>               and: [interpreterProxy isYoung: oop]) ifTrue:
>                  [^PrimErrObjectMayMove negated]].
>              ^self ffiPushStructure: ptrAddress
>                  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) = BytesPerWord ifFalse:
> -        (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = 4 ifFalse:
>              [^FFIErrorStructSize].
>          ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
>          (interpreterProxy isInMemory: ptrAddress) ifTrue:
>              [^FFIErrorInvalidPointer].
>          ^self ffiPushPointer: ptrAddress in: calloutState].
>      ^FFIErrorBadArg!
>
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog- nice.2366.mcz

Nicolas Cellier
 
Hi Eliot,
First, sorry for multiple posting...
I've been fooled by repeated ConnectionTimedOut windows.

Then, you must be right I've been away from VMMaker for too long...
Maybe we could use (self sizeof: sqintptr_t) or something like that?

As for the need of rewrite, yes!
I've tried to reverse-engineer all the logic in ThreadedFFIPlugin...
It's far from simple, and several combinations behave like I don't expect...
(but I'm not completely sure, the best way to confirm would be to simulate some TestCase).

What I understand is joined in the .xls attachment.
Left columns A-E are the status of formal parameter spec (3 bits of argType compiledSpec, and status of argType referentClass which can be either nil or some subclass of ExternalStructure)
Several combinations are valids:
- Basic atomic types and corresponding pointer types have a referentClass nil.
- Named atomic types aliases have referentClass being an ExternalStructure.
- Named structure types have referentClass being an ExternalStructure, unless they are undefined...

Column F is the secondary ffi method used to marshal the actual argument
Columns G-Q are various possible types for either the Smalltalk argument, or its handle in case of ExternalStruct.
I've omitted additional case of Alien (direct/indirect) and WordArray, so this is incomplete.

I have not made all the necessary conditions explicit...
For example we may have several ways to check types:
- thru equal compiledSpec (or mostly equal, except last bit for signed/unsigned atomic type tolerance)
- thru inherited referentClass



What I would like is more like this:



Not sure how the figure will pass thru the ML, but see attachment.


2018-04-17 16:11 GMT+02:00 Eliot Miranda <[hidden email]>:
 
Hi Nicolas,

   let's at least try and refactor so the validity checks are performed in methods with intention revealing selectors so we can more easily understand the code.  Alas I think your approach below won't work because it adds to the sqVirtualMachine Interpreter proxy interface.  Instead you could try implementing num32BitUnitsOf: in ThreadedFFIPlugin and use byteSizeOf:.

_,,,^..^,,,_ (phone)

> On Apr 17, 2018, at 5:38 AM, [hidden email] wrote:
>
>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog- nice.2366.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog- nice.2366
> Author:  nice
> Time: 17 April 2018, 3:37:48.684079 pm
> UUID: 6d9bd2fa-c381-5d4b-b31e-c6d21225c848
> Ancestors: VMMaker.oscog-VB.2365
>
> Correct a 32bit-hardcoded pointer size in FFI
> Correct two copy/paste typos in num32BitUnitsOf:
>
> Note: I don't like the FFI code that I just corrected. IMO, it does the wrong thing.
>
> if I have an argument spec is
>    MyLib>>foo: aFoo
>        <cdecl: void foo(Foo *)>
> where Foo is some ExternalStructure subclass (Foo class>>fields ^#((x 'ushort') (y 'ushort')))
>
> and that I try to pass (MyLib new foo: Foo new), it seems to me that the Foo new getHandle will be (ByteArray new: 4).
> What I understand form the code that I just corrected is that we are trying to pass the contents of the ByteArray re-interpreted as a void pointer. Scary and wrong...
>
> If I instead pass (MyLib new foo: Foo externalNew), it seems that we don't even bother to check if the (argSpec anyMask: FFIFlagPointer) and just force passing the structure by value (thru a memcpy on stack). Scary and wrong...
>
> In general, every one use <cdecl: void foo(void *)> to work around this ill-behavior, and thus bypass type checks...
>
> Also note that we can't even pass an ExternalData (think an Array of Foo), because ffiArgument:Spec:Class:in: insists on having actualArg class inheritsFrom: argType referentClass. ExternalData does not inherit from Foo, event if its type matches (ExternalType structTypeNamed: #Foo). That's crazy...
> Another reason while people use <cdecl: void foo(void *)>
>
> It's high time to consider a rewrite IMO.
>
> =============== Diff against VMMaker.oscog-VB.2365 ===============
>
> Item was changed:
>  ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: SpurMemoryManager>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: ThreadedFFIPlugin>>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) asVoidPointer.
>          "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: ptrAddress
>              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 := interpreterProxy firstIndexableField: oop.
>          (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:
>              "Since this involves passing 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."
>              [self cppIf: COGMTVM ifTrue:
>               [((calloutState callFlags anyMask: FFICallFlagThreaded)
>               and: [interpreterProxy isYoung: oop]) ifTrue:
>                  [^PrimErrObjectMayMove negated]].
>              ^self ffiPushStructure: ptrAddress
>                  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) = BytesPerWord ifFalse:
> -        (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = 4 ifFalse:
>              [^FFIErrorStructSize].
>          ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
>          (interpreterProxy isInMemory: ptrAddress) ifTrue:
>              [^FFIErrorInvalidPointer].
>          ^self ffiPushPointer: ptrAddress in: calloutState].
>      ^FFIErrorBadArg!
>


FFI_type_check.xls (52K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog- nice.2366.mcz

Nicolas Cellier
 


2018-04-17 16:43 GMT+02:00 Nicolas Cellier <[hidden email]>:
Hi Eliot,
First, sorry for multiple posting...
I've been fooled by repeated ConnectionTimedOut windows.

Then, you must be right I've been away from VMMaker for too long...
Maybe we could use (self sizeof: sqintptr_t) or something like that?

Hmm, but I see several references to BytesPerWord from within ThreadedFFI...
Are you sure that it won't work?
 

2018-04-17 16:11 GMT+02:00 Eliot Miranda <[hidden email]>:
 
Hi Nicolas,

   let's at least try and refactor so the validity checks are performed in methods with intention revealing selectors so we can more easily understand the code.  Alas I think your approach below won't work because it adds to the sqVirtualMachine Interpreter proxy interface.  Instead you could try implementing num32BitUnitsOf: in ThreadedFFIPlugin and use byteSizeOf:.

_,,,^..^,,,_ (phone)

> On Apr 17, 2018, at 5:38 AM, [hidden email] wrote:
>
>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog- nice.2366.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog- nice.2366
> Author:  nice
> Time: 17 April 2018, 3:37:48.684079 pm
> UUID: 6d9bd2fa-c381-5d4b-b31e-c6d21225c848
> Ancestors: VMMaker.oscog-VB.2365
>
> Correct a 32bit-hardcoded pointer size in FFI
> Correct two copy/paste typos in num32BitUnitsOf:
>
> Note: I don't like the FFI code that I just corrected. IMO, it does the wrong thing.
>
> if I have an argument spec is
>    MyLib>>foo: aFoo
>        <cdecl: void foo(Foo *)>
> where Foo is some ExternalStructure subclass (Foo class>>fields ^#((x 'ushort') (y 'ushort')))
>
> and that I try to pass (MyLib new foo: Foo new), it seems to me that the Foo new getHandle will be (ByteArray new: 4).
> What I understand form the code that I just corrected is that we are trying to pass the contents of the ByteArray re-interpreted as a void pointer. Scary and wrong...
>
> If I instead pass (MyLib new foo: Foo externalNew), it seems that we don't even bother to check if the (argSpec anyMask: FFIFlagPointer) and just force passing the structure by value (thru a memcpy on stack). Scary and wrong...
>
> In general, every one use <cdecl: void foo(void *)> to work around this ill-behavior, and thus bypass type checks...
>
> Also note that we can't even pass an ExternalData (think an Array of Foo), because ffiArgument:Spec:Class:in: insists on having actualArg class inheritsFrom: argType referentClass. ExternalData does not inherit from Foo, event if its type matches (ExternalType structTypeNamed: #Foo). That's crazy...
> Another reason while people use <cdecl: void foo(void *)>
>
> It's high time to consider a rewrite IMO.
>
> =============== Diff against VMMaker.oscog-VB.2365 ===============
>
> Item was changed:
>  ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: SpurMemoryManager>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: ThreadedFFIPlugin>>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) asVoidPointer.
>          "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: ptrAddress
>              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 := interpreterProxy firstIndexableField: oop.
>          (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:
>              "Since this involves passing 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."
>              [self cppIf: COGMTVM ifTrue:
>               [((calloutState callFlags anyMask: FFICallFlagThreaded)
>               and: [interpreterProxy isYoung: oop]) ifTrue:
>                  [^PrimErrObjectMayMove negated]].
>              ^self ffiPushStructure: ptrAddress
>                  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) = BytesPerWord ifFalse:
> -        (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = 4 ifFalse:
>              [^FFIErrorStructSize].
>          ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
>          (interpreterProxy isInMemory: ptrAddress) ifTrue:
>              [^FFIErrorInvalidPointer].
>          ^self ffiPushPointer: ptrAddress in: calloutState].
>      ^FFIErrorBadArg!
>


Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog- nice.2366.mcz

Nicolas Cellier
 


2018-04-17 17:03 GMT+02:00 Nicolas Cellier <[hidden email]>:


2018-04-17 16:43 GMT+02:00 Nicolas Cellier <[hidden email]>:
Hi Eliot,
First, sorry for multiple posting...
I've been fooled by repeated ConnectionTimedOut windows.

Then, you must be right I've been away from VMMaker for too long...
Maybe we could use (self sizeof: sqintptr_t) or something like that?

Hmm, but I see several references to BytesPerWord from within ThreadedFFI...
Are you sure that it won't work?
 

Ah, I think that I understand the confusion: 
#num32BitUnitsOf: changes are completely unrelated.
I do not use them in FFI, but just corrected a copy/paste error in the comment ;)


2018-04-17 16:11 GMT+02:00 Eliot Miranda <[hidden email]>:
 
Hi Nicolas,

   let's at least try and refactor so the validity checks are performed in methods with intention revealing selectors so we can more easily understand the code.  Alas I think your approach below won't work because it adds to the sqVirtualMachine Interpreter proxy interface.  Instead you could try implementing num32BitUnitsOf: in ThreadedFFIPlugin and use byteSizeOf:.

_,,,^..^,,,_ (phone)

> On Apr 17, 2018, at 5:38 AM, [hidden email] wrote:
>
>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog- nice.2366.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog- nice.2366
> Author:  nice
> Time: 17 April 2018, 3:37:48.684079 pm
> UUID: 6d9bd2fa-c381-5d4b-b31e-c6d21225c848
> Ancestors: VMMaker.oscog-VB.2365
>
> Correct a 32bit-hardcoded pointer size in FFI
> Correct two copy/paste typos in num32BitUnitsOf:
>
> Note: I don't like the FFI code that I just corrected. IMO, it does the wrong thing.
>
> if I have an argument spec is
>    MyLib>>foo: aFoo
>        <cdecl: void foo(Foo *)>
> where Foo is some ExternalStructure subclass (Foo class>>fields ^#((x 'ushort') (y 'ushort')))
>
> and that I try to pass (MyLib new foo: Foo new), it seems to me that the Foo new getHandle will be (ByteArray new: 4).
> What I understand form the code that I just corrected is that we are trying to pass the contents of the ByteArray re-interpreted as a void pointer. Scary and wrong...
>
> If I instead pass (MyLib new foo: Foo externalNew), it seems that we don't even bother to check if the (argSpec anyMask: FFIFlagPointer) and just force passing the structure by value (thru a memcpy on stack). Scary and wrong...
>
> In general, every one use <cdecl: void foo(void *)> to work around this ill-behavior, and thus bypass type checks...
>
> Also note that we can't even pass an ExternalData (think an Array of Foo), because ffiArgument:Spec:Class:in: insists on having actualArg class inheritsFrom: argType referentClass. ExternalData does not inherit from Foo, event if its type matches (ExternalType structTypeNamed: #Foo). That's crazy...
> Another reason while people use <cdecl: void foo(void *)>
>
> It's high time to consider a rewrite IMO.
>
> =============== Diff against VMMaker.oscog-VB.2365 ===============
>
> Item was changed:
>  ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: SpurMemoryManager>>num32BitUnitsOf: (in category 'object access') -----
>  num32BitUnitsOf: objOop
> +    "Answer the number of 32-bit units in the given non-immediate object.
> -    "Answer the number of 16-bit units in the given non-immediate object.
>       N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
>       Does not adjust the size of contexts by stackPointer."
>      ^(self numBytesOf: objOop) >> 2!
>
> Item was changed:
>  ----- Method: ThreadedFFIPlugin>>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) asVoidPointer.
>          "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: ptrAddress
>              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 := interpreterProxy firstIndexableField: oop.
>          (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:
>              "Since this involves passing 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."
>              [self cppIf: COGMTVM ifTrue:
>               [((calloutState callFlags anyMask: FFICallFlagThreaded)
>               and: [interpreterProxy isYoung: oop]) ifTrue:
>                  [^PrimErrObjectMayMove negated]].
>              ^self ffiPushStructure: ptrAddress
>                  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) = BytesPerWord ifFalse:
> -        (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = 4 ifFalse:
>              [^FFIErrorStructSize].
>          ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
>          (interpreterProxy isInMemory: ptrAddress) ifTrue:
>              [^FFIErrorInvalidPointer].
>          ^self ffiPushPointer: ptrAddress in: calloutState].
>      ^FFIErrorBadArg!
>