[Vm-dev] VM Maker: VMMaker.oscog-eem.2266.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Aug 31 19:21:26 UTC 2017
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)!
More information about the Vm-dev
mailing list