Commit 0ca75749 authored by Simon Marlow's avatar Simon Marlow
Browse files

remove tabs

parent d421b169
......@@ -6,13 +6,6 @@
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module StgCmm ( codeGen ) where
#define FAST_STRING_NOT_NEEDED
......@@ -56,11 +49,11 @@ import Control.Monad (when,void)
import Util
codeGen :: DynFlags
-> Module
-> [TyCon]
-> Module
-> [TyCon]
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
-> HpcInfo
-> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
-> HpcInfo
-> Stream IO CmmGroup () -- Output as a stream, so codegen can
-- be interleaved with output
......@@ -108,7 +101,7 @@ codeGen dflags this_mod data_tycons
}
---------------------------------------------------------------
-- Top-level bindings
-- Top-level bindings
---------------------------------------------------------------
{- 'cgTopBinding' is only used for top-level bindings, since they need
......@@ -123,17 +116,17 @@ variable. -}
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode ()
cgTopBinding dflags (StgNonRec id rhs, _srts)
= do { id' <- maybeExternaliseId dflags id
= do { id' <- maybeExternaliseId dflags id
; (info, fcode) <- cgTopRhs id' rhs
; fcode
; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
-- so we find it when we look up occurrences
-- so we find it when we look up occurrences
}
cgTopBinding dflags (StgRec pairs, _srts)
= do { let (bndrs, rhss) = unzip pairs
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
; let pairs' = zip bndrs' rhss
; r <- sequence $ unzipWith cgTopRhs pairs'
; let (infos, fcodes) = unzip r
; addBindsC infos
......@@ -142,8 +135,8 @@ cgTopBinding dflags (StgRec pairs, _srts)
cgTopRhs :: Id -> StgRhs -> FCode (CgIdInfo, FCode ())
-- The Id is passed along for setting up a binding...
-- It's already been externalised if necessary
-- The Id is passed along for setting up a binding...
-- It's already been externalised if necessary
cgTopRhs bndr (StgRhsCon _cc con args)
= forkStatics (cgTopRhsCon bndr con args)
......@@ -155,18 +148,18 @@ cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
---------------------------------------------------------------
-- Module initialisation code
-- Module initialisation code
---------------------------------------------------------------
{- The module initialisation code looks like this, roughly:
FN(__stginit_Foo) {
JMP_(__stginit_Foo_1_p)
}
FN(__stginit_Foo) {
JMP_(__stginit_Foo_1_p)
}
FN(__stginit_Foo_1_p) {
...
}
FN(__stginit_Foo_1_p) {
...
}
We have one version of the init code with a module version and the
'way' attached to it. The version number helps to catch cases
......@@ -186,16 +179,16 @@ cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
has the version and way info appended to it.
We initialise the module tree by keeping a work-stack,
* pointed to by Sp
* that grows downward
* Sp points to the last occupied slot
* pointed to by Sp
* that grows downward
* Sp points to the last occupied slot
-}
mkModuleInit
:: CollectedCCs -- cost centre info
-> Module
-> Module
-> HpcInfo
-> FCode ()
-> FCode ()
mkModuleInit cost_centre_info this_mod hpc_info
= do { initHpc this_mod hpc_info
......@@ -207,7 +200,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
---------------------------------------------------------------
-- Generating static stuff for algebraic data types
-- Generating static stuff for algebraic data types
---------------------------------------------------------------
......@@ -223,11 +216,11 @@ cgDataCon :: DataCon -> FCode ()
-- Generate the entry code, info tables, and (for niladic constructor)
-- the static closure, for a constructor.
cgDataCon data_con
= do { dflags <- getDynFlags
= do { dflags <- getDynFlags
; let
(tot_wds, -- #ptr_wds + #nonptr_wds
ptr_wds, -- #ptr_wds
arg_things) = mkVirtConstrOffsets dflags arg_reps
ptr_wds, -- #ptr_wds
arg_things) = mkVirtConstrOffsets dflags arg_reps
nonptr_wds = tot_wds - ptr_wds
......@@ -238,29 +231,29 @@ cgDataCon data_con
= emitClosureAndInfoTable info_tbl NativeDirectCall []
$ mk_code ticky_code
mk_code ticky_code
= -- NB: We don't set CC when entering data (WDP 94/06)
do { _ <- ticky_code
; ldvEnter (CmmReg nodeReg)
; tickyReturnOldCon (length arg_things)
mk_code ticky_code
= -- NB: We don't set CC when entering data (WDP 94/06)
do { _ <- ticky_code
; ldvEnter (CmmReg nodeReg)
; tickyReturnOldCon (length arg_things)
; void $ emitReturn [cmmOffsetB (CmmReg nodeReg)
(tagForCon data_con)]
}
-- The case continuation code expects a tagged pointer
arg_reps :: [(PrimRep, UnaryType)]
arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
arg_reps :: [(PrimRep, UnaryType)]
arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
-- Dynamic closure code for non-nullary constructors only
; whenC (not (isNullaryRepDataCon data_con))
-- Dynamic closure code for non-nullary constructors only
; whenC (not (isNullaryRepDataCon data_con))
(emit_info dyn_info_tbl tickyEnterDynCon)
-- Dynamic-Closure first, to reduce forward references
-- Dynamic-Closure first, to reduce forward references
; emit_info sta_info_tbl tickyEnterStaticCon }
---------------------------------------------------------------
-- Stuff to support splitting
-- Stuff to support splitting
---------------------------------------------------------------
-- If we're splitting the object, we need to externalise all the
......@@ -269,17 +262,17 @@ cgDataCon data_con
maybeExternaliseId :: DynFlags -> Id -> FCode Id
maybeExternaliseId dflags id
| dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
| dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
isInternalName name = do { mod <- getModuleName
; returnFC (setIdName id (externalise mod)) }
| otherwise = returnFC id
; returnFC (setIdName id (externalise mod)) }
| otherwise = returnFC id
where
externalise mod = mkExternalName uniq mod new_occ loc
name = idName id
uniq = nameUnique name
new_occ = mkLocalOcc uniq (nameOccName name)
loc = nameSrcSpan name
-- We want to conjure up a name that can't clash with any
-- existing name. So we generate
-- Mod_$L243foo
-- where 243 is the unique.
-- We want to conjure up a name that can't clash with any
-- existing name. So we generate
-- Mod_$L243foo
-- where 243 is the unique.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment