1445 lines
53 KiB
Haskell
1445 lines
53 KiB
Haskell
{-
|
|
ShiftDriver: Mackerel backend for device drivers
|
|
|
|
Part of Mackerel: a strawman device definition DSL for Barrelfish
|
|
|
|
Copyright (c) 2007, 2008, 2010, 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 ShiftDriver where
|
|
|
|
import System.IO
|
|
import System.Exit
|
|
import Data.List
|
|
import Data.Bits
|
|
import Text.Printf
|
|
import MackerelParser
|
|
import Checks
|
|
|
|
import Attr
|
|
import qualified Space
|
|
import qualified CAbsSyntax as C
|
|
import qualified TypeName as TN
|
|
import qualified TypeTable as TT
|
|
import qualified RegisterTable as RT
|
|
import qualified Fields
|
|
import qualified Dev
|
|
|
|
------------------------------------------------------------------------
|
|
-- Standardized names of C variables
|
|
------------------------------------------------------------------------
|
|
cv_i = "_i" -- Index for register arrays
|
|
cv_dev = "_dev" -- Device structure
|
|
cv_avail = "_avail" -- Available buffer space for snprintf
|
|
cv_size = "_size" -- Size of buffer for snprintf
|
|
cv_s = "_s" -- Buffer ptr for snprint
|
|
cv_rc = "_rc" -- Return value from snprintf
|
|
cv_r = "_r" -- Accumulator for snprintf values
|
|
cv_regval = "_regval" -- Value of type register contents
|
|
cv_fieldval = "_fieldval" -- Value of type field contents
|
|
cv_dtptr = "_dtptr" -- Value of type pointer to datatype struct
|
|
cv_e = "_e" -- Enumeration type value
|
|
|
|
-------------------------------------------------------------------------
|
|
-- The C Language mapping: top level name definitions
|
|
-------------------------------------------------------------------------
|
|
|
|
--
|
|
-- Device-related names
|
|
--
|
|
|
|
device_c_name :: String
|
|
device_c_name = "__DN(t)"
|
|
|
|
device_shadow_field_name :: RT.Rec -> String
|
|
device_shadow_field_name rt = (RT.name rt) ++ "_shadow"
|
|
|
|
device_initialize_fn_name :: Dev.Rec -> String
|
|
device_initialize_fn_name d = qual_devname d [ "initialize" ]
|
|
|
|
device_print_fn_name :: Dev.Rec -> String
|
|
device_print_fn_name d = qual_devname d [ "pr" ]
|
|
|
|
device_prefix_macro_name :: Dev.Rec -> String
|
|
device_prefix_macro_name d = qual_devname d ["PREFIX"]
|
|
|
|
device_initial_enum_name :: Dev.Rec -> String
|
|
device_initial_enum_name d = qual_devname d ["initials"]
|
|
|
|
--
|
|
-- Space-related names
|
|
--
|
|
space_read_fn_name :: Space.Rec -> Integer -> String
|
|
space_read_fn_name s w =
|
|
printf "__DN(%s)" (concat $ intersperse "_" [ Space.n s, "read", show w ])
|
|
|
|
space_write_fn_name :: Space.Rec -> Integer -> String
|
|
space_write_fn_name s w =
|
|
printf "__DN(%s)" (concat $ intersperse "_" [ Space.n s, "write", show w ])
|
|
|
|
space_cpu_reg_read_fn_name :: Space.Rec -> Integer -> String -> String
|
|
space_cpu_reg_read_fn_name s w n =
|
|
printf (concat $ intersperse "_" [ Space.n s, "read", show w, n ])
|
|
|
|
space_cpu_reg_write_fn_name :: Space.Rec -> Integer -> String -> String
|
|
space_cpu_reg_write_fn_name s w n =
|
|
printf (concat $ intersperse "_" [ Space.n s, "write", show w, n ])
|
|
|
|
--
|
|
-- Constants-related names
|
|
--
|
|
constants_c_name :: TT.Rec -> String
|
|
constants_c_name c = qual_typerec c ["t"]
|
|
|
|
constants_elem_c_name :: TT.Val -> String
|
|
constants_elem_c_name v = qual_device (TT.ctype v) [ TT.cname v ]
|
|
|
|
constants_print_fn_name :: TN.Name -> String
|
|
constants_print_fn_name c = qual_typename c ["prtval"]
|
|
|
|
constants_describe_fn_name :: TT.Rec -> String
|
|
constants_describe_fn_name c = qual_typerec c ["describe" ]
|
|
|
|
--
|
|
-- Register and datatype-related names
|
|
--
|
|
regtype_c_name :: TT.Rec -> String
|
|
regtype_c_name rt
|
|
| TT.is_builtin rt = (TN.typeName $ TT.tt_name rt) ++ "_t"
|
|
| otherwise = qual_typerec rt ["t"]
|
|
|
|
regtype_initial_macro_name :: TT.Rec -> String
|
|
regtype_initial_macro_name rt = qual_typerec rt ["default"]
|
|
|
|
regtype_extract_fn_name :: TT.Rec -> Fields.Rec -> String
|
|
regtype_extract_fn_name rt f = qual_typerec rt [ Fields.name f, "extract" ]
|
|
|
|
regtype_insert_fn_name :: TT.Rec -> Fields.Rec -> String
|
|
regtype_insert_fn_name rt f = qual_typerec rt [ Fields.name f, "insert" ]
|
|
|
|
regtype_print_fn_name :: TT.Rec -> String
|
|
regtype_print_fn_name rt = qual_typerec rt [ "prtval"]
|
|
|
|
datatype_array_c_name :: TT.Rec -> String
|
|
datatype_array_c_name rt = qual_typerec rt [ "array", "t"]
|
|
|
|
datatype_size_macro_name :: TT.Rec -> String
|
|
datatype_size_macro_name rt = qual_typerec rt ["size"]
|
|
|
|
--
|
|
-- Register- and register array-related names
|
|
--
|
|
register_initial_name :: RT.Rec -> String
|
|
register_initial_name r = qual_register r [ "initial" ]
|
|
|
|
register_read_fn_name :: RT.Rec -> String
|
|
register_read_fn_name r = qual_register r ["rd"]
|
|
|
|
register_write_fn_name :: RT.Rec -> String
|
|
register_write_fn_name r = qual_register r ["wr"]
|
|
|
|
register_rawread_fn_name :: RT.Rec -> String
|
|
register_rawread_fn_name r = qual_register r ["rawrd"]
|
|
|
|
register_rawwrite_fn_name :: RT.Rec -> String
|
|
register_rawwrite_fn_name r = qual_register r ["rawwr"]
|
|
|
|
register_shadow_name :: RT.Rec -> String
|
|
register_shadow_name r = qual_register r ["shadow"]
|
|
|
|
register_c_name :: RT.Rec -> String
|
|
register_c_name r = regtype_c_name $ RT.tpe r
|
|
|
|
field_c_name :: Fields.Rec -> String
|
|
field_c_name f =
|
|
case Fields.tpe f of
|
|
Nothing -> round_field_size $ Fields.size f
|
|
Just t -> qual_typename t ["t"]
|
|
|
|
register_print_fn_name :: RT.Rec -> String
|
|
register_print_fn_name rt = qual_register rt ["pr"]
|
|
|
|
register_read_field_fn_name :: RT.Rec -> Fields.Rec -> String
|
|
register_read_field_fn_name r f = qual_register r [ Fields.name f, "rdf"]
|
|
|
|
register_read_field_from_shadow_fn_name :: RT.Rec -> Fields.Rec -> String
|
|
register_read_field_from_shadow_fn_name r f =
|
|
qual_register r [Fields.name f, "rd", "shadow"]
|
|
|
|
register_write_field_fn_name :: RT.Rec -> Fields.Rec -> String
|
|
register_write_field_fn_name r f = qual_register r [ Fields.name f, "wrf"]
|
|
|
|
regarray_length_macro_name :: RT.Rec -> String
|
|
regarray_length_macro_name r = qual_register r [ "length" ]
|
|
|
|
regarray_print_fn_name :: RT.Rec -> String
|
|
regarray_print_fn_name rt = qual_register rt ["pri"]
|
|
|
|
-------------------------------------------------------------------------
|
|
-- Convenience functions for generating the C mapping
|
|
-------------------------------------------------------------------------
|
|
|
|
--
|
|
-- Given a field width in bits, return the C type of the smallest
|
|
-- possible unsigned integer capable of holding it.
|
|
--
|
|
round_field_size w
|
|
| w <= 8 = "uint8_t"
|
|
| ( w > 8 && w <= 16 ) = "uint16_t"
|
|
| ( w > 16 && w <= 32 ) = "uint32_t"
|
|
| otherwise = "uint64_t"
|
|
|
|
--
|
|
-- Take a list of scope names and translate to a C identifier.
|
|
--
|
|
|
|
qual_devname :: Dev.Rec -> [ String ] -> String
|
|
qual_devname d l =
|
|
concat $ intersperse "_" ([Dev.name d] ++ l)
|
|
|
|
qual_device :: TN.Name -> [ String ] -> String
|
|
qual_device t l =
|
|
concat $ intersperse "_" ([TN.devName t] ++ l)
|
|
|
|
qual_typename :: TN.Name -> [ String ] -> String
|
|
qual_typename (TN.Name dn tn) l = concat $ intersperse "_" ([dn, tn] ++ l)
|
|
|
|
qual_typerec :: TT.Rec -> [ String ] -> String
|
|
qual_typerec t l = qual_typename (TT.tt_name t) l
|
|
|
|
qual_register :: RT.Rec -> [ String ] -> String
|
|
qual_register r l = qual_device (RT.typename r) ([RT.name r] ++ l)
|
|
|
|
--
|
|
-- Generate a simple automatic variable declaration with optional initializer.
|
|
--
|
|
simple_var :: String -> String -> Maybe C.Expr -> C.Stmt
|
|
simple_var t n e
|
|
= C.VarDecl C.NoScope C.NonConst (C.TypeName t) n e
|
|
|
|
--
|
|
-- Generate a simple for loop with i = 0 to something.
|
|
--
|
|
simple_for :: C.Expr -> [ C.Stmt ] -> C.Stmt
|
|
simple_for end body
|
|
= C.For (C.Assignment (C.Variable cv_i) (C.NumConstant 0))
|
|
(C.Binary C.LessThan (C.Variable cv_i) end)
|
|
(C.PostInc (C.Variable cv_i))
|
|
body
|
|
|
|
--
|
|
-- Given a field width in bits, return the C snprintf format
|
|
-- specifying to correctly format it.
|
|
--
|
|
field_fmt_str size
|
|
| size <= 8 = "PRIx8"
|
|
| size <= 16 = "PRIx16"
|
|
| size <= 32 = "PRIx32"
|
|
| otherwise = "PRIx64"
|
|
|
|
--
|
|
-- Percent-escape a string so it can be used in a format to snprintf.
|
|
--
|
|
percent_escape :: String -> String
|
|
percent_escape s
|
|
= concat [ if c == '%' then "%%" else [c] | c <- s ]
|
|
|
|
|
|
--
|
|
-- Define a static inline function which looks like an snprintf in its
|
|
-- calling conventions, and maintains its internal buffer variables
|
|
-- accordingly.
|
|
--
|
|
snprintf_like_defn :: String -> [ C.Param ] -> [ C.Stmt ] -> C.Unit
|
|
snprintf_like_defn name extra_args main_body =
|
|
C.StaticInline (C.TypeName "int") name args body
|
|
where args = [ C.Param (C.Ptr $ C.TypeName "char") cv_s,
|
|
C.Param (C.TypeName "size_t") cv_size ] ++ extra_args
|
|
body = [ simple_var "int" cv_r (Just $ C.NumConstant 0),
|
|
simple_var "int" cv_avail Nothing,
|
|
simple_var "int" cv_rc Nothing ]
|
|
++
|
|
main_body
|
|
++
|
|
[ C.Return $ C.Variable cv_r ]
|
|
|
|
--
|
|
-- Wrap a call to a function which acts like snprintf (i.e. takes a
|
|
-- buffer, and a size, and tries to fit the output into the buffer).
|
|
-- The code generated here can be safely nested inside another
|
|
-- snprintf-like function as long as the variable names 'avail',
|
|
-- 'size', 'r', and 'rc' are declared.
|
|
--
|
|
snprintf_like_call :: String -> [C.Expr] -> C.Stmt
|
|
snprintf_like_call n a =
|
|
C.StmtList [ C.Ex $ C.Assignment (C.Variable cv_avail) $
|
|
C.Ternary
|
|
(C.Binary C.GreaterThan
|
|
(C.Variable cv_r)
|
|
(C.Variable cv_size))
|
|
(C.NumConstant 0)
|
|
(C.Binary C.Minus
|
|
(C.Variable cv_size)
|
|
(C.Variable cv_r)),
|
|
C.Ex $ C.Assignment
|
|
(C.Variable cv_rc)
|
|
(C.Call n ([ C.Binary C.Plus
|
|
(C.Variable cv_s)
|
|
(C.Variable cv_r),
|
|
C.Variable cv_avail
|
|
] ++ a)),
|
|
C.If
|
|
(C.Binary C.And
|
|
(C.Binary C.GreaterThan
|
|
(C.Variable cv_rc)
|
|
(C.NumConstant 0))
|
|
(C.Binary C.LessThan
|
|
(C.Variable cv_rc)
|
|
(C.Variable cv_avail)))
|
|
[ C.Ex $ C.Assignment (C.Variable cv_r)
|
|
(C.Binary C.Plus
|
|
(C.Variable cv_r)
|
|
(C.Variable cv_rc)) ]
|
|
[]
|
|
]
|
|
|
|
snputs_like_call :: String -> C.Stmt
|
|
snputs_like_call s = snprintf_like_call "snprintf" [ C.StringConstant $ percent_escape s ]
|
|
|
|
--
|
|
-- Functions to generate masks to select or deselect a subfield of bits
|
|
--
|
|
select_mask :: (Num a, Bits a) => Integer -> Integer -> Integer -> a
|
|
select_mask word_size start width =
|
|
foldl setBit 0 (enumFromTo (fromInteger $ start)
|
|
(fromInteger $ start + width - 1))
|
|
|
|
deselect_mask :: (Num a, Bits a) => Integer -> Integer -> Integer -> a
|
|
deselect_mask word_size start width =
|
|
foldl complementBit (select_mask word_size start width)
|
|
(enumFromTo 0 (fromInteger word_size - 1))
|
|
|
|
--
|
|
-- Functions to generate the builtin Mackerel access functions
|
|
--
|
|
mackerel_read_fn_name :: String -> Integer -> String
|
|
mackerel_read_fn_name typename size =
|
|
printf "mackerel_read_%s_%s" typename (show size)
|
|
|
|
mackerel_write_fn_name :: String -> Integer -> String
|
|
mackerel_write_fn_name typename size =
|
|
printf "mackerel_write_%s_%s" typename (show size)
|
|
|
|
|
|
--
|
|
-- Generate a string describing a register field
|
|
--
|
|
field_dump :: Fields.Rec -> String
|
|
field_dump f
|
|
= printf " %s\t(size %d, offset %d, init %x):\t%s\t%s"
|
|
(Fields.name f)
|
|
(Fields.size f)
|
|
(Fields.offset f)
|
|
(Fields.initial f)
|
|
(show $ Fields.attr f)
|
|
(Fields.desc f )
|
|
|
|
-- translation function mapped to every argument, for generic conversion
|
|
-- (eg. types or names) before rendering those arguments in C code
|
|
|
|
convert_arg (Arg "addr" x) = Arg "mackerel_addr_t" x
|
|
convert_arg (Arg "pci" x) = Arg "mackerel_pci_t" x
|
|
convert_arg (Arg "io" x) = Arg "mackerel_io_t" x
|
|
|
|
|
|
-------------------------------------------------------------------------
|
|
-- Top-level header file rendering code
|
|
-------------------------------------------------------------------------
|
|
|
|
-- Top-level create-a-header-file
|
|
compile :: String -> String -> Dev.Rec -> String
|
|
compile infile outfile dev =
|
|
unlines $ C.pp_unit $ device_header_file dev infile
|
|
|
|
device_header_file_string :: Dev.Rec -> String -> String
|
|
device_header_file_string d hdr
|
|
= unlines $ C.pp_unit $ device_header_file d hdr
|
|
|
|
device_header_file :: Dev.Rec -> String -> C.Unit
|
|
device_header_file d hdr =
|
|
let sym = "__" ++ (Dev.name d) ++ "_DEV_H"
|
|
in
|
|
C.IfNDef sym ([ C.Define sym [] "1"] ++ (device_def d hdr)) []
|
|
|
|
-- Body of the generated file
|
|
device_def :: Dev.Rec -> String -> [ C.Unit ]
|
|
device_def dev header =
|
|
( [device_preamble dev]
|
|
++
|
|
std_header_files dev
|
|
++
|
|
device_prefix_defs dev
|
|
++
|
|
concat [ constants_decl d
|
|
| d@(TT.ConstType {}) <- Dev.types dev]
|
|
++
|
|
concat [ regtype_decl d
|
|
| d@(TT.RegFormat {}) <- Dev.types dev ]
|
|
++
|
|
concat [ datatype_decl d
|
|
| d@(TT.DataFormat {}) <- Dev.types dev]
|
|
++
|
|
(device_struct_def dev)
|
|
++
|
|
(device_initial_values dev)
|
|
++
|
|
(device_initialize_fn dev)
|
|
++
|
|
-- Not currently implemented in command line opts
|
|
-- (device_space_includes dev header)
|
|
-- ++
|
|
concat [ register_decl d | d <- (Dev.registers dev) ]
|
|
++
|
|
[(device_print_fn dev)]
|
|
++
|
|
(device_prefix_undefs dev)
|
|
)
|
|
|
|
device_preamble :: Dev.Rec -> C.Unit
|
|
device_preamble dev =
|
|
C.MultiComment [
|
|
"DEVICE DEFINITION: " ++ (Dev.desc dev),
|
|
"",
|
|
"Copyright (c) 2010, 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.",
|
|
"",
|
|
"THIS FILE IS AUTOMATICALLY GENERATED BY MACKEREL: DO NOT EDIT!" ]
|
|
|
|
device_c_type :: C.TypeSpec
|
|
device_c_type = C.TypeName device_c_name
|
|
|
|
-- Undefine macros used by the header file
|
|
device_prefix_undefs :: Dev.Rec -> [ C.Unit ]
|
|
device_prefix_undefs d = [ C.Undef "__DN" ]
|
|
|
|
-- Define macros used by the header file
|
|
device_prefix_defs :: Dev.Rec -> [ C.Unit ]
|
|
device_prefix_defs d =
|
|
let name = Dev.name d
|
|
prefix = device_prefix_macro_name d
|
|
in
|
|
(device_prefix_undefs d)
|
|
++
|
|
[ C.Define "__DN" ["x"] (name ++ " ## _ ## x") ]
|
|
|
|
-- Header files info
|
|
std_header_files :: Dev.Rec -> [ C.Unit ]
|
|
std_header_files dev =
|
|
map (C.Include C.Standard) inclist
|
|
where
|
|
inclist = [ "mackerel/mackerel.h", "inttypes.h" ]
|
|
++
|
|
[ i ++ "_dev.h" | i <- Dev.imports dev ]
|
|
|
|
-- Device representation structure generator
|
|
device_struct_def :: Dev.Rec -> [ C.Unit ]
|
|
device_struct_def d
|
|
= [ C.MultiComment ["Device representation structure"],
|
|
C.StructDecl device_c_name params,
|
|
C.TypeDef (C.Struct device_c_name) device_c_name ]
|
|
where
|
|
params = [ C.Param (C.TypeName n) v
|
|
| Arg n v <- map convert_arg (Dev.args d) ]
|
|
++
|
|
[ device_struct_shadow_field r
|
|
| r <- RT.get_shadow_registers $ Dev.registers d ]
|
|
|
|
device_struct_shadow_field :: RT.Rec -> C.Param
|
|
device_struct_shadow_field rt =
|
|
let t = if RT.is_array rt then
|
|
C.Array (RT.num_elements rt) (regtype_c_type $ RT.tpe rt)
|
|
else
|
|
regtype_c_type $ RT.tpe rt
|
|
in
|
|
C.Param t (device_shadow_field_name rt)
|
|
|
|
device_initial_values :: Dev.Rec -> [ C.Unit ]
|
|
device_initial_values d@( Dev.Rec{ Dev.registers = [] } )
|
|
= [ C.Blank, C.Comment "No registers in this device", C.Blank ]
|
|
device_initial_values d
|
|
= [ C.Blank,
|
|
C.MultiComment ["Initial register values (currently 0)"],
|
|
C.EnumDecl (device_initial_enum_name d)
|
|
[ C.EnumItem (register_initial_name r) (Just $ C.HexConstant $ 0)
|
|
| r <- (Dev.registers d) ],
|
|
C.Blank ]
|
|
|
|
device_initialize_field :: RT.Rec -> C.Stmt
|
|
device_initialize_field rt
|
|
= let val = C.Variable $ register_initial_name rt
|
|
in
|
|
if RT.is_array rt then
|
|
C.Block [ simple_var "int" cv_i Nothing,
|
|
simple_for (C.NumConstant $ RT.num_elements rt)
|
|
[ C.Ex $ C.Assignment
|
|
(regarray_shadow_ref rt)
|
|
val
|
|
]
|
|
]
|
|
else
|
|
C.Ex $ C.Assignment (register_shadow_ref rt) val
|
|
|
|
device_initialize_arg :: String -> C.Stmt
|
|
device_initialize_arg v
|
|
= C.Ex $ C.Assignment (C.DerefField (C.Variable cv_dev) v) (C.Variable v)
|
|
|
|
-- Device init function
|
|
device_initialize_fn :: Dev.Rec -> [ C.Unit ]
|
|
device_initialize_fn d =
|
|
[ C.MultiComment [ "Device Initialization function" ],
|
|
C.StaticInline C.Void (device_initialize_fn_name d) params body ]
|
|
where
|
|
args = Dev.args d
|
|
params = [ C.Param (C.Ptr device_c_type) cv_dev ]
|
|
++
|
|
[ C.Param (C.TypeName n) v
|
|
| (Arg n v) <- map convert_arg args ]
|
|
body = [ device_initialize_arg v | (Arg _ v) <- args ]
|
|
-- XXX: Shadow copy initialization broken
|
|
-- ++
|
|
-- [ device_initialize_field rt
|
|
-- | rt <- RT.get_shadow_registers $ Dev.registers d ]
|
|
|
|
device_print_fn :: Dev.Rec -> C.Unit
|
|
device_print_fn d =
|
|
snprintf_like_defn (device_print_fn_name d) args body
|
|
where args = [ C.Param (C.Ptr device_c_type) cv_dev ]
|
|
body = [ snputs_like_call "-------------------------\n",
|
|
snputs_like_call (printf "Dump of device %s (%s):\n"
|
|
(Dev.name d) (percent_escape (Dev.desc d)))
|
|
]
|
|
++
|
|
[ device_print_eachreg r | r <- (Dev.registers d)]
|
|
++
|
|
[ snputs_like_call (printf "End of dump of device %s\n"
|
|
(Dev.name d) ),
|
|
snputs_like_call "-------------------------\n"
|
|
]
|
|
|
|
device_print_eachreg r =
|
|
snprintf_like_call (register_print_fn_name r) [ C.Variable cv_dev ]
|
|
|
|
-- XXX: This needs more thorough examination. I don't know how the
|
|
-- commandline is interacting with device spaces. Currently, when
|
|
-- there are no device spaces defined, the commandline is ignored.
|
|
device_space_includes :: Dev.Rec -> String -> [ C.Unit ]
|
|
device_space_includes d header
|
|
| all Space.is_builtin (Dev.spaces d) =
|
|
[ C.MultiComment [ "No user-defined spaces" ] ]
|
|
| header /= "" =
|
|
[ C.MultiComment [ "Space access include overridden by cmd line:"],
|
|
C.Include C.Local header ]
|
|
| otherwise =
|
|
[ C.MultiComment [ "Include access functions for user-defined spaces"],
|
|
C.Include C.Local $ printf "%s_spaces.h" (Dev.name d) ]
|
|
|
|
-------------------------------------------------------------------------
|
|
-- Render 'constants' declarations
|
|
-------------------------------------------------------------------------
|
|
|
|
--
|
|
-- Everything we need for a constants definition
|
|
--
|
|
|
|
constants_decl :: TT.Rec -> [ C.Unit ]
|
|
constants_decl c =
|
|
[ constants_comment c,
|
|
constants_typedef c ] ++
|
|
( constants_enum c ) ++
|
|
[ C.Blank,
|
|
constants_describe_fn c,
|
|
constants_print_fn c ]
|
|
|
|
constants_c_type :: TT.Rec -> C.TypeSpec
|
|
constants_c_type c = C.TypeName $ constants_c_name c
|
|
|
|
constants_comment :: TT.Rec -> C.Unit
|
|
constants_comment c =
|
|
C.MultiComment [ printf "Constants defn: %s (%s)" (TN.toString $ TT.tt_name c) (TT.tt_desc c),
|
|
case TT.tt_width c of
|
|
Nothing -> " - no width specified"
|
|
Just w -> printf " - width %d bits" w ]
|
|
|
|
constants_enum :: TT.Rec -> [ C.Unit ]
|
|
constants_enum c =
|
|
[ C.Define (constants_elem_c_name v) [] (constants_eval c v) | v <- TT.tt_vals c ]
|
|
|
|
constants_typedef :: TT.Rec -> C.Unit
|
|
constants_typedef c =
|
|
C.TypeDef (C.TypeName $ round_field_size $ TT.tt_size c) (constants_c_name c)
|
|
|
|
constants_eval :: TT.Rec -> TT.Val -> String
|
|
constants_eval c v =
|
|
printf "((%s)%s)" (constants_c_name c) (case TT.cval v of
|
|
ExprConstant (-1) -> "(-1LL)"
|
|
ExprConstant i -> printf "0x%x" i
|
|
)
|
|
|
|
constants_print_fn :: TT.Rec -> C.Unit
|
|
constants_print_fn c =
|
|
C.StaticInline (C.TypeName "int") (constants_print_fn_name $ TT.tt_name c)
|
|
[ C.Param (C.Ptr $ C.TypeName "char") cv_s,
|
|
C.Param (C.TypeName "size_t") cv_size,
|
|
C.Param (constants_c_type c) cv_e ]
|
|
[ C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.TypeName "char") "d"
|
|
(Just $ C.Call (constants_describe_fn_name c) [ C.Variable cv_e ]),
|
|
C.If (C.Variable "d")
|
|
[ C.Return $ C.Call "snprintf"
|
|
[ C.Variable cv_s,
|
|
C.Variable cv_size,
|
|
C.StringConstant "%s",
|
|
C.Variable "d"
|
|
]
|
|
]
|
|
[ C.Return $ C.Call "snprintf"
|
|
[ C.Variable cv_s,
|
|
C.Variable cv_size,
|
|
C.StringCat [ C.QStr "Unknown constant %s value 0x%",
|
|
C.NStr "PRIx64" ],
|
|
C.StringConstant (constants_c_name c),
|
|
C.Cast (C.TypeName "uint64_t") (C.Variable cv_e)
|
|
]
|
|
]
|
|
]
|
|
|
|
constants_describe_fn :: TT.Rec -> C.Unit
|
|
constants_describe_fn c =
|
|
let
|
|
rep v = C.StringConstant $ printf "%s: %s" (TT.cname v) (TT.cdesc v)
|
|
in
|
|
C.StaticInline (C.Ptr $ C.TypeName "char") (constants_describe_fn_name c)
|
|
[ C.Param (constants_c_type c) cv_e ]
|
|
[ C.Switch (C.Variable cv_e)
|
|
[ C.Case (C.Variable $ constants_elem_c_name v)
|
|
[ C.Return $ rep v ]
|
|
| v <- TT.tt_vals c ]
|
|
[ C.Return $ C.Variable "NULL" ]
|
|
]
|
|
|
|
|
|
-------------------------------------------------------------------------
|
|
-- Render register type definitions
|
|
-------------------------------------------------------------------------
|
|
|
|
regtype_c_type :: TT.Rec -> C.TypeSpec
|
|
regtype_c_type rt = C.TypeName $ regtype_c_name rt
|
|
|
|
--
|
|
-- All the generated declarations for a register type.
|
|
--
|
|
regtype_decl :: TT.Rec -> [ C.Unit ]
|
|
regtype_decl rt =
|
|
[ regtype_dump rt,
|
|
regtype_typedef rt,
|
|
regtype_initial_macro rt
|
|
]
|
|
++
|
|
(regtype_access_fns rt)
|
|
++
|
|
[
|
|
regtype_print_fn rt
|
|
]
|
|
|
|
|
|
--
|
|
-- Emit a comment describing the register type.
|
|
--
|
|
regtype_dump :: TT.Rec -> C.Unit
|
|
regtype_dump rt =
|
|
C.MultiComment ([ (TT.type_kind rt) ++ " type: " ++ (regtype_c_name rt),
|
|
"Description: " ++ (TT.tt_desc rt),
|
|
"Fields:"
|
|
]
|
|
++
|
|
[ field_dump f | f <- TT.fields rt ])
|
|
--
|
|
-- Calculate an appropriate built-in type for a mackerel type
|
|
--
|
|
regtype_c_builtin :: TT.Rec -> C.TypeSpec
|
|
regtype_c_builtin rt = C.TypeName $ round_field_size $ TT.tt_size rt
|
|
|
|
--
|
|
-- Define the register type to be an unsigned integer of appropriate size
|
|
--
|
|
regtype_typedef :: TT.Rec -> C.Unit
|
|
regtype_typedef rt =
|
|
C.TypeDef
|
|
(regtype_c_builtin rt)
|
|
(regtype_c_name rt)
|
|
|
|
--
|
|
-- Emit macro for initial register value
|
|
--
|
|
|
|
regtype_initial_macro :: TT.Rec -> C.Unit
|
|
regtype_initial_macro rt =
|
|
C.Define sym [] (C.pp_expr $ C.HexConstant val)
|
|
where
|
|
sym = regtype_initial_macro_name rt
|
|
fields = TT.fields rt
|
|
val = foldl (.|.) 0 [ Fields.initial_mask f | f <- fields ]
|
|
|
|
--
|
|
-- Emit functions to extract and insert each field from a value of
|
|
-- register contents.
|
|
--
|
|
regtype_access_fns :: TT.Rec -> [ C.Unit ]
|
|
regtype_access_fns rt =
|
|
concat [ [ regtype_field_extract_fn rt f,
|
|
regtype_field_insert_fn rt f ]
|
|
| f <- TT.fields rt, not $ Fields.is_anon f ]
|
|
|
|
--
|
|
-- Return the C type name for a field or a register
|
|
--
|
|
|
|
field_c_type :: Fields.Rec -> C.TypeSpec
|
|
field_c_type f = C.TypeName $ field_c_name f
|
|
|
|
--
|
|
-- Emit a function to extract a field from a register type value
|
|
--
|
|
|
|
regtype_field_extract_fn :: TT.Rec -> Fields.Rec -> C.Unit
|
|
regtype_field_extract_fn rt f =
|
|
let t = field_c_type f
|
|
n = regtype_extract_fn_name rt f
|
|
sz = TT.tt_size rt
|
|
arg = C.Param (regtype_c_type rt) cv_regval
|
|
-- ( r & (Fields.extract_mask f) ) >> (Fields.extract_shift f)
|
|
body = C.Return $
|
|
C.Cast t (C.Binary C.RightShift
|
|
(C.Binary C.BitwiseAnd
|
|
(C.Variable cv_regval)
|
|
(C.HexConstant $ Fields.extract_mask f sz))
|
|
(C.NumConstant $ Fields.offset f))
|
|
in
|
|
C.StaticInline t n [ arg ] [ body ]
|
|
|
|
--
|
|
-- Emit a function to insert a field value into a register type value
|
|
--
|
|
regtype_field_insert_fn :: TT.Rec -> Fields.Rec -> C.Unit
|
|
regtype_field_insert_fn rt f =
|
|
let t = field_c_type f
|
|
n = regtype_insert_fn_name rt f
|
|
rtn = regtype_c_type rt
|
|
sz = TT.tt_size rt
|
|
arg1 = C.Param rtn cv_regval
|
|
arg2 = C.Param t cv_fieldval
|
|
-- return (r & Fields.insert_mask f) | ((rtn)v << (Fields.offset f) & (Fields.insert_mask f))
|
|
-- Note that we cast the field type to the register type, to
|
|
-- ensure that it's large enough when we do the shift
|
|
body = C.Return $
|
|
C.Binary C.BitwiseOr
|
|
(C.Binary C.BitwiseAnd
|
|
(C.Variable cv_regval)
|
|
(C.HexConstant $ Fields.insert_mask f sz) )
|
|
(C.Binary C.BitwiseAnd
|
|
(C.HexConstant $ Fields.extract_mask f sz)
|
|
(C.Binary C.LeftShift
|
|
(C.Cast rtn (C.Variable cv_fieldval))
|
|
(C.NumConstant $ Fields.offset f)))
|
|
in
|
|
C.StaticInline rtn n [ arg1, arg2 ] [ body ]
|
|
|
|
--
|
|
-- Print out a value of the register or data type
|
|
--
|
|
regtype_print_fn :: TT.Rec -> C.Unit
|
|
regtype_print_fn rt =
|
|
snprintf_like_defn (regtype_print_fn_name rt) args body
|
|
where
|
|
fields = TT.fields rt
|
|
args = [ C.Param (regtype_c_type rt) cv_regval ]
|
|
body = [ field_print_block rt f | f <- fields, not $ Fields.is_anon f ]
|
|
|
|
--
|
|
-- Return a statement (or list) which will correctly format a register
|
|
-- field as part of a larger snprintf-like function.
|
|
--
|
|
field_print_block :: TT.Rec -> Fields.Rec -> C.Stmt
|
|
field_print_block _ f@(Fields.Rec { Fields.is_anon = True }) =
|
|
C.SComment ((Fields.name f) ++ " is anonymous")
|
|
field_print_block rt f =
|
|
case Fields.tpe f of
|
|
Nothing ->
|
|
let fmt = C.StringCat [ C.QStr $ printf " %s =\t%%" (Fields.name f),
|
|
C.NStr (field_fmt_str $ Fields.size f),
|
|
C.QStr $ printf "\t(%s)\n" (percent_escape $ Fields.desc f) ]
|
|
val = C.Call (regtype_extract_fn_name rt f)
|
|
[ C.Variable cv_regval ]
|
|
in
|
|
snprintf_like_call "snprintf" [fmt, val]
|
|
Just t ->
|
|
C.StmtList [snputs_like_call $ printf " %s =\t" (Fields.name f),
|
|
snprintf_like_call (constants_print_fn_name t)
|
|
[ C.Call (regtype_extract_fn_name rt f) [(C.Variable cv_regval)] ],
|
|
snputs_like_call $ printf "\t(%s)\n" (Fields.desc f)
|
|
]
|
|
|
|
-------------------------------------------------------------------------
|
|
-- Render data type definitions
|
|
-------------------------------------------------------------------------
|
|
|
|
datatype_decl :: TT.Rec -> [ C.Unit ]
|
|
datatype_decl dt =
|
|
[ regtype_dump dt,
|
|
datatype_typedef dt,
|
|
datatype_array_typedef dt,
|
|
datatype_size_macro dt
|
|
]
|
|
++ datatype_access_fns dt
|
|
++ [ regtype_print_fn dt ]
|
|
|
|
|
|
datatype_typedef :: TT.Rec -> C.Unit
|
|
datatype_typedef dt =
|
|
C.TypeDef (C.Ptr $ C.TypeName "uint8_t") (regtype_c_name dt)
|
|
|
|
datatype_array_typedef :: TT.Rec -> C.Unit
|
|
datatype_array_typedef dt =
|
|
let sz = ((TT.tt_size dt) + 7) `div` 8
|
|
in
|
|
C.TypeDef (C.Array sz $ C.TypeName "uint8_t") (datatype_array_c_name dt)
|
|
|
|
datatype_size_macro :: TT.Rec -> C.Unit
|
|
datatype_size_macro dt =
|
|
C.GVarDecl C.Static C.Const (C.TypeName "size_t")
|
|
(datatype_size_macro_name dt)
|
|
(Just $ C.SizeOfT $ C.TypeName $ datatype_array_c_name dt)
|
|
|
|
datatype_field_load_size :: Fields.Rec -> Integer
|
|
datatype_field_load_size Fields.Rec {Fields.offset=o, Fields.size=s}
|
|
| s + (o `mod` 8) <= 8 = 8
|
|
| s + (o `mod` 16) <= 16 = 16
|
|
| s + (o `mod` 32) <= 32 = 32
|
|
| s + (o `mod` 64) <= 64 = 64
|
|
| otherwise = 0
|
|
|
|
--
|
|
-- Emit functions to extract and insert each field from a value of
|
|
-- register contents.
|
|
--
|
|
datatype_access_fns :: TT.Rec -> [ C.Unit ]
|
|
datatype_access_fns rt =
|
|
concat [ [ datatype_field_extract_fn rt f,
|
|
datatype_field_insert_fn rt f ]
|
|
| f <- TT.fields rt, not $ Fields.is_anon f ]
|
|
|
|
--
|
|
-- Emit a function to extract a field from a data type value
|
|
--
|
|
datatype_field_extract_fn :: TT.Rec -> Fields.Rec -> C.Unit
|
|
datatype_field_extract_fn rt f =
|
|
let t = field_c_type f
|
|
n = regtype_extract_fn_name rt f
|
|
arg = C.Param (regtype_c_type rt) cv_dtptr
|
|
load_size = datatype_field_load_size f
|
|
bits_offset = (Fields.offset f) `mod` load_size
|
|
word_offset = ((Fields.offset f) - bits_offset) `div` 8
|
|
mask = select_mask load_size bits_offset (Fields.size f)
|
|
load_c_type = C.TypeName $ round_field_size load_size
|
|
-- ( r & (Fields.extract_mask f) ) >> (Fields.extract_shift f)
|
|
body = C.Return $
|
|
C.Binary C.RightShift
|
|
(C.Binary C.BitwiseAnd
|
|
(C.DerefPtr
|
|
(C.Cast
|
|
(C.Ptr load_c_type)
|
|
(C.Binary C.Plus
|
|
(C.NumConstant word_offset)
|
|
(C.Variable cv_dtptr))))
|
|
(C.HexConstant $ mask))
|
|
(C.NumConstant $ bits_offset)
|
|
in
|
|
C.StaticInline t n [ arg ] [ body ]
|
|
|
|
--
|
|
-- Emit a function to insert a field value into a data type value
|
|
--
|
|
datatype_field_insert_fn :: TT.Rec -> Fields.Rec -> C.Unit
|
|
datatype_field_insert_fn rt f =
|
|
let t = field_c_type f
|
|
n = regtype_insert_fn_name rt f
|
|
rtn = C.TypeName $ round_field_size $ TT.wordsize rt
|
|
arg1 = C.Param (regtype_c_type rt) cv_dtptr
|
|
arg2 = C.Param t cv_fieldval
|
|
load_size = datatype_field_load_size f
|
|
bits_offset = (Fields.offset f) `mod` load_size
|
|
word_offset = ((Fields.offset f) - bits_offset) `div` 8
|
|
smask = select_mask load_size bits_offset (Fields.size f)
|
|
dmask = deselect_mask load_size bits_offset (Fields.size f)
|
|
load_c_type = C.TypeName $ round_field_size load_size
|
|
load_expr = (C.DerefPtr
|
|
(C.Cast
|
|
(C.Ptr load_c_type)
|
|
(C.Binary C.Plus
|
|
(C.NumConstant word_offset)
|
|
(C.Variable cv_dtptr))))
|
|
|
|
-- return (r & Fields.insert_mask f) | (v << (Fields.offset f) & (Fields.insert_mask f))
|
|
body = C.Ex $
|
|
C.Assignment load_expr
|
|
(C.Binary C.BitwiseOr
|
|
(C.Binary C.BitwiseAnd
|
|
load_expr
|
|
(C.HexConstant dmask))
|
|
(C.Binary C.BitwiseAnd
|
|
(C.HexConstant smask)
|
|
(C.Binary C.LeftShift
|
|
(C.Variable cv_fieldval)
|
|
(C.NumConstant bits_offset)
|
|
))
|
|
)
|
|
in
|
|
C.StaticInline C.Void n [ arg1, arg2 ] [ body ]
|
|
|
|
-------------------------------------------------------------------------
|
|
-- Render register definitions
|
|
-------------------------------------------------------------------------
|
|
|
|
register_c_type :: RT.Rec -> C.TypeSpec
|
|
register_c_type r = C.TypeName $ register_c_name r
|
|
|
|
register_shadow_ref :: RT.Rec -> C.Expr
|
|
register_shadow_ref r =
|
|
let deref = C.DerefField (C.Variable cv_dev) (device_shadow_field_name r)
|
|
in
|
|
if RT.is_array r then
|
|
C.SubscriptOf deref (C.Variable cv_i)
|
|
else
|
|
deref
|
|
|
|
regarray_shadow_ref :: RT.Rec -> C.Expr
|
|
regarray_shadow_ref rt
|
|
= C.SubscriptOf (register_shadow_ref rt) (C.Variable cv_i)
|
|
|
|
--
|
|
-- All the declarations for a given register. Note that all
|
|
-- type-related stuff is handled above here by regtype_*; these
|
|
-- declarations are specific to the register itself.
|
|
--
|
|
register_decl :: RT.Rec -> [ C.Unit ]
|
|
register_decl r = [ register_dump_comment r,
|
|
regarray_length_macro r ]
|
|
++
|
|
( register_rawread_fn r)
|
|
++
|
|
[ register_read_fn r ]
|
|
++
|
|
( register_rawwrite_fn r)
|
|
++
|
|
[
|
|
register_write_fn r
|
|
]
|
|
++
|
|
( register_print_fn r)
|
|
++
|
|
(if not $ TT.is_primitive $ RT.tpe r then
|
|
[ register_read_field_fn r f
|
|
| f <- RT.fl r, attr_user_can_read $ Fields.attr f
|
|
]
|
|
++
|
|
[ register_read_field_from_shadow_fn r f
|
|
| f <- RT.fl r, attr_is_writeonly $ Fields.attr f
|
|
]
|
|
++
|
|
[ register_write_field_fn r f
|
|
| f <- RT.fl r, attr_user_can_write $ Fields.attr f
|
|
]
|
|
else
|
|
[]
|
|
)
|
|
|
|
register_dump_comment :: RT.Rec -> C.Unit
|
|
register_dump_comment r
|
|
= C.MultiComment ([name, typedesc] ++ fields)
|
|
where title = if (RT.is_array r) then " array" else ""
|
|
name = printf "Register%s %s: %s" title (RT.name r) (RT.desc r)
|
|
typedesc = printf "Type: %s (%s)"
|
|
(TN.toString $ RT.typename r)
|
|
(if TT.is_primitive $ RT.tpe r
|
|
then "primitive type"
|
|
else TT.tt_desc $ RT.tpe r)
|
|
fields = if TT.is_primitive $ RT.tpe r
|
|
then []
|
|
else [ field_dump f | f <- RT.fl r ]
|
|
|
|
|
|
--
|
|
-- Return a declaration for the length of a register array.
|
|
--
|
|
regarray_length_macro :: RT.Rec -> C.Unit
|
|
regarray_length_macro r
|
|
| RT.is_array r =
|
|
(C.GVarDecl
|
|
C.Static C.Const (C.TypeName "size_t")
|
|
(regarray_length_macro_name r)
|
|
(Just $ C.NumConstant $ RT.num_elements r))
|
|
| otherwise = C.NoOp
|
|
|
|
--
|
|
-- Do a raw read from a register, if the address is available.
|
|
--
|
|
register_rawread_fn :: RT.Rec -> [ C.Unit ]
|
|
register_rawread_fn r =
|
|
let
|
|
rtn = regtype_c_type $ RT.tpe r
|
|
args = (register_arg_list [] r [])
|
|
n = register_rawread_fn_name r
|
|
raw_type = regtype_c_builtin $ RT.tpe r
|
|
decl = loc_read_decl r raw_type args
|
|
in
|
|
if RT.is_noaddr r then
|
|
[
|
|
C.Comment (printf "%s has no address, user must supply %s"
|
|
(RT.name r) n)
|
|
]
|
|
else
|
|
if RT.is_readable r then
|
|
[
|
|
decl,
|
|
C.StaticInline rtn n args [ C.Return (loc_read r) ]
|
|
]
|
|
else
|
|
[
|
|
C.Comment $ printf "Register %s is not readale" (RT.name r)
|
|
]
|
|
|
|
--
|
|
-- Read from the register, or from a shadow copy if it's not readable.
|
|
--
|
|
register_read_fn :: RT.Rec -> C.Unit
|
|
register_read_fn r =
|
|
let rtn = regtype_c_type $ RT.tpe r
|
|
name = register_read_fn_name r
|
|
args = (register_arg_list [] r [])
|
|
in
|
|
if RT.is_readable r then
|
|
C.StaticInline rtn name args [ C.Return (loc_read r) ]
|
|
else
|
|
C.StaticInline rtn name args [ C.Return (register_shadow_ref r) ]
|
|
|
|
--
|
|
-- Do a write read top a register, if the address is available.
|
|
--
|
|
register_rawwrite_fn :: RT.Rec -> [ C.Unit ]
|
|
register_rawwrite_fn r =
|
|
let
|
|
rtn = regtype_c_type $ RT.tpe r
|
|
args = register_arg_list [] r [ C.Param (regtype_c_type $ RT.tpe r) cv_regval ]
|
|
n = register_rawwrite_fn_name r
|
|
raw_type = (C.TypeName $ round_field_size $ TT.tt_size $ RT.tpe r)
|
|
raw_args = register_arg_list [] r [ C.Param ( regtype_c_builtin $ RT.tpe r) cv_regval ]
|
|
decl = loc_write_decl r raw_type raw_args
|
|
in
|
|
if RT.is_noaddr r then
|
|
[
|
|
C.Comment (printf "%s has no address, user must supply %s"
|
|
(RT.name r) n)
|
|
]
|
|
else
|
|
if RT.is_writeable r then
|
|
[
|
|
decl,
|
|
C.StaticInline C.Void n args [ C.Ex $ loc_write r cv_regval ]
|
|
]
|
|
else
|
|
[
|
|
C.Comment $ printf "Register %s is not writeable" (RT.name r)
|
|
]
|
|
|
|
|
|
--
|
|
-- Write to register. Harder than it sounds.
|
|
--
|
|
-- To do this properly involves:
|
|
|
|
-- 1) Take the value to be written
|
|
-- 2) AND together the MB0 and RSVD fields' insert masks, and AND this with
|
|
-- the value.
|
|
-- 3) OR together the MB1 fields' select masks, and OR this with the
|
|
-- value.
|
|
-- 4) OR together the RSVD fields' select masks. If this is non-zero,
|
|
-- AND this mask with a read from the register, and OR this into the value.
|
|
-- 5) Write this to the register, and to the shadow, if present.
|
|
--
|
|
register_write_fn :: RT.Rec -> C.Unit
|
|
register_write_fn r =
|
|
let name = register_write_fn_name r
|
|
args = register_arg_list [] r [ C.Param (regtype_c_type $ RT.tpe r) cv_regval ]
|
|
fields = RT.fl r
|
|
size = RT.size r
|
|
nomask = 0xffffffffffffffff
|
|
mb0mask :: Integer
|
|
mb0mask = foldl (.&.) nomask [ Fields.insert_mask f size | f <- fields,
|
|
(attr_zero_before_write $ Fields.attr f) ||
|
|
(attr_preserve_on_write $ Fields.attr f) ]
|
|
mb1mask :: Integer
|
|
mb1mask = foldl (.|.) 0 [ Fields.extract_mask f size | f <- fields,
|
|
(attr_set_before_write $ Fields.attr f) ]
|
|
prsvmask :: Integer
|
|
prsvmask = foldl (.|.) 0 [ Fields.extract_mask f size | f <- fields,
|
|
(attr_preserve_on_write $ Fields.attr f) ]
|
|
body = [ (if mb0mask /= nomask then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseAnd
|
|
(C.Variable cv_regval)
|
|
(C.HexConstant mb0mask)))
|
|
else
|
|
C.SComment "No MB0 or RSVD fields present"
|
|
),
|
|
(if mb1mask /= 0 then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseOr
|
|
(C.Variable cv_regval)
|
|
(C.HexConstant mb1mask)))
|
|
else
|
|
C.SComment "No MB1 fields present"
|
|
),
|
|
(if prsvmask /= 0 then
|
|
(if RT.is_readable r then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseOr
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseAnd
|
|
(C.HexConstant prsvmask)
|
|
(loc_read r))))
|
|
else
|
|
C.SComment "No pre-read. Register is write only."
|
|
)
|
|
else
|
|
C.SComment "No pre-read of register required"
|
|
),
|
|
C.Ex $ loc_write r cv_regval
|
|
]
|
|
in
|
|
if RT.is_writeable r then
|
|
C.StaticInline C.Void name args body
|
|
else
|
|
C.Comment $ printf "Register %s is not writeable" (RT.name r)
|
|
|
|
--
|
|
-- Get the arguments right for array- and non-array registers
|
|
--
|
|
register_arg_list :: [C.Param] -> RT.Rec -> [C.Param] -> [C.Param]
|
|
register_arg_list pre r post
|
|
= (pre ++ [ C.Param (C.Ptr device_c_type) cv_dev ]
|
|
++
|
|
(if RT.is_array r then
|
|
[ C.Param (C.TypeName "int") cv_i ]
|
|
else []
|
|
)
|
|
++ post)
|
|
|
|
register_callarg_list :: [C.Param] -> RT.Rec -> [C.Param] -> [C.Param]
|
|
register_callarg_list pre r post
|
|
= (pre ++ [ C.Param (C.Ptr device_c_type) cv_dev ]
|
|
++
|
|
(if RT.is_array r then
|
|
[ C.Param (C.TypeName "int") cv_i ]
|
|
else []
|
|
)
|
|
++ post)
|
|
|
|
--
|
|
-- Generate an expression for a read or write of a register,
|
|
-- regardless of address space or whether it's an array or not.
|
|
--
|
|
loc_read :: RT.Rec -> C.Expr
|
|
loc_read r =
|
|
case RT.spc r of
|
|
Space.NoSpace ->
|
|
C.Call (register_rawread_fn_name r)
|
|
[ C.Variable cv_dev ]
|
|
Space.Builtin { Space.n = name } ->
|
|
C.Call (mackerel_read_fn_name name (RT.size r))
|
|
[ C.DerefField (C.Variable cv_dev) (RT.base r), loc_array_offset r ]
|
|
s@Space.Defined { Space.t = Space.REGISTERWISE } ->
|
|
C.Call (space_cpu_reg_read_fn_name s (RT.size r) (RT.base r))
|
|
[ ]
|
|
s@Space.Defined {} ->
|
|
C.Call (space_read_fn_name s (RT.size r))
|
|
[ C.Variable cv_dev, loc_array_offset r ]
|
|
|
|
loc_read_decl :: RT.Rec -> C.TypeSpec -> [ C.Param ] -> C.Unit
|
|
loc_read_decl r tpe args =
|
|
case RT.spc r of
|
|
-- s@Space.Defined { Space.t = Space.REGISTERWISE } ->
|
|
-- C.FunctionDecl tpe (space_cpu_reg_read_fn_name s (RT.size r) (RT.base r)) (tail args)
|
|
_ -> C.NoOp
|
|
|
|
|
|
loc_write_decl :: RT.Rec -> C.TypeSpec -> [ C.Param ] -> C.Unit
|
|
loc_write_decl r tpe args =
|
|
case RT.spc r of
|
|
-- s@Space.Defined { Space.t = Space.REGISTERWISE } ->
|
|
-- C.FunctionDecl C.Void (space_cpu_reg_write_fn_name s (RT.size r) (RT.base r))
|
|
-- (tail args)
|
|
_ -> C.NoOp
|
|
|
|
loc_write :: RT.Rec -> String -> C.Expr
|
|
loc_write r val =
|
|
case RT.spc r of
|
|
Space.NoSpace ->
|
|
C.Call (register_rawwrite_fn_name r)
|
|
[ C.Variable cv_dev, C.Variable val ]
|
|
Space.Builtin { Space.n = name } ->
|
|
C.Call (mackerel_write_fn_name name (RT.size r))
|
|
[ C.DerefField (C.Variable cv_dev) (RT.base r),
|
|
loc_array_offset r,
|
|
C.Variable val ]
|
|
s@Space.Defined { Space.t = Space.REGISTERWISE} ->
|
|
C.Call (space_cpu_reg_write_fn_name s (RT.size r) (RT.base r))
|
|
[ C.Variable val ]
|
|
s@Space.Defined {} ->
|
|
C.Call (space_write_fn_name s (RT.size r))
|
|
[ C.Variable cv_dev, loc_array_offset r, C.Variable val ]
|
|
|
|
--
|
|
-- Calculate the C expression for an appropriate offset for a register
|
|
-- array element, taking into account whether the address space is
|
|
-- Bytewise or Valuewise, and whether the array is a list or a step
|
|
-- format.
|
|
--
|
|
-- XXX List locations are not well handled right now!
|
|
--
|
|
loc_array_offset :: RT.Rec -> C.Expr
|
|
loc_array_offset r
|
|
= case (Space.t $ RT.spc r, RT.offset r, RT.arr r, RT.size r) of
|
|
(_, off, ArrayListLoc [], _) ->
|
|
C.HexConstant off
|
|
(Space.VALUEWISE, off, ArrayStepLoc _ 0, _) ->
|
|
C.Binary C.Plus (C.HexConstant off) (C.Variable cv_i)
|
|
(Space.BYTEWISE s, off, ArrayStepLoc _ 0, sz) ->
|
|
C.Binary C.Plus
|
|
(C.HexConstant off)
|
|
(C.Binary C.Times
|
|
(C.Variable cv_i)
|
|
(C.Binary C.Divide
|
|
(C.NumConstant (sz `div` s))
|
|
(C.NumConstant 8)))
|
|
(_, off, ArrayStepLoc _ step, _) ->
|
|
C.Binary C.Plus
|
|
(C.HexConstant off)
|
|
(C.Binary C.Times (C.Variable cv_i) (C.NumConstant step))
|
|
(_, _, ArrayListLoc locations, _) ->
|
|
C.StringConstant $ show locations -- Like here for instance.
|
|
|
|
--
|
|
-- Emit a function to extract a field from a register type value
|
|
--
|
|
register_read_field_fn :: RT.Rec -> Fields.Rec -> C.Unit
|
|
register_read_field_fn r f =
|
|
C.StaticInline (field_c_type f) name args body
|
|
where
|
|
args = register_arg_list [] r []
|
|
name = register_read_field_fn_name r f
|
|
extr = regtype_extract_fn_name (RT.tpe r) f
|
|
body = [ register_print_init r,
|
|
C.Return $ C.Call extr [ C.Variable cv_regval ]
|
|
]
|
|
|
|
--
|
|
-- Emit a function to extract a field from a register type value
|
|
--
|
|
register_read_field_from_shadow_fn :: RT.Rec -> Fields.Rec -> C.Unit
|
|
register_read_field_from_shadow_fn r f =
|
|
C.StaticInline (field_c_type f) name args body
|
|
where
|
|
args = register_arg_list [] r []
|
|
name = register_read_field_from_shadow_fn_name r f
|
|
extr = regtype_extract_fn_name (RT.tpe r) f
|
|
body = [ C.Return $ C.Call extr [ register_shadow_ref r ] ]
|
|
|
|
--
|
|
-- Writing a field of a register is complicated. We need:
|
|
-- 0) An initial value consisting of the field value masked/shifted into place
|
|
-- 1) A mask of all field values to read from the register.
|
|
-- 2) A mask of all field values to read from the shadow.
|
|
-- 3) A mask of all field values which must be zeroed.
|
|
-- 4) A mask of all field values which must be one.
|
|
|
|
register_write_field_fn :: RT.Rec -> Fields.Rec -> C.Unit
|
|
register_write_field_fn r f =
|
|
C.StaticInline C.Void name args body
|
|
where
|
|
args = register_arg_list [] r [ C.Param (field_c_type f) cv_fieldval ]
|
|
name = register_write_field_fn_name r f
|
|
fl = delete f $ RT.fl r
|
|
size = RT.size r
|
|
rtn = regtype_c_type $ RT.tpe r
|
|
nomask = 0xffffffffffffffff
|
|
prsvmask :: Integer
|
|
prsvmask = foldl (.|.) 0 [ Fields.extract_mask f' size | f' <- fl,
|
|
(attr_can_init_from_reg $ Fields.attr f') ]
|
|
shadmask :: Integer
|
|
shadmask = foldl (.|.) 0 [ Fields.extract_mask f' size | f' <- fl,
|
|
(attr_is_writeonly $ Fields.attr f') ]
|
|
mb0mask :: Integer
|
|
mb0mask = foldl (.&.) nomask [ Fields.insert_mask f' size | f' <- fl,
|
|
attr_zero_before_write $ Fields.attr f' ]
|
|
mb1mask :: Integer
|
|
mb1mask = foldl (.|.) 0 [ Fields.extract_mask f' size | f' <- fl,
|
|
attr_set_before_write $ Fields.attr f' ]
|
|
body = [ C.VarDecl C.NoScope C.NonConst (register_c_type r) cv_regval
|
|
(Just $ (C.Binary C.BitwiseAnd
|
|
(C.HexConstant $ Fields.extract_mask f size)
|
|
(C.Binary C.LeftShift
|
|
(C.Cast rtn (C.Variable cv_fieldval))
|
|
(C.NumConstant $ Fields.offset f)))),
|
|
(if prsvmask /= 0 then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseOr
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseAnd
|
|
(C.HexConstant prsvmask)
|
|
(loc_read r))))
|
|
else
|
|
C.SComment "No pre-read of register required"
|
|
),
|
|
(if shadmask /= 0 then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseOr
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseAnd
|
|
(C.HexConstant shadmask)
|
|
(register_shadow_ref r))))
|
|
else
|
|
C.SComment "No read of register shadow required"
|
|
),
|
|
(if mb0mask /= nomask then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseAnd
|
|
(C.Variable cv_regval)
|
|
(C.HexConstant mb0mask)))
|
|
else
|
|
C.SComment "No MB0 fields present"
|
|
),
|
|
(if mb1mask /= 0 then
|
|
(C.Ex $ C.Assignment
|
|
(C.Variable cv_regval)
|
|
(C.Binary C.BitwiseOr
|
|
(C.Variable cv_regval)
|
|
(C.HexConstant mb1mask)))
|
|
else
|
|
C.SComment "No MB1 fields present"
|
|
),
|
|
C.Ex $ loc_write r cv_regval,
|
|
(if RT.needs_shadow r then
|
|
C.Ex $ C.Assignment
|
|
(register_shadow_ref r)
|
|
(C.Variable cv_regval)
|
|
else
|
|
C.SComment "No shadow register to write to"
|
|
)
|
|
]
|
|
|
|
-- Print out a value of the register type
|
|
register_print_fn :: RT.Rec -> [ C.Unit ]
|
|
register_print_fn r
|
|
| RT.is_array r =
|
|
[ register_print_array_element r, register_print_array r ]
|
|
| otherwise =
|
|
[ register_print_single r ]
|
|
|
|
register_print_array_element :: RT.Rec -> C.Unit
|
|
register_print_array_element r =
|
|
snprintf_like_defn (regarray_print_fn_name r) args body
|
|
where
|
|
args = [ C.Param (C.Ptr device_c_type) cv_dev,
|
|
C.Param (C.TypeName "int") cv_i ]
|
|
body =
|
|
[ register_print_init r,
|
|
snprintf_like_call "snprintf"
|
|
[ C.StringConstant "Register %s[%d] (%s): ",
|
|
C.StringConstant $ RT.name r,
|
|
C.Variable cv_i,
|
|
C.StringConstant $ RT.desc r ]
|
|
] ++ (register_print_value r)
|
|
|
|
register_print_array :: RT.Rec -> C.Unit
|
|
register_print_array r =
|
|
snprintf_like_defn (register_print_fn_name r) args body
|
|
where
|
|
args = [ C.Param (C.Ptr device_c_type) cv_dev ]
|
|
body = [ simple_var "int" cv_i Nothing,
|
|
simple_for (C.NumConstant $ RT.num_elements r)
|
|
[ snprintf_like_call (regarray_print_fn_name r)
|
|
[ C.Variable cv_dev, C.Variable cv_i ]
|
|
]
|
|
]
|
|
|
|
register_print_single :: RT.Rec -> C.Unit
|
|
register_print_single r =
|
|
snprintf_like_defn (register_print_fn_name r) args body
|
|
where
|
|
args = [ C.Param (C.Ptr device_c_type) cv_dev ]
|
|
body = [ register_print_init r,
|
|
snputs_like_call $ printf
|
|
"Register %s (%s): " (RT.name r) (RT.desc r)
|
|
] ++ register_print_value r
|
|
|
|
register_print_value :: RT.Rec -> [ C.Stmt ]
|
|
register_print_value r =
|
|
case RT.tpe r of
|
|
TT.RegFormat {} -> [ snputs_like_call "\n" ]
|
|
++ [ field_print_block (RT.tpe r) f | f <- (RT.fl r) ]
|
|
TT.DataFormat {} -> [ snputs_like_call "\n" ]
|
|
++ [ field_print_block (RT.tpe r) f | f <- (RT.fl r) ]
|
|
TT.Primitive {} -> [ register_print_primitive r ]
|
|
TT.ConstType {} -> [ register_print_consttype r ]
|
|
|
|
register_print_primitive :: RT.Rec -> C.Stmt
|
|
register_print_primitive r =
|
|
let extra =
|
|
if RT.needs_shadow r then " (SHADOW copy)"
|
|
else ""
|
|
fmt = C.StringCat [ C.QStr "\t%",
|
|
C.NStr $ field_fmt_str $ RT.size r,
|
|
C.QStr (extra ++ "\n") ]
|
|
in snprintf_like_call "snprintf" [ fmt, C.Variable cv_regval ]
|
|
|
|
register_print_consttype :: RT.Rec -> C.Stmt
|
|
register_print_consttype r =
|
|
let extra =
|
|
if RT.needs_shadow r then " (SHADOW copy)"
|
|
else ""
|
|
c = constants_print_fn_name $ TT.tt_name $ RT.tpe r
|
|
in snprintf_like_call c [ C.Variable cv_regval ]
|
|
|
|
register_print_init :: RT.Rec -> C.Stmt
|
|
register_print_init r =
|
|
C.VarDecl C.NoScope C.NonConst (register_c_type r) cv_regval (Just expr)
|
|
where expr =
|
|
if RT.is_readable r then loc_read r
|
|
else register_shadow_ref r
|