[Vm-dev] VM Maker: VMMaker-dtl.340.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 13 00:29:42 UTC 2014


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.340.mcz

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

Name: VMMaker-dtl.340
Author: dtl
Time: 11 February 2014, 8:04:47.752 pm
UUID: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
Ancestors: VMMaker-dtl.339

VMMaker 4.13.2

For primitiveAllObjects, move the allObjects logic to ObjectMemory.

Incorporate various oscog code generation improvements, including code generation for sending #value: to a block, and elimination of unnecessary temp vars in inlining, for example, generate this:

	thisWord = long32At(sourceIndex);

instead of this:

	idx7 = sourceIndex;
	thisWord = long32At(idx7);

=============== Diff against VMMaker-dtl.339 ===============

Item was changed:
  ----- Method: BlockNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
  	"make a CCodeGenerator equivalent of me"
  	| statementList |
  	statementList := OrderedCollection new.
+ 	statements do:
+ 		[:s | | newS |
+ 		 newS := s asTranslatorNodeIn: aTMethod.
+ 		 "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed"
+ 		 newS isStmtList
+ 			ifTrue:  [statementList addAll: newS statements]
+ 			ifFalse: [statementList add: newS]].
+ 	^TStmtListNode new
+ 		setArguments: (arguments asArray collect: [:arg | arg key])
- 	statements
- 		do: [:s | | newS | 
- 			newS := s asTranslatorNodeIn: aTMethod.
- 			newS isStmtList
- 				ifTrue: ["inline the statement list returned when a CascadeNode is 
- 					translated "
- 					statementList addAll: newS statements]
- 				ifFalse: [statementList add: newS]].
- 	^ TStmtListNode new
- 		setArguments: (arguments asArray
- 				collect: [:arg | arg key])
  		statements: statementList;
+ 		comment: comment!
- 		 comment: comment!

Item was changed:
  Object subclass: #CCodeGenerator
+ 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations uncheckedAbstractMethods breakSrcInlineSelector breakDestInlineSelector'
- 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations uncheckedAbstractMethods'
  	classVariableNames: 'UseRightShiftForDivide'
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!
  
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was added:
+ ----- Method: CCodeGenerator>>breakDestInlineSelector (in category 'accessing') -----
+ breakDestInlineSelector
+ 	^breakDestInlineSelector!

Item was added:
+ ----- Method: CCodeGenerator>>breakDestInlineSelector: (in category 'accessing') -----
+ breakDestInlineSelector: aSelector
+ 	breakDestInlineSelector := aSelector!

Item was added:
+ ----- Method: CCodeGenerator>>breakSrcInlineSelector (in category 'accessing') -----
+ breakSrcInlineSelector
+ 	^breakSrcInlineSelector!

Item was added:
+ ----- Method: CCodeGenerator>>breakSrcInlineSelector: (in category 'accessing') -----
+ breakSrcInlineSelector: aSelector
+ 	breakSrcInlineSelector := aSelector!

Item was added:
+ ----- Method: CCodeGenerator>>generateValue:on:indent: (in category 'C translation') -----
+ generateValue: aTSendNode on: aStream indent: level
+ 	"Reduce [:formal ... :formalN| body ] value: actual ... value: actualN
+ 	 to body with formals substituted for by actuals."
+ 	| substitution substitutionDict newLabels |
+ 	self assert: aTSendNode receiver isStmtList.
+ 	self assert: aTSendNode receiver args size = aTSendNode args size.
+ 	substitution := aTSendNode receiver copy.
+ 	substitution renameLabelsForInliningInto: currentMethod.
+ 	substitutionDict := Dictionary new: aTSendNode args size * 2.
+ 	aTSendNode receiver args with: aTSendNode args do:
+ 		[ :argName :exprNode |
+ 		substitutionDict at: argName put: exprNode].
+ 	substitution
+ 		bindVariablesIn: substitutionDict;
+ 		emitCCodeOn: aStream level: level generator: self.
+ 	newLabels := Set withAll: currentMethod labels.
+ 	substitution nodesDo:
+ 		[:node| node isLabel ifTrue: [node label ifNotNil: [:label| newLabels add: label]]].
+ 	"now add the new labels so that a subsequent inline of
+ 	 the same block will be renamed with different labels."
+ 	currentMethod labels: newLabels!

