OpenCores
URL https://opencores.org/ocsvn/light8080/light8080/trunk

Subversion Repositories light8080

Compare Revisions

  • This comparison shows the changes necessary to convert path
    /light8080/trunk/vhdl
    from Rev 64 to Rev 70
    Reverse comparison

Rev 64 → Rev 70

/soc/l80pkg.vhdl
0,0 → 1,73
--------------------------------------------------------------------------------
-- l80pkg.vhdl -- Support package for Light8080 SoC.
--
-- Contains functions used to initialize internal BRAM with object code.
--
-- This package will be used from the object code package where the program
-- initialized RAM constant is defined. If you use script obj2hdl it will
-- take care of this for you.
-- The package is used in entity l80soc too, and nowhere else.
--
-- This file and all the light8080 project files are freeware (See COPYING.TXT)
--------------------------------------------------------------------------------
 
library ieee;
use ieee.std_logic_1164.all;
use ieee.std_logic_arith.all;
use ieee.std_logic_unsigned.all;
 
package l80pkg is
 
-- Basic array type for the declaration of initialization constants.
-- This type is meant to be used to declare a constant with the object code
-- that is to be preprogrammed in an initialized RAM.
type obj_code_t is array(integer range <>) of std_logic_vector(7 downto 0);
 
-- Basic array type for the definition of initialized RAMs.
type ram_t is array(integer range <>) of std_logic_vector(7 downto 0);
 
-- Builds BRAM initialization constant from a constant CONSTRAINED byte array
-- containing the application object code.
-- The object code is placed at the beginning of the BRAM and the rest is
-- filled with zeros.
-- CAN BE USED IN SYNTHESIZABLE CODE to compute a BRAM initialization constant
-- from a constant argument.
--
-- oC: Object code table (as generated by utility script obj2hdl for instance).
-- size: Size of the target memory.
-- Returns ram_t value size-bytes long, suitable for synth-time initialization
-- of a BRAM.
function objcode_to_bram(oC : obj_code_t; size : integer) return ram_t;
 
 
end package;
 
package body l80pkg is
 
-- Builds BRAM initialization constant from a constant CONSTRAINED byte array
-- containing the application object code.
function objcode_to_bram(oC : obj_code_t; size : integer) return ram_t is
variable br : ram_t(integer range 0 to size-1);
variable i : integer;
variable obj_size : integer;
begin
-- If the object code table is longer than the array size, truncate code
if oC'length > size then
obj_size := size;
else
obj_size := oC'length;
end if;
 
-- Copy object code to start of BRAM...
for i in 0 to obj_size-1 loop
br(i) := oC(i);
end loop;
-- ... and fill the rest with zeros
br(obj_size to size-1) := (others => x"00");
return br;
end function objcode_to_bram;
 
end package body;
/soc/l80soc.vhdl
0,0 → 1,276
--##############################################################################
-- l80soc : light8080 SOC
--##############################################################################
-- v1.0 (27 mar 2012) First release. Jose A. Ruiz.
--
-- This file and all the light8080 project files are freeware (See COPYING.TXT)
--##############################################################################
-- (See timing diagrams at bottom of file. More comprehensive explainations can
-- be found in the design notes)
--##############################################################################
 
library ieee;
use ieee.std_logic_1164.all;
use ieee.std_logic_arith.all;
use ieee.std_logic_unsigned.all;
use work.l80pkg.all;
 
 
--##############################################################################
--
--##############################################################################
entity l80soc is
generic (
OBJ_CODE : obj_code_t; -- RAM initialization constant
RAM_ADDR_SIZE : integer := 12; -- RAM address width
UART_IRQ_LINE : integer := 4; -- [0..3] or >3 for none
UART_HARDWIRED: boolean := true; -- UART baud rate is hardwired
BAUD_RATE : integer := 19200; -- UART (default) baud rate
CLOCK_FREQ : integer := 50E6 -- Clock frequency in Hz
);
port (
p1in : in std_logic_vector(7 downto 0);
p2out : out std_logic_vector(7 downto 0);
rxd : in std_logic;
txd : out std_logic;
 
extint : in std_logic_vector(3 downto 0);
 
clk : in std_logic;
reset : in std_logic
);
end l80soc;
 
--##############################################################################
--
--##############################################################################
 
architecture hardwired of l80soc is
 
subtype t_byte is std_logic_vector(7 downto 0);
 
-- CPU signals -----------------------------------------------------------------
 
