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

commits at source.squeak.org commits at source.squeak.org
Sat Sep 26 00:53:42 UTC 2015


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

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

Name: VMMaker.oscog-eem.1469
Author: eem
Time: 25 September 2015, 5:50:20.457 pm
UUID: 1ef45942-3ff0-4899-bc2b-20d600d357b2
Ancestors: VMMaker.oscog-eem.1468

Cogit:
Refactor argument passing in run-time calls to enable an evil act, that of using the C arg registers RDX & RCX for their "traditional" uses, ReceiverResultReg and ClassReg, due to an awful coincidence.

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

Item was added:
+ ----- Method: CogARMCompiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
+ genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
+ 	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is either a
+ 	 negative number, that of an abstract register, or a non-negative number, that of a constant parameter.
+ 
+ 	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
+ 	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
+ 	 defer to the back end to generate this code not so much that teh back end knows whether it uses
+ 	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
+ 	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
+ 	 that allows some of the argument registers to be used for specificabstract  registers, specifically
+ 	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also its really nice to keep using the old
+ 	 register assignments the principal author has grown accustomed to."
+ 	<inline: true>
+ 	numArgs = 0 ifTrue: [^self].
+ 	regOrConst0 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst0 R: CArg0Reg]
+ 		ifFalse: [cogit MoveR: regOrConst0 R: CArg0Reg].
+ 	numArgs = 1 ifTrue: [^self].
+ 	regOrConst1 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst1 R: CArg1Reg]
+ 		ifFalse: [cogit MoveR: regOrConst1 R: CArg1Reg].
+ 	numArgs = 2 ifTrue: [^self].
+ 	regOrConst2 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst2 R: CArg2Reg]
+ 		ifFalse: [cogit MoveR: regOrConst2 R: CArg2Reg].
+ 	numArgs = 3 ifTrue: [^self].
+ 	regOrConst3 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst3 R: CArg3Reg]
+ 		ifFalse: [cogit MoveR: regOrConst3 R: CArg3Reg]!

Item was removed:
- ----- Method: CogARMCompiler>>genPassConst:asArgument: (in category 'abi') -----
- genPassConst: constant asArgument: zeroRelativeArgIndex
- 	zeroRelativeArgIndex caseOf: {
- 		[0] -> [cogit MoveCq: constant R: CArg0Reg].
- 		[1] -> [cogit MoveCq: constant R: CArg1Reg].
- 		[2] -> [cogit MoveCq: constant R: CArg2Reg].
- 		[3] -> [cogit MoveCq: constant R: CArg3Reg].}.
- 	^0!

Item was removed:
- ----- Method: CogARMCompiler>>genPassReg:asArgument: (in category 'abi') -----
- genPassReg: abstractRegister asArgument: zeroRelativeArgIndex
- 	zeroRelativeArgIndex caseOf: {
- 		[0] -> [cogit MoveR: abstractRegister R: CArg0Reg].
- 		[1] -> [cogit MoveR: abstractRegister R: CArg1Reg].
- 		[2] -> [cogit MoveR: abstractRegister R: CArg2Reg].
- 		[3] -> [cogit MoveR: abstractRegister R: CArg3Reg].}.
- 	^0!

Item was added:
+ ----- Method: CogAbstractInstruction>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
+ genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
+ 	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is either a
+ 	 negative number, that of an abstract register, or a non-negative number, that of a constant parameter.
+ 
+ 	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
+ 	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
+ 	 defer to the back end to generate this code not so much that teh back end knows whether it uses
+ 	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
+ 	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
+ 	 that allows some of the argument registers to be used for specificabstract  registers, specifically
+ 	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also its really nice to keep using the old
+ 	 register assignments the principal author has grown accustomed to."
+ 	<inline: true>
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogIA32Compiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
+ genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
+ 	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is either a
+ 	 negative number, that of an abstract register, or a non-negative number, that of a constant parameter.
+ 
+ 	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
+ 	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
+ 	 defer to the back end to generate this code not so much that teh back end knows whether it uses
+ 	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
+ 	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
+ 	 that allows some of the argument registers to be used for specificabstract  registers, specifically
+ 	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also its really nice to keep using the old
+ 	 register assignments the principal author has grown accustomed to."
+ 	<inline: true>
+ 	numArgs = 0 ifTrue:
+ 		[^self].
+ 	numArgs > 1 ifTrue:
+ 		[numArgs > 2 ifTrue:
+ 			[numArgs > 3 ifTrue:
+ 				[regOrConst3 < 0
+ 					ifTrue: [cogit PushR: regOrConst3]
+ 					ifFalse: [cogit PushCq: regOrConst3]].
+ 			 regOrConst2 < 0
+ 				ifTrue: [cogit PushR: regOrConst2]
+ 				ifFalse: [cogit PushCq: regOrConst2]].
+ 		regOrConst1 < 0
+ 			ifTrue: [cogit PushR: regOrConst1]
+ 			ifFalse: [cogit PushCq: regOrConst1]].
+ 	regOrConst0 < 0
+ 		ifTrue: [cogit PushR: regOrConst0]
+ 		ifFalse: [cogit PushCq: regOrConst0]!

