nonemptyAbsC,
mkAbstractCs, mkAbsCStmts,
mkAlgAltsCSwitch,
- kindFromMagicId,
+ magicIdPrimRep,
getAmodeRep, amodeCanSurviveGC,
mixedTypeLocn, mixedPtrLocn,
flattenAbsC,
mkAbsCStmtList
-- printing/forcing stuff comes from PprAbsC
-
- -- and for interface self-sufficiency...
) where
+IMP_Ubiq(){-uitous-}
+
import AbsCSyn
-import PrelInfo ( PrimOp(..)
- IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
- IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
- )
-import Literal ( literalPrimRep )
-import CLabel ( CLabel, mkReturnPtLabel, mkVecTblLabel )
+import CLabel ( mkReturnPtLabel )
import Digraph ( stronglyConnComp )
-import Id ( fIRST_TAG, ConTag(..), DataCon(..), Id )
-import Maybes ( Maybe(..) )
-import PrimRep ( getPrimRepSize, retPrimRepSize, PrimRep(..) )
-import UniqSupply
-import StgSyn ( GenStgArg )
+import HeapOffs ( possiblyEqualHeapOffset )
+import Id ( fIRST_TAG, SYN_IE(ConTag) )
+import Literal ( literalPrimRep, Literal(..) )
+import PrimRep ( getPrimRepSize, PrimRep(..) )
+import Unique ( Unique{-instance Eq-} )
+import UniqSupply ( getUnique, getUniques, splitUniqSupply )
+import Util ( panic )
infixr 9 `thenFlt`
\end{code}
mkAbsCStmts = AbsCStmts
{- Discarded SLPJ June 95; it calls nonemptyAbsC too much!
- = BIND (case (nonemptyAbsC abc2) of
+ = case (case (nonemptyAbsC abc2) of
Nothing -> AbsCNop
- Just d2 -> d2) _TO_ abc2b ->
+ Just d2 -> d2) of { abc2b ->
case (nonemptyAbsC abc1) of {
Nothing -> abc2b;
Just d1 -> AbsCStmts d1 abc2b
- } BEND
--}
-{-
- = case (nonemptyAbsC abc1) of
- Nothing -> abc2
- Just d1 -> AbsCStmts d1 abc2
--}
-{- old2:
- = case (nonemptyAbsC abc1) of
- Nothing -> case (nonemptyAbsC abc2) of
- Nothing -> AbsCNop
- Just d2 -> d2
- Just d1 -> AbsCStmts d1 abc2
--}
-{- old:
- if abc1_empty then
- if abc2_empty
- then AbsCNop
- else abc2
- else if {- abc1 not empty but -} abc2_empty then
- abc1
- else {- neither empty -}
- AbsCStmts abc1 abc2
- where
- abc1_empty = noAbsCcode abc1
- abc2_empty = noAbsCcode abc2
+ } }
-}
\end{code}
%************************************************************************
\begin{code}
-kindFromMagicId BaseReg = PtrRep
-kindFromMagicId StkOReg = PtrRep
-kindFromMagicId (VanillaReg kind _) = kind
-kindFromMagicId (FloatReg _) = FloatRep
-kindFromMagicId (DoubleReg _) = DoubleRep
-kindFromMagicId TagReg = IntRep
-kindFromMagicId RetReg = RetRep
-kindFromMagicId SpA = PtrRep
-kindFromMagicId SuA = PtrRep
-kindFromMagicId SpB = PtrRep
-kindFromMagicId SuB = PtrRep
-kindFromMagicId Hp = PtrRep
-kindFromMagicId HpLim = PtrRep
-kindFromMagicId LivenessReg = IntRep
-kindFromMagicId StdUpdRetVecReg = PtrRep
-kindFromMagicId StkStubReg = PtrRep
-kindFromMagicId CurCostCentre = CostCentreRep
-kindFromMagicId VoidReg = VoidRep
+magicIdPrimRep BaseReg = PtrRep
+magicIdPrimRep StkOReg = PtrRep
+magicIdPrimRep (VanillaReg kind _) = kind
+magicIdPrimRep (FloatReg _) = FloatRep
+magicIdPrimRep (DoubleReg _) = DoubleRep
+magicIdPrimRep TagReg = IntRep
+magicIdPrimRep RetReg = RetRep
+magicIdPrimRep SpA = PtrRep
+magicIdPrimRep SuA = PtrRep
+magicIdPrimRep SpB = PtrRep
+magicIdPrimRep SuB = PtrRep
+magicIdPrimRep Hp = PtrRep
+magicIdPrimRep HpLim = PtrRep
+magicIdPrimRep LivenessReg = IntRep
+magicIdPrimRep StdUpdRetVecReg = PtrRep
+magicIdPrimRep StkStubReg = PtrRep
+magicIdPrimRep CurCostCentre = CostCentreRep
+magicIdPrimRep VoidReg = VoidRep
\end{code}
%************************************************************************
getAmodeRep (CVal _ kind) = kind
getAmodeRep (CAddr _) = PtrRep
-getAmodeRep (CReg magic_id) = kindFromMagicId magic_id
+getAmodeRep (CReg magic_id) = magicIdPrimRep magic_id
getAmodeRep (CTemp uniq kind) = kind
getAmodeRep (CLbl label kind) = kind
getAmodeRep (CUnVecLbl _ _) = PtrRep
_ ->
-- de-anonymous-ise the code and push it (labelled) to the top level
getUniqFlt `thenFlt` \ new_uniq ->
- BIND (mkReturnPtLabel new_uniq) _TO_ return_pt_label ->
+ case (mkReturnPtLabel new_uniq) of { return_pt_label ->
flatAbsC abs_C `thenFlt` \ (body_code, tops) ->
returnFlt (
CLbl return_pt_label CodePtrRep,
tops `mkAbsCStmts` CCodeBlock return_pt_label body_code
-- DO NOT TOUCH the stuff sent to the top...
- )
- BEND
+ ) }
flatAmode (CTableEntry base index kind)
= flatAmode base `thenFlt` \ (base_amode, base_tops) ->