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

commits at source.squeak.org commits at source.squeak.org
Mon Jan 25 01:01:09 UTC 2016


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

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

Name: VMMaker.oscog-eem.1665
Author: eem
Time: 25 January 2016, 4:59:23.956016 pm
UUID: fcc356bf-0c12-4902-8cac-f0b6a96194d9
Ancestors: VMMaker.oscog-eem.1664

Spur:
Add a free space mode to the leak checked to help track down the Newspeak image startup crashes we've seen recently at Cadence.  So checkFreeSpace is refactored to checkFreeSpace: gcMode.

Insist on inlining objectAfter:limit:.  Never inline prepareForSnapshot or writeImageFileIO (for C-level debugging).

Spur Cogit: Support CompiledMethod indexing in genPrimitiveAt[Put].  Refactor to pull-out the num-literals access from genPrimitiveObjectAt.

CoInterpreter: Remove the atCache from the CoInterpreter.  It's of little benefit in the Cogit.

StackInterpreter: Don't eneter an object into the atCache if it is 16-bit indexable (this is easier, or rather likely more efficient for non-16-bit access, than implementing 16-bit indexability in the atCache).

Slang: Support allMask: for the Spur free space leak check.  Put log time stamps in more informative places.  Don't plant comments for elided inlined methods.

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

Item was added:
+ ----- Method: CCodeGenerator>>generateAllMask:on:indent: (in category 'C translation') -----
+ generateAllMask: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPutAll: '(('.
+ 	self generateBitAnd: msgNode on: aStream indent: level.
+ 	aStream nextPutAll: ') == '.
+ 	self emitCExpression: msgNode args first on: aStream indent: level.
+ 	aStream nextPut: $)!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#>>>			#generateSignedShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:			#generateBitAnd:on:indent:
  	#bitOr:				#generateBitOr:on:indent:
  	#bitXor:			#generateBitXor:on:indent:
  	#bitShift:			#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert:on:indent:
  	#bitInvert64		#generateBitInvert:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  	#truncateTo:		#generateTruncateTo:on:indent:
  	#rounded			#generateRounded:on:indent:
  
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 	#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  	#timesRepeat:	#generateTimesRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#ifNotNil:		#generateIfNotNil:on:indent:
  	#ifNil:			#generateIfNil:on:indent:
  	#ifNotNil:ifNil:	#generateIfNotNilIfNil:on:indent:
  	#ifNil:ifNotNil:	#generateIfNilIfNotNil:on:indent:
  
  	#at:				#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#cppIf:ifTrue:ifFalse:		#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:				#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#addressOf:put:			#generateAddressOf:on:indent:
  	#asAddress:put:			#generateAsAddress:on:indent:
  	#signedIntFromLong64		#generateSignedIntFromLong64:on:indent:
  	#signedIntFromLong		#generateSignedIntFromLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToLong64		#generateSignedIntToLong64:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement			#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger		#generateAsUnsignedInteger:on:indent:
  	#asLong					#generateAsLong:on:indent:
  	#asUnsignedLong			#generateAsUnsignedLong:on:indent:
  	#asVoidPointer				#generateAsVoidPointer:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#flag:						#generateFlag:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
+ 	#allMask:					#generateAllMask:on:indent:
  	#noMask:					#generateNoMask:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  
  	#bytesPerOop 				#generateBytesPerOop:on:indent:
  	#bytesPerWord 			#generateBytesPerWord:on:indent:
  	#wordSize		 			#generateBytesPerWord:on:indent:
  	#baseHeaderSize			#generateBaseHeaderSize:on:indent:
  	#minSmallInteger			#generateSmallIntegerConstant:on:indent:
  	#maxSmallInteger			#generateSmallIntegerConstant:on:indent:
  	
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#value								#generateValue:on:indent:
  	#value:								#generateValue:on:indent:
  	#value:value:						#generateValue:on:indent:
  	#value:value:value:					#generateValue:on:indent:
  	#value:value:value:value:			#generateValue:on:indent:
  
  	#deny:								#generateDeny:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented			#generateSmalltalkMetaError:on:indent:
  	#subclassResponsibility			#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:					#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:				#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:			#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:			#generateIfFalseIfTrueAsArgument:on:indent:
  	#ifNotNil:				#generateIfNotNilAsArgument:on:indent:	
  	#ifNil:					#generateIfNilAsArgument:on:indent:
  	#ifNotNil:ifNil:			#generateIfNotNilIfNilAsArgument:on:indent:
  	#ifNil:ifNotNil:			#generateIfNilIfNotNilAsArgument:on:indent:
  	#cCode:				#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:		#generateInlineCCodeAsArgument:on:indent:
  	#cppIf:ifTrue:ifFalse:	#generateInlineCppIfElseAsArgument:on:indent:
  	#cppIf:ifTrue:			#generateInlineCppIfElseAsArgument:on:indent:
  
  	#value					#generateValueAsArgument:on:indent:
  	#value:					#generateValueAsArgument:on:indent:
  	#value:value:			#generateValueAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was changed:
  ----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	"Override to avoid repeating StackInterpreter's declarations and add our own extensions"
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile: (aCCodeGenerator vmClass isThreadedVM 
  			ifTrue: ['"cointerpmt.h"'] 
  			ifFalse: ['"cointerp.h"']);
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator vmClass
  		declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: aCCodeGenerator interpreterVersion.
  	aCCodeGenerator
  		var: #heapBase type: #usqInt;
  		var: #statCodeCompactionUsecs type: #usqLong;
  		var: #maxLiteralCountForCompile
  			declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
  		var: #minBackwardJumpCountForCompile
  			declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
+ 	aCCodeGenerator removeVariable: 'atCache'.
  	aCCodeGenerator
  		var: #reenterInterpreter
  		declareC: 'jmp_buf reenterInterpreter; /* private export */'.
  	aCCodeGenerator
  		var: #primTraceLogIndex type: #'unsigned char';
  		var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
  		var: #traceLog
  		declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
  		var: #traceSources type: #'char *' array: TraceSources!

Item was added:
+ ----- Method: CoInterpreter class>>initializeCaches (in category 'initialization') -----
+ initializeCaches
+ 	"Eliminate the AtCache"
+ 	AtCacheTotalSize := AtCacheSize := AtCacheMask := AtCacheFixedFields := AtCacheFmt := AtCacheOop := #undefined!

Item was changed:
  ----- Method: CoInterpreter class>>initializeFrameIndices (in category 'initialization') -----
  initializeFrameIndices
  	"Format of a stack frame.  Word-sized indices relative to the frame pointer.
  	 Terminology
  		Frames are either single (have no context) or married (have a context).
  		Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
  	 Stacks grow down:
  
  			receiver for method activations/closure for block activations
  			arg0
  			...
  			argN
  			caller's saved ip/this stackPage (for a base frame)
  	fp->	saved fp
  			method
  			context (initialized to nil)
  			frame flags (interpreter only)
  			saved method ip (initialized to 0; interpreter only)
  			receiver
  			first temp
  			...
  	sp->	Nth temp
  
  	In an interpreter frame
  		frame flags holds
  			the backward jump count (see ifBackwardsCheckForEvents)
  			the number of arguments (since argument temporaries are above the frame)
  			the flag for a block activation
  			and the flag indicating if the context field is valid (whether the frame is married).
  		saved method ip holds the saved method ip when the callee frame is a machine code frame.
  		This is because the saved method ip is actually the ceReturnToInterpreterTrampoline address.
  	In a machine code frame
  		the flag indicating if the context is valid is the least significant bit of the method pointer
  		the flag for a block activation is the next most significant bit of the method pointer
  
  	Interpreter frames are distinguished from method frames by the method field which will
  	be a pointer into the heap for an interpreter frame and a pointer into the method zone for
  	a machine code frame.
  
  	The first frame in a stack page is the baseFrame and is marked as such by a saved fp being its stackPage,
  	in which case the first word on the stack is the caller context (possibly hybrid) beneath the base frame."
  
  	| fxCallerSavedIP fxSavedFP fxMethod fxIFrameFlags fxThisContext fxIFReceiver fxMFReceiver fxIFSavedIP |
  	fxCallerSavedIP := 1.
  	fxSavedFP := 0.
  	fxMethod := -1.
  	fxThisContext := -2.
  	fxIFrameFlags := -3.	"Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
  							 Can find ``is block'' bit
  							 Can find ``has context'' bit"
  	fxIFSavedIP := -4.
  	fxIFReceiver := -5.
  	fxMFReceiver := -3.
  
+ 	"For debugging undefine values that differ in the StackInterpreter."
+ 	FrameSlots := #undefined.
- 	"For debugging nil out values that differ in the StackInterpreter."
- 	FrameSlots := #undeclared.
  	IFrameSlots := fxCallerSavedIP - fxIFReceiver + 1.
  	MFrameSlots := fxCallerSavedIP - fxMFReceiver + 1.
  
  	FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord.
  	"In Cog a base frame's caller context is stored on the first word of the stack page."
+ 	FoxCallerContext := #undefined.
- 	FoxCallerContext := #undeclared.
  	FoxSavedFP := fxSavedFP * BytesPerWord.
  	FoxMethod := fxMethod * BytesPerWord.
  	FoxThisContext := fxThisContext * BytesPerWord.
+ 	FoxFrameFlags := #undefined.
- 	FoxFrameFlags := #undeclared.
  	FoxIFrameFlags := fxIFrameFlags * BytesPerWord.
  	FoxIFSavedIP := fxIFSavedIP * BytesPerWord.
+ 	FoxReceiver := #undefined.
- 	FoxReceiver := #undeclared.
  	FoxIFReceiver := fxIFReceiver * BytesPerWord.
  	FoxMFReceiver := fxMFReceiver * BytesPerWord.
  
  	"N.B.  There is room for one more flag given the current 8 byte alignment of methods (which
  	 is at least needed to distinguish the checked and uncecked entry points by their alignment."
  	MFMethodFlagHasContextFlag := 1.
  	MFMethodFlagIsBlockFlag := 2.
  	MFMethodFlagFrameIsMarkedFlag := 4. "for pathTo:using:followWeak:"
  	MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag + MFMethodFlagFrameIsMarkedFlag.
  	MFMethodMask := (MFMethodFlagsMask + 1) negated!

Item was added:
+ ----- Method: CoInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
+ bytecodePrimAt
+ 	"Override to eliminate the atCache, something of little benefit to the JIT."
+ 	messageSelector := self specialSelector: 16.
+ 	argumentCount := 1.
+ 	self normalSend!