Item was removed:
- ----- Method: CogIA32Compiler>>genPassConst:asArgument: (in category 'abi') -----
- genPassConst: constant asArgument: zeroRelativeArgIndex
- 	cogit PushCq: constant.
- 	^0!

Item was removed:
- ----- Method: CogIA32Compiler>>genPassReg:asArgument: (in category 'abi') -----
- genPassReg: abstractRegister asArgument: zeroRelativeArgIndex
- 	cogit PushR: abstractRegister.
- 	^0!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>concreteRegister: (in category 'encoding') -----
  concreteRegister: registerIndex
  	 "Map a possibly abstract register into a concrete one.  Abstract registers
  	  (defined in CogAbstractOpcodes) are all negative.  If registerIndex is
  	 negative assume it is an abstract register.
  
  	[1] Figure 3.4 Register Usage in
  		System V Application Binary Interface
  		AMD64 Architecture Processor Supplement
  
  
  	N.B. RAX RCX & RDX are caller-save (scratch) registers.  Hence we use RCX for class and RDX for
  		receiver/result since these are written in all normal sends."
  
  	^registerIndex
  		caseOf: {
  			[TempReg]				-> [RAX].
  			[ClassReg]				-> [RCX].
  			[ReceiverResultReg]	-> [RDX].
  			[SendNumArgsReg]		-> [R9].
  			[SPReg]					-> [RSP].
  			[FPReg]					-> [RBP].
+ 			[Arg0Reg]				-> [RDI]. "So as to agree with C ABI arg 0"
+ 			[Arg1Reg]				-> [RSI]. "So as to agree with C ABI arg 1"
- 			[Arg0Reg]				-> [RSI].
- 			[Arg1Reg]				-> [RDI].
  			[VarBaseReg]			-> [RBX]. "Must be callee saved"
  			[RISCTempReg]			-> [R8].
  			[Scratch0Reg]			-> [R10].
  			[Scratch1Reg]			-> [R11].
  			[Scratch2Reg]			-> [R12].
  			[Scratch3Reg]			-> [R13].
  			[Scratch4Reg]			-> [R14].
  			[Scratch5Reg]			-> [R15] }
  		otherwise:
  			[self assert: (registerIndex between: RAX and: R15).
  			 registerIndex]!

