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

commits at source.squeak.org commits at source.squeak.org
Tue Jul 1 02:24:29 UTC 2014


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

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

Name: VMMaker.oscog-eem.790
Author: eem
Time: 30 June 2014, 7:21:25.447 pm
UUID: 1c0587fb-44ad-43f6-8bfd-2a0f91e21a59
Ancestors: VMMaker.oscog-eem.789

Implement following forwarders on primitive failure in
machine code interpreter primitives (still have to implement
this for sideways calls of named primitives).

Allow the JIT to not compile primitiveDoNamedPrimitiveWithArgs
to avoid any potential complications.

Rewrite all the semaphore installing primitives to fail if the
semaphore arg is neither a semaphore or nil instead of
assuming if its not a semaphore it must be nil, so as to
fail and retry when semaphores are forwarded (as they are
when Semaphore is redefined).

Implement isSemaphoreOop:/Obj: in trhe object memories
to abstract away the code.  Base Spur's on the class index
of splObj: ClassSemaphore, avoiding the table lookup to
derive the class.  Make checkForEventsMayContextSwitch:
treat all its semaphores consistently.

Have spur's fetchClassOfNonImm: answer nilObj for
forwarders to avoid assert fails.

On Spur read barriers to primitiveSuspend and
synchronousSignal:'s myList access, because the process
list manipulation routines do no checking.
Add assert checks for forwarders in the process list
manipulation routines.

Abstract out the call machinery from compileTrampolineFor:-
numArgs:arg:arg:arg:arg:saveRegs:pushLinkReg:resultReg:
so it can be used by maybeCompileRetry:onPrimitiveFail:
in implementing following forwarders on primitive failure in
machine code, and the Open PIC miss call.

Have bytecodePCFor:cogMethod:startBcpc: map any pc
before the stackCheckOffset to the initialPC, which applies
to primitives in progress.

Nuke duplicated code in CoInterpreter class>>
initializeWithOptions:

Fix assert fails in updateStateOfSpouseContextForFrame:WithSP:
and elsewhere with forwarders.

Slang:
Add FooInterpreter class>>primitiveClass so that accessor
depths are checked for the right primitive implementation,
CoInterpreterPrimitives in CoInterpreter, etc, not just
InterpreterPrimitives.

LargeIntegers Plugin:
Fix a latent signed shift bug in cDigitSub:len:with:len:into:
caused by VMMaker.oscog-eem.785's eliminating the
divide-via-shift optimization.

Simulator:
Create the MessageSends for simulatedTrampolines in
simulatedTrampolineFor: and hence eliminate the hack setup
in generateTrampolines.

Add a print rump C stack entry to the Cog utilities menu.

All these changes allow Cog Spur to redefine Process and/or
Semaphore.

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

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.
+ 	PrimCallDoNotJIT := 32.
  
  	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 removed:
- ----- Method: CoInterpreter class>>initializeWithOptions: (in category 'initialization') -----
- initializeWithOptions: optionsDictionary
- 
- 	super initializeWithOptions: optionsDictionary.
- 	COGVM := true.
- 
- 	MinBackwardJumpCountForCompile := 10.
- 
- 	MaxNumArgs := 15.
- 	PrimCallNeedsNewMethod := 1.
- 	PrimCallNeedsPrimitiveFunction := 2.
- 	PrimCallMayCallBack := 4.
- 	PrimCallCollectsProfileSamples := 8.
- 
- 	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.
- 
- 	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 class>>primitivesClass (in category 'translation') -----
+ primitivesClass
+ 	^CoInterpreterPrimitives!

Item was added:
+ ----- Method: CoInterpreter>>accessorDepthForPrimitiveIndex: (in category 'cog jit support') -----
+ accessorDepthForPrimitiveIndex: primIndex
+ 	<api>
+ 	^primitiveAccessorDepthTable at: primIndex!

Item was changed:
  ----- Method: CoInterpreter>>bytecodePCFor:cogMethod:startBcpc: (in category 'frame access') -----
  bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc
  	"Answer the mapping of the native pc theIP to a zero-relative bytecode pc.
  	 See contextInstructionPointer:frame: for the explanation."
  	<var: #cogMethod type: #'CogMethod *'>
  	| cogMethodForIP mcpc |
  	<inline: true>
  	<var: #cogMethodForIP type: #'CogBlockMethod *'>
  	self assert: theIP < 0.
  	(theIP signedBitShift: -16) < -1 "See contextInstructionPointer:frame:"
  		ifTrue:
  			[cogMethodForIP := self cCoerceSimple: cogMethod asInteger - ((theIP signedBitShift: -16) * cogit blockAlignment)
  									to: #'CogBlockMethod *'.
  			 self assert: cogMethodForIP cmType = CMBlock.
  			 self assert: cogMethodForIP cmHomeMethod = cogMethod.
  			 mcpc := cogMethodForIP asInteger - theIP signedIntFromShort]
  		ifFalse:
  			[cogMethodForIP := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'.
  			 self assert: cogMethodForIP cmType = CMMethod.
+ 			 mcpc := cogMethod asInteger - theIP.
+ 			 "map any pcs in primitive code (i.e. return addresses for interpreter primitive calls) to the initial pc"
+ 			 mcpc asUnsignedInteger < cogMethod stackCheckOffset ifTrue:
+ 				[^startBcpc]].
- 			 mcpc := cogMethod asInteger - theIP].
  	self assert: (mcpc between: cogMethod asInteger and: cogMethod asInteger + cogMethod blockSize).
  	^cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP!

Item was added:
+ ----- Method: CoInterpreter>>ceCheckForAndFollowForwardedPrimitiveStateFor: (in category 'cog jit support') -----
+ ceCheckForAndFollowForwardedPrimitiveStateFor: primIndex
+ 	"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.  Answer if any are found so the prim can be retried."
+ 	<api>
+ 	<option: #SpurObjectMemory>
+ 	^self cCode: [self checkForAndFollowForwardedPrimitiveStateFor: primIndex]
+ 		inSmalltalk: [(self checkForAndFollowForwardedPrimitiveStateFor: primIndex)
+ 						ifTrue: [1]
+ 						ifFalse: [0]]!

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.
  
+ 	"The complications of following forwarding pointers in machine code on failures
+ 	 of primitives called indirectly through primitiveDoNamedPrimitiveWithArgs are not
+ 	 worth dealing with, as primitiveDoNamedPrimitiveWithArgs is used only in debugging."
+ 	(objectMemory hasSpurMemoryManagerAPI
+ 	 and: [functionPointer = #primitiveDoNamedPrimitiveWithArgs]) ifTrue:
+ 		[^PrimCallDoNotJIT].
+ 
  	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!

Item was changed:
  ----- Method: CoInterpreter>>synchronousSignal: (in category 'process primitive support') -----
  synchronousSignal: aSemaphore 
  	"Signal the given semaphore from within the interpreter.
  	 Answer if the current process was preempted.
  	 Override to add tracing info."
  	| excessSignals |
  	<inline: false>
  	(self isEmptyList: aSemaphore) ifTrue:
  		["no process is waiting on this semaphore"
  		 excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore.
  		 self storeInteger: ExcessSignalsIndex
  			ofObject: aSemaphore
  			withValue: excessSignals + 1.
  		 ^false].
+ 
+ 	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[| firstLink |
+ 		 firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aSemaphore.
+ 		 (objectMemory isForwarded: firstLink) ifTrue:
+ 			["0 = aSemaphore, 1 = aProcess. Hence reference to suspendedContext will /not/ be forwarded."
+ 			 objectMemory followForwardedObjectFields: aSemaphore toDepth: 1].
+ 		 self assert: (objectMemory isForwarded: (objectMemory fetchPointer: SuspendedContextIndex ofObject: firstLink)) not].
+ 
  	^self resume: (self removeFirstLinkOfList: aSemaphore)
  		preemptedYieldingIf: preemptionYields
  		from: CSSignal!

Item was changed:
  ----- Method: CoInterpreter>>updateStateOfSpouseContextForFrame:WithSP: (in category 'frame access') -----
  updateStateOfSpouseContextForFrame: theFP WithSP: theSP
  	"Update the frame's spouse context with the frame's current state except for the
  	 sender and instruction pointer, which are used to mark the context as married."
  	| theContext tempIndex pointer argsPointer |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #pointer type: #'char *'>
  	<var: #argsPointer type: #'char *'>
  	self assert: (self frameHasContext: theFP).
  	theContext := self frameContext: theFP.
  	self assert: (objectMemory isContext: theContext).
+ 	objectMemory hasSpurMemoryManagerAPI
+ 		ifTrue:
+ 			["We do not need to follow forwarding pointer to the receiver; makeBaseFrameFor: does that.
+ 			  In any case the assignments below updating the non-argument stack contents will do so."
+ 			self assert: ((self frameReceiver: theFP)
+ 						= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext)
+ 						or: [(objectMemory isOopForwarded: (objectMemory fetchPointer: ReceiverIndex ofObject: theContext))
+ 							and: [(objectMemory followForwarded: (objectMemory fetchPointer: ReceiverIndex ofObject: theContext))
+ 								= (self frameReceiver: theFP)]])]
+ 		ifFalse:
+ 			[self assert: (self frameReceiver: theFP)
+ 						= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext)].
- 	self assert: (self frameReceiver: theFP)
- 				= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext).
  	(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[tempIndex := self mframeNumArgs: theFP.
  			 pointer := theFP + FoxMFReceiver - BytesPerWord]
  		ifFalse:
  			[tempIndex := self iframeNumArgs: theFP.
  			 pointer := theFP + FoxIFReceiver - BytesPerWord].
  	"update the arguments. this would appear not to be strictly necessary, but is for two reasons.
  	 First, the fact that arguments are read-only is only as convention in the Smalltalk compiler;
  	 other languages may choose to modify arguments.
  	 Second, the Squeak runUntilErrorOrReturnFrom: nightmare pops the stack top, which may, in
  	 certain circumstances, be the last argument, and hence the last argument may not have been
  	 stored into the context."
  	argsPointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex).
  	1 to: tempIndex do:
  		[:i|
  		argsPointer := argsPointer - BytesPerWord.
  		self assert: (objectMemory addressCouldBeOop: (stackPages longAt: argsPointer)).
  		 objectMemory storePointer: ReceiverIndex + i
  			ofObject: theContext
  			withValue: (stackPages longAt: argsPointer)].
  	"now update the non-argument stack contents."
  	[pointer >= theSP] whileTrue:
  		[self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)).
  		 tempIndex := tempIndex + 1.
  		 objectMemory storePointer: ReceiverIndex + tempIndex
  			ofObject: theContext
  			withValue: (stackPages longAt: pointer).
  		 pointer := pointer - BytesPerWord].
  	self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: tempIndex)!

