[Vm-dev] VM Maker: VMMaker.oscog-rmacnak.1605.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Dec 17 06:40:19 UTC 2015


Ryan Macnak uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-rmacnak.1605.mcz

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

Name: VMMaker.oscog-rmacnak.1605
Author: rmacnak
Time: 16 December 2015, 10:38:55.921 pm
UUID: d5c6ef8e-2868-4f0a-8ff7-ae4bfeb5e37e
Ancestors: VMMaker.oscog-eem.1604

MIPS: Get compiled VM up to ceCaptureCStackPointers, crashing because no one setup VarBaseReg. Dumb luck that the address has been out of VarBase range on ARM so far.

Implement identifyingPredefinedMacros and therefore start generating C for MIPSEL alongside IA32 and ARMv5.

Implement machineCodeDeclaration so our instructions don't get truncated. (Though oddly enough they're not totally incomprehensible because the function for many instructions in the low bits.)

Optimistically copy I-cache flush implementation from ARM.

Rename break: to avoid the C reserved word since Slang doesn't do it for us. Also don't rename it _break: because `#_break: numArgs` is wrong in Squeak. Rename various shadowing temps since Slang warns it doesn't make sure they refer to the same thing in C as they did in Smalltalk when inlining. Remove various simulation-only code.

Add stubs for various unreachable code to make the C compiler happy.

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

Item was added:
+ ----- Method: CogMIPSELCompiler class>>identifyingPredefinedMacros (in category 'translation') -----
+ identifyingPredefinedMacros
+ 	^#('__MIPSEL__')!

