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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 7 13:00:29 UTC 2014


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

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

Name: VMMaker.oscog-eem.845
Author: eem
Time: 7 August 2014, 5:57:59.331 am
UUID: d9eb7c70-0744-4da6-b629-1df02ca17337
Ancestors: VMMaker.oscog-eem.844

Cogits:
Implement genExtTrapIfNotInstanceOfBehaviorsBytecode
for 32 bit Spur.

Eliminate classFloatCompactIndex and just use
ClassFloatCompactIndex directly.

Simulator:
Move the facade's numSlotsOf: up.

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

Item was changed:
  CogClass subclass: #CogObjectRepresentation
  	instanceVariableNames: 'cogit methodZone objectMemory coInterpreter ceStoreCheckTrampoline'
  	classVariableNames: ''
+ 	poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMSqueakClassIndices VMStackFrameOffsets'
- 	poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  
  !CogObjectRepresentation commentStamp: '<historical>' prior: 0!
  I am an abstract superclass for object representations whose job it is to generate abstract instructions for accessing objects.  It is hoped that this level of indirection between the Cogit code generator and object access makes it easier to adapt the code generator to different garbage collectors, object representations and languages.!

Item was added:
+ ----- Method: CogObjectRepresentation>>genCmpClassFloatCompactIndexR: (in category 'compile abstract instructions') -----
+ genCmpClassFloatCompactIndexR: reg
+ 	^cogit CmpCq: ClassFloatCompactIndex R: SendNumArgsReg.!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>branchIfInstanceOfBehavior:branches: (in category 'in-line cacheing') -----
+ branchIfInstanceOfBehavior: classObj branches: branches
+ 	"Generate a branch if ReceiverResultReg is an instance of classObj, otherwise fall-
+ 	 through. Store the branch in branches and answer the number of branches generated."
+ 	<var: #branches type: #'AbstractInstruction *'>
+ 	| jmpImmediate classIndex |
+ 	<var: #jmpImmediate type: #'AbstractInstruction *'>
+ 	classIndex := objectMemory classTagForClass: classObj.
+ 	cogit MoveR: ReceiverResultReg R: TempReg.
+ 	(objectMemory isImmediateClass: classObj)
+ 		ifTrue:
+ 			[classIndex = objectMemory smallIntegerTag ifTrue:
+ 				[jmpImmediate := self genJumpSmallIntegerInScratchReg: TempReg].
+ 			 classIndex = objectMemory characterTag ifTrue:
+ 				[jmpImmediate := self genJumpCharacterInScratchReg: TempReg].
+ 			 branches at: 0 put: jmpImmediate]
+ 		ifFalse:
+ 			[jmpImmediate := self genJumpImmediateInScratchReg: TempReg.
+ 			 self genGetClassIndexOfNonImm: ReceiverResultReg into: TempReg.
+ 			 self genCmpClassIndex: classIndex R: TempReg.
+ 			 branches at: 0 put: (cogit JumpZero: 0).
+ 			 jmpImmediate jmpTarget: cogit Label].
+ 	^1!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>branchIfInstanceOfBehaviors:branches: (in category 'in-line cacheing') -----
+ branchIfInstanceOfBehaviors: arrayObj branches: branches
+ 	"Generate a branch if ReceiverResultReg is an instance of any of the classes in arrayObj,
+ 	 otherwise fall-through. Store the branch in branches and answer the number of branches
+ 	 generated."
+ 
+ 	<var: #branches type: #'AbstractInstruction *'>
+ 	| allImmediate noneImmediate immediateMask numNonImmediates classObj jmpNoMatch jmpImmediate branchIndex classIndex |
+ 	<var: #jmpNoMatch type: #'AbstractInstruction *'>
+ 	<var: #jmpImmediate type: #'AbstractInstruction *'>
+ 	branchIndex := 0.
+ 	"let me tell you all about it, let me falsify"
+ 	allImmediate := true. noneImmediate := true. immediateMask := 0. numNonImmediates := 0.
+ 	0 to: (objectMemory numSlotsOf: arrayObj) - 1 do:
+ 		[:i|
+ 		 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
+ 		 (objectMemory isImmediateClass: classObj)
+ 			ifTrue:
+ 				[noneImmediate := false.
+ 				 immediateMask := immediateMask + (objectMemory classTagForClass: classObj)]
+ 			ifFalse:
+ 				[allImmediate := false.
+ 				 numNonImmediates := numNonImmediates + 1]].
+ 
+ 	noneImmediate ifTrue:
+ 		[cogit MoveR: ReceiverResultReg R: TempReg.
+ 		 jmpImmediate := self genJumpImmediateInScratchReg: TempReg.
+ 		 self genGetCompactClassIndexNonImmOf: ReceiverResultReg into: TempReg.
+ 		 0 to: (objectMemory numSlotsOf: arrayObj) - 1 do:
+ 			[:i|
+ 			 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
+ 			 self genCmpClassIndex: (objectMemory classTagForClass: classObj) R: TempReg.
+ 			 branches at: branchIndex put: (cogit JumpZero: 0).
+ 			 branchIndex := branchIndex + 1].
+ 		 jmpImmediate jmpTarget: cogit Label].
+ 
+ 	allImmediate ifTrue:
+ 		[immediateMask = objectMemory tagMask
+ 			ifTrue:
+ 				[jmpImmediate := self genJumpImmediateInScratchReg: TempReg.
+ 				 branches at: branchIndex put: jmpImmediate.
+ 				 branchIndex := branchIndex + 1]
+ 			ifFalse:
+ 				[0 to: (objectMemory numSlotsOf: arrayObj) - 1 do:
+ 					[:i|
+ 					 cogit MoveR: ReceiverResultReg R: TempReg.
+ 					 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
+ 					 classIndex := objectMemory classTagForClass: classObj.
+ 					 classIndex = objectMemory smallIntegerTag ifTrue:
+ 						[jmpImmediate := self genJumpSmallIntegerInScratchReg: TempReg].
+ 					 classIndex = objectMemory characterTag ifTrue:
+ 						[jmpImmediate := self genJumpCharacterInScratchReg: TempReg].
+ 					 branches at: branchIndex put: jmpImmediate.
+ 					 branchIndex := branchIndex + 1]]].
+ 
+ 	(allImmediate or: [noneImmediate]) ifFalse:
+ 		[cogit MoveR: ReceiverResultReg R: TempReg.
+ 		 jmpImmediate := self genJumpImmediateInScratchReg: TempReg.
+ 		 self genGetCompactClassIndexNonImmOf: ReceiverResultReg into: TempReg.
+ 		 0 to: (objectMemory numSlotsOf: arrayObj) - 1 do:
+ 			[:i|
+ 			 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
+ 			 (objectMemory isImmediateClass: classObj) ifFalse:
+ 			 	[self genCmpClassIndex: (objectMemory classTagForClass: classObj) R: TempReg.
+ 				 branches at: branchIndex put: (cogit JumpZero: 0).
+ 				 branchIndex := branchIndex + 1]].
+ 		 jmpNoMatch := cogit Jump: 0.
+ 		 jmpImmediate jmpTarget: cogit Label.
+ 		 0 to: (objectMemory numSlotsOf: arrayObj) - 1 do:
+ 			[:i|
+ 			 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
+ 			 (objectMemory isImmediateClass: classObj) ifTrue:
+ 			 	["first time through TempReg already contains tag pattern, so no need to reload it."
+ 				 branchIndex > numNonImmediates ifTrue:
+ 					[cogit MoveR: ReceiverResultReg R: TempReg].
+ 				 classIndex := objectMemory classTagForClass: classObj.
+ 				 classIndex = objectMemory smallIntegerTag ifTrue:
+ 					[jmpImmediate := self genJumpSmallIntegerInScratchReg: TempReg].
+ 				 classIndex = objectMemory characterTag ifTrue:
+ 					[jmpImmediate := self genJumpCharacterInScratchReg: TempReg].
+ 				 branches at: branchIndex put: jmpImmediate.
+ 				 branchIndex := branchIndex + 1]].
+ 		 jmpNoMatch jmpTarget: cogit Label].
+ 
+ 	self assert: branchIndex <= (objectMemory numSlotsOf: arrayObj).
+ 	^branchIndex!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genCmpClassIndex:R: (in category 'in-line cacheing') -----
+ genCmpClassIndex: classIndex R: reg
+ 	"It is safe to use a short comparison for the known classes; these will not
+ 	 change with become, etc... But it's probably not safe to assume the hash of
+ 	 some other class won't change over time, so to be sure of generating the
+ 	 same size code over time, use a long comparison for unknown classes."
+ 	classIndex < objectMemory classTablePageSize
+ 		ifTrue: [cogit CmpCq: classIndex R: TempReg]
+ 		ifFalse: [cogit CmpCw: classIndex R: TempReg].!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>inlineCacheTagForClass: (in category 'in-line cacheing') -----
  inlineCacheTagForClass: classOop
  	"Answer the relevant inline cache tag for a class.
  	 c.f. inlineCacheTagForInstance:"
  	| hash |
