------------------------------------------------------------------------------- --- $Id: Gates.hs#8 2010/09/21 16:53:24 REDMOND\\satnams $ ------------------------------------------------------------------------------- -- | This Lava.Gates module provides a collection of Xilinx low-level -- components. module Lava.Gates (module Lava.Gates) where import Lava.Netlist import Lava.LUTGates import Lava.PrimitiveGates -- * Lava Gates -- ** LUT-based gates ------------------------------------------------------------------------------- --- LUT-based gates ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- | The 'inv' function implements an invertor explicitly with a LUT1. inv :: Bit -- ^ The input i0 -> Out Bit -- ^ The output o inv = unaryLUT not "inv" ------------------------------------------------------------------------------- -- | The 'and2' function implements an AND gate explicitly with a LUT2. and2 :: (Bit, Bit) -- ^ inputs (i0, i1) -> Out Bit -- ^ output o and2 = binaryLUT (&&) "and2" ------------------------------------------------------------------------------- -- | The 'or2' function implements an OR gate explicitly with a LUT2. or2 :: (Bit, Bit) -- ^ inputs (i0, i1) -> Out Bit -- ^ output o or2 = binaryLUT (||) "or" ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- | The 'nor2' function implements an NOR gate explicitly with a LUT2. nor2 :: (Bit, Bit) -- ^ inputs (i0, i1) -> Out Bit -- ^ output o nor2 = binaryLUT (\i0 i1 -> not (i0 || i1)) "nor" ------------------------------------------------------------------------------- -- | The 'xor2' function implements an XOR gate explicitly with a LUT2. xor2 :: (Bit, Bit) -- ^ inputs (i0, i1) -> Out Bit -- ^ output o xor2 = binaryLUT (/=) "xor" ------------------------------------------------------------------------------- -- | The 'xnor2' function implements an XOR gate explicitly with a LUT2. xnor2 :: (Bit, Bit) -- ^ inputs (i0, i1) -> Out Bit -- ^ output o xnor2 = binaryLUT (==) "nxor" ------------------------------------------------------------------------------- -- ** Carry-chain elements ------------------------------------------------------------------------------- --- CARRY CHAIN ELEMENTS ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- muxcy :: Bit -- ^ ci -> Bit -- ^ di -> Bit -- ^ s -> Out Bit -- ^ o muxcy ci di s = do [o] <- primitiveGate "muxcy" [("ci",ci), ("di", di), ("s", s)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- muxcy_d :: Bit -> Bit -> Bit -> Out (Bit, Bit) muxcy_d ci di s = do [o, lo] <- primitiveGate "muxcy_d" [("ci",ci), ("di", di), ("s", s)] ["o", "lo"] (Just (1,1)) return (o, lo) ------------------------------------------------------------------------------- muxcy_l :: Bit -> Bit -> Bit -> Out Bit muxcy_l ci di s = do [o] <- primitiveGate "muxcy_l" [("ci",ci), ("di", di), ("s", s)] ["o", "lo"] (Just (1,1)) return o ------------------------------------------------------------------------------- muxf5 :: Bit -> Bit -> Bit -> Out Bit muxf5 i0 i1 s = do [o] <- primitiveGate "muxf5" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- muxf5_d :: Bit -> Bit -> Bit -> Out (Bit, Bit) muxf5_d i0 i1 s = do [o, lo] <- primitiveGate "muxf5_d" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return (o, lo) ------------------------------------------------------------------------------- muxf5_l :: Bit -> Bit -> Bit -> Out Bit muxf5_l i0 i1 s = do [lo] <- primitiveGate "muxf5_l" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return lo ------------------------------------------------------------------------------- muxf6 :: Bit -> Bit -> Bit -> Out Bit muxf6 i0 i1 s = do [o] <- primitiveGate "muxf6" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- muxf6_d :: Bit -> Bit -> Bit -> Out (Bit, Bit) muxf6_d i0 i1 s = do [o, lo] <- primitiveGate "muxf6_d" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return (o, lo) ------------------------------------------------------------------------------- muxf6_l :: Bit -> Bit -> Bit -> Out Bit muxf6_l i0 i1 s = do [lo] <- primitiveGate "muxf6_l" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return lo ------------------------------------------------------------------------------- muxf7 :: Bit -> Bit -> Bit -> Out Bit muxf7 i0 i1 s = do [o] <- primitiveGate "muxf7" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- muxf7_d :: Bit -> Bit -> Bit -> Out (Bit, Bit) muxf7_d i0 i1 s = do [o, lo] <- primitiveGate "muxf7_d" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return (o, lo) ------------------------------------------------------------------------------- muxf7_l :: Bit -> Bit -> Bit -> Out Bit muxf7_l i0 i1 s = do [lo] <- primitiveGate "muxf7_l" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return lo ------------------------------------------------------------------------------- muxf8 :: Bit -> Bit -> Bit -> Out Bit muxf8 i0 i1 s = do [o] <- primitiveGate "muxf8" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- muxf8_d :: Bit -> Bit -> Bit -> Out (Bit, Bit) muxf8_d i0 i1 s = do [o, lo] <- primitiveGate "muxf8_d" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return (o, lo) ------------------------------------------------------------------------------- muxf8_l :: Bit -> Bit -> Bit -> Out Bit muxf8_l i0 i1 s = do [lo] <- primitiveGate "muxf8_l" [("i0",i0), ("i1", i1), ("s", s)] ["o"] (Just (1,1)) return lo ------------------------------------------------------------------------------- xorcy :: Bit -> Bit -> Out Bit xorcy ci li = do [o] <- primitiveGate "xorcy" [("ci",ci), ("li", li)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- xorcy_d :: Bit -> Bit -> Out (Bit, Bit) xorcy_d ci li = do [o, lo] <- primitiveGate "xorcy_d" [("ci",ci), ("li", li)] ["o"] (Just (1,1)) return (o, lo) ------------------------------------------------------------------------------- xorcy_l :: Bit -> Bit -> Out Bit xorcy_l ci li = do [lo] <- primitiveGate "xorcy_l" [("ci",ci), ("li", li)] ["o"] (Just (1,1)) return lo ------------------------------------------------------------------------------- -- ** Flip-flops ------------------------------------------------------------------------------- --- FLIP-FLOPS ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- fd :: Bit -> Bit -> Out Bit fd clk i = do [q] <- primitiveGate "fd" [("c",clk), ("d", i)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdc :: Bit -> Bit -> Bit -> Out Bit fdc clk clr i = do [q] <- primitiveGate "fdc" [("c",clk), ("clr", clr), ("d", i)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdc_1 :: Bit -> Bit -> Bit -> Out Bit fdc_1 clk clr i = do [q] <- primitiveGate "fdc_1" [("c",clk), ("clr", clr), ("d", i)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdce :: Bit -> Bit -> Bit -> Bit -> Out Bit fdce clk ce clr d = do [q] <- primitiveGate "fdce" [("c",clk), ("clr", clr), ("d", d), ("ce", ce)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdce_1 :: Bit -> Bit -> Bit -> Bit -> Out Bit fdce_1 clk ce clr d = do [q] <- primitiveGate "fdce_1" [("c",clk), ("clr", clr), ("d", d), ("ce", ce)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdcp :: Bit -> Bit -> Bit -> Bit -> Out Bit fdcp clk clr pre d = do [q] <- primitiveGate "fdcp" [("c",clk), ("clr", clr), ("d", d), ("pre", pre)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdcpe :: Bit -> Bit -> Bit -> Bit -> Bit -> Out Bit fdcpe clk ce clr pre d = do [q] <- primitiveGate "fdcpe" [("c",clk), ("clr", clr), ("d", d), ("pre", pre), ("ce",ce)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- fdcpe_1 :: Bit -> Bit -> Bit -> Bit -> Bit -> Out Bit fdcpe_1 clk ce clr pre d = do [q] <- primitiveGate "fdcpe_1" [("c",clk), ("clr", clr), ("d", d), ("pre", pre), ("ce",ce)] ["q"] (Just (1,1)) return q ------------------------------------------------------------------------------- -- ** Shift-register primitives ------------------------------------------------------------------------------- -- | 16-bit shift register look-up table with clock enable srl16e :: Bit -- ^ d -> Bit -- ^ clk -> Bit -- ^ ce -> Bit -- ^ a0 -> Bit -- ^ a1 -> Bit -- ^ a2 -> Bit -- ^ a3 -> Out Bit -- ^ q srl16e d clk ce a0 a1 a2 a3 = do [q] <- primitiveGate "srl16e" [("c",clk), ("ce",ce), ("a0",a0), ("a1",a1), ("a2",a2), ("a3",a3)] ["q"] Nothing return q ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- ** Gates implemented in place of a slice latch ------------------------------------------------------------------------------- -- | Two input and gate implemented in place of a slice latch and2b1l :: Bit -- ^ di -> Bit -- ^ sri -> Out Bit -- ^ o and2b1l di sri = do [o] <- primitiveGate "and2b1l" [("di",di), ("sri", sri)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- -- | Two input and gate implemented in place of a slice latch or2l :: Bit -- ^ di -> Bit -- ^ sri -> Out Bit -- ^ o or2l di sri = do [o] <- primitiveGate "or2l" [("di",di), ("sri", sri)] ["o"] (Just (1,1)) return o ------------------------------------------------------------------------------- -- ** Buffers ------------------------------------------------------------------------------- --- BUFFERS ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- | Dedicated input clock buffer ibufg :: Bit -- ^ i -> Out Bit -- ^ o ibufg i = do [o] <- primitiveGate "ibufg" [("i", i)] ["o"] Nothing return o ------------------------------------------------------------------------------- -- | Global clock buffer bufg :: Bit -- ^ i -> Out Bit -- ^ o bufg i = do [o] <- primitiveGate "bufg" [("i", i)] ["o"] Nothing return o ------------------------------------------------------------------------------- -- | Global clock buffer bufgp :: Bit -- ^ i -> Out Bit -- ^ o bufgp i = do [o] <- primitiveGate "bufgp" [("i", i)] ["o"] Nothing return o ------------------------------------------------------------------------------- -- | Output buffer obufg :: Bit -- ^ i -> Out Bit -- ^ o obufg i = do [o] <- primitiveGate "obuf" [("i", i)] ["o"] Nothing return o ------------------------------------------------------------------------------- -- ** Double data rate (DDR) components ------------------------------------------------------------------------------- -- | Output buffer obufds :: Bit -- ^ i -> Out (Bit, Bit) -- ^ (o, ob) obufds i = do [o, ob] <- primitiveGate "bufds" [("i", i)] ["o", "ob"] Nothing return (o, ob) -------------------------------------------------------------------------------