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

commits at source.squeak.org commits at source.squeak.org
Sun Dec 13 18:20:09 UTC 2015


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

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

Name: VMMaker.oscog-eem.1587
Author: eem
Time: 13 December 2015, 10:18:19.053 am
UUID: 48e64289-9f7e-45c2-88f7-d480db5b6087
Ancestors: VMMaker.oscog-rmacnak.1586

x64 Cogit:
More changes to get cogitX64.c to compile.

Use unalignedLong* methods to access literals embedded in x64 instructions.

Add tests for unaligned long access via Spur64BitCoMemoryManager

Make the inline primitive genertion code #SistaVM only.

Slang:
Provide a convenience for methods that return constants to be generated as macros.  These can be done using <cmacro>, no argument to cmacro: being necessary.

Fix determining the return type of a method that is a macro.

Include 64-bit Cog Spur in the Squeak configs under version control.

=============== Diff against VMMaker.oscog-rmacnak.1586 ===============

Item was changed:
  ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') -----
  addMethodFor: aClass selector: selector
  	"Add the given method to the code base and answer its translation
  	 or nil if it shouldn't be translated."
  
  	| method tmethod |
  	method := aClass compiledMethodAt: selector.
  	(method pragmaAt: #doNotGenerate) ifNotNil:
  		["only remove a previous method if this one overrides it, i.e. this is a subclass method.
  		 If the existing method is in a different hierarchy this method must be merely a redeirect."
  		 (methods at: selector ifAbsent: []) ifNotNil:
  			[:tm|
  			(aClass includesBehavior: tm definingClass) ifTrue:
  				[self removeMethodForSelector: selector]].
  		 ^nil].
  	method isSubclassResponsibility ifTrue:
  		[^nil].
  	(self shouldIncludeMethodFor: aClass selector: selector) ifFalse:
  		[^nil].
  	tmethod := self compileToTMethodSelector: selector in: aClass.
  	"Even thoug we exclude initialize methods, we must consider their
  	 global variable usage, otherwise globals may be incorrectly localized."
  	selector == #initialize ifTrue:
  		[self checkForGlobalUsage: (tmethod allReferencedVariablesIn: self) in: tmethod.
  		 ^nil].
  	self addMethod: tmethod.
  	"If the method has a macro then add the macro.  But keep the method
  	 for analysis purposes (e.g. its variable accesses)."
  	(method pragmaAt: #cmacro:) ifNotNil:
  		[:pragma|
  		self addMacro: (pragma argumentAt: 1) for: selector.
  		(inlineList includes: selector) ifTrue:
  			[inlineList := inlineList copyWithout: selector]].
+ 	(method pragmaAt: #cmacro) ifNotNil:
+ 		[:pragma| | literal |
+ 		literal := method literalAt: 1. "Method should be just foo ^const"
+ 		self assert: (method numArgs = 0 and: [method numLiterals = 3]).
+ 		self addMacro: '() ', (self cLiteralFor: literal value name: method selector) for: selector.
- 	(method propertyValueAt: #cmacro:) ifNotNil:
- 		[:macro|
- 		self addMacro: macro for: selector.
  		(inlineList includes: selector) ifTrue:
  			[inlineList := inlineList copyWithout: selector]].
  	^tmethod!

Item was changed:
  ----- Method: CCodeGenerator>>computeKernelReturnTypes (in category 'public') -----
  computeKernelReturnTypes
+ 	| dictionary |
+ 	dictionary := Dictionary newFromPairs:
- 	^Dictionary newFromPairs:
  		#(oopAt: #sqInt oopAt:put: #sqInt
  			oopAtPointer: #sqInt oopAtPointer:put: #sqInt
  		 byteAt: #sqInt byteAt:put: #sqInt
  			byteAtPointer: #sqInt byteAtPointer:put: #sqInt
  		 shortAt: #sqInt shortAt:put: #sqInt
  			shortAtPointer: #sqInt shortAtPointer:put: #sqInt
  		 intAt: #sqInt intAt:put: #sqInt
  			intAtPointer: #sqInt intAtPointer:put: #sqInt
  		 longAt: #sqInt longAt:put: #sqInt
  			longAtPointer: #sqInt longAtPointer:put: #sqInt
  				long32At: #sqInt long32At:put: #sqInt
+ 					unalignedLongAt: #sqInt unalignedLongAt:put: #sqInt
+ 						unalignedLong32At: #sqInt unalignedLong32At:put: #sqInt
  
  		 long64At: #sqLong long64At:put: #sqLong
  		
  		 fetchFloatAt:into: #void storeFloatAt:from: #void
  			fetchFloatAtPointer:into: #void storeFloatAtPointer:from: #void
  		 fetchSingleFloatAt:into: #void storeSingleFloatAt:from: #void
  			fetchSingleFloatAtPointer:into: #void storeSingleFloatAtPointer:from: #void
  
+ 		 pointerForOop: #'char *' oopForPointer: #sqInt).
+ 	BytesPerWord = 8 ifTrue:
+ 		[#(long32At: long32At:put: unalignedLong32At: unalignedLong32At:put:) do:
+ 			[:accessor|
+ 			dictionary at: accessor put: #int]].
+ 	^dictionary!
- 		 pointerForOop: #'char *' oopForPointer: #sqInt)!

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') -----
  returnTypeForSend: sendNode in: aTMethod
  	"Answer the return type for a send.  Absent sends default to #sqInt.
  	 The bitwise operators answer unsigned versions of their argument types, at least in gcc
  	 although this author can't find that in the C99 spec.  If you can find this, please let me know."
  	| sel |
+ 	(self anyMethodNamed: (sel := sendNode selector)) ifNotNil:
+ 		[:m|
+ 		m returnType ifNotNil: [:type| ^self baseTypeForType: type]].
+ 	^kernelReturnTypes
+ 		at: sel
+ 		ifAbsent:
+ 			[sel
+ 				caseOf: {
+ 				[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#addressOf:]			->	[(self typeFor: sendNode receiver in: aTMethod)
+ 												ifNil: [#sqInt]
+ 												ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
+ 				[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
+ 				[#bitAnd:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#bitOr:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#bitXor:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#asFloat]				->	[#double].
+ 				[#atan]					->	[#double].
+ 				[#exp]					->	[#double].
+ 				[#log]					->	[#double].
+ 				[#sin]					->	[#double].
+ 				[#sqrt]					->	[#double].
+ 				[#asLong]				->	[#long].
+ 				[#asUnsignedInteger]	->	[#usqInt].
+ 				[#asUnsignedLong]		->	[#'unsigned long'].
+ 				[#asVoidPointer]		->	[#'void *'].
+ 				[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
+ 				[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
+ 				[#cCoerce:to:]			->	[sendNode args last value].
+ 				[#cCoerceSimple:to:]	->	[sendNode args last value].
+ 				[#ifTrue:ifFalse:]		->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#ifFalse:ifTrue:]		->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#ifTrue:]				->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#ifFalse:]				->	[self typeForConditional: sendNode in: aTMethod] }
+ 				otherwise: [#sqInt]]!
- 	^(self anyMethodNamed: (sel := sendNode selector))
- 		ifNil: [kernelReturnTypes
- 				at: sel
- 				ifAbsent:
- 					[^sel
- 						caseOf: {
- 						[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#addressOf:]			->	[(self typeFor: sendNode receiver in: aTMethod)
- 														ifNil: [#sqInt]
- 														ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
- 						[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
- 						[#bitAnd:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#bitOr:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#bitXor:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 						[#asFloat]				->	[#double].
- 						[#atan]					->	[#double].
- 						[#exp]					->	[#double].
- 						[#log]					->	[#double].
- 						[#sin]					->	[#double].
- 						[#sqrt]					->	[#double].
- 						[#asLong]				->	[#long].
- 						[#asUnsignedInteger]	->	[#usqInt].
- 						[#asUnsignedLong]		->	[#'unsigned long'].
- 						[#asVoidPointer]		->	[#'void *'].
- 						[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
- 						[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
- 						[#cCoerce:to:]			->	[sendNode args last value].
- 						[#cCoerceSimple:to:]	->	[sendNode args last value].
- 						[#ifTrue:ifFalse:]		->	[self typeForConditional: sendNode in: aTMethod].
- 						[#ifFalse:ifTrue:]		->	[self typeForConditional: sendNode in: aTMethod].
- 						[#ifTrue:]				->	[self typeForConditional: sendNode in: aTMethod].
- 						[#ifFalse:]				->	[self typeForConditional: sendNode in: aTMethod] }
- 						otherwise: [#sqInt]]]
- 		ifNotNil:
- 			[:m|
- 			 m returnType ifNotNil:
- 				[:type|
- 				 self baseTypeForType: type]]!

Item was changed:
  ----- Method: CogIA32Compiler>>unalignedLongAt: (in category 'memory access') -----
  unalignedLongAt: byteAddress
+ 	<cmacro: '(byteAddress) longAt(byteAddress)'>
- 	<cmacro: '(inst,byteAddress) longAt(byteAddress)'>
  	^objectMemory unalignedLongAt: byteAddress!

Item was changed:
  ----- Method: CogIA32Compiler>>unalignedLongAt:put: (in category 'memory access') -----
  unalignedLongAt: byteAddress put: aWord
+ 	<cmacro: '(byteAddress,aWord) longAtput(byteAddress,aWord)'>
- 	<cmacro: '(inst,byteAddress,aWord) longAtput(byteAddress,aWord)'>
  	^objectMemory unalignedLongAt: byteAddress put: aWord!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>literal32BeforeFollowingAddress: (in category 'inline cacheing') -----
  literal32BeforeFollowingAddress: followingAddress
  	"Answer the 32-bit literal embedded in the instruction immediately preceding followingAddress."
+ 	^self unalignedLong32At: followingAddress - 4!
- 	^  ((objectMemory byteAt: followingAddress - 1) << 24)
- 	+  ((objectMemory byteAt: followingAddress - 2) << 16)
- 	+  ((objectMemory byteAt: followingAddress - 3) << 8)
- 	+   (objectMemory byteAt: followingAddress - 4)!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
  literalBeforeFollowingAddress: followingAddress
  	"Answer the literal embedded in the instruction immediately preceding followingAddress.
  	 This is used in the MoveCwR, PushCwR and CmpCwR cases; these are distinguished by a
  	 nop following the literal load in MoveCwR, a 16r50 + reg ending the PushCwR sequence, and
  	 a (self mod: ModReg RM: rX RO: rY) ending the CmpCwR sequence, which is at least 16rC0."
  	| lastByte base |
  	lastByte := objectMemory byteAt: followingAddress - 1.
  	base := followingAddress - (lastByte <= 16r90
  									ifTrue:
  										[lastByte = 16r90
  											ifTrue: [9]		"MoveCwR"
  											ifFalse: [10]]	"PushCwR"
  									ifFalse: [11]).			"ArithCwR"
+ 	^objectMemory unalignedLongAt: base!
- 	^self cCode: [objectMemory unalignedLongAt: base]
- 		inSmalltalk:
- 			[   (objectMemory byteAt: base)
- 			+ ((objectMemory byteAt: base + 1) << 8)
- 			+ ((objectMemory byteAt: base + 2) << 16)
- 			+ ((objectMemory byteAt: base + 3) << 24)
- 			+ ((objectMemory byteAt: base + 4) << 32)
- 			+ ((objectMemory byteAt: base + 5) << 40)
- 			+ ((objectMemory byteAt: base + 6) << 48)
- 			+ ((objectMemory byteAt: base + 7) << 52)]!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
  storeLiteral: literal beforeFollowingAddress: followingAddress
  	"Rewrite the literal in the instruction immediately preceding followingAddress.
  	 This is used in the MoveCwR, PushCwR and CmpCwR cases; these are distinguished by a
  	 nop following the literal load in MoveCwR, a 16r50 + reg ending the PushCwR sequence, and
  	 a (self mod: ModReg RM: rX RO: rY) ending the CmpCwR sequence, which is at least 16rC0."
  	| lastByte base |
  	lastByte := objectMemory byteAt: followingAddress - 1.
  	base := followingAddress - (lastByte <= 16r90
  									ifTrue:
  										[lastByte = 16r90
  											ifTrue: [9]		"MoveCwR"
  											ifFalse: [10]]	"PushCwR"
  									ifFalse: [11]).			"ArithCwR"
+ 	objectMemory unalignedLongAt: base put: literal!
- 	self cCode: [objectMemory unalignedLongAt: base put: literal]
- 		inSmalltalk:
- 			[objectMemory
- 				byteAt: base put: (literal bitAnd: 16rFF);
- 				byteAt: base + 1 put: ((literal >> 8) bitAnd: 16rFF);
- 				byteAt: base + 2 put: ((literal >> 16) bitAnd: 16rFF);
- 				byteAt: base + 3 put: ((literal >> 24) bitAnd: 16rFF);
- 				byteAt: base + 4 put: ((literal >> 32) bitAnd: 16rFF);
- 				byteAt: base + 5 put: ((literal >> 40) bitAnd: 16rFF);
- 				byteAt: base + 6 put: ((literal >> 48) bitAnd: 16rFF);
- 				byteAt: base + 7 put: ((literal >> 52) bitAnd: 16rFF)]!

Item was changed:
  ----- Method: CogX64Compiler>>rewriteCallFullAt:target: (in category 'full transfer run-time support') -----
  rewriteCallFullAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a CallFull instruction to call a different target.  This variant is used to rewrite cached primitive calls.
  	 Answer the extent of the code change which is used to compute the range of the icache to flush.
  	 On x64 this is a rewrite of
  		movq #64bits, %rax : 48 A1 b0 b1 b2 b3 b4 b5 b6 b7
  		jmp %rax : FF E0 "
  	self assert: (objectMemory byteAt: callSiteReturnAddress - 12) = 16r48.
+ 	objectMemory unalignedLongAt: callSiteReturnAddress - 10 put: callTargetAddress.
- 	objectMemory
- 		byteAt: callSiteReturnAddress -   3 put: (callTargetAddress >> 56 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress -   4 put: (callTargetAddress >> 48 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress -   5 put: (callTargetAddress >> 40 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress -   6 put: (callTargetAddress >> 32 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress -   7 put: (callTargetAddress >> 24 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress -   8 put: (callTargetAddress >> 16 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress -   9 put: (callTargetAddress >>   8 bitAnd: 16rFF);
- 		byteAt: callSiteReturnAddress - 10 put: (callTargetAddress            bitAnd: 16rFF).
  	self assert: (self callFullTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong64 = callTargetAddress.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  	^12!

Item was changed:
  ----- Method: CogX64Compiler>>sixtyFourBitLiteralBefore: (in category 'inline cacheing') -----
  sixtyFourBitLiteralBefore: followingAddress
  	<inline: true>
+ 	^objectMemory unalignedLongAt: followingAddress - 8!
- 	^self cCode: [objectMemory unalignedLongAt: followingAddress - 9]
- 		inSmalltalk: [   ((objectMemory byteAt: followingAddress - 1) << 56)
- 					+ ((objectMemory byteAt: followingAddress - 2) << 48)
- 					+ ((objectMemory byteAt: followingAddress - 3) << 40)
- 					+ ((objectMemory byteAt: followingAddress - 4) << 32)
- 					+ ((objectMemory byteAt: followingAddress - 5) << 24)
- 					+ ((objectMemory byteAt: followingAddress - 6) << 16)
- 					+ ((objectMemory byteAt: followingAddress - 7) << 8)
- 					+  (objectMemory byteAt: followingAddress - 8)]!

Item was changed:
  ----- Method: CogX64Compiler>>thirtyTwoBitLiteralBefore: (in category 'inline cacheing') -----
  thirtyTwoBitLiteralBefore: followingAddress
  	<inline: true>
+ 	^self unalignedLong32At: followingAddress - 4!
- 	^self cCode: [objectMemory unalignedLong32At: followingAddress - 5]
- 		inSmalltalk: [   ((objectMemory byteAt: followingAddress - 1) << 24)
- 					+ ((objectMemory byteAt: followingAddress - 2) << 16)
- 					+ ((objectMemory byteAt: followingAddress - 3) << 8)
- 					+  (objectMemory byteAt: followingAddress - 4)]!

Item was added:
+ ----- Method: CogX64Compiler>>unalignedLong32At: (in category 'memory access') -----
+ unalignedLong32At: byteAddress
+ 	<cmacro: '(inst,byteAddress) long32At(byteAddress)'>
+ 	^ ((objectMemory byteAt: byteAddress + 3) << 24)
+ 	+ ((objectMemory byteAt: byteAddress + 2) << 16)
+ 	+ ((objectMemory byteAt: byteAddress + 1) << 8)
+ 	+  (objectMemory byteAt: byteAddress)!

Item was added:
+ ----- Method: CogX64Compiler>>unalignedLongAt: (in category 'memory access') -----
+ unalignedLongAt: byteAddress
+ 	<cmacro: '(byteAddress) longAt(byteAddress)'>
+ 	^objectMemory unalignedLongAt: byteAddress!

Item was added:
+ ----- Method: CogX64Compiler>>unalignedLongAt:put: (in category 'memory access') -----
+ unalignedLongAt: byteAddress put: aWord
+ 	<cmacro: '(byteAddress,aWord) longAtput(byteAddress,aWord)'>
+ 	^objectMemory unalignedLongAt: byteAddress put: aWord!

Item was changed:
  ----- Method: Cogit>>getIsObjectReference (in category 'method map') -----
  getIsObjectReference
+ 	<cmacro>
- 	<cmacro: '() IsObjectReference'>
  	^IsObjectReference!

Item was changed:
  ----- Method: NewObjectMemory>>compactClassFieldWidth (in category 'cog jit support') -----
  compactClassFieldWidth
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 5'>
  	^5!

Item was changed:
  ----- Method: NewObjectMemory>>instFormatFieldLSB (in category 'cog jit support') -----
  instFormatFieldLSB
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 8'>
  	^8!

Item was changed:
  ----- Method: NewObjectMemory>>instFormatFieldWidth (in category 'cog jit support') -----
  instFormatFieldWidth
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 4'>
  	^4!

Item was changed:
  ----- Method: ObjectMemory>>compactClassFieldLSB (in category 'cog jit support') -----
  compactClassFieldLSB
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 12'>
  	^12!

Item was changed:
  ----- Method: ObjectMemory>>firstByteFormat (in category 'header formats') -----
  firstByteFormat
  	<api>
+ 	<cmacro>
  	^8!

Item was changed:
  ----- Method: ObjectMemory>>firstCompiledMethodFormat (in category 'header formats') -----
  firstCompiledMethodFormat
  	<api>
+ 	<cmacro>
  	^12!

Item was changed:
  ----- Method: ObjectMemory>>firstLongFormat (in category 'header formats') -----
  firstLongFormat
  	<api>
+ 	<cmacro>
  	^6!

Item was changed:
  ----- Method: ObjectMemory>>indexablePointersFormat (in category 'header formats') -----
  indexablePointersFormat
  	<api>
+ 	<cmacro>
  	^3!

Item was changed:
  ----- Method: ObjectMemory>>shiftForWord (in category 'interpreter access') -----
  shiftForWord
  	"N.B. This would appear to hard-code the header size for 32-bit images.  But if generating
  	 a 64-bit image, this method could be removed and the relevant one substituted.  We can't
  	 mark this method as <doNotGenerate> as we need an actual method to guide code gen."
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 2'>
  	^2!

Item was changed:
  ----- Method: ObjectMemory>>weakArrayFormat (in category 'header formats') -----
  weakArrayFormat
  	<api>
+ 	<cmacro>
  	^4!

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

Item was changed:
  ----- Method: Spur32BitMemoryManager>>numTagBits (in category 'object access') -----
  numTagBits
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 2'>
  	^2!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>shiftForWord (in category 'word size') -----
  shiftForWord
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 2'>
  	^2!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>tagMask (in category 'word size') -----
  tagMask
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 3'>
  	^3!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>wordSize (in category 'word size') -----
  wordSize
  	"Answer the manager's word size, which is the size of an oop, and which
  	 is assumed to be equivalent to the underlying machine's word size."
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 4'>
  	^4!

Item was changed:
  ----- Method: Spur64BitCoMemoryManager>>smallIntegerTag (in category 'cog jit support') -----
  smallIntegerTag
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 1'>
  	^1!

Item was changed:
  ----- Method: Spur64BitCoMemoryManager>>unalignedLongAt: (in category 'simulation only') -----
  unalignedLongAt: byteAddress
  	<doNotGenerate>
  	| rem |
+ 	rem := byteAddress \\ 8.
- 	self shouldBeImplemented.
- 	rem := byteAddress \\ 4.
  	^rem = 0
  		ifTrue: [self longAt: byteAddress]
+ 		ifFalse: [((self longAt: byteAddress - rem) + ((self longAt: byteAddress - rem + 8) bitShift: 64) bitShift: rem * -8) bitAnd: 16rFFFFFFFFFFFFFFFF]!
- 		ifFalse: [((self longAt: byteAddress - rem) + ((self longAt: byteAddress - rem + 4) bitShift: 32) bitShift: rem * -8) bitAnd: 16rFFFFFFFF]!

Item was changed:
  ----- Method: Spur64BitCoMemoryManager>>unalignedLongAt:put: (in category 'simulation only') -----
  unalignedLongAt: byteAddress put: aLong
  	<doNotGenerate>
  	| rem mask |
+ 	rem := byteAddress \\ 8.
- 	self shouldBeImplemented.
- 	rem := byteAddress \\ 4.
  	^rem = 0
  		ifTrue: [self longAt: byteAddress put: aLong]
  		ifFalse:
+ 			[mask := 16rFFFFFFFFFFFFFFFF bitAnd: (-1 bitShift: rem * 8).
- 			[mask := 16rFFFFFFFF bitAnd: (-1 bitShift: rem * 8).
  			 self longAt: byteAddress - rem
  				put: ((self longAt: byteAddress - rem) bitAnd: mask bitInvert)
  					+ ((aLong bitShift: rem * 8) bitAnd: mask).
+ 			 self longAt: byteAddress - rem + 8
+ 				put: ((self longAt: byteAddress - rem + 8) bitAnd: mask)
+ 					+ ((aLong bitShift: 8 - rem * -8) bitAnd: mask bitInvert).
- 			 self longAt: byteAddress - rem + 4
- 				put: ((self longAt: byteAddress - rem + 4) bitAnd: mask)
- 					+ ((aLong bitShift: 4 - rem * -8) bitAnd: mask bitInvert).
  			 aLong]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>numTagBits (in category 'object access') -----
  numTagBits
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 3'>
  	"4th bit reserved for object alignment, which could imply e.g. what space the object is in."
  	^3!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>shiftForWord (in category 'word size') -----
  shiftForWord
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 3'>
  	^3!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatExponentOffset (in category 'interpreter access') -----
  smallFloatExponentOffset
  	"896 is 1023 - 127, where 1023 is the mid-point of the 11-bit double precision exponent range,
  	 and 127 is the mid-point of the 8-bit SmallDouble exponent range."
+ 	<api>
+ 	<cmacro>
  	^896!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatMantissaBits (in category 'interpreter access') -----
  smallFloatMantissaBits
+ 	"SmallFLoat64's have the same mantissa as IEEE double-precision floating point"
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 52'>
  	^52!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatTag (in category 'cog jit support') -----
  smallFloatTag
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 3'>
  	^3!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
  smallObjectBytesForSlots: numSlots
  	"Answer the total number of bytes in an object without an overflow header, including header bytes."
+ 	<api>
  	<returnTypeC: #usqInt>
  	^self baseHeaderSize "single header"
  	+ (numSlots < 1
  		ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  		ifFalse: [numSlots * self bytesPerOop])!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>tagMask (in category 'word size') -----
  tagMask
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 7'>
  	^7!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>wordSize (in category 'word size') -----
  wordSize
  	"Answer the manager's word size, which is the size of an oop, and which
  	 is assumed to be equivalent to the underlying machine's word size."
+ 	<cmacro>
- 	<cmacro: '() 8'>
  	^8!

Item was added:
+ ----- Method: SpurMemoryManager>>allocateMemoryOfSize: (in category 'testing') -----
+ allocateMemoryOfSize: limit
+ 	<doNotGenerate>
+ 	memory := (self endianness == #little
+ 					ifTrue: [LittleEndianBitmap]
+ 					ifFalse: [Bitmap]) new: limit // 4!

Item was changed:
  ----- Method: SpurMemoryManager>>characterTag (in category 'object access') -----
  characterTag
  	<api>
+ 	<cmacro>
- 	<cmacro: '() 2'>
  	^2!

Item was changed:
  ----- Method: SpurMemoryManager>>classIndexMask (in category 'header format') -----
  classIndexMask
  	<api>
+ 	<cmacro>
  	"22-bit class mask => ~ 4M classes"
  	^16r3fffff!

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

Item was changed:
  ----- Method: SpurMemoryManager>>firstByteFormat (in category 'header formats') -----
  firstByteFormat
  	<api>
+ 	<cmacro>
  	^16!

Item was changed:
  ----- Method: SpurMemoryManager>>firstCompiledMethodFormat (in category 'header formats') -----
  firstCompiledMethodFormat
  	<api>
+ 	<cmacro>
  	^24!

Item was changed:
  ----- Method: SpurMemoryManager>>firstLongFormat (in category 'header formats') -----
  firstLongFormat
  	<api>
+ 	<cmacro>
  	^10!

Item was changed:
  ----- Method: SpurMemoryManager>>firstShortFormat (in category 'header formats') -----
  firstShortFormat
  	<api>
+ 	<cmacro>
  	^12!

Item was changed:
  ----- Method: SpurMemoryManager>>fixedFieldsFieldWidth (in category 'object format') -----
  fixedFieldsFieldWidth
  	<api>
+ 	<cmacro>
  	^16!

Item was changed:
  ----- Method: SpurMemoryManager>>formatMask (in category 'header format') -----
  formatMask
  	<api>
+ 	<cmacro>
  	"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,7,8 unused
  	 9 (?) 64-bit indexable
  	 10 - 11 32-bit indexable
  	 12 - 15 16-bit indexable
  	 16 - 23 byte indexable
  	 24 - 31 compiled method"
  	^16r1f!

Item was changed:
  ----- Method: SpurMemoryManager>>formatShift (in category 'header format') -----
  formatShift
  	<api>
+ 	<cmacro>
  	^24!

Item was changed:
  ----- Method: SpurMemoryManager>>identityHashFullWordShift (in category 'header access') -----
  identityHashFullWordShift
+ 	<api>
+ 	<cmacro>
  	^32!

Item was changed:
  ----- Method: SpurMemoryManager>>identityHashHalfWordMask (in category 'header format') -----
  identityHashHalfWordMask
  	<api>
+ 	<cmacro>
  	^16r3fffff!

Item was changed:
  ----- Method: SpurMemoryManager>>indexablePointersFormat (in category 'header formats') -----
  indexablePointersFormat
  	<api>
+ 	<cmacro>
  	^3!

Item was changed:
  ----- Method: SpurMemoryManager>>isForwardedObjectClassIndexPun (in category 'class table puns') -----
  isForwardedObjectClassIndexPun
  	"Answer the class index of a forwarder.  We choose 8 so as not to
  	 be confused with any immediate class (whose classIndex matches
  	 its instances tag pattern), and because it is a power of two, which
  	 allows us to generate a slightly slimmer test for isForwarded:."
  	<api>
+ 	<cmacro>
  	^8!

Item was changed:
  ----- Method: SpurMemoryManager>>numSlotsFullShift (in category 'header format') -----
  numSlotsFullShift
+ 	<api>
+ 	<cmacro>
  	^56!

Item was changed:
  ----- Method: SpurMemoryManager>>numSlotsHalfShift (in category 'header format') -----
  numSlotsHalfShift
  	<api>
+ 	<cmacro>
  	^24!

Item was changed:
  ----- Method: SpurMemoryManager>>numSlotsMask (in category 'header format') -----
  numSlotsMask
  	<api>
+ 	<cmacro>
  	"8-bit slot count
  		max 64-bit small obj size 254 * 8 =  2032 bytes
  		max 32-bit small obj size 254 * 4 =   1016 bytes"
  	^255!

Item was changed:
  ----- Method: SpurMemoryManager>>rememberedBitShift (in category 'header format') -----
  rememberedBitShift
  	<api>
+ 	<cmacro>
  	"bit 0 of 3-bit field above format (little endian)"
  	^29!

Item was changed:
  ----- Method: SpurMemoryManager>>weakArrayFormat (in category 'header formats') -----
  weakArrayFormat
  	<api>
+ 	<cmacro>
  	^4!

Item was changed:
  ----- Method: StackInterpreter>>alternateHeaderNumLiteralsMask (in category 'compiled methods') -----
  alternateHeaderNumLiteralsMask
  	<api>
+ 	<cmacro>
- 	<cmacro: '() AlternateHeaderNumLiteralsMask'>
  	^AlternateHeaderNumLiteralsMask!

Item was changed:
  ----- Method: StackInterpreterTests>>testUnalignedMemoryAccess (in category 'tests') -----
  testUnalignedMemoryAccess
+ 	"self new testUnalignedMemoryAccess"
  	| om |
  	om := NewCoObjectMemorySimulator new allocateMemoryOfSize: 16.
  	om unalignedLongAt: 1 put: 16r11223344.
  	self assert: (om unalignedLongAt: 0) equals: 16r22334400.
  	self assert: (om unalignedLongAt: 4) equals: 16r11.
  	self assert: (om unalignedLongAt: 1) equals: 16r11223344.
  	om longAt: 0 put: 16rAAAAAAAA.
  	om longAt: 4 put: 16rAAAAAAAA.
  	om unalignedLongAt: 1 put: 16r11223344.
  	self assert: (om unalignedLongAt: 0) equals: 16r223344AA.
  	self assert: (om unalignedLongAt: 4) equals: 16rAAAAAA11.
  	self assert: (om unalignedLongAt: 1) equals: 16r11223344.
+ 	om := Spur32BitMMLECoSimulator new allocateMemoryOfSize: 16.
- 	om := NewCoObjectMemorySimulator new allocateMemoryOfSize: 16.
  	om unalignedLongAt: 3 put: 16r11223344.
  	self assert: (om unalignedLongAt: 0) equals: 16r44000000.
  	self assert: (om unalignedLongAt: 4) equals: 16r112233.
  	self assert: (om unalignedLongAt: 3) equals: 16r11223344.
  	om longAt: 0 put: 16rAAAAAAAA.
  	om longAt: 4 put: 16rAAAAAAAA.
  	om unalignedLongAt: 3 put: 16r11223344.
  	self assert: (om unalignedLongAt: 0) equals: 16r44AAAAAA.
  	self assert: (om unalignedLongAt: 4) equals: 16rAA112233.
+ 	self assert: (om unalignedLongAt: 3) equals: 16r11223344.
+ 	om := Spur64BitMMLECoSimulator new allocateMemoryOfSize: 32.
+ 	om unalignedLongAt: 3 put: 16r1122334455667788.
+ 	self assert: (om unalignedLongAt: 0) equals: 16r4455667788000000.
+ 	self assert: (om unalignedLongAt: 8) equals: 16r112233.
+ 	self assert: (om unalignedLongAt: 3) equals: 16r1122334455667788.
+ 	om longAt: 0 put: 16rAAAAAAAAAAAAAAAA.
+ 	om longAt: 8 put: 16rAAAAAAAAAAAAAAAA.
+ 	om unalignedLongAt: 3 put: 16r1122334455667788.
+ 	self assert: (om unalignedLongAt: 0) equals: 16r4455667788AAAAAA.
+ 	self assert: (om unalignedLongAt: 8) equals: 16rAAAAAAAAAA112233.
+ 	self assert: (om unalignedLongAt: 3) equals: 16r1122334455667788.!
- 	self assert: (om unalignedLongAt: 3) equals: 16r11223344.!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryConstOpVarInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryConstOpVarInlinePrimitive: prim
  	"Const op var version of binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
+ 	<option: #SistaVM>
  	| ra val untaggedVal adjust |
  	ra := self allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: ra.
  	self ssPop: 1.
  	val := self ssTop constant.
  	self ssPop: 1.
  	untaggedVal := val - objectMemory smallIntegerTag.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[self AddCq: untaggedVal R: ra].
  		[1]	->	[self MoveCq: val R: TempReg.
  				 self SubR: ra R: TempReg.
  				 objectRepresentation genAddSmallIntegerTagsTo: TempReg.
  				 self MoveR: TempReg R: ra].
  		[2]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self MoveCq: (objectMemory integerValueOf: val) R: TempReg.
  				 self MulR: TempReg R: ra.
  				 objectRepresentation genAddSmallIntegerTagsTo: ra].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[16] -> [ self AndCq: val R: ra ].
  		[17] -> [ self OrCq: val R: ra ].
  		[18] -> [ self XorCw: untaggedVal R: ra. ].
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed, but because no CmpRCq things are reversed again and we invert the sense of the jumps."
  		[32] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: ra ].
  		[33] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: ra ].
  		[34] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: ra ].
  		[35] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: ra ].
  		[36] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: ra ].
  		[37] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: ra ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra. ]. 
  				self genMoveConstant: val R: TempReg.
  				self MoveXwr: ra R: TempReg R: ra].
  		[65] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				self AddCq: adjust R: ra.
  				self genMoveConstant: val R: TempReg.
  				self MoveXbr: ra R: TempReg R: ra.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: ra]
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: ra.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryVarOpConstInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryVarOpConstInlinePrimitive: prim
  	"Var op const version of inline binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
+ 	<option: #SistaVM>
  	| rr val untaggedVal |
  	val := self ssTop constant.
  	self ssPop: 1.
  	rr := self allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	untaggedVal := val - objectMemory smallIntegerTag.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[self AddCq: untaggedVal R: rr].
  		[1]	->	[self SubCq: untaggedVal R: rr ].
  		[2]	->	[self flag: 'could use MulCq:R'.
  				 objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: rr.
  				 self MoveCq: (objectMemory integerValueOf: val) R: TempReg.
  				 self MulR: TempReg R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[16] -> [ self AndCq: val R: rr ].
  		[17] -> [ self OrCq: val R: rr ].
  		[18] -> [ self flag: 'could use XorCq:'.
  				self XorCw: untaggedVal R: rr. ].
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed."
  		[32] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: rr ].
  		[33] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: rr ].
  		[34] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: rr ].
  		[35] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: rr ].
  		[36] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: rr ].
  		[37] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: rr ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genLoadSlot: (objectMemory integerValueOf: val) - 1 sourceReg: rr destReg: rr].
  		[65] ->	[self MoveCq: (objectMemory integerValueOf: val) + objectMemory baseHeaderSize - 1 R: TempReg.
  				self MoveXbr: TempReg R: rr R: rr.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr]
  
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: rr.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryVarOpVarInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryVarOpVarInlinePrimitive: prim
  	"Var op var version of binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
+ 	<option: #SistaVM>
  	| ra rr adjust |
  	self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext | ra := rTop. rr := rNext ].
  	self ssTop popToReg: ra.
  	self ssPop: 1.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self AddR: ra R: rr].
  		[1]	->	[self SubR: ra R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  		[2]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rr.
  				 objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ra.
  				 self MulR: ra R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[16] -> [ self AndR: ra R: rr ].
  		[17] -> [ self OrR: ra R: rr ].
  		[18] -> [objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra. 
  				self XorR: ra R: rr. ].
  
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed."
  		[32] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: rr ].
  		[33] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: rr ].
  		[34] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: rr ].
  		[35] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: rr ].
  		[36] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: rr ].
  		[37] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: rr ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra. ]. 
  				self MoveXwr: ra R: rr R: rr ].
  		[65] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				self AddCq: adjust R: ra.
  				self MoveXbr: ra R: rr R: rr.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr]
  
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: rr.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genCallPrimitiveBytecode (in category 'bytecode generators') -----
  genCallPrimitiveBytecode
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#inlinePrimitiveBytecode:"
  	| prim |
  	byte2 < 128 ifTrue:
  		[^bytecodePC = initialPC
  			ifTrue: [0]
  			ifFalse: [EncounteredUnknownBytecode]].
  	prim := byte2 - 128 << 8 + byte1.
  
+ 	self cppIf: SistaVM
+ 		ifTrue:
+ 			[prim < 1000 ifTrue:
+ 				[^self genNullaryInlinePrimitive: prim].
- 	prim < 1000 ifTrue:
- 		[^self genNullaryInlinePrimitive: prim].
  
+ 			prim < 2000 ifTrue:
+ 				[^self genUnaryInlinePrimitive: prim - 1000].
+ 				
+ 			prim < 3000 ifTrue:
+ 				[self ssTop type = SSConstant ifTrue:
+ 					[^self genBinaryVarOpConstInlinePrimitive: prim - 2000].
+ 				 (self ssValue: 1) type = SSConstant ifTrue:
+ 					[^self genBinaryConstOpVarInlinePrimitive: prim - 2000].
+ 				 ^self genBinaryVarOpVarInlinePrimitive: prim - 2000].
- 	prim < 2000 ifTrue:
- 		[^self genUnaryInlinePrimitive: prim - 1000].
- 		
- 	prim < 3000 ifTrue:
- 		[self ssTop type = SSConstant ifTrue:
- 			[^self genBinaryVarOpConstInlinePrimitive: prim - 2000].
- 		 (self ssValue: 1) type = SSConstant ifTrue:
- 			[^self genBinaryConstOpVarInlinePrimitive: prim - 2000].
- 		 ^self genBinaryVarOpVarInlinePrimitive: prim - 2000].
  
+ 			prim < 4000 ifTrue:
+ 				[^self genTrinaryInlinePrimitive: prim - 3000]].
- 	prim < 4000 ifTrue:
- 		[^self genTrinaryInlinePrimitive: prim - 3000].
  
  	^EncounteredUnknownBytecode!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genNullaryInlinePrimitive: (in category 'inline primitive generators') -----
  genNullaryInlinePrimitive: prim
  	"Nullary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#nullaryInlinePrimitive:"
  
+ 	<option: #SistaVM>
  	^EncounteredUnknownBytecode!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genTrinaryInlinePrimitive: (in category 'inline primitive generators') -----
  genTrinaryInlinePrimitive: prim
  	"Unary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#trinaryInlinePrimitive:"
+ 	<option: #SistaVM>
- 
  	| ra1 ra2 rr adjust needsStoreCheck |
  	"The store check requires rr to be ReceiverResultReg"
  	needsStoreCheck := (objectRepresentation isUnannotatableConstant: self ssTop) not.
  	self 
  		allocateRegForStackTopThreeEntriesInto: [:rTop :rNext :rThird | ra2 := rTop. ra1 := rNext. rr := rThird ] 
  		thirdIsReceiver: (prim = 0 and: [ needsStoreCheck ]).
  	self assert: (rr ~= ra1 and: [rr ~= ra2 and: [ra1 ~= ra2]]).
  	self ssTop popToReg: ra2.
  	self ssPop: 1.
  	self ssTop popToReg: ra1.
  	self ssPop: 1.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ra1.
  	"Now: ra is the variable object, rr is long, TempReg holds the value to store."
  	prim caseOf: {
  		"0 - 1 pointerAt:put: and byteAt:Put:"
  		[0] ->	[ adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra1. ]. 
  				self MoveR: ra2 Xwr: ra1 R: rr.
  				"I added needsStoreCheck so if you initialize an array with a Smi such as 0 or a boolean you don't need the store check"
  				needsStoreCheck ifTrue: 
  					[ self assert: needsFrame. 
  					objectRepresentation genStoreCheckReceiverReg: rr valueReg: ra2 scratchReg: TempReg inFrame: true] ].
  		[1] ->	[ objectRepresentation genConvertSmallIntegerToIntegerInReg: ra2.
  				adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				self AddCq: adjust R: ra1.
  				self MoveR: ra2 Xbr: ra1 R: rr.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: ra2. ]
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: ra2.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUnaryInlinePrimitive: (in category 'inline primitive generators') -----
  genUnaryInlinePrimitive: prim
  	"Unary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#unaryInlinePrimitive:"
+ 	<option: #SistaVM>
  	| rcvrReg resultReg |
  	rcvrReg := self allocateRegForStackEntryAt: 0.
  	resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
  	self ssTop popToReg: rcvrReg.
  	self ssPop: 1.
  	prim
  		caseOf: {
  					"00		unchecked class"
  			[1] ->	"01		unchecked pointer numSlots"
  				[objectRepresentation
  					genGetNumSlotsOf: rcvrReg into: resultReg;
  					genConvertIntegerToSmallIntegerInReg: resultReg].
  					"02		unchecked pointer basicSize"
  			[3] ->	"03		unchecked byte numBytes"
  				[objectRepresentation
  					genGetNumBytesOf: rcvrReg into: resultReg;
  					genConvertIntegerToSmallIntegerInReg: resultReg].
  					"04		unchecked short16Type format numShorts"
  					"05		unchecked word32Type format numWords"
  					"06		unchecked doubleWord64Type format numDoubleWords"
  				  }
  		otherwise:
  			[^EncounteredUnknownBytecode].
  	self ssPushRegister: resultReg.
  	^0!

Item was changed:
  ----- Method: TMethod>>definedAsMacro (in category 'testing') -----
  definedAsMacro
  	^properties notNil
+ 	  and: [(properties includesKey: #cmacro:)
+ 		or: [properties includesKey: #cmacro]]!
- 	  and: [properties includesKey: #cmacro:]!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  	"infer types for untyped variables from assignments and arithmetic uses.
  	 For debugging answer a Dictionary from var to the nodes that determined types
  	 This for debugging:
  		(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  	| alreadyExplicitlyTyped effectiveNodes |
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	alreadyExplicitlyTyped := declarations keys asSet.
  	effectiveNodes := Dictionary new. "this for debugging"
  	parseTree nodesDo:
  		[:node| | type var |
  		"If there is something of the form i >= 0, then i should be signed, not unsigned."
  		(node isSend
  		 and: [(locals includes: (var := node receiver variableNameOrNil))
  		 and: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by inferred unsigned types"
  		 and: [(#(<= < >= >) includes: node selector)
  		 and: [node args first isConstant
  		 and: [node args first value = 0
  		 and: [(type := self typeFor: var in: aCodeGen) notNil
  		 and: [type first == $u]]]]]]]) ifTrue:
  			[declarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
  			 effectiveNodes at: var put: { declarations at: var. node }].
  		"if an assignment to an untyped local of a known type, set the local's type to that type.
  		 Only observe known sends (methods in the current set) and typed local variables."
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by previously inferred types"
  		 and: [(type := node expression isSend
  						ifTrue: [aCodeGen returnTypeForSend: node expression in: self]
  						ifFalse: [self typeFor: node expression in: aCodeGen]) notNil
+ 		 and: [aCodeGen isIntegralCType: type]]]]) ifTrue:
- 		 and: [type ~= #void]]]]) ifTrue:
  			[aCodeGen mergeTypeOf: var in: declarations with: type.
  			 effectiveNodes at: var put: { declarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]].
  	^effectiveNodes!

Item was changed:
  ----- Method: VMMaker class>>generateAllSqueakConfigurationsUnderVersionControl (in category 'configurations') -----
  generateAllSqueakConfigurationsUnderVersionControl
  	self generateSqueakStackVM;
  		generateSqueakCogVM;
  		generateSqueakCogMTVM;
  		generateSqueakSpurStackVM;
  		generateSqueakSpurStack64VM;
  		generateSqueakSpurCogVM;
+ 		generateSqueakSpurCog64VM;
  		generateSqueakSpurCogSistaVM!



More information about the Vm-dev mailing list