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

commits at source.squeak.org commits at source.squeak.org
Sun Apr 5 00:42:21 UTC 2015


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

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

Name: VMMaker.oscog-eem.1160
Author: eem
Time: 4 April 2015, 5:40:16.719 pm
UUID: 0dbe8bb6-0fba-4989-8902-9ea276afe1e5
Ancestors: VMMaker.oscog-eem.1159

Cogit:
Revise method map generaqtion to provide multiple send
type annotations.  Add an IsAnnotationExtension annotation
type that implicitly has a zero displacement and uses its
displacement bits to extend the preceeding IsSendCall
annotation.  This allows us to eliminate all the exotic
entry-points and keep only the checked and unchecked
entries.

Fix pc mapping tests for Spur.

Recategorize bytecode generation suport methods in
their own category.

Nuke unused variables and some methods.

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

Item was removed:
- ----- Method: CCodeGenerator>>wantsLabels (in category 'utilities') -----
- wantsLabels
- 	"Only label the VM, not plugins (internal or external).  This to cut down the scope
- 	 of problems with labels being duplicated by C compiler optimizer inlining and
- 	 loop unrolling.  We use the asmLabel: directive to control labelling in the
- 	 interpreter proper. But it is too much work doing that for plugins too."
- 	^vmClass notNil and: [vmClass wantsLabels]!

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| classTag errSelIdx cogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	classTag := objectMemory classTagForClass: (self superclassOf: mixinApplication).
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(objectMemory isOopForwarded: selector) ifTrue:
  				[^self
  					ceDynamicSuperSend: (self handleForwardedSelectorFaultFor: selector)
  					to: rcvr
  					numArgs: numArgs].
  			 (objectMemory isForwardedClassTag: classTag) ifTrue:
  				[^self
  					ceDynamicSuperSend: selector
  					to: (self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc")
  					numArgs: numArgs].
  			 messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  				  selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 cogMethod selector = selector ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
+ 				offset: cogit entryOffset
- 				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSelfSend:to:numArgs: (in category 'trampolines') -----
  ceSelfSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked self send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| classTag errSelIdx cogMethod |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(objectMemory isOopForwarded: selector) ifTrue:
  				[^self
  					ceSelfSend: (self handleForwardedSelectorFaultFor: selector)
  					to: rcvr
  					numArgs: numArgs].
  			 (objectMemory isForwardedClassTag: classTag) ifTrue:
  				[^self
  					ceSelfSend: selector
  					to: (self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc")
  					numArgs: numArgs].
  			 messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  				  selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 cogMethod selector = selector ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
+ 				offset: cogit entryOffset
- 				offset: cogit selfSendEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

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 primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry picMNUAbort picInterpretAbort 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 ceEnclosingObjectTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines nsSendCacheSurrogateClass'
+ 	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NumObjRefsInRuntime NumOopsPerNSC NumSendTrampolines NumTrampolines ProcessorClass'
- 	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 primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset selfSendEntry selfSendEntryAlignment cmSelfSendEntryOffset picMNUAbort picInterpretAbort 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 ceEnclosingObjectTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP ordinarySendTrampolines superSendTrampolines dynamicSuperSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines nsSendCacheSurrogateClass'
- 	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NumObjRefsInRuntime NumOopsPerNSC NumSendTrampolines NumTrampolines ProcessorClass'
  	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>>initializeAnnotationConstants (in category 'class initialization') -----
  initializeAnnotationConstants
  	"These form the method map for a cog method.  Each annotated instruction has a
  	 byte in the map, and each byte in the map has two parts.  In the least signficant
  	 bits are a byte distance from the start of the method or previous map entry.  In
  	 the most signficant bits are the type of annotation at the point reached.  A null
  	 byte ends the map.
  
  	 The map occurs at the end of a method (*), in reverse, so that its start is found
  	 by adding the method's block size.  If the distance between two mapped
  	 instructions will not fit in the displacement field then one or more displacement
  	 entries are placed in the map to bridge the gap.  There are either unit displacement
  	 bytes or * 32 displacement bytes. (* if methods have performance counters then
  	 the map preceedes the counters and so one finds the map by adding the block
  	 size and subtracting numCounters * sizeof(counter)).
  
  	 There is only one kind of call annotation that serves for all calls from machine
+ 	 code. There are several kinds of call, sends, super sends, calls of the generated
- 	 code. There are four kinds of call, sends, super sends, calls of the generated
  	 run-time, and direct calls of primitive functions in the interpreter.  These need
  	 different treatment at different times.  For example, when the send cache is
  	 flushed or the method zone is shrunk some sends must be unlinked and some
+ 	 sends must be relocated.  But to be able to parse bytecoded methods and match
+ 	 their pcs with corresponding machine code pcs the map needs to differentiate
+ 	 between sends and run-time calls. 
- 	 sends must be relocated.
  
+ 	 Sends can be distinguished from run-time or direct primitive calls based on address;
+ 	 only sends have their target between methodZoneBase and methodZone freeStart.
+ 	 We used to distinguish normal sends from super sends because normal sends link to
+ 	 the checked entry-point, whereas super sends link to the unchecked entry-point, and
+ 	 both entry points have different alignment.  But now we use the IsAnnotationExtension
+ 	 to label sends other than normal sends.  For these ``exotic'' sends there is both an
+ 	 IsAnnotationExtension annotation and an IsSendCall annotation.
- 	 Sends can be distinguished from run-time or direct primitive calls based on
- 	 address; only sends have their target between methodZoneBase and methodZone
- 	 freeStart.  Further, normal sends can be distinguished from super sends because
- 	 normal sends link to the checked entry-point, whereas super sends link to the
- 	 unchecked entry-point, and both entry points have different alignment.
- 	 But to be able to parse bytecoded methods and match their pcs with corresponding
- 	 machine code pcs the map needs to differentiate between sends and run-time calls. 
  
  	 While run-time calls can be distinguished from direct primitive calls on the basis
  	 of address there is no need to do so.  They are merely calls to locations that
  	 don't move during method zone compaction.
  
  	 Absolute PC references are used for method references and counter references.
+ 	 These are references from within a particular method to absolute pcs in that same
- 	 These are references from withi a particular method to absolute pcs in that same
  	 method that must be relocated when the method moves."
  	"self initializeAnnotationConstants"
+ 
- 	IsSendCall := 7.
- 	IsRelativeCall := 6.
- 	HasBytecodePC := 5.
- 	IsAbsPCReference := 4.
- 	IsObjectReference := 3.
- 	IsNSSendCall := NewspeakVM ifTrue: [2].
- 	IsDisplacementX2N := 1.
- 	IsDisplacement := 0.
  	AnnotationShift := 5.
+ 	IsDisplacementX2N := 0.	"N.B. 0 byet ends the map"
+ 	IsAnnotationExtension := 1.	"Used to extend IsSendCall with different codes for exotic send types."
+ 	IsObjectReference := 2.
+ 	IsAbsPCReference := 3.
+ 	HasBytecodePC := 4.
+ 	IsRelativeCall := 5.
+ 	IsNSSendCall := NewspeakVM ifTrue: [6].
+ 	IsSendCall := 7.
+ 	"These are formed by combining IsSendCall and IsAnnotationExtension annotations."
+ 	IsSuperSend := 8.
+ 	IsDirectedSuperSend := 9.
+ 	IsNSSelfSend := NewspeakVM ifTrue: [10].
+ 	IsNSDynamicSuperSend := NewspeakVM ifTrue: [11].
+ 	IsNSImplicitReceiverSend := NewspeakVM ifTrue: [12].
  
  	DisplacementMask := (1 << AnnotationShift) - 1.
  	DisplacementX2N := IsDisplacementX2N << AnnotationShift.
+ 	FirstAnnotation := IsObjectReference << AnnotationShift.
- 	FirstAnnotation := IsDisplacementX2N + 1 << AnnotationShift.
- 	MaxUnitDisplacement := DisplacementMask.
  	MaxX2NDisplacement := DisplacementMask << AnnotationShift.
  
  	MapEnd := 0.
  
+ 	AnnotationConstantNames := #(	IsDisplacementX2N
+ 										IsAnnotationExtension
+ 										IsObjectReference
+ 										IsAbsPCReference
+ 										HasBytecodePC
+ 										IsRelativeCall
+ 										IsNSSendCall
+ 										IsSendCall
+ 										IsSuperSend
+ 										IsDirectedSuperSend
+ 										IsNSSelfSend
+ 										IsNSDynamicSuperSend
+ 										IsNSImplicitReceiverSend).
+ 	AnnotationsWithBytecodePCs := #(HasBytecodePC
+ 										IsNSSendCall
+ 										IsSendCall
+ 										IsSuperSend
+ 										IsDirectedSuperSend
+ 										IsNSSelfSend
+ 										IsNSDynamicSuperSend
+ 										IsNSImplicitReceiverSend)!
- 	AnnotationConstantNames := NewspeakVM
- 									ifTrue:
- 										[#(	IsDisplacement IsDisplacementX2N
- 											IsNSSendCall
- 											IsObjectReference
- 											IsAbsPCReference
- 											HasBytecodePC
- 											IsRelativeCall
- 											IsSendCall)]
- 									ifFalse:
- 										[#(	IsDisplacement IsDisplacementX2N unused
- 											IsObjectReference
- 											IsAbsPCReference
- 											HasBytecodePC
- 											IsRelativeCall
- 											IsSendCall)]!

Item was changed:
  ----- Method: Cogit class>>structureOfACogMethod (in category 'tests') -----
  structureOfACogMethod
  	"A CogMethod is the machine code for executable code in the Cog VM, and in the simulator these are
  	 instances of CogMethod.  In actuality they are structures in memory in the CogMethodZone..  There
  	 are four real kinds, defined by the cmType field, free space: CMFree, methods: CMMethod, closed
  	 PICs: CMClosedPIC (finite polymorphic inline caches with up to 6 entries), and open PICs: CMOpenPIC
+ 	 (infinite megamorphicinline caches that probe the first-level method lookup cache).  There is a fifth
- 	 (infinite megamorphicinline caches that probe the first-level method lookup cache).  There is a sixth
  	 kind of method, which is merely a header, for blocks: CMBlock, one which exists only within CMMethods,
  	 and exist only to allow block activations to refer to something that looks like a CogMethod.
  
  	 The blockSize field in a CogMethod is the size in bytes of the entire method, including the header.
  	 Methods are aligned to an 8 byte boundary in the CogMethodZone.  The size is used to iterate over
  	 the methods in the zone.
  
  	 Follwing the header is the abort and entry code.  Starting immediately after the header is the call to
  	 the abort routine called when either a send fails or a stack limit check fails.  Following that is the
  	 checked entry point that checks the receiver is of the right class, and this code ends in the unchecked
  	 entry point.  Following this is either primitive code, followed by frame building code, or frame-building
  	 code, or, for frameless methods, the code for the frameless method.  Following that is the code for the
  	 method.  If the mehtrod contains blocks  then followng the method code will be a CMBlock header,
  	 followed by code for the block, for each block, and following this will be the block dispatch code,
  	 which is pointed to by the blockEntryOffset field in the CogMethod.
  
  	 Following either the return in the method, or the block dispatch, is the meta data which identifies
+ 	 intersting points in the machine code.  This meta data starts at the end of the structure and is read
- 	 intersting points in the machine code.  This meta data starts at the end of teh structure and is read
  	 backwards towards the start of the method, and is terminated by a null byte.  So the blockSize is
  	 used to find the start of the metadata.  The metadata reveals where object references, sends and
+ 	 pc-mapping points exist in the machine code.  The metadata is parsed when garbage collecting to
+ 	 find and update object references, and when unlinking sends for method cache flushing.."
- 	 pc-mapping points exist in the machine code.  Hence the metadata is parsed when garbage collect-
- 	 ing to find and update object references."
  	 !

Item was changed:
  ----- Method: Cogit class>>testPCMappingSelect:options: (in category 'tests') -----
  testPCMappingSelect: aBlock options: optionsDictionaryOrArray
  	"Test pc mapping both ways using a selection of the methods in the current image."
  	| cogit coInterpreter |
  	self initializeWithOptions: (self asOptionsDictionary: optionsDictionaryOrArray).
  	cogit := self new.
