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

commits at source.squeak.org commits at source.squeak.org
Mon Jun 16 20:27:52 UTC 2014


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

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

Name: VMMaker.oscog-eem.775
Author: eem
Time: 16 June 2014, 1:25:07.943 pm
UUID: dd27f525-f775-49fc-8bf0-2463d78bfb97
Ancestors: VMMaker.oscog-eem.774

Rationalize the allocation check filler between V3 ObjMem
and Spur.  Make it applicable only to plugin prims and
optional, via the checkAllocFiller flag.
Add a prim failure code for this, PrimErrWritePastObject.
Make the Cogit check and fail offending ext prims if the flag
is set.
Don't fill new space with the alloc check filler if the flag is
not set.

This is good for a -49% increase in the performance of e.g.
	[1 to: 1000000000 do: [:i| {nil}]] timeToRun
on Spur.

Refactor numStrongSlotsOf:ephemeronInactiveIf: and inline
it in scavengeReferentsOf:, reusing the object format for
the isWeakling test.  Provide numStrongSlotsOfWeakling:
for weakling nilling, and hence arrange that the
numStrongSlotsOf:ephemeronInactiveIf: is always non-nil.

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

Item was changed:
  ----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	COGVM := true.
  
  	MinBackwardJumpCountForCompile := 10.
  
  	MaxNumArgs := 15.
  	PrimCallNeedsNewMethod := 1.
  	PrimCallNeedsPrimitiveFunction := 2.
  	PrimCallMayCallBack := 4.
  	PrimCallCollectsProfileSamples := 8.
+ 	CheckAllocationFillerAfterPrimCall := 16.
  
  	ReturnToInterpreter := 1. "setjmp/longjmp code."
  
  	PrimTraceLogSize := 256. "Room for 256 selectors.  Must be 256 because we use a byte to hold the index"
  	TraceBufferSize := 256 * 3. "Room for 256 events"
  	TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
  	TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
  	TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
  	TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
  	TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
  	TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
  	TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
  	TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
  	TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
  	TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
  	TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
  	TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
  	TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
  
  	TraceIsFromMachineCode := 1.
  	TraceIsFromInterpreter := 2.
  	CSCallbackEnter := 3.
  	CSCallbackLeave := 4.
  	CSEnterCriticalSection := 5.
  	CSExitCriticalSection := 6.
  	CSResume := 7.
  	CSSignal := 8.
  	CSSuspend := 9.
  	CSWait := 10.
  	CSYield := 11.
  	CSCheckEvents := 12.
  	CSThreadSchedulingLoop := 13.
  	CSOwnVM := 14.
  	CSThreadBind := 15.
  	CSSwitchIfNeccessary := 16.
  
  	TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal'  'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
  
  	"this is simulation only"
  	RumpCStackSize := 4096!

Item was added:
+ ----- Method: CoInterpreter>>getCheckAllocFiller (in category 'cog jit support') -----
+ getCheckAllocFiller
+ 	<api>
+ 	^checkAllocFiller!

