X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=eb3a5cd6a34583725ce2816678d4fef75c25cfdb;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=cc940749f9a57bca214777ac1e0be3d123b69b64;hpb=6015a94f9108a502150565577b66c23650796639;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index cc94074..eb3a5cd 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -42,8 +42,10 @@ import FastTypes	( isFastTrue )
 import Constants	( wORD_SIZE )
 
 #ifdef DEBUG
+import Outputable	( assertPanic )
 import Debug.Trace	( trace )
 #endif
+import Debug.Trace	( trace )
 
 import Control.Monad	( mapAndUnzipM )
 import Data.Maybe	( fromJust )
@@ -119,7 +121,7 @@ stmtToInstrs stmt = case stmt of
       | otherwise	 -> assignMem_IntCode kind addr src
 	where kind = cmmExprRep src
 
-    CmmCall target result_regs args _
+    CmmCall target result_regs args _ _
        -> genCCall target result_regs args
 
     CmmBranch id	  -> genBranch id
@@ -784,7 +786,8 @@ getRegister leaf
 
 getRegister (CmmLit (CmmFloat f F32)) = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst =
 	    LDATA ReadOnlyData
@@ -807,7 +810,8 @@ getRegister (CmmLit (CmmFloat d F64))
 
   | otherwise = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst =
 	    LDATA ReadOnlyData
@@ -1727,7 +1731,8 @@ getRegister (CmmLit (CmmInt i rep))
 
 getRegister (CmmLit (CmmFloat f frep)) = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst = 
 	    LDATA ReadOnlyData  [CmmDataLabel lbl,
@@ -3084,11 +3089,11 @@ genCCall target dest_regs args = do
     (callinsns,cconv) <-
       case target of
 	-- CmmPrim -> ...
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+        CmmCallee (CmmLit (CmmLabel lbl)) conv
            -> -- ToDo: stdcall arg sizes
 	      return (unitOL (CALL (Left fn_imm) []), conv)
 	   where fn_imm = ImmCLbl lbl
-        CmmForeignCall expr conv
+        CmmCallee expr conv
            -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
                  ASSERT(dyn_rep == I32)
                   return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
@@ -3195,18 +3200,19 @@ outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
   -> NatM InstrBlock
 outOfLineFloatOp mop res args
   = do
-      targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
-      let target = CmmForeignCall targetExpr CCallConv
+      dflags <- getDynFlagsNat
+      targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+      let target = CmmCallee targetExpr CCallConv
         
       if localRegRep res == F64
         then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
+          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
         else do
           uq <- getUniqueNat
           let 
             tmp = LocalReg uq F64 KindNonPtr
           -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where
@@ -3301,11 +3307,11 @@ genCCall target dest_regs args = do
     (callinsns,cconv) <-
       case target of
 	-- CmmPrim -> ...
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+        CmmCallee (CmmLit (CmmLabel lbl)) conv
            -> -- ToDo: stdcall arg sizes
 	      return (unitOL (CALL (Left fn_imm) arg_regs), conv)
 	   where fn_imm = ImmCLbl lbl
-        CmmForeignCall expr conv
+        CmmCallee expr conv
            -> do (dyn_r, dyn_c) <- getSomeReg expr
 		 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
 
@@ -3455,9 +3461,9 @@ genCCall target dest_regs argsAndHints = do
         vregs              = concat vregss
     -- deal with static vs dynamic call targets
     callinsns <- (case target of
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
+        CmmCallee (CmmLit (CmmLabel lbl)) conv -> do
 		return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
-        CmmForeignCall expr conv -> do
+        CmmCallee expr conv -> do
                 (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
                 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 	CmmPrim mop -> do
@@ -3551,7 +3557,8 @@ genCCall target dest_regs argsAndHints = do
                          )
 outOfLineFloatOp mop =
     do
-      mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+      dflags <- getDynFlagsNat
+      mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
 		  mkForeignLabel functionName Nothing True
       let mopLabelOrExpr = case mopExpr of
 			CmmLit (CmmLabel lbl) -> Left lbl
@@ -3651,8 +3658,8 @@ genCCall target dest_regs argsAndHints
                                                         (toOL []) []
                                                 
         (labelOrExpr, reduceToF32) <- case target of
-            CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
-            CmmForeignCall expr conv -> return  (Right expr, False)
+            CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
+            CmmCallee expr conv -> return  (Right expr, False)
             CmmPrim mop -> outOfLineFloatOp mop
                                                         
         let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
@@ -3806,7 +3813,8 @@ genCCall target dest_regs argsAndHints
                           
         outOfLineFloatOp mop =
             do
-                mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+                dflags <- getDynFlagsNat
+                mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
                               mkForeignLabel functionName Nothing True
                 let mopLabelOrExpr = case mopExpr of
                         CmmLit (CmmLabel lbl) -> Left lbl
@@ -3866,7 +3874,8 @@ genSwitch expr ids
   = do
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+        dflags <- getDynFlagsNat
+        dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let
             jumpTable = map jumpTableEntryRel ids
@@ -3920,7 +3929,8 @@ genSwitch expr ids
         (reg,e_code) <- getSomeReg expr
         tmp <- getNewRegNat I32
         lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+        dflags <- getDynFlagsNat
+        dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let
             jumpTable = map jumpTableEntryRel ids
@@ -4761,7 +4771,8 @@ coerceInt2FP fromRep toRep x = do
     lbl <- getNewLabelNat
     itmp <- getNewRegNat I32
     ftmp <- getNewRegNat F64
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let
     	code' dst = code `appOL` maybe_exts `appOL` toOL [