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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.370
Author: eem
Time: 11 September 2013, 7:43:11.841 am
UUID: b42d44b7-3f55-465e-80d5-d609a89ec601
Ancestors: VMMaker.oscog-eem.369

Implement hashing for Spur.  Split hashBitsOf: into rawHashBitsOf:.
Implement Lehmer's algorithm (for now).
Use ensureBehaviorHash: in instantiation routines.
Add classTableIndex.

Put the survivor spaces below eden for tenuring.  Eliminate
newSpaceStart.

Add SpurMemMgr>>isContextHeader:

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveBehaviorHash (in category 'object access primitives') -----
  primitiveBehaviorHash
  	| hashOrError |
+ 	self assert: ((objectMemory isNonImmediate: self stackTop)
+ 				 and: [self addressCouldBeClassObj: self stackTop]).
- 	self assert: (objectMemory isIntegerObject: self stackTop) not.
  	hashOrError := objectMemory ensureBehaviorHash: self stackTop.
  	hashOrError >= 0
  		ifTrue: [self pop: 1 thenPushInteger: hashOrError]
  		ifFalse: [self primitiveFailFor: hashOrError negated]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveIdentityHash (in category 'object access primitives') -----
  primitiveIdentityHash
  	| thisReceiver |
  	thisReceiver := self stackTop.
+ 	(objectMemory isImmediate: thisReceiver)
- 	(objectMemory isIntegerObject: thisReceiver)
  		ifTrue: [self primitiveFail]
  		ifFalse: [self pop: argumentCount + 1
  					thenPushInteger: (objectMemory hashBitsOf: thisReceiver)]!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
  instantiateClass: classObj indexableSize: nElements
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
  			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
  			[numSlots := nElements * 2].
  		[self firstLongFormat]	->
  			[numSlots := nElements].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 1 // 2.
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 3 // 4.
  			 instSpec := instSpec + (nElements bitAnd: 3)].
  		[self firstCompiledMethodFormat]	->
  			[numSlots := nElements + 3 // 4.
  			 instSpec := instSpec + (nElements bitAnd: 3)] }
  		otherwise: [^nil]. "non-indexable"
+ 	classIndex := self ensureBehaviorHash: classObj.
+ 	classIndex < 0 ifTrue:
+ 		[coInterpreter primitiveFailFor: classIndex negated.
+ 		 ^nil].
- 	classIndex := self hashBitsOf: classObj.
- 	classIndex = 0 ifTrue:
- 		[(self enterIntoClassTable: classObj) ifFalse:
- 			[^nil].
- 		classIndex := self hashBitsOf: classObj].
  	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
  instantiateClass: classObj indexableSize: nElements
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
  			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
  			[numSlots := nElements].
  		[self firstLongFormat]	->
  			[numSlots := nElements + 1 // 2.
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 3 // 4.
  			 instSpec := instSpec + (nElements bitAnd: 3)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 7 // 8.
  			 instSpec := instSpec + (nElements bitAnd: 7)].
  		[self firstCompiledMethodFormat]	->
  			[numSlots := nElements + 7 // 8.
  			 instSpec := instSpec + (nElements bitAnd: 7)] }
  		otherwise: [^nil]. "non-indexable"
+ 	classIndex := self ensureBehaviorHash: classObj.
+ 	classIndex < 0 ifTrue:
+ 		[coInterpreter primitiveFailFor: classIndex negated.
+ 		 ^nil].
- 	classIndex := self hashBitsOf: classObj.
- 	classIndex = 0 ifTrue:
- 		[(self enterIntoClassTable: classObj) ifFalse:
- 			[^nil].
- 		classIndex := self hashBitsOf: classObj].
  	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was changed:
  ----- Method: SpurGenerationScavenger>>manager:memory:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
  manager: aSpurMemoryManager memory: memoryArray newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
+ 	| edenBytes survivorBytes |
- 	| edenBytes edenLimit edenStart survivorBytes |
  	manager := aSpurMemoryManager.
  	memory := memoryArray.
  	edenBytes := requestedEdenBytes.
- 	edenStart := startAddress.
  	survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
  	edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
+ 	self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
+ 	"for tenuring we require older objects below younger objects.  since allocation
+ 	 grows up this means that the survivor spaces must preceed eden."
- 	edenLimit := edenStart + edenBytes roundUpTo: manager allocationUnit.
- 	self assert: totalBytes - (edenLimit - edenStart) - survivorBytes - survivorBytes < manager allocationUnit.
- 	eden := SpurNewSpaceSpace new.
  	pastSpace := SpurNewSpaceSpace new.
  	futureSpace := SpurNewSpaceSpace new.
+ 	eden := SpurNewSpaceSpace new.
+ 	pastSpace start: startAddress limit: startAddress + survivorBytes.
- 	eden start: edenStart limit: edenLimit.
- 	pastSpace start: edenLimit limit: edenLimit + survivorBytes.
  	futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
