VM Maker: VMMaker.oscog-eem.2300.mcz

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

VM Maker: VMMaker.oscog-eem.2300.mcz

commits-2
 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2300.mcz

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

Name: VMMaker.oscog-eem.2300
Author: eem
Time: 21 December 2017, 9:26:04.989859 pm
UUID: 0d9617e1-ff4e-4af4-9519-ff80b4d145f1
Ancestors: VMMaker.oscog-eem.2299

Change the contract of ThreadedFFIPlugin>>ffiAddressOf:startingAt:size:, moving the primitive fails to the callers for equivalent but more compact code.

=============== Diff against VMMaker.oscog-eem.2299 ===============

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."
- reasons) with plain Byte or Word Arrays as well. "
  | rcvrClass rcvrSize addr |
+ (interpreterProxy isBytes: rcvr) ifFalse:[^0].
+ byteOffset > 0 ifFalse:[^0].
- (interpreterProxy isBytes: rcvr) ifFalse:[^interpreterProxy primitiveFail].
- byteOffset > 0 ifFalse:[^interpreterProxy primitiveFail].
  rcvrClass := interpreterProxy fetchClassOf: rcvr.
  rcvrSize := interpreterProxy byteSizeOf: rcvr.
  rcvrClass = interpreterProxy classExternalAddress
  ifTrue:
+ [rcvrSize = BytesPerWord ifFalse:[^0].
- [rcvrSize = BytesPerWord ifFalse:[^interpreterProxy primitiveFail].
  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:
+ [^0]]
- [^interpreterProxy primitiveFail]]
  ifFalse:
  [byteOffset+byteSize-1 <= rcvrSize ifFalse:
+ [^0].
- [^interpreterProxy primitiveFail].
  addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'sqIntptr_t'].
  addr := addr + byteOffset - 1.
  ^addr asVoidPointer!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>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.
+ addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^0].
  self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  interpreterProxy pop: 2.
  ^interpreterProxy pushFloat: floatValue
  !

Item was changed:
  ----- Method: ThreadedFFIPlugin>>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.
+ addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^0].
  self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  ^interpreterProxy pop: 3 thenPush: floatOop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>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.
+ addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^0].
  self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  interpreterProxy pop: 2.
  ^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>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.
+ addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^0].
  self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  ^interpreterProxy pop: 3 thenPush: floatOop!

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."
  | 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].
  addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
+ addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^0].
  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 < 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 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."
  | 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].
  addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
+ addr = 0 ifTrue: [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^0].
  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!