signal cpu_vma : std_logic;
signal cpu_rd : std_logic;
signal cpu_wr : std_logic;
signal cpu_io : std_logic;
signal cpu_fetch : std_logic;
signal cpu_addr : std_logic_vector(15 downto 0);
signal cpu_data_i : std_logic_vector(7 downto 0);
signal cpu_data_o : std_logic_vector(7 downto 0);
signal cpu_intr : std_logic;
signal cpu_inte : std_logic;
signal cpu_inta : std_logic;
signal cpu_halt : std_logic;
 
 
-- Aux CPU signals -------------------------------------------------------------
 
-- io_wr: asserted in IO write cycles
signal io_wr : std_logic;
-- io_rd: asserted in IO read cycles
signal io_rd : std_logic;
-- io_addr: IO port address, lowest 8 bits of address bus
signal io_addr : std_logic_vector(7 downto 0);
-- io_rd_data: data coming from IO ports (io input mux)
signal io_rd_data : std_logic_vector(7 downto 0);
-- cpu_io_reg: registered cpu_io, used to control mux after cpu_io deasserts
signal cpu_io_reg : std_logic;
 
-- UART ------------------------------------------------------------------------
 
signal uart_ce : std_logic;
signal uart_data_rd : std_logic_vector(7 downto 0);
signal uart_irq : std_logic;
 
 
-- RAM -------------------------------------------------------------------------
 
constant RAM_SIZE : integer := 4096;--2**RAM_ADDR_SIZE;
 
signal ram_rd_data : std_logic_vector(7 downto 0);
signal ram_we : std_logic;
 
signal ram : ram_t(0 to RAM_SIZE-1) := objcode_to_bram(OBJ_CODE, RAM_SIZE);
signal ram_addr : std_logic_vector(RAM_ADDR_SIZE-1 downto 0);
 
-- IRQ controller interface ----------------------------------------------------
 
signal irqcon_we : std_logic;
signal irqcon_data_rd: std_logic_vector(7 downto 0);
signal irq : std_logic_vector(3 downto 0);
 
 
-- IO ports addresses ----------------------------------------------------------
 
subtype io_addr_t is std_logic_vector(7 downto 0);
 
constant ADDR_UART_0 : io_addr_t := X"80"; -- UART registers (80h..83h)
constant ADDR_UART_1 : io_addr_t := X"81"; -- UART registers (80h..83h)
constant ADDR_UART_2 : io_addr_t := X"82"; -- UART registers (80h..83h)
constant ADDR_UART_3 : io_addr_t := X"83"; -- UART registers (80h..83h)
constant P1_DATA_REG : io_addr_t := X"84"; -- port 1 data register
constant P2_DATA_REG : io_addr_t := X"86"; -- port 2 data register
constant INTR_EN_REG : io_addr_t := X"88"; -- interrupts enable register
 
begin
 
 
cpu: entity work.light8080
port map (
clk => clk,
reset => reset,
vma => cpu_vma,
rd => cpu_rd,
wr => cpu_wr,
io => cpu_io,
fetch => cpu_fetch,
addr_out => cpu_addr,
data_in => cpu_data_i,
data_out => cpu_data_o,
intr => cpu_intr,
inte => cpu_inte,
inta => cpu_inta,
halt => cpu_halt
);
 
io_rd <= cpu_io and cpu_rd;
io_wr <= '1' when cpu_io='1' and cpu_wr='1' else '0';
io_addr <= cpu_addr(7 downto 0);
-- Register some control signals that are needed to control multiplexors the
-- cycle after the control signal asserts -- e.g. cpu_io.
control_signal_registers:
process(clk)
begin
if clk'event and clk='1' then
cpu_io_reg <= cpu_io;
end if;
end process control_signal_registers;
-- Input data mux -- remember, no 3-state buses within the FPGA --------------
cpu_data_i <=
irqcon_data_rd when cpu_inta = '1' else
io_rd_data when cpu_io_reg = '1' else
ram_rd_data;
-- BRAM ----------------------------------------------------------------------
ram_we <= '1' when cpu_io='0' and cpu_wr='1' else '0';
ram_addr <= cpu_addr(RAM_ADDR_SIZE-1 downto 0);
memory:
process(clk)
begin
if clk'event and clk='1' then
if ram_we = '1' then
ram(conv_integer(ram_addr)) <= cpu_data_o;
end if;
ram_rd_data <= ram(conv_integer(ram_addr));
end if;
end process memory;
-- Interrupt controller ------------------------------------------------------
-- FIXME interrupts unused in this version
irq_control: entity work.l80irq
port map (
clk => clk,
reset => reset,
irq_i => irq,
data_i => cpu_data_o,
data_o => irqcon_data_rd,
addr_i => cpu_addr(0),
data_we_i => irqcon_we,
cpu_inta_i => cpu_inta,
cpu_intr_o => cpu_intr,
cpu_fetch_i => cpu_fetch
);
irq_line_connections:
for i in 0 to 3 generate
begin
uart_irq_connection:
if i = UART_IRQ_LINE generate
begin
irq(i) <= uart_irq;
end generate;
other_irq_connections:
if i /= UART_IRQ_LINE generate
irq(i) <= extint(i);
end generate;
end generate irq_line_connections;
irqcon_we <= '1' when io_addr=INTR_EN_REG and io_wr='1' else '0';
 
