X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=3a446c0641d76b4134b7c42c8d5c8dedb48b2ece;hb=beded1205911615ac7c1cd175def682eaf8daa1e;hp=3abe820c9e638994de3bdc1f5bfd91a1f75ff99c;hpb=b71b86cf18374f8011120c92e24ca293986e86ea;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index 3abe820..3a446c0 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -32,6 +32,7 @@ import PositionIndependentCode
 import RegAllocInfo ( mkBranchInstr )
 
 -- Our intermediate code:
+import BlockId
 import PprCmm		( pprExpr )
 import Cmm
 import MachOp
@@ -131,6 +132,8 @@ stmtToInstrs stmt = case stmt of
     CmmCondBranch arg id  -> genCondJump id arg
     CmmSwitch arg ids     -> genSwitch arg ids
     CmmJump arg params	  -> genJump arg
+    CmmReturn params	  ->
+      panic "stmtToInstrs: return statement should have been cps'd away"
 
 -- -----------------------------------------------------------------------------
 -- General things for putting together code sequences
@@ -3050,18 +3053,20 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
 
 -- we only cope with a single result for foreign calls
 genCCall (CmmPrim op) [CmmKinded r _] args = do
+  l1 <- getNewLabelNat
+  l2 <- getNewLabelNat
   case op of
 	MO_F32_Sqrt -> actuallyInlineFloatOp F32  (GSQRT F32) args
 	MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
 	
-	MO_F32_Sin  -> actuallyInlineFloatOp F32  (GSIN F32) args
-	MO_F64_Sin  -> actuallyInlineFloatOp F64 (GSIN F64) args
+	MO_F32_Sin  -> actuallyInlineFloatOp F32  (GSIN F32 l1 l2) args
+	MO_F64_Sin  -> actuallyInlineFloatOp F64 (GSIN F64 l1 l2) args
 	
-	MO_F32_Cos  -> actuallyInlineFloatOp F32  (GCOS F32) args
-	MO_F64_Cos  -> actuallyInlineFloatOp F64 (GCOS F64) args
+	MO_F32_Cos  -> actuallyInlineFloatOp F32  (GCOS F32 l1 l2) args
+	MO_F64_Cos  -> actuallyInlineFloatOp F64 (GCOS F64 l1 l2) args
 	
-	MO_F32_Tan  -> actuallyInlineFloatOp F32  (GTAN F32) args
-	MO_F64_Tan  -> actuallyInlineFloatOp F64 (GTAN F64) args
+	MO_F32_Tan  -> actuallyInlineFloatOp F32  (GTAN F32 l1 l2) args
+	MO_F64_Tan  -> actuallyInlineFloatOp F64 (GTAN F64 l1 l2) args
 	
 	other_op    -> outOfLineFloatOp op r args
  where