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

commits at source.squeak.org commits at source.squeak.org
Sat Nov 26 02:04:35 UTC 2016


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

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

Name: VMMaker.oscog-eem.2005
Author: eem
Time: 25 November 2016, 6:03:49.367116 pm
UUID: 27cfed36-5d69-48ea-87c2-ed2b87686075
Ancestors: VMMaker.oscog-eem.2004

RegisterAllocatingCogit & SistaCogit

Refactor StackToRegisterMappingCogit>>compileBlockBodies to eliminate SistaCogit>>compileBlockBodies (now stale because it was missing the literalsManager save/resetForBlockCompile sends)).

Refactor simStack printing to allow CogRASSBytecodeFixup>>printStateOn: to print its simStack on an arbitrary stream.

The only change in semantics:
I *think* RegisterAllocatingCogit>>ensureFixupAt: needs to set the mergeSimStack of a fixup if the fixup needsFixup and doesn't have a mergeSimStack.

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

Item was changed:
  ----- Method: CogRASSBytecodeFixup>>printSimStack (in category 'debug printing') -----
  printSimStack
  	<doNotGenerate>
  	self notAFixup ifFalse:
+ 		[cogit printSimStack: mergeSimStack toDepth: simStackPtr spillBase: -1 on: cogit coInterpreter transcript]!
- 		[cogit printSimStack: mergeSimStack toDepth: simStackPtr spillBase: -1]!

Item was added:
+ ----- Method: CogRASSBytecodeFixup>>printStateOn: (in category 'debug printing') -----
+ printStateOn: aStream
+ 	<doNotGenerate>
+ 	(targetInstruction isNil and: [simStackPtr isNil]) ifTrue:
+ 		[^self].
+ 	super printStateOn: aStream.
+ 	mergeSimStack ifNotNil:
+ 		[aStream skip: -1; space; nextPut: $(.
+ 		 cogit printSimStack: mergeSimStack toDepth: simStackPtr spillBase: -1 on: aStream.
+ 		 aStream nextPut: $); nextPut: $)]!

Item was changed:
  ----- Method: CogRegisterAllocatingSimStackEntry>>popToReg: (in category 'compile abstract instructions') -----
  popToReg: reg
- 	| inst |
  	<var: #inst type: #'AbstractInstruction *'>
  	liveRegister ~= NoReg
  		ifTrue: 
+ 			[self deny: spilled.
+ 			 reg ~= liveRegister
- 			[inst := reg ~= liveRegister
  				ifTrue: [cogit MoveR: liveRegister R: reg]
  				ifFalse: [cogit Label] ]
  		ifFalse: 
  			[spilled
  				ifTrue:
+ 					[cogit PopR: reg]
- 					[inst := cogit PopR: reg]
  				ifFalse:
  					[type caseOf: {
+ 						[SSBaseOffset]	-> [cogit MoveMw: offset r: register R: reg].
+ 						[SSConstant]	-> [cogit genMoveConstant: constant R: reg].
+ 						[SSRegister]	-> [reg ~= register
+ 												ifTrue: [cogit MoveR: register R: reg]
+ 												ifFalse: [cogit Label]] }]].
- 						[SSBaseOffset]	-> [inst := cogit MoveMw: offset r: register R: reg].
- 						[SSConstant]	-> [inst := cogit genMoveConstant: constant R: reg].
- 						[SSRegister]	-> [inst := reg ~= register
- 														ifTrue: [cogit MoveR: register R: reg]
- 														ifFalse: [cogit Label]] }]].
  	reg ~= TempReg ifTrue:
  		[liveRegister := reg.
  		 cogit observeLiveRegisterIn: self]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ensureFixupAt: (in category 'bytecode generator support') -----
  ensureFixupAt: targetIndex
  	| fixup |	
  	<var: #fixup type: #'BytecodeFixup *'>
  	fixup := self fixupAt: targetIndex.
  	fixup needsFixup 
