ghc/utils/genapply/GenApply.hs

   1 {-# OPTIONS -cpp #-}
   2 module Main(main) where
   3
   4 #include "../../includes/ghcconfig.h"
   5 #include "../../includes/MachRegs.h"
   6 #include "../../includes/Constants.h"
   7
   8
   9 #if __GLASGOW_HASKELL__ >= 504
  10 import Text.PrettyPrint
  11 import Data.Word
  12 import Data.Bits
  13 import Data.List        ( intersperse )
  14 import System.Exit
  15 import System.Environment
  16 import System.IO
  17 #else
  18 import System
  19 import IO
  20 import Bits
  21 import Word
  22 import Pretty
  23 import List             ( intersperse )
  24 #endif
  25
  26 -- -----------------------------------------------------------------------------
  27 -- Argument kinds (rougly equivalent to PrimRep)
  28
  29 data ArgRep
  30   = N           -- non-ptr
  31   | P           -- ptr
  32   | V           -- void
  33   | F           -- float
  34   | D           -- double
  35   | L           -- long (64-bit)
  36
  37 -- size of a value in *words*
  38 argSize :: ArgRep -> Int
  39 argSize N = 1
  40 argSize P = 1
  41 argSize V = 0
  42 argSize F = 1
  43 argSize D = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int)
  44 argSize L = (8 `quot` SIZEOF_VOID_P :: Int)
  45
  46 showArg :: ArgRep -> Char
  47 showArg N = 'n'
  48 showArg P = 'p'
  49 showArg V = 'v'
  50 showArg F = 'f'
  51 showArg D = 'd'
  52 showArg L = 'l'
  53
  54 -- is a value a pointer?
  55 isPtr :: ArgRep -> Bool
  56 isPtr P = True
  57 isPtr _ = False
  58
  59 -- -----------------------------------------------------------------------------
  60 -- Registers
  61
  62 data RegStatus = Registerised | Unregisterised
  63
  64 type Reg = String
  65
  66 availableRegs :: RegStatus -> ([Reg],[Reg],[Reg],[Reg])
  67 availableRegs Unregisterised = ([],[],[],[])
  68 availableRegs Registerised =
  69   ( vanillaRegs MAX_REAL_VANILLA_REG,
  70     floatRegs   MAX_REAL_FLOAT_REG,
  71     doubleRegs  MAX_REAL_DOUBLE_REG,
  72     longRegs    MAX_REAL_LONG_REG
  73   )
  74
  75 vanillaRegs, floatRegs, doubleRegs, longRegs :: Int -> [Reg]
  76 vanillaRegs n = [ "R" ++ show m | m <- [2..n] ]  -- never use R1
  77 floatRegs   n = [ "F" ++ show m | m <- [1..n] ]
  78 doubleRegs  n = [ "D" ++ show m | m <- [1..n] ]
  79 longRegs    n = [ "L" ++ show m | m <- [1..n] ]
  80
  81 -- -----------------------------------------------------------------------------
  82 -- Loading/saving register arguments to the stack
  83
  84 loadRegArgs :: RegStatus -> Int -> [ArgRep] -> (Doc,Int)
  85 loadRegArgs regstatus sp args
  86  = (vcat (map (uncurry assign_stk_to_reg) reg_locs), sp')
  87  where
  88   (reg_locs, _leftovers, sp') = assignRegs regstatus sp args
  89
  90 -- a bit like assignRegs in CgRetConv.lhs
  91 assignRegs
  92         :: RegStatus            -- are we registerised?
  93         -> Int                  -- Sp of first arg
  94         -> [ArgRep]             -- args
  95         -> ([(Reg,Int)],        -- regs and offsets to load
  96             [ArgRep],           -- left-over args
  97             Int)                -- Sp of left-over args
  98 assignRegs regstatus sp args = assign sp args (availableRegs regstatus) []
  99
 100 assign sp [] regs doc = (doc, [], sp)
 101 assign sp (V : args) regs doc = assign sp args regs doc
 102 assign sp (arg : args) regs doc
 103  = case findAvailableReg arg regs of
 104     Just (reg, regs') -> assign (sp + argSize arg)  args regs'
 105                             ((reg, sp) : doc)
 106     Nothing -> (doc, (arg:args), sp)
 107
 108 findAvailableReg N (vreg:vregs, fregs, dregs, lregs) =
 109   Just (vreg, (vregs,fregs,dregs,lregs))
 110 findAvailableReg P (vreg:vregs, fregs, dregs, lregs) =
 111   Just (vreg, (vregs,fregs,dregs,lregs))
 112 findAvailableReg F (vregs, freg:fregs, dregs, lregs) =
 113   Just (freg, (vregs,fregs,dregs,lregs))
 114 findAvailableReg D (vregs, fregs, dreg:dregs, lregs) =
 115   Just (dreg, (vregs,fregs,dregs,lregs))
 116 findAvailableReg L (vregs, fregs, dregs, lreg:lregs) =
 117   Just (lreg, (vregs,fregs,dregs,lregs))
 118 findAvailableReg _ _ = Nothing
 119
 120 assign_reg_to_stk reg sp
 121    = loadSpWordOff (regRep reg) sp <> text " = " <> text reg <> semi
 122
 123 assign_stk_to_reg reg sp
 124    = text reg <> text " = " <> loadSpWordOff (regRep reg) sp <> semi
 125
 126 regRep ('F':_) = "F_"
 127 regRep ('D':_) = "D_"
 128 regRep ('L':_) = "L_"
 129 regRep _       = "W_"
 130
 131 loadSpWordOff :: String -> Int -> Doc
 132 loadSpWordOff rep off = text rep <> text "[Sp+WDS(" <> int off <> text ")]"
 133
 134 -- make a ptr/non-ptr bitmap from a list of argument types
 135 mkBitmap :: [ArgRep] -> Word32
 136 mkBitmap args = foldr f 0 args
 137  where f arg bm | isPtr arg = bm `shiftL` 1
 138                 | otherwise = (bm `shiftL` size) .|. ((1 `shiftL` size) - 1)
 139                 where size = argSize arg
 140
 141 -- -----------------------------------------------------------------------------
 142 -- Generating the application functions
 143
 144 -- A SUBTLE POINT about stg_ap functions (can't think of a better
 145 -- place to put this comment --SDM):
 146 --
 147 -- The entry convention to an stg_ap_ function is as follows: all the
 148 -- arguments are on the stack (we might revisit this at some point,
 149 -- but it doesn't make any difference on x86), and THERE IS AN EXTRA
 150 -- EMPTY STACK SLOT at the top of the stack.
 151 --
 152 -- Why?  Because in several cases, stg_ap_* will need an extra stack
 153 -- slot, eg. to push a return address in the THUNK case, and this is a
 154 -- way of pushing the stack check up into the caller which is probably
 155 -- doing one anyway.  Allocating the extra stack slot in the caller is
 156 -- also probably free, because it will be adjusting Sp after pushing
 157 -- the args anyway (this might not be true of register-rich machines
 158 -- when we start passing args to stg_ap_* in regs).
 159
 160 mkApplyName args
 161   = text "stg_ap_" <> text (map showArg args)
 162
 163 mkApplyRetName args
 164   = mkApplyName args <> text "_ret"
 165
 166 mkApplyInfoName args
 167   = mkApplyName args <> text "_info"
 168
 169 genMkPAP regstatus macro jump ticker disamb stack_apply
 170         is_pap args all_args_size fun_info_label
 171   =  smaller_arity_cases
 172   $$ exact_arity_case
 173   $$ larger_arity_case
 174
 175   where
 176     n_args = length args
 177
 178     -- offset of args on the stack, see large comment above.
 179     arg_sp_offset = 1
 180
 181 -- The SMALLER ARITY cases:
 182 --      if (arity == 1) {
 183 --          Sp[0] = Sp[1];
 184 --          Sp[1] = (W_)&stg_ap_1_info;
 185 --          JMP_(GET_ENTRY(R1.cl));
 186
 187     smaller_arity_cases = vcat [ smaller_arity i | i <- [1..n_args-1] ]
 188
 189     smaller_arity arity
 190         =  text "if (arity == " <> int arity <> text ") {" $$
 191            let
 192              (reg_doc, sp')
 193                 | stack_apply = (empty, arg_sp_offset)
 194                 | otherwise   = loadRegArgs regstatus arg_sp_offset these_args
 195            in
 196            nest 4 (vcat [
 197              text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
 198              reg_doc,
 199              vcat [ shuffle_down j | j <- [sp'..these_args_size] ],
 200              loadSpWordOff "W_" these_args_size <> text " = " <>
 201                 mkApplyInfoName rest_args <> semi,
 202              text "Sp_adj(" <> int (sp' -  1) <> text ");",
 203                 -- for a PAP, we have to arrange that the stack contains a
 204                 -- return address in the even that stg_PAP_entry fails its
 205                 -- heap check.  See stg_PAP_entry in Apply.hc for details.
 206              if is_pap
 207                 then text "R2 = " <> mkApplyInfoName these_args <> semi
 208                 else empty,
 209              text "jump " <> text jump <> semi
 210             ]) $$
 211            text "}"
 212         where
 213                 (these_args, rest_args) = splitAt arity args
 214                 these_args_size = sum (map argSize these_args)
 215
 216                 shuffle_down i =
 217                   loadSpWordOff "W_" (i-1) <> text " = " <>
 218                   loadSpWordOff "W_" i <> semi
 219
 220 -- The EXACT ARITY case
 221 --
 222 --      if (arity == 1) {
 223 --          Sp++;
 224 --          JMP_(GET_ENTRY(R1.cl));
 225
 226     exact_arity_case
 227         = text "if (arity == " <> int n_args <> text ") {" $$
 228           let
 229              (reg_doc, sp')
 230                 | stack_apply = (empty, arg_sp_offset)
 231                 | otherwise   = loadRegArgs regstatus arg_sp_offset args
 232           in
 233           nest 4 (vcat [
 234             text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();",
 235             reg_doc,
 236             text "Sp_adj(" <> int sp' <> text ");",
 237             if is_pap
 238                 then text "R2 = " <> fun_info_label <> semi
 239                 else empty,
 240             text "jump " <> text jump <> semi
 241           ])
 242
 243 -- The LARGER ARITY cases:
 244 --
 245 --      } else /* arity > 1 */ {
 246 --          BUILD_PAP(1,0,(W_)&stg_ap_v_info);
 247 --      }
 248
 249     larger_arity_case =
 250            text "} else {" $$
 251            nest 4 (vcat [
 252                 text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();",
 253                 text macro <> char '(' <> int n_args <> comma <>
 254                                         int all_args_size <>
 255                                         text "," <> fun_info_label <>
 256                                         text "," <> text disamb <>
 257                                         text ");"
 258            ]) $$
 259            char '}'
 260
 261 -- -----------------------------------------------------------------------------
 262 -- generate an apply function
 263
 264 -- args is a list of 'p', 'n', 'f', 'd' or 'l'
 265
 266 genApply regstatus args =
 267    let
 268     fun_ret_label  = mkApplyRetName args
 269     fun_info_label = mkApplyInfoName args
 270     all_args_size  = sum (map argSize args)
 271    in
 272     vcat [
 273       text "INFO_TABLE_RET(" <> mkApplyName args <> text ", " <>
 274         int all_args_size <> text "/*framsize*/," <>
 275         int (fromIntegral (mkBitmap args)) <> text "/*bitmap*/, " <>
 276         text "RET_SMALL)\n{",
 277       nest 4 (vcat [
 278        text "W_ info;",
 279        text "W_ arity;",
 280
 281 --    if fast == 1:
 282 --        print "static void *lbls[] ="
 283 --        print "  { [FUN]             &&fun_lbl,"
 284 --        print "    [FUN_1_0]         &&fun_lbl,"
 285 --        print "    [FUN_0_1]        &&fun_lbl,"
 286 --        print "    [FUN_2_0]        &&fun_lbl,"
 287 --        print "    [FUN_1_1]        &&fun_lbl,"
 288 --        print "    [FUN_0_2]        &&fun_lbl,"
 289 --        print "    [FUN_STATIC]      &&fun_lbl,"
 290 --        print "    [PAP]             &&pap_lbl,"
 291 --        print "    [THUNK]           &&thunk_lbl,"
 292 --        print "    [THUNK_1_0]              &&thunk_lbl,"
 293 --        print "    [THUNK_0_1]              &&thunk_lbl,"
 294 --        print "    [THUNK_2_0]              &&thunk_lbl,"
 295 --        print "    [THUNK_1_1]              &&thunk_lbl,"
 296 --        print "    [THUNK_0_2]              &&thunk_lbl,"
 297 --        print "    [THUNK_STATIC]    &&thunk_lbl,"
 298 --        print "    [THUNK_SELECTOR]  &&thunk_lbl,"
 299 --        print "    [IND]            &&ind_lbl,"
 300 --        print "    [IND_OLDGEN]      &&ind_lbl,"
 301 --        print "    [IND_STATIC]      &&ind_lbl,"
 302 --        print "    [IND_PERM]       &&ind_lbl,"
 303 --        print "    [IND_OLDGEN_PERM] &&ind_lbl"
 304 --        print "  };"
 305
 306        text "",
 307        text "IF_DEBUG(apply,foreign \"C\" debugBelch(\"" <> fun_ret_label <>
 308           text "... \"); foreign \"C\" printClosure(R1 \"ptr\"));",
 309
 310        text "IF_DEBUG(sanity,foreign \"C\" checkStackFrame(Sp+WDS(" <> int (1 + all_args_size)
 311         <> text ")\"ptr\"));",
 312
 313 --       text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <>
 314 --        text ", CurrentTSO->stack + CurrentTSO->stack_size));",
 315
 316        text "TICK_SLOW_CALL(" <> int (length args) <> text ");",
 317
 318        let do_assert [] _ = []
 319            do_assert (arg:args) offset
 320                 | isPtr arg = this : rest
 321                 | otherwise = rest
 322                 where this = text "ASSERT(LOOKS_LIKE_CLOSURE_PTR(Sp("
 323                                  <> int offset <> text ")));"
 324                       rest = do_assert args (offset + argSize arg)
 325        in
 326        vcat (do_assert args 1),
 327
 328        text  "again:",
 329        text  "info = %GET_STD_INFO(R1);",
 330
 331 --    if fast == 1:
 332 --        print "    goto *lbls[info->type];";
 333 --    else:
 334         text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(info)) {",
 335         nest 4 (vcat [
 336
 337 --    if fast == 1:
 338 --        print "    bco_lbl:"
 339 --    else:
 340         text "case BCO: {",
 341         nest 4 (vcat [
 342           text "arity = TO_W_(StgBCO_arity(R1));",
 343           text "ASSERT(arity > 0);",
 344           genMkPAP regstatus "BUILD_PAP" "ENTRY_LBL(stg_BCO)" "FUN" "BCO"
 345                 True{-stack apply-} False{-not a PAP-}
 346                 args all_args_size fun_info_label
 347          ]),
 348         text "}",
 349
 350 --    if fast == 1:
 351 --        print "    fun_lbl:"
 352 --    else:
 353         text "case FUN,",
 354         text "     FUN_1_0,",
 355         text "     FUN_0_1,",
 356         text "     FUN_2_0,",
 357         text "     FUN_1_1,",
 358         text "     FUN_0_2,",
 359         text "     FUN_STATIC: {",
 360         nest 4 (vcat [
 361           text "arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));",
 362           text "ASSERT(arity > 0);",
 363           genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(R1)" "FUN" "FUN"
 364                 False{-reg apply-} False{-not a PAP-}
 365                 args all_args_size fun_info_label
 366          ]),
 367         text "}",
 368
 369 --    if fast == 1:
 370 --        print "    pap_lbl:"
 371 --    else:
 372
 373         text "case PAP: {",
 374         nest 4 (vcat [
 375           text "arity = TO_W_(StgPAP_arity(R1));",
 376           text "ASSERT(arity > 0);",
 377           genMkPAP regstatus "NEW_PAP" "ENTRY_LBL(stg_PAP)" "PAP" "PAP"
 378                 True{-stack apply-} True{-is a PAP-}
 379                 args all_args_size fun_info_label
 380          ]),
 381         text "}",
 382
 383         text "",
 384
 385 --    if fast == 1:
 386 --        print "    thunk_lbl:"
 387 --    else:
 388         text "case AP,",
 389         text "     AP_STACK,",
 390         text "     CAF_BLACKHOLE,",
 391         text "     BLACKHOLE,",
 392         text "     SE_BLACKHOLE,",
 393         text "     SE_CAF_BLACKHOLE,",
 394         text "     THUNK,",
 395         text "     THUNK_1_0,",
 396         text "     THUNK_0_1,",
 397         text "     THUNK_2_0,",
 398         text "     THUNK_1_1,",
 399         text "     THUNK_0_2,",
 400         text "     THUNK_STATIC,",
 401         text "     THUNK_SELECTOR: {",
 402         nest 4 (vcat [
 403           text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
 404           text "Sp(0) = " <> fun_info_label <> text ";",
 405           text "jump %GET_ENTRY(R1);",
 406           text ""
 407          ]),
 408         text "}",
 409
 410 --    if fast == 1:
 411 --        print "    ind_lbl:"
 412 --    else:
 413         text "case IND,",
 414         text "     IND_OLDGEN,",
 415         text "     IND_STATIC,",
 416         text "     IND_PERM,",
 417         text "     IND_OLDGEN_PERM: {",
 418         nest 4 (vcat [
 419           text "R1 = StgInd_indirectee(R1);",
 420           text "goto again;"
 421          ]),
 422         text "}",
 423         text "",
 424
 425 --    if fast == 0:
 426
 427        text "default: {",
 428        nest 4 (
 429          text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\");"
 430        ),
 431        text "}"
 432
 433         ]),
 434        text "}"
 435       ]),
 436       text "}"
 437     ]
 438
 439 -- -----------------------------------------------------------------------------
 440 -- Making a stack apply
 441
 442 -- These little functions are like slow entry points.  They provide
 443 -- the layer between the PAP entry code and the function's fast entry
 444 -- point: namely they load arguments off the stack into registers (if
 445 -- available) and jump to the function's entry code.
 446 --
 447 -- On entry: R1 points to the function closure
 448 --           arguments are on the stack starting at Sp
 449 --
 450 -- Invariant: the list of arguments never contains void.  Since we're only
 451 -- interested in loading arguments off the stack here, we can ignore
 452 -- void arguments.
 453
 454 mkStackApplyEntryLabel:: [ArgRep] -> Doc
 455 mkStackApplyEntryLabel args = text "stg_ap_stk_" <> text (map showArg args)
 456
 457 genStackApply :: RegStatus -> [ArgRep] -> Doc
 458 genStackApply regstatus args =
 459   let fn_entry_label = mkStackApplyEntryLabel args in
 460   vcat [
 461     fn_entry_label,
 462     text "{", nest 4 body, text "}"
 463    ]
 464  where
 465    (assign_regs, sp') = loadRegArgs regstatus 0 args
 466    body = vcat [assign_regs,
 467                 text "Sp_adj" <> parens (int sp') <> semi,
 468                 text "jump %GET_ENTRY(R1);"
 469                 ]
 470
 471 -- -----------------------------------------------------------------------------
 472 -- Stack save entry points.
 473 --
 474 -- These code fragments are used to save registers on the stack at a heap
 475 -- check failure in the entry code for a function.  We also have to save R1
 476 -- and the return address (stg_gc_fun_info) on the stack.  See stg_gc_fun_gen
 477 -- in HeapStackCheck.hc for more details.
 478
 479 mkStackSaveEntryLabel :: [ArgRep] -> Doc
 480 mkStackSaveEntryLabel args = text "stg_stk_save_" <> text (map showArg args)
 481
 482 genStackSave :: RegStatus -> [ArgRep] -> Doc
 483 genStackSave regstatus args =
 484   let fn_entry_label= mkStackSaveEntryLabel args in
 485   vcat [
 486     fn_entry_label,
 487     text "{", nest 4 body, text "}"
 488    ]
 489  where
 490    body = vcat [text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
 491                 vcat (map (uncurry assign_reg_to_stk) reg_locs),
 492                 text "Sp(2) = R1;",
 493                 text "Sp(1) =" <+> int stk_args <> semi,
 494                 text "Sp(0) = stg_gc_fun_info;",
 495                 text "jump stg_gc_noregs;"
 496                 ]
 497
 498    std_frame_size = 3 -- the std bits of the frame. See StgRetFun in Closures.h,
 499                       -- and the comment on stg_fun_gc_gen in HeapStackCheck.hc.
 500    (reg_locs, leftovers, sp_offset) = assignRegs regstatus std_frame_size args
 501
 502    -- number of words of arguments on the stack.
 503    stk_args = sum (map argSize leftovers) + sp_offset - std_frame_size
 504
 505 -- -----------------------------------------------------------------------------
 506 -- The prologue...
 507
 508 main = do
 509   args <- getArgs
 510   regstatus <- case args of
 511                  [] -> return Registerised
 512                  ["-u"] -> return Unregisterised
 513                  _other -> do hPutStrLn stderr "syntax: genapply [-u]"
 514                               exitWith (ExitFailure 1)
 515   let the_code = vcat [
 516                 text "// DO NOT EDIT!",
 517                 text "// Automatically generated by GenApply.hs",
 518                 text "",
 519                 text "#include \"Cmm.h\"",
 520                 text "#include \"AutoApply.h\"",
 521                 text "",
 522
 523                 vcat (intersperse (text "") $
 524                    map (genApply regstatus) applyTypes),
 525                 vcat (intersperse (text "") $
 526                    map (genStackFns regstatus) stackApplyTypes),
 527
 528                 genStackApplyArray stackApplyTypes,
 529                 genStackSaveArray stackApplyTypes,
 530                 genBitmapArray stackApplyTypes,
 531
 532                 text ""  -- add a newline at the end of the file
 533             ]
 534   -- in
 535   putStr (render the_code)
 536
 537 -- These have been shown to cover about 99% of cases in practice...
 538 applyTypes = [
 539         [V],
 540         [F],
 541         [D],
 542         [L],
 543         [N],
 544         [P],
 545         [P,V],
 546         [P,P],
 547         [P,P,V],
 548         [P,P,P],
 549         [P,P,P,V],
 550         [P,P,P,P],
 551         [P,P,P,P,P],
 552         [P,P,P,P,P,P]
 553    ]
 554
 555 -- No need for V args in the stack apply cases.
 556 -- ToDo: the stack apply and stack save code doesn't make a distinction
 557 -- between N and P (they both live in the same register), only the bitmap
 558 -- changes, so we could share the apply/save code between lots of cases.
 559 stackApplyTypes = [
 560         [],
 561         [N],
 562         [P],
 563         [F],
 564         [D],
 565         [L],
 566         [N,N],
 567         [N,P],
 568         [P,N],
 569         [P,P],
 570         [N,N,N],
 571         [N,N,P],
 572         [N,P,N],
 573         [N,P,P],
 574         [P,N,N],
 575         [P,N,P],
 576         [P,P,N],
 577         [P,P,P],
 578         [P,P,P,P],
 579         [P,P,P,P,P],
 580         [P,P,P,P,P,P],
 581         [P,P,P,P,P,P,P],
 582         [P,P,P,P,P,P,P,P]
 583    ]
 584
 585 genStackFns regstatus args
 586   =  genStackApply regstatus args
 587   $$ genStackSave regstatus args
 588
 589
 590 genStackApplyArray types =
 591   vcat [
 592     text "section \"rodata\" {",
 593     text "stg_ap_stack_entries:",
 594     text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
 595     vcat (map arr_ent types),
 596     text "}"
 597   ]
 598  where
 599   arr_ent ty = text "W_" <+> mkStackApplyEntryLabel ty <> semi
 600
 601 genStackSaveArray types =
 602   vcat [
 603     text "section \"rodata\" {",
 604     text "stg_stack_save_entries:",
 605     text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
 606     vcat (map arr_ent types),
 607     text "}"
 608   ]
 609  where
 610   arr_ent ty = text "W_" <+> mkStackSaveEntryLabel ty <> semi
 611
 612 genBitmapArray :: [[ArgRep]] -> Doc
 613 genBitmapArray types =
 614   vcat [
 615     text "section \"rodata\" {",
 616     text "stg_arg_bitmaps:",
 617     text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
 618     vcat (map gen_bitmap types),
 619     text "}"
 620   ]
 621   where
 622    gen_bitmap ty = text "W_" <+> int bitmap_val <> semi
 623         where bitmap_val =
 624                 (fromIntegral (mkBitmap ty) `shiftL` BITMAP_BITS_SHIFT)
 625                  .|. sum (map argSize ty)
 626