Vm-dev June 2020

vm-dev@lists.squeakfoundation.org

23 participants
106 discussions

Sista byte code documentation
by Vanessa Freudenberg 01 Jul '20

01 Jul '20

Eliot / Clément / Everyone - What’s the best documentation for the new byte codes? I found the 2014 paper, and Clèment’s thesis, and I don’t think either is detailed enough to implement them correctly. Just wondering if there’s anything else I could peruse other than the VM source code. Cheers! Vanessa

5 6

[OpenSmalltalk/opensmalltalk-vm] 8f9be8: MacOS: Support internal plugins that use C++. The...
by Eliot Miranda 01 Jul '20

01 Jul '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 8f9be8b3cb2ea842556e0845abec05523be1559f https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8f9be8b3cb2ea84255… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-30 (Tue, 30 Jun 2020) Changed paths: M build.macos32x86/common/Makefile.plugin M build.macos32x86/common/Makefile.rules M build.macos32x86/common/Makefile.vm M build.macos64x64/common/Makefile.plugin M build.macos64x64/common/Makefile.rules M build.macos64x64/common/Makefile.vm M platforms/iOS/plugins/BochsIA32Plugin/Makefile M platforms/iOS/plugins/BochsX64Plugin/Makefile Log Message: ----------- MacOS: Support internal plugins that use C++. These need to be linked with clang++ not clang. Use LINK_WITH_CXX not LINK_WITH_CPP as enabling var name. Comment the new parameters to Makefile.vm there-in (SDK,TARGET_MINVER, et al). [ci skip]

1 0

[OpenSmalltalk/opensmalltalk-vm] 11cce8: Eliminate redefinition of MAXFLOAT warning on Macos.
by Eliot Miranda 30 Jun '20

30 Jun '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 11cce8e34a23fed387ed0587c59f18a735cb80a8 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/11cce8e34a23fed387… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-30 (Tue, 30 Jun 2020) Changed paths: M platforms/Cross/third-party/fdlibm/fdlibm.h Log Message: ----------- Eliminate redefinition of MAXFLOAT warning on Macos. [ci skip]

1 0

[OpenSmalltalk/opensmalltalk-vm] 966fd3: Allow the Mac Makefiles to specify a given SDK and...
by Eliot Miranda 30 Jun '20

30 Jun '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 966fd3684be723af872bc36cac7dcf0130b7717c https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/966fd3684be723af87… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-30 (Tue, 30 Jun 2020) Changed paths: M build.macos32x86/common/Makefile.flags M build.macos64x64/common/Makefile.flags Log Message: ----------- Allow the Mac Makefiles to specify a given SDK and TARGET_MIN_VER. Make sure the 64-bit and 32-bit versions both have EXTRABFLAGS/EXTRADYFLAGS [ci skip]

1 0

[OpenSmalltalk/opensmalltalk-vm] fdc836: Macos makfiles: move fdlibm.a to the end of the li...
by Eliot Miranda 26 Jun '20

26 Jun '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: fdc836edab9bf9fe2a482fe85422e859fc370e51 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/fdc836edab9bf9fe2a… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-26 (Fri, 26 Jun 2020) Changed paths: M build.macos32x86/common/Makefile.vm M build.macos64x64/common/Makefile.vm Log Message: ----------- Macos makfiles: move fdlibm.a to the end of the list of static libraries, after the internal plugin libs. Add fdlibm.a and BIT_IDENTICAL_FLOATING_POINT to the 32-bit Makefiles as an option. [ci skip]

1 0

Broken: OpenSmalltalk/opensmalltalk-vm#2099 (Cog - 1e815b3)
by Travis CI 26 Jun '20

26 Jun '20

Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2099 Status: Broken Duration: 21 mins and 19 secs Commit: 1e815b3 (Cog) Author: Eliot Miranda Message: Crypography plugins as per CryptographyPlugins-ul.22 View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/93b9f887c47d...1e… View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/70219192… -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&ut…. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notificati…. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications.

