[Vm-dev] VM Maker: VMMaker.oscog-cb.2348.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Mar 8 14:27:51 UTC 2018


ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2348.mcz

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

Name: VMMaker.oscog-cb.2348
Author: cb
Time: 8 March 2018, 3:27:38.633989 pm
UUID: febace3b-294e-4541-bb6a-a505b9e3ed45
Ancestors: VMMaker.oscog-cb.2295, VMMaker.oscog-eem.2347

This commit is partially merged, I can only merge from a more recent Squeak image to get the DoubleWordArray/DoubleByteArray things correct. Also there's a conflict in SistaV1 bytecode table in StackToRegMappingCogit I need to figure out. I'll finish merging afterwards.

This commit:
- extends the Sista instruction set (new conditional jumps on mutability, age, backjump without interrupt points, new inlined arithmetics, inlined allocation up to 65k supported, possibleRoot, etc.) both in the interpreter and the JIT
- all the interpreter version are now filled with many assertions, so it is now possible to compile a StackVM with SistaVM option and debug easily the optimized code using the assertions.
- refactors a bit all inline primitives (Since now there is many)
- reworked a bit the bytecode set so all bytecodes except traps, mappedInlinedPrimitive and callPrimitive are normal Smalltalk bytecodes while the 3 bytecodes mentioned are different in the Sista VM. That way it is easier to know what to implement to support the full image without having to implement the whole sista extensions.

Note: (Future work)
- I am not a big fan of this hasUnsafeJump implementation, I may use a spanFunction instead.
- I think some inline primitives should not be implemented in SistaCogit but dispatch to CoObjectRepresentation (I need to look into that again).

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

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

Item was added:
+ ----- Method: CogBytecodeDescriptor>>hasUnsafeJump (in category 'accessing') -----
+ hasUnsafeJump
+ 
+ 	^ hasUnsafeJump!

Item was added:
+ ----- Method: CogBytecodeDescriptor>>hasUnsafeJump: (in category 'accessing') -----
+ hasUnsafeJump: anObject
+ 
+ 	^hasUnsafeJump := anObject!

Item was added:
+ ----- Method: CogObjectRepresentation>>genConvertSmallFloatToSmallFloatHashAsIntegerInReg:scratch: (in category 'sista support') -----
+ genConvertSmallFloatToSmallFloatHashAsIntegerInReg: reg scratch: scratch
+ 	^EncounteredUnknownBytecode!

Item was removed:
- ----- Method: CogObjectRepresentation>>genGetInstanceOf:into:initializingIf: (in category 'bytecode generator support') -----
- genGetInstanceOf: classObj into: destReg initializingIf: initializeInstance
- 	"Create an instance of classObj and assign it to destReg, initializing the instance
- 	 if initializeInstance is true with nil or 0 as appropriate This is for inline primitives.
- 	 Assume there is sufficient space in new space to complete the operation.
- 	 Answer zero on success."
- 	self subclassResponsibility!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in category 'accessing') -----
  numTrampolines
  	^super numTrampolines
