[project @ 2000-07-06 14:08:31 by simonmar]
[ghc-hetmet.git] / ghc / compiler / absCSyn / Costs.lhs
index 5296a1b..a0a6110 100644 (file)
@@ -1,7 +1,9 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
-%     Hans Wolfgang Loidl
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
+% $Id: Costs.lhs,v 1.24 2000/07/06 14:08:31 simonmar Exp $
+%
+% Only needed in a GranSim setup -- HWL
 % ---------------------------------------------------------------------------
 
 \section[Costs]{Evaluating the costs of computing some abstract C code}
@@ -28,9 +30,11 @@ The meaning of the result tuple is:
    instructions.
 \end{itemize}
 
-This function is needed in GrAnSim for parallelism.
+This function is needed in GranSim for costing pieces of abstract C.
 
-These are first suggestions for scaling the costs. But, this scaling should be done in the RTS rather than the compiler (this really should be tunable!):
+These are first suggestions for scaling the costs. But, this scaling should
+be done in the RTS rather than the compiler (this really should be
+tunable!):
 
 \begin{pseudocode}
 
@@ -63,7 +67,7 @@ import Panic          ( trace )
 
 -- --------------------------------------------------------------------------
 data CostRes = Cost (Int, Int, Int, Int, Int)
-              deriving (Text)
+              deriving (Show)
 
 nullCosts    = Cost (0, 0, 0, 0, 0) :: CostRes
 initHdrCosts = Cost (2, 0, 0, 1, 0) :: CostRes
@@ -82,6 +86,7 @@ instance Num CostRes where
  negate         = mapOp negate
  abs    = mapOp abs
  signum         = mapOp signum
+ fromInteger _ = error "fromInteger not defined"
 
 mapOp :: (Int -> Int) -> CostRes -> CostRes
 mapOp g ( Cost (i, b, l, s, f) )  = Cost (g i, g b, g l, g s, g f)
@@ -117,7 +122,7 @@ costs absC =
 
    CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)
 
-   CAssign (CReg _) (CAddr _)  -> Cost (1,0,0,0,0)  -- typ.: add %reg1,<adr>,%reg2
+   CAssign (CReg _) source_m   -> addrModeCosts source_m Rhs
 
    CAssign target_m source_m   -> addrModeCosts target_m Lhs +
                                   addrModeCosts source_m Rhs
@@ -202,7 +207,10 @@ costs absC =
 
    CSimultaneous absC       -> costs absC
 
-   CCheck _ amodes code             -> Cost (2, 1, 0, 0, 0)
+   CCheck _ amodes code             -> Cost (2, 1, 0, 0, 0) -- ToDo: refine this by 
+                                                     -- looking at the first arg 
+
+   CRetDirect _ _ _ _       -> nullCosts
 
    CMacroStmt  macro modes  -> stmtMacroCosts macro modes
 
@@ -215,19 +223,28 @@ costs absC =
   -- *** the next three [or so...] are DATA (those above are CODE) ***
   -- as they are data rather than code they all have nullCosts        -- HWL
 
+   CCallTypedef _ _ _ _      -> nullCosts
+
    CStaticClosure _ _ _ _    -> nullCosts
 
-   CClosureInfoAndCode _ _ _ _ _ -> nullCosts
+   CSRT _ _                  -> nullCosts
 
-   CRetDirect _ _ _ _       -> nullCosts
+   CBitmap _ _               -> nullCosts
+
+   CClosureInfoAndCode _ _ _ _ -> nullCosts
 
    CRetVector _ _ _ _        -> nullCosts
 
+   CClosureTbl _             -> nullCosts
+
    CCostCentreDecl _ _      -> nullCosts
+
    CCostCentreStackDecl _    -> nullCosts
 
    CSplitMarker                     -> nullCosts
 
+   _ -> trace ("Costs.costs") nullCosts
+
 -- ---------------------------------------------------------------------------
 
 addrModeCosts :: CAddrMode -> Side -> CostRes
@@ -242,16 +259,13 @@ addrModeCosts addr_mode side =
     CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
                       else Cost (0, 0, 1, 0, 0)
 
-    CAddr _  -> if lhs then Cost (0, 0, 0, 1, 0)  -- ??unchecked
-                      else Cost (0, 0, 1, 0, 0)
+    CAddr (CIndex _ n _ ) -> Cost (1, 0, 1, 0, 0) -- does pointer arithmetic
+
+    CAddr _ -> nullCosts
 
-    CReg _   -> nullCosts       {- loading from, storing to reg is free ! -}
+    CReg _  -> nullCosts        {- loading from, storing to reg is free ! -}
                                 {- for costing CReg->Creg ops see special -}
                                 {- case in costs fct -}