+ 	eden start: futureSpace limit limit: futureSpace limit + edenBytes.
  	self assert: futureSpace limit <= (startAddress + totalBytes).
  	self assert: eden start \\ manager allocationUnit
  				+ (eden limit \\ manager allocationUnit) = 0.
  	self assert: pastSpace start \\ manager allocationUnit
  				+ (pastSpace limit \\ manager allocationUnit) = 0.
  	self assert: futureSpace start \\ manager allocationUnit
  				+ (futureSpace limit \\ manager allocationUnit) = 0.
  	self initPastSpaceForObjectEnumeration.
  	manager initSpaceForAllocationCheck: eden!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') -----
  allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes
  	"Intialize the receiver for bootsraping an image.
  	 Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
  	 to allocate in oldSpace.  Later on (in initializePostBootstrap) freeStart and scavengeThreshold
  	 will be set to sane values."
  	<doNotGenerate>
  	self assert: (memoryBytes \\ self allocationUnit = 0
  				and: [newSpaceBytes \\ self allocationUnit = 0
  				and: [codeBytes \\ self allocationUnit = 0]]).
  	memory := (self endianness == #little
  					ifTrue: [LittleEndianBitmap]
  					ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4.
  	startOfMemory := codeBytes.
  	endOfMemory := memoryBytes + newSpaceBytes + codeBytes.
  	"leave newSpace empty for the bootstrap"
  	freeStart := newSpaceBytes + startOfMemory.
- 	newSpaceStart := startOfMemory.
  	newSpaceLimit := newSpaceBytes + startOfMemory.
  	scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array"
  	scavenger := SpurGenerationScavenger new
  					manager: self
  					memory: memory
+ 					newSpaceStart: startOfMemory
- 					newSpaceStart: newSpaceStart
  					newSpaceBytes: newSpaceBytes
  					edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"!

Item was added:
+ ----- Method: SpurMemoryManager>>classIndexOfHeader: (in category 'header access') -----
+ classIndexOfHeader: aHeader
+ 	<inline: true>
+ 	^aHeader bitAnd: self classIndexMask!

Item was added:
+ ----- Method: SpurMemoryManager>>classTableIndex (in category 'accessing') -----
+ classTableIndex
+ 	^classTableIndex!

Item was added:
+ ----- Method: SpurMemoryManager>>classTableIndex: (in category 'accessing') -----
+ classTableIndex: n
+ 	classTableIndex := n!

Item was added:
+ ----- Method: SpurMemoryManager>>classTableObjectsDo: (in category 'object enumeration') -----
+ classTableObjectsDo: aBlock
+ 	0 to: (self numSlotsOf: classTableRootObj) - 1 do:
+ 		[:i| | page |
+ 		page := self fetchPointer: i ofObject: classTableRootObj.
+ 		0 to: (self numSlotsOf: page) - 1 do:
+ 			[:j| | classOrNil |
+ 			classOrNil := self fetchPointer: j ofObject: page.
+ 			classOrNil ~= nilObj ifTrue:
+ 				[aBlock value: classOrNil]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>compactIndexOfClass: (in category 'class membership') -----
  compactIndexOfClass: objOop
+ 	self assert: (self rawHashBitsOf: objOop) ~= 0.
+ 	^self rawHashBitsOf: objOop!
- 	^self hashBitsOf: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>ensureBehaviorHash: (in category 'class table') -----
  ensureBehaviorHash: aBehavior
  	| newHash err |
+ 	<inline: true>
+ 	self assert: (self isImmediate: aBehavior) not.
+ 	(newHash := self rawHashBitsOf: aBehavior) = 0 ifTrue:
- 	self assert: (self isIntegerObject: aBehavior) not.
- 	(newHash := self hashBitsOf: aBehavior) = 0 ifTrue:
  		[(err := self enterIntoClassTable: aBehavior) ~= 0 ifTrue:
  			[^err negated].
+ 		 newHash := self rawHashBitsOf: aBehavior.
+ 		 self assert: (self classAtIndex: newHash) = aBehavior].
- 		 newHash := self hashBitsOf: aBehavior].
  	^newHash!

Item was added:
+ ----- Method: SpurMemoryManager>>firstValidIndexOfIndexableObject:withFormat: (in category 'indexing primitive support') -----
+ firstValidIndexOfIndexableObject: obj withFormat: fmt
+ 	"Answer the one-relative index of the first valid index in an indexbale object
+ 	 with the given format.  This is 1 for all objects except compiled methods
+ 	 where the first index is beyond the last literal.
+ 	 Used for safer bounds-checking on methods."
+ 	^fmt >= self firstCompiledMethodFormat
+ 		ifTrue: [coInterpreter firstByteIndexOfMethod: obj]
+ 		ifFalse: [1]!

Item was changed:
  ----- Method: SpurMemoryManager>>hashBitsOf: (in category 'header access') -----
  hashBitsOf: objOop
+ 	| hash |
+ 	hash := self rawHashBitsOf: objOop.
+ 	hash = 0 ifTrue:
+ 		["would like to assert
+ 			self assert: (coInterpreter addressCouldBeClassObj: objOop) not
+ 		  but instance-specific behaviors that are instances of themselves may
+ 		  fail this test."
+ 		 hash := self newObjectHash.
+ 		 self setHashBitsOf: objOop to: (hash bitAnd: self identityHashHalfWordMask)].
+ 	^hash!
- 	self flag: #endianness.
- 	^(self longAt: objOop + 4) bitAnd: self identityHashHalfWordMask!

Item was changed:
  ----- Method: SpurMemoryManager>>instantiateClass: (in category 'allocation') -----
  instantiateClass: classObj
  	| instSpec classFormat numSlots classIndex newObj |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	(self isFixedSizePointerFormat: instSpec) ifFalse:
  		[^nil].
+ 	classIndex := self ensureBehaviorHash: classObj.
+ 	classIndex < 0 ifTrue:
+ 		[coInterpreter primitiveFailFor: classIndex negated.
+ 		 ^nil].
- 	classIndex := self hashBitsOf: classObj.
- 	classIndex = 0 ifTrue:
- 		[(self enterIntoClassTable: classObj) ifFalse:
- 			[^nil].
- 		classIndex := self hashBitsOf: classObj].
  	numSlots := self fixedFieldsOfClassFormat: classFormat.
  	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: nilObj].
  	^newObj!

Item was added:
+ ----- Method: SpurMemoryManager>>isContextHeader: (in category 'header access') -----
+ isContextHeader: aHeader
+ 	<inline: true>
+ 	^(self classIndexOfHeader: aHeader) = ClassMethodContextCompactIndex!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	(#(	makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		addressCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		commonAt:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
+ 		checkIsStillMarriedContext:currentFP:
+ 		displayBitsOf:Left:Top:Right:Bottom:) includes: thisContext sender method selector) ifFalse:
- 		checkIsStillMarriedContext:currentFP:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was added:
+ ----- Method: SpurMemoryManager>>lastHash (in category 'accessing') -----
+ lastHash
+ 	^lastHash!

