[Vm-dev] VM Maker: VMMaker.oscog-eem.256.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 16 16:39:26 UTC 2013


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.256.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.256
Author: eem
Time: 16 January 2013, 8:37:11.561 am
UUID: bfea3efd-4e81-4e85-922e-cf4f58ee5d64
Ancestors: VMMaker.oscog-eem.255

Rewrite the stackLimit computation after a moment of clarity.  Allow
the system to reduce the space for frames by up to an 1/8th.
Make sure there's at least as much headroom as asked for.  This
changes the stack page size from 4096 to 2048 and much reduces
the interpreterAllocationReserveBytes.

Don't round up interpreterAllocationReserveBytes to a power of two.

Simulator:
Initialize numStackPages to the default for experimenting with
stackPage dimensions.

Implement ioRelinquishProcessorForMicroseconds: in
StackInterpreter a la CoInterpreter.

In internalFindNewMethod use splObj: SelectorDoesNotUnderstand
instead of sloooow self stringOf: messageSelector.

=============== Diff against VMMaker.oscog-eem.255 ===============

Item was removed:
- ----- Method: CoInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
- interpreterAllocationReserveBytes
- 	"At a rough approximation we may need to allocate up to a couple
- 	 of page's worth of contexts when switching stack pages, assigning
- 	 to senders, etc.  But the snapshot primitive voids all stack pages.
- 	 So a safe margin is the size of a large context times the maximum
- 	 number of frames per page times the number of pages."
- 	| availableBytesPerPage maxFramesPerPage |
- 	availableBytesPerPage := self stackPageByteSize - self stackLimitOffset - self stackPageHeadroom.
- 	maxFramesPerPage := availableBytesPerPage / BytesPerWord // MFrameSlots.
- 	^2 raisedTo: (maxFramesPerPage * LargeContextSize * numStackPages) highBit!

Item was changed:
  ----- Method: CoInterpreterStackPages>>initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom: (in category 'initialization') -----
  initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage stackLimitOffset: stackLimitOffsetBytes stackPageHeadroom: stackPageHeadroomBytes
  	"Initialize the stack pages.  In the C VM theStackPages will be alloca'ed memory to hold the
  	 stack pages on the C stack.  In the simulator they are housed in the memory between the
  	 cogMethodZone and the heap."
  
  	<var: #theStackPages type: #'char *'>
  	<returnTypeC: #void>
  	| numPages page structStackPageSize pageStructBase count |
  	<var: #page type: #'StackPage *'>
  	<var: #pageStructBase type: #'char *'>
  	self cCode: []
  		inSmalltalk:
  			[self assert: objectMemory startOfMemory - coInterpreter cogCodeSize - coInterpreter methodCacheSize - coInterpreter primTraceLogSize - coInterpreter rumpCStackSize
  					= (stackSlots * BytesPerWord)].
  	structStackPageSize := coInterpreter sizeof: CogStackPage.
  	bytesPerPage := slotsPerPage * BytesPerWord.
  	numPages := coInterpreter numStkPages.
  
  	"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
  	 subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
  	 push the stackPage array up one word to avoid the overlap.  This word is extraStackBytes."
  	pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord.
  	pages := self cCode: [self cCoerceSimple: pageStructBase to: #'StackPage *']
  				  inSmalltalk:
  					[pageMap := Dictionary new.
  					 ((0 to: numPages - 1) collect:
  						[:i|
  						 CogStackPage surrogateClass new
  							address: pageStructBase + (i * structStackPageSize)
  							simulator: coInterpreter
  							zoneBase: coInterpreter stackZoneBase
  							zoneLimit: objectMemory startOfMemory])
  						do: [:pageSurrogate|
  							pageMap at: pageSurrogate address put: pageSurrogate];
  						yourself].
+ 	"make sure there's enough headroom"
+ 	self assert: coInterpreter stackPageByteSize - coInterpreter stackLimitBytes - coInterpreter stackLimitOffset
+ 				>= coInterpreter stackPageHeadroom.
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 page
  			lastAddress: theStackPages + (index * bytesPerPage);
  			baseAddress: page lastAddress + bytesPerPage;
+ 			stackLimit: page baseAddress - coInterpreter stackLimitBytes;
- 			stackLimit: page baseAddress
- 						- stackLimitOffsetBytes
- 						- stackPageHeadroomBytes;
  			realStackLimit: page stackLimit;
  			baseFP: 0;
  			nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
  			prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
  
  	"Now compute stackBasePlus1 so that the pageIndexFor: call maps all addresses from
  	 aPage baseAddress to aBase limitAddress + 1 to the same index (stacks grow down)"
  	stackBasePlus1 := (self cCoerceSimple: theStackPages to: #'char *') + 1.
  	self cCode: []
  		inSmalltalk:
  			[minStackAddress := theStackPages.
  			 maxStackAddress := theStackPages + (numPages * bytesPerPage) + BytesPerWord - 1].
  
  	"The overflow limit is the amount of stack to retain when moving frames from an overflowing
  	 stack to reduce thrashing.  See stackOverflowOrEvent:mayContextSwitch:"
  	page := self stackPageAt: 0.
  	overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 self assert: (self pageIndexFor: page baseAddress) == index.
  		 self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index.
  		 self assert: (self stackPageFor: page baseAddress) == page.
  		 self assert: (self stackPageFor: page stackLimit) == page.
  		 self cCode: []
  			inSmalltalk:
  				[| memIndex |
  				 memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
  				 self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
  							== (memIndex + slotsPerPage - 1).
  				 index < (numPages - 1) ifTrue:
  					[self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]].
  		self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"].
  
  	mostRecentlyUsedPage := self stackPageAt: 0.
  	page := mostRecentlyUsedPage.
  	count := 0.
  	[| theIndex |
  	 count := count + 1.
  	 theIndex := self pageIndexFor: page baseAddress.
  	 self assert: (self stackPageAt: theIndex) == page.
  	 self assert: (self pageIndexFor: page baseAddress) == theIndex.
  	 self assert: (self pageIndexFor: page stackLimit) == theIndex.
  	 self assert: (self pageIndexFor: page lastAddress + 1) == theIndex.
  	 (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
  	self assert: count == numPages.
  	self assert: self pageListIsWellFormed!

Item was changed:
  ----- Method: CogBytecodeDescriptor>>printCInitializerOn:in: (in category 'translation') -----
  printCInitializerOn: aStream in: aCCodeGenerator
  	<doNotGenerate>
  	| first |
  	first := true.
  	aStream nextPut: ${; space.
  	self class instVarNamesAndTypesForTranslationDo:
  		[:ivn :type| | value |
  		first ifTrue: [first := false] ifFalse: [aStream nextPut: $,; space].
  		value := self instVarNamed: ivn.
  		(#(#'unsigned char' #'signed char' #('unsigned' ' : 1')) includes: type)
  			ifTrue: [value isInteger
+ 						ifTrue: [ivn = 'opcode'
+ 									ifTrue: [aStream nextPutAll: (CogRTLOpcodes nameForOpcode: value)]
+ 									ifFalse: [aStream print: value]]
- 						ifTrue: [aStream print: value]
  						ifFalse: [aStream nextPut: ((value notNil and: [value]) ifTrue: [$1] ifFalse: [$0])]]
  			ifFalse: [(false and: [#('spanFunction' 'isBackwardBranchFunction') includes: ivn]) ifTrue:
  						[aStream nextPut: $(; nextPutAll: type first; nextPutAll: type last; nextPut: $)].
  					aStream nextPutAll: (value
  											ifNotNil: [aCCodeGenerator cFunctionNameFor: value]
  											ifNil: ['0'])]].
  	aStream space; nextPut: $}!

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  
  	| objectMemoryClass |
  
  	"initialize class variables"
  	objectMemory ifNotNil:
  		[^self halt].
  
  	objectMemoryClass := self class objectMemoryClass.
  
  	objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
  	((Smalltalk classNamed: #CoInterpreterMT) ifNil: [CoInterpreter] ifNotNil: [:cimt| cimt])  initialize.
  	(self class cogitClass withAllSuperclasses copyUpThrough: Cogit) reverseDo:
  		[:c| c initialize].
  
  	super initialize.
  	objectMemory := objectMemoryClass simulatorClass new.
  	cogit := self class cogitClass new setInterpreter: self.
  	cogit numRegArgs > 0 ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
  	objectMemory coInterpreter: self cogit: cogit.
  
  	"Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
  	 for simulation, due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  	HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
  	cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  	enableCog := true.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	self flushAtCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	pluginList := #().
  	mappedPluginEntries := OrderedCollection new.
  	desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
+ 	"This is initialized on loading the image, but convenient for testing stack page values..."
+ 	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := lastPollCount := sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  	systemAttributes := Dictionary new.
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	primTraceLogIndex := 0.
  	traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  	traceLogIndex := 0.
  	traceSources := TraceSources.
  	statCodeCompactionCount := 0.
  	statCodeCompactionUsecs := 0.
  	extSemTabSize := 256!

Item was changed:
  ----- Method: CogVMSimulator>>internalFindNewMethod (in category 'testing') -----
  internalFindNewMethod
  "
  	| cName |
  	traceOn ifTrue:
  		[cName := (self sizeBitsOf: class) = 16r20
  			ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
  			ifFalse: [(self nameOfClass: class)].
  		self cr; print: cName , '>>' , (self stringOf: messageSelector)].
  "
+ 	messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self halt].
- 	(self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
  
  	self logSend: messageSelector.
  "
  	(sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
  		[Transcript print: sendCount; space.
  		self validate].
  "
  "
  	(sendCount > 100150) ifTrue:
  		[self qvalidate.
  		messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
  		messageQueue addLast: (self stringOf: messageSelector)].
  "
  	^super internalFindNewMethod!

Item was changed:
  ----- Method: InterpreterStackPages>>initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom: (in category 'initialization') -----
  initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage stackLimitOffset: stackLimitOffsetBytes stackPageHeadroom: stackPageHeadroomBytes
  	"Initialize the stack pages.  For testing I want stack addresses to be disjoint from
  	 normal memory addresses so stack addresses are negative.  The first address is
  	 -pageSize bytes.  So for example if there are 1024 bytes per page and 3 pages
  	 then the pages are organized as
  
  		byte address: -1024 <-> -2047 | -2048 <-> -3071 | -3072 <-> -4096 |
  							page 3			page 2			page 1
  		mem index:        769 <-> 513  |     512 <->  257  |   256 <->        1 |
  
  	 The byte address is the external address corresponding to a real address in the VM.
  	 mem index is the index in the memory Array holding the stack, an index internal to
  	 the stack pages.  The first stack page allocated will be the last page in the array of pages
  	 at the highest effective address.  Its base address be -1024  and grow down towards -2047."
  
  	"The lFoo's are to get around the foo->variable scheme in the C call to allocStackPages below."
  	<var: #theStackPages type: #'char *'>
  	| page structStackPageSize pageStructBase count |
  	<var: #page type: #'StackPage *'>
  	<var: #pageStructBase type: #'char *'>
  	self cCode: ''
  		inSmalltalk:
  			[self assert: stackMemory size = stackSlots.
  			 self assert: stackMemory size - self extraStackBytes \\ slotsPerPage = 0.
  			 self assert: stackMemory == theStackPages].
  	stackMemory := theStackPages. "For initialization in the C code."
  	self cCode: '' inSmalltalk: [pageSizeInSlots := slotsPerPage].
  	structStackPageSize := interpreter sizeof: InterpreterStackPage.
  	bytesPerPage := slotsPerPage * BytesPerWord.
  	numPages := stackSlots // (slotsPerPage + (structStackPageSize / BytesPerWord)).
  
  	"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
  	 subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
  	 push the stackPage array up one word to avoid the overlap.  This word is extraStackBytes."
  	pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord.
  	pages := self cCode: '(StackPage *)pageStructBase'
  				  inSmalltalk:
  						[pageStructBase class.
  						 (1 to: numPages) collect: [:i| InterpreterStackPage new]].
  
  	"Simulation only.  Since addresses are negative the offset is positive.  To make all
  	 stack addresses negative we make the offset a page more than it needs to be so the
  	 address of the last slot in memory (the highest address in the stack, or its start) is
  		- pageByteSize
  	 and the address of the first slot (the lowest address, or its end) is
  		- pageByteSize * (numPages + 1)"
  	self cCode: '' inSmalltalk: [indexOffset := (numPages + 1) * slotsPerPage].
+ 	"make sure there's enough headroom"
+ 	self assert: interpreter stackPageByteSize - interpreter stackLimitBytes - interpreter stackLimitOffset
+ 				>= interpreter stackPageHeadroom.
- 
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 page
  			lastAddress: (self cCode: '(char *)theStackPages + (index * GIV(bytesPerPage))'
  							inSmalltalk: [(index * slotsPerPage - indexOffset) * BytesPerWord]);
  			baseAddress: (page lastAddress + bytesPerPage);
+ 			stackLimit: page baseAddress - interpreter stackLimitBytes;
- 			stackLimit: page lastAddress
-                             + stackLimitOffsetBytes
-                             + stackPageHeadroomBytes;
  			realStackLimit: page stackLimit;
  			baseFP: 0;
  			nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
  			prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
  	self cCode: ''
  		inSmalltalk:
  			[| lowestAddress highestAddress |
  			lowestAddress := (pages at: 1) lastAddress + BytesPerWord.
  			highestAddress := (pages at: numPages) baseAddress.
  			"see InterpreterStackPages>>longAt:"
  			self assert: lowestAddress // BytesPerWord + indexOffset = 1.
  			self assert: highestAddress // BytesPerWord + indexOffset = (numPages * slotsPerPage)].
  
  	"The overflow limit is the amount of stack to retain when moving frames from an overflowing
  	 stack to reduce thrashing.  See stackOverflowOrEvent:mayContextSwitch:"
  	page := self stackPageAt: 0.
  	overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
  
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 self assert: (self pageIndexFor: page baseAddress) == index.
  		 self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index.
  		 self assert: (self stackPageFor: page baseAddress) == page.
  		 self assert: (self stackPageFor: page stackLimit) == page.
  		 self cCode: ''
  			inSmalltalk:
  				[| memIndex |
  				 memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
  				 self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
  							== (memIndex + slotsPerPage - 1).
  				 index < (numPages - 1) ifTrue:
  					[self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]].
  		self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"].
  
  	mostRecentlyUsedPage := self stackPageAt: 0.
  	page := mostRecentlyUsedPage.
  	count := 0.
  	[| theIndex |
  	 count := count + 1.
  	 theIndex := self pageIndexFor: page baseAddress.
  	 self assert: (self stackPageAt: theIndex) == page.
  	 self assert: (self pageIndexFor: page baseAddress) == theIndex.
  	 self assert: (self pageIndexFor: page stackLimit) == theIndex.
  	 self assert: (self pageIndexFor: page lastAddress + BytesPerWord) == theIndex.
  	 (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
  	self assert: count == numPages.
  	self assert: self pageListIsWellFormed!

Item was changed:
  ----- Method: StackInterpreter>>highBit: (in category 'stack pages') -----
  highBit: anUnsignedValue 
+ 	"This is a C implementation needed by ioSetMaxExtSemTableSize
+ 	 and e.g. stackPageByteSize."
- 	"This is a C implementation needed by stackPageByteSize when translated."
  	| shifted bitNo |
+ 	<api>
+ 	<highBit> "so it shows up in senders..."
  	<var: #anUnsignedValue type: #usqInt>
  	<var: #shifted type: #usqInt>
  	shifted := anUnsignedValue.
  	bitNo := 0.
  	self cppIf: BytesPerWord > 4
  		ifTrue:
  			[shifted < (1 << 32) ifFalse:
  				[shifted := shifted >> 32.
  				 bitNo := bitNo + 32]].
  	shifted < (1 << 16) ifFalse:
  		[shifted := shifted >> 16.
  		 bitNo := bitNo + 16].
  	shifted < (1 << 8) ifFalse:
  		[shifted := shifted >> 8.
  		 bitNo := bitNo + 8].
  	shifted < (1 << 4) ifFalse:
  		[shifted := shifted >> 4.
  		 bitNo := bitNo + 4].
  	shifted < (1 << 2) ifFalse:
  		[shifted := shifted >> 2.
  		 bitNo := bitNo + 2].
  	shifted < (1 << 1) ifFalse:
  		[shifted := shifted >> 1.
  		 bitNo := bitNo + 1].
  	"shifted 0 or 1 now"
  	^bitNo + shifted!

Item was changed:
  ----- Method: StackInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
  interpreterAllocationReserveBytes
  	"At a rough approximation we may need to allocate up to a couple
  	 of page's worth of contexts when switching stack pages, assigning
  	 to senders, etc.  But the snapshot primitive voids all stack pages.
  	 So a safe margin is the size of a large context times the maximum
  	 number of frames per page times the number of pages."
+ 	| maxUsedBytesPerPage maxFramesPerPage |
+ 	maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset.
+ 	maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // MFrameSlots.
+ 	^maxFramesPerPage * LargeContextSize * numStackPages!
- 	| availableBytesPerPage maxFramesPerPage |
- 	availableBytesPerPage := self stackPageByteSize - self stackLimitOffset - self stackPageHeadroom.
- 	maxFramesPerPage := availableBytesPerPage / BytesPerWord // FrameSlots.
- 	^2 raisedTo: (maxFramesPerPage * LargeContextSize * numStackPages) highBit!

Item was added:
+ ----- Method: StackInterpreter>>stackLimitBytes (in category 'stack pages') -----
+ stackLimitBytes
+ 	"Answer the actual stackLimit offset in a page.  Since stackPageByteSize may have chosen to shrink a page
+ 	 this may be less than stackPageFrameBytes, but it should be no more than stackPageFrameBytes."
+ 	^self stackPageFrameBytes min: self stackPageByteSize - self stackLimitOffset - self stackPageHeadroom.!

Item was changed:
  ----- Method: StackInterpreter>>stackPageByteSize (in category 'stack pages') -----
  stackPageByteSize
+ 	"Answer a page size that is a power-of-two and contains a useful number of frames.
+ 	 Room for 512 bytes of frames gives around 40 frames a page which is a
- 	"Room for 512 bytes of frames gives around 40 frames a page which is a
  	 good compromise between overflow rate and latency in divorcing a page."
  	<inline: false>
+ 	| pageBytes largeSize smallSize |
+ 	pageBytes := self stackPageFrameBytes + self stackLimitOffset + self stackPageHeadroom.
+ 	(pageBytes bitAnd: pageBytes - 1) = 0 ifTrue: "= 0 => a power of two"
+ 		[^pageBytes].
+ 	"round up or round down; that is the question.  If rounding down reduces
+ 	 the size by no more than 1/8th round down, otherwise roundup."
+ 	largeSize := 1 << pageBytes highBit.
+ 	smallSize := 1 << (pageBytes highBit - 1).
+ 	self assert: (largeSize > pageBytes and: [pageBytes > smallSize]).
+ 	^(pageBytes - smallSize) <= (smallSize / 8)
+ 		ifTrue: [smallSize]
+ 		ifFalse: [largeSize]!
- 	^1 << (512 + self stackLimitOffset + self stackPageHeadroom - 1) highBit!

Item was added:
+ ----- Method: StackInterpreter>>stackPageFrameBytes (in category 'stack pages') -----
+ stackPageFrameBytes
+ 	"Answer a byte size that accomodates a useful number of frames.
+ 	 512 bytes is room for around 40 frames a page which is a good
+ 	 compromise between overflow rate and latency in divorcing a page."
+ 	^512!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  
  	| objectMemoryClass |
  
  	"initialize class variables"
  	objectMemory ifNotNil:
  		[^self halt].
  
  	objectMemoryClass := self class objectMemoryClass.
  
  	objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
  	objectMemoryClass initialize.
  	StackInterpreter initialize.
  
  	super initialize.
  	objectMemory := objectMemoryClass simulatorClass new.
  	objectMemory coInterpreter: self.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	self flushAtCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	pluginList := #().
  	mappedPluginEntries := #().
  	desiredNumStackPages := desiredEdenBytes := 0.
+ 	"This is initialized on loading the image, but convenient for testing stack page values..."
+ 	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := false.
  	extSemTabSize := 256.
  	disableBooleanCheat := false!

Item was changed:
  ----- Method: StackInterpreterSimulator>>internalFindNewMethod (in category 'testing') -----
  internalFindNewMethod
  "
  	| cName |
  	traceOn ifTrue:
  		[cName := (self sizeBitsOf: class) = 16r20
  			ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
  			ifFalse: [(self nameOfClass: class)].
  		self cr; print: cName , '>>' , (self stringOf: messageSelector)].
  "
+ 	messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self halt].
- 	(self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
  
  	sendCount := sendCount + 1.
  
  	printSends ifTrue:
  		[self cr; print: byteCount; space; printStringOf: messageSelector; cr].
  "
  	(sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
  		[Transcript print: sendCount; space.
  		self validate].
  "
  "
  	(sendCount > 100150) ifTrue:
  		[self qvalidate.
  		messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
  		messageQueue addLast: (self stringOf: messageSelector)].
  "
  	super internalFindNewMethod!

Item was added:
+ ----- 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]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>primitiveRelinquishProcessor (in category 'I/O primitives support') -----
- primitiveRelinquishProcessor
- 	"No-op in simulator"
- 
- 	^ self pop: 1!



More information about the Vm-dev mailing list