xref: /src/regress/sys/uvm/pdsim/nbsd.hs

{-
/*	$NetBSD: nbsd.hs,v 1.1 2006/10/09 12:32:46 yamt Exp $	*/

/*-
 * Copyright (c)2005 YAMAMOTO Takashi,
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */
-}

import System.Environment
import System.IO
import List
import Maybe
import qualified Data.Map as Map
import Control.Exception
import Data.Queue

type PageId = Int
data Page = Pg { pgid :: PageId, referenced :: Bool }
data Pageq = Pgq { active, inactive :: PageList }

{-
data PageList = Pgl Int [Int]
pglenqueue x (Pgl n xs) = Pgl (n+1) (xs++[x])
pgldequeue (Pgl n (x:xs)) = (x, Pgl (n-1) xs)
pglsize (Pgl n _) = n
pglempty = Pgl 0 []
-}
data PageList = Pgl Int (Queue Int)
pglenqueue x (Pgl n q) = Pgl (n+1) (addToQueue q x)
pgldequeue (Pgl n q) = (x, Pgl (n-1) nq) where
	Just (x,nq) = deQueue q
pglsize (Pgl n _) = n
pglempty = Pgl 0 emptyQueue

{-
instance Show Page where
	show pg = "(" ++ (show $ pgid pg) ++ "," ++ (show $ referenced pg) ++ ")"
instance Show Pageq where
	show q = "(act=" ++ (show $ active q) ++ ",inact=" ++ (show $ inactive q) ++ ")"
-}

pglookup idx m = Map.lookup idx m

emptyq = Pgq { active = pglempty, inactive = pglempty }

clrref pg = pg { referenced = False }
markref pg = pg { referenced = True }

clrrefm x m = Map.update (Just . clrref) x m

reactivate :: (Pageq,Map.Map Int Page) -> (Pageq,Map.Map Int Page)
reactivate (q,m) = (nq,nm) where
	nq = q { active = pglenqueue x $ active q, inactive = niaq }
	nm = clrrefm x m
	(x,niaq) = pgldequeue $ inactive q
reactivate_act (q,m) = (nq,nm) where
	nq = q { active = pglenqueue x $ naq }
	nm = clrrefm x m
	(x,naq) = pgldequeue $ active q
deactivate_act (q,m) = (nq,nm) where
	nq = q { active = naq, inactive = pglenqueue x $ inactive q }
	nm = clrrefm x m
	(x,naq) = pgldequeue $ active q

reclaim :: Int -> (Pageq,Map.Map Int Page)->(Pageq,Map.Map Int Page)
reclaim pct (q0,m0) =
	if referenced p then
		reclaim pct $ reactivate (q,m)
	else
		(q { inactive = npgl },Map.delete x m)
	where
		(q,m) = fillinact pct (q0,m0)
		(x,npgl) = pgldequeue $ inactive q
		Just p = Map.lookup x m0

fillinact inactpct (q,m) =
	if inactlen >= inacttarg then (q,m) else
#if defined(LINUX)
	if referenced p then
	fillinact inactpct $ reactivate_act (q,m) else
#endif
	fillinact inactpct $ deactivate_act (q,m)
	where
		Just p = Map.lookup x m
		(x,_) = pgldequeue $ active q
		inactlen = pglsize $ inactive q
		inacttarg = div (Map.size m * inactpct) 100

pgref :: Int->Map.Map Int Page -> Map.Map Int Page
pgref idx m = Map.update f idx m where
	f = Just . markref

do_nbsd1 npg pct n q m [] = (reverse n, q)
do_nbsd1 npg pct n q m rs@(r:rs2) =
	let
		p = pglookup r m
	in
	if isJust p then
		do_nbsd1 npg pct n q (pgref r m) rs2
	else if Map.size m < npg then
		do_nbsd1 npg pct (r:n) (enqueue r q) (pgenqueue r m) rs2
	else
		let
			(nq, nm) = reclaim pct (q,m)
		in
		do_nbsd1 npg pct (r:n) (enqueue r nq) (pgenqueue r nm) rs2
	where
		newpg i = Pg {pgid = i, referenced = True}
		pgenqueue i m = Map.insert i (newpg i) m
#if defined(LINUX)
		enqueue i q = q { inactive = pglenqueue i $ inactive q }
#else
		enqueue i q = q { active = pglenqueue i $ active q }
#endif

do_nbsd npg pct rs = fst $ do_nbsd1 npg pct [] emptyq Map.empty rs
do_nbsd_dbg npg pct rs = do_nbsd1 npg pct [] emptyq Map.empty rs

main = do
	xs <- getContents
	args <- getArgs
	let
		ls = lines xs
		npgs::Int
		npgs = read $ args !! 0
		pct = read $ args !! 1
		pgs::[Int]
		pgs = map read ls
	mapM_ print $ do_nbsd npgs pct pgs