1{- 
2  Space: dealing with various register address spaces
3   
4  Part of Mackerel: a strawman device definition DSL for Barrelfish
5   
6  Copyright (c) 2007, 2008, ETH Zurich.
7  All rights reserved.
8  
9  This file is distributed under the terms in the attached LICENSE file.
10  If you do not find this file, copies can be found by writing to:
11  ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
12-}  
13
14module Space where
15
16import Text.ParserCombinators.Parsec
17
18data SpaceType = BYTEWISE Integer | VALUEWISE | REGISTERWISE | UNDEF
19               deriving (Show, Eq)
20
21data Rec = Builtin { n :: String,
22                     d :: String,
23                     t :: SpaceType }
24         | Defined { n :: String,
25                     a :: [ String ],
26                     d :: String,
27                     devname :: String,
28                     t :: SpaceType,
29                     p :: SourcePos }
30         | UndefinedSpace
31         | NoSpace
32           deriving (Eq,Show)
33
34make :: String -> [String] -> String -> SpaceType -> SourcePos -> Rec
35make name args desc tpe pos = 
36    Defined { n = name, a = args, d = desc, devname = "", t = tpe, p = pos }
37
38builtins :: [ Rec ]
39builtins = [ Builtin { n = "addr",
40                       d = "Physical address space", 
41                       t = BYTEWISE 1},
42             Builtin { n = "io", 
43                       d = "I/O port space",
44                       t = BYTEWISE 1},
45             Builtin { n = "pci",  
46                       d = "PCI configuration space",
47                       t = BYTEWISE 1}
48           ]
49
50lookup :: String -> [Rec] -> Rec
51lookup sn spt = 
52    let rl = [ s | s <- spt, (n s) == sn ]
53    in if length rl == 0 then UndefinedSpace else head rl
54
55is_builtin :: Rec -> Bool
56is_builtin (Builtin _ _ _) = True
57is_builtin _ = False
58
59{--
60data Interval = Interval RegSpace String Integer Integer
61              deriving Ord
62
63make_interval_from_regloc :: RegLoc -> Integer -> Interval
64make_interval_from_regloc (RegLoc space base expr) sz =
65    Interval space base offset size 
66        where
67          offset = evaluate expr
68          size = if size_matters space 
69                 then size 
70                 else 1 
71
72intervals_overlap :: Interval -> Interval -> Bool
73intervals_overlap (Interval sp1 b1 o1 s1) (Interval sp2 b2 o2 s2) 
74    | sp1 != sp2 = false
75    | b1 != b2 = false
76    | (o1 <= o2) and (o1 + sz) > o2 = true
77    | (o2 <= o1) and (o2 + sz) > o1 = true
78    | otherwise = false
79
80make_intlist_from_array :: RegLoc -> ArrayLoc -> Integer -> [ Interval ]
81make_intlist_from_array (RegLoc space base expr) (ArrayListLoc l) sz = 
82--}
83