Item was added:
+ ----- Method: SpurMemoryManager>>lastHash: (in category 'accessing') -----
+ lastHash: seed
+ 	lastHash := seed!

Item was added:
+ ----- Method: SpurMemoryManager>>memory (in category 'accessing') -----
+ memory
+ 	^memory!

Item was added:
+ ----- Method: SpurMemoryManager>>newObjectHash (in category 'accessing') -----
+ newObjectHash
+ 	"Use simple algorithm by D.H. Lehmer from 1951, for now."
+ 	lastHash := lastHash * 16807 "7 raisedTo: 5" \\ 16r7ffffffd "(2 raisedTo: 31) - 1".
+ 	self assert: lastHash ~= 0.
+ 	^lastHash!

Item was added:
+ ----- Method: SpurMemoryManager>>rawHashBitsOf: (in category 'header access') -----
+ rawHashBitsOf: objOop
+ 	self flag: #endianness.
+ 	^(self longAt: objOop + 4) bitAnd: self identityHashHalfWordMask!

Item was changed:
  ----- Method: StackInterpreter>>displayBitsOf:Left:Top:Right:Bottom: (in category 'I/O primitives') -----
  displayBitsOf: aForm Left: l Top: t Right: r Bottom: b
  	"Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
  
  	| displayObj dispBits w h dispBitsIndex d left right top bottom surfaceHandle |
  	displayObj := objectMemory splObj: TheDisplay.
  	aForm = displayObj ifFalse: [^ nil].
  	self success: ((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]).
  	self successful ifTrue: [
  		dispBits := objectMemory fetchPointer: 0 ofObject: displayObj.
  		w := self fetchInteger: 1 ofObject: displayObj.
  		h := self fetchInteger: 2 ofObject: displayObj.
  		d := self fetchInteger: 3 ofObject: displayObj.
  	].
  	l < 0 ifTrue:[left := 0] ifFalse: [left := l].
  	r > w ifTrue: [right := w] ifFalse: [right := r].
  	t < 0 ifTrue: [top := 0] ifFalse: [top := t].
  	b > h ifTrue: [bottom := h] ifFalse: [bottom := b].
  	((left <= right) and: [top <= bottom]) ifFalse: [^nil].
  	self successful ifTrue: [
  		(objectMemory isIntegerObject: dispBits) ifTrue: [
  			surfaceHandle := objectMemory integerValueOf: dispBits.
  			showSurfaceFn = 0 ifTrue: [
  				showSurfaceFn := self ioLoadFunction: 'ioShowSurface' From: 'SurfacePlugin'.
  				showSurfaceFn = 0 ifTrue: [^self success: false]].
  			self cCode:'((sqInt (*)(sqInt, sqInt, sqInt, sqInt, sqInt))showSurfaceFn)(surfaceHandle, left, top, right-left, bottom-top)'.
  		] ifFalse: [
+ 			self assert: (objectMemory isNonImmediate: dispBits).
+ 			dispBitsIndex := dispBits + objectMemory baseHeaderSize.  "index in memory byte array"
- 			dispBitsIndex := dispBits + BaseHeaderSize.  "index in memory byte array"
  			self cCode: 'ioShowDisplay(dispBitsIndex, w, h, d, left, right, top, bottom)'
  				inSmalltalk: [self showDisplayBits: dispBitsIndex 
  								w: w h: h d: d
  								left: left right: right top: top bottom: bottom]
  		].
  	]!