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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 28 23:16:45 UTC 2015


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

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

Name: VMMaker.oscog-eem.1476
Author: eem
Time: 28 September 2015, 4:14:35.548 pm
UUID: 55852bcd-c81e-4325-a2a7-66b2277e49cd
Ancestors: VMMaker.oscog-eem.1475

x64 Cogit:
Implement most of the inline cache tag/literal extraction code so that CogInLineLiteralsX64Compiler can generate both PIC prototypes.  This is broken because I was confused about PushCw, thinking there was a push 64-bit immediate, there isn't.  I'll have to undo some.

Change the 64-bit surrogates to use long64At:[put:] instead of the deprecated unsignedLongLongAt:[put:].

Fix a bad (but currently symptomless) bug in classRefInClosedPICAt: which had things backwards.

In-line compilation now "works" for CogInLineLiteralsX64Compiler (pace the PushCw confusion), except for the use of 32-bit entries in in-line caches.  hence the next task is to compile sends so that 32-bit inline caches can refernece selectors (i.e. by containing indices into a method's literal frame or the special selector array).

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

Item was changed:
  ----- Method: CogBlockMethodSurrogate64>>padToWord (in category 'accessing') -----
  padToWord
+ 	^memory long64At: address + 5!
- 	^memory unsignedLongLongAt: address + 5!

Item was changed:
  ----- Method: CogBlockMethodSurrogate64>>padToWord: (in category 'accessing') -----
  padToWord: aValue
  	^memory
+ 		long64At: address + 5
- 		unsignedLongLongAt: address + 5
  		put: aValue!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>concretizeArithCwR: (in category 'generate machine code') -----
+ concretizeArithCwR: opcode
+ 	| value reg |
+ 	value := operands at: 0.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at:  0 put: (self rexR: RISCTempReg x: 0 b: RISCTempReg);
+ 		at:  1 put: 16rB8 + (RISCTempReg bitAnd: 7);
+ 		at:  2 put: (value bitAnd: 16rFF);
+ 		at:  3 put: (value >> 8 bitAnd: 16rFF);
+ 		at:  4 put: (value >> 16 bitAnd: 16rFF);
+ 		at:  5 put: (value >> 24 bitAnd: 16rFF);
+ 		at:  6 put: (value >> 32 bitAnd: 16rFF);
+ 		at:  7 put: (value >> 40 bitAnd: 16rFF);
+ 		at:  8 put: (value >> 48 bitAnd: 16rFF);
+ 		at:  9 put: (value >> 56 bitAnd: 16rFF);
+ 		at: 10 put: (self rexR: RISCTempReg x: 0 b: reg);
+ 		at: 11 put: opcode;
+ 		at: 12 put: (self mod: ModReg RM: reg RO: RISCTempReg).
+ 	^machineCodeSize := 13!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>concretizeMoveCwR (in category 'generate machine code') -----
+ concretizeMoveCwR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| value reg |
+ 	value := operands at: 0.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at:  0 put: (self rexR: reg x: 0 b: reg);
+ 		at:  1 put: 16rB8 + (reg bitAnd: 7);
+ 		at:  2 put: (value bitAnd: 16rFF);
+ 		at:  3 put: (value >> 8 bitAnd: 16rFF);
+ 		at:  4 put: (value >> 16 bitAnd: 16rFF);
+ 		at:  5 put: (value >> 24 bitAnd: 16rFF);
+ 		at:  6 put: (value >> 32 bitAnd: 16rFF);
+ 		at:  7 put: (value >> 40 bitAnd: 16rFF);
+ 		at:  8 put: (value >> 48 bitAnd: 16rFF);
+ 		at:  9 put: (value >> 56 bitAnd: 16rFF);
+ 		at: 10 put: 16r90. "Add a nop to disambiguate between MoveCwR/PushCwR and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
+ 	self assert: (self mod: ModReg RM: 0 RO: 0) > 16r90.
+ 	^machineCodeSize := 11!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>concretizePushCw (in category 'generate machine code') -----
+ concretizePushCw
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| value |
+ 	value := operands at: 0.
+ 	machineCode
+ 		at: 0 put: 16r68;
+ 		at: 1 put: (value >> 8 bitAnd: 16rFF);
+ 		at: 2 put: (value >> 16 bitAnd: 16rFF);
+ 		at: 3 put: (value >> 24 bitAnd: 16rFF);
+ 		at: 4 put: (value >> 32 bitAnd: 16rFF);
+ 		at: 5 put: (value >> 40 bitAnd: 16rFF);
+ 		at: 6 put: (value >> 48 bitAnd: 16rFF);
+ 		at: 7 put: (value >> 56 bitAnd: 16rFF);
+ 		at: 8 put: 16r90. "Add a nop to disambiguate between MoveCwR/PushCwR and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
+ 	self assert: (self mod: ModReg RM: 0 RO: 0) > 16r90.
+ 	^machineCodeSize := 9!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
+ inlineCacheTagAt: callSiteReturnAddress
+ 	"Answer the inline cache tag for the return address of a send."
+ 	^self thirtyTwoBitLiteralBefore: callSiteReturnAddress - 5!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
+ literalBeforeFollowingAddress: followingAddress
+ 	"Answer the literal embedded in the instruction immediately preceeding followingAddress.
+ 	 This is used in the MoveCwR and CmpCwR cases; these are distinguished by a nop following
+ 	 the literal load in MoveCwR, and a (self mod: ModReg RM: rX RO: rY) following the CmpCwR."
+ 	| base |
+ 	base := followingAddress - ((objectMemory byteAt: followingAddress - 1) = 16r90
+ 									ifTrue: [9]
+ 									ifFalse: [11]).
+ 	^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 added:
+ ----- Method: CogInLineLiteralsX64Compiler>>loadLiteralByteSize (in category 'accessing') -----
+ loadLiteralByteSize
+ 	<inline: true>
+ 	^self moveCwRByteSize!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>moveCwRByteSize (in category 'accessing') -----
+ moveCwRByteSize
+ 	"With in-line literals we use an 11 byte sequence for loading a 64-bit immediate,
+ 	 which is one more than strictly necessary.  We plant a nop at the end of the
+ 	 sequence to allow us to distinguish between this and the
+ 	 (self mod: ModReg RM: rX RO: rY) at the end of an ArithCwR sequence."
+ 	<inline: true>
+ 	^11!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler>>pushCwByteSize (in category 'accessing') -----
+ pushCwByteSize
+ 	"With in-line literals we use an 9 byte sequence for loading a 64-bit immediate,
+ 	 which is one more than strictly necessary.  We plant a nop at the end of the
+ 	 sequence to allow us to distinguish between this and the
+ 	 (self mod: ModReg RM: rX RO: rY) at the end of an ArithCwR sequence."
+ 	<inline: true>
+ 	^9!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
  sizePCDependentInstructionAt: eventualAbsoluteAddress
  	"Size a jump and set its address.  The target may be another instruction
  	 or an absolute address.  On entry the address inst var holds our virtual
  	 address. On exit address is set to eventualAbsoluteAddress, which is
  	 where this instruction will be output.  The span of a jump to a following
  	 instruction is therefore between that instruction's address and this
  	 instruction's address ((which are both still their virtual addresses), but the
  	 span of a jump to a preceeding instruction or to an absolute address is
  	 between that instruction's address (which by now is its eventual absolute
  	 address) or absolute address and eventualAbsoluteAddress."
  
  	| target maximumSpan abstractInstruction |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	opcode = AlignmentNops ifTrue:
  		[| alignment |
  		 address := eventualAbsoluteAddress.
  		 alignment := operands at: 0.
  		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
  							   - eventualAbsoluteAddress].
  	self assert: self isJump.
  	target := operands at: 0.
  	abstractInstruction := cogit cCoerceSimple: target to: #'AbstractInstruction *'.
  	(self isAnInstruction: abstractInstruction)
  		ifTrue:
  			[maximumSpan := abstractInstruction address
  							- (((cogit abstractInstruction: self follows: abstractInstruction)
  								ifTrue: [eventualAbsoluteAddress]
  								ifFalse: [address]) + 2)]
  		ifFalse:
  			[maximumSpan := target - (eventualAbsoluteAddress + 2)].
  	address := eventualAbsoluteAddress.
  	^machineCodeSize := opcode >= FirstShortJump
  							ifTrue:
  								[(self isQuick: maximumSpan)
  									ifTrue: [2]
  									ifFalse: [opcode = Jump
  												ifTrue: [5]
  												ifFalse: [6]]]
  							ifFalse:
  								[opcode caseOf:
+ 									{	[JumpLong]				->	[5].
+ 										[JumpFull]				->	[12].
+ 										[JumpLongZero]		->	[6].
+ 										[JumpLongNonZero]	->	[6] }]!
- 									{	[JumpLong]	->	[5].
- 										[JumpFull]	->	[12].
- 										[Call]		->	[5].
- 										[CallFull]	->	[12] }]!

