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

commits at source.squeak.org commits at source.squeak.org
Thu Jun 18 21:01:01 UTC 2015


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

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

Name: VMMaker.oscog-eem.1363
Author: eem
Time: 18 June 2015, 1:58:49.325 pm
UUID: 7688edec-456b-4fce-a6e0-b0dd8cf2877a
Ancestors: VMMaker.oscog-eem.1362

Move the Literal initialization code into
CogAbstractInstruction and make sure they are
fully initializaed (old code left bogus annotations).

At least under X11 the OOLL ARM Cog VM now runs.

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

Item was changed:
+ ----- Method: CogARMCompiler>>outputMachineCodeAt: (in category 'generate machine code') -----
- ----- Method: CogARMCompiler>>outputMachineCodeAt: (in category 'inline cacheing') -----
  outputMachineCodeAt: targetAddress
  	"Override to move machine code a word at a time."
  	<inline: true>
  	0 to: machineCodeSize - 1 by: 4 do:
  		[:j|
  		objectMemory longAt: targetAddress + j put: (machineCode at: j // 4)]!

Item was added:
+ ----- 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]).
+ 	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 added:
+ ----- Method: CogAbstractInstruction>>initializeSharableLiteral: (in category 'initialization') -----
+ initializeSharableLiteral: literal
+ 	"For out-of-line literal support, initialize a sharable literal."
+ 	opcode := Literal.
+ 	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 added:
+ ----- Method: CogAbstractInstruction>>initializeUniqueLiteral: (in category 'initialization') -----
+ initializeUniqueLiteral: literal
+ 	"For out-of-line literal support, initialize an unsharable literal."
+ 	opcode := Literal.
+ 	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: CogAbstractInstruction>>outputMachineCodeAt: (in category 'generate machine code') -----
- ----- Method: CogAbstractInstruction>>outputMachineCodeAt: (in category 'encoding') -----
  outputMachineCodeAt: targetAddress
  	"By default move machine code a byte at a time
  	  Subclasses with coarser granularity can override as desired."
  	<inline: true>
  	0 to: machineCodeSize - 1 do:
  		[:j|
  		objectMemory byteAt: targetAddress + j put: (machineCode at: j)]!

Item was changed:
+ ----- Method: CogAbstractInstruction>>rewriteCallFullAt:target: (in category 'full transfer run-time support') -----
- ----- Method: CogAbstractInstruction>>rewriteCallFullAt:target: (in category 'full run-time support') -----
  rewriteCallFullAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a CallFull instruction to call a different target.  This variant is used to rewrite cached primitive calls.
  	 Answer the extent of the code change which is used to compute the range of the icache to flush.
  	 This defaults to rewriteCallAt:target:; processors that differentiate between Call and CallFull will override."
  	^self rewriteCallAt: callSiteReturnAddress target: callTargetAddress!

Item was changed:
+ ----- Method: CogAbstractInstruction>>rewriteJumpFullAt:target: (in category 'full transfer run-time support') -----
- ----- Method: CogAbstractInstruction>>rewriteJumpFullAt:target: (in category 'full run-time support') -----
  rewriteJumpFullAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a JumpFull instruction to jump to a different target.  This variant is used to rewrite cached primitive calls.
  	 Answer the extent of the code change which is used to compute the range of the icache to flush.
  	 This defaults to rewriteJumpLongAt:target:; processors that differentiate between Jump and JumpFull will override."
  	^self rewriteJumpLongAt: callSiteReturnAddress target: callTargetAddress!

Item was removed:
- ----- Method: CogOutOfLineLiteralsARMCompiler>>isUnique (in category 'generate machine code') -----
- isUnique
- 	"Hack:  To know if a literal should be unique (not shared) mark the second operand."
- 	<inline: true>
- 	self assert: opcode = Literal.
- 	^(operands at: 1) not!

Item was removed:
- ----- Method: CogOutOfLineLiteralsARMCompiler>>setIsSharable (in category 'generate machine code') -----
- setIsSharable
- 	"Hack:  To know if a literal should be unique (not shared) mark the second operand."
- 	<inline: true>
- 	self assert: opcode = Literal.
- 	^operands at: 1 put: true!

Item was removed:
- ----- Method: CogOutOfLineLiteralsARMCompiler>>setIsUnique (in category 'generate machine code') -----
- setIsUnique
- 	"Hack:  To know if a literal should be unique (not shared) mark the second operand."
- 	<inline: true>
- 	self assert: opcode = Literal.
- 	^operands at: 1 put: false!

