Propagate scalar variables and tycons for vectorisation through 'HscTypes.VectInfo'.

[ghc-hetmet.git] / compiler / codeGen / CgCallConv.hs

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index a9c591b..f3013cd 100644 (file)
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -1,10 +1,3 @@
-{-# 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
-
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2004-2006
@@ -39,19 +32,20 @@ import CgUtils
 import CgMonad
 import SMRep
 
-import Cmm
+import OldCmm
 import CLabel
 
 import Constants
 import ClosureInfo
 import CgStackery
-import CmmUtils
+import OldCmmUtils
 import Maybes
 import Id
 import Name
 import Bitmap
 import Util
 import StaticFlags
+import Module
 import FastString
 import Outputable
 import Unique
@@ -71,7 +65,7 @@ import Data.Bits
 -------------------------------------------------------------------------
 
 -- bring in ARG_P, ARG_N, etc.
-#include "../includes/StgFun.h"
+#include "../includes/rts/storage/FunTypes.h"
 
 -------------------------
 argDescrType :: ArgDescr -> StgHalfWord
@@ -127,7 +121,7 @@ stdPattern [PtrArg,PtrArg,PtrArg]      = Just ARG_PPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]              = Just ARG_PPPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        = Just ARG_PPPPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
-stdPattern other = Nothing
+stdPattern _ = Nothing
 
 
 -------------------------------------------------------------------------
@@ -156,7 +150,7 @@ mkLiveness name size bits
   = let
         small_bits = case bits of 
                        []  -> 0
-                       [b] -> fromIntegral b
+                        [b] -> b
                        _   -> panic "livenessToAddrMode"
     in
     return (smallLiveness size small_bits)
@@ -216,7 +210,7 @@ constructSlowCall
 
    -- don't forget the zero case
 constructSlowCall [] 
-  = (mkRtsApFastLabel (sLit "stg_ap_0"), [], [])
+  = (mkRtsApFastLabel (fsLit "stg_ap_0"), [], [])
 
 constructSlowCall amodes
   = (stg_ap_pat, these, rest)
@@ -231,30 +225,31 @@ slowArgs :: [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)]
 slowArgs [] = []
 slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest
   where        (arg_pat, args, rest) = matchSlowPattern amodes
-       stg_ap_pat = mkRtsRetInfoLabel arg_pat
+       stg_ap_pat      = mkCmmRetInfoLabel rtsPackageId arg_pat
   
 matchSlowPattern :: [(CgRep,CmmExpr)] 
-                -> (LitString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
+                -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
 matchSlowPattern amodes = (arg_pat, these, rest)
   where (arg_pat, n)  = slowCallPattern (map fst amodes)
        (these, rest) = splitAt n amodes
 
 -- These cases were found to cover about 99% of all slow calls:
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppppp", 6)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _)    = (sLit "stg_ap_ppppp", 5)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _)    = (sLit "stg_ap_pppp", 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _)   = (sLit "stg_ap_pppv", 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: _)            = (sLit "stg_ap_ppp", 3)
-slowCallPattern (PtrArg: PtrArg: VoidArg: _)           = (sLit "stg_ap_ppv", 3)
-slowCallPattern (PtrArg: PtrArg: _)                    = (sLit "stg_ap_pp", 2)
-slowCallPattern (PtrArg: VoidArg: _)                   = (sLit "stg_ap_pv", 2)
-slowCallPattern (PtrArg: _)                            = (sLit "stg_ap_p", 1)
-slowCallPattern (VoidArg: _)                           = (sLit "stg_ap_v", 1)
-slowCallPattern (NonPtrArg: _)                         = (sLit "stg_ap_n", 1)
-slowCallPattern (FloatArg: _)                          = (sLit "stg_ap_f", 1)
-slowCallPattern (DoubleArg: _)                         = (sLit "stg_ap_d", 1)
-slowCallPattern (LongArg: _)                           = (sLit "stg_ap_l", 1)
-slowCallPattern _  = panic "CgStackery.slowCallPattern"
+slowCallPattern :: [CgRep] -> (FastString, Int)
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppppp", 6)
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _)        = (fsLit "stg_ap_ppppp", 5)
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _)    = (fsLit "stg_ap_pppp", 4)
+slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _)   = (fsLit "stg_ap_pppv", 4)
+slowCallPattern (PtrArg: PtrArg: PtrArg: _)            = (fsLit "stg_ap_ppp", 3)
+slowCallPattern (PtrArg: PtrArg: VoidArg: _)           = (fsLit "stg_ap_ppv", 3)
+slowCallPattern (PtrArg: PtrArg: _)                    = (fsLit "stg_ap_pp", 2)
+slowCallPattern (PtrArg: VoidArg: _)                   = (fsLit "stg_ap_pv", 2)
+slowCallPattern (PtrArg: _)                            = (fsLit "stg_ap_p", 1)
+slowCallPattern (VoidArg: _)                           = (fsLit "stg_ap_v", 1)
+slowCallPattern (NonPtrArg: _)                         = (fsLit "stg_ap_n", 1)
+slowCallPattern (FloatArg: _)                          = (fsLit "stg_ap_f", 1)
+slowCallPattern (DoubleArg: _)                         = (fsLit "stg_ap_d", 1)
+slowCallPattern (LongArg: _)                           = (fsLit "stg_ap_l", 1)
+slowCallPattern _                                      = panic "CgStackery.slowCallPattern"
 
 -------------------------------------------------------------------------
 --
