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

commits at source.squeak.org commits at source.squeak.org
Sat Mar 21 18:29:10 UTC 2015


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

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

Name: VMMaker.oscog-eem.1108
Author: eem
Time: 21 March 2015, 11:27:13.632 am
UUID: e4a2d953-eee6-4f93-939c-0bf28fbba1e2
Ancestors: VMMaker.oscog-tpr.1107

Merge in Nicolas' fixes for incorrect use of #|.
Change the time base in the CogVMSimulator to
use ByteCountsPerMicrosecond and have
stackLimitFromMachineCode poll every 2ms in
simulated time, according with default heartbeat.

=============== Diff against VMMaker.oscog-tpr.1107 ===============

Item was changed:
  CoInterpreterMT subclass: #CogVMSimulator
  	instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
+ 	classVariableNames: 'ByteCountsPerMicrosecond'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!
  
  !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0!
  This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.  Remember that you can test the Cogit using its class-side in-image compilation facilities.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(CogVMSimulator new openOn: Smalltalk imageName) test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image.
  
  Here's an example to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit))
  	desiredNumStackPages: 8;
  	openOn: '/Users/eliot/Cog/startreader.image';
  	openAsMorph;
  	run
  
  Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
  
  | cos proc opts |
  CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
  CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
  cos := CogVMSimulator new.
  "cos initializeThreadSupport." "to test the multi-threaded VM"
  cos desiredNumStackPages: 8. "to set the size of the stack zone"
  "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
  cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
  "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
  proc := cos cogit processor.
  "cos cogit sendTrace: 7." "turn on tracing"
  "set a complex breakpoint at a specific point in machine code"
  "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg|  cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
  "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
  "cos cogit setBreakMethod: 16rB38880."
  cos
  	openAsMorph;
  	"toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
  	halt;
  	run!

