|
| 1 | +-- |
| 2 | +-- File Name: MessagePkg.vhd |
| 3 | +-- Design Unit Name: MessagePkg |
| 4 | +-- Revision: STANDARD VERSION, revision 2014.01 |
| 5 | +-- |
| 6 | +-- Maintainer: Jim Lewis email: [email protected] |
| 7 | +-- Contributor(s): |
| 8 | +-- Jim Lewis SynthWorks |
| 9 | +-- |
| 10 | +-- |
| 11 | +-- Package Defines |
| 12 | +-- Data structure for name and message handling. |
| 13 | +-- |
| 14 | +-- Developed for: |
| 15 | +-- SynthWorks Design Inc. |
| 16 | +-- VHDL Training Classes |
| 17 | +-- 11898 SW 128th Ave. Tigard, Or 97223 |
| 18 | +-- http://www.SynthWorks.com |
| 19 | +-- |
| 20 | +-- Latest standard version available at: |
| 21 | +-- http://www.SynthWorks.com/downloads |
| 22 | +-- |
| 23 | +-- Revision History: |
| 24 | +-- Date Version Description |
| 25 | +-- 06/2010: 0.1 Initial revision |
| 26 | +-- |
| 27 | +-- |
| 28 | +-- Copyright (c) 2010 - 2013 by SynthWorks Design Inc. All rights reserved. |
| 29 | +-- |
| 30 | +-- Verbatim copies of this source file may be used and |
| 31 | +-- distributed without restriction. |
| 32 | +-- |
| 33 | +-- This source file is free software; you can redistribute it |
| 34 | +-- and/or modify it under the terms of the ARTISTIC License |
| 35 | +-- as published by The Perl Foundation; either version 2.0 of |
| 36 | +-- the License, or (at your option) any later version. |
| 37 | +-- |
| 38 | +-- This source is distributed in the hope that it will be |
| 39 | +-- useful, but WITHOUT ANY WARRANTY; without even the implied |
| 40 | +-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR |
| 41 | +-- PURPOSE. See the Artistic License for details. |
| 42 | +-- |
| 43 | +-- You should have received a copy of the license with this source. |
| 44 | +-- If not download it from, |
| 45 | +-- http://www.perlfoundation.org/artistic_license_2_0 |
| 46 | +-- |
| 47 | + |
| 48 | +library ieee ; |
| 49 | +use ieee.std_logic_1164.all ; |
| 50 | +use ieee.numeric_std.all ; |
| 51 | +use ieee.math_real.all ; |
| 52 | +use std.textio.all ; |
| 53 | + |
| 54 | +package MessagePkg is |
| 55 | + |
| 56 | + type MessagePType is protected |
| 57 | + |
| 58 | + procedure SetName (NameIn : String) ; |
| 59 | + impure function GetName return string ; |
| 60 | + impure function IsSetName return boolean ; |
| 61 | + |
| 62 | + procedure SetMessage (MessageIn : String) ; |
| 63 | + impure function GetMessage (ItemNumber : integer) return string ; |
| 64 | + impure function GetMessageCount return integer ; |
| 65 | + |
| 66 | + procedure DeallocateName ; -- clear name |
| 67 | + procedure DeallocateMessage ; -- clear message |
| 68 | + procedure Deallocate ; -- clear all |
| 69 | + |
| 70 | + end protected MessagePType ; |
| 71 | + |
| 72 | +end package MessagePkg ; |
| 73 | +package body MessagePkg is |
| 74 | + |
| 75 | + -- Local Data Structure Types |
| 76 | + type LineArrayType is array (natural range <>) of line ; |
| 77 | + type LineArrayPtrType is access LineArrayType ; |
| 78 | + |
| 79 | + ------------------------------------------------------------ |
| 80 | + -- Local. Get first word from a string |
| 81 | + function GetWord (Message : string) return string is |
| 82 | + ------------------------------------------------------------ |
| 83 | + alias aMessage : string( 1 to Message'length) is Message ; |
| 84 | + begin |
| 85 | + for i in aMessage'range loop |
| 86 | + if aMessage(i) = ' ' or aMessage(i) = HT then |
| 87 | + return aMessage(1 to i-1) ; |
| 88 | + end if ; |
| 89 | + end loop ; |
| 90 | + return aMessage ; |
| 91 | + end function GetWord ; |
| 92 | + |
| 93 | + |
| 94 | + type MessagePType is protected body |
| 95 | + |
| 96 | + variable NamePtr : line := new string'("") ; |
| 97 | + variable MessageCount : integer := 0 ; |
| 98 | + constant INITIAL_ITEM_COUNT : integer := 25 ; |
| 99 | + variable MaxMessageCount : integer := INITIAL_ITEM_COUNT ; |
| 100 | + variable MessagePtr : LineArrayPtrType := new LineArrayType(1 to INITIAL_ITEM_COUNT) ; |
| 101 | + |
| 102 | + ------------------------------------------------------------ |
| 103 | + procedure SetName (NameIn : String) is |
| 104 | + ------------------------------------------------------------ |
| 105 | + begin |
| 106 | + deallocate(NamePtr) ; |
| 107 | + NamePtr := new string'(NameIn) ; |
| 108 | + end procedure SetName ; |
| 109 | + |
| 110 | + ------------------------------------------------------------ |
| 111 | + impure function GetName return string is |
| 112 | + ------------------------------------------------------------ |
| 113 | + begin |
| 114 | + if NamePtr.all /= "" or MessagePtr(1) = NULL then |
| 115 | + return NamePtr.all ; |
| 116 | + else |
| 117 | + return GetWord( MessagePtr(1).all ) ; |
| 118 | + end if ; |
| 119 | + end function GetName ; |
| 120 | + |
| 121 | + ------------------------------------------------------------ |
| 122 | + impure function IsSetName return boolean is |
| 123 | + ------------------------------------------------------------ |
| 124 | + begin |
| 125 | + return NamePtr.all /= "" ; |
| 126 | + end function IsSetName ; |
| 127 | + |
| 128 | + ------------------------------------------------------------ |
| 129 | + procedure SetMessage (MessageIn : String) is |
| 130 | + ------------------------------------------------------------ |
| 131 | + variable NamePtr : line ; |
| 132 | + variable OldMaxMessageCount : integer ; |
| 133 | + variable OldMessagePtr : LineArrayPtrType ; |
| 134 | + begin |
| 135 | + MessageCount := MessageCount + 1 ; |
| 136 | + if MessageCount > MaxMessageCount then |
| 137 | + OldMaxMessageCount := MaxMessageCount ; |
| 138 | + MaxMessageCount := OldMaxMessageCount * 2 ; |
| 139 | + OldMessagePtr := MessagePtr ; |
| 140 | + MessagePtr := new LineArrayType(1 to MaxMessageCount) ; |
| 141 | + for i in 1 to OldMaxMessageCount loop |
| 142 | + MessagePtr(i) := OldMessagePtr(i) ; |
| 143 | + end loop ; |
| 144 | + Deallocate( OldMessagePtr ) ; |
| 145 | + end if ; |
| 146 | + MessagePtr(MessageCount) := new string'(MessageIn) ; |
| 147 | + end procedure SetMessage ; |
| 148 | + |
| 149 | + ------------------------------------------------------------ |
| 150 | + impure function GetMessage (ItemNumber : integer) return string is |
| 151 | + ------------------------------------------------------------ |
| 152 | + begin |
| 153 | + if MessageCount > 0 then |
| 154 | + if ItemNumber >= 1 and ItemNumber <= MessageCount then |
| 155 | + return MessagePtr(ItemNumber).all ; |
| 156 | + else |
| 157 | + report LF & "%% MessagePkg:MessagePType.GetMessage input value out of range" severity failure ; |
| 158 | + return "" ; -- error if this happens |
| 159 | + end if ; |
| 160 | + else |
| 161 | + return NamePtr.all ; |
| 162 | + end if ; |
| 163 | + end function GetMessage ; |
| 164 | + |
| 165 | + ------------------------------------------------------------ |
| 166 | + impure function GetMessageCount return integer is |
| 167 | + ------------------------------------------------------------ |
| 168 | + begin |
| 169 | + return MessageCount ; |
| 170 | + end function GetMessageCount ; |
| 171 | + |
| 172 | + ------------------------------------------------------------ |
| 173 | + procedure DeallocateName is -- clear name |
| 174 | + ------------------------------------------------------------ |
| 175 | + begin |
| 176 | + deallocate(NamePtr) ; |
| 177 | + NamePtr := new string'("") ; |
| 178 | + end procedure DeallocateName ; |
| 179 | + |
| 180 | + ------------------------------------------------------------ |
| 181 | + procedure DeallocateMessage is -- clear message |
| 182 | + ------------------------------------------------------------ |
| 183 | + variable CurPtr : LineArrayPtrType ; |
| 184 | + begin |
| 185 | + for i in 1 to MessageCount loop |
| 186 | + deallocate( MessagePtr(i) ) ; |
| 187 | + end loop ; |
| 188 | + MessageCount := 0 ; |
| 189 | + -- Do NOT Do this: deallocate( MessagePtr ) ; |
| 190 | + end procedure DeallocateMessage ; |
| 191 | + |
| 192 | + ------------------------------------------------------------ |
| 193 | + procedure Deallocate is -- clear all |
| 194 | + ------------------------------------------------------------ |
| 195 | + begin |
| 196 | + DeallocateName ; |
| 197 | + DeallocateMessage ; |
| 198 | + end procedure Deallocate ; |
| 199 | + |
| 200 | + end protected body MessagePType ; |
| 201 | + |
| 202 | +end package body MessagePkg ; |
| 203 | + |
| 204 | + |
0 commit comments