diff --git a/cores/ql/TG68K_ALU.vhd b/cores/ql/TG68K_ALU.vhd new file mode 100644 index 0000000..c2e6209 --- /dev/null +++ b/cores/ql/TG68K_ALU.vhd @@ -0,0 +1,918 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- -- +-- Copyright (c) 2009-2011 Tobias Gubener -- +-- Subdesign fAMpIGA by TobiFlex -- +-- -- +-- This source file is free software: you can redistribute it and/or modify -- +-- it under the terms of the GNU General Public License as published -- +-- by the Free Software Foundation, either version 3 of the License, or -- +-- (at your option) any later version. -- +-- -- +-- This source file is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- +-- GNU General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- along with this program. If not, see . -- +-- -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +library ieee; +use ieee.std_logic_1164.all; +use ieee.std_logic_unsigned.all; +use IEEE.numeric_std.all; +use work.TG68K_Pack.all; + +entity TG68K_ALU is +generic( + MUL_Mode : integer := 0; --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no MUL, + DIV_Mode : integer := 0 --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no DIV, + ); + port(clk : in std_logic; + Reset : in std_logic; + clkena_lw : in std_logic:='1'; + execOPC : in bit; + exe_condition : in std_logic; + exec_tas : in std_logic; + long_start : in bit; + movem_presub : in bit; + set_stop : in bit; + Z_error : in bit; + rot_bits : in std_logic_vector(1 downto 0); + exec : in bit_vector(lastOpcBit downto 0); + OP1out : in std_logic_vector(31 downto 0); + OP2out : in std_logic_vector(31 downto 0); + reg_QA : in std_logic_vector(31 downto 0); + reg_QB : in std_logic_vector(31 downto 0); + opcode : in std_logic_vector(15 downto 0); + datatype : in std_logic_vector(1 downto 0); + exe_opcode : in std_logic_vector(15 downto 0); + exe_datatype : in std_logic_vector(1 downto 0); + sndOPC : in std_logic_vector(15 downto 0); + last_data_read : in std_logic_vector(15 downto 0); + data_read : in std_logic_vector(15 downto 0); + FlagsSR : in std_logic_vector(7 downto 0); + micro_state : in micro_states; + bf_ext_in : in std_logic_vector(7 downto 0); + bf_ext_out : out std_logic_vector(7 downto 0); + bf_shift : in std_logic_vector(5 downto 0); + bf_width : in std_logic_vector(5 downto 0); + bf_loffset : in std_logic_vector(4 downto 0); + + set_V_Flag : buffer bit; + Flags : buffer std_logic_vector(7 downto 0); + c_out : buffer std_logic_vector(2 downto 0); + addsub_q : buffer std_logic_vector(31 downto 0); + ALUout : out std_logic_vector(31 downto 0) + ); +end TG68K_ALU; + +architecture logic of TG68K_ALU is +----------------------------------------------------------------------------- +----------------------------------------------------------------------------- +-- ALU and more +----------------------------------------------------------------------------- +----------------------------------------------------------------------------- + signal OP1in : std_logic_vector(31 downto 0); + signal addsub_a : std_logic_vector(31 downto 0); + signal addsub_b : std_logic_vector(31 downto 0); + signal notaddsub_b : std_logic_vector(33 downto 0); + signal add_result : std_logic_vector(33 downto 0); + signal addsub_ofl : std_logic_vector(2 downto 0); + signal opaddsub : bit; + signal c_in : std_logic_vector(3 downto 0); + signal flag_z : std_logic_vector(2 downto 0); + signal set_Flags : std_logic_vector(3 downto 0); --NZVC + signal CCRin : std_logic_vector(7 downto 0); + + signal niba_l : std_logic_vector(5 downto 0); + signal niba_h : std_logic_vector(5 downto 0); + signal niba_lc : std_logic; + signal niba_hc : std_logic; + signal bcda_lc : std_logic; + signal bcda_hc : std_logic; + signal nibs_l : std_logic_vector(5 downto 0); + signal nibs_h : std_logic_vector(5 downto 0); + signal nibs_lc : std_logic; + signal nibs_hc : std_logic; + + signal bcd_a : std_logic_vector(8 downto 0); + signal bcd_s : std_logic_vector(8 downto 0); + signal result_mulu : std_logic_vector(63 downto 0); + signal result_div : std_logic_vector(63 downto 0); + signal set_mV_Flag : std_logic; + signal V_Flag : bit; + + signal rot_rot : std_logic; + signal rot_lsb : std_logic; + signal rot_msb : std_logic; + signal rot_X : std_logic; + signal rot_C : std_logic; + signal rot_out : std_logic_vector(31 downto 0); + signal asl_VFlag : std_logic; + signal bit_bits : std_logic_vector(1 downto 0); + signal bit_number : std_logic_vector(4 downto 0); + signal bits_out : std_logic_vector(31 downto 0); + signal one_bit_in : std_logic; + signal bchg : std_logic; + signal bset : std_logic; + + signal mulu_sign : std_logic; + signal mulu_signext : std_logic_vector(16 downto 0); + signal muls_msb : std_logic; + signal mulu_reg : std_logic_vector(63 downto 0); + signal FAsign : std_logic; + signal faktorA : std_logic_vector(31 downto 0); + signal faktorB : std_logic_vector(31 downto 0); + + signal div_reg : std_logic_vector(63 downto 0); + signal div_quot : std_logic_vector(63 downto 0); + signal div_ovl : std_logic; + signal div_neg : std_logic; + signal div_bit : std_logic; + signal div_sub : std_logic_vector(32 downto 0); + signal div_over : std_logic_vector(32 downto 0); + signal nozero : std_logic; + signal div_qsign : std_logic; + signal divisor : std_logic_vector(63 downto 0); + signal divs : std_logic; + signal signedOP : std_logic; + signal OP1_sign : std_logic; + signal OP2_sign : std_logic; + signal OP2outext : std_logic_vector(15 downto 0); + + signal in_offset : std_logic_vector(5 downto 0); +-- signal in_width : std_logic_vector(5 downto 0); + signal datareg : std_logic_vector(31 downto 0); + signal insert : std_logic_vector(31 downto 0); +-- signal bf_result : std_logic_vector(31 downto 0); +-- signal bf_offset : std_logic_vector(5 downto 0); +-- signal bf_width : std_logic_vector(5 downto 0); +-- signal bf_firstbit : std_logic_vector(5 downto 0); + signal bf_datareg : std_logic_vector(31 downto 0); +-- signal bf_out : std_logic_vector(31 downto 0); + signal result : std_logic_vector(39 downto 0); + signal result_tmp : std_logic_vector(39 downto 0); + signal sign : std_logic_vector(31 downto 0); + signal bf_set1 : std_logic_vector(39 downto 0); + signal inmux0 : std_logic_vector(39 downto 0); + signal inmux1 : std_logic_vector(39 downto 0); + signal inmux2 : std_logic_vector(39 downto 0); + signal inmux3 : std_logic_vector(31 downto 0); + signal copymux0 : std_logic_vector(39 downto 0); + signal copymux1 : std_logic_vector(39 downto 0); + signal copymux2 : std_logic_vector(39 downto 0); + signal copymux3 : std_logic_vector(31 downto 0); + signal bf_set2 : std_logic_vector(31 downto 0); +-- signal bf_set3 : std_logic_vector(31 downto 0); + signal shift : std_logic_vector(39 downto 0); + signal copy : std_logic_vector(39 downto 0); +-- signal offset : std_logic_vector(5 downto 0); +-- signal width : std_logic_vector(5 downto 0); + signal bf_firstbit : std_logic_vector(5 downto 0); + signal mux : std_logic_vector(3 downto 0); + signal bitnr : std_logic_vector(4 downto 0); + signal mask : std_logic_vector(31 downto 0); + signal bf_bset : std_logic; + signal bf_NFlag : std_logic; + signal bf_bchg : std_logic; + signal bf_ins : std_logic; + signal bf_exts : std_logic; + signal bf_fffo : std_logic; + signal bf_d32 : std_logic; + signal bf_s32 : std_logic; + signal index : std_logic_vector(4 downto 0); +-- signal i : integer range 0 to 31; +-- signal i : integer range 0 to 31; +-- signal i : std_logic_vector(5 downto 0); +BEGIN +----------------------------------------------------------------------------- +-- set OP1in +----------------------------------------------------------------------------- +PROCESS (OP2out, reg_QB, opcode, OP1out, OP1in, exe_datatype, addsub_q, execOPC, exec, + bcd_a, bcd_s, result_mulu, result_div, exe_condition, bf_shift, + Flags, FlagsSR, bits_out, exec_tas, rot_out, exe_opcode, result, bf_fffo, bf_firstbit, bf_datareg) + BEGIN + ALUout <= OP1in; + ALUout(7) <= OP1in(7) OR exec_tas; + IF exec(opcBFwb)='1' THEN + ALUout <= result(31 downto 0); + IF bf_fffo='1' THEN + ALUout <= (OTHERS =>'0'); + ALUout(5 downto 0) <= bf_firstbit + bf_shift; + END IF; + END IF; + + OP1in <= addsub_q; + IF exec(opcABCD)='1' THEN + OP1in(7 downto 0) <= bcd_a(7 downto 0); + ELSIF exec(opcSBCD)='1' THEN + OP1in(7 downto 0) <= bcd_s(7 downto 0); + ELSIF exec(opcMULU)='1' AND MUL_Mode/=3 THEN + IF exec(write_lowlong)='1' AND (MUL_Mode=1 OR MUL_Mode=2) THEN + OP1in <= result_mulu(31 downto 0); + ELSE + OP1in <= result_mulu(63 downto 32); + END IF; + ELSIF exec(opcDIVU)='1' AND DIV_Mode/=3 THEN + IF exe_opcode(15)='1' OR DIV_Mode=0 THEN +-- IF exe_opcode(15)='1' THEN + OP1in <= result_div(47 downto 32)&result_div(15 downto 0); + ELSE --64bit + IF exec(write_reminder)='1' THEN + OP1in <= result_div(63 downto 32); + ELSE + OP1in <= result_div(31 downto 0); + END IF; + END IF; + ELSIF exec(opcOR)='1' THEN + OP1in <= OP2out OR OP1out; + ELSIF exec(opcAND)='1' THEN + OP1in <= OP2out AND OP1out; + ELSIF exec(opcScc)='1' THEN + OP1in(7 downto 0) <= (others=>exe_condition); + ELSIF exec(opcEOR)='1' THEN + OP1in <= OP2out XOR OP1out; + ELSIF exec(opcMOVE)='1' OR exec(exg)='1' THEN +-- OP1in <= OP2out(31 downto 8)&(OP2out(7)OR exec_tas)&OP2out(6 downto 0); + OP1in <= OP2out; + ELSIF exec(opcROT)='1' THEN + OP1in <= rot_out; + ELSIF exec(opcSWAP)='1' THEN + OP1in <= OP1out(15 downto 0)& OP1out(31 downto 16); + ELSIF exec(opcBITS)='1' THEN + OP1in <= bits_out; + ELSIF exec(opcBF)='1' THEN + OP1in <= bf_datareg; + ELSIF exec(opcMOVESR)='1' THEN + OP1in(7 downto 0) <= Flags; + IF exe_datatype="00" THEN + OP1in(15 downto 8) <= "00000000"; + ELSE + OP1in(15 downto 8) <= FlagsSR; + END IF; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- addsub +----------------------------------------------------------------------------- +PROCESS (OP1out, OP2out, execOPC, datatype, Flags, long_start, movem_presub, exe_datatype, exec, addsub_a, addsub_b, opaddsub, + notaddsub_b, add_result, c_in, sndOPC) + BEGIN + addsub_a <= OP1out; + IF exec(get_bfoffset)='1' THEN + IF sndOPC(11)='1' THEN + addsub_a <= OP1out(31)&OP1out(31)&OP1out(31)&OP1out(31 downto 3); + ELSE + addsub_a <= "000000000000000000000000000000"&sndOPC(10 downto 9); + END IF; + END IF; + + IF exec(subidx)='1' THEN + opaddsub <= '1'; + ELSE + opaddsub <= '0'; + END IF; + + c_in(0) <='0'; + addsub_b <= OP2out; + IF execOPC='0' AND exec(OP2out_one)='0' AND exec(get_bfoffset)='0'THEN + IF long_start='0' AND datatype="00" AND exec(use_SP)='0' THEN + addsub_b <= "00000000000000000000000000000001"; + ELSIF long_start='0' AND exe_datatype="10" AND (exec(presub) OR exec(postadd) OR movem_presub)='1' THEN + IF exec(movem_action)='1' THEN + addsub_b <= "00000000000000000000000000000110"; + ELSE + addsub_b <= "00000000000000000000000000000100"; + END IF; + ELSE + addsub_b <= "00000000000000000000000000000010"; + END IF; + ELSE + IF (exec(use_XZFlag)='1' AND Flags(4)='1') OR exec(opcCHK)='1' THEN + c_in(0) <= '1'; + END IF; + opaddsub <= exec(addsub); + END IF; + + IF opaddsub='0' OR long_start='1' THEN --ADD + notaddsub_b <= '0'&addsub_b&c_in(0); + ELSE --SUB + notaddsub_b <= NOT ('0'&addsub_b&c_in(0)); + END IF; + add_result <= (('0'&addsub_a¬addsub_b(0))+notaddsub_b); + c_in(1) <= add_result(9) XOR addsub_a(8) XOR addsub_b(8); + c_in(2) <= add_result(17) XOR addsub_a(16) XOR addsub_b(16); + c_in(3) <= add_result(33); + addsub_q <= add_result(32 downto 1); + addsub_ofl(0) <= (c_in(1) XOR add_result(8) XOR addsub_a(7) XOR addsub_b(7)); --V Byte + addsub_ofl(1) <= (c_in(2) XOR add_result(16) XOR addsub_a(15) XOR addsub_b(15)); --V Word + addsub_ofl(2) <= (c_in(3) XOR add_result(32) XOR addsub_a(31) XOR addsub_b(31)); --V Long + c_out <= c_in(3 downto 1); + END PROCESS; + +------------------------------------------------------------------------------ +--ALU +------------------------------------------------------------------------------ +PROCESS (OP1out, OP2out, niba_hc, niba_h, niba_l, niba_lc, nibs_hc, nibs_h, nibs_l, nibs_lc, Flags) + BEGIN +--BCD_ARITH------------------------------------------------------------------- + --ADC + bcd_a <= niba_hc&(niba_h(4 downto 1)+('0',niba_hc,niba_hc,'0'))&(niba_l(4 downto 1)+('0',niba_lc,niba_lc,'0')); + niba_l <= ('0'&OP1out(3 downto 0)&'1') + ('0'&OP2out(3 downto 0)&Flags(4)); + niba_lc <= niba_l(5) OR (niba_l(4) AND niba_l(3)) OR (niba_l(4) AND niba_l(2)); + + niba_h <= ('0'&OP1out(7 downto 4)&'1') + ('0'&OP2out(7 downto 4)&niba_lc); + niba_hc <= niba_h(5) OR (niba_h(4) AND niba_h(3)) OR (niba_h(4) AND niba_h(2)); + --SBC + bcd_s <= nibs_hc&(nibs_h(4 downto 1)-('0',nibs_hc,nibs_hc,'0'))&(nibs_l(4 downto 1)-('0',nibs_lc,nibs_lc,'0')); + nibs_l <= ('0'&OP1out(3 downto 0)&'0') - ('0'&OP2out(3 downto 0)&Flags(4)); + nibs_lc <= nibs_l(5); + + nibs_h <= ('0'&OP1out(7 downto 4)&'0') - ('0'&OP2out(7 downto 4)&nibs_lc); + nibs_hc <= nibs_h(5); + END PROCESS; + +----------------------------------------------------------------------------- +-- Bits +----------------------------------------------------------------------------- +PROCESS (clk, exe_opcode, OP1out, OP2out, one_bit_in, bchg, bset, bit_Number, sndOPC) + BEGIN + IF rising_edge(clk) THEN + IF clkena_lw = '1' THEN + bchg <= '0'; + bset <= '0'; + CASE opcode(7 downto 6) IS + WHEN "01" => --bchg + bchg <= '1'; + WHEN "11" => --bset + bset <= '1'; + WHEN OTHERS => NULL; + END CASE; + END IF; + END IF; + + IF exe_opcode(8)='0' THEN + IF exe_opcode(5 downto 4)="00" THEN + bit_number <= sndOPC(4 downto 0); + ELSE + bit_number <= "00"&sndOPC(2 downto 0); + END IF; + ELSE + IF exe_opcode(5 downto 4)="00" THEN + bit_number <= reg_QB(4 downto 0); + ELSE + bit_number <= "00"®_QB(2 downto 0); + END IF; + END IF; + + one_bit_in <= OP1out(to_integer(unsigned(bit_Number))); + bits_out <= OP1out; + bits_out(to_integer(unsigned(bit_Number))) <= (bchg AND NOT one_bit_in) OR bset ; + END PROCESS; + +----------------------------------------------------------------------------- +-- Bit Field +----------------------------------------------------------------------------- +PROCESS (clk, mux, mask, bitnr, bf_ins, bf_bchg, bf_bset, bf_exts, bf_shift, inmux0, inmux1, inmux2, inmux3, bf_set2, OP1out, OP2out, result_tmp, bf_ext_in, + shift, datareg, bf_NFlag, result, reg_QB, sign, bf_d32, bf_s32, copy, bf_loffset, copymux0, copymux1, copymux2, copymux3, bf_width) + BEGIN + IF rising_edge(clk) THEN + IF clkena_lw = '1' THEN + bf_bset <= '0'; + bf_bchg <= '0'; + bf_ins <= '0'; + bf_exts <= '0'; + bf_fffo <= '0'; + bf_d32 <= '0'; + bf_s32 <= '0'; + CASE opcode(10 downto 8) IS + WHEN "010" => bf_bchg <= '1'; --BFCHG + WHEN "011" => bf_exts <= '1'; --BFEXTS +-- WHEN "100" => insert <= (OTHERS =>'0'); --BFCLR + WHEN "101" => bf_fffo <= '1'; --BFFFO + WHEN "110" => bf_bset <= '1'; --BFSET + WHEN "111" => bf_ins <= '1'; --BFINS + bf_s32 <= '1'; + WHEN OTHERS => NULL; + END CASE; + IF opcode(4 downto 3)="00" THEN + bf_d32 <= '1'; + END IF; + bf_ext_out <= result(39 downto 32); + END IF; + END IF; + shift <= bf_ext_in&OP2out; + IF bf_s32='1' THEN + shift(39 downto 32) <= OP2out(7 downto 0); + END IF; + + IF bf_shift(0)='1' THEN + inmux0 <= shift(0)&shift(39 downto 1); + ELSE + inmux0 <= shift; + END IF; + IF bf_shift(1)='1' THEN + inmux1 <= inmux0(1 downto 0)&inmux0(39 downto 2); + ELSE + inmux1 <= inmux0; + END IF; + IF bf_shift(2)='1' THEN + inmux2 <= inmux1(3 downto 0)&inmux1(39 downto 4); + ELSE + inmux2 <= inmux1; + END IF; + IF bf_shift(3)='1' THEN + inmux3 <= inmux2(7 downto 0)&inmux2(31 downto 8); + ELSE + inmux3 <= inmux2(31 downto 0); + END IF; + IF bf_shift(4)='1' THEN + bf_set2(31 downto 0) <= inmux3(15 downto 0)&inmux3(31 downto 16); + ELSE + bf_set2(31 downto 0) <= inmux3; + END IF; + + IF bf_loffset(4)='1' THEN + copymux3 <= sign(15 downto 0)&sign(31 downto 16); + ELSE + copymux3 <= sign; + END IF; + IF bf_loffset(3)='1' THEN + copymux2(31 downto 0) <= copymux3(23 downto 0)©mux3(31 downto 24); + ELSE + copymux2(31 downto 0) <= copymux3; + END IF; + IF bf_d32='1' THEN + copymux2(39 downto 32) <= copymux3(7 downto 0); + ELSE + copymux2(39 downto 32) <= "11111111"; + END IF; + IF bf_loffset(2)='1' THEN + copymux1 <= copymux2(35 downto 0)©mux2(39 downto 36); + ELSE + copymux1 <= copymux2; + END IF; + IF bf_loffset(1)='1' THEN + copymux0 <= copymux1(37 downto 0)©mux1(39 downto 38); + ELSE + copymux0 <= copymux1; + END IF; + IF bf_loffset(0)='1' THEN + copy <= copymux0(38 downto 0)©mux0(39); + ELSE + copy <= copymux0; + END IF; + + result_tmp <= bf_ext_in&OP1out; + IF bf_ins='1' THEN + datareg <= reg_QB; + ELSE + datareg <= bf_set2; + END IF; + IF bf_ins='1' THEN + result(31 downto 0) <= bf_set2; + result(39 downto 32) <= bf_set2(7 downto 0); + ELSIF bf_bchg='1' THEN + result(31 downto 0) <= NOT OP1out; + result(39 downto 32) <= NOT bf_ext_in; + ELSE + result <= (OTHERS => '0'); + END IF; + IF bf_bset='1' THEN + result <= (OTHERS => '1'); + END IF; + + sign <= (OTHERS => '0'); + bf_NFlag <= datareg(to_integer(unsigned(bf_width))); + FOR i in 0 to 31 LOOP + IF i>bf_width(4 downto 0) THEN + datareg(i) <= '0'; + sign(i) <= '1'; + END IF; + END LOOP; + + FOR i in 0 to 39 LOOP + IF copy(i)='1' THEN + result(i) <= result_tmp(i); + END IF; + END LOOP; + + IF bf_exts='1' AND bf_NFlag='1' THEN + bf_datareg <= datareg OR sign; + ELSE + bf_datareg <= datareg; + END IF; +-- bf_datareg <= copy(31 downto 0); +-- result(31 downto 0)<=datareg; +--BFFFO + mask <= datareg; + bf_firstbit <= '0'&bitnr; + bitnr <= "11111"; + IF mask(31 downto 28)="0000" THEN + IF mask(27 downto 24)="0000" THEN + IF mask(23 downto 20)="0000" THEN + IF mask(19 downto 16)="0000" THEN + bitnr(4) <= '0'; + IF mask(15 downto 12)="0000" THEN + IF mask(11 downto 8)="0000" THEN + bitnr(3) <= '0'; + IF mask(7 downto 4)="0000" THEN + bitnr(2) <= '0'; + mux <= mask(3 downto 0); + ELSE + mux <= mask(7 downto 4); + END IF; + ELSE + mux <= mask(11 downto 8); + bitnr(2) <= '0'; + END IF; + ELSE + mux <= mask(15 downto 12); + END IF; + ELSE + mux <= mask(19 downto 16); + bitnr(3) <= '0'; + bitnr(2) <= '0'; + END IF; + ELSE + mux <= mask(23 downto 20); + bitnr(3) <= '0'; + END IF; + ELSE + mux <= mask(27 downto 24); + bitnr(2) <= '0'; + END IF; + ELSE + mux <= mask(31 downto 28); + END IF; + + IF mux(3 downto 2)="00" THEN + bitnr(1) <= '0'; + IF mux(1)='0' THEN + bitnr(0) <= '0'; + END IF; + ELSE + IF mux(3)='0' THEN + bitnr(0) <= '0'; + END IF; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- Rotation +----------------------------------------------------------------------------- +PROCESS (exe_opcode, OP1out, Flags, rot_bits, rot_msb, rot_lsb, rot_rot, exec) + BEGIN + CASE exe_opcode(7 downto 6) IS + WHEN "00" => --Byte + rot_rot <= OP1out(7); + WHEN "01"|"11" => --Word + rot_rot <= OP1out(15); + WHEN "10" => --Long + rot_rot <= OP1out(31); + WHEN OTHERS => NULL; + END CASE; + + CASE rot_bits IS + WHEN "00" => --ASL, ASR + rot_lsb <= '0'; + rot_msb <= rot_rot; + WHEN "01" => --LSL, LSR + rot_lsb <= '0'; + rot_msb <= '0'; + WHEN "10" => --ROXL, ROXR + rot_lsb <= Flags(4); + rot_msb <= Flags(4); + WHEN "11" => --ROL, ROR + rot_lsb <= rot_rot; + rot_msb <= OP1out(0); + WHEN OTHERS => NULL; + END CASE; + + IF exec(rot_nop)='1' THEN + rot_out <= OP1out; + rot_X <= Flags(4); + IF rot_bits="10" THEN --ROXL, ROXR + rot_C <= Flags(4); + ELSE + rot_C <= '0'; + END IF; + ELSE + IF exe_opcode(8)='1' THEN --left + rot_out <= OP1out(30 downto 0)&rot_lsb; + rot_X <= rot_rot; + rot_C <= rot_rot; + ELSE --right + rot_X <= OP1out(0); + rot_C <= OP1out(0); + rot_out <= rot_msb&OP1out(31 downto 1); + CASE exe_opcode(7 downto 6) IS + WHEN "00" => --Byte + rot_out(7) <= rot_msb; + WHEN "01"|"11" => --Word + rot_out(15) <= rot_msb; + WHEN OTHERS => NULL; + END CASE; + END IF; + END IF; + END PROCESS; + +------------------------------------------------------------------------------ +--CCR op +------------------------------------------------------------------------------ +PROCESS (clk, Reset, exe_opcode, exe_datatype, Flags, last_data_read, OP2out, flag_z, OP1IN, c_out, addsub_ofl, + bcd_s, bcd_a, exec) + BEGIN + IF exec(andiSR)='1' THEN + CCRin <= Flags AND last_data_read(7 downto 0); + ELSIF exec(eoriSR)='1' THEN + CCRin <= Flags XOR last_data_read(7 downto 0); + ELSIF exec(oriSR)='1' THEN + CCRin <= Flags OR last_data_read(7 downto 0); + ELSE + CCRin <= OP2out(7 downto 0); + END IF; + +------------------------------------------------------------------------------ +--Flags +------------------------------------------------------------------------------ + flag_z <= "000"; + IF exec(use_XZFlag)='1' AND flags(2)='0' THEN + flag_z <= "000"; + ELSIF OP1in(7 downto 0)="00000000" THEN + flag_z(0) <= '1'; + IF OP1in(15 downto 8)="00000000" THEN + flag_z(1) <= '1'; + IF OP1in(31 downto 16)="0000000000000000" THEN + flag_z(2) <= '1'; + END IF; + END IF; + END IF; + +-- --Flags NZVC + IF exe_datatype="00" THEN --Byte + set_flags <= OP1IN(7)&flag_z(0)&addsub_ofl(0)&c_out(0); + IF exec(opcABCD)='1' THEN + set_flags(0) <= bcd_a(8); + ELSIF exec(opcSBCD)='1' THEN + set_flags(0) <= bcd_s(8); + END IF; + ELSIF exe_datatype="10" OR exec(opcCPMAW)='1' THEN --Long + set_flags <= OP1IN(31)&flag_z(2)&addsub_ofl(2)&c_out(2); + ELSE --Word + set_flags <= OP1IN(15)&flag_z(1)&addsub_ofl(1)&c_out(1); + END IF; + + IF rising_edge(clk) THEN + IF clkena_lw = '1' THEN + IF exec(directSR)='1' OR set_stop='1' THEN + Flags(7 downto 0) <= data_read(7 downto 0); + END IF; + IF exec(directCCR)='1' THEN + Flags(7 downto 0) <= data_read(7 downto 0); + END IF; + + IF exec(opcROT)='1' THEN + asl_VFlag <= ((set_flags(3) XOR rot_rot) OR asl_VFlag); + ELSE + asl_VFlag <= '0'; + END IF; + IF exec(to_CCR)='1' THEN + Flags(7 downto 0) <= CCRin(7 downto 0); --CCR + ELSIF Z_error='1' THEN + IF exe_opcode(8)='0' THEN + Flags(3 downto 0) <= reg_QA(31)&"000"; + ELSE + Flags(3 downto 0) <= "0100"; + END IF; + ELSIF exec(no_Flags)='0' THEN + IF exec(opcADD)='1' THEN + Flags(4) <= set_flags(0); + ELSIF exec(opcROT)='1' AND rot_bits/="11" AND exec(rot_nop)='0' THEN + Flags(4) <= rot_X; + END IF; + + IF (exec(opcADD) OR exec(opcCMP))='1' THEN + Flags(3 downto 0) <= set_flags; + ELSIF exec(opcDIVU)='1' AND DIV_Mode/=3 THEN + IF V_Flag='1' THEN + Flags(3 downto 0) <= "1010"; + ELSE + Flags(3 downto 0) <= OP1IN(15)&flag_z(1)&"00"; + END IF; + ELSIF exec(write_reminder)='1' AND MUL_Mode/=3 THEN -- z-flag MULU.l + Flags(3) <= set_flags(3); + Flags(2) <= set_flags(2) AND Flags(2); + Flags(1) <= '0'; + Flags(0) <= '0'; + ELSIF exec(write_lowlong)='1' AND (MUL_Mode=1 OR MUL_Mode=2) THEN -- flag MULU.l + Flags(3) <= set_flags(3); + Flags(2) <= set_flags(2); + Flags(1) <= set_mV_Flag; --V + Flags(0) <= '0'; + ELSIF exec(opcOR)='1' OR exec(opcAND)='1' OR exec(opcEOR)='1' OR exec(opcMOVE)='1' OR exec(opcMOVEQ)='1' OR exec(opcSWAP)='1' OR exec(opcBF)='1' OR (exec(opcMULU)='1' AND MUL_Mode/=3) THEN + Flags(1 downto 0) <= "00"; + Flags(3 downto 2) <= set_flags(3 downto 2); + IF exec(opcBF)='1' THEN + Flags(3) <= bf_NFlag; + END IF; + ELSIF exec(opcROT)='1' THEN + Flags(3 downto 2) <= set_flags(3 downto 2); + Flags(0) <= rot_C; + IF rot_bits="00" AND ((set_flags(3) XOR rot_rot) OR asl_VFlag)='1' THEN --ASL/ASR + Flags(1) <= '1'; + ELSE + Flags(1) <= '0'; + END IF; + ELSIF exec(opcBITS)='1' THEN + Flags(2) <= NOT one_bit_in; + ELSIF exec(opcCHK)='1' THEN + IF exe_datatype="01" THEN --Word + Flags(3) <= OP1out(15); + ELSE + Flags(3) <= OP1out(31); + END IF; + IF OP1out(15 downto 0)=X"0000" AND (exe_datatype="01" OR OP1out(31 downto 16)=X"0000") THEN + Flags(2) <='1'; + ELSE + Flags(2) <='0'; + END IF; + Flags(1 downto 0) <= "00"; + END IF; + END IF; + END IF; + Flags(7 downto 5) <= "000"; + END IF; + END PROCESS; + +------------------------------------------------------------------------------- +---- MULU/MULS +------------------------------------------------------------------------------- +PROCESS (exe_opcode, OP2out, muls_msb, mulu_reg, FAsign, mulu_sign, reg_QA, faktorB, result_mulu, signedOP) + BEGIN + IF (signedOP='1' AND faktorB(31)='1') OR FAsign='1' THEN + muls_msb <= mulu_reg(63); + ELSE + muls_msb <= '0'; + END IF; + + IF signedOP='1' AND faktorB(31)='1' THEN + mulu_sign <= '1'; + ELSE + mulu_sign <= '0'; + END IF; + + IF MUL_Mode=0 THEN -- 16 Bit + result_mulu(63 downto 32) <= muls_msb&mulu_reg(63 downto 33); + result_mulu(15 downto 0) <= 'X'&mulu_reg(15 downto 1); + IF mulu_reg(0)='1' THEN + IF FAsign='1' THEN + result_mulu(63 downto 47) <= (muls_msb&mulu_reg(63 downto 48)-(mulu_sign&faktorB(31 downto 16))); + ELSE + result_mulu(63 downto 47) <= (muls_msb&mulu_reg(63 downto 48)+(mulu_sign&faktorB(31 downto 16))); + END IF; + END IF; + ELSE -- 32 Bit + result_mulu <= muls_msb&mulu_reg(63 downto 1); + IF mulu_reg(0)='1' THEN + IF FAsign='1' THEN + result_mulu(63 downto 31) <= (muls_msb&mulu_reg(63 downto 32)-(mulu_sign&faktorB)); + ELSE + result_mulu(63 downto 31) <= (muls_msb&mulu_reg(63 downto 32)+(mulu_sign&faktorB)); + END IF; + END IF; + END IF; + IF exe_opcode(15)='1' OR MUL_Mode=0 THEN + faktorB(31 downto 16) <= OP2out(15 downto 0); + faktorB(15 downto 0) <= (OTHERS=>'0'); + ELSE + faktorB <= OP2out; + END IF; + IF (result_mulu(63 downto 32)=X"00000000" AND (signedOP='0' OR result_mulu(31)='0')) OR + (result_mulu(63 downto 32)=X"FFFFFFFF" AND signedOP='1' AND result_mulu(31)='1') THEN + set_mV_Flag <= '0'; + ELSE + set_mV_Flag <= '1'; + END IF; + END PROCESS; + +PROCESS (clk) + BEGIN + IF rising_edge(clk) THEN + IF clkena_lw='1' THEN + IF micro_state=mul1 THEN + mulu_reg(63 downto 32) <= (OTHERS=>'0'); + IF divs='1' AND ((exe_opcode(15)='1' AND reg_QA(15)='1') OR (exe_opcode(15)='0' AND reg_QA(31)='1')) THEN --MULS Neg faktor + FAsign <= '1'; + mulu_reg(31 downto 0) <= 0-reg_QA; + ELSE + FAsign <= '0'; + mulu_reg(31 downto 0) <= reg_QA; + END IF; + ELSIF exec(opcMULU)='0' THEN + mulu_reg <= result_mulu; + END IF; + END IF; + END IF; + END PROCESS; + +------------------------------------------------------------------------------- +---- DIVU/DIVS +------------------------------------------------------------------------------- + +PROCESS (execOPC, OP1out, OP2out, div_reg, div_neg, div_bit, div_sub, div_quot, OP1_sign, div_over, result_div, reg_QA, opcode, sndOPC, divs, exe_opcode, reg_QB, + signedOP, nozero, div_qsign, OP2outext) + BEGIN + divs <= (opcode(15) AND opcode(8)) OR (NOT opcode(15) AND sndOPC(11)); + divisor(15 downto 0) <= (OTHERS=> '0'); + divisor(63 downto 32) <= (OTHERS=> divs AND reg_QA(31)); + IF exe_opcode(15)='1' OR DIV_Mode=0 THEN + divisor(47 downto 16) <= reg_QA; + ELSE + divisor(31 downto 0) <= reg_QA; + IF exe_opcode(14)='1' AND sndOPC(10)='1' THEN + divisor(63 downto 32) <= reg_QB; + END IF; + END IF; + IF signedOP='1' OR opcode(15)='0' THEN + OP2outext <= OP2out(31 downto 16); + ELSE + OP2outext <= (OTHERS=> '0'); + END IF; + IF signedOP='1' AND OP2out(31) ='1' THEN + div_sub <= (div_reg(63 downto 31))+('1'&OP2out(31 downto 0)); + ELSE + div_sub <= (div_reg(63 downto 31))-('0'&OP2outext(15 downto 0)&OP2out(15 downto 0)); + END IF; + IF DIV_Mode=0 THEN + div_bit <= div_sub(16); + ELSE + div_bit <= div_sub(32); + END IF; + IF div_bit='1' THEN + div_quot(63 downto 32) <= div_reg(62 downto 31); + ELSE + div_quot(63 downto 32) <= div_sub(31 downto 0); + END IF; + div_quot(31 downto 0) <= div_reg(30 downto 0)&NOT div_bit; + + + IF ((nozero='1' AND signedOP='1' AND (OP2out(31) XOR OP1_sign XOR div_neg XOR div_qsign)='1' ) --Overflow DIVS + OR (signedOP='0' AND div_over(32)='0')) AND DIV_Mode/=3 THEN --Overflow DIVU + set_V_Flag <= '1'; + ELSE + set_V_Flag <= '0'; + END IF; + END PROCESS; + +PROCESS (clk) + BEGIN + IF rising_edge(clk) THEN + IF clkena_lw='1' THEN + V_Flag <= set_V_Flag; + signedOP <= divs; + IF micro_state=div1 THEN + nozero <= '0'; + IF divs='1' AND divisor(63)='1' THEN -- Neg divisor + OP1_sign <= '1'; + div_reg <= 0-divisor; + ELSE + OP1_sign <= '0'; + div_reg <= divisor; + END IF; + ELSE + div_reg <= div_quot; + nozero <= NOT div_bit OR nozero; + END IF; + IF micro_state=div2 THEN + div_qsign <= NOT div_bit; + div_neg <= signedOP AND (OP2out(31) XOR OP1_sign); + IF DIV_Mode=0 THEN + div_over(32 downto 16) <= ('0'&div_reg(47 downto 32))-('0'&OP2out(15 downto 0)); + ELSE + div_over <= ('0'&div_reg(63 downto 32))-('0'&OP2out); + END IF; + END IF; + IF exec(write_reminder)='0' THEN +-- IF exec_DIVU='0' THEN + IF div_neg='1' THEN + result_div(31 downto 0) <= 0-div_quot(31 downto 0); + ELSE + result_div(31 downto 0) <= div_quot(31 downto 0); + END IF; + + IF OP1_sign='1' THEN + result_div(63 downto 32) <= 0-div_quot(63 downto 32); + ELSE + result_div(63 downto 32) <= div_quot(63 downto 32); + END IF; + END IF; + END IF; + END IF; + END PROCESS; +END; diff --git a/cores/ql/TG68K_Pack.vhd b/cores/ql/TG68K_Pack.vhd new file mode 100644 index 0000000..e6011f1 --- /dev/null +++ b/cores/ql/TG68K_Pack.vhd @@ -0,0 +1,165 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- -- +-- Copyright (c) 2009-2013 Tobias Gubener -- +-- Subdesign fAMpIGA by TobiFlex -- +-- -- +-- This source file is free software: you can redistribute it and/or modify -- +-- it under the terms of the GNU General Public License as published -- +-- by the Free Software Foundation, either version 3 of the License, or -- +-- (at your option) any later version. -- +-- -- +-- This source file is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- +-- GNU General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- along with this program. If not, see . -- +-- -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +library IEEE; +use IEEE.std_logic_1164.all; + +package TG68K_Pack is + + type micro_states is (idle, nop, ld_nn, st_nn, ld_dAn1, ld_AnXn1, ld_AnXn2, st_dAn1, ld_AnXnbd1, ld_AnXnbd2, ld_AnXnbd3, + ld_229_1, ld_229_2, ld_229_3, ld_229_4, st_229_1, st_229_2, st_229_3, st_229_4, + st_AnXn1, st_AnXn2, bra1, bsr1, bsr2, nopnop, dbcc1, movem1, movem2, movem3, + andi, op_AxAy, cmpm, link1, link2, unlink1, unlink2, int1, int2, int3, int4, rte1, rte2, rte3, trap0, trap1, trap2, trap3, + trap4, trap5, trap6, movec1, movep1, movep2, movep3, movep4, movep5, rota1, bf1, + mul1, mul2, mul_end1, mul_end2, div1, div2, div3, div4, div_end1, div_end2); + + constant opcMOVE : integer := 0; -- + constant opcMOVEQ : integer := 1; -- + constant opcMOVESR : integer := 2; -- + constant opcADD : integer := 3; -- + constant opcADDQ : integer := 4; -- + constant opcOR : integer := 5; -- + constant opcAND : integer := 6; -- + constant opcEOR : integer := 7; -- + constant opcCMP : integer := 8; -- + constant opcROT : integer := 9; -- + constant opcCPMAW : integer := 10; + constant opcEXT : integer := 11; -- + constant opcABCD : integer := 12; -- + constant opcSBCD : integer := 13; -- + constant opcBITS : integer := 14; -- + constant opcSWAP : integer := 15; -- + constant opcScc : integer := 16; -- + constant andiSR : integer := 17; -- + constant eoriSR : integer := 18; -- + constant oriSR : integer := 19; -- + constant opcMULU : integer := 20; -- + constant opcDIVU : integer := 21; -- + constant dispouter : integer := 22; -- + constant rot_nop : integer := 23; -- + constant ld_rot_cnt : integer := 24; -- + constant writePC_add : integer := 25; -- + constant ea_data_OP1 : integer := 26; -- + constant ea_data_OP2 : integer := 27; -- + constant use_XZFlag : integer := 28; -- + constant get_bfoffset : integer := 29; -- + constant save_memaddr : integer := 30; -- + constant opcCHK : integer := 31; -- + constant movec_rd : integer := 32; -- + constant movec_wr : integer := 33; -- + constant Regwrena : integer := 34; -- + constant update_FC : integer := 35; -- + constant linksp : integer := 36; -- + constant movepl : integer := 37; -- + constant update_ld : integer := 38; -- + constant OP1addr : integer := 39; -- + constant write_reg : integer := 40; -- + constant changeMode : integer := 41; -- + constant ea_build : integer := 42; -- + constant trap_chk : integer := 43; -- + constant store_ea_data : integer := 44; -- + constant addrlong : integer := 45; -- + constant postadd : integer := 46; -- + constant presub : integer := 47; -- + constant subidx : integer := 48; -- + constant no_Flags : integer := 49; -- + constant use_SP : integer := 50; -- + constant to_CCR : integer := 51; -- + constant to_SR : integer := 52; -- + constant OP2out_one : integer := 53; -- + constant OP1out_zero : integer := 54; -- + constant mem_addsub : integer := 55; -- + constant addsub : integer := 56; -- + constant directPC : integer := 57; -- + constant direct_delta : integer := 58; -- + constant directSR : integer := 59; -- + constant directCCR : integer := 60; -- + constant exg : integer := 61; -- + constant get_ea_now : integer := 62; -- + constant ea_to_pc : integer := 63; -- + constant hold_dwr : integer := 64; -- + constant to_USP : integer := 65; -- + constant from_USP : integer := 66; -- + constant write_lowlong : integer := 67; -- + constant write_reminder : integer := 68; -- + constant movem_action : integer := 69; -- + constant briefext : integer := 70; -- + constant get_2ndOPC : integer := 71; -- + constant mem_byte : integer := 72; -- + constant longaktion : integer := 73; -- + constant opcRESET : integer := 74; -- + constant opcBF : integer := 75; -- + constant opcBFwb : integer := 76; -- + constant s2nd_hbits : integer := 77; -- +-- constant : integer := 75; -- +-- constant : integer := 76; -- +-- constant : integer := 7; -- +-- constant : integer := 7; -- +-- constant : integer := 7; -- + + constant lastOpcBit : integer := 77; + + component TG68K_ALU + generic( + MUL_Mode : integer := 0; --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no MUL, + DIV_Mode : integer := 0 --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no DIV, + ); + port( + clk : in std_logic; + Reset : in std_logic; + clkena_lw : in std_logic:='1'; + execOPC : in bit; + exe_condition : in std_logic; + exec_tas : in std_logic; + long_start : in bit; + movem_presub : in bit; + set_stop : in bit; + Z_error : in bit; + rot_bits : in std_logic_vector(1 downto 0); + exec : in bit_vector(lastOpcBit downto 0); + OP1out : in std_logic_vector(31 downto 0); + OP2out : in std_logic_vector(31 downto 0); + reg_QA : in std_logic_vector(31 downto 0); + reg_QB : in std_logic_vector(31 downto 0); + opcode : in std_logic_vector(15 downto 0); + datatype : in std_logic_vector(1 downto 0); + exe_opcode : in std_logic_vector(15 downto 0); + exe_datatype : in std_logic_vector(1 downto 0); + sndOPC : in std_logic_vector(15 downto 0); + last_data_read : in std_logic_vector(15 downto 0); + data_read : in std_logic_vector(15 downto 0); + FlagsSR : in std_logic_vector(7 downto 0); + micro_state : in micro_states; + bf_ext_in : in std_logic_vector(7 downto 0); + bf_ext_out : out std_logic_vector(7 downto 0); + bf_shift : in std_logic_vector(5 downto 0); + bf_width : in std_logic_vector(5 downto 0); + bf_loffset : in std_logic_vector(4 downto 0); + + set_V_Flag : buffer bit; + Flags : buffer std_logic_vector(7 downto 0); + c_out : buffer std_logic_vector(2 downto 0); + addsub_q : buffer std_logic_vector(31 downto 0); + ALUout : out std_logic_vector(31 downto 0) + ); + end component; + +end; \ No newline at end of file diff --git a/cores/ql/TG68KdotC_Kernel.vhd b/cores/ql/TG68KdotC_Kernel.vhd new file mode 100644 index 0000000..581ac4e --- /dev/null +++ b/cores/ql/TG68KdotC_Kernel.vhd @@ -0,0 +1,3231 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- -- +-- Copyright (c) 2009-2013 Tobias Gubener -- +-- Subdesign fAMpIGA by TobiFlex -- +-- -- +-- This source file is free software: you can redistribute it and/or modify -- +-- it under the terms of the GNU General Public License as published -- +-- by the Free Software Foundation, either version 3 of the License, or -- +-- (at your option) any later version. -- +-- -- +-- This source file is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- +-- GNU General Public License for more details. -- +-- -- +-- You should have received a copy of the GNU General Public License -- +-- along with this program. If not, see . -- +-- -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- add berr handling 10.03.2013 + +-- bugfix session 07/08.Feb.2013 +-- movem ,-(an) +-- movem (an)+, - thanks Gerhard Suttner +-- btst dn,#data - thanks Peter Graf +-- movep - thanks Till Harbaum +-- IPL vector - thanks Till Harbaum +-- + +-- optimize Register file + +-- to do 68010: +-- (MOVEC) +-- BKPT +-- RTD +-- MOVES +-- +-- to do 68020: +-- (CALLM) +-- (RETM) + +-- CAS, CAS2 +-- CHK2 +-- CMP2 +-- cpXXX Coprozessor stuff +-- PACK +-- TRAPcc +-- UNPK + +-- done 020: +-- Bitfields +-- address modes +-- long bra +-- DIVS.L, DIVU.L +-- LINK long +-- MULS.L, MULU.L +-- extb.l + +library ieee; +use ieee.std_logic_1164.all; +use ieee.std_logic_unsigned.all; +use work.TG68K_Pack.all; + +entity TG68KdotC_Kernel is + generic( + SR_Read : integer:= 0; --0=>user, 1=>privileged, 2=>switchable with CPU(0) + VBR_Stackframe : integer:= 0; --0=>no, 1=>yes/extended, 2=>switchable with CPU(0) + extAddr_Mode : integer:= 0; --0=>no, 1=>yes, 2=>switchable with CPU(1) + MUL_Mode : integer := 0; --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no MUL, + DIV_Mode : integer := 0; --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no DIV, + BitField : integer := 0 --0=>no, 1=>yes, 2=>switchable with CPU(1) + ); + port(clk : in std_logic; + nReset : in std_logic; --low active + clkena_in : in std_logic:='1'; + data_in : in std_logic_vector(15 downto 0); + IPL : in std_logic_vector(2 downto 0):="111"; + IPL_autovector : in std_logic:='0'; + berr : in std_logic:='0'; -- only 68000 Stackpointer dummy + CPU : in std_logic_vector(1 downto 0):="00"; -- 00->68000 01->68010 11->68020(only some parts - yet) + addr : buffer std_logic_vector(31 downto 0); + data_write : out std_logic_vector(15 downto 0); + nWr : out std_logic; + nUDS, nLDS : out std_logic; + busstate : out std_logic_vector(1 downto 0); -- 00-> fetch code 10->read data 11->write data 01->no memaccess + nResetOut : out std_logic; + FC : out std_logic_vector(2 downto 0); +-- + clr_berr : out std_logic; +-- for debug + db_OP1out : out std_logic_vector(31 downto 0); + db_OP2out : out std_logic_vector(31 downto 0); + skipFetch : out std_logic; + regin : buffer std_logic_vector(31 downto 0) + ); +end TG68KdotC_Kernel; + +architecture logic of TG68KdotC_Kernel is + + + signal syncReset : std_logic_vector(3 downto 0); + signal Reset : std_logic; + signal clkena_lw : std_logic; + signal TG68_PC : std_logic_vector(31 downto 0); + signal tmp_TG68_PC : std_logic_vector(31 downto 0); + signal TG68_PC_add : std_logic_vector(31 downto 0); + signal PC_dataa : std_logic_vector(31 downto 0); + signal PC_datab : std_logic_vector(31 downto 0); + signal memaddr : std_logic_vector(31 downto 0); + signal state : std_logic_vector(1 downto 0); + signal datatype : std_logic_vector(1 downto 0); + signal set_datatype : std_logic_vector(1 downto 0); + signal exe_datatype : std_logic_vector(1 downto 0); + signal setstate : std_logic_vector(1 downto 0); + + signal opcode : std_logic_vector(15 downto 0); + signal exe_opcode : std_logic_vector(15 downto 0); + signal sndOPC : std_logic_vector(15 downto 0); + + signal last_opc_read : std_logic_vector(15 downto 0); + signal registerin : std_logic_vector(31 downto 0); + signal reg_QA : std_logic_vector(31 downto 0); + signal reg_QB : std_logic_vector(31 downto 0); + signal Wwrena,Lwrena : bit; + signal Bwrena : bit; + signal Regwrena_now : bit; + signal rf_dest_addr : std_logic_vector(3 downto 0); + signal rf_source_addr : std_logic_vector(3 downto 0); + signal rf_source_addrd : std_logic_vector(3 downto 0); + + type regfile_t is array(0 to 15) of std_logic_vector(31 downto 0); + signal regfile : regfile_t; + signal RDindex_A : integer range 0 to 15; + signal RDindex_B : integer range 0 to 15; + signal WR_AReg : std_logic; + + + signal memaddr_reg : std_logic_vector(31 downto 0); + signal memaddr_delta : std_logic_vector(31 downto 0); + signal use_base : bit; + + signal ea_data : std_logic_vector(31 downto 0); + signal OP1out, OP2out : std_logic_vector(31 downto 0); + signal OP1outbrief : std_logic_vector(15 downto 0); + signal OP1in : std_logic_vector(31 downto 0); + signal ALUout : std_logic_vector(31 downto 0); + signal data_write_tmp : std_logic_vector(31 downto 0); + signal data_write_muxin : std_logic_vector(31 downto 0); + signal data_write_mux : std_logic_vector(47 downto 0); + signal nextpass : bit; + signal setnextpass : bit; + signal setdispbyte : bit; + signal setdisp : bit; + signal regdirectsource :bit; -- checken !!! + signal addsub_q : std_logic_vector(31 downto 0); + signal briefdata : std_logic_vector(31 downto 0); +-- signal c_in : std_logic_vector(3 downto 0); + signal c_out : std_logic_vector(2 downto 0); + + signal mem_address : std_logic_vector(31 downto 0); + signal memaddr_a : std_logic_vector(31 downto 0); + + signal TG68_PC_brw : bit; + signal TG68_PC_word : bit; + signal getbrief : bit; + signal brief : std_logic_vector(15 downto 0); + signal dest_areg : std_logic; + signal source_areg : std_logic; + signal data_is_source : bit; + signal store_in_tmp : bit; + signal write_back : bit; + signal exec_write_back: bit; + signal setstackaddr : bit; + signal writePC : bit; + signal writePCbig : bit; + signal set_writePCbig : bit; + signal setopcode : bit; + signal decodeOPC : bit; + signal execOPC : bit; + signal setexecOPC : bit; + signal endOPC : bit; + signal setendOPC : bit; + signal Flags : std_logic_vector(7 downto 0); -- ...XNZVC + signal FlagsSR : std_logic_vector(7 downto 0); -- T.S..III + signal SRin : std_logic_vector(7 downto 0); + signal exec_DIRECT : bit; + signal exec_tas : std_logic; + signal set_exec_tas : std_logic; + + signal exe_condition : std_logic; + signal ea_only : bit; + signal source_lowbits : bit; + signal source_2ndHbits : bit; + signal source_2ndLbits : bit; + signal dest_2ndHbits : bit; + signal dest_hbits : bit; + signal rot_bits : std_logic_vector(1 downto 0); + signal set_rot_bits : std_logic_vector(1 downto 0); + signal rot_cnt : std_logic_vector(5 downto 0); + signal set_rot_cnt : std_logic_vector(5 downto 0); + signal movem_actiond : bit; + signal movem_regaddr : std_logic_vector(3 downto 0); + signal movem_mux : std_logic_vector(3 downto 0); + signal movem_presub : bit; + signal movem_run : bit; + signal ea_calc_b : std_logic_vector(31 downto 0); + signal set_direct_data: bit; + signal use_direct_data: bit; + signal direct_data : bit; + + signal set_V_Flag : bit; + signal set_vectoraddr : bit; + signal writeSR : bit; + signal trap_berr : bit; + signal trap_illegal : bit; + signal trap_addr_error : bit; + signal trap_priv : bit; + signal trap_trace : bit; + signal trap_1010 : bit; + signal trap_1111 : bit; + signal trap_trap : bit; + signal trap_trapv : bit; + signal trap_interrupt : bit; + signal trapmake : bit; + signal trapd : bit; + signal trap_SR : std_logic_vector(7 downto 0); + signal make_trace : std_logic; + signal make_berr : std_logic; + + signal set_stop : bit; + signal stop : bit; + signal trap_vector : std_logic_vector(31 downto 0); + signal trap_vector_vbr : std_logic_vector(31 downto 0); + signal USP : std_logic_vector(31 downto 0); + signal illegal_write_mode : bit; + signal illegal_read_mode : bit; + signal illegal_byteaddr : bit; + + signal IPL_nr : std_logic_vector(2 downto 0); + signal rIPL_nr : std_logic_vector(2 downto 0); + signal IPL_vec : std_logic_vector(7 downto 0); + signal interrupt : bit; + signal setinterrupt : bit; + signal SVmode : std_logic; + signal preSVmode : std_logic; + signal Suppress_Base : bit; + signal set_Suppress_Base : bit; + signal set_Z_error : bit; + signal Z_error : bit; + signal ea_build_now : bit; + signal build_logical : bit; + signal build_bcd : bit; + + signal data_read : std_logic_vector(31 downto 0); + signal bf_ext_in : std_logic_vector(7 downto 0); + signal bf_ext_out : std_logic_vector(7 downto 0); + signal byte : bit; + signal long_start : bit; + signal long_start_alu : bit; + signal long_done : bit; + signal memmask : std_logic_vector(5 downto 0); + signal set_memmask : std_logic_vector(5 downto 0); + signal memread : std_logic_vector(3 downto 0); + signal wbmemmask : std_logic_vector(5 downto 0); + signal memmaskmux : std_logic_vector(5 downto 0); + signal oddout : std_logic; + signal set_oddout : std_logic; + signal PCbase : std_logic; + signal set_PCbase : std_logic; + + signal last_data_read : std_logic_vector(31 downto 0); + signal last_data_in : std_logic_vector(31 downto 0); + + signal bf_offset : std_logic_vector(5 downto 0); + signal bf_width : std_logic_vector(5 downto 0); + signal bf_bhits : std_logic_vector(5 downto 0); + signal bf_shift : std_logic_vector(5 downto 0); + signal alu_width : std_logic_vector(5 downto 0); + signal alu_bf_shift : std_logic_vector(5 downto 0); + signal bf_loffset : std_logic_vector(5 downto 0); + signal alu_bf_loffset : std_logic_vector(5 downto 0); + + signal movec_data : std_logic_vector(31 downto 0); + signal VBR : std_logic_vector(31 downto 0); + signal CACR : std_logic_vector(3 downto 0); + signal DFC : std_logic_vector(2 downto 0); + signal SFC : std_logic_vector(2 downto 0); + + + signal set : bit_vector(lastOpcBit downto 0); + signal set_exec : bit_vector(lastOpcBit downto 0); + signal exec : bit_vector(lastOpcBit downto 0); + + signal micro_state : micro_states; + signal next_micro_state : micro_states; + + + +BEGIN +db_OP1out <= OP1out; +db_OP2out <= OP2out; + +ALU: TG68K_ALU + generic map( + MUL_Mode => MUL_Mode, --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no MUL, + DIV_Mode => DIV_Mode --0=>16Bit, 1=>32Bit, 2=>switchable with CPU(1), 3=>no DIV, + ) + port map( + clk => clk, --: in std_logic; + Reset => Reset, --: in std_logic; + clkena_lw => clkena_lw, --: in std_logic:='1'; + execOPC => execOPC, --: in bit; + exe_condition => exe_condition, --: in std_logic; + exec_tas => exec_tas, --: in std_logic; + long_start => long_start_alu, --: in bit; + movem_presub => movem_presub, --: in bit; + set_stop => set_stop, --: in bit; + Z_error => Z_error, --: in bit; + + rot_bits => rot_bits, --: in std_logic_vector(1 downto 0); + exec => exec, --: in bit_vector(lastOpcBit downto 0); + OP1out => OP1out, --: in std_logic_vector(31 downto 0); + OP2out => OP2out, --: in std_logic_vector(31 downto 0); + reg_QA => reg_QA, --: in std_logic_vector(31 downto 0); + reg_QB => reg_QB, --: in std_logic_vector(31 downto 0); + opcode => opcode, --: in std_logic_vector(15 downto 0); + datatype => datatype, --: in std_logic_vector(1 downto 0); + exe_opcode => exe_opcode, --: in std_logic_vector(15 downto 0); + exe_datatype => exe_datatype, --: in std_logic_vector(1 downto 0); + sndOPC => sndOPC, --: in std_logic_vector(15 downto 0); + last_data_read => last_data_read(15 downto 0), --: in std_logic_vector(31 downto 0); + data_read => data_read(15 downto 0), --: in std_logic_vector(31 downto 0); + FlagsSR => FlagsSR, --: in std_logic_vector(7 downto 0); + micro_state => micro_state, --: in micro_states; + bf_ext_in => bf_ext_in, + bf_ext_out => bf_ext_out, + bf_shift => alu_bf_shift, + bf_width => alu_width, + bf_loffset => alu_bf_loffset(4 downto 0), + + set_V_Flag => set_V_Flag, --: buffer bit; + Flags => Flags, --: buffer std_logic_vector(8 downto 0); + c_out => c_out, --: buffer std_logic_vector(2 downto 0); + addsub_q => addsub_q, --: buffer std_logic_vector(31 downto 0); + ALUout => ALUout --: buffer std_logic_vector(31 downto 0) + ); + + long_start_alu <= to_bit(NOT memmaskmux(3)); +----------------------------------------------------------------------------- +-- Bus control +----------------------------------------------------------------------------- + nWr <= '0' WHEN state="11" ELSE '1'; + busstate <= state; + nResetOut <= '0' WHEN exec(opcRESET)='1' ELSE '1'; + memmaskmux <= memmask WHEN addr(0)='1' ELSE memmask(4 downto 0)&'1'; + nUDS <= memmaskmux(5); + nLDS <= memmaskmux(4); + clkena_lw <= '1' WHEN clkena_in='1' AND memmaskmux(3)='1' ELSE '0'; + clr_berr <= '1' WHEN setopcode='1' AND trap_berr='1' ELSE '0'; + + PROCESS (clk, nReset) + BEGIN + IF nReset='0' THEN + syncReset <= "0000"; + Reset <= '1'; + ELSIF rising_edge(clk) THEN + IF clkena_in='1' THEN + syncReset <= syncReset(2 downto 0)&'1'; + Reset <= NOT syncReset(3); + END IF; + END IF; + END PROCESS; + +PROCESS (clk, long_done, last_data_in, data_in, byte, addr, long_start, memmaskmux, memread, memmask, data_read) + BEGIN + IF memmaskmux(4)='0' THEN + data_read <= last_data_in(15 downto 0)&data_in; + ELSE + data_read <= last_data_in(23 downto 0)&data_in(15 downto 8); + END IF; + IF memread(0)='1' OR (memread(1 downto 0)="10" AND memmaskmux(4)='1')THEN + data_read(31 downto 16) <= (OTHERS=>data_read(15)); + END IF; + + IF rising_edge(clk) THEN + IF clkena_lw='1' AND state="10" THEN + IF memmaskmux(4)='0' THEN + bf_ext_in <= last_data_in(23 downto 16); + ELSE + bf_ext_in <= last_data_in(31 downto 24); + END IF; + END IF; + IF Reset='1' THEN + last_data_read <= (OTHERS => '0'); + ELSIF clkena_in='1' THEN + IF state="00" OR exec(update_ld)='1' THEN + last_data_read <= data_read; + IF state(1)='0' AND memmask(1)='0' THEN + last_data_read(31 downto 16) <= last_opc_read; + ELSIF state(1)='0' OR memread(1)='1' THEN + last_data_read(31 downto 16) <= (OTHERS=>data_in(15)); + END IF; + END IF; + last_data_in <= last_data_in(15 downto 0)&data_in(15 downto 0); + + END IF; + END IF; + long_start <= to_bit(NOT memmask(1)); + long_done <= to_bit(NOT memread(1)); + END PROCESS; + +PROCESS (byte, long_start, reg_QB, data_write_tmp, exec, data_read, data_write_mux, memmaskmux, bf_ext_out, + data_write_muxin, memmask, oddout, addr) + BEGIN + IF exec(write_reg)='1' THEN + data_write_muxin <= reg_QB; + ELSE + data_write_muxin <= data_write_tmp; + END IF; + + IF BitField=0 THEN + IF oddout=addr(0) THEN + data_write_mux <= "XXXXXXXX"&"XXXXXXXX"&data_write_muxin; + ELSE + data_write_mux <= "XXXXXXXX"&data_write_muxin&"XXXXXXXX"; + END IF; + ELSE + IF oddout=addr(0) THEN + data_write_mux <= "XXXXXXXX"&bf_ext_out&data_write_muxin; + ELSE + data_write_mux <= bf_ext_out&data_write_muxin&"XXXXXXXX"; + END IF; + END IF; + + IF memmaskmux(1)='0' THEN + data_write <= data_write_mux(47 downto 32); + ELSIF memmaskmux(3)='0' THEN + data_write <= data_write_mux(31 downto 16); + ELSE + data_write <= data_write_mux(15 downto 0); + END IF; + IF exec(mem_byte)='1' THEN --movep + data_write(7 downto 0) <= data_write_tmp(15 downto 8); + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- Registerfile +----------------------------------------------------------------------------- +PROCESS (clk, regfile, RDindex_A, RDindex_B, exec) + BEGIN + reg_QA <= regfile(RDindex_A); + reg_QB <= regfile(RDindex_B); + IF rising_edge(clk) THEN + IF clkena_lw='1' THEN + rf_source_addrd <= rf_source_addr; + WR_AReg <= rf_dest_addr(3); + RDindex_A <= conv_integer(rf_dest_addr(3 downto 0)); + RDindex_B <= conv_integer(rf_source_addr(3 downto 0)); + IF Wwrena='1' THEN + regfile(RDindex_A) <= regin; + END IF; + + IF exec(to_USP)='1' THEN + USP <= reg_QA; + END IF; + END IF; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- Write Reg +----------------------------------------------------------------------------- +PROCESS (OP1in, reg_QA, Regwrena_now, Bwrena, Lwrena, exe_datatype, WR_AReg, movem_actiond, exec, ALUout, memaddr, memaddr_a, ea_only, USP, movec_data) + BEGIN + regin <= ALUout; + IF exec(save_memaddr)='1' THEN + regin <= memaddr; + ELSIF exec(get_ea_now)='1' AND ea_only='1' THEN + regin <= memaddr_a; + ELSIF exec(from_USP)='1' THEN + regin <= USP; + ELSIF exec(movec_rd)='1' THEN + regin <= movec_data; + END IF; + + IF Bwrena='1' THEN + regin(15 downto 8) <= reg_QA(15 downto 8); + END IF; + IF Lwrena='0' THEN + regin(31 downto 16) <= reg_QA(31 downto 16); + END IF; + + Bwrena <= '0'; + Wwrena <= '0'; + Lwrena <= '0'; + IF exec(presub)='1' OR exec(postadd)='1' OR exec(changeMode)='1' THEN -- -(An)+ + Wwrena <= '1'; + Lwrena <= '1'; + ELSIF Regwrena_now='1' THEN --dbcc + Wwrena <= '1'; + ELSIF exec(Regwrena)='1' THEN --read (mem) + Wwrena <= '1'; + CASE exe_datatype IS + WHEN "00" => --BYTE + Bwrena <= '1'; + WHEN "01" => --WORD + IF WR_AReg='1' OR movem_actiond='1' THEN + Lwrena <='1'; + END IF; + WHEN OTHERS => --LONG + Lwrena <= '1'; + END CASE; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- set dest regaddr +----------------------------------------------------------------------------- +PROCESS (opcode, rf_source_addrd, brief, setstackaddr, dest_hbits, dest_areg, data_is_source, sndOPC, exec, set, dest_2ndHbits) + BEGIN + IF exec(movem_action) ='1' THEN + rf_dest_addr <= rf_source_addrd; + ELSIF set(briefext)='1' THEN + rf_dest_addr <= brief(15 downto 12); + ELSIF set(get_bfoffset)='1' THEN + rf_dest_addr <= sndOPC(9 downto 6); + ELSIF dest_2ndHbits='1' THEN + rf_dest_addr <= sndOPC(15 downto 12); + ELSIF set(write_reminder)='1' THEN + rf_dest_addr <= sndOPC(3 downto 0); + ELSIF setstackaddr='1' THEN + rf_dest_addr <= "1111"; + ELSIF dest_hbits='1' THEN + rf_dest_addr <= dest_areg&opcode(11 downto 9); + ELSE + IF opcode(5 downto 3)="000" OR data_is_source='1' THEN + rf_dest_addr <= dest_areg&opcode(2 downto 0); + ELSE + rf_dest_addr <= '1'&opcode(2 downto 0); + END IF; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- set source regaddr +----------------------------------------------------------------------------- +PROCESS (opcode, movem_presub, movem_regaddr, source_lowbits, source_areg, sndOPC, exec, set, source_2ndLbits, source_2ndHbits) + BEGIN + IF exec(movem_action)='1' OR set(movem_action) ='1' THEN + IF movem_presub='1' THEN + rf_source_addr <= movem_regaddr XOR "1111"; + ELSE + rf_source_addr <= movem_regaddr; + END IF; + ELSIF source_2ndLbits='1' THEN + rf_source_addr <= sndOPC(3 downto 0); + ELSIF source_2ndHbits='1' THEN + rf_source_addr <= sndOPC(15 downto 12); + ELSIF source_lowbits='1' THEN + rf_source_addr <= source_areg&opcode(2 downto 0); + ELSIF exec(linksp)='1' THEN + rf_source_addr <= "1111"; + ELSE + rf_source_addr <= source_areg&opcode(11 downto 9); + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- set OP1out +----------------------------------------------------------------------------- +PROCESS (reg_QA, store_in_tmp, ea_data, long_start, addr, exec, memmaskmux) + BEGIN + OP1out <= reg_QA; + IF exec(OP1out_zero)='1' THEN + OP1out <= (OTHERS => '0'); + ELSIF exec(ea_data_OP1)='1' AND store_in_tmp='1' THEN + OP1out <= ea_data; + ELSIF exec(movem_action)='1' OR memmaskmux(3)='0' OR exec(OP1addr)='1' THEN + OP1out <= addr; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- set OP2out +----------------------------------------------------------------------------- +PROCESS (OP2out, reg_QB, exe_opcode, exe_datatype, execOPC, exec, use_direct_data, + store_in_tmp, data_write_tmp, ea_data) + BEGIN + OP2out(15 downto 0) <= reg_QB(15 downto 0); + OP2out(31 downto 16) <= (OTHERS => OP2out(15)); + IF exec(OP2out_one)='1' THEN + OP2out(15 downto 0) <= "1111111111111111"; + ELSIF exec(opcEXT)='1' THEN + IF exe_opcode(6)='0' OR exe_opcode(8)='1' THEN --ext.w + OP2out(15 downto 8) <= (OTHERS => OP2out(7)); + END IF; + ELSIF use_direct_data='1' OR (exec(exg)='1' AND execOPC='1') OR exec(get_bfoffset)='1' THEN + OP2out <= data_write_tmp; + ELSIF (exec(ea_data_OP1)='0' AND store_in_tmp='1') OR exec(ea_data_OP2)='1' THEN + OP2out <= ea_data; + ELSIF exec(opcMOVEQ)='1' THEN + OP2out(7 downto 0) <= exe_opcode(7 downto 0); + OP2out(15 downto 8) <= (OTHERS => exe_opcode(7)); + ELSIF exec(opcADDQ)='1' THEN + OP2out(2 downto 0) <= exe_opcode(11 downto 9); + IF exe_opcode(11 downto 9)="000" THEN + OP2out(3) <='1'; + ELSE + OP2out(3) <='0'; + END IF; + OP2out(15 downto 4) <= (OTHERS => '0'); + ELSIF exe_datatype="10" THEN + OP2out(31 downto 16) <= reg_QB(31 downto 16); + END IF; + END PROCESS; + + +----------------------------------------------------------------------------- +-- handle EA_data, data_write +----------------------------------------------------------------------------- +PROCESS (clk) + BEGIN + IF rising_edge(clk) THEN + IF Reset = '1' THEN + store_in_tmp <='0'; + exec_write_back <= '0'; + direct_data <= '0'; + use_direct_data <= '0'; + Z_error <= '0'; + ELSIF clkena_lw='1' THEN + direct_data <= '0'; + IF state="11" THEN + exec_write_back <= '0'; + ELSIF setstate="10" AND write_back='1' THEN + exec_write_back <= '1'; + END IF; + + + IF set_direct_data='1' THEN + direct_data <= '1'; + use_direct_data <= '1'; + ELSIF endOPC='1' THEN + use_direct_data <= '0'; + END IF; + exec_DIRECT <= set_exec(opcMOVE); + + IF endOPC='1' THEN + store_in_tmp <='0'; + Z_error <= '0'; + ELSE + IF set_Z_error='1' THEN + Z_error <= '1'; + END IF; + IF set_exec(opcMOVE)='1' AND state="11" THEN + use_direct_data <= '1'; + END IF; + + IF state="10" THEN + store_in_tmp <= '1'; + END IF; + IF direct_data='1' AND state="00" THEN + store_in_tmp <= '1'; + END IF; + END IF; + IF state="10" THEN + ea_data <= data_read; + ELSIF exec(get_2ndOPC)='1' THEN + ea_data <= addr; + ELSIF exec(store_ea_data)='1' OR (direct_data='1' AND state="00") THEN + ea_data <= last_data_read; + END IF; + + IF writePC='1' THEN + data_write_tmp <= TG68_PC; + ELSIF exec(writePC_add)='1' THEN + data_write_tmp <= TG68_PC_add; + ELSIF micro_state=trap0 THEN + data_write_tmp(15 downto 0) <= trap_vector(15 downto 0); + ELSIF exec(hold_dwr)='1' THEN + data_write_tmp <= data_write_tmp; + ELSIF exec(exg)='1' THEN + data_write_tmp <= OP1out; + ELSIF exec(get_ea_now)='1' AND ea_only='1' THEN -- ist for pea + data_write_tmp <= addr; + ELSIF execOPC='1' THEN + data_write_tmp <= ALUout; + ELSIF (exec_DIRECT='1' AND state="10") THEN + data_write_tmp <= data_read; + IF exec(movepl)='1' THEN + data_write_tmp(31 downto 8) <= data_write_tmp(23 downto 0); + END IF; + ELSIF exec(movepl)='1' THEN + data_write_tmp(15 downto 0) <= reg_QB(31 downto 16); + ELSIF direct_data='1' THEN + data_write_tmp <= last_data_read; + ELSIF writeSR='1'THEN + data_write_tmp(15 downto 0) <= trap_SR(7 downto 0)& Flags(7 downto 0); + ELSE + data_write_tmp <= OP2out; + END IF; + END IF; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- brief +----------------------------------------------------------------------------- +PROCESS (brief, OP1out, OP1outbrief, cpu) + BEGIN + IF brief(11)='1' THEN + OP1outbrief <= OP1out(31 downto 16); + ELSE + OP1outbrief <= (OTHERS=>OP1out(15)); + END IF; + briefdata <= OP1outbrief&OP1out(15 downto 0); + IF extAddr_Mode=1 OR (cpu(1)='1' AND extAddr_Mode=2) THEN + CASE brief(10 downto 9) IS + WHEN "00" => briefdata <= OP1outbrief&OP1out(15 downto 0); + WHEN "01" => briefdata <= OP1outbrief(14 downto 0)&OP1out(15 downto 0)&'0'; + WHEN "10" => briefdata <= OP1outbrief(13 downto 0)&OP1out(15 downto 0)&"00"; + WHEN "11" => briefdata <= OP1outbrief(12 downto 0)&OP1out(15 downto 0)&"000"; + WHEN OTHERS => NULL; + END CASE; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- MEM_IO +----------------------------------------------------------------------------- +PROCESS (clk, setdisp, memaddr_a, briefdata, memaddr_delta, setdispbyte, datatype, interrupt, rIPL_nr, IPL_vec, + memaddr_reg, reg_QA, use_base, VBR, last_data_read, trap_vector, exec, set, cpu) + BEGIN + + IF rising_edge(clk) THEN + IF clkena_lw='1' THEN +-- trap_vector(31 downto 8) <= (others => '0'); + trap_vector(31 downto 10) <= (others => '0'); +-- IF trap_addr_fault='1' THEN + IF trap_berr='1' THEN + trap_vector(9 downto 0) <= "00" & X"08"; + END IF; + IF trap_addr_error='1' THEN + trap_vector(9 downto 0) <= "00" & X"0C"; + END IF; + IF trap_illegal='1' THEN + trap_vector(9 downto 0) <= "00" & X"10"; + END IF; + IF z_error='1' THEN + trap_vector(9 downto 0) <= "00" & X"14"; + END IF; + IF exec(trap_chk)='1' THEN + trap_vector(9 downto 0) <= "00" & X"18"; + END IF; + IF trap_trapv='1' THEN + trap_vector(9 downto 0) <= "00" & X"1C"; + END IF; + IF trap_priv='1' THEN + trap_vector(9 downto 0) <= "00" & X"20"; + END IF; + IF trap_trace='1' THEN + trap_vector(9 downto 0) <= "00" & X"24"; + END IF; + IF trap_1010='1' THEN + trap_vector(9 downto 0) <= "00" & X"28"; + END IF; + IF trap_1111='1' THEN + trap_vector(9 downto 0) <= "00" & X"2C"; + END IF; + IF trap_trap='1' THEN + trap_vector(9 downto 0) <= "0010" & opcode(3 downto 0) & "00"; + END IF; + IF trap_interrupt='1' or set_vectoraddr = '1' THEN + trap_vector(9 downto 0) <= IPL_vec & "00"; --TH + END IF; + -- TH TODO: non-autovector IRQs + END IF; + END IF; + IF VBR_Stackframe=0 OR (cpu(0)='0' AND VBR_Stackframe=2) THEN + trap_vector_vbr <= trap_vector; + ELSE + trap_vector_vbr <= trap_vector+VBR; + END IF; + + memaddr_a(4 downto 0) <= "00000"; + memaddr_a(7 downto 5) <= (OTHERS=>memaddr_a(4)); + memaddr_a(15 downto 8) <= (OTHERS=>memaddr_a(7)); + memaddr_a(31 downto 16) <= (OTHERS=>memaddr_a(15)); + IF setdisp='1' THEN + IF exec(briefext)='1' THEN + memaddr_a <= briefdata+memaddr_delta; + ELSIF setdispbyte='1' THEN + memaddr_a(7 downto 0) <= last_data_read(7 downto 0); + ELSE + memaddr_a <= last_data_read; + END IF; + ELSIF set(presub)='1' THEN + IF set(longaktion)='1' THEN + memaddr_a(4 downto 0) <= "11100"; + ELSIF datatype="00" AND set(use_SP)='0' THEN + memaddr_a(4 downto 0) <= "11111"; + ELSE + memaddr_a(4 downto 0) <= "11110"; + END IF; + ELSIF interrupt='1' THEN + memaddr_a(4 downto 0) <= '1'&rIPL_nr&'0'; + END IF; + + IF rising_edge(clk) THEN + IF clkena_in='1' THEN + IF exec(get_2ndOPC)='1' OR (state="10" AND memread(0)='1') THEN + tmp_TG68_PC <= addr; + END IF; + use_base <= '0'; + IF memmaskmux(3)='0' OR exec(mem_addsub)='1' THEN + memaddr_delta <= addsub_q; + ELSIF state="01" AND exec_write_back='1' THEN + memaddr_delta <= tmp_TG68_PC; + ELSIF exec(direct_delta)='1' THEN + memaddr_delta <= data_read; + ELSIF exec(ea_to_pc)='1' AND setstate="00" THEN + memaddr_delta <= addr; + ELSIF set(addrlong)='1' THEN + memaddr_delta <= last_data_read; + ELSIF setstate="00" THEN + memaddr_delta <= TG68_PC_add; + ELSIF exec(dispouter)='1' THEN + memaddr_delta <= ea_data+memaddr_a; + ELSIF set_vectoraddr='1' THEN + memaddr_delta <= trap_vector_vbr; + ELSE + memaddr_delta <= memaddr_a; + IF interrupt='0' AND Suppress_Base='0' THEN +-- IF interrupt='0' AND Suppress_Base='0' AND setstate(1)='1' THEN + use_base <= '1'; + END IF; + END IF; + +-- IF clkena_in THEN + IF (long_done='0' AND state(1)='1') OR movem_presub='0' THEN + memaddr <= addr; + END IF; +-- END IF; + END IF; + END IF; + + addr <= memaddr_reg+memaddr_delta; + IF use_base='0' THEN + memaddr_reg <= (others=>'0'); + ELSE + memaddr_reg <= reg_QA; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- PC Calc + fetch opcode +----------------------------------------------------------------------------- +PROCESS (clk, IPL, setstate, state, exec_write_back, set_direct_data, next_micro_state, stop, make_trace, make_berr, IPL_nr, FlagsSR, set_rot_cnt, opcode, writePCbig, set_exec, exec, + PC_dataa, PC_datab, setnextpass, last_data_read, TG68_PC_brw, TG68_PC_word, Z_error, trap_trap, trap_trapv, interrupt, tmp_TG68_PC, TG68_PC) + BEGIN + + PC_dataa <= TG68_PC; + IF TG68_PC_brw = '1' THEN + PC_dataa <= tmp_TG68_PC; + END IF; + + PC_datab(2 downto 0) <= (others => '0'); + PC_datab(3) <= PC_datab(2); + PC_datab(7 downto 4) <= (others => PC_datab(3)); + PC_datab(15 downto 8) <= (others => PC_datab(7)); + PC_datab(31 downto 16) <= (others => PC_datab(15)); + IF interrupt='1' THEN + PC_datab(2 downto 1) <= "11"; + END IF; + IF exec(writePC_add) ='1' THEN + IF writePCbig='1' THEN + PC_datab(3) <= '1'; + PC_datab(1) <= '1'; + ELSE + PC_datab(2) <= '1'; + END IF; + IF trap_trap='1' OR trap_trapv='1' OR exec(trap_chk)='1' OR Z_error='1' THEN + PC_datab(1) <= '1'; + END IF; + ELSIF state="00" THEN + PC_datab(1) <= '1'; + END IF; + IF TG68_PC_brw = '1' THEN + IF TG68_PC_word='1' THEN + PC_datab <= last_data_read; + ELSE + PC_datab(7 downto 0) <= opcode(7 downto 0); + END IF; + END IF; + + TG68_PC_add <= PC_dataa+PC_datab; + + setopcode <= '0'; + setendOPC <= '0'; + setinterrupt <= '0'; + IF setstate="00" AND next_micro_state=idle AND setnextpass='0' AND (exec_write_back='0' OR state="11") AND set_rot_cnt="000001" AND set_exec(opcCHK)='0'THEN + setendOPC <= '1'; + IF FlagsSR(2 downto 0) + set_memmask <= "101111"; + WHEN "001" => + set_memmask <= "100111"; + WHEN "010" => + set_memmask <= "100011"; + WHEN "011" => + set_memmask <= "100001"; + WHEN OTHERS => + set_memmask <= "100000"; + END CASE; + IF setstate="00" THEN + set_memmask <= "100111"; + END IF; + END PROCESS; + +------------------------------------------------------------------------------ +--SR op +------------------------------------------------------------------------------ +PROCESS (clk, Reset, FlagsSR, last_data_read, OP2out, exec) + BEGIN + IF exec(andiSR)='1' THEN + SRin <= FlagsSR AND last_data_read(15 downto 8); + ELSIF exec(eoriSR)='1' THEN + SRin <= FlagsSR XOR last_data_read(15 downto 8); + ELSIF exec(oriSR)='1' THEN + SRin <= FlagsSR OR last_data_read(15 downto 8); + ELSE + SRin <= OP2out(15 downto 8); + END IF; + + IF rising_edge(clk) THEN + IF Reset='1' THEN + FlagsSR(5) <= '1'; + FC(2) <= '1'; + SVmode <= '1'; + preSVmode <= '1'; + FlagsSR(2 downto 0) <= "111"; + make_trace <= '0'; + ELSIF clkena_lw = '1' THEN + IF setopcode='1' THEN + make_trace <= FlagsSR(7); + IF set(changeMode)='1' THEN + SVmode <= NOT SVmode; + ELSE + SVmode <= preSVmode; + END IF; + END IF; + IF set(changeMode)='1' THEN + preSVmode <= NOT preSVmode; + FlagsSR(5) <= NOT preSVmode; + FC(2) <= NOT preSVmode; + END IF; + IF micro_state=trap3 THEN + FlagsSR(7) <= '0'; + END IF; + IF trap_trace='1' AND state="10" THEN + make_trace <= '0'; + END IF; + IF exec(directSR)='1' OR set_stop='1' THEN + FlagsSR <= data_read(15 downto 8); + END IF; + IF interrupt='1' AND trap_interrupt='1' THEN + FlagsSR(2 downto 0) <=rIPL_nr; + END IF; +-- IF exec(to_CCR)='1' AND exec(to_SR)='1' THEN + IF exec(to_SR)='1' THEN + FlagsSR(7 downto 0) <= SRin; --SR + FC(2) <= SRin(5); +-- END IF; + ELSIF exec(update_FC)='1' THEN + FC(2) <= FlagsSR(5); + END IF; + IF interrupt='1' THEN + FC(2) <= '1'; + END IF; + END IF; + END IF; + END PROCESS; + +----------------------------------------------------------------------------- +-- decode opcode +----------------------------------------------------------------------------- +PROCESS (clk, cpu, OP1out, OP2out, opcode, exe_condition, nextpass, micro_state, decodeOPC, state, setexecOPC, Flags, FlagsSR, direct_data, build_logical, + build_bcd, set_Z_error, trapd, movem_run, last_data_read, set, set_V_Flag, z_error, trap_trace, trap_interrupt, + SVmode, preSVmode, stop, long_done, ea_only, setstate, execOPC, exec_write_back, exe_datatype, + datatype, interrupt, c_out, trapmake, rot_cnt, brief, addr, + long_start, set_datatype, sndOPC, set_exec, exec, ea_build_now, reg_QA, reg_QB, make_berr, trap_berr) + BEGIN + TG68_PC_brw <= '0'; + setstate <= "00"; + Regwrena_now <= '0'; + movem_presub <= '0'; + setnextpass <= '0'; + regdirectsource <= '0'; + setdisp <= '0'; + setdispbyte <= '0'; + getbrief <= '0'; + dest_areg <= '0'; + source_areg <= '0'; + data_is_source <= '0'; + write_back <= '0'; + setstackaddr <= '0'; + writePC <= '0'; + ea_build_now <= '0'; + set_rot_bits <= "XX"; + set_rot_cnt <= "000001"; + dest_hbits <= '0'; + source_lowbits <= '0'; + source_2ndHbits <= '0'; + source_2ndLbits <= '0'; + dest_2ndHbits <= '0'; + ea_only <= '0'; + set_direct_data <= '0'; + set_exec_tas <= '0'; + trap_illegal <='0'; + trap_addr_error <= '0'; + trap_priv <='0'; + trap_1010 <='0'; + trap_1111 <='0'; + trap_trap <='0'; + trap_trapv <= '0'; + trapmake <='0'; + set_vectoraddr <='0'; + writeSR <= '0'; + set_stop <= '0'; + illegal_write_mode <= '0'; + illegal_read_mode <= '0'; + illegal_byteaddr <= '0'; + set_Z_error <= '0'; + + next_micro_state <= idle; + build_logical <= '0'; + build_bcd <= '0'; + skipFetch <= make_berr; + set_writePCbig <= '0'; +-- set_recall_last <= '0'; + set_Suppress_Base <= '0'; + set_PCbase <= '0'; + + IF rot_cnt/="000001" THEN + set_rot_cnt <= rot_cnt-1; + END IF; + set_datatype <= datatype; + + set <= (OTHERS=>'0'); + set_exec <= (OTHERS=>'0'); + set(update_ld) <= '0'; +-- odd_start <= '0'; +------------------------------------------------------------------------------ +--Sourcepass +------------------------------------------------------------------------------ + CASE opcode(7 downto 6) IS + WHEN "00" => datatype <= "00"; --Byte + WHEN "01" => datatype <= "01"; --Word + WHEN OTHERS => datatype <= "10"; --Long + END CASE; + + IF trapmake='1' AND trapd='0' THEN + next_micro_state <= trap0; + IF VBR_Stackframe=0 OR (cpu(0)='0' AND VBR_Stackframe=2) THEN + set(writePC_add) <= '1'; +-- set_datatype <= "10"; + END IF; + IF preSVmode='0' THEN + set(changeMode) <= '1'; + END IF; + setstate <= "01"; + END IF; + IF interrupt='1' AND trap_berr='1' THEN + next_micro_state <= trap0; + IF preSVmode='0' THEN + set(changeMode) <= '1'; + END IF; + setstate <= "01"; + END IF; + IF micro_state=int1 OR (interrupt='1' AND trap_trace='1') THEN + next_micro_state <= trap0; +-- IF cpu(0)='0' THEN +-- set_datatype <= "10"; +-- END IF; + IF preSVmode='0' THEN + set(changeMode) <= '1'; + END IF; + setstate <= "01"; + END IF; + + IF setexecOPC='1' AND FlagsSR(5)/=preSVmode THEN + set(changeMode) <= '1'; +-- setstate <= "01"; +-- next_micro_state <= nop; + END IF; + + IF interrupt='1' AND trap_interrupt='1'THEN +-- skipFetch <= '1'; + next_micro_state <= int1; + set(update_ld) <= '1'; + setstate <= "10"; + END IF; + + IF set(changeMode)='1' THEN + set(to_USP) <= '1'; + set(from_USP) <= '1'; + setstackaddr <='1'; + END IF; + + IF ea_only='0' AND set(get_ea_now)='1' THEN + setstate <= "10"; +-- set_recall_last <= '1'; +-- set(update_ld) <= '0'; + END IF; + + IF setstate(1)='1' AND set_datatype(1)='1' THEN + set(longaktion) <= '1'; + END IF; + + IF (ea_build_now='1' AND decodeOPC='1') OR exec(ea_build)='1' THEN + CASE opcode(5 downto 3) IS --source + WHEN "010"|"011"|"100" => -- -(An)+ + set(get_ea_now) <='1'; + setnextpass <= '1'; + IF opcode(3)='1' THEN --(An)+ + set(postadd) <= '1'; + IF opcode(2 downto 0)="111" THEN + set(use_SP) <= '1'; + END IF; + END IF; + IF opcode(5)='1' THEN -- -(An) + set(presub) <= '1'; + IF opcode(2 downto 0)="111" THEN + set(use_SP) <= '1'; + END IF; + END IF; + WHEN "101" => --(d16,An) + next_micro_state <= ld_dAn1; + WHEN "110" => --(d8,An,Xn) + next_micro_state <= ld_AnXn1; + getbrief <='1'; + WHEN "111" => + CASE opcode(2 downto 0) IS + WHEN "000" => --(xxxx).w + next_micro_state <= ld_nn; + WHEN "001" => --(xxxx).l + set(longaktion) <= '1'; + next_micro_state <= ld_nn; + WHEN "010" => --(d16,PC) + next_micro_state <= ld_dAn1; + set(dispouter) <= '1'; + set_Suppress_Base <= '1'; + set_PCbase <= '1'; + WHEN "011" => --(d8,PC,Xn) + next_micro_state <= ld_AnXn1; + getbrief <= '1'; + set(dispouter) <= '1'; + set_Suppress_Base <= '1'; + set_PCbase <= '1'; + WHEN "100" => --#data + setnextpass <= '1'; + set_direct_data <= '1'; + IF datatype="10" THEN + set(longaktion) <= '1'; + END IF; + WHEN OTHERS => NULL; + END CASE; + WHEN OTHERS => NULL; + END CASE; + END IF; +------------------------------------------------------------------------------ +--prepere opcode +------------------------------------------------------------------------------ + CASE opcode(15 downto 12) IS +-- 0000 ---------------------------------------------------------------------------- + WHEN "0000" => + IF opcode(8)='1' AND opcode(5 downto 3)="001" THEN --movep + datatype <= "00"; --Byte + set(use_SP) <= '1'; --addr+2 + set(no_Flags) <='1'; + IF opcode(7)='0' THEN --to register + set_exec(Regwrena) <= '1'; + set_exec(opcMOVE) <= '1'; + set(movepl) <= '1'; + END IF; + IF decodeOPC='1' THEN + IF opcode(6)='1' THEN + set(movepl) <= '1'; + END IF; + IF opcode(7)='0' THEN + set_direct_data <= '1'; -- to register + END IF; + next_micro_state <= movep1; + END IF; + IF setexecOPC='1' THEN + dest_hbits <='1'; + END IF; + ELSE + IF opcode(8)='1' OR opcode(11 downto 9)="100" THEN --Bits + set_exec(opcBITS) <= '1'; + set_exec(ea_data_OP1) <= '1'; + IF opcode(7 downto 6)/="00" THEN + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + write_back <= '1'; + END IF; + IF opcode(5 downto 4)="00" THEN + datatype <= "10"; --Long + ELSE + datatype <= "00"; --Byte + END IF; + IF opcode(8)='0' THEN + IF decodeOPC='1' THEN + next_micro_state <= nop; + set(get_2ndOPC) <= '1'; + set(ea_build) <= '1'; + END IF; + ELSE + ea_build_now <= '1'; + END IF; + ELSIF opcode(11 downto 9)="111" THEN --MOVES not in 68000 + trap_illegal <= '1'; +-- trap_addr_error <= '1'; + trapmake <= '1'; + ELSE --andi, ...xxxi + IF opcode(11 downto 9)="000" THEN --ORI + set_exec(opcOR) <= '1'; + END IF; + IF opcode(11 downto 9)="001" THEN --ANDI + set_exec(opcAND) <= '1'; + END IF; + IF opcode(11 downto 9)="010" OR opcode(11 downto 9)="011" THEN --SUBI, ADDI + set_exec(opcADD) <= '1'; + END IF; + IF opcode(11 downto 9)="101" THEN --EORI + set_exec(opcEOR) <= '1'; + END IF; + IF opcode(11 downto 9)="110" THEN --CMPI + set_exec(opcCMP) <= '1'; + END IF; + IF opcode(7)='0' AND opcode(5 downto 0)="111100" AND (set_exec(opcAND) OR set_exec(opcOR) OR set_exec(opcEOR))='1' THEN --SR + IF decodeOPC='1' AND SVmode='0' AND opcode(6)='1' THEN --SR + trap_priv <= '1'; + trapmake <= '1'; + ELSE + set(no_Flags) <= '1'; + IF decodeOPC='1' THEN + IF opcode(6)='1' THEN + set(to_SR) <= '1'; + END IF; + set(to_CCR) <= '1'; + set(andiSR) <= set_exec(opcAND); + set(eoriSR) <= set_exec(opcEOR); + set(oriSR) <= set_exec(opcOR); + setstate <= "01"; + next_micro_state <= nopnop; + END IF; + END IF; + ELSE + IF decodeOPC='1' THEN + next_micro_state <= andi; + set(ea_build) <= '1'; + set_direct_data <= '1'; + IF datatype="10" THEN + set(longaktion) <= '1'; + END IF; + END IF; + IF opcode(5 downto 4)/="00" THEN + set_exec(ea_data_OP1) <= '1'; + END IF; + IF opcode(11 downto 9)/="110" THEN --CMPI + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + write_back <= '1'; + END IF; + IF opcode(10 downto 9)="10" THEN --CMPI, SUBI + set(addsub) <= '1'; + END IF; + END IF; + END IF; + END IF; + +-- 0001, 0010, 0011 ----------------------------------------------------------------- + WHEN "0001"|"0010"|"0011" => --move.b, move.l, move.w + set_exec(opcMOVE) <= '1'; + ea_build_now <= '1'; + IF opcode(8 downto 6)="001" THEN + set(no_Flags) <= '1'; + END IF; + IF opcode(5 downto 4)="00" THEN --Dn, An + IF opcode(8 downto 7)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + END IF; + CASE opcode(13 downto 12) IS + WHEN "01" => datatype <= "00"; --Byte + WHEN "10" => datatype <= "10"; --Long + WHEN OTHERS => datatype <= "01"; --Word + END CASE; + source_lowbits <= '1'; -- Dn=> An=> + IF opcode(3)='1' THEN + source_areg <= '1'; + END IF; + + IF nextpass='1' OR opcode(5 downto 4)="00" THEN + dest_hbits <= '1'; + IF opcode(8 downto 6)/="000" THEN + dest_areg <= '1'; + END IF; + END IF; +-- IF setstate="10" THEN +-- set(update_ld) <= '0'; +-- END IF; +-- + IF micro_state=idle AND (nextpass='1' OR (opcode(5 downto 4)="00" AND decodeOPC='1')) THEN + CASE opcode(8 downto 6) IS --destination + WHEN "000"|"001" => --Dn,An + set_exec(Regwrena) <= '1'; + WHEN "010"|"011"|"100" => --destination -(an)+ + IF opcode(6)='1' THEN --(An)+ + set(postadd) <= '1'; + IF opcode(11 downto 9)="111" THEN + set(use_SP) <= '1'; + END IF; + END IF; + IF opcode(8)='1' THEN -- -(An) + set(presub) <= '1'; + IF opcode(11 downto 9)="111" THEN + set(use_SP) <= '1'; + END IF; + END IF; + setstate <= "11"; + next_micro_state <= nop; + IF nextpass='0' THEN + set(write_reg) <= '1'; + END IF; + WHEN "101" => --(d16,An) + next_micro_state <= st_dAn1; +-- getbrief <= '1'; + WHEN "110" => --(d8,An,Xn) + next_micro_state <= st_AnXn1; + getbrief <= '1'; + WHEN "111" => + CASE opcode(11 downto 9) IS + WHEN "000" => --(xxxx).w + next_micro_state <= st_nn; + WHEN "001" => --(xxxx).l + set(longaktion) <= '1'; + next_micro_state <= st_nn; + WHEN OTHERS => NULL; + END CASE; + WHEN OTHERS => NULL; + END CASE; + END IF; +---- 0100 ---------------------------------------------------------------------------- + WHEN "0100" => --rts_group + IF opcode(8)='1' THEN --lea + IF opcode(6)='1' THEN --lea + IF opcode(7)='1' THEN + source_lowbits <= '1'; +-- IF opcode(5 downto 3)="000" AND opcode(10)='0' THEN --ext + IF opcode(5 downto 4)="00" THEN --extb.l + set_exec(opcEXT) <= '1'; + set_exec(opcMOVE) <= '1'; + set_exec(Regwrena) <= '1'; +-- IF opcode(6)='0' THEN +-- datatype <= "01"; --WORD +-- END IF; + ELSE + source_areg <= '1'; + ea_only <= '1'; + set_exec(Regwrena) <= '1'; + set_exec(opcMOVE) <='1'; + set(no_Flags) <='1'; + IF opcode(5 downto 3)="010" THEN --lea (Am),An + dest_areg <= '1'; + dest_hbits <= '1'; + ELSE + ea_build_now <= '1'; + END IF; + IF set(get_ea_now)='1' THEN + setstate <= "01"; + set_direct_data <= '1'; + END IF; + IF setexecOPC='1' THEN + dest_areg <= '1'; + dest_hbits <= '1'; + END IF; + END IF; + ELSE + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + ELSE --chk + IF opcode(7)='1' THEN + datatype <= "01"; --Word + set(trap_chk) <= '1'; + IF (c_out(1)='0' OR OP1out(15)='1' OR OP2out(15)='1') AND exec(opcCHK)='1' THEN + trapmake <= '1'; + END IF; + ELSIF cpu(1)='1' THEN --chk long for 68020 + datatype <= "10"; --Long + set(trap_chk) <= '1'; + IF (c_out(2)='1' OR OP1out(31)='1' OR OP2out(31)='1') AND exec(opcCHK)='1' THEN + trapmake <= '1'; + END IF; + ELSE + trap_illegal <= '1'; -- chk long for 68020 + trapmake <= '1'; + END IF; + IF opcode(7)='1' OR cpu(1)='1' THEN + IF (nextpass='1' OR opcode(5 downto 4)="00") AND exec(opcCHK)='0' AND micro_state=idle THEN + set_exec(opcCHK) <= '1'; + END IF; + ea_build_now <= '1'; + set(addsub) <= '1'; + IF setexecOPC='1' THEN + dest_hbits <= '1'; + source_lowbits <='1'; + END IF; + END IF; + END IF; + ELSE + CASE opcode(11 downto 9) IS + WHEN "000"=> + IF opcode(7 downto 6)="11" THEN --move from SR + IF SR_Read=0 OR (cpu(0)='0' AND SR_Read=2) OR SVmode='1' THEN +-- IF SVmode='1' THEN + ea_build_now <= '1'; + set_exec(opcMOVESR) <= '1'; + datatype <= "01"; + write_back <='1'; -- im 68000 wird auch erst gelesen + IF cpu(0)='1' AND state="10" THEN + skipFetch <= '1'; + END IF; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + ELSE + trap_priv <= '1'; + trapmake <= '1'; + END IF; + ELSE --negx + ea_build_now <= '1'; + set_exec(use_XZFlag) <= '1'; + write_back <='1'; + set_exec(opcADD) <= '1'; + set(addsub) <= '1'; + source_lowbits <= '1'; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + IF setexecOPC='1' THEN + set(OP1out_zero) <= '1'; + END IF; + END IF; + WHEN "001"=> + IF opcode(7 downto 6)="11" THEN --move from CCR 68010 + IF SR_Read=1 OR (cpu(0)='1' AND SR_Read=2) THEN + ea_build_now <= '1'; + set_exec(opcMOVESR) <= '1'; + datatype <= "00"; + write_back <='1'; -- im 68000 wird auch erst gelesen + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + ELSE + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + ELSE --clr + ea_build_now <= '1'; + write_back <='1'; + set_exec(opcAND) <= '1'; + IF cpu(0)='1' AND state="10" THEN + skipFetch <= '1'; + END IF; + IF setexecOPC='1' THEN + set(OP1out_zero) <= '1'; + END IF; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + END IF; + WHEN "010"=> + ea_build_now <= '1'; + IF opcode(7 downto 6)="11" THEN --move to CCR + datatype <= "01"; + source_lowbits <= '1'; + IF (decodeOPC='1' AND opcode(5 downto 4)="00") OR state="10" OR direct_data='1' THEN + set(to_CCR) <= '1'; + END IF; + ELSE --neg + write_back <='1'; + set_exec(opcADD) <= '1'; + set(addsub) <= '1'; + source_lowbits <= '1'; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + IF setexecOPC='1' THEN + set(OP1out_zero) <= '1'; + END IF; + END IF; + WHEN "011"=> --not, move toSR + IF opcode(7 downto 6)="11" THEN --move to SR + IF SVmode='1' THEN + ea_build_now <= '1'; + datatype <= "01"; + source_lowbits <= '1'; + IF (decodeOPC='1' AND opcode(5 downto 4)="00") OR state="10" OR direct_data='1' THEN + set(to_SR) <= '1'; + set(to_CCR) <= '1'; + END IF; + IF exec(to_SR)='1' OR (decodeOPC='1' AND opcode(5 downto 4)="00") OR state="10" OR direct_data='1' THEN + setstate <="01"; + END IF; + ELSE + trap_priv <= '1'; + trapmake <= '1'; + END IF; + ELSE --not + ea_build_now <= '1'; + write_back <='1'; + set_exec(opcEOR) <= '1'; + set_exec(ea_data_OP1) <= '1'; + IF opcode(5 downto 3)="000" THEN + set_exec(Regwrena) <= '1'; + END IF; + IF setexecOPC='1' THEN + set(OP2out_one) <= '1'; + END IF; + END IF; + WHEN "100"|"110"=> + IF opcode(7)='1' THEN --movem, ext + IF opcode(5 downto 3)="000" AND opcode(10)='0' THEN --ext + source_lowbits <= '1'; + set_exec(opcEXT) <= '1'; + set_exec(opcMOVE) <= '1'; + set_exec(Regwrena) <= '1'; + IF opcode(6)='0' THEN + datatype <= "01"; --WORD + END IF; + ELSE --movem +-- IF opcode(11 downto 7)="10001" OR opcode(11 downto 7)="11001" THEN --MOVEM + ea_only <= '1'; + set(no_Flags) <= '1'; + IF opcode(6)='0' THEN + datatype <= "01"; --Word transfer + END IF; + IF (opcode(5 downto 3)="100" OR opcode(5 downto 3)="011") AND state="01" THEN -- -(An), (An)+ + set_exec(save_memaddr) <= '1'; + set_exec(Regwrena) <= '1'; + END IF; + IF opcode(5 downto 3)="100" THEN -- -(An) + movem_presub <= '1'; + set(subidx) <= '1'; + END IF; + IF state="10" THEN + set(Regwrena) <= '1'; + set(opcMOVE) <= '1'; + END IF; + IF decodeOPC='1' THEN + set(get_2ndOPC) <='1'; + IF opcode(5 downto 3)="010" OR opcode(5 downto 3)="011" OR opcode(5 downto 3)="100" THEN + next_micro_state <= movem1; + ELSE + next_micro_state <= nop; + set(ea_build) <= '1'; + END IF; + END IF; + IF set(get_ea_now)='1' THEN + IF movem_run='1' THEN + set(movem_action) <= '1'; + IF opcode(10)='0' THEN + setstate <="11"; + set(write_reg) <= '1'; + ELSE + setstate <="10"; + END IF; + next_micro_state <= movem2; + set(mem_addsub) <= '1'; + ELSE + setstate <="01"; + END IF; + END IF; + END IF; + ELSE + IF opcode(10)='1' THEN --MUL.L, DIV.L 68020 +-- IF cpu(1)='1' THEN + IF (opcode(6)='1' AND (DIV_Mode=1 OR (cpu(1)='1' AND DIV_Mode=2))) OR + (opcode(6)='0' AND (MUL_Mode=1 OR (cpu(1)='1' AND MUL_Mode=2))) THEN + IF decodeOPC='1' THEN + next_micro_state <= nop; + set(get_2ndOPC) <= '1'; + set(ea_build) <= '1'; + END IF; + IF (micro_state=idle AND nextpass='1') OR (opcode(5 downto 4)="00" AND exec(ea_build)='1')THEN + setstate <="01"; + dest_2ndHbits <= '1'; + source_2ndLbits <= '1'; + IF opcode(6)='1' THEN + next_micro_state <= div1; + ELSE + next_micro_state <= mul1; + set(ld_rot_cnt) <= '1'; + END IF; + END IF; + IF z_error='0' AND set_V_Flag='0' AND set(opcDIVU)='1' THEN + set(Regwrena) <= '1'; + END IF; + source_lowbits <='1'; + IF nextpass='1' OR (opcode(5 downto 4)="00" AND decodeOPC='1') THEN + dest_hbits <= '1'; + END IF; + datatype <= "10"; + ELSE + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + + ELSE --pea, swap + IF opcode(6)='1' THEN + datatype <= "10"; + IF opcode(5 downto 3)="000" THEN --swap + set_exec(opcSWAP) <= '1'; + set_exec(Regwrena) <= '1'; + ELSIF opcode(5 downto 3)="001" THEN --bkpt + + ELSE --pea + ea_only <= '1'; + ea_build_now <= '1'; + IF nextpass='1' AND micro_state=idle THEN + set(presub) <= '1'; + setstackaddr <='1'; + setstate <="11"; + next_micro_state <= nop; + END IF; + IF set(get_ea_now)='1' THEN + setstate <="01"; + END IF; + END IF; + ELSE + IF opcode(5 downto 3)="001" THEN --link.l + datatype <= "10"; + set_exec(opcADD) <= '1'; --for displacement + set_exec(Regwrena) <= '1'; + set(no_Flags) <= '1'; + IF decodeOPC='1' THEN + set(linksp) <= '1'; + set(longaktion) <= '1'; + next_micro_state <= link1; + set(presub) <= '1'; + setstackaddr <='1'; + set(mem_addsub) <= '1'; + source_lowbits <= '1'; + source_areg <= '1'; + set(store_ea_data) <= '1'; + END IF; + ELSE --nbcd + ea_build_now <= '1'; + set_exec(use_XZFlag) <= '1'; + write_back <='1'; + set_exec(opcADD) <= '1'; + set_exec(opcSBCD) <= '1'; + source_lowbits <= '1'; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + IF setexecOPC='1' THEN + set(OP1out_zero) <= '1'; + END IF; + END IF; + END IF; + END IF; + END IF; +-- + WHEN "101"=> --tst, tas 4aFC - illegal + IF opcode(7 downto 2)="111111" THEN --illegal + trap_illegal <= '1'; + trapmake <= '1'; + ELSE + ea_build_now <= '1'; + IF setexecOPC='1' THEN + source_lowbits <= '1'; + IF opcode(3)='1' THEN --MC68020... + source_areg <= '1'; + END IF; + END IF; + set_exec(opcMOVE) <= '1'; + IF opcode(7 downto 6)="11" THEN --tas + set_exec_tas <= '1'; + write_back <= '1'; + datatype <= "00"; --Byte + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + END IF; + END IF; +---- WHEN "110"=> + WHEN "111"=> --4EXX +-- +-- ea_only <= '1'; +-- ea_build_now <= '1'; +-- IF nextpass='1' AND micro_state=idle THEN +-- set(presub) <= '1'; +-- setstackaddr <='1'; +-- set(mem_addsub) <= '1'; +-- setstate <="11"; +-- next_micro_state <= nop; +-- END IF; +-- IF set(get_ea_now)='1' THEN +-- setstate <="01"; +-- END IF; +-- + + + + IF opcode(7)='1' THEN --jsr, jmp + datatype <= "10"; + ea_only <= '1'; + ea_build_now <= '1'; + IF exec(ea_to_pc)='1' THEN + next_micro_state <= nop; + END IF; + IF nextpass='1' AND micro_state=idle AND opcode(6)='0' THEN + set(presub) <= '1'; + setstackaddr <='1'; + setstate <="11"; + next_micro_state <= nopnop; + END IF; +-- achtung buggefahr + IF micro_state=ld_AnXn1 AND brief(8)='0'THEN --JMP/JSR n(Ax,Dn) + skipFetch <= '1'; + END IF; + IF state="00" THEN + writePC <= '1'; + END IF; + set(hold_dwr) <= '1'; + IF set(get_ea_now)='1' THEN --jsr + IF exec(longaktion)='0' OR long_done='1' THEN + skipFetch <= '1'; + END IF; + setstate <="01"; + set(ea_to_pc) <= '1'; + END IF; + ELSE -- + CASE opcode(6 downto 0) IS + WHEN "1000000"|"1000001"|"1000010"|"1000011"|"1000100"|"1000101"|"1000110"|"1000111"| --trap + "1001000"|"1001001"|"1001010"|"1001011"|"1001100"|"1001101"|"1001110"|"1001111" => --trap + trap_trap <='1'; + trapmake <= '1'; + WHEN "1010000"|"1010001"|"1010010"|"1010011"|"1010100"|"1010101"|"1010110"|"1010111"=> --link + datatype <= "10"; + set_exec(opcADD) <= '1'; --for displacement + set_exec(Regwrena) <= '1'; + set(no_Flags) <= '1'; + IF decodeOPC='1' THEN + next_micro_state <= link1; + set(presub) <= '1'; + setstackaddr <='1'; + set(mem_addsub) <= '1'; + source_lowbits <= '1'; + source_areg <= '1'; + set(store_ea_data) <= '1'; + END IF; + + WHEN "1011000"|"1011001"|"1011010"|"1011011"|"1011100"|"1011101"|"1011110"|"1011111" => --unlink + datatype <= "10"; + set_exec(Regwrena) <= '1'; + set_exec(opcMOVE) <= '1'; + set(no_Flags) <= '1'; + IF decodeOPC='1' THEN + setstate <= "01"; + next_micro_state <= unlink1; + set(opcMOVE) <= '1'; + set(Regwrena) <= '1'; + setstackaddr <='1'; + source_lowbits <= '1'; + source_areg <= '1'; + END IF; + + WHEN "1100000"|"1100001"|"1100010"|"1100011"|"1100100"|"1100101"|"1100110"|"1100111" => --move An,USP + IF SVmode='1' THEN +-- set(no_Flags) <= '1'; + set(to_USP) <= '1'; + source_lowbits <= '1'; + source_areg <= '1'; + datatype <= "10"; + ELSE + trap_priv <= '1'; + trapmake <= '1'; + END IF; + WHEN "1101000"|"1101001"|"1101010"|"1101011"|"1101100"|"1101101"|"1101110"|"1101111" => --move USP,An + IF SVmode='1' THEN +-- set(no_Flags) <= '1'; + set(from_USP) <= '1'; + datatype <= "10"; + set_exec(Regwrena) <= '1'; + ELSE + trap_priv <= '1'; + trapmake <= '1'; + END IF; + + WHEN "1110000" => --reset + IF SVmode='0' THEN + trap_priv <= '1'; + trapmake <= '1'; + ELSE + set(opcRESET) <= '1'; + IF decodeOPC='1' THEN + set(ld_rot_cnt) <= '1'; + set_rot_cnt <= "000000"; + END IF; + END IF; + + WHEN "1110001" => --nop + + WHEN "1110010" => --stop + IF SVmode='0' THEN + trap_priv <= '1'; + trapmake <= '1'; + ELSE + IF decodeOPC='1' THEN + setnextpass <= '1'; + set_stop <= '1'; + END IF; + IF stop='1' THEN + skipFetch <= '1'; + END IF; + + END IF; + + WHEN "1110011"|"1110111" => --rte/rtr + IF SVmode='1' OR opcode(2)='1' THEN + IF decodeOPC='1' THEN + setstate <= "10"; + set(postadd) <= '1'; + setstackaddr <= '1'; + IF opcode(2)='1' THEN + set(directCCR) <= '1'; + ELSE + set(directSR) <= '1'; + END IF; + next_micro_state <= rte1; + END IF; + ELSE + trap_priv <= '1'; + trapmake <= '1'; + END IF; + + WHEN "1110101" => --rts + datatype <= "10"; + IF decodeOPC='1' THEN + setstate <= "10"; + set(postadd) <= '1'; + setstackaddr <= '1'; + set(direct_delta) <= '1'; + set(directPC) <= '1'; + next_micro_state <= nopnop; + END IF; + + WHEN "1110110" => --trapv + IF decodeOPC='1' THEN + setstate <= "01"; + END IF; + IF Flags(1)='1' AND state="01" THEN + trap_trapv <= '1'; + trapmake <= '1'; + END IF; + + WHEN "1111010"|"1111011" => --movec + IF VBR_Stackframe=0 OR (cpu(0)='0' AND VBR_Stackframe=2) THEN + trap_illegal <= '1'; + trapmake <= '1'; + ELSIF SVmode='0' THEN + trap_priv <= '1'; + trapmake <= '1'; + ELSE + datatype <= "10"; --Long + IF last_data_read(11 downto 0)=X"800" THEN + set(from_USP) <= '1'; + IF opcode(0)='1' THEN + set(to_USP) <= '1'; + END IF; + END IF; + IF opcode(0)='0' THEN + set_exec(movec_rd) <= '1'; + ELSE + set_exec(movec_wr) <= '1'; + END IF; + IF decodeOPC='1' THEN + next_micro_state <= movec1; + getbrief <='1'; + END IF; + END IF; + + WHEN OTHERS => + trap_illegal <= '1'; + trapmake <= '1'; + END CASE; + END IF; + WHEN OTHERS => NULL; + END CASE; + END IF; +-- +---- 0101 ---------------------------------------------------------------------------- + WHEN "0101" => --subq, addq + + IF opcode(7 downto 6)="11" THEN --dbcc + IF opcode(5 downto 3)="001" THEN --dbcc + IF decodeOPC='1' THEN + next_micro_state <= dbcc1; + set(OP2out_one) <= '1'; + data_is_source <= '1'; + END IF; + ELSE --Scc + datatype <= "00"; --Byte + ea_build_now <= '1'; + write_back <= '1'; + set_exec(opcScc) <= '1'; + IF cpu(0)='1' AND state="10" THEN + skipFetch <= '1'; + END IF; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + END IF; + ELSE --addq, subq + ea_build_now <= '1'; + IF opcode(5 downto 3)="001" THEN + set(no_Flags) <= '1'; + END IF; + IF opcode(8)='1' THEN + set(addsub) <= '1'; + END IF; + write_back <= '1'; + set_exec(opcADDQ) <= '1'; + set_exec(opcADD) <= '1'; + set_exec(ea_data_OP1) <= '1'; + IF opcode(5 downto 4)="00" THEN + set_exec(Regwrena) <= '1'; + END IF; + END IF; +-- +---- 0110 ---------------------------------------------------------------------------- + WHEN "0110" => --bra,bsr,bcc + datatype <= "10"; + + IF micro_state=idle THEN + IF opcode(11 downto 8)="0001" THEN --bsr + set(presub) <= '1'; + setstackaddr <='1'; + IF opcode(7 downto 0)="11111111" THEN + next_micro_state <= bsr2; + set(longaktion) <= '1'; + ELSIF opcode(7 downto 0)="00000000" THEN + next_micro_state <= bsr2; + ELSE + next_micro_state <= bsr1; + setstate <= "11"; + writePC <= '1'; + END IF; + ELSE --bra + IF opcode(7 downto 0)="11111111" THEN + next_micro_state <= bra1; + set(longaktion) <= '1'; + ELSIF opcode(7 downto 0)="00000000" THEN + next_micro_state <= bra1; + ELSE + setstate <= "01"; + next_micro_state <= bra1; + END IF; + END IF; + END IF; + +-- 0111 ---------------------------------------------------------------------------- + WHEN "0111" => --moveq +-- IF opcode(8)='0' THEN -- Cloanto's Amiga Forver ROMs have mangled moveq instructions with a 1 here... + datatype <= "10"; --Long + set_exec(Regwrena) <= '1'; + set_exec(opcMOVEQ) <= '1'; + set_exec(opcMOVE) <= '1'; + dest_hbits <= '1'; +-- ELSE +-- trap_illegal <= '1'; +-- trapmake <= '1'; +-- END IF; + +---- 1000 ---------------------------------------------------------------------------- + WHEN "1000" => --or + IF opcode(7 downto 6)="11" THEN --divu, divs + IF DIV_Mode/=3 THEN + IF opcode(5 downto 4)="00" THEN --Dn, An + regdirectsource <= '1'; + END IF; + IF (micro_state=idle AND nextpass='1') OR (opcode(5 downto 4)="00" AND decodeOPC='1') THEN + setstate <="01"; + next_micro_state <= div1; + END IF; + ea_build_now <= '1'; + IF z_error='0' AND set_V_Flag='0' THEN + set_exec(Regwrena) <= '1'; + END IF; + source_lowbits <='1'; + IF nextpass='1' OR (opcode(5 downto 4)="00" AND decodeOPC='1') THEN + dest_hbits <= '1'; + END IF; + datatype <= "01"; + ELSE + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + + ELSIF opcode(8)='1' AND opcode(5 downto 4)="00" THEN --sbcd, pack , unpack + IF opcode(7 downto 6)="00" THEN --sbcd + build_bcd <= '1'; + set_exec(opcADD) <= '1'; + set_exec(opcSBCD) <= '1'; + ELSE --pack, unpack + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + ELSE --or + set_exec(opcOR) <= '1'; + build_logical <= '1'; + END IF; + +---- 1001, 1101 ----------------------------------------------------------------------- + WHEN "1001"|"1101" => --sub, add + set_exec(opcADD) <= '1'; + ea_build_now <= '1'; + IF opcode(14)='0' THEN + set(addsub) <= '1'; + END IF; + IF opcode(7 downto 6)="11" THEN -- --adda, suba + IF opcode(8)='0' THEN --adda.w, suba.w + datatype <= "01"; --Word + END IF; + set_exec(Regwrena) <= '1'; + source_lowbits <='1'; + IF opcode(3)='1' THEN + source_areg <= '1'; + END IF; + set(no_Flags) <= '1'; + IF setexecOPC='1' THEN + dest_areg <='1'; + dest_hbits <= '1'; + END IF; + ELSE + IF opcode(8)='1' AND opcode(5 downto 4)="00" THEN --addx, subx + build_bcd <= '1'; + ELSE --sub, add + build_logical <= '1'; + END IF; + END IF; + +-- +---- 1010 ---------------------------------------------------------------------------- + WHEN "1010" => --Trap 1010 + trap_1010 <= '1'; + trapmake <= '1'; +---- 1011 ---------------------------------------------------------------------------- + WHEN "1011" => --eor, cmp + ea_build_now <= '1'; + IF opcode(7 downto 6)="11" THEN --CMPA + IF opcode(8)='0' THEN --cmpa.w + datatype <= "01"; --Word + set_exec(opcCPMAW) <= '1'; + END IF; + set_exec(opcCMP) <= '1'; + IF setexecOPC='1' THEN + source_lowbits <='1'; + IF opcode(3)='1' THEN + source_areg <= '1'; + END IF; + dest_areg <='1'; + dest_hbits <= '1'; + END IF; + set(addsub) <= '1'; + ELSE + IF opcode(8)='1' THEN + IF opcode(5 downto 3)="001" THEN --cmpm + set_exec(opcCMP) <= '1'; + IF decodeOPC='1' THEN + setstate <= "10"; + set(update_ld) <= '1'; + set(postadd) <= '1'; + next_micro_state <= cmpm; + END IF; + set_exec(ea_data_OP1) <= '1'; + set(addsub) <= '1'; + ELSE --EOR + build_logical <= '1'; + set_exec(opcEOR) <= '1'; + END IF; + ELSE --CMP + build_logical <= '1'; + set_exec(opcCMP) <= '1'; + set(addsub) <= '1'; + END IF; + END IF; +-- +---- 1100 ---------------------------------------------------------------------------- + WHEN "1100" => --and, exg + IF opcode(7 downto 6)="11" THEN --mulu, muls + IF MUL_Mode/=3 THEN + IF opcode(5 downto 4)="00" THEN --Dn, An + regdirectsource <= '1'; + END IF; + IF (micro_state=idle AND nextpass='1') OR (opcode(5 downto 4)="00" AND decodeOPC='1') THEN + setstate <="01"; + set(ld_rot_cnt) <= '1'; + next_micro_state <= mul1; + END IF; + ea_build_now <= '1'; + set_exec(Regwrena) <= '1'; + source_lowbits <='1'; + IF (nextpass='1') OR (opcode(5 downto 4)="00" AND decodeOPC='1') THEN + dest_hbits <= '1'; + END IF; + datatype <= "01"; + ELSE + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + + ELSIF opcode(8)='1' AND opcode(5 downto 4)="00" THEN --exg, abcd + IF opcode(7 downto 6)="00" THEN --abcd + build_bcd <= '1'; + set_exec(opcADD) <= '1'; + set_exec(opcABCD) <= '1'; + ELSE --exg + datatype <= "10"; + set(Regwrena) <= '1'; + set(exg) <= '1'; + IF opcode(6)='1' AND opcode(3)='1' THEN + dest_areg <= '1'; + source_areg <= '1'; + END IF; + IF decodeOPC='1' THEN + setstate <= "01"; + ELSE + dest_hbits <= '1'; + END IF; + END IF; + ELSE --and + set_exec(opcAND) <= '1'; + build_logical <= '1'; + END IF; +-- +---- 1110 ---------------------------------------------------------------------------- + WHEN "1110" => --rotation / bitfield + IF opcode(7 downto 6)="11" THEN + IF opcode(11)='0' THEN + set_exec(opcROT) <= '1'; + ea_build_now <= '1'; + datatype <= "01"; + set_rot_bits <= opcode(10 downto 9); + set_exec(ea_data_OP1) <= '1'; + write_back <= '1'; + ELSE --bitfield + IF BitField=0 OR (cpu(1)='0' AND BitField=2) THEN + trap_illegal <= '1'; + trapmake <= '1'; + ELSE + IF decodeOPC='1' THEN + next_micro_state <= nop; + set(get_2ndOPC) <= '1'; + set(ea_build) <= '1'; + END IF; + set_exec(opcBF) <= '1'; + IF opcode(10)='1' OR opcode(8)='0' THEN + set_exec(opcBFwb) <= '1'; +-- END IF; +-- IF opcode(10 downto 8)="111" THEN + set_exec(ea_data_OP1) <= '1'; + END IF; + IF opcode(10 downto 8)="010" OR opcode(10 downto 8)="100" OR opcode(10 downto 8)="110" OR opcode(10 downto 8)="111" THEN + write_back <= '1'; + END IF; + ea_only <= '1'; + IF opcode(10 downto 8)="001" OR opcode(10 downto 8)="011" OR opcode(10 downto 8)="101" THEN + set_exec(Regwrena) <= '1'; + END IF; + IF opcode(4 downto 3)="00" THEN + set_exec(Regwrena) <= '1'; + IF exec(ea_build)='1' THEN + dest_2ndHbits <= '1'; + source_2ndLbits <= '1'; + set(get_bfoffset) <='1'; + setstate <= "01"; + END IF; + END IF; + IF set(get_ea_now)='1' THEN + setstate <= "01"; + END IF; + IF exec(get_ea_now)='1' THEN + dest_2ndHbits <= '1'; + source_2ndLbits <= '1'; + set(get_bfoffset) <='1'; + setstate <= "01"; + set(mem_addsub) <='1'; + next_micro_state <= bf1; + END IF; + +-- BFINS D1,D0 s2ndHbits < D0 +-- BFEXT D0,D1 sLbits >>D0 -> D1 d2ndHbits +-- BFINS D1,(A0) s2ndHbits < (A0) +-- BFEXT (A0),D1 >>(A0) -> D1 d2ndHbits + IF setexecOPC='1' THEN + IF opcode(10 downto 8)="111" THEN --BFINS + source_2ndHbits <= '1'; + ELSE + source_lowbits <= '1'; + dest_2ndHbits <= '1'; + END IF; + END IF; + END IF; + END IF; + ELSE + set_exec(opcROT) <= '1'; + set_rot_bits <= opcode(4 downto 3); + data_is_source <= '1'; + set_exec(Regwrena) <= '1'; + IF decodeOPC='1' THEN + IF opcode(5)='1' THEN + next_micro_state <= rota1; + set(ld_rot_cnt) <= '1'; + setstate <= "01"; + ELSE + set_rot_cnt(2 downto 0) <= opcode(11 downto 9); + IF opcode(11 downto 9)="000" THEN + set_rot_cnt(3) <='1'; + ELSE + set_rot_cnt(3) <='0'; + END IF; + END IF; + END IF; + END IF; +-- +---- ---------------------------------------------------------------------------- + WHEN OTHERS => + trap_1111 <= '1'; + trapmake <= '1'; + + END CASE; + +-- use for AND, OR, EOR, CMP + IF build_logical='1' THEN + ea_build_now <= '1'; + IF set_exec(opcCMP)='0' AND (opcode(8)='0' OR opcode(5 downto 4)="00" ) THEN + set_exec(Regwrena) <= '1'; + END IF; + IF opcode(8)='1' THEN + write_back <= '1'; + set_exec(ea_data_OP1) <= '1'; + ELSE + source_lowbits <='1'; + IF opcode(3)='1' THEN --use for cmp + source_areg <= '1'; + END IF; + IF setexecOPC='1' THEN + dest_hbits <= '1'; + END IF; + END IF; + END IF; + +-- use for ABCD, SBCD + IF build_bcd='1' THEN + set_exec(use_XZFlag) <= '1'; + set_exec(ea_data_OP1) <= '1'; + write_back <= '1'; + source_lowbits <='1'; + IF opcode(3)='1' THEN + IF decodeOPC='1' THEN + setstate <= "10"; + set(update_ld) <= '1'; + set(presub) <= '1'; + next_micro_state <= op_AxAy; + dest_areg <= '1'; --??? + END IF; + ELSE + dest_hbits <= '1'; + set_exec(Regwrena) <= '1'; + END IF; + END IF; + + +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + IF set_Z_error='1' THEN -- divu by zero + trapmake <= '1'; --wichtig for USP + IF trapd='0' THEN + writePC <= '1'; + END IF; + END IF; + +----------------------------------------------------------------------------- +-- execute microcode +----------------------------------------------------------------------------- + IF rising_edge(clk) THEN + IF Reset='1' THEN + micro_state <= ld_nn; + ELSIF clkena_lw='1' THEN + trapd <= trapmake; + micro_state <= next_micro_state; + END IF; + END IF; + + CASE micro_state IS + WHEN ld_nn => -- (nnnn).w/l=> + set(get_ea_now) <='1'; + setnextpass <= '1'; + set(addrlong) <= '1'; + + WHEN st_nn => -- =>(nnnn).w/l + setstate <= "11"; + set(addrlong) <= '1'; + next_micro_state <= nop; + + WHEN ld_dAn1 => -- d(An)=>, --d(PC)=> + set(get_ea_now) <='1'; + setdisp <= '1'; --word + setnextpass <= '1'; + + WHEN ld_AnXn1 => -- d(An,Xn)=>, --d(PC,Xn)=> + IF brief(8)='0' OR extAddr_Mode=0 OR (cpu(1)='0' AND extAddr_Mode=2) THEN + setdisp <= '1'; --byte + setdispbyte <= '1'; + setstate <= "01"; + set(briefext) <= '1'; + next_micro_state <= ld_AnXn2; + ELSE + IF brief(7)='1'THEN --suppress Base + set_suppress_base <= '1'; + ELSIF exec(dispouter)='1' THEN + set(dispouter) <= '1'; + END IF; + IF brief(5)='0' THEN --NULL Base Displacement + setstate <= "01"; + ELSE --WORD Base Displacement + IF brief(4)='1' THEN + set(longaktion) <= '1'; --LONG Base Displacement + END IF; + END IF; + next_micro_state <= ld_229_1; + END IF; + + WHEN ld_AnXn2 => + set(get_ea_now) <='1'; + setdisp <= '1'; --brief + setnextpass <= '1'; + +------------------------------------------------------------------------------------- + + WHEN ld_229_1 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + IF brief(5)='1' THEN --Base Displacement + setdisp <= '1'; --add last_data_read + END IF; + IF brief(6)='0' AND brief(2)='0' THEN --Preindex or Index + set(briefext) <= '1'; + setstate <= "01"; + IF brief(1 downto 0)="00" THEN + next_micro_state <= ld_AnXn2; + ELSE + next_micro_state <= ld_229_2; + END IF; + ELSE + IF brief(1 downto 0)="00" THEN + set(get_ea_now) <='1'; + setnextpass <= '1'; + ELSE + setstate <= "10"; + set(longaktion) <= '1'; + next_micro_state <= ld_229_3; + END IF; + END IF; + + WHEN ld_229_2 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + setdisp <= '1'; -- add Index + setstate <= "10"; + set(longaktion) <= '1'; + next_micro_state <= ld_229_3; + + WHEN ld_229_3 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + set_suppress_base <= '1'; + set(dispouter) <= '1'; + IF brief(1)='0' THEN --NULL Outer Displacement + setstate <= "01"; + ELSE --WORD Outer Displacement + IF brief(0)='1' THEN + set(longaktion) <= '1'; --LONG Outer Displacement + END IF; + END IF; + next_micro_state <= ld_229_4; + + WHEN ld_229_4 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + IF brief(1)='1' THEN -- Outer Displacement + setdisp <= '1'; --add last_data_read + END IF; + IF brief(6)='0' AND brief(2)='1' THEN --Postindex + set(briefext) <= '1'; + setstate <= "01"; + next_micro_state <= ld_AnXn2; + ELSE + set(get_ea_now) <='1'; + setnextpass <= '1'; + END IF; + +---------------------------------------------------------------------------------------- + WHEN st_dAn1 => -- =>d(An) + setstate <= "11"; + setdisp <= '1'; --word + next_micro_state <= nop; + + WHEN st_AnXn1 => -- =>d(An,Xn) + IF brief(8)='0' OR extAddr_Mode=0 OR (cpu(1)='0' AND extAddr_Mode=2) THEN + setdisp <= '1'; --byte + setdispbyte <= '1'; + setstate <= "01"; + set(briefext) <= '1'; + next_micro_state <= st_AnXn2; + ELSE + IF brief(7)='1'THEN --suppress Base + set_suppress_base <= '1'; +-- ELSIF exec(dispouter)='1' THEN +-- set(dispouter) <= '1'; + END IF; + IF brief(5)='0' THEN --NULL Base Displacement + setstate <= "01"; + ELSE --WORD Base Displacement + IF brief(4)='1' THEN + set(longaktion) <= '1'; --LONG Base Displacement + END IF; + END IF; + next_micro_state <= st_229_1; + END IF; + + WHEN st_AnXn2 => + setstate <= "11"; + setdisp <= '1'; --brief + next_micro_state <= nop; + +------------------------------------------------------------------------------------- + + WHEN st_229_1 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + IF brief(5)='1' THEN --Base Displacement + setdisp <= '1'; --add last_data_read + END IF; + IF brief(6)='0' AND brief(2)='0' THEN --Preindex or Index + set(briefext) <= '1'; + setstate <= "01"; + IF brief(1 downto 0)="00" THEN + next_micro_state <= st_AnXn2; + ELSE + next_micro_state <= st_229_2; + END IF; + ELSE + IF brief(1 downto 0)="00" THEN + setstate <= "11"; + next_micro_state <= nop; + ELSE + set(hold_dwr) <= '1'; + setstate <= "10"; + set(longaktion) <= '1'; + next_micro_state <= st_229_3; + END IF; + END IF; + + WHEN st_229_2 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + setdisp <= '1'; -- add Index + set(hold_dwr) <= '1'; + setstate <= "10"; + set(longaktion) <= '1'; + next_micro_state <= st_229_3; + + WHEN st_229_3 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + set(hold_dwr) <= '1'; + set_suppress_base <= '1'; + set(dispouter) <= '1'; + IF brief(1)='0' THEN --NULL Outer Displacement + setstate <= "01"; + ELSE --WORD Outer Displacement + IF brief(0)='1' THEN + set(longaktion) <= '1'; --LONG Outer Displacement + END IF; + END IF; + next_micro_state <= st_229_4; + + WHEN st_229_4 => -- (bd,An,Xn)=>, --(bd,PC,Xn)=> + set(hold_dwr) <= '1'; + IF brief(1)='1' THEN -- Outer Displacement + setdisp <= '1'; --add last_data_read + END IF; + IF brief(6)='0' AND brief(2)='1' THEN --Postindex + set(briefext) <= '1'; + setstate <= "01"; + next_micro_state <= st_AnXn2; + ELSE + setstate <= "11"; + next_micro_state <= nop; + END IF; + +---------------------------------------------------------------------------------------- + WHEN bra1 => --bra + IF exe_condition='1' THEN + TG68_PC_brw <= '1'; --pc+0000 + next_micro_state <= nop; + skipFetch <= '1'; + END IF; + + WHEN bsr1 => --bsr short + TG68_PC_brw <= '1'; + next_micro_state <= nop; + + WHEN bsr2 => --bsr + IF long_start='0' THEN + TG68_PC_brw <= '1'; + END IF; + skipFetch <= '1'; + set(longaktion) <= '1'; + writePC <= '1'; + setstate <= "11"; + next_micro_state <= nopnop; + setstackaddr <='1'; + WHEN nopnop => --bsr + next_micro_state <= nop; + + WHEN dbcc1 => --dbcc + IF exe_condition='0' THEN + Regwrena_now <= '1'; + IF c_out(1)='1' THEN + skipFetch <= '1'; + next_micro_state <= nop; + TG68_PC_brw <= '1'; + END IF; + END IF; + + WHEN movem1 => --movem + IF last_data_read(15 downto 0)/=X"0000" THEN + setstate <="01"; + IF opcode(5 downto 3)="100" THEN + set(mem_addsub) <= '1'; + END IF; + next_micro_state <= movem2; + END IF; + WHEN movem2 => --movem + IF movem_run='0' THEN + setstate <="01"; + ELSE + set(movem_action) <= '1'; + set(mem_addsub) <= '1'; + next_micro_state <= movem2; + IF opcode(10)='0' THEN + setstate <="11"; + set(write_reg) <= '1'; + ELSE + setstate <="10"; + END IF; + END IF; + + WHEN andi => --andi + IF opcode(5 downto 4)/="00" THEN + setnextpass <= '1'; + END IF; + + WHEN op_AxAy => -- op -(Ax),-(Ay) + set_direct_data <= '1'; + set(presub) <= '1'; + dest_hbits <= '1'; + dest_areg <= '1'; + setstate <= "10"; + + WHEN cmpm => -- cmpm (Ay)+,(Ax)+ + set_direct_data <= '1'; + set(postadd) <= '1'; + dest_hbits <= '1'; + dest_areg <= '1'; + setstate <= "10"; + + WHEN link1 => -- link + setstate <="11"; + source_areg <= '1'; + set(opcMOVE) <= '1'; + set(Regwrena) <= '1'; + next_micro_state <= link2; + WHEN link2 => -- link + setstackaddr <='1'; + set(ea_data_OP2) <= '1'; + + WHEN unlink1 => -- unlink + setstate <="10"; + setstackaddr <='1'; + set(postadd) <= '1'; + next_micro_state <= unlink2; + WHEN unlink2 => -- unlink + set(ea_data_OP2) <= '1'; + + WHEN trap0 => -- TRAP + set(presub) <= '1'; + setstackaddr <='1'; + setstate <= "11"; + IF VBR_Stackframe=1 OR (cpu(0)='1' AND VBR_Stackframe=2) THEN --68010 + set(writePC_add) <= '1'; + datatype <= "01"; +-- set_datatype <= "10"; + next_micro_state <= trap1; + ELSE + IF trap_interrupt='1' OR trap_trace='1' OR trap_berr='1' THEN + writePC <= '1'; + END IF; + datatype <= "10"; + next_micro_state <= trap2; + END IF; + WHEN trap1 => -- TRAP + IF trap_interrupt='1' OR trap_trace='1' THEN + writePC <= '1'; + END IF; + set(presub) <= '1'; + setstackaddr <='1'; + setstate <= "11"; + datatype <= "10"; + next_micro_state <= trap2; + WHEN trap2 => -- TRAP + set(presub) <= '1'; + setstackaddr <='1'; + setstate <= "11"; + datatype <= "01"; + writeSR <= '1'; + IF trap_berr='1' THEN + next_micro_state <= trap4; + ELSE + next_micro_state <= trap3; + END IF; + WHEN trap3 => -- TRAP + set_vectoraddr <= '1'; + datatype <= "10"; + set(direct_delta) <= '1'; + set(directPC) <= '1'; + setstate <= "10"; + next_micro_state <= nopnop; + + WHEN trap4 => -- TRAP + set(presub) <= '1'; + setstackaddr <='1'; + setstate <= "11"; + datatype <= "01"; + writeSR <= '1'; + next_micro_state <= trap5; + WHEN trap5 => -- TRAP + set(presub) <= '1'; + setstackaddr <='1'; + setstate <= "11"; + datatype <= "10"; + writeSR <= '1'; + next_micro_state <= trap6; + WHEN trap6 => -- TRAP + set(presub) <= '1'; + setstackaddr <='1'; + setstate <= "11"; + datatype <= "01"; + writeSR <= '1'; + next_micro_state <= trap3; + + WHEN rte1 => -- RTE + datatype <= "10"; + setstate <= "10"; + set(postadd) <= '1'; + setstackaddr <= '1'; + IF VBR_Stackframe=0 OR (cpu(0)='0' AND VBR_Stackframe=2) THEN + set(direct_delta) <= '1'; + END IF; + set(directPC) <= '1'; + next_micro_state <= rte2; + WHEN rte2 => -- RTE + datatype <= "01"; + set(update_FC) <= '1'; + IF VBR_Stackframe=1 OR (cpu(0)='1' AND VBR_Stackframe=2) THEN + setstate <= "10"; + set(postadd) <= '1'; + setstackaddr <= '1'; + next_micro_state <= rte3; + ELSE + next_micro_state <= nop; + END IF; + WHEN rte3 => -- RTE + next_micro_state <= nop; +-- set(update_FC) <= '1'; + + WHEN movec1 => -- MOVEC + set(briefext) <= '1'; + set_writePCbig <='1'; + IF (brief(11 downto 0)=X"000" OR brief(11 downto 0)=X"001" OR brief(11 downto 0)=X"800" OR brief(11 downto 0)=X"801") OR + (cpu(1)='1' AND (brief(11 downto 0)=X"002" OR brief(11 downto 0)=X"802" OR brief(11 downto 0)=X"803" OR brief(11 downto 0)=X"804")) THEN + IF opcode(0)='0' THEN + set(Regwrena) <= '1'; + END IF; +-- ELSIF brief(11 downto 0)=X"800"OR brief(11 downto 0)=X"001" OR brief(11 downto 0)=X"000" THEN +-- trap_addr_error <= '1'; +-- trapmake <= '1'; + ELSE + trap_illegal <= '1'; + trapmake <= '1'; + END IF; + + WHEN movep1 => -- MOVEP d(An) + setdisp <= '1'; + set(mem_addsub) <= '1'; + set(mem_byte) <= '1'; + set(OP1addr) <= '1'; + IF opcode(6)='1' THEN + set(movepl) <= '1'; + END IF; + IF opcode(7)='0' THEN + setstate <= "10"; + ELSE + setstate <= "11"; + END IF; + next_micro_state <= movep2; + WHEN movep2 => + IF opcode(6)='1' THEN + set(mem_addsub) <= '1'; + set(OP1addr) <= '1'; + END IF; + IF opcode(7)='0' THEN + setstate <= "10"; + ELSE + setstate <= "11"; + END IF; + next_micro_state <= movep3; + WHEN movep3 => + IF opcode(6)='1' THEN + set(mem_addsub) <= '1'; + set(OP1addr) <= '1'; + set(mem_byte) <= '1'; + IF opcode(7)='0' THEN + setstate <= "10"; + ELSE + setstate <= "11"; + END IF; + next_micro_state <= movep4; + ELSE + datatype <= "01"; --Word + END IF; + WHEN movep4 => + IF opcode(7)='0' THEN + setstate <= "10"; + ELSE + setstate <= "11"; + END IF; + next_micro_state <= movep5; + WHEN movep5 => + datatype <= "10"; --Long + + WHEN mul1 => -- mulu + IF opcode(15)='1' OR MUL_Mode=0 THEN + set_rot_cnt <= "001110"; + ELSE + set_rot_cnt <= "011110"; + END IF; + setstate <="01"; + next_micro_state <= mul2; + WHEN mul2 => -- mulu + setstate <="01"; + IF rot_cnt="00001" THEN + next_micro_state <= mul_end1; + ELSE + next_micro_state <= mul2; + END IF; + WHEN mul_end1 => -- mulu + datatype <= "10"; + set(opcMULU) <= '1'; + IF opcode(15)='0' AND (MUL_Mode=1 OR MUL_Mode=2) THEN + dest_2ndHbits <= '1'; + source_2ndLbits <= '1';--??? + set(write_lowlong) <= '1'; + IF sndOPC(10)='1' THEN + setstate <="01"; + next_micro_state <= mul_end2; + END IF; + set(Regwrena) <= '1'; + END IF; + datatype <= "10"; + WHEN mul_end2 => -- divu + set(write_reminder) <= '1'; + set(Regwrena) <= '1'; + set(opcMULU) <= '1'; + + WHEN div1 => -- divu + setstate <="01"; + next_micro_state <= div2; + WHEN div2 => -- divu + IF (OP2out(31 downto 16)=x"0000" OR opcode(15)='1' OR DIV_Mode=0) AND OP2out(15 downto 0)=x"0000" THEN --div zero + set_Z_error <= '1'; + ELSE + next_micro_state <= div3; + END IF; + set(ld_rot_cnt) <= '1'; + setstate <="01"; + WHEN div3 => -- divu + IF opcode(15)='1' OR DIV_Mode=0 THEN + set_rot_cnt <= "001101"; + ELSE + set_rot_cnt <= "011101"; + END IF; + setstate <="01"; + next_micro_state <= div4; + WHEN div4 => -- divu + setstate <="01"; + IF rot_cnt="00001" THEN + next_micro_state <= div_end1; + ELSE + next_micro_state <= div4; + END IF; + WHEN div_end1 => -- divu + IF opcode(15)='0' AND (DIV_Mode=1 OR DIV_Mode=2) THEN + set(write_reminder) <= '1'; + next_micro_state <= div_end2; + setstate <="01"; + END IF; + set(opcDIVU) <= '1'; + datatype <= "10"; + WHEN div_end2 => -- divu + dest_2ndHbits <= '1'; + source_2ndLbits <= '1';--??? + set(opcDIVU) <= '1'; + + WHEN rota1 => + IF OP2out(5 downto 0)/="000000" THEN + set_rot_cnt <= OP2out(5 downto 0); + ELSE + set_exec(rot_nop) <= '1'; + END IF; + + WHEN bf1 => + setstate <="10"; + + WHEN OTHERS => NULL; + END CASE; + END PROCESS; + +----------------------------------------------------------------------------- +-- MOVEC +----------------------------------------------------------------------------- +PROCESS (clk, VBR, CACR, brief) + BEGIN + IF rising_edge(clk) THEN + IF Reset = '1' THEN + VBR <= (OTHERS => '0'); + CACR <= (OTHERS => '0'); + ELSIF clkena_lw='1' AND exec(movec_wr)='1' THEN + CASE brief(11 downto 0) IS + WHEN X"002" => CACR <= reg_QA(3 downto 0); + WHEN X"801" => VBR <= reg_QA; + WHEN OTHERS => NULL; + END CASE; + END IF; + END IF; + movec_data <= (OTHERS=>'0'); + CASE brief(11 downto 0) IS + WHEN X"002" => movec_data(3 downto 0) <= CACR; + WHEN X"801" => --IF VBR_Stackframe=1 OR (cpu(0)='1' AND VBR_Stackframe=2) THEN + movec_data <= VBR; + --END IF; + WHEN OTHERS => NULL; + END CASE; + END PROCESS; + +----------------------------------------------------------------------------- +-- Conditions +----------------------------------------------------------------------------- +PROCESS (exe_opcode, Flags) + BEGIN + CASE exe_opcode(11 downto 8) IS + WHEN X"0" => exe_condition <= '1'; + WHEN X"1" => exe_condition <= '0'; + WHEN X"2" => exe_condition <= NOT Flags(0) AND NOT Flags(2); + WHEN X"3" => exe_condition <= Flags(0) OR Flags(2); + WHEN X"4" => exe_condition <= NOT Flags(0); + WHEN X"5" => exe_condition <= Flags(0); + WHEN X"6" => exe_condition <= NOT Flags(2); + WHEN X"7" => exe_condition <= Flags(2); + WHEN X"8" => exe_condition <= NOT Flags(1); + WHEN X"9" => exe_condition <= Flags(1); + WHEN X"a" => exe_condition <= NOT Flags(3); + WHEN X"b" => exe_condition <= Flags(3); + WHEN X"c" => exe_condition <= (Flags(3) AND Flags(1)) OR (NOT Flags(3) AND NOT Flags(1)); + WHEN X"d" => exe_condition <= (Flags(3) AND NOT Flags(1)) OR (NOT Flags(3) AND Flags(1)); + WHEN X"e" => exe_condition <= (Flags(3) AND Flags(1) AND NOT Flags(2)) OR (NOT Flags(3) AND NOT Flags(1) AND NOT Flags(2)); + WHEN X"f" => exe_condition <= (Flags(3) AND NOT Flags(1)) OR (NOT Flags(3) AND Flags(1)) OR Flags(2); + WHEN OTHERS => NULL; + END CASE; + END PROCESS; + +----------------------------------------------------------------------------- +-- Movem +----------------------------------------------------------------------------- +PROCESS (clk) + BEGIN + IF rising_edge(clk) THEN + IF clkena_lw='1' THEN + movem_actiond <= exec(movem_action); + IF decodeOPC='1' THEN + sndOPC <= data_read(15 downto 0); + ELSIF exec(movem_action)='1' OR set(movem_action) ='1' THEN + CASE movem_regaddr IS + WHEN "0000" => sndOPC(0) <= '0'; + WHEN "0001" => sndOPC(1) <= '0'; + WHEN "0010" => sndOPC(2) <= '0'; + WHEN "0011" => sndOPC(3) <= '0'; + WHEN "0100" => sndOPC(4) <= '0'; + WHEN "0101" => sndOPC(5) <= '0'; + WHEN "0110" => sndOPC(6) <= '0'; + WHEN "0111" => sndOPC(7) <= '0'; + WHEN "1000" => sndOPC(8) <= '0'; + WHEN "1001" => sndOPC(9) <= '0'; + WHEN "1010" => sndOPC(10) <= '0'; + WHEN "1011" => sndOPC(11) <= '0'; + WHEN "1100" => sndOPC(12) <= '0'; + WHEN "1101" => sndOPC(13) <= '0'; + WHEN "1110" => sndOPC(14) <= '0'; + WHEN "1111" => sndOPC(15) <= '0'; + WHEN OTHERS => NULL; + END CASE; + END IF; + END IF; + END IF; + END PROCESS; + +PROCESS (sndOPC, movem_mux) + BEGIN + movem_regaddr <="0000"; + movem_run <= '1'; + IF sndOPC(3 downto 0)="0000" THEN + IF sndOPC(7 downto 4)="0000" THEN + movem_regaddr(3) <= '1'; + IF sndOPC(11 downto 8)="0000" THEN + IF sndOPC(15 downto 12)="0000" THEN + movem_run <= '0'; + END IF; + movem_regaddr(2) <= '1'; + movem_mux <= sndOPC(15 downto 12); + ELSE + movem_mux <= sndOPC(11 downto 8); + END IF; + ELSE + movem_mux <= sndOPC(7 downto 4); + movem_regaddr(2) <= '1'; + END IF; + ELSE + movem_mux <= sndOPC(3 downto 0); + END IF; + IF movem_mux(1 downto 0)="00" THEN + movem_regaddr(1) <= '1'; + IF movem_mux(2)='0' THEN + movem_regaddr(0) <= '1'; + END IF; + ELSE + IF movem_mux(0)='0' THEN + movem_regaddr(0) <= '1'; + END IF; + END IF; + END PROCESS; +END; diff --git a/cores/ql/data_io.v b/cores/ql/data_io.v new file mode 100644 index 0000000..5b36ec4 --- /dev/null +++ b/cores/ql/data_io.v @@ -0,0 +1,120 @@ +// +// data_io.v +// +// io controller writable ram for the MiST board +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module data_io ( + // io controller spi interface + input sck, + input ss, + input sdi, + + output downloading, // signal indicating an active download + output reg [4:0] index, // menu index used to upload the file + + // external ram interface + input clk, + output reg wr, + output reg [24:0] addr, + output reg [15:0] data +); + +// ********************************************************************************* +// spi client +// ********************************************************************************* + +// this core supports only the display related OSD commands +// of the minimig +reg [14:0] sbuf; +reg [7:0] cmd; +reg [4:0] cnt; +reg rclk; + +reg [24:0] laddr; +reg [15:0] ldata; + +localparam UIO_FILE_TX = 8'h53; +localparam UIO_FILE_TX_DAT = 8'h54; +localparam UIO_FILE_INDEX = 8'h55; + +assign downloading = downloading_reg; +reg downloading_reg = 1'b0; + +// data_io has its own SPI interface to the io controller +always@(posedge sck, posedge ss) begin + if(ss == 1'b1) + cnt <= 5'd0; + else begin + rclk <= 1'b0; + + // don't shift in last bit. It is evaluated directly + // when writing to ram + if(cnt != 23) + sbuf <= { sbuf[13:0], sdi}; + + // count 0-7 8-15 16-23 8-15 16-23 ... + if(cnt < 23) cnt <= cnt + 4'd1; + else cnt <= 4'd8; + + // finished command byte + if(cnt == 7) + cmd <= {sbuf[6:0], sdi}; + + // prepare/end transmission + if((cmd == UIO_FILE_TX) && (cnt == 15)) begin + // prepare + if(sdi) begin + // download rom to address 0, microdrive image to 16MB+ + if(index == 0) laddr <= 25'h0 - 25'd1; + else laddr <= 25'h800000 - 25'd1; + + downloading_reg <= 1'b1; + end else + downloading_reg <= 1'b0; + end + + // command 0x54: UIO_FILE_TX + if((cmd == UIO_FILE_TX_DAT) && (cnt == 23)) begin + ldata <= {sbuf, sdi}; + laddr <= laddr + 1; + rclk <= 1'b1; + end + + // expose file (menu) index + if((cmd == UIO_FILE_INDEX) && (cnt == 15)) + index <= {sbuf[3:0], sdi}; + end +end + +reg rclkD, rclkD2; +always@(posedge clk) begin + // bring all signals from spi clock domain into local clock domain + rclkD <= rclk; + rclkD2 <= rclkD; + wr <= 1'b0; + + if(rclkD && !rclkD2) begin + addr <= laddr; + data <= ldata; + wr <= 1'b1; + end +end + +endmodule diff --git a/cores/ql/ipc.v b/cores/ql/ipc.v new file mode 100644 index 0000000..0d9bd74 --- /dev/null +++ b/cores/ql/ipc.v @@ -0,0 +1,131 @@ +// +// ipc.v +// +// Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module ipc ( + input reset, + input clk_bus, + + input ipc_bit_strobe, + input ipc_bit, + output reg ipc_reply_bit, + output ipc_busy, + + input ps2_kbd_clk, + input ps2_kbd_data +); + +assign ipc_busy = 1'b0; + +// --------------------------------------------------------------------------------- +// -------------------------------------- KBD -------------------------------------- +// --------------------------------------------------------------------------------- + +reg key_strobe; +wire [8:0] key; +wire key_available, key_pressed; + +keyboard keyboard ( + .reset ( reset ), + .clk ( clk_bus ), + + .ps2_clk ( ps2_kbd_clk ), + .ps2_data ( ps2_kbd_data ), + + .keycode_available ( key_available ), + .keycode ( key ), + .strobe ( key_strobe ), + .pressed ( key_pressed ) +); + +// --------------------------------------------------------------------------------- +// ----------------------------------- simple IPC ---------------------------------- +// --------------------------------------------------------------------------------- + +reg [15:0] ipc_reply; +reg [3:0] ipc_unexpected /* synthesis noprune */; +reg [7:0] ipc_reply_len; +reg [3:0] ipc_cmd; +reg [31:0] ipc_len /* synthesis noprune */; + +always @(posedge ipc_bit_strobe or posedge reset) begin + if(reset) begin + ipc_len <= 32'd0; + ipc_reply_len <= 8'h00; + ipc_reply <= 8'h00; + ipc_reply_bit <= 1'b0; + ipc_unexpected <= 4'h0; + key_strobe <= 1'b0; + end else begin + key_strobe <= 1'b0; + + if(ipc_reply_len == 0) begin + ipc_cmd <= { ipc_cmd[2:0], ipc_bit}; + ipc_len <= ipc_len + 32'd1; + + // last bit of a 4 bit command being written? + if(ipc_len[1:0] == 2'b11) begin + case({ ipc_cmd[2:0], ipc_bit }) + // request status + 1: begin + // send 8 bit ipc status reply, bit 0 -> 1=kbd data available + ipc_reply_len <= 8'd8; + ipc_reply_bit <= 1'b0; + ipc_reply <= { 7'b0000000, key_available, 8'h00 }; + end + + // keyboard + // nibble: PNNN N = chars in buffer, P = last key still pressed + // N*( + // nibble: ctrl/alt/shift + // byte: keycode + // ) + 8: begin + if(key_available) begin + // currently we can only report one key at once ... + ipc_reply_len <= 8'd16; + ipc_reply_bit <= 1'b0; + ipc_reply <= { 1'b0, 3'd1, 1'b0, key[8:6], 2'b00, key[5:0]}; + key_strobe <= 1'b1; + end else begin + // no key to report + ipc_reply_len <= 8'd4; + ipc_reply_bit <= 1'b0; + ipc_reply <= { 1'b0, 3'd0, 12'h000}; + end + end + + default: begin + if(ipc_unexpected == 0) + ipc_unexpected <= { ipc_cmd[2:0], ipc_bit }; + end + endcase; + end + end else begin + // sending reply: shift it out through the ipc_reply_bit register + ipc_reply_len <= ipc_reply_len - 8'd1; + ipc_reply_bit <= ipc_reply[15]; + ipc_reply <= { ipc_reply[14:0], 1'b0 }; + end + end +end + +endmodule diff --git a/cores/ql/keyboard.v b/cores/ql/keyboard.v new file mode 100644 index 0000000..f09fedd --- /dev/null +++ b/cores/ql/keyboard.v @@ -0,0 +1,231 @@ +// +// keyboard.v +// +// Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module keyboard ( + input clk, + input reset, + + // ps2 interface + input ps2_clk, + input ps2_data, + + output keycode_available, + output [8:0] keycode, + input strobe, + output reg pressed +); + +// F1 ESC 1 2 3 4 5 6 7 8 9 0 - = £ \ +// F2 TAB Q W E R T Y U I O P [ ] +// F3 CAPS A S D F G H J K L ; ' ENTER +// F4 SHIFT Z X C V B N M , . / SHIFT +// F5 CTRL LEFT RIGHT SPACE UP DOWN ALT + +// buffer to hold up to 8 keys +reg [2:0] modifier; +reg [2:0] key_rptr, key_wptr; +reg [8:0] key_fifo [7:0]; + +// read from fifo +assign keycode_available = key_rptr != key_wptr; +assign keycode = key_fifo[key_rptr]; +always @(posedge strobe or posedge reset) begin + if(reset) key_rptr <= 3'd0; + else key_rptr <= key_rptr + 3'd1; +end + +// the top most bit is set when the new value is written and cleared +// shortly after when the value itself is stable +always @(negedge ql_key[9] or posedge reset) begin + if(reset) + key_wptr <= 3'd0; + else begin + if(ql_key[8:6] == 3'b000) + key_fifo[key_wptr] <= { modifier, ql_key[5:0] }; + else + key_fifo[key_wptr] <= ql_key[8:0]; + + key_wptr <= key_wptr + 3'd1; + end +end + +wire released = reset || key_released; +always @(negedge ql_key[9] or posedge released) begin + if(released) pressed <= 1'b0; + else pressed <= 1'b1; +end + +wire [7:0] byte; +wire valid; +wire error; + +reg key_released; +reg key_extended; + +reg [9:0] ql_key; + +always @(posedge clk) begin + if(reset) begin + ql_key <= 10'b0; + key_released <= 1'b0; + key_extended <= 1'b0; + modifier <= 3'b000; + end else begin + ql_key[9] <= 1'b0; + + // ps2 decoder has received a valid byte + if(valid) begin + if(byte == 8'he0) + // extended key code + key_extended <= 1'b1; + else if(byte == 8'hf0) + // release code + key_released <= 1'b1; + else begin + key_extended <= 1'b0; + key_released <= 1'b0; + + // SHIFT + if((byte == 8'h12) || (byte == 8'h59)) + modifier[2] <= !key_released; + + // CTRL + if(byte == 8'h14) + modifier[1] <= !key_released; + + // ALT + if(byte == 8'h11) + modifier[0] <= !key_released; + + // only key down events are enqueued + if(!key_released) begin + case(byte) + // function keys + 8'h05: ql_key <= {1'b1, 3'b000, 6'd57}; // F1 + 8'h06: ql_key <= {1'b1, 3'b000, 6'd59}; // F2 + 8'h04: ql_key <= {1'b1, 3'b000, 6'd60}; // F3 + 8'h0c: ql_key <= {1'b1, 3'b000, 6'd56}; // F4 + 8'h03: ql_key <= {1'b1, 3'b000, 6'd61}; // F5 + + // cursor keys + 8'h75: ql_key <= {1'b1, 3'b000, 6'd50}; // Up + 8'h72: ql_key <= {1'b1, 3'b000, 6'd55}; // Down + 8'h6b: ql_key <= {1'b1, 3'b000, 6'd49}; // Left + 8'h74: ql_key <= {1'b1, 3'b000, 6'd52}; // Right + + 8'h1c: ql_key <= {1'b1, 3'b000, 6'd28}; // a + 8'h32: ql_key <= {1'b1, 3'b000, 6'd44}; // b + 8'h21: ql_key <= {1'b1, 3'b000, 6'd43}; // c + 8'h23: ql_key <= {1'b1, 3'b000, 6'd30}; // d + 8'h24: ql_key <= {1'b1, 3'b000, 6'd12}; // e + 8'h2b: ql_key <= {1'b1, 3'b000, 6'd36}; // f + 8'h34: ql_key <= {1'b1, 3'b000, 6'd38}; // g + 8'h33: ql_key <= {1'b1, 3'b000, 6'd26}; // h + 8'h43: ql_key <= {1'b1, 3'b000, 6'd18}; // i + 8'h3b: ql_key <= {1'b1, 3'b000, 6'd31}; // j + 8'h42: ql_key <= {1'b1, 3'b000, 6'd34}; // k + 8'h4b: ql_key <= {1'b1, 3'b000, 6'd24}; // l + 8'h3a: ql_key <= {1'b1, 3'b000, 6'd46}; // m + 8'h31: ql_key <= {1'b1, 3'b000, 6'd06}; // n + 8'h44: ql_key <= {1'b1, 3'b000, 6'd23}; // o + 8'h4d: ql_key <= {1'b1, 3'b000, 6'd29}; // p + 8'h15: ql_key <= {1'b1, 3'b000, 6'd11}; // q + 8'h2d: ql_key <= {1'b1, 3'b000, 6'd20}; // r + 8'h1b: ql_key <= {1'b1, 3'b000, 6'd35}; // s + 8'h2c: ql_key <= {1'b1, 3'b000, 6'd14}; // t + 8'h3c: ql_key <= {1'b1, 3'b000, 6'd15}; // u + 8'h2a: ql_key <= {1'b1, 3'b000, 6'd04}; // v + 8'h1d: ql_key <= {1'b1, 3'b000, 6'd17}; // w + 8'h22: ql_key <= {1'b1, 3'b000, 6'd03}; // x + 8'h35: ql_key <= {1'b1, 3'b000, 6'd22}; // y + 8'h1a: ql_key <= {1'b1, 3'b000, 6'd41}; // z + + 8'h45: ql_key <= {1'b1, 3'b000, 6'd13}; // 0 + 8'h16: ql_key <= {1'b1, 3'b000, 6'd27}; // 1 + 8'h1e: ql_key <= {1'b1, 3'b000, 6'd09}; // 2 + 8'h26: ql_key <= {1'b1, 3'b000, 6'd25}; // 3 + 8'h25: ql_key <= {1'b1, 3'b000, 6'd62}; // 4 + 8'h2e: ql_key <= {1'b1, 3'b000, 6'd58}; // 5 + 8'h36: ql_key <= {1'b1, 3'b000, 6'd10}; // 6 + 8'h3d: ql_key <= {1'b1, 3'b000, 6'd63}; // 7 + 8'h3e: ql_key <= {1'b1, 3'b000, 6'd08}; // 8 + 8'h46: ql_key <= {1'b1, 3'b000, 6'd16}; // 9 + + 8'h5a: ql_key <= {1'b1, 3'b000, 6'd48}; // RET + 8'h29: ql_key <= {1'b1, 3'b000, 6'd54}; // SPACE + 8'h0d: ql_key <= {1'b1, 3'b000, 6'd19}; // TAB + 8'h76: ql_key <= {1'b1, 3'b000, 6'd51}; // ESC + 8'h58: ql_key <= {1'b1, 3'b000, 6'd33}; // CAPS + + 8'h4e: ql_key <= {1'b1, 3'b000, 6'd21}; // - + 8'h55: ql_key <= {1'b1, 3'b000, 6'd37}; // = + 8'h61: ql_key <= {1'b1, 3'b000, 6'd45}; // Pound + 8'h5d: ql_key <= {1'b1, 3'b000, 6'd53}; // \ + + 8'h54: ql_key <= {1'b1, 3'b000, 6'd32}; // [ + 8'h5b: ql_key <= {1'b1, 3'b000, 6'd40}; // ] + + 8'h4c: ql_key <= {1'b1, 3'b000, 6'd39}; // ; + 8'h52: ql_key <= {1'b1, 3'b000, 6'd47}; // ' + + 8'h41: ql_key <= {1'b1, 3'b000, 6'd07}; // , + 8'h49: ql_key <= {1'b1, 3'b000, 6'd42}; // . + 8'h4a: ql_key <= {1'b1, 3'b000, 6'd05}; // / + + // special keys that include modifier + 8'h66: ql_key <= {1'b1, 3'b010, 6'd49}; // Backspace -> CTRL+LEFT + 8'h71: ql_key <= {1'b1, 3'b010, 6'd52}; // Delete -> CTRL+RIGHT + 8'h7d: ql_key <= {1'b1, 3'b100, 6'd50}; // PageUp -> SHIFT+UP + 8'h7a: ql_key <= {1'b1, 3'b100, 6'd55}; // PageDown -> SHIFT+DOWN + 8'h6c: ql_key <= {1'b1, 3'b001, 6'd49}; // Home -> ALT+LEFT + 8'h69: ql_key <= {1'b1, 3'b001, 6'd52}; // End -> ALT+RIGHT + 8'h0b: ql_key <= {1'b1, 3'b100, 6'd57}; // F6 -> SHIFT+F1 + 8'h83: ql_key <= {1'b1, 3'b100, 6'd59}; // F7 -> SHIFT+F2 + 8'h0a: ql_key <= {1'b1, 3'b100, 6'd60}; // F8 -> SHIFT+F3 + 8'h01: ql_key <= {1'b1, 3'b100, 6'd56}; // F9 -> SHIFT+F4 + 8'h09: ql_key <= {1'b1, 3'b100, 6'd61}; // F10 -> SHIFT+F5 + + endcase + end + end + end + end +end + +// the ps2 decoder has been taken from the zx spectrum core +ps2_intf ps2_keyboard ( + .CLK ( clk ), + .nRESET ( !reset ), + + // PS/2 interface + .PS2_CLK ( ps2_clk ), + .PS2_DATA ( ps2_data ), + + // Byte-wide data interface - only valid for one clock + // so must be latched externally if required + .DATA ( byte ), + .VALID ( valid ), + .ERROR ( error ) +); + + +endmodule diff --git a/cores/ql/mdv.v b/cores/ql/mdv.v new file mode 100644 index 0000000..3949b14 --- /dev/null +++ b/cores/ql/mdv.v @@ -0,0 +1,195 @@ +// +// mdv.v - Microdrive +// +// Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module mdv ( + input clk, // 21mhz clock + input reset, + + input sel, + + // control bits + output gap, + output tx_empty, + output rx_ready, + output [7:0] dout, + + // ram interface to read image + input download, + input [24:0] dl_addr, + + input mem_ena, + input mem_cycle, + input mem_clk, + output reg mem_read, + output reg [24:0] mem_addr, + input [15:0] mem_din +); + +localparam BASE_ADDR = 25'h800000; + +// a gap is permanently present if no mdv is inserted or if +// there's a gap on the inserted one. This is the signal that triggers +// the irq and can be seen by the cpu +assign gap = (!mdv_present) || mdv_gap /* synthesis keep */; + +// the mdv_rx_ready flag must be quite short as the CPU never waist for it to end +wire mdv_valid = (mdv_bit_cnt[2:0] == 2); +assign rx_ready = mdv_present && mdv_data_valid && mdv_valid /* synthesis keep */; +assign tx_empty = 1'b0; + +// microdrive implementation works with images which are uploaded by the user into +// the part of ram which is unavailable to the 68k CPU (>16MB). It is then continously +// replayed from there at 200kbit/s + +reg [7:0] mdv_sector /* synthesis noprune */; + +reg [24:0] mdv_end /* synthesis noprune */; + +// determine mdv image size after download +always @(negedge download or posedge reset) begin + if(reset) mdv_end <= BASE_ADDR; + else mdv_end <= dl_addr; +end + +// the microdrive at 200kbit/s reads a bit every 8.3us and needs a new word +// every 80us. video hsync comes every 64us. A new word can thus be read in +// the hsync phase while video isn't accessing ram and the next word will not +// be needed before the next hsync + +// gaps are 2800/3400 us which is 35 words at 200kbit/s + +assign dout = mdv_bit_cnt[3]?mdv_data[7:0]:mdv_data[15:8]; + +// data is valid at the end of the video cycle while mem_read is active +reg [15:0] mdv_din /* synthesis noprune */; +always @(negedge mem_cycle) + if(mem_read) mdv_din <= mem_din; + +// activate memory read for the next full video cycle after mdv_required +always @(negedge mem_clk) begin + // mdv memory enable signal from zx8301 to give mdv emulation ram access + if(!mem_cycle) + mem_read <= mdv_rd_wait && mem_ena; +end + +// wait for next hsync to service request +reg mdv_rd_wait /* synthesis noprune */; +wire mdv_rd_ack = mem_read; +always @(posedge mdv_next_word or posedge mdv_rd_ack) begin + if(mdv_rd_ack) mdv_rd_wait <= 1'b0; + else mdv_rd_wait <= 1'b1; +end + +// a microdrive image is present if at least one word is in the buffer +wire mdv_present = sel && (mdv_end != BASE_ADDR); +reg mdv_next_word /* synthesis noprune */; +reg [3:0] mdv_bit_cnt /* synthesis noprune */; + +// also generate gap timing +reg [9:0] mdv_gap_cnt /* synthesis noprune */; +reg mdv_gap_state /* synthesis noprune */; +reg mdv_gap_active /* synthesis noprune */; +reg [15:0] mdv_data; +reg mdv_data_valid; +reg mdv_gap; + +always @(posedge mdv_clk) begin + mdv_next_word <= 1'b0; + + mdv_bit_cnt <= mdv_bit_cnt + 4'd1; + if(mdv_bit_cnt == 15) begin + mdv_data <= mdv_din; + mdv_data_valid <= !mdv_gap_active && + // don't generate data_valid for first 12 bytes (preamble) + (mdv_gap_cnt > 5) && + // and also not for the sector internal preamble + !(mdv_gap_state && (mdv_gap_cnt > 7) && (mdv_gap_cnt < 12)); + + mdv_next_word <= 1'b1; + + // reset counters when address is out of range + if((mem_addr > mdv_end)||(mem_addr < 25'h800000)) begin + mem_addr <= BASE_ADDR; + + // assume we start at the end of a post-sector/pre-header gap + mdv_gap_cnt <= 10'd0; // count bytes until gap + mdv_gap_state <= 1'b1; // toggle header + data gap + mdv_gap_active <= 1'b1; // gap atm + mdv_sector <= 8'd0; + mdv_gap <= 1'b1; + end else begin + mdv_gap_cnt <= mdv_gap_cnt + 10'd1; + + if(mdv_gap_active) begin + + // stop sending gap after 35 words = 70 bytes = 2800us + if(mdv_gap_cnt == 34) begin + mdv_gap_cnt <= 10'd0; // restart counter until next gap + mdv_gap_active <= 1'b0; // no gap anymore + mdv_gap_state <= !mdv_gap_state; // toggle gap/data + mdv_gap <= 1'b0; + end + end else begin + mem_addr <= mem_addr + 25'd1; + + if((!mdv_gap_state) && (mdv_gap_cnt == 13)) begin + // done reading 14 words header data + mdv_gap_cnt <= 10'd0; // restart counter for gap + mdv_gap_active <= 1'b1; // now comes a gap + mdv_gap <= 1'b1; + end else if(mdv_gap_state && (mdv_gap_cnt == 328)) begin + // done reading 330 words sector data + mdv_gap_cnt <= 10'd0; // restart counter for gap + mdv_gap_active <= 1'b1; // now comes a gap + mdv_gap <= 1'b1; + + // The sectors on cartridges are written in descending order + // The images seem to contain them in ascending order. So we + // have to replay them backwards for better performance + + if(mem_addr == BASE_ADDR + 343 - 1) + mem_addr <= mdv_end - 343 + 1; + else + mem_addr <= mem_addr - 2*343 + 1; + + mdv_sector <= mdv_sector + 8'd1; + end + + end + end + end +end + +// microdrive clock runs at 200khz +// -> new word required every 80us +localparam mdv_clk_scaler = 21000000/(2*200000)-1; +reg mdv_clk; +reg [7:0] mdv_clk_cnt; +always @(posedge clk) begin + if(mdv_clk_cnt == mdv_clk_scaler) begin + mdv_clk_cnt <= 8'd0; + mdv_clk <= !mdv_clk; + end else + mdv_clk_cnt <= mdv_clk_cnt + 8'd1; +end + +endmodule diff --git a/cores/ql/osd.v b/cores/ql/osd.v new file mode 100644 index 0000000..3c5ba47 --- /dev/null +++ b/cores/ql/osd.v @@ -0,0 +1,204 @@ +// +// osd.v +// +// A simple OSD implementation. Can be hooked up between a cores +// VGA output and the physical VGA pins +// +// Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module osd ( + // OSDs pixel clock, should be synchronous to cores pixel clock to + // avoid jitter. + input pclk, + + // SPI interface + input sck, + input ss, + input sdi, + + // VGA signals coming from core + input [5:0] red_in, + input [5:0] green_in, + input [5:0] blue_in, + input hs_in, + input vs_in, + + // VGA signals going to video connector + output [5:0] red_out, + output [5:0] green_out, + output [5:0] blue_out, + output hs_out, + output vs_out +); + +parameter OSD_X_OFFSET = 10'd0; +parameter OSD_Y_OFFSET = 10'd0; +parameter OSD_COLOR = 3'd0; + +localparam OSD_WIDTH = 10'd256; +localparam OSD_HEIGHT = 10'd128; + +// ********************************************************************************* +// spi client +// ********************************************************************************* + +// this core supports only the display related OSD commands +// of the minimig +reg [7:0] sbuf; +reg [7:0] cmd; +reg [4:0] cnt; +reg [10:0] bcnt; +reg osd_enable; + +reg [7:0] osd_buffer [2047:0]; // the OSD buffer itself + +// the OSD has its own SPI interface to the io controller +always@(posedge sck, posedge ss) begin + if(ss == 1'b1) begin + cnt <= 5'd0; + bcnt <= 11'd0; + end else begin + sbuf <= { sbuf[6:0], sdi}; + + // 0:7 is command, rest payload + if(cnt < 15) + cnt <= cnt + 4'd1; + else + cnt <= 4'd8; + + if(cnt == 7) begin + cmd <= {sbuf[6:0], sdi}; + + // lower three command bits are line address + bcnt <= { sbuf[1:0], sdi, 8'h00}; + + // command 0x40: OSDCMDENABLE, OSDCMDDISABLE + if(sbuf[6:3] == 4'b0100) + osd_enable <= sdi; + end + + // command 0x20: OSDCMDWRITE + if((cmd[7:3] == 5'b00100) && (cnt == 15)) begin + osd_buffer[bcnt] <= {sbuf[6:0], sdi}; + bcnt <= bcnt + 11'd1; + end + end +end + +// ********************************************************************************* +// video timing and sync polarity anaylsis +// ********************************************************************************* + +// horizontal counter +reg [9:0] h_cnt; +reg hsD, hsD2; +reg [9:0] hs_low, hs_high; +wire hs_pol = hs_high < hs_low; +wire [9:0] h_dsp_width = hs_pol?hs_low:hs_high; +wire [9:0] h_dsp_ctr = { 1'b0, h_dsp_width[9:1] }; + +always @(posedge pclk) begin + // bring hsync into local clock domain + hsD <= hs_in; + hsD2 <= hsD; + + // falling edge of hs_in + if(!hsD && hsD2) begin + h_cnt <= 10'd0; + hs_high <= h_cnt; + end + + // rising edge of hs_in + else if(hsD && !hsD2) begin + h_cnt <= 10'd0; + hs_low <= h_cnt; + end + + else + h_cnt <= h_cnt + 10'd1; +end + +// vertical counter +reg [9:0] v_cnt; +reg vsD, vsD2; +reg [9:0] vs_low, vs_high; +wire vs_pol = vs_high < vs_low; +wire [9:0] v_dsp_width = vs_pol?vs_low:vs_high; +wire [9:0] v_dsp_ctr = { 1'b0, v_dsp_width[9:1] }; + +always @(posedge hs_in) begin + // bring vsync into local clock domain + vsD <= vs_in; + vsD2 <= vsD; + + // falling edge of vs_in + if(!vsD && vsD2) begin + v_cnt <= 10'd0; + vs_high <= v_cnt; + end + + // rising edge of vs_in + else if(vsD && !vsD2) begin + v_cnt <= 10'd0; + vs_low <= v_cnt; + end + + else + v_cnt <= v_cnt + 10'd1; +end + +// area in which OSD is being displayed +wire [9:0] h_osd_start = h_dsp_ctr + OSD_X_OFFSET - (OSD_WIDTH >> 1); +wire [9:0] h_osd_end = h_dsp_ctr + OSD_X_OFFSET + (OSD_WIDTH >> 1) - 1; +wire [9:0] v_osd_start = v_dsp_ctr + OSD_Y_OFFSET - (OSD_HEIGHT >> 1); +wire [9:0] v_osd_end = v_dsp_ctr + OSD_Y_OFFSET + (OSD_HEIGHT >> 1) - 1; + +reg h_osd_active, v_osd_active; +always @(posedge pclk) begin + if(hs_in != hs_pol) begin + if(h_cnt == h_osd_start) h_osd_active <= 1'b1; + if(h_cnt == h_osd_end) h_osd_active <= 1'b0; + end + if(vs_in != vs_pol) begin + if(v_cnt == v_osd_start) v_osd_active <= 1'b1; + if(v_cnt == v_osd_end) v_osd_active <= 1'b0; + end +end + +wire osd_de = osd_enable && h_osd_active && v_osd_active; + +wire [7:0] osd_hcnt = h_cnt - h_osd_start + 7'd1; // one pixel offset for osd_byte register +wire [6:0] osd_vcnt = v_cnt - v_osd_start; + +wire osd_pixel = osd_byte[osd_vcnt[3:1]]; + +reg [7:0] osd_byte; +always @(posedge pclk) + osd_byte <= osd_buffer[{osd_vcnt[6:4], osd_hcnt}]; + +wire [2:0] osd_color = OSD_COLOR; +assign red_out = !osd_de?red_in: {osd_pixel, osd_pixel, osd_color[2], red_in[5:3] }; +assign green_out = !osd_de?green_in:{osd_pixel, osd_pixel, osd_color[1], green_in[5:3]}; +assign blue_out = !osd_de?blue_in: {osd_pixel, osd_pixel, osd_color[0], blue_in[5:3] }; + +assign hs_out = hs_in; +assign vs_out = vs_in; + +endmodule diff --git a/cores/ql/pll.qip b/cores/ql/pll.qip new file mode 100644 index 0000000..afd958b --- /dev/null +++ b/cores/ql/pll.qip @@ -0,0 +1,4 @@ +set_global_assignment -name IP_TOOL_NAME "ALTPLL" +set_global_assignment -name IP_TOOL_VERSION "13.1" +set_global_assignment -name VERILOG_FILE [file join $::quartus(qip_path) "pll.v"] +set_global_assignment -name MISC_FILE [file join $::quartus(qip_path) "pll.ppf"] diff --git a/cores/ql/pll.v b/cores/ql/pll.v new file mode 100644 index 0000000..cc42c3a --- /dev/null +++ b/cores/ql/pll.v @@ -0,0 +1,337 @@ +// megafunction wizard: %ALTPLL% +// GENERATION: STANDARD +// VERSION: WM1.0 +// MODULE: altpll + +// ============================================================ +// File Name: pll.v +// Megafunction Name(s): +// altpll +// +// Simulation Library Files(s): +// altera_mf +// ============================================================ +// ************************************************************ +// THIS IS A WIZARD-GENERATED FILE. DO NOT EDIT THIS FILE! +// +// 13.1.4 Build 182 03/12/2014 SJ Web Edition +// ************************************************************ + + +//Copyright (C) 1991-2014 Altera Corporation +//Your use of Altera Corporation's design tools, logic functions +//and other software and tools, and its AMPP partner logic +//functions, and any output files from any of the foregoing +//(including device programming or simulation files), and any +//associated documentation or information are expressly subject +//to the terms and conditions of the Altera Program License +//Subscription Agreement, Altera MegaCore Function License +//Agreement, or other applicable license agreement, including, +//without limitation, that your use is for the sole purpose of +//programming logic devices manufactured by Altera and sold by +//Altera or its authorized distributors. Please refer to the +//applicable agreement for further details. + + +// synopsys translate_off +`timescale 1 ps / 1 ps +// synopsys translate_on +module pll ( + inclk0, + c0, + c1, + locked); + + input inclk0; + output c0; + output c1; + output locked; + + wire [4:0] sub_wire0; + wire sub_wire2; + wire [0:0] sub_wire6 = 1'h0; + wire [0:0] sub_wire3 = sub_wire0[0:0]; + wire [1:1] sub_wire1 = sub_wire0[1:1]; + wire c1 = sub_wire1; + wire locked = sub_wire2; + wire c0 = sub_wire3; + wire sub_wire4 = inclk0; + wire [1:0] sub_wire5 = {sub_wire6, sub_wire4}; + + altpll altpll_component ( + .inclk (sub_wire5), + .clk (sub_wire0), + .locked (sub_wire2), + .activeclock (), + .areset (1'b0), + .clkbad (), + .clkena ({6{1'b1}}), + .clkloss (), + .clkswitch (1'b0), + .configupdate (1'b0), + .enable0 (), + .enable1 (), + .extclk (), + .extclkena ({4{1'b1}}), + .fbin (1'b1), + .fbmimicbidir (), + .fbout (), + .fref (), + .icdrclk (), + .pfdena (1'b1), + .phasecounterselect ({4{1'b1}}), + .phasedone (), + .phasestep (1'b1), + .phaseupdown (1'b1), + .pllena (1'b1), + .scanaclr (1'b0), + .scanclk (1'b0), + .scanclkena (1'b1), + .scandata (1'b0), + .scandataout (), + .scandone (), + .scanread (1'b0), + .scanwrite (1'b0), + .sclkout0 (), + .sclkout1 (), + .vcooverrange (), + .vcounderrange ()); + defparam + altpll_component.bandwidth_type = "AUTO", + altpll_component.clk0_divide_by = 9, + altpll_component.clk0_duty_cycle = 50, + altpll_component.clk0_multiply_by = 7, + altpll_component.clk0_phase_shift = "0", + altpll_component.clk1_divide_by = 9, + altpll_component.clk1_duty_cycle = 50, + altpll_component.clk1_multiply_by = 7, + altpll_component.clk1_phase_shift = "-5000", + altpll_component.compensate_clock = "CLK0", + altpll_component.inclk0_input_frequency = 37037, + altpll_component.intended_device_family = "Cyclone III", + altpll_component.lpm_hint = "CBX_MODULE_PREFIX=pll", + altpll_component.lpm_type = "altpll", + altpll_component.operation_mode = "NORMAL", + altpll_component.pll_type = "AUTO", + altpll_component.port_activeclock = "PORT_UNUSED", + altpll_component.port_areset = "PORT_UNUSED", + altpll_component.port_clkbad0 = "PORT_UNUSED", + altpll_component.port_clkbad1 = "PORT_UNUSED", + altpll_component.port_clkloss = "PORT_UNUSED", + altpll_component.port_clkswitch = "PORT_UNUSED", + altpll_component.port_configupdate = "PORT_UNUSED", + altpll_component.port_fbin = "PORT_UNUSED", + altpll_component.port_inclk0 = "PORT_USED", + altpll_component.port_inclk1 = "PORT_UNUSED", + altpll_component.port_locked = "PORT_USED", + altpll_component.port_pfdena = "PORT_UNUSED", + altpll_component.port_phasecounterselect = "PORT_UNUSED", + altpll_component.port_phasedone = "PORT_UNUSED", + altpll_component.port_phasestep = "PORT_UNUSED", + altpll_component.port_phaseupdown = "PORT_UNUSED", + altpll_component.port_pllena = "PORT_UNUSED", + altpll_component.port_scanaclr = "PORT_UNUSED", + altpll_component.port_scanclk = "PORT_UNUSED", + altpll_component.port_scanclkena = "PORT_UNUSED", + altpll_component.port_scandata = "PORT_UNUSED", + altpll_component.port_scandataout = "PORT_UNUSED", + altpll_component.port_scandone = "PORT_UNUSED", + altpll_component.port_scanread = "PORT_UNUSED", + altpll_component.port_scanwrite = "PORT_UNUSED", + altpll_component.port_clk0 = "PORT_USED", + altpll_component.port_clk1 = "PORT_USED", + altpll_component.port_clk2 = "PORT_UNUSED", + altpll_component.port_clk3 = "PORT_UNUSED", + altpll_component.port_clk4 = "PORT_UNUSED", + altpll_component.port_clk5 = "PORT_UNUSED", + altpll_component.port_clkena0 = "PORT_UNUSED", + altpll_component.port_clkena1 = "PORT_UNUSED", + altpll_component.port_clkena2 = "PORT_UNUSED", + altpll_component.port_clkena3 = "PORT_UNUSED", + altpll_component.port_clkena4 = "PORT_UNUSED", + altpll_component.port_clkena5 = "PORT_UNUSED", + altpll_component.port_extclk0 = "PORT_UNUSED", + altpll_component.port_extclk1 = "PORT_UNUSED", + altpll_component.port_extclk2 = "PORT_UNUSED", + altpll_component.port_extclk3 = "PORT_UNUSED", + altpll_component.self_reset_on_loss_lock = "OFF", + altpll_component.width_clock = 5; + + +endmodule + +// ============================================================ +// CNX file retrieval info +// ============================================================ +// Retrieval info: PRIVATE: ACTIVECLK_CHECK STRING "0" +// Retrieval info: PRIVATE: BANDWIDTH STRING "1.000" +// Retrieval info: PRIVATE: BANDWIDTH_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: BANDWIDTH_FREQ_UNIT STRING "MHz" +// Retrieval info: PRIVATE: BANDWIDTH_PRESET STRING "Low" +// Retrieval info: PRIVATE: BANDWIDTH_USE_AUTO STRING "1" +// Retrieval info: PRIVATE: BANDWIDTH_USE_PRESET STRING "0" +// Retrieval info: PRIVATE: CLKBAD_SWITCHOVER_CHECK STRING "0" +// Retrieval info: PRIVATE: CLKLOSS_CHECK STRING "0" +// Retrieval info: PRIVATE: CLKSWITCH_CHECK STRING "0" +// Retrieval info: PRIVATE: CNX_NO_COMPENSATE_RADIO STRING "0" +// Retrieval info: PRIVATE: CREATE_CLKBAD_CHECK STRING "0" +// Retrieval info: PRIVATE: CREATE_INCLK1_CHECK STRING "0" +// Retrieval info: PRIVATE: CUR_DEDICATED_CLK STRING "c0" +// Retrieval info: PRIVATE: CUR_FBIN_CLK STRING "c0" +// Retrieval info: PRIVATE: DEVICE_SPEED_GRADE STRING "8" +// Retrieval info: PRIVATE: DIV_FACTOR0 NUMERIC "9" +// Retrieval info: PRIVATE: DIV_FACTOR1 NUMERIC "9" +// Retrieval info: PRIVATE: DUTY_CYCLE0 STRING "50.00000000" +// Retrieval info: PRIVATE: DUTY_CYCLE1 STRING "50.00000000" +// Retrieval info: PRIVATE: EFF_OUTPUT_FREQ_VALUE0 STRING "21.000000" +// Retrieval info: PRIVATE: EFF_OUTPUT_FREQ_VALUE1 STRING "21.000000" +// Retrieval info: PRIVATE: EXPLICIT_SWITCHOVER_COUNTER STRING "0" +// Retrieval info: PRIVATE: EXT_FEEDBACK_RADIO STRING "0" +// Retrieval info: PRIVATE: GLOCKED_COUNTER_EDIT_CHANGED STRING "1" +// Retrieval info: PRIVATE: GLOCKED_FEATURE_ENABLED STRING "0" +// Retrieval info: PRIVATE: GLOCKED_MODE_CHECK STRING "0" +// Retrieval info: PRIVATE: GLOCK_COUNTER_EDIT NUMERIC "1048575" +// Retrieval info: PRIVATE: HAS_MANUAL_SWITCHOVER STRING "1" +// Retrieval info: PRIVATE: INCLK0_FREQ_EDIT STRING "27.000" +// Retrieval info: PRIVATE: INCLK0_FREQ_UNIT_COMBO STRING "MHz" +// Retrieval info: PRIVATE: INCLK1_FREQ_EDIT STRING "100.000" +// Retrieval info: PRIVATE: INCLK1_FREQ_EDIT_CHANGED STRING "1" +// Retrieval info: PRIVATE: INCLK1_FREQ_UNIT_CHANGED STRING "1" +// Retrieval info: PRIVATE: INCLK1_FREQ_UNIT_COMBO STRING "MHz" +// Retrieval info: PRIVATE: INTENDED_DEVICE_FAMILY STRING "Cyclone III" +// Retrieval info: PRIVATE: INT_FEEDBACK__MODE_RADIO STRING "1" +// Retrieval info: PRIVATE: LOCKED_OUTPUT_CHECK STRING "1" +// Retrieval info: PRIVATE: LONG_SCAN_RADIO STRING "1" +// Retrieval info: PRIVATE: LVDS_MODE_DATA_RATE STRING "Not Available" +// Retrieval info: PRIVATE: LVDS_MODE_DATA_RATE_DIRTY NUMERIC "0" +// Retrieval info: PRIVATE: LVDS_PHASE_SHIFT_UNIT0 STRING "deg" +// Retrieval info: PRIVATE: LVDS_PHASE_SHIFT_UNIT1 STRING "ps" +// Retrieval info: PRIVATE: MIG_DEVICE_SPEED_GRADE STRING "Any" +// Retrieval info: PRIVATE: MIRROR_CLK0 STRING "0" +// Retrieval info: PRIVATE: MIRROR_CLK1 STRING "0" +// Retrieval info: PRIVATE: MULT_FACTOR0 NUMERIC "7" +// Retrieval info: PRIVATE: MULT_FACTOR1 NUMERIC "7" +// Retrieval info: PRIVATE: NORMAL_MODE_RADIO STRING "1" +// Retrieval info: PRIVATE: OUTPUT_FREQ0 STRING "21.00000000" +// Retrieval info: PRIVATE: OUTPUT_FREQ1 STRING "21.00000000" +// Retrieval info: PRIVATE: OUTPUT_FREQ_MODE0 STRING "0" +// Retrieval info: PRIVATE: OUTPUT_FREQ_MODE1 STRING "0" +// Retrieval info: PRIVATE: OUTPUT_FREQ_UNIT0 STRING "MHz" +// Retrieval info: PRIVATE: OUTPUT_FREQ_UNIT1 STRING "MHz" +// Retrieval info: PRIVATE: PHASE_RECONFIG_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: PHASE_RECONFIG_INPUTS_CHECK STRING "0" +// Retrieval info: PRIVATE: PHASE_SHIFT0 STRING "0.00000000" +// Retrieval info: PRIVATE: PHASE_SHIFT1 STRING "-5000.00000000" +// Retrieval info: PRIVATE: PHASE_SHIFT_STEP_ENABLED_CHECK STRING "0" +// Retrieval info: PRIVATE: PHASE_SHIFT_UNIT0 STRING "deg" +// Retrieval info: PRIVATE: PHASE_SHIFT_UNIT1 STRING "ps" +// Retrieval info: PRIVATE: PLL_ADVANCED_PARAM_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_ARESET_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_AUTOPLL_CHECK NUMERIC "1" +// Retrieval info: PRIVATE: PLL_ENHPLL_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PLL_FASTPLL_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PLL_FBMIMIC_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_LVDS_PLL_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PLL_PFDENA_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_TARGET_HARCOPY_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PRIMARY_CLK_COMBO STRING "inclk0" +// Retrieval info: PRIVATE: RECONFIG_FILE STRING "pll.mif" +// Retrieval info: PRIVATE: SACN_INPUTS_CHECK STRING "0" +// Retrieval info: PRIVATE: SCAN_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: SELF_RESET_LOCK_LOSS STRING "0" +// Retrieval info: PRIVATE: SHORT_SCAN_RADIO STRING "0" +// Retrieval info: PRIVATE: SPREAD_FEATURE_ENABLED STRING "0" +// Retrieval info: PRIVATE: SPREAD_FREQ STRING "50.000" +// Retrieval info: PRIVATE: SPREAD_FREQ_UNIT STRING "KHz" +// Retrieval info: PRIVATE: SPREAD_PERCENT STRING "0.500" +// Retrieval info: PRIVATE: SPREAD_USE STRING "0" +// Retrieval info: PRIVATE: SRC_SYNCH_COMP_RADIO STRING "0" +// Retrieval info: PRIVATE: STICKY_CLK0 STRING "1" +// Retrieval info: PRIVATE: STICKY_CLK1 STRING "1" +// Retrieval info: PRIVATE: SWITCHOVER_COUNT_EDIT NUMERIC "1" +// Retrieval info: PRIVATE: SWITCHOVER_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: SYNTH_WRAPPER_GEN_POSTFIX STRING "0" +// Retrieval info: PRIVATE: USE_CLK0 STRING "1" +// Retrieval info: PRIVATE: USE_CLK1 STRING "1" +// Retrieval info: PRIVATE: USE_CLKENA0 STRING "0" +// Retrieval info: PRIVATE: USE_CLKENA1 STRING "0" +// Retrieval info: PRIVATE: USE_MIL_SPEED_GRADE NUMERIC "0" +// Retrieval info: PRIVATE: ZERO_DELAY_RADIO STRING "0" +// Retrieval info: LIBRARY: altera_mf altera_mf.altera_mf_components.all +// Retrieval info: CONSTANT: BANDWIDTH_TYPE STRING "AUTO" +// Retrieval info: CONSTANT: CLK0_DIVIDE_BY NUMERIC "9" +// Retrieval info: CONSTANT: CLK0_DUTY_CYCLE NUMERIC "50" +// Retrieval info: CONSTANT: CLK0_MULTIPLY_BY NUMERIC "7" +// Retrieval info: CONSTANT: CLK0_PHASE_SHIFT STRING "0" +// Retrieval info: CONSTANT: CLK1_DIVIDE_BY NUMERIC "9" +// Retrieval info: CONSTANT: CLK1_DUTY_CYCLE NUMERIC "50" +// Retrieval info: CONSTANT: CLK1_MULTIPLY_BY NUMERIC "7" +// Retrieval info: CONSTANT: CLK1_PHASE_SHIFT STRING "-5000" +// Retrieval info: CONSTANT: COMPENSATE_CLOCK STRING "CLK0" +// Retrieval info: CONSTANT: INCLK0_INPUT_FREQUENCY NUMERIC "37037" +// Retrieval info: CONSTANT: INTENDED_DEVICE_FAMILY STRING "Cyclone III" +// Retrieval info: CONSTANT: LPM_TYPE STRING "altpll" +// Retrieval info: CONSTANT: OPERATION_MODE STRING "NORMAL" +// Retrieval info: CONSTANT: PLL_TYPE STRING "AUTO" +// Retrieval info: CONSTANT: PORT_ACTIVECLOCK STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_ARESET STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKBAD0 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKBAD1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKLOSS STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKSWITCH STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CONFIGUPDATE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_FBIN STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_INCLK0 STRING "PORT_USED" +// Retrieval info: CONSTANT: PORT_INCLK1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_LOCKED STRING "PORT_USED" +// Retrieval info: CONSTANT: PORT_PFDENA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASECOUNTERSELECT STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASEDONE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASESTEP STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASEUPDOWN STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PLLENA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANACLR STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANCLK STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANCLKENA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANDATA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANDATAOUT STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANDONE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANREAD STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANWRITE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk0 STRING "PORT_USED" +// Retrieval info: CONSTANT: PORT_clk1 STRING "PORT_USED" +// Retrieval info: CONSTANT: PORT_clk2 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk3 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk4 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk5 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena0 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena2 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena3 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena4 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena5 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk0 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk2 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk3 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: SELF_RESET_ON_LOSS_LOCK STRING "OFF" +// Retrieval info: CONSTANT: WIDTH_CLOCK NUMERIC "5" +// Retrieval info: USED_PORT: @clk 0 0 5 0 OUTPUT_CLK_EXT VCC "@clk[4..0]" +// Retrieval info: USED_PORT: c0 0 0 0 0 OUTPUT_CLK_EXT VCC "c0" +// Retrieval info: USED_PORT: c1 0 0 0 0 OUTPUT_CLK_EXT VCC "c1" +// Retrieval info: USED_PORT: inclk0 0 0 0 0 INPUT_CLK_EXT GND "inclk0" +// Retrieval info: USED_PORT: locked 0 0 0 0 OUTPUT GND "locked" +// Retrieval info: CONNECT: @inclk 0 0 1 1 GND 0 0 0 0 +// Retrieval info: CONNECT: @inclk 0 0 1 0 inclk0 0 0 0 0 +// Retrieval info: CONNECT: c0 0 0 0 0 @clk 0 0 1 0 +// Retrieval info: CONNECT: c1 0 0 0 0 @clk 0 0 1 1 +// Retrieval info: CONNECT: locked 0 0 0 0 @locked 0 0 0 0 +// Retrieval info: GEN_FILE: TYPE_NORMAL pll.v TRUE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll.ppf TRUE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll.inc FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll.cmp FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll.bsf FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_inst.v FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_bb.v FALSE +// Retrieval info: LIB_FILE: altera_mf +// Retrieval info: CBX_MODULE_PREFIX: ON diff --git a/cores/ql/pll_rtc.qip b/cores/ql/pll_rtc.qip new file mode 100644 index 0000000..f744a1c --- /dev/null +++ b/cores/ql/pll_rtc.qip @@ -0,0 +1,4 @@ +set_global_assignment -name IP_TOOL_NAME "ALTPLL" +set_global_assignment -name IP_TOOL_VERSION "13.1" +set_global_assignment -name VERILOG_FILE [file join $::quartus(qip_path) "pll_rtc.v"] +set_global_assignment -name MISC_FILE [file join $::quartus(qip_path) "pll_rtc.ppf"] diff --git a/cores/ql/pll_rtc.v b/cores/ql/pll_rtc.v new file mode 100644 index 0000000..b83697a --- /dev/null +++ b/cores/ql/pll_rtc.v @@ -0,0 +1,301 @@ +// megafunction wizard: %ALTPLL% +// GENERATION: STANDARD +// VERSION: WM1.0 +// MODULE: altpll + +// ============================================================ +// File Name: pll_rtc.v +// Megafunction Name(s): +// altpll +// +// Simulation Library Files(s): +// altera_mf +// ============================================================ +// ************************************************************ +// THIS IS A WIZARD-GENERATED FILE. DO NOT EDIT THIS FILE! +// +// 13.1.4 Build 182 03/12/2014 SJ Web Edition +// ************************************************************ + + +//Copyright (C) 1991-2014 Altera Corporation +//Your use of Altera Corporation's design tools, logic functions +//and other software and tools, and its AMPP partner logic +//functions, and any output files from any of the foregoing +//(including device programming or simulation files), and any +//associated documentation or information are expressly subject +//to the terms and conditions of the Altera Program License +//Subscription Agreement, Altera MegaCore Function License +//Agreement, or other applicable license agreement, including, +//without limitation, that your use is for the sole purpose of +//programming logic devices manufactured by Altera and sold by +//Altera or its authorized distributors. Please refer to the +//applicable agreement for further details. + + +// synopsys translate_off +`timescale 1 ps / 1 ps +// synopsys translate_on +module pll_rtc ( + inclk0, + c0); + + input inclk0; + output c0; + + wire [4:0] sub_wire0; + wire [0:0] sub_wire4 = 1'h0; + wire [0:0] sub_wire1 = sub_wire0[0:0]; + wire c0 = sub_wire1; + wire sub_wire2 = inclk0; + wire [1:0] sub_wire3 = {sub_wire4, sub_wire2}; + + altpll altpll_component ( + .inclk (sub_wire3), + .clk (sub_wire0), + .activeclock (), + .areset (1'b0), + .clkbad (), + .clkena ({6{1'b1}}), + .clkloss (), + .clkswitch (1'b0), + .configupdate (1'b0), + .enable0 (), + .enable1 (), + .extclk (), + .extclkena ({4{1'b1}}), + .fbin (1'b1), + .fbmimicbidir (), + .fbout (), + .fref (), + .icdrclk (), + .locked (), + .pfdena (1'b1), + .phasecounterselect ({4{1'b1}}), + .phasedone (), + .phasestep (1'b1), + .phaseupdown (1'b1), + .pllena (1'b1), + .scanaclr (1'b0), + .scanclk (1'b0), + .scanclkena (1'b1), + .scandata (1'b0), + .scandataout (), + .scandone (), + .scanread (1'b0), + .scanwrite (1'b0), + .sclkout0 (), + .sclkout1 (), + .vcooverrange (), + .vcounderrange ()); + defparam + altpll_component.bandwidth_type = "AUTO", + altpll_component.clk0_divide_by = 328125, + altpll_component.clk0_duty_cycle = 50, + altpll_component.clk0_multiply_by = 1024, + altpll_component.clk0_phase_shift = "0", + altpll_component.compensate_clock = "CLK0", + altpll_component.inclk0_input_frequency = 47619, + altpll_component.intended_device_family = "Cyclone III", + altpll_component.lpm_hint = "CBX_MODULE_PREFIX=pll_rtc", + altpll_component.lpm_type = "altpll", + altpll_component.operation_mode = "NORMAL", + altpll_component.pll_type = "AUTO", + altpll_component.port_activeclock = "PORT_UNUSED", + altpll_component.port_areset = "PORT_UNUSED", + altpll_component.port_clkbad0 = "PORT_UNUSED", + altpll_component.port_clkbad1 = "PORT_UNUSED", + altpll_component.port_clkloss = "PORT_UNUSED", + altpll_component.port_clkswitch = "PORT_UNUSED", + altpll_component.port_configupdate = "PORT_UNUSED", + altpll_component.port_fbin = "PORT_UNUSED", + altpll_component.port_inclk0 = "PORT_USED", + altpll_component.port_inclk1 = "PORT_UNUSED", + altpll_component.port_locked = "PORT_UNUSED", + altpll_component.port_pfdena = "PORT_UNUSED", + altpll_component.port_phasecounterselect = "PORT_UNUSED", + altpll_component.port_phasedone = "PORT_UNUSED", + altpll_component.port_phasestep = "PORT_UNUSED", + altpll_component.port_phaseupdown = "PORT_UNUSED", + altpll_component.port_pllena = "PORT_UNUSED", + altpll_component.port_scanaclr = "PORT_UNUSED", + altpll_component.port_scanclk = "PORT_UNUSED", + altpll_component.port_scanclkena = "PORT_UNUSED", + altpll_component.port_scandata = "PORT_UNUSED", + altpll_component.port_scandataout = "PORT_UNUSED", + altpll_component.port_scandone = "PORT_UNUSED", + altpll_component.port_scanread = "PORT_UNUSED", + altpll_component.port_scanwrite = "PORT_UNUSED", + altpll_component.port_clk0 = "PORT_USED", + altpll_component.port_clk1 = "PORT_UNUSED", + altpll_component.port_clk2 = "PORT_UNUSED", + altpll_component.port_clk3 = "PORT_UNUSED", + altpll_component.port_clk4 = "PORT_UNUSED", + altpll_component.port_clk5 = "PORT_UNUSED", + altpll_component.port_clkena0 = "PORT_UNUSED", + altpll_component.port_clkena1 = "PORT_UNUSED", + altpll_component.port_clkena2 = "PORT_UNUSED", + altpll_component.port_clkena3 = "PORT_UNUSED", + altpll_component.port_clkena4 = "PORT_UNUSED", + altpll_component.port_clkena5 = "PORT_UNUSED", + altpll_component.port_extclk0 = "PORT_UNUSED", + altpll_component.port_extclk1 = "PORT_UNUSED", + altpll_component.port_extclk2 = "PORT_UNUSED", + altpll_component.port_extclk3 = "PORT_UNUSED", + altpll_component.width_clock = 5; + + +endmodule + +// ============================================================ +// CNX file retrieval info +// ============================================================ +// Retrieval info: PRIVATE: ACTIVECLK_CHECK STRING "0" +// Retrieval info: PRIVATE: BANDWIDTH STRING "1.000" +// Retrieval info: PRIVATE: BANDWIDTH_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: BANDWIDTH_FREQ_UNIT STRING "MHz" +// Retrieval info: PRIVATE: BANDWIDTH_PRESET STRING "Low" +// Retrieval info: PRIVATE: BANDWIDTH_USE_AUTO STRING "1" +// Retrieval info: PRIVATE: BANDWIDTH_USE_PRESET STRING "0" +// Retrieval info: PRIVATE: CLKBAD_SWITCHOVER_CHECK STRING "0" +// Retrieval info: PRIVATE: CLKLOSS_CHECK STRING "0" +// Retrieval info: PRIVATE: CLKSWITCH_CHECK STRING "0" +// Retrieval info: PRIVATE: CNX_NO_COMPENSATE_RADIO STRING "0" +// Retrieval info: PRIVATE: CREATE_CLKBAD_CHECK STRING "0" +// Retrieval info: PRIVATE: CREATE_INCLK1_CHECK STRING "0" +// Retrieval info: PRIVATE: CUR_DEDICATED_CLK STRING "c0" +// Retrieval info: PRIVATE: CUR_FBIN_CLK STRING "c0" +// Retrieval info: PRIVATE: DEVICE_SPEED_GRADE STRING "8" +// Retrieval info: PRIVATE: DIV_FACTOR0 NUMERIC "1" +// Retrieval info: PRIVATE: DUTY_CYCLE0 STRING "50.00000000" +// Retrieval info: PRIVATE: EFF_OUTPUT_FREQ_VALUE0 STRING "0.065536" +// Retrieval info: PRIVATE: EXPLICIT_SWITCHOVER_COUNTER STRING "0" +// Retrieval info: PRIVATE: EXT_FEEDBACK_RADIO STRING "0" +// Retrieval info: PRIVATE: GLOCKED_COUNTER_EDIT_CHANGED STRING "1" +// Retrieval info: PRIVATE: GLOCKED_FEATURE_ENABLED STRING "0" +// Retrieval info: PRIVATE: GLOCKED_MODE_CHECK STRING "0" +// Retrieval info: PRIVATE: GLOCK_COUNTER_EDIT NUMERIC "1048575" +// Retrieval info: PRIVATE: HAS_MANUAL_SWITCHOVER STRING "1" +// Retrieval info: PRIVATE: INCLK0_FREQ_EDIT STRING "21.000" +// Retrieval info: PRIVATE: INCLK0_FREQ_UNIT_COMBO STRING "MHz" +// Retrieval info: PRIVATE: INCLK1_FREQ_EDIT STRING "100.000" +// Retrieval info: PRIVATE: INCLK1_FREQ_EDIT_CHANGED STRING "1" +// Retrieval info: PRIVATE: INCLK1_FREQ_UNIT_CHANGED STRING "1" +// Retrieval info: PRIVATE: INCLK1_FREQ_UNIT_COMBO STRING "MHz" +// Retrieval info: PRIVATE: INTENDED_DEVICE_FAMILY STRING "Cyclone III" +// Retrieval info: PRIVATE: INT_FEEDBACK__MODE_RADIO STRING "1" +// Retrieval info: PRIVATE: LOCKED_OUTPUT_CHECK STRING "0" +// Retrieval info: PRIVATE: LONG_SCAN_RADIO STRING "1" +// Retrieval info: PRIVATE: LVDS_MODE_DATA_RATE STRING "Not Available" +// Retrieval info: PRIVATE: LVDS_MODE_DATA_RATE_DIRTY NUMERIC "0" +// Retrieval info: PRIVATE: LVDS_PHASE_SHIFT_UNIT0 STRING "deg" +// Retrieval info: PRIVATE: MIG_DEVICE_SPEED_GRADE STRING "Any" +// Retrieval info: PRIVATE: MIRROR_CLK0 STRING "0" +// Retrieval info: PRIVATE: MULT_FACTOR0 NUMERIC "1" +// Retrieval info: PRIVATE: NORMAL_MODE_RADIO STRING "1" +// Retrieval info: PRIVATE: OUTPUT_FREQ0 STRING "0.06553600" +// Retrieval info: PRIVATE: OUTPUT_FREQ_MODE0 STRING "1" +// Retrieval info: PRIVATE: OUTPUT_FREQ_UNIT0 STRING "MHz" +// Retrieval info: PRIVATE: PHASE_RECONFIG_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: PHASE_RECONFIG_INPUTS_CHECK STRING "0" +// Retrieval info: PRIVATE: PHASE_SHIFT0 STRING "0.00000000" +// Retrieval info: PRIVATE: PHASE_SHIFT_STEP_ENABLED_CHECK STRING "0" +// Retrieval info: PRIVATE: PHASE_SHIFT_UNIT0 STRING "deg" +// Retrieval info: PRIVATE: PLL_ADVANCED_PARAM_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_ARESET_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_AUTOPLL_CHECK NUMERIC "1" +// Retrieval info: PRIVATE: PLL_ENHPLL_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PLL_FASTPLL_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PLL_FBMIMIC_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_LVDS_PLL_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PLL_PFDENA_CHECK STRING "0" +// Retrieval info: PRIVATE: PLL_TARGET_HARCOPY_CHECK NUMERIC "0" +// Retrieval info: PRIVATE: PRIMARY_CLK_COMBO STRING "inclk0" +// Retrieval info: PRIVATE: RECONFIG_FILE STRING "pll_rtc.mif" +// Retrieval info: PRIVATE: SACN_INPUTS_CHECK STRING "0" +// Retrieval info: PRIVATE: SCAN_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: SELF_RESET_LOCK_LOSS STRING "0" +// Retrieval info: PRIVATE: SHORT_SCAN_RADIO STRING "0" +// Retrieval info: PRIVATE: SPREAD_FEATURE_ENABLED STRING "0" +// Retrieval info: PRIVATE: SPREAD_FREQ STRING "50.000" +// Retrieval info: PRIVATE: SPREAD_FREQ_UNIT STRING "KHz" +// Retrieval info: PRIVATE: SPREAD_PERCENT STRING "0.500" +// Retrieval info: PRIVATE: SPREAD_USE STRING "0" +// Retrieval info: PRIVATE: SRC_SYNCH_COMP_RADIO STRING "0" +// Retrieval info: PRIVATE: STICKY_CLK0 STRING "1" +// Retrieval info: PRIVATE: SWITCHOVER_COUNT_EDIT NUMERIC "1" +// Retrieval info: PRIVATE: SWITCHOVER_FEATURE_ENABLED STRING "1" +// Retrieval info: PRIVATE: SYNTH_WRAPPER_GEN_POSTFIX STRING "0" +// Retrieval info: PRIVATE: USE_CLK0 STRING "1" +// Retrieval info: PRIVATE: USE_CLKENA0 STRING "0" +// Retrieval info: PRIVATE: USE_MIL_SPEED_GRADE NUMERIC "0" +// Retrieval info: PRIVATE: ZERO_DELAY_RADIO STRING "0" +// Retrieval info: LIBRARY: altera_mf altera_mf.altera_mf_components.all +// Retrieval info: CONSTANT: BANDWIDTH_TYPE STRING "AUTO" +// Retrieval info: CONSTANT: CLK0_DIVIDE_BY NUMERIC "328125" +// Retrieval info: CONSTANT: CLK0_DUTY_CYCLE NUMERIC "50" +// Retrieval info: CONSTANT: CLK0_MULTIPLY_BY NUMERIC "1024" +// Retrieval info: CONSTANT: CLK0_PHASE_SHIFT STRING "0" +// Retrieval info: CONSTANT: COMPENSATE_CLOCK STRING "CLK0" +// Retrieval info: CONSTANT: INCLK0_INPUT_FREQUENCY NUMERIC "47619" +// Retrieval info: CONSTANT: INTENDED_DEVICE_FAMILY STRING "Cyclone III" +// Retrieval info: CONSTANT: LPM_TYPE STRING "altpll" +// Retrieval info: CONSTANT: OPERATION_MODE STRING "NORMAL" +// Retrieval info: CONSTANT: PLL_TYPE STRING "AUTO" +// Retrieval info: CONSTANT: PORT_ACTIVECLOCK STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_ARESET STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKBAD0 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKBAD1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKLOSS STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CLKSWITCH STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_CONFIGUPDATE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_FBIN STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_INCLK0 STRING "PORT_USED" +// Retrieval info: CONSTANT: PORT_INCLK1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_LOCKED STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PFDENA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASECOUNTERSELECT STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASEDONE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASESTEP STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PHASEUPDOWN STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_PLLENA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANACLR STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANCLK STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANCLKENA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANDATA STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANDATAOUT STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANDONE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANREAD STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_SCANWRITE STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk0 STRING "PORT_USED" +// Retrieval info: CONSTANT: PORT_clk1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk2 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk3 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk4 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clk5 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena0 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena2 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena3 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena4 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_clkena5 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk0 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk1 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk2 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: PORT_extclk3 STRING "PORT_UNUSED" +// Retrieval info: CONSTANT: WIDTH_CLOCK NUMERIC "5" +// Retrieval info: USED_PORT: @clk 0 0 5 0 OUTPUT_CLK_EXT VCC "@clk[4..0]" +// Retrieval info: USED_PORT: c0 0 0 0 0 OUTPUT_CLK_EXT VCC "c0" +// Retrieval info: USED_PORT: inclk0 0 0 0 0 INPUT_CLK_EXT GND "inclk0" +// Retrieval info: CONNECT: @inclk 0 0 1 1 GND 0 0 0 0 +// Retrieval info: CONNECT: @inclk 0 0 1 0 inclk0 0 0 0 0 +// Retrieval info: CONNECT: c0 0 0 0 0 @clk 0 0 1 0 +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc.v TRUE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc.ppf TRUE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc.inc FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc.cmp FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc.bsf FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc_inst.v FALSE +// Retrieval info: GEN_FILE: TYPE_NORMAL pll_rtc_bb.v FALSE +// Retrieval info: LIB_FILE: altera_mf +// Retrieval info: CBX_MODULE_PREFIX: ON diff --git a/cores/ql/ps2_intf.vhd b/cores/ql/ps2_intf.vhd new file mode 100755 index 0000000..ef1becc --- /dev/null +++ b/cores/ql/ps2_intf.vhd @@ -0,0 +1,158 @@ +-- ZX Spectrum for Altera DE1 +-- +-- Copyright (c) 2009-2011 Mike Stirling +-- +-- All rights reserved +-- +-- Redistribution and use in source and synthezised forms, with or without +-- modification, are permitted provided that the following conditions are met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in synthesized form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name of the author nor the names of other contributors may +-- be used to endorse or promote products derived from this software without +-- specific prior written agreement from the author. +-- +-- * License is granted for non-commercial use only. A fee may not be charged +-- for redistributions as source code or in synthesized/hardware form without +-- specific prior written agreement from the author. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, +-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE +-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. +-- + +-- PS/2 interface (input only) +-- Based loosely on ps2_ctrl.vhd (c) ALSE. http://www.alse-fr.com +library IEEE; +use IEEE.STD_LOGIC_1164.ALL; +use IEEE.STD_LOGIC_ARITH.ALL; +use IEEE.STD_LOGIC_UNSIGNED.ALL; + +-- This is input-only for the time being +entity ps2_intf is +generic (filter_length : positive := 8); +port( + CLK : in std_logic; + nRESET : in std_logic; + + -- PS/2 interface (could be bi-dir) + PS2_CLK : in std_logic; + PS2_DATA : in std_logic; + + -- Byte-wide data interface - only valid for one clock + -- so must be latched externally if required + DATA : out std_logic_vector(7 downto 0); + VALID : out std_logic; + ERROR : out std_logic + ); +end ps2_intf; + +architecture ps2_intf_arch of ps2_intf is +subtype filter_t is std_logic_vector(filter_length-1 downto 0); +signal clk_filter : filter_t; + +signal ps2_clk_in : std_logic; +signal ps2_dat_in : std_logic; +-- Goes high when a clock falling edge is detected +signal clk_edge : std_logic; +signal bit_count : unsigned (3 downto 0); +signal shiftreg : std_logic_vector(8 downto 0); +signal parity : std_logic; +begin + -- Register input signals + process(nRESET,CLK) + begin + if nRESET = '0' then + ps2_clk_in <= '1'; + ps2_dat_in <= '1'; + clk_filter <= (others => '1'); + clk_edge <= '0'; + elsif rising_edge(CLK) then + -- Register inputs (and filter clock) + ps2_dat_in <= PS2_DATA; + clk_filter <= PS2_CLK & clk_filter(clk_filter'high downto 1); + clk_edge <= '0'; + + if clk_filter = filter_t'(others => '1') then + -- Filtered clock is high + ps2_clk_in <= '1'; + elsif clk_filter = filter_t'(others => '0') then + -- Filter clock is low, check for edge + if ps2_clk_in = '1' then + clk_edge <= '1'; + end if; + ps2_clk_in <= '0'; + end if; + end if; + end process; + + -- Shift in keyboard data + process(nRESET,CLK) + begin + if nRESET = '0' then + bit_count <= (others => '0'); + shiftreg <= (others => '0'); + parity <= '0'; + DATA <= (others => '0'); + VALID <= '0'; + ERROR <= '0'; + elsif rising_edge(CLK) then + -- Clear flags + VALID <= '0'; + ERROR <= '0'; + + if clk_edge = '1' then + -- We have a new bit from the keyboard for processing + if bit_count = 0 then + -- Idle state, check for start bit (0) only and don't + -- start counting bits until we get it + + parity <= '0'; + + if ps2_dat_in = '0' then + -- This is a start bit + bit_count <= bit_count + 1; + end if; + else + -- Running. 8-bit data comes in LSb first followed by + -- a single stop bit (1) + if bit_count < 10 then + -- Shift in data and parity (9 bits) + bit_count <= bit_count + 1; + shiftreg <= ps2_dat_in & shiftreg(shiftreg'high downto 1); + parity <= parity xor ps2_dat_in; -- Calculate parity + elsif ps2_dat_in = '1' then + -- Valid stop bit received + bit_count <= (others => '0'); -- back to idle + if parity = '1' then + -- Parity correct, submit data to host + DATA <= shiftreg(7 downto 0); + VALID <= '1'; + else + -- Error + ERROR <= '1'; + end if; + else + -- Invalid stop bit + bit_count <= (others => '0'); -- back to idle + ERROR <= '1'; + end if; + end if; + end if; + end if; + end process; +end ps2_intf_arch; diff --git a/cores/ql/ql.qpf b/cores/ql/ql.qpf new file mode 100644 index 0000000..8ebdcc5 --- /dev/null +++ b/cores/ql/ql.qpf @@ -0,0 +1,30 @@ +# -------------------------------------------------------------------------- # +# +# Copyright (C) 1991-2010 Altera Corporation +# Your use of Altera Corporation's design tools, logic functions +# and other software and tools, and its AMPP partner logic +# functions, and any output files from any of the foregoing +# (including device programming or simulation files), and any +# associated documentation or information are expressly subject +# to the terms and conditions of the Altera Program License +# Subscription Agreement, Altera MegaCore Function License +# Agreement, or other applicable license agreement, including, +# without limitation, that your use is for the sole purpose of +# programming logic devices manufactured by Altera and sold by +# Altera or its authorized distributors. Please refer to the +# applicable agreement for further details. +# +# -------------------------------------------------------------------------- # +# +# Quartus II +# Version 10.1 Build 153 11/29/2010 SJ Full Version +# Date created = 11:11:11 June 13, 2011 +# +# -------------------------------------------------------------------------- # + +QUARTUS_VERSION = "10.1" +DATE = "11:11:11 June 13, 2011" + +# Revisions + +PROJECT_REVISION = "ql" diff --git a/cores/ql/ql.qsf b/cores/ql/ql.qsf new file mode 100644 index 0000000..9465a34 --- /dev/null +++ b/cores/ql/ql.qsf @@ -0,0 +1,395 @@ +# -------------------------------------------------------------------------- # +# +# Copyright (C) 1991-2011 Altera Corporation +# Your use of Altera Corporation's design tools, logic functions +# and other software and tools, and its AMPP partner logic +# functions, and any output files from any of the foregoing +# (including device programming or simulation files), and any +# associated documentation or information are expressly subject +# to the terms and conditions of the Altera Program License +# Subscription Agreement, Altera MegaCore Function License +# Agreement, or other applicable license agreement, including, +# without limitation, that your use is for the sole purpose of +# programming logic devices manufactured by Altera and sold by +# Altera or its authorized distributors. Please refer to the +# applicable agreement for further details. +# +# -------------------------------------------------------------------------- # +# +# Quartus II +# Version 11.0 Build 157 04/27/2011 SJ Full Version +# Date created = 17:14:01 April 10, 2012 +# +# -------------------------------------------------------------------------- # +# +# Notes: +# +# 1) The default values for assignments are stored in the file: +# led_assignment_defaults.qdf +# If this file doesn't exist, see file: +# assignment_defaults.qdf +# +# 2) Altera recommends that you do not modify this file. This +# file is updated automatically by the Quartus II software +# and any changes you make may be lost or overwritten. +# +# -------------------------------------------------------------------------- # + + +set_global_assignment -name FAMILY "Cyclone III" +set_global_assignment -name DEVICE EP3C25E144C8 +set_global_assignment -name TOP_LEVEL_ENTITY ql +set_global_assignment -name ORIGINAL_QUARTUS_VERSION 11.0 +set_global_assignment -name PROJECT_CREATION_TIME_DATE "17:14:01 APRIL 10, 2012" +set_global_assignment -name LAST_QUARTUS_VERSION 13.1 +set_global_assignment -name MIN_CORE_JUNCTION_TEMP 0 +set_global_assignment -name MAX_CORE_JUNCTION_TEMP 85 +set_global_assignment -name DEVICE_FILTER_PACKAGE "ANY QFP" +set_global_assignment -name DEVICE_FILTER_SPEED_GRADE 8 +set_global_assignment -name ERROR_CHECK_FREQUENCY_DIVISOR 1 +set_global_assignment -name PARTITION_NETLIST_TYPE SOURCE -section_id Top +set_global_assignment -name PARTITION_FITTER_PRESERVATION_LEVEL PLACEMENT_AND_ROUTING -section_id Top +set_global_assignment -name PARTITION_COLOR 16764057 -section_id Top +set_global_assignment -name USE_CONFIGURATION_DEVICE OFF +set_global_assignment -name CRC_ERROR_OPEN_DRAIN OFF +set_global_assignment -name RESERVE_ALL_UNUSED_PINS_WEAK_PULLUP "AS INPUT TRI-STATED" +set_global_assignment -name OUTPUT_IO_TIMING_NEAR_END_VMEAS "HALF VCCIO" -rise +set_global_assignment -name OUTPUT_IO_TIMING_NEAR_END_VMEAS "HALF VCCIO" -fall +set_global_assignment -name OUTPUT_IO_TIMING_FAR_END_VMEAS "HALF SIGNAL SWING" -rise +set_global_assignment -name OUTPUT_IO_TIMING_FAR_END_VMEAS "HALF SIGNAL SWING" -fall +set_global_assignment -name CYCLONEIII_CONFIGURATION_SCHEME "PASSIVE SERIAL" +set_global_assignment -name GENERATE_RBF_FILE ON +set_global_assignment -name FORCE_CONFIGURATION_VCCIO ON +set_global_assignment -name STRATIX_DEVICE_IO_STANDARD "3.3-V LVTTL" + +set_location_assignment PIN_7 -to LED +set_location_assignment PIN_22 -to CLOCK_50[0] +set_location_assignment PIN_23 -to CLOCK_50[1] +set_location_assignment PIN_128 -to CLOCK_32[0] +set_location_assignment PIN_129 -to CLOCK_32[1] +set_location_assignment PIN_54 -to CLOCK_27[0] +set_location_assignment PIN_55 -to CLOCK_27[1] +set_location_assignment PIN_144 -to VGA_R[5] +set_location_assignment PIN_143 -to VGA_R[4] +set_location_assignment PIN_142 -to VGA_R[3] +set_location_assignment PIN_141 -to VGA_R[2] +set_location_assignment PIN_137 -to VGA_R[1] +set_location_assignment PIN_135 -to VGA_R[0] +set_location_assignment PIN_133 -to VGA_B[5] +set_location_assignment PIN_132 -to VGA_B[4] +set_location_assignment PIN_125 -to VGA_B[3] +set_location_assignment PIN_121 -to VGA_B[2] +set_location_assignment PIN_120 -to VGA_B[1] +set_location_assignment PIN_115 -to VGA_B[0] +set_location_assignment PIN_114 -to VGA_G[5] +set_location_assignment PIN_113 -to VGA_G[4] +set_location_assignment PIN_112 -to VGA_G[3] +set_location_assignment PIN_111 -to VGA_G[2] +set_location_assignment PIN_110 -to VGA_G[1] +set_location_assignment PIN_106 -to VGA_G[0] +set_location_assignment PIN_136 -to VGA_VS +set_location_assignment PIN_119 -to VGA_HS +set_location_assignment PIN_65 -to AUDIO_L +set_location_assignment PIN_80 -to AUDIO_R +set_location_assignment PIN_46 -to UART_TX +set_location_assignment PIN_31 -to UART_RX +set_location_assignment PIN_105 -to SPI_DO +set_location_assignment PIN_88 -to SPI_DI +set_location_assignment PIN_126 -to SPI_SCK +set_location_assignment PIN_127 -to SPI_SS2 +set_location_assignment PIN_91 -to SPI_SS3 +set_location_assignment PIN_90 -to SPI_SS4 +set_location_assignment PIN_13 -to CONF_DATA0 + +set_location_assignment PIN_49 -to SDRAM_A[0] +set_location_assignment PIN_44 -to SDRAM_A[1] +set_location_assignment PIN_42 -to SDRAM_A[2] +set_location_assignment PIN_39 -to SDRAM_A[3] +set_location_assignment PIN_4 -to SDRAM_A[4] +set_location_assignment PIN_6 -to SDRAM_A[5] +set_location_assignment PIN_8 -to SDRAM_A[6] +set_location_assignment PIN_10 -to SDRAM_A[7] +set_location_assignment PIN_11 -to SDRAM_A[8] +set_location_assignment PIN_28 -to SDRAM_A[9] +set_location_assignment PIN_50 -to SDRAM_A[10] +set_location_assignment PIN_30 -to SDRAM_A[11] +set_location_assignment PIN_32 -to SDRAM_A[12] +set_location_assignment PIN_83 -to SDRAM_DQ[0] +set_location_assignment PIN_79 -to SDRAM_DQ[1] +set_location_assignment PIN_77 -to SDRAM_DQ[2] +set_location_assignment PIN_76 -to SDRAM_DQ[3] +set_location_assignment PIN_72 -to SDRAM_DQ[4] +set_location_assignment PIN_71 -to SDRAM_DQ[5] +set_location_assignment PIN_69 -to SDRAM_DQ[6] +set_location_assignment PIN_68 -to SDRAM_DQ[7] +set_location_assignment PIN_86 -to SDRAM_DQ[8] +set_location_assignment PIN_87 -to SDRAM_DQ[9] +set_location_assignment PIN_98 -to SDRAM_DQ[10] +set_location_assignment PIN_99 -to SDRAM_DQ[11] +set_location_assignment PIN_100 -to SDRAM_DQ[12] +set_location_assignment PIN_101 -to SDRAM_DQ[13] +set_location_assignment PIN_103 -to SDRAM_DQ[14] +set_location_assignment PIN_104 -to SDRAM_DQ[15] +set_location_assignment PIN_58 -to SDRAM_BA[0] +set_location_assignment PIN_51 -to SDRAM_BA[1] +set_location_assignment PIN_85 -to SDRAM_DQMH +set_location_assignment PIN_67 -to SDRAM_DQML +set_location_assignment PIN_60 -to SDRAM_nRAS +set_location_assignment PIN_64 -to SDRAM_nCAS +set_location_assignment PIN_66 -to SDRAM_nWE +set_location_assignment PIN_59 -to SDRAM_nCS +set_location_assignment PIN_33 -to SDRAM_CKE +set_location_assignment PIN_43 -to SDRAM_CLK + + +set_global_assignment -name ENABLE_SIGNALTAP ON +set_global_assignment -name USE_SIGNALTAP_FILE stp1.stp +set_global_assignment -name CYCLONEII_RESERVE_NCEO_AFTER_CONFIGURATION "USE AS REGULAR IO" +set_global_assignment -name RESERVE_DATA0_AFTER_CONFIGURATION "USE AS REGULAR IO" +set_global_assignment -name RESERVE_DATA1_AFTER_CONFIGURATION "USE AS REGULAR IO" +set_global_assignment -name RESERVE_FLASH_NCE_AFTER_CONFIGURATION "USE AS REGULAR IO" +set_global_assignment -name RESERVE_DCLK_AFTER_CONFIGURATION "USE AS REGULAR IO" +set_global_assignment -name OPTIMIZE_HOLD_TIMING "ALL PATHS" +set_global_assignment -name OPTIMIZE_MULTI_CORNER_TIMING ON +set_global_assignment -name FITTER_EFFORT "FAST FIT" +set_global_assignment -name POWER_PRESET_COOLING_SOLUTION "23 MM HEAT SINK WITH 200 LFPM AIRFLOW" +set_global_assignment -name POWER_BOARD_THERMAL_MODEL "NONE (CONSERVATIVE)" +set_instance_assignment -name CURRENT_STRENGTH_NEW "MAXIMUM CURRENT" -to VGA_* +set_global_assignment -name SLD_NODE_CREATOR_ID 110 -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_ENTITY_NAME sld_signaltap -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_RAM_BLOCK_TYPE=AUTO" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_NODE_INFO=805334528" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_POWER_UP_TRIGGER=0" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_STORAGE_QUALIFIER_INVERSION_MASK_LENGTH=0" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_ATTRIBUTE_MEM_MODE=OFF" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_STATE_FLOW_USE_GENERATED=0" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_STATE_BITS=11" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_BUFFER_FULL_STOP=1" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_CURRENT_RESOURCE_WIDTH=1" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_TRIGGER_LEVEL=1" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_TRIGGER_IN_ENABLED=0" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_ADVANCED_TRIGGER_ENTITY=basic,1," -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_TRIGGER_LEVEL_PIPELINE=1" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_ENABLE_ADVANCED_TRIGGER=0" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_SEGMENT_SIZE=256" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_SAMPLE_DEPTH=256" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[0] -to "TG68KdotC_Kernel:tg68k|IPL[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[1] -to "TG68KdotC_Kernel:tg68k|IPL[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[2] -to "TG68KdotC_Kernel:tg68k|IPL[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[3] -to "TG68KdotC_Kernel:tg68k|Reset" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[4] -to "TG68KdotC_Kernel:tg68k|addr[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[5] -to "TG68KdotC_Kernel:tg68k|addr[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[6] -to "TG68KdotC_Kernel:tg68k|addr[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[7] -to "TG68KdotC_Kernel:tg68k|addr[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[8] -to "TG68KdotC_Kernel:tg68k|addr[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[9] -to "TG68KdotC_Kernel:tg68k|addr[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[10] -to "TG68KdotC_Kernel:tg68k|addr[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[11] -to "TG68KdotC_Kernel:tg68k|addr[16]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[12] -to "TG68KdotC_Kernel:tg68k|addr[17]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[13] -to "TG68KdotC_Kernel:tg68k|addr[18]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[14] -to "TG68KdotC_Kernel:tg68k|addr[19]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[15] -to "TG68KdotC_Kernel:tg68k|addr[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[16] -to "TG68KdotC_Kernel:tg68k|addr[20]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[17] -to "TG68KdotC_Kernel:tg68k|addr[21]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[18] -to "TG68KdotC_Kernel:tg68k|addr[22]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[19] -to "TG68KdotC_Kernel:tg68k|addr[23]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[20] -to "TG68KdotC_Kernel:tg68k|addr[24]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[21] -to "TG68KdotC_Kernel:tg68k|addr[25]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[22] -to "TG68KdotC_Kernel:tg68k|addr[26]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[23] -to "TG68KdotC_Kernel:tg68k|addr[27]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[24] -to "TG68KdotC_Kernel:tg68k|addr[28]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[25] -to "TG68KdotC_Kernel:tg68k|addr[29]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[26] -to "TG68KdotC_Kernel:tg68k|addr[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[27] -to "TG68KdotC_Kernel:tg68k|addr[30]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[28] -to "TG68KdotC_Kernel:tg68k|addr[31]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[29] -to "TG68KdotC_Kernel:tg68k|addr[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[30] -to "TG68KdotC_Kernel:tg68k|addr[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[31] -to "TG68KdotC_Kernel:tg68k|addr[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[32] -to "TG68KdotC_Kernel:tg68k|addr[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[33] -to "TG68KdotC_Kernel:tg68k|addr[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[34] -to "TG68KdotC_Kernel:tg68k|addr[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[35] -to "TG68KdotC_Kernel:tg68k|addr[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[36] -to "TG68KdotC_Kernel:tg68k|busstate[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[37] -to "TG68KdotC_Kernel:tg68k|busstate[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[38] -to "TG68KdotC_Kernel:tg68k|clk" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[39] -to "TG68KdotC_Kernel:tg68k|clkena_in" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[40] -to "TG68KdotC_Kernel:tg68k|data_in[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[41] -to "TG68KdotC_Kernel:tg68k|data_in[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[42] -to "TG68KdotC_Kernel:tg68k|data_in[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[43] -to "TG68KdotC_Kernel:tg68k|data_in[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[44] -to "TG68KdotC_Kernel:tg68k|data_in[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[45] -to "TG68KdotC_Kernel:tg68k|data_in[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[46] -to "TG68KdotC_Kernel:tg68k|data_in[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[47] -to "TG68KdotC_Kernel:tg68k|data_in[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[48] -to "TG68KdotC_Kernel:tg68k|data_in[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[49] -to "TG68KdotC_Kernel:tg68k|data_in[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[50] -to "TG68KdotC_Kernel:tg68k|data_in[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[51] -to "TG68KdotC_Kernel:tg68k|data_in[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[52] -to "TG68KdotC_Kernel:tg68k|data_in[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[53] -to "TG68KdotC_Kernel:tg68k|data_in[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[54] -to "TG68KdotC_Kernel:tg68k|data_in[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[55] -to "TG68KdotC_Kernel:tg68k|data_in[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[56] -to "TG68KdotC_Kernel:tg68k|data_write[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[57] -to "TG68KdotC_Kernel:tg68k|data_write[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[58] -to "TG68KdotC_Kernel:tg68k|data_write[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[59] -to "TG68KdotC_Kernel:tg68k|data_write[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[60] -to "TG68KdotC_Kernel:tg68k|data_write[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[61] -to "TG68KdotC_Kernel:tg68k|data_write[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[62] -to "TG68KdotC_Kernel:tg68k|data_write[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[63] -to "TG68KdotC_Kernel:tg68k|data_write[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[64] -to "TG68KdotC_Kernel:tg68k|data_write[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[65] -to "TG68KdotC_Kernel:tg68k|data_write[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[66] -to "TG68KdotC_Kernel:tg68k|data_write[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[67] -to "TG68KdotC_Kernel:tg68k|data_write[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[68] -to "TG68KdotC_Kernel:tg68k|data_write[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[69] -to "TG68KdotC_Kernel:tg68k|data_write[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[70] -to "TG68KdotC_Kernel:tg68k|data_write[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[71] -to "TG68KdotC_Kernel:tg68k|data_write[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[72] -to "TG68KdotC_Kernel:tg68k|exe_opcode[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[73] -to "TG68KdotC_Kernel:tg68k|exe_opcode[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[74] -to "TG68KdotC_Kernel:tg68k|exe_opcode[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[75] -to "TG68KdotC_Kernel:tg68k|exe_opcode[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[76] -to "TG68KdotC_Kernel:tg68k|exe_opcode[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[77] -to "TG68KdotC_Kernel:tg68k|exe_opcode[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[78] -to "TG68KdotC_Kernel:tg68k|exe_opcode[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[79] -to "TG68KdotC_Kernel:tg68k|exe_opcode[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[80] -to "TG68KdotC_Kernel:tg68k|exe_opcode[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[81] -to "TG68KdotC_Kernel:tg68k|exe_opcode[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[82] -to "TG68KdotC_Kernel:tg68k|exe_opcode[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[83] -to "TG68KdotC_Kernel:tg68k|exe_opcode[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[84] -to "TG68KdotC_Kernel:tg68k|exe_opcode[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[85] -to "TG68KdotC_Kernel:tg68k|exe_opcode[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[86] -to "TG68KdotC_Kernel:tg68k|exe_opcode[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[87] -to "TG68KdotC_Kernel:tg68k|exe_opcode[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[88] -to "TG68KdotC_Kernel:tg68k|nLDS" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[89] -to "TG68KdotC_Kernel:tg68k|nReset" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[90] -to "TG68KdotC_Kernel:tg68k|nUDS" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[91] -to "TG68KdotC_Kernel:tg68k|nWr" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[0] -to "TG68KdotC_Kernel:tg68k|IPL[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[1] -to "TG68KdotC_Kernel:tg68k|IPL[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[2] -to "TG68KdotC_Kernel:tg68k|IPL[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[3] -to "TG68KdotC_Kernel:tg68k|Reset" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[4] -to "TG68KdotC_Kernel:tg68k|addr[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[5] -to "TG68KdotC_Kernel:tg68k|addr[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[6] -to "TG68KdotC_Kernel:tg68k|addr[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[7] -to "TG68KdotC_Kernel:tg68k|addr[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[8] -to "TG68KdotC_Kernel:tg68k|addr[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[9] -to "TG68KdotC_Kernel:tg68k|addr[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[10] -to "TG68KdotC_Kernel:tg68k|addr[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[11] -to "TG68KdotC_Kernel:tg68k|addr[16]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[12] -to "TG68KdotC_Kernel:tg68k|addr[17]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[13] -to "TG68KdotC_Kernel:tg68k|addr[18]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[14] -to "TG68KdotC_Kernel:tg68k|addr[19]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[15] -to "TG68KdotC_Kernel:tg68k|addr[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[16] -to "TG68KdotC_Kernel:tg68k|addr[20]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[17] -to "TG68KdotC_Kernel:tg68k|addr[21]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[18] -to "TG68KdotC_Kernel:tg68k|addr[22]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[19] -to "TG68KdotC_Kernel:tg68k|addr[23]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[20] -to "TG68KdotC_Kernel:tg68k|addr[24]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[21] -to "TG68KdotC_Kernel:tg68k|addr[25]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[22] -to "TG68KdotC_Kernel:tg68k|addr[26]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[23] -to "TG68KdotC_Kernel:tg68k|addr[27]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[24] -to "TG68KdotC_Kernel:tg68k|addr[28]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[25] -to "TG68KdotC_Kernel:tg68k|addr[29]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[26] -to "TG68KdotC_Kernel:tg68k|addr[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[27] -to "TG68KdotC_Kernel:tg68k|addr[30]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[28] -to "TG68KdotC_Kernel:tg68k|addr[31]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[29] -to "TG68KdotC_Kernel:tg68k|addr[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[30] -to "TG68KdotC_Kernel:tg68k|addr[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[31] -to "TG68KdotC_Kernel:tg68k|addr[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[32] -to "TG68KdotC_Kernel:tg68k|addr[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[33] -to "TG68KdotC_Kernel:tg68k|addr[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[34] -to "TG68KdotC_Kernel:tg68k|addr[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[35] -to "TG68KdotC_Kernel:tg68k|addr[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[36] -to "TG68KdotC_Kernel:tg68k|busstate[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[37] -to "TG68KdotC_Kernel:tg68k|busstate[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[38] -to "TG68KdotC_Kernel:tg68k|clk" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[39] -to "TG68KdotC_Kernel:tg68k|clkena_in" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[40] -to "TG68KdotC_Kernel:tg68k|data_in[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[41] -to "TG68KdotC_Kernel:tg68k|data_in[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[42] -to "TG68KdotC_Kernel:tg68k|data_in[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[43] -to "TG68KdotC_Kernel:tg68k|data_in[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[44] -to "TG68KdotC_Kernel:tg68k|data_in[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[45] -to "TG68KdotC_Kernel:tg68k|data_in[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[46] -to "TG68KdotC_Kernel:tg68k|data_in[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[47] -to "TG68KdotC_Kernel:tg68k|data_in[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[48] -to "TG68KdotC_Kernel:tg68k|data_in[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[49] -to "TG68KdotC_Kernel:tg68k|data_in[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[50] -to "TG68KdotC_Kernel:tg68k|data_in[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[51] -to "TG68KdotC_Kernel:tg68k|data_in[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[52] -to "TG68KdotC_Kernel:tg68k|data_in[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[53] -to "TG68KdotC_Kernel:tg68k|data_in[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[54] -to "TG68KdotC_Kernel:tg68k|data_in[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[55] -to "TG68KdotC_Kernel:tg68k|data_in[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[56] -to "TG68KdotC_Kernel:tg68k|data_write[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[57] -to "TG68KdotC_Kernel:tg68k|data_write[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[58] -to "TG68KdotC_Kernel:tg68k|data_write[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[59] -to "TG68KdotC_Kernel:tg68k|data_write[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[60] -to "TG68KdotC_Kernel:tg68k|data_write[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[61] -to "TG68KdotC_Kernel:tg68k|data_write[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[62] -to "TG68KdotC_Kernel:tg68k|data_write[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[63] -to "TG68KdotC_Kernel:tg68k|data_write[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[64] -to "TG68KdotC_Kernel:tg68k|data_write[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[65] -to "TG68KdotC_Kernel:tg68k|data_write[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[66] -to "TG68KdotC_Kernel:tg68k|data_write[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[67] -to "TG68KdotC_Kernel:tg68k|data_write[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[68] -to "TG68KdotC_Kernel:tg68k|data_write[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[69] -to "TG68KdotC_Kernel:tg68k|data_write[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[70] -to "TG68KdotC_Kernel:tg68k|data_write[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[71] -to "TG68KdotC_Kernel:tg68k|data_write[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[72] -to "TG68KdotC_Kernel:tg68k|exe_opcode[0]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[73] -to "TG68KdotC_Kernel:tg68k|exe_opcode[10]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[74] -to "TG68KdotC_Kernel:tg68k|exe_opcode[11]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[75] -to "TG68KdotC_Kernel:tg68k|exe_opcode[12]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[76] -to "TG68KdotC_Kernel:tg68k|exe_opcode[13]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[77] -to "TG68KdotC_Kernel:tg68k|exe_opcode[14]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[78] -to "TG68KdotC_Kernel:tg68k|exe_opcode[15]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[79] -to "TG68KdotC_Kernel:tg68k|exe_opcode[1]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[80] -to "TG68KdotC_Kernel:tg68k|exe_opcode[2]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[81] -to "TG68KdotC_Kernel:tg68k|exe_opcode[3]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[82] -to "TG68KdotC_Kernel:tg68k|exe_opcode[4]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[83] -to "TG68KdotC_Kernel:tg68k|exe_opcode[5]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[84] -to "TG68KdotC_Kernel:tg68k|exe_opcode[6]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[85] -to "TG68KdotC_Kernel:tg68k|exe_opcode[7]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[86] -to "TG68KdotC_Kernel:tg68k|exe_opcode[8]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[87] -to "TG68KdotC_Kernel:tg68k|exe_opcode[9]" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[88] -to "TG68KdotC_Kernel:tg68k|nLDS" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[89] -to "TG68KdotC_Kernel:tg68k|nReset" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[90] -to "TG68KdotC_Kernel:tg68k|nUDS" -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[91] -to "TG68KdotC_Kernel:tg68k|nWr" -section_id auto_signaltap_0 +set_global_assignment -name VERILOG_FILE zx8301.v +set_global_assignment -name VHDL_FILE ps2_intf.vhd +set_global_assignment -name VERILOG_FILE keyboard.v +set_global_assignment -name VHDL_FILE TG68KdotC_Kernel.vhd +set_global_assignment -name VHDL_FILE TG68K_Pack.vhd +set_global_assignment -name VHDL_FILE TG68K_ALU.vhd +set_global_assignment -name VERILOG_FILE data_io.v +set_global_assignment -name VERILOG_FILE sdram.v +set_global_assignment -name VERILOG_FILE osd.v +set_global_assignment -name VERILOG_FILE user_io.v +set_global_assignment -name QIP_FILE pll.qip +set_global_assignment -name VERILOG_FILE ql.v +set_global_assignment -name SIGNALTAP_FILE stp1.stp +set_global_assignment -name QIP_FILE pll_rtc.qip +set_global_assignment -name VERILOG_FILE mdv.v +set_global_assignment -name VERILOG_FILE zx8302.v +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[92] -to cpu_enable -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[93] -to cpu_mem -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[94] -to cpu_rd -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[95] -to cpu_wr -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_trigger_in[96] -to video_cycle_rd -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[92] -to cpu_enable -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[93] -to cpu_mem -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[94] -to cpu_rd -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[95] -to cpu_wr -section_id auto_signaltap_0 +set_instance_assignment -name CONNECT_TO_SLD_NODE_ENTITY_PORT acq_data_in[96] -to video_cycle_rd -section_id auto_signaltap_0 +set_global_assignment -name VERILOG_FILE ipc.v +set_instance_assignment -name POST_FIT_CONNECT_TO_SLD_NODE_ENTITY_PORT acq_clk -to clk5 -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_DATA_BITS=97" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_TRIGGER_BITS=97" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_INVERSION_MASK=0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_INVERSION_MASK_LENGTH=313" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_NODE_CRC_LOWORD=20891" -section_id auto_signaltap_0 +set_global_assignment -name SLD_NODE_PARAMETER_ASSIGNMENT "SLD_NODE_CRC_HIWORD=32699" -section_id auto_signaltap_0 +set_global_assignment -name SLD_FILE db/stp1_auto_stripped.stp +set_instance_assignment -name PARTITION_HIERARCHY root_partition -to | -section_id Top \ No newline at end of file diff --git a/cores/ql/ql.v b/cores/ql/ql.v new file mode 100644 index 0000000..8294573 --- /dev/null +++ b/cores/ql/ql.v @@ -0,0 +1,413 @@ +// +// ql.v - Sinclair QL for the MiST +// +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module ql ( + input [1:0] CLOCK_27, + + // LED outputs + output LED, // LED Yellow + + // SDRAM interface + inout [15:0] SDRAM_DQ, // SDRAM Data bus 16 Bits + output [12:0] SDRAM_A, // SDRAM Address bus 13 Bits + output SDRAM_DQML, // SDRAM Low-byte Data Mask + output SDRAM_DQMH, // SDRAM High-byte Data Mask + output SDRAM_nWE, // SDRAM Write Enable + output SDRAM_nCAS, // SDRAM Column Address Strobe + output SDRAM_nRAS, // SDRAM Row Address Strobe + output SDRAM_nCS, // SDRAM Chip Select + output [1:0] SDRAM_BA, // SDRAM Bank Address + output SDRAM_CLK, // SDRAM Clock + output SDRAM_CKE, // SDRAM Clock Enable + + // SPI interface to arm io controller + output SPI_DO, + input SPI_DI, + input SPI_SCK, + input SPI_SS2, + input SPI_SS3, + input SPI_SS4, + input CONF_DATA0, + + output AUDIO_L, // sigma-delta DAC output left + output AUDIO_R, // sigma-delta DAC output right + + output VGA_HS, + output VGA_VS, + output [5:0] VGA_R, + output [5:0] VGA_G, + output [5:0] VGA_B +); + +// the configuration string is returned to the io controller to allow +// it to control the menu on the OSD +parameter CONF_STR = { + "QL;;", + "F1,MDV;", + "O2,RAM,128k,640k;", + "O3,Video mode,PAL,NTSC;", + "O4,Scanlines,Off,On;", + "T5,Reset" +}; + +parameter CONF_STR_LEN = 4+7+17+23+20+8; + +// the status register is controlled by the on screen display (OSD) +wire [7:0] status; +wire tv15khz; +wire [1:0] buttons; + +wire ps2_kbd_clk, ps2_kbd_data; + +// generate ps2_clock +wire ps2_clock = ps2_clk_div[6]; // ~20khz +reg [6:0] ps2_clk_div; +always @(posedge clk2) + ps2_clk_div <= ps2_clk_div + 7'd1; + +// include user_io module for arm controller communication +user_io #(.STRLEN(CONF_STR_LEN)) user_io ( + .conf_str ( CONF_STR ), + + .SPI_CLK ( SPI_SCK ), + .SPI_SS_IO ( CONF_DATA0 ), + .SPI_MISO ( SPI_DO ), + .SPI_MOSI ( SPI_DI ), + + .scandoubler_disable ( tv15khz ), + .buttons ( buttons ), + + // ps2 interface + .ps2_clk ( ps2_clock ), + .ps2_kbd_clk ( ps2_kbd_clk ), + .ps2_kbd_data ( ps2_kbd_data ), + + .status ( status ) +); + +// csync for tv15khz +// QLs vsync is positive, QLs hsync is negative +wire vga_csync = !(!vga_hsync ^ vga_vsync); +wire vga_hsync, vga_vsync; + +// TV SCART has csync on hsync pin and "high" on vsync pin +assign VGA_VS = tv15khz?1'b1:vga_vsync; +assign VGA_HS = tv15khz?vga_csync:vga_hsync; + +// tv15hkz has half the pixel rate +wire osd_clk = tv15khz?clk10:clk21; + +// include the on screen display +osd #(12,0,5) osd ( + .pclk ( osd_clk ), + + // spi for OSD + .sdi ( SPI_DI ), + .sck ( SPI_SCK ), + .ss ( SPI_SS3 ), + + .red_in ( video_r ), + .green_in ( video_g ), + .blue_in ( video_b ), + .hs_in ( video_hs ), + .vs_in ( video_vs ), + + .red_out ( VGA_R ), + .green_out ( VGA_G ), + .blue_out ( VGA_B ), + .hs_out ( vga_hsync ), + .vs_out ( vga_vsync ) +); + +// SDRAM control signals +assign SDRAM_CKE = 1'b1; + + +// CPU and data_io share the same bus cycle. Thus the CPU cannot run while +// (ROM) data is being downloaded which wouldn't make any sense, anyway +// during ROM download data_io writes the ram. Otherwise the CPU +wire [24:0] sys_addr = dio_download?dio_addr[24:0]:{ 6'b000000, cpu_addr[19:1]}; +wire [1:0] sys_ds = dio_download?2'b11:~cpu_ds; +wire [15:0] sys_dout = dio_download?dio_data:cpu_dout; +wire sys_wr = dio_download?dio_write:(cpu_wr && cpu_ram); +wire sys_oe = dio_download?1'b0:(cpu_rd && cpu_mem); + +// microdrive emulation and video share the video cycle time slot +wire [24:0] video_cycle_addr = mdv_read?mdv_addr:{6'd0, video_addr}; +wire video_cycle_rd = mdv_read?1'b1:video_rd; + +// video and CPU/data_io time share the sdram bus +wire [24:0] sdram_addr = video_cycle?video_cycle_addr:sys_addr; +wire sdram_wr = video_cycle?1'b0:sys_wr; +wire sdram_oe = video_cycle?video_cycle_rd:sys_oe; +wire [1:0] sdram_ds = video_cycle?2'b11:sys_ds; +wire [15:0] sdram_dout; +wire [15:0] sdram_din = sys_dout; + +sdram sdram ( + // interface to the MT48LC16M16 chip + .sd_data ( SDRAM_DQ ), + .sd_addr ( SDRAM_A ), + .sd_dqm ( {SDRAM_DQMH, SDRAM_DQML} ), + .sd_cs ( SDRAM_nCS ), + .sd_ba ( SDRAM_BA ), + .sd_we ( SDRAM_nWE ), + .sd_ras ( SDRAM_nRAS ), + .sd_cas ( SDRAM_nCAS ), + + // system interface + .clk ( clk21 ), + .clkref ( clk2 ), + .init ( !pll_locked ), + + // cpu interface + .din ( sdram_din ), + .addr ( sdram_addr ), + .we ( sdram_wr ), + .oe ( sdram_oe ), + .ds ( sdram_ds ), + .dout ( sdram_dout ) +); + + +// --------------------------------------------------------------------------------- +// ------------------------------------- data io ----------------------------------- +// --------------------------------------------------------------------------------- + +wire dio_download; +wire [4:0] dio_index; +wire [24:0] dio_addr; +wire [15:0] dio_data; +wire dio_write; + +// include ROM download helper +// this receives a byte stream from the arm io controller via spi and +// writes it into sdram +data_io data_io ( + // io controller spi interface + .sck ( SPI_SCK ), + .ss ( SPI_SS2 ), + .sdi ( SPI_DI ), + + .downloading ( dio_download ), // signal indicating an active rom download + .index ( dio_index ), + + // external ram interface + .clk ( cpu_cycle ), + .wr ( dio_write ), + .addr ( dio_addr ), + .data ( dio_data ) +); + +// --------------------------------------------------------------------------------- +// -------------------------------------- video ------------------------------------ +// --------------------------------------------------------------------------------- + +wire [5:0] video_r, video_g, video_b; +wire video_hs, video_vs; + +wire [18:0] video_addr; +wire video_rd; + +// the zx8301 has only one write-only register at $18063 +wire zx8301_cs = cpu_cycle && cpu_io && + ({cpu_addr[6:5], cpu_addr[1]} == 3'b111)&& cpu_wr && !cpu_ds[0]; + +zx8301 zx8301 ( + .reset ( reset ), + .clk_vga ( clk21 ), + .clk_video ( clk10 ), + .video_cycle ( video_cycle ), + + .ntsc ( status[3] ), + .scandoubler ( !tv15khz ), + .scanlines ( status[4] ), + + .clk_bus ( clk2 ), + .cpu_cs ( zx8301_cs ), + .cpu_data ( cpu_dout[7:0] ), + + .mdv_men ( mdv_men ), + + .addr ( video_addr ), + .din ( sdram_dout ), + .rd ( video_rd ), + + .hs ( video_hs ), + .vs ( video_vs ), + .r ( video_r ), + .g ( video_g ), + .b ( video_b ) +); + +// --------------------------------------------------------------------------------- +// -------------------------------------- reset ------------------------------------ +// --------------------------------------------------------------------------------- + +wire rom_download = dio_download && (dio_index == 0); +reg [11:0] reset_cnt; +wire reset = (reset_cnt != 0); +always @(posedge clk2) begin + if(buttons[1] || status[0] || status[5] || !pll_locked || rom_download) + reset_cnt <= 12'hfff; + else if(reset_cnt != 0) + reset_cnt <= reset_cnt - 1; +end + +// --------------------------------------------------------------------------------- +// --------------------------------------- IO -------------------------------------- +// --------------------------------------------------------------------------------- + +wire zx8302_sel = cpu_cycle && cpu_io && !cpu_addr[6]; +wire [1:0] zx8302_addr = {cpu_addr[5], cpu_addr[1]}; +wire [15:0] zx8302_dout; + +wire mdv_download = (dio_index == 1) && dio_download; +wire mdv_men; +wire mdv_read; +wire [24:0] mdv_addr; + +zx8302 zx8302 ( + .reset ( reset ), + .init ( !pll_locked ), + .clk ( clk21 ), + + .ipl ( cpu_ipl ), + .led ( LED ), + + // CPU connection + .clk_bus ( clk2 ), + .cpu_sel ( zx8302_sel ), + .cpu_wr ( cpu_wr ), + .cpu_addr ( zx8302_addr ), + .cpu_ds ( cpu_ds ), + .cpu_din ( cpu_dout ), + .cpu_dout ( zx8302_dout ), + + .ps2_kbd_clk ( ps2_kbd_clk ), + .ps2_kbd_data ( ps2_kbd_data ), + + .vs ( video_vs ), + + // microdrive sdram interface + .mdv_addr ( mdv_addr ), + .mdv_din ( sdram_dout ), + .mdv_read ( mdv_read ), + .mdv_men ( mdv_men ), + .video_cycle ( video_cycle ), + + .mdv_download ( mdv_download ), + .mdv_dl_addr ( dio_addr ) + +); + +// --------------------------------------------------------------------------------- +// -------------------------------------- CPU -------------------------------------- +// --------------------------------------------------------------------------------- + +// address decoding +wire cpu_io = ({cpu_addr[19:14], 2'b00} == 8'h18); // internal IO $18000-$1bffff +wire cpu_bram = (cpu_addr[19:17] == 3'b001); // 128k RAM at $20000 +wire cpu_xram = status[2] && ((cpu_addr[19:18] == 2'b01) || + (cpu_addr[19:18] == 2'b10)); // 512k RAM at $40000 if enabled +wire cpu_ram = cpu_bram || cpu_xram; // any RAM +wire cpu_rom = (cpu_addr[19:16] == 4'h0); // 64k ROM at $0 +wire cpu_mem = cpu_ram || cpu_rom; // any memory mapped to sdram + +wire [15:0] io_dout = cpu_addr[6]?16'h0000:zx8302_dout; + +// demultiplex the various data sources +wire [15:0] cpu_din = + cpu_mem?sdram_dout: + cpu_io?io_dout: + 16'hffff; + +wire [31:0] cpu_addr; +wire [1:0] cpu_ds; +wire [15:0] cpu_dout; +wire [2:0] cpu_ipl; +wire cpu_rw; +wire [1:0] cpu_busstate; +wire cpu_rd = (cpu_busstate == 2'b00) || (cpu_busstate == 2'b10); +wire cpu_wr = (cpu_busstate == 2'b11) && !cpu_rw; +wire cpu_idle = (cpu_busstate == 2'b01); + +reg cpu_enable; +always @(negedge clk2) + cpu_enable <= (cpu_cycle && !dio_download) || cpu_idle; + +TG68KdotC_Kernel #(0,0,0,0,0,0) tg68k ( + .clk ( clk2 ), + .nReset ( ~reset ), + .clkena_in ( cpu_enable ), + .data_in ( cpu_din ), + .IPL ( cpu_ipl ), + .IPL_autovector ( 1'b1 ), + .berr ( 1'b0 ), + .clr_berr ( 1'b0 ), + .CPU ( 2'b00 ), // 00=68000 + .addr ( cpu_addr ), + .data_write ( cpu_dout ), + .nUDS ( cpu_ds[1] ), + .nLDS ( cpu_ds[0] ), + .nWr ( cpu_rw ), + .busstate ( cpu_busstate ), // 00-> fetch code 10->read data 11->write data 01->no memaccess + .nResetOut ( ), + .FC ( ) +); + + + +// ------------------------------------------------------------------------- +// -------------------------- clock generation ----------------------------- +// ------------------------------------------------------------------------- + +reg clk10; // 10.5 MHz QL pixel clock +wire clk21; +always @(posedge clk21) + clk10 <= !clk10; + +reg clk5; // 5.25 MHz CPU clock +always @(posedge clk10) + clk5 <= !clk5; + +reg clk2; // 2.625 MHz bus clock +always @(posedge clk5) + clk2 <= !clk2; + +// CPU and Video share the bus +reg video_cycle; +wire cpu_cycle = !video_cycle; +always @(posedge clk2) + video_cycle <= !video_cycle; + +wire pll_locked; + +// A PLL to derive the system clock from the MiSTs 27MHz +pll pll ( + .inclk0( CLOCK_27[0] ), + .c0( clk21 ), // 21.000 MHz + .c1( SDRAM_CLK ), // 21.000 MHz phase shifted + .locked( pll_locked ) +); + + +endmodule diff --git a/cores/ql/readme.md b/cores/ql/readme.md new file mode 100644 index 0000000..c452e0b --- /dev/null +++ b/cores/ql/readme.md @@ -0,0 +1,6 @@ +QL for MIST +=========== + +This is an implementation of the Sinclair QL for the MIST board. + +It's based on the TG68K CPU core. diff --git a/cores/ql/sdram.v b/cores/ql/sdram.v new file mode 100644 index 0000000..25ef3ad --- /dev/null +++ b/cores/ql/sdram.v @@ -0,0 +1,150 @@ +// +// sdram.v +// +// sdram controller implementation for the MiST board +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module sdram ( + + // interface to the MT48LC16M16 chip + inout [15:0] sd_data, // 16 bit bidirectional data bus + output reg [12:0] sd_addr, // 13 bit multiplexed address bus + output reg [1:0] sd_dqm, // two byte masks + output reg[1:0] sd_ba, // two banks + output sd_cs, // a single chip select + output sd_we, // write enable + output sd_ras, // row address select + output sd_cas, // columns address select + + // cpu/chipset interface + input init, // init signal after FPGA config to initialize RAM + input clk, // sdram is accessed at up to 128MHz + input clkref, // reference clock to sync to + + input [15:0] din, // data input from chipset/cpu + output [15:0] dout, // data output to chipset/cpu + input [24:0] addr, // 25 bit word address + input [1:0] ds, // data strobe for hi/low byte + input oe, // cpu/chipset requests read + input we // cpu/chipset requests write +); + +// no burst configured +localparam RASCAS_DELAY = 3'd3; // tRCD>=20ns -> 2 cycles@64MHz +localparam BURST_LENGTH = 3'b000; // 000=none, 001=2, 010=4, 011=8 +localparam ACCESS_TYPE = 1'b0; // 0=sequential, 1=interleaved +localparam CAS_LATENCY = 3'd3; // 2/3 allowed +localparam OP_MODE = 2'b00; // only 00 (standard operation) allowed +localparam NO_WRITE_BURST = 1'b1; // 0= write burst enabled, 1=only single access write + +localparam MODE = { 3'b000, NO_WRITE_BURST, OP_MODE, CAS_LATENCY, ACCESS_TYPE, BURST_LENGTH}; + +// --------------------------------------------------------------------- +// ------------------------ cycle state machine ------------------------ +// --------------------------------------------------------------------- + +localparam STATE_IDLE = 3'd0; // first state in cycle +localparam STATE_CMD_START = 3'd1; // state in which a new command can be started +localparam STATE_CMD_CONT = STATE_CMD_START + RASCAS_DELAY - 3'd1; // 4 command can be continued +localparam STATE_LAST = 3'd7; // last state in cycle + +reg [2:0] q /* synthesis noprune */; +always @(posedge clk) begin + // 32Mhz counter synchronous to 4 Mhz clock + // force counter to pass state 5->6 exactly after the rising edge of clkref + // since clkref is two clocks early + if(((q == 7) && ( clkref == 0)) || + ((q == 0) && ( clkref == 1)) || + ((q != 7) && (q != 0))) + q <= q + 3'd1; +end + +// --------------------------------------------------------------------- +// --------------------------- startup/reset --------------------------- +// --------------------------------------------------------------------- + +// wait 1ms (32 clkref cycles) after FPGA config is done before going +// into normal operation. Initialize the ram in the last 16 reset cycles (cycles 15-0) +reg [4:0] reset; +always @(posedge clk) begin + if(init) reset <= 5'h1f; + else if((q == STATE_LAST) && (reset != 0)) + reset <= reset - 5'd1; +end + +// --------------------------------------------------------------------- +// ------------------ generate ram control signals --------------------- +// --------------------------------------------------------------------- + +// all possible commands +localparam CMD_INHIBIT = 4'b1111; +localparam CMD_NOP = 4'b0111; +localparam CMD_ACTIVE = 4'b0011; +localparam CMD_READ = 4'b0101; +localparam CMD_WRITE = 4'b0100; +localparam CMD_BURST_TERMINATE = 4'b0110; +localparam CMD_PRECHARGE = 4'b0010; +localparam CMD_AUTO_REFRESH = 4'b0001; +localparam CMD_LOAD_MODE = 4'b0000; + +reg [3:0] sd_cmd; // current command sent to sd ram + +// drive control signals according to current command +assign sd_cs = sd_cmd[3]; +assign sd_ras = sd_cmd[2]; +assign sd_cas = sd_cmd[1]; +assign sd_we = sd_cmd[0]; + +assign sd_data = we?din:16'bZZZZZZZZZZZZZZZZ; + +assign dout = sd_data; + +always @(posedge clk) begin + sd_cmd <= CMD_INHIBIT; + + if(reset != 0) begin + sd_ba <= 2'b00; + sd_dqm <= 2'b00; + + if(reset == 13) sd_addr <= 13'b0010000000000; + else sd_addr <= MODE; + + if(q == STATE_IDLE) begin + if(reset == 13) sd_cmd <= CMD_PRECHARGE; + if(reset == 2) sd_cmd <= CMD_LOAD_MODE; + end + end else begin + if(q <= STATE_CMD_START) begin + sd_addr <= addr[20:8]; + sd_ba <= addr[22:21]; + sd_dqm <= { !ds[1], !ds[0] }; + end else + sd_addr <= { 4'b0010, addr[23], addr[7:0]}; + + if(q == STATE_IDLE) begin + if(we || oe) sd_cmd <= CMD_ACTIVE; + else sd_cmd <= CMD_AUTO_REFRESH; + end else if(q == STATE_CMD_CONT) begin + if(we) sd_cmd <= CMD_WRITE; + else if(oe) sd_cmd <= CMD_READ; + end + end +end + +endmodule diff --git a/cores/ql/user_io.v b/cores/ql/user_io.v new file mode 100644 index 0000000..e679e00 --- /dev/null +++ b/cores/ql/user_io.v @@ -0,0 +1,418 @@ +// +// user_io.v - interface to MIST arm io controller +// +// Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +// parameter STRLEN and the actual length of conf_str have to match + +module user_io #(parameter STRLEN=0) ( + input [(8*STRLEN)-1:0] conf_str, + + input SPI_CLK, + input SPI_SS_IO, + output reg SPI_MISO, + input SPI_MOSI, + + output reg [7:0] joystick_0, + output reg [7:0] joystick_1, + output reg [15:0] joystick_analog_0, + output reg [15:0] joystick_analog_1, + output [1:0] buttons, + output [1:0] switches, + output scandoubler_disable, + + output reg [7:0] status, + + // connection to sd card emulation + input [31:0] sd_lba, + input sd_rd, + input sd_wr, + output reg sd_ack, + input sd_conf, + input sd_sdhc, + output [7:0] sd_dout, // valid on rising edge of sd_dout_strobe + output reg sd_dout_strobe, + input [7:0] sd_din, + output reg sd_din_strobe, + output reg sd_change, + + // ps2 keyboard emulation + input ps2_clk, // 12-16khz provided by core + output ps2_kbd_clk, + output reg ps2_kbd_data, + output ps2_mouse_clk, + output reg ps2_mouse_data, + + // serial com port + input [7:0] serial_data, + input serial_strobe +); + +reg [6:0] sbuf; +reg [7:0] cmd; +reg [2:0] bit_cnt; // counts bits 0-7 0-7 ... +reg [7:0] byte_cnt; // counts bytes +reg [5:0] joystick0; +reg [5:0] joystick1; +reg [7:0] but_sw; +reg [2:0] stick_idx; + +assign buttons = but_sw[1:0]; +assign switches = but_sw[3:2]; +assign scandoubler_disable = but_sw[4]; +assign sd_dout = { sbuf, SPI_MOSI}; + +// this variant of user_io is for 8 bit cores (type == a4) only +wire [7:0] core_type = 8'ha4; + +// command byte read by the io controller +wire [7:0] sd_cmd = { 4'h5, sd_conf, sd_sdhc, sd_wr, sd_rd }; + +// filter spi clock. the 8 bit gate delay is ~2.5ns in total +wire [7:0] spi_sck_D = { spi_sck_D[6:0], SPI_CLK } /* synthesis keep */; +wire spi_sck = (spi_sck && spi_sck_D != 8'h00) || (!spi_sck && spi_sck_D == 8'hff); + +// drive MISO only when transmitting core id +always@(negedge spi_sck or posedge SPI_SS_IO) begin + if(SPI_SS_IO == 1) begin + SPI_MISO <= 1'bZ; + end else begin + + // first byte returned is always core type, further bytes are + // command dependent + if(byte_cnt == 0) begin + SPI_MISO <= core_type[~bit_cnt]; + + end else begin + // reading serial fifo + if(cmd == 8'h1b) begin + // send alternating flag byte and data + if(byte_cnt[0]) SPI_MISO <= serial_out_status[~bit_cnt]; + else SPI_MISO <= serial_out_byte[~bit_cnt]; + end + + // reading config string + else if(cmd == 8'h14) begin + // returning a byte from string + if(byte_cnt < STRLEN + 1) + SPI_MISO <= conf_str[{STRLEN - byte_cnt,~bit_cnt}]; + else + SPI_MISO <= 1'b0; + end + + // reading sd card status + else if(cmd == 8'h16) begin + if(byte_cnt == 1) + SPI_MISO <= sd_cmd[~bit_cnt]; + else if((byte_cnt >= 2) && (byte_cnt < 6)) + SPI_MISO <= sd_lba[{5-byte_cnt, ~bit_cnt}]; + else + SPI_MISO <= 1'b0; + end + + // reading sd card write data + else if(cmd == 8'h18) + SPI_MISO <= sd_din[~bit_cnt]; + + else + SPI_MISO <= 1'b0; + end + end +end + +// ---------------- PS2 --------------------- + +// 8 byte fifos to store ps2 bytes +localparam PS2_FIFO_BITS = 3; + +// keyboard +reg [7:0] ps2_kbd_fifo [(2**PS2_FIFO_BITS)-1:0]; +reg [PS2_FIFO_BITS-1:0] ps2_kbd_wptr; +reg [PS2_FIFO_BITS-1:0] ps2_kbd_rptr; + +// ps2 transmitter state machine +reg [3:0] ps2_kbd_tx_state; +reg [7:0] ps2_kbd_tx_byte; +reg ps2_kbd_parity; + +assign ps2_kbd_clk = ps2_clk || (ps2_kbd_tx_state == 0); + +// ps2 transmitter +// Takes a byte from the FIFO and sends it in a ps2 compliant serial format. +reg ps2_kbd_r_inc; +always@(posedge ps2_clk) begin + ps2_kbd_r_inc <= 1'b0; + + if(ps2_kbd_r_inc) + ps2_kbd_rptr <= ps2_kbd_rptr + 1; + + // transmitter is idle? + if(ps2_kbd_tx_state == 0) begin + // data in fifo present? + if(ps2_kbd_wptr != ps2_kbd_rptr) begin + // load tx register from fifo + ps2_kbd_tx_byte <= ps2_kbd_fifo[ps2_kbd_rptr]; + ps2_kbd_r_inc <= 1'b1; + + // reset parity + ps2_kbd_parity <= 1'b1; + + // start transmitter + ps2_kbd_tx_state <= 4'd1; + + // put start bit on data line + ps2_kbd_data <= 1'b0; // start bit is 0 + end + end else begin + + // transmission of 8 data bits + if((ps2_kbd_tx_state >= 1)&&(ps2_kbd_tx_state < 9)) begin + ps2_kbd_data <= ps2_kbd_tx_byte[0]; // data bits + ps2_kbd_tx_byte[6:0] <= ps2_kbd_tx_byte[7:1]; // shift down + if(ps2_kbd_tx_byte[0]) + ps2_kbd_parity <= !ps2_kbd_parity; + end + + // transmission of parity + if(ps2_kbd_tx_state == 9) + ps2_kbd_data <= ps2_kbd_parity; + + // transmission of stop bit + if(ps2_kbd_tx_state == 10) + ps2_kbd_data <= 1'b1; // stop bit is 1 + + // advance state machine + if(ps2_kbd_tx_state < 11) + ps2_kbd_tx_state <= ps2_kbd_tx_state + 4'd1; + else + ps2_kbd_tx_state <= 4'd0; + + end +end + +// mouse +reg [7:0] ps2_mouse_fifo [(2**PS2_FIFO_BITS)-1:0]; +reg [PS2_FIFO_BITS-1:0] ps2_mouse_wptr; +reg [PS2_FIFO_BITS-1:0] ps2_mouse_rptr; + +// ps2 transmitter state machine +reg [3:0] ps2_mouse_tx_state; +reg [7:0] ps2_mouse_tx_byte; +reg ps2_mouse_parity; + +assign ps2_mouse_clk = ps2_clk || (ps2_mouse_tx_state == 0); + +// ps2 transmitter +// Takes a byte from the FIFO and sends it in a ps2 compliant serial format. +reg ps2_mouse_r_inc; +always@(posedge ps2_clk) begin + ps2_mouse_r_inc <= 1'b0; + + if(ps2_mouse_r_inc) + ps2_mouse_rptr <= ps2_mouse_rptr + 1; + + // transmitter is idle? + if(ps2_mouse_tx_state == 0) begin + // data in fifo present? + if(ps2_mouse_wptr != ps2_mouse_rptr) begin + // load tx register from fifo + ps2_mouse_tx_byte <= ps2_mouse_fifo[ps2_mouse_rptr]; + ps2_mouse_r_inc <= 1'b1; + + // reset parity + ps2_mouse_parity <= 1'b1; + + // start transmitter + ps2_mouse_tx_state <= 4'd1; + + // put start bit on data line + ps2_mouse_data <= 1'b0; // start bit is 0 + end + end else begin + + // transmission of 8 data bits + if((ps2_mouse_tx_state >= 1)&&(ps2_mouse_tx_state < 9)) begin + ps2_mouse_data <= ps2_mouse_tx_byte[0]; // data bits + ps2_mouse_tx_byte[6:0] <= ps2_mouse_tx_byte[7:1]; // shift down + if(ps2_mouse_tx_byte[0]) + ps2_mouse_parity <= !ps2_mouse_parity; + end + + // transmission of parity + if(ps2_mouse_tx_state == 9) + ps2_mouse_data <= ps2_mouse_parity; + + // transmission of stop bit + if(ps2_mouse_tx_state == 10) + ps2_mouse_data <= 1'b1; // stop bit is 1 + + // advance state machine + if(ps2_mouse_tx_state < 11) + ps2_mouse_tx_state <= ps2_mouse_tx_state + 4'd1; + else + ps2_mouse_tx_state <= 4'd0; + + end +end + +// fifo to receive serial data from core to be forwarded to io controller + +// 16 byte fifo to store serial bytes +localparam SERIAL_OUT_FIFO_BITS = 6; +reg [7:0] serial_out_fifo [(2**SERIAL_OUT_FIFO_BITS)-1:0]; +reg [SERIAL_OUT_FIFO_BITS-1:0] serial_out_wptr; +reg [SERIAL_OUT_FIFO_BITS-1:0] serial_out_rptr; + +wire serial_out_data_available = serial_out_wptr != serial_out_rptr; +wire [7:0] serial_out_byte = serial_out_fifo[serial_out_rptr] /* synthesis keep */; +wire [7:0] serial_out_status = { 7'b1000000, serial_out_data_available}; + +// status[0] is reset signal from io controller and is thus used to flush +// the fifo +always @(posedge serial_strobe or posedge status[0]) begin + if(status[0] == 1) begin + serial_out_wptr <= 0; + end else begin + serial_out_fifo[serial_out_wptr] <= serial_data; + serial_out_wptr <= serial_out_wptr + 1; + end +end + +always@(negedge spi_sck or posedge status[0]) begin + if(status[0] == 1) begin + serial_out_rptr <= 0; + end else begin + if((byte_cnt != 0) && (cmd == 8'h1b)) begin + // read last bit -> advance read pointer + if((bit_cnt == 7) && !byte_cnt[0] && serial_out_data_available) + serial_out_rptr <= serial_out_rptr + 1; + end + end +end + +// SPI receiver +always@(posedge spi_sck or posedge SPI_SS_IO) begin + + if(SPI_SS_IO == 1) begin + bit_cnt <= 3'd0; + byte_cnt <= 8'd0; + sd_ack <= 1'b0; + sd_dout_strobe <= 1'b0; + sd_din_strobe <= 1'b0; + sd_change <= 1'b0; + end else begin + sd_dout_strobe <= 1'b0; + sd_din_strobe <= 1'b0; + + if(bit_cnt != 7) + sbuf[6:0] <= { sbuf[5:0], SPI_MOSI }; + + bit_cnt <= bit_cnt + 3'd1; + if((bit_cnt == 7)&&(byte_cnt != 8'd255)) + byte_cnt <= byte_cnt + 8'd1; + + // finished reading command byte + if(bit_cnt == 7) begin + if(byte_cnt == 0) begin + cmd <= { sbuf, SPI_MOSI}; + + // fetch first byte when sectore FPGA->IO command has been seen + if({ sbuf, SPI_MOSI} == 8'h18) + sd_din_strobe <= 1'b1; + + if(({ sbuf, SPI_MOSI} == 8'h17) || ({ sbuf, SPI_MOSI} == 8'h18)) + sd_ack <= 1'b1; + + end else begin + + // buttons and switches + if(cmd == 8'h01) + but_sw <= { sbuf, SPI_MOSI }; + + if(cmd == 8'h02) + joystick_0 <= { sbuf, SPI_MOSI }; + + if(cmd == 8'h03) + joystick_1 <= { sbuf, SPI_MOSI }; + + if(cmd == 8'h04) begin + // store incoming ps2 mouse bytes + ps2_mouse_fifo[ps2_mouse_wptr] <= { sbuf, SPI_MOSI }; + ps2_mouse_wptr <= ps2_mouse_wptr + 1; + end + + if(cmd == 8'h05) begin + // store incoming ps2 keyboard bytes + ps2_kbd_fifo[ps2_kbd_wptr] <= { sbuf, SPI_MOSI }; + ps2_kbd_wptr <= ps2_kbd_wptr + 1; + end + + if(cmd == 8'h15) + status <= { sbuf[6:0], SPI_MOSI }; + + // send sector IO -> FPGA + if(cmd == 8'h17) begin + // flag that download begins + sd_dout_strobe <= 1'b1; + end + + // send sector FPGA -> IO + if(cmd == 8'h18) + sd_din_strobe <= 1'b1; + + // send SD config IO -> FPGA + if(cmd == 8'h19) begin + // flag that download begins + // sd card knows data is config if sd_dout_strobe is asserted + // with sd_ack still being inactive (low) + sd_dout_strobe <= 1'b1; + end + + // joystick analog + if(cmd == 8'h1a) begin + // first byte is joystick indes + if(byte_cnt == 1) + stick_idx <= { sbuf[1:0], SPI_MOSI }; + else if(byte_cnt == 2) begin + // second byte is x axis + if(stick_idx == 0) + joystick_analog_0[15:8] <= { sbuf, SPI_MOSI }; + else if(stick_idx == 1) + joystick_analog_1[15:8] <= { sbuf, SPI_MOSI }; + end else if(byte_cnt == 3) begin + // third byte is y axis + if(stick_idx == 0) + joystick_analog_0[7:0] <= { sbuf, SPI_MOSI }; + else if(stick_idx == 1) + joystick_analog_1[7:0] <= { sbuf, SPI_MOSI }; + end + end + + // set sd card status. The fact that this register is being + // set by the arm controller indicates a possible disk change + if(cmd == 8'h1c) + sd_change <= 1'b1; + + end + end + end +end + +endmodule diff --git a/cores/ql/zx8301.v b/cores/ql/zx8301.v new file mode 100644 index 0000000..f804121 --- /dev/null +++ b/cores/ql/zx8301.v @@ -0,0 +1,345 @@ +// +// zx8301.v +// +// ZX8301 ULA for Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module zx8301 ( + input reset, + + // clock + input clk_vga, // 21 Mhz VGA pixel clock + input clk_video, // 10.5 MHz QL pixel clock + input video_cycle, + + // config options + input ntsc, + input scandoubler, + input scanlines, + + // CPU interface to access $18063 + input clk_bus, + input cpu_cs, + input [7:0] cpu_data, + + // sdram interface + output reg [18:0] addr, + output rd, + input [15:0] din, + + // signal telling mdv emulation that it may use the video + output reg mdv_men, + + // VIDEO output + output hs, + output reg vs, + output [5:0] r, + output [5:0] g, + output [5:0] b +); + +assign rd = me; + +/* ----------------------------------------------------------------- */ +/* -------------------------- CPU register ------------------------- */ +/* ----------------------------------------------------------------- */ +// [6] -> NTSC? + +wire membase = mc_stat[7]; // 0 = $20000, 1 = $28000 +wire mode = mc_stat[3]; // 0 = 512*256*2bpp, 1=256*256*4bpp +wire blank = mc_stat[1]; // 0 = normal video, 1 = blanked video + +reg [7:0] mc_stat; + +always @(negedge clk_bus) begin + if(reset) + mc_stat <= 8'h00; + else if(cpu_cs) + mc_stat <= cpu_data; +end + +/* ----------------------------------------------------------------- */ +/* ---------------------- video timing values ---------------------- */ +/* ----------------------------------------------------------------- */ + +// PAL video parameters +parameter H = 512; // width of visible area +//parameter PAL_HFP = 112; // unused time before hsync +//parameter PAL_HSW = 96; // width of hsync +//parameter PAL_HBP = 176; // unused time after hsync +//// PAL total: 896 +//parameter NTSC_HFP = 112; // unused time before hsync +//parameter NTSC_HSW = 88; // width of hsync +//parameter NTSC_HBP = 176; // unused time after hsync +//// NTSC total: 888 +parameter PAL_HFP = 34; // unused time before hsync +parameter PAL_HSW = 72; // width of hsync +parameter PAL_HBP = 54; // unused time after hsync +// PAL total: 672 +parameter NTSC_HFP = 34; // unused time before hsync +parameter NTSC_HSW = 64; // width of hsync +parameter NTSC_HBP = 54; // unused time after hsync +// NTSC total: 664 + +parameter V = 256; // height of visible area +parameter PAL_VFP = 15; // unused time before vsync +parameter PAL_VSW = 6; // width of vsync +parameter PAL_VBP = 35; // unused time after vsync +// PAL total: 312 +parameter NTSC_VFP = 2; // unused time before vsync +parameter NTSC_VSW = 2; // width of vsync +parameter NTSC_VBP = 2; // unused time after vsync +// NTSC total: 262 + +// both counters count from the begin of the visibla area +reg [9:0] h_cnt; // horizontal pixel counter +reg [9:0] sd_h_cnt; // scandoubler horizontal pixel counter +reg [9:0] v_cnt; // vertical pixel counter + +// swtich between ntsc and pal values +wire [9:0] hfp = ntsc?NTSC_HFP:PAL_HFP; +wire [9:0] hsw = ntsc?NTSC_HSW:PAL_HSW; +wire [9:0] hbp = ntsc?NTSC_HBP:PAL_HBP; +wire [9:0] vfp = ntsc?NTSC_VFP:PAL_VFP; +wire [9:0] vsw = ntsc?NTSC_VSW:PAL_VSW; +wire [9:0] vbp = ntsc?NTSC_VBP:PAL_VBP; + +// QL colors +localparam BLACK = 3'b000; +localparam BLUE = 3'b001; +localparam GREEN = 3'b010; +localparam CYAN = 3'b011; +localparam RED = 3'b100; +localparam MAGENTA = 3'b101; +localparam YELLOW = 3'b110; +localparam WHITE = 3'b111; + +/* ----------------------------------------------------------------- */ +/* ------------------------ VGA scandoubler ------------------------ */ +/* ----------------------------------------------------------------- */ + +// scan doubler buffer can hold two lines +reg [2:0] sd_buffer [1023:0]; +reg sd_scanline; +reg sd_toggle; + +// the scandoubler alternates between two buffers +// one is being written while the other one is being output +always @(posedge clk_video) + if(h_cnt == H+hfp+hsw+hbp-1) + sd_toggle = !sd_toggle; + +// scandoubler horizontal pixel counter +always@(posedge clk_vga) begin + // synchronize to + if((!clk_video && (h_cnt==H+hfp+hsw+hbp-1)) || + (sd_h_cnt==H+hfp+hsw+hbp-1)) sd_h_cnt <= 0; + else sd_h_cnt <= sd_h_cnt + 1; + + // generate negative hsync signal + if(sd_h_cnt == H+hfp) sd_hs <= 1'b0; + if(sd_h_cnt == H+hfp+hsw) begin + sd_hs <= 1'b1; + sd_scanline <= !sd_scanline; + end + + if(v_cnt == V+vfp+vsw+vbp-1) + sd_scanline <= 1'b0; +end + +// write to scandoubler buffer at QL pixel clock +always @(posedge clk_video) begin + if(h_cnt < H) begin + if(v_cnt < V) + sd_buffer[{sd_toggle, h_cnt[8:0]}] <= mode?pixel_color_4bpp:pixel_color_2bpp; + else + sd_buffer[{sd_toggle, h_cnt[8:0]}] <= 3'b000; + end +end + +// read from scandoubler buffer at twice QL pixel clock +reg [2:0] sd_pixel; +reg [2:0] sd_buffer_out; +always @(posedge clk_vga) begin + sd_buffer_out <= sd_buffer[{~sd_toggle, sd_h_cnt[8:0]}]; + if((sd_h_cnt > 1) && (sd_h_cnt <= H)) sd_pixel <= sd_buffer_out; + else sd_pixel <= 3'b000; +end +// sd_pixel <= (sd_h_cnt < H)?sd_buffer[{~sd_toggle, sd_h_cnt[8:0]}]:3'b000; +// sd_buffer_out <= sd_buffer[{~sd_toggle, sd_h_cnt[8:0]}]; + +/* ----------------------------------------------------------------- */ +/* -------------------- video timing generation -------------------- */ +/* ----------------------------------------------------------------- */ + +// toggle between scandoubler hsync and ql hsync +reg sd_hs, ql_hs; +assign hs = scandoubler?sd_hs:ql_hs; + +reg video_cycleD; +reg [2:0] video_cycle_cnt; + +// mode 8 supports hardware flashing +reg flash_state; +reg [5:0] flash_cnt; +always @(posedge vs) begin + if(flash_cnt == 25) begin + flash_cnt <= 6'd0; + flash_state <= !flash_state; + end else + flash_cnt <= flash_cnt + 6'd1; +end + +// horizontal pixel counter +always@(posedge clk_video) begin + // video cycle counter runs at pixel clock and + // synchronous to video_cycle + video_cycleD <= video_cycle; + if(video_cycle && !video_cycleD) + video_cycle_cnt <= 3'd0; + else + video_cycle_cnt <= video_cycle_cnt + 3'd1; + + // make sure h counter runs synchronous to bus_cycle + if(h_cnt==H+hfp+hsw+hbp-1) begin + if(video_cycle_cnt == 6) + h_cnt <= 0; + end else + h_cnt <= h_cnt + 1; + + // generate negative hsync signal + if(h_cnt == H+hfp) ql_hs <= 1'b0; + if(h_cnt == H+hfp+hsw) ql_hs <= 1'b1; +end + + +// veritical pixel counter +always@(posedge clk_video) begin + // the vertical counter is processed at the begin of each hsync + if(h_cnt == H+hfp) begin + if(v_cnt==V+vfp+vsw+vbp-1) v_cnt <= 0; + else v_cnt <= v_cnt + 1; + + // generate positive vsync signal + if(v_cnt == V+vfp) vs <= 1'b1; + if(v_cnt == V+vfp+vsw) vs <= 1'b0; + end +end + +reg [15:0] video_din; +reg [15:0] video_word; +reg [2:0] ql_pixel; + +always @(negedge video_cycle) + video_din <= din; + +// memory enable is 16 pixels ahead of display +reg meV, me; +always@(posedge clk_video) begin + // the verical "memory enable" changes + if(h_cnt == H+hfp+hsw+hbp-1-9) begin + if(v_cnt == 0) meV <= 1'b1; + if(v_cnt == V) meV <= 1'b0; + end + + if(meV) begin + if(h_cnt == H+hfp+hsw+hbp-1-8) me <= 1'b1; + if(h_cnt == H-1-8) me <= 1'b0; + end + + // mdv emulation may use the video bus cycle to read + // data whenever video is not using the bus + if(h_cnt == H-1) mdv_men <= 1'b1; + if(h_cnt == H+31) mdv_men <= 1'b0; +end + +// 2BPP: G0,G1,G2,G3,G4,G5,G6,G7 R0,R1,R2,R3,R4,R5,R6,R7 +wire [1:0] pixel_code_2bpp = {video_word[15], video_word[7]}; +wire [2:0] pixel_color_2bpp = + (pixel_code_2bpp == 0)?BLACK: // 0=black + (pixel_code_2bpp == 1)?RED: // 1=red + (pixel_code_2bpp == 2)?GREEN: // 2=green + WHITE; // 3=white + +// 4BPP: G0,F0,G1,F1,G2,F2,G3,F3 R0,B0,R1,B1,R2,B2,R3,B3 +wire [2:0] pixel_code_4bpp = {video_word[15], video_word[7:6]}; +wire pixel_flash_toggle = video_word[14]; + +wire [2:0] pixel_color_4bpp = + (flash_reg && flash_state)?flash_col: // flash to saved color + (pixel_code_4bpp == 0)?BLACK: // 0=black + (pixel_code_4bpp == 1)?BLUE: // 1=blue + (pixel_code_4bpp == 2)?RED: // 2=red + (pixel_code_4bpp == 3)?MAGENTA: // 3=magenta + (pixel_code_4bpp == 4)?GREEN: // 4=green + (pixel_code_4bpp == 5)?CYAN: // 5=cyan + (pixel_code_4bpp == 6)?YELLOW: // 6=yellow + WHITE; // 7=white + +reg flash_reg; +reg [2:0] flash_col; +always@(posedge clk_video) begin + if(h_cnt == H+1) + flash_reg <= 1'b0; // reset flash state at the begin of each line + + if((v_cnt == V+1) && (h_cnt == H+1)) + addr <= membase?19'h14000:19'h10000; // word! address + + if((me)&&(h_cnt[2:0] == 3'b111)) begin + addr <= addr + 19'd1; + video_word <= video_din; + end else begin + if(mode) begin + // 4bpp: shift rgbf every second pixel clock + if(h_cnt[0]) + video_word <= { video_word[13:8], 2'b00, video_word[5:0], 2'b00 }; + end else + // 2bpp, shift green byte and red byte up one pixel + video_word <= { video_word[14:8], 1'b0, video_word[6:0], 1'b0 }; + end + + // visible area? + if((v_cnt < V) && (h_cnt < H)) begin + if(mode) begin + ql_pixel <= pixel_color_4bpp; + + // change state of flash_reg if flasg bit in current pixel is set + // do this in the second half of the pixel so it's valid afterwards for the + // next pixels. the current pixel directly honours pixel_flash_toggle + if(h_cnt[0] && pixel_flash_toggle) begin + flash_reg <= !flash_reg; + flash_col <= pixel_color_4bpp; + end + end else + ql_pixel <= pixel_color_2bpp; + end else + // black pixel outside active area + ql_pixel <= 4'h0; +end + +wire [2:0] pixel = blank?3'b000:scandoubler?sd_pixel:ql_pixel; + +// the current line is a scanline if the scandoubler is being used, if +// scanlines are emnabled and if it's a scanline +wire is_scanline = scandoubler && scanlines && sd_scanline; +assign r = {(is_scanline?1'b0:pixel[2]), {5{pixel[2]}}}; +assign g = {(is_scanline?1'b0:pixel[1]), {5{pixel[1]}}}; +assign b = {(is_scanline?1'b0:pixel[0]), {5{pixel[0]}}}; + +endmodule diff --git a/cores/ql/zx8302.v b/cores/ql/zx8302.v new file mode 100644 index 0000000..3b2ac4f --- /dev/null +++ b/cores/ql/zx8302.v @@ -0,0 +1,244 @@ +// +// zx8302.v +// +// ZX8302 for Sinclair QL for the MiST +// https://github.com/mist-devel +// +// Copyright (c) 2015 Till Harbaum +// +// This source file is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// This source file is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see . +// + +module zx8302 ( + input clk, // 21 mhz + input reset, + input init, + + // interrupts + output [2:0] ipl, + + // sdram interface for microdrive emulation + output [24:0] mdv_addr, + input [15:0] mdv_din, + output mdv_read, + input mdv_men, + input video_cycle, + + // interface to watch MDV cartridge upload + input [24:0] mdv_dl_addr, + input mdv_download, + + output led, + + // vertical synv + input vs, + + input ps2_kbd_clk, + input ps2_kbd_data, + + // bus interface + input clk_bus, + input cpu_sel, + input cpu_wr, + input [1:0] cpu_addr, // a[5,1] + input [1:0] cpu_ds, + input [15:0] cpu_din, + output [15:0] cpu_dout + +); + +// --------------------------------------------------------------------------------- +// ----------------------------- CPU register write -------------------------------- +// --------------------------------------------------------------------------------- + +reg [7:0] mctrl; +reg ipc_bit_strobe; +wire ipc_reply_bit; + +// cpu is writing io registers +always @(negedge clk_bus) begin + irq_ack <= 5'd0; + ipc_bit_strobe <= 1'b0; + + // cpu writes to 0x18XXX area + if(cpu_sel && cpu_wr) begin + // even addresses have lds=0 and use the lower 8 data bus bits + if(!cpu_ds[1]) begin + // cpu writes microdrive control register + if(cpu_addr == 2'b10) + mctrl <= cpu_din[15:8]; + end + + // odd addresses have lds=0 and use the lower 8 data bus bits + if(!cpu_ds[0]) begin + // 18003 - IPCWR + // (host sends a single bit to ipc) + if(cpu_addr == 2'b01) begin + // data is ----XEDS + // S = start bit (should be 0) + // D = data bit (0/1) + // E = stop bit (should be 1) + // X = extra stopbit (should be 1) + + // QL will always write 11D0 here with one exception: At startup it sends + // one single bit through the start bit by writing 0001. Thus we ignore + // anything which doesn't match the 11D0 pattern + if((cpu_din[3:2]== 2'b11)&&(cpu_din[0]==1'b0)) + ipc_bit_strobe <= 1'b1; + end + + // cpu writes interrupt register + if(cpu_addr == 2'b10) begin + irq_mask <= cpu_din[7:5]; + irq_ack <= cpu_din[4:0]; + end + end + end +end + +// --------------------------------------------------------------------------------- +// ----------------------------- CPU register read --------------------------------- +// --------------------------------------------------------------------------------- + +// status register read +// bit 0 Network port +// bit 1 Transmit buffer full +// bit 2 Receive buffer full +// bit 3 Microdrive GAP +// bit 4 SER1 DTR +// bit 5 SER2 CTS +// bit 6 IPC busy +// bit 7 COMDATA + +wire [7:0] io_status = { ipc_reply_bit, ipc_busy, 2'b00, + mdv_gap, mdv_rx_ready, mdv_tx_empty, 1'b0 }; + +assign cpu_dout = + // 18000/18001 and 18002/18003 + (cpu_addr == 2'b00)?rtc[46:31]: + (cpu_addr == 2'b01)?rtc[30:15]: + + // 18020/18021 and 18022/18023 + (cpu_addr == 2'b10)?{io_status, irq_pending}: + (cpu_addr == 2'b11)?{mdv_byte, mdv_byte}: + + 16'h0000; + +// --------------------------------------------------------------------------------- +// -------------------------------------- IPC -------------------------------------- +// --------------------------------------------------------------------------------- + +ipc ipc ( + .reset ( reset ), + .clk_bus ( clk_bus ), + + .ipc_bit_strobe ( ipc_bit_strobe ), + .ipc_bit ( cpu_din[1] ), + .ipc_reply_bit ( ipc_reply_bit ), + .ipc_busy ( ipc_busy ), + + .ps2_kbd_clk ( ps2_kbd_clk ), + .ps2_kbd_data ( ps2_kbd_data ) +); + +// --------------------------------------------------------------------------------- +// -------------------------------------- IRQs ------------------------------------- +// --------------------------------------------------------------------------------- + +wire [7:0] irq_pending = {1'b0, (mdv_sel == 0), clk64k, + 1'b0, vsync_irq, 1'b0, 1'b0, gap_irq }; +reg [2:0] irq_mask; +reg [4:0] irq_ack; + + +// any pending irq raises ipl to 2 +assign ipl = (irq_pending[4:0] == 0)?3'b111:3'b101; + +// vsync irq is set whenever vsync rises +reg vsync_irq; +wire vsync_irq_reset = reset || irq_ack[3]; +always @(posedge vs or posedge vsync_irq_reset) begin + if(vsync_irq_reset) vsync_irq <= 1'b0; + else vsync_irq <= 1'b1; +end + +// toggling the mask will also trigger irqs ... +wire gap_irq_in = mdv_gap && irq_mask[0]; +reg gap_irq; +wire gap_irq_reset = reset || irq_ack[0]; +always @(posedge gap_irq_in or posedge gap_irq_reset) begin + if(gap_irq_reset) gap_irq <= 1'b0; + else gap_irq <= 1'b1; +end + + + +// --------------------------------------------------------------------------------- +// ----------------------------------- microdrive ---------------------------------- +// --------------------------------------------------------------------------------- + +wire mdv_gap; +wire mdv_tx_empty; +wire mdv_rx_ready; +wire [7:0] mdv_byte; + +assign led = !mdv_sel[0]; + +mdv mdv ( + .clk ( clk ), + .reset ( init ), + + .sel ( mdv_sel[0] ), + + // control bits + .gap ( mdv_gap ), + .tx_empty ( mdv_tx_empty ), + .rx_ready ( mdv_rx_ready ), + .dout ( mdv_byte ), + + .download ( mdv_download ), + .dl_addr ( mdv_dl_addr ), + + // ram interface to read image + .mem_ena ( mdv_men ), + .mem_cycle( video_cycle ), + .mem_clk ( clk_bus ), + .mem_addr ( mdv_addr ), + .mem_read ( mdv_read ), + .mem_din ( mdv_din ) +); + +// the microdrive control register mctrl generates the drive selection +reg [7:0] mdv_sel; + +always @(negedge mctrl[1]) + mdv_sel <= { mdv_sel[6:0], mctrl[0] }; + +// --------------------------------------------------------------------------------- +// -------------------------------------- RTC -------------------------------------- +// --------------------------------------------------------------------------------- + +// PLL for the real time clock (rtc) +reg [46:0] rtc; +always @(posedge clk64k) + rtc <= rtc + 47'd1; + +wire clk64k; +pll_rtc pll_rtc ( + .inclk0(clk), + .c0(clk64k) // 65536Hz +); + + +endmodule