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

commits at source.squeak.org commits at source.squeak.org
Tue Dec 10 23:39:49 UTC 2013


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

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

Name: VMMaker.oscog-eem.553
Author: eem
Time: 10 December 2013, 3:37:36.465 pm
UUID: e5f0c922-4c60-4124-9366-5f9492795a67
Ancestors: VMMaker.oscog-eem.552

Fix a bug in BitBltPlugin>>lockSurfaces.

Fix Spur genInnerPrimitiveAtPut:.

Fix bug in followForwardedMethods (add cogMethod to
youngReferrers, not its bytecoded method).

Add development-time-only asserts to check that jumps don't have
their targets assigned more than once.

Fix assert-fail in old space enumeration.  Requires that free chunks
be marked as having at least 1 slot.

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

Item was changed:
  ----- Method: BitBltSimulation>>lockSurfaces (in category 'surface support') -----
  lockSurfaces
  	"Get a pointer to the bits of any OS surfaces."
  	"Notes: 
  	* For equal source/dest handles only one locking operation is performed.
  	This is to prevent locking of overlapping areas which does not work with
  	certain APIs (as an example, DirectDraw prevents locking of overlapping areas). 
  	A special case for non-overlapping but equal source/dest handle would 
  	be possible but we would have to transfer this information over to 
  	unlockSurfaces somehow (currently, only one unlock operation is 
  	performed for equal source and dest handles). Also, this would require
  	a change in the notion of ioLockSurface() which is right now interpreted
  	as a hint and not as a requirement to lock only the specific portion of
  	the surface.
  
  	* The arguments in ioLockSurface() provide the implementation with
  	an explicit hint what area is affected. It can be very useful to
  	know the max. affected area beforehand if getting the bits requires expensive
  	copy operations (e.g., like a roundtrip to the X server or a glReadPixel op).
  	However, the returned pointer *MUST* point to the virtual origin of the surface
  	and not to the beginning of the rectangle. The promise made by BitBlt
  	is to never access data outside the given rectangle (aligned to 4byte boundaries!!)
  	so it is okay to return a pointer to the virtual origin that is actually outside
  	the valid memory area.
  
  	* The area provided in ioLockSurface() is already clipped (e.g., it will always
  	be inside the source and dest boundingBox) but it is not aligned to word boundaries
  	yet. It is up to the support code to compute accurate alignment if necessary.
  
  	* Warping always requires the entire source surface to be locked because
  	there is no beforehand knowledge about what area will actually be traversed.
  
  	"
  	| sourceHandle destHandle l r t b fn |
  	<inline: true>
  	<var: #fn declareC:'sqInt (*fn)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'>
  	hasSurfaceLock := false.
  	destBits = 0 ifTrue:["Blitting *to* OS surface"
  		lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
  		fn := self cCoerce: lockSurfaceFn to: 'sqInt (*)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'.
  		destHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: destForm.
  		(sourceBits = 0 and:[noSource not]) ifTrue:[
  			sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
  			"Handle the special case of equal source and dest handles"
  			(sourceHandle = destHandle) ifTrue:[
  				"If we have overlapping source/dest we lock the entire area
  				so that there is only one area transmitted"
  				isWarping ifFalse:[
  					"When warping we always need the entire surface for the source"
  					sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0,0, sourceWidth, sourceHeight)'.
  				] ifTrue:[
  					"Otherwise use overlapping area"
  					l := sx min: dx. r := (sx max: dx) + bbW.
+ 					t := sy min: dy. b := (sy max: dy) + bbH.
- 					t := sy min: dy. b := (sy max: sy) + bbH.
  					sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, l, t, r-l, b-t)'.
  				].
  				destBits := sourceBits.
  				destPitch := sourcePitch.
  				hasSurfaceLock := true.
  				^destBits ~~ 0
  			].
  			"Fall through - if not equal it'll be handled below"
  		].
  		destBits := self cCode:'fn(destHandle, &destPitch, dx, dy, bbW, bbH)'.
  		hasSurfaceLock := true.
  	].
  	(sourceBits == 0 and:[noSource not]) ifTrue:["Blitting *from* OS surface"
  		sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
  		lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
  		fn := self cCoerce: lockSurfaceFn to: 'sqInt (*)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'.
  		"Warping requiring the entire surface"
  		isWarping ifTrue:[
  			sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0, 0, sourceWidth, sourceHeight)'.
  		] ifFalse:[
  			sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, sx, sy, bbW, bbH)'.
  		].
  		hasSurfaceLock := true.
  	].
  	^destBits ~~ 0 and:[sourceBits ~~ 0 or:[noSource]].!

