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

commits at source.squeak.org commits at source.squeak.org
Thu Oct 24 23:08:26 UTC 2013


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

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

Name: VMMaker.oscog-eem.475
Author: eem
Time: 24 October 2013, 4:05:28.947 pm
UUID: 2dfcdc5a-bfbf-4797-8dae-eebe54a1ebbe
Ancestors: VMMaker.oscog-eem.474

Revise and complete compaction (to the extent that the generated C
compiles and links).
Make highestObjects a SpurCircularBuffer, which itself is added.

Change some arg vars to avoid shadowing warnings.
Change some return types to #void to avoid self appearing.
Add some <inline: false> to avoid inlining in whiles etc.

Fix Slang for transformation of ifNotNil: (ifNil:ifNotNil: was handled).

Fix Slang for inlining non-struct accessor methods of struct types.

Fix Slang for invoking non-struct accessor methods of struct types
with struct receivers (as opposed to pointer-to-struct receivers).

Fix shouldExcludeReceiverAsFirstArgument: to filter-out struct
fields that are implicit variables (i.e. aSpurCircularBuffer manager).

Rename some isFoo: aCodeGen selectors to isFooIn: aCodeGen for
consistency.

typos.

Spur Stack VM now links.

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

Item was removed:
- ----- Method: CogMethodZone>>mem:mo:ve: (in category 'compaction') -----
- mem: destAddress mo: sourceAddress ve: bytes
- 	<doNotGenerate>
- 	| dst src  |
- 	dst := destAddress asInteger.
- 	src := sourceAddress asInteger.
- 	"Emulate the c library memmove function"
- 	self assert: bytes \\ 4 = 0.
- 	0 to: bytes - 4 by: 4 do:
- 		[:i|
- 		objectMemory longAt: dst + i put: (objectMemory longAt: src + i)]!

