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

commits at source.squeak.org commits at source.squeak.org
Mon Jan 18 17:30:29 UTC 2016


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

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

Name: VMMaker.oscog-cb.1651
Author: cb
Time: 18 January 2016, 6:29:12.307 pm
UUID: b53b4619-89ec-4131-bc40-8740fbb218fb
Ancestors: VMMaker.oscog-eem.1650

In this version, the Stack VM compiled to C is fully working with Immutability ON.

Load the package to try to use it.

I fixed the primitive not popping enough the stack...

Fixed a zip in Cogit.

Important change in the stack interpreter: if the cannotAssign:withValue: callback was called, its sender pc was ahead by one due to the fetchNextBytecode before the normalSend. I postponed the fetchNextBytecode after the immutability check, which works fine in the compiled VM. 

I think the Simulator works fine too but I might need to fix something there.

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

Item was changed:
  ----- Method: CoInterpreter>>extendedStoreBytecodePop: (in category 'stack bytecodes') -----
  extendedStoreBytecodePop: popBoolean
  	"Override to use itemporary:in:put:"
  	| descriptor variableType variableIndex value |
  	<inline: true>
  	descriptor := self fetchByte.
- 	self fetchNextBytecode.
  	variableType := descriptor >> 6 bitAnd: 3.
  	variableIndex := descriptor bitAnd: 63.
  	value := self internalStackTop.
  	popBoolean ifTrue: [ self internalPop: 1 ].
  	variableType = 0 ifTrue:
+ 		[objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value.
+ 		^ self fetchNextBytecode.].
- 		[^objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value].
  	variableType = 1 ifTrue:
+ 		[ self fetchNextBytecode.
+ 		^self itemporary: variableIndex in: localFP put: value].
- 		[^self itemporary: variableIndex in: localFP put: value].
  	variableType = 3 ifTrue:
+ 		[self storeLiteralVariable: variableIndex withValue: value.
+ 		^ self fetchNextBytecode.].
- 		[^self storeLiteralVariable: variableIndex withValue: value].
  	self error: 'illegal store'!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genImmutableCheck:slotIndex:sourceReg:scratchReg:popBoolean:needRestoreRcvr: (in category 'compile abstract instructions') -----
  genImmutableCheck: regHoldingObjectMutated slotIndex: index sourceReg: regHoldingValueToStore scratchReg: scratchReg popBoolean: popBoolean needRestoreRcvr: needRestoreRcvr
  	| mutableJump fail |
  	<var: #mutableJump type: #'AbstractInstruction *'>
  	<var: #fail type: #'AbstractInstruction *'>
  	<inline: true>
  	<option: #IMMUTABILITY>
  	"Trampoline convention: 
  	- objectMutated passed in ReceiverResultReg
  	- index (unboxed) passed in TempReg
  	- valueToStore passed in ClassReg.
  	Simulated stack is flushed until simulatedStackPointer - 1, which implies full flush 
  	if popBoolean is true, else top value may not be flushed.
  	We spill the top value (the value to store) for the trampoline if needed."
  	self assert: regHoldingObjectMutated == ReceiverResultReg. 
  	self assert: scratchReg == TempReg.
  	self assert: regHoldingValueToStore == ClassReg.
  	mutableJump := self genJumpMutable: ClassReg scratchReg: TempReg.
  	
  	"We reach this code if the object mutated is immutable."
  	"simulatedStack state altered for the trampoline, spill top value if needed"
  	(popBoolean or: [ cogit ssTop spilled ]) ifFalse:
  		[ self assert: (cogit ssTop type = SSRegister and: [cogit ssTop register = ClassReg]).
  		  cogit PushR: ClassReg ].
  	"pass the unboxed index using TempReg"
  	cogit MoveCq: index R: TempReg.
  	"trampoline call and mcpc to bcpc annotation."
  	cogit CallRT: ceCannotAssignToWithIndexTrampoline.
  	cogit annotateBytecode: cogit Label.
  	"Top of stack is consumed by the trampoline. In case of store with non spilled value, 
  	restore ClassReg to match simulated stack state"
  	(popBoolean or: [ cogit ssTop spilled ]) ifFalse:
  		[cogit popR: ClassReg].
  	"restore ReceiverResultReg state if needed"