Item was changed:
  ----- Method: CogAbstractInstruction>>jmpTarget: (in category 'accessing') -----
  jmpTarget: anAbstractInstruction
  	"Set the target of a jump instruction.  These all have the target in the first operand."
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #anAbstractInstruction type: #'AbstractInstruction *'>
+ 	self cCode: [] "check for inadvertent smashing of already-set jmpTargets; development only"
+ 		inSmalltalk: [self assert: ((operands at: 0)
+ 									ifNil: [true]
+ 									ifNotNil: [:o| o = 0 or: [self isAFixup: o]])].
  	operands at: 0 put: anAbstractInstruction asUnsignedInteger.
  	^anAbstractInstruction!

Item was changed:
  ----- Method: CogIA32Compiler>>jmpTarget: (in category 'accessing') -----
  jmpTarget: anAbstractInstruction
  	"Set the target of a jump instruction.  These all have the target in the first operand.
  	 Override to cope with JumpFPNotEqual where because if IEEE NaN conformance and
  	 the behaviour of COMISD/UCOMISD we generate two jumps to the same target."
- 	<returnTypeC: #'AbstractInstruction *'>
- 	<var: #anAbstractInstruction type: #'AbstractInstruction *'>
  	| aDependent |
  	<var: #aDependent type: #'AbstractInstruction *'>
  	aDependent := dependent.
  	[aDependent notNil] whileTrue:
  		[aDependent jmpTarget: anAbstractInstruction.
  		 aDependent := aDependent dependent].
