[Vm-dev] VM Maker: VMMaker.oscog-eem.2998.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jul 26 18:14:22 UTC 2021
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2998.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2998
Author: eem
Time: 26 July 2021, 11:14:10.863022 am
UUID: 1b14d588-af30-45b5-9893-e0c2cc8f8609
Ancestors: VMMaker.oscog-eem.2997
ThreadedFFIPlugin: Implement 1,2,4, & 8 byte signed & unsigned integer accessors for ExternalAddress & ByteArray. Mark as many primitives as possible with the FastCPrimitiveFlag. Avoid testing failed as much as possible (integerness is handled with macros inside generated plugin code).
=============== Diff against VMMaker.oscog-eem.2997 ===============
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiAddressOf:startingAt:size: (in category 'primitive support') -----
ffiAddressOf: rcvr startingAt: byteOffset size: byteSize
"Answer a long 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. Answer 0 on error."
| rcvrClass rcvrSize addr |
+ byteOffset > 0 ifFalse: [^nil].
- (interpreterProxy isBytes: rcvr) ifFalse:[^0].
- byteOffset > 0 ifFalse:[^0].
rcvrClass := interpreterProxy fetchClassOf: rcvr.
rcvrSize := interpreterProxy byteSizeOf: rcvr.
rcvrClass = interpreterProxy classExternalAddress
ifTrue:
+ [rcvrSize = BytesPerWord ifFalse: [^nil].
- [rcvrSize = BytesPerWord ifFalse:[^0].
addr := interpreterProxy fetchPointer: 0 ofObject: rcvr. "Hack!!!!"
"don't you dare to read from object memory (unless is pinned)!!"
(addr = 0 "or: [(interpreterProxy isInMemory: addr) or: [(interpreterProxy isPinned: rcvr) not]]") ifTrue:
+ [^nil]]
- [^0]]
ifFalse:
+ [byteOffset + byteSize - 1 <= rcvrSize ifFalse:
+ [^nil].
- [byteOffset+byteSize-1 <= rcvrSize ifFalse:
- [^0].
addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'sqIntptr_t'].
+ ^(addr + byteOffset - 1) asVoidPointer!
- addr := addr + byteOffset - 1.
- ^addr asVoidPointer!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveCDataModel (in category 'primitives') -----
primitiveCDataModel
"Two forms of C Data Model infomation.
With 0 arguments answer the string naming the C data model, LP32, LP64, LLP64, etc.
WIth 1 argument, which must be a ByteArray of at least 9 elements, answer the sizes of
char, short, int, long, long long, wchar_t, float, double, void *."
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| errorCode model |
interpreterProxy methodArgumentCount = 1 ifTrue:
[| sizes |
sizes := interpreterProxy stackValue: 0.
((interpreterProxy isBytes: sizes)
and: [(interpreterProxy slotSizeOf: sizes) = 9]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self cCoerceSimple: (interpreterProxy firstIndexableField: sizes) to: #'char *')
at: 0 put: (self sizeof: #char);
at: 1 put: (self sizeof: #short);
at: 2 put: (self sizeof: #int);
at: 3 put: (self sizeof: #long);
at: 4 put: (self sizeof: #'long long');
at: 5 put: (self sizeof: #wchar_t);
at: 6 put: (self sizeof: #float);
at: 7 put: (self sizeof: #double);
at: 8 put: (self sizeof: #'void *').
^interpreterProxy methodReturnValue: sizes].
interpreterProxy methodArgumentCount = 0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
"Attempt to identify the programming model:
LP32 ILP32 LLP64 LP64 ILP64 SILP64(unidentified)
char 8 8 8 8 8 8
short 16 16 16 16 16 64
int 16 32 32 32 64 64
long 32 32 32 64 64 64
long long 64 64 64 64 64 64
pointer 32 32 64 64 64 64"
errorCode := 0. "Set bit 0 if char is wrong, bit 1 if short is wrong, 2 for int, 3 for long, 4 for long long, 5 for void *"
(self sizeof: #char) ~= 1 ifTrue:
[errorCode := errorCode + 1].
(self sizeof: #short) ~= 2 ifTrue: "N.B. SILP64 exists on Cray supercomputers; we don't care..."
[errorCode := errorCode + 2].
(self sizeof: #'long long') ~= 8 ifTrue:
[errorCode := errorCode + 16].
(self sizeof: #'void *') = 8 ifTrue: "LP64 LLP64 ILP64"
[(self sizeof: #int) = 8 ifTrue: "ILP64"
[(self sizeof: #long) = 8
ifTrue: [model := 'ILP64']
ifFalse: [errorCode := errorCode + 8]].
(self sizeof: #int) = 4 ifTrue: "LP64 or LLP64"
[(self sizeof: #long) = 8 ifTrue: "LP64"
[model := 'LP64'].
(self sizeof: #long) = 4 ifTrue: "LLP64"
[model := 'LLP64'].
((self sizeof: #long) ~= 8 and: [(self sizeof: #long) ~= 4]) ifTrue:
[errorCode := errorCode + 8]].
((self sizeof: #int) ~= 8 and: [(self sizeof: #int) ~= 4]) ifTrue:
[errorCode := errorCode + 4]].
(self sizeof: #'void *') = 4 ifTrue: "LP32 ILP32"
[(self sizeof: #long) ~= 4 ifTrue:
[errorCode := errorCode + 8].
(self sizeof: #int) = 4 ifTrue: "ILP32"
[model := 'ILP32'].
(self sizeof: #int) = 2 ifTrue: "LP32"
[model := 'LP32'].
((self sizeof: #int) ~= 4 and: [(self sizeof: #int) ~= 2]) ifTrue:
[errorCode := errorCode + 4]].
((self sizeof: #'void *') ~= 8 and: [(self sizeof: #'void *') ~= 4]) ifTrue:
[errorCode := errorCode + 32].
errorCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailForOSError: errorCode].
model ifNil:
[^interpreterProxy primitiveFailFor: PrimErrNotFound].
interpreterProxy methodReturnString: model
"Screed for testing
| proxy plugin |
proxy := InterpreterProxy new.
plugin := ThreadedFFIPluginPartialSimulator new.
plugin sizes: (Dictionary newFromPairs: #(char 1 short 2 int 4 long 4 #'long long' 8 #'void *' 8 #'void *' 4 float 4 double 8 wchar_t 4)).
plugin sizes: (Dictionary newFromPairs: #(char 1 short 2 int 2 long 4 #'long long' 8 #'void *' 4 float 4 double 8 wchar_t 4)).
plugin instVarNamed: 'interpreterProxy' put: proxy.
proxy synthesizeStackFor: plugin with: (Array with: (ByteArray new: 9)).
plugin primitiveCDataModel.
^proxy stackValue: 0"!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveExternalAddressAsInteger (in category 'primitives') -----
+ primitiveExternalAddressAsInteger
+ "Answer the address of a 4 byte or 8 byte ExternalAddress."
+ <export: true flags: #FastCPrimitiveFlag>
+ | rcvr size |
+ rcvr := interpreterProxy stackValue: 0.
+ size := interpreterProxy byteSizeOf: rcvr.
+ size = 8 ifTrue:
+ [^interpreterProxy methodReturnValue:
+ (interpreterProxy positive64BitIntegerFor:
+ ((self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'usqLong *') at: 0))].
+ size = 4 ifTrue:
+ [^interpreterProxy methodReturnValue:
+ (interpreterProxy positive32BitIntegerFor:
+ ((self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'unsigned int *') at: 0))].
+ interpreterProxy primitiveFailFor: PrimErrBadReceiver!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') -----
primitiveFFIDoubleAt
+ "Answer a 64-bit IEEE double the given byte offset."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr floatValue |
- "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 stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #double))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: #double).
+ ^interpreterProxy methodReturnFloat: floatValue]!
- byteOffset := interpreterProxy stackIntegerValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^0].
- addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
- addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- interpreterProxy methodReturnFloat: floatValue
- !
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') -----
primitiveFFIDoubleAtPut
+ "Store a 64-bit IEEE double the given byte offset."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr floatValue valueOop |
- "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>
+ valueOop := interpreterProxy stackValue: 0.
+ (interpreterProxy isFloatObject: valueOop)
+ ifTrue: [floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double]
+ ifFalse:
+ [(interpreterProxy isIntegerObject: valueOop)
+ ifTrue: [floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
+ ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]].
+ byteOffset := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ rcvr := interpreterProxy stackValue: 2.
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #double))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
+ ^interpreterProxy methodReturnValue: valueOop]!
- 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.
- addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- ^interpreterProxy pop: 3 thenPush: floatOop!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAt (in category 'primitives') -----
primitiveFFIFloatAt
+ "Answer a 32-bit IEEE float the given byte offset."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr floatValue |
- "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 stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #float))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: #float).
+ ^interpreterProxy methodReturnFloat: floatValue]!
- byteOffset := interpreterProxy stackIntegerValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^0].
- addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
- addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- interpreterProxy methodReturnFloat: floatValue!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') -----
primitiveFFIFloatAtPut
+ "Store a 32-bit IEEE float the given byte offset."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr floatValue valueOop |
- "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>
+ valueOop := interpreterProxy stackValue: 0.
+ (interpreterProxy isFloatObject: valueOop)
+ ifTrue: [floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #float]
+ ifFalse:
+ [(interpreterProxy isIntegerObject: valueOop)
+ ifTrue: [floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #float]
+ ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]].
+ byteOffset := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ rcvr := interpreterProxy stackValue: 2.
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #float))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
+ ^interpreterProxy methodReturnValue: valueOop]!
- 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.
- addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- ^interpreterProxy pop: 3 thenPush: floatOop!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIGetLastError (in category 'primitives') -----
primitiveFFIGetLastError
"Primitive. Return the error code from a failed call to the foreign function interface.
This is for backwards-compatibility. Thread-safe access to the error code is via the
primitive error code."
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
- <inline: false>
interpreterProxy methodReturnInteger: ffiLastError!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAt (in category 'primitives') -----
primitiveFFIIntegerAt
"Answer a (signed or unsigned) n byte integer from the given byte offset
in the receiver, using the platform's endianness."
+ <export: true flags: #FastCPrimitiveFlag>
+ | isSigned byteSize byteOffset rcvr value mask valueOop |
- | isSigned byteSize byteOffset rcvr addr value mask valueOop |
<var: 'value' type: #usqLong>
<var: 'mask' type: #usqLong>
<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 between: 1 and: 8)
and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse:
[^interpreterProxy primitiveFail].
+ (self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize)
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ byteSize <= 2
- addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
- addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- byteSize <= 2
- ifTrue:
- [byteSize = 1
- ifTrue: [value := self cCoerceSimple: (interpreterProxy byteAt: addr) to: #'unsigned char']
- ifFalse: [value := self cCoerceSimple: (interpreterProxy unalignedShortAt: addr) to: #'unsigned short']]
- ifFalse:
- [byteSize = 4
- ifTrue: [value := self cCoerceSimple: (interpreterProxy unalignedLong32At: addr) to: #'unsigned int']
- ifFalse: [value := interpreterProxy unalignedLong64At: addr]].
- byteSize < BytesPerWord
- ifTrue:
- [isSigned ifTrue: "sign extend value"
- [mask := 1 asUnsignedLongLong << (byteSize * 8 - 1).
- value := (value bitAnd: mask-1) - (value bitAnd: mask)].
- "note: byte/short (&long if BytesPerWord=8) never exceed SmallInteger range"
- valueOop := interpreterProxy integerObjectOf: value]
- ifFalse: "general 64 bit integer; note these never fail"
- [isSigned
ifTrue:
+ [byteSize = 1
+ ifTrue: [value := self cCoerceSimple: (interpreterProxy byteAt: addr) to: #'unsigned char']
+ ifFalse: [value := self cCoerceSimple: (interpreterProxy unalignedShortAt: addr) to: #'unsigned short']]
+ ifFalse:
+ [byteSize = 4
+ ifTrue: [value := self cCoerceSimple: (interpreterProxy unalignedLong32At: addr) to: #'unsigned int']
+ ifFalse: [value := interpreterProxy unalignedLong64At: addr]].
+ byteSize < BytesPerWord
+ ifTrue:
+ [isSigned ifTrue: "sign extend value"
- [byteSize < 8 ifTrue: "sign extend value"
[mask := 1 asUnsignedLongLong << (byteSize * 8 - 1).
value := (value bitAnd: mask-1) - (value bitAnd: mask)].
+ "note: byte/short (&long if BytesPerWord=8) never exceed SmallInteger range"
+ valueOop := interpreterProxy integerObjectOf: value]
+ ifFalse: "general 64 bit integer; note these never fail"
+ [isSigned
+ ifTrue:
+ [byteSize < 8 ifTrue: "sign extend value"
+ [mask := 1 asUnsignedLongLong << (byteSize * 8 - 1).
+ value := (value bitAnd: mask-1) - (value bitAnd: mask)].
+ self cCode: [] inSmalltalk:
+ [(byteSize = 8 and: [(value bitShift: -56) >= 128]) ifTrue:
+ [value := value - (1 bitShift: 64)]].
+ valueOop := interpreterProxy signed64BitIntegerFor: value]
+ ifFalse:[valueOop := interpreterProxy positive64BitIntegerFor: value]].
+ ^interpreterProxy methodReturnValue: valueOop]!
- self cCode: [] inSmalltalk:
- [(byteSize = 8 and: [(value bitShift: -56) >= 128]) ifTrue:
- [value := value - (1 bitShift: 64)]].
- valueOop := interpreterProxy signed64BitIntegerFor: value]
- ifFalse:[valueOop := interpreterProxy positive64BitIntegerFor: value]].
- ^interpreterProxy pop: 4 thenPush: valueOop!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAtPut (in category 'primitives') -----
primitiveFFIIntegerAtPut
"Store a (signed or unsigned) n byte integer at the given byte offset
in the receiver, using the platform's endianness."
+ <export: true flags: #FastCPrimitiveFlag>
+ | isSigned byteSize byteOffset rcvr value max valueOop |
- | isSigned byteSize byteOffset rcvr addr value max valueOop |
<var: 'value' type: #sqLong>
<var: 'max' type: #sqLong>
<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 between: 1 and: 8)
and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse:
[^interpreterProxy primitiveFail].
+ (self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize)
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ isSigned
+ ifTrue:[value := interpreterProxy signed64BitValueOf: valueOop]
+ ifFalse:[value := interpreterProxy positive64BitValueOf: valueOop].
+ interpreterProxy failed ifTrue:[^0].
+ byteSize < 8 ifTrue:
+ [isSigned
+ ifTrue:
+ [max := 1 asUnsignedLongLong << (8 * byteSize - 1).
+ (value >= (0 - max) and: [value < max]) ifFalse: [^interpreterProxy primitiveFail]]
+ ifFalse:
+ [value asUnsignedLongLong < (1 asUnsignedLongLong << (8 * byteSize)) ifFalse: [^interpreterProxy primitiveFail]]].
+ byteSize <= 2
+ ifTrue:
+ [byteSize = 1
+ ifTrue: [interpreterProxy byteAt: addr put: value]
+ ifFalse: [interpreterProxy unalignedShortAt: addr put: value]]
+ ifFalse:
+ [byteSize = 4
+ ifTrue: [interpreterProxy unalignedLong32At: addr put: value]
+ ifFalse: [interpreterProxy unalignedLong64At: addr put: value]].
+ ^interpreterProxy methodReturnValue: valueOop]!
- addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
- addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- isSigned
- ifTrue:[value := interpreterProxy signed64BitValueOf: valueOop]
- ifFalse:[value := interpreterProxy positive64BitValueOf: valueOop].
- interpreterProxy failed ifTrue:[^0].
- byteSize < 8 ifTrue:
- [isSigned
- ifTrue:
- [max := 1 asUnsignedLongLong << (8 * byteSize - 1).
- (value >= (0 - max) and: [value < max]) ifFalse: [^interpreterProxy primitiveFail]]
- ifFalse:
- [value asUnsignedLongLong < (1 asUnsignedLongLong << (8 * byteSize)) ifFalse: [^interpreterProxy primitiveFail]]].
- byteSize <= 2
- ifTrue:
- [byteSize = 1
- ifTrue: [interpreterProxy byteAt: addr put: value]
- ifFalse: [interpreterProxy unalignedShortAt: addr put: value]]
- ifFalse:
- [byteSize = 4
- ifTrue: [interpreterProxy unalignedLong32At: addr put: value]
- ifFalse: [interpreterProxy unalignedLong64At: addr put: value]].
- ^interpreterProxy pop: 5 thenPush: valueOop!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt16At (in category 'primitives') -----
+ primitiveSignedInt16At
+ "Answer the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy unalignedShortAt: addr) to: #'signed short')]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt16AtPut (in category 'primitives') -----
+ primitiveSignedInt16AtPut
+ "Store the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ ((interpreterProxy isIntegerObject: valueArg)
+ and: [((value := interpreterProxy integerValueOf: valueArg) between: -32768 and: 32767)
+ and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy unalignedShortAt: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt32At (in category 'primitives') -----
+ primitiveSignedInt32At
+ "Answer the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnValue:
+ (interpreterProxy signed32BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong32At: addr) to: #'signed int'))]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt32AtPut (in category 'primitives') -----
+ primitiveSignedInt32AtPut
+ "Store the signed 32-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ value := interpreterProxy signed32BitValueOf: valueArg.
+ (interpreterProxy failed not
+ and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy unalignedLong32At: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt64At (in category 'primitives') -----
+ primitiveSignedInt64At
+ "Answer the signed 64-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #sqLong))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnValue:
+ (interpreterProxy signed64BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong64At: addr) to: #sqLong))]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt64AtPut (in category 'primitives') -----
+ primitiveSignedInt64AtPut
+ "Store the signed 64-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ value := interpreterProxy signed64BitValueOf: valueArg.
+ (interpreterProxy failed not
+ and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #sqLong))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy unalignedLong64At: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt8At (in category 'primitives') -----
+ primitiveSignedInt8At
+ "Answer the signed 8-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy byteAt: addr) to: #'signed char')]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveSignedInt8AtPut (in category 'primitives') -----
+ primitiveSignedInt8AtPut
+ "Store the signed 8-bit integer starting at the given byte offset."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ ((interpreterProxy isIntegerObject: valueArg)
+ and: [((value := interpreterProxy integerValueOf: valueArg) between: -128 and: 127)
+ and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy byteAt: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveStructureElementAlignment (in category 'primitives') -----
primitiveStructureElementAlignment
"Answer the alignment of an element of an atomic type, or a structure, within a structure on the current platform."
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| typeCode alignment |
<var: 'alignment' type: #'void *'>
typeCode := interpreterProxy stackValue: 0.
((interpreterProxy isIntegerObject: typeCode)
and: [((typeCode := interpreterProxy integerValueOf: typeCode) between: FFITypeUnsignedByte and: FFITypeDoubleFloat)
or: [typeCode = FFIFlagStructure]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
alignment := typeCode
caseOf: {
[FFITypeUnsignedByte] -> [self structOffsetOf: 'structByte *' atomicTypeCode: FFITypeUnsignedByte].
[FFITypeSignedByte] -> [self structOffsetOf: 'structByte *' atomicTypeCode: FFITypeUnsignedByte].
[FFITypeUnsignedShort] -> [self structOffsetOf: 'structShort *' atomicTypeCode: FFITypeUnsignedShort].
[FFITypeSignedShort] -> [self structOffsetOf: 'structShort *' atomicTypeCode: FFITypeUnsignedShort].
[FFITypeUnsignedInt] -> [self structOffsetOf: 'structInt *' atomicTypeCode: FFITypeUnsignedInt].
[FFITypeSignedInt] -> [self structOffsetOf: 'structInt *' atomicTypeCode: FFITypeUnsignedInt].
[FFITypeUnsignedLongLong] -> [self structOffsetOf: 'structLongLong *' atomicTypeCode: FFITypeUnsignedLongLong].
[FFITypeSignedLongLong] -> [self structOffsetOf: 'structLongLong *' atomicTypeCode: FFITypeUnsignedLongLong].
[FFITypeSingleFloat] -> [self structOffsetOf: 'structFloat *' atomicTypeCode: FFITypeSingleFloat].
[FFITypeDoubleFloat] -> [self structOffsetOf: 'structDouble *' atomicTypeCode: FFITypeDoubleFloat].
}
otherwise: [self structOffsetOf: 'structStruct *' atomicTypeCode: FFIFlagStructure].
^interpreterProxy methodReturnInteger: alignment asUnsignedIntegerPtr!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt16At (in category 'primitives') -----
+ primitiveUnsignedInt16At
+ "Answer the unsigned 16-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy unalignedShortAt: addr) to: #'unsigned short')]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt16AtPut (in category 'primitives') -----
+ primitiveUnsignedInt16AtPut
+ "Store the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ ((interpreterProxy isIntegerObject: valueArg)
+ and: [((value := interpreterProxy integerValueOf: valueArg) between: 0 and: 65535)
+ and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy unalignedShortAt: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt32At (in category 'primitives') -----
+ primitiveUnsignedInt32At
+ "Answer the unsigned 32-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnValue:
+ (interpreterProxy positive32BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong32At: addr) to: #'unsigned int'))]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt32AtPut (in category 'primitives') -----
+ primitiveUnsignedInt32AtPut
+ "Store the unsigned 32-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ value := interpreterProxy positive32BitValueOf: valueArg.
+ (interpreterProxy failed not
+ and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy unalignedLong32At: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt64At (in category 'primitives') -----
+ primitiveUnsignedInt64At
+ "Answer the unsigned 64-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #usqLong))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnValue:
+ (interpreterProxy positive64BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong64At: addr) to: #usqLong))]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt64AtPut (in category 'primitives') -----
+ primitiveUnsignedInt64AtPut
+ "Store the unsigned 64-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ value := interpreterProxy positive64BitValueOf: valueArg.
+ (interpreterProxy failed not
+ and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #sqLong))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy unalignedLong64At: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt8At (in category 'primitives') -----
+ primitiveUnsignedInt8At
+ "Answer the unsigned 8-bit integer starting at the given byte offset (native endian)."
+ <export: true flags: #FastCPrimitiveFlag>
+ | byteOffset rcvr |
+
+ byteOffset := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isIntegerObject: byteOffset) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ ^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy byteAt: addr) to: #'unsigned char')]!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt8AtPut (in category 'primitives') -----
+ primitiveUnsignedInt8AtPut
+ "Store the unsigned 8-bit integer starting at the given byte offset."
+ <export: true flags: #FastCPrimitiveFlag>
+ | valueArg value byteOffset rcvr |
+ valueArg := interpreterProxy stackValue: 0.
+ byteOffset := interpreterProxy stackValue: 1.
+ rcvr := interpreterProxy stackValue: 2.
+ ((interpreterProxy isIntegerObject: valueArg)
+ and: [((value := interpreterProxy integerValueOf: valueArg) between: 0 and: 255)
+ and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
+ ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
+ ifNotNil:
+ [:addr|
+ interpreterProxy byteAt: addr put: value.
+ ^interpreterProxy methodReturnValue: valueArg]!
More information about the Vm-dev
mailing list