Item was changed:
  ----- Method: CogMethodSurrogate64>>methodHeader (in category 'accessing') -----
  methodHeader
+ 	^memory long64At: address + 17 + baseHeaderSize!
- 	^memory unsignedLongLongAt: address + 17 + baseHeaderSize!

Item was changed:
  ----- Method: CogMethodSurrogate64>>methodHeader: (in category 'accessing') -----
  methodHeader: aValue
  	^memory
+ 		long64At: address + baseHeaderSize + 17
- 		unsignedLongLongAt: address + baseHeaderSize + 17
  		put: aValue!

Item was changed:
  ----- Method: CogMethodSurrogate64>>methodObject (in category 'accessing') -----
  methodObject
+ 	^memory long64At: address + 9 + baseHeaderSize!
- 	^memory unsignedLongLongAt: address + 9 + baseHeaderSize!

Item was changed:
  ----- Method: CogMethodSurrogate64>>methodObject: (in category 'accessing') -----
  methodObject: aValue
  	^memory
+ 		long64At: address + baseHeaderSize + 9
- 		unsignedLongLongAt: address + baseHeaderSize + 9
  		put: aValue!

Item was changed:
  ----- Method: CogMethodSurrogate64>>selector (in category 'accessing') -----
  selector
+ 	^memory long64At: address + 25 + baseHeaderSize!
- 	^memory unsignedLongLongAt: address + 25 + baseHeaderSize!