Item was added:
+ ----- Method: CoInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
+ bytecodePrimAtPut
+ 	"Override to eliminate the atCache, something of little benefit to the JIT."
+ 	messageSelector := self specialSelector: 17.
+ 	argumentCount := 2.
+ 	self normalSend!

Item was added:
+ ----- Method: CoInterpreter>>commonVariable:at:cacheIndex: (in category 'indexing primitive support') -----
+ commonVariable: rcvr at: index cacheIndex: atIx
+ 	"There is no atCache in the CoInterpreter."
+ 	self shouldNotImplement!

Item was added:
+ ----- Method: CoInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') -----
+ commonVariable: rcvr at: index put: value cacheIndex: atIx
+ 	"There is no atCache in the CoInterpreter."
+ 	self shouldNotImplement!

Item was added:
+ ----- Method: CoInterpreter>>flushAtCache (in category 'method lookup cache') -----
+ flushAtCache
+ 	"There is no atCache in the CoInterpreter."
+ 	<inline: true>!

Item was added:
+ ----- Method: CogObjectRepresentation>>genGetMethodHeaderOf:into:scratch: (in category 'compile abstract instructions') -----
+ genGetMethodHeaderOf: methodReg into: headerReg scratch: scratchReg
+ 	"Get the method header (first word) of a CompiledMethod into headerReg.
+ 	 Deal with the method possibly being cogged."
+ 	| jumpNotCogged |
+ 	<var: #jumpNotCogged type: #'AbstractInstruction *'>
+ 	cogit MoveMw: objectMemory baseHeaderSize r: methodReg R: headerReg.
+ 	jumpNotCogged := self genJumpSmallInteger: headerReg scratchReg: scratchReg.
+ 	cogit MoveMw: (cogit offset: CogMethod of: #methodHeader) r: headerReg R: headerReg.
+ 	jumpNotCogged jmpTarget: cogit Label.
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveAt (in category 'primitive generators') -----
  genPrimitiveAt
+ 	| formatReg convertToIntAndReturn methodInBounds
- 	| formatReg convertToIntAndReturn
  	  jumpNotIndexable jumpImmediate jumpBadIndex
+ 	  jumpIsBytes jumpIsShorts jumpIsWords jumpIsMethod
+ 	  jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
+ 	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds
+ 	  jumpMethodOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
- 	  jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
- 	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpIsShorts type: #'AbstractInstruction *'>
+ 	<var: #jumpIsMethod type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	<var: #methodInBounds type: #'AbstractInstruction *'>
  	<var: #jumpWordTooBig type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
  	<var: #convertToIntAndReturn type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpMethodOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
  
  	cogit genLoadArgAtDepth: 0 into: Arg0Reg.
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	cogit MoveR: Arg0Reg R: Arg1Reg.
  	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
  	cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self genGetFormatOf: ReceiverResultReg
  		into: (formatReg := SendNumArgsReg)
  		leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
  
  	self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpIsArray := cogit JumpZero: 0.
  	jumpNotIndexable := cogit JumpBelow: 0.
  					cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpIsShorts := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	jumpIsWords := cogit JumpAboveOrEqual: 0.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexable jmpTarget: cogit Label.
  	jumpNotIndexable := cogit Jump: 0.
  
+ 	jumpIsArray jmpTarget:
+ 		(cogit CmpR: Arg1Reg R: ClassReg).
+ 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ 	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 	cogit genPrimReturn.
+ 
  	jumpIsBytes jmpTarget:
  		(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
+ 		cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ 		cogit SubR: TempReg R: ClassReg;
- 		cogit AndCq: objectMemory wordSize - 1 R: formatReg.
- 		cogit SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ 	jumpIsMethod := cogit JumpAboveOrEqual: 0.
+ 	methodInBounds :=
+ 	(cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg).
- 	cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
  	cogit backEnd byteReadsZeroExtend
  		ifTrue:
  			[cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg]
  		ifFalse:
  			[cogit "formatReg already contains a value <= 16r1f, so no need to zero it"
  				MoveXbr: Arg1Reg R: ReceiverResultReg R: formatReg;
  				MoveR: formatReg R: ReceiverResultReg].
  	convertToIntAndReturn := cogit Label.
  	self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpIsShorts jmpTarget:
  		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
  		cogit AndCq: 1 R: formatReg.
  		cogit SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: Arg1Reg R: ReceiverResultReg.
  	cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
  	cogit Jump: convertToIntAndReturn.
  
  	jumpIsWords jmpTarget:
  		(cogit CmpR: Arg1Reg R: ClassReg).
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
  	jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
  	cogit MoveR: TempReg R: ReceiverResultReg.
  	cogit Jump: convertToIntAndReturn.
  
  	jumpHasFixedFields jmpTarget:
  		(cogit AndCq: objectMemory classIndexMask R: TempReg).
  	cogit MoveR: TempReg R: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
  	jumpIsContext := cogit JumpZero: 0.
  	cogit PushR: ClassReg.
  	self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
  	cogit PopR: ClassReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit
  		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
  		SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	"index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
  	cogit AddR: formatReg R: Arg1Reg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
+ 	jumpIsMethod jmpTarget: cogit Label.
+ 	"Now check that the index is beyond the method's literals..."
+ 	self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: ClassReg scratch: TempReg.
+ 	cogit CmpR: Arg1Reg R: ClassReg.
+ 	cogit JumpBelow: methodInBounds.
+ 	jumpMethodOutOfBounds := cogit Jump: 0.
- 	jumpIsArray jmpTarget:
- 		(cogit CmpR: Arg1Reg R: ClassReg).
- 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
- 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- 	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- 	cogit genPrimReturn.
  
  	jumpWordTooBig jmpTarget:
+ 	(jumpFixedFieldsOutOfBounds jmpTarget:
- 	(cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg).
- 
- 	jumpFixedFieldsOutOfBounds jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
+ 	(jumpMethodOutOfBounds jmpTarget:
  	(jumpShortsOutOfBounds jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpNotIndexable jmpTarget:
  	(jumpIsContext jmpTarget:
  	(jumpBadIndex jmpTarget:
+ 	(jumpImmediate jmpTarget: cogit Label)))))))))).
- 	(jumpImmediate jmpTarget: cogit Label)))))))).
  
+ 	^0 "Can't be complete because of contexts."!
- 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveAtPut (in category 'primitive generators') -----
  genPrimitiveAtPut
+ 	| formatReg methodInBounds
+ 	  jumpImmediate jumpBadIndex jumpImmutable jumpNotIndexablePointers jumpNotIndexableBits
- 	| formatReg jumpImmediate jumpBadIndex jumpImmutable
- 	  jumpNotIndexablePointers jumpNotIndexableBits
  	  jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpIsShorts jumpHasFixedFields
  	  jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
  	  jumpWordsOutOfBounds jumpShortsOutOfBounds jumpBytesOutOfBounds
  	  jumpShortsOutOfRange jumpWordsOutOfRange jumpBytesOutOfRange
  	  jumpNonSmallIntegerValue jumpNotPointers
  	  |
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpIsShorts type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	<var: #methodInBounds type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexableBits type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfRange type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfRange type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfRange type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexablePointers type: #'AbstractInstruction *'>
  
  	cogit genLoadArgAtDepth: 1 into: Arg0Reg.
  	cogit genLoadArgAtDepth: 0 into: Arg1Reg.
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self cppIf: IMMUTABILITY
  		ifTrue:
  		[ self genGetFormatOf: ReceiverResultReg
  			into: (formatReg := SendNumArgsReg)
  			leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
  		jumpImmutable := self genJumpBaseHeaderImmutable: TempReg ]
  		ifFalse: 
  		[ self genGetFormatOf: ReceiverResultReg
  			into: (formatReg := SendNumArgsReg)
  			leastSignificantHalfOfBaseHeaderIntoScratch: NoReg ].
  
  	self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpNotPointers := cogit JumpAbove: 0.
  	"optimistic store check; assume index in range (almost always is)."
  	self genStoreCheckReceiverReg: ReceiverResultReg
  		valueReg: Arg1Reg
  		scratchReg: TempReg
  		inFrame: false.
  
  	cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpNotIndexablePointers := cogit JumpBelow: 0.
  	jumpHasFixedFields := cogit JumpNonZero: 0.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpHasFixedFields jmpTarget: cogit Label.
  	self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
  	jumpIsContext := cogit JumpZero: 0.
  	"get # fixed fields in formatReg"
  	cogit PushR: ClassReg.
  	self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
  	cogit PopR: ClassReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
  	cogit SubR: formatReg R: ClassReg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: formatReg R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
+ 	jumpNotPointers jmpTarget: cogit Label.
- 	jumpNotPointers jmpTarget:
- 		(cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg).
- 	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
  	jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
  					cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpIsShorts := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexableBits := cogit JumpBelow: 0.
  
  	"fall through to double words"
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	(cogit lastOpcode setsConditionCodesFor: JumpLess) ifFalse:
  		[cogit CmpCq: 0 R: TempReg]. "N.B. FLAGS := TempReg - 0"
  	jumpWordsOutOfRange := cogit JumpLess: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpIsBytes jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg).
  	jumpBytesOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
+ 	cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ 	cogit SubR: TempReg R: ClassReg.
- 	cogit AndCq: objectMemory wordSize - 1 R: formatReg.
- 	cogit SubR: formatReg R: ClassReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ 	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
+ 	methodInBounds :=
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  	cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpIsShorts jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
  	jumpShortsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
+ 	"Now check that the index is beyond the method's literals..."
+ 	jumpIsCompiledMethod jmpTarget: cogit Label.
+ 	self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: ClassReg scratch: TempReg.
+ 	cogit CmpR: Arg0Reg R: ClassReg.
+ 	cogit JumpBelow: methodInBounds.
+ 
  	jumpIsContext jmpTarget: 
  	(jumpNotIndexableBits jmpTarget:
  	(jumpBytesOutOfRange jmpTarget:
  	(jumpWordsOutOfRange jmpTarget:
  	(jumpShortsOutOfRange jmpTarget:
  	(jumpIsCompiledMethod jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsOutOfBounds jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpNotIndexablePointers jmpTarget:
  	(jumpNonSmallIntegerValue jmpTarget:
  	(jumpFixedFieldsOutOfBounds jmpTarget: cogit Label)))))))))))).
  	
  	self cppIf: IMMUTABILITY
  		ifTrue: [jumpImmutable jmpTarget: jumpIsContext getJmpTarget].
  
  	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  	self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
  
  	jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
  
