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

commits at source.squeak.org commits at source.squeak.org
Fri Jan 19 21:06:47 UTC 2018


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

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

Name: VMMaker.oscog-eem.2320
Author: eem
Time: 19 January 2018, 1:06:15.532949 pm
UUID: e2692e35-5fc8-4623-95d0-b445b3329f75
Ancestors: VMMaker.oscog-eem.2319

Spur:
Fix a bad bug in SpurPlnningCompactor.  unmarkObjectsFromFirstFreeObject, used when the compactor requires more than one pass due to insufficient savedFirstFieldsSpace, expects the corpse of a moved object to be unmarked, but copyAndUnmarkObject:to:bytes:firstField: only unmarked the target.  Unmarking the corpse before the copy unmarks both.  This fixes a crash with ReleaseBuilder class>>saveAsNewRelease when non-use of cacheDuring: creates lots of files, enough to push the system into the multi-pass regime.

Cogit:
Fix an assert fail during simulation with the openPICList.  Simply void the list when doing unlinkAllSends, and change removeFromOpenPICList: to neither crash nor complain when attempting to remove a PIC when the list is empty.  Have printOpenPICList answer the length of the list.

Simulation:
Add byte count text update to stack overflow in the cogit.

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

Item was changed:
  ----- Method: CogMethodZone>>compactCompiledCode (in category 'compaction') -----
  compactCompiledCode
  	| objectHeaderValue source dest bytes |
  	<var: #source type: #'CogMethod *'>
  	<var: #dest type: #'CogMethod *'>
  	compactionInProgress := true.
  	objectHeaderValue := objectMemory nullHeaderForMachineCodeMethod.
  	source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
+ 	self voidOpenPICList. "The list will be rebuilt with the current live set"
- 	openPICList := nil.
  	methodCount := 0.
  	NewspeakVM ifTrue: [unpairedMethodList := nil].
  	[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].
  		 NewspeakVM ifTrue:
  				[(source cmType = CMMethod
  				  and: [(coInterpreter rawHeaderOf: source methodObject) asInteger ~= source asInteger]) ifTrue:
  					[source nextMethodOrIRCs: unpairedMethodList.
  					 unpairedMethodList := source asUnsignedInteger]].
  		 SistaVM ifTrue:
  			[self clearSavedPICUsageCount: source].
  		 source cmType = CMOpenPIC ifTrue:
+ 			[self addToOpenPICList: source].
- 			[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.
  			 objectMemory mem: dest mo: source ve: bytes.
  			 dest objectHeader: objectHeaderValue.
  			 dest cmType = CMMethod
  				ifTrue:
  					["For non-Newspeak there should be a one-to-one mapping between bytecoded and
  					  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  					"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.
  							 NewspeakVM ifTrue:
  								[dest nextMethodOrIRCs: unpairedMethodList.
  								 unpairedMethodList := dest asUnsignedInteger]]]
  				ifFalse:
  					[SistaVM ifTrue:
  						[self clearSavedPICUsageCount: dest].
+ 					 dest cmType = CMOpenPIC ifTrue:
+ 						[self addToOpenPICList: dest]].
- 					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
  								to: #'CogMethod *'].
  		 source := coInterpreter
  							cCoerceSimple: source asUnsignedInteger + bytes
  							to: #'CogMethod *'].
  	mzFreeStart := dest asUnsignedInteger.
  	methodBytesFreedSinceLastCompaction := 0.
  	compactionInProgress := false!

Item was changed:
  ----- Method: CogMethodZone>>printOpenPICList (in category 'accessing') -----
  printOpenPICList
  	<api>
+ 	| n openPIC |
- 	| openPIC |
  	<var: #openPIC type: #'CogMethod *'>
+ 	n := 0.
  	openPIC := openPICList.
  	[openPIC == nil] whileFalse:
