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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 26 01:58:39 UTC 2014 

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

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

Name: VMMaker.oscog-eem.999
Author: eem
Time: 25 December 2014, 5:56:07.016 pm
UUID: b0fe8d34-046c-4ef4-8ca5-cdfe166c52fe
Ancestors: VMMaker.oscog-eem.998

Spur:
Fix argument count slips in three primitives.
Check for sufficient memory in two-way become.

All:
Fix checking of boolean arg in
primitiveArrayBecomeOneWayCopyHash.

Make primitiveSlotAt[Put] cope with non-pointer
objects.

Sista: Simplify genGetNumBytesOf:into:

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

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetNumBytesOf:into: (in category 'compile abstract instructions') -----
  genGetNumBytesOf: srcReg into: destReg
  	"Get the size in byte-sized slots of the object in srcReg into destReg.
  	 srcReg may equal destReg.
+ 	 destReg <- numSlots << self shiftForWord - (fmt bitAnd: 3).
+ 	 Assumes the object in srcReg has a byte format, i.e. 16 to 23 or 24 to 31 "
- 	destReg <- numSlots << self shiftForWord - (fmt bitAnd: 7)."
  	<var: #jmp type: #'AbstractInstruction'>
  	| jmp |
  	self genGetRawSlotSizeOfNonImm: srcReg into: TempReg.
  	cogit CmpCq: objectMemory numSlotsMask R: TempReg.
  	jmp := cogit JumpLess: 0.
+ 	cogit MoveMw: objectMemory wordSize negated r: srcReg R: destReg.
+ 	jmp jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg). 
- 	cogit MoveMw: objectMemory wordSize negated r: srcReg R: TempReg.
- 	jmp jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: TempReg). 
  	"Now: TempReg = numSlots << shiftForWord"
+ 	cogit MoveMw: 0 r: srcReg R: TempReg.
+ 	cogit LogicalShiftRightCq: objectMemory formatShift R: TempReg.
+ 	cogit AndCq: objectMemory wordSize - 1 R: TempReg.
+ 	"Now: fmt bitAnd: 3 in TempReg"
- 	cogit MoveMw: 0 r: srcReg R: destReg.
- 	cogit LogicalShiftRightCq: objectMemory formatShift R: destReg. 
- 	cogit AndCq: objectMemory formatMask R: destReg. 
- 	cogit AndCq: objectMemory wordSize - 1 R: destReg.
- 	"Now: fmt bitAnd: 7 in destReg"
  	cogit SubR: TempReg R: destReg.
  	^0!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveArrayBecomeOneWayCopyHash (in category 'object access primitives') -----
  primitiveArrayBecomeOneWayCopyHash
+ 	"Similar to primitiveArrayBecomeOneWay but accepts a third argument deciding whether to
+ 	 copy the receiver's element's identity hash over the argument's elementy's identity hash."
- 	"Similar to primitiveArrayBecomeOneWay but accepts a third argument whether to copy
- 	the receiver's identity hash over the argument's identity hash."
  
+ 	| copyHashFlag ec |
+ 	self stackTop = objectMemory trueObject
+ 		ifTrue: [copyHashFlag := true]
+ 		ifFalse:
+ 			[self stackTop = objectMemory falseObject
+ 				ifTrue: [copyHashFlag := false]
+ 				ifFalse:
+ 					[self primitiveFailFor: PrimErrBadArgument.
+ 					 ^nil]].
+ 	ec := objectMemory
+ 			become: (self stackValue: 2)
+ 			with: (self stackValue: 1)
+ 			twoWay: false
+ 			copyHash: copyHashFlag.
- 	| copyHashFlag arg rcvr ec |
- 	copyHashFlag := self booleanValueOf: (self stackTop).
- 	arg := self stackValue: 1.
- 	rcvr := self stackValue: 2.
- 	ec := objectMemory become: rcvr with: arg twoWay: false copyHash: copyHashFlag.
  	ec = PrimNoErr
+ 		ifTrue: [self pop: argumentCount]
- 		ifTrue: [self pop: 2]
  		ifFalse: [self primitiveFailFor: ec]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveImmediateAsInteger (in category 'arithmetic float primitives') -----
  primitiveImmediateAsInteger
  	"For a Smalnteger, answer itself.
  	 For a Character, answer its code as an unsigned integer.
  	 For a SmallFloat, answer the signed, but unadjusted bit pattern (so as to keep the result a SmallInteger).
  	 This is a good value for an immediate's hash."
  	<option: #Spur64BitMemoryManager>
  	| oop value |
  	oop := self stackTop.
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop] ifFalse:
  	[(objectMemory isCharacterObject: oop) ifTrue:
  		[value := objectMemory characterValueOf: oop] ifFalse:
  	[(objectMemory isImmediateFloat: oop) ifTrue:
  		[value := objectMemory rotatedFloatBitsOf: oop] ifFalse:
  	[^self primitiveFailFor: PrimErrBadReceiver]]].