+ 	hash := objectMemory classTagForClass: classOop.
- 	hash := objectMemory ensureBehaviorHash: classOop.
  	^hash <= objectMemory tagMask
  		ifTrue: [hash bitAnd: 1]
  		ifFalse: [hash]!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>inlineCacheTagForClass: (in category 'in-line cacheing') -----
  inlineCacheTagForClass: classOop
  	"Answer the relevant inline cache tag for a class.
  	 c.f. inlineCacheTagForInstance:"
+ 	^objectMemory classTagForClass: classOop!
- 	^objectMemory ensureBehaviorHash: classOop!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genAllocFloatValue:into:scratchReg:scratchReg: (in category 'primitive generators') -----
  genAllocFloatValue: dpreg into: resultReg scratchReg: scratch1 scratchReg: scratch2
  	<returnTypeC: #'AbstractInstruction *'>
  	| allocSize newFloatHeader jumpFail |
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	allocSize := objectMemory baseHeaderSize + (objectMemory sizeof: #double).
  	newFloatHeader := objectMemory
  							headerForSlots: (self sizeof: #double) / objectMemory wordSize
  							format: objectMemory firstLongFormat
+ 							classIndex: ClassFloatCompactIndex.
- 							classIndex: objectMemory classFloatCompactIndex.
  	cogit MoveAw: objectMemory freeStartAddress R: resultReg.
  	cogit LoadEffectiveAddressMw: allocSize r: resultReg R: scratch1.
  	cogit CmpCq: objectMemory getScavengeThreshold R: scratch1.
  	jumpFail := cogit JumpAboveOrEqual: 0.
  	cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
  	cogit MoveCq: newFloatHeader R: scratch2.
  	objectMemory wordSize = objectMemory baseHeaderSize
  		ifTrue: [cogit MoveR: scratch2 Mw: 0 r: resultReg]
  		ifFalse:
  			[self flag: #endianness.
  			 cogit MoveCq: newFloatHeader >> 32 R: scratch1.
  			 cogit MoveR: scratch2 Mw: 0 r: resultReg.
  			 cogit MoveR: scratch1 Mw: objectMemory wordSize r: resultReg].
  	cogit MoveRd: dpreg M64: objectMemory baseHeaderSize r: resultReg.
  	^jumpFail!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genJumpCharacterInScratchReg: (in category 'compile abstract instructions') -----
+ genJumpCharacterInScratchReg: reg 
+ 	cogit AndCq: objectMemory tagMask R: reg.
+ 	cogit CmpCq: objectMemory characterTag R: reg.
+ 	^cogit JumpZero: 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genAllocFloatValue:into:scratchReg:scratchReg: (in category 'compile abstract instructions') -----
  genAllocFloatValue: dpreg into: resultReg scratchReg: scratch1 scratchReg: scratch2
  	<returnTypeC: #'AbstractInstruction *'>
  	| allocSize newFloatHeaderSansHash jumpFail |
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	allocSize := BaseHeaderSize + (objectMemory sizeof: #double).
+ 	newFloatHeaderSansHash := ((ClassFloatCompactIndex << objectMemory compactClassFieldLSB
- 	newFloatHeaderSansHash := ((objectMemory classFloatCompactIndex << objectMemory compactClassFieldLSB
  									bitOr: (objectMemory formatOfClass: objectMemory classFloat))
  									bitOr: allocSize)
  									 bitOr: HeaderTypeShort.
  	cogit MoveAw: objectMemory freeStartAddress R: resultReg.
  	cogit MoveR: resultReg R: scratch1.
  	cogit AddCq: allocSize R: scratch1.
  	cogit MoveAw: objectMemory scavengeThresholdAddress R: scratch2.
  	cogit CmpR: scratch2 R: scratch1.
  	jumpFail := cogit JumpAboveOrEqual: 0.
  	cogit MoveR: resultReg R: scratch2.
  	self flag: #newObjectHash.
  	cogit AndCq: HashMaskUnshifted << BytesPerWord R: scratch2.
  	cogit LogicalShiftLeftCq: HashBitsOffset - BytesPerWord R: scratch2.
  	cogit OrCq: newFloatHeaderSansHash R: scratch2.
  	cogit MoveR: scratch2 Mw: 0 r: resultReg.
  	cogit MoveRd: dpreg M64: BaseHeaderSize r: resultReg.
  	cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
  	^jumpFail!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>classFloatCompactIndex (in category 'accessing') -----
- classFloatCompactIndex
- 	^objectMemory classFloatCompactIndex!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>numSlotsOf: (in category 'accessing') -----
+ numSlotsOf: objOop 
+ 	"Answer the number of slots in the given non-immediate object.
+ 	 Does not adjust the size of contexts by stackPointer."
+ 	| obj elementSize wordSize |
+ 	obj := self objectForOop: objOop.
+ 	self deny: ([obj class isImmediateClass]
+ 				on: MessageNotUnderstood
+ 				do: [:ex| obj class == SmallInteger]).
+ 	wordSize := Smalltalk wordSize.
+ 	elementSize := 
+ 		[obj class elementSize]
+ 			on: MessageNotUnderstood
+ 			do: [:ex| obj class isBytes ifTrue: [1] ifFalse: [wordSize]].
+ 	wordSize = 4 ifTrue:
+ 		[^elementSize caseOf: {
+ 			[1]	->	[obj basicSize + 3 // wordSize].
+ 			[2]	->	[obj basicSize * 2 + 3 // wordSize].
+ 			[4]	->	[obj basicSize + obj class instSize] }].
+ 	^elementSize caseOf: {
+ 		[1]	->	[obj basicSize + (wordSize - 1) // wordSize].
+ 		[2]	->	[obj basicSize * 2 + (wordSize - 1) // wordSize].
+ 		[4]	->	[obj basicSize * 2 + (wordSize - 1) // wordSize].
+ 		[8]	->	[obj basicSize + obj class instSize] }!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>characterTag (in category 'accessing') -----
+ characterTag
+ 	^objectMemory characterTag!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>classTablePageSize (in category 'accessing') -----
+ classTablePageSize
+ 	^objectMemory classTablePageSize!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>classTagForClass: (in category 'accessing') -----
+ classTagForClass: classOop
+ 	^(self objectForOop: classOop) identityHash!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>isImmediateClass: (in category 'accessing') -----
+ isImmediateClass: classOop
+ 	"Can't rely on the host image; may be running on SqueakV3.  hence..."
+ 	^#(Character SmallInteger SmallFloat) includes: (self objectForOop: classOop) name!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>smallIntegerTag (in category 'accessing') -----
+ smallIntegerTag
+ 	^objectMemory smallIntegerTag!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>numSlotsOf: (in category 'accessing') -----
- numSlotsOf: objOop 
- 	"Answer the number of slots in the given non-immediate object.
- 	 Does not adjust the size of contexts by stackPointer."
- 	| obj elementSize wordSize |
- 	obj := self objectForOop: objOop.
- 	self deny: ([obj class isImmediateClass]
- 				on: MessageNotUnderstood
- 				do: [:ex| obj class == SmallInteger]).
- 	wordSize := Smalltalk wordSize.
- 	elementSize := 
- 		[obj class elementSize]
- 			on: MessageNotUnderstood
- 			do: [:ex| obj class isBytes ifTrue: [1] ifFalse: [wordSize]].
- 	wordSize = 4 ifTrue:
- 		[^elementSize caseOf: {
- 			[1]	->	[obj basicSize + 3 // wordSize].
- 			[2]	->	[obj basicSize * 2 + 3 // wordSize].
- 			[4]	->	[obj basicSize + obj class instSize] }].
- 	^elementSize caseOf: {
- 		[1]	->	[obj basicSize + (wordSize - 1) // wordSize].
- 		[2]	->	[obj basicSize * 2 + (wordSize - 1) // wordSize].
- 		[4]	->	[obj basicSize * 2 + (wordSize - 1) // wordSize].
- 		[8]	->	[obj basicSize + obj class instSize] }!

Item was removed:
- ----- Method: NewObjectMemory>>classFloatCompactIndex (in category 'cog jit support') -----
- classFloatCompactIndex
- 	<api>
- 	^ClassFloatCompactIndex!

Item was changed:
  ----- Method: ObjectMemory>>instSpecOfClass: (in category 'object format') -----
  instSpecOfClass: classPointer
+ 	"This field in a class's format inst var corresponds to the 4-bit format field stored in every object header"
- 	"This is the same as the field stored in every object header"
  
  	^self formatOfHeader: (self formatOfClass: classPointer)!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genDoubleArithmetic:preOpCheck: (in category 'primitive generators') -----
  genDoubleArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
  	| jumpFailClass jumpFailAlloc jumpFailCheck jumpImmediate jumpNonInt doOp fail |
  	<var: #jumpFailClass type: #'AbstractInstruction *'>
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpFailCheck type: #'AbstractInstruction *'>
  	<var: #doOp type: #'AbstractInstruction *'>
  	<var: #fail type: #'AbstractInstruction *'>
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self MoveR: TempReg R: ClassReg.
  	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
+ 	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
- 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFailClass := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	doOp := self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck := self perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
  	self gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  					genAllocFloatValue: DPFPReg0
  					into: SendNumArgsReg
  					scratchReg: ClassReg
  					scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord * 2.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: doOp.
  	jumpFailAlloc jmpTarget: self Label.
  	self compileFallbackToInterpreterPrimitive.
  	fail := self Label.
  	jumpFailClass jmpTarget: fail.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck jmpTarget: fail].
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: fail].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genDoubleComparison:invert: (in category 'primitive generators') -----
  genDoubleComparison: jumpOpcodeGenerator invert: invertComparison
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	<var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'>
  	| jumpFail jumpImmediate jumpNonInt jumpCond compare |
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #compare type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self MoveR: TempReg R: ClassReg.
  	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
+ 	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
- 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	invertComparison "May need to invert for NaNs"
  		ifTrue: [compare := self CmpRd: DPFPReg0 Rd: DPFPReg1]
  		ifFalse: [compare := self CmpRd: DPFPReg1 Rd: DPFPReg0].
  	jumpCond := self perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
  		objRef: objectMemory falseObject.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord * 2.
  	jumpCond jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
  							objRef: objectMemory trueObject).
  	self RetN: BytesPerWord * 2.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: compare.
  	jumpFail jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFail getJmpTarget].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSmallIntegerComparison:orDoubleComparison: (in category 'primitive generators') -----
  genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	| jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
  	<var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
  	<var: #jumpDouble type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #jumpTrue type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
  		[^self genSmallIntegerComparison: jumpOpcode].
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpDouble := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self CmpR: ClassReg R: ReceiverResultReg. "N.B. FLAGS := RRReg - ClassReg"
  	jumpTrue := self gen: jumpOpcode.
  	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
  		objRef: objectMemory falseObject.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord * 2.
  	jumpTrue jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
  						objRef: objectMemory trueObject).
  	self RetN: BytesPerWord * 2.
  	
  	"Argument may be a Float : let us check or fail"
  	jumpDouble jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[self MoveR: ClassReg R: TempReg.
  		 jumpNonInt := objectRepresentation genJumpImmediateInScratchReg: TempReg].
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
+ 	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
- 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  
  	"It was a Float, so convert the receiver to double and perform the operation"
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: TempReg.
  	self ConvertR: TempReg Rd: DPFPReg0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	self CmpRd: DPFPReg1 Rd: DPFPReg0.
  	jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
  		objRef: objectMemory falseObject.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord * 2.
  	jumpCond jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
  							objRef: objectMemory trueObject).
  	self RetN: BytesPerWord * 2.
  
  	objectRepresentation smallIntegerIsOnlyImmediateType
  		ifTrue: [jumpFail jmpTarget: self Label]
  		ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget: self Label)].
  	^0!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>isImmediateClass: (in category 'cog jit support') -----
+ isImmediateClass: classObj
+ 	<api>
+ 	^(self instSpecOfClass: classObj) = self instSpecForImmediateClasses!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>smallIntegerTag (in category 'cog jit support') -----
+ smallIntegerTag
+ 	"Beware, SmallInetger tags are 1 or 3.  But SmallInteger's identityHash is 1."
+ 	<api>
+ 	^1!

Item was removed:
- ----- Method: SpurMemoryManager>>classFloatCompactIndex (in category 'cog jit support') -----
- classFloatCompactIndex
- 	<api>
- 	^ClassFloatCompactIndex!

Item was changed:
  ----- Method: SpurMemoryManager>>classTablePageSize (in category 'class table') -----
  classTablePageSize
  	"1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages"
  	"self basicNew classTablePageSize"
+ 	<api>
  	^1 << self classTableMajorIndexShift!

Item was changed:
  ----- Method: SpurMemoryManager>>classTagForClass: (in category 'interpreter access') -----
  classTagForClass: classObj
  	"Answer the classObj's identityHash to use as a tag in the first-level method lookup cache."
+ 	<api>
  	self assert: (coInterpreter addressCouldBeClassObj: classObj).
  	^self ensureBehaviorHash: classObj!

Item was changed:
  ----- Method: SpurMemoryManager>>ensureBehaviorHash: (in category 'class table') -----
  ensureBehaviorHash: aBehavior
  	| newHash err |
- 	<api>
  	<inline: true>
  	self assert: (coInterpreter addressCouldBeClassObj: aBehavior).
  	(newHash := self rawHashBitsOf: aBehavior) = 0 ifTrue:
  		[(err := self enterIntoClassTable: aBehavior) ~= 0 ifTrue:
  			[^err negated].
  		 newHash := self rawHashBitsOf: aBehavior.
  		 self assert: (self classAtIndex: newHash) = aBehavior].
  	^newHash!

Item was changed:
  ----- Method: SpurMemoryManager>>instSpecOfClass: (in category 'object format') -----
  instSpecOfClass: classPointer
+ 	"This field in a class's format inst var corresponds to the 5-bit format field stored in every object header"
- 	"This is the same as the field stored in every object header"
  
  	^self instSpecOfClassFormat: (self formatOfClass: classPointer)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genDoubleArithmetic:preOpCheck: (in category 'primitive generators') -----
  genDoubleArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
  	<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
  	| jumpFailClass jumpFailAlloc jumpFailCheck jumpImmediate jumpNonInt doOp |
  	<var: #jumpFailClass type: #'AbstractInstruction *'>
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpFailCheck type: #'AbstractInstruction *'>
  	<var: #doOp type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self MoveR: Arg0Reg R: ClassReg.
  	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
+ 	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
- 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFailClass := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	doOp := self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck := self perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
  	self gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  						genAllocFloatValue: DPFPReg0
  						into: SendNumArgsReg
  						scratchReg: ClassReg
  						scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: 0.
  	"We need to push the register args on two paths; this one and the interpreter primitive path.
  	But the interpreter primitive path won't unless regArgsHaveBeenPushed is false."
  	self assert: methodOrBlockNumArgs <= self numRegArgs.
  	jumpFailClass jmpTarget: self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck jmpTarget: jumpFailClass getJmpTarget].
  	backEnd genPushRegisterArgsForNumArgs: methodOrBlockNumArgs.
  	jumpFailClass := self Jump: 0.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: doOp.
  	jumpFailAlloc jmpTarget: self Label.
  	self compileFallbackToInterpreterPrimitive.
  	jumpFailClass jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFailClass getJmpTarget].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genDoubleComparison:invert: (in category 'primitive generators') -----
  genDoubleComparison: jumpOpcodeGenerator invert: invertComparison
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
  	<var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'>
  	| jumpFail jumpImmediate jumpNonInt jumpCond compare |
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #compare type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
+ 	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
- 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	invertComparison "May need to invert for NaNs"
  		ifTrue: [compare := self CmpRd: DPFPReg0 Rd: DPFPReg1]
  		ifFalse: [compare := self CmpRd: DPFPReg1 Rd: DPFPReg0].
  	jumpCond := self perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
  		objRef: objectMemory falseObject.
  	self RetN: 0.
  	jumpCond jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
  								objRef: objectMemory trueObject).
  	self RetN: 0.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	self ConvertR: Arg0Reg Rd: DPFPReg1.
  	self Jump: compare.
  	jumpFail jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFail getJmpTarget].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSmallIntegerComparison:orDoubleComparison: (in category 'primitive generators') -----
  genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator
  	"Stack looks like
  		return address"
  	| jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
  	<var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
  	<var: #jumpDouble type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #jumpTrue type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
  		[^self genSmallIntegerComparison: jumpOpcode].
  	self MoveR: Arg0Reg R: TempReg.
  	jumpDouble := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg - Arg0Reg"
  	jumpTrue := self gen: jumpOpcode.
  	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
  		objRef: objectMemory falseObject.
  	self RetN: 0.
  	jumpTrue jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
  								objRef: objectMemory trueObject).
  	self RetN: 0.
  	
  	"Argument may be a Float : let us check or fail"
  	jumpDouble jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[self MoveR: ClassReg R: TempReg.
  		 jumpNonInt := objectRepresentation genJumpImmediateInScratchReg: TempReg].
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
+ 	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
- 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  
  	"It was a Float, so convert the receiver to double and perform the operation"
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ReceiverResultReg.
  	self ConvertR: ReceiverResultReg Rd: DPFPReg0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	self CmpRd: DPFPReg1 Rd: DPFPReg0.
  	jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
  		objRef: objectMemory falseObject.
  	self RetN: 0.
  	jumpCond jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
  							objRef: objectMemory trueObject).
  	self RetN: 0.
  
  	objectRepresentation smallIntegerIsOnlyImmediateType
  		ifTrue: [jumpFail jmpTarget: self Label]
  		ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget: self Label)].
  	^0!



More information about the Vm-dev mailing list