Item was changed:
  ----- Method: CoInterpreter>>primitivePropertyFlags: (in category 'cog jit support') -----
  primitivePropertyFlags: primIndex
  	<api>
  	"Answer any special requirements of the given primitive"
  	| baseFlags functionPointer |
  	<var: #functionPointer declareC: 'void (*functionPointer)(void)'>
  	functionPointer := self functionPointerFor: primIndex inClass: nil.
  
  	baseFlags := profileSemaphore ~= objectMemory nilObject
  					ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
  					ifFalse: [0].
  
  	longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
  		[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
  
  		(functionPointer == #primitiveExternalCall
  	 or: [functionPointer == #primitiveCalloutToFFI]) ifTrue: "For callbacks"
+ 		[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack.
+ 		 checkAllocFiller ifTrue:
+ 			[baseFlags := baseFlags bitOr: CheckAllocationFillerAfterPrimCall]].
- 		[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack].
  
  	^baseFlags!

Item was changed:
  SharedPool subclass: #CogMethodConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CheckAllocationFillerAfterPrimCall MaxLiteralCountForCompile MaxMethodSize MaxNumArgs MaxStackCheckOffset PrimCallCollectsProfileSamples PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction'
- 	classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC MaxLiteralCountForCompile MaxMethodSize MaxNumArgs MaxStackCheckOffset PrimCallCollectsProfileSamples PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function result savedFramePointer savedStackPointer savedArgumentCount rpc |
  	evaluable := simulatedTrampolines at: aProcessorSimulationTrap address.
  	function := evaluable
  					isBlock ifTrue: ['aBlock; probably some plugin primitive']
  					ifFalse: [evaluable selector].
  	function ~~ #ceBaseFrameReturn: ifTrue:
  		[coInterpreter assertValidExternalStackPointers].
  	(function beginsWith: 'ceShort') ifTrue:
  		[^self perform: function with: aProcessorSimulationTrap].
  	aProcessorSimulationTrap type = #call
  		ifTrue:
  			[processor
  				simulateCallOf: aProcessorSimulationTrap address
  				nextpc: aProcessorSimulationTrap nextpc
  				memory: coInterpreter memory.
  			self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
  		ifFalse:
  			[processor
  				simulateJumpCallOf: aProcessorSimulationTrap address
  				memory: coInterpreter memory.
  			 self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
  	savedFramePointer := coInterpreter framePointer.
  	savedStackPointer := coInterpreter stackPointer.
  	savedArgumentCount := coInterpreter argumentCount.
  	result := ["self halt: evaluable selector."
  			   evaluable valueWithArguments: (processor
  												postCallArgumentsNumArgs: evaluable numArgs
  												in: coInterpreter memory)]
  				on: ReenterMachineCode
  				do: [:ex| ex return: ex returnValue].
  			
  	coInterpreter assertValidExternalStackPointers.
  	"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
  	 not called something that has built a frame, such as closure value or evaluate method, or
  	 switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
  	(function beginsWith: 'primitive') ifTrue:
+ 		[coInterpreter checkForLastObjectOverwrite.
- 		[objectMemory checkForLastObjectOverwrite.
  		 coInterpreter primFailCode = 0
  			ifTrue: [(#(	primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
  						primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
  						primitiveExecuteMethodArgsArray primitiveExecuteMethod
  						primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
  						primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
  							includes: function) ifFalse:
  						[self assert: savedFramePointer = coInterpreter framePointer.
  						 self assert: savedStackPointer + (savedArgumentCount * BytesPerWord)
  								= coInterpreter stackPointer]]
  			ifFalse:
  				[self assert: savedFramePointer = coInterpreter framePointer.
  				 self assert: savedStackPointer = coInterpreter stackPointer]].
  	result ~~ #continueNoReturn ifTrue:
  		[self recordInstruction: {'(simulated return to '. processor retpcIn: coInterpreter memory. ')'}.
  		 rpc := processor retpcIn: coInterpreter memory.
  		 self assert: (rpc >= codeBase and: [rpc < methodZone freeStart]).
  		 processor
  			smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: BytesPerWord;
  			simulateReturnIn: coInterpreter memory].
  	self assert: (result isInteger "an oop result"
  			or: [result == coInterpreter
  			or: [result == objectMemory
  			or: [#(nil continue continueNoReturn) includes: result]]]).
  	processor cResultRegister: (result
  							ifNil: [0]
  							ifNotNil: [result isInteger
  										ifTrue: [result]
  										ifFalse: [16rF00BA222]])
  
  	"coInterpreter cr.
  	 processor sp + 32 to: processor sp - 32 by: -4 do:
  		[:sp|
  		 sp = processor sp
  			ifTrue: [coInterpreter print: 'sp->'; tab]
  			ifFalse: [coInterpreter printHex: sp].
  		 coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!

Item was changed:
  ObjectMemory subclass: #NewObjectMemory
  	instanceVariableNames: 'coInterpreter freeStart reserveStart scavengeThreshold needGCFlag fullGCLock edenBytes checkForLeaks statGCEndUsecs heapMap'
+ 	classVariableNames: ''
- 	classVariableNames: 'AllocationCheckFiller'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !NewObjectMemory commentStamp: '<historical>' prior: 0!
  I am a refinement of ObjectMemory that eliminates the need for pushRemappableOop:/popRemappableOop in the interpreter proper.  Certain primitives that do major allocation may still want to provoke a garbage collection and hence may still need to remap private pointers.  But the interpreter subclass of this class does not have to provided it reserves sufficient space for it to make progress to the next scavenge point (send or backward branch).!

Item was removed:
- ----- Method: NewObjectMemory class>>initializeWithOptions: (in category 'initialization') -----
- initializeWithOptions: optionsDictionary
- 	"NewObjectMemory initializeWithOptions: Dictionary new"
- 
- 	super initializeWithOptions: optionsDictionary.
- 
- 	"The AllocationCheckFiller is used to fill newSpace and hence check for
- 	 writes beyond the ends of objects which would overwrite the filler."
- 	(optionsDictionary includesKey: #AllocationCheckFiller)
- 		ifTrue:
- 			[AllocationCheckFiller := optionsDictionary at: #AllocationCheckFiller]
- 		ifFalse:
- 			[AllocationCheckFiller isNil ifTrue:
- 				[AllocationCheckFiller := #(	0				"no allocation check"
- 											16r55AA55AA	"fill with 16r55AA55AA"
- 											16rADD4E55)	"fill with address"
- 												last
- 				"AllocationCheckFiller := 0"
- 				"AllocationCheckFiller := 16r55AA55AA"
- 				"AllocationCheckFiller := 16rADD4E55"]]!

Item was changed:
  ----- Method: NewObjectMemory>>allocateChunk: (in category 'allocation') -----
  allocateChunk: byteSize 
  	"Allocate a chunk of the given size. Sender must be sure that the requested size
  	 includes enough space for the header word(s).  This version is for normal allocations
  	 and refuses to allocate beyond the interpreter's reserveStart.  If the allocation takes
  	 freeStart over the scavenge threshold schedule a garbage collection.  If this returns 0
  	 the client should prepare for garbage collection and retry using allocateChunkAfterGC:"
  	| newChunk newFreeStart |
  	<inline: true>
  	<var: #newChunk type: #usqInt>
  	<var: #newFreeStart type: #usqInt>
  	newChunk := freeStart.
  	newFreeStart := freeStart + byteSize.
  	newFreeStart < scavengeThreshold ifTrue:
+ 		[freeStart := newFreeStart.
- 		[(AllocationCheckFiller ~= 0
- 		  and: [(self longAt: newChunk) ~= (AllocationCheckFiller = 16rADD4E55
- 												ifTrue: [newChunk]
- 												ifFalse: [AllocationCheckFiller])]) ifTrue:
- 			[self error: 'last object overwritten'].
- 		freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	self scheduleIncrementalGC.
  	freeStart <= reserveStart ifTrue:
  		[freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	^0!

Item was changed:
  ----- Method: NewObjectMemory>>allocateInterpreterChunk: (in category 'allocation') -----
  allocateInterpreterChunk: byteSize 
  	"Allocate a chunk of the given size. Sender must be sure that the requested size
  	 includes enough space for the header word(s).  This version is for interpreter
  	 allocations and will allocate beyond the interpreter's reserveStart.  If the allocation
  	 takes freeStart over the scavenge threshold schedule a garbage collection."
  	| newChunk newFreeStart |
  	<inline: true>
  	<asmLabel: false>
  	<var: #newChunk type: #usqInt>
  	<var: #newFreeStart type: #usqInt>
  
  	newChunk := freeStart.
  	newFreeStart := freeStart + byteSize.
  	newFreeStart < scavengeThreshold ifTrue:
+ 		[freeStart := newFreeStart.
- 		[(AllocationCheckFiller ~= 0
- 		  and: [(self longAt: newChunk) ~= (AllocationCheckFiller = 16rADD4E55
- 												ifTrue: [newChunk]
- 												ifFalse: [AllocationCheckFiller])]) ifTrue:
- 			[self error: 'last object overwritten'].
- 		freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	"Don't thrash doing collections when over the scavengeThreshold.
  	 Only schedule an incrementalGC if this allocation took us over the threshold."
  	freeStart < scavengeThreshold ifTrue:
  		[self scheduleIncrementalGC].
  
  	newFreeStart < reserveStart ifTrue:
  		[freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	"space is low.  A scavenge may reclaim sufficient space and this may be a
  	 false alarm.  We actually check for low space after the incremental collection.
  	 But we really do need to do a scavenge promptly, if only to check for low
  	 space.  We cannot do a garbage collect now without moving pointers under
  	 the VM's feet, which is too error-prone and inefficient to contemplate."
  
  	self scheduleIncrementalGC.
  
  	freeStart <= endOfMemory ifTrue:
  		[freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	self error: 'out of memory'.
  	^nil!

Item was removed:
- ----- Method: NewObjectMemory>>checkForLastObjectOverwrite (in category 'allocation') -----
- checkForLastObjectOverwrite
- 	<doNotGenerate>
- 	self assert: (freeStart >= scavengeThreshold
- 				or: [(AllocationCheckFiller = 0
- 		  		or: [(self longAt: freeStart) = (AllocationCheckFiller = 16rADD4E55
- 												ifTrue: [freeStart]
- 												ifFalse: [AllocationCheckFiller])])])!

Item was changed:
  ----- Method: NewObjectMemory>>maybeFillWithAllocationCheckFillerFrom:to: (in category 'allocation') -----
  maybeFillWithAllocationCheckFillerFrom: start to: end
  	"Fill free memory with a bit pattern for checking if the last object has been overwritten."
  	<inline: true>
  	<var: 'start' type: #usqInt>
  	<var: 'end' type: #usqInt>
+ 	<var: 'p' type: #usqInt>
+ 	coInterpreter checkAllocFiller ifTrue:
- 	<var: 'i' type: #usqInt>
- 	AllocationCheckFiller ~= 0 ifTrue:
  		[start to: end by: BytesPerWord do:
+ 			[:p| self longAt: p put: p]]!
- 			[:i|
- 			self longAt: i put: (AllocationCheckFiller = 16rADD4E55
- 									ifTrue: [i]
- 									ifFalse: [AllocationCheckFiller])]]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive: (in category 'primitive generators') -----
  compileInterpreterPrimitive: primitiveRoutine
  	"Compile a call to an interpreter primitive.  Call the C routine with the
  	 usual stack-switching dance, test the primFailCode and then either
  	 return on success or continue to the method body."
  	<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
  	| flags jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
  	<var: #jmp type: #'AbstractInstruction *'>
  	<var: #jmpSamplePrim type: #'AbstractInstruction *'>
  	<var: #continuePostSamplePrim type: #'AbstractInstruction *'>
  	<var: #jmpSampleNonPrim type: #'AbstractInstruction *'>
  	<var: #continuePostSampleNonPrim type: #'AbstractInstruction *'>
  
  	"Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
  	self genExternalizePointersForPrimitiveCall.
  	"Switch to the C stack."
  	self genLoadCStackPointersForPrimCall.
  
  	flags := coInterpreter primitivePropertyFlags: primitiveIndex.
  	(flags bitAnd: PrimCallCollectsProfileSamples) ~= 0 ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick if so"
  		BytesPerWord = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + BytesPerWord R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSampleNonPrim := self JumpNonZero: 0.
  		continuePostSampleNonPrim := self Label].
  
  	"Clear the primFailCode and set argumentCount"
  	self MoveCq: 0 R: TempReg.
  	self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
  	methodOrBlockNumArgs ~= 0 ifTrue:
  		[self MoveCq: methodOrBlockNumArgs R: TempReg].
  	self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
  	(flags bitAnd: PrimCallNeedsPrimitiveFunction) ~= 0 ifTrue:
  		[self MoveCw: primitiveRoutine asInteger R: TempReg.
  		 self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
  	"Old full prim trace is in VMMaker-eem.550 and prior"
  	self recordPrimTrace ifTrue:
  		[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
  	((flags bitAnd: PrimCallNeedsNewMethod+PrimCallMayCallBack) ~= 0) ifTrue:
  		["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
  		 (flags bitAnd: PrimCallMayCallBack) ~= 0 ifTrue:
  			[needsFrame := true].
  		 methodLabel addDependent:
  			(self annotateAbsolutePCRef:
  				(self MoveCw: methodLabel asInteger R: ClassReg)).
  		 self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
  		 self MoveR: TempReg Aw: coInterpreter newMethodAddress].
  	self PrefetchAw: coInterpreter primFailCodeAddress.
  	(flags bitAnd: PrimCallMayCallBack) ~= 0
  		ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
  			[backEnd genSubstituteReturnAddress:
  				((flags bitAnd: PrimCallCollectsProfileSamples) ~= 0
  					ifTrue: [cePrimReturnEnterCogCodeProfiling]
  					ifFalse: [cePrimReturnEnterCogCode]).
  			 self JumpRT: primitiveRoutine asInteger.
  			 primInvokeLabel := self Label.
  			 jmp := jmpSamplePrim := continuePostSamplePrim := nil]
  		ifFalse:
  			["Call the C primitive routine."
  			self CallRT: primitiveRoutine asInteger.
  			primInvokeLabel := self Label.
  			(flags bitAnd: PrimCallCollectsProfileSamples) ~= 0 ifTrue:
  				[self assert: (flags bitAnd: PrimCallNeedsNewMethod) ~= 0.
  				"Test nextProfileTick for being non-zero and call checkProfileTick if so"
  				BytesPerWord = 4
  					ifTrue:
  						[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  						 self MoveAw: coInterpreter nextProfileTickAddress + BytesPerWord R: ClassReg.
  						 self OrR: TempReg R: ClassReg]
  					ifFalse:
  						[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  						 self CmpCq: 0 R: TempReg].
  				"If set, jump to record sample call."
  				jmpSamplePrim := self JumpNonZero: 0.
  				continuePostSamplePrim := self Label].
+ 			self maybeCompileAllocFillerCheck.
  			"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  				success:	stackPointer	->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  				failure:						receiver
  											arg1
  											...
  							stackPointer	->	argN
  											return pc
  			In either case we can push the instructionPointer to reestablish the return pc"
  			self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
  			backEnd genLoadStackPointers.
  			"Test primitive failure"
  			self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  			self PushR: ClassReg. "Restore return pc"
  			self flag: 'ask concrete code gen if move sets condition codes?'.
  			self CmpCq: 0 R: TempReg.
  			jmp := self JumpNonZero: 0.
  			"Fetch result from stack"
  			self MoveMw: BytesPerWord r: SPReg R: ReceiverResultReg.
  			self flag: 'currently caller pushes result'.
  			self RetN: BytesPerWord].
  
  	(flags bitAnd: PrimCallCollectsProfileSamples) ~= 0 ifTrue:
  		["The sample is collected by cePrimReturnEnterCogCode for external calls"
  		jmpSamplePrim notNil ifTrue:
  			["Call ceCheckProfileTick: to record sample and then continue."
  			jmpSamplePrim jmpTarget: self Label.
  			self assert: (flags bitAnd: PrimCallNeedsNewMethod) ~= 0.
  			self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
  							   inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  			"reenter the post-primitive call flow"
  			self Jump: continuePostSamplePrim].
  		"Null newMethod and call ceCheckProfileTick: to record sample and then continue.
  		 ceCheckProfileTick will map null/0 to coInterpreter nilObject"
  		jmpSampleNonPrim jmpTarget: self Label.
  		self MoveCq: 0 R: TempReg.
  		self MoveR: TempReg Aw: coInterpreter newMethodAddress.
  		self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
  						   inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  		"reenter the post-primitive call flow"
  		self Jump: continuePostSampleNonPrim].
  
  	jmp notNil ifTrue:
  		["Jump to restore of receiver reg and proceed to frame build for failure."
  		 jmp jmpTarget: self Label.
  		 "Restore receiver reg from stack."
  		 self MoveMw: BytesPerWord * (methodOrBlockNumArgs + 1) r: SPReg R: ReceiverResultReg].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
  genPrimReturnEnterCogCodeEnilopmart: profiling
  	"Generate the substitute return code for an external or FFI primitive call.
  	 On success simply return, extracting numArgs from newMethod.
  	 On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
  	| jmpSample continuePostSample jmpFail |
  	<var: #jmpSample type: #'AbstractInstruction *'>
  	<var: #continuePostSample type: #'AbstractInstruction *'>
  	<var: #jmpFail type: #'AbstractInstruction *'>
  	opcodeIndex := 0.
  
  	profiling ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick: if so.
  		  N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves."
  		BytesPerWord = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + BytesPerWord R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSample := self JumpNonZero: 0.
  		continuePostSample := self Label].
  
+ 	self maybeCompileAllocFillerCheck.
+ 
  	"Test primitive failure"
  	self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  	self flag: 'ask concrete code gen if move sets condition codes?'.
  	self CmpCq: 0 R: TempReg.
  	jmpFail := self JumpNonZero: 0.
  
  	"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  		success:	stackPointer	->	result (was receiver)
  										arg1
  										...
  										argN
  										return pc
  		failure:							receiver
  										arg1
  										...
  					stackPointer	->	argN
  										return pc
  	We push the instructionPointer to reestablish the return pc in the success case,
  	but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."
  
  	backEnd hasLinkRegister
  		ifTrue:
  			[backEnd genLoadStackPointers.									"Switch back to Smalltalk stack."
  			 self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  			 self MoveAw: coInterpreter instructionPointerAddress R: LinkReg.	"Get and restore ret pc"
  			 self RetN: BytesPerWord]											"Return, popping result from stack"
  		ifFalse:
  			[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.	"Get return pc"
  			 backEnd genLoadStackPointers.									"Switch back to Smalltalk stack."
  			 self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  			 self MoveR: ClassReg Mw: 0 r: SPReg.								"Restore return pc"
  			 self RetN: 0].														"Return, popping result from stack"
  
  	"Primitive failed.  Invoke C code to build the frame and continue."
  	jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
  	"Reload sp with CStackPointer; easier than popping args of checkProfileTick."
  	self MoveAw: self cStackPointerAddress R: SPReg.
  	cStackAlignment > BytesPerWord ifTrue:
  		[backEnd
  			genAlignCStackSavingRegisters: false
  			numArgs: 1
  			wordAlignment: cStackAlignment / BytesPerWord].
  	backEnd genPassReg: SendNumArgsReg asArgument: 0.
  	self CallRT: (self cCode: '(unsigned long)ceActivateFailingPrimitiveMethod'
  					inSmalltalk: [self simulatedTrampolineFor: #ceActivateFailingPrimitiveMethod:]).
  
  	profiling ifTrue:
  		["Call ceCheckProfileTick: to record sample and then continue.  newMethod
  		 should be up-to-date.  Need to save and restore the link reg around this call."
  		 jmpSample jmpTarget: self Label.
  		 backEnd hasLinkRegister ifTrue: [self PushR: LinkReg].
  		 self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
  						inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  		 backEnd hasLinkRegister ifTrue: [self PopR: LinkReg].
  		 self Jump: continuePostSample]!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>maybeCompileAllocFillerCheck (in category 'primitive generators') -----
+ maybeCompileAllocFillerCheck
+ 	"If allocCheckFiller is true, words in newSpace from freeStart to scavengeThreshold
+ 	 are filled with their address, and after each call of a plugin primitive, the VM checks
+ 	 that freeStart points to a word containing the value of freeStart.  This is a simple
+ 	 check for primitives overwriting the ends of an object."
+ 	| jmpOk |
+ 	<var: #jmpOk type: #'AbstractInstruction *'>
+ 	coInterpreter getCheckAllocFiller ifTrue:
+ 		[self MoveAw: objectMemory freeStartAddress R: ClassReg.
+ 		 self MoveMw: 0 r: ClassReg R: TempReg.
+ 		 self CmpR: ClassReg R: TempReg.
+ 		 jmpOk := self JumpZero: 0.
+ 		 self MoveCq: PrimErrWritePastObject R: TempReg.
+ 		 self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
+ 		 jmpOk jmpTarget: self Label]!

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

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'scavenger') -----
  scavengeReferentsOf: referrer
  	"scavengeReferentsOf: referrer inspects all the pointers in referrer.  If
  	 any are new objects, it has them moved to FutureSurvivorSpace, and
  	 answers truth. If there are no new referents, it answers falsity. To handle
  	 weak arrays, if the referrer is weak only scavenge strong slots and answer
  	 true so that it won't be removed from the remembered set until later."
+ 	| fmt foundNewReferentOrIsWeakling numSlots |
- 	| foundNewReferent |
  	"forwarding objects should be followed by callers,
  	 unless the forwarder is a root in the remembered table."
  	self assert: ((manager isForwarded: referrer) not
  				or: [manager isRemembered: referrer]).
  	"unscanned ephemerons should be scanned later."
  	self assert: ((manager isEphemeron: referrer) not
  				or: [(self isScavengeSurvivor: (manager keyOfEphemeron: referrer))
  				or: [self is: referrer onWeaklingList: ephemeronList]]).
+ 	fmt := manager formatOf: referrer.
+ 	foundNewReferentOrIsWeakling := manager isWeakFormat: fmt.
+ 	numSlots := manager numStrongSlotsOf: referrer format: fmt ephemeronInactiveIf: #isScavengeSurvivor:.
+ 	0 to: numSlots - 1 do:
+ 		[:i| | referent newLocation |
- 	foundNewReferent := false.
- 	0 to: (manager numStrongSlotsOf: referrer ephemeronInactiveIf: #isScavengeSurvivor:) - 1
- 	   do: [:i| | referent newLocation |
  		referent := manager fetchPointer: i ofMaybeForwardedObject: referrer.
  		(manager isNonImmediate: referent) ifTrue:
  			["a forwarding pointer could be because of become: or scavenging."
  			 (manager isForwarded: referent) ifTrue:
  				[referent := manager followForwarded: referent].
  			 (manager isReallyYoungObject: referent)
  				ifTrue: "if target is already in future space forwarding pointer was due to a become:."
  					[(manager isInFutureSpace: referent)
+ 						ifTrue: [newLocation := referent. foundNewReferentOrIsWeakling := true]
- 						ifTrue: [newLocation := referent. foundNewReferent := true]
  						ifFalse:
  							[newLocation := self copyAndForward: referent.
  							 (manager isYoung: newLocation) ifTrue:
+ 								[foundNewReferentOrIsWeakling := true]].
- 								[foundNewReferent := true]].
  					 manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: newLocation]
  				ifFalse:
  					[manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: referent]]].
+ 	^foundNewReferentOrIsWeakling!
- 	^foundNewReferent or: [manager isWeakNonImm: referrer]!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurMemoryManager initialize"
  	BitsPerByte := 8.
  
  	"An obj stack is a stack of objects stored in a hidden root slot, such as
  	 the markStack or the ephemeronQueue.  It is a linked list of segments,
  	 with the hot end at the head of the list.  It is a word object.  The stack
  	 pointer is in ObjStackTopx and 0 means empty.  The list goes through
  	 ObjStackNextx. We don't want to shrink objStacks, since they're used
  	 in GC and its good to keep their memory around.  So unused pages
  	 created by popping emptying pages are kept on the ObjStackFreex list.
  	 ObjStackNextx must be the last field for swizzleObjStackAt:."
  	ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
  	ObjStackTopx := 0.
  	ObjStackMyx := 1.
  	ObjStackFreex := 2.
  	ObjStackNextx := 3.
  	ObjStackFixedSlots := 4.
  	ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
  	"There are currently three obj stacks, the mark stack, the weaklings and the ephemeron queue."
  	MarkStackRootIndex := self basicNew classTableRootSlots.
  	WeaklingStackRootIndex := MarkStackRootIndex + 1.
  	EphemeronQueueRootIndex := MarkStackRootIndex + 2.
  
- 	CheckObjectOverwrite := true.
  	MarkObjectsForEnumerationPrimitives := false.
  
  	"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
  	 Eventually this should die."
  	RemapBufferSize := 25.
  
  	"Extra roots are for plugin support."
  	ExtraRootsSize := 2048 "max. # of external roots"!

Item was removed:
- ----- Method: SpurMemoryManager>>checkForLastObjectOverwrite (in category 'allocation') -----
- checkForLastObjectOverwrite
- 	<doNotGenerate>
- 	self assert: (freeStart >= scavengeThreshold
- 				or: [CheckObjectOverwrite not
- 		  		or: [(self longAt: freeStart + BytesPerWord) = (freeStart + BytesPerWord)]])!

Item was changed:
  ----- Method: SpurMemoryManager>>doScavenge: (in category 'gc - scavenging') -----
  doScavenge: tenuringCriterion
  	"The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
  	<inline: false>
  	scavengeInProgress := true.
  	pastSpaceStart := scavenger scavenge: tenuringCriterion.
  	self assert: (self
  					oop: pastSpaceStart
  					isGreaterThanOrEqualTo: scavenger pastSpace start
  					andLessThanOrEqualTo: scavenger pastSpace limit).
  	freeStart := scavenger eden start.
+ 	self initSpaceForAllocationCheck: (self addressOf: scavenger eden) limit: scavengeThreshold.
- 	self initSpaceForAllocationCheck: (self addressOf: scavenger eden).
  	scavengeInProgress := false!

Item was removed:
- ----- Method: SpurMemoryManager>>initSpaceForAllocationCheck: (in category 'allocation') -----
- initSpaceForAllocationCheck: aNewSpace
- 	<var: 'aNewSpace' type: #'SpurNewSpaceSpace *'>
- 	memory ifNotNil:
- 		[CheckObjectOverwrite ifTrue:
- 			[aNewSpace start
- 				to: aNewSpace limit - 1
- 				by: self wordSize
- 				do: [:p| self longAt: p put: p]]]!

Item was added:
+ ----- Method: SpurMemoryManager>>initSpaceForAllocationCheck:limit: (in category 'allocation') -----
+ initSpaceForAllocationCheck: aNewSpace limit: limit
+ 	<var: 'aNewSpace' type: #'SpurNewSpaceSpace *'>
+ 	<var: 'limit' type: #usqInt>
+ 	memory ifNotNil:
+ 		[coInterpreter checkAllocFiller ifTrue:
+ 			[aNewSpace start
+ 				to: limit - 1
+ 				by: self wordSize
+ 				do: [:p| self longAt: p put: p]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeNewSpaceVariables (in category 'gc - scavenging') -----
  initializeNewSpaceVariables
  	freeStart := scavenger eden start.
  	pastSpaceStart := scavenger pastSpace start.
  	scavengeThreshold := scavenger eden limit
  							- (scavenger edenBytes // 64)
  							- coInterpreter interpreterAllocationReserveBytes.
  	newSpaceStart := scavenger pastSpace start min: scavenger futureSpace start.
  	self assert: newSpaceStart < scavenger eden start.
+ 	self initSpaceForAllocationCheck: (self addressOf: scavenger eden) limit: scavengeThreshold!
- 	self initSpaceForAllocationCheck: (self addressOf: scavenger eden)!

Item was changed:
  ----- Method: SpurMemoryManager>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') -----
  markAndTraceWeaklingsFrom: startIndex
  	"Mark weaklings on the weaklingStack, ignoring startIndex
  	 number of elements on the bottom of the stack.  Answer
  	 the size of the stack *before* the enumeration began."
  	^self objStack: weaklingStack from: startIndex do:
  		[:weakling|
  		 self markAndTraceClassOf: weakling.
+ 		 0 to: (self numStrongSlotsOfWeakling: weakling) - 1 do:
- 		 0 to: (self numStrongSlotsOf: weakling ephemeronInactiveIf: nil) - 1 do:
  			[:i| | field |
  			field := self fetchPointer: i ofObject: weakling.
  			((self isImmediate: field) or: [self isMarked: field]) ifFalse:
  				[self markAndTrace: field]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlotsIn: (in category 'weakness and ephemerality') -----
  nilUnmarkedWeaklingSlotsIn: aWeakling
  	"Nil the unmarked slots in aWeakling and
  	 answer if any unmarked slots were found."
  	| anyUnmarked |
  	anyUnmarked := false.
+ 	(self numStrongSlotsOfWeakling: aWeakling) to: (self numSlotsOf: aWeakling) - 1 do:
- 	(self numStrongSlotsOf: aWeakling ephemeronInactiveIf: nil) to: (self numSlotsOf: aWeakling) - 1 do:
  		[:i| | referent |
  		referent := self fetchPointer: i ofObject: aWeakling.
  		((self isNonImmediate: referent)
  		 and: [self isForwarded: referent]) ifTrue:
  			[referent := self fixFollowedField: i ofObject: aWeakling withInitialValue: referent].
  		((self isImmediate: referent) or: [self isMarked: referent]) ifFalse:
  			[self storePointerUnchecked: i ofObject: aWeakling withValue: nilObj.
  			 anyUnmarked := true]].
  	^anyUnmarked!

Item was changed:
  ----- Method: SpurMemoryManager>>numStrongSlotsOf:ephemeronInactiveIf: (in category 'object access') -----
  numStrongSlotsOf: objOop ephemeronInactiveIf: criterion
  	"Answer the number of strong pointer fields in the given object.
  	 Works with CompiledMethods, as well as ordinary objects."
- 	<api>
  	<var: 'criterion' declareC: 'int (*criterion)(sqInt key)'>
  	<inline: true>
  	<asmLabel: false>
+ 	| fmt |
- 	| fmt numSlots  contextSize numLiterals |
  	fmt := self formatOf: objOop.
+ 	^self numStrongSlotsOf: objOop format: (self formatOf: objOop) ephemeronInactiveIf: criterion!
- 	fmt <= self lastPointerFormat ifTrue:
- 		[numSlots := self numSlotsOf: objOop.
- 		 fmt <= self arrayFormat ifTrue:
- 			[^numSlots].
- 		 fmt = self indexablePointersFormat ifTrue:
- 			[(self isContextNonImm: objOop) ifTrue:
- 				[coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: objOop.
- 				 "contexts end at the stack pointer"
- 				 contextSize := coInterpreter fetchStackPointerOf: objOop.
- 				 ^CtxtTempFrameStart + contextSize].
- 			 ^numSlots].
- 		 fmt = self weakArrayFormat ifTrue:
- 			[^self fixedFieldsOfClass: (self fetchClassOfNonImm: objOop)].
- 		 self assert: fmt = self ephemeronFormat.
- 		 ^(criterion isNil or: [self perform: criterion with: (self keyOfEphemeron: objOop)])
- 			ifTrue: [numSlots]
- 			ifFalse: [0]].
- 	fmt = self forwardedFormat ifTrue: [^1].
- 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
- 
- 	"CompiledMethod: contains both pointers and bytes"
- 	numLiterals := coInterpreter literalCountOf: objOop.
- 	^numLiterals + LiteralStart!

Item was added:
+ ----- Method: SpurMemoryManager>>numStrongSlotsOf:format:ephemeronInactiveIf: (in category 'object access') -----
+ numStrongSlotsOf: objOop format: fmt ephemeronInactiveIf: criterion
+ 	"Answer the number of strong pointer fields in the given object.
+ 	 Works with CompiledMethods, as well as ordinary objects."
+ 	<var: 'criterion' declareC: 'int (*criterion)(sqInt key)'>
+ 	<inline: true>
+ 	<asmLabel: false>
+ 	| numSlots  contextSize numLiterals |
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[numSlots := self numSlotsOf: objOop.
+ 		 fmt <= self arrayFormat ifTrue:
+ 			[^numSlots].
+ 		 fmt = self indexablePointersFormat ifTrue:
+ 			[(self isContextNonImm: objOop) ifTrue:
+ 				[coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: objOop.
+ 				 "contexts end at the stack pointer"
+ 				 contextSize := coInterpreter fetchStackPointerOf: objOop.
+ 				 ^CtxtTempFrameStart + contextSize].
+ 			 ^numSlots].
+ 		 fmt = self weakArrayFormat ifTrue:
+ 			[^self fixedFieldsOfClass: (self fetchClassOfNonImm: objOop)].
+ 		 self assert: fmt = self ephemeronFormat.
+ 		 ^(self perform: criterion with: (self keyOfEphemeron: objOop))
+ 			ifTrue: [numSlots]
+ 			ifFalse: [0]].
+ 	fmt = self forwardedFormat ifTrue: [^1].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
+ 
+ 	"CompiledMethod: contains both pointers and bytes"
+ 	numLiterals := coInterpreter literalCountOf: objOop.
+ 	^numLiterals + LiteralStart!

Item was added:
+ ----- Method: SpurMemoryManager>>numStrongSlotsOfWeakling: (in category 'object access') -----
+ numStrongSlotsOfWeakling: objOop
+ 	"Answer the number of strong pointer fields in the given weakling."
+ 	<api>
+ 	<inline: true>
+ 	<asmLabel: false>
+ 	self assert: (self formatOf: objOop) = self weakArrayFormat.
+ 	^self fixedFieldsOfClass: (self fetchClassOfNonImm: objOop)!

Item was added:
+ ----- Method: SpurMemoryManager>>scavengeThreshold (in category 'accessing') -----
+ scavengeThreshold
+ 	^scavengeThreshold!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache 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 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache 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 tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
  	classVariableNames: 'AltBytecodeEncoderClassName AltLongStoreBytecode AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 9/11/2013 18:30' 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.
  
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
  
  1.  There are a number of things that should be done the next time we plan to release a completely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
  
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the SystemTracer.  A better solution would be to reserve one of the format codes for Contexts only.  An even better solution is to eliminate compact classes altogether (see 6.).
  
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes].
  
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache.
  
  5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT.  We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
  
  6.  If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.  [Late breaking news, the 2-word header scheme is more compact, by over 2%].  See SpurMemorymanager's class comment.!

Item was changed:
  ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
  mustBeGlobal: var
  	"Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."
  
  	^(self objectMemoryClass mustBeGlobal: var)
  	   or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
  			'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
  			'desiredNumStackPages' 'desiredEdenBytes'
+ 			'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller'
- 			'breakSelector' 'breakSelectorLength' 'sendTrace'
  			'suppressHeartbeatFlag') includes: var)
  	   or: [ "This allows slow machines to define bytecodeSetSelector as 0
  			to avoid the interpretation overhead."
  			MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]!

Item was changed:
  ----- Method: StackInterpreter>>callExternalPrimitive: (in category 'plugin primitive support') -----
  callExternalPrimitive: functionID
  	"Call the external plugin function identified. In the VM this is an address;
  	 see StackInterpreterSimulator for its version."
  
  	<var: #functionID declareC: 'void (*functionID)()'>
+ 	self dispatchFunctionPointer: functionID.
+ 	self maybeFailForLastObjectOverwrite.!
- 	self dispatchFunctionPointer: functionID!

Item was added:
+ ----- Method: StackInterpreter>>checkAllocFiller (in category 'primitive support') -----
+ checkAllocFiller
+ 	"If allocCheckFiller is true, words in newSpace from freeStart to scavengeThreshold
+ 	 are filled with their address, and after each call of a plugin primitive, the VM checks
+ 	 that freeStart points to a word containing the value of freeStart.  This is a simple
+ 	 check for primitives overwriting the ends of an object."
+ 	<cmacro: '() GIV(checkAllocFiller)'>
+ 	^checkAllocFiller!

Item was added:
+ ----- Method: StackInterpreter>>checkForLastObjectOverwrite (in category 'simulation') -----
+ checkForLastObjectOverwrite
+ 	<doNotGenerate>
+ 	| freeStart |
+ 	checkAllocFiller ifTrue: 
+ 		[self assert: ((freeStart := objectMemory freeStart) >= objectMemory scavengeThreshold
+ 					  or: [(self longAt: freeStart) = freeStart])]!

Item was changed:
  ----- Method: StackInterpreter>>dispatchFunctionPointer: (in category 'message sending') -----
  dispatchFunctionPointer: aFunctionPointer
  	"In C aFunctionPointer is void (*aFunctionPointer)()"
  	<cmacro: '(aFunctionPointer) (aFunctionPointer)()'>
+ 	"In Smalltalk aFunctionPointer is a message selector symbol, except for
+ 	 external primitives which are funkily encoded as integers >= 1000."
- 	| result |
  	(aFunctionPointer isInteger
+ 	 and: [aFunctionPointer >= 1000])
+ 		ifTrue: [self callExternalPrimitive: aFunctionPointer]
+ 		ifFalse: [self perform: aFunctionPointer]!
- 	 and: [aFunctionPointer >= 1000]) ifTrue:
- 		[result := self callExternalPrimitive: aFunctionPointer.
- 		 objectMemory checkForLastObjectOverwrite.
- 		 ^result].
- 	"In Smalltalk aFunctionPointer is a message selector symbol"
- 	result := self perform: aFunctionPointer.
- 	 objectMemory checkForLastObjectOverwrite.
- 	 ^result!

Item was changed:
  ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift 
  	"Initialize Interpreter state before starting execution of a new image."
  	interpreterProxy := self sqGetInterpreterProxy.
  	self dummyReferToProxy.
  	objectMemory initializeObjectMemory: bytesToShift.
  	self checkAssumedCompactClasses.
  	primFailCode := 0.
  	self initializeExtraClassInstVarIndices.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
  	method := newMethod := objectMemory nilObject.
  	self cCode: [self cppIf: MULTIPLEBYTECODESETS ifTrue: [bytecodeSetSelector := 0]]
  		inSmalltalk: [bytecodeSetSelector := 0].
  	methodDictLinearSearchLimit := 8.
  	self flushMethodCache.
  	self flushAtCache.
  	self initialCleanup.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	profileSemaphore := objectMemory nilObject.
  	profileProcess := objectMemory nilObject.
  	profileMethod := objectMemory nilObject.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := theUnknownShort := 0.
  	interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	[globalSessionID = 0] whileTrue:
  		[globalSessionID := self
  							cCode: [(self time: #NULL) + self ioMSecs]
  							inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs :=
  	longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
+ 	checkAllocFiller := false.
  	statForceInterruptCheck := 0.
  	statStackOverflow := 0.
  	statCheckForEvents := 0.
  	statProcessSwitch := 0.
  	statIOProcessEvents := 0.
  	statStackPageDivorce := 0!

Item was added:
+ ----- Method: StackInterpreter>>maybeFailForLastObjectOverwrite (in category 'simulation') -----
+ maybeFailForLastObjectOverwrite
+ 	<inline: true>
+ 	checkAllocFiller ifTrue: 
+ 		[(objectMemory freeStart < objectMemory scavengeThreshold
+ 		  and: [(objectMemory longAt: objectMemory freeStart) ~= objectMemory freeStart]) ifTrue:
+ 			[self primitiveFailFor: PrimErrWritePastObject]]!

Item was added:
+ ----- Method: StackInterpreter>>setCheckAllocFiller: (in category 'primitive support') -----
+ setCheckAllocFiller: aBool
+ 	"If allocCheckFiller is true, words in newSpace from freeStart to scavengeThreshold
+ 	 are filled with their address, and after each call of a plugin primitive, the VM checks
+ 	 that freeStart points to a word containing the value of freeStart.  This is a simple
+ 	 check for primitives overwriting the ends of an object."
+ 	checkAllocFiller := aBool!

Item was changed:
  ----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
  slowPrimitiveResponse
  	"Invoke a normal (non-quick) primitive.
  	 Called under the assumption that primFunctionPointer has been preloaded."
  	| nArgs savedFramePointer savedStackPointer |
  	<inline: true>
  	<asmLabel: false>
  	<var: #savedFramePointer type: #'char *'>
  	<var: #savedStackPointer type: #'char *'>
  	self assert: (objectMemory isOopForwarded: (self stackValue: argumentCount)) not.
  	FailImbalancedPrimitives ifTrue:
  		[nArgs := argumentCount.
  		 savedStackPointer := stackPointer.
  		 savedFramePointer := framePointer].
  	self initPrimCall.
  	self dispatchFunctionPointer: primitiveFunctionPointer.
  	"In Spur a primitive may fail due to encountering a forwarder.
  	 On failure check the accessorDepth for the primitive and
  	 if non-negative scan the args to the depth, following any
  	 forwarders.  Retry the primitive if any are found."
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [self successful not
  	 and: [(objectMemory isOopCompiledMethod: newMethod)
  	 and: [self checkForAndFollowForwardedPrimitiveState]]]) ifTrue:
  		[self initPrimCall.
  		 self dispatchFunctionPointer: primitiveFunctionPointer].
+ 	self maybeFailForLastObjectOverwrite.
  	(FailImbalancedPrimitives
  	and: [self successful
  	and: [framePointer = savedFramePointer
  	and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
  		[stackPointer ~= (savedStackPointer + (nArgs * BytesPerWord)) ifTrue:
  			[self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
  			 "This is necessary but insufficient; the result may still have been written to the stack.
  			   At least we'll know something is wrong."
  			 stackPointer := savedStackPointer.
  			 self failUnbalancedPrimitive]].
  	"If we are profiling, take accurate primitive measures"
  	nextProfileTick > 0 ifTrue:
  		[self checkProfileTick: newMethod].
  	^self successful!

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 GCModeFull GCModeIncr GCModeScavenge IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr STACKVM ShiftForWord 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 GCModeIncr GCModeScavenge IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord 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: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
  initializePrimitiveErrorCodes
  	"Define the VM's primitive error codes.  N.B. these are
  	 replicated in platforms/Cross/vm/sqVirtualMachine.h."
  	"VMClass initializePrimitiveErrorCodes"
  	| pet |
  	PrimErrTableIndex := 51. "Zero-relative"
  	"See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
  	 If the table exists and is large enough the corresponding entry is returned as
  	 the primitive error, otherwise the error is answered numerically."
  	pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
  	pet isArray ifFalse: [pet := #()].
  	PrimNoErr := 0. "for helper methods that need to answer success or an error code."
+ 	PrimErrGenericFailure		:= pet indexOf: nil ifAbsent: 1.
+ 	PrimErrBadReceiver			:= pet indexOf: #'bad receiver' ifAbsent: 2.
+ 	PrimErrBadArgument		:= pet indexOf: #'bad argument' ifAbsent: 3.
+ 	PrimErrBadIndex			:= pet indexOf: #'bad index' ifAbsent: 4.
+ 	PrimErrBadNumArgs		:= pet indexOf: #'bad number of arguments' ifAbsent: 5.
+ 	PrimErrInappropriate		:= pet indexOf: #'inappropriate operation' ifAbsent: 6.
+ 	PrimErrUnsupported		:= pet indexOf: #'unsupported operation' ifAbsent: 7.
+ 	PrimErrNoModification		:= pet indexOf: #'no modification' ifAbsent: 8.
+ 	PrimErrNoMemory			:= pet indexOf: #'insufficient object memory' ifAbsent: 9.
+ 	PrimErrNoCMemory			:= pet indexOf: #'insufficient C memory' ifAbsent: 10.
+ 	PrimErrNotFound			:= pet indexOf: #'not found' ifAbsent: 11.
+ 	PrimErrBadMethod			:= pet indexOf: #'bad method' ifAbsent: 12.
+ 	PrimErrNamedInternal		:= pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
+ 	PrimErrObjectMayMove		:= pet indexOf: #'object may move' ifAbsent: 14.
+ 	PrimErrLimitExceeded		:= pet indexOf: #'resource limit exceeded' ifAbsent: 15.
+ 	PrimErrObjectIsPinned		:= pet indexOf: #'object is pinned' ifAbsent: 16.
+ 	PrimErrWritePastObject	:= pet indexOf: #'primitive write beyond end of object' ifAbsent: 17!
- 	PrimErrGenericFailure	:= pet indexOf: nil ifAbsent: 1.
- 	PrimErrBadReceiver		:= pet indexOf: #'bad receiver' ifAbsent: 2.
- 	PrimErrBadArgument	:= pet indexOf: #'bad argument' ifAbsent: 3.
- 	PrimErrBadIndex		:= pet indexOf: #'bad index' ifAbsent: 4.
- 	PrimErrBadNumArgs	:= pet indexOf: #'bad number of arguments' ifAbsent: 5.
- 	PrimErrInappropriate	:= pet indexOf: #'inappropriate operation' ifAbsent: 6.
- 	PrimErrUnsupported	:= pet indexOf: #'unsupported operation' ifAbsent: 7.
- 	PrimErrNoModification	:= pet indexOf: #'no modification' ifAbsent: 8.
- 	PrimErrNoMemory		:= pet indexOf: #'insufficient object memory' ifAbsent: 9.
- 	PrimErrNoCMemory		:= pet indexOf: #'insufficient C memory' ifAbsent: 10.
- 	PrimErrNotFound		:= pet indexOf: #'not found' ifAbsent: 11.
- 	PrimErrBadMethod		:= pet indexOf: #'bad method' ifAbsent: 12.
- 	PrimErrNamedInternal	:= pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
- 	PrimErrObjectMayMove	:= pet indexOf: #'object may move' ifAbsent: 14.
- 	PrimErrLimitExceeded	:= pet indexOf: #'resource limit exceeded' ifAbsent: 15.
- 	PrimErrObjectIsPinned	:= pet indexOf: #'object is pinned' ifAbsent: 16!



More information about the Vm-dev mailing list