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

commits at source.squeak.org commits at source.squeak.org
Thu Jul 10 15:53:52 UTC 2014


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

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

Name: VMMaker.oscog-eem.814
Author: eem
Time: 10 July 2014, 8:51:06.667 am
UUID: 65761a39-4d91-4bd4-bc2d-d3c514a33901
Ancestors: VMMaker.oscog-eem.813

On Spur, move implicit receiver caches ou of code and into
pinned objects on the heap (similarly to Sista counters).
Gets e.g. -2% speedup in compiling a Newspeak file.

Rename NewspeakMethod>>nextMethod to nextMethodOrIRCs
and use it for both tasks.  Nuke SMM>>allocatePinnedCounters:
in place of allocatePinnedSlots: and use this for both counters
and IRCs.

Add a hasIRC flag to CogBytecodeDescriptor and count implicit
receiver caches for their out-of-line allocation.

Make the option: processing in shouldIncludeMethodFor:selector:
cope with multiple option: pragmas.

Nuke the newInitializeBytecodeTableForNewspeakV3PlusClosures.
Can be resurrected later if the others ever get worked on.

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

Item was changed:
  ----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
  shouldIncludeMethodFor: aClass selector: selector
  	"Answer whether a method shoud be translated.  Process optional methods by
  	 interpreting the argument to the option: pragma as either a Cogit class name
  	 or a class variable name or a variable name in VMBasicConstants.  Exclude
  	 methods with the doNotGenerate pragma."