Item was added:
+ ----- Method: CogMIPSELCompiler class>>machineCodeDeclaration (in category 'translation') -----
+ machineCodeDeclaration
+ 	"Answer the declaration for the machineCode array."
+ 	^{#'unsigned long'. '[', self basicNew machineCodeWords printString, ']'}!

Item was removed:
- ----- Method: CogMIPSELCompiler>>break: (in category 'encoding - control') -----
- break: code
- 	self assert: (code between: 0 and: 16rFFFFF).
- 	^(code << 6) bitOr: BREAK!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrLongEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrLongEqualRR
+ 	| jumpTargetInstruction jumpTargetAddr leftReg rightReg |
+ 	<var: #jumpTargetInstruction type: #'AbstractInstruction *'>
+ 	jumpTargetInstruction := self longJumpTargetAddress.
- 	| jumpTarget leftReg rightReg |
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
- 	jumpTarget := self longJumpTargetAddress.
  	self flag: #todo. "Check not crossing 256MB block."
+ 	jumpTargetAddr := jumpTargetInstruction asUnsignedInteger bitAnd: 16rFFFFFFF.
- 	jumpTarget := jumpTarget bitAnd: 16rFFFFFFF.
  	leftReg := self concreteRegister: (operands at: 1).
  	rightReg := self concreteRegister: (operands at: 2).
  
  	self machineCodeAt: 0 put: (self bneR: leftReg R: rightReg offset: 12).
  	self machineCodeAt: 4 put: (self nop). "Delay slot"
+ 	self machineCodeAt: 8 put: (self jA: jumpTargetAddr).
- 	self machineCodeAt: 8 put: (self jA: jumpTarget).
  	self machineCodeAt: 12 put: self nop. "Delay slot"
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrLongNotEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrLongNotEqualRR
+ 	| jumpTargetInstruction jumpTargetAddr leftReg rightReg |
+ 	<var: #jumpTargetInstruction type: #'AbstractInstruction *'>
+ 	jumpTargetInstruction := self longJumpTargetAddress.
- 	| jumpTarget leftReg rightReg |
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
- 	jumpTarget := self longJumpTargetAddress.
  	self flag: #todo. "Check not crossing 256MB block."
+ 	jumpTargetAddr := jumpTargetInstruction asUnsignedInteger bitAnd: 16rFFFFFFF.
- 	jumpTarget := jumpTarget bitAnd: 16rFFFFFFF.
  	leftReg := self concreteRegister: (operands at: 1).
  	rightReg := self concreteRegister: (operands at: 2).
  
  	self machineCodeAt: 0 put: (self beqR: leftReg R: rightReg offset: 12).
  	self machineCodeAt: 4 put: (self nop). "Delay slot"
+ 	self machineCodeAt: 8 put: (self jA: jumpTargetAddr).
- 	self machineCodeAt: 8 put: (self jA: jumpTarget).
  	self machineCodeAt: 12 put: self nop. "Delay slot"
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeCallFull (in category 'generate machine code - concretize') -----
  concretizeCallFull
+ 	| jumpTargetInstruction jumpTargetAddr |
+ 	<var: #jumpTargetInstruction type: #'AbstractInstruction *'>
+ 	jumpTargetInstruction := self longJumpTargetAddress.
+ 	jumpTargetAddr := jumpTargetInstruction asUnsignedInteger.
+ 	self machineCodeAt: 0 put: (self luiR: TargetReg C: (self high16BitsOf: jumpTargetAddr)).
+ 	self machineCodeAt: 4 put: (self oriR: TargetReg R: TargetReg C: (self low16BitsOf: jumpTargetAddr)).
- 	| jumpTarget |
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
- 	jumpTarget := self longJumpTargetAddress.
- 	self machineCodeAt: 0 put: (self luiR: TargetReg C: (self high16BitsOf: jumpTarget)).
- 	self machineCodeAt: 4 put: (self oriR: TargetReg R: TargetReg C: (self low16BitsOf: jumpTarget)).	
  	self machineCodeAt: 8 put: (self jalR: TargetReg).
  	self machineCodeAt: 12 put: self nop. "Delay slot"
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeJumpFull (in category 'generate machine code - concretize') -----
  concretizeJumpFull
+ 	| jumpTargetInstruction jumpTargetAddr |
+ 	<var: #jumpTargetInstruction type: #'AbstractInstruction *'>
+ 	jumpTargetInstruction := self longJumpTargetAddress.
+ 	jumpTargetAddr := jumpTargetInstruction asUnsignedInteger.
+ 	self machineCodeAt: 0 put: (self luiR: TargetReg C: (self high16BitsOf: jumpTargetAddr)).
+ 	self machineCodeAt: 4 put: (self oriR: TargetReg R: TargetReg C: (self low16BitsOf: jumpTargetAddr)).
- 	| jumpTarget |
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
- 	jumpTarget := self longJumpTargetAddress.
- 	self machineCodeAt: 0 put: (self luiR: TargetReg C: (self high16BitsOf: jumpTarget)).
- 	self machineCodeAt: 4 put: (self oriR: TargetReg R: TargetReg C: (self low16BitsOf: jumpTarget)).	
  	self machineCodeAt: 8 put: (self jR: TargetReg).
  	self machineCodeAt: 12 put: self nop. "Delay slot"
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizePrefetchAw (in category 'generate machine code - concretize') -----
  concretizePrefetchAw
+ 	| addressOperand |
+ 	addressOperand := operands at: 0.
+ 	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: addressOperand)).
+ 	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: addressOperand)).
- 	| address |
- 	address := operands at: 0.
- 	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: address)).
- 	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: address)).
  	self machineCodeAt: 8 put: (self prefR: AT offset: 0 hint: HintLoad).
  	^machineCodeSize := 12!

Item was added:
+ ----- Method: CogMIPSELCompiler>>concretizeUnimplemented (in category 'generate machine code - concretize') -----
+ concretizeUnimplemented
+ 	self error: 'Unimplemented RTL instruction'.
+ 	^0!