Item was changed:
  ----- Method: CogMethodSurrogate64>>selector: (in category 'accessing') -----
  selector: aValue
  	^memory
+ 		long64At: address + baseHeaderSize + 25
- 		unsignedLongLongAt: address + baseHeaderSize + 25
  		put: aValue!

Item was removed:
- ----- Method: CogObjectRepresentationFor32BitSpur>>genGetClassTagOf:into:scratchReg: (in category 'compile abstract instructions') -----
- genGetClassTagOf: instReg into: destReg scratchReg: scratchReg
- 	^self genGetInlineCacheClassTagFrom: instReg into: destReg forEntry: true!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetClassTagOf:into:scratchReg: (in category 'compile abstract instructions') -----
+ genGetClassTagOf: instReg into: destReg scratchReg: scratchReg
+ 	^self genGetInlineCacheClassTagFrom: instReg into: destReg forEntry: true!

Item was changed:
  ----- Method: CogSistaMethodSurrogate64>>counters (in category 'accessing') -----
  counters
+ 	^memory long64At: address + 33 + baseHeaderSize!
- 	^memory unsignedLongLongAt: address + 33 + baseHeaderSize!

Item was changed:
  ----- Method: CogSistaMethodSurrogate64>>counters: (in category 'accessing') -----
  counters: aValue
  	^memory
+ 		long64At: address + 33 + baseHeaderSize
- 		unsignedLongLongAt: address + 33 + baseHeaderSize
  		put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>baseAddress (in category 'accessing') -----
  baseAddress
+ 	^memory long64At: address + 33!
- 	^memory unsignedLongLongAt: address + 33!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>baseAddress: (in category 'accessing') -----
  baseAddress: aValue
  	self assert: (address + 32 >= zoneBase and: [address + 39 < zoneLimit]).
+ 	^memory long64At: address + 33 put: aValue!
- 	^memory unsignedLongLongAt: address + 33 put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>baseFP (in category 'accessing') -----
  baseFP
+ 	^memory long64At: address + 25!
- 	^memory unsignedLongLongAt: address + 25!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>baseFP: (in category 'accessing') -----
  baseFP: aValue
  	self assert: (address + 24 >= zoneBase and: [address + 31 < zoneLimit]).
+ 	^memory long64At: address + 25 put: aValue!
- 	^memory unsignedLongLongAt: address + 25 put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>headFP (in category 'accessing') -----
  headFP
+ 	^memory long64At: address + 17!
- 	^memory unsignedLongLongAt: address + 17!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>headFP: (in category 'accessing') -----
  headFP: aValue
  	self assert: (address + 16 >= zoneBase and: [address + 23 < zoneLimit]).
+ 	^memory long64At: address + 17 put: aValue!
- 	^memory unsignedLongLongAt: address + 17 put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>headSP (in category 'accessing') -----
  headSP
+ 	^memory long64At: address + 9!
- 	^memory unsignedLongLongAt: address + 9!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>headSP: (in category 'accessing') -----
  headSP: aValue
  	self assert: (address + 8 >= zoneBase and: [address + 15 < zoneLimit]).
+ 	^memory long64At: address + 9 put: aValue!
- 	^memory unsignedLongLongAt: address + 9 put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>lastAddress (in category 'accessing') -----
  lastAddress
+ 	^memory long64At: address + 49!
- 	^memory unsignedLongLongAt: address + 49!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>lastAddress: (in category 'accessing') -----
  lastAddress: aValue
  	self assert: (address + 48 >= zoneBase and: [address + 35 < zoneLimit]).
+ 	^memory long64At: address + 49 put: aValue!
- 	^memory unsignedLongLongAt: address + 49 put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>nextPage (in category 'accessing') -----
  nextPage
+ 	^stackPages surrogateAtAddress: (memory long64At: address + 65)!
- 	^stackPages surrogateAtAddress: (memory unsignedLongLongAt: address + 65)!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>nextPage: (in category 'accessing') -----
  nextPage: aValue
  	self assert: (address + 64 >= zoneBase and: [address + 71 < zoneLimit]).
  	^memory
