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

commits at source.squeak.org commits at source.squeak.org
Tue Jul 29 18:23:03 UTC 2014


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

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

Name: VMMaker.oscog-eem.838
Author: eem
Time: 29 July 2014, 8:20:21.403 am
UUID: 5430ce8e-3e58-4a34-b27f-e769a981ee6a
Ancestors: VMMaker.oscog-eem.837

General:
Fix slips in the new fetch/storeShort16/Long64 methods
which expect a 0-relative index.  Fix failure to convert
integer to integer value in the revised primitiveShortAt[Put].

Change the scanning for initial nils scheme in the
StackToRegisterMappingCogit to answer the number of
push nils in a bytecode, instead of whether the bytecode
is a push nil.  Refactor genReturnTopFromBlock into
genBlockReturn.  These changes accomodate Sista.

Sista:
Generate a few more bytecodes.

Simulator:
Fingers crossed, fix the inconsistent values in the balloon
code by making sure that primitiveShortAt: answers
signed values; the old code answered unsigned values.

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveShortAt (in category 'sound primitives') -----
  primitiveShortAt
+ 	"Treat the receiver, which can be indexible by either bytes or words, as
+ 	 an array of signed 16-bit values. Answer the contents of the given index.
+ 	 Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
- 	"Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Return the contents of the given index. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
  
  	| index rcvr value |
  	index := self stackTop..
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackValue: 1.
  	(objectMemory isWordsOrBytes: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
+ 	index := objectMemory integerValueOf: index.
  	((index >= 1) and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  	value := objectMemory fetchShort16: index - 1 ofObject: rcvr.
+ 	self cCode: []
+ 		inSmalltalk: [value > 32767 ifTrue: [value := value - 65536]].
  	self pop: 2 thenPushInteger: value!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveShortAtPut (in category 'sound primitives') -----
  primitiveShortAtPut
  	"Treat the receiver, which can be indexible by either bytes or words, as an array
  	 of signed 16-bit values. Set the contents of the given index to the given value.
  	 Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
  
  	| index rcvr value |
  	value := self stackTop.
  	index := self stackValue: 1.
  	((objectMemory isIntegerObject: value)
  	 and: [(objectMemory isIntegerObject: index)
  	 and: [value := objectMemory integerValueOf: value.
  		  (value >= -32768) and: [value <= 32767]]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackValue: 2.
  	(objectMemory isWordsOrBytes: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
+ 	index := objectMemory integerValueOf: index.
  	(index >= 1 and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  	objectMemory storeShort16: index - 1 ofObject: rcvr withValue: value.
  	self pop: 3 thenPush: (objectMemory integerObjectOf: value)!

Item was changed:
  ----- Method: ObjectMemory>>fetchLong64:ofObject: (in category 'object access') -----
  fetchLong64: longIndex ofObject: oop
  	<returnTypeC: #sqLong>
+ 	^self long64At: oop + BaseHeaderSize + (longIndex << 3)!
- 	^self long64At: oop + BaseHeaderSize + (8 * (longIndex - 1))!

Item was changed:
  ----- Method: ObjectMemory>>fetchShort16:ofObject: (in category 'object access') -----
  fetchShort16: shortIndex ofObject: oop
+ 	^self shortAt: oop + BaseHeaderSize + (shortIndex << 1)!
- 	^self shortAt: oop + BaseHeaderSize + (2 * (shortIndex - 1))!

Item was changed:
  ----- Method: ObjectMemory>>storeLong64:ofObject:withValue: (in category 'object access') -----
  storeLong64: longIndex ofObject: oop withValue: value
  	<var: #value type: #sqLong>
+ 	^self long64At: oop + BaseHeaderSize + (longIndex << 3) put: value!
- 	^self long64At: oop + BaseHeaderSize + (8 * (longIndex - 1)) put: value!

Item was changed:
  ----- Method: ObjectMemory>>storeShort16:ofObject:withValue: (in category 'object access') -----
  storeShort16: shortIndex ofObject: oop withValue: value
+ 	^self shortAt: oop + BaseHeaderSize + (shortIndex << 1) put: value!
- 	^self shortAt: oop + BaseHeaderSize + (2 * (shortIndex - 1)) put: value!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
  initializeBytecodeTableForSistaV1
  	"SimpleStackBasedCogit initializeBytecodeTableForSistaV1"
  
  	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)
  		(1  16   31 genPushLiteralVariable16CasesBytecode	needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode			needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode)
  		(1  76   76 genPushReceiverBytecode)
+ 		(1  77   77 genPushConstantTrueBytecode				needsFrameNever: 1)
+ 		(1  78   78 genPushConstantFalseBytecode			needsFrameNever: 1)
+ 		(1  79   79 genPushConstantNilBytecode				needsFrameNever: 1)
- 		(1  77   77 pushConstantTrueBytecode					needsFrameNever: 1)
- 		(1  78   78 pushConstantFalseBytecode				needsFrameNever: 1)
- 		(1  79   79 pushConstantNilBytecode					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)
- 		(1  95   95 genExtNop						needsFrameNever: 0)
  
  		"sends"
  		(1   96 117 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #* #/ #\\ #@ #bitShift: #// #bitAnd: #bitOr: #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 needsFrameNever: 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 223 unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  
  		"pushes"
  		(2 226 226 genExtPushReceiverVariableBytecode)
  		(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 callPrimitiveBytecode)
  		(3 249 249 unknownBytecode) "reserved for Push Float"
+ 		(3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
- 		(3 250 250 genExtPushClosureBytecode block sistaV1:Block:Code:Size:)
  		(3 251 251 genPushRemoteTempLongBytecode)
  		(3 252 252 genStoreRemoteTempLongBytecode)
  		(3 253 253 genStoreAndPopRemoteTempLongBytecode)
  
  		(3 254 255	unknownBytecode))!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genBlockReturn (in category 'bytecode generators') -----
+ genBlockReturn
+ 	"Return from block, assuming result already loaded into ReceiverResultReg."
+ 	needsFrame ifTrue:
+ 		[self MoveR: FPReg R: SPReg.
+ 		 self PopR: FPReg].
+ 	"Tim, I disagree; link reg should only be popped if frameful.
+ 	 Frameless methods should /not/ push the link reg except around trampolines.
+ 	 Eliot"
+ 	backEnd hasLinkRegister ifTrue:
+ 		[self PopR: LinkReg].
+ 	self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
+ 	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genExtNopBytecode (in category 'bytecode generators') -----
  genExtNopBytecode
+ 	"NewspeakV4: 221		11011101		Nop"
+ 	"SistaV1:		 91		01011011'		Nop"
- 	"221		11011101		Nop"
  	extA := extB := 0.
  	^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genExtPushCharacterBytecode (in category 'bytecode generators') -----
+ genExtPushCharacterBytecode
+ 	"SistaV1:		233		11101001	iiiiiiii		Push Character #iiiiiiii (+ Extend B * 256)"
+ 	| value |
+ 	value := byte1 + (extB << 8).
+ 	extB := 0.
+ 	^self genPushLiteral: (objectMemory characterObjectOf: value)!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genExtPushIntegerBytecode (in category 'bytecode generators') -----
  genExtPushIntegerBytecode
+ 	"NewsqueakV4:	229		11100101	iiiiiiii	Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)
+ 	SistaV1:		232		11101000	iiiiiiii	Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
- 	"229		11100101	i i i i i i i i	Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
  	| value |
  	value := byte1 + (extB << 8).
  	extB := 0.
  	^self genPushLiteral: (objectMemory integerObjectOf: value)!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genExtPushPseudoVariable (in category 'bytecode generators') -----
+ genExtPushPseudoVariable
+ 	"SistaV1: *	82			01010010			Push thisContext, (then Extend B = 1 => push thisProcess)"
+ 	| ext |
+ 	ext := extB.
+ 	extB := 0.
+ 	ext caseOf: {
+ 		[0]	->	[^self genPushActiveContextBytecode].
+ 		}
+ 		otherwise:
+ 			[^self unknownBytecode].
+ 	^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genReturnNilFromBlock (in category 'bytecode generators') -----
+ genReturnNilFromBlock
+ 	self assert: inBlock.
+ 	self flag: 'currently caller pushes result'.
+ 	self annotate: (self MoveCw: objectMemory nilObject R: ReceiverResultReg)
+ 		objRef: objectMemory nilObject.
+ 	^self genBlockReturn!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
  genReturnTopFromBlock
  	self assert: inBlock.
  	self flag: 'currently caller pushes result'.
  	self PopR: ReceiverResultReg.
+ 	^self genBlockReturn!
- 	needsFrame ifTrue:
- 		[self MoveR: FPReg R: SPReg.
- 		 self PopR: FPReg].
- 	backEnd hasLinkRegister ifTrue:
- 		[self PopR: LinkReg].
- 	self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
- 	^0!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>remember: (in category 'cog jit support') -----
+ remember: objOop
+ 	<doNotGenerate>
+ 	^scavenger remember: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>fetchLong64:ofObject: (in category 'object access') -----
  fetchLong64: longIndex ofObject: objOop
  	<returnTypeC: #sqLong>
+ 	^self long64At: objOop + self baseHeaderSize + (longIndex << 3)!
- 	^self long64At: objOop + self baseHeaderSize + (8 * (longIndex - 1))!

Item was changed:
  ----- Method: SpurMemoryManager>>fetchShort16:ofObject: (in category 'object access') -----
  fetchShort16: shortIndex ofObject: objOop
+ 	^self shortAt: objOop + self baseHeaderSize + (shortIndex << 1)!
- 	^self shortAt: objOop + self baseHeaderSize + (2 * (shortIndex - 1))!

Item was changed:
  ----- Method: SpurMemoryManager>>storeLong64:ofObject:withValue: (in category 'object access') -----
  storeLong64: longIndex ofObject: objOop withValue: value
  	<var: #value type: #sqLong>
+ 	^self long64At: objOop + self baseHeaderSize + (longIndex << 3) put: value!
- 	^self long64At: objOop + self baseHeaderSize + (8 * (longIndex - 1)) put: value!

Item was changed:
  ----- Method: SpurMemoryManager>>storeShort16:ofObject:withValue: (in category 'object access') -----
  storeShort16: shortIndex ofObject: objOop withValue: value
+ 	^self shortAt: objOop + self baseHeaderSize + (shortIndex << 1) put: value!
- 	^self shortAt: objOop + self baseHeaderSize + (2 * (shortIndex - 1)) put: value!

Item was changed:
  ----- Method: StackInterpreter>>extPushPseudoVariable (in category 'stack bytecodes') -----
  extPushPseudoVariable
+ 	"SistaV1:	*	82			01010010			Push thisContext, (then e.g. Extend B 1 = push thisProcess)"
+ 	extB
- 	"SistaV1:	*	82			01010010			Push thisContext, (then e.g. Extend 1 = push thisProcess)"
- 	extA
  		caseOf: {
  			[0]	->	[self pushActiveContextBytecode].
  			[1]	->	[self internalPush: self activeProcess] }
  		otherwise:
  			[self respondToUnknownBytecode].
  	self fetchNextBytecode.
+ 	extB := 0!
- 	extA := 0!

Item was changed:
  SimpleStackBasedCogit subclass: #StackToRegisterMappingCogit
+ 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks debugBytecodePointers realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode'
- 	instanceVariableNames: 'prevBCDescriptor isPushNilFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks debugBytecodePointers realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode'
  	classVariableNames: ''
  	poolDictionaries: 'CogCompilationConstants VMMethodCacheConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  StackToRegisterMappingCogit class
+ 	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
- 	instanceVariableNames: 'isPushNilFunction pushNilSizeFunction'!
  
  !StackToRegisterMappingCogit commentStamp: 'eem 12/19/2010 18:12' prior: 0!
  StackToRegisterMappingCogit is an optimizing code generator that eliminates a lot of stack operations and inlines some special selector arithmetic.  It does so by a simple stack-to-register mapping scheme based on deferring the generation of code to produce operands until operand-consuming operations.  The operations that consume operands are sends, stores and returns.
  
  See methods in the class-side documentation protocol for more detail.
  
  Instance Variables
  	callerSavedRegMask:							<Integer>
  	ceEnter0ArgsPIC:								<Integer>
  	ceEnter1ArgsPIC:								<Integer>
  	ceEnter2ArgsPIC:								<Integer>
  	ceEnterCogCodePopReceiverArg0Regs:		<Integer>
  	ceEnterCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	debugBytecodePointers:						<Set of Integer>
  	debugFixupBreaks:								<Set of Integer>
  	debugStackPointers:							<CArrayAccessor of (Integer|nil)>
  	methodAbortTrampolines:						<CArrayAccessor of Integer>
  	methodOrBlockNumTemps:						<Integer>
  	optStatus:										<Integer>
  	picAbortTrampolines:							<CArrayAccessor of Integer>
  	picMissTrampolines:							<CArrayAccessor of Integer>
  	realCEEnterCogCodePopReceiverArg0Regs:		<Integer>
  	realCEEnterCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	regArgsHaveBeenPushed:						<Boolean>
  	simSelf:											<CogSimStackEntry>
  	simSpillBase:									<Integer>
  	simStack:										<CArrayAccessor of CogSimStackEntry>
  	simStackPtr:									<Integer>
  	traceSimStack:									<Integer>
  
  callerSavedRegMask
  	- the bitmask of the ABI's caller-saved registers
  
  ceEnter0ArgsPIC ceEnter1ArgsPIC ceEnter2ArgsPIC
  	- the trampoline for entering an N-arg PIC
  
  ceEnterCogCodePopReceiverArg0Regs ceEnterCogCodePopReceiverArg1Arg0Regs
  	- teh trampoline for entering a method with N register args
  	
  debugBytecodePointers
  	- a Set of bytecode pcs for setting breakpoints (simulation only)
  
  debugFixupBreaks
  	- a Set of fixup indices for setting breakpoints (simulation only)
  
  debugStackPointers
  	- an Array of stack depths for each bytecode for code verification
  
  methodAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  methodOrBlockNumTemps
  	- the number of method or block temps (including args) in the current compilation unit (method or block)
  
  optStatus
  	- the variable used to track the status of ReceiverResultReg for avoiding reloading that register with self between adjacent inst var accesses
  
  picAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  picMissTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  realCEEnterCogCodePopReceiverArg0Regs realCEEnterCogCodePopReceiverArg1Arg0Regs
  	- the real trampolines for ebtering machine code with N reg args when in the Debug regime
  
  regArgsHaveBeenPushed
  	- whether the register args have been pushed before frame build (e.g. when an interpreter primitive is called)
  
  simSelf
  	- the simulation stack entry representing self in the current compilation unit
  
  simSpillBase
  	- the variable tracking how much of the simulation stack has been spilled to the real stack
  
  simStack
  	- the simulation stack itself
  
  simStackPtr
  	- the pointer to the top of the simulation stack
  !
  StackToRegisterMappingCogit class
+ 	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
- 	instanceVariableNames: 'isPushNilFunction pushNilSizeFunction'!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCodeGen
  	aCodeGen
  		var: #methodAbortTrampolines
  			declareC: 'sqInt methodAbortTrampolines[4]';
  		var: #picAbortTrampolines
  			declareC: 'sqInt picAbortTrampolines[4]';
  		var: #picMissTrampolines
  			declareC: 'sqInt picMissTrampolines[4]';
  		var: 'ceCall0ArgsPIC'
  			declareC: 'void (*ceCall0ArgsPIC)(void)';
  		var: 'ceCall1ArgsPIC'
  			declareC: 'void (*ceCall1ArgsPIC)(void)';
  		var: 'ceCall2ArgsPIC'
  			declareC: 'void (*ceCall2ArgsPIC)(void)';
  		var: #ceCallCogCodePopReceiverArg0Regs
  			declareC: 'void (*ceCallCogCodePopReceiverArg0Regs)(void)';
  		var: #realCECallCogCodePopReceiverArg0Regs
  			declareC: 'void (*realCECallCogCodePopReceiverArg0Regs)(void)';
  		var: #ceCallCogCodePopReceiverArg1Arg0Regs
  			declareC: 'void (*ceCallCogCodePopReceiverArg1Arg0Regs)(void)';
  		var: #realCECallCogCodePopReceiverArg1Arg0Regs
  			declareC: 'void (*realCECallCogCodePopReceiverArg1Arg0Regs)(void)';
  		var: 'simStack'
  			declareC: 'CogSimStackEntry simStack[', ((CoInterpreter bindingOf: #LargeContextSize) value * 5 / 4 // BytesPerWord) asString, ']';
  		var: 'simSelf'
  			type: #CogSimStackEntry;
  		var: #optStatus
  			type: #CogSSOptStatus;
  		var: 'prevBCDescriptor'
  			type: #'BytecodeDescriptor *'.
  
+ 	self numPushNilsFunction ifNotNil:
- 	self isPushNilFunction ifNotNil:
  		[aCodeGen
+ 			var: 'numPushNilsFunction'
+ 				declareC: 'sqInt (* const numPushNilsFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self numPushNilsFunction);
- 			var: 'isPushNilFunction'
- 				declareC: 'sqInt (* const isPushNilFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self isPushNilFunction);
  			var: 'pushNilSizeFunction'
  				declareC: 'sqInt (* const pushNilSizeFunction)(sqInt) = ', (aCodeGen cFunctionNameFor: self pushNilSizeFunction)].
  
  	aCodeGen
  		addSelectorTranslation: #register to: (aCodeGen cFunctionNameFor: 'registerr');
  		addSelectorTranslation: #register: to: (aCodeGen cFunctionNameFor: 'registerr:')!

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid
  	"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
  
  	super initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid.
+ 	numPushNilsFunction := #v3or4:Num:Push:Nils:.
- 	isPushNilFunction := #v3or4:Is:Push:Nil:.
  	pushNilSizeFunction := #v3or4PushNilSize:!

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

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in category 'class initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
  	"StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
  
  	super initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid.
+ 	numPushNilsFunction := #squeakV3orSistaV1:Num:Push:Nils:.
- 	isPushNilFunction := #squeakV3orSistaV1:Is:Push:Nil:.
  	pushNilSizeFunction := #squeakV3orSistaV1PushNilSize:!

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

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>requiredMethodNames: (in category 'translation') -----
  requiredMethodNames: options
  	^(super requiredMethodNames: options)
+ 		add: self numPushNilsFunction;
- 		add: self isPushNilFunction;
  		add: self pushNilSizeFunction;
  		yourself!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
  genReturnTopFromBlock
  	self assert: inBlock.
  	self ssTop popToReg: ReceiverResultReg.
  	self ssPop: 1.
+ 	^self genBlockReturn!
- 	needsFrame ifTrue:
- 		[self MoveR: FPReg R: SPReg.
- 		 self PopR: FPReg].
- 	backEnd hasLinkRegister ifTrue:
- 		[self PopR: LinkReg].
- 	self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
- 	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>isPushNil:pc:nExts:method: (in category 'span functions') -----
  isPushNil: descriptor pc: pc nExts: nExts method: aMethodObj
  	<inline: true>
  	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	^self perform: numPushNilsFunction
- 	^self perform: isPushNilFunction
  		with: descriptor
  		with: pc
  		with: nExts
  		with: aMethodObj!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>numPushNils:pc:nExts:method: (in category 'span functions') -----
+ numPushNils: descriptor pc: pc nExts: nExts method: aMethodObj
+ 	<inline: true>
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	^self perform: numPushNilsFunction
+ 		with: descriptor
+ 		with: pc
+ 		with: nExts
+ 		with: aMethodObj!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanBlock: (in category 'compile abstract instructions') -----
  scanBlock: blockStart
  	"Scan the block to determine if the block needs a frame or not"
+ 	| descriptor pc end framelessStackDelta nExts pushingNils numPushNils |
- 	| descriptor pc end framelessStackDelta nExts pushingNils |
  	<var: #blockStart type: #'BlockStart *'>
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	prevBCDescriptor := nil.
  	methodOrBlockNumArgs := blockStart numArgs.
  	inBlock := true.
  	pc := blockStart startpc.
  	end := blockStart startpc + blockStart span.
  	framelessStackDelta := nExts := 0.
  	pushingNils := true.
  	[pc < end] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 (pushingNils
  		  and: [descriptor isExtension not]) ifTrue:
  			["Count the initial number of pushed nils acting as temp initializers.  We can't tell
  			  whether an initial pushNil is an operand reference or a temp initializer, except
+ 			  when the pushNil is a jump target (has a fixup), which never happens:
+ 					self systemNavigation browseAllSelect:
+ 						[:m| | ebc |
+ 						(ebc := m embeddedBlockClosures
+ 									select: [:ea| ea decompile statements first isMessage]
+ 									thenCollect: [:ea| ea decompile statements first selector]) notEmpty
+ 						and: [(#(whileTrue whileFalse whileTrue: whileFalse:) intersection: ebc) notEmpty]]
+ 			  or if the bytecode set has a push multiple nils bytecode.  We simply count initial nils.
+ 			  Rarely we may end up over-estimating.  We will correct by checking the stack depth
+ 			  at the end of the block in compileBlockBodies."
+ 			 (numPushNils := self numPushNils: descriptor pc: pc nExts: nExts method: methodObj) > 0
+ 				ifTrue:
+ 					[self assert: descriptor numBytes = 1. "see compileMethodBody"
+ 					 blockStart numInitialNils: blockStart numInitialNils + numPushNils]
+ 				ifFalse:
+ 					[pushingNils := false]].
- 			  when the pushNil is a jump target (has a fixup) in which case it is definitely an
- 			  operand reference.  So rarely we may end up over-estimating.  We will correct
- 			  by checking the stack depth at the end of the block in compileBlockBodies."
- 			 (pushingNils := (self isPushNil: descriptor pc: pc nExts: nExts method: methodObj)
- 							  and: [(self fixupAt: pc - initialPC) targetInstruction = 0]) ifTrue:
- 				[self assert: descriptor numBytes = 1. "see compileMethodBody"
- 				 blockStart numInitialNils: blockStart numInitialNils + 1]].
  		 pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
  		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
  		 prevBCDescriptor := descriptor].
  	"It would be nice of this wasn't necessary but alas we need to do the eager
  	 scan for frameless methods so that we don't end up popping too much off
  	 the simulated stack, e.g. for pushNil; returnTopFromBlock methods."
  	needsFrame ifFalse:
  		[self assert: (framelessStackDelta >= 0 and: [blockStart numInitialNils >= framelessStackDelta]).
  		 blockStart numInitialNils: blockStart numInitialNils - framelessStackDelta]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	super setInterpreter: aCoInterpreter.
  
  	methodAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  	picAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  	picMissTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  
  	simStack := CArrayAccessor on: ((1 to: 256) collect: [:i| CogSimStackEntry new cogit: self]).
  	simSelf := CogSimStackEntry new cogit: self.
  	optStatus := CogSSOptStatus new.
  
  	debugFixupBreaks := Set new.
  	debugBytecodePointers := Set new.
  
+ 	numPushNilsFunction := self class numPushNilsFunction.
+ 	pushNilSizeFunction := self class pushNilSizeFunction!
- 	isPushNilFunction := self class isPushNilFunction.
- 	pushNilSizeFunction := self class pushNilSizeFunction.!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>sistaV1:Num:Push:Nils: (in category 'span functions') -----
+ sistaV1: descriptor Num: pc Push: nExts Nils: aMethodObj
+ 	"230		11100110	iiiiiiii		PushNClosureTemps iiiiiiii"
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	<inline: true>
+ 	^descriptor generator == #genPushClosureTempsBytecode
+ 		ifTrue: [objectMemory fetchByte: pc + 1 ofObject: aMethodObj]
+ 		ifFalse: [0]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>squeakV3orSistaV1:Num:Push:Nils: (in category 'span functions') -----
+ squeakV3orSistaV1: descriptor Num: pc Push: nExts Nils: aMethodObj
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	| numNils |
+ 	(numNils := self v3: descriptor Num: pc Push: nExts Nils: aMethodObj) > 0 ifTrue:
+ 		[^numNils].
+ 	^self sistaV1: descriptor Num: pc Push: nExts Nils: aMethodObj!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>v3:Is:Push:Nil: (in category 'span functions') -----
- v3: descriptor Is: pc Push: nExts Nil: aMethodObj
- 	<var: #descriptor type: #'BytecodeDescriptor *'>
- 	<inline: true>
- 	^descriptor generator == #genPushConstantNilBytecode!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>v3:Num:Push:Nils: (in category 'span functions') -----
+ v3: descriptor Num: pc Push: nExts Nils: aMethodObj
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	<inline: true>
+ 	^descriptor generator == #genPushConstantNilBytecode
+ 		ifTrue: [1]
+ 		ifFalse: [0]!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>v3or4:Is:Push:Nil: (in category 'span functions') -----
- v3or4: descriptor Is: pc Push: nExts Nil: aMethodObj
- 	<var: #descriptor type: #'BytecodeDescriptor *'>
- 	^(self v3: descriptor Is: pc Push: nExts Nil: aMethodObj)
- 	  or: [self v4: descriptor Is: pc Push: nExts Nil: aMethodObj]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>v3or4:Num:Push:Nils: (in category 'span functions') -----
+ v3or4: descriptor Num: pc Push: nExts Nils: aMethodObj
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	| numNils |
+ 	(numNils := self v3: descriptor Num: pc Push: nExts Nils: aMethodObj) > 0 ifTrue:
+ 		[^numNils].
+ 	^self v4: descriptor Num: pc Push: nExts Nils: aMethodObj!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>v4:Is:Push:Nil: (in category 'span functions') -----
- v4: descriptor Is: pc Push: nExts Nil: aMethodObj
- 	<var: #descriptor type: #'BytecodeDescriptor *'>
- 	<inline: true>
- 	^descriptor generator == #genExtPushPseudoVariableOrOuterBytecode
- 	  and: [self assert: (objectMemory fetchByte: pc ofObject: aMethodObj) = 77.
- 			nExts = 1
- 	  and: [(objectMemory fetchByte: pc - 1 ofObject: aMethodObj) = 2]]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>v4:Num:Push:Nils: (in category 'span functions') -----
+ v4: descriptor Num: pc Push: nExts Nils: aMethodObj
+ 	"*	77			01001101		Push false [* 1:true, 2:nil, 3:thisContext, ..., -N: pushExplicitOuter: N, N = Extend B]"
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	<inline: true>
+ 	^(descriptor generator == #genExtPushPseudoVariableOrOuterBytecode
+ 	   and: [self assert: (objectMemory fetchByte: pc ofObject: aMethodObj) = 77.
+ 			nExts = 1
+ 	   and: [(objectMemory fetchByte: pc - 1 ofObject: aMethodObj) = 2]])
+ 		ifTrue: [1]
+ 		ifFalse: [0]!



More information about the Vm-dev mailing list