+ 	^0 "Can't be complete because of contexts."!
- 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>getLiteralCountOf:plusOne:inBytes:into:scratch: (in category 'compile abstract instructions') -----
+ getLiteralCountOf: methodReg plusOne: plusOne inBytes: inBytes into: litCountReg scratch: scratchReg
+ 	"Get the literal count of a CompiledMethod into headerReg, plus one if requested.
+ 	  If inBytes is true, scale the count by the word size.  Deal with the possibility of
+ 	 the method being cogged."
+ 	self genGetMethodHeaderOf: methodReg into: litCountReg scratch: scratchReg.
+ 	inBytes
+ 		ifTrue:
+ 			[cogit
+ 				AndCq: coInterpreter alternateHeaderNumLiteralsMask << 1 R: litCountReg;
+ 				LogicalShiftLeftCq: 1 R: litCountReg]
+ 		ifFalse:
+ 			[cogit
+ 				LogicalShiftRightCq: 1 R: litCountReg;
+ 				AndCq: coInterpreter alternateHeaderNumLiteralsMask R: litCountReg].
+ 	plusOne ifTrue:
+ 		[cogit AddCq: (inBytes ifTrue: [objectMemory wordSize] ifFalse: [1]) R: litCountReg].
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAt (in category 'primitive generators') -----
  genPrimitiveAt
+ 	| formatReg convertToIntAndReturn methodInBounds
- 	| formatReg convertToIntAndReturn
  	  jumpNotIndexable jumpImmediate jumpBadIndex
+ 	  jumpIsBytes jumpIsShorts jumpIsWords jumpIsMethod jumpIsArray jumpIsContext
+ 	  jumpHasFixedFields jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
+ 	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds |
- 	  jumpIsBytes jumpIsShorts jumpIsWords jumpIsArray jumpHasFixedFields jumpIsContext
- 	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpIsShorts type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
+ 	<var: #jumpIsMethod type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	<var: #methodInBounds type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
  	<var: #convertToIntAndReturn type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
  
  	cogit genLoadArgAtDepth: 0 into: Arg0Reg.
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	cogit MoveR: Arg0Reg R: Arg1Reg.
  	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
  	cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self genGetFormatOf: ReceiverResultReg
  		into: (formatReg := SendNumArgsReg)
  		leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
  
  	self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpIsArray := cogit JumpZero: 0.
  	jumpNotIndexable := cogit JumpBelow: 0.
  					cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpIsShorts := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	jumpIsWords := cogit JumpAboveOrEqual: 0.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexable jmpTarget: cogit Label.
  	jumpNotIndexable := cogit Jump: 0.
  
+ 	jumpIsArray jmpTarget:
+ 		(cogit CmpR: Arg1Reg R: ClassReg).
+ 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ 	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 	cogit genPrimReturn.
+ 
  	jumpIsBytes jmpTarget:
  		(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
+ 		cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ 		cogit SubR: TempReg R: ClassReg;
- 		cogit AndCq: objectMemory wordSize - 1 R: formatReg.
- 		cogit SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ 	jumpIsMethod := cogit JumpAboveOrEqual: 0.
+ 	methodInBounds :=
+ 	(cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg).
- 	cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
  	cogit backEnd byteReadsZeroExtend
  		ifTrue:
  			[cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg]
  		ifFalse:
  			[cogit "formatReg already contains a value <= 16r1f, so no need to zero it"
  				MoveXbr: Arg1Reg R: ReceiverResultReg R: formatReg;
  				MoveR: formatReg R: ReceiverResultReg].
  	convertToIntAndReturn := cogit Label.
  	self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpIsShorts jmpTarget:
  		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
  		cogit AndCq: 1 R: formatReg.
  		cogit SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: Arg1Reg R: ReceiverResultReg.
  	cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
  	cogit Jump: convertToIntAndReturn.
  
  	jumpIsWords jmpTarget:
  		(cogit CmpR: Arg1Reg R: ClassReg).
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >>  (objectMemory shiftForWord - 1) R: Arg1Reg.
  	cogit MoveX32r: Arg1Reg R: ReceiverResultReg R: TempReg.
  	cogit MoveR: TempReg R: ReceiverResultReg.
  	cogit Jump: convertToIntAndReturn.
  
  	jumpHasFixedFields jmpTarget:
  		(cogit AndCq: objectMemory classIndexMask R: TempReg).
  	cogit MoveR: TempReg R: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
  	jumpIsContext := cogit JumpZero: 0.
  	self genGetClassObjectOfClassIndex: formatReg into: Scratch0Reg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: Scratch0Reg destReg: formatReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit
  		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
  		SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	"index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
  	cogit AddR: formatReg R: Arg1Reg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
+ 	jumpIsMethod jmpTarget: cogit Label.
+ 	"Now check that the index is beyond the method's literals..."
+ 	self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: ClassReg scratch: TempReg.
+ 	cogit CmpR: Arg1Reg R: ClassReg.
+ 	cogit JumpBelow: methodInBounds.
- 	jumpIsArray jmpTarget:
- 		(cogit CmpR: Arg1Reg R: ClassReg).
- 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
- 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- 	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- 	cogit genPrimReturn.
  
  	jumpFixedFieldsOutOfBounds jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsOutOfBounds jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpNotIndexable jmpTarget:
  	(jumpIsContext jmpTarget:
  	(jumpBadIndex jmpTarget:
  	(jumpImmediate jmpTarget: cogit Label)))))))).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAtPut (in category 'primitive generators') -----
  genPrimitiveAtPut
+ 	| formatReg methodInBounds
+ 	  jumpImmediate jumpBadIndex jumpImmutable jumpNotIndexablePointers jumpNotIndexableBits
- 	| formatReg jumpImmediate jumpBadIndex jumpImmutable
- 	  jumpNotIndexablePointers jumpNotIndexableBits
  	  jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpIsShorts jumpHasFixedFields
  	  jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
  	  jumpWordsOutOfBounds jumpShortsOutOfBounds jumpBytesOutOfBounds
  	  jumpShortsOutOfRange jumpWordsOutOfRange jumpBytesOutOfRange
  	  jumpNonSmallIntegerValue jumpNotPointers
  	  |
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpIsShorts type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	<var: #methodInBounds type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexableBits type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfRange type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfRange type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfRange type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexablePointers type: #'AbstractInstruction *'>
  
  	cogit genLoadArgAtDepth: 1 into: Arg0Reg.
  	cogit genLoadArgAtDepth: 0 into: Arg1Reg.
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self cppIf: IMMUTABILITY
  		ifTrue:
  		[ self genGetFormatOf: ReceiverResultReg
  			into: (formatReg := SendNumArgsReg)
  			leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
  		jumpImmutable := self genJumpBaseHeaderImmutable: TempReg ]
  		ifFalse: 
  		[ self genGetFormatOf: ReceiverResultReg
  			into: (formatReg := SendNumArgsReg)
  			leastSignificantHalfOfBaseHeaderIntoScratch: NoReg ].
  
  	self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpNotPointers := cogit JumpAbove: 0.
  	"optimistic store check; assume index in range (almost always is)."
  	self genStoreCheckReceiverReg: ReceiverResultReg
  		valueReg: Arg1Reg
  		scratchReg: TempReg
  		inFrame: false.
  
  	cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpNotIndexablePointers := cogit JumpBelow: 0.
  	jumpHasFixedFields := cogit JumpNonZero: 0.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpHasFixedFields jmpTarget: cogit Label.
  	self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
  	jumpIsContext := cogit JumpZero: 0.
  	"get # fixed fields in formatReg"
  	self genGetClassObjectOfClassIndex: formatReg into: Scratch0Reg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: Scratch0Reg destReg: formatReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
  	cogit SubR: formatReg R: ClassReg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: formatReg R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
+ 	jumpNotPointers jmpTarget: cogit Label.
- 	jumpNotPointers jmpTarget:
- 		(cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg).
- 	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
  	jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
  					cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpIsShorts := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexableBits := cogit JumpBelow: 0.
  
  	"fall through to words"
  	cogit CmpCq: (objectMemory integerObjectOf: 16rFFFFFFFF) R: Arg1Reg.
  	jumpWordsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: ClassReg.
  	cogit AndCq: objectMemory wordSize / 4 - 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize >> (objectMemory shiftForWord - 1) R: Arg0Reg.
  	cogit MoveR: TempReg X32r: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpIsBytes jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg).
  	jumpBytesOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
+ 	cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ 	cogit SubR: TempReg R: ClassReg.
- 	cogit AndCq: objectMemory wordSize - 1 R: formatReg.
- 	cogit SubR: formatReg R: ClassReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ 	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
+ 	methodInBounds :=
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  	cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpIsShorts jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
  	jumpShortsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
+ 	"Now check that the index is beyond the method's literals..."
+ 	jumpIsCompiledMethod jmpTarget: cogit Label.
+ 	self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: ClassReg scratch: TempReg.
+ 	cogit CmpR: Arg0Reg R: ClassReg.
+ 	cogit JumpBelow: methodInBounds.
+ 
  	jumpIsContext jmpTarget:
  	(jumpNotIndexableBits jmpTarget:
  	(jumpBytesOutOfRange jmpTarget:
  	(jumpShortsOutOfRange jmpTarget:
  	(jumpWordsOutOfRange jmpTarget:
  	(jumpIsCompiledMethod jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsOutOfBounds jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpNotIndexablePointers jmpTarget:
  	(jumpNonSmallIntegerValue jmpTarget:
  	(jumpFixedFieldsOutOfBounds jmpTarget: cogit Label)))))))))))).
  	
  	self cppIf: IMMUTABILITY
  		ifTrue: [jumpImmutable jmpTarget: jumpIsContext getJmpTarget].
  
  	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  	self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
  
  	jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
  
+ 	^0 "Can't be complete because of contexts."!
- 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>getLiteralCountOf:plusOne:inBytes:into:scratch: (in category 'compile abstract instructions') -----
+ getLiteralCountOf: methodReg plusOne: plusOne inBytes: inBytes into: litCountReg scratch: scratchReg
+ 	"Get the literal count of a CompiledMethod into headerReg, plus one if requested.
+ 	  If inBytes is true, scale the count by the word size.  Deal with the possibility of
+ 	 the method being cogged."
+ 	self genGetMethodHeaderOf: methodReg into: litCountReg scratch: scratchReg.
+ 	self assert: 1 << objectMemory numTagBits = objectMemory wordSize.
+ 	inBytes
+ 		ifTrue:
+ 			[cogit
+ 				AndCq: coInterpreter alternateHeaderNumLiteralsMask << objectMemory numTagBits
+ 				R: litCountReg]
+ 		ifFalse:
+ 			[cogit
+ 				LogicalShiftRightCq: objectMemory numTagBits R: litCountReg;
+ 				AndCq: coInterpreter alternateHeaderNumLiteralsMask R: litCountReg].
+ 	plusOne ifTrue:
+ 		[cogit
+ 			AddCq: (inBytes
+ 						ifTrue: [LiteralStart * objectMemory wordSize]
+ 						ifFalse: [LiteralStart])
+ 			R: litCountReg].
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genPrimitiveObjectAt (in category 'primitive generators') -----
  genPrimitiveObjectAt
