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

commits at source.squeak.org commits at source.squeak.org
Wed Jul 31 22:34:42 UTC 2013


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

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

Name: VMMaker.oscog-eem.315
Author: eem
Time: 31 July 2013, 3:32:56.875 pm
UUID: edf4f6ec-fb34-404f-a50a-f3690c4f6dbb
Ancestors: VMMaker.oscog-eem.314

Copy 314 transferTo:from: fix to CoInterpreterMT.

Fix become for cog methods that are not paired with their
bytecoded methods (e.g. Newspeak accessors).

Eliminate dead code around contextInstructionPointer:context:.

Eliminate duplicate methodClass asserts in ce*(Send: and simplify
some in code compaction & code freeing.

Don't inline freeStackPage:

Slang:
Revise the inlining change.  Global vars passed as parameters must
not be read after any non-trivial call.

Use CCodeGenerator>>isAssertSelector: to check for all assert: calls
(these are not inlined).  hence fix assert:l: uses.

Add some more inlining selector breakpoint checks.

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

Item was changed:
  ----- Method: CCodeGenerator>>collectInlineList: (in category 'inlining') -----
  collectInlineList: inlineFlagOrSymbol
  	"Make a list of methods that should be inlined.  If inlineFlagOrSymbol == #asSpecified
  	 only inline methods marked with <inline: true>."
  	"Details: The method must not include any inline C, since the
  	 translator cannot currently map variable names in inlined C code.
  	 Methods to be inlined must be small or called from only one place."
  
  	| selectorsOfMethodsNotToInline callsOf |
  	self assert: (#(true false asSpecified) includes: inlineFlagOrSymbol).
  	selectorsOfMethodsNotToInline := Set new: methods size.
  	selectorsOfMethodsNotToInline addAll: macros keys.
  	methods do:
  		[:m|
  		m isStructAccessor ifTrue:
  			[selectorsOfMethodsNotToInline add: m selector]].
  
  	"build dictionary to record the number of calls to each method"
  	callsOf := Dictionary new: methods size * 2.
  	methods keysAndValuesDo:
+ 		[:s :m|
- 		[ :s :m |
  		m isRealMethod ifTrue: [callsOf at: s put: 0]].
  
  	"For each method, scan its parse tree once or twice to:
  		1. determine if the method contains unrenamable C code or declarations or has a C builtin
  		2. determine how many nodes it has
  		3. increment the sender counts of the methods it calls"
  	inlineList := Set new: methods size * 2.
  	(methods reject: [:m| selectorsOfMethodsNotToInline includes: m selector]) do:
+ 		[:m| | inlineIt hasUnrenamableCCode nodeCount |
+ 		breakSrcInlineSelector = m selector ifTrue:
+ 			[self halt].
- 		[ :m | | inlineIt hasUnrenamableCCode nodeCount  |
  		inlineIt := #dontCare.
  		(translationDict includesKey: m selector)
  			ifTrue: [hasUnrenamableCCode := true]
  			ifFalse:
  				[hasUnrenamableCCode := m hasUnrenamableCCode.
  				 nodeCount := 0.
  				 m parseTree nodesDo:
+ 					[:node|
- 					[ :node | | sel |
  					node isSend ifTrue:
+ 						[callsOf
+ 							at: node selector
+ 							ifPresent:
+ 								[:senderCount| callsOf at: node selector put: senderCount + 1]].
- 						[sel := node selector.
- 						 (callsOf at: sel ifAbsent: [ nil ]) ifNotNil:
- 							[:senderCount| callsOf at: sel put: senderCount + 1]].
  					 nodeCount := nodeCount + 1].
  				inlineIt := m extractInlineDirective].  "may be true, false, or #dontCare"
  		(hasUnrenamableCCode or: [inlineIt == false])
  			ifTrue: "don't inline if method has C code or contains negative inline directive"
  				[inlineIt == true ifTrue:
  					[logger
  						ensureCr;
  						nextPutAll: 'failed to inline ';
  						nextPutAll: m selector;
  						nextPutAll: ' as it contains unrenamable C declarations or C code';
  						cr; flush].
  				selectorsOfMethodsNotToInline add: m selector]
  			ifFalse:
  				[(inlineFlagOrSymbol == #asSpecified
  					ifTrue: [inlineIt == true]
  					ifFalse: [nodeCount < 40 or: [inlineIt == true]]) ifTrue:
  				"inline if method has no C code and is either small or contains inline directive"
  					[inlineList add: m selector]]].
  
  	inlineFlagOrSymbol ~~ #asSpecified ifTrue:
  		[callsOf associationsDo:
  			[:assoc|
  			(assoc value = 1
  			 and: [(selectorsOfMethodsNotToInline includes: assoc key) not]) ifTrue:
  				[inlineList add: assoc key]]]!

Item was changed:
  ----- Method: CCodeGenerator>>extractTypeFor:fromDeclaration: (in category 'utilities') -----
  extractTypeFor: aVariable fromDeclaration: aVariableDeclaration
  	"Eliminate inessentials from aVariableDeclaration to answer a C type without the variable,
  	 or initializations etc"
+ 	| decl fpIndex closeidx openidx |
- 	| decl fpIndex |
  	decl := aVariableDeclaration.
  	(decl beginsWith: 'static') ifTrue:
  		[decl := decl allButFirst: 6].
  	(decl indexOf: $= ifAbsent: []) ifNotNil:
  		[:index| decl := decl copyFrom: 1 to: index - 1].
  	decl := decl copyReplaceAll: aVariable with: '' tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]].
  	(fpIndex := decl indexOfSubCollection: '(*') > 0 ifTrue:
  		[decl := decl copyReplaceFrom: (decl indexOf: $( startingAt: fpIndex + 1)
  					to: (decl indexOf: $) startingAt: fpIndex + 1)
  					with: ''].
+ 	"collapse [size] to *"
+ 	openidx := 0.
+ 	[(openidx := decl indexOf: $[ startingAt: openidx + 1) > 0
+ 	 and: [(closeidx := decl indexOf: $] startingAt: openidx + 1) > 0]] whileTrue:
+ 		[decl := decl copyReplaceFrom: openidx to: closeidx with: '*'].
  	^decl withBlanksTrimmed!

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

Item was changed:
  ----- Method: CCodeGenerator>>mayInline: (in category 'inlining') -----
  mayInline: sel
+ 	"Answer if the method with the given selector may be inlined."
- 	"Answer true if the method with the given selector may be inlined."
  
+ 	^(self isAssertSelector: sel) not and: [inlineList includes: sel]!
- 	^sel ~~ #assert: and: [inlineList includes: sel]!

Item was changed:
  ----- Method: CCodeGenerator>>testInliningFor:as: (in category 'utilities') -----
  testInliningFor: selector as: inlineFlagOrSymbol
  	"Test inlining for the method with the given selector.
  	 Do all inlining first (cuz that's how the algorithm works.
  	 Then try and inline into a copy of the method.  This isn't
  	 exactly what happens in the real deal but is close enough."
  	| meth |
+ 	(breakDestInlineSelector = selector
+ 	or: [breakSrcInlineSelector = selector]) ifTrue:
+ 		[self halt].
  	meth := (self methodNamed: selector) copy.
  	self doBasicInlining: inlineFlagOrSymbol.
  	self halt.
  	meth tryToInlineMethodsIn: self!

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
+ 	| class canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication |
- 	| class canLinkCacheTag errSelIdx cogMethod newCogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	lkupClass := self superclassOf: mixinApplication.
  	class := objectMemory fetchClassOf: rcvr.
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	"We set the messageSelector and lkupClass for executeMethod below since things
  	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
  	messageSelector := selector.
  	lkupClass := self superclassOf: mixinApplication.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector class: lkupClass)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
+ 				self assert: false "NOTREACHED"]].
- 				"NOTREACHED"
- 				self assert: false]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
+ 		 cogMethod selector = objectMemory nilObject
+ 			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
+ 			ifFalse:
+ 				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
+ 				  selector.  If not, try and compile a new method with the correct selector."
+ 				 cogMethod selector ~= selector ifTrue:
+ 					[(cogit cog: newMethod selector: selector) ifNotNil:
+ 						[:newCogMethod| cogMethod := newCogMethod]]].
- 		 cogMethod selector = objectMemory nilObject ifTrue:
- 			[cogit setSelectorOf: cogMethod to: selector].
- 		 "Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
- 		  selector.  If not, try and compile a new method with the correct selector."
- 		 cogMethod selector ~= selector ifTrue:
- 			[self assert: (self methodClassAssociationOf: newMethod) = objectMemory nilObject.
- 			 newCogMethod := cogit cog: newMethod selector: selector.
- 			 newCogMethod ifNotNil:
- 				[cogMethod := newCogMethod]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
+ 		 self assert: false "NOTREACHED"].
- 		 self assert: false
- 		 "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') -----
  ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
