{-# LANGUAGE FlexibleContexts #-}
module Ivory.HW.BitData where
import Numeric (showHex)
import Data.List (intercalate)
import Ivory.Language
import Ivory.HW.Prim
import Ivory.HW.Reg
data BitDataReg d =
BitDataReg
{ bdr_reg :: Reg (BitDataRep d)
, bdr_name :: Maybe String
}
bdrComment :: BitDataReg d -> String -> String -> Ivory eff ()
bdrComment r c c' =
comment ("reg " ++ c ++ " " ++ regname ++ ": " ++ c' )
where
regname = case bdr_name r of
Just n -> n
Nothing -> "0x" ++ (showHex regaddr "")
regaddr = case bdr_reg r of Reg a -> a
mkBitDataReg :: IvoryIOReg (BitDataRep d) => Integer -> BitDataReg d
mkBitDataReg a = BitDataReg { bdr_reg = mkReg a, bdr_name = Nothing }
mkBitDataRegNamed :: IvoryIOReg (BitDataRep d) => Integer -> String -> BitDataReg d
mkBitDataRegNamed a n = BitDataReg { bdr_reg = mkReg a, bdr_name = Just n }
getReg :: (BitData d, IvoryIOReg (BitDataRep d))
=> BitDataReg d -> Ivory eff d
getReg r = do
bdrComment r "get" ""
val <- readReg (bdr_reg r)
return $ fromRep val
setReg :: (BitData d, IvoryIOReg (BitDataRep d))
=> BitDataReg d -> BitDataM d a -> Ivory eff a
setReg r mf = do
let (result, val, ss) = runBits 0 mf
bdrComment r "set" (intercalate ", " ss)
writeReg (bdr_reg r) val
return result
modifyReg :: (BitData d, IvoryIOReg (BitDataRep d))
=> BitDataReg d -> BitDataM d a -> Ivory eff a
modifyReg r mf = do
val <- readReg (bdr_reg r)
let (result, val', ss) = runBits val mf
bdrComment r "modify" (intercalate ", " ss)
writeReg (bdr_reg r) val'
return result