+ 	| headerReg jumpBadIndex jumpBounds jumpNotHeaderIndex |
- 	| headerReg
- 	  jumpBadIndex jumpNotCogMethod jumpBounds jumpNotHeaderIndex |
  	<var: #jumpBounds type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
- 	<var: #jumpNotCogMethod type: #'AbstractInstruction *'>
  	<var: #jumpNotHeaderIndex type: #'AbstractInstruction *'>
  	cogit genLoadArgAtDepth: 0 into: Arg0Reg.
  	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
+ 	self genGetMethodHeaderOf: ReceiverResultReg into: (headerReg := Arg1Reg) scratch: TempReg.
+ 	cogit CmpCq: (objectMemory integerObjectOf: 1) R: Arg0Reg.
- 	"get header into Arg1Reg..."
- 	cogit MoveMw: objectMemory baseHeaderSize r: ReceiverResultReg R: (headerReg := Arg1Reg).
- 	jumpNotCogMethod := self genJumpSmallInteger: headerReg scratchReg: TempReg.
- 	cogit MoveMw: (cogit offset: CogMethod of: #methodHeader) r: headerReg R: headerReg.
- 	jumpNotCogMethod jmpTarget: (cogit
- 		CmpCq: (objectMemory integerObjectOf: 1) R: Arg0Reg).
  	jumpNotHeaderIndex := cogit JumpNonZero: 0.
  	cogit
  		MoveR: headerReg R: ReceiverResultReg;
  		genPrimReturn.
  	jumpNotHeaderIndex jmpTarget: (cogit
  		AndCq: (objectMemory integerObjectOf: coInterpreter alternateHeaderNumLiteralsMask) R: headerReg).
  	cogit
  		SubCq: (objectMemory integerObjectOf: 1) - objectMemory smallIntegerTag R: Arg0Reg;
  		CmpR: headerReg R: Arg0Reg.
  	jumpBounds := cogit JumpAbove: 0.
  
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit
  		AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg;
  		MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg;
  		genPrimReturn.
  
  	jumpBounds jmpTarget: (cogit
  		AddCq: (objectMemory integerObjectOf: 1) - objectMemory smallIntegerTag R: Arg0Reg).
  	jumpBadIndex jmpTarget: cogit Label.
  	^CompletePrimitive!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>getLiteralCountOf:plusOne:inBytes:into:scratch: (in category 'compile abstract instructions') -----
+ getLiteralCountOf: methodReg plusOne: plusOne inBytes: inBytes into: litCountReg scratch: scratchReg
+ 	"Get the literal count of a CompiledMethod into headerReg, plus one if requested.
+ 	  If inBytes is true, scale the count by the word size.  Deal with the possibility of
+ 	 the method being cogged."
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
  	 primary responsibility of this method is to allocate Smalltalk Arrays for variables
  	 that will be declared as statically-allocated global arrays in the translated code."
  	super initialize.
  
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	cogit ifNil:
  		[cogit := self class cogitClass new setInterpreter: self].
  	objectMemory coInterpreter: self cogit: cogit.
  
  	cogit numRegArgs > 0 ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
  
  	cogThreadManager ifNotNil:
  		[super initialize].
  
  	self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
  
  	cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  	enableCog := true.
  
  	methodCache := Array new: MethodCacheSize.
  	nsMethodCache := Array new: NSMethodCacheSize.
+ 	atCache := nil.
- 	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := lastPollCount := sendCount := lookupCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  	eventQueue := SharedQueue new.
  	suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  	systemAttributes := Dictionary new.
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	primTraceLogIndex := 0.
  	traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  	traceLogIndex := 0.
  	traceSources := TraceSources.
  	statCodeCompactionCount := 0.
  	statCodeCompactionUsecs := 0.
  	extSemTabSize := 256!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  Try and
  	 allocate in a segment that already includes pinned objects.  The header of the
  	 result will have been filled-in but not the contents."
  	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes
  				   suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
  	chunk ifNil:
  		[chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
  		 chunk ifNotNil:
  			[(segmentManager segmentContainingObj: chunk) containsPinned: true]].
+ 	self checkFreeSpace: GCModeNewSpace.
- 	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self flag: #endianness.
  		 self longAt: chunk put: numSlots.
  		 self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
  		 self long64At: chunk + self baseHeaderSize
  			 put: ((self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)
  					bitOr: 1 << self pinnedBitShift).
  		 ^chunk + self baseHeaderSize].
  	self long64At: chunk
  		put: ((self headerForSlots: numSlots format: formatField classIndex: classIndex)
  					bitOr: 1 << self pinnedBitShift).
  	^chunk!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents.  If no memory is available answer nil."
  	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
+ 	self checkFreeSpace: GCModeNewSpace.
- 	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self flag: #endianness.
  		 self longAt: chunk put: numSlots.
  		 self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
  		 self long64At: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self long64At: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
  objectAfter: objOop limit: limit
  	"Object parsing.
  	1. all objects have at least a word following the header, for a forwarding pointer.
  	2. objects with an overflow size have a preceeing word with a saturated numSlots.  If the word
  	   following an object doesn't have a saturated numSlots field it must be a single-header object.
  	   If the word following does have a saturated numSlots it must be the overflow size word."
+ 	<inline: true>
  	| followingWordAddress followingWord |
  	followingWordAddress := self addressAfter: objOop.
  	(self oop: followingWordAddress isGreaterThanOrEqualTo: limit) ifTrue:
  		[^limit].
  	self flag: #endianness.
  	followingWord := self longAt: followingWordAddress + 4.
  	^followingWord >> self numSlotsHalfShift = self numSlotsMask
  		ifTrue: [followingWordAddress + self baseHeaderSize]
  		ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  Try and
  	 allocate in a segment that already includes pinned objects.  The header of the
  	 result will have been filled-in but not the contents."
  	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes
  				   suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
  	chunk ifNil:
  		[chunk := self allocateOldSpaceChunkOfBytes: totalBytes].
+ 	self checkFreeSpace: GCModeNewSpace.
- 	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self longAt: chunk
  			put: numSlots + (self numSlotsMask << self numSlotsFullShift).
  		 self longAt: chunk + self baseHeaderSize
  			put: ((self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)
  					bitOr: 1 << self pinnedBitShift).
  		 ^chunk + self baseHeaderSize].
  	self longAt: chunk
  		put: ((self headerForSlots: numSlots format: formatField classIndex: classIndex)
  				bitOr: 1 << self pinnedBitShift).
  	^chunk!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents.  If no memory is available answer nil."
  	<var: #totalBytes type: #usqInt>
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
+ 	self checkFreeSpace: GCModeNewSpace.
- 	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self longAt: chunk
  			put: numSlots + (self numSlotsMask << self numSlotsFullShift).
  		 self longAt: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
  		 ^chunk + self baseHeaderSize].
  	self longAt: chunk
  		put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
  	^chunk!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
  objectAfter: objOop limit: limit
  	"Object parsing.
  	1. all objects have at least a word following the header, for a forwarding pointer.
  	2. objects with an overflow size have a preceeing word with a saturated numSlots.  If the word
  	   following an object doesn't have a saturated numSlots field it must be a single-header object.
  	   If the word following does have a saturated numSlots it must be the overflow size word."
