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

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

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

Name: VMMaker.oscog-eem.2266
Author: eem
Time: 31 August 2017, 12:20:30.681037 pm
UUID: 0501d71a-3185-4bdb-a99c-76a5fbbeee22
Ancestors: VMMaker.oscog-eem.2265

Spur:
Simplify cleverSwapHeaders:and:copyHashFlag: via xor.
Fix the type of currentAllocatedBytes given the Slang changes below.

Slang:
Fix a regression caused by the Slang fixes in VMMaker.oscog-eem.2243.
Since inferTypesForImplicitlyTypedVariablesIn: no longer sets the types of locals as it goes along (which was incorrect) we can no longer default the types of untyped variables to sqInt for the purposes of returnTypeForSend:in:ifNil:.  To allow returnTypeForSend:in:ifNil: to answer nil for arithmetic on untyped expressions typeForArithmetic:in: uses TParseNode>>typeOrNilFrom:in: instead of CCodeGenerator>>typeFor:in: to avoid the defaulting.  returnTypeForSend:in:ifNil: has been refactored to use the more direct TParseNode>>typeFrom:in: instead of CCodeGenerator>>typeFor:in: for clarity.
Teh regression caused Slang to fail to infer the types of remembered1/2 & hash1/2 in cleverSwapHeaders:and:copyHashFlag:.  The new code correctly infers the types of remembered & hashBits as sqLong.