+ 		long64At: address + 65
- 		unsignedLongLongAt: address + 65
  		put: aValue asInteger!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>prevPage (in category 'accessing') -----
  prevPage
+ 	^stackPages surrogateAtAddress: (memory long64At: address + 73)!
- 	^stackPages surrogateAtAddress: (memory unsignedLongLongAt: address + 73)!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>prevPage: (in category 'accessing') -----
  prevPage: aValue
  	self assert: (address + 72 >= zoneBase and: [address + 79 < zoneLimit]).
  	^memory
+ 		long64At: address + 73
- 		unsignedLongLongAt: address + 73
  		put: aValue asInteger!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>realStackLimit (in category 'accessing') -----
  realStackLimit
+ 	^memory long64At: address + 41!
- 	^memory unsignedLongLongAt: address + 41!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>realStackLimit: (in category 'accessing') -----
  realStackLimit: aValue
  	self assert: (address + 40 >= zoneBase and: [address + 47 < zoneLimit]).
+ 	^memory long64At: address + 41 put: aValue!
- 	^memory unsignedLongLongAt: address + 41 put: aValue!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>stackLimit (in category 'accessing') -----
  stackLimit
+ 	^memory long64At: address + 1!
- 	^memory unsignedLongLongAt: address + 1!

Item was changed:
  ----- Method: CogStackPageSurrogate64>>stackLimit: (in category 'accessing') -----
  stackLimit: aValue
  	self assert: (address >= zoneBase and: [address + 7 < zoneLimit]).
+ 	^memory long64At: address + 1 put: aValue!
- 	^memory unsignedLongLongAt: address + 1 put: aValue!

Item was added:
+ ----- Method: CogX64Compiler>>callInstructionByteSize (in category 'accessing') -----
+ callInstructionByteSize
+ 	^5!

