library bv_utilities;  use bv_utilities.bv_arithmetic.all;
use work.dlx_instr.all;

architecture behavior of dlx is
begin

  interpreter : process is

    type reg_array is array (reg_index) of dlx_bv_word;
    variable reg : reg_array;
    variable fp_reg : reg_array;

    variable PC : dlx_bv_word;
    constant PC_incr : dlx_bv_word := X"0000_0004";

    variable IR : dlx_bv_word;
    alias IR_opcode : dlx_opcode is IR(0 to 5);
    alias IR_sp_func : dlx_sp_func is IR(26 to 31);
    alias IR_fp_func : dlx_fp_func is IR(27 to 31);
    alias IR_rs1 : dlx_reg_addr is IR(6 to 10);
    alias IR_rs2 : dlx_reg_addr is IR(11 to 15);
    alias IR_Itype_rd : dlx_reg_addr is IR(11 to 15);
    alias IR_Rtype_rd : dlx_reg_addr is IR(16 to 20);
    alias IR_immed16 : dlx_immed16 is IR(16 to 31);
    alias IR_immed26 : dlx_immed26 is IR(6 to 31);

    variable disassembled_instr : string(1 to 40);
    variable disassembled_instr_len : positive;

    variable rs1, rs2, Itype_rd, Rtype_rd : reg_index;

    variable mem_addr_reg : dlx_bv_address;
    variable mem_data_reg : dlx_bv_word;

    variable overflow : boolean;

    -- lookup table for result of set instructions
    type set_result_table is array (boolean) of dlx_bv_word;
    constant set_if : set_result_table := ( false => X"0000_0000",
					    true => X"0000_0001" );
    variable instr_count : natural;


  -- local procedures for use within the interpreter


  procedure bus_read ( address : in dlx_bv_address;
                       data_width : in dlx_mem_width;
                       instr_fetch : in std_logic;
                       data : out dlx_bv_word ) is

  begin
    wait until rising_edge(phi1);
    if To_bit(reset) = '1' then
      return;
    end if;
    a <= To_X01(address) after Tpd_clk_out;
    width <= data_width after Tpd_clk_out;
    ifetch <= instr_fetch after Tpd_clk_out;
    mem_enable <= '1' after Tpd_clk_out;
    loop 
      wait until falling_edge(phi2);
      if To_bit(reset) = '1' then
        return;
      end if;
      exit when To_bit(ready) = '1';
    end loop;
    assert not Is_X(d) report "Bus read data contains unknown bits";
    data := To_bitvector(d);
    mem_enable <= '0' after Tpd_clk_out;
  end procedure bus_read;


  procedure bus_write ( address : in dlx_bv_address;
                        data_width : in dlx_mem_width;
                        data : in dlx_bv_word ) is

  begin
    wait until rising_edge(phi1);
    if To_bit(reset) = '1' then
      return;
    end if;
    a <= To_X01(address) after Tpd_clk_out;
    ifetch <= '0' after Tpd_clk_out;
    width <= data_width after Tpd_clk_out;
    d <= To_X01Z(data) after Tpd_clk_out;
    write_enable <= '1' after Tpd_clk_out;
    mem_enable <= '1' after Tpd_clk_out;
    loop 
      wait until falling_edge(phi2);
      if To_bit(reset) = '1' then
        return;
      end if;
      exit when To_bit(ready) = '1';
    end loop;
    d <= disabled_dlx_word after Tpd_clk_out;
    write_enable <= '0' after Tpd_clk_out;
    mem_enable <= '0' after Tpd_clk_out;
  end procedure bus_write;


  procedure execute_op_special is
  begin
    case IR_sp_func is
      when sp_func_nop =>
        null;
      when sp_func_add => 
        bv_add(reg(rs1), reg(rs2), reg(Rtype_rd), overflow);
      when sp_func_addu => 
        bv_addu(reg(rs1), reg(rs2), reg(Rtype_rd), overflow);
      when sp_func_sub => 
        bv_sub(reg(rs1), reg(rs2), reg(Rtype_rd), overflow);
      when sp_func_subu => 
        bv_subu(reg(rs1), reg(rs2), reg(Rtype_rd), overflow);
      when sp_func_sll => 
        reg(Rtype_rd) := reg(rs1) sll bv_to_natural(reg(rs2)(27 to 31));
      when sp_func_srl => 
        reg(Rtype_rd) := reg(rs1) srl bv_to_natural(reg(rs2)(27 to 31));
      when sp_func_sra => 
        reg(Rtype_rd) := reg(rs1) sra bv_to_natural(reg(rs2)(27 to 31));
      when sp_func_and => 
        reg(Rtype_rd) := reg(rs1) and reg(rs2);
      when sp_func_or => 
        reg(Rtype_rd) := reg(rs1) or reg(rs2);
      when sp_func_xor => 
        reg(Rtype_rd) := reg(rs1) xor reg(rs2);
      when sp_func_sequ =>
        reg(Rtype_rd) := set_if( reg(rs1) = reg(rs2) );
      when sp_func_sneu => 
        reg(Rtype_rd) := set_if( reg(rs1) /= reg(rs2) );
      when sp_func_sltu => 
        reg(Rtype_rd) := set_if( reg(rs1) < reg(rs2) );
      when sp_func_sgtu => 
        reg(Rtype_rd) := set_if( reg(rs1) > reg(rs2) );
      when sp_func_sleu => 
        reg(Rtype_rd) := set_if( reg(rs1) <= reg(rs2) );
      when sp_func_sgeu => 
        reg(Rtype_rd) := set_if( reg(rs1) >= reg(rs2) );
      when sp_func_seq => 
        reg(Rtype_rd) := set_if( reg(rs1) = reg(rs2) );
      when sp_func_sne => 
        reg(Rtype_rd) := set_if( reg(rs1) /= reg(rs2) );
      when sp_func_slt => 
        reg(Rtype_rd) := set_if( bv_lt(reg(rs1), reg(rs2)) );
      when sp_func_sgt => 
        reg(Rtype_rd) := set_if( bv_gt(reg(rs1), reg(rs2)) );
      when sp_func_sle => 
        reg(Rtype_rd) := set_if( bv_le(reg(rs1), reg(rs2)) );
      when sp_func_sge => 
        reg(Rtype_rd) := set_if( bv_ge(reg(rs1), reg(rs2)) );
      when sp_func_movi2s | sp_func_movs2i
           | sp_func_movf | sp_func_movd
           | sp_func_movfp2i | sp_func_movi2fp => 
        report sp_func_names(bv_to_natural(IR_sp_func))
               & " instruction not implemented" severity warning;
      when others =>
        report "undefined special instruction function" severity error;
    end case;
  end procedure execute_op_special;


  procedure execute_op_fparith is
  begin
    case IR_fp_func is
      when fp_func_mult | fp_func_multu | fp_func_div | fp_func_divu
           | fp_func_addf | fp_func_subf | fp_func_multf | fp_func_divf
           | fp_func_addd | fp_func_subd | fp_func_multd | fp_func_divd
           | fp_func_cvtf2d | fp_func_cvtf2i | fp_func_cvtd2f
           | fp_func_cvtd2i | fp_func_cvti2f | fp_func_cvti2d
           | fp_func_eqf | fp_func_nef | fp_func_ltf | fp_func_gtf
           | fp_func_lef | fp_func_gef | fp_func_eqd | fp_func_ned
           | fp_func_ltd | fp_func_gtd | fp_func_led | fp_func_ged =>
        report fp_func_names(bv_to_natural(IR_fp_func))
               & " instruction not implemented" severity warning;
      when others =>
        report "undefined floating point instruction function" severity error;
    end case;
  end procedure execute_op_fparith;


  procedure execute_load ( data_width : dlx_mem_width; unsigned : boolean ) is

    variable temp : dlx_bv_word;

    -- type for least-significant two bits of address
    subtype ls_2_addr_bits is bit_vector(1 downto 0);

  begin
    mem_addr_reg := reg(rs1) + bv_sext(IR_immed16, 32);
    bus_read(mem_addr_reg, data_width, '0', mem_data_reg);
    if To_bit(reset) = '1' then
      return;
    end if;
    case data_width is
      when dlx_mem_width_byte =>
        case ls_2_addr_bits'(mem_addr_reg(1 downto 0)) is
          when B"00" =>
            temp(0 to 7) := mem_data_reg(0 to 7);
          when B"01" =>
            temp(0 to 7) := mem_data_reg(8 to 15);
          when B"10" =>
            temp(0 to 7) := mem_data_reg(16 to 23);
          when B"11" =>
            temp(0 to 7) := mem_data_reg(24 to 31);
        end case;
        if unsigned then
          reg(Itype_rd) := bv_zext(temp(0 to 7), 32);
        else
          reg(Itype_rd) := bv_sext(temp(0 to 7), 32);
        end if;
      when dlx_mem_width_halfword =>
        if mem_addr_reg(1) = '0' then
          temp(0 to 15) := mem_data_reg(0 to 15);
        else
          temp(0 to 15) := mem_data_reg(16 to 31);
        end if;
        if unsigned then
          reg(Itype_rd) := bv_zext(temp(0 to 15), 32);
        else
          reg(Itype_rd) := bv_sext(temp(0 to 15), 32);
        end if;
      when dlx_mem_width_word =>
        reg(Itype_rd) := mem_data_reg;
      when others =>
        null;
    end case;
  end procedure execute_load;


  procedure execute_store ( data_width : dlx_mem_width ) is

    variable temp : dlx_bv_word;

    -- type for least-significant two bits of address
    subtype ls_2_addr_bits is bit_vector(1 downto 0);

  begin
    mem_addr_reg := reg(rs1) + bv_sext(IR_immed16, 32);
    mem_data_reg := X"0000_0000";
    case data_width is
      when dlx_mem_width_byte =>
        case ls_2_addr_bits'(mem_addr_reg(1 downto 0)) is
          when B"00" =>
            mem_data_reg(0 to 7) := reg(Itype_rd)(0 to 7);
          when B"01" =>
            mem_data_reg(8 to 15) := reg(Itype_rd)(0 to 7);
          when B"10" =>
            mem_data_reg(16 to 23) := reg(Itype_rd)(0 to 7);
          when B"11" =>
             mem_data_reg(24 to 31) := reg(Itype_rd)(0 to 7);
        end case;
      when dlx_mem_width_halfword =>
        if mem_addr_reg(1) = '0' then
          mem_data_reg(0 to 15) := reg(Itype_rd)(0 to 15);
        else
          mem_data_reg(16 to 31) := reg(Itype_rd)(0 to 15);
        end if;
      when dlx_mem_width_word =>
        mem_data_reg := reg(Itype_rd);
      when others =>
        null;
    end case;
    bus_write(mem_addr_reg, data_width, mem_data_reg);
  end procedure execute_store;


  begin -- interpreter

    -- reset the processor
    d <= disabled_dlx_word;
    halt <= '0';
    write_enable <= '0';
    mem_enable <= '0';
    reg(0) := X"0000_0000";
    PC := X"0000_0000";
    instr_count := 0;
    wait on phi2 until falling_edge(phi2) and To_bit(reset) = '0';

    -- fetch-decode-execute loop
    while To_bit(reset) /= '1' loop
      -- fetch next instruction
      instr_count := instr_count + 1;
      if debug = msg_every_100_instructions and instr_count mod 100 = 0 then
        report "instruction count = " & natural'image(instr_count);
      end if;

      if debug >= msg_each_instruction then
        report "fetching instruction";
      end if;

      bus_read( address => PC, data_width => dlx_mem_width_word,
                instr_fetch => '1', data => IR );
      exit when To_bit(reset) = '1';

      if debug >= trace_each_instruction then
	disassemble(IR, disassembled_instr, disassembled_instr_len);
        report disassembled_instr(1 to disassembled_instr_len);
      end if;

      wait until rising_edge(phi1);

      -- increment the PC to point to the following instruction
      if debug = trace_each_step then
        report "incrementing PC";
      end if;

      PC := bv_addu(PC, PC_incr);

      -- decode the instruction
      if debug = trace_each_step then
        report "decoding instruction";
      end if;

      rs1 := bv_to_natural(IR_rs1);
      rs2 := bv_to_natural(IR_rs2);
      Itype_rd := bv_to_natural(IR_Itype_rd);
      Rtype_rd := bv_to_natural(IR_Rtype_rd);

      -- execute the instruction
      if debug = trace_each_step then
        report "executing instruction";
      end if;

      overflow := false;

      case IR_opcode is
        when op_special =>
          execute_op_special;
        when op_fparith =>
          execute_op_fparith;
        when op_j  => 
          PC := PC + bv_sext(IR_immed26, 32);
        when op_jal => 
          reg(link_reg) := PC;
          PC := PC + bv_sext(IR_immed26, 32);
        when op_jr => 
          PC := reg(rs1);
        when op_jalr => 
          reg(link_reg) := PC;
          PC := reg(rs1);
        when op_beqz => 
          if reg(rs1) = X"0000_0000" then
            PC := PC + bv_sext(IR_immed16, 32);
          end if;
        when op_bnez => 
          if reg(rs1) /= X"0000_0000" then
            PC := PC + bv_sext(IR_immed16, 32);
          end if;
        when op_addi =>
          bv_add(reg(rs1), bv_sext(IR_immed16, 32), reg(Itype_rd), overflow);
        when op_addui => 
          bv_addu(reg(rs1), bv_zext(IR_immed16, 32), reg(Itype_rd), overflow);
        when op_subi => 
          bv_sub(reg(rs1), bv_sext(IR_immed16, 32), reg(Itype_rd), overflow);
        when op_subui => 
          bv_subu(reg(rs1), bv_zext(IR_immed16, 32), reg(Itype_rd), overflow);
        when op_slli => 
          reg(Itype_rd) := reg(rs1) sll bv_to_natural(IR_immed16(11 to 15));
        when op_srli =>
          reg(Itype_rd) := reg(rs1) srl bv_to_natural(IR_immed16(11 to 15));
        when op_srai => 
          reg(Itype_rd) := reg(rs1) sra bv_to_natural(IR_immed16(11 to 15));
        when op_andi => 
          reg(Itype_rd) := reg(rs1) and bv_zext(IR_immed16, 32);
        when op_ori => 
          reg(Itype_rd) := reg(rs1) or bv_zext(IR_immed16, 32);
        when op_xori => 
          reg(Itype_rd) := reg(rs1) xor bv_zext(IR_immed16, 32);
        when op_lhi => 
          reg(Itype_rd) := IR_immed16 & X"0000";
        when op_sequi => 
          reg(Itype_rd) := set_if( reg(rs1) = bv_zext(IR_immed16, 32) );
        when op_sneui => 
          reg(Itype_rd) := set_if( reg(rs1) /= bv_zext(IR_immed16, 32) );
        when op_sltui => 
          reg(Itype_rd) := set_if( reg(rs1) < bv_zext(IR_immed16, 32) );
        when op_sgtui => 
          reg(Itype_rd) := set_if( reg(rs1) > bv_zext(IR_immed16, 32) );
        when op_sleui => 
          reg(Itype_rd) := set_if( reg(rs1) <= bv_zext(IR_immed16, 32) );
        when op_sgeui => 
          reg(Itype_rd) := set_if( reg(rs1) >= bv_zext(IR_immed16, 32) );
        when op_seqi => 
          reg(Itype_rd) := set_if( reg(rs1) = bv_sext(IR_immed16, 32) );
        when op_snei => 
          reg(Itype_rd) := set_if( reg(rs1) /= bv_sext(IR_immed16, 32) );
        when op_slti => 
          reg(Itype_rd) := set_if( bv_lt(reg(rs1), bv_sext(IR_immed16, 32)) );
        when op_sgti => 
          reg(Itype_rd) := set_if( bv_gt(reg(rs1), bv_sext(IR_immed16, 32)) );
        when op_slei => 
          reg(Itype_rd) := set_if( bv_le(reg(rs1), bv_sext(IR_immed16, 32)) );
        when op_sgei => 
          reg(Itype_rd) := set_if( bv_ge(reg(rs1), bv_sext(IR_immed16, 32)) );
        when op_trap =>
          report "TRAP instruction encountered, execution halted" severity note;
          halt <= '1' after Tpd_clk_out;
          wait until To_bit(reset) = '1';
          exit;
        when op_lb =>
          execute_load(data_width => dlx_mem_width_byte, unsigned => false);
          exit when To_bit(reset) = '1';
        when op_lh => 
          execute_load(data_width => dlx_mem_width_halfword, unsigned => false);
          exit when To_bit(reset) = '1';
        when op_lw => 
          execute_load(data_width => dlx_mem_width_word, unsigned => false);
          exit when To_bit(reset) = '1';
        when op_lbu => 
          execute_load(data_width => dlx_mem_width_byte, unsigned => true);
          exit when To_bit(reset) = '1';
        when op_lhu => 
          execute_load(data_width => dlx_mem_width_halfword, unsigned => true);
          exit when To_bit(reset) = '1';
        when op_sb => 
          execute_store ( data_width => dlx_mem_width_byte );
          exit when To_bit(reset) = '1';
        when op_sh => 
          execute_store ( data_width => dlx_mem_width_halfword );
          exit when To_bit(reset) = '1';
        when op_sw => 
          execute_store ( data_width => dlx_mem_width_word );
          exit when To_bit(reset) = '1';
        when op_rfe | op_bfpt | op_bfpf | op_lf | op_ld | op_sf | op_sd => 
          report opcode_names(bv_to_natural(IR_opcode))
                 & " instruction not implemented" severity warning;
        when others =>
          report "undefined instruction" severity error;
        end case;

        -- fix up R0 in case it was overwritten
        reg(0) := X"0000_0000";

        -- overflow and divide-by-zero exception handing
        -- (not implemented)

        if debug = trace_each_step then
          report "end of execution";
        end if;

    end loop;
    -- loop is only exited when reset active:
    -- process interpreter starts again from beginning
  end process interpreter;

end architecture behavior;