Item was removed:
- ----- 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: OutOfLineLiteralsManager>>allocateLiteral: (in category 'compile abstract instructions') -----
  allocateLiteral: aLiteral
  	"Allocate an unsharable Literal instruction for the literal and answer it."
  	<returnTypeC: #'AbstractInstruction *'>
  	<inline: true>
  	| litInst |
  	<var: 'litInst' type: #'AbstractInstruction *'>
  	nextLiteralIndex >= literalsSize ifTrue:
  		[self allocateLiterals: literalsSize + 8].
  	litInst := self literalInstructionAt: nextLiteralIndex.
+ 	litInst initializeUniqueLiteral: aLiteral.
- 	litInst
- 		opcode: Literal;
- 		operand0: aLiteral;
- 		setIsUnique;
- 		setLiteralOpcodeIndex: -1; "means as-yet-unassigned; see literalInstructionInRange:"
- 		dependent: nil.
  	nextLiteralIndex := nextLiteralIndex + 1.
  	"Record the opcodeIndex of the first dependent instruction (the first instruction that references an out-of-line literal)"
  	firstOpcodeIndex > cogit getOpcodeIndex ifTrue:
  		[firstOpcodeIndex := cogit getOpcodeIndex - 1].
  	^litInst!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>allocateLiterals: (in category 'initialization') -----
  allocateLiterals: initialNumLiterals
  	<inline: true>
  	| newLiterals newInst existingInst |
  	<var: 'newInst' type: #'AbstractInstruction *'>
  	<var: 'existingInst' type: #'AbstractInstruction *'>
  	<var: 'newLiterals' type: #'AbstractInstruction *'>
  	initialNumLiterals > literalsSize ifTrue:
  		[newLiterals := self cCode:
  								[self c: initialNumLiterals alloc: (self sizeof: CogAbstractInstruction)]
  							inSmalltalk:
  								[CArrayAccessor on: ((1 to: initialNumLiterals) collect: [:i| CogCompilerClass for: cogit])].
  		 "Must copy across state (not using realloc, cuz...) and
  		  must also update existing instructions to refer to the new ones...
  		  It's either this or modify all generation routines to be able to retry
  		  with more literals after running out of literals."
  		 literals ifNotNil:
  			[0 to: nextLiteralIndex - 1 do:
  				[:i|
  				existingInst := self literalInstructionAt: i.
  				newInst := self addressOf: (newLiterals at: i).
+ 				newInst cloneLiteralFrom: existingInst.
- 				newInst
- 					opcode: Literal;
- 					operand0: (existingInst operands at: 0);
- 					setLiteralOpcodeIndex: existingInst literalOpcodeIndex.
  				self assert: existingInst dependent isNil.
  				existingInst dependent: newInst].
  			0 to: cogit getOpcodeIndex - 1 do:
  				[:i|
  				existingInst := cogit abstractInstructionAt: i.
  				(existingInst dependent notNil
  				 and: [existingInst dependent opcode = Literal]) ifTrue:
  					[existingInst dependent: existingInst dependent dependent]]].
  		 self cCode: [self free: literals] inSmalltalk: [].
  		 literals := newLiterals.
  		 literalsSize := initialNumLiterals]!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>locateLiteral: (in category 'compile abstract instructions') -----
  locateLiteral: aLiteral
  	"Search for a Literal instruction that is in-range and answer it.  Otherwise
  	 allocate a new sharable Literal instruction for the literal and answer it."
  	<returnTypeC: #'AbstractInstruction *'>
  	<inline: false>
  	| litInst |
  	<var: 'litInst' type: #'AbstractInstruction *'>
  	0 to: nextLiteralIndex - 1 do:
  		[:i|
  		litInst := self literalInstructionAt: i.
  		((litInst operands at: 0) = aLiteral
  		 and: [litInst isSharable
  		 and: [self literalInstructionInRange: litInst]]) ifTrue:
  			[^litInst]].
  	nextLiteralIndex >= literalsSize ifTrue:
  		[self allocateLiterals: literalsSize + 8].
  	litInst := self literalInstructionAt: nextLiteralIndex.
+ 	litInst initializeSharableLiteral: aLiteral.
- 	litInst
- 		opcode: Literal;
- 		operand0: aLiteral;
- 		setIsSharable;
- 		setLiteralOpcodeIndex: -1; "means as-yet-unassigned; see literalInstructionInRange:"
- 		dependent: nil.
  	nextLiteralIndex := nextLiteralIndex + 1.
  	"Record the opcodeIndex of the first dependent instruction (the first instruction that references an out-of-line literal)"
  	firstOpcodeIndex > cogit getOpcodeIndex ifTrue:
  		[firstOpcodeIndex := cogit getOpcodeIndex - 1].
  	^litInst!



More information about the Vm-dev mailing list