LIBRARY IEEE;
USE IEEE.std_logic_1164.all;
USE IEEE.std_logic_unsigned.all;

-- Forth-CPU ver.8

ENTITY fcpu IS

GENERIC ( widtx : integer :=16; Ddepth : integer :=5; Rdepth : integer :=5);

   Port(
   rst   : in std_logic;
   clk   : in std_logic;
   all_ena : in std_logic;
   addr      : out std_logic_vector (widtx-1 downto 0);
   data_in      : in std_logic_vector (widtx-1 downto 0);
   data_out   : out std_logic_vector (widtx-1 downto 0);
   rd_ram      : out std_logic;
   wr_ram      : out std_logic;
   cs_ram       : out std_logic;
   command      : out std_logic_vector (3 downto 0);
   addr_fix   : out std_logic_vector (widtx-1 downto 0)
   );

END fcpu;

ARCHITECTURE RTL OF fcpu IS

   TYPE TstackD IS array (Ddepth-1 downto 0 ) of std_logic_vector (widtx-1 downto 0);
   TYPE TstackR IS array (Rdepth-1 downto 0 ) of std_logic_vector (widtx-1 downto 0);
-- TYPE comands IS (NOP,LIT,CALL,RET,BRANCH,DUP,SWAP,DROP,RAZIM,PRISV,toR,fromR,MOVE,NEXXT);

   signal RESET : std_logic;
   signal PC : std_logic_vector (widtx-1 downto 0);
   signal newPC : std_logic_vector (widtx-1 downto 0);
   signal TOP :  std_logic_vector (widtx-1 downto 0);
   signal newTOP : std_logic_vector (widtx-1 downto 0);
   signal BOT : std_logic_vector (widtx-1 downto 0);
   signal newBOT : std_logic_vector (widtx-1 downto 0);
   signal CMD   : std_logic_vector (widtx-1 downto 0);
   signal newCMD   : std_logic_vector (widtx-1 downto 0);
   signal rrd : std_logic;
   signal rwr : std_logic;
   signal rcs : std_logic;
   signal CMD4shr : std_logic_vector (widtx-1 downto 0);
   signal CMD8shr : std_logic_vector (widtx-1 downto 0);
   signal RStack : TstackR; -- array (depth-1 downto 0) of std_logic_vector (widtx-1 downto 0);
   signal DStack : TstackD; -- array (depth-1 downto 0) of std_logic_vector (widtx-1 downto 0);
   signal newRStack : TstackR; -- std_logic_vector (widtx-1 downto 0);
   signal newDStack : TstackD; -- std_logic_vector (widtx-1 downto 0);
   signal alu1_resT  : std_logic_vector (widtx-1 downto 0);
   signal alu1_resB  : std_logic_vector (widtx-1 downto 0);
   signal alu2_resT  : std_logic_vector (widtx-1 downto 0);
   signal alu2_resB  : std_logic_vector (widtx-1 downto 0);
   signal alu3_resT  : std_logic_vector (widtx-1 downto 0);
   signal alu3_resB  : std_logic_vector (widtx-1 downto 0);   
   signal mul_res    : std_logic_vector (widtx+widtx-1 downto 0);   
   signal pre_mul    : std_logic_vector (widtx+widtx-1 downto 0);
   
   signal enaX   : std_logic;
   signal xSWAP : std_logic;
   
   signal DStackRD : std_logic_vector (widtx-1 downto 0);
   signal DStackWR : std_logic_vector (widtx-1 downto 0);
   signal RStackRD : std_logic_vector (widtx-1 downto 0);
   signal RStackWR : std_logic_vector (widtx-1 downto 0);
   signal DStackPUSH : TstackD;
   signal DStackPOP : TstackD;
   signal DStackSWAP : TstackD;
   signal RStackPUSH : TstackR;
   signal RStackPOP : TstackR;
   signal RStackSWAP : TstackR;
   signal zero : std_logic_vector (widtx-1 downto 0);


