From 546657d2c366002f4cb4d6eefc8a6c2e2b1b5390 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 21 Feb 2019 20:12:34 -0500 Subject: [PATCH] added (very hacky) PackedArrayFlatten conversion; convert logics in generate --- Convert.hs | 2 + Convert/Logic.hs | 19 +++ Convert/PackedArrayFlatten.hs | 271 ++++++++++++++++++++++++++++++++++ Language/SystemVerilog/AST.hs | 5 +- sv2v.cabal | 1 + 5 files changed, 296 insertions(+), 2 deletions(-) create mode 100644 Convert/PackedArrayFlatten.hs diff --git a/Convert.hs b/Convert.hs index 21651c1..2df5068 100644 --- a/Convert.hs +++ b/Convert.hs @@ -11,6 +11,7 @@ import Language.SystemVerilog.AST import qualified Convert.AlwaysKW import qualified Convert.Logic import qualified Convert.Typedef +import qualified Convert.PackedArrayFlatten import qualified Convert.StarPort type Phase = AST -> AST @@ -20,6 +21,7 @@ phases = [ Convert.AlwaysKW.convert , Convert.Logic.convert , Convert.Typedef.convert + , Convert.PackedArrayFlatten.convert , Convert.StarPort.convert ] diff --git a/Convert/Logic.hs b/Convert/Logic.hs index cd8bdcb..f464bf4 100644 --- a/Convert/Logic.hs +++ b/Convert/Logic.hs @@ -13,6 +13,7 @@ module Convert.Logic (convert) where +import Data.Maybe (fromJust) import qualified Data.Set as Set import Language.SystemVerilog.AST @@ -59,4 +60,22 @@ convertModuleItem idents (LocalNet (Logic mr) ident val) = LocalNet (t mr) ident val where t = if Set.member ident idents then Reg else Wire +convertModuleItem idents (Generate items) = Generate $ map (convertGenItem $ convertModuleItem idents) items convertModuleItem _ other = other + +convertGenItem :: (ModuleItem -> ModuleItem) -> GenItem -> GenItem +convertGenItem f item = convertGenItem' item + where + convertGenItem' :: GenItem -> GenItem + convertGenItem' (GenBlock x items) = GenBlock x $ map convertGenItem' items + convertGenItem' (GenFor a b c d items) = GenFor a b c d $ map convertGenItem' items + convertGenItem' (GenIf e i1 i2) = GenIf e (convertGenItem' i1) (convertGenItem' i2) + convertGenItem' (GenNull) = GenNull + convertGenItem' (GenModuleItem moduleItem) = GenModuleItem $ f moduleItem + convertGenItem' (GenCase e cases def) = GenCase e cases' def' + where + cases' = zip (map fst cases) (map (convertGenItem' . snd) cases) + def' = if def == Nothing + then Nothing + else Just $ convertGenItem' $ fromJust def + diff --git a/Convert/PackedArrayFlatten.hs b/Convert/PackedArrayFlatten.hs new file mode 100644 index 0000000..4faa493 --- /dev/null +++ b/Convert/PackedArrayFlatten.hs @@ -0,0 +1,271 @@ +{- sv2v + - Author: Zachary Snow + - + - Conversion for flattening multi-dimensional packed arrays + - + - To simplify the code, this only removes one dimension per identifier at a + - time. Because the conversions are repeatedly applied until convergence, this + - will eventually remove all the extra packed dimensions. + - + - TODO FIXME XXX: We don't actually have support for more than 2 dimensions + - right now. I don't think the parser can even handle that. This isn't + - something that should be too common, so maybe we can hold off on that for + - now. + - + - TODO FIXME XXX: This does not yet identify and flatten candidates that are + - themselves contained inside of generate blocks. + - + - TODO FIXME XXX: This actually assumes that the first range index is the upper + - bound. We could get arround this with a generate block. + -} + +module Convert.PackedArrayFlatten (convert) where + +-- Note that, for now, only wire/reg/logic/alias can have multiple packed +-- dimensions. This means all such transformations are for module items, though +-- we must of course change uses of these items in non-constant expressions, +-- which we, unfortunately, do not distinguish from constant expressions in the +-- AST. + +import Data.Maybe +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set + +import Language.SystemVerilog.AST + +type DimMap = Map.Map Identifier (Type, Range) + +convert :: AST -> AST +convert = map convertDescription + +convertDescription :: Description -> Description +convertDescription (Module name ports items) = + Module name ports $ items' ++ unflatteners + where + toFlatten = mapMaybe getExtraDims items + dimMap = Map.fromList toFlatten + items' = map (convertModuleItem dimMap) items + unflatteners = concat $ map (unflattener outputs) toFlatten + outputs = Set.fromList $ mapMaybe getOutput items + getOutput :: ModuleItem -> Maybe Identifier + getOutput (PortDecl Output _ ident) = Just ident + getOutput _ = Nothing + getExtraDims :: ModuleItem -> Maybe (Identifier, (Type, Range)) + getExtraDims (LocalNet t ident _) = + if length rs > 1 + then Just (ident, (tf $ tail rs, head rs)) + else Nothing + where (tf, rs) = typeDims t + getExtraDims _ = Nothing +convertDescription other = other + +unflattener :: Set.Set Identifier -> (Identifier, (Type, Range)) -> [ModuleItem] +unflattener outputs (arr, (t, (a, b))) = + [ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr + , LocalNet t arrUnflat (Left [(a, b)]) + , Generate + [ GenModuleItem $ Genvar index + , GenModuleItem $ MIIntegerV $ IntegerV (arrUnflat ++ "_repeater_index") (Right Nothing) + , localparam hi a + , localparam lo b + , localparam size + (BinOp Add (BinOp Sub bigHi bigLo) (Number "1")) + , GenFor + (index, Ident lo) + (BinOp Le (Ident index) (Ident hi)) + (index, BinOp Add (Ident index) (Number "1")) + (prefix "unflatten") + [ localparam startBit + (BinOp Add (Ident lo) + (BinOp Mul (Ident index) (Ident size))) + , GenModuleItem $ (uncurry Assign) $ + if Set.notMember arr outputs + then (LHSBit arrUnflat $ Ident index, IdentRange arr origRange) + else (LHSRange arr origRange, IdentBit arrUnflat $ Ident index) + ] + ] + ] + where + startBit = prefix "__START_BIT" + size = prefix "__SIZE" + arrUnflat = prefix arr + index = prefix "__index" + hi = prefix "__hi" + lo = prefix "__lo" + (bigHi, bigLo) = head $ snd $ typeDims t + localparam :: Identifier -> Expr -> GenItem + localparam x v = GenModuleItem $ MILocalparam $ Localparam Nothing x v + origRange = ( (BinOp Add (Ident startBit) + (BinOp Sub (Ident size) (Number "1"))) + , Ident startBit ) + +typeDims :: Type -> ([Range] -> Type, [Range]) +typeDims (Reg r) = (Reg , r) +typeDims (Wire r) = (Wire , r) +typeDims (Logic r) = (Logic , r) +typeDims (Alias t r) = (Alias t, r) + +prefix :: Identifier -> Identifier +prefix ident = "__sv2v_PAF_" ++ ident + +rewriteRangesOrAssignment :: DimMap -> RangesOrAssignment -> RangesOrAssignment +rewriteRangesOrAssignment dimMap (Right (Just e)) = + Right $ Just $ rewriteExpr dimMap e +rewriteRangesOrAssignment _ other = other + +rewriteRange :: DimMap -> Range -> Range +rewriteRange dimMap (a, b) = (r a, r b) + where r = rewriteExpr dimMap + +rewriteIdentifier :: DimMap -> Identifier -> Identifier +rewriteIdentifier dimMap x = + if Map.member x dimMap + then prefix x + else x + +rewriteExpr :: DimMap -> Expr -> Expr +rewriteExpr dimMap = rewriteExpr' + where + ri :: Identifier -> Identifier + ri = rewriteIdentifier dimMap + re = rewriteExpr' + rewriteExpr' :: Expr -> Expr + rewriteExpr' (String s) = String s + rewriteExpr' (Number s) = Number s + rewriteExpr' (ConstBool b) = ConstBool b + rewriteExpr' (Ident i ) = Ident (ri i) + rewriteExpr' (IdentRange i (r @ (s, e))) = + case Map.lookup i dimMap of + Nothing -> IdentRange (ri i) (rewriteRange dimMap r) + Just (t, _) -> + IdentRange i (s', e') + where + (a, b) = head $ snd $ typeDims t + size = BinOp Add (BinOp Sub a b) (Number "1") + s' = BinOp Sub (BinOp Mul size (BinOp Add s (Number "1"))) (Number "1") + e' = BinOp Mul size e + rewriteExpr' (IdentBit i e) = IdentBit (ri i) (re e) + rewriteExpr' (Repeat e l) = Repeat (re e) (map re l) + rewriteExpr' (Concat l ) = Concat (map re l) + rewriteExpr' (Call f l) = Call f (map re l) + rewriteExpr' (UniOp o e) = UniOp o (re e) + rewriteExpr' (BinOp o e1 e2) = BinOp o (re e1) (re e2) + rewriteExpr' (Mux e1 e2 e3) = Mux (re e1) (re e2) (re e3) + rewriteExpr' (Bit e n) = Bit (re e) n + +flattenRanges :: [Range] -> [Range] +flattenRanges rs = + if length rs >= 2 + then rs' + else error $ "flattenRanges on too small list: " ++ (show rs) + where + (s1, e1) = head rs + (s2, e2) = head $ tail rs + size1 = BinOp Add (BinOp Sub s1 e1) (Number "1") + size2 = BinOp Add (BinOp Sub s2 e2) (Number "1") + upper = BinOp Add (BinOp Mul size1 size2) (BinOp Sub e1 (Number "1")) + r' = (upper, e1) + rs' = (tail $ tail rs) ++ [r'] + +rewriteLHS :: DimMap -> LHS -> LHS +rewriteLHS dimMap (LHS x ) = LHS (rewriteIdentifier dimMap x) +rewriteLHS dimMap (LHSBit x e) = LHSBit (rewriteIdentifier dimMap x) (rewriteExpr dimMap e) +rewriteLHS dimMap (LHSRange x r) = LHSRange (rewriteIdentifier dimMap x) (rewriteRange dimMap r) +rewriteLHS dimMap (LHSConcat ls) = LHSConcat $ map (rewriteLHS dimMap) ls + +rewriteStmt :: DimMap -> Stmt -> Stmt +rewriteStmt dimMap orig = rs orig + where + rs :: Stmt -> Stmt + rs (Block decls stmts) = Block decls (map rs stmts) + rs (Case e cases def) = Case e' cases' def' + where + re :: Expr -> Expr + re = rewriteExpr dimMap + rc :: Case -> Case + rc (exprs, stmt) = (map re exprs, rs stmt) + e' = re e + cases' = map rc cases + def' = + case def of + Nothing -> Nothing + Just stmt -> Just $ rs stmt + rs (BlockingAssignment lhs expr) = convertAssignment BlockingAssignment lhs expr + rs (NonBlockingAssignment lhs expr) = convertAssignment NonBlockingAssignment lhs expr + rs (For (x1, e1) cc (x2, e2) stmt) = For (x1, e1') cc' (x2, e2') (rs stmt) + where + e1' = rewriteExpr dimMap e1 + e2' = rewriteExpr dimMap e2 + cc' = rewriteExpr dimMap cc + rs (If cc s1 s2) = If (rewriteExpr dimMap cc) (rs s1) (rs s2) + rs (Timing sense stmt) = Timing sense (rs stmt) + rs (Null) = Null + convertAssignment :: (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt + convertAssignment constructor (lhs @ (LHS ident)) (expr @ (Repeat _ exprs)) = + case Map.lookup ident dimMap of + Nothing -> constructor (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr) + Just (_, (a, b)) -> + For inir chkr incr assign + where + index = prefix $ ident ++ "_repeater_index" + assign = constructor + (LHSBit (prefix ident) (Ident index)) + (Concat exprs) + inir = (index, b) + chkr = BinOp Le (Ident index) a + incr = (index, BinOp Add (Ident index) (Number "1")) + convertAssignment constructor lhs expr = + constructor (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr) + +convertModuleItem :: DimMap -> ModuleItem -> ModuleItem +convertModuleItem dimMap (LocalNet t x val) = + if Map.member x dimMap + then LocalNet t' x val' + else LocalNet t x val' + where + (tf, rs) = typeDims t + t' = tf $ flattenRanges rs + val' = rewriteRangesOrAssignment dimMap val +convertModuleItem dimMap (PortDecl dir rs x) = + if Map.member x dimMap + then PortDecl dir (flattenRanges rs) x + else PortDecl dir rs x +convertModuleItem dimMap (Generate items) = + Generate $ map (convertGenItem dimMap) items +convertModuleItem dimMap (Assign lhs expr) = + Assign (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr) +convertModuleItem dimMap (AlwaysC kw stmt) = + AlwaysC kw (rewriteStmt dimMap stmt) +convertModuleItem dimMap (Function ret f decls stmt) = + Function ret f decls (rewriteStmt dimMap stmt) +convertModuleItem _ (Instance m params x Nothing) = + Instance m params x Nothing +convertModuleItem dimMap (Instance m params x (Just l)) = + Instance m params x $ Just $ map convertPortBinding l + where + convertPortBinding :: PortBinding -> PortBinding + convertPortBinding (p, Nothing) = (p, Nothing) + convertPortBinding (p, Just e) = (p, Just $ rewriteExpr dimMap e) +convertModuleItem _ (Comment x) = Comment x +convertModuleItem _ (Genvar x) = Genvar x +convertModuleItem _ (MIParameter x) = MIParameter x +convertModuleItem _ (MILocalparam x) = MILocalparam x +convertModuleItem _ (MIIntegerV x) = MIIntegerV x + +convertGenItem :: DimMap -> GenItem -> GenItem +convertGenItem dimMap item = convertGenItem' item + where + f :: ModuleItem -> ModuleItem + f = convertModuleItem dimMap + convertGenItem' :: GenItem -> GenItem + convertGenItem' (GenBlock x items) = GenBlock x $ map convertGenItem' items + convertGenItem' (GenFor a b c d items) = GenFor a b c d $ map convertGenItem' items + convertGenItem' (GenIf e i1 i2) = GenIf e (convertGenItem' i1) (convertGenItem' i2) + convertGenItem' (GenNull) = GenNull + convertGenItem' (GenModuleItem moduleItem) = GenModuleItem $ f moduleItem + convertGenItem' (GenCase e cases def) = GenCase e cases' def' + where + cases' = zip (map fst cases) (map (convertGenItem' . snd) cases) + def' = if def == Nothing + then Nothing + else Just $ convertGenItem' $ fromJust def diff --git a/Language/SystemVerilog/AST.hs b/Language/SystemVerilog/AST.hs index 0b149b6..0bb62ee 100644 --- a/Language/SystemVerilog/AST.hs +++ b/Language/SystemVerilog/AST.hs @@ -21,6 +21,7 @@ module Language.SystemVerilog.AST , Case , Range , GenCase + , RangesOrAssignment ) where import Data.List @@ -322,7 +323,7 @@ commas = intercalate ", " instance Show Stmt where show (Block Nothing b ) = printf "begin\n%s\nend" $ indent $ unlines' $ map show b - show (Block (Just (a, i)) b ) = printf "begin : %s\n%s%s\nend" a $ indent $ unlines' $ (map show i ++ map show b) + show (Block (Just (a, i)) b ) = printf "begin : %s\n%s\nend" a $ indent $ unlines' $ (map show i ++ map show b) show (Case a b Nothing ) = printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) show (Case a b (Just c) ) = printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c) show (BlockingAssignment a b ) = printf "%s = %s;" (show a) (show b) @@ -335,7 +336,7 @@ instance Show Stmt where data BlockItemDeclaration -- TODO: Maybe BIDReg should use [Range] for the first arg as well, but it's - -- really not clear to me what useful purpose this would have. + -- really not clear to me what *useful* purpose this would have. = BIDReg (Maybe Range) Identifier [Range] | BIDParameter Parameter | BIDLocalparam Localparam diff --git a/sv2v.cabal b/sv2v.cabal index 9acd2aa..ca6c252 100644 --- a/sv2v.cabal +++ b/sv2v.cabal @@ -62,6 +62,7 @@ executable sv2v Convert Convert.AlwaysKW Convert.Logic + Convert.PackedArrayFlatten Convert.StarPort Convert.Typedef Convert.Template.ModuleItem