[Vm-dev] VM Maker: VMMaker.oscog-eem.735.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu May 29 00:48:53 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.735.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.735
Author: eem
Time: 28 May 2014, 5:46:02.34 pm
UUID: ee13367a-8346-4ce8-a124-276cba680fc1
Ancestors: VMMaker.oscog-eem.734
Spur:
Fix management of lastFreeChunk during compaction
(in sweepToCoallesceFreeSpaceForPigCompactFrom: and
freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact).
lastFreeChunk's link was not being correctly terminated.
Add asserts to chunk freers to check for free chunks
overlapping, which caught the compaction bug.
Make sure that endOfMemory is immediately below the
last bridge. This is where it was set when adding a new
segment, but on loading a snapshot it was mispositioned
at the end of the last bridge. Add a check to
checkSegments, and use it in a few more places.
Eliminate bogus assert in sortedFreeListPairwiseReverseDo:.
If free gets used then lastFreeChunk won't point to it any
more.
Nuke obsolete method (from old non-repeating compact).
Cogit:
Correct link register usage in various places. e.g.
enilopmarts, checkForInterrupts trampoline. But especially,
correct link register usage in the return sequence
generators. Since Tim and I agree that RetN: returns to the
LinkReg, and no longer pops the return address from the
stack, genUpArrowReturn and genReturnTopFromBlock
must explicitly pop the saved return address into LinkReg
before RetN:. That means that all the RetN:'s in machine
code primitives will do the right thing, allowing these to
avoid pushing LinkReg on entry.
Simulator/Frame print:
fix a typo, recategorize, add an accessor for assertVEPAES.
=============== Diff against VMMaker.oscog-eem.734 ===============
Item was changed:
----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
<api>
| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
<var: #rcvrAddress type: #'char *'>
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #homeMethod type: #'CogMethod *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
(self isMachineCodeFrame: theFP)
ifTrue:
[| cogMethod homeMethod |
cogMethod := self mframeCogMethod: theFP.
homeMethod := self mframeHomeMethod: theFP.
theMethod := homeMethod asInteger.
theMethodEnd := homeMethod asInteger + homeMethod blockSize.
numArgs := cogMethod cmNumArgs.
numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
ifFalse:
[theMethod := self frameMethodObject: theFP.
theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
numArgs := self iframeNumArgs: theFP.
numTemps := self tempCountOf: theMethod].
(self frameIsBlockActivation: theFP) ifTrue:
[| rcvrOrClosure |
"No BlockLocalTempCounter in the Cogit's C code, so quick hack is to use numCopied + numArgs"
rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
((objectMemory isNonImmediate: rcvrOrClosure)
and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
ifFalse: [numTemps := numArgs]].
self shortPrintFrame: theFP.
(self isBaseFrame: theFP) ifTrue:
[self printFrameOop: '(caller ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * BytesPerWord).
self printFrameOop: '(saved ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * BytesPerWord)].
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * BytesPerWord).
numArgs to: 1 by: -1 do:
[:i|
self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * BytesPerWord)].
self printFrameThing: 'caller ip'
at: theFP + FoxCallerSavedIP
extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue:
+ ['ceReturnToInterpreter']).
- ['ceReturnToInterptreter']).
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameMethodFor: theFP.
(self isMachineCodeFrame: theFP) ifTrue:
[self printFrameFlagsForFP: theFP].
self printFrameOop: 'context' at: theFP + FoxThisContext.
(self isMachineCodeFrame: theFP) ifFalse:
[self printFrameFlagsForFP: theFP].
(self isMachineCodeFrame: theFP)
ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
ifFalse:
[self printFrameThing: 'saved ip'
at: theFP + FoxIFSavedIP
extra: ((self iframeSavedIP: theFP) = 0
ifTrue: [0]
ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - BaseHeaderSize]).
rcvrAddress := theFP + FoxIFReceiver].
self printFrameOop: 'receiver' at: rcvrAddress.
topThing := stackPages longAt: theSP.
(topThing between: theMethod and: theMethodEnd)
ifTrue:
[rcvrAddress - BytesPerWord to: theSP + BytesPerWord by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
ifTrue: ['temp/stck']
ifFalse: ['stck'])
at: addr]].
self printFrameThing: 'frame ip'
at: theSP
extra: ((self isMachineCodeFrame: theFP)
ifTrue: [topThing - theMethod]
ifFalse: [topThing - theMethod + 2 - BaseHeaderSize])]
ifFalse:
[rcvrAddress - BytesPerWord to: theSP by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
ifTrue: ['temp/stck']
ifFalse: ['stck'])
at: addr]]]!
Item was changed:
----- Method: Cogit>>genCheckForInterruptsTrampoline (in category 'initialization') -----
genCheckForInterruptsTrampoline
opcodeIndex := 0.
+ backEnd hasLinkRegister
+ ifTrue:
+ [self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress]
+ ifFalse:
+ [self PopR: TempReg. "instruction pointer"
+ self MoveR: TempReg Aw: coInterpreter instructionPointerAddress].
- self PopR: TempReg. "instruction pointer"
- self MoveR: TempReg Aw: coInterpreter instructionPointerAddress.
^self genTrampolineFor: #ceCheckForInterrupts
called: 'ceCheckForInterruptsTrampoline'
callJumpBar: true
numArgs: 0
arg: nil
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>genEnilopmartFor:and:and:called: (in category 'initialization') -----
genEnilopmartFor: regArg1 and: regArg2 and: regArg3 called: trampolineName
"An enilopmart (the reverse of a trampoline) is a piece of code that makes
the system-call-like transition from the C runtime into generated machine
code. The desired arguments and entry-point are pushed on a stackPage's
stack. The enilopmart pops off the values to be loaded into registers and
then executes a return instruction to pop off the entry-point and jump to it."
<returnTypeC: 'void (*genEnilopmartForandandcalled(sqInt regArg1, sqInt regArg2, sqInt regArg3, char *trampolineName))(void)'>
| size endAddress enilopmart |
opcodeIndex := 0.
backEnd genLoadStackPointers.
self PopR: regArg3.
self PopR: regArg2.
self PopR: regArg1.
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: 0.
self computeMaximumSizes.
size := self generateInstructionsAt: methodZoneBase.
endAddress := self outputInstructionsAt: methodZoneBase.
self assert: methodZoneBase + size = endAddress.
enilopmart := methodZoneBase.
methodZoneBase := self alignUptoRoutineBoundary: endAddress.
backEnd nopsFrom: endAddress to: methodZoneBase - 1.
self recordGeneratedRunTime: trampolineName address: enilopmart.
^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
Item was changed:
----- Method: Cogit>>genEnilopmartFor:and:called: (in category 'initialization') -----
genEnilopmartFor: regArg1 and: regArg2 called: trampolineName
"An enilopmart (the reverse of a trampoline) is a piece of code that makes
the system-call-like transition from the C runtime into generated machine
code. The desired arguments and entry-point are pushed on a stackPage's
stack. The enilopmart pops off the values to be loaded into registers and
then executes a return instruction to pop off the entry-point and jump to it."
<returnTypeC: 'void (*genEnilopmartForandcalled(sqInt regArg1, sqInt regArg2, char *trampolineName))(void)'>
| size endAddress enilopmart |
opcodeIndex := 0.
backEnd genLoadStackPointers.
self PopR: regArg2.
self PopR: regArg1.
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: 0.
self computeMaximumSizes.
size := self generateInstructionsAt: methodZoneBase.
endAddress := self outputInstructionsAt: methodZoneBase.
self assert: methodZoneBase + size = endAddress.
enilopmart := methodZoneBase.
methodZoneBase := self alignUptoRoutineBoundary: endAddress.
backEnd nopsFrom: endAddress to: methodZoneBase - 1.
self recordGeneratedRunTime: trampolineName address: enilopmart.
^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
Item was changed:
----- Method: Cogit>>genEnilopmartFor:called: (in category 'initialization') -----
genEnilopmartFor: regArg called: trampolineName
"An enilopmart (the reverse of a trampoline) is a piece of code that makes
the system-call-like transition from the C runtime into generated machine
code. The desired arguments and entry-point are pushed on a stackPage's
stack. The enilopmart pops off the values to be loaded into registers and
then executes a return instruction to pop off the entry-point and jump to it."
<returnTypeC: 'void (*genEnilopmartForcalled(sqInt regArg, char *trampolineName))(void)'>
| size endAddress enilopmart |
opcodeIndex := 0.
backEnd genLoadStackPointers.
self PopR: regArg.
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: 0.
self computeMaximumSizes.
size := self generateInstructionsAt: methodZoneBase.
endAddress := self outputInstructionsAt: methodZoneBase.
self assert: methodZoneBase + size = endAddress.
enilopmart := methodZoneBase.
methodZoneBase := self alignUptoRoutineBoundary: endAddress.
backEnd nopsFrom: endAddress to: methodZoneBase - 1.
self recordGeneratedRunTime: trampolineName address: enilopmart.
^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
Item was changed:
----- Method: Cogit>>genExternalizePointersForPrimitiveCall (in category 'trampoline support') -----
genExternalizePointersForPrimitiveCall
+ backEnd hasLinkRegister
+ ifTrue: [self PushR: LinkReg]
+ ifFalse: [self MoveMw: 0 r: SPReg R: ClassReg].
- self MoveMw: 0 r: SPReg R: ClassReg.
self MoveR: FPReg Aw: coInterpreter framePointerAddress.
"Set coInterpreter stackPointer to the topmost argument, skipping the return address."
self LoadEffectiveAddressMw: BytesPerWord r: SPReg R: TempReg.
+ backEnd hasLinkRegister
+ ifTrue: [self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress]
+ ifFalse: [self MoveR: ClassReg Aw: coInterpreter instructionPointerAddress].
- self MoveR: ClassReg Aw: coInterpreter instructionPointerAddress.
self MoveR: TempReg Aw: coInterpreter stackPointerAddress.
^0!
Item was changed:
----- Method: Cogit>>genNonLocalReturnTrampoline (in category 'initialization') -----
genNonLocalReturnTrampoline
opcodeIndex := 0.
+ backEnd hasLinkRegister
+ ifTrue:
+ [self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress]
+ ifFalse:
+ [self PopR: TempReg. "instruction pointer"
+ self MoveR: TempReg Aw: coInterpreter instructionPointerAddress].
- self PopR: TempReg. "instruction pointer"
- self MoveR: TempReg Aw: coInterpreter instructionPointerAddress.
^self genTrampolineFor: #ceNonLocalReturn:
called: 'ceNonLocalReturnTrampoline'
callJumpBar: true
numArgs: 1
arg: ReceiverResultReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: SimpleStackBasedCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
genReturnTopFromBlock
self assert: inBlock.
self flag: 'currently caller pushes result'.
self PopR: ReceiverResultReg.
needsFrame ifTrue:
[self MoveR: FPReg R: SPReg.
self PopR: FPReg].
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genUpArrowReturn (in category 'bytecode generators') -----
genUpArrowReturn
"Generate a method return from within a method or a block.
Frameless method activation looks like
receiver
args
sp-> ret pc.
Return pops receiver and arguments off the stack. Callee pushes the result."
self flag: 'currently caller pushes result'.
inBlock ifTrue:
[self assert: needsFrame.
self annotateBytecode: (self CallRT: ceNonLocalReturnTrampoline).
^0].
needsFrame ifTrue:
[self MoveR: FPReg R: SPReg.
self PopR: FPReg].
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
^0!
Item was changed:
----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') -----
addFreeSubTree: freeTree
"Add a freeChunk sub tree back into the large free chunk tree.
This is for allocateOldSpaceChunkOf[Exactly]Bytes:[suchThat:]."
| bytesInArg treeNode bytesInNode subNode |
"N.B. *can't* use numSlotsOfAny: because of rounding up of odd slots
and/or step in size at 1032 bytes in 32-bits or 2048 bytes in 64-bits."
self assert: (self isFreeObject: freeTree).
bytesInArg := self bytesInObject: freeTree.
self assert: bytesInArg >= (self numFreeLists * self allocationUnit).
treeNode := freeLists at: 0.
self assert: treeNode ~= 0.
[bytesInNode := self bytesInObject: treeNode.
+ self assert: ((self oop: freeTree + bytesInArg isLessThan: treeNode)
+ or: [self oop: freeTree isGreaterThanOrEqualTo: treeNode + bytesInNode]).
self assert: bytesInNode >= (self numFreeLists * self allocationUnit).
self assert: bytesInArg ~= bytesInNode.
bytesInNode > bytesInArg
ifTrue:
[subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree.
self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]]
ifFalse:
[subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree.
self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]].
treeNode := subNode] repeat!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
addToFreeTree: freeChunk bytes: chunkBytes
"Add freeChunk to the large free chunk tree.
For the benefit of sortedFreeObject:, answer the treeNode it is added
to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
| childBytes parent child |
self assert: (self isFreeObject: freeChunk).
self assert: chunkBytes = (self bytesInObject: freeChunk).
self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
self
storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
"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."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[childBytes := self bytesInObject: child.
+ self assert: ((self oop: freeChunk + chunkBytes isLessThan: child)
+ or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes]).
childBytes = chunkBytes ifTrue: "size match; add to list at node."
[self storePointer: self freeChunkNextIndex
ofFreeChunk: freeChunk
withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: freeChunk.
^child].
"walk down the tree"
parent := child.
child := self fetchPointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: child].
parent = 0 ifTrue:
[self assert: (freeLists at: 0) = 0.
freeLists at: 0 put: freeChunk.
freeListsMask := freeListsMask bitOr: 1.
^0].
self assert: (freeListsMask anyMask: 1).
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: freeChunk.
^0!
Item was changed:
----- Method: SpurMemoryManager>>compact (in category 'compaction') -----
compact
"We'd like to use exact fit followed by best or first fit, but it doesn't work
well enough in practice. So use pig compact. Fill large free objects starting
from low memory with objects taken from the end of memory."
<inline: false>
statCompactPassCount := statCompactPassCount + 1.
self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
1 to: 3 do:
[:i|
self pigCompact.
self eliminateAndFreeForwardersForPigCompact].
+
+ "The free lists are zeroed in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
+ They should still be zero here"
+ self assert: self freeListHeadsEmpty.
self rebuildFreeListsForPigCompact!
Item was added:
+ ----- Method: SpurMemoryManager>>freeListHeadsEmpty (in category 'free space') -----
+ freeListHeadsEmpty
+ 0 to: self numFreeLists - 1 do:
+ [:i| (freeLists at: i) ~= 0 ifTrue: [^false]].
+ ^true!
Item was changed:
----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') -----
freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
Doubly-link the free chunks in address order through the freeChunkNextIndex field using the
xor trick to use only one field, see e.g.
The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18
http://en.wikipedia.org/wiki/XOR_linked_list.
Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk.
Let the segmentManager mark which segments contain pinned objects via notePinned:."
| prevPrevFree prevFree |
<inline: false>
self checkFreeSpace.
scavenger forgetUnmarkedRememberedObjects.
self doScavenge: MarkOnTenure.
segmentManager prepareForGlobalSweep."for notePinned:"
"throw away the list heads, including the tree."
self resetFreeListHeads.
firstFreeChunk := prevPrevFree := prevFree := 0.
self allOldSpaceEntitiesForCoalescingFrom: self firstObject do:
[:o|
self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
(self isMarked: o)
ifTrue: "forwarders should have been followed in markAndTrace:"
[self assert: (self isForwarded: o) not.
self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
(self isPinned: o) ifTrue:
[segmentManager notePinned: o]]
ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
[| here |
self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
here := self coallesceFreeChunk: o.
self setObjectFree: here.
self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := here]].
prevFree ~= firstFreeChunk ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: prevFree
withValue: prevPrevFree].
lastFreeChunk := prevFree.
+ self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
+ self checkTraversableSortedFreeList!
- self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]!
Item was changed:
----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
growOldSpaceByAtLeast: minAmmount
"Attempt to grow memory by at least minAmmount.
Answer the size of the new segment, or nil if the attempt failed."
| ammount |
<var: #segInfo type: #'SpurSegmentInfo *'>
"statGrowMemory counts attempts, not successes."
statGrowMemory := statGrowMemory + 1.
"we need to include overhead for a new object header plus the segment bridge."
ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize).
"round up to the nearest power of two."
ammount := 1 << (ammount - 1) highBit.
"and grow by at least growHeadroom."
ammount := ammount max: growHeadroom.
^(segmentManager addSegmentOfSize: ammount) ifNotNil:
[:segInfo|
self assimilateNewSegment: segInfo.
"and add the new free chunk to the free list; done here
instead of in assimilateNewSegment: for the assert"
self addFreeChunkWithBytes: segInfo segSize - self bridgeSize at: segInfo segStart.
self assert: (self addressAfter: (self objectStartingAt: segInfo segStart))
= (segInfo segLimit - self bridgeSize).
self checkFreeSpace.
+ self checkSegments.
segInfo segSize]!
Item was changed:
----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
initializeOldSpaceFirstFree: startOfFreeOldSpace
<var: 'startOfFreeOldSpace' type: #usqLong>
| limit freeOldStart freeChunk |
<var: 'limit' type: #usqLong>
<var: 'freeOldStart' type: #usqLong>
limit := endOfMemory - self bridgeSize.
limit > startOfFreeOldSpace ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + (limit - startOfFreeOldSpace).
freeOldStart := startOfFreeOldSpace.
self wordSize > 4 ifTrue:
[[limit - freeOldStart >= (1 << 32)] whileTrue:
[freeChunk := self freeChunkWithBytes: (1 << 32) at: freeOldStart.
freeOldStart := freeOldStart + (1 << 32).
self assert: freeOldStart = (self addressAfter: freeChunk)]].
freeOldStart < limit ifTrue:
[freeChunk := self freeChunkWithBytes: limit - freeOldStart at: freeOldStart.
self assert: (self addressAfter: freeChunk) = limit]].
+ endOfMemory := endOfMemory - self bridgeSize.
freeOldSpaceStart := endOfMemory.
self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>rebuildFreeListsForPigCompact (in category 'compaction') -----
rebuildFreeListsForPigCompact
"Rebuild the free lists from the doubly-linked free list."
+ <inline: false>
+ self checkTraversableSortedFreeList.
totalFreeOldSpace := 0.
self sortedFreeListDo:
[:freeObj| | start bytes |
bytes := (self bytesInObject: freeObj).
start := self startOfObject: freeObj.
self addFreeChunkWithBytes: bytes at: start].
self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>sortedFreeListPairwiseReverseDo: (in category 'compaction') -----
sortedFreeListPairwiseReverseDo: aBinaryBlock
"Evaluate aBinaryBlock with adjacent entries in the free list, from
high address to low address. The second argument is in fact the
start of the next free chunk, not the free chunk itself. Use
endOfMemory - bridgeSize as the second argument in the first evaluation."
| free prevFree prevPrevFree |
<inline: true>
free := lastFreeChunk.
prevPrevFree := prevFree := 0.
[free ~= 0] whileTrue:
[aBinaryBlock value: free value: (prevFree = 0
ifTrue: [endOfMemory - self bridgeSize]
ifFalse: [self startOfObject: prevFree]).
"post evaluation of aBinaryBlock the value of free may be invalid
because moveARunOfObjectsStartingAt:upTo: may have filled it.
So reconstruct the position in the enumeration."
prevFree = 0
ifTrue:
[self assert: free = lastFreeChunk.
prevFree := lastFreeChunk.
free := self nextInSortedFreeListLink: lastFreeChunk given: 0]
ifFalse:
[self assert: (self isFreeObject: prevFree).
prevPrevFree = 0
ifTrue:
+ [prevPrevFree := lastFreeChunk.
- [self assert: free = (self nextInSortedFreeListLink: lastFreeChunk given: 0).
- prevPrevFree := lastFreeChunk.
prevFree := self nextInSortedFreeListLink: lastFreeChunk given: 0]
ifFalse:
[self assert: (self isFreeObject: prevPrevFree).
free := self nextInSortedFreeListLink: prevFree given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := free].
+ free := self nextInSortedFreeListLink: prevFree given: prevPrevFree]]!
- free := self nextInSortedFreeListLink: prevFree given: prevPrevFree]]
-
- "| labels |
- labels := Dictionary new.
- labels
- at: prevPrevFree put: 'ppf';
- at: prevFree put: 'pf';
- at: free put: 'f';
- at: nextFree put: 'f'.
- self sortedFreeListPairwiseReverseDo: [:a :b|
- Transcript cr; print: a; space.
- (labels at: a ifAbsent: []) ifNotNil: [:l| Transcript nextPutAll: l].
- Transcript flush]"!
Item was removed:
- ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompactFrom: (in category 'compaction') -----
- sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompactFrom: lowestForwarder
- "Coallesce free chunks and forwarders and rebuild the free list."
- | lowest firstFree firstFreeStart lastFree |
- lowest := (lowestForwarder = 0 ifTrue: [endOfMemory] ifFalse: [lowestForwarder])
- min: (firstFreeChunk = 0 ifTrue: [endOfMemory] ifFalse: [firstFreeChunk]).
- firstFree := totalFreeOldSpace := 0.
- self allOldSpaceEntitiesForCoalescingFrom: lowest do:
- [:o|
- ((self isFreeObject: o) or: [self isForwarded: o])
- ifTrue:
- [firstFree = 0 ifTrue:
- [firstFree := o.
- firstFreeStart := self startOfObject: o].
- lastFree := o]
- ifFalse:
- [firstFree ~= 0 ifTrue:
- [| bytes |
- bytes := (self addressAfter: lastFree) - firstFreeStart.
- self addFreeChunkWithBytes: bytes at: firstFreeStart].
- firstFree := 0]].
- firstFree ~= 0 ifTrue:
- [| bytes |
- bytes := (self addressAfter: lastFree) - firstFreeStart.
- self addFreeChunkWithBytes: bytes at: firstFreeStart].
- firstFreeChunk := lastFreeChunk := 0!
Item was changed:
----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceForPigCompactFrom: (in category 'compaction') -----
sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder
"Coallesce free chunks and forwarders, maintaining the doubly-linked free list."
| lowest firstOfFreeRun startOfFreeRun endOfFreeRun prevPrevFree prevFree |
lowest := (lowestForwarder = 0 ifTrue: [endOfMemory] ifFalse: [lowestForwarder])
min: (firstFreeChunk = 0 ifTrue: [endOfMemory] ifFalse: [firstFreeChunk]).
firstOfFreeRun := prevPrevFree := prevFree := 0.
self allOldSpaceEntitiesFrom: lowest do:
[:o|
((self isFreeObject: o) or: [self isForwarded: o])
ifTrue:
[firstOfFreeRun = 0 ifTrue:
[self setObjectFree: o.
firstOfFreeRun := o.
startOfFreeRun := self startOfObject: o].
endOfFreeRun := o]
ifFalse:
[firstOfFreeRun ~= 0 ifTrue:
[| bytes |
bytes := (self addressAfter: endOfFreeRun) - startOfFreeRun.
firstOfFreeRun := self initFreeChunkWithBytes: bytes at: startOfFreeRun.
self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := firstOfFreeRun.
firstOfFreeRun := 0]]].
firstOfFreeRun ~= 0 ifTrue:
[| bytes |
bytes := (self addressAfter: endOfFreeRun) - startOfFreeRun.
firstOfFreeRun := self initFreeChunkWithBytes: bytes at: startOfFreeRun.
self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := firstOfFreeRun.
firstOfFreeRun := 0].
prevFree ~= firstFreeChunk ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: prevFree
withValue: prevPrevFree].
lastFreeChunk := prevFree.
+ self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
+ self checkTraversableSortedFreeList!
- self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]!
Item was changed:
----- Method: SpurSegmentManager>>checkSegments (in category 'debug support') -----
checkSegments
self assert: numSegments >= 1.
0 to: numSegments - 1 do:
[:i|
self assert: (manager addressCouldBeObj: (segments at: i) segStart).
self assert: (self isValidSegmentBridge: (self bridgeAt: i))].
+ self assert: (segments at: numSegments - 1) segLimit - manager bridgeSize = manager endOfMemory!
- self assert: (segments at: numSegments - 1) segLimit = manager endOfMemory!
Item was changed:
----- Method: SpurSegmentManager>>postSnapshot (in category 'snapshot') -----
postSnapshot
"Restore all shortened segments to their proper size, re-freeing the trailing space."
<inline: false>
| seg |
<var: #seg type: #'SpurSegmentInfo *'>
"Set endOfMemory first, to avoid assert fails in freeChunkWithBytes:at:."
seg := self addressOf: (segments at: numSegments - 1).
seg lastFreeObject
ifNil: [self assert: manager endOfMemory = (seg segLimit - manager bridgeSize)]
ifNotNil: [manager setEndOfMemory: seg savedSegSize + seg segStart - manager bridgeSize].
numSegments - 1 to: 0 by: -1 do:
[:i|
seg := self addressOf: (segments at: i).
seg lastFreeObject ifNotNil:
[:freeChunk| | address |
address := seg segLimit - manager bridgeSize.
seg segSize: seg savedSegSize.
self bridgeFrom: seg
to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)]).
manager
addFreeChunkWithBytes: seg segLimit - address - manager bridgeSize
+ at: address]].
+ self checkSegments.
- at: address]]..
manager checkFreeSpace!
Item was changed:
----- Method: SpurSegmentManager>>prepareForSnapshot (in category 'snapshot') -----
prepareForSnapshot
"shorten all segments by any trailing free space."
<inline: false>
<var: #seg type: #'SpurSegmentInfo *'>
+ self checkSegments.
0 to: numSegments - 1 do:
[:i|
(segments at: i)
savedSegSize: (segments at: i) segSize;
lastFreeObject: nil].
"Ideally finding the lastFreeObject of each segment would be
done in some linear pass through the heap. But for now KISS."
manager freeTreeNodesDo:
[:freeChunk| | node next seg |
node := freeChunk.
[node ~= 0] whileTrue:
[next := manager objectAfter: node limit: manager endOfMemory.
(manager isSegmentBridge: next)
ifTrue:
[seg := self segmentContainingObj: node.
seg lastFreeObject: node.
node := 0]
ifFalse:
[node := manager
fetchPointer: manager freeChunkNextIndex
ofFreeChunk: node]].
freeChunk].
0 to: numSegments - 1 do:
[:i|
(segments at: i) lastFreeObject ifNotNil:
[:freeChunk|
manager detachFreeObject: freeChunk.
(segments at: i)
segSize: (manager startOfObject: freeChunk)
+ manager bridgeSize
- (segments at: i) segStart.
self bridgeFrom: (self addressOf: (segments at: i))
to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)])]].
"perhaps this should read
manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!
Item was added:
+ ----- Method: StackInterpreterSimulator>>assertValidExecutionPointersAtEachStep (in category 'accessing') -----
+ assertValidExecutionPointersAtEachStep
+ ^assertVEPAES!
Item was added:
+ ----- Method: StackInterpreterSimulator>>assertValidExecutionPointersAtEachStep: (in category 'accessing') -----
+ assertValidExecutionPointersAtEachStep: aBoolean
+ assertVEPAES := aBoolean!
Item was changed:
+ ----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
- ----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitive support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input."
Display reverse: (0 at 0 extent: 16 at 16).
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000) wait]
ifFalse: [Processor yield].
"And increase the byteCount form which the microsecond clock is derived..."
byteCount := byteCount + microseconds - 1.
self incrementByteCount!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
genReturnTopFromBlock
self assert: inBlock.
self ssTop popToReg: ReceiverResultReg.
self ssPop: 1.
needsFrame ifTrue:
[self MoveR: FPReg R: SPReg.
self PopR: FPReg].
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genUpArrowReturn (in category 'bytecode generators') -----
genUpArrowReturn
"Generate a method return from within a method or a block.
Frameless method activation looks like
receiver
args
sp-> ret pc.
Return pops receiver and arguments off the stack. Callee pushes the result."
inBlock ifTrue:
[self assert: needsFrame.
self annotateBytecode: (self CallRT: ceNonLocalReturnTrampoline).
^0].
needsFrame
ifTrue:
[self MoveR: FPReg R: SPReg.
self PopR: FPReg.
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
self RetN: methodOrBlockNumArgs + 1 * BytesPerWord]
ifFalse:
+ [backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
+ self RetN: ((methodOrBlockNumArgs > self numRegArgs
- [self RetN: ((methodOrBlockNumArgs > self numRegArgs
"A method with an interpreter prim will push its register args for the prim. If the failure
body is frameless the args must still be popped, see e.g. Behavior>>nextInstance."
or: [regArgsHaveBeenPushed])
ifTrue: [methodOrBlockNumArgs + 1 * BytesPerWord]
ifFalse: [0])].
^0!
More information about the Vm-dev
mailing list