Item was added:
+ ----- Method: CogX64Compiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
+ callTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address the call immediately preceeding callSiteReturnAddress will jump to."
+ 	| callDistance |
+ 	callDistance := self thirtyTwoBitLiteralBefore: callSiteReturnAddress.
+ 	^callSiteReturnAddress + callDistance signedIntFromLong!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Compute the maximum size for each opcode.  This allows jump offsets to
  	 be determined, provided that all backward branches are long branches."
  	"N.B.  The ^N forms are to get around the bytecode compiler's long branch
  	 limits which are exceeded when each case jumps around the otherwise."
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^0].
  		[AlignmentNops]		-> [^(operands at: 0) - 1].
  		[Fill16]					-> [^2].
  		[Fill32]					-> [^4].
  		[FillFromWord]			-> [^4].
  		[Nop]					-> [^1].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^2].
  		[IDIVR]					-> [^3].
  		[IMULRR]				-> [^4].
  		[CPUID]					-> [^2].
  		[CMPXCHGAwR]			-> [^8].
  		[CMPXCHGMwrR]		-> [^9].
  		[LFENCE]				-> [^3].
  		[MFENCE]				-> [^3].
  		[SFENCE]				-> [^3].
  		[LOCK]					-> [^1].
  		"[XCHGAwR]				-> [^6].
  		[XCHGMwrR]			-> [^7]."
  		[XCHGRR]				-> [^((self concreteRegister: (operands at: 0)) = RAX
  									   or: [(self concreteRegister: (operands at: 1)) = RAX])
  											ifTrue: [2]
  											ifFalse: [3]].
  		"Control"
  		[CallFull]					-> [^12].
  		[Call]						-> [^5].
  		[JumpR]						-> [^2].
  		[JumpFull]					-> [self resolveJumpTarget. ^12].
  		[JumpLong]					-> [self resolveJumpTarget. ^5].
  		[Jump]						-> [self resolveJumpTarget. ^5].
  		[JumpZero]					-> [self resolveJumpTarget. ^6].
  		[JumpNonZero]				-> [self resolveJumpTarget. ^6].
  		[JumpNegative]				-> [self resolveJumpTarget. ^6].
  		[JumpNonNegative]			-> [self resolveJumpTarget. ^6].
  		[JumpOverflow]				-> [self resolveJumpTarget. ^6].
  		[JumpNoOverflow]			-> [self resolveJumpTarget. ^6].
  		[JumpCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpNoCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpLess]					-> [self resolveJumpTarget. ^6].
  		[JumpGreaterOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpGreater]				-> [self resolveJumpTarget. ^6].
  		[JumpLessOrEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpBelow]				-> [self resolveJumpTarget. ^6].
  		[JumpAboveOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpAbove]				-> [self resolveJumpTarget. ^6].
  		[JumpBelowOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpLongZero]			-> [self resolveJumpTarget. ^6].
  		[JumpLongNonZero]		-> [self resolveJumpTarget. ^6].
  		[JumpFPEqual]				-> [self resolveJumpTarget. ^6].
  		[JumpFPNotEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLess]				-> [self resolveJumpTarget. ^6].
  		[JumpFPGreaterOrEqual]	-> [self resolveJumpTarget. ^6].
  		[JumpFPGreater]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLessOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpFPOrdered]			-> [self resolveJumpTarget. ^6].
  		[JumpFPUnordered]			-> [self resolveJumpTarget. ^6].
  		[RetN]						-> [^(operands at: 0) = 0 ifTrue: [1] ifFalse: [3]].
  		[Stop]						-> [^1].
  
  		"Arithmetic"
  		[AddCqR]		-> [^self computeSizeOfArithCqR].
  		[AndCqR]		-> [^self computeSizeOfArithCqR].
  		[CmpCqR]		-> [^self computeSizeOfArithCqR].
  		[OrCqR]			-> [^self computeSizeOfArithCqR].
  		[SubCqR]		-> [^self computeSizeOfArithCqR].
  		[TstCqR]		-> [^self computeSizeOfArithCqR].
  		[AddCwR]		-> [^self computeSizeOfArithCwR].
  		[AndCwR]		-> [^self computeSizeOfArithCwR].
  		[CmpCwR]		-> [^self computeSizeOfArithCwR].
  		[OrCwR]		-> [^self computeSizeOfArithCwR].
  		[SubCwR]		-> [^self computeSizeOfArithCwR].
  		[XorCwR]		-> [^self computeSizeOfArithCwR].
  		[AddRR]			-> [^3].
  		[AndRR]			-> [^3].
  		[CmpRR]		-> [^3].
  		[OrRR]			-> [^3].
  		[XorRR]			-> [^3].
  		[SubRR]			-> [^3].
  		[NegateR]		-> [^3].
  		"[LoadEffectiveAddressMwrR]
  						-> [^((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[LogicalShiftLeftCqR]		-> [^(operands at: 0) = 1 ifTrue: [3] ifFalse: [4]].
  		[LogicalShiftRightCqR]		-> [^(operands at: 0) = 1 ifTrue: [3] ifFalse: [4]].
  		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [3] ifFalse: [4]].
  		[LogicalShiftLeftRR]			-> [^self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [^self computeShiftRRSize].
  		[ArithmeticShiftRightRR]		-> [^self computeShiftRRSize].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
  		[SqrtRd]					-> [^4].
  		"Data Movement"
+ 		[MoveCqR]		-> [^(operands at: 0) = 0 ifTrue: [3] ifFalse: [(self is32BitSignedImmediate: (operands at: 0)) ifTrue: [7] ifFalse: [self moveCwRByteSize]]].
+ 		[MoveCwR]		-> [^self moveCwRByteSize].
- 		[MoveCqR]		-> [^(operands at: 0) = 0 ifTrue: [3] ifFalse: [(self is32BitSignedImmediate: (operands at: 0)) ifTrue: [7] ifFalse: [10]]].
- 		[MoveCwR]		-> [^10].
  		[MoveRR]		-> [^3].
  		[MoveRdRd]		-> [^4].
  		[MoveAwR]		-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 1)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRAw]		-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 0)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRMwr]	-> [^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
  											and: [((self concreteRegister: (operands at: 2)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveRdM64r]	-> [^((self isQuick: (operands at: 1))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[MoveMbrR]		-> [^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [4]
  												ifFalse: [5]]
  									ifFalse: [8])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveRMbr]		-> [^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
  											and: [((self concreteRegister: (operands at: 0)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveM16rR]	-> [^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [4]
  												ifFalse: [5]]
  									ifFalse: [8])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveM64rRd]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[MoveMwrR]		-> [^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveXbrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
  							^(self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveRXbrR]	->	[self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
  							^((self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3])
  										+ ((self concreteRegister: (operands at: 0)) >= 4
  											ifTrue: [2]
  											ifFalse: [0])]."
  		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= RSP.
  							^((self concreteRegister: (operands at: 1)) = RBP
  							   or: [(self concreteRegister: (operands at: 1)) = R13])
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= RSP.
  							^((self concreteRegister: (operands at: 2)) = RBP
  							   or: [(self concreteRegister: (operands at: 2)) = R13])
  											ifTrue: [5]
  											ifFalse: [4]].
  		[PopR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
  		[PushR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
  		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
+ 		[PushCw]		-> [^self pushCwByteSize].
- 		[PushCw]		-> [^self computeSizeOfArithCwR - 1].
  		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [12] ifFalse: [0]].
  		"Conversion"
  		"[ConvertRRd]	-> [^4]" }.
  	^0 "to keep C compiler quiet"!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeJumpLong (in category 'generate machine code') -----
+ concretizeJumpLong
+ 	"Will get inlined into concretizeAt: switch."
+ 	"Sizing/generating jumps.
+ 		Jump targets can be to absolute addresses or other abstract instructions.
+ 		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
+ 		Otherwise instructions must have a machineCodeSize which must be kept to."
+ 	<inline: true>
+ 	| jumpTarget offset |
+ 	<var: #jumpTarget type: #'AbstractInstruction *'>
+ 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
+ 	(self isAnInstruction: jumpTarget) ifTrue:
+ 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
+ 	self assert: jumpTarget ~= 0.
+ 	offset := jumpTarget signedIntFromLong - (address + 5) signedIntFromLong.
+ 	machineCode
+ 		at: 0 put: 16rE9;
+ 		at: 1 put: (offset bitAnd: 16rFF);
+ 		at: 2 put: (offset >> 8 bitAnd: 16rFF);
+ 		at: 3 put: (offset >> 16 bitAnd: 16rFF);
+ 		at: 4 put: (offset >> 24 bitAnd: 16rFF).
+ 	^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveCwR (in category 'generate machine code') -----
  concretizeMoveCwR
+ 	self subclassResponsibility!
- 	"Will get inlined into concretizeAt: switch.
- 	 Note that for quick constants, xor reg,reg, movq r8 may be shorter.
- 	 We don't consider it worthwhile for other  than 0."
- 	<inline: true>
- 	| value reg |
- 	value := operands at: 0.
- 	reg := self concreteRegister: (operands at: 1).
- 	machineCode
- 		at: 0 put: (self rexR: reg x: 0 b: reg);
- 		at: 1 put: 16rB8 + (reg bitAnd: 7);
- 		at: 2 put: (value bitAnd: 16rFF);
- 		at: 3 put: (value >> 8 bitAnd: 16rFF);
- 		at: 4 put: (value >> 16 bitAnd: 16rFF);
- 		at: 5 put: (value >> 24 bitAnd: 16rFF);
- 		at: 6 put: (value >> 32 bitAnd: 16rFF);
- 		at: 7 put: (value >> 40 bitAnd: 16rFF);
- 		at: 8 put: (value >> 48 bitAnd: 16rFF);
- 		at: 9 put: (value >> 56 bitAnd: 16rFF).
- 	^machineCodeSize := 10!

Item was changed:
  ----- Method: CogX64Compiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  	<returnTypeC: #void>
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]				-> [^self concretizeLabel].
  		[AlignmentNops]	-> [^self concretizeAlignmentNops].
  		[Fill16]				-> [^self concretizeFill16].
  		[Fill32]				-> [^self concretizeFill32].
  		[FillFromWord]		-> [^self concretizeFillFromWord].
  		[Nop]				-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^self concretizeCDQ].
  		[IDIVR]					-> [^self concretizeIDIVR].
  		[IMULRR]				-> [^self concretizeMulRR].
  		[CPUID]					-> [^self concretizeCPUID].
  		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
  		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
  		[LFENCE]				-> [^self concretizeFENCE: 5].
  		[MFENCE]				-> [^self concretizeFENCE: 6].
  		[SFENCE]				-> [^self concretizeFENCE: 7].
  		[LOCK]					-> [^self concretizeLOCK].
  		[XCHGAwR]				-> [^self concretizeXCHGAwR].
  		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
  		[XCHGRR]				-> [^self concretizeXCHGRR].
  		"Control"
  		[Call]					-> [^self concretizeCall].
  		[CallFull]				-> [^self concretizeCallFull].
  		[JumpR]					-> [^self concretizeJumpR].
  		[JumpFull]				-> [^self concretizeJumpFull].
  		[JumpLong]				-> [^self concretizeJumpLong].
  		[JumpLongZero]		-> [^self concretizeConditionalJump: 16r4].
  		[JumpLongNonZero]	-> [^self concretizeConditionalJump: 16r5].
  		[Jump]					-> [^self concretizeJump].
  		"Table B-1 Intel® 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  		[JumpZero]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpNonZero]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpNegative]			-> [^self concretizeConditionalJump: 16r8].
  		[JumpNonNegative]		-> [^self concretizeConditionalJump: 16r9].
  		[JumpOverflow]			-> [^self concretizeConditionalJump: 16r0].
  		[JumpNoOverflow]		-> [^self concretizeConditionalJump: 16r1].
  		[JumpCarry]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpNoCarry]			-> [^self concretizeConditionalJump: 16r3].
  		[JumpLess]				-> [^self concretizeConditionalJump: 16rC].
  		[JumpGreaterOrEqual]	-> [^self concretizeConditionalJump: 16rD].
  		[JumpGreater]			-> [^self concretizeConditionalJump: 16rF].
  		[JumpLessOrEqual]		-> [^self concretizeConditionalJump: 16rE].
  		[JumpBelow]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpAboveOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpAbove]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpBelowOrEqual]	-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPEqual]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpFPNotEqual]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpFPLess]				-> [^self concretizeConditionalJump: 16r2].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpFPGreater]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpFPLessOrEqual]		-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPOrdered]			-> [^self concretizeConditionalJump: 16rB].
  		[JumpFPUnordered]			-> [^self concretizeConditionalJump: 16rA].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeArithCqRWithRO: 0 raxOpcode: 15r05].