+ 	self pop: argumentCount + 1 thenPushInteger: value!
- 	self pop: argumentCount thenPushInteger: value!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveIsPinned (in category 'memory space primitives') -----
  primitiveIsPinned
  	"Answer if the receiver is pinned, i.e. immobile."
  	| obj |
  	obj := self stackTop.
  	((objectMemory isImmediate: obj)
  	 or: [objectMemory isForwarded: obj]) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	self pop: argumentCount + 1
+ 		thenPushBool: (objectMemory hasSpurMemoryManagerAPI
+ 						and: [objectMemory booleanObjectOf: (objectMemory isPinned: obj)])!
- 	self pop: argumentCount - 1.
- 	self stackTopPut:
- 			(objectMemory hasSpurMemoryManagerAPI
- 				ifTrue: [objectMemory booleanObjectOf: (objectMemory isPinned: obj)]
- 				ifFalse: [objectMemory falseObject])!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitivePin (in category 'memory space primitives') -----
  primitivePin
  	"Pin or unpin the receiver, i.e. make it immobile or mobile, based on the argument.
  	 Answer whether the object was already pinned. N.B. pinning does *not* prevent
  	 an object from being garbage collected."
  	| obj boolean wasPinned |
  	objectMemory hasSpurMemoryManagerAPI ifFalse:
  		[^self primitiveFailFor: PrimErrUnsupported].
  
  	obj := self stackValue: 1.
  	((objectMemory isImmediate: obj)
  	 or: [(objectMemory isForwarded: obj)
  	 or: [(objectMemory isContext: obj)
  		and: [self isStillMarriedContext: obj]]]) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	boolean := self stackTop.
  	(boolean = objectMemory falseObject
  	 or: [boolean = objectMemory trueObject]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  
  	(objectMemory isPinned: obj)
  		ifTrue:
  			[wasPinned := objectMemory trueObject.
  			 objectMemory setIsPinnedOf: obj to: boolean = objectMemory trueObject]
  		ifFalse:
  			[wasPinned := objectMemory falseObject.
  			 (boolean = objectMemory trueObject
  			  and: [objectMemory pinObject: obj]) = 0 ifTrue:
  				[^self primitiveFailFor: PrimErrNoMemory]].
  	
+ 	self pop: argumentCount + 1 thenPush: wasPinned!
- 	self pop: argumentCount - 1 thenPush: wasPinned!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
  primitiveSlotAt
+ 	"Answer a slot in an object.  This numbers all slots from 1, ignoring the distinction between
+ 	 named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ 	 inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
+ 	 bits, not object references) this primitive answers the raw integral value at each slot. 
+ 	 e.g. for Strings it answers the character code, not the Character object at each slot."
+ 	| index rcvr fmt numSlots |
- 	| index rcvr numSlots |
  	index := self stackTop.
  	rcvr := self stackValue: 1.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	fmt := objectMemory formatOf: rcvr.
  	index := objectMemory integerValueOf: index.
