FYI...

On Wed, Jun 24, 2020 at 12:05 PM Levente Uzonyi <leves@caesar.elte.hu> wrote:

Hi Eliot,

On Wed, 24 Jun 2020, commits@source.squeak.org wrote:

>
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2761.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.2761
> Author: eem
> Time: 24 June 2020, 11:15:52.846414 am
> UUID: 34b29eae-6069-4cb7-8a89-7365fb398dfb
> Ancestors: VMMaker.oscog-eem.2760
>
> Cherry Picking from various recent commits, but avoiding the extremely desirable, but as yet unfinished, VMMaker.oscog-nice.2761 transformInAssignmentTo: changes.the "thisContext method includes: 42" crash.
>
> MiscPrimitivePlugin: fix several uses of sizeOfSTArrayFromCPrimitive: that don''t check for potential failure if e.g. invoked on a CompiledMethod. Returning from a primitive normally when the primtiive has failed leads to disaster since the stack gets cu back but shouldn't be. For CompiledMethod isBytes: is true but isWordsOrBytes: is false. sizeOfSTArrayFromCPrimitive: checks for isWordsOrBytes:. The primtiives check that the argument is isBytes: but don't check if sizeOfSTArrayFromCPrimitive: fails. More general fixes, such as fixing isBytes: to be false for CompiledMethod, or introducing isPureBytes: and using it, are not quick fixes. hence this limited fix here.
>
> Primitive infrastructure: consequently guard the various methodReturnXXX''s with an assert to check that a primitive has not failed.
>
> Also make sure that the SpurNBitCoMemoryManagers do not follow any reference to a Cog method in the first field of a CompiledMethod.
>
> Cosmetic changes for ThreadedFFIPlugins from VMMaker.oscog-nice.2762
>
> Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages. This from VMMaker.oscog-nice.2761.

While it's true that SHA256Plugin is now obsolete, simply removing it is
not a solution. Its replacement, SHA2Plugin along with fixes to the other
plugins is available in CryptographyPlugins-ul.22.
IMO 3 steps are required to have the plugins built and shipped with the
VM:
1. Use CryptographyPlugins-ul.22 to generate the plugin sources, and push
the generated files to the git repository.
2. Apply the change from VMMaker.oscog-ul.2763.mcz. It's in the VMMaker
Inbox[1].
3. Update plugins.ext across the git repository to include all the
plugins.

I can do 2, I can create a pull request for 3, but I can't do 1.

Here's how to do #1.

1. check out the opensmalltalk-vm repository (or update your copy)

2. build a VMMaker image using opensmalltalk-vm/image/buildspurtrunkvmmaker64image.sh (or update your copy)

3. open the Source Generation workspace to find the source generaiton doits.

4. evaluate VMMaker generateVMPlugins.

5. in opensmalltalk-vm commit using scripts/gitci -u

Levente

[1] http://lists.squeakfoundation.org/pipermail/vm-dev/2020-June/034065.html

