[Vm-dev] VM Maker: VMMaker.oscog-eem.701.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun May 4 06:29:12 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.701.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.701
Author: eem
Time: 3 May 2014, 11:25:08.887 pm
UUID: 92f5171c-4e3e-4113-bb82-05f92e8b7c82
Ancestors: VMMaker.oscog-eem.700
Spur:
Fix bug in generated C for pigCompact. If "free" is unsigned
then "free - self allocationUnit" is large when free is zero, so
move subtraction to addition on other side of the comparison.
Make sure all pointer comparisons in pigCompact are unsigned.
Add forwardUnchecked:to: and use it to avoid the unnecessary
store check in forwarding during compaction.
Correct the return type of bytesInObject: to sqInt.
Looking good. Snapshots are small at last.
Slang:
Fix indenting in while loops and sequential and and or exprs.
Use aStream tab: level instead of level timesRepeat:.
Collapse generateWhile[True|False]Loop:on:indent: onto a single
generateWhile:loop:on:indent:
=============== Diff against VMMaker.oscog-eem.700 ===============
Item was changed:
----- Method: CCodeGenerator>>emitCExpression:on: (in category 'C code generator') -----
emitCExpression: aParseNode on: aStream
"Emit C code for the expression described by the given parse node."
+ self emitCExpression: aParseNode on: aStream indent: 0!
- aParseNode isLeaf
- ifTrue:
- ["omit parens"
- aParseNode emitCCodeAsExpressionOn: aStream level: 0 generator: self]
- ifFalse:
- [aStream nextPut: $(.
- aParseNode emitCCodeAsExpressionOn: aStream level: 0 generator: self.
- aStream nextPut: $)]!
Item was added:
+ ----- Method: CCodeGenerator>>emitCExpression:on:indent: (in category 'C code generator') -----
+ emitCExpression: aParseNode on: aStream indent: level
+ "Emit C code for the expression described by the given parse node."
+
+ aParseNode isLeaf
+ ifTrue:
+ ["omit parens"
+ aParseNode emitCCodeAsExpressionOn: aStream level: level generator: self]
+ ifFalse:
+ [aStream nextPut: $(.
+ aParseNode emitCCodeAsExpressionOn: aStream level: level generator: self.
+ aStream nextPut: $)]!
Item was changed:
----- Method: CCodeGenerator>>generateSequentialAnd:on:indent: (in category 'C translation') -----
generateSequentialAnd: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ self emitCExpression: msgNode receiver on: aStream indent: level.
- self emitCExpression: msgNode receiver on: aStream.
aStream crtab: level; nextPutAll: ' && ('.
self emitCTestBlock: msgNode args first on: aStream indent: level.
aStream nextPut: $)!
Item was changed:
----- Method: CCodeGenerator>>generateSequentialOr:on:indent: (in category 'C translation') -----
generateSequentialOr: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
"Note: PP 2.3 compiler produces two arguments for or:, presumably
to help with inlining later. Taking the last agument should do the correct
thing even if your compiler is different."
+ self emitCExpression: msgNode receiver on: aStream indent: level.
- self emitCExpression: msgNode receiver on: aStream.
aStream crtab: level; nextPutAll: ' || ('.
self emitCTestBlock: msgNode args last on: aStream indent: level.
aStream nextPutAll: ')'!
Item was added:
+ ----- Method: CCodeGenerator>>generateWhile:loop:on:indent: (in category 'C translation') -----
+ generateWhile: boolean loop: msgNode on: aStream indent: level
+ "Generate while(cond) {stmtList} or while(!!(cond)) {stmtList}."
+
+ aStream nextPutAll: 'while ('.
+ boolean ifFalse: [aStream nextPut: $(].
+ self emitCTestBlock: msgNode receiver on: aStream indent: level.
+ boolean ifFalse: [aStream nextPut: $)].
+ aStream nextPutAll: ') {'; cr.
+ msgNode args first isNilStmtListNode ifFalse:
+ [msgNode args first emitCCodeOn: aStream level: level + 1 generator: self].
+ aStream tab: level.
+ aStream nextPut: $}!
Item was changed:
----- Method: CCodeGenerator>>generateWhileFalse:on:indent: (in category 'C translation') -----
generateWhileFalse: msgNode on: aStream indent: level
"Generate C code for a loop in one of the following formats, as appropriate:
while(!!(cond)) { stmtList }
do {stmtList} while(!!(cond))
while(1) {stmtListA; if (cond) break; stmtListB}"
msgNode receiver statements size <= 1
+ ifTrue: [^self generateWhile: false loop: msgNode on: aStream indent: level].
- ifTrue: [^self generateWhileFalseLoop: msgNode on: aStream indent: level].
msgNode args first isNilStmtListNode
ifTrue: [^self generateDoWhileFalse: msgNode on: aStream indent: level].
^self generateWhileForeverBreakIf: true loop: msgNode on: aStream indent: level!
Item was removed:
- ----- Method: CCodeGenerator>>generateWhileFalseLoop:on:indent: (in category 'C translation') -----
- generateWhileFalseLoop: msgNode on: aStream indent: level
- "Generate while(!!(cond)) {stmtList}."
-
- aStream nextPutAll: 'while (!!('.
- self emitCTestBlock: msgNode receiver on: aStream indent: level.
- aStream nextPutAll: ')) {'; cr.
- msgNode args first isNilStmtListNode ifFalse:
- [msgNode args first emitCCodeOn: aStream level: level + 1 generator: self].
- level timesRepeat: [ aStream tab ].
- aStream nextPutAll: '}'.!
Item was changed:
----- Method: CCodeGenerator>>generateWhileTrue:on:indent: (in category 'C translation') -----
generateWhileTrue: msgNode on: aStream indent: level
"Generate C code for a loop in one of the following formats, as appropriate:
while(cond) { stmtList }
do {stmtList} while(cond)
while(1) {stmtListA; if (!!(cond)) break; stmtListB}"
msgNode receiver statements size <= 1
+ ifTrue: [^self generateWhile: true loop: msgNode on: aStream indent: level].
- ifTrue: [^self generateWhileTrueLoop: msgNode on: aStream indent: level].
msgNode args first isNilStmtListNode
ifTrue: [^self generateDoWhileTrue: msgNode on: aStream indent: level].
^self generateWhileForeverBreakIf: false loop: msgNode on: aStream indent: level!
Item was removed:
- ----- Method: CCodeGenerator>>generateWhileTrueLoop:on:indent: (in category 'C translation') -----
- generateWhileTrueLoop: msgNode on: aStream indent: level
- "Generate while(cond) {stmtList}."
-
- aStream nextPutAll: 'while ('.
- self emitCTestBlock: msgNode receiver on: aStream indent: level.
- aStream nextPutAll: ') {'; cr.
- msgNode args first isNilStmtListNode ifFalse:
- [msgNode args first emitCCodeOn: aStream level: level + 1 generator: self].
- level timesRepeat: [ aStream tab ].
- aStream nextPutAll: '}'.!
Item was changed:
----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
bytesInObject: objOop
"Answer the total number of bytes in an object including header and possible overflow size header."
+ <returnTypeC: #usqInt>
- <returnTypeC: #usqLong>
| headerNumSlots numSlots |
headerNumSlots := self rawNumSlotsOf: objOop.
numSlots := headerNumSlots = self numSlotsMask
ifTrue: [self longAt: objOop - self baseHeaderSize]
ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
^numSlots + (numSlots bitAnd: 1) << self shiftForWord
+ (headerNumSlots = self numSlotsMask
ifTrue: [self baseHeaderSize + self baseHeaderSize]
ifFalse: [self baseHeaderSize])!
Item was changed:
----- Method: Spur64BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
bytesInObject: objOop
"Answer the total number of bytes in an object including header and possible overflow size header."
+ <returnTypeC: #usqInt>
- <returnTypeC: #usqLong>
| header headerNumSlots numSlots |
<var: 'header' type: #usqLong>
self flag: #endianness.
header := self longAt: objOop.
headerNumSlots := header >> self numSlotsFullShift.
numSlots := headerNumSlots = self numSlotsMask
ifTrue: [header bitAnd: 16rFFFFFFFFFFFFFF]
ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
^numSlots << self shiftForWord
+ (headerNumSlots = self numSlotsMask
ifTrue: [self baseHeaderSize + self baseHeaderSize]
ifFalse: [self baseHeaderSize])!
Item was changed:
----- Method: SpurMemoryManager>>checkNoForwardersBelowFirstFreeChunk (in category 'gc - global') -----
checkNoForwardersBelowFirstFreeChunk
self allOldSpaceEntitiesDo:
[:o|
+ (self oop: o isGreaterThanOrEqualTo: firstFreeChunk) ifTrue:
- o >= firstFreeChunk ifTrue:
[^true].
(self asserta: (self isForwarded: o) not) ifFalse:
[^false]].
^true!
Item was changed:
----- Method: SpurMemoryManager>>forwardSurvivor:to: (in category 'become implementation') -----
forwardSurvivor: obj1 to: obj2
+ "This version of forward:to: can use an unchecked store because it is known that obj1 is young."
- "This version of forward:to: can use an uncecked store because it is known that obj1 is young."
self assert: (self isInNewSpace: obj1).
self assert: ((self isInFutureSpace: obj2) or: [self isInOldSpace: obj2]).
self storePointerUnchecked: 0 ofObject: obj1 withValue: obj2.
self set: obj1 classIndexTo: self isForwardedObjectClassIndexPun formatTo: self forwardedFormat!
Item was added:
+ ----- Method: SpurMemoryManager>>forwardUnchecked:to: (in category 'become implementation') -----
+ forwardUnchecked: obj1 to: obj2
+ "This version of forward:to: can use an unchecked store because it is known that both obj1 and obj2 are old."
+ self assert: ((self isInOldSpace: obj1) and: [self isInOldSpace: obj2]).
+ self storePointerUnchecked: 0 ofObject: obj1 withValue: obj2.
+ self set: obj1 classIndexTo: self isForwardedObjectClassIndexPun formatTo: self forwardedFormat!
Item was changed:
----- Method: SpurMemoryManager>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') -----
moveARunOfObjectsStartingAt: startAddress upTo: limit
"Move the sequence of movable objects starting at startAddress. Answer the start
of the next sequence of movable objects after a possible run of unmovable objects,
or the limit, if there are no more movable objects, or 0 if no more compaction can be
done. Compaction is done when the search through the freeList has reached the
address from which objects are being moved from.
There are two broad cases to be dealt with here. One is a run of smallish objects
that can easily be moved into free chunks. The other is a large object that is unlikely
to fit in the typical free chunk. This second pig needs careful handling; it needs to be
moved to the lowest place it will fit and not cause the scan to skip lots of smaller
free chunks looking in vain for somewhere to put it."
+ <var: #startAddress type: #usqInt>
+ <var: #limit type: #usqInt>
+ <inline: false>
| here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
+ <var: #here type: #usqInt>
+ <var: #there type: #usqInt>
+ <var: #nextFree type: #usqInt>
+ <var: #endOfFree type: #usqInt>
+ <var: #destination type: #usqInt>
+ <var: #maxFreeChunk type: #usqInt>
here := startAddress.
hereObj := self objectStartingAt: startAddress.
hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
prevPrevFreeChunk := prevFreeChunk := 0.
thisFreeChunk := maxFreeChunk := firstFreeChunk.
[thisFreeChunk ~= 0] whileTrue:
[| freeBytes endOfFree nextFree destination there moved |
"skip any initial immobile objects"
[(self isMobileObjectHeader: hereObjHeader)] whileFalse:
[here := self addressAfter: hereObj.
here >= limit ifTrue:
[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]].
hereObj := self objectStartingAt: here.
hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
"grab a free chunk, and the following one, because we want to overwrite this one."
self assert: ((self isFreeObject: firstFreeChunk) and: [self isFreeObject: thisFreeChunk]).
freeBytes := self bytesInObject: thisFreeChunk.
nextFree := self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk.
destination := self startOfObject: thisFreeChunk.
endOfFree := destination + freeBytes.
moved := false.
maxFreeChunk := maxFreeChunk max: nextFree.
self assert: (nextFree = 0 or: [self isFreeObject: nextFree]).
"move as many objects as will fit in freeBytes..."
[there := self addressAfter: hereObj.
+ "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when freeBytes = 0"
(self isMobileObjectHeader: hereObjHeader)
+ and: [freeBytes > (there - here + self allocationUnit)
+ or: [freeBytes = (there - here)]]] whileTrue:
- and: [there - here < (freeBytes - self allocationUnit)
- or: [there - here = freeBytes]]] whileTrue:
[moved := true.
self mem: destination cp: here y: there - here.
+ self forwardUnchecked: hereObj to: destination + (hereObj - here).
- self forward: hereObj to: destination + (hereObj - here).
destination := destination + (there - here).
freeBytes := freeBytes - (there - here).
hereObj := self objectStartingAt: there.
here := there.
hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
moved
ifTrue: "we did overwrite it; we need to repair the free list"
[| nextNextFree |
nextFree ~= 0 ifTrue:
[nextNextFree := self nextInSortedFreeListLink: nextFree given: thisFreeChunk.
self assert: (self isFreeObject: nextFree)].
(destination > thisFreeChunk "if false couldn't move anything"
and: [destination < endOfFree]) "if false, filled entire free chunk"
ifTrue:
[thisFreeChunk := self initFreeChunkWithBytes: endOfFree - destination at: destination.
self inSortedFreeListLink: prevFreeChunk to: thisFreeChunk given: prevPrevFreeChunk.
self inSortedFreeListLink: thisFreeChunk to: nextFree given: prevFreeChunk.
nextFree ~= 0 ifTrue:
[self inSortedFreeListLink: nextFree to: nextNextFree given: thisFreeChunk].
prevPrevFreeChunk := prevFreeChunk.
prevFreeChunk := thisFreeChunk.
thisFreeChunk := nextFree]
ifFalse:
[self inSortedFreeListLink: prevFreeChunk to: nextFree given: prevPrevFreeChunk.
nextFree ~= 0 ifTrue:
[self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk].
thisFreeChunk := nextFree]]
ifFalse: "out of space (or immobile object); move on up the free list..."
[prevPrevFreeChunk := prevFreeChunk.
prevFreeChunk := thisFreeChunk.
thisFreeChunk := nextFree].
(self isMobileObjectHeader: hereObjHeader) ifFalse:
[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]].
"Was the loop stopped by a pig? If so, try and find space for it"
there - here >= (self averageObjectSizeInBytes * 8) ifTrue: "256b in 32 bit, 512b in 64 bit"
[| usedChunk |
usedChunk := self tryToMovePig: hereObj at: here end: there.
"if it couldn't be moved we need to advance, so always
set here to there whether the pig was moved or not."
hereObj := self objectStartingAt: there.
here := there.
hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
"In general it's a bad idea to reset the enumeration; it leads to N^2 behaviour
when encountering pigs. But if the move affected the enumeration this is
simpler than resetting the list pointers."
(usedChunk = prevPrevFreeChunk
or: [usedChunk = prevFreeChunk
or: [usedChunk = thisFreeChunk]]) ifTrue:
["reset the scan for free space back to the start of the list"
prevPrevFreeChunk := prevFreeChunk := 0.
thisFreeChunk := firstFreeChunk]].
((here > startAddress and: [there >= limit])
or: [maxFreeChunk >= startAddress]) ifTrue:
+ [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].
+ ^here!
- [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].!
Item was changed:
----- Method: SpurMemoryManager>>noForwardersBelowFirstFreeChunk (in category 'gc - global') -----
noForwardersBelowFirstFreeChunk
self allOldSpaceEntitiesDo:
[:o|
+ (self oop: o isGreaterThanOrEqualTo: firstFreeChunk) ifTrue:
- o >= firstFreeChunk ifTrue:
[^true].
(self isForwarded: o) ifTrue:
[^false]].
^true!
Item was changed:
----- Method: SpurMemoryManager>>pigCompact (in category 'compaction') -----
pigCompact
"Traverse the sorted free list, moving objects from the high-end of
memory to the free objects in the low end of memory. Return when
the address at which objects are being copiecd to meets the address
from which objects are being copied from."
self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'pig compacting...'; flush].
self sortedFreeListPairwiseReverseDo:
[:low :high| | scanAddress |
self cCode: '' inSmalltalk: [coInterpreter transcript nextPut: $.; flush].
scanAddress := self addressAfter: low.
+ [self oop: scanAddress isLessThan: high] whileTrue:
- [scanAddress < high] whileTrue:
[scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high.
scanAddress = 0 ifTrue:
[^self]]].
self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]!
Item was changed:
----- Method: SpurMemoryManager>>tryToMovePig:at:end: (in category 'compaction') -----
tryToMovePig: pigObj at: pigStart end: pigEnd
"Try to move a pig (a largish object) to a free chunk in low memory.
Answer the freeChunk that was used to house the moved pig, or
0 if no free chunk could be found."
| freeChunk prevFree prevPrevFree pigBytes nextNext |
prevPrevFree := prevFree := 0.
freeChunk := firstFreeChunk.
pigBytes := pigEnd - pigStart.
[freeChunk ~= 0 and: [freeChunk < pigObj]] whileTrue:
[| next dest chunkBytes newChunk |
next := self nextInSortedFreeListLink: freeChunk given: prevFree.
dest := self startOfObject: freeChunk.
chunkBytes := (self addressAfter: freeChunk) - dest.
+ "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when chunkBytes = 0"
(chunkBytes = pigBytes
+ or: [chunkBytes > (pigBytes + self allocationUnit)]) ifTrue:
- or: [chunkBytes - self allocationUnit > pigBytes]) ifTrue:
[self mem: dest cp: pigStart y: pigBytes.
+ self forwardUnchecked: pigObj to: dest + (pigObj - pigStart).
- self forward: pigObj to: dest + (pigObj - pigStart).
next ~= 0 ifTrue:
[nextNext := self nextInSortedFreeListLink: next given: freeChunk].
"now either shorten the chunk, or remove it, adjusting the links to keep the list sorted."
pigBytes < chunkBytes "if false, filled entire free chunk"
ifTrue:
[newChunk := self initFreeChunkWithBytes: chunkBytes - pigBytes at: dest + pigBytes.
self inSortedFreeListLink: prevFree to: newChunk given: prevPrevFree.
self inSortedFreeListLink: newChunk to: next given: prevFree.
next ~= 0 ifTrue:
[self inSortedFreeListLink: next to: nextNext given: newChunk]]
ifFalse:
[self inSortedFreeListLink: prevFree to: next given: prevPrevFree.
next ~= 0 ifTrue:
[self inSortedFreeListLink: next to: nextNext given: prevFree]].
"self checkTraversableSortedFreeList".
^freeChunk].
prevPrevFree := prevFree.
prevFree := freeChunk.
freeChunk := next].
^0!
More information about the Vm-dev
mailing list