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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 8 22:11:48 UTC 2014


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

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

Name: VMMaker.oscog-eem.876
Author: eem
Time: 8 September 2014, 3:09:18.582 pm
UUID: 85989927-97e3-4111-a351-b242bf444291
Ancestors: VMMaker.oscog-eem.875

The option for Spur is SpurObjectMemory, not
SpurMemoryManager.

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

Item was changed:
  ----- Method: Cogit>>ceImplicitReceiverFor:receiver:cache: (in category 'in-line cacheing') -----
  ceImplicitReceiverFor: selector receiver: receiver cache: cacheAddress
  	"Cached implicit receiver implementation.  Caller looks like
  				mov Lclass, Arg1Reg
  				mov selector, SendNumArgsReg
  				call ceImplicitReceiver
  	 and Lclass: .word; Lmixin: .word is somewhere on the heap.
  	 The trampoline has already fetched the class and probed the cache and found
  	 that the cache missed.  Compute the implicit receiver for the receiver's class
  	 and reload the class tag.  If either the class tag or the mixin are young then the
  	 method needs to be added to the youngReferrers list to ensure correct GC."
  
+ 	<option: #SpurObjectMemory>
- 	<option: #SpurMemoryManager>
  	<var: #cacheAddress type: #usqInt>
  	| rcvrClass mixin cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	mixin := coInterpreter
  				implicitReceiverFor: receiver
  				mixin: coInterpreter mMethodClass
  				implementing: selector.
  	rcvrClass := objectMemory fetchClassOf: receiver.
  	cogMethod := coInterpreter mframeHomeMethodExport.
  	cogMethod cmRefersToYoung ifFalse:
  		[((objectRepresentation inlineCacheTagsMayBeObjects
  		   and: [objectMemory isYoung: rcvrClass])
  		  or: [mixin ~= receiver and: [objectMemory isYoung: mixin]]) ifTrue:
  			[methodZone ensureInYoungReferrers: cogMethod]].
  	backEnd
  		unalignedLongAt: cacheAddress
  			put: (objectRepresentation inlineCacheTagForClass: rcvrClass);
  		unalignedLongAt: cacheAddress + BytesPerOop
  			put: (mixin = receiver ifTrue: [0] ifFalse: [mixin]).
  	^mixin!

Item was changed:
  ----- Method: Cogit>>freeUnmarkedMachineCode (in category 'jit - api') -----
  freeUnmarkedMachineCode
  	"Free machine-code methods whose compiled methods are unmarked
  	 and open PICs whose selectors are not marked."
  	<api>
+ 	<option: #SpurObjectMemory>
- 	<option: #SpurMemoryManager>
  	| cogMethod freedMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	freedMethod := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[(cogMethod cmType = CMMethod
  		  and: [(objectMemory isMarked: cogMethod methodObject) not]) ifTrue:
  			[freedMethod := true.
  			 methodZone freeMethod: cogMethod].
  		 (cogMethod cmType = CMOpenPIC
  		  and: [(objectMemory isImmediate: cogMethod selector) not
  		  and: [(objectMemory isMarked: cogMethod selector) not]]) ifTrue:
  			[freedMethod := true.
  			 methodZone freeMethod: cogMethod].
  		 cogMethod := methodZone methodAfter: cogMethod].
  	freedMethod ifTrue:
  		[self unlinkSendsToFree.
  		 methodZone pruneYoungReferrers.
  		 processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceLiteralsIn: (in category 'garbage collection') -----
  markAndTraceLiteralsIn: cogMethod
+ 	<option: #SpurObjectMemory>
- 	<option: #SpurMemoryManager>
  	"Unlink sends that have unmarked classes in inline caches or freed/freeable targets.
  	 Nil-out inline caches linked to open PICs.
  	 Assert that any selectors are marked.  We can do this since
  	 this is only run on marked methods and thus any selectors they
  	 reference should already be marked."
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: true>
  	self assert: ((cogMethod cmType = CMMethod
  				 and: [objectMemory isMarked: cogMethod methodObject])
  				 or: [cogMethod cmType = CMOpenPIC
  				 and: [(objectMemory isImmediate: cogMethod selector)
  					or: [objectMemory isMarked: cogMethod selector]]]).
  	objectRepresentation
  		markAndTraceLiteral: cogMethod selector
  		in: cogMethod
  		at: (self addressOf: cogMethod selector put: [:val| cogMethod selector: val]).
  	self maybeMarkCountersIn: cogMethod.
  	self maybeMarkIRCsIn: cogMethod.
  	self mapFor: cogMethod
  		 performUntil: #markLiterals:pc:method:
  		 arg: cogMethod 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>
- 	<option: #SpurMemoryManager>
  	| 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 to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  	"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files,
  	 or in the case of VMBIGENDIAN the various sqConfig.h files.
  	 Subclass implementations need to include a super initializeMiscConstants"
  
  	| omc |
  	VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  	self isInterpreterClass ifTrue:
  		[STACKVM := COGVM := COGMTVM := false].
  
  	initializationOptions ifNil: [self initializationOptions: Dictionary new].
  	omc := initializationOptions at: #ObjectMemory ifAbsent: nil.
  	initializationOptions
  		at: #SqueakV3ObjectMemory	"the good ole default"
  			put: (omc
  					ifNil: [true]
+ 					ifNotNil: [(Smalltalk at: omc) includesBehavior: ObjectMemory]);
- 					ifNotNil: [(Smalltalk at: omc) inheritsFrom: ObjectMemory]);
  		at: #SpurObjectMemory		"the new condender"
  			put: (omc
  					ifNil: [false]
+ 					ifNotNil: [(Smalltalk at: omc) includesBehavior: SpurMemoryManager]).
- 					ifNotNil: [(Smalltalk at: omc) inheritsFrom: SpurMemoryManager]).
  
  	"Use ifAbsentPut: so that they will get copied back to the
  	 VMMaker's options and dead code will likely be eliminated."
  	NewspeakVM := initializationOptions at: #NewspeakVM ifAbsentPut: [false].
  	SistaVM := initializationOptions at: #SistaVM ifAbsentPut: [false].
  	MULTIPLEBYTECODESETS := initializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false].
  	"N.B.  Not yet implemented."
  	IMMUTABILITY := initializationOptions at: #IMMUTABILITY ifAbsentPut: [false].
  
  	"These for scripts etc... Usually they should get set by an Interpreter class's initializeMiscConstantsWith:"
  	(initializationOptions includesKey: #STACKVM) ifTrue:
  		[STACKVM := initializationOptions at: #STACKVM].
  	(initializationOptions includesKey: #COGVM) ifTrue:
  		[COGVM := initializationOptions at: #COGVM].
  	(initializationOptions includesKey: #COGMTVM) ifTrue:
  		[COGMTVM := initializationOptions at: #COGMTVM]!



More information about the Vm-dev mailing list