Item was added:
+ ----- Method: CCodeGenerator>>generateValueAsArgument:on:indent: (in category 'C translation') -----
+ generateValueAsArgument: aTSendNode on: aStream indent: level
+ 	"Reduce [:formal ... :formalN| body ] value: actual ... value: actualN
+ 	 to body with formals substituted for by actuals."
+ 	| substitution substitutionDict newLabels |
+ 	self assert: aTSendNode receiver isStmtList.
+ 	self assert: aTSendNode receiver args size = aTSendNode args size.
+ 	substitution := aTSendNode receiver copy.
+ 	substitution renameLabelsForInliningInto: currentMethod.
+ 	substitutionDict := Dictionary new: aTSendNode args size * 2.
+ 	aTSendNode receiver args with: aTSendNode args do:
+ 		[ :argName :exprNode |
+ 		substitutionDict at: argName put: exprNode].
+ 	substitution
+ 		bindVariablesIn: substitutionDict;
+ 		emitCCodeAsArgumentOn: aStream level: level generator: self.
+ 	newLabels := Set withAll: currentMethod labels.
+ 	substitution nodesDo:
+ 		[:node| node isLabel ifTrue: [node label ifNotNil: [:label| newLabels add: label]]].
+ 	"now add the new labels so that a subsequent inline of
+ 	 the same block will be renamed with different labels."
+ 	currentMethod labels: newLabels!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:		#generateBitAnd:on:indent:
  	#bitOr:			#generateBitOr:on:indent:
  	#bitXor:		#generateBitXor:on:indent:
  	#bitShift:		#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert32:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 		#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#at:			#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#preprocessorExpression:	#generateInlineCppDirective:on:indent:
  	#isDefined:inSmalltalk:comment:ifTrue:	#generateInlineCppIfDef:on:indent:
  	#isDefined:inSmalltalk:comment:ifTrue:ifFalse:	#generateInlineCppIfDefElse:on:indent:
  	#isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse:	#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#signedIntFromLong			#generateSignedIntFromLong:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement				#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger			#generateAsUnsignedInteger:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  	#bytesPerWord		#generateBytesPerWord:on:indent:
  	#baseHeaderSize		#generateBaseHeaderSize:on:indent:
  
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
+ 	#value								#generateValue:on:indent:
+ 	#value:								#generateValue:on:indent:
+ 	#value:value:						#generateValue:on:indent:
+ 
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented				#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:				#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:			#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:		#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:		#generateIfFalseIfTrueAsArgument:on:indent:
  	#cCode:			#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:	#generateInlineCCodeAsArgument:on:indent:
+ 
+ 	#value					#generateValueAsArgument:on:indent:
+ 	#value:					#generateValueAsArgument:on:indent:
+ 	#value:value:			#generateValueAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was added:
+ ----- Method: CCodeGenerator>>isAssertSelector: (in category 'inlining') -----
+ isAssertSelector: selector
+ 	^#(assert: asserta: assert:l: asserta:l:) includes: selector!

Item was added:
+ ----- Method: CCodeGenerator>>selectorReturnsStruct: (in category 'C code generator') -----
+ selectorReturnsStruct: selector "<Symbol>"
+ 	| tMethod |
+ 	^(tMethod := methods
+ 					at: selector
+ 					ifAbsent:
+ 						[apiMethods ifNotNil:
+ 							[apiMethods at: selector ifAbsent: []]]) notNil
+ 	  and: [VMStructType isTypeStruct: tMethod returnType]!

Item was added:
+ ----- Method: CCodeGenerator>>wantsLabels (in category 'utilities') -----
+ wantsLabels
+ 	"Only label the VM, not plugins (internal or external).  This to cut down the scope
+ 	 of problems with labels being duplicated by C compiler optimizer inlining and
+ 	 loop unrolling.  We use the asmLabel: directive to control labelling in the
+ 	 interpreter proper. But it is too much work doing that for plugins too."
+ 	^vmClass notNil and: [vmClass wantsLabels]!

Item was added:
+ ----- Method: Interpreter class>>wantsLabels (in category 'translation') -----
+ wantsLabels
+ 	"Only label the VM, not plugins (internal or external).  This to cut down the scope
+ 	 of problems with labels being duplicated by C compiler optimizer inlining and
+ 	 loop unrolling.  We use the asmLabel: directive to control labelling in the
+ 	 interpreter proper. But it is too much work doing that for plugins too."
+ 	^true!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') -----
  primitiveAllObjects
+ 	"Answer an array of all objects that exist when the primitive
+ 	 is called, excluding those that may be garbage collected as
+ 	 a side effect of allocating the result array."
- 	"Answer an array of all objects that exist when the primitive is called, excluding those
- 	that may be garbage collected as a side effect of allocating the result array. The array
- 	will contain at least one trailing integer zero that serves as a marker for end of valid
- 	object references. Additional trailing zeros represent objects that were garbage
- 	collected during execution of this primitive. Sender is responsible for ignoring all
- 	trailing zero marker objects in the result array."
  
  	<export: true>
