Add x86-support to travis

stack-8.4.yaml

@@ -6,9 +6,7 @@ resolver: lts-12.26
 
 packages:
 - base
-- x86
 - symbolic
-- x86_symbolic
 - deps/crucible/what4
 - deps/crucible/crucible
 - deps/crucible/crucible-llvm
@@ -20,6 +18,10 @@ packages:
 - deps/llvm-pretty-bc-parser
 - deps/parameterized-utils
 - submodules/macaw-loader/macaw-loader
+# X86 specific repos
+- x86
+- x86/support
+- x86_symbolic
 # - submodules/dismantle/dismantle-tablegen
 # - macaw-semmc
 # - submodules/semmc/semmc

stack-8.6.yaml

@@ -6,9 +6,7 @@ resolver: lts-13.13
 
 packages:
 - base
-- x86
 - symbolic
-- x86_symbolic
 - deps/crucible/what4
 - deps/crucible/crucible
 - deps/crucible/crucible-llvm
@@ -20,6 +18,10 @@ packages:
 - deps/llvm-pretty-bc-parser
 - deps/parameterized-utils
 - submodules/macaw-loader/macaw-loader
+# X86 specific repos
+- x86
+- x86/support
+- x86_symbolic
 # - submodules/dismantle/dismantle-tablegen
 # - macaw-semmc
 # - submodules/semmc/semmc

x86/support/make_bsd_syscalls/Main.hs

@@ -10,15 +10,12 @@ import           Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as P
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
-import           Data.Either (either)
-import           Data.Map (Map)
 import qualified Data.Map as Map
-import           Data.Maybe (catMaybes, maybe)
+import           Data.Maybe (catMaybes)
 import           Language.C
 import           Language.C.Analysis.AstAnalysis
 import           Language.C.Analysis.SemRep
 import           Language.C.Analysis.TravMonad
-import           Language.C.Data.Ident
 import           Language.C.Data.Name (newNameSupply)
 import           Language.C.Data.Position (position)
 import           System.Environment (getArgs)
@@ -27,8 +24,6 @@ import           System.IO
 import           Text.PrettyPrint
 import           Text.Show.Pretty
 
-import           Debug.Trace
-
 -- FIXME: clag from Data.Macaw.Architecture.Syscall
 data SyscallArgType = VoidArgType | WordArgType
                     deriving (Eq, Show, Read)
@@ -115,10 +110,15 @@ generateHSFile tunit sis =
 
     -- summariseDeclEvent idecl = pretty idecl
 
-    summariseDeclEvent (getVarDecl -> VarDecl vname _ (FunctionType (FunType rettyp params _) _)) =
-      ( identToString (identOfVarName vname)
-      , typeToArgType rettyp
-      , map (typeToArgType . declType) params )
+    summariseDeclEvent d =
+      case getVarDecl d of
+        VarDecl vname _ (FunctionType (FunType rettyp params _) _) ->
+          ( identToString (identOfVarName vname)
+          , typeToArgType rettyp
+          , map (typeToArgType . declType) params
+          )
+        _ -> error "summariseDeclEvent given unexpected declaration."
+
 
     -- syscallInfo (CDeclExt (CDecl [CTypeSpec spec] [(Just declr, _, _)] _))
     --   | CDeclr (Just ident) [CFunDeclr (Right (decls, _)) _ _] _ _ _ <- declr
@@ -129,8 +129,8 @@ generateHSFile tunit sis =
     -- declToArgType d = error ("unhandled decl (in type) " ++ show d)
 
 typeToArgType :: Type -> SyscallArgType
-typeToArgType typ =
-  case typ of
+typeToArgType tp =
+  case tp of
     DirectType typ' _ _ ->
       case typ' of
         TyVoid               -> VoidArgType
@@ -138,7 +138,7 @@ typeToArgType typ =
         TyFloating TyLDouble -> unhandled
         TyFloating _         -> unhandled -- XMMFloatType
         TyComplex _          -> unhandled
-        TyComp comp          -> unhandled -- compTypeToArgType comp
+        TyComp _comp         -> unhandled -- compTypeToArgType comp
         TyEnum _             -> WordArgType -- FIXME: ???
         TyBuiltin _          -> unhandled
     PtrType _ _ _            -> WordArgType
@@ -146,7 +146,7 @@ typeToArgType typ =
     FunctionType _ _         -> unhandled
     TypeDefType (TypeDefRef _ typ _) _ _ -> typeToArgType typ
   where
-    unhandled = error ("Unhandled type: " ++ show (pretty typ))
+    unhandled = error ("Unhandled type: " ++ show (pretty tp))
 
 ------------------------------------------------------------------------
 -- File preprocessing

x86/support/make_linux_syscalls/Main.hs