Item was added:
+ ----- Method: CogX64Compiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
+ genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
+ 	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is either a
+ 	 negative number, that of an abstract register, or a non-negative number, that of a constant parameter.
+ 
+ 	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
+ 	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
+ 	 defer to the back end to generate this code not so much that teh back end knows whether it uses
+ 	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
+ 	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
+ 	 that allows some of the argument registers to be used for specificabstract  registers, specifically
+ 	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also its really nice to keep using the old
+ 	 register assignments the principal author has grown accustomed to.
+ 
+ 	 How can this possibly work?  Look at Cogit class>>runtime for a list of the run-time calls and their
+ 	 arguments, including which arguments are passed in which registers.  Look at CogX64Compiler's
+ 	 subclass implementations of concreteRegister:.  There are no calls in which ReceiverResultReg (RDX)
+ 	 and/or ClassReg (RCX) are passed along with Arg0Reg and Arg1Reg, and none in which the use of
+ 	 either ReceiverResultReg or ClassReg conflict for args 3 & 4.  So if args are assigned in order, the
+ 	 registers do not get overwritten.  Yes, this is evil, but it's so nice to continue to use RCX & RDX."
+ 	<inline: true>
+ 	numArgs = 0 ifTrue: [^self].
+ 	regOrConst0 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst0 R: RDI]
+ 		ifFalse: [cogit MoveR: regOrConst0 R: RDI].
+ 	numArgs = 1 ifTrue: [^self].
+ 	regOrConst1 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst1 R: RSI]
+ 		ifFalse: [cogit MoveR: regOrConst1 R: RSI].
+ 	numArgs = 2 ifTrue: [^self].
+ 	regOrConst2 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst2 R: RDX]
+ 		ifFalse: [cogit MoveR: regOrConst2 R: RDX].
+ 	numArgs = 3 ifTrue: [^self].
+ 	regOrConst3 < 0
+ 		ifTrue: [cogit MoveCq: regOrConst3 R: RCX]
+ 		ifFalse: [cogit MoveR: regOrConst3 R: RCX]!

Item was removed:
- ----- Method: CogX64Compiler>>genPassConst:asArgument: (in category 'abi') -----
- genPassConst: constant asArgument: zeroRelativeArgIndex
- 	zeroRelativeArgIndex caseOf: {
- 		[0] -> [cogit MoveCq: constant R: RDI].
- 		[1] -> [cogit MoveCq: constant R: RSI].
- 		[2] -> [cogit MoveCq: constant R: RDX].
- 		[3] -> [cogit MoveCq: constant R: RCX].}.
- 	^0!

Item was removed:
- ----- Method: CogX64Compiler>>genPassReg:asArgument: (in category 'abi') -----
- genPassReg: abstractRegister asArgument: zeroRelativeArgIndex
- 	zeroRelativeArgIndex caseOf: {
- 		[0] -> [cogit MoveR: abstractRegister R: RDI].
- 		[1] -> [cogit MoveR: abstractRegister R: RSI].
- 		[2] -> [cogit MoveR: abstractRegister R: RDX].
- 		[3] -> [cogit MoveR: abstractRegister R: RCX].}.
- 	^0!

