1{- 
2   Fields: Mackerel register fields
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 Fields where
15
16import Attr
17import Data.Bits
18import Text.ParserCombinators.Parsec
19import MackerelParser
20import TypeName as TN
21
22data Rec = Rec { name :: String,
23                 size :: Integer,
24                 offset :: Integer,
25                 attr :: Attr,
26                 initial :: Integer,
27                 tpe :: Maybe TN.Name,
28                 desc :: String,
29                 pos :: SourcePos,
30                 is_anon :: Bool }
31           deriving (Show,Eq)
32
33is_writeonly :: Rec -> Bool
34is_writeonly f = attr_is_writeonly (attr f)
35
36is_readable :: Rec -> Bool
37is_readable  f = attr_is_readable (attr f)
38
39is_writeable :: Rec -> Bool
40is_writeable f = attr_is_writeable (attr f)
41
42is_rsvd :: Rec -> Bool
43is_rsvd Rec { attr = RSVD } = True
44is_rsvd _ = False
45
46--
47-- Create a list of fields, in the right order, with the right default
48-- attribute, from a set of declarations.
49--
50make_list :: String -> Attr -> BitOrder -> Integer -> [AST] -> [Rec]
51make_list dn dflt order 0 decls 
52    = make_list_from_word dn dflt order 0 decls
53make_list dn dflt order word_size decls 
54    = make_list_of_words dn dflt order word_size 0 decls []
55
56
57make_list_of_words :: String -> Attr -> BitOrder -> Integer -> Integer
58                      -> [AST] -> [AST] -> [Rec]
59make_list_of_words dn dflt order word_size off decls acc 
60    = let acc_length = foldl (+) 0 [ s | (RegField _ s _ _ _ _) <- acc ]
61      in
62        if acc_length >= word_size then
63            let al = make_list_from_word dn dflt order off acc
64                new_off = (offset $ last al) + (size $ last al)
65            in 
66              al ++ (make_list_of_words dn dflt order word_size new_off decls [])
67        else 
68            if (length decls) == 0 then
69                 make_list_from_word dn dflt order off acc
70            else
71                make_list_of_words dn dflt order word_size off (tail decls) (acc ++ [head decls])
72
73
74make_list_from_word :: String -> Attr -> BitOrder -> Integer -> [AST] -> [Rec]
75make_list_from_word dn dflt LSBFIRST init_offset decls = 
76    -- Cons up a list of the offsets of each field in the structure. 
77    let add_sizes decls = 
78            foldl (\t (RegField _ s _ _ _ _) -> t ++ [(last t) + s]) [init_offset] decls
79    in map (make_field dn dflt False) $ zip decls (add_sizes decls)
80make_list_from_word dn dflt MSBFIRST init_offset decls = 
81    make_list_from_word dn dflt LSBFIRST init_offset (reverse decls)
82
83--   make_list_from_word dflt MSBFIRST init_offset decls =
84-- -    make_list dflt LSBFIRST init_offset (reverse decls)
85-- +    make_list_from_word dflt LSBFIRST init_offset (reverse decls)
86--
87-- Create a list of fields, in the right order, with the right 
88-- attribute, from a set of other fields (e.g. from a type).
89-- The inheritance rules for attributes are as follows:
90--
91inherit_list :: Attr -> [Rec] -> [Rec]
92inherit_list regattr ftlist = 
93    [ r { attr = (if (attr r) == NOATTR then regattr else (attr r)) } | r <- ftlist ]
94
95--
96-- Fix up default attributes.  Anything without an attributed defaults
97-- to the attribute of the register (dflt here), unless it's "_", in
98-- which case it defaults to RSVD.
99--
100make_field :: String -> Attr -> Bool -> (AST, Integer) -> Rec
101make_field dn dflt anon ((RegField id sz a t dsc p), off) 
102    | id == "_" = 
103        make_field dn RSVD True ((RegField ("_anon" ++ show off) sz a t "_" p), off)
104    | otherwise = 
105        Rec { name = id, 
106              size = sz, 
107              offset = off,
108              initial = if a == MB1 then (shift 1 $ fromInteger sz) - 1 else 0,
109              attr = if a == NOATTR then dflt else a,
110              tpe = make_ftype t dn,
111              desc = dsc, 
112              pos = p, 
113              is_anon = anon }
114
115make_ftype :: AST -> String -> Maybe TN.Name
116make_ftype NoBitFieldType _ = Nothing
117make_ftype t@(TypeRef _ _) dn = Just (TN.fromRef t dn)
118
119--
120-- Generate masks and shifts for isolating this field.  These functions
121-- are polymorphic so that they don't need to know how large the total
122-- load unit is (32 bits? 8 bits?) etc.
123--
124extract_mask :: (Num a, Bits a) => Rec -> Integer -> a
125extract_mask f sz = 
126    foldl setBit 0 (enumFromTo (fromInteger $ offset f) 
127                               (fromInteger $ (offset f) + (size f) - 1))
128insert_mask :: (Num a, Bits a) => Rec -> Integer -> a
129insert_mask f sz = 
130    foldl complementBit (extract_mask f sz) (enumFromTo 0 (fromInteger sz - 1))
131
132extract_shift :: Rec -> Integer
133extract_shift f = - (insert_shift f)
134
135insert_shift :: Rec -> Integer
136insert_shift f = offset f
137
138initial_mask :: Rec -> Integer
139initial_mask f = shift (initial f) (fromInteger $ insert_shift f)
140