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