+ 	| class canLinkCacheTag errSelIdx cogMethod |
- 	| class canLinkCacheTag errSelIdx cogMethod newCogMethod |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	superNormalBar = 0
  		ifTrue: [class := objectMemory fetchClassOf: rcvr]
  		ifFalse: [class := self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer))].
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	"We set the messageSelector and lkupClass for executeMethod below since things
  	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
  	messageSelector := selector.
  	lkupClass := class.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector class: class)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(errSelIdx := self lookupMethodNoMNUEtcInClass: class) ~= 0 ifTrue:
  				[(canLinkCacheTag
  				  and: [errSelIdx = SelectorDoesNotUnderstand
  				  and: [(cogMethod := cogit cogMNUPICSelector: messageSelector
  											methodOperand: (self mnuMethodOrNilFor: rcvr)
  											numArgs: argumentCount) asUnsignedInteger
  						> cogit minCogMethodAddress]]) ifTrue:
  						[cogit
  							linkSendAt: (stackPages longAt: stackPointer)
  							in: (self mframeHomeMethod: framePointer)
  							to: cogMethod
  							offset: (superNormalBar = 0
  									ifTrue: [cogit entryOffset]
  									ifFalse: [cogit noCheckEntryOffset])
  							receiver: rcvr].
  				self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: class.
+ 				self assert: false "NOTREACHED"]].
- 				"NOTREACHED"
- 				self assert: false]].
  	"Method found and has a cog method.  Attempt to link to it.  The receiver's class may be young.
  	 If the Cogit can't store young classes in inline caches we can link to an open PIC instead."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