+ 	| result |
+ 	result := objectMemory allObjects.
+ 	result = 0 ifTrue:
- 	| count obj resultArray newCount |
- 	self pop: argumentCount+1.
- 	"Count the currently accessible objects"
- 	count := 0.
- 	obj := objectMemory firstAccessibleObject.
- 	[obj = nil] whileFalse:
- 		[count := count + 1.
- 		obj := objectMemory accessibleObjectAfter: obj].
- 	"Allocate result array, may cause GC"
- 	resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: count.
- 	resultArray = nil ifTrue:
  		[^self primitiveFailFor: PrimErrNoMemory].
+ 	self pop: argumentCount+1 thenPush: result!
- 	"Store all objects in result array, excluding any reference to the result array 
- 	itself, as may happen if garbage collection occurred during allocation of the array."
- 	newCount := 0.
- 	obj := objectMemory firstAccessibleObject.
- 	[obj = nil or: [newCount >= count]] whileFalse:
- 		[obj == resultArray
- 			ifFalse: [newCount := newCount + 1.
- 				self stObject: resultArray at: newCount put: obj ].
- 		obj := objectMemory accessibleObjectAfter: obj].
- 	"If GC occurred during result array allocation, truncate unused portion of result array"
- 	newCount < count
- 		ifTrue: [self shorten: resultArray toIndexableSize: newCount].
- 	self push: resultArray!

Item was added:
+ ----- Method: ObjectMemory>>allObjects (in category 'primitive support') -----
+ allObjects
+ 	"Attempt to answer an array of all objects, excluding those that may
+ 	be garbage collected as a side effect of allocating the result array.
+ 	If no memory is available answer 0."
+ 	| count obj resultArray newCount |
+ 	"Count the currently accessible objects"
+ 	count := 0.
+ 	obj := self firstAccessibleObject.
+ 	[obj = nil] whileFalse:
+ 		[count := count + 1.
+ 		obj := self accessibleObjectAfter: obj].
+ 	"Allocate result array, may cause GC"
+ 	resultArray := self instantiateClass: self classArray indexableSize: count.
+ 	resultArray = nil ifTrue:
+ 		[^0].
+ 	"Store all objects in result array, excluding any reference to the result array itself,
+ 	 as may happen if garbage collection occurred during allocation of the array. No store
+ 	 check is necessary; the result array will be the last object in memory and hence new."
+ 	newCount := 0.
+ 	obj := self firstAccessibleObject.
+ 	[obj = nil or: [newCount >= count]] whileFalse:
+ 		[obj == resultArray
+ 			ifFalse: [newCount := newCount + 1.
+ 				self stObject: resultArray at: newCount put: obj ].
+ 		obj := self accessibleObjectAfter: obj].
+ 	"If GC occurred during result array allocation, truncate unused portion of result array"
+ 	newCount < count ifTrue:
+ 		[self shorten: resultArray toIndexableSize: newCount].
+ 	^resultArray!

Item was added:
+ ----- Method: SlangTestSupportInterpreter class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
+ isNonArgumentImplicitReceiverVariableName: aString
+ 	^aString = 'objectMemory'
+ 		or: [super isNonArgumentImplicitReceiverVariableName: aString]
+ !

Item was added:
+ ----- Method: TAssignmentNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 
+ 	(cautionaryBlock value: self) ifTrue: [^self].
+ 	variable nodesDo: aBlock unless: cautionaryBlock.
+ 	expression nodesDo: aBlock unless: cautionaryBlock.
+ 	aBlock value: self.!

Item was added:
+ ----- Method: TCaseStmtNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 
+ 	(cautionaryBlock value: self) ifTrue: [^self].
+ 	expression nodesDo: aBlock unless: cautionaryBlock.
+ 	cases do: [ :c | c nodesDo: aBlock  unless: cautionaryBlock].
+ 	aBlock value: self!

Item was added:
+ ----- Method: TInlineNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 
+ 	(cautionaryBlock value: self) ifTrue: [^self].
+ 	method parseTree nodesDo: aBlock unless: cautionaryBlock.
+ 	aBlock value: self.!

Item was changed:
  Object subclass: #TMethod
+ 	instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels writtenToGlobalVarsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties cascadeVariableNumber extraVariableNumber'
- 	instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels possibleSideEffectsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties cascadeVariableNumber extraVariableNumber'
  	classVariableNames: 'CaseStatements'
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!
  
  !TMethod commentStamp: 'dtl 9/15/2008 09:06' prior: 0!
  A TMethod is a translation method, representing a MethodNode that is to be translated to C source. It has a parseTree of translation nodes that mirrors the parse tree of the corresponding Smalltalk method.!

