1 {-# OPTIONS -cpp -fglasgow-exts #-}
2 module Main(main) where
4 #include "../../includes/ghcconfig.h"
5 #include "../../includes/MachRegs.h"
6 #include "../../includes/Constants.h"
9 #include "../../includes/MachDeps.h"
11 import Text.PrettyPrint
14 import Data.List ( intersperse )
16 import System.Environment
19 -- -----------------------------------------------------------------------------
20 -- Argument kinds (rougly equivalent to PrimRep)
30 -- size of a value in *words*
31 argSize :: ArgRep -> Int
36 argSize D = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int)
37 argSize L = (8 `quot` SIZEOF_VOID_P :: Int)
39 showArg :: ArgRep -> Char
47 -- is a value a pointer?
48 isPtr :: ArgRep -> Bool
52 -- -----------------------------------------------------------------------------
55 data RegStatus = Registerised | Unregisterised
59 availableRegs :: RegStatus -> ([Reg],[Reg],[Reg],[Reg])
60 availableRegs Unregisterised = ([],[],[],[])
61 availableRegs Registerised =
62 ( vanillaRegs MAX_REAL_VANILLA_REG,
63 floatRegs MAX_REAL_FLOAT_REG,
64 doubleRegs MAX_REAL_DOUBLE_REG,
65 longRegs MAX_REAL_LONG_REG
68 vanillaRegs, floatRegs, doubleRegs, longRegs :: Int -> [Reg]
69 vanillaRegs n = [ "R" ++ show m | m <- [2..n] ] -- never use R1
70 floatRegs n = [ "F" ++ show m | m <- [1..n] ]
71 doubleRegs n = [ "D" ++ show m | m <- [1..n] ]
72 longRegs n = [ "L" ++ show m | m <- [1..n] ]
74 -- -----------------------------------------------------------------------------
75 -- Loading/saving register arguments to the stack
77 loadRegArgs :: RegStatus -> Int -> [ArgRep] -> (Doc,Int)
78 loadRegArgs regstatus sp args
79 = (loadRegOffs reg_locs, sp')
80 where (reg_locs, _, sp') = assignRegs regstatus sp args
82 loadRegOffs :: [(Reg,Int)] -> Doc
83 loadRegOffs = vcat . map (uncurry assign_stk_to_reg)
85 saveRegOffs :: [(Reg,Int)] -> Doc
86 saveRegOffs = vcat . map (uncurry assign_reg_to_stk)
88 -- a bit like assignRegs in CgRetConv.lhs
90 :: RegStatus -- are we registerised?
91 -> Int -- Sp of first arg
93 -> ([(Reg,Int)], -- regs and offsets to load
94 [ArgRep], -- left-over args
95 Int) -- Sp of left-over args
96 assignRegs regstatus sp args = assign sp args (availableRegs regstatus) []
98 assign sp [] regs doc = (doc, [], sp)
99 assign sp (V : args) regs doc = assign sp args regs doc
100 assign sp (arg : args) regs doc
101 = case findAvailableReg arg regs of
102 Just (reg, regs') -> assign (sp + argSize arg) args regs'
104 Nothing -> (doc, (arg:args), sp)
106 findAvailableReg N (vreg:vregs, fregs, dregs, lregs) =
107 Just (vreg, (vregs,fregs,dregs,lregs))
108 findAvailableReg P (vreg:vregs, fregs, dregs, lregs) =
109 Just (vreg, (vregs,fregs,dregs,lregs))
110 findAvailableReg F (vregs, freg:fregs, dregs, lregs) =
111 Just (freg, (vregs,fregs,dregs,lregs))
112 findAvailableReg D (vregs, fregs, dreg:dregs, lregs) =
113 Just (dreg, (vregs,fregs,dregs,lregs))
114 findAvailableReg L (vregs, fregs, dregs, lreg:lregs) =
115 Just (lreg, (vregs,fregs,dregs,lregs))
116 findAvailableReg _ _ = Nothing
118 assign_reg_to_stk reg sp
119 = loadSpWordOff (regRep reg) sp <> text " = " <> text reg <> semi
121 assign_stk_to_reg reg sp
122 = text reg <> text " = " <> loadSpWordOff (regRep reg) sp <> semi
124 regRep ('F':_) = "F_"
125 regRep ('D':_) = "D_"
126 regRep ('L':_) = "L_"
129 loadSpWordOff :: String -> Int -> Doc
130 loadSpWordOff rep off = text rep <> text "[Sp+WDS(" <> int off <> text ")]"
132 -- make a ptr/non-ptr bitmap from a list of argument types
133 mkBitmap :: [ArgRep] -> Word32
134 mkBitmap args = foldr f 0 args
135 where f arg bm | isPtr arg = bm `shiftL` 1
136 | otherwise = (bm `shiftL` size) .|. ((1 `shiftL` size) - 1)
137 where size = argSize arg
139 -- -----------------------------------------------------------------------------
140 -- Generating the application functions
142 -- A SUBTLE POINT about stg_ap functions (can't think of a better
143 -- place to put this comment --SDM):
145 -- The entry convention to an stg_ap_ function is as follows: all the
146 -- arguments are on the stack (we might revisit this at some point,
147 -- but it doesn't make any difference on x86), and THERE IS AN EXTRA
148 -- EMPTY STACK SLOT at the top of the stack.
150 -- Why? Because in several cases, stg_ap_* will need an extra stack
151 -- slot, eg. to push a return address in the THUNK case, and this is a
152 -- way of pushing the stack check up into the caller which is probably
153 -- doing one anyway. Allocating the extra stack slot in the caller is
154 -- also probably free, because it will be adjusting Sp after pushing
155 -- the args anyway (this might not be true of register-rich machines
156 -- when we start passing args to stg_ap_* in regs).
159 = text "stg_ap_" <> text (map showArg args)
162 = mkApplyName args <> text "_ret"
165 = mkApplyName args <> text "_fast"
168 = mkApplyName args <> text "_info"
170 mb_tag_node arity | Just tag <- tagForArity arity = mkTagStmt tag <> semi
173 mkTagStmt tag = text ("R1 = R1 + "++ show tag)
175 genMkPAP regstatus macro jump ticker disamb
176 no_load_regs -- don't load argumnet regs before jumping
177 args_in_regs -- arguments are already in regs
178 is_pap args all_args_size fun_info_label
180 = smaller_arity_cases
187 -- offset of arguments on the stack at slow apply calls.
188 stk_args_slow_offset = 1
192 | otherwise = stk_args_slow_offset
194 -- The SMALLER ARITY cases:
197 -- Sp[1] = (W_)&stg_ap_1_info;
198 -- JMP_(GET_ENTRY(R1.cl));
199 smaller_arity_cases = vcat [ smaller_arity i | i <- [1..n_args-1] ]
202 = text "if (arity == " <> int arity <> text ") {" $$
204 -- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
206 -- load up regs for the call, if necessary
209 -- If we have more args in registers than are required
210 -- for the call, then we must save some on the stack,
211 -- and set up the stack for the follow-up call.
212 -- If the extra arguments are on the stack, then we must
213 -- instead shuffle them down to make room for the info
214 -- table for the follow-on call.
217 else shuffle_extra_args,
219 -- for a PAP, we have to arrange that the stack contains a
220 -- return address in the even that stg_PAP_entry fails its
221 -- heap check. See stg_PAP_entry in Apply.hc for details.
223 then text "R2 = " <> mkApplyInfoName this_call_args <> semi
226 if is_fun_case then mb_tag_node arity else empty,
227 text "jump " <> text jump <> semi
232 -- offsets in case we need to save regs:
234 = assignRegs regstatus stk_args_offset args
236 -- register assignment for *this function call*
237 (reg_locs', reg_call_leftovers, reg_call_sp_stk_args)
238 = assignRegs regstatus stk_args_offset (take arity args)
241 | no_load_regs || args_in_regs = empty
242 | otherwise = loadRegOffs reg_locs'
244 (this_call_args, rest_args) = splitAt arity args
246 -- the offset of the stack args from initial Sp
248 | args_in_regs = stk_args_offset
249 | no_load_regs = stk_args_offset
250 | otherwise = reg_call_sp_stk_args
252 -- the stack args themselves
254 | args_in_regs = reg_call_leftovers -- sp offsets are wrong
255 | no_load_regs = this_call_args
256 | otherwise = reg_call_leftovers
258 stack_args_size = sum (map argSize this_call_stack_args)
260 overflow_regs = args_in_regs && length reg_locs > length reg_locs'
263 = -- we have extra arguments in registers to save
265 extra_reg_locs = drop (length reg_locs') (reverse reg_locs)
266 adj_reg_locs = [ (reg, off - adj + 1) |
267 (reg,off) <- extra_reg_locs ]
268 adj = case extra_reg_locs of
269 (reg, fst_off):_ -> fst_off
270 size = snd (last adj_reg_locs)
272 text "Sp_adj(" <> int (-size - 1) <> text ");" $$
273 saveRegOffs adj_reg_locs $$
274 loadSpWordOff "W_" 0 <> text " = " <>
275 mkApplyInfoName rest_args <> semi
278 = vcat (map shuffle_down
279 [sp_stk_args .. sp_stk_args+stack_args_size-1]) $$
280 loadSpWordOff "W_" (sp_stk_args+stack_args_size-1)
282 <> mkApplyInfoName rest_args <> semi $$
283 text "Sp_adj(" <> int (sp_stk_args - 1) <> text ");"
286 loadSpWordOff "W_" (i-1) <> text " = " <>
287 loadSpWordOff "W_" i <> semi
289 -- The EXACT ARITY case
293 -- JMP_(GET_ENTRY(R1.cl));
296 = text "if (arity == " <> int n_args <> text ") {" $$
299 | no_load_regs || args_in_regs = (empty, stk_args_offset)
300 | otherwise = loadRegArgs regstatus stk_args_offset args
303 -- text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();",
305 text "Sp_adj(" <> int sp' <> text ");",
307 then text "R2 = " <> fun_info_label <> semi
309 if is_fun_case then mb_tag_node n_args else empty,
310 text "jump " <> text jump <> semi
313 -- The LARGER ARITY cases:
315 -- } else /* arity > 1 */ {
316 -- BUILD_PAP(1,0,(W_)&stg_ap_v_info);
324 text "Sp_adj(" <> int (-sp_offset) <> text ");" $$
330 -- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();",
332 -- Before building the PAP, tag the function closure pointer
335 text "if (arity < " <> int tAG_BITS_MAX <> text ") {",
336 text " R1 = R1 + arity" <> semi,
341 text macro <> char '(' <> int n_args <> comma <>
343 text "," <> fun_info_label <>
344 text "," <> text disamb <>
349 -- offsets in case we need to save regs:
350 (reg_locs, leftovers, sp_offset)
351 = assignRegs regstatus stk_args_slow_offset args
352 -- BUILD_PAP assumes args start at offset 1
354 -- --------------------------------------
355 -- Examine tag bits of function pointer and enter it
356 -- directly if needed.
357 -- TODO: remove the redundant case in the original code.
358 enterFastPath regstatus no_load_regs args_in_regs args
359 | Just tag <- tagForArity (length args)
360 = enterFastPathHelper tag regstatus no_load_regs args_in_regs args
361 enterFastPath _ _ _ _ = empty
363 -- Copied from Constants.lhs & CgUtils.hs, i'd rather have this imported:
365 tAG_BITS = (TAG_BITS :: Int)
366 tAG_BITS_MAX = ((1 `shiftL` tAG_BITS) :: Int)
368 tagForArity :: Int -> Maybe Int
369 tagForArity i | i < tAG_BITS_MAX = Just i
370 | otherwise = Nothing
372 enterFastPathHelper tag regstatus no_load_regs args_in_regs args =
373 vcat [text "if (GETTAG(R1)==" <> int tag <> text ") {",
375 text " Sp_adj(" <> int sp' <> text ");",
376 -- enter, but adjust offset with tag
377 text " jump " <> text "%GET_ENTRY(R1-" <> int tag <> text ");",
380 -- I don't totally understand this code, I copied it from
384 -- offset of arguments on the stack at slow apply calls.
385 stk_args_slow_offset = 1
389 | otherwise = stk_args_slow_offset
392 | no_load_regs || args_in_regs = (empty, stk_args_offset)
393 | otherwise = loadRegArgs regstatus stk_args_offset args
398 | Just tag <- tagForArity arity
400 text "W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;",
401 text "W_[SLOW_CALLS_" <> int arity <> text "] = W_[SLOW_CALLS_" <> int arity <> text "] + 1;",
402 text "if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == " <> int arity <> text " ) {",
403 text " W_[RIGHT_ARITY_" <> int arity <> text "] = W_[RIGHT_ARITY_" <> int arity <> text "] + 1;",
404 text " if (GETTAG(R1)==" <> int tag <> text ") {",
405 text " W_[TAGGED_PTR_" <> int arity <> text "] = W_[TAGGED_PTR_" <> int arity <> text "] + 1;",
407 -- force a halt when not tagged!
412 tickForArity _ = text "W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;"
414 -- -----------------------------------------------------------------------------
415 -- generate an apply function
417 -- args is a list of 'p', 'n', 'f', 'd' or 'l'
418 formalParam :: ArgRep -> Int -> Doc
419 formalParam V _ = empty
421 formalParamType arg <> space <>
422 text "arg" <> int n <> text ", "
423 formalParamType arg | isPtr arg = text "\"ptr\"" <> space <> argRep arg
424 | otherwise = argRep arg
431 genApply regstatus args =
433 fun_ret_label = mkApplyRetName args
434 fun_info_label = mkApplyInfoName args
435 all_args_size = sum (map argSize args)
438 text "INFO_TABLE_RET(" <> mkApplyName args <> text ", " <>
439 text "RET_SMALL, " <> (cat $ zipWith formalParam args [1..]) <>
446 -- print "static void *lbls[] ="
447 -- print " { [FUN] &&fun_lbl,"
448 -- print " [FUN_1_0] &&fun_lbl,"
449 -- print " [FUN_0_1] &&fun_lbl,"
450 -- print " [FUN_2_0] &&fun_lbl,"
451 -- print " [FUN_1_1] &&fun_lbl,"
452 -- print " [FUN_0_2] &&fun_lbl,"
453 -- print " [FUN_STATIC] &&fun_lbl,"
454 -- print " [PAP] &&pap_lbl,"
455 -- print " [THUNK] &&thunk_lbl,"
456 -- print " [THUNK_1_0] &&thunk_lbl,"
457 -- print " [THUNK_0_1] &&thunk_lbl,"
458 -- print " [THUNK_2_0] &&thunk_lbl,"
459 -- print " [THUNK_1_1] &&thunk_lbl,"
460 -- print " [THUNK_0_2] &&thunk_lbl,"
461 -- print " [THUNK_STATIC] &&thunk_lbl,"
462 -- print " [THUNK_SELECTOR] &&thunk_lbl,"
463 -- print " [IND] &&ind_lbl,"
464 -- print " [IND_OLDGEN] &&ind_lbl,"
465 -- print " [IND_STATIC] &&ind_lbl,"
466 -- print " [IND_PERM] &&ind_lbl,"
467 -- print " [IND_OLDGEN_PERM] &&ind_lbl"
470 tickForArity (length args),
472 text "IF_DEBUG(apply,foreign \"C\" debugBelch(\"" <> fun_ret_label <>
473 text "... \"); foreign \"C\" printClosure(R1 \"ptr\"));",
475 text "IF_DEBUG(sanity,foreign \"C\" checkStackFrame(Sp+WDS(" <> int (1 + all_args_size)
476 <> text ")\"ptr\"));",
478 -- text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <>
479 -- text ", CurrentTSO->stack + CurrentTSO->stack_size));",
481 -- text "TICK_SLOW_CALL(" <> int (length args) <> text ");",
483 let do_assert [] _ = []
484 do_assert (arg:args) offset
485 | isPtr arg = this : rest
487 where this = text "ASSERT(LOOKS_LIKE_CLOSURE_PTR(Sp("
488 <> int offset <> text ")));"
489 rest = do_assert args (offset + argSize arg)
491 vcat (do_assert args 1),
495 -- if pointer is tagged enter it fast!
496 enterFastPath regstatus False False args,
498 -- Functions can be tagged, so we untag them!
499 text "R1 = UNTAG(R1);",
500 text "info = %INFO_PTR(R1);",
503 -- print " goto *lbls[info->type];";
505 text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(%STD_INFO(info)))) {",
513 text "arity = TO_W_(StgBCO_arity(R1));",
514 text "ASSERT(arity > 0);",
515 genMkPAP regstatus "BUILD_PAP" "ENTRY_LBL(stg_BCO)" "FUN" "BCO"
516 True{-stack apply-} False{-args on stack-} False{-not a PAP-}
517 args all_args_size fun_info_label {- tag stmt -}False
530 text " FUN_STATIC: {",
532 text "arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));",
533 text "ASSERT(arity > 0);",
534 genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" "FUN" "FUN"
535 False{-reg apply-} False{-args on stack-} False{-not a PAP-}
536 args all_args_size fun_info_label {- tag stmt -}True
546 text "arity = TO_W_(StgPAP_arity(R1));",
547 text "ASSERT(arity > 0);",
548 genMkPAP regstatus "NEW_PAP" "stg_PAP_apply" "PAP" "PAP"
549 True{-stack apply-} False{-args on stack-} True{-is a PAP-}
550 args all_args_size fun_info_label {- tag stmt -}False
557 -- print " thunk_lbl:"
561 text " CAF_BLACKHOLE,",
563 text " SE_BLACKHOLE,",
564 text " SE_CAF_BLACKHOLE,",
571 text " THUNK_STATIC,",
572 text " THUNK_SELECTOR: {",
574 -- text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
575 text "Sp(0) = " <> fun_info_label <> text ";",
576 -- CAREFUL! in SMP mode, the info table may already have been
577 -- overwritten by an indirection, so we must enter the original
578 -- info pointer we read, don't read it again, because it might
579 -- not be enterable any more.
580 text "jump %ENTRY_CODE(info);",
592 text " IND_OLDGEN_PERM: {",
594 text "R1 = StgInd_indirectee(R1);",
595 -- An indirection node might contain a tagged pointer
605 text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\") never returns;"
615 -- -----------------------------------------------------------------------------
616 -- Making a fast unknown application, args are in regs
618 genApplyFast regstatus args =
620 fun_fast_label = mkApplyFastName args
621 fun_ret_label = text "RET_LBL" <> parens (mkApplyName args)
622 fun_info_label = mkApplyInfoName args
623 all_args_size = sum (map argSize args)
632 tickForArity (length args),
634 -- if pointer is tagged enter it fast!
635 enterFastPath regstatus False True args,
637 -- Functions can be tagged, so we untag them!
638 text "R1 = UNTAG(R1);",
639 text "info = %GET_STD_INFO(R1);",
640 text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(info))) {",
648 text " FUN_STATIC: {",
650 text "arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));",
651 text "ASSERT(arity > 0);",
652 genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" "FUN" "FUN"
653 False{-reg apply-} True{-args in regs-} False{-not a PAP-}
654 args all_args_size fun_info_label {- tag stmt -}True
660 (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args
661 -- leave a one-word space on the top of the stack when
662 -- calling the slow version
665 text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
666 saveRegOffs reg_locs,
667 text "jump" <+> fun_ret_label <> semi
676 -- -----------------------------------------------------------------------------
677 -- Making a stack apply
679 -- These little functions are like slow entry points. They provide
680 -- the layer between the PAP entry code and the function's fast entry
681 -- point: namely they load arguments off the stack into registers (if
682 -- available) and jump to the function's entry code.
684 -- On entry: R1 points to the function closure
685 -- arguments are on the stack starting at Sp
687 -- Invariant: the list of arguments never contains void. Since we're only
688 -- interested in loading arguments off the stack here, we can ignore
691 mkStackApplyEntryLabel:: [ArgRep] -> Doc
692 mkStackApplyEntryLabel args = text "stg_ap_stk_" <> text (map showArg args)
694 genStackApply :: RegStatus -> [ArgRep] -> Doc
695 genStackApply regstatus args =
696 let fn_entry_label = mkStackApplyEntryLabel args in
699 text "{", nest 4 body, text "}"
702 (assign_regs, sp') = loadRegArgs regstatus 0 args
703 body = vcat [assign_regs,
704 text "Sp_adj" <> parens (int sp') <> semi,
705 text "jump %GET_ENTRY(UNTAG(R1));"
708 -- -----------------------------------------------------------------------------
709 -- Stack save entry points.
711 -- These code fragments are used to save registers on the stack at a heap
712 -- check failure in the entry code for a function. We also have to save R1
713 -- and the return address (stg_gc_fun_info) on the stack. See stg_gc_fun_gen
714 -- in HeapStackCheck.hc for more details.
716 mkStackSaveEntryLabel :: [ArgRep] -> Doc
717 mkStackSaveEntryLabel args = text "stg_stk_save_" <> text (map showArg args)
719 genStackSave :: RegStatus -> [ArgRep] -> Doc
720 genStackSave regstatus args =
721 let fn_entry_label= mkStackSaveEntryLabel args in
724 text "{", nest 4 body, text "}"
727 body = vcat [text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
728 saveRegOffs reg_locs,
730 text "Sp(1) =" <+> int stk_args <> semi,
731 text "Sp(0) = stg_gc_fun_info;",
732 text "jump stg_gc_noregs;"
735 std_frame_size = 3 -- the std bits of the frame. See StgRetFun in Closures.h,
736 -- and the comment on stg_fun_gc_gen in HeapStackCheck.hc.
737 (reg_locs, leftovers, sp_offset) = assignRegs regstatus std_frame_size args
739 -- number of words of arguments on the stack.
740 stk_args = sum (map argSize leftovers) + sp_offset - std_frame_size
742 -- -----------------------------------------------------------------------------
747 regstatus <- case args of
748 [] -> return Registerised
749 ["-u"] -> return Unregisterised
750 _other -> do hPutStrLn stderr "syntax: genapply [-u]"
751 exitWith (ExitFailure 1)
752 let the_code = vcat [
753 text "// DO NOT EDIT!",
754 text "// Automatically generated by GenApply.hs",
756 text "#include \"Cmm.h\"",
757 text "#include \"AutoApply.h\"",
760 vcat (intersperse (text "") $
761 map (genApply regstatus) applyTypes),
762 vcat (intersperse (text "") $
763 map (genStackFns regstatus) stackApplyTypes),
765 vcat (intersperse (text "") $
766 map (genApplyFast regstatus) applyTypes),
768 genStackApplyArray stackApplyTypes,
769 genStackSaveArray stackApplyTypes,
770 genBitmapArray stackApplyTypes,
772 text "" -- add a newline at the end of the file
775 putStr (render the_code)
777 -- These have been shown to cover about 99% of cases in practice...
795 -- No need for V args in the stack apply cases.
796 -- ToDo: the stack apply and stack save code doesn't make a distinction
797 -- between N and P (they both live in the same register), only the bitmap
798 -- changes, so we could share the apply/save code between lots of cases.
825 genStackFns regstatus args
826 = genStackApply regstatus args
827 $$ genStackSave regstatus args
830 genStackApplyArray types =
832 text "section \"relrodata\" {",
833 text "stg_ap_stack_entries:",
834 text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
835 vcat (map arr_ent types),
839 arr_ent ty = text "W_" <+> mkStackApplyEntryLabel ty <> semi
841 genStackSaveArray types =
843 text "section \"relrodata\" {",
844 text "stg_stack_save_entries:",
845 text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
846 vcat (map arr_ent types),
850 arr_ent ty = text "W_" <+> mkStackSaveEntryLabel ty <> semi
852 genBitmapArray :: [[ArgRep]] -> Doc
853 genBitmapArray types =
855 text "section \"rodata\" {",
856 text "stg_arg_bitmaps:",
857 text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
858 vcat (map gen_bitmap types),
862 gen_bitmap ty = text "W_" <+> int bitmap_val <> semi
864 (fromIntegral (mkBitmap ty) `shiftL` BITMAP_BITS_SHIFT)
865 .|. sum (map argSize ty)