{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.RawDevice.Base
-- 
-- Maintainer  :  Isaac Jones <ijones@galois.com>
-- Stability   :  alpha
-- Portability :  GHC
--
module System.RawDevice.Base
       ( DiskAddress
       , BlockNumber

       , bytesPerBlock
       , locationOfBlock
       , BufferBlockHandle
       , newBufferBlockHandle
       , checkBufferBlockHandleSize
       , zeroBufferBlockHandle 
       , invalidateBufferBlockHandle 
       ) where
       
import Data.Integral
import Binary
import Control.Exception(assert)
import Data.Array.SysArray
import Foreign.Marshal.Alloc(mallocBytes)

-- |Represents the number of the physical block on disk.
type DiskAddress = INInt

-- |nth block within a file
type BlockNumber = INInt

bytesPerBlock :: Int
bytesPerBlock = 4096

locationOfBlock :: DiskAddress -> Bin Int
locationOfBlock blockNum = BinPtr $ (inIntToInt blockNum) * bytesPerBlock

newtype BufferBlockHandle s = BufferBlockHandle FixedSysHandle
	deriving (BinaryHandle)

newBufferBlockHandle :: IO (BufferBlockHandle s)
newBufferBlockHandle = do
    ptr <- mallocBytes bytesPerBlock
    let arr = mkSysArray (fromIntegral bytesPerBlock) ptr False
    buf <- openFixedSysHandle arr
    return $ BufferBlockHandle buf

checkBufferBlockHandleSize :: BufferBlockHandle s -> IO ()
checkBufferBlockHandleSize (BufferBlockHandle fixed) = do
   size <- sizeFixedSysMem fixed
   assert (size == bytesPerBlock) $ return ()

zeroBufferBlockHandle :: BufferBlockHandle s -> IO ()
zeroBufferBlockHandle (BufferBlockHandle fixed) = zeroFixedSysHandle fixed

invalidateBufferBlockHandle :: BufferBlockHandle s -> IO ()
invalidateBufferBlockHandle (BufferBlockHandle fixed) = invalidateFixedSysMem fixed