+ 			 + (SistaV1BytecodeSet
+ 				ifTrue: [9] "(small,large)x(method,block,fullBlock) context creation,
+ 							 ceNewHashTrampoline, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline"
+ 				ifFalse: [7] "(small,large)x(method,block) context creation, 
+ 							 ceNewHashTrampoline, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline")
+ 			 + NumStoreTrampolines
+ 			 + ((initializationOptions at: #SistaVM ifAbsent: [false])
+ 				ifTrue: [1] "inline newHash"
+ 				ifFalse: [0]) !
- 	 + (SistaV1BytecodeSet
- 		ifTrue: [9] "(small,large)x(method,block,fullBlock) context creation,
- 					 ceNewHashTrampoline, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline"
- 		ifFalse: [7] "(small,large)x(method,block) context creation, 
- 					 ceNewHashTrampoline, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline")
- 	 + ((initializationOptions at: #IMMUTABILITY ifAbsent: [false])
- 		ifTrue: [NumStoreTrampolines]
- 		ifFalse: [0])
- 	 + ((initializationOptions at: #SistaVM ifAbsent: [false])
- 		ifTrue: [1] "inline newHash"
- 		ifFalse: [0])!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genGetInstanceOf:into:initializingIf: (in category 'inline primitive support') -----
- genGetInstanceOf: classObj into: destReg initializingIf: initializeInstance
- 	"Create an instance of classObj and assign it to destReg, initializing the instance
- 	 if initializeInstance is true with nil or 0 as appropriate This is for inline primitives.
- 	 Assume there is sufficient space in new space to complete the operation.
- 	 Answer zero on success."
- 	| classIndex classFormat header slots |
- 	((objectMemory isNonImmediate: classObj)
- 	 and: [(coInterpreter objCouldBeClassObj: classObj)
- 	 and: [(classIndex := objectMemory rawHashBitsOf: classObj) ~= 0
- 	 and: [(objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClassFormat: (classFormat := objectMemory formatOfClass: classObj)))
- 	 and: [(slots := objectMemory fixedFieldsOfClassFormat: classFormat) < objectMemory numSlotsMask]]]]) ifFalse:
- 		[^UnimplementedOperation].
- 
- 	self deny: destReg = TempReg.
- 
- 	header := objectMemory
- 					headerForSlots: slots
- 					format: (objectMemory instSpecOfClassFormat: classFormat)
- 					classIndex: classIndex.
- 
- 	cogit MoveAw: objectMemory freeStartAddress R: destReg.
- 	self genStoreHeader: header intoNewInstance: destReg using: TempReg.
- 	cogit
- 		LoadEffectiveAddressMw: (objectMemory smallObjectBytesForSlots: slots) r: destReg R: TempReg;
- 		MoveR: TempReg Aw: objectMemory freeStartAddress.
- 	(initializeInstance and: [slots > 0]) ifTrue:
- 		[cogit genMoveConstant: objectMemory nilObject R: TempReg.
- 		 0 to: slots - 1 do:
- 			[:i| cogit MoveR: TempReg
- 					Mw: i * objectMemory wordSize + objectMemory baseHeaderSize
- 					r: destReg]].
- 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetInstanceOfByteClass:into:initializingIf:numBytes: (in category 'inline primitive support') -----
+ genGetInstanceOfByteClass: classObj into: destReg initializingIf: initializeInstance numBytes: numBytes
+ 	"Create an instance of classObj and assign it to destReg, initializing the instance
+ 	 if initializeInstance is true with 0 This is for inline primitives.
+ 	 Assume there is sufficient space in new space to complete the operation."
+ 	| classIndex numSlots byteFormat |
+ 	classIndex := objectMemory rawHashBitsOf: classObj.
+ 	self flag: #duplication. "Duplicated byteFormatForNumBytes: and numSlotsForBytes:, might be worth adding api"
+ 	numSlots := numBytes + (objectMemory wordSize - 1) // objectMemory wordSize.
+ 	byteFormat := objectMemory firstByteFormat + (8 - numBytes bitAnd: objectMemory wordSize - 1).
+ 	self assert: classIndex ~= 0.
+ 	self genGetUninitializedInstanceWithClassIndex: classIndex numSlots: numSlots format: byteFormat into: destReg.
+ 	(initializeInstance and: [numBytes > 0]) ifTrue: 
+ 		[self genStoreValue: 0 instance: destReg numSlots: numSlots].
+ 	^0
+ 	!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genGetInstanceOfFixedClass:into:initializingIf: (in category 'inline primitive support') -----
- genGetInstanceOfFixedClass: classObj into: destReg initializingIf: initializeInstance
- 	"Create an instance of classObj and assign it to destReg, initializing the instance
- 	 if initializeInstance is true with nil or 0 as appropriate This is for inline primitives.
- 	 Assume there is sufficient space in new space to complete the operation.
- 	 Answer zero on success."
- 	| classIndex classFormat header slots branch constReg inst loop delta loopCount slotsPerIteration |
- 	((objectMemory isNonImmediate: classObj)
- 	 and: [(coInterpreter objCouldBeClassObj: classObj)
- 	 and: [(classIndex := objectMemory rawHashBitsOf: classObj) ~= 0
- 	 and: [(objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClassFormat: (classFormat := objectMemory formatOfClass: classObj)))
- 	 and: [(slots := objectMemory fixedFieldsOfClassFormat: classFormat) < objectMemory numSlotsMask]]]]) ifFalse:
- 		[^UnimplementedOperation].
- 
- 	header := objectMemory
- 					headerForSlots: slots
- 					format: (objectMemory instSpecOfClassFormat: classFormat)
- 					classIndex: classIndex.
- 
- 	cogit MoveAw: objectMemory freeStartAddress R: destReg.
- 	self genStoreHeader: header intoNewInstance: destReg using: TempReg.
- 	cogit
- 		LoadEffectiveAddressMw: (objectMemory smallObjectBytesForSlots: slots) r: destReg R: TempReg;
- 		MoveR: TempReg Aw: objectMemory freeStartAddress.
- 	(initializeInstance and: [slots > 0]) ifFalse:
- 		[^0].
- 	slots <= (slotsPerIteration := 8) ifTrue: "slotsPerIteration must be even; see cogit SubCq: objectMemory bytesPerOop R: TempReg below"
- 		[cogit genMoveConstant: objectMemory nilObject R: TempReg.
- 		 0 to: slots - 1 do:
- 			[:i| cogit MoveR: TempReg
- 					Mw: i * objectMemory wordSize + objectMemory baseHeaderSize
- 					r: destReg].
- 		^0].
- 	"self halt: 'genGetInstanceOfFixedClass:... ', slots asInteger."
- 	constReg := cogit allocateRegNotConflictingWith: destReg.
- 	cogit genMoveConstant: objectMemory nilObject R: constReg.
- 	
- 	slots \\ slotsPerIteration ~= 0
- 		ifTrue: "delta maps the offset at the loop entryPoint onto destReg + objectMemory baseHeaderSize"
- 			[delta := (slotsPerIteration - (slots \\ slotsPerIteration) * objectMemory bytesPerOop) - objectMemory baseHeaderSize.
- 			 delta > 0 ifTrue: [cogit SubCq: delta R: destReg].
- 			 delta < 0 ifTrue: [cogit AddCq: delta negated R: destReg].
- 			 "now delta maps (loopCount * slotsPerIteration * objectMemory bytesPerOop) + objectMemory baseHeaderSize - delta to the start of the object"
- 			 delta := delta + objectMemory baseHeaderSize.
- 			 (objectMemory bytesPerOop < objectMemory baseHeaderSize
- 			  and: [slots \\ 2 = 1]) ifTrue: "if end of loop is not at start of next object, adjust loop limit in TempReg to point to last field filled."
- 				[cogit SubCq: objectMemory bytesPerOop R: TempReg].
- 			 branch := cogit Jump: 0]
- 		ifFalse:
- 			[delta := 0.
- 			 cogit AddCq: objectMemory baseHeaderSize R: destReg].
- 	"loopCount is number of times through the increment of destReg."
- 	loopCount := slots + slotsPerIteration - 1 // slotsPerIteration.
- 	self assert: loopCount > 1.
- 	loop := cogit Label.
- 	0 to: 7 do:
- 		[:i|
- 		inst := cogit MoveR: constReg Mw: i * objectMemory bytesPerOop r: destReg.
- 		slotsPerIteration - (slots \\ slotsPerIteration) = i ifTrue:
- 			[branch jmpTarget: inst]].
- 	cogit
- 		AddCq: slotsPerIteration * objectMemory bytesPerOop R: destReg;
- 		CmpR: TempReg R: destReg;
- 		JumpBelow: loop;
- 		SubCq: (loopCount * slotsPerIteration * objectMemory bytesPerOop) + objectMemory baseHeaderSize - delta R: destReg.
- 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetInstanceOfPointerClass:into:initializingIf:numVariableSlots: (in category 'inline primitive support') -----
+ genGetInstanceOfPointerClass: classObj into: destReg initializingIf: initializeInstance numVariableSlots: varSlots
+ 	"Create an instance of classObj and assign it to destReg, initializing the instance
+ 	 if initializeInstance is true with nil This is for inline primitives.
+ 	 Assume there is sufficient space in new space to complete the operation."
+ 	| classIndex classFormat totalNumSlots fixedSlots |
+ 	classIndex := objectMemory rawHashBitsOf: classObj.
+ 	classFormat := objectMemory formatOfClass: classObj.
+ 	fixedSlots := objectMemory fixedFieldsOfClassFormat: classFormat.
+ 	totalNumSlots := varSlots + fixedSlots.
+ 	self assert: classIndex ~= 0.
+ 	self genGetUninitializedInstanceWithClassIndex: classIndex numSlots: totalNumSlots format: (objectMemory instSpecOfClassFormat: classFormat) into: destReg.
+ 	(initializeInstance and: [totalNumSlots > 0]) ifTrue: 
+ 		[self genStoreValue: objectMemory nilObject instance: destReg numSlots: totalNumSlots].
+ 	^0
+ 	!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetUninitializedInstanceWithClassIndex:numSlots:format:into: (in category 'inline primitive support') -----
+ genGetUninitializedInstanceWithClassIndex: classIndex numSlots: numSlots format: format into: destReg
+ 	"Write in destReg the pointer to the object (adjusted based on header size)
+ 	Can deal with large header but not with with old space allocation (max allocation size)"
+ 	| overflowHeader header lowNumSlots |
+ 	<var: #overflowHeader type: #usqLong>
+ 	numSlots >= objectMemory fixedFieldsOfClassFormatMask ifTrue: [^UnimplementedOperation].
+ 	cogit MoveAw: objectMemory freeStartAddress R: destReg.
+ 	numSlots >= objectMemory numSlotsMask
+ 		ifTrue: 
+ 			[overflowHeader := numSlots + (objectMemory numSlotsMask << objectMemory numSlotsFullShift).
+ 			 self genStoreHeader: overflowHeader intoNewInstance: destReg using: TempReg.
+ 			 cogit AddCq: objectMemory baseHeaderSize R: destReg. "Allow to store base header at correct place and to use smallObjectBytes in the rest of the method"
+ 			 lowNumSlots := objectMemory numSlotsMask]
+ 		ifFalse: 
+ 			[lowNumSlots := numSlots].	
+ 	header := objectMemory
+ 					headerForSlots: lowNumSlots
+ 					format: format
+ 					classIndex: classIndex.
+ 	self genStoreHeader: header intoNewInstance: destReg using: TempReg.
+ 	cogit
+ 		LoadEffectiveAddressMw: (objectMemory smallObjectBytesForSlots: numSlots) r: destReg R: TempReg;
+ 		MoveR: TempReg Aw: objectMemory freeStartAddress.
+ 
+ 	!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genIfRequiredCheckRememberedBitOf:scratch: (in category 'mapped inlined primitive support') -----
+ genIfRequiredCheckRememberedBitOf: rr scratch: scratchReg
+ 	CheckRememberedInTrampoline ifFalse: 
+ 		[^self genCheckRememberedBitOf: rr scratch: scratchReg]!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genStoreValue:instance:numSlots: (in category 'inline primitive support') -----
+ genStoreValue: value instance: destReg numSlots: numSlots 
+ 	"Store the value in the instance from field 1 to numSlots
+ 	 Typically used for for inlined allocations, initializing objects with 0 or nil.
+ 	 destReg is referencing the object (oop) and is restored at the end of this code.
+ 	 If less than 8 fields, use a full unrolled initialization (up to 8 stores)
+ 	 If more than 8 fields, use a duff device to initialize with a 8-vectorized loop."
+ 
+ 	| slotsPerIteration constReg delta branch loopCount loop inst |
+ 	numSlots <= (slotsPerIteration := 8) ifTrue: "slotsPerIteration must be even; see cogit SubCq: objectMemory bytesPerOop R: TempReg below"
+ 		[cogit genMoveConstant: value R: TempReg.
+ 		 0 to: numSlots - 1 do:
+ 			[:i| cogit MoveR: TempReg
+ 					Mw: i * objectMemory wordSize + objectMemory baseHeaderSize
+ 					r: destReg].
+ 		^0].
+ 	
+ 	constReg := cogit allocateRegNotConflictingWith: (cogit registerMaskFor: destReg).
+ 	cogit genMoveConstant: value R: constReg.
+ 	
+ 	numSlots \\ slotsPerIteration ~= 0
+ 		ifTrue: "delta maps the offset at the loop entryPoint onto destReg + objectMemory baseHeaderSize"
+ 			[delta := (slotsPerIteration - (numSlots \\ slotsPerIteration) * objectMemory bytesPerOop) - objectMemory baseHeaderSize.
+ 			 delta > 0 ifTrue: [cogit SubCq: delta R: destReg].
+ 			 delta < 0 ifTrue: [cogit AddCq: delta negated R: destReg].
+ 			 "now delta maps (loopCount * slotsPerIteration * objectMemory bytesPerOop) + objectMemory baseHeaderSize - delta to the start of the object"
+ 			 delta := delta + objectMemory baseHeaderSize.
+ 			 (objectMemory bytesPerOop < objectMemory baseHeaderSize
+ 			  and: [numSlots \\ 2 = 1]) ifTrue: "if end of loop is not at start of next object, adjust loop limit in TempReg to point to last field filled."
+ 				[cogit SubCq: objectMemory bytesPerOop R: TempReg].
+ 			 branch := cogit Jump: 0]
+ 		ifFalse:
+ 			[delta := 0.
+ 			 cogit AddCq: objectMemory baseHeaderSize R: destReg].
+ 	"loopCount is number of times through the increment of destReg."
+ 	loopCount := numSlots + slotsPerIteration - 1 // slotsPerIteration.
+ 	self assert: loopCount > 1.
+ 	loop := cogit Label.
+ 	0 to: 7 do:
+ 		[:i|
+ 		inst := cogit MoveR: constReg Mw: i * objectMemory bytesPerOop r: destReg.
+ 		slotsPerIteration - (numSlots \\ slotsPerIteration) = i ifTrue:
+ 			[branch jmpTarget: inst]].
+ 	cogit
+ 		AddCq: slotsPerIteration * objectMemory bytesPerOop R: destReg;
+ 		CmpR: TempReg R: destReg;
+ 		JumpBelow: loop;
+ 		SubCq: (loopCount * slotsPerIteration * objectMemory bytesPerOop) + objectMemory baseHeaderSize - delta R: destReg.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genVarIndexCallStoreTrampoline (in category 'mapped inlined primitive support') -----
+ genVarIndexCallStoreTrampoline	
+ 	self assert: IMMUTABILITY.
+ 	self cppIf: #IMMUTABILITY
+ 		ifTrue: [cogit CallRT: (ceStoreTrampolines at: NumStoreTrampolines - 1).
+ 				cogit annotateBytecode: cogit Label ].!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>setIfRequiredTargetOf:toTargetOf: (in category 'mapped inlined primitive support') -----
+ setIfRequiredTargetOf: jumpRemembered toTargetOf: jmpImmediate
+ 	<inline: true> "To avoid typing..."
+ 	CheckRememberedInTrampoline ifFalse:
+ 		[jumpRemembered jmpTarget: jmpImmediate getJmpTarget].!

Item was changed:
  ----- Method: Cogit class>>generatorTableFrom: (in category 'class initialization') -----
  generatorTableFrom: anArray
  	| blockCreationBytecodeSize |
  	generatorTable := CArrayAccessor on: (Array new: 256).
  	anArray do:
  		[:tuple| | descriptor |
  		(descriptor := CogBytecodeDescriptor new)
  						numBytes: tuple first;
  						generator: tuple fourth;
  						isReturn: (tuple includes: #return);
+ 						hasUnsafeJump: (tuple includes: #hasUnsafeJump);
  						isMapped: ((tuple includes: #isMappedIfImmutability)
  										ifTrue: [self bindingOf: #IMMUTABILITY]
  										ifFalse: [tuple includes: #isMapped]);
  						isMappedInBlock: (tuple includes: #isMappedInBlock);
  						isBlockCreation: (tuple includes: #block);
  						spanFunction: (((tuple includes: #block) or: [(tuple includes: #branch)]) ifTrue:
  										[tuple detect: [:thing| thing isSymbol and: [thing numArgs = 4]]]);
  						isBranchTrue: (tuple includes: #isBranchTrue);
  						isBranchFalse: (tuple includes: #isBranchFalse);
  						isExtension: (tuple includes: #extension);
  						isInstVarRef: (tuple includes: #isInstVarRef);	"for Spur"
  						is1ByteInstVarStore: (tuple includes: #is1ByteInstVarStore);	"for Spur"
  						hasIRC: (tuple includes: #hasIRC);			"for Newspeak"
  						yourself.
  		"As a hack to cut down on descriptor flags, use opcode to tag unusedBytecode for scanning.
  		 Currently descriptors are exactly 16 bytes with all 8 flag bits used (in Newspeak at least 17 bytes,
  		 9 flag bits).  As another hack to eliminate a test in scanMethod mark unknowns as extensions."
  		descriptor generator == #unknownBytecode ifTrue:
  			[descriptor opcode: Nop; isExtension: true].
  		descriptor isBlockCreation ifTrue:
  			[blockCreationBytecodeSize
  				ifNil: [blockCreationBytecodeSize := descriptor numBytes]
  				ifNotNil: [self assert: blockCreationBytecodeSize = descriptor numBytes]].
  		tuple do:
  			[:thing|
  			thing isSymbol ifTrue:
  				[(thing beginsWith: #needsFrame) ifTrue:
  					[descriptor needsFrameFunction: thing].
  				 (CogRTLOpcodes classPool at: thing ifAbsent: []) ifNotNil:
  					[:opcode| descriptor opcode: opcode]]].
  		tuple last isInteger
  			ifTrue: [descriptor stackDelta: tuple last]
  			ifFalse:
  				[descriptor needsFrameFunction ifNotNil:
  					[self error: 'frameless block bytecodes must specify a stack delta']].
  		tuple second to: tuple third do:
  			[:index|
  			generatorTable at: index put: descriptor]].
  	BlockCreationBytecodeSize := blockCreationBytecodeSize.
  	^generatorTable!

Item was changed:
  ----- Method: Cogit>>endPCOf: (in category 'compiled methods') -----
  endPCOf: aMethod
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	| pc end latestContinuation descriptor prim distance targetPC byte bsOffset nExts |
  	pc := latestContinuation := coInterpreter startPCOfMethod: aMethod.
  	(prim := coInterpreter primitiveIndexOf: aMethod) > 0 ifTrue:
  		[(coInterpreter isQuickPrimitiveIndex: prim) ifTrue:
  			[^pc - 1]].
  	bsOffset := self bytecodeSetOffsetFor: aMethod.
  	nExts := 0.
  	end := objectMemory numBytesOf: aMethod.
  	[pc <= end] whileTrue:
  		[byte := objectMemory fetchByte: pc ofObject: aMethod.
  		descriptor := self generatorAt: byte + bsOffset.
  		(descriptor isReturn
  		 and: [pc >= latestContinuation]) ifTrue:
  			[end := pc].
+ 		(descriptor isBranch or: [descriptor isBlockCreation]) 
+ 			ifTrue:
+ 				[distance := self spanFor: descriptor at: pc exts: nExts in: aMethod.
+ 			 	targetPC := pc + descriptor numBytes + distance.
+ 			 	latestContinuation := latestContinuation max: targetPC.
+ 			 	descriptor isBlockCreation ifTrue:
+ 					[pc := pc + distance]]
+ 			ifFalse: 
+ 				[latestContinuation := self maybeUnsafeJumpContinuation: latestContinuation at: pc for: descriptor in: aMethod].
- 		(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
- 			[distance := self spanFor: descriptor at: pc exts: nExts in: aMethod.
- 			 targetPC := pc + descriptor numBytes + distance.
- 			 latestContinuation := latestContinuation max: targetPC.
- 			 descriptor isBlockCreation ifTrue:
- 				[pc := pc + distance]].
  		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
  		pc := pc + descriptor numBytes].
  	^end!

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.  To cut down on number of arguments.
  	 and to be usable for both pc-mapping and method introspection, we encode
  	 the annotation and the isBackwardBranch flag in the same parameter.
  	 Guilty as charged."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor *desc, sqInt annotationAndIsBackwardBranch, char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	<inline: true>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts annotation |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  
  	self assert: cogMethod stackCheckOffset > 0.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	"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: 0 + (HasBytecodePC << 1)
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	bcpc := startbcpc.
  	"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 := cogMethod cmIsFullBlock.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 annotation := (objectMemory byteAt: map) >> AnnotationShift.
  			 self assert: (annotation = IsAbsPCReference
  						 or: [annotation = IsObjectReference
  						 or: [annotation = IsRelativeCall
  						 or: [annotation = IsDisplacementX2N]]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory numBytesOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			"If the method has a primitive, skip it and the error code store, if any;
  			 Logically. these come before the stack check and so must be ignored."
  			 bcpc := bcpc + (self deltaToSkipPrimAndErrorStoreIn: aMethodObj
  									header: homeMethod methodHeader)]
  		ifFalse:
  			[isInBlock := true.
  			 self assert: bcpc = cogMethod startpc.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 annotation := (objectMemory byteAt: map) >> AnnotationShift.
  			 self assert: (annotation >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [annotation >> AnnotationShift = IsDisplacementX2N]).
  			 [(annotation := (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].
  	nExts := 0.
  	self inlineCacheTagsAreIndexes ifTrue:
  		[enumeratingCogMethod := homeMethod].
  	"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:
  				[| nextBcpc isBackwardBranch |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + ((mapByte bitAnd: DisplacementMask) * backEnd codeGranularity).
  				(self isPCMappedAnnotation: annotation) ifTrue:
  					[(annotation = IsSendCall
  					  and: [(mapByte := objectMemory byteAt: map - 1) >> AnnotationShift = IsAnnotationExtension]) ifTrue:
  						[annotation := annotation + (mapByte bitAnd: DisplacementMask).
  						 map := map - 1].
  					 [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].
+ 							 latestContinuation := self maybeUnsafeJumpContinuation: latestContinuation at: bcpc for: descriptor in: aMethodObj].
- 								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					 isBackwardBranch := descriptor isBranch
  										   and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj].
  					 result := self perform: functionSymbol
  									with: descriptor
  									with: (isBackwardBranch ifTrue: [annotation << 1 + 1] ifFalse: [annotation << 1])
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: (isBackwardBranch ifTrue: [bcpc - (2 * nExts)] ifFalse: [bcpc])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc.
  					 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
  			ifFalse:
  				[self assert: (mapByte >> AnnotationShift = IsDisplacementX2N
  							or: [mapByte >> AnnotationShift = IsAnnotationExtension]).
  				 mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
  					[mcpc := mcpc + ((mapByte - DisplacementX2N << AnnotationShift) * backEnd codeGranularity)]].
  		 map := map - 1].
  	^0!

Item was added:
+ ----- Method: Cogit>>maybeDealWithUnsafeJumpForDescriptor:pc:latestContinuation: (in category 'compile abstract instructions') -----
+ maybeDealWithUnsafeJumpForDescriptor: descriptor pc: pc latestContinuation: latestContinuation
+ 	<inline: true>
+ 	^ latestContinuation!

Item was added:
+ ----- Method: Cogit>>maybeUnsafeJumpContinuation:at:for:in: (in category 'compile abstract instructions') -----
+ maybeUnsafeJumpContinuation: latestContinuation at: bcpc for: descriptor in: aMethodObj
+ 	<inline: true>
+ 	^ latestContinuation!

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

Item was removed:
- ----- Method: DoubleWordArray class>>defaultIntegerBaseInDebugger (in category '*VMMaker-debugger') -----
- defaultIntegerBaseInDebugger
- 	^16!

Item was removed:
- ----- Method: DoubleWordArray>>byteAt: (in category '*VMMaker-JITSimulation') -----
- byteAt: byteAddress
- 	"Extract a byte from a DoubleWordArray (little-endian version)"
- 	| lowBits |
- 	lowBits := byteAddress - 1 bitAnd: 7.
- 	^((self at: byteAddress - 1 - lowBits // 8 + 1)
- 		bitShift: lowBits * -8)
- 		bitAnd: 16rFF!

Item was removed:
- ----- Method: DoubleWordArray>>long64At: (in category '*VMMaker-JITSimulation') -----
- long64At: byteIndex
- 	| lowBits wordIndex value high low |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	(lowBits := byteIndex - 1 \\ 8) = 0
- 		ifTrue:
- 			[value := self at: wordIndex]
- 		ifFalse:
- 			[high := ((self at: wordIndex + 1) bitAnd: (1 bitShift: lowBits * 8) - 1) bitShift: 8 - lowBits * 8.
- 			 low := (self at: wordIndex) bitShift: lowBits * -8.
- 			 high = 0 ifTrue:
- 				[^low].
- 			 value := high + low].
- 	 ^(value bitShift: -56) <= 127
- 		ifTrue: [value]
- 		ifFalse: [value - 16r10000000000000000]!

Item was removed:
- ----- Method: DoubleWordArray>>long64At:put: (in category '*VMMaker-JITSimulation') -----
- long64At: byteIndex put: aValue
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits mask allOnes |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	((aValue bitShift: -63) between: -1 and: 0) ifFalse:
- 		[self errorImproperStore].
- 	allOnes := 16rFFFFFFFFFFFFFFFF.
- 	(lowBits := byteIndex - 1 bitAnd: 7) = 0 ifTrue:
- 		[^self at: wordIndex put: (aValue >= 0 ifTrue: [aValue] ifFalse: [aValue bitAnd: allOnes])].
- 	mask := allOnes bitShift: 8 - lowBits * -8.
- 	self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: allOnes - mask)).
- 	self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: allOnes - mask) bitXor: (allOnes bitAnd: ((aValue bitShift: 8 - lowBits * -8) bitAnd: mask))).
- 	^aValue!

Item was removed:
- ----- Method: DoubleWordArray>>longAt: (in category '*VMMaker-JITSimulation') -----
- longAt: byteIndex
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits word hiWord |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	lowBits := byteIndex - 1 bitAnd: 7.
- 	word := (self at: wordIndex) bitShift: lowBits * -8.
- 	lowBits > 4 ifTrue: "access straddles two words"
- 		[hiWord := (self at: wordIndex + 1) bitShift: 8 - lowBits * 8.
- 		 word := word + hiWord].
- 	word := word bitAnd: 16rFFFFFFFF.
- 	(word bitShift: -24) > 127 ifTrue:
- 		[word := word - 16r100000000].
- 	^word!

Item was removed:
- ----- Method: DoubleWordArray>>longAt:bigEndian: (in category '*VMMaker-JITSimulation') -----
- longAt: byteIndex bigEndian: bigEndian
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits word hiWord |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	lowBits := byteIndex - 1 bitAnd: 7.
- 	word := (self at: wordIndex) bitShift: lowBits * -8.
- 	lowBits > 4 ifTrue: "access straddles two words"
- 		[hiWord := (self at: wordIndex + 1) bitShift: 8 - lowBits * 8.
- 		 word := word + hiWord].
- 	word := word bitAnd: 16rFFFFFFFF.
- 	bigEndian ifTrue:
- 		[word := ((word bitShift: -24) bitAnd: 16rFF)
- 				 + ((word bitShift: -8) bitAnd: 16rFF00)
-  				 + ((word bitAnd: 16rFF00) bitShift: 8)
- 				 + ((word bitAnd: 16rFF) bitShift: 24)].
- 	(word bitShift: -24) > 127 ifTrue:
- 		[word := word - 16r100000000].
- 	^word!

Item was removed:
- ----- Method: DoubleWordArray>>longAt:put: (in category '*VMMaker-JITSimulation') -----
- longAt: byteIndex put: aValue
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits word allOnes loMask hiMask |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	lowBits := byteIndex - 1 bitAnd: 7.
- 	((aValue bitShift: -31) between: -1 and: 0) ifFalse:
- 		[self errorImproperStore].
- 	lowBits <= 4 ifTrue: "access fits in a single word"
- 		[| mask |
- 		 mask := 16rFFFFFFFF bitShift: lowBits * 8.
- 		 word := self at: wordIndex.
- 		 self at: wordIndex put: ((word bitOr: mask) bitXor: (((aValue bitShift: lowBits * 8) bitAnd: mask) bitXor: mask)).
- 		 ^aValue].
- 	"access straddles two words; make lowMask ones where destination is unchanged to avoid overflow"
- 	allOnes := 16rFFFFFFFFFFFFFFFF.
- 	loMask := allOnes bitShift: 8 - lowBits * -8.
- 	hiMask := 16rFFFFFFFF bitShift: 8 - lowBits * -8.
- 	word := self at: wordIndex.
- 	self at: wordIndex put: ((word bitAnd: loMask) bitOr: ((aValue bitAnd: (16rFFFFFFFF bitShift: (lowBits bitAnd: 3) * -8)) bitShift: lowBits * 8)).
- 	word := self at: wordIndex + 1.
- 	self at: wordIndex + 1 put: ((word bitOr: hiMask) bitXor: ((((aValue bitShift: 4 - (lowBits bitAnd: 3) * -8)) bitAnd: hiMask) bitXor: hiMask)).
- 	^aValue!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedByteAt: (in category '*VMMaker-JITSimulation') -----
- unsignedByteAt: byteAddress
- 	"Extract a byte from a 64-bit word array (little-endian version)"
- 	| lowBits |
- 	lowBits := byteAddress - 1 bitAnd: 7.
- 	^((self at: byteAddress - 1 - lowBits // 8 + 1)
- 		bitShift: lowBits * -8)
- 		bitAnd: 16rFF!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedByteAt:put: (in category '*VMMaker-JITSimulation') -----
- unsignedByteAt: byteAddress put: byte
- 	"Insert a byte into a 64-bit word (little-endian version)"
- 	| longWord shift lowBits longAddr |
- 	(byte < 0 or: [byte > 255]) ifTrue:[^self errorImproperStore].
- 	lowBits := byteAddress - 1 bitAnd: 7.
- 	longWord := self at: (longAddr := (byteAddress - 1 - lowBits) // 8 + 1).
- 	shift := lowBits * 8.
- 	longWord := longWord
- 				- (longWord bitAnd: (16rFF bitShift: shift)) 
- 				+ (byte bitShift: shift).
- 	self at: longAddr put: longWord.
- 	^byte!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedLong64At: (in category '*VMMaker-JITSimulation') -----
- unsignedLong64At: byteIndex
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits high low |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	(lowBits := byteIndex - 1 bitAnd: 7) = 0 ifTrue:
- 		[^self at: wordIndex].
- 	high := ((self at: wordIndex + 1) bitAnd: (1 bitShift: lowBits * 8) - 1) bitShift: 8 - lowBits * 8.
- 	low := (self at: wordIndex) bitShift: lowBits * -8.
- 	^high = 0 ifTrue: [low] ifFalse: [high + low]!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedLong64At:put: (in category '*VMMaker-JITSimulation') -----
- unsignedLong64At: byteIndex put: aValue
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits mask allOnes |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	(lowBits := byteIndex - 1 bitAnd: 7) = 0 ifTrue:
- 		[^self at: wordIndex put: aValue].
- 	(aValue bitShift: -64) = 0 ifFalse:
- 		[self errorImproperStore].
- 	mask := (allOnes := 16rFFFFFFFFFFFFFFFF) bitShift: 8 - lowBits * -8.
- 	self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: allOnes - mask)).
- 	self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: allOnes - mask) bitXor: (allOnes bitAnd: ((aValue bitShift: 8 - lowBits * -8) bitAnd: mask))).
- 	^aValue!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedLongAt: (in category '*VMMaker-JITSimulation') -----
- unsignedLongAt: byteIndex
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits word hiWord |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	lowBits := byteIndex - 1 bitAnd: 7.
- 	word := (self at: wordIndex) bitShift: lowBits * -8.
- 	lowBits > 4 ifTrue: "access straddles two words"
- 		[hiWord := (self at: wordIndex + 1) bitShift: 8 - lowBits * 8.
- 		 word := word + hiWord].
- 	^word bitAnd: 16rFFFFFFFF!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedLongAt:put: (in category '*VMMaker-JITSimulation') -----
- unsignedLongAt: byteIndex put: aValue
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| wordIndex lowBits word allOnes loMask hiMask |
- 	wordIndex := byteIndex - 1 // 8 + 1.
- 	lowBits := byteIndex - 1 bitAnd: 7.
- 	(aValue bitShift: -32) ~= 0 ifTrue:
- 		[self errorImproperStore].
- 	lowBits <= 4 ifTrue: "access fits in a single word"
- 		[| mask |
- 		 mask := 16rFFFFFFFF bitShift: lowBits * 8.
- 		 word := self at: wordIndex.
- 		 self at: wordIndex put: ((word bitOr: mask) bitXor: (((aValue bitShift: lowBits * 8) bitAnd: mask) bitXor: mask)).
- 		 ^aValue].
- 	"access straddles two words; make lowMask ones where destination is unchanged to avoid overflow"
- 	allOnes := 16rFFFFFFFFFFFFFFFF.
- 	loMask := allOnes bitShift: 8 - lowBits * -8.
- 	hiMask := 16rFFFFFFFF bitShift: 8 - lowBits * -8.
- 	word := self at: wordIndex.
- 	self at: wordIndex put: ((word bitAnd: loMask) bitOr: ((aValue bitAnd: (16rFFFFFFFF bitShift: (lowBits bitAnd: 3) * -8)) bitShift: lowBits * 8)).
- 	word := self at: wordIndex + 1.
- 	self at: wordIndex + 1 put: ((word bitOr: hiMask) bitXor: ((((aValue bitShift: 4 - (lowBits bitAnd: 3) * -8)) bitAnd: hiMask) bitXor: hiMask)).
- 	^aValue!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedShortAt: (in category '*VMMaker-JITSimulation') -----
- unsignedShortAt: byteIndex
- 	"Compatiblity with the ByteArray & Alien methods of the same name."
- 	| zi word |
- 	zi := byteIndex - 1.
- 	word := self at: zi // 8 + 1.
- 	(zi bitAnd: 1) ~= 0 ifTrue:
- 		[self notYetImplemented]. "i.e. odd access implies implementing straddling two words"
- 	(zi bitAnd: 7) ~= 0 ifTrue:
- 		[word := word bitShift: (zi bitAnd: 7) * -8].
- 	^word bitAnd: 16rFFFF!

Item was removed:
- ----- Method: DoubleWordArray>>unsignedShortAt:put: (in category '*VMMaker-JITSimulation') -----
- unsignedShortAt: byteAddress put: short
- 	"Insert a double byte into a 64-bit word (little-endian version)"
- 	| longWord shift lowBits longAddr |
- 	(short < 0 or: [short > 65535]) ifTrue:[^self errorImproperStore].
- 	lowBits := byteAddress - 1 bitAnd: 7.
- 	(lowBits bitAnd: 1) ~= 0 ifTrue:
- 		[self notYetImplemented]. "i.e. odd access implies implementing straddling two words"
- 	longWord := self at: (longAddr := (byteAddress - 1 - lowBits) // 8 + 1).
- 	shift := lowBits * 8.
- 	longWord := longWord
- 				- (longWord bitAnd: (16rFFFF bitShift: shift)) 
- 				+ (short bitShift: shift).
- 	self at: longAddr put: longWord.
- 	^short!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
  initializeBytecodeTableForSistaV1
  	"SimpleStackBasedCogit initializeBytecodeTableForSistaV1"
  
  	BytecodeSetHasDirectedSuperSend := true.
  	FirstSpecialSelector := 96.
  	NumSpecialSelectors := 32.
  	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 isInstVarRef)
  		(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  80   80 genPushConstantZeroBytecode				needsFrameNever: 1)
  		(1  81   81 genPushConstantOneBytecode				needsFrameNever: 1)
  		(1  82   82 genExtPushPseudoVariable)
  		(1  83   83 duplicateTopBytecode						needsFrameNever: 1)
  
  		(1  84   87 unknownBytecode)
  
  		"returns"
  		(1  88   88 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  89   89 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  90   90 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  91   91 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  92   92 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1  93   93 genReturnNilFromBlock			return needsFrameNever: -1)
  		(1  94   94 genReturnTopFromBlock		return needsFrameNever: -1)
  		(1  95   95 genExtNopBytecode			needsFrameNever: 0)
  
  		"sends"
  		(1   96 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 120 genSpecialSelectorNotEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 121 127 genSpecialSelectorSend isMapped) "#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 isInstVarRef isMappedIfImmutability needsFrameIfImmutability: -1)
  		(1 208 215 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 216 216 genPopStackBytecode needsFrameNever: -1)
  
  		(1 217 217 genUnconditionalTrapBytecode isMapped)
  
  		(1 218 223 unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  
  		"pushes"
  		(2 226 226 genExtPushReceiverVariableBytecode isInstVarRef)		"Needs a frame for context inst var access"
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genLongPushTemporaryVariableBytecode)
  		(2 230 230 unknownBytecode)
  		(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 unknownBytecode)
  
  		"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 isInstVarRef isMappedIfImmutability)
+ 		(2 241 241 genExtStoreAndPopLiteralVariableBytecode isMappedIfImmutability)
- 		(2 240 240 genSistaExtStoreAndPopReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
- 		(2 241 241 genSistaExtStoreAndPopLiteralVariableBytecode isMappedIfImmutability)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
+ 		(2 243 243 genExtStoreReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
+ 		(2 244 244 genExtStoreLiteralVariableBytecode isMappedIfImmutability)
- 		(2 243 243 genSistaExtStoreReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
- 		(2 244 244 genSistaExtStoreLiteralVariableBytecode isMappedIfImmutability)
  		(2 245 245 genLongStoreTemporaryVariableBytecode)
  
  		(2 246 247	unknownBytecode)
  
  		"3 byte bytecodes"
  		(3 248 248 genCallPrimitiveBytecode)
  		(3 249 249 genExtPushFullClosureBytecode) 
  		(3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
+ 		(3 251 251 genPushRemoteTempLongBytecode)
+ 		(3 252 252 genStoreRemoteTempLongBytecode isMappedIfImmutability)
+ 		(3 253 253 genStoreAndPopRemoteTempLongBytecode isMappedIfImmutability)
- 		(3 251 251 genExtPushRemoteTempOrInstVarLongBytecode)
- 		(3 252 252 genExtStoreRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
- 		(3 253 253 genExtStoreAndPopRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
  
+ 		(3 254 255	unknownBytecode))!
- 		(3 254 254	genExtJumpIfNotInstanceOfBehaviorsBytecode)
- 			
- 		(3 255 255	unknownBytecode))!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genCallMappedInlinedPrimitive (in category 'bytecode generators') -----
+ genCallMappedInlinedPrimitive
+ 	"Implemented with SistaCogit only"
+ 	^EncounteredUnknownBytecode!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>genExtEnsureAllocableSlots (in category 'bytecode generators') -----
- genExtEnsureAllocableSlots
- 	"SistaV1	*	236	11101100	iiiiiiii	Ensure Allocable Slots (+ Extend A * 256)"
- 	| slots skip |
- 	slots := (extA bitShift: 8) + byte1.
- 	extA := 0.
- 	self
- 		MoveAw: objectMemory freeStartAddress R: TempReg;
- 		CmpCq: objectMemory getScavengeThreshold - (objectMemory bytesPerOop * slots) R: TempReg.
- 	skip := self JumpBelow: 0.
- 	objectRepresentation genSetGCNeeded.
- 	self CallRT: ceCheckForInterruptTrampoline.
- 	skip jmpTarget: self Label.
- 	self annotateBytecode: skip getJmpTarget.
- 	^0!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
- genExtJumpIfNotInstanceOfBehaviorsBytecode
- 	"SistaV1: *	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
- 	"Non supported in non Sista VMs"
- 	^EncounteredUnknownBytecode
- 	!

Item was added:
+ ----- Method: SistaCogit>>decodePushIntegerLongBefore:in: (in category 'compile abstract instructions') -----
+ decodePushIntegerLongBefore: bcpc in: aMethodObj
+ 	<inline: true>
+ 	| distance upperByte | 
+ 	distance := objectMemory fetchByte: bcpc - 1 ofObject: aMethodObj.
+ 	upperByte := objectMemory fetchByte: bcpc - 3 ofObject: aMethodObj.
+ 	upperByte > 127 ifTrue: [upperByte := upperByte - 256].
+ 	^ (upperByte << 8) + distance.
+ 		 !

Item was changed:
  ----- Method: SistaCogit>>genAtPutInlinePrimitive: (in category 'inline primitive generators') -----
  genAtPutInlinePrimitive: prim
- 	"Unary inline primitives."
- 	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
- 	 See EncoderForSistaV1's class comment and StackInterpreter>>#trinaryInlinePrimitive:"
- 	| ra1 ra2 rr adjust needsStoreCheck |
  	"The store check requires rr to be ReceiverResultReg"
- 	needsStoreCheck := (objectRepresentation isUnannotatableConstant: self ssTop) not.
- 	self 
- 		allocateRegForStackTopThreeEntriesInto: [:rTop :rNext :rThird | ra2 := rTop. ra1 := rNext. rr := rThird ] 
- 		thirdIsReceiver: (prim = 0 and: [ needsStoreCheck ]).
- 	self assert: (rr ~= ra1 and: [rr ~= ra2 and: [ra1 ~= ra2]]).
- 	self ssTop popToReg: ra2.
- 	self ssPop: 1.
- 	self ssTop popToReg: ra1.
- 	self ssPop: 1.
- 	self ssTop popToReg: rr.
- 	self ssPop: 1.
- 	objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
- 	"Now: ra is the variable object, rr is long, TempReg holds the value to store."
- 	self flag: #TODO. "This is not really working as the immutability and store check needs to be present. "
  	prim caseOf: {
+ 		"3000	pointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[0] ->	[self genPointerAtPutMaybeContext: false storeCheck: false immutabilityCheck: false].
+ 		"3001	storeCheckPointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[1] ->	[self genPointerAtPutMaybeContext: false storeCheck: true immutabilityCheck: false].
+ 		"3002	maybeContextPointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[2] ->	[self genPointerAtPutMaybeContext: true storeCheck: false immutabilityCheck: false].
+ 		"3003	maybeContextStoreCheckPointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[3] ->	[self genPointerAtPutMaybeContext: true storeCheck: true immutabilityCheck: false].
+ 		"3004	byteAt:put:
+ 		 Mutable byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[4] ->	[self genByteAtPut].
- 		"0 - 1 pointerAt:put: and byteAt:Put:"
- 		[0] ->	[ adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
- 				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra1. ]. 
- 				self MoveR: ra2 Xwr: ra1 R: rr.
- 				"I added needsStoreCheck so if you initialize an array with a Smi such as 0 or a boolean you don't need the store check"
- 				needsStoreCheck ifTrue: 
- 					[ self assert: needsFrame. 
- 					objectRepresentation genStoreCheckReceiverReg: rr valueReg: ra2 scratchReg: TempReg inFrame: true] ].
- 		[1] ->	[ objectRepresentation genConvertSmallIntegerToIntegerInReg: ra2.
- 				adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
- 				self AddCq: adjust R: ra1.
- 				self MoveR: ra2 Xbr: ra1 R: rr.
- 				objectRepresentation genConvertIntegerToSmallIntegerInReg: ra2. ].
  	}
  	otherwise: [^EncounteredUnknownBytecode].
- 	self ssPushRegister: ra2.
  	^0!

Item was added:
+ ----- Method: SistaCogit>>genBinaryAtConstInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryAtConstInlinePrimitive: primIndex
+ 	"2064	pointerAt:
+ 	Pointer object (Fixed sized or not) and not a context, Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2065	maybeContextPointerAt:
+ 	Pointer object (Fixed sized or not), Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2066	byteAt:
+ 	byte object, Smi => 8 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2067	shortAt:
+ 	short object, Smi => 16 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2068	wordAt:
+ 	word object, Smi => 32 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2069	doubleWordAt:
+ 	double word object, Smi => 64 bits unsigned Smi or LargePositiveInteger (1-based, optimised if arg1 is a constant)"
+ 	| rr val |
+ 	val := self ssTop constant.
+ 	rr := primIndex = 65 
+ 		ifFalse: [self allocateRegForStackEntryAt: 1]
+ 		ifTrue: [self ssAllocateRequiredReg: ReceiverResultReg.
+ 				self voidReceiverResultRegContainsSelf.
+ 				ReceiverResultReg].
+ 	(self ssValue: 1) popToReg: rr.
+ 	self ssPop: 2.
+ 	primIndex caseOf: {
+ 		[64] ->	[objectRepresentation genLoadSlot: (objectMemory integerValueOf: val) - 1 sourceReg: rr destReg: rr].
+ 		[65] ->	[self ssAllocateRequiredReg: SendNumArgsReg.
+ 				 ^self genPushMaybeContextSlotIndex: (objectMemory integerValueOf: val) - 1].
+ 		[66] ->	[self MoveCq: (objectMemory integerValueOf: val) + objectMemory baseHeaderSize - 1 R: TempReg.
+ 				self MoveXbr: TempReg R: rr R: rr.
+ 				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr]
+ 	}
+ 	otherwise: [^EncounteredUnknownBytecode].
+ 	^self ssPushRegister: rr!

Item was added:
+ ----- Method: SistaCogit>>genBinaryAtInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryAtInlinePrimitive: primIndex
+ 	"2064	pointerAt:
+ 	Pointer object (Fixed sized or not) and not a context, Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2065	maybeContextPointerAt:
+ 	Pointer object (Fixed sized or not), Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2066	byteAt:
+ 	byte object, Smi => 8 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2067	shortAt:
+ 	short object, Smi => 16 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2068	wordAt:
+ 	word object, Smi => 32 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2069	doubleWordAt:
+ 	double word object, Smi => 64 bits unsigned Smi or LargePositiveInteger (1-based, optimised if arg1 is a constant)"
+ 	| ra rr adjust |
+ 	self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext | ra := rTop. rr := rNext ].
+ 	self ssTop popToReg: ra.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: rr.
+ 	self ssPop: 1.
+ 	primIndex caseOf: {
+ 		[64] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1.
+ 				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra. ]. 
+ 				self MoveXwr: ra R: rr R: rr ].
+ 		[66] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				adjust := objectMemory baseHeaderSize - 1. 
+ 				self AddCq: adjust R: ra.
+ 				self MoveXbr: ra R: rr R: rr.
+ 				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr].
+ 	}
+ 	otherwise: [^EncounteredUnknownBytecode].
+ 	^self ssPushRegister: rr!

Item was added:
+ ----- Method: SistaCogit>>genBinaryCompInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryCompInlinePrimitive: primIndex
+ 	"2032	>
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2033	<
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2034	>=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2035	<=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2036	=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2037	~=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2038	rawEqualsEquals:
+ 	not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2039	rawNotEqualsEquals:
+ 	not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 	|resultReg otherReg opTrue opFalse invertedOpTrue invertedOpFalse|
+ 	self assert: (primIndex between: 32 and: 39).
+ 	primIndex caseOf: {
+ 		[32]	->	[opTrue := JumpGreater. opFalse := JumpLessOrEqual. invertedOpTrue := JumpLess. invertedOpFalse := JumpGreaterOrEqual].
+ 		[33]	->	[opTrue := JumpLess. opFalse := JumpGreaterOrEqual. invertedOpTrue := JumpGreater. invertedOpFalse := JumpLessOrEqual].
+ 		[34]	->	[opTrue := JumpGreaterOrEqual. opFalse := JumpLess. invertedOpTrue := JumpLessOrEqual. invertedOpFalse := JumpGreater].
+ 		[35]	->	[opTrue := JumpLessOrEqual. opFalse := JumpGreater. invertedOpTrue := JumpGreaterOrEqual. invertedOpFalse := JumpLess].
+ 		[36]	->	[opTrue := JumpZero. opFalse := JumpNonZero. invertedOpTrue := JumpZero. invertedOpFalse := JumpNonZero].
+ 		[37]	->	[opTrue := JumpNonZero. opFalse := JumpZero. invertedOpTrue := JumpNonZero. invertedOpFalse := JumpZero].
+ 		[38]	->	[opTrue := JumpZero. opFalse := JumpNonZero. invertedOpTrue := JumpZero. invertedOpFalse := JumpNonZero].
+ 		[39]	->	[opTrue := JumpNonZero. opFalse := JumpZero. invertedOpTrue := JumpNonZero. invertedOpFalse := JumpZero].
+ 	}.
+ 	"Gen comparison"
+ 	self ssTop type = SSConstant 
+ 		ifTrue: [resultReg := self allocateRegForStackEntryAt: 1.
+ 				(self ssValue: 1) popToReg: resultReg.
+ 				self genCmpConstant: self ssTop constant R: resultReg.
+ 				self ssPop: 2.
+ 				self genBinaryInlineComparison: opTrue opFalse: opFalse destReg: resultReg.
+ 				^self ssPushRegister: resultReg].
+ 	(self ssValue: 1) type = SSConstant 
+ 		ifTrue: [resultReg := self allocateRegForStackEntryAt: 0.
+ 				self ssTop popToReg: resultReg.
+ 				self genCmpConstant: (self ssValue: 1) constant R: resultReg.
+ 				self ssPop: 2.
+ 				self genBinaryInlineComparison: invertedOpTrue opFalse: invertedOpFalse destReg: resultReg.
+ 				^self ssPushRegister: resultReg].
+ 	otherReg := self allocateRegForStackEntryAt: 0.	
+ 	self ssTop popToReg: otherReg.
+ 	resultReg := self allocateRegForStackEntryAt: 1 notConflictingWith: (self registerMaskFor: otherReg).	
+ 	(self ssValue: 1) popToReg: resultReg.
+ 	self CmpR: otherReg R: resultReg.
+ 	self ssPop: 2.
+ 	self genBinaryInlineComparison: opTrue opFalse: opFalse destReg: resultReg.
+ 	^self ssPushRegister: resultReg
+ 	
+ 	!

Item was added:
+ ----- Method: SistaCogit>>genBinaryConstOpVarSmiInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryConstOpVarSmiInlinePrimitive: primIndex
+ 	| ra val untaggedVal |
+ 	ra := self allocateRegForStackEntryAt: 0.
+ 	self ssTop popToReg: ra.
+ 	self ssPop: 1.
+ 	val := self ssTop constant.
+ 	self ssPop: 1.
+ 	untaggedVal := val - objectMemory smallIntegerTag.
+ 	primIndex caseOf: {
+ 		"2000	+
+ 		Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[0]	->	[self AddCq: untaggedVal R: ra].
+ 		"2001	-
+ 		Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[1]	->	[self MoveCq: val R: TempReg.
+ 				 self SubR: ra R: TempReg.
+ 				 objectRepresentation genAddSmallIntegerTagsTo: TempReg.
+ 				 self MoveR: TempReg R: ra].
+ 		"2002	*
+ 		Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[2]	->	[objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ra.
+ 				 self MoveCq: untaggedVal R: TempReg.
+ 				 self MulR: TempReg R: ra.
+ 				 objectRepresentation genSetSmallIntegerTagsIn: ra].
+ 		
+ 		"2016	bitAnd:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[16] -> [ self AndCq: val R: ra ].
+ 		"2017	bitOr:
+ 		Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[17] -> [ self OrCq: val R: ra ].
+ 		"2018	bitXor:
+ 		Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[18] -> [ self XorCw: untaggedVal R: ra. ].
+ 	}
+ 	otherwise: [^EncounteredUnknownBytecode].
+ 	self ssPushRegister: ra.
+ 	^0!

Item was changed:
+ ----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive binary generators') -----
- ----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
  genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
  	"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	| nextPC branchDescriptor targetBytecodePC postBranchPC |	
  		
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
  		ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
  			[ (self fixupAt: nextPC) notAFixup
  				ifTrue: "The next instruction is dead.  we can skip it."
  					[deadCode := true.
  				 	 self ensureFixupAt: targetBytecodePC.
  					 self ensureFixupAt: postBranchPC ]
  				ifFalse:
  					[self ssPushConstant: objectMemory trueObject]. "dummy value"
  			self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
  				operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  			"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
  			 Branch following means it may not be."
  			self nextDescriptorExtensionsAndNextPCInto:
  				[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
  			(deadCode and: [nextPC = postBranchPC]) ifFalse:
  				[ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
  		ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
  			[| condJump jump |
  			condJump := self genConditionalBranch: opTrue operand: 0.
  			self genMoveFalseR: destReg.
  	 		jump := self Jump: 0.
  			condJump jmpTarget: (self genMoveTrueR: destReg).
  			jump jmpTarget: self Label].
  	^ 0!

Item was added:
+ ----- Method: SistaCogit>>genBinaryInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryInlinePrimitive: primIndex
+ 	"Bulk comments: each sub-method has its own comment with the specific case.
+ 	2000	+
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2001	-
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2002	*
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2003	/
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2004	//
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2005	\
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2006	quo:
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2016	bitAnd:
+ 	Smi, Smi => Smi (optimised if one operand is a constant)
+ 	2017	bitOr:
+ 	Smi, Smi => Smi (optimised if one operand is a constant)
+ 	2018	bitXor:
+ 	Smi, Smi => Smi (optimised if one operand is a constant)
+ 	2019	bitShiftLeft:
+ 	Smi greater or equal to 0, Smi greater or equal to 0 => Smi (no overflow, optimised if arg1 is a constant)
+ 	2020	bitShiftRight:
+ 	Smi, Smi greater or equal to 0 => Smi (optimised if arg1 is a constant)
+ 	2032	>
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2033	<
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2034	>=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2035	<=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2036	=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2037	~=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2038	rawEqualsEquals:
+ 	not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2039	rawNotEqualsEquals:
+ 	not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2048	rawNew:
+ 	literal which is a fixed-sized behavior, Smi => instance of receiver, fields nilled out (optimised if arg1 is a constant)
+ 	2049	rawNewNoInit:
+ 	literal which is a fixed-sized behavior, Smi => instance of receiver (Fields of returned value contain undefined data, optimised if arg1 is a constant)
+ 	2064	pointerAt:
+ 	Pointer object (Fixed sized or not) and not a context, Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2065	maybeContextPointerAt:
+ 	Pointer object (Fixed sized or not), Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2066	byteAt:
+ 	byte object, Smi => 8 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2067	shortAt:
+ 	short object, Smi => 16 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2068	wordAt:
+ 	word object, Smi => 32 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2069	doubleWordAt:
+ 	double word object, Smi => 64 bits unsigned Smi or LargePositiveInteger (1-based, optimised if arg1 is a constant)"
+ 	(primIndex <= 18 and: [primIndex <= 2 or: [primIndex > 6]])  ifTrue: 
+ 		[self ssTop type = SSConstant 
+ 			ifTrue: [^self genBinaryVarOpConstSmiInlinePrimitive: primIndex].
+ 		(self ssValue: 1) type = SSConstant 
+ 			ifTrue: [^self genBinaryConstOpVarSmiInlinePrimitive: primIndex].
+ 		^self genBinaryVarOpVarSmiInlinePrimitive: primIndex].
+ 	primIndex <= 6 ifTrue: [^self genDivInlinePrimitive: primIndex].
+ 	primIndex = 19 ifTrue: [^self genBinarySmiBitShiftLeftInlinePrimitive].
+ 	primIndex = 20 ifTrue: [^self genBinarySmiBitShiftRightInlinePrimitive].
+ 	primIndex < 32 ifTrue: [^EncounteredUnknownBytecode].
+ 	primIndex <= 39 ifTrue: [^self genBinaryCompInlinePrimitive: primIndex].
+ 	primIndex < 48 ifTrue: [^EncounteredUnknownBytecode].
+ 	primIndex <= 49 ifTrue: [^self genBinaryNewInlinePrimitive: primIndex].
+ 	primIndex < 64 ifTrue: [^EncounteredUnknownBytecode].
+ 	primIndex <= 69 ifTrue: 
+ 		[self ssTop type = SSConstant
+ 			ifTrue: [^self genBinaryAtConstInlinePrimitive: primIndex].
+ 		^self genBinaryAtInlinePrimitive: primIndex].
+ 	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SistaCogit>>genBinaryNewInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryNewInlinePrimitive: primIndex
+ 	"2048	rawNew:
+ 	literal which is a variable-sized behavior, Smi => instance of receiver, fields nilled/zeroed out (optimised if arg1 is a constant)
+ 	2049	rawNewNoInit:
+ 	literal which is a variable-sized behavior, Smi => instance of receiver (Fields of returned value contain undefined data, optimised if arg1 is a constant)"
+ 	| resultReg classObj classFormat argInt |
+ 
+ 	"Assertion"
+ 	(self ssValue: 1) type = SSConstant ifFalse: [^UnimplementedOperation].
+ 	
+ 	"It would be nice to deal with variable-sized allocation on non-constant.
+ 	We need to see, however, than inlined allocation cannot deal with large allocations (i.e.
+ 	allocation directly in old space, > 65k currently. So Scorch still needs to perform range analysis
+ 	or generate 2 paths at the bytecode level in this case."
+ 	self ssTop type = SSConstant ifFalse: [^UnimplementedOperation].
+ 	
+ 	classObj := (self ssValue: 1) constant.
+ 	self assert: (objectMemory isNonImmediate: classObj).
+ 	self assert: (coInterpreter objCouldBeClassObj: classObj).
+ 	self deny: (objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClassFormat: (objectMemory formatOfClass: classObj))).
+ 	objectMemory classTagForClass: classObj. "Ensure Behavior hash"
+ 	
+ 	"Actual code"
+ 	resultReg := self allocateRegNotConflictingWith: 0.
+ 	classFormat := objectMemory instSpecOfClassFormat: (objectMemory formatOfClass: classObj).
+ 	argInt := objectMemory integerValueOf: self ssTop constant.
+ 	self ssPop: 2.
+ 	self ssPushRegister: resultReg.
+ 	(classFormat = objectMemory arrayFormat or: [classFormat = objectMemory indexablePointersFormat]) ifTrue: 
+ 		[^objectRepresentation genGetInstanceOfPointerClass: classObj into: resultReg initializingIf: primIndex = 48 numVariableSlots: argInt].
+ 	(classFormat = objectMemory firstByteFormat) ifTrue: 
+ 		[^objectRepresentation genGetInstanceOfByteClass: classObj into: resultReg initializingIf: primIndex = 48 numBytes: argInt].
+ 	^UnimplementedOperation!

Item was added:
+ ----- Method: SistaCogit>>genBinarySmiBitShiftLeftInlinePrimitive (in category 'inline primitive binary generators') -----
+ genBinarySmiBitShiftLeftInlinePrimitive
+ 	"2019	bitShiftLeft:
+ 	Smi greater or equal to 0, Smi greater or equal to 0 => Smi (no overflow, optimised if arg1 is a constant)"
+ 	| rr ra |
+ 	rr := self allocateRegForStackEntryAt: 1.
+ 	(self ssValue: 1) popToReg: rr.
+ 	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rr.
+ 	self ssTop type = SSConstant 
+ 		ifTrue: [self LogicalShiftLeftCq: (objectMemory integerValueOf: self ssTop constant) R: rr]
+ 		ifFalse: [ra := self allocateRegForStackEntryAt: 0 notConflictingWith: (self registerMaskFor: rr).
+ 				self ssTop popToReg: ra.
+ 				objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				self LogicalShiftLeftR: ra R: rr.].
+ 	objectRepresentation genAddSmallIntegerTagsTo: rr.
+ 	self ssPop: 2.
+ 	^self ssPushRegister: rr
+ !

Item was added:
+ ----- Method: SistaCogit>>genBinarySmiBitShiftRightInlinePrimitive (in category 'inline primitive binary generators') -----
+ genBinarySmiBitShiftRightInlinePrimitive
+ 	"2019	bitShiftLeft:
+ 	Smi greater or equal to 0, Smi greater or equal to 0 => Smi (no overflow, optimised if arg1 is a constant)"
+ 	| rr ra |
+ 	rr := self allocateRegForStackEntryAt: 1.
+ 	(self ssValue: 1) popToReg: rr.
+ 	self ssTop type = SSConstant 
+ 		ifTrue: [self ArithmeticShiftRightCq: (objectMemory integerValueOf: self ssTop constant) R: rr]
+ 		ifFalse: [ra := self allocateRegForStackEntryAt: 0 notConflictingWith: (self registerMaskFor: rr).
+ 				self ssTop popToReg: ra.
+ 				objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				 self ArithmeticShiftRightR: ra R: rr].
+ 	objectRepresentation genClearAndSetSmallIntegerTagsIn: rr.
+ 	self ssPop: 2.
+ 	^self ssPushRegister: rr!

Item was added:
+ ----- Method: SistaCogit>>genBinaryVarOpConstSmiInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryVarOpConstSmiInlinePrimitive: primIndex
+ 	| rr val untaggedVal |
+ 	self assert: primIndex <= 18.
+ 	val := self ssTop constant.
+ 	self ssPop: 1.
+ 	rr := self allocateRegForStackEntryAt: 0.
+ 	self ssTop popToReg: rr.
+ 	self ssPop: 1.
+ 	untaggedVal := val - objectMemory smallIntegerTag.
+ 	primIndex caseOf: {
+ 		"2000	+
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[0]	->	[self AddCq: untaggedVal R: rr].
+ 		"2001	-
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[1]	->	[self SubCq: untaggedVal R: rr ].
+ 		"2002	*
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[2]	->	[self flag: 'could use MulCq:R'.
+ 				 objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: rr.
+ 				 self MoveCq: untaggedVal R: TempReg.
+ 				 self MulR: TempReg R: rr.
+ 				 objectRepresentation genSetSmallIntegerTagsIn: rr].
+ 		
+ 		"2016	bitAnd:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[16] -> [ self AndCq: val R: rr ].
+ 		"2017	bitOr:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[17] -> [ self OrCq: val R: rr ].
+ 		"2018	bitXor:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[18] -> [ self flag: 'could use XorCq:'.
+ 				self XorCw: untaggedVal R: rr. ]
+ 
+ 	}
+ 	otherwise: [^EncounteredUnknownBytecode].
+ 	self ssPushRegister: rr.
+ 	^0!

Item was added:
+ ----- Method: SistaCogit>>genBinaryVarOpVarSmiInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genBinaryVarOpVarSmiInlinePrimitive: primIndex
+ 	| ra rr |
+ 	self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext | ra := rTop. rr := rNext ].
+ 	self ssTop popToReg: ra.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: rr.
+ 	self ssPop: 1.
+ 	primIndex caseOf: {
+ 		"2000	+
+ 		Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[0]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
+ 				 self AddR: ra R: rr].
+ 		"2001	-
+ 		Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[1]	->	[self SubR: ra R: rr.
+ 				 objectRepresentation genAddSmallIntegerTagsTo: rr].
+ 		"2002	*
+ 		Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[2]	->	[self genShiftAwaySmallIntegerTagsInScratchReg: rr.
+ 				 self genRemoveSmallIntegerTagsInScratchReg: ra.
+ 				 self MulR: ra R: rr.
+ 				 self genSetSmallIntegerTagsIn: rr].
+ 			
+ 		"2016	bitAnd:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[16] -> [ self AndR: ra R: rr ].
+ 		"2017	bitOr:
+ 		Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[17] -> [ self OrR: ra R: rr ].
+ 		"2018	bitXor:
+ 		Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[18] -> [objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra. 
+ 				self XorR: ra R: rr. ]
+ 	}
+ 	otherwise: [^EncounteredUnknownBytecode].
+ 	self ssPushRegister: rr.
+ 	^0!

Item was added:
+ ----- Method: SistaCogit>>genByteAtPut (in category 'inline primitive generators') -----
+ genByteAtPut
+ 	| ra1 ra2 rr adjust |
+ 	self 
+ 		allocateRegForStackTopThreeEntriesInto: [:rTop :rNext :rThird | ra2 := rTop. ra1 := rNext. rr := rThird ] 
+ 		thirdIsReceiver: false.
+ 	self assert: (rr ~= ra1 and: [rr ~= ra2 and: [ra1 ~= ra2]]).
+ 	self ssTop popToReg: ra2.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: ra1.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: rr.
+ 	self ssPop: 1.
+ 	adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
+ 	objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
+ 	objectRepresentation genConvertSmallIntegerToIntegerInReg: ra2.
+ 	self AddCq: adjust R: ra1.
+ 	self MoveR: ra2 Xbr: ra1 R: rr.
+ 	objectRepresentation genConvertIntegerToSmallIntegerInReg: ra2.
+ 	^self ssPushRegister: ra2!

Item was added:
+ ----- Method: SistaCogit>>genByteAtPutImmutabilityCheck (in category 'mapped inline primitive generators') -----
+ genByteAtPutImmutabilityCheck
+ 	| ra1 ra2 rr adjust mutableJump immutabilityFailure indexIsCst |
+ 	<var: #mutableJump type: #'AbstractInstruction *'>
+ 	<var: #immutabilityFailure type: #'AbstractInstruction *'>
+ 	"Assumes rr is not a context and no store check is needed"
+ 	indexIsCst := (self ssValue: 1) type = SSConstant.
+ 	rr := ReceiverResultReg.
+ 	ra1 := TempReg.
+ 	ra2 := ClassReg.
+ 	self voidReceiverResultRegContainsSelf.
+ 	self ssFlushTo: simStackPtr - 1. "we use top value immediately after, so it does not require flush"
+ 	self ssTop popToReg: ra2.
+ 	adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
+ 	indexIsCst
+ 		ifFalse:
+ 			[(self ssValue: 1) popToReg: ra1.
+ 			objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
+ 			self AddCq: adjust R: ra1]
+ 		ifTrue: [self MoveCq: (objectMemory integerValueOf: (self ssValue: 1) constant) + adjust R: ra1].
+ 	(self ssValue: 2) popToReg: rr.
+ 	self ssPop: 3.
+ 	self ssPushRegister: ra2.
+ 
+ 	"Everything is flushed except returned value. All regs are unused except rr ra1 ra2"
+ 	mutableJump := self genJumpMutable: rr scratchReg: Arg0Reg.
+ 	self PushR: ra2. "flush sim stack top"
+ 	self SubCq: 1 + adjust R: ra1. "index 0-relative for trampoline, ra1 unused afterwards"
+ 	objectRepresentation genVarIndexCallStoreTrampoline.
+ 	self PopR: ra2. "restore sim stack top"
+ 	immutabilityFailure := self Jump: 0.
+ 	
+ 	mutableJump jmpTarget: (self MoveR: ra2 R: Arg0Reg).
+ 	objectRepresentation genConvertSmallIntegerToIntegerInReg: Arg0Reg.
+ 	self MoveR: Arg0Reg Xbr: ra1 R: rr.
+ 	
+ 	immutabilityFailure jmpTarget: self Label.
+ 	^0!

Item was added:
+ ----- Method: SistaCogit>>genCallMappedInlinedPrimitive (in category 'mapped inline primitive generators') -----
+ genCallMappedInlinedPrimitive
+ 	"SistaV1:	236		11101100	iiiiiiii		callMappedInlinedPrimitive"
+ 	^ self genMappedInlinePrimitive: byte1!

Item was changed:
  ----- Method: SistaCogit>>genCallPrimitiveBytecode (in category 'bytecode generators') -----
  genCallPrimitiveBytecode
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#inlinePrimitiveBytecode:"
  	| prim primSet |
  	byte2 < 128 ifTrue:
  		[^bytecodePC = initialPC
  			ifTrue: [0]
  			ifFalse: [EncounteredUnknownBytecode]].
  	prim := byte2 - 128 << 8 + byte1.
  	primSet := prim >> 13 bitAnd: 3.
  	prim := prim bitAnd: 8191.
  	LowcodeVM
  		ifTrue:
  			[
  			primSet = 1 ifTrue: [
  				prim < 1000 ifTrue:
  					[^self genLowcodeNullaryInlinePrimitive: prim].
  
  				prim < 2000 ifTrue:
  					[^self genLowcodeUnaryInlinePrimitive: prim - 1000].
  				
  				prim < 3000 ifTrue:
  					[^ self genLowcodeBinaryInlinePrimitive: prim - 2000].
  
  				prim < 4000 ifTrue:
  					[^self genLowcodeTrinaryInlinePrimitive: prim - 3000].
  			]
  		].
  	
  	self assert: primSet = 0.
  	
+ 	^ self genSistaInlinePrimitive: prim!
- 	prim < 1000 ifTrue:
- 		[^self genNullaryInlinePrimitive: prim].
- 
- 	prim < 2000 ifTrue:
- 		[^self genUnaryInlinePrimitive: prim - 1000].
- 		
- 	prim < 3000 ifTrue:
- 		[self ssTop type = SSConstant ifTrue:
- 			[^self genBinaryVarOpConstInlinePrimitive: prim - 2000].
- 		 (self ssValue: 1) type = SSConstant ifTrue:
- 			[^self genBinaryConstOpVarInlinePrimitive: prim - 2000].
- 		 ^self genBinaryVarOpVarInlinePrimitive: prim - 2000].
- 
- 	prim < 4000 ifTrue:
- 		[^self genTrinaryInlinePrimitive: prim - 3000].
- 	
- 	prim < 5000 ifTrue: 
- 		[^self genQuaternaryInlinePrimitive: prim - 4000].
- 	
- 	prim < 6000 ifTrue: 
- 		[^self genQuinaryInlinePrimitive: prim - 5000].
- 		
- 	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SistaCogit>>genDirectCall (in category 'mapped inline primitive generators') -----
+ genDirectCall
+ 	"250	directCall
+ 	literal index of the method to call on top of stack =>  (variable number of parameters)"
+ 	| newMethod newMethodHeader newMethodArgCount sendTable annotation litIndex |
+ 	self assert: (self ssTop type = SSConstant and: [objectMemory isCompiledMethod: self ssTop constant]).
+ 	litIndex := objectMemory integerValueOf: self ssTop constant.
+ 	newMethod := self getLiteral: litIndex.
+ 	self ssPop: 1.
+ 	self flag: #TODO. "One needs to finish the implementation with the annotation and the sendTable"
+ 	sendTable := 1. "directCallSendTable"
+ 	annotation := 1. "directCallAnnotation"
+ 	newMethodHeader := self rawHeaderOf: newMethod.
+ 	newMethodArgCount := self argumentCountOfMethodHeader: methodHeader.
+ 	"The receiver cannot be a forwader"
+ 	"numArgs >= (NumSendTrampolines - 1) ifTrue:
+ 		[self MoveCq: newMethodArgCount R: SendNumArgsReg]."
+ 	"Load inline cache with method index"
+ 	"self MoveUniqueC32: litIndex R: ClassReg.
+ 	(self Call: (sendTable at: (newMethodArgCount min: NumSendTrampolines - 1))) annotation: annotation.
+ 	self voidReceiverOptStatus.
+ 	self ssPushRegister: ReceiverResultReg."
+ 	^ EncounteredUnknownBytecode "Need to finish implementation"!

Item was added:
+ ----- Method: SistaCogit>>genDivInlinePrimitive: (in category 'inline primitive binary generators') -----
+ genDivInlinePrimitive: primIndex
+ 	"2003	/
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant) "
+ 	"2004	//
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant) "
+ 	"2005	\\
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant) "
+ 	"2006	quo:
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant) "
+ 	
+ 	"We don't deal with constants here. Too complex and does nto bring much"
+ 	| ra rr jumpExact jumpSameSign |
+ 	<var: #jumpExact type: #'AbstractInstruction *'>
+ 	<var: #jumpSameSign type: #'AbstractInstruction *'>
+ 	self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext | ra := rTop. rr := rNext ].
+ 	self ssTop popToReg: ra.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: rr.
+ 	self ssPop: 1.
+ 	self assert: backEnd canDivQuoRem.
+ 	"arg non zero, no overflow check. / remains (unused in optimised code)"
+ 	primIndex caseOf: {
+ 		[4] ->	[objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ra.
+ 				objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: rr.
+ 				self DivR: ra R: rr Quo: rr Rem: TempReg.
+ 				"If remainder is zero, success"
+ 				self CmpCq: 0 R: TempReg.
+ 				jumpExact := self JumpZero: 0.
+ 				"If arg and remainder signs are different we must round down."
+ 				objectRepresentation genConvertIntegerToSmallIntegerInReg: ra.
+ 				self XorR: TempReg R: ra.
+ 				(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
+ 					[self CmpCq: 0 R: ra].
+ 				jumpSameSign := self JumpGreaterOrEqual: 0.
+ 				self SubCq: 1 R: rr.
+ 				jumpSameSign jmpTarget: (jumpExact jmpTarget: self Label).
+ 				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr ].
+ 		[5] ->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
+ 				objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rr.
+ 			 	self DivR: ra R: rr Quo: TempReg Rem: rr.
+ 				"If remainder is zero we're done."
+ 				self CmpCq: 0 R: rr.
+ 				jumpExact := self JumpZero: 0.
+ 				"If arg and remainder signs are different we must reflect around zero."
+ 				self XorR: rr R: ra.
+ 				(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
+ 					[self CmpCq: 0 R: ra].
+ 				jumpSameSign := self JumpGreaterOrEqual: 0.
+ 				self XorR: rr R: ra.
+ 				self AddR: ra R: rr.
+ 				jumpSameSign jmpTarget: (jumpExact jmpTarget: self Label).
+ 				objectRepresentation genSetSmallIntegerTagsIn: rr ].
+ 		[6] ->	[objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ra.
+ 				objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: rr.
+ 				self DivR: ra R: rr Quo: rr Rem: ra.
+ 				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr].
+ 	} otherwise: [^EncounteredUnknownBytecode].
+ 	self ssPushRegister: rr.
+ 	^0!

Item was added:
+ ----- Method: SistaCogit>>genEnsureEnoughSlots (in category 'mapped inline primitive generators') -----
+ genEnsureEnoughSlots
+ 	"50	EnsureEnoughWords
+ 	 literal which is a Smi => ret value is receiver"
+ 	|slots skip|
+ 	<var: #skip type: #'AbstractInstruction *'>
+ 	self assert: (self ssTop type = SSConstant and: [objectMemory isIntegerObject: self ssTop constant]).
+ 	slots := objectMemory integerValueOf: self ssTop constant.
+ 	self ssFlushTo: simStackPtr - 1.
+ 	self
+ 		MoveAw: objectMemory freeStartAddress R: TempReg;
+ 		CmpCq: objectMemory getScavengeThreshold - (objectMemory bytesPerOop * slots) R: TempReg.
+ 	skip := self JumpBelow: 0.
+ 	objectRepresentation genSetGCNeeded.
+ 	self CallRT: ceCheckForInterruptTrampoline.
+ 	skip jmpTarget: self Label.
+ 	self annotateBytecode: skip getJmpTarget.
+ 	^0!

Item was removed:
- ----- Method: SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
- genExtJumpIfNotInstanceOfBehaviorsBytecode
- 	"SistaV1: *	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
- 	| reg literal distance targetFixUp inverse |
- 
- 	"We lose the information of in which register is stack top 
- 	 when jitting the branch target so we need to flush everything. 
- 	 We could use a fixed register here...."
- 	reg := self allocateRegForStackEntryAt: 0.
- 	self ssTop popToReg: reg.
- 	self ssPop: 1.
- 	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
- 
- 	literal := self getLiteral: (extA * 256 + byte1).
- 	(inverse := extB < 0) ifTrue:
- 		[extB := extB + 128].
- 	distance := extB * 256 + byte2.
- 	extA := extB := numExtB := 0.
- 
- 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- 	inverse
- 		ifFalse: 
- 			[(objectMemory isArrayNonImm: literal)
- 				ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
- 				ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
- 		ifTrue:
- 			[(objectMemory isArrayNonImm: literal)
- 				ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
- 				ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
- 
- 	^0!

Item was added:
+ ----- Method: SistaCogit>>genJumpBinaryInlinePrimitive: (in category 'inline primitive generators') -----
+ genJumpBinaryInlinePrimitive: primIndex
+ 	| target testReg |
+ 	self assert: self ssTop type = SSConstant.
+ 	target := self eventualTargetOf: ((objectMemory integerValueOf: self ssTop constant) + 3 + bytecodePC).
+ 	testReg := self allocateRegForStackEntryAt: 1.
+ 	(self ssValue: 1) popToReg: testReg.
+ 	self ssPop: 2.
+ 	primIndex caseOf: {
+ 		"7016	jumpIfWritable:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[16]	->	[self cppIf: #IMMUTABILITY
+ 						ifTrue: [(objectRepresentation genJumpMutable: testReg scratchReg: TempReg) jmpTarget: (self ensureFixupAt: target).]
+ 						ifFalse: [self Jump: (self ensureFixupAt: target)].
+ 					^0].
+ 		"7017	jumpIfReadOnly:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[17]	->	[self cppIf: #IMMUTABILITY
+ 						ifTrue: [(objectRepresentation genJumpImmutable: testReg scratchReg: TempReg) jmpTarget: (self ensureFixupAt: target)]
+ 						ifFalse: [0"Do nothing - fall through"].
+ 					^0].
+ 		"7018	jumpIfYoung:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[18]	->	[self CmpCw: objectMemory storeCheckBoundary R: testReg.
+ 	 				 self JumpBelow: (self ensureFixupAt: target).
+ 					 ^0].
+ 		"7019	jumpIfOld:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[19]	->	[self CmpCw: objectMemory storeCheckBoundary R: testReg.
+ 	 				 self JumpAboveOrEqual: (self ensureFixupAt: target).
+ 					^0].
+ 	}. 
+ 	^ EncounteredUnknownBytecode
+ 	!

Item was added:
+ ----- Method: SistaCogit>>genJumpTrinaryInlinePrimitive: (in category 'inline primitive generators') -----
+ genJumpTrinaryInlinePrimitive: primIndex
+ 	"Note: those tests work with forwarders (wrong class index)"
+ 	| testReg target behavior targetFixUp |
+ 	<var: #targetFixUp type: #'BytecodeFixup *'>
+ 	self assert: self ssTop type = SSConstant.
+ 	self assert: (self ssValue: 1) type = SSConstant.
+ 	testReg := self allocateRegForStackEntryAt: 2.
+ 	(self ssValue: 2) popToReg: testReg.
+ 	behavior := (self ssValue: 1) constant.
+ 	target := self eventualTargetOf: ((objectMemory integerValueOf: self ssTop constant) + 3 + bytecodePC).
+ 	self ssPop: 3.
+ 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: target) to: #'AbstractInstruction *'.
+ 	primIndex caseOf: {
+ 	[0] -> 	["8000	jumpIfInstanceOf:distance:
+ 			 Anything, literal which is a Behavior, literal which is a Smi"
+ 			objectRepresentation branchIf: testReg instanceOfBehavior: behavior target: targetFixUp.
+ 			^0].
+ 	[1] -> 	["8001	jumpIfNotInstanceOf:distance:
+ 			 Anything, literal which is a Behavior, literal which is a Smi"
+ 			 objectRepresentation branchIf: testReg notInstanceOfBehavior: behavior target: targetFixUp.
+ 			^0].
+ 	[2] -> 	["8002	jumpIfInstanceOfOneOf:distance:
+ 			 Anything, Array of behaviors, literal which is a Smi"
+ 			 objectRepresentation branchIf: testReg instanceOfBehaviors: behavior target: targetFixUp.
+ 			^0].
+ 	[3] -> 	["8003	jumpIfNotInstanceOfOneOf:distance:
+ 			  Anything, Array of behaviors, literal which is a Smi"
+ 			 objectRepresentation branchIf: testReg notInstanceOfBehaviors: behavior target: targetFixUp.
+ 			^0].
+ 	}.
+ 	^ EncounteredUnknownBytecode
+ 	
+ 	!

Item was added:
+ ----- Method: SistaCogit>>genJumpUnaryInlinePrimitive: (in category 'inline primitive generators') -----
+ genJumpUnaryInlinePrimitive: primIndex
+ 	"6000	backjumpNoInterrupt
+ 	 literal which is a Smi"
+ 	primIndex = 0 ifTrue: 
+ 		[|targetBytecodePC|
+ 		 self assert: self ssTop type = SSConstant.
+ 		 targetBytecodePC := (objectMemory integerValueOf: self ssTop constant) + 3 + bytecodePC.
+ 		 self ssPop: 1.
+ 		 self ssFlushTo: simStackPtr.
+ 		 deadCode := true. "can't fall through"
+ 		 self Jump: (self fixupAt: targetBytecodePC).
+ 		 ^0].
+ 	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SistaCogit>>genMappedInlinePrimitive: (in category 'mapped inline primitive generators') -----
+ genMappedInlinePrimitive: primIndex
+ 	"SistaV1:	236		11101100	iiiiiiii		callMappedInlinedPrimitive"
+ 	"Number of arguments:
+ 	 0-49 nullary
+ 	 50-99 unary
+ 	 100-149  binary
+ 	 150-199 trinary
+ 	 200-255 variable"
+ 	"Specification:
+ 	50	EnsureEnoughWords
+ 	literal which is a Smi => ret value is receiver
+ 	150	immCheckPointerAt:put:
+ 	pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	151	immCheckStoreCheckPointerAt:put:
+ 	pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	152	immCheckMaybeContextPointerAt:put:
+ 	pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	153	immCheckMaybeContextStoreCheckPointerAt:put:
+ 	pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	154	immCheckByteAt:put:
+ 	byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	155	immCheckShortAt:put:
+ 	short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	156	immCheckWordAt:put:
+ 	word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	157	immCheckDoubleWordAt:put:
+ 	double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)
+ 	250	directCall
+ 	method to call on top of stack =>  (variable number of parameters)"
+ 	primIndex caseOf: 
+ 	{ 
+ 		[50] ->	 [^self genEnsureEnoughSlots].
+ 		[150] -> [^self genPointerAtPutMaybeContext: false storeCheck: false immutabilityCheck: true].
+ 		[151] -> [^self genPointerAtPutMaybeContext: false storeCheck: true immutabilityCheck: true].
+ 		[152] -> [^self genPointerAtPutMaybeContext: true storeCheck: false immutabilityCheck: true].
+ 		[153] -> [^self genPointerAtPutMaybeContext: true storeCheck: true immutabilityCheck: true].
+ 		[154] -> [self cppIf: #IMMUTABILITY
+ 					ifTrue: [^self genByteAtPutImmutabilityCheck]
+ 					ifFalse: [self genByteAtPut.
+ 							self annotateBytecode: self Label.
+ 							 ^0]].
+ 		[155] -> [^EncounteredUnknownBytecode "not implemented, missing short instruction in Cog RTL"].
+ 		[156] -> [^EncounteredUnknownBytecode "not implemented, need to deal with LargePositiveInteger in 32 bits"].
+ 		[157] -> [^EncounteredUnknownBytecode "not implemented, need to deal with LargePositiveInteger in 64 bits"].
+ 		[250] -> [^self genDirectCall].
+ 	} otherwise: [^EncounteredUnknownBytecode].
+ 	!

Item was changed:
  ----- Method: SistaCogit>>genNullaryInlinePrimitive: (in category 'inline primitive generators') -----
  genNullaryInlinePrimitive: prim
- 	"Nullary inline primitives."
- 	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
- 	 See EncoderForSistaV1's class comment and StackInterpreter>>#nullaryInlinePrimitive:"
- 
  	<option: #SistaVM>
  	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SistaCogit>>genPointerAtPutConstantMaybeContext:storeCheck:immutabilityCheck: (in category 'inline primitive generators') -----
+ genPointerAtPutConstantMaybeContext: maybeContext storeCheck: needsStoreCheck immutabilityCheck: needsImmCheck 
+ 	| rcvrReg valReg indexCst |
+ 	indexCst := (objectMemory integerValueOf: (self ssValue: 1) constant) - 1.
+ 	"we want to have on top of stack the value to write descriptor."
+ 	(maybeContext or: [needsImmCheck]) 
+ 		ifTrue: [ valReg := ClassReg.
+ 				 self voidReceiverResultRegContainsSelf.
+ 				 rcvrReg := ReceiverResultReg ]
+ 		ifFalse: [ valReg := self allocateRegForStackEntryAt: 0 notConflictingWith: 0.
+ 				  needsStoreCheck 
+ 					ifFalse: [rcvrReg := self allocateRegForStackEntryAt: 2 notConflictingWith: (self registerMaskFor: valReg)]
+ 					ifTrue: [self voidReceiverResultRegContainsSelf.
+ 							rcvrReg := ReceiverResultReg]].
+ 	"If rcvr is valReg, we flush it. Could generate a move instead but not that common"
+ 	self ssAllocateRequiredReg: valReg upThrough: simStackPtr - 2.
+ 	self ssAllocateRequiredReg: rcvrReg upThrough: simStackPtr - 3.
+ 	self ssTop popToReg: valReg.
+ 	self ssPop: 1.
+ 	self ssTop spilled ifTrue: [self AddCq: objectRepresentation wordSize R: SPReg].
+ 	self ssPop: 1.
+ 	self ssTop popToReg: rcvrReg.
+ 	self ssPop: 1.
+ 	self ssPushRegister: valReg.
+ 			
+ 	maybeContext
+ 		ifFalse: 
+ 			[^self 
+ 				genGenericStorePop: false 
+ 				slotIndex: indexCst
+ 				destReg: rcvrReg 
+ 				needsStoreCheck: needsStoreCheck 
+ 				needsRestoreRcvr: false 
+ 				needsImmutabilityCheck: needsImmCheck]
+ 		ifTrue:
+ 			[^self
+ 				genGenericStorePop: false 
+ 				MaybeContextSlotIndex: indexCst
+ 				needsStoreCheck: needsStoreCheck 
+ 				needsRestoreRcvr: false 
+ 				needsImmutabilityCheck: needsImmCheck]!

Item was added:
+ ----- Method: SistaCogit>>genPointerAtPutImmCheckAndStoreCheck (in category 'mapped inline primitive generators') -----
+ genPointerAtPutImmCheckAndStoreCheck
+ 	| ra1 ra2 rr adjust scratchReg immutableJump jmpImmediate jmpDestYoung jmpSourceOld jumpRemembered indexIsCst |
+ 	<var: #jmpSourceOld type: #'AbstractInstruction *'>
+ 	<var: #jmpDestYoung type: #'AbstractInstruction *'>
+ 	<var: #jmpImmediate type: #'AbstractInstruction *'>
+ 	<var: #immutableJump type: #'AbstractInstruction *'>
+ 	<var: #jumpRemembered type: #'AbstractInstruction *'>
+ 	"Assumes rr is not a context and no store check is needed"
+ 	indexIsCst := (self ssValue: 1) type = SSConstant.
+ 	self ssFlushTo: simStackPtr - 3.
+ 	rr := ReceiverResultReg.
+ 	ra1 := TempReg.
+ 	ra2 := ClassReg.
+ 	scratchReg := Arg0Reg.
+ 	adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
+ 	(self ssValue: 2) popToReg: rr.
+ 	indexIsCst
+ 		ifFalse:
+ 			[(self ssValue: 1) popToReg: ra1.
+ 			objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
+ 			adjust ~= 0 ifTrue: [self AddCq: adjust R: ra1]]
+ 		ifTrue: [self MoveCq: (objectMemory integerValueOf: (self ssValue: 1) constant) + adjust R: ra1].
+ 	self ssTop popToReg: ra2.
+ 	self ssPop: 3.
+ 	self ssPushRegister: ra2.
+ 	self voidReceiverResultRegContainsSelf.
+ 
+ 	immutableJump := self genJumpImmutable: rr scratchReg: scratchReg.
+ 	self MoveR: ra2 Xwr: ra1 R: rr.
+ 	
+ 	"store check"
+ 	jmpImmediate := self genJumpImmediate: ra2.
+ 	"Get the old/new boundary in scratchReg"
+ 	self MoveCw: objectMemory storeCheckBoundary R: scratchReg.
+ 	"Is target young?  If so we're done"
+ 	self CmpR: scratchReg R: rr. "N.B. FLAGS := destReg - scratchReg"
+ 	jmpDestYoung := self JumpBelow: 0.
+ 	"Is value stored old?  If so we're done."
+ 	self CmpR: scratchReg R: ra2. "N.B. FLAGS := valueReg - scratchReg"
+ 	jmpSourceOld := self JumpAboveOrEqual: 0.
+ 	"value is young and target is old.
+ 	 Need to remember this only if the remembered bit is not already set."
+ 	jumpRemembered := objectRepresentation genIfRequiredCheckRememberedBitOf: rr scratch: scratchReg.
+ 	"Set the inst var index for the benefit of the immutability check. The trampoline will
+ 	 repeat the check to choose between the immutbality violation and the store check."
+ 	immutableJump jmpTarget: self Label.
+ 	self PushR: ra2.
+ 	self SubCq: 1 + adjust R: ra1. "index 0-relative for trampoline, ra1 unused afterwards"
+ 	objectRepresentation genVarIndexCallStoreTrampoline.
+ 	self PopR: ra2.
+ 	jmpImmediate jmpTarget:
+ 	(jmpDestYoung jmpTarget:
+ 	(jmpSourceOld jmpTarget:
+ 		self Label)).
+ 	self setIfRequiredTargetOf: jumpRemembered toTargetOf: jmpImmediate.
+ 	
+ 	^0!

Item was added:
+ ----- Method: SistaCogit>>genPointerAtPutImmCheckButNoStoreCheck (in category 'mapped inline primitive generators') -----
+ genPointerAtPutImmCheckButNoStoreCheck
+ 	| ra1 ra2 rr adjust mutableJump immutabilityFailure indexIsCst |
+ 	<var: #mutableJump type: #'AbstractInstruction *'>
+ 	<var: #immutabilityFailure type: #'AbstractInstruction *'>
+ 	"Assumes rr is not a context and no store check is needed"
+ 	indexIsCst := (self ssValue: 1) type = SSConstant.
+ 	self ssFlushTo: simStackPtr - 3.
+ 	rr := ReceiverResultReg.
+ 	ra1 := TempReg.
+ 	ra2 := ClassReg.
+ 	(self ssValue: 2) popToReg: rr.
+ 	adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
+ 	indexIsCst
+ 		ifFalse:
+ 			[(self ssValue: 1) popToReg: ra1.
+ 			objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
+ 			adjust ~= 0 ifTrue: [self AddCq: adjust R: ra1]]
+ 		ifTrue: [self MoveCq: (objectMemory integerValueOf: (self ssValue: 1) constant) + adjust R: ra1].
+ 	self ssTop popToReg: ra2.
+ 	self ssPop: 3.
+ 	self ssPushRegister: ra2.
+ 	self voidReceiverResultRegContainsSelf.
+ 
+ 	mutableJump := self genJumpMutable: rr scratchReg: Arg0Reg.
+ 	"simStack is flushed, but result is not"
+ 	self PushR: ra2.
+ 	self SubCq: 1 + adjust R: ra1. "index 0-relative for trampoline, ra1 unused afterwards"
+ 	objectRepresentation genVarIndexCallStoreTrampoline.
+ 	self PopR: ra2.
+ 	immutabilityFailure := self Jump: 0.
+ 	
+ 	mutableJump jmpTarget: self Label.
+ 	self MoveR: ra2 Xwr: ra1 R: rr.
+ 	immutabilityFailure jmpTarget: self Label.
+ 	^0!

Item was added:
+ ----- Method: SistaCogit>>genPointerAtPutMaybeContext:storeCheck:immutabilityCheck: (in category 'mapped inline primitive generators') -----
+ genPointerAtPutMaybeContext: maybeContext storeCheck: needsStoreCheck immutabilityCheck: needsImmCheck
+ 	"150	immCheckPointerAt:put:
+ 	pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	151	immCheckStoreCheckPointerAt:put:
+ 	pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	152	immCheckMaybeContextPointerAt:put:
+ 	pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	153	immCheckMaybeContextStoreCheckPointerAt:put:
+ 	pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 	| index |
+ 	index := self ssValue: 1.
+ 	"Instruction always annoted - uncommon, IMMUTABILITY disabled. We need a Nop since previous instr can be annotated."
+ 	self cppIf: #IMMUTABILITY ifTrue: [] ifFalse: [ needsImmCheck ifTrue: [ self annotateBytecode: self Nop ] ].
+ 	"Optimised case if arg1 is constant"
+ 	index type = SSConstant 
+ 		ifTrue:  [^self genPointerAtPutConstantMaybeContext: maybeContext storeCheck: needsStoreCheck immutabilityCheck: needsImmCheck].
+ 	maybeContext ifTrue: [^EncounteredUnknownBytecode "not implemented, not used right now, for tempAt: optimisation on non constant"].
+ 	self cppIf: #IMMUTABILITY ifTrue:
+ 		[needsImmCheck
+ 			ifTrue: [needsStoreCheck
+ 				ifTrue: [^self genPointerAtPutImmCheckAndStoreCheck]
+ 				ifFalse: [^self genPointerAtPutImmCheckButNoStoreCheck] ] ].
+ 	^self genPointerAtPutStoreCheck: needsStoreCheck!

Item was added:
+ ----- Method: SistaCogit>>genPointerAtPutStoreCheck: (in category 'mapped inline primitive generators') -----
+ genPointerAtPutStoreCheck: needsStoreCheck 
+ 	| ra1 ra2 rr adjust |
+ 	"Assumes rr is not a context and no immutability check is needed"
+ 	"The store check requires rr to be ReceiverResultReg"
+ 	self 
+ 		allocateRegForStackTopThreeEntriesInto: [:rTop :rNext :rThird | ra2 := rTop. ra1 := rNext. rr := rThird ] 
+ 		thirdIsReceiver: needsStoreCheck.
+ 	self assert: (rr ~= ra1 and: [rr ~= ra2 and: [ra1 ~= ra2]]).
+ 	self ssTop popToReg: ra2.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: ra1.
+ 	self ssPop: 1.
+ 	self ssTop popToReg: rr.
+ 	self ssPop: 1.
+ 	objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
+ 	adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
+ 	adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra1. ]. 
+ 	self MoveR: ra2 Xwr: ra1 R: rr.
+ 	needsStoreCheck ifTrue: 
+ 		[ self assert: needsFrame. 
+ 		objectRepresentation genStoreCheckReceiverReg: rr valueReg: ra2 scratchReg: TempReg inFrame: true].
+ 	self ssPushRegister: ra2.
+ 	^0!

Item was changed:
  ----- Method: SistaCogit>>genQuaternaryInlinePrimitive: (in category 'inline primitive generators') -----
  genQuaternaryInlinePrimitive: prim
+ 	^ EncounteredUnknownBytecode!
- 	"Quaternary inline primitives."
- 	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
- 	 See EncoderForSistaV1's class comment and StackInterpreter>>#quaternaryInlinePrimitive:"
- 	| needStoreCheck sourceReg stopReg objReg adjust jmp cmp isStartCst isStopCst startCst stopCst iteratorReg |
- 	<var: #jmp type: #'AbstractInstruction *'>
- 	<var: #cmp type: #'AbstractInstruction *'>
- 	prim = 0 ifFalse: [^EncounteredUnknownBytecode].
- 	
- 	"4000	Pointer Object>> fillFrom:to:with: The receiver is a Pointer object. the middle two arguments are smallintegers. Last argument is any object. Fills the object in between the two indexes with last argument. Receiver is guaranteed to be mutable. The pointer accesses are raw (no inst var check). If ExtB is set to 1, no store check is present. Else a single store check is done for the bulk operation. Answers the receiver."
- 	needStoreCheck := self sistaNeedsStoreCheck.
- 	extB := numExtB := 0.
- 	
- 	"Allocate reg for src, objToStore, iterator and stop."
- 	sourceReg := needStoreCheck 
- 		ifTrue: [	self ssAllocateRequiredReg: ReceiverResultReg.
- 				self voidReceiverResultRegContainsSelf.
- 				ReceiverResultReg ]
- 		ifFalse: [ self allocateRegForStackEntryAt: 3 notConflictingWith: self emptyRegisterMask ].
- 	(self ssValue: 3) popToReg: sourceReg.
- 	objReg := self allocateRegForStackEntryAt: 0 notConflictingWith: (self registerMaskFor: sourceReg).
- 	self ssTop popToReg: objReg.
- 	
- 	"Set up iterator to first index to write and stop to last index to write"
- 	adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
- 	isStartCst := (self ssValue: 2) type = SSConstant.
- 	isStopCst := (self ssValue: 1) type = SSConstant.
- 	isStartCst ifTrue: [startCst := adjust + (objectMemory integerValueOf: (self ssValue: 2) constant)].
- 	isStopCst ifTrue: [stopCst := adjust + (objectMemory integerValueOf: (self ssValue: 1) constant)].
- 	
- 	(isStartCst
- 	and: [isStopCst
- 	and: [stopCst - startCst < 7 ]]) "The other path generates at least 7 instructions"
- 		ifTrue: ["unroll"
- 				startCst
- 					to: stopCst
- 					do: [ :i | self MoveMw: i r: sourceReg R: objReg ] ]
- 		ifFalse: ["loop"
- 				stopReg := self allocateRegNotConflictingWith: (self registerMaskFor: sourceReg and: objReg).
- 				iteratorReg := self allocateRegNotConflictingWith: (self registerMaskFor: sourceReg and: objReg and: stopReg).
- 				isStartCst 
- 					ifTrue: [ self MoveCq: startCst R: iteratorReg ]
- 					ifFalse: [ (self ssValue: 2) popToReg: iteratorReg. 
- 							 adjust ~= 0 ifTrue: [ self AddCq: adjust R: iteratorReg ] ].
- 				isStopCst 
- 					ifTrue: [ self MoveCq: stopCst R: stopReg ]
- 					ifFalse: [ (self ssValue: 1) popToReg: stopReg. 
- 							 adjust ~= 0 ifTrue: [ self AddCq: adjust R: stopReg ] ].
- 				cmp := self CmpR: stopReg R: iteratorReg.
- 				jmp := self JumpAbove: 0.
- 				self MoveR: objReg Xwr: iteratorReg R: sourceReg.
- 				self AddCq: 1 R: iteratorReg.
- 				self Jump: cmp.
- 				jmp jmpTarget: self Label].
- 			
- 	needStoreCheck ifTrue: [objectRepresentation genStoreCheckReceiverReg: sourceReg valueReg: objReg scratchReg: TempReg inFrame: true].
- 	
- 	self ssPop: 4.
- 	self ssPushRegister: sourceReg.
- 	 ^0!

Item was changed:
  ----- Method: SistaCogit>>genQuinaryInlinePrimitive: (in category 'inline primitive generators') -----
  genQuinaryInlinePrimitive: prim
+ 	^ EncounteredUnknownBytecode!
- 	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
- 	 See EncoderForSistaV1's class comment and StackInterpreter>>#quaternaryInlinePrimitive:"
- 	| srcReg destReg destIterator srcIterator limitReg jmpDestYoung instr jmpAlreadyRemembered jumpFinished singleIterator |
- 	<var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
- 	<var: #jmpDestYoung type: #'AbstractInstruction *'>
- 	<var: #jumpFinished type: #'AbstractInstruction *'>
- 	<var: #instr type: #'AbstractInstruction *'>
- 	prim ~= 0 ifTrue: [^EncounteredUnknownBytecode].
- 	
- 	"5000	Pointer Object>> replaceFrom: srcPos to: srcLast with: startingAt: 
- 	Src and dest are pointer objects. 
- 	ScrPos, scrLast and destLast are smallintegers. 
- 	Receiver is guaranteed to be mutable.  
- 	Both ranges are in-bounds. 
- 	The pointer accesses are raw (no inst var check). 
- 	As for the normal primitive, the copy is linear from the first field to the last field (legacy code relies on it). 
- 	Answers the receiver."
- 	singleIterator := self ssTop type = SSConstant 
- 						and: [(self ssValue: 3) type = SSConstant 
- 						and: [self ssTop constant = (self ssValue: 3) constant]].
- 	 srcIterator :=  self allocateRegForStackEntryAt: 0 notConflictingWith: self emptyRegisterMask.
- 	 self genMoveAndAdjustSSEntry: (self ssValue: 0) into: srcIterator. 
- 	 srcReg := self allocateRegForStackEntryAt: 1 notConflictingWith: (self registerMaskFor: srcIterator).
- 	 (self ssValue: 1) popToReg: srcReg.
- 	 limitReg := self allocateRegForStackEntryAt: 2 notConflictingWith: (self registerMaskFor: srcIterator and: srcReg).
- 	 self genMoveAndAdjustSSEntry: (self ssValue: 2) into: limitReg.
- 	singleIterator
- 		ifTrue: 
- 			[ destIterator := srcIterator ]
- 		ifFalse: 
- 			[ destIterator := self allocateRegForStackEntryAt: 3 notConflictingWith: (self registerMaskFor: srcIterator and: srcReg and: limitReg).
- 			  self genMoveAndAdjustSSEntry: (self ssValue: 3) into: destIterator ].
- 	 destReg := self allocateRegForStackEntryAt: 4 notConflictingWith: (self registerMaskFor: srcIterator and: srcReg and: limitReg and: destIterator).
- 	 (self ssValue: 4) popToReg: destReg.
- 	
- 	"store check"
- 	extB > 0 ifFalse:
- 		[self MoveCw: objectMemory storeCheckBoundary R: TempReg.
- 		 self CmpR: TempReg R: destReg.
- 		 jmpDestYoung := self JumpBelow: 0.
- 		 objectRepresentation checkRememberedInTrampoline ifFalse: 
- 			[jmpAlreadyRemembered := objectRepresentation genCheckRememberedBitOf: destReg scratch: TempReg].
- 		 objectRepresentation callStoreCheckTrampoline.
- 		 jmpDestYoung jmpTarget: self Label.
- 		 objectRepresentation checkRememberedInTrampoline ifFalse: 
- 			[jmpAlreadyRemembered jmpTarget: self Label]].
- 	extB := 0.
- 	
- 	"Fast copy - no store check"
- 	instr := self CmpR: destIterator R: limitReg.
- 	jumpFinished := self JumpBelow: 0.
- 	self MoveXwr: srcIterator R: srcReg R: TempReg.
- 	self MoveR: TempReg Xwr: destIterator R: destReg.
- 	self AddCq: 1 R: srcIterator.
- 	srcIterator ~= destIterator ifTrue: [ self AddCq: 1 R: destIterator ].
- 	self Jump: instr.
- 	jumpFinished jmpTarget: self Label.
- 	
- 	self ssPop: 5.
- 	self ssPushRegister: destReg.
- 	^ 0!

Item was added:
+ ----- Method: SistaCogit>>genSistaInlinePrimitive: (in category 'inline primitive generators') -----
+ genSistaInlinePrimitive: prim
+ 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution. This is the dispatch for unmapped sista inlined primitives."
+ 	
+ 	prim < 1000 ifTrue:
+ 		[^self genNullaryInlinePrimitive: prim].
+ 
+ 	prim < 2000 ifTrue:
+ 		[^self genUnaryInlinePrimitive: prim - 1000].
+ 	
+ 	prim < 3000 ifTrue:
+ 		[^self genBinaryInlinePrimitive: prim - 2000].
+ 
+ 	prim < 4000 ifTrue:
+ 		[^self genTrinaryInlinePrimitive: prim - 3000].
+ 	
+ 	prim < 5000 ifTrue: 
+ 		[^self genQuaternaryInlinePrimitive: prim - 4000].
+ 	
+ 	prim < 6000 ifTrue: 
+ 		[^self genQuinaryInlinePrimitive: prim - 5000].
+ 		
+ 	 prim < 7000 ifTrue:
+ 		[^self genJumpUnaryInlinePrimitive: prim - 6000].
+ 	
+  	prim < 8000 ifTrue:
+ 		[^self genJumpBinaryInlinePrimitive: prim - 7000].
+ 	
+ 	^ self genJumpTrinaryInlinePrimitive: prim - 8000.!

Item was changed:
  ----- Method: SistaCogit>>genTrinaryInlinePrimitive: (in category 'inline primitive generators') -----
  genTrinaryInlinePrimitive: prim
+ 	"Bulk comment, each sub method has its own comment
+ 	3000	pointerAt:put:
+ 	Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3001	storeCheckPointerAt:put:
+ 	Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3002	maybeContextPointerAt:put:
+ 	Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3003	maybeContextStoreCheckPointerAt:put:
+ 	Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3004	byteAt:put:
+ 	Mutable byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	3005	shortAt:put:
+ 	Mutable short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	3006	wordAt:put:
+ 	Mutable word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	3007	doubleWordAt:put:
+ 	Mutable double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)
+ 	3021 is deprecated."
+ 	prim <= 7 ifTrue: [^self genAtPutInlinePrimitive: prim].
+ 	prim = 21 ifTrue: [^self genByteEqualsInlinePrimitive: prim].
- 	"trinary inline primitives."
- 	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
- 	 See EncoderForSistaV1's class comment and StackInterpreter>>#trinaryInlinePrimitive:"
- 
- 	prim < 10 ifTrue: [^ self genAtPutInlinePrimitive: prim].
- 	prim = 21 ifTrue: [^ self genByteEqualsInlinePrimitive: prim].
  	^ EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SistaCogit>>genUnaryClassPrimitive (in category 'inline primitive unary generators') -----
+ genUnaryClassPrimitive 
+ 	"1000	rawClass
+ 	not a forwarder => Behavior (Same as class special send, but receiver is not a forwarder)"
+ 	
+ 	"Important performance note:
+ 	In Scorch, typically a value is known as not being a forwarder if there is a trap.
+ 	If the trap is due to a monomorphic send, the #class send leads to:
+ 		trapIf: X notInstanceOf: C
+ 		X rawClass
+ 	therefore X rawClass is simplified in Scorch to the cst:C
+ 	The rawClass is therefore used only for PICs. 
+ 		trapIf: X notInstanceOf: C, C', C''
+ 		X rawClass
+ 	This unsafe operation is important to avoid register flush, but the performance 
+ 	difference in differencing rawClass for immediate and rawClass for non immediate 
+ 	classes is not that relevant"
+ 	
+ 	| topReg jumpIsImm destReg |
+ 	<var: #jumpIsImm type: #'AbstractInstruction *'>
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: 0.
+ 	destReg := self allocateRegNotConflictingWith: (self registerMaskFor: topReg).
+ 	self ssTop popToReg: topReg.
+ 	
+ 	"1. Read the class index"
+ 	self MoveR: topReg R: TempReg.
+ 	self AndCq: objectMemory tagMask R: TempReg.
+ 	jumpIsImm := self JumpNonZero: 0.
+ 	self flag: #endianness.
+ 	"Get least significant half of header word in destReg"
+ 	self MoveMw: 0 r: topReg R: TempReg.
+ 	"mask off class index"
+ 	self AndCq: objectMemory classIndexMask R: TempReg.
+ 	
+ 	"2. Read the class from class index"
+ 	jumpIsImm jmpTarget: self Label.
+ 	objectRepresentation genGetClassObjectOfClassIndex: TempReg into: destReg scratchReg: topReg.
+ 	self ssPop: 1.
+ 	^self ssPushRegister: destReg!

Item was added:
+ ----- Method: SistaCogit>>genUnaryConvertInlinePrimitive: (in category 'inline primitive unary generators') -----
+ genUnaryConvertInlinePrimitive: primIndex
+ 	| resultReg |
+ 	self assert: (primIndex between: 30 and: 32).
+ 	primIndex caseOf: {
+ 		"1030	characterAsInteger
+ 		 Character => 22 bits strictly positive Smi (Unicode)"
+ 		[30] -> [resultReg := self allocateRegForStackEntryAt: 0. 
+ 				self ssTop popToReg: resultReg.
+ 				objectRepresentation genConvertCharacterToSmallIntegerInReg: resultReg].
+ 		"1031	smallFloatAsInteger
+ 		 SmallFloat => Smi"
+ 		[31] -> [^EncounteredUnknownBytecode "to implement"].
+ 		"1032	smiAsFloat
+ 		 Smi => SmallFloat"
+ 		[32] -> [resultReg := self allocateRegForStackEntryAt: 0. 
+ 				self ssTop popToReg: resultReg.
+ 				self assert: self processorHasDoublePrecisionFloatingPointSupport.
+ 				self MoveR: resultReg R: TempReg.
+ 				self genConvertSmallIntegerToIntegerInReg: TempReg.
+ 				self ConvertR: TempReg Rd: DPFPReg0.
+ 				self flag: #TODO. "Should never fail"
+ 				self
+ 					genAllocFloatValue: DPFPReg0
+ 					into: resultReg
+ 					scratchReg: TempReg
+ 					scratchReg: NoReg. "scratch2 for V3 only"] 
+ 	}.
+ 	self ssPop: 1.
+ 	^self ssPushRegister: resultReg!

Item was added:
+ ----- Method: SistaCogit>>genUnaryHashInlinePrimitive: (in category 'inline primitive unary generators') -----
+ genUnaryHashInlinePrimitive: primIndex
+ 	| rcvrReg resultReg |
+ 	self assert: (primIndex between: 20 and: 23).
+ 	primIndex caseOf: {
+ 		"1020	objectIdentityHash
+ 		 non-immediate and non-behavior => 22 bits strictly positive Smi"
+ 		[20] ->	[rcvrReg := self allocateRegForStackEntryAt: 0.
+ 				 resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
+ 				 self ssTop popToReg: rcvrReg.
+ 				 objectRepresentation genGetIdentityHash: rcvrReg resultReg: resultReg].
+ 		"1021	smiIdentityHash
+ 		 Smi => Smi"
+ 		[21] -> [resultReg := self allocateRegForStackEntryAt: 0. 
+ 				self ssTop popToReg: resultReg].		
+ 		"1022	charIdentityHash
+ 		 Character => 22 bits strictly positive Smi"
+ 		[22] -> [resultReg := self allocateRegForStackEntryAt: 0. 
+ 				self ssTop popToReg: resultReg.
+ 				objectRepresentation genConvertCharacterToSmallIntegerInReg: resultReg].
+ 		"1023	smallfloatIdentityHash
+ 		 SmallFloat => Smi"
+ 		[23] -> [resultReg := self allocateRegForStackEntryAt: 0. 
+ 				objectRepresentation genConvertSmallFloatToSmallFloatHashAsIntegerInReg: resultReg scratch: TempReg].
+ 		"1024	behaviorIdentityHash
+ 		 Behavior => 22 bits strictly positive Smi"
+ 		[24] -> [^EncounteredUnknownBytecode "not implemented"].	
+ 		}.
+ 		self ssPop: 1.
+ 		^self ssPushRegister: resultReg!

Item was changed:
+ ----- Method: SistaCogit>>genUnaryInlinePrimitive: (in category 'inline primitive unary generators') -----
+ genUnaryInlinePrimitive: primIndex
+ 	"Bulk comments: each sub-method has its own comment with the specific case.
+ 	1000	rawClass
+ 	not a forwarder => Behavior (Same as class special send, but receiver is not a forwarder)
+ 	1001	numSlots
+ 	pointer object => Smi between 0 and SmallInteger maxVal // 4 - 1 (Answers total size in pointer-sized slots)
+ 	1002	numBytes
+ 	byte object => Smi between 0 and SmallInteger maxVal - 9 (Includes compiled code)
+ 	1003	numShorts
+ 	short object => Smi between 0 and SmallInteger maxVal - 9
+ 	1004	numWords
+ 	word object => Smi between 0 and SmallInteger maxVal - 9
+ 	1005	numDoubleWords
+ 	double word object => Smi between 0 and SmallInteger maxVal - 9
+ 	1011	RawNew
+ 	literal which is a fixed-sized behavior => instance of the receiver with fields nilled out
+ 	1012	RawNewNoInit
+ 	literal which is a fixed-sized behavior => instance of the receiver (Fields of returned value contain undefined data)
+ 	1020	objectIdentityHash
+ 	non-immediate and non-behavior => 22 bits strictly positive Smi
+ 	1021	smiIdentityHash
+ 	Smi => Smi
+ 	1022	charIdentityHash
+ 	Character => 22 bits strictly positive Smi
+ 	1023	smallfloatIdentityHash
+ 	SmallFloat => Smi
+ 	1024	behaviorIdentityHash
+ 	Behavior => 22 bits strictly positive Smi
+ 	1030	characterAsInteger
+ 	Character => 22 bits strictly positive Smi (Unicode)
+ 	1031	smallFloatAsInteger
+ 	SmallFloat => Smi
+ 	1032	smiAsFloat
+ 	Smi => SmallFloat
+ 	1040	unforward
+ 	Anything => Not a forwarder
+ 	1041	possibleRoot
+ 	non-immediate, not a forwarder => receiver is returned (should be effect-only) (If old, becomes gray and remembered to allow many unchecked stores in a row afterwards)"
+ 	primIndex = 0 ifTrue: [^self genUnaryClassPrimitive].
+ 	primIndex <= 6 ifTrue: [^self genUnarySizeInlinePrimitive: primIndex].
+ 	primIndex < 11 ifTrue: [^EncounteredUnknownBytecode].
+ 	primIndex <= 12 ifTrue: [^self genUnaryNewInlinePrimitive: primIndex].
+ 	primIndex < 20 ifTrue: [^EncounteredUnknownBytecode].
+ 	primIndex <= 24 ifTrue: [^self genUnaryHashInlinePrimitive: primIndex].
+ 	primIndex < 30 ifTrue: [^EncounteredUnknownBytecode].
+ 	primIndex <= 32 ifTrue: [^self genUnaryConvertInlinePrimitive: primIndex].
+ 	primIndex = 39 ifTrue: [^self genUnaryUnforwardNonImmediateInlinePrimitive].
+ 	primIndex = 40 ifTrue: [^self genUnaryUnforwardInlinePrimitive].
+ 	primIndex = 41 ifTrue: [^self genUnaryPossibleRootInlinePrimitive].
+ 	^EncounteredUnknownBytecode!
- ----- Method: SistaCogit>>genUnaryInlinePrimitive: (in category 'inline primitive generators') -----
- genUnaryInlinePrimitive: prim
- 	"Unary inline primitives."
- 	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
- 	 See EncoderForSistaV1's class comment and StackInterpreter>>#unaryInlinePrimitive:"
- 	| rcvrReg resultReg |
- 	rcvrReg := self allocateRegForStackEntryAt: 0.
- 	resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
- 	prim
- 		caseOf: {
- 					"00		unchecked class"
- 			[1] ->	"01		unchecked pointer numSlots"
- 				[self ssTop popToReg: rcvrReg.
- 				 self ssPop: 1.
- 				 objectRepresentation
- 					genGetNumSlotsOf: rcvrReg into: resultReg;
- 					genConvertIntegerToSmallIntegerInReg: resultReg].
- 					"02		unchecked pointer basicSize"
- 			[3] ->	"03		unchecked byte numBytes"
- 				[self ssTop popToReg: rcvrReg.
- 				 self ssPop: 1.
- 				 objectRepresentation
- 					genGetNumBytesOf: rcvrReg into: resultReg;
- 					genConvertIntegerToSmallIntegerInReg: resultReg].
- 					"04		unchecked short16Type format numShorts"
- 					"05		unchecked word32Type format numWords"
- 					"06		unchecked doubleWord64Type format numDoubleWords"
- 			[11] ->	"11		unchecked fixed pointer basicNew"
- 				[self ssTop type ~= SSConstant ifTrue:
- 					[^EncounteredUnknownBytecode].
- 				 (objectRepresentation
- 					genGetInstanceOfFixedClass: self ssTop constant
- 						into: resultReg
- 							initializingIf: self extBSpecifiesInitializeInstance) ~= 0 ifTrue:
- 					[^ShouldNotJIT]. "e.g. bad class"
- 				 self ssPop: 1] .
- 			[20] ->	"20 	identityHash"
- 				[objectRepresentation genGetIdentityHash: rcvrReg resultReg: resultReg.
- 				 self ssPop: 1] .
- 					"21		identityHash (SmallInteger)"
- 					"22		identityHash (Character)"
- 					"23		identityHash (SmallFloat64)"
- 					"24		identityHash (Behavior)"
- 					"30 	immediateAsInteger (Character)
- 					 31 	immediateAsInteger (SmallFloat64)
- 					 35		immediateAsFloat 	  (SmallInteger)	"
- 			[30] -> 
- 				[self ssTop popToReg: resultReg.
- 				 objectRepresentation genConvertCharacterToSmallIntegerInReg: resultReg.
- 				 self ssPop: 1].
- 			[35] -> 
- 				[self assert: self processorHasDoublePrecisionFloatingPointSupport.
- 				self MoveR: rcvrReg R: TempReg.
- 				self genConvertSmallIntegerToIntegerInReg: TempReg.
- 				self ConvertR: TempReg Rd: DPFPReg0.
- 				self flag: #TODO. "Should never fail"
- 				self
- 					genAllocFloatValue: DPFPReg0
- 					into: resultReg
- 					scratchReg: TempReg
- 					scratchReg: NoReg. "scratch2 for V3 only"]
- 				  }
- 				
- 		otherwise:
- 			[^EncounteredUnknownBytecode].
- 	extB := 0.
- 	numExtB := 0.
- 	self ssPushRegister: resultReg.
- 	^0!

Item was added:
+ ----- Method: SistaCogit>>genUnaryNewInlinePrimitive: (in category 'inline primitive unary generators') -----
+ genUnaryNewInlinePrimitive: primIndex 
+ 	"1011	RawNew
+ 	 literal which is a fixed-sized behavior => instance of the receiver with fields nilled out
+ 	1012	RawNewNoInit
+ 	literal which is a fixed-sized behavior => instance of the receiver (Fields of returned value contain undefined data)"
+ 	| resultReg classObj |
+ 	self assert: (self ssTop type = SSConstant).
+ 	classObj := self ssTop constant.
+ 	self assert: (objectMemory isNonImmediate: classObj).
+ 	self assert: (coInterpreter objCouldBeClassObj: classObj).
+ 	self assert: (objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClassFormat: (objectMemory formatOfClass: classObj))).
+ 	objectMemory classTagForClass: classObj. "Ensure Behavior hash"
+ 	resultReg := self allocateRegNotConflictingWith: 0.
+ 	objectRepresentation genGetInstanceOfPointerClass: classObj into: resultReg initializingIf: primIndex = 11 numVariableSlots: 0.
+ 	self ssPop: 1.
+ 	^self ssPushRegister: resultReg!

Item was added:
+ ----- Method: SistaCogit>>genUnaryPossibleRootInlinePrimitive (in category 'inline primitive unary generators') -----
+ genUnaryPossibleRootInlinePrimitive
+ 	"1041	possibleRoot
+ 	 non-immediate, not a forwarder => receiver is returned (should be effect-only) (If old, becomes gray and remembered to allow many unchecked stores in a row afterwards)"
+ 	| topReg jmpDestYoung jmpAlreadyRemembered|
+ 	<var: #jmpDestYoung type: #'AbstractInstruction *'>
+ 	<var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: 0.
+ 	self ssTop popToReg: topReg.
+ 	self MoveCw: objectMemory storeCheckBoundary R: TempReg.
+ 	 self CmpR: TempReg R: topReg.
+ 	 jmpDestYoung := self JumpBelow: 0.
+ 	 objectRepresentation checkRememberedInTrampoline ifFalse: 
+ 		[jmpAlreadyRemembered := objectRepresentation genCheckRememberedBitOf: topReg scratch: TempReg].
+ 	 objectRepresentation callStoreCheckTrampoline.
+ 	 jmpDestYoung jmpTarget: self Label.
+ 	 objectRepresentation checkRememberedInTrampoline ifFalse: 
+ 		[jmpAlreadyRemembered jmpTarget: self Label].
+ 	self ssPop: 1.
+ 	^self ssPushRegister: topReg!

Item was added:
+ ----- Method: SistaCogit>>genUnarySizeInlinePrimitive: (in category 'inline primitive unary generators') -----
+ genUnarySizeInlinePrimitive: primIndex 
+ 	| rcvrReg resultReg |
+ 	self assert: (primIndex between: 1 and: 6).
+ 	rcvrReg := self allocateRegForStackEntryAt: 0 notConflictingWith: 0.
+ 	resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
+ 	self ssTop popToReg: rcvrReg.
+ 	self ssPop: 1.
+ 	self ssPushRegister: resultReg.
+ 	primIndex caseOf: {
+ 		"1001	numSlots
+ 		 pointer object => Smi between 0 and SmallInteger maxVal // 4 - 1 (Answers total size in pointer-sized slots)"
+ 		[1]	->	[objectRepresentation
+ 					genGetNumSlotsOf: rcvrReg into: resultReg;
+ 					genConvertIntegerToSmallIntegerInReg: resultReg].
+ 		"1002	numBytes
+ 		 byte object => Smi between 0 and SmallInteger maxVal - 9 (Includes compiled code)"
+ 		[2]	->	[objectRepresentation
+ 					genGetNumBytesOf: rcvrReg into: resultReg;
+ 					genConvertIntegerToSmallIntegerInReg: resultReg].
+ 		"1003	numShorts
+ 		 short object => Smi between 0 and SmallInteger maxVal - 9"
+ 		[3]	->	[^EncounteredUnknownBytecode "not implemented"].
+ 		"1004	numWords
+ 		 word object => Smi between 0 and SmallInteger maxVal - 9"
+ 		[5]	->	[^EncounteredUnknownBytecode "not implemented"].
+ 		"1005	numDoubleWords 
+ 		 double word object => Smi between 0 and SmallInteger maxVal - 9"
+ 		[6]	->	[^EncounteredUnknownBytecode "not implemented"].
+ 	}..
+ 	^ 0!

Item was added:
+ ----- Method: SistaCogit>>genUnaryUnforwardInlinePrimitive (in category 'inline primitive unary generators') -----
+ genUnaryUnforwardInlinePrimitive
+ 	"1040	unforward
+ 	 Anything => Not a forwarder"
+ 	| topReg |
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: 0.
+ 	self ssTop popToReg: topReg.
+ 	objectRepresentation genEnsureOopInRegNotForwarded: topReg scratchReg: TempReg.
+ 	self ssPop: 1.
+ 	^self ssPushRegister: topReg!

Item was added:
+ ----- Method: SistaCogit>>genUnaryUnforwardNonImmediateInlinePrimitive (in category 'inline primitive unary generators') -----
+ genUnaryUnforwardNonImmediateInlinePrimitive
+ 	"1039	unforwardNonImmediate
+ 	 non immediate => Not a forwarder"
+ 	| topReg |
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: 0.
+ 	self ssTop popToReg: topReg.
+ 	objectRepresentation genEnsureObjInRegNotForwarded: topReg scratchReg: TempReg.
+ 	self ssPop: 1.
+ 	^self ssPushRegister: topReg!

Item was added:
+ ----- Method: SistaCogit>>maybeDealWithUnsafeJumpForDescriptor:pc:latestContinuation: (in category 'compile abstract instructions') -----
+ maybeDealWithUnsafeJumpForDescriptor: descriptor pc: pc latestContinuation: latestContinuation
+ 	"Mapped: 250	backjumpAlwaysInterrupt
+ 	 Unmapped: 6000	backjumpNoInterrupt 
+ 				 7016-7020 jumpWritable/Young
+ 				 8000-8003 type branches
+ 	In all cases the distance is an integer pushed on stack just before with pushIntegerLong:"
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	| distance targetPC byte01 byte02 newContinuation |
+ 	newContinuation := latestContinuation.
+ 	descriptor hasUnsafeJump ifTrue:
+ 		[ byte01 := objectMemory fetchByte: pc + 1 ofObject: methodObj.
+ 		  byte02 := objectMemory fetchByte: pc + 2 ofObject: methodObj.
+ 		  distance := self decodePushIntegerLongBefore: pc in: methodObj.
+ 		  targetPC := pc + descriptor numBytes + distance.
+ 		  descriptor isMapped 
+ 			ifTrue: [ byte01 = 250 ifTrue: 
+ 				[ "mapped always interrupt backjump" 
+ 				 self maybeCountFixup: descriptor.
+ 				 self initializeFixupAt: targetPC ] ]
+ 			ifFalse: 
+ 				[ byte02 >> 5 = 2r100 ifTrue: 
+ 					[ "inlined sista primitive" 
+ 					| prim |
+ 					prim := (byte02 bitAnd: 16r1F) << 8 + byte01.
+ 					prim >= 7000
+ 						ifTrue: 
+ 							["branch forward"
+ 							 self maybeCountFixup: descriptor.
+ 							 newContinuation := latestContinuation max: targetPC ]
+ 						ifFalse: 
+ 							[prim >= 6000 ifTrue: 
+ 								["no interrupt back jump"
+ 								self maybeCountFixup: descriptor.
+ 								self initializeFixupAt: targetPC]]]]].
+ 	^newContinuation!

Item was added:
+ ----- Method: SistaCogit>>maybeUnsafeJumpContinuation:at:for:in: (in category 'compile abstract instructions') -----
+ maybeUnsafeJumpContinuation: latestContinuation at: bcpc for: descriptor in: aMethodObj
+ 	<inline: true>
+ 	"Note: ignore backward jumps."
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	| distance targetPC byte01 byte02 newContinuation | 
+ 	newContinuation := latestContinuation.
+ 	descriptor hasUnsafeJump ifTrue:
+ 		[ byte01 := objectMemory fetchByte: bcpc + 1 ofObject: aMethodObj.
+ 		  byte02 := objectMemory fetchByte: bcpc + 2 ofObject: aMethodObj.
+ 		  "pushIntegerLong"
+ 		  distance := self decodePushIntegerLongBefore: bcpc in: methodObj.
+ 		  targetPC := bcpc + descriptor numBytes + distance.
+ 		  descriptor isMapped 
+ 			ifFalse: 
+ 				[ byte02 >> 5 = 2r100 ifTrue: 
+ 					[ "inlined sista primitive" 
+ 					| prim |
+ 					prim := (byte02 bitAnd: 16r1F) << 8 + byte01.
+ 					prim >= 7000
+ 						ifTrue: 
+ 							["branch forward"
+ 							 newContinuation := latestContinuation max: targetPC ]]]].
+ 	^newContinuation!

Item was removed:
- ----- Method: SistaRegisterAllocatingCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
- genExtJumpIfNotInstanceOfBehaviorsBytecode
- 	"SistaV1: *	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
- 	| reg literal distance targetFixUp inverse |
- 
- 	"We lose the information of in which register is stack top 
- 	 when jitting the branch target so we need to flush everything. 
- 	 We could use a fixed register here...."
- 	reg := self allocateRegForStackEntryAt: 0.
- 	self ssTop popToReg: reg.
- 	self ssPop: 1.
- 
- 	literal := self getLiteral: (extA * 256 + byte1).
- 	(inverse := extB < 0) ifTrue:
- 		[extB := extB + 128].
- 	distance := extB * 256 + byte2.
- 	extA := extB := numExtB := 0.
- 
- 	"For now just deny we're in the situation we have yet to implement ;-)"
- 	self deny: (self mergeRequiredForJumpTo: bytecodePC + 3 + distance).
- 
- 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- 	inverse
- 		ifFalse: 
- 			[(objectMemory isArrayNonImm: literal)
- 				ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
- 				ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
- 		ifTrue:
- 			[(objectMemory isArrayNonImm: literal)
- 				ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
- 				ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
- 
- 	^0!

Item was changed:
  ----- Method: StackDepthFinder>>callInlinePrimitive: (in category 'instruction decoding') -----
  callInlinePrimitive: primitiveIndex
  	"The convention for inline primitives is that the argument count is primitiveIndex // 1000 - 1,
  	 so receiverless 0-arg prims are from 0 to 999 (does this even make sense?), 0-arg prims
+ 	 are from 1 to 1999, 2-arg prims from 1000 to 1999, and so on.
+ 	 Primitives over 6000 are jumps."
+ 	primitiveIndex >= 6000 ifTrue: [
+ 		| upperByte delta |
+ 		 self drop: (primitiveIndex - 4999) // 1000.
+ 		 upperByte := self method at: pc - 6.
+ 		 upperByte > 127 ifTrue: [upperByte := upperByte - 256].
+ 		 delta := upperByte << 8 + (self method at: pc - 4).
+ 		 delta < 0
+ 			ifTrue:
+ 				[(joins at: pc + delta) ~= stackp ifTrue: [(Notification new tag: #'bad join'; signal)]]
+ 			ifFalse:
+ 				[joins at: pc + delta put: stackp].
+ 		^ self ].
- 	 are from 1 to 1999, 2-arg prims from 1000 to 1999, and so on."
  	self drop: (primitiveIndex // 1000 - 1 max: 0)!

Item was added:
+ ----- Method: StackDepthFinder>>callMappedInlinePrimitive: (in category 'instruction decoding') -----
+ callMappedInlinePrimitive: primIndex
+ 	self drop: (primIndex // 50 - 1 max: 0)!

Item was removed:
- ----- Method: StackDepthFinder>>ensureAllocableSlots: (in category 'instruction decoding') -----
- ensureAllocableSlots: numSlots
- 	"nothing to do here..."!

Item was removed:
- ----- Method: StackDepthFinder>>jumpOrPop:IfNotInstanceOf: (in category 'instruction decoding') -----
- jumpOrPop: delta IfNotInstanceOf: behaviors
- 	"Conditional Jump bytecode."
- 	self doJump: delta.
- 	self drop.!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTableForSistaV1 (in category 'initialization') -----
  initializeBytecodeTableForSistaV1
  	"See e.g. the cass comment for EncoderForSistaV1"
  	"StackInterpreter initializeBytecodeTableForSistaV1"
  	"Note: This table will be used to generate a C switch statement."
  
  	initializationOptions at: #SistaV1BytecodeSet put: (SistaV1BytecodeSet := true).
  
  	BytecodeTable := Array new: 256.
  	BytecodeEncoderClassName := #EncoderForSistaV1.
  	BytecodeSetHasDirectedSuperSend := true.
  	BytecodeSetHasExtensions := true.
  	LongStoreBytecode := 245.
  	self table: BytecodeTable from:
  	#(	"1 byte bytecodes"
  		(   0  15 pushReceiverVariableBytecode)
  		( 16  31 pushLiteralVariable16CasesBytecode)
  		( 32  63 pushLiteralConstantBytecode)
  		( 64  75 pushTemporaryVariableBytecode)
  		( 76	 pushReceiverBytecode)
  		( 77	 pushConstantTrueBytecode)
  		( 78	 pushConstantFalseBytecode)
  		( 79	 pushConstantNilBytecode)
  		( 80	 pushConstantZeroBytecode)
  		( 81	 pushConstantOneBytecode)
  		( 82	 extPushPseudoVariable)
  		( 83	 duplicateTopBytecode)
  	
  		( 84 87	unknownBytecode)
  		( 88	returnReceiver)
  		( 89	returnTrue)
  		( 90	returnFalse)
  		( 91	returnNil)
  		( 92	returnTopFromMethod)
  		( 93	returnNilFromBlock)
  		( 94	returnTopFromBlock)
  		( 95	extNopBytecode)
  
  		( 96	 bytecodePrimAdd)
  		( 97	 bytecodePrimSubtract)
+ 		( 98	 bytecodePrimLessThanSistaV1) 		"for booleanCheatSistaV1:"
+ 		( 99	 bytecodePrimGreaterThanSistaV1) 	"for booleanCheatSistaV1:"
+ 		(100	 bytecodePrimLessOrEqualSistaV1) 	"for booleanCheatSistaV1:"
+ 		(101	 bytecodePrimGreaterOrEqualSistaV1) 	"for booleanCheatSistaV1:"
+ 		(102	 bytecodePrimEqualSistaV1) 			"for booleanCheatSistaV1:"
+ 		(103	 bytecodePrimNotEqualSistaV1) 		"for booleanCheatSistaV1:"
- 		( 98	 bytecodePrimLessThanSistaV1) "for booleanCheatSistaV1:"
- 		( 99	 bytecodePrimGreaterThanSistaV1) "for booleanCheatSistaV1:"
- 		(100	 bytecodePrimLessOrEqualSistaV1) "for booleanCheatSistaV1:"
- 		(101	 bytecodePrimGreaterOrEqualSistaV1) "for booleanCheatSistaV1:"
- 		(102	 bytecodePrimEqualSistaV1) "for booleanCheatSistaV1:"
- 		(103	 bytecodePrimNotEqualSistaV1) "for booleanCheatSistaV1:"
  		(104	 bytecodePrimMultiply)
  		(105	 bytecodePrimDivide)
  		(106	 bytecodePrimMod)
  		(107	 bytecodePrimMakePoint)
  		(108	 bytecodePrimBitShift)
  		(109	 bytecodePrimDiv)
  		(110	 bytecodePrimBitAnd)
  		(111	 bytecodePrimBitOr)
  
  		(112	 bytecodePrimAt)
  		(113	 bytecodePrimAtPut)
  		(114	 bytecodePrimSize)
  		(115	 bytecodePrimNext)		 "i.e. a 0 arg special selector"
  		(116	 bytecodePrimNextPut)		 "i.e. a 1 arg special selector"
  		(117	 bytecodePrimAtEnd)
  		(118	 bytecodePrimIdenticalSistaV1) "for booleanCheatSistaV1:"
  		(119	 bytecodePrimClass)
  		(120	 bytecodePrimNotIdenticalSistaV1) "was blockCopy:"
  		(121	 bytecodePrimValue)
  		(122	 bytecodePrimValueWithArg)
  		(123	 bytecodePrimDo)			"i.e. a 1 arg special selector"
  		(124	 bytecodePrimNew)			"i.e. a 0 arg special selector"
  		(125	 bytecodePrimNewWithArg)	"i.e. a 1 arg special selector"
  		(126	 bytecodePrimPointX)		"i.e. a 0 arg special selector"
  		(127	 bytecodePrimPointY)		"i.e. a 0 arg special selector"
  
  		(128 143	sendLiteralSelector0ArgsBytecode)
  		(144 159	sendLiteralSelector1ArgBytecode)
  		(160 175	sendLiteralSelector2ArgsBytecode)
  
  		(176 183	shortUnconditionalJump)
  		(184 191	shortConditionalJumpTrue)
  		(192 199	shortConditionalJumpFalse)
  	
  		(200 207	storeAndPopReceiverVariableBytecode)
  		(208 215	storeAndPopTemporaryVariableBytecode)
  		(216		popStackBytecode)
  		(217		unconditionnalTrapBytecode)
  
  		(218 223	unknownBytecode)
  
  		"2 byte bytecodes"
  		(224		extABytecode)
  		(225		extBBytecode)
  
  		(226		extPushReceiverVariableBytecode)
  		(227		extPushLiteralVariableBytecode)
  		(228		extPushLiteralBytecode)
  		(229		longPushTemporaryVariableBytecode)
  		(230		unknownBytecode)
  		(231		pushNewArrayBytecode)
  		(232		extPushIntegerBytecode)
  		(233		extPushCharacterBytecode)
  
  		(234		extSendBytecode)
  		(235		extSendSuperBytecode)
  
+ 		(236		callMappedInlinedPrimitive)
- 		(236		extEnsureAllocableSlots)
  
  		(237		extUnconditionalJump)
  		(238		extJumpIfTrue)
  		(239		extJumpIfFalse)
  
+ 		(240		extStoreAndPopReceiverVariableBytecode)
+ 		(241		extStoreAndPopLiteralVariableBytecode)
- 		(240		extSistaStoreAndPopReceiverVariableBytecode)
- 		(241		extSistaStoreAndPopLiteralVariableBytecode)
  		(242		longStoreAndPopTemporaryVariableBytecode)
  
+ 		(243		extStoreReceiverVariableBytecode)
+ 		(244		extStoreLiteralVariableBytecode)
- 		(243		extSistaStoreReceiverVariableBytecode)
- 		(244		extSistaStoreLiteralVariableBytecode)
  		(245		longStoreTemporaryVariableBytecode)
  
  		(246 247	unknownBytecode)
  
  		"3 byte bytecodes"
  		(248		callPrimitiveBytecode)
  		(249		extPushFullClosureBytecode)
  
  		(250		extPushClosureBytecode)
+ 		(251		pushRemoteTempLongBytecode)
+ 		(252		storeRemoteTempLongBytecode)
+ 		(253		storeAndPopRemoteTempLongBytecode)
- 		(251		extPushRemoteTempOrInstVarLongBytecode)
- 		(252		extStoreRemoteTempOrInstVarLongBytecode)
- 		(253		extStoreAndPopRemoteTempOrInstVarLongBytecode)
  				
+ 		(254 255	unknownBytecode)
- 		(254		extJumpIfNotInstanceOfBehaviorsBytecode)
- 
- 		(255		unknownBytecode)
  	)!

Item was added:
+ ----- Method: StackInterpreter>>binaryAtInlinePrimitive: (in category 'sista inline primitives - binary') -----
+ binaryAtInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result rec argIntAdjusted top |
+ 	rec := self internalStackValue: 1.
+ 	top := self internalStackTop.
+ 	self deny: ((objectMemory isOopForwarded: rec) or: [(objectMemory isImmediate: rec)]).
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	argIntAdjusted := (objectMemory integerValueOf: top) - 1.
+ 	self assert: argIntAdjusted >= 0.
+ 	primIndex caseOf: {
+ 		"2064	pointerAt:
+ 		Pointer object (Fixed sized or not) and not a context, Smi =>  (1-based, optimised if arg1 is a constant)"
+ 		[64]	->	[self assert: (objectMemory isPointers: rec).
+ 					 self assert: argIntAdjusted < (objectMemory numSlotsOfAny: rec).
+ 					 result := objectMemory fetchPointer: argIntAdjusted ofObject: rec.].
+ 		"2065	maybeContextPointerAt:
+ 		 Pointer object (Fixed sized or not), Smi =>  (1-based, optimised if arg1 is a constant)"
+ 		[65]	->	[ ((objectMemory isContextNonImm: rec) 
+ 						 and: [self isMarriedOrWidowedContext: rec])
+ 							ifTrue:
+ 								[self externalizeIPandSP.
+ 								 result := self externalInstVar: argIntAdjusted ofContext: rec.
+ 								 self internalizeIPandSP]
+ 					ifFalse: [result := objectMemory fetchPointer: argIntAdjusted ofObject: rec]
+ 			].
+ 		"2066	byteAt:
+ 		 byte object, Smi => 8 bits unsigned Smi (1-based, optimised if arg1 is a constant)"
+ 		[66]	->	[self assert: (objectMemory isBytes: rec).
+ 					 self assert: argIntAdjusted < (objectMemory numBytesOf: rec).
+ 					 result := objectMemory integerObjectOf: (objectMemory fetchByte: argIntAdjusted ofObject: rec)].
+ 		"2067	shortAt:
+ 		short object, Smi => 16 bits unsigned Smi (1-based, optimised if arg1 is a constant)"
+ 		[67]	->	[self assert: (objectMemory isShorts: rec).
+ 					 self assert: argIntAdjusted < (objectMemory num16BitUnitsOf: rec).
+ 					 result := objectMemory integerObjectOf: (objectMemory fetchShort16: argIntAdjusted ofObject: rec)].
+ 		"2068	wordAt:
+ 		 word object, Smi => 32 bits unsigned Smi (1-based, optimised if arg1 is a constant)."
+ 		[68]	->	[self assert: (objectMemory isWords: rec).
+ 					 self assert: argIntAdjusted < (objectMemory num32BitUnitsOf: rec).
+ 					 result := self positive32BitIntegerFor: (objectMemory fetchLong32: argIntAdjusted ofObject: rec)].
+ 		"2069	doubleWordAt:
+ 		 double word object, Smi => 64 bits unsigned Smi or LargePositiveInteger (1-based, optimised if arg1 is a constant)"
+ 		[69]	->	[self assert: (objectMemory isLong64s: rec).
+ 					 self assert: argIntAdjusted < (objectMemory num64BitUnitsOf: rec).
+ 					 result := self positive64BitIntegerFor: (objectMemory fetchLong64: argIntAdjusted ofObject: rec)].}.
+ 		self internalPop: 1; internalStackTopPut: result!

Item was added:
+ ----- Method: StackInterpreter>>binaryCompInlinePrimitive: (in category 'sista inline primitives - binary') -----
+ binaryCompInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result |
+ 	self assert: (primIndex between: 38 and: 39).
+ 	primIndex caseOf: {
+ 		"2038	rawEqualsEquals:
+ 		 not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[38]	->	[result := ((self internalStackValue: 1) = self internalStackTop).].
+ 		"2039	rawNotEqualsEquals:
+ 		 not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[39]	->	[result := ((self internalStackValue: 1) ~= self internalStackTop)].
+ 	}.
+ 	self internalPop: 1; internalStackTopPut: (objectMemory booleanObjectOf: result)!

Item was changed:
+ ----- Method: StackInterpreter>>binaryInlinePrimitive: (in category 'sista inline primitives - binary') -----
- ----- Method: StackInterpreter>>binaryInlinePrimitive: (in category 'miscellaneous bytecodes') -----
  binaryInlinePrimitive: primIndex
- 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	<option: #SistaVM>
+ 	"Bulk comments: each sub-method has its own comment with the specific case.
+ 	2000	+
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2001	-
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2002	*
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2003	/
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2004	//
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2005	\
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2006	quo:
+ 	Smi, Smi => Smi (no overflow, optimised if one operand is a constant)
+ 	2016	bitAnd:
+ 	Smi, Smi => Smi (optimised if one operand is a constant)
+ 	2017	bitOr:
+ 	Smi, Smi => Smi (optimised if one operand is a constant)
+ 	2018	bitXor:
+ 	Smi, Smi => Smi (optimised if one operand is a constant)
+ 	2019	bitShiftLeft:
+ 	Smi greater or equal to 0, Smi greater or equal to 0 => Smi (no overflow, optimised if arg1 is a constant)
+ 	2020	bitShiftRight:
+ 	Smi, Smi greater or equal to 0 => Smi (optimised if arg1 is a constant)
+ 	2032	>
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2033	<
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2034	>=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2035	<=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2036	=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2037	~=
+ 	Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2038	rawEqualsEquals:
+ 	not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2039	rawNotEqualsEquals:
+ 	not a forwarder, not a forwarder => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)
+ 	2048	rawNew:
+ 	literal which is a fixed-sized behavior, Smi => instance of receiver, fields nilled out (optimised if arg1 is a constant)
+ 	2049	rawNewNoInit:
+ 	literal which is a fixed-sized behavior, Smi => instance of receiver (Fields of returned value contain undefined data, optimised if arg1 is a constant)
+ 	2064	pointerAt:
+ 	Pointer object (Fixed sized or not) and not a context, Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2065	maybeContextPointerAt:
+ 	Pointer object (Fixed sized or not), Smi =>  (1-based, optimised if arg1 is a constant)
+ 	2066	byteAt:
+ 	byte object, Smi => 8 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2067	shortAt:
+ 	short object, Smi => 16 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2068	wordAt:
+ 	word object, Smi => 32 bits unsigned Smi (1-based, optimised if arg1 is a constant)
+ 	2069	doubleWordAt:
+ 	double word object, Smi => 64 bits unsigned Smi or LargePositiveInteger (1-based, optimised if arg1 is a constant)"
+ 	primIndex <= 6 ifTrue: [^self binarySmiArithmeticInlinePrimitive: primIndex].
+ 	primIndex < 16 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 20 ifTrue: [^self binarySmiBitInlinePrimitive: primIndex].
+ 	primIndex < 32 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 37 ifTrue: [^self binarySmiCompInlinePrimitive: primIndex].
+ 	primIndex <= 39 ifTrue: [^self binaryCompInlinePrimitive: primIndex].
+ 	primIndex < 48 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 49 ifTrue: [^self binaryNewInlinePrimitive: primIndex].
+ 	primIndex < 64 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 69 ifTrue: [^self binaryAtInlinePrimitive: primIndex].
+ 	self unknownInlinePrimitive!
- 	| result result64 |
- 	primIndex caseOf: {
- 		"2000	unchecked SmallInteger #+.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[0]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															+ (objectMemory integerValueOf: self internalStackTop)).
- 				 self internalPop: 1; internalStackTopPut: result].
- 		"2001	unchecked SmallInteger #-.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[1]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															- (objectMemory integerValueOf: self internalStackTop)).
- 				 self internalPop: 1; internalStackTopPut: result].
- 		"2002	unchecked SmallInteger #*.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[2]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															* (objectMemory integerValueOf: self internalStackTop)).
- 				 self internalPop: 1; internalStackTopPut: result].
- 		"2003	unchecked SmallInteger #/.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[3]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															/ (objectMemory integerValueOf: self internalStackTop)).
- 				 self internalPop: 1; internalStackTopPut: result].
- 		"2004	unchecked SmallInteger #//.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[4]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															// (objectMemory integerValueOf: self internalStackTop)).
- 				 self internalPop: 1; internalStackTopPut: result].
- 		"2005	unchecked SmallInteger #\\.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[5]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															\\ (objectMemory integerValueOf: self internalStackTop)).
- 				 self internalPop: 1; internalStackTopPut: result].
- 		"2006	unchecked SmallInteger #quo:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[6]	->	[| rcvr arg |
- 				 rcvr := objectMemory integerValueOf: (self internalStackValue: 1).
- 				 arg := objectMemory integerValueOf: self internalStackTop.
- 				 result := self quot: rcvr ient: arg.
- 				 self internalPop: 1; internalStackTopPut: (objectMemory integerObjectOf: result)].
- 
- 		"2016	unchecked SmallInteger #bitAnd:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[16]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															bitAnd: (objectMemory integerValueOf: self internalStackTop)).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2017	unchecked SmallInteger #bitOr:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[17]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															bitOr: (objectMemory integerValueOf: self internalStackTop)).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2018	unchecked SmallInteger #bitXor:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[18]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1))
- 															bitXor: (objectMemory integerValueOf: self internalStackTop)).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2019	unchecked SmallInteger #bitShiftLeft:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[19]	->	[result := objectMemory integerObjectOf: ((objectMemory integerValueOf: (self internalStackValue: 1)) 
- 															<< (objectMemory integerValueOf: self internalStackTop)).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2019	unchecked SmallInteger #bitShiftRight:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
- 		[20]	->	[result := objectMemory integerObjectOf: (objectMemory wordSize = 4
- 						ifTrue: [ (objectMemory integerValueOf: (self internalStackValue: 1)) >> (objectMemory integerValueOf: self internalStackTop)]
- 						ifFalse: [ (objectMemory integerValueOf: (self internalStackValue: 1)) >>> (objectMemory integerValueOf: self internalStackTop)]).
- 					 self internalPop: 1; internalStackTopPut: result].
- 
- 		"2032	unchecked SmallInteger #>.  Both arguments are SmallIntegers"
- 		[32]	->	[result := objectMemory booleanObjectOf: ((self internalStackValue: 1) > self internalStackTop).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2033	unchecked SmallInteger #<.  Both arguments are SmallIntegers"
- 		[33]	->	[result := objectMemory booleanObjectOf: ((self internalStackValue: 1) < self internalStackTop).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2034	unchecked SmallInteger #>=.  Both arguments are SmallIntegers"
- 		[34]	->	[result := objectMemory booleanObjectOf: ((self internalStackValue: 1) >= self internalStackTop).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2035	unchecked SmallInteger #<=.  Both arguments are SmallIntegers"
- 		[35]	->	[result := objectMemory booleanObjectOf: ((self internalStackValue: 1) <= self internalStackTop).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2036	unchecked SmallInteger #=.  Both arguments are SmallIntegers"
- 		[36]	->	[result := objectMemory booleanObjectOf: ((self internalStackValue: 1) = self internalStackTop).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2037	unchecked SmallInteger #~=.  Both arguments are SmallIntegers"
- 		[37]	->	[result := objectMemory booleanObjectOf: ((self internalStackValue: 1) ~= self internalStackTop).
- 					 self internalPop: 1; internalStackTopPut: result].
- 
- 		"2064	unchecked Pointer Object>>at:.		The receiver is guaranteed to be a pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger"
- 		[64]	->	[result := objectMemory
- 									fetchPointer: (objectMemory integerValueOf: self internalStackTop) - 1
- 									ofObject: (self internalStackValue: 1).
- 					 self internalPop: 1; internalStackTopPut: result].
- 		"2065	unchecked Byte Object>>at:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger."
- 		[65]	->	[result := objectMemory
- 									fetchByte: (objectMemory integerValueOf: self internalStackTop) - 1
- 									ofObject: (self internalStackValue: 1).
- 					 self internalPop: 1; internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"2066	unchecked 16-bit Word Object>>at:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger."
- 		[66]	->	[result := objectMemory
- 									fetchShort16: (objectMemory integerValueOf: self internalStackTop) - 1
- 									ofObject: (self internalStackValue: 1).
- 					 self internalPop: 1; internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"2067	unchecked 32 bit Word Object>>at:.	The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger or a LargePositiveInteger."
- 		[67]	->	[result := objectMemory
- 									fetchLong32: (objectMemory integerValueOf: self internalStackTop) - 1
- 									ofObject: (self internalStackValue: 1).
- 					 self internalPop: 1; internalStackTopPut: (self signed64BitValueOf: result)].
- 		"2068	unchecked 64 bit Word Object>>at:.		The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger or a LargePositiveInteger."
- 		[68]	->	[result64 := objectMemory
- 									fetchLong64: (objectMemory integerValueOf: self internalStackTop) - 1
- 									ofObject: (self internalStackValue: 1).
- 					 self internalPop: 1; internalStackTopPut: (self signed64BitValueOf: result)] }
- 	otherwise:
- 		[localIP := localIP - 3.
- 		 self respondToUnknownBytecode]!

Item was added:
+ ----- Method: StackInterpreter>>binaryNewInlinePrimitive: (in category 'sista inline primitives - binary') -----
+ binaryNewInlinePrimitive: primIndex
+ 	"2048	rawNew:
+ 	literal which is a variable-sized behavior, Smi => instance of receiver, fields nilled/zeroed out (optimised if arg1 is a constant)
+ 	2049	rawNewNoInit:
+ 	literal which is a variable-sized behavior, Smi => instance of receiver (Fields of returned value contain undefined data, optimised if arg1 is a constant)
+ 	
+ 	WARNING: In the interpreter version, fields are always initialized."
+ 	| classObj result size top |
+ 	self assert: (primIndex between: 48 and: 49).
+ 	top := self internalStackTop.
+ 	classObj := self internalStackValue: 1.
+ 	self assert: ((objectMemory isNonImmediate: classObj) and: [self objCouldBeClassObj: classObj]).
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	size := self positiveMachineIntegerValueOf: top.
+ 	result := objectMemory instantiateClass: classObj indexableSize: size.
+ 	self internalPop: 1; internalStackTopPut: result!

Item was added:
+ ----- Method: StackInterpreter>>binarySmiArithmeticInlinePrimitive: (in category 'sista inline primitives - binary') -----
+ binarySmiArithmeticInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result recInt argInt rcvr top |
+ 	rcvr := self internalStackValue: 1.
+ 	top := self internalStackTop.
+ 	self assert: primIndex <= 6.
+ 	self assert: (objectMemory isIntegerObject: rcvr).
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	recInt := objectMemory integerValueOf: rcvr.
+ 	argInt := objectMemory integerValueOf: top.
+ 	primIndex caseOf: {
+ 		"2000	+
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[0]	->	[result := recInt + argInt].
+ 		"2001	-
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[1]	->	[result := recInt - argInt].
+ 		"2002	*
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[2]	->	[result := recInt * argInt].
+ 		"2003	/
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[3]	->	[result := recInt / argInt].
+ 		"2004	//
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[4]	->	[result := recInt // argInt].
+ 		"2005	\
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[5]	->	[result := recInt \\ argInt].
+ 		"2006	quo:
+ 		 Smi, Smi => Smi (no overflow, optimised if one operand is a constant)"
+ 		[6]	->	[result := self quot: recInt ient: argInt].
+ 	}.
+ 	self internalPop: 1; internalStackTopPutIntegerObjectOf: result!

Item was added:
+ ----- Method: StackInterpreter>>binarySmiBitInlinePrimitive: (in category 'sista inline primitives - binary') -----
+ binarySmiBitInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result recInt argInt rcvr top |
+ 	rcvr := self internalStackValue: 1.
+ 	top := self internalStackTop.
+ 	self assert: (primIndex between: 16 and: 20).
+ 	self assert: (objectMemory isIntegerObject: rcvr).
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	recInt := objectMemory integerValueOf: rcvr.
+ 	argInt := objectMemory integerValueOf: top.
+ 	primIndex caseOf: {
+ 		"2016	bitAnd:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[16]	->	[result := recInt bitAnd: argInt].
+ 		"2017	bitOr:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[17]	->	[result := recInt bitOr: argInt].
+ 		"2018	bitXor:
+ 		 Smi, Smi => Smi (optimised if one operand is a constant)"
+ 		[18]	->	[result := recInt bitXor: argInt].
+ 		"2019	bitShiftLeft:
+ 		 Smi greater or equal to 0, Smi greater or equal to 0 => Smi (no overflow, optimised if arg1 is a constant)"
+ 		[19]	->	[self assert: recInt >= 0.
+ 					 self assert: argInt >= 0.
+ 					 result := recInt << argInt].
+ 		"2020	bitShiftRight:
+ 		 Smi, Smi greater or equal to 0 => Smi (optimised if arg1 is a constant)"
+ 		[20]	->	[self assert: argInt >= 0.
+ 					 result := recInt >> argInt].
+ 	}.
+ 	self internalPop: 1; internalStackTopPutIntegerObjectOf: result!

Item was added:
+ ----- Method: StackInterpreter>>binarySmiCompInlinePrimitive: (in category 'sista inline primitives - binary') -----
+ binarySmiCompInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result top rcvr |
+ 	self assert: (primIndex between: 32 and: 37).
+ 	rcvr := self internalStackValue: 1.
+ 	top := self internalStackTop.
+ 	self assert: (objectMemory isIntegerObject: rcvr).
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	primIndex caseOf: {
+ 		"2032	>
+ 		Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[32]	->	[result := rcvr > top].
+ 		"2033	<
+ 		Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[33]	->	[result := rcvr < top].
+ 		"2034	>=
+ 		Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[34]	->	[result := rcvr >= top].
+ 		"2035	<=
+ 		Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[35]	->	[result :=rcvr <= top].
+ 		"2036	=
+ 		Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[36]	->	[result := (rcvr = top).].
+ 		"2037	~=
+ 		Smi, Smi => Boolean (optimised if one operand is a constant, Pipelined with ifTrue:ifFalse:)"
+ 		[37]	->	[result := (rcvr ~= top)].
+ 	}.
+ 	self internalPop: 1; internalStackTopPut: (objectMemory booleanObjectOf: result)!

Item was added:
+ ----- Method: StackInterpreter>>callMappedInlinedPrimitive (in category 'sista bytecodes') -----
+ callMappedInlinedPrimitive
+ 	"SistaV1:	236		11101100	iiiiiiii		callMappedInlinedPrimitive"
+ 	| primIndex |
+ 	SistaVM
+ 		ifTrue:
+ 			[primIndex := self fetchByte.
+ 			self fetchNextBytecode.
+ 			self sistaMappedInlinePrimitive: primIndex]
+ 		ifFalse: 
+ 			[localIP := localIP - 2.
+ 			self respondToUnknownBytecode].!

Item was changed:
  ----- Method: StackInterpreter>>callPrimitiveBytecode (in category 'miscellaneous bytecodes') -----
  callPrimitiveBytecode
  	"V4:			249		11111001	i i i i i i i i	jjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjjj * 256)
  	 SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 V3/Spur:	139		10001011	i i i i i i i i	jjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
  	"Note that we simply skip a callPrimitiveBytecode at the start of a method
  	 that contains a primitive.  This because methods like Context(Part)>>reset
  	 have to be updated to skip the callPrimtiive bytecode otherwise."
  	SistaVM
  		ifTrue:
  			[| byte1 byte2 prim primSet header |
  			 byte1 := self fetchByte.
  			 byte2 := self fetchByte.
  			 self fetchNextBytecode.
  			 byte2 < 128 ifTrue:
  				[header := objectMemory methodHeaderOf: method.
  				 ((self methodHeaderHasPrimitive: header)
  				  and: [localIP asUnsignedInteger
  						= (self initialIPForHeader: header method: method) + (self sizeOfCallPrimitiveBytecode: header)]) ifTrue:
  					[^self].
  				 localIP := localIP - 3.
  				 ^self respondToUnknownBytecode].
  			 prim := byte2 - 128 << 8 + byte1.
  			 primSet := prim >> 13 bitAnd: 3.
  			 prim := prim bitAnd: 8191.
+ 			 primSet = 0 ifTrue: [^self sistaInlinePrimitive: prim].
- 			 primSet = 0 ifTrue: [
- 				
- 				 prim < 1000 ifTrue:
- 					[^self nullaryInlinePrimitive: prim].
- 
- 				 prim < 2000 ifTrue:
- 					[^self unaryInlinePrimitive: prim - 1000].
- 				
- 				 prim < 3000 ifTrue:
- 					[^self binaryInlinePrimitive: prim - 2000].
- 				
- 				 prim < 4000 ifTrue:
- 					[^self trinaryInlinePrimitive: prim - 3000].
- 
- 				 prim < 5000 ifTrue:
- 					[^self quaternaryInlinePrimitive: prim - 4000].
- 
- 				 prim < 6000 ifTrue:
- 					[^self quinaryInlinePrimitive: prim - 5000].
- 				
- 			 ].
  		
  			LowcodeVM ifTrue: [
  				primSet = 1 ifTrue: [
  					prim < 1000 ifTrue:
  						[^self lowcodeNullaryInlinePrimitive: prim].
  
  					prim < 2000 ifTrue:
  						[^self lowcodeUnaryInlinePrimitive: prim - 1000].
  				
  					prim < 3000 ifTrue:
  						[^self lowcodeBinaryInlinePrimitive: prim - 2000].
  
  					prim < 4000 ifTrue:
  						[^self lowcodeTrinaryInlinePrimitive: prim - 3000].
  				].
  			].
  		
  			localIP := localIP - 3.
  			^self respondToUnknownBytecode]
  		ifFalse:
  			[| header |
  			 header := objectMemory methodHeaderOf: method.
  			 ((self methodHeaderHasPrimitive: header)
  			  and: [localIP asInteger = (self initialIPForHeader: header method: method)])
  				ifTrue:
  					[localIP := localIP + (self sizeOfCallPrimitiveBytecode: header) - 1.
  					 ^self fetchNextBytecode]
  				ifFalse:
  					[^self respondToUnknownBytecode]]!

Item was removed:
- ----- Method: StackInterpreter>>extEnsureAllocableSlots (in category 'miscellaneous bytecodes') -----
- extEnsureAllocableSlots
- 	"SistaV1		*	236		11101100	iiiiiiii		Ensure Allocable Slots (+ Extend A * 256)"
- 	| slots ok |
- 	slots := (extA bitShift: 8) + self fetchByte.
- 	self fetchNextBytecode.
- 	extA := 0.
- 	ok := objectMemory checkForAvailableSlots: slots.
- 	ok ifFalse:
- 		[self externalizeIPandSP.
- 		 self checkForEventsMayContextSwitch: true.
- 		 self browserPluginReturnIfNeeded.
- 		 self internalizeIPandSP]!

Item was removed:
- ----- Method: StackInterpreter>>extJumpIfNotInstanceOfBehaviorsBytecode (in category 'sista bytecodes') -----
- extJumpIfNotInstanceOfBehaviorsBytecode
- 	"254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B between: 0 and: 127)
- 	 254		11111110	kkkkkkkk	jjjjjjjj		branch If Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B - 128 * 256, where Extend B between: 128 and: 255)"
- 	| tosClassTag literal distance inverse |
- 	SistaVM ifFalse: [^self respondToUnknownBytecode].
- 	self assert: ((extB bitAnd: 128) = 0 or: [extB < 0]).
- 	(inverse := extB < 0) ifTrue:
- 		[extB := extB + 128].
- 	tosClassTag := objectMemory fetchClassTagOf: self internalPopStack.
- 	literal := self literal: extA << 8 + self fetchByte.
- 	distance := extB << 8 + self fetchByte.
- 	extA := extB := numExtB := 0.
- 
- 	(objectMemory isArrayNonImm: literal) ifTrue:
- 		[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do:
- 			[:i |
- 			 tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal)) ifTrue:
- 				[inverse ifTrue: [ localIP := localIP + distance ].
- 				 ^self fetchNextBytecode ] ].
- 		 inverse ifFalse: [localIP := localIP + distance].
- 		 ^self fetchNextBytecode].
- 
- 	tosClassTag = (objectMemory rawClassTagForClass: literal) = inverse ifTrue:
- 		[localIP := localIP + distance].
- 	self fetchNextBytecode!

Item was removed:
- ----- Method: StackInterpreter>>extPushRemoteTempOrInstVarLongBytecode (in category 'stack bytecodes') -----
- extPushRemoteTempOrInstVarLongBytecode
- 	| slotIndex tempIndex object |
- 	slotIndex := self fetchByte.
- 	tempIndex := self fetchByte.
- 	self fetchNextBytecode.
- 	(tempIndex noMask: self remoteIsInstVarAccess)
- 		ifTrue: [self pushRemoteTemp: slotIndex inVectorAt: tempIndex]
- 		ifFalse: 
- 			[ slotIndex := slotIndex + (extA << 8).
- 			tempIndex := tempIndex - self remoteIsInstVarAccess.
- 			numExtB := extA := extB := 0.
- 			object := self temporary: tempIndex in: localFP.
- 			self pushMaybeContext: object receiverVariable: slotIndex ]!

Item was removed:
- ----- Method: StackInterpreter>>extSistaStoreAndPopLiteralVariableBytecode (in category 'stack bytecodes') -----
- extSistaStoreAndPopLiteralVariableBytecode
- 	"236		11101100	i i i i i i i i	Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
- 	(3) ExtB lowest bit implies no store check is needed, ExtB next bit implies the object may be a context, other bits in the extension are unused."
- 	| variableIndex value |
- 	variableIndex := self fetchByte + (extA << 8).
- 	value := self internalStackTop.
- 	self internalPop: 1.
- 	extA := numExtB := extB := 0.
- 	self storeLiteralVariable: variableIndex withValue: value.
- 	self fetchNextBytecode.!

Item was removed:
- ----- Method: StackInterpreter>>extSistaStoreAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
- extSistaStoreAndPopReceiverVariableBytecode
- 	"235		11101011	i i i i i i i i	Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
- 	(3) ExtB lowest bit implies no store check is needed, ExtB next bit implies the object may be a context, other bits in the extension are unused."
- 	| variableIndex value |
- 	variableIndex := self fetchByte + (extA << 8).
- 	extA := numExtB := extB := 0.
- 	value := self internalStackTop.
- 	self internalPop: 1.
- 	self storeMaybeContextReceiverVariable: variableIndex withValue: value.
- 	self fetchNextBytecode.!

Item was removed:
- ----- Method: StackInterpreter>>extSistaStoreLiteralVariableBytecode (in category 'stack bytecodes') -----
- extSistaStoreLiteralVariableBytecode
- 	"233		11101001	i i i i i i i i	Store Literal Variable #iiiiiiii (+ Extend A * 256)
- 	(3) ExtB lowest bit implies no store check is needed, ExtB next bit implies the object may be a context, other bits in the extension are unused."
- 	| variableIndex |
- 	variableIndex := self fetchByte + (extA << 8).
- 	extA := numExtB := extB := 0.
- 	self storeLiteralVariable: variableIndex withValue: self internalStackTop.
- 	self fetchNextBytecode.!

Item was removed:
- ----- Method: StackInterpreter>>extSistaStoreReceiverVariableBytecode (in category 'stack bytecodes') -----
- extSistaStoreReceiverVariableBytecode
- 	"232		11101000	i i i i i i i i	Store Receiver Variable #iiiiiii (+ Extend A * 256)
- 	(3) ExtB lowest bit implies no store check is needed, ExtB next bit implies the object may be a context, other bits in the extension are unused."
- 	| variableIndex |
- 	variableIndex := self fetchByte + (extA << 8).
- 	extA := numExtB := extB := 0.
- 	self storeMaybeContextReceiverVariable: variableIndex withValue: self internalStackTop.
- 	self fetchNextBytecode.!

Item was removed:
- ----- Method: StackInterpreter>>extStoreAndPopRemoteTempOrInstVarLongBytecode (in category 'stack bytecodes') -----
- extStoreAndPopRemoteTempOrInstVarLongBytecode
- 	self extStoreRemoteTempOrInstVarLongBytecode.
- 	self internalPop: 1!

Item was removed:
- ----- Method: StackInterpreter>>extStoreRemoteTempOrInstVarLongBytecode (in category 'stack bytecodes') -----
- extStoreRemoteTempOrInstVarLongBytecode
- 	<inline: true>
- 	| slotIndex tempIndex object |
- 	slotIndex := self fetchByte.
- 	tempIndex := self fetchByte.
- 	self fetchNextBytecode.
- 	(tempIndex noMask: self remoteIsInstVarAccess)
- 		ifTrue: [self storeRemoteTemp: slotIndex inVectorAt: tempIndex]
- 		ifFalse: 
- 			[ slotIndex := slotIndex + (extA << 8).
- 			tempIndex := tempIndex - self remoteIsInstVarAccess.
- 			extA := numExtB := extB := 0.
- 			object := self temporary: tempIndex in: localFP.
- 			self storeMaybeContext: object receiverVariable: slotIndex withValue: self internalStackTop ]!

Item was changed:
  ----- Method: StackInterpreter>>internalStackTop (in category 'internal interpreter access') -----
  internalStackTop
- 
  	^stackPages longAtPointer: localSP!

Item was added:
+ ----- Method: StackInterpreter>>internalStackTopPutIntegerObjectOf: (in category 'internal interpreter access') -----
+ internalStackTopPutIntegerObjectOf: aValue
+ 	
+ 	^self internalStackTopPut: (objectMemory integerObjectOf: aValue)!

Item was added:
+ ----- Method: StackInterpreter>>jumpBinaryInlinePrimitive: (in category 'sista bytecodes') -----
+ jumpBinaryInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| test offset top |
+ 	top := self internalStackTop.
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	offset := objectMemory integerValueOf: top.
+ 	test := self internalStackValue: 1.
+ 	self assert: offset >= 0.
+ 	primIndex caseOf: {
+ 		"7016	jumpIfWritable:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[16]	->	[self deny: (objectMemory isOopForwarded: test).
+ 					 self deny: (objectMemory isImmediate: test).
+ 					 (objectMemory isImmutable: test) ifFalse: [localIP := localIP + offset]].
+ 		"7017	jumpIfReadOnly:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[17]	->	[self deny: (objectMemory isOopForwarded: test).
+ 					 self deny: (objectMemory isImmediate: test).
+ 					 (objectMemory isImmutable: test) ifTrue: [localIP := localIP + offset]].
+ 		"7018	jumpIfYoung:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[18]	->	[self deny: (objectMemory isOopForwarded: test).
+ 					 self deny: (objectMemory isImmediate: test).
+ 					 (objectMemory isYoungObject: test) ifTrue: [localIP := localIP + offset]].
+ 		"7019	jumpIfOld:
+ 		 Not a forwarder, literal which is a Smi"
+ 		[19]	->	[self deny: (objectMemory isOopForwarded: test).
+ 					 self deny: (objectMemory isImmediate: test).
+ 					 (objectMemory isYoungObject: test) ifFalse: [localIP := localIP + offset]].
+ 	}.
+ 	localIP := localIP - 1. "we've already fetched, but we may have incorrectly fetched if jump"
+ 	self fetchNextBytecode.
+ 	self internalPop: 2.
+ 	!

Item was added:
+ ----- Method: StackInterpreter>>jumpTrinaryInlinePrimitive: (in category 'sista bytecodes') -----
+ jumpTrinaryInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	"Note: those tests work with forwarders (wrong class index)"
+ 	| test classObj offset classTag top |
+ 	top := self internalStackTop.
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	offset := objectMemory integerValueOf: top.
+ 	self assert: offset >= 0.
+ 	test := self internalStackValue: 2.
+ 	classObj := self internalStackValue: 1.
+ 	self assert: (objectMemory isNonImmediate: classObj).
+ 	primIndex caseOf: {
+ 	[0] -> 	["8000	jumpIfInstanceOf:distance:
+ 			 Anything, literal which is a Behavior, literal which is a Smi"
+ 			 self assert: (self objCouldBeClassObj: classObj).
+ 			 classTag := objectMemory fetchClassTagOf: test.
+ 			 classTag = (objectMemory rawClassTagForClass: classObj) ifTrue: 
+ 				[localIP := localIP + offset]].
+ 	[1] -> 	["8001	jumpIfNotInstanceOf:distance:
+ 			 Anything, literal which is a Behavior, literal which is a Smi"
+ 			 self assert: (self objCouldBeClassObj: classObj).
+ 			 classTag := objectMemory fetchClassTagOf: test.
+ 			 classTag = (objectMemory rawClassTagForClass: classObj) ifFalse: 
+ 				[localIP := localIP + offset]].
+ 	[2] -> 	["8002	jumpIfInstanceOfOneOf:distance:
+ 			 Anything, Array of behaviors, literal which is a Smi"
+ 			 self assert: (objectMemory isArrayNonImm: classObj).
+ 			 classTag := objectMemory fetchClassTagOf: test.
+ 			0 to: (objectMemory numSlotsOf: classObj) asInteger - 1 do:
+ 			[:i |
+ 			 classTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: classObj)) ifTrue:
+ 				[localIP := localIP + offset]]].
+ 	[3] -> 	["8003	jumpIfNotInstanceOfOneOf:distance:
+ 			  Anything, Array of behaviors, literal which is a Smi"
+ 			 self assert: (objectMemory isArrayNonImm: classObj).
+ 			 classTag := objectMemory fetchClassTagOf: test.
+ 			0 to: (objectMemory numSlotsOf: classObj) asInteger - 1 do:
+ 			[:i |
+ 			 classTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: classObj)) ifTrue:
+ 				[localIP := localIP - 1.
+ 				 self fetchNextBytecode.
+ 				 ^self internalPop: 3]].
+ 			localIP := localIP + offset].
+ 	}.
+ 	localIP := localIP - 1. "we've already fetched, but we may have incorrectly fetched if jump"
+ 	self fetchNextBytecode.
+ 	self internalPop: 3
+ 	!

Item was added:
+ ----- Method: StackInterpreter>>jumpUnaryInlinePrimitive: (in category 'sista bytecodes') -----
+ jumpUnaryInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	"6000	backjumpNoInterrupt
+ 	 literal which is a Smi"
+ 	| top |
+ 	top := self internalStackTop.
+ 	primIndex = 0 ifTrue: 
+ 		[self assert: (objectMemory isIntegerObject: top). 
+ 		 self assert: (objectMemory integerValueOf: top) < 0.
+ 		"We've already fetched next bytecode, so we add -1"
+ 		 localIP := localIP + (objectMemory integerValueOf: top) - 1. 
+ 		 self fetchNextBytecode.
+ 		 ^self internalPop: 1].
+ 	^ self unknownInlinePrimitive	!

Item was added:
+ ----- Method: StackInterpreter>>mappedBackjumpAlwaysInterrupt (in category 'sista bytecodes') -----
+ mappedBackjumpAlwaysInterrupt
+ 	| top offset |
+ 	top := self internalStackTop.
+ 	self assert: (objectMemory isIntegerObject: top).
+ 	offset := objectMemory integerObjectOf: top.
+ 	localIP := localIP - offset.
+ 	self internalPop: 1.
+ 	"+1 since this instr is 3 bytes not 2"
+ 	self ifBackwardsCheckForEvents: 0 - offset + 1. 
+ 	localIP := localIP - 1.
+ 	self fetchNextBytecode!

Item was added:
+ ----- Method: StackInterpreter>>mappedDirectCall (in category 'sista bytecodes') -----
+ mappedDirectCall
+ 	"250	directCall
+ 	literal index of the method to call on top of stack =>  (variable number of parameters)"
+ 	|methodHeader localPrimIndex methodIndex|
+ 	methodIndex := self internalPopStack. "Can't write this inside next line for Slang inliner"
+ 	newMethod := self literal: (objectMemory integerValueOf: methodIndex).
+ 	self assert: (objectMemory isCompiledMethod: newMethod).
+ 	methodHeader := objectMemory methodHeaderOf: newMethod.
+ 	localPrimIndex := self primitiveIndexOfMethod: newMethod header: methodHeader.
+ 	argumentCount := self argumentCountOfMethodHeader: methodHeader.
+ 	"The primitive function pointer is not cached in the interpreter, but it's called quickly in the JIT"
+ 	primitiveFunctionPointer := self functionPointerFor: localPrimIndex inClass: objectMemory nilObject..
+ 	self internalActivateNewMethod!

Item was added:
+ ----- Method: StackInterpreter>>mappedEnsureEnoughWords (in category 'sista bytecodes') -----
+ mappedEnsureEnoughWords
+ 	"50	EnsureEnoughWords
+ 	 literal which is a Smi => ret value is receiver"
+ 	 | slots ok top |
+ 	 top := self internalStackTop.
+ 	 self assert: (objectMemory isIntegerObject: top).
+ 	 slots := objectMemory integerValueOf: top.
+ 	 self assert: slots >= 0.
+ 	 ok := objectMemory checkForAvailableSlots: slots.
+ 	 ok ifFalse:
+ 		[self externalizeIPandSP.
+ 		 self checkForEventsMayContextSwitch: true.
+ 		 self browserPluginReturnIfNeeded.
+ 		 self internalizeIPandSP]!

Item was added:
+ ----- Method: StackInterpreter>>mappedImmcheckDataAtPut: (in category 'sista bytecodes') -----
+ mappedImmcheckDataAtPut: primIndex
+ 	<option: #SistaVM>
+ 	| argIntAdjusted rec result arg1 |
+ 	self assert: (primIndex between: 154 and: 157).
+ 	arg1 := self internalStackValue: 1.
+ 	rec := self internalStackValue: 2.
+ 	self deny: ((objectMemory isOopForwarded: rec) or: [(objectMemory isImmediate: rec)]).
+ 	self assert: (objectMemory isIntegerObject: arg1).
+ 	argIntAdjusted := (objectMemory integerValueOf: arg1) - 1.
+ 	self assert: argIntAdjusted >= 0.
+ 	result := self internalStackTop.
+ 	self internalPop: 2; internalStackTopPut: result.
+ 	(objectMemory isImmutable: rec) ifTrue: [^self cannotAssign: result to: rec withIndex: argIntAdjusted].
+ 	
+ 	primIndex caseOf: {
+ 		"154	immCheckByteAt:put:
+ 		byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[154]	->	[self assert: (objectMemory isBytes: rec).
+ 				 self assert: argIntAdjusted < (objectMemory numBytesOf: rec).
+ 				 self assert: (objectMemory isIntegerObject: result).
+ 				 objectMemory
+ 					storeByte: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory integerValueOf: result)].
+ 		"155	immCheckShortAt:put:
+ 		short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[155]	->	[self assert: (objectMemory isShorts: rec).
+ 				 self assert: argIntAdjusted < (objectMemory num16BitUnitsOf: rec).
+ 				 self assert: (objectMemory isIntegerObject: result).
+ 				 objectMemory
+ 					storeShort16: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory integerValueOf: result)].
+ 		"156	immCheckWordAt:put:
+ 		word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[156]	->	[self assert: (objectMemory isWords: rec).
+ 				 self assert: argIntAdjusted < (objectMemory num32BitUnitsOf: rec).
+ 				 objectMemory
+ 					storeLong32: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory positive32BitValueOf: result)].
+ 		"157	immCheckDoubleWordAt:put:
+ 		double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[157]	->	[self assert: (objectMemory isLong64s: rec).
+ 				 self assert: argIntAdjusted < (objectMemory num64BitUnitsOf: rec).
+ 				 objectMemory
+ 					storeLong64: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory positive64BitValueOf: result)]}.
+ 		!

