[Vm-dev] VM Maker: VMMaker.oscog-tpr.1197.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Apr 15 02:19:27 UTC 2015


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tpr.1197.mcz

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

Name: VMMaker.oscog-tpr.1197
Author: tpr
Time: 14 April 2015, 7:18:07.275 pm
UUID: b9bf7cd9-ddce-4c05-afc3-b7830daa9842
Ancestors: VMMaker.oscog-eem.1196

Changes that make ARM cog go further and in somer cases faster.
The genGetActiveContextLarge:inBlock: code may well be wrong to wrap the callRT:.

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, ASR #distance"
- 	Handle for now with a MOV reg, reg, ASR #distance"
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
  	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist -100 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg 
- 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 0 rn: 0 rd: reg 
  									shifterOperand: (distance << 7 bitOr: (64 "flag for arithmetic" bitOr: reg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightRR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, ASR distReg"
- 	Handle for now with a MOV reg, reg, ASR distReg"
  	<inline: true>
  	| destReg distReg |
  	distReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 destR distR 0101 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
- 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 0 rn: 0 rd: destReg 
  									shifterOperand: (distReg << 8 bitOr: (80 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, LSL #distance"
- 	Handle for now with a MOV reg, reg, LSL #distance"
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
  	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dista 000 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg shifterOperand: (distance << 7 bitOr: reg)).
- 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 0 rn: 0 rd: reg shifterOperand: (distance << 7 bitOr: reg)).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftRR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, LSL distReg" 
- 	Handle for now with a MOV reg, reg, LSL distReg"
  	<inline: true>
  	| destReg distReg |
  	distReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0001 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
- 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 0 rn: 0 rd: destReg 
  									shifterOperand: (distReg << 8 bitOr: (16 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, LSR #distance"
- 	Handle for now with a MOV reg, reg, LSR #distance"
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
  	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist -010 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg 
- 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 0 rn: 0 rd: reg 
  									shifterOperand: (distance << 7 bitOr: (32 bitOr: reg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightRR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, LSR distReg"
- 	Handle for now with a MOV reg, reg, LSR distReg"
  	<inline: true>
  	| destReg distReg |
  	distReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0011 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
- 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 0 rn: 0 rd: destReg 
  									shifterOperand: (distReg << 8 bitOr: (48 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetActiveContextLarge:inBlock: (in category 'initialization') -----
  genGetActiveContextLarge: isLarge inBlock: isInBlock
  	"Create a trampoline to answer the active context that will
  	 answer it if a frame is already married, and create it otherwise.
  	 Assume numArgs is in SendNumArgsReg and ClassReg is free."
  	| header slotSize jumpSingle loopHead jumpNeedScavenge continuation exit |
  	<var: #jumpNeedScavenge type: #'AbstractInstruction *'>
  	<var: #continuation type: #'AbstractInstruction *'>
  	<var: #jumpSingle type: #'AbstractInstruction *'>
  	<var: #loopHead type: #'AbstractInstruction *'>
  	<var: #exit type: #'AbstractInstruction *'>
+ 	cogit "load the flag; stash it in both TempReg & ClassReg; do the compare (a prime candidated for use of AndCq:R:R:)"
+ 		MoveMw: FoxMethod r: FPReg R: ClassReg;
+ 		AndCq: MFMethodFlagHasContextFlag R: ClassReg R: TempReg.
+ 	jumpSingle := cogit JumpZero: 0. "jump if flag bit not set"
+ 	cogit "since the flag bit was set, get the context in the receiver reg and return"
- 	cogit
- 		MoveMw: FoxMethod r: FPReg R: TempReg;
- 		MoveR: TempReg R: ClassReg;
- 		AndCq: MFMethodFlagHasContextFlag R: TempReg.
- 	jumpSingle := cogit JumpZero: 0.
- 	cogit
  		MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg;
  		RetN: 0.
  	jumpSingle jmpTarget: cogit Label.
  
  	"OK, it doesn't exist; instantiate and initialize it"
  	"set the hasContext flag; See CoInterpreter class>>initializeFrameIndices"
  	cogit
  		OrCq: MFMethodFlagHasContextFlag R: ClassReg;
  		MoveR: ClassReg Mw: FoxMethod r: FPReg.
  	"now get the home CogMethod into ClassReg and save for post-instantiation."
  	isInBlock
  		ifTrue:
  			[cogit
  				SubCq: 3 R: ClassReg; "-3 is -(hasContext+isBlock) flags"
  				MoveM16: 0 r: ClassReg R: TempReg;
  				SubR: TempReg R: ClassReg]
  		ifFalse:
  			[cogit SubCq: 1 R: ClassReg]. "-1 is hasContext flag"
  
  	"instantiate the context..."
  	slotSize := isLarge ifTrue: [LargeContextSlots] ifFalse: [SmallContextSlots].
  	header := objectMemory
  					headerForSlots: slotSize
  					format: objectMemory indexablePointersFormat
  					classIndex: ClassMethodContextCompactIndex.
  	self flag: #endianness.
  	cogit
  		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
  		MoveCq: (self low32BitsOf: header) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg;
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	jumpNeedScavenge := cogit JumpAboveOrEqual: 0.
  
  	"Now initialize the fields of the context.  See CoInterpreter>>marryFrame:SP:copyTemps:"
  	"sender gets frame pointer as a SmallInteger"
  	continuation :=
  	cogit MoveR: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (SenderIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"pc gets frame caller as a SmallInteger"
  	cogit MoveMw: FoxSavedFP r: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (InstructionPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the method field, freeing up ClassReg again, and frame's context field,"
  	cogit
  		MoveMw: (cogit offset: CogMethod of: #methodObject) r: ClassReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (MethodIndex * objectMemory wordSize) r: ReceiverResultReg;
  		MoveR: ReceiverResultReg Mw: FoxThisContext r: FPReg.
  
  	"Now compute stack pointer; this is stackPointer (- 1 for return pc if a CISC) - framePointer - 4 (1 each for saved pc, method, context, receiver) + 1 (1-relative)"
  	cogit
  		MoveR: FPReg R: TempReg;
  		SubR: SPReg R: TempReg;
  		LogicalShiftRightCq: self log2BytesPerWord R: TempReg;
  		SubCq: (cogit backEnd hasLinkRegister ifTrue: [3] ifFalse: [4]) R: TempReg;
  		AddR: SendNumArgsReg R: TempReg.
  	self genConvertIntegerToSmallIntegerInReg: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (StackPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set closureOrNil to either the stacked receiver or nil"
  	isInBlock
  		ifTrue:
  			[cogit
  				MoveR: SendNumArgsReg R: TempReg;
  				AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  				MoveXwr: TempReg R: FPReg R: TempReg]
  		ifFalse:
  			[cogit MoveCw: objectMemory nilObject R: TempReg].
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (ClosureIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the receiver"
  	cogit
  		MoveMw: FoxMFReceiver r: FPReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (ReceiverIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Now copy the arguments.  This is tricky because of the shortage of registers,.  ClassReg ranges
  	 from 1 to numArgs (SendNumArgsReg), and from ReceiverIndex + 1 to ReceiverIndex + numArgs.
  	 1 to: numArgs do:
  		[:i|
  		temp := longAt(FPReg + ((SendNumArgs - i + 2) * BytesPerWord)). +2 for saved pc and savedfp
  		longAtput(FPReg + FoxMFReceiver + (i * BytesPerWord), temp)]"
  	cogit MoveCq: 1 R: ClassReg.
  	loopHead := cogit CmpR: SendNumArgsReg R: ClassReg.
  	exit := cogit JumpGreater: 0.
  	cogit
  		MoveR: SendNumArgsReg R: TempReg;
  		SubR: ClassReg R: TempReg;
  		AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  		MoveXwr: TempReg R: FPReg R: TempReg;
  		AddCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) R: ClassReg; "Now convert ClassReg from frame index to context index"
  		MoveR: TempReg Xwr: ClassReg R: ReceiverResultReg;
  		SubCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) - 1 R: ClassReg; "convert back adding 1 ;-)"
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	"Finally copy the temps.
  	 ClassReg := FPReg + FoxMFReceiver.
  	 SendNumArgsReg := SendNumArgsReg+ReceiverIndex.
  	 [ClassReg := ClassReg - 4.
  	  backEnd hasLinkRegister
  			ifTrue: [ClassReg > SPReg]
  			ifFalse: [ClassReg >= SPReg]] whileTrue:
  		[receiver[SendNumArgsReg] := *ClassReg.
  		 SendNumArgsReg := SendNumArgsReg + 1]]"
  	cogit
  		MoveR: FPReg R: ClassReg;
  		AddCq: FoxMFReceiver R: ClassReg;
  		AddCq: ReceiverIndex + 1 + (objectMemory baseHeaderSize / objectMemory wordSize) R: SendNumArgsReg.
  	loopHead :=
  	cogit SubCq: objectMemory wordSize R: ClassReg.
  	cogit CmpR: SPReg R: ClassReg.
  	exit := cogit backEnd hasLinkRegister
  				ifTrue: [cogit JumpBelowOrEqual: 0]
  				ifFalse: [cogit JumpBelow: 0].
  	cogit
  		MoveMw: 0 r: ClassReg R: TempReg;
  		MoveR: TempReg Xwr: SendNumArgsReg R: ReceiverResultReg;
  		AddCq: 1 R: SendNumArgsReg;
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	cogit RetN: 0.
  	
  	jumpNeedScavenge jmpTarget:
+ 		(cogit backEnd saveAndRestoreLinkRegAround: [cogit CallRT: ceScheduleScavengeTrampoline]). "We need to push the LR here for ARM, and pop it back after the callRT:"
- 		(cogit CallRT: ceScheduleScavengeTrampoline).
  	cogit Jump: continuation.
  	^0!

Item was changed:
  ----- Method: Cogit>>compileTrampolineFor:numArgs:arg:arg:arg:arg:saveRegs:pushLinkReg:resultReg: (in category 'initialization') -----
  compileTrampolineFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNil
  	"Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutine
  	 as requested by callJumpBar.  If generating a call and resultRegOrNil is non-zero pass the C result
  	 back in resultRegOrNil.
  	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
  	<var: #aRoutine type: #'void *'>
  	<inline: false>
+ 	"If on an ARM-like RISC processor, the return address needs to be pushed to the
- 	"If on a RISC processor, the return address needs to be pushed to the
  	 stack so that the interpreter sees the same stack layout as on CISC."
  	(pushLinkReg and: [backEnd hasLinkRegister]) ifTrue:
  		[self PushR: LinkReg].
  	self genSmalltalkToCStackSwitch.
  	self
  		compileCallFor: aRoutine
  		numArgs: numArgs
  		arg: regOrConst0
  		arg: regOrConst1
  		arg: regOrConst2
  		arg: regOrConst3
  		resultReg: resultRegOrNil
  		saveRegs: saveRegs.
  	backEnd genLoadStackPointers.
+ 	(pushLinkReg and: [backEnd hasLinkRegister])
+ 		ifTrue: [self PopR: PCReg] "since we know there is no SP messing to do, might as well pop the stacked return address straight into PC"
+ 		ifFalse:[ self RetN: 0]!
- 	(pushLinkReg and: [backEnd hasLinkRegister]) ifTrue:
- 		[self PopR: LinkReg].
- 	self RetN: 0!

Item was changed:
  ----- Method: Cogit>>genNonLocalReturnTrampoline (in category 'initialization') -----
  genNonLocalReturnTrampoline
  	opcodeIndex := 0.
  	"write the return address to the coInterpreter instructionPointerAddress;
+ 	 following the CallRT to this CISCs will have pushed it on the stack, so pop it first; RISCs will have it in
- 	 CISCs will have pushed it on the stack, so pop it first; RISCs will have it in
  	 their link register so just write it directly."
  	backEnd hasLinkRegister
  		ifTrue:
  			[self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress]
  		ifFalse:
  			[self PopR: TempReg. "instruction pointer"
  			 self MoveR: TempReg Aw: coInterpreter instructionPointerAddress].
  	^self genTrampolineFor: #ceNonLocalReturn:
  		called: 'ceNonLocalReturnTrampoline'
  		numArgs: 1
  		arg: ReceiverResultReg
  		arg: nil
  		arg: nil
  		arg: nil
  		saveRegs: false
  		pushLinkReg: false
  		resultReg: nil
  		appendOpcodes: true!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
  genPrimReturnEnterCogCodeEnilopmart: profiling
  	"Generate the substitute return code for an external or FFI primitive call.
  	 On success simply return, extracting numArgs from newMethod.
  	 On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
  	| jmpSample continuePostSample jmpFail |
  	<var: #jmpSample type: #'AbstractInstruction *'>
  	<var: #continuePostSample type: #'AbstractInstruction *'>
  	<var: #jmpFail type: #'AbstractInstruction *'>
  	opcodeIndex := 0.
  
  	profiling ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick: if so.
  		  N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves."
  		objectMemory wordSize = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSample := self JumpNonZero: 0.
  		continuePostSample := self Label].
  
  	self maybeCompileAllocFillerCheck.
  
  	"Test primitive failure"
  	self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  	self flag: 'ask concrete code gen if move sets condition codes?'.
  	self CmpCq: 0 R: TempReg.
  	jmpFail := self JumpNonZero: 0.
  
  	"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  		success:	stackPointer	->	result (was receiver)
  										arg1
  										...
  										argN
  										return pc
  		failure:							receiver
  										arg1
  										...
  					stackPointer	->	argN
  										return pc
  	We push the instructionPointer to reestablish the return pc in the success case,
  	but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."
  
  	backEnd hasLinkRegister
  		ifTrue:
  			[backEnd genLoadStackPointers.											"Switch back to Smalltalk stack."
  			 backEnd hasPCRegister
  				ifTrue:
  					[self PopR: ReceiverResultReg.										"Pop result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: PCReg]	"Return"
  				ifFalse:
  					[self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: LinkReg.	"Get ret pc"
  					 self RetN: objectMemory wordSize]]								"Return, popping result from stack"
  		ifFalse:
  			[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.	"Get return pc"
  			 backEnd genLoadStackPointers.									"Switch back to Smalltalk stack."
  			 self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  			 self MoveR: ClassReg Mw: 0 r: SPReg.								"Restore return pc"
  			 self RetN: 0].														"Return, popping result from stack"
  
  	"Primitive failed.  Invoke C code to build the frame and continue."
  	jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
  	"Reload sp with CStackPointer; easier than popping args of checkProfileTick."
  	self MoveAw: self cStackPointerAddress R: SPReg.
  	self 
  		compileCallFor: #ceActivateFailingPrimitiveMethod:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: nil
  		saveRegs: false.
  
  	"On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful.
  	 So continue by returning to the caller.
  	 Switch back to the Smalltalk stack.  Stack should be in this state:
  				success:	stackPointer ->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  	 We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  	self MoveAw: coInterpreter instructionPointerAddress
  		R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  	backEnd genLoadStackPointers.
  	backEnd hasLinkRegister
  		ifTrue:
  			[self MoveMw: 0 r: SPReg R: ReceiverResultReg]	"Fetch result from stack"
  		ifFalse:
  			[self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg.	"Fetch result from stack"
  			 self PushR: ClassReg].											"Restore return pc on CISCs"
  	self flag: 'currently caller pushes result'.
  	self RetN: objectMemory wordSize.	"return to caller, popping receiver"
  
  	profiling ifTrue:
  		["Call ceCheckProfileTick: to record sample and then continue.  newMethod
  		 should be up-to-date.  Need to save and restore the link reg around this call."
  		 jmpSample jmpTarget: self Label.
+ 		 backEnd saveAndRestoreLinkRegAround:
+ 			[self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
+ 						inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick])].
- 		 backEnd hasLinkRegister ifTrue: [self PushR: LinkReg].
- 		 self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
- 						inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
- 		 backEnd hasLinkRegister ifTrue: [self PopR: LinkReg].
  		 self Jump: continuePostSample]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails.
  	 Override to push the register args when calling ceSendFromInLineCacheMiss:"
  	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self compilePICAbort: numArgs.
  	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  	self MoveR: ClassReg R: SendNumArgsReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	itsAHit := self Label.
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)
  		r: ClassReg
  		R: SendNumArgsReg.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
  	objectRepresentation
  		genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
  	jumpBCMethod jmpTarget: picInterpretAbort.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	objectMemory shiftForWord > 2 ifTrue:
  		[self LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg].
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromInLineCacheMiss: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	backEnd genPushRegisterArgsForNumArgs: numArgs.
+ 	"because genPushRegisterArgsForNumArgs: doesn't push LinkReg on ARM..."
+ 	backEnd hasLinkRegister ifTrue:
+ 		[self PushR: LinkReg].
  	self genSmalltalkToCStackSwitch.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
  	self 
  		compileCallFor: #ceSendFromInLineCacheMiss:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: nil
  		saveRegs: false
  	"Note that this call does not return."!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genMethodAbortTrampolineFor: (in category 'initialization') -----
  genMethodAbortTrampolineFor: numArgs
  	
  	"Generate the abort for a method.  This abort performs either a call of ceSICMiss:
  	 to handle a single-in-line cache miss or a call of ceStackOverflow: to handle a
  	 stack overflow.  It distinguishes the two by testing ResultReceiverReg.  If the
  	 register is zero then this is a stack-overflow because a) the receiver has already
  	 been pushed and so can be set to zero before calling the abort, and b) the
  	 receiver must always contain an object (and hence be non-zero) on SIC miss."
  	| jumpSICMiss |
  	<var: #jumpSICMiss type: #'AbstractInstruction *'>
  	opcodeIndex := 0.
  	self CmpCq: 0 R: ReceiverResultReg.
  	jumpSICMiss := self JumpNonZero: 0.
  
+ 	"The abort sequencer has pushed the LinkReg a second time - because a stackoverflow can only happen after building a frame, which pushes LinkReg anyway, and we still need to push LinkReg in case we get to this routine from a sendMissAbort. Sigh-  there has to be a simpler way.
+ 	 Overwrite that duplicate with the right one - the return address for the call to the abort trampoline. The only reason it matters is an assert in ceStackOverflow: uses it"
- 	"The abort sequencer has pushed the LinkReg a second time.
- 	 Overwrite it with the right one."
  	backEnd hasLinkRegister ifTrue:
  		[self MoveR: LinkReg Mw: 0 r: SPReg].
  	self compileTrampolineFor: #ceStackOverflow:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		saveRegs: false
  		pushLinkReg: false "The LinkReg has already been set above."
  		resultReg: nil.
  	jumpSICMiss jmpTarget: self Label.
  	backEnd genPushRegisterArgsForAbortMissNumArgs: numArgs.
  	^self genTrampolineFor: #ceSICMiss:
  		called: (self trampolineName: 'ceMethodAbort' numArgs: (numArgs <= self numRegArgs ifTrue: [numArgs] ifFalse: [-1]))
  		numArgs: 1
  		arg: ReceiverResultReg
  		arg: nil
  		arg: nil
  		arg: nil
  		saveRegs: false
  		pushLinkReg: false "The LinkReg will have been pushed in genPushRegisterArgsForAbortMissNumArgs: above."
  		resultReg: nil
  		appendOpcodes: true!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUpArrowReturn (in category 'bytecode generators') -----
  genUpArrowReturn
  	"Generate a method return from within a method or a block.
  	 Frameless method activation looks like
+ 	for x86 - 
  				receiver
  				args
  		sp->	ret pc.
+ 	for ARM -
+ 				receiver
+ 				args
+ 				ret pc in LR.
+ 	A fully framed activation is described in CoInterpreter class>initializeFrameIndices.
  	 Return pops receiver and arguments off the stack.  Callee pushes the result."
  	inBlock ifTrue:
+ 		[self assert: needsFrame. 
- 		[self assert: needsFrame.
  		 self annotateBytecode: (self CallRT: ceNonLocalReturnTrampoline).
  		 ^0].
  	needsFrame
  		ifTrue:
  			[self MoveR: FPReg R: SPReg.
  			 self PopR: FPReg.
  			 backEnd hasLinkRegister ifTrue:
  				[self PopR: LinkReg].
  			 self RetN: methodOrBlockNumArgs + 1 * objectMemory wordSize]
  		ifFalse:
  			[self RetN: ((methodOrBlockNumArgs > self numRegArgs
  						"A method with an interpreter prim will push its register args for the prim.  If the failure
  						 body is frameless the args must still be popped, see e.g. Behavior>>nextInstance."
  						or: [regArgsHaveBeenPushed])
  							ifTrue: [methodOrBlockNumArgs + 1 * objectMemory wordSize]
  							ifFalse: [0])].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramelessBlock: (in category 'simulation stack') -----
  initSimStackForFramelessBlock: startpc
  	"The register receiver (the closure itself) and args are pushed by the closure value primitive(s)
  	 and hence a frameless block has all arguments and copied values pushed to the stack.  However,
  	 the method receiver (self) is put in the ReceiverResultRegister by the block entry."
  	| desc |
  	<var: #desc type: #'CogSimStackEntry *'>
  	simSelf
  		type: SSRegister;
  		spilled: false;
  		annotateUse: false;
  		register: ReceiverResultReg.
  	optStatus
  		isReceiverResultRegLive: true;
  		ssEntry: (self addressOf: simSelf).
  	self assert: methodOrBlockNumTemps >= methodOrBlockNumArgs.
  	0 to: methodOrBlockNumTemps - 1 do:
  		[:i|
  		desc := self simStackAt: i.
  		desc
  			type: SSBaseOffset;
  			spilled: true;
  			annotateUse: false;
  			register: SPReg;
  			offset: ((backEnd hasLinkRegister
+ 								ifTrue: [methodOrBlockNumArgs - 1- i]
+ 								ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
- 						ifTrue: [methodOrBlockNumArgs - 1- i]
- 						ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
  			bcptr: startpc].
  	simSpillBase := simStackPtr := methodOrBlockNumTemps - 1!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramelessMethod: (in category 'simulation stack') -----
  initSimStackForFramelessMethod: startpc
  	| desc |
  	<var: #desc type: #'CogSimStackEntry *'>
  	simSelf
  		type: SSRegister;
  		spilled: false;
  		annotateUse: false;
  		register: ReceiverResultReg.
  	optStatus
  		isReceiverResultRegLive: true;
  		ssEntry: (self addressOf: simSelf).
  	self assert: methodOrBlockNumTemps >= methodOrBlockNumArgs.
  	self assert: self numRegArgs <= 2.
  	(methodOrBlockNumArgs between: 1 and: self numRegArgs)
  		ifTrue:
  			[desc := self simStackAt: 0.
  			 desc
  				type: SSRegister;
  				spilled: false;
  				annotateUse: false;
  				register: Arg0Reg;
  				bcptr: startpc.
  			 methodOrBlockNumArgs > 1 ifTrue:
  				[desc := self simStackAt: 1.
  				 desc
  					type: SSRegister;
  					spilled: false;
  					annotateUse: false;
  					register: Arg1Reg;
  					bcptr: startpc]]
  		ifFalse:
  			[0 to: methodOrBlockNumArgs - 1 do:
  				[:i|
  				desc := self simStackAt: i.
  				desc
  					type: SSBaseOffset;
  					register: SPReg;
  					spilled: true;
  					annotateUse: false;
  					offset: ((backEnd hasLinkRegister
  								ifTrue: [methodOrBlockNumArgs - 1- i]
  								ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
  					bcptr: startpc]].
  	simSpillBase := simStackPtr := methodOrBlockNumArgs - 1!



More information about the Vm-dev mailing list