+ 		[AddCwR]					-> [^self concretizeArithCwR: 16r03].
- 		[AddCwR]					-> [^self concretizeAddCwR].
  		[AddRR]						-> [^self concretizeAddRR].
  		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
  		[AndCqR]					-> [^self concretizeArithCqRWithRO: 4 raxOpcode: 16r25].
+ 		[AndCwR]					-> [^self concretizeArithCwR: 16r23].
- 		[AndCwR]					-> [^self concretizeAndCwR].
  		[AndRR]						-> [^self concretizeAndRR].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[CmpCqR]					-> [^self concretizeArithCqRWithRO: 7 raxOpcode: 16r3D].
+ 		[CmpCwR]					-> [^self concretizeArithCwR: 16r39].
- 		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
  		[OrCqR]						-> [^self concretizeArithCqRWithRO: 1 raxOpcode: 16r0D].
+ 		[OrCwR]					-> [^self concretizeArithCwR: 16r0B].
- 		[OrCwR]					-> [^self concretizeOrCwR].
  		[OrRR]						-> [^self concretizeOrRR].
  		[SubCqR]					-> [^self concretizeArithCqRWithRO: 5 raxOpcode: 16r2D].
+ 		[SubCwR]					-> [^self concretizeArithCwR: 16r2B].
- 		[SubCwR]					-> [^self concretizeSubCwR].
  		[SubRR]						-> [^self concretizeSubRR].
  		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