+ 	<inline: true>
  	| followingWordAddress followingWord |
  	followingWordAddress := self addressAfter: objOop.
  	(self oop: followingWordAddress isGreaterThanOrEqualTo: limit) ifTrue:
  		[^limit].
  	self flag: #endianness.
  	followingWord := self longAt: followingWordAddress.
  	^followingWord >> self numSlotsFullShift = self numSlotsMask
  		ifTrue: [followingWordAddress + self baseHeaderSize]
  		ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
  allInstancesOf: aClass
  	"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 the number of instances as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| classIndex freeChunk ptr start limit count bytes |
  	classIndex := self rawHashBitsOf: aClass.
  	classIndex = 0 ifTrue:
  		[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 ^freeChunk].
  	MarkObjectsForEnumerationPrimitives ifTrue:
  		[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk.
  	start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	(self isClassAtUniqueIndex: aClass)
  		ifTrue:
  			[self uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]]
  		ifFalse:
  			[self ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]].
  	self assert: (self isEmptyObjStack: markStack).
  	MarkObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeObject: freeChunk.
  		 ^self integerObjectOf: count].
  	count < self numSlotsMask ifTrue:
  		[| smallObj |
  		 smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 0 to: count - 1 do:
  			[:i|
  			self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
  		 self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  		 self beRootIfOld: smallObj.
+ 		 self checkFreeSpace: GCModeFull.
- 		 self checkFreeSpace.
  		 ^smallObj].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self rawOverflowSlotsOf: freeChunk put: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
+ 	self checkFreeSpace: GCModeFull.
- 	self checkFreeSpace.
  	self runLeakCheckerFor: GCModeFull.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>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 the number of objects as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| freeChunk ptr start limit count bytes |
  	MarkObjectsForEnumerationPrimitives ifTrue:
  		[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk.
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
  		 (MarkObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 count := count + 1.
  					 ptr < limit ifTrue:
  						[self longAt: ptr put: obj.
  						 ptr := ptr + self bytesPerOop]]
  				ifFalse:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self assert: (self isEmptyObjStack: markStack).
  	MarkObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	self assert: count >= self numSlotsMask.
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
+ 		 self checkFreeSpace: GCModeFull.
- 		 self checkFreeSpace.
  		 ^self integerObjectOf: count].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self rawOverflowSlotsOf: freeChunk put: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
+ 	self checkFreeSpace: GCModeFull.
- 	self checkFreeSpace.
  	self runLeakCheckerFor: GCModeFull.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>checkFreeSpace (in category 'debug support') -----
  checkFreeSpace
+ 	"Bootstrap only"
+ 	<doNotGenerate>
+ 	self checkFreeSpace: GCModeFull!
- 	self assert: self bitsSetInFreeSpaceMaskForAllFreeLists.
- 	self assert: totalFreeOldSpace = self totalFreeListBytes!

Item was added:
+ ----- Method: SpurMemoryManager>>checkFreeSpace: (in category 'debug support') -----
+ checkFreeSpace: gcModes
+ 	self assert: self bitsSetInFreeSpaceMaskForAllFreeLists.
+ 	self assert: totalFreeOldSpace = self totalFreeListBytes.
+ 	(gcModes > 0
+ 	 and: [checkForLeaks allMask: (GCModeFreeSpace bitOr: gcModes)]) ifTrue:
+ 		[self runLeakCheckerForFreeSpace: GCModeFreeSpace]!

Item was added:
+ ----- Method: SpurMemoryManager>>checkHeapFreeSpaceIntegrity (in category 'debug support') -----
+ checkHeapFreeSpaceIntegrity
+ 	"Perform an integrity/leak check using the heapMap.  Assume clearLeakMapAndMapAccessibleFreeSpace
+ 	 has set a bit at each free chunk's header.  Scan all objects in the heap checking that no pointer points
+ 	 to a free chunk and that all free chunks that refer to others refer to marked chunks.  Answer if all checks pass."
+ 	| ok |
+ 	<inline: false>
+ 	ok := true.
+ 
+ 	0 to: self numFreeLists - 1 do:
+ 		[:i|
+ 		(freeLists at: i) ~= 0 ifTrue:
+ 			[(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) = 0 ifTrue:
+ 				[coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); cr.
+ 				 self eek.
+ 				 ok := false]]].
+ 
+ 	"Excuse the duplication but performance is at a premium and we avoid
+ 	 some tests by splitting the newSpace and oldSpace enumerations."
+ 	self allNewSpaceEntitiesDo:
+ 		[:obj| | fieldOop |
+ 		 (self isFreeObject: obj)
+ 			ifTrue:
+ 				[coInterpreter print: 'young object '; printHex: obj; print: ' is free'; cr.
+ 				 self eek.
+ 				 ok := false]
+ 			ifFalse:
+ 				[0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 					[:fi|
+ 					 fieldOop := self fetchPointer: fi ofObject: obj.
+ 					 (self isNonImmediate: fieldOop) ifTrue:
+ 						[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
+ 							[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; cr.
+ 							 self eek.
+ 							 ok := false]]]]].
+ 	self allOldSpaceEntitiesDo:
+ 		[:obj| | fieldOop |
+ 		(self isFreeObject: obj)
+ 			ifTrue:
+ 				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
+ 					[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; cr.
+ 					 self eek.
+ 					 ok := false].
+ 				 fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
+ 				 (fieldOop ~= 0
+ 				 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
+ 					[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; cr.
+ 					 self eek.
+ 					 ok := false].
+ 				(self isLargeFreeObject: obj) ifTrue:
+ 					[self freeChunkParentIndex to: self freeChunkLargerIndex do:
+ 						[:fi|
+ 						 fieldOop := self fetchPointer: fi ofFreeChunk: obj.
+ 						 (fieldOop ~= 0
+ 						 and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
+ 							[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is unmapped'; cr.
+ 							 self eek.
+ 							 ok := false].]]]
+ 			ifFalse:
+ 				[0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 					[:fi|
+ 					 fieldOop := self fetchPointer: fi ofObject: obj.
+ 					 (self isNonImmediate: fieldOop) ifTrue:
+ 						[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
+ 							[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; cr.
+ 							 self eek.
+ 							 ok := false]]]]].
+ 	^ok!

Item was changed:
  ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  	"Perform an integrity/leak check using the heapMap.  Assume clearLeakMapAndMapAccessibleObjects
+ 	 has set a bit at each (non-free) object's header.  Scan all objects in the heap checking that every
+ 	 pointer points to a header.  Scan the rememberedSet, remapBuffer and extraRootTable checking
+ 	 that every entry is a pointer to a header. Check that the number of roots is correct and that all
+ 	 rememberedSet entries have their isRemembered: flag set.  Answer if all checks pass."
- 	 has set a bit at each object's header.  Scan all objects in the heap checking that every pointer points
- 	 to a header.  Scan the rememberedSet, remapBuffer and extraRootTable checking that every entry is
- 	 a pointer to a header. Check that the number of roots is correct and that all rememberedSet entries
- 	 have their isRemembered: flag set.  Answer if all checks pass."
  	| ok numRememberedObjectsInHeap |
  	<inline: false>
  	ok := true.
  	numRememberedObjectsInHeap := 0.
+ 	0 to: self numFreeLists - 1 do:
+ 		[:i|
+ 		(freeLists at: i) ~= 0 ifTrue:
+ 			[(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) ~= 0 ifTrue:
+ 				[coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); cr.
+ 				 self eek.
+ 				 ok := false]]].
+ 
  	"Excuse the duplication but performance is at a premium and we avoid
  	 some tests by splitting the newSpace and oldSpace enumerations."
  	self allNewSpaceEntitiesDo:
  		[:obj| | fieldOop classIndex classOop |
+ 		(self isFreeObject: obj)
+ 			ifTrue:
+ 				[coInterpreter print: 'young object '; printHex: obj; print: ' is free'; cr.
- 		((self isFreeObject: obj)
- 		 or: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]) ifFalse:
- 			[(self isRemembered: obj) ifTrue:
- 				[coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; cr.
  				 self eek.
+ 				 ok := false]
+ 			ifFalse:
+ 				[((self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]) ifFalse:
+ 					[(self isRemembered: obj) ifTrue:
+ 						[coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; cr.
- 				 ok := false]].
- 			 (self isForwarded: obj)
- 				ifTrue:
- 					[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
- 					 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- 						[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
  						 self eek.
+ 						 ok := false]].
+ 					 (self isForwarded: obj)
+ 						ifTrue:
+ 							[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
+ 							 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 								[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
- 						 ok := false]]
- 				ifFalse:
- 					[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
- 					 (classIndicesShouldBeValid
- 					  and: [classOop = nilObj
- 					  and: [(self isHiddenObj: obj) not]]) ifTrue:
- 						[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
- 						 self eek.
- 						 ok := false].
- 					 0 to: (self numPointerSlotsOf: obj) - 1 do:
- 						[:fi|
- 						 fieldOop := self fetchPointer: fi ofObject: obj.
- 						 (self isNonImmediate: fieldOop) ifTrue:
- 							[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  								 self eek.
+ 								 ok := false]]
+ 						ifFalse:
+ 							[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
+ 							 (classIndicesShouldBeValid
+ 							  and: [classOop = nilObj
+ 							  and: [(self isHiddenObj: obj) not]]) ifTrue:
+ 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
+ 								 self eek.
+ 								 ok := false].
+ 							 0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 								[:fi|
+ 								 fieldOop := self fetchPointer: fi ofObject: obj.
+ 								 (self isNonImmediate: fieldOop) ifTrue:
+ 									[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 										[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ 										 self eek.
+ 										 ok := false]]]]]].
- 								 ok := false]]]]].
  	self allOldSpaceEntitiesDo:
  		[:obj| | containsYoung fieldOop classIndex classOop |
+ 		(self isFreeObject: obj)
+ 			ifTrue:
+ 				[(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
+ 					[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is mapped?!! '; cr.
- 		(self isFreeObject: obj) ifFalse:
- 			[containsYoung := false.
- 			 (self isRemembered: obj) ifTrue:
- 				[numRememberedObjectsInHeap := numRememberedObjectsInHeap + 1.
- 				 (scavenger isInRememberedSet: obj) ifFalse:
- 					[coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
  					 self eek.
+ 					 ok := false].
+ 				 fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
+ 				 (fieldOop ~= 0
+ 				 and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue:
+ 					[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is mapped'; cr.
+ 					 self eek.
+ 					 ok := false].
+ 				(self isLargeFreeObject: obj) ifTrue:
+ 					[self freeChunkParentIndex to: self freeChunkLargerIndex do:
+ 						[:fi|
+ 						 fieldOop := self fetchPointer: fi ofFreeChunk: obj.
+ 						 (fieldOop ~= 0
+ 						 and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue:
+ 							[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is mapped'; cr.
+ 							 self eek.
+ 							 ok := false].]]]
+ 			ifFalse:
+ 				[containsYoung := false.
+ 				 (self isRemembered: obj) ifTrue:
+ 					[numRememberedObjectsInHeap := numRememberedObjectsInHeap + 1.
+ 					 (scavenger isInRememberedSet: obj) ifFalse:
+ 						[coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
- 					 ok := false]].
- 			 (self isForwarded: obj)
- 				ifTrue:
- 					[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
- 					 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- 						[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
  						 self eek.
+ 						 ok := false]].
+ 				 (self isForwarded: obj)
+ 					ifTrue:
+ 						[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
+ 						 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 							[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
+ 							 self eek.
+ 							 ok := false].
+ 						 (self isReallyYoung: fieldOop) ifTrue:
+ 							[containsYoung := true]]
+ 					ifFalse:
+ 						[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
+ 						 (classIndicesShouldBeValid
+ 						  and: [classOop = nilObj
+ 						  and: [classIndex > self lastClassIndexPun]]) ifTrue:
+ 							[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
+ 							 self eek.
+ 							 ok := false].
+ 						 0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 							[:fi|
+ 							 fieldOop := self fetchPointer: fi ofObject: obj.
+ 							 (self isNonImmediate: fieldOop) ifTrue:
+ 								[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 									[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ 									 self eek.
+ 									 ok := false].
+ 								 "don't be misled by CogMethods; they appear to be young, but they're not"
+ 								 (self isReallyYoung: fieldOop) ifTrue:
+ 									[containsYoung := true]]]].
+ 				 containsYoung ifTrue:
+ 					[(self isRemembered: obj) ifFalse:
+ 						[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
- 						 ok := false].
- 					 (self isReallyYoung: fieldOop) ifTrue:
- 						[containsYoung := true]]
- 				ifFalse:
- 					[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
- 					 (classIndicesShouldBeValid
- 					  and: [classOop = nilObj
- 					  and: [classIndex > self lastClassIndexPun]]) ifTrue:
- 						[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
  						 self eek.
+ 						 ok := false]]]].
- 						 ok := false].
- 					 0 to: (self numPointerSlotsOf: obj) - 1 do:
- 						[:fi|
- 						 fieldOop := self fetchPointer: fi ofObject: obj.
- 						 (self isNonImmediate: fieldOop) ifTrue:
- 							[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- 								 self eek.
- 								 ok := false].
- 							 "don't be misled by CogMethods; they appear to be young, but they're not"
- 							 (self isReallyYoung: fieldOop) ifTrue:
- 								[containsYoung := true]]]].
- 			 containsYoung ifTrue:
- 				[(self isRemembered: obj) ifFalse:
- 					[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
- 					 self eek.
- 					 ok := false]]]].
  	numRememberedObjectsInHeap ~= scavenger rememberedSetSize ifTrue:
  		[coInterpreter
  			print: 'root count mismatch. #heap roots ';
  			printNum: numRememberedObjectsInHeap;
  			print: '; #roots ';
  			printNum: scavenger rememberedSetSize;
  			cr.
  		self eek.
  		"But the system copes with overflow..."
  		self flag: 'no support for remembered set overflow yet'.
  		"ok := rootTableOverflowed and: [needGCFlag]"].
  	scavenger rememberedSetWithIndexDo:
  		[:obj :i|
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  						 self eek.
  						 ok := false]
  					ifFalse:
  						[(self isYoung: obj) ifTrue:
  							[coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  							 self eek.
  							 ok := false]]]].
  	1 to: remapBufferCount do:
  		[:ri| | obj |
  		obj := remapBuffer at: ri.
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  					[coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  					 self eek.
  					 ok := false]]].
  	1 to: extraRootCount do:
  		[:ri| | obj |
  		obj := (extraRoots at: ri) at: 0.
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  					[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  					 self eek.
  					 ok := false]]].
  	^ok!

