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