------------------------------------------------ -- Model : 8051 Behavioral Model, -- Top Level Block -- -- File : mc8051.vhd (MicroController 8051) -- -- Requires : pack8051.vhd (Package containing -- needed procedures, types, etc.) -- -- Author : Michael Mayer (mrmayer@computer.org), -- Dr. Hardy J. Pottinger, -- Department of Electrical Engineering -- University of Missouri - Rolla -- -- Inspired from : Sundar Subbarayan -- UC Riverside CS 122a (lab 3) -- Professor: Dr.Frank Vahid -- 17th January 1996 -- -- Date Started : September 15, 1997 -- -- Features : Entire command set -- Support for Intel Hex format -- Internal program memory (4Kb) -- Internal data memory (384 bytes) -- Supports external prog mem up to 64 Kb -- Supports external data mem up to 64 Kb -- using MOVX instr. with 16 bit data ptr. -- Supports I/O through 4 ports when not using -- above features -- Serial tx / rx in mode 1 -- Timer 1 in mode 2 only -- Interrupts (limited) -- -- Limitations : Reset Port does not function -- All interrupts are same level (IP ignored) -- No choice of level / edge sensitive interrupts -- No timer 0 -- Limited timer 1 (only 1 mode) -- -- -- Revisions : -- -- REV DATE Description -- ----- -------- --------------------------------------- -- 1.0 01/17/97 Work from Sundar Subbarayan and -- Dr. Frank Vahid -- -- 2.0 11/04/97 Initial implementation of command -- interpreter for Hex Code set. -- -- 2.1 11/12/97 Changed memory to separate lo and hi mem -- and made all access through functions / -- procedures / aliases to allow for -- distinction between indirect and direct -- accessing of upper 128 bytes of data mem -- (for 8052 compatibility). -- -- 2.2 11/21/97 Made program memory access only through -- the process get_pmem and its two -- signals: pmem_s1_byte and pmem_s4_byte -- Added state machine sensitive to xtal which -- governs the machine cycles, port & mem -- reads, etc. Built support for external -- program memory read in process get_pmem. -- -- 2.3 12/12/97 Corrected bug in get_pmem - resync to pc -- Moved load_program procedure to pack8051 -- Converted IF..ELSEIF structure to CASE for -- decoding of opcodes. Completed any missing -- commands and verified that all 256 were available -- -- 3.0 12/13/97 Changed port 3 to a single std_logic_vector -- Differentiated between commands that read the -- port and those that read the latch. -- Added output drivers for port3 -- -- 3.1 12/14/97 Modified procedures in main for accessing -- data bytes. All use get_byte_dmem -- and set_byte_dmem for any data access, unless -- they access it through aliases (e.g. acc <= val) -- -- 3.1.1 01/26/98 Added condition of ea_n to the program rom load -- -- 3.1.2 02/22/98 Corrected handle_sub's advancing of the pc -- Corrected JNC to IF cy='0' instead of '1' -- -- 3.1.3 02/24/98 Corrected MOVX's control of Ports 2 & 3. -- -- 3.2 07/??/98 Corrections from Kyle Mitchell for -- 0 or L, 1 or H and for initial boot-up -- -- 4.0 08/30/98 Added serial UART, timer 1 in mode 2, and -- the serial interrupt -- -- 4.1 09/02/98 Added remaining interrupts. -- ------------------------------------------------ LIBRARY ieee; USE ieee.std_logic_1164.ALL; USE ieee.std_logic_arith.ALL; -- Uses type unsigned, the "+" and "-" operators, and the functions -- conv_integer and conv_unsigned, amongst others USE std.textio.ALL; USE work.pack8051.ALL; ENTITY mc8051 IS GENERIC ( program_filename : string := "print.hex" -- program_filename : "print.hex" ); PORT ( P0 : INOUT std_logic_vector(7 DOWNTO 0); -- used for data i/o P1 : INOUT std_logic_vector(7 DOWNTO 0); -- low-order address byte P2 : INOUT std_logic_vector(7 DOWNTO 0); -- high-order address byte P3 : INOUT std_logic_vector(7 DOWNTO 0); -- These are the other uses for port 3 pins -- rxd : INOUT std_logic; --port 3.0, serial port receiver data -- txd : INOUT std_logic; --port 3.1, serial port transmitter -- int0_n : INOUT std_logic; --port 3.2, interrupt 0 input -- int1_n : INOUT std_logic; --port 3.3, interrupt 1 input -- t0 : INOUT std_logic; --port 3.4, input to counter 0 -- t1 : INOUT std_logic; --port 3.5, input to counter 1 -- wr_n : INOUT std_logic; --port 3.6, write control, latches port 0 to external -- rd_n : INOUT std_logic; --port 3.7, read control, enables external to port 0 rst : IN std_logic; -- low to high causes reset - IGNORED! xtal1 : IN std_logic; -- clock input 1.2 to 12 MHz xtal2 : OUT std_logic; -- output from oscillator (for crystal) - IGNORED! ale : OUT std_logic; -- provides Address Latch Enable output, psen_n : OUT std_logic; -- program store enable ea_n : IN std_logic -- when low, access external prog. mem ); END ENTITY mc8051; ARCHITECTURE behav OF mc8051 IS -- The following variables hold the program and data memory. -- Note that the upper 128 byte block of the data memory can -- only be accessed via indirect addressing. Direct addressing -- will instead reach the special function registers, etc. -- The aliases below are mapped to specific points in the data so that -- they can be accessed more easily. All data writes MUST be done -- through the set_dmem process. SIGNAL lo_dmem : data_lomem_T; -- the lower data memory SIGNAL direct_hi_dmem : data_himem_T; -- the data memory (sfr) SIGNAL indirect_hi_dmem : data_himem_T; -- the data memory SIGNAL pc : wVec; -- program counter SIGNAL pmem_s1_byte, pmem_s4_byte : bVec; -- next pmem data if needed ALIAS acc : bvec IS direct_hi_dmem(16#E0#); -- accum ALIAS b : bvec IS direct_hi_dmem(16#F0#); -- used for mult / div ALIAS psw : bvec IS direct_hi_dmem(16#D0#); -- program status word ALIAS cy : std_logic IS psw(7); -- carry flag ALIAS ac : std_logic IS psw(6); -- auxiliary carry flag ALIAS f0 : std_logic IS psw(5); -- flag 0 ALIAS rs : unsigned(1 DOWNTO 0) IS psw(4 DOWNTO 3); -- register bank selector ALIAS ov : std_logic IS psw(2); -- overflow flag ALIAS p : std_logic IS psw(0); -- parity - not implemented ALIAS sp : bvec IS direct_hi_dmem(16#81#); -- stack pointer ALIAS dpl : bvec IS direct_hi_dmem(16#82#); -- data pointer low ALIAS dph : bvec IS direct_hi_dmem(16#83#); -- data pointer high ALIAS p0_latch : bvec IS direct_hi_dmem(16#80#); -- port 0 in memory ALIAS p1_latch : bvec IS direct_hi_dmem(16#90#); -- port 1 in memory ALIAS p2_latch : bvec IS direct_hi_dmem(16#A0#); -- port 2 in memory ALIAS p3_latch : bvec IS direct_hi_dmem(16#B0#); -- port 3 in memory ALIAS scon : bvec IS direct_hi_dmem(16#98#); -- serial control reg. ALIAS sm : unsigned(2 DOWNTO 0) IS scon(7 DOWNTO 5); -- serial mode -- NOT IMPLEMENTED, but would decode as follows: -- 00 shift reg (FOSC / 12 Baud) -- 01 8-Bit UART (Variable Baus) -- 10 9-Bit UART (Fosc / 64 or Fosc / 32 Baus) -- 11 9-Bit UART (Variable Baud) -- sm2 enables multiprocessor communication feature ALIAS ren : std_logic IS scon(4); -- Reception Enable (active high) ALIAS tb8 : std_logic IS scon(3); -- Transmit Bit 8 (ninth bit) ALIAS rb8 : std_logic IS scon(2); -- Received Bit 8 (ninth bit) ALIAS ti : std_logic IS scon(1); -- transmit interrupt ALIAS ri : std_logic IS scon(0); -- receive interrup ALIAS sbuf : bvec IS direct_hi_dmem(16#99#); -- serial data buffer ALIAS tcon : bvec IS direct_hi_dmem(16#88#); -- timer control reg. ALIAS timer1_on : std_logic IS tcon(6); ALIAS ie : bvec IS direct_hi_dmem(16#A8#); -- interrupt enable ALIAS ea : std_logic IS ie(7); -- disable all interrupts ALIAS en_serial : std_logic IS ie(4); -- es bit ALIAS en_t1 : std_logic IS ie(3); ALIAS en_x1 : std_logic IS ie(2); ALIAS en_t0 : std_logic IS ie(1); ALIAS en_x0 : std_logic IS ie(0); -- cycle_state is a signal containing the current state of the -- machine cycle (s1 through s6), with 2 pulses for each state (p1 and p2). SIGNAL cycle_state : machine_cycle_states; SIGNAL TCLCL : TIME := 0 ns; -- time for a period of XTAL1 SIGNAL reset_pmem : std_logic; -- port_req is used by the external data memory access (in process main) -- to halt the output of the external program memory process. SIGNAL port_req : std_logic := '0'; -- These two signals carry addr / data for ports 0 and 2 SIGNAL p0_addr, p2_addr : bvec; -- When the following ctrl signals are low, then the port will -- output the value associated with the latch, otherwise it is -- the value of data / addr or special function. SIGNAL p0_ctrl, p2_ctrl : std_logic; SIGNAL p3_ctrl : bvec; -- When Port 0 is written to for data / addr purposes, the latch is reset -- to all ones. Process main is in charge of all writes to the memory. -- The following signal is used by get_pmem to indicate the reset: SIGNAL p0_reset : std_logic; -- Handshaking signal controlled by main to acknowledge above reset SIGNAL p0_reset_ack : std_logic; -- Denotes bad data read at s1p1 which could be an opcode SIGNAL bad_data : std_logic; -- Two signals that are used to resolve ale (from get_pmem and main) SIGNAL ale_pm, ale_dm : std_logic; -- Internal signals for port3 special functions SIGNAL wr_n_internal, rd_n_internal, rxd_internal, txd_internal, int0_n_internal, int1_n_internal, t0_internal, t1_internal : std_logic := '1'; -- the sbuf reg. maintained by the serial driver SIGNAL sbuf_dup : bvec; SIGNAL p2clk : std_logic; -- used by uart, high for any s?p2 SIGNAL addr_gb, data_gb : bvec; SIGNAL wr_gb, rd_gb : std_logic := '0'; SIGNAL acknow : std_logic; SIGNAL scon_out : bvec; ALIAS trans_int : std_logic IS scon_out(1); ALIAS recv_int : std_logic IS scon_out(0); SIGNAL timer1H : unsigned(7 DOWNTO 0); SIGNAL timer1_int : std_logic := '0'; ------------------------------------------------------------------------ BEGIN -- architecture --=============================================================== -- Concurrent Signal Assignments --=============================================================== -- Strobe ale high whenever program or data memory requires it. ale <= '1' WHEN ale_pm = '1' OR ale_dm = '1' ELSE '0'; -- Put a weak low on control lines, so that a 1 write will pull high p0_ctrl <= 'L'; p2_ctrl <= 'L'; p3_ctrl <= "LLLLLLLL"; -- assign a high impedance version of the latch (either L or H) -- on any falling edge P0 <= std_logic_vector(to_high_imped(p0_latch)) WHEN cycle_state=s1p1 AND falling_edge(xtal1) ELSE UNAFFECTED; P1 <= std_logic_vector(to_high_imped(p1_latch)) WHEN cycle_state=s1p1 AND falling_edge(xtal1) ELSE UNAFFECTED; P2 <= std_logic_vector(to_high_imped(p2_latch)) WHEN cycle_state=s1p1 AND falling_edge(xtal1) ELSE UNAFFECTED; P3 <= std_logic_vector(to_high_imped(p3_latch)) WHEN cycle_state=s1p1 AND falling_edge(xtal1) ELSE UNAFFECTED; -- when the ctrl is asserted (by get_pmem or main) then -- force the addr/data value out the port P0 <= std_logic_vector(p0_addr) WHEN p0_ctrl = '1' ELSE (OTHERS => 'Z'); P2 <= std_logic_vector(p2_addr) WHEN p2_ctrl = '1' ELSE (OTHERS => 'Z'); -- always enable the UART p3_ctrl(0) <= '1'; p3_ctrl(1) <= '1'; --P3(0) <= rxd_internal WHEN p3_ctrl(0) = '1' ELSE 'Z'; rxd_internal <= P3(0); P3(1) <= txd_internal WHEN p3_ctrl(1) = '1' ELSE 'Z'; -- mrm add logic here to detemine level / edge sensitive int0_n_internal <= P3(2); int1_n_internal <= P3(3); t0_internal <= P3(4); t1_internal <= P3(5); P3(6) <= wr_n_internal WHEN p3_ctrl(6) = '1' ELSE 'Z'; P3(7) <= rd_n_internal WHEN p3_ctrl(7) = '1' ELSE 'Z'; --=============================================================== -- Process Statements --=============================================================== ------------------------------------------------------------------------ -- The oscillator process will follow the XTAL clock signal and -- advance the current state. The states are s1p1, s1p2, s2p1, s2p2, -- up to s6p1 and s6p2. ------------------------------------------------------------------------ oscillator : PROCESS (XTAL1) IS VARIABLE last_falling_edge_time : TIME := 0 ns; VARIABLE startup_count : INTEGER := 0; BEGIN IF falling_edge(XTAL1) THEN IF startup_count < 3 THEN cycle_state <= init; startup_count := startup_count + 1; last_falling_edge_time := NOW; ELSE cycle_state <= inc(cycle_state); -- increment the current state, -- and loop back from s6p2 to s1p1 TCLCL <= NOW - last_falling_edge_time; last_falling_edge_time := NOW; END IF; END IF; END PROCESS oscillator; ------------------------------------------------------------------------ -- The process get_pmem is responsible for reading all of the program -- memory (whetere internal or external) and feeding the read bytes to -- the process main through the signals pmem_s1_byte and pmem_s4_byte. -- If there has been a transaction on pc, this process will set -- its internal addr to the value of pc at state s4p1. Then, if needed, -- it will output this addr at s5p1 and then read in the appropriate data -- at s1p1. Then it increments its internal addr and will read the next -- byte at s4p1. It will continue to increment the internal addr until -- there is another transaction on pc. ------------------------------------------------------------------------- get_pmem : PROCESS(cycle_state, pc'TRANSACTION) IS VARIABLE addr : INTEGER := 0; VARIABLE pmem : program_mem_T; -- the program memory VARIABLE prog_loaded : BOOLEAN := FALSE; -- true after pmem is updated VARIABLE resync : BOOLEAN := FALSE; -- set true when pc changes VARIABLE port_to_01 : bit_vector(7 DOWNTO 0); BEGIN IF NOT prog_loaded THEN IF (ea_n = '1' or ea_n = 'H') THEN load_program(program_filename,pmem); END IF; -- Set default values for control lines psen_n <= '1'; p0_ctrl <= 'Z'; p2_ctrl <= 'Z'; p0_reset <= '0'; prog_loaded := TRUE; ELSE -- If process main has acknowledged a reset, then -- clear the p0 reset line. IF p0_reset_ack <= '1' THEN p0_reset <= '0'; END IF; -- If there has been a transaction on pc, and it is -- not the initial start-up state, then flag the -- resync variable IF pc'ACTIVE THEN resync := TRUE; END IF; -- If the process main is trying to read a data byte -- from external mem, yield to it by putting ctrl's -- to high impedance IF port_req = '1' THEN p0_ctrl <= 'Z'; p2_ctrl <= 'Z'; p0_addr <= "ZZZZZZZZ"; p2_addr <= "ZZZZZZZZ"; ale_pm <= '0'; psen_n <= '1'; ELSIF reset_pmem = '1' THEN resync := TRUE; addr := 0; ELSIF cycle_state'ACTIVE THEN CASE cycle_state IS WHEN init => NULL; WHEN s1p1 => -- read in the current byte from pmem IF ( addr > 16#0FFF#) OR (ea_n = '0') OR (ea_n = 'L') THEN IF Is_X(P0) THEN pmem_s1_byte <= unsigned'("00000000"); bad_data <= '1'; ELSE port_to_01 := to_bitVector(P0); pmem_s1_byte <= unsigned(to_stdlogicvector(port_to_01)); bad_data <= '0'; END IF; ELSE -- fetch from internal memory pmem_s1_byte <= pmem(addr); END IF; WHEN s4p1 => -- read in the current byte from pmem IF ( addr >= 16#0FFF#) OR (ea_n = '0') OR (ea_n = 'L') THEN port_to_01 := to_bitVector(P0); pmem_s4_byte <= unsigned(to_stdlogicvector(port_to_01)); ELSE -- fetch from internal memory pmem_s4_byte <= pmem(addr); END IF; WHEN s1p2 | s4p2 => IF resync THEN addr := conv_integer(pc); resync := FALSE; ELSE addr := addr + 1; END IF; -- strobe ale if next addr is external -- rewrite p0_latch to all 1's IF ( addr >= 16#0FFF#) OR (ea_n = '0') OR (ea_n = 'L') THEN ale_pm <= '1'; psen_n <= '1'; p0_reset <= '1'; END IF; WHEN s2p1 | s5p1 => -- drive port 0 and port 2 if addr is external IF ( addr >= 16#0FFF#) OR (ea_n = '0') OR (ea_n = 'L') THEN p0_addr <= conv_unsigned(addr MOD 256, 8); p2_addr <= conv_unsigned(addr / 256, 8); p0_ctrl <= '1'; p2_ctrl <= '1'; ELSE p0_ctrl <= 'Z'; p2_ctrl <= 'Z'; END IF; WHEN s2p2 | s5p2 => -- drive ale to zero IF ( addr >= 16#0FFF#) OR (ea_n = '0') OR (ea_n = 'L') THEN ale_pm <= '0'; END IF; WHEN s3p1 | s6p1 => -- drive psen low IF ( addr >= 16#0FFF#) OR (ea_n = '0') OR (ea_n = 'L') THEN psen_n <= '0'; p0_addr <= "ZZZZZZZZ"; END IF; WHEN s3p2 | s6p2 => NULL; END CASE; END IF; END IF; END PROCESS get_pmem; ------------------------------------------------------------------------ -- This is the main process of the microcomputer. It will check the -- opcode and perform the action. ------------------------------------------------------------------------ main : PROCESS VARIABLE opcode : bVec; -- the opcode for this cycle VARIABLE temp1, temp2 : bVec; -- temp use only VARIABLE temp_int : INTEGER; -- temp use only VARIABLE temp_pc : wVec; -- temp pc storage VARIABLE init_done : BOOLEAN := FALSE; -- set to true once the initializing is done in the first cycle VARIABLE ie_stored : bVec; -- stores ie reg when servicing an interrupt VARIABLE pc_int : INTEGER; -- only used for report -- set_sfr (set the default value of the special function registers) PROCEDURE set_sfr IS BEGIN acc <= "00000000"; b <= "00000000"; psw <= "00000000"; sp <= "00000111"; dpl <= "00000000"; dph <= "00000000"; p0_latch <= "11111111"; p1_latch <= "11111111"; p2_latch <= "11111111"; p3_latch <= "11111111"; END PROCEDURE set_sfr; ------------------------------------------------Memory Handling Procedures -- Note that the following impure functions and procedures all use -- the program and/or data memory which is defined as a signal. -- However, when reading from addr's 80,90,A0,B0 for some will -- read the port directly, while others will read the ram mirror. -- Those that read the mirror (latch) are ANL, ORL, XRL, JBC, -- CPL, INC, DEC, DJNZ, MOV PX.Y, CLR PX.Y, SETB PX.Y -- get_byte_dmem will return the value of the byte at byte address -- depending upon if direct or indirect addressing is being used. -- it will also check if an event has occured on a serial control -- or buffer and will copy that into the ram IMPURE FUNCTION get_byte_dmem( CONSTANT addr : IN bvec; CONSTANT mode : IN access_type; CONSTANT read_latch : IN BOOLEAN := FALSE ) RETURN bvec IS VARIABLE addr_int : INTEGER; VARIABLE byte_slice : bVec; BEGIN addr_int := conv_integer(addr); IF addr_int < 128 THEN byte_slice := lo_dmem(addr_int); ELSIF mode = indirect THEN byte_slice := indirect_hi_dmem(addr_int); ELSIF (NOT read_latch) AND (addr_int=16#80#) THEN -- read the port itself byte_slice := unsigned(P0); ELSIF (NOT read_latch) AND (addr_int=16#90#) THEN -- read the port itself byte_slice := unsigned(P1); ELSIF (NOT read_latch) AND (addr_int=16#A0#) THEN -- read the port itself byte_slice := unsigned(P2); ELSIF (NOT read_latch) AND (addr_int=16#B0#) THEN -- read the port itself byte_slice := unsigned(P3); -- read from sbuf ELSIF addr_int = 16#99# THEN byte_slice := sbuf_dup; ELSIF addr_int = 16#98# THEN byte_slice := scon_out; ELSE byte_slice := direct_hi_dmem(addr_int); END IF; RETURN(byte_slice); END FUNCTION get_byte_dmem; -- set_byte_dmem will set the value of the byte at address (addr) -- using the appropriate memory for direct / indirect accessing. PROCEDURE set_byte_dmem( CONSTANT addr : IN bvec; CONSTANT val : IN bVec; CONSTANT mode : IN access_type ) IS VARIABLE addr_int : INTEGER; BEGIN addr_int := conv_integer(addr); IF addr_int < 128 THEN lo_dmem(addr_int) <= val; ELSIF mode = indirect THEN indirect_hi_dmem(addr_int) <= val; -- write to sbuf ELSIF addr_int = 16#99# THEN addr_gb <= "10011001"; data_gb <= val; wr_gb <= '1'; WAIT UNTIL acknow = '1'; wr_gb <= 'L'; addr_gb <= "ZZZZZZZZ"; data_gb <= "ZZZZZZZZ"; -- write to scon ELSIF addr_int = 16#98# THEN direct_hi_dmem(addr_int) <= val; addr_gb <= "10011000"; data_gb <= val; wr_gb <= '1'; WAIT UNTIL acknow = '1'; wr_gb <= 'L'; addr_gb <= "ZZZZZZZZ"; data_gb <= "ZZZZZZZZ"; ELSIF addr_int = 16#8D# THEN timer1H <= val; direct_hi_dmem(addr_int) <= val; ELSE direct_hi_dmem(addr_int) <= val; END IF; END PROCEDURE set_byte_dmem; -- get_reg will get the value of register (number) based upon -- the current bank number as defined in register select (rs) IMPURE FUNCTION get_reg( CONSTANT number : IN unsigned(2 DOWNTO 0) ) RETURN bVec IS VARIABLE addr : bvec; BEGIN addr := unsigned'("000") & rs & number; RETURN get_byte_dmem(addr, direct); END FUNCTION get_reg; -- set_reg will set the value of register (number) based upon -- the current bank number as defined in register select (rs) PROCEDURE set_reg( CONSTANT number : IN unsigned(2 DOWNTO 0); CONSTANT value : IN bVec ) IS VARIABLE addr : bvec; BEGIN addr := unsigned'("000") & rs & number; set_byte_dmem(addr, value, direct); END PROCEDURE set_reg; -- get_bit_dmem will return the value of the bit at bit address (addr) -- will always use direct mem IMPURE FUNCTION get_bit_dmem( CONSTANT addr : IN bVec; CONSTANT read_latch : IN BOOLEAN := FALSE ) RETURN std_logic IS VARIABLE byte_slice : bVec; VARIABLE addr1 : bVec; BEGIN IF addr(7) = '0' THEN -- if addr < 16#80 THEN addr1 := unsigned'("0010") & addr(6 DOWNTO 3); ELSIF addr(7) = '1' THEN -- if addr > 16#80 THEN addr1 := addr(7 DOWNTO 3) & unsigned'("000"); ELSE REPORT "8051 Internal Error: Bad address in get_bit_dmem"; END IF; byte_slice := get_byte_dmem(addr1,direct,read_latch); -- read latch RETURN(byte_slice(conv_integer(addr(2 DOWNTO 0)))); END FUNCTION get_bit_dmem; -- set_bit_dmem will set the value of the bit at bit address (addr) -- always assumed to be a "Read Modify Write" instruction, so that -- setting a bit to the port will read the surrounding bits from the -- port mirror (latch). PROCEDURE set_bit_dmem( CONSTANT addr : IN bvec; CONSTANT val : IN std_logic ) IS VARIABLE byte_slice : bvec; VARIABLE addr1 : bvec; BEGIN IF addr(7) = '0' THEN -- if addr < 16#80 THEN addr1 := unsigned'("0010") & addr(6 DOWNTO 3); ELSIF addr(7) = '1' THEN -- if addr > 16#80 THEN addr1 := addr(7 DOWNTO 3) & unsigned'("000"); ELSE REPORT "8051 Internal Error: Bad address in get_bit_dmem"; END IF; byte_slice := get_byte_dmem(addr1,direct,TRUE); -- read latch byte_slice(conv_integer(addr(2 DOWNTO 0))) := val; set_byte_dmem(addr1,byte_slice,direct); END PROCEDURE set_bit_dmem; -------------------------------------------End of Memory Handling Procdures -------------------------------------------procedure get data -- This function will get data from either data memory, a register, -- or direct (from program memory) based on the opcode passed. -- It uses the following table for the last few digits of the opcode -- 0000, 0001, 0010, 0011 Not found by this procedure! -- 0100 : Use immediate data in program memory -- 0101 : Use direct address -- 011i : Use data at address contained in register 0 or 1 (i) -- 1rrr : Use register rrr PROCEDURE get_data( CONSTANT opcode : IN bVec; -- opcode used to select data VARIABLE data : INOUT bVec; -- The 8-bits of data CONSTANT read_latch : IN BOOLEAN := FALSE ) IS VARIABLE nxt_pmem1 : bVec; -- Temporary data BEGIN IF opcode(3) = '1' THEN -- use register data := get_reg(opcode(2 DOWNTO 0)); ELSIF opcode(2 DOWNTO 0) =unsigned'( "101") THEN -- use direct memory data := get_byte_dmem(pmem_s4_byte, direct, read_latch); ELSIF opcode(2 DOWNTO 0) =unsigned'( "100") THEN -- use immediate data data := pmem_s4_byte; ELSIF opcode(2 DOWNTO 0) =unsigned'( "110") THEN -- use data @R0 data := get_byte_dmem(get_reg("000"),indirect) ; ELSIF opcode(2 DOWNTO 0) =unsigned'( "111") THEN -- use data @R1 data := get_byte_dmem(get_reg("001"), indirect); END IF; END PROCEDURE get_data; FUNCTION advance_pc( CONSTANT opcode : IN bVec -- opcode used to select data ) RETURN INTEGER IS VARIABLE pc_inc : INTEGER; BEGIN IF opcode(3) = '1' THEN -- use register pc_inc := 0; ELSIF opcode(2 DOWNTO 0) =unsigned'( "101") THEN -- use direct memory pc_inc := 1; ELSIF opcode(2 DOWNTO 0) =unsigned'( "100") THEN -- use immediate data pc_inc := 1; ELSIF opcode(2 DOWNTO 0) =unsigned'( "110") THEN -- use data @R0 pc_inc := 0; ELSIF opcode(2 DOWNTO 0) =unsigned'( "111") THEN -- use data @R1 pc_inc := 0; END IF; RETURN pc_inc; END FUNCTION advance_pc; -------------------------------------------procedure handle add -- This function handles the carry's and adding for the ADD and ADDC -- opcodes. PROCEDURE handle_add( CONSTANT opcode : IN bVec; -- The opcode, used to select the 2nd operand CONSTANT cy_in : IN std_logic -- set to '0' for ADD, cy for ADDC ) IS VARIABLE operand2 : bVec; -- the 2nd operand VARIABLE new_sum : INTEGER; -- the new sum to be put in the acc VARIABLE pc_inc : INTEGER; -- amount to increment pc BEGIN pc <= pc + 1 + advance_pc(opcode); WAIT UNTIL cycle_state = s5p1; get_data(opcode, operand2); new_sum := conv_integer(acc) + conv_integer(operand2) + conv_integer(cy_in); -- Set carry flag if there is a carry out of bit 7 IF new_sum > 255 THEN cy <= '1'; ELSE cy <= '0'; END IF; -- Set aux. carry flag if there is a carry out of bit 3 IF (conv_integer(acc(3 DOWNTO 0))+conv_integer(operand2(3 DOWNTO 0))+ conv_integer(cy_in)) > 15 THEN ac <= '1'; ELSE ac <= '0'; END IF; -- Set OV if there is a carry from bit 6 but not bit 7, or -- if there is a carry from 7 but none from 6. Otherwise, clear. IF conv_integer(acc(6 DOWNTO 0))+conv_integer(operand2(6 DOWNTO 0)) > 127 THEN -- There is a carry from 6 IF new_sum > 255 THEN -- and from 7 ov <= '0'; -- so clear overflow ELSE -- If there is not a carry from 7, ov <= '1'; -- then set overflow END IF; ELSE -- If there is not a carry from 6 IF NEW_sum > 255 THEN -- and there is from 7 ov <= '1'; -- set overflow. ELSE -- If there is not a carry from 7, ov <= '0'; -- then clear overflow END IF; END IF; -- Finally, put the new sum into the acc (getting rid of any overflow) acc <= conv_unsigned(new_sum, 8); END PROCEDURE handle_add; -------------------------------------------procedure handle sub -- This function handles the carry's and subtracting for the SUBB opcode PROCEDURE handle_sub( CONSTANT opcode : IN bVec -- The opcode, used to select the 2nd operand ) IS VARIABLE acc_int,op2_int,cy_int : INTEGER;-- bits converted to int VARIABLE operand2 : bVec; -- the 2nd operand VARIABLE new_diff : INTEGER; -- the new diff for acc BEGIN pc <= pc + 1 + advance_pc(opcode); WAIT UNTIL cycle_state = s5p1; get_data(opcode, operand2); acc_int := conv_integer(acc); op2_int := conv_integer(operand2); cy_int := conv_integer(cy); IF acc_int > op2_int + cy_int THEN new_diff := acc_int - (op2_int + cy_int); cy <= '0'; -- clear cy (borrow) flag ELSE -- If the subtractants are larger than the acc, set -- borrow and add 256 to acc new_diff := (acc_int + 256) - (op2_int + cy_int); cy <= '1'; -- set cy (borrow) flag END IF; -- Decide if aux. carry needs to be set or cleared (lower 4 bits) IF conv_integer(acc(3 DOWNTO 0)) > (conv_integer(operand2(3 DOWNTO 0)) + cy_int) THEN ac <= '0'; ELSE ac <= '1'; END IF; -- Set OV if there is borrow into bit 6 but not bit 7, or -- into bit 7 but not bit 6. Otherwise, clear. IF conv_integer(acc(6 DOWNTO 0)) < conv_integer(operand2(6 DOWNTO 0)) + cy_int THEN -- There is a borrow into bit 6 IF acc_int > op2_int + cy_int THEN -- but not into bit 7 ov <= '1'; -- so set ov (overflow) ELSE -- There is not a borrow into bit 7 ov <= '0'; -- so clear overflow END IF; ELSE -- There is not a borrow into bit 6 IF acc_int > op2_int + cy_int THEN -- and not into 7 ov <= '0'; -- then clear overflow ELSE -- There is a borrow into bit 7 ov <= '1'; -- So set overflow END IF; END IF; -- Set AC if there is a borrow into bit 3, otherwise reset it IF conv_integer(acc(3 DOWNTO 0)) < conv_integer(operand2(3 DOWNTO 0)) + cy_int THEN ac <= '1'; ELSE ac <= '0'; END IF; acc <= conv_unsigned(new_diff, 8); END PROCEDURE handle_sub; ------------------------------------------- Begin the Process main --VARIABLE first_inst : BOOLEAN := TRUE; BEGIN -- process main -- There are six states to a machine cycle, some commands take -- more than one cycle. However, here is the general timing -- State 1 Pulse 1 - The opcode is read in by the get_pmem process -- State 1 Pulse 2 - The next address (pc + 1) is stored for output -- by the get_pmem process -- State 2 Pulse 1 - Process main reads the opcode and decodes it. -- pc is updated if it is a one cycle code -- the operation is completed if no more data required -- State 4 Pulse 1 - The next data (at pc + 1) is read in by get_pmem -- State 4 Pulse 2 - If pc was updated, the new pc addr is stored by -- process get_pmem. Otherwise, addr for pc + 2 is -- stored. -- State 5 Pulse 1 - The new pmem data (s4p1) is read by process main, if -- necessary, and operations performed. pc updated -- -- Last cycle of a multi-cycle opcode: -- State 1 Pulse 1 - The pc has not been changed since this opcode -- was deciphered, so the next byte of pmem (at pc + 2) -- is read by process get_pmem. -- State 1 Pulse 2 - The next address (pc + 3) is stored for later use -- in process get_pmem. -- State 2 Pulse 1 - The byte of s1p1 is read in by process main, and -- any operations performed -- pc is now updated -- State 4 Pulse 1 - The next data (pc + 4) is read by process get_pmem -- State 4 Pulse 2 - The new pc is read and stored for output. -- State 5 Pulse 1 - The opcode should be done by now! -- if(first_inst and init_done) then -- pc <= "0000000000000000"; -- first_inst := FALSE; -- end if; -- set init values IF NOT init_done THEN set_sfr; reset_pmem <= '1'; pc <= "0000000000000000"; -- Set any signals driven from this process to 'Z' p0_addr <= "ZZZZZZZZ"; p2_addr <= "ZZZZZZZZ"; p0_ctrl <= 'Z'; p2_ctrl <= 'Z'; rd_n_internal <= '1'; wr_n_internal <= '1'; WAIT UNTIL cycle_state = s4p1; init_done := TRUE; reset_pmem <= '0'; END IF; WAIT UNTIL cycle_state = s2p1; -- When a data / addr value is written to P0, then it is -- reset to all 1's. The get_pmem process cannot do that -- by itself, so we will implement that here. IF p0_reset = '1' THEN p0_latch <= "11111111"; p0_reset_ack <= '1'; END IF; IF p0_reset = '0' THEN p0_reset_ack <= '0'; END IF; -- The parity bit (bit 0 of PSW) is automatically set / cleared -- to indicate an odd / even number of 1's in acc temp_int := 0; FOR k IN acc'RANGE LOOP temp_int := conv_integer(acc(k)) + temp_int; END LOOP; IF (temp_int MOD 2 = 1) THEN PSW(0) <= '1'; ELSE PSW(0) <= '0'; END IF; ------------INTERRUPTS------------------ -- Check to see if an interrupt needs to be processed -- Only check for serial at the moment IF ea = '1' AND ( (en_serial = '1' AND (trans_int = '1' OR recv_int = '1')) OR -- serial (en_t1 = '1' AND timer1_int = '1') OR -- timer1 (en_x1 = '1' AND int0_n_internal = '0') OR -- ext 1 -- (en_t0 = '1' AND timer0_int = '1') OR -- timer0 (en_x0 = '1' AND int1_n_internal = '0') ) THEN -- ext 0 -- disable interrupts -- mrm this isn't quite right, unless all are same priority level ea <= '0'; -- LCALL WAIT UNTIL cycle_state = s2p1; -- wait for next cycle temp_pc := pc; set_byte_dmem(sp + 1, temp_pc(7 DOWNTO 0), indirect); set_byte_dmem(sp + 2, temp_pc(15 DOWNTO 8), indirect); sp <= sp + 2; -- update stack pointer to point to the new data -- determine the new PC in order of same-level priority IF (en_x0 = '1' AND int1_n_internal = '0') THEN -- ext 0 pc <= "0000000000000011"; -- 03 -- ELSIF (en_t0 = '1' AND timer0_int = '1') THEN -- pc <= "0000000000001011"; -- 0B ELSIF (en_x1 = '1' AND int0_n_internal = '0') THEN pc <= "0000000000010011"; -- 13 ELSIF (en_t1 = '1' AND timer1_int = '1') THEN pc <= "0000000000011011"; -- 1B ELSIF (en_serial = '1' AND (trans_int = '1' OR recv_int = '1')) THEN pc <= "0000000000100011"; -- 23 END IF; WAIT UNTIL cycle_state = s4p1; ELSE -- NO INTERRUPTS -- Read in the next opcode (at s2p1) opcode := pmem_s1_byte; IF bad_data = '1' THEN pc_int := conv_integer(pc); REPORT "ERROR: COULD NOT READ OPCODE - X's read from memory. PC is " & integer'image(pc_int) & "d" SEVERITY error; END IF; -- The opcode is converted to an 8bit integer CASE smallint(conv_integer(opcode)) IS -- ACALL: absolute call WHEN 16#11# | 16#31# | 16#51# | 16#71# | 16#91# | 16#B1# | 16#D1# | 16#F1# => --cycle cycles := 2; pc <= pc + 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle set_byte_dmem(sp + 1, pc(7 DOWNTO 0), indirect); set_byte_dmem(sp + 2, pc(15 DOWNTO 8), indirect); sp <= sp + 2; pc <= pc(15 DOWNTO 11) & opcode(7 DOWNTO 5) & pmem_s4_byte; -- AJMP: Absolute Jump WHEN 16#01# | 16#21# | 16#41# | 16#61# | 16#81# | 16#A1# | 16#C1# | 16#E1# => --cycle cycles := 2; pc <= pc + 2; WAIT UNTIL cycle_state = s2p1; -- wait for the next cycle pc <= pc(15 DOWNTO 11) & opcode(7 DOWNTO 5) & pmem_s4_byte; -- NOP: No operation WHEN 16#00# => --cycle cycles := 1; pc <= pc + 1; -- MOV A, Rn WHEN 16#E8# to 16#EF# => --cycle cycles := 1; pc <= pc + 1; acc <= get_reg(opcode(2 DOWNTO 0)); -- MOV A, data addr WHEN 16#E5# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; acc <= get_byte_dmem(pmem_s4_byte, direct); -- MOV A, @Ri WHEN 16#E6# TO 16#E7# => --cycle cycles := 1; pc <= pc + 1; temp1 := get_reg("00"&opcode(0)); -- indirect src addr acc <= get_byte_dmem(temp1, indirect); -- MOV A, #data WHEN 16#74# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; acc <= pmem_s4_byte; -- MOV Rn, A WHEN 16#F8# TO 16#FF# => --cycle cycles := 1; pc <= pc + 1; set_reg(opcode(2 DOWNTO 0), acc); -- MOV Rn, data addr WHEN 16#A8# TO 16#AF# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait to next cycle pc <= pc + 2; temp1 := get_byte_dmem(pmem_s4_byte, direct); -- src data set_reg(opcode(2 DOWNTO 0), temp1); -- set to reg. -- MOV Rn, #data WHEN 16#78# TO 16#7F# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; set_reg(opcode(2 DOWNTO 0), pmem_s4_byte); -- MOV data addr, A WHEN 16#F5# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; set_byte_dmem(pmem_s4_byte, acc, direct); -- MOV data addr, Rn WHEN 16#88# TO 16#8F# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait to next cycle pc <= pc + 2; temp1 := get_reg(opcode(2 DOWNTO 0)); -- src data from Rn set_byte_dmem(pmem_s4_byte, temp1, direct); -- MOV direct, direct WHEN 16#85# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 3; temp1 := get_byte_dmem(pmem_s4_byte, direct); -- the data at source addr set_byte_dmem(pmem_s1_byte, temp1, direct); -- set to dest addr -- MOV direct, @Ri WHEN 16#86# TO 16#87# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 2; temp1 := get_reg("00" & opcode(0)); -- indirect src addr temp2 := get_byte_dmem(temp1, indirect); -- src data at addr @Ri set_byte_dmem(pmem_s4_byte, temp2, direct); -- MOV direct, #data WHEN 16#75# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 3; set_byte_dmem(pmem_s4_byte, pmem_s1_byte, direct); -- MOV @Ri, A WHEN 16#F6# TO 16#F7# => --cycle cycles := 1; pc <= pc + 1; temp1 := get_reg("00"&opcode(0)); -- indirect dest addr set_byte_dmem(temp1, acc, indirect); -- MOV @Ri, direct WHEN 16#A6# TO 16#A7# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for the next cycle pc <= pc + 2; temp1 := get_reg("00"&opcode(0)); -- the indirect dest addr temp2 := get_byte_dmem(pmem_s4_byte, direct); -- the src byte set_byte_dmem(temp1, temp2, indirect); -- MOV @Ri, #data WHEN 16#76# TO 16#77# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; -- wait for data temp1 := get_reg("00"&opcode(0)); -- the indirect dest addr set_byte_dmem(temp1, pmem_s4_byte, indirect); -- MOV DPTR, #data16 WHEN 16#90# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 3; dph <= pmem_s4_byte; dpl <= pmem_s1_byte; -- MOV bit addr, C WHEN 16#92# => --cycle cycles := 2 WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 2; set_bit_dmem(pmem_s4_byte,cy); -- MOV C, bit addr WHEN 16#A2# => --cycle cycles := 1 pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; cy <= get_bit_dmem(pmem_s4_byte); -- MOVC A, @A + DPTR WHEN 16#93# => --cycle cycles := 2; temp1 := PC(15 DOWNTO 8); temp2 := PC(7 DOWNTO 0); -- Set the program counter, so that the addr will go out at s4p2, -- and the new data come in at s1p1 of next cycle pc(7 DOWNTO 0) <= acc + dpl; IF conv_integer(acc)+conv_integer(dpl) > 255 THEN pc(15 DOWNTO 8) <= dph + 1; ELSE pc(15 DOWNTO 8) <= dph; END IF; WAIT UNTIL cycle_state = s2p1; acc <= pmem_s1_byte; pc <= temp1 & temp2 + 1; -- MOVC A, @A + PC WHEN 16#83# => --cycle cycles := 2; temp1 := PC(15 DOWNTO 8); temp2 := PC(7 DOWNTO 0); -- Set the program counter, so that the addr will go out at s4p2, -- and the new data come in at s1p1 of next cycle pc <= (acc+pc); WAIT UNTIL cycle_state = s2p1; acc <= pmem_s1_byte; pc <= temp1 & temp2 + 1; -- MOVX A, @Ri WHEN 16#E2# TO 16#E3# => temp1 := get_reg("00"&opcode(0)); -- the addr p0_latch <= "11111111"; -- reset the p0 sfr p0_addr <= temp1; -- send out addr when p0_ctrl WAIT UNTIL cycle_state = s3p1; port_req <= '1'; WAIT UNTIL cycle_state = s4p2; ale_dm <= '1'; WAIT UNTIL cycle_state = s5p1; p0_ctrl <= '1'; p3_ctrl(7) <= '1'; WAIT UNTIL cycle_state = s5p2; ale_dm <= '0'; WAIT UNTIL cycle_state = s1p1; rd_n_internal <= '0'; p0_ctrl <= 'Z'; WAIT UNTIL cycle_state = s3p1; -- read into the accumulator acc <= bvec(to_X01(P0)); WAIT UNTIL cycle_state = s4p1; rd_n_internal <= '1'; port_req <= '0'; p3_ctrl(7) <= 'Z'; p0_addr <= "ZZZZZZZZ"; pc <= pc + 1; -- MOVX A, @DPTR WHEN 16#E0# => p0_latch <= "11111111"; -- reset the p0 latch WAIT UNTIL cycle_state = s3p1; port_req <= '1'; WAIT UNTIL cycle_state = s4p2; ale_dm <= '1'; WAIT UNTIL cycle_state = s5p1; p0_addr <= dpl; -- send out the addr -- changed p0 to p2 in the next line p2_addr <= dph; -- send out the addr p0_ctrl <= '1'; p2_ctrl <= '1'; p3_ctrl(7) <= '1'; WAIT UNTIL cycle_state = s5p2; ale_dm <= '0'; WAIT UNTIL cycle_state = s1p1; rd_n_internal <= '0'; p0_ctrl <= 'Z'; WAIT UNTIL cycle_state = s3p1; -- read into the accumulator acc <= bvec(to_X01(P0)); WAIT UNTIL cycle_state = s4p1; rd_n_internal <= '1'; port_req <= '0'; p0_addr <= "ZZZZZZZZ"; p2_ctrl <= 'Z'; p3_ctrl(7) <= 'Z'; pc <= pc + 1; -- MOVX @Ri, A WHEN 16#F2# TO 16#F3# => temp1 := get_reg("00"&opcode(0)); -- the addr p0_latch <= "11111111"; -- reset the p0 latch WAIT UNTIL cycle_state = s3p1; port_req <= '1'; WAIT UNTIL cycle_state = s4p2; ale_dm <= '1'; WAIT UNTIL cycle_state = s5p1; p0_addr <= temp1; -- send out the addr p0_ctrl <= '1'; p3_ctrl(6) <= '1'; WAIT UNTIL cycle_state = s5p2; ale_dm <= '0'; WAIT UNTIL cycle_state = s6p2; p0_addr <= acc; -- output the data WAIT UNTIL cycle_state = s1p1; wr_n_internal <= '0'; WAIT UNTIL cycle_state = s4p1; wr_n_internal <= '1'; port_req <= '0'; -- shouldn't have any effect until s4p2 p0_ctrl <= 'Z'; p3_ctrl(6) <= 'Z'; p0_addr <= "ZZZZZZZZ"; pc <= pc + 1; -- MOVX @DPTR, A WHEN 16#F0# => p0_latch <= "11111111"; -- reset the p0 latch WAIT UNTIL cycle_state = s3p1; port_req <= '1'; WAIT UNTIL cycle_state = s4p2; ale_dm <= '1'; WAIT UNTIL cycle_state = s5p1; p0_addr <= dpl; -- send out the addr p2_addr <= dph; -- send out the addr p0_ctrl <= '1'; p2_ctrl <= '1'; p3_ctrl(6) <= '1'; WAIT UNTIL cycle_state = s5p2; ale_dm <= '0'; WAIT UNTIL cycle_state = s6p2; p0_addr <= acc; -- output the data WAIT UNTIL cycle_state = s1p1; wr_n_internal <= '0'; WAIT UNTIL cycle_state = s4p1; wr_n_internal <= '1'; port_req <= '0'; -- shouldn't have any effect until s4p2 p0_ctrl <= 'Z'; p2_ctrl <= 'Z'; p3_ctrl(6) <= 'Z'; p0_addr <= "ZZZZZZZZ"; p2_addr <= "ZZZZZZZZ"; pc <= pc + 1; -- LJMP: Long Jump WHEN 16#02# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for the next cycle pc <= pmem_s4_byte & pmem_s1_byte; -- RR: Rotate acc right WHEN 16#03# => --cycle cycles := 1; pc <= pc + 1; acc <= acc(0) & acc(7 DOWNTO 1); -- INC: Acc WHEN 16#04# => --cycle cycles := 1; pc <= pc + 1; acc <= acc + 1; -- INC: direct address WHEN 16#05# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); set_byte_dmem(pmem_s4_byte, temp1 + 1, direct); -- INC: @Ri WHEN 16#06# TO 16#07# => --cycle cycles := 1; pc <= pc + 1; temp1 := get_reg("00"&opcode(0)); -- the indirect address temp2 := get_byte_dmem(temp1, indirect); -- the data at indirect addr set_byte_dmem(temp1, temp2 + 1, indirect); -- INC: Reg WHEN 16#08# TO 16#0F# => --cycle cycles := 1; pc <= pc + 1; set_reg(opcode(2 DOWNTO 0), get_reg(opcode(2 DOWNTO 0)) + 1); -- JBC: Jump if Bit set and Clear bit WHEN 16#10# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for the next cycle IF get_bit_dmem(pmem_s4_byte, read_latch => TRUE) = '1' THEN temp_int := conv_signed_to_int(pmem_s1_byte); pc <= pc + 3 + temp_int; ELSE pc <= pc + 3; END IF; set_bit_dmem(pmem_s4_byte, '0'); -- LCALL: long call WHEN 16#12# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle temp_pc := pc + 3; set_byte_dmem(sp + 1, temp_pc(7 DOWNTO 0), indirect); set_byte_dmem(sp + 2, temp_pc(15 DOWNTO 8), indirect); sp <= sp + 2; -- update stack pointer to point to the new data pc <= pmem_s4_byte & pmem_s1_byte; -- RRC: Rotate acc right through carry flag WHEN 16#13# => --cycle cycles := 1; pc <= pc + 1; acc <= cy & acc(7 DOWNTO 1); cy <= acc(0); -- DEC: Acc WHEN 16#14# => --cycle cycles := 1; pc <= pc + 1; acc <= acc - 1; -- DEC: direct address WHEN 16#15# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); set_byte_dmem(pmem_s4_byte, temp1 - 1, direct); -- DEC: @Ri WHEN 16#16# TO 16#17# => --cycle cycles := 1; pc <= pc + 1; temp1 := get_reg("00"&opcode(0)); -- indirect addr temp2 := get_byte_dmem(temp1, indirect); set_byte_dmem(temp1, temp2 - 1, indirect); -- DEC: Reg WHEN 16#18# TO 16#1F# => --cycle cycles := 1; pc <= pc + 1; set_reg(opcode(2 DOWNTO 0), get_reg(opcode(2 DOWNTO 0)) - 1); -- JB: Jump if bit set WHEN 16#20# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF get_bit_dmem(pmem_s4_byte) = '1' THEN temp_int := conv_signed_to_int(pmem_s1_byte); pc <= pc + 3 + temp_int; ELSE pc <= pc + 3; END IF; -- RET: Return from subroutine WHEN 16#22# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc(15 DOWNTO 8) <= get_byte_dmem(sp, indirect); -- Take from the stack pc(7 DOWNTO 0) <= get_byte_dmem(sp-1, indirect); sp <= sp - 2; -- Update stack pointer to point to the new data -- RL: Rotate accumulator left WHEN 16#23# => --cycle cycles := 1; pc <= pc + 1; acc <= acc(6 DOWNTO 0) & acc(7); -- ADD Acc WHEN 16#24# TO 16#2F# => --cycle cycles := 1; handle_add(opcode,'0'); -- Use a separate procedure, ignoring cy bit -- JNB: Jump if bit not set WHEN 16#30# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF get_bit_dmem(pmem_s4_byte) = '0' THEN temp_int := conv_signed_to_int(pmem_s1_byte); pc <= pc + 3 + temp_int; ELSE pc <= pc + 3; END IF; -- RETI: Return from interrupt WHEN 16#32# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc(15 DOWNTO 8) <= get_byte_dmem(sp, indirect); -- Take from the stack pc(7 DOWNTO 0) <= get_byte_dmem(sp-1, indirect); sp <= sp - 2; -- Update stack pointer to point to the new data -- ALSO NEEDS TO TURN INTERRUPTS BACK ON ea <= '1'; -- RLC Acc: Rotate Left through Carry WHEN 16#33# => --cycle cycles := 1; pc <= pc + 1; acc <= acc(6 DOWNTO 0) & cy; cy <= acc(7); -- ADDC: Add to the acc with carry WHEN 16#34# TO 16#3F# => --cycle cycles := 1; handle_add(opcode,cy); -- Use a separate procedure, using cy bit -- JC: Jump if carry is set WHEN 16#40# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF cy='1' THEN temp_int := conv_signed_to_int(pmem_s4_byte); pc <= pc + 2 + temp_int; ELSE pc <= pc + 2; END IF; -- ORL to data mem from acc WHEN 16#42# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); set_byte_dmem(pmem_s4_byte, temp1 OR acc, direct); -- ORL to data mem from immediate data WHEN 16#43# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); -- the data value set_byte_dmem(pmem_s4_byte, temp1 OR pmem_s1_byte, direct); pc <= pc + 3; -- ORL to acc WHEN 16#44# TO 16#4F# => --cycle cycles := 1; pc <= pc + 1 + advance_pc(opcode); WAIT UNTIL cycle_state = s5p1; get_data(opcode, temp1, read_latch => TRUE); -- get second operand and update PC acc <= acc OR temp1; -- ORL to Carry, bit address WHEN 16#72# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 2; cy <= cy OR get_bit_dmem(pmem_s4_byte); -- ORL to Carry, bit address (using complement) WHEN 16#A0# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 2; cy <= cy OR NOT get_bit_dmem(pmem_s4_byte); -- JNC: Jump if carry not set WHEN 16#50# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF cy='0' THEN temp_int := conv_signed_to_int(pmem_s4_byte); pc <= pc + 2 + temp_int; ELSE pc <= pc + 2; END IF; -- ANL: And to data mem from acc WHEN 16#52# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); -- data value set_byte_dmem(pmem_s4_byte, temp1 AND acc, direct); -- ANL And to data mem from #data WHEN 16#53# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 3; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); -- byte of data mem set_byte_dmem(pmem_s4_byte, temp1 AND pmem_s1_byte, direct); -- ANL: And to acc WHEN 16#54# TO 16#5F# => --cycle cycles := 1; pc <= pc + 1 + advance_pc(opcode); WAIT UNTIL cycle_state = s5p1; get_data(opcode, temp1, read_latch => TRUE); -- get second operand acc <= acc AND temp1; -- ANL to Carry, bit address WHEN 16#82# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- Wait for next cycle pc <= pc + 2; cy <= cy AND get_bit_dmem(pmem_s4_byte); -- ANL to Carry, bit address WHEN 16#B0# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- Wait for next cycle pc <= pc + 2; cy <= cy AND NOT get_bit_dmem(pmem_s4_byte); -- JZ: Jump if acc is zero WHEN 16#60# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- Wait for next cycle IF acc=unsigned'("00000000") THEN temp_int := conv_signed_to_int(pmem_s4_byte); pc <= pc + 2 + temp_int; ELSE pc <= pc + 2; END IF; -- XRL to data mem from acc WHEN 16#62# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); set_byte_dmem(pmem_s4_byte, temp1 XOR acc, direct); -- XRL to data mem from direct data WHEN 16#63# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- Wait for next cycle pc <= pc + 3; temp1 := get_byte_dmem(pmem_s4_byte, direct, read_latch => TRUE); set_byte_dmem(pmem_s4_byte, temp1 XOR pmem_s1_byte, direct); -- XRL to acc WHEN 16#64# TO 16#6F# => --cycle cycles := 1; pc <= pc + 1 + advance_pc(opcode); WAIT UNTIL cycle_state = s5p1; get_data(opcode, temp1, read_latch => TRUE); -- get second operand and update PC acc <= acc XOR temp1; -- JNZ: Jump if acc is not zero WHEN 16#70# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF acc/=unsigned'("00000000") THEN temp_int := conv_signed_to_int(pmem_s4_byte); pc <= pc + 2 + temp_int; ELSE pc <= pc + 2; END IF; -- JMP: @A + dptr WHEN 16#73# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= unsigned'(acc) + unsigned'(dph & dpl); -- SJMP: Short Jump WHEN 16#80# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle temp_int := conv_signed_to_int(pmem_s4_byte); pc <= pc + 2 + temp_int; -- DIV: Divide acc by b WHEN 16#84# => --cycle cycles := 4; FOR k in 2 to 4 LOOP -- make sure it takes 4 cycles WAIT UNTIL cycle_state = s2p1; END LOOP; pc <= pc + 1; IF b=unsigned'("00000000") THEN ov <= '1'; ELSE temp1 := acc; -- Since division is not defined in std_logic_arith, -- we'll convert to integer and back. acc <= conv_unsigned(conv_integer(acc) / conv_integer(b),8); b <= temp1 - acc * b; -- remainder ov <= '0'; END IF; cy <= '0'; -- SUBB: Subtract with borrow WHEN 16#94# TO 16#9F# => --cycle cycles:=1; handle_sub(opcode); -- handles subtraction -- Inc: dptr WHEN 16#A3# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 1; IF dpl = unsigned'("11111111") THEN dpl <= unsigned'("00000000"); dph <= dph + 1; ELSE dpl <= dpl + 1; END IF; -- MUL: AB WHEN 16#A4# => --cycle cycles := 4; FOR k in 2 to 4 LOOP -- make sure it takes 4 cycles WAIT UNTIL cycle_state = s2p1; END LOOP; pc <= pc + 1; temp_int := conv_integer(acc) * conv_integer(b); IF temp_int < 256 THEN acc <= conv_unsigned(temp_int,8); ov <= '0'; ELSE acc <= conv_unsigned(temp_int MOD 256, 8); -- low byte b <= conv_unsigned(temp_int / 256, 8); -- high byte ov <= '1'; END IF; cy <= '0'; -- reserved WHEN 16#A5# => NULL; -- CPL bit: Complement bit at bit address WHEN 16#B2# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; set_bit_dmem(pmem_s4_byte, NOT get_bit_dmem(pmem_s4_byte, read_latch => TRUE)); -- CPL C: Complement the carry bit WHEN 16#B3# => --cycle cycles := 1; pc <= pc + 1; cy <= NOT cy; -- CJNE A, direct addr, code addr: Compare and Jump if Not equal WHEN 16#B5# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF acc /= get_byte_dmem(pmem_s4_byte, direct) THEN temp_int := conv_signed_to_int(pmem_s1_byte); pc <= pc + 3 + temp_int; ELSE pc <= pc + 3; END IF; -- Set the carry flag if the dest_byte is less than the src_byte IF acc < get_byte_dmem(pmem_s4_byte, direct) THEN cy <= '1'; ELSE cy <= '0'; END IF; -- CJNE A, #data, code addr: Compare and Jump if Not equal WHEN 16#B4# | 16#B6# TO 16#BF# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle IF opcode(3 DOWNTO 0)=unsigned'("0100") THEN temp1 := acc; ELSIF opcode(3)='1' THEN temp1 := get_reg(opcode(2 DOWNTO 0)); ELSE temp1 := get_byte_dmem(get_reg("00"&opcode(0)), indirect); END IF; IF temp1 /= pmem_s4_byte THEN temp_int := conv_signed_to_int(pmem_s1_byte); pc <= pc + 3 + temp_int; ELSE pc <= pc + 3; END IF; -- Set the carry flag if the dest_byte is less than the src_byte IF temp1 < pmem_s4_byte THEN cy <= '1'; ELSE cy <= '0'; END IF; -- PUSH: Push onto stack WHEN 16#C0# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- wait for next cycle pc <= pc + 2; temp1 := get_byte_dmem(pmem_s4_byte, direct); set_byte_dmem(sp + 1, temp1, indirect); sp <= sp + 1; -- CLR: Clear bit address WHEN 16#C2# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; set_bit_dmem(pmem_s4_byte, '0'); -- CLR C: Clear the carry bit WHEN 16#C3# => --cycle cycles := 1; pc <= pc + 1; cy <= '0'; -- SWAP A: Swap nibbles within the accumulator WHEN 16#C4# => --cycle cycles := 1; pc <= pc + 1; temp1 := acc; acc(7 DOWNTO 4) <= temp1(3 DOWNTO 0); acc(3 DOWNTO 0) <= temp1(7 DOWNTO 4); -- XCH: Exchange accumulator with Rn WHEN 16#C8# TO 16#CF# => --cycle cycles := 1; pc <= pc + 1; WAIT UNTIL cycle_state=s5p1; acc <= get_reg(opcode(2 DOWNTO 0)); set_reg(opcode(2 DOWNTO 0), acc); -- XCH: Exchange acc with a direct addr WHEN 16#C5# => pc <= pc + 2; WAIT UNTIL cycle_state=s5p1; acc <= get_byte_dmem(pmem_s4_byte, direct); set_byte_dmem(pmem_s4_byte, acc, direct); -- XCH: Exchange acc with an indirect addr WHEN 16#C6# TO 16#C7# => pc <= pc + 1; WAIT UNTIL cycle_state=s5p1; temp2 := get_reg("00" & opcode(0)); -- indirect addr acc <= get_byte_dmem(temp2, indirect); set_byte_dmem(temp2, acc, indirect); -- POP: Pop from stack WHEN 16#D0# => --cycle cycles := 2; WAIT UNTIL cycle_state = s2p1; -- Wait for next cycle pc <= pc + 2; temp1 := get_byte_dmem(sp, indirect); set_byte_dmem(pmem_s4_byte, temp1, direct); sp <= sp - 1; -- SETB: Set bit address WHEN 16#D2# => --cycle cycles := 1; pc <= pc + 2; WAIT UNTIL cycle_state = s5p1; set_bit_dmem(pmem_s4_byte, '1'); -- SETB C: Set the carry bit WHEN 16#D3# => --cycle cycles := 1; pc <= pc + 1; cy <= '1'; -- DA : Decimal Adjust (for BCD adjusting after an ADD or