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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 29 02:07:37 UTC 2015


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

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

Name: VMMaker.oscog-eem.1479
Author: eem
Time: 28 September 2015, 7:05:52.522 pm
UUID: 543de85e-ae35-48a1-9a24-d176a2818012
Ancestors: VMMaker.oscog-eem.1478

and clean up collateral damage

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

Item was added:
+ ----- Method: CogARMCompiler>>isCallPrecedingReturnPC: (in category 'testing') -----
+ isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
+ 	"There are two types of calls: BL and/BLX encoding"
+ 	| call |
+ 	call := self instructionBeforeAddress: mcpc.
+ 	^(self instructionIsBL: call) or:[self instructionIsBLX: call]!

Item was removed:
- ----- Method: CogARMCompiler>>isCallPreceedingReturnPC: (in category 'testing') -----
- isCallPreceedingReturnPC: mcpc
- 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
- 	"There are two types of calls: BL and/BLX encoding"
- 	| call |
- 	call := self instructionBeforeAddress: mcpc.
- 	^(self instructionIsBL: call) or:[self instructionIsBLX: call]!

Item was added:
+ ----- Method: CogAbstractInstruction>>isCallPrecedingReturnPC: (in category 'testing') -----
+ isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
+ 	^self subclassResponsibility!

Item was removed:
- ----- Method: CogAbstractInstruction>>isCallPreceedingReturnPC: (in category 'testing') -----
- isCallPreceedingReturnPC: mcpc
- 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
- 	^self subclassResponsibility!

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

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

Item was added:
+ ----- Method: CogIA32Compiler>>isCallPrecedingReturnPC: (in category 'testing') -----
+ isCallPrecedingReturnPC: mcpc
+ 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
+ 	^(objectMemory byteAt: mcpc - 5) = 16rE8!

Item was removed:
- ----- Method: CogIA32Compiler>>isCallPreceedingReturnPC: (in category 'testing') -----
- isCallPreceedingReturnPC: mcpc
- 	"Assuming mcpc is a return pc answer if the instruction before it is a call."
- 	^(objectMemory byteAt: mcpc - 5) = 16rE8!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>extract32BitOperandFrom4InstructionsPreceding: (in category 'testing') -----
+ extract32BitOperandFrom4InstructionsPreceding: addr
+ 	<inline: true>
+ 	^(objectMemory byteAt: addr -4) 
+ 	 + ((objectMemory byteAt: addr - 8) << 8) 
+ 	 + ((objectMemory byteAt: addr - 12) << 16) 
+ 	 + ((objectMemory byteAt: addr - 16) << 24)!

Item was removed:
- ----- Method: CogInLineLiteralsARMCompiler>>extract32BitOperandFrom4InstructionsPreceeding: (in category 'testing') -----
- extract32BitOperandFrom4InstructionsPreceeding: addr
- 	<inline: true>
- 	^(objectMemory byteAt: addr -4) 
- 	 + ((objectMemory byteAt: addr - 8) << 8) 
- 	 + ((objectMemory byteAt: addr - 12) << 16) 
- 	 + ((objectMemory byteAt: addr - 16) << 24)!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>implicitReceiveCacheAt: (in category 'inline cacheing') -----
  implicitReceiveCacheAt: callSiteReturnAddress
  	"Answer the implicit receiver cache for the return address
  	 of a call to one of the ceImplicitReceiver... trampolines."
  	self assert: (self instructionIsBL: (self instructionBeforeAddress: callSiteReturnAddress)).
+ 	^self extract32BitOperandFrom4InstructionsPreceding: callSiteReturnAddress - 4!
- 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
  inlineCacheTagAt: callSiteReturnAddress
  	"Answer the inline cache tag for the return address of a send."
  	self assert: (self instructionIsBL: (self instructionBeforeAddress: callSiteReturnAddress)).
