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

commits at source.squeak.org commits at source.squeak.org
Wed Jan 3 18:08:49 UTC 2018


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

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

Name: VMMaker.oscog-eem.2304
Author: eem
Time: 3 January 2018, 10:08:19.405856 am
UUID: 4ad967cb-31c8-40d8-968a-6e1954c3794d
Ancestors: VMMaker.oscog-eem.2303

Add a check for the knownClassIndex actually binding to a class in the relevant eeInstantiate routines.

Simulation:
Make sure the V3/SistaV1 hybrid is the default when creating a MULTIPLEBYTECODESETS Squeak/Pharo VM.

Add click step to the StackInterpreter.

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

Item was changed:
  ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'instantiation') -----
  eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots
  	"Instantiate an instance of a compact class.  ee stands for execution engine and
  	 implies that this allocation will *NOT* cause a GC.  N.B. the instantiated object
  	 IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
  	 call is used in routines that do just that we are safe.  Break this rule and die in GC.
  	 Result is guaranteed to be young."
  	<api>
  	<inline: true>
+ 	self assert: (numSlots >= 0 and: [knownClassIndex ~= 0 and: [(self knownClassAtIndex: knownClassIndex) ~= nilObj]]).
- 	self assert: (numSlots >= 0 and: [knownClassIndex ~= 0]).
  	self assert: (objFormat < self firstByteFormat
  					ifTrue: [objFormat]
  					ifFalse: [objFormat bitAnd: self byteFormatMask])
  				= (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
  	^self allocateNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex!

Item was changed:
  ----- Method: SpurMemoryManager>>eeInstantiateSmallClassIndex:format:numSlots: (in category 'instantiation') -----
  eeInstantiateSmallClassIndex: knownClassIndex format: objFormat numSlots: numSlots
  	"Instantiate a small instance of a compact class.  ee stands for execution engine and
  	 implies that this allocation will *NOT* cause a GC.  small implies the object will have
  	 less than 255 slots. N.B. the instantiated object IS NOT FILLED and must be completed
  	 before returning it to Smalltalk. Since this call is used in routines that do just that we
  	 are safe.  Break this rule and die in GC.  Result is guaranteed to be young."
  	<inline: true>
+ 	self assert: (numSlots >= 0 and: [knownClassIndex ~= 0 and: [(self knownClassAtIndex: knownClassIndex) ~= nilObj]]).
- 	self assert: (numSlots >= 0 and: [knownClassIndex ~= 0]).
  	self assert: (objFormat < self firstByteFormat
  					ifTrue: [objFormat]
  					ifFalse: [objFormat bitAnd: self byteFormatMask])
  				= (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
  	^self allocateSmallNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTable (in category 'initialization') -----
  initializeBytecodeTable
  	"StackInterpreter initializeBytecodeTable"
  
  	VMBytecodeConstants falsifyBytecodeSetFlags: initializationOptions.
  	BytecodeSetHasDirectedSuperSend := false.
  
  	(initializationOptions at: #bytecodeTableInitializer ifAbsent: nil) ifNotNil:
  		[:initalizer| ^self perform: initalizer].
  
  	NewspeakVM ifTrue:
  		[^MULTIPLEBYTECODESETS
  			ifTrue: [self initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid]
  			ifFalse: [self initializeBytecodeTableForNewspeakV4]].
  
+ 	^MULTIPLEBYTECODESETS
+ 		ifTrue: [self initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid]
+ 		ifFalse: [self initializeBytecodeTableForSqueakV3PlusClosures]!
- 	^self initializeBytecodeTableForSqueakV3PlusClosures!

Item was added:
+ ----- Method: StackInterpreterSimulator>>setClickStepBreakBlock (in category 'UI') -----
+ setClickStepBreakBlock
+ 	"Set the break block to present a confirmer, breaking if true, and restoring the previous break block.
+ 	 If an open debugger on the receiver can be found, proceed it."
+ 	<doNotGenerate>
+ 	| previousAtEachStepBlock |
+ 	(atEachStepBlock isNil or: [atEachStepBlock method ~~ thisContext method]) ifTrue:
+ 		[previousAtEachStepBlock := atEachStepBlock.
+ 		 atEachStepBlock :=
+ 							[previousAtEachStepBlock value.
+ 							 (UIManager confirm: 'step?') ifFalse:
+ 								[atEachStepBlock := previousAtEachStepBlock.
+ 								 self halt]]].
+ 	(World submorphs
+ 		detect:
+ 			[:m|
+ 			 m model class == Debugger
+ 			 and: [(m model interruptedProcess suspendedContext findContextSuchThat:
+ 					[:ctxt|
+ 					 ctxt receiver == self
+ 					 and: [ctxt selector == #run]]) notNil]]
+ 		ifNone: []) ifNotNil:
+ 			[:debuggerWindow|
+ 			 WorldState addDeferredUIMessage:
+ 				[debuggerWindow model proceed]]!

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]];
  		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 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: 'click step' action: [self setClickStepBreakBlock];
  		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