+ 		 cogMethod selector = objectMemory nilObject
+ 			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
+ 			ifFalse:
+ 				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the
+ 				  correct selector.  If not, try and compile a new method with the correct selector."
+ 				 cogMethod selector ~= selector ifTrue:
+ 					[(cogit cog: newMethod selector: selector) ifNotNil:
+ 						[:newCogMethod| cogMethod := newCogMethod]]].
- 		 cogMethod selector = objectMemory nilObject ifTrue:
- 			[cogit setSelectorOf: cogMethod to: selector].
- 		 "Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
- 		  selector.  If not, try and compile a new method with the correct selector."
- 		 cogMethod selector ~= selector ifTrue:
- 			[self assert: (self methodClassAssociationOf: newMethod) = objectMemory nilObject.
- 			 newCogMethod := cogit cog: newMethod selector: selector.
- 			 newCogMethod ifNotNil:
- 				[cogMethod := newCogMethod]].
  		 (cogMethod selector = selector
  		  and: [canLinkCacheTag])
  			ifTrue:
  				[cogit
  					linkSendAt: (stackPages longAt: stackPointer)
  					in: (self mframeHomeMethod: framePointer)
  					to: cogMethod
  					offset: (superNormalBar = 0
  								ifTrue: [cogit entryOffset]
  								ifFalse: [cogit noCheckEntryOffset])
  					receiver: rcvr]
  			ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory"
  				[cogit
  					patchToOpenPICFor: selector
  					numArgs: numArgs
  					receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
+ 		 self assert: false "NOTREACHED"].
- 		 self assert: false
- 		 "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was removed:
- ----- Method: CoInterpreter>>contextInstructionPointer:context: (in category 'frame access') -----
- contextInstructionPointer: mcpc context: aContext
- 	"Answer a value to store in the InstructionPointer index of a context object for mcpc.
- 	 This is needed for cannotReturn: where we have the instructionPointer, the context
- 	 but not the cog method, and so don't know which method or block we're in.  Find it."
- 	<inline: false>
- 	| methodObj homeMethod cogMethod |
- 	<var: #homeMethod type: #'CogMethod *'>
- 	<var: #cogMethod type: #'CogBlockMethod *'>
- 	methodObj := objectMemory fetchPointer: MethodIndex ofObject: aContext.
- 	self assert: (self methodHasCogMethod: methodObj).
- 	homeMethod := self cogMethodOf: methodObj.
- 	cogMethod := cogit findEnclosingMethodFor: mcpc inHomeMethod: homeMethod.
- 	self assert: (cogMethod cmType = CMBlock)
- 				= ((objectMemory fetchPointer: ClosureIndex ofObject: aContext) ~= objectMemory nilObject).
- 	^self encodedNativePCOf: mcpc cogMethod: cogMethod!