Item was changed:
  ----- Method: CoInterpreterMT>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
  checkForEventsMayContextSwitch: mayContextSwitch
  	"Check for possible interrupts and handle one if necessary.
  	 Answer if a context switch has occurred."
  	| switched sema now |
  	<inline: false>
  	<var: #now type: #usqLong>
  	self assertSaneThreadAndProcess.
  	cogit assertCStackWellAligned.
  	statCheckForEvents := statCheckForEvents + 1.
  
  	"restore the stackLimit if it has been smashed."
  	self restoreStackLimit.
  	self externalWriteBackHeadFramePointers.
  	self assert: stackPage = stackPages mostRecentlyUsedPage.
  
  	"Allow the platform to do anything it needs to do synchronously."
  	self ioSynchronousCheckForEvents.
  
  	self checkCogCompiledCodeCompactionCalledFor.
  
  	objectMemory needGCFlag ifTrue:
  		["sufficientSpaceAfterGC: runs the incremental GC and
  		 then, if not enough space is available, the fullGC."
  		 (objectMemory sufficientSpaceAfterGC: 0) ifFalse:
  			[self setSignalLowSpaceFlagAndSaveProcess]].
  
  	mayContextSwitch ifFalse: [^false].
  
  	switched := false.
  	self assert: deferThreadSwitch not.
  	deferThreadSwitch := true.
  
  	(profileProcess ~= objectMemory nilObject
  	 or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
+ 		[nextProfileTick := 0.
+ 		 "Take a sample (if not already done so) for the profiler if it is active.  This
- 		["Take a sample (if not already done so) for the profiler if it is active.  This
  		  must be done before any of the synchronousSignals below or else we will
  		  attribute a pause in ioRelinquishProcessor to the newly activated process."
+ 		 profileProcess = objectMemory nilObject ifTrue:
- 		profileProcess = objectMemory nilObject ifTrue:
  			[profileProcess := self activeProcess.
  			 profileMethod := objectMemory nilObject].
+ 		 "and signal the profiler semaphore if it is present"
+ 		 (profileSemaphore ~= objectMemory nilObject
+ 		  and: [self synchronousSignal: profileSemaphore]) ifTrue:
+ 			[switched := true]].
- 		"and signal the profiler semaphore if it is present"
- 		(profileSemaphore ~= objectMemory nilObject 
- 		 and: [self synchronousSignal: profileSemaphore]) ifTrue:
- 			[switched := true].
- 		nextProfileTick := 0].
  
  	self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
  		[switched := true].
  
  	objectMemory signalLowSpace ifTrue:
  		[objectMemory signalLowSpace: false. "reset flag"
  		 sema := objectMemory splObj: TheLowSpaceSemaphore.
+ 		 (sema ~= objectMemory nilObject
- 		 (sema ~= objectMemory nilObject 
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
  	 ioProcessEvents e.g. for native GUIs.  We would like to manage that here but can't
  	 since the platform code may choose to call ioProcessEvents itself in various places."
  	false
  		ifTrue:
  			[((now := self ioUTCMicroseconds) >= nextPollUsecs
  			 and: [inIOProcessEvents = 0]) ifTrue:
  				[statIOProcessEvents := statIOProcessEvents + 1.
  				 inIOProcessEvents := inIOProcessEvents + 1.
  				 self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
  				 inIOProcessEvents > 0 ifTrue:
  					[inIOProcessEvents := inIOProcessEvents - 1].
  				 nextPollUsecs := now + 20000
  				 "msecs to wait before next call to ioProcessEvents.  Note that strictly
  				  speaking we might need to update 'now' at this point since
  				  ioProcessEvents could take a very long time on some platforms"]]
  		ifFalse:
  			[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
  				[statIOProcessEvents := statIOProcessEvents + 1.
  				 self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
  				 nextPollUsecs := now + 20000
  				 "msecs to wait before next call to ioProcessEvents.  Note that strictly
  				  speaking we might need to update 'now' at this point since
  				  ioProcessEvents could take a very long time on some platforms"]].
  
  	interruptPending ifTrue:
  		[interruptPending := false.
  		 "reset interrupt flag"
  		 sema := objectMemory splObj: TheInterruptSemaphore.
+ 		 (sema ~= objectMemory nilObject
- 		 (sema ~= objectMemory nilObject 
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	nextWakeupUsecs ~= 0 ifTrue:
  		[now >= nextWakeupUsecs ifTrue:
  			[nextWakeupUsecs := 0.
  			 "set timer interrupt to 0 for 'no timer'"
  			 sema := objectMemory splObj: TheTimerSemaphore.
+ 			 (sema ~= objectMemory nilObject
- 			 (sema ~= objectMemory nilObject 
  			  and: [self synchronousSignal: sema]) ifTrue:
  				[switched := true]]].
  
  	"signal any pending finalizations"
  	pendingFinalizationSignals > 0 ifTrue:
+ 		[pendingFinalizationSignals := 0.
+ 		 sema := objectMemory splObj: TheFinalizationSemaphore.
+ 		 (sema ~= objectMemory nilObject
- 		[sema := objectMemory splObj: TheFinalizationSemaphore.
- 		 ((objectMemory isClassOfNonImm: sema equalTo: (objectMemory splObj: ClassSemaphore))
  		  and: [self synchronousSignal: sema]) ifTrue:
+ 			[switched := true]].
- 			[switched := true].
- 		pendingFinalizationSignals := 0].
  
  	"signal all semaphores in semaphoresToSignal"
  	self signalExternalSemaphores ifTrue:
  		[switched := true].
  
  	deferThreadSwitch := false.
  	checkThreadActivation ifTrue:
  		[checkThreadActivation := false.
  		 self cedeToHigherPriorityThreads]. "N.B.  This may not return if we do switch."
  
  	self threadSwitchIfNecessary: self activeProcess from: CSCheckEvents.
  	^switched!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveLongRunningPrimitiveSemaphore (in category 'process primitives') -----
  primitiveLongRunningPrimitiveSemaphore
  	"Primitive. Install the semaphore to be used for collecting long-running primitives, 
  	 or nil if no semaphore should be used."
  	| sema flushState activeContext |
  	<export: true>
+ 	self methodArgumentCount ~= 1 ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadNumArgs].
  	sema := self stackValue: 0.
- 	((objectMemory isIntegerObject: sema)
- 	or: [self methodArgumentCount ~= 1]) ifTrue:
- 		[^self primitiveFail].
  	sema = objectMemory nilObject
  		ifTrue:
  			[flushState := longRunningPrimitiveCheckSemaphore notNil.
  			 longRunningPrimitiveCheckSemaphore := nil]
  		ifFalse:
  			[flushState := longRunningPrimitiveCheckSemaphore isNil.
+ 			 (objectMemory isSemaphoreOop: sema) ifFalse:
+ 				[^self primitiveFailFor: PrimErrBadArgument].
- 			 (objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore) ifFalse:
- 				[^self primitiveFail].
  			 longRunningPrimitiveCheckSemaphore := sema].
  	"If we've switched checking on or off we must void machine code
  	 (and machine code pcs in contexts) since we will start or stop setting
  	 newMethod in machine code primitive invocations, and so generate
  	 slightly different code from here on in."
  	flushState ifTrue:
  		[self push: instructionPointer.
  		 activeContext := self voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
  		 self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
  		 self assert: (((self stackValue: 0) = objectMemory nilObject and: [longRunningPrimitiveCheckSemaphore isNil])
  				  or: [(self stackValue: 0) = longRunningPrimitiveCheckSemaphore
+ 					  and: [objectMemory isSemaphoreOop: sema]])].
- 					  and: [(objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore)]])].
  	self voidLongRunningPrimitive: 'install'.
  	self pop: 1.
  	flushState ifTrue:
  		[self siglong: reenterInterpreter jmp: ReturnToInterpreter]!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveProfileSemaphore (in category 'process primitives') -----
  primitiveProfileSemaphore
  	"Primitive. Install the semaphore to be used for profiling, 
  	or nil if no semaphore should be used.
  	See also primitiveProfileStart."
  	| sema flushState activeContext |
  	<export: true>
+ 	self methodArgumentCount ~= 1 ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadNumArgs].
  	sema := self stackValue: 0.
- 	((objectMemory isIntegerObject: sema)
- 	or: [self methodArgumentCount ~= 1]) ifTrue:
- 		[^self primitiveFail].
  	sema = objectMemory nilObject
  		ifTrue:
  			[flushState := profileSemaphore ~= objectMemory nilObject]
  		ifFalse:
  			[flushState := profileSemaphore = objectMemory nilObject.
+ 			 (objectMemory isSemaphoreOop: sema) ifFalse:
+ 				[^self primitiveFailFor: PrimErrBadArgument]].
- 			 (objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore) ifFalse:
- 				[^self primitiveFail]].
  	profileSemaphore := sema.
  	"If we've switched profiling on or off we must void machine code
  	 (and machine code pcs in contexts) since we will start or stop
  	 testing the profile clock in machine code primitive invocations,
  	 and so generate slightly different code from here on in."
  	flushState ifTrue:
  		[self push: instructionPointer.
  		 activeContext := self voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
  		 self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
  		 self assert: (((self stackValue: 0) = objectMemory nilObject and: [profileSemaphore = objectMemory nilObject])
  				  or: [(self stackValue: 0) = profileSemaphore
+ 					  and: [objectMemory isSemaphoreOop: sema]])].
- 					  and: [(objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore)]])].
  	profileProcess := profileMethod := objectMemory nilObject.
  	self pop: 1.
  	flushState ifTrue:
  		[self siglong: reenterInterpreter jmp: ReturnToInterpreter]!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
  primitiveSuspend
  	"Primitive. Suspend the receiver, aProcess such that it can be executed again
  	by sending #resume. If the given process is not currently running, take it off
  	its corresponding list. The primitive returns the list the receiver was previously on."
  	| process myList |
  	process := self stackTop.
  	process = self activeProcess ifTrue:
  		[| inInterpreter |
  		"We're going to switch process, either to an interpreted frame or a machine
  		 code frame. To know whether to return or enter machine code we have to
  		 know from whence we came.  We could have come from the interpreter,
  		 either directly or via a machine code primitive.  We could have come from
  		 machine code.  The instructionPointer tells us where from:"
  		self pop: 1 thenPush: objectMemory nilObject.
  		inInterpreter := instructionPointer >= objectMemory startOfMemory.
  		self transferTo: self wakeHighestPriority from: CSSuspend.
  		^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter].
  	myList := objectMemory fetchPointer: MyListIndex ofObject: process.
  	"XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
  	but we can't easily so just do a quick check for nil which is the most common case."
+ 	myList = objectMemory nilObject ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	"Alas in Spur we need a read barrier"
+ 	(objectMemory isForwarded: myList) ifTrue:
+ 		[myList := objectMemory followForwarded: myList.
+ 		 objectMemory storePointer: MyListIndex ofObject: process withValue: myList].
- 	myList = objectMemory nilObject ifTrue:[^self primitiveFail].
  	self removeProcess: process fromList: myList.
  	self successful ifTrue:
  		[objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
  		 self pop: 1 thenPush: myList]!

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

Item was changed:
  CogClass subclass: #CogObjectRepresentation
+ 	instanceVariableNames: 'cogit methodZone objectMemory coInterpreter ceStoreCheckTrampoline'
- 	instanceVariableNames: 'cogit methodZone objectMemory ceStoreCheckTrampoline'
  	classVariableNames: ''
  	poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  
  !CogObjectRepresentation commentStamp: '<historical>' prior: 0!
  I am an abstract superclass for object representations whose job it is to generate abstract instructions for accessing objects.  It is hoped that this level of indirection between the Cogit code generator and object access makes it easier to adapt the code generator to different garbage collectors, object representations and languages.!

Item was added:
+ ----- Method: CogObjectRepresentation>>maybeCompileRetry:onPrimitiveFail: (in category 'primitive generators') -----
+ maybeCompileRetry: retryInst onPrimitiveFail: primIndex
+ 	<var: #retry type: #'AbstractInstruction *'>
+ 	"Object representations with lazy forwarding will want to check for
+ 	 forwarding pointers on primitive failure and retry the primitive if found.
+ 	 By default do nothing."!

Item was changed:
  ----- Method: CogObjectRepresentation>>setCogit:methodZone: (in category 'initialization') -----
  setCogit: aCogit methodZone: aMethodZone
  	<doNotGenerate>
  	cogit := aCogit.
  	methodZone := aMethodZone.
+ 	coInterpreter := aCogit coInterpreter.
+ 	objectMemory := (coInterpreter isKindOf: StackInterpreter)
+ 						ifTrue: [coInterpreter objectMemory]
+ 						ifFalse: [coInterpreter]!
- 	objectMemory := (aCogit coInterpreter isKindOf: StackInterpreter)
- 						ifTrue: [aCogit coInterpreter objectMemory]
- 						ifFalse: [aCogit coInterpreter]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>maybeCompileRetry:onPrimitiveFail: (in category 'primitive generators') -----
+ maybeCompileRetry: retryInst onPrimitiveFail: primIndex
+ 	<var: #retry type: #'AbstractInstruction *'>
+ 	"If primIndex has an accessorDepth, check for primitive failure and call
+ 	 ceCheckForAndFollowForwardedPrimitiveStateFor:.  If ceCheck.... answers
+ 	 true, retry the primitive."
+ 	| accessorDepth jmp |
+ 	<var: #jmp type: #'AbstractInstruction *'>
+ 	accessorDepth := coInterpreter accessorDepthForPrimitiveIndex: primIndex.
+ 	accessorDepth < 0 ifTrue:
+ 		[^0].
+ 	cogit MoveAw: coInterpreter primFailCodeAddress R: TempReg.
+ 	cogit CmpCq: 0 R: TempReg.
+ 	jmp := cogit JumpZero: 0.
+ 	cogit
+ 		compileCallFor: #ceCheckForAndFollowForwardedPrimitiveStateFor:
+ 		numArgs: 1
+ 		arg: primIndex
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		resultReg: TempReg
+ 		saveRegs: false.
+ 	cogit CmpCq: 0 R: TempReg.
+ 	cogit JumpNonZero: retryInst.
+ 	jmp jmpTarget: cogit Label.
+ 	^0!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulationWindow;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
  											self writeBackHeadFramePointers];
  		addLine;
+ 		add: 'print rump C stack' action: [objectMemory printMemoryFrom: cogit processor sp to: self CStackPointer];
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:theCogit| false]'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

Item was changed:
  CogClass subclass: #Cogit
  	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent usesMethodClass primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss sendMissCall missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall interpretLabel endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
+ 	classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass ShouldNotJIT UnimplementedPrimitive YoungSelectorInPIC'
- 	classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass UnimplementedPrimitive YoungSelectorInPIC'
  	poolDictionaries: 'CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
  !Cogit commentStamp: 'eem 2/13/2013 15:37' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
  
  	StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
  
  I have concrete subclasses that implement different levels of optimization:
  	SimpleStackBasedCogit is the simplest code generator.
  
  	StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  	to the stack until necessary and implements a register-based calling convention for low-arity sends.
  
  	StackToRegisterMappingCogit is an experimental code generator with support for counting
  	conditional branches, intended to support adaptive optimization.
  
  coInterpreter <CoInterpreterSimulator>
  	the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  	the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  	the object used to generate object accesses
  processor <BochsIA32Alien|?>
  	the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  	flags controlling debug printing and code simulation
  breakPC <Integer>
  	machine code pc breakpoint
  cFramePointer cStackPointer <Integer>
  	the variables representing the C stack & frame pointers, which must change on FFI callback and return
  selectorOop <sqInt>
  	the oop of the methodObj being compiled
  methodObj <sqInt>
  	the bytecode method being compiled
  initialPC endPC <Integer>
  	the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  	argument count of current method or block being compiled
  needsFrame <Boolean>
  	whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  	primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  	label for the method header
  blockEntryLabel <CogAbstractOpcode>
  	label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  	label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  	label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  	offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  	label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  	offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  	label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
  	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixup shas one element per byte in methodObj's bytecode
  abstractOpcodes <Array of <AbstractOpcode>>
  	the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  	individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  	bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  	the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  	the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  	the starts of blocks in the current method
  blockCount
  	the index into blockStarts as they are being noted, and hence eventuakly teh total number of blocks in the current method
  labelCounter <Integer>
  	a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  	the various trampolines (system-call-like jumps from machine code to the run-time).
  	See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  	routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  	the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!

Item was changed:
  ----- Method: Cogit class>>initializeErrorCodes (in category 'class initialization') -----
  initializeErrorCodes
  	"External errors, returned to or from cog:selector:"
  	NotFullyInitialized := -1.
  	InsufficientCodeSpace := -2.
  	MethodTooBig := -4.
  	YoungSelectorInPIC := -5.
  	EncounteredUnknownBytecode := -6.
  	UnimplementedPrimitive := -7.
+ 	ShouldNotJIT := -8.
+ 	MaxNegativeErrorCode := ShouldNotJIT.
- 	MaxNegativeErrorCode := UnimplementedPrimitive.
  	"Internal errors returned by generator routines to other generator routines"
  	BadRegisterSet := 1!

Item was added:
+ ----- Method: Cogit>>compileCallFor:numArgs:arg:arg:arg:arg:resultReg:saveRegs: (in category 'initialization') -----
+ compileCallFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 resultReg: resultRegOrNil saveRegs: saveRegs
+ 	"Generate a call to aRoutine with up to 4 arguments.  If resultRegOrNil is
+ 	 non-zero assign the C result to resultRegOrNil.  If saveRegs, save all registers.
+ 	 Hack: a negative arg value indicates an abstract register, a non-negative value
+ 	 indicates a constant."
+ 	<var: #aRoutine type: #'void *'>
+ 	<inline: false>
+ 	cStackAlignment > BytesPerWord ifTrue:
+ 		[backEnd
+ 			genAlignCStackSavingRegisters: saveRegs
+ 			numArgs: numArgs
+ 			wordAlignment: cStackAlignment / BytesPerWord].
+ 	saveRegs ifTrue:
+ 		[backEnd genSaveRegisters].
+ 	numArgs > 0 ifTrue:
+ 		[numArgs > 1 ifTrue:
+ 			[numArgs > 2 ifTrue:
+ 				[numArgs > 3 ifTrue:
+ 					[regOrConst3 < 0
+ 						ifTrue: [backEnd genPassReg: regOrConst3 asArgument: 3]
+ 						ifFalse: [backEnd genPassConst: regOrConst3 asArgument: 3]].
+ 				 regOrConst2 < 0
+ 					ifTrue: [backEnd genPassReg: regOrConst2 asArgument: 2]
+ 					ifFalse: [backEnd genPassConst: regOrConst2 asArgument: 2]].
+ 			regOrConst1 < 0
+ 				ifTrue: [backEnd genPassReg: regOrConst1 asArgument: 1]
+ 				ifFalse: [backEnd genPassConst: regOrConst1 asArgument: 1]].
+ 		regOrConst0 < 0
+ 			ifTrue: [backEnd genPassReg: regOrConst0 asArgument: 0]
+ 			ifFalse: [backEnd genPassConst: regOrConst0 asArgument: 0]].
+ 	self CallRT: (self cCode: [aRoutine asUnsignedInteger]
+ 					   inSmalltalk: [self simulatedTrampolineFor: aRoutine]).
+ 	resultRegOrNil ifNotNil:
+ 		[backEnd genWriteCResultIntoReg: resultRegOrNil].
+ 	 saveRegs ifTrue:
+ 		[numArgs > 0 ifTrue:
+ 			[backEnd genRemoveNArgsFromStack: numArgs].
+ 		resultRegOrNil
+ 			ifNotNil: [backEnd genRestoreRegsExcept: resultRegOrNil]
+ 			ifNil: [backEnd genRestoreRegs]]!

Item was changed:
  ----- Method: Cogit>>compileTrampolineFor:numArgs:arg:arg:arg:arg:saveRegs:pushLinkReg:resultReg: (in category 'initialization') -----
  compileTrampolineFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNil
  	"Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutine
  	 as requested by callJumpBar.  If generating a call and resultRegOrNil is non-zero pass the C result
  	 back in resultRegOrNil.
  	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
  	<var: #aRoutine type: #'void *'>
  	<inline: false>
  	"If on a RISC processor, the return address needs to be pushed to the
  	 stack so that the interpreter sees the same stack layout as on CISC."
  	(pushLinkReg and: [backEnd hasLinkRegister]) ifTrue:
  		[self PushR: LinkReg].
  	self genSmalltalkToCStackSwitch.
+ 	self
+ 		compileCallFor: aRoutine
+ 		numArgs: numArgs
+ 		arg: regOrConst0
+ 		arg: regOrConst1
+ 		arg: regOrConst2
+ 		arg: regOrConst3
+ 		resultReg: resultRegOrNil
+ 		saveRegs: saveRegs.
- 	cStackAlignment > BytesPerWord ifTrue:
- 		[backEnd
- 			genAlignCStackSavingRegisters: saveRegs
- 			numArgs: numArgs
- 			wordAlignment: cStackAlignment / BytesPerWord].
- 	saveRegs ifTrue:
- 		[backEnd genSaveRegisters].
- 	numArgs > 0 ifTrue:
- 		[numArgs > 1 ifTrue:
- 			[numArgs > 2 ifTrue:
- 				[numArgs > 3 ifTrue:
- 					[regOrConst3 < 0
- 						ifTrue: [backEnd genPassReg: regOrConst3 asArgument: 3]
- 						ifFalse: [backEnd genPassConst: regOrConst3 asArgument: 3]].
- 				 regOrConst2 < 0
- 					ifTrue: [backEnd genPassReg: regOrConst2 asArgument: 2]
- 					ifFalse: [backEnd genPassConst: regOrConst2 asArgument: 2]].
- 			regOrConst1 < 0
- 				ifTrue: [backEnd genPassReg: regOrConst1 asArgument: 1]
- 				ifFalse: [backEnd genPassConst: regOrConst1 asArgument: 1]].
- 		regOrConst0 < 0
- 			ifTrue: [backEnd genPassReg: regOrConst0 asArgument: 0]
- 			ifFalse: [backEnd genPassConst: regOrConst0 asArgument: 0]].
- 	self Call: (self cCode: [aRoutine asUnsignedInteger]
- 					   inSmalltalk: [self simulatedTrampolineFor: aRoutine]).
- 	resultRegOrNil ifNotNil:
- 		[backEnd genWriteCResultIntoReg: resultRegOrNil].
- 	 saveRegs ifTrue:
- 		[numArgs > 0 ifTrue:
- 			[backEnd genRemoveNArgsFromStack: numArgs].
- 		resultRegOrNil
- 			ifNotNil: [backEnd genRestoreRegsExcept: resultRegOrNil]
- 			ifNil: [backEnd genRestoreRegs]].
  	backEnd genLoadStackPointers.
  	backEnd hasLinkRegister ifTrue:
  		[self PopR: LinkReg].
  	self RetN: 0!

Item was changed:
  ----- Method: Cogit>>generateTrampolines (in category 'initialization') -----
  generateTrampolines
  	"Generate the run-time entries and exits at the base of the native code zone and update the base.
  	 Read the class-side method trampolines for documentation on the various trampolines"
  	| methodZoneStart |
  	methodZoneStart := methodZoneBase.
  	self allocateOpcodes: 80 bytecodes: 0.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	hasYoungReferent := false.
  	self generateSendTrampolines.
  	self generateMissAbortTrampolines.
  	objectRepresentation generateObjectRepresentationTrampolines.
  	self generateRunTimeTrampolines.
  	self cppIf: NewspeakVM ifTrue: 	[self generateNewspeakRuntime].
  	self generateEnilopmarts.
  	self generateTracingTrampolines.
  
  	"finish up"
  	self recordGeneratedRunTime: 'methodZoneBase' address: methodZoneBase.
+ 	processor flushICacheFrom: methodZoneStart to: methodZoneBase!
- 	processor flushICacheFrom: methodZoneStart to: methodZoneBase.
- 	self cCode: ''
- 		inSmalltalk:
- 			[simulatedTrampolines keysAndValuesDo:
- 				[:addr :selector|
- 				simulatedTrampolines
- 					at: addr
- 					put: (MessageSend
- 							receiver: ((self respondsTo: selector)
- 										ifTrue: [self]
- 										ifFalse: [(coInterpreter respondsTo: selector)
- 													ifTrue: [coInterpreter]
- 													ifFalse: [(objectMemory respondsTo: selector)
- 														ifTrue: [objectMemory]
- 														ifFalse: [self notify: 'cannot find receiver for ', selector]]])
- 							selector: selector
- 							arguments: (1 to: selector numArgs) asArray)]]!

Item was changed:
  ----- Method: Cogit>>simulatedTrampolineFor: (in category 'initialization') -----
  simulatedTrampolineFor: selectorOrAddress
  	"Set a simulated trampoline.  This is a method in the cogit, coInterpreter
  	 or objectMemory that is called from a machine code trampoline."
  	<doNotGenerate>
  	| address |
  	selectorOrAddress isInteger ifTrue:
  		[self assert: (simulatedTrampolines includesKey: selectorOrAddress).
  		 ^selectorOrAddress].
  	self assert: selectorOrAddress isSymbol.
  	address := self simulatedAddressFor: selectorOrAddress.
+ 	simulatedTrampolines
+ 		at: address
+ 		ifAbsentPut:
+ 			[MessageSend
+ 				receiver: ((self respondsTo: selectorOrAddress)
+ 							ifTrue: [self]
+ 							ifFalse: [(coInterpreter respondsTo: selectorOrAddress)
+ 										ifTrue: [coInterpreter]
+ 										ifFalse: [(objectMemory respondsTo: selectorOrAddress)
+ 											ifTrue: [objectMemory]
+ 											ifFalse: [self notify: 'cannot find receiver for ', selectorOrAddress]]])
+ 				selector: selectorOrAddress
+ 				arguments: (1 to: selectorOrAddress numArgs) asArray].
- 	simulatedTrampolines at: address ifAbsentPut: [selectorOrAddress].
  	^address!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveInputSemaphore (in category 'I/O primitives') -----
  primitiveInputSemaphore
  	"Register the input semaphore. If the argument is not a 
  	Semaphore, unregister the current input semaphore."
  	| arg |
  	arg := self stackTop.
  	(objectMemory isIntegerObject: arg) ifTrue:
  		["If arg is integer, then use it as an index 
  		  into the external objects array and install it 
  		  as the new event semaphore"
  		 self ioSetInputSemaphore: (objectMemory integerValueOf: arg).
  		 self successful ifTrue:
  			[self pop: 1].
  		 ^nil].
  
  	"old code for compatibility"
  	TheInputSemaphore = nil ifTrue:
  		[^self primitiveFail].
+ 	(arg = objectMemory nilObject
+ 	 or: [objectMemory isSemaphoreOop: arg])
+ 		ifTrue:
+ 			[objectMemory splObj: TheInputSemaphore put: arg.
+ 			 self pop: 1]
+ 		ifFalse:
+ 			[self primitiveFailFor: PrimErrBadArgument]!
- 	arg := self popStack.
- 	(objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore) ifFalse:
- 		[arg := objectMemory nilObject].
- 	objectMemory splObj: TheInputSemaphore put: arg!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveInterruptSemaphore (in category 'I/O primitives') -----
  primitiveInterruptSemaphore
  	"Register the user interrupt semaphore. If the argument is 
  	not a Semaphore, unregister the current interrupt 
  	semaphore. "
  	| arg |
+ 	arg := self stackTop.
+ 	(arg = objectMemory nilObject
+ 	 or: [objectMemory isSemaphoreOop: arg])
+ 		ifTrue:
+ 			[objectMemory splObj: TheInterruptSemaphore put: arg.
+ 			 self pop: 1]
+ 		ifFalse:
+ 			[self primitiveFailFor: PrimErrBadArgument]!
- 	arg := self popStack.
- 	(objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore)
- 		ifTrue: [objectMemory splObj: TheInterruptSemaphore put: arg]
- 		ifFalse: [objectMemory splObj: TheInterruptSemaphore put: objectMemory nilObject]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveLowSpaceSemaphore (in category 'memory space primitives') -----
  primitiveLowSpaceSemaphore
  	"Register the low-space semaphore. If the argument is not a 
+ 	 Semaphore, unregister the current low-space Semaphore."
- 	Semaphore, unregister the current low-space Semaphore."
  	| arg |
+ 	arg := self stackTop.
+ 	(arg = objectMemory nilObject
+ 	 or: [objectMemory isSemaphoreOop: arg])
+ 		ifTrue:
+ 			[objectMemory splObj: TheLowSpaceSemaphore put: arg.
+ 			 self pop: 1]
+ 		ifFalse:
+ 			[self primitiveFailFor: PrimErrBadArgument]!
- 	arg := self popStack.
- 	(objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore)
- 		ifTrue: [objectMemory splObj: TheLowSpaceSemaphore put: arg]
- 		ifFalse: [objectMemory splObj: TheLowSpaceSemaphore put: objectMemory nilObject]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveProfileSemaphore (in category 'process primitives') -----
  primitiveProfileSemaphore
  	"Primitive. Install the semaphore to be used for profiling, 
  	or nil if no semaphore should be used.
  	See also primitiveProfileStart."
  	| sema |
  	<export: true>
+ 	self methodArgumentCount = 1 ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadNumArgs].
- 	self methodArgumentCount = 1 ifFalse:[^self success: false].
  	sema := self stackValue: 0.
+ 	(sema = objectMemory nilObject
+ 	 or: [objectMemory isSemaphoreOop: sema]) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
- 	sema = objectMemory nilObject ifFalse:[
- 		(objectMemory fetchClassOf: sema) = (objectMemory splObj: ClassSemaphore) 
- 			ifFalse:[^self success: false]].
  	profileSemaphore := sema.
  	profileProcess := profileMethod := objectMemory nilObject.
+ 	self pop: 1!
- 	self pop: 1.!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
  primitiveSuspend
  	"Primitive. Suspend the receiver, aProcess such that it can be executed again
  	by sending #resume. If the given process is not currently running, take it off
  	its corresponding list. The primitive returns the list the receiver was previously on."
  	| process myList |
  	process := self stackTop.
+ 	process = self activeProcess ifTrue:
+ 		[self pop: 1 thenPush: objectMemory nilObject.
+ 		 ^self transferTo: self wakeHighestPriority].
+ 	myList := objectMemory fetchPointer: MyListIndex ofObject: process.
+ 	"XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
+ 	but we can't easily so just do a quick check for nil which is the most common case."
+ 	myList = objectMemory nilObject ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	"Alas in Spur we need a read barrier"
+ 	(objectMemory isForwarded: myList) ifTrue:
+ 		[myList := objectMemory followForwarded: myList.
+ 		 objectMemory storePointer: MyListIndex ofObject: process withValue: myList].
+ 	self removeProcess: process fromList: myList.
+ 	self successful ifTrue:
+ 		[objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
+ 		 self pop: 1 thenPush: myList]!
- 	process = self activeProcess ifTrue:[
- 		self pop: 1 thenPush: objectMemory nilObject.
- 		self transferTo: self wakeHighestPriority.
- 	] ifFalse:[
- 		myList := objectMemory fetchPointer: MyListIndex ofObject: process.
- 		"XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
- 		but we can't easily so just do a quick check for nil which is the most common case."
- 		myList = objectMemory nilObject ifTrue:[^self primitiveFail].
- 		self removeProcess: process fromList: myList.
- 		self successful ifTrue:[
- 			objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
- 			self pop: 1 thenPush: myList.
- 		].
- 	]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>cDigitSub:len:with:len:into: (in category 'C core') -----
+ cDigitSub: pByteSmall len: smallLen with: pByteLarge len: largeLen into: pByteRes
+ 	| z |
- cDigitSub: pByteSmall
- 		len: smallLen
- 		with: pByteLarge
- 		len: largeLen
- 		into: pByteRes
- 	| z limit |
  	<var: #pByteSmall type: 'unsigned char * '>
  	<var: #pByteLarge type: 'unsigned char * '>
  	<var: #pByteRes type: 'unsigned char * '>
  
+ 	z := 0. "Loop invariant is -1<=z<=1"
+ 	0 to: smallLen - 1 do: 
- 	z := 0.
- 	"Loop invariant is -1<=z<=1"
- 	limit := smallLen - 1.
- 	0 to: limit do: 
  		[:i | 
  		z := z + (pByteLarge at: i) - (pByteSmall at: i).
+ 		pByteRes at: i put: z - (z // 256 * 256). "sign-tolerant form of (z bitAnd: 255)"
+ 		z := z signedBitShift: -8].
+ 	smallLen to: largeLen - 1 do: 
- 		pByteRes at: i put: z - (z // 256 * 256).
- 		"sign-tolerant form of (z bitAnd: 255)"
- 		z := z // 256].
- 	limit := largeLen - 1.
- 	smallLen to: limit do: 
  		[:i | 
  		z := z + (pByteLarge at: i) .
+ 		pByteRes at: i put: z - (z // 256 * 256). "sign-tolerant form of (z bitAnd: 255)"
+ 		z := z signedBitShift: -8].
- 		pByteRes at: i put: z - (z // 256 * 256).
- 		"sign-tolerant form of (z bitAnd: 255)"
- 		z := z // 256].
  !

Item was added:
+ ----- Method: ObjectMemory>>isSemaphoreObj: (in category 'interpreter access') -----
+ isSemaphoreObj: anObj
+ 	^(self fetchClassOfNonImm: anObj) = (self splObj: ClassSemaphore)!

Item was added:
+ ----- Method: ObjectMemory>>isSemaphoreOop: (in category 'interpreter access') -----
+ isSemaphoreOop: anOop
+ 	^(self isNonImmediate: anOop)
+ 	 and: [self isSemaphoreObj: anOop]!

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 retry continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
- 	| flags jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
  	<var: #jmp type: #'AbstractInstruction *'>
+ 	<var: #retry 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 anyMask: PrimCallDoNotJIT) ifTrue:
+ 		[^ShouldNotJIT].
+  
+ 	(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
- 	(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].
  
+ 	"Old full prim trace is in VMMaker-eem.550 and prior"
+ 	self recordPrimTrace ifTrue:
+ 		[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
+ 
  	"Clear the primFailCode and set argumentCount"
+ 	retry := self MoveCq: 0 R: TempReg.
- 	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.
+ 
+ 	"If required, set primitiveFunctionPointer and newMethod"
+ 	(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
- 	(flags bitAnd: PrimCallNeedsPrimitiveFunction) ~= 0 ifTrue:
  		[self MoveCw: primitiveRoutine asInteger R: TempReg.
  		 self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
+ 	(flags anyMask: PrimCallNeedsNewMethod+PrimCallMayCallBack) ifTrue:
- 	"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 anyMask: PrimCallMayCallBack) ifTrue:
- 		 (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].
+ 
+ 	"Invoke the primitive"
  	self PrefetchAw: coInterpreter primFailCodeAddress.
+ 	(flags anyMask: PrimCallMayCallBack)
- 	(flags bitAnd: PrimCallMayCallBack) ~= 0
  		ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
  			[backEnd genSubstituteReturnAddress:
+ 				((flags anyMask: PrimCallCollectsProfileSamples)
- 				((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 anyMask: PrimCallCollectsProfileSamples) ifTrue:
+ 				[self assert: (flags anyMask: PrimCallNeedsNewMethod).
- 			(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].
+ 			objectRepresentation maybeCompileRetry: retry onPrimitiveFail: primitiveIndex.
  			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 or load it into the LinkRegister to reestablish the return pc"
  			self MoveAw: coInterpreter instructionPointerAddress
  				R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  			backEnd genLoadStackPointers.
  			"Test primitive failure"
  			self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  			backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs"
  			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 anyMask: PrimCallCollectsProfileSamples) ifTrue:
- 	(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 anyMask: PrimCallNeedsNewMethod).
+ 			self CallRT: (self cCode: [#ceCheckProfileTick asUnsignedLong]
- 			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: [#ceCheckProfileTick asUnsignedLong]
- 		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.  If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
  		 self MoveMw: BytesPerWord * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
  			r: SPReg
  			R: ReceiverResultReg].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails."
+ 	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
- 	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod routine |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self compilePICProlog: numArgs.
  	self cppIf: NewspeakVM ifTrue:
  		[self Nop. "1st nop differentiates dynSuperEntry from no-check entry if using nextMethod"
  		 dynSuperEntry := self Nop].
  	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  	self MoveR: ClassReg R: SendNumArgsReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: ShiftForWord R: ClassReg.
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	itsAHit := self Label.
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << ShiftForWord)
  		r: ClassReg
  		R: SendNumArgsReg.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
  	objectRepresentation
  		genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
  	jumpBCMethod jmpTarget: interpretLabel.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg.
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	ShiftForWord > 2 ifTrue:
  		[self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg].
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromInLineCacheMiss: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	self genSaveStackPointers.
  	self genLoadCStackPointers.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
+ 	self 
+ 		compileCallFor: #ceSendFromInLineCacheMiss:
+ 		numArgs: 1
+ 		arg: SendNumArgsReg
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		resultReg: nil
+ 		saveRegs: false
- 	cStackAlignment > BytesPerWord ifTrue:
- 		[backEnd
- 			genAlignCStackSavingRegisters: false
- 			numArgs: 1
- 			wordAlignment: cStackAlignment / BytesPerWord].
- 	backEnd genPassReg: SendNumArgsReg asArgument: 0.
- 	routine := self cCode: '(sqInt)ceSendFromInLineCacheMiss'
- 					inSmalltalk: [self simulatedAddressFor: #ceSendFromInLineCacheMiss:].
- 	self annotateCall: (self Call: routine)
  	"Note that this call does not return."!

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.
+ 	self 
+ 		compileCallFor: #ceActivateFailingPrimitiveMethod:
+ 		numArgs: 1
+ 		arg: SendNumArgsReg
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		resultReg: nil
+ 		saveRegs: false.
- 	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 changed:
  ----- Method: SimpleStackBasedCogit>>generateMissAbortTrampolines (in category 'initialization') -----
  generateMissAbortTrampolines
  	"Generate the run-time entries for the various method and PIC entry misses and aborts..
  	 Read the class-side method trampolines for documentation on the various trampolines"
  
  	ceMethodAbortTrampoline := self genMethodAbortTrampoline.
  	cePICAbortTrampoline := self genPICAbortTrampoline.
  	ceCPICMissTrampoline := self genTrampolineFor: #ceCPICMiss:receiver:
  								called: 'ceCPICMissTrampoline'
  								arg: ClassReg
+ 								arg: ReceiverResultReg!
- 								arg: ReceiverResultReg.
- 	self cCode: '' inSmalltalk:
- 		[simulatedTrampolines
- 			at: (self simulatedAddressFor: #ceSendFromInLineCacheMiss:)
- 			put: #ceSendFromInLineCacheMiss:]!

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
  	 or: [aClass ~~ (self classOrNilAtIndex: classIndex)]) ifTrue:
  		[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 ^freeChunk].
  	MarkObjectsForEnumerationPrimitives ifTrue:
  		[self markObjects]. "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].
  					 (self classIndexOf: obj) = classIndex ifTrue:
  					 	[count := count + 1.
  						 ptr < limit ifTrue:
  							[self longAt: ptr put: obj.
  							 ptr := ptr + self bytesPerSlot]]]
  				ifFalse:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self assert: self allObjectsUnmarked.
  	self assert: (self isEmptyObjStack: markStack).
  	self emptyObjStack: weaklingStack.
  	(count > (ptr - start / self bytesPerSlot) "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 storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofObject: freeChunk)].
  		 self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  		 self beRootIfOld: smallObj.
  		 self checkFreeSpace.
  		 ^smallObj].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self setOverflowNumSlotsOf: freeChunk to: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace.
  	self runLeakCheckerForFullGC: false.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>fetchClassOfNonImm: (in category 'object access') -----
  fetchClassOfNonImm: objOop
  	| classIndex |
  	classIndex := self classIndexOf: objOop.
+ 	classIndex <= self classIsItselfClassIndexPun ifTrue:
+ 		[classIndex = self classIsItselfClassIndexPun ifTrue:
+ 			[^objOop].
+ 		 "Answer nil to avoid the assert failure in classOrNilAtIndex:"
+ 		 classIndex = self isForwardedObjectClassIndexPun ifTrue:
+ 			[^nilObj]].
- 	classIndex = self classIsItselfClassIndexPun ifTrue:
- 		[^objOop].
  	self assert: classIndex >= self arrayClassIndexPun.
  	^self classOrNilAtIndex: classIndex!

Item was changed:
  ----- Method: SpurMemoryManager>>followSpecialObjectsOop (in category 'become implementation') -----
  followSpecialObjectsOop
  	(self isForwarded: specialObjectsOop) ifTrue:
+ 		[specialObjectsOop := self followForwarded: specialObjectsOop].
+ 	self followForwardedObjectFields: specialObjectsOop toDepth: 0.!
- 		[specialObjectsOop := self followForwarded: specialObjectsOop]!

Item was added:
+ ----- Method: SpurMemoryManager>>isSemaphoreObj: (in category 'object testing') -----
+ isSemaphoreObj: anObj
+ 	^(self classIndexOf: anObj) = (self rawHashBitsOf: (self splObj: ClassSemaphore))!

Item was added:
+ ----- Method: SpurMemoryManager>>isSemaphoreOop: (in category 'object testing') -----
+ isSemaphoreOop: anOop
+ 	^(self isNonImmediate: anOop)
+ 	 and: [self isSemaphoreObj: anOop]!

Item was changed:
  ----- Method: StackInterpreter class>>primitiveAccessorDepthTable (in category 'constants') -----
  primitiveAccessorDepthTable
  	| cg |
  	cg := CCodeGenerator new.
  	cg vmClass: StackInterpreter.
  	^PrimitiveTable collect:
  		[:thing| |class  method |
  		(thing isInteger "quick prims, 0 for fast primitve fail"
  		 or: [thing == #primitiveFail
+ 		 or: [(class := self primitivesClass whichClassIncludesSelector: thing) isNil]])
- 		 or: [(class := self whichClassIncludesSelector: thing) isNil]])
  			ifTrue: [-1]
  			ifFalse:
  				[method := (class >> thing) methodNode asTranslationMethodOfClass: TMethod.
  				 cg accessorDepthForMethod: method]]!

Item was added:
+ ----- Method: StackInterpreter class>>primitivesClass (in category 'translation') -----
+ primitivesClass
+ 	^StackInterpreterPrimitives!

Item was changed:
  ----- Method: StackInterpreter>>addFirstLink:toList: (in category 'process primitive support') -----
  addFirstLink: proc toList: aList 
  	"Add the given process to the front of the given linked list
  	 and set the backpointer of process to its new list."
  	| firstLink |
+ 	self assert: (objectMemory isForwarded: aList) not.
  	self assert: (objectMemory fetchPointer: NextLinkIndex ofObject: proc) = objectMemory nilObject.
  	firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
  	self assert: firstLink ~= proc.
  	objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: proc.
  	firstLink = objectMemory nilObject "a.k.a. (self isEmptyList: aList)"
  		ifTrue: [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: proc]
  		ifFalse: [objectMemory storePointer: NextLinkIndex ofObject: proc withValue: firstLink].
  	objectMemory storePointer: MyListIndex ofObject: proc withValue: aList!

Item was changed:
  ----- Method: StackInterpreter>>addLastLink:toList: (in category 'process primitive support') -----
  addLastLink: proc toList: aList 
  	"Add the given process to the end of the given linked list
  	 and set the backpointer of process to its new list."
  	| lastLink |
+ 	self assert: (objectMemory isForwarded: aList) not.
  	self assert: (objectMemory fetchPointer: NextLinkIndex ofObject: proc) = objectMemory nilObject.
  	(self isEmptyList: aList)
  		ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: proc]
  		ifFalse:
  			[lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
  			 self assert: lastLink ~= proc.
  			 objectMemory storePointer: NextLinkIndex ofObject: lastLink withValue: proc].
  	objectMemory storePointer: LastLinkIndex ofObject: aList withValue: proc.
  	objectMemory storePointer: MyListIndex ofObject: proc withValue: aList!

Item was changed:
  ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
  checkForAndFollowForwardedPrimitiveState
  	"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.  Answer if any are found so the prim can be retried."
  	<option: #SpurObjectMemory>
+ 	^self checkForAndFollowForwardedPrimitiveStateFor: (self primitiveIndexOf: newMethod)!
- 	| primIndex accessorDepth found |
- 	self assert: self successful not.
- 	found := false.
- 	primIndex := self primitiveIndexOf: newMethod.
- 	accessorDepth := primitiveAccessorDepthTable at: primIndex.
- 	"For the method-executing primitives, failure could have been in those primitives or the
- 	 primitives of the methods they execute.  find out which failed by seeing what is in effect."
- 	primIndex caseOf: {
- 		[117] -> 
- 			[primitiveFunctionPointer ~~ #primitiveExternalCall ifTrue:
- 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
- 			 self assert: argumentCount = (self argumentCountOf: newMethod)].
- 		[118] -> "with tryPrimitive:withArgs: the argument count has nothing to do with newMethod's, so no arg count assert."
- 			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
- 		[218] ->
- 			[primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs ifTrue:
- 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
- 			 self assert: argumentCount = (self argumentCountOf: newMethod)]. }
- 		otherwise:
- 			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject).
- 			 self assert: argumentCount = (self argumentCountOf: newMethod)].
- 	accessorDepth >= 0 ifTrue:
- 		[0 to: argumentCount do:
- 			[:index| | oop |
- 			oop := self stackValue: index.
- 			(objectMemory isNonImmediate: oop) ifTrue:
- 				[(objectMemory isForwarded: oop) ifTrue:
- 					[self assert: index < argumentCount. "receiver should have been caught at send time."
- 					 found := true.
- 					 oop := objectMemory followForwarded: oop.
- 					 self stackValue: index put: oop].
- 				((objectMemory hasPointerFields: oop)
- 				 and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
- 					[found := true]]]].
- 	^found!

Item was added:
+ ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveStateFor: (in category 'primitive support') -----
+ checkForAndFollowForwardedPrimitiveStateFor: primIndex
+ 	"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.  Answer if any are found so the prim can be retried."
+ 	<option: #SpurObjectMemory>
+ 	| accessorDepth found |
+ 	self assert: self successful not.
+ 	found := false.
+ 	accessorDepth := primitiveAccessorDepthTable at: primIndex.
+ 	"For the method-executing primitives, failure could have been in those primitives or the
+ 	 primitives of the methods they execute.  find out which failed by seeing what is in effect."
+ 	primIndex caseOf: {
+ 		[117] -> 
+ 			[primitiveFunctionPointer ~~ #primitiveExternalCall ifTrue:
+ 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
+ 			 self assert: argumentCount = (self argumentCountOf: newMethod)].
+ 		[118] -> "with tryPrimitive:withArgs: the argument count has nothing to do with newMethod's, so no arg count assert."
+ 			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
+ 		[218] ->
+ 			[primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs ifTrue:
+ 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
+ 			 self assert: argumentCount = (self argumentCountOf: newMethod)]. }
+ 		otherwise:
+ 			["functionPointer should have been set, unless we're in machine code"
+ 			 instructionPointer > objectMemory nilObject ifTrue:
+ 				[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject).
+ 				 self assert: argumentCount = (self argumentCountOf: newMethod)]].
+ 	accessorDepth >= 0 ifTrue:
+ 		[0 to: argumentCount do:
+ 			[:index| | oop |
+ 			oop := self stackValue: index.
+ 			(objectMemory isNonImmediate: oop) ifTrue:
+ 				[(objectMemory isForwarded: oop) ifTrue:
+ 					[self assert: index < argumentCount. "receiver should have been caught at send time."
+ 					 found := true.
+ 					 oop := objectMemory followForwarded: oop.
+ 					 self stackValue: index put: oop].
+ 				((objectMemory hasPointerFields: oop)
+ 				 and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
+ 					[found := true]]]].
+ 	^found!

Item was changed:
  ----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
  checkForEventsMayContextSwitch: mayContextSwitch
  	"Check for possible interrupts and handle one if necessary.
  	 Answer if a context switch has occurred."
  	| switched sema now |
  	<inline: false>
  	<var: #now type: #usqLong>
  	statCheckForEvents := statCheckForEvents + 1.
  
  	"restore the stackLimit if it has been smashed."
  	self restoreStackLimit.
  	self externalWriteBackHeadFramePointers.
  	self assert: stackPage = stackPages mostRecentlyUsedPage.
  
  	"Allow the platform to do anything it needs to do synchronously."
  	self ioSynchronousCheckForEvents.
  
  	self checkCogCompiledCodeCompactionCalledFor.
  
  	objectMemory needGCFlag ifTrue:
  		["sufficientSpaceAfterGC: runs the incremental GC and
  		 then, if not enough space is available, the fullGC."
  		 (objectMemory sufficientSpaceAfterGC: 0) ifFalse:
  			[self setSignalLowSpaceFlagAndSaveProcess]].
  
  	mayContextSwitch ifFalse: [^false].
  
  	switched := false.
  
  	(profileProcess ~= objectMemory nilObject
  	 or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
+ 		[nextProfileTick := 0.
+ 		 "Take a sample (if not already done so) for the profiler if it is active.  This
- 		["Take a sample (if not already done so) for the profiler if it is active.  This
  		  must be done before any of the synchronousSignals below or else we will
  		  attribute a pause in ioRelinquishProcessor to the newly activated process."
+ 		 profileProcess = objectMemory nilObject ifTrue:
- 		profileProcess = objectMemory nilObject ifTrue:
  			[profileProcess := self activeProcess.
  			 profileMethod := objectMemory nilObject].
+ 		 "and signal the profiler semaphore if it is present"
+ 		 (profileSemaphore ~= objectMemory nilObject
+ 		  and: [self synchronousSignal: profileSemaphore]) ifTrue:
+ 			[switched := true]].
- 		"and signal the profiler semaphore if it is present"
- 		(profileSemaphore ~= objectMemory nilObject 
- 		 and: [self synchronousSignal: profileSemaphore]) ifTrue:
- 			[switched := true].
- 		nextProfileTick := 0].
  
  	self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
  		[switched := true].
  
  	objectMemory signalLowSpace ifTrue:
  		[objectMemory signalLowSpace: false. "reset flag"
  		 sema := objectMemory splObj: TheLowSpaceSemaphore.
+ 		 (sema ~= objectMemory nilObject
- 		 (sema ~= objectMemory nilObject 
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
  	 ioProcessEvents e.g. for native GUIs.  We would like to manage that here but can't
  	 since the platform code may choose to call ioProcessEvents itself in various places."
  	false
  		ifTrue:
  			[((now := self ioUTCMicroseconds) >= nextPollUsecs
  			 and: [inIOProcessEvents = 0]) ifTrue:
  				[statIOProcessEvents := statIOProcessEvents + 1.
  				 inIOProcessEvents := inIOProcessEvents + 1.
  				 self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
  				 inIOProcessEvents > 0 ifTrue:
  					[inIOProcessEvents := inIOProcessEvents - 1].
  				 nextPollUsecs := now + 20000
  				 "msecs to wait before next call to ioProcessEvents.  Note that strictly
  				  speaking we might need to update 'now' at this point since
  				  ioProcessEvents could take a very long time on some platforms"]]
  		ifFalse:
  			[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
  				[statIOProcessEvents := statIOProcessEvents + 1.
  				 self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
  				 nextPollUsecs := now + 20000
  				 "msecs to wait before next call to ioProcessEvents.  Note that strictly
  				  speaking we might need to update 'now' at this point since
  				  ioProcessEvents could take a very long time on some platforms"]].
  
  	interruptPending ifTrue:
  		[interruptPending := false.
  		 "reset interrupt flag"
  		 sema := objectMemory splObj: TheInterruptSemaphore.
+ 		 (sema ~= objectMemory nilObject
- 		 (sema ~= objectMemory nilObject 
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	nextWakeupUsecs ~= 0 ifTrue:
  		[now >= nextWakeupUsecs ifTrue:
  			[nextWakeupUsecs := 0.
  			 "set timer interrupt to 0 for 'no timer'"
  			 sema := objectMemory splObj: TheTimerSemaphore.
+ 			 (sema ~= objectMemory nilObject
- 			 (sema ~= objectMemory nilObject 
  			  and: [self synchronousSignal: sema]) ifTrue:
  				[switched := true]]].
  
  	"signal any pending finalizations"
  	pendingFinalizationSignals > 0 ifTrue:
+ 		[pendingFinalizationSignals := 0.
+ 		 sema := objectMemory splObj: TheFinalizationSemaphore.
+ 		 (sema ~= objectMemory nilObject
- 		[sema := objectMemory splObj: TheFinalizationSemaphore.
- 		 ((objectMemory isClassOfNonImm: sema equalTo: (objectMemory splObj: ClassSemaphore))
  		  and: [self synchronousSignal: sema]) ifTrue:
+ 			[switched := true]].
- 			[switched := true].
- 		pendingFinalizationSignals := 0].
  
  	"signal all semaphores in semaphoresToSignal"
  	self signalExternalSemaphores ifTrue:
  		[switched := true].
  
  	^switched!

Item was changed:
  ----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
  codeGeneratorToComputeAccessorDepth
  	^VMMaker new
+ 		buildCodeGeneratorForInterpreter: self primitivesClass
- 		buildCodeGeneratorForInterpreter: StackInterpreterPrimitives
  		includeAPIMethods: false
  		initializeClasses: false!

Item was changed:
  ----- Method: StackInterpreter>>doSignalSemaphoreWithIndex: (in category 'process primitive support') -----
  doSignalSemaphoreWithIndex: index
  	"Signal the external semaphore with the given index.  Answer if a context switch
  	 occurs as a result.  Do not bounds check.  This has been done in the caller."
  	<api>
+ 	| xArray sema |
- 	| xArray semaphoreClass sema |
  	xArray := objectMemory splObj: ExternalObjectsArray.
- 	semaphoreClass := objectMemory splObj: ClassSemaphore.
  	sema := objectMemory fetchPointer: index - 1 ofObject: xArray. "Note: semaphore indices are 1-based"
+ 	self assert: (objectMemory isOopForwarded: sema) not.
+ 	^(objectMemory isSemaphoreOop: sema)
+ 	  and: [self synchronousSignal: sema]!
- 	^(objectMemory isNonIntegerObject: sema)
- 	   and: [(objectMemory fetchClassOfNonImm: sema) = semaphoreClass
- 	   and: [self synchronousSignal: sema]]!

Item was added:
+ ----- Method: StackInterpreter>>followForwardingPointersInProfileState (in category 'object memory support') -----
+ followForwardingPointersInProfileState
+ 	(objectMemory isForwarded: profileProcess) ifTrue:
+ 		[profileProcess := objectMemory followForwarded: profileProcess].
+ 	(objectMemory isForwarded: profileMethod) ifTrue:
+ 		[profileMethod := objectMemory followForwarded: profileMethod].
+ 	(objectMemory isForwarded: profileProcess) ifTrue:
+ 		[profileSemaphore := objectMemory followForwarded: profileSemaphore].!

Item was added:
+ ----- Method: StackInterpreter>>followForwardingPointersInSpecialObjectsArray (in category 'object memory support') -----
+ followForwardingPointersInSpecialObjectsArray
+ 	"Various semaphores in the specialObjectsArray are signalled in checkForEventsMayContextSwitch:.
+ 	 These must be followed post become to avoid a read barrier in checkForEventsMayContextSwitch:,
+ 	 or worse still in synchronousSignal."
+ 	| xArray |
+ 	self followSemaphoreIn: objectMemory specialObjectsOop
+ 		at: TheLowSpaceSemaphore.
+ 	self followSemaphoreIn: objectMemory specialObjectsOop
+ 		at: TheInterruptSemaphore.
+ 	self followSemaphoreIn: objectMemory specialObjectsOop
+ 		at: TheTimerSemaphore.
+ 	self followSemaphoreIn: objectMemory specialObjectsOop
+ 		at: TheFinalizationSemaphore.
+ 	xArray := objectMemory splObj: ExternalObjectsArray.
+ 	(objectMemory isForwarded: xArray) ifTrue:
+ 		[xArray := objectMemory followForwarded: xArray.
+ 		 objectMemory splObj: ExternalObjectsArray put: xArray].
+ 	0 to: (objectMemory numSlotsOf: xArray) - 1 do:
+ 		[:i|
+ 		self followSemaphoreIn: xArray at: i]!

Item was added:
+ ----- Method: StackInterpreter>>followSemaphoreIn:at: (in category 'object memory support') -----
+ followSemaphoreIn: anArray at: index
+ 	"Only follow the reference to the semaphore.  synchronousSignal
+ 	 checks the chain to the suspendedContext."
+ 	 
+ 	| obj |
+ 	obj := objectMemory fetchPointer: index ofObject: anArray.
+ 	(objectMemory isForwarded: obj) ifTrue:
+ 		[obj := objectMemory followForwarded: obj.
+ 		 objectMemory storePointer: index ofObject: anArray withValue: obj]!

Item was changed:
  ----- Method: StackInterpreter>>isEmptyList: (in category 'process primitive support') -----
  isEmptyList: aLinkedList
+ 	self assert: (objectMemory isForwarded: aLinkedList) not.
- 
  	^ (objectMemory fetchPointer: FirstLinkIndex ofObject: aLinkedList) = objectMemory nilObject!

Item was changed:
  ----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') -----
  postBecomeAction: theBecomeEffectsFlags
  	"Insulate the stack zone from the effects of a become.
  	 All receivers must be unfollowed for two reasons:
  		1. inst var access is direct with no read barrier
  		2. super sends (always to the receiver) have no class check and so don't trap
  		   for forwarded receivers.
  	 Methods must be unfollowed since bytecode access is direct with no read barrier.
  	 But this only needs to be done if the becomeEffectsFlags indicate that a
  	 CompiledMethod was becommed.
  	 The sceduler state must be followed, but only if the becomeEffectsFlags indicate
  	 that a pointer object was becommed."
  	self followForwardingPointersInStackZone: theBecomeEffectsFlags.
  	theBecomeEffectsFlags ~= 0 ifTrue:
  		[(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  			[self followForwardedMethodsInMethodCache.
  			 self followForwardedMethodsInMethodZone]. "for CoInterpreter"
+ 		 self followForwardingPointersInScheduler.
+ 		 self followForwardingPointersInSpecialObjectsArray.
+ 		 self followForwardingPointersInProfileState]!
- 		 self followForwardingPointersInScheduler]!

Item was changed:
  ----- Method: StackInterpreter>>removeFirstLinkOfList: (in category 'process primitive support') -----
  removeFirstLinkOfList: aList 
  	"Remove the first process from the given linked list."
  	| first last next |
+ 	self assert: (objectMemory isForwarded: aList) not.
  	first := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
  	last := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
  	first = last
  		ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: objectMemory nilObject.
  			objectMemory storePointer: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]
  		ifFalse: [next := objectMemory fetchPointer: NextLinkIndex ofObject: first.
  			objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: next].
  	objectMemory storePointer: NextLinkIndex ofObject: first withValue: objectMemory nilObject.
  	^ first!

Item was changed:
  ----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') -----
  removeProcess: aProcess fromList: aList 
  	"Remove a given process from a linked list. May fail if aProcess is not on the list."
  	| firstLink lastLink nextLink tempLink |
+ 	self assert: (objectMemory isForwarded: aList) not.
  	firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
  	lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
  	aProcess  = firstLink ifTrue:[
  		nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess .
  		objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink.
  		aProcess  = lastLink ifTrue:[
  			objectMemory storePointer: LastLinkIndex ofObject: aList withValue: objectMemory nilObject.
  		].
  	] ifFalse:[
  		tempLink := firstLink.
  		[tempLink = objectMemory nilObject ifTrue:[^self success: false]. "fail"
  		nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink.
  		nextLink = aProcess] whileFalse:[
  			tempLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink.
  		].
  		nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess.
  		objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink.
  		aProcess  = lastLink ifTrue:[
  			objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink.
  		].
  	].
  	objectMemory storePointer: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject!

Item was changed:
  ----- Method: StackInterpreter>>signalExternalSemaphores (in category 'process primitive support') -----
  signalExternalSemaphores
  	"Signal all requested semaphores.  Answer if a context switch has occurred."
  	| xArray |
  	xArray := objectMemory splObj: ExternalObjectsArray.
+ 	^self doSignalExternalSemaphores: (objectMemory numSlotsOf: xArray)!
- 	^self doSignalExternalSemaphores: (self stSizeOf: xArray)!

Item was changed:
  ----- Method: StackInterpreter>>synchronousSignal: (in category 'process primitive support') -----
  synchronousSignal: aSemaphore 
  	"Signal the given semaphore from within the interpreter.
  	 Answer if the current process was preempted."
  	| excessSignals |
  	<inline: false>
  	(self isEmptyList: aSemaphore) ifTrue:
  		["no process is waiting on this semaphore"
  		 excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore.
  		 self storeInteger: ExcessSignalsIndex
  			ofObject: aSemaphore
  			withValue: excessSignals + 1.
  		 ^false].
+ 
+ 	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[| firstLink |
+ 		 firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aSemaphore.
+ 		 (objectMemory isForwarded: firstLink) ifTrue:
+ 			["0 = aSemaphore, 1 = aProcess. Hence reference to suspendedContext will /not/ be forwarded."
+ 			 objectMemory followForwardedObjectFields: aSemaphore toDepth: 1].
+ 		 self assert: (objectMemory isForwarded: (objectMemory fetchPointer: SuspendedContextIndex ofObject: firstLink)) not].
+ 
  	^self resume: (self removeFirstLinkOfList: aSemaphore)
  		preemptedYieldingIf: preemptionYields!

Item was changed:
  ----- Method: StackInterpreter>>traceProfileState (in category 'object memory support') -----
  traceProfileState
+ 	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[self followForwardingPointersInProfileState].
  	objectMemory markAndTrace: profileProcess.
  	objectMemory markAndTrace: profileMethod.
  	objectMemory markAndTrace: profileSemaphore.
  
  	"The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt.  Be very careful with it.
  	  If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
  	  been recenty sampled, but it must be newMethod and we don't need to trace it twice.  If LRPCSN
  	  ~= statCheckForEvents then LRPCM must be some extant object and needs to be traced."
  	self sqLowLevelMFence.
  	(longRunningPrimitiveCheckMethod ~= nil
  	 and: [longRunningPrimitiveCheckSequenceNumber ~= statCheckForEvents]) ifTrue:
+ 		[(objectMemory isForwarded: longRunningPrimitiveCheckMethod) ifTrue:
+ 			[longRunningPrimitiveCheckMethod := objectMemory followForwarded: longRunningPrimitiveCheckMethod].
+ 	objectMemory markAndTrace: longRunningPrimitiveCheckMethod].
- 		[objectMemory markAndTrace: longRunningPrimitiveCheckMethod].
  	longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
+ 		[(objectMemory isForwarded: longRunningPrimitiveCheckSemaphore) ifTrue:
+ 			[longRunningPrimitiveCheckSemaphore := objectMemory followForwarded: longRunningPrimitiveCheckSemaphore].
+ 		 objectMemory markAndTrace: longRunningPrimitiveCheckSemaphore]!
- 		[objectMemory markAndTrace: longRunningPrimitiveCheckSemaphore]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveLongRunningPrimitiveSemaphore (in category 'process primitives') -----
  primitiveLongRunningPrimitiveSemaphore
  	"Primitive. Install the semaphore to be used for collecting long-running primitives, 
  	 or nil if no semaphore should be used."
  	| sema |
  	<export: true>
  	sema := self stackValue: 0.
  	((objectMemory isIntegerObject: sema)
  	or: [self methodArgumentCount ~= 1]) ifTrue:
  		[^self primitiveFail].
  	sema = objectMemory nilObject
  		ifTrue:
  			[longRunningPrimitiveCheckSemaphore := nil]
  		ifFalse:
+ 			[(objectMemory isSemaphoreOop: sema) ifFalse:
- 			[(objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore) ifFalse:
  				[^self primitiveFail].
  			 longRunningPrimitiveCheckSemaphore := sema].
  	self voidLongRunningPrimitive: 'install'.
  	self pop: 1!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
  primitiveSignalAtMilliseconds
  	"Cause the time semaphore, if one has been registered, to be
  	 signalled when the microsecond clock is greater than or equal to
  	 the given tick value. A tick value of zero turns off timer interrupts."
  	| msecsObj msecs deltaMsecs sema |
  	<var: #msecs type: #usqInt>
  	msecsObj := self stackTop.
  	sema := self stackValue: 1.
  	msecs := self positive32BitValueOf: msecsObj.
+ 	
+ 	self successful ifTrue:
+ 		[(objectMemory isSemaphoreOop: sema) ifTrue:
- 	(self failed
- 	 or: [objectMemory isImmediate: sema]) ifTrue:
- 		[self primitiveFail.
- 		 ^nil].
- 	(objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore)
- 		ifTrue:
  			[objectMemory splObj: TheTimerSemaphore put: sema.
+ 			 deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask).
+ 			 deltaMsecs < 0 ifTrue:
- 			deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask).
- 			deltaMsecs < 0 ifTrue:
  				[deltaMsecs := deltaMsecs + MillisecondClockMask + 1].
+ 			 nextWakeupUsecs := self ioUTCMicroseconds + (deltaMsecs * 1000).
+ 			 ^self pop: 2].
+ 		 sema = objectMemory nilObject ifTrue:
- 			nextWakeupUsecs := self ioUTCMicroseconds + (deltaMsecs * 1000)]
- 		ifFalse:
  			[objectMemory
  				storePointer: TheTimerSemaphore
  				ofObject: objectMemory specialObjectsOop
  				withValue: objectMemory nilObject.
+ 			 nextWakeupUsecs := 0.
+ 			 ^self pop: 2]].
+ 	self primitiveFailFor: PrimErrBadArgument!
- 			nextWakeupUsecs := 0].
- 	self pop: 2!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSignalAtUTCMicroseconds (in category 'system control primitives') -----
  primitiveSignalAtUTCMicroseconds
  	"Cause the time semaphore, if one has been registered, to be
  	 signalled when the microsecond clock is greater than or equal to
  	 the given tick value. A tick value of zero turns off timer interrupts."
  	| usecsObj sema usecs |
  	<var: #usecs type: #usqLong>
  	usecsObj := self stackTop.
  	sema := self stackValue: 1.
  	usecs := self positive64BitValueOf: usecsObj.
+ 	self successful ifTrue:
+ 		[(objectMemory isSemaphoreOop: sema) ifTrue:
- 	(self failed
- 	 or: [objectMemory isIntegerObject: sema]) ifTrue:
- 		[self primitiveFail.
- 		 ^nil].
- 	(objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore)
- 		ifTrue:
  			[objectMemory splObj: TheTimerSemaphore put: sema.
+ 			 nextWakeupUsecs := usecs.
+ 			 ^self pop: 2].
+ 		 sema = objectMemory nilObject ifTrue:
- 			nextWakeupUsecs := usecs]
- 		ifFalse:
  			[objectMemory
  				storePointer: TheTimerSemaphore
  				ofObject: objectMemory specialObjectsOop
  				withValue: objectMemory nilObject.
+ 			 nextWakeupUsecs := 0.
+ 			 ^self pop: 2]].
+ 	self primitiveFailFor: PrimErrBadArgument!
- 			nextWakeupUsecs := 0].
- 	self pop: 2!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails.
  	 Override to push the register args when calling ceSendFromInLineCacheMiss:"
+ 	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
- 	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod routine |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self compilePICProlog: numArgs.
  	self cppIf: NewspeakVM ifTrue:
  		[self Nop. "1st nop differentiates dynSuperEntry from no-check entry if using nextMethod"
  		 dynSuperEntry := self Nop].
  	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  	self MoveR: ClassReg R: SendNumArgsReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: ShiftForWord R: ClassReg.
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	itsAHit := self Label.
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << ShiftForWord)
  		r: ClassReg
  		R: SendNumArgsReg.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
  	objectRepresentation
  		genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
  	jumpBCMethod jmpTarget: interpretLabel.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg.
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	ShiftForWord > 2 ifTrue:
  		[self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg].
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromInLineCacheMiss: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	backEnd genPushRegisterArgsForNumArgs: numArgs.
  	self genSmalltalkToCStackSwitch.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
+ 	self 
+ 		compileCallFor: #ceSendFromInLineCacheMiss:
+ 		numArgs: 1
+ 		arg: SendNumArgsReg
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		resultReg: nil
+ 		saveRegs: false
- 	cStackAlignment > BytesPerWord ifTrue:
- 		[backEnd
- 			genAlignCStackSavingRegisters: false
- 			numArgs: 1
- 			wordAlignment: cStackAlignment / BytesPerWord].
- 	backEnd genPassReg: SendNumArgsReg asArgument: 0.
- 	routine := self cCode: '(sqInt)ceSendFromInLineCacheMiss'
- 					inSmalltalk: [self simulatedAddressFor: #ceSendFromInLineCacheMiss:].
- 	self annotateCall: (self Call: routine)
  	"Note that this call does not return."!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>generateMissAbortTrampolines (in category 'initialization') -----
  generateMissAbortTrampolines
  	"Generate the run-time entries for the various method and PIC entry misses and aborts.
  	 Read the class-side method trampolines for documentation on the various trampolines"
  
  	"Slang needs these apparently superfluous asSymbol sends."
  	0 to: self numRegArgs + 1 do:
  		[:numArgs|
  		methodAbortTrampolines
  			at: numArgs
  			put: (self genMethodAbortTrampolineFor: numArgs)].
  	0 to: self numRegArgs + 1 do:
  		[:numArgs|
  		picAbortTrampolines
  			at: numArgs
  			put: (self genPICAbortTrampolineFor: numArgs)].
  	0 to: self numRegArgs + 1 do:
  		[:numArgs|
  		picMissTrampolines
  			at: numArgs
+ 			put: (self genPICMissTrampolineFor: numArgs)]!
- 			put: (self genPICMissTrampolineFor: numArgs)].
- 	self cCode: '' inSmalltalk:
- 		[simulatedTrampolines
- 			at: (self simulatedAddressFor: #ceSendFromInLineCacheMiss:)
- 			put: #ceSendFromInLineCacheMiss:]!



More information about the Vm-dev mailing list