+ 	^super jmpTarget: anAbstractInstruction!
- 	operands at: 0 put: anAbstractInstruction asUnsignedInteger.
- 	^anAbstractInstruction!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAt: (in category 'primitive generators') -----
  genInnerPrimitiveAt: retNoffset
  	"Implement the guts of primitiveAt"
  	| formatReg jumpNotIndexable jumpSmallSize jumpImmediate jumpBadIndex
  	  jumpBytesDone jumpShortsDone jumpWordsDone jumpFixedFieldsDone
  	  jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
  	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
  	<inline: true>
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpIsShorts type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpSmallSize type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpBytesDone type: #'AbstractInstruction *'>
  	<var: #jumpShortsDone type: #'AbstractInstruction *'>
  	<var: #jumpWordsDone type: #'AbstractInstruction *'>
  	<var: #jumpWordTooBig type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
  	<var: #jumpFixedFieldsDone type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
  
  	cogit MoveR: ReceiverResultReg R: TempReg.
  	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
  	cogit MoveR: Arg0Reg R: TempReg.
  	cogit MoveR: Arg0Reg R: Arg1Reg.
  	jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
  	cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
  
  	formatReg := SendNumArgsReg.
  	cogit
  		MoveMw: 0 r: ReceiverResultReg R: formatReg;		"formatReg := least significant half of self baseHeader: receiver"
  		MoveR: formatReg R: TempReg;
  		LogicalShiftRightCq: objectMemory formatShift R: formatReg;
  		AndCq: objectMemory formatMask R: formatReg.	"formatReg := self formatOfHeader: destReg"
  
  	"get numSlots into ClassReg."
  	cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
  	cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
  	cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
  	jumpSmallSize := cogit JumpBelow: 0.
  	cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	jumpSmallSize jmpTarget:
  					(cogit CmpCq: objectMemory firstByteFormat R: formatReg).
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpIsArray := cogit JumpZero: 0.
  	jumpNotIndexable := cogit JumpBelow: 0.
  					cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpIsShorts := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	jumpIsWords := cogit JumpAboveOrEqual: 0.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexable jmpTarget: cogit Label.
  	jumpNotIndexable := cogit Jump: 0.
  
  	jumpIsBytes jmpTarget:
  		(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
  		cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  		cogit SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
  	cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
  	self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
  	jumpBytesDone := cogit Jump: 0.
  
  	jumpIsShorts jmpTarget:
  		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
  		cogit AndCq: 1 R: formatReg.
  		cogit SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: Arg1Reg R: ReceiverResultReg.
  	cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
  	self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
  	jumpShortsDone := cogit Jump: 0.
  
  	jumpIsWords jmpTarget:
  		(cogit CmpR: Arg1Reg R: ClassReg).
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
  	cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
  	cogit MoveR: TempReg R: ReceiverResultReg.
  	self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
  	jumpWordsDone := cogit Jump: 0.
  
  	jumpHasFixedFields jmpTarget:
  		(cogit AndCq: objectMemory classIndexMask R: TempReg).
- 	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
  	cogit MoveR: TempReg R: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
  	jumpIsContext := cogit JumpZero: 0.
  	cogit PushR: ClassReg.
  	self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
  	cogit PopR: ClassReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit
  		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
  		SubR: formatReg R: ClassReg;
  		CmpR: Arg1Reg R: ClassReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	"index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
  	cogit AddR: formatReg R: Arg1Reg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
  	jumpFixedFieldsDone := cogit Jump: 0.
  
  	jumpIsArray jmpTarget:
  		(cogit CmpR: Arg1Reg R: ClassReg).
  	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
  
  	jumpFixedFieldsDone jmpTarget:
  	(jumpWordsDone jmpTarget:
  	(jumpShortsDone jmpTarget:
  	(jumpBytesDone jmpTarget:
  		(cogit RetN: retNoffset)))).
  
  	jumpFixedFieldsOutOfBounds jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsOutOfBounds jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpWordTooBig jmpTarget:
  	(jumpNotIndexable jmpTarget:
  	(jumpIsContext jmpTarget:
  	(jumpBadIndex jmpTarget:
  	(jumpImmediate jmpTarget: cogit Label))))))))).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAtPut: (in category 'primitive generators') -----
  genInnerPrimitiveAtPut: retNoffset
  	"Implement the guts of primitiveAtPut"
+ 	| formatReg jumpImmediate jumpBadIndex
+ 	  jumpSmallSize jumpNotIndexablePointers jumpNotIndexableBits
+ 	  jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpHasFixedFields
+ 	  jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
+ 	  jumpWordsOutOfBounds jumpBytesOutOfBounds jumpBytesOutOfRange
+ 	  jumpNonSmallIntegerValue jumpShortsUnsupported jumpNotPointers
+ 	  |
- 	| formatReg jumpNotIndexable jumpSmallSize jumpImmediate jumpBadIndex
- 	  jumpArrayDone jumpBytesDone jumpWordsDone jumpBytesOutOfRange
- 	  jumpIsBytes jumpIsWords jumpIsPointers jumpHasFixedFields jumpIsContext jumpIsCompiledMethod
- 	  jumpBytesOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
- 	  jumpNonSmallIntegerValue jumpShortsUnsupported |
  	<inline: true>
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
- 	<var: #jumpIsShorts type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpSmallSize type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
- 	<var: #jumpArrayDone type: #'AbstractInstruction *'>
- 	<var: #jumpBytesDone type: #'AbstractInstruction *'>
- 	<var: #jumpWordsDone type: #'AbstractInstruction *'>
- 	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
- 	<var: #jumpPointersDone type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
+ 	<var: #jumpNotIndexableBits type: #'AbstractInstruction *'>
- 	<var: #jumpFixedFieldsDone type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsUnsupported type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpNotIndexablePointers type: #'AbstractInstruction *'>
- 	<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
  