+ 		[SqrtRd]					-> [^self concretizeSqrtRd].
+ 		[XorCwR]					-> [^self concretizeArithCwR: 16r33].
+ 		[XorRR]						-> [^self concretizeXorRR].
+ 		[NegateR]					-> [^self concretizeNegateR].
- 		[SqrtRd]						-> [^self concretizeSqrtRd].
- 		[XorCwR]						-> [^self concretizeXorCwR].
- 		[XorRR]							-> [^self concretizeXorRR].
- 		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeShiftCqRegOpcode: 7].
  		[LogicalShiftRightCqR]			-> [^self concretizeShiftCqRegOpcode: 5].
  		[LogicalShiftLeftCqR]			-> [^self concretizeShiftCqRegOpcode: 4].
  		[ArithmeticShiftRightRR]			-> [^self concretizeShiftRegRegOpcode: 7].
  		[LogicalShiftLeftRR]				-> [^self concretizeShiftRegRegOpcode: 4].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveRXbrR]		-> [^self concretizeMoveRXbrR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCq]			-> [^self concretizePushCq].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd] }!

Item was added:
+ ----- Method: CogX64Compiler>>jumpLongByteSize (in category 'accessing') -----
+ jumpLongByteSize
+ "	Branch/Call ranges.  Jump[Cond] can be generated as short as possible.  Call/Jump[Cond]Long must be generated
+ 	in the same number of bytes irrespective of displacement since their targets may be updated, but they need only
+ 	span 16Mb, the maximum size of the code zone.  This allows e.g. ARM to use single-word call and jump instructions
+ 	for most calls and jumps.  CallFull/JumpFull must also be generated in the same number of bytes irrespective of
+ 	displacement for the same reason, but they must be able to span the full (32-bit or 64-bit) address space because
+ 	they are used to call code in the C runtime, which may be distant from the code zone"
+ 	^5!

Item was added:
+ ----- Method: CogX64Compiler>>jumpLongConditionalByteSize (in category 'accessing') -----
+ jumpLongConditionalByteSize
+ 	^6!

Item was added:
+ ----- Method: CogX64Compiler>>jumpLongTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
+ jumpLongTargetBeforeFollowingAddress: mcpc 
+ 	"Answer the target address for the long jump immediately preceeding mcpc"
+ 	^self callTargetFromReturnAddress: mcpc!

Item was added:
+ ----- Method: CogX64Compiler>>moveCwRByteSize (in category 'accessing') -----
+ moveCwRByteSize
+ 	<inline: true>
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogX64Compiler>>padIfPossibleWithNopsFrom:to: (in category 'generate machine code') -----
+ padIfPossibleWithNopsFrom: startAddr to: endAddr
+ 	self nopsFrom: startAddr to: endAddr!

Item was added:
+ ----- Method: CogX64Compiler>>pushCwByteSize (in category 'accessing') -----
+ pushCwByteSize
+ 	<inline: true>
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogX64Compiler>>thirtyTwoBitLiteralBefore: (in category 'inline cacheing') -----
+ thirtyTwoBitLiteralBefore: followingAddress
+ 	<inline: true>
+ 	^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 changed:
  ----- Method: Cogit>>expectedClosedPICPrototype: (in category 'garbage collection') -----
  expectedClosedPICPrototype: cPIC
  	"Answer 0 if the ClosedPIC is as expected from compileClosedPICPrototype,
  	 otherwise answer an error code identifying the first discrepancy found."
