X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachInstrs.hs;h=dc7731c4dd60c42356fde2dced1e5ad178712a31;hb=58852522d1ba4fb647bf2e0a67745a808a7da0c6;hp=96db72dcad78101348996abd8d9642b37d7eeb2a;hpb=22bbcd1dcd94851b8f9409310cf95f3b9332850c;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachInstrs.hs b/compiler/nativeGen/MachInstrs.hs index 96db72d..dc7731c 100644 --- a/compiler/nativeGen/MachInstrs.hs +++ b/compiler/nativeGen/MachInstrs.hs @@ -1,3 +1,10 @@ +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Machine-dependent assembly language @@ -36,6 +43,7 @@ module MachInstrs ( #include "HsVersions.h" +import BlockId import MachRegs import Cmm import MachOp ( MachRep(..) ) @@ -52,8 +60,8 @@ import GHC.Exts -- Our flavours of the Cmm types -- Type synonyms for Cmm populated with native code -type NatCmm = GenCmm CmmStatic Instr -type NatCmmTop = GenCmmTop CmmStatic Instr +type NatCmm = GenCmm CmmStatic [CmmStatic] (ListGraph Instr) +type NatCmmTop = GenCmmTop CmmStatic [CmmStatic] (ListGraph Instr) type NatBasicBlock = GenBasicBlock Instr -- ----------------------------------------------------------------------------- @@ -226,6 +234,9 @@ data Instr | DELTA Int -- specify current stack offset for -- benefit of subsequent passes + | SPILL Reg Int -- ^ spill this reg to a stack slot + | RELOAD Int Reg -- ^ reload this reg from a stack slot + -- ----------------------------------------------------------------------------- -- Alpha instructions @@ -473,9 +484,9 @@ bit or 64 bit precision. | GABS MachRep Reg Reg -- src, dst | GNEG MachRep Reg Reg -- src, dst | GSQRT MachRep Reg Reg -- src, dst - | GSIN MachRep Reg Reg -- src, dst - | GCOS MachRep Reg Reg -- src, dst - | GTAN MachRep Reg Reg -- src, dst + | GSIN MachRep CLabel CLabel Reg Reg -- src, dst + | GCOS MachRep CLabel CLabel Reg Reg -- src, dst + | GTAN MachRep CLabel CLabel Reg Reg -- src, dst | GFREE -- do ffree on all x86 regs; an ugly hack #endif @@ -488,8 +499,8 @@ bit or 64 bit precision. | CVTSS2SD Reg Reg -- F32 to F64 | CVTSD2SS Reg Reg -- F64 to F32 - | CVTSS2SI Operand Reg -- F32 to I32/I64 (with rounding) - | CVTSD2SI Operand Reg -- F64 to I32/I64 (with rounding) + | CVTTSS2SIQ Operand Reg -- F32 to I32/I64 (with truncation) + | CVTTSD2SIQ Operand Reg -- F64 to I32/I64 (with truncation) | CVTSI2SS Operand Reg -- I32/I64 to F32 | CVTSI2SD Operand Reg -- I32/I64 to F64 @@ -546,19 +557,19 @@ data Operand #endif /* i386 or x86_64 */ #if i386_TARGET_ARCH -i386_insert_ffrees :: [Instr] -> [Instr] -i386_insert_ffrees insns - | any is_G_instr insns - = concatMap ffree_before_nonlocal_transfers insns +i386_insert_ffrees :: [GenBasicBlock Instr] -> [GenBasicBlock Instr] +i386_insert_ffrees blocks + | or (map (any is_G_instr) [ instrs | BasicBlock id instrs <- blocks ]) + = map ffree_before_nonlocal_transfers blocks | otherwise - = insns - -ffree_before_nonlocal_transfers insn - = case insn of - CALL _ _ -> [GFREE, insn] - JMP _ -> [GFREE, insn] - other -> [insn] - + = blocks + where + ffree_before_nonlocal_transfers (BasicBlock id insns) + = BasicBlock id (foldr p [] insns) + where p insn r = case insn of + CALL _ _ -> GFREE : insn : r + JMP _ -> GFREE : insn : r + other -> insn : r -- if you ever add a new FP insn to the fake x86 FP insn set, -- you must update this too @@ -573,7 +584,7 @@ is_G_instr instr GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True GCMP _ _ _ -> True; GABS _ _ _ -> True GNEG _ _ _ -> True; GSQRT _ _ _ -> True - GSIN _ _ _ -> True; GCOS _ _ _ -> True; GTAN _ _ _ -> True + GSIN _ _ _ _ _ -> True; GCOS _ _ _ _ _ -> True; GTAN _ _ _ _ _ -> True GFREE -> panic "is_G_instr: GFREE (!)" other -> False #endif /* i386_TARGET_ARCH */