+ 
+ 	fmt <= objectMemory lastPointerFormat ifTrue:
- 	(objectMemory isPointersNonImm: rcvr) ifTrue:
  		[numSlots := objectMemory numSlotsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1 thenPush: (objectMemory fetchPointer: index ofObject: rcvr).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	fmt >= objectMemory firstByteFormat ifTrue:
+ 		[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ 			[^self primitiveFailFor: PrimErrUnsupported].
+ 		 numSlots := objectMemory numBytesOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	(objectMemory hasSpurMemoryManagerAPI
+ 	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
+ 		[numSlots := objectMemory num16BitUnitsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr).
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
+ 		[numSlots := objectMemory num64BitUnitsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[self pop: argumentCount + 1
+ 				thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	fmt >= objectMemory firstLongFormat ifTrue:
+ 		[numSlots := objectMemory num32BitUnitsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[self pop: argumentCount + 1
+ 				thenPush: (objectMemory bytesPerOop = 8
+ 							ifTrue: [objectMemory integerObjectOf: (objectMemory fetchLong32: index ofObject: rcvr)]
+ 							ifFalse: [self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)]).
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
- 	"for now just fail for non-pointer objects; the issue here is should
- 	 strings answer characters and if so how do we efficiently identify strings?"
  	^self primitiveFailFor: PrimErrBadReceiver!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') -----
  primitiveSlotAtPut
+ 	"Assign a slot in an object.  This numbers all slots from 1, ignoring the distinction between
+ 	 named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ 	 inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
+ 	 bits, not object references) this primitive assigns a raw integral value at each slot."
+ 	| newValue index rcvr fmt numSlots value |
- 	| newValue index rcvr numSlots |
  	newValue := self stackTop.
  	index := self stackValue: 1.
  	rcvr := self stackValue: 2.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	fmt := objectMemory formatOf: rcvr.
  	index := objectMemory integerValueOf: index.
+ 
+ 	fmt <= objectMemory lastPointerFormat ifTrue:
- 	(objectMemory isPointersNonImm: rcvr) ifTrue:
  		[numSlots := objectMemory numSlotsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storePointer: index ofObject: rcvr withValue: newValue.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	value := self positiveMachineIntegerValueOf: newValue.
+ 	self failed ifTrue:
+ 		[primFailCode := PrimErrBadArgument.
+ 		^0].
+ 
+ 	fmt >= objectMemory firstByteFormat ifTrue:
+ 		[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ 			[^self primitiveFailFor: PrimErrUnsupported].
+ 		 (self asUnsigned: value) > 16rFF ifTrue:
+ 			[^self primitiveFailFor: PrimErrBadArgument].
+ 		 numSlots := objectMemory numBytesOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[objectMemory storeByte: index ofObject: rcvr withValue: value.
+ 			 self pop: argumentCount + 1 thenPush: newValue.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	(objectMemory hasSpurMemoryManagerAPI
+ 	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
+ 		[(self asUnsigned: value) > 16rFFFF ifTrue:
+ 			[^self primitiveFailFor: PrimErrBadArgument].
+ 		 numSlots := objectMemory num16BitUnitsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[objectMemory storeShort16: index ofObject: rcvr withValue: value.
+ 			 self pop: argumentCount + 1 thenPush: newValue.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	(objectMemory bytesPerOop = 8
+ 	 and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue:
+ 		[numSlots := objectMemory num64BitUnitsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[objectMemory storeLong64: index ofObject: rcvr withValue: value.
+ 			 self pop: argumentCount + 1 thenPush: newValue.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
+ 	fmt >= objectMemory firstLongFormat ifTrue:
+ 		[(objectMemory wordSize > 4
+ 		  and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue:
+ 			[^self primitiveFailFor: PrimErrBadArgument].
+ 		 numSlots := objectMemory num32BitUnitsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[objectMemory storeLong32: index ofObject: rcvr withValue: value.
+ 			 self pop: argumentCount + 1 thenPush: newValue.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 
- 	"for now just fail for non-pointer objects; the issue here is should
- 	 strings answer characters and if so how do we efficiently identify strings?"
  	^self primitiveFailFor: PrimErrBadReceiver!

Item was added:
+ ----- Method: ObjectMemory>>sixtyFourBitIndexableFormat (in category 'header formats') -----
+ sixtyFourBitIndexableFormat
+ 	^7!

Item was changed:
  ----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects:and: (in category 'become implementation') -----
  containsOnlyValidBecomeObjects: array1 and: array2
  	"Answer 0 if neither array contains only unpinned non-immediates.
  	 Otherwise answer an informative error code.
  	 Can't become: immediates!!  Shouldn't become pinned objects."
+ 	| fieldOffset effectsFlags oop size |
- 	| fieldOffset effectsFlags oop |
  	fieldOffset := self lastPointerOf: array1.
+ 	effectsFlags := size := 0.
- 	effectsFlags := 0.
  	"same size as array2"
  	[fieldOffset >= self baseHeaderSize] whileTrue:
  		[oop := self longAt: array1 + fieldOffset.
  		 (self isOopForwarded: oop) ifTrue:
  			[oop := self followForwarded: oop.
  			 self longAt: array1 + fieldOffset put: oop].
  		 (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  		 (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  		 effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ 		 size := size + (self bytesInObject: oop).
  		 oop := self longAt: array2 + fieldOffset.
  		 (self isOopForwarded: oop) ifTrue:
  			[oop := self followForwarded: oop.
  			 self longAt: array2 + fieldOffset put: oop].
  		 (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  		 (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  		 effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ 		 size := size + (self bytesInObject: oop).
  		 fieldOffset := fieldOffset - self bytesPerOop].
  	"only set flags after checking all args."
  	becomeEffectsFlags := effectsFlags.
+ 	size >= (totalFreeOldSpace + (scavengeThreshold - freeStart)) ifTrue:
+ 		[^PrimErrNoMemory].
  	^0!

More information about the Vm-dev mailing list