- 	true ifTrue: [^cogit unimplementedPrimitive].
  	cogit MoveR: ReceiverResultReg R: TempReg.
  	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
  	cogit MoveR: Arg0Reg R: TempReg.
  	jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
  
  	formatReg := SendNumArgsReg.
  	cogit
  		MoveMw: 0 r: ReceiverResultReg R: formatReg;		"formatReg := least significant half of self baseHeader: receiver"
  		MoveR: formatReg R: TempReg;
  		LogicalShiftRightCq: objectMemory formatShift R: formatReg;
  		AndCq: objectMemory formatMask R: formatReg.	"formatReg := self formatOfHeader: destReg"
  
  	"get numSlots into ClassReg."
  	cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
  	cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
  	cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
  	jumpSmallSize := cogit JumpBelow: 0.
  	cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	jumpSmallSize jmpTarget:
  					(cogit CmpCq: objectMemory weakArrayFormat R: formatReg).
+ 	jumpNotPointers := cogit JumpAbove: 0.
+ 	"optimistic store check; assume index in range (almost always is)."
+ 	self genStoreCheckReceiverReg: ReceiverResultReg valueReg: Arg1Reg scratchReg: TempReg.
+ 
+ 	cogit CmpCq: objectMemory arrayFormat R: formatReg.
+ 	jumpNotIndexablePointers := cogit JumpBelow: 0.
+ 	jumpHasFixedFields := cogit JumpNonZero: 0.
+ 	cogit CmpR: Arg0Reg R: ClassReg.
+ 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ 	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
+ 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ 	cogit RetN: retNoffset.
+ 
+ 	jumpHasFixedFields jmpTarget: cogit Label.
+ 	self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
+ 	cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
+ 	jumpIsContext := cogit JumpZero: 0.
+ 	"get # fixed fields in formatReg"
+ 	cogit PushR: ClassReg.
+ 	self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
+ 	self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
+ 	cogit PopR: ClassReg.
+ 	self genConvertSmallIntegerToIntegerInReg: formatReg.
+ 	cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
+ 	cogit SubR: formatReg R: ClassReg.
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
+ 	cogit CmpR: Arg0Reg R: ClassReg.
+ 	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit AddR: formatReg R: Arg0Reg.
+ 	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
+ 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ 	cogit RetN: retNoffset.
+ 
+ 	jumpNotPointers jmpTarget:
+ 		(cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg).
- 	jumpIsPointers := cogit JumpBelowOrEqual: 0.
- 					cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
  	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	jumpNonSmallIntegerValue := self genJumpNotSmallIntegerInScratchReg: TempReg.
  					cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ 	jumpIsBytes := cogit JumpAboveOrEqual: 0.
- 	jumpIsBytes := cogit JumpGreaterOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ 	jumpShortsUnsupported := cogit JumpAboveOrEqual: 0.
- 	jumpShortsUnsupported := cogit JumpGreaterOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
- 	jumpIsWords := cogit JumpGreaterOrEqual: 0.
  	"For now ignore 64-bit indexability."
+ 	jumpNotIndexableBits := cogit JumpBelow: 0.
- 	jumpNotIndexable := cogit Jump: 0.
  
+ 	cogit CmpR: Arg0Reg R: ClassReg.
+ 	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit MoveR: Arg1Reg R: TempReg.
+ 	self genConvertSmallIntegerToIntegerInReg: TempReg.
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ 	cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
+ 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ 	cogit RetN: retNoffset.
+ 
  	jumpIsBytes jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg).
  	jumpBytesOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
  	cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg;
  	CmpR: Arg0Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  	cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ 	cogit RetN: retNoffset.