Item was changed:
  ----- Method: CogVMSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil
  	"The relevant ObjectMemory, Interpreter and Cogit classes must be initialized in order.
  	 This happens notionally every time we start the simulator,
  	 but in fact happens when ever we instantiate a simulator."
  	initializationOptions := optionsDictionaryOrArray isArray
  							ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
  							ifFalse: [optionsDictionaryOrArray].
  	(objectMemoryClassOrNil ifNil: [self objectMemoryClass])
  		initializeWithOptions: initializationOptions.
  
  	self initializeWithOptions: initializationOptions.
  
  	((initializationOptions at: #COGMTVM ifAbsent: [false])
  			ifTrue: [CoInterpreterMT]
  			ifFalse: [CoInterpreter])
  		initializeWithOptions: initializationOptions.
  
+ 	ByteCountsPerMicrosecond := initializationOptions
+ 										at: #ByteCountsPerMicrosecond
+ 										ifAbsent: [10].
+ 
  	(self cogitClass withAllSuperclasses copyUpTo: Cogit) reverseDo:
  		[:c| c initializeWithOptions: initializationOptions]!

Item was changed:
  ----- Method: CogVMSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
  ioRelinquishProcessorForMicroseconds: microseconds
  	"In the simulator give an indication that we're idling and check for input.
  	 If called from machine code then increment the byte count since the clock
  	 is derived from it and the clock will not advance otherwise.
  	 If we're simulating threading we're in difficulties.  We need a UI process
  	 (to run activities such as fill-in-the-blanks) but we also need an independent
  	 thread of control to run this VM thread.  So we need to fork a new UI process."
  	Display reverse: (0 at 0 extent: 16 at 16).
  	Sensor peekEvent ifNotNil:
  		[self forceInterruptCheck].
  	Processor activeProcess == Project uiProcess ifTrue:
  		[World doOneCycle].
  	microseconds >= 1000
  		ifTrue: [self isThreadedVM ifTrue:
  					[self forceInterruptCheckFromHeartbeat].
  				(Delay forMilliseconds: microseconds + 999 // 1000) wait]
  		ifFalse: [Processor yield].
+ 	byteCount := byteCount + (microseconds * ByteCountsPerMicrosecond) - 1.
- 	byteCount := byteCount + microseconds - 1.
  	self incrementByteCount!

Item was changed:
  ----- Method: CogVMSimulator>>ioUTCMicroseconds (in category 'I/O primitives support') -----
  ioUTCMicroseconds
  	"Return the value of the microsecond clock."
  	"NOT.  Actually, we want something a lot slower and, for exact debugging,
+ 	 something more repeatable than real time.  Dan had an idea: use the byteCount...
+ 	 We increment byteCount in stackLimitFromMachineCode and a real machine
+ 	 can easily run e.g. nfib at 6e7 / second, which this would be 1 usec ~= 60 byteCounts.
+ 	 Use 10 byteCounts per usec by default; see CogVMSimulator class>>initializeWithOptions:objectMemoryClass:"
- 	something more repeatable than real time.  Dan had an idea: use the byteCount..."
  
+ 	^byteCount // ByteCountsPerMicrosecond + startMicroseconds
- 	^byteCount + startMicroseconds
  	
+ 	"Dan:
+ 	 At 20k bytecodes per second, this gives us about 200 ticks per second, or about 1/5
+ 	 of what you'd expect for the real time clock.  This should still service events at one or
+ 	 two per second"!
- "At 20k bytecodes per second, this gives us aobut 200 ticks per second, or about 1/5 of what you'd expect for the real time clock.  This should still service events at one or two per second"!

Item was changed:
  ----- Method: CogVMSimulator>>stackLimitFromMachineCode (in category 'I/O primitives support') -----
  stackLimitFromMachineCode
+ 	"Intercept accesses to the stackLimit from machine code to increment byteCount so that
+ 	 ioMSecs/ioMicroseconds does something reasonable when we're purely in machine code.
+ 	 Force an interrupt check every 2 ms in simulated time (2ms = the default heartbeat), or if
+ 	 the profile tick has expired.."
+ 
+ 	(byteCount := byteCount + 1) - lastPollCount >= (2000 * ByteCountsPerMicrosecond) ifTrue:
+ 		[lastPollCount := byteCount].
+ 	(lastPollCount = byteCount
+ 	 or: [nextProfileTick > 0 and: [nextProfileTick <= self ioUTCMicroseconds]]) ifTrue:
+ 		[suppressHeartbeatFlag "gets set by selector breakpoints"
+ 			ifTrue: [self forceInterruptCheck]
+ 			ifFalse: [self forceInterruptCheckFromHeartbeat]].
- 	"Intercept accesses to the stackLimit from machine code to
- 	 increment byteCount so that ioMSecs/ioMicroseconds does
- 	 somethng reasonable when we're purely in machine code."
- 	(byteCount := byteCount + 1) - lastPollCount >= 100 ifTrue:
- 		[lastPollCount := byteCount.
- 		 ("Sensor peekEvent notNil" false
- 		  or: [nextProfileTick > 0
- 			  and: [nextProfileTick <= self ioUTCMicroseconds]]) ifTrue:
- 			[suppressHeartbeatFlag "gets set by selector breakpoints"
- 				ifTrue: [self forceInterruptCheck]
- 				ifFalse: [self forceInterruptCheckFromHeartbeat]]].
  	^stackLimit!

Item was changed:
  ----- Method: SpurMemoryManager>>checkOkayOop: (in category 'debug support') -----
  checkOkayOop: oop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class.
  	 Answer true if OK.  Otherwise print reason and answer false."
  	<api>
  	<var: #oop type: #usqInt>
  	| classIndex fmt unusedBits unusedBitsInYoungObjects |
  	<var: #unusedBits type: #usqLong>
  
  	"address and size checks"
  	(self isImmediate: oop) ifTrue: [^true].
  	(self addressCouldBeObj: oop) ifFalse:
  		[self print: 'oop '; printHex: oop; print: ' is not a valid address'. ^false].
  
  	(self oop: (self addressAfter: oop) isLessThanOrEqualTo: endOfMemory) ifFalse:
  		[self print: 'oop '; printHex: oop; print: ' size would make it extend beyond the end of memory'. ^false].
  
  	"header type checks"
  	(classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse:
  		[self print: 'oop '; printHex: oop; print: ' is a free chunk, or bridge, not an object'. ^false].
  	((self rawNumSlotsOf: oop) = self numSlotsMask
  	 and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue:
  		[self print: 'oop '; printHex: oop; print: ' header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false].
  
  	"format check"
  	fmt := self formatOf: oop.
  	(fmt = 6) | (fmt = 8) ifTrue:
  		[self print: 'oop '; printHex: oop; print: ' has an unknown format type'. ^false].
  	(fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue:
  		[self print: 'oop '; printHex: oop; print: ' has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false].
  
  	"specific header bit checks"
  	unusedBits := (1 << self classIndexFieldWidth)
+ 				   bitOr: (1 << (self identityHashFieldWidth + 32)).
- 				   | (1 << (self identityHashFieldWidth + 32)).
  	((self long64At: oop) bitAnd: unusedBits) ~= 0 ifTrue:
  		[self print: 'oop '; printHex: oop; print: ' has some unused header bits set; should be zero'. ^false].
  
  	unusedBitsInYoungObjects := self newSpaceRefCountMask.
  	((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue:
  		[self print: 'oop '; printHex: oop; print: ' has some header bits unused in young objects set; should be zero'. ^false].
  	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>newSpaceRefCountMask (in category 'gc - scavenging') -----
  newSpaceRefCountMask
  	"The three bit field { isGrey, isPinned, isRemembered } is for bits
  	 that are never set in young objects.  This allows the remembered
  	 table to be pruned when full by using these bits as a reference
  	 count of newSpace objects from the remembered table. Objects
  	 with a high count should be tenured to prune the remembered table."
+ 	^1 << self greyBitShift
+ 	  bitOr: (1 << self pinnedBitShift
+ 	  bitOr: 1 << self rememberedBitShift)!
- 	^ (1 << self greyBitShift)
- 	 | (1 << self pinnedBitShift)
- 	 | (1 << self rememberedBitShift)!

Item was changed:
  ----- Method: SpurMemoryManager>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| oop classIndex fmt unusedBits unusedBitsInYoungObjects |
  	<var: #oop type: #usqInt>
  	<var: #unusedBits type: #usqLong>
  	oop := self cCoerce: signedOop to: #usqInt.
  
  	"address and size checks"
  	(self isImmediate: oop) ifTrue: [^true].
  	(self addressCouldBeObj: oop) ifFalse:
  		[self error: 'oop is not a valid address'. ^false].
  
  	(self oop: (self addressAfter: oop) isLessThanOrEqualTo: endOfMemory) ifFalse:
  		[self error: 'oop size would make it extend beyond the end of memory'. ^false].
  
  	"header type checks"
  	(classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse:
  		[self error: 'oop is a free chunk, or bridge, not an object'. ^false].
  	((self rawNumSlotsOf: oop) = self numSlotsMask
  	 and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue:
  		[self error: 'oop header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false].
  
  	"format check"
  	fmt := self formatOf: oop.
  	(fmt = 6) | (fmt = 8) ifTrue:
  		[self error: 'oop has an unknown format type'. ^false].
  	(fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue:
  		[self error: 'oop has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false].
  
  	"specific header bit checks"
  	unusedBits := (1 << self classIndexFieldWidth)
+ 				   bitOr: (1 << (self identityHashFieldWidth + 32)).
- 				   | (1 << (self identityHashFieldWidth + 32)).
  	((self long64At: oop) bitAnd: unusedBits) ~= 0 ifTrue:
  		[self error: 'some unused header bits are set; should be zero'. ^false].
  
+ 	unusedBitsInYoungObjects := ((1 << self greyBitShift)
+ 								   bitOr: (1 << self pinnedBitShift))
+ 								   bitOr: (1 << self rememberedBitShift).
- 	unusedBitsInYoungObjects := (1 << self greyBitShift)
- 								   | (1 << self pinnedBitShift)
- 								   | (1 << self rememberedBitShift).
  	((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue:
  		[self error: 'some header bits unused in young objects are set; should be zero'. ^false].
  	^true
  !



More information about the Vm-dev mailing list