tbs_dec.vhd

another 8051 core porocesssor vhdl source code

                when "1001" =>return '9';
                when "100H" =>return '9';
                when "H001" =>return '9';
                when "H00H" =>return '9';
                when "1010" =>return 'A';
                when "10H0" =>return 'A';
                when "H010" =>return 'A';
                when "H0H0" =>return 'A';
                when "1011" =>return 'B';
                when "101H" =>return 'B';
                when "10H1" =>return 'B';
                when "10HH" =>return 'B';
                when "H011" =>return 'B';
                when "H01H" =>return 'B';
                when "H0H1" =>return 'B';
                when "H0HH" =>return 'B';
                when "1100" =>return 'C';
                when "1H00" =>return 'C';
                when "H100" =>return 'C';
                when "HH00" =>return 'C';
                when "1101" =>return 'D';
                when "110H" =>return 'D';
                when "1H01" =>return 'D';
                when "1H0H" =>return 'D';
                when "H101" =>return 'D';
                when "H10H" =>return 'D';
                when "HH01" =>return 'D';
                when "HH0H" =>return 'D';
                when "1110" =>return 'E';
                when "11H0" =>return 'E';
                when "1H10" =>return 'E';
                when "1HH0" =>return 'E';
                when "H110" =>return 'E';
                when "H1H0" =>return 'E';
                when "HH10" =>return 'E';
                when "HHH0" =>return 'E';
                when "1111" =>return 'F';
                when "111H" =>return 'F';
                when "11H1" =>return 'F';
                when "11HH" =>return 'F';
                when "1H11" =>return 'F';
                when "1H1H" =>return 'F';
                when "1HH1" =>return 'F';
                when "1HHH" =>return 'F';
                when "H111" =>return 'F';
                when "H11H" =>return 'F';
                when "H1H1" =>return 'F';
                when "H1HH" =>return 'F';
                when "HH11" =>return 'F';
                when "HH1H" =>return 'F';
                when "HHH1" =>return 'F';
                when "HHHH" =>return 'H';
                when "LLLL" =>return 'L';
                when "ZZZZ" =>return 'Z';
                when "XXXX" =>return 'X';
                when others =>return 'X';
	end case;
end convertlogihex;
--**********************************************************************
function eightbit(logvect8:std_logic_vector(7 downto 0)) return string is
variable onechar,twochar:character;
begin
	if (logvect8(7 downto 4)="0000") then
	   onechar:= '0';--make space to supppress leading zeros
	   return onechar&convertlogihex(logvect8(3 downto 0));
	else 
	   return convertlogihex(logvect8(7 downto 4))&convertlogihex(logvect8(3 downto 0));	
        end if;
end eightbit;
--**********************************************************************
function sixteenbit(logvect16:std_logic_vector(15 downto 0)) return string is
variable onechar,twochar,threechar,fourchar :character;
begin
   if (logvect16(15 downto 12)="0000") then
      onechar:= '0';             --make space to supppress leading zeros
      if (logvect16(11 downto 8)="0000") then 
         twochar:='0';           --make space to supppress leading zeros
         if logvect16(7 downto 4)="0000" then
            threechar:='0';      --make space to supppress leading zeros
            return onechar&twochar&threechar&convertlogihex(logvect16(3 downto 0));
         else 
            return onechar&twochar&convertlogihex(logvect16(7 downto 4))&convertlogihex(logvect16(3 downto 0));
         end if;
      else 
         return onechar&convertlogihex(logvect16(11 downto 8))&convertlogihex(logvect16(7 downto 4))
                &convertlogihex(logvect16(3 downto 0));
      end if;
   else
      return convertlogihex(logvect16(15 downto 12))&convertlogihex(logvect16(11 downto 8))&convertlogihex(logvect16(7 downto 4))
      &convertlogihex(logvect16(3 downto 0)); 
   end if;
end sixteenbit;
--**********************************************************************
procedure P_Skip_white(variable L : in LINE; pos : inout integer) is
begin

while pos <= L'high loop
   case L(pos) is
      when ' ' | HT  => pos := pos + 1;
      when others    => exit;
   end case;
end loop;
end;
--**********************************************************************
procedure P_Shrink_line(L : inout LINE; pos : in integer) is 
variable old_L : LINE := L;
begin
   if pos > 1 then
      L := new string'(old_L(pos to old_L'high));
      Deallocate(old_L);
   end if;
