diff --git a/files/mockup_prelude.cc b/files/mockup_prelude.cc index d25edff205bc12454f38781a7755dd04f024bfbc..c5f9e39bb142a15df8024c541b7ba0dd7838115b 100644 --- a/files/mockup_prelude.cc +++ b/files/mockup_prelude.cc @@ -104,7 +104,7 @@ void hex_os_state() { const uint8_t *end = (const uint8_t*)&_edata_os_canonical; uint32_t len = end-start; - printf("os-hex: len:%d 0x", len); + printf("debug: os-hex: len:%d 0x", len); for (const uint8_t *i = start; i < end; i++) { printf("%02x", *i); } diff --git a/src/Search/Search.hs b/src/Search/Search.hs index c260ba458ec8ce82d86a95da46caf7e44f1cf0ca..e058af209b6be0f929e6186e850d536fc0738f80 100644 --- a/src/Search/Search.hs +++ b/src/Search/Search.hs @@ -92,12 +92,13 @@ findOpenDecision = listToMaybe . mapMaybe isHalf . M.elems . view decisions type EliminateEpsilons = Bool type DumpJSON = Bool +type DebugOutput = Bool -driver :: EliminateEpsilons -> DumpJSON -> FilePath -> IO (Graph Text Text) -driver ee dumpJSON prog = driver' ee dumpJSON prog (VertexLabel "start" "" "") +driver :: EliminateEpsilons -> DumpJSON -> DebugOutput -> FilePath -> IO (Graph Text Text) +driver ee dumpJSON debug prog = driver' ee dumpJSON debug prog (VertexLabel "start" "" "") -driver' :: EliminateEpsilons -> DumpJSON -> FilePath -> VertexLabel -> IO (Graph Text Text) -driver' elimEpsis dumpJSON prog startVertex = do +driver' :: EliminateEpsilons -> DumpJSON -> DebugOutput -> FilePath -> VertexLabel -> IO (Graph Text Text) +driver' elimEpsis dumpJSON debug prog startVertex = do let startOS = Just (EdgeLabel "StartOS" "StartOS") -- first edge state <- newIORef $ State { _foundGraph = singletonGraph 0 startVertex @@ -107,7 +108,7 @@ driver' elimEpsis dumpJSON prog startVertex = do , _currentSyscall = startOS , _curTrace = [] } - oneProgRun prog state Nothing + oneProgRun prog debug state Nothing let loop = do modifyIORef state $ \s -> (s & curTrace .~ [] @@ -124,20 +125,21 @@ driver' elimEpsis dumpJSON prog startVertex = do B.putStrLn (encode (prepareForCompare graph')) return $ prepareForCompare graph' Just trace -> do - oneProgRun prog state (Just $ reverse trace) + oneProgRun prog debug state (Just $ reverse trace) loop loop -oneProgRun :: FilePath -> IORef State -> Maybe [Bool] -> IO () -oneProgRun prog state trace = do +oneProgRun :: FilePath -> DebugOutput -> IORef State -> Maybe [Bool] -> IO () +oneProgRun prog debug state trace = do (Just pstdin, Just pstdout, _, handle) <- createProcess (proc prog []) { std_in = CreatePipe, std_out = CreatePipe } case trace of - Just trace' -> tracePath pstdin pstdout state trace' + Just trace' -> tracePath debug pstdin pstdout state trace' _ -> return () - let loop = handleLine pstdout state >>= \case + let loop = handleLine debug pstdout state >>= \case Decision x -> do + when debug $ hPutStrLn stderr ("Decision: " ++ show x) s <- readIORef state let (next, s') = handleDecision x (s^.curTrace) s writeIORef state s' @@ -163,15 +165,15 @@ oneProgRun prog state trace = do loop -tracePath :: Handle -> Handle -> IORef State -> [Bool] -> IO () -tracePath _ _ _ [] = return () -tracePath pstdin pstdout state (decision:ds) = - handleLine pstdout state >>= \case +tracePath :: DebugOutput -> Handle -> Handle -> IORef State -> [Bool] -> IO () +tracePath _ _ _ _ [] = return () +tracePath debug pstdin pstdout state (decision:ds) = + handleLine debug pstdout state >>= \case EOF -> error "premature eof" -- FIXME Decision _ -> do makeDecision pstdin state decision - tracePath pstdin pstdout state ds - _ -> tracePath pstdin pstdout state (decision:ds) + tracePath debug pstdin pstdout state ds + _ -> tracePath debug pstdin pstdout state (decision:ds) makeDecision :: Handle -> IORef State -> Bool -> IO () makeDecision pstdin state decision = do @@ -184,15 +186,16 @@ data LineOut = NewVertex VertexLabel | Decision DecisionNumber | EOF -parseLine :: Handle -> IO LineOut -parseLine handle = do +parseLine :: DebugOutput -> Handle -> IO LineOut +parseLine debug handle = do eof <- hIsEOF handle if eof then return EOF else do line <- T.hGetLine handle + when debug $ T.hPutStrLn stderr line if "debug" `T.isPrefixOf` line then - T.hPutStrLn stderr line >> parseLine handle + T.hPutStrLn stderr line >> parseLine debug handle else case decodeStrict (T.encodeUtf8 line) of Nothing -> error $ "Parser error in line " <> T.unpack line Just (DecisionRequest num) -> @@ -202,8 +205,8 @@ parseLine handle = do Just (AtBasicBlock state abb func) -> return $ NewVertex (VertexLabel state abb func) -handleLine :: Handle -> IORef State -> IO LineOut -handleLine pstdin state = parseLine pstdin >>= \case +handleLine :: DebugOutput -> Handle -> IORef State -> IO LineOut +handleLine debug pstdin state = parseLine debug pstdin >>= \case NewVertex vert -> do modifyIORef state (addVertex vert) return (NewVertex vert) diff --git a/src/main/Main.hs b/src/main/Main.hs index a464cae615fbe2180af37345486c5568c956a919..458fc9ed0d0fb609577e72108578d0ea60a5f945 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -59,6 +59,7 @@ data SearchOpts = SearchOpts , sseGraphJsonFile :: Maybe FilePath , eliminateEpsilons :: Bool , dumpJSON :: Bool + , debugOutput :: Bool } searchOptParser :: Parser SearchOpts @@ -69,6 +70,7 @@ searchOptParser = SearchOpts <> help "Don't do epsilon elimination on the search graph" )) <*> switch (long "dump-json" <> help "Dump graph as json instead of dot") + <*> switch (long "debug" <> help "Print verbose debug output to stderr") data MockupOpts = MockupOpts { triggerInterrupts :: Bool @@ -130,12 +132,12 @@ main = do json <- traverse BS.readFile (sseGraphJsonFile opts) case JSON.parseFile <$> json of -- Don't do any comparision between graphs - Nothing -> void (driver (eliminateEpsilons opts) (dumpJSON opts) (mockupExecutable opts)) + Nothing -> void (driver (eliminateEpsilons opts) (dumpJSON opts) (debugOutput opts) (mockupExecutable opts)) Just (Left e) -> do hPutStrLn stderr $ "Could not parse sse graph json: " <> e exitFailure Just (Right graph1) -> do - graph2 <- driver (eliminateEpsilons opts) (dumpJSON opts) (mockupExecutable opts) + graph2 <- driver (eliminateEpsilons opts) (dumpJSON opts) (debugOutput opts) (mockupExecutable opts) hPutStr stderr $ "GRAPH COMPARISION FOR " ++ (mockupExecutable opts) ++ ": " hPrint stderr (isIsomorphic (preprocess graph1) graph2) Mockup opts -> do