[Vm-dev] VM Maker: VMMaker-oscog-EstebanLorenzano.236.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Mar 12 09:48:10 UTC 2013
Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.236.mcz
==================== Summary ====================
Name: VMMaker-oscog-EstebanLorenzano.236
Author: EstebanLorenzano
Time: 12 March 2013, 10:43:57.384 am
UUID: 1dbdb1d5-7f43-44db-9cec-f2095b90345e
Ancestors: VMMaker-oscog-EstebanLorenzano.235, VMMaker.oscog-eem.272
- merged with Eliot's. More becomeForward: fixes.
=============== Diff against VMMaker-oscog-EstebanLorenzano.235 ===============
Item was added:
+ ----- Method: CoInterpreterStackPages>>markStackPageLeastMostRecentlyUsed: (in category 'page access') -----
+ markStackPageLeastMostRecentlyUsed: page "<InterpreterStackPage>"
+ "This method is used to move a page to the end of the used pages.
+ This is to keep asserts checking pageListIsWellFormed happy."
+
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+
+ <var: #page type: #'StackPage *'>
+ <returnTypeC: #void>
+ | lastUsedPage |
+ <var: #lastUsedPage type: #'StackPage *'>
+ self assert: page = mostRecentlyUsedPage nextPage.
+ lastUsedPage := page nextPage.
+ [lastUsedPage isFree] whileTrue:
+ [lastUsedPage := lastUsedPage nextPage].
+ lastUsedPage nextPage = page ifTrue:
+ [^nil].
+ page prevPage nextPage: page nextPage.
+ page nextPage prevPage: page prevPage.
+ lastUsedPage prevPage nextPage: page.
+ page prevPage: lastUsedPage prevPage.
+ page nextPage: lastUsedPage.
+ lastUsedPage prevPage: page.
+ self assert: self pageListIsWellFormed!
Item was changed:
----- Method: CoInterpreterStackPages>>markStackPageMostRecentlyUsed: (in category 'page access') -----
markStackPageMostRecentlyUsed: page "<InterpreterStackPage>"
"MRUP-->used page<->used page<->used page<->used page<--LRUP
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page"
+ <var: #page type: #'StackPage *'>
- <var: #page type: 'StackPage *'>
<asmLabel: false>
<returnTypeC: #void>
page == mostRecentlyUsedPage ifTrue:
[^nil].
"Common case; making new page most recently used."
page prevPage == mostRecentlyUsedPage ifTrue:
[mostRecentlyUsedPage := page.
self assert: self pageListIsWellFormed.
^nil].
page prevPage nextPage: page nextPage.
page nextPage prevPage: page prevPage.
mostRecentlyUsedPage nextPage prevPage: page.
page prevPage: mostRecentlyUsedPage.
page nextPage: mostRecentlyUsedPage nextPage.
mostRecentlyUsedPage nextPage: page.
mostRecentlyUsedPage := page.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: CoInterpreterStackPages>>markStackPageNextMostRecentlyUsed: (in category 'page access') -----
markStackPageNextMostRecentlyUsed: page "<InterpreterStackPage>"
"This method is used to move a page to a position in the list such that it cannot
be deallocated when a new page is allocated, without changing the most recently
used page. There must be at least 3 pages in the system. So making the page
the MRU's prevPage is sufficient to ensure it won't be deallocated."
"MRUP-->used page<->used page<->used page<->used page<--LRUP
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page"
+ <var: #page type: #'StackPage *'>
- <var: #page type: 'StackPage *'>
<returnTypeC: #void>
self assert: page ~~ mostRecentlyUsedPage.
page nextPage == mostRecentlyUsedPage ifTrue:
[^nil].
page prevPage nextPage: page nextPage.
page nextPage prevPage: page prevPage.
mostRecentlyUsedPage prevPage nextPage: page.
page prevPage: mostRecentlyUsedPage prevPage.
page nextPage: mostRecentlyUsedPage.
mostRecentlyUsedPage prevPage: page.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: CoInterpreterStackPages>>pageListIsWellFormed (in category 'assertions') -----
pageListIsWellFormed
"Answer if the stack page list is well-formed.
MRUP-->used page<->used page<->used page<->used page<--LRUP
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page"
| ok page count limit |
<inline: false>
+ <var: #page type: #'StackPage *'>
- <var: #page type: 'StackPage *'>
ok := true.
page := mostRecentlyUsedPage nextPage.
count := 1.
limit := coInterpreter numStkPages * 2.
[page isFree
and: [page ~= mostRecentlyUsedPage
and: [count <= limit]]] whileTrue:
[(self asserta: page nextPage prevPage == page) ifFalse:
[ok := false].
page := page nextPage.
count := count + 1].
[page ~= mostRecentlyUsedPage
and: [count <= limit]] whileTrue:
[(self asserta: page nextPage prevPage == page) ifFalse:
[ok := false].
(self asserta: page isFree not)
ifTrue:
[(self asserta: (self stackPageFor: page baseFP) == page) ifFalse:
[ok := false].
(self asserta: (self stackPageFor: page headSP) == page) ifFalse:
[ok := false]]
ifFalse:
[ok := false].
page := page nextPage.
count := count + 1].
(self asserta: count = coInterpreter numStkPages) ifFalse:
[ok := false].
^ok!
Item was changed:
----- Method: CoInterpreterStackPages>>stackPageAt: (in category 'page access') -----
stackPageAt: index
"Answer the page for a page index.
N.B. This is a zero-relative index."
+ <returnTypeC: #'StackPage *'>
- <returnTypeC: 'StackPage *'>
^self stackPageAt: index pages: pages!
Item was changed:
----- Method: InterpreterStackPages>>isFree: (in category 'page access') -----
isFree: thePage
+ "This is an anachronism. Previously Slang couldn't generate the method correctly
+ from e.g. InterpreterStackPage>>isFree since Slang didn't do substitution on self.
+ Now it does, but there are still callers of isFree: so we keep this for simulation."
- "This is a sad workaround. Ideally this is an accessor on InterpreterStackPages.
- But it isn't easy to extend Slang to deal with this. There's no easy place to put
- the type information and Slang doesn't ever do substitution on self. It merely
- elides self."
<doNotGenerate>
+ ^thePage baseFP = 0!
- <inline: true>
- <var: #thePage type: 'StackPage *'>
- ^thePage baseFP = 0
- !
Item was added:
+ ----- Method: InterpreterStackPages>>markStackPageLeastMostRecentlyUsed: (in category 'page access') -----
+ markStackPageLeastMostRecentlyUsed: page "<InterpreterStackPage>"
+ "This method is used to move a page to the end of the used pages.
+ This is to keep asserts checking pageListIsWellFormed happy."
+
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+
+ <var: #page type: #'StackPage *'>
+ <returnTypeC: #void>
+ | lastUsedPage |
+ <var: #lastUsedPage type: #'StackPage *'>
+ self assert: page = mostRecentlyUsedPage nextPage.
+ lastUsedPage := page nextPage.
+ [lastUsedPage isFree] whileTrue:
+ [lastUsedPage := lastUsedPage nextPage].
+ lastUsedPage nextPage = page ifTrue:
+ [^nil].
+ page prevPage nextPage: page nextPage.
+ page nextPage prevPage: page prevPage.
+ lastUsedPage prevPage nextPage: page.
+ page prevPage: lastUsedPage prevPage.
+ page nextPage: lastUsedPage.
+ lastUsedPage prevPage: page.
+ self assert: self pageListIsWellFormed!
Item was changed:
----- Method: InterpreterStackPages>>markStackPageMostRecentlyUsed: (in category 'page access') -----
markStackPageMostRecentlyUsed: page "<InterpreterStackPage>"
"MRUP-->used page<->used page<->used page<->used page<--LRUP
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page"
+ <var: #page type: #'StackPage *'>
- <var: #page type: 'StackPage *'>
<asmLabel: false>
page == mostRecentlyUsedPage ifTrue:
[^nil].
"Common case; making new page most recently used."
page prevPage == mostRecentlyUsedPage ifTrue:
[mostRecentlyUsedPage := page.
self assert: self pageListIsWellFormed.
^nil].
page prevPage nextPage: page nextPage.
page nextPage prevPage: page prevPage.
mostRecentlyUsedPage nextPage prevPage: page.
page prevPage: mostRecentlyUsedPage.
page nextPage: mostRecentlyUsedPage nextPage.
mostRecentlyUsedPage nextPage: page.
mostRecentlyUsedPage := page.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: InterpreterStackPages>>markStackPageNextMostRecentlyUsed: (in category 'page access') -----
markStackPageNextMostRecentlyUsed: page "<InterpreterStackPage>"
"This method is used to move a page to a position in the list such that it cannot
be deallocated when a new page is allocated, without changing the most recently
used page. There must be at least 3 pages in the system. So making the page
the MRU's prevPage is sufficient to ensure it won't be deallocated."
"MRUP-->used page<->used page<->used page<->used page<--LRUP
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page"
+ <var: #page type: #'StackPage *'>
- <var: #page type: 'StackPage *'>
self assert: page ~~ mostRecentlyUsedPage.
page nextPage == mostRecentlyUsedPage ifTrue:
[^nil].
page prevPage nextPage: page nextPage.
page nextPage prevPage: page prevPage.
mostRecentlyUsedPage prevPage nextPage: page.
page prevPage: mostRecentlyUsedPage prevPage.
page nextPage: mostRecentlyUsedPage.
mostRecentlyUsedPage prevPage: page.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: InterpreterStackPages>>pageIndexFor: (in category 'page access') -----
pageIndexFor: pointer "<Integer>"
"Answer the page index for a pointer into stack memory, i.e. the index
for the page the address is in. N.B. This is a zero-relative index."
+ <var: #pointer type: #'void *'>
- <var: #pointer type: 'void *'>
^self pageIndexFor: pointer stackMemory: stackMemory bytesPerPage: bytesPerPage!
Item was changed:
----- Method: InterpreterStackPages>>pageListIsWellFormed (in category 'assertions') -----
pageListIsWellFormed
"Answer if the stack page list is well-formed.
MRUP-->used page<->used page<->used page<->used page<--LRUP
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page"
| ok page count limit |
<inline: false>
+ <var: #page type: #'StackPage *'>
- <var: #page type: 'StackPage *'>
ok := true.
page := mostRecentlyUsedPage nextPage.
count := 1.
limit := numPages * 2.
[page isFree
and: [page ~= mostRecentlyUsedPage
and: [count <= limit]]] whileTrue:
[(self asserta: page nextPage prevPage == page) ifFalse:
[ok := false].
page := page nextPage.
count := count + 1].
[page ~= mostRecentlyUsedPage
and: [count <= limit]] whileTrue:
[(self asserta: page nextPage prevPage == page) ifFalse:
[ok := false].
(self asserta: page isFree not)
ifTrue:
[(self asserta: (self stackPageFor: page baseFP) == page) ifFalse:
[ok := false].
(self asserta: (self stackPageFor: page headSP) == page) ifFalse:
[ok := false]]
ifFalse:
[ok := false].
page := page nextPage.
count := count + 1].
(self asserta: count = numPages) ifFalse:
[ok := false].
^ok!
Item was changed:
----- Method: InterpreterStackPages>>stackPageAt: (in category 'page access') -----
stackPageAt: index
"Answer the page for a page index.
N.B. This is a zero-relative index."
+ <returnTypeC: #'StackPage *'>
- <returnTypeC: 'StackPage *'>
^self stackPageAt: index pages: pages!
Item was changed:
----- Method: StackInterpreter>>assertValidExecutionPointe:r:s:imbar: (in category 'debug support') -----
assertValidExecutionPointe: lip r: lfp s: lsp imbar: inInterpreter
+ <var: #lip type: #usqInt>
- <var: #lip type: #'char *'>
<var: #lfp type: #'char *'>
<var: #lsp type: #'char *'>
self assert: inInterpreter.
self assert: stackPage = (stackPages stackPageFor: lfp).
self assert: stackPage = stackPages mostRecentlyUsedPage.
self assertValidStackLimits.
self assert: lfp < stackPage baseAddress.
self assert: lsp < lfp.
self assert: lfp > lsp.
self assert: lsp >= (stackPage realStackLimit - self stackLimitOffset).
self assert: (lfp - lsp) < LargeContextSize.
self assert: (self validInstructionPointer: lip inFrame: lfp).
self assert: ((self frameIsBlockActivation: lfp)
or: [(self pushedReceiverOrClosureOfFrame: lfp) = (self frameReceiver: lfp)]).
self assert: method = (self frameMethod: lfp).
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256)].!
Item was changed:
----- Method: StackInterpreter>>externalSetStackPageAndPointersForSuspendedContextOfProcess: (in category 'frame access') -----
externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess
"Set stackPage, framePointer and stackPointer for the suspendedContext of aProcess,
marrying the context if necessary, and niling the suspendedContext slot. This is used
on process switch to ensure a context has a stack frame and so can continue execution."
+ | newContext theFrame thePage newPage |
- | newContext theFrame thePage |
<var: #theFrame type: #'char *'>
<var: #thePage type: #'StackPage *'>
+ <var: #newPage type: #'StackPage *'>
newContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess.
self assert: (objectMemory isContext: newContext).
(self isMarriedOrWidowedContext: newContext) ifTrue:
[self assert: (self checkIsStillMarriedContext: newContext currentFP: framePointer)].
+ objectMemory
+ storePointerUnchecked: SuspendedContextIndex
+ ofObject: aProcess
+ withValue: objectMemory nilObject.
- objectMemory storePointerUnchecked: SuspendedContextIndex ofObject: aProcess withValue: objectMemory nilObject.
(self isStillMarriedContext: newContext)
ifTrue:
[theFrame := self frameOfMarriedContext: newContext.
+ thePage := stackPages stackPageFor: theFrame.
+ theFrame ~= thePage headFP ifTrue:
+ ["explicit assignment of suspendedContext can cause switch to interior frame."
+ newPage := self newStackPage.
+ self moveFramesIn: thePage
+ through: (self findFrameAbove: theFrame inPage: thePage)
+ toPage: newPage.
+ stackPages markStackPageLeastMostRecentlyUsed: newPage].
+ self assert: thePage headFP = theFrame]
- thePage := stackPages stackPageFor: theFrame]
ifFalse:
[thePage := self makeBaseFrameFor: newContext.
theFrame := thePage baseFP].
- self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
stackPointer := thePage headSP.
framePointer := thePage headFP.
(self isMachineCodeFrame: framePointer) ifFalse:
[self setMethod: (self iframeMethod: framePointer)].
self assertValidExecutionPointe: self stackTop asUnsignedInteger r: framePointer s: stackPointer!
Item was changed:
----- Method: StackInterpreter>>respondToUnknownBytecode (in category 'miscellaneous bytecodes') -----
respondToUnknownBytecode
"If an error selector is available then send it to the activeContext, otherwise abort."
<sharedCodeNamed: #respondToUnknownBytecode inCase: #unknownBytecode>
+ | ourContext |
+ messageSelector := objectMemory maybeSplObj: SelectorUnknownBytecode.
+ (messageSelector isNil
+ or: [messageSelector = objectMemory nilObject]) ifTrue:
- | unknownBytecodeSelector ourContext |
- unknownBytecodeSelector := objectMemory maybeSplObj: SelectorUnknownBytecode.
- unknownBytecodeSelector isNil ifTrue:
[self error: 'Unknown bytecode'].
ourContext := self ensureFrameIsMarried: localFP SP: localSP.
+ "undo fetch of bytecode so that context's pc is pointing to the unknown bytecode."
+ localIP := localIP - 1.
- "N.B. Do Not:
- self fetchNextBytecode."
self internalPush: ourContext.
- messageSelector := unknownBytecodeSelector.
argumentCount := 0.
+ self normalSend!
- self commonSend!
Item was changed:
----- Method: StackInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') -----
validInstructionPointer: theInstrPointer inMethod: aMethod framePointer: fp
<var: #theInstrPointer type: #usqInt>
<var: #aMethod type: #usqInt>
+ <var: #fp type: #'char *'>
^self
cppIf: MULTIPLEBYTECODESETS
ifTrue:
[| methodHeader |
methodHeader := self noAssertHeaderOf: aMethod. "-1 for pre-increment in fetchNextBytecode"
theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BaseHeaderSize - 1)
and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + BaseHeaderSize - 1)
and: ["If the method starts with a CallPrimitive opcode the instruction pointer should be past it."
((self headerIndicatesAlternateBytecodeSet: methodHeader)
and: [(self alternateHeaderHasPrimitiveFlag: methodHeader)
and: [theInstrPointer < (aMethod
+ BaseHeaderSize - 1
+ (objectMemory lastPointerOf: aMethod)
+ (self sizeOfCallPrimitiveBytecode: methodHeader) - 1)]])
not]]]
ifFalse: "-1 for pre-increment in fetchNextBytecode"
[theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BaseHeaderSize - 1)
and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + BaseHeaderSize - 1)]]!
More information about the Vm-dev
mailing list