+ 	^self extract32BitOperandFrom4InstructionsPreceding: callSiteReturnAddress - 4!
- 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>insert32BitOperand:into4InstructionsPreceding: (in category 'testing') -----
+ insert32BitOperand: operand into4InstructionsPreceding: addr
+ 	<inline: true>
+ 	objectMemory
+ 		byteAt: addr -   4 put: (operand			bitAnd: 16rFF);
+ 		byteAt: addr -   8 put: (operand >>   8	bitAnd: 16rFF);
+ 		byteAt: addr - 12 put: (operand >> 16	bitAnd: 16rFF);
+ 		byteAt: addr - 16 put: (operand >> 24	bitAnd: 16rFF)!

Item was removed:
- ----- Method: CogInLineLiteralsARMCompiler>>insert32BitOperand:into4InstructionsPreceeding: (in category 'testing') -----
- insert32BitOperand: operand into4InstructionsPreceeding: addr
- 	<inline: true>
- 	objectMemory
- 		byteAt: addr -   4 put: (operand			bitAnd: 16rFF);
- 		byteAt: addr -   8 put: (operand >>   8	bitAnd: 16rFF);
- 		byteAt: addr - 12 put: (operand >> 16	bitAnd: 16rFF);
- 		byteAt: addr - 16 put: (operand >> 24	bitAnd: 16rFF)!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
  literalBeforeFollowingAddress: followingAddress
  	"Answer the long constant loaded by a MOV/ORR/ORR/ORR
  	 or MOV/ORR/ORR/ORR/PUSH, or MOV/ORR/ORR/ORR/CMP sequence, just before this address:"
  	^(self instructionIsOR: (self instructionBeforeAddress: followingAddress))
+ 		ifTrue: [self extract32BitOperandFrom4InstructionsPreceding: followingAddress]
+ 		ifFalse: [self extract32BitOperandFrom4InstructionsPreceding: followingAddress - 4]!
- 		ifTrue: [self extract32BitOperandFrom4InstructionsPreceeding: followingAddress]
- 		ifFalse: [self extract32BitOperandFrom4InstructionsPreceeding: followingAddress - 4]!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>relocateMethodReferenceBeforeAddress:by: (in category 'inline cacheing') -----
  relocateMethodReferenceBeforeAddress: pc by: delta
  	"If possible we generate the method address using pc-relative addressing.
  	 If so we don't need to relocate it in code.  So check if pc-relative code was
  	 generated, and if not, adjust a long sequence.  There are two cases, a push
  	 or a register load.  If a push, then there is a register load, but in the instruction
  	 before."
  	| pcPreceedingLoad reference |
  	pcPreceedingLoad := (self instructionIsPush: (self instructionBeforeAddress: pc))
  							ifTrue: [pc - 4]
  							ifFalse: [pc].
  	"If the load is not done via pc-relative addressing we have to relocate."
  	(self isPCRelativeValueLoad: (self instructionBeforeAddress: pcPreceedingLoad)) ifFalse:
+ 		[reference := self extract32BitOperandFrom4InstructionsPreceding: pcPreceedingLoad.
- 		[reference := self extract32BitOperandFrom4InstructionsPreceeding: pcPreceedingLoad.
  		 reference := reference + delta.
+ 		 self insert32BitOperand: reference into4InstructionsPreceding: pcPreceedingLoad]!
- 		 self insert32BitOperand: reference into4InstructionsPreceeding: pcPreceedingLoad]!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>rewriteFullTransferAt:target:expectedInstruction: (in category 'inline cacheing') -----
  rewriteFullTransferAt: callSiteReturnAddress target: callTargetAddress expectedInstruction: expectedInstruction
  	"Rewrite a CallFull or JumpFull instruction to transfer 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."
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	"cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1"
  	self assert: (self instructionBeforeAddress: callSiteReturnAddress) = expectedInstruction.
+ 	self insert32BitOperand: callTargetAddress into4InstructionsPreceding: callSiteReturnAddress - 4.
- 	self insert32BitOperand: callTargetAddress into4InstructionsPreceeding: callSiteReturnAddress - 4.
  	self assert: (self callFullTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  	^20!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>rewriteInlineCacheAt:tag:target: (in category 'inline cacheing') -----
  rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target: callTargetAddress
  	"Rewrite an inline cache to call a different target for a new tag.  This variant is used
  	 to link unlinked sends in ceSend:to:numArgs: et al.  Answer the extent of the code
  	 change which is used to compute the range of the icache to flush."
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	| call callDistance |
  	false
  		ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
  		ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
  					[self error: 'linking callsite to invalid address']].
  	callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
  	self assert: (self isInImmediateJumpRange: callDistance). "we don't support long call updates here"
  	call := self bl: callDistance.
  	objectMemory longAt: callSiteReturnAddress - 4 put: call.