+ 	needRestoreRcvr ifTrue: [ cogit putSelfInReceiverResultReg ].
- 	needRestoreRcvr ifTrue: [ self putSelfInReceiverResultReg ].
  	fail := cogit Jump: 0.
  	
  	"We reach this code is the object mutated is mutable"
  	mutableJump jmpTarget: cogit Label.
  	
  	^ fail!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetImmutability (in category 'object access primitives') -----
  primitiveGetImmutability
  	<option: #IMMUTABILITY>
  	| rcvr bool |
  	rcvr := self stackValue: 0.
  	bool := (objectMemory isOopImmutable: rcvr)
  		ifTrue: [ TrueObject ]
  		ifFalse: [ FalseObject ].
+ 	self pop: argumentCount + 1 thenPush: (self splObj: bool)!
- 	self pop: argumentCount thenPush: (self splObj: bool)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSetImmutability (in category 'object access primitives') -----
  primitiveSetImmutability
  	<option: #IMMUTABILITY>
  	| rcvr boolean wasImmutable |
  	rcvr := self stackValue: 1.
  	(objectMemory isImmediate: rcvr) ifTrue: [ ^ self primitiveFailFor: PrimErrInappropriate ].
  	boolean := self booleanValueOf: self stackTop.
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	boolean ifTrue: 
  		[ (self canBeImmutable: rcvr) ifFalse: [ ^ self primitiveFailFor: PrimErrInappropriate ] ]. 
  	wasImmutable := (objectMemory isOopImmutable: rcvr)
  		ifTrue: [ TrueObject ]
  		ifFalse: [ FalseObject ].
  	objectMemory setIsImmutableOf: rcvr to: boolean.
+ 	self pop: argumentCount + 1 thenPush: (self splObj: wasImmutable)!
- 	self pop: argumentCount thenPush: (self splObj: wasImmutable)!

Item was changed:
  ----- Method: StackInterpreter>>doubleExtendedDoAnythingBytecode (in category 'send bytecodes') -----
  doubleExtendedDoAnythingBytecode
  	"Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count. 
  	Here we use 3 bits for the operation sub-type (opType),  and the remaining 5 bits for argument count where needed. 
  	The last byte give access to 256 instVars or literals. 
  	See also secondExtendedSendBytecode"
  	| byte2 byte3 opType top |
  	byte2 := self fetchByte.
  	byte3 := self fetchByte.
  	opType := byte2 >> 5.
  	opType = 0 ifTrue:
  		[messageSelector := self literal: byte3.
  		 argumentCount := byte2 bitAnd: 31.
  		 ^self normalSend].
  	opType = 1 ifTrue:
  		[messageSelector := self literal: byte3.
  		 argumentCount := byte2 bitAnd: 31.
  		 ^self superclassSend].
+ 	opType = 2 ifTrue: [self fetchNextBytecode. ^self pushMaybeContextReceiverVariable: byte3].
+ 	opType = 3 ifTrue: [self fetchNextBytecode. ^self pushLiteralConstant: byte3].
+ 	opType = 4 ifTrue: [self fetchNextBytecode. ^self pushLiteralVariable: byte3].
- 	self fetchNextBytecode.
- 	opType = 2 ifTrue: [^self pushMaybeContextReceiverVariable: byte3].
- 	opType = 3 ifTrue: [^self pushLiteralConstant: byte3].
- 	opType = 4 ifTrue: [^self pushLiteralVariable: byte3].
  	top := self internalStackTop.
  	opType = 7 ifTrue:
  		[self storeLiteralVariable: byte3 withValue: top.
+ 		 ^self fetchNextBytecode].
- 		 ^self].
  	"opType = 5 is store; opType = 6 is storePop"
  	opType = 6 ifTrue:
  		[self internalPop: 1].
+ 	self storeMaybeContextReceiverVariable: byte3 withValue: top.
+ 	self fetchNextBytecode!
- 	self storeMaybeContextReceiverVariable: byte3 withValue: top!

