ghc/compiler/nativeGen/AbsCStixGen.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 \begin{code}
   6 #include "HsVersions.h"
   7
   8 module AbsCStixGen (
   9         genCodeAbstractC,
  10
  11         -- and, of course, that's not enough...
  12         AbstractC, Target, StixTree, SplitUniqSupply, SUniqSM(..)
  13     ) where
  14
  15 import AbsCSyn
  16 import AbsPrel          ( PrimOp(..), primOpNeedsWrapper, isCompareOp
  17                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  18                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  19                         )
  20 import CgCompInfo       ( mIN_UPD_SIZE )
  21 import ClosureInfo      ( infoTableLabelFromCI, entryLabelFromCI, fastLabelFromCI,
  22                           closureUpdReqd
  23                         )
  24 import MachDesc
  25 import Maybes           ( Maybe(..), maybeToBool )
  26 import Outputable
  27 import PrimKind         ( isFloatingKind )
  28 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  29 import Stix
  30 import StixInfo         ( genCodeInfoTable )
  31 import SplitUniq
  32 import Unique
  33 import Util
  34 \end{code}
  35
  36 For each independent chunk of AbstractC code, we generate a list of @StixTree@s,
  37 where each tree corresponds to a single Stix instruction.  We leave the chunks
  38 separated so that register allocation can be performed locally within the chunk.
  39
  40 \begin{code}
  41
  42 genCodeAbstractC
  43     :: Target
  44     -> AbstractC
  45     -> SUniqSM [[StixTree]]
  46
  47 genCodeAbstractC target absC =
  48     mapSUs (genCodeTopAbsC target) (mkAbsCStmtList absC)        `thenSUs` \ trees ->
  49     returnSUs ([StComment SLIT("Native Code")] : trees)
  50
  51 \end{code}
  52
  53 Here we handle top-level things, like @CCodeBlock@s and
  54 @CClosureInfoTable@s.
  55
  56 \begin{code}
  57
  58 genCodeTopAbsC
  59     :: Target
  60     -> AbstractC
  61     -> SUniqSM [StixTree]
  62
  63 genCodeTopAbsC target (CCodeBlock label absC) =
  64     genCodeAbsC target absC                             `thenSUs` \ code ->
  65     returnSUs (StSegment TextSegment : StFunBegin label : code [StFunEnd label])
  66
  67 genCodeTopAbsC target stmt@(CStaticClosure label _ _ _) =
  68     genCodeStaticClosure target stmt                    `thenSUs` \ code ->
  69     returnSUs (StSegment DataSegment : StLabel label : code [])
  70
  71 genCodeTopAbsC target stmt@(CRetUnVector _ _) = returnSUs []
  72
  73 genCodeTopAbsC target stmt@(CFlatRetVector label _) =
  74     genCodeVecTbl target stmt                           `thenSUs` \ code ->
  75     returnSUs (StSegment TextSegment : code [StLabel label])
  76
  77 genCodeTopAbsC target stmt@(CClosureInfoAndCode cl_info slow Nothing _ _)
  78
  79   | slow_is_empty
  80   = genCodeInfoTable target stmt                        `thenSUs` \ itbl ->
  81     returnSUs (StSegment TextSegment : itbl [])
  82
  83   | otherwise
  84   = genCodeInfoTable target stmt                        `thenSUs` \ itbl ->
  85     genCodeAbsC target slow                             `thenSUs` \ slow_code ->
  86     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl :
  87               slow_code [StFunEnd slow_lbl]))
  88   where
  89     slow_is_empty = not (maybeToBool (nonemptyAbsC slow))
  90     slow_lbl = entryLabelFromCI cl_info
  91
  92 genCodeTopAbsC target stmt@(CClosureInfoAndCode cl_info slow (Just fast) _ _) =
  93 -- ToDo: what if this is empty? ------------------------^^^^
  94     genCodeInfoTable target stmt                        `thenSUs` \ itbl ->
  95     genCodeAbsC target slow                             `thenSUs` \ slow_code ->
  96     genCodeAbsC target fast                             `thenSUs` \ fast_code ->
  97     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl :
  98               slow_code (StFunEnd slow_lbl : StFunBegin fast_lbl :
  99               fast_code [StFunEnd fast_lbl])))
 100   where
 101     slow_lbl = entryLabelFromCI cl_info
 102     fast_lbl = fastLabelFromCI cl_info
 103
 104 genCodeTopAbsC target absC =
 105     genCodeAbsC target absC                             `thenSUs` \ code ->
 106     returnSUs (StSegment TextSegment : code [])
 107
 108 \end{code}
 109
 110 Now the individual AbstractC statements.
 111
 112 \begin{code}
 113
 114 genCodeAbsC
 115     :: Target
 116     -> AbstractC
 117     -> SUniqSM StixTreeList
 118
 119 \end{code}
 120
 121 @AbsCNop@s just disappear.
 122
 123 \begin{code}
 124
 125 genCodeAbsC target AbsCNop = returnSUs id
 126
 127 \end{code}
 128
 129 OLD:@CComment@s are passed through as the corresponding @StComment@s.
 130
 131 \begin{code}
 132
 133 --UNUSED:genCodeAbsC target (CComment s) = returnSUs (\xs -> StComment s : xs)
 134
 135 \end{code}
 136
 137 Split markers are a NOP in this land.
 138
 139 \begin{code}
 140
 141 genCodeAbsC target CSplitMarker = returnSUs id
 142
 143 \end{code}
 144
 145 AbstractC instruction sequences are handled individually, and the
 146 resulting StixTreeLists are joined together.
 147
 148 \begin{code}
 149
 150 genCodeAbsC target (AbsCStmts c1 c2) =
 151     genCodeAbsC target c1                               `thenSUs` \ b1 ->
 152     genCodeAbsC target c2                               `thenSUs` \ b2 ->
 153     returnSUs (b1 . b2)
 154
 155 \end{code}
 156
 157 Initialising closure headers in the heap...a fairly complex ordeal if
 158 done properly.  For now, we just set the info pointer, but we should
 159 really take a peek at the flags to determine whether or not there are
 160 other things to be done (setting cost centres, age headers, global
 161 addresses, etc.)
 162
 163 \begin{code}
 164
 165 genCodeAbsC target (CInitHdr cl_info reg_rel _ _) =
 166     let
 167         lhs = amodeToStix target (CVal reg_rel PtrKind)
 168         lbl = infoTableLabelFromCI cl_info
 169     in
 170         returnSUs (\xs -> StAssign PtrKind lhs (StCLbl lbl) : xs)
 171
 172 \end{code}
 173
 174 Assignment, the curse of von Neumann, is the center of the code we
 175 produce.  In most cases, the type of the assignment is determined
 176 by the type of the destination.  However, when the destination can
 177 have mixed types, the type of the assignment is ``StgWord'' (we use
 178 PtrKind for lack of anything better).  Think:  do we also want a cast
 179 of the source?  Be careful about floats/doubles.
 180
 181 \begin{code}
 182
 183 genCodeAbsC target (CAssign lhs rhs)
 184   | getAmodeKind lhs == VoidKind = returnSUs id
 185   | otherwise =
 186     let pk = getAmodeKind lhs
 187         pk' = if mixedTypeLocn lhs && not (isFloatingKind pk) then IntKind else pk
 188         lhs' = amodeToStix target lhs
 189         rhs' = amodeToStix' target rhs
 190     in
 191         returnSUs (\xs -> StAssign pk' lhs' rhs' : xs)
 192
 193 \end{code}
 194
 195 Unconditional jumps, including the special ``enter closure'' operation.
 196 Note that the new entry convention requires that we load the InfoPtr (R2)
 197 with the address of the info table before jumping to the entry code for Node.
 198
 199 \begin{code}
 200
 201 genCodeAbsC target (CJump dest) =
 202     returnSUs (\xs -> StJump (amodeToStix target dest) : xs)
 203
 204 genCodeAbsC target (CFallThrough (CLbl lbl _)) =
 205     returnSUs (\xs -> StFallThrough lbl : xs)
 206
 207 genCodeAbsC target (CReturn dest DirectReturn) =
 208     returnSUs (\xs -> StJump (amodeToStix target dest) : xs)
 209
 210 genCodeAbsC target (CReturn table (StaticVectoredReturn n)) =
 211     returnSUs (\xs -> StJump dest : xs)
 212   where
 213     dest = StInd PtrKind (StIndex PtrKind (amodeToStix target table)
 214                                           (StInt (toInteger (-n-1))))
 215
 216 genCodeAbsC target (CReturn table (DynamicVectoredReturn am)) =
 217     returnSUs (\xs -> StJump dest : xs)
 218   where
 219     dest = StInd PtrKind (StIndex PtrKind (amodeToStix target table) dyn_off)
 220     dyn_off = StPrim IntSubOp [StPrim IntNegOp [amodeToStix target am], StInt 1]
 221
 222 \end{code}
 223
 224 Now the PrimOps, some of which may need caller-saves register wrappers.
 225
 226 \begin{code}
 227
 228 genCodeAbsC target (COpStmt results op args liveness_mask vols)
 229   -- ToDo (ADR?): use that liveness mask
 230   | primOpNeedsWrapper op =
 231     let
 232         saves = volatileSaves target vols
 233         restores = volatileRestores target vols
 234     in
 235         primToStix target (nonVoid results) op (nonVoid args)
 236                                                         `thenSUs` \ code ->
 237         returnSUs (\xs -> saves ++ code (restores ++ xs))
 238
 239   | otherwise = primToStix target (nonVoid results) op (nonVoid args)
 240     where
 241         nonVoid = filter ((/= VoidKind) . getAmodeKind)
 242
 243 \end{code}
 244
 245 Now the dreaded conditional jump.
 246
 247 Now the if statement.  Almost *all* flow of control are of this form.
 248 @
 249         if (am==lit) { absC } else { absCdef }
 250 @
 251         =>
 252 @
 253         IF am = lit GOTO l1:
 254         absC
 255         jump l2:
 256    l1:
 257         absCdef
 258    l2:
 259 @
 260
 261 \begin{code}
 262
 263 genCodeAbsC target (CSwitch discrim alts deflt)
 264   = case alts of
 265       [] -> genCodeAbsC target deflt
 266
 267       [(tag,alt_code)] -> case maybe_empty_deflt of
 268                                 Nothing -> genCodeAbsC target alt_code
 269                                 Just dc -> mkIfThenElse target discrim tag alt_code dc
 270
 271       [(tag1@(MachInt i1 _), alt_code1),
 272        (tag2@(MachInt i2 _), alt_code2)]
 273         | deflt_is_empty && i1 == 0 && i2 == 1
 274         -> mkIfThenElse target discrim tag1 alt_code1 alt_code2
 275         | deflt_is_empty && i1 == 1 && i2 == 0
 276         -> mkIfThenElse target discrim tag2 alt_code2 alt_code1
 277
 278         -- If the @discrim@ is simple, then this unfolding is safe.
 279       other | simple_discrim -> mkSimpleSwitches target discrim alts deflt
 280
 281         -- Otherwise, we need to do a bit of work.
 282       other ->  getSUnique                        `thenSUs` \ u ->
 283                 genCodeAbsC target (AbsCStmts
 284                 (CAssign (CTemp u pk) discrim)
 285                 (CSwitch (CTemp u pk) alts deflt))
 286
 287   where
 288     maybe_empty_deflt = nonemptyAbsC deflt
 289     deflt_is_empty = case maybe_empty_deflt of
 290                         Nothing -> True
 291                         Just _  -> False
 292
 293     pk = getAmodeKind discrim
 294
 295     simple_discrim = case discrim of
 296                         CReg _    -> True
 297                         CTemp _ _ -> True
 298                         other     -> False
 299 \end{code}
 300
 301
 302
 303 Finally, all of the disgusting AbstractC macros.
 304
 305 \begin{code}
 306
 307 genCodeAbsC target (CMacroStmt macro args) = macroCode target macro args
 308
 309 genCodeAbsC target (CCallProfCtrMacro macro _) =
 310     returnSUs (\xs -> StComment macro : xs)
 311
 312 genCodeAbsC target (CCallProfCCMacro macro _) =
 313     returnSUs (\xs -> StComment macro : xs)
 314
 315 \end{code}
 316
 317 Here, we generate a jump table if there are more than four (integer) alternatives and
 318 the jump table occupancy is greater than 50%.  Otherwise, we generate a binary
 319 comparison tree.  (Perhaps this could be tuned.)
 320
 321 \begin{code}
 322
 323 intTag :: BasicLit -> Integer
 324 intTag (MachChar c) = toInteger (ord c)
 325 intTag (MachInt i _) = i
 326 intTag _ = panic "intTag"
 327
 328 fltTag :: BasicLit -> Rational
 329
 330 fltTag (MachFloat f) = f
 331 fltTag (MachDouble d) = d
 332 fltTag _ = panic "fltTag"
 333
 334 mkSimpleSwitches
 335     :: Target
 336     -> CAddrMode -> [(BasicLit,AbstractC)] -> AbstractC
 337     -> SUniqSM StixTreeList
 338
 339 mkSimpleSwitches target am alts absC =
 340     getUniqLabelNCG                                     `thenSUs` \ udlbl ->
 341     getUniqLabelNCG                                     `thenSUs` \ ujlbl ->
 342     let am' = amodeToStix target am
 343         joinedAlts = map (\ (tag,code) -> (tag, mkJoin code ujlbl)) alts
 344         sortedAlts = naturalMergeSortLe leAlt joinedAlts
 345                      -- naturalMergeSortLe, because we often get sorted alts to begin with
 346
 347         lowTag = intTag (fst (head sortedAlts))
 348         highTag = intTag (fst (last sortedAlts))
 349
 350         -- lowest and highest possible values the discriminant could take
 351         lowest = if floating then targetMinDouble else targetMinInt
 352         highest = if floating then targetMaxDouble else targetMaxInt
 353
 354         -- These should come from somewhere else, depending on the target arch
 355         -- (Note that the floating point values aren't terribly important.)
 356         -- ToDo: Fix!(JSM)
 357         targetMinDouble = MachDouble (-1.7976931348623157e+308)
 358         targetMaxDouble = MachDouble (1.7976931348623157e+308)
 359         targetMinInt = mkMachInt (-2147483647)
 360         targetMaxInt = mkMachInt 2147483647
 361     in
 362         (
 363         if not floating && choices > 4 && highTag - lowTag < toInteger (2 * choices) then
 364             mkJumpTable target am' sortedAlts lowTag highTag udlbl
 365         else
 366             mkBinaryTree target am' floating sortedAlts choices lowest highest udlbl
 367         )
 368                                                         `thenSUs` \ alt_code ->
 369         genCodeAbsC target absC                         `thenSUs` \ dflt_code ->
 370
 371         returnSUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs)))
 372
 373     where
 374         floating = isFloatingKind (getAmodeKind am)
 375         choices = length alts
 376
 377         (x@(MachChar _),_)  `leAlt` (y,_) = intTag x <= intTag y
 378         (x@(MachInt _ _),_) `leAlt` (y,_) = intTag x <= intTag y
 379         (x,_)               `leAlt` (y,_) = fltTag x <= fltTag y
 380
 381 \end{code}
 382
 383 We use jump tables when doing an integer switch on a relatively dense list of
 384 alternatives.  We expect to be given a list of alternatives, sorted by tag,
 385 and a range of values for which we are to generate a table.  Of course, the tags of
 386 the alternatives should lie within the indicated range.  The alternatives need
 387 not cover the range; a default target is provided for the missing alternatives.
 388
 389 If a join is necessary after the switch, the alternatives should already finish
 390 with a jump to the join point.
 391
 392 \begin{code}
 393
 394 mkJumpTable
 395     :: Target
 396     -> StixTree                 -- discriminant
 397     -> [(BasicLit, AbstractC)]  -- alternatives
 398     -> Integer                  -- low tag
 399     -> Integer                  -- high tag
 400     -> CLabel                   -- default label
 401     -> SUniqSM StixTreeList
 402
 403 mkJumpTable target am alts lowTag highTag dflt =
 404     getUniqLabelNCG                                     `thenSUs` \ utlbl ->
 405     mapSUs genLabel alts                                `thenSUs` \ branches ->
 406     let cjmpLo = StCondJump dflt (StPrim IntLtOp [am, StInt lowTag])
 407         cjmpHi = StCondJump dflt (StPrim IntGtOp [am, StInt highTag])
 408
 409         offset = StPrim IntSubOp [am, StInt lowTag]
 410         jump = StJump (StInd PtrKind (StIndex PtrKind (StCLbl utlbl) offset))
 411
 412         tlbl = StLabel utlbl
 413         table = StData PtrKind (mkTable branches [lowTag..highTag] [])
 414     in
 415         mapSUs mkBranch branches                        `thenSUs` \ alts ->
 416
 417         returnSUs (\xs -> cjmpLo : cjmpHi : jump :
 418                          StSegment DataSegment : tlbl : table :
 419                          StSegment TextSegment : foldr1 (.) alts xs)
 420
 421     where
 422         genLabel x = getUniqLabelNCG `thenSUs` \ lbl -> returnSUs (lbl, x)
 423
 424         mkBranch (lbl,(_,alt)) =
 425             genCodeAbsC target alt                      `thenSUs` \ alt_code ->
 426             returnSUs (\xs -> StLabel lbl : alt_code xs)
 427
 428         mkTable _  []     tbl = reverse tbl
 429         mkTable [] (x:xs) tbl = mkTable [] xs (StCLbl dflt : tbl)
 430         mkTable alts@((lbl,(tag,_)):rest) (x:xs) tbl
 431           | intTag tag == x = mkTable rest xs (StCLbl lbl : tbl)
 432           | otherwise = mkTable alts xs (StCLbl dflt : tbl)
 433
 434 \end{code}
 435
 436 We generate binary comparison trees when a jump table is inappropriate.
 437 We expect to be given a list of alternatives, sorted by tag, and for
 438 convenience, the length of the alternative list.  We recursively break
 439 the list in half and do a comparison on the first tag of the second half
 440 of the list.  (Odd lists are broken so that the second half of the list
 441 is longer.)  We can handle either integer or floating kind alternatives,
 442 so long as they are not mixed.  (We assume that the type of the discriminant
 443 determines the type of the alternatives.)
 444
 445 As with the jump table approach, if a join is necessary after the switch, the
 446 alternatives should already finish with a jump to the join point.
 447
 448 \begin{code}
 449
 450 mkBinaryTree
 451     :: Target
 452     -> StixTree                 -- discriminant
 453     -> Bool                     -- floating point?
 454     -> [(BasicLit, AbstractC)]  -- alternatives
 455     -> Int                      -- number of choices
 456     -> BasicLit                 -- low tag
 457     -> BasicLit                 -- high tag
 458     -> CLabel                   -- default code label
 459     -> SUniqSM StixTreeList
 460
 461 mkBinaryTree target am floating [(tag,alt)] _ lowTag highTag udlbl
 462   | rangeOfOne = genCodeAbsC target alt
 463   | otherwise =
 464     let tag' = amodeToStix target (CLit tag)
 465         cmpOp = if floating then DoubleNeOp else IntNeOp
 466         test = StPrim cmpOp [am, tag']
 467         cjmp = StCondJump udlbl test
 468     in
 469         genCodeAbsC target alt                          `thenSUs` \ alt_code ->
 470         returnSUs (\xs -> cjmp : alt_code xs)
 471
 472     where
 473         rangeOfOne = not floating && intTag lowTag + 1 >= intTag highTag
 474         -- When there is only one possible tag left in range, we skip the comparison
 475
 476 mkBinaryTree target am floating alts choices lowTag highTag udlbl =
 477     getUniqLabelNCG                                     `thenSUs` \ uhlbl ->
 478     let tag' = amodeToStix target (CLit splitTag)
 479         cmpOp = if floating then DoubleGeOp else IntGeOp
 480         test = StPrim cmpOp [am, tag']
 481         cjmp = StCondJump uhlbl test
 482     in
 483         mkBinaryTree target am floating alts_lo half lowTag splitTag udlbl
 484                                                         `thenSUs` \ lo_code ->
 485         mkBinaryTree target am floating alts_hi (choices - half) splitTag highTag udlbl
 486                                                         `thenSUs` \ hi_code ->
 487
 488         returnSUs (\xs -> cjmp : lo_code (StLabel uhlbl : hi_code xs))
 489
 490     where
 491         half = choices `div` 2
 492         (alts_lo, alts_hi) = splitAt half alts
 493         splitTag = fst (head alts_hi)
 494
 495 \end{code}
 496
 497 \begin{code}
 498
 499 mkIfThenElse
 500     :: Target
 501     -> CAddrMode            -- discriminant
 502     -> BasicLit             -- tag
 503     -> AbstractC            -- if-part
 504     -> AbstractC            -- else-part
 505     -> SUniqSM StixTreeList
 506
 507 mkIfThenElse target discrim tag alt deflt =
 508     getUniqLabelNCG                                     `thenSUs` \ ujlbl ->
 509     getUniqLabelNCG                                     `thenSUs` \ utlbl ->
 510     let discrim' = amodeToStix target discrim
 511         tag' = amodeToStix target (CLit tag)
 512         cmpOp = if (isFloatingKind (getAmodeKind discrim)) then DoubleNeOp else IntNeOp
 513         test = StPrim cmpOp [discrim', tag']
 514         cjmp = StCondJump utlbl test
 515         dest = StLabel utlbl
 516         join = StLabel ujlbl
 517     in
 518         genCodeAbsC target (mkJoin alt ujlbl)           `thenSUs` \ alt_code ->
 519         genCodeAbsC target deflt                        `thenSUs` \ dflt_code ->
 520         returnSUs (\xs -> cjmp : alt_code (dest : dflt_code (join : xs)))
 521
 522 mkJoin :: AbstractC -> CLabel -> AbstractC
 523
 524 mkJoin code lbl
 525   | mightFallThrough code = mkAbsCStmts code (CJump (CLbl lbl PtrKind))
 526   | otherwise = code
 527
 528 \end{code}
 529
 530 %---------------------------------------------------------------------------
 531
 532 This answers the question: Can the code fall through to the next
 533 line(s) of code?  This errs towards saying True if it can't choose,
 534 because it is used for eliminating needless jumps.  In other words, if
 535 you might possibly {\em not} jump, then say yes to falling through.
 536
 537 \begin{code}
 538 mightFallThrough :: AbstractC -> Bool
 539
 540 mightFallThrough absC = ft absC True
 541  where
 542   ft AbsCNop       if_empty = if_empty
 543
 544   ft (CJump _)       if_empty = False
 545   ft (CReturn _ _)   if_empty = False
 546   ft (CSwitch _ alts deflt) if_empty
 547         = ft deflt if_empty ||
 548           or [ft alt if_empty | (_,alt) <- alts]
 549
 550   ft (AbsCStmts c1 c2) if_empty = ft c2 (ft c1 if_empty)
 551   ft _ if_empty = if_empty
 552
 553 {- Old algorithm, which called nonemptyAbsC for every subexpression! =========
 554 fallThroughAbsC (AbsCStmts c1 c2) =
 555     case nonemptyAbsC c2 of
 556         Nothing -> fallThroughAbsC c1
 557         Just x -> fallThroughAbsC x
 558 fallThroughAbsC (CJump _)        = False
 559 fallThroughAbsC (CReturn _ _)    = False
 560 fallThroughAbsC (CSwitch _ choices deflt)
 561   = (not (isEmptyAbsC deflt) && fallThroughAbsC deflt)
 562     || or (map (fallThroughAbsC . snd) choices)
 563 fallThroughAbsC other            = True
 564
 565 isEmptyAbsC :: AbstractC -> Bool
 566 isEmptyAbsC = not . maybeToBool . nonemptyAbsC
 567 ================= End of old, quadratic, algorithm -}
 568 \end{code}
 569
 570 Vector tables are trivial!
 571
 572 \begin{code}
 573
 574 genCodeVecTbl
 575     :: Target
 576     -> AbstractC
 577     -> SUniqSM StixTreeList
 578
 579 genCodeVecTbl target (CFlatRetVector label amodes) =
 580     returnSUs (\xs -> vectbl : xs)
 581   where
 582     vectbl = StData PtrKind (reverse (map (amodeToStix target) amodes))
 583
 584 \end{code}
 585
 586 Static closures are not so hard either.
 587
 588 \begin{code}
 589
 590 genCodeStaticClosure
 591     :: Target
 592     -> AbstractC
 593     -> SUniqSM StixTreeList
 594
 595 genCodeStaticClosure target (CStaticClosure _ cl_info cost_centre amodes) =
 596     returnSUs (\xs -> table : xs)
 597   where
 598     table = StData PtrKind (StCLbl info_lbl : body)
 599     info_lbl = infoTableLabelFromCI cl_info
 600
 601     body = if closureUpdReqd cl_info then
 602                 take (max mIN_UPD_SIZE (length amodes')) (amodes' ++ zeros)
 603            else
 604                 amodes'
 605
 606     zeros = StInt 0 : zeros
 607
 608     amodes' = map amodeZeroVoid amodes
 609
 610         -- Watch out for VoidKinds...cf. PprAbsC
 611     amodeZeroVoid item
 612       | getAmodeKind item == VoidKind = StInt 0
 613       | otherwise = amodeToStix target item
 614
 615 \end{code}
 616