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

commits at source.squeak.org commits at source.squeak.org
Sat Aug 9 03:02:35 UTC 2014


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

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

Name: VMMaker.oscog-eem.850
Author: eem
Time: 8 August 2014, 8:00:14.987 pm
UUID: 9781942b-089b-4bea-b70c-ea9394fae3b4
Ancestors: VMMaker.oscog-eem.849

Fix some simulation bugs with the Cogit in running the new
format Spur images.

Alter the SqueakV3 Cogit bytecode table initializers to add
the callPrimitiveBytecode: at 139 if in a Spur VM.

Hack the dependency on BytecodeSets for
stackDeltaForPrimitive:in: to be soft via an MNU handler.

Update the prim numbers for inlined prims in
genCallPrimitiveBytecode to match the latest
EncoderForSistaV1 class comment.

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

Item was changed:
  ----- Method: CoInterpreter>>ceInterpretMethodFromPIC:receiver: (in category 'trampolines') -----
  ceInterpretMethodFromPIC: aMethodObj receiver: rcvr
  	<api>
  	| pic primitiveIndex |
  	<var: #pic type: #'CogMethod *'>
  	self assert: (self methodHasCogMethod: aMethodObj) not.
  	"pop off inner return and locate open PIC"
  	pic := self cCoerceSimple: self popStack - cogit interpretOffset to: #'CogMethod *'.
  	self assert: (pic cmType = CMOpenPIC or: [pic cmType = CMClosedPIC]).
  	"If found from an open PIC then it must be an uncogged method and, since it's been found
  	 in the method cache, should be cogged if possible.  If found from a closed PIC it should
  	 be interpreted (since being reached by that route implies it is uncoggable)."
  	pic cmType = CMOpenPIC
  		ifTrue:
  			[(self methodShouldBeCogged: aMethodObj) ifTrue:
  				[cogit cog: aMethodObj selector: pic selector.
  				 (self methodHasCogMethod: aMethodObj) ifTrue:
  					[self executeCogMethod: (self cogMethodOf: aMethodObj)
  						fromUnlinkedSendWithReceiver: rcvr]]]
  		ifFalse:
  			[self assert: (cogCompiledCodeCompactionCalledFor
+ 						or: [(self methodShouldBeCogged: aMethodObj) not])].
- 						or: [(cogit methodShouldBeCogged: aMethodObj) not])].
  	messageSelector := pic selector.
  	newMethod := aMethodObj.
  	primitiveIndex := self primitiveIndexOf: aMethodObj.
  	primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject.
  	argumentCount := pic cmNumArgs.
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: Cogit>>cogMethodSurrogateAt: (in category 'simulation only') -----
  cogMethodSurrogateAt: address
  	<doNotGenerate>
+ 	self assert: (address < 0 or: [(address bitAnd: BytesPerWord - 1) = 0]).
- 	self assert: (address bitAnd: BytesPerWord - 1) = 0.
  	^cogMethodSurrogateClass new
  		at: address
  		objectMemory: objectMemory
  		cogit: self!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>literalCountOfMethodHeader: (in category 'accessing') -----