Item was added:
+ ----- Method: StackInterpreter>>mappedImmcheckMaybeContextStoreCheckPointerAtPut (in category 'sista bytecodes') -----
+ mappedImmcheckMaybeContextStoreCheckPointerAtPut
+ 	"153	immCheckMaybeContextStoreCheckPointerAt:put:
+ 	 pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 	|rec argIntAdjusted result arg1|
+ 	rec := self internalStackValue: 2.
+ 	arg1 := self internalStackValue: 1.
+ 	self assert: (objectMemory isIntegerObject: arg1).
+ 	argIntAdjusted := (objectMemory integerValueOf: arg1) - 1.
+ 	result := self internalStackTop.
+ 	self internalPop: 3.
+ 	self internalPush: result.
+ 	(self isWriteMediatedContextInstVarIndex: argIntAdjusted) 
+ 						ifFalse: [objectMemory storePointerImmutabilityCheck: argIntAdjusted ofObject: rec withValue: result]
+ 						ifTrue: [self externalizeIPandSP.
+ 								self externalInstVar: argIntAdjusted ofContext: rec  put: result.
+ 								self internalizeIPandSP]!

Item was added:
+ ----- Method: StackInterpreter>>mappedImmcheckStoreCheckPointerAtPut (in category 'sista bytecodes') -----
+ mappedImmcheckStoreCheckPointerAtPut
+ 	"151	immCheckStoreCheckPointerAt:put:
+ 	 pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 	|rec argIntAdjusted result arg1|
+ 	rec := self internalStackValue: 2.
+ 	arg1 := self internalStackValue: 1.
+ 	self assert: (objectMemory isPointers: rec).
+ 	self assert: (objectMemory isIntegerObject: arg1).
+ 	argIntAdjusted := (objectMemory integerValueOf: arg1) - 1.
+ 	self assert: argIntAdjusted >= 0.
+ 	self assert: argIntAdjusted < (objectMemory numSlotsOfAny: rec).
+ 	result := self internalStackTop.
+ 	self internalPop: 3.
+ 	self internalPush: result.
+ 	objectMemory
+ 		storePointerImmutabilityCheck: argIntAdjusted
+ 		ofObject: rec
+ 		withValue: result!

