SPARC NCG: Add Pwr callish mach op
[ghc-hetmet.git] / compiler / nativeGen / MachCodeGen.hs
index c340b9d..5f973ef 100644 (file)
@@ -371,6 +371,26 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])
                        r_dst_lo
 
 
+-- Addition of II64
+iselExpr64 (CmmMachOp (MO_Add width) [e1, e2])
+ = do  ChildCode64 code1 r1_lo <- iselExpr64 e1
+       let r1_hi       = getHiVRegFromLo r1_lo
+
+       ChildCode64 code2 r2_lo <- iselExpr64 e2
+       let r2_hi       = getHiVRegFromLo r2_lo
+       
+       r_dst_lo        <- getNewRegNat II32
+       let r_dst_hi    = getHiVRegFromLo r_dst_lo
+       
+       let code =      code1
+               `appOL` code2
+               `appOL` toOL
+                       [ ADD False False r1_lo (RIReg r2_lo) r_dst_lo
+                       , ADD True  False r1_hi (RIReg r2_hi) r_dst_hi ]
+       
+       return  $ ChildCode64 code r_dst_lo
+
+
 iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do
      r_dst_lo <-  getNewRegNat II32
      let r_dst_hi = getHiVRegFromLo r_dst_lo
@@ -383,6 +403,23 @@ iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do
             ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
          )
 
+-- Convert something into II64
+iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) 
+ = do
+       r_dst_lo        <- getNewRegNat II32
+       let r_dst_hi    = getHiVRegFromLo r_dst_lo
+
+       -- compute expr and load it into r_dst_lo
+       (a_reg, a_code) <- getSomeReg expr
+
+       let code        = a_code
+               `appOL` toOL
+                       [ mkRegRegMoveInstr g0    r_dst_hi      -- clear high 32 bits
+                       , mkRegRegMoveInstr a_reg r_dst_lo ]
+                       
+       return  $ ChildCode64 code r_dst_lo
+
+
 iselExpr64 expr
    = pprPanic "iselExpr64(sparc)" (ppr expr)
 
@@ -3567,8 +3604,9 @@ genCCall target dest_regs args = do
         (arg_op, arg_code) <- getOperand arg
          delta <- getDeltaNat
          setDeltaNat (delta-arg_size)
-        let code' = code `appOL` toOL [PUSH II64 arg_op, 
-                                       DELTA (delta-arg_size)]
+        let code' = code `appOL` arg_code `appOL` toOL [
+                        PUSH II64 arg_op, 
+                       DELTA (delta-arg_size)]
         push_args rest code'
        where
          arg_rep = cmmExprType arg
@@ -3615,6 +3653,16 @@ genCCall
 
 -}
 
+
+-- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
+-- are guaranteed to take place before writes afterwards (unlike on PowerPC). 
+-- Ref: Section 8.4 of the SPARC V9 Architecture manual.
+--
+-- In the SPARC case we don't need a barrier.
+--
+genCCall (CmmPrim (MO_WriteBarrier)) _ _
+ = do  return nilOL
+
 genCCall target dest_regs argsAndHints 
  = do          
        -- strip hints from the arg regs
@@ -3641,7 +3689,7 @@ genCCall target dest_regs argsAndHints
                        return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 
                CmmPrim mop 
-                -> do  (res, reduce) <- outOfLineFloatOp mop
+                -> do  res     <- outOfLineFloatOp mop
                        lblOrMopExpr <- case res of
                                Left lbl -> do
                                        return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
