1{- 2/* $NetBSD: nbsd.hs,v 1.1 2006/10/09 12:32:46 yamt Exp $ */ 3 4/*- 5 * Copyright (c)2005 YAMAMOTO Takashi, 6 * All rights reserved. 7 * 8 * Redistribution and use in source and binary forms, with or without 9 * modification, are permitted provided that the following conditions 10 * are met: 11 * 1. Redistributions of source code must retain the above copyright 12 * notice, this list of conditions and the following disclaimer. 13 * 2. Redistributions in binary form must reproduce the above copyright 14 * notice, this list of conditions and the following disclaimer in the 15 * documentation and/or other materials provided with the distribution. 16 * 17 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 18 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 21 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 * SUCH DAMAGE. 28 */ 29-} 30 31import System.Environment 32import System.IO 33import List 34import Maybe 35import qualified Data.Map as Map 36import Control.Exception 37import Data.Queue 38 39type PageId = Int 40data Page = Pg { pgid :: PageId, referenced :: Bool } 41data Pageq = Pgq { active, inactive :: PageList } 42 43{- 44data PageList = Pgl Int [Int] 45pglenqueue x (Pgl n xs) = Pgl (n+1) (xs++[x]) 46pgldequeue (Pgl n (x:xs)) = (x, Pgl (n-1) xs) 47pglsize (Pgl n _) = n 48pglempty = Pgl 0 [] 49-} 50data PageList = Pgl Int (Queue Int) 51pglenqueue x (Pgl n q) = Pgl (n+1) (addToQueue q x) 52pgldequeue (Pgl n q) = (x, Pgl (n-1) nq) where 53 Just (x,nq) = deQueue q 54pglsize (Pgl n _) = n 55pglempty = Pgl 0 emptyQueue 56 57{- 58instance Show Page where 59 show pg = "(" ++ (show $ pgid pg) ++ "," ++ (show $ referenced pg) ++ ")" 60instance Show Pageq where 61 show q = "(act=" ++ (show $ active q) ++ ",inact=" ++ (show $ inactive q) ++ ")" 62-} 63 64pglookup idx m = Map.lookup idx m 65 66emptyq = Pgq { active = pglempty, inactive = pglempty } 67 68clrref pg = pg { referenced = False } 69markref pg = pg { referenced = True } 70 71clrrefm x m = Map.update (Just . clrref) x m 72 73reactivate :: (Pageq,Map.Map Int Page) -> (Pageq,Map.Map Int Page) 74reactivate (q,m) = (nq,nm) where 75 nq = q { active = pglenqueue x $ active q, inactive = niaq } 76 nm = clrrefm x m 77 (x,niaq) = pgldequeue $ inactive q 78reactivate_act (q,m) = (nq,nm) where 79 nq = q { active = pglenqueue x $ naq } 80 nm = clrrefm x m 81 (x,naq) = pgldequeue $ active q 82deactivate_act (q,m) = (nq,nm) where 83 nq = q { active = naq, inactive = pglenqueue x $ inactive q } 84 nm = clrrefm x m 85 (x,naq) = pgldequeue $ active q 86 87reclaim :: Int -> (Pageq,Map.Map Int Page)->(Pageq,Map.Map Int Page) 88reclaim pct (q0,m0) = 89 if referenced p then 90 reclaim pct $ reactivate (q,m) 91 else 92 (q { inactive = npgl },Map.delete x m) 93 where 94 (q,m) = fillinact pct (q0,m0) 95 (x,npgl) = pgldequeue $ inactive q 96 Just p = Map.lookup x m0 97 98fillinact inactpct (q,m) = 99 if inactlen >= inacttarg then (q,m) else 100#if defined(LINUX) 101 if referenced p then 102 fillinact inactpct $ reactivate_act (q,m) else 103#endif 104 fillinact inactpct $ deactivate_act (q,m) 105 where 106 Just p = Map.lookup x m 107 (x,_) = pgldequeue $ active q 108 inactlen = pglsize $ inactive q 109 inacttarg = div (Map.size m * inactpct) 100 110 111pgref :: Int->Map.Map Int Page -> Map.Map Int Page 112pgref idx m = Map.update f idx m where 113 f = Just . markref 114 115do_nbsd1 npg pct n q m [] = (reverse n, q) 116do_nbsd1 npg pct n q m rs@(r:rs2) = 117 let 118 p = pglookup r m 119 in 120 if isJust p then 121 do_nbsd1 npg pct n q (pgref r m) rs2 122 else if Map.size m < npg then 123 do_nbsd1 npg pct (r:n) (enqueue r q) (pgenqueue r m) rs2 124 else 125 let 126 (nq, nm) = reclaim pct (q,m) 127 in 128 do_nbsd1 npg pct (r:n) (enqueue r nq) (pgenqueue r nm) rs2 129 where 130 newpg i = Pg {pgid = i, referenced = True} 131 pgenqueue i m = Map.insert i (newpg i) m 132#if defined(LINUX) 133 enqueue i q = q { inactive = pglenqueue i $ inactive q } 134#else 135 enqueue i q = q { active = pglenqueue i $ active q } 136#endif 137 138do_nbsd npg pct rs = fst $ do_nbsd1 npg pct [] emptyq Map.empty rs 139do_nbsd_dbg npg pct rs = do_nbsd1 npg pct [] emptyq Map.empty rs 140 141main = do 142 xs <- getContents 143 args <- getArgs 144 let 145 ls = lines xs 146 npgs::Int 147 npgs = read $ args !! 0 148 pct = read $ args !! 1 149 pgs::[Int] 150 pgs = map read ls 151 mapM_ print $ do_nbsd npgs pct pgs 152