|
|
- --
- -- 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 ;
|