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

commits at source.squeak.org commits at source.squeak.org
Fri Sep 18 00:31:43 UTC 2015


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

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

Name: VMMaker.oscog-eem.1456
Author: eem
Time: 17 September 2015, 5:29:27.743 pm
UUID: 518085e6-a9c6-4fe5-be72-d0a7bda0fa6f
Ancestors: VMMaker.oscog-eem.1455

Add enough support for the first X64 test to pass (testAndCqR).  Fix a few of the CogARMCompilerTests given that they have been broken by various changes in getting the CogARMCompiler working.

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

Item was changed:
+ ----- Method: AbstractInstructionTests>>concreteCompilerClass (in category 'accessing') -----
- ----- Method: AbstractInstructionTests>>concreteCompilerClass (in category 'generating machine code') -----
  concreteCompilerClass
  	"Answer the concreate subclass of CogAbstractInstruction the concrete test class is testing."
  	self subclassResponsibility!

Item was changed:
  ----- Method: AbstractInstructionTests>>disassembleOpcodesIn:to: (in category 'disassembly') -----
  disassembleOpcodesIn: memory to: aStream
  	self processor
  		disassembleFrom: opcodes first address
  		to: opcodes last address + opcodes last machineCodeSize - 1
+ 		in: (self memoryAsBytes: memory)
- 		in: memory
  		on: aStream!

Item was changed:
+ ----- Method: AbstractInstructionTests>>processor (in category 'accessing') -----
- ----- Method: AbstractInstructionTests>>processor (in category 'generating machine code') -----
  processor
  	self subclassResponsibility!

Item was added:
+ ----- Method: CogARMCompilerTests>>disassembleInstructionAt:In:into: (in category 'private') -----
+ disassembleInstructionAt: index In: inst into: binaryBlock
+ 	"Manage the fact that in the simulator inst machineCode object is an Array and the disassembler requires a ByteArray or some such."
+ 	^self processor
+ 		disassembleInstructionAt: index
+ 		In: (self memoryAsBytes: inst machineCode object)
+ 		into: binaryBlock!

Item was added:
+ ----- Method: CogARMCompilerTests>>generateInstructions (in category 'generating machine code') -----
+ generateInstructions
+ 	"See Cogit>>computeMaximumSizes, generateInstructionsAt: & outputInstructionsAt:.
+ 	 This is a pure Smalltalk (non-Slang) version of that trio of methods.
+ 	 The wrinkle here is that in teh simulator a CogARMInstruction's machien code is a simple Array of integers, not a ByteArray of four byte quads."
+ 	| address pcDependentInstructions instructions |
+ 	address := 0.
+ 	pcDependentInstructions := OrderedCollection new.
+ 	opcodes do:
+ 		[:abstractInstruction|
+ 		abstractInstruction
+ 			address: address;
+ 			maxSize: abstractInstruction computeMaximumSize.
+ 		address := address + abstractInstruction maxSize].
+ 	address := 0.
+ 	opcodes do:
+ 		[:abstractInstruction|
+ 		abstractInstruction isPCDependent
+ 			ifTrue:
+ 				[abstractInstruction sizePCDependentInstructionAt: address.
+ 				 pcDependentInstructions addLast: abstractInstruction.
+ 				 address := address + abstractInstruction machineCodeSize]
+ 			ifFalse:
+ 				[address := abstractInstruction concretizeAt: address]].
+ 	pcDependentInstructions do:
+ 		[:abstractInstruction|
+ 		abstractInstruction concretizeAt: abstractInstruction address].
+ 	instructions := Array new: address / 4.
+ 	address := 0.
+ 	opcodes do:
+ 		[:abstractInstruction|
+ 		self assert: abstractInstruction address / 4 = address.
+ 		0 to: abstractInstruction machineCodeSize - 1 by: 4 do:
+ 			[:j|
+ 			instructions at: address + 1 put: (abstractInstruction machineCode at: j / 4).
+ 			address := address + 1]].
+ 	^instructions!