Item was removed:
- ----- Method: TMethod>>addVarsDeclarationsAndLabelsOf: (in category 'inlining support') -----
- addVarsDeclarationsAndLabelsOf: methodToBeInlined
- 	"Prepare to inline the body of the given method into the receiver by making the args and locals of the argument to the receiver be locals of the receiver. Record any type declarations for these variables. Record labels. Assumes that the variables have already be renamed to avoid name clashes."
- 
- 	methodToBeInlined args, methodToBeInlined locals do: [ :v |
- 		(locals includes: v) ifFalse: [ locals addLast: v ].
- 	].
- 	methodToBeInlined declarations associationsDo: [ :assoc |
- 		declarations add: assoc.
- 	].
- 	methodToBeInlined labels do: [ :label |
- 		labels add: label.
- 	].!

Item was added:
+ ----- Method: TMethod>>addVarsDeclarationsAndLabelsOf:except: (in category 'inlining support') -----
+ addVarsDeclarationsAndLabelsOf: methodToBeInlined except: doNotRename
+ 	"Prepare to inline the body of the given method into the receiver by making the args and locals of the argument to the receiver be locals of the receiver. Record any type declarations for these variables. Record labels. Assumes that the variables have already be renamed to avoid name clashes."
+ 
+ 	locals
+ 		addAll: (methodToBeInlined args reject: [ :v | doNotRename includes: v]);
+ 		addAll: (methodToBeInlined locals reject: [ :v | doNotRename includes: v]).
+ 	methodToBeInlined declarations keysAndValuesDo:
+ 		[ :v :decl |
+ 		(doNotRename includes: v) ifFalse:
+ 			[self declarationAt: v put: decl]].
+ 
+ 	labels addAll: methodToBeInlined labels!

Item was removed:
- ----- Method: TMethod>>computePossibleSideEffectsIn: (in category 'inlining support') -----
- computePossibleSideEffectsIn: aCodeGen
- 	"Answer true if this method may have side effects. It has side effects if it assigns to a global variable. It may have side effects if it calls a non-built-in method."
- 
- 	parseTree nodesDo: [ :node |
- 		node isSend ifTrue: [
- 			node isBuiltinOperator ifFalse: [ ^true ].
- 		].
- 	].
- 	^ false!

Item was added:
+ ----- Method: TMethod>>computePossibleSideEffectsInto:visited:in: (in category 'inlining support') -----
+ computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen
+ 	"Add all variables written to by this method and its callees to writtenToVars.
+ 	 Avoid circularity via visitedSelectors"
+ 
+ 	(visitedSelectors includes: selector) ifTrue:
+ 		[^self].
+ 	visitedSelectors add: selector.
+ 	writtenToGlobalVarsCache ifNotNil:
+ 		[writtenToVars addAll: writtenToGlobalVarsCache.
+ 		 ^self].
+ 	parseTree nodesDo:
+ 		[ :node |
+ 			(node isAssignment
+ 			 and: [(locals includes: node variable name) not])
+ 				ifTrue:
+ 					[writtenToVars add: node variable name].
+ 			(node isSend
+ 			 and: [node isBuiltinOperator not
+ 			 and: [(node isStructSendIn: aCodeGen) not]]) ifTrue:
+ 				[(aCodeGen methodNamed: node selector) ifNotNil:
+ 					[:method|
+ 					 method
+ 						computePossibleSideEffectsInto: writtenToVars
+ 						visited: visitedSelectors
+ 						in: aCodeGen]]].
+ 	writtenToGlobalVarsCache := writtenToVars copy!