-    CTableEntry base_mode offset_mode kind ->
-               addrModeCosts base_mode side +
-               addrModeCosts offset_mode side +
-               Cost (1,0,1,0,0)
 
     CTemp _ _  -> nullCosts    {- if lhs then Cost (0, 0, 0, 1, 0)
                                          else Cost (0, 0, 1, 0, 0)  -}
@@ -272,16 +286,9 @@ addrModeCosts addr_mode side =
     CIntLike mode  -> if lhs then Cost (0, 0, 0, 1, 0)
                             else Cost (0, 0, 1, 0, 0)
 
-    CString _     -> if lhs then Cost (0, 0, 0, 1, 0)
-                            else Cost (0, 0, 1, 0, 0)
-
     CLit    _     -> if lhs then nullCosts            -- should never occur
                             else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
 
-    CLitLit _  _   -> if lhs then nullCosts
-                            else Cost (1, 0, 0, 0, 0)
-                     -- same es CLit
-
     CJoinPoint _         -> if lhs then Cost (0, 0, 0, 1, 0)
                                    else Cost (0, 0, 1, 0, 0)
 
@@ -298,10 +305,10 @@ exprMacroCosts side macro mode_list =
   in
   arg_costs +
   case macro of
-    ENTRY_CODE -> nullCosts
-    ARG_TAG -> nullCosts -- XXX
-    GET_TAG -> nullCosts -- XXX
-    
+    ENTRY_CODE -> nullCosts -- nothing 
+    ARG_TAG -> nullCosts -- nothing
+    GET_TAG -> Cost (0, 0, 1, 0, 0)  -- indirect load
+    UPD_FRAME_UPDATEE -> Cost (0, 0, 1, 0, 0)  -- indirect load
 
 -- ---------------------------------------------------------------------------
 
@@ -319,14 +326,16 @@ stmtMacroCosts macro modes =
     UPD_CAF              ->  Cost (7, 0, 1, 3, 0)       {- SMupdate.lh  -}
     UPD_BH_UPDATABLE     ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
     UPD_BH_SINGLE_ENTRY          ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
-    PUSH_UPD_FRAME       ->  Cost (3, 0, 0, 4, 0)       {- SMupdate.lh  -}
+    PUSH_UPD_FRAME       ->  Cost (3, 0, 0, 4, 0)       {- Updates.h    -}
+    PUSH_SEQ_FRAME       ->  Cost (2, 0, 0, 3, 0)       {- StgMacros.h  !-}
+    UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0)     {- StgMacros.h         !-}
     SET_TAG              ->  nullCosts             {- COptRegs.lh -}
     GRAN_FETCH                 ->  nullCosts     {- GrAnSim bookkeeping -}
     GRAN_RESCHEDULE            ->  nullCosts     {- GrAnSim bookkeeping -}
     GRAN_FETCH_AND_RESCHEDULE  ->  nullCosts     {- GrAnSim bookkeeping -}
     GRAN_YIELD                 ->  nullCosts     {- GrAnSim bookkeeping -- added SOF -}
     THREAD_CONTEXT_SWITCH      ->  nullCosts     {- GrAnSim bookkeeping -}
-    _ -> trace ("Costs.stmtMacroCosts: "++show macro) nullCosts
+    _ -> trace ("Costs.stmtMacroCosts") nullCosts
 
 -- ---------------------------------------------------------------------------
 
@@ -374,7 +383,7 @@ primOpCosts :: PrimOp -> CostRes
 
 -- Special cases
 
-primOpCosts (CCallOp _ _ _ _) = SAVE_COSTS + RESTORE_COSTS     
+primOpCosts (CCallOp _) = SAVE_COSTS + RESTORE_COSTS   
                                  -- don't guess costs of ccall proper
                                   -- for exact costing use a GRAN_EXEC
                                   -- in the C code
@@ -385,7 +394,6 @@ primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
-primOpCosts IntAbsOp  = Cost (0, 1, 0, 0, 0) -- abs closure already costed
 
 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
@@ -440,124 +448,3 @@ costsByKind DoubleRep     _ = nullCosts
 -}
 -- ---------------------------------------------------------------------------
 \end{code}
