Home | History | Annotate | Line # | Download | only in pdsim 
      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 
     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
    152