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

commits at source.squeak.org commits at source.squeak.org
Tue Mar 19 01:01:05 UTC 2013


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

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

Name: VMMaker.oscog-eem.274
Author: eem
Time: 18 March 2013, 5:58:39.263 pm
UUID: 559311c1-938a-409c-9ee4-e17fb0e2b85f
Ancestors: VMMaker.oscog-eem.273

Fix PC-mapping for NewspeakV4.  Absent receiver sends must not
be maped twice, once for IsNSSend and once for IsSend.  So
introduce class vars that state whether instructioon set uses
PushImplicitReceiver (NSSendIsPCAnnotated is true) or
SendAbsentImplicit (NSSendIsPCAnnotated is false).

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

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 postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceStoreCheckTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceCreateNewArrayTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceActiveContextTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline cePositive32BitIntegerTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
+ 	classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxUnitDisplacement MaxUnreportableError MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC'
- 	classVariableNames: 'AltBlockCreationBytecodeSize AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxUnitDisplacement MaxUnreportableError MaxX2NDisplacement MethodTooBig NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC'
  	poolDictionaries: '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>>initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid
  	"SimpleStackBasedCogit initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
  	"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
  
  	| v3Table v4Table |
  	"N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize correctly."
  	self initializeBytecodeTableForNewspeakV4.
  	v4Table := generatorTable.
  	AltBlockCreationBytecodeSize := BlockCreationBytecodeSize.
+ 	AltNSSendIsPCAnnotated := NSSendIsPCAnnotated.
  	self initializeBytecodeTableForNewspeakV3PlusClosures.
  	v3Table := generatorTable.
  	generatorTable := CArrayAccessor on: v3Table object, v4Table object!

Item was removed:
- ----- Method: Cogit>>isPCMappedAnnotation: (in category 'method map') -----
- isPCMappedAnnotation: annotation
- 	<inline: true>
- 	^(self isSendAnnotation: annotation)
- 	  or: [annotation = HasBytecodePC]!

Item was added:
+ ----- Method: Cogit>>isPCMappedAnnotation:alternateInstructionSet: (in category 'method map') -----
+ isPCMappedAnnotation: annotation alternateInstructionSet: isAlternateInstSet
+ 	<inline: true>
+ 	^self cppIf: NewspeakVM
+ 		ifTrue:
+ 			"For Newspeak we shoe-horn in implicit receiver inline cache handling as an inline
+ 			 send, since these caches are processed similarly to inline send caches.  But if
+ 			 the Newspeak instruction set includes an absent receiver send then there are
+ 			 two map entries for the one bytecode, the first for the implicit receiver cache
+ 			 and the second for the send cache. Only one of these can function as the pc-
+ 			 mapped entry since there is only one bytecode. c.f. isSendAnnotation:"
+ 			[annotation = IsSendCall
+ 			or: [(annotation = IsNSSendCall
+ 				and: [isAlternateInstSet
+ 						ifTrue: [AltNSSendIsPCAnnotated]
+ 						ifFalse: [NSSendIsPCAnnotated]])
+ 			or: [annotation = HasBytecodePC]]]
+ 		ifFalse:
+ 			[(self isSendAnnotation: annotation)
+ 			  or: [annotation = HasBytecodePC]]!

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)(char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| 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 = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory byteLengthOf: 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: (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 |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
+ 				(self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue:
- 				(self isPCMappedAnnotation: annotation) 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]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: ((descriptor isBranch
  										   and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj])
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc.
  					 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

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

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

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genGetImplicitReceiverFor: (in category 'bytecode generators') -----
  genGetImplicitReceiverFor: selector
  	"Cached implicit receiver implementation.  Caller looks like
  		mov selector, ClassReg
+ 				call ceImplicitReceiverTrampoline
- 				call cePushImplicitReceiver
  				br continue
  		Lclass	.word
  		Lmixin:	.word
  		continue:
  	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
  	 If 0, answer the actual receiver.  This is done in the trampoline.
+ 	 See generateNewspeakRuntime.
+ 
+ 	 N.B. For PC mapping either this is used for SendAbsentImplicit or for PushAbsentReceiver
+ 	 but not both.  So any Newspeak instruction set has to choose either SendAbsentImplicit
+ 	 or PushAbsentReceiver.  See isPCMappedAnnotation:alternateInstructionSet:"
- 	 See generateNewspeakRuntime."
  	| skip |
  	<var: #skip type: #'AbstractInstruction *'>
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
  	self MoveCw: selector R: SendNumArgsReg.
  	self CallNewspeakSend: ceImplicitReceiverTrampoline.
  	skip := self Jump: 0.
  	self Fill32: 0.
  	self Fill32: 0.
  	skip jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>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.
  
  	 Override to add the descriptor as the first argument to function."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| 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 = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory byteLengthOf: 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.
  	"as a hack for collecting counters, remember the prev mcpc in a static variable."
  	prevMapAbsPCMcpc := 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: (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 |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
+ 				(self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue:
- 				(self isPCMappedAnnotation: annotation) 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]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: descriptor
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj)
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc].
  				annotation = IsAbsPCReference ifTrue:
  					[prevMapAbsPCMcpc := mcpc]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

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

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

Item was changed:
  ----- Method: 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
+ 			alternateInstructionSet: bytecodeSetOffset > 0) ifFalse:
- 	(self isPCMappedAnnotation: annotation annotation) 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