- return (argcode `appOL`
- move_sp_down `appOL`
- transfer_code `appOL`
- callinsns `appOL`
- unitOL NOP `appOL`
- move_sp_up `appOL`
- assign_code dest_regs)
- where
- -- move args from the integer vregs into which they have been
- -- marshalled, into %o0 .. %o5, and the rest onto the stack.
- move_final :: [Reg] -> [Reg] -> Int -> [Instr]
-
- move_final [] _ offset -- all args done
- = []
-
- move_final (v:vs) [] offset -- out of aregs; move to stack
- = ST II32 v (spRel offset)
- : move_final vs [] (offset+1)
-
- move_final (v:vs) (a:az) offset -- move into an arg (%o[0..5]) reg
- = OR False g0 (RIReg v) a
- : move_final vs az offset
-
- -- generate code to calculate an argument, and move it into one
- -- or two integer vregs.
- arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
- arg_to_int_vregs arg
- | isWord64 (cmmExprType arg)
- = do
- (ChildCode64 code r_lo) <- iselExpr64 arg
- let
- r_hi = getHiVRegFromLo r_lo
- return (code, [r_hi, r_lo])
- | otherwise
- = do
- (src, code) <- getSomeReg arg
- tmp <- getNewRegNat (cmmTypeSize $ cmmExprType arg)
- let
- pk = cmmExprType arg
- Just f0_high = fPair f0
- case cmmTypeSize pk of
- FF64 -> do
- v1 <- getNewRegNat II32
- v2 <- getNewRegNat II32
- return (
- code `snocOL`
- FMOV FF64 src f0 `snocOL`
- ST FF32 f0 (spRel 16) `snocOL`
- LD II32 (spRel 16) v1 `snocOL`
- ST FF32 f0_high (spRel 16) `snocOL`
- LD II32 (spRel 16) v2
- ,
- [v1,v2]
- )
- FF32 -> do
- v1 <- getNewRegNat II32
- return (
- code `snocOL`
- ST FF32 src (spRel 16) `snocOL`
- LD II32 (spRel 16) v1
- ,
- [v1]
- )
- other -> do
- v1 <- getNewRegNat II32
- return (
- code `snocOL` OR False g0 (RIReg src) v1
- ,
- [v1]
- )
-outOfLineFloatOp mop =
- do
- dflags <- getDynFlagsNat
- mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
- mkForeignLabel functionName Nothing True
- let mopLabelOrExpr = case mopExpr of
- CmmLit (CmmLabel lbl) -> Left lbl
- _ -> Right mopExpr
- return (mopLabelOrExpr, reduce)
- where
- (reduce, functionName) = case mop of
- MO_F32_Exp -> (True, fsLit "exp")
- MO_F32_Log -> (True, fsLit "log")
- MO_F32_Sqrt -> (True, fsLit "sqrt")
+ return (code2, [v1])
+
+ -- Move an integer return value into its destination reg.
+ other -> do
+ v1 <- getNewRegNat II32
+
+ let code2 =
+ code `snocOL`
+ OR False g0 (RIReg src) v1
+
+ return (code2, [v1])
+
+
+-- | Move args from the integer vregs into which they have been
+-- marshalled, into %o0 .. %o5, and the rest onto the stack.
+--
+move_final :: [Reg] -> [Reg] -> Int -> [Instr]
+
+-- all args done
+move_final [] _ offset
+ = []
+
+-- out of aregs; move to stack
+move_final (v:vs) [] offset
+ = ST II32 v (spRel offset)
+ : move_final vs [] (offset+1)
+
+-- move into an arg (%o[0..5]) reg
+move_final (v:vs) (a:az) offset
+ = OR False g0 (RIReg v) a
+ : move_final vs az offset
+
+
+-- | Assign results returned from the call into their
+-- desination regs.
+--
+assign_code :: [CmmHinted LocalReg] -> OrdList Instr
+assign_code [] = nilOL
+
+assign_code [CmmHinted dest _hint]
+ = let rep = localRegType dest
+ width = typeWidth rep
+ r_dest = getRegisterReg (CmmLocal dest)
+
+ result
+ | isFloatType rep
+ , W32 <- width
+ = unitOL $ FMOV FF32 (RealReg $ fReg 0) r_dest
+
+ | isFloatType rep
+ , W64 <- width
+ = unitOL $ FMOV FF64 (RealReg $ fReg 0) r_dest
+
+ | not $ isFloatType rep
+ , W32 <- width
+ = unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
+
+ | not $ isFloatType rep
+ , W64 <- width
+ , r_dest_hi <- getHiVRegFromLo r_dest
+ = toOL [ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest_hi
+ , mkRegRegMoveInstr (RealReg $ oReg 1) r_dest]
+ in result
+
+
+-- | Generate a call to implement an out-of-line floating point operation
+outOfLineFloatOp
+ :: CallishMachOp
+ -> NatM ( Either CLabel CmmExpr
+ , Bool)
+
+outOfLineFloatOp mop
+ = do let (reduce, functionName)
+ = outOfLineFloatOp_table mop
+
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
+ $ mkForeignLabel functionName Nothing True
+
+ let mopLabelOrExpr
+ = case mopExpr of
+ CmmLit (CmmLabel lbl) -> Left lbl
+ _ -> Right mopExpr
+
+ return (mopLabelOrExpr, reduce)
+
+
+outOfLineFloatOp_table
+ :: CallishMachOp
+ -> (Bool, 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_Sin -> (True, fsLit "sin")
+ MO_F32_Cos -> (True, fsLit "cos")
+ MO_F32_Tan -> (True, fsLit "tan")
projects / ghc-hetmet.git / blobdiff