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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 30 20:34:09 UTC 2015


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

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

Name: VMMaker.oscog-eem.1485
Author: eem
Time: 30 September 2015, 1:32:27.435 pm
UUID: b5561be1-d4c9-4ae7-b09b-6e8b626d40da
Ancestors: VMMaker.oscog-rmacnak.1484

Simulator:
Fix bug in CogMethodSurrogate>>containsAddress: (argument shadows inst var).
Fix bug in BalloonEngineSimulation>>loadWordTransformFrom:into:length: (code disabled writing of values to both heap object and simArray).
Make sure that CogStackPage also checks its surrogate in initialize.
Add a run leak checker entry to the utilities menu in the VM simulators.

StackInterpreter: speeling errors
NSSendCache: categorization

=============== Diff against VMMaker.oscog-rmacnak.1484 ===============

Item was changed:
  ----- Method: BalloonEngineSimulation>>loadWordTransformFrom:into:length: (in category 'simulation') -----
  loadWordTransformFrom: transformOop into: destPtr length: n 
  	"Load a float array transformation from the given oop"
+ 	| srcPtr |
- 	| srcPtr wordDestPtr |
- 	false
- 		ifTrue: [^ super
- 				loadWordTransformFrom: transformOop
- 				into: destPtr
- 				length: n].
  	srcPtr := interpreterProxy firstIndexableField: transformOop.
+ 	"Use BalloonArray's float conversion shell.  It stores both the float bits into
+ 	 the heap object, and the float object into the simArray.  This is needed for
+ 	 correct simulation, otherwise there will be errors in BalloonArray>>floatAt:"
+ 	0 to: n - 1 do: [:i| destPtr at: i put: (srcPtr floatAt: i)]!
- 	wordDestPtr := destPtr as: CArrayAccessor.
- 	"Remove float conversion shell"
- 	0 to: n - 1
- 		do: [:i | wordDestPtr at: i put: (srcPtr floatAt: i) asIEEE32BitWord]
- !

Item was changed:
  ----- Method: CoInterpreter>>getCogVMFlags (in category 'internal interpreter access') -----
  getCogVMFlags
  	"Answer an array of flags indicating various properties of the Cog VM.
  	 These are the same as the image header flags shifted right two bits (excluding float order and full screen flags).
  	 Bit 0: specific to CoInterpreterMT
  	 Bit 1: if set, methods that are interpreted will have the flag bit set in their header
  	 Bit 2: if set, implies preempting a process does not put it to the back of its run queue
  	 Bit 3: specific to CoInterpreterMT
+ 	 Bit 4: if set, implies the new finalization scheme where WeakArrays are queued"
- 	 Bit 4: if set, implies preempting a process does not put it to the back of its run queue"
  	^objectMemory integerObjectOf: (flagInterpretedMethods ifTrue: [2] ifFalse: [0])
  									+ (preemptionYields ifTrue: [0] ifFalse: [4])
  									+ (newFinalization ifTrue: [16] ifFalse: [0])
  									+ (imageHeaderFlags >> 2 bitClear: 2 + 4 + 16)!

Item was changed:
  ----- Method: CoInterpreter>>setCogVMFlags: (in category 'internal interpreter access') -----
  setCogVMFlags: flags
  	"Set an array of flags indicating various properties of the Cog VM.
  	 Bit 0: if set, implies the image's Process class has threadId as its 3rd inst var (zero relative)
  	 Bit 1: if set, methods that are interpreted will have the flag bit set in their header
  	 Bit 2: if set, implies preempting a process does not put it to the back of its run queue
+ 	 Bit 3: if set, implies a threaded VM will not dosown the VM if owned by the GUI thread
+ 	 Bit 4: if set, implies the new finalization scheme where WeakArrays are queued"
- 	 Bit 3: if set, implies a threaded VM will not dosown the VM if owned by the GUI thread."
  	flags asUnsignedInteger > 31 ifTrue:
  		[^self primitiveFailFor: PrimErrUnsupported].
  	flagInterpretedMethods := (flags bitAnd: 2) ~= 0.
  	preemptionYields := (flags bitAnd: 4) = 0.
  	newFinalization := (flags bitAnd: 16) ~= 0!

Item was changed:
  ----- Method: CoInterpreterMT>>getCogVMFlags (in category 'internal interpreter access') -----
  getCogVMFlags
  	"Answer an array of flags indicating various properties of the Cog VM.
  	 These are the same as the image header flags shifted right two bits (excluding float order and full screen flags).
  	 Bit 0: implies the image's Process class has threadId as its 3rd inst var (zero relative)
  	 Bit 1: if set, methods that are interpreted will have the flag bit set in their header
  	 Bit 2: if set, implies preempting a process does not put it to the back of its run queue
  	 Bit 3: if set, implies the GUI will run on the first thread and event queues will not be accessed from other threads
