--
|
|
-- File Name: MessagePkg.vhd
|
|
-- Design Unit Name: MessagePkg
|
|
-- Revision: STANDARD VERSION, revision 2014.01
|
|
--
|
|
-- Maintainer: Jim Lewis email: jim@synthworks.com
|
|
-- Contributor(s):
|
|
-- Jim Lewis SynthWorks
|
|
--
|
|
--
|
|
-- Package Defines
|
|
-- Data structure for name and message handling.
|
|
--
|
|
-- Developed for:
|
|
-- SynthWorks Design Inc.
|
|
-- VHDL Training Classes
|
|
-- 11898 SW 128th Ave. Tigard, Or 97223
|
|
-- http://www.SynthWorks.com
|
|
--
|
|
-- Latest standard version available at:
|
|
-- http://www.SynthWorks.com/downloads
|
|
--
|
|
-- Revision History:
|
|
-- Date Version Description
|
|
-- 06/2010: 0.1 Initial revision
|
|
--
|
|
--
|
|
-- Copyright (c) 2010 - 2013 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
|
|
--
|
|
|
|
library ieee ;
|
|
use ieee.std_logic_1164.all ;
|
|
use ieee.numeric_std.all ;
|
|
use ieee.math_real.all ;
|
|
use std.textio.all ;
|
|
|
|
package MessagePkg is
|
|
|
|
type MessagePType is protected
|
|
|
|
procedure SetName (NameIn : String) ;
|
|
impure function GetName return string ;
|
|
impure function IsSetName return boolean ;
|
|
|
|
procedure SetMessage (MessageIn : String) ;
|
|
impure function GetMessage (ItemNumber : integer) return string ;
|
|
impure function GetMessageCount return integer ;
|
|
|
|
procedure DeallocateName ; -- clear name
|
|
procedure DeallocateMessage ; -- clear message
|
|
procedure Deallocate ; -- clear all
|
|
|
|
end protected MessagePType ;
|
|
|
|
end package MessagePkg ;
|
|
package body MessagePkg is
|
|
|
|
-- Local Data Structure Types
|
|
type LineArrayType is array (natural range <>) of line ;
|
|
type LineArrayPtrType is access LineArrayType ;
|
|
|
|
------------------------------------------------------------
|
|
-- Local. Get first word from a string
|
|
function GetWord (Message : string) return string is
|
|
------------------------------------------------------------
|
|
alias aMessage : string( 1 to Message'length) is Message ;
|
|
begin
|
|
for i in aMessage'range loop
|
|
if aMessage(i) = ' ' or aMessage(i) = HT then
|
|
return aMessage(1 to i-1) ;
|
|
end if ;
|
|
end loop ;
|
|
return aMessage ;
|
|
end function GetWord ;
|
|
|
|
|
|
type MessagePType is protected body
|
|
|
|
variable NamePtr : line := new string'("") ;
|
|
variable MessageCount : integer := 0 ;
|
|
constant INITIAL_ITEM_COUNT : integer := 25 ;
|
|
variable MaxMessageCount : integer := INITIAL_ITEM_COUNT ;
|
|
variable MessagePtr : LineArrayPtrType := new LineArrayType(1 to INITIAL_ITEM_COUNT) ;
|
|
|
|
------------------------------------------------------------
|
|
procedure SetName (NameIn : String) is
|
|
------------------------------------------------------------
|
|
begin
|
|
deallocate(NamePtr) ;
|
|
NamePtr := new string'(NameIn) ;
|
|
end procedure SetName ;
|
|
|
|
------------------------------------------------------------
|
|
impure function GetName return string is
|
|
------------------------------------------------------------
|
|
begin
|
|
if NamePtr.all /= "" or MessagePtr(1) = NULL then
|
|
return NamePtr.all ;
|
|
else
|
|
return GetWord( MessagePtr(1).all ) ;
|
|
end if ;
|
|
end function GetName ;
|
|
|
|
------------------------------------------------------------
|
|
impure function IsSetName return boolean is
|
|
------------------------------------------------------------
|
|
begin
|
|
return NamePtr.all /= "" ;
|
|
end function IsSetName ;
|
|
|
|
------------------------------------------------------------
|
|
procedure SetMessage (MessageIn : String) is
|
|
------------------------------------------------------------
|
|
variable NamePtr : line ;
|
|
variable OldMaxMessageCount : integer ;
|
|
variable OldMessagePtr : LineArrayPtrType ;
|
|
begin
|
|
MessageCount := MessageCount + 1 ;
|
|
if MessageCount > MaxMessageCount then
|
|
OldMaxMessageCount := MaxMessageCount ;
|
|
MaxMessageCount := OldMaxMessageCount * 2 ;
|
|
OldMessagePtr := MessagePtr ;
|
|
MessagePtr := new LineArrayType(1 to MaxMessageCount) ;
|
|
for i in 1 to OldMaxMessageCount loop
|
|
MessagePtr(i) := OldMessagePtr(i) ;
|
|
end loop ;
|
|
Deallocate( OldMessagePtr ) ;
|
|
end if ;
|
|
MessagePtr(MessageCount) := new string'(MessageIn) ;
|
|
end procedure SetMessage ;
|
|
|
|
------------------------------------------------------------
|
|
impure function GetMessage (ItemNumber : integer) return string is
|
|
------------------------------------------------------------
|
|
begin
|
|
if MessageCount > 0 then
|
|
if ItemNumber >= 1 and ItemNumber <= MessageCount then
|
|
return MessagePtr(ItemNumber).all ;
|
|
else
|
|
report LF & "%% MessagePkg:MessagePType.GetMessage input value out of range" severity failure ;
|
|
return "" ; -- error if this happens
|
|
end if ;
|
|
else
|
|
return NamePtr.all ;
|
|
end if ;
|
|
end function GetMessage ;
|
|
|
|
------------------------------------------------------------
|
|
impure function GetMessageCount return integer is
|
|
------------------------------------------------------------
|
|
begin
|
|
return MessageCount ;
|
|
end function GetMessageCount ;
|
|
|
|
------------------------------------------------------------
|
|
procedure DeallocateName is -- clear name
|
|
------------------------------------------------------------
|
|
begin
|
|
deallocate(NamePtr) ;
|
|
NamePtr := new string'("") ;
|
|
end procedure DeallocateName ;
|
|
|
|
------------------------------------------------------------
|
|
procedure DeallocateMessage is -- clear message
|
|
------------------------------------------------------------
|
|
variable CurPtr : LineArrayPtrType ;
|
|
begin
|
|
for i in 1 to MessageCount loop
|
|
deallocate( MessagePtr(i) ) ;
|
|
end loop ;
|
|
MessageCount := 0 ;
|
|
-- Do NOT Do this: deallocate( MessagePtr ) ;
|
|
end procedure DeallocateMessage ;
|
|
|
|
------------------------------------------------------------
|
|
procedure Deallocate is -- clear all
|
|
------------------------------------------------------------
|
|
begin
|
|
DeallocateName ;
|
|
DeallocateMessage ;
|
|
end procedure Deallocate ;
|
|
|
|
end protected body MessagePType ;
|
|
|
|
end package body MessagePkg ;
|
|
|
|
|