- 	jumpBytesDone := cogit Jump: 0.
  
  	"there are no shorts as yet.  so this is dead code:
  	jumpIsShorts jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
  	jumpShortsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	cogit AndCq: 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg;
  	CmpR: Arg0Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	cogit genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	jumpShortsDone := cogit Jump: 0."
  
- 	jumpIsWords jmpTarget:
- 		(cogit CmpR: Arg0Reg R: ClassReg).
- 	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
- 	cogit MoveR: Arg1Reg R: TempReg.
- 	self genConvertSmallIntegerToIntegerInReg: TempReg.
- 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- 	cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
- 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
- 	jumpWordsDone := cogit Jump: 0.
- 
- 	jumpIsPointers jmpTarget: cogit Label.
- 	"optimistic store check; assume index in range (almost always is)."
- 	self genStoreCheckReceiverReg: ReceiverResultReg valueReg: Arg1Reg scratchReg: TempReg.
- 
- 	cogit CmpCq: objectMemory arrayFormat R: formatReg.
- 	jumpHasFixedFields := cogit JumpNonZero: 0.
- 
- 	cogit CmpR: Arg0Reg R: ClassReg.
- 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
- 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- 	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
- 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
- 	jumpArrayDone := cogit Jump: 0.
- 
- 	jumpHasFixedFields jmpTarget:
- 		(cogit AndCq: objectMemory classIndexMask R: TempReg).
- 	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
- 	cogit MoveR: TempReg R: formatReg.
- 	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
- 	jumpIsContext := cogit JumpZero: 0.
- 	cogit PushR: ClassReg.
- 	self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
- 	self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
- 	cogit PopR: ClassReg.
- 	self genConvertSmallIntegerToIntegerInReg: formatReg.
- 	cogit
- 		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
- 		SubR: formatReg R: ClassReg;
- 		CmpR: Arg0Reg R: ClassReg.
- 	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
- 	"index is (formatReg (fixed fields) + Arg0Reg (0-rel index)) * wordSize + baseHeaderSize"
- 	cogit AddR: formatReg R: Arg0Reg.
- 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- 	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
- 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
- 	"fall through"
- 
- 	jumpArrayDone jmpTarget:
- 	(jumpBytesDone jmpTarget:
- 	(jumpWordsDone jmpTarget:
- 		(cogit RetN: retNoffset))).
- 
  	jumpIsContext jmpTarget: 