-- UART -- simple UART with hardwired baud rate ------------------------------
-- NOTE: the serial port does NOT have interrupt capability (yet)
uart : entity work.uart
generic map (
BAUD_RATE => BAUD_RATE,
CLOCK_FREQ => CLOCK_FREQ
)
port map (
clk_i => clk,
reset_i => reset,
irq_o => uart_irq,
data_i => cpu_data_o,
data_o => uart_data_rd,
addr_i => cpu_addr(1 downto 0),
ce_i => uart_ce,
wr_i => io_wr,
rd_i => io_rd,
rxd_i => rxd,
txd_o => txd
);
-- UART write enable
uart_ce <= '1' when
io_addr(7 downto 2) = ADDR_UART_0(7 downto 2)
else '0';
-- IO ports -- Simple IO ports with hardcoded direction ----------------------
-- These are meant as an usage example mostly
output_ports:
process(clk)
begin
if clk'event and clk='1' then
if reset = '1' then
-- Reset values for all io ports
p2out <= (others => '0');
else
if io_wr = '1' then
if conv_integer(io_addr) = P2_DATA_REG then
p2out <= cpu_data_o;
end if;
end if;
end if;
end if;
end process output_ports;
-- Input IO data multiplexor
with io_addr select io_rd_data <=
p1in when P1_DATA_REG,
uart_data_rd when ADDR_UART_0,
uart_data_rd when ADDR_UART_1,
uart_data_rd when ADDR_UART_2,
uart_data_rd when ADDR_UART_3,
irqcon_data_rd when INTR_EN_REG,
X"00" when others;
 
end hardwired;
 
/soc/uart.vhdl
0,0 → 1,569
--##############################################################################
-- uart.vhdl -- Basic, hardwired RS232 UART.
--
-- Most operational parameters are hardcoded: 8 bit words, no parity, 1 stop
-- bit. The only parameter that can be configured in run time is the baud rate.
--
-- The receiver logic is a simplified copy of the 8051 UART. The bit period is
-- split in 16 sampling periods, and 3 samples are taken at the center of each
-- bit period. The bit value is decided by majority. The receiver logic has some
-- error recovery capability that should make this core reliable enough for
-- actual application use -- yet, the core does not have a format test bench.
--
-- See usage notes below.
--
--------------------------------------------------------------------------------
-- This file is free software (See COPYING.TXT)
--##############################################################################
 
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;
 