+ 		ifTrue:
+ 			[fixup mergeSimStack
+ 				ifNil: [self setMergeSimStackOf: fixup]
+ 				ifNotNil: [self mergeCurrentSimStackWith: fixup mergeSimStack]]
- 		ifTrue: [self mergeCurrentSimStackWith: fixup mergeSimStack ]
  		ifFalse: 
  			[self assert: fixup mergeSimStack isNil.
  			self moveSimStackConstantsToRegisters.
  			self setMergeSimStackOf: fixup ].
  	^super ensureFixupAt: targetIndex.
  !

Item was changed:
  ----- Method: RegisterAllocatingCogit>>restoreSimStackAtMergePoint: (in category 'simulation stack') -----
  restoreSimStackAtMergePoint: fixup
  	<inline: true>
  	"All the execution paths reaching a merge point expect everything to be spilled
  	 on stack and the optStatus is unknown.  If the merge point follows a return, it
  	 isn't a merge, but a sdkip past a return.  If it is a real merge point then throw
  	 away all simStack and optStatus optimization state."
  	fixup mergeSimStack ifNotNil:
  		[simSpillBase := methodOrBlockNumTemps.
+ 		 self flag: 'try and maintain this through the merge'.
  		 optStatus isReceiverResultRegLive: false.
  		 0 to: simStackPtr do:
  			[:i|
  			self cCode: [simStack at: i put: (fixup mergeSimStack at: i)]
  				inSmalltalk: [(simStack at: i) copyFrom: (fixup mergeSimStack at: i)]]].
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>setMergeSimStackOf: (in category 'bytecode generator support') -----
  setMergeSimStackOf: fixup
  	<var: #fixup type: #'BytecodeFixup *'>
  	self assert: nextFixup <= numFixups.
  	self moveSimStackConstantsToRegisters.
  	self cCode: [fixup mergeSimStack: mergeSimStacksBase + (nextFixup * self simStackSlots * (self sizeof: CogSimStackEntry))].
