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

commits at source.squeak.org commits at source.squeak.org
Wed Dec 9 20:58:42 UTC 2015


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

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

Name: VMMaker.oscog-eem.1568
Author: eem
Time: 9 December 2015, 12:57:00.723 pm
UUID: 5b0f045a-94ac-45a9-9868-42e5db50b924
Ancestors: VMMaker.oscog-EstebanLorenzano.1567

Interpreter: fix primitiveIsPinned, tweak primitivePin.

x64 Cogit:
Fix genInnerPrimitiveNewWithArg:; it was rounding up slot sizes using the 32-bit code (!!); no rounding up necessary in 64-bits.

Fix overflow detection in the division primitives.

Fix leak checking of 32-bit inline caches in 64-bits, renaming genLoadInlineCache: to genLoadInlineCacheWithSelector:.

Add int 3 (stop) to the instructions handled in x86 & x64 instructionSizeAt:.

Better comment isIntegerValue:

=============== Diff against VMMaker.oscog-EstebanLorenzano.1567 ===============

Item was changed:
  ----- Method: CogIA32Compiler>>instructionSizeAt: (in category 'disassembly') -----
  instructionSizeAt: pc
  	"Answer the instruction size at pc.  This is very far from a full decode.
  	 It only has to cope with the instructions generated in a block dispatch."
  	| op |
  	op := objectMemory byteAt: pc.
  	^op caseOf:
  		{	[16r0F]	->	[self twoByteInstructionSizeAt: pc].
  			[16r3D]	->	[5]. "cmp EAX,imm32"
  			[16r70]	->	[2]. "short conditional jumps"
  			[16r71]	->	[2].
  			[16r72]	->	[2].
  			[16r73]	->	[2].
  			[16r74]	->	[2].
  			[16r75]	->	[2].
  			[16r76]	->	[2].
  			[16r77]	->	[2].
  			[16r78]	->	[2].
  			[16r79]	->	[2].
  			[16r7A]	->	[2].
  			[16r7B]	->	[2].
  			[16r7C]	->	[2].
  			[16r7D]	->	[2].
  			[16r7E]	->	[2].
  			[16r7F]	->	[2].
  			[16r83]	->	[self sizeImmediateGroup1: op at: pc].
  			[16r89]	->	[2]. "MOV Eb,Gb"
  			[16r8B]	->	[self sizeHasModrm: op at: pc].
  			[16r90]	->	[1]. "nop"
  			[16rE9] ->	[5]. "long unconditional jump"
+ 			[16rEB] ->	[2]. "short unconditional jump"
+ 			[16rCC]	->	[1]. "int3" }!
- 			[16rEB] ->	[2] "short unconditional jump" }!

Item was added:
+ ----- Method: CogObjectRepresentation>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
+ 	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
+ 	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump.
+ 	 c.f. Spur32BitMemoryManager>>isIntegerValue:"
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^cogit
+ 		MoveR: aRegister R: scratchReg;
+ 		ArithmeticShiftRightCq: 1 R: scratchReg;
+ 		XorR: aRegister R: scratchReg;
+ 		JumpGreaterOrEqual: 0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genInnerPrimitiveNewWithArg: (in category 'primitive generators') -----
  genInnerPrimitiveNewWithArg: retNoffset
  	"Implement primitiveNewWithArg for convenient cases:
  	- the receiver has a hash
  	- the receiver is variable and not compiled method
  	- single word header/num slots < numSlotsMask
  	- the result fits in eden
  	See superclass method for dynamic frequencies of formats.
  	For the moment we implement only arrayFormat, firstByteFormat & firstLongFormat"
  
  	| headerReg fillReg instSpecReg byteSizeReg maxSlots
  	  jumpArrayTooBig jumpByteTooBig jumpLongTooBig
  	  jumpArrayFormat jumpByteFormat jumpBytePrepDone jumpLongPrepDone
  	  jumpUnhashed jumpNElementsNonInt jumpFailCuzFixed jumpNoSpace jumpHasSlots fillLoop skip |
  	<var: 'skip' type: #'AbstractInstruction *'>
  	<var: 'fillLoop' type: #'AbstractInstruction *'>	
  	<var: 'jumpHasSlots' type: #'AbstractInstruction *'>
  	<var: 'jumpNoSpace' type: #'AbstractInstruction *'>
  	<var: 'jumpUnhashed' type: #'AbstractInstruction *'>
  	<var: 'jumpByteFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpByteTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpLongTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpArrayFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpArrayTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpFailCuzFixed' type: #'AbstractInstruction *'>
  	<var: 'jumpBytePrepDone' type: #'AbstractInstruction *'>
  	<var: 'jumpLongPrepDone' type: #'AbstractInstruction *'>
  	<var: 'jumpNElementsNonInt' type: #'AbstractInstruction *'>
  
  	"header will contain classIndex/class's hash & format & numSlots/fixed size"
  	headerReg := SendNumArgsReg.
