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 OldCmm
  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         -- need to remove alignment information
  84         let argsAndHints' | (CmmPrim mop) <- target,
  85                             (mop == MO_Memcpy ||
  86                              mop == MO_Memset ||
  87                              mop == MO_Memmove)
  88                           = init argsAndHints
  89
  90                           | otherwise
  91                           = argsAndHints
  92
  93         -- strip hints from the arg regs
  94         let args :: [CmmExpr]
  95             args  = map hintlessCmm argsAndHints'
  96
  97
  98         -- work out the arguments, and assign them to integer regs
  99         argcode_and_vregs       <- mapM arg_to_int_vregs args
 100         let (argcodes, vregss)  = unzip argcode_and_vregs
 101         let vregs               = concat vregss
 102
 103         let n_argRegs           = length allArgRegs
 104         let n_argRegs_used      = min (length vregs) n_argRegs
 105
 106
 107         -- deal with static vs dynamic call targets
 108         callinsns <- case target of
 109                 CmmCallee (CmmLit (CmmLabel lbl)) _ ->
 110                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 111
 112                 CmmCallee expr _
 113                  -> do  (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
 114                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 115
 116                 CmmPrim mop
 117                  -> do  res     <- outOfLineMachOp mop
 118                         lblOrMopExpr <- case res of
 119                                 Left lbl -> do
 120                                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 121
 122                                 Right mopExpr -> do
 123                                         (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
 124                                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 125
 126                         return lblOrMopExpr
 127
 128         let argcode = concatOL argcodes
 129
 130         let (move_sp_down, move_sp_up)
 131                    = let diff = length vregs - n_argRegs
 132                          nn   = if odd diff then diff + 1 else diff -- keep 8-byte alignment
 133                      in  if   nn <= 0
 134                          then (nilOL, nilOL)
 135                          else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
 136
 137         let transfer_code
 138                 = toOL (move_final vregs allArgRegs extraStackArgsHere)
 139
 140         return
 141          $      argcode                 `appOL`
 142                 move_sp_down            `appOL`
 143                 transfer_code           `appOL`
 144                 callinsns               `appOL`
 145                 unitOL NOP              `appOL`
 146                 move_sp_up              `appOL`
 147                 assign_code dest_regs
 148
 149
 150 -- | Generate code to calculate an argument, and move it into one
 151 --      or two integer vregs.
 152 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
 153 arg_to_int_vregs arg
 154
 155         -- If the expr produces a 64 bit int, then we can just use iselExpr64
 156         | isWord64 (cmmExprType arg)
 157         = do    (ChildCode64 code r_lo) <- iselExpr64 arg
 158                 let r_hi                = getHiVRegFromLo r_lo
 159                 return (code, [r_hi, r_lo])
 160
 161         | otherwise
 162         = do    (src, code)     <- getSomeReg arg
 163                 let pk          = cmmExprType arg
 164
 165                 case cmmTypeSize pk of
 166
 167                  -- Load a 64 bit float return value into two integer regs.
 168                  FF64 -> do
 169                         v1 <- getNewRegNat II32
 170                         v2 <- getNewRegNat II32
 171
 172                         let code2 =
 173                                 code                            `snocOL`
 174                                 FMOV FF64 src f0                `snocOL`
 175                                 ST   FF32  f0 (spRel 16)        `snocOL`
 176                                 LD   II32  (spRel 16) v1        `snocOL`
 177                                 ST   FF32  f1 (spRel 16)        `snocOL`
 178                                 LD   II32  (spRel 16) v2
 179
 180                         return  (code2, [v1,v2])
 181
 182                  -- Load a 32 bit float return value into an integer reg
 183                  FF32 -> do
 184                         v1 <- getNewRegNat II32
 185
 186                         let code2 =
 187                                 code                            `snocOL`
 188                                 ST   FF32  src (spRel 16)       `snocOL`
 189                                 LD   II32  (spRel 16) v1
 190
 191                         return (code2, [v1])
 192
 193                  -- Move an integer return value into its destination reg.
 194                  _ -> do
 195                         v1 <- getNewRegNat II32
 196
 197                         let code2 =
 198                                 code                            `snocOL`
 199                                 OR False g0 (RIReg src) v1
 200
 201                         return (code2, [v1])
 202
 203
 204 -- | Move args from the integer vregs into which they have been
 205 --      marshalled, into %o0 .. %o5, and the rest onto the stack.
 206 --
 207 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
 208
 209 -- all args done
 210 move_final [] _ _
 211         = []
 212
 213 -- out of aregs; move to stack
 214 move_final (v:vs) [] offset
 215         = ST II32 v (spRel offset)
 216         : move_final vs [] (offset+1)
 217
 218 -- move into an arg (%o[0..5]) reg
 219 move_final (v:vs) (a:az) offset
 220         = OR False g0 (RIReg v) a
 221         : move_final vs az offset
 222
 223
 224 -- | Assign results returned from the call into their
 225 --      desination regs.
 226 --
 227 assign_code :: [CmmHinted LocalReg] -> OrdList Instr
 228
 229 assign_code []  = nilOL
 230
 231 assign_code [CmmHinted dest _hint]
 232  = let  rep     = localRegType dest
 233         width   = typeWidth rep
 234         r_dest  = getRegisterReg (CmmLocal dest)
 235
 236         result
 237                 | isFloatType rep
 238                 , W32   <- width
 239                 = unitOL $ FMOV FF32 (regSingle $ fReg 0) r_dest
 240
 241                 | isFloatType rep
 242                 , W64   <- width
 243                 = unitOL $ FMOV FF64 (regSingle $ fReg 0) r_dest
 244
 245                 | not $ isFloatType rep
 246                 , W32   <- width
 247                 = unitOL $ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest
 248
 249                 | not $ isFloatType rep
 250                 , W64           <- width
 251                 , r_dest_hi     <- getHiVRegFromLo r_dest
 252                 = toOL  [ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest_hi
 253                         , mkRegRegMoveInstr (regSingle $ oReg 1) r_dest]
 254
 255                 | otherwise
 256                 = panic "SPARC.CodeGen.GenCCall: no match"
 257
 258    in   result
 259
 260 assign_code _
 261         = panic "SPARC.CodeGen.GenCCall: no match"
 262
 263
 264
 265 -- | Generate a call to implement an out-of-line floating point operation
 266 outOfLineMachOp
 267         :: CallishMachOp
 268         -> NatM (Either CLabel CmmExpr)
 269
 270 outOfLineMachOp mop
 271  = do   let functionName
 272                 = outOfLineMachOp_table mop
 273
 274         dflags  <- getDynFlagsNat
 275         mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
 276                 $  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
 277
 278         let mopLabelOrExpr
 279                 = case mopExpr of
 280                         CmmLit (CmmLabel lbl)   -> Left lbl
 281                         _                       -> Right mopExpr
 282
 283         return mopLabelOrExpr
 284
 285
 286 -- | Decide what C function to use to implement a CallishMachOp
 287 --
 288 outOfLineMachOp_table
 289         :: CallishMachOp
 290         -> FastString
 291
 292 outOfLineMachOp_table mop
 293  = case mop of
 294         MO_F32_Exp    -> fsLit "expf"
 295         MO_F32_Log    -> fsLit "logf"
 296         MO_F32_Sqrt   -> fsLit "sqrtf"
 297         MO_F32_Pwr    -> fsLit "powf"
 298
 299         MO_F32_Sin    -> fsLit "sinf"
 300         MO_F32_Cos    -> fsLit "cosf"
 301         MO_F32_Tan    -> fsLit "tanf"
 302
 303         MO_F32_Asin   -> fsLit "asinf"
 304         MO_F32_Acos   -> fsLit "acosf"
 305         MO_F32_Atan   -> fsLit "atanf"
 306
 307         MO_F32_Sinh   -> fsLit "sinhf"
 308         MO_F32_Cosh   -> fsLit "coshf"
 309         MO_F32_Tanh   -> fsLit "tanhf"
 310
 311         MO_F64_Exp    -> fsLit "exp"
 312         MO_F64_Log    -> fsLit "log"
 313         MO_F64_Sqrt   -> fsLit "sqrt"
 314         MO_F64_Pwr    -> fsLit "pow"
 315
 316         MO_F64_Sin    -> fsLit "sin"
 317         MO_F64_Cos    -> fsLit "cos"
 318         MO_F64_Tan    -> fsLit "tan"
 319
 320         MO_F64_Asin   -> fsLit "asin"
 321         MO_F64_Acos   -> fsLit "acos"
 322         MO_F64_Atan   -> fsLit "atan"
 323
 324         MO_F64_Sinh   -> fsLit "sinh"
 325         MO_F64_Cosh   -> fsLit "cosh"
 326         MO_F64_Tanh   -> fsLit "tanh"
 327
 328         MO_Memcpy    -> fsLit "memcpy"
 329         MO_Memset    -> fsLit "memset"
 330         MO_Memmove   -> fsLit "memmove"
 331
 332         _ -> pprPanic "outOfLineMachOp(sparc): Unknown callish mach op "
 333                         (pprCallishMachOp mop)