[Vm-dev] VM Maker: VMMaker-oscog-IgorStasenko.143.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Feb 7 03:24:41 UTC 2012


Igor Stasenko uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-IgorStasenko.143.mcz

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

Name: VMMaker-oscog-IgorStasenko.143
Author: IgorStasenko
Time: 7 February 2012, 4:28:02 am
UUID: 25049516-19fb-3647-9ca4-6328c656f3f0
Ancestors: VMMaker-oscog-EstebanLorenzano.140, VMMaker.oscog-eem.142

- clean merge with VMMaker.oscog-eem.142

=============== Diff against VMMaker-oscog-EstebanLorenzano.140 ===============

Item was changed:
  TestCase subclass: #AbstractInstructionTests
  	instanceVariableNames: 'processor opcodes'
  	classVariableNames: ''
  	poolDictionaries: 'CogRTLOpcodes'
  	category: 'VMMaker-Tests'!
+ 
+ !AbstractInstructionTests commentStamp: 'BenjaminVanRyseghem 9/27/2011 14:04' prior: 0!
+ Use for a test: ClosureCompilerTest>>#closureCases!

Item was changed:
  ----- Method: CoInterpreter>>longUnconditionalJump (in category 'jump bytecodes') -----
  longUnconditionalJump
  	| offset switched |
  	offset := (((currentBytecode bitAnd: 7) - 4) * 256) + self fetchByte.
  	localIP := localIP + offset.
  	"backward jump means we're in a loop.
  		- check for possible interrupts.
  		- check for long-running loops and JIT if appropriate."
  	offset < 0 ifTrue:
  		[localSP < stackLimit ifTrue:
  			[self externalizeIPandSP.
  			 switched := self checkForEventsMayContextSwitch: true.
  			 self returnToExecutive: true postContextSwitch: switched.
  			 self browserPluginReturnIfNeeded.
  			 self internalizeIPandSP].
  		method = lastBackwardJumpMethod
  			ifTrue:
  				[(backwardJumpCount := backwardJumpCount - 1) <= 0 ifTrue:
  					[(self methodWithHeaderShouldBeCogged: (self headerOf: method))
  						ifTrue:
  							[self externalizeFPandSP.
+ 							 self resetBackwardJumpVariables. "only to force variables to be global"
  							 self attemptToSwitchToMachineCode: (self oopForPointer: localIP) - offset - method - BaseHeaderSize - 1]
  						ifFalse: "don't ask if one should compile a second time..."
  							[backwardJumpCount := 1 bitShift: BytesPerWord * 8 - 2]]]
  			ifFalse:
  				[lastBackwardJumpMethod := method.
  				backwardJumpCount := minBackwardJumpCountForCompile]].
  	self fetchNextBytecode!

Item was added:
+ ----- Method: CoInterpreter>>resetBackwardJumpVariables (in category 'jump bytecodes') -----
+ resetBackwardJumpVariables
+ 	"Reference these variables from outside interpret to avoid them being localised to interpret.
+ 	 Oh the hacks we commit for Slang..."
+ 	<cmacro: '() /* nada */'>
+ 	<inline: #false>
+ 	lastBackwardJumpMethod := lastBackwardJumpMethod.
+ 	backwardJumpCount := backwardJumpCount!

