[Vm-dev] VM Maker: VMMaker.oscogSPC-eem.2113.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jan 26 19:09:40 UTC 2017


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

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

Name: VMMaker.oscogSPC-eem.2113
Author: eem
Time: 26 January 2017, 11:08:47.456381 am
UUID: 759b608a-4e67-41d5-a8d7-2ba8b63010a7
Ancestors: VMMaker.oscogSPC-eem.2112

Temporary branch for SpurPlanningCompactor as default compactor.

copyAndUnmarkObject:to:bytes:firstField: musty use memmove sincer the source aed destination can overlap.  Improve the simulator's implementations of mem:cp:y: to check for this.

freeFrom:upTo:previousPin: may be given a toFinger beyond lastMobileObject, in which case toFinger must be wslid up to the next freeable object, if any.

Add leak checking of CogMethod counters and implicit reveiver caches.

Inline markIfIRC:

=============== Diff against VMMaker.oscogSPC-eem.2112 ===============

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>checkValidDerivedObjectReference: (in category 'debug support') -----
+ checkValidDerivedObjectReference: bodyAddress
+ 	^(objectMemory heapMapAtWord: (self pointerForOop: bodyAddress - objectMemory baseHeaderSize)) ~= 0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>couldBeDerivedObject: (in category 'garbage collection') -----
+ couldBeDerivedObject: bodyAddress
+ 	^self oop: bodyAddress - objectMemory baseHeaderSize isGreaterThanOrEqualTo: objectMemory startOfMemory!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>markIfIRC: (in category 'newspeak support') -----
  markIfIRC: maybeIRCs
  	"If maybeIRCs (from some cogMehtod's nextMethodOrIRCs) is in old space it is
  	 a pointer to the first field of a pinned object in old space holding the implicit
  	 receiver caches for a method.  If so, map it back to an oop and mark it."
  	<var: #maybeIRCs type: #usqInt>
  	<option: #NewspeakVM>
+ 	<inline: true>
  	(self oop: maybeIRCs isGreaterThan: objectMemory nilObject) ifTrue:
  		[objectMemory markAndTrace: maybeIRCs - objectMemory baseHeaderSize]!

Item was changed:
  ----- Method: Cogit>>allMachineCodeObjectReferencesValid (in category 'garbage collection') -----
  allMachineCodeObjectReferencesValid
  	"Check that all methods have valid selectors, and that all linked sends are to valid targets and have valid cache tags"
  	| ok cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	ok := true.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[(self asserta: (objectRepresentation checkValidOopReference: cogMethod selector)) ifFalse:
  				[ok := false].
  			 (self asserta: (self cogMethodDoesntLookKosher: cogMethod) = 0) ifFalse:
  				[ok := false]].
  		(cogMethod cmType = CMMethod
  		 or: [cogMethod cmType = CMOpenPIC]) ifTrue:
  			[(self asserta: ((self mapFor: cogMethod
  								 performUntil: #checkIfValidOopRefAndTarget:pc:cogMethod:
  								 arg: cogMethod asInteger) = 0)) ifFalse:
  				[ok := false]].
