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

commits at source.squeak.org commits at source.squeak.org
Fri Sep 2 09:27:02 UTC 2016


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

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

Name: VMMaker.oscog-cb.1932
Author: cb
Time: 2 September 2016, 11:24:18.041558 am
UUID: 9d80a630-31aa-40dc-9b38-917293281995
Ancestors: VMMaker.oscog-cb.1931

The jumpIfNotInstanceOfOrPop bytecode was interesting but hard to tackle in many places, leading to hard to write assertion in the JIT.

I've changed it so that it now always consumes the top of the stack, jumping if the top of the stack is not an instance of one of the class specified in the literal.

This way that bytecode can also be used easily to optimize PICs.

=============== Diff against VMMaker.oscog-cb.1931 ===============

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 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
  
  		"jumps"
  		(1 176 183 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 184 191 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 192 199 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		"stores"
  		(1 200 207 genStoreAndPopReceiverVariableBytecode 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 genSistaExtStoreAndPopReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
  		(2 241 241 genSistaExtStoreAndPopLiteralVariableBytecode isMappedIfImmutability)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
  		(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 genExtPushRemoteTempOrInstVarLongBytecode)
  		(3 252 252 genExtStoreRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
  		(3 253 253 genExtStoreAndPopRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
  
+ 		(3 254 254	genExtJumpIfNotInstanceOfBehaviorsBytecode)
- 		(3 254 254	genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode)
  			
  		(3 255 255	unknownBytecode))!

Item was added:
+ ----- 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 removed:
- ----- Method: SimpleStackBasedCogit>>genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'bytecode generators') -----
- genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode
- 	"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>>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 |
+ 	
+ 	"We loose 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 ssFlushTo: simStackPtr. "flushed but the value is still in reg"
+ 	
+ 	self genPopStackBytecode.
+ 	
+ 	literal := self getLiteral: (extA * 256 + byte1).
+ 	extA := 0.
+ 	distance := extB * 256 + byte2.
+ 	extB := 0.
+ 	
+ 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
+ 		
+ 	(objectMemory isArrayNonImm: literal)
+ 		ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
+ 		ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
+ 
+ 	^0!

Item was removed:
- ----- Method: SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'bytecode generators') -----
- genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode
- 	"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 |
- 	
- 	"We loose 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 ssFlushTo: simStackPtr. "flushed but the value is still in reg"
- 
- 	self genPopStackBytecode.
- 	
- 	literal := self getLiteral: (extA * 256 + byte1).
- 	extA := 0.
- 	distance := extB * 256 + byte2.
- 	extB := 0.
- 	
- 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
- 		
- 	(objectMemory isArrayNonImm: literal)
- 		ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
- 		ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
- 	
- 	^0!

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.
  	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:"
  		(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	 bytecodePrimSpecialSelector24) "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		unknownBytecode)
  
  		(237		extUnconditionalJump)
  		(238		extJumpIfTrue)
  		(239		extJumpIfFalse)
  
  		(240		extSistaStoreAndPopReceiverVariableBytecode)
  		(241		extSistaStoreAndPopLiteralVariableBytecode)
  		(242		longStoreAndPopTemporaryVariableBytecode)
  
  		(243		extSistaStoreReceiverVariableBytecode)
  		(244		extSistaStoreLiteralVariableBytecode)
  		(245		longStoreTemporaryVariableBytecode)
  
  		(246 247	unknownBytecode)
  
  		"3 byte bytecodes"
  		(248		callPrimitiveBytecode)
  		(249		extPushFullClosureBytecode)
  
  		(250		extPushClosureBytecode)
  		(251		extPushRemoteTempOrInstVarLongBytecode)
  		(252		extStoreRemoteTempOrInstVarLongBytecode)
  		(253		extStoreAndPopRemoteTempOrInstVarLongBytecode)
  				
+ 		(254		extJumpIfNotInstanceOfBehaviorsBytecode)
- 		(254		extJumpIfNotInstanceOfBehaviorsOrPopBytecode)
  
  		(255		unknownBytecode)
  	)!

Item was added:
+ ----- 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 >= 0)"
+ 	| tosClassTag literal distance |
+ 	SistaVM ifFalse: [^self respondToUnknownBytecode].
+ 	tosClassTag := objectMemory fetchClassTagOf: self internalPopStack.
+ 	literal := self literal: extA << 8 + self fetchByte.
+ 	distance := extB << 8 + self fetchByte.
+ 	extA := 0.
+ 	extB := 0.
+ 	(objectMemory isArrayNonImm: literal)
+ 		ifTrue:
+ 			[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do: [:i |
+ 				tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))
+ 					ifTrue: [ ^ self fetchNextBytecode ] ].
+ 			 localIP := localIP + distance.
+ 			 ^ self fetchNextBytecode]
+ 		ifFalse:
+ 			[tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
+ 				[localIP := localIP + distance.
+ 				^ self fetchNextBytecode]].
+ 	self fetchNextBytecode!

