X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=b29b59e8bbc69fe167fbf1f81e9a324f32ce5f05;hb=6e1e37433632160a73d30ad785476a1ef0ba14a8;hp=39e0ac6c42c884767c1b2651b9c26ceadbca5f5b;hpb=bd3a364da7956c269d31645995d0d775c52f6a84;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index 39e0ac6..b29b59e 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -29,6 +29,7 @@ import PprCmm		( pprExpr )
 import Cmm
 import MachOp
 import CLabel
+import ClosureInfo	( C_SRT(..) )
 
 -- The rest:
 import StaticFlags	( opt_PIC )
@@ -41,7 +42,6 @@ import FastTypes	( isFastTrue )
 import Constants	( wORD_SIZE )
 
 #ifdef DEBUG
-import Outputable	( assertPanic )
 import Debug.Trace	( trace )
 #endif
 
@@ -61,7 +61,7 @@ import Data.Int
 
 type InstrBlock = OrdList Instr
 
-cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
+cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop]
 cmmTopCodeGen (CmmProc info lab params blocks) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
@@ -119,7 +119,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
@@ -188,7 +188,7 @@ assignMem_I64Code addrTree valueTree = do
   return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
 
 
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
+assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do
    ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
    let 
          r_dst_lo = mkVReg u_dst I32
@@ -230,7 +230,7 @@ iselExpr64 (CmmLoad addrTree I64) = do
                         rlo
      )
 
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
    = return (ChildCode64 nilOL (mkVReg vu I32))
          
 -- we handle addition, but rather badly
@@ -369,7 +369,7 @@ assignMem_I64Code addrTree valueTree = do
 	-- in
 	return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
 
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
+assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do
    ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
    let 
          r_dst_lo = mkVReg u_dst I32
@@ -399,7 +399,7 @@ iselExpr64 (CmmLoad addrTree I64) = do
     return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) 
                          rlo
 
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
    = return (ChildCode64 nilOL (mkVReg vu I32))
 
 iselExpr64 (CmmLit (CmmInt i _)) = do
@@ -476,7 +476,7 @@ getSomeReg expr = do
 
 getRegisterReg :: CmmReg -> Reg
 
-getRegisterReg (CmmLocal (LocalReg u pk))
+getRegisterReg (CmmLocal (LocalReg u pk _))
   = mkVReg u pk
 
 getRegisterReg (CmmGlobal mid)
@@ -2938,8 +2938,8 @@ genCondJump id bool = do
 
 genCCall
     :: CmmCallTarget		-- function to call
-    -> [(CmmReg,MachHint)]	-- where to put the result
-    -> [(CmmExpr,MachHint)]	-- arguments (of mixed type)
+    -> CmmHintFormals		-- where to put the result
+    -> CmmActuals		-- arguments (of mixed type)
     -> NatM InstrBlock
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -3042,7 +3042,7 @@ genCCall (CmmPrim op) [(r,_)] args = do
   actuallyInlineFloatOp rep instr [(x,_)]
 	= do res <- trivialUFCode rep instr x
 	     any <- anyReg res
- 	     return (any (getRegisterReg r))
+ 	     return (any (getRegisterReg (CmmLocal r)))
 
 genCCall target dest_regs args = do
     let
@@ -3107,8 +3107,8 @@ genCCall target dest_regs args = do
 		rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
 	  where 
 		r_dest_hi = getHiVRegFromLo r_dest
-		rep = cmmRegRep dest
-		r_dest = getRegisterReg dest
+		rep = localRegRep dest
+		r_dest = getRegisterReg (CmmLocal dest)
 	assign_code many = panic "genCCall.assign_code many"
 
     return (push_code `appOL` 
@@ -3172,23 +3172,23 @@ genCCall target dest_regs args = do
 
 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 
-outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
+outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
   -> NatM InstrBlock
 outOfLineFloatOp mop res args
   = do
       targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
       let target = CmmForeignCall targetExpr CCallConv
         
-      if cmmRegRep res == F64
+      if localRegRep res == F64
         then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args)  
+          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
         else do
           uq <- getUniqueNat
           let 
-            tmp = CmmLocal (LocalReg uq F64)
+            tmp = LocalReg uq F64 KindNonPtr
           -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args)
-          code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
+          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+          code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where
 	lbl = mkForeignLabel fn Nothing False
@@ -3322,8 +3322,8 @@ genCCall target dest_regs args = do
 		F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
 		rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest))
 	  where 
-		rep = cmmRegRep dest
-		r_dest = getRegisterReg dest
+		rep = localRegRep dest
+		r_dest = getRegisterReg (CmmLocal dest)
 	assign_code many = panic "genCCall.assign_code many"
 
     return (load_args_code 	`appOL` 
@@ -3618,7 +3618,7 @@ outOfLineFloatOp mop =
 -}
 
 
-genCCall (CmmPrim MO_WriteBarrier) _ _ _
+genCCall (CmmPrim MO_WriteBarrier) _ _ 
  = return $ unitOL LWSYNC
 
 genCCall target dest_regs argsAndHints
@@ -3782,8 +3782,8 @@ genCCall target dest_regs argsAndHints
                     | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
                                           MR r_dest r4]
                     | otherwise -> unitOL (MR r_dest r3)
-                    where rep = cmmRegRep dest
-                          r_dest = getRegisterReg dest
+                    where rep = cmmRegRep (CmmLocal dest)
+                          r_dest = getRegisterReg (CmmLocal dest)
                           
         outOfLineFloatOp mop =
             do