Item was changed:
  ----- Method: CoInterpreterMT>>transferTo:from: (in category 'process primitive support') -----
  transferTo: newProc from: sourceCode
  	"Record a process to be awoken on the next interpreter cycle.  Override to
  	 potentially switch threads either if the new process is bound to another thread,
  	 or if there is no runnable process but there is a waiting thread. Note that the
  	 abort on no runnable process has beeen moved here from wakeHighestPriority."
  	| sched oldProc activeContext vmThread |
  	<inline: false>
  	<var: #vmThread type: #'CogVMThread *'>
  	statProcessSwitch := statProcessSwitch + 1.
  	self push: instructionPointer.
  	self externalWriteBackHeadFramePointers.
+ 	self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
+ 	"ensureMethodIsCogged: in makeBaseFrameFor: in
+ 	 externalSetStackPageAndPointersForSuspendedContextOfProcess:
+ 	 below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice."
+ 	instructionPointer := 0.
  	sched := self schedulerPointer.
  	oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
  	self recordContextSwitchFrom: oldProc in: sourceCode.
  	activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
  	objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
  
  	newProc isNil ifTrue:
  		["Two possibilities.  One, there is at least one thread waiting to own the VM in which
  		  case it should be activated.  Two, there are no processes to run and so abort."
  		 vmThread := self willingVMThread.
  		 (vmThread notNil and: [vmThread state = CTMWantingOwnership]) ifTrue:
  			[self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: sourceCode].
  		self error: 'scheduler could not find a runnable process'].
  
  	objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
  	objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject.
  
  	self threadSwitchIfNecessary: newProc from: sourceCode.
  
  	self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc!

Item was changed:
  ----- Method: CoInterpreterStackPages>>freeStackPage: (in category 'page access') -----
  freeStackPage: aPage "<InterpreterStackPage>"
  	"MRUP-->used page<->used page<->used page<->used page<--LRUP
  	               ^                        <-next-prev->                         ^
  	                |                                                                       |
  	                v                        <-prev-next->                         v
  	                free page<->free page<->free page<->free page"
  	<var: #aPage type: #'StackPage *'>
+ 	<inline: false>
  	self freeStackPageNoAssert: aPage.
  	self assert: self pageListIsWellFormed!