BEGIN
   zero <= (others => '0');
   -- вспомогательные сигналы:
   -- регистр команд, сдвинутый на 4 бита (для большинства команд)
   CMD4shr(widtx-5 downto 0) <= (CMD(widtx-1 downto 4));
   CMD4shr(widtx-1 downto widtx-4)<=zero(widtx-1 downto widtx-4);
   -- регистр команд, сдвинутый на 8 бит для дкоманд-префиксов
   CMD8shr(widtx-9 downto 0) <= (CMD(widtx-1 downto 8));
   CMD8shr(widtx-1 downto widtx-8)<=zero(widtx-1 downto widtx-8);
   -- стек данных
   DStackRD <= DStack(0);
   DStackPUSH(0) <= DStackWR; DStackPUSH(Ddepth-1 downto 1) <= DStack(Ddepth-2 downto 0);
   DStackPOP(Ddepth-2 downto 0) <= DStack(Ddepth-1 downto 1); DStackPOP(Ddepth-1) <= zero;
   DStackSWAP(Ddepth-1 downto 1) <= DStack(Ddepth-1 downto 1);DStackSWAP(0) <= DStackWR;
   -- стек возвратов
   RStackRD <= RStack(0);
   RStackPUSH(0) <= RStackWR; RStackPUSH(Rdepth-1 downto 1) <= RStack(Rdepth-2 downto 0);
   RStackPOP(Rdepth-2 downto 0) <= RStack(Rdepth-1 downto 1); RStackPOP(Rdepth-1) <= zero;
   RStackSWAP(Rdepth-1 downto 1) <= RStack(Rdepth-1 downto 1); RStackSWAP(0) <= RStackWR;
   -- результат умножения
