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