Merging in the new codegen branch
[ghc-hetmet.git] / compiler / codeGen / CgForeignCall.hs
index e9a542e..6e33806 100644 (file)
@@ -24,8 +24,6 @@ module CgForeignCall (
   emitOpenNursery,
  ) where
 
-#include "HsVersions.h"
-
 import StgSyn
 import CgProf
 import CgBindery
@@ -36,7 +34,6 @@ import TysPrim
 import CLabel
 import Cmm
 import CmmUtils
-import MachOp
 import SMRep
 import ForeignCall
 import ClosureInfo
@@ -51,7 +48,7 @@ import Control.Monad
 -- Code generation for Foreign Calls
 
 cgForeignCall
-       :: CmmFormals   -- where to put the results
+       :: HintedCmmFormals     -- where to put the results
        -> ForeignCall          -- the op
        -> [StgArg]             -- arguments
        -> StgLiveVars  -- live vars, in case we need to save them
@@ -66,13 +63,13 @@ cgForeignCall results fcall stg_args live
                       nonVoidArg rep]
 
        arg_hints = zipWith CmmHinted
-                      arg_exprs (map (typeHint.stgArgType) stg_args)
+                      arg_exprs (map (typeForeignHint.stgArgType) stg_args)
   -- in
   emitForeignCall results fcall arg_hints live
 
 
 emitForeignCall
-       :: CmmFormals   -- where to put the results
+       :: HintedCmmFormals     -- where to put the results
        -> ForeignCall          -- the op
        -> [CmmHinted CmmExpr] -- arguments
        -> StgLiveVars  -- live vars, in case we need to save them
@@ -95,11 +92,11 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
        -- attach this info to the CLabel here, and the CLabel pretty printer
        -- will generate the suffix when the label is printed.
       call_size
-       | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.hintlessCmm) args))
+       | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprType.hintlessCmm) args))
        | otherwise            = Nothing
 
        -- ToDo: this might not be correct for 64-bit API
-      arg_size rep = max (machRepByteWidth rep) wORD_SIZE
+      arg_size rep = max (widthInBytes (typeWidth rep)) wORD_SIZE
 
 emitForeignCall _ (DNCall _) _ _
   = panic "emitForeignCall: DNCall"
@@ -108,7 +105,7 @@ emitForeignCall _ (DNCall _) _ _
 -- alternative entry point, used by CmmParse
 emitForeignCall'
        :: Safety
-       -> CmmFormals   -- where to put the results
+       -> HintedCmmFormals     -- where to put the results
        -> CmmCallTarget        -- the op
        -> [CmmHinted CmmExpr] -- arguments
        -> Maybe [GlobalReg]    -- live vars, in case we need to save them
@@ -126,8 +123,8 @@ emitForeignCall' safety results target args vols srt ret
   | otherwise = do
     -- Both 'id' and 'new_base' are GCKindNonPtr because they're
     -- RTS only objects and are not subject to garbage collection
-    id <- newNonPtrTemp wordRep
-    new_base <- newNonPtrTemp (cmmRegRep (CmmGlobal BaseReg))
+    id <- newTemp bWord
+    new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
     temp_args <- load_args_into_temps args
     temp_target <- load_target_into_temp target
     let (caller_save, caller_load) = callerSaveVolatileRegs vols
@@ -136,16 +133,16 @@ emitForeignCall' safety results target args vols srt ret
     -- The CmmUnsafe arguments are only correct because this part
     -- of the code hasn't been moved into the CPS pass yet.
     -- Once that happens, this function will just emit a (CmmSafe srt) call,
-    -- and the CPS will will be the one to convert that
+    -- and the CPS will be the one to convert that
     -- to this sequence of three CmmUnsafe calls.
     stmtC (CmmCall (CmmCallee suspendThread CCallConv) 
-                       [ CmmHinted id PtrHint ]
-                       [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ] 
+                       [ CmmHinted id AddrHint ]
+                       [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint ] 
                        CmmUnsafe ret)
     stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
     stmtC (CmmCall (CmmCallee resumeThread CCallConv) 
-                       [ CmmHinted new_base PtrHint ]
-                       [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ]
+                       [ CmmHinted new_base AddrHint ]
+                       [ CmmHinted (CmmReg (CmmLocal id)) AddrHint ]
                        CmmUnsafe ret)
     -- Assign the result to BaseReg: we
     -- might now have a different Capability!
@@ -153,8 +150,8 @@ emitForeignCall' safety results target args vols srt ret
     stmtsC caller_load
     emitLoadThreadState
 
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread")))
+resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread")))
 
 
 -- we might need to load arguments into temporaries before
@@ -181,7 +178,7 @@ maybe_assign_temp e
        -- don't use assignTemp, it uses its own notion of "trivial"
        -- expressions, which are wrong here.
         -- this is a NonPtr because it only duplicates an existing
-       reg <- newNonPtrTemp (cmmExprRep e) --TODO FIXME NOW
+       reg <- newTemp (cmmExprType e) --TODO FIXME NOW
        stmtC (CmmAssign (CmmLocal reg) e)
        return (CmmReg (CmmLocal reg))
 
@@ -203,13 +200,13 @@ emitSaveThreadState = do
 emitCloseNursery = stmtC $ CmmStore nursery_bdescr_free (cmmOffsetW stgHp 1)
 
 emitLoadThreadState = do
-  tso <- newNonPtrTemp wordRep -- TODO FIXME NOW
+  tso <- newTemp bWord -- TODO FIXME NOW
   stmtsC [
        -- tso = CurrentTSO;
        CmmAssign (CmmLocal tso) stgCurrentTSO,
        -- Sp = tso->sp;
        CmmAssign sp (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_SP)
-                             wordRep),
+                             bWord),
        -- SpLim = tso->stack + RESERVED_STACK_WORDS;
        CmmAssign spLim (cmmOffsetW (cmmOffset (CmmReg (CmmLocal tso)) tso_STACK)
                                    rESERVED_STACK_WORDS)
@@ -218,21 +215,21 @@ emitLoadThreadState = do
   -- and load the current cost centre stack from the TSO when profiling:
   when opt_SccProfilingOn $
        stmtC (CmmStore curCCSAddr 
-               (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) wordRep))
+               (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) bWord))
 
 emitOpenNursery = stmtsC [
         -- Hp = CurrentNursery->free - 1;
-       CmmAssign hp (cmmOffsetW (CmmLoad nursery_bdescr_free wordRep) (-1)),
+       CmmAssign hp (cmmOffsetW (CmmLoad nursery_bdescr_free gcWord) (-1)),
 
         -- HpLim = CurrentNursery->start + 
        --              CurrentNursery->blocks*BLOCK_SIZE_W - 1;
        CmmAssign hpLim
            (cmmOffsetExpr
-               (CmmLoad nursery_bdescr_start wordRep)
+               (CmmLoad nursery_bdescr_start bWord)
                (cmmOffset
                  (CmmMachOp mo_wordMul [
-                   CmmMachOp (MO_S_Conv I32 wordRep)
-                     [CmmLoad nursery_bdescr_blocks I32],
+                   CmmMachOp (MO_SS_Conv W32 wordWidth)
+                     [CmmLoad nursery_bdescr_blocks b32],
                    CmmLit (mkIntCLit bLOCK_SIZE)
                   ])
                  (-1)