Item was changed:
  ----- Method: StackInterpreter>>extStoreAndPopLiteralVariableBytecode (in category 'stack bytecodes') -----
  extStoreAndPopLiteralVariableBytecode
  	"236		11101100	i i i i i i i i	Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)"
  	| variableIndex value |
  	variableIndex := self fetchByte + (extA << 8).
- 	self fetchNextBytecode.
  	value := self internalStackTop.
  	self internalPop: 1.
  	extA := 0.
+ 	self storeLiteralVariable: variableIndex withValue: value.
+ 	self fetchNextBytecode.!
- 	self storeLiteralVariable: variableIndex withValue: value!

Item was changed:
  ----- Method: StackInterpreter>>extStoreAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
  extStoreAndPopReceiverVariableBytecode
  	"235		11101011	i i i i i i i i	Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)"
  	| variableIndex value |
  	variableIndex := self fetchByte + (extA << 8).
- 	self fetchNextBytecode.
  	extA := 0.
  	value := self internalStackTop.
  	self internalPop: 1.
+ 	self storeMaybeContextReceiverVariable: variableIndex withValue: value.
+ 	self fetchNextBytecode.!
- 	self storeMaybeContextReceiverVariable: variableIndex withValue: value!

Item was changed:
  ----- Method: StackInterpreter>>extStoreLiteralVariableBytecode (in category 'stack bytecodes') -----
  extStoreLiteralVariableBytecode
  	"233		11101001	i i i i i i i i	Store Literal Variable #iiiiiiii (+ Extend A * 256)"
  	| variableIndex |
  	variableIndex := self fetchByte + (extA << 8).
- 	self fetchNextBytecode.
  	extA := 0.
+ 	self storeLiteralVariable: variableIndex withValue: self internalStackTop.
+ 	self fetchNextBytecode.!
- 	self storeLiteralVariable: variableIndex withValue: self internalStackTop!

Item was changed:
  ----- Method: StackInterpreter>>extStoreReceiverVariableBytecode (in category 'stack bytecodes') -----
  extStoreReceiverVariableBytecode
  	"232		11101000	i i i i i i i i	Store Receiver Variable #iiiiiii (+ Extend A * 256)"
  	| variableIndex |
  	variableIndex := self fetchByte + (extA << 8).
- 	self fetchNextBytecode.
  	extA := 0.
+ 	self storeMaybeContextReceiverVariable: variableIndex withValue: self internalStackTop.
+ 	self fetchNextBytecode.!
- 	self storeMaybeContextReceiverVariable: variableIndex withValue: self internalStackTop!

Item was changed:
  ----- Method: StackInterpreter>>extendedStoreBytecodePop: (in category 'stack bytecodes') -----
  extendedStoreBytecodePop: popBoolean
  	| descriptor variableType variableIndex value |
  	<inline: true>
  	descriptor := self fetchByte.
- 	self fetchNextBytecode.
  	variableType := descriptor >> 6 bitAnd: 3.
  	variableIndex := descriptor bitAnd: 63.
  	value := self internalStackTop.
  	popBoolean ifTrue: [ self internalPop: 1 ].
  	variableType = 0 ifTrue:
+ 		[objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value.
+ 		^ self fetchNextBytecode].
- 		[^objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value].
  	variableType = 1 ifTrue:
+ 		[ self fetchNextBytecode.
+ 		^self temporary: variableIndex in: localFP put: value].
- 		[^self temporary: variableIndex in: localFP put: value].
  	variableType = 3 ifTrue:
+ 		[self storeLiteralVariable: variableIndex withValue: value.
+ 		^ self fetchNextBytecode].
- 		[^self storeLiteralVariable: variableIndex withValue: value].
  	self error: 'illegal store'
  !

Item was changed:
  ----- Method: StackInterpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
  storeAndPopReceiverVariableBytecode
  	| rcvr top instVarIndex |
  	rcvr := self receiver.
  	top := self internalStackTop.
  	instVarIndex := currentBytecode bitAnd: 7.
  	self internalPop: 1.
- 	self fetchNextBytecode.
  	objectMemory
  		storePointerImmutabilityCheck: instVarIndex
  		ofObject: rcvr
+ 		withValue: top.
+ 	self fetchNextBytecode.!
- 		withValue: top!



More information about the Vm-dev mailing list