X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgBindery.lhs;h=b00aca77fa938b9e3cf311df6be5907c69b86891;hb=5cf27e8f1731c52fe63a5b9615f927484164c61b;hp=fbc2fc9e214d8ee2ab68616bffdd74962d300277;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs index fbc2fc9..b00aca7 100644 --- a/ghc/compiler/codeGen/CgBindery.lhs +++ b/ghc/compiler/codeGen/CgBindery.lhs @@ -8,7 +8,7 @@ module CgBindery ( CgBindings(..), CgIdInfo(..){-dubiously concrete-}, - StableLoc, VolatileLoc, LambdaFormInfo{-re-exported-}, + StableLoc, VolatileLoc, maybeAStkLoc, maybeBStkLoc, @@ -19,37 +19,39 @@ module CgBindery ( bindNewToAStack, bindNewToBStack, bindNewToNode, bindNewToReg, bindArgsToRegs, ---UNUSED: bindNewToSameAsOther, bindNewToTemp, bindNewPrimToAmode, - getAtomAmode, getAtomAmodes, + getArgAmode, getArgAmodes, getCAddrModeAndInfo, getCAddrMode, getCAddrModeIfVolatile, getVolatileRegs, - rebindToAStack, rebindToBStack, ---UNUSED: rebindToTemp, - - -- and to make a self-sufficient interface... - AbstractC, CAddrMode, HeapOffset, MagicId, CLabel, CgState, - BasicLit, IdEnv(..), UniqFM, - Id, Maybe, Unique, StgAtom, UniqSet(..) + rebindToAStack, rebindToBStack ) where -IMPORT_Trace -- ToDo: rm (debugging only) -import Outputable -import Unpretty -import PprAbsC +import Ubiq{-uitous-} +import CgLoop1 -- here for paranoia-checking import AbsCSyn import CgMonad import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset ) -import CLabelInfo ( mkClosureLabel, CLabel ) -import ClosureInfo -import Id ( getIdKind, toplevelishId, isDataCon, Id ) -import IdEnv -- used to build CgBindings -import Maybes ( catMaybes, Maybe(..) ) -import UniqSet -- ( setToList ) -import StgSyn -import Util +import CLabel ( mkClosureLabel ) +import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument ) +import HeapOffs ( VirtualHeapOffset(..), + VirtualSpAOffset(..), VirtualSpBOffset(..) + ) +import Id ( idPrimRep, toplevelishId, isDataCon, + mkIdEnv, rngIdEnv, IdEnv(..), + idSetToList, + GenId{-instance NamedThing-} + ) +import Maybes ( catMaybes ) +import Name ( isLocallyDefined ) +#ifdef DEBUG +import PprAbsC ( pprAmode ) +#endif +import PprStyle ( PprStyle(..) ) +import StgSyn ( StgArg(..), StgLiveVars(..), GenStgArg(..) ) +import Unpretty ( uppShow ) +import Util ( zipWithEqual, panic ) \end{code} @@ -92,7 +94,7 @@ data StableLoc = NoStableLoc | VirAStkLoc VirtualSpAOffset | VirBStkLoc VirtualSpBOffset - | LitLoc BasicLit + | LitLoc Literal | StableAmodeLoc CAddrMode -- these are so StableLoc can be abstract: @@ -123,14 +125,14 @@ newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo) newTempAmodeAndIdInfo name lf_info = (temp_amode, temp_idinfo) where - uniq = getTheUnique name - temp_amode = CTemp uniq (getIdKind name) + uniq = uniqueOf name + temp_amode = CTemp uniq (idPrimRep name) temp_idinfo = tempIdInfo name uniq lf_info -idInfoToAmode :: PrimKind -> CgIdInfo -> FCode CAddrMode +idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab -idInfoPiecesToAmode :: PrimKind -> VolatileLoc -> StableLoc -> FCode CAddrMode +idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind) idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id) @@ -156,7 +158,9 @@ idInfoPiecesToAmode kind NoVolatileLoc (VirBStkLoc i) = getSpBRelOffset i `thenFC` \ rel_spB -> returnFC (CVal rel_spB kind) +#ifdef DEBUG idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc" +#endif \end{code} %************************************************************************ @@ -204,7 +208,7 @@ getCAddrModeAndInfo name returnFC (amode, lf_info) where global_amode = CLbl (mkClosureLabel name) kind - kind = getIdKind name + kind = idPrimRep name getCAddrMode :: Id -> FCode CAddrMode getCAddrMode name @@ -220,7 +224,7 @@ getCAddrModeIfVolatile name = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) -> case stable_loc of NoStableLoc -> -- Aha! So it is volatile! - idInfoPiecesToAmode (getIdKind name) volatile_loc NoStableLoc `thenFC` \ amode -> + idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode -> returnFC (Just amode) a_stable_loc -> returnFC Nothing @@ -234,10 +238,10 @@ stable one (notably, on the stack), we modify the current bindings to forget the volatile one. \begin{code} -getVolatileRegs :: PlainStgLiveVars -> FCode [MagicId] +getVolatileRegs :: StgLiveVars -> FCode [MagicId] getVolatileRegs vars - = mapFCs snaffle_it (uniqSetToList vars) `thenFC` \ stuff -> + = mapFCs snaffle_it (idSetToList vars) `thenFC` \ stuff -> returnFC (catMaybes stuff) where snaffle_it var @@ -245,7 +249,7 @@ getVolatileRegs vars let -- commoned-up code... consider_reg reg - = if not (isVolatileReg reg) then + = if not (isVolatileReg reg) then -- Potentially dies across C calls -- For now, that's everything; we leave -- it to the save-macros to decide which @@ -254,7 +258,7 @@ getVolatileRegs vars else case stable_loc of NoStableLoc -> returnFC (Just reg) -- got one! - is_a_stable_loc -> + is_a_stable_loc -> -- has both volatile & stable locations; -- force it to rely on the stable location modifyBindC var nuke_vol_bind `thenC` @@ -271,17 +275,17 @@ getVolatileRegs vars \end{code} \begin{code} -getAtomAmodes :: [PlainStgAtom] -> FCode [CAddrMode] -getAtomAmodes [] = returnFC [] -getAtomAmodes (atom:atoms) - = getAtomAmode atom `thenFC` \ amode -> - getAtomAmodes atoms `thenFC` \ amodes -> +getArgAmodes :: [StgArg] -> FCode [CAddrMode] +getArgAmodes [] = returnFC [] +getArgAmodes (atom:atoms) + = getArgAmode atom `thenFC` \ amode -> + getArgAmodes atoms `thenFC` \ amodes -> returnFC ( amode : amodes ) -getAtomAmode :: PlainStgAtom -> FCode CAddrMode +getArgAmode :: StgArg -> FCode CAddrMode -getAtomAmode (StgVarAtom var) = getCAddrMode var -getAtomAmode (StgLitAtom lit) = returnFC (CLit lit) +getArgAmode (StgVarArg var) = getCAddrMode var +getArgAmode (StgLitArg lit) = returnFC (CLit lit) \end{code} %************************************************************************ @@ -336,25 +340,9 @@ bindNewToLit name lit bindArgsToRegs :: [Id] -> [MagicId] -> Code bindArgsToRegs args regs - = listCs (zipWith bind args regs) - where - arg `bind` reg = bindNewToReg arg reg mkLFArgument - -{- UNUSED: -bindNewToSameAsOther :: Id -> PlainStgAtom -> Code -bindNewToSameAsOther name (StgVarAtom old_name) -#ifdef DEBUG - | toplevelishId old_name = panic "bindNewToSameAsOther: global old name" - | otherwise -#endif - = lookupBindC old_name `thenFC` \ old_stuff -> - addBindC name old_stuff - -bindNewToSameAsOther name (StgLitAtom lit) - = addBindC name info + = listCs (zipWithEqual "bindArgsToRegs" bind args regs) where - info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (panic "bindNewToSameAsOther") --} + arg `bind` reg = bindNewToReg arg reg mkLFArgument \end{code} @bindNewPrimToAmode@ works only for certain addressing modes, because @@ -371,10 +359,10 @@ bindNewPrimToAmode name (CTemp uniq kind) bindNewPrimToAmode name (CLit lit) = bindNewToLit name lit -bindNewPrimToAmode name (CVal (SpBRel _ offset) _) +bindNewPrimToAmode name (CVal (SpBRel _ offset) _) = bindNewToBStack (name, offset) -bindNewPrimToAmode name (CVal (NodeRel offset) _) +bindNewPrimToAmode name (CVal (NodeRel offset) _) = bindNewToNode name offset (panic "bindNewPrimToAmode node") -- See comment on idInfoPiecesToAmode for VirNodeLoc @@ -398,19 +386,5 @@ rebindToBStack name offset where replace_stable_fn (MkCgIdInfo i vol stab einfo) = MkCgIdInfo i vol (VirBStkLoc offset) einfo - -{- UNUSED: -rebindToTemp :: Id -> FCode CAddrMode -rebindToTemp name - = let - (temp_amode, MkCgIdInfo _ new_vol _ _ {-LF info discarded-}) - = newTempAmodeAndIdInfo name (panic "rebindToTemp") - in - modifyBindC name (replace_volatile_fn new_vol) `thenC` - returnFC temp_amode - where - replace_volatile_fn new_vol (MkCgIdInfo i vol stab einfo) - = MkCgIdInfo i new_vol stab einfo --} \end{code}