-
-This is the data structure of {\tt PrimOp} copied from prelude/PrimOp.lhs.
-I include here some comments about the estimated costs for these @PrimOps@.
-Compare with the @primOpCosts@ fct above.  -- HWL
-
-\begin{pseudocode}
-data PrimOp
-    -- I assume all these basic comparisons take just one ALU instruction
-    -- Checked that for Char, Int; Word, Addr should be the same as Int.
-
-    = CharGtOp  | CharGeOp   | CharEqOp   | CharNeOp   | CharLtOp   | CharLeOp
-    | IntGtOp   | IntGeOp    | IntEqOp    | IntNeOp    | IntLtOp    | IntLeOp
-    | WordGtOp  | WordGeOp   | WordEqOp   | WordNeOp   | WordLtOp   | WordLeOp
-    | AddrGtOp  | AddrGeOp   | AddrEqOp   | AddrNeOp   | AddrLtOp   | AddrLeOp
-
-    -- Analogously, these take one FP unit instruction
-    -- Haven't checked that, yet.
-
-    | FloatGtOp         | FloatGeOp  | FloatEqOp  | FloatNeOp  | FloatLtOp  | FloatLeOp
-    | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
-
-    -- 1 ALU op; unchecked
-    | OrdOp | ChrOp
-
-    -- these just take 1 ALU op; checked
-    | IntAddOp | IntSubOp
-
-    -- but these take more than that; see special cases in primOpCosts
-    -- I counted the generated ass. instructions for these -> checked
-    | IntMulOp | IntQuotOp
-    | IntRemOp | IntNegOp | IntAbsOp
-
-    -- Rest is unchecked so far -- HWL
-
-    -- Word#-related ops:
-    | AndOp   | OrOp  | NotOp | XorOp | ShiftLOp | ShiftROp
-    | Int2WordOp | Word2IntOp -- casts
-
-    -- Addr#-related ops:
-    | Int2AddrOp | Addr2IntOp -- casts
-
-    -- Float#-related ops:
-    | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
-    | Float2IntOp | Int2FloatOp
-
-    | FloatExpOp   | FloatLogOp          | FloatSqrtOp
-    | FloatSinOp   | FloatCosOp          | FloatTanOp
-    | FloatAsinOp  | FloatAcosOp  | FloatAtanOp
-    | FloatSinhOp  | FloatCoshOp  | FloatTanhOp
-    -- not all machines have these available conveniently:
-    -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
-    | FloatPowerOp -- ** op
-
-    -- Double#-related ops:
-    | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
-    | Double2IntOp | Int2DoubleOp
-    | Double2FloatOp | Float2DoubleOp
-
-    | DoubleExpOp   | DoubleLogOp   | DoubleSqrtOp
-    | DoubleSinOp   | DoubleCosOp   | DoubleTanOp
-    | DoubleAsinOp  | DoubleAcosOp  | DoubleAtanOp
-    | DoubleSinhOp  | DoubleCoshOp  | DoubleTanhOp
-    -- not all machines have these available conveniently:
-    -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
-    | DoublePowerOp -- ** op
-
-    -- Integer (and related...) ops:
-    -- slightly weird -- to match GMP package.
-    | IntegerAddOp | IntegerSubOp | IntegerMulOp
-    | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
-
-    | IntegerCmpOp
-
-    | Integer2IntOp  | Int2IntegerOp
-    | Addr2IntegerOp -- "Addr" is *always* a literal string
-    -- ?? gcd, etc?
-
-    | FloatEncodeOp  | FloatDecodeOp
-    | DoubleEncodeOp | DoubleDecodeOp
-
-    -- primitive ops for primitive arrays
-
-    | NewArrayOp
-    | NewByteArrayOp PrimRep
-
-    | SameMutableArrayOp
-    | SameMutableByteArrayOp
-
-    | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
-
-    | ReadByteArrayOp  PrimRep
-    | WriteByteArrayOp PrimRep
-    | IndexByteArrayOp PrimRep
-    | IndexOffAddrOp   PrimRep
-       -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
-       -- This is just a cheesy encoding of a bunch of ops.
-       -- Note that ForeignObjRep is not included -- the only way of
-       -- creating a ForeignObj is with a ccall or casm.
-
-    | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
-
-    | MakeStablePtrOp | DeRefStablePtrOp
-\end{pseudocode}
-
-A special ``trap-door'' to use in making calls direct to C functions:
-Note: From GrAn point of view, CCall is probably very expensive 
-      The programmer can specify the costs of the Ccall by inserting
-      a GRAN_EXEC(a,b,l,s,f) at the end of the C- code, specifing the
-      number or arithm., branch, load, store and floating point instructions
-      -- HWL
-
-\begin{pseudocode}
-    | CCallOp  String  -- An "unboxed" ccall# to this named function
-               Bool    -- True <=> really a "casm"
-               Bool    -- True <=> might invoke Haskell GC
-               [Type]  -- Unboxed argument; the state-token
-                       -- argument will have been put *first*
-               Type    -- Return type; one of the "StateAnd<blah>#" types
-
-    -- (... to be continued ... )
-\end{pseudocode}