--------------------------------------------------------------------------------
-- UART programmer model
--------------------------------------------------------------------------------
--
-- The UART has a number of configuration registers addressable with input
-- signal addr_i:
--
-- [00] => Data buffer, both transmission and reception.
-- [01] => Status/control register (r/w).
-- [10] => Bit period register, low byte.
-- [11] => Bit period register, high byte.
--
--
-- Data buffers:
----------------
--
-- The same address [00b] is used for both the receive buffer and the
-- transmision buffer.
--
-- Writing to the data buffer when flag TxRdy is high will trigger a
-- transmission and clear flag TxRdy.
-- Writing to the data buffer when flag TxRdy is clear will have no effect.
--
-- Reading the data register when flag RxRdy is high will return the last
-- received data byte, and will clear flag RxRdy but NOT RxIrq.
-- Reading the register when flag RxRdy is clear will return indeterminate data,
-- which in practice will usually be the last byte received.
--
-- Interrupts:
--------------
--
-- The core has two interrupt sources tied to a single external irq line. The
-- sources are these:
--
-- -# Receiver interrupt: Raised when the stop bit is sampled and determined
-- to be valid (about the middle of the bit period).
-- If the stop bit is not valid (not high) then the interrupt is not
-- triggered. If a start bit is determined to be spurious (i.e. the falling
-- edge is detected but the bit value when sampled is not 0) then the
c
-- This interrupt sets flag RxIrw in the status register.
-- -# Transmitter interrupt: Raised at the end of the transmission of the stop
-- bit.
-- This interrupt sets flag TxIrq in the status register 1 clock cycle after
-- the interrupt is raised.
--
-- The core does not have any interrupt enable mask. If any interrupt source
-- triggers, the output irq_o is asserted for one cycle. This is all the extent
-- of the interrupt processing done by this module: this UART needs a separate
-- interrupt controller to interface the light8080 core.
--
-- Error detection:
-------------------
--
-- The core is capable of detecting and recovering from these error conditions:
--
-- -# When a start bit is determined to be spurious (i.e. the falling edge is
-- detected but the bit value when sampled is not 0) then the core returns to
-- its idle state (waiting for a new start bit).
-- -# If a stop bit is determined to be invalid (not 1 when sampled), the
-- reception interrupt is not triggered and the received byte is discarded.
-- -# When the 3 samples taken from the center of a bit period are not equal,
-- the bit value is decided by majority.
--
-- In none of the 3 cases does the core raise any error flag. It would be very
-- easy to include those flags in the core, but it would take a lot more time
-- to test them minimally and that's why they haven't been included.
--
-- Status register flags:
-------------------------
--
-- 7 6 5 4 3 2 1 0
-- +-------+-------+-------+-------+-------+-------+-------+-------+
-- | 0 | 0 | RxIrq | TxIrq | 0 | 0 | RxRdy | TxRdy |
-- +-------+-------+-------+-------+-------+-------+-------+-------+
-- h h W1C W1C h h r r
--
-- Bits marked 'h' are hardwired and can't be modified.
-- Bits marked 'r' are read only; they are set and clear by the core.
-- Bits marked W1C ('Write 1 Clear') are set by the core when an interrupt
-- has been triggered and must be cleared by the software by writing a '1'.
--
-- -# Status bit TxRdy is high when there isn't any transmission in progress.
-- It is cleared when data is written to the transmission buffer and is
-- raised at the same time the transmission interrupt is triggered.
-- -# Status bit RxRdy is raised at the same time the receive interrupt is
-- triggered and is cleared when the data register is read.
-- -# Status bit TxIrq is raised when the transmission interrupt is triggered
-- and is cleared when a 1 is written to it.
-- -# Status bit RxIrq is raised when the reception interrupt is triggered
-- and is cleared when a 1 is written to it.
--
-- When writing to the status/control registers, only flags TxIrq and RxIrq are
-- affected, and only when writing a '1' as explained above. All other flags
-- are read-only.
--
-- Baud rate configuration:
---------------------------
--
-- The baud rate is determined by the value of 14-bit register 'bit_period_reg'.
-- This register holds the length of the bit period in clock cycles and its
-- value may be hardcoded or configured at run time.
--
-- When generic HARDWIRED is true, bit_period_reg is hardwired with a value
-- computed from the value of generic BAUD_RATE. The bit period computation
-- needs to know the master clock rate, which should be given in generic
-- CLOCK_RATE.
-- Writes to the baud registers when HARDWIRED is true will be ignored.
--
-- When generic HARDWIRED is false, generics BAUD_RATE and CLOCK_RATE determine
-- the reset value of bit_period_reg, but the register can be changed at run
-- time by writing at addresses [10b] and [11b], which access the low and high
-- bytes of the register, respectively.
-- Reading from those register addresses returns the value of the status
-- register (a LUT saving measure) so the registers are effectively write-only.
--
--------------------------------------------------------------------------------
-- Core interface signals:
--
-- clk_i: Clock input, active rising edge.
-- reset_i: Synchronous reset.
-- txd_o: TxD UART output.
-- rxd_i: RxD UART input -- synchronization logic included.
-- irq_o: Interrupt output, asserted for 1 cycle when triggered.
-- data_i: Data bus, input.
-- data_o: Data bus, output.
-- addr_i: Register selection address (see above).
-- wr_i: Write enable input.
-- rd_i: Read enable input.
-- ce_i: Chip enable, must be active at the same time as wr_i or rd_i.
--
--
-- A detailed explanation of the interface timing will not be given. The core
-- reads and writes like a synchronous memory. There's usage examples in other
-- project files.
--------------------------------------------------------------------------------
 
