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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.606
Author: eem
Time: 4 February 2014, 11:40:28.238 am
UUID: d20e62c6-4468-4f78-91cb-8331c94a6ab7
Ancestors: VMMaker.oscog-eem.605

Demorgan CCodeGenerator>>shouldIncludeMethodFor:selector:
so it doesn't include undefined options by default.  This so that
primitiveTestShortenIndexableSize stays in its ghetto.

Make ObjectMemory>>allObjectsDo: use objectAfter: instead of
objectAfterWhileForwarding:.  Introduce allObjectsDoSafely: to use
objectAfterWhileForwarding:.  Add a compatibility method to Sour.
Use allObjectsDoSafely: where appropriate.

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

Item was changed:
  ----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
  shouldIncludeMethodFor: aClass selector: selector
  	"process optional methods by interpreting the argument to the option: pragma as either
  	 a Cogit class name or a class variable name or a variable name in VMBasicConstants."
  	(aClass >> selector pragmaAt: #option:) ifNotNil:
  		[:pragma| | key |
  		key := pragma argumentAt: 1.
  		vmMaker ifNotNil:
+ 			[(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
+ 				[| cogitClass optionClass |
+ 				 cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
+ 				 optionClass := Smalltalk classNamed: key.
+ 				 ^cogitClass includesBehavior: optionClass].
+ 			(vmMaker options at: key ifAbsent: [false]) ifNotNil:
+ 				[:option| option ~~ false ifTrue: [^true]].
- 			[((Cogit withAllSubclasses anySatisfy: [:c| c name = key])
- 			and: [vmMaker cogitClassName ~= key]) ifTrue:
- 				[^false].
- 			(vmMaker options at: key ifAbsent: []) ifNotNil:
- 				[:option| option == false ifTrue: [^false]]].
  		(aClass bindingOf: key) ifNotNil:
  			[:binding|
+ 			binding value ~~ false ifTrue: [^true]].
- 			binding value == false ifTrue: [^false]].
  		(VMBasicConstants bindingOf: key) ifNotNil:
  			[:binding|
+ 			binding value ~~ false ifTrue: [^true]]].
+ 		^false].
- 			binding value == false ifTrue: [^false]]].
  	^true!

Item was changed:
  ----- Method: CogVMSimulator>>allObjectsSelect: (in category 'debug support') -----
  allObjectsSelect: objBlock
  	"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
  
  	| selected |
  	selected := OrderedCollection new.
+ 	objectMemory allObjectsDoSafely:
- 	objectMemory allObjectsDo:
  		[:oop| (objBlock value: oop) ifTrue: [selected addLast: oop]].
  	^ selected!

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

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

Item was changed:
  ----- Method: ObjectMemory>>allObjects (in category 'primitive support') -----
  allObjects
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer 0."
  	| count obj resultArray newCount |
  	"Count the currently accessible objects"
  	count := 0.
  	self allObjectsDo:
+ 		[:ign| count := count + 1].
- 		[count := count + 1].
  	"Allocate result array, may cause GC"
  	resultArray := self instantiateClass: self classArray indexableSize: count.
  	resultArray = nil ifTrue:
  		[^0].
  	"Store all objects in result array, excluding any reference to the result array itself,
  	 as may happen if garbage collection occurred during allocation of the array. No store
  	 check is necessary; the result array will be the last object in memory and hence new."
  	newCount := 0.
  	obj := self firstObject.
  	[obj < resultArray] whileTrue:
  		[(self isFreeObject: obj) ifFalse:
  			[newCount := newCount + 1.
  			 self storePointerUnchecked: newCount ofObject: resultArray withValue: obj].
  		 obj := self objectAfter: obj].
  	"If GC occurred during result array allocation, truncate unused portion of result array"
  	newCount < count ifTrue:
  		[self shorten: resultArray toIndexableSize: newCount].
  	^resultArray!

Item was changed:
  ----- 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 objectAfter: oop]!
- 		 oop := self objectAfterWhileForwarding: oop]!

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

Item was added:
+ ----- Method: SpurMemoryManager>>allObjectsDoSafely: (in category 'object enumeration') -----
+ allObjectsDoSafely: aBlock
+ 	<inline: true>
+ 	self allObjectsDo: aBlock!

Item was changed:
  ----- Method: StackInterpreter>>allAccessibleObjectsOkay (in category 'debug support') -----
  allAccessibleObjectsOkay
  	"Ensure that all accessible objects in the heap are okay."
  	| ok |
  	ok := true.
+ 	objectMemory allObjectsDoSafely:
- 	objectMemory allObjectsDo:
  		[:oop|
  		ok := ok & (self okayFields: 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 := true.
+ 	objectMemory allObjectsDoSafely:
- 	objectMemory allObjectsDo:
  		[:oop| ok := ok & (self checkOkayFields: oop)].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>printAllStacks (in category 'debug printing') -----
  printAllStacks
  	"Print all the stacks of all running processes, including those that are currently suspended."
  	<api>
  	| proc semaphoreClass mutexClass schedLists p processList |
  	<inline: false>
  	proc := self activeProcess.
  	self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5; space; printHex: proc.
  	self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr.
  	self printCallStackFP: framePointer. "first the current activation"
  	schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
  	"then the runnable processes"
  	p := highestRunnableProcessPriority = 0
  			ifTrue: [objectMemory fetchWordLengthOf: schedLists]
  			ifFalse: [highestRunnableProcessPriority].
  	p - 1 to: 0 by: -1 do:
  		[:pri|
  		processList := objectMemory fetchPointer: pri ofObject: schedLists.
  		(self isEmptyList: processList) ifFalse:
  			[self cr; print: 'processes at priority '; printNum: pri + 1.
  			 self printProcsOnList: processList]].
  	self cr; print: 'suspended processes'.
  	semaphoreClass := objectMemory classSemaphore.
  	mutexClass := objectMemory classMutex.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[semaphoreClass := objectMemory compactIndexOfClass: semaphoreClass.
  			 mutexClass := objectMemory compactIndexOfClass: mutexClass.
  			 objectMemory allHeapEntitiesDo:
  				[:obj| | classIdx |
  				 classIdx := objectMemory classIndexOf: obj.
  				 (classIdx = semaphoreClass
  				  or: [classIdx = mutexClass]) ifTrue:
  					[self printProcsOnList: obj]]]
  		ifFalse:
+ 			[objectMemory allObjectsDoSafely:
- 			[objectMemory allObjectsDo:
  				[:obj| | classObj |
  				 classObj := objectMemory fetchClassOfNonImm: obj.
  				 (classObj = semaphoreClass
  				  or: [classObj = mutexClass]) ifTrue:
  					[self printProcsOnList: obj]]]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>allObjectsSelect: (in category 'debug support') -----
  allObjectsSelect: objBlock
  	"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
  
  	| selected |
  	selected := OrderedCollection new.
+ 	objectMemory allObjectsDoSafely:
- 	objectMemory allObjectsDo:
  		[:obj|
  		(objBlock value: obj) ifTrue: [selected addLast: obj]].
  	^selected!