+ 	"Assume there's an available scratch register on 64-bit machines.  This holds the saved numFixedFileds and then the value to fill with"
- 	"Assume there's an available scratch register on 64-bit machines"
  	fillReg := Scratch0Reg.
  	self assert: (cogit backEnd concreteRegister: fillReg) > 0.
  	"inst spec will hold class's instance specification and then byte size"
  	instSpecReg := byteSizeReg := ClassReg.
  	"The max slots we'll allocate here are those for a single header"
  	maxSlots := objectMemory numSlotsMask - 1.
  
  	"get freeStart as early as possible so as not to wait later..."
  	cogit MoveAw: objectMemory freeStartAddress R: Arg1Reg.
  	"get class's hash & fail if 0"
  	self genGetHashFieldNonImmOf: ReceiverResultReg into: headerReg.
  	jumpUnhashed := cogit JumpZero: 0.
  	"get index and fail if not a +ve integer"
  	jumpNElementsNonInt := self genJumpNotSmallInteger: Arg0Reg scratch: TempReg.
  	"get class's format inst var for inst spec (format field)"
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ReceiverResultReg destReg: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory fixedFieldsFieldWidth + self numSmallIntegerTagBits R: instSpecReg.
  	cogit AndCq: objectMemory formatMask R: instSpecReg.
  	"Add format to classIndex/format header now"
  	cogit MoveR: instSpecReg R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
+ 	"get integer value of num fields in fillReg now"
+ 	cogit MoveR: Arg0Reg R: fillReg.
+ 	self genConvertSmallIntegerToIntegerInReg: fillReg.
- 	"get integer value of num fields in TempReg now"
- 	cogit MoveR: Arg0Reg R: TempReg.
- 	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	"dispatch on format, failing if not variable or if compiled method"
  	cogit CmpCq: objectMemory arrayFormat R: instSpecReg.
  	jumpArrayFormat := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory firstByteFormat R: instSpecReg.
  	jumpByteFormat := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory firstLongFormat R: instSpecReg.
  	jumpFailCuzFixed := cogit JumpNonZero: 0.
  
  	cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg.
  	jumpLongTooBig := cogit JumpAbove: 0.
  	"save num elements/slot size to instSpecReg"
+ 	cogit MoveR: fillReg R: instSpecReg.
- 	cogit MoveR: TempReg R: instSpecReg.
  	cogit MoveCq: 0 R: fillReg.
  	jumpLongPrepDone := cogit Jump: 0. "go allocate"
  
  	jumpByteFormat jmpTarget:
  	(cogit CmpCq: (objectMemory integerObjectOf: maxSlots * objectMemory wordSize) R: Arg0Reg).
  	jumpByteTooBig := cogit JumpAbove: 0.
  	"save num elements to instSpecReg"
+ 	cogit MoveR: fillReg R: instSpecReg.
- 	cogit MoveR: TempReg R: instSpecReg.
  	"compute odd bits and add into headerReg; oddBits := 4 - nElements bitAnd: 3"
  	cogit MoveCq: objectMemory wordSize R: TempReg.
  	cogit SubR: instSpecReg R: TempReg.
  	cogit AndCq: objectMemory wordSize - 1 R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
  	"round up num elements to numSlots in instSpecReg"
  	cogit AddCq: objectMemory wordSize - 1 R: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory shiftForWord R: instSpecReg.
  	cogit MoveCq: 0 R: fillReg.
  	jumpBytePrepDone := cogit Jump: 0. "go allocate"
  
  	jumpArrayFormat jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg).
  	jumpArrayTooBig := cogit JumpAbove: 0.
  	"save num elements/slot size to instSpecReg"