entity uart is
generic (
HARDWIRED : boolean := true; -- Baud rate hardwired to constant value
BAUD_RATE : integer := 19200; -- Default (or hardwired) baud rate
CLOCK_FREQ : integer := 50E6); -- Clock rate
port (
rxd_i : in std_logic;
txd_o : out std_logic;
irq_o : out std_logic;
data_i : in std_logic_vector(7 downto 0);
data_o : out std_logic_vector(7 downto 0);
addr_i : in std_logic_vector(1 downto 0);
wr_i : in std_logic;
rd_i : in std_logic;
ce_i : in std_logic;
clk_i : in std_logic;
reset_i : in std_logic);
end uart;
 
architecture hardwired of uart is
 
-- Bit period expressed in master clock cycles
constant DEFAULT_BIT_PERIOD : integer := (CLOCK_FREQ / BAUD_RATE);
 
-- Bit sampling period is 1/16 of the baud rate.
constant DEFAULT_SAMPLING_PERIOD : integer := DEFAULT_BIT_PERIOD / 16;
 
 
 
--##############################################################################
 
-- Common signals
 
signal reset : std_logic;
signal clk : std_logic;
 
 
signal bit_period_reg : unsigned(13 downto 0);
signal sampling_period : unsigned(9 downto 0);
 
 
-- Interrupt & status register signals
 
signal tx_irq_flag : std_logic;
signal rx_irq_flag : std_logic;
signal load_stat_reg : std_logic;
signal load_tx_reg : std_logic;
 
-- Receiver signals
signal rxd_q : std_logic;
signal tick_ctr : unsigned(3 downto 0);
signal state : unsigned(3 downto 0);
signal next_state : unsigned(3 downto 0);
signal start_bit_detected : std_logic;
signal reset_tick_ctr : std_logic;
signal stop_bit_sampled : std_logic;
signal load_rx_buffer : std_logic;
signal stop_error : std_logic;
signal samples : std_logic_vector(2 downto 0);
signal sampled_bit : std_logic;
signal do_shift : std_logic;
signal rx_buffer : std_logic_vector(7 downto 0);
signal rx_shift_reg : std_logic_vector(9 downto 0);
signal tick_ctr_enable : std_logic;
signal tick_baud_ctr : unsigned(10 downto 0);
 
signal rx_rdy_flag : std_logic;
signal rx_irq : std_logic;
signal set_rx_rdy_flag : std_logic;
signal rxd : std_logic;
 
signal read_rx : std_logic;
signal status : std_logic_vector(7 downto 0);
 
-- Transmitter signals
 
signal tx_counter : unsigned(13 downto 0);
signal tx_data : std_logic_vector(10 downto 0);
signal tx_ctr_bit : unsigned(3 downto 0);
signal tx_busy : std_logic;
signal tx_irq : std_logic;
 
 
 
begin
 
-- Rename the most commonly used inputs to get rid of the i/o suffix
clk <= clk_i;
reset <= reset_i;
rxd <= rxd_i;
 
 
-- Serial port status byte -- only 2 status flags
status <=
"00" & rx_irq_flag & tx_irq_flag & -- Interrupt flags
"00" & rx_rdy_flag & (not tx_busy); -- State flags
 
-- Read register multiplexor
with addr_i select data_o <=
rx_buffer when "00",
status when others;
 
 
load_tx_reg <= '1' when wr_i = '1' and ce_i = '1' and addr_i = "00" else '0';
load_stat_reg <= '1' when wr_i = '1' and ce_i = '1' and addr_i = "01" else '0';
read_rx <= '1' when rd_i = '1' and ce_i = '1' else '0';
 
rx_irq <= set_rx_rdy_flag;
irq_o <= rx_irq or tx_irq;
 
interrupt_flags:
process(clk)
begin
if clk'event and clk='1' then
if reset = '1' then
rx_irq_flag <= '0';
tx_irq_flag <= '0';
else
if set_rx_rdy_flag='1' then
rx_irq_flag <= '1';
elsif load_stat_reg='1' and data_i(5)='1' then
rx_irq_flag <= '0';
end if;
if tx_irq='1' then
tx_irq_flag <= '1';
elsif load_stat_reg='1' and data_i(4)='1' then
tx_irq_flag <= '0';
end if;
end if;
end if;
end process interrupt_flags;
 
 
baud_rate_registers:
process(clk)
begin
if clk'event and clk='1' then
if reset = '1' then
bit_period_reg <= to_unsigned(DEFAULT_BIT_PERIOD,14);
else
if wr_i = '1' and ce_i = '1' then
if addr_i = "10" then
bit_period_reg(7 downto 0) <= unsigned(data_i);
elsif addr_i = "11" then
bit_period_reg(13 downto 8) <= unsigned(data_i(5 downto 0));
end if;
end if;
end if;
end if;
end process baud_rate_registers;
 
