Refactor lookupFixityRn-related code following D1744
[ghc.git] / compiler / deSugar / 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_sptEntryZC0_closure;
19 -- > hs_spt_insert(k0, &Main_sptEntryZC0_closure);
20 -- >
21 -- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
22 -- > extern StgPtr Main_sptEntryZC1_closure;
23 -- > hs_spt_insert(k1, &Main_sptEntryZC1_closure);
24 -- >
25 -- > }
26 --
27 -- where the constants are fingerprints produced from the static forms.
28 --
29 -- There is also a finalization function for the time when the module is
30 -- unloaded.
31 --
32 -- > static void hs_hpc_fini_Main(void) __attribute__((destructor));
33 -- > static void hs_hpc_fini_Main(void) {
34 -- >
35 -- > static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
36 -- > hs_spt_remove(k0);
37 -- >
38 -- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
39 -- > hs_spt_remove(k1);
40 -- >
41 -- > }
42 --
43 module StaticPtrTable (sptInitCode) where
44
45 import CoreSyn
46 import Module
47 import Outputable
48 import Id
49 import CLabel
50 import GHC.Fingerprint
51
52
53 -- | @sptInitCode module statics@ is a C stub to insert the static entries
54 -- @statics@ of @module@ into the static pointer table.
55 --
56 -- Each entry contains the fingerprint used to locate the entry and the
57 -- top-level binding for the entry.
58 --
59 sptInitCode :: Module -> [(Fingerprint, (Id,CoreExpr))] -> SDoc
60 sptInitCode _ [] = Outputable.empty
61 sptInitCode this_mod entries = vcat
62 [ text "static void hs_spt_init_" <> ppr this_mod
63 <> text "(void) __attribute__((constructor));"
64 , text "static void hs_spt_init_" <> ppr this_mod <> text "(void)"
65 , braces $ vcat $
66 [ text "static StgWord64 k" <> int i <> text "[2] = "
67 <> pprFingerprint fp <> semi
68 $$ text "extern StgPtr "
69 <> (ppr $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
70 $$ text "hs_spt_insert" <> parens
71 (hcat $ punctuate comma
72 [ char 'k' <> int i
73 , char '&' <> ppr (mkClosureLabel (idName n) (idCafInfo n))
74 ]
75 )
76 <> semi
77 | (i, (fp, (n, _))) <- zip [0..] entries
78 ]
79 , text "static void hs_spt_fini_" <> ppr this_mod
80 <> text "(void) __attribute__((destructor));"
81 , text "static void hs_spt_fini_" <> ppr this_mod <> text "(void)"
82 , braces $ vcat $
83 [ text "StgWord64 k" <> int i <> text "[2] = "
84 <> pprFingerprint fp <> semi
85 $$ text "hs_spt_remove" <> parens (char 'k' <> int i) <> semi
86 | (i, (fp, _)) <- zip [0..] entries
87 ]
88 ]
89
90 where
91
92 pprFingerprint :: Fingerprint -> SDoc
93 pprFingerprint (Fingerprint w1 w2) =
94 braces $ hcat $ punctuate comma
95 [ integer (fromIntegral w1) <> text "ULL"
96 , integer (fromIntegral w2) <> text "ULL"
97 ]