SoundPlugin:
Eliminate a couple of warnings by using 0 instead of NULL.

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

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') -----
  returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil
        "Answer the return type for a send.  Unbound sends default to typeIfNil.
         Methods with types as yet unknown have a type determined either by the
         kernelReturnTypes or the table below, or, if they are in neither set, then nil.
         The inferred type should match as closely as possible the C type of
         generated expessions so that inlining would not change the expression.
         If there is a method for sel but its return type is as yet unknown it mustn't
         be defaulted, since on a subsequent pass its type may be computable."
        | sel methodOrNil |
        methodOrNil := self anyMethodNamed: (sel := sendNode selector).
        (methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue:
                [^self baseTypeForType: methodOrNil returnType].
        ^kernelReturnTypes
                at: sel
                ifAbsent:
                        [sel
                                caseOf: {
                                [#integerValueOf:]              ->      [#sqInt].
                                [#isIntegerObject:]             ->      [#int].
+                               [#negated]                              ->      [self promoteArithmeticTypes: (sendNode receiver typeFrom: self in: aTMethod) and: #int].
-                               [#negated]                              ->      [self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
                                [#+]                                    ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#-]                                            ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#*]                                    ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#/]                                            ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#//]                                   ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#\\]                                   ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#rem:]                                 ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#quo:]                                 ->      [self typeForArithmetic: sendNode in: aTMethod].
                                "C99 Sec Bitwise shift operators ... 3 Sematics ...
                                 The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..."
+                               [#>>]                                   ->      [sendNode receiver typeFrom: self in: aTMethod].
+                               [#<<]                                   ->      [sendNode receiver typeFrom: self in: aTMethod].
+                               [#addressOf:]                   ->      [(sendNode receiver typeFrom: self in: aTMethod)
-                               [#>>]                                   ->      [self typeFor: sendNode receiver in: aTMethod].
-                               [#<<]                                   ->      [self typeFor: sendNode receiver in: aTMethod].
-                               [#addressOf:]                   ->      [(self typeFor: sendNode receiver in: aTMethod)
                                                                                                ifNil: [#sqInt]
                                                                                                ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
                                [#at:]                                  ->      [self typeForDereference: sendNode in: aTMethod].
                                [#bitAnd:]                              ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#bitOr:]                               ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#bitXor:]                              ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#bitClear:]                            ->      [self typeForArithmetic: sendNode in: aTMethod].
                                [#bitInvert32]                  ->      [#'unsigned int'].
+                               [#bitInvert64]                  ->      [self promoteArithmeticTypes: (sendNode receiver typeFrom: self in: aTMethod) and: #int].
-                               [#bitInvert64]                  ->      [self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
                                [#byteSwap32]                   ->      [#'unsigned int'].
                                [#byteSwap64]                   ->      [#'unsigned long long'].
                                [#byteSwapped32IfBigEndian:]    ->      [#'unsigned int'].
                                [#byteSwapped64IfBigEndian:]    ->      [#'unsigned long long'].
                                [#=]                                    ->      [#int].
                                [#~=]                                   ->      [#int].
                                [#==]                                   ->      [#int].
                                [#~~]                                   ->      [#int].
                                [#<]                                    ->      [#int].
                                [#<=]                                   ->      [#int].
                                [#>]                                    ->      [#int].
                                [#>=]                                   ->      [#int].
                                [#between:and:]         ->      [#int].
                                [#anyMask:]                             ->      [#int].
                                [#allMask:]                             ->      [#int].
                                [#noMask:]                              ->      [#int].
                                [#isNil]                                        ->      [#int].
                                [#notNil]                               ->      [#int].
                                [#&]                                    ->      [#int].
                                [#|]                                            ->      [#int].
                                [#not]                                  ->      [#int].
                                [#asFloat]                              ->      [#double].
                                [#atan]                                 ->      [#double].
                                [#exp]                                  ->      [#double].
                                [#log]                                  ->      [#double].
                                [#sin]                                  ->      [#double].
                                [#sqrt]                                 ->      [#double].
                                [#asLong]                               ->      [#long].
                                [#asInteger]                    ->      [#sqInt].
                                [#asIntegerPtr]                 ->      [#'sqIntptr_t'].
                                [#asUnsignedInteger]    ->      [#usqInt].
                                [#asUnsignedIntegerPtr]->       [#'usqIntptr_t'].
                                [#asUnsignedLong]               ->      [#'unsigned long'].
                                [#asUnsignedLongLong]           ->      [#'unsigned long long'].
                                [#asVoidPointer]                ->      [#'void *'].
                                [#signedIntToLong]              ->      [#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
                                [#signedIntToShort]     ->      [#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
                                [#cCoerce:to:]                  ->      [sendNode args last value].
                                [#cCoerceSimple:to:]    ->      [sendNode args last value].
                                [#sizeof:]                              ->      [#'usqIntptr_t']. "Technically it's a size_t but it matches on target architectures so far..."
                                [#ifTrue:ifFalse:]              ->      [self typeForConditional: sendNode in: aTMethod].
                                [#ifFalse:ifTrue:]              ->      [self typeForConditional: sendNode in: aTMethod].
                                [#ifTrue:]                              ->      [self typeForConditional: sendNode in: aTMethod].
                                [#ifFalse:]                             ->      [self typeForConditional: sendNode in: aTMethod].
                                [#and:]                                 ->      [#sqInt].
                                [#or:]                                  ->      [#sqInt].
                                [#caseOf:]                              ->      [self typeFor: sendNode args first in: aTMethod] }
                                otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted,
                                                        since on a subsequent pass its type may be computable.  Only default unbound selectors."
                                        [methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]!

Item was changed:
  ----- Method: CCodeGenerator>>typeForArithmetic:in: (in category 'type inference') -----
  typeForArithmetic: sendNode in: aTMethod
        "Answer the return type for an arithmetic sendThis is so that the inliner can still
         inline simple expressions.  Deal with pointer arithmetic, floating point arithmetic
         and promotion."
+       | rcvrType argType arg |
+       rcvrType := sendNode receiver typeOrNilFrom: self in: aTMethod.
+       argType := (arg := sendNode args first) typeOrNilFrom: self in: aTMethod.
-       | rcvrType argType arg promotedType |
-       rcvrType := self typeFor: sendNode receiver in: aTMethod.
-       argType := self typeFor: (arg := sendNode args first) in: aTMethod.
        "deal with pointer arithmetic"
        ((rcvrType notNil and: [rcvrType last == $*]) or: [argType notNil and: [argType last == $*]]) ifTrue:
                [(rcvrType isNil or: [argType isNil]) ifTrue:
                        [^nil].
                 (rcvrType last == $* and: [argType last == $*]) ifTrue:
                        [sendNode selector == #- ifTrue:
                                [^#int].
                         self error: 'invalid pointer arithmetic'].
                 ^rcvrType last == $*
                        ifTrue: [rcvrType]
                        ifFalse: [argType]].
+       ^(self promoteArithmeticTypes: rcvrType and: argType) ifNotNil:
+               [:promotedType|
+                "We have to be very careful with subtraction.  The difference between two unsigned types is signed.
+                 But we don't want unsigned - constant to be signed.  We almost always want this to stay unsigned."
+                (sendNode selector == #- and: [promotedType first == $u and: [(arg isConstant and: [arg value isInteger]) not]])
+                       ifTrue: [promotedType allButFirst: ((promotedType beginsWith: 'unsigned') ifTrue: [9] ifFalse: [1])]
+                       ifFalse: [promotedType]]!
-       promotedType := self promoteArithmeticTypes: rcvrType and: argType.
-       "We have to be very careful with subtraction.  The difference between two unsigned types is signed.
-        But we don't want unsigned - constant to be signed.  We almost always want this to stay unsigned."
-       ^(sendNode selector == #- and: [promotedType first == $u and: [(arg isConstant and: [arg value isInteger]) not]])
-               ifTrue: [promotedType allButFirst: ((promotedType beginsWith: 'unsigned') ifTrue: [9] ifFalse: [1])]
-               ifFalse: [promotedType]!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSetDefaultSoundPlayer (in category 'primitives') -----
  primitiveSetDefaultSoundPlayer
        "Tell the operating system to use the specified device name as the output device for sound."
        "arg at top of stack is the String"
        | deviceName obj srcPtr sz |
        <export: true>
        <var: 'deviceName' declareC: 'char deviceName[257]'>
        <var: 'srcPtr' type: #'char *'>

        "Parse arguments"
        interpreterProxy methodArgumentCount = 1 ifFalse:
                [^interpreterProxy primitiveFail].
        obj := interpreterProxy stackValue: 0.
        (interpreterProxy isBytes: obj) ifFalse:
                [^interpreterProxy primitiveFail].
        (sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse:
                [^interpreterProxy primitiveFail].
        srcPtr := interpreterProxy firstIndexableField: obj.
        self touch: srcPtr.
        self touch: deviceName.
        self touch: sz.
        self cCode: 'strncpy(deviceName, srcPtr, sz)'.
+       self cCode: 'deviceName[sz] = 0'.
-       self cCode: 'deviceName[sz] = NULL'.

        "do the work"
        self cCode: 'setDefaultSoundPlayer(deviceName)'.
        interpreterProxy failed ifFalse: "pop arg, leave receiver"
                [interpreterProxy pop: 1]!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSetDefaultSoundRecorder (in category 'primitives') -----
  primitiveSetDefaultSoundRecorder
        "Tell the operating system to use the specified device name as the input device for sound."
        "arg at top of stack is the String"
        | deviceName obj srcPtr sz |
        <export: true>
        <var: 'deviceName' declareC: 'char deviceName[257]'>
        <var: 'srcPtr' type: #'char *'>

        "Parse arguments"
        interpreterProxy methodArgumentCount = 1 ifFalse:
                [^interpreterProxy primitiveFail].
        obj := interpreterProxy stackValue: 0.
        (interpreterProxy isBytes: obj) ifFalse:
                [^interpreterProxy primitiveFail].
        (sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse:
                [^interpreterProxy primitiveFail].
        srcPtr := interpreterProxy firstIndexableField: obj.
        self touch: srcPtr.
        self touch: deviceName.
        self touch: sz.
        self cCode: 'strncpy(deviceName, srcPtr, sz)'.
+       self cCode: 'deviceName[sz] = 0'.
-       self cCode: 'deviceName[sz] = NULL'.

        "do the work"
        self cCode: 'setDefaultSoundRecorder(deviceName)'.
        interpreterProxy failed ifFalse: "pop arg, leave receiver"
                [interpreterProxy pop: 1]!

Item was changed:
  ----- Method: SpurMemoryManager>>cleverSwapHeaders:and:copyHashFlag: (in category 'become implementation') -----
  cleverSwapHeaders: obj1 and: obj2 copyHashFlag: copyHashFlag
        "swap headers, but swapping headers swaps remembered bits and hashes;
         remembered bits must be unswapped and hashes may be unswapped if
         copyHash is false."
        "This variant doesn't tickle a compiler bug in gcc and clang.  See naiveSwapHeaders:and:copyHashFlag:"
        <inline: true>
+       | header1 header2 remembered |
-       | header1 header2 remembered1 remembered2 |
        header1 := self long64At: obj1.
        header2 := self long64At: obj2.
+       remembered := (header1 bitXor: header2) bitAnd: 1 << self rememberedBitShift.
+       remembered ~= 0 ifTrue:
+               [header1 := header1 bitXor: remembered.
+                header2 := header2 bitXor: remembered].

-       remembered1 := header1 bitAnd: 1 << self rememberedBitShift.
-       remembered2 := header2 bitAnd: 1 << self rememberedBitShift.
-       remembered1 ~= remembered2 ifTrue:
-               [header1 := header1 - remembered1 + remembered2.
-                header2 := header2 - remembered2 + remembered1].
        "swapping headers swaps hash; if not copyHashFlag then unswap hash"
        copyHashFlag ifFalse:
+               [| hashBits |
+                hashBits := (header1 bitXor: header2) bitAnd: self identityHashFullWordMask.
+                hashBits ~= 0 ifTrue:
+                       [header1 := header1 bitXor: hashBits.
+                        header2 := header2 bitXor: hashBits]].
-               [| hash1 hash2 |
-                hash1 := header1 bitAnd: self identityHashFullWordMask.
-                hash2 := header2 bitAnd: self identityHashFullWordMask.
-                hash1 ~= hash2 ifTrue:
-                       [header1 := header1 - hash1 + hash2.
-                        header2 := header2 - hash2 + hash1]].
        self long64At: obj1 put: header2.
        self long64At: obj2 put: header1!

Item was changed:
  ----- Method: SpurMemoryManager>>currentAllocatedBytes (in category 'allocation accounting') -----
  currentAllocatedBytes
        "Compute the current allocated bytes since last set.
         This is the cumulative total in statAllocatedBytes plus the allocation since the last scavenge."
        | use |
+       "Slang infers the type of the difference between two unsigned variables as signed.
+        In this case we want it to be unsigned."
+       <var: 'use' type: #usqInt>
        use := segmentManager totalOldSpaceCapacity - totalFreeOldSpace.
        ^statAllocatedBytes
         + (freeStart - scavenger eden start)
         + (use - oldSpaceUsePriorToScavenge)!