+ 	| pragmas |
+ 	(pragmas := (aClass >> selector) pragmas select: [:p| p keyword == #option:]) notEmpty ifTrue:
+ 		[pragmas do:
+ 			[:pragma| | key |
+ 			 key := pragma argumentAt: 1.
+ 			 vmMaker ifNotNil:
+ 				[vmMaker cogitClassName ifNotNil:
+ 					[(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
+ 						[| cogitClass optionClass |
+ 						 cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
+ 						 optionClass := Smalltalk classNamed: key.
+ 						 ^cogitClass includesBehavior: optionClass]].
+ 				((vmClass
+ 					ifNotNil: [vmClass initializationOptions]
+ 					ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil:
+ 					[:option| option ~~ false ifTrue: [^true]].
+ 			 (aClass bindingOf: key) ifNotNil:
+ 				[:binding|
+ 				binding value ~~ false ifTrue: [^true]].
+ 			 (VMBasicConstants bindingOf: key) ifNotNil:
+ 				[:binding|
+ 				binding value ~~ false ifTrue: [^true]]]].
- 	(aClass >> selector pragmaAt: #option:) ifNotNil:
- 		[:pragma| | key |
- 		key := pragma argumentAt: 1.
- 		vmMaker ifNotNil:
- 			[vmMaker cogitClassName ifNotNil:
- 				[(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
- 					[| cogitClass optionClass |
- 					 cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
- 					 optionClass := Smalltalk classNamed: key.
- 					 ^cogitClass includesBehavior: optionClass]].
- 			((vmClass
- 				ifNotNil: [vmClass initializationOptions]
- 				ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil:
- 				[:option| option ~~ false ifTrue: [^true]].
- 		(aClass bindingOf: key) ifNotNil:
- 			[:binding|
- 			binding value ~~ false ifTrue: [^true]].
- 		(VMBasicConstants bindingOf: key) ifNotNil:
- 			[:binding|
- 			binding value ~~ false ifTrue: [^true]]].
  		^false].
  	^(aClass >> selector pragmaAt: #doNotGenerate) isNil!

Item was added:
+ ----- Method: CogAbstractInstruction>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
+ implicitReceiveCacheAt: callSiteReturnAddress
+ 	"Answer the implicit receiver cache for the return address
+ 	 of a call to the ceImplicitReceiverTrampoline."
+ 	<option: #NewspeakVM>
+ 	^self subclassResponsibility!

Item was changed:
  VMStructType subclass: #CogBytecodeDescriptor
+ 	instanceVariableNames: 'generator spanFunction needsFrameFunction stackDelta opcode numBytes isBranchTrue isBranchFalse isReturn isBlockCreation isMapped isMappedInBlock isExtension hasIRC'
- 	instanceVariableNames: 'generator spanFunction needsFrameFunction stackDelta opcode numBytes isBranchTrue isBranchFalse isReturn isBlockCreation isMapped isMappedInBlock isExtension'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogBytecodeDescriptor commentStamp: 'eem 11/18/2010 06:32' prior: 0!
  I am an entry in the Cogit's dispatch table for bytecodes.  I hold the routine to call to generate code for the partcular bytecode I represent and the number of bytes the bytecode has.  For eliminating temps in frameless blocks I maintain a stack delta for bytecodes that are valid in a frameless block.  The order of my instance variables is chosen for compact struct packing.!

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

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

Item was added:
+ ----- Method: CogIA32Compiler>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
+ implicitReceiveCacheAt: callSiteReturnAddress
+ 	"Answer the implicit receiver cache for the return address
+ 	 of a call to the ceImplicitReceiverTrampoline."
+ 	<option: #NewspeakVM>
+ 	<inline: false>
+ 	^self literalBeforeFollowingAddress: callSiteReturnAddress - 10!

Item was changed:
  ----- Method: CogMethodZone class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	aCCodeGenerator
  		removeVariable: 'coInterpreter';
  		removeVariable: 'objectRepresentation'.
  	
+ 	self declareC: #(youngReferrers mzFreeStart baseAddress limitAddress unpairedMethodList)
+ 		as: #usqInt
+ 		in: aCCodeGenerator!
- 	self declareC: #(youngReferrers mzFreeStart baseAddress limitAddress)
- 			as: #usqInt
- 				in: aCCodeGenerator.
- 	aCCodeGenerator var: 'unpairedMethodList' type: #'CogMethod *'!

Item was changed:
  ----- Method: CogMethodZone>>addToUnpairedMethodList: (in category 'accessing') -----
  addToUnpairedMethodList: aCogMethod
  	<option: #NewspeakVM>
  	<var: #aCogMethod type: #'CogMethod *'>
  	self assert: aCogMethod cmType = CMMethod.
+ 	self assert: (cogit noAssertMethodClassAssociationOf: aCogMethod methodObject) = objectMemory nilObject.
  	self assert: (unpairedMethodList == nil
+ 				or: [(self cCoerceSimple: unpairedMethodList to: #'CogMethod *') cmType = CMMethod]).
+ 	aCogMethod nextMethodOrIRCs: unpairedMethodList.
- 				or: [unpairedMethodList cmType = CMMethod]).
- 	aCogMethod nextMethod: unpairedMethodList.
  	unpairedMethodList := aCogMethod!

Item was changed:
  ----- Method: CogMethodZone>>compactCompiledCode (in category 'compaction') -----
  compactCompiledCode
  	| objectHeaderValue source dest bytes |
  	<var: #source type: #'CogMethod *'>
  	<var: #dest type: #'CogMethod *'>
  	objectHeaderValue := objectMemory nullHeaderForMachineCodeMethod.
  	source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
  	openPICList := nil.
  	methodCount := 0.
  	self cppIf: NewspeakVM ifTrue: [unpairedMethodList := nil].
  	[source < self limitZony
  	 and: [source cmType ~= CMFree]] whileTrue:
  		[self assert: (cogit cogMethodDoesntLookKosher: source) = 0.
  		 source objectHeader: objectHeaderValue.
  		 source cmUsageCount > 0 ifTrue:
  			[source cmUsageCount: source cmUsageCount // 2].
  		 self cppIf: NewspeakVM ifTrue:
  				[(source cmType = CMMethod
  				  and: [(coInterpreter rawHeaderOf: source methodObject) asInteger ~= source asInteger]) ifTrue:
+ 					[source nextMethodOrIRCs: unpairedMethodList.
+ 					 unpairedMethodList := source asUnsignedInteger]].
- 					[source nextMethod: unpairedMethodList.
- 					 unpairedMethodList := source]].
  		 source cmType = CMOpenPIC ifTrue:
  			[source nextOpenPIC: openPICList asUnsignedInteger.
  			 openPICList := source].
  		 methodCount := methodCount + 1.
  		 source := self methodAfter: source].
  	source >= self limitZony ifTrue:
  		[^self halt: 'no free methods; cannot compact.'].
  	dest := source.
  	[source < self limitZony] whileTrue:
  		[self assert: (cogit maybeFreeCogMethodDoesntLookKosher: source) = 0.
  		 bytes := source blockSize.
  		 source cmType ~= CMFree ifTrue:
  			[methodCount := methodCount + 1.
  			 objectMemory mem: dest mo: source ve: bytes.
  			 dest objectHeader: objectHeaderValue.
  			 dest cmType = CMMethod
  				ifTrue:
  					["For non-Newspeak there should be a one-to-one mapping between bytecoded and
  					  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  					"Only update the original method's header if it is referring to this CogMethod."
  					 (coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
+ 						ifTrue:
+ 							[coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]
- 						ifTrue: [coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]
  						ifFalse:
  							[self assert: (cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject.
+ 							 self cppIf: NewspeakVM ifTrue:
+ 								[dest nextMethodOrIRCs: unpairedMethodList.
+ 								 unpairedMethodList := dest asUnsignedInteger]]]
- 							 self cppIf: NewspeakVM
- 								ifTrue: [dest nextMethod: unpairedMethodList.
- 										unpairedMethodList := dest]]]
  				ifFalse:
  					[dest cmType = CMOpenPIC ifTrue:
  						[dest nextOpenPIC: openPICList asUnsignedInteger.
  						 openPICList := dest]].
  			 dest cmUsageCount > 0 ifTrue:
  				[dest cmUsageCount: dest cmUsageCount // 2].
  			 dest := coInterpreter
  								cCoerceSimple: dest asUnsignedInteger + bytes
  								to: #'CogMethod *'].
  		 source := coInterpreter
  							cCoerceSimple: source asUnsignedInteger + bytes
  							to: #'CogMethod *'].
  	mzFreeStart := dest asUnsignedInteger.
  	methodBytesFreedSinceLastCompaction := 0!

Item was changed:
  ----- Method: CogMethodZone>>findPreviouslyCompiledVersionOf:with: (in category 'accessing') -----
  findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop
  	"Newspeak uses a set of methods to implement accessors, a setter and a getter for
  	 each inst var offset (e.g. 0 to 255).  These accessors are installed under the relevant
  	 selectors in different method dictionaries as required.  These methods effectively
  	 have multiple selectors.  The current inline cache design stores the selector of a
  	 linked send in the header of the target method.  So this requires a one-to-many
  	 mapping of bytecoded method to cog method, with the bytecoded method referring
  	 directly to only one cog method, which will have a specific selector, not necessarily
  	 the right one.  It is therefore worth-while searching for a cog method on this bytecoded
  	 method that has the right selector.  To speed up the search we maintain all such unpaired
+ 	 methods on the unpairedMethodList, which is linked through nextMethodOrIRCs."
- 	 methods on the unpairedMethodList."
  	<returnTypeC: #'CogMethod *'>
  	<option: #NewspeakVM>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	((coInterpreter methodHasCogMethod: aMethodObj)
  	 and: [(coInterpreter methodClassAssociationOf: aMethodObj) = objectMemory nilObject]) ifTrue:
+ 		[cogMethod := self cCoerceSimple: unpairedMethodList to: #'CogMethod *'.
- 		[cogMethod := unpairedMethodList.
  		[cogMethod notNil] whileTrue:
  			[self assert: cogMethod cmType = CMMethod.
  			 (cogMethod selector = aSelectorOop
  			  and: [cogMethod methodObject = aMethodObj]) ifTrue:
  				[^cogMethod].
+ 			 cogMethod := self cCoerceSimple: cogMethod nextMethodOrIRCs to: #'CogMethod *']].
- 			 cogMethod := cogMethod nextMethod]].
  	^nil!

Item was changed:
  ----- Method: CogMethodZone>>freeMethod: (in category 'compaction') -----
  freeMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: false>
  	self assert: cogMethod cmType ~= CMFree.
  	self assert: ((cogit cogMethodDoesntLookKosher: cogMethod) = 0
  				 or: [(cogit cogMethodDoesntLookKosher: cogMethod) = 23
  					 and: [(cogit cCoerceSimple: cogMethod methodObject to: #'CogMethod *') cmType = CMFree]]).
  	cogMethod cmType = CMMethod ifTrue:
  		["For non-Newspeak there should ne a one-to-one mapping between bytecoded and
  		  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  		"Only reset the original method's header if it is referring to this CogMethod."
  		 (coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger
  			ifTrue:
+ 				[coInterpreter rawHeaderOf: cogMethod methodObject put: cogMethod methodHeader.
+ 				 self cppIf: NewspeakVM ifTrue:
+ 					[(objectRepresentation canPinObjects and: [cogMethod nextMethodOrIRCs ~= 0]) ifTrue:
+ 						[objectRepresentation freeIRCs: cogMethod nextMethodOrIRCs]]]
- 				[coInterpreter rawHeaderOf: cogMethod methodObject put: cogMethod methodHeader]
  			ifFalse:
  				[self assert: (cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject.
  				 self cppIf: NewspeakVM ifTrue:
  					[self removeFromUnpairedMethodList: cogMethod]].
  		 cogit maybeFreeCountersOf: cogMethod.
  		 cogMethod cmRefersToYoung: false].
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[self removeFromOpenPICList: cogMethod.
  		 cogMethod cmRefersToYoung: false].
  	cogMethod cmType: CMFree.
  	methodBytesFreedSinceLastCompaction := methodBytesFreedSinceLastCompaction
  												+ cogMethod blockSize!

Item was changed:
  ----- Method: CogMethodZone>>removeFromUnpairedMethodList: (in category 'accessing') -----
  removeFromUnpairedMethodList: aCogMethod
  	<option: #NewspeakVM>
  	<var: #aCogMethod type: #'CogMethod *'>
  	| prevMethod |
  	<var: #prevMethod type: #'CogMethod *'>
  	self assert: aCogMethod cmType = CMMethod.
+ 	aCogMethod asUnsignedInteger = unpairedMethodList ifTrue:
+ 		[unpairedMethodList := aCogMethod nextMethodOrIRCs.
- 	aCogMethod = unpairedMethodList ifTrue:
- 		[unpairedMethodList := aCogMethod nextMethod.
  		 ^nil].
+ 	prevMethod := self cCoerceSimple: unpairedMethodList to: #'CogMethod *'.
- 	prevMethod := unpairedMethodList.
  	[prevMethod notNil] whileTrue:
  		[self assert: (prevMethod ~~ nil and: [prevMethod cmType = CMMethod]).
+ 		 prevMethod nextMethodOrIRCs = aCogMethod asUnsignedInteger ifTrue:
+ 			[prevMethod nextMethodOrIRCs: aCogMethod nextMethodOrIRCs.
- 		 prevMethod nextMethod = aCogMethod ifTrue:
- 			[prevMethod nextMethod: aCogMethod nextMethod.
  			 ^nil].
+ 		  prevMethod := self cCoerceSimple: prevMethod nextMethodOrIRCs to: #'CogMethod *']!
- 		  prevMethod := prevMethod nextMethod]!

Item was added:
+ ----- Method: CogObjectRepresentation>>canPinObjects (in category 'testing') -----
+ canPinObjects
+ 	"Answer if the memory manager supports pinned objects."
+ 	^false!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>allocateCounters: (in category 'sista support') -----
+ allocateCounters: nCounters
+ 	"On Spur allocate the counters on the heap as pinned objects.
+ 	 Each counter occupies 32-bits.  The number of counters can
+ 	 be derived from the number of slots in the obj."
+ 	<inline: true>
+ 	| objOop |
+ 	objOop := objectMemory allocatePinnedSlots: nCounters.
+ 	^objOop
+ 		ifNil: [0]
+ 		ifNotNil: [objOop + objectMemory baseHeaderSize]!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>allocateCounters: (in category 'sista support') -----
+ allocateCounters: nCounters
+ 	"On Spur allocate the counters on the heap as pinned objects.
+ 	 Each counter occupies 32-bits.  The number of counters can
+ 	 be derived from the number of slots in the obj."
+ 	<inline: true>
+ 	| objOop |
+ 	objOop := objectMemory allocatePinnedSlots: nCounters + 1 // 2.
+ 	^objOop
+ 		ifNil: [0]
+ 		ifNotNil: [objOop + objectMemory baseHeaderSize]!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>allocateCounters: (in category 'sista support') -----
- allocateCounters: nCounters
- 	"On Spur allocate the counters on the heap as pinned objects.  The
- 	 number of counters can be derived from the nbumber of slots in the obj."
- 	<inline: true>
- 	| objOop |
- 	objOop := objectMemory allocatePinnedCounters: nCounters.
- 	^objOop
- 		ifNil: [0]
- 		ifNotNil: [objOop + objectMemory baseHeaderSize]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>allocateNPinnedSlots: (in category 'newspeak support') -----
+ allocateNPinnedSlots: nSlots
+ 	"On Newspeak allocate the implicit receiver caches on the heap as pinned objects."
+ 	<inline: true>
+ 	<option: #NewspeakVM>
+ 	| objOop |
+ 	objOop := objectMemory allocatePinnedSlots: nSlots.
+ 	^objOop
+ 		ifNil: [0]
+ 		ifNotNil: [objOop + objectMemory baseHeaderSize]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>canPinObjects (in category 'testing') -----
+ canPinObjects
+ 	"Answer if the memory manager supports pinned objects."
+ 	^true!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>freeCounters: (in category 'sista support') -----
  freeCounters: theCounters
  	<var: #theCounters type: #usqInt>
  	<inline: true>
+ 	<option: #SistaStackToRegisterMappingCogit>
  	theCounters ~= 0 ifTrue:
  		[objectMemory freeObject: theCounters - objectMemory baseHeaderSize]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>freeIRCs: (in category 'newspeak support') -----
+ freeIRCs: maybeIRCs
+ 	<var: #maybeIRCs type: #usqInt>
+ 	<option: #NewspeakVM>
+ 	<inline: true>
+ 	(self oop: maybeIRCs isGreaterThan: objectMemory nilObject) ifTrue:
+ 		[objectMemory freeObject: maybeIRCs - objectMemory baseHeaderSize]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>markIfIRC: (in category 'newspeak support') -----
+ markIfIRC: maybeIRCs
+ 	"If maybeIRCs (from some cogMehtod's nextMethodOrIRCs) is in old space it is
+ 	 a pointer to the first field of a pinned object in old space holding the implicit
+ 	 receiver caches for a method.  If so, map it back to an oop and mark it."
+ 	<var: #maybeIRCs type: #usqInt>
+ 	<option: #NewspeakVM>
+ 	(self oop: maybeIRCs isGreaterThan: objectMemory nilObject) ifTrue:
+ 		[objectMemory markAndTrace: maybeIRCs - objectMemory baseHeaderSize]!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>maybeMarkCounters: (in category 'sista support') -----
  maybeMarkCounters: theCounters
  	"In SIsta Spur counters are held on the heap in pinned objects which must be marked
  	 to avoid them being garbage collected.  This is the hook through which that happens."
+ 	<var: #theCounters type: #usqInt>
+ 	<option: #SistaStackToRegisterMappingCogit>
- 	<var: #counters type: #usqInt>
  	<inline: true>
  	theCounters ~= 0 ifTrue:
  		[objectMemory markAndTrace: theCounters - objectMemory baseHeaderSize]!

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 maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs'
+ 	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 NumOopsPerIRC NumSendTrampolines NumTrampolines ProcessorClass ShouldNotJIT UnimplementedPrimitive YoungSelectorInPIC'
- 	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 maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs 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'
  	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>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'dynSuperEntry' 'dynSuperEntryAlignment' 'dynamicSuperSendTrampolines'
+ 			'ceImplicitReceiverTrampoline' 'ceExplicitReceiverTrampoline' 'cmDynSuperEntryOffset'
+ 			'numIRCs' 'indexOfIRC' 'theIRCs') do:
- 			'ceImplicitReceiverTrampoline' 'ceExplicitReceiverTrampoline' 'cmDynSuperEntryOffset') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"cogmethod.h"';
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	aCCodeGenerator
  		var: #ceGetSP
  			declareC: 'unsigned long (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #ceFlushICache
  			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
  			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
  			declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
  		var: #ceUnlockVMOwner
  			declareC: 'void (*ceUnlockVMOwner)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *, void *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *'.
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel';
  		var: #primInvokeLabel type: #'AbstractInstruction *'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss sendMissCall entry noCheckEntry dynSuperEntry
  					mnuCall interpretCall interpretLabel endCPICCase0 endCPICCase1)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #annotations type: #'InstructionAnnotation *';
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *'.
  	aCCodeGenerator
  		var: #sendTrampolines
  			declareC: 'sqInt sendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
  		var: #dynamicSuperSendTrampolines
  			declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static sqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #CFramePointer type: #'void *';
  		declareVar: #CStackPointer type: #'void *';
  		declareVar: #minValidCallAddress type: #'unsigned long';
  		declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator);
  			var: #primitiveGeneratorTable
  				declareC: 'PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
  							(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

Item was changed:
  ----- Method: Cogit class>>generatorTableFrom: (in category 'class initialization') -----
  generatorTableFrom: anArray
  	| blockCreationBytecodeSize |
  	generatorTable := CArrayAccessor on: (Array new: 256).
  	anArray do:
  		[:tuple| | descriptor |
  		(descriptor := CogBytecodeDescriptor new)
  						numBytes: tuple first;
  						generator: tuple fourth;
  						isReturn: (tuple includes: #return);
  						isMapped: (tuple includes: #isMapped);
  						isMappedInBlock: (tuple includes: #isMappedInBlock);
  						isBlockCreation: (tuple includes: #block);
  						spanFunction: (((tuple includes: #block) or: [(tuple includes: #branch)]) ifTrue:
  										[tuple detect: [:thing| thing isSymbol and: [thing numArgs = 4]]]);
  						isBranchTrue: (tuple includes: #isBranchTrue);
  						isBranchFalse: (tuple includes: #isBranchFalse);
  						isExtension: (tuple includes: #extension);
+ 						hasIRC: (tuple includes: #hasIRC);
  						yourself.
  		descriptor isBlockCreation ifTrue:
  			[blockCreationBytecodeSize
  				ifNil: [blockCreationBytecodeSize := descriptor numBytes]
  				ifNotNil: [self assert: blockCreationBytecodeSize = descriptor numBytes]].
  		tuple do:
  			[:thing|
  			thing isSymbol ifTrue:
  				[(thing beginsWith: #needsFrame) ifTrue:
  					[descriptor needsFrameFunction: thing].
  				 (CogRTLOpcodes classPool at: thing ifAbsent: []) ifNotNil:
  					[:opcode| descriptor opcode: opcode]]].
  		tuple last isInteger
  			ifTrue: [descriptor stackDelta: tuple last]
  			ifFalse:
  				[descriptor needsFrameFunction ifNotNil:
  					[self error: 'frameless block bytecodes must specify a stack delta']].
  		tuple second to: tuple third do:
  			[:index|
  			generatorTable at: index put: descriptor]].
  	BlockCreationBytecodeSize := blockCreationBytecodeSize.
  	^generatorTable!

Item was changed:
  ----- Method: Cogit class>>initializeMiscConstants (in category 'class initialization') -----
  initializeMiscConstants
  	super initializeMiscConstants.
  	Debug := initializationOptions at: #Debug ifAbsent: [false].
  	(initializationOptions includesKey: #EagerInstructionDecoration)
  		ifTrue:
  			[EagerInstructionDecoration := initializationOptions at: #EagerInstructionDecoration]
  		ifFalse:
  			[EagerInstructionDecoration isNil ifTrue:
  				[EagerInstructionDecoration := false]]. "speeds up single stepping but could lose fidelity"
  
  	ProcessorClass := (initializationOptions at: #ISA ifAbsent: [#IA32]) caseOf: {
  							[#IA32] 	->	[BochsIA32Alien].
  							[#ARMv5]	->	[GdbARMAlien]. }.
  	"we special-case 0, 1 & 2 argument sends, N is numArgs >= 3"
  	NumSendTrampolines := 4.
+ 	"Currently not even the ceImplicitReceiverTrampoline contains object references."
+ 	NumObjRefsInRuntime := 0.
+ 	"The implicit receiver cache has two entries, class and mixin oops."
+ 	NumOopsPerIRC := 2.
- 	"Currently only the ceImplicitReceiverTrampoline contains object references."
- 	NumObjRefsInRuntime := 2.
  	"Max size to alloca when compiling.
  	 Mac OS X 10.6.8 segfaults approaching 8Mb.
  	 Linux 2.6.9 segfaults above 11Mb.
  	 WIndows XP segfaults approaching 2Mb."
  	MaxStackAllocSize := 1024 * 1024 * 3 / 2 !

Item was removed:
- ----- Method: Cogit class>>newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
- newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid
- 	"SimpleStackBasedCogit newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
- 	"StackToRegisterMappingCogit newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
- 
- 	| v3Table v4Table |
- 	"N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize correctly."
- 	self newInitializeBytecodeTableForNewspeakV4.
- 	v4Table := generatorTable.
- 	AltBlockCreationBytecodeSize := BlockCreationBytecodeSize.
- 	AltNSSendIsPCAnnotated := NSSendIsPCAnnotated.
- 	self newInitializeBytecodeTableForNewspeakV3PlusClosures.
- 	v3Table := generatorTable.
- 	generatorTable := CArrayAccessor on: v3Table object, v4Table object!

Item was changed:
  ----- Method: Cogit>>ceImplicitReceiverFor:receiver: (in category 'in-line cacheing') -----
  ceImplicitReceiverFor: selector receiver: receiver
  	"Cached implicit receiver implementation.  Caller looks like
  		mov selector, ClassReg
  				call ceImplicitReceiver
  				br continue
  		Lclass	.word
  		Lmixin:	.word
  		continue:
  	 The trampoline has already fetched the class and probed the cache and found
  	 that the cache missed.  Compute the implicit receiver for the receiver's class
  	 and reload the class tag.  If either the class tag or the mixin are young then the
  	 method needs to be added to the youngReferrers list to ensure correct GC."
  
+ 	<option: #SqueakV3ObjectMemory>
  	| rcvrClass retpc classpc mixinpc mixin cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	retpc := coInterpreter stackTop.
  	classpc := retpc + backEnd jumpShortByteSize.
  	mixinpc := retpc + backEnd jumpShortByteSize + BytesPerOop.
  	mixin := coInterpreter
  				implicitReceiverFor: receiver
  				mixin: coInterpreter mMethodClass
  				implementing: selector.
  	rcvrClass := objectMemory fetchClassOf: receiver.
  	cogMethod := coInterpreter mframeHomeMethodExport.
  	cogMethod cmRefersToYoung ifFalse:
  		[((objectRepresentation inlineCacheTagsMayBeObjects
  		   and: [objectMemory isYoung: rcvrClass])
  		  or: [mixin ~= receiver and: [objectMemory isYoung: mixin]]) ifTrue:
  			[methodZone roomOnYoungReferrersList ifFalse:
  				[coInterpreter callForCogCompiledCodeCompaction.
  				 ^mixin].
  			 cogMethod cmRefersToYoung: true.
  			 methodZone addToYoungReferrers: cogMethod]].
  	backEnd
  		unalignedLongAt: classpc
  			put: (objectRepresentation inlineCacheTagForClass: rcvrClass);
  		unalignedLongAt: mixinpc
  			put: (mixin = receiver ifTrue: [0] ifFalse: [mixin]).
  	^mixin!

Item was added:
+ ----- Method: Cogit>>ceImplicitReceiverFor:receiver:cache: (in category 'in-line cacheing') -----
+ ceImplicitReceiverFor: selector receiver: receiver cache: cacheAddress
+ 	"Cached implicit receiver implementation.  Caller looks like
+ 				mov Lclass, Arg1Reg
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 	 and Lclass: .word; Lmixin: .word is somewhere on the heap.
+ 	 The trampoline has already fetched the class and probed the cache and found
+ 	 that the cache missed.  Compute the implicit receiver for the receiver's class
+ 	 and reload the class tag.  If either the class tag or the mixin are young then the
+ 	 method needs to be added to the youngReferrers list to ensure correct GC."
+ 
+ 	<option: #SpurMemoryManager>
+ 	<var: #cacheAddress type: #usqInt>
+ 	| rcvrClass mixin cogMethod |
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	mixin := coInterpreter
+ 				implicitReceiverFor: receiver
+ 				mixin: coInterpreter mMethodClass
+ 				implementing: selector.
+ 	rcvrClass := objectMemory fetchClassOf: receiver.
+ 	cogMethod := coInterpreter mframeHomeMethodExport.
+ 	cogMethod cmRefersToYoung ifFalse:
+ 		[((objectRepresentation inlineCacheTagsMayBeObjects
+ 		   and: [objectMemory isYoung: rcvrClass])
+ 		  or: [mixin ~= receiver and: [objectMemory isYoung: mixin]]) ifTrue:
+ 			[methodZone roomOnYoungReferrersList ifFalse:
+ 				[coInterpreter callForCogCompiledCodeCompaction.
+ 				 ^mixin].
+ 			 cogMethod cmRefersToYoung: true.
+ 			 methodZone addToYoungReferrers: cogMethod]].
+ 	backEnd
+ 		unalignedLongAt: cacheAddress
+ 			put: (objectRepresentation inlineCacheTagForClass: rcvrClass);
+ 		unalignedLongAt: cacheAddress + BytesPerOop
+ 			put: (mixin = receiver ifTrue: [0] ifFalse: [mixin]).
+ 	^mixin!

Item was changed:
  ----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
  compileCogMethod: selector
  	<returnTypeC: #'CogMethod *'>
  	| numBytecodes numBlocks numCleanBlocks result extra |
  	hasYoungReferent := (objectMemory isYoungObject: methodObj)
  						  or: [objectMemory isYoung: selector].
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
  	inBlock := false.
  	primInvokeLabel := nil.
  	postCompileHook := nil.
  	maxLitIndex := -1.
  	usesMethodClass := false.
  	extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
  			and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
  				ifTrue: [30]
  				ifFalse: [10].
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
  					ifTrue: [initialPC - 1]
  					ifFalse: [objectMemory byteLengthOf: methodObj].
  	numBytecodes := endPC - initialPC + 1.
  	self allocateOpcodes: (numBytecodes + extra) * 10
  		bytecodes: numBytecodes
  		ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	numCleanBlocks := self scanForCleanBlocks.
  	self allocateBlockStarts: numBlocks + numCleanBlocks.
  	blockCount := 0.
  	numCleanBlocks > 0 ifTrue:
  		[self addCleanBlockStarts].
+ 	(self maybeAllocAndInitCounters
+ 	 and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do.  This will likely never fail."
- 	self maybeAllocAndInitCounters ifFalse: "Inaccurate error code, but it'll do.  This will likely never fail."
  		[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
+ 	
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogMethod: selector!

Item was changed:
  ----- Method: Cogit>>disassembleMethod:on: (in category 'disassembly') -----
  disassembleMethod: surrogateOrAddress on: aStream
  	<doNotGenerate>
  	| cogMethod mapEntries codeRanges |
  	cogMethod := surrogateOrAddress isInteger
  								ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
  								ifFalse: [surrogateOrAddress].
  	cogMethod cmType = CMBlock ifTrue:
  		[^self disassembleMethod: cogMethod cmHomeMethod on: aStream].
  	self printMethodHeader: cogMethod on: aStream.
  
  	(mapEntries := Dictionary new)
  		at: cogMethod asInteger + cmEntryOffset put: 'entry'.
  	
  	cogMethod cmType = CMMethod ifTrue:
  		[mapEntries at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry'.
  		self cppIf: NewspeakVM
  			ifTrue: [mapEntries at: cogMethod asInteger + dynSuperEntryAlignment put: 'dynSuperEntry']].
  
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[mapEntries at: cogMethod asInteger + firstCPICCaseOffset put: 'ClosedPICCase0'.
  		 1 to: numPICCases - 1 do:
  			[:i|
  			mapEntries
  				at: cogMethod asInteger + firstCPICCaseOffset + (i * cPICCaseSize)
  				put: 'ClosedPICCase', i printString]].
  
  	self mapFor: cogMethod
  		performUntil: #collectMapEntry:address:into:
  		arg: mapEntries.
  
  	self cppIf: NewspeakVM
  		ifTrue:
+ 			[objectRepresentation canPinObjects ifFalse:
+ 				[mapEntries keys do:
+ 					[:a|
+ 					(mapEntries at: a) = #IsNSSendCall ifTrue:
+ 						[mapEntries
+ 							at: a + backEnd jumpShortByteSize
+ 								put: {'Class'. #disassembleCachedOop:. BytesPerWord};
+ 							at: a + backEnd jumpShortByteSize + BytesPerOop
+ 								put: {'ImplicitReceiver'. #disassembleCachedOop:. BytesPerWord}]]]].
- 			[mapEntries keys do:
- 				[:a|
- 				(mapEntries at: a) = #IsNSSendCall ifTrue:
- 					[mapEntries
- 						at: a + backEnd jumpShortByteSize
- 							put: {'Class'. #disassembleCachedOop:. BytesPerWord};
- 						at: a + backEnd jumpShortByteSize + BytesPerOop
- 							put: {'ImplicitReceiver'. #disassembleCachedOop:. BytesPerWord}]]].
  
  	"This would all be far more elegant and simple if we used blocks.
  	 But there are no blocks in C and the basic enumerators here need
  	 to be used in the real VM.  Apologies."
  	(codeRanges := self codeRangesFor: cogMethod) do:
  		[:range|
  		(cogMethod cmType = CMMethod) ifTrue:
  			[mapEntries keysAndValuesDo:
  				[:mcpc :label| | bcpc |
  				((range includes: mcpc)
  				 and: [(#(IsSendCall HasBytecodePC) includes: label)
  				 and: [range cogMethod stackCheckOffset > 0]]) ifTrue:
  					[bcpc := self bytecodePCFor: mcpc startBcpc: range startpc in: range cogMethod.
  					 bcpc ~= 0 ifTrue:
  						[mapEntries at: mcpc put: label, ' bc ', bcpc printString, '/', (bcpc + 1) printString]]]].
  		(cogMethod blockEntryOffset ~= 0
  		 and: [range first = (cogMethod blockEntryOffset + cogMethod asInteger)])
  			ifTrue:
  				[aStream nextPutAll: 'blockEntry:'; cr.
  				 self blockDispatchFor: cogMethod
  					perform: #disassemble:from:to:arg:
  					arg: aStream]
  			ifFalse:
  				[range first > (cogMethod address + cmNoCheckEntryOffset) ifTrue:
  					[self printMethodHeader: range cogMethod
  						on: aStream].
  				self disassembleFrom: range first to: range last labels: mapEntries on: aStream]].
  	aStream nextPutAll: 'startpc: '; print: codeRanges first startpc; cr.
  	(cogMethod cmType = CMMethod
  	 or: [cogMethod cmType = CMOpenPIC]) ifTrue:
  		[[self mapFor: cogMethod
  			performUntil: #printMapEntry:mcpc:args:
  			arg: { aStream. codeRanges. cogMethod }]
  			on: AssertionFailure
  			do: [:ex|
  				ex primitiveChangeClassTo: ResumableVMError basicNew. ":) :) :)"
  				ex resume: nil]].
  	^cogMethod!

Item was changed:
  ----- Method: Cogit>>fillInMethodHeader:size:selector: (in category 'generate machine code') -----
  fillInMethodHeader: method size: size selector: selector
  	<returnTypeC: #'CogMethod *'>
  	<var: #method type: #'CogMethod *'>
  	<var: #originalMethod type: #'CogMethod *'>
  	| methodHeader originalMethod |
  	method cmType: CMMethod.
  	method objectHeader: objectMemory nullHeaderForMachineCodeMethod.
  	method blockSize: size.
  	method methodObject: methodObj.
  	methodHeader := coInterpreter rawHeaderOf: methodObj.
  	"If the method has already been cogged (e.g. Newspeak accessors) then
  	 leave the original method attached to its cog method, but get the right header."
  	(coInterpreter isCogMethodReference: methodHeader)
  		ifTrue:
  			[originalMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'.
  			self assert: originalMethod blockSize = size.
  			methodHeader := originalMethod methodHeader.
+ 			self cppIf: NewspeakVM ifTrue:
+ 				[methodZone addToUnpairedMethodList: method]]
- 			self cppIf: NewspeakVM ifTrue: [methodZone addToUnpairedMethodList: method]]
  		ifFalse:
+ 			[coInterpreter rawHeaderOf: methodObj put: method asInteger.
+ 			self cppIf: NewspeakVM ifTrue:
+ 				[method nextMethodOrIRCs: theIRCs]].
- 			[coInterpreter rawHeaderOf: methodObj put: method asInteger].
  	method methodHeader: methodHeader.
  	method selector: selector.
  	method cmNumArgs: (coInterpreter argumentCountOfMethodHeader: methodHeader).
  	(method cmRefersToYoung: hasYoungReferent) ifTrue:
  		[methodZone addToYoungReferrers: method].
  	method cmUsageCount: self initialMethodUsageCount.
  	method cpicHasMNUCase: false.
  	method cmUsesPenultimateLit: maxLitIndex >= ((coInterpreter literalCountOfHeader: methodHeader) - 2).
  	method cmUsesMethodClass: usesMethodClass.
  	method blockEntryOffset: (blockEntryLabel notNil
  								ifTrue: [blockEntryLabel address - method asInteger]
  								ifFalse: [0]).
  	"This can be an error check since a large stackCheckOffset is caused by compiling
  	 a machine-code primitive, and hence depends on the Cogit, not the input method."
  	needsFrame ifTrue:
  		[stackCheckLabel address - method asInteger <= MaxStackCheckOffset ifFalse:
  			[self error: 'too much code for stack check offset']].
  	method stackCheckOffset: (needsFrame
  								ifTrue: [stackCheckLabel address - method asInteger]
  								ifFalse: [0]).
  	self assert: (backEnd callTargetFromReturnAddress: method asInteger + missOffset)
  				= (self methodAbortTrampolineFor: method cmNumArgs).
  	self assert: size = (methodZone roundUpLength: size).
  	^method!

Item was changed:
  ----- Method: Cogit>>generateNewspeakRuntime (in category 'initialization') -----
  generateNewspeakRuntime
  	<option: #NewspeakVM>
  	| jumpMiss jumpItsTheReceiverStupid retpcReg |
  	<var: #jumpMiss type: #'AbstractInstruction *'>
  	<var: #jumpItsTheReceiverStupid type: #'AbstractInstruction *'>
  	"Generate the non-send runtime support for Newspeak, explicit outer and implicit receiver.
  	 The dynamic frequency of explicit outer is so low we merely call an interpreter routine."
  	ceExplicitReceiverTrampoline := self genTrampolineFor: #ceExplicitReceiverAt:
  										called: 'ceExplicitReceiverTrampoline'
  										arg: SendNumArgsReg
  										result: ReceiverResultReg.
+ 	"Cached push implicit receiver implementation.  If objectRepresentation doesn't support
+ 	 pinning then caller looks like
- 	"Cached push implicit receiver implementation.  Caller looks like
  				mov selector, SendNumArgsReg
  				call ceImplicitReceiver
  				br continue
  		Lclass:	.word
  		Lmixin::	.word
  		continue:
+ 	 If objectRepresentation supports pinning then caller looks like
+ 				mov Lclass, Arg1Reg
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 	 and Lclass: .word; Lmixin: .word is somewhere on the heap.
+ 
  	 If class tag matches class of receiver then mixin contains either 0 or the implicit receiver.
  	 If 0, answer the actual receiver, otherwise the mixin.
  	 Generate the class fetch and cache probe inline for speed.
  	 Smashes Arg1Reg, RegClass and caller-saved regs."
  	opcodeIndex := 0.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	objectRepresentation
  		genGetInlineCacheClassTagFrom: ReceiverResultReg
  		into: ClassReg
  		forEntry: false.
+ 	objectRepresentation canPinObjects
+ 		ifTrue:
+ 			[self MoveMw: 0 r: Arg1Reg R: TempReg.
+ 			 self CmpR: ClassReg R: TempReg.
+ 			 jumpMiss := self JumpNonZero: 0.
+ 			 self MoveMw: BytesPerOop r: Arg1Reg R: TempReg.
+ 			 self CmpCq: 0 R: TempReg.
+ 			 jumpItsTheReceiverStupid := self JumpZero: 0.
+ 			 self MoveR: TempReg R: ReceiverResultReg.
+ 			 jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
+ 			 jumpMiss jmpTarget: self Label.
+ 			 ceImplicitReceiverTrampoline := self
+ 												genTrampolineFor: #ceImplicitReceiverFor:receiver:cache:
+ 												called: 'ceImplicitReceiverTrampoline'
+ 												numArgs: 3
+ 												arg: SendNumArgsReg
+ 												arg: ReceiverResultReg
+ 												arg: Arg1Reg
+ 												arg: nil
+ 												saveRegs: false
+ 												pushLinkReg: true
+ 												resultReg: ReceiverResultReg
+ 												appendOpcodes: true]
+ 		ifFalse:
+ 			[backEnd hasLinkRegister
+ 				ifTrue: [retpcReg := LinkReg]
+ 				ifFalse: [self MoveMw: 0 r: SPReg R: (retpcReg := TempReg)].
+ 			 self MoveMw: 0 r: SPReg R: retpcReg.
+ 			 self MoveMw: backEnd jumpShortByteSize r: retpcReg R: Arg1Reg.
+ 			 self CmpR: ClassReg R: Arg1Reg.
+ 			 jumpMiss := self JumpNonZero: 0.
+ 			 self MoveMw: backEnd jumpShortByteSize + BytesPerOop r: retpcReg R: ClassReg.
+ 			 self CmpCq: 0 R: ClassReg.
+ 			 jumpItsTheReceiverStupid := self JumpZero: 0.
+ 			 self MoveR: ClassReg R: ReceiverResultReg.
+ 			 jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
+ 			 jumpMiss jmpTarget: self Label.
+ 			 ceImplicitReceiverTrampoline := self
+ 												genTrampolineFor: #ceImplicitReceiverFor:receiver:
+ 												called: 'ceImplicitReceiverTrampoline'
+ 												numArgs: 2
+ 												arg: SendNumArgsReg
+ 												arg: ReceiverResultReg
+ 												arg: nil
+ 												arg: nil
+ 												saveRegs: false
+ 												pushLinkReg: true
+ 												resultReg: ReceiverResultReg
+ 												appendOpcodes: true]!
- 	backEnd hasLinkRegister
- 		ifTrue: [retpcReg := LinkReg]
- 		ifFalse: [self MoveMw: 0 r: SPReg R: (retpcReg := TempReg)].
- 
- 	self MoveMw: 0 r: SPReg R: retpcReg.
- 	self MoveMw: backEnd jumpShortByteSize r: retpcReg R: Arg1Reg.
- 	self CmpR: ClassReg R: Arg1Reg.
- 	jumpMiss := self JumpNonZero: 0.
- 	self MoveMw: backEnd jumpShortByteSize + BytesPerOop r: retpcReg R: ClassReg.
- 	self CmpCq: 0 R: ClassReg.
- 	jumpItsTheReceiverStupid := self JumpZero: 0.
- 	self MoveR: ClassReg R: ReceiverResultReg.
- 	jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
- 	jumpMiss jmpTarget: self Label.
- 	ceImplicitReceiverTrampoline := self
- 										genTrampolineFor: #ceImplicitReceiverFor:receiver:
- 										called: 'ceImplicitReceiverTrampoline'
- 										numArgs: 2
- 										arg: SendNumArgsReg
- 										arg: ReceiverResultReg
- 										arg: nil
- 										arg: nil
- 										saveRegs: false
- 										pushLinkReg: true
- 										resultReg: ReceiverResultReg
- 										appendOpcodes: true!

Item was added:
+ ----- Method: Cogit>>implicitReceiverCacheAddressAt: (in category 'newspeak support') -----
+ implicitReceiverCacheAddressAt: mcpc
+ 	"Cached push implicit receiver implementation.  If objectRepresentation doesn't support
+ 	 pinning then caller looks like
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 				br continue
+ 		Lclass:	.word
+ 		Lmixin::	.word
+ 		continue:
+ 	 If objectRepresentation supports pinning then caller looks like
+ 				mov Lclass, Arg1Reg
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 	 and Lclass: .word; Lmixin: .word is somewhere on the heap."
+ 	<inline: true>
+ 	^objectRepresentation canPinObjects
+ 		ifTrue:
+ 			[backEnd implicitReceiveCacheAt: mcpc]
+ 		ifFalse:
+ 			[mcpc asUnsignedInteger + backEnd jumpShortByteSize]!

Item was changed:
  ----- Method: Cogit>>markAndTraceLiteralsIn: (in category 'garbage collection') -----
  markAndTraceLiteralsIn: cogMethod
  	<option: #SpurMemoryManager>
  	"Unlink sends that have unmarked classes in inline caches or freed/freeable targets.
  	 Nil-out inline caches linked to open PICs.
  	 Assert that any selectors are marked.  We can do this since
  	 this is only run on marked methods and thus any selectors they
  	 reference should already be marked."
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: true>
  	self assert: ((cogMethod cmType = CMMethod
  				 and: [objectMemory isMarked: cogMethod methodObject])
  				 or: [cogMethod cmType = CMOpenPIC
  				 and: [(objectMemory isImmediate: cogMethod selector)
  					or: [objectMemory isMarked: cogMethod selector]]]).
  	objectRepresentation markAndTraceLiteral: cogMethod selector.
  	self maybeMarkCountersIn: cogMethod.
+ 	self maybeMarkIRCsIn: cogMethod.
  	self mapFor: cogMethod
  		 performUntil: #markLiterals:pc:method:
  		 arg: cogMethod asInteger!

Item was changed:
  ----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection') -----
  markLiterals: annotation pc: mcpc method: cogMethod
  	"Mark and trace literals.
  	 Additionally in Newspeak, void push implicits that have unmarked classes."
  	<var: #mcpc type: #'char *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 objectRepresentation markAndTraceLiteral: literal].
  	(self isSendAnnotation: annotation) ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj |
  			 tagCouldBeObj ifTrue:
  				[objectRepresentation markAndTraceLiteral: cacheTag].  "cacheTag is selector"
  			  self cppIf: NewspeakVM ifTrue:
  				[entryPoint = ceImplicitReceiverTrampoline ifTrue:
+ 					[| cacheAddress class mixin |
+ 					 self assert: NumOopsPerIRC = 2.
+ 					 cacheAddress := self implicitReceiverCacheAddressAt: mcpc.
+ 					 class := backEnd unalignedLongAt: cacheAddress.
- 					[| classpc mixinpc class mixin |
- 					 classpc := mcpc asInteger + backEnd jumpShortByteSize.
- 					 mixinpc := mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop.
- 					 class := backEnd unalignedLongAt: classpc.
  					 class ~= 0
  						ifTrue:
  							[(objectRepresentation cacheTagIsMarked: class)
  								ifTrue:
+ 									[(mixin := backEnd unalignedLongAt: cacheAddress + BytesPerOop) ~= 0 ifTrue:
- 									[(mixin := backEnd unalignedLongAt: mixinpc) ~= 0 ifTrue:
  										[objectRepresentation markAndTraceLiteral: mixin]]
  								ifFalse:
  									[backEnd
+ 										unalignedLongAt: cacheAddress put: 0;
+ 										unalignedLongAt: cacheAddress + BytesPerOop put: 0.
- 										unalignedLongAt: classpc put: 0;
- 										unalignedLongAt: mixinpc put: 0.
  									 codeModified := true]]
  						ifFalse:
+ 							[self assert: (backEnd unalignedLongAt: cacheAddress + BytesPerOop) = 0]]]]].
- 							[self assert: (backEnd unalignedLongAt: mixinpc) = 0]]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection') -----
  markLiteralsAndUnlinkIfUnmarkedSend: annotation pc: mcpc method: cogMethod
  	"Mark and trace literals.  Unlink sends that have unmarked cache tags or targets."
  	<var: #mcpc type: #'char *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 objectRepresentation markAndTraceLiteral: literal].
  	(self isSendAnnotation: annotation) ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
  			 cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
  			 entryPoint > methodZoneBase
  				ifTrue: "It's a linked send."
  					[self targetMethodAndSendTableFor: entryPoint into:
  						[:targetMethod :sendTable| | unlinkedRoutine |
  						 (cacheTagMarked not
  						  or: [self markAndTraceOrFreeCogMethod: targetMethod firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger]) ifTrue:
  							["Either the cacheTag is unmarked (e.g. new class) or the target
  							  has been freed (because it is unmarked), so unlink the send."
  							 unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  							 backEnd
  								rewriteInlineCacheAt: mcpc asInteger
  								tag: targetMethod selector
  								target: unlinkedRoutine.
  							 codeModified := true.
  							 objectRepresentation markAndTraceLiteral: targetMethod selector]]]
  				ifFalse:
  					[objectRepresentation markAndTraceLiteral: cacheTag.  "cacheTag is selector"
  					 self cppIf: NewspeakVM ifTrue:
  						[entryPoint = ceImplicitReceiverTrampoline ifTrue:
+ 							[| cacheAddress class mixin |
- 							[| classpc mixinpc class mixin |
  							 objectRepresentation markAndTraceLiteral: cacheTag.  "cacheTag is selector"
+ 							 self assert: NumOopsPerIRC = 2.
+ 							 cacheAddress := self implicitReceiverCacheAddressAt: mcpc.
+ 							 class := backEnd unalignedLongAt: cacheAddress.
- 							 classpc := mcpc asInteger + backEnd jumpShortByteSize.
- 							 mixinpc := mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop.
- 							 class := backEnd unalignedLongAt: classpc.
  							 class ~= 0
  								ifTrue:
  									[(objectRepresentation cacheTagIsMarked: class)
  										ifTrue:
+ 											[(mixin := backEnd unalignedLongAt: cacheAddress + BytesPerOop) ~= 0 ifTrue:
- 											[(mixin := backEnd unalignedLongAt: mixinpc) ~= 0 ifTrue:
  												[objectRepresentation markAndTraceLiteral: mixin]]
  										ifFalse:
  											[backEnd
+ 												unalignedLongAt: cacheAddress put: 0;
+ 												unalignedLongAt: cacheAddress + BytesPerOop put: 0.
- 												unalignedLongAt: classpc put: 0;
- 												unalignedLongAt: mixinpc put: 0.
  											 codeModified := true]]
  								ifFalse:
+ 									[self assert: (backEnd unalignedLongAt: cacheAddress + BytesPerOop) = 0]]]]]].
- 									[self assert: (backEnd unalignedLongAt: mixinpc) = 0]]]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markLiteralsAndUnlinkUnmarkedSendsIn: (in category 'garbage collection') -----
  markLiteralsAndUnlinkUnmarkedSendsIn: cogMethod
  	"Unlink sends that have unmarked classes in inline caches or freed/freeable targets.
  	 Nil-out inline caches linked to open PICs.
  	 Assert that any selectors are marked.  We can do this since
  	 this is only run on marked methods and thus any selectors they
  	 reference should already be marked."
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: true>
  	self assert: cogMethod cmType = CMMethod.
  	self assert: (objectMemory isMarked: cogMethod methodObject).
  	objectRepresentation markAndTraceLiteral: cogMethod selector.
  	self maybeMarkCountersIn: cogMethod.
+ 	self maybeMarkIRCsIn: cogMethod.
  	self mapFor: cogMethod
  		 performUntil: #markLiteralsAndUnlinkIfUnmarkedSend:pc:method:
  		 arg: cogMethod asInteger!

Item was changed:
  ----- Method: Cogit>>markYoungObjects:pc:method: (in category 'garbage collection') -----
  markYoungObjects: annotation pc: mcpc method: cogMethod
  	"Mark and trace young literals."
  	<var: #mcpc type: #'char *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 objectRepresentation markAndTraceLiteralIfYoung: literal].
  	(self isSendAnnotation: annotation) ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj |
  			 tagCouldBeObj ifTrue:
  				[objectRepresentation markAndTraceLiteralIfYoung: cacheTag].
  				 self cppIf: NewspeakVM ifTrue:
  					[entryPoint = ceImplicitReceiverTrampoline ifTrue:
+ 						[| cacheAddress class mixin |
+ 						 self assert: NumOopsPerIRC = 2.
+ 						 cacheAddress := self implicitReceiverCacheAddressAt: mcpc.
+ 						 class := backEnd unalignedLongAt: cacheAddress.
+ 						 class ~= 0 ifTrue:
- 						[| class mixin |
- 						 (class := backEnd unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize) ~= 0 ifTrue:
  							[objectRepresentation inlineCacheTagsMayBeObjects ifTrue:
  								[objectRepresentation markAndTraceLiteralIfYoung: class].
+ 							 mixin := backEnd unalignedLongAt: cacheAddress + BytesPerOop.
- 							 mixin := backEnd unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop.
  							 objectRepresentation markAndTraceLiteralIfYoung: mixin]]]]].
  	^0 "keep scanning"!

Item was added:
+ ----- Method: Cogit>>maybeAllocAndInitIRCs (in category 'newspeak support') -----
+ maybeAllocAndInitIRCs
+ 	"If this is the Newspeak VM and the objectRepresentation supports pinning
+ 	 then allocate space for the implicit receiver caches on the heap."
+ 	self cppIf: #NewspeakVM
+ 		ifTrue:
+ 			[indexOfIRC := theIRCs := 0.
+ 			 (objectRepresentation canPinObjects and: [numIRCs > 0]) ifTrue:
+ 				[self assert: (self noAssertMethodClassAssociationOf: methodObj) ~= objectMemory nilObject.
+ 				 theIRCs := objectRepresentation allocateNPinnedSlots: numIRCs * NumOopsPerIRC.
+ 				 ^theIRCs ~= 0].
+ 			 ^true]
+ 		ifFalse:
+ 			[^true]!

Item was added:
+ ----- Method: Cogit>>maybeMarkIRCsIn: (in category 'newspeak support') -----
+ maybeMarkIRCsIn: cogMethod
+ 	<inline: true>
+ 	self cppIf: #NewspeakVM ifTrue:
+ 		[objectRepresentation canPinObjects ifTrue:
+ 			[objectRepresentation markIfIRC: cogMethod nextMethodOrIRCs]]!

Item was changed:
  ----- Method: Cogit>>printMethodHeader:on: (in category 'disassembly') -----
  printMethodHeader: cogMethod on: aStream
  	<doNotGenerate>
  	self cCode: ''
  		inSmalltalk:
  			[cogMethod isInteger ifTrue:
  				[^self printMethodHeader: (self cogMethodOrBlockSurrogateAt: cogMethod) on: aStream]].
  	aStream ensureCr.
  	cogMethod asInteger printOn: aStream base: 16.
  	aStream crtab.
  	cogMethod cmType = CMMethod ifTrue:
  		[aStream nextPutAll: 'objhdr: '.
  		cogMethod objectHeader printOn: aStream base: 16].
  	cogMethod cmType = CMBlock ifTrue:
  		[aStream nextPutAll: 'homemth: '.
  		cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16.
  		aStream crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
  	aStream
  		crtab; nextPutAll: 'nArgs: ';	print: cogMethod cmNumArgs;
  		tab;    nextPutAll: 'type: ';	print: cogMethod cmType.
  	(cogMethod cmType ~= 0 and: [cogMethod cmType ~= CMBlock]) ifTrue:
  		[aStream crtab; nextPutAll: 'blksiz: '.
  		cogMethod blockSize printOn: aStream base: 16.
  		aStream crtab; nextPutAll: 'method: '.
  		cogMethod methodObject printOn: aStream base: 16.
  		aStream crtab; nextPutAll: 'mthhdr: '.
  		cogMethod methodHeader printOn: aStream base: 16.
  		aStream crtab; nextPutAll: 'selctr: '.
  		cogMethod selector printOn: aStream base: 16.
  		(coInterpreter lookupAddress: cogMethod selector) ifNotNil:
  			[:string| aStream nextPut: $=; nextPutAll: string].
  		aStream crtab; nextPutAll: 'blkentry: '.
  		cogMethod blockEntryOffset printOn: aStream base: 16.
  		cogMethod blockEntryOffset ~= 0 ifTrue:
  			[aStream nextPutAll: ' => '.
  			 cogMethod asInteger + cogMethod blockEntryOffset printOn: aStream base: 16]].
  	cogMethod cmType = CMClosedPIC
  		ifTrue:
  			[aStream crtab; nextPutAll: 'cPICNumCases: '.
  			 cogMethod cPICNumCases printOn: aStream base: 16.]
  		ifFalse:
  			[aStream crtab; nextPutAll: 'stackCheckOffset: '.
  			 cogMethod stackCheckOffset printOn: aStream base: 16.
  			 cogMethod stackCheckOffset > 0 ifTrue:
  				[aStream nextPut: $/.
  				 cogMethod asInteger + cogMethod stackCheckOffset printOn: aStream base: 16].
  			cogMethod cmType ~= CMBlock ifTrue:
  				[aStream
  					crtab;
  					nextPutAll: 'cmRefersToYoung: ';
  					nextPutAll: (cogMethod cmRefersToYoung ifTrue: ['yes'] ifFalse: ['no'])].
  			cogMethod cmType = CMMethod ifTrue:
+ 				[([cogMethod nextMethodOrIRCs] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
+ 					[:nmoircs| aStream crtab; nextPutAll: 'nextMethodOrIRCs: '.
+ 						nmoircs = 0 ifTrue: [aStream print: nmoircs] ifFalse: [self printHex: nmoircs]].
+ 				 ([cogMethod counters] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
- 				[([cogMethod counters] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
  					[:cntrs| aStream crtab; nextPutAll: 'counters: '.
  						cntrs = 0 ifTrue: [aStream print: cntrs] ifFalse: [self printHex: cntrs]]]].
  	aStream cr; flush!

Item was changed:
  ----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
  remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
  	<var: #mcpc type: #'char *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	annotation = IsObjectReference ifTrue:
  		[| literal mappedLiteral |
  		 literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (objectRepresentation couldBeObject: literal) ifTrue:
  			[mappedLiteral := objectRepresentation remapObject: literal.
  			 literal ~= mappedLiteral ifTrue:
  				[backEnd storeLiteral: mappedLiteral beforeFollowingAddress: mcpc asInteger.
  				 codeModified := true].
  			 (hasYoungPtr ~= 0
  			  and: [objectMemory isYoung: mappedLiteral]) ifTrue:
  				[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
  	(self isSendAnnotation: annotation) ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj | | mappedCacheTag |
  			 (tagCouldBeObj
  			  and: [objectRepresentation couldBeObject: cacheTag]) ifTrue:
  				[mappedCacheTag := objectRepresentation remapObject: cacheTag.
  				 cacheTag ~= mappedCacheTag ifTrue:
  					[backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asInteger.
  					 codeModified := true].
  				 (hasYoungPtr ~= 0
  				  and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
  					[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  			 (self cppIf: NewspeakVM
  					ifTrue: [entryPoint = ceImplicitReceiverTrampoline]
  					ifFalse: [false])
  				ifTrue: "Examine an implicit receiver cache."
+ 					[| cacheAddress oop mappedOop |
+ 					 self assert: NumOopsPerIRC = 2.
+ 					 cacheAddress := self implicitReceiverCacheAddressAt: mcpc.
+ 					 (oop := backEnd unalignedLongAt: cacheAddress) ~= 0 ifTrue:
- 					[| pc oop mappedOop |
- 					 pc := mcpc asInteger + backEnd jumpShortByteSize.
- 					 (oop := backEnd unalignedLongAt: pc) ~= 0 ifTrue:
  						["First look at the classTag entry.  This is an inline cache tag and so might not be an object."
  						 (objectRepresentation inlineCacheTagsMayBeObjects
  						  and: [objectRepresentation couldBeObject: oop]) ifTrue:
  							[mappedOop := objectRepresentation remapOop: oop.
  							 mappedOop ~= oop ifTrue:
+ 								[backEnd unalignedLongAt: cacheAddress put: mappedOop].
- 								[backEnd unalignedLongAt: pc put: mappedOop].
  							 (hasYoungPtr ~= 0
  							  and: [objectMemory isYoung: mappedOop]) ifTrue:
  								[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
+ 						 "Second look at the mixin entry. this must be 0 or an object."
+ 						 (oop := backEnd unalignedLongAt: cacheAddress + BytesPerOop) ~= 0 ifTrue:
- 						 "Second look at the mixin entry. this must be 0 or an objct."
- 						 pc := mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop.
- 						 (oop := backEnd unalignedLongAt: pc) ~= 0 ifTrue:
  							[mappedOop := objectRepresentation remapOop: oop.
  							 mappedOop ~= oop ifTrue:
+ 								[backEnd unalignedLongAt: cacheAddress + BytesPerOop put: mappedOop].
- 								[backEnd unalignedLongAt: pc put: mappedOop].
  							 (hasYoungPtr ~= 0
  							  and: [objectMemory isYoung: mappedOop]) ifTrue:
  								[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]
  				ifFalse:
  					[hasYoungPtr ~= 0 ifTrue:
  						["Since the unlinking routines may rewrite the cacheTag to the send's selector, and
  						  since they don't have the cogMethod to hand and can't add it to youngReferrers,
  						  the method must remain in youngReferrers if the targetMethod's selector is young."
  						 entryPoint > methodZoneBase ifTrue: "It's a linked send."
  							[self targetMethodAndSendTableFor: entryPoint into:
  								[:targetMethod :ignored|
  								 (objectMemory isYoung: targetMethod selector) ifTrue:
  									[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	inBlock := false.
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := 0.
+ 	self cppIf: #NewspeakVM ifTrue:
+ 		[numIRCs := 0].
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		descriptor := self generatorAt: byte0.
  		(descriptor isReturn
  		 and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse: [latestContinuation := latestContinuation max: targetPC]].
  		descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
+ 		self cppIf: #NewspeakVM ifTrue:
+ 			[descriptor hasIRC ifTrue:
+ 				[numIRCs := numIRCs + 1]].
  		pc := pc + descriptor numBytes.
  		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	^numBlocks!

Item was changed:
  ----- Method: Cogit>>unlinkIfFreeOrLinkedSend:pc:of: (in category 'in-line cacheing') -----
  unlinkIfFreeOrLinkedSend: annotation pc: mcpc of: theSelector
  	<var: #mcpc type: #'char *'>
  	| entryPoint |
  	(self isSendAnnotation: annotation) ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
  				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| | unlinkedRoutine |
  					 (targetMethod cmType = CMFree
  					  or: [targetMethod selector = theSelector]) ifTrue:
  						[unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  						 backEnd
  							rewriteInlineCacheAt: mcpc asInteger
  							tag: targetMethod selector
  							target: unlinkedRoutine.
  						 codeModified := true]]]
  			ifFalse:
  				[self cppIf: NewspeakVM ifTrue:
  					[(entryPoint = ceImplicitReceiverTrampoline
  					 and: [(backEnd inlineCacheTagAt: mcpc asInteger) = theSelector]) ifTrue:
+ 					 	[self voidImplicitReceiverCacheAt: mcpc]]]].
- 					 	[backEnd
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0;
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSend:pc:ignored: (in category 'in-line cacheing') -----
  unlinkIfLinkedSend: annotation pc: mcpc ignored: superfluity
  	<var: #mcpc type: #'char *'>
  	| entryPoint |
  	(self isSendAnnotation: annotation) ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
  				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| | unlinkedRoutine |
  					 unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  					 backEnd
  						rewriteInlineCacheAt: mcpc asInteger
  						tag: targetMethod selector
  						target: unlinkedRoutine]]
  			ifFalse:
  				[self cppIf: NewspeakVM ifTrue:
  					[entryPoint = ceImplicitReceiverTrampoline ifTrue:
+ 						[self voidImplicitReceiverCacheAt: mcpc]]]].
- 						[backEnd
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0;
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSend:pc:of: (in category 'in-line cacheing') -----
  unlinkIfLinkedSend: annotation pc: mcpc of: theSelector
  	<var: #mcpc type: #'char *'>
  	| entryPoint |
  	(self isSendAnnotation: annotation) ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
  				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| | unlinkedRoutine |
  					 targetMethod selector = theSelector ifTrue:
  						[unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  						 backEnd
  							rewriteInlineCacheAt: mcpc asInteger
  							tag: targetMethod selector
  							target: unlinkedRoutine.
  						 codeModified := true]]]
  			ifFalse:
  				[self cppIf: NewspeakVM ifTrue:
  					[(entryPoint = ceImplicitReceiverTrampoline
  					  and: [(backEnd inlineCacheTagAt: mcpc asInteger) = theSelector]) ifTrue:
+ 						[self voidImplicitReceiverCacheAt: mcpc]]]].
- 						[backEnd
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0;
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSend:pc:to: (in category 'in-line cacheing') -----
  unlinkIfLinkedSend: annotation pc: mcpc to: theCogMethod
  	<var: #mcpc type: #'char *'>
  	| entryPoint |
  	(self isSendAnnotation: annotation) ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
  				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| | unlinkedRoutine |
  					 targetMethod asInteger = theCogMethod ifTrue:
  						[unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  						 backEnd
  							rewriteInlineCacheAt: mcpc asInteger
  							tag: targetMethod selector
  							target: unlinkedRoutine.
  						 codeModified := true]]]
  			ifFalse: "Can't tell the target with PushReciver/SendImplicit so flush anyway."
  				[self cppIf: NewspeakVM ifTrue:
  					[entryPoint = ceImplicitReceiverTrampoline ifTrue:
+ 						[self voidImplicitReceiverCacheAt: mcpc]]]].
- 						[backEnd
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0;
- 							unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]].
  	^0 "keep scanning"!

Item was added:
+ ----- Method: Cogit>>voidImplicitReceiverCacheAt: (in category 'newspeak support') -----
+ voidImplicitReceiverCacheAt: mcpc
+ 	"Cached push implicit receiver implementation.  If objectRepresentation doesn't support
+ 	 pinning then caller looks like
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 				br continue
+ 		Lclass:	.word
+ 		Lmixin::	.word
+ 		continue:
+ 	 If objectRepresentation supports pinning then caller looks like
+ 				mov Lclass, Arg1Reg
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 	 and Lclass: .word; Lmixin: .word is somewhere on the heap."
+ 
+ 	| cacheAddress |
+ 	self assert: NumOopsPerIRC = 2.
+ 	cacheAddress := self implicitReceiverCacheAddressAt: mcpc.
+ 	backEnd
+ 		unalignedLongAt: cacheAddress put: 0;
+ 		unalignedLongAt: cacheAddress + BytesPerOop put: 0!

Item was changed:
  CogMethod subclass: #NewspeakCogMethod
+ 	instanceVariableNames: 'nextMethodOrIRCs'
- 	instanceVariableNames: 'nextMethod'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was removed:
- ----- Method: NewspeakCogMethod>>nextMethod (in category 'accessing') -----
- nextMethod
- 	"Answer the value of nextMethod"
- 
- 	^ nextMethod!

Item was removed:
- ----- Method: NewspeakCogMethod>>nextMethod: (in category 'accessing') -----
- nextMethod: anObject
- 	"Set the value of nextMethod"
- 
- 	^nextMethod := anObject!

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

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

Item was removed:
- ----- Method: NewspeakCogMethodSurrogate32>>nextMethod (in category 'accessing') -----
- nextMethod
- 	| v |
- 	^(v := memory unsignedLongAt: address + 21 + baseHeaderSize) ~= 0 ifTrue:
- 		[cogit cCoerceSimple: v to: #'CogMethod *']!

Item was removed:
- ----- Method: NewspeakCogMethodSurrogate32>>nextMethod: (in category 'accessing') -----
- nextMethod: aValue
- 	^memory
- 		unsignedLongAt: address + baseHeaderSize + 21
- 		put: ((aValue ifNotNil: [aValue asUnsignedInteger] ifNil: [0]))!

Item was added:
+ ----- Method: NewspeakCogMethodSurrogate32>>nextMethodOrIRCs (in category 'accessing') -----
+ nextMethodOrIRCs
+ 	^memory unsignedLongAt: address + 21 + baseHeaderSize!

Item was added:
+ ----- Method: NewspeakCogMethodSurrogate32>>nextMethodOrIRCs: (in category 'accessing') -----
+ nextMethodOrIRCs: aValue
+ 	^memory
+ 		unsignedLongAt: address + baseHeaderSize + 21
+ 		put: aValue!

Item was removed:
- ----- Method: NewspeakCogMethodSurrogate64>>nextMethod (in category 'accessing') -----
- nextMethod
- 	| v |
- 	^(v := memory unsignedLongLongAt: address + 33 + baseHeaderSize) ~= 0 ifTrue:
- 		[cogit cCoerceSimple: v to: #'CogMethod *']!

Item was removed:
- ----- Method: NewspeakCogMethodSurrogate64>>nextMethod: (in category 'accessing') -----
- nextMethod: aValue
- 	^memory
- 		unsignedLongLongAt: address + baseHeaderSize + 33
- 		put: ((aValue ifNotNil: [aValue asUnsignedInteger] ifNil: [0]))!

Item was added:
+ ----- Method: NewspeakCogMethodSurrogate64>>nextMethodOrIRCs (in category 'accessing') -----
+ nextMethodOrIRCs
+ 	^memory unsignedLongLongAt: address + 33 + baseHeaderSize!

Item was added:
+ ----- Method: NewspeakCogMethodSurrogate64>>nextMethodOrIRCs: (in category 'accessing') -----
+ nextMethodOrIRCs: aValue
+ 	^memory
+ 		unsignedLongLongAt: address + baseHeaderSize + 33
+ 		put: aValue!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV3PlusClosures
  	"SimpleStackBasedCogit initializeBytecodeTableForNewspeakV3PlusClosures"
  
  	NSSendIsPCAnnotated := true. "IsNSSendCall used by PushImplicitReceiver"
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		(1    0   15 genPushReceiverVariableBytecode)
  		(1  16   31 genPushTemporaryVariableBytecode)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   95 genPushLiteralVariableBytecode needsFrameNever: 1)
  		(1  96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 104 111 genStoreAndPopTemporaryVariableBytecode)
  		(1 112 112 genPushReceiverBytecode)
  		(1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
  		(1 114 114 genPushConstantFalseBytecode needsFrameNever: 1)
  		(1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
  		(1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1)
  		"method returns in blocks need a frame because of nonlocalReturn:through:"
  		(1 120 120 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 121 121 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 122 122 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 123 123 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 124 124 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 125 125 genReturnTopFromBlock		return needsFrameNever: -1)
  
+ 		(3 126 126 genDynamicSuperSendBytecode isMapped)			"Newspeak"
+ 		(2 127 127 genPushImplicitReceiverBytecode isMapped hasIRC)	"Newspeak"
- 		(3 126 126 genDynamicSuperSendBytecode isMapped)		"Newspeak"
- 		(2 127 127 genPushImplicitReceiverBytecode isMapped)	"Newspeak"
  
  		(2 128 128 extendedPushBytecode needsFrameNever: 1)
  		(2 129 129 extendedStoreBytecode)
  		(2 130 130 extendedStoreAndPopBytecode)
  		(2 131 131 genExtendedSendBytecode isMapped)
  		(3 132 132 doubleExtendedDoAnythingBytecode isMapped)
  		(2 133 133 genExtendedSuperBytecode isMapped)
  		(2 134 134 genSecondExtendedSendBytecode isMapped)
  		(1 135 135 genPopStackBytecode needsFrameNever: -1)
  		(1 136 136 duplicateTopBytecode needsFrameNever: 1)
  
  		(1 137 137 genPushActiveContextBytecode)
  		(2 138 138 genPushNewArrayBytecode)
  
  		(2 139 139 genPushExplicitOuterReceiverBytecode isMapped)	"Newspeak"
  
  		(3 140 140 genPushRemoteTempLongBytecode)
  		(3 141 141 genStoreRemoteTempLongBytecode)
  		(3 142 142 genStoreAndPopRemoteTempLongBytecode)
  		(4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:)
  
  		(1 144 151 genShortUnconditionalJump			branch v3:ShortForward:Branch:Distance:)
  		(1 152 159 genShortJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
  															v3:ShortForward:Branch:Distance:)
  		(2 160 163 genLongUnconditionalBackwardJump	branch isMapped "because of interrupt check"
  															v3:Long:Branch:Distance:)
  		(2 164 167 genLongUnconditionalForwardJump		branch v3:Long:Branch:Distance:)
  		(2 168 171 genLongJumpIfTrue					branch isBranchTrue isMapped "because of mustBeBoolean"
  															v3:LongForward:Branch:Distance:)
  		(2 172 175 genLongJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
  															v3:LongForward:Branch:Distance:)
  
  		(1 176 197 genSpecialSelectorSend isMapped)
  		(1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 199 199 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 200 207 genSpecialSelectorSend isMapped)
  		(1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV4
  	"SimpleStackBasedCogit initializeBytecodeTableForNewspeakV4"
  
  	NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		"1 byte bytecodes"
  		(1    0   15 genPushReceiverVariableBytecode)
  		(1  16   31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode)
  		(1  76   76 genPushReceiverBytecode)
  		(1  77   77 genExtPushPseudoVariableOrOuterBytecode)
  		(1  78   78 genPushConstantZeroBytecode)
  		(1  79   79 genPushConstantOneBytecode)
  
  		(1   80 101 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #at: #at:put: #size #next #nextPut: #atEnd"
  		(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 103 103 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
+ 		(1 160 175	genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
- 		(1 160 175	genSendAbsentImplicit0ArgsBytecode isMapped)
  
  		(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 184 191 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 192 199 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 200 207 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 208 215 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		(1 216 216 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 217 217 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 218 218 genExtReturnTopFromBlock	return needsFrameNever: -1)
  
  		(1 219 219 duplicateTopBytecode			needsFrameNever: 1)
  		(1 220 220 genPopStackBytecode			needsFrameNever: -1)
  		(1 221 221 genExtNopBytecode			needsFrameNever: 0)
  		(1 222 223	unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  		(2 226 226 genExtPushReceiverVariableBytecode)
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 230 230 genLongPushTemporaryVariableBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtStoreReceiverVariableBytecode)
  		(2 233 233 genExtStoreLiteralVariableBytecode)
  		(2 234 234 genLongStoreTemporaryVariableBytecode)
  		(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
  		(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
  		(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
  
  		(2 238 238 genExtSendBytecode isMapped)
  		(2 239 239 genExtSendSuperBytecode isMapped)
+ 		(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
- 		(2 240 240 genExtSendAbsentImplicitBytecode isMapped)
  		(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
  
  		(2 242 242 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 243 243 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 244 244 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		(2 245 248	unknownBytecode)
  
  		"3 byte bytecodes"
  		(3 249 249 callPrimitiveBytecode)
  		(3 250 250 genPushRemoteTempLongBytecode)
  		(3 251 251 genStoreRemoteTempLongBytecode)
  		(3 252 252 genStoreAndPopRemoteTempLongBytecode)
  		(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
  
  		(3 254 255	unknownBytecode))!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileFrameBuild (in category 'compile abstract instructions') -----
  compileFrameBuild
  	"Build a frame for a CogMethod activation.  See CoInterpreter class>>initializeFrameIndices.
  	 		receiver (in ReceiverResultReg)
  			arg0
  			...
  			argN
  			caller's saved ip/this stackPage (for a base frame)
  	fp->	saved fp
  			method
  			context (uninitialized?)
  			receiver
  			first temp
  			...
  	sp->	Nth temp
  	If there is a primitive and an error code the Nth temp is the error code.
  	Ensure SendNumArgsReg is set early on (incidentally to nilObj) because
  	it is the flag determining whether context switch is allowed on stack-overflow."
  	| methodHeader jumpSkip |
  	<inline: false>
  	<var: #jumpSkip type: #'AbstractInstruction *'>
  	needsFrame ifFalse: [^0].
  	methodHeader := coInterpreter headerOf: methodObj.
  	backEnd hasLinkRegister ifTrue: [self PushR: LinkReg].
  	self PushR: FPReg.
  	self MoveR: SPReg R: FPReg.
  	methodLabel addDependent: (self annotateAbsolutePCRef:
  		(self PushCw: methodLabel asInteger)). "method"
  	self annotate: (self MoveCw: objectMemory nilObject R: SendNumArgsReg)
  		objRef: objectMemory nilObject.
  	self PushR: SendNumArgsReg. "context"
  	self PushR: ReceiverResultReg.
  	methodOrBlockNumArgs + 1 to: (coInterpreter temporaryCountOfMethodHeader: methodHeader) do:
  		[:i|
  		self PushR: SendNumArgsReg].
  	(primitiveIndex > 0
  	 and: [(coInterpreter longStoreBytecodeForHeader: methodHeader)
  			= (objectMemory
  				fetchByte: initialPC + (coInterpreter sizeOfCallPrimitiveBytecode: methodHeader)
  				ofObject: methodObj)]) ifTrue:
  		[self compileGetErrorCode.
  		 initialPC := initialPC
  				   + (coInterpreter sizeOfCallPrimitiveBytecode: methodHeader)
  				   + (coInterpreter sizeOfLongStoreTempBytecode: methodHeader)].
  	self MoveAw: coInterpreter stackLimitAddress R: TempReg.
  	self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
  	"If we can't context switch for this method, use a slightly
  	 slower overflow check that clears SendNumArgsReg."
  	(coInterpreter canContextSwitchIfActivating: methodObj header: methodHeader)
  		ifTrue:
  			[self JumpBelow: stackOverflowCall.
  			 stackCheckLabel := self Label]
  		ifFalse:
  			[jumpSkip := self JumpAboveOrEqual: 0.
  			 self MoveCq: 0 R: SendNumArgsReg.
  			 self Jump: stackOverflowCall.
  			 jumpSkip jmpTarget: (stackCheckLabel := self Label)].
+ 	self annotateBytecode: stackCheckLabel.
+ 	self cppIf: #NewspeakVM ifTrue:
+ 		[numIRCs > 0 ifTrue:
+ 		 	[self PrefetchAw: theIRCs]]!
- 	self annotateBytecode: stackCheckLabel!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genGetImplicitReceiverFor:forPush: (in category 'bytecode generators') -----
  genGetImplicitReceiverFor: selector forPush: forPushSendBar
+ 	"Cached implicit receiver implementation.  If objectRepresentation doesn't support
+ 	 pinning then caller looks like
+ 				mov selector, ClassReg
- 	"Cached implicit receiver implementation.  Caller looks like
- 		mov selector, ClassReg
  				call ceImplicitReceiverTrampoline
  				br continue
  		Lclass	.word
  		Lmixin:	.word
  		continue:
+ 	 If objectRepresentation supports pinning then caller looks like
+ 				mov Lclass, Arg1Reg
+ 				mov selector, SendNumArgsReg
+ 				call ceImplicitReceiver
+ 	 and Lclass: .word; Lmixin: .word is somewhere on the heap.
+ 
  	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
  	 If 0, answer the actual receiver.  This is done in the trampoline.
  	 See generateNewspeakRuntime."
  
  	| skip |
  	<var: #skip type: #'AbstractInstruction *'>
  	"N.B. For PC mapping either this is used for SendAbsentImplicit or for PushAbsentReceiver
  	 but not both.  So any Newspeak instruction set has to choose either SendAbsentImplicit
  	 or PushImplicitReceiver.  See isPCMappedAnnotation:alternateInstructionSet:"
  	self assert: forPushSendBar = (self isPCMappedAnnotation: IsNSSendCall
  										alternateInstructionSet: bytecodeSetOffset > 0).
+ 	self assert: (self noAssertMethodClassAssociationOf: methodObj) ~= objectMemory nilObject.
+ 	self assert: needsFrame.
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
+ 	objectRepresentation canPinObjects ifTrue:
+ 		[self MoveCw: theIRCs + (2 * BytesPerOop * indexOfIRC) R: Arg1Reg.
+ 		 self MoveCw: selector R: SendNumArgsReg.
+ 		 self CallNewspeakSend: ceImplicitReceiverTrampoline.
+ 		 indexOfIRC := indexOfIRC + 1.
+ 		 ^0].
- 	self assert: needsFrame.
  	self MoveCw: selector R: SendNumArgsReg.
  	self CallNewspeakSend: ceImplicitReceiverTrampoline.
  	skip := self Jump: 0.
  	self Fill32: 0.
  	self Fill32: 0.
  	skip jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	"override to maintain counterIndex when recompiling blocks; sigh."
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
+ 	  initialStackPtr initialOpcodeIndex initialAnnotationIndex initialCounterIndex initialIndexOfIRC |
- 	  initialStackPtr initialOpcodeIndex initialAnnotationIndex initialCounterIndex |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
  	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		 self scanBlock: blockStart.
  		 initialOpcodeIndex := opcodeIndex.
  		 initialAnnotationIndex := annotationIndex.
  		 initialCounterIndex := counterIndex.
+ 		 self cppIf: #NewspeakVM ifTrue:
+ 			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + ((self pushNilSize: methodObj) * blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
  									[:i|
  									abstractOpcodes
  										at: i
  										put: (processor abstractInstructionCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
  				 annotationIndex := initialAnnotationIndex.
+ 				 counterIndex := initialCounterIndex.
+ 				 self cppIf: #NewspeakVM ifTrue:
+ 					[indexOfIRC := initialIndexOfIRC]].
- 				 counterIndex := initialCounterIndex].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  		- how many counters it needs/conditional branches it contains
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	inBlock := false.
  	prevBCDescriptor := nil.
  	numCounters := 0.
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := 0.
+ 	self cppIf: #NewspeakVM ifTrue:
+ 		[numIRCs := 0].
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		descriptor := self generatorAt: byte0.
  		(descriptor isReturn
  		 and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse:
  					[latestContinuation := latestContinuation max: targetPC.
  					 (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
  						[numCounters := numCounters + 1]]].
  		descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
+ 		self cppIf: #NewspeakVM ifTrue:
+ 			[descriptor hasIRC ifTrue:
+ 				[numIRCs := numIRCs + 1]].
  		pc := pc + descriptor numBytes.
  		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
  		prevBCDescriptor := descriptor].
  	^numBlocks!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>allocatePinnedCounters: (in category 'sista support') -----
- allocatePinnedCounters: nCounters
- 	<api>
- 	<option: #SistaStackToRegisterMappingCogit>
- 	^self allocateSlotsForPinningInOldSpace: nCounters
- 			bytes: (self objectBytesForSlots: nCounters)
- 			format: self firstLongFormat
- 			classIndex: 	self thirtyTwoBitLongsClassIndexPun!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>allocatePinnedCounters: (in category 'sista support') -----
- allocatePinnedCounters: nCounters
- 	<api>
- 	<option: #SistaStackToRegisterMappingCogit>
- 	| numSlots |
- 	numSlots := nCounters + 1 // 2.
- 	^self allocateSlotsForPinningInOldSpace: numSlots
- 			bytes: (self objectBytesForSlots: numSlots)
- 			format: self firstLongFormat + (nCounters bitAnd: 1)
- 			classIndex: 	self thirtyTwoBitLongsClassIndexPun!

Item was added:
+ ----- Method: SpurMemoryManager>>allocatePinnedSlots: (in category 'sista support') -----
+ allocatePinnedSlots: nSlots
+ 	<api>
+ 	<option: #NewspeakVM>
+ 	<option: #SistaStackToRegisterMappingCogit>
+ 	| obj |
+ 	obj := self allocateSlotsForPinningInOldSpace: nSlots
+ 				bytes: (self objectBytesForSlots: nSlots)
+ 				format: self wordIndexableFormat
+ 				classIndex: 	self wordSizeClassIndexPun.
+ 	obj ifNotNil:
+ 		[self fillObj: obj numSlots: nSlots with: 0].
+ 	^obj!

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV3PlusClosures
  	"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosures"
  
  	isPushNilFunction := #v3:Is:Push:Nil:.
  	pushNilSizeFunction := #v3PushNilSize:.
  	NSSendIsPCAnnotated := true. "IsNSSendCall used by PushImplicitReceiver"
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		(1    0   15 genPushReceiverVariableBytecode needsFrameNever: 1)
  		(1  16   31 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   95 genPushLiteralVariableBytecode needsFrameNever: 1)
  		(1  96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 104 111 genStoreAndPopTemporaryVariableBytecode)
  		(1 112 112 genPushReceiverBytecode needsFrameNever: 1)
  		(1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
  		(1 114 114 genPushConstantFalseBytecode needsFrameNever: 1)
  		(1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
  		(1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1)
  		"method returns in blocks need a frame because of nonlocalReturn:through:"
  		(1 120 120 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 121 121 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 122 122 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 123 123 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 124 124 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 125 125 genReturnTopFromBlock		return needsFrameNever: -1)
  
+ 		(3 126 126 genDynamicSuperSendBytecode isMapped)			"Newspeak"
+ 		(2 127 127 genPushImplicitReceiverBytecode isMapped hasIRC)	"Newspeak"
- 		(3 126 126 genDynamicSuperSendBytecode isMapped)		"Newspeak"
- 		(2 127 127 genPushImplicitReceiverBytecode isMapped)	"Newspeak"
  
  		(2 128 128 extendedPushBytecode needsFrameNever: 1)
  		(2 129 129 extendedStoreBytecode)
  		(2 130 130 extendedStoreAndPopBytecode)
  		(2 131 131 genExtendedSendBytecode isMapped)
  		(3 132 132 doubleExtendedDoAnythingBytecode isMapped)
  		(2 133 133 genExtendedSuperBytecode isMapped)
  		(2 134 134 genSecondExtendedSendBytecode isMapped)
  		(1 135 135 genPopStackBytecode needsFrameNever: -1)
  		(1 136 136 duplicateTopBytecode needsFrameNever: 1)
  
  		(1 137 137 genPushActiveContextBytecode)
  		(2 138 138 genPushNewArrayBytecode)
  
  		(2 139 139 genPushExplicitOuterReceiverBytecode isMapped)	"Newspeak"
  
  		(3 140 140 genPushRemoteTempLongBytecode)
  		(3 141 141 genStoreRemoteTempLongBytecode)
  		(3 142 142 genStoreAndPopRemoteTempLongBytecode)
  		(4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:)
  
  		(1 144 151 genShortUnconditionalJump			branch v3:ShortForward:Branch:Distance:)
  		(1 152 159 genShortJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
  															v3:ShortForward:Branch:Distance:)
  		(2 160 163 genLongUnconditionalBackwardJump	branch isMapped "because of interrupt check"
  															v3:Long:Branch:Distance:)
  		(2 164 167 genLongUnconditionalForwardJump		branch v3:Long:Branch:Distance:)
  		(2 168 171 genLongJumpIfTrue					branch isBranchTrue isMapped "because of mustBeBoolean"
  															v3:LongForward:Branch:Distance:)
  		(2 172 175 genLongJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
  															v3:LongForward:Branch:Distance:)
  
  		(1 176 176 genSpecialSelectorArithmetic isMapped AddRR)
  		(1 177 177 genSpecialSelectorArithmetic isMapped SubRR)
  		(1 178 178 genSpecialSelectorComparison isMapped JumpLess)
  		(1 179 179 genSpecialSelectorComparison isMapped JumpGreater)
  		(1 180 180 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1 181 181 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1 182 182 genSpecialSelectorComparison isMapped JumpZero)
  		(1 183 183 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1 184 189 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1 190 190 genSpecialSelectorArithmetic isMapped AndRR)
  		(1 191 191 genSpecialSelectorArithmetic isMapped OrRR)
  		(1 192 197 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 199 199 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 200 207 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  		(1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV4
  	"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
  
  	isPushNilFunction := #v4:Is:Push:Nil:.
  	pushNilSizeFunction := #v4PushNilSize:.
  	NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		"1 byte bytecodes"
  		(1    0   15 genPushReceiverVariableBytecode needsFrameNever: 1)
  		(1  16   31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
  		(1  76   76 genPushReceiverBytecode needsFrameNever: 1)
  		(1  77   77 genExtPushPseudoVariableOrOuterBytecode)
  		(1  78   78 genPushConstantZeroBytecode needsFrameNever: 1)
  		(1  79   79 genPushConstantOneBytecode needsFrameNever: 1)
  
  		(1   80   80 genSpecialSelectorArithmetic isMapped AddRR)
  		(1   81   81 genSpecialSelectorArithmetic isMapped SubRR)
  		(1   82   82 genSpecialSelectorComparison isMapped JumpLess)
  		(1   83   83 genSpecialSelectorComparison isMapped JumpGreater)
  		(1   84   84 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1   85   85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1   86   86 genSpecialSelectorComparison isMapped JumpZero)
  		(1   87   87 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1   88   93 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1   94   94 genSpecialSelectorArithmetic isMapped AndRR)
  		(1   95   95 genSpecialSelectorArithmetic isMapped OrRR)
  		(1   96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 103 103 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
+ 		(1 160 175	genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
- 		(1 160 175	genSendAbsentImplicit0ArgsBytecode isMapped)
  
  		(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 184 191 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 192 199 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 200 207 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 208 215 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		(1 216 216 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 217 217 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 218 218 genExtReturnTopFromBlock	return needsFrameNever: -1)
  
  		(1 219 219 duplicateTopBytecode			needsFrameNever: 1)
  		(1 220 220 genPopStackBytecode			needsFrameNever: -1)
  		(1 221 221 genExtNopBytecode			needsFrameNever: 0)
  		(1 222 223	unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension					needsFrameNever: 0)
  		(2 225 225 extBBytecode extension					needsFrameNever: 0)
  		(2 226 226 genExtPushReceiverVariableBytecode)
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 230 230 genLongPushTemporaryVariableBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtStoreReceiverVariableBytecode)
  		(2 233 233 genExtStoreLiteralVariableBytecode)
  		(2 234 234 genLongStoreTemporaryVariableBytecode)
  		(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
  		(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
  		(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
  
  		(2 238 238 genExtSendBytecode isMapped)
  		(2 239 239 genExtSendSuperBytecode isMapped)
+ 		(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
- 		(2 240 240 genExtSendAbsentImplicitBytecode isMapped)
  		(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
  
  		(2 242 242 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 243 243 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 244 244 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		(2 245 248	unknownBytecode)
  
  		"3 byte bytecodes"
  		(3 249 249 callPrimitiveBytecode)
  		(3 250 250 genPushRemoteTempLongBytecode)
  		(3 251 251 genStoreRemoteTempLongBytecode)
  		(3 252 252 genStoreAndPopRemoteTempLongBytecode)
  		(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
  
  		(3 254 255	unknownBytecode))!

Item was removed:
- ----- Method: StackToRegisterMappingCogit class>>newInitializeBytecodeTableForNewspeakV3PlusClosures (in category 'class initialization') -----
- newInitializeBytecodeTableForNewspeakV3PlusClosures
- 	"StackToRegisterMappingCogit newInitializeBytecodeTableForNewspeakV3PlusClosures"
- 
- 	isPushNilFunction := #v3:Is:Push:Nil:.
- 	pushNilSizeFunction := #v3PushNilSize:.
- 	NSSendIsPCAnnotated := true. "IsNSSendCall used by PushImplicitReceiver"
- 	self flag:
- 'Special selector send class must be inlined to agree with the interpreter, which
-  inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
-  class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
-  have identical semantics.  We get away with not hardwiring the other special
-  selectors either because in the Cointerpreter they are not inlined or because they
-  are inlined only to instances of classes for which there will always be a method.'.
- 	self generatorTableFrom: #(
- 		(1    0   15 genPushReceiverVariableBytecode needsFrameNever: 1)
- 		(1  16   31 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
- 		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
- 		(1  64   95 genPushLiteralVariableBytecode needsFrameNever: 1)
- 		(1  96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
- 		(1 104 111 genStoreAndPopTemporaryVariableBytecode)
- 		(1 112 112 genPushReceiverBytecode needsFrameNever: 1)
- 		(1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
- 		(1 114 114 genPushConstantFalseBytecode needsFrameNever: 1)
- 		(1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
- 		(1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1)
- 		"method returns in blocks need a frame because of nonlocalReturn:through:"
- 		(1 120 120 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
- 		(1 121 121 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
- 		(1 122 122 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
- 		(1 123 123 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
- 		(1 124 124 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
- 		(1 125 125 genReturnTopFromBlock		return needsFrameNever: -1)
- 
- 		(3 126 126 genDynamicSuperSendBytecode isMapped)		"Newspeak"
- 		(2 127 127 genPushImplicitReceiverBytecode isMapped)	"Newspeak"
- 
- 		(2 128 128 extendedPushBytecode needsFrameNever: 1)
- 		(2 129 129 extendedStoreBytecode)
- 		(2 130 130 extendedStoreAndPopBytecode)
- 		(2 131 131 genExtendedSendBytecode isMapped)
- 		(3 132 132 doubleExtendedDoAnythingBytecode isMapped)
- 		(2 133 133 genExtendedSuperBytecode isMapped)
- 		(2 134 134 genSecondExtendedSendBytecode isMapped)
- 		(1 135 135 genPopStackBytecode needsFrameNever: -1)
- 		(1 136 136 duplicateTopBytecode needsFrameNever: 1)
- 
- 		(1 137 137 genPushActiveContextBytecode)
- 		(2 138 138 genPushNewArrayBytecode)
- 
- 		(2 139 139 genPushExplicitOuterReceiverBytecode isMapped)	"Newspeak"
- 
- 		(3 140 140 genPushRemoteTempLongBytecode)
- 		(3 141 141 genStoreRemoteTempLongBytecode)
- 		(3 142 142 genStoreAndPopRemoteTempLongBytecode)
- 		(4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:)
- 
- 		(1 144 151 genShortUnconditionalJump			branch v3:ShortForward:Branch:Distance:)
- 		(1 152 159 genShortJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
- 															v3:ShortForward:Branch:Distance:)
- 		(2 160 163 genLongUnconditionalBackwardJump	branch isMapped "because of interrupt check"
- 															v3:Long:Branch:Distance:)
- 		(2 164 167 genLongUnconditionalForwardJump		branch v3:Long:Branch:Distance:)
- 		(2 168 171 genLongJumpIfTrue					branch isBranchTrue isMapped "because of mustBeBoolean"
- 															v3:LongForward:Branch:Distance:)
- 		(2 172 175 genLongJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
- 															v3:LongForward:Branch:Distance:)
- 
- 		(1 176 176 genSpecialSelectorArithmetic isMapped AddRR)
- 		(1 177 177 genSpecialSelectorArithmetic isMapped SubRR)
- 		(1 178 178 genSpecialSelectorComparison isMapped JumpLess)
- 		(1 179 179 genSpecialSelectorComparison isMapped JumpGreater)
- 		(1 180 180 genSpecialSelectorComparison isMapped JumpLessOrEqual)
- 		(1 181 181 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
- 		(1 182 182 genSpecialSelectorComparison isMapped JumpZero)
- 		(1 183 183 genSpecialSelectorComparison isMapped JumpNonZero)
- 		(1 184 189 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
- 		(1 190 190 genSpecialSelectorArithmetic isMapped AndRR)
- 		(1 191 191 genSpecialSelectorArithmetic isMapped OrRR)
- 		(1 192 197 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
- 		(1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
- 		(1 199 199 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
- 		(1 200 207 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
- 		(1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
- 		(1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
- 		(1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!

Item was removed:
- ----- Method: StackToRegisterMappingCogit class>>newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
- newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid
- 	"StackToRegisterMappingCogit newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
- 
- 	super newInitializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid.
- 	isPushNilFunction := #v3or4:Is:Push:Nil:.
- 	pushNilSizeFunction := #v3or4PushNilSize:!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
+ 	  initialStackPtr initialOpcodeIndex initialAnnotationIndex initialIndexOfIRC |
- 	  initialStackPtr initialOpcodeIndex initialAnnotationIndex |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
  	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		 self scanBlock: blockStart.
  		 initialOpcodeIndex := opcodeIndex.
  		 initialAnnotationIndex := annotationIndex.
+ 		 self cppIf: #NewspeakVM ifTrue:
+ 			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + ((self pushNilSize: methodObj) * blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
  									[:i|
  									abstractOpcodes
  										at: i
  										put: (processor abstractInstructionCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
+ 				 annotationIndex := initialAnnotationIndex.
+ 				 self cppIf: #NewspeakVM ifTrue:
+ 					[indexOfIRC := initialIndexOfIRC]].
- 				 annotationIndex := initialAnnotationIndex].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	inBlock := false.
  	prevBCDescriptor := nil.
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := 0.
+ 	self cppIf: #NewspeakVM ifTrue:
+ 		[numIRCs := 0].
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		descriptor := self generatorAt: byte0.
  		(descriptor isReturn
  		 and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse: [latestContinuation := latestContinuation max: targetPC]].
  		descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
+ 		self cppIf: #NewspeakVM ifTrue:
+ 			[descriptor hasIRC ifTrue:
+ 				[numIRCs := numIRCs + 1]].
  		pc := pc + descriptor numBytes.
  		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
  		prevBCDescriptor := descriptor].
  	^numBlocks!



More information about the Vm-dev mailing list