Item was changed:
+ ----- Method: StackInterpreter>>nullaryInlinePrimitive: (in category 'sista bytecodes') -----
- ----- Method: StackInterpreter>>nullaryInlinePrimitive: (in category 'miscellaneous bytecodes') -----
  nullaryInlinePrimitive: primIndex
- 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	<option: #SistaVM>
+ 	self unknownInlinePrimitive!
- 	localIP := localIP - 3.
- 	self respondToUnknownBytecode!

Item was changed:
+ ----- Method: StackInterpreter>>quaternaryInlinePrimitive: (in category 'sista bytecodes') -----
- ----- Method: StackInterpreter>>quaternaryInlinePrimitive: (in category 'miscellaneous bytecodes') -----
  quaternaryInlinePrimitive: primIndex
- 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	<option: #SistaVM>
+ 	self unknownInlinePrimitive!
- 	self respondToUnknownBytecode!

Item was changed:
+ ----- Method: StackInterpreter>>quinaryInlinePrimitive: (in category 'sista bytecodes') -----
- ----- Method: StackInterpreter>>quinaryInlinePrimitive: (in category 'miscellaneous bytecodes') -----
  quinaryInlinePrimitive: primIndex
- 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	| src srcIndex dest destIndex destLimit oop |
  	<option: #SistaVM>
