; code_stuff <- initC dflags this_mod $ do
{ cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
; cmm_tycons <- mapM cgTyCon data_tycons
; code_stuff <- initC dflags this_mod $ do
{ cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
; cmm_tycons <- mapM cgTyCon data_tycons
= do { -- Allocate the static boolean that records if this
-- module has been registered already
emitData Data [CmmDataLabel moduleRegdLabel,
CmmStaticLit zeroCLit]
= do { -- Allocate the static boolean that records if this
-- module has been registered already
emitData Data [CmmDataLabel moduleRegdLabel,
CmmStaticLit zeroCLit]
- this_pkg = thisPackage dflags
-
- plain_init_lbl = mkPlainModuleInitLabel this_pkg this_mod
- real_init_lbl = mkModuleInitLabel this_pkg this_mod way
- plain_main_init_lbl = mkPlainModuleInitLabel this_pkg rOOT_MAIN
+ plain_init_lbl = mkPlainModuleInitLabel this_mod
+ real_init_lbl = mkModuleInitLabel this_mod way
+ plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
| mod == gHC_PRIM
= nopC
| otherwise -- Push the init procedure onto the work stack
= stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
| mod == gHC_PRIM
= nopC
| otherwise -- Push the init procedure onto the work stack
= stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
cgTopBinding dflags (StgNonRec id rhs, srts)
= do { id' <- maybeExternaliseId dflags id
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
cgTopBinding dflags (StgNonRec id rhs, srts)
= do { id' <- maybeExternaliseId dflags id
; (id,info) <- cgTopRhs id' rhs
; addBindC id info -- Add the *un-externalised* Id to the envt,
-- so we find it when we look up occurrences
; (id,info) <- cgTopRhs id' rhs
; addBindC id info -- Add the *un-externalised* Id to the envt,
-- so we find it when we look up occurrences
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
; _new_binds <- fixC (\ new_binds -> do
{ addBindsC new_binds
; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
; nopC }
; _new_binds <- fixC (\ new_binds -> do
{ addBindsC new_binds
; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
; nopC }
-mkSRT :: PackageId -> [Id] -> (Id,[Id]) -> Code
-mkSRT this_pkg these (id,[]) = nopC
-mkSRT this_pkg these (id,ids)
+mkSRT :: [Id] -> (Id,[Id]) -> Code
+mkSRT these (id,[]) = nopC
+mkSRT these (id,ids)
cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
= ASSERT(null fvs) -- There should be no free variables
cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
= ASSERT(null fvs) -- There should be no free variables
- setSRTLabel (mkSRTLabel (idName bndr)) $
- forkStatics (cgTopRhsClosure bndr cc bi srt upd_flag args body)
+ setSRTLabel (mkSRTLabel (idName bndr)) $
+ setSRT srt $
+ forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)