[Vm-dev] VM Maker: VMMaker.oscog-eem.474.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 22 23:14:58 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.474.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.474
Author: eem
Time: 22 October 2013, 4:11:59.709 pm
UUID: 64efc673-34ea-49e3-b97a-9bab48706160
Ancestors: VMMaker.oscog-eem.473
Transform e ifNotNil: [:v|...] into v := e. v ifNotNil: [...] in TMethod
creation so as to enable the allocateOldSpaceChunkOfExactlyBytes:suchThat:
send in exactFitCompact to be inlined.
Add an <inline: true> pragma to said method to force it to be
inlined.
Add generateValueAsArgument:on:indent: to allow the
acceptanceBlock to be correctly expanded in the ifs in said method.
Fix swizzleObjStackAt: to answer the obj stack swizzled.
Fix TStmtList printing with arguments are nil.
=============== Diff against VMMaker.oscog-eem.473 ===============
Item was changed:
----- Method: BlockNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator equivalent of me"
| statementList |
statementList := OrderedCollection new.
+ statements do:
+ [:s | | newS |
+ newS := s asTranslatorNodeIn: aTMethod.
+ "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed"
+ newS isStmtList
+ ifTrue: [statementList addAll: newS statements]
+ ifFalse: [statementList add: newS]].
+ ^TStmtListNode new
+ setArguments: (arguments asArray collect: [:arg | arg key])
- statements
- do: [:s | | newS |
- newS := s asTranslatorNodeIn: aTMethod.
- newS isStmtList
- ifTrue: ["inline the statement list returned when a CascadeNode is
- translated "
- statementList addAll: newS statements]
- ifFalse: [statementList add: newS]].
- ^ TStmtListNode new
- setArguments: (arguments asArray
- collect: [:arg | arg key])
statements: statementList;
+ comment: comment!
- comment: comment!
Item was added:
+ ----- Method: CCodeGenerator>>generateValueAsArgument:on:indent: (in category 'C translation') -----
+ generateValueAsArgument: aTSendNode on: aStream indent: level
+ "Reduce [:formal ... :formalN| body ] value: actual ... value: actualN
+ to body with formals substituted for by actuals."
+ | substitution substitutionDict newLabels |
+ self assert: aTSendNode receiver isStmtList.
+ self assert: aTSendNode receiver args size = aTSendNode args size.
+ substitution := aTSendNode receiver copy.
+ substitution renameLabelsForInliningInto: currentMethod.
+ substitutionDict := Dictionary new: aTSendNode args size * 2.
+ aTSendNode receiver args with: aTSendNode args do:
+ [ :argName :exprNode |
+ substitutionDict at: argName put: exprNode].
+ substitution
+ bindVariablesIn: substitutionDict;
+ emitCCodeAsArgumentOn: aStream level: level generator: self.
+ newLabels := Set withAll: currentMethod labels.
+ substitution nodesDo:
+ [:node| node isLabel ifTrue: [node label ifNotNil: [:label| newLabels add: label]]].
+ "now add the new labels so that a subsequent inline of
+ the same block will be renamed with different labels."
+ currentMethod labels: newLabels!
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert32:on:indent:
#bitClear: #generateBitClear:on:indent:
#truncateTo: #generateTruncateTo:on:indent:
#rounded #generateRounded:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#noMask: #generateNoMask:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#wordSize #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
#subclassResponsibility #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
+
+ #value #generateValueAsArgument:on:indent:
+ #value: #generateValueAsArgument:on:indent:
+ #value:value: #generateValueAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
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 ifNotNilBlock |
- | 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:])
- ((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]].
args := (1 to: sel numArgs) collect:
+ [:i | (arguments at: i) asTranslatorNodeIn: aTMethod].
- [: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 == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue:
[sel := #ifFalse:. args := {args last}].
(sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue:
[sel := #ifTrue:. args := {args first}].
(sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue:
[sel := #ifTrue:. args := {args last}].
(sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue:
[sel := #ifTrue:. args := {args first}].
+ ((sel == #ifFalse: or: [sel == #or:])
- ((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)].
+ "For the benefit of later passes, e.g. value: inlining,
+ transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...],
+ which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]."
+ ((sel == #ifTrue: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]])
+ and: [receiver notNil
+ and: [receiver isAssignmentEqualsEqualsNil
+ and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue:
+ [ifNotNilBlock setArguments: #().
+ ^TStmtListNode new
+ setArguments: #()
+ statements:
+ { receiver receiver asTranslatorNodeIn: aTMethod.
+ TSendNode new
+ setSelector: sel
+ receiver: (TSendNode new
+ setSelector: #==
+ receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod)
+ arguments: {receiver arguments first asTranslatorNodeIn: aTMethod})
+ arguments: args }].
^TSendNode new
setSelector: sel
receiver: rcvrOrNil
arguments: args!
Item was added:
+ ----- Method: MessageNode>>isAssignmentEqualsEqualsNil (in category '*VMMaker-C translation') -----
+ isAssignmentEqualsEqualsNil
+ "Answer if the receiver if of the form (v := e) == nil, which underlies e ifNotNil: [:v|...]"
+ ^#== == (selector isSymbol ifTrue: [selector] ifFalse: [selector key])
+ and: [receiver notNil
+ and: [receiver isAssignmentNode
+ and: [(arguments first isJust: NodeNil)
+ or: [arguments first isVariableNode
+ and: [arguments first key = 'nil']]]]]!
Item was added:
+ ----- Method: ParseNode>>isAssignmentEqualsEqualsNil (in category '*VMMaker-C translation') -----
+ isAssignmentEqualsEqualsNil
+ ^false!
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart
lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
in: aCCodeGenerator.
aCCodeGenerator
var: #freeLists type: #'sqInt *';
var: #classTableBitmap type: #'unsigned char *';
+ var: #highestObjects type: #SpurContiguousObjStack;
var: #unscannedEphemerons type: #SpurContiguousObjStack.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') -----
allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock
"Answer a chunk of oldSpace from the free lists, if one of this size
is available, otherwise answer nil. N.B. the chunk is simply a pointer,
it has no valid header. The caller *must* fill in the header correctly."
| initialIndex node nodeBytes child |
+ <inline: true> "must inline for acceptanceBlock"
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
initialIndex := chunkBytes / self allocationUnit.
initialIndex < self numFreeLists ifTrue:
[(1 << initialIndex <= freeListsMask
and: [(node := freeLists at: initialIndex) ~= 0
and: [acceptanceBlock value: node]]) ifTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self unlinkFreeChunk: node atIndex: initialIndex].
^nil].
"Large chunk. Search the large chunk list.
Large chunk list organized as a tree, each node of which is a list of
chunks of the same size. Beneath the node are smaller and larger
blocks. When the search ends parent should hold the first chunk of
the same size as chunkBytes, or 0 if none."
node := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
[node := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
(node ~= 0 and: [acceptanceBlock value: node]) ifTrue:
[self assert: (self isValidFreeObject: node).
self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node].
node := child.
nodeBytes := childBytes.
child := 0] "break out of loop to remove interior node"
ifFalse:
[childBytes < chunkBytes
ifTrue: "walk down the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
"if no chunk, there was no exact fit"
(node ~= 0 and: [acceptanceBlock value: node]) ifFalse:
[^nil].
"self printFreeChunk: parent"
self assert: nodeBytes = chunkBytes.
self assert: (self bytesInObject: node) = chunkBytes.
"can't be a list; would have removed and returned it above."
self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0.
"no list; remove the interior node"
"N.B. This will fail when we try to remove the head node and there are still next links,
which is possible given acceptanceBlock but does not occur in current use."
self unlinkSolitaryFreeTreeNode: node.
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node!
Item was changed:
----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') -----
swizzleObjStackAt: objStackRootIndex
- <returnTypeC: #void>
"On load, swizzle the pointers in an obj stack. Answer the obj stack's oop."
| firstPage stackOrNil index field |
firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
stackOrNil = nilObj ifTrue:
[^stackOrNil].
[self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex.
"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4.
Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx"
index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
"swizzle fields including ObjStackNextx and leave field containing the next link."
[field := self fetchPointer: index ofObject: stackOrNil.
(self isImmediate: field) ifFalse:
[field := segmentManager swizzleObj: field.
self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field].
(index := index - 1) > ObjStackTopx] whileTrue.
(stackOrNil := field) ~= 0] whileTrue.
[stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage.
stackOrNil ~= 0] whileTrue:
[field := segmentManager swizzleObj: stackOrNil.
self storePointer: ObjStackFreex ofObjStack: firstPage withValue: field.
firstPage := stackOrNil].
+ self assert: (self isValidObjStackAt: objStackRootIndex).
+ ^self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj!
- self assert: (self isValidObjStackAt: objStackRootIndex)
- !
Item was changed:
----- Method: SpurNewSpaceSpace class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ self allInstVarNames do:
- self instVarNames do:
[:ivn| aBinaryBlock value: ivn value: #usqInt]!
Item was changed:
----- Method: TStmtListNode>>printOn:level: (in category 'printing') -----
printOn: aStream level: level
aStream nextPut: $[.
+ (arguments notNil and: [arguments notEmpty]) ifTrue:
+ [arguments do: [ :arg | aStream nextPutAll: ' :'; nextPutAll: arg].
+ aStream nextPutAll: ' | '].
- arguments size > 0 ifTrue: [
- arguments do: [ :arg | aStream nextPutAll: ' :', arg ].
- aStream nextPutAll: ' | '.
- ].
self printStatementsOn: aStream level: level.
+ aStream nextPut: $]!
- aStream nextPut: $].!
More information about the Vm-dev
mailing list