+ 	coInterpreter := CurrentImageCoInterpreterFacade forCogit: cogit.
- 	coInterpreter := CurrentImageCoInterpreterFacade new cogit: cogit; yourself.
  	[cogit
  			setInterpreter: coInterpreter;
  			singleStep: true;
  			initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size]
  		on: Notification
  		do: [:ex|
  			(ex messageText beginsWith: 'cannot find receiver for') ifTrue:
  				[ex resume: coInterpreter]].
  	SystemNavigation new allSelect:
  		[:m| | cm |
  		(m isQuick not
  		 and: [aBlock value: m]) ifTrue:
+ 			[coInterpreter voidHeaderToMethodMap.
+ 			 Transcript nextPut: $.; flush.
+ 			 [coInterpreter.
+ 			  cm := cogit
- 			[Transcript nextPut: $.; flush.
- 			 [cm := cogit
  						cog: (coInterpreter oopForObject: m)
  						selector: (coInterpreter oopForObject: m selector).
  			   cm isNil and: [coInterpreter isCogCompiledCodeCompactionCalledFor]] whileTrue:
  				[cogit methodZone clearCogCompiledCode.
  				 coInterpreter clearCogCompiledCodeCompactionCalledFor.
  				 coInterpreter initializeObjectMap].
  			 cogit testPCMappingForCompiledMethod: m cogMethod: cm].
  		 false]!

Item was removed:
- ----- Method: Cogit class>>wantsLabels (in category 'translation') -----
- wantsLabels
- 	^true!

Item was removed:
- ----- Method: Cogit>>CallSend: (in category 'method map') -----
- CallSend: callTarget
- 	<returnTypeC: #'AbstractInstruction *'>
- 	^self annotateSend: (self Call: callTarget)!

Item was removed:
- ----- Method: Cogit>>annotateSend: (in category 'method map') -----
- annotateSend: abstractInstruction
- 	<var: #abstractInstruction type: #'AbstractInstruction *'>
- 	<returnTypeC: #'AbstractInstruction *'>
- 	<inline: true>
- 	^self annotate: abstractInstruction with: IsSendCall!

Item was added:
+ ----- Method: Cogit>>annotationForMcpc:in: (in category 'method map') -----
+ annotationForMcpc: mcpc in: cogHomeMethod
+ 	"Answer the annotation for mcpc in cogHomeMethod's map, or 0 if no entry exists."
+ 	<var: #cogHomeMethod type: #'CogMethod *'>
+ 	| mapLocation mapByte annotation |
+ 	mapLocation := self findMapLocationForMcpc: mcpc inMethod: cogHomeMethod.
+ 	mapLocation = 0 ifTrue:
+ 		[^0].
+ 	mapByte := coInterpreter byteAt: mapLocation.
+ 	annotation := mapByte >> AnnotationShift.
+ 	annotation = IsSendCall ifTrue:
+ 		[mapByte := coInterpreter byteAt: mapLocation - 1.
+ 		 mapByte >> AnnotationShift = IsAnnotationExtension ifTrue:
+ 			[annotation := annotation + (mapByte bitAnd: DisplacementMask)]].
+ 	^annotation!

Item was changed:
  ----- Method: Cogit>>ceSICMiss: (in category 'in-line cacheing') -----
  ceSICMiss: receiver
  	"An in-line cache check in a method has failed.  The failing entry check has jumped
  	 to the ceMethodAbort abort call at the start of the method which has called this routine.
  	 If possible allocate a closed PIC for the current and existing classes.
  	 The stack looks like:
  			receiver
  			args
  			sender return address
  	  sp=>	ceMethodAbort call return address
  	 So we can find the method that did the failing entry check at
  		ceMethodAbort call return address - missOffset
  	 and we can find the send site from the outer return address."
  	<api>
  	| pic innerReturn outerReturn entryPoint targetMethod newTargetMethodOrNil errorSelectorOrNil cacheTag extent result |
  	<var: #pic type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
+ 	<var: #callerMethod type: #'CogMethod *'>
  	"Whether we can relink to a PIC or not we need to pop off the inner return and identify the target method."
+ 	innerReturn := coInterpreter popStack asUnsignedInteger.
- 	innerReturn := coInterpreter popStack.
  	targetMethod := self cCoerceSimple: innerReturn - missOffset to: #'CogMethod *'.
  	(objectMemory isOopForwarded: receiver) ifTrue:
  		[^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
+ 	outerReturn := coInterpreter stackTop asUnsignedInteger.
- 	outerReturn := coInterpreter stackTop.
  	self assert: (outerReturn between: methodZoneBase and: methodZone freeStart).
  	entryPoint := backEnd callTargetFromReturnAddress: outerReturn.
  
  	self assert: targetMethod selector ~= objectMemory nilObject.
  	self cppIf: NewspeakVM ifTrue:
+ 		[| callerMethod annotation |
+ 		 self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
+ 		 callerMethod := coInterpreter mframeHomeMethod: coInterpreter framePointer.
+ 		 self assert: (outerReturn
+ 						between: callerMethod asUnsignedInteger + cmNoCheckEntryOffset
+ 						and: callerMethod asUnsignedInteger + callerMethod blockSize).
+ 		 annotation := self annotationForMcpc: outerReturn in: callerMethod.
+ 		 self assert: annotation >= IsSendCall.
+ 		 "Avoid the effort of implementing PICs for the relatively high dynamic frequency
+ 		  self send and simply rebind the send site (for now)."
+ 		 annotation = IsNSSelfSend ifTrue:
- 		[self assert: (targetMethod asInteger + cmEntryOffset = entryPoint
- 					or: [targetMethod asInteger + cmSelfSendEntryOffset = entryPoint
- 					or: [targetMethod asInteger + cmDynSuperEntryOffset = entryPoint]]).
- 		 "Avoid the effort of implementing PICs for the relatively low dynamic frequency
- 		  dynamic super send and simply rebind the send site."
- 		 targetMethod asInteger + cmSelfSendEntryOffset = entryPoint ifTrue:
  			[^coInterpreter
  				ceSelfSend: targetMethod selector
  				to: receiver
  				numArgs: targetMethod cmNumArgs].
+ 		 "Avoid the effort of implementing PICs for the relatively low dynamic frequency
+ 		  dynamic super send and simply rebind the send site."
+ 		 annotation = IsNSDynamicSuperSend ifTrue:
- 		 targetMethod asInteger + cmDynSuperEntryOffset = entryPoint ifTrue:
  			[^coInterpreter
  				ceDynamicSuperSend: targetMethod selector
  				to: receiver
  				numArgs: targetMethod cmNumArgs]].
  	self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
  
  	self lookup: targetMethod selector
  		for: receiver
  		methodAndErrorSelectorInto:
  			[:method :errsel|
  			newTargetMethodOrNil := method.
  			errorSelectorOrNil := errsel].
  	"We assume lookupAndCog:for: will *not* reclaim the method zone"
  	self assert: outerReturn = coInterpreter stackTop.
  	cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
  	((errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
  	 or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
  	 or: [(backEnd inlineCacheTagAt: outerReturn) = self picAbortDiscriminatorValue
  	 or: [newTargetMethodOrNil isNil
  	 or: [objectMemory isYoung: newTargetMethodOrNil]]]]) ifTrue:
  		[result := self patchToOpenPICFor: targetMethod selector
  					numArgs: targetMethod cmNumArgs
  					receiver: receiver.
  		 self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
  		 ^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  	"See if an Open PIC is already available."
  	pic := methodZone openPICWithSelector: targetMethod selector.
  	pic isNil ifTrue:
  		["otherwise attempt to create a closed PIC for the two cases."
  		 pic := self cogPICSelector: targetMethod selector
  					numArgs: targetMethod cmNumArgs
  					Case0Method: targetMethod
  					Case1Method: newTargetMethodOrNil
  					tag: cacheTag
  					isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
  		 (pic asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  			["For some reason the PIC couldn't be generated, most likely a lack of code memory.
  			  Continue as if this is an unlinked send."
  			 pic asInteger = InsufficientCodeSpace ifTrue:
  				[coInterpreter callForCogCompiledCodeCompaction].
  			^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  		 processor flushICacheFrom: pic asInteger to: pic asInteger + closedPICSize].
  	"Relink the send site to the pic.  If to an open PIC then reset the cache tag to the selector,
  	 for the benefit of the cacheTag assert check in checkIfValidObjectRef:pc:cogMethod:."
  	extent := pic cmType = CMOpenPIC
  				ifTrue:
  					[backEnd
  						rewriteInlineCacheAt: outerReturn
  						tag: targetMethod selector
  						target: pic asInteger + cmEntryOffset]
  				ifFalse:
  					[backEnd
  						rewriteCallAt: outerReturn
  						target: pic asInteger + cmEntryOffset].
  	processor flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1.
  	"Jump back into the pic at its entry in case this is an MNU (newTargetMethodOrNil is nil)"
  	coInterpreter
  		executeCogPIC: pic
  		fromLinkedSendWithReceiver: receiver
  		andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
  	"NOTREACHED"
  	^nil!

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRef: annotation pc: mcpc cogMethod: cogMethod
+ 	"Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	annotation = IsObjectReference ifTrue:
  		[| literal |
  		 literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (objectRepresentation checkValidOopReference: literal) ifFalse:
  			[coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  			^1]].
  
+ 	self cppIf: NewspeakVM ifTrue:
+ 		[annotation = IsNSSendCall ifTrue:
+ 			[| nsSendCache enclosingObject |
+ 			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ 			[(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
+ 				[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
+ 				^1]].
+ 			(enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
+ 				[[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
+ 					[coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
+ 					^1]]]]].
- 	self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- 		[| nsSendCache enclosingObject |
- 		nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- 		[(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
- 			[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
- 			^1]].
- 		(enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
- 			[[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
- 				[coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
- 				^1]]]]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[| entryPoint selectorOrCacheTag offset |
  		 entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint <= methodZoneBase
  			ifTrue:
  				[offset := entryPoint]
  			ifFalse:
  				[self
  					offsetAndSendTableFor: entryPoint
  					annotation: annotation
  					into: [:off :table| offset := off]].
  		 selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  		 (entryPoint > methodZoneBase
  		  and: [offset ~= cmNoCheckEntryOffset
  		  and: [(self cCoerceSimple: entryPoint - offset to: #'CogMethod *') cmType ~= CMOpenPIC]])
  			ifTrue: "linked non-super send, cacheTag is a cacheTag"
  				[(objectRepresentation validInlineCacheTag: selectorOrCacheTag) ifFalse:
  					[coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  					^1]]
  			ifFalse: "unlinked send or super send; cacheTag is a selector"
  				[(objectRepresentation checkValidOopReference: selectorOrCacheTag) ifFalse:
  					[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  					^1]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
+ 	"Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| literal entryPoint |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (self asserta: (objectRepresentation checkValidOopReference: literal)) ifFalse:
  			[^1].
  		((objectRepresentation couldBeObject: literal)
  		 and: [objectMemory isReallyYoungObject: literal]) ifTrue:
  			[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  				[^2]]].
  
+ 	self cppIf: NewspeakVM ifTrue:
+ 		[annotation = IsNSSendCall ifTrue:
+ 			[| nsSendCache classTag enclosingObject nsTargetMethod |
+ 			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ 			(self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
+ 				[^9].
+ 			classTag := nsSendCache classTag.
+ 			(self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
+ 				[^10].
+ 			enclosingObject := nsSendCache enclosingObject.
+ 			(self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
+ 				[^11].
+ 			entryPoint := nsSendCache target.
+ 			entryPoint ~= 0 ifTrue: [
+ 				nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ 				(self asserta: (nsTargetMethod cmType = CMMethod)) ifFalse:
+ 					[^12]]]].
- 	self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- 		[ | nsSendCache classTag enclosingObject nsTargetMethod |
- 		nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- 		(self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
- 			[^9].
- 		classTag := nsSendCache classTag.
- 		(self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
- 			[^10].
- 		enclosingObject := nsSendCache enclosingObject.
- 		(self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
- 			[^11].
- 		entryPoint := nsSendCache target.
- 		entryPoint ~= 0 ifTrue: [
- 			nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- 			(self asserta: (nsTargetMethod cmType = CMMethod)) ifFalse:
- 				[^12]]]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
  			[^3].
  		 self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:offset :cacheTag :tagCouldBeObject|
  			tagCouldBeObject
  				ifTrue:
  					[(objectRepresentation couldBeObject: cacheTag)
  						ifTrue:
  							[(self asserta: (objectRepresentation checkValidOopReference: cacheTag)) ifFalse:
  								[^4]]
  						ifFalse:
  							[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  								[^5]].
  					((objectRepresentation couldBeObject: cacheTag)
  					 and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
  						[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  							[^6]]]
  				ifFalse:
  					[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  						[^7]]].
  		entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		entryPoint > methodZoneBase ifTrue:
  			["It's a linked send; find which kind."
+ 			 self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 			 self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable|
  					 (self asserta: (targetMethod cmType = CMMethod
  								   or: [targetMethod cmType = CMClosedPIC
  								   or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
  						[^8]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>compileCPICEntry (in category 'in-line cacheing') -----
  compileCPICEntry
  	<returnTypeC: #'AbstractInstruction *'>
  	"Compile the cache tag computation and the first comparison.  Answer the address of that comparison."
- 	self cppIf: NewspeakVM ifTrue:
- 		[self Nop. "1st nop differentiates from no-check entry if using nextMethod"
- 		 selfSendEntry := self Nop.
- 		 dynSuperEntry := self Nop].
  	entry := objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: TempReg forEntry: true.
  	self CmpR: ClassReg R: TempReg.
  	^self JumpNonZero: 0!

Item was changed:
  ----- Method: Cogit>>compileEntry (in category 'compile abstract instructions') -----
  compileEntry
  	"The entry code to a method checks that the class of the current receiver matches
  	 that in the inline cache.  Other non-obvious elements are that its alignment must be
  	 different from the alignment of the noCheckEntry so that the method map machinery
+ 	 can distinguish normal and super sends (super sends bind to the noCheckEntry)."
- 	 can distinguish normal and super sends (super sends bind to the noCheckEntry).
- 	 In Newspeak we also need to distinguish dynSuperSends and self sends from normal
- 	 and super sends and so on Newspeak, bind the dynSuperEntry and selfSendEntry to
- 	 preceeding nops (on x86 there happens to be at least one anyway)."
  
- 	self cppIf: NewspeakVM ifTrue:
- 		[self Nop. "1st nop differentiates from no-check entry if using nextMethod".
- 		 dynSuperEntry := self Nop.
- 		 selfSendEntry := self Nop]. "Put selfSend last as it has higher dynamic frequency."
  	entry := objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: TempReg forEntry: true.
  	self CmpR: ClassReg R: TempReg.
  	self JumpNonZero: sendMiss.
  	noCheckEntry := self Label.
  	self compileSendTrace ifTrue:
  		[backEnd saveAndRestoreLinkRegAround:
  			[self CallRT: ceTraceLinkedSendTrampoline]]!

Item was changed:
  ----- Method: Cogit>>computeEntryOffsets (in category 'initialization') -----
  computeEntryOffsets
  	"Generate the entry code for a method to determine cmEntryOffset and cmNoCheckEntryOffset.  We
  	 need cmNoCheckEntryOffset up front to be able to generate the map starting from cmNoCheckEntryOffset"
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	| sendMissCall |
  	<var: 'sendMissCall' type: #'AbstractInstruction *'>
  	self allocateOpcodes: 24 bytecodes: 0.
  	methodOrBlockNumArgs := 0.
  	sendMissCall := self compileAbort.
  	self compileEntry.
  	self computeMaximumSizes.
  	self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod).
  	cmEntryOffset := entry address - methodZoneBase.
  	cmNoCheckEntryOffset := noCheckEntry address - methodZoneBase.
- 	self cppIf: NewspeakVM ifTrue:
- 		[cmSelfSendEntryOffset := selfSendEntry address - methodZoneBase.
- 		 cmDynSuperEntryOffset := dynSuperEntry address - methodZoneBase].
  	missOffset := sendMissCall address + sendMissCall machineCodeSize - methodZoneBase.
  	entryPointMask := objectMemory wordSize - 1.
+ 	[(cmEntryOffset bitAnd: entryPointMask) = (cmNoCheckEntryOffset bitAnd: entryPointMask)] whileTrue:
- 	[self cppIf: NewspeakVM
- 		ifTrue: [(cmEntryOffset bitAnd: entryPointMask) = (cmNoCheckEntryOffset bitAnd: entryPointMask)
- 				or: [(cmEntryOffset bitAnd: entryPointMask) = (cmSelfSendEntryOffset bitAnd: entryPointMask)
- 				or: [(cmEntryOffset bitAnd: entryPointMask) = (cmDynSuperEntryOffset bitAnd: entryPointMask)
- 				or: [(cmNoCheckEntryOffset bitAnd: entryPointMask) = (cmDynSuperEntryOffset bitAnd: entryPointMask)]]]]
- 		ifFalse: [(cmEntryOffset bitAnd: entryPointMask) = (cmNoCheckEntryOffset bitAnd: entryPointMask)]] whileTrue:
  		[entryPointMask := entryPointMask + entryPointMask + 1].
  	entryPointMask >= (methodZone roundUpLength: 1) ifTrue:
  		[self error: 'cannot differentiate checked and unchecked entry-points with current cog method alignment'].
  	checkedEntryAlignment := cmEntryOffset bitAnd: entryPointMask.
  	uncheckedEntryAlignment := cmNoCheckEntryOffset bitAnd: entryPointMask.
+ 	self assert: checkedEntryAlignment ~= uncheckedEntryAlignment!
- 	self assert: checkedEntryAlignment ~= uncheckedEntryAlignment.
- 	self cppIf: NewspeakVM
- 		ifTrue:
- 			[cmSelfSendEntryOffset := selfSendEntry address - methodZoneBase.
- 			 selfSendEntryAlignment := cmSelfSendEntryOffset bitAnd: entryPointMask.
- 			 cmDynSuperEntryOffset := dynSuperEntry address - methodZoneBase.
- 			 dynSuperEntryAlignment := cmDynSuperEntryOffset bitAnd: entryPointMask.
- 			self assert: selfSendEntryAlignment ~= checkedEntryAlignment.
- 			self assert: selfSendEntryAlignment ~= uncheckedEntryAlignment.
- 			self assert: dynSuperEntryAlignment ~= checkedEntryAlignment.
- 			self assert: dynSuperEntryAlignment ~= uncheckedEntryAlignment.
- 			self assert: dynSuperEntryAlignment ~= selfSendEntryAlignment]!

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'].
- 		[mapEntries at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry'.
- 		self cppIf: NewspeakVM ifTrue:
- 			[mapEntries at: cogMethod asInteger + selfSendEntryAlignment put: 'selfSendEntry'.
- 			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.
  
+ 	NewspeakVM ifTrue:
+ 		[objectRepresentation canPinObjects ifFalse:
+ 			[mapEntries keys do:
+ 				[:a|
+ 				(mapEntries at: a) = #IsNSSendCall ifTrue:
+ 					[mapEntries
+ 						at: a + backEnd jumpShortByteSize
+ 							put: {'Class'. #disassembleCachedOop:. (objectMemory wordSize)};
+ 						at: a + backEnd jumpShortByteSize + objectMemory bytesPerOop
+ 							put: {'ImplicitReceiver'. #disassembleCachedOop:. (objectMemory wordSize)}]]]].
- 	self cppIf: NewspeakVM
- 		ifTrue:
- 			[objectRepresentation canPinObjects ifFalse:
- 				[mapEntries keys do:
- 					[:a|
- 					(mapEntries at: a) = #IsNSSendCall ifTrue:
- 						[mapEntries
- 							at: a + backEnd jumpShortByteSize
- 								put: {'Class'. #disassembleCachedOop:. (objectMemory wordSize)};
- 							at: a + backEnd jumpShortByteSize + objectMemory bytesPerOop
- 								put: {'ImplicitReceiver'. #disassembleCachedOop:. (objectMemory wordSize)}]]]].
  
  	"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: [(AnnotationsWithBytecodePCs includes: label)
- 				 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 removed:
- ----- Method: Cogit>>dynSuperEntryOffset (in category 'accessing') -----
- dynSuperEntryOffset
- 	<api>
- 	<cmacro: '() cmDynSuperEntryOffset'>
- 	^cmDynSuperEntryOffset!

Item was changed:
  ----- Method: Cogit>>findMapLocationForMcpc:inMethod: (in category 'method map') -----
  findMapLocationForMcpc: targetMcpc inMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
  	| mcpc map mapByte annotation |
  	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	mcpc = targetMcpc ifTrue: [^map].
  	[(mapByte := coInterpreter byteAt: map) ~= MapEnd] whileTrue:
  		[annotation := mapByte >> AnnotationShift.
+ 		 annotation ~= IsAnnotationExtension ifTrue:
+ 			[mcpc := mcpc + (annotation = IsDisplacementX2N
+ 								ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
+ 								ifFalse: [mapByte bitAnd: DisplacementMask])].
- 		 mcpc := mcpc + (annotation = IsDisplacementX2N
- 							ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
- 							ifFalse: [mapByte bitAnd: DisplacementMask]).
  		 mcpc >= targetMcpc ifTrue:
  			[self assert: mcpc = targetMcpc.
  			 ^map].
  		 map := map - 1].
  	^0!

Item was changed:
  ----- Method: Cogit>>generateMapAt:start: (in category 'method map') -----
  generateMapAt: addressOrNull start: startAddress
  	"Generate the method map at addressrNull (or compute it if adressOrNull is null).
  	 Answer the length of the map in byes.  Each entry in the map is in two parts.  In the
+ 	 least signficant bits are a displacement of how far from the start or previous entry,
+ 	 unless it is an IsAnnotationExtension byte, in which case those bits are the extension.
- 	 least signficant bits are a displacement of how far from the start or previous entry.
  	 In the most signficant bits are the type of annotation at the point reached.  A null
  	 byte ends the map."
  	| length location |
  	<var: #annotation type: #'InstructionAnnotation *'>
  	length := 0.
  	location := startAddress.
  	0 to: annotationIndex - 1 do:
  		[:i| | annotation mcpc delta maxDelta mapEntry |
  		 annotation := self addressOf: (annotations at: i).
  		 mcpc := annotation instruction address + annotation instruction machineCodeSize.
+ 		 [(delta := mcpc - location) > DisplacementMask] whileTrue:
- 		 [(delta := mcpc - location) > MaxUnitDisplacement] whileTrue:
  			[maxDelta := (delta min: MaxX2NDisplacement) bitClear: DisplacementMask.
  			 self assert: maxDelta >> AnnotationShift <= DisplacementMask.
  			 addressOrNull ~= 0 ifTrue:
  				[objectMemory
  					byteAt: addressOrNull - length
  					put: maxDelta >> AnnotationShift + DisplacementX2N.
  				 self traceMap: IsDisplacementX2N
  					  byte: maxDelta >> AnnotationShift + DisplacementX2N
  					  at: addressOrNull - length
  					  for: mcpc].
  			 location := location + maxDelta.
  			 length := length + 1].
  		 addressOrNull ~= 0 ifTrue:
+ 			[mapEntry := delta + ((annotation annotation min: IsSendCall) << AnnotationShift).
- 			[mapEntry := delta + (annotation annotation << AnnotationShift).
  			 objectMemory byteAt: addressOrNull - length put: mapEntry.
  			 self traceMap: annotation
  				  byte: mapEntry
  				  at: addressOrNull - length
+ 				  for: mcpc.
+ 			 annotation annotation > IsSendCall ifTrue: "Add the necessary IsAnnotationExtension"
+ 				[mapEntry := IsAnnotationExtension << AnnotationShift + (annotation annotation - IsSendCall).
+ 				 objectMemory byteAt: addressOrNull - (length := length + 1) put: mapEntry.
+ 				 self traceMap: annotation
+ 					  byte: mapEntry
+ 					  at: addressOrNull - length
+ 					  for: mcpc]].
- 				  for: mcpc].
  		 location := location + delta.
  		 length := length + 1].
  	addressOrNull ~= 0 ifTrue:
  		[objectMemory byteAt: addressOrNull - length put: MapEnd.
  		 self traceMap: MapEnd
  			  byte: MapEnd
  			  at: addressOrNull - length
  			  for: 0].
  	^length + 1!

Item was removed:
- ----- Method: Cogit>>implicitReceiverCacheAddressAt: (in category 'newspeak support') -----
- implicitReceiverCacheAddressAt: mcpc
- 	"Caller looks like
- 		mov LcacheAddress, SendNumArgsReg
- 		call ceImplicitReceiver"
- 	<option: #NewspeakVM>
- 	<var: #mcpc type: #'char *'>
- 	<inline: true>
- 	self assert: false.
- 	^self cCoerceSimple: (backEnd implicitReceiveCacheAt: mcpc) asUnsignedInteger to: #'NSSendCache *'
- !

Item was changed:
  ----- Method: Cogit>>incrementUsageOfTargetIfLinkedSend:mcpc:ignored: (in category 'compaction') -----
  incrementUsageOfTargetIfLinkedSend: annotation mcpc: mcpc ignored: superfluity
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| entryPoint |
  
+ 	self cppIf: NewspeakVM ifTrue:
+ 		[annotation = IsNSSendCall ifTrue:
+ 			[| nsSendCache |
+ 			 nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ 			 nsSendCache classTag ~= 0 ifTrue: "send is linked"
+ 				[ | targetMethod |
+ 				entryPoint := nsSendCache target.
+ 				targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ 				self assert: (self isPCWithinMethodZone: targetMethod asUnsignedInteger).
+ 				targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
+ 					[targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
- 	self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- 		[|  nsSendCache |
- 		 nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- 		 nsSendCache classTag ~= 0 ifTrue: "send is linked"
- 			[ | targetMethod |
- 			entryPoint := nsSendCache target.
- 			targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- 			self assert: (self isPCWithinMethodZone: targetMethod asUnsignedInteger).
- 			targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
- 				[targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[self assert: annotation ~= IsNSSendCall.
  		 entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase ifTrue: "It's a linked send."
+ 			[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 			[self targetMethodAndSendTableFor: entryPoint into:
  				[:targetMethod :sendTable|
  				 targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
  					[targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
  
  	^0 "keep scanning"!

Item was added:
+ ----- Method: Cogit>>isDirectedSuper:extA:extB: (in category 'bytecode generator support') -----
+ isDirectedSuper: descriptor extA: exta extB: extb
+ 	"235	(1)	11101011	iiiiijjj	ExtendB < 64
+ 										ifTrue: [Send To Superclass
+ 													Literal Selector #iiiii (+ Extend A * 32)
+ 													with jjj (+ Extend B * 8) Arguments]
+ 										ifFalse: [Send To Superclass of Stacked Class
+ 													Literal Selector #iiiii (+ Extend A * 32)
+ 													with jjj (+ (Extend B bitAnd: 63) * 8) Arguments]"
+ 	<inline: true>
+ 	^descriptor notNil
+ 	  and: [descriptor == #genExtSendSuperBytecode
+ 	  and: [extb >= 64]]!

Item was added:
+ ----- Method: Cogit>>isPCMappedAnnotation: (in category 'method map') -----
+ isPCMappedAnnotation: annotation
+ 	<inline: true>
+ 	^annotation >= IsSendCall
+ 	  or: [annotation = HasBytecodePC
+ 	  or: [NewspeakVM and: [annotation = IsNSSendCall]]]!

Item was removed:
- ----- Method: Cogit>>isPCMappedAnnotation:alternateInstructionSet: (in category 'method map') -----
- isPCMappedAnnotation: annotation alternateInstructionSet: isAlternateInstSet
- 	<inline: true>
- 	^self cppIf: NewspeakVM
- 		ifTrue:
- 			[annotation = IsSendCall
- 			or: [annotation = IsNSSendCall
- 			or: [annotation = HasBytecodePC]]]
- 		ifFalse:
- 			[(annotation = IsSendCall)
- 			  or: [annotation = HasBytecodePC]]!

Item was added:
+ ----- Method: Cogit>>isPureSendAnnotation: (in category 'method map') -----
+ isPureSendAnnotation: annotation
+ 	<inline: true>
+ 	^annotation >= IsSendCall!

Item was changed:
  ----- Method: Cogit>>isSendAnnotation: (in category 'method map') -----
  isSendAnnotation: annotation
  	<inline: true>
+ 	^annotation >= IsSendCall
+ 	  or: [NewspeakVM and: [annotation = IsNSSendCall]]!
- 	^self cppIf: NewspeakVM
- 		ifTrue: [annotation = IsSendCall or: [annotation = IsNSSendCall]]
- 		ifFalse: [annotation = IsSendCall]!

Item was removed:
- ----- Method: Cogit>>isSuperSend: (in category 'in-line cacheing') -----
- isSuperSend: entryPoint
- 	<inline: true>
- 	^(entryPoint bitAnd: entryPointMask) ~= checkedEntryAlignment!

Item was changed:
  ----- Method: Cogit>>linkSendAt:in:to:offset:receiver: (in category 'in-line cacheing') -----
  linkSendAt: callSiteReturnAddress in: sendingMethod to: targetMethod offset: theEntryOffset receiver: receiver
  	<api>
  	<var: #sendingMethod type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	| inlineCacheTag address extent |
+ 	self assert: (theEntryOffset = cmEntryOffset or: [theEntryOffset = cmNoCheckEntryOffset]).
- 	self cppIf: NewspeakVM
- 		ifTrue: [self assert: (theEntryOffset = cmEntryOffset
- 							or: [theEntryOffset = cmNoCheckEntryOffset
- 							or: [theEntryOffset = cmSelfSendEntryOffset
- 							or: [theEntryOffset = cmDynSuperEntryOffset]]])]
- 		ifFalse: [self assert: (theEntryOffset = cmEntryOffset
- 							or: [theEntryOffset = cmNoCheckEntryOffset])].
  	self assert: (callSiteReturnAddress between: methodZoneBase and: methodZone freeStart).
  	inlineCacheTag := theEntryOffset = cmNoCheckEntryOffset
  						ifTrue: [targetMethod selector "i.e. no change"]
  						ifFalse: [objectRepresentation inlineCacheTagForInstance: receiver].
  	(objectRepresentation inlineCacheTagIsYoung: inlineCacheTag) ifTrue:
  		[methodZone ensureInYoungReferrers: sendingMethod].
  	address := targetMethod asInteger + theEntryOffset.
  	extent := backEnd
  				rewriteInlineCacheAt: callSiteReturnAddress
  				tag: inlineCacheTag
  				target: address.
  	processor
  		flushICacheFrom: callSiteReturnAddress - 1 - extent
  		to: callSiteReturnAddress - 1!

Item was changed:
  ----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
  	"Machine-code <-> bytecode pc mapping support.  Evaluate functionSymbol
  	 for each mcpc, bcpc pair in the map until the function returns non-zero,
  	 answering that result, or 0 if it fails to.  This works only for frameful methods."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor *desc, sqInt isBackwardBranch, char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	<inline: true>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self assert: cogMethod stackCheckOffset > 0.
  	"In both CMMethod and CMBlock cases find the start of the map and
  	 skip forward to the bytecode pc map entry for the stack check."
  	cogMethod cmType = CMMethod
  		ifTrue:
  			[isInBlock := false.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsObjectReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory numBytesOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
  		ifFalse:
  			[isInBlock := true.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
  			 [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  				[map := map - 1].
  			 map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
  			 aMethodObj := homeMethod methodObject.
  			 bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			 byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  			 descriptor := self generatorAt: byte.
  			 endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
  	bcpc := startbcpc.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	nExts := 0.
  	"The stack check maps to the start of the first bytecode,
  	 the first bytecode being effectively after frame build."
  	result := self perform: functionSymbol
  					with: nil
  					with: false
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	"Now skip up through the bytecode pc map entry for the stack check." 
  	[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  		[map := map - 1].
  	map := map - 1.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[| annotation nextBcpc isBackwardBranch |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
+ 				(self isPCMappedAnnotation: annotation) ifTrue:
- 				(self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue:
  					[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  					  descriptor := self generatorAt: byte.
  					  isInBlock
  						ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
  						ifFalse:
  							[(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0].
  							 (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  								[| targetPC |
  								 targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					isBackwardBranch := descriptor isBranch
  										   and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj].
  					result := self perform: functionSymbol
  									with: descriptor
  									with: isBackwardBranch
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: bcpc
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc.
  					 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
  			ifFalse:
+ 				[self assert: (mapByte >> AnnotationShift = IsDisplacementX2N
+ 							or: [mapByte >> AnnotationShift = IsAnnotationExtension]).
+ 				 mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
+ 					[mcpc := mcpc + (mapByte - DisplacementX2N << AnnotationShift)]].
- 				[mcpc := mcpc + (mapByte >= DisplacementX2N
- 									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
- 									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

Item was added:
+ ----- Method: Cogit>>mapFor:performAllMapEntriesUntil:arg: (in category 'method map') -----
+ mapFor: cogMethod performAllMapEntriesUntil: functionSymbol arg: arg
+ 	"Analysis support"
+ 	<doNotGenerate>
+ 	| mcpc map mapByte result |
+ 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
+ 	map := self mapStartFor: cogMethod.
+ 	[(mapByte := coInterpreter byteAt: map) ~= MapEnd] whileTrue:
+ 		[mapByte >= FirstAnnotation
+ 			ifTrue:
+ 				[mcpc := mcpc + (mapByte bitAnd: DisplacementMask)]
+ 			ifFalse:
+ 				[mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
+ 					[mcpc := mcpc + (mapByte - DisplacementX2N << AnnotationShift)]].
+ 		 result := self perform: functionSymbol
+ 					   with: mapByte >> AnnotationShift
+ 					   with: (self cCoerceSimple: mcpc to: #'char *')
+ 					   with: arg.
+ 		 result ~= 0 ifTrue:
+ 			[^result].
+ 		 map := map - 1].
+ 	^0!

Item was changed:
  ----- Method: Cogit>>mapFor:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod performUntil: functionSymbol arg: arg
  	"Unlinking/GC/Disassembly support"
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #functionSymbol declareC: 'int (*functionSymbol)(sqInt annotation, char *mcpc, sqInt arg)'>
  	<inline: true>
+ 	| mcpc map mapByte annotation result |
- 	| mcpc map mapByte result |
  	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
  	map := self mapStartFor: cogMethod.
  	[(mapByte := coInterpreter byteAt: map) ~= MapEnd] whileTrue:
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
+ 				 "If this is an IsSendCall annotation, peek ahead for an IsAnnotationExtension, and consume it."
+ 				 ((annotation := mapByte >> AnnotationShift) = IsSendCall
+ 				  and: [(mapByte := coInterpreter byteAt: map - 1) >> AnnotationShift = IsAnnotationExtension]) ifTrue:
+ 					[annotation := annotation + (mapByte bitAnd: DisplacementMask).
+ 					 map := map - 1].
  				 result := self perform: functionSymbol
+ 							   with: annotation
- 							   with: mapByte >> AnnotationShift
  							   with: (self cCoerceSimple: mcpc to: #'char *')
  							   with: arg.
  				 result ~= 0 ifTrue:
  					[^result]]
  			ifFalse:
+ 				[mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
+ 					[mcpc := mcpc + (mapByte - DisplacementX2N << AnnotationShift)]].
- 				[mcpc := mcpc + (mapByte >= DisplacementX2N
- 									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
- 									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asUnsignedInteger.
  		 (objectRepresentation
  				markAndTraceLiteral: literal
  				in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  				atpc: mcpc asUnsignedInteger) ifTrue:
  			[codeModified := true]].
  
+ 	self cppIf: NewspeakVM ifTrue:
+ 		[annotation = IsNSSendCall ifTrue:
+ 			[| nsSendCache sel eo |
+ 			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ 			sel := nsSendCache selector.
+ 				(objectMemory isForwarded: sel)
+ 					ifFalse: [objectMemory markAndTrace: sel]
+ 					ifTrue: [sel := objectMemory followForwarded: literal.
+ 							nsSendCache selector: sel.
+ 							self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
+ 			eo := nsSendCache enclosingObject.
+ 			eo ~= 0 ifTrue:
+ 				[(objectMemory isForwarded: eo)
+ 					ifFalse: [objectMemory markAndTrace: eo]
+ 					ifTrue: [eo := objectMemory followForwarded: literal.
+ 							nsSendCache enclosingObject: eo.
+ 							self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
- 	self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- 		[| nsSendCache sel eo |
- 		nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- 		sel := nsSendCache selector.
- 			(objectMemory isForwarded: sel)
- 				ifFalse: [objectMemory markAndTrace: sel]
- 				ifTrue: [sel := objectMemory followForwarded: literal.
- 						nsSendCache selector: sel.
- 						self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
- 		eo := nsSendCache enclosingObject.
- 		eo ~= 0 ifTrue:
- 			[(objectMemory isForwarded: eo)
- 				ifFalse: [objectMemory markAndTrace: eo]
- 				ifTrue: [eo := objectMemory followForwarded: literal.
- 						nsSendCache enclosingObject: eo.
- 						self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj |
  			 tagCouldBeObj ifTrue:
  				[(objectRepresentation
  						markAndTraceCacheTagLiteral: cacheTag
  						in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  						atpc: mcpc asUnsignedInteger) ifTrue:
  					["cacheTag is selector" codeModified := true]]]].
  
  	^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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asUnsignedInteger.
  		 (objectRepresentation
  				markAndTraceLiteral: literal
  				in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  				atpc: mcpc asUnsignedInteger) ifTrue:
  			[codeModified := true]].
  
+ 	self cppIf: NewspeakVM ifTrue:
+ 		[annotation = IsNSSendCall ifTrue:
+ 			[| nsSendCache entryPoint targetMethod sel eo |
+ 			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ 			entryPoint := nsSendCache target.
+ 			entryPoint ~= 0 ifTrue: "Send is linked"
+ 				[targetMethod := entryPoint - cmNoCheckEntryOffset.
+ 				(self markAndTraceOrFreeCogMethod: targetMethod
+ 					firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:	
+ 						[nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
+ 			sel := nsSendCache selector.
+ 				(objectMemory isForwarded: sel)
+ 					ifFalse: [objectMemory markAndTrace: sel]
+ 					ifTrue: [sel := objectMemory followForwarded: literal.
+ 							nsSendCache selector: sel.
+ 							self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
+ 			eo := nsSendCache enclosingObject.
+ 			eo ~= 0 ifTrue:
+ 				[(objectMemory isForwarded: eo)
+ 					ifFalse: [objectMemory markAndTrace: eo]
+ 					ifTrue: [eo := objectMemory followForwarded: literal.
+ 							nsSendCache enclosingObject: eo.
+ 							self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
- 	self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- 		[| nsSendCache entryPoint targetMethod sel eo |
- 		nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- 		entryPoint := nsSendCache target.
- 		entryPoint ~= 0 ifTrue: "Send is linked"
- 			[targetMethod := entryPoint - cmNoCheckEntryOffset.
- 			(self markAndTraceOrFreeCogMethod: targetMethod
- 				firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:	
- 					[nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
- 		sel := nsSendCache selector.
- 			(objectMemory isForwarded: sel)
- 				ifFalse: [objectMemory markAndTrace: sel]
- 				ifTrue: [sel := objectMemory followForwarded: literal.
- 						nsSendCache selector: sel.
- 						self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
- 		eo := nsSendCache enclosingObject.
- 		eo ~= 0 ifTrue:
- 			[(objectMemory isForwarded: eo)
- 				ifFalse: [objectMemory markAndTrace: eo]
- 				ifTrue: [eo := objectMemory followForwarded: literal.
- 						nsSendCache enclosingObject: eo.
- 						self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
  
+ 	annotation = IsNSSendCall ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
  			 self assert: annotation ~= IsNSSendCall.
  			 cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
  			 entryPoint > methodZoneBase
  				ifTrue: "It's a linked send."
+ 					[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 					[self targetMethodAndSendTableFor: entryPoint into:
  						[:targetMethod :sendTable| 
  						 (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."
  							 self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable.
  							 objectRepresentation
  								markAndTraceLiteral: targetMethod selector
  								in: targetMethod
  								at: (self addressOf: targetMethod selector put: [:val| targetMethod selector: val])]]]
  				ifFalse:  "cacheTag is selector"
  					[(objectRepresentation
  							markAndTraceCacheTagLiteral: cacheTag
  							in: cogMethod
  							atpc: mcpc asUnsignedInteger) ifTrue:
  						[codeModified := true]]]].
  
  	^0 "keep scanning"!

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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 objectRepresentation markAndTraceLiteralIfYoung: literal].
  
  	self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
  		[| nsSendCache |
  		 nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  		 objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
  		 nsSendCache enclosingObject ~= 0 ifTrue:
  			[objectRepresentation markAndTraceLiteralIfYoung: nsSendCache enclosingObject]]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj |
  			 tagCouldBeObj ifTrue:
  				[objectRepresentation markAndTraceLiteralIfYoung: cacheTag]]].
  
  	^0 "keep scanning"!

Item was removed:
- ----- Method: Cogit>>maybeRememberPrevMap:absPCMcpc: (in category 'method map') -----
- maybeRememberPrevMap: annotation absPCMcpc: mcpc
- 	"This is a nop in all except the SistaStackToRegisterMappingCogit."
- 	<inline: true>!

Item was added:
+ ----- Method: Cogit>>nextDescriptorAndExtensionsInto: (in category 'bytecode generator support') -----
+ nextDescriptorAndExtensionsInto: aTrinaryBlock
+ 	"Peek ahead and deliver the next descriptor plus extension bytes."
+ 	<inline: true>
+ 	| savedB0 savedB1 savedB2 savedB3 savedEA savedEB descriptor bcpc |
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	savedB0 := byte0. savedB1 := byte1. savedB2 := byte2. savedB3 := byte3.
+ 	savedEA := extA. savedEB := extB.
+ 	bcpc := bytecodePC.
+ 	[bcpc > endPC ifTrue:
+ 		[^aTrinaryBlock value: nil value: 0 value: 0].
+ 	 byte0 := (objectMemory fetchByte: bcpc ofObject: methodObj)  + bytecodeSetOffset.
+ 	 descriptor := self generatorAt: byte0.
+ 	 self loadSubsequentBytesForDescriptor: descriptor at: bcpc.
+ 	 descriptor isExtension ifFalse:
+ 		[| eA eB |
+ 		 eA := extA. eB := extB.
+ 		 extA := savedEA. extB := savedEB.
+ 		 byte0 := savedB0. byte1 := savedB1. byte2 := savedB2. byte3 := savedB3.
+ 	 	 ^aTrinaryBlock value: descriptor value: eA value: eB].
+ 	 self perform: descriptor generator.
+ 	 bcpc := bcpc + descriptor numBytes.
+ 	 true] whileTrue!

Item was changed:
  ----- Method: Cogit>>offsetAndSendTableFor:annotation:into: (in category 'in-line cacheing') -----
  offsetAndSendTableFor: entryPoint annotation: annotation into: binaryBlock
  	"Find the relevant sendTable for a linked-send to entryPoint.  Do this based on the
+ 	 annotation.  c.f. annotationForSendTable:"
- 	 alignment of entryPoint.  N.B.  For Newspeak sends we don't need to distinguish
- 	 between ceImplicitReceiver and the other sends since ceImplicitReceiver will
- 	 never appear to be linked, so only three cases here."
  	<inline: true>
+ 	| offset sendTable |
+ 	<var: #sendTable type: #'sqInt *'>
+ 	annotation = IsSendCall ifTrue:
+ 		[offset := cmEntryOffset.
+ 		 sendTable := ordinarySendTrampolines] ifFalse:
+ 	[(SistaVM and: [annotation = IsDirectedSuperSend]) ifTrue:
+ 		[offset := cmNoCheckEntryOffset.
+ 		 sendTable := directedSuperSendTrampolines] ifFalse:
+ 	[(NewspeakVM and: [annotation = IsNSSelfSend]) ifTrue:
+ 		[offset := cmEntryOffset.
+ 		 sendTable := selfSendTrampolines] ifFalse:
+ 	[(NewspeakVM and: [annotation = IsNSSelfSend]) ifTrue:
+ 		[offset := cmEntryOffset.
+ 		 sendTable := selfSendTrampolines] ifFalse:
+ 	[(NewspeakVM and: [annotation = IsNSSelfSend]) ifTrue:
+ 		[offset := cmEntryOffset.
+ 		 sendTable := selfSendTrampolines] ifFalse:
+ 	[self assert: annotation = IsSuperSend.
+ 	 offset := cmNoCheckEntryOffset.
+ 	 sendTable := superSendTrampolines]]]]].
+ 
+ 	binaryBlock
+ 		value: offset
+ 		value: sendTable!
- 	self cppIf: NewspeakVM
- 		ifTrue:
- 			[self assert: annotation = IsSendCall.
- 			 (entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- 				ifTrue: [binaryBlock value: cmEntryOffset value: ordinarySendTrampolines]
- 				ifFalse: [(entryPoint bitAnd: entryPointMask) = selfSendEntryAlignment
- 					ifTrue: [binaryBlock value: cmSelfSendEntryOffset value: selfSendTrampolines]
- 					ifFalse: [(entryPoint bitAnd: entryPointMask) = dynSuperEntryAlignment
- 						ifTrue: [binaryBlock value: cmDynSuperEntryOffset value: dynamicSuperSendTrampolines]
- 						ifFalse: [binaryBlock value: cmNoCheckEntryOffset value: superSendTrampolines]]]]
- 		ifFalse:
- 			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- 				ifTrue: [binaryBlock value: cmEntryOffset value: ordinarySendTrampolines]
- 				ifFalse: [binaryBlock value: cmNoCheckEntryOffset value: superSendTrampolines]]!

Item was changed:
  ----- Method: Cogit>>printMapEntry:mcpc:args: (in category 'disassembly') -----
  printMapEntry: annotation mcpc: mcpc args: tupleOfStreamCodeRangesAndMethod
  	"Print the Map entry's mcpc, its annotation and the corresponding bytecode pc, if any."
  	<doNotGenerate>
+ 	[:aStream :codeRanges :cogMethod|
- 	[:aStream :codeRanges :cogMethod| | isAltInstSet |
- 	isAltInstSet := coInterpreter headerIndicatesAlternateBytecodeSet: cogMethod methodHeader.
  	self startMcpcAndCogMethodForMcpc: mcpc in: cogMethod do:
  		[:startmcpc :subMethod| | name codeRange |
  		"Find the start of the block by searching the code ranges."
  		codeRange := codeRanges detect: [:range| range includes: mcpc].
  		codeRange first = mcpc ifTrue:
  			[aStream nextPutAll: 'startpc: '; print: codeRange startpc; cr].
  		aStream
  			next: 2 put: Character space;
  			nextPutAll: mcpc hex;  space;
  			nextPutAll: (name := self class annotationConstantNames at: annotation + 1);
  			next: 20 - name size put: Character space;
  			nextPut: $(;
  			nextPutAll: (self findMapLocationForMcpc: mcpc inMethod: cogMethod) hex.
+ 		(self isPCMappedAnnotation: annotation) ifTrue:
- 		(self isPCMappedAnnotation: annotation alternateInstructionSet: isAltInstSet) ifTrue:
  			[aStream
  				nextPutAll: ', bc: ';
  				print: (self bytecodePCFor: mcpc startBcpc: codeRange startpc in: subMethod)].
  		(self isSendAnnotation: annotation) ifTrue:
  			[| sel |
  			sel := self selectorForSendAt: mcpc annotation: annotation.
  			sel isInteger ifTrue:
  				[sel := self lookupAddress: sel].
  			sel isString ifTrue:
  				[aStream space; nextPutAll: sel]].
  		aStream
  			nextPut: $);
  			cr; flush]]
  		valueWithArguments: tupleOfStreamCodeRangesAndMethod.
  	^0!

Item was changed:
  ----- Method: Cogit>>printPCMapPairsFor:on: (in category 'method map') -----
  printPCMapPairsFor: cogMethod on: aStream
  	<doNotGenerate>
+ 	<inline: true>
+ 	| mcpc map mapByte annotation |
+ 	mcpc := cogMethod asInteger + cmNoCheckEntryOffset.
+ 	map := self mapStartFor: cogMethod.
+ 	[(mapByte := coInterpreter byteAt: map) ~= MapEnd] whileTrue:
+ 		[annotation := mapByte >> AnnotationShift.
+ 		 annotation ~= IsAnnotationExtension ifTrue:
+ 			[mcpc := mcpc + (annotation = IsDisplacementX2N
+ 								ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
+ 								ifFalse: [mapByte bitAnd: DisplacementMask])].
+ 		 aStream ensureCr.
+ 		 map printOn: aStream base: 16.
+ 		 aStream nextPutAll: ': '.
+ 		 mapByte printOn: aStream base: 16.
+ 		 aStream space.
+ 		 annotation printOn: aStream base: 16.
+ 		 aStream nextPutAll: ' ('; print: (AnnotationConstantNames at: annotation + 1); nextPutAll: ') '.
+ 		 (mapByte bitAnd: DisplacementMask) printOn: aStream base: 16.
+ 		 aStream space.
+ 		 aStream nextPut: $@.
+ 		 mcpc printOn: aStream base: 16.
+ 		 aStream flush.
+ 		 map := map - 1]!
- 	(self subMethodsAsRangesFor: cogMethod)
- 		do: [:sm|
- 			self mapFor: sm cogMethod bcpc: sm startpc performUntil: #print:IsBackwardBranch:Mcpc:Bcpc:on: arg: aStream]
- 		separatedBy: [aStream tab; next: 2 put: $=; cr]!

Item was changed:
  ----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
  relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: delta
  	<var: #mcpc type: #'char *'>
+ 	| entryPoint targetMethod unlinkedRoutine |
- 	| entryPoint offset sendTable targetMethod unlinkedRoutine |
- 	<var: #sendTable type: #'sqInt *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			["Retrieve the send cache before relocating the stub call. Fetching the send
  			  cache asserts the stub call points below all the cogged methods, but
  			  until this method is actually moved, the adjusted stub call may appear to
  			  point to somewhere in the method zone."
  			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  
  			"Fix call to trampoline. This method is moving [delta] bytes, and calls are
  			 relative, so adjust the call by -[delta] bytes"
  			backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  
  			nsSendCache target ~= 0 ifTrue: "Send is linked"
  				[entryPoint := nsSendCache target.
  				targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  				targetMethod cmType = CMMethod
  					ifTrue: "send target not freed; just relocate. The cache has an absolute
  							target, so only adjust by the target method's displacement."
  						[nsSendCache target: entryPoint + targetMethod objectHeader]
  					ifFalse: "send target was freed, unlink"
  						[nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
  			^0]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
  			[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  			 ^0].
  		"It's a linked send; find which kind."
  		self
  			offsetAndSendTableFor: entryPoint
  			annotation: annotation
+ 			into: [:offset :sendTable|
+ 				 targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
+ 				 targetMethod cmType = CMMethod ifTrue: "send target not freed; just relocate."
+ 					[backEnd
+ 						relocateCallBeforeReturnPC: mcpc asInteger
+ 						by: (delta - targetMethod objectHeader) negated.
+ 					 ^0].
+ 				 "Target was freed; map back to an unlinked send; but include this method's reocation"
+ 				 unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
+ 				 unlinkedRoutine := unlinkedRoutine - delta.
+ 				 backEnd
+ 					rewriteInlineCacheAt: mcpc asInteger
+ 					tag: targetMethod selector
+ 					target: unlinkedRoutine.
+ 				 ^0]].
- 			into: [:off :table| offset := off. sendTable := table].
- 		 targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
- 		 targetMethod cmType = CMMethod ifTrue: "send target not freed; just relocate."
- 			[backEnd
- 				relocateCallBeforeReturnPC: mcpc asInteger
- 				by: (delta - targetMethod objectHeader) negated.
- 			 ^0].
- 		"Target was freed; map back to an unlinked send; but include this method's reocation"
- 		 unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
- 		 unlinkedRoutine := unlinkedRoutine - delta.
- 		 backEnd
- 			rewriteInlineCacheAt: mcpc asInteger
- 			tag: targetMethod selector
- 			target: unlinkedRoutine.
- 		 ^0].
  
  	annotation = IsRelativeCall ifTrue:
  		[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  		 ^0].
  
  	annotation = IsAbsPCReference ifTrue:
  		[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: delta].
  
  	^0 "keep scanning"!

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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	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 cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
  		[| nsSendCache oop mappedOop |
  		nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  		oop := nsSendCache selector.	
  		mappedOop := objectRepresentation remapObject: oop.
  		oop ~= mappedOop ifTrue:
  			[nsSendCache selector: mappedOop.
  			(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
  				[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  		oop := nsSendCache enclosingObject.	
  		oop ~= 0 ifTrue: [
  			mappedOop := objectRepresentation remapObject: oop.
  			oop ~= mappedOop ifTrue:
  				[nsSendCache enclosingObject: mappedOop.
  				(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
  					[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
  		^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall 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]].
  			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 annotation: annotation into:
- 					[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 removed:
- ----- Method: Cogit>>selfSendEntryOffset (in category 'accessing') -----
- selfSendEntryOffset
- 	<api>
- 	<cmacro: '() cmSelfSendEntryOffset'>
- 	^cmSelfSendEntryOffset!

Item was changed:
+ ----- Method: Cogit>>shouldBeImplemented (in category 'bytecode generator support') -----
- ----- Method: Cogit>>shouldBeImplemented (in category 'bytecode generators') -----
  shouldBeImplemented
  	"In the production VM we can continue in the interpreter..."
  	self cCode: [coInterpreter warning: 'bytecode should be implemented; interpreting']
  		inSmalltalk: [super shouldBeImplemented]!

Item was added:
+ ----- Method: Cogit>>targetMethodAndSendTableFor:annotation:into: (in category 'in-line cacheing') -----
+ targetMethodAndSendTableFor: entryPoint annotation: annotation into: binaryBlock
+ 	"Evaluate binaryBlock with the targetMethod and relevant send table for a linked-send
+ 	 to entryPoint.  Do so based on the alignment of entryPoint.  N.B.  For Newspeak sends
+ 	 we don't need to distinguish between ceImplicitReceiver and the other sends since
+ 	 ceImplicitReceiver will never appear to be linked, so only three cases here."
+ 	<inline: true>
+ 	| targetMethod sendTable |
+ 	<var: #targetMethod type: #'CogMethod *'>
+ 	<var: #sendTable type: #'sqInt *'>
+ 
+ 	annotation = IsSendCall ifTrue:
+ 		[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
+ 		 sendTable := ordinarySendTrampolines] ifFalse:
+ 	[(SistaVM and: [annotation = IsDirectedSuperSend]) ifTrue:
+ 		[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ 		 sendTable := directedSuperSendTrampolines] ifFalse:
+ 	[(NewspeakVM and: [annotation = IsNSSelfSend]) ifTrue:
+ 		[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
+ 		 sendTable := selfSendTrampolines] ifFalse:
+ 	[(NewspeakVM and: [annotation = IsNSSelfSend]) ifTrue:
+ 		[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
+ 		 sendTable := selfSendTrampolines] ifFalse:
+ 	[(NewspeakVM and: [annotation = IsNSSelfSend]) ifTrue:
+ 		[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
+ 		 sendTable := selfSendTrampolines] ifFalse:
+ 	[self assert: annotation = IsSuperSend.
+ 	 targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ 	 sendTable := superSendTrampolines]]]]].
+ 
+ 	binaryBlock
+ 		value: targetMethod
+ 		value: sendTable!

Item was removed:
- ----- Method: Cogit>>targetMethodAndSendTableFor:into: (in category 'in-line cacheing') -----
- targetMethodAndSendTableFor: entryPoint into: binaryBlock
- 	"Evaluate binaryBlock with the targetMethod and relevant send table for a linked-send
- 	 to entryPoint.  Do so based on the alignment of entryPoint.  N.B.  For Newspeak sends
- 	 we don't need to distinguish between ceImplicitReceiver and the other sends since
- 	 ceImplicitReceiver will never appear to be linked, so only three cases here."
- 	<inline: true>
- 	| targetMethod sendTable |
- 	<var: #targetMethod type: #'CogMethod *'>
- 	<var: #sendTable type: #'sqInt *'>
- 	self cppIf: NewspeakVM
- 		ifTrue:
- 			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- 				ifTrue:
- 					[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
- 					 sendTable := ordinarySendTrampolines]
- 			ifFalse: [(entryPoint bitAnd: entryPointMask) = selfSendEntryAlignment
- 				ifTrue:
- 					[targetMethod := self cCoerceSimple: entryPoint - cmSelfSendEntryOffset to: #'CogMethod *'.
- 					 sendTable := selfSendTrampolines]
- 			ifFalse: [(entryPoint bitAnd: entryPointMask) = dynSuperEntryAlignment
- 				ifTrue:
- 					[targetMethod := self cCoerceSimple: entryPoint - cmDynSuperEntryOffset to: #'CogMethod *'.
- 					 sendTable := dynamicSuperSendTrampolines]
- 				ifFalse:
- 					[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- 					 sendTable := superSendTrampolines]]]]
- 		ifFalse:
- 			[(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- 				ifTrue:
- 					[targetMethod := self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *'.
- 					 sendTable := ordinarySendTrampolines]
- 				ifFalse:
- 					[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- 					 sendTable := superSendTrampolines]].
- 	binaryBlock
- 		value: targetMethod
- 		value: sendTable!

Item was changed:
  ----- Method: Cogit>>testBcToMcPcMappingForCompiledMethod:cogMethod: (in category 'tests-method map') -----
  testBcToMcPcMappingForCompiledMethod: aCompiledMethod cogMethod: cogMethod
  	<doNotGenerate>
  	"self disassembleMethod: cogMethod"
  	"self printPCMapPairsFor: cogMethod on: Transcript"
+ 	| aMethodObj subMethods bsOffset |
- 	| aMethodObj currentSubMethod subMethods bsOffset |
  	aMethodObj := cogMethod methodObject.
  	subMethods := self subMethodsAsRangesFor: cogMethod.
+ 	subMethods first endPC: (self endPCOf: aMethodObj).
- 	currentSubMethod := subMethods first.
- 	currentSubMethod endPC: (self endPCOf: aMethodObj).
  	bsOffset := self bytecodeSetOffsetFor: aMethodObj.
  	self bcpcsAndDescriptorsFor: aMethodObj bsOffset: bsOffset do:
  		[:bcpc :byte :desc :nExts| | subMethod |
  		(desc notNil and: [desc isBlockCreation]) ifTrue:
  			[subMethod := subMethods detect: [:sm| sm startpc = (bcpc + desc numBytes)].
  			 subMethod endPC: bcpc + desc numBytes + (self spanFor: desc at: bcpc exts: -1 in: aMethodObj) - 1]].
  	subMethods allButFirst do:
  		[:blockSubMethod| | cogBlockMethod |
  		cogBlockMethod := self
  								findMethodForStartBcpc: blockSubMethod startpc
  								inHomeMethod: cogMethod.
  		self assert: cogBlockMethod address = (blockSubMethod first - (self sizeof: CogBlockMethod))].
  	self bcpcsAndDescriptorsFor: aMethodObj bsOffset: bsOffset do:
+ 		[:bcpc :byte :desc :nExts| | currentSubMethod subCogMethod absMcpc mappedBcpc |
- 		[:bcpc :byte :desc :nExts| | absMcpc mappedBcpc |
  		currentSubMethod := self innermostSubMethodFor: bcpc in: subMethods startingAt: 1.
+ 		subCogMethod := currentSubMethod cogMethod.
+ 		(subCogMethod stackCheckOffset > 0
- 		(currentSubMethod cogMethod stackCheckOffset > 0
  		 and: [desc isNil or: [desc isMapped]]) ifTrue:
  			["The first bytecode and backward branch bytecodes are mapped to their pc.
  			  Other bytecodes map to their following pc."
  			 absMcpc := (desc notNil
  						   and: [desc isBranch
  						   and: [self isBackwardBranch: desc at: bcpc exts: nExts in: aMethodObj]])
  							ifTrue: "Backward branches have a special mapper"
  								[mappedBcpc := bcpc.
  								 self
  									mcPCForBackwardBranch: mappedBcpc
  									startBcpc: currentSubMethod startpc
+ 									in: subCogMethod]
- 									in: currentSubMethod cogMethod]
  							ifFalse: "All others use the generic mapper"
  								[mappedBcpc := desc ifNil: [bcpc] ifNotNil: [bcpc + desc numBytes].
  								 self
  									mcPCFor: mappedBcpc
  									startBcpc: currentSubMethod startpc
+ 									in: subCogMethod].
+ 			 self assert: absMcpc >= (subCogMethod asInteger + subCogMethod stackCheckOffset).
+ 			 self assert: (self bytecodePCFor: absMcpc startBcpc: currentSubMethod startpc in: subCogMethod) = mappedBcpc]]!
- 									in: currentSubMethod cogMethod].
- 			 self assert: absMcpc > (currentSubMethod cogMethod asInteger + self noCheckEntryOffset).
- 			 self assert: (self
- 							bytecodePCFor: absMcpc
- 							startBcpc: currentSubMethod startpc
- 							in: currentSubMethod cogMethod) = mappedBcpc]]!

Item was changed:
  ----- Method: Cogit>>testMcToBcPcMappingForCompiledMethod:cogMethod: (in category 'tests-method map') -----
  testMcToBcPcMappingForCompiledMethod: aCompiledMethod cogMethod: cogMethod
  	<doNotGenerate>
+ 	| bcMethod subMethods prevMcpc |
- 	| bcMethod subMethods prevMcpc isAltInstSet |
  	"self disassembleMethod: cogMethod"
  	"coInterpreter symbolicMethod: cogMethod methodObject"
  	"coInterpreter printOop: cogMethod methodObject"
  	"self printPCMapPairsFor: cogMethod on: Transcript"
  	cogMethod stackCheckOffset = 0 ifTrue: "frameless"
  		[^self].
  	bcMethod := coInterpreter isCurrentImageFacade
  					ifTrue: [coInterpreter objectForOop: cogMethod methodObject]
  					ifFalse: [VMCompiledMethodProxy new
  								for: cogMethod methodObject
  								coInterpreter: coInterpreter
  								objectMemory: objectMemory].
  	subMethods := self subMethodsAsRangesFor: cogMethod.
- 	isAltInstSet := coInterpreter headerIndicatesAlternateBytecodeSet: cogMethod methodHeader.
  	self mapFor: cogMethod do:
+ 		[:annotation :mcpc| | subMethod subCogMethod bcpc mappedpc |
+ 		(self isPCMappedAnnotation: annotation) ifTrue:
- 		[:annotation :mcpc| | subMethod bcpc mappedpc |
- 		(self isPCMappedAnnotation: annotation alternateInstructionSet: isAltInstSet) ifTrue:
  			[subMethod := subMethods
  								detect: [:range| range includes: mcpc]
  								ifNone: ["a trailing call ceNonLocalReturnTrampoline's following
  										 pc is the start of a following block or the end of the map"
  										subMethods detect: [:range| range includes: mcpc - 1]].
  			mcpc > subMethod first ifTrue:
  				[bcpc := self
  							bytecodePCFor: mcpc
  							startBcpc: subMethod startpc
+ 							in: (subCogMethod := subMethod cogMethod).
- 							in: subMethod cogMethod.
  				self assert: bcpc ~= 0.
+ 				mappedpc := self mcPCFor: bcpc startBcpc: subMethod startpc in: subCogMethod.
+ 				subCogMethod stackCheckOffset = 0
+ 					ifTrue: [self assert: mappedpc > (subCogMethod address + self noCheckEntryOffset)]
+ 					ifFalse: [self assert: mappedpc >= (subCogMethod address + subCogMethod stackCheckOffset)].
- 				mappedpc := self mcPCFor: bcpc startBcpc: subMethod startpc in: subMethod cogMethod.
- 				self assert: mappedpc > (subMethod cogMethod address + self noCheckEntryOffset).
  				"mcpc = mappedpc is obviously what we want and expect.  prevMcpc = mappedpc hacks
  				 around frame building accessors where the first bytecode is mapped twice, once for the
  				 stack check and once for the context inst var access.  The bytecode pc can only map
  				 back to a single mcpc, the first, so the second map entry will fail without this hack."
  				self assert: (mcpc = mappedpc or: [prevMcpc = mappedpc]).
  				(self isSendAnnotation: annotation) ifTrue:
  					[| mcSelector bcSelector |
  					mcSelector := self selectorForSendAt: mcpc annotation: annotation.
  					"sends map to the following pc.  need to find the selector for the previous pc"
  					bcSelector := self selectorForSendBefore: bcpc in: bcMethod.
  					self assert: mcSelector = bcSelector]].
  			 prevMcpc := mcpc].
  		 false "keep scanning"]!

Item was changed:
  ----- Method: Cogit>>unlinkIfForwardedSend:pc:ignored: (in category 'in-line cacheing') -----
  unlinkIfForwardedSend: annotation pc: mcpc ignored: superfluity
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| entryPoint |
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			nsSendCache classTag ~= 0 ifTrue:
  				[(objectMemory isForwardedClassIndex: nsSendCache classTag) ifTrue: [
  					nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
  			"Should we check if the enclosing object's class is forwarded as well?"
  			^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send, but maybe a super send or linked to an OpenPIC, in which case the cache tag will be a selector...."
  				[(objectMemory isForwardedClassIndex: (backEnd inlineCacheTagAt: mcpc asInteger)) ifTrue:
+ 					[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 					[self targetMethodAndSendTableFor: entryPoint into:
  						[:targetMethod :sendTable|
  						 self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
  
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfFreeOrLinkedSend:pc:of: (in category 'in-line cacheing') -----
  unlinkIfFreeOrLinkedSend: annotation pc: mcpc of: theSelector
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| entryPoint |
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			 (entryPoint := nsSendCache target) ~= 0 ifTrue:
  				[ | targetMethod |
  				targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  				(targetMethod cmType = CMFree or: [nsSendCache selector = theSelector]) ifTrue:
  					[nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
  			^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
+ 				[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| 
  					 (targetMethod cmType = CMFree
  					  or: [targetMethod selector = theSelector]) ifTrue:
  						[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
  
  	^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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| entryPoint |
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			nsSendCache classTag ~= 0 ifTrue: "Send is linked"
  				[nsSendCache classTag: 0; enclosingObject: 0; target: 0].
  			^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
+ 				[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| 
  					 self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]].
  
  	^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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| entryPoint |
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			nsSendCache selector = theSelector ifTrue:
  				[nsSendCache classTag: 0; enclosingObject: 0; target: 0].
  			^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
+ 				[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| 
  					 targetMethod selector = theSelector ifTrue:
  						[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
  
  	^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 *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| entryPoint |
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache |
  		 annotation = IsNSSendCall ifTrue:
  			[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			(entryPoint := nsSendCache target) ~= 0 ifTrue:
  				[ | targetMethod |
  				targetMethod := entryPoint - cmNoCheckEntryOffset.
  				targetMethod = theCogMethod ifTrue:
  					[nsSendCache classTag: 0.
  					nsSendCache enclosingObject: 0.
  					nsSendCache target: 0]].
  			^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase
  			ifTrue: "It's a linked send."
+ 				[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 				[self targetMethodAndSendTableFor: entryPoint into:
  					[:targetMethod :sendTable| 
  					 targetMethod asInteger = theCogMethod ifTrue:
  						[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
  
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSendToFree:pc:ignored: (in category 'in-line cacheing') -----
  unlinkIfLinkedSendToFree: annotation pc: mcpc ignored: superfluity
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	<var: #nsTargetMethod type: #'CogMethod *'>
  	| entryPoint |
  
  	self cppIf: NewspeakVM ifTrue:
  		[| nsSendCache nsTargetMethod |
  		 annotation = IsNSSendCall ifTrue:
  			[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			(entryPoint := nsSendCache target) ~= 0 ifTrue: "It's a linked send."
  				[nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  				nsTargetMethod cmType = CMFree ifTrue:
  					[nsSendCache classTag: 0.
  					nsSendCache enclosingObject: 0.
  					nsSendCache target: 0]].
  			^0 "keep scanning"]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsSendCall ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint > methodZoneBase ifTrue: "It's a linked send."
+ 			[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- 			[self targetMethodAndSendTableFor: entryPoint into:
  				[:targetMethod :sendTable| 
  				 targetMethod cmType = CMFree ifTrue:
  					[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
  
  	^0 "keep scanning"!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>functionPointerForCompiledMethod:primitiveIndex: (in category 'accessing') -----
  functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex
  	^([coInterpreter functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex]
+ 			on: Error
- 			on: MessageNotUnderstood
  			do: [:ex|
  				#someExternalPrimitive]) ifNotNil:
  		[:symbol|
  		self addressForLabel: symbol]!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>voidHeaderToMethodMap (in category 'accessing') -----
+ voidHeaderToMethodMap
+ 	headerToMethodMap := Dictionary new!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>annotationForSendTable: (in category 'bytecode generator support') -----
+ annotationForSendTable: sendTable
+ 	"c.f. offsetAndSendTableFor:annotation:into:"
+ 	<inline: true>
+ 	<var: #sendTable type: #'sqInt *'>
+ 	(NewspeakVM and: [sendTable == selfSendTrampolines]) ifTrue:
+ 		[^IsNSSelfSend].
+ 	(NewspeakVM and: [sendTable == dynamicSuperSendTrampolines]) ifTrue:
+ 		[^IsNSDynamicSuperSend].
+ 	(NewspeakVM and: [sendTable == implicitReceiverSendTrampolines]) ifTrue:
+ 		[^IsNSImplicitReceiverSend].
+ 	(SistaVM and: [sendTable == directedSuperSendTrampolines]) ifTrue:
+ 		[^IsNSImplicitReceiverSend].
+ 	sendTable == superSendTrampolines ifTrue:
+ 		[^IsSuperSend].
+ 	self assert: sendTable == ordinarySendTrampolines.
+ 	^IsSendCall!

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

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>firstSpecialSelectorBytecodeOffset (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>firstSpecialSelectorBytecodeOffset (in category 'bytecode generators') -----
  firstSpecialSelectorBytecodeOffset
  	<inline: true>
  	^self cppIf: MULTIPLEBYTECODESETS
  		ifTrue: [bytecodeSetOffset = 256 ifTrue: [AltFirstSpecialSelector + 256] ifFalse: [FirstSpecialSelector]]
  		ifFalse: [FirstSpecialSelector]!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>frameOffsetOfTemporary: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>frameOffsetOfTemporary: (in category 'bytecode generators') -----
  frameOffsetOfTemporary: index
  	^index < methodOrBlockNumArgs
  		ifTrue: [FoxCallerSavedIP + ((methodOrBlockNumArgs - index) * objectMemory wordSize)]
  		ifFalse: [FoxMFReceiver - objectMemory wordSize + ((methodOrBlockNumArgs - index) * objectMemory wordSize)]!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genExtPushLitVarDirSupBytecode (in category 'bytecode generators') -----
+ genExtPushLitVarDirSupBytecode
+ 	"227		11100011	i i i i i i i i	Push Literal Variable #iiiiiiii (+ Extend A * 256)"
+ 	| index |
+ 	index := byte1 + (extA << 8).
+ 	extA := 0.
+ 	^self genPushLiteralVariableGivenDirectedSuper: index!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genExtSendSuperBytecode (in category 'bytecode generators') -----
  genExtSendSuperBytecode
  	"239		11101111	i i i i i j j j	Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
+ 	| isDirected litIndex nArgs |
+ 	(isDirected := extB >= 64) ifTrue:
+ 		[extB := extB bitAnd: 63].
- 	| litIndex nArgs |
  	litIndex := (byte1 >> 3) + (extA << 5).
  	extA := 0.
  	nArgs := (byte1 bitAnd: 7) + (extB << 3).
  	extB := 0.
+ 	^isDirected
+ 		ifTrue: [self genSendDirectedSuper: (self getLiteral: litIndex) numArgs: nArgs]
+ 		ifFalse: [self genSendSuper: (self getLiteral: litIndex) numArgs: nArgs]!
- 	^self genSendSuper: (self getLiteral: litIndex) numArgs: nArgs!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genJumpBackTo: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genJumpBackTo: (in category 'bytecode generators') -----
  genJumpBackTo: targetBytecodePC
  	self MoveAw: coInterpreter stackLimitAddress R: TempReg.
  	self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
  	self JumpAboveOrEqual: (self fixupAt: targetBytecodePC - initialPC).
  	self annotateBytecode: (self CallRT: ceCheckForInterruptTrampoline).
  	self Jump: (self fixupAt: targetBytecodePC - initialPC).
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genJumpIf:to: (in category 'bytecode generators') -----
  genJumpIf: boolean to: targetBytecodePC
  	<inline: false>
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	| ok |
  	<var: #ok type: #'AbstractInstruction *'>
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
  	self PopR: TempReg.
  	self annotate: (self SubCw: boolean R: TempReg) objRef: boolean.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self CallRT: (boolean == objectMemory falseObject
  					ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  					ifFalse: [ceSendMustBeBooleanAddTrueTrampoline]).
  	ok jmpTarget: (self annotateBytecode: self Label).
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genJumpTo: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genJumpTo: (in category 'bytecode generators') -----
  genJumpTo: targetBytecodePC
  	self Jump: (self ensureFixupAt: targetBytecodePC - initialPC).
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushEnclosingObjectAt: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushEnclosingObjectAt: (in category 'bytecode generators') -----
  genPushEnclosingObjectAt: level
  	"Uncached push enclosing object"
  	self MoveCq: level R: SendNumArgsReg.
  	self CallRT: ceEnclosingObjectTrampoline.
  	self PushR: ReceiverResultReg.
  	^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPushLitVarDirSup16CasesBytecode (in category 'bytecode generators') -----
+ genPushLitVarDirSup16CasesBytecode
+ 	"e.g. SistaV1: 16-31		0001 iiii			Push Literal Variable #iiii"
+ 	^self genPushLiteralVariableGivenDirectedSuper: (byte0 bitAnd: 15)!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPushLitVarDirSupBytecode (in category 'bytecode generators') -----
+ genPushLitVarDirSupBytecode
+ 	^self genPushLiteralVariableGivenDirectedSuper: (byte0 bitAnd: 31)!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushLiteral: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushLiteral: (in category 'bytecode generators') -----
  genPushLiteral: literal
  	self annotate: (self PushCw: literal) objRef: literal.
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushLiteralIndex: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushLiteralIndex: (in category 'bytecode generators') -----
  genPushLiteralIndex: literalIndex "<SmallInteger>"
  	<inline: false>
  	| literal |
  	literal := self getLiteral: literalIndex.
  	^self genPushLiteral: literal!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushLiteralVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushLiteralVariable: (in category 'bytecode generators') -----
  genPushLiteralVariable: literalIndex
  	<inline: false>
  	| association |
  	association := self getLiteral: literalIndex.
  	"N.B. Do _not_ use ReceiverResultReg to avoid overwriting receiver in assignment in frameless methods."
  	self annotate: (self MoveCw: association R: ClassReg) objRef: association.
  	objectRepresentation
  		genEnsureObjInRegNotForwarded: ClassReg
  		scratchReg: TempReg.
  	objectRepresentation
  		genLoadSlot: ValueIndex
  		sourceReg: ClassReg
  		destReg: TempReg.
  	self PushR: TempReg.
  	^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPushLiteralVariableGivenDirectedSuper: (in category 'bytecode generator support') -----
+ genPushLiteralVariableGivenDirectedSuper: literalIndex
+ 	"This is a version of genPushLiteralVariable: that looks ahead for a directed super send bytecode
+ 	 and does not generate any code for the dereference yet if followed by a directed super send."
+ 	<inline: false>
+ 	self nextDescriptorAndExtensionsInto:
+ 		[:descriptor :exta :extb|
+ 		(self isDirectedSuper: descriptor extA: exta extB: extb) ifTrue:
+ 			[self ssPushConstant: (self getLiteral: literalIndex).
+ 			 ^0]].
+ 	^self genPushLiteralVariable: literalIndex!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushMaybeContextReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushMaybeContextReceiverVariable: (in category 'bytecode generators') -----
  genPushMaybeContextReceiverVariable: slotIndex 
  	<inline: false>
  	| jmpSingle jmpDone |
  	<var: #jmpSingle type: #'AbstractInstruction *'>
  	<var: #jmpDone type: #'AbstractInstruction *'>
  	self assert: needsFrame.
  	"See CoInterpreter>>contextInstructionPointer:frame: for an explanation
  	 of the instruction pointer slot handling."
  	slotIndex = InstructionPointerIndex ifTrue:
  		[self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  		 self MoveCq: slotIndex R: SendNumArgsReg.
  		 self CallRT: ceFetchContextInstVarTrampoline.
  		 self PushR: SendNumArgsReg.
  		 ^0].
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	objectRepresentation
  		genLoadSlot: SenderIndex
  		sourceReg: ReceiverResultReg
  		destReg: TempReg.
  	jmpSingle := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveCq: slotIndex R: SendNumArgsReg.
  	self CallRT: ceFetchContextInstVarTrampoline.
  	jmpDone := self Jump: 0.
  	jmpSingle jmpTarget: self Label.
  	objectRepresentation
  		genLoadSlot: slotIndex
  		sourceReg: ReceiverResultReg
  		destReg: SendNumArgsReg.
  	jmpDone jmpTarget: (self PushR: SendNumArgsReg).
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushReceiverVariable: (in category 'bytecode generators') -----
  genPushReceiverVariable: index
  	<inline: false>
  	| maybeErr |
  	needsFrame ifTrue:
  		[self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg].
  	maybeErr := objectRepresentation genLoadSlot: index sourceReg: ReceiverResultReg destReg: TempReg.
  	maybeErr < 0 ifTrue:
  		[^maybeErr].
  	self PushR: TempReg.
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genPushTemporaryVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genPushTemporaryVariable: (in category 'bytecode generators') -----
  genPushTemporaryVariable: index
  	self MoveMw: (self frameOffsetOfTemporary: index) r: FPReg R: TempReg.
  	self PushR: TempReg.
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSend:numArgs: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSend:numArgs: (in category 'bytecode generators') -----
  genSend: selector numArgs: numArgs
  	<inline: true>
  	^self genSend: selector numArgs: numArgs sendTable: ordinarySendTrampolines!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSend:numArgs:sendTable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSend:numArgs:sendTable: (in category 'bytecode generators') -----
  genSend: selector numArgs: numArgs sendTable: sendTable
  	<inline: false>
  	<var: #sendTable type: #'sqInt *'>
+ 	| annotation |
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
+ 	annotation := self annotationForSendTable: sendTable.
+ 	self assert: (numArgs between: 0 and: 255). "say"
- 	self assert: (numArgs between: 0 and: 256). "say"
  	self assert: (objectMemory addressCouldBeOop: selector).
  	self MoveMw: numArgs * objectMemory wordSize r: SPReg R: ReceiverResultReg.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
+ 	self annotate: (self Call: (sendTable at: (numArgs min: NumSendTrampolines - 1)))
+ 		with: annotation.
- 	self CallSend: (sendTable at: (numArgs min: NumSendTrampolines - 1)).
  	self flag: 'currently caller pushes result'.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSendAbsentDynamicSuper:numArgs: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSendAbsentDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genSendAbsentDynamicSuper: selector numArgs: numArgs
  	"Shuffle arguments if necessary and push receiver.
  	 Then send."
  	<inline: false>
  	self marshallAbsentReceiverSendArguments: numArgs.
  	^self genSend: selector numArgs: numArgs sendTable: dynamicSuperSendTrampolines!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generators') -----
  genSendAbsentImplicit: selector numArgs: numArgs
  	| nsSendCache |
  	<inline: false>
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  
  	nsSendCache := theIRCs + (NumOopsPerNSC * objectMemory bytesPerOop * indexOfIRC).
  	indexOfIRC := indexOfIRC + 1.
  	self assert: (objectMemory isInOldSpace: nsSendCache).
  	self initializeNSSendCache: nsSendCache selector: selector numArgs: numArgs.
  
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  
  	"This leaves the method receiver on the stack, which might not be the implicit receiver. But we care
  	 not: the callee will use ReceiverResultReg to build its frame, not the value beneath the arguments."
  	self marshallAbsentReceiverSendArguments: numArgs.
  
  	"Load the cache last so it is a fixed distance from the call."
  	self MoveCw: nsSendCache R: SendNumArgsReg.
  	self CallNewspeakSend: (implicitReceiverSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
  
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSendAbsentOuter:numArgs:depth: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSendAbsentOuter:numArgs:depth: (in category 'bytecode generators') -----
  genSendAbsentOuter: selector numArgs: numArgs depth: depth
  	"Shuffle arguments if necessary and push receiver.
  	 Then send."
  	<inline: false>
  	self genPushEnclosingObjectAt: depth.
  	self PopR: ReceiverResultReg.
  	self marshallAbsentReceiverSendArguments: numArgs.
  	^self genSend: selector numArgs: numArgs!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSendAbsentSelf:numArgs: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSendAbsentSelf:numArgs: (in category 'bytecode generators') -----
  genSendAbsentSelf: selector numArgs: numArgs
  	"Shuffle arguments if necessary and push receiver.
  	 Then send."
  	<inline: false>
  	self marshallAbsentReceiverSendArguments: numArgs.
  	^self genSend: selector numArgs: numArgs sendTable: selfSendTrampolines!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genSendDirectedSuper:numArgs: (in category 'bytecode generator support') -----
+ genSendDirectedSuper: selector numArgs: numArgs
+ 	<inline: false>
+ 	self halt: 'do all that good stuff moving the literal variable to an argument reg, etc...'.
+ 	^self genSend: selector numArgs: numArgs sendTable: directedSuperSendTrampolines!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>genSendDynamicSuper:numArgs: (in category 'bytecode generators') -----
- genSendDynamicSuper: selector numArgs: numArgs
- 	(objectMemory isYoung: selector) ifTrue:
- 		[hasYoungReferent := true].
- 	self assert: needsFrame.
- 	self MoveMw: numArgs * objectMemory wordSize r: SPReg R: ReceiverResultReg.
- 	numArgs > 2 ifTrue:
- 		[self MoveCq: numArgs R: SendNumArgsReg].
- 	self MoveCw: selector R: ClassReg.
- 	self CallSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	self flag: 'currently caller pushes result'.
- 	self PushR: ReceiverResultReg.
- 	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genSendSuper:numArgs: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genSendSuper:numArgs: (in category 'bytecode generators') -----
  genSendSuper: selector numArgs: numArgs
  	<inline: false>
  	^self genSend: selector numArgs: numArgs sendTable: superSendTrampolines!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genStorePop:LiteralVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genStorePop:LiteralVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean LiteralVariable: litVarIndex
  	<inline: false>
  	| association |
  	self assert: needsFrame.
  	association := self getLiteral: litVarIndex.
  	self annotate: (self MoveCw: association R: ReceiverResultReg) objRef: association.
  	objectRepresentation
  		genEnsureObjInRegNotForwarded: ReceiverResultReg
  		scratchReg: TempReg.
  	popBoolean
  		ifTrue: [self PopR: ClassReg]
  		ifFalse: [self MoveMw: 0 r: SPReg R: ClassReg].
  	traceStores > 0 ifTrue:
  		[self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: ClassReg
  		slotIndex: ValueIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genStorePop:MaybeContextReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genStorePop:MaybeContextReceiverVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean MaybeContextReceiverVariable: slotIndex
  	<inline: false>
  	| jmpSingle jmpDone |
  	<var: #jmpSingle type: #'AbstractInstruction *'>
  	<var: #jmpDone type: #'AbstractInstruction *'>
  	self assert: needsFrame.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	objectRepresentation
  		genLoadSlot: SenderIndex
  		sourceReg: ReceiverResultReg
  		destReg: TempReg.
  	self MoveMw: 0 r: SPReg R: ClassReg.
  	jmpSingle := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveCq: slotIndex R: SendNumArgsReg.
  	self CallRT: ceStoreContextInstVarTrampoline.
  	jmpDone := self Jump: 0.
  	jmpSingle jmpTarget: self Label.
  	traceStores > 0 ifTrue:
  		[self CallRT: ceTraceStoreTrampoline].
  	objectRepresentation
  		genStoreSourceReg: ClassReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg.
  	jmpDone jmpTarget: self Label.
  	popBoolean ifTrue:
  		[self AddCq: objectMemory wordSize R: SPReg].
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genStorePop:ReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genStorePop:ReceiverVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean ReceiverVariable: slotIndex
  	<inline: false>
  	needsFrame ifTrue:
  		[self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg].
  	popBoolean
  		ifTrue: [self PopR: ClassReg]
  		ifFalse: [self MoveMw: 0 r: SPReg R: ClassReg].
  	traceStores > 0 ifTrue:
  		[self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: ClassReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genStorePop:RemoteTemp:At: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genStorePop:RemoteTemp:At: (in category 'bytecode generators') -----
  genStorePop: popBoolean RemoteTemp: slotIndex At: remoteTempIndex
  	<inline: false>
  	self assert: needsFrame.
  	popBoolean
  		ifTrue: [self PopR: ClassReg]
  		ifFalse: [self MoveMw: 0 r: SPReg R: ClassReg].
  	self MoveMw: (self frameOffsetOfTemporary: remoteTempIndex) r: FPReg R: ReceiverResultReg.
  	traceStores > 0 ifTrue:
  		[self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: ClassReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean TemporaryVariable: tempIndex
  	<inline: false>
  	popBoolean
  		ifTrue: [self PopR: TempReg]
  		ifFalse: [self MoveMw: 0 r: SPReg R: TempReg].
  	self MoveR: TempReg
  		Mw: (self frameOffsetOfTemporary: tempIndex)
  		r: FPReg.
  	^0!

Item was changed:
+ ----- Method: SimpleStackBasedCogit>>marshallAbsentReceiverSendArguments: (in category 'bytecode generator support') -----
- ----- Method: SimpleStackBasedCogit>>marshallAbsentReceiverSendArguments: (in category 'bytecode generators') -----
  marshallAbsentReceiverSendArguments: numArgs
  	"Shuffle arguments if necessary and push receiver."
  	numArgs = 0
  		ifTrue:
  			[self PushR: ReceiverResultReg]
  		ifFalse:
  			[self MoveMw: 0 r: SPReg R: TempReg.
  			self PushR: TempReg.
  			2 to: numArgs do:
  				[:index|
  				self MoveMw: index * BytesPerWord r: SPReg R: TempReg.
  				self MoveR: TempReg Mw: index - 1 * BytesPerWord r: SPReg].
  			self MoveR: ReceiverResultReg Mw: numArgs * BytesPerWord r: SPReg].!

Item was changed:
+ ----- Method: SistaStackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
- ----- Method: SistaStackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generators') -----
  genJumpIf: boolean to: targetBytecodePC
  	"The heart of performance counting in Sista.  Conditional branches are 6 times less
  	 frequent than sends and can provide basic block frequencies (send counters can't).
  	 Each conditional has a 32-bit counter split into an upper 16 bits counting executions
  	 and a lower half counting untaken executions of the branch.  Executing the branch
  	 decrements the upper half, tripping if the count goes negative.  Not taking the branch
  	 decrements the lower half.  N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
  	 so that scanning for send and branch data is simplified and that branch data is correct."
  	<inline: false>
  	| desc ok counterAddress countTripped retry |
  	<var: #ok type: #'AbstractInstruction *'>
  	<var: #desc type: #'CogSimStackEntry *'>
  	<var: #retry type: #'AbstractInstruction *'>
  	<var: #countTripped type: #'AbstractInstruction *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
  
  	self ssFlushTo: simStackPtr - 1.
  	desc := self ssTop.
  	self ssPop: 1.
  	desc popToReg: TempReg.
  
  	self ssAllocateRequiredReg: SendNumArgsReg. "Use this as the count reg."
  	counterAddress := counters + ((self sizeof: #sqInt) * counterIndex).
  	counterIndex := counterIndex + 1.
  	self flag: 'will need to use MoveAw32:R: if 64 bits'.
  	self assert: objectMemory wordSize = CounterBytes.
  	retry := self MoveAw: counterAddress R: SendNumArgsReg.
  	self SubCq: 16r10000 R: SendNumArgsReg. "Count executed"
  	"Don't write back if we trip; avoids wrapping count back to initial value, and if we trip we don't execute."
  	countTripped := self JumpCarry: 0.
  	self MoveR: SendNumArgsReg Aw: counterAddress. "write back"
  
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
  	self annotate: (self SubCw: boolean R: TempReg) objRef: boolean.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  
  	self SubCq: 1 R: SendNumArgsReg. "Count untaken"
  	self MoveR: SendNumArgsReg Aw: counterAddress. "write back"
  
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self MoveCq: 0 R: SendNumArgsReg. "if SendNumArgsReg is 0 this is a mustBeBoolean, not a counter trip."
  	countTripped jmpTarget:
  		(self CallRT: (boolean == objectMemory falseObject
  						ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  						ifFalse: [ceSendMustBeBooleanAddTrueTrampoline])).
  	"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped:
  	 trampoline will return directly to machine code, returning the boolean.  So the code should
  	 jump back to the retry point. The trampoline makes sure that TempReg has been reloaded."
  	self annotateBytecode: self Label.
  	self Jump: retry.
  	ok jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>picDataFor:IsBackwardBranch:Mcpc:Bcpc:Method: (in category 'method introspection') -----
  picDataFor: descriptor IsBackwardBranch: IsBackwardBranch Mcpc: mcpc Bcpc: bcpc Method: cogMethodArg
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #mcpc type: #'char *'>
  	<var: #cogMethodArg type: #'void *'>
  	| entryPoint tuple counter |
  	<var: #counter type: #'unsigned long'>
  
  	descriptor isNil ifTrue:
  		[^0].
  	descriptor isBranch ifTrue:
  		["it's a branch; conditional?"
  		 (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
  			[counter := (self
  							cCoerce: ((self
  											cCoerceSimple: cogMethodArg
  											to: #'CogMethod *') counters)
  							to: #'unsigned long *')
  								at: counterIndex.
  			 tuple := self picDataForCounter: counter at: bcpc + 1.
  			 tuple = 0 ifTrue: [^PrimErrNoMemory].
  			 objectMemory storePointer: picDataIndex ofObject: picData withValue: tuple.
  			 picDataIndex := picDataIndex + 1.
  			 counterIndex := counterIndex + 1].
  		 ^0].
  	"infer it's a send; alas we can't just test the descriptor because of the bloody
  	 doubleExtendedDoAnythingBytecode which does sends as well as other things."
  	(backEnd isCallPreceedingReturnPC: mcpc asUnsignedInteger) ifFalse:
  		[^0].
  	entryPoint := backEnd callTargetFromReturnAddress: mcpc asUnsignedInteger.
  	entryPoint <= methodZoneBase ifTrue: "send is not linked, or is not a send"
  		[^0].
  	self targetMethodAndSendTableFor: entryPoint into: "It's a linked send; find which kind."
  		[:targetMethod :sendTable|
  		 tuple := self picDataForSendTo: targetMethod
+ 					methodClassIfSuper: (sendTable = superSendTrampolines
+ 											ifTrue:
- 					methodClassIfSuper: (sendTable = superSendTrampolines ifTrue:
  												[coInterpreter methodClassOf:
+ 													(self cCoerceSimple: cogMethodArg to: #'CogMethod *') methodObject]
+ 											ifFalse: "Difficult to find the directed send class at this point in time ;-)"
+ 												[sendTable = directedSuperSendTrampolines ifTrue:
+ 													[objectMemory nilObject]])
- 													(self cCoerceSimple: cogMethodArg to: #'CogMethod *') methodObject])
  					at: mcpc
  					bcpc: bcpc + 1].
  	tuple = 0 ifTrue: [^PrimErrNoMemory].
  	objectMemory storePointer: picDataIndex ofObject: picData withValue: tuple.
  	picDataIndex := picDataIndex + 1.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>picDataForSendTo:methodClassIfSuper:at:bcpc: (in category 'method introspection') -----
  picDataForSendTo: cogMethod methodClassIfSuper: methodClassOrNil at: sendMcpc bcpc: sendBcpc
  	"Answer a tuple with the send data for a linked send to cogMethod.
  	 If the target is a CogMethod (monomorphic send) answer
  		{ bytecode pc, inline cache class, target method }
  	 If the target is an open PIC (megamorphic send) answer
  		{ bytecode pc, nil, send selector }
  	If the target is a closed PIC (polymorphic send) answer
  		{ bytecode pc, first class, target method, second class, second target method, ... }"
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #sendMcpc type: #'char *'>
+ 	| tuple class |
- 	| tuple |
  	tuple := objectMemory
  					eeInstantiateClassIndex: ClassArrayCompactIndex
  					format: objectMemory arrayFormat
  					numSlots: (cogMethod cmType = CMClosedPIC
  								ifTrue: [2 * cogMethod cPICNumCases + 1]
  								ifFalse: [3]).
  	tuple = 0 ifTrue:
  		[^0].
  	objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc).
  	cogMethod cmType = CMMethod ifTrue:
+ 		[class := methodClassOrNil ifNil:
+ 					[objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)].
+ 		 objectMemory
+ 			storePointer: 1 ofObject: tuple withValue: class;
- 		[objectMemory
- 			storePointer: 1
- 				ofObject: tuple
- 					withValue: (methodClassOrNil ifNil:
- 								[objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)]);
  			storePointer: 2 ofObject: tuple withValue: cogMethod methodObject.
  		^tuple].
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[self populate: tuple withPICInfoFor: cogMethod firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger).
  		^tuple].
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[objectMemory
  			storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject;
  			storePointer: 2 ofObject: tuple withValue: cogMethod selector.
  		^tuple].
  	self error: 'invalid method type'.
  	^0 "to get Slang to type this method as answering sqInt"!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
  initializeBytecodeTableForSistaV1
  	"StackToRegisterMappingCogit initializeBytecodeTableForSistaV1"
  
  	numPushNilsFunction := #sistaV1:Num:Push:Nils:.
  	pushNilSizeFunction := #sistaV1PushNilSize:numInitialNils:.
  	FirstSpecialSelector := 96.
  	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"
  		"pushes"
  		(1    0   15 genPushReceiverVariableBytecode			needsFrameNever: 1)
+ 		(1  16   31 genPushLitVarDirSup16CasesBytecode	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 genPushConstantTrueBytecode				needsFrameNever: 1)
  		(1  78   78 genPushConstantFalseBytecode			needsFrameNever: 1)
  		(1  79   79 genPushConstantNilBytecode				needsFrameNever: 1)
  		(1  80   80 genPushConstantZeroBytecode				needsFrameNever: 1)
  		(1  81   81 genPushConstantOneBytecode				needsFrameNever: 1)
  		(1  82   82 genExtPushPseudoVariable)
  		(1  83   83 duplicateTopBytecode						needsFrameNever: 1)
  
  		(1  84   87 unknownBytecode)
  
  		"returns"
  		(1  88   88 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  89   89 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  90   90 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  91   91 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  92   92 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1  93   93 genReturnNilFromBlock			return needsFrameNever: -1)
  		(1  94   94 genReturnTopFromBlock		return needsFrameNever: -1)
  		(1  95   95 genExtNopBytecode			needsFrameNever: 0)
  
  		"sends"
  		(1  96   96 genSpecialSelectorArithmetic isMapped AddRR)
  		(1  97   97 genSpecialSelectorArithmetic isMapped SubRR)
  		(1  98   98 genSpecialSelectorComparison isMapped JumpLess)
  		(1  99   99 genSpecialSelectorComparison isMapped JumpGreater)
  		(1 100 100 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1 101 101 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1 102 102 genSpecialSelectorComparison isMapped JumpZero)
  		(1 103 103 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1 104 109 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
  		(1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
  		(1 112 117 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 119 119 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
  
  		"jumps"
  		(1 176 183 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 184 191 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 192 199 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		"stores"
  		(1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 208 215 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 216 216 genPopStackBytecode needsFrameNever: -1)
  
  		(1 217 217 genUnconditionnalTrapBytecode isMapped)
  
  		(1 218 223 unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  
  		"pushes"
  		(2 226 226 genExtPushReceiverVariableBytecode		needsFrameNever: 1)
+ 		(2 227 227 genExtPushLitVarDirSupBytecode			needsFrameNever: 1)
- 		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genLongPushTemporaryVariableBytecode)
  		(2 230 230 genPushClosureTempsBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 233 233 genExtPushCharacterBytecode				needsFrameNever: 1)
  
  		"returns"
  		"sends"
  		(2 234 234 genExtSendBytecode isMapped)
  		(2 235 235 genExtSendSuperBytecode isMapped)
  
  		"sista bytecodes"
  		(2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
  
  		"jumps"
  		(2 237 237 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 238 238 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 239 239 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		"stores"
  		(2 240 240 genExtStoreAndPopReceiverVariableBytecode)
  		(2 241 241 genExtStoreAndPopLiteralVariableBytecode)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
  		(2 243 243 genExtStoreReceiverVariableBytecode)
  		(2 244 244 genExtStoreLiteralVariableBytecode)
  		(2 245 245 genLongStoreTemporaryVariableBytecode)
  
  		(2 246 247	unknownBytecode)
  
  		"3 byte bytecodes"
  		(3 248 248 genCallPrimitiveBytecode)
  		(3 249 249 unknownBytecode) "reserved for Push Float"
  		(3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
  		(3 251 251 genPushRemoteTempLongBytecode)
  		(3 252 252 genStoreRemoteTempLongBytecode)
  		(3 253 253 genStoreAndPopRemoteTempLongBytecode)
  
  		(3 254 255	unknownBytecode))!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>annotateBytecodeIfAnnotated: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>annotateBytecodeIfAnnotated: (in category 'bytecode generators') -----
  annotateBytecodeIfAnnotated: aSimStackEntry
  	<var: #aSimStackEntry type: #'CogSimStackEntry *'>
  	<inline: false>
  	aSimStackEntry annotateUse ifTrue:
  		[self annotateBytecode: (self prevInstIsPCAnnotated
  									ifTrue: [self Nop]
  									ifFalse: [self Label]).
  		 aSimStackEntry annotateUse: false]!

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

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>ensureReceiverResultRegContainsSelf (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>ensureReceiverResultRegContainsSelf (in category 'bytecode generators') -----
  ensureReceiverResultRegContainsSelf
  	needsFrame
  		ifTrue:
  			[(optStatus isReceiverResultRegLive
  			 and: [optStatus ssEntry = (self addressOf: simSelf)]) ifFalse:
  				[self ssAllocateRequiredReg: ReceiverResultReg.
  				 (self addressOf: simSelf) storeToReg: ReceiverResultReg].
  			optStatus
  				isReceiverResultRegLive: true;
  				ssEntry: (self addressOf: simSelf)]
  		ifFalse:
  			[self assert: (simSelf type = SSRegister
  						  and: [simSelf register = ReceiverResultReg]).
  			self assert: (optStatus isReceiverResultRegLive
  						  and: [optStatus ssEntry = (self addressOf: simSelf)])]!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genFramelessStorePop:ReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genFramelessStorePop:ReceiverVariable: (in category 'bytecode generators') -----
  genFramelessStorePop: popBoolean ReceiverVariable: slotIndex
  	<inline: false>
  	| topReg valueReg constVal |
  	self assert: needsFrame not.
  	self ssFlushUpThroughReceiverVariable: slotIndex.
  	"Avoid store check for immediate values"
  	constVal := self ssTop maybeConstant.
  	(self ssTop type = SSConstant
  	 and: [(objectRepresentation shouldAnnotateObjectReference: constVal) not]) ifTrue:
  		[self ensureReceiverResultRegContainsSelf.
  		 self ssStorePop: popBoolean toPreferredReg: TempReg.
  		 traceStores > 0 ifTrue:
  			[backEnd saveAndRestoreLinkRegAround:
  				[self CallRT: ceTraceStoreTrampoline]].
  		 ^objectRepresentation
  			genStoreImmediateInSourceReg: TempReg
  			slotIndex: slotIndex
  			destReg: ReceiverResultReg].
  	(topReg := self ssTop registerOrNil) isNil ifTrue:
  		[topReg := ClassReg].
  	valueReg := self ssStorePop: popBoolean toPreferredReg: topReg.
  	"Note that ReceiverResultReg remains live after ceStoreCheckTrampoline."
  	self ensureReceiverResultRegContainsSelf.
  	 traceStores > 0 ifTrue:
  		[self MoveR: valueReg R: TempReg.
  		 backEnd saveAndRestoreLinkRegAround:
  			[self CallRT: ceTraceStoreTrampoline]].
  	^objectRepresentation
  		genStoreSourceReg: valueReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genJumpBackTo: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genJumpBackTo: (in category 'bytecode generators') -----
  genJumpBackTo: targetBytecodePC
  	self ssFlushTo: simStackPtr.
  	^super genJumpBackTo: targetBytecodePC!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generators') -----
  genJumpIf: boolean to: targetBytecodePC
  	<inline: false>
  	| desc fixup ok |
  	<var: #desc type: #'CogSimStackEntry *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	<var: #ok type: #'AbstractInstruction *'>
  	self ssFlushTo: simStackPtr - 1.
  	desc := self ssTop.
  	self ssPop: 1.
  	(desc type == SSConstant
  	 and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
  		["Must arrange there's a fixup at the target whether it is jumped to or
  		  not so that the simStackPtr can be kept correct."
  		 fixup := self ensureFixupAt: targetBytecodePC - initialPC.
  		 "Must enter any annotatedConstants into the map"
  		 desc annotateUse ifTrue:
  			[self annotateBytecode: (self prevInstIsPCAnnotated
  											ifTrue: [self Nop]
  											ifFalse: [self Label])].
  		 "Must annotate the bytecode for correct pc mapping."
  		 self annotateBytecode: (desc constant = boolean
  									ifTrue: [self Jump: fixup]
  									ifFalse: [self prevInstIsPCAnnotated
  												ifTrue: [self Nop]
  												ifFalse: [self Label]]).
  		 ^0].
  	desc popToReg: TempReg.
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
  	self annotate: (self SubCw: boolean R: TempReg) objRef: boolean.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self CallRT: (boolean == objectMemory falseObject
  					ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  					ifFalse: [ceSendMustBeBooleanAddTrueTrampoline]).
  	ok jmpTarget: (self annotateBytecode: self Label).
  	^0!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genJumpTo: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genJumpTo: (in category 'bytecode generators') -----
  genJumpTo: targetBytecodePC
  	self ssFlushTo: simStackPtr.
  	^super genJumpTo: targetBytecodePC!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genMarshalledSend:numArgs:sendTable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genMarshalledSend:numArgs:sendTable: (in category 'bytecode generators') -----
  genMarshalledSend: selector numArgs: numArgs sendTable: sendTable
  	<inline: false>
  	<var: #sendTable type: #'sqInt *'>
+ 	| annotation |
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
+ 	annotation := self annotationForSendTable: sendTable.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
+ 	self annotate: (self Call: (sendTable at: (numArgs min: NumSendTrampolines - 1)))
+ 		with: annotation.
- 	self CallSend: (sendTable at: (numArgs min: NumSendTrampolines - 1)).
  	optStatus isReceiverResultRegLive: false.
  	^self ssPushRegister: ReceiverResultReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genPushEnclosingObjectAt: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genPushEnclosingObjectAt: (in category 'bytecode generators') -----
  genPushEnclosingObjectAt: level
  	"Uncached push enclosing object"
  	optStatus isReceiverResultRegLive: false.
  	self ssAllocateCallReg: SendNumArgsReg.
  	self MoveCq: level R: SendNumArgsReg.
  	self CallRT: ceEnclosingObjectTrampoline.
  	^self ssPushRegister: ReceiverResultReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genPushLiteral: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genPushLiteral: (in category 'bytecode generators') -----
  genPushLiteral: literal
  	^self ssPushConstant: literal!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genPushLiteralVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genPushLiteralVariable: (in category 'bytecode generators') -----
  genPushLiteralVariable: literalIndex
  	<inline: false>
  	| association freeReg |
  	freeReg := self ssAllocatePreferredReg: ClassReg.
  	association := self getLiteral: literalIndex.
  	"N.B. Do _not_ use ReceiverResultReg to avoid overwriting receiver in assignment in frameless methods."
  	"So far descriptors are not rich enough to describe the entire dereference so generate the register
  	 load but don't push the result.  There is an order-of-evaluation issue if we defer the dereference."
  	self annotate: (self MoveCw: association R: TempReg) objRef: association.
  	objectRepresentation
  		genEnsureObjInRegNotForwarded: TempReg
  		scratchReg: freeReg.
  	objectRepresentation
  		genLoadSlot: ValueIndex
  		sourceReg: TempReg
  		destReg: freeReg.
  	self ssPushRegister: freeReg.
  	^0!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genPushMaybeContextReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genPushMaybeContextReceiverVariable: (in category 'bytecode generators') -----
  genPushMaybeContextReceiverVariable: slotIndex 
  	<inline: false>
  	| jmpSingle jmpDone |
  	<var: #jmpSingle type: #'AbstractInstruction *'>
  	<var: #jmpDone type: #'AbstractInstruction *'>
  	self assert: needsFrame.
  	self ssAllocateCallReg: ReceiverResultReg and: SendNumArgsReg.
  	self ensureReceiverResultRegContainsSelf.
  	((self registerMaskFor: ReceiverResultReg) anyMask: callerSavedRegMask) ifTrue:
  		["We have no way of reloading ReceiverResultReg since we need the inst var value as the result."
  		optStatus isReceiverResultRegLive: false].
  	"See CoInterpreter>>contextInstructionPointer:frame: for an explanation
  	 of the instruction pointer slot handling."
  	slotIndex = InstructionPointerIndex ifTrue:
  		[self MoveCq: slotIndex R: SendNumArgsReg.
  		 self CallRT: ceFetchContextInstVarTrampoline.
  		 ^self ssPushRegister: SendNumArgsReg].
  	objectRepresentation
  		genLoadSlot: SenderIndex
  		sourceReg: ReceiverResultReg
  		destReg: TempReg.
  	jmpSingle := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveCq: slotIndex R: SendNumArgsReg.
  	self CallRT: ceFetchContextInstVarTrampoline.
  	jmpDone := self Jump: 0.
  	jmpSingle jmpTarget: self Label.
  	objectRepresentation
  		genLoadSlot: slotIndex
  		sourceReg: ReceiverResultReg
  		destReg: SendNumArgsReg.
  	jmpDone jmpTarget: self Label.
  	^self ssPushRegister: SendNumArgsReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genPushReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genPushReceiverVariable: (in category 'bytecode generators') -----
  genPushReceiverVariable: index
  	<inline: false>
  	self ensureReceiverResultRegContainsSelf.
  	^self ssPushBase: ReceiverResultReg
  			offset: (objectRepresentation slotOffsetOfInstVarIndex: index)!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genPushTemporaryVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genPushTemporaryVariable: (in category 'bytecode generators') -----
  genPushTemporaryVariable: index
  	"If a frameless method (not a block), only argument temps can be accessed.
  	 This is assured by the use of needsFrameIfMod16GENumArgs: in pushTemp."
  	self assert: (inBlock or: [needsFrame or: [index < methodOrBlockNumArgs]]).
  	^self ssPushDesc: (simStack at: index)!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSend:numArgs: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSend:numArgs: (in category 'bytecode generators') -----
  genSend: selector numArgs: numArgs
  	self marshallSendArguments: numArgs.
  	^self genMarshalledSend: selector numArgs: numArgs sendTable: ordinarySendTrampolines!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSendAbsentDynamicSuper:numArgs: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSendAbsentDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genSendAbsentDynamicSuper: selector numArgs: numArgs
  	"OK, we could do better and avoid spilling ReceiverResultReg if we refactored
  	 marshallImplicitReceiverSendArguments: to take a flag saying whether the
  	 receiver was in ReceiverResultReg (absent receiver send) or on the stack
  	 (absent dynamic super send) and in the latter case loading ReceiverResultReg
  	 from the stack after marshalling.  But this is a rare bytecode so for the moment
  	 don't bother."
  	self ssAllocateCallReg: ReceiverResultReg.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	self marshallAbsentReceiverSendArguments: numArgs.
  	^self genMarshalledSend: selector numArgs: numArgs sendTable: dynamicSuperSendTrampolines!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generators') -----
  genSendAbsentImplicit: selector numArgs: numArgs
  	| nsSendCache |
  	<inline: false>
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  
  	nsSendCache := theIRCs + (NumOopsPerNSC * objectMemory bytesPerOop * indexOfIRC).
  	indexOfIRC := indexOfIRC + 1.
  	self assert: (objectMemory isInOldSpace: nsSendCache).
  	self initializeNSSendCache: nsSendCache selector: selector numArgs: numArgs.
  
  	self ssAllocateCallReg: ReceiverResultReg and: SendNumArgsReg.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  
  	"This leaves the method receiver on the stack, which might not be the implicit receiver. But we care
  	 not: the callee will use ReceiverResultReg to build its frame, not the value beneath the arguments."
  	self marshallAbsentReceiverSendArguments: numArgs.
  
  	"Load the cache last so it is a fixed distance from the call."
  	self MoveCw: nsSendCache R: SendNumArgsReg.
  	self CallNewspeakSend: (implicitReceiverSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
  
  	optStatus isReceiverResultRegLive: false.
  	^self ssPushRegister: ReceiverResultReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSendAbsentOuter:numArgs:depth: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSendAbsentOuter:numArgs:depth: (in category 'bytecode generators') -----
  genSendAbsentOuter: selector numArgs: numArgs depth: depth
  	"OK, we could do better and avoid spilling ReceiverResultReg if we refactored
  	 marshallAbsentReceiverSendArguments: to take a flag saying whether the
  	 receiver was in ReceiverResultReg (absent receiver send) or on the stack
  	 (absent dynamic super send) and in the latter case loading ReceiverResultReg
  	 from the stack after marshalling.  But this is a rare bytecode so for the moment
  	 don't bother."
  	optStatus isReceiverResultRegLive: false.
  	self ssAllocateCallReg: SendNumArgsReg.
  	self MoveCq: depth R: SendNumArgsReg.
  	self CallRT: ceEnclosingObjectTrampoline.
  	self marshallAbsentReceiverSendArguments: numArgs.
  	^self genMarshalledSend: selector numArgs: numArgs sendTable: ordinarySendTrampolines!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSendAbsentSelf:numArgs: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSendAbsentSelf:numArgs: (in category 'bytecode generators') -----
  genSendAbsentSelf: selector numArgs: numArgs
  	"OK, we could do better and avoid spilling ReceiverResultReg if we refactored
  	 marshallAbsentReceiverSendArguments: to take a flag saying whether the
  	 receiver was in ReceiverResultReg (absent receiver send) or on the stack
  	 (absent dynamic super send) and in the latter case loading ReceiverResultReg
  	 from the stack after marshalling.  But this is a rare bytecode so for the moment
  	 don't bother."
  	self ssAllocateCallReg: ReceiverResultReg.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	self marshallAbsentReceiverSendArguments: numArgs.
  	^self genMarshalledSend: selector numArgs: numArgs sendTable: selfSendTrampolines!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genSendDirectedSuper:numArgs: (in category 'bytecode generator support') -----
+ genSendDirectedSuper: selector numArgs: numArgs
+ 	self halt: 'do all that good stuff moving the literal variable to an argument reg, etc...'.
+ 	self marshallSendArguments: numArgs.
+ 	^self genMarshalledSend: selector numArgs: numArgs sendTable: superSendTrampolines!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSendDynamicSuper:numArgs: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSendDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genSendDynamicSuper: selector numArgs: numArgs
  	self marshallSendArguments: numArgs.
  	^self genMarshalledSend: selector numArgs: numArgs sendTable: dynamicSuperSendTrampolines!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genSendSuper:numArgs: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genSendSuper:numArgs: (in category 'bytecode generators') -----
  genSendSuper: selector numArgs: numArgs
  	self marshallSendArguments: numArgs.
  	^self genMarshalledSend: selector numArgs: numArgs sendTable: superSendTrampolines!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genStorePop:LiteralVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genStorePop:LiteralVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean LiteralVariable: litVarIndex
  	<inline: false>
  	| topReg valueReg association constVal |
  	self flag: 'with better register allocation this wouldn''t need a frame.  e.g. use SendNumArgs instead of ReceiverResultReg'.
  	self assert: needsFrame.
  	optStatus isReceiverResultRegLive: false.
  	"N.B.  No need to check the stack for references because we generate code for
  	 literal variable loads that stores the result in a register, deferring only the register push."
  	association := self getLiteral: litVarIndex.
  	constVal := self ssTop maybeConstant.
  	"Avoid store check for immediate values"
  	(self ssTop type = SSConstant
  	 and: [(objectRepresentation shouldAnnotateObjectReference: constVal) not]) ifTrue:
  		[self ssAllocateRequiredReg: ReceiverResultReg.
  		 self annotate: (self MoveCw: association R: ReceiverResultReg) objRef: association.
  		 objectRepresentation
  			genEnsureObjInRegNotForwarded: ReceiverResultReg
  			scratchReg: TempReg.
  		 self ssStorePop: popBoolean toPreferredReg: TempReg.
  		 traceStores > 0 ifTrue:
  			[self CallRT: ceTraceStoreTrampoline].
  		 ^objectRepresentation
  			genStoreImmediateInSourceReg: TempReg
  			slotIndex: ValueIndex
  			destReg: ReceiverResultReg].
  	((topReg := self ssTop registerOrNil) isNil
  	 or: [topReg = ReceiverResultReg]) ifTrue:
  		[topReg := ClassReg].
  	self ssPop: 1.
  	self ssAllocateCallReg: topReg. "for the ceStoreCheck call in genStoreSourceReg:... below"
  	self ssPush: 1.
  	valueReg := self ssStorePop: popBoolean toPreferredReg: topReg.
  	valueReg = ReceiverResultReg ifTrue:
  		[self MoveR: valueReg R: topReg].
  	self ssAllocateCallReg: ReceiverResultReg.
  	self annotate: (self MoveCw: association R: ReceiverResultReg) objRef: association.
  	objectRepresentation genEnsureObjInRegNotForwarded: ReceiverResultReg scratchReg: TempReg.
  	traceStores > 0 ifTrue:
  		[self MoveR: topReg R: TempReg.
  		 self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: topReg
  		slotIndex: ValueIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genStorePop:MaybeContextReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genStorePop:MaybeContextReceiverVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean MaybeContextReceiverVariable: slotIndex
  	<inline: false>
  	| jmpSingle jmpDone valueReg |
  	<var: #jmpSingle type: #'AbstractInstruction *'>
  	<var: #jmpDone type: #'AbstractInstruction *'>
  	self assert: needsFrame.
  	self ssFlushUpThroughReceiverVariable: slotIndex.
  	"Note that ReceiverResultReg remains live after both
  	 ceStoreContextInstVarTrampoline and ceStoreCheckTrampoline."
  	self ensureReceiverResultRegContainsSelf.
  	self ssPop: 1.
  	self ssAllocateCallReg: ClassReg and: SendNumArgsReg. "for the ceStoreCheck call in genStoreSourceReg:... below"
  	self ssPush: 1.
  	objectRepresentation
  		genLoadSlot: SenderIndex
  		sourceReg: ReceiverResultReg
  		destReg: TempReg.
  	valueReg := self ssStorePop: popBoolean toPreferredReg: ClassReg.
  	valueReg ~= ClassReg ifTrue:
  		[self MoveR: valueReg R: ClassReg].
  	jmpSingle := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveCq: slotIndex R: SendNumArgsReg.
  	self CallRT: ceStoreContextInstVarTrampoline.
  	jmpDone := self Jump: 0.
  	jmpSingle jmpTarget: self Label.
  	traceStores > 0 ifTrue:
  		[self MoveR: ClassReg R: TempReg.
  		 self CallRT: ceTraceStoreTrampoline].
  	objectRepresentation
  		genStoreSourceReg: ClassReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg.
  	jmpDone jmpTarget: self Label.
  	^0!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genStorePop:ReceiverVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genStorePop:ReceiverVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean ReceiverVariable: slotIndex
  	<inline: false>
  	| topReg valueReg constVal |
  	needsFrame ifFalse:
  		[^self genFramelessStorePop: popBoolean ReceiverVariable: slotIndex].
  	self ssFlushUpThroughReceiverVariable: slotIndex.
  	"Avoid store check for immediate values"
  	constVal := self ssTop maybeConstant.
  	(self ssTop type = SSConstant
  	 and: [(objectRepresentation shouldAnnotateObjectReference: constVal) not]) ifTrue:
  		[self ensureReceiverResultRegContainsSelf.
  		 self ssStorePop: popBoolean toPreferredReg: TempReg.
  		 traceStores > 0 ifTrue:
  			[self CallRT: ceTraceStoreTrampoline].
  		 ^objectRepresentation
  			genStoreImmediateInSourceReg: TempReg
  			slotIndex: slotIndex
  			destReg: ReceiverResultReg].
  	((topReg := self ssTop registerOrNil) isNil
  	 or: [topReg = ReceiverResultReg]) ifTrue:
  		[topReg := ClassReg].
  	self ssPop: 1.
  	self ssAllocateCallReg: topReg. "for the ceStoreCheck call in genStoreSourceReg:... below"
  	self ssPush: 1.
  	valueReg := self ssStorePop: popBoolean toPreferredReg: topReg.
  	valueReg = ReceiverResultReg ifTrue:
  		[self MoveR: valueReg R: topReg].
  	"Note that ReceiverResultReg remains live after ceStoreCheckTrampoline."
  	self ensureReceiverResultRegContainsSelf.
  	 traceStores > 0 ifTrue:
  		[self MoveR: topReg R: TempReg.
  		 self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: topReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genStorePop:RemoteTemp:At: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genStorePop:RemoteTemp:At: (in category 'bytecode generators') -----
  genStorePop: popBoolean RemoteTemp: slotIndex At: remoteTempIndex
  	<inline: false>
  	| topReg valueReg constVal topSpilled |
  	self assert: needsFrame.
  	optStatus isReceiverResultRegLive: false.
  	"N.B.  No need to check the stack for references because we generate code for
  	 remote temp loads that stores the result in a register, deferring only the register push."
  	"Avoid store check for immediate values"
  	constVal := self ssTop maybeConstant.
  	(self ssTop type = SSConstant
  	 and: [(objectRepresentation shouldAnnotateObjectReference: constVal) not]) ifTrue:
  		[self ssAllocateRequiredReg: ReceiverResultReg.
  		 self MoveMw: (self frameOffsetOfTemporary: remoteTempIndex) r: FPReg R: ReceiverResultReg.
  		 self ssStorePop: popBoolean toPreferredReg: TempReg.
  		 traceStores > 0 ifTrue:
  			[self CallRT: ceTraceStoreTrampoline].
  		 ^objectRepresentation
  			genStoreImmediateInSourceReg: TempReg
  			slotIndex: slotIndex
  			destReg: ReceiverResultReg].
  	((topReg := self ssTop registerOrNil) isNil
  	 or: [topReg = ReceiverResultReg]) ifTrue:
  		[topReg := ClassReg].
  	self ssPop: 1.
  	"for the ceStoreCheck call in genStoreSourceReg:... below"
  	self ssAllocateCallReg: topReg and: ReceiverResultReg.
  	self ssPush: 1.
  	topSpilled := self ssTop spilled.
  	valueReg := self ssStorePop: (popBoolean or: [topSpilled]) toPreferredReg: topReg.
  	valueReg = ReceiverResultReg ifTrue:
  		[self MoveR: valueReg R: topReg].
  	popBoolean ifFalse:
  		[topSpilled ifFalse: [self ssPop: 1].
  		 self ssPushRegister: topReg].
  	self MoveMw: (self frameOffsetOfTemporary: remoteTempIndex) r: FPReg R: ReceiverResultReg.
  	 traceStores > 0 ifTrue:
  		[self MoveR: topReg R: TempReg.
  		 self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: topReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg!

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator support') -----
- ----- Method: StackToRegisterMappingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generators') -----
  genStorePop: popBoolean TemporaryVariable: tempIndex
  	<inline: false>
  	| reg |
  	self ssFlushUpThroughTemporaryVariable: tempIndex.
  	reg := self ssStorePop: popBoolean toPreferredReg: TempReg.
  	self MoveR: reg
  		Mw: (self frameOffsetOfTemporary: tempIndex)
  		r: FPReg.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>prevInstIsPCAnnotated (in category 'testing') -----
  prevInstIsPCAnnotated
  	| annotation prevIndex prevInst |
  	<var: #annotation type: #'InstructionAnnotation *'>
  	<var: #prevInst type: #'AbstractInstruction *'>
  	annotationIndex > 0 ifFalse:
  		[^false].
  	annotation := self addressOf: (annotations at: annotationIndex - 1).
+ 	(self isPCMappedAnnotation: annotation annotation) ifFalse:
- 	(self isPCMappedAnnotation: annotation annotation
- 			alternateInstructionSet: bytecodeSetOffset > 0) ifFalse:
  		[^false].
  	prevIndex := opcodeIndex - 1.
  	[prevIndex <= 0 ifTrue: [^false].
  	 prevInst := self abstractInstructionAt: prevIndex.
  	 annotation instruction = prevInst ifTrue:
  		[^true].
  	 prevInst opcode = Label]
  		whileTrue:
  			[prevIndex := prevIndex - 1].
  	^false!



More information about the Vm-dev mailing list