Item was added:
+ ----- Method: SpurMemoryManager>>clearLeakMapAndMapAccessibleFreeSpace (in category 'debug support') -----
+ clearLeakMapAndMapAccessibleFreeSpace
+ 	"Perform an integrity/leak check using the heapMap.  Set a bit at each free chunk's header."
+ 	<inline: false>
+ 	heapMap clearHeapMap.
+ 	self allOldSpaceEntitiesFrom: self firstObject
+ 		do: [:objOop|
+ 			(self isFreeObject: objOop) ifTrue:
+ 				[heapMap heapMapAtWord: (self pointerForOop: objOop) Put: 1]]!

Item was changed:
  ----- Method: SpurMemoryManager>>computeFreeSpacePostSwizzle (in category 'free space') -----
  computeFreeSpacePostSwizzle
  	totalFreeOldSpace := self totalFreeListBytes.
+ 	self checkFreeSpace: 0!
- 	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') -----
  freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
  	"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
  
  	 Doubly-link the free chunks in address order through the freeChunkNextIndex field using the
  	 xor trick to use only one field, see e.g.
  		The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18
  		http://en.wikipedia.org/wiki/XOR_linked_list.
  	 Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk.
  
  	 Let the segmentManager mark which segments contain pinned objects via notePinned:."
  
  	| prevPrevFree prevFree |
  	<inline: #never> "for profiling"
+ 	self checkFreeSpace: GCModeFull.
- 	self checkFreeSpace.
  	scavenger forgetUnmarkedRememberedObjects.
  	self doScavenge: MarkOnTenure.
  	segmentManager prepareForGlobalSweep."for notePinned:"
  	"throw away the list heads, including the tree."
  	self resetFreeListHeads.
  	firstFreeChunk := prevPrevFree := prevFree := 0.
  	self allOldSpaceEntitiesForCoalescingFrom: self firstObject do:
  		[:o|
  		 self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
  		 (self isMarked: o)
  			ifTrue: "forwarders should have been followed in markAndTrace:"
  				[self assert: (self isForwarded: o) not.
  				 self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
  				 (self isPinned: o) ifTrue:
  					[segmentManager notePinned: o]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := self coallesceFreeChunk: o.
  				 self setObjectFree: here.
  				 self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
  				 prevPrevFree := prevFree.
  				 prevFree := here]].
  	prevFree ~= firstFreeChunk ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: prevFree
  			withValue: prevPrevFree].
  	lastFreeChunk := prevFree.
  	self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
  	self assert: self checkTraversableSortedFreeList!

Item was changed:
  ----- Method: SpurMemoryManager>>garbageCollectForSnapshot (in category 'snapshot') -----
  garbageCollectForSnapshot
  	self flushNewSpace. "There is no place to put newSpace in the snapshot file."
  	self flag: 'If we wanted to shrink the rememberedSet prior to snapshot this is the place to do it.'.
  	numCompactionPasses := CompactionPassesForSnapshot.
  	self fullGC.
  	numCompactionPasses := CompactionPassesForGC.
  	segmentManager prepareForSnapshot.
+ 	self checkFreeSpace: GCModeFull!
- 	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
  growOldSpaceByAtLeast: minAmmount
  	"Attempt to grow memory by at least minAmmount.
  	 Answer the size of the new segment, or nil if the attempt failed."
  	| ammount headroom total |
  	<var: #segInfo type: #'SpurSegmentInfo *'>
  	"statGrowMemory counts attempts, not successes."
  	statGrowMemory := statGrowMemory + 1."we need to include overhead for a new object header plus the segment bridge."
  	ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize).
  	"round up to the nearest power of two."
  	ammount := 1 << (ammount - 1) highBit.
  	"and grow by at least growHeadroom."
  	ammount := ammount max: growHeadroom.
  
  	"Now apply the maxOldSpaceSize limit, if one is in effect."
  	maxOldSpaceSize > 0 ifTrue:
  		[total := segmentManager totalBytesInSegments.
  		 total >= maxOldSpaceSize ifTrue:
  			[^nil].
  		 headroom := maxOldSpaceSize - total.
  		 headroom < ammount ifTrue:
  			[headroom < (minAmmount + (self baseHeaderSize * 2 + self bridgeSize)) ifTrue:
  				[^nil].
  			 ammount := headroom]].
  		 
  	^(segmentManager addSegmentOfSize: ammount) ifNotNil:
  		[:segInfo|
  		 self assimilateNewSegment: segInfo.
  		 "and add the new free chunk to the free list; done here
  		  instead of in assimilateNewSegment: for the assert"
  		 self addFreeChunkWithBytes: segInfo segSize - self bridgeSize at: segInfo segStart.
  		 self assert: (self addressAfter: (self objectStartingAt: segInfo segStart))
  					= (segInfo segLimit - self bridgeSize).
+ 		 self checkFreeSpace: GCModeFreeSpace.
- 		 self checkFreeSpace.
  		 segmentManager checkSegments.
  		 segInfo segSize]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
  initializeOldSpaceFirstFree: startOfFreeOldSpace
  	<var: 'startOfFreeOldSpace' type: #usqInt>
  	| limit freeOldStart freeChunk |
  	<var: 'limit' type: #usqInt>
  	<var: 'freeOldStart' type: #usqInt>
  	limit := endOfMemory - self bridgeSize.
  	limit > startOfFreeOldSpace ifTrue:
  		[totalFreeOldSpace := totalFreeOldSpace + (limit - startOfFreeOldSpace).
  		 freeOldStart := startOfFreeOldSpace.
  		 self wordSize > 4 ifTrue:
  			[[limit - freeOldStart >= (1 << 32)] whileTrue:
  				[freeChunk := self freeChunkWithBytes: (1 << 32) at: freeOldStart.
  				 freeOldStart := freeOldStart + (1 << 32).
  				 self assert: freeOldStart = (self addressAfter: freeChunk)]].
  		freeOldStart < limit ifTrue:
  			[freeChunk := self freeChunkWithBytes: limit - freeOldStart at: freeOldStart.
  			 self assert: (self addressAfter: freeChunk) = limit]].
  	endOfMemory := endOfMemory - self bridgeSize.
  	freeOldSpaceStart := endOfMemory.
+ 	self checkFreeSpace: GCModeFreeSpace!
- 	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
  objectsReachableFromRoots: arrayOfRoots
  	"This is part of storeImageSegmentInto:outPointers:roots:.
  	 Answer an Array of all the objects only reachable from the argument, an Array of root objects,
  	 starting with arrayOfRoots.  If there is no space, answer a SmallInteger whose value is the
  	 number of slots required.  This is used to collect the objects to include in an image segment
  	 on Spur, separate from creating the segment, hence simplifying the implementation.
  	 Thanks to Igor Stasenko for this idea."
  
  	| freeChunk ptr start limit count oop objOop |
  	self assert: (self isArray: arrayOfRoots).
  	"Mark all objects except those only reachable from the arrayOfRoots by marking
  	 each object in arrayOfRoots and then marking all reachable objects (from the
  	 system roots).  This leaves unmarked only objects reachable from the arrayOfRoots.
  	 N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
   	self assert: self allObjectsUnmarked.
  	self markObjectsIn: arrayOfRoots.
  	self markObjects: false.
  
  	"After the mark phase all unreachable weak slots will have been nilled
  	 and all active ephemerons fired."
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self noUnscannedEphemerons.
  
  	"Use the largest free chunk to answer the result."
  	freeChunk := self allocateLargestFreeChunk.
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  
  	"First put the arrayOfRoots; order is important."
  	count := count + 1.
  	ptr < limit ifTrue:
  		[self longAt: ptr put: arrayOfRoots.
  		 ptr := ptr + self bytesPerOop].
  
  	0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
  		[:i|
  		 oop := self fetchPointer: i ofObject: arrayOfRoots.
  		 (self isNonImmediate: oop) ifTrue:
  			[self push: oop onObjStack: markStack]].
  
  	"Now collect the unmarked objects reachable from the roots."
  	[self isEmptyObjStack: markStack] whileFalse:
  		[objOop := self popObjStack: markStack.
  		 count := count + 1.
  		 ptr < limit ifTrue:
  			[self longAt: ptr put: objOop.
  			 ptr := ptr + self bytesPerOop].
  		 oop := self fetchClassOfNonImm: objOop.
  		 (self isMarked: oop) ifFalse:
  			[self setIsMarkedOf: objOop to: true.
  			 self push: oop onObjStack: markStack].
  		 ((self isContextNonImm: objOop)
  		  and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the loop"
  			ifTrue:
  				[0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
  					[:i|
  					 oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
  					 ((self isImmediate: oop)
  					  or: [self isMarked: oop]) ifFalse:
  						[self setIsMarkedOf: objOop to: true.
  						 self push: oop onObjStack: markStack]]]
  			ifFalse:
  				[0 to: (self numPointerSlotsOf: objOop) - 1 do:
  					[:i|
  					 oop := self fetchPointer: i ofObject: objOop.
  					 ((self isImmediate: oop)
  					  or: [self isMarked: oop]) ifFalse:
  						[self setIsMarkedOf: objOop to: true.
  						 self push: oop onObjStack: markStack]]]].
  
  	self unmarkAllObjects.
  
  	totalFreeOldSpace := totalFreeOldSpace - (self bytesInObject: freeChunk).
  	"Now try and allocate the result"
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
+ 		 self checkFreeSpace: GCModeImageSegment.
- 		 self checkFreeSpace.
  		 ^self integerObjectOf: count].
  	"There's room; set the format, & classIndex and shorten."
  	self setFormatOf: freeChunk to: self arrayFormat.
  	self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
  	self shorten: freeChunk toIndexableSize: count.
  	self possibleRootStoreInto: freeChunk.
