StaticPtrTable.hs 2.51 KB
Newer Older
Facundo Domínguez's avatar
Facundo Domínguez committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
-- | Code generation for the Static Pointer Table
--
-- (c) 2014 I/O Tweag
--
-- Each module that uses 'static' keyword declares an initialization function of
-- the form hs_spt_init_<module>() which is emitted into the _stub.c file and
-- annotated with __attribute__((constructor)) so that it gets executed at
-- startup time.
--
-- The function's purpose is to call hs_spt_insert to insert the static
-- pointers of this module in the hashtable of the RTS, and it looks something
-- like this:
--
-- > static void hs_hpc_init_Main(void) __attribute__((constructor));
-- > static void hs_hpc_init_Main(void) {
-- >
-- >   static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
-- >   extern StgPtr Main_sptEntryZC0_closure;
-- >   hs_spt_insert(k0, &Main_sptEntryZC0_closure);
-- >
-- >   static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
-- >   extern StgPtr Main_sptEntryZC1_closure;
-- >   hs_spt_insert(k1, &Main_sptEntryZC1_closure);
-- >
-- > }
--
27
-- where the constants are fingerprints produced from the static forms.
Facundo Domínguez's avatar
Facundo Domínguez committed
28 29 30 31 32 33 34 35 36 37 38 39
--
module StaticPtrTable (sptInitCode) where

import CoreSyn
import Module
import Outputable
import Id
import CLabel
import GHC.Fingerprint


-- | @sptInitCode module statics@ is a C stub to insert the static entries
40
-- @statics@ of @module@ into the static pointer table.
Facundo Domínguez's avatar
Facundo Domínguez committed
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
--
-- Each entry contains the fingerprint used to locate the entry and the
-- top-level binding for the entry.
--
sptInitCode :: Module -> [(Fingerprint, (Id,CoreExpr))] -> SDoc
sptInitCode _ [] = Outputable.empty
sptInitCode this_mod entries = vcat
    [ text "static void hs_spt_init_" <> ppr this_mod
           <> text "(void) __attribute__((constructor));"
    , text "static void hs_spt_init_" <> ppr this_mod <> text "(void)"
    , braces $ vcat $
        [  text "static StgWord64 k" <> int i <> text "[2] = "
           <> pprFingerprint fp <> semi
        $$ text "extern StgPtr "
           <> (ppr $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
        $$ text "hs_spt_insert" <> parens
             (hcat $ punctuate comma
                [ char 'k' <> int i
                , char '&' <> ppr (mkClosureLabel (idName n) (idCafInfo n))
                ]
             )
        <> semi
        |  (i, (fp, (n, _))) <- zip [0..] entries
        ]
    ]

  where

    pprFingerprint :: Fingerprint -> SDoc
    pprFingerprint (Fingerprint w1 w2) =
      braces $ hcat $ punctuate comma
                 [ integer (fromIntegral w1) <> text "ULL"
                 , integer (fromIntegral w2) <> text "ULL"
                 ]