+ 	(jumpNotIndexableBits jmpTarget:
- 	(jumpNotIndexable jmpTarget:
  	(jumpBytesOutOfRange jmpTarget:
  	(jumpIsCompiledMethod jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsUnsupported jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
+ 	(jumpNotIndexablePointers jmpTarget:
  	(jumpNonSmallIntegerValue jmpTarget:
+ 	(jumpFixedFieldsOutOfBounds jmpTarget: cogit Label)))))))))).
- 	(jumpFixedFieldsOutOfBounds jmpTarget:cogit Label))))))))).
  
  	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  	self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
  
  	jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveStringAtPut: (in category 'primitive generators') -----
  genInnerPrimitiveStringAtPut: retNoffset
  	"Implement the guts of primitiveStringAtPut"
  	| formatReg jumpSmallSize jumpImmediate jumpBadIndex jumpBadArg
  	  jumpWordsDone jumpBytesOutOfRange
  	  jumpIsBytes jumpNotString jumpIsCompiledMethod
  	  jumpBytesOutOfBounds jumpWordsOutOfBounds jumpShortsUnsupported |
  	<inline: true>
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpBadArg type: #'AbstractInstruction *'>
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpSmallSize type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpWordsDone type: #'AbstractInstruction *'>
- 	<var: #jumpPointersDone type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsUnsupported type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
  
  	cogit MoveR: ReceiverResultReg R: TempReg.
  	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
  	cogit MoveR: Arg0Reg R: TempReg.
  	jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
  	cogit MoveR: Arg1Reg R: TempReg.
  	jumpBadArg := self genJumpNotCharacterInScratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
  
  	formatReg := SendNumArgsReg.
  	cogit
  		MoveMw: 0 r: ReceiverResultReg R: formatReg;		"formatReg := least significant half of self baseHeader: receiver"
  		MoveR: formatReg R: TempReg;
  		LogicalShiftRightCq: objectMemory formatShift R: formatReg;
  		AndCq: objectMemory formatMask R: formatReg.	"formatReg := self formatOfHeader: destReg"
  
  	"get numSlots into ClassReg."
  	cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
  	cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
  	cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
  	jumpSmallSize := cogit JumpBelow: 0.
  	cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
  
  	"dispatch on format; words and/or bytes.
  		  0 to 8 = pointer objects, forwarders, reserved.
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable (but unused)
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	jumpSmallSize jmpTarget:
  					(cogit CmpCq: objectMemory firstLongFormat R: formatReg).
  	jumpNotString := cogit JumpBelowOrEqual: 0.
  					cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
  	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpGreaterOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpShortsUnsupported := cogit JumpGreaterOrEqual: 0.
  
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	jumpWordsDone := cogit Jump: 0.
  
  	"there are no shorts as yet.  so this is dead code:
  	jumpIsShorts jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
  	jumpShortsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	cogit AndCq: 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg;
  	CmpR: Arg0Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	cogit genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	jumpShortsDone := cogit Jump: 0."
  
  	jumpIsBytes jmpTarget:
  		(cogit CmpCq: (objectMemory characterObjectOf: 255) R: Arg1Reg).
  	jumpBytesOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
  	cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg;
  	CmpR: Arg0Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertCharacterToCodeInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  	cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  
  	jumpWordsDone jmpTarget:
  		(cogit RetN: retNoffset).
  
  	jumpBadArg jmpTarget:
- 	(jumpBadIndex jmpTarget:
  	(jumpNotString jmpTarget:
  	(jumpBytesOutOfRange jmpTarget:
  	(jumpIsCompiledMethod jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsUnsupported jmpTarget:
+ 	(jumpWordsOutOfBounds jmpTarget: cogit Label)))))).
- 	(jumpWordsOutOfBounds jmpTarget: cogit Label))))))).
  
  	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  	self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
  
  	jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
  
  	^0!