sampling_period <= bit_period_reg(13 downto 4);
-- Receiver --------------------------------------------------------------------
 
baud_counter:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
tick_baud_ctr <= (others => '0');
else
if tick_baud_ctr=sampling_period then
tick_baud_ctr <= (others => '0');
else
tick_baud_ctr <= tick_baud_ctr + 1;
end if;
end if;
end if;
end process baud_counter;
 
tick_ctr_enable<= '1' when tick_baud_ctr=sampling_period else '0';
 
-- Register RxD at the bit sampling rate -- 16 times the baud rate.
rxd_input_register:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
rxd_q <= '0';
else
if tick_ctr_enable='1' then
rxd_q <= rxd;
end if;
end if;
end if;
end process rxd_input_register;
 
-- We detect the start bit when...
start_bit_detected <= '1' when
state="0000" and -- ...we're waiting for the start bit...
rxd_q='1' and rxd='0' -- ...and we see RxD going 1-to-0
else '0';
 
-- As soon as we detect the start bit we synchronize the bit sampler to
-- the start bit's falling edge.
reset_tick_ctr <= '1' when start_bit_detected='1' else '0';
 
-- We have seen the end of the stop bit when...
stop_bit_sampled <= '1' when
state="1010" and -- ...we're in the stop bit period...
tick_ctr="1011" -- ...and we get the 11th sample in the bit period
else '0';
 
-- Load the RX buffer with the shift register when...
load_rx_buffer <= '1' when
stop_bit_sampled='1' and -- ...we've just seen the end of the stop bit...
sampled_bit='1' -- ...and its value is correct (1)
else '0';
 
-- Conversely, we detect a stop bit error when...
stop_error <= '1' when
stop_bit_sampled='1' and -- ...we've just seen the end of the stop bit...
sampled_bit='0' -- ...and its value is incorrect (0)
else '0';
 
-- tick_ctr is a counter 16 times faster than the baud rate that is aligned to
-- the falling edge of the start bit, so that when tick_ctr=0 we're close to
-- the start of a bit period.
bit_sample_counter:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
tick_ctr <= "0000";
else
if tick_ctr_enable='1' then
-- Restart counter when it reaches 15 OR when the falling edge
-- of the start bit is detected; this is how we synchronize to the
-- start bit.
if tick_ctr="1111" or reset_tick_ctr='1' then
tick_ctr <= "0000";
else
tick_ctr <= tick_ctr + 1;
end if;
end if;
end if;
end if;
end process bit_sample_counter;
 
-- Main RX state machine:
-- 0 -> waiting for start bit
-- 1 -> sampling start bit
-- 2..9 -> sampling data bit 0 to 7
-- 10 -> sampling stop bit
next_state <=
-- Start sampling the start bit when we detect the falling edge
"0001" when state="0000" and start_bit_detected='1' else
-- Return to idle state if the start bit is not a clean 0
"0000" when state="0001" and tick_ctr="1010" and sampled_bit='1' else
-- Return to idle state at the end of the stop bit period
"0000" when state="1010" and tick_ctr="1111" else
-- Otherwise, proceed to next bit period at the end of each period
state + 1 when tick_ctr="1111" and do_shift='1' else
state;
rx_state_machine_register:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
state <= "0000";
else
if tick_ctr_enable='1' then
state <= next_state;
end if;
end if;
end if;
end process rx_state_machine_register;
 
-- Collect 3 RxD samples from the 3 central sampling periods of the bit period.
rx_sampler:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
samples <= "000";
else
if tick_ctr_enable='1' then
if tick_ctr="0111" then
samples(0) <= rxd;
end if;
if tick_ctr="1000" then
samples(1) <= rxd;
end if;
if tick_ctr="1001" then
samples(2) <= rxd;
end if;
end if;
end if;
end if;
end process rx_sampler;
 
-- Decide the value of the RxD bit by majority
with samples select
sampled_bit <= '0' when "000",
'0' when "001",
'0' when "010",
'1' when "011",
'0' when "100",
'1' when "101",
'1' when "110",
'1' when others;
 
