Support some clock and reset pragmas in BH/Classic (#624)

Add support for: gate_input_clocks, clock_family, clock_prefix,
gate_prefix, reset_prefix.

Check for duplicate prefix pragmas in PragmaCheck because, unlike BSV,
the Classic parser lets duplicate pragmas through.

Make subdirectory for tests of Classic pragmas, move the existing
Pragmas.bs test there, and add test cases for the new pragmas.

src/comp/Parser/Classic/CParser.hs

@@ -618,6 +618,11 @@ pPragma = l L_lpragma ..+ pPragma'  +.. l L_rpragma
                     ||! literal (mkFString "parameter") ..+ var >>- PPparam . (\i -> [i])
                     ||! literal (mkFString "no_default_clock") .> PPclock_osc  [(idDefaultClock,"")]
                     ||! literal (mkFString "no_default_reset") .> PPreset_port [(idDefaultReset,"")]
+                    ||! literal (mkFString "gate_input_clocks") ..+ eq ..+ l L_lcurl ..+ sepBy varcon cm +.. l L_rcurl >>- PPgate_input_clocks
+                    ||! literal (mkFString "clock_family") ..+ eq ..+ l L_lcurl ..+ sepBy varcon cm +.. l L_rcurl >>- PPclock_family
+                    ||! literal (mkFString "clock_prefix") ..+ eq ..+ varString >>- PPCLK
+                    ||! literal (mkFString "gate_prefix") ..+ eq ..+ varString >>- PPGATE
+                    ||! literal (mkFString "reset_prefix") ..+ eq ..+ varString >>- PPRSTN
         pProps = eq ..+ l L_lcurl ..+ sepBy1 pProp cm +.. l L_rcurl
         pProp = literal (mkFString "alwaysReady") .> PPalwaysReady []
             ||! literal (mkFString "noReady") .> PPalwaysReady []                -- deprecated

src/comp/PragmaCheck.hs

@@ -272,37 +272,45 @@ checkModuleArgPragmas pos pps_orig pps vtis =
     -- given for a default clock/reset
 
         emsg0 =
-            let clk_prefix = listToMaybe [ s | PPCLK s <- pps ]
+            let clk_prefixes = [s | PPCLK s <- pps ]
+                clk_prefix = listToMaybe clk_prefixes
                 ps = filter (modifies idDefaultClock) pps
                 default_clock_osc =
                     listToMaybe $ catMaybes $
                       [ lookup idDefaultClock xs | PPclock_osc xs <- ps ]
-            in  case (clk_prefix, default_clock_osc) of
-                    (Just "", Nothing) ->
+            in  case (clk_prefixes, clk_prefix, default_clock_osc) of
+                    (s:_: _, _, _) ->
+                        Just (pos, EMultipleAttribute $ getModulePragmaName $ PPCLK s)
+                    (_, Just "", Nothing) ->
                         Just (pos, EEmptyPrefixNoPortName
                                        (getIdBaseString idDefaultClock))
                     _ -> Nothing
 
         emsg1 =
-            let gate_prefix = listToMaybe [ s | PPGATE s <- pps ]
+            let gate_prefixes = [ s | PPGATE s <- pps ]
+                gate_prefix = listToMaybe gate_prefixes
                 ps = filter (modifies idDefaultClock) pps
                 default_clock_gate =
                     listToMaybe $ catMaybes $
                       [ lookup idDefaultClock xs | PPclock_gate xs <- ps ]
-            in  case (gate_prefix, default_clock_gate) of
-                    (Just "", Nothing) ->
+            in  case (gate_prefixes, gate_prefix, default_clock_gate) of
+                    (s:_:_, _, _) ->
+                        Just (pos, EMultipleAttribute $ getModulePragmaName $ PPGATE s)
+                    (_, Just "", Nothing) ->
                         Just (pos, EEmptyPrefixNoPortName
                                        (getIdBaseString idDefaultClock))
                     _ -> Nothing
 
         emsg2 =
-            let rst_prefix = listToMaybe [ s | PPRSTN s <- pps ]
+            let rst_prefixes = [ s | PPRSTN s <- pps ]
+                rst_prefix = listToMaybe rst_prefixes
                 ps = filter (modifies idDefaultReset) pps
                 default_reset_port =
                     listToMaybe $ catMaybes $
                       [ lookup idDefaultReset xs | PPreset_port xs <- ps ]
-            in  case (rst_prefix, default_reset_port) of
-                    (Just "", Nothing) ->
+            in  case (rst_prefixes, rst_prefix, default_reset_port) of
+                    (s:_:_, _, _) -> Just (pos, EMultipleAttribute $ getModulePragmaName $ PPRSTN s)
+                    (_, Just "", Nothing) ->
                         Just (pos, EEmptyPrefixNoPortName
                                        (getIdBaseString idDefaultReset))
                     _ -> Nothing

testsuite/bsc.syntax/bh/Makefile

@@ -2,10 +2,4 @@
 
 CONFDIR = $(realpath ../..)
 
-KEEPFILES += \
-	mkPragmas_0_file.txt \
-	mkPragmas_1_file.txt \
-	mkPragmas_2_file.txt \
-	mkPragmas_3_file.txt \
-
 include $(CONFDIR)/clean.mk

testsuite/bsc.syntax/bh/bh.exp

@@ -63,10 +63,6 @@ compile_pass ParseDisplay.bsv
 
 compile_pass StringLit.bs 
 
-# Support for parameter, no_default_clock, and no_default_reset pragmas
-# (fixes Google issue #78233370)
-test_c_veri_bs_modules Pragmas {}
-
 # Top-level defs must have signatures
 # (fixes Google issue #73087150)
 compile_fail_error NoSign.bs T0141

testsuite/bsc.syntax/bh/bh_pragmas/ClockFamily.bs

@@ -0,0 +1,21 @@
+package ClockFamily where
+
+clockedBy :: (IsModule m mType) => Clock -> m a -> m a
+clockedBy c = changeSpecialWires (Just c) Nothing Nothing
+
+interface Ticked =
+  ticked :: Bool
+
+{-# synthesize mkClockFamily {
+  gate_input_clocks = { default_clock },
+  clock_family = { default_clock, ungated } } #-}
+mkClockFamily :: (IsModule m mType) => Clock -> m Ticked
+mkClockFamily ungated = module
+  toggle :: Reg Bool <- mkReg False
+  toggle_delay :: Reg Bool <- clockedBy ungated $ mkRegU
+
+  rules
+    "toggle": when True ==> toggle := not toggle
+    "watch": when True ==> toggle_delay := toggle
+  interface Ticked
+    ticked = toggle_delay /= toggle

testsuite/bsc.syntax/bh/bh_pragmas/DoubleClockPrefix.bs

@@ -0,0 +1,14 @@
+package DoubleClockPrefix where
+
+{-# synthesize sysDoubleClockPrefix {
+  gate_input_clocks = { default_clock },
+  clock_prefix = "clk",
+  clock_prefix = "c",
+  gate_prefix = "gate",
+  reset_prefix = "rst" } #-}
+sysDoubleClockPrefix :: (IsModule m mType) => m Empty
+sysDoubleClockPrefix = module
+  r :: Reg (UInt 16) <- mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/DoubleGatePrefix.bs

@@ -0,0 +1,14 @@
+package DoubleGatePrefix where
+
+{-# synthesize sysDoubleGatePrefix {
+  gate_input_clocks = { default_clock },
+  clock_prefix = "clk",
+  gate_prefix = "gate",
+  gate_prefix = "g",
+  reset_prefix = "rst" } #-}
+sysDoubleGatePrefix :: (IsModule m mType) => m Empty
+sysDoubleGatePrefix = module
+  r :: Reg (UInt 16) <- mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/DoubleResetPrefix.bs

@@ -0,0 +1,14 @@
+package DoubleResetPrefix where
+
+{-# synthesize sysDoubleResetPrefix {
+  gate_input_clocks = { default_clock },
+  clock_prefix = "clk",
+  gate_prefix = "gate",
+  reset_prefix = "rst",
+  reset_prefix = "r" } #-}
+sysDoubleResetPrefix :: (IsModule m mType) => m Empty
+sysDoubleResetPrefix = module
+  r :: Reg (UInt 16) <- mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/GateDefaultClock.bs

@@ -0,0 +1,9 @@
+package GateDefaultClock where
+
+{-# synthesize sysGateDefaultClock { gate_input_clocks = { default_clock } } #-}
+sysGateDefaultClock :: (IsModule m mType) => m Empty
+sysGateDefaultClock = module
+  r :: Reg (UInt 16) <- mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/GateExplicitClock.bs

@@ -0,0 +1,19 @@
+package GateExplicitClock where
+
+clockedBy :: (IsModule m mType) => Clock -> m a -> m a
+clockedBy c = changeSpecialWires (Just c) Nothing Nothing
+
+resetBy :: (IsModule m mType) => Reset -> m a -> m a
+resetBy r = changeSpecialWires Nothing (Just r) Nothing
+
+{-# synthesize sysGateExplicitClock {
+     no_default_clock,
+     no_default_reset,
+     gate_input_clocks = { clk } } #-}
+
+sysGateExplicitClock :: (IsModule m mType) => Clock -> Reset -> m Empty
+sysGateExplicitClock clk rst = module
+  r :: Reg (UInt 16) <- clockedBy clk $ resetBy rst $ mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/GateUnknownClock.bs

@@ -0,0 +1,17 @@
+package GateUnknownClock where
+
+clockedBy :: (IsModule m mType) => Clock -> m a -> m a
+clockedBy c = changeSpecialWires (Just c) Nothing Nothing
+
+resetBy :: (IsModule m mType) => Reset -> m a -> m a
+resetBy r = changeSpecialWires Nothing (Just r) Nothing
+
+{-# synthesize sysGateUnknownClock {
+     gate_input_clocks = { gated } } #-}
+
+sysGateUnknownClock :: (IsModule m mType) => Clock -> Reset -> m Empty
+sysGateUnknownClock clk rst = module
+  r :: Reg (UInt 16) <- clockedBy clk $ resetBy rst $ mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/Makefile

@@ -0,0 +1,11 @@
+# for "make clean" to work everywhere
+
+CONFDIR = $(realpath ../../..)
+
+KEEPFILES += \
+	mkPragmas_0_file.txt \
+	mkPragmas_1_file.txt \
+	mkPragmas_2_file.txt \
+	mkPragmas_3_file.txt \
+
+include $(CONFDIR)/clean.mk

testsuite/bsc.syntax/bh/bh_pragmas/NoClockFamily.bs

@@ -0,0 +1,19 @@
+package NoClockFamily where
+
+clockedBy :: (IsModule m mType) => Clock -> m a -> m a
+clockedBy c = changeSpecialWires (Just c) Nothing Nothing
+
+interface Ticked =
+  ticked :: Bool
+
+{-# synthesize mkNoClockFamily { gate_input_clocks = { default_clock } } #-}
+mkNoClockFamily :: (IsModule m mType) => Clock -> m Ticked
+mkNoClockFamily ungated = module
+  toggle :: Reg Bool <- mkReg False
+  toggle_delay :: Reg Bool <- clockedBy ungated $ mkRegU
+
+  rules
+    "toggle": when True ==> toggle := not toggle
+    "watch": when True ==> toggle_delay := toggle
+  interface Ticked
+    ticked = toggle_delay /= toggle

testsuite/bsc.syntax/bh/bh_pragmas/Prefixes.bs

@@ -0,0 +1,13 @@
+package Prefixes where
+
+{-# synthesize sysPrefixes {
+  gate_input_clocks = { default_clock },
+  clock_prefix = "clk",
+  gate_prefix = "gate",
+  reset_prefix = "rst" } #-}
+sysPrefixes :: (IsModule m mType) => m Empty
+sysPrefixes = module
+  r :: Reg (UInt 16) <- mkReg 0
+  rules
+    "test": when True ==>
+      r := r + 1

testsuite/bsc.syntax/bh/bh_pragmas/UnknownClockFamily.bs

@@ -0,0 +1,21 @@
+package UnknownClockFamily where
+
+clockedBy :: (IsModule m mType) => Clock -> m a -> m a
+clockedBy c = changeSpecialWires (Just c) Nothing Nothing
+
+interface Ticked =
+  ticked :: Bool
+
+{-# synthesize mkUnknownClockFamily {
+  gate_input_clocks = { default_clock },
+  clock_family = { default_clock, ungated } } #-}
+mkUnknownClockFamily :: (IsModule m mType) => Clock -> m Ticked
+mkUnknownClockFamily c = module
+  toggle :: Reg Bool <- mkReg False
+  toggle_delay :: Reg Bool <- clockedBy c $ mkRegU
+
+  rules
+    "toggle": when True ==> toggle := not toggle
+    "watch": when True ==> toggle_delay := toggle
+  interface Ticked
+    ticked = toggle_delay /= toggle

testsuite/bsc.syntax/bh/bh_pragmas/bh_pragmas.exp

@@ -0,0 +1,32 @@
+# Support for parameter, no_default_clock, and no_default_reset pragmas
+# (fixes Google issue #78233370)
+test_c_veri_bs_modules Pragmas {}
+
+compile_verilog_pass GateDefaultClock.bs
+compare_verilog sysGateDefaultClock.v
+
+compile_verilog_pass GateExplicitClock.bs
+compare_verilog sysGateExplicitClock.v
+
+compile_verilog_fail_error GateUnknownClock.bs P0182
+find_n_strings GateUnknownClock.bs.bsc-vcomp-out gated 1
+
+compile_verilog_fail_error NoClockFamily.bs G0007 2
+
+compile_verilog_pass ClockFamily.bs
+compare_verilog mkClockFamily.v
+
+compile_verilog_fail_error UnknownClockFamily.bs P0182
+find_n_strings UnknownClockFamily.bs.bsc-vcomp-out ungated 1
+
+compile_verilog_pass Prefixes.bs
+compare_verilog sysPrefixes.v
+
+compile_fail_error DoubleClockPrefix.bs P0156
+find_n_strings DoubleClockPrefix.bs.bsc-out clock_prefix 1
+
+compile_fail_error DoubleGatePrefix.bs P0156
+find_n_strings DoubleGatePrefix.bs.bsc-out gate_prefix 1
+
+compile_fail_error DoubleResetPrefix.bs P0156
+find_n_strings DoubleResetPrefix.bs.bsc-out reset_prefix 1