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

Eliot Miranda eliot.miranda at gmail.com
Wed Nov 18 17:40:30 UTC 2015


Hi Ryan,

    looking at these changes I wonder whether the right way to do this is
to back out of the introduction of OpCheckOverflowCq/R:R:, add the opcodes
as class variables of CogMIPSELCompiler (c.f. CDQ &IMULRR in
CogIA32Compiler), and have the change made in Jump[No]Overflow:.  e.g.

JumpNoOverflow: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpNoOverflow operand: jumpTarget asInteger

and all other conditional jumps could be rewritten along the lines of

JumpNoOverflow: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self previousInstruction noteFollowingConditionalBranch:
(self gen: JumpNoOverflow operand: jumpTarget asInteger)

where

CogAbstractInstruction>> noteFollowingConditionalBranch: branchInstruction
<var: 'branchInstruction' type: #'AbstractInstruction *'>
<inline: true>
^branchInstruction

CogMIPSELCompiler>>noteFollowingConditionalBranch: branchInstruction
<var: 'branchInstruction' type: #'AbstractInstruction *'>
branchInstruction opcode caseOf: {
[JumpOverflow] -> [opcode := opcode caseOf: {
[AddCqR] -> [AddOverflowCheckCqR].
...
}].
...
}.
^branchInstruction


What do you think? If you like this I'm happy to do the leg work.

I'd consider add subclasses of CogAbstractInstruction:
CogAbstractInstructionWithConditionCodes
CogAbstractInstructionWithoutConditionCodes, and put the different versions
there-in.  Of course if we were to apply this to the LinkReg/RetPC
RISC/CISC distinction we'd need multiple inheritance, so perhaps this is
too elaborate.


On Tue, Nov 17, 2015 at 10:04 PM, <commits at source.squeak.org> wrote:

>
> Ryan Macnak uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-rmacnak.1524.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-rmacnak.1524
> Author: rmacnak
> Time: 17 November 2015, 10:03:52.949 pm
> UUID: d298c397-7a0b-4973-b1e1-39c9b08053c9
> Ancestors: VMMaker.oscog-eem.1523
>
> Get MIPSEL up to the first CPIC extension.
>
> Add separate RTL opcodes for Add/Sub/Mul with overflow check.
> Fix relative jump offsets.
> Fix MoveMwrR with large offsets.
> Fix confusion of call as jump in initial CPIC setup.
>
> =============== Diff against VMMaker.oscog-eem.1523 ===============
>
> Item was added:
> + ----- Method: CogARMCompiler>>hasConditionRegister (in category
> 'testing') -----
> + hasConditionRegister
> +       "Answer if the receiver supports, e.g., JumpOverflow after a
> regular AddRR"
> +       <inline: true>
> +       ^true!
>
> Item was added:
> + ----- Method: CogAbstractInstruction>>hasConditionRegister (in category
> 'testing') -----
> + hasConditionRegister
> +       "Answer if the receiver supports, e.g., JumpOverflow after a
> regular AddRR"
> +       <inline: true>
> +       ^self subclassResponsibility!
>
> Item was added:
> + ----- Method: CogIA32Compiler>>hasConditionRegister (in category
> 'testing') -----
> + hasConditionRegister
> +       "Answer if the receiver supports, e.g., JumpOverflow after a
> regular AddRR"
> +       <inline: true>
> +       ^true!
>
> Item was changed:
>   CogAbstractInstruction subclass: #CogMIPSELCompiler
>         instanceVariableNames: ''
> +       classVariableNames: 'Cmp CmpSGT CmpSLT CmpUGT CmpULT
> ConcreteVarBaseReg Overflow OverflowTemp1 OverflowTemp2 TargetReg'
> -       classVariableNames: 'Cmp CmpSGT CmpSLT CmpUGT CmpULT
> ConcreteVarBaseReg TargetReg'
>         poolDictionaries: 'MIPSConstants'
>         category: 'VMMaker-JIT'!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler class>>initialize (in category 'as yet
> unclassified') -----
>   initialize
>         "CogMIPSELCompiler initialize"
>
>         super initialize.
>
>         ConcreteVarBaseReg := S6.
>
>         "Simulating a condition register."
>         Cmp := T0.
>         CmpSLT := T1.
>         CmpSGT := T2.
>         CmpULT := T3.
>         CmpUGT := T4.
> +       Overflow := T0.
> +       OverflowTemp1 := T1.
> +       OverflowTemp2 := T2.
>
>         "OABI position independent code expects T9 to have its entry point
> on entry?"
>         self flag: #OABI.
>         TargetReg := T9. !
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>computeMaximumSize (in category
> 'generate machine code') -----
>   computeMaximumSize
>         "Each MIPS instruction has 4 bytes. Many abstract opcodes need
> more than one
>          instruction. Instructions that refer to constants and/or literals
> depend on literals
>          being stored in-line or out-of-line.
>
>          N.B.  The ^N forms are to get around the bytecode compiler's long
> branch
>          limits which are exceeded when each case jumps around the
> otherwise."
>
>         opcode
>                 caseOf: {
>                 "Noops & Pseudo Ops"
>                 [Label]                                 -> [^0].
>                 [Literal]                                       -> [^4].
>                 [AlignmentNops]         -> [^(operands at: 0) - 4].
>                 [Fill16]                                        -> [^4].
>                 [Fill32]                                        -> [^4].
>                 [FillFromWord]                  -> [^4].
>                 [Nop]                                   -> [^4].
>                 "Control"
>                 [Call]                                  -> [^self
> literalLoadInstructionBytes + 8].
>                 [CallFull]                              -> [^self
> literalLoadInstructionBytes + 8].
>                 [JumpR]                                 -> [^8].
>                 [Jump]                                  -> [^8].
>                 [JumpFull]                              -> [^self
> literalLoadInstructionBytes + 8].
>                 [JumpLong]                              -> [^self
> literalLoadInstructionBytes + 8].
>                 [JumpZero]                              -> [^8].
>                 [JumpNonZero]                   -> [^8].
>                 [JumpNegative]                  -> [^8].
>                 [JumpNonNegative]               -> [^8].
>                 [JumpOverflow]                  -> [^8].
>                 [JumpNoOverflow]                -> [^8].
>                 [JumpCarry]                     -> [^8].
>                 [JumpNoCarry]                   -> [^8].
>                 [JumpLess]                              -> [^8].
>                 [JumpGreaterOrEqual]    -> [^8].
>                 [JumpGreater]                   -> [^8].
>                 [JumpLessOrEqual]               -> [^8].
>                 [JumpBelow]                     -> [^8].
>                 [JumpAboveOrEqual]      -> [^8].
>                 [JumpAbove]                     -> [^8].
>                 [JumpBelowOrEqual]      -> [^8].
>                 [JumpLongZero]          -> [^self
> literalLoadInstructionBytes + 8].
>                 [JumpLongNonZero]       -> [^self
> literalLoadInstructionBytes + 8].
>                 [JumpFPEqual]                   -> [^8].
>                 [JumpFPNotEqual]                -> [^8].
>                 [JumpFPLess]                    -> [^8].
>                 [JumpFPGreaterOrEqual]-> [^8].
>                 [JumpFPGreater]         -> [^8].
>                 [JumpFPLessOrEqual]     -> [^8].
>                 [JumpFPOrdered]         -> [^8].
>                 [JumpFPUnordered]               -> [^8].
>                 [RetN]                                  -> [^8].
>                 [Stop]                                  -> [^4].
>
>                 "Arithmetic"
>                 [AddCqR]                                -> [^12].
>                 [AndCqR]                                -> [^16].
>                 [AndCqRR]                               -> [^12].
>                 [CmpCqR]                                -> [^28].
>                 [OrCqR]                                 -> [^12].
>                 [SubCqR]                                -> [^12].
>                 [TstCqR]                                -> [^12].
>                 [XorCqR]                                -> [^12].
>                 [AddCwR]                                -> [^12].
>                 [AndCwR]                                -> [^12].
>                 [CmpCwR]                                -> [^28].
>                 [OrCwR]                         -> [^12].
>                 [SubCwR]                                -> [^12].
>                 [XorCwR]                                -> [^12].
>                 [AddRR]                                 -> [^4].
>                 [AndRR]                                 -> [^4].
>                 [CmpRR]                         -> [^20].
>                 [OrRR]                                  -> [^4].
>                 [XorRR]                                 -> [^4].
>                 [SubRR]                                 -> [^4].
>                 [NegateR]                               -> [^4].
> +               [LoadEffectiveAddressMwrR] -> [^12].
> -               [LoadEffectiveAddressMwrR]
> -                                                                       ->
> [^self rotateable8bitImmediate: (operands at: 0)
> -
>              ifTrue: [:r :i| 4]
> -
>              ifFalse: [self literalLoadInstructionBytes + 4]].
> -
>                 [LogicalShiftLeftCqR]           -> [^4].
>                 [LogicalShiftRightCqR]          -> [^4].
>                 [ArithmeticShiftRightCqR]       -> [^4].
>                 [LogicalShiftLeftRR]                    -> [^4].
>                 [LogicalShiftRightRR]           -> [^4].
>                 [ArithmeticShiftRightRR]                -> [^4].
>                 [AddRdRd]                                       -> [^4].
>                 [CmpRdRd]                                       -> [^4].
>                 [SubRdRd]                                       -> [^4].
>                 [MulRdRd]                                       -> [^4].
>                 [DivRdRd]                                       -> [^4].
>                 [SqrtRd]                                        -> [^4].
> +               [SubCheckOverflowCqR]   -> [^28].
>                 "Data Movement"
>                 [MoveCqR]                               -> [^8 "or 4"].
>                 [MoveCwR]                               -> [^8].
>                 [MoveRR]                                -> [^4].
>                 [MoveRdRd]                              -> [^4].
>                 [MoveAwR]                               -> [^(self
> isAddressRelativeToVarBase: (operands at: 0))
>
>                               ifTrue: [4]
>
>                               ifFalse: [self literalLoadInstructionBytes +
> 4]].
>                 [MoveRAw]                               -> [^(self
> isAddressRelativeToVarBase: (operands at: 1))
>
>                               ifTrue: [4]
>
>                               ifFalse: [self literalLoadInstructionBytes +
> 4]].
> +               [MoveAbR]                               -> [^(self
> isAddressRelativeToVarBase: (operands at: 0))
> +
>                              ifTrue: [4]
> +
>                              ifFalse: [self literalLoadInstructionBytes +
> 4]].
> +               [MoveRAb]                               -> [^(self
> isAddressRelativeToVarBase: (operands at: 1))
> +
>                              ifTrue: [4]
> +
>                              ifFalse: [self literalLoadInstructionBytes +
> 4]].
>                 [MoveRMwr]                      -> [^16].
>                 [MoveRdM64r]                    -> [^self
> literalLoadInstructionBytes + 4].
>                 [MoveMbrR]                              -> [^16].
>                 [MoveRMbr]                              -> [^16].
>                 [MoveM16rR]                     -> [^4].
>                 [MoveM64rRd]                    -> [^self
> literalLoadInstructionBytes + 4].
>                 [MoveMwrR]                      -> [^16].
>                 [MoveXbrRR]                     -> [^0].
>                 [MoveRXbrR]                     -> [^0].
>                 [MoveXwrRR]                     -> [^12].
>                 [MoveRXwrR]                     -> [^12].
>                 [PopR]                                  -> [^8].
>                 [PushR]                                 -> [^8].
>                 [PushCw]                                -> [^16].
>                 [PushCq]                                -> [^16].
> +               [PrefetchAw]                    -> [^12].
> -               [PrefetchAw]                    -> [^(self
> isAddressRelativeToVarBase: (operands at: 0))
> -
>      ifTrue: [4]
> -
>      ifFalse: [self literalLoadInstructionBytes + 4]].
>                 "Conversion"
>                 [ConvertRRd]                    -> [^8].
>                 }.
>         ^0 "to keep C compiler quiet"
>   !
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJump (in category 'generate
> machine code - concretize') -----
>   concretizeJump
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 8.
>         self flag: #BranchRange.
>         self machineCodeAt: 0 put: (self beqR: ZR R: ZR offset: offset).
>         self machineCodeAt: 4 put: self nop. "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizeJumpNoOverflow (in category
> 'generate machine code - concretize') -----
> + concretizeJumpNoOverflow
> +       | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> +       self flag: #BranchRange.
> +       self machineCodeAt: 0 put: (self bgezR: Overflow offset: offset).
> +       self machineCodeAt: 4 put: self nop. "Delay slot"
> +       ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpNonZero (in category
> 'generate machine code - concretize') -----
>   concretizeJumpNonZero
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self flag: #BranchRange.
>         self machineCodeAt: 0 put: (self bneR: Cmp R: ZR offset: offset).
>         self machineCodeAt: 4 put: self nop. "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizeJumpOverflow (in category
> 'generate machine code - concretize') -----
> + concretizeJumpOverflow
> +       | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> +       self flag: #BranchRange.
> +       self machineCodeAt: 0 put: (self bltzR: Overflow offset: offset).
> +       self machineCodeAt: 4 put: self nop. "Delay slot"
> +       ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpSignedGreaterEqual (in
> category 'generate machine code - concretize') -----
>   concretizeJumpSignedGreaterEqual
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self bneR: CmpSLT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpSignedGreaterThan (in
> category 'generate machine code - concretize') -----
>   concretizeJumpSignedGreaterThan
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self bneR: CmpSGT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpSignedLessEqual (in
> category 'generate machine code - concretize') -----
>   concretizeJumpSignedLessEqual
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self beqR: CmpSGT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpSignedLessThan (in
> category 'generate machine code - concretize') -----
>   concretizeJumpSignedLessThan
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self bneR: CmpSLT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpUnsignedGreaterEqual (in
> category 'generate machine code - concretize') -----
>   concretizeJumpUnsignedGreaterEqual
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self bneR: CmpULT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpUnsignedGreaterThan (in
> category 'generate machine code - concretize') -----
>   concretizeJumpUnsignedGreaterThan
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self bneR: CmpUGT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpUnsignedLessEqual (in
> category 'generate machine code - concretize') -----
>   concretizeJumpUnsignedLessEqual
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self beqR: CmpUGT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpUnsignedLessThan (in
> category 'generate machine code - concretize') -----
>   concretizeJumpUnsignedLessThan
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self machineCodeAt: 0 put: (self bneR: CmpULT R: ZR offset:
> offset).
>         self machineCodeAt: 4 put: (self nop). "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeJumpZero (in category
> 'generate machine code - concretize') -----
>   concretizeJumpZero
>         | offset |
> +       offset := self computeJumpTargetOffsetPlus: 4.
> -       offset := self computeJumpTargetOffsetPlus: 12.
>         self flag: #BranchRange.
>         self machineCodeAt: 0 put: (self beqR: Cmp R: ZR offset: offset).
>         self machineCodeAt: 4 put: self nop. "Delay slot"
>         ^machineCodeSize := 8!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizeLoadEffectiveAddressMwrR (in
> category 'generate machine code - concretize') -----
> + concretizeLoadEffectiveAddressMwrR
> +       <var: #offset type: #sqInt>
> +       | baseReg offset destReg |
> +       offset := operands at: 0.
> +       baseReg := self concreteRegister: (operands at: 1).
> +       destReg := self concreteRegister: (operands at: 2).
> +       (self isShortOffset: offset) ifTrue:
> +               [self machineCodeAt: 0 put: (self addiuR: destReg R:
> baseReg C: offset).
> +               ^machineCodeSize := 4].
> +
> +       self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf:
> offset)).
> +       self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self
> low16BitsOf: offset)).
> +       self machineCodeAt: 8 put: (self adduR: destReg R: baseReg R: AT).
> +       ^machineCodeSize := 12.
> + !
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizeMoveAbR (in category
> 'generate machine code - concretize') -----
> + concretizeMoveAbR
> +       | srcAddr destReg |
> +       srcAddr := operands at: 0.
> +       destReg := self concreteRegister: (operands at: 1).
> +
> +       (self isAddressRelativeToVarBase: srcAddr) ifTrue:
> +               [self machineCodeAt: 0 put: (self lwR: destReg base:
> ConcreteVarBaseReg offset: srcAddr - cogit varBaseAddress).
> +                ^machineCodeSize := 4].
> +
> +       self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf:
> srcAddr)).
> +       self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self
> low16BitsOf: srcAddr)).
> +       self machineCodeAt: 8 put: (self lbuR: destReg base: AT offset: 0).
> +       ^machineCodeSize := 12!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeMoveMwrR (in category
> 'generate machine code - concretize') -----
>   concretizeMoveMwrR
>         <var: #offset type: #sqInt>
>         | baseReg offset destReg |
>         offset := operands at: 0.
>         baseReg := self concreteRegister: (operands at: 1).
>         destReg := self concreteRegister: (operands at: 2).
>         (self isShortOffset: offset) ifTrue:
>                 [self machineCodeAt: 0 put: (self lwR: destReg base:
> baseReg offset: offset).
>                 ^machineCodeSize := 4].
>
>         self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf:
> offset)).
>         self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self
> low16BitsOf: offset)).
> +       self machineCodeAt: 8 put: (self adduR: AT R: baseReg R: AT).
> +       self machineCodeAt: 12 put: (self lwR: destReg base: AT offset: 0).
> +       ^machineCodeSize := 16.
> -       self machineCodeAt: 8 put: (self adduR: AT R: baseReg R: ZR).
> -       self machineCodeAt: 0 put: (self lwR: destReg base: AT offset: 0).
> -       ^machineCodeSize := 4.
>   !
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizeMoveRAb (in category
> 'generate machine code - concretize') -----
> + concretizeMoveRAb
> +       | srcReg destAddr |
> +       srcReg := self concreteRegister: (operands at: 0).
> +       destAddr := operands at: 1.
> +
> +       (self isAddressRelativeToVarBase: destAddr) ifTrue:
> +               [self machineCodeAt: 0 put: (self swR: srcReg base:
> ConcreteVarBaseReg offset: destAddr - cogit varBaseAddress).
> +                ^machineCodeSize := 4].
> +
> +       self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf:
> destAddr)).
> +       self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self
> low16BitsOf: destAddr)).
> +       self machineCodeAt: 8 put: (self sbR: srcReg base: AT offset: 0).
> +       ^machineCodeSize := 12!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>concretizeMoveXwrRR (in category
> 'generate machine code - concretize') -----
>   concretizeMoveXwrRR
>         | indexReg baseReg destReg |
>         indexReg := self concreteRegister: (operands at: 0).
>         baseReg := self concreteRegister: (operands at: 1).
>         destReg := self concreteRegister: (operands at: 2).
>         self machineCodeAt: 0 put: (self sllR: AT R: indexReg C: 2).
> "index is in words"
>         self machineCodeAt: 4 put: (self adduR: AT R: baseReg R: AT).
> +       self machineCodeAt: 8 put: (self lwR: destReg base: AT offset: 0).
> -       self machineCodeAt: 8 put: (self lwR: destReg base: baseReg
> offset: 0).
>         ^machineCodeSize := 12!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizePrefetchAw (in category
> 'generate machine code - concretize') -----
> + concretizePrefetchAw
> +       | 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>>concretizePushCq (in category 'generate
> machine code - concretize') -----
> + concretizePushCq
> +       ^self concretizePushCw!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizePushCw (in category 'generate
> machine code - concretize') -----
> + concretizePushCw
> +       | value |
> +       value := operands at: 0.
> +       self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf:
> value)).
> +       self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self
> low16BitsOf: value)).
> +       self machineCodeAt: 8 put: (self addiuR: SP R: SP C: -4).
> +       self machineCodeAt: 12 put: (self swR: AT base: SP offset: 0).
> +       ^machineCodeSize := 16!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>concretizeSubCheckOverflowCqR (in
> category 'generate machine code - concretize') -----
> + concretizeSubCheckOverflowCqR
> +       | value reg |
> +       value := operands at: 0.
> +       reg := self concreteRegister: (operands at: 1).
> +       self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf:
> value)).
> +       self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self
> low16BitsOf: value)).
> +
> +       "Save original LHS"
> +       self machineCodeAt: 8 put: (self adduR: OverflowTemp1 R: reg R:
> ZR).
> +
> +       "The actual subtraction"
> +       self machineCodeAt: 12 put: (self subuR: reg R: reg R: AT).
> +
> +       "Set sign bit of OverflowTemp2 if sign of result differs from sign
> of RHS."
> +       self machineCodeAt: 16 put: (self xorR: OverflowTemp2 R: reg R:
> AT).
> +       "Set sign bit of OverflowTemp1 if sign of result differs from sign
> of LHS."
> +       self machineCodeAt: 20 put: (self xorR: OverflowTemp1 R: reg R:
> OverflowTemp1).
> +       "Set sign bit of Overflow if sign of result differs from both LHS
> and RHS, which indicates overflow."
> +       self machineCodeAt: 24 put: (self andR: Overflow R: OverflowTemp1
> R: OverflowTemp2).
> +       ^machineCodeSize := 28!
>
> 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: {
>                 "Noops & Pseudo Ops"
>                 [Label]                                 -> [^self
> concretizeLabel].
>                 [AlignmentNops]         -> [^self concretizeAlignmentNops].
>                 [Fill16]                                        -> [^self
> concretizeFill16].
>                 [Fill32]                                        -> [^self
> concretizeFill32].
>                 [FillFromWord]                  -> [^self
> concretizeFillFromWord].
>                 [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
> concretizeUnimplemented].
> +               [JumpNoOverflow]                        -> [^self
> concretizeJumpNoOverflow].
> -               [JumpNoOverflow]                        -> [^self
> concretizeUnimplemented].
>                 [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
> 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
> concretizeUnimplemented].
>                 [AddRdRd]                                       -> [^self
> concretizeUnimplemented].
>                 [CmpRdRd]                                       -> [^self
> concretizeUnimplemented].
>                 [DivRdRd]                                       -> [^self
> concretizeUnimplemented].
>                 [MulRdRd]                                       -> [^self
> concretizeUnimplemented].
>                 [SubRdRd]                                       -> [^self
> concretizeUnimplemented].
>                 [SqrtRd]                                        -> [^self
> concretizeUnimplemented].
>                 [NegateR]                                               ->
> [^self concretizeNegateR].
> +               [LoadEffectiveAddressMwrR]      -> [^self
> concretizeLoadEffectiveAddressMwrR].
> -               [LoadEffectiveAddressMwrR]      -> [^self
> concretizeUnimplemented].
>                 [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].
>                 [MoveM16rR]             -> [^self concretizeMoveM16rR].
>                 [MoveM64rRd]            -> [^self concretizeUnimplemented].
>                 [MoveMwrR]              -> [^self concretizeMoveMwrR].
>                 [MoveXbrRR]             -> [^self concretizeUnimplemented].
>                 [MoveRXbrR]             -> [^self concretizeUnimplemented].
>                 [MoveXwrRR]             -> [^self concretizeMoveXwrRR].
>                 [MoveRXwrR]             -> [^self concretizeMoveRXwrR].
>                 [MoveRMwr]              -> [^self concretizeMoveRMwr].
>                 [MoveRdM64r]            -> [^self concretizeUnimplemented].
>                 [PopR]                          -> [^self concretizePopR].
>                 [PushR]                         -> [^self concretizePushR].
> +               [PushCq]                        -> [^self
> concretizePushCq].
> +               [PushCw]                        -> [^self
> concretizePushCw].
> +               [PrefetchAw]            -> [^self concretizePrefetchAw].
> +               [SubCheckOverflowCqR] -> [^self
> concretizeSubCheckOverflowCqR].
> -               [PushCq]                        -> [^self
> concretizeUnimplemented].
> -               [PushCw]                        -> [^self
> concretizeUnimplemented].
> -               [PrefetchAw]            -> [^self concretizeUnimplemented].
>                 "Conversion"
>                 [ConvertRRd]            -> [^self
> concretizeUnimplemented]}!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>hasConditionRegister (in category
> 'testing') -----
> + hasConditionRegister
> +       "Answer if the receiver supports, e.g., JumpOverflow after a
> regular AddRR"
> +       <inline: true>
> +       ^false!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>hasThreeAddressArithmetic (in category
> 'testing') -----
>   hasThreeAddressArithmetic
> +       "Answer if the receiver supports three-address arithmetic
> instructions"
> +       <inline: true>
>         ^true!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>inlineCacheTagAt: (in category 'inline
> cacheing') -----
> + inlineCacheTagAt: callSiteReturnAddress
> +       "Answer the inline cache tag for the return address of a send."
> +
> +       "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>
> +       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.
> +
> +       ^self literalAtAddress: callSiteReturnAddress - 20!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>jumpShortByteSize (in category
> 'accessing') -----
> + jumpShortByteSize
> +       ^8!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>literalAtAddress:put: (in category
> 'inline cacheing') -----
>   literalAtAddress: mcpc put: newLiteral
> +       | oldUpper newUpper oldLower newLower |
> +       self assert: (self opcodeAtAddress: mcpc - 4) = LUI.
> -       | instruction |
>         self assert: (self opcodeAtAddress: mcpc) = ORI.
> +
> +       oldUpper := objectMemory longAt: mcpc - 4.
> +       newUpper := (oldUpper bitAnd: 16rFFFF0000) bitOr: (self
> high16BitsOf: newLiteral).
> +       objectMemory longAt: mcpc - 4 put: newUpper.
> +
> +       oldLower := objectMemory longAt: mcpc.
> +       newLower := (oldLower bitAnd: 16rFFFF0000) bitOr: (self
> low16BitsOf: newLiteral).
> +       objectMemory longAt: mcpc put: newLower.
> +
>         self assert: (self opcodeAtAddress: mcpc - 4) = LUI.
> +       self assert: (self opcodeAtAddress: mcpc) = ORI.
>
> +       self assert: (self literalAtAddress: mcpc) = newLiteral.
> -       instruction := (objectMemory longAt: mcpc) bitAnd: 16rFFFF000.
> -       instruction := instruction bitOr: (self low16BitsOf: newLiteral).
> -       objectMemory longAt: mcpc put: instruction.
> -
> -       instruction := (objectMemory longAt: mcpc - 4) bitAnd: 16rFFFF000.
> -       instruction := instruction bitOr: (self high16BitsOf: newLiteral).
> -       objectMemory longAt: mcpc put: instruction.
>
>         ^newLiteral!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>loadPICLiteralByteSize (in category
> 'accessing') -----
> + loadPICLiteralByteSize
> +       "Answer the byte size of a MoveCwR opcode's corresponding machine
> code
> +        when the argument is a PIC.  This is for the self-reference at
> the end of a
> +        closed PIC."
> +       <inline: true>
> +       ^self loadLiteralByteSize!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>prefR:offset:hint: (in category
> 'encoding - memory') -----
> + prefR: baseReg offset: offset hint: hint
> +       self flag: #todo. "Should we generate a nop instead? gcc gives an
> error trying to assemble this for mips1 (1985), mips2 (1990) and mips3
> (1992), but succeeds with mips4 (1994) and mips32 (1999)."
> +       self assert: (hint == HintLoad or: [hint == HintStore]).
> +       ^self itype: PREF rs: baseReg rt: hint signedImmediate: offset!
>
> Item was added:
> + ----- Method:
> CogMIPSELCompiler>>relocateMethodReferenceBeforeAddress:by: (in category
> 'inline cacheing') -----
> + relocateMethodReferenceBeforeAddress: pc by: delta
> +       | oldValue newValue |
> +       cogit disassembleFrom: pc - 8 to: pc.
> +
> +       oldValue := self literalAtAddress: pc - 4.
> +       newValue := oldValue + delta.
> +       self literalAtAddress: pc - 4 put: newValue.
> +
> +       cogit disassembleFrom: pc - 8 to: pc.
> +       self assert: (self literalAtAddress: pc - 4) = newValue.
> +       !
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>rewriteCPICCaseAt:tag:objRef:target:
> (in category 'inline cacheing') -----
> + rewriteCPICCaseAt: followingAddress tag: newTag objRef: newObjRef
> target: newTarget
> +       "rewrite the three values involved in a CPIC case. Used by the
> create & extend cpcic methods"
> +
> +       "lui at, tagHigh
> +        ori at, at, tagLow
> +        subu t0, s5, at (Cmp)
> +        slt ... (Cmp)
> +        slt ... (Cmp)
> +        sltu ... (Cmp)
> +        sltu ... (Cmp)
> +        lui s4, objRefHigh
> +        ori s4, s4, objRefLow
> +        bne t0, zr, +12
> +        nop (delay slot)
> +        j target
> +        nop (delay slot)
> +        .... <-- followingAddress"
> +
> +       cogit disassembleFrom: followingAddress - 52 to: followingAddress.
> +       self assert: (self opcodeAtAddress: followingAddress - 52) = LUI.
> +       self assert: (self opcodeAtAddress: followingAddress - 48) = ORI.
> +       self assert: (self functionAtAddress: followingAddress - 44) =
> SUBU.
> +       self assert: (self functionAtAddress: followingAddress - 40) = SLT.
> +       self assert: (self functionAtAddress: followingAddress - 36) = SLT.
> +       self assert: (self functionAtAddress: followingAddress - 32) =
> SLTU.
> +       self assert: (self functionAtAddress: followingAddress - 28) =
> SLTU.
> +       self assert: (self opcodeAtAddress: followingAddress - 24) = LUI.
> +       self assert: (self opcodeAtAddress: followingAddress - 20) = ORI.
> +       self assert: (self opcodeAtAddress: followingAddress - 16) = BNE.
> +       self assert: (objectMemory longAt: followingAddress - 12) = self
> nop.
> +       self assert: (self opcodeAtAddress: followingAddress - 8) = J.
> +       self assert: (objectMemory longAt: followingAddress - 4) = self
> nop.
> +
> +       self literalAtAddress: followingAddress - 48 put: newTag.
> +       self literalAtAddress: followingAddress - 20 put: newObjRef.
> +       self rewriteJTypeAtAddress: followingAddress - 8 target: newTarget.
> +
> +       cogit disassembleFrom: followingAddress - 52 to: followingAddress.
> +       self assert: (self opcodeAtAddress: followingAddress - 52) = LUI.
> +       self assert: (self opcodeAtAddress: followingAddress - 48) = ORI.
> +       self assert: (self functionAtAddress: followingAddress - 44) =
> SUBU.
> +       self assert: (self functionAtAddress: followingAddress - 40) = SLT.
> +       self assert: (self functionAtAddress: followingAddress - 36) = SLT.
> +       self assert: (self functionAtAddress: followingAddress - 32) =
> SLTU.
> +       self assert: (self functionAtAddress: followingAddress - 28) =
> SLTU.
> +       self assert: (self opcodeAtAddress: followingAddress - 24) = LUI.
> +       self assert: (self opcodeAtAddress: followingAddress - 20) = ORI.
> +       self assert: (self opcodeAtAddress: followingAddress - 16) = BNE.
> +       self assert: (objectMemory longAt: followingAddress - 12) = self
> nop.
> +       self assert: (self opcodeAtAddress: followingAddress - 8) = J.
> +       self assert: (objectMemory longAt: followingAddress - 4) = self
> nop.
> +
> +       ^56!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>rewriteCPICJumpAt:target: (in category
> 'inline cacheing') -----
> + rewriteCPICJumpAt: callSiteReturnAddress target: callTargetAddress
> +       "Rewrite a jump instruction to call a different target.  This
> variant is used to reset the
> +       jumps in the prototype CPIC to suit each use,.
> +       Answer the extent of the code change which is used to compute the
> range of the icache to flush."
> +       <var: #callSiteReturnAddress type: #usqInt>
> +       <var: #callTargetAddress type: #usqInt>
> +
> +       cogit disassembleFrom: callSiteReturnAddress - 16 to:
> callSiteReturnAddress + 16.
> +       self halt.!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>rewriteCallAt:target: (in category
> 'inline cacheing') -----
> + rewriteCallAt: callSiteReturnAddress target: callTargetAddress
> +       "Rewrite a call instruction to call a different target.  This
> variant is used to link PICs
> +        in ceSendMiss et al,.
> +       Answer the extent of the code change which is used to compute the
> range of the icache to flush."
> +       <var: #callSiteReturnAddress type: #usqInt>
> +       <var: #callTargetAddress type: #usqInt>
> +
> +       "lui t9, stub/targetHigh
> +        ori t9, t9, stub/targetLow
> +        jalr t9
> +        nop (delay slot)
> +        ...  <-- callSiteReturnAddress"
> +
> +       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 - 16 to:
> callSiteReturnAddress.
> +
> +       self literalAtAddress: callSiteReturnAddress - 12 put:
> callTargetAddress.
> +
> +       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 - 16 to:
> callSiteReturnAddress.
> +
> +       ^20!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>rewriteInlineCacheAt:tag:target: (in
> category 'inline cacheing') -----
> + rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target:
> callTargetAddress
> +       "Rewrite an inline cache to call a different target for a new
> tag.  This variant is used
> +        to link unlinked sends in ceSend:to:numArgs: et al.  Answer the
> extent of the code
> +        change which is used to compute the range of the icache to flush."
> +
> +       "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 literalAtAddress: callSiteReturnAddress - 12 put:
> callTargetAddress.
> +
> +       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.
> +
> +       ^28!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>rewriteJTypeAtAddress:target: (in
> category 'inline cacheing') -----
> + rewriteJTypeAtAddress: mcpc target: newTarget
> +       | regionMask |
> +       regionMask := 16rF0000000.
> +       "mcpc + 4: relative to delay slot not j"
> +       self assert: (mcpc + 4 bitAnd: regionMask) = (newTarget bitAnd:
> regionMask).
> +       objectMemory longAt: mcpc put: (self jA: newTarget).!
>
> Item was added:
> + ----- Method: CogMIPSELCompiler>>rewriteJumpLongAt:target: (in category
> 'inline cacheing') -----
> + rewriteJumpLongAt: callSiteReturnAddress target: callTargetAddress
> +       "Rewrite a jump instruction to call a different target.  This
> variant is used to reset the
> +       jumps in the prototype CPIC to suit each use,.
> +       Answer the extent of the code change which is used to compute the
> range of the icache to flush."
> +       <var: #callSiteReturnAddress type: #usqInt>
> +       <var: #callTargetAddress type: #usqInt>
> +
> +       "lui t9, stub/targetHigh
> +        ori t9, t9, stub/targetLow
> +        jr t9
> +        nop (delay slot)
> +        ...  <-- callSiteReturnAddress"
> +
> +       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) =
> JR.
> +       self assert: (objectMemory longAt: callSiteReturnAddress - 4) =
> self nop.
> +
> +       cogit disassembleFrom: callSiteReturnAddress - 16 to:
> callSiteReturnAddress.
> +
> +       self literalAtAddress: callSiteReturnAddress - 12 put:
> callTargetAddress.
> +
> +       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) =
> JR.
> +       self assert: (objectMemory longAt: callSiteReturnAddress - 4) =
> self nop.
> +
> +       cogit disassembleFrom: callSiteReturnAddress - 16 to:
> callSiteReturnAddress.
> +
> +       ^20!
>
> Item was changed:
>   ----- Method: CogMIPSELCompiler>>rtype:rs:rt:rd:sa:funct: (in category
> 'encoding') -----
>   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: (sa between: 0 and: 15).
>         self assert: (funct between: 0 and: 63).
>         ^(((((opcode << 26) bitOr: (rs << 21)) bitOr: (rt << 16)) bitOr:
> (rd << 11)) bitOr: (sa << 6)) bitOr: funct!
>
> Item was changed:
>   SharedPool subclass: #CogRTLOpcodes
>         instanceVariableNames: ''
> +       classVariableNames: 'AddCheckOverflowCqR AddCheckOverflowRR AddCqR
> AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg
> Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull
> ClassReg CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1
> DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16
> Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump Jump
> JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual
> JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual
> JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater
> JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero
> JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative
> JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg
> Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR
> LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR
> LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR
> MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r
> MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRX16rR MoveRX32rR MoveRXbrR
> MoveRXowr MoveRXwrR MoveRdM64r MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR
> MoveXowrR MoveXwrRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR
> PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg
> Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg
> Scratch6Reg Scratch7Reg SendNumArgsReg SqrtRd Stop SubCheckOverflowCqR
> SubCheckOverflowRR SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg
> XorCqR XorCwR XorRR'
> -       classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops
> AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR
> ArithmeticShiftRightRR Call CallFull ClassReg CmpC32R CmpCqR CmpCwR CmpRR
> CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5
> DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom
> FillFromWord FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual
> JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater
> JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual
> JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual
> JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative
> JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR
> JumpZero Label LastJump LastRTLCode LinkReg Literal
> LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR
> LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR
> MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR
> MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR
> MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdRd
> MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd NegateR Nop
> OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg
> ReceiverResultReg RetN SPReg Scratch0Reg Scratch1Reg Scratch2Reg
> Scratch3Reg Scratch4Reg Scratch5Reg Scratch6Reg Scratch7Reg SendNumArgsReg
> SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR
> XorCwR XorRR'
>         poolDictionaries: ''
>         category: 'VMMaker-JIT'!
>
>   !CogRTLOpcodes commentStamp: '<historical>' prior: 0!
>   I am a pool for the Register-Transfer-Language to which Cog compiles.  I
> define unique integer values for all RTL opcodes and abstract registers.
> See CogAbstractInstruction for instances of instructions with the opcodes
> that I define.!
>
> Item was changed:
>   ----- Method: CogRTLOpcodes class>>initialize (in category 'class
> initialization') -----
>   initialize
>         "Abstract opcodes are a compound of a one word operation specifier
> and zero or more operand type specifiers.
>          e.g. MoveRR is the Move opcode with two register operand
> specifiers and defines a move register to
>          register instruction from operand 0 to operand 1.  The word and
> register size is assumed to be either 32-bits on
>          a 32-bit architecture or 64-bits on a 64-bit architecture.  The
> abstract machine is mostly a 2 address machine
>          with the odd three address instruction added to better exploit
> RISCs.
>                         (self initialize)
>         The operand specifiers are
>                 R               - general purpose register
>                 Rd              - double-precision floating-point register
>                 Cq              - a `quick' constant that can be encoded
> in the minimum space possible.
>                 Cw              - a constant with word size where word is
> the default operand size for the Smalltalk VM, 32-bits
>                                   for a 32-bit VM, 64-bits for a 64-bit
> VM.  The generated constant must occupy the default number
>                                   of bits.  This allows e.g. a garbage
> collector to update the value without invalidating the code.
>                 C32     - a constant with 32 bit size.  The generated
> constant must occupy 32 bits.
>                 C64     - a constant with 64 bit size.  The generated
> constant must occupy 64 bits.
>                 Aw              - memory word at an absolute address
>                 Ab              - memory byte at an absolute address
>                 Mwr     - memory word whose address is at a constant
> offset from an address in a register
>                 Mbr             - memory byte whose address is at a
> constant offset from an address in a register (zero-extended on read)
>                 M16r    - memory 16-bit halfword whose address is at a
> constant offset from an address in a register
>                 M32r    - memory 32-bit halfword whose address is at a
> constant offset from an address in a register
>                 M64r    - memory 64-bit doubleword whose address is at a
> constant offset from an address in a register
>                 XbrR    - memory word whose address is r * byte size away
> from an address in a register
>                 X16rR   - memory word whose address is r * (2 bytes size)
> away from an address in a register
>                 X32rR   - memory word whose address is r * (4 bytes size)
> away from an address in a register
>                 XwrR    - memory word whose address is r * word size away
> from an address in a register
>                 XowrR   - memory word whose address is (r * word size) + o
> away from an address in a register (scaled indexed)
>
>         An alternative would be to decouple opcodes from operands, e.g.
>                 Move := 1. Add := 2. Sub := 3...
>                 RegisterOperand := 1. ConstantQuickOperand := 2.
> ConstantWordOperand := 3...
>         But not all combinations make sense and even fewer are used so we
> stick with the simple compound approach.
>
>         The assumption is that comparison and arithmetic instructions set
> condition codes and that move instructions
>         leave the condition codes unaffected.  In particular
> LoadEffectiveAddressMwrR does not set condition codes
>         although it can be used to do arithmetic.
>
>         Not all of the definitions in opcodeDefinitions below are
> implemented.  In particular we do not implement the
>         XowrR scaled index addressing mode since it requires 4 operands.
>
>         Note that there are no generic division instructions defined, but
> a processor may define some.
>
>         Branch/Call ranges.  Jump[Cond] can be generated as short as
> possible.  Call/Jump[Cond]Long must be generated
>         in the same number of bytes irrespective of displacement since
> their targets may be updated, but they need only
>         span 16Mb, the maximum size of the code zone.  This allows e.g.
> ARM to use single-word call and jump instructions
>         for most calls and jumps.  CallFull/JumpFull must also be
> generated in the same number of bytes irrespective of
>         displacement for the same reason, but they must be able to span
> the full (32-bit or 64-bit) address space because
>         they are used to call code in the C runtime, which may be distant
> from the code zone.  CallFull/JumpFull are allowed
>         to use the cResultRegister as a scratch if required (e.g. on x64
> where there is no direct 64-bit call or jump).
>
>         Byte reads.  If the concrete compiler class answers true to
> byteReadsZeroExtend then byte reads must zero-extend
>         the byte read into the destination register.  If not, the other
> bits of the register should be left undisturbed and the
>         Cogit will add an instruction to zero the register as required.
> Under no circumstances should byte reads sign-extend.
>
>         16-bit (and on 64-bits, 32-bit) reads.  These /are/ expected to
> always zero-extend."
>
>         | opcodeNames refs |
>         "A small fixed set of abstract registers are defined and used in
> code generation
>          for Smalltalk code, and executes on stack pages in the stack zone.
>          These are mapped to processor-specific registers by
> concreteRegister:"
>         FPReg := -1.    "A frame pointer is used for Smalltalk frames."
>         SPReg := -2.
>         ReceiverResultReg := -3.                "The receiver at point of
> send, and return value of a send"
>         TempReg := -4.
>         ClassReg := -5.                                 "The inline send
> cache class tag is in this register, loaded at the send site"
>         SendNumArgsReg := -6.           "Sends > 2 args set the arg count
> in this reg"
>         Arg0Reg := -7.                                  "In the
> StackToRegisterMappingCogit 1 & 2 arg sends marshall into these registers."
>         Arg1Reg := -8.
>
>         "A small fixed set of abstract scratch registers for register-rich
> machines (ARM can use 1, x64 can use 6)."
>         Scratch0Reg := -9.
>         Scratch1Reg := -10.
>         Scratch2Reg := -11.
>         Scratch3Reg := -12.
>         Scratch4Reg := -13.
>         Scratch5Reg := -14.
>         Scratch6Reg := -15.
>         Scratch7Reg := -16.
>
>         "RISC-specific registers"
>         LinkReg := -17.
>         RISCTempReg := -18.     "Used to synthesize CISC instructions from
> multiple RISC instructions."
>         PCReg := -19.
>         VarBaseReg := -20.              "If useful, points to base of
> interpreter variables."
>
>         "Floating-point registers"
>         DPFPReg0 := -21.
>         DPFPReg1 := -22.
>         DPFPReg2 := -23.
>         DPFPReg3 := -24.
>         DPFPReg4 := -25.
>         DPFPReg5 := -26.
>         DPFPReg6 := -27.
>         DPFPReg7 := -28.
>
>         opcodeNames := #("Noops & Pseudo Ops"
>                                                 Label
>                                                 Literal                 "a
> word-sized literal"
>                                                 AlignmentNops
>                                                 FillBytesFrom   "output
> operand 0's worth of bytes from the address in operand 1"
>                                                 Fill8
>      "output a byte's worth of bytes with operand 0"
>                                                 Fill16
> "output two byte's worth of bytes with operand 0"
>                                                 Fill32
> "output four byte's worth of bytes with operand 0"
>                                                 FillFromWord    "output
> BytesPerWord's worth of bytes with operand 0 + operand 1"
>                                                 Nop
>
>                                                 "Control"
>                                                 Call
>               "call within the code zone"
>                                                 CallFull
>               "call anywhere within the full address space"
>                                                 RetN
>                                                 JumpR
>      "Not a regular jump, i.e. not pc dependent."
>                                                 Stop
>       "Halt the processor"
>
>                                                 "N.B.  Jumps are
> contiguous.  Long and Full jumps are contigiuous within them.  See
> FirstJump et al below"
>                                                 JumpFull
>       "Jump anywhere within the address space"
>                                                 JumpLong
>       "Jump anywhere within the 16mb code zone."
>                                                 JumpLongZero
>       "a.k.a. JumpLongEqual"
>                                                 JumpLongNonZero
>  "a.k.a. JumpLongNotEqual"
>                                                 Jump
>       "short jumps; can be encoded in as few bytes as possible; will not be
> disturbed by GC or relocation."
>                                                 JumpZero
>               "a.k.a. JumpEqual"
>                                                 JumpNonZero
>      "a.k.a. JumpNotEqual"
>                                                 JumpNegative
>                                                 JumpNonNegative
>                                                 JumpOverflow
>                                                 JumpNoOverflow
>                                                 JumpCarry
>                                                 JumpNoCarry
>                                                 JumpLess
>       "signed"
>                                                 JumpGreaterOrEqual
>                                                 JumpGreater
>                                                 JumpLessOrEqual
>                                                 JumpBelow
>      "unsigned"
>                                                 JumpAboveOrEqual
>                                                 JumpAbove
>                                                 JumpBelowOrEqual
>
>                                                 JumpFPEqual
>                                                 JumpFPNotEqual
>                                                 JumpFPLess
>                                                 JumpFPLessOrEqual
>                                                 JumpFPGreater
>                                                 JumpFPGreaterOrEqual
>                                                 JumpFPOrdered
>                                                 JumpFPUnordered
>
>                                                 "Data Movement;
> destination is always last operand"
>                                                 MoveRR
>                                                 MoveAwR
>                                                 MoveRAw
>                                                 MoveAbR
>                                                 MoveRAb
>                                                 MoveMwrR MoveRMwr
> MoveXwrRR MoveRXwrR MoveXowrR MoveRXowr
>                                                 MoveM16rR MoveRM16r
> MoveX16rRR MoveRX16rR
>                                                 MoveM32rR MoveRM32r
> MoveX32rRR MoveRX32rR
>                                                 MoveMbrR MoveRMbr
> MoveXbrRR MoveRXbrR
>                                                 MoveCqR MoveCwR MoveC32R
> MoveC64R
>                                                 MoveRdRd MoveM64rRd
> MoveRdM64r
>                                                 PopR PushR PushCq PushCw
>                                                 PrefetchAw
>
>                                                 "Arithmetic; destination
> is always last operand except Cmp; CmpXR is SubRX with no update of result"
>                                                 LoadEffectiveAddressMwrR
> LoadEffectiveAddressXowrR "Variants of add/multiply"
>                                                 NegateR "2's complement
> negation"
>                                                 ArithmeticShiftRightCqR
> ArithmeticShiftRightRR
>                                                 LogicalShiftRightCqR
> LogicalShiftRightRR
>                                                 LogicalShiftLeftCqR
> LogicalShiftLeftRR
>
>                                                 CmpRR AddRR SubRR AndRR
> OrRR XorRR
>                                                 CmpCqR AddCqR SubCqR
> AndCqR OrCqR TstCqR XorCqR
>                                                 CmpCwR CmpC32R AddCwR
> SubCwR AndCwR OrCwR XorCwR
>
> +                                               AddCheckOverflowCqR
> AddCheckOverflowRR SubCheckOverflowCqR SubCheckOverflowRR MulCheckOverflowRR
> +
>                                                 AndCqRR
>
>                                                 CmpRdRd AddRdRd SubRdRd
> MulRdRd DivRdRd SqrtRd
>
>                                                 "Conversion"
>                                                 ConvertRRd
>
>                                                 LastRTLCode).
>
>         "Magic auto declaration. Add to the classPool any new variables
> and nuke any obsolete ones, and assign values"
>         "Find the variables directly referenced by this method"
>         refs := (thisContext method literals select: [:l| l
> isVariableBinding and: [classPool includesKey: l key]]) collect:
>                                 [:ea| ea key].
>         "Move to Undeclared any opcodes in classPool not in opcodes or
> this method."
>         (classPool keys reject: [:k| (opcodeNames includes: k) or: [refs
> includes: k]]) do:
>                 [:k|
>                 Undeclared declare: k from: classPool].
>         "Declare as class variables and number elements of opcodeArray
> above"
>         opcodeNames withIndexDo:
>                 [:classVarName :value|
>                 self classPool
>                         declare: classVarName from: Undeclared;
>                         at: classVarName put: value].
>
>         "For CogAbstractInstruction>>isJump etc..."
>         FirstJump := JumpFull.
>         LastJump := JumpFPUnordered.
>         FirstShortJump := Jump.
>
>         "And now initialize the backends; they add their own opcodes and
> hence these must be reinitialized."
>         (Smalltalk classNamed: #CogAbstractInstruction) ifNotNil:
>                 [:cogAbstractInstruction| cogAbstractInstruction
> allSubclasses do: [:sc| sc initialize]]!
>
> Item was added:
> + ----- Method: CogX64Compiler>>hasConditionRegister (in category
> 'testing') -----
> + hasConditionRegister
> +       "Answer if the receiver supports, e.g., JumpOverflow after a
> regular AddRR"
> +       <inline: true>
> +       ^true!
>
> Item was added:
> + ----- Method: Cogit>>AddCheckOverflowCq:R: (in category 'abstract
> instructions') -----
> + AddCheckOverflowCq: quickConstant R: reg
> +       <inline: true>
> +       <returnTypeC: #'AbstractInstruction *'>
> +       backEnd hasConditionRegister ifTrue:
> +               [^self AddCq: quickConstant R: reg].
> +       ^self gen: AddCheckOverflowCqR quickConstant: quickConstant
> operand: reg!
>
> Item was added:
> + ----- Method: Cogit>>AddCheckOverflowR:R: (in category 'abstract
> instructions') -----
> + AddCheckOverflowR: reg1 R: reg2
> +       <inline: true>
> +       <returnTypeC: #'AbstractInstruction *'>
> +       backEnd hasConditionRegister ifTrue:
> +               [^self AddR: reg1 R: reg2].
> +       ^self gen: AddCheckOverflowRR operand: reg1 operand: reg2!
>
> Item was changed:
>   ----- Method: Cogit>>MoveR:R: (in category 'abstract instructions') -----
>   MoveR: reg1 R: reg2
>         <inline: true>
>         <returnTypeC: #'AbstractInstruction *'>
>         ^self gen: MoveRR operand: reg1 operand: reg2!
>
> Item was added:
> + ----- Method: Cogit>>MulCheckOverflowR:R: (in category 'abstract
> instructions') -----
> + MulCheckOverflowR: reg1 R: reg2
> +       "Multiplication is a little weird on some processors.  Defer to
> the backEnd
> +        to allow it to generate any special code it may need to."
> +       <returnTypeC: #'AbstractInstruction *'>
> +       <inline: false>
> +       backEnd hasConditionRegister ifTrue:
> +               [^self MulR: reg1 R: reg2].
> +       backEnd genCheckOverflowMulR: reg1 R: reg2.
> +       ^self abstractInstructionAt: opcodeIndex - 1!
>
> Item was added:
> + ----- Method: Cogit>>SubCheckOverflowCq:R: (in category 'abstract
> instructions') -----
> + SubCheckOverflowCq: quickConstant R: reg
> +       <inline: true>
> +       <returnTypeC: #'AbstractInstruction *'>
> +       backEnd hasConditionRegister ifTrue:
> +               [^self SubCq: quickConstant R: reg].
> +       ^self gen: SubCheckOverflowCqR quickConstant: quickConstant
> operand: reg!
>
> Item was added:
> + ----- Method: Cogit>>SubCheckOverflowR:R: (in category 'abstract
> instructions') -----
> + SubCheckOverflowR: reg1 R: reg2
> +       <inline: true>
> +       <returnTypeC: #'AbstractInstruction *'>
> +       backEnd hasConditionRegister ifTrue:
> +               [^self SubR: reg1 R: reg2].
> +       ^self gen: SubCheckOverflowRR operand: reg1 operand: reg2!
>
> Item was changed:
>   ----- Method:
> Cogit>>configureCPIC:Case0:Case1Method:tag:isMNUCase:numArgs:delta: (in
> category 'in-line cacheing') -----
>   configureCPIC: cPIC Case0: case0CogMethod Case1Method: case1Method tag:
> case1Tag isMNUCase: isMNUCase numArgs: numArgs delta: addrDelta
>         "Configure a copy of the prototype CPIC for a two-case PIC for
>         case0CogMethod and
>         case1Method
>         case1Tag.
>          The tag for case0CogMethod is at the send site and so doesn't
> need to be generated.
>          case1Method may be any of
>                 - a Cog method; jump to its unchecked entry-point
>                 - a CompiledMethod; jump to the ceInterpretFromPIC
> trampoline
>                 - nil; call ceMNUFromPIC
>         addDelta is the address change from the prototype to the new CPCI
> location, needed
>         because the loading of the CPIC lable at the end may use a literal
> instead of a pc relative"
>         <var: #cPIC type: #'CogMethod *'>
>         <var: #case0CogMethod type: #'CogMethod *'>
>         | operand targetEntry caseEndAddress|
>         <var: #targetEntry type: #'void *'>
>         self assert: case1Method notNil.
>
> +       "adjust the call at missOffset, the ceAbortXArgs"
> +       backEnd rewriteCallAt: cPIC asInteger + missOffset target: (self
> picAbortTrampolineFor: numArgs).
> -       "adjust the jump at missOffset, the ceAbortXArgs"
> -       backEnd rewriteJumpLongAt: cPIC asInteger + missOffset target:
> (self picAbortTrampolineFor: numArgs).
>
>         self assert: (objectRepresentation inlineCacheTagIsYoung:
> case1Tag) not.
>         (isMNUCase not
>          and: [coInterpreter methodHasCogMethod: case1Method])
>                 ifTrue:
>                         [operand := 0.
>                          targetEntry := ((coInterpreter cogMethodOf:
> case1Method) asInteger + cmNoCheckEntryOffset) asVoidPointer]
>                 ifFalse: "We do not scavenge PICs, hence we cannot cache
> the MNU method if it is in new space."
>                         [operand := (case1Method isNil or: [objectMemory
> isYoungObject: case1Method])
>                                                         ifTrue: [0]
>                                                         ifFalse:
> [case1Method].
>                          targetEntry := case1Method isNil ifTrue: [cPIC
> asInteger + (self sizeof: CogMethod)] ifFalse: [cPIC asInteger + self
> picInterpretAbortOffset]].
>
>         "set the jump to the case0 method"
>         backEnd rewriteJumpLongAt: cPIC asInteger + firstCPICCaseOffset
> target: case0CogMethod asInteger + cmNoCheckEntryOffset.
>
>         caseEndAddress := self addressOfEndOfCase: 2 inCPIC: cPIC.
>
>         "update the cpic case - deferred to backend because messy"
>         backEnd rewriteCPICCaseAt: caseEndAddress tag: case1Tag objRef:
> operand target: (isMNUCase ifTrue: [cPIC asInteger + (self sizeof:
> CogMethod)] ifFalse: [targetEntry]) asInteger.
>
>         "update the loading of the PCIC label address"
>         backEnd relocateMethodReferenceBeforeAddress: cPIC asInteger +
> cPICEndOfCodeOffset - backEnd jumpLongByteSize by: addrDelta.
>
>         "write the final desperate jump to cePICMissXArgs"
>         backEnd rewriteJumpLongAt: cPIC asInteger + cPICEndOfCodeOffset
> target: (self cPICMissTrampolineFor: numArgs).
>         ^0
>         "self disassembleFrom: cPIC + (self sizeof: CogMethod) to: cPIC +
> closedPICSize - 1."!
>
> Item was changed:
>   ----- Method: SimpleStackBasedCogit>>genPrimitiveAdd (in category
> 'primitive generators') -----
>   genPrimitiveAdd
>         "Stack looks like
>                 receiver (also in ResultReceiverReg)
>                 arg
>                 return address"
>         | jumpNotSI jumpOvfl |
>         <var: #jumpNotSI type: #'AbstractInstruction *'>
>         <var: #jumpOvfl type: #'AbstractInstruction *'>
>         self genLoadArgAtDepth: 0 into: TempReg.
>         self MoveR: TempReg R: ClassReg.
>         jumpNotSI := objectRepresentation
> genJumpNotSmallIntegerInScratchReg: TempReg.
>         objectRepresentation genRemoveSmallIntegerTagsInScratchReg:
> ClassReg.
>         self MoveR: ReceiverResultReg R: TempReg.
> +       self AddCheckOverflowR: ClassReg R: TempReg.
> -       self AddR: ClassReg R: TempReg.
>         jumpOvfl := self JumpOverflow: 0.
>         self MoveR: TempReg R: ReceiverResultReg.
>         self RetN: (self primRetNOffsetFor: 1).
>         jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
>         ^0!
>
> Item was changed:
>   ----- Method: SimpleStackBasedCogit>>genPrimitiveMultiply (in category
> 'primitive generators') -----
>   genPrimitiveMultiply
>         | jumpNotSI jumpOvfl |
>         <var: #jumpNotSI type: #'AbstractInstruction *'>
>         <var: #jumpOvfl type: #'AbstractInstruction *'>
>         self genLoadArgAtDepth: 0 into: TempReg.
>         self MoveR: TempReg R: ClassReg.
>         jumpNotSI := objectRepresentation
> genJumpNotSmallIntegerInScratchReg: TempReg.
>         objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg:
> ClassReg.
>         self MoveR: ReceiverResultReg R: TempReg.
>         objectRepresentation genRemoveSmallIntegerTagsInScratchReg:
> TempReg.
> +       self MulCheckOverflowR: TempReg R: ClassReg.
> -       self MulR: TempReg R: ClassReg.
>         jumpOvfl := self JumpOverflow: 0.
>         objectRepresentation genSetSmallIntegerTagsIn: ClassReg.
>         self MoveR: ClassReg R: ReceiverResultReg.
>         self RetN: (self primRetNOffsetFor: 1).
>         jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
>         ^0!
>
> Item was changed:
>   ----- Method: SimpleStackBasedCogit>>genPrimitiveSubtract (in category
> 'primitive generators') -----
>   genPrimitiveSubtract
>         "Stack looks like
>                 receiver (also in ResultReceiverReg)
>                 arg
>                 return address"
>         | jumpNotSI jumpOvfl |
>         <var: #jumpNotSI type: #'AbstractInstruction *'>
>         <var: #jumpOvfl type: #'AbstractInstruction *'>
>         self genLoadArgAtDepth: 0 into: TempReg.
>         self MoveR: TempReg R: ClassReg.
>         jumpNotSI := objectRepresentation
> genJumpNotSmallIntegerInScratchReg: TempReg.
>         self MoveR: ReceiverResultReg R: TempReg.
> +       self SubCheckOverflowR: ClassReg R: TempReg.
> -       self SubR: ClassReg R: TempReg.
>         jumpOvfl := self JumpOverflow: 0.
>         objectRepresentation genAddSmallIntegerTagsTo: TempReg.
>         self MoveR: TempReg R: ReceiverResultReg.
>         self RetN: (self primRetNOffsetFor: 1).
>         jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
>         ^0!
>
> Item was changed:
>   ----- Method: StackToRegisterMappingCogit>>genPrimitiveAdd (in category
> 'primitive generators') -----
>   genPrimitiveAdd
>         | jumpNotSI jumpOvfl |
>         <var: #jumpNotSI type: #'AbstractInstruction *'>
>         <var: #jumpOvfl type: #'AbstractInstruction *'>
>         self MoveR: Arg0Reg R: ClassReg.
>         jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg
> scratchReg: TempReg.
>         objectRepresentation genRemoveSmallIntegerTagsInScratchReg:
> ClassReg.
> +       self AddCheckOverflowR: ReceiverResultReg R: ClassReg.
> -       self AddR: ReceiverResultReg R: ClassReg.
>         jumpOvfl := self JumpOverflow: 0.
>         self MoveR: ClassReg R: ReceiverResultReg.
>         self RetN: 0.
>         jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
>         ^0!
>
> Item was changed:
>   ----- Method: StackToRegisterMappingCogit>>genPrimitiveMultiply (in
> category 'primitive generators') -----
>   genPrimitiveMultiply
>         | jumpNotSI jumpOvfl |
>         <var: #jumpNotSI type: #'AbstractInstruction *'>
>         <var: #jumpOvfl type: #'AbstractInstruction *'>
>         self MoveR: Arg0Reg R: ClassReg.
>         self MoveR: ReceiverResultReg R: Arg1Reg.
>         jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg
> scratchReg: TempReg..
>         objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg:
> ClassReg.
>         objectRepresentation genRemoveSmallIntegerTagsInScratchReg:
> Arg1Reg.
> +       self MulCheckOverflowR: Arg1Reg R: ClassReg.
> -       self MulR: Arg1Reg R: ClassReg.
>         jumpOvfl := self JumpOverflow: 0.
>         objectRepresentation genSetSmallIntegerTagsIn: ClassReg.
>         self MoveR: ClassReg R: ReceiverResultReg.
>         self RetN: 0.
>         jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
>         ^0!
>
> Item was changed:
>   ----- Method: StackToRegisterMappingCogit>>genPrimitiveSubtract (in
> category 'primitive generators') -----
>   genPrimitiveSubtract
>         | jumpNotSI jumpOvfl |
>         <var: #jumpNotSI type: #'AbstractInstruction *'>
>         <var: #jumpOvfl type: #'AbstractInstruction *'>
>         jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg
> scratchReg: TempReg.
>         self MoveR: ReceiverResultReg R: TempReg.
> +       self SubCheckOverflowR: Arg0Reg R: TempReg.
> -       self SubR: Arg0Reg R: TempReg.
>         jumpOvfl := self JumpOverflow: 0.
>         objectRepresentation genAddSmallIntegerTagsTo: TempReg.
>         self MoveR: TempReg R: ReceiverResultReg.
>         self RetN: 0.
>         jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
>         ^0!
>
> Item was changed:
>   ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorArithmetic
> (in category 'bytecode generators') -----
>   genSpecialSelectorArithmetic
>         | primDescriptor rcvrIsConst argIsConst rcvrIsInt argIsInt rcvrInt
> argInt result
>          jumpNotSmallInts jumpContinue annotateInst instToAnnotate index |
>         <var: #primDescriptor type: #'BytecodeDescriptor *'>
>         <var: #jumpNotSmallInts type: #'AbstractInstruction *'>
>         <var: #jumpContinue type: #'AbstractInstruction *'>
>         <var: #instToAnnotate type: #'AbstractInstruction *'>
>         primDescriptor := self generatorAt: byte0.
>         argIsInt := (argIsConst := self ssTop type = SSConstant)
>                                  and: [objectMemory isIntegerObject:
> (argInt := self ssTop constant)].
>         rcvrIsInt := (rcvrIsConst := (self ssValue: 1) type = SSConstant)
>                                  and: [objectMemory isIntegerObject:
> (rcvrInt := (self ssValue: 1) constant)].
>
>         (argIsInt and: [rcvrIsInt]) ifTrue:
>                 [rcvrInt := objectMemory integerValueOf: rcvrInt.
>                  argInt := objectMemory integerValueOf: argInt.
>                  primDescriptor opcode caseOf: {
>                         [AddRR] -> [result := rcvrInt + argInt].
>                         [SubRR] -> [result := rcvrInt - argInt].
>                         [AndRR] -> [result := rcvrInt bitAnd: argInt].
>                         [OrRR]  -> [result := rcvrInt bitOr: argInt] }.
>                 (objectMemory isIntegerValue: result) ifTrue:
>                         ["Must enter any annotatedConstants into the map"
>                          self annotateBytecodeIfAnnotated: (self ssValue:
> 1).
>                          self annotateBytecodeIfAnnotated: self ssTop.
>                          "Must annotate the bytecode for correct pc
> mapping."
>                         ^self ssPop: 2; ssPushAnnotatedConstant:
> (objectMemory integerObjectOf: result)].
>                 ^self genSpecialSelectorSend].
>
>         "If there's any constant involved other than a SmallInteger don't
> attempt to inline."
>         ((rcvrIsConst and: [rcvrIsInt not])
>          or: [argIsConst and: [argIsInt not]]) ifTrue:
>                 [^self genSpecialSelectorSend].
>
>         "If we know nothing about the types then better not to inline as
> the inline cache and
>          primitive code is not terribly slow so wasting time on
> duplicating tag tests is pointless."
>         (argIsInt or: [rcvrIsInt]) ifFalse:
>                 [^self genSpecialSelectorSend].
>
>         argIsInt
>                 ifTrue:
>                         [self ssFlushTo: simStackPtr - 2.
>                          (self ssValue: 1) popToReg: ReceiverResultReg.
>                          annotateInst := self ssTop annotateUse.
>                          self ssPop: 2.
>                          self MoveR: ReceiverResultReg R: TempReg]
>                 ifFalse:
>                         [self marshallSendArguments: 1.
>                          self MoveR: Arg0Reg R: TempReg.
>                          rcvrIsInt ifFalse:
>                                 [objectRepresentation
> isSmallIntegerTagNonZero
>                                         ifTrue: [self AndR:
> ReceiverResultReg R: TempReg]
>                                         ifFalse: [self OrR:
> ReceiverResultReg R: TempReg]]].
>         jumpNotSmallInts := objectRepresentation
> genJumpNotSmallIntegerInScratchReg: TempReg.
>         primDescriptor opcode caseOf: {
>                 [AddRR] -> [argIsInt
>                                                 ifTrue:
> +                                                       [instToAnnotate :=
> self AddCheckOverflowCq: argInt - ConstZero R: ReceiverResultReg.
> -                                                       [instToAnnotate :=
> self AddCq: argInt - ConstZero R: ReceiverResultReg.
>                                                          jumpContinue :=
> self JumpNoOverflow: 0.
>                                                          "overflow; must
> undo the damage before continuing"
>                                                          self SubCq:
> argInt - ConstZero R: ReceiverResultReg]
>                                                 ifFalse:
>
> [objectRepresentation genRemoveSmallIntegerTagsInScratchReg:
> ReceiverResultReg.
> +                                                        self
> AddCheckOverflowR: Arg0Reg R: ReceiverResultReg.
> -                                                        self AddR:
> Arg0Reg R: ReceiverResultReg.
>                                                         jumpContinue :=
> self JumpNoOverflow: 0.
>                                                         "overflow; must
> undo the damage before continuing"
>                                                          rcvrIsInt
>                                                                 ifTrue:
> [self MoveCq: rcvrInt R: ReceiverResultReg]
>                                                                 ifFalse:
>
> [self SubR: Arg0Reg R: ReceiverResultReg.
>
>  objectRepresentation genSetSmallIntegerTagsIn: ReceiverResultReg]]].
>                 [SubRR] -> [argIsInt
>                                                 ifTrue:
> +                                                       [instToAnnotate :=
> self SubCheckOverflowCq: argInt - ConstZero R: ReceiverResultReg.
> -                                                       [instToAnnotate :=
> self SubCq: argInt - ConstZero R: ReceiverResultReg.
>                                                          jumpContinue :=
> self JumpNoOverflow: 0.
>                                                          "overflow; must
> undo the damage before continuing"
>                                                          self AddCq:
> argInt - ConstZero R: ReceiverResultReg]
>                                                 ifFalse:
>
> [objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg0Reg.
> +                                                        self
> SubCheckOverflowR: Arg0Reg R: ReceiverResultReg.
> -                                                        self SubR:
> Arg0Reg R: ReceiverResultReg.
>                                                          jumpContinue :=
> self JumpNoOverflow: 0.
>                                                          "overflow; must
> undo the damage before continuing"
>                                                          self AddR:
> Arg0Reg R: ReceiverResultReg.
>
>  objectRepresentation genSetSmallIntegerTagsIn: Arg0Reg]].
>                 [AndRR] -> [argIsInt
>                                                 ifTrue: [instToAnnotate :=
> self AndCq: argInt R: ReceiverResultReg]
>                                                 ifFalse: [self AndR:
> Arg0Reg R: ReceiverResultReg].
>                                         jumpContinue := self Jump: 0].
>                 [OrRR]  -> [argIsInt
>                                                 ifTrue: [instToAnnotate :=
> self OrCq: argInt R: ReceiverResultReg]
>                                                 ifFalse: [self OrR:
> Arg0Reg R: ReceiverResultReg].
>                                         jumpContinue := self Jump: 0] }.
>         jumpNotSmallInts jmpTarget: self Label.
>         argIsInt ifTrue:
>                 [annotateInst ifTrue: [self annotateBytecode:
> instToAnnotate].
>                  self MoveCq: argInt R: Arg0Reg].
>         index := byte0 - self firstSpecialSelectorBytecodeOffset.
>         self genMarshalledSend: index negated - 1 numArgs: 1 sendTable:
> ordinarySendTrampolines.
>         jumpContinue jmpTarget: self Label.
>         ^0!
>
>


-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20151118/c69a05aa/attachment-0001.htm


More information about the Vm-dev mailing list