Item was added:
+ ----- Method: CogARMCompilerTests>>memoryAsBytes: (in category 'private') -----
+ memoryAsBytes: aByteArrayOrArray
+ 	"Manage the fact that in the simulator inst machineCode object is an Array and the disassembler requires a ByteArray or some such."
+ 	| bytes |
+ 	aByteArrayOrArray isArray ifFalse:
+ 		[^aByteArrayOrArray].
+ 	bytes := ByteArray new: aByteArrayOrArray size * 4.
+ 	1 to: aByteArrayOrArray size do:
+ 		[:i|
+ 		(aByteArrayOrArray at: i) ifNotNil:
+ 			[:word|
+ 			bytes unsignedLongAt: i - 1* 4 + 1 put: word]].
+ 	^bytes!

Item was changed:
  ----- Method: CogARMCompilerTests>>testAdd (in category 'tests') -----
  testAdd
  	"self new testAdd"
  	
  	"the forms are valid, "
  	"test AddCqR"
  	self concreteCompilerClass registersWithNamesDo: [ :reg :regName |
  		#(0 16rF 16rFF) do:
  			[:n| | inst len |
  			inst := self gen: AddCqR operand: n operand: reg.
  			len := inst concretizeAt: 0.
+ 			self
- 			self processor
  				disassembleInstructionAt: 0
+ 				In: inst
- 				In: inst machineCode object
  				into: [:str :sz| | plainJane herIntended |
  					plainJane := self strip: str.
  					herIntended := 'adds	', regName, ', ', regName, ', #', n asString.
  					self assert: (plainJane match: herIntended)]]].
  		
  	"test AddCwR"
  	self concreteCompilerClass registersWithNamesDo: [ :reg :regName |
  		#(16rFFFFFFFF 16r88888888 0) do:
  			[:n| | inst len |
  			inst := self gen: AddCwR operand: n operand: reg.
  			len := inst concretizeAt: 0.
+ 			self
- 			self processor
  				disassembleInstructionAt: 0
+ 				In: inst
- 				In: inst machineCode object
  				into: [:str :sz| | plainJane herIntended |
  					plainJane := self strip: str.
+ 					herIntended := 'mov	ip, #', (n bitAnd: 16rFF << 24) signedIntFromLong asString.
- 					herIntended := 'mov	sl, #', (n bitAnd: 16rFF << 24) signedIntFromLong asString.
  					self assert: (plainJane match: herIntended)].
+ 			self
- 			self processor
  				disassembleInstructionAt: 4
+ 				In: inst
- 				In: inst machineCode object
  				into: [:str :sz| | plainJane herIntended |
  					plainJane := self strip: str.
+ 					herIntended := 'orr	ip, ip, #', (n bitAnd: 16rFF << 16) asString.
- 					herIntended := 'orr	sl, sl, #', (n bitAnd: 16rFF << 16) asString.
  					self assert: (plainJane match: herIntended)].
+ 			self
- 			self processor
  				disassembleInstructionAt: 8
+ 				In: inst
- 				In: inst machineCode object
  				into: [:str :sz| | plainJane herIntended |
  					plainJane := self strip: str.
+ 					herIntended := 'orr	ip, ip, #', (n bitAnd: 16rFF << 8) signedIntFromLong asString.
- 					herIntended := 'orr	sl, sl, #', (n bitAnd: 16rFF << 8) signedIntFromLong asString.
  					self assert: (plainJane match: herIntended)].
+ 			self
- 			self processor
  				disassembleInstructionAt: 12
+ 				In: inst
- 				In: inst machineCode object
  				into: [:str :sz| | plainJane herIntended |
  					plainJane := self strip: str.
+ 					herIntended := 'orr	ip, ip, #', (n bitAnd: 16rFF) asString.
- 					herIntended := 'orr	sl, sl, #', (n bitAnd: 16rFF) asString.
  					self assert: (plainJane match: herIntended)].
+ 			self
- 			self processor
  				disassembleInstructionAt: 16
+ 				In: inst
- 				In: inst machineCode object
  				into: [:str :sz| | plainJane herIntended |
  					plainJane := self strip: str.
+ 					herIntended := 'adds	', regName, ', ', regName, ', ip'.
- 					herIntended := 'adds	', regName, ', ', regName, ', sl'.
  					self assert: (plainJane match: herIntended)]]]
  !

