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