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

commits at source.squeak.org commits at source.squeak.org
Thu Jun 18 23:49:32 UTC 2015


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

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

Name: VMMaker.oscog-eem.1364
Author: eem
Time: 18 June 2015, 4:47:28.809 pm
UUID: da709414-067f-45e5-b1a6-4d14acb3f58d
Ancestors: VMMaker.oscog-eem.1363

ARM Cogit:
Set an out-of-line literal's opcodeIndex when
dumping literals and revise the ARM's
outOfLineLiteralOpcodeLimit up a bit.  Add an assert
to check that the pc offset is in range.

Remember to nil the address on literal allocation.

Make Literals not pc-dependent; only the
instructions that reference them are.

Change the second loop index in generateInstructionsAt:
for easier debugging (run until...)

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

Item was changed:
  CogAbstractInstruction subclass: #CogARMCompiler
  	instanceVariableNames: 'conditionOrNil'
+ 	classVariableNames: 'AL AddOpcode AndOpcode BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CMPSMULL CPSRReg CS CmpNotOpcode CmpOpcode ConcreteIPReg ConcretePCReg ConcreteVarBaseReg EQ GE GT HI LDMFD LE LR LS LT MI MRS MSR MoveNotOpcode MoveOpcode NE OrOpcode OverflowFlag PC PL R0 R1 R10 R11 R12 R2 R3 R4 R5 R6 R7 R8 R9 RsbOpcode SMLALOpcode SMULL SP STMFD SubOpcode TstOpcode VC VS XorOpcode'
- 	classVariableNames: 'AL AddOpcode AndOpcode BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CMPSMULL CPSRReg CS CmpNotOpcode CmpOpcode ConcreteIPReg ConcreteVarBaseReg EQ GE GT HI LDMFD LE LR LS LT MI MRS MSR MoveNotOpcode MoveOpcode NE OrOpcode OverflowFlag PC PL R0 R1 R10 R11 R12 R2 R3 R4 R5 R6 R7 R8 R9 RsbOpcode SMLALOpcode SMULL SP STMFD SubOpcode TstOpcode VC VS XorOpcode'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogARMCompiler commentStamp: 'lw 8/23/2012 19:38' prior: 0!
  I generate ARM instructions from CogAbstractInstructions.  For reference see
  http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.set.architecture/index.html
  
  The Architecture Reference Manual used is that of version 5, which includes some version 6 instructions. Of those, only pld is used(for PrefetchAw).
  
  This class does not take any special action to flush the instruction cache on instruction-modification.!

Item was added:
+ ----- Method: CogARMCompiler class>>PCReg (in category 'accessing') -----
+ PCReg
+ 	^ConcretePCReg!

Item was changed:
  ----- Method: CogARMCompiler class>>initialize (in category 'class initialization') -----
  initialize
  	
  	"Initialize various ARM instruction-related constants."
  	"CogARMCompiler initialize"
  	
  	| specificOpcodes refs |
  	super initialize.
  	self ~~ CogARMCompiler ifTrue: [^self].
  	
  	R0 := 0.
  	R1 := 1.
  	R2 := 2.
  	R3 := 3.
  	R4 := 4.
  	R5 := 5.
  	R6 := 6.
  	R7 := 7.
  	R8 := 8.
  	R9 := 9.
  	R10 := 10.
  	R11 := 11.
  	R12 := 12.
  	SP := 13.
  	LR := 14.
  	PC := 15.
  	
  	CArg0Reg := 0.
  	CArg1Reg := 1.
  	CArg2Reg := 2.
  	CArg3Reg := 3.
  
  	ConcreteVarBaseReg := 10.
  	ConcreteIPReg := 12. "IP, The Intra-Procedure-call scratch register."
