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

commits at source.squeak.org commits at source.squeak.org
Thu Sep 5 22:11:41 UTC 2013


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

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

Name: VMMaker.oscog-eem.350
Author: eem
Time: 5 September 2013, 3:09:03.974 pm
UUID: 10d870ce-a680-45bb-a981-a55a5f6dfe9f
Ancestors: VMMaker.oscog-eem.349

Replace explicit enumeration by inlined allObjectsDo: now that
a) Slang inlines literal blocks, and
b) Spur has a segmented memory, preventing simple enumeration.

Remove C code from printOopShortInner: so that it's inlined as requested.

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

Item was removed:
- ----- Method: CogVMSimulator>>allObjectsDo: (in category 'debug support') -----
- allObjectsDo: objBlock
- 
- 	| oop |
- 	oop := objectMemory firstObject.
- 	[oop < objectMemory freeStart] whileTrue:
- 		[(objectMemory isFreeObject: oop) ifFalse:
- 			[objBlock value: oop].
- 		 oop := objectMemory objectAfter: oop]!

Item was changed:
  ----- Method: CogVMSimulator>>testPCMapping (in category 'testing') -----
  testPCMapping
+ 	objectMemory allObjectsDo:
- 	self allObjectsDo:
  		[:o|
  		((objectMemory isCompiledMethod: o)
  		 and: [self methodShouldBeCogged: o]) ifTrue:
  			[(self methodHasCogMethod: o) ifFalse:
  				[[([cogit cog: o selector: objectMemory nilObject]
  					on: Error
  					do: [:ex|
  						ex messageText = 'This won''t work...' ifTrue:
  							[ex resumeUnchecked: nil].
  						ex pass]) isNil
  				   and: [cogCompiledCodeCompactionCalledFor]] whileTrue:
  					[cogMethodZone clearCogCompiledCode.
  					 cogCompiledCodeCompactionCalledFor := false]].
  			 (self methodHasCogMethod: o)
  				ifTrue:
  					[transcript nextPut: $.; flush.
  					 cogit testMcToBcPcMappingForMethod: (self cogMethodOf: o)]
  				ifFalse:
  					[transcript nextPutAll: 'failed to compile method '; print: o; cr; flush]]]!

Item was removed:
- ----- Method: InterpreterSimulator>>allObjectsDo: (in category 'debug support') -----
- allObjectsDo: objBlock
- 
- 	| oop |
- 	oop := self firstObject.
- 	[oop < endOfMemory] whileTrue:
- 			[(self isFreeObject: oop)
- 				ifFalse: [objBlock value: oop].
- 			oop := self objectAfter: oop].
- !

Item was changed:
+ ----- Method: NewObjectMemory>>allObjectsDo: (in category 'object enumeration') -----
- ----- Method: NewObjectMemory>>allObjectsDo: (in category 'debug support') -----
  allObjectsDo: aBlock
+ 	<inline: true>
- 	<doNotGenerate>
  	| oop |
  	oop := self firstObject.
  	[oop < freeStart] whileTrue:
  		[(self isFreeObject: oop) ifFalse:
  			[aBlock value: oop].
  		 oop := self objectAfterWhileForwarding: oop]!

Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>allObjectsDo: (in category 'debug support') -----
- allObjectsDo: objBlock
- 
- 	| oop |
- 	oop := self firstObject.
- 	[oop < endOfMemory] whileTrue:
- 			[(self isFreeObject: oop)
- 				ifFalse: [objBlock value: oop].
- 			oop := self objectAfter: oop].
- !

Item was added:
+ ----- Method: ObjectMemory>>allObjectsDo: (in category 'object enumeration') -----
+ allObjectsDo: aBlock
+ 	<inline: true>
+ 	| oop |
+ 	oop := self firstObject.
+ 	[oop < freeBlock] whileTrue:
+ 		[(self isFreeObject: oop) ifFalse:
+ 			[aBlock value: oop].
+ 		 oop := self objectAfterWhileForwarding: oop]!

Item was changed:
  ----- Method: SpurMemoryManager>>allNewSpaceObjectsDo: (in category 'object enumeration') -----
  allNewSpaceObjectsDo: aBlock
+ 	<inline: true>
  	| prevObj prevPrevObj objOop limit |
  	prevPrevObj := prevObj := nil.
  	"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
  	  in pastSpace.  Objects are allocated in eden.  So enumerate only eden and pastSpace."
  	objOop := self objectStartingAt: scavenger eden start.
  	[objOop < freeStart] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: freeStart].
  	objOop := self objectStartingAt: scavenger pastSpace start.
  	limit := scavenger pastSpace limit.
  	[objOop < limit] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: limit].
  	prevPrevObj class.
  	prevObj class!