Item was changed:
  ----- Method: CogARMCompilerTests>>testPrefetchAw (in category 'tests') -----
  testPrefetchAw
  	"self new testPrefetchAw"
  	
  	#(16rFF00FF00 16r00000012) do:
  		[:n| | inst len |
  		inst := self gen: PrefetchAw operand: n.
  		len := inst concretizeAt: 0.
+ 		self
- 		self processor
  			disassembleInstructionAt: 12
+ 			In: inst
- 			In: inst machineCode object
  			into: [:str :sz| | plainJane herIntended |
  				"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
  				plainJane := self strip: str.
  				herIntended := 'pld	[sl', ((n bitAnd: 16rFF) = 0 ifTrue: [''] ifFalse: [', #', (n bitAnd: 16rFF) asString]) ,']'.
  				self assert: (plainJane match: herIntended).
  				self assert: len = 16]].
  !

Item was changed:
  ----- Method: CogARMCompilerTests>>testPushR (in category 'tests') -----
  testPushR
  	"self new testPushR"
  	
  	self concreteCompilerClass registersWithNamesDo:
  		[:r :name | | inst len |
  		inst := self gen: PushR operand: r.
  		len := inst concretizeAt: 0.
+ 		self
- 		self processor
  			disassembleInstructionAt: 0
+ 			In: inst
- 			In: inst machineCode object
  			into: [:str :sz| | plainJane herIntended |
  				"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
  				plainJane := self strip: str.
  				herIntended := 'push	{', name ,'}'.
  				self assert: (plainJane match: herIntended).
  				self assert: len = 4]].
  !

Item was changed:
  ----- Method: CogARMCompilerTests>>testRetN (in category 'tests') -----
  testRetN
  	"self new testRetN"
  	
  	#(0) do:
  		[:n| | inst len |
  		inst := self gen: RetN operand: n.
  		len := inst concretizeAt: 0.
+ 		self
- 		self processor
  			disassembleInstructionAt: 0
+ 			In: inst
- 			In: inst machineCode object
  			into: [:str :sz| | plainJane  |
  				"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
  				plainJane := self strip: str.
  				self assert: (plainJane match: 'mov	pc, lr').
  				self assert: len = sz]].
  	
  	#(1 2 3 4 5 6 7) do:
  		[:n| | inst len |
  		inst := self gen: RetN operand: n * 4.
  		len := inst concretizeAt: 0.
+ 		self
- 		self processor
  			disassembleInstructionAt: 0
+ 			In: inst
- 			In: inst machineCode object
  			into: [:str :sz| | plainJane herIntended |
  				plainJane := self strip: str.
  				herIntended := 'add	sp, sp, #', (n * 4 )asString.
  				self assert: (plainJane match: herIntended)].
+ 		self
- 		self processor
  			disassembleInstructionAt: 4
+ 			In: inst
- 			In: inst machineCode object
  			into: [:str :sz| | plainJane |
  				plainJane := self strip: str.
  				self assert: (plainJane match: 'mov	pc, lr').		
  		self assert: len = 8]]!

Item was added:
+ ----- Method: CogIA32CompilerTests>>methodLabel (in category 'generating machine code') -----
+ methodLabel
+ 	"There is no methodLabel in test code."
+ 	^nil!

Item was added:
+ CogX64Compiler subclass: #CogInLineLiteralsX64Compiler
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was added:
+ CogX64Compiler subclass: #CogOutOfLineLiteralsX64Compiler
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was changed:
  CogAbstractInstruction subclass: #CogX64Compiler
  	instanceVariableNames: ''