>
> Slang:
> Fix TParseNode>>isSameAs: implementations to incluyde an identity check. TReturnNode always answered false to this in the past.
>
> Optimize inlineFunctionCall:in: to avoid a rewrite of the copied parse tree being inlined if the actuals match the formals. Uses the improved bindVariablesIn:.
>
> Use a setter for variable & expression in TAssignmentNode to ease breakpointing/debugging.
>
> =============== Diff against VMMaker.oscog-eem.2760 ===============
>
> Item was changed:
> ----- Method: CogARMCompiler>>concretizeAndCqRR (in category 'generate machine code - concretize') -----
> concretizeAndCqRR
> "Will get inlined into concretizeAt: switch."
> "AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find compact ways to make the masks"
> <inline: true>
> | val srcReg dstReg |
> val := operands at: 0.
> srcReg := operands at: 1.
> dstReg := operands at: 2.
> self rotateable8bitBitwiseImmediate: val
> ifTrue:
> [:rot :immediate :invert|
> self machineCodeAt: 0 put: (invert
> ifTrue: [self bics: dstReg rn: srcReg imm: immediate ror: rot]
> ifFalse: [self ands: dstReg rn: srcReg imm: immediate ror: rot]).
> ^4]
> ifFalse:
> [| hb |
> hb := (operands at: 0) highBit.
> "First see if the constant can be made from a simple shift of 0xFFFFFFFF"
> 1 << hb = (val +1) ifTrue: "MVN temp reg, 0, making 0xffffffff"
> [self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
> "Then AND reg, temp reg, lsr #(32-hb)"
> self machineCodeAt: 4 put: (self dataOpType: AndOpcode rd: dstReg rn: srcReg rm: ConcreteIPReg lsr: 32 - hb).
> + ^8]].
> + ^self concretizeDataOperationCwR: AndOpcode R: dstReg!
> - ^8].
> - ^self concretizeDataOperationCwR: AndOpcode R: dstReg]!
>
> Item was added:
> + ----- Method: Float32Array class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
> + ccg: cg prolog: aBlock expr: aString index: anInteger
> +
> + ^cg ccgLoad: aBlock expr: aString asWBFloatPtrFrom: anInteger!
>
> Item was added:
> + ----- Method: Float32Array class>>ccgDeclareCForVar: (in category '*VMMaker-plugin generation') -----
> + ccgDeclareCForVar: aSymbolOrString
> +
> + ^'float *', aSymbolOrString!
>
> Item was removed:
> - ----- Method: FloatArray class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
> - ccg: cg prolog: aBlock expr: aString index: anInteger
> -
> - ^cg ccgLoad: aBlock expr: aString asWBFloatPtrFrom: anInteger!
>
> Item was removed:
> - ----- Method: FloatArray class>>ccgDeclareCForVar: (in category '*VMMaker-plugin generation') -----
> - ccgDeclareCForVar: aSymbolOrString
> -
> - ^'float *', aSymbolOrString!
>
> Item was changed:
> ----- Method: InterpreterProxy>>methodReturnBool: (in category 'stack access') -----
> methodReturnBool: boolean
> "Sets the return value for a method"
> + self deny: self failed.
> self pop: argumentCount+1 thenPushBool: boolean.
> ^0!
>
> Item was changed:
> ----- Method: InterpreterProxy>>methodReturnFloat: (in category 'stack access') -----
> methodReturnFloat: aFloat
> "Sets the return value for a method"
> <var: 'aFloat' type: #double>
> + self deny: self failed.
> self pop: argumentCount+1 thenPushFloat: aFloat.
> ^0!
>
> Item was changed:
> ----- Method: InterpreterProxy>>methodReturnInteger: (in category 'stack access') -----
> methodReturnInteger: integer
> "Sets the return value for a method"
> + self deny: self failed.
> self pop: argumentCount+1 thenPushInteger: integer.
> ^0!
>
> Item was changed:
> ----- Method: InterpreterProxy>>methodReturnReceiver (in category 'stack access') -----
> methodReturnReceiver
> "Sets the return value for a method"
> + self deny: self failed.
> self pop: argumentCount.
> ^0!
>
> Item was changed:
> ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') -----
> methodReturnString: aCString
> "Attempt to answer a ByteString for a given C string as the result of a primitive."
> <var: 'aCString' type: #'char *'>
> + self deny: self failed.
> aCString
> ifNil: [primFailCode := PrimErrOperationFailed]
> ifNotNil:
> [(self stringForCString: aCString)
> ifNil: [primFailCode := PrimErrNoMemory]
> ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].
> ^0!
>
> Item was changed:
> ----- Method: InterpreterProxy>>methodReturnValue: (in category 'stack access') -----
> methodReturnValue: oop
> "Sets the return value for a method"
> + self deny: self failed.
> self pop: argumentCount+1 thenPush: oop.
> ^0!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') -----
> primitiveCompareString
> "ByteString (class) compare: string1 with: string2 collated: order"
> <export: true>
> | len1 len2 order string1 string2 orderOop string1Oop string2Oop |
>
> <var: 'order' type: #'unsigned char *'>
> <var: 'string1' type: #'unsigned char *'>
> <var: 'string2' type: #'unsigned char *'>
> orderOop := interpreterProxy stackValue: 0.
> string2Oop := interpreterProxy stackValue: 1.
> string1Oop := interpreterProxy stackValue: 2.
> ((interpreterProxy isBytes: orderOop)
> and: [(interpreterProxy isBytes: string2Oop)
> and: [interpreterProxy isBytes: string1Oop]]) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> order := interpreterProxy firstIndexableField: orderOop.
> (interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> string1 := interpreterProxy firstIndexableField: string1Oop.
> string2 := interpreterProxy firstIndexableField: string2Oop.
> len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
> len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
> + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> 0 to: (len1 min: len2) - 1 do:
> [ :i | | c1 c2 |
> c1 := order at: (string1 at: i).
> c2 := order at: (string2 at: i).
> c1 = c2 ifFalse:
> [^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
> interpreterProxy methodReturnInteger:
> (len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
> primitiveCompressToByteArray
> "Bitmap compress: bm toByteArray: ba"
> <export: true>
> | bm ba eqBytes i j k lowByte size destSize word |
> <var: 'ba' type: #'unsigned char *'>
> <var: 'bm' type: #'int *'>
> bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
> inSmalltalk: [interpreterProxy
> cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
> to: #'int *'].
> interpreterProxy failed ifTrue: [^nil].
> (interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrNoModification].
> ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
> size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
> destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
> + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
> i := self encodeInt: size in: ba at: 0.
> k := 0.
> [k < size] whileTrue:
> [word := bm at: k.
> lowByte := word bitAnd: 255.
> eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
> j := k.
> [j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
> j > k
> ifTrue:
> [eqBytes
> ifTrue:
> [i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
> ba at: i put: lowByte.
> i := i + 1]
> ifFalse:
> [i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
> i := self encodeBytesOf: word in: ba at: i].
> k := j + 1]
> ifFalse:
> [eqBytes
> ifTrue:
> [i := self encodeInt: 1 * 4 + 1 in: ba at: i.
> ba at: i put: lowByte.
> i := i + 1.
> k := k + 1]
> ifFalse:
> [[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
> j + 1 = size ifTrue: [j := j + 1].
> i := self encodeInt: j - k * 4 + 3 in: ba at: i.
> k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
> k := j]]].
> interpreterProxy methodReturnInteger: i!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveConvert8BitSigned (in category 'primitives') -----
> primitiveConvert8BitSigned
> "SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer"
> <export: true>
> | aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop |
>
> <var: 'aByteArray' type: #'unsigned char *'>
> <var: 'aSoundBuffer' type: #'unsigned short *'>
> byteArrayOop := interpreterProxy stackValue: 1.
> (interpreterProxy isBytes: byteArrayOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
> soundBufferOop := interpreterProxy stackValue: 0.
> + (interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
> + [^interpreterProxy primitiveFailFor: PrimErrNoModification].
> aSoundBuffer := self
> cCode: [interpreterProxy arrayValueOf: soundBufferOop]
> inSmalltalk: [interpreterProxy
> cCoerce: (interpreterProxy arrayValueOf: soundBufferOop)
> to: #'unsigned short *'].
> - interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - (interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
> - [^interpreterProxy primitiveFailFor: PrimErrNoModification].
> arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
> + interpreterProxy failed ifTrue:
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> (interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> 0 to: arraySize - 1 do:
> [ :i | | s |
> s := aByteArray at: i.
> aSoundBuffer
> at: i
> put: (s > 127
> ifTrue: [s - 256 bitShift: 8]
> ifFalse: [s bitShift: 8])].
> interpreterProxy methodReturnReceiver!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') -----
> primitiveDecompressFromByteArray
> "Bitmap decompress: bm fromByteArray: ba at: index"
> <export: true>
> | bm ba index i anInt code data end k n pastEnd |
> <var: 'ba' type: #'unsigned char *'>
> <var: 'bm' type: #'int *'>
> <var: 'anInt' type: #'unsigned int'>
> <var: 'code' type: #'unsigned int'>
> <var: 'data' type: #'unsigned int'>
> <var: 'n' type: #'unsigned int'>
> bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)]
> inSmalltalk: [interpreterProxy
> cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2))
> to: #'int *'].
> (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrNoModification].
> (interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
> index := interpreterProxy stackIntegerValue: 0.
> - interpreterProxy failed ifTrue: [^nil].
> - i := index - 1.
> - k := 0.
> end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
> pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
> + interpreterProxy failed ifTrue:
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + i := index - 1.
> + k := 0.
> [i < end] whileTrue:
> [anInt := ba at: i.
> i := i + 1.
> anInt <= 223 ifFalse:
> [anInt <= 254
> ifTrue:
> [anInt := anInt - 224 * 256 + (ba at: i).
> i := i + 1]
> ifFalse:
> [anInt := 0.
> 1 to: 4 by: 1 do:
> [ :j | anInt := (anInt bitShift: 8) + (ba at: i).
> i := i + 1]]].
> n := anInt >> 2.
> k + n > pastEnd ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> code := anInt bitAnd: 3.
> "code = 0 ifTrue: [nil]."
> code = 1 ifTrue:
> [data := ba at: i.
> i := i + 1.
> data := data bitOr: (data bitShift: 8).
> data := data bitOr: (data bitShift: 16).
> 1 to: n do:
> [ :j |
> bm at: k put: data.
> k := k + 1]].
> code = 2 ifTrue:
> [data := 0.
> 1 to: 4 do:
> [ :j |
> data := (data bitShift: 8) bitOr: (ba at: i).
> i := i + 1].
> 1 to: n do:
> [ :j |
> bm at: k put: data.
> k := k + 1]].
> code = 3 ifTrue:
> [1 to: n do:
> [ :m |
> data := 0.
> 1 to: 4 do:
> [ :j |
> data := (data bitShift: 8) bitOr: (ba at: i).
> i := i + 1].
> bm at: k put: data.
> k := k + 1]]].
> interpreterProxy pop: interpreterProxy methodArgumentCount!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') -----
> primitiveFindFirstInString
> "ByteString (class) findFirstInString: aString inSet: inclusionMap startingAt: start"
> <export: true>
>
> | aString i inclusionMap stringSize aStringOop inclusionMapOop |
> <var: 'aString' type: #'unsigned char *'>
> <var: 'inclusionMap' type: #'unsigned char *'>
> aStringOop := interpreterProxy stackValue: 2.
> (interpreterProxy isBytes: aStringOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> inclusionMapOop := interpreterProxy stackValue: 1.
> (interpreterProxy isBytes: inclusionMapOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> i := interpreterProxy stackIntegerValue: 0.
> + interpreterProxy failed ifTrue:
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> i := i - 1. "Convert to 0-based index."
> i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop.
> (interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
> [^interpreterProxy methodReturnInteger: 0].
> aString := interpreterProxy firstIndexableField: aStringOop.
> stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
> + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> [i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
> [i := i + 1].
> interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') -----
> primitiveFindSubstring
> "ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
> <export: true>
>
> + | body key keySize bodySize matchTable start bodyOop keyOop matchTableOop |
> - | body key keySize matchTable start bodyOop keyOop matchTableOop |
> <var: #key type: #'unsigned char *'>
> <var: #body type: #'unsigned char *'>
> <var: #matchTable type: #'unsigned char *'>
> keyOop := interpreterProxy stackValue: 3.
> (interpreterProxy isBytes: keyOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> bodyOop := interpreterProxy stackValue: 2.
> (interpreterProxy isBytes: bodyOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> start := interpreterProxy stackIntegerValue: 1.
> interpreterProxy failed ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> matchTableOop := interpreterProxy stackValue: 0.
> (interpreterProxy isBytes: matchTableOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> matchTable := interpreterProxy firstIndexableField: matchTableOop.
> (interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> key := interpreterProxy firstIndexableField: keyOop.
> (keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
> [keySize := keySize - 1. "adjust for zero relative indexes"
> start := start - 1 max: 0. "adjust for zero relative indexes"
> + body := interpreterProxy firstIndexableField: bodyOop.
> + bodySize := interpreterProxy sizeOfSTArrayFromCPrimitive: body.
> + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + start to: bodySize - 1 - keySize do:
> - body := interpreterProxy firstIndexableField: bodyOop.
> - start to: (interpreterProxy sizeOfSTArrayFromCPrimitive: body) - 1 - keySize do:
> [ :startIndex | | index |
> index := 0.
> [(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue:
> [index = keySize ifTrue:
> [^interpreterProxy methodReturnInteger: startIndex + 1].
> index := index + 1]]].
> ^interpreterProxy methodReturnInteger: 0!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') -----
> primitiveIndexOfAsciiInString
> "ByteString indexOfAscii: anInteger inString: aString startingAt: start"
> <export: true>
>
> + | integerOop startOop anInteger aString start stringSize stringOop |
> - | anInteger aString start stringSize aStringOop |
> <var: #aString type: #'unsigned char *'>
> + integerOop := interpreterProxy stackValue: 2.
> + stringOop := interpreterProxy stackValue: 1.
> + startOop := interpreterProxy stackValue: 0.
> + ((interpreterProxy isIntegerObject: integerOop)
> + and: [(interpreterProxy isIntegerObject: startOop)
> + and: [(interpreterProxy isBytes: stringOop)
> + and: [interpreterProxy isWordsOrBytes: stringOop]]]) ifFalse: "sizeOfSTArrayFromCPrimitive: is defined only for words or bytes"
> - anInteger := interpreterProxy stackIntegerValue: 2.
> - interpreterProxy failed ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + (start := interpreterProxy integerValueOf: startOop) >= 1 ifFalse:
> + [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> + anInteger := interpreterProxy integerValueOf: integerOop.
> + aString := interpreterProxy firstIndexableField: stringOop.
> - aStringOop := interpreterProxy stackValue: 1.
> - (interpreterProxy isBytes: aStringOop) ifFalse:
> - [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - start := interpreterProxy stackIntegerValue: 0.
> - interpreterProxy failed ifTrue:
> - [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - start >= 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> - aString := interpreterProxy firstIndexableField: aStringOop.
> stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
> start - 1 to: stringSize - 1 do:
> + [:pos |
> - [ :pos |
> (aString at: pos) = anInteger ifTrue:
> [^interpreterProxy methodReturnInteger: pos + 1]].
> ^interpreterProxy methodReturnInteger: 0!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') -----
> primitiveStringHash
> "ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
> <export: true>
>
> | aByteArray hash byteArrayOop |
> <var: 'aByteArray' type: #'unsigned char *'>
> <var: 'hash' type: #'unsigned int'>
> hash := interpreterProxy stackIntegerValue: 0.
> interpreterProxy failed ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> byteArrayOop := interpreterProxy stackValue: 1.
> + ((interpreterProxy isBytes: byteArrayOop)
> + and: [interpreterProxy isWordsOrBytes: byteArrayOop]) ifFalse: "filters out CompiledMethods"
> - (interpreterProxy isBytes: byteArrayOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
> 0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do:
> [ :pos |
> hash := hash + (aByteArray at: pos) * 16r19660D ].
> interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin>>primitiveTranslateStringWithTable (in category 'primitives') -----
> primitiveTranslateStringWithTable
> "ByteString (class) translate: aString from: start to: stop table: table"
> <export: true>
>
> | aString start stop table aStringOop tableOop |
> <var: #table type: #'unsigned char *'>
> <var: #aString type: #'unsigned char *'>
> aStringOop := interpreterProxy stackValue: 3.
> (interpreterProxy isBytes: aStringOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> (interpreterProxy isOopImmutable: aStringOop) ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrNoModification].
> start := interpreterProxy stackIntegerValue: 2.
> - interpreterProxy failed ifTrue:
> - [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> stop := interpreterProxy stackIntegerValue: 1.
> interpreterProxy failed ifTrue:
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> tableOop := interpreterProxy stackValue: 0.
> (interpreterProxy isBytes: tableOop) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> aString := interpreterProxy firstIndexableField: aStringOop.
> (start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse:
> [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> table := interpreterProxy firstIndexableField: tableOop.
> (interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue:
> [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + interpreterProxy failed ifTrue:
> + [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))].
> interpreterProxy methodReturnReceiver!
>
> Item was added:
> + ----- Method: Spur32BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
> + followForwardedObjectFields: objOop toDepth: depth
> + "Follow pointers in the object to depth.
> + Answer if any forwarders were found.
> + How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
> + <api>
> + <inline: false>
> + | found fmt numSlots |
> + found := false.
> + self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
> + fmt := self formatOf: objOop.
> + numSlots := self numPointerSlotsOf: objOop format: fmt.
> + "It is essential to skip the first field of a method because it may be a
> + reference to a Cog method in the method zone, not a real object at all."
> + ((self isCompiledMethodFormat: fmt)
> + ifTrue: [1]
> + ifFalse: [0])
> + to: numSlots - 1
> + do: [:i| | oop |
> + oop := self fetchPointer: i ofObject: objOop.
> + (self isNonImmediate: oop) ifTrue:
> + [(self isForwarded: oop) ifTrue:
> + [found := true.
> + oop := self followForwarded: oop.
> + self storePointer: i ofObject: objOop withValue: oop].
> + (depth > 0
> + and: [(self hasPointerFields: oop)
> + and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
> + [found := true]]].
> + ^found!
>
> Item was added:
> + ----- Method: Spur64BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
> + followForwardedObjectFields: objOop toDepth: depth
> + "Follow pointers in the object to depth.
> + Answer if any forwarders were found.
> + How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
> + <api>
> + <inline: false>
> + | found fmt numSlots |
> + found := false.
> + self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
> + fmt := self formatOf: objOop.
> + numSlots := self numPointerSlotsOf: objOop format: fmt.
> + "It is essential to skip the first field of a method because it may be a
> + reference to a Cog method in the method zone, not a real object at all."
> + ((self isCompiledMethodFormat: fmt)
> + ifTrue: [1]
> + ifFalse: [0])
> + to: numSlots - 1
> + do: [:i| | oop |
> + oop := self fetchPointer: i ofObject: objOop.
> + (self isNonImmediate: oop) ifTrue:
> + [(self isForwarded: oop) ifTrue:
> + [found := true.
> + oop := self followForwarded: oop.
> + self storePointer: i ofObject: objOop withValue: oop].
> + (depth > 0
> + and: [(self hasPointerFields: oop)
> + and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
> + [found := true]]].
> + ^found!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
> followForwardedObjectFields: objOop toDepth: depth
> "Follow pointers in the object to depth.
> Answer if any forwarders were found.
> + How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
> - How to avoid cyclic structures?? A temproary mark bit?"
> <api>
> <inline: false>
> + | found numSlots |
> - | oop found |
> found := false.
> self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
> + numSlots := self numPointerSlotsOf: objOop.
> + 0 to: numSlots - 1 do:
> + [:i| | oop |
> - 0 to: (self numPointerSlotsOf: objOop) - 1 do:
> - [:i|
> oop := self fetchPointer: i ofObject: objOop.
> (self isNonImmediate: oop) ifTrue:
> [(self isForwarded: oop) ifTrue:
> [found := true.
> oop := self followForwarded: oop.
> self storePointer: i ofObject: objOop withValue: oop].
> (depth > 0
> and: [(self hasPointerFields: oop)
> and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
> [found := true]]].
> ^found!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>numPointerSlotsOf: (in category 'object access') -----
> numPointerSlotsOf: objOop
> "Answer the number of pointer fields in the given object.
> Works with CompiledMethods, as well as ordinary objects."
> <api>
> <inline: true>
> + | fmt |
> - | fmt contextSize numLiterals header |
> fmt := self formatOf: objOop.
> + ^self numPointerSlotsOf: objOop format: fmt!
> - fmt <= self lastPointerFormat ifTrue:
> - [(fmt = self indexablePointersFormat
> - and: [self isContextNonImm: objOop]) ifTrue:
> - ["contexts end at the stack pointer"
> - contextSize := coInterpreter fetchStackPointerOf: objOop.
> - ^CtxtTempFrameStart + contextSize].
> - ^self numSlotsOf: objOop "all pointers"].
> - fmt = self forwardedFormat ifTrue: [^1].
> - fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
> -
> - "CompiledMethod: contains both pointers and bytes"
> - header := self methodHeaderOf: objOop.
> - numLiterals := self literalCountOfMethodHeader: header.
> - ^numLiterals + LiteralStart!
>
> Item was added:
> + ----- Method: SpurMemoryManager>>numPointerSlotsOf:format: (in category 'object access') -----
> + numPointerSlotsOf: objOop format: fmt
> + "Answer the number of pointer fields in the given object.
> + Works with CompiledMethods, as well as ordinary objects."
> + <inline: #always>
> + | contextSize numLiterals header |
> + fmt <= self lastPointerFormat ifTrue:
> + [(fmt = self indexablePointersFormat
> + and: [self isContextNonImm: objOop]) ifTrue:
> + ["contexts end at the stack pointer"
> + contextSize := coInterpreter fetchStackPointerOf: objOop.
> + ^CtxtTempFrameStart + contextSize].
> + ^self numSlotsOf: objOop "all pointers"].
> + fmt = self forwardedFormat ifTrue: [^1].
> + fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
> +
> + "CompiledMethod: contains both pointers and bytes"
> + header := self methodHeaderOf: objOop.
> + numLiterals := self literalCountOfMethodHeader: header.
> + ^numLiterals + LiteralStart!
>
> Item was changed:
> ----- Method: StackInterpreter>>methodReturnBool: (in category 'plugin primitive support') -----
> methodReturnBool: boolean
> "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
> primResult machinery."
> + self deny: self failed.
> self pop: argumentCount+1 thenPushBool: boolean.
> ^0!
>
> Item was changed:
> ----- Method: StackInterpreter>>methodReturnFloat: (in category 'plugin primitive support') -----
> methodReturnFloat: aFloat
> "Sets the return value for a method."
> <var: 'aFloat' type: #double>
> + self deny: self failed.
> self pop: argumentCount+1 thenPushFloat: aFloat.
> ^0!
>
> Item was changed:
> ----- Method: StackInterpreter>>methodReturnInteger: (in category 'plugin primitive support') -----
> methodReturnInteger: integer
> "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
> primResult machinery."
> + self deny: self failed.
> self pop: argumentCount+1 thenPushInteger: integer.
> ^0!
>
> Item was changed:
> ----- Method: StackInterpreter>>methodReturnReceiver (in category 'plugin primitive support') -----
> methodReturnReceiver
> "Sets the return value for a method"
> + self deny: self failed.
> self pop: argumentCount.
> ^0!
>
> Item was changed:
> ----- Method: StackInterpreter>>methodReturnString: (in category 'plugin primitive support') -----
> methodReturnString: aCString
> "Attempt to answer a ByteString for a given C string as the result of a primitive."
> <var: 'aCString' type: #'char *'>
> + self deny: self failed.
> aCString
> ifNil: [primFailCode := PrimErrOperationFailed]
> ifNotNil:
> [(self stringForCString: aCString)
> ifNil: [primFailCode := PrimErrNoMemory]
> ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].
> ^0!
>
> Item was changed:
> ----- Method: StackInterpreter>>methodReturnValue: (in category 'plugin primitive support') -----
> methodReturnValue: oop
> "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
> primResult machinery."
> + self deny: self failed.
> self pop: argumentCount+1 thenPush: oop.
> ^0!
>
> Item was changed:
> ----- Method: TAssignmentNode>>bindVariablesIn: (in category 'transformations') -----
> bindVariablesIn: aDictionary
>
> + self setVar: (variable bindVariablesIn: aDictionary)
> + exp: (expression bindVariablesIn: aDictionary)!
> - variable := variable bindVariablesIn: aDictionary.
> - expression := expression bindVariablesIn: aDictionary.!
>
> Item was changed:
> ----- Method: TAssignmentNode>>isSameAs: (in category 'testing') -----
> isSameAs: aTParseNode
> + ^self == aTParseNode
> + or: [aTParseNode isAssignment
> + and: [(variable isSameAs: aTParseNode variable)
> + and: [expression isSameAs: aTParseNode expression]]]!
> - ^aTParseNode isAssignment
> - and: [(variable isSameAs: aTParseNode variable)
> - and: [expression isSameAs: aTParseNode expression]]!
>
> Item was changed:
> ----- Method: TAssignmentNode>>postCopy (in category 'copying') -----
> postCopy
>
> + self setVar: variable copy exp: expression copy!
> - variable := variable copy.
> - expression := expression copy!
>
> Item was changed:
> ----- Method: TAssignmentNode>>replaceNodesIn: (in category 'transformations') -----
> replaceNodesIn: aDictionary
>
> + ^aDictionary
> + at: self
> + ifAbsent:
> + [self setVar: (variable replaceNodesIn: aDictionary)
> + exp: (expression replaceNodesIn: aDictionary)]!
> - ^aDictionary at: self ifAbsent: [
> - variable := variable replaceNodesIn: aDictionary.
> - expression := expression replaceNodesIn: aDictionary.
> - self]!
>
> Item was added:
> + ----- Method: TAssignmentNode>>setVar:exp: (in category 'private') -----
> + setVar: varNode exp: expressionNode
> + "This is a private setter, just for breakpointing..."
> + variable := varNode.
> + expression := expressionNode!
>
> Item was changed:
> ----- Method: TConstantNode>>isSameAs: (in category 'comparing') -----
> isSameAs: aTParseNode
> + ^self == aTParseNode
> + or: [aTParseNode isConstant
> + and: [value class == aTParseNode value class
> + and: [value = aTParseNode value]]]!
> - ^aTParseNode isConstant
> - and: [value class == aTParseNode value class
> - and: [value = aTParseNode value]]!
>
> Item was changed:
> ----- Method: TDefineNode>>isSameAs: (in category 'comparing') -----
> isSameAs: aTParseNode
> + ^self == aTParseNode
> + or: [self class == aTParseNode class
> + and: [value class == aTParseNode value class
> + and: [value = aTParseNode value
> + and: [name = aTParseNode nameOrValue]]]]!
> - ^self class == aTParseNode class
> - and: [value class == aTParseNode value class
> - and: [value = aTParseNode value
> - and: [name = aTParseNode nameOrValue]]]!
>
> Item was changed:
> ----- Method: TMethod>>deny: (in category 'error handling') -----
> deny: aBooleanOrBlock
> - <doNotGenerate>
> aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']!
>
> Item was changed:
> ----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') -----
> inlineFunctionCall: aSendNode in: aCodeGen
> "Answer the body of the called function, substituting the actual
> parameters for the formal argument variables in the method body.
> Assume caller has established that:
> 1. the method arguments are all substitutable nodes, and
> 2. the method to be inlined contains no additional embedded returns."
>
> | sel meth doNotRename argsForInlining substitutionDict |
> + aCodeGen maybeBreakForInlineOf: aSendNode in: self.
> sel := aSendNode selector.
> meth := (aCodeGen methodNamed: sel) copy.
> meth ifNil:
> [^self inlineBuiltin: aSendNode in: aCodeGen].
> doNotRename := Set withAll: args.
> argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen.
> meth args with: argsForInlining do:
> [ :argName :exprNode |
> exprNode isLeaf ifTrue:
> [doNotRename add: argName]].
> (meth statements size = 2
> and: [meth statements first isSend
> and: [meth statements first selector == #flag:]]) ifTrue:
> [meth statements removeFirst].
> meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen.
> meth renameLabelsForInliningInto: self.
> self addVarsDeclarationsAndLabelsOf: meth except: doNotRename.
> substitutionDict := Dictionary new: meth args size * 2.
> meth args with: argsForInlining do:
> [ :argName :exprNode |
> + (exprNode isVariable and: [exprNode name = argName]) ifFalse:
> + [substitutionDict at: argName put: exprNode].
> - substitutionDict at: argName put: exprNode.
> (doNotRename includes: argName) ifFalse:
> [locals remove: argName]].
> meth parseTree bindVariablesIn: substitutionDict.
> ^meth parseTree endsWithReturn
> ifTrue: [meth parseTree copyWithoutReturn]
> ifFalse: [meth parseTree]!
>
> Item was added:
> + ----- Method: TParseNode>>deny: (in category 'as yet unclassified') -----
> + deny: aBooleanOrBlock
> + aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']!
>
> Item was changed:
> ----- Method: TParseNode>>isSameAs: (in category 'comparing') -----
> isSameAs: aTParseNode
> "Answer if the ParseTree rooted at this node is the same as aTParseNode.
> By default answer false and have subclasses override as appropriate."
> + ^self == aTParseNode!
> - ^false!
>
> Item was added:
> + ----- Method: TReturnNode>>isSameAs: (in category 'comparing') -----
> + isSameAs: aTParseNode
> + ^self == aTParseNode
> + or: [aTParseNode isReturn
> + and: [expression isSameAs: aTParseNode expression]]!
>
> Item was changed:
> ----- Method: TSendNode>>isSameAs: (in category 'comparing') -----
> isSameAs: aTParseNode
> + self == aTParseNode ifTrue: [^true].
> (aTParseNode isSend
> and: [selector == aTParseNode selector
> and: [receiver isSameAs: aTParseNode receiver]]) ifFalse:
> [^false].
> arguments with: aTParseNode args do:
> [:a :b|
> (a isSameAs: b) ifFalse:
> [^false]].
> ^true!
>
> Item was changed:
> ----- Method: TStmtListNode>>bindVariablesIn: (in category 'transformations') -----
> bindVariablesIn: aDictionary
>
> + aDictionary notEmpty ifTrue:
> + [statements := statements collect: [:s| s bindVariablesIn: aDictionary]]!
> - statements := statements collect: [ :s | s bindVariablesIn: aDictionary ].!
>
> Item was changed:
> ----- Method: TStmtListNode>>isSameAs: (in category 'testing') -----
> isSameAs: aTParseNode
> + self == aTParseNode ifTrue: [^true].
> (aTParseNode isStmtList
> and: [statements size = aTParseNode statements size]) ifFalse:
> [^false].
> statements with: aTParseNode statements do:
> [:mine :theirs|
> (mine isSameAs: theirs) ifFalse:
> [^false]].
> ^true!
>
> Item was changed:
> ----- Method: TVariableNode>>isSameAs: (in category 'comparing') -----
> isSameAs: aTParseNode
> + ^self == aTParseNode
> + or: [aTParseNode isVariable
> + and: [name = aTParseNode name]]!
> - ^aTParseNode isVariable
> - and: [name = aTParseNode name]!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>canReturnInRegistersStructOfSize: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>canReturnInRegistersStructOfSize: (in category 'marshalling') -----
> canReturnInRegistersStructOfSize: returnStructSize
> "Answer if a struct result of a given size can be returned via registers or not.
> Size is a necessary condition, but it might not be a sufficient condition.
> For example, SysV X64 also require that struct fields be properly aligned."
> ^self subclassResponsibility!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushSignedLongLongOop:in: (in category 'marshalling') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushSignedLongLongOop:in: (in category 'callout support') -----
> ffiPushSignedLongLongOop: oop in: calloutState
> <var: #calloutState type: #'CalloutState *'>
> "Push a longlong type (e.g., a 64bit integer).
> Note: Coercions from float are *not* supported."
> | value |
> <var: #value type: #sqLong>
> (oop = interpreterProxy nilObject
> or: [oop = interpreterProxy falseObject])
> ifTrue:[value := 0] ifFalse:
> [oop = interpreterProxy trueObject
> ifTrue:[value := 1] ifFalse:
> [value := interpreterProxy signed64BitValueOf: oop.
> interpreterProxy failed ifTrue:
> [^FFIErrorCoercionFailed]]].
> ^self ffiPushSignedLongLong: value in: calloutState!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
> ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
> <var: #pointer type: #'void *'>
> <var: #argSpec type: #'sqInt *'>
> <var: #calloutState type: #'CalloutState *'>
> <inline: true>
> self subclassResponsibility!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushStructureContentsOf:in: (in category 'marshalling-struct') -----
> - ----- 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:
> [^FFIErrorStructSize].
> ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
> (interpreterProxy isInMemory: ptrAddress) ifTrue:
> [^FFIErrorInvalidPointer].
> ^self ffiPushPointer: ptrAddress in: calloutState].
> ^FFIErrorBadArg!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedLongLongOop:in: (in category 'marshalling') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedLongLongOop:in: (in category 'callout support') -----
> ffiPushUnsignedLongLongOop: oop in: calloutState
> <var: #calloutState type: #'CalloutState *'>
> "Push an unsigned longlong type (e.g., a 64bit integer).
> Note: Coercions from float are *not* supported."
> | value |
> <var: #value type: #usqLong>
> (oop = interpreterProxy nilObject
> or: [oop = interpreterProxy falseObject])
> ifTrue:[value := 0] ifFalse:
> [oop = interpreterProxy trueObject
> ifTrue:[value := 1] ifFalse:
> [value := interpreterProxy positive64BitValueOf: oop.
> interpreterProxy failed ifTrue:
> [^FFIErrorCoercionFailed]]].
> ^self ffiPushUnsignedLongLong: value in: calloutState!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushVoid:in: (in category 'marshalling') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushVoid:in: (in category 'callout support') -----
> ffiPushVoid: ignored in: calloutState
> <var: #calloutState type: #'CalloutState *'>
> "This is a fallback in case somebody tries to pass a 'void' value.
> We could simply ignore the argument but I think it's better to let
> the caller know what he did"
> ^FFIErrorAttemptToPassVoid!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>nonRegisterStructReturnIsViaImplicitFirstArgument (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>nonRegisterStructReturnIsViaImplicitFirstArgument (in category 'marshalling') -----
> nonRegisterStructReturnIsViaImplicitFirstArgument
> "Answer if a struct returned in memory is returned to the
> referent of a pointer passed as an implciit first argument.
> It almost always is. Subclasses can override if not."
> ^true!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>returnStructInRegisters: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
> returnStructInRegisters: calloutState
> "Answer if struct result is returned in registers or not.
> Use the OS specific encoding stored in structReturnType.
> Since it is OS dependent, leave the responsibility to subclass"
> <var: #calloutState type: #'CalloutState *'>
> ^self subclassResponsibility!
>
> Item was changed:
> ----- Method: ThreadedX64SysVFFIPlugin>>registerType:ForUnionSpecs:OfLength:StartingAt:ByteOffset:EightbyteOffset: (in category 'marshalling') -----
> registerType: initialRegisterType ForUnionSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: byteOffset EightbyteOffset: eightbyteOffset
> "Answer with a number characterizing the register type for passing a union of size <= 16 bytes.
> On input, the index points to the structure header (the one with FFIFlagStructure + structSize)
> On output, the index points to the structure trailer (the FFIFlagStructure)."
>
> <var: #specs type: #'unsigned int*'>
> <var: #indexPtr type: #'unsigned int*'>
> - <var: #subIndex type: #'unsigned int'>
> <inline: false>
> | registerType spec atomic isInt recurse subLevel |
> registerType := initialRegisterType.
> [indexPtr at: 0 put: (indexPtr at: 0) + 1.
> subLevel := 0.
> (indexPtr at: 0) < specSize]
> whileTrue:
> [spec := specs at: (indexPtr at: 0).
> isInt := false.
> recurse := false.
> spec = FFIFlagStructure "this marks end of structure/union"
> ifTrue:
> [subLevel = 0 ifTrue: [^registerType].
> subLevel := subLevel - 1]
> ifFalse:
> [(spec anyMask: FFIFlagPointer)
> ifTrue:
> [isInt := true]
> ifFalse:
> [(spec bitAnd: FFIFlagStructure + FFIFlagAtomic)
> caseOf:
> {[FFIFlagStructure] ->
> [recurse := (self isUnionSpec: specs OfLength: specSize StartingAt: (indexPtr at: 0))not.
> recurse ifFalse: [subLevel := subLevel + 1]].
> [FFIFlagAtomic] ->
> [atomic := self atomicTypeOf: spec.
> isInt := (atomic >> 1) ~= (FFITypeSingleFloat >> 1)]}
> otherwise: ["invalid spec" ^-1]].
> isInt
> ifTrue:
> ["If this eightbyte contains an int field, then we must use an int register"
> registerType := registerType bitOr: 1 << eightbyteOffset].
> recurse ifTrue:
> ["struct in union require a recursive form, because we handle byteOffset/eightbyteOffset differently"
> registerType := self
> registerType: registerType
> ForStructSpecs: specs
> OfLength: specSize
> StartingAt: indexPtr
> ByteOffset: byteOffset
> EightbyteOffset: eightbyteOffset]]].
> self assert: subLevel = 0.
> ^registerType!
>
> Item was changed:
> ----- Method: ThreadedX64SysVFFIPlugin>>registerTypeForStructSpecs:OfLength: (in category 'marshalling') -----
> registerTypeForStructSpecs: specs OfLength: specSize
> "Answer with a number characterizing the register type for passing a struct of size <= 16 bytes.
> The bit at offset i of registerType is set to 1 if eightbyte at offset i is a int register (RAX ...)
> The bit at offset 2 indicates if there is a single eightbyte (struct size <= 8)
> * 2r00 for float float (XMM0 XMM1)
> * 2r01 for int float (RAX XMM0)
> * 2r10 for float int (XMM0 RAX)
> * 2r11 for int int (RAX RDX)
> * 2r100 for float (XMM0)
> * 2r101 for int (RAX)
> * 2r110 INVALID (not aligned)
> Beware, the bits must be read from right to left for decoding register type.
> Note: this method reconstructs the struct layout according to X64 alignment rules.
> Therefore, it will not work for packed struct or other exotic alignment."
>
> <var: #specs type: #'unsigned int*'>
> - <var: #subIndex type: #'unsigned int'>
> <inline: false>
> | index byteSize registerType |
> index := 0.
> byteSize := (specs at: index) bitAnd: FFIStructSizeMask.
> byteSize > 16 ifTrue: [^2r110].
> (self checkAlignmentOfStructSpec: specs OfLength: specSize StartingAt: index)
> ifFalse: [^2r110].
> registerType := byteSize <= 8 ifTrue: [2r100] ifFalse: [0].
> ^(self isUnionSpec: specs OfLength: specSize StartingAt: 0)
> ifTrue: [ self
> registerType: registerType
> ForUnionSpecs: specs
> OfLength: specSize
> StartingAt: (self addressOf: index)
> ByteOffset: 0
> EightbyteOffset: 0 ]
> ifFalse: [ self
> registerType: registerType
> ForStructSpecs: specs
> OfLength: specSize
> StartingAt: (self addressOf: index)
> ByteOffset: 0
> EightbyteOffset: 0 ]!
>
> Item was changed:
> ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') -----
> generateVMPlugins
> ^VMMaker
> generatePluginsTo: self sourceTree, '/src'
> options: #()
> platformDir: self sourceTree, '/platforms'
> including:#(ADPCMCodecPlugin AsynchFilePlugin
> BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation
> BochsIA32Plugin BochsX64Plugin GdbARMv6Plugin GdbARMv8Plugin
> CameraPlugin CroquetPlugin DeflatePlugin DropPlugin
> + "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin
> - "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin
> "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin
> GeniePlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin
> JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
> LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
> MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin
> ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin
> SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin
> ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin
> ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
> UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin
> Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin
> XDisplayControlPlugin)!

_,,,^..^,,,_

best, Eliot