+ 	"self disassembleFrom: methodZoneBase + (self sizeof: CogMethod) to: methodZoneBase + closedPICSize"
  	<var: #cPIC type: #'CogMethod *'>
  	| pc offsetToLiteral object entryPoint |
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	"First jump is unconditional; subsequent ones are conditional"
  	offsetToLiteral := backEnd jumpLongByteSize.
  	1 to: numPICCases do:
  		[:i|
  		i > 1 ifTrue:
  			[object := literalsManager classRefInClosedPICAt: pc - offsetToLiteral.
  			 object = (16rBABE1F15 + i - 1) ifFalse:
  				[^1]].
  		object := literalsManager objRefInClosedPICAt: pc - offsetToLiteral.
  		object = (i = 1
  					ifTrue: [16r5EAF00D]
  					ifFalse: [16rBADA550 + i - 1]) ifFalse:
  			[^2].
  		offsetToLiteral := backEnd jumpLongConditionalByteSize.
  		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		entryPoint = (self cPICPrototypeCaseOffset + 16rCA5E10 + (i - 1 * 16)) ifFalse:
  				[^3].
  		pc := pc + cPICCaseSize].
  	pc := pc - cPICCaseSize.
  	entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc + cPICEndSize.
  	entryPoint = (self cPICMissTrampolineFor: 0) ifFalse:
  		[^4].
  	^0!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>classTag (in category 'accessing') -----
  classTag
+ 	^memory long64At: address + 1!
- 	^memory unsignedLongLongAt: address + 1!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>classTag: (in category 'accessing') -----
  classTag: aValue
  	^memory
+ 		long64At: address + 1
- 		unsignedLongLongAt: address + 1
  		put: aValue!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>depth (in category 'accessing') -----
  depth
+ 	^memory long64At: address + 41!
- 	^memory unsignedLongLongAt: address + 41!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>depth: (in category 'accessing') -----
  depth: aValue
  	^memory
+ 		long64At: address + 41
- 		unsignedLongLongAt: address + 41
  		put: aValue!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>enclosingObject (in category 'accessing') -----
  enclosingObject
+ 	^memory long64At: address + 9!
- 	^memory unsignedLongLongAt: address + 9!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>enclosingObject: (in category 'accessing') -----
  enclosingObject: aValue
  	^memory
+ 		long64At: address + 9
- 		unsignedLongLongAt: address + 9
  		put: aValue!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>numArgs (in category 'accessing') -----
  numArgs
+ 	^memory long64At: address + 33!
- 	^memory unsignedLongLongAt: address + 33!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>numArgs: (in category 'accessing') -----
  numArgs: aValue
  	^memory
+ 		long64At: address + 33
- 		unsignedLongLongAt: address + 33
  		put: aValue!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>selector (in category 'accessing') -----
  selector
+ 	^memory long64At: address + 25!
- 	^memory unsignedLongLongAt: address + 25!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>selector: (in category 'accessing') -----
  selector: aValue
  	^memory
+ 		long64At: address + 25
- 		unsignedLongLongAt: address + 25
  		put: aValue!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>target (in category 'accessing') -----
  target
+ 	^memory long64At: address + 17!
- 	^memory unsignedLongLongAt: address + 17!

Item was changed:
  ----- Method: NSSendCacheSurrogate64>>target: (in category 'accessing') -----
  target: aValue
  	^memory
+ 		long64At: address + 17
- 		unsignedLongLongAt: address + 17
  		put: aValue!

Item was changed:
  ----- Method: NewspeakCogMethodSurrogate64>>nextMethodOrIRCs (in category 'accessing') -----
  nextMethodOrIRCs
+ 	^memory long64At: address + 33 + baseHeaderSize!
- 	^memory unsignedLongLongAt: address + 33 + baseHeaderSize!

Item was changed:
  ----- Method: NewspeakCogMethodSurrogate64>>nextMethodOrIRCs: (in category 'accessing') -----
  nextMethodOrIRCs: aValue
  	^memory
+ 		long64At: address + baseHeaderSize + 33
- 		unsignedLongLongAt: address + baseHeaderSize + 33
  		put: aValue!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>classRefInClosedPICAt: (in category 'garbage collection') -----
  classRefInClosedPICAt: address
  	<inline: true>
  	"If inline cache tags are not objects they will be 32-bit values."
  	^objectRepresentation inlineCacheTagsMayBeObjects
+ 		ifFalse: [objectMemory long32At: address - 4]
+ 		ifTrue: [objectMemory longAt: address - objectMemory bytesPerOop]!
- 		ifTrue: [objectMemory long32At: address - 4]
- 		ifFalse: [objectMemory longAt: address - objectMemory bytesPerOop]!



More information about the Vm-dev mailing list