Item was added:
+ ----- Method: Cogit class>>runtime (in category 'documentation') -----
+ runtime
+ 	"Generated machine code makes use of a number of run-time routines for support, for executing certain primitives,
+ 	 and for event handling.  These run-time entry points all begin with ce, for ``code entry''.  They are called from
+ 	 trampolines whose job it is to a) switch from the Smalltalk stack to the C stack (because run-time routines are C
+ 	 code in the CoInterpreter or Cogit and run on the C stack, whereas machine code runs on the Smalltalk stack), and
+ 	 b) to marshall the register parameters that trampol,ines take into what ever the platform's ABI requires.
+ 	 See the method trampolines for more info on trampoilines.
+ 
+ 	 Here's a doit to collect the signatures of the current run-time routines
+  
+ 		(((CoInterpreter selectors select: [:ea| (ea beginsWith: 'ce') and: [ea third isUppercase]]) ,
+ 		(SistaStackToRegisterMappingCogit allSelectors select: [:ea| (ea beginsWith: 'ce') and: [ea third isUppercase]]) asArray) sort collect:
+ 			[:s| | m |
+ 			m := CoInterpreter compiledMethodAt: s ifAbsent: [(SistaStackToRegisterMappingCogit whichClassIncludesSelector: s) >> s].
+ 			s numArgs = 0
+ 				ifTrue: [s asString]
+ 				ifFalse:
+ 					[(String streamContents:
+ 						[:str|
+ 						s keywords with: (CoInterpreter newParser parseParameterNames: m getSource) do:
+ 							[:k :p| str nextPutAll: k; space; nextPutAll: p; nextPutAll: ' (Reg) ']]) allButLast]])
+ 
+ 
+ 	Run-time:
+ 		ceActivateFailingPrimitiveMethod: aPrimitiveMethod (SendNumArgsReg)
+ 		ceActiveContext => ReceiverResultReg
+ 		ceBaseFrameReturn: returnValue (ReceiverResultReg)
+ 		ceBaseFrameReturnPC
+ 		ceCPICMiss: cPIC (ClassReg) receiver: receiver (ReceiverResultReg)
+ 		ceCall0ArgsPIC
+ 		ceCall1ArgsPIC
+ 		ceCall2ArgsPIC
+ 		ceCannotResume
+ 		ceCannotResumePC
+ 		ceCaptureCStackPointers
+ 		ceCheckFeatures
+ 		ceCheckForAndFollowForwardedPrimitiveState
+ 		ceCheckForInterrupts
+ 		ceCheckProfileTick
+ 		ceClosureCopyDescriptor: descriptor (SendNumArgsReg) => ReceiverResultReg
+ 		ceContext: maybeContext (ReceiverResultReg) instVar: slotIndex (SendNumArgsReg) => ReceiverResultReg
+ 		ceContext: maybeMarriedContext (ReceiverResultReg) instVar: slotIndex (SendNumArgsReg) value: anOop (ClassReg) => ReceiverResultReg
+ 		ceCounterTripped: condition (TempReg)
+ 		ceDynamicSuperSend: cacheAddress (SendNumArgsReg) receiver: methodReceiver (ReceiverResultReg)
+ 		ceEnclosingObjectAt: level (SendNumArgsReg) => ReceiverResultReg
+ 		ceImplicitReceiverSend: cacheAddress (SendNumArgsReg) receiver: methodReceiver (ReceiverResultReg)
+ 		ceInterpretMethodFromPIC: aMethodObj (SendNumArgsReg) receiver: rcvr (ReceiverResultReg)
+ 		ceMNUFromPICMNUMethod: aMethodObj (SendNumArgsReg) receiver: rcvr (ReceiverResultReg)
+ 		ceNewArraySlotSize: slotSize (SendNumArgsReg) => ReceiverResultReg
+ 		ceNonLocalReturn: returnValue (ReceiverResultReg)
+ 		ceOuterSend: cacheAddress (SendNumArgsReg) receiver: methodReceiver (ReceiverResultReg)
+ 		ceReturnToInterpreter: anOop (ReceiverResultReg)
+ 		ceReturnToInterpreterPC
+ 		ceSICMiss: receiver (ReceiverResultReg)
+ 		ceScheduleScavenge
+ 		ceSelfSend: cacheAddress (SendNumArgsReg) receiver: methodReceiver (ReceiverResultReg)
+ 		ceSend: selector (ClassReg) above: startAssociationArg (TempReg) to: rcvr (ReceiverResultReg) numArgs: numArgs (n)
+ 		ceSend: selector (ClassReg) super: superNormalBar (n) to: rcvr (ReceiverResultReg) numArgs: numArgs (n)
+ 		ceSendFromInLineCacheMiss: cogMethodOrPIC (SendNumArgsReg)
+ 		ceSendMustBeBoolean: anObject (TempReg)
+ 		ceSistaTrap
+ 		ceStackOverflow: contextSwitchIfNotNil (SendNumArgsReg)
+ 		ceTraceBlockActivation
+ 		ceTraceLinkedSend: theReceiver (ReceiverResultReg)
+ 		ceTraceStoreOf: aValue (ClassReg) into: anObject (ReceiverResultReg)
+ 		positive32BitIntegerFor: integerValue (ReceiverResultReg) => TempReg
+ 
+ 	Enilopmarts:
+ 		ceCallCogCodePopReceiverAndClassRegs
+ 		ceCallCogCodePopReceiverArg0Regs
+ 		ceCallCogCodePopReceiverArg1Arg0Regs
+ 		ceCallCogCodePopReceiverReg
+ 		ceEnterCogCodePopReceiverReg
+ 
+ 	Simulation only
+ 		ceShortCutTraceBlockActivation: aProcessorSimulationTrap
+ 		ceShortCutTraceLinkedSend: aProcessorSimulationTrap
+ 		ceShortCutTraceStore: aProcessorSimulationTrap
+ 
+ 	Misnamed:
+ 		ceSendAbort:to:numArgs: not a code entry.  Used by ceCannotResume, ceSendMustBeBoolean et al to execute their sends"!