+ 	"0 is deprecated, now this can be handled at Scorch level"
+ 	primIndex = 0 ifTrue: "Array copy, pointer variable object with no inst vars"
+ 		[dest := self internalStackValue: 4.
+ 		destIndex := (objectMemory integerValueOf: (self internalStackValue: 3)) - 1.
+ 		destLimit := (objectMemory integerValueOf: (self internalStackValue: 2)) - 1.
+ 		src := self internalStackValue: 1.
+ 		srcIndex := (objectMemory integerValueOf: (self internalStackValue: 0)) - 1.
+ 		self internalPop: 4.
+ 		destLimit < destIndex ifTrue: [^self].
+ 		(objectMemory isYoung: dest) ifFalse: [objectMemory possibleRootStoreInto: dest].
+ 		0 to: destLimit - destIndex do: 
+ 			[:i| oop := objectMemory fetchPointer: srcIndex + i ofObject: src.
+ 			    objectMemory storePointerUnchecked: destIndex + i ofObject: dest withValue: oop].
+ 		^ self].
+ 	self unknownInlinePrimitive!
- 	primIndex = 0 ifFalse: [self respondToUnknownBytecode].
- 	dest := self internalStackValue: 4.
- 	destIndex := (objectMemory integerValueOf: (self internalStackValue: 3)) - 1.
- 	destLimit := (objectMemory integerValueOf: (self internalStackValue: 2)) - 1.
- 	src := self internalStackValue: 1.
- 	srcIndex := (objectMemory integerValueOf: (self internalStackValue: 0)) - 1.
- 	self internalPop: 4.
- 	destLimit < destIndex ifTrue: [^self].
- 	(objectMemory isYoung: dest) ifFalse: [objectMemory possibleRootStoreInto: dest].
- 	0 to: destLimit - destIndex do: [:i |
- 		oop := objectMemory fetchPointer: srcIndex + i ofObject: src.
- 		objectMemory storePointerUnchecked: destIndex + i ofObject: dest withValue: oop ].
- 	!

