-- Copyright (c) 2007 Frank Buss (fb@frank-buss.de)
-- See license.txt for license

library IEEE;
use IEEE.STD_LOGIC_1164.ALL; 
use IEEE.NUMERIC_STD.ALL; 
use work.ALL;

entity forth_core is
    generic(
        cell_size   : natural := 16
    );
    port(
        clock       : in std_logic;
        reset       : in std_logic;
        address     : out unsigned(cell_size - 1 downto 0);
        wren        : out std_logic;
        data_out    : out unsigned(cell_size - 1 downto 0);
        q           : in unsigned(cell_size - 1 downto 0)
    );
end entity forth_core;

architecture rtl of forth_core is
    -- initial values for pointers
    constant pc_start : natural := 256;
    constant rp_start : natural := 255;
    constant sp_start : natural := 63;

    -- number of bits for a command. Max: cell_size-11
    constant command_size : natural := 4;

    -- microcode size
    constant microcode_size : natural := command_size + 3;

    subtype cell_type is unsigned(cell_size - 1 downto 0);
    subtype command_type is unsigned(command_size - 1 downto 0);
    subtype microcode_type is unsigned(microcode_size - 1 downto 0);

    -- commands
    constant cmd_q2a        : command_type := to_unsigned(0, command_size);
    constant cmd_a2data     : command_type := to_unsigned(1, command_size);
    constant cmd_a2address  : command_type := to_unsigned(2, command_size);
    constant cmd_pc2address : command_type := to_unsigned(3, command_size);
    constant cmd_pc2data    : command_type := to_unsigned(4, command_size);
    constant cmd_a2pc       : command_type := to_unsigned(5, command_size);
    constant cmd_branch     : command_type := to_unsigned(6, command_size);
    constant cmd_q2pc       : command_type := to_unsigned(7, command_size);
    constant cmd_and        : command_type := to_unsigned(8, command_size);
    constant cmd_or         : command_type := to_unsigned(9, command_size);
    constant cmd_xor        : command_type := to_unsigned(10, command_size);
    constant cmd_plus       : command_type := to_unsigned(11, command_size);
    constant cmd_lshift     : command_type := to_unsigned(12, command_size);
    constant cmd_rshift     : command_type := to_unsigned(13, command_size);
    constant cmd_pop        : command_type := to_unsigned(14, command_size);
    constant cmd_popr       : command_type := to_unsigned(15, command_size);

    -- delays main process for simpler memory access
    signal delay : boolean := false;

    -- every opcode contains two microcodes, this is the second microcode
    signal next_microcode : microcode_type;

    -- program counter
    signal pc : cell_type := to_unsigned(pc_start, cell_size);

    -- stack pointer
    signal sp : cell_type := to_unsigned(sp_start, cell_size);

    -- return stack pointer
    signal rp : cell_type := to_unsigned(rp_start, cell_size);

    -- additional address register
    signal a : cell_type := to_unsigned(0, cell_size);

    -- temporary register and input value for RAM write access
    signal data : cell_type;

    -- CPU statemachine steps
    type state_type is (
        read_opcode,
        step1,
        step2
    );
    signal state : state_type := read_opcode;

begin

    -- the CPU process
    process(clock, reset)
        variable microcode : microcode_type;
        variable command : command_type;
    begin
        if reset = '1' then
            state <= read_opcode;
            delay <= false;
            pc <= to_unsigned(pc_start, cell_size);
            rp <= to_unsigned(rp_start, cell_size);
            sp <= to_unsigned(sp_start, cell_size);
            wren <= '0';
        elsif rising_edge(clock) then
            delay <= not delay;
            if delay then
                microcode := (others => '0');
                wren <= '0';
                data <= q;
                case state is
                    when read_opcode =>
                        address <= pc;
                        pc <= pc + 1;
                        state <= step1;
                    when step1 =>
                        if q(15) = '1' then
                            pc <= '0' & q(14 downto 0);
                            address <= rp;
                            rp <= rp - 1;
                            wren <= '1';
                            data <= pc;
                            state <= read_opcode;
                        else
                            microcode := q(microcode_size - 1 downto 0);
                            next_microcode <= q(2 * microcode_size - 1 downto microcode_size);
                            state <= step2;
                        end if;
                    when step2 =>
                        microcode := next_microcode;
                        state <= read_opcode;
                end case;

                if microcode(1 downto 0) /= "00" then
          command := microcode(microcode_size - 1 downto 3);
          
          -- VHDL IEEE standard forbids case/end case on variables, using ifs is allowed
          if command = cmd_q2a then a <= q; end if;
                    if command = cmd_a2data then data <= a; end if;
                    if command = cmd_a2address then address <= a; end if;
                    if command = cmd_pc2address then address <= pc; pc <= pc + 1; end if;
                    if command = cmd_pc2data then data <= pc; end if;
                    if command = cmd_a2pc then pc <= a; end if;
                    if command = cmd_branch then if q /= x"0000" then pc <= a; end if; end if;
                    if command = cmd_q2pc then pc <= q; end if;
                    if command = cmd_and then data <= q and a; end if;
                    if command = cmd_or then data <= q or a; end if;
                    if command = cmd_xor then data <= q xor a; end if;
                    if command = cmd_plus then data <= q + a; end if;
                    if command = cmd_lshift then data <= q(cell_size - 2 downto 0) & '0'; end if;
                    if command = cmd_rshift then data <= '0' & q(cell_size - 1 downto 1); end if;
                    if command = cmd_pop then address <= sp + 1; sp <= sp + 1; end if;
                    if command = cmd_popr then address <= rp + 1; rp <= rp + 1; end if;
                end if;

                if microcode(2) = '1' then
                    wren <= '1';
                end if;
            
                case microcode(1 downto 0) is
                    when "10" => 
                        -- push
                        address <= sp;
                        sp <= sp - 1;
                    when "11" =>
                        -- pushr
                        address <= rp;
                        rp <= rp - 1;
                    when others => null;
                end case;
            end if;
        end if;
    end process;

    -- connect internal data buffer to outgoing signal
    data_out <= data;
    
end architecture rtl;