Permalink
Browse files

refactoring: separate breakpoints and blocking calls

  • Loading branch information...
1 parent 20416d9 commit b0cd20a8235f632f2c4986dd055d532571dbdb62 Alexander Bernauer committed Aug 9, 2012
View
@@ -1,3 +1,3 @@
#!/bin/bash
-exec ghci -isrc -idist/build/autogen/ -no-user-package-conf -package-conf cabal-dev/packages-7.4.1.conf Ocram.Main
+exec ghci -Wall -isrc -idist/build/autogen/ -no-user-package-conf -package-conf cabal-dev/packages-7.4.1.conf Ocram.Main
View
@@ -4,10 +4,8 @@ module Ocram.Debug where
-- import {{{1
import Data.Data (Data)
import Data.Digest.OpenSSL.MD5 (md5sum)
-import Data.Maybe (fromMaybe)
import Data.Typeable (Typeable)
-import Language.C.Data.Node (lengthOfNode, posOfNode, CNode(nodeInfo), NodeInfo, undefNode)
-import Language.C.Data.Position (posRow, posColumn, posFile)
+import Language.C.Data.Node (CNode(nodeInfo), NodeInfo, undefNode)
import Ocram.Analysis (CallGraph, start_functions, blocking_functions, call_order)
import Ocram.Options (Options(optInput, optOutput))
import Ocram.Debug.Internal
@@ -20,7 +18,7 @@ import qualified Data.ByteString.Char8 as BS
data ENodeInfo = ENodeInfo { -- {{{1
enTnodeInfo :: NodeInfo
, enThreadId :: Maybe Int
- , enTraceLocation :: Bool
+ , enBreakpoint :: Bool
, enBlockingCall :: Bool
} deriving (Data, Typeable)
@@ -36,26 +34,15 @@ un = enrich_node_info undefNode
enrich_node_info :: NodeInfo -> ENodeInfo -- {{{1
enrich_node_info ni = ENodeInfo ni Nothing False False
-setThread :: Int -> ENodeInfo -> ENodeInfo -- {{{1
-setThread tid eni = eni {enThreadId = Just tid}
-
-tlocation :: ENodeInfo -> TLocation -- {{{1
-tlocation eni =
- let
- ni = enTnodeInfo eni
- pos = posOfNode ni
- in
- TLocation (posRow pos + 1) (posColumn pos) (fromMaybe (-1) (lengthOfNode ni)) (posFile pos)
-
-create_debug_info :: Options -> CallGraph -> BS.ByteString -> BS.ByteString -> BS.ByteString -> VarMap -> LocMap -> DebugInfo -- {{{1
-create_debug_info opt cg tcode pcode ecode vm lm =
+create_debug_info :: Options -> CallGraph -> BS.ByteString -> BS.ByteString -> BS.ByteString -> VarMap -> Breakpoints -> BlockingCalls -> DebugInfo -- {{{1
+create_debug_info opt cg tcode pcode ecode vm lm bkl =
let
tfile = File (optInput opt) (md5sum tcode)
efile = File (optOutput opt) (md5sum ecode)
ts = zipWith createThreadInfo [0..] (start_functions cg)
ppm = preproc_map tcode pcode
oa = blocking_functions cg
in
- DebugInfo tfile pcode efile ppm lm vm ts oa
+ DebugInfo tfile pcode efile ppm lm bkl vm ts oa
where
createThreadInfo tid sf = Thread tid sf (threadExecutionFunction tid) ($fromJust_s $ call_order cg sf)
View
@@ -28,8 +28,8 @@ runCompiler argv = do
(tcode, pcode, ast) <- exitOnError "parser" =<< parse opt
(cg, fpr) <- exitOnError "analysis" $ analysis ast
let (ast', pal, vm) = transformation cg ast
- let (ecode, lm) = print_with_log ast'
- let di = encode_debug_info $ create_debug_info opt cg tcode pcode ecode vm lm
+ let (ecode, lm, bl) = print_with_log ast'
+ let di = encode_debug_info $ create_debug_info opt cg tcode pcode ecode vm lm bl
exitOnError "output" =<< generate_pal opt fpr pal
exitOnError "output" =<< dump_ecode opt ecode
exitOnError "output" =<< dump_debug_info opt di
View
@@ -41,60 +41,84 @@ module Ocram.Print
) where
-- import {{{1
-import Control.Arrow (first)
+import Data.Maybe (fromMaybe)
+import Language.C.Data.Position (posRow, posColumn, posFile)
import Language.C.Syntax
import Language.C.Data.Ident (Ident, identToString)
+import Language.C.Data.Node (posOfNode, lengthOfNode)
import Text.PrettyPrint
-import Ocram.Debug (ENodeInfo(..), tlocation)
-import Ocram.Ruab (ELocation(ELocation), Location(Location), LocMap)
-import Ocram.Util (abort)
+import Ocram.Debug (ENodeInfo(..))
+import Ocram.Ruab (TLocation(..), ELocation(..), Breakpoint(..), Breakpoints, BlockingCall(..), BlockingCalls)
+import Ocram.Util (abort, fromJust_s)
+import Prelude hiding (log)
import qualified Data.ByteString.Char8 as BS
-print_with_log :: CTranslationUnit ENodeInfo -> (BS.ByteString, LocMap) -- {{{1
-print_with_log tu = first BS.pack $ renderWithLog (pretty tu)
+import Debug.Trace (trace)
-marker :: ENodeInfo -> DocL LocMap -> DocL LocMap
+print_with_log :: CTranslationUnit ENodeInfo -> (BS.ByteString, Breakpoints, BlockingCalls) -- {{{1
+print_with_log tu =
+ let
+ (code, log) = renderWithLog (pretty tu)
+ (bps, bcs) = foldr split ([], []) log
+ split (Left x) (bps', bcs') = (x:bps', bcs')
+ split (Right x) (bps', bcs') = (bps', x:bcs')
+ in
+ (BS.pack code, bps, bcs)
+
+type Log = [Either Breakpoint BlockingCall]
+
+marker :: ENodeInfo -> DocL Log -> DocL Log
marker eni doc
- | enTraceLocation eni = here logger doc
+ | enBreakpoint eni = here bpLogger doc
+ | enBlockingCall eni = trace "YES" (here bcLogger doc)
| otherwise = doc
where
- logger (Position r c) = [Location (tlocation eni) (ELocation r c ) (enBlockingCall eni) (enThreadId eni)]
+ bpLogger (Position r c) = [Left $ Breakpoint tlocation (ELocation r c ) (enThreadId eni)]
+
+ bcLogger (Position r c) = [Right $ BlockingCall (ELocation r c) (($fromJust_s . enThreadId) eni)]
+
+ tlocation =
+ let
+ ni = enTnodeInfo eni
+ pos = posOfNode ni
+ in
+ TLocation (posRow pos + 1) (posColumn pos) (fromMaybe (-1) (lengthOfNode ni)) (posFile pos)
class PrettyLog a where
- pretty :: a -> DocL LocMap
- prettyPrec :: Int -> a -> DocL LocMap
+ pretty :: a -> DocL Log
+ prettyPrec :: Int -> a -> DocL Log
pretty = prettyPrec 0
prettyPrec _ = pretty
-- pretty print optional chunk
-maybeP :: (p -> DocL LocMap) -> Maybe p -> DocL LocMap
+maybeP :: (p -> DocL Log) -> Maybe p -> DocL Log
maybeP = maybe empty
-- pretty print when flag is true
-ifP :: Bool -> DocL LocMap -> DocL LocMap
+ifP :: Bool -> DocL Log -> DocL Log
ifP flag doc = if flag then doc else empty
-- pretty print _optional_ list, i.e. [] ~ Nothing and (x:xs) ~ Just (x:xs)
-mlistP :: ([p] -> DocL LocMap) -> [p] -> DocL LocMap
+mlistP :: ([p] -> DocL Log) -> [p] -> DocL Log
mlistP pp xs = maybeP pp (if null xs then Nothing else Just xs)
-- pretty print identifier
-identP :: Ident -> DocL LocMap
+identP :: Ident -> DocL Log
identP = text . identToString
-- pretty print attribute annotations
-attrlistP :: [CAttribute ENodeInfo] -> DocL LocMap
+attrlistP :: [CAttribute ENodeInfo] -> DocL Log
attrlistP [] = empty
attrlistP attrs = text "__attribute__" <> parens (parens (hcat . punctuate comma . map pretty $ attrs))
-- analogous to showParen
-parenPrec :: Int -> Int -> DocL LocMap -> DocL LocMap
+parenPrec :: Int -> Int -> DocL Log -> DocL Log
parenPrec prec prec2 t = if prec <= prec2 then t else parens t
-- indent a chunk of code
-ii :: DocL LocMap -> DocL LocMap
+ii :: DocL Log -> DocL Log
ii = nest 4
-- PrettyLog instances
@@ -319,7 +343,7 @@ instance PrettyLog (CEnumeration ENodeInfo) where
instance PrettyLog (CDeclarator ENodeInfo) where
prettyPrec prec declr = prettyDeclr True prec declr
-prettyDeclr :: Bool -> Int -> CDeclarator ENodeInfo -> DocL LocMap
+prettyDeclr :: Bool -> Int -> CDeclarator ENodeInfo -> DocL Log
prettyDeclr show_attrs prec (CDeclr name derived_declrs asmname cattrs _) =
ppDeclr prec (reverse derived_declrs) <+> prettyAsmName asmname <+> ifP show_attrs (attrlistP cattrs)
where
@@ -6,20 +6,18 @@ module Ocram.Print.Test
) where
-- import {{{1
-import Control.Arrow ((***))
import Data.Generics (everything, mkQ, extQ)
import Data.List (intercalate)
-import Ocram.Debug (ENodeInfo(..), tlocation)
-import Language.C.Data.Node (nodeInfo)
-import Language.C.Syntax.AST (CTranslUnit, CTranslationUnit(..), annotation)
+import Ocram.Debug (ENodeInfo(..))
+import Language.C.Syntax.AST (annotation)
import Ocram.Analysis (analysis)
import Ocram.Print (print_with_log)
-import Ocram.Test.Lib (enumTestGroup, paste, lpaste, enrich, reduce, TLocMap)
+import Ocram.Test.Lib (enumTestGroup, lpaste, enrich, reduce, TBreakpoints, TBlockingCalls)
import Ocram.Text (show_errors)
import Ocram.Transformation (transformation)
import Ocram.Transformation.Types (CExpr', CStat')
import Test.Framework (Test, testGroup)
-import Test.HUnit ((@=?), Assertion, assertFailure, assertEqual)
+import Test.HUnit (Assertion, assertFailure, assertEqual)
import qualified Data.ByteString.Char8 as BS
@@ -61,6 +59,8 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
}
|], [
(3, 19, Just 0)
+ ], [
+ (19, 0)
])
-- function static variable {{{2
, ([lpaste|
@@ -98,6 +98,8 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
|], [
(3, 17, Just 0)
, (4, 20, Just 0)
+ ], [
+ (20, 0)
])
-- global variable {{{2
, ([lpaste|
@@ -137,6 +139,8 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
|], [
(4, 18, Just 0)
, (5, 21, Just 0)
+ ], [
+ (21, 0)
])
-- non-critical function call {{{2
,([lpaste|
@@ -184,6 +188,8 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
(3, 4, Nothing)
, (7, 22, Just 0)
, (8, 25, Just 0)
+ ], [
+ (25, 0)
])
-- critical function call {{{2
,([lpaste|
@@ -237,6 +243,8 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
|], [
(6, 26, Just 0)
, (3, 34, Just 0)
+ ], [
+ (34, 0)
])
-- re-entrance {{{2
,([lpaste|
@@ -323,6 +331,9 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
, (3, 40, Just 0)
, (9, 54, Just 1)
, (3, 62, Just 1)
+ ], [
+ (40, 0)
+ , (62, 1)
])
-- multiple statements in a row {{{2
,([lpaste|
@@ -364,6 +375,9 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
|], [
(3, 19, Just 0)
, (3, 25, Just 0)
+ ], [
+ (19, 0)
+ , (25, 0)
])
-- return {{{2
,([lpaste|
@@ -417,7 +431,7 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
{
ec_stack_start.ec_frames.c.ec_frames.block.i = 23;
ec_stack_start.ec_frames.c.ec_frames.block.ec_cont = &&ec_label_c_1;
- block(&ec_stack_start.ec_frames.c.ec_frames.block);
+39: block(&ec_stack_start.ec_frames.c.ec_frames.block);
return;
ec_label_c_1:
;
@@ -431,7 +445,7 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
{
ec_stack_start.ec_frames.c.ec_frames.block.i = 42;
ec_stack_start.ec_frames.c.ec_frames.block.ec_cont = &&ec_label_c_2;
- block(&ec_stack_start.ec_frames.c.ec_frames.block);
+53: block(&ec_stack_start.ec_frames.c.ec_frames.block);
return;
ec_label_c_2:
;
@@ -447,32 +461,39 @@ test_print_with_log = enumTestGroup "print_with_log" $ map runTest [
, ( 3, 35, Just 0)
, ( 4, 46, Just 0)
, ( 6, 60, Just 0)
+ ], [
+ (39, 0)
+ , (53, 0)
])
]
-runTest :: (String, String, TLocMap) -> Assertion -- {{{1
-runTest (inputCode, expectedCode, expectedLocMap) =
+runTest :: (String, String, TBreakpoints, TBlockingCalls) -> Assertion -- {{{1
+runTest (inputCode, expectedCode, expectedLocMap, expectedBlockList) =
let ast = enrich inputCode in
case analysis ast of
Left es -> assertFailure $ show_errors "analysis" es
Right (cg, _) ->
let
- ast' = (\(a, _, _)->a) $ transformation cg ast
- (resultCode, resultLocMap) = print_with_log ast'
- resultCode' = BS.unpack resultCode
- resultLocMap' = reduce resultLocMap
+ (ast', _, _) = transformation cg ast
+ (resultCode, resultLocMap, resultBlockList) = print_with_log ast'
+ resultCode' = BS.unpack resultCode
+ resultLocMap' = reduce resultLocMap
+ resultBlockList' = reduce resultBlockList
in do
- expectedCode @=? resultCode'
- let locs = intercalate "\n" $ map show $ everything (++) (mkQ [] traceLocationExpr `extQ` traceLocationStat) ast'
- assertEqual (locs ++ "\n" ++ show resultLocMap) expectedLocMap resultLocMap'
+ let dbg = debug ast'
+ assertEqual "code" expectedCode resultCode'
+ assertEqual "locmap" expectedLocMap resultLocMap'
+ assertEqual ("blocklist: " ++ dbg) expectedBlockList resultBlockList'
where
+ debug ast = intercalate "\n" $ map show $ everything (++) (mkQ [] traceLocationExpr `extQ` traceLocationStat) ast
+
traceLocationExpr :: CExpr' -> [String]
traceLocationExpr expr
- | (enTraceLocation . annotation) expr = [show expr]
+ | (enBlockingCall . annotation) expr = [show expr]
| otherwise = []
traceLocationStat :: CStat' -> [String]
traceLocationStat stmt
- | (enTraceLocation . annotation) stmt = [show stmt]
+ | (enBlockingCall . annotation) stmt = [show stmt]
| otherwise = []
Oops, something went wrong.

0 comments on commit b0cd20a

Please sign in to comment.