rx_buffer_register:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
rx_buffer <= "00000000";
set_rx_rdy_flag <= '0';
else
if tick_ctr_enable='1' and load_rx_buffer='1' and rx_rdy_flag='0' then
rx_buffer <= rx_shift_reg(8 downto 1);
set_rx_rdy_flag <= '1';
else
set_rx_rdy_flag <= '0';
end if;
end if;
end if;
end process rx_buffer_register;
 
rx_flag:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
rx_rdy_flag <= '0';
else
if set_rx_rdy_flag='1' then
rx_rdy_flag <= '1';
else
if read_rx = '1' then
rx_rdy_flag <= '0';
end if;
end if;
end if;
end if;
end process rx_flag;
 
-- RX shifter control: shift in any state other than idle state (0)
do_shift <= state(0) or state(1) or state(2) or state(3);
 
rx_shift_register:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
rx_shift_reg <= "1111111111";
else
if tick_ctr_enable='1' then
if tick_ctr="1010" and do_shift='1' then
rx_shift_reg(9) <= sampled_bit;
rx_shift_reg(8 downto 0) <= rx_shift_reg(9 downto 1);
end if;
end if;
end if;
end if;
end process rx_shift_register;
 
-- Transmitter -----------------------------------------------------------------
 
 
main_tx_process:
process(clk)
begin
if clk'event and clk='1' then
if reset='1' then
tx_data <= "10111111111";
tx_busy <= '0';
tx_irq <= '0';
tx_ctr_bit <= "0000";
tx_counter <= (others => '0');
elsif load_tx_reg='1' and tx_busy='0' then
tx_data <= "1"&data_i&"01";
tx_busy <= '1';
else
if tx_busy='1' then
if tx_counter = bit_period_reg then
tx_counter <= (others => '0');
tx_data(9 downto 0) <= tx_data(10 downto 1);
tx_data(10) <= '1';
if tx_ctr_bit = "1010" then
tx_busy <= '0';
tx_irq <= '1';
tx_ctr_bit <= "0000";
else
tx_ctr_bit <= tx_ctr_bit + 1;
end if;
else
tx_counter <= tx_counter + 1;
end if;
else
tx_irq <= '0';
end if;
end if;
end if;
end process main_tx_process;
 
txd_o <= tx_data(0);
 
end hardwired;
/soc/l80irq.vhdl
0,0 → 1,189
--##############################################################################
-- l80irq : light8080 interrupt controller for l80soc
--##############################################################################
--
-- This is a basic interrupt controller for the light8080 core. It is meant for
-- demonstration purposes only (demonstration of the light8080 core) and has
-- not passed any serious verification test bench.
-- It has been built on the same principles as the rest of the modules in this
-- project: no more functionality than strictly needed, minimized area.
--
-- The interrupt controller operates under these rules:
--
-- -# All interrupt inputs are active at rising edge.
-- -# No logic is included for input sinchronization. You must take care to
-- prevent metastability issues yourself by the usual means.
-- -# If a new edge is detected before the first is serviced, it is lost.
-- -# As soon as a rising edge in enabled irq input K is detected, bit K in the
-- interrupt pending register 'irq_pending_reg' will be asserted.
-- Than is, disabled interrupts never get detected at all.
-- -# Output cpu_intr_o will be asserted as long as there's a bit asserted in
-- the interrupt pending register.
-- -# For each interrupt there is a predefined priority level and a predefined
-- interrupt vector -- see comments below.
-- -# As soon as an INTA cycle is done by the CPU (inta=1 and fetch=1) the
-- following will happen:
-- * The module will supply the interrupt vector of the highes priority
-- pending interrupt.
-- * The highest priority pending interrupt bit in the pending interrupt
-- register will be deasserted -- UNLESS the interrupts happens to trigger
-- again at the same time, in which case the pending bit will remain
-- asserted.
-- * If there are no more interrupts pending, the cpu_intr_o output will
-- be deasserted.
-- -# The CPU will have its interrupts disabled from the INTA cycle to the
-- execution of instruction EI.
-- -# The cpu_intr_o will be asserted for a single cycle.
-- -# The irq vectors are hardcoded to RST instructions (single byte calls).
--
-- The priorities and vectors are hardcoded to the following values:
--
-- irq_i(3) Priority 3 Vector RST 7
-- irq_i(2) Priority 2 Vector RST 5
-- irq_i(1) Priority 1 Vector RST 3
-- irq_i(0) Priority 0 Vector RST 1
--
-- (Priority order: 3 > 2 > 1 > 0).
--
-- This module is used in the l80soc module, for which a basic test bench
-- exists. Both can be used as usage example.
-- The module and its application is so simple than no documentation other than
-- these comments should be necessary.
--
-- This file and all the light8080 project files are freeware (See COPYING.TXT)
--##############################################################################
-- (See timing diagrams at bottom of file. More comprehensive explainations can
-- be found in the design notes)
--##############################################################################
 