Item was changed:
  ----- Method: CogMethodZone>>compactCompiledCode: (in category 'compaction') -----
  compactCompiledCode: objectHeaderValue
  	| source dest bytes |
  	<var: #source type: #'CogMethod *'>
  	<var: #dest type: #'CogMethod *'>
  	source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
  	openPICList := nil.
  	methodCount := 0.
  	[source < self limitZony
  	 and: [source cmType ~= CMFree]] whileTrue:
  		[self assert: (cogit cogMethodDoesntLookKosher: source) = 0.
  		 source objectHeader: objectHeaderValue.
  		 source cmUsageCount > 0 ifTrue:
  			[source cmUsageCount: source cmUsageCount // 2].
  		 source cmType = CMOpenPIC ifTrue:
  			[source nextOpenPIC: openPICList asUnsignedInteger.
  			 openPICList := source].
  		 methodCount := methodCount + 1.
  		 source := self methodAfter: source].
  	source >= self limitZony ifTrue:
  		[^self halt: 'no free methods; cannot compact.'].
  	dest := source.
  	[source < self limitZony] whileTrue:
  		[self assert: (cogit maybeFreeCogMethodDoesntLookKosher: source) = 0.
  		 bytes := source blockSize.
  		 source cmType ~= CMFree ifTrue:
  			[methodCount := methodCount + 1.
  			 self mem: dest mo: source ve: bytes.
  			 dest objectHeader: objectHeaderValue.
  			 dest cmType = CMMethod
  				ifTrue:
+ 					["For non-Newspeak there should be a one-to-one mapping metween bytecoded and
+ 					  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
- 					["For non-Newspeak there should ne a one-to-one mapping metween bytecoded and
- 					  cog methods. For Newspeak not necessarily, but only for anonymous accessors."
- 					 self assert: ((coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
- 								or: [(cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject]).
  					"Only update the original method's header if it is referring to this CogMethod."
+ 					 (coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
+ 						ifTrue: [coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]
+ 						ifFalse: [self assert: (cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject]]
- 					 (coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger ifTrue:
- 						[coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]]
  				ifFalse:
  					[dest cmType = CMOpenPIC ifTrue:
  						[dest nextOpenPIC: openPICList asUnsignedInteger.
  						 openPICList := dest]].
  			 dest cmUsageCount > 0 ifTrue:
  				[dest cmUsageCount: dest cmUsageCount // 2].
  			 dest := coInterpreter
+ 								cCoerceSimple: dest asUnsignedInteger + bytes
- 								cCoerceSimple: dest asInteger + bytes
  								to: #'CogMethod *'].
  		 source := coInterpreter
+ 							cCoerceSimple: source asUnsignedInteger + bytes
- 							cCoerceSimple: source asInteger + bytes
  							to: #'CogMethod *'].
+ 	mzFreeStart := dest asUnsignedInteger.
- 	mzFreeStart := dest asInteger.
  	methodBytesFreedSinceLastCompaction := 0!

Item was changed:
  ----- Method: CogMethodZone>>findPreviouslyCompiledVersionOf:with: (in category 'accessing') -----
  findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop
+ 	"Newspeak uses a set of methods to implement accessors, a setter and a getter for
+ 	 each inst var offset (e.g. 0 to 255).  These accessors are installed under the relevant
+ 	 selectors in different method dictionaries as required.  These methods effectively
+ 	 have multiple selectors.  The current inline cache design stores the selector of a
+ 	 linked send in the header of the target method.  So this requires a one-to-many
+ 	 mapping of bytecoded method to cog method, with the bytecoded method referring
+ 	 directly to only one cog method, which will have a specific selector, not necessarily
+ 	 the right one.  It is therefore worth-while searching for a cog method on this method
+ 	 that has the right selector.
+ 	 We could revisit this:
+ 		- a send site could have two loads, one for the selector and one for the class,
+ 		  eliminating the need to store the selector in the header of a cog method
+ 		  (although it would still be needed in a PIC, because open PICs are shared)
+ 		- a set of unpaired cog methods could be maintained to speed up the search. since
+ 		  the methodHeader field is effectively unused in an unpaired method the list could
+ 		  link through this field (c.f. the openPICList linked through the methodObject field)."
  	<returnTypeC: #'CogMethod *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	((coInterpreter methodHasCogMethod: aMethodObj)
  	and: [(coInterpreter methodClassAssociationOf: aMethodObj) = objectMemory nilObject]) ifTrue:
  		[cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
  		[cogMethod < self limitZony] whileTrue:
  			[(cogMethod cmType = CMMethod
  			  and: [cogMethod selector = aSelectorOop
  			  and: [cogMethod methodObject = aMethodObj]]) ifTrue:
  				[^cogMethod].
  			 cogMethod := self methodAfter: cogMethod]].
  	^nil!

Item was changed:
  ----- Method: CogMethodZone>>freeMethod: (in category 'compaction') -----
  freeMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: false>
  	self assert: cogMethod cmType ~= CMFree.
  	self assert: (cogit cogMethodDoesntLookKosher: cogMethod) = 0.
  	cogMethod cmType = CMMethod ifTrue:
  		["For non-Newspeak there should ne a one-to-one mapping between bytecoded and
+ 		  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
- 		  cog methods. For Newspeak not necessarily, but only for anonymous accessors."
- 		 self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger
- 					or: [(cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject]).
  		"Only reset the original method's header if it is referring to this CogMethod."
+ 		 (coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger
+ 			ifTrue:
+ 				[coInterpreter rawHeaderOf: cogMethod methodObject put: cogMethod methodHeader]
+ 			ifFalse:
+ 				[self assert: (cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject].
- 		 (coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger ifTrue:
- 			[coInterpreter
- 				rawHeaderOf: cogMethod methodObject
- 				put: cogMethod methodHeader].
  		 cogMethod cmRefersToYoung: false].
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[self removeFromOpenPICList: cogMethod.
  		 cogMethod cmRefersToYoung: false].
  	cogMethod cmType: CMFree.
  	methodBytesFreedSinceLastCompaction := methodBytesFreedSinceLastCompaction
+ 												+ cogMethod blockSize!
- 											+ cogMethod blockSize!

Item was removed:
- ----- Method: Cogit>>findEnclosingMethodFor:inHomeMethod: (in category 'method map') -----
- findEnclosingMethodFor: mcpc inHomeMethod: cogMethod
- 	<var: #cogMethod type: #'CogMethod *'>
- 	<returnTypeC: #'CogBlockMethod *'>
- 	<api>
- 	"Find the CMMethod or CMBlock that encloses mcpc.
- 	 If the method contains blocks then, because block dispatch is not in order,
- 	 enumerate the block dispatch and find the nearest preceeding entry."
- 	self assert: cogMethod cmType = CMMethod.
- 	cogMethod blockEntryOffset = 0 ifTrue:
- 		[^self cCoerceSimple: cogMethod to: #'CogBlockMethod *'].
- 	maxMethodBefore := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'.
- 	self blockDispatchTargetsFor: cogMethod perform: #findMinAndMaxMethodsPC:around: arg: mcpc.
- 	^maxMethodBefore!

Item was removed:
- ----- Method: Cogit>>findMinAndMaxMethodsPC:around: (in category 'method map') -----
- findMinAndMaxMethodsPC: blockEntryPC around: mcpc
- 	<returnTypeC: #usqInt>
- 	(blockEntryPC asUnsignedInteger <= mcpc asUnsignedInteger
- 	and: [blockEntryPC asUnsignedInteger > maxMethodBefore asUnsignedInteger]) ifTrue:
- 		[maxMethodBefore := self cCoerceSimple: blockEntryPC - (self sizeof: CogBlockMethod)
- 								   to: #'CogBlockMethod *'].
- 	^0 "keep scanning..."!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForBecome
  	"Update all references to objects in machine code for a become.
  	 Unlike incrementalGC or fullGC a method that does not refer to young may
  	 refer to young as a result of the become operation.  Unlike incrementalGC
  	 or fullGC the reference from a Cog method to its methodObject *must not*
  	 change since the two are two halves of the same object."
  	| cogMethod hasYoungObj hasYoungObjPtr freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	hasYoungObj := false.
  	hasYoungObjPtr := self cCode: [(self addressOf: hasYoungObj) asInteger]
  							inSmalltalk: [CPluggableAccessor new
  											setObject: nil;
  											atBlock: [:obj :idx| hasYoungObj]
  											atPutBlock: [:obj :idx :val| hasYoungObj := val]].
  	codeModified := freedPIC := false.
  	self mapObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[self assert: hasYoungObj not.
  		 cogMethod cmType ~= CMFree ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 cogMethod selector: (objectRepresentation remapOop: cogMethod selector)..
  			 cogMethod cmType = CMClosedPIC
  				ifTrue:
  					[((objectMemory isYoung: cogMethod selector)
  					   or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
  						[freedPIC := true.
  						 methodZone freeMethod: cogMethod]]
  				ifFalse:
  					[(objectMemory isYoung: cogMethod selector) ifTrue:
  						[hasYoungObj := true].
  					 cogMethod cmType = CMMethod ifTrue:
  						[| remappedMethod |
  						 self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
- 						 self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
- 									or: [(self noAssertMethodClassAssociationOf: cogMethod methodObject)
- 											= objectMemory nilObject]).
  						 remappedMethod := objectRepresentation remapOop: cogMethod methodObject.
  						 remappedMethod ~= cogMethod methodObject ifTrue:
  							[(coInterpreter methodHasCogMethod: remappedMethod) ifTrue:
  								[self error: 'attempt to become two cogged methods'].
  							 (objectMemory
  									withoutForwardingOn: cogMethod methodObject
  									and: remappedMethod
  									with: cogMethod cmUsesPenultimateLit
  									sendToCogit: #method:hasSameCodeAs:checkPenultimate:) ifFalse:
  								[self error: 'attempt to become cogged method into different method'].
+ 							 "For non-Newspeak there should ne a one-to-one mapping between bytecoded and
+ 							  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
+ 							 "Only reset the method object's header if it is referring to this CogMethod."
+ 							 (coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
+ 								ifTrue:
+ 									[coInterpreter
+ 										rawHeaderOf: cogMethod methodObject
+ 										put: cogMethod methodHeader.
+ 									 cogMethod
+ 										methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
+ 										methodObject: remappedMethod.
+ 									 coInterpreter
+ 										rawHeaderOf: remappedMethod
+ 										put: cogMethod asInteger]
+ 								ifFalse:
+ 									[ self assert: (self noAssertMethodClassAssociationOf: cogMethod methodObject)
+ 													= objectMemory nilObject.
+ 									 cogMethod
+ 										methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
+ 										methodObject: remappedMethod]].
- 							 coInterpreter
- 								rawHeaderOf: cogMethod methodObject
- 								put: cogMethod methodHeader.
- 							 cogMethod
- 								methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
- 								methodObject: remappedMethod.
- 							 coInterpreter
- 								rawHeaderOf: remappedMethod
- 								put: cogMethod asInteger].
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: (self cppIf: NewspeakVM
  											ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
  											ifFalse: [#remapIfObjectRef:pc:hasYoung:])
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue:
  							[cogMethod cmRefersToYoung ifFalse:
  								[cogMethod cmRefersToYoung: true.
  								 methodZone addToYoungReferrers: cogMethod].
  							hasYoungObj := false]
  						ifFalse: [cogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	methodZone pruneYoungReferrers.
  	freedPIC ifTrue:
  		[self unlinkSendsToFree.
  		 codeModified := true].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
  		[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: TMethod>>checkForCompleteness:in: (in category 'inlining') -----
  checkForCompleteness: stmtLists in: aCodeGen
  	"Set the complete flag if none of the given statement list nodes contains further candidates for inlining."
  
  	complete := true.
  	stmtLists do:
+ 		[:stmtList|
- 		[ :stmtList |
  		stmtList statements do:
+ 			[:node|
- 			[ :node |
  			[(self inlineableSend: node in: aCodeGen) ifTrue:
  				[complete := false.  "more inlining to do"
  				^self]]]].
  
  	parseTree
  		nodesDo:
+ 			[:node|
+ 			(self inlineableFunctionCall: node in: aCodeGen) ifTrue:
- 			[ :n |
- 			(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
  				[complete := false.  "more inlining to do"
  				^self]]
  		unless:
+ 			[:node|
+ 			node isSend
+ 			and: [node selector == #cCode:inSmalltalk:
+ 				or: [aCodeGen isAssertSelector: node selector]]]!
- 			[ :n | n isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: n selector]]!

Item was changed:
  ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
  isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
  	"Answer true if the given parameter node is either a constant, a local variable, or a formal parameter of the receiver. Such parameter nodes may be substituted directly into the body of the method during inlining. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument."
  
+ 	| var madeNonTrivialCall |
- 	| var |
  	aNode isConstant ifTrue: [^true].
  
  	aNode isVariable ifTrue:
  		[var := aNode name.
  		((locals includes: var) or: [args includes: var]) ifTrue: [^true].
  		(#(self true false nil) includes: var) ifTrue: [^true].
+ 		"We can substitute any variable provided it is only read in the method being inlined,
+ 		 and if it is not read after any non-trivial call (which may update the variable)."
+ 		madeNonTrivialCall := false.
- 		"We can substitute any variable provided it is only read in the method being inlined."
  		(targetMeth isComplete
  		 and: [targetMeth parseTree noneSatisfy:
  				[:node|
+ 				 (node isSend
+ 				  and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
+ 					[madeNonTrivialCall := true].
+ 				 (madeNonTrivialCall and: [node isVariable and: [node name = argName]])
+ 				 or: [node isAssignment
+ 					  and: [node variable name = argName]]]]) ifTrue:
- 				node isAssignment and: [node variable name = argName]]]) ifTrue:
  			[^true].
  		(targetMeth maySubstituteGlobal: var in: aCodeGen) ifTrue: [^true]].
  
  	"For now allow literal blocks to be substituted.  They better be accessed only
  	 with value[:value:*] messages though!!"
  	aNode isStmtList ifTrue: [^true].
  
  	"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
  	aNode nodesDo: [ :node |
  		node isSend ifTrue: [
  			node isBuiltinOperator ifFalse: [^false].
  		].
  		node isVariable ifTrue: [
  			var := node name.
  			((locals includes: var) or:
  			 [(args includes: var) or:
  			 [(#(self true false nil) includes: var) or:
  			 [targetMeth maySubstituteGlobal: var in: aCodeGen]]]) ifFalse: [^false].
  		].
  		(node isConstant or: [node isVariable or: [node isSend]]) ifFalse: [^false].
  	].
  
  	^ true!

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.
- 	 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: [#(cCode:inSmalltalk: assert: asserta:) includes: node selector]].
- 	parseTree nodesDo:
- 		[ :node | 
- 		node isSend ifTrue:
- 			[node selector = #cCode:inSmalltalk: ifTrue:
- 				[node nodesDo:
- 					[:inStNode| stmtLists remove: inStNode 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 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].
  	didSomething := false.
  	sendsToInline := Dictionary new: 100.
  	parseTree
  		nodesDo:
+ 			[:node|
+ 			(self inlineableFunctionCall: node in: aCodeGen) ifTrue:
+ 				[sendsToInline at: node put: (self inlineFunctionCall: node in: aCodeGen)]]
- 			[ :n |
- 			(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
- 				[sendsToInline at: n put: (self inlineFunctionCall: n 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]]].
- 			[:n| n isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: n selector]].
  
  	sendsToInline isEmpty ifFalse:
  		[didSomething := true.
  		parseTree := parseTree replaceNodesIn: sendsToInline].
  
  	didSomething ifTrue:
  		[writtenToGlobalVarsCache := nil.
  		^didSomething].
  
+ 	stmtLists := self statementsListsForInliningIn: aCodeGen.
- 	stmtLists := self statementsListsForInlining.
  	stmtLists do:
+ 		[:stmtList|
- 		[ :stmtList | 
  		newStatements := OrderedCollection new: 100.
  		stmtList statements do:
+ 			[:stmt|
- 			[ :stmt |
  			(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
  				ifNil: [newStatements addLast: stmt]
  				ifNotNil: [:inlinedStmts|
  					didSomething := true.
  					newStatements addAllLast: inlinedStmts]].
  		stmtList setStatements: newStatements asArray].
  
  	didSomething ifTrue:
  		[writtenToGlobalVarsCache := nil.
  		^didSomething].
  
  	complete ifFalse:
  		[self checkForCompleteness: stmtLists in: aCodeGen.
  		 complete ifTrue: [ didSomething := true ]].  "marking a method complete is progress"
  	^didSomething!



More information about the Vm-dev mailing list