+ 	cogit MoveR: fillReg R: instSpecReg.
- 	cogit MoveR: TempReg R: instSpecReg.
  	cogit MoveCq: objectMemory nilObject R: fillReg.
  	"fall through to allocate"
  
  	jumpBytePrepDone jmpTarget:
  	(jumpLongPrepDone jmpTarget: cogit Label).
  
  	"store numSlots to headerReg"
  	cogit MoveR: instSpecReg R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory numSlotsFullShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
  	"compute byte size; remember 0-sized objects still need 1 slot."
  	cogit CmpCq: 0 R: byteSizeReg. "a.k.a. instSpecReg"
  	jumpHasSlots := cogit JumpNonZero: 0.
  	cogit MoveCq: objectMemory baseHeaderSize * 2 R: byteSizeReg.
  	skip := cogit Jump: 0.
- 	"round up to allocationUnit"
  	jumpHasSlots jmpTarget:
+ 	(cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg).
- 	(cogit MoveR: byteSizeReg R: TempReg).
- 	cogit AddR: TempReg R: byteSizeReg.
- 	cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: byteSizeReg.
  	skip jmpTarget:
  	"check if allocation fits"
  	(cogit AddR: Arg1Reg R: byteSizeReg).
  	cogit CmpCq: objectMemory getScavengeThreshold R: byteSizeReg.
  	jumpNoSpace := cogit JumpAboveOrEqual: 0.
  	"get result, increment freeStart and write it back. Arg1Reg holds new freeStart, the limit of the object"
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit MoveR: byteSizeReg Aw: objectMemory freeStartAddress.
  	"write other half of header (numSlots/0 identityHash)"
  	cogit MoveR: headerReg Mw: 0 r: ReceiverResultReg.
  	"now fill"
  	cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: Arg1Reg.
  	fillLoop := 
  	cogit MoveR: fillReg Mw: 0 r: Arg1Reg.
  	cogit AddCq: 8 R: Arg1Reg.
  	cogit CmpR: Arg1Reg R: byteSizeReg.
  	cogit JumpAbove: fillLoop.
  	cogit RetN: retNoffset.
  	
  	jumpNoSpace jmpTarget:
  	(jumpUnhashed jmpTarget:
  	(jumpFailCuzFixed jmpTarget:
  	(jumpArrayTooBig jmpTarget:
  	(jumpByteTooBig jmpTarget:
  	(jumpLongTooBig jmpTarget:
  	(jumpNElementsNonInt jmpTarget: cogit Label)))))).
  
  	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
+ 	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump.
+ 	 c.f. Spur64BitMemoryManager>>isIntegerValue:"
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^cogit
+ 		MoveR: aRegister R: scratchReg;
+ 		ArithmeticShiftRightCq: 64 - self numTagBits R: scratchReg;
+ 		AddCq: 1 R: scratchReg;
+ 		AndCq: 1 << (self numTagBits + 1) - 1 R: scratchReg; "sign and top numTags bits must be the same"
+ 		CmpCq: 1 R: scratchReg;
+ 		JumpLess: 0!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
+ 	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump.
+ 	 c.f. ObjectMemory>>isIntegerValue:"
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^cogit
+ 		MoveR: aRegister R: scratchReg;
+ 		ArithmeticShiftRightCq: 1 R: scratchReg;
+ 		XorR: aRegister R: scratchReg;
+ 		JumpGreaterOrEqual: 0!