library ieee;
use ieee.std_logic_1164.all;
use ieee.std_logic_arith.all;
use ieee.std_logic_unsigned.all;
 
--##############################################################################
--
--##############################################################################
 
entity L80irq is
port (
cpu_inta_i : in std_logic;
cpu_intr_o : out std_logic;
cpu_fetch_i : in std_logic;
data_we_i : in std_logic;
addr_i : in std_logic;
data_i : in std_logic_vector(7 downto 0);
data_o : out std_logic_vector(7 downto 0);
 
irq_i : in std_logic_vector(3 downto 0);
clk : in std_logic;
reset : in std_logic );
end L80irq;
 
--##############################################################################
--
--##############################################################################
 
architecture hardwired of L80irq is
 
-- irq_pending: 1 when irq[i] is pending service
signal irq_pending_reg : std_logic_vector(3 downto 0);
-- irq_enable: 1 when irq[i] is enabled
signal irq_enable_reg : std_logic_vector(3 downto 0);
-- irq_q: registered irq input used to catch rising edges
signal irq_q : std_logic_vector(3 downto 0);
-- irq_trigger: asserted to 1 when a rising edge is detected
signal irq_trigger : std_logic_vector(3 downto 0);
signal irq_clear : std_logic_vector(3 downto 0);
signal irq_clear_mask:std_logic_vector(3 downto 0);
 
signal data_rd : std_logic_vector(7 downto 0);
signal vector : std_logic_vector(7 downto 0);
signal irq_level : std_logic_vector(2 downto 0);
 
 
begin
 
edge_detection:
for i in 0 to 3 generate
begin
irq_trigger(i) <= '1' when -- IRQ(i) is triggered when...
irq_q(i)='0' and -- ...we see a rising edge...
irq_i(i)='1' and
irq_enable_reg(i)='1' -- ...and the irq input us enabled.
else '0';
end generate edge_detection;
 
interrupt_pending_reg:
process(clk)
begin
if clk'event and clk='1' then
if reset = '1' then
irq_pending_reg <= (others => '0');
irq_q <= (others => '0');
else
irq_pending_reg <= (irq_pending_reg and (not irq_clear)) or irq_trigger;
irq_q <= irq_i;
end if;
end if;
end process interrupt_pending_reg;
 
with irq_level select irq_clear_mask <=
"1000" when "111",
"0100" when "101",
"0010" when "011",
"0001" when others;
 
irq_clear <= irq_clear_mask when cpu_inta_i='1' and cpu_fetch_i='1' else "0000";
 
interrupt_enable_reg:
process(clk)
begin
if clk'event and clk='1' then
if reset = '1' then
-- All interrupts disabled at reset
irq_enable_reg <= (others => '0');
else
if data_we_i = '1' and addr_i = '0' then
irq_enable_reg <= data_i(3 downto 0);
end if;
end if;
end if;
end process interrupt_enable_reg;
 
-- Interrupt priority & vector decoding
irq_level <=
"001" when irq_pending_reg(0) = '1' else
"011" when irq_pending_reg(1) = '1' else
"110" when irq_pending_reg(2) = '1' else
"111";
 
-- Raise interrupt request when there's any irq pending
cpu_intr_o <= '1' when irq_pending_reg /= "0000" else '0';
 
-- The IRQ vector is hardcoded to a RST instruction, whose opcode is
-- RST <n> ---> 11nnn111
process(clk)
begin
if clk'event and clk='1' then
if cpu_inta_i='1' and cpu_fetch_i='1' then
vector <= "11" & irq_level & "111";
end if;
end if;
end process;
 
-- There's only an internal register, the irq enable register, so we
-- don't need an output register mux.
data_rd <= "0000" & irq_enable_reg;
 
-- The mdule will output the register being read, if any, OR the irq vector.
data_o <= vector when cpu_inta_i = '1' else data_rd;
 
 
 
 
end hardwired;
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.