[Vm-dev] VM Maker: VMMaker-dtl.315.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Apr 6 15:14:00 UTC 2013
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.315.mcz
==================== Summary ====================
Name: VMMaker-dtl.315
Author: dtl
Time: 6 April 2013, 11:11:30.122 am
UUID: 3fbadee2-b872-46a1-9b50-b95d04f7a9a0
Ancestors: VMMaker-dtl.314
VMMaker 4.11.5
Remove PixelValuePeekPlugin from defaultUnixSpec.
New SlangTest tests for loop limit code generation.
>From VMMaker.oscog-eem.279 and VMMaker.oscog-eem.282:
Fix translation of to:by:do: loops so that the limit is not re-evaluated
on each iteration if it may have side-effects.
As part of this change make TMethod locals a Set, and sort only when
emitting locals. Alas this causes a number of methods to change.
Fix SmartSyntaxPlugin support method affected by the fixes
for generating to:by:do: loops in VMMaker.oscog-eem.279.
=============== Diff against VMMaker-dtl.314 ===============
Item was changed:
----- Method: CCodeGenerator>>generateToByDo:on:indent: (in category 'C translation') -----
generateToByDo: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ "N.B. MessageNode>>asTranslatorNodeIn: adds the limit var as a hidden fourth argument."
+ | blockExpr iterationVar limitExpr mayHaveSideEffects limitVar step negative |
+ blockExpr := msgNode args third.
+ blockExpr args size = 1 ifFalse:
+ [self error: 'wrong number of block arguments'].
+ iterationVar := blockExpr args first.
+ limitExpr := msgNode args first.
-
- | iterationVar step negative |
- (msgNode args last args size = 1) ifFalse: [
- self error: 'wrong number of block arguments'.
- ].
- iterationVar := msgNode args last args first.
aStream nextPutAll: 'for (', iterationVar, ' = '.
self emitCExpression: msgNode receiver on: aStream.
+ mayHaveSideEffects := msgNode args size = 4. "See TMethod>>prepareMethodIn:"
+ mayHaveSideEffects ifTrue:
+ [limitVar := msgNode args last.
+ aStream nextPutAll: ', ', limitVar name, ' = '.
+ self emitCExpression: limitExpr on: aStream.
+ limitExpr := limitVar].
aStream nextPutAll: '; ', iterationVar.
negative := ((step := msgNode args at: 2) isConstant and: [step value < 0])
or: [step isSend and: [step selector == #negated
and: [step receiver isConstant and: [step receiver value >= 0]]]].
aStream nextPutAll: (negative ifTrue: [' >= '] ifFalse: [' <= ']).
+ self emitCExpression: limitExpr on: aStream.
- self emitCExpression: msgNode args first on: aStream.
aStream nextPutAll: '; ', iterationVar, ' += '.
self emitCExpression: step on: aStream.
aStream nextPutAll: ') {'; cr.
+ blockExpr emitCCodeOn: aStream level: level + 1 generator: self.
+ aStream tab: level.
+ aStream nextPut: $}!
- msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
- level timesRepeat: [ aStream tab ].
- aStream nextPutAll: '}'.!
Item was changed:
----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator equivalent of me"
"selector is sometimes a Symbol, sometimes a SelectorNode!!
On top of this, numArgs is needed due to the (truly grody) use of
arguments as a place to store the extra expressions needed to generate
code for in-line to:by:do:, etc. see below, where it is used."
+ | rcvrOrNil sel args |
+ rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
+ (rcvrOrNil notNil
+ and: [rcvrOrNil isVariable
+ and: [rcvrOrNil name = 'super']]) ifTrue:
+ [^aTMethod superExpansionNodeFor: selector key args: arguments].
+ sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key].
+ ((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
+ or: [sel = #cCode:])
+ and: [arguments first isBlockNode]) ifTrue:
+ [| block |
+ ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
+ ifTrue: [block statements first]
+ ifFalse: [block]].
- | sel args |
- sel := (selector isSymbol) ifTrue: [selector] ifFalse: [selector key].
args := (1 to: sel numArgs) collect:
[:i | (arguments at: i) asTranslatorNodeIn: aTMethod].
+ (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue:
+ ["Restore limit expr that got moved by transformToDo:"
+ args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod.
+ args second.
+ args third. "add the limit var as a hidden extra argument; we may need it later"
+ TVariableNode new setName: arguments first key}].
+ ((sel = #ifFalse: or: [sel = #or:])
+ and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
+ ["Restore argument block that got moved by transformOr: or transformIfFalse:"
+ args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
+ ^TSendNode new
- (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]])
- ifTrue: ["Restore limit expr that got moved by transformToDo:"
- args at: 1 put: ((arguments at: 7) value asTranslatorNodeIn: aTMethod)].
- (sel = #or: and: [arguments size = 2 and: [(arguments at: 2) notNil]])
- ifTrue: ["Restore argument block that got moved by transformOr:"
- args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
- (sel = #ifFalse: and: [arguments size = 2 and: [(arguments at: 2) notNil]])
- ifTrue: ["Restore argument block that got moved by transformIfFalse:"
- args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
- ^ TSendNode new
setSelector: sel
+ receiver: rcvrOrNil
- receiver: (receiver ~~ nil ifTrue: [receiver asTranslatorNodeIn: aTMethod])
arguments: args!
Item was added:
+ ----- Method: SlangTest>>testCallMethodEmbeddedWithSendInLoopLimit (in category 'testing loop limits') -----
+ testCallMethodEmbeddedWithSendInLoopLimit
+ "A loop embedded in a loop with two loop limit variables generated"
+
+ "(SlangTest selector: #testCallMethodEmbeddedWithSendInLoopLimit) debug"
+
+ | m1 sts lines |
+ sts := SlangTestSupportInterpreter inline: true.
+ m1 := (sts asCString: #callMethodEmbeddedWithSendInLoopLimit)
+ copyReplaceAll: 'callMethodEmbeddedWithSendInLoopLimit'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 2.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ self should: (lines select: [:e | 'sqInt kLimiT;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportPlugin inline: true.
+ m1 := (sts asCString: #callMethodEmbeddedWithSendInLoopLimit)
+ copyReplaceAll: 'callMethodEmbeddedWithSendInLoopLimit'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 2.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ self should: (lines select: [:e | 'sqInt kLimiT;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportSSIP inline: true.
+ m1 := (sts asCString: #callMethodEmbeddedWithSendInLoopLimit)
+ copyReplaceAll: 'callMethodEmbeddedWithSendInLoopLimit'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 2.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ self should: (lines select: [:e | 'sqInt kLimiT;' = e withBlanksTrimmed]) size = 1.!
Item was added:
+ ----- Method: SlangTest>>testCallMethodTwiceWithLoopLimitThatMightBeModified (in category 'testing loop limits') -----
+ testCallMethodTwiceWithLoopLimitThatMightBeModified
+ "Two calls to a method with loop that might be modified generates a distinct
+ loop limit variable for each."
+
+ "(SlangTest selector: #testCallMethodTwiceWithLoopLimitThatMightBeModified) debug"
+
+ | m1 sts lines |
+ sts := SlangTestSupportInterpreter inline: true.
+ m1 := (sts asCString: #callMethodTwiceWithLoopLimitThatMightBeModified)
+ copyReplaceAll: 'callMethodTwiceWithLoopLimitThatMightBeModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 2.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT1;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportSSIP inline: true.
+ m1 := (sts asCString: #callMethodTwiceWithLoopLimitThatMightBeModified)
+ copyReplaceAll: 'callMethodTwiceWithLoopLimitThatMightBeModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 2.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT1;' = e withBlanksTrimmed]) size = 1.
+ !
Item was added:
+ ----- Method: SlangTest>>testCallMethodTwiceWithSendInLoopLimit (in category 'testing loop limits') -----
+ testCallMethodTwiceWithSendInLoopLimit
+ "Two calls to a method with loop with loop limit that is a method send can
+ share the same loop limit variable."
+
+ "(SlangTest selector: #testCallMethodTwiceWithSendInLoopLimit) debug"
+
+ | m1 sts lines |
+ sts := SlangTestSupportInterpreter inline: true.
+ m1 := (sts asCString: #callMethodTwiceWithSendInLoopLimit)
+ copyReplaceAll: 'callMethodTwiceWithSendInLoopLimit'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportPlugin inline: true.
+ m1 := (sts asCString: #callMethodTwiceWithSendInLoopLimit)
+ copyReplaceAll: 'callMethodTwiceWithSendInLoopLimit'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportSSIP inline: true.
+ m1 := (sts asCString: #callMethodTwiceWithSendInLoopLimit)
+ copyReplaceAll: 'callMethodTwiceWithSendInLoopLimit'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ !
Item was added:
+ ----- Method: SlangTest>>testCallMethodWithLoopLimitThatIsNotModified (in category 'testing loop limits') -----
+ testCallMethodWithLoopLimitThatIsNotModified
+ "A call to a method with loop with a constant loop limit does not require a
+ loop limit variable."
+
+ "(SlangTest selector: #testCallMethodTwiceWithSendInLoopLimit) debug"
+
+ | m1 sts lines |
+ sts := SlangTestSupportInterpreter inline: true.
+ m1 := (sts asCString: #callMethodWithLoopLimitThatIsNotModified)
+ copyReplaceAll: 'callMethodWithLoopLimitThatIsNotModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 0.
+ self should: (lines select: [:e | 'for (i = 0; i <= 10; i += 1) {' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportPlugin inline: true.
+ m1 := (sts asCString: #callMethodWithLoopLimitThatIsNotModified)
+ copyReplaceAll: 'callMethodWithLoopLimitThatIsNotModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 0.
+ self should: (lines select: [:e | 'for (i = 0; i <= 10; i += 1) {' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportSSIP inline: true.
+ m1 := (sts asCString: #callMethodWithLoopLimitThatIsNotModified)
+ copyReplaceAll: 'callMethodWithLoopLimitThatIsNotModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 0.
+ self should: (lines select: [:e | 'for (i = 0; i <= 10; i += 1) {' = e withBlanksTrimmed]) size = 1.
+ !
Item was added:
+ ----- Method: SlangTest>>testCallMethodWithLoopLimitThatMightBeModified (in category 'testing loop limits') -----
+ testCallMethodWithLoopLimitThatMightBeModified
+ "A call to a method with loop with a loop limit that might be modified by the loop
+ body requires a loop limit variable."
+
+ "(SlangTest selector: #testCallMethodWithLoopLimitThatMightBeModified) debug"
+
+ | m1 sts lines |
+ sts := SlangTestSupportInterpreter inline: true.
+ m1 := (sts asCString: #callMethodWithLoopLimitThatMightBeModified)
+ copyReplaceAll: 'callMethodWithLoopLimitThatMightBeModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportPlugin inline: true.
+ m1 := (sts asCString: #callMethodWithLoopLimitThatMightBeModified)
+ copyReplaceAll: 'callMethodWithLoopLimitThatMightBeModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+
+ sts := SlangTestSupportSSIP inline: true.
+ m1 := (sts asCString: #callMethodWithLoopLimitThatMightBeModified)
+ copyReplaceAll: 'callMethodWithLoopLimitThatMightBeModified'
+ with: 'methodName'.
+ lines := m1 findTokens: String cr.
+ self should: (lines select: [:e | '*sqInt *LimiT*' match: e]) size = 1.
+ self should: (lines select: [:e | 'sqInt iLimiT;' = e withBlanksTrimmed]) size = 1.
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>callMethodEmbeddedWithSendInLoopLimit (in category 'loop limits') -----
+ callMethodEmbeddedWithSendInLoopLimit
+
+ <export: true>
+ 1 to: self methodWithIntegerResult do: [:i |
+ 1 to: self methodWithIntegerResult do: [:k | ]].
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>callMethodTwiceWithLoopLimitThatMightBeModified (in category 'loop limits') -----
+ callMethodTwiceWithLoopLimitThatMightBeModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>callMethodTwiceWithSendInLoopLimit (in category 'loop limits') -----
+ callMethodTwiceWithSendInLoopLimit
+
+ <export: true>
+ 1 to: self methodWithIntegerResult do: [:i | ].
+ 1 to: self methodWithIntegerResult do: [:i | ].
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>callMethodWithLoopLimitThatIsNotModified (in category 'loop limits') -----
+ callMethodWithLoopLimitThatIsNotModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatIsNotModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>callMethodWithLoopLimitThatMightBeModified (in category 'loop limits') -----
+ callMethodWithLoopLimitThatMightBeModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>methodWithIntegerResult (in category 'loop limits') -----
+ methodWithIntegerResult
+ "Translates to nonsense, but use this to illustrate the point"
+ ^(Random new next * 100) asInteger!
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
+ methodWithLoopLimitThatIsNotModified: arrayObj
+
+ 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>methodWithLoopLimitThatMightBeModified: (in category 'loop limits') -----
+ methodWithLoopLimitThatMightBeModified: arrayObj
+
+ 0 to: (self lengthOf: arrayObj) do:
+ [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>callMethodEmbeddedWithSendInLoopLimit (in category 'loop limits') -----
+ callMethodEmbeddedWithSendInLoopLimit
+
+ <export: true>
+ 1 to: self methodWithIntegerResult do: [:i |
+ 1 to: self methodWithIntegerResult do: [:k | ]].
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>callMethodTwiceWithLoopLimitThatMightBeModified (in category 'loop limits') -----
+ callMethodTwiceWithLoopLimitThatMightBeModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>callMethodTwiceWithSendInLoopLimit (in category 'loop limits') -----
+ callMethodTwiceWithSendInLoopLimit
+
+ <export: true>
+ 1 to: self methodWithIntegerResult do: [:i | ].
+ 1 to: self methodWithIntegerResult do: [:i | ].
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>callMethodWithLoopLimitThatIsNotModified (in category 'loop limits') -----
+ callMethodWithLoopLimitThatIsNotModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatIsNotModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>callMethodWithLoopLimitThatMightBeModified (in category 'loop limits') -----
+ callMethodWithLoopLimitThatMightBeModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>methodWithIntegerResult (in category 'loop limits') -----
+ methodWithIntegerResult
+ "Translates to nonsense, but use this to illustrate the point"
+ ^(Random new next * 100) asInteger!
Item was added:
+ ----- Method: SlangTestSupportPlugin>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
+ methodWithLoopLimitThatIsNotModified: arrayObj
+
+ 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
+ !
Item was added:
+ ----- Method: SlangTestSupportPlugin>>methodWithLoopLimitThatMightBeModified: (in category 'loop limits') -----
+ methodWithLoopLimitThatMightBeModified: arrayObj
+
+ 0 to: (self lengthOf: arrayObj) do:
+ [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nil]
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>callMethodEmbeddedWithSendInLoopLimit (in category 'loop limits') -----
+ callMethodEmbeddedWithSendInLoopLimit
+
+ <export: true>
+ 1 to: self methodWithIntegerResult do: [:i |
+ 1 to: self methodWithIntegerResult do: [:k | ]].
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>callMethodTwiceWithLoopLimitThatMightBeModified (in category 'loop limits') -----
+ callMethodTwiceWithLoopLimitThatMightBeModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>callMethodTwiceWithSendInLoopLimit (in category 'loop limits') -----
+ callMethodTwiceWithSendInLoopLimit
+
+ <export: true>
+ 1 to: self methodWithIntegerResult do: [:i | ].
+ 1 to: self methodWithIntegerResult do: [:i | ].
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>callMethodWithLoopLimitThatIsNotModified (in category 'loop limits') -----
+ callMethodWithLoopLimitThatIsNotModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatIsNotModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>callMethodWithLoopLimitThatMightBeModified (in category 'loop limits') -----
+ callMethodWithLoopLimitThatMightBeModified
+
+ <export: true>
+ | aVar |
+ aVar := 'foo'.
+ self methodWithLoopLimitThatMightBeModified: aVar.
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>methodWithIntegerResult (in category 'loop limits') -----
+ methodWithIntegerResult
+ ^127 + 5!
Item was added:
+ ----- Method: SlangTestSupportSSIP>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
+ methodWithLoopLimitThatIsNotModified: arrayObj
+
+ 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
+ !
Item was added:
+ ----- Method: SlangTestSupportSSIP>>methodWithLoopLimitThatMightBeModified: (in category 'loop limits') -----
+ methodWithLoopLimitThatMightBeModified: arrayObj
+
+ 0 to: (self lengthOf: arrayObj) do:
+ [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nil]
+ !
Item was changed:
----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
prepareMethodIn: aCodeGen
+ "Record sends of builtin operators, map sends of the special selector dispatchOn:in:
+ with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
+ Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:].
+ These must be top-level statements; they cannot appear in expressions.
+ As a hack also update the types of variables introduced to implement cascades correctly.
+ This has to be done at teh same time as this is done, so why not piggy back here?"
+ | replacements |.
+ cascadeVariableNumber ifNotNil:
+ [declarations keysAndValuesDo:
+ [:varName :decl|
+ decl isBlock ifTrue:
+ [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
+ locals add: varName.
+ self declarationAt: varName
+ put: (decl value: self value: aCodeGen), ' ', varName]]].
+ replacements := IdentityDictionary new.
+ aCodeGen
+ pushScope: declarations
+ while:
+ [parseTree nodesDo:
+ [:node|
+ node isSend ifTrue:
+ [(aCodeGen builtin: node selector)
+ ifTrue:
+ [node isBuiltinOperator: true.
+ "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
+ (node selector = #to:by:do:
+ and: [node args size = 4]) ifTrue:
+ [| limitExpr |
+ limitExpr := node args first.
+ (limitExpr anySatisfy:
+ [:subNode|
+ subNode isSend
+ and: [(aCodeGen builtin: subNode selector) not
+ and: [(subNode isStructSend: aCodeGen) not]]])
+ ifTrue: [ | limitVar |
+ limitVar := node args last name.
+ "n.b. Two loops in the same method may share the same variable
+ for loop limit, so add the variable declaration only if not already
+ declared by a previous loop. Assumes that the name of the loop
+ limit variable (e.g. 'iLimiT') is unlikely to have been used as an actual
+ instance variable elsewhere."
+ (locals includes: limitVar) ifFalse: [locals add: limitVar]]
+ ifFalse:
+ [node arguments: node args allButLast]]]
+ ifFalse:
+ [(CaseStatements includes: node selector) ifTrue:
+ [replacements at: node put: (self buildCaseStmt: node)].
+ (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
+ [replacements at: node put: (self buildSwitchStmt: node)]]].
+ ((node isAssignment or: [node isReturn])
+ and: [node expression isSwitch]) ifTrue:
+ [replacements at: node put: (self transformSwitchExpression: node)]]].
+ replacements isEmpty ifFalse:
+ [parseTree := parseTree replaceNodesIn: replacements]!
- "Record sends of builtin operators and replace sends of the special selector dispatchOn:in: with case statement nodes."
- "Note: Only replaces top-level sends of dispatchOn:in:. Case statements must be top-level statements; they cannot appear in expressions."
-
- | stmts stmt |
- parseTree nodesDo: [ :node |
- node isSend ifTrue: [
- "record sends of builtin operators"
- (aCodeGen builtin: node selector) ifTrue: [ node isBuiltinOperator: true ].
- ].
- node isStmtList ifTrue: [
- "replace dispatchOn:in: with case statement node"
- stmts := node statements.
- 1 to: stmts size do: [ :i |
- stmt := stmts at: i.
- (stmt isSend and: [CaseStatements includes: stmt selector]) ifTrue: [
- stmts at: i put: (self buildCaseStmt: stmt).
- ].
- ].
- ].
- ].!
Item was changed:
----- Method: TMethod>>preparePrimitivePrologue (in category 'primitive compilation') -----
preparePrimitivePrologue
"Add a prolog and postlog to a primitive method. The prolog copies any instance variables referenced by this primitive method into local variables. The postlog copies values of assigned-to variables back into the instance. The names of the new locals are added to the local variables list.
The declarations dictionary defines the types of any non-integer variables (locals, arguments, or instance variables). In particular, it may specify the types:
int * -- an array of 32-bit values (e.g., a BitMap)
short * -- an array of 16-bit values (e.g., a SoundBuffer)
char * -- an array of unsigned bytes (e.g., a String)
double -- a double precision floating point number (e.g., 3.14159)
Undeclared variables are taken to be integers and will be converted from Smalltalk to C ints."
"Current restrictions:
o method must not contain message sends
o method must not allocate objects
o method must not manipulate raw oops
o method cannot access class variables
o method can only return an integer"
| prolog postlog instVarsUsed varsAssignedTo instVarList primArgCount varName endsWithReturn aClass |
+ self assert: selector ~~ #setInterpreter:.
- selector == #setInterpreter: ifTrue:[self halt].
aClass := definingClass.
prolog := OrderedCollection new.
postlog := OrderedCollection new.
instVarsUsed := self freeVariableReferences asSet.
varsAssignedTo := self variablesAssignedTo asSet.
instVarList := aClass allInstVarNames.
primArgCount := args size.
"add receiver fetch and arg conversions to prolog"
prolog addAll: self fetchRcvrExpr.
1 to: args size do: [:argIndex |
varName := args at: argIndex.
prolog addAll:
(self argConversionExprFor: varName stackIndex: args size - argIndex)].
"add success check to postlog"
postlog addAll: self checkSuccessExpr.
"add instance variable fetches to prolog and instance variable stores to postlog"
1 to: instVarList size do: [:varIndex |
varName := instVarList at: varIndex.
(instVarsUsed includes: varName) ifTrue: [
locals add: varName.
prolog addAll: (self instVarGetExprFor: varName offset: varIndex - 1).
(varsAssignedTo includes: varName) ifTrue: [
postlog addAll: (self instVarPutExprFor: varName offset: varIndex - 1)]]].
prolog addAll: self checkSuccessExpr.
+ ((locals includes: 'rcvr') or: [(locals intersection: args) notEmpty]) ifTrue:
+ [self error: 'local name conflicts with instance variable name'].
+ locals add: 'rcvr'; addAll: args.
- locals addAllFirst: args.
- locals addFirst: 'rcvr'.
args := args class new.
- locals asSet size = locals size
- ifFalse: [self error: 'local name conflicts with instance variable name'].
endsWithReturn := self endsWithReturn.
self fixUpReturns: primArgCount postlog: postlog.
endsWithReturn
ifTrue: [parseTree setStatements: prolog, parseTree statements]
ifFalse: [
postlog addAll: (self popArgsExpr: primArgCount).
parseTree setStatements: prolog, parseTree statements, postlog].
!
Item was added:
+ ----- Method: TParseNode>>anySatisfy: (in category 'enumerating') -----
+ anySatisfy: aBlock
+ self nodesDo: [:n| (aBlock value: n) ifTrue: [^true]].
+ ^false!
Item was added:
+ ----- Method: TParseNode>>noneSatisfy: (in category 'enumerating') -----
+ noneSatisfy: aBlock
+ self nodesDo: [:n| (aBlock value: n) ifTrue: [^false]].
+ ^true!
Item was added:
+ ----- Method: TSendNode>>arguments: (in category 'private') -----
+ arguments: aSequence
+ arguments := aSequence!
Item was changed:
+ ----- Method: TSendNode>>printOn:level: (in category 'printing') -----
- ----- Method: TSendNode>>printOn:level: (in category 'testing') -----
printOn: aStream level: level
+ | possiblyParenthesize |
+ possiblyParenthesize :=
+ [:node :newLevel|
+ (node isSend
+ and: [node selector precedence >= 3]) ifTrue:
+ [aStream nextPut: $(].
+ node printOn: aStream level: newLevel.
+ (node isSend
+ and: [node selector precedence >= 3]) ifTrue:
+ [aStream nextPut: $)]].
+ possiblyParenthesize value: receiver value: level.
+ arguments size = 0 ifTrue:
+ [aStream space; nextPutAll: selector.
+ ^self].
+ selector keywords with: (arguments first: selector numArgs) do:
+ [:keyword :arg |
+ aStream space; nextPutAll: keyword; space.
+ possiblyParenthesize value: arg value: level + 1]!
- | keywords |
- receiver printOn: aStream level: level.
- arguments size = 0 ifTrue: [
- aStream space; nextPutAll: selector.
- ^self
- ].
- keywords := selector keywords.
- 1 to: keywords size do: [ :i |
- aStream space.
- aStream nextPutAll: (keywords at: i); space.
- (arguments at: i) printOn: aStream level: level + 1.
- ].!
Item was changed:
----- Method: VMMaker class>>versionString (in category 'version testing') -----
versionString
"VMMaker versionString"
+ ^'4.11.5'!
- ^'4.11.4'!
Item was changed:
----- Method: VMMakerTool class>>defaultUnixSpec (in category 'configurations') -----
defaultUnixSpec
"Typical VMMaker spec for a unix/linux target platform"
"VMMakerTool defaultUnixSpec"
^#(
#( "internal plugins"
#ADPCMCodecPlugin
#AsynchFilePlugin
#BMPReadWriterPlugin
#BalloonEnginePlugin
#BitBltSimulation
#CroquetPlugin
#DSAPlugin
#DeflatePlugin
#DropPlugin
#FFTPlugin
#FT2Plugin
#FilePlugin
#FloatArrayPlugin
#FloatMathPlugin
#GeniePlugin
#JPEGReadWriter2Plugin
#JPEGReaderPlugin
#JoystickTabletPlugin
#KlattSynthesizerPlugin
#LargeIntegersPlugin
#LocalePlugin
#MD5Plugin
#Matrix2x3Plugin
#MiscPrimitivePlugin
#RandPlugin
#RePlugin
#SHA256Plugin
#SecurityPlugin
#SerialPlugin
#SlangTestPlugin
#SlangTestSupportPlugin
#SocketPlugin
#SoundCodecPlugin
#SoundGenerationPlugin
#SoundPlugin
#StarSqueakPlugin
#SurfacePlugin
)
#( "external plugins"
#B3DAcceleratorPlugin
#B3DEnginePlugin
#ClipboardExtendedPlugin
#DBusPlugin
#FFIPlugin
#FileCopyPlugin
#GStreamerPlugin
#HostWindowPlugin
#KedamaPlugin
#KedamaPlugin2
#MIDIPlugin
#Mpeg3Plugin
#RomePlugin
#UUIDPlugin
#UnixAioPlugin
#UnixOSProcessPlugin
#XDisplayControlPlugin
#CameraPlugin
#ScratchPlugin
#UnicodePlugin
#WeDoPlugin
#SqueakSSLPlugin
- #PixelValuePeekPlugin
)
true "inline flag"
false "forBrowser flag"
'unix' "platform"
'src' "source directory for generated sources"
'platforms' "path to platform sources"
4 "unused, was bytesPerWord which is now a compile time definition"
true "unused, was flag for source directtory pathname is relative"
true "unused, was flag for platforms directory path is relative"
'Interpreter' "interpreter class name"
)!
More information about the Vm-dev
mailing list