Item was changed:
  ----- Method: SpurMemoryManager>>allObjectsDo: (in category 'object enumeration') -----
  allObjectsDo: aBlock
+ 	<inline: true>
  	self allOldSpaceObjectsDo: aBlock.
  	self allNewSpaceObjectsDo: aBlock!

Item was changed:
  ----- Method: SpurMemoryManager>>allOldSpaceObjectsDo: (in category 'object enumeration') -----
  allOldSpaceObjectsDo: aBlock
+ 	<inline: true>
- 	<doNotGenerate>
  	| prevObj prevPrevObj objOop |
  	prevPrevObj := prevObj := nil.
  	objOop := self firstObject.
  	[self assert: objOop \\ self allocationUnit = 0.
  	 objOop < freeOldSpaceStart] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: freeOldSpaceStart].
  	prevPrevObj class.
  	prevObj class!

Item was changed:
  ----- Method: StackInterpreter>>allAccessibleObjectsOkay (in category 'debug support') -----
  allAccessibleObjectsOkay
  	"Ensure that all accessible objects in the heap are okay."
+ 	| ok |
- 	| ok oop |
  	ok := true.
+ 	objectMemory allObjectsDo:
+ 		[:oop|
+ 		ok := ok & (self okayFields: oop)].
- 	oop := objectMemory firstAccessibleObject.
- 	[oop = nil] whileFalse:
- 		[ok := ok & (self okayFields: oop).
- 		oop := objectMemory accessibleObjectAfter: oop].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>checkAllAccessibleObjectsOkay (in category 'debug support') -----
  checkAllAccessibleObjectsOkay
  	"Ensure that all accessible objects in the heap are okay."
  	<api>
+ 	| ok |
- 	| ok oop |
  	ok := true.
+ 	objectMemory allObjectsDo:
+ 		[:oop| ok := ok & (self checkOkayFields: oop)].
- 	oop := objectMemory firstAccessibleObject.
- 	[oop = nil] whileFalse:
- 		[ok := ok & (self checkOkayFields: oop).
- 		oop := objectMemory accessibleObjectAfter: oop].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: true>
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
+ 			[self printChar: $$;
+ 				printChar: (objectMemory characterValueOf: oop);
+ 				printChar: $(;
+ 				printHex: (objectMemory integerValueOf: oop);
+ 				printChar: $).
- 			[self
- 				cCode: 'printf("$%c(%ld)", (long)characterValueOf(oop), (long)characterValueOf(oop))'
- 				inSmalltalk:
- 					[self printChar: $$;
- 						printChar: (objectMemory characterValueOf: oop);
- 						printChar: $(;
- 						printHex: (objectMemory integerValueOf: oop);
- 						printChar: $)].
  			 ^nil].
  		self printNum: (objectMemory integerValueOf: oop);
  			printChar: $(;
  			printHex: (objectMemory integerValueOf: oop);
  			printChar: $).
  		 ^nil].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [' is not on the heap']); cr.
  		 ^nil].
  	(self isFloatObject: oop) ifTrue:
  		[self printFloat: (self dbgFloatValueOf: oop).
  		 ^nil].
  	classOop := objectMemory fetchClassOfNonImm: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[self print: 'a ??'. ^nil].
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
  		[self printNameOfClass: oop count: 5.
  		 ^nil].
  	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
  	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
  	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $'; printStringOf: oop; printChar: $'.
  			 ^nil].
  		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop.
  			 ^nil]].
  	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
  		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
  		 ^nil].
+ 	self print: 'a(n) '.
+ 	1 to: nameLen do: [:i| self printChar: (name at: i)].
- 	self cCode: [self prin: 'a(n) %.*s' t: nameLen f: name]
- 		inSmalltalk: [self print: 'a(n) '; print: name].
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
  	 and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation)))
  	 and: [objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
  		[self space;
  			printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  			print: ' -> ';
  			printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>allObjectsDo: (in category 'debug support') -----
- allObjectsDo: objBlock
- 
- 	| oop |
- 	oop := objectMemory firstObject.
- 	[oop < objectMemory endOfMemory] whileTrue:
- 			[(objectMemory isFreeObject: oop)
- 				ifFalse: [objBlock value: oop].
- 			oop := objectMemory objectAfter: oop].
- !



More information about the Vm-dev mailing list