+ 	ConcretePCReg := 15.
  	
  	"Condition Codes. Note that cc=16rF is NOT ALLOWED as a condition; it specifies an extension instruction. See e.g.ARM_ARM v5 DDI01001.pdf A3.2.1"
  	EQ := 0.
  	NE := 1.
  	CS := 2.
  	CC := 3.
  	MI := 4.
  	PL := 5.
  	VS := 6.
  	VC := 7.
  	HI := 8.
  	LS := 9.
  	GE := 10.
  	LT := 11.
  	GT := 12.
  	LE := 13.
  	AL := 14.
  
  	"Table A3-2 in sec A3.4 Data-processing instructions of the AARM."
  	AddOpcode := 	4.
  	AndOpcode := 0.
  	BicOpcode := 14.
  	CmpOpcode := 10.
  	CmpNotOpcode := 11.
  	MoveOpcode := 13.
  	MoveNotOpcode := 15.
  	OrOpcode := 12.
  	RsbOpcode := 3.
  	SMLALOpcode := 7.
  	SubOpcode := 2.
  	TstOpcode := 8.
  	XorOpcode := 1.
  
  	CPSRReg := 16.
  	OverflowFlag := 1 << 28.
  
  	"Specific instructions"
  	LastRTLCode isNil ifTrue:
  		[CogRTLOpcodes initialize].
  	specificOpcodes := #(SMULL MSR MRS LDMFD STMFD CMPSMULL).
  	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 changed:
  ----- Method: CogAbstractInstruction>>cloneLiteralFrom: (in category 'initialization') -----
  cloneLiteralFrom: existingLiteral
  	"For out-of-line literal support, clone a literal from a literal."
  	<var: 'existingLiteral' type: #'AbstractInstruction *'>
+ 	self assert: (existingLiteral opcode = Literal and: [dependent isNil and: [address isNil]]).
- 	self assert: (existingLiteral opcode = Literal and: [dependent isNil]).
  	opcode := Literal.
  	annotation := existingLiteral annotation.
  	operands
  		at: 0 put: (existingLiteral operands at: 0);
  		at: 1 put: (existingLiteral operands at: 1);
  		at: 2 put: (existingLiteral operands at: 2)!

Item was changed:
  ----- Method: CogAbstractInstruction>>initializeSharableLiteral: (in category 'initialization') -----
  initializeSharableLiteral: literal
  	"For out-of-line literal support, initialize a sharable literal."
  	opcode := Literal.
+ 	annotation := nil. "separate := nil for Slang"
+ 	address := nil.
+ 	dependent := nil.
- 	dependent := nil. "separate := nil for Slang"
- 	annotation := nil.
  	operands
  		at: 0 put: literal;
  		at: 1 put: true;		"isSharable/isUnique not"
  		at: 2 put: -1			"opcodeIndex"!

Item was changed:
  ----- Method: CogAbstractInstruction>>initializeUniqueLiteral: (in category 'initialization') -----
  initializeUniqueLiteral: literal
  	"For out-of-line literal support, initialize an unsharable literal."
  	opcode := Literal.
+ 	annotation := nil. "separate := nil for Slang"
+ 	address := nil.
+ 	dependent := nil.
- 	dependent := nil. "separate := nil for Slang"
- 	annotation := nil.
  	operands
  		at: 0 put: literal;
  		at: 1 put: false;		"isSharable/isUnique not"
  		at: 2 put: -1			"opcodeIndex"!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>concretizeLiteral (in category 'generate machine code') -----
  concretizeLiteral
  	"Generate an out-of-line literal.  Copy the value and any annotation from the stand-in in the literals manager."
  	| literalAsInstruction literal |
  	literalAsInstruction := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
  	literal := (self isAnInstruction: literalAsInstruction)
  				ifTrue: [literalAsInstruction address]
  				ifFalse: [self cCode: [literalAsInstruction asUnsignedInteger]
  							inSmalltalk: [literalAsInstruction]].
+ 	self assert: (dependent notNil and: [dependent opcode = Literal]).
- 	self assert: (dependent notNil and: [dependent opcode = Literal and: [dependent address = address]]).
  	dependent annotation ifNotNil:
  		[self assert: annotation isNil.
  		 annotation := dependent annotation].
+ 	dependent address ifNotNil: [self assert: dependent address = address].
+ 	dependent address: address.
+ 	self machineCodeAt: 0 put: literal.
+ 	machineCodeSize := 4!
- 	self machineCodeAt: 0 put: literal!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>isPCDependent (in category 'testing') -----
  isPCDependent
  	"Answer if the receiver is a pc-dependent instruction.  With out-of-line literals any instruction
  	 that refers to a literal depends on the address of the literal, so add them in addition to the jumps."
  	^self isJump
  	  or: [opcode = AlignmentNops
+ 	  or: [opcode ~= Literal and: [dependent notNil and: [dependent opcode = Literal]]]]!
- 	  or: [dependent notNil and: [dependent opcode = Literal]]]!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>moveCw:intoR: (in category 'generate machine code - support') -----
  moveCw: constant intoR: destReg
  	"Emit a load of aWord into destReg.  Answer the number of bytes of machine code generated.
  	 Literals are stored out-of-line; emit a LDR with the relevant offset."
  	 <var: 'constant' type: #usqInt>
  	<inline: true>
  	self assert: (cogit addressIsInCurrentCompilation: dependent address).
