043f62f8114d41d62959125468bb7fc6bfc7c217
[ghc.git] / compiler / cmm / CmmBuildInfoTables.hs
1 {-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
2 GeneralizedNewtypeDeriving, NondecreasingIndentation #-}
3
4 module CmmBuildInfoTables
5 ( CAFSet, CAFEnv, cafAnal
6 , doSRTs, ModuleSRTInfo, emptySRT
7 ) where
8
9 import GhcPrelude hiding (succ)
10
11 import BlockId
12 import Hoopl.Block
13 import Hoopl.Graph
14 import Hoopl.Label
15 import Hoopl.Collections
16 import Hoopl.Dataflow
17 import Module
18 import Digraph
19 import CLabel
20 import PprCmmDecl ()
21 import Cmm
22 import CmmUtils
23 import DynFlags
24 import Maybes
25 import Outputable
26 import SMRep
27 import UniqSupply
28 import CostCentre
29 import StgCmmHeap
30
31 import PprCmm()
32 import Data.Map (Map)
33 import qualified Data.Map as Map
34 import Data.Set (Set)
35 import qualified Data.Set as Set
36 import Data.Tuple
37 import Control.Monad
38 import Control.Monad.Trans.State
39 import Control.Monad.Trans.Class
40
41
42 {- Note [SRTs]
43
44 SRTs are the mechanism by which the garbage collector can determine
45 the live CAFs in the program.
46
47 Representation
48 ^^^^^^^^^^^^^^
49
50 +------+
51 | info |
52 | | +-----+---+---+---+
53 | -------->|SRT_2| | | | | 0 |
54 |------| +-----+-|-+-|-+---+
55 | | | |
56 | code | | |
57 | | v v
58
59 An SRT is simply an object in the program's data segment. It has the
60 same representation as a static constructor. There are 16
61 pre-compiled SRT info tables: stg_SRT_1_info, .. stg_SRT_16_info,
62 representing SRT objects with 1-16 pointers, respectively.
63
64 The entries of an SRT object point to static closures, which are either
65 - FUN_STATIC, THUNK_STATIC or CONSTR
66 - Another SRT (actually just a CONSTR)
67
68 The final field of the SRT is the static link field, used by the
69 garbage collector to chain together static closures that it visits and
70 to determine whether a static closure has been visited or not. (see
71 Note [STATIC_LINK fields])
72
73 By traversing the transitive closure of an SRT, the GC will reach all
74 of the CAFs that are reachable from the code associated with this SRT.
75
76 If we need to create an SRT with more than 16 entries, we build a
77 chain of SRT objects with all but the last having 16 entries.
78
79 +-----+---+- -+---+---+
80 |SRT16| | | | | | 0 |
81 +-----+-|-+- -+-|-+---+
82 | |
83 v v
84 +----+---+---+---+
85 |SRT2| | | | | 0 |
86 +----+-|-+-|-+---+
87 | |
88 | |
89 v v
90
91 Referring to an SRT from the info table
92 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
93
94 The following things have SRTs:
95
96 - Static functions (FUN)
97 - Static thunks (THUNK), ie. CAFs
98 - Continuations (RET_SMALL, etc.)
99
100 In each case, the info table points to the SRT.
101
102 - info->srt is zero if there's no SRT, otherwise:
103 - info->srt == 1 and info->f.srt_offset points to the SRT
104
105 e.g. for a FUN with an SRT:
106
107 StgFunInfoTable +------+
108 info->f.srt_offset | ------------> offset to SRT object
109 StgStdInfoTable +------+
110 info->layout.ptrs | ... |
111 info->layout.nptrs | ... |
112 info->srt | 1 |
113 info->type | ... |
114 |------|
115
116 On x86_64, we optimise the info table representation further. The
117 offset to the SRT can be stored in 32 bits (all code lives within a
118 2GB region in x86_64's small memory model), so we can save a word in
119 the info table by storing the srt_offset in the srt field, which is
120 half a word.
121
122 On x86_64 with TABLES_NEXT_TO_CODE:
123
124 - info->srt is zero if there's no SRT, otherwise:
125 - info->srt is an offset from the info pointer to the SRT object
126
127 StgStdInfoTable +------+
128 info->layout.ptrs | |
129 info->layout.nptrs | |
130 info->srt | ------------> offset to SRT object
131 |------|
132
133
134 EXAMPLE
135 ^^^^^^^
136
137 f = \x. ... g ...
138 where
139 g = \y. ... h ... c1 ...
140 h = \z. ... c2 ...
141
142 c1 & c2 are CAFs
143
144 g and h are local functions, but they have no static closures. When
145 we generate code for f, we start with a CmmGroup of four CmmDecls:
146
147 [ f_closure, f_entry, g_entry, h_entry ]
148
149 we process each CmmDecl separately in cpsTop, giving us a list of
150 CmmDecls. e.g. for f_entry, we might end up with
151
152 [ f_entry, f1_ret, f2_proc ]
153
154 where f1_ret is a return point, and f2_proc is a proc-point. We have
155 a CAFSet for each of these CmmDecls, let's suppose they are
156
157 [ f_entry{g_info}, f1_ret{g_info}, f2_proc{} ]
158 [ g_entry{h_info, c1_closure} ]
159 [ h_entry{c2_closure} ]
160
161 Next, we make an SRT for each of these functions:
162
163 f_srt : [g_info]
164 g_srt : [h_info, c1_closure]
165 h_srt : [c2_closure]
166
167 Now, for g_info and h_info, we want to refer to the SRTs for g and h
168 respectively, which we'll label g_srt and h_srt:
169
170 f_srt : [g_srt]
171 g_srt : [h_srt, c1_closure]
172 h_srt : [c2_closure]
173
174 Now, when an SRT has a single entry, we don't actually generate an SRT
175 closure for it, instead we just replace references to it with its
176 single element. So, since h_srt == c2_closure, we have
177
178 f_srt : [g_srt]
179 g_srt : [c2_closure, c1_closure]
180 h_srt : [c2_closure]
181
182 and the only SRT closure we generate is
183
184 g_srt = SRT_2 [c2_closure, c1_closure]
185
186
187 Optimisations
188 ^^^^^^^^^^^^^
189
190 To reduce the code size overhead and the cost of traversing SRTs in
191 the GC, we want to simplify SRTs where possible. We therefore apply
192 the following optimisations. Each has a [keyword]; search for the
193 keyword in the code below to see where the optimisation is
194 implemented.
195
196 1. [Shortcut] we never create an SRT with a single entry, instead
197 we replace all references to the singleton SRT with a reference
198 to its element. This includes references from info tables.
199
200 i.e. instead of
201
202 +------+
203 | info |
204 | | +-----+---+---+
205 | -------->|SRT_1| | | 0 |
206 |------| +-----+-|-+---+
207 | | |
208 | code | |
209 | | v
210 closure
211
212 we can point directly to the closure:
213
214 +------+
215 | info |
216 | |
217 | -------->closure
218 |------|
219 | |
220 | code |
221 | |
222
223
224 The exception to this is when we're doing dynamic linking. In that
225 case, if the closure is not locally defined then we can't point to
226 it directly from the info table, because this is the text section
227 which cannot contain runtime relocations. In this case we skip this
228 optimisation and generate the singleton SRT, becase SRTs are in the
229 data section and *can* have relocatable references.
230
231 2. [FUN] If an SRT refers to a top-level function (a FUN_STATIC), then
232 we can shortcut the reference to point directly to the function's
233 SRT instead.
234
235 i.e. instead of
236
237 +---+---+---
238 |SRT| | |
239 +---+-|-+---
240 |
241 v
242 +---+---+
243 | | | 0 |
244 +-|-+---+
245 |
246 | +------+
247 | | info |
248 | | | +-----+---+---+
249 | | -------->|SRT_1| | | 0 |
250 `----->|------| +-----+-|-+---+
251 | | |
252 | code | |
253 | | v
254 closure
255
256 we can generate
257
258 +---+---+---
259 |SRT| | |
260 +---+-|-+---
261 `----------------------,
262 |
263 +---+---+ |
264 | | | 0 | |
265 +-|-+---+ |
266 | |
267 | +------+ |
268 | | info | v
269 | | | +-----+---+---+
270 | | -------->|SRT_1| | | 0 |
271 `----->|------| +-----+-|-+---+
272 | | |
273 | code | |
274 | | v
275 closure
276
277 This is quicker for the garbage collector to traverse, and avoids
278 setting the static link field on the function's closure.
279
280 Of course we can only do this if we know what the function's SRT
281 is. Due to [Shortcut] the function's SRT can be an arbitrary
282 closure, so this optimisation only applies within a module.
283
284 Note: we can *not* do this optimisation for top-level thunks
285 (CAFs), because we want the SRT to point directly to the
286 CAF. Otherwise the SRT would keep the CAF's static references alive
287 even after the CAF had been evaluated!
288
289 3. [Common] Identical SRTs can be commoned up.
290
291 4. [Filter] If an SRT A refers to an SRT B and a closure C, and B also
292 refers to C (perhaps transitively), then we can omit the reference
293 to C from A.
294
295
296 As an alternative to [FUN]: we could merge the FUN's SRT with the FUN
297 object itself.
298
299 Note that there are many other optimisations that we could do, but
300 aren't implemented. In general, we could omit any reference from an
301 SRT if everything reachable from it is also reachable from the other
302 fields in the SRT. Our [Filter] optimisation is a special case of
303 this.
304
305 Another opportunity we don't exploit is this:
306
307 A = {X,Y,Z}
308 B = {Y,Z}
309 C = {X,B}
310
311 Here we could use C = {A} and therefore [Shortcut] C = A.
312 -}
313
314 -- ---------------------------------------------------------------------
315 -- Label types
316
317 -- Labels that come from cafAnal can be:
318 -- - _closure labels for static functions or CAFs
319 -- - _info labels for dynamic functions, thunks, or continuations
320 -- - _entry labels for functions or thunks
321 --
322 -- Meanwhile the labels on top-level blocks are _entry labels.
323 --
324 -- To put everything in the same namespace we convert all labels to
325 -- closure labels using toClosureLbl. Note that some of these
326 -- labels will not actually exist; that's ok because we're going to
327 -- map them to SRTEntry later, which ranges over labels that do exist.
328 --
329 newtype CAFLabel = CAFLabel CLabel
330 deriving (Eq,Ord,Outputable)
331
332 type CAFSet = Set CAFLabel
333 type CAFEnv = LabelMap CAFSet
334
335 mkCAFLabel :: CLabel -> CAFLabel
336 mkCAFLabel lbl = CAFLabel (toClosureLbl lbl)
337
338 -- This is a label that we can put in an SRT. It *must* be a closure label,
339 -- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.
340 newtype SRTEntry = SRTEntry CLabel
341 deriving (Eq, Ord, Outputable)
342
343 -- ---------------------------------------------------------------------
344 -- CAF analysis
345
346 -- |
347 -- For each code block:
348 -- - collect the references reachable from this code block to FUN,
349 -- THUNK or RET labels for which hasCAF == True
350 --
351 -- This gives us a `CAFEnv`: a mapping from code block to sets of labels
352 --
353 cafAnal
354 :: LabelSet -- The blocks representing continuations, ie. those
355 -- that will get RET info tables. These labels will
356 -- get their own SRTs, so we don't aggregate CAFs from
357 -- references to these labels, we just use the label.
358 -> CLabel -- The top label of the proc
359 -> CmmGraph
360 -> CAFEnv
361 cafAnal contLbls topLbl cmmGraph =
362 analyzeCmmBwd cafLattice
363 (cafTransfers contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty
364
365
366 cafLattice :: DataflowLattice CAFSet
367 cafLattice = DataflowLattice Set.empty add
368 where
369 add (OldFact old) (NewFact new) =
370 let !new' = old `Set.union` new
371 in changedIf (Set.size new' > Set.size old) new'
372
373
374 cafTransfers :: LabelSet -> Label -> CLabel -> TransferFun CAFSet
375 cafTransfers contLbls entry topLbl
376 (BlockCC eNode middle xNode) fBase =
377 let joined = cafsInNode xNode $! live'
378 !result = foldNodesBwdOO cafsInNode middle joined
379
380 facts = mapMaybe successorFact (successors xNode)
381 live' = joinFacts cafLattice facts
382
383 successorFact s
384 -- If this is a loop back to the entry, we can refer to the
385 -- entry label.
386 | s == entry = Just (add topLbl Set.empty)
387 -- If this is a continuation, we want to refer to the
388 -- SRT for the continuation's info table
389 | s `setMember` contLbls
390 = Just (Set.singleton (mkCAFLabel (infoTblLbl s)))
391 -- Otherwise, takes the CAF references from the destination
392 | otherwise
393 = lookupFact s fBase
394
395 cafsInNode :: CmmNode e x -> CAFSet -> CAFSet
396 cafsInNode node set = foldExpDeep addCaf node set
397
398 addCaf expr !set =
399 case expr of
400 CmmLit (CmmLabel c) -> add c set
401 CmmLit (CmmLabelOff c _) -> add c set
402 CmmLit (CmmLabelDiffOff c1 c2 _ _) -> add c1 $! add c2 set
403 _ -> set
404 add l s | hasCAF l = Set.insert (mkCAFLabel l) s
405 | otherwise = s
406
407 in mapSingleton (entryLabel eNode) result
408
409
410 -- -----------------------------------------------------------------------------
411 -- ModuleSRTInfo
412
413 data ModuleSRTInfo = ModuleSRTInfo
414 { thisModule :: Module
415 -- ^ Current module being compiled. Required for calling labelDynamic.
416 , dedupSRTs :: Map (Set SRTEntry) SRTEntry
417 -- ^ previous SRTs we've emitted, so we can de-duplicate.
418 -- Used to implement the [Common] optimisation.
419 , flatSRTs :: Map SRTEntry (Set SRTEntry)
420 -- ^ The reverse mapping, so that we can remove redundant
421 -- entries. e.g. if we have an SRT [a,b,c], and we know that b
422 -- points to [c,d], we can omit c and emit [a,b].
423 -- Used to implement the [Filter] optimisation.
424 }
425 instance Outputable ModuleSRTInfo where
426 ppr ModuleSRTInfo{..} =
427 text "ModuleSRTInfo:" <+> ppr dedupSRTs <+> ppr flatSRTs
428
429 emptySRT :: Module -> ModuleSRTInfo
430 emptySRT mod =
431 ModuleSRTInfo
432 { thisModule = mod
433 , dedupSRTs = Map.empty
434 , flatSRTs = Map.empty }
435
436 -- -----------------------------------------------------------------------------
437 -- Constructing SRTs
438
439 {- Implementation notes
440
441 - In each CmmDecl there is a mapping info_tbls from Label -> CmmInfoTable
442
443 - The entry in info_tbls corresponding to g_entry is the closure info
444 table, the rest are continuations.
445
446 - Each entry in info_tbls possibly needs an SRT. We need to make a
447 label for each of these.
448
449 - We get the CAFSet for each entry from the CAFEnv
450
451 -}
452
453 -- | Return a (Label,CLabel) pair for each labelled block of a CmmDecl,
454 -- where the label is
455 -- - the info label for a continuation or dynamic closure
456 -- - the closure label for a top-level function (not a CAF)
457 getLabelledBlocks :: CmmDecl -> [(Label, CAFLabel)]
458 getLabelledBlocks (CmmData _ _) = []
459 getLabelledBlocks (CmmProc top_info _ _ _) =
460 [ (blockId, mkCAFLabel (cit_lbl info))
461 | (blockId, info) <- mapToList (info_tbls top_info)
462 , let rep = cit_rep info
463 , not (isStaticRep rep) || not (isThunkRep rep)
464 ]
465
466
467 -- | Get (Label,CLabel) pairs for each block that represents a CAF.
468 -- These are treated differently from other labelled blocks:
469 -- - we never resolve a reference to a CAF to the contents of its SRT, since
470 -- the point of SRTs is to keep CAFs alive.
471 -- - CAFs therefore don't take part in the dependency analysis in depAnalSRTs.
472 -- instead we generate their SRTs after everything else, so that we can
473 -- resolve references in the CAF's SRT.
474 getCAFs :: CmmDecl -> [(Label, CAFLabel)]
475 getCAFs (CmmData _ _) = []
476 getCAFs (CmmProc top_info topLbl _ g)
477 | Just info <- mapLookup (g_entry g) (info_tbls top_info)
478 , let rep = cit_rep info
479 , isStaticRep rep && isThunkRep rep = [(g_entry g, mkCAFLabel topLbl)]
480 | otherwise = []
481
482
483 -- | Put the labelled blocks that we will be annotating with SRTs into
484 -- dependency order. This is so that we can process them one at a
485 -- time, resolving references to earlier blocks to point to their
486 -- SRTs.
487 depAnalSRTs
488 :: CAFEnv
489 -> [CmmDecl]
490 -> [SCC (Label, CAFLabel, Set CAFLabel)]
491
492 depAnalSRTs cafEnv decls =
493 srtTrace "depAnalSRTs" (ppr blockToLabel $$ ppr (graph ++ cafSCCs)) $
494 (graph ++ cafSCCs)
495 where
496 cafs = concatMap getCAFs decls
497 cafSCCs = [ AcyclicSCC (blockid, lbl, cafs)
498 | (blockid, lbl) <- cafs
499 , Just cafs <- [mapLookup blockid cafEnv] ]
500 labelledBlocks = concatMap getLabelledBlocks decls
501 blockToLabel :: LabelMap CAFLabel
502 blockToLabel = mapFromList (cafs ++ labelledBlocks)
503 labelToBlock = Map.fromList (map swap labelledBlocks)
504 graph = stronglyConnCompFromEdgedVerticesOrd
505 [ let cafs' = Set.delete lbl cafs in
506 DigraphNode (l,lbl,cafs') l
507 (mapMaybe (flip Map.lookup labelToBlock) (Set.toList cafs'))
508 | (l, lbl) <- labelledBlocks
509 , Just cafs <- [mapLookup l cafEnv] ]
510
511
512 -- | Maps labels from 'cafAnal' to the final CLabel that will appear
513 -- in the SRT.
514 -- - closures with singleton SRTs resolve to their single entry
515 -- - closures with larger SRTs map to the label for that SRT
516 -- - CAFs must not map to anything!
517 -- - if a labels maps to Nothing, we found that this label's SRT
518 -- is empty, so we don't need to refer to it from other SRTs.
519 type SRTMap = Map CAFLabel (Maybe SRTEntry)
520
521 -- | resolve a CAFLabel to its SRTEntry using the SRTMap
522 resolveCAF :: SRTMap -> CAFLabel -> Maybe SRTEntry
523 resolveCAF srtMap lbl@(CAFLabel l) =
524 Map.findWithDefault (Just (SRTEntry (toClosureLbl l))) lbl srtMap
525
526
527 -- | Attach SRTs to all info tables in the CmmDecls, and add SRT
528 -- declarations to the ModuleSRTInfo.
529 --
530 doSRTs
531 :: DynFlags
532 -> ModuleSRTInfo
533 -> [(CAFEnv, [CmmDecl])]
534 -> IO (ModuleSRTInfo, [CmmDecl])
535
536 doSRTs dflags topSRT tops = do
537 us <- mkSplitUniqSupply 'u'
538
539 -- Ignore the original grouping of decls, and combine all the
540 -- CAFEnvs into a single CAFEnv.
541 let (cafEnvs, declss) = unzip tops
542 cafEnv = mapUnions cafEnvs
543 decls = concat declss
544
545 -- Put the decls in dependency order. Why? So that we can implement
546 -- [Shortcut] and [Filter]. If we need to refer to an SRT that has
547 -- a single entry, we use the entry itself, which means that we
548 -- don't need to generate the singleton SRT in the first place. But
549 -- to do this we need to process blocks before things that depend on
550 -- them.
551 let sccs = depAnalSRTs cafEnv decls
552
553 -- On each strongly-connected group of decls, construct the SRT
554 -- closures and the SRT fields for info tables.
555 let (((declss, pairs), _srtMap), topSRT') =
556 initUs_ us $
557 flip runStateT topSRT $
558 flip runStateT Map.empty $
559 mapAndUnzipM (doSCC dflags) sccs
560
561 -- Next, update the info tables with the SRTs
562 let decls' = map (updInfoSRTs (mapFromList (concat pairs))) decls
563
564 return (topSRT', concat declss ++ decls')
565
566
567 -- | Build the SRT for a strongly-connected component of blocks
568 doSCC
569 :: DynFlags
570 -> SCC (Label, CAFLabel, Set CAFLabel)
571 -> StateT SRTMap
572 (StateT ModuleSRTInfo UniqSM)
573 ( [CmmDecl] -- generated SRTs
574 , [(Label, CLabel)] -- SRT fields for info tables
575 )
576
577 doSCC dflags (AcyclicSCC (l, cafLbl, cafs)) =
578 oneSRT dflags [l] [cafLbl] cafs
579
580 doSCC dflags (CyclicSCC nodes) = do
581 -- build a single SRT for the whole cycle
582 let (blockids, lbls, cafsets) = unzip3 nodes
583 cafs = Set.unions cafsets `Set.difference` Set.fromList lbls
584 oneSRT dflags blockids lbls cafs
585
586
587 -- | Build an SRT for a set of blocks
588 oneSRT
589 :: DynFlags
590 -> [Label] -- blocks in this set
591 -> [CAFLabel] -- labels for those blocks
592 -> Set CAFLabel -- SRT for this set
593 -> StateT SRTMap
594 (StateT ModuleSRTInfo UniqSM)
595 ( [CmmDecl] -- SRT objects we built
596 , [(Label, CLabel)] -- SRT fields for these blocks' itbls
597 )
598
599 oneSRT dflags blockids lbls cafs = do
600 srtMap <- get
601 topSRT <- lift get
602 let
603 -- First resolve all the CAFLabels to SRTEntries
604 -- implements the [Shortcut] optimisation.
605 resolved =
606 Set.fromList $
607 catMaybes (map (resolveCAF srtMap) (Set.toList cafs))
608
609 -- The set of all SRTEntries in SRTs that we refer to from here.
610 allBelow =
611 Set.unions [ lbls | caf <- Set.toList resolved
612 , Just lbls <- [Map.lookup caf (flatSRTs topSRT)] ]
613
614 -- Remove SRTEntries that are also in an SRT that we refer to.
615 -- Implements the [Filter] optimisation.
616 filtered = Set.difference resolved allBelow
617
618 srtTrace "oneSRT:"
619 (ppr cafs <+> ppr resolved <+> ppr allBelow <+> ppr filtered) $ return ()
620
621 let
622 updateSRTMap srtEntry = do
623 let newSRTMap = Map.fromList [(cafLbl, srtEntry) | cafLbl <- lbls]
624 put (Map.union newSRTMap srtMap)
625
626 case Set.toList filtered of
627 [] -> do
628 srtTrace "oneSRT: empty" (ppr lbls) $ return ()
629 updateSRTMap Nothing
630 return ([], [])
631
632 [one@(SRTEntry lbl)]
633 | not (labelDynamic dflags (thisModule topSRT) lbl) -> do
634 updateSRTMap (Just one)
635 return ([], [(l, lbl) | l <- blockids])
636
637 cafList ->
638 -- Check whether an SRT with the same entries has been emitted already.
639 -- Implements the [Common] optimisation.
640 case Map.lookup filtered (dedupSRTs topSRT) of
641 Just srtEntry@(SRTEntry srtLbl) -> do
642 srtTrace "oneSRT [Common]" (ppr lbls <+> ppr srtLbl) $ return ()
643 updateSRTMap (Just srtEntry)
644 return ([], [(l, srtLbl) | l <- blockids])
645 Nothing -> do
646 -- No duplicates: we have to build a new SRT object
647 srtTrace "oneSRT: new" (ppr lbls <+> ppr filtered) $ return ()
648 (decls, srtEntry) <- lift . lift $ buildSRTChain dflags cafList
649 updateSRTMap (Just srtEntry)
650 let allBelowThis = Set.union allBelow filtered
651 oldFlatSRTs = flatSRTs topSRT
652 newFlatSRTs = Map.insert srtEntry allBelowThis oldFlatSRTs
653 newDedupSRTs = Map.insert filtered srtEntry (dedupSRTs topSRT)
654 lift (put (topSRT { dedupSRTs = newDedupSRTs
655 , flatSRTs = newFlatSRTs }))
656 let SRTEntry lbl = srtEntry
657 return (decls, [(l, lbl) | l <- blockids])
658
659
660 -- | build a static SRT object (or a chain of objects) from a list of
661 -- SRTEntries.
662 buildSRTChain
663 :: DynFlags
664 -> [SRTEntry]
665 -> UniqSM
666 ( [CmmDecl] -- The SRT object(s)
667 , SRTEntry -- label to use in the info table
668 )
669 buildSRTChain _ [] = panic "buildSRT: empty"
670 buildSRTChain dflags cafSet =
671 case splitAt mAX_SRT_SIZE cafSet of
672 (these, []) -> do
673 (decl,lbl) <- buildSRT dflags these
674 return ([decl], lbl)
675 (these,those) -> do
676 (rest, rest_lbl) <- buildSRTChain dflags (head these : those)
677 (decl,lbl) <- buildSRT dflags (rest_lbl : tail these)
678 return (decl:rest, lbl)
679 where
680 mAX_SRT_SIZE = 16
681
682
683 buildSRT :: DynFlags -> [SRTEntry] -> UniqSM (CmmDecl, SRTEntry)
684 buildSRT dflags refs = do
685 id <- getUniqueM
686 let
687 lbl = mkSRTLabel id
688 srt_n_info = mkSRTInfoLabel (length refs)
689 fields =
690 mkStaticClosure dflags srt_n_info dontCareCCS
691 [ CmmLabel lbl | SRTEntry lbl <- refs ]
692 [] -- no padding
693 [mkIntCLit dflags 0] -- link field
694 [] -- no saved info
695 return (mkDataLits (Section Data lbl) lbl fields, SRTEntry lbl)
696
697
698 {- Note [reverse gs]
699
700 It is important to keep the code blocks in the same order,
701 otherwise binary sizes get slightly bigger. I'm not completely
702 sure why this is, perhaps the assembler generates bigger jump
703 instructions for forward refs. --SDM
704 -}
705
706 updInfoSRTs :: LabelMap CLabel -> CmmDecl -> CmmDecl
707 updInfoSRTs srt_env (CmmProc top_info top_l live g) =
708 CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l live g
709 where updInfoTbl l info_tbl
710 = info_tbl { cit_srt = mapLookup l srt_env }
711 updInfoSRTs _ t = t
712
713
714 srtTrace :: String -> SDoc -> b -> b
715 srtTrace _ _ b = b