1 0

[OpenSmalltalk/opensmalltalk-vm] 1e815b: Crypography plugins as per CryptographyPlugins-ul.22
by Eliot Miranda 26 Jun '20

26 Jun '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 1e815b33ac593758c1834e08fa16aa2ea1e7935e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/1e815b33ac593758c1… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-25 (Thu, 25 Jun 2020) Changed paths: M src/plugins/DESPlugin/DESPlugin.c M src/plugins/DSAPrims/DSAPrims.c M src/plugins/MD5Plugin/MD5Plugin.c A src/plugins/SHA2Plugin/SHA2Plugin.c Log Message: ----------- Crypography plugins as per CryptographyPlugins-ul.22

1 0

VM Maker: VMMaker.oscog-eem.2762.mcz
by commits＠source.squeak.org 26 Jun '20

26 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2762.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2762 Author: eem Time: 25 June 2020, 3:02:53.797793 pm UUID: 4c244387-7f00-429e-8c37-1524f9397177 Ancestors: VMMaker.oscog-eem.2761 Merge VMMaker.oscog-ul.2763 add missing SHA2Plugin to the list of plugins =============== 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 SHA2Plugin - "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)!

1 0

VM Maker Inbox: VMMaker.oscog-nice.2761.mcz
by commits＠source.squeak.org 25 Jun '20