+ 	classVariableNames: 'CDQ CMPXCHGAwR CMPXCHGMwrR CPUID IDIVR IMULRR LFENCE LOCK MFENCE ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 R10 R11 R12 R13 R14 R15 R8 R9 RAX RBP RBX RCX RDI RDX RSI RSP SFENCE SIB1 SIB2 SIB4 SIB8 XCHGAwR XCHGMwrR XCHGRR XMM0H XMM0L XMM1H XMM1L XMM2H XMM2L XMM3H XMM3L XMM4H XMM4L XMM5H XMM5L XMM6H XMM6L XMM7H XMM7L'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogX64Compiler commentStamp: 'eem 9/14/2015 17:12' prior: 0!
  I generate x64 (x86-64) instructions from CogAbstractInstructions.  For reference see
  1. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M
  2. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, N-Z
  	http://www.intel.com/products/processor/manuals/
  or
  AMD64 Architecture Programmer's Manual Volume 3: General-Purpose and System Instructions
  AMD64 Architecture Programmer's Manual Volume 4: 128-bit Media Instructions
  AMD64 Architecture Programmer's Manual Volume 5: 64-bit Media and x87 Floating Point Instructions
  	http://developer.amd.com/resources/documentation-articles/developer-guides-manuals/
  (® is supposed to be the Unicode "registered  sign").!