+ 	self assert: (dependent address - (address + 8)) abs < (1<<12).
  	self machineCodeAt: 0
  		put: (self
  				ldr: destReg
  				rn: PC
  				plus: (dependent address >= (address + 8) ifTrue: [1] ifFalse: [0])
  				imm: (dependent address - (address + 8)) abs).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>outOfLineLiteralOpcodeLimit (in category 'compile abstract instructions') -----
  outOfLineLiteralOpcodeLimit
+ 	"The maximum offset in a LDR is (1<<12)-1, or (1<<10)-1 instructions.
+ 	 Be a little conservative."
+ 	^1<<(12-2) - 4!
- 	"The maximum offset in a LDR is 1<<12.  Be conservative."
- 	^1<<(11-2)!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>setLiteralOpcodeIndex: (in category 'generate machine code') -----
+ setLiteralOpcodeIndex: index
+ 	"Hack:  To know how far away a literal is from its referencing instruction we store
+ 	 its opcodeIndex, or -1, if as yet unassigned, in the second operand of the literal."
+ 	<inline: true>
+ 	self assert: opcode = Literal.
+ 	operands at: 2 put: index!

Item was changed:
  ----- Method: Cogit>>generateInstructionsAt: (in category 'generate machine code') -----
  generateInstructionsAt: eventualAbsoluteAddress
  	"Size pc-dependent instructions and assign eventual addresses to all instructions.
  	 Answer the size of the code.
  	 Compute forward branches based on virtual address (abstract code starts at 0),
  	 assuming that any branches branched over are long.
  	 Compute backward branches based on actual address.
  	 Reuse the fixups array to record the pc-dependent instructions that need to have
  	 their code generation postponed until after the others."
  	| absoluteAddress pcDependentIndex abstractInstruction fixup |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	absoluteAddress := eventualAbsoluteAddress.
  	pcDependentIndex := 0.
  	0 to: opcodeIndex - 1 do:
  		[:i|
  		breakPC = absoluteAddress ifTrue:
  			[self halt: 'breakPC reached in generateInstructionsAt:'].
  		abstractInstruction := self abstractInstructionAt: i.
  		abstractInstruction isPCDependent
  			ifTrue:
  				[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
  				 fixup := self fixupAt: pcDependentIndex.
  				 pcDependentIndex := pcDependentIndex + 1.
  				 fixup instructionIndex: i.
  				 absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
  			ifFalse:
  				[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
  	0 to: pcDependentIndex - 1 do:
+ 		[:j|
+ 		fixup := self fixupAt: j.
- 		[:i|
- 		fixup := self fixupAt: i.
  		abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
  		breakPC = absoluteAddress ifTrue:
  			[self halt: 'breakPC reached in generateInstructionsAt:'].
  		abstractInstruction concretizeAt: abstractInstruction address].
  	self cCode: ''
  		inSmalltalk:
  			[breakPC ifNotNil:
  				[breakPC <= absoluteAddress ifTrue:
  					[self singleStep: true]]].
  	^absoluteAddress - eventualAbsoluteAddress!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>dumpLiterals: (in category 'compile abstract instructions') -----
  dumpLiterals: generateBranchAround
  	"Output all pending literal instructions, making the originals dependents of the generated ones
  	 so that a later pass will copy the address of each generated literl inst to its original in literals,
  	 and hence allow the instruction using the literal to compute the correct address.."
  	| jump litInst |
  	<var: 'jump' type: #'AbstractInstruction *'>
  	<var: 'litInst' type: #'AbstractInstruction *'>
  
  	generateBranchAround ifTrue:
  		[jump := cogit Jump: 0].
  	lastDumpedLiteralIndex to: nextLiteralIndex - 1 do:
  		[:i|
  		litInst := self literalInstructionAt: i.
+ 		(cogit gen: Literal operand: (litInst operands at: 0)) dependent: litInst.
+ 		litInst setLiteralOpcodeIndex: cogit getOpcodeIndex].
- 		(cogit gen: Literal operand: (litInst operands at: 0)) dependent: litInst].
  	generateBranchAround ifTrue:
  		[jump jmpTarget: cogit Label].
  
  	firstOpcodeIndex := cogit getOpcodeIndex.
  	lastDumpedLiteralIndex := nextLiteralIndex!



More information about the Vm-dev mailing list