Commit 3f279f37 authored by Jan Stolarek's avatar Jan Stolarek

Trailing whitespaces, code formatting, detabify

A major cleanup of trailing whitespaces and tabs in codeGen/
directory. I also adjusted code formatting in some places.
parent f661e79c
......@@ -50,12 +50,12 @@ import Control.Monad (when,void)
import Util
codeGen :: DynFlags
-> Module
-> [TyCon]
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [StgBinding] -- Bindings to convert
-> HpcInfo
-> Stream IO CmmGroup () -- Output as a stream, so codegen can
-> Module
-> [TyCon]
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [StgBinding] -- Bindings to convert
-> HpcInfo
-> Stream IO CmmGroup () -- Output as a stream, so codegen can
-- be interleaved with output
codeGen dflags this_mod data_tycons
......@@ -178,13 +178,13 @@ cgTopRhs rec bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
module in the program, and we don't want to require that this name
has the version and way info appended to it.
We initialise the module tree by keeping a work-stack,
We initialise the module tree by keeping a work-stack,
* pointed to by Sp
* that grows downward
* Sp points to the last occupied slot
-}
mkModuleInit
mkModuleInit
:: CollectedCCs -- cost centre info
-> Module
-> HpcInfo
......
......@@ -106,7 +106,7 @@ cgTopRhsClosure rec id ccs _ upd_flag args body
caffy = idCafInfo id
info_tbl = mkCmmInfo closure_info -- XXX short-cut
closure_rep = mkStaticClosureFields dflags info_tbl ccs caffy []
-- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
; emitDataLits closure_label closure_rep
; let fv_details :: [(NonVoid Id, VirtualHpOffset)]
......@@ -115,7 +115,7 @@ cgTopRhsClosure rec id ccs _ upd_flag args body
-- Don't drop the non-void args until the closure info has been made
; forkClosureBody (closureCodeBody True id closure_info ccs
(nonVoidIds args) (length args) body fv_details)
; return () }
unLit (CmmLit l) = l
......@@ -582,7 +582,7 @@ emitBlackHoleCode node = do
-- Eager blackholing is normally disabled, but can be turned on with
-- -feager-blackholing. When it is on, we replace the info pointer
-- of the thunk with stg_EAGER_BLACKHOLE_info on entry.
-- If we wanted to do eager blackholing with slop filling, we'd need
-- to do it at the *end* of a basic block, otherwise we overwrite
-- the free variables in the thunk that we still need. We have a
......@@ -593,7 +593,7 @@ emitBlackHoleCode node = do
-- on. But it didn't work, and it wasn't strictly necessary to bring
-- back minimal ticky-ticky, so now EAGER_BLACKHOLING is
-- unconditionally disabled. -- krc 1/2007
-- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
-- because emitBlackHoleCode is called from CmmParse.
......
This diff is collapsed.
......@@ -235,7 +235,7 @@ buildDynCon' dflags _ binder actually_bound ccs con args
use_cc -- cost-centre to stick in the object
| isCurrentCCS ccs = curCCS
| otherwise = panic "buildDynCon: non-current CCS not implemented"
blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
......
......@@ -20,8 +20,8 @@ module StgCmmEnv (
bindArgsToRegs, bindToReg, rebindToReg,
bindArgToReg, idToReg,
getArgAmode, getNonVoidArgAmodes,
getCgIdInfo,
maybeLetNoEscape,
getCgIdInfo,
maybeLetNoEscape,
) where
#include "HsVersions.h"
......@@ -114,7 +114,7 @@ addDynTag :: DynFlags -> CmmExpr -> DynTag -> CmmExpr
addDynTag dflags expr tag = cmmOffsetB dflags expr tag
cgIdInfoId :: CgIdInfo -> Id
cgIdInfoId = cg_id
cgIdInfoId = cg_id
cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
cgIdInfoLF = cg_lf
......@@ -127,8 +127,8 @@ maybeLetNoEscape _other = Nothing
---------------------------------------------------------
-- The binding environment
--
-- There are three basic routines, for adding (addBindC),
--
-- There are three basic routines, for adding (addBindC),
-- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
---------------------------------------------------------
......@@ -160,7 +160,7 @@ getCgIdInfo id
Nothing ->
-- Should be imported; make up a CgIdInfo for it
let
let
name = idName id
in
if isExternalName name then do
......@@ -168,10 +168,10 @@ getCgIdInfo id
dflags <- getDynFlags
return (litIdInfo dflags id (mkLFImported id) ext_lbl)
else
-- Bug
-- Bug
cgLookupPanic id
}}}}
cgLookupPanic :: Id -> FCode a
cgLookupPanic id
= do static_binds <- getStaticBinds
......@@ -192,7 +192,7 @@ getArgAmode (NonVoid (StgVarArg var)) =
getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit
getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
-- NB: Filters out void args,
-- NB: Filters out void args,
-- so the result list may be shorter than the argument list
getNonVoidArgAmodes [] = return []
getNonVoidArgAmodes (arg:args)
......@@ -214,7 +214,7 @@ bindToReg nvid@(NonVoid id) lf_info
return reg
rebindToReg :: NonVoid Id -> FCode LocalReg
-- Like bindToReg, but the Id is already in scope, so
-- Like bindToReg, but the Id is already in scope, so
-- get its LF info from the envt
rebindToReg nvid@(NonVoid id)
= do { info <- getCgIdInfo id
......@@ -233,7 +233,7 @@ idToReg :: DynFlags -> NonVoid Id -> LocalReg
-- We re-use the Unique from the Id to make it easier to see what is going on
--
-- By now the Ids should be uniquely named; else one would worry
-- about accidental collision
idToReg dflags (NonVoid id)
= LocalReg (idUnique id)
(case idPrimRep id of VoidRep -> pprPanic "idToReg" (ppr id)
......
......@@ -323,7 +323,7 @@ This special case handles code like
--> case tagToEnum# (a <$# b) of
True -> .. ; False -> ...
--> case (a <$# b) of r ->
--> case (a <$# b) of r ->
case tagToEnum# r of
True -> .. ; False -> ...
......
......@@ -12,7 +12,7 @@
module StgCmmExtCode (
CmmParse, unEC,
Named(..), Env,
loopDecls,
getEnv,
......@@ -50,13 +50,13 @@ import Unique
-- | The environment contains variable definitions or blockids.
data Named
data Named
= VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
-- eg, RtsLabel, ForeignLabel, CmmLabel etc.
-- eg, RtsLabel, ForeignLabel, CmmLabel etc.
| FunN PackageId -- ^ A function name from this package
| LabelN BlockId -- ^ A blockid of some code or data.
-- | An environment of named things.
type Env = UniqFM Named
......@@ -65,7 +65,7 @@ type Decls = [(FastString,Named)]
-- | Does a computation in the FCode monad, with a current environment
-- and a list of local declarations. Returns the resulting list of declarations.
newtype CmmParse a
newtype CmmParse a
= EC { unEC :: Env -> Decls -> FCode (Decls, a) }
type ExtCode = CmmParse ()
......@@ -86,7 +86,7 @@ instance HasDynFlags CmmParse where
-- | Takes the variable decarations and imports from the monad
-- and makes an environment, which is looped back into the computation.
-- and makes an environment, which is looped back into the computation.
-- In this way, we can have embedded declarations that scope over the whole
-- procedure, and imports that scope over the entire module.
-- Discards the local declaration contained within decl'
......@@ -107,8 +107,8 @@ addDecl :: FastString -> Named -> ExtCode
addDecl name named = EC $ \_ s -> return ((name, named) : s, ())
-- | Add a new variable to the list of local declarations.
-- The CmmExpr says where the value is stored.
-- | Add a new variable to the list of local declarations.
-- The CmmExpr says where the value is stored.
addVarDecl :: FastString -> CmmExpr -> ExtCode
addVarDecl var expr = addDecl var (VarN expr)
......@@ -118,11 +118,11 @@ addLabel name block_id = addDecl name (LabelN block_id)
-- | Create a fresh local variable of a given type.
newLocal
newLocal
:: CmmType -- ^ data type
-> FastString -- ^ name of variable
-> CmmParse LocalReg -- ^ register holding the value
newLocal ty name = do
u <- code newUnique
let reg = LocalReg u ty
......@@ -141,32 +141,32 @@ newBlockId :: CmmParse BlockId
newBlockId = code F.newLabelC
-- | Add add a local function to the environment.
newFunctionName
:: FastString -- ^ name of the function
newFunctionName
:: FastString -- ^ name of the function
-> PackageId -- ^ package of the current module
-> ExtCode
newFunctionName name pkg = addDecl name (FunN pkg)
-- | Add an imported foreign label to the list of local declarations.
-- If this is done at the start of the module the declaration will scope
-- over the whole module.
newImport
:: (FastString, CLabel)
newImport
:: (FastString, CLabel)
-> CmmParse ()
newImport (name, cmmLabel)
newImport (name, cmmLabel)
= addVarDecl name (CmmLit (CmmLabel cmmLabel))
-- | Lookup the BlockId bound to the label with this name.
-- If one hasn't been bound yet, create a fresh one based on the
-- If one hasn't been bound yet, create a fresh one based on the
-- Unique of the name.
lookupLabel :: FastString -> CmmParse BlockId
lookupLabel name = do
env <- getEnv
return $
return $
case lookupUFM env name of
Just (LabelN l) -> l
_other -> mkBlockId (newTagUnique (getUnique name) 'L')
......@@ -179,7 +179,7 @@ lookupLabel name = do
lookupName :: FastString -> CmmParse CmmExpr
lookupName name = do
env <- getEnv
return $
return $
case lookupUFM env name of
Just (VarN e) -> e
Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name))
......@@ -188,7 +188,7 @@ lookupName name = do
-- | Lift an FCode computation into the CmmParse monad
code :: FCode a -> CmmParse a
code fc = EC $ \_ s -> do
code fc = EC $ \_ s -> do
r <- fc
return (s, r)
......
......@@ -469,7 +469,7 @@ cannedGCEntryPoint dflags regs
W32 -> Just (mkGcLabel "stg_gc_f1")
W64 -> Just (mkGcLabel "stg_gc_d1")
_ -> Nothing
| width == wordWidth dflags -> Just (mkGcLabel "stg_gc_unbx_r1")
| width == W64 -> Just (mkGcLabel "stg_gc_l1")
| otherwise -> Nothing
......
......@@ -6,23 +6,16 @@
--
-----------------------------------------------------------------------------
{-# 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 StgCmmLayout (
mkArgDescr,
mkArgDescr,
emitCall, emitReturn, adjustHpBackwards,
emitClosureProcAndInfoTable,
emitClosureAndInfoTable,
emitClosureProcAndInfoTable,
emitClosureAndInfoTable,
slowCall, directCall,
slowCall, directCall,
mkVirtHeapOffsets, mkVirtConstrOffsets, getHpRelOffset, hpRel,
mkVirtHeapOffsets, mkVirtConstrOffsets, getHpRelOffset, hpRel,
ArgRep(..), toArgRep, argRepSizeW -- re-exported from StgCmmArgRep
) where
......@@ -47,8 +40,8 @@ import CLabel
import StgSyn
import Id
import Name
import TyCon ( PrimRep(..) )
import BasicTypes ( RepArity )
import TyCon ( PrimRep(..) )
import BasicTypes ( RepArity )
import DynFlags
import Module
......@@ -59,7 +52,7 @@ import FastString
import Control.Monad
------------------------------------------------------------------------
-- Call and return sequences
-- Call and return sequences
------------------------------------------------------------------------
-- | Return multiple values to the sequel
......@@ -108,10 +101,10 @@ emitCallWithExtraStack
:: (Convention, Convention) -> CmmExpr -> [CmmExpr]
-> [CmmExpr] -> FCode ReturnKind
emitCallWithExtraStack (callConv, retConv) fun args extra_stack
= do { dflags <- getDynFlags
= do { dflags <- getDynFlags
; adjustHpBackwards
; sequel <- getSequel
; updfr_off <- getUpdFrameOff
; sequel <- getSequel
; updfr_off <- getUpdFrameOff
; case sequel of
Return _ -> do
emit $ mkJumpExtra dflags callConv fun args updfr_off extra_stack
......@@ -129,33 +122,33 @@ emitCallWithExtraStack (callConv, retConv) fun args extra_stack
adjustHpBackwards :: FCode ()
-- This function adjusts and heap pointers just before a tail call or
-- return. At a call or return, the virtual heap pointer may be less
-- than the real Hp, because the latter was advanced to deal with
-- the worst-case branch of the code, and we may be in a better-case
-- branch. In that case, move the real Hp *back* and retract some
-- return. At a call or return, the virtual heap pointer may be less
-- than the real Hp, because the latter was advanced to deal with
-- the worst-case branch of the code, and we may be in a better-case
-- branch. In that case, move the real Hp *back* and retract some
-- ticky allocation count.
--
-- It *does not* deal with high-water-mark adjustment.
-- That's done by functions which allocate heap.
adjustHpBackwards
= do { hp_usg <- getHpUsage
; let rHp = realHp hp_usg
vHp = virtHp hp_usg
adjust_words = vHp -rHp
; new_hp <- getHpRelOffset vHp
= do { hp_usg <- getHpUsage
; let rHp = realHp hp_usg
vHp = virtHp hp_usg
adjust_words = vHp -rHp
; new_hp <- getHpRelOffset vHp
; emit (if adjust_words == 0
then mkNop
else mkAssign hpReg new_hp) -- Generates nothing when vHp==rHp
; emit (if adjust_words == 0
then mkNop
else mkAssign hpReg new_hp) -- Generates nothing when vHp==rHp
; tickyAllocHeap False adjust_words -- ...ditto
; tickyAllocHeap False adjust_words -- ...ditto
; setRealHp vHp
}
; setRealHp vHp
}
-------------------------------------------------------------------------
-- Making calls: directCall and slowCall
-- Making calls: directCall and slowCall
-------------------------------------------------------------------------
-- General plan is:
......@@ -183,7 +176,7 @@ directCall conv lbl arity stg_args
slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
-- (slowCall fun args) applies fun to args, returning the results to Sequel
slowCall fun stg_args
slowCall fun stg_args
= do { dflags <- getDynFlags
; argsreps <- getArgRepsAmodes stg_args
; let (rts_fun, arity) = slowCallPattern (map fst argsreps)
......@@ -299,13 +292,13 @@ slowArgs dflags args -- careful: reps contains voids (V), but args does not
save_cccs_lbl = mkCmmRetInfoLabel rtsPackageId (fsLit "stg_restore_cccs")
-------------------------------------------------------------------------
---- Laying out objects on the heap and stack
---- Laying out objects on the heap and stack
-------------------------------------------------------------------------
-- The heap always grows upwards, so hpRel is easy
hpRel :: VirtualHpOffset -- virtual offset of Hp
-> VirtualHpOffset -- virtual offset of The Thing
-> WordOff -- integer word offset
hpRel :: VirtualHpOffset -- virtual offset of Hp
-> VirtualHpOffset -- virtual offset of The Thing
-> WordOff -- integer word offset
hpRel hp off = off - hp
getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
......@@ -316,10 +309,10 @@ getHpRelOffset virtual_offset
mkVirtHeapOffsets
:: DynFlags
-> Bool -- True <=> is a thunk
-> [(PrimRep,a)] -- Things to make offsets for
-> (WordOff, -- _Total_ number of words allocated
WordOff, -- Number of words allocated for *pointers*
-> Bool -- True <=> is a thunk
-> [(PrimRep,a)] -- Things to make offsets for
-> (WordOff, -- _Total_ number of words allocated
WordOff, -- Number of words allocated for *pointers*
[(NonVoid a, VirtualHpOffset)])
-- Things with their offsets from start of object in order of
......@@ -333,10 +326,10 @@ mkVirtHeapOffsets
-- than the unboxed things
mkVirtHeapOffsets dflags is_thunk things
= let non_void_things = filterOut (isVoidRep . fst) things
(ptrs, non_ptrs) = partition (isGcPtrRep . fst) non_void_things
(wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
(tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
= let non_void_things = filterOut (isVoidRep . fst) things
(ptrs, non_ptrs) = partition (isGcPtrRep . fst) non_void_things
(wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
(tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
in
(tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
where
......@@ -344,8 +337,8 @@ mkVirtHeapOffsets dflags is_thunk things
| otherwise = fixedHdrSize dflags
computeOffset wds_so_far (rep, thing)
= (wds_so_far + argRepSizeW dflags (toArgRep rep),
(NonVoid thing, hdr_size + wds_so_far))
= (wds_so_far + argRepSizeW dflags (toArgRep rep),
(NonVoid thing, hdr_size + wds_so_far))
mkVirtConstrOffsets :: DynFlags -> [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)])
-- Just like mkVirtHeapOffsets, but for constructors
......@@ -354,11 +347,11 @@ mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False
-------------------------------------------------------------------------
--
-- Making argument descriptors
-- Making argument descriptors
--
-- An argument descriptor describes the layout of args on the stack,
-- both for * GC (stack-layout) purposes, and
-- * saving/restoring registers when a heap-check fails
-- both for * GC (stack-layout) purposes, and
-- * saving/restoring registers when a heap-check fails
--
-- Void arguments aren't important, therefore (contrast constructSlowCall)
--
......@@ -377,7 +370,7 @@ mkArgDescr _nm args
Just spec_id -> return (ArgSpec spec_id)
Nothing -> return (ArgGen arg_bits)
argBits :: DynFlags -> [ArgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits :: DynFlags -> [ArgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits _ [] = []
argBits dflags (P : args) = False : argBits dflags args
argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True)
......@@ -387,37 +380,37 @@ argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True)
stdPattern :: [ArgRep] -> Maybe Int
stdPattern reps
= case reps of
[] -> Just ARG_NONE -- just void args, probably
[N] -> Just ARG_N
[P] -> Just ARG_P
[F] -> Just ARG_F
[D] -> Just ARG_D
[L] -> Just ARG_L
[V16] -> Just ARG_V16
[N,N] -> Just ARG_NN
[N,P] -> Just ARG_NP
[P,N] -> Just ARG_PN
[P,P] -> Just ARG_PP
[N,N,N] -> Just ARG_NNN
[N,N,P] -> Just ARG_NNP
[N,P,N] -> Just ARG_NPN
[N,P,P] -> Just ARG_NPP
[P,N,N] -> Just ARG_PNN
[P,N,P] -> Just ARG_PNP
[P,P,N] -> Just ARG_PPN
[P,P,P] -> Just ARG_PPP
[P,P,P,P] -> Just ARG_PPPP
[P,P,P,P,P] -> Just ARG_PPPPP
[P,P,P,P,P,P] -> Just ARG_PPPPPP
_ -> Nothing
[] -> Just ARG_NONE -- just void args, probably
[N] -> Just ARG_N
[P] -> Just ARG_P
[F] -> Just ARG_F
[D] -> Just ARG_D
[L] -> Just ARG_L
[V16] -> Just ARG_V16
[N,N] -> Just ARG_NN
[N,P] -> Just ARG_NP
[P,N] -> Just ARG_PN
[P,P] -> Just ARG_PP
[N,N,N] -> Just ARG_NNN
[N,N,P] -> Just ARG_NNP
[N,P,N] -> Just ARG_NPN
[N,P,P] -> Just ARG_NPP
[P,N,N] -> Just ARG_PNN
[P,N,P] -> Just ARG_PNP
[P,P,N] -> Just ARG_PPN
[P,P,P] -> Just ARG_PPP
[P,P,P,P] -> Just ARG_PPPP
[P,P,P,P,P] -> Just ARG_PPPPP
[P,P,P,P,P,P] -> Just ARG_PPPPPP
_ -> Nothing
-------------------------------------------------------------------------
--
-- Generating the info table and code for a closure
-- Generating the info table and code for a closure
--
-------------------------------------------------------------------------
......@@ -427,7 +420,7 @@ stdPattern reps
-- When loading the free variables, a function closure pointer may be tagged,
-- so we must take it into account.
emitClosureProcAndInfoTable :: Bool -- top-level?
emitClosureProcAndInfoTable :: Bool -- top-level?
-> Id -- name of the closure
-> LambdaFormInfo
-> CmmInfoTable
......
......@@ -12,7 +12,7 @@ module StgCmmMonad (
initC, runC, thenC, thenFC, listCs,
returnFC, fixC,
newUnique, newUniqSupply,
newUnique, newUniqSupply,
newLabelC, emitLabel,
......@@ -46,7 +46,7 @@ module StgCmmMonad (
-- ideally we wouldn't export these, but some other modules access internal state
getState, setState, getInfoDown, getDynFlags, getThisPackage,
-- more localised access to monad state
-- more localised access to monad state
CgIdInfo(..), CgLoc(..),
getBinds, setBinds, getStaticBinds,
......@@ -132,7 +132,7 @@ returnFC :: a -> FCode a
returnFC val = FCode (\_info_down state -> (# val, state #))
thenC :: FCode () -> FCode a -> FCode a
thenC (FCode m) (FCode k) =
thenC (FCode m) (FCode k) =
FCode $ \info_down state -> case m info_down state of
(# _,new_state #) -> k info_down new_state
......@@ -141,7 +141,7 @@ listCs [] = return ()
listCs (fc:fcs) = do
fc
listCs fcs
thenFC :: FCode a -> (a -> FCode c) -> FCode c
thenFC (FCode m) k = FCode $
\info_down state ->
......@@ -152,7 +152,7 @@ thenFC (FCode m) k = FCode $
fixC :: (a -> FCode a) -> FCode a
fixC fcode = FCode (
\info_down state ->
\info_down state ->
let
(v,s) = doFCode (fcode v) info_down state
in
......@@ -163,8 +163,8 @@ fixC fcode = FCode (