1 {-# OPTIONS -cpp -fglasgow-exts #-}
3 -- The above warning supression flag is a temporary kludge.
4 -- While working on this module you are encouraged to remove it and fix
5 -- any warnings in the module. See
6 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 module Main(main) where
10 #include "../../includes/ghcconfig.h"
11 #include "../../includes/MachRegs.h"
12 #include "../../includes/Constants.h"
14 -- Needed for TAG_BITS
15 #include "../../includes/MachDeps.h"
17 import Text.PrettyPrint
20 import Data.List ( intersperse )
22 import System.Environment
25 -- -----------------------------------------------------------------------------
26 -- Argument kinds (rougly equivalent to PrimRep)
36 -- size of a value in *words*
37 argSize :: ArgRep -> Int
42 argSize D = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int)
43 argSize L = (8 `quot` SIZEOF_VOID_P :: Int)
45 showArg :: ArgRep -> Char
53 -- is a value a pointer?
54 isPtr :: ArgRep -> Bool
58 -- -----------------------------------------------------------------------------
61 data RegStatus = Registerised | Unregisterised
65 availableRegs :: RegStatus -> ([Reg],[Reg],[Reg],[Reg])
66 availableRegs Unregisterised = ([],[],[],[])
67 availableRegs Registerised =
68 ( vanillaRegs MAX_REAL_VANILLA_REG,
69 floatRegs MAX_REAL_FLOAT_REG,
70 doubleRegs MAX_REAL_DOUBLE_REG,
71 longRegs MAX_REAL_LONG_REG
74 vanillaRegs, floatRegs, doubleRegs, longRegs :: Int -> [Reg]
75 vanillaRegs n = [ "R" ++ show m | m <- [2..n] ] -- never use R1
76 floatRegs n = [ "F" ++ show m | m <- [1..n] ]
77 doubleRegs n = [ "D" ++ show m | m <- [1..n] ]
78 longRegs n = [ "L" ++ show m | m <- [1..n] ]
80 -- -----------------------------------------------------------------------------
81 -- Loading/saving register arguments to the stack
83 loadRegArgs :: RegStatus -> Int -> [ArgRep] -> (Doc,Int)
84 loadRegArgs regstatus sp args
85 = (loadRegOffs reg_locs, sp')
86 where (reg_locs, _, sp') = assignRegs regstatus sp args
88 loadRegOffs :: [(Reg,Int)] -> Doc
89 loadRegOffs = vcat . map (uncurry assign_stk_to_reg)
91 saveRegOffs :: [(Reg,Int)] -> Doc
92 saveRegOffs = vcat . map (uncurry assign_reg_to_stk)
94 -- a bit like assignRegs in CgRetConv.lhs
96 :: RegStatus -- are we registerised?
97 -> Int -- Sp of first arg
99 -> ([(Reg,Int)], -- regs and offsets to load
100 [ArgRep], -- left-over args
101 Int) -- Sp of left-over args
102 assignRegs regstatus sp args = assign sp args (availableRegs regstatus) []
104 assign sp [] regs doc = (doc, [], sp)
105 assign sp (V : args) regs doc = assign sp args regs doc
106 assign sp (arg : args) regs doc
107 = case findAvailableReg arg regs of
108 Just (reg, regs') -> assign (sp + argSize arg) args regs'
110 Nothing -> (doc, (arg:args), sp)
112 findAvailableReg N (vreg:vregs, fregs, dregs, lregs) =
113 Just (vreg, (vregs,fregs,dregs,lregs))
114 findAvailableReg P (vreg:vregs, fregs, dregs, lregs) =
115 Just (vreg, (vregs,fregs,dregs,lregs))
116 findAvailableReg F (vregs, freg:fregs, dregs, lregs) =
117 Just (freg, (vregs,fregs,dregs,lregs))
118 findAvailableReg D (vregs, fregs, dreg:dregs, lregs) =
119 Just (dreg, (vregs,fregs,dregs,lregs))
120 findAvailableReg L (vregs, fregs, dregs, lreg:lregs) =
121 Just (lreg, (vregs,fregs,dregs,lregs))
122 findAvailableReg _ _ = Nothing
124 assign_reg_to_stk reg sp
125 = loadSpWordOff (regRep reg) sp <> text " = " <> text reg <> semi
127 assign_stk_to_reg reg sp
128 = text reg <> text " = " <> loadSpWordOff (regRep reg) sp <> semi
130 regRep ('F':_) = "F_"
131 regRep ('D':_) = "D_"
132 regRep ('L':_) = "L_"
135 loadSpWordOff :: String -> Int -> Doc
136 loadSpWordOff rep off = text rep <> text "[Sp+WDS(" <> int off <> text ")]"
138 -- make a ptr/non-ptr bitmap from a list of argument types
139 mkBitmap :: [ArgRep] -> Word32
140 mkBitmap args = foldr f 0 args
141 where f arg bm | isPtr arg = bm `shiftL` 1
142 | otherwise = (bm `shiftL` size) .|. ((1 `shiftL` size) - 1)
143 where size = argSize arg
145 -- -----------------------------------------------------------------------------
146 -- Generating the application functions
148 -- A SUBTLE POINT about stg_ap functions (can't think of a better
149 -- place to put this comment --SDM):
151 -- The entry convention to an stg_ap_ function is as follows: all the
152 -- arguments are on the stack (we might revisit this at some point,
153 -- but it doesn't make any difference on x86), and THERE IS AN EXTRA
154 -- EMPTY STACK SLOT at the top of the stack.
156 -- Why? Because in several cases, stg_ap_* will need an extra stack
157 -- slot, eg. to push a return address in the THUNK case, and this is a
158 -- way of pushing the stack check up into the caller which is probably
159 -- doing one anyway. Allocating the extra stack slot in the caller is
160 -- also probably free, because it will be adjusting Sp after pushing
161 -- the args anyway (this might not be true of register-rich machines
162 -- when we start passing args to stg_ap_* in regs).
165 = text "stg_ap_" <> text (map showArg args)
168 = mkApplyName args <> text "_ret"
171 = mkApplyName args <> text "_fast"
174 = mkApplyName args <> text "_info"
176 mb_tag_node arity | Just tag <- tagForArity arity = mkTagStmt tag <> semi
179 mkTagStmt tag = text ("R1 = R1 + "++ show tag)
181 genMkPAP regstatus macro jump ticker disamb
182 no_load_regs -- don't load argumnet regs before jumping
183 args_in_regs -- arguments are already in regs
184 is_pap args all_args_size fun_info_label
186 = smaller_arity_cases
193 -- offset of arguments on the stack at slow apply calls.
194 stk_args_slow_offset = 1
198 | otherwise = stk_args_slow_offset
200 -- The SMALLER ARITY cases:
203 -- Sp[1] = (W_)&stg_ap_1_info;
204 -- JMP_(GET_ENTRY(R1.cl));
205 smaller_arity_cases = vcat [ smaller_arity i | i <- [1..n_args-1] ]
208 = text "if (arity == " <> int arity <> text ") {" $$
210 -- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
212 -- load up regs for the call, if necessary
215 -- If we have more args in registers than are required
216 -- for the call, then we must save some on the stack,
217 -- and set up the stack for the follow-up call.
218 -- If the extra arguments are on the stack, then we must
219 -- instead shuffle them down to make room for the info
220 -- table for the follow-on call.
223 else shuffle_extra_args,
225 -- for a PAP, we have to arrange that the stack contains a
226 -- return address in the even that stg_PAP_entry fails its
227 -- heap check. See stg_PAP_entry in Apply.hc for details.
229 then text "R2 = " <> mkApplyInfoName this_call_args <> semi
232 if is_fun_case then mb_tag_node arity else empty,
233 text "jump " <> text jump <> semi
238 -- offsets in case we need to save regs:
240 = assignRegs regstatus stk_args_offset args
242 -- register assignment for *this function call*
243 (reg_locs', reg_call_leftovers, reg_call_sp_stk_args)
244 = assignRegs regstatus stk_args_offset (take arity args)
247 | no_load_regs || args_in_regs = empty
248 | otherwise = loadRegOffs reg_locs'
250 (this_call_args, rest_args) = splitAt arity args
252 -- the offset of the stack args from initial Sp
254 | args_in_regs = stk_args_offset
255 | no_load_regs = stk_args_offset
256 | otherwise = reg_call_sp_stk_args
258 -- the stack args themselves
260 | args_in_regs = reg_call_leftovers -- sp offsets are wrong
261 | no_load_regs = this_call_args
262 | otherwise = reg_call_leftovers
264 stack_args_size = sum (map argSize this_call_stack_args)
266 overflow_regs = args_in_regs && length reg_locs > length reg_locs'
269 = -- we have extra arguments in registers to save
271 extra_reg_locs = drop (length reg_locs') (reverse reg_locs)
272 adj_reg_locs = [ (reg, off - adj + 1) |
273 (reg,off) <- extra_reg_locs ]
274 adj = case extra_reg_locs of
275 (reg, fst_off):_ -> fst_off
276 size = snd (last adj_reg_locs)
278 text "Sp_adj(" <> int (-size - 1) <> text ");" $$
279 saveRegOffs adj_reg_locs $$
280 loadSpWordOff "W_" 0 <> text " = " <>
281 mkApplyInfoName rest_args <> semi
284 = vcat (map shuffle_down
285 [sp_stk_args .. sp_stk_args+stack_args_size-1]) $$
286 loadSpWordOff "W_" (sp_stk_args+stack_args_size-1)
288 <> mkApplyInfoName rest_args <> semi $$
289 text "Sp_adj(" <> int (sp_stk_args - 1) <> text ");"
292 loadSpWordOff "W_" (i-1) <> text " = " <>
293 loadSpWordOff "W_" i <> semi
295 -- The EXACT ARITY case
299 -- JMP_(GET_ENTRY(R1.cl));
302 = text "if (arity == " <> int n_args <> text ") {" $$
305 | no_load_regs || args_in_regs = (empty, stk_args_offset)
306 | otherwise = loadRegArgs regstatus stk_args_offset args
309 -- text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();",
311 text "Sp_adj(" <> int sp' <> text ");",
313 then text "R2 = " <> fun_info_label <> semi
315 if is_fun_case then mb_tag_node n_args else empty,
316 text "jump " <> text jump <> semi
319 -- The LARGER ARITY cases:
321 -- } else /* arity > 1 */ {
322 -- BUILD_PAP(1,0,(W_)&stg_ap_v_info);
330 text "Sp_adj(" <> int (-sp_offset) <> text ");" $$
336 -- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();",
338 -- Before building the PAP, tag the function closure pointer
341 text "if (arity < " <> int tAG_BITS_MAX <> text ") {",
342 text " R1 = R1 + arity" <> semi,
347 text macro <> char '(' <> int n_args <> comma <>
349 text "," <> fun_info_label <>
350 text "," <> text disamb <>
355 -- offsets in case we need to save regs:
356 (reg_locs, leftovers, sp_offset)
357 = assignRegs regstatus stk_args_slow_offset args
358 -- BUILD_PAP assumes args start at offset 1
360 -- --------------------------------------
361 -- Examine tag bits of function pointer and enter it
362 -- directly if needed.
363 -- TODO: remove the redundant case in the original code.
364 enterFastPath regstatus no_load_regs args_in_regs args
365 | Just tag <- tagForArity (length args)
366 = enterFastPathHelper tag regstatus no_load_regs args_in_regs args
367 enterFastPath _ _ _ _ = empty
369 -- Copied from Constants.lhs & CgUtils.hs, i'd rather have this imported:
371 tAG_BITS = (TAG_BITS :: Int)
372 tAG_BITS_MAX = ((1 `shiftL` tAG_BITS) :: Int)
374 tagForArity :: Int -> Maybe Int
375 tagForArity i | i < tAG_BITS_MAX = Just i
376 | otherwise = Nothing
378 enterFastPathHelper tag regstatus no_load_regs args_in_regs args =
379 vcat [text "if (GETTAG(R1)==" <> int tag <> text ") {",
381 text " Sp_adj(" <> int sp' <> text ");",
382 -- enter, but adjust offset with tag
383 text " jump " <> text "%GET_ENTRY(R1-" <> int tag <> text ");",
386 -- I don't totally understand this code, I copied it from
390 -- offset of arguments on the stack at slow apply calls.
391 stk_args_slow_offset = 1
395 | otherwise = stk_args_slow_offset
398 | no_load_regs || args_in_regs = (empty, stk_args_offset)
399 | otherwise = loadRegArgs regstatus stk_args_offset args
404 | Just tag <- tagForArity arity
406 text "W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;",
407 text "W_[SLOW_CALLS_" <> int arity <> text "] = W_[SLOW_CALLS_" <> int arity <> text "] + 1;",
408 text "if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == " <> int arity <> text " ) {",
409 text " W_[RIGHT_ARITY_" <> int arity <> text "] = W_[RIGHT_ARITY_" <> int arity <> text "] + 1;",
410 text " if (GETTAG(R1)==" <> int tag <> text ") {",
411 text " W_[TAGGED_PTR_" <> int arity <> text "] = W_[TAGGED_PTR_" <> int arity <> text "] + 1;",
413 -- force a halt when not tagged!
418 tickForArity _ = text "W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;"
420 -- -----------------------------------------------------------------------------
421 -- generate an apply function
423 -- args is a list of 'p', 'n', 'f', 'd' or 'l'
424 formalParam :: ArgRep -> Int -> Doc
425 formalParam V _ = empty
427 formalParamType arg <> space <>
428 text "arg" <> int n <> text ", "
429 formalParamType arg | isPtr arg = text "\"ptr\"" <> space <> argRep arg
430 | otherwise = argRep arg
437 genApply regstatus args =
439 fun_ret_label = mkApplyRetName args
440 fun_info_label = mkApplyInfoName args
441 all_args_size = sum (map argSize args)
444 text "INFO_TABLE_RET(" <> mkApplyName args <> text ", " <>
445 text "RET_SMALL, " <> (cat $ zipWith formalParam args [1..]) <>
452 -- print "static void *lbls[] ="
453 -- print " { [FUN] &&fun_lbl,"
454 -- print " [FUN_1_0] &&fun_lbl,"
455 -- print " [FUN_0_1] &&fun_lbl,"
456 -- print " [FUN_2_0] &&fun_lbl,"
457 -- print " [FUN_1_1] &&fun_lbl,"
458 -- print " [FUN_0_2] &&fun_lbl,"
459 -- print " [FUN_STATIC] &&fun_lbl,"
460 -- print " [PAP] &&pap_lbl,"
461 -- print " [THUNK] &&thunk_lbl,"
462 -- print " [THUNK_1_0] &&thunk_lbl,"
463 -- print " [THUNK_0_1] &&thunk_lbl,"
464 -- print " [THUNK_2_0] &&thunk_lbl,"
465 -- print " [THUNK_1_1] &&thunk_lbl,"
466 -- print " [THUNK_0_2] &&thunk_lbl,"
467 -- print " [THUNK_STATIC] &&thunk_lbl,"
468 -- print " [THUNK_SELECTOR] &&thunk_lbl,"
469 -- print " [IND] &&ind_lbl,"
470 -- print " [IND_OLDGEN] &&ind_lbl,"
471 -- print " [IND_STATIC] &&ind_lbl,"
472 -- print " [IND_PERM] &&ind_lbl,"
473 -- print " [IND_OLDGEN_PERM] &&ind_lbl"
476 tickForArity (length args),
478 text "IF_DEBUG(apply,foreign \"C\" debugBelch(\"" <> fun_ret_label <>
479 text "... \"); foreign \"C\" printClosure(R1 \"ptr\"));",
481 text "IF_DEBUG(sanity,foreign \"C\" checkStackFrame(Sp+WDS(" <> int (1 + all_args_size)
482 <> text ")\"ptr\"));",
484 -- text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <>
485 -- text ", CurrentTSO->stack + CurrentTSO->stack_size));",
487 -- text "TICK_SLOW_CALL(" <> int (length args) <> text ");",
489 let do_assert [] _ = []
490 do_assert (arg:args) offset
491 | isPtr arg = this : rest
493 where this = text "ASSERT(LOOKS_LIKE_CLOSURE_PTR(Sp("
494 <> int offset <> text ")));"
495 rest = do_assert args (offset + argSize arg)
497 vcat (do_assert args 1),
501 -- if pointer is tagged enter it fast!
502 enterFastPath regstatus False False args,
504 -- Functions can be tagged, so we untag them!
505 text "R1 = UNTAG(R1);",
506 text "info = %INFO_PTR(R1);",
509 -- print " goto *lbls[info->type];";
511 text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(%STD_INFO(info)))) {",
519 text "arity = TO_W_(StgBCO_arity(R1));",
520 text "ASSERT(arity > 0);",
521 genMkPAP regstatus "BUILD_PAP" "ENTRY_LBL(stg_BCO)" "FUN" "BCO"
522 True{-stack apply-} False{-args on stack-} False{-not a PAP-}
523 args all_args_size fun_info_label {- tag stmt -}False
536 text " FUN_STATIC: {",
538 text "arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));",
539 text "ASSERT(arity > 0);",
540 genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" "FUN" "FUN"
541 False{-reg apply-} False{-args on stack-} False{-not a PAP-}
542 args all_args_size fun_info_label {- tag stmt -}True
552 text "arity = TO_W_(StgPAP_arity(R1));",
553 text "ASSERT(arity > 0);",
554 genMkPAP regstatus "NEW_PAP" "stg_PAP_apply" "PAP" "PAP"
555 True{-stack apply-} False{-args on stack-} True{-is a PAP-}
556 args all_args_size fun_info_label {- tag stmt -}False
563 -- print " thunk_lbl:"
567 text " CAF_BLACKHOLE,",
569 text " SE_BLACKHOLE,",
570 text " SE_CAF_BLACKHOLE,",
577 text " THUNK_STATIC,",
578 text " THUNK_SELECTOR: {",
580 -- text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
581 text "Sp(0) = " <> fun_info_label <> text ";",
582 -- CAREFUL! in SMP mode, the info table may already have been
583 -- overwritten by an indirection, so we must enter the original
584 -- info pointer we read, don't read it again, because it might
585 -- not be enterable any more.
586 text "jump %ENTRY_CODE(info);",
598 text " IND_OLDGEN_PERM: {",
600 text "R1 = StgInd_indirectee(R1);",
601 -- An indirection node might contain a tagged pointer
611 text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\") never returns;"
621 -- -----------------------------------------------------------------------------
622 -- Making a fast unknown application, args are in regs
624 genApplyFast regstatus args =
626 fun_fast_label = mkApplyFastName args
627 fun_ret_label = text "RET_LBL" <> parens (mkApplyName args)
628 fun_info_label = mkApplyInfoName args
629 all_args_size = sum (map argSize args)
638 tickForArity (length args),
640 -- if pointer is tagged enter it fast!
641 enterFastPath regstatus False True args,
643 -- Functions can be tagged, so we untag them!
644 text "R1 = UNTAG(R1);",
645 text "info = %GET_STD_INFO(R1);",
646 text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(info))) {",
654 text " FUN_STATIC: {",
656 text "arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));",
657 text "ASSERT(arity > 0);",
658 genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" "FUN" "FUN"
659 False{-reg apply-} True{-args in regs-} False{-not a PAP-}
660 args all_args_size fun_info_label {- tag stmt -}True
666 (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args
667 -- leave a one-word space on the top of the stack when
668 -- calling the slow version
671 text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
672 saveRegOffs reg_locs,
673 text "jump" <+> fun_ret_label <> semi
682 -- -----------------------------------------------------------------------------
683 -- Making a stack apply
685 -- These little functions are like slow entry points. They provide
686 -- the layer between the PAP entry code and the function's fast entry
687 -- point: namely they load arguments off the stack into registers (if
688 -- available) and jump to the function's entry code.
690 -- On entry: R1 points to the function closure
691 -- arguments are on the stack starting at Sp
693 -- Invariant: the list of arguments never contains void. Since we're only
694 -- interested in loading arguments off the stack here, we can ignore
697 mkStackApplyEntryLabel:: [ArgRep] -> Doc
698 mkStackApplyEntryLabel args = text "stg_ap_stk_" <> text (map showArg args)
700 genStackApply :: RegStatus -> [ArgRep] -> Doc
701 genStackApply regstatus args =
702 let fn_entry_label = mkStackApplyEntryLabel args in
705 text "{", nest 4 body, text "}"
708 (assign_regs, sp') = loadRegArgs regstatus 0 args
709 body = vcat [assign_regs,
710 text "Sp_adj" <> parens (int sp') <> semi,
711 text "jump %GET_ENTRY(UNTAG(R1));"
714 -- -----------------------------------------------------------------------------
715 -- Stack save entry points.
717 -- These code fragments are used to save registers on the stack at a heap
718 -- check failure in the entry code for a function. We also have to save R1
719 -- and the return address (stg_gc_fun_info) on the stack. See stg_gc_fun_gen
720 -- in HeapStackCheck.hc for more details.
722 mkStackSaveEntryLabel :: [ArgRep] -> Doc
723 mkStackSaveEntryLabel args = text "stg_stk_save_" <> text (map showArg args)
725 genStackSave :: RegStatus -> [ArgRep] -> Doc
726 genStackSave regstatus args =
727 let fn_entry_label= mkStackSaveEntryLabel args in
730 text "{", nest 4 body, text "}"
733 body = vcat [text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
734 saveRegOffs reg_locs,
736 text "Sp(1) =" <+> int stk_args <> semi,
737 text "Sp(0) = stg_gc_fun_info;",
738 text "jump stg_gc_noregs;"
741 std_frame_size = 3 -- the std bits of the frame. See StgRetFun in Closures.h,
742 -- and the comment on stg_fun_gc_gen in HeapStackCheck.hc.
743 (reg_locs, leftovers, sp_offset) = assignRegs regstatus std_frame_size args
745 -- number of words of arguments on the stack.
746 stk_args = sum (map argSize leftovers) + sp_offset - std_frame_size
748 -- -----------------------------------------------------------------------------
753 regstatus <- case args of
754 [] -> return Registerised
755 ["-u"] -> return Unregisterised
756 _other -> do hPutStrLn stderr "syntax: genapply [-u]"
757 exitWith (ExitFailure 1)
758 let the_code = vcat [
759 text "// DO NOT EDIT!",
760 text "// Automatically generated by GenApply.hs",
762 text "#include \"Cmm.h\"",
763 text "#include \"AutoApply.h\"",
766 vcat (intersperse (text "") $
767 map (genApply regstatus) applyTypes),
768 vcat (intersperse (text "") $
769 map (genStackFns regstatus) stackApplyTypes),
771 vcat (intersperse (text "") $
772 map (genApplyFast regstatus) applyTypes),
774 genStackApplyArray stackApplyTypes,
775 genStackSaveArray stackApplyTypes,
776 genBitmapArray stackApplyTypes,
778 text "" -- add a newline at the end of the file
781 putStr (render the_code)
783 -- These have been shown to cover about 99% of cases in practice...
801 -- No need for V args in the stack apply cases.
802 -- ToDo: the stack apply and stack save code doesn't make a distinction
803 -- between N and P (they both live in the same register), only the bitmap
804 -- changes, so we could share the apply/save code between lots of cases.
831 genStackFns regstatus args
832 = genStackApply regstatus args
833 $$ genStackSave regstatus args
836 genStackApplyArray types =
838 text "section \"relrodata\" {",
839 text "stg_ap_stack_entries:",
840 text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
841 vcat (map arr_ent types),
845 arr_ent ty = text "W_" <+> mkStackApplyEntryLabel ty <> semi
847 genStackSaveArray types =
849 text "section \"relrodata\" {",
850 text "stg_stack_save_entries:",
851 text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
852 vcat (map arr_ent types),
856 arr_ent ty = text "W_" <+> mkStackSaveEntryLabel ty <> semi
858 genBitmapArray :: [[ArgRep]] -> Doc
859 genBitmapArray types =
861 text "section \"rodata\" {",
862 text "stg_arg_bitmaps:",
863 text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
864 vcat (map gen_bitmap types),
868 gen_bitmap ty = text "W_" <+> int bitmap_val <> semi
870 (fromIntegral (mkBitmap ty) `shiftL` BITMAP_BITS_SHIFT)
871 .|. sum (map argSize ty)