+ 		(cogMethod cmType = CMMethod
+ 		 and: [(NewspeakVM or: [SistaVM])
+ 		 and: [objectRepresentation canPinObjects]]) ifTrue:
+ 			[(SistaVM and: [cogMethod counters ~= 0]) ifTrue:
+ 				[(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod counters)) ifFalse:
+ 					[ok := false]].
+ 			 (NewspeakVM and: [cogMethod nextMethodOrIRCs ~= 0]) ifTrue:
+ 				[(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod nextMethodOrIRCs)) ifFalse:
+ 					[ok := false]]].
  		cogMethod cmType = CMClosedPIC ifTrue:
  			[(self asserta: (self noTargetsFreeInClosedPIC: cogMethod)) ifFalse:
  				[ok := false]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	^ok!

Item was changed:
  ----- Method: Cogit>>cogMethodDoesntLookKosher: (in category 'debugging') -----
  cogMethodDoesntLookKosher: cogMethod
  	"Check that the header fields onf a non-free method are consistent with
  	 the type. Answer 0 if it is ok, otherwise answer a code for the error."
  	<api>
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	((cogMethod blockSize bitAnd: objectMemory wordSize - 1) ~= 0
  	 or: [cogMethod blockSize < (self sizeof: CogMethod)
  	 or: [cogMethod blockSize >= 32768]]) ifTrue:
  		[^1].
  
  	cogMethod cmType = CMFree ifTrue: [^2].
  
  	cogMethod cmType = CMMethod ifTrue:
  		[(objectMemory isIntegerObject: cogMethod methodHeader) ifFalse:
  			[^11].
  		 (objectRepresentation couldBeObject: cogMethod methodObject) ifFalse:
  			[^12].
  		 (cogMethod stackCheckOffset > 0
+ 		  and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue:
- 		 and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue:
  			[^13].
+ 		 (SistaVM
+ 		  and: [objectRepresentation canPinObjects
+ 		  and: [cogMethod counters ~= 0]]) ifTrue:
+ 			[(objectRepresentation couldBeDerivedObject: cogMethod counters) ifFalse:
+ 				[^14]].
+ 		 (NewspeakVM
+ 		  and: [objectRepresentation canPinObjects
+ 		  and: [cogMethod nextMethodOrIRCs ~= 0]]) ifTrue:
+ 			[(objectRepresentation couldBeDerivedObject: cogMethod nextMethodOrIRCs) ifFalse:
+ 				[^15]].
  		 ^0].
  
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[cogMethod blockSize ~= openPICSize ifTrue:
  			[^21].
  		 cogMethod methodHeader ~= 0 ifTrue:
  			[^22].
  		
  		 "Check the nextOpenPIC link unless we're compacting"
  		 cogMethod objectHeader >= 0 ifTrue:
  			[(cogMethod methodObject ~= 0
  			 and: [cogMethod methodObject < methodZoneBase
  				   or: [cogMethod methodObject > (methodZone freeStart - openPICSize)
  				   or: [(cogMethod methodObject bitAnd: objectMemory wordSize - 1) ~= 0
  				   or: [(self cCoerceSimple: cogMethod methodObject
  							to: #'CogMethod *') cmType ~= CMOpenPIC]]]]) ifTrue:
  				[^23]].
  		 cogMethod stackCheckOffset ~= 0 ifTrue:
  			[^24].
  		 ^0].
  
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[cogMethod blockSize ~= closedPICSize ifTrue:
  			[^31].
  		 (cogMethod cPICNumCases between: 1 and: MaxCPICCases) ifFalse:
  			[^32].
  		 cogMethod methodHeader ~= 0 ifTrue:
  			[^33].
  		 cogMethod methodObject ~= 0 ifTrue:
  			[^34].
  		 ^0].
  
  	^9!

Item was changed:
  ----- Method: SpurMemoryManager>>mem:cp:y: (in category 'simulation') -----
  mem: destAddress cp: sourceAddress y: bytes
+ 	"For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
- 	"For SpurGenerationScavenger>>copyToFutureSpace:bytes:"
  	<doNotGenerate>
+ 	self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
+ 				or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]]).
  	^self mem: destAddress mo: sourceAddress ve: bytes!

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 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 |
  	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;
- 		mem: toFinger asVoidPointer cp: start asVoidPointer y: bytes;
  		setIsMarkedOf: destObj to: false;
  		storePointerUnchecked: 0 ofObject: destObj withValue: firstField!

Item was changed:
  ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') -----
  freeFrom: toFinger upTo: limit previousPin: previousPinOrNil
  	"Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil."
  	<inline: false>
  	<var: 'limit' type: #usqInt>
  	<var: 'toFinger' type: #usqInt>
  	<var: 'previousPinOrNil' type: #usqInt>
  	| effectiveToFinger pin nextUnpinned start seg |
  	<var: 'nextUnpinned' type: #usqInt>
  	<var: #seg type: #'SpurSegmentInfo *'>
  	self cCode: [] inSmalltalk:
  		[coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr].
  	effectiveToFinger := toFinger.
  	pin := previousPinOrNil.
+ 	"If toFinger is past lastMobileObject then it was impossible to move an object past a pin
+ 	 and toFinger is pointing at an object. The object may be a pin which must be preserved."
+ 	effectiveToFinger > lastMobileObject ifTrue:
+ 		[effectiveToFinger >= limit ifTrue:
+ 				[^self].
+ 		 nextUnpinned := manager objectStartingAt: effectiveToFinger.
+ 		 [(manager isPinned: nextUnpinned) and: [manager isMarked: nextUnpinned]] whileTrue:
+ 			[nextUnpinned := manager objectAfter: nextUnpinned.
+ 			 nextUnpinned >= limit ifTrue:
+ 				[^self]].
+ 		 effectiveToFinger := manager startOfObject: nextUnpinned.
+ 		 (previousPinOrNil notNil and: [effectiveToFinger > previousPinOrNil]) ifTrue:
+ 			[pin := nil]].
  	"If the range toFinger to limit spans segments but there is no pin (as when freeing to the end of memory)
  	 segment boundaries must still be observed.  So in this case use the nearest bridge above toFinger as the pin."
  	pin ifNil:
  		[seg := manager segmentManager segmentContainingObj: toFinger.
  		 seg segLimit < limit ifTrue:
  			[pin := manager segmentManager bridgeFor: seg]].
  	[pin notNil] whileTrue:
  		[(start := manager startOfObject: pin) > toFinger ifTrue:
  			[manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger].
  		 nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin.
  		 nextUnpinned >= limit ifTrue:
  			[^self].
  		 effectiveToFinger := manager startOfObject: nextUnpinned.
  		 pin := self findNextMarkedPinnedAfter: nextUnpinned].
  	manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger!

Item was changed:
  ----- Method: VMClass>>mem:cp:y: (in category 'C library simulation') -----
+ mem: dString cp: sString y: bytes
- mem: aString cp: bString y: n
  	<doNotGenerate>
+ 	"implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+ 	(dString isString or: [sString isString]) ifFalse:
+ 		[| destAddress sourceAddress |
+ 		 destAddress := dString asInteger.
+ 		 sourceAddress := sString asInteger.
+ 		 self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
+ 					or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
+ 	dString isString
- 	"implementation of memcpy(3)"
- 	aString isString
  		ifTrue:
+ 			[1 to: bytes do:
- 			[1 to: n do:
  				[:i| | v |
+ 				v := sString isString
+ 						ifTrue: [sString at: i]
+ 						ifFalse: [Character value: (self byteAt: sString + i - 1)].
+ 				dString at: i put: v]]
- 				v := bString isString
- 						ifTrue: [bString at: i]
- 						ifFalse: [Character value: (self byteAt: bString + i - 1)].
- 				aString at: i put: v]]
  		ifFalse:
+ 			[1 to: bytes do:
- 			[1 to: n do:
  				[:i| | v |
+ 				v := sString isString
+ 						ifTrue: [(sString at: i) asInteger]
+ 						ifFalse: [self byteAt: sString + i - 1].
+ 				self byteAt: dString + i - 1 put: v]].
+ 	^dString!
- 				v := bString isString
- 						ifTrue: [(bString at: i) asInteger]
- 						ifFalse: [self byteAt: bString + i - 1].
- 				self byteAt: aString + i - 1 put: v]].
- 	^aString!



More information about the Vm-dev mailing list