compiler/nativeGen/SPARC/CodeGen/CCall.hs

   1 -- | Generating C calls
   2 module SPARC.CodeGen.CCall (
   3         genCCall
   4 )
   5
   6 where
   7
   8 import SPARC.CodeGen.Gen64
   9 import SPARC.CodeGen.Gen32
  10 import SPARC.CodeGen.Base
  11 import SPARC.Stack
  12 import SPARC.Instr
  13 import SPARC.Imm
  14 import SPARC.Regs
  15 import SPARC.Base
  16 import NCGMonad
  17 import PIC
  18 import Instruction
  19 import Size
  20 import Reg
  21
  22 import Cmm
  23 import CLabel
  24 import BasicTypes
  25
  26 import OrdList
  27 import FastString
  28 import Outputable
  29
  30 {-
  31    Now the biggest nightmare---calls.  Most of the nastiness is buried in
  32    @get_arg@, which moves the arguments to the correct registers/stack
  33    locations.  Apart from that, the code is easy.
  34
  35    The SPARC calling convention is an absolute
  36    nightmare.  The first 6x32 bits of arguments are mapped into
  37    %o0 through %o5, and the remaining arguments are dumped to the
  38    stack, beginning at [%sp+92].  (Note that %o6 == %sp.)
  39
  40    If we have to put args on the stack, move %o6==%sp down by
  41    the number of words to go on the stack, to ensure there's enough space.
  42
  43    According to Fraser and Hanson's lcc book, page 478, fig 17.2,
  44    16 words above the stack pointer is a word for the address of
  45    a structure return value.  I use this as a temporary location
  46    for moving values from float to int regs.  Certainly it isn't
  47    safe to put anything in the 16 words starting at %sp, since
  48    this area can get trashed at any time due to window overflows
  49    caused by signal handlers.
  50
  51    A final complication (if the above isn't enough) is that
  52    we can't blithely calculate the arguments one by one into
  53    %o0 .. %o5.  Consider the following nested calls:
  54
  55        fff a (fff b c)
  56
  57    Naive code moves a into %o0, and (fff b c) into %o1.  Unfortunately
  58    the inner call will itself use %o0, which trashes the value put there
  59    in preparation for the outer call.  Upshot: we need to calculate the
  60    args into temporary regs, and move those to arg regs or onto the
  61    stack only immediately prior to the call proper.  Sigh.
  62 -}
  63
  64 genCCall
  65     :: CmmCallTarget            -- function to call
  66     -> HintedCmmFormals         -- where to put the result
  67     -> HintedCmmActuals         -- arguments (of mixed type)
  68     -> NatM InstrBlock
  69
  70
  71
  72 -- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
  73 -- are guaranteed to take place before writes afterwards (unlike on PowerPC).
  74 -- Ref: Section 8.4 of the SPARC V9 Architecture manual.
  75 --
  76 -- In the SPARC case we don't need a barrier.
  77 --
  78 genCCall (CmmPrim (MO_WriteBarrier)) _ _
  79  = do   return nilOL
  80
  81 genCCall target dest_regs argsAndHints
  82  = do
  83         -- strip hints from the arg regs
  84         let args :: [CmmExpr]
  85             args  = map hintlessCmm argsAndHints
  86
  87
  88         -- work out the arguments, and assign them to integer regs
  89         argcode_and_vregs       <- mapM arg_to_int_vregs args
  90         let (argcodes, vregss)  = unzip argcode_and_vregs
  91         let vregs               = concat vregss
  92
  93         let n_argRegs           = length allArgRegs
  94         let n_argRegs_used      = min (length vregs) n_argRegs
  95
  96
  97         -- deal with static vs dynamic call targets
  98         callinsns <- case target of
  99                 CmmCallee (CmmLit (CmmLabel lbl)) _ ->
 100                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 101
 102                 CmmCallee expr _
 103                  -> do  (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
 104                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 105
 106                 CmmPrim mop
 107                  -> do  res     <- outOfLineFloatOp mop
 108                         lblOrMopExpr <- case res of
 109                                 Left lbl -> do
 110                                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 111
 112                                 Right mopExpr -> do
 113                                         (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
 114                                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 115
 116                         return lblOrMopExpr
 117
 118         let argcode = concatOL argcodes
 119
 120         let (move_sp_down, move_sp_up)
 121                    = let diff = length vregs - n_argRegs
 122                          nn   = if odd diff then diff + 1 else diff -- keep 8-byte alignment
 123                      in  if   nn <= 0
 124                          then (nilOL, nilOL)
 125                          else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
 126
 127         let transfer_code
 128                 = toOL (move_final vregs allArgRegs extraStackArgsHere)
 129
 130         return
 131          $      argcode                 `appOL`
 132                 move_sp_down            `appOL`
 133                 transfer_code           `appOL`
 134                 callinsns               `appOL`
 135                 unitOL NOP              `appOL`
 136                 move_sp_up              `appOL`
 137                 assign_code dest_regs
 138
 139
 140 -- | Generate code to calculate an argument, and move it into one
 141 --      or two integer vregs.
 142 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
 143 arg_to_int_vregs arg
 144
 145         -- If the expr produces a 64 bit int, then we can just use iselExpr64
 146         | isWord64 (cmmExprType arg)
 147         = do    (ChildCode64 code r_lo) <- iselExpr64 arg
 148                 let r_hi                = getHiVRegFromLo r_lo
 149                 return (code, [r_hi, r_lo])
 150
 151         | otherwise
 152         = do    (src, code)     <- getSomeReg arg
 153                 let pk          = cmmExprType arg
 154
 155                 case cmmTypeSize pk of
 156
 157                  -- Load a 64 bit float return value into two integer regs.
 158                  FF64 -> do
 159                         v1 <- getNewRegNat II32
 160                         v2 <- getNewRegNat II32
 161
 162                         let code2 =
 163                                 code                            `snocOL`
 164                                 FMOV FF64 src f0                `snocOL`
 165                                 ST   FF32  f0 (spRel 16)        `snocOL`
 166                                 LD   II32  (spRel 16) v1        `snocOL`
 167                                 ST   FF32  f1 (spRel 16)        `snocOL`
 168                                 LD   II32  (spRel 16) v2
 169
 170                         return  (code2, [v1,v2])
 171
 172                  -- Load a 32 bit float return value into an integer reg
 173                  FF32 -> do
 174                         v1 <- getNewRegNat II32
 175
 176                         let code2 =
 177                                 code                            `snocOL`
 178                                 ST   FF32  src (spRel 16)       `snocOL`
 179                                 LD   II32  (spRel 16) v1
 180
 181                         return (code2, [v1])
 182
 183                  -- Move an integer return value into its destination reg.
 184                  _ -> do
 185                         v1 <- getNewRegNat II32
 186
 187                         let code2 =
 188                                 code                            `snocOL`
 189                                 OR False g0 (RIReg src) v1
 190
 191                         return (code2, [v1])
 192
 193
 194 -- | Move args from the integer vregs into which they have been
 195 --      marshalled, into %o0 .. %o5, and the rest onto the stack.
 196 --
 197 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
 198
 199 -- all args done
 200 move_final [] _ _
 201         = []
 202
 203 -- out of aregs; move to stack
 204 move_final (v:vs) [] offset
 205         = ST II32 v (spRel offset)
 206         : move_final vs [] (offset+1)
 207
 208 -- move into an arg (%o[0..5]) reg
 209 move_final (v:vs) (a:az) offset
 210         = OR False g0 (RIReg v) a
 211         : move_final vs az offset
 212
 213
 214 -- | Assign results returned from the call into their
 215 --      desination regs.
 216 --
 217 assign_code :: [CmmHinted LocalReg] -> OrdList Instr
 218
 219 assign_code []  = nilOL
 220
 221 assign_code [CmmHinted dest _hint]
 222  = let  rep     = localRegType dest
 223         width   = typeWidth rep
 224         r_dest  = getRegisterReg (CmmLocal dest)
 225
 226         result
 227                 | isFloatType rep
 228                 , W32   <- width
 229                 = unitOL $ FMOV FF32 (regSingle $ fReg 0) r_dest
 230
 231                 | isFloatType rep
 232                 , W64   <- width
 233                 = unitOL $ FMOV FF64 (regSingle $ fReg 0) r_dest
 234
 235                 | not $ isFloatType rep
 236                 , W32   <- width
 237                 = unitOL $ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest
 238
 239                 | not $ isFloatType rep
 240                 , W64           <- width
 241                 , r_dest_hi     <- getHiVRegFromLo r_dest
 242                 = toOL  [ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest_hi
 243                         , mkRegRegMoveInstr (regSingle $ oReg 1) r_dest]
 244
 245                 | otherwise
 246                 = panic "SPARC.CodeGen.GenCCall: no match"
 247
 248    in   result
 249
 250 assign_code _
 251         = panic "SPARC.CodeGen.GenCCall: no match"
 252
 253
 254
 255 -- | Generate a call to implement an out-of-line floating point operation
 256 outOfLineFloatOp
 257         :: CallishMachOp
 258         -> NatM (Either CLabel CmmExpr)
 259
 260 outOfLineFloatOp mop
 261  = do   let functionName
 262                 = outOfLineFloatOp_table mop
 263
 264         dflags  <- getDynFlagsNat
 265         mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
 266                 $  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
 267
 268         let mopLabelOrExpr
 269                 = case mopExpr of
 270                         CmmLit (CmmLabel lbl)   -> Left lbl
 271                         _                       -> Right mopExpr
 272
 273         return mopLabelOrExpr
 274
 275
 276 -- | Decide what C function to use to implement a CallishMachOp
 277 --
 278 outOfLineFloatOp_table
 279         :: CallishMachOp
 280         -> FastString
 281
 282 outOfLineFloatOp_table mop
 283  = case mop of
 284         MO_F32_Exp    -> fsLit "expf"
 285         MO_F32_Log    -> fsLit "logf"
 286         MO_F32_Sqrt   -> fsLit "sqrtf"
 287         MO_F32_Pwr    -> fsLit "powf"
 288
 289         MO_F32_Sin    -> fsLit "sinf"
 290         MO_F32_Cos    -> fsLit "cosf"
 291         MO_F32_Tan    -> fsLit "tanf"
 292
 293         MO_F32_Asin   -> fsLit "asinf"
 294         MO_F32_Acos   -> fsLit "acosf"
 295         MO_F32_Atan   -> fsLit "atanf"
 296
 297         MO_F32_Sinh   -> fsLit "sinhf"
 298         MO_F32_Cosh   -> fsLit "coshf"
 299         MO_F32_Tanh   -> fsLit "tanhf"
 300
 301         MO_F64_Exp    -> fsLit "exp"
 302         MO_F64_Log    -> fsLit "log"
 303         MO_F64_Sqrt   -> fsLit "sqrt"
 304         MO_F64_Pwr    -> fsLit "pow"
 305
 306         MO_F64_Sin    -> fsLit "sin"
 307         MO_F64_Cos    -> fsLit "cos"
 308         MO_F64_Tan    -> fsLit "tan"
 309
 310         MO_F64_Asin   -> fsLit "asin"
 311         MO_F64_Acos   -> fsLit "acos"
 312         MO_F64_Atan   -> fsLit "atan"
 313
 314         MO_F64_Sinh   -> fsLit "sinh"
 315         MO_F64_Cosh   -> fsLit "cosh"
 316         MO_F64_Tanh   -> fsLit "tanh"
 317
 318         _ -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
 319                         (pprCallishMachOp mop)