+ 	self checkFreeSpace: GCModeImageSegment.
- 	self checkFreeSpace.
  	self runLeakCheckerFor: GCModeImageSegment.
  	^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>rebuildFreeListsForPigCompact (in category 'compaction') -----
  rebuildFreeListsForPigCompact
  	"Rebuild the free lists from the doubly-linked free list."
  	<inline: false>
  	self assert: self checkTraversableSortedFreeList.
  	totalFreeOldSpace := 0.
  	self sortedFreeListDo:
  		[:freeObj| | start bytes |
  		 bytes := (self bytesInObject: freeObj).
  		 start := self startOfObject: freeObj.
  		 self addFreeChunkWithBytes: bytes at: start].
+ 	self checkFreeSpace: GCModeFull!
- 	self checkFreeSpace!

Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerForFreeSpace: (in category 'debug support') -----
+ runLeakCheckerForFreeSpace: gcModes
+ 	<inline: false>
+ 	(gcModes anyMask: GCModeFreeSpace) ifTrue:
+ 		[coInterpreter reverseDisplayFrom: 16 to: 19.
+ 		 self clearLeakMapAndMapAccessibleFreeSpace.
+ 		 self assert: self checkHeapFreeSpaceIntegrity]!

Item was changed:
  ----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'gc - scavenging') -----
  scavengingGCTenuringIf: tenuringCriterion
  	"Run the scavenger."
  	<inline: false>
  	self assert: remapBufferCount = 0.
  	(self asserta: scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse:
  		[coInterpreter tab;
  			printNum: scavenger eden limit - freeStart; space;
  			printNum: coInterpreter interpreterAllocationReserveBytes; space;
  			printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - freeStart); cr].
  	self checkMemoryMap.
+ 	self checkFreeSpace: GCModeNewSpace.
- 	self checkFreeSpace.
  	self runLeakCheckerFor: GCModeNewSpace.
  
  	coInterpreter
  		preGCAction: GCModeNewSpace;
  		"would prefer this to be in mapInterpreterOops, but
  		 compatibility with ObjectMemory dictates it goes here."
  		flushMethodCacheFrom: newSpaceStart to: newSpaceLimit.
  	needGCFlag := false.
  
  	gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
  
  	self doScavenge: tenuringCriterion.
  
  	statScavenges := statScavenges + 1.
  	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
  	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
  	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
  	statRootTableCount := scavenger rememberedSetSize.
  
  	coInterpreter postGCAction: GCModeNewSpace.
  
  	self runLeakCheckerFor: GCModeNewSpace.
+ 	self checkFreeSpace: GCModeNewSpace!
- 	self checkFreeSpace!

Item was changed:
  ----- Method: SpurSegmentManager>>postSnapshot (in category 'snapshot') -----
  postSnapshot
  	"Restore all shortened segments to their proper size, re-freeing the trailing space."
  	<inline: false>
  	| seg |
  	<var: #seg type: #'SpurSegmentInfo *'>
  	"Set endOfMemory first, to avoid assert fails in freeChunkWithBytes:at:."
  	seg := self addressOf: (segments at: numSegments - 1).
  	seg lastFreeObject
  		ifNil: [self assert: manager endOfMemory = (seg segLimit - manager bridgeSize)]
  		ifNotNil: [manager setEndOfMemory: seg savedSegSize + seg segStart - manager bridgeSize].
  
  	numSegments - 1 to: 0 by: -1 do:
  		[:i|
  		 seg := self addressOf: (segments at: i).
  		 seg lastFreeObject ifNotNil:
  			[:freeChunk| | address |
  			address := seg segLimit - manager bridgeSize.
  			seg segSize: seg savedSegSize.
  			self bridgeFrom: seg
  				to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)]).
  			manager
  				addFreeChunkWithBytes: seg segLimit - address - manager bridgeSize
  				at: address]].
  	self checkSegments.
+ 	manager checkFreeSpace: GCModeFull!
- 	manager checkFreeSpace!

Item was changed:
  ----- Method: SpurSegmentManager>>prepareForSnapshot (in category 'snapshot') -----
  prepareForSnapshot
  	"shorten all segments by any trailing free space."
+ 	<inline: #never>
- 	<inline: false>
  	<var: #seg type: #'SpurSegmentInfo *'>
  	self checkSegments.
  	0 to: numSegments - 1 do:
  		[:i|
  		 (segments at: i)
  			savedSegSize: (segments at: i) segSize;
  			lastFreeObject: nil].
  
  	"Ideally finding the lastFreeObject of each segment would be
  	 done in some linear pass through the heap.  But for now KISS."
  	manager freeTreeNodesDo:
  		[:freeChunk| | node next seg |
  		 node := freeChunk.
  		 [node ~= 0] whileTrue:
  			[next := manager objectAfter: node limit: manager endOfMemory.
  			 (manager isSegmentBridge: next)
  				ifTrue:
  					[seg := self segmentContainingObj: node.
  					 seg lastFreeObject: node.
  					 node := 0]
  				ifFalse:
  					[node := manager
  								fetchPointer: manager freeChunkNextIndex
  								ofFreeChunk: node]].
  		 freeChunk].
  
  	0 to: numSegments - 1 do:
  		[:i|
  		 (segments at: i) lastFreeObject ifNotNil:
  			[:freeChunk|
  			manager detachFreeObject: freeChunk.
  			(segments at: i)
  				segSize: (manager startOfObject: freeChunk)
  						+ manager bridgeSize
  						- (segments at: i) segStart.
  			self bridgeFrom: (self addressOf: (segments at: i))
  				to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)])]].
  
  	"perhaps this should read
  		manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
  	manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
  	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
+ 	classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
- 	classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
  	poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  StackInterpreter and subclasses support multiple memory managers.  Currently there are two.  NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html.  Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions.  You can read about it in SpurMemoryManager's class comment.  There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| vmClass |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'<wchar.h> /* for wint_t */';
  		addHeaderFile:'"vmCallback.h"';
  		addHeaderFile:'"sqMemoryFence.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: 'unsigned long'.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
  	self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory breakSelector)
  		as: #'char *'
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  	NewspeakVM ifFalse:
  		[aCCodeGenerator
  			removeVariable: 'localAbsentReceiver';
  			removeVariable: 'localAbsentReceiverOrZero';
  			removeVariable: 'nsMethodCache'].
  	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  	 is not defined, for the benefit of the interpreter on slow machines."
  	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  	MULTIPLEBYTECODESETS == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'extA';
  			removeVariable: 'extB';
  			removeVariable: 'bytecodeSetSelector'].
  	aCCodeGenerator
  		var: #methodCache
  		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #nsMethodCache
  		declareC: 'long nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'.
+ 	AtCacheTotalSize isInteger ifTrue:
+ 		[aCCodeGenerator
+ 			var: #atCache
+ 			declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
  	aCCodeGenerator
- 		var: #atCache
- 		declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
- 	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
  	vmClass primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	vmClass objectMemoryClass hasSpurMemoryManagerAPI
  		ifTrue:
  			[aCCodeGenerator
  				var: #primitiveAccessorDepthTable
  				type: 'signed char'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  				array: vmClass primitiveAccessorDepthTable]
  		ifFalse:
  			[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void (*primitiveFunctionPointer)()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #interruptCheckChain
  		declareC: 'void (*interruptCheckChain)(void) = 0'.
  
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  								longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
  								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce)
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong!

Item was changed:
  ----- Method: StackInterpreter class>>initializeCaches (in category 'initialization') -----
  initializeCaches
  
+ 	| atCacheEntries atCacheEntrySize |
- 	| atCacheEntrySize |
  	NewspeakVM
  		ifTrue: [MethodCacheEntries := 512]
  		ifFalse: [MethodCacheEntries := 1024].
  	MethodCacheSelector := 1.
  	MethodCacheClass := 2.
  	MethodCacheMethod := 3.
  	MethodCachePrimFunction := 4.
  	MethodCacheEntrySize := 4.  "Must be power of two for masking scheme."
  	MethodCacheMask := (MethodCacheEntries - 1) * MethodCacheEntrySize.
  	MethodCacheSize := MethodCacheEntries * MethodCacheEntrySize.
  	CacheProbeMax := 3.
  
  	NSMethodCacheEntries := 512.
  	NSMethodCacheSelector := 1.
  	NSMethodCacheClassTag := 2.
  	NSMethodCacheCallingMethod := 3.
  	NSMethodCacheDepthOrLookupRule := 4.
  	NSMethodCacheTargetMethod := 5.
  	NSMethodCachePrimFunction := 6.
  	NSMethodCacheActualReceiver := 7.
  	NSMethodCacheEntrySize := 8.	"Must be power of two for masking scheme."
  	NSMethodCacheMask := NSMethodCacheEntries - 1 * NSMethodCacheEntrySize.
  	NSMethodCacheSize := NSMethodCacheEntries * NSMethodCacheEntrySize.
  
- 	AtCacheEntries := 8.  "Must be a power of two"
  	AtCacheOop := 1.
  	AtCacheSize := 2.
  	AtCacheFmt := 3.
  	AtCacheFixedFields := 4.
+ 	atCacheEntries := 8.
  	atCacheEntrySize := 4.  "Must be power of two for masking scheme."
+ 	AtCacheMask := (atCacheEntries-1) * atCacheEntrySize.
+ 	AtPutBase := atCacheEntries * atCacheEntrySize.
+ 	AtCacheTotalSize := atCacheEntries * atCacheEntrySize * 2.
- 	AtCacheMask := (AtCacheEntries-1) * atCacheEntrySize.
- 	AtPutBase := AtCacheEntries * atCacheEntrySize.
- 	AtCacheTotalSize := AtCacheEntries * atCacheEntrySize * 2.
  
  	"LookupRuleOuter is [0, 255], with the value being the lexical depth. Note that an
  	 outer send to lexical depth 0 is equivalent to a self send. Implicit receiver and
  	 outer sends are encoded as adjacent values to allow a quick range check to
  	 determine whether the absent receiver might differ from the method receiver.
  	 Note also Smalltalk super sends use ordinary send lookup rules."
  	LookupRuleSelf := 0.
  	LookupRuleImplicit := 256.
  	LookupRuleDynamicSuper := 257.
  	LookupRuleOrdinary := 258.
  	LookupRuleMNU := 259.
  !

Item was changed:
  ----- Method: StackInterpreter class>>initializeFrameIndices (in category 'initialization') -----
  initializeFrameIndices
  	"Format of a stack frame.  Word-sized indices relative to the frame pointer.
  	 Terminology
  		Frames are either single (have no context) or married (have a context).
  		Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
  	 Stacks grow down:
  
  			receiver for method activations/closure for block activations
  			arg0
  			...
  			argN
  			caller's method ip/base frame's sender context
  	fp->	saved fp
  			method
  			frame flags
  			context (uninitialized)
  			receiver
  			first temp
  			...
  	sp->	Nth temp
  
  	frame flags holds the number of arguments (since argument temporaries are above the frame)
  	the flag for a block activation
  	and the flag indicating if the context field is valid (whether the frame is married).
  
  	The first frame in a stack page is the baseFrame and is marked as such by a null saved fp,
  	in which case the saved method ip is actually the context (possibly hybrid) beneath the base frame"
  
  	| fxCallerSavedIP fxSavedFP fxMethod fxFrameFlags fxThisContext fxReceiver |
  	fxCallerSavedIP := 1.
  	fxSavedFP := 0.
  	fxMethod := -1.
  	fxFrameFlags := -2.	"Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
  						 Can find ``is block'' bit
  						 Can find ``has context'' bit"
  	fxThisContext := -3.
  	fxReceiver := -4.
  
  	FrameSlots := fxCallerSavedIP - fxReceiver + 1.
  
  	FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord.
  	"In base frames the caller saved ip field holds the caller context."
  	FoxCallerContext := FoxCallerSavedIP.
  	FoxSavedFP := fxSavedFP * BytesPerWord.
  	FoxMethod := fxMethod * BytesPerWord.
  	FoxFrameFlags := fxFrameFlags * BytesPerWord.
  	FoxThisContext := fxThisContext * BytesPerWord.
  	FoxReceiver := fxReceiver * BytesPerWord.
  
+ 	"Mark the CoInterpreter-specific offsets as #undefined to
- 	"Mark the CoInterpreter-specific offsets as #undeclared to
  	 avoid including them accidentally in StackInterpreter code."
+ 	IFrameSlots := #undefined.
+ 	MFrameSlots := #undefined.
+ 	FoxIFrameFlags := #undefined.
+ 	FoxIFSavedIP := #undefined.
+ 	FoxIFReceiver := #undefined.
+ 	FoxMFReceiver := #undefined!
- 	IFrameSlots := #undeclared.
- 	MFrameSlots := #undeclared.
- 	FoxIFrameFlags := #undeclared.
- 	FoxIFSavedIP := #undeclared.
- 	FoxIFReceiver := #undeclared.
- 	FoxMFReceiver := #undeclared!

Item was changed:
  ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	STACKVM := true.
  
  	"These flags function to identify a GC operation, or
  	 to specify what operations the leak checker should be run for."
  	GCModeFull := 1.				"stop-the-world global GC"
  	GCModeNewSpace := 2.		"Spur's scavenge, or V3's incremental"
  	GCModeIncremental := 4.		"incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
  	GCModeBecome := 8.			"v3 post-become sweeping"
  	GCModeImageSegment := 16.	"just a flag for leak checking image segments"
+ 	GCModeFreeSpace := 32.		"just a flag for leak checking free space; Spur only"
  
  	StackPageTraceInvalid := -1.
  	StackPageUnreached := 0.
  	StackPageReachedButUntraced := 1.
  	StackPageTraced := 2.
  
  	DumpStackOnLowSpace := 0.
  	PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall"
  	MillisecondClockMask := 16r1FFFFFFF.
  	"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
  	MaxExternalPrimitiveTableSize := 4096. "entries"
  
  	MaxJumpBuf := 32. "max. callback depth"
  	FailImbalancedPrimitives := initializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true].
  	EnforceAccessControl := initializationOptions at: #EnforceAccessControl ifAbsent: [true]!