@@ -3649,9 +3697,8 @@ genCCall target dest_regs argsAndHints
                                Right mopExpr -> do
                                        (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
                                        return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
-                       if reduce 
-                               then panic ("genCCall(sparc): can not reduce mach op " ++ show mop)
-                               else return lblOrMopExpr
+
+                       return lblOrMopExpr
 
        let argcode = concatOL argcodes
 
@@ -3787,11 +3834,10 @@ assign_code [CmmHinted dest _hint]
 -- | Generate a call to implement an out-of-line floating point operation
 outOfLineFloatOp 
        :: CallishMachOp 
-       -> NatM ( Either CLabel CmmExpr
-               , Bool)
+       -> NatM (Either CLabel CmmExpr)
 
 outOfLineFloatOp mop 
- = do  let (reduce, functionName)
+ = do  let functionName
                = outOfLineFloatOp_table mop
        
        dflags  <- getDynFlagsNat
@@ -3803,46 +3849,50 @@ outOfLineFloatOp mop
                        CmmLit (CmmLabel lbl)   -> Left lbl
                         _                      -> Right mopExpr
 
-       return (mopLabelOrExpr, reduce)
+       return mopLabelOrExpr
 
 
+-- | Decide what C function to use to implement a CallishMachOp
+--
 outOfLineFloatOp_table 
        :: CallishMachOp
-       -> (Bool, FastString)
+       -> FastString
        
 outOfLineFloatOp_table mop
  = case mop of
-       MO_F32_Exp    -> (True,  fsLit "exp")
-       MO_F32_Log    -> (True,  fsLit "log")
-       MO_F32_Sqrt   -> (True,  fsLit "sqrt")
+       MO_F32_Exp    -> fsLit "expf"
+       MO_F32_Log    -> fsLit "logf"
+       MO_F32_Sqrt   -> fsLit "sqrtf"
+       MO_F32_Pwr    -> fsLit "powf"
 
-       MO_F32_Sin    -> (True,  fsLit "sin")
-       MO_F32_Cos    -> (True,  fsLit "cos")
-       MO_F32_Tan    -> (True,  fsLit "tan")
+       MO_F32_Sin    -> fsLit "sinf"
+       MO_F32_Cos    -> fsLit "cosf"
+       MO_F32_Tan    -> fsLit "tanf"
 
-       MO_F32_Asin   -> (True,  fsLit "asin")
-       MO_F32_Acos   -> (True,  fsLit "acos")
-       MO_F32_Atan   -> (True,  fsLit "atan")
+       MO_F32_Asin   -> fsLit "asinf"
+       MO_F32_Acos   -> fsLit "acosf"
+       MO_F32_Atan   -> fsLit "atanf"
 
-       MO_F32_Sinh   -> (True,  fsLit "sinh")
-       MO_F32_Cosh   -> (True,  fsLit "cosh")
-       MO_F32_Tanh   -> (True,  fsLit "tanh")
+       MO_F32_Sinh   -> fsLit "sinhf"
+       MO_F32_Cosh   -> fsLit "coshf"
+       MO_F32_Tanh   -> fsLit "tanhf"
 
-       MO_F64_Exp    -> (False, fsLit "exp")
-       MO_F64_Log    -> (False, fsLit "log")
-       MO_F64_Sqrt   -> (False, fsLit "sqrt")
+       MO_F64_Exp    -> fsLit "exp"
+       MO_F64_Log    -> fsLit "log"
+       MO_F64_Sqrt   -> fsLit "sqrt"
+       MO_F64_Pwr    -> fsLit "pow"
 
-       MO_F64_Sin    -> (False, fsLit "sin")
-       MO_F64_Cos    -> (False, fsLit "cos")
-       MO_F64_Tan    -> (False, fsLit "tan")
+       MO_F64_Sin    -> fsLit "sin"
+       MO_F64_Cos    -> fsLit "cos"
+       MO_F64_Tan    -> fsLit "tan"
 
-       MO_F64_Asin   -> (False, fsLit "asin")
-       MO_F64_Acos   -> (False, fsLit "acos")
-       MO_F64_Atan   -> (False, fsLit "atan")
+       MO_F64_Asin   -> fsLit "asin"
+       MO_F64_Acos   -> fsLit "acos"
+       MO_F64_Atan   -> fsLit "atan"
 
-       MO_F64_Sinh   -> (False, fsLit "sinh")
-       MO_F64_Cosh   -> (False, fsLit "cosh")
-       MO_F64_Tanh   -> (False, fsLit "tanh")
+       MO_F64_Sinh   -> fsLit "sinh"
+       MO_F64_Cosh   -> fsLit "cosh"
+       MO_F64_Tanh   -> fsLit "tanh"
 
        other -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
                        (pprCallishMachOp mop)
@@ -4261,8 +4311,8 @@ genSwitch expr ids
                        , SLL   e_reg (RIImm $ ImmInt 2) offset_reg
 
                        -- load and jump to the destination
-                       , LD    II32 (AddrRegReg base_reg offset_reg) dst
-                       , JMP   (AddrRegImm dst (ImmInt 0)) 
+                       , LD      II32 (AddrRegReg base_reg offset_reg) dst
+                       , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]
                        , NOP ]
 
 #else