Item was removed:
- ----- Method: StackInterpreter>>extJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'sista bytecodes') -----
- extJumpIfNotInstanceOfBehaviorsOrPopBytecode
- 	"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)"
- 	| tosClassTag literal distance |
- 	SistaVM ifFalse: [^self respondToUnknownBytecode].
- 	tosClassTag := objectMemory fetchClassTagOf: self internalStackTop.
- 	literal := self literal: extA << 8 + self fetchByte.
- 	distance := extB << 8 + self fetchByte.
- 	extA := 0.
- 	extB := 0.
- 	(objectMemory isArrayNonImm: literal)
- 		ifTrue:
- 			[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do: [:i |
- 				tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))
- 					ifTrue: 
- 						[ self internalPopStack.
- 						^ self fetchNextBytecode ] ].
- 			localIP := localIP + distance.
- 				^ self fetchNextBytecode]
- 		ifFalse:
- 			[tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
- 				[localIP := localIP + distance.
- 				^ self fetchNextBytecode]].
- 	self internalPopStack.
- 	self fetchNextBytecode!

Item was removed:
- ----- Method: StackInterpreter>>extTrapIfNotInstanceOfBehaviorsBytecode (in category 'sista bytecodes') -----
- extTrapIfNotInstanceOfBehaviorsBytecode
- 	"SistaV1: *	236	11101100	iiiiiiii	Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)"
- 	| tos tosClassTag literal |
- 	tos := self internalStackTop.
- 	tosClassTag := objectMemory fetchClassTagOf: tos.
- 	literal := self literal: extA << 8 + self fetchByte.
- 	extA := 0.
- 	(objectMemory isArrayNonImm: literal)
- 		ifTrue:
- 			[| i |
- 			 i := (objectMemory numSlotsOf: literal) asInteger.
- 			 [(i := i -1) < 0
- 			  or: [tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))]] whileTrue.
- 			 i < 0 ifTrue:
- 				[^self respondToSistaTrap]]
- 		ifFalse:
- 			[tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
- 				[^self respondToSistaTrap]].
- 	self internalPopStack.
- 	self fetchNextBytecode!

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  32   63 genPushLiteralConstantBytecode					needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode				needsFrameIfMod16GENumArgs: 1)
  		(1  76   76 genPushReceiverBytecode							needsFrameNever: 1)
  		(1  77   77 genPushConstantTrueBytecode						needsFrameNever: 1)
  		(1  78   78 genPushConstantFalseBytecode					needsFrameNever: 1)
  		(1  79   79 genPushConstantNilBytecode						needsFrameNever: 1)
  		(1  80   80 genPushConstantZeroBytecode						needsFrameNever: 1)
  		(1  81   81 genPushConstantOneBytecode						needsFrameNever: 1)
  		(1  82   82 genExtPushPseudoVariable)
  		(1  83   83 duplicateTopBytecode								needsFrameNever: 1)
  
  		(1  84   87 unknownBytecode)
  
  		"returns"
  		(1  88   88 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  89   89 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  90   90 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  91   91 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  92   92 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1  93   93 genReturnNilFromBlock			return needsFrameNever: -1)
  		(1  94   94 genReturnTopFromBlock		return needsFrameNever: -1)
  		(1  95   95 genExtNopBytecode			needsFrameNever: 0)
  
  		"sends"
  		(1  96   96 genSpecialSelectorArithmetic isMapped AddRR)
  		(1  97   97 genSpecialSelectorArithmetic isMapped SubRR)
  		(1  98   98 genSpecialSelectorComparison isMapped JumpLess)
  		(1  99   99 genSpecialSelectorComparison isMapped JumpGreater)
  		(1 100 100 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1 101 101 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1 102 102 genSpecialSelectorComparison isMapped JumpZero)
  		(1 103 103 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1 104 109 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
  		(1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
  		(1 112 117 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 119 119 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
  
  		"jumps"
  		(1 176 183 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 184 191 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 192 199 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(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 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 genSistaExtStoreAndPopReceiverVariableBytecode isInstVarRef isMappedIfImmutability)
  		(2 241 241 genSistaExtStoreAndPopLiteralVariableBytecode isMappedIfImmutability)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
  		(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 genExtPushRemoteTempOrInstVarLongBytecode)
  		(3 252 252 genExtStoreRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
  		(3 253 253 genExtStoreAndPopRemoteTempOrInstVarLongBytecode isMappedIfImmutability)
  
+ 		(3 254 254	genExtJumpIfNotInstanceOfBehaviorsBytecode branch v4:Long:BranchIfNotInstanceOf:Distance:)
- 		(3 254 254	genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode branch v4:Long:BranchIfNotInstanceOf:Distance:)
  		
  		(3 255 255	unknownBytecode))!



More information about the Vm-dev mailing list