Item was changed:
  ----- Method: Cogit>>compileCallFor:numArgs:arg:arg:arg:arg:resultReg:saveRegs: (in category 'initialization') -----
  compileCallFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 resultReg: resultRegOrNil saveRegs: saveRegs
  	"Generate a call to aRoutine with up to 4 arguments.  If resultRegOrNil is
  	 non-zero assign the C result to resultRegOrNil.  If saveRegs, save all registers.
  	 Hack: a negative arg value indicates an abstract register, a non-negative value
  	 indicates a constant."
  	<var: #aRoutine type: #'void *'>
  	<inline: false>
  	cStackAlignment > objectMemory wordSize ifTrue:
  		[backEnd
  			genAlignCStackSavingRegisters: saveRegs
  			numArgs: numArgs
  			wordAlignment: cStackAlignment / objectMemory wordSize].
  	saveRegs ifTrue:
  		[backEnd genSaveRegisters].
+ 	backEnd genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3.
- 	numArgs > 0 ifTrue:
- 		[numArgs > 1 ifTrue:
- 			[numArgs > 2 ifTrue:
- 				[numArgs > 3 ifTrue:
- 					[regOrConst3 < 0
- 						ifTrue: [backEnd genPassReg: regOrConst3 asArgument: 3]
- 						ifFalse: [backEnd genPassConst: regOrConst3 asArgument: 3]].
- 				 regOrConst2 < 0
- 					ifTrue: [backEnd genPassReg: regOrConst2 asArgument: 2]
- 					ifFalse: [backEnd genPassConst: regOrConst2 asArgument: 2]].
- 			regOrConst1 < 0
- 				ifTrue: [backEnd genPassReg: regOrConst1 asArgument: 1]
- 				ifFalse: [backEnd genPassConst: regOrConst1 asArgument: 1]].
- 		regOrConst0 < 0
- 			ifTrue: [backEnd genPassReg: regOrConst0 asArgument: 0]
- 			ifFalse: [backEnd genPassConst: regOrConst0 asArgument: 0]].
  	self CallFullRT: (self cCode: [aRoutine asUnsignedInteger]
  					   inSmalltalk: [self simulatedTrampolineFor: aRoutine]).
  	resultRegOrNil ifNotNil:
  		[backEnd genWriteCResultIntoReg: resultRegOrNil].
  	 saveRegs ifTrue:
  		[numArgs > 0 ifTrue:
  			[backEnd genRemoveNArgsFromStack: numArgs].
  		resultRegOrNil
  			ifNotNil: [backEnd genRestoreRegsExcept: resultRegOrNil]
  			ifNil: [backEnd genRestoreRegs]]!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>ceClassAtIndex: (in category 'trampolines') -----
- ceClassAtIndex: classIndex
- 	<api>
- 	| result |
- 	result := self classAtIndex: classIndex.
- 	self assert: (coInterpreter addressCouldBeClassObj: result).
- 	^result!

Item was removed:
- ----- Method: Spur64BitCoMemoryManager>>ceClassAtIndex: (in category 'trampolines') -----
- ceClassAtIndex: classIndex
- 	<api>
- 	| result |
- 	result := self classAtIndex: classIndex.
- 	self assert: (coInterpreter addressCouldBeClassObj: result).
- 	^result!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>genSendTrampolineFor:numArgs:called:arg:arg:arg: (in category 'initialization') -----
- genSendTrampolineFor: aRoutine numArgs: numArgs called: aString arg: regOrConst0 arg: regOrConst1 arg: regOrConst2
- 	"Generate a trampoline with three arguments.
- 	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
- 	<var: #aRoutine type: #'void *'>
- 	<var: #aString type: #'char *'>
- 	| startAddress |
- 	<inline: false>
- 	startAddress := methodZoneBase.
- 	self zeroOpcodeIndex.
- 	backEnd genPushRegisterArgsForNumArgs: numArgs scratchReg: SendNumArgsReg.
- 	self genTrampolineFor: aRoutine
- 		called: aString
- 		numArgs: 3
- 		arg: regOrConst0
- 		arg: regOrConst1
- 		arg: regOrConst2
- 		arg: nil
- 		saveRegs: false
- 		pushLinkReg: true
- 		resultReg: nil
- 		appendOpcodes: true.
- 	^startAddress!



More information about the Vm-dev mailing list