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

commits at source.squeak.org commits at source.squeak.org
Fri Mar 7 01:40:28 UTC 2014


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

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

Name: VMMaker.oscog-eem.631
Author: eem
Time: 6 March 2014, 5:37:25.927 pm
UUID: 7865b135-ec18-4e75-afdd-3f2c9662b61b
Ancestors: VMMaker.oscog-eem.630

Spur:
Make sure adjustAllOopsBy: only sets bits in the classTableBitmap
for classes, not class index puns. 

Provide a free tree printer.

Typo.

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

Item was changed:
  ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') -----
  adjustAllOopsBy: bytesToShift
  	"Adjust all oop references by the given number of bytes. This is
  	 done just after reading in an image when the new base address
  	 of the object heap is different from the base address in the image,
  	 or when loading multiple segments that have been coalesced.  Also
  	 set bits in the classTableBitmap corresponding to used classes."
  
+ 	| obj classIndex |
- 	| obj |
  	self countNumClassPagesPreSwizzle: bytesToShift;
  		ensureAdequateClassTableBitmap.
  	(bytesToShift ~= 0
  	 or: [segmentManager numSegments > 1])
  		ifTrue:
  			[self assert: self newSpaceIsEmpty.
  			 obj := self objectStartingAt: oldSpaceStart.
  			 [self oop: obj isLessThan: freeOldSpaceStart] whileTrue:
+ 				[classIndex := self classIndexOf: obj.
+ 				 classIndex >= self isForwardedObjectClassIndexPun
+ 					ifTrue:
+ 						[classIndex > self lastClassIndexPun ifTrue:
+ 							[self inClassTableBitmapSet: classIndex].
+ 						 self swizzleFieldsOfObject: obj]
- 				[(self isFreeObject: obj)
- 					ifTrue: [self swizzleFieldsOfFreeChunk: obj]
  					ifFalse:
+ 						[classIndex = self isFreeObjectClassIndexPun ifTrue:
+ 							[self swizzleFieldsOfFreeChunk: obj]].
- 						[self inClassTableBitmapSet: (self classIndexOf: obj).
- 						 self swizzleFieldsOfObject: obj].
  				 obj := self objectAfter: obj]]
  		ifFalse:
  			[self assert: self newSpaceIsEmpty.
  			 obj := self objectStartingAt: oldSpaceStart.
  			 [self oop: obj isLessThan: endOfMemory] whileTrue:
+ 				[classIndex := self classIndexOf: obj.
+ 				 classIndex > self lastClassIndexPun ifTrue:
+ 					[self inClassTableBitmapSet: classIndex].
- 				[(self isFreeObject: obj) ifFalse:
- 					[self inClassTableBitmapSet: (self classIndexOf: obj)].
  				 obj := self objectAfter: obj]]!

Item was changed:
  ----- Method: SpurMemoryManager>>inClassTableBitmapSet: (in category 'class table') -----
  inClassTableBitmapSet: classIndex
  	| bit majorIndex |
+ 	self assert: (classIndex > self lastClassIndexPun and: [classIndex <= self classIndexMask]).
- 	self assert: (classIndex >= 0 and: [classIndex <= self classIndexMask]).
  	majorIndex := classIndex // BitsPerByte.
  	bit := 1 << (classIndex bitAnd: BitsPerByte - 1).
  	classTableBitmap
  		at: majorIndex
  		put: ((classTableBitmap at: majorIndex) bitOr: bit)!

Item was added:
+ ----- Method: SpurMemoryManager>>inOrderPrintFreeTree:printList: (in category 'debug printing') -----
+ inOrderPrintFreeTree: freeChunk printList: printNextList
+ 	"print free chunks in freeTree in order."
+ 	<api>
+ 	| next |
+ 	(next := self fetchPointer: self freeChunkSmallerIndex ofObject: freeChunk) ~= 0 ifTrue:
+ 		[self inOrderPrintFreeTree: next printList: printNextList].
+ 	self printFreeChunk: freeChunk isNextChunk: false.
+ 	printNextList ifTrue:
+ 		[next := freeChunk.
+ 		 [(next := self fetchPointer: self freeChunkNextIndex ofObject: next) ~= 0] whileTrue:
+ 			[coInterpreter tab.
+ 			 self printFreeChunk: next isNextChunk: true]].
+ 	(next := self fetchPointer: self freeChunkLargerIndex ofObject: freeChunk) ~= 0 ifTrue:
+ 		[self inOrderPrintFreeTree: next printList: printNextList]!

Item was changed:
  ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') -----
  printFreeChunk: freeChunk
  	<api>
+ 	self printFreeChunk: freeChunk isNextChunk: false!
- 	| numBytes |
- 	numBytes := self bytesInObject: freeChunk.
- 	coInterpreter
- 		print: 'freeChunk '; printHexPtrnp: freeChunk;
- 		print: ' bytes '; printNum: numBytes;
- 		print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
- 											ofFreeChunk: freeChunk).
- 	numBytes >= (self numFreeLists * self allocationUnit) ifTrue:
- 		[coInterpreter
- 			print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
- 											ofFreeChunk: freeChunk);
- 			print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
- 											ofFreeChunk: freeChunk);
- 			print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
- 											ofFreeChunk: freeChunk)].
- 	coInterpreter cr!

Item was added:
+ ----- Method: SpurMemoryManager>>printFreeChunk:isNextChunk: (in category 'debug printing') -----
+ printFreeChunk: freeChunk isNextChunk: isNextChunk
+ 	| numBytes |
+ 	numBytes := self bytesInObject: freeChunk.
+ 	coInterpreter
+ 		print: 'freeChunk '; printHexPtrnp: freeChunk;
+ 		print: ' bytes '; printNum: numBytes;
+ 		print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
+ 											ofFreeChunk: freeChunk).
+ 	(numBytes >= (self numFreeLists * self allocationUnit)
+ 	 and: [isNextChunk not]) ifTrue:
+ 		[coInterpreter
+ 			print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
+ 											ofFreeChunk: freeChunk);
+ 			print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
+ 											ofFreeChunk: freeChunk);
+ 			print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
+ 											ofFreeChunk: freeChunk)].
+ 	coInterpreter cr!

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'"vmCallback.h"';
  		addHeaderFile:'"sqMemoryFence.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	self declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: 'unsigned long'.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
  	self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory)
  		as: #'char *'
  		in: aCCodeGenerator.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  	 is not defined, for the benefit of the interpreter on slow machines."
  	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  	MULTIPLEBYTECODESETS == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'extA';
  			removeVariable: 'extB';
  			removeVariable: 'bytecodeSetSelector'].
  	aCCodeGenerator
  		var: #methodCache
  		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #atCache
  		declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', self primitiveTableString.
  	self primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	self objectMemoryClass hasSpurMemoryManagerAPI
  		ifTrue:
  			[aCCodeGenerator
  				var: #primitiveAccessorDepthTable
  				type: 'signed char'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  				array: self primitiveAccessorDepthTable]
  		ifFalse:
  			[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void (*primitiveFunctionPointer)()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #interruptCheckChain
  		declareC: 'void (*interruptCheckChain)(void) = 0'.
  	aCCodeGenerator
  		var: #breakSelector type: #'char *';
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = -1'.
  
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  								longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
+ 								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
- 								"these are high-frequency enough that tehy're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce)
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong!



More information about the Vm-dev mailing list