Item was added:
+ ----- Method: TMethod>>definedAsMacro (in category 'testing') -----
+ definedAsMacro
+ 	^properties notNil
+ 	  and: [properties includesKey: #cmacro:]!

Item was changed:
  ----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') -----
  inlineFunctionCall: aSendNode in: aCodeGen
+ 	"Answer the body of the called function, substituting the actual
+ 	 parameters for the formal argument variables in the method body.
+ 	 Assume caller has established that:
- 	"Answer the body of the called function, substituting the actual parameters for the formal argument variables in the method body."
- 	"Assume caller has established that:
  		1. the method arguments are all substitutable nodes, and
  		2. the method to be inlined contains no additional embedded returns."
  
+ 	| sel meth doNotRename argsForInlining substitutionDict |
- 	| sel meth substitutionDict |
  	sel := aSendNode selector.
  	meth := (aCodeGen methodNamed: sel) copy.
+ 	doNotRename := Set withAll: args.
+ 	argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen.
+ 	meth args with: argsForInlining do:
+ 		[ :argName :exprNode |
+ 		exprNode isLeaf ifTrue:
+ 			[doNotRename add: argName]].
+ 	meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen.
- 	meth renameVarsForInliningInto: self in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
+ 	self addVarsDeclarationsAndLabelsOf: meth except: doNotRename.
+ 	substitutionDict := Dictionary new: meth args size * 2.
+ 	meth args with: argsForInlining do:
+ 		[ :argName :exprNode |
- 	self addVarsDeclarationsAndLabelsOf: meth.
- 	substitutionDict := Dictionary new: 100.
- 	meth args with: aSendNode args do: [ :argName :exprNode |
  		substitutionDict at: argName put: exprNode.
+ 		(doNotRename includes: argName) ifFalse:
+ 			[locals remove: argName]].
- 		locals remove: argName.
- 		declarations removeKey: argName ifAbsent: []].
  	meth parseTree bindVariablesIn: substitutionDict.
+ 	^meth statements first expression!
- 	^ meth statements first expression!

Item was changed:
  ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') -----
  inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen
  	"Answer a collection of statments to replace the given send. directReturn indicates that the send is the expression of a return statement, so returns can be left in the body of the inlined method. If exitVar is nil, the value returned by the send is not used; thus, returns need not assign to the output variable."
  
  	| sel meth exitLabel labelUsed inlineStmts |
  	sel := aSendNode selector.
  	meth := (aCodeGen methodNamed: sel) copy.
  	meth renameVarsForInliningInto: self in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
+ 	self addVarsDeclarationsAndLabelsOf: meth except: #().
- 	self addVarsDeclarationsAndLabelsOf: meth.
  	meth hasReturn ifTrue: [
  		directReturn ifTrue: [
  			"propagate the return type, if necessary"
  			returnType = meth returnType ifFalse: [ self halt ].  "caller's return type should be declared by user"
  			returnType := meth returnType.
  		] ifFalse: [
  			exitLabel := self unusedLabelForInliningInto: self.
  			labelUsed := meth exitVar: exitVar label: exitLabel.
  			labelUsed
  				ifTrue: [ labels add: exitLabel ]
  				ifFalse: [ exitLabel := nil ].
  		].
  		"propagate type info if necessary"
  		((exitVar ~= nil) and: [meth returnType ~= 'sqInt']) ifTrue: [
  			declarations at: exitVar put: meth returnType, ' ', exitVar.
  		].
  	].
  	inlineStmts := OrderedCollection new: 100.
  	inlineStmts add: (TLabeledCommentNode new setComment: 'begin ', sel).
  	inlineStmts addAll:
  		(self argAssignmentsFor: meth args: aSendNode args in: aCodeGen).
  	inlineStmts addAll: meth statements.  "method body"
  	(directReturn and: [meth endsWithReturn not]) ifTrue: [
  		inlineStmts add: (TReturnNode new setExpression: (TVariableNode new setName: 'nil')).
  	].
  	exitLabel ~= nil ifTrue: [
  		inlineStmts add:
  			(TLabeledCommentNode new
  				setLabel: exitLabel comment: 'end ', meth selector).
  	].
  	^inlineStmts!

Item was changed:
  ----- Method: TMethod>>maySubstituteGlobal:in: (in category 'inlining support') -----
  maySubstituteGlobal: globalVar in: aCodeGen
+ 	"We can substitute globalVar into this method provided globalVar is only read, not written."
- 	"Answer true if this method does or may have side effects on the given global variable."
  
+ 	writtenToGlobalVarsCache = nil ifTrue:
+ 		[self computePossibleSideEffectsInto: (Set new: 50) visited: (Set new: 50) in: aCodeGen].
+ 	^(writtenToGlobalVarsCache includes: globalVar) not!
- 	possibleSideEffectsCache = nil ifTrue: [
- 		"see if this calls any other method and record the result"
- 		possibleSideEffectsCache := self computePossibleSideEffectsIn: aCodeGen.
- 	].
- 	possibleSideEffectsCache ifTrue: [ ^ false ].
- 
- 	parseTree nodesDo: [ :node |
- 		node isAssignment ifTrue: [
- 			node variable name = globalVar ifTrue: [ ^ false ].
- 		].
- 	].
- 
- 	"if we get here, receiver calls no other method
- 	 and does not itself assign to the given global variable"
- 	^ true!

Item was added:
+ ----- Method: TMethod>>maybeBreakFor:in: (in category 'inlining') -----
+ maybeBreakFor: aNode in: aCodeGen
+ 	"convenient for debugging..."
+ 	(aNode isSend
+ 	and: [(aCodeGen breakSrcInlineSelector notNil or: [aCodeGen breakDestInlineSelector notNil])
+ 	and: [(aCodeGen breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector])
+ 	and: [aCodeGen breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = selector]]]]) ifTrue:
+ 		[self halt: selector]!

