Check for using constants with an undefined width specifier.

diff --git a/devices/ia32.dev b/devices/ia32.dev
index 09416eb..8c4747c 100644 (file)
--- a/devices/ia32.dev
+++ b/devices/ia32.dev
@@ -112,11 +112,11 @@ device ia32 lsbfirst () "ia32 / Intel64 core architecture" {
 
     // 14.3.1.3 
     constants mcg_ctl_val width(64) "Global MC control values" {
-       mc_enable       = 0xffffffffffffffff;
+       mc_enable       = 1s;
        mc_disable      = 0x0;
     };
     register mcg_ctl rw msr(0x17b) "Global machine check control" 
-       type(uint64);
+       type(mcg_ctl_val);
 
     // 14.3.2.5
     register mcg_rax rwzc msr(0x180) "State of RAX at MC" type(uint64);

diff --git a/doc/002-mackerel/Mackerel.tex b/doc/002-mackerel/Mackerel.tex
index 94204b0..06cf697 100644 (file)
--- a/doc/002-mackerel/Mackerel.tex
+++ b/doc/002-mackerel/Mackerel.tex
@@ -445,7 +445,7 @@ and a textual description of its meaning.
 The syntax is:
 
 \begin{syntax}
-constants \synit{name} "\synit{description}" \verb+{+ 
+constants \synit{name} [width( \synit{width} )] "\synit{description}" \verb+{+ 
    \synit{name\(\sb{1}\)} = \synit{value\(\sb{1}\)} ["\synit{description\(\sb{1}\)}"] ;
    \ldots
 \verb+}+; 
@@ -457,6 +457,10 @@ constants \synit{name} "\synit{description}" \verb+{+
   generate identifiers in the target language (typically C).  The
   scope of this identifier is the enclosing device specification.  
 
+\item[width] is optional, and specifies the width of the constant
+  value in bits.  This is useful, for example, when the type is used
+  as the type of a register. 
+
 \item [``description''] is a string literal in double quotes, which
   describes the constant type being specified, for example
   \texttt{"Vector delivery mode"}. 

diff --git a/tools/mackerel/Checks.hs b/tools/mackerel/Checks.hs
index 980d030..3558715 100644 (file)
--- a/tools/mackerel/Checks.hs
+++ b/tools/mackerel/Checks.hs
@@ -76,15 +76,22 @@ check_devname inf dev =
 
 check_rous :: Dev.Rec -> [ MacError ]
 check_rous d = 
-    [ make_rous_error t | t@(TT.RegFormat {}) <- (Dev.types d), check_rous_type t ]
+    [ make_rous_error t 
+    | t@(TT.RegFormat {}) <- (Dev.types d), check_rous_type t ]
+    ++
+    [ make_rous_error t 
+    | RT.Rec { RT.tpe = t@(TT.ConstType {}) } <- (Dev.registers d), check_rous_type t ]
 
 check_rous_type t = notElem (TT.tt_size t) [ 8, 16, 32, 64 ]
 make_rous_error t = 
     (MacError (TT.pos t)
-     (printf "Register type '%s' (%s) is a Register Of Unusual Size (%d bits)"
-                 (TT.type_name t)
-                 (TT.tt_desc t)
-                 (TT.tt_size t)))
+     (if TT.tt_size t == -1 
+      then 
+        (printf "Register type '%s' (%s) has no width() specifier"
+         (TT.type_name t) (TT.tt_desc t))
+      else
+        (printf "Type '%s' (%s) is a Register Of Unusual Size (%d bits)"
+         (TT.type_name t) (TT.tt_desc t) (TT.tt_size t))))
       
 --
 -- Check for Data types of Unusual Size

diff --git a/tools/mackerel/Main.hs b/tools/mackerel/Main.hs
index 5ff8aa5..09f0cf2 100644 (file)
--- a/tools/mackerel/Main.hs
+++ b/tools/mackerel/Main.hs
@@ -31,7 +31,7 @@ import Dev
 --
 
 -- Datatypes for carrying command options around
-data Target = BitFieldDriver | ShiftDriver deriving (Eq, Show)
+data Target = BitFieldDriver | ShiftDriver | NullDriver deriving (Eq, Show)
 
 data Options = Options {
   opt_infilename :: Maybe String,
@@ -69,6 +69,9 @@ options =
   , Option ['S'] ["shift-driver"]
     (NoArg (\ opts -> opts { opt_target = ShiftDriver } ))
      "use shift driver (default; preferred)"
+  , Option ['n'] ["null-driver"]
+    (NoArg (\ opts -> opts { opt_target = NullDriver } ))
+     "use null output driver (don't generate any C)"
   , Option ['B'] ["bitfield-driver"]
     (NoArg (\ opts -> opts { opt_target = BitFieldDriver } ))
      "use bitfield driver (deprecrated: do not use)"
@@ -118,6 +121,10 @@ usageError errs =
 -- Processing source files
 ---
 
+-- Null compilation 
+nullCompiler :: String -> String -> Dev.Rec -> String
+nullCompiler _ _ _ = ""
+
 -- Perform run-time checks
 run_checks :: String -> Dev.Rec -> IO String
 run_checks input_fn dev =
@@ -192,6 +199,7 @@ main = do { cli <- System.getArgs
                 do { _ <- run_checks input_fn dev
                    ; outFileD <- openFile output_fn WriteMode
                    ; hPutStr outFileD ((case (opt_target opts) of
+                                           NullDriver -> nullCompiler 
                                            ShiftDriver -> ShiftDriver.compile 
                                            BitFieldDriver -> BitFieldDriver.compile)
                                        input_fn output_fn dev)

diff --git a/tools/mackerel/RegisterTable.hs b/tools/mackerel/RegisterTable.hs
index d65f946..5ee1958 100644 (file)
--- a/tools/mackerel/RegisterTable.hs
+++ b/tools/mackerel/RegisterTable.hs
@@ -80,22 +80,25 @@ make_reginfo rtinfo (RegArray n attr als rloc aloc dsc (TypeDefn decls) p) dn or
 
 make_reginfo rtinfo (RegArray n attr als rloc aloc dsc tr@(TypeRef tname dname) p) dn order spt = 
   let tn = TN.fromRef tr dn
-  in
-   if TN.is_builtin_type tn then
-        let t = (TT.Primitive tn (TT.builtin_size tname) attr)
-            r = make_regproto n als rloc dsc p spt t
-        in [ r { fl = [],
-                 origtype = tname,
-                 size = (TT.tt_size t),
-                 arr = aloc } ]
-   else
-        let rt = (TT.get_rtrec rtinfo tn)
-            r = make_regproto n als rloc dsc p spt rt
-        in
-          [ r { fl = F.inherit_list attr (TT.fields rt),
-                origtype = tname,
-                size = (TT.tt_size rt),
-                arr = aloc } ]
+      rt = (TT.get_rtrec rtinfo tn)
+      r = make_regproto n als rloc dsc p spt rt
+  in case rt of
+    t@(TT.Primitive {}) -> [ r { origtype = tname,
+                                 size = (TT.tt_size rt),
+                                 arr = aloc } ]
+    t@(TT.RegFormat {}) -> [ r { fl = F.inherit_list attr (TT.fields rt),
+                                 origtype = tname,
+                                 size = (TT.tt_size rt),
+                                 arr = aloc } ]
+    t@(TT.DataFormat {}) -> [ r { fl = F.inherit_list attr (TT.fields rt),
+                                 origtype = tname,
+                                 size = (TT.tt_size rt),
+                                 arr = aloc } ]
+    t@(TT.ConstType {}) -> [ r { origtype = tname,
+                                 size = case (TT.tt_width rt) of
+                                   Nothing -> -1
+                                   Just i  -> i,
+                                 arr = aloc } ]
 
 make_reginfo rtinfo (Register n attr als rloc dsc (TypeDefn decls) p) dn order spt =
     let tn = TN.fromParts dn n
@@ -108,23 +111,26 @@ make_reginfo rtinfo (Register n attr als rloc dsc (TypeDefn decls) p) dn order s
 
 make_reginfo rtinfo (Register n attr als rloc dsc tr@(TypeRef tname dname) p) dn order spt =
   let tn = TN.fromRef tr dn
-  in
-    if TN.is_builtin_type tn then
-        let t = (TT.Primitive tn (TT.builtin_size tname) attr)
-            r = make_regproto n als rloc dsc p spt t
-        in [ r { origtype = tname,
-                 size = (TT.tt_size t),
-                 arr = (ArrayListLoc []) } ]
-
-    else
-        let rt = (TT.get_rtrec rtinfo tn)
-            r = make_regproto n als rloc dsc p spt rt
-        in
-          [ r { fl = F.inherit_list attr (TT.fields rt),
-                origtype = tname,
-                size = (TT.tt_size rt),
-                arr = (ArrayListLoc []) } ]
-          
+      rt = (TT.get_rtrec rtinfo tn)
+      r = make_regproto n als rloc dsc p spt rt
+  in case rt of
+    t@(TT.Primitive {}) -> [ r { origtype = tname,
+                                 size = (TT.tt_size rt),
+                                 arr = (ArrayListLoc []) } ]
+    t@(TT.RegFormat {}) -> [ r { fl = F.inherit_list attr (TT.fields rt),
+                                 origtype = tname,
+                                 size = (TT.tt_size rt),
+                                 arr = (ArrayListLoc []) } ]
+    t@(TT.DataFormat {}) -> [ r { fl = F.inherit_list attr (TT.fields rt),
+                                 origtype = tname,
+                                 size = (TT.tt_size rt),
+                                 arr = (ArrayListLoc []) } ]
+    t@(TT.ConstType {}) -> [ r { origtype = tname,
+                                 size = case (TT.tt_width rt) of
+                                   Nothing -> -1
+                                   Just i  -> i,
+                                 arr = (ArrayListLoc []) } ]
+
 make_reginfo rtinfo _ _ _ _ = []
 
 get_location :: RegLoc -> [Space.Rec] -> ( String, Space.Rec, String, Integer )

diff --git a/tools/mackerel/ShiftDriver.hs b/tools/mackerel/ShiftDriver.hs
index 930622f..676dd0c 100644 (file)
--- a/tools/mackerel/ShiftDriver.hs
+++ b/tools/mackerel/ShiftDriver.hs
@@ -337,6 +337,7 @@ convert_arg (Arg "io" x) = Arg "mackerel_io_t" x
 -------------------------------------------------------------------------
 
 -- 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
 
@@ -548,7 +549,10 @@ 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) ]
+    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 = 

diff --git a/tools/mackerel/TypeTable.hs b/tools/mackerel/TypeTable.hs
index af5ef55..0e1009b 100644 (file)
--- a/tools/mackerel/TypeTable.hs
+++ b/tools/mackerel/TypeTable.hs
@@ -51,7 +51,7 @@ data Rec = RegFormat  { tt_name :: TN.Name,
                         tt_size :: Integer,
                         tt_attr :: Attr }
            deriving Show 
-
+              
 type_name :: Rec -> String
 type_name r = TN.toString $ tt_name r
 
@@ -64,9 +64,12 @@ type_kind DataFormat {} = "Data"
 type_kind ConstType  {} = "Constant"
 type_kind Primitive  {} = "Primitive"
 
-
+-- Is this a primitive (i.e. non-record-like) type.  A key issue here
+-- is that this includes constants types; otherwise this is equivalent
+-- to is_builtin below.
 is_primitive :: Rec -> Bool
 is_primitive Primitive {} = True
+is_primitive ConstType {} = True
 is_primitive _ = False
 
 is_builtin :: Rec -> Bool
@@ -81,7 +84,10 @@ builtin_size "uint64" = 64
 
 make_rtypetable :: DeviceFile -> [Rec]
 make_rtypetable (DeviceFile (Device devname bitorder _ _ decls) _) = 
-  concat [ make_rtrec d devname bitorder | d <- decls ]
+  (concat [ make_rtrec d devname bitorder | d <- decls ])
+  ++ 
+  [ Primitive (TN.fromParts devname ("uint" ++ (show w))) w NOATTR 
+  | w <- [ 8, 16, 32, 64 ] ] 
 
 make_rtrec :: AST -> String -> BitOrder -> [Rec]
 make_rtrec (RegType nm dsc (TypeDefn decls) p) dev order = 
@@ -117,7 +123,9 @@ make_rtrec (Constants nm d vs w p) dev devorder =
   let tn = TN.fromParts dev nm 
   in
    [ ConstType { tt_name = tn,
-                 tt_size = 0,
+                 tt_size = case w of 
+                   Nothing -> (-1)
+                   Just t -> t,
                  tt_vals = [ make_val tn v | v <- vs ], 
                  tt_desc = d,
                  tt_width = w,
@@ -141,5 +149,5 @@ get_rtrec rtinfo nm =
       else RegFormat { tt_name = TN.null,
                        tt_size = 32,
                        fields = [],
-                       tt_desc = "Fictional non-existent type",
+                       tt_desc = "Failed to find type" ++ show nm,
                        pos = initialPos "no file" }