+ 	self insert32BitOperand: cacheTag into4InstructionsPreceding: callSiteReturnAddress - 4.
- 	self insert32BitOperand: cacheTag into4InstructionsPreceeding: callSiteReturnAddress - 4.
  	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
+ 	self assert: (self extract32BitOperandFrom4InstructionsPreceding: callSiteReturnAddress - 4) = cacheTag.
- 	self assert: (self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4) = cacheTag.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
  	^20!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>rewriteInlineCacheTag:at: (in category 'inline cacheing') -----
  rewriteInlineCacheTag: cacheTag at: callSiteReturnAddress
  	"Rewrite an inline cache with a new tag.  This variant is used
  	 by the garbage collector."
+ 	self insert32BitOperand: cacheTag into4InstructionsPreceding: callSiteReturnAddress -4!
- 	self insert32BitOperand: cacheTag into4InstructionsPreceeding: callSiteReturnAddress -4!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
  storeLiteral: literal beforeFollowingAddress: followingAddress
  	"Rewrite the long constant loaded by a MOV/ORR/ORR/ORR
  	 or MOV/ORR/ORR/ORR/PUSH  sequence, just before this address:"
  	^(self instructionIsOR: (self instructionBeforeAddress: followingAddress))
+ 		ifTrue: [self insert32BitOperand: literal into4InstructionsPreceding: followingAddress]
+ 		ifFalse: [self insert32BitOperand: literal into4InstructionsPreceding: followingAddress - 4]!
- 		ifTrue: [self insert32BitOperand: literal into4InstructionsPreceeding: followingAddress]
- 		ifFalse: [self insert32BitOperand: literal into4InstructionsPreceeding: followingAddress - 4]!

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

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

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

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

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

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

Item was changed:
  ----- Method: Cogit>>isSendReturnPC: (in category 'jit - api') -----
  isSendReturnPC: retpc
  	<api>
  	"Answer if the instruction preceding retpc is a call instruction."
  	| target |
+ 	(backEnd isCallPrecedingReturnPC: retpc) ifFalse:
- 	(backEnd isCallprecedingReturnPC: retpc) ifFalse:
  		[^false].
  	target := backEnd callTargetFromReturnAddress: retpc.
  	^(target between: firstSend and: lastSend)
  	   or: [target between: methodZoneBase and: methodZone freeStart]!

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

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

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

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

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

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

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

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

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

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

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

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

Item was changed:
  ----- Method: SimpleStackBasedCogit>>recordCallOffsetIn: (in category 'external primitive support') -----
  recordCallOffsetIn: cogMethod
  	<api>
  	<var: #cogMethod type: #'CogMethod *'>
  	| offset offsetTable |
  	<var: #offsetTable type: #'sqInt *'>
  	offset := primSetFunctionLabel address - cogMethod asInteger.
  	(externalSetPrimOffsets at: cogMethod cmNumArgs) isNil
  		ifTrue: [externalSetPrimOffsets at: cogMethod cmNumArgs put: offset]
  		ifFalse: [self assert: (externalSetPrimOffsets at: cogMethod cmNumArgs) = offset].
+ 	offsetTable := (backEnd isCallPrecedingReturnPC: primInvokeLabel address asUnsignedInteger)
- 	offsetTable := (backEnd isCallPreceedingReturnPC: primInvokeLabel address asUnsignedInteger)
  						ifTrue: [externalPrimCallOffsets]
  						ifFalse: [externalPrimJumpOffsets].
  	offset := primInvokeLabel address - cogMethod asInteger.
  	(offsetTable at: cogMethod cmNumArgs) isNil
  		ifTrue: [offsetTable at: cogMethod cmNumArgs put: offset]
  		ifFalse: [self assert: (offsetTable at: cogMethod cmNumArgs) = offset]!



More information about the Vm-dev mailing list