Item was added:
+ ----- Method: TMethod>>renameVarsForInliningInto:except:in: (in category 'inlining support') -----
+ renameVarsForInliningInto: destMethod except: doNotRename in: aCodeGen
+ 	"Rename any variables that would clash with those of the destination method."
+ 
+ 	| destVars usedVars varMap newVarName |
+ 	destVars := aCodeGen globalsAsSet copy.
+ 	destVars addAll: destMethod locals.
+ 	destVars addAll: destMethod args.
+ 	usedVars := destVars copy.  "keeps track of names in use"
+ 	usedVars addAll: args; addAll: locals.
+ 	varMap := Dictionary new: 100.
+ 	locals, args do:
+ 		[ :v |
+ 		((doNotRename includes: v) not
+ 		  and: [destVars includes: v]) ifTrue:
+ 			[newVarName := self unusedNamePrefixedBy: v avoiding: usedVars.
+ 			varMap at: v put: newVarName]].
+ 	self renameVariablesUsing: varMap!

Item was removed:
- ----- Method: TMethod>>statementsListsForInlining (in category 'inlining') -----
- statementsListsForInlining
- 	"Answer a collection of statement list nodes that are candidates for inlining. Currently, we cannot inline into the argument blocks of and: and or: messages."
- 
- 	| stmtLists |
- 	stmtLists := OrderedCollection new: 10.
- 	parseTree nodesDo: [ :node | 
- 		node isStmtList ifTrue: [ stmtLists add: node ].
- 	].
- 	parseTree nodesDo: [ :node | 
- 		node isSend ifTrue: [
- 			((node selector = #and:) or: [node selector = #or:]) ifTrue: [
- 				"Note: the PP 2.3 compiler produces two arg nodes for these selectors"
- 				stmtLists remove: node args first ifAbsent: [].
- 				stmtLists remove: node args last ifAbsent: [].
- 			].
- 			((node selector = #ifTrue:) or: [node selector = #ifFalse:]) ifTrue: [
- 				stmtLists remove: node receiver ifAbsent: [].
- 			].
- 			((node selector = #ifTrue:ifFalse:) or: [node selector = #ifFalse:ifTrue:]) ifTrue: [
- 				stmtLists remove: node receiver ifAbsent: [].
- 			].
- 			((node selector = #whileFalse:) or: [node selector = #whileTrue:]) ifTrue: [
- 				"Allow inlining if it is a [...] whileTrue/whileFalse.
- 				This is identified by having more than one statement in the 
- 				receiver block in which case the C code wouldn't work anyways"
- 				node receiver statements size = 1
- 					ifTrue:[stmtLists remove: node receiver ifAbsent: []].
- 			].
- 			(node selector = #to:do:) ifTrue: [
- 				stmtLists remove: node receiver ifAbsent: [].
- 				stmtLists remove: node args first ifAbsent: [].
- 			].
- 			(node selector = #to:by:do:) ifTrue: [
- 				stmtLists remove: node receiver ifAbsent: [].
- 				stmtLists remove: node args first ifAbsent: [].
- 				stmtLists remove: node args second ifAbsent: [].
- 			].
- 		].
- 		node isCaseStmt ifTrue: [
- 			"don't inline cases"
- 			node cases do: [: case | stmtLists remove: case ifAbsent: [] ].
- 		].
- 	].
- 	^stmtLists!

Item was added:
+ ----- Method: TMethod>>statementsListsForInliningIn: (in category 'inlining') -----
+ statementsListsForInliningIn: aCodeGen
+ 	"Answer a collection of statement list nodes that are candidates for inlining.
+ 	 Currently, we cannot inline into the argument blocks of and: and or: messages.
+ 	 We do not want to inline code strings within cCode:inSmalltalk: blocks (those with a
+ 	 proper block for the cCode: argument are inlined in MessageNode>>asTranslatorNodeIn:).
+ 	 We do not want to inline code within assert: sends (because we want the assert to read nicely)."
+ 
+ 	| stmtLists |
+ 	stmtLists := OrderedCollection new: 10.
+ 	parseTree
+ 		nodesDo:
+ 			[:node|
+ 			node isStmtList ifTrue: [stmtLists add: node]]
+ 		unless:
+ 			[:node|
+ 			node isSend
+ 			and: [node selector == #cCode:inSmalltalk:
+ 				or: [aCodeGen isAssertSelector: node selector]]].
+ 	parseTree nodesDo:
+ 		[:node|
+ 		node isSend ifTrue:
+ 			[node selector = #cCode:inSmalltalk: ifTrue:
+ 				[node nodesDo:
+ 					[:ccisNode| stmtLists remove: ccisNode ifAbsent: []]].
+ 			 node selector = #cppIf:ifTrue:ifFalse: ifTrue:
+ 				[node args first nodesDo:
+ 					[:inCondNode| stmtLists remove: inCondNode ifAbsent: []]].
+ 			((node selector = #and:) or: [node selector = #or:]) ifTrue:
+ 				"Note: the PP 2.3 compiler produces two arg nodes for these selectors"
+ 				[stmtLists remove: node args first ifAbsent: [].
+ 				stmtLists remove: node args last ifAbsent: []].
+ 			(#(	#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:
+ 				#ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil: ) includes: node selector) ifTrue:
+ 				[stmtLists remove: node receiver ifAbsent: []].
+ 			(#(whileTrue whileTrue: whilefalse whileFalse:) includes: node selector) ifTrue:
+ 				"Allow inlining if it is a [...] whileTrue/whileFalse.
+ 				This is identified by having more than one statement in the 
+ 				receiver block in which case the C code wouldn't work anyways"
+ 				[node receiver statements size = 1 ifTrue:
+ 					[stmtLists remove: node receiver ifAbsent: []]].
+ 			(node selector = #to:do:) ifTrue:
+ 				[stmtLists remove: node receiver ifAbsent: [].
+ 				stmtLists remove: node args first ifAbsent: []].
+ 			(node selector = #to:by:do:) ifTrue:
+ 				[stmtLists remove: node receiver ifAbsent: [].
+ 				stmtLists remove: node args first ifAbsent: [].
+ 				stmtLists remove: node args second ifAbsent: []]].
+ 		node isCaseStmt ifTrue: "don't inline cases"
+ 			[node cases do: [:case| stmtLists remove: case ifAbsent: []]]].
+ 	^stmtLists!

Item was changed:
  ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
  tryToInlineMethodsIn: aCodeGen
  	"Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
  
+ 	| stmtLists didSomething newStatements sendsToInline |
+ 	self definedAsMacro ifTrue:
+ 		[complete := true.
+ 		 ^false].
- 	| stmtLists didSomething newStatements inlinedStmts sendsToInline |
  	didSomething := false.
- 
  	sendsToInline := Dictionary new: 100.
+ 	parseTree
+ 		nodesDo:
+ 			[:node|
+ 			(self inlineableFunctionCall: node in: aCodeGen) ifTrue:
+ 				[sendsToInline at: node put: (self inlineFunctionCall: node in: aCodeGen)]]
+ 		unless: "Don't inline the arguments to asserts to keep the asserts readable"
+ 			[:node|
+ 			node isSend
+ 			and: [node selector == #cCode:inSmalltalk:
+ 				or: [aCodeGen isAssertSelector: node selector]]].
- 	parseTree nodesDo: [ :n |
- 		(self inlineableFunctionCall: n in: aCodeGen) ifTrue: [
- 			sendsToInline at: n put: (self inlineFunctionCall: n in: aCodeGen).
- 		].
- 	].
- 	sendsToInline isEmpty ifFalse: [
- 		didSomething := true.
- 		parseTree := parseTree replaceNodesIn: sendsToInline.
- 	].
  
+ 	sendsToInline isEmpty ifFalse:
+ 		[didSomething := true.
+ 		parseTree := parseTree replaceNodesIn: sendsToInline].
- 	didSomething ifTrue: [
- 		possibleSideEffectsCache := nil.
- 		^didSomething
- 	].
  
+ 	didSomething ifTrue:
+ 		[writtenToGlobalVarsCache := nil.
+ 		^didSomething].
+ 
+ 	stmtLists := self statementsListsForInliningIn: aCodeGen.
+ 	stmtLists do:
+ 		[:stmtList|
- 	stmtLists := self statementsListsForInlining.
- 	stmtLists do: [ :stmtList | 
  		newStatements := OrderedCollection new: 100.
+ 		stmtList statements do:
+ 			[:stmt|
+ 			(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
+ 				ifNil: [newStatements addLast: stmt]
+ 				ifNotNil: [:inlinedStmts|
+ 					didSomething := true.
+ 					newStatements addAllLast: inlinedStmts]].
+ 		stmtList setStatements: newStatements asArray].
- 		stmtList statements do: [ :stmt |
- 			inlinedStmts := self inlineCodeOrNilForStatement: stmt in: aCodeGen.
- 			(inlinedStmts = nil) ifTrue: [
- 				newStatements addLast: stmt.
- 			] ifFalse: [
- 				didSomething := true.
- 				newStatements addAllLast: inlinedStmts.
- 			].
- 		].
- 		stmtList setStatements: newStatements asArray.
- 	].
  
+ 	didSomething ifTrue:
+ 		[writtenToGlobalVarsCache := nil.
+ 		^didSomething].
- 	didSomething ifTrue: [
- 		possibleSideEffectsCache := nil.
- 		^didSomething
- 	].
  
+ 	complete ifFalse:
+ 		[self checkForCompleteness: stmtLists in: aCodeGen.
+ 		 complete ifTrue: [ didSomething := true ]].  "marking a method complete is progress"
- 	complete ifFalse: [
- 		self checkForCompleteness: stmtLists in: aCodeGen.
- 		complete ifTrue: [ didSomething := true ].  "marking a method complete is progress"
- 	].
  	^didSomething!

Item was added:
+ ----- Method: TParseNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 	"Evaluate aBlock for all nodes in  the tree except those for which cautionaryBlock
+ 	 answers true or are children of those for which cautionaryBlock answers true."
+ 	(cautionaryBlock value: self) ifFalse:
+ 		[aBlock value: self]!

Item was added:
+ ----- Method: TReturnNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 
+ 	(cautionaryBlock value: self) ifTrue: [^self].
+ 	expression nodesDo: aBlock unless: cautionaryBlock.
+ 	aBlock value: self.!

Item was added:
+ ----- Method: TSendNode>>argumentsForInliningCodeGenerator: (in category 'inlining support') -----
+ argumentsForInliningCodeGenerator: aCodeGen
+ 	^(self shouldIncludeReceiverAsFirstArgument: aCodeGen)
+ 		ifTrue: [{receiver}, arguments]
+ 		ifFalse: [arguments]!

Item was added:
+ ----- Method: TSendNode>>isSelfReference:in: (in category 'C code generation') -----
+ isSelfReference: varNode in: aCodeGen
+ 	^(varNode name beginsWith: 'self')
+ 	  and: [varNode name = 'self' or: [varNode name beginsWith: 'self_in_']]!

Item was added:
+ ----- Method: TSendNode>>isStructReference:in: (in category 'C code generation') -----
+ isStructReference: varNode in: aCodeGen
+ 	^(varNode structTargetKindIn: aCodeGen) notNil!

Item was added:
+ ----- Method: TSendNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 
+ 	(cautionaryBlock value: self) ifTrue: [^self].
+ 	receiver nodesDo: aBlock unless: cautionaryBlock.
+ 	arguments do: [ :arg | arg nodesDo: aBlock unless: cautionaryBlock].
+ 	aBlock value: self.!

Item was changed:
  ----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') -----
  shouldExcludeReceiverAsFirstArgument: aCodeGen
  	"Only include the receiver as the first argument in certain cases.
  	 The receiver is always included if it is an expression.
  	 If it is a variable:
  		 If the vmClass says it is an implicit variable, don't include it.
  		 If the method's definingClass says it is an implicit variable, don't include it.
  		 If the variable is 'self' and the method being called is not in
+ 		 the method set (i.e. it is some external code), don't include it.
+ 		 If it is a struct send of something the vm says is an implicit variable, don't include it."
- 		 the method set (i.e. it is some external code), don't include it."
  	| m |
+ 	(aCodeGen isAssertSelector: selector) ifTrue:
+ 		[^true].
+ 
+ 	(receiver isSend
+ 	 and: [receiver receiver isVariable
+ 	 and: [(self isSelfReference: receiver receiver in: aCodeGen)
+ 		or: [self isStructReference: receiver receiver in: aCodeGen]]]) ifTrue:
+ 		[^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector].
+ 
  	^receiver isVariable
  	    and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name)
+ 		    or: [(self isSelfReference: receiver in: aCodeGen)
- 		    or: [(receiver name beginsWith: 'self')
- 			    and: [(receiver name = 'self' or: [receiver name beginsWith: 'self_in_'])
  			    and: [(m := aCodeGen methodNamed: selector) isNil
+ 					or: [m typeForSelf == #implicit]]]]!
- 					or: [m typeForSelf == #implicit]]]]]!

Item was added:
+ ----- Method: TStmtListNode>>nodesDo:unless: (in category 'enumerating') -----
+ nodesDo: aBlock unless: cautionaryBlock
+ 
+ 	(cautionaryBlock value: self) ifTrue: [^self].
+ 	statements do: [ :s | s nodesDo: aBlock unless: cautionaryBlock ].	
+ 	aBlock value: self!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.13.2'!
- 	^'4.13.1'!



More information about the Vm-dev mailing list