+ literalCountOfMethodHeader: headerIntegerOop
+ 	^objectMemory literalCountOfMethodHeader: headerIntegerOop!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>methodHeaderOf: (in category 'accessing') -----
+ methodHeaderOf: oop
+ 	^(self objectForOop: oop) header!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForSqueakV3PlusClosures (in category 'class initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosures
  	"SimpleStackBasedCogit initializeBytecodeTableForSqueakV3PlusClosures"
  
  	FirstSpecialSelector := 176.
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		(1    0   15 genPushReceiverVariableBytecode)
  		(1  16   31 genPushTemporaryVariableBytecode)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   95 genPushLiteralVariableBytecode needsFrameNever: 1)
  		(1  96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 104 111 genStoreAndPopTemporaryVariableBytecode)
  		(1 112 112 genPushReceiverBytecode)
  		(1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
  		(1 114 114 genPushConstantFalseBytecode needsFrameNever: 1)
  		(1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
  		(1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1)
  		"method returns in blocks need a frame because of nonlocalReturn:through:"
  		(1 120 120 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 121 121 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 122 122 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 123 123 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 124 124 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 125 125 genReturnTopFromBlock		return needsFrameNever: -1)
  
  		(1 126 127 unknownBytecode)
  
  		(2 128 128 extendedPushBytecode needsFrameNever: 1)
  		(2 129 129 extendedStoreBytecode)
  		(2 130 130 extendedStoreAndPopBytecode)
  		(2 131 131 genExtendedSendBytecode isMapped)
  		(3 132 132 doubleExtendedDoAnythingBytecode isMapped)
  		(2 133 133 genExtendedSuperBytecode isMapped)
  		(2 134 134 genSecondExtendedSendBytecode isMapped)
  		(1 135 135 genPopStackBytecode needsFrameNever: -1)
  		(1 136 136 duplicateTopBytecode needsFrameNever: 1)
  
  		(1 137 137 genPushActiveContextBytecode)
+ 		(2 138 138 genPushNewArrayBytecode)),
- 		(2 138 138 genPushNewArrayBytecode)
  
+ 		((initializationOptions at: #SpurObjectMemory ifAbsent: [false])
+ 			ifTrue: [#((3 139 139 callPrimitiveBytecode))]
+ 			ifFalse: [#((1 139 139 unknownBytecode))]),
- 		(1 139 139 unknownBytecode)
  
+ 	  #(
  		(3 140 140 genPushRemoteTempLongBytecode)
  		(3 141 141 genStoreRemoteTempLongBytecode)
  		(3 142 142 genStoreAndPopRemoteTempLongBytecode)
  		(4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:)
  
  		(1 144 151 genShortUnconditionalJump			branch v3:ShortForward:Branch:Distance:)
  		(1 152 159 genShortJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
  															v3:ShortForward:Branch:Distance:)
  		(2 160 163 genLongUnconditionalBackwardJump	branch isMapped "because of interrupt check"
  															v3:Long:Branch:Distance:)
  		(2 164 167 genLongUnconditionalForwardJump		branch v3:Long:Branch:Distance:)
  		(2 168 171 genLongJumpIfTrue					branch isBranchTrue isMapped "because of mustBeBoolean"
  															v3:LongForward:Branch:Distance:)
  		(2 172 175 genLongJumpIfFalse					branch isBranchFalse isMapped "because of mustBeBoolean"
  															v3:LongForward:Branch:Distance:)
  
  		(1 176 197 genSpecialSelectorSend isMapped)
  		(1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 199 199 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 200 207 genSpecialSelectorSend isMapped)
  		(1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>callPrimitiveBytecode (in category 'bytecode generators') -----
  callPrimitiveBytecode
+ 	"V3PlusClosures:	139 10001011	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ 	 NewsqueakV4:		249 11111001	iiiiiiii   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."
- 	"249		11111001	i i i i i i i i	jjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
  	self assert: (primitiveIndex = (byte1 + (byte2 << 8))
  				or: [primitiveIndex = 0 "disabled primitives, e.g. stream prims"
  					and: [(coInterpreter primitiveIndexOf: methodObj) = (byte1 + (byte2 << 8))]]).
  	^0!

Item was changed:
  ----- Method: Spur32BitCoMemoryManager>>methodHeaderOf: (in category 'growing/shrinking memory') -----
  methodHeaderOf: methodObj
  	"Answer the method header of a CompiledMethod object.
  	 If the method has been cogged then the header is a pointer to
  	 the CogMethod and the real header will be stored in the CogMethod."
  	<inline: true>
  	| header |
  	self assert: (self isCompiledMethod: methodObj).
  	header := self fetchPointer: HeaderIndex ofObject: methodObj.
  	^(self isIntegerObject: header)
  		ifTrue: [header]
  		ifFalse:
  			[self assert: header asUnsignedInteger < newSpaceStart.
+ 			 self assert: (coInterpreter cCoerceSimple: header to: #'CogMethod *') objectHeader
- 			 self assert: (self cCoerceSimple: header to: #'CogMethod *') objectHeader
  						= self nullHeaderForMachineCodeMethod..
+ 			(coInterpreter cCoerceSimple: header to: #'CogMethod *') methodHeader]!
- 			(self cCoerceSimple: header to: #'CogMethod *') methodHeader]!

Item was changed:
  ----- Method: StackDepthFinder>>callPrimitive: (in category 'instruction decoding') -----
  callPrimitive: primitiveIndex
  	"Call Primitive bytecode."
+ 	"Phhh.... stackDeltaForPrimitive:in: is in BytecodeSets.  But since the default response
+ 	 to callPrimitive: is nothing, just handle this with an MNU for now."
+ 	[self drop: (encoderClass stackDeltaForPrimitive: primitiveIndex in: self method) negated]
+ 		on: MessageNotUnderstood
+ 		do: [:ex|
+ 			ex message selector ~~ #stackDeltaForPrimitive:in: ifTrue:
+ 				[ex pass]]!
- 	self drop: (encoderClass stackDeltaForPrimitive: primitiveIndex in: self method) negated!

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

Item was changed:
+ ----- Method: StackToRegisterMappingCogit>>genBinaryVarOpVarInlinePrimitive: (in category 'inline primitive generators') -----
- ----- Method: StackToRegisterMappingCogit>>genBinaryVarOpVarInlinePrimitive: (in category 'bytecode generators') -----
  genBinaryVarOpVarInlinePrimitive: prim
  	"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:"
  	| ra rr |
  	rr := (backEnd availableRegisterOrNilFor: self liveRegisters) ifNil:
  			[self ssAllocateRequiredReg:
  				(optStatus isReceiverResultRegLive
  					ifTrue: [Arg0Reg]
  					ifFalse: [ReceiverResultReg])].
  	ra := (backEnd availableRegisterOrNilFor: (self liveRegisters bitOr: (self registerMaskFor: rr))) ifNil:
  			[self ssAllocateRequiredReg: Arg1Reg].
  	(rr = ReceiverResultReg or: [ra = ReceiverResultReg]) ifTrue:
  		[optStatus isReceiverResultRegLive: false].
  	self ssTop popToReg: ra.
  	self ssPop: 1.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self AddR: ra R: rr].
  		[1]	->	[self SubR: ra R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  		[2]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rr.
  				 objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ra.
  				 self MulR: ra R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  
  		"16 through 19, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  
  		"32	through 37, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  
  		"64	through 68, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  
  		"80	through 84, Pointer Object>>at:put:, Byte Object>>at:put:, Short16 Word Object>>at:put: LongWord32 Object>>at:put: Quad64Word Object>>at:put:. obj op 0-rel SmallInteger => oop"
  
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: rr.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>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 |
  	byte2 < 128 ifTrue:
  		[^EncounteredUnknownBytecode].
  	prim := byte2 - 128 << 8 + byte1.
  
+ 	prim < 1000 ifTrue:
+ 		[^self genUnaryInlinePrimitive: prim].
+ 		
+ 	prim < 2000 ifTrue:
- 	prim < 80 ifTrue:
  		[self ssTop type = SSConstant ifTrue:
+ 			[^self genBinaryVarOpConstInlinePrimitive: prim - 1000].
- 			[^self genBinaryVarOpConstInlinePrimitive: prim].
  		 (self ssValue: 1) type = SSConstant ifTrue:
+ 			[^self genBinaryConstOpVarInlinePrimitive: prim - 1000].
+ 		 ^self genBinaryVarOpVarInlinePrimitive: prim - 1000].
- 			[^self genBinaryConstOpVarInlinePrimitive: prim].
- 		 ^self genBinaryVarOpVarInlinePrimitive: prim].
  
+ 	prim < 3000 ifTrue:
+ 		[^self genTrinaryInlinePrimitive: prim - 2000].
- 	prim < 100 ifTrue:
- 		[^self genTrinaryInlinePrimitive: prim].
  
  	^EncounteredUnknownBytecode!



More information about the Vm-dev mailing list