Item was added:
+ ----- Method: StackInterpreter>>sistaInlinePrimitive: (in category 'sista bytecodes') -----
+ sistaInlinePrimitive: prim
+ 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution. This is the dispatch for unmapped sista inlined primitives."
+ 	<option: #SistaVM>
+ 	
+ 	 prim < 1000 ifTrue:
+ 		[^self nullaryInlinePrimitive: prim].
+ 
+ 	 prim < 2000 ifTrue:
+ 		[^self unaryInlinePrimitive: prim - 1000].
+ 
+ 	 prim < 3000 ifTrue:
+ 		[^self binaryInlinePrimitive: prim - 2000].
+ 
+ 	 prim < 4000 ifTrue:
+ 		[^self trinaryInlinePrimitive: prim - 3000].
+ 
+ 	 prim < 5000 ifTrue:
+ 		[^self quaternaryInlinePrimitive: prim - 4000].
+ 
+ 	 prim < 6000 ifTrue:
+ 		[^self quinaryInlinePrimitive: prim - 5000].
+ 	
+ 	 prim < 7000 ifTrue:
+ 		[^self jumpUnaryInlinePrimitive: prim - 6000].
+ 	
+  	prim < 8000 ifTrue:
+ 		[^self jumpBinaryInlinePrimitive: prim - 7000].
+ 	
+ 	^ self jumpTrinaryInlinePrimitive: prim - 8000.!

