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

commits at source.squeak.org commits at source.squeak.org
Tue Apr 14 02:35:32 UTC 2015


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

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

Name: VMMaker.oscog-eem.1190
Author: eem
Time: 13 April 2015, 7:33:48.858 pm
UUID: f4e308b4-64a8-45d2-9bde-52d4dc64a850
Ancestors: VMMaker.oscog-eem.1189

Render the generated Slang for the new register
allocation code by adding a read-before-written
pass to C generation that initializes variables
read-before-written with 0 (the C equivalent of nil).

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

Item was changed:
  ----- Method: CCodeGenerator>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') -----
  emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag
  	"Emit C code for all methods in the code base onto the given stream. All inlined method calls should already have been expanded."
  
  	| verbose methodList |
  	"method preparation"
  	verbose := false.
  	self prepareMethods.
  	verbose ifTrue: [
  		self printUnboundCallWarnings.
  		self printUnboundVariableReferenceWarnings.
  		logger cr.
  	].
  	assertionFlag ifFalse: [ self removeAssertions ].
  	self doInlining: inlineFlag.
  
  	"code generation"
  	"If we're outputting the VM put the main interpreter loop first for two reasons.
  	 1, so that the dispdbg.h header included at the bytecode dispatch can define
  	 macros that affect all C code in the interpreter,  and 2, so that all primitive
  	 functions will come after and have relatively high addresses.  This provides safety
  	 in the use of primitiveFunctionPointer as a function pointer and an index by trying
  	 to ensure that primitives have addresses much higher than any indices."
  	methodList := self sortMethods: methods.
  	(methods includesKey: #interpret) ifTrue:
  		[methodList := { methods at: #interpret }, (methodList copyWithout: (methods at: #interpret))].
  	"clean out no longer valid variable names and then
  	 handle any global variable usage in each method"
+ 	methodList do: [:m | self checkForGlobalUsage: (m removeUnusedTempsAndNilIfRequiredIn: self) in: m].
- 	methodList do: [:m | self checkForGlobalUsage: (m removeUnusedTempsIn: self) in: m].
  	self localizeGlobalVariables.
  
  	self emitCHeaderOn: aStream.
  	self emitCTypesOn: aStream.
  	self emitCConstantsOn: aStream.
  	self emitCFunctionPrototypes: methodList on: aStream.
  	self emitCVariablesOn: aStream.
  	self emitCMacros: methodList on: aStream.
  	self emitCMethods: methodList on: aStream.
  	self emitExportsOn: aStream.
  !

Item was changed:
  ----- Method: TMethod>>emitInlineOn:level:generator: (in category 'C code generation') -----
  emitInlineOn: aStream level: level generator: aCodeGen
  	"Emit C code for this method onto the given stream. All calls to inlined methods should already have been expanded."
+ 	self removeUnusedTempsAndNilIfRequiredIn: aCodeGen.
- 	self removeUnusedTempsIn: aCodeGen.
  	sharedLabel ifNotNil:
  		[aStream crtab: level-1; nextPutAll: sharedLabel; nextPut: $:.
  		aStream crtab: level.
  		aStream nextPutAll: '/* '; nextPutAll: selector; nextPutAll: ' */'.
  		aStream crtab: level].
  	aStream nextPut: ${.
  	locals isEmpty ifFalse:
  		[(aCodeGen sortStrings: locals) do:
  			[:var|
  			 aStream
  				crtab: level+1;
  				nextPutAll: (self declarationAt: var);
  				nextPut: $;].
  			 aStream cr].
  	aStream crtab: level+1.
  	aCodeGen outputAsmLabel: selector on: aStream.
  	aStream crtab: level+1.
  	aCodeGen
  		pushScope: declarations
  		while: [parseTree emitCCodeOn: aStream level: level+1 generator: aCodeGen].
  	aStream tab: level; nextPut: $}!

Item was added:
+ ----- Method: TMethod>>findReadBeforeAssignedIn: (in category 'utilities') -----
+ findReadBeforeAssignedIn: variables
+ 	| readBeforeAssigned |
+ 	readBeforeAssigned := Set new.
+ 	parseTree
+ 		addReadBeforeAssignedIn: variables
+ 		to: readBeforeAssigned
+ 		assignments: Set new.
+ 	^readBeforeAssigned!

Item was added:
+ ----- Method: TMethod>>removeUnusedTempsAndNilIfRequiredIn: (in category 'utilities') -----
+ removeUnusedTempsAndNilIfRequiredIn: aCodeGen
+ 	"Remove all of the unused temps in this method. Answer a set of the references.
+ 	 As a side-effect introduce explicit temp := nil statements for temps that are
+ 	 tested for nil before necessarily being assigned."
+ 	| refs readBeforeAssigned |
+ 	refs := self removeUnusedTempsIn: aCodeGen.
+ 	"reset the locals to be only those still referred to"
+ 	locals := locals select: [:e| refs includes: e].
+ 	(locals notEmpty
+ 	 and: [(readBeforeAssigned := (self findReadBeforeAssignedIn: locals)) notEmpty]) ifTrue:
+ 		[readBeforeAssigned := readBeforeAssigned reject: [:v| (self declarationAt: v) beginsWith: 'extern'].
+ 		 parseTree statements addAllFirst:
+ 			(readBeforeAssigned asSortedCollection collect:
+ 				[:var|
+ 				TAssignmentNode new
+ 					setVariable: (TVariableNode new setName: var; yourself)
+ 					expression: (TConstantNode new setValue: 0; yourself)])].
+ 	^refs!

Item was added:
+ ----- Method: TStmtListNode>>addReadBeforeAssignedIn:to:assignments: (in category 'utilities') -----
+ addReadBeforeAssignedIn: variables to: readBeforeAssigned assignments: assigned
+ 	"Add any variables in variables that are read before written to readBeforeAssigned.
+ 	 Add unconditional assignments to assigned.  For convenience answer assigned."
+ 	self
+ 		nodesWithParentsDo:
+ 			[:node :parent|
+ 			(node isAssignment
+ 			 and: [variables includes: node variable name]) ifTrue:
+ 				[assigned add: node variable name].
+ 			(node isVariable
+ 			 and: [(variables includes: node name)
+ 			 and: [(assigned includes: node name) not
+ 			 and: [(parent notNil and: [parent isAssignment and: [parent variable == node]]) not]]]) ifTrue:
+ 				[readBeforeAssigned add: node name]]
+ 		unless:
+ 			[:node :parent| | conditionalAssignments mayHaveSideEffects |
+ 			node isSend
+ 				ifTrue:
+ 					["First deal with implicit assignments..."
+ 					node isValueExpansion ifTrue:
+ 						[assigned addAll: node receiver args].
+ 					(#(mem:cp:y: mem:mo:ve:) includes: node selector) ifTrue:
+ 						[assigned add: (node args first detect: [:subnode| subnode isVariable]) name].
+ 					(#(to:do: to:by:do:) includes: node selector) ifTrue:
+ 						[assigned addAll: (node args at: node selector numArgs) args.
+ 						 mayHaveSideEffects := node args size = 4. "See TMethod>>prepareMethodIn:"
+ 						 mayHaveSideEffects ifTrue:
+ 							[assigned add: node args last name]].
+ 					"Then deal with read-before-written in the arms of conditionals..."
+ 					(#(ifTrue: ifFalse: ifNil: ifNotNil:) intersection: node selector keywords) notEmpty
+ 						ifTrue:
+ 							["First find assignments in the expression..."
+ 							 (TStmtListNode new setStatements: {node receiver}; yourself)
+ 								addReadBeforeAssignedIn: variables
+ 								to: readBeforeAssigned
+ 								assignments: assigned.
+ 							 "Now find read-before-written in each arm, and collect the assignments to spot those assigned in both arms"
+ 							 conditionalAssignments :=
+ 								node args
+ 									collect:
+ 										[:block|
+ 										block isStmtList ifTrue:
+ 											[block
+ 												addReadBeforeAssignedIn: variables
+ 												to: readBeforeAssigned
+ 												assignments: assigned copy]]
+ 									thenSelect: [:each| each notNil].
+ 							 "add to assigned those variables written to in both arms"
+ 							 conditionalAssignments size = 2 ifTrue:
+ 								[conditionalAssignments := conditionalAssignments collect: [:set| set difference: assigned].
+ 								 assigned addAll: (conditionalAssignments first intersection: conditionalAssignments last)].
+ 							 true]
+ 						ifFalse:
+ 							[false]]
+ 				ifFalse:
+ 					[false]].
+ 	^assigned!



More information about the Vm-dev mailing list