1{- 2 Type table: list of all register types 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 TypeTable where 15 16import MackerelParser 17import Attr 18import Text.ParserCombinators.Parsec 19import Text.ParserCombinators.Parsec.Pos 20import qualified Fields as F 21import qualified TypeName as TN 22 23{-------------------------------------------------------------------- 24 25--------------------------------------------------------------------} 26 27data Val = Val { cname :: String, 28 cval :: Expr, 29 cdesc :: String, 30 ctype :: TN.Name, 31 cpos :: SourcePos } 32 deriving Show 33 34data Rec = RegFormat { tt_name :: TN.Name, 35 tt_size :: Integer, 36 fields :: [F.Rec], 37 tt_desc :: String, 38 pos :: SourcePos } 39 | DataFormat { tt_name :: TN.Name, 40 tt_size :: Integer, 41 fields :: [F.Rec], 42 tt_desc :: String, 43 wordsize :: Integer, 44 pos :: SourcePos } 45 | ConstType { tt_name :: TN.Name, 46 tt_size :: Integer, 47 tt_vals :: [ Val ], 48 tt_width :: Maybe Integer, 49 tt_desc :: String, 50 pos :: SourcePos } 51 | Primitive { tt_name :: TN.Name, 52 tt_size :: Integer, 53 tt_attr :: Attr } 54 deriving Show 55 56type_name :: Rec -> String 57type_name r = TN.toString $ tt_name r 58 59devname :: Rec -> String 60devname r = TN.devName $ tt_name r 61 62type_kind :: Rec -> String 63type_kind RegFormat {} = "Register" 64type_kind DataFormat {} = "Data" 65type_kind ConstType {} = "Constant" 66type_kind Primitive {} = "Primitive" 67 68-- Is this a primitive (i.e. non-record-like) type. A key issue here 69-- is that this includes constants types; otherwise this is equivalent 70-- to is_builtin below. 71is_primitive :: Rec -> Bool 72is_primitive Primitive {} = True 73is_primitive ConstType {} = True 74is_primitive _ = False 75 76is_builtin :: Rec -> Bool 77is_builtin Primitive { tt_name = n } = TN.is_builtin_type n 78is_builtin _ = False 79 80builtin_size :: String -> Integer 81builtin_size "uint8" = 8 82builtin_size "uint16" = 16 83builtin_size "uint32" = 32 84builtin_size "uint64" = 64 85 86make_rtypetable :: DeviceFile -> [Rec] 87make_rtypetable (DeviceFile (Device devname bitorder _ _ decls) _) = 88 (concat [ make_rtrec d devname bitorder | d <- decls ]) 89 ++ 90 [ Primitive (TN.fromParts devname ("uint" ++ (show w))) w NOATTR 91 | w <- [ 8, 16, 32, 64 ] ] 92 93make_rtrec :: AST -> String -> BitOrder -> [Rec] 94make_rtrec (RegType nm dsc (TypeDefn decls) p) dev order = 95 [ RegFormat { tt_name = TN.fromParts dev nm, 96 tt_size = (calc_tt_size decls), 97 fields = F.make_list dev NOATTR order 0 decls, 98 tt_desc = dsc, 99 pos = p } ] 100 101make_rtrec (Register nm tt_attrib _ _ dsc (TypeDefn decls) p) dev order = 102 [ RegFormat { tt_name = TN.fromParts dev nm, 103 tt_size = (calc_tt_size decls), 104 fields = F.make_list dev tt_attrib order 0 decls, 105 tt_desc = "Implicit type of " ++ dsc ++ " register", 106 pos = p } ] 107 108make_rtrec (RegArray nm tt_attrib _ _ _ dsc (TypeDefn decls) p) dev order = 109 [ RegFormat { tt_name = TN.fromParts dev nm, 110 tt_size = (calc_tt_size decls), 111 fields = F.make_list dev NOATTR order 0 decls, 112 tt_desc = "Implicit type of " ++ dsc ++ " register array", 113 pos = p } ] 114 115make_rtrec (DataType nm dsc (TypeDefn decls) o w p) dev devorder = 116 let order = if o == NOORDER then devorder else o 117 sz = calc_tt_size decls 118 in 119 [ DataFormat { tt_name = TN.fromParts dev nm, 120 tt_size = sz, 121 fields = F.make_list dev RW order w decls, 122 tt_desc = dsc, 123 wordsize = if w == 0 then sz else w, 124 pos = p } ] 125make_rtrec (Constants nm d vs w p) dev devorder = 126 let tn = TN.fromParts dev nm 127 vl = [ make_val tn v | v <- vs ] 128 in 129 [ ConstType { tt_name = tn, 130 tt_size = case w of 131 Nothing -> calc_const_size vl 132 Just t -> t, 133 tt_vals = vl, 134 tt_desc = d, 135 tt_width = w, 136 pos = p } ] 137make_rtrec _ _ _ = [] 138 139calc_const_size :: [Val] -> Integer 140calc_const_size vs = 141 let m = maximum [ i | t@Val { cval = (ExprConstant i) } <- vs ] 142 in 143 if m <= 0xff then 8 144 else if m <= 0xffff then 16 145 else if m <= 0xffffffff then 32 146 else 64 147 148-- Building constant lists 149make_val :: TN.Name -> AST -> Val 150make_val tn (ConstVal i e d p) 151 = Val { cname = i, cval = e, cdesc = d, ctype = tn, cpos = p } 152 153calc_tt_size :: [AST] -> Integer 154calc_tt_size decls = sum [ sz | (RegField _ sz _ _ _ _) <- decls ] 155 156get_rtrec :: [Rec] -> TN.Name -> Rec 157get_rtrec rtinfo nm = 158 let l = [ rt | rt <- rtinfo, (tt_name rt) == nm ] 159 in 160 if (length l) > 0 161 then head l 162 else RegFormat { tt_name = TN.null, 163 tt_size = 32, 164 fields = [], 165 tt_desc = "Failed to find type" ++ show nm, 166 pos = initialPos "no file" } 167