+ 	fixup simStackPtr: simStackPtr.
  	nextFixup := nextFixup + 1.
  	self cCode: [self mem: fixup mergeSimStack cp: simStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [fixup mergeSimStack: self copySimStack]!

Item was removed:
- ----- Method: SistaCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
- compileBlockBodies
- 	"override to maintain counterIndex when recompiling blocks; sigh."
- 	<inline: false>
- 	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
- 	  initialStackPtr initialOpcodeIndex initialCounterIndex initialIndexOfIRC |
- 	<var: #blockStart type: #'BlockStart *'>
- 	self assert: blockCount > 0.
- 	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
- 	savedNeedsFrame := needsFrame.
- 	savedNumArgs := methodOrBlockNumArgs.
- 	savedNumTemps := methodOrBlockNumTemps.
- 	inBlock := InVanillaBlock.
- 	compiledBlocksCount := 0.
- 	[compiledBlocksCount < blockCount] whileTrue:
- 		[blockStart := self blockStartAt: compiledBlocksCount.
- 		 (result := self scanBlock: blockStart) < 0 ifTrue: [^result].
- 		 initialOpcodeIndex := opcodeIndex.
- 		 initialCounterIndex := counterIndex.
- 		 NewspeakVM ifTrue:
- 			[initialIndexOfIRC := indexOfIRC].
- 		 [self compileBlockEntry: blockStart.
- 		  initialStackPtr := simStackPtr.
- 		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
- 						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
- 			[^result].
- 		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
- 		   estimated the number of initial nils (because it assumed one or more pushNils to
- 		   produce an operand were pushNils to initialize temps.  This is very rare, so
- 		   compensate by checking, adjusting numInitialNils and recompiling the block body.
- 		   N.B.  No need to reinitialize the literalsManager because it answers existing literals."
- 		  initialStackPtr = simStackPtr]
- 			whileFalse:
- 				[self assert: initialStackPtr > simStackPtr.
- 				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
- 				 blockStart fakeHeader dependent: nil.
- 				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
- 					through: blockStart startpc + blockStart span - 1.
- 				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
- 									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
- 					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
- 									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
- 				 opcodeIndex := initialOpcodeIndex.
- 				 counterIndex := initialCounterIndex.
- 				 NewspeakVM ifTrue:
- 					[indexOfIRC := initialIndexOfIRC]].
- 		compiledBlocksCount := compiledBlocksCount + 1].
- 	needsFrame := savedNeedsFrame.
- 	methodOrBlockNumArgs := savedNumArgs.
- 	methodOrBlockNumTemps := savedNumTemps.
- 	^0!

Item was added:
+ ----- Method: SistaCogit>>maybeCounterIndex (in category 'compile abstract instructions') -----
+ maybeCounterIndex
+ 	<inline: true>
+ 	^counterIndex!

Item was added:
+ ----- Method: SistaCogit>>maybeSetCounterIndex: (in category 'compile abstract instructions') -----
+ maybeSetCounterIndex: value
+ 	<inline: true>
+ 	counterIndex := value!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
+ 	  initialStackPtr initialOpcodeIndex initialIndexOfIRC initialCounterIndex |
- 	  initialStackPtr initialOpcodeIndex initialIndexOfIRC |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
  	inBlock := InVanillaBlock.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
+ 		 (result := self scanBlock: blockStart) < 0 ifTrue: [^result].
- 		  (result := self scanBlock: blockStart) < 0 ifTrue: [^result].
  		 initialOpcodeIndex := opcodeIndex.
+ 		 initialCounterIndex := self maybeCounterIndex."for SistaCogit"
  		 literalsManager saveForBlockCompile.
  		 NewspeakVM ifTrue:
  			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body.
  		   N.B.  No need to reinitialize the literalsManager because it answers existing literals."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
  									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
+ 				 self maybeSetCounterIndex: initialCounterIndex. "For SistaCogit"
  				 literalsManager resetForBlockCompile.
  				 NewspeakVM ifTrue:
  					[indexOfIRC := initialIndexOfIRC]].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>maybeCounterIndex (in category 'compile abstract instructions') -----
+ maybeCounterIndex
+ 	"Hook for SistaCogit to allow it to reuse compileBlockBodies"
+ 	<inline: true>
+ 	^0!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>maybeSetCounterIndex: (in category 'compile abstract instructions') -----
+ maybeSetCounterIndex: value
+ 	"Hook for SistaCogit to allow it to reuse compileBlockBodies"
+ 	<inline: true>!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>printSimStack (in category 'simulation only') -----
  printSimStack
  	<doNotGenerate>
+ 	self printSimStack: simStack toDepth: simStackPtr spillBase: simSpillBase on: coInterpreter transcript!
- 	self printSimStack: simStack toDepth: simStackPtr spillBase: simSpillBase!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>printSimStack:toDepth:spillBase: (in category 'simulation only') -----
- printSimStack: aSimStack toDepth: limit spillBase: spillBase
- 	<doNotGenerate>
- 	coInterpreter transcript ensureCr.
- 	limit < 0 ifTrue:
- 		[^coInterpreter transcript nextPutAll: 'simStackEmpty'; cr; flush].
- 	0 to: limit do:
- 		[:i|
- 		coInterpreter transcript print: i.
- 		i = spillBase
- 			ifTrue: [coInterpreter transcript nextPutAll: ' sb'; tab]
- 			ifFalse: [coInterpreter transcript tab; tab].
- 		(aSimStack at: i) printStateOn: coInterpreter transcript.
- 		coInterpreter transcript cr; flush]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>printSimStack:toDepth:spillBase:on: (in category 'simulation only') -----
+ printSimStack: aSimStack toDepth: limit spillBase: spillBase on: aStream
+ 	<doNotGenerate>
+ 	aStream ensureCr.
+ 	limit < 0 ifTrue:
+ 		[^aStream nextPutAll: 'simStackEmpty'; cr; flush].
+ 	0 to: limit do:
+ 		[:i|
+ 		aStream print: i.
+ 		i = spillBase
+ 			ifTrue: [aStream nextPutAll: ' sb'; tab]
+ 			ifFalse: [aStream tab; tab].
+ 		(aSimStack at: i) printStateOn: aStream.
+ 		aStream cr; flush]!



More information about the Vm-dev mailing list