Typos in comments
[ghc.git] / compiler / main / StaticPtrTable.hs
1 -- | Code generation for the Static Pointer Table
2 --
3 -- (c) 2014 I/O Tweag
4 --
5 -- Each module that uses 'static' keyword declares an initialization function of
6 -- the form hs_spt_init_<module>() which is emitted into the _stub.c file and
7 -- annotated with __attribute__((constructor)) so that it gets executed at
8 -- startup time.
9 --
10 -- The function's purpose is to call hs_spt_insert to insert the static
11 -- pointers of this module in the hashtable of the RTS, and it looks something
12 -- like this:
13 --
14 -- > static void hs_hpc_init_Main(void) __attribute__((constructor));
15 -- > static void hs_hpc_init_Main(void) {
16 -- >
17 -- > static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
18 -- > extern StgPtr Main_r2wb_closure;
19 -- > hs_spt_insert(k0, &Main_r2wb_closure);
20 -- >
21 -- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
22 -- > extern StgPtr Main_r2wc_closure;
23 -- > hs_spt_insert(k1, &Main_r2wc_closure);
24 -- >
25 -- > }
26 --
27 -- where the constants are fingerprints produced from the static forms.
28 --
29 -- The linker must find the definitions matching the @extern StgPtr <name>@
30 -- declarations. For this to work, the identifiers of static pointers need to be
31 -- exported. This is done in TidyPgm.chooseExternalIds.
32 --
33 -- There is also a finalization function for the time when the module is
34 -- unloaded.
35 --
36 -- > static void hs_hpc_fini_Main(void) __attribute__((destructor));
37 -- > static void hs_hpc_fini_Main(void) {
38 -- >
39 -- > static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
40 -- > hs_spt_remove(k0);
41 -- >
42 -- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
43 -- > hs_spt_remove(k1);
44 -- >
45 -- > }
46 --
47
48 {-# LANGUAGE ViewPatterns #-}
49 module StaticPtrTable (sptModuleInitCode) where
50
51 -- See SimplCore Note [Grand plan for static forms]
52
53 import CLabel
54 import CoreSyn
55 import DataCon
56 import Id
57 import Literal
58 import Module
59 import Outputable
60 import PrelNames
61
62 import Data.Maybe
63 import GHC.Fingerprint
64
65 -- | @sptModuleInitCode module binds@ is a C stub to insert the static entries
66 -- found in @binds@ of @module@ into the static pointer table.
67 --
68 -- A bind is considered a static entry if it is an application of the
69 -- data constructor @StaticPtr@.
70 --
71 sptModuleInitCode :: Module -> CoreProgram -> SDoc
72 sptModuleInitCode this_mod binds =
73 sptInitCode $ catMaybes
74 $ map (\(b, e) -> ((,) b) <$> staticPtrFp e)
75 $ flattenBinds binds
76 where
77 staticPtrFp :: CoreExpr -> Maybe Fingerprint
78 staticPtrFp (collectTyBinders -> (_, e))
79 | (Var v, _ : Lit lit0 : Lit lit1 : _) <- collectArgs e
80 , Just con <- isDataConId_maybe v
81 , dataConName con == staticPtrDataConName
82 , Just w0 <- fromPlatformWord64Rep lit0
83 , Just w1 <- fromPlatformWord64Rep lit1
84 = Just $ Fingerprint (fromInteger w0) (fromInteger w1)
85 staticPtrFp _ = Nothing
86
87 fromPlatformWord64Rep (MachWord w) = Just w
88 fromPlatformWord64Rep (MachWord64 w) = Just w
89 fromPlatformWord64Rep _ = Nothing
90
91 sptInitCode :: [(Id, Fingerprint)] -> SDoc
92 sptInitCode [] = Outputable.empty
93 sptInitCode entries = vcat
94 [ text "static void hs_spt_init_" <> ppr this_mod
95 <> text "(void) __attribute__((constructor));"
96 , text "static void hs_spt_init_" <> ppr this_mod <> text "(void)"
97 , braces $ vcat $
98 [ text "static StgWord64 k" <> int i <> text "[2] = "
99 <> pprFingerprint fp <> semi
100 $$ text "extern StgPtr "
101 <> (ppr $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
102 $$ text "hs_spt_insert" <> parens
103 (hcat $ punctuate comma
104 [ char 'k' <> int i
105 , char '&' <> ppr (mkClosureLabel (idName n) (idCafInfo n))
106 ]
107 )
108 <> semi
109 | (i, (n, fp)) <- zip [0..] entries
110 ]
111 , text "static void hs_spt_fini_" <> ppr this_mod
112 <> text "(void) __attribute__((destructor));"
113 , text "static void hs_spt_fini_" <> ppr this_mod <> text "(void)"
114 , braces $ vcat $
115 [ text "StgWord64 k" <> int i <> text "[2] = "
116 <> pprFingerprint fp <> semi
117 $$ text "hs_spt_remove" <> parens (char 'k' <> int i) <> semi
118 | (i, (_, fp)) <- zip [0..] entries
119 ]
120 ]
121
122 pprFingerprint :: Fingerprint -> SDoc
123 pprFingerprint (Fingerprint w1 w2) =
124 braces $ hcat $ punctuate comma
125 [ integer (fromIntegral w1) <> text "ULL"
126 , integer (fromIntegral w2) <> text "ULL"
127 ]