summaryrefslogtreecommitdiff
path: root/testsuite/gna/sr2940
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/gna/sr2940')
-rw-r--r--testsuite/gna/sr2940/GCD.vhd203
-rw-r--r--testsuite/gna/sr2940/Prim.vhd80
-rwxr-xr-xtestsuite/gna/sr2940/testsuite.sh10
3 files changed, 293 insertions, 0 deletions
diff --git a/testsuite/gna/sr2940/GCD.vhd b/testsuite/gna/sr2940/GCD.vhd
new file mode 100644
index 0000000..509b721
--- /dev/null
+++ b/testsuite/gna/sr2940/GCD.vhd
@@ -0,0 +1,203 @@
+-- module GCD where
+--
+--
+-- $wmygcd::*Int# -> *Int# -> *Int#
+-- $wmygcd ww ww1 =
+-- let wild::GHC.Types.Bool = (GHC.Prim.==# ww ww1) in
+-- case wild of :: *Int#
+-- GHC.Types.False ->
+-- let wild1::GHC.Types.Bool = (GHC.Prim.<# ww ww1) in
+-- case wild1 of :: *Int#
+-- GHC.Types.False -> ($wmygcd (GHC.Prim.-# ww ww1) ww1)
+-- GHC.Types.True -> ($wmygcd ww (GHC.Prim.-# ww1 ww))
+-- GHC.Types.True -> ww
+--
+-- mygcd::GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
+-- mygcd w w1 =
+-- let w2::GHC.Types.Int = w in
+-- case w2 of :: GHC.Types.Int
+-- GHC.Types.I# ww::*Int# ->
+-- let w3::GHC.Types.Int = w1 in
+-- case w3 of :: GHC.Types.Int
+-- GHC.Types.I# ww1::*Int# ->
+-- let ww2::*Int# = ($wmygcd ww ww1) in
+-- case ww2 of :: GHC.Types.Int DEFAULT -> (GHC.Types.I# ww2)
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use work.\Prim\.all;
+
+package \GCD\ is
+end \GCD\;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use work.\Prim\.all;
+use work.\GCD\.all;
+
+entity \$wmygcd\ is
+ port (clk : in std_logic;
+ s1_call : in std_logic;
+ s1_ret : out std_logic;
+ s1_ww : in \Int#\;
+ s1_ww1 : in \Int#\;
+ res : out \Int#\);
+end entity;
+
+architecture rtl of \$wmygcd\ is
+ signal tail_call : std_logic;
+ signal tail_ww : \Int#\;
+ signal tail_ww1 : \Int#\;
+ signal core_call : std_logic;
+ signal core_ret : std_logic;
+ signal core_ww : \Int#\;
+ signal core_ww1 : \Int#\;
+ signal s1_act : std_logic;
+ signal s1_wait : std_logic;
+ signal s1_saved_ww : \Int#\;
+ signal s1_saved_ww1 : \Int#\;
+begin
+ process (core_call, core_ww, core_ww1)
+ variable wild : \GHC.Types.Bool\;
+ variable wild1 : \GHC.Types.Bool\;
+ variable ww : \Int#\;
+ variable ww1 : \Int#\;
+ begin
+ ww := core_ww;
+ ww1 := core_ww1;
+ wild := \GHC.Prim.==#\(ww, ww1);
+ if \is_GHC.Types.False\(wild) then
+ wild1 := \GHC.Prim.<#\(ww, ww1);
+ if \is_GHC.Types.False\(wild1) then
+ res <= \$wmygcd\(\GHC.Prim.-#\(ww, ww1), ww1);
+ elsif \is_GHC.Types.True\(wild1) then
+ res <= \$wmygcd\(ww, \GHC.Prim.-#\(ww1, ww));
+ end if;
+ elsif \is_GHC.Types.True\(wild) then res <= ww;
+ end if;
+ end process;
+
+ process (clk)
+ begin
+ if rising_edge(clk) then
+ core_call <= '0';
+ if s1_call = '1' then
+ s1_wait <= '1';
+ s1_saved_ww <= s1_ww;
+ s1_saved_ww1 <= s1_ww1;
+ end if;
+ if tail_call = '1' then
+ core_call <= '1';
+ core_ww <= tail_ww;
+ core_ww1 <= tail_ww1;
+ elsif core_ret = '1' or s1_act = '1' then
+ s1_act <= '0';
+ if s1_wait = '1' then
+ core_call <= '1';
+ s1_act <= '1';
+ s1_wait <= '0';
+ core_ww <= s1_saved_ww;
+ core_ww1 <= s1_saved_ww1;
+ elsif s1_call = '1' then
+ core_call <= '1';
+ s1_act <= '1';
+ s1_wait <= '0';
+ core_ww <= s1_ww;
+ core_ww1 <= s1_ww1;
+ end if;
+ end if;
+ end if;
+ end process;
+
+ s1_ret <= core_ret and s1_act;
+
+end architecture;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use work.\Prim\.all;
+use work.\GCD\.all;
+
+entity mygcd is
+ port (clk : in std_logic;
+ s1_call : in std_logic;
+ s1_ret : out std_logic;
+ s1_w : in \GHC.Types.Int\;
+ s1_w1 : in \GHC.Types.Int\;
+ res : out \GHC.Types.Int\);
+end entity;
+
+architecture rtl of mygcd is
+ signal tail_call : std_logic;
+ signal tail_w : \GHC.Types.Int\;
+ signal tail_w1 : \GHC.Types.Int\;
+ signal core_call : std_logic;
+ signal core_ret : std_logic;
+ signal core_w : \GHC.Types.Int\;
+ signal core_w1 : \GHC.Types.Int\;
+ signal s1_act : std_logic;
+ signal s1_wait : std_logic;
+ signal s1_saved_w : \GHC.Types.Int\;
+ signal s1_saved_w1 : \GHC.Types.Int\;
+begin
+ process (core_call, core_w, core_w1)
+ variable w2 : \GHC.Types.Int\;
+ variable ww : \Int#\;
+ variable w3 : \GHC.Types.Int\;
+ variable ww1 : \Int#\;
+ variable ww2 : \Int#\;
+ variable w : \GHC.Types.Int\;
+ variable w1 : \GHC.Types.Int\;
+ begin
+ w := core_w;
+ w1 := core_w1;
+ w2 := w;
+ if \is_GHC.Types.I#\(w2) then
+ \expand_GHC.Types.I#\(w2, ww);
+ w3 := w1;
+ if \is_GHC.Types.I#\(w3) then
+ \expand_GHC.Types.I#\(w3, ww1);
+ ww2 := \$wmygcd\(ww, ww1);
+ res <= \GHC.Types.I#\(ww2);
+ end if;
+ end if;
+ end process;
+
+ process (clk)
+ begin
+ if rising_edge(clk) then
+ core_call <= '0';
+ if s1_call = '1' then
+ s1_wait <= '1';
+ s1_saved_w <= s1_w;
+ s1_saved_w1 <= s1_w1;
+ end if;
+ if tail_call = '1' then
+ core_call <= '1';
+ core_w <= tail_w;
+ core_w1 <= tail_w1;
+ elsif core_ret = '1' or s1_act = '1' then
+ s1_act <= '0';
+ if s1_wait = '1' then
+ core_call <= '1';
+ s1_act <= '1';
+ s1_wait <= '0';
+ core_w <= s1_saved_w;
+ core_w1 <= s1_saved_w1;
+ elsif s1_call = '1' then
+ core_call <= '1';
+ s1_act <= '1';
+ s1_wait <= '0';
+ core_w <= s1_w;
+ core_w1 <= s1_w1;
+ end if;
+ end if;
+ end if;
+ end process;
+
+ s1_ret <= core_ret and s1_act;
+
+end architecture;
+
diff --git a/testsuite/gna/sr2940/Prim.vhd b/testsuite/gna/sr2940/Prim.vhd
new file mode 100644
index 0000000..5bef42f
--- /dev/null
+++ b/testsuite/gna/sr2940/Prim.vhd
@@ -0,0 +1,80 @@
+-- Types and functions for Haskell Primitives
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+package \Prim\ is
+
+ subtype \Int#\ is signed(31 downto 0);
+ subtype \GHC.Types.Int\ is signed(31 downto 0);
+ subtype \GHC.Types.Bool\ is std_logic;
+
+ -- Primitive arithmetic operations
+ function \GHC.Prim.==#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\;
+ function \GHC.Prim.<#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\;
+ function \GHC.Prim.-#\ ( a, b : \Int#\ ) return \Int#\;
+
+ -- Data Constructor predicates: each takes a object and returns
+ -- a boolean (i.e., tested with VHDL's if) that indicates whether the
+ -- object was constructed with the given constructor
+ function \is_GHC.Types.False\ (a : \GHC.Types.Bool\) return boolean;
+ function \is_GHC.Types.True\ (a : \GHC.Types.Bool\) return boolean;
+ function \is_GHC.Types.I#\ (a : \GHC.Types.Int\) return boolean;
+
+ -- Data "deconstructor" procedures: split apart an algebraic data type
+ -- into fields
+
+ procedure \expand_GHC.Types.I#\ ( input : in \GHC.Types.Int\;
+ field1 : out \Int#\);
+
+end \Prim\;
+
+package body \Prim\ is
+
+ function \GHC.Prim.==#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\ is
+ begin
+ if a = b then
+ return '1';
+ else
+ return '0';
+ end if;
+ end \GHC.Prim.==#\;
+
+ function \GHC.Prim.<#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\ is
+ begin
+ if a < b then
+ return '1';
+ else
+ return '0';
+ end if;
+ end \GHC.Prim.<#\;
+
+ function \GHC.Prim.-#\ ( a, b : \Int#\ ) return \Int#\ is
+ begin
+ return a - b;
+ end \GHC.Prim.-#\;
+
+ function \is_GHC.Types.False\ (a : \GHC.Types.Bool\) return boolean is
+ begin
+ return a = '0';
+ end \is_GHC.Types.False\;
+
+ function \is_GHC.Types.True\ (a : \GHC.Types.Bool\) return boolean is
+ begin
+ return a = '1';
+ end \is_GHC.Types.True\;
+
+ function \is_GHC.Types.I#\ (a : \GHC.Types.Int\) return boolean is
+ begin
+ return true; -- Trivial: there's only one constructor
+ end \is_GHC.Types.I#\;
+
+ procedure \expand_GHC.Types.I#\ (
+ input : in \GHC.Types.Int\;
+ field1 : out \Int#\) is
+ begin
+ field1 := input;
+ end \expand_GHC.Types.I#\;
+
+end \Prim\;
diff --git a/testsuite/gna/sr2940/testsuite.sh b/testsuite/gna/sr2940/testsuite.sh
new file mode 100755
index 0000000..5e25d4b
--- /dev/null
+++ b/testsuite/gna/sr2940/testsuite.sh
@@ -0,0 +1,10 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze Prim.vhd
+analyze_failure GCD.vhd
+
+clean
+
+echo "Test successful"
generated by cgit (git 2.34.1) at 2024-12-21 11:30:17 +0000