[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