--   mul_res <= TOP * BOT;
--   mul_res <= (others => '0');
   mul_res <= pre_mul;
   
   -- ALU для команд типа DUP#, SWAP#, DROP#
   process (CMD) begin
      case conv_integer(CMD(7 downto 4)) is
         when 0 =>
            -- DUP
            alu1_resB <= TOP; -- caaeooea aey DUP
            alu1_resT <= TOP; -- caaeooea aey DUP
            -- SWAP
            alu2_resB <= TOP; -- caaeooea aey SWAP
            alu2_resT <= BOT; -- caaeooea aey SWAP
            -- DROP               
            alu3_resB <= DStackRD; -- caaeooea aey DROP
            alu3_resT <= BOT; -- caaeooea aey DROP               
         when 1 =>
            -- OVER
            alu1_resB <= TOP; -- caaeooea aey DUP
            alu1_resT <= BOT; -- caaeooea aey DUP
            -- INC
            alu2_resB <= BOT; -- caaeooea aey SWAP
            alu2_resT <= TOP+1; -- caaeooea aey SWAP
            -- ADD
            alu3_resB <= DStackRD; -- caaeooea aey DROP
            alu3_resT <= BOT+TOP; -- caaeooea aey DROP
         when 2 =>
            -- TRUE
            alu1_resB <= TOP; -- caaeooea aey DUP
            alu1_resT <= zero; -- caaeooea aey DUP
            -- DEC
            alu2_resB <= BOT; -- caaeooea aey SWAP
            alu2_resT <= TOP-1; -- caaeooea aey SWAP
            -- SUB
            alu3_resB <= DStackRD; -- caaeooea aey DROP
            alu3_resT <= BOT-TOP; -- caaeooea aey DROP
         when 3 =>
            -- FALSE
            alu1_resB <= TOP; -- caaeooea aey DUP
            alu1_resT <= (others => '1'); -- caaeooea aey DUP
            -- MUL
            alu2_resB <= mul_res(widtx+widtx-1 downto widtx);
            alu2_resT <= mul_res(widtx-1 downto 0);
            --alu2_resB <= BOT; -- caaeooea aey SWAP
            --alu2_resT <= TOP-1; -- caaeooea aey SWAP
            -- AND
            alu3_resB <= DStackRD; -- caaeooea aey DROP
            alu3_resT <= BOT and TOP; -- caaeooea aey DROP
         when 4 =>
            -- ONE
            alu1_resB <= TOP; -- caaeooea aey DUP
            alu1_resT <= (0 => '1',others => '0'); -- caaeooea aey DUP
            -- MUL
            alu2_resB <= mul_res(widtx+widtx-1 downto widtx);
            alu2_resT <= mul_res(widtx-1 downto 0);
            --alu2_resB <= BOT; -- caaeooea aey SWAP
            --alu2_resT <= TOP-1; -- caaeooea aey SWAP
            -- OR
            alu3_resB <= DStackRD; -- caaeooea aey DROP
            alu3_resT <= BOT or TOP; -- caaeooea aey DROP
         when others =>
            alu1_resB <= TOP; -- заглушка для DUP
            alu1_resT <= TOP; -- заглушка для DUP
            alu2_resB <= TOP; -- заглушка для SWAP
            alu2_resT <= BOT; -- заглушка для SWAP
            alu3_resB <= DStackRD; -- заглушка для DROP
            alu3_resT <= BOT; -- заглушка для DROP
      end case;
   end process;

   -- вся логика процессора
   process (RESET,CMD) begin
      -- установки при сбросе
      if RESET = '0' then

         newPC <= zero;
         newBOT <= BOT;
         newTOP <= TOP;
         DStackWR <= DStackRD;
         RStackWR <= RStackRD;
         newRStack <= RStack; -- RStack-NOP
         newDStack <= DStack; -- DStack-NOP
         enaX <= '0';
         rrd <= '1';
         rcs <= '1';
         rwr <= '1';
         newCMD <= zero;
         
      else
         -- система команд здесь!
         case conv_integer(CMD(3 downto 0)) is
            -- NOP
            when 0 =>
               newPC <= PC+1;
               enaX <= '0';
               newCMD <= data_in;
               newBOT <= BOT;
               newTOP <= TOP;
               RSTackWR <= RStackRD;
               DSTackWR <= DStackRD;
               newRStack <= RStack;
               newDStack <= DStack;
               rrd <= '0';
               rcs <= '0';
               rwr <= '1';
               enaX <= '0';
            -- LIT
            when 1 =>
               enaX <= '0';
               newBOT <= TOP;
               newTOP <= data_in;
               newPC <= PC+1;
               rrd <= '0';
               rcs <= '0';
               rwr <= '1';
               newDStack <= DStackPUSH; DStackWR <= BOT;
               newRStack <= RStack; RStackWR <= RStackRD;
               newCMD <= CMD4shr;
            -- CALL
            when 2 =>
               enaX <= '0';
               newBOT <= BOT;
               newTOP <= TOP;
               newPC <= data_in;
               rrd <= '0';
               rcs <= '0';
               rwr <= '1';
               DStackWR <= DStackRD;
               newRStack <= RStackPUSH; RStackWR <= PC+1;
               newDStack <= DStack;
               newCMD <= zero;
            -- RET
            when 3 =>
               enaX <= '0';
               newBOT <= BOT;
               newTOP <= TOP;
               newPC <= RStackRD;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= RStackRD; DSTackWR <= DStackRD;
               newDStack <= DStack;
               newRStack <= RStackPOP; -- RStack-POP
               newCMD <= CMD4shr;
            -- IF   
            when 4 =>
               enaX <= '0';
               if (conv_integer(TOP) = 0) then
                  newPC <= PC+1;
                  newCMD <= CMD4shr;
               else
                  newPC <= data_in;
                  newCMD <= CMD4shr;
               end if;
               newBOT <= BOT;
               newTOP <= TOP;
               rrd <= '0';
               rcs <= '0';
               rwr <= '1';      
               RSTackWR <= RStackRD; DSTackWR <= DStackRD;
               newRStack <= RStack;
               newDStack <= DStack;
            -- DUP operations
            when 5 =>
               enaX <= '0';
               newPC <= PC;
               newBOT <= alu1_resB;
               newTOP <= alu1_resT;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= RStackRD;
               DSTackWR <= BOT;
               newDStack <= DStackPUSH; -- BOT; -- DStack-PUSH
               newRStack <= RStack;
               newCMD <= CMD8shr;
            -- SWAP opeations
            when 6 =>  -- SWAP, ROT, -ROT, INC, DEC, NEG, NOT...
               enaX <= '0';
               newPC <= PC;
               newBOT <= alu2_resB;
               newTOP <= alu2_resT;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= RStackRD; DSTackWR <= DStackRD;
               newDStack <= DStackSWAP;
               newRStack <= RStack;
               newCMD <= CMD8shr;
            -- DROP operations
            when 7 =>
               enaX <= '0';
               newPC <= PC;
               newBOT <= alu3_resB;
               newTOP <= alu3_resT;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= RStackRD; DSTackWR <= DStackRD;
               newDStack <= DStackPOP; -- DStack-POP
               newRStack <= RStack;
               newCMD <= CMD8shr;
            -- @
            when 8 =>
               enaX <= '1';
               if (xSWAP = '0') then
                  newPC <= TOP;
                  newTOP <= BOT;
                  newBOT <= DStackRD;
                  rrd <= '1';
                  rcs <= '1';
                  rwr <= '1';
                  RSTackWR <= PC;
                  DSTackWR <= DStackRD;
                  newDStack <= DStackPOP; -- SDtack-POP
                  newRStack <= RStackPUSH; -- PC; -- RStack-PUSH
                  newCMD <= CMD; -- команда не меняется
               else
                  newPC <= RStackRD;
                  newBOT <= TOP;
                  newTOP <= data_in;
                  rrd <= '0';
                  rcs <= '0';
                  rwr <= '1';
                  RSTackWR <= RStackRD; DSTackWR <= BOT;
                  newDStack <= DStackPUSH; -- DStack-POP
                  newRStack <= RStackPOP; -- RStack-POP
                  newCMD <= CMD4shr;   -- следующая команда
               end if;
            -- !
            when 9 =>
               enaX <= '1';
               if (xSWAP = '0') then
                  newPC <= TOP;
                  newTOP <= BOT;
                  newBOT <= DStackRD; -- SDtack-POP
                  rrd <= '1';
                  rcs <= '1';
                  rwr <= '1';
                  RSTackWR <= PC;
                  DSTackWR <= DStackRD;
                  newDStack <= DStackPOP; -- SDtack-POP
                  newRStack <= RStackPUSH; -- PC; -- RStack-PUSH
                  newCMD <= CMD; -- команда не меняется
               else
                  newPC <= RStackRD;
                  newBOT <= DStackRD;
                  newTOP <= BOT;
                  rrd <= '1';
                  rcs <= '0';
                  rwr <= '0';
                  RSTackWR <= RStackRD; DSTackWR <= DStackRD;
                  newDStack <= DStackPOP; -- DStack-POP
                  newRStack <= RStackPOP; -- RStack-POP
                  newCMD <= CMD4shr;   -- следующая команда
               end if;
            -- >R
            when 10 =>
               enaX <= '0';
               newPC <= PC;
               newBOT <= DStackRD;
               newTOP <= BOT;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= TOP; DSTackWR <= DStackRD;
               newDStack <= DStackPOP;
               newRStack <= RStackPUSH;
               newCMD <= CMD4shr;
            -- R>
            when 11 =>
               enaX <= '0';
               newPC <= PC;
               newBOT <= TOP;
               newTOP <= RStackRD;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= RStackRD; DSTackWR <= RStackRD;
               newDStack <= DStackPUSH; -- DStack-PUSH
               newRStack <= RStackPOP; -- RSTack-POP
               newCMD <= CMD4shr;
            -- MOVE
            when 12 =>
               enaX <= '1';
               if (xSWAP = '0') then
                  newPC <= RStackRD;
                  newBOT <= TOP;
                  newTOP <= data_in;
                  rrd <= '0';
                  rcs <= '0';
                  rwr <= '1';
                  RSTackWR <= PC+1;
                  DSTackWR <= BOT;
                  newDStack <= DStackPUSH;
                  newRStack <= RStackSWAP;
                  newCMD <= CMD;
               else
                  newPC <=RStackRD;
                  newTOP <= BOT-1;
                  newBOT <= DStackRD;
                  rrd <= '1';
                  rcs <= '0';
                  rwr <= '0';
                  RSTackWR <= PC+1;
                  DSTackWR <= DStackRD;
                  newDStack <= DStackPOP;
                  newRStack <= RStackSWAP;
                  if (conv_integer(BOT) = 1) then
                     newCMD <= CMD4shr;
                  else
                     newCMD <= CMD;
                  end if;
               end if;
            -- NEXT
            when 13 =>
               enaX <= '1';
               if (xSWAP = '0') then
                  newPC <= RStackRD;
                  newBOT <= BOT;
                  newTOP <= TOP;
                  rrd <= '1';
                  rcs <= '1';
                  rwr <= '1';
                  RSTackWR <= RStackRD; DSTackWR <= DStackRD;
                  newDStack <= DStack;
                  newRStack <= RStackPOP;
                  newCMD <= CMD; -- здесь команда не меняется
               else
                  newPC <= data_in;
                  newBOT <= BOT;
                  newTOP <= TOP;
                  rrd <= '0';
                  rcs <= '0';
                  rwr <= '1';
                  RSTackWR <= PC+1;
                  DSTackWR <= DStackRD;
                  newDStack <= DStackPUSH;
                  newRStack <= RStackPUSH;
                  newCMD <= CMD4shr;
               end if;
               
               
            when others =>

               enaX <= '0';
               newPC <= PC;
               newBOT <= BOT;
               newTOP <= TOP;
               rrd <= '1';
               rcs <= '1';
               rwr <= '1';
               RSTackWR <= RStackRD;
               DSTackWR <= DStackRD;
               newDStack <= DStack;
               newRStack <= RStack;
               newCMD <= CMD4shr;
         end case;
      end if;
   end process;
   
   -- все регистры
   process (clk,all_ena) begin
      if (clk'event and clk='1' and all_ena='1') then
         CMD <= newCMD;
         PC <= newPC;
         TOP <= newTOP;
         BOT <= newBOT;
         RESET <= rst;
         RStack <= newRStack;
         DStack <= newDStack;
         xSWAP <= (not xSWAP) and enaX;
         addr_fix <= newPC;
      end if;
   end process;
   
   -- умножение производится сразу, как в TOP и BOT появились новые значения
   -- независимо от all_ena
   process (clk) begin
      if (clk'event and clk='1') then
         pre_mul <= TOP * BOT;
      end if;
   end process;

   -- назначения выходов
--   addr <= PC;
   addr <= newPC;
   data_out <= TOP;
   rd_ram <= rrd;
   wr_ram <= rwr;
   cs_ram <= rcs;   
   command   <= CMD (3 downto 0);


END ARCHITECTURE;