Tag ForeignCalls with the package they correspond to

[ghc-hetmet.git] / compiler / nativeGen / X86 / CodeGen.hs

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 6cf871f..5941a8c 100644 (file)
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -27,7 +27,7 @@ where
 
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
 
 -- NCG stuff:
 import X86.Instr
@@ -204,11 +204,11 @@ swizzleRegisterRep (Any _ codefn)     size = Any   size codefn
 getRegisterReg :: CmmReg -> Reg
 
 getRegisterReg (CmmLocal (LocalReg u pk))
-  = mkVReg u (cmmTypeSize pk)
+  = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
 
 getRegisterReg (CmmGlobal mid)
   = case get_GlobalReg_reg_or_addr mid of
-       Left reg@(RegReal _) -> reg
+       Left reg -> RegReal $ reg
        _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
           -- By this stage, the only MagicIds remaining should be the
           -- ones which map to a real machine register on this
@@ -300,7 +300,7 @@ assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
    ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
    let 
-         r_dst_lo = mkVReg u_dst II32
+         r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
          r_dst_hi = getHiVRegFromLo r_dst_lo
          r_src_hi = getHiVRegFromLo r_src_lo
          mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo)
@@ -342,7 +342,7 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
      )
 
 iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
-   = return (ChildCode64 nilOL (mkVReg vu II32))
+   = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
          
 -- we handle addition, but rather badly
 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
@@ -1633,7 +1633,7 @@ genCCall target dest_regs args = do
                w  = typeWidth ty
                r_dest_hi = getHiVRegFromLo r_dest
                r_dest    = getRegisterReg (CmmLocal dest)
-       assign_code many = panic "genCCall.assign_code many"
+       assign_code many = pprPanic "genCCall.assign_code - too many return values:" (ppr many)
 
     return (push_code `appOL` 
            call `appOL` 
@@ -1781,9 +1781,7 @@ genCCall target dest_regs args = do
        assign_code [CmmHinted dest _hint] = 
          case typeWidth rep of
                W32 | isFloatType rep -> unitOL (MOV (floatSize W32) (OpReg xmm0) (OpReg r_dest))
-v v v v v v v
                W64 | isFloatType rep -> unitOL (MOV (floatSize W64) (OpReg xmm0) (OpReg r_dest))
-^ ^ ^ ^ ^ ^ ^
                _ -> unitOL (MOV (cmmTypeSize rep) (OpReg rax) (OpReg r_dest))
          where 
                rep = localRegType dest
@@ -1884,7 +1882,10 @@ outOfLineFloatOp mop res args
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where
-       lbl = mkForeignLabel fn Nothing False IsFunction
+       -- Assume we can call these functions directly, and that they're not in a dynamic library.
+       -- TODO: Why is this ok? Under linux this code will be in libm.so
+       --       Is is because they're really implemented as a primitive instruction by the assembler??  -- BL 2009/12/31 
+       lbl = mkForeignLabel fn Nothing ForeignLabelInThisPackage IsFunction
 
        fn = case mop of
              MO_F32_Sqrt  -> fsLit "sqrtf"