Item was changed:
  ----- Method: CogX64Compiler>>instructionSizeAt: (in category 'disassembly') -----
  instructionSizeAt: pc
  	"Answer the instruction size at pc. This is used in method disassembly
  	 to decode the jumps in block dispatch to discover where block methods
  	 occur within a larger method.   This is very far from a full decode."
  	| op |
  	op := objectMemory byteAt: pc.
  	(op bitAnd: 16rF8) = 16r48 ifTrue:
  		[^1 + (self instructionSizeAt: pc + 1)].
  	^op caseOf:
  		{	[16r0F]	->	[self twoByteInstructionSizeAt: pc].
  			[16r3D]	->	[5]. "cmp EAX,imm32"
  			[16r70]	->	[2]. "short conditional jumps"
  			[16r71]	->	[2].
  			[16r72]	->	[2].
  			[16r73]	->	[2].
  			[16r74]	->	[2].
  			[16r75]	->	[2].
  			[16r76]	->	[2].
  			[16r77]	->	[2].
  			[16r78]	->	[2].
  			[16r79]	->	[2].
  			[16r7A]	->	[2].
  			[16r7B]	->	[2].
  			[16r7C]	->	[2].
  			[16r7D]	->	[2].
  			[16r7E]	->	[2].
  			[16r7F]	->	[2].
  			[16r83]	->	[self sizeImmediateGroup1: op at: pc].
  			[16r89]	->	[2]. "MOV Eb,Gb"
  			[16r8B]	->	[self sizeHasModrm: op at: pc].
  			[16r90]	->	[1]. "nop"
  			[16rE9] ->	[5]. "long unconditional jump"
+ 			[16rEB] ->	[2]. "short unconditional jump"
+ 			[16rCC]	->	[1]. "int3" }!
- 			[16rEB] ->	[2] "short unconditional jump" }!

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRef: annotation pc: mcpc cogMethod: cogMethod
  	"Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	annotation = IsObjectReference ifTrue:
  		[| literal |
  		 literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  		 (objectRepresentation checkValidOopReference: literal) ifFalse:
  			[coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  			^1]].
  
  	self cppIf: NewspeakVM ifTrue:
  		[annotation = IsNSSendCall ifTrue:
  			[| nsSendCache enclosingObject |
  			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			[(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
  				[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  				^1]].
  			(enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
  				[[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
  					[coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  					^1]]]]].
  
  	(self isPureSendAnnotation: annotation) ifTrue:
  		[| entryPoint selectorOrCacheTag offset |
  		 entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint <= methodZoneBase
  			ifTrue:
  				[offset := entryPoint]
  			ifFalse:
  				[self
  					offsetAndSendTableFor: entryPoint
  					annotation: annotation
  					into: [:off :table| offset := off]].
  		 selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  		 (entryPoint > methodZoneBase
  		  and: [offset ~= cmNoCheckEntryOffset
  		  and: [(self cCoerceSimple: entryPoint - offset to: #'CogMethod *') cmType ~= CMOpenPIC]])
  			ifTrue: "linked non-super send, cacheTag is a cacheTag"
  				[(objectRepresentation validInlineCacheTag: selectorOrCacheTag) ifFalse:
  					[coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  					^1]]
+ 			ifFalse: "unlinked send or super send; cacheTag is a selector unless 64-bit, in which case it is an index."
+ 				[(objectMemory wordSize = 8
+ 				  or: [objectRepresentation checkValidOopReference: selectorOrCacheTag]) ifFalse:
- 			ifFalse: "unlinked send or super send; cacheTag is a selector"
- 				[(objectRepresentation checkValidOopReference: selectorOrCacheTag) ifFalse:
  					[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  					^1]]].
  	^0 "keep scanning"!

Item was removed:
- ----- Method: Cogit>>genLoadInlineCache: (in category 'in-line cacheing') -----
- genLoadInlineCache: selectorIndex
- 	"The in-line cache for a send is implemented as a constant load into ClassReg.
- 	 We always use a 32-bit load, even in 64-bits.
- 
- 	 In the initial (unlinked) state the in-line cache is notionally loaded with the selector.
- 	 But since in 64-bits an arbitrary selector oop won't fit in a 32-bit constant load, we
- 	 instead load the cache with the selector's index, either into the literal frame of the
- 	 current method, or into the special selector array.  Negative values are 1-relative
- 	 indices into the special selector array.
- 
- 	 When a send is linked, the load of the selector, or selector index, is overwritten with a
- 	 load of the receiver's class, or class tag.  Hence, the 64-bit VM is currently constrained
- 	 to use class indices as cache tags.  If out-of-line literals are used, distinct caches /must
- 	 not/ share acche locations, for if they do, send cacheing will be confused by the sharing.
- 	 Hence we use the MoveUniqueC32:R: instruction that will not share literal locations."
- 
- 	| cacheValue |
- 	self assert: (selectorIndex < 0
- 					ifTrue: [selectorIndex negated between: 1 and: self numSpecialSelectors]
- 					ifFalse: [selectorIndex between: 0 and: (objectMemory literalCountOf: methodObj) - 1]).
- 
- 	objectMemory wordSize = 8
- 		ifTrue:
- 			[cacheValue := selectorIndex]
- 		ifFalse:
- 			[| selector |
- 			 selector := selectorIndex < 0
- 							ifTrue: [(coInterpreter specialSelector: -1 - selectorIndex)]
- 							ifFalse: [self getLiteral: selectorIndex].
- 			 self assert: (objectMemory addressCouldBeOop: selector).
- 			 (objectMemory isYoung: selector) ifTrue:
- 				[hasYoungReferent := true].
- 			 cacheValue := selector].
- 
- 	self MoveUniqueC32: cacheValue R: ClassReg!

Item was added:
+ ----- Method: Cogit>>genLoadInlineCacheWithSelector: (in category 'in-line cacheing') -----
+ genLoadInlineCacheWithSelector: selectorIndex
+ 	"The in-line cache for a send is implemented as a constant load into ClassReg.
+ 	 We always use a 32-bit load, even in 64-bits.
+ 
+ 	 In the initial (unlinked) state the in-line cache is notionally loaded with the selector.
+ 	 But since in 64-bits an arbitrary selector oop won't fit in a 32-bit constant load, we
+ 	 instead load the cache with the selector's index, either into the literal frame of the
+ 	 current method, or into the special selector array.  Negative values are 1-relative
+ 	 indices into the special selector array.
+ 
+ 	 When a send is linked, the load of the selector, or selector index, is overwritten with a
+ 	 load of the receiver's class, or class tag.  Hence, the 64-bit VM is currently constrained
+ 	 to use class indices as cache tags.  If out-of-line literals are used, distinct caches /must
+ 	 not/ share acche locations, for if they do, send cacheing will be confused by the sharing.
+ 	 Hence we use the MoveUniqueC32:R: instruction that will not share literal locations."
+ 
+ 	| cacheValue |
+ 	self assert: (selectorIndex < 0
+ 					ifTrue: [selectorIndex negated between: 1 and: self numSpecialSelectors]
+ 					ifFalse: [selectorIndex between: 0 and: (objectMemory literalCountOf: methodObj) - 1]).
+ 
+ 	objectMemory wordSize = 8
+ 		ifTrue:
+ 			[cacheValue := selectorIndex]
+ 		ifFalse:
+ 			[| selector |
+ 			 selector := selectorIndex < 0
+ 							ifTrue: [(coInterpreter specialSelector: -1 - selectorIndex)]
+ 							ifFalse: [self getLiteral: selectorIndex].
+ 			 self assert: (objectMemory addressCouldBeOop: selector).
+ 			 (objectMemory isYoung: selector) ifTrue:
+ 				[hasYoungReferent := true].
+ 			 cacheValue := selector].
+ 
+ 	self MoveUniqueC32: cacheValue R: ClassReg!

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

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."
  	<option: #SpurObjectMemory>
  	| obj boolean wasPinned |
  
  	obj := self stackValue: 1.
  	((objectMemory isImmediate: obj)
  	 or: [objectMemory isForwarded: 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.
  			 boolean ~= wasPinned ifTrue:
  				[objectMemory setIsPinnedOf: obj to: false]]
  		ifFalse:
  			[wasPinned := objectMemory falseObject.
+ 			 (boolean ~= wasPinned
- 			 (boolean = objectMemory trueObject
  			  and: [(objectMemory pinObject: obj) = 0]) ifTrue:
  				[^self primitiveFailFor: PrimErrNoMemory]].
  	
  	self pop: argumentCount + 1 thenPush: wasPinned!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveDivide (in category 'primitive generators') -----
  genPrimitiveDivide
  	| jumpNotSI jumpZero jumpInexact jumpOverflow |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
  	<var: #jumpInexact type: #'AbstractInstruction *'>
  	<var: #jumpOverflow type: #'AbstractInstruction *'>
+ 	self genLoadArgAtDepth: 0 into: Arg0Reg.
+ 	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self genLoadArgAtDepth: 0 into: TempReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is non-zero fail."
  	self CmpCq: 0 R: ClassReg.
  	jumpInexact := self JumpNonZero: 0.
  	"test for overflow; the only case is SmallInteger minVal / -1"
+ 	jumpOverflow := objectRepresentation genJumpNotSmallIntegerValue: TempReg scratch: Arg1Reg.
- 	self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg.
- 	jumpOverflow := self JumpGreaterOrEqual: 0.
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
+ 	self RetN: 0.
- 	self RetN: (self primRetNOffsetFor: 1).
  	jumpOverflow jmpTarget: (jumpInexact jmpTarget: (jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label))).
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveQuo (in category 'primitive generators') -----
  genPrimitiveQuo
+ 	| convert jumpNotSI jumpZero jumpIsSI jumpExact |
+ 	<var: #convert type: #'AbstractInstruction *'>
+ 	<var: #jumpIsSI type: #'AbstractInstruction *'>
- 	| jumpNotSI jumpZero jumpOverflow |
- 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
+ 	<var: #jumpNotSI type: #'AbstractInstruction *'>
+ 	<var: #jumpExact type: #'AbstractInstruction *'>
+ 	self genLoadArgAtDepth: 0 into: Arg0Reg.
+ 	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	<var: #jumpOverflow type: #'AbstractInstruction *'>
- 	self genLoadArgAtDepth: 0 into: TempReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: ClassReg].
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
+ 	"If remainder is zero we must check for overflow."
+ 	self CmpCq: 0 R: ClassReg.
+ 	jumpExact := self JumpZero: 0.
+ 	convert := self Label.
- 	"test for overflow; the only case is SmallInteger minVal quo: -1"
- 	self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg.
- 	jumpOverflow := self JumpGreaterOrEqual: 0.
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
+ 	self RetN: 0.
+ 	jumpExact jmpTarget: self Label.
+ 	jumpIsSI := objectRepresentation genJumpIsSmallIntegerValue: TempReg scratch: Arg1Reg.
+ 	jumpIsSI jmpTarget: convert.
+ 	jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label).
- 	self RetN: (self primRetNOffsetFor: 1).
- 	jumpOverflow jmpTarget: (jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label)).
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSend:numArgs:sendTable: (in category 'bytecode generator support') -----
  genSend: selectorIndex numArgs: numArgs sendTable: sendTable
  	<inline: false>
  	<var: #sendTable type: #'sqInt *'>
  	| annotation |
  	self assert: needsFrame.
  	annotation := self annotationForSendTable: sendTable.
  	self assert: (numArgs between: 0 and: 255). "say"
  	self MoveMw: numArgs * objectMemory wordSize r: SPReg R: ReceiverResultReg.
  	"Deal with stale super sends; see SpurMemoryManager's class comment."
  	(self annotationIsForUncheckedEntryPoint: annotation) ifTrue:
  		[objectRepresentation genEnsureOopInRegNotForwarded: ReceiverResultReg scratchReg: TempReg].
  	"0 through (NumSendTrampolines - 2) numArgs sends have the arg count implciti in the trampoline.
  	 The last send trampoline (NumSendTrampolines - 1) passes numArgs in SendNumArgsReg."
  	numArgs >= (NumSendTrampolines - 1) ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	(BytecodeSetHasDirectedSuperSend
  	 and: [annotation = IsDirectedSuperSend]) ifTrue:
  		[self genMoveConstant: tempOop R: TempReg].
+ 	self genLoadInlineCacheWithSelector: selectorIndex.
- 	self genLoadInlineCache: selectorIndex.
  	(self Call: (sendTable at: (numArgs min: NumSendTrampolines - 1))) annotation: annotation.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
  isIntegerValue: intValue
  	"Answer if the given value can be represented as a Smalltalk integer value.
  	 In 64-bits we use a 3 bit tag which leaves 61 bits for 2's complement signed
+ 	 integers. In C, use a shift add and mask to test if the top 4 bits are all the same.
+ 	 Since 16rFFFFFFFFFFFFFFFF >> 60 = 16rF the computation intValue >> 60 + 1 bitAnd: 16rF
+ 	 maps in-range -ve values to 0 and in-range +ve values to 1."
- 	 integers. In C, use a shift add and mask to test if the top 4 bits are all the same."
  	<api>
  	^self
+ 		cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1] "N.B. (16rFFFFFFFFFFFFFFFF >> 60) + 1 = 16"
- 		cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1]
  		inSmalltalk: [intValue >= -16r1000000000000000 and: [intValue <= 16rFFFFFFFFFFFFFFF]]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genMarshalledSend:numArgs:sendTable: (in category 'bytecode generator support') -----
  genMarshalledSend: selectorIndex numArgs: numArgs sendTable: sendTable
  	<inline: false>
  	<var: #sendTable type: #'sqInt *'>
  	| annotation |
  	self assert: needsFrame.
  	annotation := self annotationForSendTable: sendTable.
  	"Deal with stale super sends; see SpurMemoryManager's class comment."
  	(self annotationIsForUncheckedEntryPoint: annotation) ifTrue:
  		[objectRepresentation genEnsureOopInRegNotForwarded: ReceiverResultReg scratchReg: TempReg].
  	"0 through (NumSendTrampolines - 2) numArgs sends have the arg count implciti in the trampoline.
  	 The last send trampoline (NumSendTrampolines - 1) passes numArgs in SendNumArgsReg."
  	numArgs >= (NumSendTrampolines - 1) ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	(BytecodeSetHasDirectedSuperSend
  	 and: [annotation = IsDirectedSuperSend]) ifTrue:
  		[self genMoveConstant: tempOop R: TempReg].
+ 	self genLoadInlineCacheWithSelector: selectorIndex.
- 	self genLoadInlineCache: selectorIndex.
  	(self Call: (sendTable at: (numArgs min: NumSendTrampolines - 1))) annotation: annotation.
  	optStatus isReceiverResultRegLive: false.
  	^self ssPushRegister: ReceiverResultReg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveDivide (in category 'primitive generators') -----
  genPrimitiveDivide
  	| jumpNotSI jumpZero jumpInexact jumpOverflow |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
  	<var: #jumpInexact type: #'AbstractInstruction *'>
  	<var: #jumpOverflow type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: ClassReg.
  	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is non-zero fail."
  	self CmpCq: 0 R: ClassReg.
  	jumpInexact := self JumpNonZero: 0.
  	"test for overflow; the only case is SmallInteger minVal / -1"
+ 	jumpOverflow := objectRepresentation genJumpNotSmallIntegerValue: TempReg scratch: Arg1Reg.
- 	self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg.
- 	jumpOverflow := self JumpGreaterOrEqual: 0.
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOverflow jmpTarget: (jumpInexact jmpTarget: (jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label))).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveQuo (in category 'primitive generators') -----
  genPrimitiveQuo
+ 	| convert jumpNotSI jumpZero jumpIsSI jumpExact |
+ 	<var: #convert type: #'AbstractInstruction *'>
+ 	<var: #jumpIsSI type: #'AbstractInstruction *'>
- 	| jumpNotSI jumpZero jumpOverflow |
- 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
+ 	<var: #jumpNotSI type: #'AbstractInstruction *'>
+ 	<var: #jumpExact type: #'AbstractInstruction *'>
- 	<var: #jumpOverflow type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: ClassReg.
  	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: ClassReg].
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
+ 	"If remainder is zero we must check for overflow."
+ 	self CmpCq: 0 R: ClassReg.
+ 	jumpExact := self JumpZero: 0.
+ 	convert := self Label.
- 	"test for overflow; the only case is SmallInteger minVal quo: -1"
- 	self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg.
- 	jumpOverflow := self JumpGreaterOrEqual: 0.
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
+ 	jumpExact jmpTarget: self Label.
+ 	jumpIsSI := objectRepresentation genJumpIsSmallIntegerValue: TempReg scratch: Arg1Reg.
+ 	jumpIsSI jmpTarget: convert.
+ 	jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label).
- 	jumpOverflow jmpTarget: (jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label)).
  	^0!



More information about the Vm-dev mailing list