Item was added:
+ ----- Method: CogX64Compiler class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Initialize various x64 instruction-related constants.
+ 	 [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M"
+ 
+ 	"CogX64Compiler initialize"
+ 
+ 	| specificOpcodes refs |
+ 	self ~~ CogX64Compiler ifTrue: [^self].
+ 
+ 	RAX := 0.
+ 	RCX := 1.  "Were they completely mad or simply sadistic?"
+ 	RDX := 2.
+ 	RBX := 3.
+ 	RSP := 4.
+ 	RBP := 5.
+ 	RSI := 6.
+ 	RDI := 7.
+ 	R8 := 8.
+ 	R9 := 9.
+ 	R10 := 10.
+ 	R11 := 11.
+ 	R12 := 12.
+ 	R13 := 13.
+ 	R14 := 14.
+ 	R15 := 15.
+ 
+ 	XMM0L := 0.
+ 	XMM1L := 2.
+ 	XMM2L := 4.
+ 	XMM3L := 6.
+ 	XMM4L := 8.
+ 	XMM5L := 10.
+ 	XMM6L := 12.
+ 	XMM7L := 14.
+ 
+ 	XMM0H := 1.
+ 	XMM1H := 3.
+ 	XMM2H := 5.
+ 	XMM3H := 7.
+ 	XMM4H := 9.
+ 	XMM5H := 11.
+ 	XMM6H := 13.
+ 	XMM7H := 15.
+ 
+ 	"Mod R/M Mod fields.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-2"
+ 	ModRegInd := 0.
+ 		ModRegIndSIB := 4.
+ 		ModRegIndDisp32 := 5.
+ 	ModRegRegDisp8 := 1.
+ 	ModRegRegDisp32 := 2.
+ 	ModReg := 3.
+ 
+ 	"SIB Scaled Index modes.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-3"
+ 	SIB1 := 0.
+ 	SIB2 := 1.
+ 	SIB4 := 2.
+ 	SIB8 := 3.
+ 
+ 	"Specific instructions"
+ 	LastRTLCode ifNil:
+ 		[CogRTLOpcodes initialize].
+ 	specificOpcodes := #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR).
+ 	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
+ 				[:ea| ea key].
+ 	(classPool keys reject: [:k| (specificOpcodes includes: k) or: [refs includes: k]]) do:
+ 		[:k|
+ 		Undeclared declare: k from: classPool].
+ 	specificOpcodes withIndexDo:
+ 		[:classVarName :value|
+ 		self classPool
+ 			declare: classVarName from: Undeclared;
+ 			at: classVarName put: value + LastRTLCode - 1]!

Item was added:
+ ----- Method: CogX64Compiler class>>machineCodeDeclaration (in category 'translation') -----
+ machineCodeDeclaration
+ 	"Answer the declaration for the machineCode array."
+ 	^{#'unsigned char'. '[', self basicNew machineCodeBytes printString, ']'}!

Item was added:
+ ----- 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]					-> [^1].
+ 		[IDIVR]					-> [^2].
+ 		[IMULRR]				-> [^3].
+ 		[CPUID]					-> [^2].
+ 		[CMPXCHGAwR]			-> [^7].
+ 		[CMPXCHGMwrR]		-> [^8].
+ 		[LFENCE]				-> [^3].
+ 		[MFENCE]				-> [^3].
+ 		[SFENCE]				-> [^3].
+ 		[LOCK]					-> [^1].
+ 		[XCHGAwR]				-> [^6].
+ 		[XCHGMwrR]			-> [^7].
+ 		[XCHGRR]				-> [^2]."
+ 		"Control"
+ 		[CallFull]					-> [^5].
+ 		[Call]						-> [^5].
+ 		[JumpR]						-> [^2].
+ 		[JumpFull]					-> [self resolveJumpTarget. ^5].
+ 		[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 isQuick: (operands at: 0))
+ 											ifTrue: [3]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]]].
+ 		[AndCqR]		-> [^(self isQuick: (operands at: 0))
+ 											ifTrue: [3]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]]].
+ 		[CmpCqR]		-> [^(self isQuick: (operands at: 0))
+ 											ifTrue: [3]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]]].
+ 		[OrCqR]			-> [^(self isQuick: (operands at: 0))
+ 											ifTrue: [3]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]]].
+ 		[SubCqR]		-> [^(self isQuick: (operands at: 0))
+ 											ifTrue: [3]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]]].
+ 		[TstCqR]		-> [^((self isQuick: (operands at: 0)) and: [(self concreteRegister: (operands at: 1)) < 4])
+ 											ifTrue: [3]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]]].
+ 		[AddCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[AndCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[CmpCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[OrCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[SubCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[XorCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[AddRR]			-> [^2].
+ 		[AndRR]			-> [^2].
+ 		[CmpRR]		-> [^2].
+ 		[OrRR]			-> [^2].
+ 		[XorRR]			-> [^2].
+ 		[SubRR]			-> [^2].
+ 		[NegateR]		-> [^2].
+ 		[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: [2] ifFalse: [3]].
+ 		[LogicalShiftRightCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
+ 		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
+ 		[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: [2] ifFalse: [5]].
+ 		[MoveCwR]		-> [^5].
+ 		[MoveRR]		-> [^2].
+ 		[MoveRdRd]		-> [^4].
+ 		[MoveAwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[MoveRAw]		-> [^(self concreteRegister: (operands at: 0)) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[MoveRMwr]	-> [^((self isQuick: (operands at: 1))
+ 											ifTrue: [3]
+ 											ifFalse: [6])
+ 										+ ((self concreteRegister: (operands at: 2)) = ESP
+ 											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: [4]
+ 											ifFalse: [7])
+ 										+ ((self concreteRegister: (operands at: 1)) = ESP
+ 											ifTrue: [1]
+ 											ifFalse: [0])].
+ 		[MoveRMbr]		-> [^((self isQuick: (operands at: 1))
+ 											ifTrue: [3]
+ 											ifFalse: [6])
+ 										+ ((self concreteRegister: (operands at: 2)) = ESP
+ 											ifTrue: [1]
+ 											ifFalse: [0])].
+ 		[MoveM16rR]	-> [^((self isQuick: (operands at: 0))
+ 											ifTrue: [4]
+ 											ifFalse: [7])
+ 										+ ((self concreteRegister: (operands at: 1)) = ESP
+ 											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: [3]
+ 											ifFalse: [6])
+ 										+ ((self concreteRegister: (operands at: 1)) = ESP
+ 											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)) ~= ESP.
+ 							^(self concreteRegister: (operands at: 1)) = EBP
+ 											ifTrue: [4]
+ 											ifFalse: [3]].
+ 		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
+ 							^(self concreteRegister: (operands at: 2)) = EBP
+ 											ifTrue: [4]
+ 											ifFalse: [3]].
+ 		[PopR]			-> [^1].
+ 		[PushR]			-> [^1].
+ 		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
+ 		[PushCw]		-> [^5].
+ 		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [7] ifFalse: [0]]."
+ 		"Conversion"
+ 		"[ConvertRRd]	-> [^4]" }.
+ 	^0 "to keep C compiler quiet"!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeAndCqR (in category 'generate machine code') -----
+ concretizeAndCqR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| mask reg |
+ 	mask := operands at: 0.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: (self rexR: 0 x: 0 b: reg).
+ 	(self isQuick: mask) ifTrue:
+ 		[machineCode
+ 			at: 1 put: 16r83;
+ 			at: 2 put: (self mod: ModReg RM: reg RO: 4);
+ 			at: 3 put: (mask bitAnd: 16rFF).
+ 		 ^machineCodeSize := 4].
+ 	self assert: mask >> 32 = 0.
+ 	reg = RAX ifTrue:
+ 		[machineCode
+ 			at: 1 put: 16r25;
+ 			at: 2 put: (mask bitAnd: 16rFF);
+ 			at: 3 put: (mask >> 8 bitAnd: 16rFF);
+ 			at: 4 put: (mask >> 16 bitAnd: 16rFF);
+ 			at: 5 put: (mask >> 24 bitAnd: 16rFF).
+ 		 ^machineCodeSize := 6].
+ 	machineCode
+ 		at: 1 put: 16r81;
+ 		at: 2 put: (self mod: ModReg RM: reg RO: 4);
+ 		at: 3 put: (mask bitAnd: 16rFF);
+ 		at: 4 put: (mask >> 8 bitAnd: 16rFF);
+ 		at: 5 put: (mask >> 16 bitAnd: 16rFF);
+ 		at: 6 put: (mask >> 24 bitAnd: 16rFF).
+ 	 ^machineCodeSize := 7!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeAt: (in category 'generate machine code') -----
+ concretizeAt: actualAddress
+ 	"Generate concrete machine code for the instruction at actualAddress,
+ 	 setting machineCodeSize, and answer the following address."
+ 
+ 	address := actualAddress.
+ 	self dispatchConcretize.
+ 	self assert: (maxSize = nil or: [maxSize >= machineCodeSize]).
+ 	^actualAddress + machineCodeSize!

Item was added:
+ ----- 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 concretizeCall].
+ 		[JumpR]					-> [^self concretizeJumpR].
+ 		[JumpFull]				-> [^self concretizeJumpLong].
+ 		[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 concretizeAddCqR].
+ 		[AddCwR]					-> [^self concretizeAddCwR].
+ 		[AddRR]						-> [^self concretizeAddRR].
+ 		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
+ 		[AndCqR]					-> [^self concretizeAndCqR].
+ 		[AndCwR]					-> [^self concretizeAndCwR].
+ 		[AndRR]						-> [^self concretizeAndRR].
+ 		[TstCqR]					-> [^self concretizeTstCqR].
+ 		[CmpCqR]					-> [^self concretizeCmpCqR].
+ 		[CmpCwR]					-> [^self concretizeCmpCwR].
+ 		[CmpRR]					-> [^self concretizeCmpRR].
+ 		[CmpRdRd]					-> [^self concretizeCmpRdRd].
+ 		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
+ 		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
+ 		[OrCqR]						-> [^self concretizeOrCqR].
+ 		[OrCwR]					-> [^self concretizeOrCwR].
+ 		[OrRR]						-> [^self concretizeOrRR].
+ 		[SubCqR]					-> [^self concretizeSubCqR].
+ 		[SubCwR]					-> [^self concretizeSubCwR].
+ 		[SubRR]						-> [^self concretizeSubRR].
+ 		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
+ 		[SqrtRd]						-> [^self concretizeSqrtRd].
+ 		[XorCwR]						-> [^self concretizeXorCwR].
+ 		[XorRR]							-> [^self concretizeXorRR].
+ 		[NegateR]						-> [^self concretizeNegateR].
+ 		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
+ 		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
+ 		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
+ 		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
+ 		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
+ 		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
+ 		"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>>isQuick: (in category 'testing') -----
+ isQuick: operand
+ 	<var: #operand type: #'unsigned long'>
+ 	^operand signedIntFromLong between: -128 and: 127!

Item was added:
+ ----- Method: CogX64Compiler>>machineCodeBytes (in category 'generate machine code') -----
+ machineCodeBytes
+ 	"Answer the maximum number of bytes of machine code generated for any abstract instruction.
+ 	 e.g. lock movsd  0x400(%rsp),%xmm4 => f0 f2 0f 10 a4 24 00 04 00 00"
+ 	^10!

Item was added:
+ ----- Method: CogX64Compiler>>mod:RM:RO: (in category 'encoding') -----
+ mod: mod RM: regMode RO: regOpcode
+ 	^mod << 6 + ((regOpcode bitAnd: 7) << 3) + (regMode bitAnd: 7)!

Item was added:
+ ----- Method: CogX64Compiler>>rexR:x:b: (in category 'encoding') -----
+ rexR: reg "<0-15>" x: sibReg "<0-15>"  b: fieldReg "<0-15>"
+ 	^self rexw: true r: reg x: sibReg b: fieldReg!

Item was added:
+ ----- Method: CogX64Compiler>>rexw:r:x:b: (in category 'encoding') -----
+ rexw: width64 "<Boolean>" r: reg "<0-15>" x: sibReg "<0-15>"  b: fieldReg "<0-15>"
+ 	"Given width64, the R register, sib register, and modrm/sib/reg field, answer either nil,
+ 	 if a REX prefix  byte is not needed, or the correctly encoded REX prefix byte.
+ 	 See AMD64 Architecture Programmer's Manual Volume 3: General-Purpose and System Instructions, Table 1-11"
+ 	| regBits |
+ 	regBits := ((reg bitAnd: 8) >> 1) + ((sibReg bitAnd: 8) >> 2) + ((fieldReg bitAnd: 8) >> 3).
+ 	^(width64 or: [regBits ~= 0]) ifTrue:
+ 		[(width64 ifTrue: [16r48] ifFalse: [16r40]) + regBits]!

Item was added:
+ CogInLineLiteralsX64Compiler subclass: #CogX64CompilerForTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Tests'!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>dataRegistersWithAccessorsDo: (in category 'test support') -----
+ dataRegistersWithAccessorsDo: aTrinaryBlock
+ 	self registers withIndexDo:
+ 		[:reg :i|
+ 		aTrinaryBlock
+ 			value: reg
+ 			value: (#(rax rcx rdx rbx rsp rbp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15) at: i)
+ 			value: (#(rax: rcx: rdx: rbx: rsp: rbp: rsi: rdi:  r8: r9: r10: r11: r12: r13: r14: r15:) at: i)]!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>dataRegistersWithAccessorsExcept:do: (in category 'test support') -----
+ dataRegistersWithAccessorsExcept: accessorsToExclude do: aTrinaryBlock
+ 	self registers withIndexDo:
+ 		[:reg :i| | getter setter |
+ 		getter := #(rax rcx rdx rbx rsp rbp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15) at: i.
+ 		setter := #(rax: rcx: rdx: rbx: rsp: rbp: rsi: rdi:  r8: r9: r10: r11: r12: r13: r14: r15:) at: i.
+ 		(accessorsToExclude includes: getter) ifFalse:
+ 			[aTrinaryBlock value: reg value: getter value: setter]]!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>fp64RegistersWithAccessorsDo: (in category 'test support') -----
+ fp64RegistersWithAccessorsDo: aTrinaryBlock
+ 	self fp64registers withIndexDo:
+ 		[:reg :i|
+ 		aTrinaryBlock
+ 			value: reg
+ 			value: (#(xmm0low xmm1low xmm2low xmm3low xmm4low xmm5low xmm6low xmm7low) at: i)
+ 			value: (#(xmm0low: xmm1low: xmm2low: xmm3low: xmm4low: xmm5low: xmm6low: xmm7low:) at: i)]!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>fp64registers (in category 'test support') -----
+ fp64registers
+ 	^{ DPFPReg0. DPFPReg1. DPFPReg2. DPFPReg3. DPFPReg4. DPFPReg5. DPFPReg6. DPFPReg7 } "a.k.a. (-9 to: -16 by: -1)"!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>registers (in category 'test support') -----
+ registers
+ 	^(0 to: 15) "a.k.a. { RAX. RCX. RDX. RBX. RSP. RBP. RSI. RDI. R8. R9. R10. R11. R12. R13. R14. R15 }"!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>registersWithNamesDo: (in category 'test support') -----
+ registersWithNamesDo: aBinaryBlock
+ 	self registers
+ 		with: #('%rax' '%rcx' '%rdx' '%rbx' '%rsp' '%rbp' '%rsi' '%rdi' '%r8' '%r9' '%r10' '%r11' '%r12' '%r13' '%r14' '%r15')
+ 		do: aBinaryBlock!

Item was added:
+ ----- Method: CogX64CompilerForTests class>>xmmRegistersWithNamesDo: (in category 'test support') -----
+ xmmRegistersWithNamesDo: aBinaryBlock
+ 	{XMM0L. XMM1L. XMM2L. XMM3L. XMM4L. XMM5L. XMM6L. XMM7L}
+ 		with: #('%xmm0' '%xmm1' '%xmm2' '%xmm3' '%xmm4' '%xmm5' '%xmm6' '%xmm7')
+ 		do: aBinaryBlock!

Item was added:
+ ----- Method: CogX64CompilerForTests>>concreteRegister: (in category 'encoding') -----
+ concreteRegister: value
+ 	^value!

Item was added:
+ ----- Method: CogX64CompilerForTests>>hasSSE2Instructions (in category 'testing') -----
+ hasSSE2Instructions
+ 	"Answer if we support SSE2"
+ 	^true!

Item was added:
+ AbstractInstructionTests subclass: #CogX64CompilerTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Tests'!

Item was added:
+ ----- Method: CogX64CompilerTests>>concreteCompilerClass (in category 'accessing') -----
+ concreteCompilerClass
+ 	^CogX64CompilerForTests!

Item was added:
+ ----- Method: CogX64CompilerTests>>processor (in category 'accessing') -----
+ processor
+ 	processor ifNil:
+ 		[processor := BochsX64Alien new].
+ 	^processor!

Item was added:
+ ----- Method: CogX64CompilerTests>>strip: (in category 'accessing') -----
+ strip: aFancyDisassembledInstruction
+ 	"Convert e.g. '00000000: movl %rax, 0x2(%rax) : 89 40 02' to  'movl %rax, 0x2(%rax)'"
+ 	^((((aFancyDisassembledInstruction
+ 		copyReplaceAll: '%ds:' with: '')
+ 			copyReplaceAll: '%ss:' with: '')
+ 				allButFirst: (aFancyDisassembledInstruction indexOf: $:) + 1)
+ 					copyUpTo: $:)
+ 						allButLast: 1!

Item was added:
+ ----- Method: CogX64CompilerTests>>testAndCqR (in category 'tests') -----
+ testAndCqR
+ 	"self new testAndCqR"
+ 	self concreteCompilerClass registersWithNamesDo:
+ 		[:reg :regname|
+ 		#(16r1 16r3 16r7 16r555555 16rAAAAAA "16r55AA55AA55AA 16rAA55AA55AA55 no 64-bit constant support with AndC") do:
+ 			[:const| | inst len|
+ 			inst := self gen: AndCqR operand: const operand: reg.
+ 			len := inst concretizeAt: 0.
+ 			self processor
+ 				disassembleInstructionAt: 0
+ 				In: inst machineCode object
+ 				into: [:str :sz| | plainJane herIntended |
+ 					"Convert e.g. '00000000: movq %rax, 0x2(%rax) : 89 40 02' to  'movl %rax, 0x2(%rax)'"
+ 					plainJane := self strip: str.
+ 					herIntended := 'andq $0x', (const printStringBase: 16 length: 16 padded: true), ', ', regname.
+ 					self assert: (plainJane match: herIntended).
+ 					self assert: len = sz]]]!



More information about the Vm-dev mailing list