regress/sys/uvm/pdsim/nbsd.hs

   1 {-
   2 /*      $NetBSD: nbsd.hs,v 1.1 2006/09/30 08:50:32 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
  31 import System.Environment
  32 import System.IO
  33 import List
  34 import Maybe
  35 import qualified Data.Map as Map
  36 import Control.Exception
  37 import Data.Queue
  38
  39 type PageId = Int
  40 data Page = Pg { pgid :: PageId, referenced :: Bool }
  41 data Pageq = Pgq { active, inactive :: PageList }
  42
  43 {-
  44 data PageList = Pgl Int [Int]
  45 pglenqueue x (Pgl n xs) = Pgl (n+1) (xs++[x])
  46 pgldequeue (Pgl n (x:xs)) = (x, Pgl (n-1) xs)
  47 pglsize (Pgl n _) = n
  48 pglempty = Pgl 0 []
  49 -}
  50 data PageList = Pgl Int (Queue Int)
  51 pglenqueue x (Pgl n q) = Pgl (n+1) (addToQueue q x)
  52 pgldequeue (Pgl n q) = (x, Pgl (n-1) nq) where
  53         Just (x,nq) = deQueue q
  54 pglsize (Pgl n _) = n
  55 pglempty = Pgl 0 emptyQueue
  56
  57 {-
  58 instance Show Page where
  59         show pg = "(" ++ (show $ pgid pg) ++ "," ++ (show $ referenced pg) ++ ")"
  60 instance Show Pageq where
  61         show q = "(act=" ++ (show $ active q) ++ ",inact=" ++ (show $ inactive q) ++ ")"
  62 -}
  63
  64 pglookup idx m = Map.lookup idx m
  65
  66 emptyq = Pgq { active = pglempty, inactive = pglempty }
  67
  68 clrref pg = pg { referenced = False }
  69 markref pg = pg { referenced = True }
  70
  71 clrrefm x m = Map.update (Just . clrref) x m
  72
  73 reactivate :: (Pageq,Map.Map Int Page) -> (Pageq,Map.Map Int Page)
  74 reactivate (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
  78 reactivate_act (q,m) = (nq,nm) where
  79         nq = q { active = pglenqueue x $ naq }
  80         nm = clrrefm x m
  81         (x,naq) = pgldequeue $ active q
  82 deactivate_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
  87 reclaim :: Int -> (Pageq,Map.Map Int Page)->(Pageq,Map.Map Int Page)
  88 reclaim 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
  98 fillinact 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
 111 pgref :: Int->Map.Map Int Page -> Map.Map Int Page
 112 pgref idx m = Map.update f idx m where
 113         f = Just . markref
 114
 115 do_nbsd1 npg pct n q m [] = (reverse n, q)
 116 do_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
 138 do_nbsd npg pct rs = fst $ do_nbsd1 npg pct [] emptyq Map.empty rs
 139 do_nbsd_dbg npg pct rs = do_nbsd1 npg pct [] emptyq Map.empty rs
 140
 141 main = 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