25 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-nice.2761.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.2761 Author: nice Time: 20 June 2020, 8:11:09.897426 pm UUID: e8105e2b-a95e-4698-9a5f-939360e251b8 Ancestors: VMMaker.oscog-eem.2760 1) Revise a bit the tranformation of assignment/returns for C code generation (see below) 2) Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages. In Smalltalk, every statement is an expression that can be used in other expression, assigned to variables, etc... In C, not all statements are valid expressions, or IOW, not all statements have a value. In C parlance, rvalues are the ones which can be used at the right of an assignment, lvalues the ones which can be used on the left of an assignment. While working on FFI, I had invalid code generated looking like: err = switch(atomicType) ... This is because there is brittle code for transforming some expressions, which are not generic enough. For example, we have similar TSwitchStmtListNode and TCaseStmtNode for handling #dispatchOn:in:, but not exactly same handling of both. Before this change, an overview can be given by reviewing senders of: #isSwitch #isCaseStmt This commit is an attempt to enhance/generalize handling of such non-rvalues by distributing the handling of those constructs in TParseNode hierarchy. A slight change, is that assigning/returning result of a caseOf: without otherwise clause did create a default branch with an error message and a default value for the returned expression/assigned variable. See #emitCCodeOn:addToEndOfCases:level:generator: or #emitCCodeOn:prependToEndOfCases:level:generator: The new #transformInAssignmentTo: only create the error message, but does not provide the default value. This is because type analysis might have been not yet taken place at time of transformation. Is this really needed? I don't think so. Please review! We might want to further extend the mechanism. =============== Diff against VMMaker.oscog-eem.2760 =============== Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansion:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansion: stmtList on: aStream level: level generator: aCodeGen stmtList statements last = variable ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable) - stmtList copy - assignLastExpressionTo: variable; emitCCodeOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansionAsExpression:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansionAsExpression: stmtList on: aStream level: level generator: aCodeGen stmtList statements last = variable ifTrue: [^expression emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable) - stmtList copy - assignLastExpressionTo: variable; emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') ----- emitValueExpansionOn: aStream level: level generator: aCodeGen | stmtList lastStmt copiedStatements | self assert: (expression isSend and: [expression isValueExpansion]). stmtList := expression receiver. lastStmt := stmtList statements last. (lastStmt = variable or: [lastStmt isReturn]) ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + copiedStatements := stmtList copy transformInAssignmentTo: variable. - copiedStatements := stmtList copy. - copiedStatements statements - at: stmtList statements size - put: (TAssignmentNode new - setVariable: variable - expression: lastStmt). expression copy receiver: copiedStatements; emitCCodeOn: aStream level: level generator: aCodeGen! Item was added: + ----- Method: TAssignmentNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Avoid transforming: + x := expression + into: + x := x := expression" + + aTVariableNode = variable ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was changed: TParseNode subclass: #TCaseStmtNode + instanceVariableNames: 'expression firsts lasts cases otherwiseOrNil' - instanceVariableNames: 'expression firsts lasts cases' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! !TCaseStmtNode commentStamp: '<historical>' prior: 0! I implement the main dispatch case statements for bytecode and primitive dispatch. See TMethod classPool associationAt: #CaseStatements! Item was changed: ----- Method: TCaseStmtNode>>emitCCodeOn:level:generator: (in category 'C code generation') ----- emitCCodeOn: aStream level: level generator: aCodeGen | printMod expansions duplicates | printMod := false. (expression isVariable and: [expression name = 'currentBytecode']) ifTrue: [printMod := true. aStream nextPutAll: 'bytecodeDispatchDebugHook();'; cr; crtab: level. aCodeGen outputAsmLabel: 'bytecodeDispatch' on: aStream. aStream crtab: level]. aStream nextPutAll: 'switch ('. expression emitCCodeOn: aStream level: level generator: aCodeGen. aStream nextPutAll: ') {'; cr. expansions := aCodeGen suppressAsmLabelsWhile: [cases collect: [:case| self filterCommentsFrom: (String streamContents: [:s| case emitCCodeOn: s level: 0 generator: aCodeGen])]]. duplicates := Set new. 1 to: cases size do: [:i| (duplicates includes: i) ifFalse: [(duplicates addAll: ((i to: cases size) select: [:j| (expansions at: i) = (expansions at: j)])) do: [:k| (firsts at: k) to: (lasts at: k) do: [:caseIndex| aStream tab: level; nextPutAll: 'case '; print: caseIndex; nextPut: $:. (caseIndex > 255 and: [printMod]) ifTrue: [aStream nextPutAll: ' /*'; print: (caseIndex bitAnd: 255); nextPutAll: '*/']. aStream cr]]. (cases at: i) emitCCodeOn: aStream level: level + 1 generator: aCodeGen. aStream tab: level + 1; nextPutAll: 'break;'; cr]]. + otherwiseOrNil + ifNotNil: + [aStream + crtab: level; + nextPutAll: 'default:'; + cr. + otherwiseOrNil emitCCodeOn: aStream level: level + 1 generator: aCodeGen]. aStream tab: level; nextPut: $}! Item was added: + ----- Method: TCaseStmtNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A switch is not an rvalue" + + ^false! Item was added: + ----- Method: TCaseStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that each case is transformed into an assignment." + cases := cases collect: [:node | node copy transformInAssignmentTo: aTVariableNode]. + otherwiseOrNil := otherwiseOrNil isNil + ifTrue: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found') + arguments: #()}] + ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. + ^self! Item was added: + ----- Method: TGoToNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A goto is not an rvalue" + + ^false! Item was removed: - ----- Method: TMethod>>isConditionalToBeTransformedForAssignment:in: (in category 'inlining') ----- - isConditionalToBeTransformedForAssignment: aSend in: aCodeGen - "Answer if a send is of the form - e1 - ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] - ifFalse: [self m3] - such that at least one of the sends mN may be inlined.." - - ^(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aSend selector) - and: [aSend args anySatisfy: - [:arg| | stmt | - self assert: arg isStmtList. - arg statements size > 1 - or: [(stmt := arg statements first) isSwitch - or: [stmt isSend - and: [(aCodeGen mayInline: stmt selector) - or: [self isConditionalToBeTransformedForAssignment: stmt in: aCodeGen]]]]]]! Item was changed: ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') ----- transformConditionalAssignment: node in: aCodeGen "If possible answer the transformation of code of the form var := e1 ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] ifFalse: [self m3] into e1 ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]] ifFalse: [var := self m3] + to allow inlining of m1, m2, et al. Otherwise answer nil. + Also apply to various C constructs like switch" - to allow inlining of m1, m2, et al. Otherwise answer nil." - | expr | ^(node isAssignment + and: [node expression mustTransformWhenAssignedIn: aCodeGen]) ifTrue: + [node expression copy transformInAssignmentTo: node variable]! - and: [(expr := node expression) isSend - and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) - and: [self isConditionalToBeTransformedForAssignment: expr in: aCodeGen]]]) ifTrue: - [expr copy - arguments: - (expr args collect: - [:stmtList| stmtList copy assignLastExpressionTo: node variable]); - yourself]! Item was changed: ----- Method: TMethod>>transformReturnSubExpression:toAssignmentOf:andGoto:unless:into: (in category 'inlining') ----- transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock | expr replacement | expr := node isReturn ifTrue: [node expression] ifFalse: [node]. replacement := (expr isVariable "Eliminate ^self's" and: [expr name = 'self' and: [eliminateReturnSelfs]]) ifTrue: [nil] ifFalse: [exitVar ifNil: [expr] + ifNotNil: [expr transformInAssignmentTo: (TVariableNode new setName: exitVar)]]. - ifNotNil: [TAssignmentNode new - setVariable: (TVariableNode new setName: exitVar) - expression: expr]]. node == parseTree statements last ifTrue: [aBinaryBlock value: replacement value: false] ifFalse: [replacement := replacement ifNil: [TGoToNode new setLabel: exitLabel; yourself] ifNotNil: [TStmtListNode new setArguments: #() statements: {replacement. TGoToNode new setLabel: exitLabel; yourself}; yourself]. aBinaryBlock value: replacement value: true]! Item was changed: ----- Method: TMethod>>transformReturns (in category 'type inference') ----- transformReturns + "Once the return type has been found or inferred, returns may need to be modified. - "Once the return type has been found or inferred, returns may bneed to be modified. If the return type is #void, any occurrences of ^expr must be replaced with expr. ^self. If the type is #sqInt any any occurrences of ^self are replaced with ^0." (returnType == #void or: [returnType == #sqInt]) ifFalse: [^self]. parseTree nodesWithParentsDo: [:node :parent| node isReturn ifTrue: [(node expression isVariable and: [node expression name = 'self']) ifTrue: [returnType = #sqInt ifTrue: [node setExpression: (TConstantNode new setValue: 0)]] ifFalse: [returnType = #void ifTrue: [parent replaceChild: node with: (TStmtListNode new setArguments: #() statements: {node expression. TReturnNode new setExpression: (TVariableNode new setName: 'self') yourself})]]]]! Item was added: + ----- Method: TParseNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "Answer false if this node is potentially not a rvalue. + a rvalue is an expression that can occur to the right of an assignement. + In C code, not all expression can be a rvalue. + For example if() {} else {} are not rvalues, unless they can be transformed into a ()?: construct. + Likewise, while and for loops, switch statements are not possible rvalues. + This method has to take inlining into account, because a simple message send would be transformed into a function call which is an rvalue. + But if the method is inlined rather than called, this may not be the case. + Default behavior is to answer true, only notorious non-rvalues have to refine this" + + ^true + ! Item was added: + ----- Method: TParseNode>>mustTransformWhenAssignedIn: (in category 'testing') ----- + mustTransformWhenAssignedIn: aCodeGen + "Answer whether this node must be transformed when assigned to a variable + var := expr. + Not all statements can be used at the right of assignment in C (rvalues)." + + ^(self isAnRValueIn: aCodeGen) not + ! Item was added: + ----- Method: TParseNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Default behavior is to transform an expression into an assignement + var := expression. + This message has to be redefined in subclasses which are not rvalues." + ^TAssignmentNode new + setVariable: aTVariableNode + expression: self! Item was added: + ----- Method: TReturnNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "This is not an rvalue, we cannot write: + x = return y" + + ^false! Item was added: + ----- Method: TReturnNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "a return shall not be assigned: + x := condition ifTrue: [^nil] ifFalse: [2] + shall be transformed into: + condition ifTrue: [^nil] ifFalse: [x := 2]" + + ^self! Item was added: + ----- Method: TSendNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + self isConditionalSend + ifTrue: ["If all expressions of a conditional are rvalue, then the + conditional can be transformed into a ()?: construct and is + thus an rvalue" + ^ (receiver isAnRValueIn: aCodeGen) + and: [self args + allSatisfy: [:arg | arg isAnRValueIn: aCodeGen]]]. + "inlined message sends are potentially not rvalues" + ^ (aCodeGen mayInline: self selector) not! Item was added: + ----- Method: TSendNode>>mustTransformWhenAssignedIn: (in category 'transformations') ----- + mustTransformWhenAssignedIn: aCodeGen + "Answer whether this node must be transformed. + Avoid infinite transformation loops caused by unchanged nodes." + + (aCodeGen mayInline: self selector) ifTrue: [^false]. + ^super mustTransformWhenAssignedIn: aCodeGen! Item was added: + ----- Method: TSendNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "transform a conditional: + condition ifTrue: [stmt1. stmt2] ifFalse: [stmt3. stmt4]. + into: + condition ifTrue: [stmt1. var := stmt2] ifFalse: [stmt3. var := stmt4]. + If the last expression is itself not an rvalue, it will be transformed recursively" + + self isConditionalSend ifTrue: [^self copy + arguments: + (self args collect: + [:stmtList| stmtList copy transformInAssignmentTo: aTVariableNode]); + yourself]. + "don't attempt to assign aTVariableNode with the error condition (like default switch missing)" + selector = #error ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was removed: - ----- Method: TStmtListNode>>assignLastExpressionTo: (in category 'transformations') ----- - assignLastExpressionTo: variableNode - "Destructively transform the receiver so that its last expression is assigned to the argument." - | index | - index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. - statements - at: index - put: (TAssignmentNode new - setVariable: variableNode - expression: (statements at: index))! Item was added: + ----- Method: TStmtListNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A list of statements is not an rvalue... + Well, in simple cases we could use comma operator (,), but don't bother here." + + ^statements size = 1 and: [statements first isAnRValueIn: aCodeGen]! Item was added: + ----- Method: TStmtListNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that its last expression is assigned to the argument." + | index | + index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. + statements + at: index + put: ((statements at: index) copy transformInAssignmentTo: aTVariableNode). + ^self! Item was added: + ----- Method: TSwitchStmtNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A switch is not an rvalue" + + ^false! Item was added: + ----- Method: TSwitchStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that each case is transformed into an assignment." + cases := cases collect: [:pair | {pair first. pair last copy transformInAssignmentTo: aTVariableNode}]. + otherwiseOrNil := otherwiseOrNil isNil + ifTrue: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found and no otherwise clause') + arguments: #()}] + ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. + ^self! Item was added: + ----- Method: TVariableNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Avoid transforming: + x + into: + x := x" + + aTVariableNode = self ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! 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)!

1 0

VM Maker Inbox: VMMaker.oscog-nice.2762.mcz
by commits＠source.squeak.org 25 Jun '20

25 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-nice.2762.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.2762 Author: nice Time: 21 June 2020, 8:04:31.580691 pm UUID: be5f88fb-cafe-4654-ab95-4f5bafe5de16 Ancestors: VMMaker.oscog-nice.2761 Cosmetic changes - move some smart syntax method FloatArray -> Float32Array requires a recent Squeak trunk image or a compatibility layer - recategorize some FFI methods - remove some unused var:type: =============== Diff against VMMaker.oscog-nice.2761 =============== 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: 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 ]!

1 0

← Newer
1
2
3
4
5
6
7
8
...
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev June 2020