8 #include "HsVersions.h"
15 import StaticFlags (opt_Unregisterised)
19 = RegisterParam GlobalReg
22 assignRegs :: [LocalReg] -> ArgumentFormat LocalReg
23 assignRegs regs = assignRegs' regs 0 availRegs
25 assignRegs' (r:rs) offset availRegs = (r,assignment):assignRegs' rs new_offset remaining
27 (assignment, new_offset, remaining) = assign_reg (localRegRep r) offset availRegs
29 assignArguments :: (a -> MachRep) -> [a] -> ArgumentFormat a
30 assignArguments f reps = assignArguments' reps 0 availRegs
32 assignArguments' [] offset availRegs = []
33 assignArguments' (r:rs) offset availRegs = (r,assignment):assignArguments' rs new_offset remaining
35 (assignment, new_offset, remaining) = assign_reg (f r) offset availRegs
37 type ArgumentFormat a = [(a, ParamLocation)]
39 type AvailRegs = ( [GlobalReg] -- available vanilla regs.
40 , [GlobalReg] -- floats
41 , [GlobalReg] -- doubles
42 , [GlobalReg] -- longs (int64 and word64)
45 -- Vanilla registers can contain pointers, Ints, Chars.
46 -- Floats and doubles have separate register supplies.
48 -- We take these register supplies from the *real* registers, i.e. those
49 -- that are guaranteed to map to machine registers.
51 useVanillaRegs | opt_Unregisterised = 0
52 | otherwise = mAX_Real_Vanilla_REG
53 useFloatRegs | opt_Unregisterised = 0
54 | otherwise = mAX_Real_Float_REG
55 useDoubleRegs | opt_Unregisterised = 0
56 | otherwise = mAX_Real_Double_REG
57 useLongRegs | opt_Unregisterised = 0
58 | otherwise = mAX_Real_Long_REG
60 availRegs = (regList VanillaReg useVanillaRegs,
61 regList FloatReg useFloatRegs,
62 regList DoubleReg useDoubleRegs,
63 regList LongReg useLongRegs)
65 regList f max = map f [1 .. max]
67 slot_size :: LocalReg -> Int
68 slot_size reg = ((machRepByteWidth (localRegRep reg) - 1) `div` wORD_SIZE) + 1
70 slot_size' :: MachRep -> Int
71 slot_size' reg = ((machRepByteWidth reg - 1) `div` wORD_SIZE) + 1
73 assign_reg :: MachRep -> WordOff -> AvailRegs -> (ParamLocation, WordOff, AvailRegs)
74 assign_reg I8 off (v:vs, fs, ds, ls) = (RegisterParam $ v, off, (vs, fs, ds, ls))
75 assign_reg I16 off (v:vs, fs, ds, ls) = (RegisterParam $ v, off, (vs, fs, ds, ls))
76 assign_reg I32 off (v:vs, fs, ds, ls) = (RegisterParam $ v, off, (vs, fs, ds, ls))
77 assign_reg I64 off (vs, fs, ds, l:ls) = (RegisterParam $ l, off, (vs, fs, ds, ls))
78 assign_reg I128 off _ = panic "I128 is not a supported register type"
79 assign_reg F32 off (vs, f:fs, ds, ls) = (RegisterParam $ f, off, (vs, fs, ds, ls))
80 assign_reg F64 off (vs, fs, d:ds, ls) = (RegisterParam $ d, off, (vs, fs, ds, ls))
81 assign_reg F80 off _ = panic "F80 is not a supported register type"
82 assign_reg reg off _ = (StackParam $ off - size, off - size, ([], [], [], [])) where size = slot_size' reg