+ 	 Bit 4: if set, implies the new finalization scheme where WeakArrays are queued"
- 	 Bit 4: if set, implies the new finalizartion scheme where WeakArrays are queued"
  	^objectMemory integerObjectOf: (processHasThreadId ifTrue: [1] ifFalse: [0])
  									+ (flagInterpretedMethods ifTrue: [2] ifFalse: [0])
  									+ (preemptionYields ifTrue: [0] ifFalse: [4])
  									+ (noThreadingOfGUIThread ifTrue: [8] ifFalse: [0])
  									+ (newFinalization ifTrue: [16] ifFalse: [0])
  									+ (imageHeaderFlags >> 2 bitClear: 1 + 2 + 4 + 8 + 16)!

Item was changed:
  ----- Method: CoInterpreterMT>>setCogVMFlags: (in category 'internal interpreter access') -----
  setCogVMFlags: flags
  	"Set an array of flags indicating various properties of the Cog VM.
  	 Bit 0: if set, implies the image's Process class has threadId as its 3rd inst var (zero relative)
  	 Bit 1: if set, methods that are interpreted will have the flag bit set in their header
  	 Bit 2: if set, implies preempting a process does not put it to the back of its run queue
+ 	 Bit 3: if set, implies a threaded VM will not dosown the VM if owned by the GUI thread
+ 	 Bit 4: if set, implies the new finalization scheme where WeakArrays are queued"
- 	 Bit 3: if set, implies a threaded VM will not dosown the VM if owned by the GUI thread."
  	flags asUnsignedInteger > 31 ifTrue:
  		[^self primitiveFailFor: PrimErrUnsupported].
  	processHasThreadId := (flags bitAnd: 1) ~= 0.
  	flagInterpretedMethods := (flags bitAnd: 2) ~= 0.
  	preemptionYields := (flags bitAnd: 4) = 0.
  	noThreadingOfGUIThread := (flags bitAnd: 8) ~= 0.
  	newFinalization := (flags bitAnd: 16) ~= 0!

Item was changed:
  ----- Method: CogMethod>>containsAddress: (in category 'testing') -----
+ containsAddress: anAddress
- containsAddress: address
  	<inline: true>
+ 	^self asUnsignedInteger <= anAddress asUnsignedInteger
+ 	  and: [self asUnsignedInteger + self blockSize >= anAddress asUnsignedInteger]!
- 	^self asUnsignedInteger <= address asUnsignedInteger
- 	  and: [self asUnsignedInteger + self blockSize >= address asUnsignedInteger]!

Item was changed:
  ----- Method: CogMethodSurrogate>>containsAddress: (in category 'testing') -----
+ containsAddress: anAddress
+ 	^address <= anAddress asUnsignedInteger
+ 	  and: [address + self blockSize >= anAddress asUnsignedInteger]!
- containsAddress: address
- 	"Simulation only; N.B. this will error if used on block method surrogates."
- 	^address <= address asUnsignedInteger
- 	  and: [address + self blockSize >= address asUnsignedInteger]!

Item was added:
+ ----- Method: CogStackPage class>>initialize (in category 'translation') -----
+ initialize
+ 	"self initialize"
+ 	(Smalltalk classNamed: #CogStackPageSurrogate32) ifNotNil:
+ 		[:csps32|
+ 		self checkGenerateSurrogate: csps32 bytesPerWord: 4].
+ 	(Smalltalk classNamed: #CogStackPageSurrogate64) ifNotNil:
+ 		[:csps64|
+ 		self checkGenerateSurrogate: csps64 bytesPerWord: 8]!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulationWindow;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
  											self writeBackHeadFramePointers];
  		addLine;
  		add: 'print rump C stack' action: [objectMemory printMemoryFrom: cogit processor sp to: self CStackPointer];
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action:
  			[cogit disassembleCodeAt: ((cogit methodZone methodFor: cogit processor pc) = 0
  											ifTrue: [instructionPointer]
  											ifFalse: [cogit processor pc])];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
+ 		add: 'run leak checker' action: [Cursor execute showWhile: [self runLeakChecker]];
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
  		add: 'print cog methods with selector...' action:
  			[|s| s := UIManager default request: 'selector'.
  			s notEmpty ifTrue:
  				[s = 'nil' ifTrue: [s := nil].
  				 cogMethodZone methodsDo:
  					[:m|
  					(s ifNil: [m selector = objectMemory nilObject]
  					 ifNotNil: [(objectMemory numBytesOf: m selector) = s size
  							and: [(self str: s
  									n: (m selector + objectMemory baseHeaderSize)
  									cmp: (objectMemory numBytesOf: m selector)) = 0]]) ifTrue:
  						[cogit printCogMethod: m]]]];
  		add: 'print cog method for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodFor: pc]];
  		add: 'print cog method header for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodHeaderFor: pc]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: 'click step' action: [cogit setClickStepBreakBlock];
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:theCogit| false]'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