Item was changed:
  ----- Method: CogMIPSELCompiler>>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."
  	<returnTypeC: #void>		 
  	opcode caseOf: {
  		[BrEqualRR]						-> [^self concretizeBrEqualRR].
  		[BrNotEqualRR]					-> [^self concretizeBrNotEqualRR].
  		[BrUnsignedLessRR]			-> [^self concretizeBrUnsignedLessRR].
  		[BrUnsignedLessEqualRR]		-> [^self concretizeBrUnsignedLessEqualRR].
  		[BrUnsignedGreaterRR]			-> [^self concretizeBrUnsignedGreaterRR].
  		[BrUnsignedGreaterEqualRR]	-> [^self concretizeBrUnsignedGreaterEqualRR].
  		[BrSignedLessRR]				-> [^self concretizeBrSignedLessRR].
  		[BrSignedLessEqualRR]			-> [^self concretizeBrSignedLessEqualRR].
  		[BrSignedGreaterRR]			-> [^self concretizeBrSignedGreaterRR].
  		[BrSignedGreaterEqualRR]		-> [^self concretizeBrSignedGreaterEqualRR].	
  		[BrLongEqualRR]				-> [^self concretizeBrLongEqualRR].
  		[BrLongNotEqualRR]				-> [^self concretizeBrLongNotEqualRR].
+ 		[MulRR]				-> [^self concretizeUnimplemented].
- 		[MulRR]				-> [^self concretizeMulRR].
  		[DivRR]				-> [^self concretizeDivRR].
  		[MoveLowR]		-> [^self concretizeMoveLowR].
  		[MoveHighR]		-> [^self concretizeMoveHighR].
  
  										
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill32]					-> [^self concretizeFill32].
  		[Nop]					-> [^self concretizeNop].
  		"Control"
  		[Call]						-> [^self concretizeCall]. "call code within code space"
  		[CallFull]					-> [^self concretizeCallFull]. "call code anywhere in address space"
  		[JumpR]						-> [^self concretizeJumpR].
  		[JumpFull]					-> [^self concretizeJumpFull]."jump within address space"
  		[JumpLong]					-> [^self concretizeJumpLong]."jumps witihn code space"
  		[JumpLongZero]			-> [^self concretizeJumpLongZero].
  		[JumpLongNonZero]		-> [^self concretizeJumpLongNonZero].
  		[Jump]						-> [^self concretizeJump].
  		[JumpZero]					-> [^self concretizeJumpZero].
  		[JumpNonZero]				-> [^self concretizeJumpNonZero].
  		[JumpNegative]				-> [^self concretizeUnimplemented].
  		[JumpNonNegative]			-> [^self concretizeUnimplemented].
  		[JumpOverflow]				-> [^self concretizeJumpOverflow].
  		[JumpNoOverflow]			-> [^self concretizeJumpNoOverflow].
  		[JumpCarry]				-> [^self concretizeUnimplemented].
  		[JumpNoCarry]				-> [^self concretizeUnimplemented].
  		[JumpLess]					-> [^self concretizeJumpSignedLessThan].
  		[JumpGreaterOrEqual]		-> [^self concretizeJumpSignedGreaterEqual].
  		[JumpGreater]				-> [^self concretizeJumpSignedGreaterThan].
  		[JumpLessOrEqual]			-> [^self concretizeJumpSignedLessEqual].
  		[JumpBelow]				-> [^self concretizeJumpUnsignedLessThan].
  		[JumpAboveOrEqual]		-> [^self concretizeJumpUnsignedGreaterEqual].
  		[JumpAbove]				-> [^self concretizeJumpUnsignedGreaterThan].
  		[JumpBelowOrEqual]		-> [^self concretizeJumpUnsignedLessEqual].
  		[JumpFPEqual]				-> [^self concretizeUnimplemented].
  		[JumpFPNotEqual]			-> [^self concretizeUnimplemented].
  		[JumpFPLess]				-> [^self concretizeUnimplemented].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeUnimplemented].
  		[JumpFPGreater]			-> [^self concretizeUnimplemented].
  		[JumpFPLessOrEqual]		-> [^self concretizeUnimplemented].
  		[JumpFPOrdered]			-> [^self concretizeUnimplemented].
  		[JumpFPUnordered]			-> [^self concretizeUnimplemented].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AndCqR]					-> [^self concretizeAndCqR].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[OrCqR]						-> [^self concretizeOrCqR].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[TstCqR]					-> [^self concretizeTstCqR].
