-useVanillaRegs | opt_Unregisterised = 0
- | otherwise = mAX_Real_Vanilla_REG
-useFloatRegs | opt_Unregisterised = 0
- | otherwise = mAX_Real_Float_REG
-useDoubleRegs | opt_Unregisterised = 0
- | otherwise = mAX_Real_Double_REG
-useLongRegs | opt_Unregisterised = 0
- | otherwise = mAX_Real_Long_REG
-
-availRegs = (regList VanillaReg useVanillaRegs,
- regList FloatReg useFloatRegs,
- regList DoubleReg useDoubleRegs,
- regList LongReg useLongRegs)
- where
- regList f max = map f [1 .. max]
-
--- Round the size of a local register up to the nearest word.
-slot_size :: LocalReg -> Int
-slot_size reg = slot_size' (typeWidth (localRegType reg))
-
-slot_size' :: Width -> Int
-slot_size' reg = ((widthInBytes reg - 1) `div` wORD_SIZE) + 1
-
-type Assignment = (ParamLocation WordOff, WordOff, WordOff, AvailRegs)
-type SlotAssigner = Width -> Int -> AvailRegs -> Assignment
-
-assign_reg :: Bool -> SlotAssigner -> CmmType -> WordOff -> AvailRegs -> Assignment
-assign_reg isCall slot ty off avails
- | isFloatType ty = assign_float_reg slot width off avails
- | otherwise = assign_bits_reg isCall slot width off gcp avails
- where
- width = typeWidth ty
- gcp | isGcPtrType ty = VGcPtr
- | otherwise = VNonGcPtr
-
--- Assigning a slot on a stack that grows up:
--- JD: I don't know why this convention stops using all the registers
--- after running out of one class of registers.
-assign_slot_up :: SlotAssigner
-assign_slot_up width off regs =
- (StackParam $ off, off + size, size, ([], [], [], [])) where size = slot_size' width
-
--- Assigning a slot on a stack that grows down:
-assign_slot_down :: SlotAssigner
-assign_slot_down width off regs =
- (StackParam $ off + size, off + size, size, ([], [], [], []))
- where size = slot_size' width
-
--- On calls, `node` is used to hold the closure that is entered, so we can't
--- pass arguments in that register.
-assign_bits_reg _ _ W128 _ _ _ = panic "I128 is not a supported register type"
-assign_bits_reg isCall assign_slot w off gcp regs@(v:vs, fs, ds, ls) =
- if isCall && v gcp == node then
- assign_bits_reg isCall assign_slot w off gcp (vs, fs, ds, ls)
- else if widthInBits w <= widthInBits wordWidth then
- (RegisterParam (v gcp), off, 0, (vs, fs, ds, ls))
- else assign_slot w off regs
-
-assign_float_reg _ W32 off (vs, f:fs, ds, ls) = (RegisterParam $ f, off, 0, (vs, fs, ds, ls))
-assign_float_reg _ W64 off (vs, fs, d:ds, ls) = (RegisterParam $ d, off, 0, (vs, fs, ds, ls))
-assign_float_reg _ W80 off _ = panic "F80 is not a supported register type"
-assign_float_reg assign_slot width off r = assign_slot width off r
+vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
+vanillaRegNos | opt_Unregisterised = []
+ | otherwise = regList mAX_Real_Vanilla_REG
+floatRegNos | opt_Unregisterised = []
+ | otherwise = regList mAX_Real_Float_REG
+doubleRegNos | opt_Unregisterised = []
+ | otherwise = regList mAX_Real_Double_REG
+longRegNos | opt_Unregisterised = []
+ | otherwise = regList mAX_Real_Long_REG
+
+--
+getRegsWithoutNode, getRegsWithNode :: AvailRegs
+getRegsWithoutNode =
+ (filter (\r -> r VGcPtr /= node) intRegs,
+ map FloatReg floatRegNos, map DoubleReg doubleRegNos, map LongReg longRegNos)
+ where intRegs = map VanillaReg vanillaRegNos
+getRegsWithNode =
+ (intRegs, map FloatReg floatRegNos, map DoubleReg doubleRegNos, map LongReg longRegNos)
+ where intRegs = map VanillaReg vanillaRegNos
+
+allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
+allVanillaRegNos = regList mAX_Vanilla_REG
+allFloatRegNos = regList mAX_Float_REG
+allDoubleRegNos = regList mAX_Double_REG
+allLongRegNos = regList mAX_Long_REG
+
+regList :: Int -> [Int]
+regList n = [1 .. n]
+
+allRegs :: AvailRegs
+allRegs = (map VanillaReg allVanillaRegNos, map FloatReg allFloatRegNos,
+ map DoubleReg allDoubleRegNos, map LongReg allLongRegNos)
+
+noRegs :: AvailRegs
+noRegs = ([], [], [], [])