Item was changed:
+ ----- Method: NSSendCache class>>initialize (in category 'class initialization') -----
- ----- Method: NSSendCache class>>initialize (in category 'as yet unclassified') -----
  initialize
  	"self initialize"
  	(Smalltalk classNamed: #NSSendCacheSurrogate32) ifNotNil:
  		[:scs32|
  		self checkGenerateSurrogate: scs32 bytesPerWord: 4].
  	(Smalltalk classNamed: #NSSendCacheSurrogate64) ifNotNil:
  		[:scs64|
  		self checkGenerateSurrogate: scs64 bytesPerWord: 8]!

Item was changed:
+ ----- Method: NSSendCache class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- ----- Method: NSSendCache class>>instVarNamesAndTypesForTranslationDo: (in category 'as yet unclassified') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  
  	self allInstVarNames do:
  		[:ivn| aBinaryBlock
  				value: ivn
  				value: #'sqInt']!

Item was changed:
  ----- Method: StackInterpreter>>getCogVMFlags (in category 'internal interpreter access') -----
  getCogVMFlags
  	"Answer an array of flags indicating various properties of the Cog VM.
  	 These are the same as the image header flags shifted right two bits (excluding float order and full screen flags).
  	 Bit 0: specific to CoInterpreterMT
  	 Bit 1: specific to CoInterpreter
  	 Bit 2: if set, implies preempting a process does not put it to the back of its run queue
  	 Bit 3: specific to CoInterpreterMT
+ 	 Bit 4: if set, implies the new finalization scheme where WeakArrays are queued"
- 	 Bit 4: if set, implies the new finalizartion scheme where WeakArrays are queued"
  	^objectMemory integerObjectOf: (preemptionYields ifTrue: [0] ifFalse: [4])
  									+ (newFinalization ifTrue: [16] ifFalse: [0])
  									+ (imageHeaderFlags >> 2 bitClear: 4 + 16)!

Item was added:
+ ----- Method: StackInterpreter>>runLeakChecker (in category 'simulation') -----
+ runLeakChecker
+ 	<doNotGenerate>
+ 	| oldCheckForLeaks |
+ 	oldCheckForLeaks := objectMemory checkForLeaks.
+ 	objectMemory setCheckForLeaks: -1.
+ 	[objectMemory runLeakCheckerFor: GCModeIncremental]
+ 		ensure:
+ 			[objectMemory setCheckForLeaks: oldCheckForLeaks]!

Item was changed:
  ----- Method: StackInterpreter>>setCogVMFlags: (in category 'internal interpreter access') -----
  setCogVMFlags: flags
  	"Set an array of flags indicating various properties of the Cog VM.
  	 Bit 2: if set, implies preempting a process does not put it to the back of its run queue
+ 	 Bit 4: if set, implies the new finalization scheme where WeakArrays are queued"
- 	 Bit 4: if set, implies the new finalizartion scheme where WeakArrays are queued"
  	flags asUnsignedInteger > 31 ifTrue:
  		[^self primitiveFailFor: PrimErrUnsupported].
  	preemptionYields := (flags bitAnd: 4) = 0.
  	newFinalization := (flags bitAnd: 16) ~= 0!

Item was changed:
  ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulationWindow;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		addLine;
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
+ 		add: 'run leak checker' action: [Cursor execute showWhile: [self runLeakChecker]];
  		add: 'inspect interpreter' action: #inspect;
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'turn valid exec ptrs assert o', (assertVEPAES ifTrue: ['ff'] ifFalse: ['n']) action: [assertVEPAES := assertVEPAES not];
  		add: (printSends
  				ifTrue: ['no print sends']
  				ifFalse: ['print sends'])
  			action: [self ensureDebugAtEachStepBlock.
  					printSends := printSends not];
  		"currently printReturns does nothing"
  		"add: (printReturns
  				ifTrue: ['no print returns']
  				ifFalse: ['print returns'])
  			action: [self ensureDebugAtEachStepBlock.
  					printReturns := printReturns not];"
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!



More information about the Vm-dev mailing list