Item was added:
+ ----- Method: CogAbstractInstruction class>>specificOpcodes (in category 'verification') -----
+ specificOpcodes
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction class>>unimplementedOpcodes (in category 'verification') -----
+ unimplementedOpcodes
+ 	"Check computeMaximumSize and dispatchConcretize for unimplemented opcodes."
+ 	"self subclasses collect: [:compiler| {compiler. compiler unimplementedOpcodes}]"
+ 	| opcodes cmsLiterals dcLiterals |
+ 	opcodes := CogRTLOpcodes opcodes, self specificOpcodes.
+ 	cmsLiterals := (self >> #computeMaximumSize) literals
+ 						select: [:l| l isVariableBinding]
+ 						thenCollect: [:l| l key].
+ 	dcLiterals := (self >> #dispatchConcretize) literals
+ 						select: [:l| l isVariableBinding]
+ 						thenCollect: [:l| l key].
+ 	^Dictionary new
+ 		at: #computeMaximumSize put: (opcodes reject: [:opcode| cmsLiterals includes: opcode]);
+ 		at: #dispatchConcretize put: (opcodes reject: [:opcode| dcLiterals includes: opcode]);
+ 		yourself!

Item was added:
+ ----- Method: CogAbstractInstruction class>>usedUnimplementedOpcodes (in category 'verification') -----
+ usedUnimplementedOpcodes
+ 	"Check for uses of unimplemented opcodes"
+ 	"self subclasses collect: [:compiler| {compiler. compiler usedUnimplementedOpcodes}]"
+ 	| genericUnimplementedOpcodeBindings specificUnimplementedOpcodeBindings |
+ 	genericUnimplementedOpcodeBindings := Set new.
+ 	specificUnimplementedOpcodeBindings := Set new.
+ 	self unimplementedOpcodes do:
+ 		[:arrayOfOpcodes|
+ 		arrayOfOpcodes do:
+ 			[:opcode|
+ 			(self bindingOf: opcode)
+ 				ifNotNil: [:b| specificUnimplementedOpcodeBindings add: b]
+ 				ifNil: [genericUnimplementedOpcodeBindings add: (CogRTLOpcodes bindingOf: opcode)]]].
+ 	^ { (SystemNavigation new allCallsOn: genericUnimplementedOpcodeBindings localToPackage: #VMMaker)
+ 			inject: Set new
+ 			into:  [:them :methodRef| "These should be in Cogit's abstract instructions category"
+ 				them
+ 					addAll: (SystemNavigation new allCallsOn: methodRef method selector localToPackage: #VMMaker);
+ 					yourself].
+ 		SystemNavigation new allCallsOn: specificUnimplementedOpcodeBindings localToPackage: #VMMaker }!

Item was added:
+ ----- Method: CogIA32Compiler class>>specificOpcodes (in category 'verification') -----
+ specificOpcodes
+ 	"Answer the processor-specific opcodes for this class.
+ 	 They're all in an Array literal in the initialize method."
+ 	^(self class >> #initialize) literals detect: [:l| l isArray and: [l includes: #LOCK]]!

Item was changed:
  ----- Method: CogIA32Compiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Compute the maximum size for each opcode.  This allows jump offsets to
  	 be determined, provided that all backward branches are long branches."
  	"N.B.  The ^maxSize := N forms are to get around the compiler's long branch
  	 limits which are exceeded when each case jumps around the otherwise."
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^maxSize := 0].
  		[AlignmentNops]		-> [^maxSize := (operands at: 0) - 1].
  		[Fill16]					-> [^maxSize := 2].
  		[Fill32]					-> [^maxSize := 4].
  		[FillFromWord]			-> [^maxSize := 4].
  		[Nop]					-> [^maxSize := 1].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^maxSize := 1].
  		[IDIVR]					-> [^maxSize := 2].
  		[IMULRR]				-> [^maxSize := 3].
  		[CPUID]					-> [^maxSize := 2].
  		[CMPXCHGAwR]			-> [^maxSize := 7].
  		[CMPXCHGMwrR]		-> [^maxSize := 8].
  		[LFENCE]				-> [^maxSize := 3].
  		[MFENCE]				-> [^maxSize := 3].
  		[SFENCE]				-> [^maxSize := 3].
  		[LOCK]					-> [^maxSize := 1].
  		[XCHGAwR]				-> [^maxSize := 6].
  		[XCHGMwrR]			-> [^maxSize := 7].
  		[XCHGRR]				-> [^maxSize := 2].
  		"Control"
  		[Call]					-> [^maxSize := 5].
  		[JumpR]					-> [^maxSize := 2].
  		[Jump]					-> [self resolveJumpTarget. ^maxSize := 5].
  		[JumpLong]				-> [self resolveJumpTarget. ^maxSize := 5].
  		[JumpZero]				-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpNonZero]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpNegative]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpNonNegative]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpOverflow]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpNoOverflow]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpCarry]				-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpNoCarry]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpLess]				-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpGreaterOrEqual]	-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpGreater]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpLessOrEqual]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpBelow]				-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpAboveOrEqual]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpAbove]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpBelowOrEqual]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpLongZero]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpLongNonZero]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPEqual]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPNotEqual]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPLess]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPGreaterOrEqual]	-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPGreater]			-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPLessOrEqual]	-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPOrdered]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[JumpFPUnordered]		-> [self resolveJumpTarget. ^maxSize := 6].
  		[RetN]					-> [^maxSize := (operands at: 0) = 0
  													ifTrue: [1]
  													ifFalse: [3]].
  		"Arithmetic"
  		[AddCqR]		-> [^maxSize := (self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[AndCqR]		-> [^maxSize := (self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[CmpCqR]		-> [^maxSize := (self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[OrCqR]			-> [^maxSize := (self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[SubCqR]		-> [^maxSize := (self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[AddCwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]].
+ 		[AndCwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]].
  		[CmpCwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]].
+ 		[OrCwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
+ 														ifTrue: [5]
+ 														ifFalse: [6]].
  		[SubCwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]].
  		[XorCwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]].
  		[AddRR]			-> [^maxSize := 2].
  		[AndRR]			-> [^maxSize := 2].
  		[CmpRR]		-> [^maxSize := 2].
  		[OrRR]			-> [^maxSize := 2].
  		[XorRR]			-> [^maxSize := 2].
  		[SubRR]			-> [^maxSize := 2].
  		[NegateR]		-> [^maxSize := 2].
  		[LoadEffectiveAddressMwrR]
  						-> [^maxSize := ((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[LogicalShiftLeftCqR]		-> [^maxSize := (operands at: 0) = 1
  														ifTrue: [2]
  														ifFalse: [3]].
  		[LogicalShiftRightCqR]	-> [^maxSize := (operands at: 0) = 1
  														ifTrue: [2]
  														ifFalse: [3]].
  		[ArithmeticShiftRightCqR]	-> [^maxSize := (operands at: 0) = 1
  														ifTrue: [2]
  														ifFalse: [3]].
  		[LogicalShiftLeftRR]		-> [self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [self computeShiftRRSize].
  		[ArithmeticShiftRightRR]	-> [self computeShiftRRSize].
  		[AddRdRd]				-> [^maxSize := 4].
  		[CmpRdRd]				-> [^maxSize := 4].
  		[SubRdRd]				-> [^maxSize := 4].
  		[MulRdRd]				-> [^maxSize := 4].
  		[DivRdRd]				-> [^maxSize := 4].
  		[SqrtRd]					-> [^maxSize := 4].
  		"Data Movement"
  		[MoveCqR]		-> [^maxSize := (operands at: 0) = 0 ifTrue: [2] ifFalse: [5]].
  		[MoveCwR]		-> [^maxSize := 5].
  		[MoveRR]		-> [^maxSize := 2].
+ 		[MoveRdRd]		-> [^maxSize := 4].
  		[MoveAwR]		-> [^maxSize := (self concreteRegister: (operands at: 1)) = EAX
  											ifTrue: [5]
  											ifFalse: [6]].
  		[MoveRAw]		-> [^maxSize := (self concreteRegister: (operands at: 0)) = EAX
  											ifTrue: [5]
  											ifFalse: [6]].
  		[MoveRMwr]		-> [^maxSize := ((self isQuick: (operands at: 1))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveRdM64r]	-> [^maxSize := ((self isQuick: (operands at: 1))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveMbrR]		-> [^maxSize := ((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveRMbr]		-> [^maxSize := ((self isQuick: (operands at: 1))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveM16rR]	-> [^maxSize := ((self isQuick: (operands at: 0))
  											ifTrue: [4]
  											ifFalse: [7])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveM64rRd]	-> [^maxSize := ((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveMwrR]		-> [^maxSize := ((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveXbrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
  							^maxSize := (self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
  							^maxSize := (self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [4]
  											ifFalse: [3]].
  		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
  							^maxSize := (self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3]].
  		[PopR]			-> [^maxSize := 1].
  		[PushR]			-> [^maxSize := 1].
  		[PushCw]		-> [^maxSize := 5].
  		[PrefetchAw]	-> [^maxSize := self hasSSEInstructions ifTrue: [7] ifFalse: [0]].
  		"Conversion"
  		[ConvertRRd]	-> [^maxSize := 4] }.
  	^0 "to keep C compiler quiet"!

Item was added:
+ ----- Method: CogIA32Compiler>>concretizeAndCwR (in category 'generate machine code') -----
+ concretizeAndCwR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| value reg |
+ 	value := operands at: 0.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	reg = EAX ifTrue:
+ 		[machineCode
+ 			at: 0 put: 16r25;
+ 			at: 1 put: (value bitAnd: 16rFF);
+ 			at: 2 put: (value >> 8 bitAnd: 16rFF);
+ 			at: 3 put: (value >> 16 bitAnd: 16rFF);
+ 			at: 4 put: (value >> 24 bitAnd: 16rFF).
+ 		 ^machineCodeSize := 5].
+ 	machineCode
+ 		at: 0 put: 16r83;
+ 		at: 1 put: (self mod: ModReg RM: reg RO: 4);
+ 		at: 2 put: (value bitAnd: 16rFF);
+ 		at: 3 put: (value >> 8 bitAnd: 16rFF);
+ 		at: 4 put: (value >> 16 bitAnd: 16rFF);
+ 		at: 5 put: (value >> 24 bitAnd: 16rFF).
+ 	 ^machineCodeSize := 6!

Item was added:
+ ----- Method: CogIA32Compiler>>concretizeOrCwR (in category 'generate machine code') -----
+ concretizeOrCwR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| value reg |
+ 	value := operands at: 0.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	reg = EAX ifTrue:
+ 		[machineCode
+ 			at: 0 put: 16r0D;
+ 			at: 1 put: (value bitAnd: 16rFF);
+ 			at: 2 put: (value >> 8 bitAnd: 16rFF);
+ 			at: 3 put: (value >> 16 bitAnd: 16rFF);
+ 			at: 4 put: (value >> 24 bitAnd: 16rFF).
+ 		 ^machineCodeSize := 5].
+ 	machineCode
+ 		at: 0 put: 16r83;
+ 		at: 1 put: (self mod: ModReg RM: reg RO: 1);
+ 		at: 2 put: (value bitAnd: 16rFF);
+ 		at: 3 put: (value >> 8 bitAnd: 16rFF);
+ 		at: 4 put: (value >> 16 bitAnd: 16rFF);
+ 		at: 5 put: (value >> 24 bitAnd: 16rFF).
+ 	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]				-> [^self concretizeLabel].
  		[AlignmentNops]	-> [^self concretizeAlignmentNops].
  		[Fill16]				-> [^self concretizeFill16].
  		[Fill32]				-> [^self concretizeFill32].
  		[FillFromWord]		-> [^self concretizeFillFromWord].
  		[Nop]				-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^self concretizeCDQ].
  		[IDIVR]					-> [^self concretizeIDIVR].
  		[IMULRR]				-> [^self concretizeMulRR].
  		[CPUID]					-> [^self concretizeCPUID].
  		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
  		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
  		[LFENCE]				-> [^self concretizeFENCE: 5].
  		[MFENCE]				-> [^self concretizeFENCE: 6].
  		[SFENCE]				-> [^self concretizeFENCE: 7].
  		[LOCK]					-> [^self concretizeLOCK].
  		[XCHGAwR]				-> [^self concretizeXCHGAwR].
  		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
  		[XCHGRR]				-> [^self concretizeXCHGRR].
  		"Control"
  		[Call]					-> [^self concretizeCall].
  		[JumpR]					-> [^self concretizeJumpR].
  		[JumpLong]				-> [^self concretizeJumpLong].
  		[JumpLongZero]		-> [^self concretizeConditionalJumpLong: 16r4].
  		[JumpLongNonZero]	-> [^self concretizeConditionalJumpLong: 16r5].
  		[Jump]					-> [^self concretizeJump].
  		"Table B-1 Intel® 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  		[JumpZero]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpNonZero]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpNegative]			-> [^self concretizeConditionalJump: 16r8].
  		[JumpNonNegative]		-> [^self concretizeConditionalJump: 16r9].
  		[JumpOverflow]			-> [^self concretizeConditionalJump: 16r0].
  		[JumpNoOverflow]		-> [^self concretizeConditionalJump: 16r1].
  		[JumpCarry]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpNoCarry]			-> [^self concretizeConditionalJump: 16r3].
  		[JumpLess]				-> [^self concretizeConditionalJump: 16rC].
  		[JumpGreaterOrEqual]	-> [^self concretizeConditionalJump: 16rD].
  		[JumpGreater]			-> [^self concretizeConditionalJump: 16rF].
  		[JumpLessOrEqual]		-> [^self concretizeConditionalJump: 16rE].
  		[JumpBelow]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpAboveOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpAbove]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpBelowOrEqual]	-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPEqual]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpFPNotEqual]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpFPLess]				-> [^self concretizeConditionalJump: 16r2].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpFPGreater]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpFPLessOrEqual]		-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPOrdered]			-> [^self concretizeConditionalJump: 16rB].
  		[JumpFPUnordered]			-> [^self concretizeConditionalJump: 16rA].
  		[RetN]						-> [^self concretizeRetN].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeAddCwR].
  		[AddRR]						-> [^self concretizeAddRR].
  		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
  		[AndCqR]					-> [^self concretizeAndCqR].
+ 		[AndCwR]					-> [^self concretizeAndCwR].
  		[AndRR]						-> [^self concretizeAndRR].
  		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
  		[OrCqR]						-> [^self concretizeOrCqR].
+ 		[OrCwR]					-> [^self concretizeOrCwR].
  		[OrRR]						-> [^self concretizeOrRR].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeSubCwR].
  		[SubRR]						-> [^self concretizeSubRR].
  		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[XorCwR]						-> [^self concretizeXorCwR].
  		[XorRR]							-> [^self concretizeXorRR].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd] }!

Item was added:
+ ----- Method: CogRTLOpcodes class>>opcodes (in category 'accessing') -----
+ opcodes
+ 	"CogRTLOpcodes opcodes"
+ 	"CogRTLOpcodes opcodes select:
+ 		[:opcode|
+ 		(Cogit organization listAtCategoryNamed: #'abstract instructions') noneSatisfy:
+ 			[:s|
+ 			(Cogit compiledMethodAt: s) literals anySatisfy:
+ 				[:l|
+ 				l isVariableBinding and: [l key = opcode]]]]"
+ 	^(classPool keys reject:
+ 		[:k|
+ 		(#('First' 'Last' 'DPFP') anySatisfy: [:prefix| k beginsWith: prefix])
+ 		or: [#('Reg' 'Min' 'Max') anySatisfy: [:postfix| k endsWith: postfix]]]) asArray sort!

Item was changed:
  ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
  tryToInlineMethodsIn: aCodeGen
  	"Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
  
  	| stmtLists didSomething newStatements sendsToInline |
+ 	self definedAsMacro ifTrue:
- 	(properties includesKey: #cmacro:) ifTrue:
  		[complete := true.
  		 ^false].
  	didSomething := false.
  	sendsToInline := Dictionary new: 100.
  	parseTree
  		nodesDo:
  			[ :n |
  			(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
  				[sendsToInline at: n put: (self inlineFunctionCall: n in: aCodeGen)]]
  		unless: "Don't inline the arguments to asserts to keep the asserts readable"
  			[:n| n isSend and: [#(cCode:inSmalltalk: assert:) includes: n selector]].
  
  	sendsToInline isEmpty ifFalse:
  		[didSomething := true.
  		parseTree := parseTree replaceNodesIn: sendsToInline].
  
  	didSomething ifTrue:
  		[writtenToGlobalVarsCache := nil.
  		^didSomething].
  
  	stmtLists := self statementsListsForInlining.
  	stmtLists do:
  		[ :stmtList | 
  		newStatements := OrderedCollection new: 100.
  		stmtList statements do:
  			[ :stmt |
  			(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
  				ifNil: [newStatements addLast: stmt]
  				ifNotNil: [:inlinedStmts|
  					didSomething := true.
  					newStatements addAllLast: inlinedStmts]].
  		stmtList setStatements: newStatements asArray].
  
  	didSomething ifTrue:
  		[writtenToGlobalVarsCache := nil.
  		^didSomething].
  
  	complete ifFalse:
  		[self checkForCompleteness: stmtLists in: aCodeGen.
  		 complete ifTrue: [ didSomething := true ]].  "marking a method complete is progress"
  	^didSomething!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
  ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
  	"Generic callout. Does the actual work.  If argArrayOrNil is nil it takes args from the stack
  	 and the spec from the method.  If argArrayOrNil is not nil takes args from argArrayOrNil
  	 and the spec from the receiver."
  	| flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result |
  	<inline: true>
  	<var: #theCalloutState type: #'CalloutState'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #allocation type: #'char *'>
  
  	(interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
  		[^self ffiFail: FFIErrorNotFunction].
  	"Load and check the values in the externalFunction before we call out"
  	flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
  	interpreterProxy failed ifTrue:
  		[^self ffiFail: FFIErrorBadArgs].
+ 
+ 	"This must come early for compatibility with the old FFIPlugin.  Image-level code
+ 	 may assume the function pointer is loaded eagerly.  Thanks to Nicolas Cellier."
+ 	address := self ffiLoadCalloutAddress: externalFunction.
+ 	interpreterProxy failed ifTrue:
+ 		[^0 "error code already set by ffiLoadCalloutAddress:"].
+ 	
  	argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
  	"must be array of arg types"
  	((interpreterProxy isArray: argTypeArray)
  	and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
  		[^self ffiFail: FFIErrorBadArgs].
  	"check if the calling convention is supported"
  	self cppIf: COGMTVM
  		ifTrue:
  			[(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
  				[^self ffiFail: FFIErrorCallType]]
  		ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
  			[(self ffiSupportsCallingConvention: flags) ifFalse:
  				[^self ffiFail: FFIErrorCallType]].
+ 		
- 
- 	address := self ffiLoadCalloutAddress: externalFunction.
- 	interpreterProxy failed ifTrue:
- 		[^0 "error code already set by ffiLoadCalloutAddress:"].
  	requiredStackSize := self externalFunctionHasStackSizeSlot
  							ifTrue: [interpreterProxy
  										fetchInteger: ExternalFunctionStackSizeIndex
  										ofObject: externalFunction]
  							ifFalse: [-1].
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
  												ifTrue: [PrimErrBadMethod]
  												ifFalse: [PrimErrBadReceiver])].
  	stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
  	self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
  	calloutState := self addressOf: theCalloutState.
  	self cCode: [self me: calloutState ms: 0 et: (self sizeof: #CalloutState asSymbol)].
  	calloutState callFlags: flags.
  	"Fetch return type and args"
  	argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
  	argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  	argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  	(err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
  		[^self ffiFail: err]. "cannot return"
  	"alloca the outgoing stack frame, leaving room for register args while marshalling, and including space for the return struct, if any."
  	allocation := self alloca: stackSize + calloutState structReturnSize + self registerArgsSlop + self cStackAlignment.
  	self allocaLiesSoUseGetsp ifTrue:
  		[allocation := self getsp].
  	self cStackAlignment ~= 0 ifTrue:
  		[allocation := self cCoerce: (allocation asUnsignedInteger bitAnd: (self cStackAlignment - 1) bitInvert32)
  						to: #'char *'].
  	calloutState
  		argVector: allocation;
  		currentArg: allocation + self registerArgsSlop;
  		limit: allocation + stackSize + self registerArgsSlop.
  	(calloutState structReturnSize > 0
  	 and: [self nonRegisterStructReturnIsViaImplicitFirstArgument
  	 and: [(self returnStructInRegisters: calloutState structReturnSize) not]]) ifTrue:
  		[self ffiPushPointer: calloutState limit in: calloutState].
  	1 to: nArgs do:
  		[:i|
  		argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
  		argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  		argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  		oop := argArrayOrNil isNil
  				ifTrue: [interpreterProxy stackValue: nArgs - i]
  				ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
  		err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
  		err ~= 0 ifTrue:
  			[self cleanupCalloutState: calloutState.
  			 self cppIf: COGMTVM ifTrue:
  			 [err = PrimErrObjectMayMove negated ifTrue:
  				[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  			 ^self ffiFail: err]]. "coercion failed or out of stack space"
  	"Failures must be reported back from ffiArgument:Spec:Class:in:.
  	 Should not fail from here on in."
  	self assert: interpreterProxy failed not.
  	self ffiLogCallout: externalFunction.
  	(requiredStackSize < 0
  	 and: [self externalFunctionHasStackSizeSlot]) ifTrue:
  		[stackSize := calloutState currentArg - calloutState argVector.
  		 interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
  	"Go out and call this guy"
  	result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
  	self cleanupCalloutState: calloutState.
  	^result!



More information about the Vm-dev mailing list