never executed always true always false
    1 
    2 
    3 -----------------------------------------------------------------------------
    4 --
    5 -- Generating machine code (instruction selection)
    6 --
    7 -- (c) The University of Glasgow 1996-2013
    8 --
    9 -----------------------------------------------------------------------------
   10 
   11 {-# LANGUAGE GADTs #-}
   12 module GHC.CmmToAsm.SPARC.CodeGen (
   13         cmmTopCodeGen,
   14         generateJumpTableForInstr,
   15         InstrBlock
   16 )
   17 
   18 where
   19 
   20 -- NCG stuff:
   21 import GHC.Prelude
   22 
   23 import GHC.CmmToAsm.SPARC.Base
   24 import GHC.CmmToAsm.SPARC.CodeGen.Sanity
   25 import GHC.CmmToAsm.SPARC.CodeGen.Amode
   26 import GHC.CmmToAsm.SPARC.CodeGen.CondCode
   27 import GHC.CmmToAsm.SPARC.CodeGen.Gen64
   28 import GHC.CmmToAsm.SPARC.CodeGen.Gen32
   29 import GHC.CmmToAsm.SPARC.CodeGen.Base
   30 import GHC.CmmToAsm.SPARC.Instr
   31 import GHC.CmmToAsm.SPARC.Imm
   32 import GHC.CmmToAsm.SPARC.AddrMode
   33 import GHC.CmmToAsm.SPARC.Regs
   34 import GHC.CmmToAsm.SPARC.Stack
   35 import GHC.CmmToAsm.Types
   36 import GHC.CmmToAsm.Format
   37 import GHC.CmmToAsm.Monad   ( NatM, getNewRegNat, getNewLabelNat, getPlatform, getConfig )
   38 import GHC.CmmToAsm.Config
   39 
   40 -- Our intermediate code:
   41 import GHC.Cmm.BlockId
   42 import GHC.Cmm
   43 import GHC.Cmm.Utils
   44 import GHC.Cmm.Switch
   45 import GHC.Cmm.Dataflow.Block
   46 import GHC.Cmm.Dataflow.Graph
   47 import GHC.CmmToAsm.PIC
   48 import GHC.Platform.Reg
   49 import GHC.Cmm.CLabel
   50 import GHC.CmmToAsm.CPrim
   51 
   52 -- The rest:
   53 import GHC.Types.Basic
   54 import GHC.Data.FastString
   55 import GHC.Data.OrdList
   56 import GHC.Utils.Outputable
   57 import GHC.Utils.Panic
   58 import GHC.Platform
   59 
   60 import Control.Monad    ( mapAndUnzipM )
   61 
   62 -- | Top level code generation
   63 cmmTopCodeGen :: RawCmmDecl
   64               -> NatM [NatCmmDecl RawCmmStatics Instr]
   65 
   66 cmmTopCodeGen (CmmProc info lab live graph)
   67  = do let blocks = toBlockListEntryFirst graph
   68       (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   69 
   70       let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
   71       let tops = proc : concat statics
   72 
   73       return tops
   74 
   75 cmmTopCodeGen (CmmData sec dat) =
   76   return [CmmData sec dat]  -- no translation, we just use CmmStatic
   77 
   78 
   79 -- | Do code generation on a single block of CMM code.
   80 --      code generation may introduce new basic block boundaries, which
   81 --      are indicated by the NEWBLOCK instruction.  We must split up the
   82 --      instruction stream into basic blocks again.  Also, we extract
   83 --      LDATAs here too.
   84 basicBlockCodeGen :: CmmBlock
   85                   -> NatM ( [NatBasicBlock Instr]
   86                           , [NatCmmDecl RawCmmStatics Instr])
   87 
   88 basicBlockCodeGen block = do
   89   let (_, nodes, tail)  = blockSplit block
   90       id = entryLabel block
   91       stmts = blockToList nodes
   92   platform <- getPlatform
   93   mid_instrs <- stmtsToInstrs stmts
   94   tail_instrs <- stmtToInstrs tail
   95   let instrs = mid_instrs `appOL` tail_instrs
   96   let
   97         (top,other_blocks,statics)
   98                 = foldrOL mkBlocks ([],[],[]) instrs
   99 
  100         mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
  101           = ([], BasicBlock id instrs : blocks, statics)
  102 
  103         mkBlocks (LDATA sec dat) (instrs,blocks,statics)
  104           = (instrs, blocks, CmmData sec dat:statics)
  105 
  106         mkBlocks instr (instrs,blocks,statics)
  107           = (instr:instrs, blocks, statics)
  108 
  109         -- do intra-block sanity checking
  110         blocksChecked
  111                 = map (checkBlock platform block)
  112                 $ BasicBlock id top : other_blocks
  113 
  114   return (blocksChecked, statics)
  115 
  116 
  117 -- | Convert some Cmm statements to SPARC instructions.
  118 stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
  119 stmtsToInstrs stmts
  120    = do instrss <- mapM stmtToInstrs stmts
  121         return (concatOL instrss)
  122 
  123 
  124 stmtToInstrs :: CmmNode e x -> NatM InstrBlock
  125 stmtToInstrs stmt = do
  126   platform <- getPlatform
  127   config <- getConfig
  128   case stmt of
  129     CmmComment s   -> return (unitOL (COMMENT $ ftext s))
  130     CmmTick {}     -> return nilOL
  131     CmmUnwind {}   -> return nilOL
  132 
  133     CmmAssign reg src
  134       | isFloatType ty  -> assignReg_FltCode format reg src
  135       | isWord64 ty     -> assignReg_I64Code        reg src
  136       | otherwise       -> assignReg_IntCode format reg src
  137         where ty = cmmRegType platform reg
  138               format = cmmTypeFormat ty
  139 
  140     CmmStore addr src
  141       | isFloatType ty  -> assignMem_FltCode format addr src
  142       | isWord64 ty     -> assignMem_I64Code      addr src
  143       | otherwise       -> assignMem_IntCode format addr src
  144         where ty = cmmExprType platform src
  145               format = cmmTypeFormat ty
  146 
  147     CmmUnsafeForeignCall target result_regs args
  148        -> genCCall target result_regs args
  149 
  150     CmmBranch   id              -> genBranch id
  151     CmmCondBranch arg true false _ -> do
  152       b1 <- genCondJump true arg
  153       b2 <- genBranch false
  154       return (b1 `appOL` b2)
  155     CmmSwitch arg ids   -> genSwitch config arg ids
  156     CmmCall { cml_target = arg } -> genJump arg
  157 
  158     _
  159      -> panic "stmtToInstrs: statement should have been cps'd away"
  160 
  161 
  162 {-
  163 Now, given a tree (the argument to a CmmLoad) that references memory,
  164 produce a suitable addressing mode.
  165 
  166 A Rule of the Game (tm) for Amodes: use of the addr bit must
  167 immediately follow use of the code part, since the code part puts
  168 values in registers which the addr then refers to.  So you can't put
  169 anything in between, lest it overwrite some of those registers.  If
  170 you need to do some other computation between the code part and use of
  171 the addr bit, first store the effective address from the amode in a
  172 temporary, then do the other computation, and then use the temporary:
  173 
  174     code
  175     LEA amode, tmp
  176     ... other computation ...
  177     ... (tmp) ...
  178 -}
  179 
  180 
  181 
  182 -- | Convert a BlockId to some CmmStatic data
  183 jumpTableEntry :: Platform -> Maybe BlockId -> CmmStatic
  184 jumpTableEntry platform Nothing = CmmStaticLit (CmmInt 0 (wordWidth platform))
  185 jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
  186     where blockLabel = blockLbl blockid
  187 
  188 
  189 
  190 -- -----------------------------------------------------------------------------
  191 -- Generating assignments
  192 
  193 -- Assignments are really at the heart of the whole code generation
  194 -- business.  Almost all top-level nodes of any real importance are
  195 -- assignments, which correspond to loads, stores, or register
  196 -- transfers.  If we're really lucky, some of the register transfers
  197 -- will go away, because we can use the destination register to
  198 -- complete the code generation for the right hand side.  This only
  199 -- fails when the right hand side is forced into a fixed register
  200 -- (e.g. the result of a call).
  201 
  202 assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
  203 assignMem_IntCode pk addr src = do
  204     (srcReg, code) <- getSomeReg src
  205     Amode dstAddr addr_code <- getAmode addr
  206     return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
  207 
  208 
  209 assignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
  210 assignReg_IntCode _ reg src = do
  211     platform <- getPlatform
  212     r <- getRegister src
  213     let dst = getRegisterReg platform reg
  214     return $ case r of
  215         Any _ code         -> code dst
  216         Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
  217 
  218 
  219 
  220 -- Floating point assignment to memory
  221 assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
  222 assignMem_FltCode pk addr src = do
  223     platform <- getPlatform
  224     Amode dst__2 code1 <- getAmode addr
  225     (src__2, code2) <- getSomeReg src
  226     tmp1 <- getNewRegNat pk
  227     let
  228         pk__2   = cmmExprType platform src
  229         code__2 = code1 `appOL` code2 `appOL`
  230             if   formatToWidth pk == typeWidth pk__2
  231             then unitOL (ST pk src__2 dst__2)
  232             else toOL   [ FxTOy (cmmTypeFormat pk__2) pk src__2 tmp1
  233                         , ST    pk tmp1 dst__2]
  234     return code__2
  235 
  236 -- Floating point assignment to a register/temporary
  237 assignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
  238 assignReg_FltCode pk dstCmmReg srcCmmExpr = do
  239     platform <- getPlatform
  240     srcRegister <- getRegister srcCmmExpr
  241     let dstReg  = getRegisterReg platform dstCmmReg
  242 
  243     return $ case srcRegister of
  244         Any _ code                  -> code dstReg
  245         Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg
  246 
  247 
  248 
  249 
  250 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
  251 
  252 genJump (CmmLit (CmmLabel lbl))
  253   = return (toOL [CALL (Left target) 0 True, NOP])
  254   where
  255     target = ImmCLbl lbl
  256 
  257 genJump tree
  258   = do
  259         (target, code) <- getSomeReg tree
  260         return (code `snocOL` JMP (AddrRegReg target g0)  `snocOL` NOP)
  261 
  262 -- -----------------------------------------------------------------------------
  263 --  Unconditional branches
  264 
  265 genBranch :: BlockId -> NatM InstrBlock
  266 genBranch = return . toOL . mkJumpInstr
  267 
  268 
  269 -- -----------------------------------------------------------------------------
  270 --  Conditional jumps
  271 
  272 {-
  273 Conditional jumps are always to local labels, so we can use branch
  274 instructions.  We peek at the arguments to decide what kind of
  275 comparison to do.
  276 
  277 SPARC: First, we have to ensure that the condition codes are set
  278 according to the supplied comparison operation.  We generate slightly
  279 different code for floating point comparisons, because a floating
  280 point operation cannot directly precede a @BF@.  We assume the worst
  281 and fill that slot with a @NOP@.
  282 
  283 SPARC: Do not fill the delay slots here; you will confuse the register
  284 allocator.
  285 -}
  286 
  287 
  288 genCondJump
  289     :: BlockId      -- the branch target
  290     -> CmmExpr      -- the condition on which to branch
  291     -> NatM InstrBlock
  292 
  293 
  294 
  295 genCondJump bid bool = do
  296   CondCode is_float cond code <- getCondCode bool
  297   return (
  298        code `appOL`
  299        toOL (
  300          if   is_float
  301          then [NOP, BF cond False bid, NOP]
  302          else [BI cond False bid, NOP]
  303        )
  304     )
  305 
  306 
  307 
  308 -- -----------------------------------------------------------------------------
  309 -- Generating a table-branch
  310 
  311 genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
  312 genSwitch config expr targets
  313         | ncgPIC config
  314         = error "MachCodeGen: sparc genSwitch PIC not finished\n"
  315 
  316         | otherwise
  317         = do    (e_reg, e_code) <- getSomeReg indexExpr
  318 
  319                 base_reg        <- getNewRegNat II32
  320                 offset_reg      <- getNewRegNat II32
  321                 dst             <- getNewRegNat II32
  322 
  323                 label           <- getNewLabelNat
  324 
  325                 return $ e_code `appOL`
  326                  toOL
  327                         [ -- load base of jump table
  328                           SETHI (HI (ImmCLbl label)) base_reg
  329                         , OR    False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
  330 
  331                         -- the addrs in the table are 32 bits wide..
  332                         , SLL   e_reg (RIImm $ ImmInt 2) offset_reg
  333 
  334                         -- load and jump to the destination
  335                         , LD      II32 (AddrRegReg base_reg offset_reg) dst
  336                         , JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label
  337                         , NOP ]
  338   where
  339     indexExpr = cmmOffset platform exprWidened offset
  340     -- We widen to a native-width register to santize the high bits
  341     exprWidened = CmmMachOp
  342       (MO_UU_Conv (cmmExprWidth platform expr)
  343                   (platformWordWidth platform))
  344       [expr]
  345     (offset, ids) = switchTargetsToTable targets
  346     platform = ncgPlatform config
  347 
  348 generateJumpTableForInstr :: Platform -> Instr
  349                           -> Maybe (NatCmmDecl RawCmmStatics Instr)
  350 generateJumpTableForInstr platform (JMP_TBL _ ids label) =
  351   let jumpTable = map (jumpTableEntry platform) ids
  352   in Just (CmmData (Section ReadOnlyData label) (CmmStaticsRaw label jumpTable))
  353 generateJumpTableForInstr _ _ = Nothing
  354 
  355 
  356 
  357 -- -----------------------------------------------------------------------------
  358 -- Generating C calls
  359 
  360 {-
  361    Now the biggest nightmare---calls.  Most of the nastiness is buried in
  362    @get_arg@, which moves the arguments to the correct registers/stack
  363    locations.  Apart from that, the code is easy.
  364 
  365    The SPARC calling convention is an absolute
  366    nightmare.  The first 6x32 bits of arguments are mapped into
  367    %o0 through %o5, and the remaining arguments are dumped to the
  368    stack, beginning at [%sp+92].  (Note that %o6 == %sp.)
  369 
  370    If we have to put args on the stack, move %o6==%sp down by
  371    the number of words to go on the stack, to ensure there's enough space.
  372 
  373    According to Fraser and Hanson's lcc book, page 478, fig 17.2,
  374    16 words above the stack pointer is a word for the address of
  375    a structure return value.  I use this as a temporary location
  376    for moving values from float to int regs.  Certainly it isn't
  377    safe to put anything in the 16 words starting at %sp, since
  378    this area can get trashed at any time due to window overflows
  379    caused by signal handlers.
  380 
  381    A final complication (if the above isn't enough) is that
  382    we can't blithely calculate the arguments one by one into
  383    %o0 .. %o5.  Consider the following nested calls:
  384 
  385        fff a (fff b c)
  386 
  387    Naive code moves a into %o0, and (fff b c) into %o1.  Unfortunately
  388    the inner call will itself use %o0, which trashes the value put there
  389    in preparation for the outer call.  Upshot: we need to calculate the
  390    args into temporary regs, and move those to arg regs or onto the
  391    stack only immediately prior to the call proper.  Sigh.
  392 -}
  393 
  394 genCCall
  395     :: ForeignTarget            -- function to call
  396     -> [CmmFormal]        -- where to put the result
  397     -> [CmmActual]        -- arguments (of mixed type)
  398     -> NatM InstrBlock
  399 
  400 
  401 
  402 -- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
  403 -- are guaranteed to take place before writes afterwards (unlike on PowerPC).
  404 -- Ref: Section 8.4 of the SPARC V9 Architecture manual.
  405 --
  406 -- In the SPARC case we don't need a barrier.
  407 --
  408 genCCall (PrimTarget MO_ReadBarrier) _ _
  409  = return $ nilOL
  410 genCCall (PrimTarget MO_WriteBarrier) _ _
  411  = return $ nilOL
  412 
  413 genCCall (PrimTarget (MO_Prefetch_Data _)) _ _
  414  = return $ nilOL
  415 
  416 genCCall target dest_regs args
  417  = do   -- work out the arguments, and assign them to integer regs
  418         argcode_and_vregs       <- mapM arg_to_int_vregs args
  419         let (argcodes, vregss)  = unzip argcode_and_vregs
  420         let vregs               = concat vregss
  421 
  422         let n_argRegs           = length allArgRegs
  423         let n_argRegs_used      = min (length vregs) n_argRegs
  424 
  425 
  426         -- deal with static vs dynamic call targets
  427         callinsns <- case target of
  428                 ForeignTarget (CmmLit (CmmLabel lbl)) _ ->
  429                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
  430 
  431                 ForeignTarget expr _
  432                  -> do  (dyn_c, dyn_rs) <- arg_to_int_vregs expr
  433                         let dyn_r = case dyn_rs of
  434                                       [dyn_r'] -> dyn_r'
  435                                       _ -> panic "SPARC.CodeGen.genCCall: arg_to_int"
  436                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
  437 
  438                 PrimTarget mop
  439                  -> do  res     <- outOfLineMachOp mop
  440                         case res of
  441                                 Left lbl ->
  442                                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
  443 
  444                                 Right mopExpr -> do
  445                                         (dyn_c, dyn_rs) <- arg_to_int_vregs mopExpr
  446                                         let dyn_r = case dyn_rs of
  447                                                       [dyn_r'] -> dyn_r'
  448                                                       _ -> panic "SPARC.CodeGen.genCCall: arg_to_int"
  449                                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
  450 
  451         let argcode = concatOL argcodes
  452 
  453         let (move_sp_down, move_sp_up)
  454                    = let diff = length vregs - n_argRegs
  455                          nn   = if odd diff then diff + 1 else diff -- keep 8-byte alignment
  456                      in  if   nn <= 0
  457                          then (nilOL, nilOL)
  458                          else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
  459 
  460         let transfer_code
  461                 = toOL (move_final vregs allArgRegs extraStackArgsHere)
  462 
  463         platform <- getPlatform
  464         return
  465          $      argcode                 `appOL`
  466                 move_sp_down            `appOL`
  467                 transfer_code           `appOL`
  468                 callinsns               `appOL`
  469                 unitOL NOP              `appOL`
  470                 move_sp_up              `appOL`
  471                 assign_code platform dest_regs
  472 
  473 
  474 -- | Generate code to calculate an argument, and move it into one
  475 --      or two integer vregs.
  476 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
  477 arg_to_int_vregs arg = do platform <- getPlatform
  478                           arg_to_int_vregs' platform arg
  479 
  480 arg_to_int_vregs' :: Platform -> CmmExpr -> NatM (OrdList Instr, [Reg])
  481 arg_to_int_vregs' platform arg
  482 
  483         -- If the expr produces a 64 bit int, then we can just use iselExpr64
  484         | isWord64 (cmmExprType platform arg)
  485         = do    (ChildCode64 code r_lo) <- iselExpr64 arg
  486                 let r_hi                = getHiVRegFromLo r_lo
  487                 return (code, [r_hi, r_lo])
  488 
  489         | otherwise
  490         = do    (src, code)     <- getSomeReg arg
  491                 let pk          = cmmExprType platform arg
  492 
  493                 case cmmTypeFormat pk of
  494 
  495                  -- Load a 64 bit float return value into two integer regs.
  496                  FF64 -> do
  497                         v1 <- getNewRegNat II32
  498                         v2 <- getNewRegNat II32
  499 
  500                         let code2 =
  501                                 code                            `snocOL`
  502                                 FMOV FF64 src f0                `snocOL`
  503                                 ST   FF32  f0 (spRel 16)        `snocOL`
  504                                 LD   II32  (spRel 16) v1        `snocOL`
  505                                 ST   FF32  f1 (spRel 16)        `snocOL`
  506                                 LD   II32  (spRel 16) v2
  507 
  508                         return  (code2, [v1,v2])
  509 
  510                  -- Load a 32 bit float return value into an integer reg
  511                  FF32 -> do
  512                         v1 <- getNewRegNat II32
  513 
  514                         let code2 =
  515                                 code                            `snocOL`
  516                                 ST   FF32  src (spRel 16)       `snocOL`
  517                                 LD   II32  (spRel 16) v1
  518 
  519                         return (code2, [v1])
  520 
  521                  -- Move an integer return value into its destination reg.
  522                  _ -> do
  523                         v1 <- getNewRegNat II32
  524 
  525                         let code2 =
  526                                 code                            `snocOL`
  527                                 OR False g0 (RIReg src) v1
  528 
  529                         return (code2, [v1])
  530 
  531 
  532 -- | Move args from the integer vregs into which they have been
  533 --      marshalled, into %o0 .. %o5, and the rest onto the stack.
  534 --
  535 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
  536 
  537 -- all args done
  538 move_final [] _ _
  539         = []
  540 
  541 -- out of aregs; move to stack
  542 move_final (v:vs) [] offset
  543         = ST II32 v (spRel offset)
  544         : move_final vs [] (offset+1)
  545 
  546 -- move into an arg (%o[0..5]) reg
  547 move_final (v:vs) (a:az) offset
  548         = OR False g0 (RIReg v) a
  549         : move_final vs az offset
  550 
  551 
  552 -- | Assign results returned from the call into their
  553 --      destination regs.
  554 --
  555 assign_code :: Platform -> [LocalReg] -> OrdList Instr
  556 
  557 assign_code _ [] = nilOL
  558 
  559 assign_code platform [dest]
  560  = let  rep     = localRegType dest
  561         width   = typeWidth rep
  562         r_dest  = getRegisterReg platform (CmmLocal dest)
  563 
  564         result
  565                 | isFloatType rep
  566                 , W32   <- width
  567                 = unitOL $ FMOV FF32 (regSingle $ fReg 0) r_dest
  568 
  569                 | isFloatType rep
  570                 , W64   <- width
  571                 = unitOL $ FMOV FF64 (regSingle $ fReg 0) r_dest
  572 
  573                 | not $ isFloatType rep
  574                 , W32   <- width
  575                 = unitOL $ mkRegRegMoveInstr platform (regSingle $ oReg 0) r_dest
  576 
  577                 | not $ isFloatType rep
  578                 , W64           <- width
  579                 , r_dest_hi     <- getHiVRegFromLo r_dest
  580                 = toOL  [ mkRegRegMoveInstr platform (regSingle $ oReg 0) r_dest_hi
  581                         , mkRegRegMoveInstr platform (regSingle $ oReg 1) r_dest]
  582 
  583                 | otherwise
  584                 = panic "SPARC.CodeGen.GenCCall: no match"
  585 
  586    in   result
  587 
  588 assign_code _ _
  589         = panic "SPARC.CodeGen.GenCCall: no match"
  590 
  591 
  592 
  593 -- | Generate a call to implement an out-of-line floating point operation
  594 outOfLineMachOp
  595         :: CallishMachOp
  596         -> NatM (Either CLabel CmmExpr)
  597 
  598 outOfLineMachOp mop
  599  = do   let functionName
  600                 = outOfLineMachOp_table mop
  601 
  602         config  <- getConfig
  603         mopExpr <- cmmMakeDynamicReference config CallReference
  604                 $  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
  605 
  606         let mopLabelOrExpr
  607                 = case mopExpr of
  608                         CmmLit (CmmLabel lbl)   -> Left lbl
  609                         _                       -> Right mopExpr
  610 
  611         return mopLabelOrExpr
  612 
  613 
  614 -- | Decide what C function to use to implement a CallishMachOp
  615 --
  616 outOfLineMachOp_table
  617         :: CallishMachOp
  618         -> FastString
  619 
  620 outOfLineMachOp_table mop
  621  = case mop of
  622         MO_F32_Exp    -> fsLit "expf"
  623         MO_F32_ExpM1  -> fsLit "expm1f"
  624         MO_F32_Log    -> fsLit "logf"
  625         MO_F32_Log1P  -> fsLit "log1pf"
  626         MO_F32_Sqrt   -> fsLit "sqrtf"
  627         MO_F32_Fabs   -> unsupported
  628         MO_F32_Pwr    -> fsLit "powf"
  629 
  630         MO_F32_Sin    -> fsLit "sinf"
  631         MO_F32_Cos    -> fsLit "cosf"
  632         MO_F32_Tan    -> fsLit "tanf"
  633 
  634         MO_F32_Asin   -> fsLit "asinf"
  635         MO_F32_Acos   -> fsLit "acosf"
  636         MO_F32_Atan   -> fsLit "atanf"
  637 
  638         MO_F32_Sinh   -> fsLit "sinhf"
  639         MO_F32_Cosh   -> fsLit "coshf"
  640         MO_F32_Tanh   -> fsLit "tanhf"
  641 
  642         MO_F32_Asinh  -> fsLit "asinhf"
  643         MO_F32_Acosh  -> fsLit "acoshf"
  644         MO_F32_Atanh  -> fsLit "atanhf"
  645 
  646         MO_F64_Exp    -> fsLit "exp"
  647         MO_F64_ExpM1  -> fsLit "expm1"
  648         MO_F64_Log    -> fsLit "log"
  649         MO_F64_Log1P  -> fsLit "log1p"
  650         MO_F64_Sqrt   -> fsLit "sqrt"
  651         MO_F64_Fabs   -> unsupported
  652         MO_F64_Pwr    -> fsLit "pow"
  653 
  654         MO_F64_Sin    -> fsLit "sin"
  655         MO_F64_Cos    -> fsLit "cos"
  656         MO_F64_Tan    -> fsLit "tan"
  657 
  658         MO_F64_Asin   -> fsLit "asin"
  659         MO_F64_Acos   -> fsLit "acos"
  660         MO_F64_Atan   -> fsLit "atan"
  661 
  662         MO_F64_Sinh   -> fsLit "sinh"
  663         MO_F64_Cosh   -> fsLit "cosh"
  664         MO_F64_Tanh   -> fsLit "tanh"
  665 
  666         MO_F64_Asinh  -> fsLit "asinh"
  667         MO_F64_Acosh  -> fsLit "acosh"
  668         MO_F64_Atanh  -> fsLit "atanh"
  669 
  670         MO_I64_ToI   -> fsLit "hs_int64ToInt"
  671         MO_I64_FromI -> fsLit "hs_intToInt64"
  672         MO_W64_ToW   -> fsLit "hs_word64ToWord"
  673         MO_W64_FromW -> fsLit "hs_wordToWord64"
  674         MO_x64_Neg   -> fsLit "hs_neg64"
  675         MO_x64_Add   -> fsLit "hs_add64"
  676         MO_x64_Sub   -> fsLit "hs_sub64"
  677         MO_x64_Mul   -> fsLit "hs_mul64"
  678         MO_I64_Quot  -> fsLit "hs_quotInt64"
  679         MO_I64_Rem   -> fsLit "hs_remInt64"
  680         MO_W64_Quot  -> fsLit "hs_quotWord64"
  681         MO_W64_Rem   -> fsLit "hs_remWord64"
  682         MO_x64_And   -> fsLit "hs_and64"
  683         MO_x64_Or    -> fsLit "hs_or64"
  684         MO_x64_Xor   -> fsLit "hs_xor64"
  685         MO_x64_Not   -> fsLit "hs_not64"
  686         MO_x64_Shl   -> fsLit "hs_uncheckedShiftL64"
  687         MO_I64_Shr   -> fsLit "hs_uncheckedIShiftRA64"
  688         MO_W64_Shr   -> fsLit "hs_uncheckedShiftRL64"
  689         MO_x64_Eq    -> fsLit "hs_eq64"
  690         MO_x64_Ne    -> fsLit "hs_ne64"
  691         MO_I64_Ge    -> fsLit "hs_geInt64"
  692         MO_I64_Gt    -> fsLit "hs_gtInt64"
  693         MO_I64_Le    -> fsLit "hs_leInt64"
  694         MO_I64_Lt    -> fsLit "hs_ltInt64"
  695         MO_W64_Ge    -> fsLit "hs_geWord64"
  696         MO_W64_Gt    -> fsLit "hs_gtWord64"
  697         MO_W64_Le    -> fsLit "hs_leWord64"
  698         MO_W64_Lt    -> fsLit "hs_ltWord64"
  699 
  700         MO_UF_Conv w -> word2FloatLabel w
  701 
  702         MO_Memcpy _  -> fsLit "memcpy"
  703         MO_Memset _  -> fsLit "memset"
  704         MO_Memmove _ -> fsLit "memmove"
  705         MO_Memcmp _  -> fsLit "memcmp"
  706 
  707         MO_SuspendThread -> fsLit "suspendThread"
  708         MO_ResumeThread  -> fsLit "resumeThread"
  709 
  710         MO_BSwap w          -> bSwapLabel w
  711         MO_BRev w           -> bRevLabel w
  712         MO_PopCnt w         -> popCntLabel w
  713         MO_Pdep w           -> pdepLabel w
  714         MO_Pext w           -> pextLabel w
  715         MO_Clz w            -> clzLabel w
  716         MO_Ctz w            -> ctzLabel w
  717         MO_AtomicRMW w amop -> atomicRMWLabel w amop
  718         MO_Cmpxchg w        -> cmpxchgLabel w
  719         MO_Xchg w           -> xchgLabel w
  720         MO_AtomicRead w     -> atomicReadLabel w
  721         MO_AtomicWrite w    -> atomicWriteLabel w
  722 
  723         MO_S_Mul2    {}  -> unsupported
  724         MO_S_QuotRem {}  -> unsupported
  725         MO_U_QuotRem {}  -> unsupported
  726         MO_U_QuotRem2 {} -> unsupported
  727         MO_Add2 {}       -> unsupported
  728         MO_AddWordC {}   -> unsupported
  729         MO_SubWordC {}   -> unsupported
  730         MO_AddIntC {}    -> unsupported
  731         MO_SubIntC {}    -> unsupported
  732         MO_U_Mul2 {}     -> unsupported
  733         MO_ReadBarrier   -> unsupported
  734         MO_WriteBarrier  -> unsupported
  735         MO_Touch         -> unsupported
  736         (MO_Prefetch_Data _) -> unsupported
  737     where unsupported = panic ("outOfLineCmmOp: " ++ show mop
  738                             ++ " not supported here")
  739