Item was added:
+ ----- Method: StackInterpreter>>sistaMappedInlinePrimitive: (in category 'sista bytecodes') -----
+ sistaMappedInlinePrimitive: primIndex
+ 	"SistaV1:	236		11101100	iiiiiiii		callMappedInlinedPrimitive"
+ 	"Number of arguments:
+ 	 0-49 nullary
+ 	 50-99 unary
+ 	 100-149  binary
+ 	 150-199 trinary
+ 	 200-249 variable
+ 	 250-255 mapped jumps"
+ 	"Specification:
+ 	50	EnsureEnoughWords
+ 	literal which is a Smi => ret value is receiver
+ 	150	immCheckPointerAt:put:
+ 	pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	151	immCheckStoreCheckPointerAt:put:
+ 	pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	152	immCheckMaybeContextPointerAt:put:
+ 	pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	153	immCheckMaybeContextStoreCheckPointerAt:put:
+ 	pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	154	immcheckByteAt:put:
+ 	byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	155	immCheckShortAt:put:
+ 	short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	156	immCheckWordAt:put:
+ 	word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	157	immCheckDoubleWordAt:put:
+ 	double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)
+ 	200	directCall
+ 	method to call on top of stack =>  (variable number of parameters)
+ 	250 	backjumpAlwaysInterrupt
+ 	literal which is a Smi"
+ 	<option: #SistaVM>
+ 	(primIndex between: 154 and: 157) ifTrue: [^self mappedImmcheckDataAtPut: primIndex].
+ 	primIndex caseOf: {
+ 		[50]	->	[self mappedEnsureEnoughWords].
+ 		[150]	->	["150	immCheckPointerAt:put:
+ 		 			 pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 					"We could ignore the store check but we don't care in the interpreter"
+ 					self mappedImmcheckStoreCheckPointerAtPut].
+ 		[151]	->	[self mappedImmcheckStoreCheckPointerAtPut].
+ 		[152]	->	["152	immCheckMaybeContextPointerAt:put:
+ 					 pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 					 "We could ignore the store check but we don't care in the interpreter"
+ 					 self mappedImmcheckMaybeContextStoreCheckPointerAtPut].
+ 		[153]	->	[self mappedImmcheckMaybeContextStoreCheckPointerAtPut].
+ 		[200] 	->	[self mappedDirectCall].
+ 		[250] 	->	[self mappedBackjumpAlwaysInterrupt].
+ 	} otherwise: [self unknownInlinePrimitive]
+ 	
+ !

Item was added:
+ ----- Method: StackInterpreter>>trinaryAtPutInlinePrimitive: (in category 'sista bytecodes') -----
+ trinaryAtPutInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result rec argIntAdjusted arg1|
+ 	arg1 := self internalStackValue: 1.
+ 	rec := self internalStackValue: 2.
+ 	self deny: ((objectMemory isOopForwarded: rec) or: [(objectMemory isImmediate: rec)]).
+ 	self assert: (objectMemory isIntegerObject: arg1).
+ 	argIntAdjusted := (objectMemory integerValueOf: arg1) - 1.
+ 	self assert: argIntAdjusted >= 0.
+ 	result := self internalStackTop.
+ 	
+ 	primIndex caseOf: {
+ 		"3000	pointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[0]	->	[self assert: (objectMemory isPointers: rec).
+ 				 self assert: argIntAdjusted < (objectMemory numSlotsOfAny: rec).
+ 				 objectMemory
+ 					storePointerUnchecked: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: result.].
+ 		"3001	storeCheckPointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[1]	->	[self assert: (objectMemory isPointers: rec).
+ 				 self assert: argIntAdjusted < (objectMemory numSlotsOfAny: rec).
+ 				 objectMemory
+ 					storePointer: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: result].
+ 		"3002	maybeContextPointerAt:put:
+ 		 Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[2]	->	[((objectMemory isContextNonImm: rec) 
+ 				 and: [self isMarriedOrWidowedContext: rec])
+ 					ifTrue:
+ 						[self externalizeIPandSP.
+ 						 self externalInstVar: argIntAdjusted ofContext: rec  put: result.
+ 						 self internalizeIPandSP]
+ 					ifFalse: [objectMemory storePointer: argIntAdjusted ofObject: rec withValue: result]].
+ 		"3003	maybeContextStoreCheckPointerAt:put:
+ 		Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[3]	->	[((objectMemory isContextNonImm: rec) 
+ 				 and: [self isMarriedOrWidowedContext: rec])
+ 					ifTrue:
+ 						[self externalizeIPandSP.
+ 						 self externalInstVar: argIntAdjusted ofContext: rec  put: result.
+ 						 self internalizeIPandSP]
+ 					ifFalse: [objectMemory storePointer: argIntAdjusted ofObject: rec withValue: result]].
+ 		"3004	byteAt:put:
+ 		Mutable byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[4]	->	[self assert: (objectMemory isBytes: rec).
+ 				 self assert: argIntAdjusted < (objectMemory numBytesOf: rec).
+ 				 self assert: (objectMemory isIntegerObject: result).
+ 				 objectMemory
+ 					storeByte: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory integerValueOf: result).].
+ 		"3005	shortAt:put:
+ 		 Mutable short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[5]	->	[self assert: (objectMemory isShorts: rec).
+ 				 self assert: argIntAdjusted < (objectMemory num16BitUnitsOf: rec).
+ 				 self assert: (objectMemory isIntegerObject: result).
+ 				 objectMemory
+ 					storeShort16: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory integerValueOf: result).].
+ 		"3006	wordAt:put:
+ 		 Mutable word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[6]	->	[self assert: (objectMemory isWords: rec).
+ 				 self assert: argIntAdjusted < (objectMemory num32BitUnitsOf: rec).
+ 				 objectMemory
+ 					storeLong32: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory positive32BitValueOf: result).].
+ 		"3007	doubleWordAt:put:
+ 		 Mutable double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)"
+ 		[7]	->	[self assert: (objectMemory isLong64s: rec).
+ 				 self assert: argIntAdjusted < (objectMemory num64BitUnitsOf: rec).
+ 				 objectMemory
+ 					storeLong64: argIntAdjusted
+ 					ofObject: rec
+ 					withValue: (objectMemory positive64BitValueOf: result).].
+ 	}.
+ 	 self internalPop: 2; internalStackTopPut: result!

Item was changed:
+ ----- Method: StackInterpreter>>trinaryInlinePrimitive: (in category 'sista bytecodes') -----
- ----- Method: StackInterpreter>>trinaryInlinePrimitive: (in category 'miscellaneous bytecodes') -----
  trinaryInlinePrimitive: primIndex
