1{- 2 Register table: list of all registers 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 RegisterTable where 15 16import Data.List 17import MackerelParser 18import Text.ParserCombinators.Parsec 19import Attr 20import qualified Fields as F 21import qualified TypeTable as TT 22import qualified TypeName as TN 23import qualified Space 24 25{-------------------------------------------------------------------- 26Register table: list of all registers 27--------------------------------------------------------------------} 28 29data Rec = Rec { name :: String, -- Unqualified name of register 30 fl :: [F.Rec], -- List of fields (may be empty) 31 attr :: Attr, -- Attribute (for non-field types) 32 tpe :: TT.Rec, -- Type of this register 33 origtype :: String, -- Original name of register type 34 size :: Integer, -- Width in bits 35 also :: Bool, -- Only register at this address? 36 desc :: String, -- Description string 37 spc_id :: String, -- Address space identifier 38 spc :: Space.Rec, -- Address space record 39 base :: String, -- Base variable name 40 offset :: Integer, -- Offset of register from base 41 arr :: ArrayLoc, -- Array of locations 42 pos :: SourcePos -- Source code position 43 } 44 deriving Show 45 46-- 47-- Building the register table 48-- 49make_table :: [TT.Rec] -> [AST] -> String -> BitOrder -> [Space.Rec] -> [Rec] 50make_table rtinfo decls dn order spt = 51 concat [ (make_reginfo rtinfo d dn order spt) | d <- decls ] 52 53 54make_regproto :: String -> Attr -> Bool -> RegLoc -> String -> SourcePos -> [Space.Rec] -> TT.Rec -> String 55 -> Rec 56make_regproto n atrv als rloc dsc p spt t tname = 57 let (si, s, b, o) = get_location rloc spt 58 in 59 Rec { name = n, 60 fl = [], 61 attr =atrv, 62 tpe = t, 63 origtype = tname, 64 size = 0, 65 also = als, 66 desc = dsc, 67 spc_id = si, 68 spc = s, 69 base = b, 70 offset = o, 71 arr = (ArrayListLoc []), 72 pos = p } 73 74make_reginfo :: [TT.Rec] -> AST -> String -> BitOrder -> [Space.Rec] -> [Rec] 75 76make_reginfo rtinfo (RegArray n atrv als rloc aloc dsc (TypeDefn decls) p) dn order spt = 77 let t = (TT.get_rtrec rtinfo (TN.fromParts dn n)) 78 r = make_regproto n atrv als rloc dsc p spt t "<inline>" 79 in 80 [ r { fl = F.make_list dn atrv order 0 decls, 81 size = TT.tt_size t, 82 arr = aloc } ] 83 84make_reginfo rtinfo (RegArray n atrv als rloc aloc dsc tr@(TypeRef tname dname) p) dn order spt = 85 let tn = TN.fromRef tr dn 86 rt = (TT.get_rtrec rtinfo tn) 87 r = make_regproto n atrv als rloc dsc p spt rt tname 88 in case rt of 89 t@(TT.Primitive {}) -> [ r { size = (TT.tt_size rt), 90 arr = aloc } ] 91 t@(TT.RegFormat {}) -> [ r { fl = F.inherit_list atrv (TT.fields rt), 92 size = (TT.tt_size rt), 93 arr = aloc } ] 94 t@(TT.DataFormat {}) -> [ r { fl = F.inherit_list atrv (TT.fields rt), 95 size = (TT.tt_size rt), 96 arr = aloc } ] 97 t@(TT.ConstType {}) -> [ r { size = case (TT.tt_width rt) of 98 Nothing -> -1 99 Just i -> i, 100 arr = aloc } ] 101 102make_reginfo rtinfo (Register n atrv als rloc dsc (TypeDefn decls) p) dn order spt = 103 let tn = TN.fromParts dn n 104 td = TT.get_rtrec rtinfo tn 105 r = make_regproto n atrv als rloc dsc p spt td "<inline>" 106 in 107 [ r { fl = F.make_list dn atrv order 0 decls, 108 size = TT.tt_size td, 109 arr = (ArrayListLoc []) } ] 110 111make_reginfo rtinfo (Register n atrv als rloc dsc tr@(TypeRef tname dname) p) dn order spt = 112 let tn = TN.fromRef tr dn 113 rt = (TT.get_rtrec rtinfo tn) 114 r = make_regproto n atrv als rloc dsc p spt rt tname 115 in case rt of 116 t@(TT.Primitive {}) -> [ r { size = (TT.tt_size rt), 117 arr = (ArrayListLoc []) } ] 118 t@(TT.RegFormat {}) -> [ r { fl = F.inherit_list atrv (TT.fields rt), 119 size = (TT.tt_size rt), 120 arr = (ArrayListLoc []) } ] 121 t@(TT.DataFormat {}) -> [ r { fl = F.inherit_list atrv (TT.fields rt), 122 size = (TT.tt_size rt), 123 arr = (ArrayListLoc []) } ] 124 t@(TT.ConstType {}) -> [ r { size = case (TT.tt_width rt) of 125 Nothing -> -1 126 Just i -> i, 127 arr = (ArrayListLoc []) } ] 128 129make_reginfo rtinfo _ _ _ _ = [] 130 131get_location :: RegLoc -> [Space.Rec] -> ( String, Space.Rec, String, Integer ) 132get_location RegNoLoc _ = 133 ( "", Space.NoSpace, "", 0) 134get_location (RegLoc s b o) spt = 135 ( s, Space.lookup s spt, b, o) 136 137overlap :: Rec -> Rec -> Bool 138overlap r1 r2 139 | spc_id r1 /= spc_id r2 = False 140 | base r1 /= base r2 = False 141 | spc r1 == Space.NoSpace = False 142 | spc r2 == Space.NoSpace = False 143 | otherwise = compare_extents (extents r1) (extents r2) 144 145compare_extents :: [ (Integer, Integer) ] -> [ (Integer, Integer) ] -> Bool 146compare_extents [] _ = False 147compare_extents _ [] = False 148compare_extents (e:es) (f:fs) 149 | extent_overlap e f = True 150 | otherwise = 151 if fst e < fst f 152 then compare_extents es (f:fs) 153 else compare_extents (e:es) fs 154 155extent_overlap :: (Integer, Integer) -> (Integer, Integer) -> Bool 156extent_overlap (b1, o1) (b2, o2) 157 | b1 > b2 = ( b2 + o2 > b1 ) 158 | otherwise = ( b1 + o1 > b2 ) 159 160extents :: Rec -> [ (Integer, Integer) ] 161extents r 162 | spc r == Space.NoSpace = [] 163 | otherwise = [ ((offset r) + o, (extentsz (Space.t (spc r)) (size r))) 164 | o <- arrayoffsets (arr r) (size r)] 165extentsz :: Space.SpaceType -> Integer -> Integer 166extentsz (Space.BYTEWISE s) sz = sz `div` 8 `div` s 167extentsz _ sz = 1 168 169arrayoffsets :: ArrayLoc -> Integer -> [ Integer ] 170arrayoffsets (ArrayListLoc []) _ = [0] 171arrayoffsets (ArrayListLoc l) _ = (sort l) -- Return offsets in order 172arrayoffsets (ArrayStepLoc n 0) sz = enumFromThenTo 0 (sz `div` 8) (sz* (n-1) `div` 8) 173arrayoffsets (ArrayStepLoc n s) _ = enumFromThenTo 0 s (s* (n-1)) 174 175-- 176-- Lookups 177-- 178lookup_reg :: [Rec] -> String -> Rec 179lookup_reg reginfo n = 180 head l where l = [ r | r <- reginfo, (name r) == n ] 181 182lookup_size :: [Rec] -> String -> Integer 183lookup_size reginfo n = (size (lookup_reg reginfo n )) 184 185-- 186-- Properties of registers 187-- 188 189is_writeable :: Rec -> Bool 190is_writeable r@Rec{ attr=a, tpe=t } = 191 case t of 192 (TT.Primitive {} ) -> attr_is_writeable a 193 (TT.ConstType {} ) -> attr_is_writeable a 194 _ -> any F.is_writeable (fl r) 195 196is_readable :: Rec -> Bool 197is_readable r@Rec{ attr=a, tpe=t } = 198 case t of 199 (TT.Primitive {} ) -> attr_is_readable a 200 (TT.ConstType {} ) -> attr_is_readable a 201 _ -> any F.is_readable (fl r) 202 203is_writeonly :: Rec -> Bool 204is_writeonly r@Rec{ attr=a, tpe=t } = 205 case t of 206 (TT.Primitive {} ) -> attr_is_writeonly a 207 (TT.ConstType {} ) -> attr_is_writeonly a 208 _ -> any F.is_writeonly (fl r) 209 210needs_shadow :: Rec -> Bool 211needs_shadow r = is_writeonly r 212 213typename :: Rec -> TN.Name 214typename r = (TT.tt_name (tpe r)) 215 216is_array :: Rec -> Bool 217is_array (Rec { arr = (ArrayListLoc []) } ) = False 218is_array r = True 219 220is_noaddr :: Rec -> Bool 221is_noaddr (Rec { spc = Space.NoSpace } ) = True 222is_noaddr _ = False 223 224num_elements :: Rec -> Integer 225num_elements Rec { arr = (ArrayListLoc l) } = toInteger (length l) 226num_elements Rec { arr = (ArrayStepLoc num _) } = num 227 228needs_read_before_write :: Rec -> Bool 229needs_read_before_write r = any F.is_rsvd (fl r) 230 231 232 233data Shadow = Shadow String TN.Name 234-- name type 235get_shadows :: [Rec] -> [Shadow] 236get_shadows reginfo = 237 [ Shadow (name r) (typename r) | r <- reginfo, needs_shadow r ] 238 239get_shadow_registers :: [Rec] -> [Rec] 240get_shadow_registers reginfo = [ r | r <- reginfo, needs_shadow r ] 241