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 Just f0_high = fPair f0
 163
 164                         let code2 =
 165                                 code                            `snocOL`
 166                                 FMOV FF64 src f0                `snocOL`
 167                                 ST   FF32  f0 (spRel 16)        `snocOL`
 168                                 LD   II32  (spRel 16) v1        `snocOL`
 169                                 ST   FF32  f0_high (spRel 16)   `snocOL`
 170                                 LD   II32  (spRel 16) v2
 171
 172                         return  (code2, [v1,v2])
 173
 174                  -- Load a 32 bit float return value into an integer reg
 175                  FF32 -> do
 176                         v1 <- getNewRegNat II32
 177
 178                         let code2 =
 179                                 code                            `snocOL`
 180                                 ST   FF32  src (spRel 16)       `snocOL`
 181                                 LD   II32  (spRel 16) v1
 182
 183                         return (code2, [v1])
 184
 185                  -- Move an integer return value into its destination reg.
 186                  _ -> do
 187                         v1 <- getNewRegNat II32
 188
 189                         let code2 =
 190                                 code                            `snocOL`
 191                                 OR False g0 (RIReg src) v1
 192
 193                         return (code2, [v1])
 194
 195
 196 -- | Move args from the integer vregs into which they have been
 197 --      marshalled, into %o0 .. %o5, and the rest onto the stack.
 198 --
 199 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
 200
 201 -- all args done
 202 move_final [] _ _
 203         = []
 204
 205 -- out of aregs; move to stack
 206 move_final (v:vs) [] offset
 207         = ST II32 v (spRel offset)
 208         : move_final vs [] (offset+1)
 209
 210 -- move into an arg (%o[0..5]) reg
 211 move_final (v:vs) (a:az) offset
 212         = OR False g0 (RIReg v) a
 213         : move_final vs az offset
 214
 215
 216 -- | Assign results returned from the call into their
 217 --      desination regs.
 218 --
 219 assign_code :: [CmmHinted LocalReg] -> OrdList Instr
 220
 221 assign_code []  = nilOL
 222
 223 assign_code [CmmHinted dest _hint]
 224  = let  rep     = localRegType dest
 225         width   = typeWidth rep
 226         r_dest  = getRegisterReg (CmmLocal dest)
 227
 228         result
 229                 | isFloatType rep
 230                 , W32   <- width
 231                 = unitOL $ FMOV FF32 (RealReg $ fReg 0) r_dest
 232
 233                 | isFloatType rep
 234                 , W64   <- width
 235                 = unitOL $ FMOV FF64 (RealReg $ fReg 0) r_dest
 236
 237                 | not $ isFloatType rep
 238                 , W32   <- width
 239                 = unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
 240
 241                 | not $ isFloatType rep
 242                 , W64           <- width
 243                 , r_dest_hi     <- getHiVRegFromLo r_dest
 244                 = toOL  [ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest_hi
 245                         , mkRegRegMoveInstr (RealReg $ oReg 1) r_dest]
 246
 247                 | otherwise
 248                 = panic "SPARC.CodeGen.GenCCall: no match"
 249
 250    in   result
 251
 252 assign_code _
 253         = panic "SPARC.CodeGen.GenCCall: no match"
 254
 255
 256
 257 -- | Generate a call to implement an out-of-line floating point operation
 258 outOfLineFloatOp
 259         :: CallishMachOp
 260         -> NatM (Either CLabel CmmExpr)
 261
 262 outOfLineFloatOp mop
 263  = do   let functionName
 264                 = outOfLineFloatOp_table mop
 265
 266         dflags  <- getDynFlagsNat
 267         mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
 268                 $  mkForeignLabel functionName Nothing True IsFunction
 269
 270         let mopLabelOrExpr
 271                 = case mopExpr of
 272                         CmmLit (CmmLabel lbl)   -> Left lbl
 273                         _                       -> Right mopExpr
 274
 275         return mopLabelOrExpr
 276
 277
 278 -- | Decide what C function to use to implement a CallishMachOp
 279 --
 280 outOfLineFloatOp_table
 281         :: CallishMachOp
 282         -> FastString
 283
 284 outOfLineFloatOp_table mop
 285  = case mop of
 286         MO_F32_Exp    -> fsLit "expf"
 287         MO_F32_Log    -> fsLit "logf"
 288         MO_F32_Sqrt   -> fsLit "sqrtf"
 289         MO_F32_Pwr    -> fsLit "powf"
 290
 291         MO_F32_Sin    -> fsLit "sinf"
 292         MO_F32_Cos    -> fsLit "cosf"
 293         MO_F32_Tan    -> fsLit "tanf"
 294
 295         MO_F32_Asin   -> fsLit "asinf"
 296         MO_F32_Acos   -> fsLit "acosf"
 297         MO_F32_Atan   -> fsLit "atanf"
 298
 299         MO_F32_Sinh   -> fsLit "sinhf"
 300         MO_F32_Cosh   -> fsLit "coshf"
 301         MO_F32_Tanh   -> fsLit "tanhf"
 302
 303         MO_F64_Exp    -> fsLit "exp"
 304         MO_F64_Log    -> fsLit "log"
 305         MO_F64_Sqrt   -> fsLit "sqrt"
 306         MO_F64_Pwr    -> fsLit "pow"
 307
 308         MO_F64_Sin    -> fsLit "sin"
 309         MO_F64_Cos    -> fsLit "cos"
 310         MO_F64_Tan    -> fsLit "tan"
 311
 312         MO_F64_Asin   -> fsLit "asin"
 313         MO_F64_Acos   -> fsLit "acos"
 314         MO_F64_Atan   -> fsLit "atan"
 315
 316         MO_F64_Sinh   -> fsLit "sinh"
 317         MO_F64_Cosh   -> fsLit "cosh"
 318         MO_F64_Tanh   -> fsLit "tanh"
 319
 320         _ -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
 321                         (pprCallishMachOp mop)