- 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	<option: #SistaVM>
+ 	"Bulk comment, each sub method has its own comment
+ 	3000	pointerAt:put:
+ 	Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3001	storeCheckPointerAt:put:
+ 	Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3002	maybeContextPointerAt:put:
+ 	Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3003	maybeContextStoreCheckPointerAt:put:
+ 	Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)
+ 	3004	byteAt:put:
+ 	Mutable byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	3005	shortAt:put:
+ 	Mutable short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	3006	wordAt:put:
+ 	Mutable word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)
+ 	3007	doubleWordAt:put:
+ 	Mutable double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)
+ 	3021 is deprecated."
+ 	primIndex <= 7 ifTrue: [^self trinaryAtPutInlinePrimitive: primIndex].
+ 	"21 is deprecated, now this can be handled at Scorch level"
+ 	primIndex = 21 ifTrue: 
+ 		[ | str1 str2 word1 word2 len |
+ 		  len := objectMemory integerValueOf: self internalStackTop.
+ 		  len = 0 ifTrue: [^self internalPop: 2; internalStackTopPut: objectMemory trueObject].
+ 		  str1 := self internalStackValue: 2.
- 	| result |
- 	primIndex caseOf: {
- 
- 		"3000	unchecked Pointer Object>>at:put:.			The receiver is guaranteed to be a pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger"
- 		[0]	->	[result := self internalStackTop.
- 				 objectMemory
- 					storePointer: (objectMemory integerValueOf: (self internalStackValue: 1)) - 1
- 					ofObject: (self internalStackValue: 2)
- 					withValue: result.
- 				 self internalPop: 2; internalStackTopPut: result].
- 		"3001	unchecked Byte Object>>at:put:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 8 bits."
- 		[1]	->	[result := self internalStackTop.
- 				 objectMemory
- 					storeByte: (objectMemory integerValueOf: (self internalStackValue: 1)) - 1
- 					ofObject: (self internalStackValue: 2)
- 					withValue: (objectMemory integerValueOf: result).
- 				 self internalPop: 2; internalStackTopPut: result].
- 		"3002	unchecked Word Object>>at:put:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 16 bits."
- 		[2]	->	[result := self internalStackTop.
- 				 objectMemory
- 					storeShort16: (objectMemory integerValueOf: (self internalStackValue: 1)) - 1
- 					ofObject: (self internalStackValue: 2)
- 					withValue: (objectMemory integerValueOf: result).
- 				 self internalPop: 2; internalStackTopPut: result].
- 		"3003	unchecked DoubleWord Object>>at:put:.	The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 32 bits."
- 		[3]	->	[result := self internalStackTop.
- 				 objectMemory
- 					storeLong32: (objectMemory integerValueOf: (self internalStackValue: 1)) - 1
- 					ofObject: (self internalStackValue: 2)
- 					withValue: (objectMemory integerValueOf: result).
- 				 self internalPop: 2; internalStackTopPut: result].
- 		"3004	unchecked QuadWord Object>>at:put:.		The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 64 bits."
- 		[4]	->	[result := self internalStackTop.
- 				 objectMemory
- 					storeLong64: (objectMemory integerValueOf: (self internalStackValue: 1)) - 1
- 					ofObject: (self internalStackValue: 2)
- 					withValue: (objectMemory integerValueOf: result).
- 				 self internalPop: 2; internalStackTopPut: result].
- 		"3021	Byte Object >> equals:length:	
- 				The receiver and the arguments are both byte objects and have both the same size (length in bytes). 
- 				The length argument is a smallinteger. 
- 				Answers true if all fields are equal, false if not. 
- 				Comparison is bulked to word comparison."
- 		[21]	->	[ | str1 str2 word1 word2 len |
- 					  len := objectMemory integerValueOf: self internalStackTop.
- 					  len = 0 ifTrue: [^self internalPop: 2; internalStackTopPut: objectMemory trueObject].
- 					  str1 := self internalStackValue: 2.
    					  str2 := self internalStackValue: 1.
+ 		  0 to: len - 1 >> objectMemory shiftForWord do: [:i |
+ 			word1 := objectMemory fetchPointer: i ofObject: str1.
+ 			word2 := objectMemory fetchPointer: i ofObject: str2. 
+ 			word1 = word2 ifFalse: [^self internalPop: 2; internalStackTopPut: objectMemory falseObject] ].
+ 		 ^self internalPop: 2; internalStackTopPut: objectMemory trueObject ].
+ 	self unknownInlinePrimitive!
- 					  0 to: len - 1 >> objectMemory shiftForWord do: [:i |
- 						word1 := objectMemory fetchPointer: i ofObject: str1.
- 						word2 := objectMemory fetchPointer: i ofObject: str2. 
- 						word1 = word2 ifFalse: [^self internalPop: 2; internalStackTopPut: objectMemory falseObject] ].
- 					 self internalPop: 2; internalStackTopPut: objectMemory trueObject ] }
- 	otherwise:
- 		[localIP := localIP - 3.
- 		 self respondToUnknownBytecode]!

Item was added:
+ ----- Method: StackInterpreter>>unaryClassPrimitive (in category 'sista inline primitives - unary') -----
+ unaryClassPrimitive
+ 	| result top |
+ 	"1000	rawClass
+ 	 not a forwarder => Behavior (Same as class special send, but receiver is not a forwarder)"
+ 	 top := self internalStackTop.
+ 	 self deny: (objectMemory isOopForwarded: top).
+ 	 result := objectMemory fetchClassOf: top.
+ 	 self internalStackTopPut: result!

Item was added:
+ ----- Method: StackInterpreter>>unaryConvertInlinePrimitive: (in category 'sista inline primitives - unary') -----
+ unaryConvertInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result top |
+ 	self assert: (primIndex between: 30 and: 32).
+ 	top := self internalStackTop.
+ 	primIndex caseOf: {
+ 		"1030	characterAsInteger
+ 		 Character => 22 bits strictly positive Smi (Unicode)"
+ 		[30] -> [self assert: (objectMemory isImmediateCharacter: top).
+ 				result := objectMemory characterValueOf: top.
+ 				self assert: (result between: 1 and: "1 << 22 - 1" 4194303).
+ 				self internalStackTopPutIntegerObjectOf: result].
+ 		"1031	smallFloatAsInteger
+ 		 SmallFloat => Smi"
+ 		[31] -> [objectMemory hasSixtyFourBitImmediates
+ 					ifTrue: "Needs to protect rotatedFloatBitsOf:"
+ 						[self assert: (objectMemory isImmediateFloat: top).
+ 						result := objectMemory rotatedFloatBitsOf: top.
+ 						self assert: (objectMemory isIntegerObject: result).
+ 						self internalStackTopPutIntegerObjectOf: result]
+ 					ifFalse: [self unknownInlinePrimitive]].
+ 		"1032	smiAsFloat
+ 		 Smi => SmallFloat"
+ 		[32] -> [self assert: (objectMemory isIntegerObject: top).
+ 				self pop: 1 thenPushFloat: (objectMemory integerValueOf: top) asFloat].
+ 		 }!

Item was added:
+ ----- Method: StackInterpreter>>unaryHashInlinePrimitive: (in category 'sista inline primitives - unary') -----
+ unaryHashInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result top |
+ 	self assert: (primIndex between: 20 and: 23).
+ 	top := self internalStackTop.
+ 	primIndex caseOf: {
+ 		"1020	objectIdentityHash
+ 		 non-immediate and non-behavior => 22 bits strictly positive Smi"
+ 		[20] ->	[self deny: ((objectMemory isOopForwarded: top)
+ 						or: [(objectMemory isImmediate: top)
+ 							or: [objectMemory isInClassTable: top]]).
+ 				 result := objectMemory hashBitsOf: top.
+ 				self assert: (result between: 1 and: "1 << 22 - 1" 4194303).
+ 				self internalStackTopPutIntegerObjectOf: result].
+ 		"1021	smiIdentityHash
+ 		 Smi => Smi"
+ 		[21] -> [self assert: (objectMemory isIntegerObject: top).
+ 				"Don't do anything, Smi hash is the object itself"].		
+ 		"1022	charIdentityHash
+ 		 Character => 22 bits strictly positive Smi"
+ 		[22] -> [self assert: (objectMemory isImmediateCharacter: top).
+ 				result := objectMemory integerObjectOfCharacterObject: top.
+ 				self assert: (result between: 1 and: "1 << 22 - 1" 4194303).
+ 				self internalStackTopPut: result].
+ 		"1023	smallfloatIdentityHash
+ 		 SmallFloat => Smi"
+ 		[23] -> [objectMemory hasSixtyFourBitImmediates
+ 					ifTrue: "Needs to protect rotatedFloatBitsOf:"
+ 						[self assert: (objectMemory isImmediateFloat: top).
+ 						result := objectMemory rotatedFloatBitsOf: top.
+ 						self assert: (objectMemory isIntegerObject: result).
+ 						self internalStackTopPutIntegerObjectOf: result]
+ 					ifFalse: [self unknownInlinePrimitive]].
+ 		"1024	behaviorIdentityHash
+ 		 Behavior => 22 bits strictly positive Smi"
+ 		[24] -> [self assert: ((objectMemory isNonImmediate: top) 
+ 					and: [objectMemory objCouldBeClassObj: top]).
+ 				result := objectMemory ensureBehaviorHash: top.
+ 				self assert: (result between: 1 and: "1 << 22 - 1" 4194303).
+ 				self internalStackTopPutIntegerObjectOf: result].	
+ 		 }!

Item was changed:
+ ----- Method: StackInterpreter>>unaryInlinePrimitive: (in category 'sista inline primitives - unary') -----
- ----- Method: StackInterpreter>>unaryInlinePrimitive: (in category 'miscellaneous bytecodes') -----
  unaryInlinePrimitive: primIndex
- 	"SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	<option: #SistaVM>
+ 	"Bulk comments: each sub-method has its own comment with the specific case.
+ 	1000	rawClass
+ 	not a forwarder => Behavior (Same as class special send, but receiver is not a forwarder)
+ 	1001	numSlots
+ 	pointer object => Smi between 0 and SmallInteger maxVal // 4 - 1 (Answers total size in pointer-sized slots)
+ 	1002	numBytes
+ 	byte object => Smi between 0 and SmallInteger maxVal - 9 (Includes compiled code)
+ 	1003	numShorts
+ 	short object => Smi between 0 and SmallInteger maxVal - 9
+ 	1004	numWords
+ 	word object => Smi between 0 and SmallInteger maxVal - 9
+ 	1005	numDoubleWords
+ 	double word object => Smi between 0 and SmallInteger maxVal - 9
+ 	1011	RawNew
+ 	literal which is a fixed-sized behavior => instance of the receiver with fields nilled out
+ 	1012	RawNewNoInit
+ 	literal which is a fixed-sized behavior => instance of the receiver (Fields of returned value contain undefined data)
+ 	1020	objectIdentityHash
+ 	non-immediate and non-behavior => 22 bits strictly positive Smi
+ 	1021	smiIdentityHash
+ 	Smi => Smi
+ 	1022	charIdentityHash
+ 	Character => 22 bits strictly positive Smi
+ 	1023	smallfloatIdentityHash
+ 	SmallFloat => Smi
+ 	1024	behaviorIdentityHash
+ 	Behavior => 22 bits strictly positive Smi
+ 	1030	characterAsInteger
+ 	Character => 22 bits strictly positive Smi (Unicode)
+ 	1031	smallFloatAsInteger
+ 	SmallFloat => Smi
+ 	1032	smiAsFloat
+ 	Smi => SmallFloat
+ 	1039	unforwardNonImmediate
+ 	non immediate => Not a forwarder
+ 	1040	unforward
+ 	Anything => Not a forwarder
+ 	1041	possibleRoot
+ 	non-immediate, not a forwarder => receiver is returned (should be effect-only) (If old, becomes gray and remembered to allow many unchecked stores in a row afterwards)"
+ 	primIndex = 0 ifTrue: [^self unaryClassPrimitive].
+ 	primIndex <= 6 ifTrue: [^self unarySizeInlinePrimitive: primIndex].
+ 	primIndex < 11 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 12 ifTrue: [^self unaryNewInlinePrimitive: primIndex].
+ 	primIndex < 20 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 24 ifTrue: [^self unaryHashInlinePrimitive: primIndex].
+ 	primIndex < 30 ifTrue: [^self unknownInlinePrimitive].
+ 	primIndex <= 32 ifTrue: [^self unaryConvertInlinePrimitive: primIndex].
+ 	primIndex < 39 ifTrue: [^ self unknownInlinePrimitive].
+ 	primIndex <= 40 ifTrue: [^self unaryUnforwardInlinePrimitive: primIndex].
+ 	primIndex = 41 ifTrue: [^self unaryPossibleRootInlinePrimitive].
+ 	self unknownInlinePrimitive!
- 	| result |
- 	primIndex caseOf: {
- 		"1000	unchecked class"
- 		[0]	->	[result := objectMemory fetchClassOf: self internalStackTop.
- 				 self internalStackTopPut: result].
- 		"1001	unchecked pointer numSlots"
- 		[1]	->	[result := objectMemory numSlotsOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"1002	unchecked pointer basicSize"
- 		[2]	->	[result := (objectMemory numSlotsOf: self internalStackTop)
- 						- (objectMemory fixedFieldsOfClass: (objectMemory fetchClassOfNonImm: self internalStackTop)).
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"1003	unchecked byte8Type format numBytes (includes CompiledMethod)"
- 		[3]	->	[result := objectMemory numBytesOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"1004	unchecked short16Type format numShorts"
- 		[4]	->	[result := objectMemory num16BitUnitsOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"1005	unchecked word32Type format numWords"
- 		[5]	->	[result := objectMemory num32BitUnitsOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"1006	unchecked doubleWord64Type format numDoubleWords"
- 		[6]	->	[result := objectMemory num64BitUnitsOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 
- 		"1011	unchecked fixed pointer basicNew"
- 		[11] ->	[| classObj numSlots |
- 				 classObj := self internalStackTop.
- 				 numSlots := objectMemory instanceSizeOf: classObj.
- 				 result := objectMemory instantiateClass: classObj.
- 				" result := objectMemory eeInstantiateSmallClass: classObj numSlots: numSlots.
- 				 (extB noMask: 1) ifTrue:
- 					[0 to: numSlots - 1 do:
- 						[:i| objectMemory storePointerUnchecked: i ofObject: result withValue: objectMemory nilObject]]."
- 				 extB := 0.
- 				numExtB := 0.
- 				 self internalStackTopPut: result].
- 		"1020 	identityHash"
- 		[20] ->	[result := objectMemory hashBitsOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)].
- 		"1021		identityHash (SmallInteger)"
- 		"1022		identityHash (Character)"
- 		"1023		identityHash (SmallFloat64)"
- 		"1024		identityHash (Behavior)"
- 		"1030 	immediateAsInteger (Character)
- 		 1031 	immediateAsInteger (SmallFloat64)"
- 		[30] -> [ result := objectMemory characterValueOf: self internalStackTop.
- 				 self internalStackTopPut: (objectMemory integerObjectOf: result)]
- 		 }
- 	otherwise:
- 		[localIP := localIP - 3.
- 		 self respondToUnknownBytecode]!

Item was added:
+ ----- Method: StackInterpreter>>unaryNewInlinePrimitive: (in category 'sista inline primitives - unary') -----
+ unaryNewInlinePrimitive: primIndex
+ 	"1011	RawNew
+ 	 literal which is a fixed-sized behavior => instance of the receiver with fields nilled out
+ 	1012	RawNewNoInit
+ 	literal which is a fixed-sized behavior => instance of the receiver (Fields of returned value contain undefined data)
+ 	
+ 	WARNING: In the interpreter version, fields are always initialized."
+ 	| classObj result |
+ 	self assert: (primIndex between: 11 and: 12).
+ 	classObj := self internalStackTop.
+ 	self assert: ((objectMemory isNonImmediate: classObj) and: [self objCouldBeClassObj: classObj]).
+ 	result := objectMemory instantiateClass: classObj.
+ 	self internalStackTopPut: result!

Item was added:
+ ----- Method: StackInterpreter>>unaryPossibleRootInlinePrimitive (in category 'sista inline primitives - unary') -----
+ unaryPossibleRootInlinePrimitive
+ 	<option: #SistaVM>
+ 	"1041	possibleRoot
+ 	 non-immediate, not a forwarder => receiver is returned (should be effect-only) (If old, becomes gray and remembered to allow many unchecked stores in a row afterwards)"
+ 	| top |
+ 	top := self internalStackTop.
+ 	self deny: (objectMemory isImmediate: top).
+ 	self deny: (objectMemory isOopForwarded: top).
+ 	(objectMemory isYoungObject: top)
+ 		ifFalse: [objectMemory possibleRootStoreInto: top]!

Item was added:
+ ----- Method: StackInterpreter>>unarySizeInlinePrimitive: (in category 'sista inline primitives - unary') -----
+ unarySizeInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	| result top |
+ 	self assert: (primIndex between: 1 and: 6).
+ 	top := self internalStackTop.
+ 	primIndex caseOf: {
+ 		"1001	numSlots
+ 		 pointer object => Smi between 0 and SmallInteger maxVal // 4 - 1 (Answers total size in pointer-sized slots)"
+ 		[1]	->	[self assert: (objectMemory isPointers: top).
+ 				 result := objectMemory numSlotsOfAny: top.
+ 				 self assert: (result between: 0 and: objectMemory maxSmallInteger // 4 - 1)].
+ 		"1002	numBytes
+ 		 byte object => Smi between 0 and SmallInteger maxVal - 9 (Includes compiled code)"
+ 		[2]	->	[self assert: (objectMemory isBytes: top).
+ 				 result := objectMemory numBytesOf: top].
+ 		"1003	numShorts
+ 		 short object => Smi between 0 and SmallInteger maxVal - 9"
+ 		[3]	->	[self assert: (objectMemory isShorts: top).
+ 				 result := objectMemory num16BitUnitsOf: top].
+ 		"1004	numWords
+ 		 word object => Smi between 0 and SmallInteger maxVal - 9"
+ 		[5]	->	[self assert: (objectMemory isWords: top).
+ 				 result := objectMemory num32BitUnitsOf: top].
+ 		"1005	numDoubleWords 
+ 		 double word object => Smi between 0 and SmallInteger maxVal - 9"
+ 		[6]	->	[self assert: (objectMemory isLong64s: top).
+ 				 result := objectMemory num64BitUnitsOf: top].
+ 	}.
+ 	self assert: (result between: 0 and: objectMemory maxSmallInteger - 9).
+ 	self internalStackTopPut: (objectMemory integerObjectOf: result)
+ 	!

Item was added:
+ ----- Method: StackInterpreter>>unaryUnforwardInlinePrimitive: (in category 'sista inline primitives - unary') -----
+ unaryUnforwardInlinePrimitive: primIndex
+ 	<option: #SistaVM>
+ 	"1039	unforwardNonImmediate
+ 	 non immediate => Not a forwarder
+ 	 1040	unforward
+ 	 Anything => Not a forwarder"
+ 	"Only perf in jitted code matters, don't remove the immediate check"
+ 	 | top |
+ 	 top := self internalStackTop.
+ 	self assert: (primIndex = 40 or: [objectMemory isNonImmediate: top]).
+ 	 (objectMemory isOopForwarded: top) ifTrue:
+ 		[self internalStackTopPut: (objectMemory followForwarded: top)]!

Item was added:
+ ----- Method: StackInterpreter>>unknownInlinePrimitive (in category 'sista bytecodes') -----
+ unknownInlinePrimitive
+ 	<inline: true> "Should be inlined everywhere to access localIP"
+ 	localIP := localIP - 3.
+ 	self respondToUnknownBytecode!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
  initializeBytecodeTableForSistaV1
  	"StackToRegisterMappingCogit initializeBytecodeTableForSistaV1"
  
  	numPushNilsFunction := #sistaV1:Num:Push:Nils:.
  	pushNilSizeFunction := #sistaV1PushNilSize:numInitialNils:.
  	BytecodeSetHasDirectedSuperSend := true.
  	FirstSpecialSelector := 96.
  	NumSpecialSelectors := 32.
  	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 isInstVarRef		needsFrameNever: 1)
+ 		(1  16   31 genPushLitVarDirSup16CasesBytecode				needsFrameNever: 1)
- 		(1  16   31 genPushLiteralVariable16CasesBytecode			needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode					needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode				needsFrameIfMod16GENumArgs: 1)
  		(1  76   76 genPushReceiverBytecode							needsFrameNever: 1)
  		(1  77   77 genPushConstantTrueBytecode						needsFrameNever: 1)
  		(1  78   78 genPushConstantFalseBytecode					needsFrameNever: 1)
  		(1  79   79 genPushConstantNilBytecode						needsFrameNever: 1)
  		(1  80   80 genPushConstantZeroBytecode						needsFrameNever: 1)
  		(1  81   81 genPushConstantOneBytecode						needsFrameNever: 1)
  		(1  82   82 genExtPushPseudoVariable)
  		(1  83   83 duplicateTopBytecode								needsFrameNever: 1)
  
  		(1  84   87 unknownBytecode)
  
  		"returns"
  		(1  88   88 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  89   89 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  90   90 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  91   91 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  92   92 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1  93   93 genReturnNilFromBlock			return needsFrameNever: -1)
  		(1  94   94 genReturnTopFromBlock		return needsFrameNever: -1)
  		(1  95   95 genExtNopBytecode			needsFrameNever: 0)
  
  		"sends"
  		(1  96   96 genSpecialSelectorArithmetic isMapped AddRR)
  		(1  97   97 genSpecialSelectorArithmetic isMapped SubRR)
  		(1  98   98 genSpecialSelectorComparison isMapped JumpLess)
  		(1  99   99 genSpecialSelectorComparison isMapped JumpGreater)
  		(1 100 100 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1 101 101 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1 102 102 genSpecialSelectorComparison isMapped JumpZero)
  		(1 103 103 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1 104 109 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
  		(1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
  		(1 112 117 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 119 119 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 120 120 genSpecialSelectorNotEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 121 127 genSpecialSelectorSend isMapped) "#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:)
  		(1 200 207 genStoreAndPopReceiverVariableBytecode isInstVarRef is1ByteInstVarStore isMappedIfImmutability needsFrameIfImmutability: -1)
  		
  		(1 208 215 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 216 216 genPopStackBytecode needsFrameNever: -1)
  
  		(1 217 217 genUnconditionalTrapBytecode isMapped)
  
  		(1 218 223 unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  
  		"pushes"
  		(2 226 226 genExtPushReceiverVariableBytecode isInstVarRef)		"Needs a frame for context inst var access"
+ 		(2 227 227 genExtPushLitVarDirSupBytecode			needsFrameNever: 1)
- 		(2 227 227 genExtPushLiteralVariableBytecode			needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genLongPushTemporaryVariableBytecode)
  		(2 230 230 unknownBytecode)
  		(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 genCallMappedInlinedPrimitive isMapped hasUnsafeJump)
- 		(2 236 236 genExtEnsureAllocableSlots 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 isInstVarRef isMappedIfImmutability)
+ 		(2 241 241 genExtStoreAndPopLiteralVariableBytecode isMappedIfImmutability)
- 		(2 240 240 genSistaExtStoreAndPopReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
- 		(2 241 241 genSistaExtStoreAndPopLiteralVariableBytecode isMappedIfImmutability)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
+ 		(2 243 243 genExtStoreReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
+ 		(2 244 244 genExtStoreLiteralVariableBytecode isMappedIfImmutability)
- 		(2 243 243 genSistaExtStoreReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
- 		(2 244 244 genSistaExtStoreLiteralVariableBytecode isMappedIfImmutability)
  		(2 245 245 genLongStoreTemporaryVariableBytecode)
  
  		(2 246 247	unknownBytecode)
  
  		"3 byte bytecodes"
+ 		(3 248 248 genCallPrimitiveBytecode hasUnsafeJump)
- 		(3 248 248 genCallPrimitiveBytecode)
  		(3 249 249 genExtPushFullClosureBytecode)
  		(3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
+ 		(3 251 251 genPushRemoteTempLongBytecode)
+ 		(3 252 252 genStoreRemoteTempLongBytecode isMappedIfImmutability)
+ 		(3 253 253 genStoreAndPopRemoteTempLongBytecode isMappedIfImmutability)
- 		(3 251 251 genExtPushRemoteTempOrInstVarLongBytecode)
- 		(3 252 252 genExtStoreRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
- 		(3 253 253 genExtStoreAndPopRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
- 
- 		(3 254 254	genExtJumpIfNotInstanceOfBehaviorsBytecode branch v4:Long:BranchIfNotInstanceOf:Distance:)
  		
+ 		(3 254 255	unknownBytecode))!
- 		(3 255 255	unknownBytecode))!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>genExtEnsureAllocableSlots (in category 'bytecode generators') -----
- genExtEnsureAllocableSlots
- 	"SistaV1	*	236	11101100	iiiiiiii	Ensure Allocable Slots (+ Extend A * 256)"
- 	self ssFlushTo: simStackPtr.
- 	^super genExtEnsureAllocableSlots!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genGenericStorePop:slotIndex:destReg:needsStoreCheck:needsRestoreRcvr:needsImmutabilityCheck: (in category 'bytecode generator stores') -----
  genGenericStorePop: popBoolean slotIndex: slotIndex destReg: destReg needsStoreCheck: needsStoreCheck needsRestoreRcvr: needsRestoreReceiver needsImmutabilityCheck: needsImmCheck
  	"Generates a store into an object that *cannot* be a context.
  	 This code is common between multiple stores (litVar, instVar, remoteInstVar, RemoteTemp)
  	 Multiple settings:
  	- needsStoreCheck (young into old object check)
  	- needRestoreRcvr (ensures the receiver is live across the store)
  	- needsImmCheck (do the call-back if the receiver is immutable)"
- 	<inline: true>
  	"We have two very different paths as only the immutability path requires a specific register 
  	for the value on top of stack as well as the stack flush"
  	| topReg |
+ 	<inline: true>
  	self 
  		cppIf: IMMUTABILITY
  		ifTrue:
  			[needsImmCheck
  				ifTrue: 
+ 					[self ssAllocateRequiredReg: ClassReg upThrough: simStackPtr - 1. "If already classReg don't spill it"
- 					[self ssAllocateRequiredReg: ClassReg.
  					 "we replace the top value for the flush"
  					 self ssStoreAndReplacePop: popBoolean toReg: ClassReg.
  					 self ssFlushTo: simStackPtr.
  					 ^objectRepresentation 
  						genStoreWithImmutabilityCheckSourceReg: ClassReg 
  						slotIndex: slotIndex 
  						destReg: destReg 
  						scratchReg: TempReg 
  						needsStoreCheck: needsStoreCheck 
  						needRestoreRcvr: needsRestoreReceiver]].
  		 topReg := self 
  					allocateRegForStackEntryAt: 0 
  					notConflictingWith: (self registerMaskFor: destReg). 
  		 self ssStorePop: popBoolean toReg: topReg.
  		 ^objectRepresentation
  			genStoreSourceReg: topReg
  			slotIndex: slotIndex
  			destReg: destReg
  			scratchReg: TempReg
  			inFrame: needsFrame
  			needsStoreCheck: needsStoreCheck
  	!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta seenInstVarStore |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := useTwoPaths := seenInstVarStore := false.
  	LowcodeVM ifTrue: [ hasNativeFrame := false ].
  	self maybeInitNumFixups.
  	self maybeInitNumCounters.
  	prevBCDescriptor := nil.
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := numExtB := extB := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  				[^EncounteredUnknownBytecode].
  			 self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
+ 		
- 
  		  needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  					ifTrue:
  						["With immutability we win simply by avoiding a frame build if the receiver is young and not immutable."
  						 self cppIf: IMMUTABILITY
  							ifTrue: [descriptor is1ByteInstVarStore
  									ifTrue: [useTwoPaths := true]
  									ifFalse: [needsFrame := true. useTwoPaths := false]]
  							ifFalse: [needsFrame := true. useTwoPaths := false]]
  					ifFalse:
  						[framelessStackDelta := framelessStackDelta + descriptor stackDelta.
  						 "Without immutability we win if there are two or more stores and the receiver is new."
  						 self cppIf: IMMUTABILITY
  							ifTrue: []
  							ifFalse:
  								[descriptor is1ByteInstVarStore ifTrue:
  									[seenInstVarStore
  										ifTrue: [useTwoPaths := true]
  										ifFalse: [seenInstVarStore := true]]]]].
  
  		 descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 self maybeCountFixup: descriptor.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC]
  				ifFalse:
  					[latestContinuation := latestContinuation max: targetPC.
  					 self maybeCountCounter]].
+ 			
+ 		 latestContinuation := self 
+ 			maybeDealWithUnsafeJumpForDescriptor: descriptor 
+ 			pc: pc 
+ 			latestContinuation: latestContinuation.
+ 		
  		 descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC.
  			 self maybeCountFixup: descriptor].
  
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue: [numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [extA := numExtB := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!



More information about the Vm-dev mailing list