end;
--**********************************************************************
--This procedure will read line from textfile and convert it to std_logic_vector
--**********************************************************************
procedure P_READ(L:inout LINE; VALUE: out std_logic_vector; GOOD : out BOOLEAN)   is
alias    val  : std_logic_vector(1 to VALUE'length) is VALUE;
variable vpos : integer := 0;	-- Index of last valid bit in val.
variable lpos : integer;	-- Index of next unused char in L.
begin
if L /= NULL then
    lpos :=1 ;
    P_Skip_white(L, lpos);
    while lpos <= L'right and vpos < VALUE'length loop
case L(lpos) is
    when 'U' =>
                vpos := vpos + 1;
                val(vpos) := 'U';
    when 'X' =>
                vpos := vpos + 1;
                val(vpos) := 'X';
    when '0' =>
                vpos := vpos + 1;
                val(vpos) := '0';
    when '1' =>
                vpos := vpos + 1;
                val(vpos) := '1';
    when 'Z' =>
                vpos := vpos + 1;
                val(vpos) := 'Z';
    when 'z' =>
                vpos := vpos + 1;
                val(vpos) := 'Z';
    when 'W' =>
                vpos := vpos + 1;
                val(vpos) := 'W';
    when 'L' =>
                vpos := vpos + 1;
                val(vpos) := 'L';
    when 'H' =>
                vpos := vpos + 1;
                val(vpos) := 'H';
    when '-' =>
                vpos := vpos + 1;
                val(vpos) := '-';
    when others =>
        exit;
end case;
   lpos := lpos + 1;
   end loop;
   end if;

   if vpos = VALUE'length then
      GOOD := TRUE;
      P_Shrink_line(L, lpos);
   else
      GOOD := FALSE;
   end if;
end;
--**********************************************************************
-- This hex file should contain integral no. of word entries.
-- This procedure is used to read a HEX FILE 
--COMMENTED LINES are applicable to VHDL93 Syntax
--**********************************************************************
procedure P_READ_HEX(L:inout LINE; DATA : out data_buff; ADDRESS: out integer; 
                DATA_LEN:out integer; GOOD : out boolean) is
   variable     CHKSUM	: integer:=0;
   variable     BLK		: integer:=0;
   variable     LPOS 	: integer :=10;	-- Index of char in L.
   variable     WORD	: word;
   variable     S		: string(1 to 2);
   variable     LEN 	: integer:=0;
   variable     TEMP	: integer:=0;
begin
   assert not(L'length < 11) 
   report "Error in Hex File!";
   assert not(L = NULL)
   report "Blank Line!";
   assert not(L(1) /= ':') 
   report "Header not matched!";
   if not(L'length < 11) and not(L =NULL) and not(L(1) /= ':') then
      S:=L(2) & L(3);
      LEN := extract_hex_data(S);
      DATA_LEN := LEN;
      S:=L(4) & L(5);
      TEMP := extract_hex_data(S);
      CHKSUM := LEN + TEMP;
      S:=L(6) & L(7);
      ADDRESS := TEMP * 256 + extract_hex_data(S);
      CHKSUM := CHKSUM + extract_hex_data(S);
      S:=L(8) & L(9);
      BLK := extract_hex_data(S);
      CHKSUM := CHKSUM + BLK;
      for i in 1 to LEN loop
         S:=L(LPOS) & L(LPOS+1);
         DATA(i-1) := extract_hex_data(S);
         CHKSUM := CHKSUM + extract_hex_data(S);
         LPOS := LPOS + 2;
      end loop;
      TEMP := CHKSUM rem 256;
         if TEMP /= 0 then
            CHKSUM := 256 - TEMP;
         else
            CHKSUM := 0;
         end if;
      S := L(LPOS) & L(LPOS+1);
      TEMP := extract_hex_data(S);
   end if;
end;
--**********************************************************************
procedure birtext_out (OUTTEXT : string) is
variable OUTLINE :LINE;
begin
write(OUTLINE,OUTTEXT);
writeline(RESULTSBIR,OUTLINE);
end birtext_out;
--**********************************************************************
procedure unitext_out(OUTTEXT : in string) is
variable OUTLINE :line;
begin
write(OUTLINE,OUTTEXT);
writeline(RESULTSUNI,OUTLINE);
end unitext_out;
--**********************************************************************
procedure birtitle_out is
begin
    birtext_out ("  P  P  P  P     N    "); 
    birtext_out ("  O  O  O  O     X   P"); 
    birtext_out ("  R  R  R  R R N T A S"); 
    birtext_out ("  T  T  T  T S E L L E"); 
    birtext_out ("  0  1  2  3 T A 1 E N"); 
end birtitle_out;
--**********************************************************************
procedure birtitle_in is
-- skip over title banners in listing
variable DUMMY :line; 
begin
readline(BIRREF,DUMMY);--matches ("  P  P  P  P     N    ") 
readline(BIRREF,DUMMY);--matches ("  O  O  O  O     X   P") 
readline(BIRREF,DUMMY);--matches ("  R  R  R  R R N T A S") 
readline(BIRREF,DUMMY);--matches ("  T  T  T  T S E L L E") 
readline(BIRREF,DUMMY);--matches ("  0  1  2  3 T A 1 E N") 
end birtitle_in;
--**********************************************************************
procedure birdata_out(OUTCHARS : in string) is
variable OUTLINE :LINE;
begin
       write(OUTLINE,OUTCHARS);
       write(OUTLINE,now); 
       writeline(RESULTSBIR,OUTLINE);
end birdata_out;
--**********************************************************************
--procedure birtcard_out(OUTCHARS : in string) is
--variable OUTLINE :LINE;
--begin
--       write(OUTLINE,OUTCHARS);
--       write(OUTLINE,now); 
--       writeline(TCARDSTIM,OUTLINE);
--end  birtcard_out;
--**********************************************************************
procedure birdata_in( REFCHARS : out string) is
variable NEXTCHAR:character;
--variable CHARLINE:string(23 downto 1);
variable INLINE :LINE;
begin
   if not OPEN_LOOP then
      readline(BIRREF,INLINE);
      for i in 1 to 23 loop
         read(INLINE,NEXTCHAR);
         REFCHARS(24 - i) := NEXTCHAR;
      end loop; 
   else
      for i in 1 to 23 loop
         REFCHARS(24 - i) := '?';
      end loop; 
   end if;
end birdata_in;
--**********************************************************************
procedure unititle_out is
begin
   unitext_out ("                                                                                        N N");
   unitext_out ("                              N                            N N                          S S");
   unitext_out ("        A P                   E                          A P A X I      N N         N N F F");
   unitext_out ("N N N R L S                   S                          L S L O D      M M D       F F R R");
   unitext_out ("E X X S E E  A  B  C  D  M  F F   O  O  O  O  A  B  C  D E E E F L      O W L  F  F O W O W");
   unitext_out ("A 1 2 T I I  I  I  I  I  D  I R   A  B  C  D  E  E  E  E O N N F E    M E E M  A  O E E E E");
end unititle_out;
--**********************************************************************
procedure unititle_in is
-- skip over title banners in listing