{-# LANGUAGE PatternSignatures #-} ----------------------------------------------------------------------------- -- | -- Module : TheBlockMap -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : GHC -- -- Explanation: Tracks free blocks in the filesystem. Does not track -- non-free blocks. Exists as a FIFO queue to avoid block reuse. -- This is also true when syncing to the disk; it syncs in FIFO order, -- so when its read from the disk, the least-recently-used block is on -- the end, and won't be used for a while. -- The number of bytes in -- the block map file does _not_ change, but not all of those bytes -- will always be used. That is, the block map file is a fixed size, -- does not shrink after newFS. module Halfs.TheBlockMap (TheBlockMap -- abstract ,mkBlockMap ,allocateBlock ,freeBlock ,freeBlocks ,bmTotalSize ,bmDirty ,newFS ,findAddress ,unitTests) where import Halfs.Inode (Inode(metaData), InodeMetadata(level) ,newInode, firstFreeInodeDiskAddr) import Halfs.TestFramework (Test(..), UnitTests, (~:), (~=?), hunitToUnitTest) import Data.Integral ( INInt, intToINInt ) import Halfs.Utils (DiskAddress, BlockNumber, FileType (File), blockPointersPerIndirectBlock, blockPointersPerInode) -- Base import Data.Queue (listToQueue, addToQueue, deQueue, Queue, queueToList, queueLength) import qualified Data.Set as Set import Control.Exception(assert) -- TODO: each block of blockmap should have a dirty bit (inside the -- inode) data TheBlockMap = TheBlockMap {freeBlocks :: Queue DiskAddress ,_freeBlocksSet :: Set.Set DiskAddress ,bmDirty :: Bool ,bmTotalSize :: INInt -- total number of blocks } -- |todo: check to see if new epoch, optimize allocation by using a -- window and passing in a hint of where it "should" go. "Nothing" -- means that the disk is full. allocateBlock :: TheBlockMap -> Maybe (DiskAddress, TheBlockMap) allocateBlock (TheBlockMap inBlockMap inBlockSet _ s) = case deQueue inBlockMap of Nothing -> Nothing -- Nothing free! Just (addr, newBlockMap) -> Just ((assert (addr /= 0) addr), TheBlockMap newBlockMap (Set.delete addr inBlockSet) True s) freeBlock :: TheBlockMap -> DiskAddress -> TheBlockMap freeBlock (TheBlockMap inBlockMap inBlockSet _ len) addr = assert (not (Set.member addr inBlockSet)) $ assert (addr > 0 && addr < len) $ TheBlockMap (addToQueue inBlockMap (assert (addr /= 0) addr)) (Set.insert addr inBlockSet) True len {- where addToQueue' q addr = listToQueue (take offset xs ++ [addr] ++ drop offset xs) where xs = queueToList q offset = 200 -} -- |smart constructor for TheBlockMap newFS :: INInt -- ^Length of the device in blocks -> TheBlockMap newFS len -- 0 and 1 are inode file and inodemap file = mkBlockMap (listToQueue [firstFreeInodeDiskAddr .. (len - 1)]) True len mkBlockMap :: Queue DiskAddress -> Bool -> INInt -> TheBlockMap mkBlockMap free busy size = assert (queueLength free == Set.size freeSet) $ TheBlockMap free freeSet busy size where freeSet = Set.fromList (queueToList free) instance Show TheBlockMap where show (TheBlockMap free _ de tot) = "TheBlockMap [" ++ showBM (queueToList free) ++ "] " ++ show de ++ " " ++ show tot where commas [] = "" commas xs = foldl1 (\ a b -> a ++ "," ++ b) xs showBM xs = commas [ if a == b then show a else show a ++ ".." ++ show b | (a,b) <- combine [ (x,x) | x <- xs ] ] combine ((a,b):(c,d):r) | b+1 == c = combine ((a,d):r) combine (v:r) = v: combine r combine [] = [] {- instance Show TheBlockMap where show (TheBlockMap fb _ _) = fmap (\x -> if isFree x then "-" else "X") -} -- ------------------------------------------------------------ -- * Computing the location on disk of this block -- ------------------------------------------------------------ findAddress :: Inode -- ^Inode that contains the blocks -> BlockNumber -- ^Address we're looking for, 0 indexed -> [INInt] -- ^dereference locations at each level, 0 indexed findAddress inode findMe = addrList (level $ metaData inode) 1 (intToINInt blockPointersPerIndirectBlock) (intToINInt blockPointersPerInode) findMe -- |Compute the list of locations in a tree with the given branching -- factor. Counts up to totalLevels, zero indexed. That is, if I'm -- looking for the 3rd element in a zero indexed binary tree with two -- levels, it'll be [1,1]. addrList 3 3 2 10 == [1,0,1] addrList :: INInt -- Levels -> INInt -- current level -> INInt -- branching factor -> INInt -- base buckets -> BlockNumber -- address to find -> [INInt] addrList totalLevels currLevel branchingFactor baseBuckets findMe | findMe >= numBuckets totalLevels branchingFactor baseBuckets = error "block too big, should have resized" | currLevel > totalLevels = [] | otherwise = let bucketLoc = absBucket totalLevels currLevel branchingFactor baseBuckets findMe prevLevel = currLevel - 1 prevBucket = absBucket totalLevels prevLevel branchingFactor baseBuckets findMe answer = if currLevel == 1 then bucketLoc else bucketLoc - (branchingFactor * prevBucket) in answer : (addrList totalLevels (currLevel + 1) branchingFactor baseBuckets findMe) -- |How many buckets at this level for this branching factor? numBuckets :: INInt -- current level -> INInt -- branching factor -> INInt -- base buckets -> INInt numBuckets 0 _ _ = error "zero" numBuckets 1 _ b = b numBuckets currLevel branchingFactor baseBuckets = (numBuckets (currLevel - 1) branchingFactor baseBuckets) * branchingFactor -- Get the bucket of this element as if this entire level were one node absBucket :: INInt -- total levels -> INInt -- current level -> INInt -- branching factor -> INInt -- base buckets -> BlockNumber -- location to find. -> INInt absBucket _ _ _ _ 0 = 0 absBucket totalLevels currLevel branchingFactor baseBuckets findMe = let maxElems = numBuckets totalLevels branchingFactor baseBuckets buckets = numBuckets currLevel branchingFactor baseBuckets itemsPerBucket = maxElems `div` (assert (buckets /= 0) buckets) -- Below "1" adjustments are because addresses start at zero. in (ceiling $ toRational (findMe+1) / toRational itemsPerBucket) - 1 -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ unitTests :: UnitTests unitTests = hunitToUnitTest hunitTests hunitTests :: [Test] hunitTests = let inode' = newInode 0 File inode = inode'{metaData=(metaData inode'){level=2}} inode2 = inode'{metaData=(metaData inode'){level=3}} (maxAddr::INInt) = (16 * (1024 ^ (2::Int))) - 1 -- for 3 levels in ["simple Address List 1" ~: "failed" ~: [1,0,1] ~=? addrList 3 1 3 2 10 ,"simple Address List 2" ~: "failed" ~: [1,0,2] ~=? addrList 3 1 3 2 11 ,"simple Address List 2" ~: "failed" ~: [1,1,1] ~=? addrList 3 1 3 2 13 ,"disk addr list 1" ~: "failed" ~: [0,0] ~=? findAddress inode 0 ,"disk addr list 2" ~: "failed" ~: [0,1] ~=? findAddress inode 1 ,"disk addr list 3" ~: "failed" ~: [0,1023] ~=? findAddress inode 1023 ,"disk addr list 4" ~: "failed" ~: [1,0] ~=? findAddress inode 1024 ,"disk addr list 3 lev. 1" ~: "failed" ~: [0,1,0] ~=? findAddress inode2 1024 ,"disk addr list 3 lev. 2" ~: "failed" ~: [0,0,1023] ~=? findAddress inode2 1023 ,"disk addr list 3 lev. 3" ~: "failed" ~: [0,5,0] ~=? findAddress inode2 5120 ,"max addr" ~: "failed" ~: maxAddr ~=? (numBuckets 3 1024 16) - 1 ,"max addr loc" ~: "failed" ~: [15, 1023, 1023] ~=? findAddress inode2 maxAddr -- FIX: Should test address maxAddr + 1 which should fail ]