{-# LANGUAGE CPP #-}

module RegAlloc.Linear.FreeRegs (
    FR(..),
    maxSpillSlots
)

#include "HsVersions.h"

where

import GhcPrelude

import Reg
import RegClass

import DynFlags
import Panic
import Platform

-- -----------------------------------------------------------------------------
-- The free register set
-- This needs to be *efficient*
-- Here's an inefficient 'executable specification' of the FreeRegs data type:
--
--      type FreeRegs = [RegNo]
--      noFreeRegs = 0
--      releaseReg n f = if n `elem` f then f else (n : f)
--      initFreeRegs = allocatableRegs
--      getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f
--      allocateReg f r = filter (/= r) f

import qualified RegAlloc.Linear.PPC.FreeRegs    as PPC
import qualified RegAlloc.Linear.SPARC.FreeRegs  as SPARC
import qualified RegAlloc.Linear.X86.FreeRegs    as X86
import qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64

import qualified PPC.Instr
import qualified SPARC.Instr
import qualified X86.Instr

class Show freeRegs => FR freeRegs where
    frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
    frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
    frInitFreeRegs :: Platform -> freeRegs
    frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs

instance FR X86.FreeRegs where
    frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg  = \_ -> RealReg -> FreeRegs -> FreeRegs
X86.allocateReg
    frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs  = Platform -> RegClass -> FreeRegs -> [RealReg]
X86.getFreeRegs
    frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
X86.initFreeRegs
    frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg   = \_ -> RealReg -> FreeRegs -> FreeRegs
X86.releaseReg

instance FR X86_64.FreeRegs where
    frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg  = \_ -> RealReg -> FreeRegs -> FreeRegs
X86_64.allocateReg
    frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs  = Platform -> RegClass -> FreeRegs -> [RealReg]
X86_64.getFreeRegs
    frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
X86_64.initFreeRegs
    frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg   = \_ -> RealReg -> FreeRegs -> FreeRegs
X86_64.releaseReg

instance FR PPC.FreeRegs where
    frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg  = \_ -> RealReg -> FreeRegs -> FreeRegs
PPC.allocateReg
    frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs  = \_ -> RegClass -> FreeRegs -> [RealReg]
PPC.getFreeRegs
    frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
PPC.initFreeRegs
    frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg   = \_ -> RealReg -> FreeRegs -> FreeRegs
PPC.releaseReg

instance FR SPARC.FreeRegs where
    frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg  = Platform -> RealReg -> FreeRegs -> FreeRegs
SPARC.allocateReg
    frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs  = \_ -> RegClass -> FreeRegs -> [RealReg]
SPARC.getFreeRegs
    frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
SPARC.initFreeRegs
    frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg   = Platform -> RealReg -> FreeRegs -> FreeRegs
SPARC.releaseReg

maxSpillSlots :: DynFlags -> Int
maxSpillSlots :: DynFlags -> Int
maxSpillSlots dflags :: DynFlags
dflags
              = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
                ArchX86       -> DynFlags -> Int
X86.Instr.maxSpillSlots DynFlags
dflags
                ArchX86_64    -> DynFlags -> Int
X86.Instr.maxSpillSlots DynFlags
dflags
                ArchPPC       -> DynFlags -> Int
PPC.Instr.maxSpillSlots DynFlags
dflags
                ArchSPARC     -> DynFlags -> Int
SPARC.Instr.maxSpillSlots DynFlags
dflags
                ArchSPARC64   -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchSPARC64"
                ArchARM _ _ _ -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchARM"
                ArchARM64     -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchARM64"
                ArchPPC_64 _  -> DynFlags -> Int
PPC.Instr.maxSpillSlots DynFlags
dflags
                ArchAlpha     -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchAlpha"
                ArchMipseb    -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchMipseb"
                ArchMipsel    -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchMipsel"
                ArchJavaScript-> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchJavaScript"
                ArchUnknown   -> String -> Int
forall a. String -> a
panic "maxSpillSlots ArchUnknown"