140 lines
4.9 KiB
Haskell
140 lines
4.9 KiB
Haskell
{-
|
|
Fields: Mackerel register fields
|
|
|
|
Part of Mackerel: a strawman device definition DSL for Barrelfish
|
|
|
|
Copyright (c) 2007, 2008, ETH Zurich.
|
|
All rights reserved.
|
|
|
|
This file is distributed under the terms in the attached LICENSE file.
|
|
If you do not find this file, copies can be found by writing to:
|
|
ETH Zurich D-INFK, Universitaetstrasse 6, CH-8092 Zurich. Attn: Systems Group.
|
|
-}
|
|
|
|
module Fields where
|
|
|
|
import Attr
|
|
import Data.Bits
|
|
import Text.ParserCombinators.Parsec
|
|
import MackerelParser
|
|
import TypeName as TN
|
|
|
|
data Rec = Rec { name :: String,
|
|
size :: Integer,
|
|
offset :: Integer,
|
|
attr :: Attr,
|
|
initial :: Integer,
|
|
tpe :: Maybe TN.Name,
|
|
desc :: String,
|
|
pos :: SourcePos,
|
|
is_anon :: Bool }
|
|
deriving (Show,Eq)
|
|
|
|
is_writeonly :: Rec -> Bool
|
|
is_writeonly f = attr_is_writeonly (attr f)
|
|
|
|
is_readable :: Rec -> Bool
|
|
is_readable f = attr_is_readable (attr f)
|
|
|
|
is_writeable :: Rec -> Bool
|
|
is_writeable f = attr_is_writeable (attr f)
|
|
|
|
is_rsvd :: Rec -> Bool
|
|
is_rsvd Rec { attr = RSVD } = True
|
|
is_rsvd _ = False
|
|
|
|
--
|
|
-- Create a list of fields, in the right order, with the right default
|
|
-- attribute, from a set of declarations.
|
|
--
|
|
make_list :: String -> Attr -> BitOrder -> Integer -> [AST] -> [Rec]
|
|
make_list dn dflt order 0 decls
|
|
= make_list_from_word dn dflt order 0 decls
|
|
make_list dn dflt order word_size decls
|
|
= make_list_of_words dn dflt order word_size 0 decls []
|
|
|
|
|
|
make_list_of_words :: String -> Attr -> BitOrder -> Integer -> Integer
|
|
-> [AST] -> [AST] -> [Rec]
|
|
make_list_of_words dn dflt order word_size off decls acc
|
|
= let acc_length = foldl (+) 0 [ s | (RegField _ s _ _ _ _) <- acc ]
|
|
in
|
|
if acc_length >= word_size then
|
|
let al = make_list_from_word dn dflt order off acc
|
|
new_off = (offset $ last al) + (size $ last al)
|
|
in
|
|
al ++ (make_list_of_words dn dflt order word_size new_off decls [])
|
|
else
|
|
if (length decls) == 0 then
|
|
make_list_from_word dn dflt order off acc
|
|
else
|
|
make_list_of_words dn dflt order word_size off (tail decls) (acc ++ [head decls])
|
|
|
|
|
|
make_list_from_word :: String -> Attr -> BitOrder -> Integer -> [AST] -> [Rec]
|
|
make_list_from_word dn dflt LSBFIRST init_offset decls =
|
|
-- Cons up a list of the offsets of each field in the structure.
|
|
let add_sizes decls =
|
|
foldl (\t (RegField _ s _ _ _ _) -> t ++ [(last t) + s]) [init_offset] decls
|
|
in map (make_field dn dflt False) $ zip decls (add_sizes decls)
|
|
make_list_from_word dn dflt MSBFIRST init_offset decls =
|
|
make_list_from_word dn dflt LSBFIRST init_offset (reverse decls)
|
|
|
|
-- make_list_from_word dflt MSBFIRST init_offset decls =
|
|
-- - make_list dflt LSBFIRST init_offset (reverse decls)
|
|
-- + make_list_from_word dflt LSBFIRST init_offset (reverse decls)
|
|
--
|
|
-- Create a list of fields, in the right order, with the right
|
|
-- attribute, from a set of other fields (e.g. from a type).
|
|
-- The inheritance rules for attributes are as follows:
|
|
--
|
|
inherit_list :: Attr -> [Rec] -> [Rec]
|
|
inherit_list regattr ftlist =
|
|
[ r { attr = (if (attr r) == NOATTR then regattr else (attr r)) } | r <- ftlist ]
|
|
|
|
--
|
|
-- Fix up default attributes. Anything without an attributed defaults
|
|
-- to the attribute of the register (dflt here), unless it's "_", in
|
|
-- which case it defaults to RSVD.
|
|
--
|
|
make_field :: String -> Attr -> Bool -> (AST, Integer) -> Rec
|
|
make_field dn dflt anon ((RegField id sz a t dsc p), off)
|
|
| id == "_" =
|
|
make_field dn RSVD True ((RegField ("_anon" ++ show off) sz a t "_" p), off)
|
|
| otherwise =
|
|
Rec { name = id,
|
|
size = sz,
|
|
offset = off,
|
|
initial = if a == MB1 then (shift 1 $ fromInteger sz) - 1 else 0,
|
|
attr = if a == NOATTR then dflt else a,
|
|
tpe = make_ftype t dn,
|
|
desc = dsc,
|
|
pos = p,
|
|
is_anon = anon }
|
|
|
|
make_ftype :: AST -> String -> Maybe TN.Name
|
|
make_ftype NoBitFieldType _ = Nothing
|
|
make_ftype t@(TypeRef _ _) dn = Just (TN.fromRef t dn)
|
|
|
|
--
|
|
-- Generate masks and shifts for isolating this field. These functions
|
|
-- are polymorphic so that they don't need to know how large the total
|
|
-- load unit is (32 bits? 8 bits?) etc.
|
|
--
|
|
extract_mask :: (Num a, Bits a) => Rec -> Integer -> a
|
|
extract_mask f sz =
|
|
foldl setBit 0 (enumFromTo (fromInteger $ offset f)
|
|
(fromInteger $ (offset f) + (size f) - 1))
|
|
insert_mask :: (Num a, Bits a) => Rec -> Integer -> a
|
|
insert_mask f sz =
|
|
foldl complementBit (extract_mask f sz) (enumFromTo 0 (fromInteger sz - 1))
|
|
|
|
extract_shift :: Rec -> Integer
|
|
extract_shift f = - (insert_shift f)
|
|
|
|
insert_shift :: Rec -> Integer
|
|
insert_shift f = offset f
|
|
|
|
initial_mask :: Rec -> Integer
|
|
initial_mask f = shift (initial f) (fromInteger $ insert_shift f)
|