-- \ Dual language RTL model of the CD16 CPU.
-- \ Author: Brad Eckert
-- \ revision: 4
-- \ Even free stuff needs lawyer repellant:
-- \ ----------------------------------------------------------------------------------------------------------- \
-- \ Copyright (C) 2003 Brad Eckert brad@tinyboot.com \
-- \ \
-- \ This source file may be used and distributed without restriction provided that this copyright statement is \
-- \ not removed from the file and that any derivative work contains the original copyright notice and the \
-- \ associated disclaimer. \
-- \ \
-- \ THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT \
-- \ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. 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. \
-- \ ----------------------------------------------------------------------------------------------------------- \
-- \ This model can be simulated with either a 32-bit ANS Forth or a VHDL simulator. The code to the left of '--'
-- \ is intended to be ignored by the Forth interpreter. The code to the right is ignored by the VHDL tool.
-- \ Structures are expressed side by side in both languages so as to comment each other. The Forth model
-- \ represents bits and vectors in a less rigorous way, so it can simulate much faster than the VHDL model.
-- \ 8pt Courier allows 115 columns on Letter paper. Let VHDL comments begin at column 49, leaving 67 columns
-- \ for Forth. A screen resolution of 1024x768 or better is desirable when editing or browsing this file.
library ieee;
use ieee.std_logic_1164.all;
use ieee.std_logic_arith.all;
use ieee.std_logic_unsigned.all;
use work.CD16pkg.all;
entity CD16 is
port(reset, clk: in std_logic; -- \ reset the CPU, master clock
hold: in std_logic; -- ' undef in: hold \ insert wait states
int: in std_logic_vector(7 downto 1); -- ' undef in: int \ interrupt trigger
ya,yb: in cell; -- \ Data from Stack DPRAM (already defined)
ia,ib: out cell; -- \ Data to Stack DPRAM
aa,ab: out std_logic_vector(spwidth-1 downto 0); -- \ Stack DPRAM address
wa,wb: out std_logic; -- \ Stack DPRAM write enables
ra,rb: out std_logic; -- \ Stack DPRAM read enables
py: out cell; -- \ Data to program space
pi: in cell; -- ' undef in: pi \ Data from program space
pa: out cell; -- \ Program space address
pbank: out std_logic_vector(5 downto 0); -- \ Program bank select
wp: out std_logic; -- \ write to program memory, sync write
dy: out cell; -- \ Data to data space
di: in cell; -- ' undef in: di \ Data from data space
da: out cell; -- \ Data space address
wd: out std_logic; -- \ write to data memory, sync write
rd: out std_logic; -- \ data mem read-enable, sync read
CPA: in cell; -- ' undef in: CPA
CPO: in cell; -- ' undef in: CPO
CPctrl: out std_logic_vector(6 downto 0); -- w: CPctl
t_P,t_IR,t_W: out cell;
t_SP,t_RP: out std_logic_vector(spwidth-1 downto 0); -- \ debugging vectors
t_cv: out std_logic_vector(1 downto 0));
end CD16;
-- n 2^n mask &sign ( sign bit mask ) -1 &sign 1- CONSTANT maxint
-- n 3 + 2^n mask &carry ( ALU carry-out mask ) n 3 - 2^n 1- mask &brdisp
-- n 1+ 2^n 1- mask &cell ( cell-wide mask ) n 4 - 2^n CONSTANT brsign
-- n 1+ 2^n mask &sign+1 ( W register sign bit ) n 2 + 2^n 1- mask &cell+1
architecture behavioral of CD16 is
constant zro: std_logic_vector(n downto 1) := (others=>'0'); -- \ 0
-- \ registers may be changed to arrays for instant context switching
signal SP,RP: std_logic_vector(spwidth-1 downto 0); -- r: SP r: RP \ stack pointers
signal P: cell; -- r: P \ program counter
signal IR: cell; -- r: IR \ instruction reg
signal W: std_logic_vector(n+1 downto 0); -- r: W \ W reg
signal cf,ov: std_logic; -- r: cf r: ov \ carry flag, overflow flag
signal sleep: std_logic; -- r: sleep \ sleep until interrupt
signal reps: std_logic_vector(4 downto 0); -- r: reps \ REP counter
signal bank: std_logic_vector(5 downto 0); -- r: bank \ Program bank select
signal resetd: std_logic; -- r: resetd \ buffered reset line
-- \ interrupt logic
signal drowsy: std_logic; -- w: drowsy \ trigger sleep mode
signal iack: std_logic; -- w: iack \ interrupt just acknowledged
signal intd, IRQpend: std_logic_vector (7 downto 1); -- r: intd r: IRQpend
signal ipl: std_logic_vector (2 downto 0);
-- \ stack addressing logic
signal wrena, wrenb: std_logic; -- w: wrena w: wrenb \ stack memory write enable
signal rdena, rdenb: std_logic; -- w: rdena w: rdenb \ stack memory read enable
signal ssel: std_logic; -- w: ssel \ select 0=SP, 1=RP (addresses A)
signal predec: std_logic; -- w: predec \ predec selected stack pointer
signal postinc: std_logic; -- w: postinc \ postinc selected stack pointer
signal xbump: std_logic; -- w: xbump \ postinc by signed offset
signal xen, selcon: std_logic; -- \ latch enable SP/RP, select +/- 1
signal yax: std_logic; -- w: yax \ route YA to XP if enabled
signal rex: std_logic; -- w: rex \ enable extended Rstack addressing
signal xpxs: std_logic;
signal xpsx: std_logic_vector(spwidth-7 downto 0); -- \ sign extension for SP displacement
signal cons1: std_logic_vector(spwidth-2 downto 0); -- \ sign extension for constant +/- 1
signal XP,spin: std_logic_vector(spwidth-1 downto 0); -- \ selected ptr for A
signal xfb, offa, para, xpx: std_logic_vector(spwidth-1 downto 0); -- \ inter-mux busses
type iaselect is (ia_p, ia_w, ia_xp, ia_c, ia_uo, ia_pi, ia_di); -- $ ia_p $ ia_w $ ia_xp $ ia_c $ ia_uo
signal iasel: iaselect; -- w: iasel $ ia_pi $ ia_di
type ibselect is (ib_uo, ib_cp, ib_ya); -- $ ib_uo $ ib_cp $ ib_ya
signal ibsel: ibselect; -- w: ibsel
signal div: std_logic; -- w: div \ enable divider latch
-- \ P register
signal pin, brdis: cell; -- \ P in, signed branch displacement
type pselect is (p_bump, p_ir, p_ya); -- $ p_bump $ p_ir $ p_ya
signal psel: pselect; -- w: psel \ src = P+1, P+IR, IR, YA
signal bran: std_logic; -- w: bran \ 1: P adder uses displacement brdis
signal stall: std_logic; -- w: stall \ 1: don't bump PC
signal repen, repeating: std_logic; -- w: repen \ 1: load REP counter
signal banken: std_logic; -- w: banken \ 1: load BANK register
-- \ W register
signal win: std_logic_vector(n+1 downto 0); -- \ pending W (if wen=1)
signal wm: std_logic_vector(1 downto 0); -- w: wm \ W source
signal wen: std_logic; -- w: wen \ latch enable W
-- \ ALU inputs A and B \ ALU inputs A and B
signal ub,ua,uo,uol,iacond: cell;
signal ubm: std_logic_vector(3 downto 0); -- w: ubm \ B = shiftop(YB,ubm)
signal uam: std_logic; -- w: uam \ A = const, YA1
signal uas: std_logic; -- w: uas \ YA1 = YA, YA>>8
signal mul, uasel, ubc, nz: std_logic; -- w: mul \ input A is in multiplier mode
signal sub: std_logic; -- w: sub \ force ALU carry in to '1'
signal aluop: std_logic_vector(2 downto 0); -- w: aluop \ +, C+, +C, C+C, A, A&B, A!B, A^B
signal uoa: std_logic_vector(n+3 downto 0); -- \ adder result with carry in and carry out
signal acsx: std_logic_vector(n downto 2); -- \ 14-bit A constant sign extension
signal acon: std_logic_vector(1 downto 0); -- w: acon \ A constant = 0, 1, 2, -1
signal ya1, aconst: cell; -- \ A possible inputs
-- \ carry flag
signal cin, uci: std_logic;
signal cm: std_logic_vector(1 downto 0); -- w: cm \ src = cf, carry(A+B), YB(n), YB(0)
signal cen: std_logic; -- w: cen \ carry latch enable
-- \ IR and branch
signal flush: std_logic; -- w: flush \ discard data on the instruction bus
signal flushIR: cell; -- w: flushIR \ the pending "nop"
signal condition: std_logic; -- \ condition(IR11:IR8)
signal dissx: std_logic_vector(n downto 12); -- \ sign extension for branch displacement
-- \ Program memory
signal pasel: std_logic; -- w: pasel \ program address
signal pw: std_logic; -- w: pw \ prog write enable
-- \ Data memory
type aselect is (a_cp, a_yb, a_pi); -- $ a_cp $ a_yb $ a_pi
signal dasel: aselect; -- w: dasel \ select data memory address
signal dw, drd: std_logic; -- w: dw w: drd \ data write enable, read enable
begin
ipl <= "001" when IRQpend(1) = '1' else -- \ interrupt priority encoder: level 1 is highest priority
"010" when IRQpend(2) = '1' else -- : ipl ( -- n ) IRQpend DUP IF \ {2}
"011" when IRQpend(3) = '1' else -- DUP 0F0 AND 0<> 4 AND
"100" when IRQpend(4) = '1' else -- OVER 0CC AND 0<> 2 AND +
"101" when IRQpend(5) = '1' else -- SWAP 0AA AND 0<> 1 AND +
"110" when IRQpend(6) = '1' else -- THEN ;
"111" when IRQpend(7) = '1' else "000";
nz <= W(16) or W(15) or W(14) or W(13) -- : nz ( -- bit ) W -2 AND 0<> 1 AND ; \ '1' if W<>0
or W(12) or W(11) or W(10) or W(9) -- : w(n+1) ( -- bit ) W &sign+1 0<> 1 AND ; \ sign of W
or W(8) or W(7) or W(6) or W(5) -- : w(n) ( -- bit ) W &sign 0<> 1 AND ; \ sign of W/2
or W(4) or W(3) or W(2) or W(1); -- : bit? ( mask -- bit ) AND 0<> 1 AND ;
-- : inv ( bit -- !bit ) INVERT 1 AND ; \ flip bit
-- : hialu ( n bit -- n' ) n 2 + lshift OR ; \ adder hi bit
repeating <= '0' when reps="00000" else '1';
-- : repeating ( -- f ) reps 0<> 1 AND ;
xen <= predec or postinc or xbump; -- : xen ( -- f ) predec postinc xbump OR OR ;
XP <= RP when ssel='1' else SP; -- : XP ( -- ptr ) ssel IF RP ELSE SP THEN ;
xpsx <= (others => (xbump and IR(9))); -- : xpsx ( -- sext ) xbump 0<> IR 200 AND 0<> AND ;
para <= xpsx & IR(9 downto 4) when rex='1' -- : para ( -- n ) IR 4 RSHIFT rex
else zro(spwidth downto 5)&IR(7 downto 4); -- IF 03F AND xpsx -40 AND OR ELSE 0F AND THEN &sa ;
cons1 <= (others => predec);
selcon <= (postinc and (not xbump)) or predec;
offa <= cons1&'1' when selcon='1' -- : offa ( -- n ) postinc xbump 0= AND predec OR
else para; -- IF predec IF -1 ELSE 1 THEN &sa ELSE para THEN ;
xfb <= (XP + offa); -- : xfb ( -- n ) XP offa + &sa ;
xpxs <= IR(7) and (not xen) and (not rex); -- : xpxs ( -- f ) IR 80 bit? xen 0= AND rex 0= AND ;
xpx <= zro(spwidth downto 4)&IR(6 downto 4) --
when xpxs='1' else XP; -- : xpx ( --f ) xpxs IF IR 4 RSHIFT 7 AND ELSE XP THEN ;
aa <= zro(spwidth downto 5)&'1'&(not ipl) when iack='1' -- :noname ( -- n ) iack IF ipl 7 XOR 8 OR
else xfb when (postinc='0' and xpxs='0') -- ELSE postinc 0= xpxs 0= and
else xpx; -- IF xfb ELSE xpx THEN THEN ; is aa
ab <= zro(spwidth downto 4)&IR(2 downto 0)
when IR(3)='1' -- :noname ( -- n ) IR DUP 8 AND \ address of B param
else (SP + IR(2 downto 0)); -- IF 7 AND ELSE 7 AND SP + THEN ; is ab
-- : ybn@ ( -- bit ) yb &sign 0<> 1 AND ; \ sign bit of YB
dissx <= (others=>IR(n-4)); -- : dissx ( -- n ) IR brsign AND 0<> -1 &brdisp INVERT AND ;
brdis <= dissx&IR(n-4 downto 0) -- : brdis ( -- disp ) bran IF IR &brdisp dissx OR
when bran='1' -- ELSE stall resetd or repeating or 0= 1 AND THEN ;
else zro&(not(stall or resetd or repeating));
-- : yan@ ( -- bit ) ya &sign 0<> 1 AND ; \ sign bit of YA
with psel select -- : pin ( -- n ) psel CASE \ P input
pin <= P + brdis when p_bump, -- p_bump OF P brdis + ENDOF
IR(n-1 downto 0) & '0' when p_ir, -- p_ir OF IR maxint AND 2* ENDOF
YA when p_ya; -- p_ya OF ya ENDOF
-- ABORT" Invalid PSEL" ENDCASE ;
with ubm(1 downto 0) select -- : ubc ( -- bit ) ubm 3 and CASE \ shifter carry input
ubc <= '0' when "00", -- 0 OF 0 ENDOF
cf when "01", -- 1 OF cf ENDOF
W(n+1) when "10", -- 2 OF w(n+1) ENDOF
YB(n) when others; -- 3 OF ybn@ ENDOF
-- ENDCASE ;
with ubm(3 downto 2) select -- : ub ( -- n ) ubm 2 RSHIFT CASE \ ALU 'A' input
ub <= YB when "00", -- 0 OF YB ENDOF
(not YB) when "01", -- 1 OF YB INVERT &cell ENDOF
YB(n-1 downto 0) & ubc when "10", -- 2 OF YB 2* ubc OR &cell ENDOF
ubc & YB(n downto 1) when others; -- 3 OF YB 1 RSHIFT ubc n LSHIFT OR ENDOF
-- ABORT" Invalid UBM" ENDCASE ;
uasel <= W(n) when mul='1' else uam; -- : uasel ( -- bit ) mul IF w(n) ELSE uam THEN ;
acsx <= (others=>(acon(1) and acon(0))); -- CREATE aconsts 0 , 1 , 2 , -1 ,
aconst <= acsx & acon; -- : aconst ( -- n ) acon 3 AND CELLS aconsts + @ &cell ;
-- : swhalf ( n -- n' ) 2 n 2/ LSHIFT DUP >R /MOD SWAP R> * + ;
ya1 <= YA((n-1)/2 downto 0) -- : ya1 ( -- n ) YA uas \ swap hi & lo halves
& YA(n downto (n+1)/2) -- IF swhalf THEN ;
when uas='1' else YA; -- : ua ( -- n ) uasel \ ALU 'B' input
ua <= ya1 when uasel='1' else aconst; -- IF ya1 ELSE aconst THEN ;
with aluop(1 downto 0) select -- : uol ( -- n ) aluop 3 AND CASE \ logic part of ALU
uol <= ub when "00", -- 0 OF ub ENDOF
(ub and ua) when "01", -- 1 OF ub ua AND ENDOF
(ub or ua) when "10", -- 2 OF ub ua OR ENDOF
(ub xor ua) when others; -- 3 OF ub ua XOR ENDOF
-- ENDCASE ;
uci <= (cf and aluop(1) and aluop(0)) -- : uci ( -- bit ) aluop 3 AND 3 = cf AND sub OR ;
or sub;
uoa <= (('0'&div&ub&'1') -- : uoa ( -- n ) ub 2* 1 + div hialu \ adder part of ALU
+ ('0'&((not div) or cf)&ua&uci)); -- ua 2* uci +
-- div inv cf OR hialu + ;
uo <= uol when aluop(2)='1' -- : uo ( -- n ) aluop 4 AND IF uol \ output of ALU
else uoa(n+1 downto 1); -- ELSE uoa 2/ &cell THEN ;
with cm select -- : cin ( -- n ) cm CASE \ cf input
cin <= '0' when "00", -- 0 OF 0 ENDOF
uoa(n+3) when "01", -- 1 OF uoa &carry 0<> 1 AND ENDOF
YB(n) when "10", -- 2 OF ybn@ ENDOF
YB(0) when others; -- 3 OF YB 1 AND ENDOF
-- ABORT" Invalid CM" ENDCASE ;
with IR(11 downto 9) select
condition <= -- : condition ( -- f ) IR 9 RSHIFT 7 AND CASE
IR(8) xor '0' when "000", -- 0 OF 0 ENDOF
IR(8) xor (cf nand nz) when "001", -- 1 OF cf nz and inv ENDOF \ {1}
IR(8) xor cf when "010", -- 2 OF cf ENDOF
IR(8) xor (not nz) when "011", -- 3 OF nz inv ENDOF
IR(8) xor ov when "100", -- 4 OF ov ENDOF
IR(8) xor W(n+1) when "101", -- 5 OF w(n+1) ENDOF
IR(8) xor ((W(n+1) xor ov)) when "110", -- 6 OF ov w(n+1) xor ENDOF
IR(8) xor ((W(n+1) xor ov) -- 7 OF ov w(n+1) xor nz inv or ENDOF
or (not nz)) when others; -- ENDCASE IR 100 AND 0<> XOR 1 AND ;
iacond <= (others => condition); -- : iacond ( -- n ) condition 0<> &cell ;
spin <= YA(spwidth-1 downto 0) -- : spin ( -- n ) yax IF YA ELSE xfb THEN ; \ pending XP
when yax='1' else xfb;
with dasel select -- : da ( -- n ) dasel CASE
da <= PI when a_pi, -- a_pi OF PI ENDOF
CPA when a_cp, -- a_cp OF CPA ENDOF
YB when a_yb; -- a_yb OF YB ENDOF
-- ABORT" Invalid DASEL" ENDCASE ;
pa <= YB when pasel='1' else pin; -- : pa ( -- n ) pasel IF YB else pin THEN ;
pbank <= bank when pasel='1' -- : pbank ( -- n ) pasel IF bank else 0 THEN ; \ {3}
else (others=>'0'); -- \ Program memory read is banked. Program is limited to bank 0.
with iasel select -- :noname ( -- n ) iasel CASE \ DPRAM A input
ia <= PI when ia_pi, -- ia_pi OF PI ENDOF
DI when ia_di, -- ia_di OF DI ENDOF
uo when ia_uo, -- ia_uo OF uo ENDOF
iacond when ia_c, -- ia_c OF iacond ENDOF
zro(n downto spwidth)&XP when ia_xp, -- ia_xp OF XP ( unsigned ) ENDOF
W(n+1 downto 1) when ia_w, -- ia_w OF W 1 RSHIFT ENDOF
P when ia_p; -- ia_p OF P ENDOF
-- ABORT" Invalid IASEL" ENDCASE ; is ia
with ibsel select -- :noname ( -- n ) ibsel CASE \ DPRAM B input
ib <= uo when ib_uo, -- ib_uo OF uo ENDOF
CPO when ib_cp, -- ib_cp OF CPO ENDOF
YA when ib_ya; -- ib_ya OF YA ENDOF
-- ABORT" Invalid IBSEL" ENDCASE ; is ib
with wm select -- : win ( -- n ) wm CASE \ W input
win <= uo & '0' when "00", -- 0 OF uo 2* ENDOF
'0' & uo when "01", -- 1 OF uo ENDOF
(W(n downto 0) + cf) & '0' when "10", -- 2 OF W cf + 2* ENDOF
(W(n downto 0) + cf) & YB(n) when others; -- 3 OF W cf + 2* ybn@ + ENDOF
-- ABORT" Invalid WM" ENDCASE &cell+1 ;
dy <= YA; -- : dy ( -- n ) YA ;
wb <= (div and uoa(n+3)) or wrenb; -- :noname ( -- bit ) uoa &carry 0<>
-- div AND wrenb OR ; is wb
wa <= wrena; -- :noname ( -- bit ) wrena ; is wa
ra <= rdena; -- :noname ( -- bit ) rdena ; is ra
rb <= rdenb; -- :noname ( -- bit ) rdenb ; is rb
py <= YA; -- : py ( -- n ) ya ;
wp <= pw; -- : wp ( -- n ) pw ;
wd <= dw; -- : wd ( -- n ) dw ;
rd <= drd; -- : rd ( -- n ) drd ;
-- : CPctrl ( -- n ) CPctl ;
-- DEFER opcodes DEFER miscops
decode: process(IR,condition,ipl) begin -- : getopcd ( -- op )
rdena <= '0'; rdenb <= '0'; -- 0 to rdena 0 to rdenb
uam<='0'; ubm<="0000"; wm<="00"; -- 0 to uam 0 to ubm 0 to wm \ default wire settings
aluop<="000"; rex<='0'; acon<="00"; -- 0 to aluop 0 to acon 0 to rex
predec<='0'; postinc<='0'; -- 0 to predec 0 to postinc
wrena<='0'; wrenb<='0'; -- 0 to wrena 0 to wrenb
flush<='0'; flushIR<=(others=>'0'); -- 0 to flush 0 to flushIR
pasel<='0'; pw<='0'; -- 0 to pasel 0 to pw
dasel<=a_yb; dw<='0'; -- a_yb to dasel 0 to dw
psel<=p_bump; banken<='0'; -- p_bump to psel 0 to banken
iasel<=ia_p; ibsel<=ib_uo; -- ia_p to iasel ib_uo to ibsel
xbump<='0'; yax<='0'; drd<='0'; -- 0 to xbump 0 to yax 0 to drd
div<='0'; mul<='0'; stall<='0'; -- 0 to div 0 to mul 0 to stall
bran<='0'; sub<='0'; -- 0 to bran 0 to sub
ssel<='0'; wen<='0'; repen<='0'; -- 0 to ssel 0 to wen 0 to repen
cm<="00"; cen<='0'; uas<='0'; -- 0 to cm 0 to cen 0 to uas
iack<='0'; drowsy<='0'; -- 0 to iack 0 to drowsy
CPctrl<='0'&IR(11 downto 6); -- IR 6 RSHIFT 3F AND to CPctl
-- IR n 3 - RSHIFT 7 AND ; \ 8 main instruction types
if IR(n)='1' then -- : CPUdecode ( -- ) getopcd IR &sign
psel <= p_ir; -- IF p_ir to psel DROP \ CALL: load new P
ssel <= '1'; -- 1 to ssel \ select RP
predec <= '1'; wrena <= '1'; -- 1 to predec 1 to wrena \ push at next clock
flush <= '1'; -- 1 to flush \ ignore next instruction
else -- ELSE CELLS opcodes + @ EXECUTE process
case IR(n-1 downto n-3) is -- THEN ;
when "000" => -- \ MISC 0000 cccc aaaa Sooo
ssel <= IR(3); -- : op0 IR 8 bit? to ssel \ 0000 --aa aaaa Sooo
case IR(2 downto 0) is -- IR 7 AND CELLS miscops + @ EXECUTE ;
when "000" => flush<=condition; -- : mo0 condition to flush \ 0000 cccc --p- Z000
drowsy<=IR(3); -- IR 08 bit? to drowsy \ sleep pending
postinc<=IR(5); -- IR 20 bit? to postinc ;
when "001" => psel <= p_ya; -- : mo1 p_ya to psel
rdena <= '1'; -- 1 to rdena
if (ipl /= "000") then -- ipl \ 0000 -f-- ---- s001
iack<='1'; -- IF 1 to iack \ acknowledge irq
else postinc<='1'; -- ELSE 1 to postinc \ RET and RETD
end if; -- THEN
flush <= IR(10); -- IR 400 bit? to flush ;
when "010" => yax <= IR(8); -- : mo2 IR 100 bit? to yax \ 0000 dfwy aaaa s010
wrena <= IR(9); -- IR 200 bit? to wrena
stall <= IR(10); -- IR 400 bit? to stall
flush <= IR(10); -- IR 400 bit? to flush
rdena <= '1'; -- 1 to rdena
if IR(11)='1' then -- IR 800 bit?
iasel <= ia_di; -- IF ia_di to iasel
else iasel <= ia_pi; -- ELSE ia_pi to iasel
end if; -- THEN ;
when "011" => iasel <= ia_c; -- : mo3 ia_c to iasel \ 0000 cccc aaaa s011
wrena <= '1'; -- 1 to wrena ;
when "100" => postinc<='1'; -- : mo4 1 to postinc \ 0000 r-aa aaaa s100
xbump<='1'; -- 1 to xbump \ latch XP = XP + IR[9:4]
rex<=IR(11); -- IR 800 bit? to rex ;
when "101" => iasel <= ia_w; -- : mo5 ia_w to iasel \ 0000 rpx- aaaa s101
rex <= IR(11); -- IR 800 bit? to rex \ IA(ext) = W
predec <= IR(10); -- IR 400 bit? to predec
if IR(9)='1' then iasel <= ia_xp; -- \ IA(ext) = XP
end if; -- IR 200 bit? if ia_xp to iasel then
wrena <= '1'; -- 1 to wrena ;
when "110" => flush <= '1'; -- : mo6 1 to flush 1 to wrena \ IA(ext) = literal
wrena <= '1'; -- IR 400 bit? \ rp-- aaaa s110
iasel <= ia_pi; -- ia_pi to iasel
rdena <= '1'; -- 1 to rdena
if IR(10)='1' then -- IF IR 200 bit?
if IR(9)='1' then -- IF 1 to drd
dasel <= a_pi; -- a_pi to dasel
wrena <= '0'; -- 0 to wrena
if IR(8)='1' then -- IR 100 bit?
dw <= '1'; -- IF 1 to dw
else flushIR <= "00001010" & IR(7 downto 3) & "010";
drd <= '1'; -- ELSE 1 to drd \ mem read
-- IR 00F8 AND 0A02 OR to flushIR
end if; -- THEN
end if; -- THEN
predec<=IR(11); -- IR 800 bit? to predec
else rex <= IR(11); -- ELSE IR 800 bit? to rex
end if; -- THEN ;
when others => iasel <= ia_p; -- : mo7 ia_p to iasel \ 0000 rfaa aaaa s111
psel <= p_ya; -- p_ya to psel \ IA = P P = YA
rdena <= '1'; -- 1 to rdena
rex <= IR(11); -- IR 800 bit? to rex
flush <= IR(10); -- IR 400 bit? to flush
wrena <= '1'; -- 1 to wrena ; \ EXECUTE = 0000 0100 0000 1111
end case; -- CREATE mojmp ~ mo0 ~ mo1 ~ mo2 ~ mo3 ~ mo4 ~ mo5 ~ mo6 ~ mo7
-- ' mojmp IS miscops
when "001" => -- \ BRANCH 0001 dddd dddd dddd
bran<='1'; flush<='1'; -- : op1 1 to bran 1 to flush ;
when "010" => -- \ COPROCESSOR 0010 ???? ??pw bbbb
dasel <= a_cp; -- : op2 a_cp to dasel \ data mem addr = CPA
ibsel <= ib_cp; -- ib_cp to ibsel
wrenb <= IR(4); -- IR 10 bit? to wrenb
postinc <= IR(5); -- IR 20 bit? to postinc
CPctrl(6) <= '1'; -- CPctl 40 OR to CPctl
rdenb <= '1'; -- 1 to rdenb
drd <= '1'; -- 1 to drd ;
when "011" => -- \ RSTACK 0011 ooaa aaaa bbbb
ssel <= '1'; rex <= '1'; -- : op3 1 to rex 1 to ssel \ select RP = long addr
aluop<="100"; -- 4 to aluop
case IR(11 downto 10) is -- IR 0C00 AND CASE
when "00" => iasel <= ia_uo; -- 0000 OF ia_uo to iasel \ A := B
aluop <= "100"; -- 4 to aluop
rdenb <= '1'; -- 1 to rdenb
wrena <= '1'; -- 1 to wrena ENDOF
when "01" => wrenb <= '1'; -- 0400 OF 1 to wrenb \ B := A
rdena <= '1'; -- 1 to rdena
ibsel <= ib_ya; -- ib_ya to ibsel ENDOF
when "10" => iasel <= ia_uo; -- 0800 OF ia_uo to iasel \ push B to return stack
aluop <= "100"; -- 4 to aluop
rdenb <= '1'; -- 1 to rdenb
predec <= '1'; -- 1 to predec
wrena<='1'; -- 1 to wrena ENDOF
when others => wrenb<='1'; -- 0C00 OF 1 to wrenb \ pop B from return stack
rdena <= '1'; -- 1 to rdena
ibsel <= ib_ya; -- ib_ya to ibsel
postinc <= '1'; -- 1 to postinc ENDOF
end case; -- ENDCASE ;
when "100" => -- \ ARITH 0100 duuu aaaa bbbb
aluop <= IR(10 downto 8); -- : op4 IR 8 RSHIFT 7 AND to aluop \ 0 d = A + B
if (IR(10 downto 8)="001") -- aluop 1 = \ 1 d = A - B, save CF
then ubm<="0100"; sub<='1'; -- IF 4 to ubm 1 to sub \ 2 d = A + B, save CF
cm<= "01"; cen<='1'; -- 1 to cm 1 to cen \ 3 d = A + B + CF, saveCF
end if; -- THEN \ 4 d = B
if (IR(10 downto 9)="01") -- aluop 6 AND 2 = \ 5 d = A and B
then cm<= "01"; cen<='1'; -- IF 1 to cm 1 to cen \ 6 d = A or B
end if; -- THEN \ 7 d = A xor B
wen<='1'; iasel<=ia_uo; -- 1 to wen ia_uo to iasel
if IR(11)='1' then -- IR 800 AND
wrena<='1'; -- IF 1 to wrena
end if; -- THEN
rdena <= '1'; rdenb <= '1'; -- 1 to rdena 1 to rdenb
uam<='1'; -- 1 to uam ;
when "101" => -- \ SHIFT 0101 ssss aaaa bbbb
ubm <= IR(11 downto 8); -- : op5 IR 8 RSHIFT 0F AND to ubm
rdenb <= '1'; -- 1 to rdenb
wrena <= '1'; -- 1 to wrena \ A = shift_op(B)
if IR(11)='1' then -- IR 800 AND \ + constant
cm <= IR(11 downto 10); -- IF ubm 2 RSHIFT to cm
cen<='1'; -- 1 to cen
rdena <= '1'; -- 1 to rdena
else acon <= IR(9 downto 8); -- ELSE ubm 3 AND to acon
end if; -- THEN
wen<='1'; iasel<=ia_uo; -- 1 to wen ia_uo to iasel ; \ copy to W
when "110" => -- \ MEMORY 0110 oodp aaaa bbbb
wrenb<= IR(8); -- : op6 IR 100 bit? to wrenb \ post inc/dec if p=1
acon <= IR(9) & '1'; -- IR 200 bit? 2* 1+ to acon ( uo = YB +/- 1 )
rdenb <= '1'; -- 1 to rdenb
if IR(11)='1' then -- IR 800 AND IF
rdena <= '1'; -- 1 to rdena
if IR(10)='1' then -- IR 400 AND IF \ 11xx = Write D
dw<='1'; -- 1 to dw
else pasel<='1'; pw<='1'; -- ELSE 1 to pasel 1 to pw \ 10xx = Write P
stall<='1'; flush<='1'; -- 1 to stall 1 to flush
end if; -- THEN
else -- ELSE \ Read Operation:
if IR(10)='1' then -- IR 400 AND IF
if IR(9 downto 8) /= "10" then
wrena <= '1'; -- IR 8 rshift 3 and 2 <> \ 0110 = pre-read
end if; -- IF 1 to wrena THEN
iasel <= ia_di; -- ia_di to iasel \ 01xx = Read D[b]
drd<='1'; -- 1 to drd
else pasel<='1'; -- ELSE 1 to pasel \ 00xx = Read P[b]
flush<='1'; -- 1 to flush
stall<='1'; -- 1 to stall
if IR(9 downto 8) = "10" then -- \ xx=01 postinc
predec <= '1'; -- IR 8 rshift 3 and 2 = \ xx=11 postdec
end if; -- IF 1 to predec THEN \ 0010 = push P[b]
flushIR <= "00000110" & IR(7 downto 4) & "0010";
-- IR 00F0 AND 0602 OR to flushIR
end if; -- THEN
end if; -- THEN ;
when others => -- \ MATH 0111 oooo aaaa bbbb
rdenb <= '1'; -- : op7 1 to rdenb
if IR(11)='1' then -- IR 800 AND IF \ W operation:
wm <= IR(9 downto 8); -- IR 8 RSHIFT 3 AND to wm \ 1-00 W=B
aluop<="100"; -- 4 to aluop \ 1-01 W=B/-2
wen<='1'; iasel<=ia_uo; -- 1 to wen ia_uo to iasel \ 1-10 W=(W+CF)*2+YBN
cen<='1'; -- 1 to cen ( clear carry )
else -- ELSE
rdena <= '1'; -- 1 to rdena
if IR(10)='1' then -- IR 400 AND IF
cen<='1'; -- 1 to cen
if IR(9)='1' then -- IR 200 AND IF \ 0110 Multiply step
wm<="11"; wen<='1'; -- 3 to wm 1 to wen \ 0111 CRC step
mul<='1'; cm<="01"; -- 1 to mul 1 to cm
wrenb<='1'; ubm<="1000"; -- 1 to wrenb 08 to ubm
if IR(8)='1' then -- IR 100 AND IF
aluop<="111"; -- 7 to aluop \ XOR instead of +
wm<="00"; -- 0 to wm
end if; -- THEN
else -- ELSE
if IR(8)='1' then -- IR 100 AND IF \ 0101 Div step 2
div<='1'; cm<="01"; -- 1 to div 1 to cm
uam<='1'; -- 1 to uam
else -- ELSE \ 0100 Div step 1
wrenb<='1'; -- 1 to wrenb
ubm<="1010"; -- 0A to ubm
cm<="01"; -- 1 to cm
wen<='1'; wm<="10"; -- 1 to wen 2 to wm
end if; -- THEN
end if; -- THEN
else -- ELSE
if IR(9)='1' then -- IR 200 AND IF \ A = (A | swapA) & B
uas <= IR(8); -- IR 100 bit? to uas
aluop<="101"; -- 5 to aluop
wen<='1'; uam<='1'; -- 1 to wen 1 to uam
iasel<=ia_uo; -- ia_uo to iasel
wrena<='1'; -- 1 to wrena
else -- ELSE
if IR(8 downto 6) = "100" then -- IR 1C0 AND 100 = IF \ 7100: load REP count
repen <= '1'; -- 1 to repen
end if; -- THEN
if IR(8 downto 6) = "101" then -- IR 1C0 AND 101 = IF \ 7140: load BANK
banken <= '1'; -- 1 to banken
end if; -- THEN
-- \ room for other instructions here.
end if; -- THEN
end if; -- THEN
end if; -- THEN ;
end case; -- CREATE opcodz ~ op0 ~ op1 ~ op2 ~ op3 ~ op4 ~ op5 ~ op6 ~ op7
end if; -- ' opcodz IS opcodes
end process decode;
-- \ -------------------------------------------------------------------------------------------------------------
-- ( synchonous processes )
sync: process(clk) begin -- : process ( -- ) CPUdecode
if rising_edge(clk) then
resetd <= reset; -- reset => resetd
if resetd='1' then -- resetd IF
cf <= '0'; ov <= '0'; -- 0 => cf 0 => ov
P <= (others => '0'); -- 0 => P
W <= (others => '0'); -- 0 => W
SP <= (others => '0'); -- 0 => SP
RP <= (others => '0'); -- 0 => RP
IR <= (others => '0'); -- 0 => IR
bank <= (others=>'0'); -- 0 => bank
IRQpend <= (others=>'0'); -- 0 => IRQpend \ clear interupt logic
intd <= (others=>'1'); -- -1 => intd
sleep <= '0'; -- 0 => sleep
reps <= (others=>'0'); -- 0 => reps
else -- ELSE
if ipl/="000" then sleep <= '0'; -- ipl IF 0 => sleep
elsif drowsy='1' then sleep <= '1'; -- ELSE drowsy IF 1 => sleep
end if; -- THEN THEN
-- ( clock the interrupt logic )
intd <= int; -- int => intd
IRQpend <= IRQpend or -- intd INVERT int AND
(int and (not intd)); -- IRQpend OR => IRQpend
if iack='1' then -- iack IF
case ipl is -- \ decode irq and clear request
when "001" => IRQpend(1) <= '0'; -- 1 ipl LSHIFT INVERT
when "010" => IRQpend(2) <= '0'; -- IRQpend AND => IRQpend
when "011" => IRQpend(3) <= '0';
when "100" => IRQpend(4) <= '0';
when "101" => IRQpend(5) <= '0';
when "110" => IRQpend(6) <= '0';
when others => IRQpend(7) <= '0';
end case;
end if; -- THEN
if (hold='0') and (sleep='0') then -- hold 0= sleep 0= AND IF
if flush='1' then -- flush
IR <= flushIR; -- IF flushIR => IR \ insert a NOP or special instr.
elsif repeating='0' then -- ELSE repeating 0=
IR <= PI; -- IF PI => IR THEN \ fetch next instruction
end if; -- THEN
if wen='1' then -- wen
W <= win; -- IF win => W THEN
end if; --
if banken='1' then -- banken
bank <= IR(5 downto 0); -- IF IR 03F AND => bank THEN
end if; --
if (xen='1' or yax='1') then -- xen yax OR
if ssel='1' then RP <= spin; -- IF spin
else SP <= spin; -- ssel IF => RP ELSE => SP THEN \ update selected ptr
end if; -- THEN
end if;
if repeating='1' then -- repeating
reps <= reps - 1; -- IF reps 1- => reps
else P <= pin; -- ELSE pin => P \ next P
if repen='1' then -- repen \ load REP counter?
if IR(5)='1' then -- IF IR 20 bit?
reps <= W(5 downto 1); -- IF W 2/
else reps <= IR(4 downto 0); -- ELSE IR
end if; -- THEN 1F and => reps
end if; -- THEN
end if; -- THEN
if cen='1' then -- cen
cf <= cin; -- IF cin => cf \ latch carry and overflow
-- uoa &sign+1 0<> uoa &carry 0= AND yan@ 0= AND ybn@ AND
-- uoa &sign+1 0= uoa &carry 0<> AND ybn@ 0= AND yan@ AND
ov <= (uoa(n+1) and not uoa(n+3) and not ya(n) and yb(n))
or (uoa(n+3) and not uoa(n+1) and not yb(n) and ya(n));
-- \ This is probably the same as uoa(n+3) xor uoa(n+1) xor yb(n) xor ya(n) but I'm not changing it at this point.
-- OR 1 AND => ov
end if; -- THEN
end if; -- THEN
end if; -- THEN
end if;
end process sync; -- ;
t_P <= P; -- \ debugging instrumentation
t_IR <= IR;
t_W <= W(n+1 downto 1);
t_RP <= RP;
t_SP <= SP;
t_cv <= CF & ov;
end behavioral;
-- \ revision history:
-- \ 0: pre-release
-- \ 1: Inverted CF in condition codes 2 & 3 to correct unsigned comparisons.
-- \ 2: Changed Forth version of IPL to run faster.
-- \ 3: Added BANK for extended program memory fetch.
-- \ 4: Changed Forth HDL to remove the need for @ and @@.
|