@@ -289,7 +284,6 @@ getSequelAmode
            OnStack -> do { sp_rel <- getSpRelOffset virt_sp
                          ; returnFC (CmmLoad sp_rel bWord) }
 
-           UpdateCode        -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
            CaseAlts lbl _ _  -> returnFC (CmmLit (CmmLabel lbl))
        }
 
@@ -358,7 +352,7 @@ assign_regs :: [(CgRep,a)]          -- Arg or result values to assign
 assign_regs args supply
   = go args [] supply
   where
-    go [] acc supply = (acc, [])       -- Return the results reversed (doesn't matter)
+    go [] acc _ = (acc, [])    -- Return the results reversed (doesn't matter)
     go ((VoidArg,_) : args) acc supply         -- Skip void arguments; they aren't passed, and
        = go args acc supply            -- there's nothing to bind them to
     go ((rep,arg) : args) acc supply 
@@ -373,7 +367,7 @@ assign_reg LongArg   (vs, fs, ds, l:ls) = Just (LongReg l,    (vs, fs, ds, ls))
 assign_reg PtrArg    (v:vs, fs, ds, ls) = Just (VanillaReg v VGcPtr, (vs, fs, ds, ls))
 assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v VNonGcPtr, (vs, fs, ds, ls))
     -- PtrArg and NonPtrArg both go in a vanilla register
-assign_reg other     not_enough_regs    = Nothing
+assign_reg _         _                  = Nothing
 
 
 -------------------------------------------------------------------------
@@ -388,12 +382,16 @@ assign_reg other     not_enough_regs    = Nothing
 -- We take these register supplies from the *real* registers, i.e. those
 -- that are guaranteed to map to machine registers.
 
+useVanillaRegs :: Int
 useVanillaRegs | opt_Unregisterised = 0
               | otherwise          = mAX_Real_Vanilla_REG
+useFloatRegs :: Int
 useFloatRegs   | opt_Unregisterised = 0
               | otherwise          = mAX_Real_Float_REG
+useDoubleRegs :: Int
 useDoubleRegs  | opt_Unregisterised = 0
               | otherwise          = mAX_Real_Double_REG
+useLongRegs :: Int
 useLongRegs    | opt_Unregisterised = 0
               | otherwise          = mAX_Real_Long_REG
 
@@ -409,7 +407,7 @@ allFloatRegNos       = regList mAX_Float_REG
 allDoubleRegNos         = regList mAX_Double_REG
 allLongRegNos   = regList mAX_Long_REG
 
-regList 0 = []
+regList :: Int -> [Int]
 regList n = [1 .. n]
 
 type AvailRegs = ( [Int]   -- available vanilla regs.
@@ -426,6 +424,8 @@ mkRegTbl_allRegs :: [GlobalReg] -> AvailRegs
 mkRegTbl_allRegs regs_in_use
   = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
 
+mkRegTbl' :: [GlobalReg] -> [Int] -> [Int] -> [Int] -> [Int]
+          -> ([Int], [Int], [Int], [Int])
 mkRegTbl' regs_in_use vanillas floats doubles longs
   = (ok_vanilla, ok_float, ok_double, ok_long)
   where