Item was changed:
  ----- Method: StackInterpreter>>install:inAtCache:at:string: (in category 'indexing primitive support') -----
  install: rcvr inAtCache: cache at: atIx string: stringy
  	"Attempt to install the oop of this object in the given cache (at or atPut),
  	 along with its size, format and fixedSize. Answer if this was successful."
  	| hdr fmt totalLength fixedFields |
  	<inline: true>
  	<var: #cache type: 'sqInt *'>
  	self assert: (objectMemory isContext: rcvr) not.
  	hdr := objectMemory baseHeader: rcvr.
  	fmt := objectMemory formatOfHeader: hdr.
+ 	"For now the AtCache code doesn't support 16-bit indexability."
+ 	(objectMemory hasSpurMemoryManagerAPI
+ 	and: [fmt between: objectMemory firstShortFormat and: objectMemory firstByteFormat - 1]) ifTrue:
+ 		[^self primitiveFailed].
  	stringy
  		ifTrue:
  			[totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  			 fixedFields := 0.
  			 fmt := fmt + objectMemory firstStringyFakeFormat]  "special flag for strings"
  		ifFalse:
  			[(fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: hdr]) ifTrue:
  				["Contexts must not be put in the atCache, since their size is not constant"
  				self primitiveFailFor: PrimErrBadReceiver.
  				^false].
  			 totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  			 fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength].
  
  	cache at: atIx+AtCacheOop put: rcvr.
  	cache at: atIx+AtCacheFmt put: fmt.
  	cache at: atIx+AtCacheFixedFields put: fixedFields.
  	cache at: atIx+AtCacheSize put: totalLength - fixedFields.
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>writeImageFileIO (in category 'image save/restore') -----
  writeImageFileIO
  	"Write the image header and heap contents to imageFile for snapshot. c.f. writeImageFileIOSimulation.
  	 The game below is to maintain 64-bit alignment for all putLong:toFile: occurrences."
+ 	<inline: #never>
  	| imageName headerStart headerSize f imageBytes bytesWritten sCWIfn okToWrite |
  	<var: #f type: #sqImageFile>
  	<var: #headerStart type: #squeakFileOffsetType>
  	<var: #sCWIfn type: #'void *'>
  	<var: #imageName declareC: 'extern char imageName[]'>
  
  	self cCode: [] inSmalltalk: [imageName := 'sooth compiler'. ^self writeImageFileIOSimulation].
  
  	"If the security plugin can be loaded, use it to check for write permission.
  	 If not, assume it's ok"
  	sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
  	sCWIfn ~= 0 ifTrue:
  		[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
  		 okToWrite ifFalse:[^self primitiveFail]].
  	
  	"local constants"
  	headerStart := 0.  
  	headerSize := objectMemory wordSize = 4 ifTrue: [64] ifFalse: [128].  "header size in bytes; do not change!!"
  
  	f := self sqImageFile: imageName Open: 'wb'.
  	f = nil ifTrue: "could not open the image file for writing"
  		[^self primitiveFail].
  
  	imageBytes := objectMemory imageSizeToWrite.
  	headerStart := self sqImage: f File: imageName StartLocation: headerSize + imageBytes.
  	self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
  	"position file to start of header"
  	self sqImageFile: f Seek: headerStart.
  
  	self putWord32: self imageFormatVersion toFile: f.
  	self putWord32: headerSize toFile: f.
  	self putLong: imageBytes toFile: f.
  	self putLong: objectMemory baseAddressOfImage toFile: f.
  	self putLong: objectMemory specialObjectsOop toFile: f.
  	self putLong: objectMemory newObjectHash toFile: f.
  	self putLong: self ioScreenSize toFile: f.
  	self putLong: self getImageHeaderFlags toFile: f.
  	self putWord32: extraVMMemory toFile: f.
  	self putShort: desiredNumStackPages toFile: f.
  	self putShort: self unknownShortOrCodeSizeInKs toFile: f.
  	self putWord32: desiredEdenBytes toFile: f.
  	self putShort: (maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]) toFile: f.
  	self putShort: the2ndUnknownShort toFile: f.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[self putLong: objectMemory firstSegmentBytes toFile: f.
  			 self putLong: objectMemory bytesLeftInOldSpace toFile: f.
  			 2 timesRepeat: [self putLong: 0 toFile: f]	"Pad the rest of the header."]
  		ifFalse:
  			[4 timesRepeat: [self putLong: 0 toFile: f]].  "Pad the rest of the header."
  
  	 objectMemory wordSize = 8 ifTrue:
  		[3 timesRepeat: [self putLong: 0 toFile: f]]. "Pad the rest of the header."
  
  	self assert: headerStart + headerSize = (self sqImageFilePosition: f).
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	self successful ifFalse: "file write or seek failure"
  		[self sqImageFileClose: f.
  		 ^nil].
  
  	"write the image data"
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[bytesWritten := objectMemory writeImageSegmentsToFile: f]
  		ifFalse:
  			[bytesWritten := self sq: (self pointerForOop: objectMemory baseAddressOfImage)
  								Image: (self sizeof: #char)
  								File: imageBytes
  								Write: f].
  	self success: bytesWritten = imageBytes.
  	self sqImageFileClose: f!

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 := aSendNode selector.
  	meth := aCodeGen methodNamed: sel.
  	methArgs := meth args.
  	"convenient for debugging..."
  	aCodeGen maybeBreakForInlineOf: aSendNode in: self.
  	(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
  		[methArgs := methArgs allButFirst].
  	methArgs size = aSendNode args size ifFalse:
  		[^nil].
  	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]].
  
  	"Propagate any unusual argument types to untyped argument variables"
  	methArgs
  		with: aSendNode args
  		do: [:formal :actual|
  			(meth declarationAt: formal ifAbsent: nil) ifNil:
  				[(self typeFor: actual in: aCodeGen) ifNotNil:
  					[:type|
  					type ~= #sqInt ifTrue:
  						[meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
  
  	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: meth statements.  "method body"
  	(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 size = 1 ifTrue: "Nuke empty methods; e.g. override of flushAtCache"
+ 		[self assert: inlineStmts first class == TLabeledCommentNode.
+ 		 inlineStmts removeFirst].
  	^inlineStmts!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
- 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
  
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!

Item was changed:
  ----- Method: VMMaker>>generateMainVM (in category 'generate sources') -----
  generateMainVM
  	"Generate the interp (and optionally the cogit), internal plugins and exports.
  	 N.B. generateInterpreterFile *must* precede generateCogitFile so that
  	 the objectMemory and interpreter classes are initialized before the Cogit
  	 code is generated."
  
+ 	self logDateAndTime;
+ 		generateInterpreterFile;
- 	self generateInterpreterFile;
  		generateCogitFiles;
  		processFilesForCoreVM;
  		generateInternalPlugins;
+ 		generateExportsFile;
+ 		logDateAndTime!
- 		generateExportsFile!



More information about the Vm-dev mailing list