path: root/testsuite/gna/issue317/OSVVM/TextUtilPkg.vhd

--
--  File Name:         TextUtilPkg.vhd
--  Design Unit Name:  TextUtilPkg
--  Revision:          STANDARD VERSION
--
--  Maintainer:        Jim Lewis      email:  jim@synthworks.com
--  Contributor(s):
--     Jim Lewis      jim@synthworks.com
--
--
--  Description:
--        Shared Utilities for handling text files
--          
--
--  Developed for:
--        SynthWorks Design Inc.
--        VHDL Training Classes
--        11898 SW 128th Ave.  Tigard, Or  97223
--        http://www.SynthWorks.com
--
--  Revision History:
--    Date       Version    Description
--    01/2015:   2015.05    Initial revision
--    01/2016:   2016.01    Update for L.all(L'left)
--    11/2016:   2016.11    Added IsUpper, IsLower, to_upper, to_lower
--
--
--  Copyright (c) 2015-2016 by SynthWorks Design Inc.  All rights reserved.
--
--  Verbatim copies of this source file may be used and
--  distributed without restriction.
--
--  This source file is free software; you can redistribute it
--  and/or modify it under the terms of the ARTISTIC License
--  as published by The Perl Foundation; either version 2.0 of
--  the License, or (at your option) any later version.
--
--  This source is distributed in the hope that it will be
--  useful, but WITHOUT ANY WARRANTY; without even the implied
--  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--  PURPOSE. See the Artistic License for details.
--
--  You should have received a copy of the license with this source.
--  If not download it from,
--     http://www.perlfoundation.org/artistic_license_2_0
--

use std.textio.all ;
library ieee ; 
use ieee.std_logic_1164.all ; 

package TextUtilPkg is
  ------------------------------------------------------------
  function IsUpper (constant Char : character ) return boolean ;
  function IsLower (constant Char : character ) return boolean ;
  function to_lower (constant Char : character ) return character ;
  function to_lower (constant Str : string ) return string ;
  function to_upper (constant Char : character ) return character ;
  function to_upper (constant Str : string ) return string ;
  function ishex (constant Char : character ) return boolean ; 
  function isstd_logic (constant Char : character ) return boolean ;

  ------------------------------------------------------------
  procedure SkipWhiteSpace (
  ------------------------------------------------------------
    variable L     : InOut line ;
    variable Empty : out   boolean
  ) ;
  procedure SkipWhiteSpace (variable L : InOut line) ;
  
  ------------------------------------------------------------
  procedure EmptyOrCommentLine (
  ------------------------------------------------------------
    variable L                : InOut  line ;
    variable Empty            : InOut  boolean ;
    variable MultiLineComment : inout  boolean 
  ) ;
  
  ------------------------------------------------------------
  procedure ReadHexToken (
  -- Reads Upto Result'length values, less is ok.
  -- Does not skip white space
  ------------------------------------------------------------
    variable L      : InOut line ;
    variable Result : Out   std_logic_vector ;
    variable StrLen : Out   integer 
  ) ; 
    
  ------------------------------------------------------------
  procedure ReadBinaryToken (
  -- Reads Upto Result'length values, less is ok.
  -- Does not skip white space
  ------------------------------------------------------------
    variable L      : InOut line ;
    variable Result : Out   std_logic_vector ;
    variable StrLen : Out   integer 
  ) ;   

end TextUtilPkg ;
  
--- ///////////////////////////////////////////////////////////////////////////
--- ///////////////////////////////////////////////////////////////////////////
--- ///////////////////////////////////////////////////////////////////////////

package body TextUtilPkg is
  constant LOWER_TO_UPPER_OFFSET : integer := character'POS('a') - character'POS('A') ;
  
  ------------------------------------------------------------
  function "-" (R : character ; L : integer ) return character is
  ------------------------------------------------------------
  begin
    return character'VAL(character'pos(R) - L) ;  
  end function "-" ; 
  
  ------------------------------------------------------------
  function "+" (R : character ; L : integer ) return character is
  ------------------------------------------------------------
  begin
    return character'VAL(character'pos(R) + L) ;  
  end function "+" ; 

  ------------------------------------------------------------
  function IsUpper (constant Char : character ) return boolean is
  ------------------------------------------------------------
  begin
    if Char >= 'A' and Char <= 'Z' then 
      return TRUE ; 
    else
      return FALSE ; 
    end if ; 
  end function IsUpper ; 
  
  ------------------------------------------------------------
  function IsLower (constant Char : character ) return boolean is
  ------------------------------------------------------------
  begin
    if Char >= 'a' and Char <= 'z' then 
      return TRUE ; 
    else
      return FALSE ; 
    end if ; 
  end function IsLower ;
 
  ------------------------------------------------------------
  function to_lower (constant Char : character ) return character is
  ------------------------------------------------------------
  begin
    if IsUpper(Char) then 
      return Char + LOWER_TO_UPPER_OFFSET ; 
    else
      return Char ; 
    end if ; 
  end function to_lower ;

  ------------------------------------------------------------
  function to_lower (constant Str : string ) return string is
  ------------------------------------------------------------
    variable result : string(Str'range) ;
  begin
    for i in Str'range loop 
      result(i) := to_lower(Str(i)) ;
    end loop ;
    return result ; 
  end function to_lower ;

  ------------------------------------------------------------
  function to_upper (constant Char : character ) return character is
  ------------------------------------------------------------
  begin
    if IsLower(Char) then 
      return Char - LOWER_TO_UPPER_OFFSET ; 
    else
      return Char ; 
    end if ; 
  end function to_upper ;

  ------------------------------------------------------------
  function to_upper (constant Str : string ) return string is
  ------------------------------------------------------------
    variable result : string(Str'range) ;
  begin
    for i in Str'range loop 
      result(i) := to_upper(Str(i)) ;
    end loop ;
    return result ; 
  end function to_upper ;

  ------------------------------------------------------------
  function ishex (constant Char : character ) return boolean is
  ------------------------------------------------------------
  begin
    if Char >= '0' and Char <= '9' then 
      return TRUE ; 
    elsif Char >= 'a' and Char <= 'f' then 
      return TRUE ; 
    elsif Char >= 'A' and Char <= 'F' then 
      return TRUE ; 
    else
      return FALSE ; 
    end if ; 
  end function ishex ; 
  
  ------------------------------------------------------------
  function isstd_logic (constant Char : character ) return boolean is
  ------------------------------------------------------------
  begin
    case Char is
      when 'U' | 'X' | '0' | '1' | 'Z' | 'W' | 'L' | 'H' | '-' => 
        return TRUE ; 
      when others =>
        return FALSE ; 
    end case ; 
  end function isstd_logic ;
  
--  ------------------------------------------------------------
--  function iscomment (constant Char : character ) return boolean is
--  ------------------------------------------------------------
--  begin
--    case Char is
--      when '#' | '/' | '-'  => 
--        return TRUE ; 
--      when others =>
--        return FALSE ; 
--    end case ; 
--  end function iscomment ;

  ------------------------------------------------------------
  procedure SkipWhiteSpace (
  ------------------------------------------------------------
    variable L     : InOut line ;
    variable Empty : out   boolean
  ) is
    variable Valid : boolean ;
    variable Char  : character ;
    constant NBSP  : CHARACTER := CHARACTER'val(160);  -- space character
  begin
    Empty := TRUE ; 
    WhiteSpLoop : while L /= null and L.all'length > 0 loop
      if (L.all(L'left) = ' ' or L.all(L'left) = NBSP or L.all(L'left) = HT) then
        read (L, Char, Valid) ;
        exit when not Valid ; 
      else
        Empty := FALSE ; 
        return ;
      end if ; 
    end loop WhiteSpLoop ;
  end procedure SkipWhiteSpace ;

  ------------------------------------------------------------
  procedure SkipWhiteSpace (
  ------------------------------------------------------------
    variable L     : InOut line 
  ) is
    variable Empty : boolean ;
  begin
    SkipWhiteSpace(L, Empty) ; 
  end procedure SkipWhiteSpace ;
  
  ------------------------------------------------------------
  -- Package Local 
  procedure FindCommentEnd (
  ------------------------------------------------------------
    variable L     : InOut line ;
    variable Empty : out   boolean ;
    variable MultiLineComment : inout boolean 
  ) is
    variable Valid : boolean ;
    variable Char  : character ;
  begin
    MultiLineComment := TRUE ; 
    Empty            := TRUE ; 
    FindEndOfCommentLoop : while L /= null and L.all'length > 1 loop
      read(L, Char, Valid) ; 
      if Char = '*' and L.all(L'left) = '/' then
        read(L, Char, Valid) ; 
        Empty            := FALSE ;
        MultiLineComment := FALSE ;
        exit FindEndOfCommentLoop ;
      end if ; 
    end loop ; 
  end procedure FindCommentEnd ;
  
  ------------------------------------------------------------
  procedure EmptyOrCommentLine (
  ------------------------------------------------------------
    variable L                : InOut  line ;
    variable Empty            : InOut  boolean ;
    variable MultiLineComment : inout  boolean 
  ) is
    variable Valid : boolean ;
    variable Next2Char  : string(1 to 2) ;
    constant NBSP  : CHARACTER := CHARACTER'val(160);  -- space character
  begin
    if MultiLineComment then 
      FindCommentEnd(L, Empty, MultiLineComment) ; 
    end if ; 
    
    EmptyCheckLoop : while not MultiLineComment loop 
      SkipWhiteSpace(L, Empty) ; 
      exit when Empty ; -- line null or 0 in length detected by SkipWhite
      
      Empty := TRUE ; 

      exit when L.all(L'left) = '#' ; -- shell style comment
      
      if L.all'length >= 2 then 
        if L'ascending then 
          Next2Char := L.all(L'left to L'left+1) ;
        else 
          Next2Char := L.all(L'left to L'left-1) ;
        end if; 
        exit when Next2Char = "//" ; -- C style comment
        exit when Next2Char = "--" ; -- VHDL style comment
        
        if Next2Char = "/*" then   -- C style multi line comment
          FindCommentEnd(L, Empty, MultiLineComment) ;
          exit when Empty ; 
          next EmptyCheckLoop ; -- Found end of comment, restart processing line
        end if ; 
      end if ; 
      
      Empty := FALSE ; 
      exit ; 
    end loop EmptyCheckLoop ;
  end procedure EmptyOrCommentLine ;
  
  ------------------------------------------------------------
  procedure ReadHexToken (
  -- Reads Upto Result'length values, less is ok.
  -- Does not skip white space
  ------------------------------------------------------------
    variable L      : InOut line ;
    variable Result : Out   std_logic_vector ;
    variable StrLen : Out   integer 
  ) is
    constant NumHexChars   : integer := (Result'length+3)/4 ;
    constant ResultNormLen : integer := NumHexChars * 4 ; 
    variable NextChar      : character ; 
    variable CharCount     : integer ; 
    variable ReturnVal     : std_logic_vector(ResultNormLen-1 downto 0) ;
    variable ReadVal       : std_logic_vector(3 downto 0) ; 
    variable ReadValid     : boolean ; 
  begin
    ReturnVal := (others => '0') ;
    CharCount := 0 ; 
    
    ReadLoop : while L /= null and L.all'length > 0 loop
      NextChar := L.all(L'left) ; 
      if ishex(NextChar) or NextChar = 'X' or NextChar = 'Z' then 
        hread(L, ReadVal, ReadValid) ; 
        ReturnVal := ReturnVal(ResultNormLen-5 downto 0) & ReadVal ; 
        CharCount := CharCount + 1 ; 
        exit ReadLoop when CharCount >= NumHexChars ; 
      elsif NextChar = '_' then 
        read(L, NextChar, ReadValid) ; 
      else
        exit ; 
      end if ; 
    end loop ReadLoop ;
    
    if CharCount >= NumHexChars then 
      StrLen := Result'length ; 
    else
      StrLen := CharCount * 4 ; 
    end if ; 
    
    Result := ReturnVal(Result'length-1 downto 0) ; 
  end procedure ReadHexToken ; 
    
  ------------------------------------------------------------
  procedure ReadBinaryToken (
  -- Reads Upto Result'length values, less is ok.
  -- Does not skip white space
  ------------------------------------------------------------
    variable L      : InOut line ;
    variable Result : Out   std_logic_vector ;
    variable StrLen : Out   integer 
  ) is
    variable NextChar       : character ; 
    variable CharCount      : integer ; 
    variable ReadVal        : std_logic ; 
    variable ReturnVal      : std_logic_vector(Result'length-1 downto 0) ;
    variable ReadValid      : boolean ; 
  begin
    ReturnVal := (others => '0') ;
    CharCount := 0 ; 
    
    ReadLoop : while L /= null and L.all'length > 0 loop
      NextChar := L.all(L'left) ; 
      if isstd_logic(NextChar) then 
        read(L, ReadVal, ReadValid) ; 
        ReturnVal := ReturnVal(Result'length-2 downto 0) & ReadVal ; 
        CharCount := CharCount + 1 ; 
        exit ReadLoop when CharCount >= Result'length ; 
      elsif NextChar = '_' then 
        read(L, NextChar, ReadValid) ; 
      else
        exit ; 
      end if ; 
    end loop ReadLoop ;
    
    StrLen := CharCount ; 
    Result := ReturnVal ;
  end procedure ReadBinaryToken ;   


end package body TextUtilPkg ;