Item was changed:
  ----- Method: Cogit>>followForwardedMethods (in category 'garbage collection') -----
  followForwardedMethods
  	<api>
  	<option: #SpurObjectMemory>
  	<var: #cogMethod type: #'CogMethod *'>
  	| cogMethod freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	freedPIC := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod ifTrue:
  			[(objectMemory shouldRemapOop: cogMethod methodObject) ifTrue:
  				[cogMethod methodObject: (objectMemory remapObj: cogMethod methodObject).
  				 (cogMethod cmRefersToYoung not
  				  and: [objectMemory isYoungObject: cogMethod methodObject]) ifTrue:
+ 					[methodZone addToYoungReferrers: cogMethod]]].
- 					[methodZone addToYoungReferrers: cogMethod methodObject]]].
  		 cogMethod cmType = CMClosedPIC ifTrue:
  			[(self mapObjectReferencesInClosedPIC: cogMethod) ifTrue:
  				[freedPIC := true.
  				 methodZone freeMethod: cogMethod]].
  		 cogMethod := methodZone methodAfter: cogMethod].
  	freedPIC ifTrue:
  		[self unlinkSendsToFree.
  		 processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
  bytesInObject: objOop
  	"Answer the total number of bytes in an object including header and possible overflow size header."
  	<returnTypeC: #usqLong>
  	| headerNumSlots numSlots |
+ 	headerNumSlots := self rawNumSlotsOf: objOop.
- 	headerNumSlots := self rawNumSlotsOf: objOop..
  	numSlots := headerNumSlots = self numSlotsMask
  					ifTrue: [self longAt: objOop - self baseHeaderSize]
  					ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
  	^numSlots + (numSlots bitAnd: 1) << self shiftForWord
  	+ (headerNumSlots = self numSlotsMask
  		ifTrue: [self baseHeaderSize + self baseHeaderSize]
  		ifFalse: [self baseHeaderSize])!

Item was changed:
  ----- Method: SpurMemoryManager>>allExistingOldSpaceObjectsDo: (in category 'object enumeration') -----
  allExistingOldSpaceObjectsDo: aBlock
  	"Enumerate all old space objects, excluding any objects created
  	 during the execution of allExistingOldSpaceObjectsDo:."
  	<inline: true>
  	| oldSpaceLimit prevObj prevPrevObj objOop |
  	prevPrevObj := prevObj := nil.
  	objOop := self firstObject.
  	oldSpaceLimit := endOfMemory.
  	[self assert: objOop \\ self allocationUnit = 0.
  	 self oop: objOop isLessThan: oldSpaceLimit] whileTrue:
+ 		[(self isEnumerableObject: objOop) ifTrue:
- 		[self assert: (self longLongAt: objOop) ~= 0.
- 		 (self isEnumerableObject: objOop) ifTrue:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: oldSpaceLimit].
  	self touch: prevPrevObj.
  	self touch: prevObj!

Item was changed:
  ----- Method: SpurMemoryManager>>freeSmallObject: (in category 'free space') -----
  freeSmallObject: objOop
+ 	"Free a small object.  The wrinkle here is that we don't tolerate a zero-slot
+ 	 count in a free object so that the (self longLongAt: objOop) ~= 0 assert in
+ 	 isEnumerableObject: isn't triggered."
+ 		 
+ 	| headerNumSlots bytes index |
+ 	headerNumSlots := self rawNumSlotsOf: objOop.
+ 	headerNumSlots = 0
+ 		ifTrue:
+ 			[self setRawNumSlotsOf: objOop to: 1.
+ 			 index := self baseHeaderSize + self allocationUnit / self allocationUnit]
+ 		ifFalse:
+ 			[bytes := self bytesInObject: objOop.
+ 			 index := bytes / self allocationUnit.
+ 			 self assert: index < self numFreeLists].
- 	| bytes index |
- 	bytes := self bytesInObject: objOop.
- 	index := bytes / self allocationUnit.
- 	self assert: index < self numFreeLists.
  	self setFree: objOop. 
  	self storePointer: self freeChunkNextIndex ofFreeChunk: objOop withValue: (freeLists at: index).
+ 	freeLists at: index put: objOop!
- 	freeLists at: index put: objOop.!

Item was changed:
  ----- Method: SpurMemoryManager>>isEnumerableObject: (in category 'object enumeration') -----
  isEnumerableObject: objOop
  	"Answer if objOop should be included in an allObjects...Do: enumeration.
  	 Non-objects should be excluded; these are bridges and free chunks."
  	| classIndex |
  	<inline: true>
  	classIndex := self classIndexOf: objOop.
+ 	self assert: ((self longLongAt: objOop) ~= 0
+ 				  and: [classIndex < (numClassTablePages * self classTablePageSize)]).
- 	self assert: (classIndex >= 0 and: [classIndex < (numClassTablePages * self classTablePageSize)]).
  	^classIndex >= self isForwardedObjectClassIndexPun!

Item was added:
+ ----- Method: SpurMemoryManager>>setRawNumSlotsOf:to: (in category 'free space') -----
+ setRawNumSlotsOf: objOop to: n
+ 	"Private to free space. See freeSmallObject:"
+ 	self flag: #endian.
+ 	self byteAt: objOop + 7 put: n!



More information about the Vm-dev mailing list