[project @ 1998-01-08 18:03:08 by simonm]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgRetConv.lhs

diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 856a119..d6342e2 100644 (file)
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -7,8 +7,6 @@ The datatypes and functions here encapsulate what there is to know
 about return conventions.
 
 \begin{code}
-#include "HsVersions.h"
-
 module CgRetConv (
        CtrlReturnConvention(..), DataReturnConvention(..),
 
@@ -20,29 +18,25 @@ module CgRetConv (
        assignPrimOpResultRegs,
        makePrimOpArgsRobust,
        assignRegs
-
-       -- and to make the interface self-sufficient...
     ) where
 
-import Ubiq{-uitous-}
-import AbsCLoop                -- paranoia checking
+#include "HsVersions.h"
 
 import AbsCSyn         -- quite a few things
 import AbsCUtils       ( mkAbstractCs, getAmodeRep,
                          amodeCanSurviveGC
                        )
-import CgCompInfo      ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
+import Constants       ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
                          mAX_Vanilla_REG, mAX_Float_REG,
                          mAX_Double_REG
                        )
 import CmdLineOpts     ( opt_ReturnInRegsThreshold )
-import Id              ( isDataCon, dataConSig,
-                         DataCon(..), GenId{-instance Eq-}
+import Id              ( isDataCon, dataConRawArgTys,
+                         DataCon, GenId{-instance Eq-},
+                         Id
                        )
 import Maybes          ( catMaybes )
-import PprStyle                ( PprStyle(..) )
 import PprType         ( TyCon{-instance Outputable-} )
-import PrelInfo                ( integerDataCon )
 import PrimOp          ( primOpCanTriggerGC,
                          getPrimOpResultInfo, PrimOpResultInfo(..),
                          PrimOp{-instance Outputable-}
@@ -50,9 +44,8 @@ import PrimOp         ( primOpCanTriggerGC,
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import TyCon           ( tyConDataCons, tyConFamilySize )
 import Type            ( typePrimRep )
-import Util            ( zipWithEqual, mapAccumL, isn'tIn,
-                         pprError, pprTrace, panic, assertPanic
-                       )
+import Util            ( zipWithEqual, mapAccumL, isn'tIn )
+import Outputable
 \end{code}
 
 %************************************************************************
@@ -95,7 +88,7 @@ ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 
 ctrlReturnConvAlg tycon
   = case (tyConFamilySize tycon) of
-      0 -> pprTrace "ctrlReturnConvAlg:" (ppr PprDebug tycon) $
+      0 -> pprTrace "ctrlReturnConvAlg:" (ppr tycon) $
           UnvectoredReturn 0 -- e.g., w/ "data Bin"
 
       size -> -- we're supposed to know...
@@ -119,18 +112,16 @@ then it gives up, returning @ReturnInHeap@.
 dataReturnConvAlg :: DataCon -> DataReturnConvention
 
 dataReturnConvAlg data_con
-  = ASSERT(isDataCon data_con)
+  = ASSERT2(isDataCon data_con, (ppr data_con))
     case leftover_kinds of
        []    ->        ReturnInRegs reg_assignment
        other ->        ReturnInHeap    -- Didn't fit in registers
   where
-    (_, _, arg_tys, _) = dataConSig data_con
+    arg_tys = dataConRawArgTys data_con
 
     (reg_assignment, leftover_kinds)
       = assignRegs [node, infoptr] -- taken...
                   (map typePrimRep arg_tys)
-
-    is_prim_result_ty = data_con == integerDataCon -- ***HACK***! (WDP 95/11)
 \end{code}
 
 %************************************************************************
@@ -158,7 +149,7 @@ dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep ILIT(1)
 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
 
 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
-dataReturnConvPrim MallocPtrRep = VanillaReg MallocPtrRep ILIT(1)
+dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
 
 #ifdef DEBUG
 dataReturnConvPrim PtrRep      = panic "dataReturnConvPrim: PtrRep"
@@ -207,8 +198,8 @@ argument into it).
 
 Bug: it is assumed that robust amodes cannot contain pointers.  This
 seems reasonable but isn't true.  For example, \tr{Array#}'s
-\tr{MallocPtr#}'s are pointers.  (This is only known to bite on
-\tr{_ccall_GC_} with a MallocPtr argument.)
+\tr{ForeignObj#}'s are pointers.  (This is only known to bite on
+\tr{_ccall_GC_} with a ForeignObj argument.)
 
 See after for some ADR comments...
 
@@ -232,7 +223,7 @@ makePrimOpArgsRobust op arg_amodes
                -- Check that all the args fit before returning arg_regs
        final_arg_regs = case extra_args of
                           []    -> arg_regs
-                          other -> pprError "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr PprDebug op)
+                          other -> pprPanic "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr op)
 
        arg_assts
          = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)