[Vm-dev] VM Maker: VMMaker.oscog-tpr.1335.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jun 4 00:51:39 UTC 2015


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tpr.1335.mcz

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

Name: VMMaker.oscog-tpr.1335
Author: tpr
Time: 3 June 2015, 5:49:55.408 pm
UUID: de4ebc16-0bda-42c8-b337-9d3b09f41627
Ancestors: VMMaker.oscog-eem.1334

Enable the magic MULL instruction on ARM.
Clean up flushICache usage

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

Item was changed:
  ----- Method: CoInterpreter>>defaultCogCodeSize (in category 'initialization') -----
  defaultCogCodeSize
  	"Return the default number of bytes to allocate for native code at startup.
  	 The actual value can be set via vmParameterAt: and/or a preference in the ini file."
  	<inline: false>
+ 	^1024 * 1400!
- 	^1024 * 1024!

Item was changed:
  ----- Method: CogARMCompiler>>canMulRR (in category 'testing') -----
  canMulRR
+ "we can do a MulRR be we can't simulate it correctly for some reason. More bug-fixing in the simulator one day"
  	<inline: true>
+ 	^true!
- 	^false!

Item was changed:
  ----- Method: Cogit>>ceSICMiss: (in category 'in-line cacheing') -----
  ceSICMiss: receiver
  	"An in-line cache check in a method has failed.  The failing entry check has jumped
  	 to the ceMethodAbort abort call at the start of the method which has called this routine.
  	 If possible allocate a closed PIC for the current and existing classes.
  	 The stack looks like:
  			receiver
  			args
  			sender return address
  	  sp=>	ceMethodAbort call return address
  	 So we can find the method that did the failing entry check at
  		ceMethodAbort call return address - missOffset
  	 and we can find the send site from the outer return address."
  	<api>
  	| pic innerReturn outerReturn entryPoint targetMethod newTargetMethodOrNil errorSelectorOrNil cacheTag extent result |
  	<var: #pic type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	<var: #callerMethod type: #'CogMethod *'>
  	"Whether we can relink to a PIC or not we need to pop off the inner return and identify the target method."
  	innerReturn := coInterpreter popStack asUnsignedInteger.
  	targetMethod := self cCoerceSimple: innerReturn - missOffset to: #'CogMethod *'.
  	(objectMemory isOopForwarded: receiver) ifTrue:
  		[^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  	outerReturn := coInterpreter stackTop asUnsignedInteger.
  	self assert: (outerReturn between: methodZoneBase and: methodZone freeStart).
  	entryPoint := backEnd callTargetFromReturnAddress: outerReturn.
  
  	self assert: targetMethod selector ~= objectMemory nilObject.
  	self cppIf: NewspeakVM ifTrue:
  		[| callerMethod annotation |
  		 self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
  		 callerMethod := coInterpreter mframeHomeMethod: coInterpreter getFramePointer.
  		 self assert: (outerReturn
  						between: callerMethod asUnsignedInteger + cmNoCheckEntryOffset
  						and: callerMethod asUnsignedInteger + callerMethod blockSize).
  		 annotation := self annotationForMcpc: outerReturn in: callerMethod.
  		 self assert: annotation >= IsSendCall.
  		 "Avoid the effort of implementing PICs for the relatively high dynamic frequency
  		  self send and simply rebind the send site (for now)."
  		 annotation = IsNSSelfSend ifTrue:
  			[^coInterpreter
  				ceSelfSend: targetMethod selector
  				to: receiver
  				numArgs: targetMethod cmNumArgs].
  		 "Avoid the effort of implementing PICs for the relatively low dynamic frequency
  		  dynamic super send and simply rebind the send site."
  		 annotation = IsNSDynamicSuperSend ifTrue:
  			[^coInterpreter
  				ceDynamicSuperSend: targetMethod selector
  				to: receiver
  				numArgs: targetMethod cmNumArgs]].
  	self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
  
  	self lookup: targetMethod selector
  		for: receiver
  		methodAndErrorSelectorInto:
  			[:method :errsel|
  			newTargetMethodOrNil := method.
  			errorSelectorOrNil := errsel].
  	"We assume lookupAndCog:for: will *not* reclaim the method zone"
  	self assert: outerReturn = coInterpreter stackTop.
  	cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
  	((errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
  	 or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
  	 or: [(backEnd inlineCacheTagAt: outerReturn) = self picAbortDiscriminatorValue
  	 or: [newTargetMethodOrNil isNil
  	 or: [objectMemory isYoung: newTargetMethodOrNil]]]]) ifTrue:
  		[result := self patchToOpenPICFor: targetMethod selector
  					numArgs: targetMethod cmNumArgs
  					receiver: receiver.
  		 self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
  		 ^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  	"See if an Open PIC is already available."
  	pic := methodZone openPICWithSelector: targetMethod selector.
  	pic isNil ifTrue:
  		["otherwise attempt to create a closed PIC for the two cases."
  		 pic := self cogPICSelector: targetMethod selector
  					numArgs: targetMethod cmNumArgs
  					Case0Method: targetMethod
  					Case1Method: newTargetMethodOrNil
  					tag: cacheTag
  					isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
  		 (pic asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  			["For some reason the PIC couldn't be generated, most likely a lack of code memory.
  			  Continue as if this is an unlinked send."
  			 pic asInteger = InsufficientCodeSpace ifTrue:
  				[coInterpreter callForCogCompiledCodeCompaction].
  			^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
+ 		 processor flushICacheFrom: pic asUnsignedInteger to: pic asUnsignedInteger + closedPICSize].
- 		 processor flushICacheFrom: pic asInteger to: pic asInteger + closedPICSize].
  	"Relink the send site to the pic.  If to an open PIC then reset the cache tag to the selector,
  	 for the benefit of the cacheTag assert check in checkIfValidObjectRef:pc:cogMethod:."
  	extent := pic cmType = CMOpenPIC
  				ifTrue:
  					[backEnd
  						rewriteInlineCacheAt: outerReturn
  						tag: targetMethod selector
  						target: pic asInteger + cmEntryOffset]
  				ifFalse:
  					[backEnd
  						rewriteCallAt: outerReturn
  						target: pic asInteger + cmEntryOffset].
+ 	processor flushICacheFrom: outerReturn  - extent to: outerReturn .
- 	processor flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1.
  	"Jump back into the pic at its entry in case this is an MNU (newTargetMethodOrNil is nil)"
  	coInterpreter
  		executeCogPIC: pic
  		fromLinkedSendWithReceiver: receiver
  		andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
  	"NOTREACHED"
  	^nil!

Item was changed:
  ----- Method: Cogit>>cogExtendPIC:CaseNMethod:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogExtendPIC: cPIC CaseNMethod: caseNMethod tag: caseNTag isMNUCase: isMNUCase
  	"Extend the cPIC with the supplied case.  If caseNMethod is cogged dispatch direct to
  	 its unchecked entry-point.  If caseNMethod is not cogged, jump to the fast interpreter
  	 dispatch, and if isMNUCase then dispatch to fast MNU invocation and mark the cPIC as
  	 having the MNU case for cache flushing."
   	<var: #cPIC type: #'CogMethod *'>
  	| operand target address size end |
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	coInterpreter
  		compilationBreak: cPIC selector
  		point: (objectMemory numBytesOf: cPIC selector)
  		isMNUCase: isMNUCase.
  	self allocateOpcodes: 5 bytecodes: 0.
  	methodLabel address: cPIC asUnsignedInteger; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
  	self assert: (objectRepresentation inlineCacheTagIsYoung: caseNTag) not.
  	"Caller patches to open pic if caseNMethod is young."
  	self assert: (caseNMethod notNil and: [(objectMemory isYoung: caseNMethod) not]).
  	(isMNUCase not
  	 and: [coInterpreter methodHasCogMethod: caseNMethod])
  		ifTrue:
  			[operand := 0.
  			 target := (coInterpreter cogMethodOf: caseNMethod) asInteger + cmNoCheckEntryOffset]
  		ifFalse:
  			[operand := caseNMethod.
  			 isMNUCase
  				ifTrue:
  					[cPIC cpicHasMNUCase: true.
  					 target := cPIC asInteger + (self sizeof: CogMethod)]
  				ifFalse:
  					[target := cPIC asInteger + self picInterpretAbortOffset]].
  	self CmpCw: caseNTag R: TempReg.
  	self MoveCw: operand R: SendNumArgsReg.
  	self JumpLongZero: target.
  	self MoveCw: cPIC asUnsignedInteger R: ClassReg.
  	self JumpLong: (self cPICMissTrampolineFor: cPIC cmNumArgs).
  	self computeMaximumSizes.
  	address := self addressOfEndOfCase: cPIC cPICNumCases - 1 inCPIC: cPIC.
  	size := self generateInstructionsAt: address.
  	end := self outputInstructionsAt: address.
+ 	processor flushICacheFrom: cPIC asUnsignedInteger to: cPIC asUnsignedInteger + closedPICSize.
- 	processor flushICacheFrom: cPIC asInteger to: cPIC asInteger + closedPICSize.
  	cPIC cPICNumCases: cPIC cPICNumCases + 1.
  	^0!

Item was changed:
  ----- Method: Cogit>>compactCogCompiledCode (in category 'jit - api') -----
  compactCogCompiledCode
  	<api>
  	self assert: self noCogMethodsMaximallyMarked.
  	coInterpreter markActiveMethodsAndReferents.
  	methodZone freeOlderMethodsForCompaction.
  	self freePICsWithFreedTargets.
  	methodZone planCompaction.
  	coInterpreter updateStackZoneReferencesToCompiledCodePreCompaction.
  	self relocateMethodsPreCompaction.
  	methodZone compactCompiledCode.
  	self assert: self allMethodsHaveCorrectHeader.
  	self assert: methodZone kosherYoungReferrers.
+ 	processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart asUnsignedInteger!
- 	processor flushICacheFrom: methodZoneBase to: methodZone freeStart!

Item was changed:
  ----- Method: Cogit>>generateCaptureCStackPointers: (in category 'initialization') -----
  generateCaptureCStackPointers: captureFramePointer
  	"Generate the routine that writes the current values of the C frame and stack pointers into
  	 variables.  These are used to establish the C stack in trampolines back into the C run-time.
  
  	 This is a presumptuous quick hack for x86.  It is presumptuous for two reasons.  Firstly
  	 the system's frame and stack pointers may differ from those we use in generated code,
  	 e.g. on register-rich RISCs.  Secondly the ABI may not support a simple frameless call
  	 as written here (for example 128-bit stack alignment on Mac OS X)."
  	| startAddress |
  	<inline: false>
  	self allocateOpcodes: 32 bytecodes: 0.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	startAddress := methodZoneBase.
  	captureFramePointer ifTrue:
  		[self MoveR: FPReg Aw: self cFramePointerAddress].
  	"Capture the stack pointer prior to the call."
  	backEnd leafCallStackPointerDelta = 0
  		ifTrue: [self MoveR: SPReg Aw: self cStackPointerAddress]
  		ifFalse: [self MoveR: SPReg R: TempReg.
  				self AddCq: backEnd leafCallStackPointerDelta R: TempReg.
  				self MoveR: TempReg Aw: self cStackPointerAddress].
  	self RetN: 0.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
+ 	processor flushICacheFrom: startAddress asUnsignedInteger to: methodZoneBase asUnsignedInteger.
- 	processor flushICacheFrom: startAddress to: methodZoneBase.
  	self recordGeneratedRunTime: 'ceCaptureCStackPointers' address: startAddress.
  	ceCaptureCStackPointers := self cCoerceSimple: startAddress to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>generateTrampolines (in category 'initialization') -----
  generateTrampolines
  	"Generate the run-time entries and exits at the base of the native code zone and update the base.
  	 Read the class-side method trampolines for documentation on the various trampolines"
  	| methodZoneStart |
  	methodZoneStart := methodZoneBase.
  	methodLabel address: methodZoneStart.
  	self allocateOpcodes: 80 bytecodes: 0.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	hasYoungReferent := false.
  	self generateSendTrampolines.
  	self generateMissAbortTrampolines.
  	objectRepresentation generateObjectRepresentationTrampolines.
  	self generateRunTimeTrampolines.
  	self cppIf: NewspeakVM ifTrue: 	[self generateNewspeakRuntime].
  	self cppIf: SistaVM ifTrue: [self generateSistaRuntime].
  	self generateEnilopmarts.
  	self generateTracingTrampolines.
  
  	"finish up"
  	self recordGeneratedRunTime: 'methodZoneBase' address: methodZoneBase.
+ 	processor flushICacheFrom: methodZoneStart asUnsignedInteger to: methodZoneBase asUnsignedInteger!
- 	processor flushICacheFrom: methodZoneStart to: methodZoneBase!

Item was changed:
  ----- Method: Cogit>>linkSendAt:in:to:offset:receiver: (in category 'in-line cacheing') -----
  linkSendAt: callSiteReturnAddress in: sendingMethod to: targetMethod offset: theEntryOffset receiver: receiver
  	<api>
  	<var: #sendingMethod type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	| inlineCacheTag address extent |
  	self assert: (theEntryOffset = cmEntryOffset or: [theEntryOffset = cmNoCheckEntryOffset]).
  	self assert: (callSiteReturnAddress between: methodZoneBase and: methodZone freeStart).
  	inlineCacheTag := theEntryOffset = cmNoCheckEntryOffset
  						ifTrue: [targetMethod selector "i.e. no change"]
  						ifFalse: [objectRepresentation inlineCacheTagForInstance: receiver].
  	(objectRepresentation inlineCacheTagIsYoung: inlineCacheTag) ifTrue:
  		[methodZone ensureInYoungReferrers: sendingMethod].
  	address := targetMethod asInteger + theEntryOffset.
  	extent := backEnd
  				rewriteInlineCacheAt: callSiteReturnAddress
  				tag: inlineCacheTag
  				target: address.
  	processor
+ 		flushICacheFrom: callSiteReturnAddress asUnsignedInteger - extent
+ 		to: callSiteReturnAddress asUnsignedInteger!
- 		flushICacheFrom: callSiteReturnAddress - 1 - extent
- 		to: callSiteReturnAddress - 1!

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 addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
  	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.
  						 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]].
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: #remapIfObjectRef:pc:hasYoung:
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue:
  							[methodZone ensureInYoungReferrers: cogMethod.
  							hasYoungObj := false]
  						ifFalse:
  							[cogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	"we /must/ prune youngReferrers here because a) the [cogMethod cmRefersToYoung: false]
  	 block could have removed a method and subsequently it could be added back, and b) we
  	 can not tolerate duplicates in the youngReferrers list."  
  	methodZone pruneYoungReferrers.
  	freedPIC ifTrue:
  		[self unlinkSendsToFree].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: codeBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForFullGC (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForFullGC
  	"Update all references to objects in machine code for a full gc.  Since
  	 the current (New)ObjectMemory GC makes everything old in a full GC
  	 a method not referring to young will not refer to young afterwards"
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	codeModified := false.
  	self mapObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 cogMethod selector: (objectRepresentation remapOop: cogMethod selector).
  			 cogMethod cmType = CMClosedPIC
  				ifTrue:
  					[self assert: cogMethod cmRefersToYoung not.
  					 self mapObjectReferencesInClosedPIC: cogMethod]
  				ifFalse:
  					[cogMethod cmType = CMMethod ifTrue:
  						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject)].
  					 self mapFor: cogMethod
  						 performUntil: #remapIfObjectRef:pc:hasYoung:
  						 arg: 0.
  					 (cogMethod cmRefersToYoung
  					  and: [objectRepresentation allYoungObjectsAgeInFullGC]) ifTrue:
  						[cogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	methodZone pruneYoungReferrers.
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: codeBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForYoungGC (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForYoungGC
  	"Update all references to objects in machine code for either a Spur scavenging gc
  	 or a Squeak V3 incremental GC.  Avoid scanning all code by using the youngReferrers
  	 list.  In a young gc a method referring to young may no longer refer to young, but a
  	 method not referring to young cannot and will not refer to young afterwards."
  	| pointer cogMethod hasYoungObj hasYoungObjPtr |
  	<var: #cogMethod type: #'CogMethod *'>
  	hasYoungObj := false.
  	hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
  	codeModified := false.
  	pointer := methodZone youngReferrers.
  	[pointer < methodZone zoneEnd] whileTrue:
  		[self assert: hasYoungObj not.
  		 cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
  		 cogMethod cmType = CMFree
  			ifTrue: [self assert: cogMethod cmRefersToYoung not]
  			ifFalse:
  				[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  				 cogMethod cmRefersToYoung ifTrue:
  					[self assert: (cogMethod cmType = CMMethod
  								or: [cogMethod cmType = CMOpenPIC]).
  					 cogMethod selector: (objectRepresentation remapOop: cogMethod selector).
  					 (objectMemory isYoung: cogMethod selector) ifTrue:
  						[hasYoungObj := true].
  					 cogMethod cmType = CMMethod ifTrue:
  						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: #remapIfObjectRef:pc:hasYoung:
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue: [hasYoungObj := false]
  						ifFalse: [cogMethod cmRefersToYoung: false]]].
  		 pointer := pointer + objectMemory wordSize].
  	methodZone pruneYoungReferrers.
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceMachineCodeForNewSpaceGC (in category 'jit - api') -----
  markAndTraceMachineCodeForNewSpaceGC
  	"Free any methods that refer to unmarked objects, unlinking sends to freed methods."
  	| pointer cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	objectMemory leakCheckNewSpaceGC ifTrue:
  		[self assert: self allMachineCodeObjectReferencesValid].
  	codeModified := false.
  	pointer := methodZone youngReferrers.
  	[pointer < methodZone zoneEnd] whileTrue:
  		[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
  		 cogMethod cmRefersToYoung ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 self assert: (cogMethod cmType = CMMethod
  						or: [cogMethod cmType = CMOpenPIC]).
  			 (objectMemory isYoung: cogMethod selector) ifTrue:
  				[objectMemory markAndTrace: cogMethod selector].
  			 cogMethod cmType = CMMethod ifTrue:
  				[(objectMemory isYoung: cogMethod methodObject) ifTrue:
  					[objectMemory markAndTrace: cogMethod methodObject].
  				self markYoungObjectsIn: cogMethod]].
  		 pointer := pointer + objectMemory wordSize].
  	objectMemory leakCheckNewSpaceGC ifTrue:
  		[self assert: self allMachineCodeObjectReferencesValid].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceMachineCodeOfMarkedMethods (in category 'jit - api') -----
  markAndTraceMachineCodeOfMarkedMethods
  	"Mark objects in machine-code of marked methods (or open PICs with marked selectors)."
  	<api>
  	<option: #SpurObjectMemory>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	objectMemory leakCheckFullGC ifTrue:
  		[self assert: self allMachineCodeObjectReferencesValid].
  	codeModified := false.
  	self markAndTraceObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[(cogMethod cmType = CMMethod
  		  and: [objectMemory isMarked: cogMethod methodObject]) ifTrue:
  			[self markAndTraceLiteralsIn: cogMethod].
  		 (cogMethod cmType = CMOpenPIC
  		  and: [(objectMemory isImmediate: cogMethod selector)
  				or: [objectMemory isMarked: cogMethod selector]]) ifTrue:
  			[self markAndTraceLiteralsIn: cogMethod].
  		 cogMethod := methodZone methodAfter: cogMethod].
  	objectMemory leakCheckFullGC ifTrue:
  		[self assert: self allMachineCodeObjectReferencesValid].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceOrFreeMachineCodeForFullGC (in category 'jit - api') -----
  markAndTraceOrFreeMachineCodeForFullGC
  	"Free any methods that refer to unmarked objects, unlinking sends to freed methods."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	objectMemory leakCheckFullGC ifTrue:
  		[self assert: self allMachineCodeObjectReferencesValid].
  	codeModified := false.
  	self markAndTraceObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[self markAndTraceOrFreeCogMethod: cogMethod firstVisit: true.
  		 cogMethod := methodZone methodAfter: cogMethod].
  	objectMemory leakCheckFullGC ifTrue:
  		[self assert: self allMachineCodeObjectReferencesValid].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>patchToOpenPICFor:numArgs:receiver: (in category 'in-line cacheing') -----
  patchToOpenPICFor: selector numArgs: numArgs receiver: receiver
  	"Code entry closed PIC full or miss to an instance of a young class or to a young target method.
  	 Attempt to patch the send site to an open PIC.  Answer if the attempt succeeded; in fact it will
  	 only return if the attempt failed.
  	 The stack looks like:
  			receiver
  			args
  	 sp=>	sender return address"
  	<api>
  	| oPIC outerReturn extent |
  	<var: #oPIC type: #'CogMethod *'>
  	outerReturn := coInterpreter stackTop.
  	"See if an Open PIC is already available."
  	oPIC := methodZone openPICWithSelector: selector.
  	oPIC isNil ifTrue:
  		["otherwise attempt to create an Open PIC."
  		oPIC := self cogOpenPICSelector: selector numArgs: numArgs.
  		(oPIC asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  			["For some reason the PIC couldn't be generated, most likely a lack of code memory."
  			oPIC asInteger = InsufficientCodeSpace ifTrue:
  				[coInterpreter callForCogCompiledCodeCompaction].
  			^false]].
  	extent := backEnd
  				rewriteInlineCacheAt: outerReturn
  				tag: selector
  				target: oPIC asInteger + cmEntryOffset.
  	processor
+ 		flushICacheFrom: outerReturn asUnsignedInteger - extent to: outerReturn asUnsignedInteger;
- 		flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1;
  		flushICacheFrom: oPIC asInteger to: oPIC asInteger + openPICSize.
  	"Jump into the oPIC at its entry"
  	coInterpreter executeCogMethod: oPIC fromLinkedSendWithReceiver: receiver.
  	"NOTREACHED"
  	^true!

Item was changed:
  ----- Method: Cogit>>unlinkAllSends (in category 'jit - api') -----
  unlinkAllSends
  	<api>
  	"Unlink all sends in cog methods."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase isNil ifTrue: [^self].
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfLinkedSend:pc:ignored:
  					 arg: 0]
  			ifFalse:
  				[cogMethod cmType ~= CMFree ifTrue:
  					[methodZone freeMethod: cogMethod]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	"After updating inline caches we need to flush the icache."
+ 	processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger!
- 	processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger!

Item was changed:
  ----- Method: Cogit>>unlinkSendsLinkedForInvalidClasses (in category 'jit - api') -----
  unlinkSendsLinkedForInvalidClasses
  	<api>
  	<option: #SpurObjectMemory>
  	"Unlink all sends in cog methods whose class tag is that of a forwarded class."
  	| cogMethod freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	codeModified := freedPIC := false.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfInvalidClassSend:pc:ignored:
  					 arg: 0]
  			ifFalse:
  				[(cogMethod cmType = CMClosedPIC
  				  and: [self cPICHasForwardedClass: cogMethod]) ifTrue:
  					[methodZone freeMethod: cogMethod.
  					 freedPIC := true]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	freedPIC
  		ifTrue: [self unlinkSendsToFree]
  		ifFalse:
  			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 				[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]]!
- 				[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsOf:isMNUSelector: (in category 'jit - api') -----
  unlinkSendsOf: selector isMNUSelector: isMNUSelector
  	<api>
  	"Unlink all sends in cog methods. Free all Closed PICs with the selector,
  	 or with an MNU case if isMNUSelector.  First check if any method actually
  	 has the selector; if not there can't be any linked send to it.  This routine
  	 (including descendents) is performance critical.  It contributes perhaps
  	 30% of entire execution time in Compiler recompileAll."
  	| cogMethod mustScanAndUnlink |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase isNil ifTrue: [^self].
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	mustScanAndUnlink := false.
  	isMNUSelector
  		ifTrue:
  			[[cogMethod < methodZone limitZony] whileTrue:
  				[cogMethod cmType ~= CMFree ifTrue:
  					[cogMethod cpicHasMNUCase
  						ifTrue:
  							[self assert: cogMethod cmType = CMClosedPIC.
  							 methodZone freeMethod: cogMethod.
  							 mustScanAndUnlink := true]
  						ifFalse:
  							[cogMethod selector = selector ifTrue:
  								[mustScanAndUnlink := true.
  								 cogMethod cmType = CMClosedPIC ifTrue:
  									[methodZone freeMethod: cogMethod]]]].
  				 cogMethod := methodZone methodAfter: cogMethod]]
  		ifFalse:
  			[[cogMethod < methodZone limitZony] whileTrue:
  				[(cogMethod cmType ~= CMFree
  				  and: [cogMethod selector = selector]) ifTrue:
  					[mustScanAndUnlink := true.
  					 cogMethod cmType = CMClosedPIC ifTrue:
  						[methodZone freeMethod: cogMethod]].
  				 cogMethod := methodZone methodAfter: cogMethod]].
  	mustScanAndUnlink ifFalse:
  		[^self].
  	codeModified := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod ifTrue:
  			[self mapFor: cogMethod
  				 performUntil: #unlinkIfFreeOrLinkedSend:pc:of:
  				 arg: selector].
  		cogMethod := methodZone methodAfter: cogMethod].
  	codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsTo:andFreeIf: (in category 'jit - api') -----
  unlinkSendsTo: targetMethodObject andFreeIf: freeIfTrue
  	<api>
  	"Unlink all sends in cog methods to a particular target method.
  	 If targetMethodObject isn't actually a method (perhaps being
  	 used via invokeAsMethod) then there's nothing to do."
  	| cogMethod targetMethod freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	((objectMemory isOopCompiledMethod: targetMethodObject)
  	and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse:
  		[^self].
  	targetMethod := coInterpreter cogMethodOf: targetMethodObject.
  	methodZoneBase isNil ifTrue: [^self].
  	codeModified := freedPIC := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfLinkedSend:pc:to:
  					 arg: targetMethod asInteger]
  			ifFalse:
  				[(cogMethod cmType = CMClosedPIC
  				  and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue:
  					[methodZone freeMethod: cogMethod.
  					 freedPIC := true]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	freeIfTrue ifTrue: [self freeMethod: targetMethod].
  	freedPIC
  		ifTrue: [self unlinkSendsToFree]
  		ifFalse:
  			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 				[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]]!
- 				[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsToFree (in category 'garbage collection') -----
  unlinkSendsToFree
  	<api>
  	"Unlink all sends in cog methods to free methods and/or pics."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase isNil ifTrue: [^self].
  	codeModified := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfLinkedSendToFree:pc:ignored:
  					 arg: 0]
  			ifFalse:
  				[cogMethod cmType = CMClosedPIC ifTrue:
  					[self assert: (self noTargetsFreeInClosedPIC: cogMethod)]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>rewritePrimInvocationIn:to: (in category 'external primitive support') -----
  rewritePrimInvocationIn: cogMethod to: primFunctionPointer
  	<api>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #primFunctionPointer declareC: #'void (*primFunctionPointer)(void)'>
  	| primIndex flags address extent |
  	self assert: cogMethod cmType = CMMethod.
  	primIndex := coInterpreter
  					primitiveIndexOfMethod: cogMethod methodObject
  					header: cogMethod methodHeader.
  	flags := coInterpreter primitivePropertyFlags: primIndex.
  	"See compileInterpreterPrimitive:"
  	(flags bitAnd: PrimCallMayCallBack) ~= 0
  		ifTrue:
  			[address := cogMethod asUnsignedInteger
  						+ (externalPrimJumpOffsets at: cogMethod cmNumArgs).
  			extent := backEnd
  						rewriteJumpFullAt: address
  						target: (self cCode: [primFunctionPointer asUnsignedInteger]
  									inSmalltalk: [self simulatedTrampolineFor: primFunctionPointer])]
  		ifFalse:
  			[address := cogMethod asUnsignedInteger
  						+ (externalPrimCallOffsets at: cogMethod cmNumArgs).
  			extent := backEnd
  						rewriteCallFullAt: address
  						target: (self cCode: [primFunctionPointer asUnsignedInteger]
  									inSmalltalk: [self simulatedTrampolineFor: primFunctionPointer])].
+ 	processor flushICacheFrom: address asUnsignedInteger to: address asUnsignedInteger + extent!
- 	processor flushICacheFrom: address to: address + extent!



More information about the Vm-dev mailing list