+ 		[XorCqR]					-> [^self concretizeUnimplemented].
- 		[XorCqR]					-> [^self concretizeXorCqR].
  		[AddCwR]					-> [^self concretizeAddCwR].
  		[AndCwR]					-> [^self concretizeAndCwR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[OrCwR]					-> [^self concretizeOrCwR].
  		[SubCwR]					-> [^self concretizeSubCwR].
  		[XorCwR]					-> [^self concretizeXorCwR].
  		[AddRR]						-> [^self concretizeAddRR].
  		[AndRR]						-> [^self concretizeAndRR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[OrRR]						-> [^self concretizeOrRR].
  		[SubRR]						-> [^self concretizeSubRR].
  		[XorRR]						-> [^self concretizeXorRR].
  		[AddRdRd]					-> [^self concretizeUnimplemented].
  		[CmpRdRd]					-> [^self concretizeUnimplemented].
  		[DivRdRd]					-> [^self concretizeUnimplemented].
  		[MulRdRd]					-> [^self concretizeUnimplemented].
  		[SubRdRd]					-> [^self concretizeUnimplemented].
  		[SqrtRd]					-> [^self concretizeUnimplemented].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveAbR]			-> [^self concretizeMoveAbR].
  		[MoveRAb]			-> [^self concretizeMoveRAb].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
+ 		[MoveRMbr]			-> [^self concretizeUnimplemented].
- 		[MoveRMbr]			-> [^self concretizeRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
+ 		[MoveM64rRd]		-> [^self concretizeUnimplemented].
- 		[MoveM64rRd]		-> [^self concretizeM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveRXbrR]		-> [^self concretizeMoveRXbrR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
+ 		[MoveRdM64r]		-> [^self concretizeUnimplemented].
- 		[MoveRdM64r]		-> [^self concretizeRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCq]			-> [^self concretizePushCq].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		[AddCheckOverflowCqR] -> [^self concretizeAddCheckOverflowCqR].
  		[AddCheckOverflowRR] -> [^self concretizeAddCheckOverflowRR].
  		[SubCheckOverflowCqR] -> [^self concretizeSubCheckOverflowCqR].
  		[SubCheckOverflowRR] -> [^self concretizeSubCheckOverflowRR].
  		[MulCheckOverflowRR] -> [^self concretizeMulCheckOverflowRR].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeUnimplemented]}!

Item was added:
+ ----- Method: CogMIPSELCompiler>>flushICacheFrom:to: (in category 'inline cacheing') -----
+ flushICacheFrom: startAddress "<Integer>" to: endAddress "<Integer>"
+ 	<cmacro: '(me,startAddress,endAddress) __clear_cache((char*) startAddress, (char*) (endAddress ))'>
+ 	"On ARM we almost certainly need to flush and wash hands. On linux we use __clear_cache (see http://community.arm.com/groups/processors/blog/2010/02/17/caches-and-self-modifying-code for a decent example) and remember that the end address is *exclusive* so we can just use the end address passed in since it is always the byte after the actual last one needing flushing"
+ 	self halt: #ceFlushICache!

Item was added:
+ ----- Method: CogMIPSELCompiler>>genLoadCStackPointer (in category 'smalltalk calling convention') -----
+ genLoadCStackPointer
+ 	"Load the stack pointer register with that of the C stack, effecting
+ 	 a switch to the C stack.  Used when machine code calls into the
+ 	 CoInterpreter run-time (e.g. to invoke interpreter primitives)."
+ 	cogit MoveAw: cogit cStackPointerAddress R: SPReg.
+ 	^0!

Item was added:
+ ----- Method: CogMIPSELCompiler>>genRestoreRegsExcept: (in category 'abi') -----
+ genRestoreRegsExcept: abstractReg
+ 	"Restore the general purpose registers except for abstractReg for a trampoline call."
+ 	self flag: #bogus.!

Item was added:
+ ----- Method: CogMIPSELCompiler>>getDefaultCogCodeSize (in category 'accessing') -----
+ getDefaultCogCodeSize
+ 	"Return the default number of bytes to allocate for native code at startup.
+ 	 The actual value can be set via vmParameterAt: and/or a preference in the ini file."
+ 	<inline: true>
+ 	^1024 * 1536!

Item was added:
+ ----- Method: CogMIPSELCompiler>>hasVarBaseRegister (in category 'testing') -----
+ hasVarBaseRegister
+ 	"Answer if the processor has a dedicated callee-saved register to point to
+ 	 the base of commonly-accessed variables."
+ 	<inline: true>
+ 	^true "S6"!

Item was changed:
  ----- Method: CogMIPSELCompiler>>isJumpAt: (in category 'testing') -----
  isJumpAt: pc
+ 	"cogit disassembleFrom: pc to: pc + 4."
- 	cogit disassembleFrom: pc to: pc + 4.
  
  	(self opcodeAtAddress: pc) = J ifTrue: [^true].
  	
+ 	(self opcodeAtAddress: pc) = SPECIAL ifTrue: 
+ 		[(self functionAtAddress: pc) = JR ifTrue: [^true]].
- 	(self opcodeAtAddress: pc) = SPECIAL ifTrue: [
- 		(self functionAtAddress: pc) = JR ifTrue: [^true].
- 	].
  
  	(self opcodeAtAddress: pc) = BEQ ifTrue: [^true].
  	(self opcodeAtAddress: pc) = BNE ifTrue: [^true].
  	(self opcodeAtAddress: pc) = BLEZ ifTrue: [^true].
  	(self opcodeAtAddress: pc) = BGTZ ifTrue: [^true].
  
+ 	(self opcodeAtAddress: pc) = REGIMM ifTrue: 
+ 		[(self rtAtAddress: pc) = BLTZ ifTrue: [^true].
+ 		 (self rtAtAddress: pc) = BGEZ ifTrue: [^true]].	
- 	(self opcodeAtAddress: pc) = REGIMM ifTrue: [
- 		(self rtAtAddress: pc) = BLTZ ifTrue: [^true].
- 		(self rtAtAddress: pc) = BGEZ ifTrue: [^true].
- 	].	
  	
  	^false!

Item was changed:
  ----- Method: CogMIPSELCompiler>>itype:rs:rt:eitherImmediate: (in category 'encoding') -----
+ itype: op rs: rs rt: rt eitherImmediate: signedImmediate	
- itype: opcode rs: rs rt: rt eitherImmediate: signedImmediate	
  	| unsignedImmediate |
+ 	self assert: (op between: 0 and: 63).
- 	self assert: (opcode between: 0 and: 63).
  	self assert: (rs between: 0 and: 31).
  	self assert: (rt between: 0 and: 31).
  	signedImmediate < 0
  		ifTrue: [unsignedImmediate := signedImmediate + 16r10000]
  		ifFalse: [unsignedImmediate := signedImmediate].
  	self assert: (unsignedImmediate between: 0 and: 16rFFFF).
+ 	^(((op << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: unsignedImmediate!
- 	^(((opcode << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: unsignedImmediate!

Item was changed:
  ----- Method: CogMIPSELCompiler>>itype:rs:rt:signedImmediate: (in category 'encoding') -----
+ itype: op rs: rs rt: rt signedImmediate: signedImmediate	
- itype: opcode rs: rs rt: rt signedImmediate: signedImmediate	
  	| unsignedImmediate |
+ 	self assert: (op between: 0 and: 63).
- 	self assert: (opcode between: 0 and: 63).
  	self assert: (rs between: 0 and: 31).
  	self assert: (rt between: 0 and: 31).
  	self assert: (signedImmediate between: -16r8000 and: 16r7FFF).
  	signedImmediate < 0
  		ifTrue: [unsignedImmediate := signedImmediate + 16r10000]
  		ifFalse: [unsignedImmediate := signedImmediate].
  	self assert: (unsignedImmediate between: 0 and: 16rFFFF).
+ 	^(((op << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: unsignedImmediate!
- 	^(((opcode << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: unsignedImmediate!

Item was changed:
  ----- Method: CogMIPSELCompiler>>itype:rs:rt:unsignedImmediate: (in category 'encoding') -----
+ itype: op rs: rs rt: rt unsignedImmediate: immediate	
+ 	self assert: (op between: 0 and: 63).
- itype: opcode rs: rs rt: rt unsignedImmediate: immediate	
- 	self assert: (opcode between: 0 and: 63).
  	self assert: (rs between: 0 and: 31).
  	self assert: (rt between: 0 and: 31).
  	self assert: (immediate between: 0 and: 16rFFFF).
+ 	^(((op << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: immediate!
- 	^(((opcode << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: immediate!

Item was changed:
  ----- Method: CogMIPSELCompiler>>jtype:target: (in category 'encoding') -----
+ jtype: op target: target
+ 	self assert: (op between: 0 and: 63).
+ 	self assert: (target between: 0 and: 16r7FFFFFF).
+ 	^(op << 26) bitOr: target!
- jtype: opcode target: target
- 	self assert: (opcode between: 0 and: 63).
- 	self assert: (opcode between: 0 and: 16r7FFFFFF).
- 	^(opcode << 26) bitOr: target!

Item was added:
+ ----- Method: CogMIPSELCompiler>>mipsbreak: (in category 'encoding - control') -----
+ mipsbreak: code
+ 	self assert: (code between: 0 and: 16rFFFFF).
+ 	^(code << 6) bitOr: BREAK!

Item was changed:
  ----- Method: CogMIPSELCompiler>>noteFollowingConditionalBranch: (in category 'abstract instructions') -----
  noteFollowingConditionalBranch: branch
  	"Support for processors without condition codes, such as the MIPS.
  	 Answer the branch opcode.  Modify the receiver and the branch to
  	 implement a suitable conditional branch that doesn't depend on
  	 condition codes being set by the receiver."
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #branch type: #'AbstractInstruction *'>
  	| newBranchLeft newBranchOpcode newBranchRight |
  	
  	((branch opcode = JumpOverflow) or: [branch opcode = JumpNoOverflow]) 
  		ifTrue: [^self noteFollowingOverflowBranch: branch].
  
  	newBranchOpcode := branch opcode caseOf: {
  		[JumpZero] 			-> [BrEqualRR].
  		[JumpNonZero]			-> [BrNotEqualRR].
  		[JumpBelow]			-> [BrUnsignedLessRR].
  		[JumpBelowOrEqual]	-> [BrUnsignedLessEqualRR].
  		[JumpAbove]			-> [BrUnsignedGreaterRR].
  		[JumpAboveOrEqual]	-> [BrUnsignedGreaterEqualRR].
  		[JumpLess]				-> [BrSignedLessRR].
  		[JumpLessOrEqual]		-> [BrSignedLessEqualRR].
  		[JumpGreater]			-> [BrSignedGreaterRR].
  		[JumpGreaterOrEqual]	-> [BrSignedGreaterEqualRR].
  		[JumpLongZero] 		-> [BrLongEqualRR].
  		[JumpLongNonZero]	-> [BrLongNotEqualRR].
  		
  		[JumpNegative]			-> [BrSignedLessRR].
+ 	} otherwise: [self unreachable. 0].
- 	} otherwise: [self unreachable].
  	
  	opcode caseOf: {
  		[BrEqualRR]	->	["I.e., two jumps after a compare."
  						newBranchLeft := operands at: 1.
  						newBranchRight := operands at: 2].
  		[BrUnsignedLessRR]	->	["I.e., two jumps after a compare."
  						newBranchLeft := operands at: 1.
  						newBranchRight := operands at: 2].
  
  		[CmpRR] 	-> 	[newBranchLeft := operands at: 1.
  						 newBranchRight := operands at: 0.
  						 opcode := Label].
  		[CmpCqR]	-> 	[newBranchLeft := operands at: 1.
  						 newBranchRight := AT.
  						 opcode := MoveCqR.
  						 operands at: 1 put: AT].
  		[CmpCwR]	-> 	[newBranchLeft := operands at: 1.
  						 newBranchRight := AT.
  						 opcode := MoveCwR.
  						 operands at: 1 put: AT].
  		[TstCqR]	->	[newBranchLeft := Cmp.
  						 newBranchRight := ZR].
  		[AndCqR]	->	[newBranchLeft := operands at: 1.
  						 newBranchRight := ZR].
  		[AndCqRR]	->	[newBranchLeft := operands at: 2.
  						 newBranchRight := ZR].
  		[OrRR]	->		[newBranchLeft := operands at: 1.
  						 newBranchRight := ZR].
  		[XorRR]	->		[newBranchLeft := operands at: 1.
  						 newBranchRight := ZR].
  		[SubCwR]	->	[newBranchLeft := operands at: 1.
  						 newBranchRight := ZR].
  		[SubCqR]	->	[newBranchLeft := operands at: 1.
  						 newBranchRight := ZR].
  		[ArithmeticShiftRightCqR]	->	[newBranchLeft := operands at: 1.
  						 newBranchRight := ZR].
  	} otherwise: [self unreachable].
  
  	branch rewriteOpcode: newBranchOpcode with: newBranchLeft with: newBranchRight.
  	^branch!

Item was changed:
  ----- Method: CogMIPSELCompiler>>noteFollowingOverflowBranch: (in category 'abstract instructions') -----
  noteFollowingOverflowBranch: branch
  	"Support for processors without condition codes, such as the MIPS.
  	 Answer the branch opcode.  Modify the receiver and the branch to
  	 implement a suitable conditional branch that doesn't depend on
  	 condition codes being set by the receiver."
  	<var: #branch type: #'AbstractInstruction *'>
  	| newBranchOpcode |
  	
  	(opcode = MulRR) ifTrue:
  		[opcode := MulCheckOverflowRR.
  		 newBranchOpcode := branch opcode caseOf: {
  			[JumpOverflow]		-> [BrNotEqualRR].
  			[JumpNoOverflow]	-> [BrEqualRR].
+ 		 } otherwise: [self unreachable. 0].
- 		 } otherwise: [self unreachable].
  		 branch rewriteOpcode: newBranchOpcode with: OverflowTemp1 with: OverflowTemp2.
  		 ^branch].
  
  
  	opcode := opcode caseOf: {
  		[AddCqR]	-> [AddCheckOverflowCqR].
  		[AddRR]		-> [AddCheckOverflowRR].
  		[SubCqR]	-> [SubCheckOverflowCqR].
  		[SubRR]		-> [SubCheckOverflowRR].
+ 	} otherwise: [self unreachable. 0].
- 	} otherwise: [self unreachable].
  
  	newBranchOpcode := branch opcode caseOf: {
  		[JumpOverflow]		-> [BrSignedLessRR].
  		[JumpNoOverflow]	-> [BrSignedGreaterEqualRR].
+ 	} otherwise: [self unreachable. 0].
- 	} otherwise: [self unreachable].
  	branch rewriteOpcode: newBranchOpcode with: Overflow with: ZR.
  	^branch!

Item was changed:
  ----- Method: CogMIPSELCompiler>>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."
  	
  	"MoveCwR ClassReg selectorIndex/expectedClass
  	 Call: unlinked send stub/expectedTarget
  	 Push ReceiverResult <-- callSiteReturnAddress"
  	
  	"lui s3, selector/tagHigh
  	 ori s3, s3, selector/tagLow
  	 lui t9, stub/targetHigh
  	 ori t9, t9, stub/targetLow
  	 jalr t9
  	 nop (delay slot)
  	 ...  <-- callSiteReturnAddress"
  	
  	<var: #callSiteReturnAddress type: #usqInt>
- 	<var: #callTargetAddress type: #usqInt>
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 24) = LUI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 20) = ORI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 16) = LUI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 12) = ORI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 8) = SPECIAL.
  	self assert: (self functionAtAddress: callSiteReturnAddress - 8) = JALR.
  	self assert: (objectMemory longAt: callSiteReturnAddress - 4) = self nop.
  	"cogit disassembleFrom: callSiteReturnAddress - 24 to: callSiteReturnAddress."
  
  	self literalAtAddress: callSiteReturnAddress - 20 put: cacheTag.
  
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 24) = LUI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 20) = ORI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 16) = LUI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 12) = ORI.
  	self assert: (self opcodeAtAddress: callSiteReturnAddress - 8) = SPECIAL.
  	self assert: (self functionAtAddress: callSiteReturnAddress - 8) = JALR.
  	self assert: (objectMemory longAt: callSiteReturnAddress - 4) = self nop.
  	"cogit disassembleFrom: callSiteReturnAddress - 24 to: callSiteReturnAddress."!

Item was changed:
  ----- Method: CogMIPSELCompiler>>rewriteOpcode:with:with: (in category 'abstract instructions') -----
  rewriteOpcode: anOpcode with: left with: right
  	<inline: true>
- 	self assert: anOpcode isInteger.
- 	self assert: left isInteger.
- 	self assert: right isInteger.
- 	
  	opcode := anOpcode.
  	operands
  		"0 is target"
  		at: 1 put: left;
  		at: 2 put: right!

Item was added:
+ ----- Method: CogMIPSELCompiler>>rtAtAddress: (in category 'inline cacheing') -----
+ rtAtAddress: mcpc
+ 	^(objectMemory longAt: mcpc) >> 16 bitAnd: 31
+ !

Item was changed:
  ----- Method: CogMIPSELCompiler>>rtype:rs:rt:rd:sa:funct: (in category 'encoding') -----
+ rtype: op rs: rs rt: rt rd: rd sa: sa funct: funct
+ 	self assert: (op between: 0 and: 63).
- rtype: opcode rs: rs rt: rt rd: rd sa: sa funct: funct
- 	self assert: (opcode between: 0 and: 63).
  	self assert: (rs between: 0 and: 31).
  	self assert: (rt between: 0 and: 31).
  	self assert: (rd between: 0 and: 31).
  	self assert: (sa between: 0 and: 31).
  	self assert: (funct between: 0 and: 63).
+ 	^(((((op << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: (rd << 11)) bitOr: (sa << 6)) bitOr: funct!
- 	^(((((opcode << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr: (rd << 11)) bitOr: (sa << 6)) bitOr: funct!

Item was changed:
  ----- Method: CogMIPSELCompiler>>stop (in category 'encoding - control') -----
  stop
+ 	^self mipsbreak: 0!
- 	^self break: 0!



More information about the Vm-dev mailing list