@@ -6,7 +6,6 @@ The driver for creating SyscallInfo.Linux
 {-# LANGUAGE PatternGuards #-}
 module Main (main) where
 
-import           Control.Lens
 import           Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as P
 import           Data.ByteString (ByteString)
@@ -14,14 +13,12 @@ import qualified Data.ByteString.Char8 as BS
 import           Data.Either (either)
 import           Data.Map (Map)
 import qualified Data.Map as Map
-import           Data.Maybe (catMaybes, maybe, isNothing, listToMaybe)
+import           Data.Maybe (catMaybes)
 import           Language.C
 import           Language.C.Analysis.AstAnalysis
 import           Language.C.Analysis.SemRep
 import           Language.C.Analysis.TravMonad
 import           Language.C.Data.Ident
-import           Language.C.Data.Name (newNameSupply)
-import           Language.C.Data.Position (position)
 import           Language.C.System.GCC (newGCC)
 import           System.Environment (getArgs)
 import           System.Exit
@@ -29,8 +26,6 @@ import           System.IO
 import           Text.PrettyPrint
 import           Text.Show.Pretty
 
-import           Debug.Trace
-
 -- FIXME: clag from Data.Macaw.Architecture.Syscall
 data SyscallArgType = VoidArgType | WordArgType | XMMFloatType
                     deriving (Eq, Show, Read)
@@ -51,15 +46,16 @@ data SyscallArgType = VoidArgType | WordArgType | XMMFloatType
 
 data SyscallInfo =
   SyscallInfo { syscallNo    :: Integer
-              , syscallABI   :: ByteString
+              , _syscallABI   :: ByteString
               , syscallName  :: ByteString
               , syscallProto :: Either ByteString IdentDecl
               }
   -- deriving Show
 
-pp si = print $ integer (syscallNo si) <+> text (show $ syscallName si)
-                <+> text "->"
-                <+> either (const "???") pretty (syscallProto si)
+instance Show SyscallInfo where
+  show si = show $ integer (syscallNo si) <+> text (show $ syscallName si)
+                 <+> text "->"
+            <+> either (const "???") pretty (syscallProto si)
 
 -- A bit hacky, but no less than using TH to read in a text file
 generateHSFile :: [SyscallInfo] -> Doc
@@ -84,10 +80,13 @@ generateHSFile sis =
       , Left str <- [ syscallProto si ]  ]
 
     -- syscallInfo :: CExtDecl -> Maybe (String, SyscallArgType, [SyscallArgType])
-    syscallInfo (getVarDecl -> VarDecl vname _ (FunctionType (FunType rettyp params _) _)) =
-      ( identToString (identOfVarName vname)
-      , typeToArgType rettyp
-      , map (typeToArgType . declType) params )
+    syscallInfo d =
+      case getVarDecl d of
+        VarDecl vname _ (FunctionType (FunType rettyp params _) _) ->
+          ( identToString (identOfVarName vname)
+          , typeToArgType rettyp
+          , map (typeToArgType . declType) params )
+        _ -> error "syscallInfo given unexpected declaration."
 
     -- syscallInfo (CDeclExt (CDecl [CTypeSpec spec] [(Just declr, _, _)] _))
     --   | CDeclr (Just ident) [CFunDeclr (Right (decls, _)) _ _] _ _ _ <- declr
@@ -98,8 +97,8 @@ generateHSFile sis =
     -- declToArgType d = error ("unhandled decl (in type) " ++ show d)
 
 typeToArgType :: Type -> SyscallArgType
-typeToArgType typ =
-  case typ of
+typeToArgType tp =
+  case tp of
     DirectType typ' _ _ ->
       case typ' of
         TyVoid               -> VoidArgType
@@ -107,7 +106,7 @@ typeToArgType typ =
         TyFloating TyLDouble -> unhandled
         TyFloating _         -> XMMFloatType
         TyComplex _          -> unhandled
-        TyComp comp          -> unhandled -- compTypeToArgType comp
+        TyComp _comp         -> unhandled -- compTypeToArgType comp
         TyEnum _             -> WordArgType -- FIXME: ???
         TyBuiltin _          -> unhandled
     PtrType _ _ _            -> WordArgType
@@ -115,10 +114,7 @@ typeToArgType typ =
     FunctionType _ _         -> unhandled
     TypeDefType (TypeDefRef _ typ _) _ _ -> typeToArgType typ
   where
-    unhandled = error ("Unhandled type: " ++ show (pretty typ))
-
-compTypeToArgType :: CompTypeRef -> SyscallArgType
-compTypeToArgType ctyp = trace ("Comp type: " ++ show (pretty ctyp)) WordArgType
+    unhandled = error ("Unhandled type: " ++ show (pretty tp))
 
 -- We support as little as possible here ...
 -- typeSpecToArgType :: Show a => CTypeSpecifier a -> SyscallArgType
@@ -152,7 +148,7 @@ readOneCFile f = do
 
   let gdecls = case runTrav_ (analyseAST tunit) of
                  Left err -> error $ "Error: " ++ (show err)
-                 Right (gdecls, _) -> gdecls
+                 Right (d, _) -> d
 
   return (Map.mapKeys (\(Ident name _ _) -> BS.pack name) $ gObjs gdecls)