Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- data Instr
- = COMMENT FastString
- | LDATA Section RawCmmStatics
- | NEWBLOCK BlockId
- | DELTA Int
- | LD Format AddrMode Reg
- | ST Format Reg AddrMode
- | ADD Bool Bool Reg RI Reg
- | SUB Bool Bool Reg RI Reg
- | UMUL Bool Reg RI Reg
- | SMUL Bool Reg RI Reg
- | UDIV Bool Reg RI Reg
- | SDIV Bool Reg RI Reg
- | RDY Reg
- | WRY Reg Reg
- | AND Bool Reg RI Reg
- | ANDN Bool Reg RI Reg
- | OR Bool Reg RI Reg
- | ORN Bool Reg RI Reg
- | XOR Bool Reg RI Reg
- | XNOR Bool Reg RI Reg
- | SLL Reg RI Reg
- | SRL Reg RI Reg
- | SRA Reg RI Reg
- | SETHI Imm Reg
- | NOP
- | FABS Format Reg Reg
- | FADD Format Reg Reg Reg
- | FCMP Bool Format Reg Reg
- | FDIV Format Reg Reg Reg
- | FMOV Format Reg Reg
- | FMUL Format Reg Reg Reg
- | FNEG Format Reg Reg
- | FSQRT Format Reg Reg
- | FSUB Format Reg Reg Reg
- | FxTOy Format Format Reg Reg
- | BI Cond Bool BlockId
- | BF Cond Bool BlockId
- | JMP AddrMode
- | JMP_TBL AddrMode [Maybe BlockId] CLabel
- | CALL (Either Imm Reg) Int Bool
- data RI
- riZero :: RI -> Bool
- fpRelEA :: Int -> Reg -> Instr
- moveSp :: Int -> Instr
- isUnconditionalJump :: Instr -> Bool
- maxSpillSlots :: NCGConfig -> Int
- patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
- patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
- mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
- mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
- mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
- mkJumpInstr :: BlockId -> [Instr]
- takeDeltaInstr :: Instr -> Maybe Int
- isMetaInstr :: Instr -> Bool
- isJumpishInstr :: Instr -> Bool
- jumpDestsOfInstr :: Instr -> [BlockId]
- takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
- regUsageOfInstr :: Platform -> Instr -> RegUsage
Documentation
SPARC instruction set. Not complete. This is only the ones we need.
COMMENT FastString | |
LDATA Section RawCmmStatics | |
NEWBLOCK BlockId | |
DELTA Int | |
LD Format AddrMode Reg | |
ST Format Reg AddrMode | |
ADD Bool Bool Reg RI Reg | |
SUB Bool Bool Reg RI Reg | |
UMUL Bool Reg RI Reg | |
SMUL Bool Reg RI Reg | |
UDIV Bool Reg RI Reg | |
SDIV Bool Reg RI Reg | |
RDY Reg | |
WRY Reg Reg | |
AND Bool Reg RI Reg | |
ANDN Bool Reg RI Reg | |
OR Bool Reg RI Reg | |
ORN Bool Reg RI Reg | |
XOR Bool Reg RI Reg | |
XNOR Bool Reg RI Reg | |
SLL Reg RI Reg | |
SRL Reg RI Reg | |
SRA Reg RI Reg | |
SETHI Imm Reg | |
NOP | |
FABS Format Reg Reg | |
FADD Format Reg Reg Reg | |
FCMP Bool Format Reg Reg | |
FDIV Format Reg Reg Reg | |
FMOV Format Reg Reg | |
FMUL Format Reg Reg Reg | |
FNEG Format Reg Reg | |
FSQRT Format Reg Reg | |
FSUB Format Reg Reg Reg | |
FxTOy Format Format Reg Reg | |
BI Cond Bool BlockId | |
BF Cond Bool BlockId | |
JMP AddrMode | |
JMP_TBL AddrMode [Maybe BlockId] CLabel | |
CALL (Either Imm Reg) Int Bool |
Instances
Instruction Instr Source # | instance for sparc instruction set |
Defined in GHC.CmmToAsm.SPARC regUsageOfInstr :: Platform -> Instr -> RegUsage Source # patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr Source # isJumpishInstr :: Instr -> Bool Source # jumpDestsOfInstr :: Instr -> [BlockId] Source # patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr Source # mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr] Source # mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr] Source # takeDeltaInstr :: Instr -> Maybe Int Source # isMetaInstr :: Instr -> Bool Source # mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr Source # takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg) Source # mkJumpInstr :: BlockId -> [Instr] Source # mkStackAllocInstr :: Platform -> Int -> [Instr] Source # mkStackDeallocInstr :: Platform -> Int -> [Instr] Source # | |
OutputableP Platform Instr Source # | |
Check if a RI represents a zero value. - a literal zero - register %g0, which is always zero.
fpRelEA :: Int -> Reg -> Instr Source #
Calculate the effective address which would be used by the corresponding fpRel sequence.
isUnconditionalJump :: Instr -> Bool Source #
An instruction that will cause the one after it never to be exectuted
maxSpillSlots :: NCGConfig -> Int Source #
The maximum number of spill slots available on the C stack. If we use up all of the slots, then we're screwed.
Why do we reserve 64 bytes, instead of using the whole thing?? -- BL 20090215
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr Source #
Apply a given mapping to tall the register references in this instruction.
mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr Source #
Make a reg-reg move instruction. On SPARC v8 there are no instructions to move directly between floating point and integer regs. If we need to do that then we have to go via memory.
Make a spill reload instruction.
Make a spill instruction. On SPARC we spill below frame pointer leaving 2 words/spill
mkJumpInstr :: BlockId -> [Instr] Source #
Make an unconditional branch instruction.
takeDeltaInstr :: Instr -> Maybe Int Source #
See if this instruction is telling us the current C stack delta
isMetaInstr :: Instr -> Bool Source #
isJumpishInstr :: Instr -> Bool Source #
jumpDestsOfInstr :: Instr -> [BlockId] Source #
takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg) Source #
Check whether an instruction represents a reg-reg move. The register allocator attempts to eliminate reg->reg moves whenever it can, by assigning the src and dest temporaries to the same real register.
regUsageOfInstr :: Platform -> Instr -> RegUsage Source #
regUsage returns the sets of src and destination registers used by a particular instruction. Machine registers that are pre-allocated to stgRegs are filtered out, because they are uninteresting from a register allocation standpoint. (We wouldn't want them to end up on the free list!) As far as we are concerned, the fixed registers simply don't exist (for allocation purposes, anyway).