+ 		[n := n + 1.
+ 		 coInterpreter printCogMethod: openPIC.
+ 		 openPIC := self cCoerceSimple: openPIC nextOpenPIC to: #'CogMethod *'].
+ 	^n!
- 		[coInterpreter printCogMethod: openPIC.
- 		 openPIC := self cCoerceSimple: openPIC nextOpenPIC to: #'CogMethod *']!

Item was changed:
  ----- Method: CogMethodZone>>removeFromOpenPICList: (in category 'accessing') -----
  removeFromOpenPICList: anOpenPIC
  	<var: #anOpenPIC type: #'CogMethod *'>
  	| prevPIC |
  	<var: #prevPIC type: #'CogMethod *'>
  	self assert: anOpenPIC cmType = CMOpenPIC.
+ 	openPICList ifNil: [^nil]. "As it is when compacting or unlinking all sends"
+ 	self assert: (openPICList cmType = CMOpenPIC
+ 				and: [openPICList nextOpenPIC isNil
+ 					or: [(self cCoerceSimple: openPICList nextOpenPIC to: #'CogMethod *') cmType = CMOpenPIC]]).
  	anOpenPIC = openPICList ifTrue:
  		["N.B. Use self rather than coInterpreter to avoid attempting to cast nil.
  		  Conversion to CogMethod done in the nextOpenPIC accessor."
  		 openPICList := self cCoerceSimple: anOpenPIC nextOpenPIC to: #'CogMethod *'.
  		 ^nil].
  	prevPIC := openPICList.
  	[self assert: (prevPIC ~~ nil
  				and: [prevPIC cmType = CMOpenPIC]).
+ 	 prevPIC nextOpenPIC = anOpenPIC asUnsignedInteger ifTrue:
- 	 prevPIC nextOpenPIC = anOpenPIC asInteger ifTrue:
  		[prevPIC nextOpenPIC: anOpenPIC nextOpenPIC.
  		 ^nil].
  	  prevPIC := self cCoerceSimple: prevPIC nextOpenPIC to: #'CogMethod *'.
  	  true] whileTrue!

Item was added:
+ ----- Method: CogMethodZone>>voidOpenPICList (in category 'accessing') -----
+ voidOpenPICList
+ 	openPICList := nil!

Item was changed:
  ----- Method: CogVMSimulator>>ceStackOverflow: (in category 'trampolines') -----
  ceStackOverflow: contextSwitchIfNotNil
  	"Override to bump up the byteCount from which the microsecond clock is derived."
  	byteCount := byteCount + 1000.
+ 	self doOrDefer: [self changed: #byteCountText; changed: #composeAll].
  	^super ceStackOverflow: contextSwitchIfNotNil!

Item was changed:
  ----- Method: Cogit>>unlinkAllSends (in category 'jit - api') -----
  unlinkAllSends
  	<api>
  	"Unlink all sends in cog methods."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
+ 	methodZone voidOpenPICList.
  	[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!

Item was changed:
  ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:bytes:firstField: (in category 'compaction') -----
  copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: firstField
+ 	"Copy the object to toFinger, clearing its mark bit both in the target and the corpse,
+ 	 and restoring its firstField, which was overwritten with a forwarding pointer."
- 	"Copy the object to toFinger, clearing its mark bit and restoring its firstField, which was overwritten with a forwarding pointer.
- 	 Answer the number of bytes in the object, including overflow header."
  	<inline: true>
  	| numSlots destObj start |
+ 	manager setIsMarkedOf: o to: false.
  	numSlots := manager rawNumSlotsOf: o.
  	destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots)
  					ifTrue: [toFinger + manager baseHeaderSize]
  					ifFalse: [toFinger].
  	start := manager startOfObject: o given: numSlots.
  	"memmove must be used since the ranges may overlap."
  	manager
  		mem: toFinger asVoidPointer mo: start asVoidPointer ve: bytes;
- 		setIsMarkedOf: destObj to: false;
  		storePointerUnchecked: 0 ofObject: destObj withValue: firstField!



More information about the Vm-dev mailing list