Item was changed:
  ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
  	"make a CCodeGenerator equivalent of me"
  	"selector is sometimes a Symbol, sometimes a SelectorNode!!
  	On top of this, numArgs is needed due to the (truly grody) use of
  	arguments as a place to store the extra expressions needed to generate
  	code for in-line to:by:do:, etc.  see below, where it is used."
  	| rcvrOrNil sel args ifNotNilBlock |
  	rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
  	(rcvrOrNil notNil
  	and: [rcvrOrNil isVariable
  	and: [rcvrOrNil name = 'super']]) ifTrue:
  		[^aTMethod superExpansionNodeFor: selector key args: arguments].
  	sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key].
  	((sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
  	  or: [sel == #cCode:])
  	 and: [arguments first isBlockNode]) ifTrue:
  		[| block |
  		 ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
  			ifTrue: [block statements first]
  			ifFalse: [block]].
+ 	args := arguments
+ 				select: [:arg| arg notNil]
+ 				thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod].
- 	args := (1 to: sel numArgs) collect:
- 				[:i | (arguments at: i) asTranslatorNodeIn: aTMethod].
  	(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue:
  		["Restore limit expr that got moved by transformToDo:"
  		 args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. 
  				  args second.
  				  args third. "add the limit var as a hidden extra argument; we may need it later"
  				  TVariableNode new setName: arguments first key}].
  	(sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue:
  		[sel := #ifFalse:. args := {args last}].
  	(sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue:
  		[sel := #ifTrue:. args := {args first}].
  	(sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue:
  		[sel := #ifTrue:. args := {args last}].
  	(sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue:
  		[sel := #ifTrue:. args := {args first}].
  	((sel == #ifFalse: or: [sel == #or:])
  	 and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
  		["Restore argument block that got moved by transformOr: or transformIfFalse:"
  		 args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
  	"For the benefit of later passes, e.g. value: inlining,
  	 transform e ifNotNil: [:v| ...] into  v := e. v ifNotNil: [...],
  	 which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]."
+ 	((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]])
- 	((sel == #ifTrue: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]])
  	 and: [receiver notNil
  	 and: [receiver isAssignmentEqualsEqualsNil
  	 and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue:
  		[ifNotNilBlock setArguments: #().
  		 ^TStmtListNode new
  			setArguments: #()
  			statements:
  				{	receiver receiver asTranslatorNodeIn: aTMethod.
  					TSendNode new
  						setSelector: sel
  						receiver: (TSendNode new
  									setSelector: #==
  									receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod)
  									arguments: {receiver arguments first asTranslatorNodeIn: aTMethod})
  						arguments: args }].
  	^TSendNode new
  		setSelector: sel
  		receiver: rcvrOrNil
  		arguments: args!

Item was changed:
  ----- Method: Spur32BitCoMemoryManager>>edenBytes: (in category 'snapshot') -----
+ edenBytes: bytes
+ 	newSpaceLimit := bytes + coInterpreter cogCodeSize!
- edenBytes: edenBytes
- 	newSpaceLimit := edenBytes + coInterpreter cogCodeSize!

Item was added:
+ SpurNewSpaceSpace subclass: #SpurCircularBuffer
+ 	instanceVariableNames: 'manager first last'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurMemoryManager'!
+ 
+ !SpurCircularBuffer commentStamp: 'eem 10/23/2013 10:01' prior: 0!
+ A SpurCircularBuffer is a region of memory being used as a circular buffer.  The buffer is empty when last < start.  The buffer is full when first = (last + wordSize > limit ifTrue: [start] ifFalse: [last + wordSize]).
+ 
+ Instance Variables
+ 	first:		<Integer address>
+ 	last:		<Integer address>
+ 
+ first
+ 	- pointer to the first element in the buffer
+ 
+ last
+ 	- pointer to the last element in the buffer
+ !

Item was added:
+ ----- Method: SpurCircularBuffer>>addLast: (in category 'accessing') -----
+ addLast: element
+ 	| newLast |
+ 	newLast := last + manager wordSize.
+ 	newLast > limit ifTrue:
+ 		[newLast := start].
+ 	(newLast = first and: [last >= start]) ifTrue: "wrapped; bump first"
+ 		[(first := newLast + manager wordSize) >= limit ifTrue:
+ 			[first := start]].
+ 	last := newLast.
+ 	manager longAt: newLast put: element!

Item was added:
+ ----- Method: SpurCircularBuffer>>first (in category 'accessing') -----
+ first
+ 	"Answer the value of first"
+ 
+ 	^ first!

Item was added:
+ ----- Method: SpurCircularBuffer>>first: (in category 'accessing') -----
+ first: anObject
+ 	"Set the value of first"
+ 
+ 	^first := anObject!

Item was added:
+ ----- Method: SpurCircularBuffer>>from:reverseDo: (in category 'enumerating') -----
+ from: initialPtr reverseDo: aBlock
+ 	<inline: true>
+ 	| ptr |
+ 	last >= start ifTrue:
+ 		[ptr := initialPtr.
+ 		 [aBlock value: (manager longAt: ptr).
+ 		  ptr = first ifTrue: [^nil].
+ 		  (ptr := ptr - manager wordSize) < start ifTrue:
+ 			[ptr := limit]] repeat].
+ 	^nil!

Item was added:
+ ----- Method: SpurCircularBuffer>>initializeStart:limit: (in category 'initialization') -----
+ initializeStart: aStart limit: aLimit
+ 	self start: aStart;
+ 		limit: aLimit;
+ 		first: aStart;
+ 		last: aStart - manager wordSize!

Item was added:
+ ----- Method: SpurCircularBuffer>>isEmpty (in category 'testing') -----
+ isEmpty
+ 	^last < start!

Item was added:
+ ----- Method: SpurCircularBuffer>>last (in category 'accessing') -----
+ last
+ 	"Answer the value of last"
+ 
+ 	^ last!

Item was added:
+ ----- Method: SpurCircularBuffer>>last: (in category 'accessing') -----
+ last: anObject
+ 	"Set the value of last"
+ 
+ 	^last := anObject!

Item was added:
+ ----- Method: SpurCircularBuffer>>manager (in category 'accessing') -----
+ manager
+ 	"Answer the value of manager"
+ 
+ 	^ manager!

Item was added:
+ ----- Method: SpurCircularBuffer>>manager: (in category 'accessing') -----
+ manager: anObject
+ 	"Set the value of manager"
+ 	<doNotGenerate>
+ 	^manager := anObject!

Item was added:
+ ----- Method: SpurCircularBuffer>>resetAsEmpty (in category 'accessing') -----
+ resetAsEmpty
+ 	last := start - manager wordSize!

Item was added:
+ ----- Method: SpurCircularBuffer>>reverseDo: (in category 'enumerating') -----
+ reverseDo: aBlock
+ 	| ptr |
+ 	last >= start ifTrue:
+ 		[ptr := last.
+ 		 [aBlock value: (manager longAt: ptr).
+ 		  ptr = first ifTrue: [^nil].
+ 		  (ptr := ptr - manager wordSize) < start ifTrue:
+ 			[ptr := limit]] repeat].
+ 	^nil!

Item was changed:
  ----- Method: SpurGenerationScavenger>>fireEphemeronsOnEphemeronList (in category 'weakness and ephemerality') -----
  fireEphemeronsOnEphemeronList
  	"There are ephemerons to be fired in the remembered set.
  	 Fire them and scavenge their keys.  Be careful since copyAndForward:
  	 can remember ephemerons (ephemerons pointing to ephemerons)."
+ 	<returnTypeC: #void>
  	| ephemeron ephemeronCorpse |
  	ephemeronList ifNil:
  		[^self].
  	ephemeronCorpse := self firstCorpse: ephemeronList.
  	"Reset the list head so that new ephemerons will get added
  	 to a new list, not concatenated on the one we are scanning."
  	ephemeronList := nil.
  	[ephemeronCorpse notNil] whileTrue:
  		[self assert: (manager isForwarded: ephemeronCorpse).
  		 ephemeron := manager followForwarded: ephemeronCorpse.
  		 self assert: (self isScavengeSurvivor: (manager keyOfEphemeron: ephemeron)) not.
  		 coInterpreter fireEphemeron: ephemeron.
  		 self copyAndForward: (manager keyOfEphemeron: ephemeron).
  		 self cCoerceSimple: (self scavengeReferentsOf: ephemeron) to: #void.
  		 ephemeronCorpse := self nextCorpseOrNil: ephemeronCorpse]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
  newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
+ 	| actualEdenBytes survivorBytes |
- 	| edenBytes survivorBytes |
  
+ 	actualEdenBytes := requestedEdenBytes.
+ 	survivorBytes := totalBytes - actualEdenBytes // 2 truncateTo: manager allocationUnit.
+ 	actualEdenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
+ 	self assert: totalBytes - actualEdenBytes - survivorBytes - survivorBytes < manager allocationUnit.
- 	edenBytes := requestedEdenBytes.
- 	survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
- 	edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
- 	self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
  
  	"for tenuring we require older objects below younger objects.  since allocation
  	 grows up this means that the survivor spaces must preceed eden."
  
  	pastSpace start: startAddress; limit: startAddress + survivorBytes.
  	futureSpace start: pastSpace limit; limit: pastSpace limit + survivorBytes.
+ 	eden start: futureSpace limit; limit: futureSpace limit + actualEdenBytes.
- 	eden start: futureSpace limit; limit: futureSpace limit + edenBytes.
  
  	self assert: futureSpace limit <= (startAddress + totalBytes).
  	self assert: eden start \\ manager allocationUnit
  				+ (eden limit \\ manager allocationUnit) = 0.
  	self assert: pastSpace start \\ manager allocationUnit
  				+ (pastSpace limit \\ manager allocationUnit) = 0.
  	self assert: futureSpace start \\ manager allocationUnit
  				+ (futureSpace limit \\ manager allocationUnit) = 0.
  
  	self initFutureSpaceStart.
  	manager initSpaceForAllocationCheck: (self addressOf: eden)!

Item was changed:
  ----- Method: SpurGenerationScavenger>>remember: (in category 'store check') -----
  remember: objOop
+ 	<inline: false>
  	self assert: ((manager isNonImmediate: objOop)
  				and: [(manager isYoung: objOop) not]).
  	rememberedSetSize < RememberedSetLimit
  		ifTrue:
  			[rememberedSet at: rememberedSetSize put: objOop.
  			 (rememberedSetSize := rememberedSetSize + 1) >= RememberedSetRedZone ifTrue:
  				[manager scheduleScavenge]]
  		ifFalse:
  			[self error: 'remembered set overflow' "for now"]!

Item was changed:
  ----- Method: SpurMemoryManager class>>ancilliaryClasses: (in category 'translation') -----
  ancilliaryClasses: options
+ 	^{	SpurGenerationScavenger. SpurSegmentManager. SpurSegmentInfo },
+ 		SpurNewSpaceSpace withAllSubclasses!
- 	^{	SpurGenerationScavenger. SpurNewSpaceSpace.
- 		SpurSegmentManager. SpurSegmentInfo.
- 		SpurContiguousObjStack }!

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	self declareCAsOop: #(	memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart
  							lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks)
  		in: aCCodeGenerator.
  	self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #freeLists type: #'sqInt *';
  		var: #classTableBitmap type: #'unsigned char *';
+ 		var: #highestObjects type: #SpurCircularBuffer;
- 		var: #highestObjects type: #SpurContiguousObjStack;
  		var: #unscannedEphemerons type: #SpurContiguousObjStack.
  	aCCodeGenerator
  		var: #remapBuffer
  		declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #extraRoots
  		declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.!

Item was added:
+ ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') -----
+ allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock
+ 	"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
+ 	 if available, otherwise answer nil.  Break up a larger chunk if one of the exact
+ 	 size cannot be found.  N.B.  the chunk is simply a pointer, it has no valid header.
+ 	 The caller *must* fill in the header correctly."
+ 	| initialIndex node next prev index child acceptedChunk acceptedNode |
+ 	<inline: true> "must inline for acceptanceBlock"
+ 	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
+ 	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
+ 	initialIndex := chunkBytes / self allocationUnit.
+ 	(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
+ 		[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
+ 			[(node := freeLists at: initialIndex) = 0
+ 				ifTrue: [freeListsMask := freeListsMask - (1 << index)]
+ 				ifFalse:
+ 					[prev := 0.
+ 					 [node ~= 0] whileTrue:
+ 						[self assert: node = (self startOfObject: node).
+ 						 self assert: (self isValidFreeObject: node).
+ 						 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 						 (acceptanceBlock value: node) ifTrue:
+ 							[prev = 0
+ 								ifTrue: [freeLists at: index put: next]
+ 								ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
+ 							 ^node].
+ 						 node := next]]].
+ 		 "first search for free chunks of a multiple of chunkBytes in size"
+ 		 index := initialIndex.
+ 		 [(index := index + initialIndex) < self numFreeLists
+ 		  and: [1 << index <= freeListsMask]] whileTrue:
+ 			[(freeListsMask anyMask: 1 << index) ifTrue:
+ 				[(node := freeLists at: index) = 0
+ 					ifTrue: [freeListsMask := freeListsMask - (1 << index)]
+ 					ifFalse:
+ 						[prev := 0.
+ 						 [node ~= 0] whileTrue:
+ 							[self assert: node = (self startOfObject: node).
+ 							 self assert: (self isValidFreeObject: node).
+ 							 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 							 (acceptanceBlock value: node) ifTrue:
+ 								[prev = 0
+ 									ifTrue: [freeLists at: index put: next]
+ 									ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. 
+ 								 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ 									at: (self startOfObject: node) + chunkBytes.
+ 								 ^node].
+ 							 node := next].
+ 						 self assert: node = (self startOfObject: node).
+ 						 self assert: (self isValidFreeObject: node).
+ 						 self unlinkFreeChunk: node atIndex: index.
+ 						 self assert: (self bytesInObject: node) = (index * self allocationUnit).
+ 						 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ 							at: (self startOfObject: node) + chunkBytes.
+ 						^node]]].
+ 		 "now get desperate and use the first that'll fit.
+ 		  Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
+ 		  leave room for the forwarding pointer/next free link, we can only break chunks
+ 		  that are at least 16 bytes larger, hence start at initialIndex + 2."
+ 		 index := initialIndex + 1.
+ 		 [(index := index + 1) < self numFreeLists
+ 		  and: [1 << index <= freeListsMask]] whileTrue:
+ 			[(freeListsMask anyMask: 1 << index) ifTrue:
+ 				[(node := freeLists at: index) = 0
+ 					ifTrue: [freeListsMask := freeListsMask - (1 << index)]
+ 					ifFalse:
+ 						[prev := 0.
+ 						 [node ~= 0] whileTrue:
+ 							[self assert: node = (self startOfObject: node).
+ 							 self assert: (self isValidFreeObject: node).
+ 							 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 							 (acceptanceBlock value: node) ifTrue:
+ 								[prev = 0
+ 									ifTrue: [freeLists at: index put: next]
+ 									ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. 
+ 								 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ 									at: (self startOfObject: node) + chunkBytes.
+ 								 ^node].
+ 							 node := next].
+ 						 self assert: node = (self startOfObject: node).
+ 						 self assert: (self isValidFreeObject: node).
+ 						 self unlinkFreeChunk: node atIndex: index.
+ 						 self assert: (self bytesInObject: node) = (index * self allocationUnit).
+ 						 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ 							at: (self startOfObject: node) + chunkBytes.
+ 						^node]]]].
+ 
+ 	"Large chunk, or no space on small free lists.  Search the large chunk list.
+ 	 Large chunk list organized as a tree, each node of which is a list of chunks
+ 	 of the same size. Beneath the node are smaller and larger blocks.
+ 	 When the search ends parent should hold the smallest chunk at least as
+ 	 large as chunkBytes, or 0 if none.  acceptedChunk and acceptedNode save
+ 	 us from having to back-up when the acceptanceBlock filters-out all nodes
+ 	 of the right size, but there are nodes of the wrong size it does accept."
+ 	child := freeLists at: 0.
+ 	[child ~= 0] whileTrue:
+ 		[| childBytes |
+ 		 self assert: (self isValidFreeObject: child).
+ 		 childBytes := self bytesInObject: child.
+ 		 childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
+ 			[node := child.
+ 			 [prev := node.
+ 			  node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 			  node ~= 0] whileTrue:
+ 				[(acceptanceBlock value: node) ifTrue:
+ 					[self assert: (self isValidFreeObject: node).
+ 					 self storePointer: self freeChunkNextIndex
+ 						ofFreeChunk: prev
+ 						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
+ 					 ^self startOfObject: node]].
+ 			 (acceptanceBlock value: node) ifTrue:
+ 				[node := child.
+ 				 child := 0]]. "break out of loop to remove interior node"
+ 		 child ~= 0 ifTrue:
+ 			["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
+ 			  leave room for the forwarding pointer/next free link, we can only break chunks
+ 			  that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
+ 			childBytes <= (chunkBytes + self allocationUnit)
+ 				ifTrue: "node too small; walk down the larger size of the tree"
+ 					[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
+ 				ifFalse:
+ 					[acceptedNode = 0 ifTrue:
+ 						[acceptedChunk := child.
+ 						 "first search the list."
+ 						 [acceptedChunk := self fetchPointer: self freeChunkNextIndex
+ 													ofFreeChunk: acceptedChunk.
+ 						  acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue:
+ 							[(acceptanceBlock value: acceptedChunk) ifTrue:
+ 								[acceptedNode := child].
+ 						 "nothing on the list; will the node do?  This prefers
+ 						  acceptable nodes higher up the tree over acceptable
+ 						  list elements further down, but we haven't got all day..."
+ 						 (acceptedNode = 0
+ 						  and: [acceptanceBlock value: child]) ifTrue:
+ 							[acceptedNode := child]].
+ 					 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]].
+ 	acceptedNode ~= 0 ifTrue:
+ 		[acceptedChunk ~= 0 ifTrue:
+ 			[self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit).
+ 			 [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
+ 			  next ~= acceptedChunk] whileTrue:
+ 				[acceptedNode := next].
+ 			 self storePointer: self freeChunkNextIndex
+ 				ofFreeChunk: acceptedNode
+ 				withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk).
+ 			self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes
+ 					at: (self startOfObject: acceptedChunk) + chunkBytes.
+ 			^self startOfObject: acceptedChunk].
+ 		next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
+ 		next = 0
+ 			ifTrue: "no list; remove the interior node"
+ 				[self unlinkSolitaryFreeTreeNode: acceptedNode]
+ 			ifFalse: "list; replace node with it"
+ 				[self inFreeTreeReplace: acceptedNode with: next].
+ 		 self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit).
+ 		 self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes
+ 				at: (self startOfObject: acceptedNode) + chunkBytes.
+ 		^self startOfObject: acceptedNode].
+ 	totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
+ 	^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') -----
  allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock
+ 	"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
+ 	 if one of this size is available, otherwise answer nil.  N.B.  the chunk is simply a
+ 	 pointer, it has no valid header.  The caller *must* fill in the header correctly."
+ 	| index node next prev child childBytes |
- 	"Answer a chunk of oldSpace from the free lists, if one of this size
- 	 is available, otherwise answer nil.  N.B.  the chunk is simply a pointer,
- 	 it has no valid header.  The caller *must* fill in the header correctly."
- 	| initialIndex node nodeBytes child |
  	<inline: true> "must inline for acceptanceBlock"
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  
+ 	index := chunkBytes / self allocationUnit.
+ 	index < self numFreeLists ifTrue:
+ 		[1 << index <= freeListsMask ifTrue:
+ 			[(node := freeLists at: index) = 0
+ 				ifTrue: [freeListsMask := freeListsMask - (1 << index)]
+ 				ifFalse:
+ 					[prev := 0.
+ 					 [node ~= 0] whileTrue:
+ 						[self assert: node = (self startOfObject: node).
+ 						 self assert: (self isValidFreeObject: node).
+ 						 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 						 (acceptanceBlock value: node) ifTrue:
+ 							[prev = 0
+ 								ifTrue: [freeLists at: index put: next]
+ 								ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
+ 							 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ 							 ^node].
+ 						 node := next]]].
- 	initialIndex := chunkBytes / self allocationUnit.
- 	initialIndex < self numFreeLists ifTrue:
- 		[(1 << initialIndex <= freeListsMask
- 		 and: [(node := freeLists at: initialIndex) ~= 0
- 		 and: [acceptanceBlock value: node]]) ifTrue:
- 			[self assert: node = (self startOfObject: node).
- 			 self assert: (self isValidFreeObject: node).
- 			totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- 			^self unlinkFreeChunk: node atIndex: initialIndex].
  		 ^nil].
  
  	"Large chunk.  Search the large chunk list.
  	 Large chunk list organized as a tree, each node of which is a list of
  	 chunks of the same size. Beneath the node are smaller and larger
  	 blocks.  When the search ends parent should hold the first chunk of
  	 the same size as chunkBytes, or 0 if none."
  	node := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
+ 		[self assert: (self isValidFreeObject: child).
- 		[| childBytes |
- 		 self assert: (self isValidFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes
+ 			ifTrue: "size match; try to remove from list at node first."
+ 				[node := child.
+ 				 [prev := node.
+ 				  node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 				  node ~= 0] whileTrue:
+ 					[(acceptanceBlock value: node) ifTrue:
+ 						[self assert: (self isValidFreeObject: node).
+ 						 self storePointer: self freeChunkNextIndex
+ 							ofFreeChunk: prev
+ 							withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
+ 						 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ 						 ^self startOfObject: node]].
- 			ifTrue: "size match; try to remove from list at node."
- 				[node := self fetchPointer: self freeChunkNextIndex
- 								ofFreeChunk: child.
- 				 (node ~= 0 and: [acceptanceBlock value: node]) ifTrue:
- 					[self assert: (self isValidFreeObject: node).
- 					 self storePointer: self freeChunkNextIndex
- 						ofFreeChunk: child
- 						withValue: (self fetchPointer: self freeChunkNextIndex
- 										ofFreeChunk: node).
- 					 totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- 					 ^self startOfObject: node].
  				 node := child.
- 				 nodeBytes := childBytes.
  				 child := 0] "break out of loop to remove interior node"
+ 			ifFalse: "no size match; walk down the tree"
+ 				[child := self fetchPointer: (childBytes < chunkBytes
+ 												ifTrue: [self freeChunkLargerIndex]
+ 												ifFalse: [self freeChunkSmallerIndex])
+ 							ofFreeChunk: child]].
- 			ifFalse:
- 				[childBytes < chunkBytes
- 					ifTrue: "walk down the tree"
- 						[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
- 					ifFalse:
- 						[nodeBytes := childBytes.
- 						 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
  	"if no chunk, there was no exact fit"
  	(node ~= 0 and: [acceptanceBlock value: node]) ifFalse:
  		[^nil].
  
  	"self printFreeChunk: parent"
- 	self assert: nodeBytes = chunkBytes.
  	self assert: (self bytesInObject: node) = chunkBytes.
  
+ 	next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ 	next = 0
+ 		ifTrue: "no list; remove the interior node"
+ 			[self unlinkSolitaryFreeTreeNode: node]
+ 		ifFalse: "list; replace node with it"
+ 			[self inFreeTreeReplace: node with: next].
- 	"can't be a list; would have removed and returned it above."
- 	self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0.
- 
- 	"no list; remove the interior node"
- 	"N.B. This will fail when we try to remove the head node and there are still next links,
- 	  which is possible given acceptanceBlock but does not occur in current use."
- 	self unlinkSolitaryFreeTreeNode: node.
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
  	^self startOfObject: node!

Item was changed:
  ----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') -----
  bestFitCompact
  	"Compact all of memory using best-fit, assuming free space is sorted
  	 and that the highest objects are recorded in highestObjects."
  
+ 	<returnTypeC: #void>
+ 	<inline: false>
+ 	| freePriorToExactFit |
- 	| freePriorToExactFit firstFailedFit |
  	freePriorToExactFit := totalFreeOldSpace.
+ 	self exactFitCompact.
+ 	highestObjects isEmpty ifTrue:
+ 		[^self]. "either no high objects, or no misfits."
+ 	highestObjects reverseDo:
+ 		[:o| | b |
+ 		 self assert: ((self isForwarded: o) or: [self isPinned: o]) not.
+ 		 b := self bytesInObject: o.
+ 				(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
+ 					[:f|
+ 					self mem: f
+ 						cp: o
+ 						y: ((self hasOverflowHeader: o)
+ 								ifTrue: [b - self baseHeaderSize]
+ 								ifFalse: [b]).
+ 					(self isRemembered: o) ifTrue:
+ 						[scavenger remember: f].
+ 					self forward: o to: f]].
+ 	self allOldSpaceObjectsFrom: firstFreeChunk
- 	firstFailedFit := self exactFitCompact.
- 	firstFailedFit = 0 ifTrue:
- 		[^self]. "either no free space, no high objects, or no misfits."
- 	self allOldSpaceObjectsFrom: firstFailedFit
  		do: [:o| | b |
  			((self isForwarded: o)
  			 or: [self isPinned: o]) ifFalse:
  				[b := self bytesInObject: o.
  				(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
  					[:f|
  					self mem: f
  						cp: o
  						y: ((self hasOverflowHeader: o)
  								ifTrue: [b - self baseHeaderSize]
  								ifFalse: [b]).
  					(self isRemembered: o) ifTrue:
  						[scavenger remember: f].
+ 					self forward: o to: f]]].
+ 	self checkFreeSpace
+ 	self touch: freePriorToExactFit!
- 					self forward: o to: f].
- 				self checkFreeSpace]].
- 	self checkFreeSpace!

Item was added:
+ ----- Method: SpurMemoryManager>>capacityOfObjStack: (in category 'obj stacks') -----
+ capacityOfObjStack: objStack
+ 	| total freeObj |
+ 	objStack = nilObj ifTrue: [^0].
+ 	total := ObjStackLimit negated.
+ 	freeObj := objStack.
+ 	[freeObj ~= 0] whileTrue:
+ 		[total := total + ObjStackLimit.
+ 		 freeObj := self fetchPointer: ObjStackFreex ofObject: freeObj].
+ 	freeObj := objStack.
+ 	[freeObj ~= 0] whileTrue:
+ 		[total := total + ObjStackLimit.
+ 		 freeObj := self fetchPointer: ObjStackNextx ofObject: freeObj].
+ 	^total!

Item was changed:
  ----- Method: SpurMemoryManager>>edenBytes: (in category 'snapshot') -----
+ edenBytes: bytes
+ 	newSpaceLimit := bytes!
- edenBytes: edenBytes
- 	newSpaceLimit := edenBytes!

Item was added:
+ ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category 'gc - global') -----
+ eliminateAndFreeForwarders
+ 	"As the final phase of global garbage collect, sweep
+ 	 the heap to follow forwarders, then free forwarders"
+ 	| lowestForwarded firstForwarded lastForwarded |
+ 	lowestForwarded := 0.
+ 	self allOldSpaceObjectsDo:
+ 		[:o|
+ 		(self isForwarded: o)
+ 			ifTrue:
+ 				[lowestForwarded = 0 ifTrue:
+ 					[lowestForwarded := o]]
+ 			ifFalse:
+ 				[0 to: (self numPointerSlotsOf: o) - 1 do:
+ 					[:i| | f |
+ 					f := self fetchPointer: i ofObject: o.
+ 					(self isOopForwarded: f) ifTrue:
+ 						[f := self followForwarded: f.
+ 						 self assert: ((self isImmediate: f) or: [self isYoung: f]) not.
+ 						 self storePointerUnchecked: i ofObject: o withValue: f]]]].
+ 	firstForwarded := lastForwarded := 0.
+ 	self allOldSpaceObjectsFrom: lowestForwarded do:
+ 		[:o|
+ 		(self isForwarded: o)
+ 			ifTrue:
+ 				[firstForwarded = 0 ifTrue:
+ 					[firstForwarded := o].
+ 				 lastForwarded := o]
+ 			ifFalse:
+ 				[firstForwarded ~= 0 ifTrue:
+ 					[| start bytes |
+ 					start := self startOfObject: firstForwarded.
+ 					bytes := (self addressAfter: lastForwarded) - start.
+ 					self addFreeChunkWithBytes: bytes at: start].
+ 				 firstForwarded := 0]]!

Item was changed:
  ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
  exactFitCompact
+ 	"Compact all of memory above firstFreeChunk using exact-fit, assuming free
+ 	 space is sorted and that the highest objects are recorded in highestObjects.
+ 	 Note that we don't actually move; we merely copy and forward.  Eliminating
+ 	 forwarders will be done in a final pass.
+ 	 Leave the objects that don't fit exactly, and hence aren't moved, in highestObjects."
- 	"Compact all of memory using exact-fit, assuming free space is sorted
- 	 and that the highest objects are recorded in highestObjects."
  
+ 	<returnTypeC: #void>
+ 	<inline: false>
+ 	| failures first |
+ 	<var: #failures type: #usqInt>
- 	| firstFailedFit top o |
- 	<var: #top type: #unsigned>
- 	firstFailedFit := 0.
  	totalFreeOldSpace = 0 ifTrue: [^0].
+ 	failures := highestObjects last + self wordSize.
+ 	[highestObjects from: failures - self wordSize reverseDo:
+ 		[:o| | b |
+ 		o < firstFreeChunk ifTrue:
+ 			[failures = (highestObjects last + self wordSize)
+ 				ifTrue: [highestObjects resetAsEmpty]
+ 				ifFalse: [highestObjects first: failures].
+ 			 ^self].
+ 		 ((self isForwarded: o) or: [self isPinned: o]) ifFalse:
- 	top := highestObjects top.
- 	[[top := top - self wordSize.
- 	  top < highestObjects start ifTrue:
- 		[top := highestObjects limit].
- 	  top ~= highestObjects top and: [(o := self longAt: top) > firstFreeChunk]] whileTrue:
- 		[| b |
- 		 ((self isForwarded: o)
- 		 or: [self isPinned: o]) ifFalse:
  			[b := self bytesInObject: o.
+ 			 (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
+ 				ifNil:
+ 					[failures := failures - self wordSize.
+ 					 failures < highestObjects start ifTrue:
+ 						[failures := highestObjects limit].
+ 					 self longAt: failures put: o]
- 			(self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
- 				ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]]
  				ifNotNil:
  					[:f|
  					self mem: f
  						cp: o
  						y: ((self hasOverflowHeader: o)
  								ifTrue: [b - self baseHeaderSize]
  								ifFalse: [b]).
  					"wait until the next scavenge to unremember o"
  					(self isRemembered: o) ifTrue:
  						[scavenger remember: f].
  					self forward: o to: f]]].
+ 	 "now highestObjects contains only failures, if any, from failures to last.
+ 	  set first to first failure and refill buffer. next cycle will add more failures.
+ 	  give up on exact-fit when half of the highest objects fail to fit."
+ 	 first := self longAt: highestObjects first.
+ 	 first > firstFreeChunk ifTrue:
+ 		[| highestObjBytes failureBytes savedLimit |
+ 		 highestObjBytes := highestObjects limit - highestObjects start.
+ 		 failureBytes := highestObjects last >= failures
+ 							ifTrue: [highestObjects last - failures]
+ 							ifFalse: [highestObjBytes - (failures - highestObjects last)].
+ 		 failureBytes >= (highestObjBytes // 2) ifTrue:
+ 			[highestObjects first: failures.
+ 			 ^self].
+ 		 savedLimit := self moveFailuresToTopOfHighestObjects: failures.
+ 		 self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
+ 		 failures := self moveFailuresInHighestObjectsBack: savedLimit]] repeat!
- 	 top = highestObjects top and: [o > firstFreeChunk]] whileTrue:
- 		[self fillHighestObjectsFrom: firstFreeChunk upTo: o].
- 	self checkFreeSpace.
- 	^firstFailedFit!

Item was added:
+ ----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFrom:upTo: (in category 'compaction') -----
+ fillHighestObjectsWithMovableObjectsFrom: startObj upTo: limitObj
+ 	"Refill highestObjects with movable objects up to, but not including limitObj.
+ 	 c.f. the loop in freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace."
+ 	| lastHighest highestObjectsWraps |
+ 	lastHighest := highestObjects last.
+ 	highestObjectsWraps := 0.
+ 	self allOldSpaceObjectsFrom: startObj do:
+ 		[:o|
+ 		o >= limitObj ifTrue:
+ 			[highestObjects last: lastHighest.
+ 			 ^nil].
+ 		((self isForwarded: o) or: [self isPinned: o]) ifFalse:
+ 			[false "conceptually...: "
+ 				ifTrue: [highestObjects addLast: o]
+ 				ifFalse: "but we inline so we can use the local lastHighest"
+ 					[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
+ 						[highestObjectsWraps := highestObjectsWraps + 1].
+ 					 self longAt: lastHighest put: o]]].
+ 	highestObjects last: lastHighest!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
  freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace
  	"Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings,
+ 	 coalescing free chunks, and sorting free space.
+ 
+ 	 Small free chunks are sorted in address order on each small list head.  Large free chunks
+ 	 are sorted on the sortedFreeChunks list.  Record as many of the highest objects as there
+ 	 is room for in highestObjects, a circular buffer, for the use of exactFitCompact.  Use
+ 	 unused eden space for highestObjects.  If highestObjects does not wrap, store 0 at
+ 	 highestObjects last.  Record the lowest free object in firstFreeChunk.  Let the
+ 	 segmentManager mark which segments contain pinned objects via notePinned:."
+ 
+ 	| lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
+ 	<var: #lastHighest type: #usqInt>
- 	 coalescing free chunks, and sorting free space.  Small free chunks are sorted in address
- 	 order on each small list head.  Large free chunks are sorted on the sortedFreeChunks list.
- 	 Record the highest N objects in highestObjects, for the first cycle of exactFitCompact.
- 	 Let the segmentManager mark which segments contain pinned objects via notePinned:"
- 	| lastLargeFree highestObjectsWraps sortedFreeChunks |
  	self checkFreeSpace.
  	scavenger forgetUnmarkedRememberedObjects.
  	segmentManager prepareForGlobalSweep."for notePinned:"
  	"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
  	self resetFreeListHeads.
+ 	highestObjects initializeStart: freeStart limit: scavenger eden limit.
+ 	lastHighest := highestObjects last "a.k.a. freeStart - wordSize".
- 	highestObjects
- 		top: freeStart;
- 		start: freeStart;
- 		limit: scavenger eden limit.
  	highestObjectsWraps := 0.
  	self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
  	firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
+ 	"Note that if we were truly striving for performance we could split the scan into
+ 	 two phases, one up to the first free object and one after, which would remove
+ 	 the need to test firstFreeChunk when filling highestObjects."
  	self allOldSpaceEntitiesForCoalescingDo:
  		[:o|
  		(self isMarked: o)
+ 			ifTrue: "forwarders should have been followed in markAndTrace:"
+ 				[self assert: (self isForwarded: o) not.
+ 				 self setIsMarkedOf: o to: false.
- 			ifTrue:
- 				[self setIsMarkedOf: o to: false.
  				 ((self isWeakNonImm: o)
+ 				  and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
- 				 and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
  					[coInterpreter signalFinalization: o].
  				 (self isPinned: o) ifTrue:
  					[segmentManager notePinned: o].
+ 				 firstFreeChunk ~= 0 ifTrue:
+ 					[false "conceptually...: "
+ 						ifTrue: [highestObjects addLast: o]
+ 						ifFalse: "but we inline so we can use the local lastHighest"
+ 							[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
+ 								[highestObjectsWraps := highestObjectsWraps + 1].
+ 							 self longAt: lastHighest put: o]]]
- 				 lastLargeFree ~= 0 ifTrue:
- 					[self longAt: highestObjects top put: o.
- 					 (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue:
- 						[highestObjects top: highestObjects start.
- 						 highestObjectsWraps := highestObjectsWraps + 1]]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here next |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := o.
  				 next := self objectAfter: here limit: endOfMemory.
  				 (self isMarked: next) ifFalse: "coalescing; rare case"
  					[self assert: (self isRemembered: o) not.
  					 [statCoalesces := statCoalesces + 1.
  					  here := self coalesce: here and: next.
  					  next := self objectAfter: here limit: endOfMemory.
  					  next = endOfMemory or: [self isMarked: next]] whileFalse].
  				 firstFreeChunk = 0 ifTrue:
  					[firstFreeChunk := here].
  				 (self isLargeFreeObject: here)
  					ifTrue:
  						[lastLargeFree = 0
  							ifTrue: [sortedFreeChunks := here]
  							ifFalse:
  								[self setFree: here.
  								 self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
  						 lastLargeFree := here]
  					ifFalse:
  						[self freeSmallObject: here]]].
+ 	highestObjects last: lastHighest.
+ 	highestObjectsWraps ~= 0 ifTrue:
+ 		[highestObjects first: (lastHighest + self wordSize >= highestObjects limit
+ 								ifTrue: [highestObjects start]
+ 								ifFalse: [lastHighest + self wordSize])].
  	lastLargeFree ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
  	totalFreeOldSpace := self reverseSmallListHeads.
  	totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
  	self checkFreeSpace.
  	self touch: highestObjectsWraps!

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  	self runLeakCheckerForFullGC: true.
  	self markObjects.
- 	self runLeakCheckerForFullGC: true.
  	self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace.
- 	self runLeakCheckerForFullGC: true.
  	self bestFitCompact.
+ 	self eliminateAndFreeForwarders.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	"We can put all initializations that set something to 0 or to false here.
  	 In C all global variables are initialized to 0, and 0 is false."
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := extraRootCount := 0. "see below"
  	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  	statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0.
  	statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0.
  	statCoalesces := 0.
  
  	"We can initialize things that are allocated but are lazily initialized."
  	unscannedEphemerons := SpurContiguousObjStack new.
+ 	highestObjects := SpurCircularBuffer new manager: self; yourself.
- 	highestObjects := SpurContiguousObjStack new.
  
  	"we can initialize things that are virtual in C."
  	scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  	segmentManager := SpurSegmentManager new manager: self; yourself.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
  
  	"N.B. We *don't* initialize extraRoots because we don't simulate it."!

Item was added:
+ ----- Method: SpurMemoryManager>>moveFailuresInHighestObjectsBack: (in category 'compaction') -----
+ moveFailuresInHighestObjectsBack: savedLimit
+ 	"After refilling highestObjects move any failures back to being
+ 	 adjacent with the new objects, reset the space's limit and
+ 	 answer the pointer to the lowest failure to resume the scan."
+ 
+ 	| newFailuresPosition |
+ 	savedLimit = highestObjects limit ifTrue:
+ 		[^highestObjects last].
+ 	"simple; we didnt fill all the way; just move failures down."
+ 	(highestObjects first = highestObjects start
+ 	 and: [highestObjects last < highestObjects limit]) ifTrue:
+ 		[newFailuresPosition := highestObjects limit.
+ 		 self mem: newFailuresPosition
+ 			mo: highestObjects last + self wordSize
+ 			ve: savedLimit - newFailuresPosition.
+ 		 highestObjects limit: savedLimit.
+ 		 ^newFailuresPosition].
+ 	"tricky to do unless we have last - start's worth of free space.
+ 	 we *don't* want to rotate lots and lots of objects.  We could push
+ 	 failures onto the mark stack, if it is big enough.
+ 	 limit: | failures hi <-> lo | lowest candidates | highest candidates | : start
+ 	                                                      ^ last"
+ 	self shouldBeImplemented.
+ 	^newFailuresPosition!

Item was added:
+ ----- Method: SpurMemoryManager>>moveFailuresToTopOfHighestObjects: (in category 'compaction') -----
+ moveFailuresToTopOfHighestObjects: failures
+ 	"After a cycle of exact-fit compaction highestObjects may contain some
+ 	 number of mobile objects that fail to fit, and more objects may exist to
+ 	 move.  Move existing failures to top of highestObjects and temporarily
+ 	 shrink highestObjects to refill it without overwriting failues.  Answer the
+ 	 old limit. moveFailuresInHighestObjectsBack: will undo the change."
+ 
+ 	| oldLimit bytesToMove |
+ 	oldLimit := highestObjects limit.
+ 	failures = (highestObjects last + self wordSize) ifTrue:
+ 		[highestObjects resetAsEmpty.
+ 		 ^oldLimit].
+ 	failures <= highestObjects last ifTrue:
+ 		[bytesToMove := highestObjects last + self wordSize - failures.
+ 		 self mem: highestObjects limit - bytesToMove
+ 			mo: failures
+ 			ve: bytesToMove.
+ 		 highestObjects limit: failures - self wordSize.
+ 		 ^oldLimit].
+ 	"failures wrapped; move in two stages to preserve ordering"
+ 	bytesToMove := highestObjects last - highestObjects start.
+ 	self mem: failures - bytesToMove
+ 		mo: failures
+ 		ve: oldLimit - failures.
+ 	highestObjects limit: failures - bytesToMove.
+ 	self mem: oldLimit - bytesToMove
+ 		mo: highestObjects start
+ 		ve: bytesToMove.
+ 	^oldLimit!

Item was changed:
  ----- Method: SpurNewSpaceSpace class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	self allInstVarNames do:
+ 		[:ivn|
+ 		(SpurMemoryManager isNonArgumentImplicitReceiverVariableName: ivn) ifFalse:
+ 			[aBinaryBlock value: ivn value: #usqInt]]!
- 		[:ivn| aBinaryBlock value: ivn value: #usqInt]!

Item was changed:
  ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
  addSegmentOfSize: ammount
  	<returnTypeC: #'SpurSegmentInfo *'>
+ 	<inline: false>
  	| allocatedSize |
  	<var: #newSeg type: #'SpurSegmentInfo *'>
  	(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
  			sqAllocateMemorySegmentOfSize: ammount
  			Above: (segments at: 0) segStart + (segments at: 0) segSize
  			AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  									inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  		[:segAddress| | newSegIndex newSeg |
  		 newSegIndex := self insertSegmentFor: segAddress.
  		 newSeg := self addressOf: (segments at: newSegIndex).
  		 newSeg
  			segStart: segAddress;
  			segSize: allocatedSize.
  		 self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
  		 self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
  										[self addressOf: (segments at: newSegIndex + 1)]).
  		 "and add the new free chunk to the free list; done here
  		  instead of in assimilateNewSegment: for the assert"
  		 manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
  		 self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart))
  					= (newSeg segStart + newSeg segSize - manager bridgeSize).
  		 ^newSeg].
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>doubleExtendedDoAnythingBytecode (in category 'send bytecodes') -----
  doubleExtendedDoAnythingBytecode
  	"Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count. 
  	Here we use 3 bits for the operation sub-type (opType),  and the remaining 5 bits for argument count where needed. 
  	The last byte give access to 256 instVars or literals. 
  	See also secondExtendedSendBytecode"
+ 	| byte2 byte3 opType top lit |
- 	| byte2 byte3 opType top |
  	byte2 := self fetchByte.
  	byte3 := self fetchByte.
  	opType := byte2 >> 5.
  	opType = 0 ifTrue:
  		[messageSelector := self literal: byte3.
  		 argumentCount := byte2 bitAnd: 31.
  		 ^self normalSend].
  	opType = 1 ifTrue:
  		[messageSelector := self literal: byte3.
  		 argumentCount := byte2 bitAnd: 31.
  		 ^self superclassSend].
  	self fetchNextBytecode.
  	opType = 2 ifTrue: [^self pushMaybeContextReceiverVariable: byte3].
  	opType = 3 ifTrue: [^self pushLiteralConstant: byte3].
  	opType = 4 ifTrue: [^self pushLiteralVariable: byte3].
  	top := self internalStackTop.
  	opType = 7 ifTrue:
+ 		[lit := self literal: byte3.
+ 		 ^objectMemory storePointer: ValueIndex ofObject: lit withValue: top].
- 		[^objectMemory storePointer: ValueIndex ofObject: (self literal: byte3) withValue: top].
  	"opType = 5 is store; opType = 6 = storePop"
  	opType = 6 ifTrue:
  		[self internalPop: 1].
  	^self storeMaybeContextReceiverVariable: byte3 withValue: top!

Item was changed:
  ----- Method: StackInterpreter>>sendBreakpoint:receiver: (in category 'debug support') -----
+ sendBreakpoint: selector receiver: rcvr
- sendBreakpoint: selector receiver: receiver
  	<inline: true>
  	self sendBreak: (objectMemory firstFixedFieldOfMaybeImmediate: selector)
  		point: (objectMemory lengthOfMaybeImmediate: selector)
+ 		receiver: rcvr!
- 		receiver: receiver!

Item was removed:
- ----- Method: TAssignmentNode>>structTargetKind: (in category 'testing') -----
- structTargetKind: aCodeGen
- 	"Answer if the recever evaluates to a struct or struct pointer
- 	 and hence can be dereferenced using . or ->.  Answer any of
- 	 #struct #pointer or nil"
- 	^variable structTargetKind: aCodeGen!

Item was added:
+ ----- Method: TAssignmentNode>>structTargetKindIn: (in category 'testing') -----
+ structTargetKindIn: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil"
+ 	^variable structTargetKindIn: aCodeGen!

Item was added:
+ ----- Method: TMethod>>argAssignmentsFor:send:in: (in category 'inlining') -----
+ argAssignmentsFor: meth send: aSendNode in: aCodeGen
+ 	"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
+ 	"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
+ 
+ 	| stmtList substitutionDict argList |
+ 	stmtList := OrderedCollection new: 100.
+ 	substitutionDict := Dictionary new: 100.
+ 	argList := aSendNode args.
+ 	
+ 	meth args size > aSendNode args size ifTrue:
+ 		[self assert: (meth args first beginsWith: 'self_in_').
+ 		 argList := {aSendNode receiver}, aSendNode args].
+ 	meth args with: argList do:
+ 		[ :argName :exprNode |
+ 		(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
+ 			ifTrue:
+ 				[substitutionDict at: argName put: exprNode.
+ 				 locals remove: argName]
+ 			ifFalse:
+ 				[stmtList add: (TAssignmentNode new
+ 								setVariable: (TVariableNode new setName: argName)
+ 								expression: exprNode copy)]].
+ 	meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
+ 	^stmtList!

Item was changed:
  ----- Method: TMethod>>computePossibleSideEffectsInto:visited:in: (in category 'inlining support') -----
  computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen
  	"Add all variables written to by this method and its callees to writtenToVars.
  	 Avoid circularity via visitedSelectors"
  
  	(visitedSelectors includes: selector) ifTrue:
  		[^self].
  	visitedSelectors add: selector.
  	writtenToGlobalVarsCache ifNotNil:
  		[writtenToVars addAll: writtenToGlobalVarsCache.
  		 ^self].
  	parseTree nodesDo:
  		[ :node |
  			(node isAssignment
  			 and: [(locals includes: node variable name) not])
  				ifTrue:
  					[writtenToVars add: node variable name].
  			(node isSend
  			 and: [node isBuiltinOperator not
+ 			 and: [(node isStructSendIn: aCodeGen) not]]) ifTrue:
- 			 and: [(node isStructSend: aCodeGen) not]]) ifTrue:
  				[(aCodeGen methodNamed: node selector) ifNotNil:
  					[:method|
  					 method
  						computePossibleSideEffectsInto: writtenToVars
  						visited: visitedSelectors
  						in: aCodeGen]]].
  	writtenToGlobalVarsCache := writtenToVars copy!

Item was changed:
  ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') -----
  inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen
  	"Answer a collection of statements to replace the given send.  directReturn indicates
  	 that the send is the expression in a return statement, so returns can be left in the
  	 body of the inlined method. If exitVar is nil, the value returned by the send is not
  	 used; thus, returns need not assign to the output variable.
  
  	 Types are propagated to as-yet-untyped variables when inlining a send that is assigned,
  	 otherwise the assignee variable type must match the return type of the inlinee.  Return
  	 types are not propagated."
  
+ 	| sel meth methArgs exitLabel inlineStmts label exitType |
- 	| sel meth exitLabel inlineStmts label exitType |
  	sel := aSendNode selector.
  	meth := aCodeGen methodNamed: sel.
+ 	methArgs := meth args.
  	"convenient for debugging..."
  	self maybeBreakFor: aSendNode in: aCodeGen.
+ 	(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
+ 		[methArgs := methArgs allButFirst].
+ 	methArgs size = aSendNode args size ifFalse:
- 	meth args size = aSendNode args size ifFalse:
  		[^nil].
+ 	methArgs with: aSendNode args do:
- 	meth args with: aSendNode args do:
  		[:formal :actual|
  		(actual isVariable
  		and: [(aCodeGen
  				variableOfType: (self typeFor: formal using: aCodeGen)
  				acceptsValueOfType: (self typeFor: actual name in: aCodeGen)) not]) ifTrue:
  			[aCodeGen logger
  				nextPutAll:
  					'type mismatch for formal ', formal, ' and actual ', actual name,
  					' when inlining ', sel, ' in ', selector, '. Use a cast.';
  				cr; flush]]. 
  	meth := meth copy.
  
  	"Propagate the return type of an inlined method"
  	(directReturn or:[exitVar notNil]) ifTrue:[
  		exitType := directReturn 
  			ifTrue:[returnType] 
  			ifFalse:[(self typeFor: exitVar in: aCodeGen) ifNil:[#sqInt]].
  		(exitType = #void or:[exitType = meth returnType]) 
  			ifFalse:[meth propagateReturnIn: aCodeGen]].
  
  	meth renameVarsForInliningInto: self except: #() in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
  	self addVarsDeclarationsAndLabelsOf: meth except: #().
  	meth hasReturn ifTrue:[
  		directReturn ifFalse:[
  			exitLabel := self unusedLabelForInliningInto: self.
  			(meth exitVar: exitVar label: exitLabel) "is label used?"
  				ifTrue: [ labels add: exitLabel ]
  				ifFalse: [ exitLabel := nil ]]].
  	(inlineStmts := OrderedCollection new: 100)
  		add: (label := TLabeledCommentNode new setComment: 'begin ', sel);
+ 		addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen);
- 		addAll: (self argAssignmentsFor: meth args: aSendNode args in: aCodeGen);
  		addAll: meth statements.  "method body"
  	"Vile hacks to prevent too many labels.  If the C compiler inlines functions it can duplicate
  	 labels and cause compilation to fail.  The second statement prevents us creating labels in
  	 anything other than the interpreter.  If we add labels to small functions that may be inlined
  	 by the C compiler then the label can be duplicated by the C compiler and cause the assembler
  	 to fail.  eem 9/20/2008 12:29"
  	(aCodeGen wantsLabels
  	 and: [meth asmLabel
  	 and: [meth mustAsmLabel or: [meth hasMoreSendsThan: 20]]]) ifTrue:
  		[label asmLabel: sel].
  	(directReturn
  	 and: [meth endsWithReturn not]) ifTrue:
  		[inlineStmts add:
  			(TReturnNode new setExpression: (TVariableNode new setName: 'nil'))].
  	exitLabel ~= nil ifTrue:
  		[inlineStmts add:
  			(TLabeledCommentNode new setLabel:
  				exitLabel comment: 'end ', meth selector)].
  	^inlineStmts!

Item was changed:
  ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
  prepareMethodIn: aCodeGen
  	"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
  	 with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
  	 As a hack also update the types of variables introduced to implement cascades correctly.
  	 This has to be done at the same time as this is done, so why not piggy back here?"
  	extraVariableNumber ifNotNil:
  		[declarations keysAndValuesDo:
  			[:varName :decl|
  			decl isBlock ifTrue:
  				[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
  				 locals add: varName.
  				 self declarationAt: varName
  					put: (decl value: self value: aCodeGen), ' ', varName]]].
  	aCodeGen
  		pushScope: declarations
  		while:"N.B.  nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
  			[parseTree nodesWithParentsDo:
  				[:node :parent|
  				 node isSend ifTrue:
  					[(aCodeGen isBuiltinSelector: node selector)
  						ifTrue:
  							[node isBuiltinOperator: true.
  							"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
  							 (node selector = #to:by:do:
  							  and: [node args size = 4]) ifTrue:
  								[| limitExpr |
  								 limitExpr := node args first.
  								 (limitExpr anySatisfy:
  										[:subNode|
  										subNode isSend
  										and: [(aCodeGen isBuiltinSelector: subNode selector) not
+ 										and: [(subNode isStructSendIn: aCodeGen) not]]])
- 										and: [(subNode isStructSend: aCodeGen) not]]])
  									ifTrue: [locals add: node args last name]
  									ifFalse:
  										[node arguments: node args allButLast]]]
  						ifFalse:
  							[(CaseStatements includes: node selector) ifTrue:
  								[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node})].
  							 (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
  								[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]]]]]!

Item was changed:
  ----- Method: TMethod>>transformToStructClassMethodFor: (in category 'transformations') -----
  transformToStructClassMethodFor: aCCodeGenerator
  	"Transform this method so that it can be used on an instance of a struct class (VMStructType subclass).
  	 Convert inst var refs into field dereferences of self.  Add selfSelector as the first argument with the
  	 right struct type. As a complete hack to avoid breaking the inlinert don't use 'self' as the name for self
+ 	 as this causes serious type redefinitions ``somewhere'' in the inliner."
- 	 as this causes surious type redefinitions ``somewhere'' in the inliner."
  	| replacements selfNode typeForSelf |
  	self isStructAccessor ifTrue:
  		[^returnType := definingClass returnTypeForAccessor: selector].
  	replacements := IdentityDictionary new.
  	selfNode := TVariableNode new setName: 'self_in_', (aCCodeGenerator cFunctionNameFor: selector).
  	args do:
  		[:var|
  		(definingClass isAccessor: var) ifTrue:
  			[self error: 'In ', definingClass name, '>>', selector, ' ', var, ' arg shadows struct field and will break during translation!!']].
  	parseTree nodesDo:
  		[:node|
  		node isVariable ifTrue:
  			[node name = 'self' ifTrue:
  				[replacements at: node put: selfNode copy].
  			 (definingClass isAccessor: node name) ifTrue:
  				[replacements
  					at: node
  					put: (TSendNode new
  							setSelector: node name asSymbol
  							receiver: selfNode
  							arguments: #())]]].
  	replacements notEmpty ifTrue:
  		[parseTree := parseTree replaceNodesIn: replacements].
  	typeForSelf := self typeForSelf.
  	self assert: (typeForSelf notNil and: [typeForSelf ~~ #implicit]).
  	self declarationAt: (args addFirst: selfNode name)
  		put: (declarations removeKey: 'self'), '_in_', (aCCodeGenerator cFunctionNameFor: selector)!

Item was removed:
- ----- Method: TParseNode>>structTargetKind: (in category 'testing') -----
- structTargetKind: aCodeGen
- 	"Answer if the recever evaluates to a struct or struct pointer
- 	 and hence can be dereferenced using . or ->.  Answer any of
- 	 #struct #pointer or nil"
- 	^nil!

Item was added:
+ ----- Method: TParseNode>>structTargetKindIn: (in category 'testing') -----
+ structTargetKindIn: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil"
+ 	^nil!

Item was changed:
  ----- Method: TSendNode>>emitCCodeAsFieldReferenceOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsFieldReferenceOn: aStream level: level generator: aCodeGen
  	"If appropriate, translate this message send as a pointer dereference"
  
  	| parenCount |
+ 	(self isStructSendIn: aCodeGen) ifFalse:
- 	(self isStructSend: aCodeGen) ifFalse:
  		[^false].
  
  	parenCount := receiver isSend ifTrue: [2] ifFalse: [1].
  	aStream next: parenCount put: $(.
  	receiver  emitCCodeAsExpressionOn: aStream level: 0 generator: aCodeGen.
  	parenCount > 1 ifTrue:
  		[aStream nextPut: $)].
+ 	(receiver structTargetKindIn: aCodeGen) caseOf: {
- 	(receiver structTargetKind: aCodeGen) caseOf: {
  		[#pointer] -> [aStream nextPut: $-; nextPut: $>].
  		[#struct] -> [aStream nextPut: $.] }.
  	aStream nextPutAll: (aCodeGen cFunctionNameFor: selector).
  	arguments isEmpty ifFalse:
  		[self assert: arguments size = 1.
  		 aStream nextPutAll: ' = '.
  		 arguments first emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen].
  	aStream nextPut: $).
  	^true!

Item was changed:
  ----- Method: TSendNode>>emitCCodeAsFunctionCallOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsFunctionCallOn: aStream level: level generator: aCodeGen
  
  	"Translate this message send into a C function call"
  	"Special case for pluggable modules. Replace messages to interpreterProxy
  	 by interpreterProxy->message(..) if the message is not builtin"
  	(aCodeGen messageReceiverIsInterpreterProxy: self) ifTrue:
  		[(aCodeGen noteUsedPluginFunction: selector) ifTrue:
  			[aStream nextPutAll: 'interpreterProxy->']].
+ 
  	"Translate this message send into a C function call."
  	aStream nextPutAll: (aCodeGen cFunctionNameFor: selector); nextPut: $(.
  	"Only include the receiver as the first argument in certain cases.
  	 The receiver is always included if it is an expression.
  	 If it is a variable:
  		 If the vmClass says it is an implicit variable, don't include it.
  		 If the variable is 'self' and the method being called is not in
  		 the method set (i.e. it is some external code), don't include it."
  	(self shouldExcludeReceiverAsFirstArgument: aCodeGen) ifFalse:
+ 		[(receiver structTargetKindIn: aCodeGen) == #struct ifTrue:
+ 			[aStream nextPut: $&].
+ 		 receiver emitCCodeOn: aStream level: level generator: aCodeGen.
- 		[receiver emitCCodeOn: aStream level: level generator: aCodeGen.
  		 arguments isEmpty ifFalse:
  			[aStream nextPutAll: ', ']].
  	arguments
  		do: [ :arg| arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]
  		separatedBy: [aStream nextPut: $,; space].
  	aStream nextPut: $)!

Item was removed:
- ----- Method: TSendNode>>isSelfReference: (in category 'C code generation') -----
- isSelfReference: varNode
- 	^(varNode name beginsWith: 'self')
- 	  and: [varNode name = 'self' or: [varNode name beginsWith: 'self_in_']]!

Item was added:
+ ----- Method: TSendNode>>isSelfReference:in: (in category 'C code generation') -----
+ isSelfReference: varNode in: aCodeGen
+ 	^(varNode name beginsWith: 'self')
+ 	  and: [varNode name = 'self' or: [varNode name beginsWith: 'self_in_']]!

Item was added:
+ ----- Method: TSendNode>>isStructReference:in: (in category 'C code generation') -----
+ isStructReference: varNode in: aCodeGen
+ 	^(varNode structTargetKindIn: aCodeGen) notNil!

Item was removed:
- ----- Method: TSendNode>>isStructSend: (in category 'testing') -----
- isStructSend: aCodeGen
- 	"Answer if the recever is a send of a structure accessor.
- 	 This is tricky.  We want
- 		foo bar => foo->bar
- 		foo bar => foo.bar
- 		foo bar: expr => foo->bar = expr
- 		foo bar: expr => foo.bar = expr
- 	 depending on whether foo is a struct or a pointer to a struct,
- 	 but only if both foo is a struct type and bar is a field accessor.
- 	 The tricky cases are self-sends within struct class methods.  Here we need to
- 	 distinguish between self-sends of ordinary methods from self sends of accessors."
- 	^arguments size <= 1
- 	   and: [(receiver structTargetKind: aCodeGen) notNil
- 	   and: [(aCodeGen methodNamed: selector)
- 				ifNil: [false]
- 				ifNotNil: [:method| method isStructAccessor]]]!

Item was added:
+ ----- Method: TSendNode>>isStructSendIn: (in category 'testing') -----
+ isStructSendIn: aCodeGen
+ 	"Answer if the recever is a send of a structure accessor.
+ 	 This is tricky.  We want
+ 		foo bar => foo->bar
+ 		foo bar => foo.bar
+ 		foo bar: expr => foo->bar = expr
+ 		foo bar: expr => foo.bar = expr
+ 	 depending on whether foo is a struct or a pointer to a struct,
+ 	 but only if both foo is a struct type and bar is a field accessor.
+ 	 The tricky cases are self-sends within struct class methods.  Here we need to
+ 	 distinguish between self-sends of ordinary methods from self sends of accessors."
+ 	^arguments size <= 1
+ 	   and: [(receiver structTargetKindIn: aCodeGen) notNil
+ 	   and: [(aCodeGen methodNamed: selector)
+ 				ifNil: [false]
+ 				ifNotNil: [:method| method isStructAccessor]]]!

Item was changed:
  ----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') -----
  shouldExcludeReceiverAsFirstArgument: aCodeGen
  	"Only include the receiver as the first argument in certain cases.
  	 The receiver is always included if it is an expression.
  	 If it is a variable:
  		 If the vmClass says it is an implicit variable, don't include it.
  		 If the method's definingClass says it is an implicit variable, don't include it.
  		 If the variable is 'self' and the method being called is not in
  		 the method set (i.e. it is some external code), don't include it.
  		 If it is a struct send of something the vm says is an implicit variable, don't include it."
  	| m |
  	(receiver isSend
  	 and: [receiver receiver isVariable
+ 	 and: [(self isSelfReference: receiver receiver in: aCodeGen)
+ 		or: [self isStructReference: receiver receiver in: aCodeGen]]]) ifTrue:
- 	 and: [self isSelfReference: receiver receiver]]) ifTrue:
  		[^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector].
  
  	^receiver isVariable
  	    and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name)
+ 		    or: [(self isSelfReference: receiver in: aCodeGen)
- 		    or: [(self isSelfReference: receiver)
  			    and: [(m := aCodeGen methodNamed: selector) isNil
  					or: [m typeForSelf == #implicit]]]]!

Item was removed:
- ----- Method: TSendNode>>structTargetKind: (in category 'testing') -----
- structTargetKind: aCodeGen
- 	"Answer if the recever evaluates to a struct or struct pointer
- 	 and hence can be dereferenced using . or ->.  Answer any of
- 	 #struct #pointer or nil.  Right now we don't need or support
- 	 structure return so this method answers either #pointer or nil."
- 	selector == #cCoerceSimple:to: ifTrue:
- 		[^(VMStructType isTypePointerToStruct: arguments last value) ifTrue:
- 			[#pointer]].
- 
- 	selector == #addressOf: ifTrue:
- 		[^#pointer].
- 
- 	selector == #at: ifTrue:
- 		[receiver isVariable ifTrue:
- 			[(aCodeGen typeOfVariable: receiver name) ifNotNil:
- 				[:type| | derefType |
- 				 type last = $* ifFalse:
- 					[^receiver structTargetKind: aCodeGen].
- 				 (VMStructType isTypeStruct: (aCodeGen
- 											extractTypeFor: receiver name
- 											fromDeclaration: type allButLast)) ifTrue:
- 						[^#struct]]].
- 		(receiver structTargetKind: aCodeGen) ifNotNil:
- 			[:kind| ^kind]].
- 
- 	(aCodeGen selectorReturnsPointerToStruct: selector) ifTrue:
- 		[^#pointer].
- 
- 	(aCodeGen selectorReturnsStruct: selector) ifTrue:
- 		[^#struct].
- 
- 	^nil!

Item was added:
+ ----- Method: TSendNode>>structTargetKindIn: (in category 'testing') -----
+ structTargetKindIn: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil.  Right now we don't need or support
+ 	 structure return so this method answers either #pointer or nil."
+ 	selector == #cCoerceSimple:to: ifTrue:
+ 		[^(VMStructType isTypePointerToStruct: arguments last value) ifTrue:
+ 			[#pointer]].
+ 
+ 	selector == #addressOf: ifTrue:
+ 		[^#pointer].
+ 
+ 	selector == #at: ifTrue:
+ 		[receiver isVariable ifTrue:
+ 			[(aCodeGen typeOfVariable: receiver name) ifNotNil:
+ 				[:type| | derefType |
+ 				 type last = $* ifFalse:
+ 					[^receiver structTargetKindIn: aCodeGen].
+ 				 (VMStructType isTypeStruct: (aCodeGen
+ 											extractTypeFor: receiver name
+ 											fromDeclaration: type allButLast)) ifTrue:
+ 						[^#struct]]].
+ 		(receiver structTargetKindIn: aCodeGen) ifNotNil:
+ 			[:kind| ^kind]].
+ 
+ 	(aCodeGen selectorReturnsPointerToStruct: selector) ifTrue:
+ 		[^#pointer].
+ 
+ 	(aCodeGen selectorReturnsStruct: selector) ifTrue:
+ 		[^#struct].
+ 
+ 	^nil!

Item was removed:
- ----- Method: TVariableNode>>structTargetKind: (in category 'testing') -----
- structTargetKind: aCodeGen
- 	"Answer if the recever evaluates to a struct or struct pointer
- 	 and hence can be dereferenced using . or ->.  Answer any of
- 	 #struct #pointer or nil"
- 	^aCodeGen structTargetKindForVariableName: name!

Item was added:
+ ----- Method: TVariableNode>>structTargetKindIn: (in category 'testing') -----
+ structTargetKindIn: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil"
+ 	^aCodeGen structTargetKindForVariableName: name!



More information about the Vm-dev mailing list