diff options
36 files changed, 17115 insertions, 0 deletions
diff --git a/testsuite/gna/issue317/OSVVM/AlertLogPkg.vhd b/testsuite/gna/issue317/OSVVM/AlertLogPkg.vhd new file mode 100644 index 000000000..0e3e15124 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/AlertLogPkg.vhd @@ -0,0 +1,2732 @@ +-- +-- File Name: AlertLogPkg.vhd +-- Design Unit Name: AlertLogPkg +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis jim@synthworks.com +-- +-- +-- Description: +-- Alert handling and log filtering (verbosity control) +-- Alert handling provides a method to count failures, errors, and warnings +-- To accumlate counts, a data structure is created in a shared variable +-- It is of type AlertLogStructPType which is defined in AlertLogBasePkg +-- Log filtering provides verbosity control for logs (display or do not display) +-- AlertLogPkg provides a simplified interface to the shared variable +-- +-- +-- 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.01 Initial revision +-- 03/2015 2015.03 Added: AlertIfEqual, AlertIfNotEqual, AlertIfDiff, PathTail, +-- ReportNonZeroAlerts, ReadLogEnables +-- 05/2015 2015.06 Added IncAlertCount, AffirmIf +-- 07/2015 2016.01 Fixed AlertLogID issue with > 32 IDs +-- 02/2016 2016.02 Fixed IsLogEnableType (for PASSED), AffirmIf (to pass AlertLevel) +-- Created LocalInitialize +-- +-- 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 ; +use work.OsvvmGlobalPkg.all ; +use work.TranscriptPkg.all ; +use work.TextUtilPkg.all ; + +library IEEE ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; + +package AlertLogPkg is + + subtype AlertLogIDType is integer ; + type AlertType is (FAILURE, ERROR, WARNING) ; -- NEVER + subtype AlertIndexType is AlertType range FAILURE to WARNING ; + type AlertCountType is array (AlertIndexType) of integer ; + type AlertEnableType is array(AlertIndexType) of boolean ; + type LogType is (ALWAYS, DEBUG, FINAL, INFO, PASSED) ; -- NEVER -- See function IsLogEnableType + subtype LogIndexType is LogType range DEBUG to PASSED ; + type LogEnableType is array (LogIndexType) of boolean ; + + constant ALERTLOG_BASE_ID : AlertLogIDType := 0 ; -- Careful as some code may assume this is 0. + constant ALERTLOG_DEFAULT_ID : AlertLogIDType := 1 ; + constant ALERT_DEFAULT_ID : AlertLogIDType := ALERTLOG_DEFAULT_ID ; + constant LOG_DEFAULT_ID : AlertLogIDType := ALERTLOG_DEFAULT_ID ; + constant OSVVM_ALERTLOG_ID : AlertLogIDType := 2 ; + constant OSVVM_SCOREBOARD_ALERTLOG_ID : AlertLogIDType := OSVVM_ALERTLOG_ID ; + -- NUM_PREDEFINED_AL_IDS intended to be local, but depends on others + -- constant NUM_PREDEFINED_AL_IDS : AlertLogIDType := OSVVM_SCOREBOARD_ALERTLOG_ID - ALERTLOG_BASE_ID ; -- Not including base + constant ALERTLOG_ID_NOT_FOUND : AlertLogIDType := -1 ; -- alternately integer'right + constant ALERTLOG_ID_NOT_ASSIGNED : AlertLogIDType := -1 ; + constant MIN_NUM_AL_IDS : AlertLogIDType := 32 ; -- Number IDs initially allocated + + alias AlertLogOptionsType is work.OsvvmGlobalPkg.OsvvmOptionsType ; + + ------------------------------------------------------------ + -- Alert always goes to the transcript file + procedure Alert( + AlertLogID : AlertLogIDType ; + Message : string ; + Level : AlertType := ERROR + ) ; + procedure Alert( Message : string ; Level : AlertType := ERROR ) ; + + ------------------------------------------------------------ + procedure IncAlertCount( -- A silent form of alert + AlertLogID : AlertLogIDType ; + Level : AlertType := ERROR + ) ; + procedure IncAlertCount( Level : AlertType := ERROR ) ; + + ------------------------------------------------------------ + -- Similar to assert, except condition is positive + procedure AlertIf( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIf( condition : boolean ; Message : string ; Level : AlertType := ERROR ) ; + impure function AlertIf( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean ; + impure function AlertIf( condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean ; + + -- deprecated + procedure AlertIf( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) ; + impure function AlertIf( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) return boolean ; + + ------------------------------------------------------------ + -- Direct replacement for assert + procedure AlertIfNot( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNot( condition : boolean ; Message : string ; Level : AlertType := ERROR ) ; + impure function AlertIfNot( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean ; + impure function AlertIfNot( condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean ; + + -- deprecated + procedure AlertIfNot( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) ; + impure function AlertIfNot( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) return boolean ; + + ------------------------------------------------------------ + -- overloading for common functionality + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : signed ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : integer ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : real ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : character ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : string ; Message : string ; Level : AlertType := ERROR ) ; + + procedure AlertIfEqual( L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : signed ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : integer ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : real ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : character ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfEqual( L, R : string ; Message : string ; Level : AlertType := ERROR ) ; + + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : signed ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : integer ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : real ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : character ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : string ; Message : string ; Level : AlertType := ERROR ) ; + + procedure AlertIfNotEqual( L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : signed ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : integer ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : real ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : character ; Message : string ; Level : AlertType := ERROR ) ; + procedure AlertIfNotEqual( L, R : string ; Message : string ; Level : AlertType := ERROR ) ; + ------------------------------------------------------------ + -- Simple Diff for file comparisons + procedure AlertIfDiff (AlertLogID : AlertLogIDType ; Name1, Name2 : string; Message : string := "" ; Level : AlertType := ERROR ) ; + procedure AlertIfDiff (Name1, Name2 : string; Message : string := "" ; Level : AlertType := ERROR ) ; + procedure AlertIfDiff (AlertLogID : AlertLogIDType ; file File1, File2 : text; Message : string := "" ; Level : AlertType := ERROR ) ; + procedure AlertIfDiff (file File1, File2 : text; Message : string := "" ; Level : AlertType := ERROR ) ; + ------------------------------------------------------------ + procedure AffirmIf( + AlertLogID : AlertLogIDType ; + condition : boolean ; + Message : string ; + LogLevel : LogType := PASSED ; + AlertLevel : AlertType := ERROR + ) ; + procedure AffirmIf(condition : boolean ; Message : string ; LogLevel : LogType := PASSED ; AlertLevel : AlertType := ERROR) ; + + ------------------------------------------------------------ + procedure SetAlertLogJustify ; + procedure ReportAlerts ( Name : String ; AlertCount : AlertCountType ) ; + procedure ReportAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (others => 0) ) ; + procedure ReportNonZeroAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (others => 0) ) ; + procedure ClearAlerts ; + function "ABS" (L : AlertCountType) return AlertCountType ; + function "+" (L, R : AlertCountType) return AlertCountType ; + function "-" (L, R : AlertCountType) return AlertCountType ; + function "-" (R : AlertCountType) return AlertCountType ; + impure function SumAlertCount(AlertCount: AlertCountType) return integer ; + impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType ; + impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return integer ; + impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType ; + impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return integer ; + impure function GetDisabledAlertCount return AlertCountType ; + impure function GetDisabledAlertCount return integer ; + impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return AlertCountType ; + impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return integer ; + + ------------------------------------------------------------ + -- log filtering for verbosity control, optionally has a separate file parameter + procedure Log( + AlertLogID : AlertLogIDType ; + Message : string ; + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable + ) ; + procedure Log( Message : string ; Level : LogType := ALWAYS ; Enable : boolean := FALSE) ; + + + ------------------------------------------------------------ + -- Accessor Methods + procedure SetAlertLogName(Name : string ) ; + impure function GetAlertLogName(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return string ; + procedure DeallocateAlertLogStruct ; + procedure InitializeAlertLogStruct ; + impure function FindAlertLogID(Name : string ) return AlertLogIDType ; + impure function FindAlertLogID(Name : string ; ParentID : AlertLogIDType) return AlertLogIDType ; + impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) return AlertLogIDType ; + impure function GetAlertLogParentID(AlertLogID : AlertLogIDType) return AlertLogIDType ; + + ------------------------------------------------------------ + -- Accessor Methods + procedure SetGlobalAlertEnable (A : boolean := TRUE) ; + impure function SetGlobalAlertEnable (A : boolean := TRUE) return boolean ; + impure function GetGlobalAlertEnable return boolean ; + procedure IncAffirmCheckCount ; + impure function GetAffirmCheckCount return natural ; +--?? procedure IncAffirmPassCount ; +--?? impure function GetAffirmPassCount return natural ; + + procedure SetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType ; Count : integer) ; + procedure SetAlertStopCount(Level : AlertType ; Count : integer) ; + impure function GetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType) return integer ; + impure function GetAlertStopCount(Level : AlertType) return integer ; + + procedure SetAlertEnable(Level : AlertType ; Enable : boolean) ; + procedure SetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) ; + impure function GetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType) return boolean ; + impure function GetAlertEnable(Level : AlertType) return boolean ; + + procedure SetLogEnable(Level : LogType ; Enable : boolean) ; + procedure SetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) ; + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean ; + impure function GetLogEnable(Level : LogType) return boolean ; + impure function IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean ; -- same as GetLogEnable + impure function IsLoggingEnabled(Level : LogType) return boolean ; + + procedure ReportLogEnables ; + + ------------------------------------------------------------ + procedure SetAlertLogOptions ( + FailOnWarning : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + FailOnDisabledErrors : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + ReportHierarchy : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + AlertPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + LogPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + ReportPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + DoneName : string := OSVVM_STRING_INIT_PARM_DETECT ; + PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; + FailName : string := OSVVM_STRING_INIT_PARM_DETECT + ) ; + + procedure ReportAlertLogOptions ; + + impure function GetAlertLogFailOnWarning return AlertLogOptionsType ; + impure function GetAlertLogFailOnDisabledErrors return AlertLogOptionsType ; + impure function GetAlertLogReportHierarchy return AlertLogOptionsType ; + impure function GetAlertLogFoundReportHier return boolean ; + impure function GetAlertLogFoundAlertHier return boolean ; + impure function GetAlertLogWriteAlertLevel return AlertLogOptionsType ; + impure function GetAlertLogWriteAlertName return AlertLogOptionsType ; + impure function GetAlertLogWriteAlertTime return AlertLogOptionsType ; + impure function GetAlertLogWriteLogLevel return AlertLogOptionsType ; + impure function GetAlertLogWriteLogName return AlertLogOptionsType ; + impure function GetAlertLogWriteLogTime return AlertLogOptionsType ; + + impure function GetAlertLogAlertPrefix return string ; + impure function GetAlertLogLogPrefix return string ; + + impure function GetAlertLogReportPrefix return string ; + impure function GetAlertLogDoneName return string ; + impure function GetAlertLogPassName return string ; + impure function GetAlertLogFailName return string ; + + + -- File Reading Utilities + function IsLogEnableType (Name : String) return boolean ; + procedure ReadLogEnables (file AlertLogInitFile : text) ; + procedure ReadLogEnables (FileName : string) ; + + -- String Helper Functions -- This should be in a more general string package + function PathTail (A : string) return string ; + +end AlertLogPkg ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +use work.NamePkg.all ; + +package body AlertLogPkg is + + -- instead of justify(to_upper(to_string())), just look up the upper case, left justified values + type AlertNameType is array(AlertType) of string(1 to 7) ; + constant ALERT_NAME : AlertNameType := (WARNING => "WARNING", ERROR => "ERROR ", FAILURE => "FAILURE") ; -- , NEVER => "NEVER " + type LogNameType is array(LogType) of string(1 to 7) ; + constant LOG_NAME : LogNameType := (DEBUG => "DEBUG ", FINAL => "FINAL ", INFO => "INFO ", ALWAYS => "ALWAYS ", PASSED => "PASSED ") ; -- , NEVER => "NEVER " + + + type AlertLogStructPType is protected + + ------------------------------------------------------------ + procedure alert ( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + message : string ; + level : AlertType := ERROR + ) ; + + ------------------------------------------------------------ + procedure IncAlertCount ( AlertLogID : AlertLogIDType ; level : AlertType := ERROR ) ; + procedure SetJustify ; + procedure ReportAlerts ( Name : string ; AlertCount : AlertCountType ) ; + procedure ReportAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (0,0,0) ; ReportAll : boolean := TRUE ) ; + procedure ClearAlerts ; + impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType ; + impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType ; + impure function GetDisabledAlertCount return AlertCountType ; + impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return AlertCountType ; + + ------------------------------------------------------------ + procedure log ( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Message : string ; + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable + ) ; + + ------------------------------------------------------------ + -- FILE IO Controls +-- procedure SetTranscriptEnable (A : boolean := TRUE) ; +-- impure function IsTranscriptEnabled return boolean ; +-- procedure MirrorTranscript (A : boolean := TRUE) ; +-- impure function IsTranscriptMirrored return boolean ; + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- AlertLog Structure Creation and Interaction Methods + + ------------------------------------------------------------ + procedure SetAlertLogName(Name : string ) ; + procedure SetNumAlertLogIDs (NewNumAlertLogIDs : integer) ; + impure function FindAlertLogID(Name : string ) return AlertLogIDType ; + impure function FindAlertLogID(Name : string ; ParentID : AlertLogIDType) return AlertLogIDType ; + impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType ; CreateHierarchy : Boolean) return AlertLogIDType ; + impure function GetAlertLogParentID(AlertLogID : AlertLogIDType) return AlertLogIDType ; + procedure Initialize(NewNumAlertLogIDs : integer := MIN_NUM_AL_IDS) ; + procedure Deallocate ; + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- Accessor Methods + ------------------------------------------------------------ + procedure SetGlobalAlertEnable (A : boolean := TRUE) ; + impure function GetAlertLogName(AlertLogID : AlertLogIDType) return string ; + impure function GetGlobalAlertEnable return boolean ; + procedure IncAffirmCheckCount ; + impure function GetAffirmCheckCount return natural ; +--?? procedure IncAffirmPassCount ; +--?? impure function GetAffirmPassCount return natural ; + + procedure SetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType ; Count : integer) ; + impure function GetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType) return integer ; + + procedure SetAlertEnable(Level : AlertType ; Enable : boolean) ; + procedure SetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) ; + impure function GetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType) return boolean ; + + procedure SetLogEnable(Level : LogType ; Enable : boolean) ; + procedure SetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) ; + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean ; + + procedure ReportLogEnables ; + + ------------------------------------------------------------ + -- Reporting Accessor + procedure SetAlertLogOptions ( + FailOnWarning : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + FailOnDisabledErrors : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + ReportHierarchy : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + AlertPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + LogPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + ReportPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + DoneName : string := OSVVM_STRING_INIT_PARM_DETECT ; + PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; + FailName : string := OSVVM_STRING_INIT_PARM_DETECT + ) ; + procedure ReportAlertLogOptions ; + + impure function GetAlertLogFailOnWarning return AlertLogOptionsType ; + impure function GetAlertLogFailOnDisabledErrors return AlertLogOptionsType ; + impure function GetAlertLogReportHierarchy return AlertLogOptionsType ; + impure function GetAlertLogFoundReportHier return boolean ; + impure function GetAlertLogFoundAlertHier return boolean ; + impure function GetAlertLogWriteAlertLevel return AlertLogOptionsType ; + impure function GetAlertLogWriteAlertName return AlertLogOptionsType ; + impure function GetAlertLogWriteAlertTime return AlertLogOptionsType ; + impure function GetAlertLogWriteLogLevel return AlertLogOptionsType ; + impure function GetAlertLogWriteLogName return AlertLogOptionsType ; + impure function GetAlertLogWriteLogTime return AlertLogOptionsType ; + + impure function GetAlertLogAlertPrefix return string ; + impure function GetAlertLogLogPrefix return string ; + + impure function GetAlertLogReportPrefix return string ; + impure function GetAlertLogDoneName return string ; + impure function GetAlertLogPassName return string ; + impure function GetAlertLogFailName return string ; + + end protected AlertLogStructPType ; + + --- /////////////////////////////////////////////////////////////////////////// + + type AlertLogStructPType is protected body + + variable GlobalAlertEnabledVar : boolean := TRUE ; -- Allows turn off and on + + variable AffirmCheckCountVar : natural := 0 ; +--?? variable AffirmPassedCountVar : natural := 0 ; + + ------------------------------------------------------------ + type AlertLogRecType is record + ------------------------------------------------------------ + Name : Line ; + ParentID : AlertLogIDType ; + AlertCount : AlertCountType ; + AlertStopCount : AlertCountType ; + AlertEnabled : AlertEnableType ; + LogEnabled : LogEnableType ; + end record AlertLogRecType ; + + ------------------------------------------------------------ + -- Basis for AlertLog Data Structure + variable NumAlertLogIDsVar : AlertLogIDType := 0 ; -- defined by initialize + variable NumAllocatedAlertLogIDsVar : AlertLogIDType := 0 ; +--xx variable NumPredefinedAlIDsVar : AlertLogIDType := 0 ; -- defined by initialize + + type AlertLogRecPtrType is access AlertLogRecType ; + type AlertLogArrayType is array (AlertLogIDType range <>) of AlertLogRecPtrType ; + type AlertLogArrayPtrType is access AlertLogArrayType ; + variable AlertLogPtr : AlertLogArrayPtrType ; + + ------------------------------------------------------------ + -- Report formatting settings, with defaults + variable FailOnWarningVar : boolean := TRUE ; + variable FailOnDisabledErrorsVar : boolean := TRUE ; + variable ReportHierarchyVar : boolean := TRUE ; + variable FoundReportHierVar : boolean := FALSE ; + variable FoundAlertHierVar : boolean := FALSE ; + + variable WriteAlertLevelVar : boolean := TRUE ; + variable WriteAlertNameVar : boolean := TRUE ; + variable WriteAlertTimeVar : boolean := TRUE ; + variable WriteLogLevelVar : boolean := TRUE ; + variable WriteLogNameVar : boolean := TRUE ; + variable WriteLogTimeVar : boolean := TRUE ; + + variable AlertPrefixVar : NamePType ; + variable LogPrefixVar : NamePType ; + variable ReportPrefixVar : NamePType ; + variable DoneNameVar : NamePType ; + variable PassNameVar : NamePType ; + variable FailNameVar : NamePType ; + + variable AlertLogJustifyAmountVar : integer := 0 ; + variable ReportJustifyAmountVar : integer := 0 ; + + ------------------------------------------------------------ + -- PT Local + impure function LeftJustify(A : String; Amount : integer) return string is + ------------------------------------------------------------ + constant Spaces : string(1 to maximum(1, Amount)) := (others => ' ') ; + begin + if A'length >= Amount then + return A ; + else + return A & Spaces(1 to Amount - A'length) ; + end if ; + end function LeftJustify ; + + + ------------------------------------------------------------ + -- PT Local + procedure IncrementAlertCount( + ------------------------------------------------------------ + constant AlertLogID : in AlertLogIDType ; + constant Level : in AlertType ; + variable StopDueToCount : inout boolean + ) is + begin + -- Always Count at this level + AlertLogPtr(AlertLogID).AlertCount(Level) := AlertLogPtr(AlertLogID).AlertCount(Level) + 1 ; + -- Only do remaining actions if enabled + if AlertLogPtr(AlertLogID).AlertEnabled(Level) then + -- Exceeded Stop Count at this level? + if AlertLogPtr(AlertLogID).AlertCount(Level) >= AlertLogPtr(AlertLogID).AlertStopCount(Level) then + StopDueToCount := TRUE ; + end if ; + -- Propagate counts to parent(s) -- Ascend Hierarchy + if AlertLogID /= ALERTLOG_BASE_ID then + IncrementAlertCount(AlertLogPtr(AlertLogID).ParentID, Level, StopDueToCount) ; + end if ; + end if ; + end procedure IncrementAlertCount ; + + ------------------------------------------------------------ + procedure alert ( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + message : string ; + level : AlertType := ERROR + ) is + variable buf : Line ; + constant AlertPrefix : string := AlertPrefixVar.Get(OSVVM_DEFAULT_ALERT_PREFIX) ; + variable StopDueToCount : boolean := FALSE ; + begin + if GlobalAlertEnabledVar then + -- Do not write or count when GlobalAlertEnabledVar is disabled + if AlertLogPtr(AlertLogID).AlertEnabled(Level) then + -- do not write when disabled + write(buf, AlertPrefix) ; + if WriteAlertLevelVar then + -- write(buf, " " & to_string(Level) ) ; + write(buf, " " & ALERT_NAME(Level)) ; -- uses constant lookup + end if ; +--xx if (NumAlertLogIDsVar > NumPredefinedAlIDsVar) and WriteAlertNameVar then -- print hierarchy names even when silent + if FoundAlertHierVar and WriteAlertNameVar then +-- write(buf, " in " & justify(AlertLogPtr(AlertLogID).Name.all & ",", LEFT, AlertLogJustifyAmountVar) ) ; + write(buf, " in " & LeftJustify(AlertLogPtr(AlertLogID).Name.all & ",", AlertLogJustifyAmountVar) ) ; + end if ; + write(buf, " " & Message) ; + if WriteAlertTimeVar then + write(buf, " at " & to_string(NOW, 1 ns)) ; + end if ; + writeline(buf) ; + end if ; + -- Always Count + IncrementAlertCount(AlertLogID, Level, StopDueToCount) ; + if StopDueToCount then + write(buf, LF & AlertPrefix & " Stop Count on " & ALERT_NAME(Level) & " reached") ; +--xx if NumAlertLogIDsVar > NumPredefinedAlIDsVar then -- print hierarchy names even when silent + if FoundAlertHierVar then + write(buf, " in " & AlertLogPtr(AlertLogID).Name.all) ; + end if ; + write(buf, " at " & to_string(NOW, 1 ns) & " ") ; + writeline(buf) ; + ReportAlerts(ReportAll => TRUE) ; + std.env.stop(1) ; + end if ; + end if ; + end procedure alert ; + + ------------------------------------------------------------ + procedure IncAlertCount ( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + level : AlertType := ERROR + ) is + variable buf : Line ; + constant AlertPrefix : string := AlertPrefixVar.Get(OSVVM_DEFAULT_ALERT_PREFIX) ; + variable StopDueToCount : boolean := FALSE ; + begin + if GlobalAlertEnabledVar then + IncrementAlertCount(AlertLogID, Level, StopDueToCount) ; + if StopDueToCount then + write(buf, LF & AlertPrefix & " Stop Count on " & ALERT_NAME(Level) & " reached") ; +--xx if NumAlertLogIDsVar > NumPredefinedAlIDsVar then -- print hierarchy names even when silent + if FoundAlertHierVar then + write(buf, " in " & AlertLogPtr(AlertLogID).Name.all) ; + end if ; + write(buf, " at " & to_string(NOW, 1 ns) & " ") ; + writeline(buf) ; + ReportAlerts(ReportAll => TRUE) ; + std.env.stop ; + end if ; + end if ; + end procedure IncAlertCount ; + + ------------------------------------------------------------ + -- PT Local + impure function CalcJustify (AlertLogID : AlertLogIDType ; CurrentLength : integer ; IndentAmount : integer) return integer_vector is + ------------------------------------------------------------ + variable ResultValues, LowerLevelValues : integer_vector(1 to 2) ; -- 1 = Max, 2 = Indented + begin + ResultValues(1) := CurrentLength + 1 ; -- AlertLogJustifyAmountVar + ResultValues(2) := CurrentLength + IndentAmount ; -- ReportJustifyAmountVar + for i in AlertLogID+1 to NumAlertLogIDsVar loop + if AlertLogID = AlertLogPtr(i).ParentID then + LowerLevelValues := CalcJustify(i, AlertLogPtr(i).Name'length, IndentAmount + 2) ; + ResultValues(1) := maximum(ResultValues(1), LowerLevelValues(1)) ; + ResultValues(2) := maximum(ResultValues(2), LowerLevelValues(2)) ; + end if ; + end loop ; + return ResultValues ; + end function CalcJustify ; + + ------------------------------------------------------------ + procedure SetJustify is + ------------------------------------------------------------ + variable ResultValues : integer_vector(1 to 2) ; -- 1 = Max, 2 = Indented + begin + ResultValues := CalcJustify(ALERTLOG_BASE_ID, 0, 0) ; + AlertLogJustifyAmountVar := ResultValues(1) ; + ReportJustifyAmountVar := ResultValues(2) ; + end procedure SetJustify ; + + ------------------------------------------------------------ + -- PT Local + impure function GetEnabledAlertCount(AlertCount: AlertCountType; AlertEnabled : AlertEnableType) return AlertCountType is + ------------------------------------------------------------ + variable Count : AlertCountType := (others => 0) ; + begin + if AlertEnabled(FAILURE) then + Count(FAILURE) := AlertCount(FAILURE) ; + end if ; + if AlertEnabled(ERROR) then + Count(ERROR) := AlertCount(ERROR) ; + end if ; + if FailOnWarningVar and AlertEnabled(WARNING) then + Count(WARNING) := AlertCount(WARNING) ; + end if ; + return Count ; + end function GetEnabledAlertCount ; + + ------------------------------------------------------------ + impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType is + ------------------------------------------------------------ + variable AlertCount : AlertCountType ; + begin + return AlertLogPtr(AlertLogID).AlertCount ; + end function GetAlertCount ; + + ------------------------------------------------------------ + impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType is + ------------------------------------------------------------ + variable AlertCount : AlertCountType ; + begin + return GetEnabledAlertCount(AlertLogPtr(AlertLogID).AlertCount, AlertLogPtr(AlertLogID).AlertEnabled) ; + end function GetEnabledAlertCount ; + + ------------------------------------------------------------ + -- PT Local + impure function GetDisabledAlertCount(AlertCount: AlertCountType; AlertEnabled : AlertEnableType) return AlertCountType is + ------------------------------------------------------------ + variable Count : AlertCountType := (others => 0) ; + begin + if not AlertEnabled(FAILURE) then + Count(FAILURE) := AlertCount(FAILURE) ; + end if ; + if not AlertEnabled(ERROR) then + Count(ERROR) := AlertCount(ERROR) ; + end if ; + if FailOnWarningVar and not AlertEnabled(WARNING) then + Count(WARNING) := AlertCount(WARNING) ; + end if ; + return Count ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + impure function GetDisabledAlertCount return AlertCountType is + ------------------------------------------------------------ + variable Count : AlertCountType := (others => 0) ; + begin + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop + Count := Count + GetDisabledAlertCount(AlertLogPtr(i).AlertCount, AlertLogPtr(i).AlertEnabled) ; + end loop ; + return Count ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return AlertCountType is + ------------------------------------------------------------ + variable Count : AlertCountType := (others => 0) ; + begin + Count := GetDisabledAlertCount(AlertLogPtr(AlertLogID).AlertCount, AlertLogPtr(AlertLogID).AlertEnabled) ; + for i in AlertLogID+1 to NumAlertLogIDsVar loop + if AlertLogID = AlertLogPtr(i).ParentID then + Count := Count + GetDisabledAlertCount(i) ; + end if ; + end loop ; + return Count ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + -- PT Local + procedure PrintTopAlerts ( + ------------------------------------------------------------ + NumErrors : integer ; + AlertCount : AlertCountType ; + Name : string ; + NumDisabledErrors : integer + ) is + constant ReportPrefix : string := ResolveOsvvmWritePrefix(ReportPrefixVar.GetOpt ) ; + constant DoneName : string := ResolveOsvvmDoneName(DoneNameVar.GetOpt ) ; + constant PassName : string := ResolveOsvvmPassName(PassNameVar.GetOpt ) ; + constant FailName : string := ResolveOsvvmFailName(FailNameVar.GetOpt ) ; + variable buf : line ; + begin + if NumErrors = 0 then + if NumDisabledErrors = 0 then + -- Passed + write(buf, ReportPrefix & DoneName & " " & PassName & " " & Name) ; + if AffirmCheckCountVar > 0 then + write(buf, " Affirmations Checked: " & to_string(AffirmCheckCountVar)) ; + end if ; + write(buf, " at " & to_string(NOW, 1 ns)) ; + WriteLine(buf) ; + else + -- Failed Due to Disabled Errors + write(buf, ReportPrefix & DoneName & " " & FailName & " " & Name) ; + write(buf, " Failed Due to Disabled Error(s) = " & to_string(NumDisabledErrors)) ; + if AffirmCheckCountVar > 0 then + write(buf, " Affirmations Checked: " & to_string(AffirmCheckCountVar)) ; + end if ; + write(buf, " at " & to_string(NOW, 1 ns)) ; + WriteLine(buf) ; + end if ; + else + -- Failed + write(buf, ReportPrefix & DoneName & " " & FailName & " "& Name) ; + write(buf, " Total Error(s) = " & to_string(NumErrors) ) ; + write(buf, " Failures: " & to_string(AlertCount(FAILURE)) ) ; + write(buf, " Errors: " & to_string(AlertCount(ERROR) ) ) ; + write(buf, " Warnings: " & to_string(AlertCount(WARNING) ) ) ; + if AffirmCheckCountVar > 0 then +--?? write(buf, " Affirmations Passed: " & to_string(AffirmPassedCountVar)) ; +--?? write(buf, " Checked: " & to_string(AffirmCheckCountVar)) ; + write(buf, " Affirmations Checked: " & to_string(AffirmCheckCountVar)) ; + end if ; + Write(buf, " at " & to_string(NOW, 1 ns)) ; + WriteLine(buf) ; + end if ; + end procedure PrintTopAlerts ; + + ------------------------------------------------------------ + -- PT Local + procedure PrintChild( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Prefix : string ; + IndentAmount : integer ; + ReportAll : boolean + ) is + variable buf : line ; + begin + for i in AlertLogID+1 to NumAlertLogIDsVar loop + if AlertLogID = AlertLogPtr(i).ParentID then + if ReportAll or SumAlertCount(AlertLogPtr(i).AlertCount) > 0 then + Write(buf, Prefix & " " & LeftJustify(AlertLogPtr(i).Name.all, ReportJustifyAmountVar - IndentAmount)) ; + write(buf, " Failures: " & to_string(AlertLogPtr(i).AlertCount(FAILURE) ) ) ; + write(buf, " Errors: " & to_string(AlertLogPtr(i).AlertCount(ERROR) ) ) ; + write(buf, " Warnings: " & to_string(AlertLogPtr(i).AlertCount(WARNING) ) ) ; + WriteLine(buf) ; + end if ; + PrintChild( + AlertLogID => i, + Prefix => Prefix & " ", + IndentAmount => IndentAmount + 2, + ReportAll => ReportAll + ) ; + end if ; + end loop ; + end procedure PrintChild ; + + ------------------------------------------------------------ + procedure ReportAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (0,0,0) ; ReportAll : boolean := TRUE) is + ------------------------------------------------------------ + variable NumErrors : integer ; + variable NumDisabledErrors : integer ; + constant ReportPrefix : string := ResolveOsvvmWritePrefix(ReportPrefixVar.GetOpt) ; + begin + if ReportJustifyAmountVar <= 0 then + SetJustify ; + end if ; + NumErrors := SumAlertCount( ExternalErrors + GetEnabledAlertCount(AlertLogPtr(AlertLogID).AlertCount, AlertLogPtr(AlertLogID).AlertEnabled) ) ; + if FailOnDisabledErrorsVar then + NumDisabledErrors := SumAlertCount( GetDisabledAlertCount(AlertLogID) ) ; + else + NumDisabledErrors := 0 ; + end if ; + if IsOsvvmStringSet(Name) then + PrintTopAlerts ( + NumErrors => NumErrors, + AlertCount => AlertLogPtr(AlertLogID).AlertCount + ExternalErrors, + Name => Name, + NumDisabledErrors => NumDisabledErrors + ) ; + else + PrintTopAlerts ( + NumErrors => NumErrors, + AlertCount => AlertLogPtr(AlertLogID).AlertCount + ExternalErrors, + Name => AlertLogPtr(AlertLogID).Name.all, + NumDisabledErrors => NumDisabledErrors + ) ; + end if ; + --Print Hierarchy when enabled and error or disabled error + if (FoundReportHierVar and ReportHierarchyVar) and (NumErrors /= 0 or NumDisabledErrors /=0) then + PrintChild( + AlertLogID => AlertLogID, + Prefix => ReportPrefix & " ", + IndentAmount => 2, + ReportAll => ReportAll + ) ; + end if ; + end procedure ReportAlerts ; + + ------------------------------------------------------------ + procedure ReportAlerts ( Name : string ; AlertCount : AlertCountType ) is + ------------------------------------------------------------ + begin + PrintTopAlerts ( + NumErrors => SumAlertCount(AlertCount), + AlertCount => AlertCount, + Name => Name, + NumDisabledErrors => 0 + ) ; + end procedure ReportAlerts ; + + ------------------------------------------------------------ + procedure ClearAlerts is + ------------------------------------------------------------ + begin + AffirmCheckCountVar := 0 ; +--?? AffirmPassedCountVar := 0 ; + + AlertLogPtr(ALERTLOG_BASE_ID).AlertCount := (0, 0, 0) ; + AlertLogPtr(ALERTLOG_BASE_ID).AlertStopCount := (FAILURE => 0, ERROR => integer'right, WARNING => integer'right) ; + + for i in ALERTLOG_BASE_ID + 1 to NumAlertLogIDsVar loop + AlertLogPtr(i).AlertCount := (0, 0, 0) ; + AlertLogPtr(i).AlertStopCount := (FAILURE => integer'right, ERROR => integer'right, WARNING => integer'right) ; + end loop ; + end procedure ClearAlerts ; + + ------------------------------------------------------------ + -- PT Local + procedure LocalLog ( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Message : string ; + Level : LogType + ) is + variable buf : line ; + constant LogPrefix : string := LogPrefixVar.Get(OSVVM_DEFAULT_LOG_PREFIX) ; + begin + write(buf, LogPrefix) ; + if WriteLogLevelVar then + write(buf, " " & LOG_NAME(Level) ) ; + end if ; +--xx if (NumAlertLogIDsVar > NumPredefinedAlIDsVar) and WriteLogNameVar then -- print hierarchy names even when silent + if FoundAlertHierVar and WriteLogNameVar then +-- write(buf, " in " & justify(AlertLogPtr(AlertLogID).Name.all & ",", LEFT, AlertLogJustifyAmountVar) ) ; + write(buf, " in " & LeftJustify(AlertLogPtr(AlertLogID).Name.all & ",", AlertLogJustifyAmountVar) ) ; + end if ; + write(buf, " " & Message) ; + if WriteLogTimeVar then + write(buf, " at " & to_string(NOW, 1 ns)) ; + end if ; + writeline(buf) ; + end procedure LocalLog ; + + ------------------------------------------------------------ + procedure log ( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Message : string ; + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable + ) is + begin + if Level = ALWAYS or Enable then + LocalLog(AlertLogID, Message, Level) ; + elsif AlertLogPtr(AlertLogID).LogEnabled(Level) then + LocalLog(AlertLogID, Message, Level) ; + end if ; + end procedure log ; + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- AlertLog Structure Creation and Interaction Methods + + ------------------------------------------------------------ + procedure SetAlertLogName(Name : string ) is + ------------------------------------------------------------ + begin + Deallocate(AlertLogPtr(ALERTLOG_BASE_ID).Name) ; + AlertLogPtr(ALERTLOG_BASE_ID).Name := new string'(Name) ; + end procedure SetAlertLogName ; + + ------------------------------------------------------------ + impure function GetAlertLogName(AlertLogID : AlertLogIDType) return string is + ------------------------------------------------------------ + begin + return AlertLogPtr(AlertLogID).Name.all ; + end function GetAlertLogName ; + + ------------------------------------------------------------ + -- PT Local + procedure NewAlertLogRec(AlertLogID : AlertLogIDType ; Name : string ; ParentID : AlertLogIDType) is + ------------------------------------------------------------ + variable AlertEnabled : AlertEnableType ; + variable AlertStopCount : AlertCountType ; + variable LogEnabled : LogEnableType ; + begin + if AlertLogID = ALERTLOG_BASE_ID then + AlertEnabled := (TRUE, TRUE, TRUE) ; + LogEnabled := (others => FALSE) ; + AlertStopCount := (FAILURE => 0, ERROR => integer'right, WARNING => integer'right) ; + else + if ParentID < ALERTLOG_BASE_ID then + AlertEnabled := AlertLogPtr(ALERTLOG_BASE_ID).AlertEnabled ; + LogEnabled := AlertLogPtr(ALERTLOG_BASE_ID).LogEnabled ; + else + AlertEnabled := AlertLogPtr(ParentID).AlertEnabled ; + LogEnabled := AlertLogPtr(ParentID).LogEnabled ; + end if ; + AlertStopCount := (FAILURE => integer'right, ERROR => integer'right, WARNING => integer'right) ; + end if ; + AlertLogPtr(AlertLogID) := new AlertLogRecType ; + AlertLogPtr(AlertLogID).Name := new string'(NAME) ; + AlertLogPtr(AlertLogID).ParentID := ParentID ; + AlertLogPtr(AlertLogID).AlertCount := (0, 0, 0) ; + AlertLogPtr(AlertLogID).AlertEnabled := AlertEnabled ; + AlertLogPtr(AlertLogID).AlertStopCount := AlertStopCount ; + AlertLogPtr(AlertLogID).LogEnabled := LogEnabled ; +-- AlertLogPtr(AlertLogID) := new AlertLogRecType'( +-- Name => new string'(NAME), +-- ParentID => ParentID, +-- AlertCount => (0, 0, 0), +-- AlertEnabled => AlertEnabled, +-- AlertStopCount => AlertStopCount, +-- LogEnabled => LogEnabled +-- ) ; + end procedure NewAlertLogRec ; + + ------------------------------------------------------------ + -- PT Local + -- Construct initial data structure + procedure LocalInitialize(NewNumAlertLogIDs : integer := MIN_NUM_AL_IDS) is + ------------------------------------------------------------ + begin + if NumAllocatedAlertLogIDsVar /= 0 then + Alert(ALERT_DEFAULT_ID, "AlertLogPkg: Initialize, data structure already initialized", FAILURE) ; + return ; + end if ; + -- Initialize Pointer + AlertLogPtr := new AlertLogArrayType(ALERTLOG_BASE_ID to ALERTLOG_BASE_ID + NewNumAlertLogIDs) ; + NumAllocatedAlertLogIDsVar := NewNumAlertLogIDs ; + -- Create BASE AlertLogID (if it differs from DEFAULT + if ALERTLOG_BASE_ID /= ALERT_DEFAULT_ID then + NewAlertLogRec(ALERTLOG_BASE_ID, "AlertLogTop", ALERTLOG_BASE_ID) ; + end if ; + -- Create DEFAULT AlertLogID + NewAlertLogRec(ALERT_DEFAULT_ID, "Default", ALERTLOG_BASE_ID) ; + NumAlertLogIDsVar := ALERT_DEFAULT_ID ; + -- Create OSVVM AlertLogID (if it differs from DEFAULT + if OSVVM_ALERTLOG_ID /= ALERT_DEFAULT_ID then + NewAlertLogRec(OSVVM_ALERTLOG_ID, "OSVVM", ALERTLOG_BASE_ID) ; + NumAlertLogIDsVar := NumAlertLogIDsVar + 1 ; + end if ; + if OSVVM_SCOREBOARD_ALERTLOG_ID /= OSVVM_ALERTLOG_ID then + NewAlertLogRec(OSVVM_SCOREBOARD_ALERTLOG_ID, "OSVVM Scoreboard", ALERTLOG_BASE_ID) ; + NumAlertLogIDsVar := NumAlertLogIDsVar + 1 ; + end if ; + end procedure LocalInitialize ; + + ------------------------------------------------------------ + -- Construct initial data structure + procedure Initialize(NewNumAlertLogIDs : integer := MIN_NUM_AL_IDS) is + ------------------------------------------------------------ + begin + LocalInitialize(NewNumAlertLogIDs) ; + end procedure Initialize ; + + ------------------------------------------------------------ + -- PT Local + -- Constructs initial data structure using constant below + impure function LocalInitialize return boolean is + ------------------------------------------------------------ + begin + LocalInitialize(MIN_NUM_AL_IDS) ; + return TRUE ; + end function LocalInitialize ; + + constant CONSTRUCT_ALERT_DATA_STRUCTURE : boolean := LocalInitialize ; + + ------------------------------------------------------------ + procedure Deallocate is + ------------------------------------------------------------ + begin + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop + Deallocate(AlertLogPtr(i).Name) ; + Deallocate(AlertLogPtr(i)) ; + end loop ; + deallocate(AlertLogPtr) ; + -- Free up space used by protected types within AlertLogPkg + AlertPrefixVar.Deallocate ; + LogPrefixVar.Deallocate ; + ReportPrefixVar.Deallocate ; + DoneNameVar.Deallocate ; + PassNameVar.Deallocate ; + FailNameVar.Deallocate ; + -- Restore variables to their initial state + NumAlertLogIDsVar := 0 ; + NumAllocatedAlertLogIDsVar := 0 ; + GlobalAlertEnabledVar := TRUE ; -- Allows turn off and on + AffirmCheckCountVar := 0 ; +--?? AffirmPassedCountVar := 0 ; + FailOnWarningVar := TRUE ; + FailOnDisabledErrorsVar := TRUE ; + ReportHierarchyVar := TRUE ; + FoundReportHierVar := FALSE ; + FoundAlertHierVar := FALSE ; + WriteAlertLevelVar := TRUE ; + WriteAlertNameVar := TRUE ; + WriteAlertTimeVar := TRUE ; + WriteLogLevelVar := TRUE ; + WriteLogNameVar := TRUE ; + WriteLogTimeVar := TRUE ; + end procedure Deallocate ; + + ------------------------------------------------------------ + -- PT Local. + procedure GrowAlertStructure (NewNumAlertLogIDs : integer) is + ------------------------------------------------------------ + variable oldAlertLogPtr : AlertLogArrayPtrType ; + begin + if NumAllocatedAlertLogIDsVar = 0 then + Initialize (NewNumAlertLogIDs) ; -- Construct initial structure + else + oldAlertLogPtr := AlertLogPtr ; + AlertLogPtr := new AlertLogArrayType(ALERTLOG_BASE_ID to NewNumAlertLogIDs) ; + AlertLogPtr(ALERTLOG_BASE_ID to NumAlertLogIDsVar) := oldAlertLogPtr(ALERTLOG_BASE_ID to NumAlertLogIDsVar) ; + deallocate(oldAlertLogPtr) ; + end if ; + NumAllocatedAlertLogIDsVar := NewNumAlertLogIDs ; + end procedure GrowAlertStructure ; + + ------------------------------------------------------------ + -- Sets a AlertLogPtr to a particular size + -- Use for small bins to save space or large bins to + -- suppress the resize and copy as a CovBin autosizes. + procedure SetNumAlertLogIDs (NewNumAlertLogIDs : integer) is + ------------------------------------------------------------ + variable oldAlertLogPtr : AlertLogArrayPtrType ; + begin + if NewNumAlertLogIDs > NumAllocatedAlertLogIDsVar then + GrowAlertStructure(NewNumAlertLogIDs) ; + end if; + end procedure SetNumAlertLogIDs ; + + ------------------------------------------------------------ + -- PT Local + impure function GetNextAlertLogID return AlertLogIDType is + ------------------------------------------------------------ + variable NewNumAlertLogIDs : AlertLogIDType ; + begin + NewNumAlertLogIDs := NumAlertLogIDsVar + 1 ; + if NewNumAlertLogIDs > NumAllocatedAlertLogIDsVar then + GrowAlertStructure(NumAllocatedAlertLogIDsVar + MIN_NUM_AL_IDS) ; + end if ; + NumAlertLogIDsVar := NewNumAlertLogIDs ; + return NumAlertLogIDsVar ; + end function GetNextAlertLogID ; + + ------------------------------------------------------------ + impure function FindAlertLogID(Name : string ) return AlertLogIDType is + ------------------------------------------------------------ + begin + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop + if Name = AlertLogPtr(i).Name.all then + return i ; + end if ; + end loop ; + return ALERTLOG_ID_NOT_FOUND ; -- not found + end function FindAlertLogID ; + + ------------------------------------------------------------ + impure function FindAlertLogID(Name : string ; ParentID : AlertLogIDType) return AlertLogIDType is + ------------------------------------------------------------ + variable CurParentID : AlertLogIDType ; + begin + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop + CurParentID := AlertLogPtr(i).ParentID ; + if Name = AlertLogPtr(i).Name.all and + (CurParentID = ParentID or CurParentID = ALERTLOG_ID_NOT_ASSIGNED or ParentID = ALERTLOG_ID_NOT_ASSIGNED) + then + return i ; + end if ; + end loop ; + return ALERTLOG_ID_NOT_FOUND ; -- not found + end function FindAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType ; CreateHierarchy : Boolean) return AlertLogIDType is + ------------------------------------------------------------ + variable ResultID : AlertLogIDType ; + begin + ResultID := FindAlertLogID(Name, ParentID) ; + if ResultID /= ALERTLOG_ID_NOT_FOUND then + -- found it, set ParentID + if AlertLogPtr(ResultID).ParentID = ALERTLOG_ID_NOT_ASSIGNED then + AlertLogPtr(ResultID).ParentID := ParentID ; + -- else -- do not update as ParentIDs are either same or input ParentID = ALERTLOG_ID_NOT_ASSIGNED + end if ; + else + ResultID := GetNextAlertLogID ; + NewAlertLogRec(ResultID, Name, ParentID) ; + FoundAlertHierVar := TRUE ; + if CreateHierarchy then + FoundReportHierVar := TRUE ; + end if ; + end if ; + return ResultID ; + end function GetAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogParentID(AlertLogID : AlertLogIDType) return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogPtr(AlertLogID).ParentID ; + end function GetAlertLogParentID ; + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- Accessor Methods + ------------------------------------------------------------ + + ------------------------------------------------------------ + procedure SetGlobalAlertEnable (A : boolean := TRUE) is + ------------------------------------------------------------ + begin + GlobalAlertEnabledVar := A ; + end procedure SetGlobalAlertEnable ; + + ------------------------------------------------------------ + impure function GetGlobalAlertEnable return boolean is + ------------------------------------------------------------ + begin + return GlobalAlertEnabledVar ; + end function GetGlobalAlertEnable ; + + ------------------------------------------------------------ + procedure IncAffirmCheckCount is + ------------------------------------------------------------ + begin + if GlobalAlertEnabledVar then + AffirmCheckCountVar := AffirmCheckCountVar + 1 ; + end if ; + end procedure IncAffirmCheckCount ; + + ------------------------------------------------------------ + impure function GetAffirmCheckCount return natural is + ------------------------------------------------------------ + begin + return AffirmCheckCountVar ; + end function GetAffirmCheckCount ; + +--?? ------------------------------------------------------------ +--?? procedure IncAffirmPassCount is +--?? ------------------------------------------------------------ +--?? begin +--?? if GlobalAlertEnabledVar then +--?? AffirmCheckCountVar := AffirmCheckCountVar + 1 ; +--?? AffirmPassedCountVar := AffirmPassedCountVar + 1 ; +--?? end if ; +--?? end procedure IncAffirmPassCount ; +--?? +--?? ------------------------------------------------------------ +--?? impure function GetAffirmPassCount return natural is +--?? ------------------------------------------------------------ +--?? begin +--?? return AffirmPassedCountVar ; +--?? end function GetAffirmPassCount ; + + ------------------------------------------------------------ + -- PT LOCAL + procedure SetOneStopCount( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Level : AlertType ; + Count : integer + ) is + begin + if AlertLogPtr(AlertLogID).AlertStopCount(Level) = integer'right then + AlertLogPtr(AlertLogID).AlertStopCount(Level) := Count ; + else + AlertLogPtr(AlertLogID).AlertStopCount(Level) := + AlertLogPtr(AlertLogID).AlertStopCount(Level) + Count ; + end if ; + end procedure SetOneStopCount ; + + ------------------------------------------------------------ + procedure SetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType ; Count : integer) is + ------------------------------------------------------------ + begin + SetOneStopCount(AlertLogID, Level, Count) ; + if AlertLogID /= ALERTLOG_BASE_ID then + SetAlertStopCount(AlertLogPtr(AlertLogID).ParentID, Level, Count) ; + end if ; + end procedure SetAlertStopCount ; + + ------------------------------------------------------------ + impure function GetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType) return integer is + ------------------------------------------------------------ + begin + return AlertLogPtr(AlertLogID).AlertStopCount(Level) ; + end function GetAlertStopCount ; + + ------------------------------------------------------------ + procedure SetAlertEnable(Level : AlertType ; Enable : boolean) is + ------------------------------------------------------------ + begin + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop + AlertLogPtr(i).AlertEnabled(Level) := Enable ; + end loop ; + end procedure SetAlertEnable ; + + ------------------------------------------------------------ + procedure SetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogPtr(AlertLogID).AlertEnabled(Level) := Enable ; + if DescendHierarchy then + for i in AlertLogID+1 to NumAlertLogIDsVar loop + if AlertLogID = AlertLogPtr(i).ParentID then + SetAlertEnable(i, Level, Enable, DescendHierarchy) ; + end if ; + end loop ; + end if ; + end procedure SetAlertEnable ; + + ------------------------------------------------------------ + impure function GetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogPtr(AlertLogID).AlertEnabled(Level) ; + end function GetAlertEnable ; + + ------------------------------------------------------------ + procedure SetLogEnable(Level : LogType ; Enable : boolean) is + ------------------------------------------------------------ + begin + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop + AlertLogPtr(i).LogEnabled(Level) := Enable ; + end loop ; + end procedure SetLogEnable ; + + ------------------------------------------------------------ + procedure SetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogPtr(AlertLogID).LogEnabled(Level) := Enable ; + if DescendHierarchy then + for i in AlertLogID+1 to NumAlertLogIDsVar loop + if AlertLogID = AlertLogPtr(i).ParentID then + SetLogEnable(i, Level, Enable, DescendHierarchy) ; + end if ; + end loop ; + end if ; + end procedure SetLogEnable ; + + ------------------------------------------------------------ + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is + ------------------------------------------------------------ + begin + if Level = ALWAYS then + return TRUE ; + else + return AlertLogPtr(AlertLogID).LogEnabled(Level) ; + end if ; + end function GetLogEnable ; + + ------------------------------------------------------------ + -- PT Local + procedure PrintLogLevels( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Prefix : string ; + IndentAmount : integer + ) is + variable buf : line ; + begin + write(buf, Prefix & " " & LeftJustify(AlertLogPtr(AlertLogID).Name.all, ReportJustifyAmountVar - IndentAmount)) ; + for i in LogIndexType loop + if AlertLogPtr(AlertLogID).LogEnabled(i) then +-- write(buf, " " & to_string(AlertLogPtr(AlertLogID).LogEnabled(i)) ) ; + write(buf, " " & to_string(i)) ; + end if ; + end loop ; + WriteLine(buf) ; + for i in AlertLogID+1 to NumAlertLogIDsVar loop + if AlertLogID = AlertLogPtr(i).ParentID then + PrintLogLevels( + AlertLogID => i, + Prefix => Prefix & " ", + IndentAmount => IndentAmount + 2 + ) ; + end if ; + end loop ; + end procedure PrintLogLevels ; + + ------------------------------------------------------------ + procedure ReportLogEnables is + ------------------------------------------------------------ + begin + if ReportJustifyAmountVar <= 0 then + SetJustify ; + end if ; + PrintLogLevels(ALERTLOG_BASE_ID, "", 0) ; + end procedure ReportLogEnables ; + + ------------------------------------------------------------ + procedure SetAlertLogOptions ( + ------------------------------------------------------------ + FailOnWarning : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + FailOnDisabledErrors : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + ReportHierarchy : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + AlertPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + LogPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + ReportPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + DoneName : string := OSVVM_STRING_INIT_PARM_DETECT ; + PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; + FailName : string := OSVVM_STRING_INIT_PARM_DETECT + ) is + begin + if FailOnWarning /= OPT_INIT_PARM_DETECT then + FailOnWarningVar := IsEnabled(FailOnWarning) ; + end if ; + if FailOnDisabledErrors /= OPT_INIT_PARM_DETECT then + FailOnDisabledErrorsVar := IsEnabled(FailOnDisabledErrors) ; + end if ; + if ReportHierarchy /= OPT_INIT_PARM_DETECT then + ReportHierarchyVar := IsEnabled(ReportHierarchy) ; + end if ; + if WriteAlertLevel /= OPT_INIT_PARM_DETECT then + WriteAlertLevelVar := IsEnabled(WriteAlertLevel) ; + end if ; + if WriteAlertName /= OPT_INIT_PARM_DETECT then + WriteAlertNameVar := IsEnabled(WriteAlertName) ; + end if ; + if WriteAlertTime /= OPT_INIT_PARM_DETECT then + WriteAlertTimeVar := IsEnabled(WriteAlertTime) ; + end if ; + if WriteLogLevel /= OPT_INIT_PARM_DETECT then + WriteLogLevelVar := IsEnabled(WriteLogLevel) ; + end if ; + if WriteLogName /= OPT_INIT_PARM_DETECT then + WriteLogNameVar := IsEnabled(WriteLogName) ; + end if ; + if WriteLogTime /= OPT_INIT_PARM_DETECT then + WriteLogTimeVar := IsEnabled(WriteLogTime) ; + end if ; + if AlertPrefix /= OSVVM_STRING_INIT_PARM_DETECT then + AlertPrefixVar.Set(AlertPrefix) ; + end if ; + if LogPrefix /= OSVVM_STRING_INIT_PARM_DETECT then + LogPrefixVar.Set(LogPrefix) ; + end if ; + if ReportPrefix /= OSVVM_STRING_INIT_PARM_DETECT then + ReportPrefixVar.Set(ReportPrefix) ; + end if ; + if DoneName /= OSVVM_STRING_INIT_PARM_DETECT then + DoneNameVar.Set(DoneName) ; + end if ; + if PassName /= OSVVM_STRING_INIT_PARM_DETECT then + PassNameVar.Set(PassName) ; + end if ; + if FailName /= OSVVM_STRING_INIT_PARM_DETECT then + FailNameVar.Set(FailName) ; + end if ; + end procedure SetAlertLogOptions ; + + ------------------------------------------------------------ + procedure ReportAlertLogOptions is + ------------------------------------------------------------ + variable buf : line ; + begin + -- Boolean Values + swrite(buf, "ReportAlertLogOptions" & LF ) ; + swrite(buf, "---------------------" & LF ) ; + swrite(buf, "FailOnWarningVar: " & to_string(FailOnWarningVar ) & LF ) ; + swrite(buf, "FailOnDisabledErrorsVar: " & to_string(FailOnDisabledErrorsVar ) & LF ) ; + swrite(buf, "ReportHierarchyVar: " & to_string(ReportHierarchyVar ) & LF ) ; + swrite(buf, "FoundReportHierVar: " & to_string(FoundReportHierVar ) & LF ) ; -- Not set by user + swrite(buf, "FoundAlertHierVar: " & to_string(FoundAlertHierVar ) & LF ) ; -- Not set by user + swrite(buf, "WriteAlertLevelVar: " & to_string(WriteAlertLevelVar ) & LF ) ; + swrite(buf, "WriteAlertNameVar: " & to_string(WriteAlertNameVar ) & LF ) ; + swrite(buf, "WriteAlertTimeVar: " & to_string(WriteAlertTimeVar ) & LF ) ; + swrite(buf, "WriteLogLevelVar: " & to_string(WriteLogLevelVar ) & LF ) ; + swrite(buf, "WriteLogNameVar: " & to_string(WriteLogNameVar ) & LF ) ; + swrite(buf, "WriteLogTimeVar: " & to_string(WriteLogTimeVar ) & LF ) ; + + -- String + swrite(buf, "AlertPrefixVar: " & string'(AlertPrefixVar.Get(OSVVM_DEFAULT_ALERT_PREFIX)) & LF ) ; + swrite(buf, "LogPrefixVar: " & string'(LogPrefixVar.Get(OSVVM_DEFAULT_LOG_PREFIX)) & LF ) ; + swrite(buf, "ReportPrefixVar: " & ResolveOsvvmWritePrefix(ReportPrefixVar.GetOpt) & LF ) ; + swrite(buf, "DoneNameVar: " & ResolveOsvvmDoneName(DoneNameVar.GetOpt) & LF ) ; + swrite(buf, "PassNameVar: " & ResolveOsvvmPassName(PassNameVar.GetOpt) & LF ) ; + swrite(buf, "FailNameVar: " & ResolveOsvvmFailName(FailNameVar.GetOpt) & LF ) ; + writeline(buf) ; + end procedure ReportAlertLogOptions ; + + ------------------------------------------------------------ + impure function GetAlertLogFailOnWarning return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(FailOnWarningVar) ; + end function GetAlertLogFailOnWarning ; + + ------------------------------------------------------------ + impure function GetAlertLogFailOnDisabledErrors return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(FailOnDisabledErrorsVar) ; + end function GetAlertLogFailOnDisabledErrors ; + + ------------------------------------------------------------ + impure function GetAlertLogReportHierarchy return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(ReportHierarchyVar) ; + end function GetAlertLogReportHierarchy ; + + ------------------------------------------------------------ + impure function GetAlertLogFoundReportHier return boolean is + ------------------------------------------------------------ + begin + return FoundReportHierVar ; + end function GetAlertLogFoundReportHier ; + + ------------------------------------------------------------ + impure function GetAlertLogFoundAlertHier return boolean is + ------------------------------------------------------------ + begin + return FoundAlertHierVar ; + end function GetAlertLogFoundAlertHier ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteAlertLevel return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(WriteAlertLevelVar) ; + end function GetAlertLogWriteAlertLevel ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteAlertName return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(WriteAlertNameVar) ; + end function GetAlertLogWriteAlertName ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteAlertTime return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(WriteAlertTimeVar) ; + end function GetAlertLogWriteAlertTime ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteLogLevel return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(WriteLogLevelVar) ; + end function GetAlertLogWriteLogLevel ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteLogName return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(WriteLogNameVar) ; + end function GetAlertLogWriteLogName ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteLogTime return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return to_OsvvmOptionsType(WriteLogTimeVar) ; + end function GetAlertLogWriteLogTime ; + + ------------------------------------------------------------ + impure function GetAlertLogAlertPrefix return string is + ------------------------------------------------------------ + begin + return AlertPrefixVar.Get(OSVVM_DEFAULT_ALERT_PREFIX) ; + end function GetAlertLogAlertPrefix ; + + ------------------------------------------------------------ + impure function GetAlertLogLogPrefix return string is + ------------------------------------------------------------ + begin + return LogPrefixVar.Get(OSVVM_DEFAULT_LOG_PREFIX) ; + end function GetAlertLogLogPrefix ; + + ------------------------------------------------------------ + impure function GetAlertLogReportPrefix return string is + ------------------------------------------------------------ + begin + return ResolveOsvvmWritePrefix(ReportPrefixVar.GetOpt) ; + end function GetAlertLogReportPrefix ; + + ------------------------------------------------------------ + impure function GetAlertLogDoneName return string is + ------------------------------------------------------------ + begin + return ResolveOsvvmDoneName(DoneNameVar.GetOpt) ; + end function GetAlertLogDoneName ; + + ------------------------------------------------------------ + impure function GetAlertLogPassName return string is + ------------------------------------------------------------ + begin + return ResolveOsvvmPassName(PassNameVar.GetOpt) ; + end function GetAlertLogPassName ; + + ------------------------------------------------------------ + impure function GetAlertLogFailName return string is + ------------------------------------------------------------ + begin + return ResolveOsvvmFailName(FailNameVar.GetOpt) ; + end function GetAlertLogFailName ; + + end protected body AlertLogStructPType ; + + + + shared variable AlertLogStruct : AlertLogStructPType ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + + ------------------------------------------------------------ + procedure Alert( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Message : string ; + Level : AlertType := ERROR + ) is + begin + AlertLogStruct.Alert(AlertLogID, Message, Level) ; + end procedure alert ; + + ------------------------------------------------------------ + procedure Alert( Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message, Level) ; + end procedure alert ; + + ------------------------------------------------------------ + procedure IncAlertCount( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + Level : AlertType := ERROR + ) is + begin + AlertLogStruct.IncAlertCount(AlertLogID, Level) ; + end procedure IncAlertCount ; + + ------------------------------------------------------------ + procedure IncAlertCount( Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + AlertLogStruct.IncAlertCount(ALERT_DEFAULT_ID, Level) ; + end procedure IncAlertCount ; + + + ------------------------------------------------------------ + procedure AlertIf( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if condition then + AlertLogStruct.Alert(AlertLogID , Message, Level) ; + end if ; + end procedure AlertIf ; + + ------------------------------------------------------------ + -- deprecated + procedure AlertIf( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + AlertIf( AlertLogID, condition, Message, Level) ; + end procedure AlertIf ; + + ------------------------------------------------------------ + procedure AlertIf( condition : boolean ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if condition then + AlertLogStruct.Alert(ALERT_DEFAULT_ID , Message, Level) ; + end if ; + end procedure AlertIf ; + + ------------------------------------------------------------ + -- useful with exit conditions in a loop: exit when alert( not ReadValid, failure, "Read Failed") ; + impure function AlertIf( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean is + ------------------------------------------------------------ + begin + if condition then + AlertLogStruct.Alert(AlertLogID , Message, Level) ; + end if ; + return condition ; + end function AlertIf ; + + ------------------------------------------------------------ + -- deprecated + impure function AlertIf( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) return boolean is + ------------------------------------------------------------ + begin + return AlertIf( AlertLogID, condition, Message, Level) ; + end function AlertIf ; + + ------------------------------------------------------------ + impure function AlertIf( condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean is + ------------------------------------------------------------ + begin + if condition then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message, Level) ; + end if ; + return condition ; + end function AlertIf ; + + ------------------------------------------------------------ + procedure AlertIfNot( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if not condition then + AlertLogStruct.Alert(AlertLogID, Message, Level) ; + end if ; + end procedure AlertIfNot ; + + ------------------------------------------------------------ + -- deprecated + procedure AlertIfNot( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + AlertIfNot( AlertLogID, condition, Message, Level) ; + end procedure AlertIfNot ; + + ------------------------------------------------------------ + procedure AlertIfNot( condition : boolean ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if not condition then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message, Level) ; + end if ; + end procedure AlertIfNot ; + + ------------------------------------------------------------ + -- useful with exit conditions in a loop: exit when alert( not ReadValid, failure, "Read Failed") ; + impure function AlertIfNot( AlertLogID : AlertLogIDType ; condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean is + ------------------------------------------------------------ + begin + if not condition then + AlertLogStruct.Alert(AlertLogID, Message, Level) ; + end if ; + return not condition ; + end function AlertIfNot ; + + ------------------------------------------------------------ + -- deprecated + impure function AlertIfNot( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) return boolean is + ------------------------------------------------------------ + begin + return AlertIfNot( AlertLogID, condition, Message, Level) ; + end function AlertIfNot ; + + ------------------------------------------------------------ + impure function AlertIfNot( condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean is + ------------------------------------------------------------ + begin + if not condition then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message, Level) ; + end if ; + return not condition ; + end function AlertIfNot ; + + -- With AlertLogID + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : signed ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : integer ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : real ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & to_string(L, 4) & " R = " & to_string(R, 4), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : character ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( AlertLogID : AlertLogIDType ; L, R : string ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(AlertLogID, Message & " L = R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfEqual ; + + -- Without AlertLogID + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : signed ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : integer ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : real ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & to_string(L, 4) & " R = " & to_string(R, 4), Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : character ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfEqual ; + + ------------------------------------------------------------ + procedure AlertIfEqual( L, R : string ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L = R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L = R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfEqual ; + + -- With AlertLogID + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : signed ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : integer ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : real ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & to_string(L, 4) & " R = " & to_string(R, 4), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : character ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( AlertLogID : AlertLogIDType ; L, R : string ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(AlertLogID, Message & " L /= R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfNotEqual ; + + -- Without AlertLogID + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : std_logic ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : std_logic_vector ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : unsigned ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : signed ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L ?/= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : integer ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & to_string(L) & " R = " & to_string(R), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : real ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & to_string(L, 4) & " R = " & to_string(R, 4), Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : character ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfNotEqual( L, R : string ; Message : string ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + if L /= R then + AlertLogStruct.Alert(ALERT_DEFAULT_ID, Message & " L /= R, L = " & L & " R = " & R, Level) ; + end if ; + end procedure AlertIfNotEqual ; + + ------------------------------------------------------------ + procedure AlertIfDiff (AlertLogID : AlertLogIDType ; Name1, Name2 : string; Message : string := "" ; Level : AlertType := ERROR ) is + -- Open files and call AlertIfDiff[text, ...] + ------------------------------------------------------------ + file FileID1, FileID2 : text ; + variable status1, status2 : file_open_status ; + begin + file_open(status1, FileID1, Name1, READ_MODE) ; + file_open(status2, FileID2, Name2, READ_MODE) ; + if status1 = OPEN_OK and status2 = OPEN_OK then + AlertIfDiff (AlertLogID, FileID1, FileID2, Message & " " & Name1 & " /= " & Name2 & ", ", Level) ; + else + if status1 /= OPEN_OK then + AlertLogStruct.Alert(AlertLogID , Message & " File, " & Name1 & ", did not open", Level) ; + end if ; + if status2 /= OPEN_OK then + AlertLogStruct.Alert(AlertLogID , Message & " File, " & Name2 & ", did not open", Level) ; + end if ; + end if; + end procedure AlertIfDiff ; + + ------------------------------------------------------------ + procedure AlertIfDiff (Name1, Name2 : string; Message : string := "" ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + AlertIfDiff (ALERT_DEFAULT_ID, Name1, Name2, Message, Level) ; + end procedure AlertIfDiff ; + + ------------------------------------------------------------ + procedure AlertIfDiff (AlertLogID : AlertLogIDType ; file File1, File2 : text; Message : string := "" ; Level : AlertType := ERROR ) is + -- Simple diff. + ------------------------------------------------------------ + variable Buf1, Buf2 : line ; + variable File1Done, File2Done : boolean ; + variable LineCount : integer := 0 ; + begin + ReadLoop : loop + File1Done := EndFile(File1) ; + File2Done := EndFile(File2) ; + exit ReadLoop when File1Done or File2Done ; + + ReadLine(File1, Buf1) ; + ReadLine(File2, Buf2) ; + LineCount := LineCount + 1 ; + + if Buf1.all /= Buf2.all then + AlertLogStruct.Alert(AlertLogID , Message & " File miscompare on line " & to_string(LineCount), Level) ; + exit ReadLoop ; + end if ; + end loop ReadLoop ; + if File1Done /= File2Done then + if not File1Done then + AlertLogStruct.Alert(AlertLogID , Message & " File1 longer than File2 " & to_string(LineCount), Level) ; + end if ; + if not File2Done then + AlertLogStruct.Alert(AlertLogID , Message & " File2 longer than File1 " & to_string(LineCount), Level) ; + end if ; + end if; + end procedure AlertIfDiff ; + + ------------------------------------------------------------ + procedure AlertIfDiff (file File1, File2 : text; Message : string := "" ; Level : AlertType := ERROR ) is + ------------------------------------------------------------ + begin + AlertIfDiff (ALERT_DEFAULT_ID, File1, File2, Message, Level) ; + end procedure AlertIfDiff ; + + ------------------------------------------------------------ + procedure AffirmIf( + ------------------------------------------------------------ + AlertLogID : AlertLogIDType ; + condition : boolean ; + Message : string ; + LogLevel : LogType := PASSED ; + AlertLevel : AlertType := ERROR + ) is + begin + AlertLogStruct.IncAffirmCheckCount ; -- increment check count + if condition then + -- passed + AlertLogStruct.Log(AlertLogID, Message, LogLevel) ; -- call log +-- AlertLogStruct.IncAffirmPassCount ; -- increment pass & check count + else + AlertLogStruct.Alert(AlertLogID, Message, AlertLevel) ; -- signal failure + end if ; + end procedure AffirmIf ; + + ------------------------------------------------------------ + procedure AffirmIf(condition : boolean ; Message : string ; LogLevel : LogType := PASSED ; AlertLevel : AlertType := ERROR) is + ------------------------------------------------------------ + begin + AffirmIf(ALERT_DEFAULT_ID, condition, Message, LogLevel, AlertLevel) ; + end procedure AffirmIf; + + ------------------------------------------------------------ + procedure SetAlertLogJustify is + ------------------------------------------------------------ + begin + AlertLogStruct.SetJustify ; + end procedure SetAlertLogJustify ; + + ------------------------------------------------------------ + procedure ReportAlerts ( Name : String ; AlertCount : AlertCountType ) is + ------------------------------------------------------------ + begin + AlertLogStruct.ReportAlerts(Name, AlertCount) ; + end procedure ReportAlerts ; + + ------------------------------------------------------------ + procedure ReportAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (others => 0) ) is + ------------------------------------------------------------ + begin + AlertLogStruct.ReportAlerts(Name, AlertLogID, ExternalErrors, TRUE) ; + end procedure ReportAlerts ; + + ------------------------------------------------------------ + procedure ReportNonZeroAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (others => 0) ) is + ------------------------------------------------------------ + begin + AlertLogStruct.ReportAlerts(Name, AlertLogID, ExternalErrors, FALSE) ; + end procedure ReportNonZeroAlerts ; + + ------------------------------------------------------------ + procedure ClearAlerts is + ------------------------------------------------------------ + begin + AlertLogStruct.ClearAlerts ; + end procedure ClearAlerts ; + + ------------------------------------------------------------ + function "ABS" (L : AlertCountType) return AlertCountType is + ------------------------------------------------------------ + variable Result : AlertCountType ; + begin + Result(FAILURE) := ABS( L(FAILURE) ) ; + Result(ERROR) := ABS( L(ERROR) ) ; + Result(WARNING) := ABS( L(WARNING) ); + return Result ; + end function "ABS" ; + + ------------------------------------------------------------ + function "+" (L, R : AlertCountType) return AlertCountType is + ------------------------------------------------------------ + variable Result : AlertCountType ; + begin + Result(FAILURE) := L(FAILURE) + R(FAILURE) ; + Result(ERROR) := L(ERROR) + R(ERROR) ; + Result(WARNING) := L(WARNING) + R(WARNING) ; + return Result ; + end function "+" ; + + ------------------------------------------------------------ + function "-" (L, R : AlertCountType) return AlertCountType is + ------------------------------------------------------------ + variable Result : AlertCountType ; + begin + Result(FAILURE) := L(FAILURE) - R(FAILURE) ; + Result(ERROR) := L(ERROR) - R(ERROR) ; + Result(WARNING) := L(WARNING) - R(WARNING) ; + return Result ; + end function "-" ; + + ------------------------------------------------------------ + function "-" (R : AlertCountType) return AlertCountType is + ------------------------------------------------------------ + variable Result : AlertCountType ; + begin + Result(FAILURE) := - R(FAILURE) ; + Result(ERROR) := - R(ERROR) ; + Result(WARNING) := - R(WARNING) ; + return Result ; + end function "-" ; + + ------------------------------------------------------------ + impure function SumAlertCount(AlertCount: AlertCountType) return integer is + ------------------------------------------------------------ + begin + -- Using ABS ensures correct expected error handling. + return abs(AlertCount(FAILURE)) + abs(AlertCount(ERROR)) + abs(AlertCount(WARNING)) ; + end function SumAlertCount ; + + ------------------------------------------------------------ + impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertCount(AlertLogID) ; + end function GetAlertCount ; + + ------------------------------------------------------------ + impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return integer is + ------------------------------------------------------------ + begin + return SumAlertCount(AlertLogStruct.GetAlertCount(AlertLogID)) ; + end function GetAlertCount ; + + ------------------------------------------------------------ + impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetEnabledAlertCount(AlertLogID) ; + end function GetEnabledAlertCount ; + + ------------------------------------------------------------ + impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return integer is + ------------------------------------------------------------ + begin + return SumAlertCount(AlertLogStruct.GetEnabledAlertCount(AlertLogID)) ; + end function GetEnabledAlertCount ; + + ------------------------------------------------------------ + impure function GetDisabledAlertCount return AlertCountType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetDisabledAlertCount ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + impure function GetDisabledAlertCount return integer is + ------------------------------------------------------------ + begin + return SumAlertCount(AlertLogStruct.GetDisabledAlertCount) ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return AlertCountType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetDisabledAlertCount(AlertLogID) ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return integer is + ------------------------------------------------------------ + begin + return SumAlertCount(AlertLogStruct.GetDisabledAlertCount(AlertLogID)) ; + end function GetDisabledAlertCount ; + + ------------------------------------------------------------ + procedure Log( + AlertLogID : AlertLogIDType ; + Message : string ; + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable + ) is + begin + AlertLogStruct.Log(AlertLogID, Message, Level, Enable) ; + end procedure log ; + + ------------------------------------------------------------ + procedure Log( Message : string ; Level : LogType := ALWAYS ; Enable : boolean := FALSE) is + ------------------------------------------------------------ + begin + AlertLogStruct.Log(LOG_DEFAULT_ID, Message, Level, Enable) ; + end procedure log ; + + ------------------------------------------------------------ + procedure SetAlertLogName(Name : string ) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetAlertLogName(Name) ; + end procedure SetAlertLogName ; + + ------------------------------------------------------------ + impure function GetAlertLogName(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogName(AlertLogID) ; + end GetAlertLogName ; + + ------------------------------------------------------------ + procedure DeallocateAlertLogStruct is + ------------------------------------------------------------ + begin + AlertLogStruct.Deallocate ; + end procedure DeallocateAlertLogStruct ; + + ------------------------------------------------------------ + procedure InitializeAlertLogStruct is + ------------------------------------------------------------ + begin + AlertLogStruct.Initialize ; + end procedure InitializeAlertLogStruct ; + + ------------------------------------------------------------ + impure function FindAlertLogID(Name : string ) return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogStruct.FindAlertLogID(Name) ; + end function FindAlertLogID ; + + ------------------------------------------------------------ + impure function FindAlertLogID(Name : string ; ParentID : AlertLogIDType) return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogStruct.FindAlertLogID(Name, ParentID) ; + end function FindAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogID(Name, ParentID, CreateHierarchy ) ; + end function GetAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogParentID(AlertLogID : AlertLogIDType) return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogParentID(AlertLogID) ; + end function GetAlertLogParentID ; + + ------------------------------------------------------------ + procedure SetGlobalAlertEnable (A : boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetGlobalAlertEnable(A) ; + end procedure SetGlobalAlertEnable ; + + ------------------------------------------------------------ + -- Set using constant. Set before code runs. + impure function SetGlobalAlertEnable (A : boolean := TRUE) return boolean is + ------------------------------------------------------------ + begin + AlertLogStruct.SetGlobalAlertEnable(A) ; + return A ; + end function SetGlobalAlertEnable ; + + ------------------------------------------------------------ + impure function GetGlobalAlertEnable return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetGlobalAlertEnable ; + end function GetGlobalAlertEnable ; + + ------------------------------------------------------------ + procedure IncAffirmCheckCount is + ------------------------------------------------------------ + begin + AlertLogStruct.IncAffirmCheckCount ; + end procedure IncAffirmCheckCount ; + + ------------------------------------------------------------ + impure function GetAffirmCheckCount return natural is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAffirmCheckCount ; + end function GetAffirmCheckCount ; + +--?? ------------------------------------------------------------ +--?? procedure IncAffirmPassCount is +--?? ------------------------------------------------------------ +--?? begin +--?? AlertLogStruct.IncAffirmPassCount ; +--?? end procedure IncAffirmPassCount ; +--?? +--?? ------------------------------------------------------------ +--?? impure function GetAffirmPassCount return natural is +--?? ------------------------------------------------------------ +--?? begin +--?? return AlertLogStruct.GetAffirmPassCount ; +--?? end function GetAffirmPassCount ; + + ------------------------------------------------------------ + procedure SetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType ; Count : integer) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetAlertStopCount(AlertLogID, Level, Count) ; + end procedure SetAlertStopCount ; + + ------------------------------------------------------------ + procedure SetAlertStopCount(Level : AlertType ; Count : integer) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetAlertStopCount(ALERTLOG_BASE_ID, Level, Count) ; + end procedure SetAlertStopCount ; + + ------------------------------------------------------------ + impure function GetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType) return integer is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertStopCount(AlertLogID, Level) ; + end function GetAlertStopCount ; + + ------------------------------------------------------------ + impure function GetAlertStopCount(Level : AlertType) return integer is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertStopCount(ALERTLOG_BASE_ID, Level) ; + end function GetAlertStopCount ; + + ------------------------------------------------------------ + procedure SetAlertEnable(Level : AlertType ; Enable : boolean) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetAlertEnable(Level, Enable) ; + end procedure SetAlertEnable ; + + ------------------------------------------------------------ + procedure SetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetAlertEnable(AlertLogID, Level, Enable, DescendHierarchy) ; + end procedure SetAlertEnable ; + + ------------------------------------------------------------ + impure function GetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertEnable(AlertLogID, Level) ; + end function GetAlertEnable ; + + ------------------------------------------------------------ + impure function GetAlertEnable(Level : AlertType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertEnable(ALERT_DEFAULT_ID, Level) ; + end function GetAlertEnable ; + + ------------------------------------------------------------ + procedure SetLogEnable(Level : LogType ; Enable : boolean) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetLogEnable(Level, Enable) ; + end procedure SetLogEnable ; + + ------------------------------------------------------------ + procedure SetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogStruct.SetLogEnable(AlertLogID, Level, Enable, DescendHierarchy) ; + end procedure SetLogEnable ; + + ------------------------------------------------------------ + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetLogEnable(AlertLogID, Level) ; + end function GetLogEnable ; + + ------------------------------------------------------------ + impure function GetLogEnable(Level : LogType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetLogEnable(LOG_DEFAULT_ID, Level) ; + end function GetLogEnable ; + + ------------------------------------------------------------ + impure function IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetLogEnable(AlertLogID, Level) ; + end function IsLoggingEnabled ; + + ------------------------------------------------------------ + impure function IsLoggingEnabled(Level : LogType) return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetLogEnable(LOG_DEFAULT_ID, Level) ; + end function IsLoggingEnabled ; + + ------------------------------------------------------------ + procedure ReportLogEnables is + ------------------------------------------------------------ + begin + AlertLogStruct.ReportLogEnables ; + end ReportLogEnables ; + + ------------------------------------------------------------ + procedure SetAlertLogOptions ( + ------------------------------------------------------------ + FailOnWarning : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + FailOnDisabledErrors : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + ReportHierarchy : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteAlertTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogLevel : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogName : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + WriteLogTime : AlertLogOptionsType := OPT_INIT_PARM_DETECT ; + AlertPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + LogPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + ReportPrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + DoneName : string := OSVVM_STRING_INIT_PARM_DETECT ; + PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; + FailName : string := OSVVM_STRING_INIT_PARM_DETECT + ) is + begin + AlertLogStruct.SetAlertLogOptions ( + FailOnWarning => FailOnWarning , + FailOnDisabledErrors => FailOnDisabledErrors, + ReportHierarchy => ReportHierarchy , + WriteAlertLevel => WriteAlertLevel , + WriteAlertName => WriteAlertName , + WriteAlertTime => WriteAlertTime , + WriteLogLevel => WriteLogLevel , + WriteLogName => WriteLogName , + WriteLogTime => WriteLogTime , + AlertPrefix => AlertPrefix , + LogPrefix => LogPrefix , + ReportPrefix => ReportPrefix , + DoneName => DoneName , + PassName => PassName , + FailName => FailName + ); + end procedure SetAlertLogOptions ; + + ------------------------------------------------------------ + procedure ReportAlertLogOptions is + ------------------------------------------------------------ + begin + AlertLogStruct.ReportAlertLogOptions ; + end procedure ReportAlertLogOptions ; + + ------------------------------------------------------------ + impure function GetAlertLogFailOnWarning return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogFailOnWarning ; + end function GetAlertLogFailOnWarning ; + + ------------------------------------------------------------ + impure function GetAlertLogFailOnDisabledErrors return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogFailOnDisabledErrors ; + end function GetAlertLogFailOnDisabledErrors ; + + ------------------------------------------------------------ + impure function GetAlertLogReportHierarchy return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogReportHierarchy ; + end function GetAlertLogReportHierarchy ; + + ------------------------------------------------------------ + impure function GetAlertLogFoundReportHier return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogFoundReportHier ; + end function GetAlertLogFoundReportHier ; + + ------------------------------------------------------------ + impure function GetAlertLogFoundAlertHier return boolean is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogFoundAlertHier ; + end function GetAlertLogFoundAlertHier ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteAlertLevel return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogWriteAlertLevel ; + end function GetAlertLogWriteAlertLevel ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteAlertName return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogWriteAlertName ; + end function GetAlertLogWriteAlertName ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteAlertTime return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogWriteAlertTime ; + end function GetAlertLogWriteAlertTime ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteLogLevel return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogWriteLogLevel ; + end function GetAlertLogWriteLogLevel ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteLogName return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogWriteLogName ; + end function GetAlertLogWriteLogName ; + + ------------------------------------------------------------ + impure function GetAlertLogWriteLogTime return AlertLogOptionsType is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogWriteLogTime ; + end function GetAlertLogWriteLogTime ; + + ------------------------------------------------------------ + impure function GetAlertLogAlertPrefix return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogAlertPrefix ; + end function GetAlertLogAlertPrefix ; + + ------------------------------------------------------------ + impure function GetAlertLogLogPrefix return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogLogPrefix ; + end function GetAlertLogLogPrefix ; + + ------------------------------------------------------------ + impure function GetAlertLogReportPrefix return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogReportPrefix ; + end function GetAlertLogReportPrefix ; + + ------------------------------------------------------------ + impure function GetAlertLogDoneName return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogDoneName ; + end function GetAlertLogDoneName ; + + ------------------------------------------------------------ + impure function GetAlertLogPassName return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogPassName ; + end function GetAlertLogPassName ; + + ------------------------------------------------------------ + impure function GetAlertLogFailName return string is + ------------------------------------------------------------ + begin + return AlertLogStruct.GetAlertLogFailName ; + end function GetAlertLogFailName ; + + ------------------------------------------------------------ + function IsLogEnableType (Name : String) return boolean is + ------------------------------------------------------------ + -- type LogType is (ALWAYS, DEBUG, FINAL, INFO, PASSED) ; -- NEVER + begin + if Name = "PASSED" then return TRUE ; + elsif Name = "DEBUG" then return TRUE ; + elsif Name = "FINAL" then return TRUE ; + elsif Name = "INFO" then return TRUE ; + end if ; + return FALSE ; + end function IsLogEnableType ; + + ------------------------------------------------------------ + procedure ReadLogEnables (file AlertLogInitFile : text) is + -- Preferred Read format + -- Line 1: instance1_name log_enable log_enable log_enable + -- Line 2: instance2_name log_enable log_enable log_enable + -- when reading multiple log_enables on a line, they must be separated by a space + -- + --- Also supports alternate format from Lyle/.... + -- Line 1: instance1_name + -- Line 2: log enable + -- Line 3: instance2_name + -- Line 4: log enable + -- + ------------------------------------------------------------ + type ReadStateType is (GET_ID, GET_ENABLE) ; + variable ReadState : ReadStateType := GET_ID ; + variable buf : line ; + variable Empty : boolean ; + variable MultiLineComment : boolean := FALSE ; + variable Name : string(1 to 80) ; + variable NameLen : integer ; + variable AlertLogID : AlertLogIDType ; + variable ReadAnEnable : boolean ; + variable LogLevel : LogType ; + begin + ReadState := GET_ID ; + ReadLineLoop : while not EndFile(AlertLogInitFile) loop + ReadLine(AlertLogInitFile, buf) ; + if ReadAnEnable then + -- Read one or more enable values, next line read AlertLog name + -- Note that any newline with ReadAnEnable TRUE will result in + -- searching for another AlertLogID name - this includes multi-line comments. + ReadState := GET_ID ; + end if ; + + ReadNameLoop : loop + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; + next ReadLineLoop when Empty ; + + case ReadState is + when GET_ID => + sread(buf, Name, NameLen) ; + exit ReadNameLoop when NameLen = 0 ; + AlertLogID := GetAlertLogID(Name(1 to NameLen), ALERTLOG_ID_NOT_ASSIGNED) ; + ReadState := GET_ENABLE ; + ReadAnEnable := FALSE ; + + when GET_ENABLE => + sread(buf, Name, NameLen) ; + exit ReadNameLoop when NameLen = 0 ; + ReadAnEnable := TRUE ; + if not IsLogEnableType(Name(1 to NameLen)) then + Alert(OSVVM_ALERTLOG_ID, "AlertLogPkg.ReadLogEnables: Found Invalid LogEnable: " & Name(1 to NameLen)) ; + exit ReadNameLoop ; + end if ; + LogLevel := LogType'value(Name(1 to NameLen)) ; + SetLogEnable(AlertLogID, LogLevel, TRUE) ; + end case ; + end loop ReadNameLoop ; + end loop ReadLineLoop ; + end procedure ReadLogEnables ; + + ------------------------------------------------------------ + procedure ReadLogEnables (FileName : string) is + ------------------------------------------------------------ + file AlertLogInitFile : text open READ_MODE is FileName ; + begin + ReadLogEnables(AlertLogInitFile) ; + end procedure ReadLogEnables ; + + ------------------------------------------------------------ + function PathTail (A : string) return string is + ------------------------------------------------------------ + alias aA : string(1 to A'length) is A ; + begin + for i in aA'length - 1 downto 1 loop + if aA(i) = ':' then + return aA(i+1 to aA'length-1) ; + end if ; + end loop ; + return aA ; + end function PathTail ; + +end package body AlertLogPkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/NamePkg.vhd b/testsuite/gna/issue317/OSVVM/NamePkg.vhd new file mode 100644 index 000000000..44e4ec6cf --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/NamePkg.vhd @@ -0,0 +1,129 @@ +-- +-- File Name: NamePkg.vhd +-- Design Unit Name: NamePkg +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis SynthWorks +-- +-- +-- Package Defines +-- Data structure for name. +-- +-- 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 +-- 07/2014: 2014.07 Moved specialization required by CoveragePkg to CoveragePkg +-- Separated name handling from message handling to simplify naming +-- 12/2014: 2014.07a Removed initialized pointers which can lead to memory leaks. +-- 05/2015 2015.06 Added input to Get to return when not initialized +-- +-- +-- Copyright (c) 2010 - 2015 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 ; + +package NamePkg is + + type NamePType is protected + procedure Set (NameIn : String) ; + impure function Get (DefaultName : string := "") return string ; + impure function GetOpt return string ; + impure function IsSet return boolean ; + procedure Clear ; -- clear name + procedure Deallocate ; -- effectively alias to clear name + end protected NamePType ; + +end package NamePkg ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +package body NamePkg is + type NamePType is protected body + + variable NamePtr : line ; + + ------------------------------------------------------------ + procedure Set (NameIn : String) is + ------------------------------------------------------------ + begin + deallocate(NamePtr) ; + NamePtr := new string'(NameIn) ; + end procedure Set ; + + ------------------------------------------------------------ + impure function Get (DefaultName : string := "") return string is + ------------------------------------------------------------ + begin + if NamePtr = NULL then + return DefaultName ; + else + return NamePtr.all ; + end if ; + end function Get ; + + ------------------------------------------------------------ + impure function GetOpt return string is + ------------------------------------------------------------ + begin + if NamePtr = NULL then + return NUL & "" ; + else + return NamePtr.all ; + end if ; + end function GetOpt ; + + ------------------------------------------------------------ + impure function IsSet return boolean is + ------------------------------------------------------------ + begin + return NamePtr /= NULL ; + end function IsSet ; + + ------------------------------------------------------------ + procedure Clear is -- clear name + ------------------------------------------------------------ + begin + deallocate(NamePtr) ; + end procedure Clear ; + + ------------------------------------------------------------ + procedure Deallocate is -- clear name + ------------------------------------------------------------ + begin + Clear ; + end procedure Deallocate ; + + end protected body NamePType ; + +end package body NamePkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/OsvvmGlobalPkg.vhd b/testsuite/gna/issue317/OSVVM/OsvvmGlobalPkg.vhd new file mode 100644 index 000000000..1d61e2bd3 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/OsvvmGlobalPkg.vhd @@ -0,0 +1,350 @@ +-- +-- File Name: OsvvmGlobalPkg.vhd +-- Design Unit Name: OsvvmGlobalPkg +-- Revision: STANDARD VERSION, revision 2015.01 +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis jim@synthworks.com +-- +-- +-- Description: +-- Global Settings for OSVVM packages +-- +-- +-- 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/2014: 2015.01 Initial revision +-- +-- +-- Copyright (c) 2015 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 std.textio.all ; + +use work.NamePkg.all ; + +package OsvvmGlobalPkg is + -- FILE IO Global File Identifier -- Open using AlertLogPkg.TranscriptOpen +-- file TranscriptFile : text ; + + -- Shared Options Type used in OSVVM + type OsvvmOptionsType is (OPT_INIT_PARM_DETECT, OPT_USE_DEFAULT, DISABLED, FALSE, ENABLED, TRUE) ; + function IsEnabled (A : OsvvmOptionsType) return boolean ; -- Requires that TRUE is last and ENABLED is 2nd to last + function to_OsvvmOptionsType (A : boolean) return OsvvmOptionsType ; + + -- Defaults for String values + constant OSVVM_DEFAULT_ALERT_PREFIX : string := "%% Alert" ; + constant OSVVM_DEFAULT_LOG_PREFIX : string := "%% Log " ; + constant OSVVM_DEFAULT_WRITE_PREFIX : string := "%% " ; + constant OSVVM_DEFAULT_DONE_NAME : string := "DONE" ; + constant OSVVM_DEFAULT_PASS_NAME : string := "PASSED" ; + constant OSVVM_DEFAULT_FAIL_NAME : string := "FAILED" ; + constant OSVVM_STRING_INIT_PARM_DETECT : string := NUL & NUL & NUL ; + constant OSVVM_STRING_USE_DEFAULT : string := NUL & "" ; + + -- Coverage Settings + constant OSVVM_DEFAULT_WRITE_PASS_FAIL : OsvvmOptionsType := FALSE ; + constant OSVVM_DEFAULT_WRITE_BIN_INFO : OsvvmOptionsType := TRUE ; + constant OSVVM_DEFAULT_WRITE_COUNT : OsvvmOptionsType := TRUE ; + constant OSVVM_DEFAULT_WRITE_ANY_ILLEGAL : OsvvmOptionsType := FALSE ; + + ------------------------------------------------------------ + procedure SetOsvvmGlobalOptions ( + ------------------------------------------------------------ + WritePassFail : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WriteBinInfo : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WriteCount : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WriteAnyIllegal : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WritePrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + DoneName : string := OSVVM_STRING_INIT_PARM_DETECT ; + PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; + FailName : string := OSVVM_STRING_INIT_PARM_DETECT + ) ; + + ------------------------------------------------------------ + -- Accessor Functions + function ResolveOsvvmOption(A, B, C : OsvvmOptionsType) return OsvvmOptionsType ; + function ResolveOsvvmOption(A, B, C, D : OsvvmOptionsType) return OsvvmOptionsType ; + function IsOsvvmStringSet (A : string) return boolean ; + function ResolveOsvvmOption(A, B : string) return string ; + function ResolveOsvvmOption(A, B, C : string) return string ; + function ResolveOsvvmOption(A, B, C, D : string) return string ; + + impure function ResolveOsvvmWritePrefix(A : String) return string ; + impure function ResolveOsvvmWritePrefix(A, B : String) return string ; + impure function ResolveOsvvmDoneName(A : String) return string ; + impure function ResolveOsvvmDoneName(A, B : String) return string ; + impure function ResolveOsvvmPassName(A : String) return string ; + impure function ResolveOsvvmPassName(A, B : String) return string ; + impure function ResolveOsvvmFailName(A : String) return string ; + impure function ResolveOsvvmFailName(A, B : String) return string ; + + impure function ResolveCovWritePassFail(A, B : OsvvmOptionsType) return OsvvmOptionsType ; -- Cov + impure function ResolveCovWriteBinInfo(A, B : OsvvmOptionsType) return OsvvmOptionsType ; -- Cov + impure function ResolveCovWriteCount(A, B : OsvvmOptionsType) return OsvvmOptionsType ; -- Cov + impure function ResolveCovWriteAnyIllegal(A, B : OsvvmOptionsType) return OsvvmOptionsType ; -- Cov + + procedure OsvvmDeallocate ; + + type OptionsPType is protected + procedure Set (A: OsvvmOptionsType) ; + impure function get return OsvvmOptionsType ; + end protected OptionsPType ; +end OsvvmGlobalPkg ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +package body OsvvmGlobalPkg is + type OptionsPType is protected body + variable GlobalVar : OsvvmOptionsType ; + procedure Set (A : OsvvmOptionsType) is + begin + GlobalVar := A ; + end procedure Set ; + impure function get return OsvvmOptionsType is + begin + return GlobalVar ; + end function get ; + end protected body OptionsPType ; + + shared variable WritePrefixVar : NamePType ; + shared variable DoneNameVar : NamePType ; + shared variable PassNameVar : NamePType ; + shared variable FailNameVar : NamePType ; + shared variable WritePassFailVar : OptionsPType ; -- := FALSE ; + shared variable WriteBinInfoVar : OptionsPType ; -- := TRUE ; + shared variable WriteCountVar : OptionsPType ; -- := TRUE ; + shared variable WriteAnyIllegalVar : OptionsPType ; -- := FALSE ; + + function IsEnabled (A : OsvvmOptionsType) return boolean is + begin + return A >= ENABLED ; + end function IsEnabled ; + + function to_OsvvmOptionsType (A : boolean) return OsvvmOptionsType is + begin + if A then + return TRUE ; + else + return FALSE ; + end if ; + end function to_OsvvmOptionsType ; + + + ------------------------------------------------------------ + procedure SetOsvvmGlobalOptions ( + ------------------------------------------------------------ + WritePassFail : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WriteBinInfo : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WriteCount : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WriteAnyIllegal : OsvvmOptionsType := OPT_INIT_PARM_DETECT ; + WritePrefix : string := OSVVM_STRING_INIT_PARM_DETECT ; + DoneName : string := OSVVM_STRING_INIT_PARM_DETECT ; + PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; + FailName : string := OSVVM_STRING_INIT_PARM_DETECT + ) is + begin + if WritePassFail /= OPT_INIT_PARM_DETECT then + WritePassFailVar.Set(WritePassFail) ; + end if ; + if WriteBinInfo /= OPT_INIT_PARM_DETECT then + WriteBinInfoVar.Set(WriteBinInfo) ; + end if ; + if WriteCount /= OPT_INIT_PARM_DETECT then + WriteCountVar.Set(WriteCount) ; + end if ; + if WriteAnyIllegal /= OPT_INIT_PARM_DETECT then + WriteAnyIllegalVar.Set(WriteAnyIllegal) ; + end if ; + if WritePrefix /= OSVVM_STRING_INIT_PARM_DETECT then + WritePrefixVar.Set(WritePrefix) ; + end if ; + if DoneName /= OSVVM_STRING_INIT_PARM_DETECT then + DoneNameVar.Set(DoneName) ; + end if ; + if PassName /= OSVVM_STRING_INIT_PARM_DETECT then + PassNameVar.Set(PassName) ; + end if ; + if FailName /= OSVVM_STRING_INIT_PARM_DETECT then + FailNameVar.Set(FailName) ; + end if ; + end procedure SetOsvvmGlobalOptions ; + + ------------------------------------------------------------ + -- Accessor Functions + -- Local Function + function IsOsvvmOptionSet (A : OsvvmOptionsType) return boolean is + begin + return A > OPT_USE_DEFAULT ; + end function IsOsvvmOptionSet ; + + function ResolveOsvvmOption(A, B, C : OsvvmOptionsType) return OsvvmOptionsType is + begin + if IsOsvvmOptionSet(A) then + return A ; + elsif IsOsvvmOptionSet(B) then + return B ; + else + return C ; + end if ; + end function ResolveOsvvmOption ; + + function ResolveOsvvmOption(A, B, C, D : OsvvmOptionsType) return OsvvmOptionsType is + begin + if IsOsvvmOptionSet(A) then + return A ; + elsif IsOsvvmOptionSet(B) then + return B ; + elsif IsOsvvmOptionSet(C) then + return C ; + else + return D ; + end if ; + end function ResolveOsvvmOption ; + + -- Local Function + function IsOsvvmStringSet (A : string) return boolean is + begin + if A'length = 0 then -- Null strings permitted + return TRUE ; + else + return A(A'left) /= NUL ; + end if; + end function IsOsvvmStringSet ; + + function ResolveOsvvmOption(A, B : string) return string is + begin + if IsOsvvmStringSet(A) then + return A ; + else + return B ; + end if ; + end function ResolveOsvvmOption ; + + function ResolveOsvvmOption(A, B, C : string) return string is + begin + if IsOsvvmStringSet(A) then + return A ; + elsif IsOsvvmStringSet(B) then + return B ; + else + return C ; + end if ; + end function ResolveOsvvmOption ; + + function ResolveOsvvmOption(A, B, C, D : string) return string is + begin + if IsOsvvmStringSet(A) then + return A ; + elsif IsOsvvmStringSet(B) then + return B ; + elsif IsOsvvmStringSet(C) then + return C ; + else + return D ; + end if ; + end function ResolveOsvvmOption ; + + + impure function ResolveOsvvmWritePrefix(A : String) return string is + begin + return ResolveOsvvmOption(A, WritePrefixVar.GetOpt, OSVVM_DEFAULT_WRITE_PREFIX) ; + end function ResolveOsvvmWritePrefix ; + + impure function ResolveOsvvmWritePrefix(A, B : String) return string is + begin + return ResolveOsvvmOption(A, B, WritePrefixVar.GetOpt, OSVVM_DEFAULT_WRITE_PREFIX) ; + end function ResolveOsvvmWritePrefix ; + + impure function ResolveOsvvmDoneName(A : String) return string is + begin + return ResolveOsvvmOption(A, DoneNameVar.GetOpt, OSVVM_DEFAULT_DONE_NAME) ; + end function ResolveOsvvmDoneName ; + + impure function ResolveOsvvmDoneName(A, B : String) return string is + begin + return ResolveOsvvmOption(A, DoneNameVar.GetOpt, OSVVM_DEFAULT_DONE_NAME) ; + end function ResolveOsvvmDoneName ; + + impure function ResolveOsvvmPassName(A : String) return string is + begin + return ResolveOsvvmOption(A, PassNameVar.GetOpt, OSVVM_DEFAULT_PASS_NAME) ; + end function ResolveOsvvmPassName ; + + impure function ResolveOsvvmPassName(A, B : String) return string is + begin + return ResolveOsvvmOption(A, B, PassNameVar.GetOpt, OSVVM_DEFAULT_PASS_NAME) ; + end function ResolveOsvvmPassName ; + + impure function ResolveOsvvmFailName(A : String) return string is + begin + return ResolveOsvvmOption(A, FailNameVar.GetOpt, OSVVM_DEFAULT_FAIL_NAME) ; + end function ResolveOsvvmFailName ; + + impure function ResolveOsvvmFailName(A, B : String) return string is + begin + return ResolveOsvvmOption(A, B, FailNameVar.GetOpt, OSVVM_DEFAULT_FAIL_NAME) ; + end function ResolveOsvvmFailName ; + + impure function ResolveCovWritePassFail(A, B : OsvvmOptionsType) return OsvvmOptionsType is + begin + return ResolveOsvvmOption(A, B, WritePassFailVar.Get, OSVVM_DEFAULT_WRITE_PASS_FAIL) ; + end function ResolveCovWritePassFail ; -- Cov + + impure function ResolveCovWriteBinInfo(A, B : OsvvmOptionsType) return OsvvmOptionsType is + begin + return ResolveOsvvmOption(A, B, WriteBinInfoVar.Get, OSVVM_DEFAULT_WRITE_BIN_INFO) ; + end function ResolveCovWriteBinInfo ; -- Cov + + impure function ResolveCovWriteCount(A, B : OsvvmOptionsType) return OsvvmOptionsType is + begin + return ResolveOsvvmOption(A, B, WriteCountVar.Get, OSVVM_DEFAULT_WRITE_COUNT) ; + end function ResolveCovWriteCount ; -- Cov + + impure function ResolveCovWriteAnyIllegal(A, B : OsvvmOptionsType) return OsvvmOptionsType is + begin + return ResolveOsvvmOption(A, B, WriteAnyIllegalVar.Get, OSVVM_DEFAULT_WRITE_ANY_ILLEGAL) ; + end function ResolveCovWriteAnyIllegal ; -- Cov + + procedure OsvvmDeallocate is + begin + -- Free up space used by NamePType within OsvvmGlobalPkg + WritePrefixVar.Deallocate ; + DoneNameVar.Deallocate ; + PassNameVar.Deallocate ; + FailNameVar.Deallocate ; + WritePassFailVar.Set(FALSE) ; -- := FALSE ; + WriteBinInfoVar.Set(TRUE ) ; -- := TRUE ; + WriteCountVar.Set(TRUE ) ; -- := TRUE ; + WriteAnyIllegalVar.Set(FALSE) ; -- := FALSE ; + + end procedure OsvvmDeallocate ; + +end package body OsvvmGlobalPkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/RandomBasePkg.vhd b/testsuite/gna/issue317/OSVVM/RandomBasePkg.vhd new file mode 100644 index 000000000..9dc00d8e2 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/RandomBasePkg.vhd @@ -0,0 +1,234 @@ +-- +-- File Name: RandomBasePkg.vhd +-- Design Unit Name: RandomBasePkg +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis jim@synthworks.com +-- +-- +-- Description: +-- Defines Base randomization, seed definition, seed generation, +-- and seed IO functionality for RandomPkg.vhd +-- Defines: +-- Procedure Uniform - baseline randomization +-- Type RandomSeedType - the seed as a single object +-- function GenRandSeed from integer_vector, integer, or string +-- IO function to_string, & procedures write, read +-- +-- In revision 2.0 these types and functions are included by package reference. +-- Long term these will be passed as generics to RandomGenericPkg +-- +-- +-- 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/2008: 0.1 Initial revision +-- Numerous revisions for VHDL Testbenches and Verification +-- 02/2009: 1.0 First Public Released Version +-- 02/25/2009 1.1 Replaced reference to std_2008 with a reference +-- to ieee_proposed.standard_additions.all ; +-- 03/01/2011 2.0 STANDARD VERSION +-- Fixed abstraction by moving RandomParmType to RandomPkg.vhd +-- 4/2013 2013.04 No Changes +-- 5/2013 2013.05 No Changes +-- 1/2015 2015.01 Changed Assert/Report to Alert +-- 6/2015 2015.06 Changed GenRandSeed to impure +-- +-- +-- Copyright (c) 2008 - 2015 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.math_real.all ; +use std.textio.all ; + +use work.OsvvmGlobalPkg.all ; +use work.AlertLogPkg.all ; + +-- comment out following 2 lines with VHDL-2008. Leave in for VHDL-2002 +-- library ieee_proposed ; -- remove with VHDL-2008 +-- use ieee_proposed.standard_additions.all ; -- remove with VHDL-2008 + + +package RandomBasePkg is + + -- RandomSeedType and Uniform can be replaced by any procedure that + -- produces a uniform distribution with 0 <= Value < 1 or 0 < Value < 1 + -- and maintains the same call interface + type RandomSeedType is array (1 to 2) of integer ; + procedure Uniform (Result : out real ; Seed : inout RandomSeedType) ; + + -- Translate from integer_vector, integer, or string to RandomSeedType + -- Required by RandomPkg.InitSeed + -- GenRandSeed makes sure all values are in a valid range + impure function GenRandSeed(IV : integer_vector) return RandomSeedType ; + impure function GenRandSeed(I : integer) return RandomSeedType ; + impure function GenRandSeed(S : string) return RandomSeedType ; + + -- IO for RandomSeedType. If use subtype, then create aliases here + -- in a similar fashion VHDL-2008 std_logic_textio. + -- Not required by RandomPkg + function to_string(A : RandomSeedType) return string ; + procedure write(variable L: inout line ; A : RandomSeedType ) ; + procedure read (variable L: inout line ; A : out RandomSeedType ; good : out boolean ) ; + procedure read (variable L: inout line ; A : out RandomSeedType ) ; + +end RandomBasePkg ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +package body RandomBasePkg is + + ----------------------------------------------------------------- + -- Uniform + -- Generate a random number with a Uniform distribution + -- Required by RandomPkg. All randomization is derived from here. + -- Value produced must be either: + -- 0 <= Value < 1 or 0 < Value < 1 + -- + -- Current version uses ieee.math_real.Uniform + -- This abstraction allows higher precision version + -- of a uniform distribution to be used provided + -- + procedure Uniform ( + Result : out real ; + Seed : inout RandomSeedType + ) is + begin + ieee.math_real.Uniform (Seed(Seed'left), Seed(Seed'right), Result) ; + end procedure Uniform ; + + + ----------------------------------------------------------------- + -- GenRandSeed + -- Convert integer_vector to RandomSeedType + -- Uniform requires two seed values of the form: + -- 1 <= SEED1 <= 2147483562; 1 <= SEED2 <= 2147483398 + -- + -- if 2 seed values are passed to GenRandSeed and they are + -- in the above range, then they must remain unmodified. + -- + impure function GenRandSeed(IV : integer_vector) return RandomSeedType is + alias iIV : integer_vector(1 to IV'length) is IV ; + variable Seed1 : integer ; + variable Seed2 : integer ; + constant SEED1_MAX : integer := 2147483562 ; + constant SEED2_MAX : integer := 2147483398 ; + begin + if iIV'Length <= 0 then -- no seed + Alert(OSVVM_ALERTLOG_ID, "RandomBasePkg.GenRandSeed received NULL integer_vector", FAILURE) ; + return (3, 17) ; -- if continue seed = (3, 17) + + elsif iIV'Length = 1 then -- one seed value + -- inefficient handling, but condition is unlikely + return GenRandSeed(iIV(1)) ; -- generate a seed + + else -- only use the left two values + -- 1 <= SEED1 <= 2147483562 + -- mod returns 0 to MAX-1, the -1 adjusts legal values, +1 adjusts them back + Seed1 := ((iIV(1)-1) mod SEED1_MAX) + 1 ; + -- 1 <= SEED2 <= 2147483398 + Seed2 := ((iIV(2)-1) mod SEED2_MAX) + 1 ; + return (Seed1, Seed2) ; + end if ; + end function GenRandSeed ; + + + ----------------------------------------------------------------- + -- GenRandSeed + -- transform a single integer into the internal seed + -- + impure function GenRandSeed(I : integer) return RandomSeedType is + variable result : integer_vector(1 to 2) ; + begin + result(1) := I ; + result(2) := I/3 + 1 ; + return GenRandSeed(result) ; -- make value ranges legal + end function GenRandSeed ; + + + ----------------------------------------------------------------- + -- GenRandSeed + -- transform a string value into the internal seed + -- usage: RV.GenRandSeed(RV'instance_path)); + -- + impure function GenRandSeed(S : string) return RandomSeedType is + constant LEN : integer := S'length ; + constant HALF_LEN : integer := LEN/2 ; + alias revS : string(LEN downto 1) is S ; + variable result : integer_vector(1 to 2) ; + variable temp : integer := 0 ; + begin + for i in 1 to HALF_LEN loop + temp := (temp + character'pos(revS(i))) mod (integer'right - 2**8) ; + end loop ; + result(1) := temp ; + for i in HALF_LEN + 1 to LEN loop + temp := (temp + character'pos(revS(i))) mod (integer'right - 2**8) ; + end loop ; + result(2) := temp ; + return GenRandSeed(result) ; -- make value ranges legal + end function GenRandSeed ; + + + ----------------------------------------------------------------- + function to_string(A : RandomSeedType) return string is + begin + return to_string(A(A'left)) & " " & to_string(A(A'right)) ; + end function to_string ; + + + ----------------------------------------------------------------- + procedure write(variable L: inout line ; A : RandomSeedType ) is + begin + write(L, to_string(A)) ; + end procedure ; + + + ----------------------------------------------------------------- + procedure read(variable L: inout line ; A : out RandomSeedType ; good : out boolean ) is + variable iReadValid : boolean ; + begin + for i in A'range loop + read(L, A(i), iReadValid) ; + exit when not iReadValid ; + end loop ; + good := iReadValid ; + end procedure read ; + + + ----------------------------------------------------------------- + procedure read(variable L: inout line ; A : out RandomSeedType ) is + variable ReadValid : boolean ; + begin + read(L, A, ReadValid) ; + AlertIfNot(ReadValid, OSVVM_ALERTLOG_ID, "RandomBasePkg.read[line, RandomSeedType] failed", FAILURE) ; + end procedure read ; + +end RandomBasePkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/RandomPkg.vhd b/testsuite/gna/issue317/OSVVM/RandomPkg.vhd new file mode 100644 index 000000000..8c5065881 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/RandomPkg.vhd @@ -0,0 +1,1647 @@ +-- +-- File Name : RandomPkg.vhd +-- Design Unit Name : RandomPkg +-- Revision : STANDARD VERSION +-- +-- Maintainer : Jim Lewis email : jim@synthworks.com +-- Contributor(s) : +-- Jim Lewis email : jim@synthworks.com +-- * +-- +-- * In writing procedures normal, poisson, the following sources were referenced : +-- Wikipedia +-- package rnd2 written by John Breen and Ken Christensen +-- package RNG written by Gnanasekaran Swaminathan +-- +-- +-- Description : +-- RandomPType, a protected type, defined to hold randomization RandomSeeds and +-- function methods to facilitate randomization with uniform and weighted +-- distributions +-- +-- Developed for : +-- SynthWorks Design Inc. +-- VHDL Training Classes +-- 11898 SW 128th Ave. Tigard, Or 97223 +-- http ://www.SynthWorks.com +-- +-- Revision History : +-- Date Version Description +-- 12/2006 : 0.1 Initial revision +-- Numerous revisions for SynthWorks' Advanced VHDL Testbenches and Verification +-- 02/2009 : 1.0 First Public Released Version +-- 02/25/2009 1.1 Replaced reference to std_2008 with a reference to +-- ieee_proposed.standard_additions.all ; +-- 06/2010 1.2 Added Normal and Poisson distributions +-- 03/2011 2.0 Major clean-up. Moved RandomParmType and control to here +-- 07/2011 2.1 Bug fix to convenience functions for slv, unsigned, and signed. +-- 06/2012 2.2 Removed '_' in the name of subprograms FavorBig and FavorSmall +-- 04/2013 2013.04 Changed DistInt. Return array indices now match input +-- Better Min, Max error handling in Uniform, FavorBig, FavorSmall, Normal, Poisson +-- 5/2013 - Removed extra variable declaration in functions RandInt and RandReal +-- 5/2013 2013.05 Big vector randomization added overloading RandUnsigned, RandSlv, and RandSigned +-- Added NULL_RANGE_TYPE to minimize null range warnings +-- 1/2014 2014.01 Added RandTime, RandReal(set), RandIntV, RandRealV, RandTimeV +-- Made sort, revsort from SortListPkg_int visible via aliases +-- 1/2015 2015.01 Changed Assert/Report to Alert +-- 5/2015 2015.06 Revised Alerts to Alert(OSVVM_ALERTLOG_ID, ...) ; +-- 11/2016 2016.11 No changes. Updated release numbers to make documentation and +-- package have consistent release identifiers. +-- +-- Copyright (c) 2006 - 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 work.OsvvmGlobalPkg.all ; +use work.AlertLogPkg.all ; +use work.RandomBasePkg.all ; +use work.SortListPkg_int.all ; + +use std.textio.all ; + +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +use ieee.numeric_std_unsigned.all ; +use ieee.math_real.all ; + +-- comment out following 3 lines with VHDL-2008. Leave in for VHDL-2002 +-- library ieee_proposed ; -- remove with VHDL-2008 +-- use ieee_proposed.standard_additions.all ; -- remove with VHDL-2008 +-- use ieee_proposed.standard_textio_additions.all ; -- remove with VHDL-2008 + + +package RandomPkg is +-- Uncomment the following with VHDL-2008 package generics. +-- For now they are defined in the package RandomBasePkg.vhd +-- package RandomGenericPkg is + -- generic ( + -- type RandomSeedType ; -- base type for randomization + -- procedure Uniform (Result : out real ; Seed : inout RandomSeedType) ; + -- function GenRandSeed(IV : integer_vector) return RandomSeedType ; + -- function GenRandSeed(I : integer) return RandomSeedType ; + -- function GenRandSeed(S : string) return RandomSeedType ; + -- ) ; + + -- make things from SortListPkg_int visible + alias sort is work.SortListPkg_int.sort[integer_vector return integer_vector] ; + alias revsort is work.SortListPkg_int.revsort[integer_vector return integer_vector] ; + + -- note NULL_RANGE_TYPE should probably be in std.standard + subtype NULL_RANGE_TYPE is integer range 0 downto 1 ; + constant NULL_INTV : integer_vector (NULL_RANGE_TYPE) := (others => 0) ; + + -- Supports DistValInt functionality + type DistRecType is record + Value : integer ; + Weight : integer ; + end record ; + type DistType is array (natural range <>) of DistRecType ; + + + -- Parameters for randomization + -- RandomDistType specifies the distribution to use for randomize + type RandomDistType is (NONE, UNIFORM, FAVOR_SMALL, FAVOR_BIG, NORMAL, POISSON) ; + + type RandomParmType is record + Distribution : RandomDistType ; + Mean : Real ; -- also used as probability of success + StdDeviation : Real ; -- also used as number of trials for binomial + end record ; + + -- RandomParm IO + function to_string(A : RandomDistType) return string ; + procedure write(variable L : inout line ; A : RandomDistType ) ; + procedure read(variable L : inout line ; A : out RandomDistType ; good : out boolean ) ; + procedure read(variable L : inout line ; A : out RandomDistType ) ; + function to_string(A : RandomParmType) return string ; + procedure write(variable L : inout line ; A : RandomParmType ) ; + procedure read(variable L : inout line ; A : out RandomParmType ; good : out boolean ) ; + procedure read(variable L : inout line ; A : out RandomParmType ) ; + + + type RandomPType is protected + -- Seed Manipulation + -- Known ambiguity between InitSeed with string and integer_vector + -- Recommendation, use : RV.InitSeed(RV'instance_path) ; + -- For integer_vector use either : RV.InitSeed(IV => (1,5)) ; + -- or : RV.InitSeed(integer_vector'(1,5)) ; + procedure InitSeed (S : string ) ; + procedure InitSeed (I : integer ) ; + procedure InitSeed (IV : integer_vector ) ; + + -- SetSeed & GetSeed : Used to save and restore seed values + procedure SetSeed (RandomSeedIn : RandomSeedType ) ; + impure function GetSeed return RandomSeedType ; + -- SeedRandom = SetSeed & GetSeed for SV compatibility + -- replace with aliases when they work in popular simulators + procedure SeedRandom (RandomSeedIn : RandomSeedType ) ; + impure function SeedRandom return RandomSeedType ; + -- alias SeedRandom is SetSeed [RandomSeedType] ; + -- alias SeedRandom is GetSeed [return RandomSeedType] ; + + -- Setting Randomization Parameters + -- Allows RandInt to have distributions other than uniform + procedure SetRandomParm (RandomParmIn : RandomParmType) ; + procedure SetRandomParm ( + Distribution : RandomDistType ; + Mean : Real := 0.0 ; + Deviation : Real := 0.0 + ) ; + impure function GetRandomParm return RandomParmType ; + impure function GetRandomParm return RandomDistType ; + + -- For compatibility with previous version - replace with alias + procedure SetRandomMode (RandomDistIn : RandomDistType) ; + -- alias SetRandomMode is SetRandomParm [RandomDistType, Real, Real] ; + + -- Base Randomization Distributions + -- Uniform : Generate a random number with a Uniform distribution + impure function Uniform (Min, Max : in real) return real ; + impure function Uniform (Min, Max : integer) return integer ; + impure function Uniform (Min, Max : integer ; Exclude : integer_vector) return integer ; + + -- FavorSmall + -- Generate random numbers with a greater number of small + -- values than large values + impure function FavorSmall (Min, Max : real) return real ; + impure function FavorSmall (Min, Max : integer) return integer ; + impure function FavorSmall (Min, Max : integer ; Exclude : integer_vector) return integer ; + + -- FavorBig + -- Generate random numbers with a greater number of large + -- values than small values + impure function FavorBig (Min, Max : real) return real ; + impure function FavorBig (Min, Max : integer) return integer ; + impure function FavorBig (Min, Max : integer ; Exclude : integer_vector) return integer ; + + -- Normal : Generate a random number with a normal distribution + impure function Normal (Mean, StdDeviation : real) return real ; + -- Normal + RandomVal >= Min and RandomVal < Max + impure function Normal (Mean, StdDeviation, Min, Max : real) return real ; + impure function Normal ( + Mean : real ; + StdDeviation : real ; + Min : integer ; + Max : integer ; + Exclude : integer_vector := NULL_INTV + ) return integer ; + + -- Poisson : Generate a random number with a poisson distribution + -- Discrete distribution = only generates integral values + impure function Poisson (Mean : real) return real ; + -- Poisson + RandomVal >= Min and RandomVal < Max + impure function Poisson (Mean, Min, Max : real) return real ; + impure function Poisson ( + Mean : real ; + Min : integer ; + Max : integer ; + Exclude : integer_vector := NULL_INTV + ) return integer ; + + -- randomization with a range + impure function RandInt (Min, Max : integer) return integer ; + impure function RandReal(Min, Max : Real) return real ; + impure function RandTime (Min, Max : time ; Unit : time := ns) return time ; + impure function RandSlv (Min, Max, Size : natural) return std_logic_vector ; + impure function RandUnsigned (Min, Max, Size : natural) return Unsigned ; + impure function RandSigned (Min, Max : integer ; Size : natural ) return Signed ; + impure function RandIntV (Min, Max : integer ; Size : natural) return integer_vector ; + impure function RandIntV (Min, Max : integer ; Unique : natural ; Size : natural) return integer_vector ; + impure function RandRealV (Min, Max : real ; Size : natural) return real_vector ; + impure function RandTimeV (Min, Max : time ; Size : natural ; Unit : time := ns) return time_vector ; + impure function RandTimeV (Min, Max : time ; Unique : natural ; Size : natural ; Unit : time := ns) return time_vector ; + + -- randomization with a range and exclude vector + impure function RandInt (Min, Max : integer ; Exclude : integer_vector ) return integer ; + impure function RandTime (Min, Max : time ; Exclude : time_vector ; Unit : time := ns) return time ; + impure function RandSlv (Min, Max : natural ; Exclude : integer_vector ; Size : natural ) return std_logic_vector ; + impure function RandUnsigned (Min, Max : natural ; Exclude : integer_vector ; Size : natural ) return Unsigned ; + impure function RandSigned (Min, Max : integer ; Exclude : integer_vector ; Size : natural ) return Signed ; + impure function RandIntV (Min, Max : integer ; Exclude : integer_vector ; Size : natural) return integer_vector ; + impure function RandIntV (Min, Max : integer ; Exclude : integer_vector ; Unique : natural ; Size : natural) return integer_vector ; + impure function RandTimeV (Min, Max : time ; Exclude : time_vector ; Size : natural ; Unit : in time := ns) return time_vector ; + impure function RandTimeV (Min, Max : time ; Exclude : time_vector ; Unique : natural ; Size : natural ; Unit : in time := ns) return time_vector ; + + -- Randomly select a value within a set of values + impure function RandInt ( A : integer_vector ) return integer ; + impure function RandReal ( A : real_vector ) return real ; + impure function RandTime (A : time_vector) return time ; + impure function RandSlv (A : integer_vector ; Size : natural) return std_logic_vector ; + impure function RandUnsigned (A : integer_vector ; Size : natural) return Unsigned ; + impure function RandSigned (A : integer_vector ; Size : natural ) return Signed ; + impure function RandIntV (A : integer_vector ; Size : natural) return integer_vector ; + impure function RandIntV (A : integer_vector ; Unique : natural ; Size : natural) return integer_vector ; + impure function RandRealV (A : real_vector ; Size : natural) return real_vector ; + impure function RandRealV (A : real_vector ; Unique : natural ; Size : natural) return real_vector ; + impure function RandTimeV (A : time_vector ; Size : natural) return time_vector ; + impure function RandTimeV (A : time_vector ; Unique : natural ; Size : natural) return time_vector ; + + -- Randomly select a value within a set of values with exclude values (so can skip last or last n) + impure function RandInt ( A, Exclude : integer_vector ) return integer ; + impure function RandReal ( A, Exclude : real_vector ) return real ; + impure function RandTime (A, Exclude : time_vector) return time ; + impure function RandSlv (A, Exclude : integer_vector ; Size : natural) return std_logic_vector ; + impure function RandUnsigned (A, Exclude : integer_vector ; Size : natural) return Unsigned ; + impure function RandSigned (A, Exclude : integer_vector ; Size : natural ) return Signed ; + impure function RandIntV (A, Exclude : integer_vector ; Size : natural) return integer_vector ; + impure function RandIntV (A, Exclude : integer_vector ; Unique : natural ; Size : natural) return integer_vector ; + impure function RandRealV (A, Exclude : real_vector ; Size : natural) return real_vector ; + impure function RandRealV (A, Exclude : real_vector ; Unique : natural ; Size : natural) return real_vector ; + impure function RandTimeV (A, Exclude : time_vector ; Size : natural) return time_vector ; + impure function RandTimeV (A, Exclude : time_vector ; Unique : natural ; Size : natural) return time_vector ; + + -- Randomly select between 0 and N-1 based on the specified weight. + -- where N = number values in weight array + impure function DistInt ( Weight : integer_vector ) return integer ; + impure function DistSlv ( Weight : integer_vector ; Size : natural ) return std_logic_vector ; + impure function DistUnsigned ( Weight : integer_vector ; Size : natural ) return unsigned ; + impure function DistSigned ( Weight : integer_vector ; Size : natural ) return signed ; + + -- Distribution with just weights and with exclude values + impure function DistInt ( Weight : integer_vector ; Exclude : integer_vector ) return integer ; + impure function DistSlv ( Weight : integer_vector ; Exclude : integer_vector ; Size : natural ) return std_logic_vector ; + impure function DistUnsigned ( Weight : integer_vector ; Exclude : integer_vector ; Size : natural ) return unsigned ; + impure function DistSigned ( Weight : integer_vector ; Exclude : integer_vector ; Size : natural ) return signed ; + + -- Distribution with weight and value + impure function DistValInt ( A : DistType ) return integer ; + impure function DistValSlv ( A : DistType ; Size : natural) return std_logic_vector ; + impure function DistValUnsigned ( A : DistType ; Size : natural) return unsigned ; + impure function DistValSigned ( A : DistType ; Size : natural) return signed ; + + -- Distribution with weight and value and with exclude values + impure function DistValInt ( A : DistType ; Exclude : integer_vector ) return integer ; + impure function DistValSlv ( A : DistType ; Exclude : integer_vector ; Size : natural) return std_logic_vector ; + impure function DistValUnsigned ( A : DistType ; Exclude : integer_vector ; Size : natural) return unsigned ; + impure function DistValSigned ( A : DistType ; Exclude : integer_vector ; Size : natural) return signed ; + + -- Large vector handling. + impure function RandUnsigned (Size : natural) return unsigned ; + impure function RandSlv (Size : natural) return std_logic_vector ; + impure function RandSigned (Size : natural) return signed ; + impure function RandUnsigned (Max : Unsigned) return unsigned ; + impure function RandSlv (Max : std_logic_vector) return std_logic_vector ; + impure function RandSigned (Max : signed) return signed ; + impure function RandUnsigned (Min, Max : unsigned) return unsigned ; + impure function RandSlv (Min, Max : std_logic_vector) return std_logic_vector ; + impure function RandSigned (Min, Max : signed) return signed ; + + -- Convenience Functions + impure function RandReal return real ; -- 0.0 to 1.0 + impure function RandReal(Max : Real) return real ; -- 0.0 to Max + impure function RandInt (Max : integer) return integer ; + impure function RandSlv (Max, Size : natural) return std_logic_vector ; + impure function RandUnsigned (Max, Size : natural) return Unsigned ; + impure function RandSigned (Max : integer ; Size : natural ) return Signed ; + + end protected RandomPType ; + +end RandomPkg ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +package body RandomPkg is + + ----------------------------------------------------------------- + -- Local Randomization Support + ----------------------------------------------------------------- + constant NULL_SLV : std_logic_vector (NULL_RANGE_TYPE) := (others => '0') ; + constant NULL_UV : unsigned (NULL_RANGE_TYPE) := (others => '0') ; + constant NULL_SV : signed (NULL_RANGE_TYPE) := (others => '0') ; + + ----------------------------------------------------------------- + -- Scale -- Scale a value to be within a given range + -- + function Scale (A, Min, Max : real) return real is + variable ValRange : Real ; + begin + if Max >= Min then + ValRange := Max - Min ; + return A * ValRange + Min ; + else + return real'left ; + end if ; + end function Scale ; + + function Scale (A : real ; Min, Max : integer) return integer is + variable ValRange : real ; + variable rMin, rMax : real ; + begin + if Max >= Min then + rMin := real(Min) - 0.5 ; + rMax := real(Max) + 0.5 ; + ValRange := rMax - rMin ; + return integer(round(A * ValRange + rMin)) ; + else + return integer'left ; + end if ; + end function Scale ; + + -- create more smaller values + function FavorSmall (A : real) return real is + begin + return 1.0 - sqrt(A) ; + end FavorSmall ; + + -- create more larger values + -- alias FavorBig is sqrt[real return real] ; + function FavorBig (A : real) return real is + begin + return sqrt(A) ; + end FavorBig ; + + -- local. + function to_time_vector (A : integer_vector ; Unit : time) return time_vector is + variable result : time_vector(A'range) ; + begin + for i in A'range loop + result(i) := A(i) * Unit ; + end loop ; + return result ; + end function to_time_vector ; + + -- local + function to_integer_vector (A : time_vector ; Unit : time) return integer_vector is + variable result : integer_vector(A'range) ; + begin + for i in A'range loop + result(i) := A(i) / Unit ; + end loop ; + return result ; + end function to_integer_vector ; + + -- Local. Remove the exclude list from the list - integer_vector + procedure RemoveExclude(A, Exclude : integer_vector ; variable NewA : out integer_vector ; variable NewALength : inout natural ) is + alias norm_NewA : integer_vector(1 to NewA'length) is NewA ; + begin + NewALength := 0 ; + for i in A'range loop + if not inside(A(i), Exclude) then + NewALength := NewALength + 1 ; + norm_NewA(NewALength) := A(i) ; + end if ; + end loop ; + end procedure RemoveExclude ; + + -- Local. Inside - real_vector + function inside(A : real ; Exclude : real_vector) return boolean is + begin + for i in Exclude'range loop + if A = Exclude(i) then + return TRUE ; + end if ; + end loop ; + return FALSE ; + end function inside ; + + -- Local. Remove the exclude list from the list - real_vector + procedure RemoveExclude(A, Exclude : real_vector ; variable NewA : out real_vector ; variable NewALength : inout natural ) is + alias norm_NewA : real_vector(1 to NewA'length) is NewA ; + begin + NewALength := 0 ; + for i in A'range loop + if not inside(A(i), Exclude) then + NewALength := NewALength + 1 ; + norm_NewA(NewALength) := A(i) ; + end if ; + end loop ; + end procedure RemoveExclude ; + + -- Local. Inside - time_vector + function inside(A : time ; Exclude : time_vector) return boolean is + begin + for i in Exclude'range loop + if A = Exclude(i) then + return TRUE ; + end if ; + end loop ; + return FALSE ; + end function inside ; + + -- Local. Remove the exclude list from the list - time_vector + procedure RemoveExclude(A, Exclude : time_vector ; variable NewA : out time_vector ; variable NewALength : inout natural ) is + alias norm_NewA : time_vector(1 to NewA'length) is NewA ; + begin + NewALength := 0 ; + for i in A'range loop + if not inside(A(i), Exclude) then + NewALength := NewALength + 1 ; + norm_NewA(NewALength) := A(i) ; + end if ; + end loop ; + end procedure RemoveExclude ; + + + ----------------------------------------------------------------- + -- RandomParmType IO + ----------------------------------------------------------------- + ----------------------------------------------------------------- + function to_string(A : RandomDistType) return string is + begin + return RandomDistType'image(A) ; + end function to_string ; + + + ----------------------------------------------------------------- + procedure write(variable L : inout line ; A : RandomDistType ) is + begin + write(L, to_string(A)) ; + end procedure write ; + + + ----------------------------------------------------------------- + procedure read(variable L : inout line ; A : out RandomDistType ; good : out boolean ) is + variable strval : string(1 to 40) ; + variable len : natural ; + begin + -- procedure SREAD (L : inout LINE ; VALUE : out STRING ; STRLEN : out NATURAL) ; + sread(L, strval, len) ; + A := RandomDistType'value(strval(1 to len)) ; + good := len > 0 ; + end procedure read ; + + + ----------------------------------------------------------------- + procedure read(variable L : inout line ; A : out RandomDistType ) is + variable ReadValid : boolean ; + begin + read(L, A, ReadValid) ; + AlertIfNot( OSVVM_ALERTLOG_ID, ReadValid, "RandomPkg.read[line, RandomDistType] failed", FAILURE) ; + end procedure read ; + + + ----------------------------------------------------------------- + function to_string(A : RandomParmType) return string is + begin + return RandomDistType'image(A.Distribution) & " " & + to_string(A.Mean, 2) & " " & to_string(A.StdDeviation, 2) ; + end function to_string ; + + + ----------------------------------------------------------------- + procedure write(variable L : inout line ; A : RandomParmType ) is + begin + write(L, to_string(A)) ; + end procedure write ; + + + ----------------------------------------------------------------- + procedure read(variable L : inout line ; A : out RandomParmType ; good : out boolean ) is + variable strval : string(1 to 40) ; + variable len : natural ; + variable igood : boolean ; + begin + loop + -- procedure SREAD (L : inout LINE ; VALUE : out STRING ; STRLEN : out NATURAL) ; + sread(L, strval, len) ; + A.Distribution := RandomDistType'value(strval(1 to len)) ; + igood := len > 0 ; + exit when not igood ; + + read(L, A.Mean, igood) ; + exit when not igood ; + + read(L, A.StdDeviation, igood) ; + exit ; + end loop ; + good := igood ; + end procedure read ; + + + ----------------------------------------------------------------- + procedure read(variable L : inout line ; A : out RandomParmType ) is + variable ReadValid : boolean ; + begin + read(L, A, ReadValid) ; + AlertIfNot( OSVVM_ALERTLOG_ID, ReadValid, "RandomPkg.read[line, RandomParmType] failed", FAILURE) ; + end procedure read ; + + + + ----------------------------------------------------------------- + ----------------------------------------------------------------- + type RandomPType is protected body + -- + -- RandomSeed manipulation + -- + variable RandomSeed : RandomSeedType := GenRandSeed(integer_vector'(1,7)) ; + + procedure InitSeed (S : string ) is + begin + RandomSeed := GenRandSeed(S) ; + end procedure InitSeed ; + + procedure InitSeed (I : integer ) is + begin + RandomSeed := GenRandSeed(I) ; + end procedure InitSeed ; + + procedure InitSeed (IV : integer_vector ) is + begin + RandomSeed := GenRandSeed(IV) ; + end procedure InitSeed ; + + procedure SetSeed (RandomSeedIn : RandomSeedType ) is + begin + RandomSeed := RandomSeedIn ; + end procedure SetSeed ; + + procedure SeedRandom (RandomSeedIn : RandomSeedType ) is + begin + RandomSeed := RandomSeedIn ; + end procedure SeedRandom ; + + impure function GetSeed return RandomSeedType is + begin + return RandomSeed ; + end function GetSeed ; + + impure function SeedRandom return RandomSeedType is + begin + return RandomSeed ; + end function SeedRandom ; + + + -- + -- randomization mode + -- + variable RandomParm : RandomParmType ; -- left most values ok for init + + procedure SetRandomParm (RandomParmIn : RandomParmType) is + begin + RandomParm := RandomParmIn ; + end procedure SetRandomParm ; + + procedure SetRandomParm ( + Distribution : RandomDistType ; + Mean : Real := 0.0 ; + Deviation : Real := 0.0 + ) is + begin + RandomParm := RandomParmType'(Distribution, Mean, Deviation) ; + end procedure SetRandomParm ; + + + impure function GetRandomParm return RandomParmType is + begin + return RandomParm ; + end function GetRandomParm ; + + + impure function GetRandomParm return RandomDistType is + begin + return RandomParm.Distribution ; + end function GetRandomParm ; + + + -- For compatibility with previous version + procedure SetRandomMode (RandomDistIn : RandomDistType) is + begin + SetRandomParm(RandomDistIn) ; + end procedure SetRandomMode ; + + + -- + -- Base Randomization Distributions + -- + -- + -- Uniform : Generate a random number with a Uniform distribution + -- + impure function Uniform (Min, Max : in real) return real is + variable rRandomVal : real ; + begin + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.Uniform: Max < Min", FAILURE) ; + Uniform(rRandomVal, RandomSeed) ; + return scale(rRandomVal, Min, Max) ; + end function Uniform ; + + impure function Uniform (Min, Max : integer) return integer is + variable rRandomVal : real ; + begin + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.Uniform: Max < Min", FAILURE) ; + Uniform(rRandomVal, RandomSeed) ; + return scale(rRandomVal, Min, Max) ; + end function Uniform ; + + impure function Uniform (Min, Max : integer ; Exclude : integer_vector) return integer is + variable iRandomVal : integer ; + variable ExcludeList : SortListPType ; + variable count : integer ; + begin + ExcludeList.add(Exclude, Min, Max) ; + count := ExcludeList.count ; + iRandomVal := Uniform(Min, Max - count) ; + -- adjust count, note iRandomVal changes while checking. + for i in 1 to count loop + exit when iRandomVal < ExcludeList.Get(i) ; + iRandomVal := iRandomVal + 1 ; + end loop ; + ExcludeList.erase ; + return iRandomVal ; + end function Uniform ; + + + -- + -- FavorSmall + -- Generate random numbers with a greater number of small + -- values than large values + -- + impure function FavorSmall (Min, Max : real) return real is + variable rRandomVal : real ; + begin + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorSmall: Max < Min", FAILURE) ; + Uniform(rRandomVal, RandomSeed) ; + return scale(FavorSmall(rRandomVal), Min, Max) ; -- real + end function FavorSmall ; + + impure function FavorSmall (Min, Max : integer) return integer is + variable rRandomVal : real ; + begin + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorSmall: Max < Min", FAILURE) ; + Uniform(rRandomVal, RandomSeed) ; + return scale(FavorSmall(rRandomVal), Min, Max) ; -- integer + end function FavorSmall ; + + impure function FavorSmall (Min, Max : integer ; Exclude : integer_vector) return integer is + variable iRandomVal : integer ; + variable ExcludeList : SortListPType ; + variable count : integer ; + begin + ExcludeList.add(Exclude, Min, Max) ; + count := ExcludeList.count ; + iRandomVal := FavorSmall(Min, Max - count) ; + -- adjust count, note iRandomVal changes while checking. + for i in 1 to count loop + exit when iRandomVal < ExcludeList.Get(i) ; + iRandomVal := iRandomVal + 1 ; + end loop ; + ExcludeList.erase ; + return iRandomVal ; + end function FavorSmall ; + + + -- + -- FavorBig + -- Generate random numbers with a greater number of large + -- values than small values + -- + impure function FavorBig (Min, Max : real) return real is + variable rRandomVal : real ; + begin + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorBig: Max < Min", FAILURE) ; + Uniform(rRandomVal, RandomSeed) ; + return scale(FavorBig(rRandomVal), Min, Max) ; -- real + end function FavorBig ; + + impure function FavorBig (Min, Max : integer) return integer is + variable rRandomVal : real ; + begin + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorBig: Max < Min", FAILURE) ; + Uniform(rRandomVal, RandomSeed) ; + return scale(FavorBig(rRandomVal), Min, Max) ; -- integer + end function FavorBig ; + + impure function FavorBig (Min, Max : integer ; Exclude : integer_vector) return integer is + variable iRandomVal : integer ; + variable ExcludeList : SortListPType ; + variable count : integer ; + begin + ExcludeList.add(Exclude, Min, Max) ; + count := ExcludeList.count ; + iRandomVal := FavorBig(Min, Max - count) ; + -- adjust count, note iRandomVal changes while checking. + for i in 1 to count loop + exit when iRandomVal < ExcludeList.Get(i) ; + iRandomVal := iRandomVal + 1 ; + end loop ; + ExcludeList.erase ; + return iRandomVal ; + end function FavorBig ; + + + ----------------------------------------------------------------- + -- Normal + -- Generate a random number with a normal distribution + -- + -- Use Box Muller, per Wikipedia : + -- http ://en.wikipedia.org/wiki/Box%E2%80%93Muller_transform + -- + -- Use polar method, per Wikipedia : + -- http ://en.wikipedia.org/wiki/Marsaglia_polar_method + -- + impure function Normal (Mean, StdDeviation : real) return real is + variable x01, y01 : real ; + variable StdNormalDist : real ; -- mean 0, variance 1 + begin + -- add this check to set parameters? + if StdDeviation < 0.0 then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Normal: Standard deviation must be >= 0.0", FAILURE) ; + return -1.0 ; + end if ; + + -- Box Muller + Uniform (x01, RandomSeed) ; + Uniform (y01, RandomSeed) ; + StdNormalDist := sqrt(-2.0 * log(x01)) * cos(math_2_pi*y01) ; + + -- Polar form rejected due to mean 50.0, std deviation = 5 resulted + -- in a median of 49 + -- -- find two Uniform distributed values with range -1 to 1 + -- -- that satisify S = X **2 + Y**2 < 1.0 + -- loop + -- Uniform (x01, RandomSeed) ; + -- Uniform (y01, RandomSeed) ; + -- x := 2.0 * x01 - 1.0 ; -- scale to -1 to 1 + -- y := 2.0 * y01 - 1.0 ; + -- s := x*x + y*y ; + -- exit when s < 1.0 and s > 0.0 ; + -- end loop ; + + -- -- Calculate Standard Normal Distribution + -- StdNormalDist := x * sqrt((-2.0 * log(s)) / s) ; + + -- Convert to have Mean and StdDeviation + return StdDeviation * StdNormalDist + Mean ; + end function Normal ; + + + -- Normal + RandomVal >= Min and RandomVal <= Max + impure function Normal (Mean, StdDeviation, Min, Max : real) return real is + variable rRandomVal : real ; + begin + if Max < Min then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Normal: Max < Min", FAILURE) ; + return Mean ; + else + loop + rRandomVal := Normal (Mean, StdDeviation) ; + exit when rRandomVal >= Min and rRandomVal <= Max ; + end loop ; + end if ; + return rRandomVal ; + end function Normal ; + + -- Normal + RandomVal >= Min and RandomVal <= Max + impure function Normal ( + Mean : real ; + StdDeviation : real ; + Min : integer ; + Max : integer ; + Exclude : integer_vector := NULL_INTV + ) return integer is + variable iRandomVal : integer ; + begin + if Max < Min then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Normal: Max < Min", FAILURE) ; + return integer(round(Mean)) ; + else + loop + iRandomVal := integer(round( Normal(Mean, StdDeviation) )) ; + exit when iRandomVal >= Min and iRandomVal <= Max and + not inside(iRandomVal, Exclude) ; + end loop ; + end if ; + return iRandomVal ; + end function Normal ; + + + ----------------------------------------------------------------- + -- Poisson + -- Generate a random number with a poisson distribution + -- Discrete distribution = only generates integral values + -- + -- Use knuth method, per Wikipedia : + -- http ://en.wikipedia.org/wiki/Poisson_distribution + -- + impure function Poisson (Mean : real) return real is + variable Product : Real := 1.0 ; + variable Bound : Real := 0.0 ; + variable UniformRand : Real := 0.0 ; + variable PoissonRand : Real := 0.0 ; + begin + Bound := exp(-1.0 * Mean) ; + Product := 1.0 ; + + -- add this check to set parameters? + if Mean <= 0.0 or Bound <= 0.0 then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Poisson: Mean < 0 or too large. Mean = " & real'image(Mean), FAILURE) ; + return Mean ; + end if ; + + while (Product >= Bound) loop + PoissonRand := PoissonRand + 1.0 ; + Uniform(UniformRand, RandomSeed) ; + Product := Product * UniformRand ; + end loop ; + return PoissonRand ; + end function Poisson ; -- no range + + -- Poisson + RandomVal >= Min and RandomVal < Max + impure function Poisson (Mean, Min, Max : real) return real is + variable rRandomVal : real ; + begin + if Max < Min then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Poisson: Max < Min", FAILURE) ; + return Mean ; + else + loop + rRandomVal := Poisson (Mean) ; + exit when rRandomVal >= Min and rRandomVal <= Max ; + end loop ; + end if ; + return rRandomVal ; + end function Poisson ; + + impure function Poisson ( + Mean : real ; + Min : integer ; + Max : integer ; + Exclude : integer_vector := NULL_INTV + ) return integer is + variable iRandomVal : integer ; + begin + if Max < Min then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Poisson: Max < Min", FAILURE) ; + return integer(round(Mean)) ; + else + loop + iRandomVal := integer(round( Poisson (Mean) )) ; + exit when iRandomVal >= Min and iRandomVal <= Max and + not inside(iRandomVal, Exclude) ; + end loop ; + end if ; + return iRandomVal ; + end function Poisson ; + + + -- + -- integer randomization with a range + -- Distribution determined by RandomParm + -- + impure function RandInt (Min, Max : integer) return integer is + begin + case RandomParm.Distribution is + when NONE | UNIFORM => return Uniform(Min, Max) ; + when FAVOR_SMALL => return FavorSmall(Min, Max) ; + when FAVOR_BIG => return FavorBig (Min, Max) ; + when NORMAL => return Normal(RandomParm.Mean, RandomParm.StdDeviation, Min, Max) ; + when POISSON => return Poisson(RandomParm.Mean, Min, Max) ; + when others => + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandInt: RandomParm.Distribution not implemented", FAILURE) ; + return integer'low ; + end case ; + end function RandInt ; + + -- + -- real randomization with a range + -- Distribution determined by RandomParm + -- + impure function RandReal(Min, Max : Real) return real is + begin + case RandomParm.Distribution is + when NONE | UNIFORM => return Uniform(Min, Max) ; + when FAVOR_SMALL => return FavorSmall(Min, Max) ; + when FAVOR_BIG => return FavorBig (Min, Max) ; + when NORMAL => return Normal(RandomParm.Mean, RandomParm.StdDeviation, Min, Max) ; + when POISSON => return Poisson(RandomParm.Mean, Min, Max) ; + when others => + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandReal: Specified RandomParm.Distribution not implemented", FAILURE) ; + return real(integer'low) ; + end case ; + end function RandReal ; + + impure function RandTime (Min, Max : time ; Unit :time := ns) return time is + variable IntVal : integer ; + begin + -- if Max - Min > 2**31 result will be out of range + IntVal := RandInt(0, (Max - Min)/Unit) ; + Return Min + Unit*IntVal ; + end function RandTime ; + + impure function RandSlv (Min, Max, Size : natural) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(RandInt(Min, Max), Size)) ; + end function RandSlv ; + + impure function RandUnsigned (Min, Max, Size : natural) return Unsigned is + begin + return to_unsigned(RandInt(Min, Max), Size) ; + end function RandUnsigned ; + + impure function RandSigned (Min, Max : integer ; Size : natural ) return Signed is + begin + return to_signed(RandInt(Min, Max), Size) ; + end function RandSigned ; + + impure function RandIntV (Min, Max : integer ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandInt(Min, Max) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandIntV (Min, Max : integer ; Unique : natural ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + variable iUnique : natural ; + begin + -- if Unique = 0, it is more efficient to call RandIntV(Min, Max, Size) + iUnique := Unique ; + if Max-Min+1 < Unique then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.(RandIntV | RandRealV | RandTimeV): Unique > number of values available", FAILURE) ; + iUnique := Max-Min+1 ; + end if ; + for i in result'range loop + result(i) := RandInt(Min, Max, result(maximum(1, 1 + i - iUnique) to Size)) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandRealV (Min, Max : real ; Size : natural) return real_vector is + variable result : real_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandReal(Min, Max) ; + end loop ; + return result ; + end function RandRealV ; + + impure function RandTimeV (Min, Max : time ; Size : natural ; Unit : time := ns) return time_vector is + variable result : time_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandTime(Min, Max, Unit) ; + end loop ; + return result ; + end function RandTimeV ; + + impure function RandTimeV (Min, Max : time ; Unique : natural ; Size : natural ; Unit : time := ns) return time_vector is + begin + -- if Unique = 0, it is more efficient to call RandTimeV(Min, Max, Size) + return to_time_vector(RandIntV(Min/Unit, Max/Unit, Unique, Size), Unit) ; + end function RandTimeV ; + + + -- + -- integer randomization with a range and exclude vector + -- Distribution determined by RandomParm + -- + impure function RandInt (Min, Max : integer ; Exclude : integer_vector ) return integer is + begin + case RandomParm.Distribution is + when NONE | UNIFORM => return Uniform(Min, Max, Exclude) ; + when FAVOR_SMALL => return FavorSmall(Min, Max, Exclude) ; + when FAVOR_BIG => return FavorBig (Min, Max, Exclude) ; + when NORMAL => return Normal(RandomParm.Mean, RandomParm.StdDeviation, Min, Max, Exclude) ; + when POISSON => return Poisson(RandomParm.Mean, Min, Max, Exclude) ; + when others => + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandInt: Specified RandomParm.Distribution not implemented", FAILURE) ; + return integer'low ; + end case ; + end function RandInt ; + + impure function RandTime (Min, Max : time ; Exclude : time_vector ; Unit : time := ns) return time is + variable IntVal : integer ; + begin + -- if Min or Max > 2**31 value will be out of range + return RandInt(Min/Unit, Max/Unit, to_integer_vector(Exclude, Unit)) * Unit ; + end function RandTime ; + + impure function RandSlv (Min, Max : natural ; Exclude : integer_vector ; Size : natural ) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(RandInt(Min, Max, Exclude), Size)) ; + end function RandSlv ; + + impure function RandUnsigned (Min, Max : natural ; Exclude : integer_vector ; Size : natural ) return Unsigned is + begin + return to_unsigned(RandInt(Min, Max, Exclude), Size) ; + end function RandUnsigned ; + + impure function RandSigned (Min, Max : integer ; Exclude : integer_vector ; Size : natural ) return Signed is + begin + return to_signed(RandInt(Min, Max, Exclude), Size) ; + end function RandSigned ; + + impure function RandIntV (Min, Max : integer ; Exclude : integer_vector ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandInt(Min, Max, Exclude) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandIntV (Min, Max : integer ; Exclude : integer_vector ; Unique : natural ; Size : natural) return integer_vector is + variable ResultPlus : integer_vector(1 to Size + Exclude'length) ; + begin + -- if Unique = 0, it is more efficient to call RandIntV(Min, Max, Size) + ResultPlus(Size+1 to ResultPlus'right) := Exclude ; + for i in 1 to Size loop + ResultPlus(i) := RandInt(Min, Max, ResultPlus(maximum(1, 1 + i - Unique) to ResultPlus'right)) ; + end loop ; + return ResultPlus(1 to Size) ; + end function RandIntV ; + + impure function RandTimeV (Min, Max : time ; Exclude : time_vector ; Size : natural ; Unit : in time := ns) return time_vector is + begin + return to_time_vector( RandIntV(Min/Unit, Max/Unit, to_integer_vector(Exclude, Unit), Size), Unit ) ; + end function RandTimeV ; + + impure function RandTimeV (Min, Max : time ; Exclude : time_vector ; Unique : natural ; Size : natural ; Unit : in time := ns) return time_vector is + begin + -- if Unique = 0, it is more efficient to call RandIntV(Min, Max, Size) + return to_time_vector( RandIntV(Min/Unit, Max/Unit, to_integer_vector(Exclude, Unit), Unique, Size), Unit ) ; + end function RandTimeV ; + + + + -- + -- Randomly select a value within a set of values + -- Distribution determined by RandomParm + -- + impure function RandInt ( A : integer_vector ) return integer is + alias A_norm : integer_vector(1 to A'length) is A ; + begin + return A_norm( RandInt(1, A'length) ) ; + end function RandInt ; + + impure function RandReal ( A : real_vector ) return real is + alias A_norm : real_vector(1 to A'length) is A ; + begin + return A_norm( RandInt(1, A'length) ) ; + end function RandReal ; + + impure function RandTime ( A : time_vector ) return time is + alias A_norm : time_vector(1 to A'length) is A ; + begin + return A_norm( RandInt(1, A'length) ) ; + end function RandTime ; + + impure function RandSlv (A : integer_vector ; Size : natural) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(RandInt(A), Size)) ; + end function RandSlv ; + + impure function RandUnsigned (A : integer_vector ; Size : natural) return Unsigned is + begin + return to_unsigned(RandInt(A), Size) ; + end function RandUnsigned ; + + impure function RandSigned (A : integer_vector ; Size : natural ) return Signed is + begin + return to_signed(RandInt(A), Size) ; + end function RandSigned ; + + impure function RandIntV (A : integer_vector ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandInt(A) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandIntV (A : integer_vector ; Unique : natural ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + variable iUnique : natural ; + begin + -- if Unique = 0, it is more efficient to call RandIntV(A, Size) + -- require A'length >= Unique + iUnique := Unique ; + if A'length < Unique then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandIntV: Unique > length of set of values", FAILURE) ; + iUnique := A'length ; + end if ; + for i in result'range loop + result(i) := RandInt(A, result(maximum(1, 1 + i - iUnique) to Size)) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandRealV (A : real_vector ; Size : natural) return real_vector is + variable result : real_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandReal(A) ; + end loop ; + return result ; + end function RandRealV ; + + impure function RandRealV (A : real_vector ; Unique : natural ; Size : natural) return real_vector is + alias A_norm : real_vector(1 to A'length) is A ; + variable result : real_vector(1 to Size) ; + variable IntResult : integer_vector(result'range) ; + begin + -- randomly generate indices + IntResult := RandIntV(1, A'length, Unique, Size) ; + -- translate indicies into result values + for i in result'range loop + result(i) := A_norm(IntResult(i)) ; + end loop ; + return result ; + end function RandRealV ; + + impure function RandTimeV (A : time_vector ; Size : natural) return time_vector is + variable result : time_vector(1 to Size) ; + begin + for i in result'range loop + result(i) := RandTime(A) ; + end loop ; + return result ; + end function RandTimeV ; + + impure function RandTimeV (A : time_vector ; Unique : natural ; Size : natural) return time_vector is + alias A_norm : time_vector(1 to A'length) is A ; + variable result : time_vector(1 to Size) ; + variable IntResult : integer_vector(result'range) ; + begin + -- randomly generate indices + IntResult := RandIntV(1, A'length, Unique, Size) ; + -- translate indicies into result values + for i in result'range loop + result(i) := A_norm(IntResult(i)) ; + end loop ; + return result ; + end function RandTimeV ; + + + -- + -- Randomly select a value within a set of values with exclude values (so can skip last or last n) + -- Distribution determined by RandomParm + -- + + impure function RandInt ( A, Exclude : integer_vector ) return integer is + variable NewA : integer_vector(1 to A'length) ; + variable NewALength : natural ; + begin + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Randomize Index + return NewA(RandInt(1, NewALength)) ; + end function RandInt ; + + impure function RandReal ( A, Exclude : real_vector ) return real is + variable NewA : real_vector(1 to A'length) ; + variable NewALength : natural ; + begin + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Randomize Index + return NewA(RandInt(1, NewALength)) ; + end function RandReal ; + + impure function RandTime ( A, Exclude : time_vector ) return time is + variable NewA : time_vector(1 to A'length) ; + variable NewALength : natural ; + begin + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Randomize Index + return NewA(RandInt(1, NewALength)) ; + end function RandTime ; + + impure function RandSlv (A, Exclude : integer_vector ; Size : natural) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(RandInt(A, Exclude), Size)) ; + end function RandSlv ; + + impure function RandUnsigned (A, Exclude : integer_vector ; Size : natural) return Unsigned is + begin + return to_unsigned(RandInt(A, Exclude), Size) ; + end function RandUnsigned ; + + impure function RandSigned (A, Exclude : integer_vector ; Size : natural ) return Signed is + begin + return to_signed(RandInt(A, Exclude), Size) ; + end function RandSigned ; + + impure function RandIntV (A, Exclude : integer_vector ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + variable NewA : integer_vector(1 to A'length) ; + variable NewALength : natural ; + begin + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Randomize Index + for i in result'range loop + result(i) := NewA(RandInt(1, NewALength)) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandIntV (A, Exclude : integer_vector ; Unique : natural ; Size : natural) return integer_vector is + variable result : integer_vector(1 to Size) ; + variable NewA : integer_vector(1 to A'length) ; + variable NewALength, iUnique : natural ; + begin + -- if Unique = 0, it is more efficient to call RandIntV(Min, Max, Size) + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Require NewALength >= Unique + iUnique := Unique ; + if NewALength < Unique then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandIntV: Unique > Length of Set A - Exclude", FAILURE) ; + iUnique := NewALength ; + end if ; + -- Randomize using exclude list of Unique # of newly generated values + for i in result'range loop + result(i) := RandInt(NewA(1 to NewALength), result(maximum(1, 1 + i - iUnique) to Size)) ; + end loop ; + return result ; + end function RandIntV ; + + impure function RandRealV (A, Exclude : real_vector ; Size : natural) return real_vector is + variable result : real_vector(1 to Size) ; + variable NewA : real_vector(1 to A'length) ; + variable NewALength : natural ; + begin + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Randomize Index + for i in result'range loop + result(i) := NewA(RandInt(1, NewALength)) ; + end loop ; + return result ; + end function RandRealV ; + + impure function RandRealV (A, Exclude : real_vector ; Unique : natural ; Size : natural) return real_vector is + variable result : real_vector(1 to Size) ; + variable NewA : real_vector(1 to A'length) ; + variable NewALength, iUnique : natural ; + begin + -- if Unique = 0, it is more efficient to call RandRealV(Min, Max, Size) + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Require NewALength >= Unique + iUnique := Unique ; + if NewALength < Unique then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandRealV: Unique > Length of Set A - Exclude", FAILURE) ; + iUnique := NewALength ; + end if ; + -- Randomize using exclude list of Unique # of newly generated values + for i in result'range loop + result(i) := RandReal(NewA(1 to NewALength), result(maximum(1, 1 + i - iUnique) to Size)) ; + end loop ; + return result ; + end function RandRealV ; + + impure function RandTimeV (A, Exclude : time_vector ; Size : natural) return time_vector is + variable result : time_vector(1 to Size) ; + variable NewA : time_vector(1 to A'length) ; + variable NewALength : natural ; + begin + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Randomize Index + for i in result'range loop + result(i) := NewA(RandInt(1, NewALength)) ; + end loop ; + return result ; + end function RandTimeV ; + + impure function RandTimeV (A, Exclude : time_vector ; Unique : natural ; Size : natural) return time_vector is + variable result : time_vector(1 to Size) ; + variable NewA : time_vector(1 to A'length) ; + variable NewALength, iUnique : natural ; + begin + -- if Unique = 0, it is more efficient to call RandRealV(Min, Max, Size) + -- Remove Exclude from A + RemoveExclude(A, Exclude, NewA, NewALength) ; + -- Require NewALength >= Unique + iUnique := Unique ; + if NewALength < Unique then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandTimeV: Unique > Length of Set A - Exclude", FAILURE) ; + iUnique := NewALength ; + end if ; + -- Randomize using exclude list of Unique # of newly generated values + for i in result'range loop + result(i) := RandTime(NewA(1 to NewALength), result(maximum(1, 1 + i - iUnique) to Size)) ; + end loop ; + return result ; + end function RandTimeV ; + + + -- + -- Basic Discrete Distributions + -- Always uses Uniform + -- + impure function DistInt ( Weight : integer_vector ) return integer is + variable DistArray : integer_vector(weight'range) ; + variable sum : integer ; + variable iRandomVal : integer ; + begin + DistArray := Weight ; + sum := 0 ; + for i in DistArray'range loop + DistArray(i) := DistArray(i) + sum ; + if DistArray(i) < sum then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.DistInt: negative weight or sum > 31 bits", FAILURE) ; + return DistArray'low ; -- allows debugging vs integer'left, out of range + end if ; + sum := DistArray(i) ; + end loop ; + if sum >= 1 then + iRandomVal := Uniform(1, sum) ; + for i in DistArray'range loop + if iRandomVal <= DistArray(i) then + return i ; + end if ; + end loop ; + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.DistInt: randomization failed", FAILURE) ; + else + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.DistInt: No randomization weights", FAILURE) ; + end if ; + return DistArray'low ; -- allows debugging vs integer'left, out of range + end function DistInt ; + + impure function DistSlv ( Weight : integer_vector ; Size : natural ) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(DistInt(Weight), Size)) ; + end function DistSlv ; + + impure function DistUnsigned ( Weight : integer_vector ; Size : natural ) return unsigned is + begin + return to_unsigned(DistInt(Weight), Size) ; + end function DistUnsigned ; + + impure function DistSigned ( Weight : integer_vector ; Size : natural ) return signed is + begin + return to_signed(DistInt(Weight), Size) ; + end function DistSigned ; + + + -- + -- Basic Distributions with exclude values (so can skip last or last n) + -- Always uses Uniform via DistInt + -- + impure function DistInt ( Weight : integer_vector ; Exclude : integer_vector ) return integer is + variable DistArray : integer_vector(weight'range) ; + variable ExcludeTemp : integer ; + begin + DistArray := Weight ; + for i in Exclude'range loop + ExcludeTemp := Exclude(i) ; + if ExcludeTemp >= DistArray'low and ExcludeTemp <= DistArray'high then + DistArray(ExcludeTemp) := 0 ; + end if ; + end loop ; + return DistInt(DistArray) ; + end function DistInt ; + + impure function DistSlv ( Weight : integer_vector ; Exclude : integer_vector ; Size : natural ) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(DistInt(Weight, Exclude), Size)) ; + end function DistSlv ; + + impure function DistUnsigned ( Weight : integer_vector ; Exclude : integer_vector ; Size : natural ) return unsigned is + begin + return to_unsigned(DistInt(Weight, Exclude), Size) ; + end function DistUnsigned ; + + impure function DistSigned ( Weight : integer_vector ; Exclude : integer_vector ; Size : natural ) return signed is + begin + return to_signed(DistInt(Weight, Exclude), Size) ; + end function DistSigned ; + + + -- + -- Distribution for sparse values + -- Always uses Uniform via DistInt + -- + impure function DistValInt ( A : DistType ) return integer is + variable DistArray : integer_vector(0 to A'length -1) ; + alias DistRecArray : DistType(DistArray'range) is A ; + begin + for i in DistArray'range loop + DistArray(i) := DistRecArray(i).Weight ; + end loop ; + return DistRecArray(DistInt(DistArray)).Value ; + end function DistValInt ; + + impure function DistValSlv ( A : DistType ; Size : natural ) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(DistValInt(A), Size)) ; + end function DistValSlv ; + + impure function DistValUnsigned ( A : DistType ; Size : natural ) return unsigned is + begin + return to_unsigned(DistValInt(A), Size) ; + end function DistValUnsigned ; + + impure function DistValSigned ( A : DistType ; Size : natural ) return signed is + begin + return to_signed(DistValInt(A), Size) ; + end function DistValSigned ; + + + -- + -- Distribution for sparse values with exclude values (so can skip last or last n) + -- Always uses Uniform via DistInt + -- + impure function DistValInt ( A : DistType ; Exclude : integer_vector ) return integer is + variable DistArray : integer_vector(0 to A'length -1) ; + alias DistRecArray : DistType(DistArray'range) is A ; + begin + for i in DistRecArray'range loop + if inside(DistRecArray(i).Value, exclude) then + DistArray(i) := 0 ; -- exclude + else + DistArray(i) := DistRecArray(i).Weight ; + end if ; + end loop ; + return DistRecArray(DistInt(DistArray)).Value ; + end function DistValInt ; + + impure function DistValSlv ( A : DistType ; Exclude : integer_vector ; Size : natural ) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(DistValInt(A, Exclude), Size)) ; + end function DistValSlv ; + + impure function DistValUnsigned ( A : DistType ; Exclude : integer_vector ; Size : natural ) return unsigned is + begin + return to_unsigned(DistValInt(A, Exclude), Size) ; + end function DistValUnsigned ; + + impure function DistValSigned ( A : DistType ; Exclude : integer_vector ; Size : natural ) return signed is + begin + return to_signed(DistValInt(A, Exclude), Size) ; + end function DistValSigned ; + + + -- + -- Large vector handling. + -- + impure function RandUnsigned (Size : natural) return unsigned is + constant NumLoops : integer := integer(ceil(real(Size)/30.0)) ; + constant Remain : integer := (Size - 1) mod 30 + 1 ; -- range 1 to 30 + variable RandVal : unsigned(1 to Size) ; + begin + if size = 0 then + return NULL_UV ; -- Null array + end if ; + for i in 0 to NumLoops-2 loop + RandVal(1 + 30*i to 30 + 30*i) := to_unsigned(RandInt(0, 2**30-1), 30) ; + end loop ; + RandVal(1+30*(NumLoops-1) to Remain + 30*(NumLoops-1)) := to_unsigned(RandInt(0, 2**Remain-1), Remain) ; + return RandVal ; + end function RandUnsigned ; + + impure function RandSlv (Size : natural) return std_logic_vector is + begin + return std_logic_vector(RandUnsigned(Size)) ; + end function RandSlv ; + + impure function RandSigned (Size : natural) return signed is + begin + return signed(RandUnsigned(Size)) ; + end function RandSigned ; + + + impure function RandUnsigned (Max : unsigned) return unsigned is + alias normMax : unsigned (Max'length downto 1) is Max ; + variable Result : unsigned(Max'range) := (others => '0') ; + alias normResult : unsigned(normMax'range) is Result ; + variable Size : integer ; + begin + -- Size = -1 if not found or Max'length = 0 + Size := find_leftmost(normMax, '1') ; + + if Size > 0 then + loop + normResult(Size downto 1) := RandUnsigned(Size) ; + exit when normResult <= Max ; + end loop ; + return Result ; -- = normResult with range same as Max + else + return resize("0", Max'length) ; + end if ; + end function RandUnsigned ; + + -- Working version that scales the value + -- impure function RandUnsigned (Max : unsigned) return unsigned is + -- constant MaxVal : unsigned(Max'length+3 downto 1) := (others => '1') ; + -- begin + -- if max'length > 0 then + -- -- "Max'length+3" creates 3 guard bits + -- return resize( RandUnsigned(Max'length+3) * ('0'&Max+1) / ('0'&MaxVal+1), Max'length) ; + -- else + -- return NULL_UV ; -- Null Array + -- end if ; + -- end function RandUnsigned ; + + impure function RandSlv (Max : std_logic_vector) return std_logic_vector is + begin + return std_logic_vector(RandUnsigned( unsigned(Max))) ; + end function RandSlv ; + + impure function RandSigned (Max : signed) return signed is + begin + if max'length > 0 then + AlertIf (OSVVM_ALERTLOG_ID, Max < 0, "RandomPkg.RandSigned: Max < 0", FAILURE) ; + return signed(RandUnsigned( unsigned(Max))) ; + else + return NULL_SV ; -- Null Array + end if ; + end function RandSigned ; + + + impure function RandUnsigned (Min, Max : unsigned) return unsigned is + constant LEN : integer := maximum(Max'length, Min'length) ; + begin + if LEN > 0 and Min <= Max then + return RandUnsigned(Max-Min) + Min ; + else + if Len > 0 then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandUnsigned: Max < Min", FAILURE) ; + end if ; + return NULL_UV ; + end if ; + end function RandUnsigned ; + + + impure function RandSlv (Min, Max : std_logic_vector) return std_logic_vector is + constant LEN : integer := maximum(Max'length, Min'length) ; + begin + if LEN > 0 and Min <= Max then + return RandSlv(Max-Min) + Min ; + else + if Len > 0 then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandSlv: Max < Min", FAILURE) ; + end if ; + return NULL_SlV ; + end if ; + end function RandSlv ; + + + impure function RandSigned (Min, Max : signed) return signed is + constant LEN : integer := maximum(Max'length, Min'length) ; + begin + if LEN > 0 and Min <= Max then + return resize(RandSigned(resize(Max,LEN+1) - resize(Min,LEN+1)) + Min, LEN) ; + else + if Len > 0 then + Alert(OSVVM_ALERTLOG_ID, "RandomPkg.RandSigned: Max < Min", FAILURE) ; + end if ; + return NULL_SV ; + end if ; + end function RandSigned ; + + + -- + -- Convenience Functions. Resolve into calls into the other functions + -- + impure function RandReal return real is + begin + return RandReal(0.0, 1.0) ; + end function RandReal ; + + impure function RandReal(Max : Real) return real is -- 0.0 to Max + begin + return RandReal(0.0, Max) ; + end function RandReal ; + + impure function RandInt (Max : integer) return integer is + begin + return RandInt(0, Max) ; + end function RandInt ; + + impure function RandSlv (Max, Size : natural) return std_logic_vector is + begin + return std_logic_vector(to_unsigned(RandInt(0, Max), Size)) ; + end function RandSlv ; + + impure function RandUnsigned (Max, Size : natural) return Unsigned is + begin + return to_unsigned(RandInt(0, Max), Size) ; + end function RandUnsigned ; + + + impure function RandSigned (Max : integer ; Size : natural ) return Signed is + begin + -- chose 0 to Max rather than -Max to +Max to be same as RandUnsigned, either seems logical + return to_signed(RandInt(0, Max), Size) ; + end function RandSigned ; + + end protected body RandomPType ; + +end RandomPkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/ScoreboardGenericPkg.vhd b/testsuite/gna/issue317/OSVVM/ScoreboardGenericPkg.vhd new file mode 100644 index 000000000..17a227fa1 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/ScoreboardGenericPkg.vhd @@ -0,0 +1,1573 @@ +-- +-- File Name: ScoreBoardGenericPkg.vhd +-- Design Unit Name: ScoreBoardGenericPkg +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis email: jim@synthworks.com +-- +-- +-- Description: +-- Defines types and methods to implement a FIFO based Scoreboard +-- Defines type ScoreBoardPType +-- Defines methods for putting values the scoreboard +-- +-- 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 +-- 12/2006: 2006.12 Initial revision +-- 08/2010 2010.08 Added Tailpointer +-- 05/2012 2012.05 Changed FIFO to store pointers to ExpectedType +-- Allows usage of unconstrained arrays +-- 08/2012 2012.08 Added Type and Subprogram Generics +-- 08/2013 2013.08 Generics: to_string replaced write, Match replaced check +-- Added Tags - Experimental +-- Added Array of Scoreboards +-- 09/2013 2013.09 Added file handling, Check Count, Finish Status +-- Find, Flush +-- 06/2015 2015.06 Added Alerts, SetAlertLogID, Revised LocalPush, GetDropCount, +-- Deprecated SetFinish and ReportMode - REPORT_NONE, FileOpen +-- Deallocate, Initialized, Function SetName +-- 11/2016 2016.11 Released as part of OSVVM +-- +-- +-- +-- Copyright (c) 2006 - 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 ; + use ieee.numeric_std.all ; + + use work.TranscriptPkg.all ; + use work.AlertLogPkg.all ; + use work.NamePkg.all ; + + +package ScoreboardGenericPkg is + generic ( + type ExpectedType ; + type ActualType ; + function Match(Actual : ActualType ; -- defaults + Expected : ExpectedType) return boolean ; -- is "=" ; + function expected_to_string(A : ExpectedType) return string ; -- is to_string ; + function actual_to_string (A : ActualType) return string -- is to_string ; + ) ; + +-- -- For a VHDL-2002 package, comment out the generics and +-- -- uncomment the following, it replaces a generic instance of the package. +-- -- As a result, you will have multiple copies of the entire package. +-- -- Inconvenient, but ok as it still works the same. +-- subtype ExpectedType is std_logic_vector ; +-- subtype ActualType is std_logic_vector ; +-- alias Match is std_match [ActualType, ExpectedType return boolean] ; -- for std_logic_vector +-- alias expected_to_string is to_hstring [ExpectedType return string]; -- VHDL-2008 +-- alias actual_to_string is to_hstring [ActualType return string]; -- VHDL-2008 + + -- ScoreboardReportType is deprecated + -- Replaced by Affirmations. ERROR is the default. ALL turns on PASSED flag + type ScoreboardReportType is (REPORT_ERROR, REPORT_ALL, REPORT_NONE) ; -- replaced by affirmations + + type ScoreBoardPType is protected + + ------------------------------------------------------------ + -- Emulate arrays of scoreboards + procedure SetArrayIndex(L, R : integer) ; -- supports integer indices + procedure SetArrayIndex(R : natural) ; -- indicies 1 to R + impure function GetArrayIndex return integer_vector ; + impure function GetArrayLength return natural ; + + ------------------------------------------------------------ + -- Push items into the scoreboard/FIFO + + -- Simple Scoreboard, no tag + procedure Push (Item : in ExpectedType) ; + + -- Simple Tagged Scoreboard + procedure Push ( + constant Tag : in string ; + constant Item : in ExpectedType + ) ; + + -- Array of Scoreboards, no tag + procedure Push ( + constant Index : in integer ; + constant Item : in ExpectedType + ) ; + + -- Array of Tagged Scoreboards + procedure Push ( + constant Index : in integer ; + constant Tag : in string ; + constant Item : in ExpectedType + ) ; + +-- ------------------------------------------------------------ +-- -- Push items into the scoreboard/FIFO +-- -- Function form supports chaining of operations +-- -- In 2013, this caused overloading issues in some simulators, will retest later +-- +-- -- Simple Scoreboard, no tag +-- impure function Push (Item : ExpectedType) return ExpectedType ; +-- +-- -- Simple Tagged Scoreboard +-- impure function Push ( +-- constant Tag : in string ; +-- constant Item : in ExpectedType +-- ) return ExpectedType ; +-- +-- -- Array of Scoreboards, no tag +-- impure function Push ( +-- constant Index : in integer ; +-- constant Item : in ExpectedType +-- ) return ExpectedType ; +-- +-- -- Array of Tagged Scoreboards +-- impure function Push ( +-- constant Index : in integer ; +-- constant Tag : in string ; +-- constant Item : in ExpectedType +-- ) return ExpectedType ; -- for chaining of operations + + ------------------------------------------------------------ + -- Check received item with item in the scoreboard/FIFO + + -- Simple Scoreboard, no tag + procedure Check (ActualData : ActualType) ; + + -- Simple Tagged Scoreboard + procedure Check ( + constant Tag : in string ; + constant ActualData : in ActualType + ) ; + + -- Array of Scoreboards, no tag + procedure Check ( + constant Index : in integer ; + constant ActualData : in ActualType + ) ; + + -- Array of Tagged Scoreboards + procedure Check ( + constant Index : in integer ; + constant Tag : in string ; + constant ActualData : in ActualType + ) ; + + ------------------------------------------------------------ + -- Pop the top item (FIFO) from the scoreboard/FIFO + + -- Simple Scoreboard, no tag + procedure Pop (variable Item : out ExpectedType) ; + + -- Simple Tagged Scoreboard + procedure Pop ( + constant Tag : in string ; + variable Item : out ExpectedType + ) ; + + -- Array of Scoreboards, no tag + procedure Pop ( + constant Index : in integer ; + variable Item : out ExpectedType + ) ; + + -- Array of Tagged Scoreboards + procedure Pop ( + constant Index : in integer ; + constant Tag : in string ; + variable Item : out ExpectedType + ) ; + +-- ------------------------------------------------------------ +-- -- Pop the top item (FIFO) from the scoreboard/FIFO +-- -- Function form supports chaining of operations +-- -- In 2013, this caused overloading issues in some simulators, will retest later +-- +-- -- Simple Scoreboard, no tag +-- impure function Pop return ExpectedType ; +-- +-- -- Simple Tagged Scoreboard +-- impure function Pop ( +-- constant Tag : in string +-- ) return ExpectedType ; +-- +-- -- Array of Scoreboards, no tag +-- impure function Pop (Index : integer) return ExpectedType ; +-- +-- -- Array of Tagged Scoreboards +-- impure function Pop ( +-- constant Index : in integer ; +-- constant Tag : in string +-- ) return ExpectedType ; + + ------------------------------------------------------------ + -- Empty - check to see if scoreboard is empty + impure function Empty return boolean ; -- Simple + impure function Empty (Tag : String) return boolean ; -- Simple, Tagged + impure function Empty (Index : integer) return boolean ; -- Array + impure function Empty (Index : integer; Tag : String) return boolean ; -- Array, Tagged + + ------------------------------------------------------------ + -- SetAlertLogID - associate an AlertLogID with a scoreboard to allow integrated error reporting + procedure SetAlertLogID(Index : Integer ; Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) ; + procedure SetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) ; + -- Use when an AlertLogID is used by multiple items (BFM or Scoreboards). See also AlertLogPkg.GetAlertLogID + procedure SetAlertLogID (Index : Integer ; A : AlertLogIDType) ; + procedure SetAlertLogID (A : AlertLogIDType) ; + impure function GetAlertLogID(Index : Integer) return AlertLogIDType ; + impure function GetAlertLogID return AlertLogIDType ; + + ------------------------------------------------------------ + -- Set a scoreboard name. + -- Used when scoreboard AlertLogID is shared between different sources. + procedure SetName (Name : String) ; + impure function SetName (Name : String) return string ; + impure function GetName (DefaultName : string := "Scoreboard") return string ; + + + ------------------------------------------------------------ + -- Scoreboard Introspection + + -- Number of items put into scoreboard + impure function GetItemCount return integer ; -- Simple, with or without tags + impure function GetItemCount (Index : integer) return integer ; -- Arrays, with or without tags + + -- Number of items checked by scoreboard + impure function GetCheckCount return integer ; -- Simple, with or without tags + impure function GetCheckCount (Index : integer) return integer ; -- Arrays, with or without tags + + -- Number of items dropped by scoreboard. See Find/Flush + impure function GetDropCount return integer ; -- Simple, with or without tags + impure function GetDropCount (Index : integer) return integer ; -- Arrays, with or without tags + + ------------------------------------------------------------ + -- Find - Returns the ItemNumber for a value and tag (if applicable) in a scoreboard. + -- Find returns integer'left if no match found + -- Also See Flush. Flush will drop items up through the ItemNumber + + -- Simple Scoreboard + impure function Find ( + constant ActualData : in ActualType + ) return integer ; + + -- Tagged Scoreboard + impure function Find ( + constant Tag : in string; + constant ActualData : in ActualType + ) return integer ; + + -- Array of Simple Scoreboards + impure function Find ( + constant Index : in integer ; + constant ActualData : in ActualType + ) return integer ; + + -- Array of Tagged Scoreboards + impure function Find ( + constant Index : in integer ; + constant Tag : in string; + constant ActualData : in ActualType + ) return integer ; + + ------------------------------------------------------------ + -- Flush - Remove elements in the scoreboard upto and including the one with ItemNumber + -- See Find to identify an ItemNumber of a particular value and tag (if applicable) + + -- Simple Scoreboard + procedure Flush ( + constant ItemNumber : in integer + ) ; + + -- Tagged Scoreboard - only removes items that also match the tag + procedure Flush ( + constant Tag : in string ; + constant ItemNumber : in integer + ) ; + + -- Array of Simple Scoreboards + procedure Flush ( + constant Index : in integer ; + constant ItemNumber : in integer + ) ; + + -- Array of Tagged Scoreboards - only removes items that also match the tag + procedure Flush ( + constant Index : in integer ; + constant Tag : in string ; + constant ItemNumber : in integer + ) ; + + ------------------------------------------------------------ + -- Generally these are not required. When a simulation ends and + -- another simulation is started, a simulator will release all allocated items. + procedure Deallocate ; -- Deletes all allocated items + procedure Initialize ; -- Creates initial data structure if it was destroyed with Deallocate + + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- Deprecated. Use alerts directly instead. + -- AlertIF(SB.GetCheckCount < 10, ....) ; + -- AlertIf(Not SB.Empty, ...) ; + ------------------------------------------------------------ + -- Set alerts if scoreboard not empty or if CheckCount < + -- Use if need to check empty or CheckCount for a specific scoreboard. + + -- Simple Scoreboards, with or without tag + procedure CheckFinish ( + FinishCheckCount : integer ; + FinishEmpty : boolean + ) ; + + -- Array of Scoreboards, with or without tag + procedure CheckFinish ( + Index : integer ; + FinishCheckCount : integer ; + FinishEmpty : boolean + ) ; + + ------------------------------------------------------------ + -- Get error count + -- Deprecated, replaced by usage of Alerts + -- AlertFLow: Instead use AlertLogPkg.ReportAlerts or AlertLogPkg.GetAlertCount + -- Not AlertFlow: use GetErrorCount to get total error count + + -- Simple Scoreboards, with or without tag + impure function GetErrorCount return integer ; + + -- Array of Scoreboards, with or without tag + impure function GetErrorCount(Index : integer) return integer ; + + ------------------------------------------------------------ + -- Error count manipulation + + -- IncErrorCount - not recommended, use alerts instead - may be deprecated in the future + procedure IncErrorCount ; -- Simple, with or without tags + procedure IncErrorCount (Index : integer) ; -- Arrays, with or without tags + + -- Clear error counter. Caution does not change AlertCounts, must also use AlertLogPkg.ClearAlerts + procedure SetErrorCountZero ; -- Simple, with or without tags + procedure SetErrorCountZero (Index : integer) ; -- Arrays, with or without tags + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- Deprecated. Names changed. Maintained for backward compatibility - would prefer an alias + ------------------------------------------------------------ + procedure FileOpen (FileName : string; OpenKind : File_Open_Kind ) ; -- Replaced by TranscriptPkg.TranscriptOpen + procedure PutExpectedData (ExpectedData : ExpectedType) ; -- Replaced by push + procedure CheckActualData (ActualData : ActualType) ; -- Replaced by Check + impure function GetItemNumber return integer ; -- Replaced by GetItemCount + procedure SetMessage (MessageIn : String) ; -- Replaced by SetName + impure function GetMessage return string ; -- Replaced by GetName + + -- Deprecated and may be deleted in a future revision + procedure SetFinish ( -- Replaced by CheckFinish + Index : integer ; + FCheckCount : integer ; + FEmpty : boolean := TRUE; + FStatus : boolean := TRUE + ) ; + + procedure SetFinish ( -- Replaced by CheckFinish + FCheckCount : integer ; + FEmpty : boolean := TRUE; + FStatus : boolean := TRUE + ) ; + + ------------------------------------------------------------ + -- SetReportMode + -- Not AlertFlow + -- REPORT_ALL: Replaced by AlertLogPkg.SetLogEnable(PASSED, TRUE) + -- REPORT_ERROR: Replaced by AlertLogPkg.SetLogEnable(PASSED, FALSE) + -- REPORT_NONE: Deprecated, do not use. + -- AlertFlow: + -- REPORT_ALL: Replaced by AlertLogPkg.SetLogEnable(AlertLogID, PASSED, TRUE) + -- REPORT_ERROR: Replaced by AlertLogPkg.SetLogEnable(AlertLogID, PASSED, FALSE) + -- REPORT_NONE: Replaced by AlertLogPkg.SetAlertEnable(AlertLogID, ERROR, FALSE) + procedure SetReportMode (ReportModeIn : ScoreboardReportType) ; + impure function GetReportMode return ScoreboardReportType ; + + + end protected ScoreBoardPType ; + +end ScoreboardGenericPkg ; + + +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +package body ScoreboardGenericPkg is + + type ScoreBoardPType is protected body + type ExpectedPointerType is access ExpectedType ; + + type ListType ; + type ListPointerType is access ListType ; + type ListType is record + ItemNumber : integer ; + TagPtr : line ; + ExpectedPtr : ExpectedPointerType ; + NextPtr : ListPointerType ; + end record ; + type ListArrayType is array (integer range <>) of ListPointerType ; + type ListArrayPointerType is access ListArrayType ; + + variable ArrayLengthVar : integer := 1 ; + variable HeadPointer : ListArrayPointerType := new ListArrayType(1 to 1) ; + variable TailPointer : ListArrayPointerType := new ListArrayType(1 to 1) ; + variable PopListPointer : ListArrayPointerType := new ListArrayType(1 to 1) ; + + type IntegerArrayType is array (integer range <>) of Integer ; + type IntegerArrayPointerType is access IntegerArrayType ; + + variable ErrCntVar : IntegerArrayPointerType := new IntegerArrayType'(1 => 0) ; + variable DropCountVar : IntegerArrayPointerType := new IntegerArrayType'(1 => 0) ; + variable ItemNumberVar : IntegerArrayPointerType := new IntegerArrayType'(1 => 0) ; + variable CheckCountVar : IntegerArrayPointerType := new IntegerArrayType'(1 => 0) ; + variable AlertLogIDVar : IntegerArrayPointerType := new IntegerArrayType'(1 => OSVVM_SCOREBOARD_ALERTLOG_ID) ; + + variable NameVar : NamePType ; + variable ReportModeVar : ScoreboardReportType ; + variable FirstIndexVar : integer := 1 ; + + + ------------------------------------------------------------ + procedure SetName (Name : String) is + ------------------------------------------------------------ + begin + NameVar.Set(Name) ; + end procedure SetName ; + + ------------------------------------------------------------ + impure function SetName (Name : String) return string is + ------------------------------------------------------------ + begin + NameVar.Set(Name) ; + return Name ; + end function SetName ; + + ------------------------------------------------------------ + impure function GetName (DefaultName : string := "Scoreboard") return string is + ------------------------------------------------------------ + begin + return NameVar.Get(DefaultName) ; + end function GetName ; + + ------------------------------------------------------------ + procedure SetReportMode (ReportModeIn : ScoreboardReportType) is + ------------------------------------------------------------ + begin + ReportModeVar := ReportModeIn ; + if ReportModeVar = REPORT_ALL then + Alert(OSVVM_SCOREBOARD_ALERTLOG_ID, "ScoreboardGenericPkg.SetReportMode: To turn off REPORT_ALL, use osvvm.AlertLogPkg.SetLogEnable(PASSED, FALSE)", WARNING) ; + for i in AlertLogIDVar'range loop + SetLogEnable(AlertLogIDVar(i), PASSED, TRUE) ; + end loop ; + end if ; + if ReportModeVar = REPORT_NONE then + Alert(OSVVM_SCOREBOARD_ALERTLOG_ID, "ScoreboardGenericPkg.SetReportMode: ReportMode REPORT_NONE has been deprecated and will be removed in next revision. Please contact OSVVM architect Jim Lewis if you need this capability.", WARNING) ; + end if ; + end procedure SetReportMode ; + + ------------------------------------------------------------ + impure function GetReportMode return ScoreboardReportType is + ------------------------------------------------------------ + begin + return ReportModeVar ; + end function GetReportMode ; + + ------------------------------------------------------------ + procedure SetArrayIndex(L, R : integer) is + ------------------------------------------------------------ + variable OldHeadPointer, OldTailPointer, OldPopListPointer : ListArrayPointerType ; + variable OldErrCnt, OldDropCount, OldItemNumber, OldCheckCount, OldAlertLogIDVar : IntegerArrayPointerType ; + variable Min, Max, Len, OldLen, OldMax : integer ; + begin + Min := minimum(L, R) ; + Max := maximum(L, R) ; + OldLen := ArrayLengthVar ; + OldMax := Min + ArrayLengthVar - 1 ; + Len := Max - Min + 1 ; + ArrayLengthVar := Len ; + if Len >= OldLen then + FirstIndexVar := Min ; + + OldHeadPointer := HeadPointer ; + HeadPointer := new ListArrayType(Min to Max) ; + if OldHeadPointer /= NULL then + HeadPointer(Min to OldMax) := OldHeadPointer.all ; -- (OldHeadPointer'range) ; + Deallocate(OldHeadPointer) ; + end if ; + + OldTailPointer := TailPointer ; + TailPointer := new ListArrayType(Min to Max) ; + if OldTailPointer /= NULL then + TailPointer(Min to OldMax) := OldTailPointer.all ; + Deallocate(OldTailPointer) ; + end if ; + + OldPopListPointer := PopListPointer ; + PopListPointer := new ListArrayType(Min to Max) ; + if OldPopListPointer /= NULL then + PopListPointer(Min to OldMax) := OldPopListPointer.all ; + Deallocate(OldPopListPointer) ; + end if ; + + OldErrCnt := ErrCntVar ; + ErrCntVar := new IntegerArrayType'(Min to Max => 0) ; + if OldErrCnt /= NULL then + ErrCntVar(Min to OldMax) := OldErrCnt.all ; + Deallocate(OldErrCnt) ; + end if ; + + OldDropCount := DropCountVar ; + DropCountVar := new IntegerArrayType'(Min to Max => 0) ; + if OldDropCount /= NULL then + DropCountVar(Min to OldMax) := OldDropCount.all ; + Deallocate(OldDropCount) ; + end if ; + + OldItemNumber := ItemNumberVar ; + ItemNumberVar := new IntegerArrayType'(Min to Max => 0) ; + if OldItemNumber /= NULL then + ItemNumberVar(Min to OldMax) := OldItemNumber.all ; + Deallocate(OldItemNumber) ; + end if ; + + OldCheckCount := CheckCountVar ; + CheckCountVar := new IntegerArrayType'(Min to Max => 0) ; + if OldCheckCount /= NULL then + CheckCountVar(Min to OldMax) := OldCheckCount.all ; + Deallocate(OldCheckCount) ; + end if ; + + OldAlertLogIDVar := AlertLogIDVar ; + AlertLogIDVar := new IntegerArrayType'(Min to Max => OSVVM_SCOREBOARD_ALERTLOG_ID) ; + if OldAlertLogIDVar /= NULL then + AlertLogIDVar(Min to OldMax) := OldAlertLogIDVar.all ; + Deallocate(OldAlertLogIDVar) ; + end if ; + + elsif Len < OldLen then + report "ScoreboardGenericPkg: SetArrayIndex, new array Length <= current array length" + severity failure ; + + end if ; + end procedure SetArrayIndex ; + + ------------------------------------------------------------ + procedure SetArrayIndex(R : natural) is + ------------------------------------------------------------ + begin + SetArrayIndex(1, R) ; + end procedure SetArrayIndex ; + + ------------------------------------------------------------ + procedure Deallocate is + ------------------------------------------------------------ + variable CurListPtr, LastListPtr : ListPointerType ; + begin + for Index in HeadPointer'range loop + -- Deallocate contents in the scoreboards + CurListPtr := HeadPointer(Index) ; + while CurListPtr /= Null loop + deallocate(CurListPtr.TagPtr) ; + deallocate(CurListPtr.ExpectedPtr) ; + LastListPtr := CurListPtr ; + CurListPtr := CurListPtr.NextPtr ; + Deallocate(LastListPtr) ; + end loop ; + end loop ; + + for Index in PopListPointer'range loop + -- Deallocate PopListPointer - only has single element + CurListPtr := PopListPointer(Index) ; + if CurListPtr /= NULL then + deallocate(CurListPtr.TagPtr) ; + deallocate(CurListPtr.ExpectedPtr) ; + deallocate(CurListPtr) ; + end if ; + end loop ; + + -- Deallocate arrays of pointers + Deallocate(HeadPointer) ; + Deallocate(TailPointer) ; + Deallocate(PopListPointer) ; + + -- Deallocate supporting arrays + Deallocate(ErrCntVar) ; + Deallocate(DropCountVar) ; + Deallocate(ItemNumberVar) ; + Deallocate(CheckCountVar) ; + Deallocate(AlertLogIDVar) ; + + -- Deallocate NameVar - NamePType + NameVar.Deallocate ; + + ArrayLengthVar := 0 ; + end procedure Deallocate ; + + ------------------------------------------------------------ + -- Construct initial data structure + procedure Initialize is + ------------------------------------------------------------ + begin + SetArrayIndex(1, 1) ; + end procedure Initialize ; + + ------------------------------------------------------------ + impure function GetArrayIndex return integer_vector is + ------------------------------------------------------------ + begin + return (1 => HeadPointer'left, 2 => HeadPointer'right) ; + end function GetArrayIndex ; + + ------------------------------------------------------------ + impure function GetArrayLength return natural is + ------------------------------------------------------------ + begin + return ArrayLengthVar ; -- HeadPointer'length ; + end function GetArrayLength ; + + ------------------------------------------------------------ + procedure SetAlertLogID (Index : Integer ; A : AlertLogIDType) is + ------------------------------------------------------------ + begin + AlertLogIDVar(Index) := A ; + end procedure SetAlertLogID ; + + ------------------------------------------------------------ + procedure SetAlertLogID (A : AlertLogIDType) is + ------------------------------------------------------------ + begin + AlertLogIDVar(FirstIndexVar) := A ; + end procedure SetAlertLogID ; + + ------------------------------------------------------------ + procedure SetAlertLogID(Index : Integer ; Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogIDVar(Index) := GetAlertLogID(Name, ParentID, CreateHierarchy) ; + end procedure SetAlertLogID ; + + ------------------------------------------------------------ + procedure SetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogIDVar(FirstIndexVar) := GetAlertLogID(Name, ParentID, CreateHierarchy) ; + end procedure SetAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogID(Index : Integer) return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogIDVar(Index) ; + end function GetAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogID return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogIDVar(FirstIndexVar) ; + end function GetAlertLogID ; + + ------------------------------------------------------------ + impure function LocalOutOfRange( + ------------------------------------------------------------ + constant Index : in integer ; + constant Name : in string + ) return boolean is + begin + return AlertIf(OSVVM_SCOREBOARD_ALERTLOG_ID, Index < HeadPointer'Low or Index > HeadPointer'High, + GetName & " " & Name & " Index: " & to_string(Index) & + "is not in the range (" & to_string(HeadPointer'Low) & + "to " & to_string(HeadPointer'High) & ")", + FAILURE ) ; + end function LocalOutOfRange ; + + ------------------------------------------------------------ + procedure LocalPush ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string ; + constant Item : in ExpectedType + ) is + variable ExpectedPtr : ExpectedPointerType ; + variable TagPtr : line ; + begin + if LocalOutOfRange(Index, "Push") then + return ; -- error reporting in LocalOutOfRange + end if ; + + ItemNumberVar(Index) := ItemNumberVar(Index) + 1 ; + ExpectedPtr := new ExpectedType'(Item) ; + TagPtr := new string'(Tag) ; + + if HeadPointer(Index) = NULL then + -- 2015.05: allocation using ListTtype'(...) in a protected type does not work in some simulators + -- HeadPointer(Index) := new ListType'(ItemNumberVar(Index), TagPtr, ExpectedPtr, NULL) ; + HeadPointer(Index) := new ListType ; + HeadPointer(Index).ItemNumber := ItemNumberVar(Index) ; + HeadPointer(Index).TagPtr := TagPtr ; + HeadPointer(Index).ExpectedPtr := ExpectedPtr ; + HeadPointer(Index).NextPtr := NULL ; + TailPointer(Index) := HeadPointer(Index) ; + else + -- 2015.05: allocation using ListTtype'(...) in a protected type does not work in some simulators + -- TailPointer(Index).NextPtr := new ListType'(ItemNumberVar(Index), TagPtr, ExpectedPtr, NULL) ; + TailPointer(Index).NextPtr := new ListType ; + TailPointer(Index).NextPtr.ItemNumber := ItemNumberVar(Index) ; + TailPointer(Index).NextPtr.TagPtr := TagPtr ; + TailPointer(Index).NextPtr.ExpectedPtr := ExpectedPtr ; + TailPointer(Index).NextPtr.NextPtr := NULL ; + TailPointer(Index) := TailPointer(Index).NextPtr ; + end if ; + end procedure LocalPush ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + procedure Push ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string ; + constant Item : in ExpectedType + ) is + variable ExpectedPtr : ExpectedPointerType ; + variable TagPtr : line ; + begin + if LocalOutOfRange(Index, "Push") then + return ; -- error reporting in LocalOutOfRange + end if ; + LocalPush(Index, Tag, Item) ; + end procedure Push ; + + ------------------------------------------------------------ + -- Array of Scoreboards, no tag + procedure Push ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Item : in ExpectedType + ) is + begin + if LocalOutOfRange(Index, "Push") then + return ; -- error reporting in LocalOutOfRange + end if ; + LocalPush(Index, "", Item) ; + end procedure Push ; + + ------------------------------------------------------------ + -- Simple Tagged Scoreboard + procedure Push ( + ------------------------------------------------------------ + constant Tag : in string ; + constant Item : in ExpectedType + ) is + begin + LocalPush(FirstIndexVar, Tag, Item) ; + end procedure Push ; + + ------------------------------------------------------------ + -- Simple Scoreboard, no tag + procedure Push (Item : in ExpectedType) is + ------------------------------------------------------------ + begin + LocalPush(FirstIndexVar, "", Item) ; + end procedure Push ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + impure function Push ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string ; + constant Item : in ExpectedType + ) return ExpectedType is + begin + if LocalOutOfRange(Index, "Push") then + return Item ; -- error reporting in LocalOutOfRange + end if ; + LocalPush(Index, Tag, Item) ; + return Item ; + end function Push ; + + ------------------------------------------------------------ + -- Array of Scoreboards, no tag + impure function Push ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Item : in ExpectedType + ) return ExpectedType is + begin + if LocalOutOfRange(Index, "Push") then + return Item ; -- error reporting in LocalOutOfRange + end if ; + LocalPush(Index, "", Item) ; + return Item ; + end function Push ; + + ------------------------------------------------------------ + -- Simple Tagged Scoreboard + impure function Push ( + ------------------------------------------------------------ + constant Tag : in string ; + constant Item : in ExpectedType + ) return ExpectedType is + begin + LocalPush(FirstIndexVar, Tag, Item) ; + return Item ; + end function Push ; + + ------------------------------------------------------------ + -- Simple Scoreboard, no tag + impure function Push (Item : ExpectedType) return ExpectedType is + ------------------------------------------------------------ + begin + LocalPush(FirstIndexVar, "", Item) ; + return Item ; + end function Push ; + + ------------------------------------------------------------ + -- Local Only + -- Pops highest element matching Tag into PopListPointer(Index) + procedure LocalPop (Index : integer ; Tag : string; Name : string) is + ------------------------------------------------------------ + variable CurPtr : ListPointerType ; + begin + if LocalOutOfRange(Index, "Pop/Check") then + return ; -- error reporting in LocalOutOfRange + end if ; + if HeadPointer(Index) = NULL then + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + Alert(AlertLogIDVar(Index), GetName & " Empty during " & Name, FAILURE) ; + return ; + end if ; + -- deallocate previous pointer + if PopListPointer(Index) /= NULL then + deallocate(PopListPointer(Index).TagPtr) ; + deallocate(PopListPointer(Index).ExpectedPtr) ; + deallocate(PopListPointer(Index)) ; + end if ; + -- Descend to find Tag field and extract + CurPtr := HeadPointer(Index) ; + if CurPtr.TagPtr.all = Tag then + -- Non-tagged scoreboards find this one. + PopListPointer(Index) := HeadPointer(Index) ; + HeadPointer(Index) := HeadPointer(Index).NextPtr ; + else + loop + if CurPtr.NextPtr = NULL then + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + Alert(AlertLogIDVar(Index), GetName & " Pop/Check (" & Name & "), tag: " & Tag & " not found", FAILURE) ; + exit ; + elsif CurPtr.NextPtr.TagPtr.all = Tag then + PopListPointer(Index) := CurPtr.NextPtr ; + CurPtr.NextPtr := CurPtr.NextPtr.NextPtr ; + if CurPtr.NextPtr = NULL then + TailPointer(Index) := CurPtr ; + end if ; + exit ; + else + CurPtr := CurPtr.NextPtr ; + end if ; + end loop ; + end if ; + end procedure LocalPop ; + + ------------------------------------------------------------ + -- Local Only + procedure LocalCheck ( + ------------------------------------------------------------ + constant Index : in integer ; + constant ActualData : in ActualType + ) is + variable ExpectedPtr : ExpectedPointerType ; + variable CurrentItem : integer ; + variable WriteBuf : line ; + variable FoundError : boolean ; + begin + CheckCountVar(Index) := CheckCountVar(Index) + 1 ; + ExpectedPtr := PopListPointer(Index).ExpectedPtr ; + CurrentItem := PopListPointer(Index).ItemNumber ; + + if not Match(ActualData, ExpectedPtr.all) then + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + FoundError := TRUE ; + else + FoundError := FALSE ; + end if ; + + IncAffirmCheckCount ; + +-- if FoundError or ReportModeVar = REPORT_ALL then + if FoundError or GetLogEnable(AlertLogIDVar(Index), PASSED) then + if AlertLogIDVar(Index) = OSVVM_SCOREBOARD_ALERTLOG_ID then + write(WriteBuf, GetName(DefaultName => "Scoreboard")) ; + else + write(WriteBuf, GetName(DefaultName => "")) ; + end if ; + if ArrayLengthVar > 1 then + write(WriteBuf, " (" & to_string(Index) & ") ") ; + end if ; + write(WriteBuf, " Expected: " & expected_to_string(ExpectedPtr.all)) ; + write(WriteBuf, " Actual: " & actual_to_string(ActualData)) ; + if PopListPointer(Index).TagPtr.all /= "" then + write(WriteBuf, " Tag: " & PopListPointer(Index).TagPtr.all) ; + end if; + write(WriteBuf, " Item Number: " & to_string(CurrentItem)) ; + if FoundError then + if ReportModeVar /= REPORT_NONE then + -- Affirmation Failed + Alert(AlertLogIDVar(Index), WriteBuf.all, ERROR) ; + else + -- Affirmation Failed, but silent, unless in DEBUG mode + Log(AlertLogIDVar(Index), "ERROR " & WriteBuf.all, DEBUG) ; + IncAlertCount(AlertLogIDVar(Index)) ; -- Silent Counted Alert + end if ; + else + -- Affirmation passed + Log(AlertLogIDVar(Index), WriteBuf.all, PASSED) ; + end if ; + deallocate(WriteBuf) ; + end if ; + end procedure LocalCheck ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + procedure Check ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string ; + constant ActualData : in ActualType + ) is + begin + if LocalOutOfRange(Index, "Check") then + return ; -- error reporting in LocalOutOfRange + end if ; + LocalPop(Index, Tag, "Check") ; + LocalCheck(Index, ActualData) ; + end procedure Check ; + + ------------------------------------------------------------ + -- Array of Scoreboards, no tag + procedure Check ( + ------------------------------------------------------------ + constant Index : in integer ; + constant ActualData : in ActualType + ) is + begin + if LocalOutOfRange(Index, "Check") then + return ; -- error reporting in LocalOutOfRange + end if ; + LocalPop(Index, "", "Check") ; + LocalCheck(Index, ActualData) ; + end procedure Check ; + + ------------------------------------------------------------ + -- Simple Tagged Scoreboard + procedure Check ( + ------------------------------------------------------------ + constant Tag : in string ; + constant ActualData : in ActualType + ) is + begin + LocalPop(FirstIndexVar, Tag, "Check") ; + LocalCheck(FirstIndexVar, ActualData) ; + end procedure Check ; + + ------------------------------------------------------------ + -- Simple Scoreboard, no tag + procedure Check (ActualData : ActualType) is + ------------------------------------------------------------ + begin + LocalPop(FirstIndexVar, "", "Check") ; + LocalCheck(FirstIndexVar, ActualData) ; + end procedure Check ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + procedure Pop ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string ; + variable Item : out ExpectedType + ) is + begin + if LocalOutOfRange(Index, "Pop") then + return ; -- error reporting in LocalOutOfRange + end if ; + LocalPop(Index, Tag, "Pop") ; + Item := PopListPointer(Index).ExpectedPtr.all ; + end procedure Pop ; + + ------------------------------------------------------------ + -- Array of Scoreboards, no tag + procedure Pop ( + ------------------------------------------------------------ + constant Index : in integer ; + variable Item : out ExpectedType + ) is + begin + if LocalOutOfRange(Index, "Pop") then + return ; -- error reporting in LocalOutOfRange + end if ; + LocalPop(Index, "", "Pop") ; + Item := PopListPointer(Index).ExpectedPtr.all ; + end procedure Pop ; + + ------------------------------------------------------------ + -- Simple Tagged Scoreboard + procedure Pop ( + ------------------------------------------------------------ + constant Tag : in string ; + variable Item : out ExpectedType + ) is + begin + LocalPop(FirstIndexVar, Tag, "Pop") ; + Item := PopListPointer(FirstIndexVar).ExpectedPtr.all ; + end procedure Pop ; + + ------------------------------------------------------------ + -- Simple Scoreboard, no tag + procedure Pop (variable Item : out ExpectedType) is + ------------------------------------------------------------ + begin + LocalPop(FirstIndexVar, "", "Pop") ; + Item := PopListPointer(FirstIndexVar).ExpectedPtr.all ; + end procedure Pop ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + impure function Pop ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string + ) return ExpectedType is + begin + if LocalOutOfRange(Index, "Pop") then + -- error reporting in LocalOutOfRange + return PopListPointer(FirstIndexVar).ExpectedPtr.all ; + end if ; + LocalPop(Index, Tag, "Pop") ; + return PopListPointer(Index).ExpectedPtr.all ; + end function Pop ; + + ------------------------------------------------------------ + -- Array of Scoreboards, no tag + impure function Pop (Index : integer) return ExpectedType is + ------------------------------------------------------------ + begin + if LocalOutOfRange(Index, "Pop") then + -- error reporting in LocalOutOfRange + return PopListPointer(FirstIndexVar).ExpectedPtr.all ; + end if ; + LocalPop(Index, "", "Pop") ; + return PopListPointer(Index).ExpectedPtr.all ; + end function Pop ; + + ------------------------------------------------------------ + -- Simple Tagged Scoreboard + impure function Pop ( + ------------------------------------------------------------ + constant Tag : in string + ) return ExpectedType is + begin + LocalPop(FirstIndexVar, Tag, "Pop") ; + return PopListPointer(FirstIndexVar).ExpectedPtr.all ; + end function Pop ; + + ------------------------------------------------------------ + -- Simple Scoreboard, no tag + impure function Pop return ExpectedType is + ------------------------------------------------------------ + begin + LocalPop(FirstIndexVar, "", "Pop") ; + return PopListPointer(FirstIndexVar).ExpectedPtr.all ; + end function Pop ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + impure function Empty (Index : integer; Tag : String) return boolean is + ------------------------------------------------------------ + variable CurPtr : ListPointerType ; + begin + CurPtr := HeadPointer(Index) ; + while CurPtr /= NULL loop + if CurPtr.TagPtr.all = Tag then + return FALSE ; -- Found Tag + end if ; + CurPtr := CurPtr.NextPtr ; + end loop ; + return TRUE ; -- Tag not found + end function Empty ; + + ------------------------------------------------------------ + -- Array of Scoreboards, no tag + impure function Empty (Index : integer) return boolean is + ------------------------------------------------------------ + begin + return HeadPointer(Index) = NULL ; + end function Empty ; + + ------------------------------------------------------------ + -- Simple Tagged Scoreboard + impure function Empty (Tag : String) return boolean is + ------------------------------------------------------------ + variable CurPtr : ListPointerType ; + begin + return Empty(FirstIndexVar, Tag) ; + end function Empty ; + + ------------------------------------------------------------ + -- Simple Scoreboard, no tag + impure function Empty return boolean is + ------------------------------------------------------------ + begin + return HeadPointer(FirstIndexVar) = NULL ; + end function Empty ; + + ------------------------------------------------------------ + procedure CheckFinish ( + ------------------------------------------------------------ + Index : integer ; + FinishCheckCount : integer ; + FinishEmpty : boolean + ) is + variable EmptyError : Boolean ; + variable WriteBuf : line ; + begin + if AlertLogIDVar(Index) = OSVVM_SCOREBOARD_ALERTLOG_ID then + write(WriteBuf, GetName(DefaultName => "Scoreboard")) ; + else + write(WriteBuf, GetName(DefaultName => "")) ; + end if ; + if ArrayLengthVar > 1 then + if WriteBuf.all /= "" then + swrite(WriteBuf, " ") ; + end if ; + write(WriteBuf, "Index(" & to_string(Index) & "), ") ; + else + if WriteBuf.all /= "" then + swrite(WriteBuf, ", ") ; + end if ; + end if ; + if FinishEmpty then + AffirmIf(AlertLogIDVar(Index), Empty(Index), WriteBuf.all & "Checking Empty: " & to_string(Empty(Index)) & + " FinishEmpty: " & to_string(FinishEmpty)) ; + if not Empty(Index) then + -- Increment internal count on FinishEmpty Error + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + end if ; + end if ; + AffirmIf(AlertLogIDVar(Index), CheckCountVar(Index) >= FinishCheckCount, WriteBuf.all & + "Checking CheckCount: " & to_string(CheckCountVar(Index)) & + " >= Expected: " & to_string(FinishCheckCount)) ; + if not (CheckCountVar(Index) >= FinishCheckCount) then + -- Increment internal count on FinishCheckCount Error + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + end if ; + deallocate(WriteBuf) ; + end procedure CheckFinish ; + + ------------------------------------------------------------ + procedure CheckFinish ( + ------------------------------------------------------------ + FinishCheckCount : integer ; + FinishEmpty : boolean + ) is + begin + for AlertLogID in AlertLogIDVar'range loop + CheckFinish(AlertLogID, FinishCheckCount, FinishEmpty) ; + end loop ; + end procedure CheckFinish ; + + ------------------------------------------------------------ + impure function GetErrorCount (Index : integer) return integer is + ------------------------------------------------------------ + begin + return ErrCntVar(Index) ; + end function GetErrorCount ; + + ------------------------------------------------------------ + impure function GetErrorCount return integer is + ------------------------------------------------------------ + variable TotalErrorCount : integer := 0 ; + begin + for Index in AlertLogIDVar'range loop + TotalErrorCount := TotalErrorCount + GetErrorCount(Index) ; + end loop ; + return TotalErrorCount ; + end function GetErrorCount ; + + ------------------------------------------------------------ + procedure IncErrorCount (Index : integer) is + ------------------------------------------------------------ + begin + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + IncAlertCount(AlertLogIDVar(Index), ERROR) ; + end IncErrorCount ; + + ------------------------------------------------------------ + procedure IncErrorCount is + ------------------------------------------------------------ + begin + ErrCntVar(FirstIndexVar) := ErrCntVar(FirstIndexVar) + 1 ; + IncAlertCount(AlertLogIDVar(FirstIndexVar), ERROR) ; + end IncErrorCount ; + + ------------------------------------------------------------ + procedure SetErrorCountZero (Index : integer) is + ------------------------------------------------------------ + begin + ErrCntVar(Index) := 0; + end procedure SetErrorCountZero ; + + ------------------------------------------------------------ + procedure SetErrorCountZero is + ------------------------------------------------------------ + begin + ErrCntVar(FirstIndexVar) := 0 ; + end procedure SetErrorCountZero ; + + ------------------------------------------------------------ + impure function GetItemCount (Index : integer) return integer is + ------------------------------------------------------------ + begin + return ItemNumberVar(Index) ; + end function GetItemCount ; + + ------------------------------------------------------------ + impure function GetItemCount return integer is + ------------------------------------------------------------ + begin + return ItemNumberVar(FirstIndexVar) ; + end function GetItemCount ; + + ------------------------------------------------------------ + impure function GetCheckCount (Index : integer) return integer is + ------------------------------------------------------------ + begin + return CheckCountVar(Index) ; + end function GetCheckCount ; + + ------------------------------------------------------------ + impure function GetCheckCount return integer is + ------------------------------------------------------------ + begin + return CheckCountVar(FirstIndexVar) ; + end function GetCheckCount ; + + ------------------------------------------------------------ + impure function GetDropCount (Index : integer) return integer is + ------------------------------------------------------------ + begin + return DropCountVar(Index) ; + end function GetDropCount ; + + ------------------------------------------------------------ + impure function GetDropCount return integer is + ------------------------------------------------------------ + begin + return DropCountVar(FirstIndexVar) ; + end function GetDropCount ; + + ------------------------------------------------------------ + procedure SetFinish ( + ------------------------------------------------------------ + Index : integer ; + FCheckCount : integer ; + FEmpty : boolean := TRUE; + FStatus : boolean := TRUE + ) is + begin + Alert(AlertLogIDVar(Index), "OSVVM.ScoreboardGenericPkg.SetFinish: Deprecated and removed. See CheckFinish", ERROR) ; + end procedure SetFinish ; + + ------------------------------------------------------------ + procedure SetFinish ( + ------------------------------------------------------------ + FCheckCount : integer ; + FEmpty : boolean := TRUE; + FStatus : boolean := TRUE + ) is + begin + SetFinish(FirstIndexVar, FCheckCount, FEmpty, FStatus) ; + end procedure SetFinish ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + -- Find Element with Matching Tag and ActualData + -- Returns integer'left if no match found + impure function Find ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string; + constant ActualData : in ActualType + ) return integer is + variable CurPtr : ListPointerType ; + begin + if LocalOutOfRange(Index, "Find") then + return integer'left ; -- error reporting in LocalOutOfRange + end if ; + CurPtr := HeadPointer(Index) ; + loop + if CurPtr = NULL then + -- Failed to find it + ErrCntVar(Index) := ErrCntVar(Index) + 1 ; + if Tag /= "" then + Alert(AlertLogIDVar(Index), + GetName & " Did not find Tag: " & Tag & " and Actual Data: " & actual_to_string(ActualData), + FAILURE ) ; + else + Alert(AlertLogIDVar(Index), + GetName & " Did not find Actual Data: " & actual_to_string(ActualData), + FAILURE ) ; + end if ; + return integer'left ; + + elsif CurPtr.TagPtr.all = Tag and + Match(ActualData, CurPtr.ExpectedPtr.all) then + -- Found it. Return Index. + return CurPtr.ItemNumber ; + + else -- Descend + CurPtr := CurPtr.NextPtr ; + end if ; + end loop ; + end function Find ; + + ------------------------------------------------------------ + -- Array of Simple Scoreboards + -- Find Element with Matching ActualData + impure function Find ( + ------------------------------------------------------------ + constant Index : in integer ; + constant ActualData : in ActualType + ) return integer is + begin + return Find(Index, "", ActualData) ; + end function Find ; + + ------------------------------------------------------------ + -- Tagged Scoreboard + -- Find Element with Matching ActualData + impure function Find ( + ------------------------------------------------------------ + constant Tag : in string; + constant ActualData : in ActualType + ) return integer is + begin + return Find(FirstIndexVar, Tag, ActualData) ; + end function Find ; + + ------------------------------------------------------------ + -- Simple Scoreboard + -- Find Element with Matching ActualData + impure function Find ( + ------------------------------------------------------------ + constant ActualData : in ActualType + ) return integer is + begin + return Find(FirstIndexVar, "", ActualData) ; + end function Find ; + + ------------------------------------------------------------ + -- Array of Tagged Scoreboards + -- Flush Remove elements with tag whose itemNumber is <= ItemNumber parameter + procedure Flush ( + ------------------------------------------------------------ + constant Index : in integer ; + constant Tag : in string ; + constant ItemNumber : in integer + ) is + variable CurPtr, RemovePtr, LastPtr : ListPointerType ; + begin + if LocalOutOfRange(Index, "Find") then + return ; -- error reporting in LocalOutOfRange + end if ; + CurPtr := HeadPointer(Index) ; + LastPtr := NULL ; + loop + if CurPtr = NULL then + -- Done + return ; + elsif CurPtr.TagPtr.all = Tag then + if ItemNumber >= CurPtr.ItemNumber then + -- remove it + RemovePtr := CurPtr ; + if CurPtr = TailPointer(Index) then + TailPointer(Index) := LastPtr ; + end if ; + if CurPtr = HeadPointer(Index) then + HeadPointer(Index) := CurPtr.NextPtr ; + else -- if LastPtr /= NULL then + LastPtr.NextPtr := LastPtr.NextPtr.NextPtr ; + end if ; + CurPtr := CurPtr.NextPtr ; + -- LastPtr := LastPtr ; -- no change + DropCountVar(Index) := DropCountVar(Index) + 1 ; + deallocate(RemovePtr.TagPtr) ; + deallocate(RemovePtr.ExpectedPtr) ; + deallocate(RemovePtr) ; + else + -- Done + return ; + end if ; + else + -- Descend + LastPtr := CurPtr ; + CurPtr := CurPtr.NextPtr ; + end if ; + end loop ; + end procedure Flush ; + + ------------------------------------------------------------ + -- Tagged Scoreboard + -- Flush Remove elements with tag whose itemNumber is <= ItemNumber parameter + procedure Flush ( + ------------------------------------------------------------ + constant Tag : in string ; + constant ItemNumber : in integer + ) is + begin + Flush(FirstIndexVar, Tag, ItemNumber) ; + end procedure Flush ; + + ------------------------------------------------------------ + -- Array of Simple Scoreboards + -- Flush - Remove Elements upto and including the one with ItemNumber + procedure Flush ( + ------------------------------------------------------------ + constant Index : in integer ; + constant ItemNumber : in integer + ) is + variable CurPtr : ListPointerType ; + begin + if LocalOutOfRange(Index, "Find") then + return ; -- error reporting in LocalOutOfRange + end if ; + CurPtr := HeadPointer(Index) ; + loop + if CurPtr = NULL then + -- Done + return ; + elsif ItemNumber >= CurPtr.ItemNumber then + -- Descend, Check Tail, Deallocate + HeadPointer(Index) := HeadPointer(Index).NextPtr ; + if CurPtr = TailPointer(Index) then + TailPointer(Index) := NULL ; + end if ; + DropCountVar(Index) := DropCountVar(Index) + 1 ; + deallocate(CurPtr.TagPtr) ; + deallocate(CurPtr.ExpectedPtr) ; + deallocate(CurPtr) ; + CurPtr := HeadPointer(Index) ; + else + -- Done + return ; + end if ; + end loop ; + end procedure Flush ; + + ------------------------------------------------------------ + -- Simple Scoreboard + -- Flush - Remove Elements upto and including the one with ItemNumber + procedure Flush ( + ------------------------------------------------------------ + constant ItemNumber : in integer + ) is + begin + Flush(FirstIndexVar, ItemNumber) ; + end procedure Flush ; + + ------------------------------------------------------------ + ------------------------------------------------------------ + -- Remaining Deprecated. + ------------------------------------------------------------ + ------------------------------------------------------------ + + ------------------------------------------------------------ + -- Deprecated. Maintained for backward compatibility. + -- Use TranscriptPkg.TranscriptOpen + procedure FileOpen (FileName : string; OpenKind : File_Open_Kind ) is + ------------------------------------------------------------ + begin + -- WriteFileInit := TRUE ; + -- file_open( WriteFile , FileName , OpenKind ); + TranscriptOpen(FileName, OpenKind) ; + end procedure FileOpen ; + + + ------------------------------------------------------------ + -- Deprecated. Maintained for backward compatibility. + procedure PutExpectedData (ExpectedData : ExpectedType) is + ------------------------------------------------------------ + begin + Push(ExpectedData) ; + end procedure PutExpectedData ; + + ------------------------------------------------------------ + -- Deprecated. Maintained for backward compatibility. + procedure CheckActualData (ActualData : ActualType) is + ------------------------------------------------------------ + begin + Check(ActualData) ; + end procedure CheckActualData ; + + ------------------------------------------------------------ + -- Deprecated. Maintained for backward compatibility. + impure function GetItemNumber return integer is + ------------------------------------------------------------ + begin + return GetItemCount(FirstIndexVar) ; + end GetItemNumber ; + + ------------------------------------------------------------ + -- Deprecated. Maintained for backward compatibility. + procedure SetMessage (MessageIn : String) is + ------------------------------------------------------------ + begin + -- deallocate(Message) ; + -- Message := new string'(MessageIn) ; + SetName(MessageIn) ; + end procedure SetMessage ; + + ------------------------------------------------------------ + -- Deprecated. Maintained for backward compatibility. + impure function GetMessage return string is + ------------------------------------------------------------ + begin + -- return Message.all ; + return GetName("Scoreboard") ; + end function GetMessage ; + + end protected body ScoreBoardPType ; +end ScoreboardGenericPkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/SortListPkg_int.vhd b/testsuite/gna/issue317/OSVVM/SortListPkg_int.vhd new file mode 100644 index 000000000..6f32151c5 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/SortListPkg_int.vhd @@ -0,0 +1,417 @@ +-- +-- File Name: SortListPkg_int.vhd +-- Design Unit Name: SortListPkg_int +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis jim@synthworks.com +-- +-- Description: +-- Sorting utility for array of scalars +-- Uses protected type so as to shrink and expand the data structure +-- +-- Developed for: +-- SynthWorks Design Inc. +-- VHDL Training Classes +-- 11898 SW 128th Ave. Tigard, Or 97223 +-- http://www.SynthWorks.com +-- +-- Revision History: +-- Date Version Description +-- 06/2008: 0.1 Initial revision +-- Numerous revisions for VHDL Testbenches and Verification +-- 02/2009: 1.0 First Public Released Version +-- 02/25/2009 1.1 Replaced reference to std_2008 with a reference to +-- ieee_proposed.standard_additions.all ; +-- 06/16/2010 1.2 Added EraseList parameter to to_array +-- 3/2011 2.0 added inside as non protected type +-- 6/2011 2.1 added sort as non protected type +-- 4/2013 2013.04 No Changes +-- 5/2013 2013.05 No changes of substance. +-- Deleted extra variable declaration in procedure remove +-- 1/2014 2014.01 Added RevSort. Added AllowDuplicate paramter to Add procedure +-- 1/2015 2015.01 Changed Assert/Report to Alert +-- 11/2016 2016.11 Revised Add. When AllowDuplicate, add a matching value last. +-- +-- +-- +-- Copyright (c) 2008 - 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 work.OsvvmGlobalPkg.all ; +use work.AlertLogPkg.all ; +use std.textio.all ; + +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +use ieee.std_logic_textio.all ; + +-- comment out following 2 lines with VHDL-2008. Leave in for VHDL-2002 +-- library ieee_proposed ; -- remove with VHDL-2008 +-- use ieee_proposed.standard_additions.all ; -- remove with VHDL-2008 + + +package SortListPkg_int is + -- with VHDL-2008, convert package to generic package + -- convert subtypes ElementType and ArrayofElementType to generics + -- package SortListGenericPkg is + subtype ElementType is integer ; + subtype ArrayofElementType is integer_vector ; + + impure function inside (constant E : ElementType; constant A : in ArrayofElementType) return boolean ; + impure function sort (constant A : in ArrayofElementType) return ArrayofElementType ; + impure function revsort (constant A : in ArrayofElementType) return ArrayofElementType ; + + type SortListPType is protected + procedure add ( constant A : in ElementType ; constant AllowDuplicate : Boolean := FALSE ) ; + procedure add ( constant A : in ArrayofElementType ) ; + procedure add ( constant A : in ArrayofElementType ; Min, Max : ElementType ) ; + procedure add ( variable A : inout SortListPType ) ; + -- Count items in list + impure function count return integer ; + impure function find_index ( constant A : ElementType) return integer ; + impure function inside (constant A : ElementType) return boolean ; + procedure insert ( constant A : in ElementType; constant index : in integer := 1 ) ; + impure function get ( constant index : in integer := 1 ) return ElementType ; + procedure erase ; + impure function Empty return boolean ; + procedure print ; + + procedure remove ( constant A : in ElementType ) ; + procedure remove ( constant A : in ArrayofElementType ) ; + procedure remove ( variable A : inout SortListPType ) ; + + impure function to_array (constant EraseList : boolean := FALSE) return ArrayofElementType ; + impure function to_rev_array (constant EraseList : boolean := FALSE) return ArrayofElementType ; + end protected SortListPType ; + +end SortListPkg_int ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +package body SortListPkg_int is + + impure function inside (constant E : ElementType; constant A : in ArrayofElementType) return boolean is + begin + for i in A'range loop + if E = A(i) then + return TRUE ; + end if ; + end loop ; + return FALSE ; + end function inside ; + + type SortListPType is protected body + type ListType ; + type ListPointerType is access ListType ; + type ListType is record + A : ElementType ; + -- item_num : integer ; + NextPtr : ListPointerType ; + -- PrevPtr : ListPointerType ; + end record ; + variable HeadPointer : ListPointerType := NULL ; + -- variable TailPointer : ListPointerType := NULL ; + + procedure add ( constant A : in ElementType ; constant AllowDuplicate : Boolean := FALSE ) is + variable CurPtr, tempPtr : ListPointerType ; + begin + if HeadPointer = NULL then + HeadPointer := new ListType'(A, NULL) ; + elsif A = HeadPointer.A then -- ignore duplicates + if AllowDuplicate then + tempPtr := HeadPointer ; + HeadPointer := new ListType'(A, tempPtr) ; + end if ; + elsif A < HeadPointer.A then + tempPtr := HeadPointer ; + HeadPointer := new ListType'(A, tempPtr) ; + else + CurPtr := HeadPointer ; + AddLoop : loop + exit AddLoop when CurPtr.NextPtr = NULL ; + exit AddLoop when A < CurPtr.NextPtr.A ; + if A = CurPtr.NextPtr.A then +-- if AllowDuplicate then -- changed s.t. insert at after match rather than before +-- exit AddLoop ; -- insert +-- else + if not AllowDuplicate then + return ; -- return without insert + end if; + end if ; + CurPtr := CurPtr.NextPtr ; + end loop AddLoop ; + tempPtr := CurPtr.NextPtr ; + CurPtr.NextPtr := new ListType'(A, tempPtr) ; + end if ; + end procedure add ; + + procedure add ( constant A : in ArrayofElementType ) is + begin + for i in A'range loop + add(A(i)) ; + end loop ; + end procedure add ; + + procedure add ( constant A : in ArrayofElementType ; Min, Max : ElementType ) is + begin + for i in A'range loop + if A(i) >= Min and A(i) <= Max then + add(A(i)) ; + end if ; + end loop ; + end procedure add ; + + procedure add ( variable A : inout SortListPType ) is + begin + for i in 1 to A.Count loop + add(A.Get(i)) ; + end loop ; + end procedure add ; + + -- Count items in list + impure function count return integer is + variable result : positive := 1 ; + variable CurPtr : ListPointerType ; + begin + if HeadPointer = NULL then + return 0 ; + else + CurPtr := HeadPointer ; + loop + exit when CurPtr.NextPtr = NULL ; + result := result + 1 ; + CurPtr := CurPtr.NextPtr ; + end loop ; + return result ; + end if ; + end function count ; + + impure function find_index (constant A : ElementType) return integer is + variable result : positive := 2 ; + variable CurPtr : ListPointerType ; + begin + if HeadPointer = NULL then + return 0 ; + elsif A <= HeadPointer.A then + return 1 ; + else + CurPtr := HeadPointer ; + loop + exit when CurPtr.NextPtr = NULL ; + exit when A <= CurPtr.NextPtr.A ; + result := result + 1 ; + CurPtr := CurPtr.NextPtr ; + end loop ; + return result ; + end if ; + end function find_index ; + + impure function inside (constant A : ElementType) return boolean is + variable CurPtr : ListPointerType ; + begin + if HeadPointer = NULL then + return FALSE ; + end if ; + if A = HeadPointer.A then + return TRUE ; + else + CurPtr := HeadPointer ; + loop + exit when CurPtr.NextPtr = NULL ; + exit when A < CurPtr.NextPtr.A ; + if A = CurPtr.NextPtr.A then + return TRUE ; -- exit + end if; + CurPtr := CurPtr.NextPtr ; + end loop ; + end if ; + return FALSE ; + end function inside ; + + + procedure insert( constant A : in ElementType; constant index : in integer := 1 ) is + variable CurPtr, tempPtr : ListPointerType ; + begin + if index <= 1 then + tempPtr := HeadPointer ; + HeadPointer := new ListType'(A, tempPtr) ; + else + CurPtr := HeadPointer ; + for i in 3 to index loop + exit when CurPtr.NextPtr = NULL ; -- end of list + CurPtr := CurPtr.NextPtr ; + end loop ; + tempPtr := CurPtr.NextPtr ; + CurPtr.NextPtr := new ListType'(A, tempPtr) ; + end if; + end procedure insert ; + + impure function get ( constant index : in integer := 1 ) return ElementType is + variable CurPtr : ListPointerType ; + begin + if index > Count then + Alert(OSVVM_ALERTLOG_ID, "SortLIstPkg_int.get index out of range", FAILURE) ; + return ElementType'left ; + elsif HeadPointer = NULL then + return ElementType'left ; + elsif index <= 1 then + return HeadPointer.A ; + else + CurPtr := HeadPointer ; + for i in 2 to index loop + CurPtr := CurPtr.NextPtr ; + end loop ; + return CurPtr.A ; + end if; + end function get ; + + + procedure erase (variable CurPtr : inout ListPointerType ) is + begin + if CurPtr.NextPtr /= NULL then + erase (CurPtr.NextPtr) ; + end if ; + deallocate (CurPtr) ; + end procedure erase ; + + procedure erase is + begin + if HeadPointer /= NULL then + erase(HeadPointer) ; + -- deallocate (HeadPointer) ; + HeadPointer := NULL ; + end if; + end procedure erase ; + + impure function Empty return boolean is + begin + return HeadPointer = NULL ; + end Empty ; + + procedure print is + variable buf : line ; + variable CurPtr : ListPointerType ; + begin + if HeadPointer = NULL then + write (buf, string'("( )")) ; + else + CurPtr := HeadPointer ; + write (buf, string'("(")) ; + loop + write (buf, CurPtr.A) ; + exit when CurPtr.NextPtr = NULL ; + write (buf, string'(", ")) ; + CurPtr := CurPtr.NextPtr ; + end loop ; + write (buf, string'(")")) ; + end if ; + writeline(OUTPUT, buf) ; + end procedure print ; + + procedure remove ( constant A : in ElementType ) is + variable CurPtr, tempPtr : ListPointerType ; + begin + if HeadPointer = NULL then + return ; + elsif A = HeadPointer.A then + tempPtr := HeadPointer ; + HeadPointer := HeadPointer.NextPtr ; + deallocate (tempPtr) ; + else + CurPtr := HeadPointer ; + loop + exit when CurPtr.NextPtr = NULL ; + if A = CurPtr.NextPtr.A then + tempPtr := CurPtr.NextPtr ; + CurPtr.NextPtr := CurPtr.NextPtr.NextPtr ; + deallocate (tempPtr) ; + exit ; + end if ; + exit when A < CurPtr.NextPtr.A ; + CurPtr := CurPtr.NextPtr ; + end loop ; + end if ; + end procedure remove ; + + procedure remove ( constant A : in ArrayofElementType ) is + begin + for i in A'range loop + remove(A(i)) ; + end loop ; + end procedure remove ; + + procedure remove ( variable A : inout SortListPType ) is + begin + for i in 1 to A.Count loop + remove(A.Get(i)) ; + end loop ; + end procedure remove ; + + impure function to_array (constant EraseList : boolean := FALSE) return ArrayofElementType is + variable result : ArrayofElementType(1 to Count) ; + begin + for i in 1 to Count loop + result(i) := Get(i) ; + end loop ; + if EraseList then + erase ; + end if ; + return result ; + end function to_array ; + + impure function to_rev_array (constant EraseList : boolean := FALSE) return ArrayofElementType is + variable result : ArrayofElementType(Count downto 1) ; + begin + for i in 1 to Count loop + result(i) := Get(i) ; + end loop ; + if EraseList then + erase ; + end if ; + return result ; + end function to_rev_array ; + + end protected body SortListPType ; + + + impure function sort (constant A : in ArrayofElementType) return ArrayofElementType is + variable Result : SortListPType ; + begin + for i in A'range loop + Result.Add(A(i), TRUE) ; + end loop ; + return Result.to_array(EraseList => TRUE) ; + end function sort ; + + impure function revsort (constant A : in ArrayofElementType) return ArrayofElementType is + variable Result : SortListPType ; + begin + for i in A'range loop + Result.Add(A(i), TRUE) ; + end loop ; + return Result.to_rev_array(EraseList => TRUE) ; + end function revsort ; +end SortListPkg_int ; + diff --git a/testsuite/gna/issue317/OSVVM/TextUtilPkg.vhd b/testsuite/gna/issue317/OSVVM/TextUtilPkg.vhd new file mode 100644 index 000000000..d1c5ee17e --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/TextUtilPkg.vhd @@ -0,0 +1,407 @@ +-- +-- 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 ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/OSVVM/TranscriptPkg.vhd b/testsuite/gna/issue317/OSVVM/TranscriptPkg.vhd new file mode 100644 index 000000000..a88b00a25 --- /dev/null +++ b/testsuite/gna/issue317/OSVVM/TranscriptPkg.vhd @@ -0,0 +1,200 @@ +-- +-- File Name: TranscriptPkg.vhd +-- Design Unit Name: TranscriptPkg +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis jim@synthworks.com +-- +-- +-- Description: +-- Define file identifier TranscriptFile +-- provide subprograms to open, close, and print to it. +-- +-- +-- 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.01 Initial revision +-- 01/2016: 2016.01 TranscriptOpen function now calls procedure of same name +-- 11/2016: 2016.l1 Added procedure BlankLine +-- +-- +-- 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 ; +package TranscriptPkg is + + -- File Identifier to facilitate usage of one transcript file + file TranscriptFile : text ; + + -- Cause compile errors if READ_MODE is passed to TranscriptOpen + subtype WRITE_APPEND_OPEN_KIND is FILE_OPEN_KIND range WRITE_MODE to APPEND_MODE ; + + -- Open and close TranscriptFile. Function allows declarative opens + procedure TranscriptOpen (Status: out FILE_OPEN_STATUS; ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) ; + procedure TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) ; + impure function TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS ; + + procedure TranscriptClose ; + impure function IsTranscriptOpen return boolean ; + alias IsTranscriptEnabled is IsTranscriptOpen [return boolean] ; + + -- Mirroring. When using TranscriptPkw WriteLine and Print, uses both TranscriptFile and OUTPUT + procedure SetTranscriptMirror (A : boolean := TRUE) ; + impure function IsTranscriptMirrored return boolean ; + alias GetTranscriptMirror is IsTranscriptMirrored [return boolean] ; + + -- Write to TranscriptFile when open. Write to OUTPUT when not open or IsTranscriptMirrored + procedure WriteLine(buf : inout line) ; + procedure Print(s : string) ; + + -- Create "count" number of blank lines + procedure BlankLine (count : integer := 1) ; + +end TranscriptPkg ; + +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// +--- /////////////////////////////////////////////////////////////////////////// + +package body TranscriptPkg is + ------------------------------------------------------------ + type LocalBooleanPType is protected + procedure Set (A : boolean) ; + impure function get return boolean ; + end protected LocalBooleanPType ; + type LocalBooleanPType is protected body + variable GlobalVar : boolean := FALSE ; + procedure Set (A : boolean) is + begin + GlobalVar := A ; + end procedure Set ; + impure function get return boolean is + begin + return GlobalVar ; + end function get ; + end protected body LocalBooleanPType ; + + ------------------------------------------------------------ + shared variable TranscriptEnable : LocalBooleanPType ; + shared variable TranscriptMirror : LocalBooleanPType ; + + ------------------------------------------------------------ + procedure TranscriptOpen (Status: out FILE_OPEN_STATUS; ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) is + ------------------------------------------------------------ + begin + file_open(Status, TranscriptFile, ExternalName, OpenKind) ; + if Status = OPEN_OK then + TranscriptEnable.Set(TRUE) ; + end if ; + end procedure TranscriptOpen ; + + ------------------------------------------------------------ + procedure TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) is + ------------------------------------------------------------ + variable Status : FILE_OPEN_STATUS ; + begin + TranscriptOpen(Status, ExternalName, OpenKind) ; + if Status /= OPEN_OK then + report "TranscriptPkg.TranscriptOpen file: " & + ExternalName & " status is: " & to_string(status) & " and is not OPEN_OK" severity FAILURE ; + end if ; + end procedure TranscriptOpen ; + + ------------------------------------------------------------ + impure function TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS is + ------------------------------------------------------------ + variable Status : FILE_OPEN_STATUS ; + begin + TranscriptOpen(Status, ExternalName, OpenKind) ; + return Status ; + end function TranscriptOpen ; + + ------------------------------------------------------------ + procedure TranscriptClose is + ------------------------------------------------------------ + begin + if TranscriptEnable.Get then + file_close(TranscriptFile) ; + end if ; + TranscriptEnable.Set(FALSE) ; + end procedure TranscriptClose ; + + ------------------------------------------------------------ + impure function IsTranscriptOpen return boolean is + ------------------------------------------------------------ + begin + return TranscriptEnable.Get ; + end function IsTranscriptOpen ; + + ------------------------------------------------------------ + procedure SetTranscriptMirror (A : boolean := TRUE) is + ------------------------------------------------------------ + begin + TranscriptMirror.Set(A) ; + end procedure SetTranscriptMirror ; + + ------------------------------------------------------------ + impure function IsTranscriptMirrored return boolean is + ------------------------------------------------------------ + begin + return TranscriptMirror.Get ; + end function IsTranscriptMirrored ; + + ------------------------------------------------------------ + procedure WriteLine(buf : inout line) is + ------------------------------------------------------------ + begin + if not TranscriptEnable.Get then + WriteLine(OUTPUT, buf) ; + elsif TranscriptMirror.Get then + TEE(TranscriptFile, buf) ; + else + WriteLine(TranscriptFile, buf) ; + end if ; + end procedure WriteLine ; + + ------------------------------------------------------------ + procedure Print(s : string) is + ------------------------------------------------------------ + variable buf : line ; + begin + write(buf, s) ; + WriteLine(buf) ; + end procedure Print ; + + ------------------------------------------------------------ + procedure BlankLine (count : integer := 1) is + ------------------------------------------------------------ + begin + for i in 1 to count loop + print("") ; + end loop ; + end procedure Blankline ; + +end package body TranscriptPkg ;
\ No newline at end of file diff --git a/testsuite/gna/issue317/PoC/src/common/components.vhdl b/testsuite/gna/issue317/PoC/src/common/components.vhdl new file mode 100644 index 000000000..3be522de7 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/components.vhdl @@ -0,0 +1,328 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Package: Common primitives described as a function +-- +-- Description: +-- ------------------------------------- +-- This packages describes common primitives like flip flops and multiplexers +-- as a function to use them as one-liners. +-- +-- ATTENSION: +-- The parameter 'constant INIT' of some functions is actually the reset +-- value, not the initial value after device programming (e.g. for FPGAs), +-- this value MUST be set via signal declaration! +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.STD_LOGIC_1164.all; +use IEEE.NUMERIC_STD.all; + +library PoC; +use PoC.utils.all; + + +package components is + -- implement an optional register stage + function registered(signal Clock : std_logic; constant IsRegistered : boolean) return boolean; + + -- FlipFlop functions + -- =========================================================================== + -- RS-FlipFlops + function ffrs(q : std_logic; rst : std_logic := '0'; set : std_logic := '0') return std_logic; -- RS-FlipFlop with dominant rst + function ffsr(q : std_logic; rst : std_logic := '0'; set : std_logic := '0') return std_logic; -- RS-FlipFlop with dominant set + -- D-FlipFlops (Delay) + function ffdre(q : std_logic; d : std_logic; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : std_logic := '0') return std_logic; -- D-FlipFlop with reset and enable + function ffdre(q : std_logic_vector; d : std_logic_vector; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : std_logic_vector := (0 to 0 => '0')) return std_logic_vector; -- D-FlipFlop with reset and enable + function ffdse(q : std_logic; d : std_logic; set : std_logic := '0'; en : std_logic := '1') return std_logic; -- D-FlipFlop with set and enable + -- T-FlipFlops (Toggle) + function fftre(q : std_logic; t : std_logic; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : std_logic := '0') return std_logic; -- T-FlipFlop with reset and enable + function fftse(q : std_logic; t : std_logic; set : std_logic := '0'; en : std_logic := '1') return std_logic; -- T-FlipFlop with set and enable + + -- counter + function upcounter_next(cnt : unsigned; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : natural := 0) return unsigned; + function upcounter_equal(cnt : unsigned; value : natural) return std_logic; + function downcounter_next(cnt : signed; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : integer := 0) return signed; + function downcounter_equal(cnt : signed; value : integer) return std_logic; + function downcounter_neg(cnt : signed) return std_logic; + + -- shiftregisters + function shreg_left(q : std_logic_vector; i : std_logic; en : std_logic := '1') return std_logic_vector; + function shreg_right(q : std_logic_vector; i : std_logic; en : std_logic := '1') return std_logic_vector; + -- rotate registers + function rreg_left(q : std_logic_vector; en : std_logic := '1') return std_logic_vector; + function rreg_right(q : std_logic_vector; en : std_logic := '1') return std_logic_vector; + + -- compare + function comp(value1 : std_logic_vector; value2 : std_logic_vector) return std_logic_vector; + function comp(value1 : unsigned; value2 : unsigned) return unsigned; + function comp(value1 : signed; value2 : signed) return signed; + function comp_allzero(value : std_logic_vector) return std_logic; + function comp_allzero(value : unsigned) return std_logic; + function comp_allzero(value : signed) return std_logic; + function comp_allone(value : std_logic_vector) return std_logic; + function comp_allone(value : unsigned) return std_logic; + function comp_allone(value : signed) return std_logic; + + -- multiplexing + function mux(sel : std_logic; sl0 : std_logic; sl1 : std_logic) return std_logic; + function mux(sel : std_logic; slv0 : std_logic_vector; slv1 : std_logic_vector) return std_logic_vector; + function mux(sel : std_logic; us0 : unsigned; us1 : unsigned) return unsigned; + function mux(sel : std_logic; s0 : signed; s1 : signed) return signed; +end package; + + +package body components is + -- implement an optional register stage + -- =========================================================================== + function registered(signal Clock : std_logic; constant IsRegistered : boolean) return boolean is + begin + return ite(IsRegistered, rising_edge(Clock), TRUE); + end function; + + -- FlipFlops + -- =========================================================================== + -- D-flipflop with reset and enable + function ffdre(q : std_logic; d : std_logic; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : std_logic := '0') return std_logic is + begin + if not SIMULATION then + if (INIT = '0') then + return ((d and en) or (q and not en)) and not rst; + elsif (INIT = '1') then + return ((d and en) or (q and not en)) or rst; + else + report "Unsupported INIT value for synthesis." severity FAILURE; + return 'X'; + end if; + elsif (rst = '1') then + return INIT; + else + return ((d and en) or (q and not en)); + end if; + end function; + + function ffdre(q : std_logic_vector; d : std_logic_vector; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : std_logic_vector := (0 to 0 => '0')) return std_logic_vector is + constant INIT_I : std_logic_vector(q'range) := resize(INIT, q'length); + variable Result : std_logic_vector(q'range); + begin + for i in q'range loop + Result(i) := ffdre(q => q(i), d => d(i), rst => rst, en => en, INIT => INIT_I(i)); + end loop; + return Result; + end function; + + -- D-flipflop with set and enable + function ffdse(q : std_logic; d : std_logic; set : std_logic := '0'; en : std_logic := '1') return std_logic is + begin + return ffdre(q => q, d => d, rst => set, en => en, INIT => '1'); + end function; + + -- T-flipflop with reset and enable + function fftre(q : std_logic; t : std_logic; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : std_logic := '0') return std_logic is + begin + if not SIMULATION then + if (INIT = '0') then + return ((not q and (t and en)) or (q and not (t and en))) and not rst; + elsif (INIT = '1') then + return ((not q and (t and en)) or (q and not (t and en))) or rst; + else + report "Unsupported INIT value for synthesis." severity FAILURE; + return 'X'; + end if; + elsif (rst = '1') then + return INIT; + else + return ((not q and (t and en)) or (q and not (t and en))); + end if; + end function; + + -- T-flipflop with set and enable + function fftse(q : std_logic; t : std_logic; set : std_logic := '0'; en : std_logic := '1') return std_logic is + begin + return fftre(q => q, t => t, rst => set, en => en, INIT => '1'); + end function; + + -- RS-flipflop with dominant rst + function ffrs(q : std_logic; rst : std_logic := '0'; set : std_logic := '0') return std_logic is + begin + return (q or set) and not rst; + end function; + + -- RS-flipflop with dominant set + function ffsr(q : std_logic; rst : std_logic := '0'; set : std_logic := '0') return std_logic is + begin + return (q and not rst) or set; + end function; + + + -- Counters + -- =========================================================================== + -- up-counter + function upcounter_next(cnt : unsigned; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : natural := 0) return unsigned is + begin + if (rst = '1') then + return to_unsigned(INIT, cnt'length); + elsif (en = '1') then + return cnt + 1; + else + return cnt; + end if; + end function; + + function upcounter_equal(cnt : unsigned; value : natural) return std_logic is + begin + -- optimized comparison for only up counting values + return to_sl((cnt and to_unsigned(value, cnt'length)) = value); + end function; + + -- down-counter + function downcounter_next(cnt : signed; rst : std_logic := '0'; en : std_logic := '1'; constant INIT : integer := 0) return signed is + begin + if (rst = '1') then + return to_signed(INIT, cnt'length); + elsif (en = '1') then + return cnt - 1; + else + return cnt; + end if; + end function; + + function downcounter_equal(cnt : signed; value : integer) return std_logic is + begin + -- optimized comparison for only down counting values + return to_sl((cnt nor to_signed(value, cnt'length)) /= value); + end function; + + function downcounter_neg(cnt : signed) return std_logic is + begin + return cnt(cnt'high); + end function; + + -- Shift/Rotate Registers + -- =========================================================================== + function shreg_left(q : std_logic_vector; i : std_logic; en : std_logic := '1') return std_logic_vector is + begin + return mux(en, q, q(q'left - 1 downto q'right) & i); + end function; + + function shreg_right(q : std_logic_vector; i : std_logic; en : std_logic := '1') return std_logic_vector is + begin + return mux(en, q, i & q(q'left downto q'right - 1)); + end function; + + function rreg_left(q : std_logic_vector; en : std_logic := '1') return std_logic_vector is + begin + return mux(en, q, q(q'left - 1 downto q'right) & q(q'left)); + end function; + + function rreg_right(q : std_logic_vector; en : std_logic := '1') return std_logic_vector is + begin + return mux(en, q, q(q'right) & q(q'left downto q'right - 1)); + end function; + + -- compare functions + -- =========================================================================== + -- Returns, when + -- 1- => value1 < value2 (difference is negative) + -- 00 => value1 = value2 (difference is zero) + -- -1 => value1 > value2 (difference is positive) + function comp(value1 : std_logic_vector; value2 : std_logic_vector) return std_logic_vector is + begin + report "Comparing two STD_LOGIC_VECTORs - implicit conversion to UNSIGNED" severity WARNING; + return std_logic_vector(comp(unsigned(value1), unsigned(value2))); + end function; + + function comp(value1 : unsigned; value2 : unsigned) return unsigned is + begin + if value1 < value2 then + return "10"; + elsif value1 = value2 then + return "00"; + else + return "01"; + end if; + end function; + + function comp(value1 : signed; value2 : signed) return signed is + begin + if value1 < value2 then + return "10"; + elsif value1 = value2 then + return "00"; + else + return "01"; + end if; + end function; + + function comp_allzero(value : std_logic_vector) return std_logic is + begin + return comp_allzero(unsigned(value)); + end function; + + function comp_allzero(value : unsigned) return std_logic is + begin + return to_sl(value = (value'range => '0')); + end function; + + function comp_allzero(value : signed) return std_logic is + begin + return to_sl(value = (value'range => '0')); + end function; + + function comp_allone(value : std_logic_vector) return std_logic is + begin + return comp_allone(unsigned(value)); + end function; + + function comp_allone(value : unsigned) return std_logic is + begin + return to_sl(value = (value'range => '1')); + end function; + + function comp_allone(value : signed) return std_logic is + begin + return to_sl(value = (value'range => '1')); + end function; + + + -- multiplexers + function mux(sel : std_logic; sl0 : std_logic; sl1 : std_logic) return std_logic is + begin + return (sl0 and not sel) or (sl1 and sel); + end function; + + function mux(sel : std_logic; slv0 : std_logic_vector; slv1 : std_logic_vector) return std_logic_vector is + begin + return (slv0 and not (slv0'range => sel)) or (slv1 and (slv1'range => sel)); + end function; + + function mux(sel : std_logic; us0 : unsigned; us1 : unsigned) return unsigned is + begin + return (us0 and not (us0'range => sel)) or (us1 and (us1'range => sel)); + end function; + + function mux(sel : std_logic; s0 : signed; s1 : signed) return signed is + begin + return (s0 and not (s0'range => sel)) or (s1 and (s1'range => sel)); + end function; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/config.vhdl b/testsuite/gna/issue317/PoC/src/common/config.vhdl new file mode 100644 index 000000000..854ec5a44 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/config.vhdl @@ -0,0 +1,1173 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Thomas B. Preusser +-- Martin Zabel +-- Patrick Lehmann +-- +-- Package: Global configuration settings. +-- +-- Description: +-- ------------------------------------- +-- This file evaluates the settings declared in the project specific package my_config. +-- See also template file my_config.vhdl.template. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany, +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; + +library PoC; +use PoC.utils.all; + +package config_private is + -- TODO: + -- =========================================================================== + subtype T_BOARD_STRING is string(1 to 16); + subtype T_BOARD_CONFIG_STRING is string(1 to 64); + subtype T_DEVICE_STRING is string(1 to 32); + + -- Data structures to describe UART / RS232 + type T_BOARD_UART_DESC is record + IsDTE : boolean; -- Data terminal Equipment (e.g. PC, Printer) + FlowControl : T_BOARD_CONFIG_STRING; -- (NONE, SW, HW_CTS_RTS, HW_RTR_RTS) + BaudRate : T_BOARD_CONFIG_STRING; -- e.g. "115.2 kBd" + BaudRate_Max : T_BOARD_CONFIG_STRING; + end record; + + -- Data structures to describe Ethernet + type T_BOARD_ETHERNET_DESC is record + IPStyle : T_BOARD_CONFIG_STRING; + RS_DataInterface : T_BOARD_CONFIG_STRING; + PHY_Device : T_BOARD_CONFIG_STRING; + PHY_DeviceAddress : std_logic_vector(7 downto 0); + PHY_DataInterface : T_BOARD_CONFIG_STRING; + PHY_ManagementInterface : T_BOARD_CONFIG_STRING; + end record; + + subtype T_BOARD_ETHERNET_DESC_INDEX is natural range 0 to 7; + type T_BOARD_ETHERNET_DESC_VECTOR is array(natural range <>) of T_BOARD_ETHERNET_DESC; + + -- Data structures to describe a board layout + type T_BOARD_INFO is record + BoardName : T_BOARD_CONFIG_STRING; + FPGADevice : T_BOARD_CONFIG_STRING; + UART : T_BOARD_UART_DESC; + Ethernet : T_BOARD_ETHERNET_DESC_VECTOR(T_BOARD_ETHERNET_DESC_INDEX); + EthernetCount : T_BOARD_ETHERNET_DESC_INDEX; + end record; + + type T_BOARD_INFO_VECTOR is array (natural range <>) of T_BOARD_INFO; + + constant C_POC_NUL : character; + constant C_BOARD_STRING_EMPTY : T_BOARD_STRING; + constant C_BOARD_CONFIG_STRING_EMPTY : T_BOARD_CONFIG_STRING; + constant C_DEVICE_STRING_EMPTY : T_DEVICE_STRING; + constant C_BOARD_INFO_LIST : T_BOARD_INFO_VECTOR; + + function conf(str : string) return T_BOARD_CONFIG_STRING; +end package; + + +package body config_private is + constant C_POC_NUL : character := '~'; + constant C_BOARD_STRING_EMPTY : T_BOARD_STRING := (others => C_POC_NUL); + constant C_BOARD_CONFIG_STRING_EMPTY : T_BOARD_CONFIG_STRING := (others => C_POC_NUL); + constant C_DEVICE_STRING_EMPTY : T_DEVICE_STRING := (others => C_POC_NUL); + + function conf(str : string) return T_BOARD_CONFIG_STRING is + constant ConstNUL : string(1 to 1) := (others => C_POC_NUL); + variable Result : string(1 to T_BOARD_CONFIG_STRING'length); + begin + Result := (others => C_POC_NUL); + if (str'length > 0) then + Result(1 to bound(T_BOARD_CONFIG_STRING'length, 1, str'length)) := ite((str'length > 0), str(1 to imin(T_BOARD_CONFIG_STRING'length, str'length)), ConstNUL); + end if; + return Result; + end function; + + constant C_BOARD_ETHERNET_DESC_EMPTY : T_BOARD_ETHERNET_DESC := ( + IPStyle => C_BOARD_CONFIG_STRING_EMPTY, + RS_DataInterface => C_BOARD_CONFIG_STRING_EMPTY, + PHY_Device => C_BOARD_CONFIG_STRING_EMPTY, + PHY_DeviceAddress => x"00", + PHY_DataInterface => C_BOARD_CONFIG_STRING_EMPTY, + PHY_ManagementInterface => C_BOARD_CONFIG_STRING_EMPTY + ); + + -- predefined UART descriptions + function brd_CreateUART(IsDTE : boolean; FlowControl : string; BaudRate : string; BaudRate_Max : string := "") return T_BOARD_UART_DESC is + variable Result : T_BOARD_UART_DESC; + begin + Result.IsDTE := IsDTE; + Result.FlowControl := conf(FlowControl); + Result.BaudRate := conf(BaudRate); + Result.BaudRate_Max := ite((BaudRate_Max = ""), conf(BaudRate), conf(BaudRate_Max)); + return Result; + end function; + + -- IsDTE FlowControl BaudRate + constant C_BOARD_UART_EMPTY : T_BOARD_UART_DESC := brd_CreateUART(TRUE, "NONE", "0 Bd"); + constant C_BOARD_UART_DTE_115200_NONE : T_BOARD_UART_DESC := brd_CreateUART(TRUE, "NONE", "115.2 kBd"); + constant C_BOARD_UART_DCE_115200_NONE : T_BOARD_UART_DESC := brd_CreateUART(FALSE, "NONE", "115.2 kBd"); + constant C_BOARD_UART_DCE_115200_HWCTS : T_BOARD_UART_DESC := brd_CreateUART(FALSE, "HW_CTS_RTS", "115.2 kBd"); + constant C_BOARD_UART_DCE_460800_NONE : T_BOARD_UART_DESC := brd_CreateUART(FALSE, "NONE", "460.8 kBd"); + constant C_BOARD_UART_DTE_921600_NONE : T_BOARD_UART_DESC := brd_CreateUART(FALSE, "NONE", "921.6 kBd"); + + function brd_CreateEthernet(IPStyle : string; RS_DataInt : string; PHY_Device : string; PHY_DevAddress : std_logic_vector(7 downto 0); PHY_DataInt : string; PHY_MgntInt : string) return T_BOARD_ETHERNET_DESC is + variable Result : T_BOARD_ETHERNET_DESC; + begin + Result.IPStyle := conf(IPStyle); + Result.RS_DataInterface := conf(RS_DataInt); + Result.PHY_Device := conf(PHY_Device); + Result.PHY_DeviceAddress := PHY_DevAddress; + Result.PHY_DataInterface := conf(PHY_DataInt); + Result.PHY_ManagementInterface := conf(PHY_MgntInt); + return Result; + end function; + + constant C_BOARD_ETH_EMPTY : T_BOARD_ETHERNET_DESC := brd_CreateEthernet("", "", "", x"00", "", ""); + constant C_BOARD_ETH_SOFT_GMII_88E1111 : T_BOARD_ETHERNET_DESC := brd_CreateEthernet("SOFT", "GMII", "MARVEL_88E1111", x"07", "GMII", "MDIO"); + constant C_BOARD_ETH_HARD_GMII_88E1111 : T_BOARD_ETHERNET_DESC := brd_CreateEthernet("HARD", "GMII", "MARVEL_88E1111", x"07", "GMII", "MDIO"); + constant C_BOARD_ETH_SOFT_SGMII_88E1111 : T_BOARD_ETHERNET_DESC := brd_CreateEthernet("SOFT", "GMII", "MARVEL_88E1111", x"07", "SGMII", "MDIO_OVER_IIC"); + + constant C_BOARD_ETH_NONE : T_BOARD_ETHERNET_DESC_VECTOR(T_BOARD_ETHERNET_DESC_INDEX) := (others => C_BOARD_ETH_EMPTY); + + + -- Board Descriptions + -- =========================================================================== + constant C_BOARD_INFO_LIST : T_BOARD_INFO_VECTOR := ( + ( + BoardName => conf("GENERIC"), + FPGADevice => conf("GENERIC"), -- GENERIC + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY + ), + EthernetCount => 1 + ), + -- Altera boards + -- ========================================================================= + ( + BoardName => conf("DE0"), + FPGADevice => conf("EP3C16F484"), -- EP3C16F484 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("S2GXAV"), + FPGADevice => conf("EP2SGX90FF1508C3"), -- EP2SGX90FF1508C3 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("DE4"), + FPGADevice => conf("EP4SGX230KF40C2"), -- EP4SGX230KF40C2 + UART => C_BOARD_UART_DCE_460800_NONE, + Ethernet => ( + 0 => brd_CreateEthernet("SOFT", "GMII", "MARVEL_88E1111", x"00", "RGMII", "MDIO"), + 1 => brd_CreateEthernet("SOFT", "GMII", "MARVEL_88E1111", x"01", "RGMII", "MDIO"), + 2 => brd_CreateEthernet("SOFT", "GMII", "MARVEL_88E1111", x"02", "RGMII", "MDIO"), + 3 => brd_CreateEthernet("SOFT", "GMII", "MARVEL_88E1111", x"03", "RGMII", "MDIO"), + others => C_BOARD_ETH_EMPTY + ), + EthernetCount => 4 + ),( + BoardName => conf("DE5"), + FPGADevice => conf("EP5SGXEA7N2F45C2"), -- EP5SGXEA7N2F45C2 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ), + -- Lattice boards + -- ========================================================================= + ( + BoardName => conf("ECP5 Versa"), + FPGADevice => conf("LFE5UM-45F-6BG381C"), -- LFE5UM-45F-6BG381C + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ), + -- Xilinx boards + -- ========================================================================= + ( + BoardName => conf("S3SK200"), + FPGADevice => conf("XC3S200-4FT256"), -- XC3S200-4FT256 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("S3SK1000"), + FPGADevice => conf("XC3S1000-4FT256"), -- XC2S1000-4FT256 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("S3ESK500"), + FPGADevice => conf("XC3S500E-4FG320"), -- XC3S500E-4FG320 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("S3ESK1600"), + FPGADevice => conf("XC3S1600E-4FG320"), -- XC3S1600E-4FG320 + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("ATLYS"), + FPGADevice => conf("XC6SLX45-3CSG324"), -- XC6SLX45-3CSG324 + UART => C_BOARD_UART_DCE_460800_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("ZC706"), + FPGADevice => conf("XC7Z045-2FFG900"), -- XC7Z045-2FFG900C + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("ZedBoard"), + FPGADevice => conf("XC7Z020-1CLG484"), -- XC7Z020-1CLG484 + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ),( + BoardName => conf("AC701"), + FPGADevice => conf("XC7A200T-2FBG676C"), -- XC7A200T-2FBG676C + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_SOFT_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("KC705"), + FPGADevice => conf("XC7K325T-2FFG900C"), -- XC7K325T-2FFG900C + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_SOFT_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("ML505"), + FPGADevice => conf("XC5VLX50T-1FF1136"), -- XC5VLX50T-1FF1136 + UART => C_BOARD_UART_DCE_115200_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("ML506"), + FPGADevice => conf("XC5VSX50T-1FFG1136"), -- XC5VSX50T-1FFG1136 + UART => C_BOARD_UART_DCE_115200_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("ML507"), + FPGADevice => conf("XC5VFX70T-1FFG1136"), -- XC5VFX70T-1FFG1136 + UART => C_BOARD_UART_DCE_115200_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("XUPV5"), + FPGADevice => conf("XC5VLX110T-1FF1136"), -- XC5VLX110T-1FF1136 + UART => C_BOARD_UART_DCE_115200_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("ML605"), + FPGADevice => conf("XC6VLX240T-1FF1156"), -- XC6VLX240T-1FF1156 + UART => C_BOARD_UART_EMPTY, + Ethernet => ( + 0 => C_BOARD_ETH_HARD_GMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("VC707"), + FPGADevice => conf("XC7VX485T-2FFG1761C"), -- XC7VX485T-2FFG1761C + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => ( + 0 => C_BOARD_ETH_SOFT_SGMII_88E1111, + others => C_BOARD_ETH_EMPTY), + EthernetCount => 1 + ),( + BoardName => conf("VC709"), + FPGADevice => conf("XC7VX690T-2FFG1761C"), -- XC7VX690T-2FFG1761C + UART => C_BOARD_UART_DTE_921600_NONE, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ), + -- Custom Board (MUST BE LAST ONE) + -- ========================================================================= + ( + BoardName => conf("Custom"), + FPGADevice => conf("Device is unknown for a custom board"), + UART => C_BOARD_UART_EMPTY, + Ethernet => C_BOARD_ETH_NONE, + EthernetCount => 0 + ) + ); +end package body; + + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; + +library PoC; +use PoC.my_config.all; +use PoC.my_project.all; +use PoC.config_private.all; +use PoC.utils.all; + + +package config is + constant PROJECT_DIR : string := MY_PROJECT_DIR; + constant OPERATING_SYSTEM : string := MY_OPERATING_SYSTEM; + constant POC_VERBOSE : boolean := MY_VERBOSE; + + -- List of known FPGA / Chip vendors + -- --------------------------------------------------------------------------- + type T_VENDOR is ( + VENDOR_UNKNOWN, + VENDOR_GENERIC, + VENDOR_ALTERA, + VENDOR_LATTICE, + VENDOR_XILINX + ); + + -- List of known synthesis tool chains + -- --------------------------------------------------------------------------- + type T_SYNTHESIS_TOOL is ( + SYNTHESIS_TOOL_UNKNOWN, + SYNTHESIS_TOOL_GENERIC, + SYNTHESIS_TOOL_ALTERA_QUARTUS2, + SYNTHESIS_TOOL_LATTICE_LSE, + SYNTHESIS_TOOL_SYNOPSIS, + SYNTHESIS_TOOL_XILINX_XST, + SYNTHESIS_TOOL_XILINX_VIVADO + ); + + -- List of known device families + -- --------------------------------------------------------------------------- + type T_DEVICE_FAMILY is ( + DEVICE_FAMILY_UNKNOWN, + DEVICE_FAMILY_GENERIC, + -- Altera + DEVICE_FAMILY_ARRIA, + DEVICE_FAMILY_CYCLONE, + DEVICE_FAMILY_STRATIX, + -- Lattice + DEVICE_FAMILY_ICE, + DEVICE_FAMILY_MACHXO, + DEVICE_FAMILY_ECP, + -- Xilinx + DEVICE_FAMILY_SPARTAN, + DEVICE_FAMILY_ZYNQ, + DEVICE_FAMILY_ARTIX, + DEVICE_FAMILY_KINTEX, + DEVICE_FAMILY_VIRTEX + ); + + type T_DEVICE_SERIES is ( + DEVICE_SERIES_UNKNOWN, + DEVICE_SERIES_GENERIC, + -- Xilinx FPGA series + DEVICE_SERIES_7_SERIES, + DEVICE_SERIES_ULTRASCALE, + DEVICE_SERIES_ULTRASCALE_PLUS + ); + + -- List of known devices + -- --------------------------------------------------------------------------- + type T_DEVICE is ( + DEVICE_UNKNOWN, + DEVICE_GENERIC, + -- Altera + DEVICE_MAX2, DEVICE_MAX10, -- Altera.Max + DEVICE_ARRIA1, DEVICE_ARRIA2, DEVICE_ARRIA5, DEVICE_ARRIA10, -- Altera.Arria + DEVICE_CYCLONE1, DEVICE_CYCLONE2, DEVICE_CYCLONE3, DEVICE_CYCLONE4, -- Altera.Cyclone + DEVICE_CYCLONE5, -- + DEVICE_STRATIX1, DEVICE_STRATIX2, DEVICE_STRATIX3, DEVICE_STRATIX4, -- Altera.Stratix + DEVICE_STRATIX5, DEVICE_STRATIX10, -- + -- Lattice + DEVICE_ICE40, DEVICE_ICE65, DEVICE_ICE5, -- Lattice.iCE + DEVICE_MACHXO, DEVICE_MACHXO2, -- Lattice.MachXO + DEVICE_ECP3, DEVICE_ECP4, DEVICE_ECP5, -- Lattice.ECP + -- Xilinx + DEVICE_SPARTAN3, DEVICE_SPARTAN6, -- Xilinx.Spartan + DEVICE_ZYNQ7, DEVICE_ZYNQ_ULTRA_PLUS, -- Xilinx.Zynq + DEVICE_ARTIX7, -- Xilinx.Artix + DEVICE_KINTEX7, DEVICE_KINTEX_ULTRA, DEVICE_KINTEX_ULTRA_PLUS, -- Xilinx.Kintex + DEVICE_VIRTEX4, DEVICE_VIRTEX5, DEVICE_VIRTEX6, DEVICE_VIRTEX7, -- Xilinx.Virtex + DEVICE_VIRTEX_ULTRA, DEVICE_VIRTEX_ULTRA_PLUS -- + ); + + -- List of known device subtypes + -- --------------------------------------------------------------------------- + type T_DEVICE_SUBTYPE is ( + DEVICE_SUBTYPE_NONE, + DEVICE_SUBTYPE_GENERIC, + -- Altera + DEVICE_SUBTYPE_E, + DEVICE_SUBTYPE_GS, + DEVICE_SUBTYPE_GX, + DEVICE_SUBTYPE_GT, + -- Lattice + DEVICE_SUBTYPE_U, + DEVICE_SUBTYPE_UM, + -- Xilinx + DEVICE_SUBTYPE_X, + DEVICE_SUBTYPE_T, + DEVICE_SUBTYPE_XT, + DEVICE_SUBTYPE_HT, + DEVICE_SUBTYPE_LX, + DEVICE_SUBTYPE_SXT, + DEVICE_SUBTYPE_LXT, + DEVICE_SUBTYPE_TXT, + DEVICE_SUBTYPE_FXT, + DEVICE_SUBTYPE_CXT, + DEVICE_SUBTYPE_HXT + ); + + -- List of known transceiver (sub-)types + -- --------------------------------------------------------------------------- + type T_TRANSCEIVER is ( + TRANSCEIVER_NONE, + TRANSCEIVER_GENERIC, + -- TODO: add more? Altera transceivers + -- Altera transceivers + TRANSCEIVER_GXB, -- Altera GXB transceiver + --Lattice transceivers + TRANSCEIVER_MGT, -- Lattice transceiver + -- Xilinx transceivers + TRANSCEIVER_GTP_DUAL, TRANSCEIVER_GTPE1, TRANSCEIVER_GTPE2, -- Xilinx GTP transceivers + TRANSCEIVER_GTX, TRANSCEIVER_GTXE1, TRANSCEIVER_GTXE2, -- Xilinx GTX transceivers + TRANSCEIVER_GTH, TRANSCEIVER_GTHE1, TRANSCEIVER_GTHE2, -- Xilinx GTH transceivers + TRANSCEIVER_GTZ, -- Xilinx GTZ transceivers + TRANSCEIVER_GTY -- Xilinx GTY transceivers + ); + + -- Properties of an FPGA architecture + -- =========================================================================== + type T_DEVICE_INFO is record + Vendor : T_VENDOR; + Device : T_DEVICE; + DevFamily : T_DEVICE_FAMILY; + DevGeneration : natural; + DevNumber : natural; + DevSubType : T_DEVICE_SUBTYPE; + DevSeries : T_DEVICE_SERIES; + + TransceiverType : T_TRANSCEIVER; + LUT_FanIn : positive; + end record; + + -- Functions extracting board and PCB properties from "MY_BOARD" + -- which is declared in package "my_config". + -- =========================================================================== + function BOARD(BoardConfig : string := C_BOARD_STRING_EMPTY) return natural; + function BOARD_INFO(BoardConfig : string := C_BOARD_STRING_EMPTY) return T_BOARD_INFO; + function BOARD_NAME(BoardConfig : string := C_BOARD_STRING_EMPTY) return string; + function BOARD_DEVICE(BoardConfig : string := C_BOARD_STRING_EMPTY) return string; + function BOARD_UART_BAUDRATE(BoardConfig : string := C_BOARD_STRING_EMPTY) return string; + + -- Functions extracting device and architecture properties from "MY_DEVICE" + -- which is declared in package "my_config". + -- =========================================================================== + function VENDOR(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_VENDOR; + function SYNTHESIS_TOOL(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_SYNTHESIS_TOOL; + function DEVICE(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE; + function DEVICE_FAMILY(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_FAMILY; + function DEVICE_SUBTYPE(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_SUBTYPE; + function DEVICE_SERIES(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_SERIES; + function DEVICE_GENERATION(DeviceString : string := C_DEVICE_STRING_EMPTY) return natural; + function DEVICE_NUMBER(DeviceString : string := C_DEVICE_STRING_EMPTY) return natural; + + function TRANSCEIVER_TYPE(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_TRANSCEIVER; + function LUT_FANIN(DeviceString : string := C_DEVICE_STRING_EMPTY) return positive; + + function DEVICE_INFO(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_INFO; + + -- Convert T_DEVICE to string representation as required by "altera_mf" library + -- =========================================================================== + function getAlteraDeviceName (device : T_DEVICE) return string; + + -- force FSM to predefined encoding in debug mode + -- =========================================================================== + function getFSMEncoding_gray(debug : boolean) return string; +end package; + + +package body config is + -- inlined function from PoC.utils, to break dependency + -- =========================================================================== + function ite(cond : boolean; value1 : string; value2 : string) return string is begin + if cond then return value1; else return value2; end if; + end function; + + -- chr_is* function + function chr_isDigit(chr : character) return boolean is + begin + return ((character'pos('0') <= CHARACTER'pos(chr)) and (character'pos(chr) <= CHARACTER'pos('9'))); + end function; + + function chr_isAlpha(chr : character) return boolean is + begin + return (((character'pos('a') <= CHARACTER'pos(chr)) and (character'pos(chr) <= CHARACTER'pos('z'))) or + ((character'pos('A') <= CHARACTER'pos(chr)) and (character'pos(chr) <= CHARACTER'pos('Z')))); + end function; + + function str_length(str : string) return natural is + begin + for i in str'range loop + if str(i) = C_POC_NUL then + return i - str'low; + end if; + end loop; + return str'length; + end function; + + function str_trim(str : string) return string is + begin + for i in str'range loop + if str(i) = C_POC_NUL then + return str(str'low to i-1); + end if; + end loop; + return str; + end function; + + function str_imatch(str1 : string; str2 : string) return boolean is + constant len : natural := imin(str1'length, str2'length); + variable chr1 : character; + variable chr2 : character; + begin + -- if both strings are empty + if ((str1'length = 0 ) and (str2'length = 0)) then return TRUE; end if; + -- compare char by char + for i in 0 to len-1 loop + chr1 := str1(str1'low + i); + chr2 := str2(str2'low + i); + if (character'pos('A') <= CHARACTER'pos(chr1)) and (character'pos(chr1) <= CHARACTER'pos('Z')) then + chr1 := character'val(CHARACTER'pos(chr1) - character'pos('A') + CHARACTER'pos('a')); + end if; + if (character'pos('A') <= CHARACTER'pos(chr2)) and (character'pos(chr2) <= CHARACTER'pos('Z')) then + chr2 := character'val(CHARACTER'pos(chr2) - character'pos('A') + CHARACTER'pos('a')); + end if; + if chr1 /= chr2 then + return FALSE; + elsif (chr1 = C_POC_NUL) xor (chr2 = C_POC_NUL) then + return FALSE; + elsif (chr1 = C_POC_NUL) and (chr2 = C_POC_NUL) then + return TRUE; + end if; + end loop; + -- check special cases, + if ((str1'length = len) and (str2'length = len)) then -- both strings are fully consumed and equal + return TRUE; + elsif (str1'length > len) then + return (str1(str1'low + len) = C_POC_NUL); -- str1 is longer, but str_length equals len + else + return (str2(str2'low + len) = C_POC_NUL); -- str2 is longer, but str_length equals len + end if; + end function; + + function str_find(str : string; pattern : string; start : natural := 0) return boolean is + begin + for i in imax(str'low, start) to (str'high - pattern'length + 1) loop + exit when (str(i) = C_POC_NUL); + if (str(i to i + pattern'length - 1) = pattern) then + return TRUE; + end if; + end loop; + return FALSE; + end function; + + -- private functions required by board description + -- ModelSim requires that this functions is defined before it is used below. + -- =========================================================================== + function getLocalDeviceString(DeviceString : string) return string is + constant ConstNUL : string(1 to 1) := (others => C_POC_NUL); + constant MY_DEVICE_STR : string := BOARD_DEVICE; + variable Result : string(1 to T_DEVICE_STRING'length); + begin + Result := (others => C_POC_NUL); + -- report DeviceString for debugging + if POC_VERBOSE then + report "getLocalDeviceString: DeviceString='" & str_trim(DeviceString) & "' MY_DEVICE='" & str_trim(MY_DEVICE) & "' MY_DEVICE_STR='" & str_trim(MY_DEVICE_STR) & "'" severity NOTE; + end if; + -- if DeviceString is populated + if (str_length(DeviceString) /= 0) and not str_imatch(DeviceString, "None") then + Result(1 to bound(T_DEVICE_STRING'length, 1, DeviceString'length)) := ite((DeviceString'length > 0), DeviceString(1 to imin(T_DEVICE_STRING'length, DeviceString'length)), ConstNUL); + -- if MY_DEVICE is set, prefer it + elsif (str_length(MY_DEVICE) /= 0) and not str_imatch(MY_DEVICE, "None") then + Result(1 to bound(T_DEVICE_STRING'length, 1, MY_DEVICE'length)) := ite((MY_DEVICE'length > 0), MY_DEVICE(1 to imin(T_DEVICE_STRING'length, MY_DEVICE'length)), ConstNUL); + -- otherwise use MY_BOARD + else + Result(1 to bound(T_DEVICE_STRING'length, 1, MY_DEVICE_STR'length)) := ite((MY_DEVICE_STR'length > 0), MY_DEVICE_STR(1 to imin(T_DEVICE_STRING'length, MY_DEVICE_STR'length)), ConstNUL); + end if; + return Result; + end function; + + function extractFirstNumber(str : string) return natural is + variable low : integer; + variable high : integer; + variable Result : natural; + variable Digit : integer; + begin + low := -1; + high := -1; + for i in str'low to str'high loop + if chr_isDigit(str(i)) then + low := i; + exit; + end if; + end loop; + -- abort if no digit can be found + if low = -1 then return 0; end if; + + for i in (low + 1) to str'high loop + if chr_isAlpha(str(i)) then + high := i - 1; + exit; + end if; + end loop; + + if high = -1 then return 0; end if; + -- return INTEGER'value(str(low to high)); -- 'value(...) is not supported by Vivado Synth 2014.1 + + -- convert substring to a number + for i in low to high loop + if not chr_isDigit(str(i)) then + return 0; + end if; + Result := (Result * 10) + (character'pos(str(i)) - character'pos('0')); + end loop; + return Result; + end function; + + -- Public functions + -- =========================================================================== + -- TODO: comment + function BOARD(BoardConfig : string := C_BOARD_STRING_EMPTY) return natural is + constant MY_BRD : T_BOARD_CONFIG_STRING := ite((BoardConfig /= C_BOARD_STRING_EMPTY), conf(BoardConfig), conf(MY_BOARD)); + constant BOARD_NAME : string := str_trim(MY_BRD); + begin + if POC_VERBOSE then report "PoC configuration: Used board is '" & BOARD_NAME & "'" severity NOTE; end if; + for i in C_BOARD_INFO_LIST'range loop + if str_imatch(BOARD_NAME, C_BOARD_INFO_LIST(i).BoardName) then + return i; + end if; + end loop; + + report "Unknown board name in MY_BOARD = " & MY_BRD & "." severity failure; + return C_BOARD_INFO_LIST'high; + end function; + + function BOARD_INFO(BoardConfig : string := C_BOARD_STRING_EMPTY) return T_BOARD_INFO is + constant BRD : natural := BOARD(BoardConfig); + begin + return C_BOARD_INFO_LIST(BRD); + end function; + + -- TODO: comment + function BOARD_NAME(BoardConfig : string := C_BOARD_STRING_EMPTY) return string is + constant BRD : natural := BOARD(BoardConfig); + begin + return str_trim(C_BOARD_INFO_LIST(BRD).BoardName); + end function; + + -- TODO: comment + function BOARD_DEVICE(BoardConfig : string := C_BOARD_STRING_EMPTY) return string is + constant BRD : natural := BOARD(BoardConfig); + begin + return str_trim(C_BOARD_INFO_LIST(BRD).FPGADevice); + end function; + + function BOARD_UART_BAUDRATE(BoardConfig : string := C_BOARD_STRING_EMPTY) return string is + constant BRD : natural := BOARD(BoardConfig); + begin + return str_trim(C_BOARD_INFO_LIST(BRD).UART.BaudRate); + end function; + + -- purpose: extract vendor from MY_DEVICE + function VENDOR(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_VENDOR is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant VEN_STR2 : string(1 to 2) := MY_DEV(1 to 2); -- TODO: test if alias declarations also work out on all platforms + constant VEN_STR3 : string(1 to 3) := MY_DEV(1 to 3); -- TODO: test if alias declarations also work out on all platforms + begin + case VEN_STR2 is + when "GE" => return VENDOR_GENERIC; + when "EP" => return VENDOR_ALTERA; + when "XC" => return VENDOR_XILINX; + when others => null; + end case; + case VEN_STR3 is + when "iCE" => return VENDOR_LATTICE; -- iCE devices + when "LCM" => return VENDOR_LATTICE; -- MachXO device + when "LFE" => return VENDOR_LATTICE; -- ECP devices + when others => report "Unknown vendor in MY_DEVICE = '" & MY_DEV & "'" severity failure; + return VENDOR_UNKNOWN; + end case; + end function; + + function SYNTHESIS_TOOL(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_SYNTHESIS_TOOL is + constant VEN : T_VENDOR := VENDOR(DeviceString); + begin + case VEN is + when VENDOR_GENERIC => + return SYNTHESIS_TOOL_GENERIC; + when VENDOR_ALTERA => + return SYNTHESIS_TOOL_ALTERA_QUARTUS2; + when VENDOR_LATTICE => + return SYNTHESIS_TOOL_LATTICE_LSE; + --return SYNTHESIS_TOOL_SYNOPSIS; + when VENDOR_XILINX => + if (1 fs /= 1 us) then + return SYNTHESIS_TOOL_XILINX_XST; + else + return SYNTHESIS_TOOL_XILINX_VIVADO; + end if; + when others => + return SYNTHESIS_TOOL_UNKNOWN; + end case; + end function; + + -- purpose: extract device from MY_DEVICE + function DEVICE(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant VEN : T_VENDOR := VENDOR(DeviceString); + constant DEV_STR : string(3 to 4) := MY_DEV(3 to 4); -- TODO: test if alias declarations also work out on all platforms + begin + case VEN is + when VENDOR_GENERIC => + if (MY_DEV(1 to 7) = "GENERIC") then return DEVICE_GENERIC; + else report "Unknown Generic device in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + when VENDOR_ALTERA => + case DEV_STR is + when "1C" => return DEVICE_CYCLONE1; + when "2C" => return DEVICE_CYCLONE2; + when "3C" => return DEVICE_CYCLONE3; + when "1S" => return DEVICE_STRATIX1; + when "2S" => return DEVICE_STRATIX2; + when "4S" => return DEVICE_STRATIX4; + when "5S" => return DEVICE_STRATIX5; + when others => report "Unknown Altera device in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end case; + + when VENDOR_LATTICE => + if (MY_DEV(1 to 6) = "LCMX02") then return DEVICE_MACHXO2; + elsif (MY_DEV(1 to 5) = "LCMX0") then return DEVICE_MACHXO; + elsif (MY_DEV(1 to 5) = "iCE40") then return DEVICE_ICE40; + elsif (MY_DEV(1 to 5) = "iCE65") then return DEVICE_ICE65; + elsif (MY_DEV(1 to 4) = "iCE5") then return DEVICE_ICE5; + elsif (MY_DEV(1 to 4) = "LFE3") then return DEVICE_ECP3; + elsif (MY_DEV(1 to 4) = "LFE4") then return DEVICE_ECP4; + elsif (MY_DEV(1 to 4) = "LFE5") then return DEVICE_ECP5; + else report "Unknown Lattice device in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when VENDOR_XILINX => + case DEV_STR is + when "7A" => return DEVICE_ARTIX7; + when "7K" => return DEVICE_KINTEX7; + when "KU" => return DEVICE_KINTEX_ULTRA; + when "3S" => return DEVICE_SPARTAN3; + when "6S" => return DEVICE_SPARTAN6; + when "4V" => return DEVICE_VIRTEX4; + when "5V" => return DEVICE_VIRTEX5; + when "6V" => return DEVICE_VIRTEX6; + when "7V" => return DEVICE_VIRTEX7; + when "VU" => return DEVICE_VIRTEX_ULTRA; + when "7Z" => return DEVICE_ZYNQ7; + when others => report "Unknown Xilinx device in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end case; + + when others => report "Unknown vendor in MY_DEVICE = " & MY_DEV & "." severity failure; + end case; + return DEVICE_UNKNOWN; + end function; + + -- purpose: extract device from MY_DEVICE + function DEVICE_FAMILY(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_FAMILY is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant VEN : T_VENDOR := VENDOR(DeviceString); + constant FAM_CHAR : character := MY_DEV(4); + begin + case VEN is + when VENDOR_GENERIC => + return DEVICE_FAMILY_GENERIC; + when VENDOR_ALTERA => + case FAM_CHAR is + when 'C' => return DEVICE_FAMILY_CYCLONE; + when 'S' => return DEVICE_FAMILY_STRATIX; + when others => report "Unknown Altera device family in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end case; + + when VENDOR_LATTICE => + case FAM_CHAR is + --when 'M' => return DEVICE_FAMILY_MACHXO; + when 'E' => return DEVICE_FAMILY_ECP; + when others => report "Unknown Lattice device family in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end case; + + when VENDOR_XILINX => + case FAM_CHAR is + when 'A' => return DEVICE_FAMILY_ARTIX; + when 'K' => return DEVICE_FAMILY_KINTEX; + when 'S' => return DEVICE_FAMILY_SPARTAN; + when 'V' => return DEVICE_FAMILY_VIRTEX; + when 'Z' => return DEVICE_FAMILY_ZYNQ; + when others => report "Unknown Xilinx device family in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end case; + + when others => report "Unknown vendor in MY_DEVICE = '" & MY_DEV & "'" severity failure; + end case; + return DEVICE_FAMILY_UNKNOWN; + end function; + + -- some devices share some common features: e.g. XADC, BlockRAM, ... + function DEVICE_SERIES(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_SERIES is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant DEV : T_DEVICE := DEVICE(DeviceString); + begin + case DEV is + when DEVICE_GENERIC => + return DEVICE_SERIES_GENERIC; + -- all Xilinx ****7 devices + when DEVICE_ARTIX7 | DEVICE_KINTEX7 | DEVICE_VIRTEX7 | DEVICE_ZYNQ7 => + return DEVICE_SERIES_7_SERIES; + -- all Xilinx ****UltraScale devices + when DEVICE_KINTEX_ULTRA | DEVICE_VIRTEX_ULTRA => + return DEVICE_SERIES_ULTRASCALE; + -- all Xilinx ****UltraScale+ devices + when DEVICE_KINTEX_ULTRA_PLUS | DEVICE_VIRTEX_ULTRA_PLUS | DEVICE_ZYNQ_ULTRA_PLUS => + return DEVICE_SERIES_ULTRASCALE_PLUS; + when others => + return DEVICE_SERIES_UNKNOWN; + end case; + end function; + + function DEVICE_GENERATION(DeviceString : string := C_DEVICE_STRING_EMPTY) return natural is + constant SERIES : T_DEVICE_SERIES := DEVICE_SERIES(DeviceString); + begin + if SERIES = DEVICE_SERIES_7_SERIES then + return 7; + else + return 0; + end if; + end function; + + function DEVICE_NUMBER(DeviceString : string := C_DEVICE_STRING_EMPTY) return natural is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant VEN : T_VENDOR := VENDOR(DeviceString); + begin + case VEN is + when VENDOR_GENERIC => return 0; + when VENDOR_ALTERA => return extractFirstNumber(MY_DEV(5 to MY_DEV'high)); + when VENDOR_LATTICE => return extractFirstNumber(MY_DEV(6 to MY_DEV'high)); + when VENDOR_XILINX => return extractFirstNumber(MY_DEV(5 to MY_DEV'high)); + when others => report "Unknown vendor in MY_DEVICE = '" & MY_DEV & "'" severity failure; + return 0; + end case; + end function; + + function DEVICE_SUBTYPE(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_SUBTYPE is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant DEV : T_DEVICE := DEVICE(MY_DEV); + constant DEV_SUB_STR : string(1 to 2) := MY_DEV(5 to 6); -- WORKAROUND: for GHDL + begin + case DEV is + when DEVICE_GENERIC => return DEVICE_SUBTYPE_GENERIC; + -- TODO: extract Arria GX subtype + when DEVICE_ARRIA1 => + report "TODO: parse Arria device subtype." severity failure; + return DEVICE_SUBTYPE_NONE; + -- TODO: extract ArriaII GX,GZ subtype + when DEVICE_ARRIA2 => + report "TODO: parse ArriaII device subtype." severity failure; + return DEVICE_SUBTYPE_NONE; + -- TODO: extract ArriaV GX, GT, SX, GZ subtype + when DEVICE_ARRIA5 => + report "TODO: parse ArriaV device subtype." severity failure; + return DEVICE_SUBTYPE_NONE; + -- TODO: extract Arria10 GX, GT, SX subtype + when DEVICE_ARRIA10 => + report "TODO: parse Arria10 device subtype." severity failure; + return DEVICE_SUBTYPE_NONE; + -- Altera Cyclon I, II, III, IV, V devices have no subtype + when DEVICE_CYCLONE1 | DEVICE_CYCLONE2 | DEVICE_CYCLONE3 | DEVICE_CYCLONE4 | + DEVICE_CYCLONE5 => return DEVICE_SUBTYPE_NONE; + + when DEVICE_STRATIX2 => + if chr_isDigit(DEV_SUB_STR(1)) then return DEVICE_SUBTYPE_NONE; + elsif DEV_SUB_STR = "GX" then return DEVICE_SUBTYPE_GX; + else report "Unknown Stratix II subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_STRATIX4 => + if (DEV_SUB_STR(1) = 'E') then return DEVICE_SUBTYPE_E; + elsif DEV_SUB_STR = "GX" then return DEVICE_SUBTYPE_GX; +-- elsif (DEV_SUB_STR = "GT") then return DEVICE_SUBTYPE_GT; + else report "Unknown Stratix IV subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + -- TODO: extract StratixV subtype + when DEVICE_STRATIX5 => + report "TODO: parse Stratix V device subtype." severity failure; + return DEVICE_SUBTYPE_NONE; + + when DEVICE_ECP5 => + if (DEV_SUB_STR(1) = 'U') then return DEVICE_SUBTYPE_U; + elsif DEV_SUB_STR = "UM" then return DEVICE_SUBTYPE_UM; + else report "Unknown Lattice ECP5 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_SPARTAN3 => + report "TODO: parse Spartan3 / Spartan3E / Spartan3AN device subtype." severity failure; + return DEVICE_SUBTYPE_NONE; + + when DEVICE_SPARTAN6 => + if ((DEV_SUB_STR = "LX") and (not str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_LX; + elsif ((DEV_SUB_STR = "LX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_LXT; + else report "Unknown Virtex-5 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_VIRTEX4 => + report "Unkown Virtex 4" severity failure; + + when DEVICE_VIRTEX5 => + if ((DEV_SUB_STR = "LX") and (not str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_LX; + elsif ((DEV_SUB_STR = "LX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_LXT; + elsif ((DEV_SUB_STR = "SX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_SXT; + elsif ((DEV_SUB_STR = "TX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_TXT; + elsif ((DEV_SUB_STR = "FX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_FXT; + else report "Unknown Virtex-5 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_VIRTEX6 => + if ((DEV_SUB_STR = "LX") and (not str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_LX; + elsif ((DEV_SUB_STR = "LX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_LXT; + elsif ((DEV_SUB_STR = "SX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_SXT; + elsif ((DEV_SUB_STR = "CX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_CXT; + elsif ((DEV_SUB_STR = "HX") and ( str_find(MY_DEV(7 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_HXT; + else report "Unknown Virtex-6 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_ARTIX7 => + if ( ( str_find(MY_DEV(5 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_T; + else report "Unknown Artix-7 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_KINTEX7 => + if ( ( str_find(MY_DEV(5 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_T; + else report "Unknown Kintex-7 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_KINTEX_ULTRA => return DEVICE_SUBTYPE_NONE; + when DEVICE_KINTEX_ULTRA_PLUS => return DEVICE_SUBTYPE_NONE; + + when DEVICE_VIRTEX7 => + if ( ( str_find(MY_DEV(5 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_T; + elsif ((DEV_SUB_STR(1) = 'X') and ( str_find(MY_DEV(6 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_XT; + elsif ((DEV_SUB_STR(1) = 'H') and ( str_find(MY_DEV(6 to MY_DEV'high), "T"))) then return DEVICE_SUBTYPE_HT; + else report "Unknown Virtex-7 subtype: MY_DEVICE = '" & MY_DEV & "'" severity failure; + end if; + + when DEVICE_VIRTEX_ULTRA => return DEVICE_SUBTYPE_NONE; + when DEVICE_VIRTEX_ULTRA_PLUS => return DEVICE_SUBTYPE_NONE; + + when DEVICE_ZYNQ7 => return DEVICE_SUBTYPE_NONE; + when DEVICE_ZYNQ_ULTRA_PLUS => return DEVICE_SUBTYPE_NONE; + + when others => report "Device sub-type is unknown for the given device." severity failure; + end case; + return DEVICE_SUBTYPE_NONE; + end function; + + function LUT_FANIN(DeviceString : string := C_DEVICE_STRING_EMPTY) return positive is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant DEV : T_DEVICE := DEVICE(DeviceString); + constant SERIES : T_DEVICE_SERIES := DEVICE_SERIES(DeviceString); + begin + case SERIES is + when DEVICE_SERIES_GENERIC => return 6; + when DEVICE_SERIES_7_SERIES | DEVICE_SERIES_ULTRASCALE | + DEVICE_SERIES_ULTRASCALE_PLUS => return 6; + when others => null; + end case; + case DEV is + when DEVICE_CYCLONE1 | DEVICE_CYCLONE2 | DEVICE_CYCLONE3 => return 4; + when DEVICE_STRATIX1 | DEVICE_STRATIX2 => return 4; + when DEVICE_STRATIX4 | DEVICE_STRATIX5 => return 6; + + when DEVICE_ECP5 => return 4; + + when DEVICE_SPARTAN3 => return 4; + when DEVICE_SPARTAN6 => return 6; + when DEVICE_VIRTEX4 | DEVICE_VIRTEX5 | DEVICE_VIRTEX6 => return 6; + + when others => report "LUT fan-in is unknown for the given device, using default (4)." severity failure; + return 4; + end case; + end function; + + function TRANSCEIVER_TYPE(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_TRANSCEIVER is + constant MY_DEV : string(1 to 32) := getLocalDeviceString(DeviceString); + constant DEV : T_DEVICE := DEVICE(DeviceString); + constant DEV_NUM : natural := DEVICE_NUMBER(DeviceString); + constant DEV_SUB : T_DEVICE_SUBTYPE := DEVICE_SUBTYPE(DeviceString); + begin + case DEV is + when DEVICE_GENERIC => return TRANSCEIVER_GENERIC; + when DEVICE_MAX2 | DEVICE_MAX10 => return TRANSCEIVER_NONE; -- Altera MAX II, 10 devices have no transceivers + when DEVICE_CYCLONE1 | DEVICE_CYCLONE2 | DEVICE_CYCLONE3 => return TRANSCEIVER_NONE; -- Altera Cyclon I, II, III devices have no transceivers + + when DEVICE_STRATIX2 => return TRANSCEIVER_GXB; + when DEVICE_STRATIX4 => return TRANSCEIVER_GXB; + --when DEVICE_STRATIX5 => return TRANSCEIVER_GXB; + + when DEVICE_ECP5 => return TRANSCEIVER_MGT; + + when DEVICE_SPARTAN3 => return TRANSCEIVER_NONE; -- Xilinx Spartan3 devices have no transceivers + when DEVICE_SPARTAN6 => + case DEV_SUB is + when DEVICE_SUBTYPE_LX => return TRANSCEIVER_NONE; + when DEVICE_SUBTYPE_LXT => return TRANSCEIVER_GTPE1; + when others => report "Unknown Spartan-6 subtype: " & T_DEVICE_SUBTYPE'image(DEV_SUB) severity failure; + end case; + + when DEVICE_VIRTEX4 => + report "Unknown Virtex-4" severity failure; + + when DEVICE_VIRTEX5 => + case DEV_SUB is + when DEVICE_SUBTYPE_LX => return TRANSCEIVER_NONE; + when DEVICE_SUBTYPE_SXT => return TRANSCEIVER_GTP_DUAL; + when DEVICE_SUBTYPE_LXT => return TRANSCEIVER_GTP_DUAL; + when DEVICE_SUBTYPE_TXT => return TRANSCEIVER_GTX; + when DEVICE_SUBTYPE_FXT => return TRANSCEIVER_GTX; + when others => report "Unknown Virtex-5 subtype: " & T_DEVICE_SUBTYPE'image(DEV_SUB) severity failure; + end case; + + when DEVICE_VIRTEX6 => + case DEV_SUB is + when DEVICE_SUBTYPE_LX => return TRANSCEIVER_NONE; + when DEVICE_SUBTYPE_SXT => return TRANSCEIVER_GTXE1; + when DEVICE_SUBTYPE_LXT => return TRANSCEIVER_GTXE1; + when DEVICE_SUBTYPE_HXT => return TRANSCEIVER_GTXE1; + when others => report "Unknown Virtex-6 subtype: " & T_DEVICE_SUBTYPE'image(DEV_SUB) severity failure; + end case; + + when DEVICE_ARTIX7 => return TRANSCEIVER_GTPE2; + when DEVICE_KINTEX7 => return TRANSCEIVER_GTXE2; + when DEVICE_VIRTEX7 => + case DEV_SUB is + when DEVICE_SUBTYPE_T => return TRANSCEIVER_GTXE2; + when DEVICE_SUBTYPE_XT => + if DEV_NUM = 485 then return TRANSCEIVER_GTXE2; + else return TRANSCEIVER_GTHE2; + end if; + when DEVICE_SUBTYPE_HT => return TRANSCEIVER_GTHE2; + when others => report "Unknown Virtex-7 subtype: " & T_DEVICE_SUBTYPE'image(DEV_SUB) severity failure; + end case; + when DEVICE_ZYNQ7 => + case DEV_NUM is + when 10 | 20 => return TRANSCEIVER_NONE; + when 15 => return TRANSCEIVER_GTPE2; + when others => return TRANSCEIVER_GTXE2; + end case; + + when others => report "Unknown device." severity failure; + end case; + return TRANSCEIVER_NONE; + end function; + + -- purpose: extract architecture properties from DEVICE + function DEVICE_INFO(DeviceString : string := C_DEVICE_STRING_EMPTY) return T_DEVICE_INFO is + variable Result : T_DEVICE_INFO; + begin + Result.Vendor := VENDOR(DeviceString); + Result.Device := DEVICE(DeviceString); + Result.DevFamily := DEVICE_FAMILY(DeviceString); + Result.DevSubType := DEVICE_SUBTYPE(DeviceString); + Result.DevSeries := DEVICE_SERIES(DeviceString); + Result.DevGeneration := DEVICE_GENERATION(DeviceString); + Result.DevNumber := DEVICE_NUMBER(DeviceString); + Result.TransceiverType := TRANSCEIVER_TYPE(DeviceString); + Result.LUT_FanIn := LUT_FANIN(DeviceString); + + return Result; + end function; + + + -- Convert T_DEVICE to string representation as required by "altera_mf" library + function getAlteraDeviceName (device : T_DEVICE) return string is + begin + case device is + when DEVICE_ARRIA1 => return "Arria"; + when DEVICE_ARRIA2 => return "Arria II"; + when DEVICE_ARRIA5 => return "Arria V"; + when DEVICE_ARRIA10 => return "Arria 10"; + when DEVICE_CYCLONE1 => return "Cyclone"; + when DEVICE_CYCLONE2 => return "Cyclone II"; + when DEVICE_CYCLONE3 => return "Cyclone III"; + when DEVICE_CYCLONE4 => return "Cyclone IV"; + when DEVICE_CYCLONE5 => return "Cyclone V"; + when DEVICE_STRATIX1 => return "Stratix"; + when DEVICE_STRATIX2 => return "Stratix II"; + when DEVICE_STRATIX3 => return "Stratix III"; + when DEVICE_STRATIX4 => return "Stratix IV"; + when DEVICE_STRATIX5 => return "Stratix V"; + when DEVICE_STRATIX10 => return "Stratix 10"; + when others => + report "Unknown Altera device." severity failure; + return ""; + end case; + end function; + + -- force FSM to predefined encoding in debug mode + function getFSMEncoding_gray(debug : boolean) return string is + begin + if debug then + return "gray"; + else + case VENDOR is + when VENDOR_ALTERA => return "default"; + --when VENDOR_LATTICE => return "default"; + when VENDOR_XILINX => return "auto"; + when others => report "Unknown vendor." severity failure; + return ""; + end case; + end if; + end function; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/fileio.v08.vhdl b/testsuite/gna/issue317/PoC/src/common/fileio.v08.vhdl new file mode 100644 index 000000000..999d73da5 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/fileio.v08.vhdl @@ -0,0 +1,255 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Package: File I/O-related Functions. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany, +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +use STD.TextIO.all; + +library PoC; +use PoC.my_project.all; +use PoC.utils.all; +use PoC.strings.all; +use PoC.ProtectedTypes.all; + + +package FileIO is + subtype T_LOGFILE_OPEN_KIND is FILE_OPEN_KIND range WRITE_MODE to APPEND_MODE; + + -- Constant declarations + constant C_LINEBREAK : string; + + -- =========================================================================== + type T_LOGFILE is protected + procedure OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE); + impure function OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS; + procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE); + impure function IsOpen return boolean; + procedure CloseFile; + + procedure Print(str : string); + procedure PrintLine(str : string := ""); + procedure Flush; + -- procedure WriteLine(LineBuffer : inout LINE); + end protected; + + -- =========================================================================== + type T_FILE is protected + procedure OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE); + impure function OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS; + procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE); + impure function IsOpen return boolean; + procedure CloseFile; + + procedure Print(str : string); + procedure PrintLine(str : string := ""); + procedure Flush; + -- procedure WriteLine(LineBuffer : inout LINE); + end protected; + + type T_STDOUT is protected + procedure Print(str : string); + procedure PrintLine(str : string := ""); + procedure Flush; + end protected; +end package; + + +package body FileIO is + constant C_LINEBREAK : string := ite(str_equal(MY_OPERATING_SYSTEM, "WINDOWS"), (CR & LF), (1 => LF)); + + -- =========================================================================== + file Global_LogFile : TEXT; + -- shared variable LogFile_IsOpen : P_BOOLEAN; + -- shared variable LogFile : T_LOGFILE; + -- shared variable StdOut : T_STDOUT; + -- shared variable LogFile_IsMirrored : P_BOOLEAN; + + -- =========================================================================== + type T_LOGFILE is protected body + variable LineBuffer : LINE; + variable Local_IsOpen : boolean; + variable Local_FileName : string(1 to 256); + + procedure OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) is + variable Status : FILE_OPEN_STATUS; + begin + OpenFile(Status, FileName, OpenKind); + end procedure; + + impure function OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS is + variable Status : FILE_OPEN_STATUS; + begin + OpenFile(Status, FileName, OpenKind); + return Status; + end function; + + procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) is + variable Status_i : FILE_OPEN_STATUS; + begin + if not Local_IsOpen then + file_open(Status_i, Global_LogFile, FileName, OpenKind); + Local_IsOpen := Status_i = OPEN_OK; + Local_FileName := resize(FileName, Local_FileName'length); + Status := Status_i; + else + report "Global log file '" & str_trim(Local_FileName) & "' is already open." severity ERROR; + end if; + end procedure; + + impure function IsOpen return boolean is + begin + return Local_IsOpen; + end function; + + procedure CloseFile is + begin + if Local_IsOpen then + file_close(Global_LogFile); + Local_IsOpen := FALSE; + end if; + end procedure; + + procedure WriteLine(LineBuffer : inout LINE) is + begin + if not Local_IsOpen then + writeline(OUTPUT, LineBuffer); + -- elsif (LogFile_IsMirrored.Get = TRUE) then + -- tee(Global_LogFile, LineBuffer); + else + writeline(Global_LogFile, LineBuffer); + end if ; + end procedure; + + procedure Print(str : string) is + begin + write(LineBuffer, str); + end procedure; + + procedure PrintLine(str : string := "") is + begin + write(LineBuffer, str); + WriteLine(LineBuffer); + end procedure; + + procedure Flush is + begin + WriteLine(LineBuffer); + end procedure; + end protected body; + + type T_FILE is protected body + file LocalFile : TEXT; + variable LineBuffer : LINE; + variable Local_IsOpen : boolean; + variable Local_FileName : string(1 to 256); + + procedure OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) is + variable Status : FILE_OPEN_STATUS; + begin + OpenFile(Status, FileName, OpenKind); + end procedure; + + impure function OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS is + variable Status : FILE_OPEN_STATUS; + begin + OpenFile(Status, FileName, OpenKind); + return Status; + end function; + + impure function IsOpen return boolean is + begin + return Local_IsOpen; + end function; + + procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) is + variable Status_i : FILE_OPEN_STATUS; + begin + if not Local_IsOpen then + file_open(Status_i, LocalFile, FileName, OpenKind); + Local_IsOpen := Status_i = OPEN_OK; + Local_FileName := resize(FileName, Local_FileName'length); + Status := Status_i; + else + report "File '" & str_trim(Local_FileName) & "' is already open." severity ERROR; + end if; + end procedure; + + procedure CloseFile is + begin + if Local_IsOpen then + file_close(LocalFile); + Local_IsOpen := FALSE; + end if; + end procedure; + + procedure WriteLine(LineBuffer : inout LINE) is + begin + if not Local_IsOpen then + report "File is not open." severity ERROR; + else + writeline(LocalFile, LineBuffer); + end if ; + end procedure; + + procedure Print(str : string) is + begin + write(LineBuffer, str); + end procedure; + + procedure PrintLine(str : string := "") is + begin + write(LineBuffer, str); + WriteLine(LineBuffer); + end procedure; + + procedure Flush is + begin + WriteLine(LineBuffer); + end procedure; + end protected body; + + type T_STDOUT is protected body + variable LineBuffer : LINE; + + procedure Print(str : string) is + begin + write(LineBuffer, str); + end procedure; + + procedure PrintLine(str : string := "") is + begin + write(LineBuffer, str); + writeline(OUTPUT, LineBuffer); + end procedure; + + procedure Flush is + begin + writeline(OUTPUT, LineBuffer); + end procedure; + end protected body; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/math.vhdl b/testsuite/gna/issue317/PoC/src/common/math.vhdl new file mode 100644 index 000000000..2b366418e --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/math.vhdl @@ -0,0 +1,105 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Package: Math extension package. +-- +-- Description: +-- ------------------------------------- +-- This package provides additional math functions. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2015 Technische Universitaet Dresden - Germany, +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; + +library PoC; +use PoC.utils.all; + + +package math is + -- figurate numbers + function squareNumber(N : natural) return natural; + function cubicNumber(N : natural) return natural; + function triangularNumber(N : natural) return natural; + + -- coefficients + -- binomial coefficient (N choose K) + function binomialCoefficient(N : positive; K : positive) return positive; + + -- greatest common divisor (gcd) + function greatestCommonDivisor(N1 : positive; N2 : positive) return positive; + -- least common multiple (lcm) + function leastCommonMultiple(N1 : positive; N2 : positive) return positive; +end package; + +package body math is + -- figurate numbers + function squareNumber(N : natural) return natural is + begin + return N*N; + end function; + + function cubicNumber(N : natural) return natural is + begin + return N*N*N; + end function; + + function triangularNumber(N : natural) return natural is + variable T : natural; + begin + return (N * (N + 1) / 2); + end function; + + -- coefficients + function binomialCoefficient(N : positive; K : positive) return positive is + variable Result : positive; + begin + Result := 1; + for i in 1 to K loop + Result := Result * (((N + 1) - i) / i); + end loop; + return Result; + end function; + + -- greatest common divisor (gcd) + function greatestCommonDivisor(N1 : positive; N2 : positive) return positive is + variable M1 : positive; + variable M2 : natural; + variable Remainer : natural; + begin + M1 := imax(N1, N2); + M2 := imin(N1, N2); + while M2 /= 0 loop + Remainer := M1 mod M2; + M1 := M2; + M2 := Remainer; + end loop; + return M1; + end function; + + -- least common multiple (lcm) + function leastCommonMultiple(N1 : positive; N2 : positive) return positive is + begin + return ((N1 * N2) / greatestCommonDivisor(N1, N2)); + end function; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/physical.vhdl b/testsuite/gna/issue317/PoC/src/common/physical.vhdl new file mode 100644 index 000000000..b8b07d7e6 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/physical.vhdl @@ -0,0 +1,1039 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- Martin Zabel +-- Thomas B. Preusser +-- +-- Package: This VHDL package declares new physical types and their +-- conversion functions. +-- +-- Description: +-- ------------------------------------- +-- For detailed documentation see below. +-- +-- NAMING CONVENTION: +-- t - time +-- p - period +-- d - delay +-- f - frequency +-- br - baud rate +-- vec - vector +-- +-- ATTENTION: +-- This package is not supported by Xilinx Synthese Tools prior to 14.7! +-- +-- It was successfully tested with: +-- - Xilinx Synthesis Tool (XST) 14.7 and Xilinx ISE Simulator (iSim) 14.7 +-- - Quartus II 13.1 +-- - QuestaSim 10.0d +-- - GHDL 0.31 +-- +-- Tool chains with known issues: +-- - Xilinx Vivado Synthesis 2014.4 +-- +-- Untested tool chains +-- - Xilinx Vivado Simulator (xSim) 2014.4 +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2015 Technische Universitaet Dresden - Germany, +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.math_real.all; + +library PoC; +use PoC.config.all; +use PoC.utils.all; +use PoC.strings.all; + + +package physical is + + type FREQ is range 0 to integer'high units + Hz; + kHz = 1000 Hz; + MHz = 1000 kHz; + GHz = 1000 MHz; + end units; + + type BAUD is range 0 to integer'high units + Bd; + kBd = 1000 Bd; + MBd = 1000 kBd; + GBd = 1000 MBd; + end units; + + type MEMORY is range 0 to integer'high units + Byte; + KiB = 1024 Byte; + MiB = 1024 KiB; + GiB = 1024 MiB; + end units; + + -- vector data types + type T_TIMEVEC is array(natural range <>) of time; + type T_FREQVEC is array(natural range <>) of FREQ; + type T_BAUDVEC is array(natural range <>) of BAUD; + type T_MEMVEC is array(natural range <>) of MEMORY; + + -- if true: TimingToCycles reports difference between expected and actual result + constant C_PHYSICAL_REPORT_TIMING_DEVIATION : boolean := TRUE; + + -- conversion functions + function to_time(f : FREQ) return time; + function to_freq(p : time) return FREQ; + function to_freq(br : BAUD) return FREQ; + function to_baud(str : string) return BAUD; + + -- inter-type arithmetic + function div(a : time; b : time) return real; + function div(a : FREQ; b : FREQ) return real; + + function "/"(x : real; t : time) return FREQ; + function "/"(x : real; f : FREQ) return time; + function "*"(t : time; f : FREQ) return real; + function "*"(f : FREQ; t : time) return real; + + -- if-then-else + function ite(cond : boolean; value1 : time; value2 : time) return time; + function ite(cond : boolean; value1 : FREQ; value2 : FREQ) return FREQ; + function ite(cond : boolean; value1 : BAUD; value2 : BAUD) return BAUD; + function ite(cond : boolean; value1 : MEMORY; value2 : MEMORY) return MEMORY; + + -- min/ max for 2 arguments + function tmin(arg1 : time; arg2 : time) return time; -- Calculates: min(arg1, arg2) for times + function fmin(arg1 : FREQ; arg2 : FREQ) return FREQ; -- Calculates: min(arg1, arg2) for frequencies + function bmin(arg1 : BAUD; arg2 : BAUD) return BAUD; -- Calculates: min(arg1, arg2) for symbols per second + function mmin(arg1 : MEMORY; arg2 : MEMORY) return MEMORY; -- Calculates: min(arg1, arg2) for memory + + function tmax(arg1 : time; arg2 : time) return time; -- Calculates: max(arg1, arg2) for times + function fmax(arg1 : FREQ; arg2 : FREQ) return FREQ; -- Calculates: max(arg1, arg2) for frequencies + function bmax(arg1 : BAUD; arg2 : BAUD) return BAUD; -- Calculates: max(arg1, arg2) for symbols per second + function mmax(arg1 : MEMORY; arg2 : MEMORY) return MEMORY; -- Calculates: max(arg1, arg2) for memory + + -- min/max/sum as vector aggregation + function tmin(vec : T_TIMEVEC) return time; -- Calculates: min(vec) for a time vector + function fmin(vec : T_FREQVEC) return FREQ; -- Calculates: min(vec) for a frequency vector + function bmin(vec : T_BAUDVEC) return BAUD; -- Calculates: min(vec) for a baud vector + function mmin(vec : T_MEMVEC) return MEMORY; -- Calculates: min(vec) for a memory vector + + function tmax(vec : T_TIMEVEC) return time; -- Calculates: max(vec) for a time vector + function fmax(vec : T_FREQVEC) return FREQ; -- Calculates: max(vec) for a frequency vector + function bmax(vec : T_BAUDVEC) return BAUD; -- Calculates: max(vec) for a baud vector + function mmax(vec : T_MEMVEC) return MEMORY; -- Calculates: max(vec) for a memory vector + + function tsum(vec : T_TIMEVEC) return time; -- Calculates: sum(vec) for a time vector + function fsum(vec : T_FREQVEC) return FREQ; -- Calculates: sum(vec) for a frequency vector + function bsum(vec : T_BAUDVEC) return BAUD; -- Calculates: sum(vec) for a baud vector + function msum(vec : T_MEMVEC) return MEMORY; -- Calculates: sum(vec) for a memory vector + + -- convert standard types (NATURAL, REAL) to time (TIME) + function fs2Time(t_fs : integer) return time; + function ps2Time(t_ps : integer) return time; + function ns2Time(t_ns : integer) return time; + function us2Time(t_us : integer) return time; + function ms2Time(t_ms : integer) return time; + function sec2Time(t_sec : integer) return time; + + function fs2Time(t_fs : REAL) return time; + function ps2Time(t_ps : REAL) return time; + function ns2Time(t_ns : REAL) return time; + function us2Time(t_us : REAL) return time; + function ms2Time(t_ms : REAL) return time; + function sec2Time(t_sec : REAL) return time; + + -- convert standard types (NATURAL, REAL) to period (TIME) + function Hz2Time(f_Hz : natural) return time; + function kHz2Time(f_kHz : natural) return time; + function MHz2Time(f_MHz : natural) return time; + function GHz2Time(f_GHz : natural) return time; + + function Hz2Time(f_Hz : REAL) return time; + function kHz2Time(f_kHz : REAL) return time; + function MHz2Time(f_MHz : REAL) return time; + function GHz2Time(f_GHz : REAL) return time; + + -- convert standard types (NATURAL, REAL) to frequency (FREQ) + function Hz2Freq(f_Hz : natural) return FREQ; + function kHz2Freq(f_kHz : natural) return FREQ; + function MHz2Freq(f_MHz : natural) return FREQ; + function GHz2Freq(f_GHz : natural) return FREQ; + + function Hz2Freq(f_Hz : REAL) return FREQ; + function kHz2Freq(f_kHz : REAL) return FREQ; + function MHz2Freq(f_MHz : REAL) return FREQ; + function GHz2Freq(f_GHz : REAL) return FREQ; + + -- convert physical types to standard type (REAL) + function to_real(t : time; scale : time) return REAL; + function to_real(f : FREQ; scale : FREQ) return REAL; + function to_real(br : BAUD; scale : BAUD) return REAL; + function to_real(mem : MEMORY; scale : MEMORY) return REAL; + + -- convert physical types to standard type (INTEGER) + function to_int(t : time; scale : time; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer; + function to_int(f : FREQ; scale : FREQ; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer; + function to_int(br : BAUD; scale : BAUD; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer; + function to_int(mem : MEMORY; scale : MEMORY; RoundingStyle : T_ROUNDING_STYLE := ROUND_UP) return integer; + + -- calculate needed counter cycles to achieve a given 1. timing/delay and 2. frequency/period + function TimingToCycles(Timing : time; Clock_Period : time; RoundingStyle : T_ROUNDING_STYLE := ROUND_UP) return natural; + function TimingToCycles(Timing : time; Clock_Frequency : FREQ; RoundingStyle : T_ROUNDING_STYLE := ROUND_UP) return natural; + + function CyclesToDelay(Cycles : natural; Clock_Period : time) return time; + function CyclesToDelay(Cycles : natural; Clock_Frequency : FREQ) return time; + + -- convert and format physical types to STRING + function to_string(t : time; precision : natural) return string; + function to_string(f : FREQ; precision : natural) return string; + function to_string(br : BAUD; precision : natural) return string; + function to_string(mem : MEMORY; precision : natural) return string; +end package; + + +package body physical is + + -- WORKAROUND: for simulators with a "Minimal Time Resolution" > 1 fs + -- Version: all + -- Vendors: all + -- Issue: + -- Some simulators use a lower minimal time resolution (MTR) than the VHDL + -- standard (LRM) defines (1 fs). Usually, the MTR is set to 1 ps or 1 ns. + -- Most simulators allow the user to specify a higher MTR -> check the + -- simulator documentation. + -- Solution: + -- The currently set MTR can be calculated in VHDL. Using the correct MTR + -- can prevent cleared intermediate values and division by zero errors. + -- Examples: + -- Mentor Graphics QuestaSim/ModelSim (vSim): default MTR = ? ?? + -- Xilinx ISE Simulator (iSim): default MTR = 1 ps + -- Xilinx Vivado Simulator (xSim): default MTR = 1 ps + function MinimalTimeResolutionInSimulation return time is + begin + if (1 fs > 0 sec) then return 1 fs; + elsif (1 ps > 0 sec) then return 1 ps; + elsif (1 ns > 0 sec) then return 1 ns; + elsif (1 us > 0 sec) then return 1 us; + elsif (1 ms > 0 sec) then return 1 ms; + else return 1 sec; + end if; + end function; + + -- real division for physical types + -- =========================================================================== + function div(a : time; b : time) return REAL is + constant MTRIS : time := MinimalTimeResolutionInSimulation; + variable a_real : real; + variable b_real : real; + begin + -- WORKAROUND: for Altera Quartus + -- Version: all + -- Issue: + -- Results of TIME arithmetic must be in 32-bit integer range, because + -- the internally used 64-bit integer for type TIME can not be + -- represented in VHDL. + -- Solution: + -- Pre- and post-scale all values to stay in the integer range. + if a < 1 us then + a_real := real(a / MTRIS); + elsif a < 1 ms then + a_real := real(a / (1000 * MTRIS)) * 1000.0; + elsif a < 1 sec then + a_real := real(a / (1000000 * MTRIS)) * 1000000.0; + else + a_real := real(a / (1000000000 * MTRIS)) * 1000000000.0; + end if; + + if b < 1 us then + b_real := real(b / MTRIS); + elsif b < 1 ms then + b_real := real(b / (1000 * MTRIS)) * 1000.0; + elsif b < 1 sec then + b_real := real(b / (1000000 * MTRIS)) * 1000000.0; + else + b_real := real(b / (1000000000 * MTRIS)) * 1000000000.0; + end if; + + return a_real / b_real; + end function; + + function div(a : FREQ; b : FREQ) return REAL is + begin + return real(a / 1 Hz) / real(b / 1 Hz); + end function; + + function div(a : BAUD; b : BAUD) return REAL is + begin + return real(a / 1 Bd) / real(b / 1 Bd); + end function; + + function div(a : MEMORY; b : MEMORY) return REAL is + begin + return real(a / 1 Byte) / real(b / 1 Byte); + end function; + + -- conversion functions + -- =========================================================================== + function to_time(f : FREQ) return time is + variable res : time; + begin + res := div(1000 MHz, f) * 1 ns; + if POC_VERBOSE then + report "to_time: f= " & to_string(f, 3) & " return " & to_string(res, 3) severity note; + end if; + return res; + end function; + + function to_freq(p : time) return FREQ is + variable res : FREQ; + begin + if (p <= 1 sec) then res := div(1 sec, p) * 1 Hz; + else report "to_freq: input period exceeds output frequency scale." severity failure; + end if; + if POC_VERBOSE then + report "to_freq: p= " & to_string(p, 3) & " return " & to_string(res, 3) severity note; + end if; + return res; + end function; + + function to_freq(br : BAUD) return FREQ is + variable res : FREQ; + begin + res := (br / 1 Bd) * 1 Hz; + if POC_VERBOSE then + report "to_freq: br= " & to_string(br, 3) & " return " & to_string(res, 3) severity note; + end if; + return res; + end function; + + function to_baud(str : string) return BAUD is + variable pos : integer; + variable int : natural; + variable base : positive; + variable frac : natural; + variable digits : natural; + begin + pos := str'low; + int := 0; + frac := 0; + digits := 0; + -- read integer part + for i in pos to str'high loop + if chr_isDigit(str(i)) then int := int * 10 + to_digit_dec(str(i)); + elsif (str(i) = '.') then pos := -i; exit; + elsif (str(i) = ' ') then pos := i; exit; + else pos := 0; exit; + end if; + end loop; + -- read fractional part + if ((pos < 0) and (-pos < str'high)) then + for i in -pos+1 to str'high loop + if ((frac = 0) and (str(i) = '0')) then next; + elsif chr_isDigit(str(i)) then frac := frac * 10 + to_digit_dec(str(i)); + elsif (str(i) = ' ') then digits := i + pos - 1; pos := i; exit; + else pos := 0; exit; + end if; + end loop; + end if; + -- abort if format is unknown + if pos = 0 then report "to_baud: Unknown format" severity FAILURE; end if; + -- parse unit + pos := pos + 1; + if ((pos + 1 = str'high) and (str(pos to pos + 1) = "Bd")) then + return int * 1 Bd; + elsif (pos + 2 = str'high) then + if (str(pos to pos + 2) = "kBd") then + if frac = 0 then return (int * 1 kBd); + elsif (digits <= 3) then return (int * 1 kBd) + (frac * 10**(3 - digits) * 1 Bd); + else return (int * 1 kBd) + (frac / 10**(digits - 3) * 100 Bd); + end if; + elsif (str(pos to pos + 2) = "MBd") then + if frac = 0 then return (int * 1 kBd); + elsif (digits <= 3) then return (int * 1 MBd) + (frac * 10**(3 - digits) * 1 kBd); + elsif (digits <= 6) then return (int * 1 MBd) + (frac * 10**(6 - digits) * 1 Bd); + else return (int * 1 MBd) + (frac / 10**(digits - 6) * 100000 Bd); + end if; + elsif (str(pos to pos + 2) = "GBd") then + if frac = 0 then return (int * 1 kBd); + elsif (digits <= 3) then return (int * 1 GBd) + (frac * 10**(3 - digits) * 1 MBd); + elsif (digits <= 6) then return (int * 1 GBd) + (frac * 10**(6 - digits) * 1 kBd); + elsif (digits <= 9) then return (int * 1 GBd) + (frac * 10**(9 - digits) * 1 Bd); + else return (int * 1 GBd) + (frac / 10**(digits - 9) * 100000000 Bd); + end if; + else + report "to_baud: Unknown unit." severity FAILURE; + end if; + else + report "to_baud: Unknown format" severity FAILURE; + end if; + return 0 Bd; + end function; + + -- inter-type arithmetic + -- =========================================================================== + function "/"(x : real; t : time) return FREQ is + begin + return x*div(1 ms, t) * 1 kHz; + end function; + function "/"(x : real; f : FREQ) return time is + begin + return x*div(1 kHz, f) * 1 ms; + end function; + function "*"(t : time; f : FREQ) return real is + begin + return div(t, 1.0/f); + end function; + function "*"(f : FREQ; t : time) return real is + begin + return div(f, 1.0/t); + end function; + + -- if-then-else + -- =========================================================================== + function ite(cond : boolean; value1 : time; value2 : time) return time is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : FREQ; value2 : FREQ) return FREQ is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : BAUD; value2 : BAUD) return BAUD is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : MEMORY; value2 : MEMORY) return MEMORY is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + -- min/ max for 2 arguments + -- =========================================================================== + -- Calculates: min(arg1, arg2) for times + function tmin(arg1 : time; arg2 : time) return time is + begin + if arg1 < arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: min(arg1, arg2) for frequencies + function fmin(arg1 : FREQ; arg2 : FREQ) return FREQ is + begin + if arg1 < arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: min(arg1, arg2) for symbols per second + function bmin(arg1 : BAUD; arg2 : BAUD) return BAUD is + begin + if arg1 < arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: min(arg1, arg2) for memory + function mmin(arg1 : MEMORY; arg2 : MEMORY) return MEMORY is + begin + if arg1 < arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: max(arg1, arg2) for times + function tmax(arg1 : time; arg2 : time) return time is + begin + if arg1 > arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: max(arg1, arg2) for frequencies + function fmax(arg1 : FREQ; arg2 : FREQ) return FREQ is + begin + if arg1 > arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: max(arg1, arg2) for symbols per second + function bmax(arg1 : BAUD; arg2 : BAUD) return BAUD is + begin + if arg1 > arg2 then return arg1; end if; + return arg2; + end function; + + -- Calculates: max(arg1, arg2) for memory + function mmax(arg1 : MEMORY; arg2 : MEMORY) return MEMORY is + begin + if arg1 > arg2 then return arg1; end if; + return arg2; + end function; + + -- min/max/sum as vector aggregation + -- =========================================================================== + -- Calculates: min(vec) for a time vector + function tmin(vec : T_TIMEVEC) return time is + variable res : time := time'high; + begin + for i in vec'range loop + if vec(i) < res then + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: min(vec) for a frequency vector + function fmin(vec : T_FREQVEC) return FREQ is + variable res : FREQ := FREQ'high; + begin + for i in vec'range loop + if (integer(FREQ'pos(vec(i))) < integer(FREQ'pos(res))) then -- Quartus workaround + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: min(vec) for a baud vector + function bmin(vec : T_BAUDVEC) return BAUD is + variable res : BAUD := BAUD'high; + begin + for i in vec'range loop + if (integer(BAUD'pos(vec(i))) < integer(BAUD'pos(res))) then -- Quartus workaround + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: min(vec) for a memory vector + function mmin(vec : T_MEMVEC) return MEMORY is + variable res : MEMORY := MEMORY'high; + begin + for i in vec'range loop + if (integer(MEMORY'pos(vec(i))) < integer(MEMORY'pos(res))) then -- Quartus workaround + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: max(vec) for a time vector + function tmax(vec : T_TIMEVEC) return time is + variable res : time := time'low; + begin + for i in vec'range loop + if vec(i) > res then + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: max(vec) for a frequency vector + function fmax(vec : T_FREQVEC) return FREQ is + variable res : FREQ := FREQ'low; + begin + for i in vec'range loop + if (integer(FREQ'pos(vec(i))) > integer(FREQ'pos(res))) then -- Quartus workaround + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: max(vec) for a baud vector + function bmax(vec : T_BAUDVEC) return BAUD is + variable res : BAUD := BAUD'low; + begin + for i in vec'range loop + if (integer(BAUD'pos(vec(i))) > integer(BAUD'pos(res))) then -- Quartus workaround + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: max(vec) for a memory vector + function mmax(vec : T_MEMVEC) return MEMORY is + variable res : MEMORY := MEMORY'low; + begin + for i in vec'range loop + if (integer(MEMORY'pos(vec(i))) > integer(MEMORY'pos(res))) then -- Quartus workaround + res := vec(i); + end if; + end loop; + return res; + end; + + -- Calculates: sum(vec) for a time vector + function tsum(vec : T_TIMEVEC) return time is + variable res : time := 0 fs; + begin + for i in vec'range loop + res := res + vec(i); + end loop; + return res; + end; + + -- Calculates: sum(vec) for a frequency vector + function fsum(vec : T_FREQVEC) return FREQ is + variable res : FREQ := 0 Hz; + begin + for i in vec'range loop + res := res + vec(i); + end loop; + return res; + end; + + -- Calculates: sum(vec) for a baud vector + function bsum(vec : T_BAUDVEC) return BAUD is + variable res : BAUD := 0 Bd; + begin + for i in vec'range loop + res := res + vec(i); + end loop; + return res; + end; + + -- Calculates: sum(vec) for a memory vector + function msum(vec : T_MEMVEC) return MEMORY is + variable res : MEMORY := 0 Byte; + begin + for i in vec'range loop + res := res + vec(i); + end loop; + return res; + end; + + -- convert standard types (NATURAL, REAL) to time (TIME) + -- =========================================================================== + function fs2Time(t_fs : integer) return time is + begin + return t_fs * 1 fs; + end function; + + function ps2Time(t_ps : integer) return time is + begin + return t_ps * 1 ps; + end function; + + function ns2Time(t_ns : integer) return time is + begin + return t_ns * 1 ns; + end function; + + function us2Time(t_us : integer) return time is + begin + return t_us * 1 us; + end function; + + function ms2Time(t_ms : integer) return time is + begin + return t_ms * 1 ms; + end function; + + function sec2Time(t_sec : integer) return time is + begin + return t_sec * 1 sec; + end function; + + function fs2Time(t_fs : REAL) return time is + begin + return t_fs * 1 fs; + end function; + + function ps2Time(t_ps : REAL) return time is + begin + return t_ps * 1 ps; + end function; + + function ns2Time(t_ns : REAL) return time is + begin + return t_ns * 1 ns; + end function; + + function us2Time(t_us : REAL) return time is + begin + return t_us * 1 us; + end function; + + function ms2Time(t_ms : REAL) return time is + begin + return t_ms * 1 ms; + end function; + + function sec2Time(t_sec : REAL) return time is + begin + return t_sec * 1 sec; + end function; + + -- convert standard types (NATURAL, REAL) to period (TIME) + -- =========================================================================== + function Hz2Time(f_Hz : natural) return time is + begin + return 1 sec / f_Hz; + end function; + + function kHz2Time(f_kHz : natural) return time is + begin + return 1 ms / f_kHz; + end function; + + function MHz2Time(f_MHz : natural) return time + is + begin + return 1 us / f_MHz; + end function; + + function GHz2Time(f_GHz : natural) return time is + begin + return 1 ns / f_GHz; + end function; + + function Hz2Time(f_Hz : REAL) return time is + begin + return 1 sec / f_Hz; + end function; + + function kHz2Time(f_kHz : REAL) return time is + begin + return 1 ms / f_kHz; + end function; + + function MHz2Time(f_MHz : REAL) return time is + begin + return 1 us / f_MHz; + end function; + + function GHz2Time(f_GHz : REAL) return time is + begin + return 1 ns / f_GHz; + end function; + + -- convert standard types (NATURAL, REAL) to frequency (FREQ) + -- =========================================================================== + function Hz2Freq(f_Hz : natural) return FREQ is + begin + return f_Hz * 1 Hz; + end function; + + function kHz2Freq(f_kHz : natural) return FREQ is + begin + return f_kHz * 1 kHz; + end function; + + function MHz2Freq(f_MHz : natural) return FREQ is + begin + return f_MHz * 1 MHz; + end function; + + function GHz2Freq(f_GHz : natural) return FREQ is + begin + return f_GHz * 1 GHz; + end function; + + function Hz2Freq(f_Hz : REAL) return FREQ is + begin + return f_Hz * 1 Hz; + end function; + + function kHz2Freq(f_kHz : REAL )return FREQ is + begin + return f_kHz * 1 kHz; + end function; + + function MHz2Freq(f_MHz : REAL )return FREQ is + begin + return f_MHz * 1 MHz; + end function; + + function GHz2Freq(f_GHz : REAL )return FREQ is + begin + return f_GHz * 1 GHz; + end function; + + -- convert physical types to standard type (REAL) + -- =========================================================================== + function to_real(t : time; scale : time) return REAL is + begin + if (scale = 1 fs) then return div(t, 1 fs); + elsif (scale = 1 ps) then return div(t, 1 ps); + elsif (scale = 1 ns) then return div(t, 1 ns); + elsif (scale = 1 us) then return div(t, 1 us); + elsif (scale = 1 ms) then return div(t, 1 ms); + elsif (scale = 1 sec) then return div(t, 1 sec); + else report "to_real: scale must have a value of '1 <unit>'" severity failure; + return 0.0; + end if; + end; + + function to_real(f : FREQ; scale : FREQ) return REAL is + begin + if (scale = 1 Hz) then return div(f, 1 Hz); + elsif (scale = 1 kHz) then return div(f, 1 kHz); + elsif (scale = 1 MHz) then return div(f, 1 MHz); + elsif (scale = 1 GHz) then return div(f, 1 GHz); +-- elsif (scale = 1 THz) then return div(f, 1 THz); + else report "to_real: scale must have a value of '1 <unit>'" severity failure; + end if; + return 0.0; + end; + + function to_real(br : BAUD; scale : BAUD) return REAL is + begin + if (scale = 1 Bd) then return div(br, 1 Bd); + elsif (scale = 1 kBd) then return div(br, 1 kBd); + elsif (scale = 1 MBd) then return div(br, 1 MBd); + elsif (scale = 1 GBd) then return div(br, 1 GBd); + else report "to_real: scale must have a value of '1 <unit>'" severity failure; + end if; + return 0.0; + end; + + function to_real(mem : MEMORY; scale : MEMORY) return REAL is + begin + if (scale = 1 Byte) then return div(mem, 1 Byte); + elsif (scale = 1 KiB) then return div(mem, 1 KiB); + elsif (scale = 1 MiB) then return div(mem, 1 MiB); + elsif (scale = 1 GiB) then return div(mem, 1 GiB); + else report "to_real: scale must have a value of '1 <unit>'" severity failure; + end if; + return 0.0; + end; + + -- convert physical types to standard type (INTEGER) + -- =========================================================================== + function to_int(t : time; scale : time; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer is + begin + case RoundingStyle is + when ROUND_UP => return integer(ceil(to_real(t, scale))); + when ROUND_DOWN => return integer(floor(to_real(t, scale))); + when ROUND_TO_NEAREST => return integer(round(to_real(t, scale))); + when others => null; + end case; + report "to_int: unsupported RoundingStyle: " & T_ROUNDING_STYLE'image(RoundingStyle) severity failure; + return 0; + end; + + function to_int(f : FREQ; scale : FREQ; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer is + begin + case RoundingStyle is + when ROUND_UP => return integer(ceil(to_real(f, scale))); + when ROUND_DOWN => return integer(floor(to_real(f, scale))); + when ROUND_TO_NEAREST => return integer(round(to_real(f, scale))); + when others => null; + end case; + report "to_int: unsupported RoundingStyle: " & T_ROUNDING_STYLE'image(RoundingStyle) severity failure; + return 0; + end; + + function to_int(br : BAUD; scale : BAUD; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer is + begin + case RoundingStyle is + when ROUND_UP => return integer(ceil(to_real(br, scale))); + when ROUND_DOWN => return integer(floor(to_real(br, scale))); + when ROUND_TO_NEAREST => return integer(round(to_real(br, scale))); + when others => null; + end case; + report "to_int: unsupported RoundingStyle: " & T_ROUNDING_STYLE'image(RoundingStyle) severity failure; + return 0; + end; + + function to_int(mem : MEMORY; scale : MEMORY; RoundingStyle : T_ROUNDING_STYLE := ROUND_UP) return integer is + begin + case RoundingStyle is + when ROUND_UP => return integer(ceil(to_real(mem, scale))); + when ROUND_DOWN => return integer(floor(to_real(mem, scale))); + when ROUND_TO_NEAREST => return integer(round(to_real(mem, scale))); + when others => null; + end case; + report "to_int: unsupported RoundingStyle: " & T_ROUNDING_STYLE'image(RoundingStyle) severity failure; + return 0; + end; + + -- calculate needed counter cycles to achieve a given 1. timing/delay and 2. frequency/period + -- =========================================================================== + -- @param Timing A given timing or delay, which should be achieved + -- @param Clock_Period The period of the circuits clock + -- @RoundingStyle Default = ROUND_UP; other choises: ROUND_UP, ROUND_DOWN, ROUND_TO_NEAREST + function TimingToCycles(Timing : time; Clock_Period : time; RoundingStyle : T_ROUNDING_STYLE := ROUND_UP) return natural is + variable res_real : REAL; + variable res_nat : natural; + variable res_time : time; + variable res_dev : REAL; + begin + res_real := div(Timing, Clock_Period); + case RoundingStyle is + when ROUND_TO_NEAREST => res_nat := natural(round(res_real)); + when ROUND_UP => res_nat := natural(ceil(res_real)); + when ROUND_DOWN => res_nat := natural(floor(res_real)); + when others => report "RoundingStyle '" & T_ROUNDING_STYLE'image(RoundingStyle) & "' not supported." severity failure; + end case; + res_time := CyclesToDelay(res_nat, Clock_Period); + res_dev := (div(res_time, Timing) - 1.0) * 100.0; + + if POC_VERBOSE then + report "TimingToCycles: " & LF & + " Timing: " & to_string(Timing, 3) & LF & + " Clock_Period: " & to_string(Clock_Period, 3) & LF & + " RoundingStyle: " & str_substr(T_ROUNDING_STYLE'image(RoundingStyle), 7) & LF & + " res_real = " & str_format(res_real, 3) & LF & + " => " & integer'image(res_nat) + severity note; + end if; + + if C_PHYSICAL_REPORT_TIMING_DEVIATION then + report "TimingToCycles (timing deviation report): " & LF & + " timing to achieve: " & to_string(Timing, 3) & LF & + " calculated cycles: " & integer'image(res_nat) & " cy" & LF & + " resulting timing: " & to_string(res_time, 3) & LF & + " deviation: " & to_string(res_time - Timing, 3) & " (" & str_format(res_dev, 2) & "%)" + severity note; + end if; + + return res_nat; + end; + + function TimingToCycles(Timing : time; Clock_Frequency : FREQ; RoundingStyle : T_ROUNDING_STYLE := ROUND_UP) return natural is + begin + return TimingToCycles(Timing, to_time(Clock_Frequency), RoundingStyle); + end function; + + function CyclesToDelay(Cycles : natural; Clock_Period : time) return time is + begin + return Clock_Period * Cycles; + end function; + + function CyclesToDelay(Cycles : natural; Clock_Frequency : FREQ) return time is + begin + return CyclesToDelay(Cycles, to_time(Clock_Frequency)); + end function; + + -- convert and format physical types to STRING + function to_string(t : time; precision : natural) return string is + variable tt : time; + variable unit : string(1 to 3) := (others => C_POC_NUL); + variable value : REAL; + begin + tt := abs t; + if (tt < 1 ps) then + unit(1 to 2) := "fs"; + value := to_real(tt, 1 fs); + elsif (tt < 1 ns) then + unit(1 to 2) := "ps"; + value := to_real(tt, 1 ps); + elsif (tt < 1 us) then + unit(1 to 2) := "ns"; + value := to_real(tt, 1 ns); + elsif (tt < 1 ms) then + unit(1 to 2) := "us"; + value := to_real(tt, 1 us); + elsif (tt < 1 sec) then + unit(1 to 2) := "ms"; + value := to_real(tt, 1 ms); + else + unit := "sec"; + value := to_real(tt, 1 sec); + end if; + + return ite(t >= 0 fs, str_format(value, precision) & " " & str_trim(unit), + '-' & str_format(value, precision) & " " & str_trim(unit)); + end function; + + function to_string(f : FREQ; precision : natural) return string is + variable unit : string(1 to 3) := (others => C_POC_NUL); + variable value : REAL; + begin + if (f < 1 kHz) then + unit(1 to 2) := "Hz"; + value := to_real(f, 1 Hz); + elsif (f < 1 MHz) then + unit := "kHz"; + value := to_real(f, 1 kHz); + elsif (f < 1 GHz) then + unit := "MHz"; + value := to_real(f, 1 MHz); + else + unit := "GHz"; + value := to_real(f, 1 GHz); + end if; + + return str_format(value, precision) & " " & str_trim(unit); + end function; + + function to_string(br : BAUD; precision : natural) return string is + variable unit : string(1 to 3) := (others => C_POC_NUL); + variable value : REAL; + begin + if (br < 1 kBd) then + unit(1 to 2) := "Bd"; + value := to_real(br, 1 Bd); + elsif (br < 1 MBd) then + unit := "kBd"; + value := to_real(br, 1 kBd); + elsif (br < 1 GBd) then + unit := "MBd"; + value := to_real(br, 1 MBd); + else + unit := "GBd"; + value := to_real(br, 1 GBd); + end if; + + return str_format(value, precision) & " " & str_trim(unit); + end function; + + function to_string(mem : MEMORY; precision : natural) return string is + variable unit : string(1 to 3) := (others => C_POC_NUL); + variable value : REAL; + begin + if (mem < 1 KiB) then + unit(1) := 'B'; + value := to_real(mem, 1 Byte); + elsif (mem < 1 MiB) then + unit := "KiB"; + value := to_real(mem, 1 KiB); + elsif (mem < 1 GiB) then + unit := "MiB"; + value := to_real(mem, 1 MiB); + else + unit := "GiB"; + value := to_real(mem, 1 GiB); + end if; + + return str_format(value, precision) & " " & str_trim(unit); + end function; + +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/protected.v08.vhdl b/testsuite/gna/issue317/PoC/src/common/protected.v08.vhdl new file mode 100644 index 000000000..9888f27ce --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/protected.v08.vhdl @@ -0,0 +1,302 @@ +-- EMACS settings: -*- tab-width: 2;indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2;replace-tabs off;indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Package: Protected type implementations. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany, +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.math_real.all; + +library PoC; +-- use PoC.my_project.all; +-- use PoC.utils.all; + + +package ProtectedTypes is + -- protected BOOLEAN implementation + -- =========================================================================== + type P_BOOLEAN is protected + procedure Clear; + procedure Set(Value : boolean := TRUE); + impure function Get return boolean; + impure function Toggle return boolean; + end protected; + + -- protected INTEGER implementation + -- =========================================================================== + -- TODO: Mult, Div, Pow, Mod, Rem + type P_INTEGER is protected + procedure Clear; + procedure Set(Value : integer); + impure function Get return integer; + procedure Add(Value : integer); + impure function Add(Value : integer) return integer; + procedure Sub(Value : integer); + impure function Sub(Value : integer) return integer; + end protected; + + -- protected NATURAL implementation + -- =========================================================================== + -- TODO: Mult, Div, Pow, Mod, Rem + type P_NATURAL is protected + procedure Clear; + procedure Set(Value : natural); + impure function Get return natural; + procedure Add(Value : natural); + impure function Add(Value : natural) return natural; + procedure Sub(Value : natural); + impure function Sub(Value : natural) return natural; + end protected; + + -- protected POSITIVE implementation + -- =========================================================================== + -- TODO: Mult, Div, Pow, Mod, Rem + type P_POSITIVE is protected + procedure Clear; + procedure Set(Value : positive); + impure function Get return positive; + procedure Add(Value : positive); + impure function Add(Value : positive) return positive; + procedure Sub(Value : positive); + impure function Sub(Value : positive) return positive; + end protected; + + -- protected REAL implementation + -- =========================================================================== + -- TODO: Round, Mult, Div, Pow, Mod + type P_REAL is protected + procedure Clear; + procedure Set(Value : REAL); + impure function Get return REAL; + procedure Add(Value : REAL); + impure function Add(Value : REAL) return REAL; + procedure Sub(Value : REAL); + impure function Sub(Value : REAL) return REAL; + end protected; +end package; + + +package body ProtectedTypes is + -- protected BOOLEAN implementation + -- =========================================================================== + type P_BOOLEAN is protected body + variable InnerValue : boolean := FALSE; + + procedure Clear is + begin + InnerValue := FALSE; + end procedure; + + procedure Set(Value : boolean := TRUE) is + begin + InnerValue := Value; + end procedure; + + impure function Get return boolean is + begin + return InnerValue; + end function; + + impure function Toggle return boolean is + begin + InnerValue := not InnerValue; + return InnerValue; + end function; + end protected body; + + -- protected INTEGER implementation + -- =========================================================================== + type P_INTEGER is protected body + variable InnerValue : integer := 0; + + procedure Clear is + begin + InnerValue := 0; + end procedure; + + procedure Set(Value : integer) is + begin + InnerValue := Value; + end procedure; + + impure function Get return integer is + begin + return InnerValue; + end function; + + procedure Add(Value : integer) is + begin + InnerValue := InnerValue + Value; + end procedure; + + impure function Add(Value : integer) return integer is + begin + Add(Value); + return InnerValue; + end function; + + procedure Sub(Value : integer) is + begin + InnerValue := InnerValue - Value; + end procedure; + + impure function Sub(Value : integer) return integer is + begin + Sub(Value); + return InnerValue; + end function; + end protected body; + + -- protected NATURAL implementation + -- =========================================================================== + type P_NATURAL is protected body + variable InnerValue : natural := 0; + + procedure Clear is + begin + InnerValue := 0; + end procedure; + + procedure Set(Value : natural) is + begin + InnerValue := Value; + end procedure; + + impure function Get return natural is + begin + return InnerValue; + end function; + + procedure Add(Value : natural) is + begin + InnerValue := InnerValue + Value; + end procedure; + + impure function Add(Value : natural) return natural is + begin + Add(Value); + return InnerValue; + end function; + + procedure Sub(Value : natural) is + begin + InnerValue := InnerValue - Value; + end procedure; + + impure function Sub(Value : natural) return natural is + begin + Sub(Value); + return InnerValue; + end function; + end protected body; + + -- protected POSITIVE implementation + -- =========================================================================== + type P_POSITIVE is protected body + variable InnerValue : positive := 1; + + procedure Clear is + begin + InnerValue := 1; + end procedure; + + procedure Set(Value : positive) is + begin + InnerValue := Value; + end procedure; + + impure function Get return positive is + begin + return InnerValue; + end function; + + procedure Add(Value : positive) is + begin + InnerValue := InnerValue + Value; + end procedure; + + impure function Add(Value : positive) return positive is + begin + Add(Value); + return InnerValue; + end function; + + procedure Sub(Value : positive) is + begin + InnerValue := InnerValue - Value; + end procedure; + + impure function Sub(Value : positive) return positive is + begin + Sub(Value); + return InnerValue; + end function; + end protected body; + + -- protected REAL implementation + -- =========================================================================== + type P_REAL is protected body + variable InnerValue : REAL := 0.0; + + procedure Clear is + begin + InnerValue := 0.0; + end procedure; + + procedure Set(Value : REAL) is + begin + InnerValue := Value; + end procedure; + + impure function Get return REAL is + begin + return InnerValue; + end function; + + procedure Add(Value : REAL) is + begin + InnerValue := InnerValue + Value; + end procedure; + + impure function Add(Value : REAL) return REAL is + begin + Add(Value); + return InnerValue; + end function; + + procedure Sub(Value : REAL) is + begin + InnerValue := InnerValue - Value; + end procedure; + + impure function Sub(Value : REAL) return REAL is + begin + Sub(Value); + return InnerValue; + end function; + end protected body; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/strings.vhdl b/testsuite/gna/issue317/PoC/src/common/strings.vhdl new file mode 100644 index 000000000..258eb28b8 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/strings.vhdl @@ -0,0 +1,997 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Thomas B. Preusser +-- Martin Zabel +-- Patrick Lehmann +-- +-- Package: String related functions and types +-- +-- Description: +-- ------------------------------------- +-- For detailed documentation see below. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2015 Technische Universitaet Dresden - Germany, +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; +use IEEE.math_real.all; + +library PoC; +use PoC.config.all; +use PoC.utils.all; +--use PoC.FileIO.all; + + +package strings is + -- default fill and string termination character for fixed size strings + -- =========================================================================== + -- WORKAROUND: for Altera Quartus-II + -- Version: 15.0 + -- Issue: + -- character 0 (NUL) causes Quartus-II to crash, if uses to pad STRINGs + -- characters < 32 (control characters) are not supported in Quartus-II + -- characters > 127 are not supported in VHDL files (strict ASCII files) + -- character 255 craches ISE log window (created by 'CHARACTER'val(255)') + -- Solution: + -- PoC uses backtick "`" as a fill and termination symbol, if a Quartus-II + -- synthesis environment is detected. + constant C_POC_NUL : character := ite((SYNTHESIS_TOOL /= SYNTHESIS_TOOL_ALTERA_QUARTUS2), NUL, '`'); + + -- Type declarations + -- =========================================================================== + subtype T_RAWCHAR is std_logic_vector(7 downto 0); + type T_RAWSTRING is array (natural range <>) of T_RAWCHAR; + + -- testing area: + -- =========================================================================== + function to_IPStyle(str : string) return T_IPSTYLE; + + -- to_char + function to_char(Value : std_logic) return character; + function to_char(rawchar : T_RAWCHAR) return character; + + function to_HexChar(Value : natural) return character; + function to_HexChar(Value : unsigned) return character; + + -- chr_is* function + function chr_isDigit(chr : character) return boolean; + function chr_isLowerHexDigit(chr : character) return boolean; + function chr_isUpperHexDigit(chr : character) return boolean; + function chr_isHexDigit(chr : character) return boolean; + function chr_isLower(chr : character) return boolean; + function chr_isLowerAlpha(chr : character) return boolean; + function chr_isUpper(chr : character) return boolean; + function chr_isUpperAlpha(chr : character) return boolean; + function chr_isAlpha(chr : character) return boolean; + + -- raw_format_* functions + function raw_format_bool_bin(Value : boolean) return string; + function raw_format_bool_chr(Value : boolean) return string; + function raw_format_bool_str(Value : boolean) return string; + function raw_format_slv_bin(slv : std_logic_vector) return string; + function raw_format_slv_oct(slv : std_logic_vector) return string; + function raw_format_slv_dec(slv : std_logic_vector) return string; + function raw_format_slv_hex(slv : std_logic_vector) return string; + function raw_format_nat_bin(Value : natural) return string; + function raw_format_nat_oct(Value : natural) return string; + function raw_format_nat_dec(Value : natural) return string; + function raw_format_nat_hex(Value : natural) return string; + + -- str_format_* functions + function str_format(Value : REAL; precision : natural := 3) return string; + + -- to_string + function to_string(Value : boolean) return string; + function to_string(Value : integer; base : positive := 10) return string; + function to_string(slv : std_logic_vector; format : character; Length : natural := 0; fill : character := '0') return string; + function to_string(rawstring : T_RAWSTRING) return string; + function to_string(Value : T_BCD_VECTOR) return string; + + -- to_slv + function to_slv(rawstring : T_RAWSTRING) return std_logic_vector; + + -- digit subtypes incl. error Value (-1) + subtype T_DIGIT_BIN is integer range -1 to 1; + subtype T_DIGIT_OCT is integer range -1 to 7; + subtype T_DIGIT_DEC is integer range -1 to 9; + subtype T_DIGIT_HEX is integer range -1 to 15; + + -- to_digit* + function to_digit_bin(chr : character) return T_DIGIT_BIN; + function to_digit_oct(chr : character) return T_DIGIT_OCT; + function to_digit_dec(chr : character) return T_DIGIT_DEC; + function to_digit_hex(chr : character) return T_DIGIT_HEX; + function to_digit(chr : character; base : character := 'd') return integer; + + -- to_natural* + function to_natural_bin(str : string) return integer; + function to_natural_oct(str : string) return integer; + function to_natural_dec(str : string) return integer; + function to_natural_hex(str : string) return integer; + function to_natural(str : string; base : character := 'd') return integer; + + -- to_raw* + function to_RawChar(char : character) return T_RAWCHAR; + function to_RawString(str : string) return T_RAWSTRING; + + -- resize + function resize(str : string; size : positive; FillChar : character := C_POC_NUL) return string; +-- function resize(rawstr : T_RAWSTRING; size : POSITIVE; FillChar : T_RAWCHAR := x"00") return T_RAWSTRING; + + -- Character functions + function chr_toLower(chr : character) return character; + function chr_toUpper(chr : character) return character; + + -- String functions + function str_length(str : string) return natural; + function str_equal(str1 : string; str2 : string) return boolean; + function str_match(str1 : string; str2 : string) return boolean; + function str_imatch(str1 : string; str2 : string) return boolean; + function str_pos(str : string; chr : character; start : natural := 0) return integer; + function str_pos(str : string; pattern : string; start : natural := 0) return integer; + function str_ipos(str : string; chr : character; start : natural := 0) return integer; + function str_ipos(str : string; pattern : string; start : natural := 0) return integer; + function str_find(str : string; chr : character) return boolean; + function str_find(str : string; pattern : string) return boolean; + function str_ifind(str : string; chr : character) return boolean; + function str_ifind(str : string; pattern : string) return boolean; + function str_replace(str : string; pattern : string; replace : string) return string; + function str_substr(str : string; start : integer := 0; Length : integer := 0) return string; + function str_ltrim(str : string; char : character := ' ') return string; + function str_rtrim(str : string; char : character := ' ') return string; + function str_trim(str : string) return string; + function str_calign(str : string; Length : natural; FillChar : character := ' ') return string; + function str_lalign(str : string; Length : natural; FillChar : character := ' ') return string; + function str_ralign(str : string; Length : natural; FillChar : character := ' ') return string; + function str_toLower(str : string) return string; + function str_toUpper(str : string) return string; +end package; + + +package body strings is + -- + function to_IPStyle(str : string) return T_IPSTYLE is + begin + for i in T_IPSTYLE'pos(T_IPSTYLE'low) to T_IPSTYLE'pos(T_IPSTYLE'high) loop + if str_imatch(str, T_IPSTYLE'image(T_IPSTYLE'val(i))) then + return T_IPSTYLE'val(i); + end if; + end loop; + + report "Unknown IPStyle: '" & str & "'" severity FAILURE; + return IPSTYLE_UNKNOWN; + end function; + + -- to_char + -- =========================================================================== + function to_char(Value : std_logic) return character is + begin + case Value is + when 'U' => return 'U'; + when 'X' => return 'X'; + when '0' => return '0'; + when '1' => return '1'; + when 'Z' => return 'Z'; + when 'W' => return 'W'; + when 'L' => return 'L'; + when 'H' => return 'H'; + when '-' => return '-'; + when others => return 'X'; + end case; + end function; + + function to_char(rawchar : T_RAWCHAR) return character is + begin + return character'val(to_integer(unsigned(rawchar))); + end function; + + -- + function to_HexChar(Value : natural) return character is + constant HEX : string := "0123456789ABCDEF"; + begin + return ite(Value < 16, HEX(Value+1), 'X'); + end function; + + function to_HexChar(Value : unsigned) return character is + begin + return to_HexChar(to_integer(Value)); + end function; + + -- chr_is* function + function chr_isDigit(chr : character) return boolean is + begin + return (character'pos('0') <= character'pos(chr)) and (character'pos(chr) <= character'pos('9')); + end function; + + function chr_isLowerHexDigit(chr : character) return boolean is + begin + return (character'pos('a') <= character'pos(chr)) and (character'pos(chr) <= character'pos('f')); + end function; + + function chr_isUpperHexDigit(chr : character) return boolean is + begin + return (character'pos('A') <= character'pos(chr)) and (character'pos(chr) <= character'pos('F')); + end function; + + function chr_isHexDigit(chr : character) return boolean is + begin + return chr_isDigit(chr) or chr_isLowerHexDigit(chr) or chr_isUpperHexDigit(chr); + end function; + + function chr_isLower(chr : character) return boolean is + begin + return chr_isLowerAlpha(chr); + end function; + + function chr_isLowerAlpha(chr : character) return boolean is + begin + return (character'pos('a') <= character'pos(chr)) and (character'pos(chr) <= character'pos('z')); + end function; + + function chr_isUpper(chr : character) return boolean is + begin + return chr_isUpperAlpha(chr); + end function; + + function chr_isUpperAlpha(chr : character) return boolean is + begin + return (character'pos('A') <= character'pos(chr)) and (character'pos(chr) <= character'pos('Z')); + end function; + + function chr_isAlpha(chr : character) return boolean is + begin + return chr_isLowerAlpha(chr) or chr_isUpperAlpha(chr); + end function; + + -- raw_format_* functions + -- =========================================================================== + function raw_format_bool_bin(Value : boolean) return string is + begin + return ite(Value, "1", "0"); + end function; + + function raw_format_bool_chr(Value : boolean) return string is + begin + return ite(Value, "T", "F"); + end function; + + function raw_format_bool_str(Value : boolean) return string is + begin + return str_toUpper(boolean'image(Value)); + end function; + + function raw_format_slv_bin(slv : std_logic_vector) return string is + variable Value : std_logic_vector(slv'length - 1 downto 0); + variable Result : string(1 to slv'length); + variable j : natural; + begin + -- convert input slv to a downto ranged vector and normalize range to slv'low = 0 + Value := movez(ite(slv'ascending, descend(slv), slv)); + -- convert each bit to a character + j := 0; + for i in Result'reverse_range loop + Result(i) := to_char(Value(j)); + j := j + 1; + end loop; + return Result; + end function; + + function raw_format_slv_oct(slv : std_logic_vector) return string is + variable Value : std_logic_vector(slv'length - 1 downto 0); + variable Digit : std_logic_vector(2 downto 0); + variable Result : string(1 to div_ceil(slv'length, 3)); + variable j : natural; + begin + -- convert input slv to a downto ranged vector; normalize range to slv'low = 0 and resize it to a multiple of 3 + Value := resize(movez(ite(slv'ascending, descend(slv), slv)), (Result'length * 3)); + -- convert 3 bit to a character + j := 0; + for i in Result'reverse_range loop + Digit := Value((j * 3) + 2 downto (j * 3)); + Result(i) := to_HexChar(unsigned(Digit)); + j := j + 1; + end loop; + + return Result; + end function; + + function raw_format_slv_dec(slv : std_logic_vector) return string is + variable Value : std_logic_vector(slv'length - 1 downto 0); + variable Result : string(1 to div_ceil(slv'length, 3)); + + subtype TT_BCD is integer range 0 to 31; + type TT_BCD_VECTOR is array(natural range <>) of TT_BCD; + + variable Temp : TT_BCD_VECTOR(div_ceil(slv'length, 3) - 1 downto 0); + variable Carry : T_UINT_8; + + variable Pos : natural; + begin + Temp := (others => 0); + Pos := 0; + -- convert input slv to a downto ranged vector + Value := ite(slv'ascending, descend(slv), slv); + + for i in Value'range loop + Carry := to_int(Value(i)); + for j in Temp'reverse_range loop + Temp(j) := Temp(j) * 2 + Carry; + Carry := to_int(Temp(j) > 9); + Temp(j) := Temp(j) - to_int((Temp(j) > 9), 0, 10); + end loop; + end loop; + + for i in Result'range loop + Result(i) := to_HexChar(Temp(Temp'high - i + 1)); + if ((Result(i) /= '0') and (Pos = 0)) then + Pos := i; + end if; + end loop; + -- trim leading zeros, except the last + return Result(imin(Pos, Result'high) to Result'high); + end function; + + function raw_format_slv_hex(slv : std_logic_vector) return string is + variable Value : std_logic_vector(4*div_ceil(slv'length, 4) - 1 downto 0); + variable Digit : std_logic_vector(3 downto 0); + variable Result : string(1 to div_ceil(slv'length, 4)); + variable j : natural; + begin + Value := resize(slv, Value'length); + j := 0; + for i in Result'reverse_range loop + Digit := Value((j * 4) + 3 downto (j * 4)); + Result(i) := to_HexChar(unsigned(Digit)); + j := j + 1; + end loop; + return Result; + end function; + + function raw_format_nat_bin(Value : natural) return string is + begin + return raw_format_slv_bin(to_slv(Value, log2ceilnz(Value+1))); + end function; + + function raw_format_nat_oct(Value : natural) return string is + begin + return raw_format_slv_oct(to_slv(Value, log2ceilnz(Value+1))); + end function; + + function raw_format_nat_dec(Value : natural) return string is + begin + return integer'image(Value); + end function; + + function raw_format_nat_hex(Value : natural) return string is + begin + return raw_format_slv_hex(to_slv(Value, log2ceilnz(Value+1))); + end function; + + -- str_format_* functions + -- =========================================================================== + function str_format(Value : REAL; precision : natural := 3) return string is + constant s : REAL := sign(Value); + constant val : REAL := Value * s; + constant int : integer := integer(floor(val)); + constant frac : integer := integer(round((val - real(int)) * 10.0**precision)); + constant overflow : boolean := frac >= 10**precision; + constant int2 : integer := ite(overflow, int+1, int); + constant frac2 : integer := ite(overflow, frac-10**precision, frac); + constant frac_str : string := integer'image(frac2); + constant res : string := integer'image(int2) & "." & (2 to (precision - frac_str'length + 1) => '0') & frac_str; + begin + return ite ((s < 0.0), "-" & res, res); + end function; + + -- to_string + -- =========================================================================== + function to_string(Value : boolean) return string is + begin + return raw_format_bool_str(Value); + end function; + + -- convert an integer Value to a STRING using an arbitrary base + function to_string(Value : integer; base : positive := 10) return string is + constant absValue : natural := abs Value; + constant len : positive := log10ceilnz(absValue); + variable power : positive; + variable Result : string(1 to len); + begin + power := 1; + + if base = 10 then + return integer'image(Value); + else + for i in len downto 1 loop + Result(i) := to_HexChar(absValue / power mod base); + power := power * base; + end loop; + + if Value < 0 then + return '-' & Result; + else + return Result; + end if; + end if; + end function; + + -- QUESTION: rename to slv_format(..) ? + function to_string(slv : std_logic_vector; format : character; Length : natural := 0; fill : character := '0') return string is + constant int : integer := ite((slv'length <= 31), to_integer(unsigned(resize(slv, 31))), 0); + constant str : string := integer'image(int); + constant bin_len : positive := slv'length; + constant dec_len : positive := str'length;--log10ceilnz(int); + constant hex_len : positive := ite(((bin_len mod 4) = 0), (bin_len / 4), (bin_len / 4) + 1); + constant len : natural := ite((format = 'b'), bin_len, + ite((format = 'd'), dec_len, + ite((format = 'h'), hex_len, 0))); + variable j : natural; + variable Result : string(1 to ite((Length = 0), len, imax(len, Length))); + begin + j := 0; + Result := (others => fill); + + if (format = 'b') then + for i in Result'reverse_range loop + Result(i) := to_char(slv(j)); + j := j + 1; + end loop; + elsif (format = 'd') then + -- TODO: enable big integer conversion +-- if (slv'length < 32) then +-- return INTEGER'image(int); +-- else +-- return raw_format_slv_dec(slv); +-- end if; + Result(Result'length - str'length + 1 to Result'high) := str; + elsif (format = 'h') then + for i in Result'reverse_range loop + Result(i) := to_HexChar(unsigned(slv((j * 4) + 3 downto (j * 4)))); + j := j + 1; + end loop; + else + report "Unknown format character: " & format & "." severity FAILURE; + end if; + + return Result; + end function; + + function to_string(rawstring : T_RAWSTRING) return string is + variable Result : string(1 to rawstring'length); + begin + for i in rawstring'low to rawstring'high loop + Result(i - rawstring'low + 1) := to_char(rawstring(i)); + end loop; + return Result; + end function; + + function to_string(Value : T_BCD_VECTOR) return string is + variable Result : string(1 to Value'length); + begin + for i in Value'range loop + Result(Result'high - (i - Value'low)) := to_HexChar(unsigned(Value(i))); + end loop; + return Result; + end function; + + -- to_slv + -- =========================================================================== + function to_slv(rawstring : T_RAWSTRING) return std_logic_vector is + variable Result : std_logic_vector((rawstring'length * 8) - 1 downto 0); + begin + for i in rawstring'range loop + Result(((i - rawstring'low) * 8) + 7 downto (i - rawstring'low) * 8) := rawstring(i); + end loop; + return Result; + end function; + + -- to_digit* + -- =========================================================================== + -- convert a binary digit given as CHARACTER to a digit returned as NATURAL; return -1 on error + function to_digit_bin(chr : character) return T_DIGIT_BIN is + begin + case chr is + when '0' => return 0; + when '1' => return 1; + when others => return -1; + end case; + end function; + + -- convert an octal digit given as CHARACTER to a digit returned as NATURAL; return -1 on error + function to_digit_oct(chr : character) return T_DIGIT_OCT is + variable dec : integer; + begin + dec := to_digit_dec(chr); + return ite((dec < 8), dec, -1); + end function; + + -- convert a adecimal digit given as CHARACTER to a digit returned as NATURAL; return -1 on error + function to_digit_dec(chr : character) return T_DIGIT_DEC is + begin + if chr_isDigit(chr) then + return character'pos(chr) - CHARACTER'pos('0'); + else + return -1; + end if; + end function; + + -- convert a hexadecimal digit given as CHARACTER to a digit returned as NATURAL; return -1 on error + function to_digit_hex(chr : character) return T_DIGIT_HEX is + begin + if chr_isDigit(chr) then return character'pos(chr) - CHARACTER'pos('0'); + elsif chr_isLowerHexDigit(chr) then return character'pos(chr) - CHARACTER'pos('a') + 10; + elsif chr_isUpperHexDigit(chr) then return character'pos(chr) - CHARACTER'pos('A') + 10; + else return -1; + end if; + end function; + + -- convert a digit given as CHARACTER to a digit returned as NATURAL; return -1 on error + function to_digit(chr : character; base : character := 'd') return integer is + begin + case base is + when 'b' => return to_digit_bin(chr); + when 'o' => return to_digit_oct(chr); + when 'd' => return to_digit_dec(chr); + when 'h' => return to_digit_hex(chr); + when others => report "Unknown base character: " & base & "." severity FAILURE; + return -1; + end case; + end function; + + -- to_natural* + -- =========================================================================== + -- convert a binary number given as STRING to a NATURAL; return -1 on error + function to_natural_bin(str : string) return integer is + variable Result : natural; + variable Digit : integer; + begin + for i in str'range loop + Digit := to_digit_bin(str(i)); + if Digit /= -1 then + Result := Result * 2 + Digit; + else + return -1; + end if; + end loop; + return Result; + end function; + + -- convert an octal number given as STRING to a NATURAL; return -1 on error + function to_natural_oct(str : string) return integer is + variable Result : natural; + variable Digit : integer; + begin + for i in str'range loop + Digit := to_digit_oct(str(i)); + if Digit /= -1 then + Result := Result * 8 + Digit; + else + return -1; + end if; + end loop; + return Result; + end function; + + -- convert a decimal number given as STRING to a NATURAL; return -1 on error + function to_natural_dec(str : string) return integer is + variable Result : natural; + variable Digit : integer; + begin + -- WORKAROUND: Xilinx Vivado Synth + -- Version: 2014.1 + -- Issue: + -- INTEGER'value(...) is not supported by Vivado Synth + -- Solution: + -- implement a manual conversion using shift and multiply + for i in str'range loop + Digit := to_digit_dec(str(i)); + if Digit /= -1 then + Result := Result * 10 + Digit; + else + return -1; + end if; + end loop; + return Result; -- INTEGER'value(str); + end function; + + -- convert a hexadecimal number given as STRING to a NATURAL; return -1 on error + function to_natural_hex(str : string) return integer is + variable Result : natural; + variable Digit : integer; + begin + for i in str'range loop + Digit := to_digit_hex(str(i)); + if Digit /= -1 then + Result := Result * 16 + Digit; + else + return -1; + end if; + end loop; + return Result; + end function; + + -- convert a number given as STRING to a NATURAL; return -1 on error + function to_natural(str : string; base : character := 'd') return integer is + begin + case base is + when 'b' => return to_natural_bin(str); + when 'o' => return to_natural_oct(str); + when 'd' => return to_natural_dec(str); + when 'h' => return to_natural_hex(str); + when others => report "Unknown base character: " & base & "." severity FAILURE; + return -1; + end case; + end function; + + -- to_raw* + -- =========================================================================== + -- convert a CHARACTER to a RAWCHAR + function to_RawChar(char : character) return T_RAWCHAR is + begin + return std_logic_vector(to_unsigned(character'pos(char), T_RAWCHAR'length)); + end function; + + -- convert a STRING to a RAWSTRING + function to_RawString(str : string) return T_RAWSTRING is + variable Result : T_RAWSTRING(0 to str'length - 1); + begin + for i in str'low to str'high loop + Result(i - str'low) := to_RawChar(str(i)); + end loop; + return Result; + end function; + + -- resize + -- =========================================================================== + function resize(str : string; Size : positive; FillChar : character := C_POC_NUL) return string is + constant ConstNUL : string(1 to 1) := (others => C_POC_NUL); + variable Result : string(1 to Size); + begin + Result := (others => FillChar); + if (str'length > 0) then + -- WORKAROUND: for Altera Quartus-II + -- Version: 15.0 + -- Issue: array bounds are check regardless of the hierarchy and control flow + Result(1 to bound(Size, 1, str'length)) := ite((str'length > 0), str(1 to imin(Size, str'length)), ConstNUL); + end if; + return Result; + end function; + +-- function resize(str : T_RAWSTRING; size : POSITIVE; FillChar : T_RAWCHAR := x"00") return T_RAWSTRING is +-- constant ConstNUL : T_RAWSTRING(1 to 1) := (others => x"00"); +-- variable Result : T_RAWSTRING(1 to size); +-- function ifthenelse(cond : BOOLEAN; value1 : T_RAWSTRING; value2 : T_RAWSTRING) return T_RAWSTRING is +-- begin +-- if cond then +-- return value1; +-- else +-- return value2; +-- end if; +-- end function; +-- begin +-- Result := (others => FillChar); +-- if (str'length > 0) then +-- Result(1 to imin(size, imax(1, str'length))) := ifthenelse((str'length > 0), str(1 to imin(size, str'length)), ConstNUL); +-- end if; +-- return Result; +-- end function; + + + -- Character functions + -- =========================================================================== + -- convert an upper case CHARACTER into a lower case CHARACTER + function chr_toLower(chr : character) return character is + begin + if chr_isUpperAlpha(chr) then + return character'val(character'pos(chr) - character'pos('A') + character'pos('a')); + else + return chr; + end if; + end function; + + -- convert a lower case CHARACTER into an upper case CHARACTER + function chr_toUpper(chr : character) return character is + begin + if chr_isLowerAlpha(chr) then + return character'val(character'pos(chr) - character'pos('a') + character'pos('A')); + else + return chr; + end if; + end function; + + -- String functions + -- =========================================================================== + -- count the length of a POC_NUL terminated STRING + function str_length(str : string) return natural is + begin + for i in str'range loop + if str(i) = C_POC_NUL then + return i - str'low; + end if; + end loop; + return str'length; + end function; + + -- compare two STRINGs for equality + -- pre-check the string lengthes to suppress warnings for unqual sized string comparisons. + -- QUESTION: overload "=" operator? + function str_equal(str1 : string; str2 : string) return boolean is + begin + if str1'length /= str2'length then + return FALSE; + else + return (str1 = str2); + end if; + end function; + + -- compare two POC_NUL terminated STRINGs + function str_match(str1 : string; str2 : string) return boolean is + constant len : natural := imin(str1'length, str2'length); + begin + -- if both strings are empty + if ((str1'length = 0 ) and (str2'length = 0)) then return TRUE; end if; + -- compare char by char + for i in str1'low to str1'low + len - 1 loop + if (str1(i) /= str2(str2'low + (i - str1'low))) then + return FALSE; + elsif ((str1(i) = C_POC_NUL) xor (str2(str2'low + (i - str1'low)) = C_POC_NUL)) then + return FALSE; + elsif ((str1(i) = C_POC_NUL) and (str2(str2'low + (i - str1'low)) = C_POC_NUL)) then + return TRUE; + end if; + end loop; + -- check special cases, + return (((str1'length = len) and (str2'length = len)) or -- both strings are fully consumed and equal + ((str1'length > len) and (str1(str1'low + len) = C_POC_NUL)) or -- str1 is longer, but str_length equals len + ((str2'length > len) and (str2(str2'low + len) = C_POC_NUL))); -- str2 is longer, but str_length equals len + end function; + + -- compare two POC_NUL terminated STRINGs; case insentitve + function str_imatch(str1 : string; str2 : string) return boolean is + begin + return str_match(str_toLower(str1), str_toLower(str2)); + end function; + + -- search for chr in a STRING and return the position; return -1 on error + function str_pos(str : string; chr : character; start : natural := 0) return integer is + begin + for i in imax(str'low, start) to str'high loop + exit when (str(i) = C_POC_NUL); + if str(i) = chr then + return i; + end if; + end loop; + return -1; + end function; + + -- search for pattern in a STRING and return the position; return -1 on error + -- QUESTION: implement KMP algorithm? + function str_pos(str : string; pattern : string; start : natural := 0) return integer is + begin + for i in imax(str'low, start) to (str'high - pattern'length + 1) loop + exit when (str(i) = C_POC_NUL); + if (str(i to i + pattern'length - 1) = pattern) then + return i; + end if; + end loop; + return -1; + end function; + + -- search for chr in a STRING and return the position; case insentitve; return -1 on error + function str_ipos(str : string; chr : character; start : natural := 0) return integer is + begin + return str_pos(str_toLower(str), chr_toLower(chr)); + end function; + + -- search for pattern in a STRING and return the position; case insentitve; return -1 on error + function str_ipos(str : string; pattern : string; start : natural := 0) return integer is + begin + return str_pos(str_toLower(str), str_toLower(pattern)); + end function; + +-- function str_pos(str1 : STRING; str2 : STRING) return INTEGER is +-- variable PrefixTable : T_INTVEC(0 to str2'length); +-- variable j : INTEGER; +-- begin +-- -- construct prefix table for KMP algorithm +-- j := -1; +-- PrefixTable(0) := -1; +-- for i in str2'range loop +-- while ((j >= 0) and str2(j + 1) /= str2(i)) loop +-- j := PrefixTable(j); +-- end loop; +-- +-- j := j + 1; +-- PrefixTable(i - 1) := j + 1; +-- end loop; +-- +-- -- search pattern str2 in text str1 +-- j := 0; +-- for i in str1'range loop +-- while ((j >= 0) and str1(i) /= str2(j + 1)) loop +-- j := PrefixTable(j); +-- end loop; +-- +-- j := j + 1; +-- if ((j + 1) = str2'high) then +-- return i - str2'length + 1; +-- end if; +-- end loop; +-- +-- return -1; +-- end function; + + -- check if chr exists in STRING str + function str_find(str : string; chr : character) return boolean is + begin + return (str_pos(str, chr) > 0); + end function; + + -- check if pattern exists in STRING str + function str_find(str : string; pattern : string) return boolean is + begin + return (str_pos(str, pattern) > 0); + end function; + + -- check if chr exists in STRING str; case insentitve + function str_ifind(str : string; chr : character) return boolean is + begin + return (str_ipos(str, chr) > 0); + end function; + + -- check if pattern exists in STRING str; case insentitve + function str_ifind(str : string; pattern : string) return boolean is + begin + return (str_ipos(str, pattern) > 0); + end function; + + -- replace a pattern in a STRING str by the STRING replace + function str_replace(str : string; pattern : string; replace : string) return string is + variable pos : integer; + begin + pos := str_pos(str, pattern); + if pos > 0 then + if pos = 1 then + return replace & str(pattern'length + 1 to str'length); + elsif (pos = str'length - pattern'length + 1) then + return str(1 to str'length - pattern'length) & replace; + else + return str(1 to pos - 1) & replace & str(pos + pattern'length to str'length); + end if; + else + return str; + end if; + end function; + + -- return a sub-string of STRING str + -- EXAMPLES: + -- 123456789ABC + -- input string: "Hello World." + -- low=1; high=12; length=12 + -- + -- str_substr("Hello World.", 0, 0) => "Hello World." - copy all + -- str_substr("Hello World.", 7, 0) => "World." - copy from pos 7 to end of string + -- str_substr("Hello World.", 7, 5) => "World" - copy from pos 7 for 5 characters + -- str_substr("Hello World.", 0, -7) => "Hello World." - copy all until character 8 from right boundary + function str_substr(str : string; start : integer := 0; Length : integer := 0) return string is + variable StartOfString : positive; + variable EndOfString : positive; + begin + if start < 0 then -- start is negative -> start substring at right string boundary + StartOfString := str'high + start + 1; + elsif start = 0 then -- start is zero -> start substring at left string boundary + StartOfString := str'low; + else -- start is positive -> start substring at left string boundary + offset + StartOfString := start; + end if; + + if Length < 0 then -- Length is negative -> end substring at length'th character before right string boundary + EndOfString := str'high + Length; + elsif Length = 0 then -- Length is zero -> end substring at right string boundary + EndOfString := str'high; + else -- Length is positive -> end substring at StartOfString + Length + EndOfString := StartOfString + Length - 1; + end if; + + if (StartOfString < str'low) then report "StartOfString is out of str's range. (str=" & str & ")" severity FAILURE; end if; + if (EndOfString < str'high) then report "EndOfString is out of str's range. (str=" & str & ")" severity FAILURE; end if; + + return str(StartOfString to EndOfString); + end function; + + -- left-trim the STRING str + function str_ltrim(str : string; char : character := ' ') return string is + begin + for i in str'range loop + if str(i) /= char then + return str(i to str'high); + end if; + end loop; + return ""; + end function; + + -- right-trim the STRING str + function str_rtrim(str : string; char : character := ' ') return string is + begin + for i in str'reverse_range loop + if str(i) /= char then + return str(str'low to i); + end if; + end loop; + return ""; + end function; + + -- remove POC_NUL string termination characters + function str_trim(str : string) return string is + begin + return str(str'low to str'low + str_length(str) - 1); + end function; + + -- center-align a STRING str in a FillChar filled STRING of length Length + function str_calign(str : string; Length : natural; FillChar : character := ' ') return string is + constant Start : positive := (Length - str'length) / 2; + variable Result : string(1 to Length); + begin + Result := (others => FillChar); + Result(Start to (Start + str'length)) := str; + return Result; + end function; + + -- left-align a STRING str in a FillChar filled STRING of length Length + function str_lalign(str : string; Length : natural; FillChar : character := ' ') return string is + variable Result : string(1 to Length); + begin + Result := (others => FillChar); + Result(1 to str'length) := str; + return Result; + end function; + + -- right-align a STRING str in a FillChar filled STRING of length Length + function str_ralign(str : string; Length : natural; FillChar : character := ' ') return string is + variable Result : string(1 to Length); + begin + Result := (others => FillChar); + Result((Length - str'length + 1) to Length) := str; + return Result; + end function; + + -- convert an upper case STRING into a lower case STRING + function str_toLower(str : string) return string is + variable Result : string(str'range); + begin + for i in str'range loop + Result(i) := chr_toLower(str(i)); + end loop; + return Result; + end function; + + -- convert a lower case STRING into an upper case STRING + function str_toUpper(str : string) return string is + variable Result : string(str'range); + begin + for i in str'range loop + Result(i) := chr_toUpper(str(i)); + end loop; + return Result; + end function; + +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/utils.vhdl b/testsuite/gna/issue317/PoC/src/common/utils.vhdl new file mode 100644 index 000000000..d9acc0fc1 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/utils.vhdl @@ -0,0 +1,1127 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Thomas B. Preusser +-- Martin Zabel +-- Patrick Lehmann +-- Paul Genssler +-- +-- Package: Common functions and types +-- +-- Description: +-- ------------------------------------- +-- For detailed documentation see below. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; +use IEEE.math_real.all; + +package utils is + + -- Environment + -- ========================================================================== + -- Distinguishes simulation from synthesis + constant SIMULATION : boolean; -- deferred constant declaration + + -- Type declarations + -- ========================================================================== + + --+ Vectors of primitive standard types +++++++++++++++++++++++++++++++++++++ + type T_BOOLVEC is array(natural range <>) of boolean; + type T_INTVEC is array(natural range <>) of integer; + type T_NATVEC is array(natural range <>) of natural; + type T_POSVEC is array(natural range <>) of positive; + type T_REALVEC is array(natural range <>) of REAL; + + --+ Integer subranges sometimes useful for speeding up simulation ++++++++++ + subtype T_INT_8 is integer range -128 to 127; + subtype T_INT_16 is integer range -32768 to 32767; + subtype T_UINT_8 is integer range 0 to 255; + subtype T_UINT_16 is integer range 0 to 65535; + + --+ Enums ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + -- Intellectual Property (IP) type + type T_IPSTYLE is (IPSTYLE_UNKNOWN, IPSTYLE_HARD, IPSTYLE_SOFT); + + -- Bit Order + type T_BIT_ORDER is (LSB_FIRST, MSB_FIRST); + + -- Byte Order (Endian) + type T_BYTE_ORDER is (LITTLE_ENDIAN, BIG_ENDIAN); + + -- rounding style + type T_ROUNDING_STYLE is (ROUND_TO_NEAREST, ROUND_TO_ZERO, ROUND_TO_INF, ROUND_UP, ROUND_DOWN); + + -- define a new unrelated type T_BCD for arithmetic + -- QUESTION: extract to an own BCD package? + -- => overloaded operators for +/-/=/... and conversion functions + type T_BCD is array(3 downto 0) of std_logic; + type T_BCD_VECTOR is array(natural range <>) of T_BCD; + constant C_BCD_MINUS : T_BCD := "1010"; + constant C_BCD_OFF : T_BCD := "1011"; + + + -- Function declarations + -- ========================================================================== + + --+ Division ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + -- Calculates: ceil(a / b) + function div_ceil(a : natural; b : positive) return natural; + + --+ Power +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + -- is input a power of 2? + function is_pow2(int : natural) return boolean; + -- round to next power of 2 + function ceil_pow2(int : natural) return positive; + -- round to previous power of 2 + function floor_pow2(int : natural) return natural; + + --+ Logarithm ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + -- Calculates: ceil(ld(arg)) + function log2ceil(arg : positive) return natural; + -- Calculates: max(1, ceil(ld(arg))) + function log2ceilnz(arg : positive) return positive; + -- Calculates: ceil(lg(arg)) + function log10ceil(arg : positive) return natural; + -- Calculates: max(1, ceil(lg(arg))) + function log10ceilnz(arg : positive) return positive; + + --+ if-then-else (ite) +++++++++++++++++++++++++++++++++++++++++++++++++++++ + function ite(cond : boolean; value1 : boolean; value2 : boolean) return boolean; + function ite(cond : boolean; value1 : integer; value2 : integer) return integer; + function ite(cond : boolean; value1 : REAL; value2 : REAL) return REAL; + function ite(cond : boolean; value1 : std_logic; value2 : std_logic) return std_logic; + function ite(cond : boolean; value1 : std_logic_vector; value2 : std_logic_vector) return std_logic_vector; + function ite(cond : boolean; value1 : bit_vector; value2 : bit_vector) return bit_vector; + function ite(cond : boolean; value1 : unsigned; value2 : unsigned) return unsigned; + function ite(cond : boolean; value1 : character; value2 : character) return character; + function ite(cond : boolean; value1 : string; value2 : string) return string; + + -- conditional increment / decrement + function inc_if(cond : boolean; value : integer; increment : integer := 1) return integer; + function dec_if(cond : boolean; value : integer; decrement : integer := 1) return integer; + + --+ Max / Min / Sum ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + function imin(arg1 : integer; arg2 : integer) return integer; -- Calculates: min(arg1, arg2) for integers + alias rmin is IEEE.math_real.realmin[real, real return real]; + -- function rmin(arg1 : real; arg2 : real) return real; -- Calculates: min(arg1, arg2) for reals + + function imin(vec : T_INTVEC) return integer; -- Calculates: min(vec) for a integer vector + function imin(vec : T_NATVEC) return natural; -- Calculates: min(vec) for a natural vector + function imin(vec : T_POSVEC) return positive; -- Calculates: min(vec) for a positive vector + function rmin(vec : T_REALVEC) return real; -- Calculates: min(vec) of real vector + + function imax(arg1 : integer; arg2 : integer) return integer; -- Calculates: max(arg1, arg2) for integers + alias rmax is IEEE.math_real.realmax[real, real return real]; + -- function rmax(arg1 : real; arg2 : real) return real; -- Calculates: max(arg1, arg2) for reals + + function imax(vec : T_INTVEC) return integer; -- Calculates: max(vec) for a integer vector + function imax(vec : T_NATVEC) return natural; -- Calculates: max(vec) for a natural vector + function imax(vec : T_POSVEC) return positive; -- Calculates: max(vec) for a positive vector + function rmax(vec : T_REALVEC) return real; -- Calculates: max(vec) of real vector + + function isum(vec : T_NATVEC) return natural; -- Calculates: sum(vec) for a natural vector + function isum(vec : T_POSVEC) return natural; -- Calculates: sum(vec) for a positive vector + function isum(vec : T_INTVEC) return integer; -- Calculates: sum(vec) of integer vector + function rsum(vec : T_REALVEC) return real; -- Calculates: sum(vec) of real vector + + --+ Conversions ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + -- to integer: to_int + function to_int(bool : boolean; zero : integer := 0; one : integer := 1) return integer; + function to_int(sl : std_logic; zero : integer := 0; one : integer := 1) return integer; + + -- to std_logic: to_sl + function to_sl(Value : boolean) return std_logic; + function to_sl(Value : character) return std_logic; + + -- to std_logic_vector: to_slv + function to_slv(Value : natural; Size : positive) return std_logic_vector; -- short for std_logic_vector(to_unsigned(Value, Size)) + + function to_BCD(Digit : integer) return T_BCD; + function to_BCD(Digit : character) return T_BCD; + function to_BCD(Digit : unsigned) return T_BCD; + function to_BCD(Digit : std_logic_vector) return T_BCD; + function to_BCD_Vector(Value : integer; Size : natural := 0; Fill : T_BCD := x"0") return T_BCD_VECTOR; + function to_BCD_Vector(Value : string; Size : natural := 0; Fill : T_BCD := x"0") return T_BCD_VECTOR; + + -- TODO: comment + function bound(index : integer; lowerBound : integer; upperBound : integer) return integer; + function to_index(slv : unsigned; max : natural := 0) return integer; + function to_index(slv : std_logic_vector; max : natural := 0) return integer; + + -- is_* + function is_sl(c : character) return boolean; + + --+ Basic Vector Utilities +++++++++++++++++++++++++++++++++++++++++++++++++ + + -- Aggregate functions + function slv_or (vec : std_logic_vector) return std_logic; + function slv_nor (vec : std_logic_vector) return std_logic; + function slv_and (vec : std_logic_vector) return std_logic; + function slv_nand(vec : std_logic_vector) return std_logic; + function slv_xor (vec : std_logic_vector) return std_logic; + -- NO slv_xnor! This operation would not be well-defined as + -- not xor(vec) /= vec_{n-1} xnor ... xnor vec_1 xnor vec_0 iff n is odd. + + -- Reverses the elements of the passed Vector. + -- + -- @synthesis supported + -- + function reverse(vec : std_logic_vector) return std_logic_vector; + function reverse(vec : bit_vector) return bit_vector; + function reverse(vec : unsigned) return unsigned; + + -- scale a value into a range [Minimum, Maximum] + function scale(Value : integer; Minimum : integer; Maximum : integer; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer; + function scale(Value : REAL; Minimum : integer; Maximum : integer; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer; + function scale(Value : REAL; Minimum : REAL; Maximum : REAL) return REAL; + + -- Resizes the vector to the specified length. The adjustment is make on + -- on the 'high end of the vector. The 'low index remains as in the argument. + -- If the result vector is larger, the extension uses the provided fill value + -- (default: '0'). + -- Use the resize functions of the numeric_std package for value-preserving + -- resizes of the signed and unsigned data types. + -- + -- @synthesis supported + -- + function resize(vec : bit_vector; length : natural; fill : bit := '0') + return bit_vector; + function resize(vec : std_logic_vector; length : natural; fill : std_logic := '0') + return std_logic_vector; + + -- Shift the index range of a vector by the specified offset. + function move(vec : std_logic_vector; ofs : integer) return std_logic_vector; + + -- Shift the index range of a vector making vec'low = 0. + function movez(vec : std_logic_vector) return std_logic_vector; + + function ascend(vec : std_logic_vector) return std_logic_vector; + function descend(vec : std_logic_vector) return std_logic_vector; + + -- Least-Significant Set Bit (lssb): + -- Computes a vector of the same length as the argument with + -- at most one bit set at the rightmost '1' found in arg. + -- + -- @synthesis supported + -- + function lssb(arg : std_logic_vector) return std_logic_vector; + function lssb(arg : bit_vector) return bit_vector; + + -- Returns the index of the least-significant set bit. + -- + -- @synthesis supported + -- + function lssb_idx(arg : std_logic_vector) return integer; + function lssb_idx(arg : bit_vector) return integer; + + -- Most-Significant Set Bit (mssb): computes a vector of the same length + -- with at most one bit set at the leftmost '1' found in arg. + function mssb(arg : std_logic_vector) return std_logic_vector; + function mssb(arg : bit_vector) return bit_vector; + function mssb_idx(arg : std_logic_vector) return integer; + function mssb_idx(arg : bit_vector) return integer; + + -- Swap sub vectors in vector (endian reversal) + function swap(slv : std_logic_vector; Size : positive) return std_logic_vector; + + -- Swap the bits in a chunk + function bit_swap(slv : std_logic_vector; Chunksize : positive) return std_logic_vector; + + -- generate bit masks + function genmask_high(Bits : natural; MaskLength : positive) return std_logic_vector; + function genmask_low(Bits : natural; MaskLength : positive) return std_logic_vector; + function genmask_alternate(len : positive; lsb : std_logic := '0') return std_logic_vector; + + --+ Encodings ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + -- One-Hot-Code to Binary-Code. + -- If a non-negative value empty_val is specified, its unsigned + -- representation will be returned upon an all-zero input. As a consequence + -- of specifying this value, no simulation warnings will be issued upon empty + -- inputs. Alleged 1-hot-encoded inputs with more than one bit asserted + -- will always raise a simulation warning. + function onehot2bin(onehot : std_logic_vector; empty_val : integer := -1) return unsigned; + + -- Converts Gray-Code into Binary-Code. + -- + -- @synthesis supported + -- + function gray2bin (gray_val : std_logic_vector) return std_logic_vector; + + -- Binary-Code to One-Hot-Code + function bin2onehot(value : std_logic_vector) return std_logic_vector; + + -- Binary-Code to Gray-Code + function bin2gray(value : std_logic_vector) return std_logic_vector; + +end package; + + +package body utils is + + -- Environment + -- ========================================================================== + function is_simulation return boolean is + variable ret : boolean; + begin + ret := false; + -- WORKAROUND: for Xilinx ISE + -- Version: all versions with enabled 'use_new_parser' option + -- Issue: Is_X('X') does not evaluate to FALSE in synthesis + -- Solution: Use '--synthesis translate_on/off' pragmas + --synthesis translate_off + if Is_X('X') then ret := true; end if; + --synthesis translate_on + return ret; + end function; + + -- deferred constant assignment + constant SIMULATION : boolean := is_simulation; + + -- Divisions: div_* + -- =========================================================================== + -- integer division; always round-up + function div_ceil(a : natural; b : positive) return natural is -- calculates: ceil(a / b) + begin + return (a + (b - 1)) / b; + end function; + + -- Power functions: *_pow2 + -- ========================================================================== + -- return TRUE, if input is a power of 2 + function is_pow2(int : natural) return boolean is + begin + return ceil_pow2(int) = int; + end function; + + -- round to next power of 2 + function ceil_pow2(int : natural) return positive is + begin + return 2 ** log2ceil(int); + end function; + + -- round to previous power of 2 + function floor_pow2(int : natural) return natural is + variable temp : unsigned(30 downto 0); + begin + temp := to_unsigned(int, 31); + for i in temp'range loop + if (temp(i) = '1') then + return 2 ** i; + end if; + end loop; + return 0; + end function; + + -- Logarithms: log*ceil* + -- ========================================================================== + -- return log2; always rounded up + function log2ceil(arg : positive) return natural is + variable tmp : positive; + variable log : natural; + begin + if arg = 1 then return 0; end if; + tmp := 1; + log := 0; + while arg > tmp loop + tmp := tmp * 2; + log := log + 1; + end loop; + return log; + end function; + + -- return log2; always rounded up; the return value is >= 1 + function log2ceilnz(arg : positive) return positive is + begin + return imax(1, log2ceil(arg)); + end function; + + -- return log10; always rounded up + function log10ceil(arg : positive) return natural is + variable tmp : positive; + variable log : natural; + begin + if arg = 1 then return 0; end if; + tmp := 1; + log := 0; + while arg > tmp loop + tmp := tmp * 10; + log := log + 1; + end loop; + return log; + end function; + + -- return log2; always rounded up; the return value is >= 1 + function log10ceilnz(arg : positive) return positive is + begin + return imax(1, log10ceil(arg)); + end function; + + -- if-then-else (ite) + -- ========================================================================== + function ite(cond : boolean; value1 : boolean; value2 : boolean) return boolean is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : integer; value2 : integer) return integer is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : REAL; value2 : REAL) return REAL is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : std_logic; value2 : std_logic) return std_logic is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : std_logic_vector; value2 : std_logic_vector) return std_logic_vector is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : bit_vector; value2 : bit_vector) return bit_vector is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : unsigned; value2 : unsigned) return unsigned is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : character; value2 : character) return character is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + function ite(cond : boolean; value1 : string; value2 : string) return string is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + -- conditional increment / decrement + -- =========================================================================== + -- return the by increment incremented Value if cond is true else passthrough Value + function inc_if(cond : boolean; Value : integer; increment : integer := 1) return integer is + begin + if cond then + return Value + increment; + else + return Value; + end if; + end function; + + -- return the by decrement decremented Value if cond is true else passthrough Value + function dec_if(cond : boolean; Value : integer; decrement : integer := 1) return integer is + begin + if cond then + return Value - decrement; + else + return Value; + end if; + end function; + + -- *min / *max / *sum + -- =========================================================================== + function imin(arg1 : integer; arg2 : integer) return integer is + begin + if arg1 < arg2 then return arg1; end if; + return arg2; + end function; + + -- function rmin(arg1 : real; arg2 : real) return real is + -- begin + -- if arg1 < arg2 then return arg1; end if; + -- return arg2; + -- end function; + + function imin(vec : T_INTVEC) return integer is + variable Result : integer; + begin + Result := integer'high; + for i in vec'range loop + if vec(i) < Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function imin(vec : T_NATVEC) return natural is + variable Result : natural; + begin + Result := natural'high; + for i in vec'range loop + if vec(i) < Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function imin(vec : T_POSVEC) return positive is + variable Result : positive; + begin + Result := positive'high; + for i in vec'range loop + if vec(i) < Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function rmin(vec : T_REALVEC) return REAL is + variable Result : REAL; + begin + Result := REAL'high; + for i in vec'range loop + if vec(i) < Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function imax(arg1 : integer; arg2 : integer) return integer is + begin + if arg1 > arg2 then return arg1; end if; + return arg2; + end function; + + -- function rmax(arg1 : real; arg2 : real) return real is + -- begin + -- if arg1 > arg2 then return arg1; end if; + -- return arg2; + -- end function; + + function imax(vec : T_INTVEC) return integer is + variable Result : integer; + begin + Result := integer'low; + for i in vec'range loop + if vec(i) > Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function imax(vec : T_NATVEC) return natural is + variable Result : natural; + begin + Result := natural'low; + for i in vec'range loop + if vec(i) > Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function imax(vec : T_POSVEC) return positive is + variable Result : positive; + begin + Result := positive'low; + for i in vec'range loop + if vec(i) > Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function rmax(vec : T_REALVEC) return REAL is + variable Result : REAL; + begin + Result := REAL'low; + for i in vec'range loop + if vec(i) > Result then + Result := vec(i); + end if; + end loop; + return Result; + end function; + + function isum(vec : T_INTVEC) return integer is + variable Result : integer; + begin + Result := 0; + for i in vec'range loop + Result := Result + vec(i); + end loop; + return Result; + end function; + + function isum(vec : T_NATVEC) return natural is + variable Result : natural; + begin + Result := 0; + for i in vec'range loop + Result := Result + vec(i); + end loop; + return Result; + end function; + + function isum(vec : T_POSVEC) return natural is + variable Result : natural; + begin + Result := 0; + for i in vec'range loop + Result := Result + vec(i); + end loop; + return Result; + end function; + + function rsum(vec : T_REALVEC) return REAL is + variable Result : REAL; + begin + Result := 0.0; + for i in vec'range loop + Result := Result + vec(i); + end loop; + return Result; + end function; + + -- Vector aggregate functions: slv_* + -- ========================================================================== + function slv_or(vec : std_logic_vector) return std_logic is + variable Result : std_logic; + begin + Result := '0'; + for i in vec'range loop + Result := Result or vec(i); + end loop; + return Result; + end function; + + function slv_nor(vec : std_logic_vector) return std_logic is + begin + return not slv_or(vec); + end function; + + function slv_and(vec : std_logic_vector) return std_logic is + variable Result : std_logic; + begin + Result := '1'; + for i in vec'range loop + Result := Result and vec(i); + end loop; + return Result; + end function; + + function slv_nand(vec : std_logic_vector) return std_logic is + begin + return not slv_and(vec); + end function; + + function slv_xor(vec : std_logic_vector) return std_logic is + variable res : std_logic; + begin + res := '0'; + for i in vec'range loop + res := res xor vec(i); + end loop; + return res; + end function; + + -- =========================================================================== + -- Type conversion + -- =========================================================================== + -- Convert to integer: to_int + function to_int(bool : boolean; zero : integer := 0; one : integer := 1) return integer is + begin + return ite(bool, one, zero); + end function; + + function to_int(sl : std_logic; zero : integer := 0; one : integer := 1) return integer is + begin + if (sl = '1') then + return one; + end if; + return zero; + end function; + + -- Convert to bit: to_sl + -- =========================================================================== + function to_sl(Value : boolean) return std_logic is + begin + return ite(Value, '1', '0'); + end function; + + function to_sl(Value : character) return std_logic is + begin + case Value is + when 'U' => return 'U'; + when '0' => return '0'; + when '1' => return '1'; + when 'Z' => return 'Z'; + when 'W' => return 'W'; + when 'L' => return 'L'; + when 'H' => return 'H'; + when '-' => return '-'; + when others => return 'X'; + end case; + end function; + + -- Convert to vector: to_slv + -- =========================================================================== + -- short for std_logic_vector(to_unsigned(Value, Size)) + -- the return value is guaranteed to have the range (Size-1 downto 0) + function to_slv(Value : natural; Size : positive) return std_logic_vector is + constant res : std_logic_vector(Size-1 downto 0) := std_logic_vector(to_unsigned(Value, Size)); + begin + return res; + end function; + + -- Convert to T_BCD or T_BCD_VECTOR: to_BCD* + -- =========================================================================== + function to_BCD(Digit : integer) return T_BCD is + begin + return T_BCD(to_unsigned(Digit, T_BCD'length)); + end function; + + function to_BCD(Digit : character) return T_BCD is + begin + return T_BCD(to_unsigned((character'pos(Digit) - CHARACTER'pos('0')), T_BCD'length)); + end function; + + function to_BCD(Digit : unsigned) return T_BCD is + begin + return T_BCD(Digit); + end function; + + function to_BCD(Digit : std_logic_vector) return T_BCD is + begin + return T_BCD(Digit); + end function; + + function to_BCD_Vector(Value : integer; Size : natural := 0; Fill : T_BCD := x"0") return T_BCD_VECTOR is + begin + return to_BCD_Vector(integer'image(Value), Size, Fill); + end function; + + function to_BCD_Vector(Value : string; Size : natural := 0; Fill : T_BCD := x"0") return T_BCD_VECTOR is + variable Result : T_BCD_VECTOR(Size - 1 downto 0); + begin + Result := (others => Fill); + for i in Value'range loop + Result(Value'length - (i - Value'low) - 1) := to_BCD(Value(i)); + end loop; + return Result; + end function; + + -- bound array indices for simulation, to prevent out of range errors + function bound(index : integer; lowerBound : integer; upperBound : integer) return integer is + begin + if index < lowerBound then + return lowerBound; + elsif upperBound < index then + return upperBound; + else + return index; + end if; + end function; + + function to_index(slv : unsigned; max : natural := 0) return integer is + variable res : integer; + begin + if (slv'length = 0) then return 0; end if; + + res := to_integer(slv); + if SIMULATION and max > 0 then + res := imin(res, max); + end if; + return res; + end function; + + -- bound array indices for simulation, to prevent out of range errors + function to_index(slv : std_logic_vector; max : natural := 0) return integer is + begin + return to_index(unsigned(slv), max); + end function; + + -- is_* + -- =========================================================================== + function is_sl(c : character) return boolean is + begin + case c is + when 'U'|'X'|'0'|'1'|'Z'|'W'|'L'|'H'|'-' => return true; + when others => return false; + end case; + end function; + + + -- Reverse vector elements + function reverse(vec : std_logic_vector) return std_logic_vector is + variable res : std_logic_vector(vec'range); + begin + for i in vec'low to vec'high loop + res(vec'low + (vec'high-i)) := vec(i); + end loop; + return res; + end function; + + function reverse(vec : bit_vector) return bit_vector is + variable res : bit_vector(vec'range); + begin + res := to_bitvector(reverse(to_stdlogicvector(vec))); + return res; + end function; + + function reverse(vec : unsigned) return unsigned is + begin + return unsigned(reverse(std_logic_vector(vec))); + end function; + + + -- Swap sub vectors in vector + -- ========================================================================== + function swap(slv : std_logic_vector; Size : positive) return std_logic_vector is + constant SegmentCount : natural := slv'length / Size; + variable FromH : natural; + variable FromL : natural; + variable ToH : natural; + variable ToL : natural; + variable Result : std_logic_vector(slv'length - 1 downto 0); + begin + for i in 0 to SegmentCount - 1 loop + FromH := ((i + 1) * Size) - 1; + FromL := i * Size; + ToH := ((SegmentCount - i) * Size) - 1; + ToL := (SegmentCount - i - 1) * Size; + Result(ToH downto ToL) := slv(FromH downto FromL); + end loop; + return Result; + end function; + + + -- Swap the bits in a chunk + -- ========================================================================== + function bit_swap(slv : std_logic_vector; Chunksize : positive) return std_logic_vector is + constant SegmentCount : natural := slv'length / Chunksize; + variable FromH : natural; + variable FromL : natural; + variable Result : std_logic_vector(slv'length - 1 downto 0); + begin + for i in 0 to SegmentCount - 1 loop + FromH := ((i + 1) * Chunksize) - 1; + FromL := i * Chunksize; + Result(FromH downto FromL) := reverse(slv(FromH downto FromL)); + end loop; + return Result; + end function; + + + -- generate bit masks + -- ========================================================================== + function genmask_high(Bits : natural; MaskLength : positive) return std_logic_vector is + begin + if Bits = 0 then + return (MaskLength - 1 downto 0 => '0'); + else + return (MaskLength - 1 downto MaskLength - Bits + 1 => '1') & (MaskLength - Bits downto 0 => '0'); + end if; + end function; + + function genmask_low(Bits : natural; MaskLength : positive) return std_logic_vector is + begin + if Bits = 0 then + return (MaskLength - 1 downto 0 => '0'); + else + return (MaskLength - 1 downto Bits => '0') & (Bits - 1 downto 0 => '1'); + end if; + end function; + + function genmask_alternate(len : positive; lsb : std_logic := '0') return std_logic_vector is + variable curr : std_logic; + variable res : std_logic_vector(len-1 downto 0); + begin + curr := lsb; + for i in res'reverse_range loop + res(i) := curr; + curr := not curr; + end loop; + return res; + end function; + + -- binary encoding conversion functions + -- ========================================================================== + -- One-Hot-Code to Binary-Code + function onehot2bin(onehot : std_logic_vector; empty_val : integer := -1) return unsigned is + variable res : unsigned(log2ceilnz(imax(onehot'high, empty_val)+1)-1 downto 0); + variable chk : natural; + begin + -- Note: empty_val = 0 takes the regular path to reduce on synthesized hardware + if empty_val > 0 and onehot = (onehot'range => '0') then + res := to_unsigned(empty_val, res'length); + else + res := (others => '0'); + chk := 0; + for i in onehot'range loop + if onehot(i) = '1' then + res := res or to_unsigned(i, res'length); + chk := chk + 1; + end if; + end loop; + + if SIMULATION and chk /= 1 and (chk > 1 or empty_val < 0) then + report "Broken 1-Hot-Code with "&integer'image(chk)&" bits set." + severity warning; + res := (others => 'X'); -- computed result is implementation-dependant + end if; + end if; + return res; + end function; + + -- Gray-Code to Binary-Code + function gray2bin(gray_val : std_logic_vector) return std_logic_vector is + variable tmp : std_logic_vector(gray_val'length downto 0); + variable res : std_logic_vector(gray_val'range); + begin + tmp := '0' & gray_val; + for i in tmp'left-1 downto 0 loop + tmp(i) := tmp(i+1) xor tmp(i); + end loop; + res := tmp(tmp'left-1 downto 0); + return res; + end function; + + -- Binary-Code to One-Hot-Code + function bin2onehot(Value : std_logic_vector) return std_logic_vector is + variable result : std_logic_vector(2**Value'length - 1 downto 0); + begin + result := (others => '0'); + result(to_index(Value, 0)) := '1'; + return result; + end function; + + -- Binary-Code to Gray-Code + function bin2gray(Value : std_logic_vector) return std_logic_vector is + variable tmp : std_logic_vector(Value'length downto 0); + variable res : std_logic_vector(Value'range); + begin + tmp := ('0' & Value) xor (Value & '0'); + res := tmp(Value'length downto 1); + return res; + end function; + + -- bit searching / bit indices + -- ========================================================================== + -- Least-Significant Set Bit (lssb): computes a vector of the same length with at most one bit set at the rightmost '1' found in arg. + function lssb(arg : std_logic_vector) return std_logic_vector is + variable res : std_logic_vector(arg'range); + begin + res := arg and std_logic_vector(unsigned(not arg)+1); + return res; + end function; + + function lssb(arg : bit_vector) return bit_vector is + variable res : bit_vector(arg'range); + begin + res := to_bitvector(lssb(to_stdlogicvector(arg))); + return res; + end function; + + -- Most-Significant Set Bit (mssb): computes a vector of the same length with at most one bit set at the leftmost '1' found in arg. + function mssb(arg : std_logic_vector) return std_logic_vector is + begin + return reverse(lssb(reverse(arg))); + end function; + + function mssb(arg : bit_vector) return bit_vector is + begin + return reverse(lssb(reverse(arg))); + end function; + + -- Index of lssb + function lssb_idx(arg : std_logic_vector) return integer is + begin + return to_integer(onehot2bin(lssb(arg))); + end function; + + function lssb_idx(arg : bit_vector) return integer is + variable slv : std_logic_vector(arg'range); + begin + slv := to_stdlogicvector(arg); + return lssb_idx(slv); + end function; + + -- Index of mssb + function mssb_idx(arg : std_logic_vector) return integer is + begin + return to_integer(onehot2bin(mssb(arg))); + end function; + + function mssb_idx(arg : bit_vector) return integer is + variable slv : std_logic_vector(arg'range); + begin + slv := to_stdlogicvector(arg); + return mssb_idx(slv); + end function; + + -- scale a value into a given range + function scale(Value : integer; Minimum : integer; Maximum : integer; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer is + begin + return scale(real(Value), Minimum, Maximum, RoundingStyle); + end function; + + function scale(Value : REAL; Minimum : integer; Maximum : integer; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return integer is + variable Result : REAL; + begin + if Maximum < Minimum then + return integer'low; + else + Result := real(Value) * ((real(Maximum) + 0.5) - (real(Minimum) - 0.5)) + (real(Minimum) - 0.5); + case RoundingStyle is + when ROUND_TO_NEAREST => return integer(round(Result)); + when ROUND_TO_ZERO => report "scale: unsupported RoundingStyle." severity FAILURE; + when ROUND_TO_INF => report "scale: unsupported RoundingStyle." severity FAILURE; + when ROUND_UP => return integer(ceil(Result)); + when ROUND_DOWN => return integer(floor(Result)); + when others => report "scale: unsupported RoundingStyle." severity FAILURE; + end case; + return integer(Result); + end if; + end function; + + function scale(Value : REAL; Minimum : REAL; Maximum : REAL) return REAL is + begin + if Maximum < Minimum then + return REAL'low; + else + return Value * (Maximum - Minimum) + Minimum; + end if; + end function; + + function resize(vec : bit_vector; length : natural; fill : bit := '0') return bit_vector is + constant high2b : natural := vec'low+length-1; + constant highcp : natural := imin(vec'high, high2b); + variable res_up : bit_vector(vec'low to high2b); + variable res_dn : bit_vector(high2b downto vec'low); + begin + if vec'ascending then + res_up := (others => fill); + res_up(vec'low to highcp) := vec(vec'low to highcp); + return res_up; + else + res_dn := (others => fill); + res_dn(highcp downto vec'low) := vec(highcp downto vec'low); + return res_dn; + end if; + end function; + + function resize(vec : std_logic_vector; length : natural; fill : std_logic := '0') return std_logic_vector is + constant high2b : natural := vec'low+length-1; + constant highcp : natural := imin(vec'high, high2b); + variable res_up : std_logic_vector(vec'low to high2b); + variable res_dn : std_logic_vector(high2b downto vec'low); + begin + if vec'ascending then + res_up := (others => fill); + res_up(vec'low to highcp) := vec(vec'low to highcp); + return res_up; + else + res_dn := (others => fill); + res_dn(highcp downto vec'low) := vec(highcp downto vec'low); + return res_dn; + end if; + end function; + + -- Move vector boundaries + -- ========================================================================== + function move(vec : std_logic_vector; ofs : integer) return std_logic_vector is + variable res_up : std_logic_vector(vec'low +ofs to vec'high+ofs); + variable res_dn : std_logic_vector(vec'high+ofs downto vec'low +ofs); + begin + if vec'ascending then + res_up := vec; + return res_up; + else + res_dn := vec; + return res_dn; + end if; + end function; + + function movez(vec : std_logic_vector) return std_logic_vector is + begin + return move(vec, -vec'low); + end function; + + function ascend(vec : std_logic_vector) return std_logic_vector is + variable res : std_logic_vector(vec'low to vec'high); + begin + res := vec; + return res; + end function; + + function descend(vec : std_logic_vector) return std_logic_vector is + variable res : std_logic_vector(vec'high downto vec'low); + begin + res := vec; + return res; + end function; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/common/vectors.vhdl b/testsuite/gna/issue317/PoC/src/common/vectors.vhdl new file mode 100644 index 000000000..74ed0e579 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/common/vectors.vhdl @@ -0,0 +1,1035 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Thomas B. Preusser +-- Martin Zabel +-- Patrick Lehmann +-- +-- Package: Common functions and types +-- +-- Description: +-- ------------------------------------- +-- For detailed documentation see below. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; + +library PoC; +use PoC.utils.all; +use PoC.strings.all; + + +package vectors is + -- ========================================================================== + -- Type declarations + -- ========================================================================== + -- STD_LOGIC_VECTORs + subtype T_SLV_2 is std_logic_vector(1 downto 0); + subtype T_SLV_3 is std_logic_vector(2 downto 0); + subtype T_SLV_4 is std_logic_vector(3 downto 0); + subtype T_SLV_8 is std_logic_vector(7 downto 0); + subtype T_SLV_12 is std_logic_vector(11 downto 0); + subtype T_SLV_16 is std_logic_vector(15 downto 0); + subtype T_SLV_24 is std_logic_vector(23 downto 0); + subtype T_SLV_32 is std_logic_vector(31 downto 0); + subtype T_SLV_48 is std_logic_vector(47 downto 0); + subtype T_SLV_64 is std_logic_vector(63 downto 0); + subtype T_SLV_96 is std_logic_vector(95 downto 0); + subtype T_SLV_128 is std_logic_vector(127 downto 0); + subtype T_SLV_256 is std_logic_vector(255 downto 0); + subtype T_SLV_512 is std_logic_vector(511 downto 0); + + -- STD_LOGIC_VECTOR_VECTORs + -- type T_SLVV is array(NATURAL range <>) of STD_LOGIC_VECTOR; -- VHDL 2008 syntax - not yet supported by Xilinx + type T_SLVV_2 is array(natural range <>) of T_SLV_2; + type T_SLVV_3 is array(natural range <>) of T_SLV_3; + type T_SLVV_4 is array(natural range <>) of T_SLV_4; + type T_SLVV_8 is array(natural range <>) of T_SLV_8; + type T_SLVV_12 is array(natural range <>) of T_SLV_12; + type T_SLVV_16 is array(natural range <>) of T_SLV_16; + type T_SLVV_24 is array(natural range <>) of T_SLV_24; + type T_SLVV_32 is array(natural range <>) of T_SLV_32; + type T_SLVV_48 is array(natural range <>) of T_SLV_48; + type T_SLVV_64 is array(natural range <>) of T_SLV_64; + type T_SLVV_128 is array(natural range <>) of T_SLV_128; + type T_SLVV_256 is array(natural range <>) of T_SLV_256; + type T_SLVV_512 is array(natural range <>) of T_SLV_512; + + -- STD_LOGIC_MATRIXs + type T_SLM is array(natural range <>, natural range <>) of std_logic; + -- ATTENTION: + -- 1. you MUST initialize your matrix signal with 'Z' to get correct simulation results (iSIM, vSIM, ghdl/gtkwave) + -- Example: signal myMatrix : T_SLM(3 downto 0, 7 downto 0) := (others => (others => 'Z')); + -- 2. Xilinx iSIM bug: DON'T use myMatrix'range(n) for n >= 2 + -- myMatrix'range(2) returns always myMatrix'range(1); see work-around notes below + -- + -- USAGE NOTES: + -- dimension 1 => rows - e.g. Words + -- dimension 2 => columns - e.g. Bits/Bytes in a word + -- + -- WORKAROUND: for Xilinx ISE/iSim + -- Version: 14.2 + -- Issue: myMatrix'range(n) for n >= 2 returns always myMatrix'range(1) + + -- ========================================================================== + -- Function declarations + -- ========================================================================== + -- slicing boundary calulations + function low (lenvec : T_POSVEC; index : natural) return natural; + function high(lenvec : T_POSVEC; index : natural) return natural; + + -- Assign procedures: assign_* + procedure assign_row(signal slm : out T_SLM; slv : std_logic_vector; constant RowIndex : natural); -- assign vector to complete row + procedure assign_row(signal slm : out T_SLM; slv : std_logic_vector; constant RowIndex : natural; Position : natural); -- assign short vector to row starting at position + procedure assign_row(signal slm : out T_SLM; slv : std_logic_vector; constant RowIndex : natural; High : natural; Low : natural); -- assign short vector to row in range high:low + procedure assign_col(signal slm : out T_SLM; slv : std_logic_vector; constant ColIndex : natural); -- assign vector to complete column + -- ATTENTION: see T_SLM definition for further details and work-arounds + + -- Matrix to matrix conversion: slm_slice* + function slm_slice(slm : T_SLM; RowIndex : natural; ColIndex : natural; Height : natural; Width : natural) return T_SLM; -- get submatrix in boundingbox RowIndex,ColIndex,Height,Width + function slm_slice_rows(slm : T_SLM; High : natural; Low : natural) return T_SLM; -- get submatrix / all rows in RowIndex range high:low + function slm_slice_cols(slm : T_SLM; High : natural; Low : natural) return T_SLM; -- get submatrix / all columns in ColIndex range high:low + + -- Boolean Operators + function "not" (a : t_slm) return t_slm; + function "and" (a, b : t_slm) return t_slm; + function "or" (a, b : t_slm) return t_slm; + function "xor" (a, b : t_slm) return t_slm; + function "nand"(a, b : t_slm) return t_slm; + function "nor" (a, b : t_slm) return t_slm; + function "xnor"(a, b : t_slm) return t_slm; + + -- Matrix concatenation: slm_merge_* + function slm_merge_rows(slm1 : T_SLM; slm2 : T_SLM) return T_SLM; + function slm_merge_cols(slm1 : T_SLM; slm2 : T_SLM) return T_SLM; + + -- Matrix to vector conversion: get_* + function get_col(slm : T_SLM; ColIndex : natural) return std_logic_vector; -- get a matrix column + function get_row(slm : T_SLM; RowIndex : natural) return std_logic_vector; -- get a matrix row + function get_row(slm : T_SLM; RowIndex : natural; Length : positive) return std_logic_vector; -- get a matrix row of defined length [length - 1 downto 0] + function get_row(slm : T_SLM; RowIndex : natural; High : natural; Low : natural) return std_logic_vector; -- get a sub vector of a matrix row at high:low + + -- Convert to vector: to_slv + function to_slv(slvv : T_SLVV_2) return std_logic_vector; -- convert vector-vector to flatten vector + function to_slv(slvv : T_SLVV_4) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_8) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_12) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_16) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_24) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_32) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_64) return std_logic_vector; -- ... + function to_slv(slvv : T_SLVV_128) return std_logic_vector; -- ... + function to_slv(slm : T_SLM) return std_logic_vector; -- convert matrix to flatten vector + + -- Convert flat vector to avector-vector: to_slvv_* + function to_slvv_4(slv : std_logic_vector) return T_SLVV_4; -- + function to_slvv_8(slv : std_logic_vector) return T_SLVV_8; -- + function to_slvv_12(slv : std_logic_vector) return T_SLVV_12; -- + function to_slvv_16(slv : std_logic_vector) return T_SLVV_16; -- + function to_slvv_32(slv : std_logic_vector) return T_SLVV_32; -- + function to_slvv_64(slv : std_logic_vector) return T_SLVV_64; -- + function to_slvv_128(slv : std_logic_vector) return T_SLVV_128; -- + function to_slvv_256(slv : std_logic_vector) return T_SLVV_256; -- + function to_slvv_512(slv : std_logic_vector) return T_SLVV_512; -- + + -- Convert matrix to avector-vector: to_slvv_* + function to_slvv_4(slm : T_SLM) return T_SLVV_4; -- + function to_slvv_8(slm : T_SLM) return T_SLVV_8; -- + function to_slvv_12(slm : T_SLM) return T_SLVV_12; -- + function to_slvv_16(slm : T_SLM) return T_SLVV_16; -- + function to_slvv_32(slm : T_SLM) return T_SLVV_32; -- + function to_slvv_64(slm : T_SLM) return T_SLVV_64; -- + function to_slvv_128(slm : T_SLM) return T_SLVV_128; -- + function to_slvv_256(slm : T_SLM) return T_SLVV_256; -- + function to_slvv_512(slm : T_SLM) return T_SLVV_512; -- + + -- Convert vector-vector to matrix: to_slm + function to_slm(slv : std_logic_vector; ROWS : positive; COLS : positive) return T_SLM; -- create matrix from vector + function to_slm(slvv : T_SLVV_4) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_8) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_12) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_16) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_32) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_48) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_64) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_128) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_256) return T_SLM; -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_512) return T_SLM; -- create matrix from vector-vector + + -- Change vector direction + function dir(slvv : T_SLVV_8) return T_SLVV_8; + + -- Reverse vector elements + function rev(slvv : T_SLVV_4) return T_SLVV_4; + function rev(slvv : T_SLVV_8) return T_SLVV_8; + function rev(slvv : T_SLVV_12) return T_SLVV_12; + function rev(slvv : T_SLVV_16) return T_SLVV_16; + function rev(slvv : T_SLVV_32) return T_SLVV_32; + function rev(slvv : T_SLVV_64) return T_SLVV_64; + function rev(slvv : T_SLVV_128) return T_SLVV_128; + function rev(slvv : T_SLVV_256) return T_SLVV_256; + function rev(slvv : T_SLVV_512) return T_SLVV_512; + + -- TODO: + function resize(slm : T_SLM; size : positive) return T_SLM; + + -- to_string + function to_string(slvv : T_SLVV_8; sep : character := ':') return string; + function to_string(slm : T_SLM; groups : positive := 4; format : character := 'b') return string; +end package vectors; + + +package body vectors is + -- slicing boundary calulations + -- ========================================================================== + function low(lenvec : T_POSVEC; index : natural) return natural is + variable pos : natural := 0; + begin + for i in lenvec'low to index - 1 loop + pos := pos + lenvec(i); + end loop; + return pos; + end function; + + function high(lenvec : T_POSVEC; index : natural) return natural is + variable pos : natural := 0; + begin + for i in lenvec'low to index loop + pos := pos + lenvec(i); + end loop; + return pos - 1; + end function; + + -- Assign procedures: assign_* + -- ========================================================================== + procedure assign_row(signal slm : out T_SLM; slv : std_logic_vector; constant RowIndex : natural) is + variable temp : std_logic_vector(slm'high(2) downto slm'low(2)); -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + begin + temp := slv; + for i in temp'range loop + slm(RowIndex, i) <= temp(i); + end loop; + end procedure; + + procedure assign_row(signal slm : out T_SLM; slv : std_logic_vector; constant RowIndex : natural; Position : natural) is + variable temp : std_logic_vector(Position + slv'length - 1 downto Position); + begin + temp := slv; + for i in temp'range loop + slm(RowIndex, i) <= temp(i); + end loop; + end procedure; + + procedure assign_row(signal slm : out T_SLM; slv : std_logic_vector; constant RowIndex : natural; High : natural; Low : natural) is + variable temp : std_logic_vector(High downto Low); + begin + temp := slv; + for i in temp'range loop + slm(RowIndex, i) <= temp(i); + end loop; + end procedure; + + procedure assign_col(signal slm : out T_SLM; slv : std_logic_vector; constant ColIndex : natural) is + variable temp : std_logic_vector(slm'range(1)); + begin + temp := slv; + for i in temp'range loop + slm(i, ColIndex) <= temp(i); + end loop; + end procedure; + + -- Matrix to matrix conversion: slm_slice* + -- ========================================================================== + function slm_slice(slm : T_SLM; RowIndex : natural; ColIndex : natural; Height : natural; Width : natural) return T_SLM is + variable Result : T_SLM(Height - 1 downto 0, Width - 1 downto 0) := (others => (others => '0')); + begin + for i in 0 to Height - 1 loop + for j in 0 to Width - 1 loop + Result(i, j) := slm(RowIndex + i, ColIndex + j); + end loop; + end loop; + return Result; + end function; + + function slm_slice_rows(slm : T_SLM; High : natural; Low : natural) return T_SLM is + variable Result : T_SLM(High - Low downto 0, slm'length(2) - 1 downto 0) := (others => (others => '0')); + begin + for i in 0 to High - Low loop + for j in 0 to slm'length(2) - 1 loop + Result(i, j) := slm(Low + i, slm'low(2) + j); + end loop; + end loop; + return Result; + end function; + + function slm_slice_cols(slm : T_SLM; High : natural; Low : natural) return T_SLM is + variable Result : T_SLM(slm'length(1) - 1 downto 0, High - Low downto 0) := (others => (others => '0')); + begin + for i in 0 to slm'length(1) - 1 loop + for j in 0 to High - Low loop + Result(i, j) := slm(slm'low(1) + i, Low + j); + end loop; + end loop; + return Result; + end function; + + -- Boolean Operators + function "not"(a : t_slm) return t_slm is + variable res : t_slm(a'range(1), a'range(2)); + begin + for i in res'range(1) loop + for j in res'range(2) loop + res(i, j) := not a(i, j); + end loop; + end loop; + return res; + end function; + + function "and"(a, b : t_slm) return t_slm is + variable bb, res : t_slm(a'range(1), a'range(2)); + begin + bb := b; + for i in res'range(1) loop + for j in res'range(2) loop + res(i, j) := a(i, j) and bb(i, j); + end loop; + end loop; + return res; + end function; + + function "or"(a, b : t_slm) return t_slm is + variable bb, res : t_slm(a'range(1), a'range(2)); + begin + bb := b; + for i in res'range(1) loop + for j in res'range(2) loop + res(i, j) := a(i, j) or bb(i, j); + end loop; + end loop; + return res; + end function; + + function "xor"(a, b : t_slm) return t_slm is + variable bb, res : t_slm(a'range(1), a'range(2)); + begin + bb := b; + for i in res'range(1) loop + for j in res'range(2) loop + res(i, j) := a(i, j) xor bb(i, j); + end loop; + end loop; + return res; + end function; + + function "nand"(a, b : t_slm) return t_slm is + begin + return not(a and b); + end function; + + function "nor"(a, b : t_slm) return t_slm is + begin + return not(a or b); + end function; + + function "xnor"(a, b : t_slm) return t_slm is + begin + return not(a xor b); + end function; + + -- Matrix concatenation: slm_merge_* + function slm_merge_rows(slm1 : T_SLM; slm2 : T_SLM) return T_SLM is + constant ROWS : positive := slm1'length(1) + slm2'length(1); + constant COLUMNS : positive := slm1'length(2); + variable slm : T_SLM(ROWS - 1 downto 0, COLUMNS - 1 downto 0); + begin + for i in slm1'range(1) loop + for j in slm1'low(2) to slm1'high(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + slm(i, j) := slm1(i, j); + end loop; + end loop; + for i in slm2'range(1) loop + for j in slm2'low(2) to slm2'high(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + slm(slm1'length(1) + i, j) := slm2(i, j); + end loop; + end loop; + return slm; + end function; + + function slm_merge_cols(slm1 : T_SLM; slm2 : T_SLM) return T_SLM is + constant ROWS : positive := slm1'length(1); + constant COLUMNS : positive := slm1'length(2) + slm2'length(2); + variable slm : T_SLM(ROWS - 1 downto 0, COLUMNS - 1 downto 0); + begin + for i in slm1'range(1) loop + for j in slm1'low(2) to slm1'high(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + slm(i, j) := slm1(i, j); + end loop; + for j in slm2'low(2) to slm2'high(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + slm(i, slm1'length(2) + j) := slm2(i, j); + end loop; + end loop; + return slm; + end function; + + + -- Matrix to vector conversion: get_* + -- ========================================================================== + -- get a matrix column + function get_col(slm : T_SLM; ColIndex : natural) return std_logic_vector is + variable slv : std_logic_vector(slm'range(1)); + begin + for i in slm'range(1) loop + slv(i) := slm(i, ColIndex); + end loop; + return slv; + end function; + + -- get a matrix row + function get_row(slm : T_SLM; RowIndex : natural) return std_logic_vector is + variable slv : std_logic_vector(slm'high(2) downto slm'low(2)); -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + begin + for i in slv'range loop + slv(i) := slm(RowIndex, i); + end loop; + return slv; + end function; + + -- get a matrix row of defined length [length - 1 downto 0] + function get_row(slm : T_SLM; RowIndex : natural; Length : positive) return std_logic_vector is + begin + return get_row(slm, RowIndex, (Length - 1), 0); + end function; + + -- get a sub vector of a matrix row at high:low + function get_row(slm : T_SLM; RowIndex : natural; High : natural; Low : natural) return std_logic_vector is + variable slv : std_logic_vector(High downto Low); + begin + for i in slv'range loop + slv(i) := slm(RowIndex, i); + end loop; + return slv; + end function; + + -- Convert to vector: to_slv + -- ========================================================================== + -- convert vector-vector to flatten vector + function to_slv(slvv : T_SLVV_2) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 2) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 2) + 1 downto (i * 2)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_4) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 4) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 4) + 3 downto (i * 4)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_8) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 8) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 8) + 7 downto (i * 8)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_12) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 12) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 12) + 11 downto (i * 12)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_16) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 16) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 16) + 15 downto (i * 16)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_24) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 24) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 24) + 23 downto (i * 24)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_32) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 32) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 32) + 31 downto (i * 32)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_64) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 64) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 64) + 63 downto (i * 64)) := slvv(i); + end loop; + return slv; + end function; + + function to_slv(slvv : T_SLVV_128) return std_logic_vector is + variable slv : std_logic_vector((slvv'length * 128) - 1 downto 0); + begin + for i in slvv'range loop + slv((i * 128) + 127 downto (i * 128)) := slvv(i); + end loop; + return slv; + end function; + + -- convert matrix to flatten vector + function to_slv(slm : T_SLM) return std_logic_vector is + variable slv : std_logic_vector((slm'length(1) * slm'length(2)) - 1 downto 0); + begin + for i in slm'range(1) loop + for j in slm'high(2) downto slm'low(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + slv((i * slm'length(2)) + j) := slm(i, j); + end loop; + end loop; + return slv; + end function; + + + -- Convert flat vector to a vector-vector: to_slvv_* + -- ========================================================================== + -- create vector-vector from vector (4 bit) + function to_slvv_4(slv : std_logic_vector) return T_SLVV_4 is + variable Result : T_SLVV_4((slv'length / 4) - 1 downto 0); + begin + if ((slv'length mod 4) /= 0) then report "to_slvv_4: width mismatch - slv'length is no multiple of 4 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 4) + 3 downto (i * 4)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (8 bit) + function to_slvv_8(slv : std_logic_vector) return T_SLVV_8 is + variable Result : T_SLVV_8((slv'length / 8) - 1 downto 0); + begin + if ((slv'length mod 8) /= 0) then report "to_slvv_8: width mismatch - slv'length is no multiple of 8 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 8) + 7 downto (i * 8)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (12 bit) + function to_slvv_12(slv : std_logic_vector) return T_SLVV_12 is + variable Result : T_SLVV_12((slv'length / 12) - 1 downto 0); + begin + if ((slv'length mod 12) /= 0) then report "to_slvv_12: width mismatch - slv'length is no multiple of 12 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 12) + 11 downto (i * 12)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (16 bit) + function to_slvv_16(slv : std_logic_vector) return T_SLVV_16 is + variable Result : T_SLVV_16((slv'length / 16) - 1 downto 0); + begin + if ((slv'length mod 16) /= 0) then report "to_slvv_16: width mismatch - slv'length is no multiple of 16 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 16) + 15 downto (i * 16)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (32 bit) + function to_slvv_32(slv : std_logic_vector) return T_SLVV_32 is + variable Result : T_SLVV_32((slv'length / 32) - 1 downto 0); + begin + if ((slv'length mod 32) /= 0) then report "to_slvv_32: width mismatch - slv'length is no multiple of 32 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 32) + 31 downto (i * 32)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (64 bit) + function to_slvv_64(slv : std_logic_vector) return T_SLVV_64 is + variable Result : T_SLVV_64((slv'length / 64) - 1 downto 0); + begin + if ((slv'length mod 64) /= 0) then report "to_slvv_64: width mismatch - slv'length is no multiple of 64 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 64) + 63 downto (i * 64)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (128 bit) + function to_slvv_128(slv : std_logic_vector) return T_SLVV_128 is + variable Result : T_SLVV_128((slv'length / 128) - 1 downto 0); + begin + if ((slv'length mod 128) /= 0) then report "to_slvv_128: width mismatch - slv'length is no multiple of 128 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 128) + 127 downto (i * 128)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (256 bit) + function to_slvv_256(slv : std_logic_vector) return T_SLVV_256 is + variable Result : T_SLVV_256((slv'length / 256) - 1 downto 0); + begin + if ((slv'length mod 256) /= 0) then report "to_slvv_256: width mismatch - slv'length is no multiple of 256 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 256) + 255 downto (i * 256)); + end loop; + return Result; + end function; + + -- create vector-vector from vector (512 bit) + function to_slvv_512(slv : std_logic_vector) return T_SLVV_512 is + variable Result : T_SLVV_512((slv'length / 512) - 1 downto 0); + begin + if ((slv'length mod 512) /= 0) then report "to_slvv_512: width mismatch - slv'length is no multiple of 512 (slv'length=" & INTEGER'image(slv'length) & ")" severity FAILURE; end if; + + for i in Result'range loop + Result(i) := slv((i * 512) + 511 downto (i * 512)); + end loop; + return Result; + end function; + + -- Convert matrix to avector-vector: to_slvv_* + -- ========================================================================== + -- create vector-vector from matrix (4 bit) + function to_slvv_4(slm : T_SLM) return T_SLVV_4 is + variable Result : T_SLVV_4(slm'range(1)); + begin + if (slm'length(2) /= 4) then report "to_slvv_4: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (8 bit) + function to_slvv_8(slm : T_SLM) return T_SLVV_8 is + variable Result : T_SLVV_8(slm'range(1)); + begin + if (slm'length(2) /= 8) then report "to_slvv_8: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (12 bit) + function to_slvv_12(slm : T_SLM) return T_SLVV_12 is + variable Result : T_SLVV_12(slm'range(1)); + begin + if (slm'length(2) /= 12) then report "to_slvv_12: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (16 bit) + function to_slvv_16(slm : T_SLM) return T_SLVV_16 is + variable Result : T_SLVV_16(slm'range(1)); + begin + if (slm'length(2) /= 16) then report "to_slvv_16: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (32 bit) + function to_slvv_32(slm : T_SLM) return T_SLVV_32 is + variable Result : T_SLVV_32(slm'range(1)); + begin + if (slm'length(2) /= 32) then report "to_slvv_32: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (64 bit) + function to_slvv_64(slm : T_SLM) return T_SLVV_64 is + variable Result : T_SLVV_64(slm'range(1)); + begin + if (slm'length(2) /= 64) then report "to_slvv_64: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (128 bit) + function to_slvv_128(slm : T_SLM) return T_SLVV_128 is + variable Result : T_SLVV_128(slm'range(1)); + begin + if (slm'length(2) /= 128) then report "to_slvv_128: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (256 bit) + function to_slvv_256(slm : T_SLM) return T_SLVV_256 is + variable Result : T_SLVV_256(slm'range); + begin + if (slm'length(2) /= 256) then report "to_slvv_256: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- create vector-vector from matrix (512 bit) + function to_slvv_512(slm : T_SLM) return T_SLVV_512 is + variable Result : T_SLVV_512(slm'range(1)); + begin + if (slm'length(2) /= 512) then report "to_slvv_512: type mismatch - slm'length(2)=" & integer'image(slm'length(2)) severity FAILURE; end if; + + for i in slm'range(1) loop + Result(i) := get_row(slm, i); + end loop; + return Result; + end function; + + -- Convert vector-vector to matrix: to_slm + -- ========================================================================== + -- create matrix from vector + function to_slm(slv : std_logic_vector; ROWS : positive; COLS : positive) return T_SLM is + variable slm : T_SLM(ROWS - 1 downto 0, COLS - 1 downto 0); + begin + for i in 0 to ROWS - 1 loop + for j in 0 to COLS - 1 loop + slm(i, j) := slv((i * COLS) + j); + end loop; + end loop; + return slm; + end function; + + -- create matrix from vector-vector + function to_slm(slvv : T_SLVV_4) return T_SLM is + variable slm : T_SLM(slvv'range, 3 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_4'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_8) return T_SLM is +-- variable test : STD_LOGIC_VECTOR(T_SLV_8'range); +-- variable slm : T_SLM(slvv'range, test'range); -- BUG: iSIM 14.5 cascaded 'range accesses let iSIM break down +-- variable slm : T_SLM(slvv'range, T_SLV_8'range); -- BUG: iSIM 14.5 allocates 9 bits in dimension 2 + variable slm : T_SLM(slvv'range, 7 downto 0); -- WORKAROUND: use constant range + begin +-- report "slvv: slvv.length=" & INTEGER'image(slvv'length) & " slm.dim0.length=" & INTEGER'image(slm'length(1)) & " slm.dim1.length=" & INTEGER'image(slm'length(2)) severity NOTE; +-- report "T_SLV_8: .length=" & INTEGER'image(T_SLV_8'length) & " .high=" & INTEGER'image(T_SLV_8'high) & " .low=" & INTEGER'image(T_SLV_8'low) severity NOTE; +-- report "test: test.length=" & INTEGER'image(test'length) & " .high=" & INTEGER'image(test'high) & " .low=" & INTEGER'image(test'low) severity NOTE; + for i in slvv'range loop + for j in T_SLV_8'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_12) return T_SLM is + variable slm : T_SLM(slvv'range, 11 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_12'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_16) return T_SLM is + variable slm : T_SLM(slvv'range, 15 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_16'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_32) return T_SLM is + variable slm : T_SLM(slvv'range, 31 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_32'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_48) return T_SLM is + variable slm : T_SLM(slvv'range, 47 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_48'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_64) return T_SLM is + variable slm : T_SLM(slvv'range, 63 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_64'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_128) return T_SLM is + variable slm : T_SLM(slvv'range, 127 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_128'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_256) return T_SLM is + variable slm : T_SLM(slvv'range, 255 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_256'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + function to_slm(slvv : T_SLVV_512) return T_SLM is + variable slm : T_SLM(slvv'range, 511 downto 0); + begin + for i in slvv'range loop + for j in T_SLV_512'range loop + slm(i, j) := slvv(i)(j); + end loop; + end loop; + return slm; + end function; + + -- Change vector direction + -- ========================================================================== + function dir(slvv : T_SLVV_8) return T_SLVV_8 is + variable Result : T_SLVV_8(slvv'reverse_range); + begin + Result := slvv; + return Result; + end function; + + -- Reverse vector elements + function rev(slvv : T_SLVV_4) return T_SLVV_4 is + variable Result : T_SLVV_4(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_8) return T_SLVV_8 is + variable Result : T_SLVV_8(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_12) return T_SLVV_12 is + variable Result : T_SLVV_12(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_16) return T_SLVV_16 is + variable Result : T_SLVV_16(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_32) return T_SLVV_32 is + variable Result : T_SLVV_32(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_64) return T_SLVV_64 is + variable Result : T_SLVV_64(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_128) return T_SLVV_128 is + variable Result : T_SLVV_128(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_256) return T_SLVV_256 is + variable Result : T_SLVV_256(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + function rev(slvv : T_SLVV_512) return T_SLVV_512 is + variable Result : T_SLVV_512(slvv'range); + begin + for i in slvv'low to slvv'high loop + Result(slvv'high - i) := slvv(i); + end loop; + return Result; + end function; + + -- Resize functions + -- ========================================================================== + -- Resizes the vector to the specified length. Input vectors larger than the specified size are truncated from the left side. Smaller input + -- vectors are extended on the left by the provided fill value (default: '0'). Use the resize functions of the numeric_std package for + -- value-preserving resizes of the signed and unsigned data types. + function resize(slm : T_SLM; size : positive) return T_SLM is + variable Result : T_SLM(size - 1 downto 0, slm'high(2) downto slm'low(2)) := (others => (others => '0')); -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + begin + for i in slm'range(1) loop + for j in slm'high(2) downto slm'low(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + Result(i, j) := slm(i, j); + end loop; + end loop; + return Result; + end function; + + function to_string(slvv : T_SLVV_8; sep : character := ':') return string is + constant hex_len : positive := ite((sep = C_POC_NUL), (slvv'length * 2), (slvv'length * 3) - 1); + variable Result : string(1 to hex_len) := (others => sep); + variable pos : positive := 1; + begin + for i in slvv'range loop + Result(pos to pos + 1) := to_string(slvv(i), 'h'); + pos := pos + ite((sep = C_POC_NUL), 2, 3); + end loop; + return Result; + end function; + + function to_string_bin(slm : T_SLM; groups : positive := 4; format : character := 'h') return string is + variable PerLineOverheader : positive := div_ceil(slm'length(2), groups); + variable Result : string(1 to (slm'length(1) * (slm'length(2) + PerLineOverheader)) + 10); + variable Writer : positive; + variable GroupCounter : natural; + begin + Result := (others => C_POC_NUL); + Result(1) := LF; + Writer := 2; + GroupCounter := 0; + for i in slm'low(1) to slm'high(1) loop + for j in slm'high(2) downto slm'low(2) loop -- WORKAROUND: Xilinx iSIM work-around, because 'range(2) evaluates to 'range(1); see work-around notes at T_SLM type declaration + Result(Writer) := to_char(slm(i, j)); + Writer := Writer + 1; + GroupCounter := GroupCounter + 1; + if GroupCounter = groups then + Result(Writer) := ' '; + Writer := Writer + 1; + GroupCounter := 0; + end if; + end loop; + Result(Writer - 1) := LF; + GroupCounter := 0; + end loop; + return str_trim(Result); + end function; + + function to_string(slm : T_SLM; groups : positive := 4; format : character := 'b') return string is + begin + if (format = 'b') then + return to_string_bin(slm, groups); + else + return "Format not supported."; + end if; + end function; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/sim/sim_global.v08.vhdl b/testsuite/gna/issue317/PoC/src/sim/sim_global.v08.vhdl new file mode 100644 index 000000000..02ebe003e --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/sim/sim_global.v08.vhdl @@ -0,0 +1,42 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Package: Global simulation constants and shared varibales. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library PoC; +use PoC.FileIO.all; +use PoC.sim_protected.all; + + +package sim_global is + -- The default global status objects. + -- =========================================================================== + shared variable globalSimulationStatus : T_SIM_STATUS; + shared variable globalLogFile : T_LOGFILE; + shared variable globalStdOut : T_STDOUT; +end package; diff --git a/testsuite/gna/issue317/PoC/src/sim/sim_protected.v08.vhdl b/testsuite/gna/issue317/PoC/src/sim/sim_protected.v08.vhdl new file mode 100644 index 000000000..64b9568bb --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/sim/sim_protected.v08.vhdl @@ -0,0 +1,489 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- Thomas B. Preusser +-- +-- Package: Simulation constants, functions and utilities. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +use STD.TextIO.all; + +library IEEE; +use IEEE.STD_LOGIC_1164.all; + +library PoC; +use PoC.utils.all; +use PoC.strings.all; +use PoC.vectors.all; +use PoC.physical.all; + +use PoC.sim_types.all; + + +package sim_protected is + -- Simulation Task and Status Management + -- =========================================================================== + type T_SIM_STATUS is protected + -- Initializer and Finalizer + procedure initialize(MaxAssertFailures : natural := natural'high; MaxSimulationRuntime : TIME := TIME'high); + procedure finalize; + + -- Assertions + procedure fail(Message : string := ""); + procedure assertion(Condition : boolean; Message : string := ""); + procedure writeMessage(Message : string); + procedure writeReport; + + -- Process Management + impure function registerProcess(Name : string; IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID; + impure function registerProcess(TestID : T_SIM_TEST_ID; Name : string; IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID; + procedure deactivateProcess(procID : T_SIM_PROCESS_ID; SkipLowPriority : boolean := FALSE); + procedure stopAllProcesses; + procedure stopProcesses(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID); + + -- Test Management + procedure createDefaultTest; + impure function createTest(Name : string) return T_SIM_TEST_ID; + procedure activateDefaultTest; + procedure finalizeTest; + procedure finalizeTest(TestID : T_SIM_TEST_ID); + + -- Run Management + procedure stopAllClocks; + procedure stopClocks(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID); + + impure function isStopped(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean; + impure function isFinalized(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean; + impure function isAllFinalized return boolean; + end protected; +end package; + + +package body sim_protected is + -- Simulation process and Status Management + -- =========================================================================== + type T_SIM_STATUS_STATE is record + IsInitialized : boolean; + IsFinalized : boolean; + end record; + + type T_SIM_STATUS is protected body + -- status + variable State : T_SIM_STATUS_STATE := (FALSE, FALSE); + + variable Max_AssertFailures : natural := natural'high; + variable Max_SimulationRuntime : time := time'high; + + -- Internal state variable to log a failure condition for final reporting. + -- Once de-asserted, this variable will never return to a value of true. + variable Passed : boolean := TRUE; + variable AssertCount : natural := 0; + variable FailedAssertCount : natural := 0; + + -- Clock Management + variable MainProcessEnables : T_SIM_BOOLVEC(T_SIM_TEST_ID) := (others => TRUE); + variable MainClockEnables : T_SIM_BOOLVEC(T_SIM_TEST_ID) := (others => TRUE); + + -- Process Management + variable ProcessCount : natural := 0; + variable ActiveProcessCount : natural := 0; + variable Processes : T_SIM_PROCESS_VECTOR(T_SIM_PROCESS_ID); + + -- Test Management + variable TestCount : natural := 0; + variable ActiveTestCount : natural := 0; + variable Tests : T_SIM_TEST_VECTOR(T_SIM_TEST_ID); + + -- Initializer + procedure init is + begin + if (State.IsInitialized = FALSE) then + if C_SIM_VERBOSE then report "init:" severity NOTE; end if; + State.IsInitialized := TRUE; + createDefaultTest; + end if; + end procedure; + + procedure initialize(MaxAssertFailures : natural := natural'high; MaxSimulationRuntime : TIME := TIME'high) is + begin + if C_SIM_VERBOSE then report "initialize:" severity NOTE; end if; + init; + Max_AssertFailures := MaxAssertFailures; + Max_SimulationRuntime := MaxSimulationRuntime; + end procedure; + + procedure finalize is + begin + if (State.IsFinalized = FALSE) then + if C_SIM_VERBOSE then report "finalize: " severity NOTE; end if; + State.IsFinalized := TRUE; + for i in C_SIM_DEFAULT_TEST_ID to TestCount - 1 loop + finalizeTest(i); + end loop; + writeReport; + end if; + end procedure; + + procedure writeReport_Header is + variable LineBuffer : LINE; + begin + write(LineBuffer, ( string'("========================================"))); + write(LineBuffer, (LF & string'("POC TESTBENCH REPORT"))); + write(LineBuffer, (LF & string'("========================================"))); + writeline(output, LineBuffer); + end procedure; + + procedure writeReport_TestReport(Prefix : string := "") is + variable LineBuffer : LINE; + begin + if (Tests(C_SIM_DEFAULT_TEST_ID).Status /= SIM_TEST_STATUS_CREATED) then + write(LineBuffer, Prefix & "Tests " & integer'image(TestCount + 1)); + write(LineBuffer, LF & Prefix & " " & str_ralign("-1", log10ceilnz(TestCount + 1) + 1) & ": " & C_SIM_DEFAULT_TEST_NAME); + else + write(LineBuffer, Prefix & "Tests " & integer'image(TestCount)); + end if; + for i in 0 to TestCount - 1 loop + write(LineBuffer, LF & Prefix & " " & str_ralign(integer'image(i), log10ceilnz(TestCount)) & ": " & str_trim(Tests(i).Name)); + end loop; + writeline(output, LineBuffer); + end procedure; + + procedure writeReport_AssertReport(Prefix : string := "") is + variable LineBuffer : LINE; + begin + write(LineBuffer, Prefix & "Assertions " & integer'image(AssertCount)); + write(LineBuffer, LF & Prefix & " failed " & integer'image(FailedAssertCount) & ite((FailedAssertCount >= Max_AssertFailures), " Too many failed asserts!", "")); + writeline(output, LineBuffer); + end procedure; + + procedure writeReport_ProcessReport(Prefix : string := "") is + variable LineBuffer : LINE; + begin + write(LineBuffer, Prefix & "Processes " & integer'image(ProcessCount)); + write(LineBuffer, LF & Prefix & " active " & integer'image(ActiveProcessCount)); + -- report killed processes + for i in 0 to ProcessCount - 1 loop + if ((Processes(i).Status = SIM_PROCESS_STATUS_ACTIVE) and (Processes(i).IsLowPriority = FALSE)) then + write(LineBuffer, LF & Prefix & " " & str_ralign(integer'image(i), log10ceilnz(ProcessCount)) & ": " & str_trim(Processes(i).Name)); + end if; + end loop; + writeline(output, LineBuffer); + end procedure; + + procedure writeReport_RuntimeReport(Prefix : string := "") is + variable LineBuffer : LINE; + begin + write(LineBuffer, Prefix & "Runtime " & to_string(now, 1)); + writeline(output, LineBuffer); + end procedure; + + procedure writeReport_SimulationResult is + variable LineBuffer : LINE; + begin + write(LineBuffer, ( string'("========================================"))); + if not Passed then write(LineBuffer, (LF & string'("SIMULATION RESULT = FAILED"))); + elsif AssertCount = 0 then write(LineBuffer, (LF & string'("SIMULATION RESULT = NO ASSERTS"))); + elsif Passed then write(LineBuffer, (LF & string'("SIMULATION RESULT = PASSED"))); + end if; + write(LineBuffer, (LF & string'("========================================"))); + writeline(output, LineBuffer); + end procedure; + + procedure writeReport is + variable LineBuffer : LINE; + begin + writeReport_Header; + writeReport_TestReport(""); + write(LineBuffer, LF & "Overall"); + writeline(output, LineBuffer); + writeReport_AssertReport(" "); + writeReport_ProcessReport(" "); + writeReport_RuntimeReport(" "); + writeReport_SimulationResult; + end procedure; + + procedure assertion(condition : boolean; Message : string := "") is + begin + AssertCount := AssertCount + 1; + if not condition then + fail(Message); + FailedAssertCount := FailedAssertCount + 1; + if (FailedAssertCount >= Max_AssertFailures) then + stopAllProcesses; + end if; + end if; + end procedure; + + procedure fail(Message : string := "") is + begin + if (Message'length > 0) then + report Message severity ERROR; + end if; + Passed := FALSE; + end procedure; + + procedure writeMessage(Message : string) is + variable LineBuffer : LINE; + begin + write(LineBuffer, Message); + writeline(output, LineBuffer); + end procedure; + + procedure createDefaultTest is + variable Test : T_SIM_TEST; + begin + if (State.IsInitialized = FALSE) then + init; + end if; + if C_SIM_VERBOSE then report "createDefaultTest(" & C_SIM_DEFAULT_TEST_NAME & "):" severity NOTE; end if; + Test.ID := C_SIM_DEFAULT_TEST_ID; + Test.Name := resize(C_SIM_DEFAULT_TEST_NAME, T_SIM_TEST_NAME'length); + Test.Status := SIM_TEST_STATUS_CREATED; + Test.ProcessIDs := (others => 0); + Test.ProcessCount := 0; + Test.ActiveProcessCount := 0; + -- add to the internal structure + Tests(Test.ID) := Test; + end procedure; + + impure function createTest(Name : string) return T_SIM_TEST_ID is + variable Test : T_SIM_TEST; + begin + if (State.IsInitialized = FALSE) then + init; + end if; + if C_SIM_VERBOSE then report "createTest(" & Name & "): => " & T_SIM_TEST_ID'image(TestCount) severity NOTE; end if; + Test.ID := TestCount; + Test.Name := resize(Name, T_SIM_TEST_NAME'length); + Test.Status := SIM_TEST_STATUS_ACTIVE; + Test.ProcessIDs := (others => 0); + Test.ProcessCount := 0; + Test.ActiveProcessCount := 0; + -- add to the internal structure + Tests(Test.ID) := Test; + TestCount := TestCount + 1; + ActiveTestCount := ActiveTestCount + 1; + -- return TestID for finalizeTest + return Test.ID; + end function; + + procedure activateDefaultTest is + begin + if (Tests(C_SIM_DEFAULT_TEST_ID).Status = SIM_TEST_STATUS_CREATED) then + Tests(C_SIM_DEFAULT_TEST_ID).Status := SIM_TEST_STATUS_ACTIVE; + ActiveTestCount := ActiveTestCount + 1; + end if; + end procedure; + + procedure finalizeTest is + begin + finalizeTest(C_SIM_DEFAULT_TEST_ID); + end procedure; + + procedure finalizeTest(TestID : T_SIM_TEST_ID) is + begin + if (TestID >= TestCount) then + report "TestID (" & T_SIM_TEST_ID'image(TestID) & ") is unknown." severity FAILURE; + return; + end if; + + if TestID = C_SIM_DEFAULT_TEST_ID then + if (Tests(C_SIM_DEFAULT_TEST_ID).Status = SIM_TEST_STATUS_CREATED) then + if C_SIM_VERBOSE then report "finalizeTest(" & integer'image(C_SIM_DEFAULT_TEST_ID) & "): inactive" severity NOTE; end if; + Tests(C_SIM_DEFAULT_TEST_ID).Status := SIM_TEST_STATUS_ENDED; + stopProcesses(C_SIM_DEFAULT_TEST_ID); + return; + elsif (Tests(C_SIM_DEFAULT_TEST_ID).Status = SIM_TEST_STATUS_ACTIVE) then + if ActiveTestCount > 1 then + for ProcIdx in 0 to Tests(C_SIM_DEFAULT_TEST_ID).ProcessCount - 1 loop + deactivateProcess(Tests(C_SIM_DEFAULT_TEST_ID).ProcessIDs(ProcIdx), TRUE); + end loop; + Tests(C_SIM_DEFAULT_TEST_ID).Status := SIM_TEST_STATUS_ZOMBI; + return; + else + if C_SIM_VERBOSE then report "finalizeTest(" & integer'image(C_SIM_DEFAULT_TEST_ID) & "): active" severity NOTE; end if; + Tests(C_SIM_DEFAULT_TEST_ID).Status := SIM_TEST_STATUS_ENDED; + ActiveTestCount := ActiveTestCount - 1; + stopProcesses(C_SIM_DEFAULT_TEST_ID); + end if; + end if; + elsif (Tests(TestID).Status /= SIM_TEST_STATUS_ENDED) then + if C_SIM_VERBOSE then report "finalizeTest(TestID=" & T_SIM_TEST_ID'image(TestID) & "): " severity NOTE; end if; + Tests(TestID).Status := SIM_TEST_STATUS_ENDED; + ActiveTestCount := ActiveTestCount - 1; + + if (Tests(TestID).ActiveProcessCount > 0) then + fail("Test " & integer'image(TestID) & " '" & str_trim(Tests(TestID).Name) & "' has still active process while finalizing:"); + for ProcIdx in 0 to Tests(TestID).ProcessCount - 1 loop + if (Processes(Tests(TestID).ProcessIDs(ProcIdx)).Status = SIM_PROCESS_STATUS_ACTIVE) then + report " " & Processes(Tests(TestID).ProcessIDs(ProcIdx)).Name severity WARNING; + end if; + end loop; + end if; + stopProcesses(TestID); + end if; + + if ActiveTestCount = 0 then + finalize; + elsif ActiveTestCount = 1 then + if (Tests(C_SIM_DEFAULT_TEST_ID).Status = SIM_TEST_STATUS_ACTIVE) then + finalizeTest(C_SIM_DEFAULT_TEST_ID); + elsif (Tests(C_SIM_DEFAULT_TEST_ID).Status = SIM_TEST_STATUS_ZOMBI) then + stopProcesses(C_SIM_DEFAULT_TEST_ID); + else + return; + end if; + finalize; + end if; + end procedure; + + impure function registerProcess(Name : string; IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID is + begin + return registerProcess(C_SIM_DEFAULT_TEST_ID, Name, IsLowPriority); + end function; + + impure function registerProcess(TestID : T_SIM_TEST_ID; Name : string; IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID is + variable Proc : T_SIM_PROCESS; + variable TestProcID : T_SIM_TEST_ID; + begin + if (State.IsInitialized = FALSE) then + init; + end if; + if TestID = C_SIM_DEFAULT_TEST_ID then + activateDefaultTest; + end if; + + if (TestID >= TestCount) then + report "TestID (" & T_SIM_TEST_ID'image(TestID) & ") is unknown." severity FAILURE; + return T_SIM_PROCESS_ID'high; + end if; + + if C_SIM_VERBOSE then report "registerProcess(TestID=" & T_SIM_TEST_ID'image(TestID) & ", " & Name & "): => " & T_SIM_PROCESS_ID'image(ProcessCount) severity NOTE; end if; + Proc.ID := ProcessCount; + Proc.TestID := TestID; + Proc.Name := resize(Name, T_SIM_PROCESS_NAME'length); + Proc.Status := SIM_PROCESS_STATUS_ACTIVE; + Proc.IsLowPriority := IsLowPriority; + + -- add process to list + Processes(Proc.ID) := Proc; + ProcessCount := ProcessCount + 1; + ActiveProcessCount := inc_if(not IsLowPriority, ActiveProcessCount); + -- add process to test + TestProcID := Tests(TestID).ProcessCount; + Tests(TestID).ProcessIDs(TestProcID) := Proc.ID; + Tests(TestID).ProcessCount := TestProcID + 1; + Tests(TestID).ActiveProcessCount := inc_if(not IsLowPriority, Tests(TestID).ActiveProcessCount); + -- return the process ID + return Proc.ID; + end function; + + procedure deactivateProcess(ProcID : T_SIM_PROCESS_ID; SkipLowPriority : boolean := FALSE) is + variable TestID : T_SIM_TEST_ID; + begin + if (ProcID >= ProcessCount) then + report "ProcID (" & T_SIM_PROCESS_ID'image(ProcID) & ") is unknown." severity FAILURE; + return; + elsif (Processes(ProcID).IsLowPriority and SkipLowPriority) then + return; + end if; + + TestID := Processes(ProcID).TestID; + -- deactivate process + if (Processes(ProcID).Status = SIM_PROCESS_STATUS_ACTIVE) then + if C_SIM_VERBOSE then report "deactivateProcess(ProcID=" & T_SIM_PROCESS_ID'image(ProcID) & "): TestID=" & T_SIM_TEST_ID'image(TestID) & " Name=" & str_trim(Processes(ProcID).Name) severity NOTE; end if; + Processes(ProcID).Status := SIM_PROCESS_STATUS_ENDED; + ActiveProcessCount := dec_if(not Processes(ProcID).IsLowPriority, ActiveProcessCount); + Tests(TestID).ActiveProcessCount := dec_if(not Processes(ProcID).IsLowPriority, Tests(TestID).ActiveProcessCount); + if (Tests(TestID).ActiveProcessCount = 0) then + finalizeTest(TestID); + end if; + end if; + end procedure; + + procedure stopAllProcesses is + begin + if C_SIM_VERBOSE then report "stopAllProcesses:" severity NOTE; end if; + for i in C_SIM_DEFAULT_TEST_ID to TestCount - 1 loop + stopProcesses(i); + end loop; + end procedure; + + procedure stopProcesses(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) is + begin + if (TestID >= TestCount) then + report "TestID (" & T_SIM_TEST_ID'image(TestID) & ") is unknown." severity FAILURE; + return; + end if; + + if C_SIM_VERBOSE then report "stopProcesses(TestID=" & T_SIM_TEST_ID'image(TestID) & "): Name=" & str_trim(Tests(TestID).Name) severity NOTE; end if; + MainProcessEnables(TestID) := FALSE; + stopClocks(TestID); + end procedure; + + procedure stopAllClocks is + begin + if C_SIM_VERBOSE then report "stopAllClocks:" severity NOTE; end if; + for i in C_SIM_DEFAULT_TEST_ID to TestCount - 1 loop + stopClocks(i); + end loop; + end procedure; + + procedure stopClocks(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) is + begin + if (TestID >= TestCount) then + report "TestID (" & T_SIM_TEST_ID'image(TestID) & ") is unknown." severity FAILURE; + return; + end if; + + if C_SIM_VERBOSE then report "stopClocks(TestID=" & T_SIM_TEST_ID'image(TestID) & "): Name=" & str_trim(Tests(TestID).Name) severity NOTE; end if; + MainClockEnables(TestID) := FALSE; + end procedure; + + impure function isStopped(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean is + begin + return not MainClockEnables(TestID); + end function; + + impure function isFinalized(TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean is + begin + return (Tests(TestID).Status = SIM_TEST_STATUS_ENDED); + end function; + + impure function isAllFinalized return boolean is + begin + if (State.IsFinalized = TRUE) then + if ActiveTestCount = 0 then + return TRUE; + end if; + report "isAllFinalized: " severity ERROR; + return FALSE; + else + return FALSE; + end if; + end function; + end protected body; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/sim/sim_simulation.v08.vhdl b/testsuite/gna/issue317/PoC/src/sim/sim_simulation.v08.vhdl new file mode 100644 index 000000000..81a964b95 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/sim/sim_simulation.v08.vhdl @@ -0,0 +1,173 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- Thomas B. Preusser +-- +-- Package: Simulation constants, functions and utilities. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; +use IEEE.math_real.all; + +library PoC; +use PoC.utils.all; +-- use PoC.strings.all; +use PoC.vectors.all; +use PoC.physical.all; + +use PoC.sim_global.all; +use PoC.sim_types.all; +use PoC.sim_protected.all; + + +package simulation is + -- Legacy interface for pre VHDL-2002 + -- =========================================================================== + -- prepared aliases, if GHDL gets the aliases fixed. Reported on 08.02.2015 as Issue #38 + -- alias simmInitialize is globalSimulationStatus.initialize[NATURAL, TIME]; + -- alias simmFinalize is globalSimulationStatus.finalize[]; + + -- alias simmCreateTest is globalSimulationStatus.createTest[STRING return T_SIM_TEST_ID]; + -- alias simmFinalizeTest is globalSimulationStatus.finalizeTest[T_SIM_TEST_ID]; + -- alias simmRegisterProcess is globalSimulationStatus.registerProcess[T_SIM_TEST_ID, STRING, BOOLEAN return T_SIM_PROCESS_ID]; + -- alias simmRegisterProcess is globalSimulationStatus.registerProcess[STRING, BOOLEAN return T_SIM_PROCESS_ID]; + -- alias simmDeactivateProcess is globalSimulationStatus.deactivateProcess[T_SIM_PROCESS_ID]; + + -- alias simmIsStopped is globalSimulationStatus.isStopped[T_SIM_TEST_ID return BOOLEAN]; + -- alias simmIsFinalized is globalSimulationStatus.isFinalized[T_SIM_TEST_ID return BOOLEAN]; + -- alias simmIsAllFinalized is globalSimulationStatus.isAllFinalized [return BOOLEAN]; + + -- alias simmAssertion is globalSimulationStatus.assertion[BOOLEAN, STRING]; + -- alias simmFail is globalSimulationStatus.fail[STRING]; + -- alias simmWriteMessage is globalSimulationStatus.writeMessage[STRING]; + + procedure simInitialize(MaxAssertFailures : natural := natural'high; MaxSimulationRuntime : TIME := TIME'high); + procedure simFinalize; + + impure function simCreateTest(Name : string) return T_SIM_TEST_ID; + procedure simFinalizeTest(constant TestID : T_SIM_TEST_ID); + impure function simRegisterProcess(Name : string; constant IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID; + impure function simRegisterProcess(constant TestID : T_SIM_TEST_ID; Name : string; constant IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID; + procedure simDeactivateProcess(ProcID : T_SIM_PROCESS_ID); + + impure function simIsStopped(constant TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean; + impure function simIsFinalized(constant TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean; + impure function simIsAllFinalized return boolean; + + procedure simAssertion(cond : in boolean; Message : in string := ""); + procedure simFail(Message : in string := ""); + procedure simWriteMessage(Message : in string := ""); + + -- TODO: integrate VCD simulation functions and procedures from sim_value_change_dump.vhdl here + + -- checksum functions + -- =========================================================================== + -- TODO: move checksum functions here +end package; + + +package body simulation is + -- legacy procedures + -- =========================================================================== + -- TODO: undocumented group + procedure simInitialize(MaxAssertFailures : natural := natural'high; MaxSimulationRuntime : TIME := TIME'high) is + begin + globalSimulationStatus.initialize(MaxAssertFailures, MaxSimulationRuntime); + if C_SIM_VERBOSE then report "simInitialize:" severity NOTE; end if; + if (MaxSimulationRuntime /= time'high) then + wait for MaxSimulationRuntime; + report "simInitialize: TIMEOUT" severity ERROR; + globalSimulationStatus.finalize; + end if; + end procedure; + + procedure simFinalize is + begin + globalSimulationStatus.finalize; + end procedure; + + impure function simCreateTest(Name : string) return T_SIM_TEST_ID is + begin + return globalSimulationStatus.createTest(Name); + end function; + + procedure simFinalizeTest(constant TestID : T_SIM_TEST_ID) is + begin + globalSimulationStatus.finalizeTest(TestID); + end procedure; + + impure function simRegisterProcess(Name : string; constant IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID is + begin + return globalSimulationStatus.registerProcess(Name, IsLowPriority); + end function; + + impure function simRegisterProcess(constant TestID : T_SIM_TEST_ID; Name : string; constant IsLowPriority : boolean := FALSE) return T_SIM_PROCESS_ID is + begin + return globalSimulationStatus.registerProcess(TestID, Name, IsLowPriority); + end function; + + procedure simDeactivateProcess(ProcID : T_SIM_PROCESS_ID) is + begin + globalSimulationStatus.deactivateProcess(ProcID); + end procedure; + + impure function simIsStopped(constant TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean is + begin + return globalSimulationStatus.isStopped(TestID); + end function; + + impure function simIsFinalized(constant TestID : T_SIM_TEST_ID := C_SIM_DEFAULT_TEST_ID) return boolean is + begin + return globalSimulationStatus.isFinalized(TestID); + end function; + + impure function simIsAllFinalized return boolean is + begin + return globalSimulationStatus.isAllFinalized; + end function; + + -- TODO: undocumented group + procedure simWriteMessage(Message : in string := "") is + begin + globalSimulationStatus.writeMessage(Message); + end procedure; + + procedure simFail(Message : in string := "") is + begin + globalSimulationStatus.fail(Message); + end procedure; + + procedure simAssertion(cond : in boolean; Message : in string := "") is + begin + globalSimulationStatus.assertion(cond, Message); + end procedure; + + -- checksum functions + -- =========================================================================== + -- TODO: move checksum functions here +end package body; diff --git a/testsuite/gna/issue317/PoC/src/sim/sim_types.vhdl b/testsuite/gna/issue317/PoC/src/sim/sim_types.vhdl new file mode 100644 index 000000000..332cd4e16 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/sim/sim_types.vhdl @@ -0,0 +1,376 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- Thomas B. Preusser +-- +-- Package: Simulation constants, functions and utilities. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; +use IEEE.math_real.all; + +library PoC; +use PoC.utils.all; +-- use PoC.strings.all; +use PoC.vectors.all; +-- use PoC.physical.all; + + +package sim_types is + + constant C_SIM_VERBOSE : boolean := FALSE; -- POC_VERBOSE + + -- =========================================================================== + -- Simulation Task and Status Management + -- =========================================================================== + type T_SIM_BOOLVEC is array(integer range <>) of boolean; + + subtype T_SIM_TEST_ID is integer range -1 to 1023; + subtype T_SIM_TEST_NAME is string(1 to 256); + subtype T_SIM_PROCESS_ID is natural range 0 to 1023; + subtype T_SIM_PROCESS_NAME is string(1 to 64); + subtype T_SIM_PROCESS_INSTNAME is string(1 to 256); + type T_SIM_PROCESS_ID_VECTOR is array(natural range <>) of T_SIM_PROCESS_ID; + + type T_SIM_TEST_STATUS is ( + SIM_TEST_STATUS_CREATED, + SIM_TEST_STATUS_ACTIVE, + SIM_TEST_STATUS_ENDED, + SIM_TEST_STATUS_ZOMBI + ); + + type T_SIM_PROCESS_STATUS is ( + SIM_PROCESS_STATUS_ACTIVE, + SIM_PROCESS_STATUS_ENDED + ); + + type T_SIM_TEST is record + ID : T_SIM_TEST_ID; + Name : T_SIM_TEST_NAME; + Status : T_SIM_TEST_STATUS; + ProcessIDs : T_SIM_PROCESS_ID_VECTOR(T_SIM_PROCESS_ID); + ProcessCount : T_SIM_PROCESS_ID; + ActiveProcessCount : T_SIM_PROCESS_ID; + end record; + type T_SIM_TEST_VECTOR is array(integer range <>) of T_SIM_TEST; + + type T_SIM_PROCESS is record + ID : T_SIM_PROCESS_ID; + TestID : T_SIM_TEST_ID; + Name : T_SIM_PROCESS_NAME; + Status : T_SIM_PROCESS_STATUS; + IsLowPriority : boolean; + end record; + type T_SIM_PROCESS_VECTOR is array(natural range <>) of T_SIM_PROCESS; + + constant C_SIM_DEFAULT_TEST_ID : T_SIM_TEST_ID := -1; + constant C_SIM_DEFAULT_TEST_NAME : string := "Default test"; + + -- =========================================================================== + -- Random Numbers + -- =========================================================================== + type T_SIM_RAND_SEED is record + Seed1 : integer; + Seed2 : integer; + end record; + + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED); + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED; SeedValue : in T_SIM_RAND_SEED); + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED; SeedVector : in T_INTVEC); + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED; SeedVector : in string); + function randInitializeSeed return T_SIM_RAND_SEED; + function randInitializeSeed(SeedValue : T_SIM_RAND_SEED) return T_SIM_RAND_SEED; + function randInitializeSeed(SeedVector : T_INTVEC) return T_SIM_RAND_SEED; + function randInitializeSeed(SeedVector : string) return T_SIM_RAND_SEED; + + + -- Uniform distributed random values + -- =========================================================================== + procedure randUniformDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL); + procedure randUniformDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out integer; Minimum : integer; Maximum : integer); + procedure randUniformDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; Minimum : REAL; Maximum : REAL); + + -- Normal / Gaussian distributed random values + -- =========================================================================== + procedure randNormalDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; StandardDeviation : REAL := 1.0; Mean : REAL := 0.0); + procedure randNormalDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out integer; StandardDeviation : in REAL; Mean : in REAL; Minimum : in integer; Maximum : in integer); + procedure randNormalDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; StandardDeviation : in REAL; Mean : in REAL; Minimum : in REAL; Maximum : in REAL); + + -- Poisson distributed random values + -- =========================================================================== + procedure randPoissonDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; Mean : in REAL); + procedure randPoissonDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out integer; Mean : in REAL; Minimum : in integer; Maximum : in integer); + procedure randPoissonDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; Mean : in REAL; Minimum : in REAL; Maximum : in REAL); + + -- =========================================================================== + -- Clock Generation + -- =========================================================================== + -- type T_PERCENT is INTEGER'range units + type T_PERCENT is range integer'low to INTEGER'high units + ppb; + ppm = 1000 ppb; + permil = 1000 ppm; + percent = 10 permil; + one = 100 percent; + end units; + subtype T_WANDER is T_PERCENT range -1 one to 1 one; + subtype T_DUTYCYCLE is T_PERCENT range 0 ppb to 1 one; + + type T_DEGREE is range integer'low to INTEGER'high units + second; + minute = 60 second; + deg = 60 minute; + end units; + subtype T_PHASE is T_DEGREE range -360 deg to 360 deg; + + function ite(cond : boolean; value1 : T_DEGREE; value2 : T_DEGREE) return T_DEGREE; +end package; + + +package body sim_types is + function ite(cond : boolean; value1 : T_DEGREE; value2 : T_DEGREE) return T_DEGREE is + begin + if cond then + return value1; + else + return value2; + end if; + end function; + + -- =========================================================================== + -- Random Numbers + -- =========================================================================== + constant MAX_SEED1_VALUE : positive := 2147483562; + constant MAX_SEED2_VALUE : positive := 2147483398; + + function randGenerateInitialSeed return T_SIM_RAND_SEED is + begin + return ( + Seed1 => 5, + Seed2 => 3423 + ); + end function; + + function randBoundSeed(SeedValue : in T_SIM_RAND_SEED) return T_SIM_RAND_SEED is + begin + return ( + Seed1 => (SeedValue.Seed1 - 1 mod MAX_SEED1_VALUE) + 1, + Seed2 => (SeedValue.Seed2 - 1 mod MAX_SEED2_VALUE) + 1 + ); + end function; + + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED) is + begin + Seed := randGenerateInitialSeed; + end procedure; + + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED; SeedValue : in T_SIM_RAND_SEED) is + begin + Seed := randBoundSeed(SeedValue); + end procedure; + + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED; SeedVector : in T_INTVEC) is + begin + if (SeedVector'length = 0) then + Seed := randGenerateInitialSeed; + elsif (SeedVector'length = 1) then + Seed := randBoundSeed(T_SIM_RAND_SEED'( + Seed1 => SeedVector(0), + Seed2 => 92346 + )); + elsif (SeedVector'length = 2) then + Seed := randBoundSeed(T_SIM_RAND_SEED'( + Seed1 => SeedVector(0), + Seed2 => SeedVector(1) + )); + else + -- FIXME: + -- Seed.Seed1 := SeedVector(0); + -- Seed.Seed2 := SeedVector(1); + end if; + end procedure; + + procedure randInitializeSeed(Seed : inout T_SIM_RAND_SEED; SeedVector : in string) is + begin + if (SeedVector'length = 0) then + Seed := randGenerateInitialSeed; + elsif (SeedVector'length = 1) then + Seed := T_SIM_RAND_SEED'( + Seed1 => character'pos(SeedVector(1)), + Seed2 => 39834 + ); + elsif (SeedVector'length = 2) then + Seed := T_SIM_RAND_SEED'( + Seed1 => character'pos(SeedVector(1)), + Seed2 => character'pos(SeedVector(2)) + ); + else + -- FIXME: + -- Seed.Seed1 := CHARACTER'pos(SeedVector(0)); + -- Seed.Seed2 := CHARACTER'pos(SeedVector(1)); + end if; + end procedure; + + function randInitializeSeed return T_SIM_RAND_SEED is + begin + return randGenerateInitialSeed; + end function; + + function randInitializeSeed(SeedValue : T_SIM_RAND_SEED) return T_SIM_RAND_SEED is + begin + return randBoundSeed(SeedValue); + end function; + + function randInitializeSeed(SeedVector : T_INTVEC) return T_SIM_RAND_SEED is + variable Result : T_SIM_RAND_SEED; + begin + randInitializeSeed(Result, SeedVector); + return Result; + end function; + + function randInitializeSeed(SeedVector : string) return T_SIM_RAND_SEED is + variable Result : T_SIM_RAND_SEED; + begin + randInitializeSeed(Result, SeedVector); + return Result; + end function; + + -- =========================================================================== + -- Uniform distributed random values + -- =========================================================================== + procedure randUniformDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL) is + begin + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, Value); + end procedure; + + procedure randUniformDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out integer; Minimum : integer; Maximum : integer) is + variable rand : REAL; + begin + if Maximum < Minimum then report "randUniformDistributedValue: Maximum must be greater than Minimum." severity FAILURE; end if; + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, rand); + Value := scale(rand, Minimum, Maximum); + end procedure; + + procedure randUniformDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; Minimum : REAL; Maximum : REAL) is + variable rand : REAL; + begin + if Maximum < Minimum then report "randUniformDistributedValue: Maximum must be greater than Minimum." severity FAILURE; end if; + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, rand); + Value := scale(rand, Minimum, Maximum); + end procedure; + + -- =========================================================================== + -- Normal / Gaussian distributed random values + -- =========================================================================== + procedure randNormalDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; StandardDeviation : REAL := 1.0; Mean : REAL := 0.0) is + variable rand1 : REAL; + variable rand2 : REAL; + begin + if StandardDeviation < 0.0 then report "randNormalDistributedValue: Standard deviation must be >= 0.0" severity FAILURE; end if; + -- Box Muller transformation + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, rand1); + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, rand2); + -- standard normal distribution: mean 0, variance 1 + Value := StandardDeviation * (sqrt(-2.0 * log(rand1)) * cos(MATH_2_PI * rand2)) + Mean; + end procedure; + + procedure randNormalDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out integer; StandardDeviation : in REAL; Mean : in REAL; Minimum : in integer; Maximum : in integer) is + variable rand_real : REAL; + variable rand_int : integer; + begin + if Maximum < Minimum then report "randNormalDistributedValue: Maximum must be greater than Minimum." severity FAILURE; end if; + if StandardDeviation < 0.0 then report "randNormalDistributedValue: Standard deviation must be >= 0.0" severity FAILURE; end if; + while TRUE loop + randNormalDistributedValue(Seed, rand_real, StandardDeviation, Mean); + rand_int := integer(round(rand_real)); + exit when ((Minimum <= rand_int) and (rand_int <= Maximum)); + end loop; + Value := rand_int; + end procedure; + + procedure randNormalDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; StandardDeviation : in REAL; Mean : in REAL; Minimum : in REAL; Maximum : in REAL) is + variable rand : REAL; + begin + if Maximum < Minimum then report "randNormalDistributedValue: Maximum must be greater than Minimum." severity FAILURE; end if; + if StandardDeviation < 0.0 then report "randNormalDistributedValue: Standard deviation must be >= 0.0" severity FAILURE; end if; + while TRUE loop + randNormalDistributedValue(Seed, rand, StandardDeviation, Mean); + exit when ((Minimum <= rand) and (rand <= Maximum)); + end loop; + Value := rand; + end procedure; + + -- =========================================================================== + -- Poisson distributed random values + -- =========================================================================== + procedure randPoissonDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; Mean : in REAL) is + variable Product : Real; + variable Bound : Real; + variable rand : Real; + variable Result : Real; + begin + Product := 1.0; + Result := 0.0; + Bound := exp(-1.0 * Mean); + if ((Mean <= 0.0) or (Bound <= 0.0)) then + report "randPoissonDistributedValue: Mean must be greater than 0.0." severity FAILURE; + return; + end if; + + while (Product >= Bound) loop + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, rand); + Product := Product * rand; + Result := Result + 1.0; + end loop; + Value := Result; + end procedure; + + procedure randPoissonDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out integer; Mean : in REAL; Minimum : in integer; Maximum : in integer) is + variable rand_real : REAL; + variable rand_int : integer; + begin + if Maximum < Minimum then report "randPoissonDistributedValue: Maximum must be greater than Minimum." severity FAILURE; end if; + while TRUE loop + randPoissonDistributedValue(Seed, rand_real, Mean); + rand_int := integer(round(rand_real)); + exit when ((Minimum <= rand_int) and (rand_int <= Maximum)); + end loop; + Value := rand_int; + end procedure; + + procedure randPoissonDistributedValue(Seed : inout T_SIM_RAND_SEED; Value : out REAL; Mean : in REAL; Minimum : in REAL; Maximum : in REAL) is + variable rand : REAL; + begin + if Maximum < Minimum then report "randPoissonDistributedValue: Maximum must be greater than Minimum." severity FAILURE; end if; + while TRUE loop + randPoissonDistributedValue(Seed, rand, Mean); + exit when ((Minimum <= rand) and (rand <= Maximum)); + end loop; + Value := rand; + end procedure; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/sim/sim_waveform.vhdl b/testsuite/gna/issue317/PoC/src/sim/sim_waveform.vhdl new file mode 100644 index 000000000..3c70eeac1 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/sim/sim_waveform.vhdl @@ -0,0 +1,981 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- Martin Zabel +-- +-- Package: Simulation constants, functions and utilities. +-- +-- Description: +-- ------------------------------------- +-- .. TODO:: No documentation available. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; +use IEEE.math_real.all; + +library PoC; +use PoC.utils.all; +-- use PoC.strings.all; +use PoC.vectors.all; +use PoC.physical.all; + +use PoC.sim_types.all; +-- use PoC.sim_random.all; +use PoC.simulation.all; + + +package waveform is + -- clock generation + -- =========================================================================== + procedure simGenerateClock( + signal Clock : out std_logic; + constant Frequency : in FREQ; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ); + procedure simGenerateClock( + constant TestID : in T_SIM_TEST_ID; + signal Clock : out std_logic; + constant Frequency : in FREQ; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ); + procedure simGenerateClock( + signal Clock : out std_logic; + constant Period : in time; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ); + procedure simGenerateClock( + constant TestID : in T_SIM_TEST_ID; + signal Clock : out std_logic; + constant Period : in time; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ); + + procedure simWaitUntilRisingEdge(signal Clock : in std_logic; constant Times : in positive); + procedure simWaitUntilRisingEdge(constant TestID : in T_SIM_TEST_ID; signal Clock : in std_logic; constant Times : in positive); + procedure simWaitUntilFallingEdge(signal Clock : in std_logic; constant Times : in positive); + procedure simWaitUntilFallingEdge(constant TestID : in T_SIM_TEST_ID; signal Clock : in std_logic; constant Times : in positive); + + procedure simGenerateClock2(constant TestID : in T_SIM_TEST_ID; signal Clock : out std_logic; signal Debug : out REAL; constant Period : in time); + + -- waveform description + -- =========================================================================== + type T_SIM_WAVEFORM_TUPLE_SL is record + Delay : time; + Value : std_logic; + end record; + + type T_SIM_WAVEFORM_TUPLE_SLV_8 is record + Delay : time; + Value : T_SLV_8; + end record; + + type T_SIM_WAVEFORM_TUPLE_SLV_16 is record + Delay : time; + Value : T_SLV_16; + end record; + + type T_SIM_WAVEFORM_TUPLE_SLV_24 is record + Delay : time; + Value : T_SLV_24; + end record; + + type T_SIM_WAVEFORM_TUPLE_SLV_32 is record + Delay : time; + Value : T_SLV_32; + end record; + + type T_SIM_WAVEFORM_TUPLE_SLV_48 is record + Delay : time; + Value : T_SLV_48; + end record; + + type T_SIM_WAVEFORM_TUPLE_SLV_64 is record + Delay : time; + Value : T_SLV_64; + end record; + + subtype T_SIM_WAVEFORM is TIME_VECTOR; -- use predefined physical type TIME here + type T_SIM_WAVEFORM_SL is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SL; + type T_SIM_WAVEFORM_SLV_8 is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SLV_8; + type T_SIM_WAVEFORM_SLV_16 is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SLV_16; + type T_SIM_WAVEFORM_SLV_24 is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SLV_24; + type T_SIM_WAVEFORM_SLV_32 is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SLV_32; + type T_SIM_WAVEFORM_SLV_48 is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SLV_48; + type T_SIM_WAVEFORM_SLV_64 is array(natural range <>) of T_SIM_WAVEFORM_TUPLE_SLV_64; + + -- waveform generation procedures + -- =========================================================================== + -- TODO: get initial value from Waveform(0) if .Delay = o fs, otherwise use (others => 'U') ? + procedure simGenerateWaveform( + signal Wave : out boolean; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in boolean := FALSE + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out boolean; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in boolean := FALSE + ); + procedure simGenerateWaveform( + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in std_logic := '0' + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in std_logic := '0' + ); + procedure simGenerateWaveform( + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM_SL; + constant InitialValue : in std_logic := '0' + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM_SL; + constant InitialValue : in std_logic := '0' + ); + procedure simGenerateWaveform( + signal Wave : out T_SLV_8; + constant Waveform : in T_SIM_WAVEFORM_SLV_8; + constant InitialValue : in T_SLV_8 := (others => '0') + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_8; + constant Waveform : in T_SIM_WAVEFORM_SLV_8; + constant InitialValue : in T_SLV_8 := (others => '0') + ); + procedure simGenerateWaveform( + signal Wave : out T_SLV_16; + constant Waveform : in T_SIM_WAVEFORM_SLV_16; + constant InitialValue : in T_SLV_16 := (others => '0') + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_16; + constant Waveform : in T_SIM_WAVEFORM_SLV_16; + constant InitialValue : in T_SLV_16 := (others => '0') + ); + procedure simGenerateWaveform( + signal Wave : out T_SLV_24; + constant Waveform : in T_SIM_WAVEFORM_SLV_24; + constant InitialValue : in T_SLV_24 := (others => '0') + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_24; + constant Waveform : in T_SIM_WAVEFORM_SLV_24; + constant InitialValue : in T_SLV_24 := (others => '0') + ); + procedure simGenerateWaveform( + signal Wave : out T_SLV_32; + constant Waveform : in T_SIM_WAVEFORM_SLV_32; + constant InitialValue : in T_SLV_32 := (others => '0') + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_32; + constant Waveform : in T_SIM_WAVEFORM_SLV_32; + constant InitialValue : in T_SLV_32 := (others => '0') + ); + procedure simGenerateWaveform( + signal Wave : out T_SLV_48; + constant Waveform : in T_SIM_WAVEFORM_SLV_48; + constant InitialValue : in T_SLV_48 := (others => '0') + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_48; + constant Waveform : in T_SIM_WAVEFORM_SLV_48; + constant InitialValue : in T_SLV_48 := (others => '0') + ); + procedure simGenerateWaveform( + signal Wave : out T_SLV_64; + constant Waveform : in T_SIM_WAVEFORM_SLV_64; + constant InitialValue : in T_SLV_64 := (others => '0') + ); + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_64; + constant Waveform : in T_SIM_WAVEFORM_SLV_64; + constant InitialValue : in T_SLV_64 := (others => '0') + ); + + function "*" (Wave : T_SIM_WAVEFORM; Times : natural) return T_SIM_WAVEFORM; + function ">" (Wave : T_SIM_WAVEFORM; Offset : time) return T_SIM_WAVEFORM; + function "<" (Wave : T_SIM_WAVEFORM; Offset : time) return T_SIM_WAVEFORM; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_8; Times : natural) return T_SIM_WAVEFORM_SLV_8; + function ">" (Wave : T_SIM_WAVEFORM_SLV_8; Offset : time) return T_SIM_WAVEFORM_SLV_8; + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_8; Offset : TIME) return T_SIM_WAVEFORM_SLV_8; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_16; Times : natural) return T_SIM_WAVEFORM_SLV_16; + function ">" (Wave : T_SIM_WAVEFORM_SLV_16; Offset : time) return T_SIM_WAVEFORM_SLV_16; + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_16; Offset : TIME) return T_SIM_WAVEFORM_SLV_16; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_24; Times : natural) return T_SIM_WAVEFORM_SLV_24; + function ">" (Wave : T_SIM_WAVEFORM_SLV_24; Offset : time) return T_SIM_WAVEFORM_SLV_24; + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_24; Offset : TIME) return T_SIM_WAVEFORM_SLV_24; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_32; Times : natural) return T_SIM_WAVEFORM_SLV_32; + function ">" (Wave : T_SIM_WAVEFORM_SLV_32; Offset : time) return T_SIM_WAVEFORM_SLV_32; + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_32; Offset : TIME) return T_SIM_WAVEFORM_SLV_32; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_48; Times : natural) return T_SIM_WAVEFORM_SLV_48; + function ">" (Wave : T_SIM_WAVEFORM_SLV_48; Offset : time) return T_SIM_WAVEFORM_SLV_48; + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_48; Offset : TIME) return T_SIM_WAVEFORM_SLV_48; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_64; Times : natural) return T_SIM_WAVEFORM_SLV_64; + function ">" (Wave : T_SIM_WAVEFORM_SLV_64; Offset : time) return T_SIM_WAVEFORM_SLV_64; + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_64; Offset : TIME) return T_SIM_WAVEFORM_SLV_64; + + -- convert arrays to waveforms + -- TODO: optimize waveform if input data doesn't change + -- TODO: write single bit variant + function to_waveform(bv : bit_vector; Delay : time) return T_SIM_WAVEFORM; + function to_waveform(slv : std_logic_vector; Delay : time) return T_SIM_WAVEFORM_SL; + function to_waveform(slvv : T_SLVV_8; Delay : time) return T_SIM_WAVEFORM_SLV_8; + function to_waveform(slvv : T_SLVV_16; Delay : time) return T_SIM_WAVEFORM_SLV_16; + function to_waveform(slvv : T_SLVV_24; Delay : time) return T_SIM_WAVEFORM_SLV_24; + function to_waveform(slvv : T_SLVV_32; Delay : time) return T_SIM_WAVEFORM_SLV_32; + function to_waveform(slvv : T_SLVV_48; Delay : time) return T_SIM_WAVEFORM_SLV_48; + function to_waveform(slvv : T_SLVV_64; Delay : time) return T_SIM_WAVEFORM_SLV_64; + + -- predefined common waveforms + function simGenerateWaveform_Reset(constant Pause : time := 0 ns; ResetPulse : time := 10 ns) return T_SIM_WAVEFORM; + + -- TODO: integrate VCD simulation functions and procedures from sim_value_change_dump.vhdl here + end package; + + +package body waveform is + -- clock generation + -- =========================================================================== + procedure simGenerateClock( + signal Clock : out std_logic; + constant Frequency : in FREQ; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ) is + constant Period : time := to_time(Frequency); + begin + simGenerateClock(C_SIM_DEFAULT_TEST_ID, Clock, Period, Phase, DutyCycle, Wander); + end procedure; + + procedure simGenerateClock( + constant TestID : in T_SIM_TEST_ID; + signal Clock : out std_logic; + constant Frequency : in FREQ; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ) is + constant Period : time := to_time(Frequency); + begin + simGenerateClock(TestID, Clock, Period, Phase, DutyCycle, Wander); + end procedure; + + procedure simGenerateClock( + signal Clock : out std_logic; + constant Period : in time; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ) is + begin + simGenerateClock(C_SIM_DEFAULT_TEST_ID, Clock, Period, Phase, DutyCycle, Wander); + end procedure; + + procedure simGenerateClock( + constant TestID : in T_SIM_TEST_ID; + signal Clock : out std_logic; + constant Period : in time; + constant Phase : in T_PHASE := 0 deg; + constant DutyCycle : in T_DUTYCYCLE := 50 percent; + constant Wander : in T_WANDER := 0 permil + ) is + constant NormalizedPhase : T_PHASE := ite((Phase >= 0 deg), Phase, Phase + 360 deg); -- move Phase into the range of 0° to 360° + constant PhaseAsFactor : REAL := real(NormalizedPhase / 1 second) / 1296000.0; -- 1,296,000 = 3,600 seconds * 360 degree per cycle + constant WanderAsFactor : REAL := real(Wander / 1 ppb) / 1.0e9; + constant DutyCycleAsFactor : REAL := real(DutyCycle / 1 permil) / 1000.0; + constant Delay : time := Period * PhaseAsFactor; + constant TimeHigh : time := Period * DutyCycleAsFactor + (Period * (WanderAsFactor / 2.0)); -- add 50% wander to the high level + constant TimeLow : time := Period - TimeHigh + (Period * WanderAsFactor); -- and 50% to the low level + constant ClockAfterRun_cy : positive := 5; + + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateClock(period=" & to_string(Period, 2) & ")", IsLowPriority => TRUE); + begin + -- report "simGenerateClock: (Instance: '" & Clock'instance_name & "')" & LF & + -- "Period: " & TIME'image(Period) & LF & + -- "Phase: " & T_PHASE'image(Phase) & LF & + -- "DutyCycle: " & T_DUTYCYCLE'image(DutyCycle) & LF & + -- "PhaseAsFactor: " & REAL'image(PhaseAsFactor) & LF & + -- "WanderAsFactor: " & REAL'image(WanderAsFactor) & LF & + -- "DutyCycleAsFactor: " & REAL'image(DutyCycleAsFactor) & LF & + -- "Delay: " & TIME'image(Delay) & LF & + -- "TimeHigh: " & TIME'image(TimeHigh) & LF & + -- "TimeLow: " & TIME'image(TimeLow) + -- severity NOTE; + + if (Delay = 0 ns) then + null; + elsif (Delay <= TimeLow) then + Clock <= '0'; + wait for Delay; + else + Clock <= '1'; + wait for Delay - TimeLow; + Clock <= '0'; + wait for TimeLow; + end if; + Clock <= '1'; + while not simIsStopped(TestID) loop + wait for TimeHigh; + Clock <= '0'; + wait for TimeLow; + Clock <= '1'; + end loop; + simDeactivateProcess(PROCESS_ID); + -- create N more cycles to allow other processes to recognize the stop condition (clock after run) + for i in 1 to ClockAfterRun_cy loop + wait for TimeHigh; + Clock <= '0'; + wait for TimeLow; + Clock <= '1'; + end loop; + Clock <= '0'; + end procedure; + + type T_SIM_NORMAL_DIST_PARAMETER is record + StandardDeviation : REAL; + Mean : REAL; + end record; + type T_JITTER_DISTRIBUTION is array (natural range <>) of T_SIM_NORMAL_DIST_PARAMETER; + + procedure simGenerateClock2( + constant TestID : in T_SIM_TEST_ID; + signal Clock : out std_logic; + signal Debug : out REAL; + constant Period : in time + ) is + constant TimeHigh : time := Period * 0.5; + constant TimeLow : time := Period - TimeHigh; + constant JitterPeakPeak : REAL := 0.1; -- UI + constant JitterAsFactor : REAL := JitterPeakPeak / 4.0; -- Maximum jitter per edge + constant JitterDistribution : T_JITTER_DISTRIBUTION := ( + -- 0 => (StandardDeviation => 0.2, Mean => -0.4), + -- 1 => (StandardDeviation => 0.2, Mean => 0.4) + + -- 0 => (StandardDeviation => 0.2, Mean => -0.4), + -- 1 => (StandardDeviation => 0.3, Mean => -0.1), + -- 2 => (StandardDeviation => 0.5, Mean => 0.0), + -- 3 => (StandardDeviation => 0.3, Mean => 0.1), + -- 4 => (StandardDeviation => 0.2, Mean => 0.4) + + 0 => (StandardDeviation => 0.15, Mean => -0.6), + 1 => (StandardDeviation => 0.2, Mean => -0.3), + 2 => (StandardDeviation => 0.25, Mean => -0.2), + 3 => (StandardDeviation => 0.3, Mean => 0.0), + 4 => (StandardDeviation => 0.25, Mean => 0.2), + 5 => (StandardDeviation => 0.2, Mean => 0.3), + 6 => (StandardDeviation => 0.15, Mean => 0.6) + ); + variable Seed : T_SIM_RAND_SEED; + variable rand : REAL; + variable Jitter : REAL; + variable Index : natural; + + constant ClockAfterRun_cy : positive := 5; + begin + Clock <= '1'; + randInitializeSeed(Seed); + + while not simIsStopped(TestID) loop + ieee.math_real.Uniform(Seed.Seed1, Seed.Seed2, rand); + Index := scale(rand, 0, JitterDistribution'length * 10) mod JitterDistribution'length; + randNormalDistributedValue(Seed, rand, JitterDistribution(Index).StandardDeviation, JitterDistribution(Index).Mean, -1.0, 1.0); + + Jitter := JitterAsFactor * rand; + Debug <= rand; + + -- Debug <= integer(rand * 256.0 + 256.0); + wait for TimeHigh + (Period * Jitter); + Clock <= '0'; + wait for TimeLow + (Period * Jitter); + Clock <= '1'; + end loop; + -- create N more cycles to allow other processes to recognize the stop condition (clock after run) + for i in 1 to ClockAfterRun_cy loop + wait for TimeHigh; + Clock <= '0'; + wait for TimeLow; + Clock <= '1'; + end loop; + Clock <= '0'; + end procedure; + + + procedure simWaitUntilRisingEdge(signal Clock : in std_logic; constant Times : in positive) is + begin + simWaitUntilRisingEdge(C_SIM_DEFAULT_TEST_ID, Clock, Times); + end procedure; + + procedure simWaitUntilRisingEdge(constant TestID : in T_SIM_TEST_ID; signal Clock : in std_logic; constant Times : in positive) is + begin + for i in 1 to Times loop + wait until rising_edge(Clock); + exit when simIsStopped(TestID); + end loop; + end procedure; + + procedure simWaitUntilFallingEdge(signal Clock : in std_logic; constant Times : in positive) is + begin + simWaitUntilFallingEdge(C_SIM_DEFAULT_TEST_ID, Clock, Times); + end procedure; + + procedure simWaitUntilFallingEdge(constant TestID : in T_SIM_TEST_ID; signal Clock : in std_logic; constant Times : in positive) is + begin + for i in 1 to Times loop + wait until falling_edge(Clock); + exit when simIsStopped(TestID); + end loop; + end procedure; + + -- waveform generation + -- =========================================================================== + procedure simGenerateWaveform( + signal Wave : out boolean; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in boolean := FALSE + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out boolean; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in boolean := FALSE + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + variable State : boolean; + begin + State := InitialValue; + Wave <= State; + for i in Waveform'range loop + wait for Waveform(i); + State := not State; + Wave <= State; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in std_logic := '0' + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM; + constant InitialValue : in std_logic := '0' + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + variable State : std_logic; + begin + State := InitialValue; + Wave <= State; + for i in Waveform'range loop + wait for Waveform(i); + State := not State; + Wave <= State; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM_SL; + constant InitialValue : in std_logic := '0' + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out std_logic; + constant Waveform : in T_SIM_WAVEFORM_SL; + constant InitialValue : in std_logic := '0' + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out T_SLV_8; + constant Waveform : in T_SIM_WAVEFORM_SLV_8; + constant InitialValue : in T_SLV_8 := (others => '0') + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_8; + constant Waveform : in T_SIM_WAVEFORM_SLV_8; + constant InitialValue : in T_SLV_8 := (others => '0') + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out T_SLV_16; + constant Waveform : in T_SIM_WAVEFORM_SLV_16; + constant InitialValue : in T_SLV_16 := (others => '0') + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_16; + constant Waveform : in T_SIM_WAVEFORM_SLV_16; + constant InitialValue : in T_SLV_16 := (others => '0') + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out T_SLV_24; + constant Waveform : in T_SIM_WAVEFORM_SLV_24; + constant InitialValue : in T_SLV_24 := (others => '0') + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_24; + constant Waveform : in T_SIM_WAVEFORM_SLV_24; + constant InitialValue : in T_SLV_24 := (others => '0') + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out T_SLV_32; + constant Waveform : in T_SIM_WAVEFORM_SLV_32; + constant InitialValue : in T_SLV_32 := (others => '0') + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_32; + constant Waveform : in T_SIM_WAVEFORM_SLV_32; + constant InitialValue : in T_SLV_32 := (others => '0') + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out T_SLV_48; + constant Waveform : in T_SIM_WAVEFORM_SLV_48; + constant InitialValue : in T_SLV_48 := (others => '0') + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_48; + constant Waveform : in T_SIM_WAVEFORM_SLV_48; + constant InitialValue : in T_SLV_48 := (others => '0') + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + procedure simGenerateWaveform( + signal Wave : out T_SLV_64; + constant Waveform : in T_SIM_WAVEFORM_SLV_64; + constant InitialValue : in T_SLV_64 := (others => '0') + ) is + begin + simGenerateWaveform(C_SIM_DEFAULT_TEST_ID, Wave, Waveform, InitialValue); + end procedure; + + procedure simGenerateWaveform( + constant TestID : in T_SIM_TEST_ID; + signal Wave : out T_SLV_64; + constant Waveform : in T_SIM_WAVEFORM_SLV_64; + constant InitialValue : in T_SLV_64 := (others => '0') + ) is + constant PROCESS_ID : T_SIM_PROCESS_ID := simRegisterProcess(TestID, "simGenerateWaveform"); + begin + Wave <= InitialValue; + for i in Waveform'range loop + wait for Waveform(i).Delay; + Wave <= Waveform(i).Value; + exit when simIsStopped(TestID); + end loop; + simDeactivateProcess(PROCESS_ID); + end procedure; + + -- Waveform arithmetic + function "*" (Wave : T_SIM_WAVEFORM; Times : natural) return T_SIM_WAVEFORM is + variable Result : T_SIM_WAVEFORM(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM; Offset : time) return T_SIM_WAVEFORM is + begin + return (Wave(Wave'low) + Offset) & Wave(Wave'low + 1 to Wave'high); + end function; + + function "<" (Wave : T_SIM_WAVEFORM; Offset : time) return T_SIM_WAVEFORM is + variable Result : T_SIM_WAVEFORM(Wave'range); + variable TimePos : time; + begin + report "Has bugs" severity ERROR; + TimePos := 0 fs; + for i in Wave'range loop + TimePos := TimePos + Wave(i); + if TimePos > Offset then + return (TimePos - Offset) & Wave(i + 1 to Wave'high); + end if; + end loop; + return (0 => 0 fs); + end function; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_8; Times : natural) return T_SIM_WAVEFORM_SLV_8 is + variable Result : T_SIM_WAVEFORM_SLV_8(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM_SLV_8; Offset : time) return T_SIM_WAVEFORM_SLV_8 is + begin + return T_SIM_WAVEFORM_TUPLE_SLV_8'( + Delay => Wave(Wave'low).Delay + Offset, + Value => Wave(Wave'low).Value + ) & Wave(Wave'low + 1 to Wave'high); + end function; + + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_8; Offset : TIME) return T_SIM_WAVEFORM_SLV_8 is + -- begin + -- report "Not implemented" severity FAILURE; + -- end function; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_16; Times : natural) return T_SIM_WAVEFORM_SLV_16 is + variable Result : T_SIM_WAVEFORM_SLV_16(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM_SLV_16; Offset : time) return T_SIM_WAVEFORM_SLV_16 is + begin + return T_SIM_WAVEFORM_TUPLE_SLV_16'( + Delay => Wave(Wave'low).Delay + Offset, + Value => Wave(Wave'low).Value + ) & Wave(Wave'low + 1 to Wave'high); + end function; + + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_16; Offset : TIME) return T_SIM_WAVEFORM_SLV_16 is + -- begin + -- report "Not implemented" severity FAILURE; + -- end function; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_24; Times : natural) return T_SIM_WAVEFORM_SLV_24 is + variable Result : T_SIM_WAVEFORM_SLV_24(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM_SLV_24; Offset : time) return T_SIM_WAVEFORM_SLV_24 is + begin + return T_SIM_WAVEFORM_TUPLE_SLV_24'( + Delay => Wave(Wave'low).Delay + Offset, + Value => Wave(Wave'low).Value + ) & Wave(Wave'low + 1 to Wave'high); + end function; + + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_24; Offset : TIME) return T_SIM_WAVEFORM_SLV_24 is + -- begin + -- report "Not implemented" severity FAILURE; + -- end function; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_32; Times : natural) return T_SIM_WAVEFORM_SLV_32 is + variable Result : T_SIM_WAVEFORM_SLV_32(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM_SLV_32; Offset : time) return T_SIM_WAVEFORM_SLV_32 is + begin + return T_SIM_WAVEFORM_TUPLE_SLV_32'( + Delay => Wave(Wave'low).Delay + Offset, + Value => Wave(Wave'low).Value + ) & Wave(Wave'low + 1 to Wave'high); + end function; + + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_32; Offset : TIME) return T_SIM_WAVEFORM_SLV_32 is + -- begin + -- report "Not implemented" severity FAILURE; + -- end function; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_48; Times : natural) return T_SIM_WAVEFORM_SLV_48 is + variable Result : T_SIM_WAVEFORM_SLV_48(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM_SLV_48; Offset : time) return T_SIM_WAVEFORM_SLV_48 is + begin + return T_SIM_WAVEFORM_TUPLE_SLV_48'( + Delay => Wave(Wave'low).Delay + Offset, + Value => Wave(Wave'low).Value + ) & Wave(Wave'low + 1 to Wave'high); + end function; + + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_48; Offset : TIME) return T_SIM_WAVEFORM_SLV_48 is + -- begin + -- report "Not implemented" severity FAILURE; + -- end function; + + function "*" (Wave : T_SIM_WAVEFORM_SLV_64; Times : natural) return T_SIM_WAVEFORM_SLV_64 is + variable Result : T_SIM_WAVEFORM_SLV_64(0 to Wave'length * Times - 1); + begin + for i in 0 to Times - 1 loop + Result(i * Wave'length to (i + 1) * Wave'length - 1) := Wave; + end loop; + return Result; + end function; + + function ">" (Wave : T_SIM_WAVEFORM_SLV_64; Offset : time) return T_SIM_WAVEFORM_SLV_64 is + begin + return T_SIM_WAVEFORM_TUPLE_SLV_64'( + Delay => Wave(Wave'low).Delay + Offset, + Value => Wave(Wave'low).Value + ) & Wave(Wave'low + 1 to Wave'high); + end function; + + -- function "<" (Wave : T_SIM_WAVEFORM_SLV_64; Offset : TIME) return T_SIM_WAVEFORM_SLV_64 is + -- begin + -- report "Not implemented" severity FAILURE; + -- end function; + + + function to_waveform(bv : bit_vector; Delay : time) return T_SIM_WAVEFORM is + variable Result : T_SIM_WAVEFORM(0 to bv'length - 1); + begin + report "Has bugs" severity ERROR; + for i in 0 to bv'length - 1 loop + Result(i) := Delay; + end loop; + return Result; + end function; + + function to_waveform(slv : std_logic_vector; Delay : time) return T_SIM_WAVEFORM_SL is + variable Result : T_SIM_WAVEFORM_SL(0 to slv'length - 1); + begin + for i in 0 to slv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slv(i); + end loop; + return Result; + end function; + + function to_waveform(slvv : T_SLVV_8; Delay : time) return T_SIM_WAVEFORM_SLV_8 is + variable Result : T_SIM_WAVEFORM_SLV_8(0 to slvv'length - 1); + begin + for i in 0 to slvv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slvv(i); + end loop; + return Result; + end function; + + function to_waveform(slvv : T_SLVV_16; Delay : time) return T_SIM_WAVEFORM_SLV_16 is + variable Result : T_SIM_WAVEFORM_SLV_16(0 to slvv'length - 1); + begin + for i in 0 to slvv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slvv(i); + end loop; + return Result; + end function; + + function to_waveform(slvv : T_SLVV_24; Delay : time) return T_SIM_WAVEFORM_SLV_24 is + variable Result : T_SIM_WAVEFORM_SLV_24(0 to slvv'length - 1); + begin + for i in 0 to slvv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slvv(i); + end loop; + return Result; + end function; + + function to_waveform(slvv : T_SLVV_32; Delay : time) return T_SIM_WAVEFORM_SLV_32 is + variable Result : T_SIM_WAVEFORM_SLV_32(0 to slvv'length - 1); + begin + for i in 0 to slvv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slvv(i); + end loop; + return Result; + end function; + + function to_waveform(slvv : T_SLVV_48; Delay : time) return T_SIM_WAVEFORM_SLV_48 is + variable Result : T_SIM_WAVEFORM_SLV_48(0 to slvv'length - 1); + begin + for i in 0 to slvv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slvv(i); + end loop; + return Result; + end function; + + function to_waveform(slvv : T_SLVV_64; Delay : time) return T_SIM_WAVEFORM_SLV_64 is + variable Result : T_SIM_WAVEFORM_SLV_64(0 to slvv'length - 1); + begin + for i in 0 to slvv'length - 1 loop + Result(i).Delay := Delay; + Result(i).Value := slvv(i); + end loop; + return Result; + end function; + + -- predefined common waveforms + function simGenerateWaveform_Reset(constant Pause : time := 0 ns; ResetPulse : time := 10 ns) return T_SIM_WAVEFORM is + variable p : time; + variable rp : time; + begin + -- WORKAROUND: for Mentor QuestaSim/ModelSim + -- Version: 10.4c + -- Issue: + -- return (0 => Pause, 1 => ResetPulse); always evaluates to (0 ns, 10 ns), + -- regardless of the passed function parameters + -- Bugfix: + -- The bugfix will be included in 10.5a, but this workaround must be + -- present until Altera updates the embedded ModelSim Altera Edition. + p := Pause; + rp := ResetPulse; + return (0 => p, 1 => rp); + end function; +end package body; diff --git a/testsuite/gna/issue317/PoC/src/sort/sortnet/sortnet_BitonicSort.vhdl b/testsuite/gna/issue317/PoC/src/sort/sortnet/sortnet_BitonicSort.vhdl new file mode 100644 index 000000000..49e0dd908 --- /dev/null +++ b/testsuite/gna/issue317/PoC/src/sort/sortnet/sortnet_BitonicSort.vhdl @@ -0,0 +1,194 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Entity: Sorting network: bitonic sort +-- +-- Description: +-- ------------------------------------- +-- This sorting network uses the *bitonic sort* algorithm. +-- +-- .. image:: /_static/sort/sortnet/sortnet_BitonicSort.* +-- :target: ../../../_static/sort/sortnet/sortnet_BitonicSort.svg +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.numeric_std.all; + +library PoC; +use PoC.config.all; +use PoC.utils.all; +use PoC.math.all; +use PoC.vectors.all; +use PoC.components.all; + + +entity sortnet_BitonicSort is + generic ( + INPUTS : positive := 32; -- input count + KEY_BITS : positive := 32; -- the first KEY_BITS of In_Data are used as a sorting critera (key) + DATA_BITS : positive := 64; -- inclusive KEY_BITS + META_BITS : natural := 2; -- additional bits, not sorted but delayed as long as In_Data + PIPELINE_STAGE_AFTER : natural := 2; -- add a pipline stage after n sorting stages + ADD_INPUT_REGISTERS : boolean := FALSE; -- + ADD_OUTPUT_REGISTERS : boolean := TRUE -- + ); + port ( + Clock : in std_logic; + Reset : in std_logic; + + Inverse : in std_logic := '0'; + + In_Valid : in std_logic; + In_IsKey : in std_logic; + In_Data : in T_SLM(INPUTS - 1 downto 0, DATA_BITS - 1 downto 0); + In_Meta : in std_logic_vector(META_BITS - 1 downto 0); + + Out_Valid : out std_logic; + Out_IsKey : out std_logic; + Out_Data : out T_SLM(INPUTS - 1 downto 0, DATA_BITS - 1 downto 0); + Out_Meta : out std_logic_vector(META_BITS - 1 downto 0) + ); +end entity; + + +architecture rtl of sortnet_BitonicSort is + constant C_VERBOSE : boolean := POC_VERBOSE; + + constant BLOCKS : positive := log2ceil(INPUTS); + constant STAGES : positive := triangularNumber(BLOCKS); + constant COMPARATORS : positive := STAGES * (INPUTS / 2); + + constant META_VALID_BIT : natural := 0; + constant META_ISKEY_BIT : natural := 1; + constant META_VECTOR_BITS : positive := META_BITS + 2; + + subtype T_META is std_logic_vector(META_VECTOR_BITS - 1 downto 0); + type T_META_VECTOR is array(natural range <>) of T_META; + + subtype T_DATA is std_logic_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + type T_DATA_MATRIX is array(natural range <>) of T_DATA_VECTOR(INPUTS - 1 downto 0); + + function to_dv(slm : T_SLM) return T_DATA_VECTOR is + variable Result : T_DATA_VECTOR(slm'range(1)); + begin + for i in slm'range(1) loop + for j in slm'high(2) downto slm'low(2) loop + Result(i)(j) := slm(i, j); + end loop; + end loop; + return Result; + end function; + + function to_slm(dv : T_DATA_VECTOR) return T_SLM is + variable Result : T_SLM(dv'range, T_DATA'range); + begin + for i in dv'range loop + for j in T_DATA'range loop + Result(i, j) := dv(i)(j); + end loop; + end loop; + return Result; + end function; + + signal In_Valid_d : std_logic := '0'; + signal In_IsKey_d : std_logic := '0'; + signal In_Data_d : T_SLM(INPUTS - 1 downto 0, DATA_BITS - 1 downto 0) := (others => (others => '0')); + signal In_Meta_d : std_logic_vector(META_BITS - 1 downto 0) := (others => '0'); + + signal MetaVector : T_META_VECTOR(STAGES downto 0) := (others => (others => '0')); + signal DataMatrix : T_DATA_MATRIX(STAGES downto 0) := (others => (others => (others => '0'))); + + signal MetaOutputs_d : T_META := (others => '0'); + signal DataOutputs_d : T_SLM(INPUTS - 1 downto 0, DATA_BITS - 1 downto 0) := (others => (others => '0')); + +begin + assert (not C_VERBOSE) + report "sortnet_BitonicSort:" & LF & + " DATA_BITS=" & integer'image(DATA_BITS) & + " KEY_BITS=" & integer'image(KEY_BITS) & + " META_BITS=" & integer'image(META_BITS) + severity NOTE; + + In_Valid_d <= In_Valid when registered(Clock, ADD_INPUT_REGISTERS); + In_IsKey_d <= In_IsKey when registered(Clock, ADD_INPUT_REGISTERS); + In_Data_d <= In_Data when registered(Clock, ADD_INPUT_REGISTERS); + In_Meta_d <= In_Meta when registered(Clock, ADD_INPUT_REGISTERS); + + DataMatrix(0) <= to_dv(In_Data_d); + MetaVector(0)(META_VALID_BIT) <= In_Valid_d; + MetaVector(0)(META_ISKEY_BIT) <= In_IsKey_d; + MetaVector(0)(META_VECTOR_BITS - 1 downto META_VECTOR_BITS - META_BITS) <= In_Meta_d; + + genBlocks : for b in 0 to BLOCKS - 1 generate + constant START_DISTANCE : positive := 2**b; + begin + genStage : for s in 0 to b generate + constant STAGE_INDEX : natural := triangularNumber(b) + s; + constant DISTANCE : positive := 2**(b - s); + constant GROUPS : positive := INPUTS / (DISTANCE * 2); + constant INSERT_PIPELINE_REGISTER : boolean := (PIPELINE_STAGE_AFTER /= 0) and (STAGE_INDEX mod PIPELINE_STAGE_AFTER = 0); + begin + MetaVector(STAGE_INDEX + 1) <= MetaVector(STAGE_INDEX) when registered(Clock, INSERT_PIPELINE_REGISTER); + + genGroups : for g in 0 to GROUPS - 1 generate + constant INV : std_logic := to_sl((g / (2 ** s) mod 2 = 1)); + begin + genLoop : for l in 0 to DISTANCE - 1 generate + constant SRC0 : natural := g * (DISTANCE * 2) + l; + constant SRC1 : natural := SRC0 + DISTANCE; + + signal Greater : std_logic; + signal Switch_d : std_logic; + signal Switch_en : std_logic; + signal Switch_r : std_logic := '0'; + signal Switch : std_logic; + signal NewData0 : T_DATA; + signal NewData1 : T_DATA; + + begin + Greater <= to_sl(unsigned(DataMatrix(STAGE_INDEX)(SRC0)(KEY_BITS - 1 downto 0)) > unsigned(DataMatrix(STAGE_INDEX)(SRC1)(KEY_BITS - 1 downto 0))); + Switch_d <= Greater xor Inverse xor INV; + Switch_en <= MetaVector(STAGE_INDEX)(META_ISKEY_BIT) and MetaVector(STAGE_INDEX)(META_VALID_BIT); + Switch_r <= ffdre(q => Switch_r, d => Switch_d, en => Switch_en) when rising_edge(Clock); + Switch <= mux(Switch_en, Switch_r, Switch_d); + + NewData0 <= mux(Switch, DataMatrix(STAGE_INDEX)(SRC0), DataMatrix(STAGE_INDEX)(SRC1)); + NewData1 <= mux(Switch, DataMatrix(STAGE_INDEX)(SRC1), DataMatrix(STAGE_INDEX)(SRC0)); + + DataMatrix(STAGE_INDEX + 1)(SRC0) <= NewData0 when registered(Clock, INSERT_PIPELINE_REGISTER); + DataMatrix(STAGE_INDEX + 1)(SRC1) <= NewData1 when registered(Clock, INSERT_PIPELINE_REGISTER); + end generate; + end generate; + end generate; + end generate; + + MetaOutputs_d <= MetaVector(STAGES) when registered(Clock, ADD_OUTPUT_REGISTERS); + DataOutputs_d <= to_slm(DataMatrix(STAGES)) when registered(Clock, ADD_OUTPUT_REGISTERS); + + Out_Valid <= MetaOutputs_d(META_VALID_BIT); + Out_IsKey <= MetaOutputs_d(META_ISKEY_BIT); + Out_Data <= DataOutputs_d; + Out_Meta <= MetaOutputs_d(META_VECTOR_BITS - 1 downto META_VECTOR_BITS - META_BITS); +end architecture; diff --git a/testsuite/gna/issue317/PoC/tb/common/config_tb.vhdl b/testsuite/gna/issue317/PoC/tb/common/config_tb.vhdl new file mode 100644 index 000000000..1b9ab0f82 --- /dev/null +++ b/testsuite/gna/issue317/PoC/tb/common/config_tb.vhdl @@ -0,0 +1,81 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- +-- ============================================================================= +-- Authors: Thomas B. Preusser +-- Patrick Lehmann +-- +-- Testbench: Tests global constants, functions and settings +-- +-- Description: +-- ------------------------------------ +-- TODO +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library PoC; +use PoC.config.all; +use PoC.utils.all; +-- simulation only packages +use PoC.sim_types.all; +use PoC.simulation.all; + + +entity config_tb is +end config_tb; + + +architecture tb of config_tb is + signal SimQuiet : boolean := true; +begin + + procChecker : process + constant simProcessID : T_SIM_PROCESS_ID := simRegisterProcess("Checker"); + begin + if not SimQuiet then + report "is simulation?: " & boolean'image(SIMULATION) severity note; + report "Vendor: " & T_VENDOR'image(VENDOR) severity note; + report "Device: " & T_DEVICE'image(DEVICE) severity note; + report "Device Family: " & T_DEVICE_FAMILY'image(DEVICE_FAMILY) severity note; + report "Device Subtype: " & T_DEVICE_SUBTYPE'image(DEVICE_SUBTYPE) severity note; + report "Device Series: " & T_DEVICE_SERIES'image(DEVICE_SERIES) severity note; + report "Device Generation: " & integer'image(DEVICE_GENERATION) severity note; + report "Device Number: " & integer'image(DEVICE_NUMBER) severity note; + report "--------------------------------------------------" severity note; + report "LUT fan-in: " & integer'image(LUT_FANIN) severity note; + report "Transceiver: " & T_TRANSCEIVER'image(TRANSCEIVER_TYPE) severity note; + end if; + + simAssertion((SIMULATION = TRUE), "SIMULATION=" & boolean'image(SIMULATION) & " Expected=TRUE"); + simAssertion((VENDOR = VENDOR_GENERIC), "VENDOR= " & T_VENDOR'image(VENDOR) & " Expected=VENDOR_XILINX"); + simAssertion((DEVICE = DEVICE_GENERIC), "DEVICE=" & T_DEVICE'image(DEVICE) & " Expected=DEVICE_KINTEX7"); + simAssertion((DEVICE_FAMILY = DEVICE_FAMILY_GENERIC), "DEVICE_FAMILY=" & T_DEVICE_FAMILY'image(DEVICE_FAMILY) & " Expected=DEVICE_FAMILY_KINTEX"); + simAssertion((DEVICE_NUMBER = 0), "DEVICE_NUMBER=" & integer'image(DEVICE_NUMBER) & " Expected=325"); + simAssertion((DEVICE_SUBTYPE = DEVICE_SUBTYPE_GENERIC), "DEVICE_SUBTYPE=" & T_DEVICE_SUBTYPE'image(DEVICE_SUBTYPE) & " Expected=DEVICE_SUBTYPE_T"); + simAssertion((DEVICE_GENERATION = 0), "DEVICE_GENERATION=" & integer'image(DEVICE_GENERATION) & " Expected=7"); + simAssertion((DEVICE_SERIES = DEVICE_SERIES_GENERIC), "DEVICE_SERIES=" & T_DEVICE_SERIES'image(DEVICE_SERIES) & " Expected=DEVICE_SERIES_7_SERIES"); + simAssertion((LUT_FANIN = 6), "LUT_FANIN=" & integer'image(LUT_FANIN) & " Expected=6"); + simAssertion((TRANSCEIVER_TYPE = TRANSCEIVER_GENERIC), "TRANSCEIVER_TYPE=" & T_TRANSCEIVER'image(TRANSCEIVER_TYPE) & " Expected=TRANSCEIVER_GTXE2"); + + -- This process is finished + simDeactivateProcess(simProcessID); + wait; -- forever + end process; +end architecture; diff --git a/testsuite/gna/issue317/PoC/tb/sort/sortnet/sortnet_BitonicSort_tb.vhdl b/testsuite/gna/issue317/PoC/tb/sort/sortnet/sortnet_BitonicSort_tb.vhdl new file mode 100644 index 000000000..b7f015674 --- /dev/null +++ b/testsuite/gna/issue317/PoC/tb/sort/sortnet/sortnet_BitonicSort_tb.vhdl @@ -0,0 +1,233 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Module: TODO +-- +-- Description: +-- ------------------------------------ +-- TODO +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.STD_LOGIC_1164.all; +use IEEE.NUMERIC_STD.all; + +library OSVVM; +use OSVVM.RandomPkg.all; + +library PoC; +use PoC.math.all; +use PoC.utils.all; +use PoC.vectors.all; +use PoC.strings.all; +use PoC.physical.all; +-- simulation only packages +use PoC.sim_types.all; +use PoC.simulation.all; +use PoC.waveform.all; + +library Test; + + +entity sortnet_BitonicSort_tb is +end entity; + + +architecture tb of sortnet_BitonicSort_tb is + constant TAG_BITS : positive := 4; + + constant INPUTS : positive := 64; + constant DATA_COLUMNS : positive := 2; + + constant KEY_BITS : positive := 32; + constant DATA_BITS : positive := 64; + constant META_BITS : positive := TAG_BITS; + constant PIPELINE_STAGE_AFTER : natural := 2; + + constant LOOP_COUNT : positive := 32; -- 1024; + + constant STAGES : positive := triangularNumber(log2ceil(INPUTS)); + constant DELAY : natural := STAGES / PIPELINE_STAGE_AFTER; + + package P_SORTNET_TB is new Test.sortnet_tb + generic map ( + META_BITS => META_BITS, + DATA_BITS => DATA_BITS, + INPUTS => INPUTS + ); + use P_SORTNET_TB.all; + + constant CLOCK_FREQ : FREQ := 100 MHz; + signal Clock : std_logic := '1'; + + signal Generator_Valid : std_logic := '0'; + signal Generator_IsKey : std_logic := '0'; + signal Generator_Data : T_DATA_VECTOR(INPUTS - 1 downto 0) := (others => (others => '0')); + signal Generator_Meta : std_logic_vector(META_BITS - 1 downto 0) := (others => '0'); + + signal Sort_Valid : std_logic; + signal Sort_IsKey : std_logic; + signal Sort_Data : T_DATA_VECTOR(INPUTS - 1 downto 0); + signal Sort_Meta : std_logic_vector(META_BITS - 1 downto 0); + + signal DataInputMatrix : T_SLM(INPUTS - 1 downto 0, DATA_BITS - 1 downto 0); + signal DataOutputMatrix : T_SLM(INPUTS - 1 downto 0, DATA_BITS - 1 downto 0); + + shared variable ScoreBoard : PT_SCOREBOARD; + +begin + -- initialize global simulation status + simInitialize; + + simWriteMessage("SETTINGS"); + simWriteMessage(" INPUTS: " & integer'image(INPUTS)); + simWriteMessage(" KEY_BITS: " & integer'image(KEY_BITS)); + simWriteMessage(" DATA_BITS: " & integer'image(DATA_BITS)); + simWriteMessage(" REG AFTER: " & integer'image(PIPELINE_STAGE_AFTER)); + + simGenerateClock(Clock, CLOCK_FREQ); + + procGenerator : process + constant simProcessID : T_SIM_PROCESS_ID := simRegisterProcess("Generator"); + variable RandomVar : RandomPType; -- protected type from RandomPkg + + variable KeyInput : std_logic_vector(KEY_BITS - 1 downto 0); + variable DataInput : std_logic_vector(DATA_BITS - KEY_BITS - 1 downto 0); + variable TagInput : std_logic_vector(TAG_BITS - 1 downto 0); + variable Generator_Input : T_DATA_VECTOR(INPUTS - 1 downto 0); + + function GreaterThan(L : std_logic_vector; R : std_logic_vector) return boolean is + alias LL is L(KEY_BITS - 1 downto 0); + alias RR is R(KEY_BITS - 1 downto 0); + begin + return unsigned(LL) > unsigned(RR); + end function; + + variable ScoreBoardData : T_SCOREBOARD_DATA; + begin + RandomVar.InitSeed(RandomVar'instance_name); -- Generate initial seeds + + Generator_Valid <= '0'; + Generator_IsKey <= '0'; + Generator_Input := (others => (others => '0')); + Generator_Meta <= (others => '0'); + wait until rising_edge(Clock); + + Generator_Valid <= '1'; + for i in 0 to LOOP_COUNT - 1 loop +-- report "Loop: " & integer'image (i) severity note; + TagInput := RandomVar.RandSlv(TAG_BITS); + + ScoreBoardData.IsKey := to_sl(i mod DATA_COLUMNS = 0); + ScoreBoardData.Meta := resize(TagInput, META_BITS); + Generator_IsKey <= ScoreBoardData.IsKey; + Generator_Meta <= ScoreBoardData.Meta; + + KeyInput := RandomVar.RandSlv(KEY_BITS); + DataInput := RandomVar.RandSlv(DATA_BITS - KEY_BITS); + Generator_Input(0) := DataInput & KeyInput; + ScoreBoardData.Data(0):= Generator_Input(0); + + loop_j: for j in 1 to INPUTS - 1 loop + KeyInput := RandomVar.RandSlv(KEY_BITS); + DataInput := RandomVar.RandSlv(DATA_BITS - KEY_BITS); + Generator_Input(j) := DataInput & KeyInput; + + for k in j downto 1 loop + if GreaterThan(ScoreBoardData.Data(k - 1), Generator_Input(j)) then + ScoreBoardData.Data(k) := ScoreBoardData.Data(k - 1); + else + ScoreBoardData.Data(k) := Generator_Input(j); + next loop_j; + end if; + end loop; + ScoreBoardData.Data(0) := Generator_Input(j); + end loop; + + Generator_Data <= Generator_Input; + ScoreBoard.Push(ScoreBoardData); + wait until rising_edge(Clock); + end loop; + + Generator_Valid <= '0'; + wait until rising_edge(Clock); + + -- This process is finished + simDeactivateProcess(simProcessID); + wait; -- forever + end process; + + DataInputMatrix <= to_slm(Generator_Data); + + sort : entity PoC.sortnet_BitonicSort + generic map ( + INPUTS => INPUTS, + KEY_BITS => KEY_BITS, + DATA_BITS => DATA_BITS, + META_BITS => META_BITS, + PIPELINE_STAGE_AFTER => PIPELINE_STAGE_AFTER + ) + port map ( + Clock => Clock, + Reset => '0', + + In_Valid => Generator_Valid, + In_IsKey => Generator_IsKey, + In_Data => DataInputMatrix, + In_Meta => Generator_Meta, + + Out_Valid => Sort_Valid, + Out_IsKey => Sort_IsKey, + Out_Data => DataOutputMatrix, + Out_Meta => Sort_Meta + ); + + Sort_Data <= to_dv(DataOutputMatrix); + + procChecker : process + constant simProcessID : T_SIM_PROCESS_ID := simRegisterProcess("Checker"); + variable Check : boolean; + variable CurValue : unsigned(KEY_BITS - 1 downto 0); + variable LastValue : unsigned(KEY_BITS - 1 downto 0); + + variable ScoreBoardData : T_SCOREBOARD_DATA; + begin + wait until rising_edge(Sort_Valid); + + for i in 0 to LOOP_COUNT - 1 loop + wait until falling_edge(Clock); + + Check := TRUE; + ScoreBoardData.IsKey := Sort_IsKey; + ScoreBoardData.Meta := Sort_Meta; + ScoreBoardData.Data := Sort_Data; + ScoreBoard.Check(ScoreBoardData); + end loop; + -- simAssertion(Check, "Result is not monotonic." & raw_format_slv_hex(std_logic_vector(LastValue))); + + -- This process is finished + simDeactivateProcess(simProcessID); + wait; -- forever + end process; +end architecture; diff --git a/testsuite/gna/issue317/PoC/tb/sort/sortnet/sortnet_tb.pkg.vhdl b/testsuite/gna/issue317/PoC/tb/sort/sortnet/sortnet_tb.pkg.vhdl new file mode 100644 index 000000000..a70137a74 --- /dev/null +++ b/testsuite/gna/issue317/PoC/tb/sort/sortnet/sortnet_tb.pkg.vhdl @@ -0,0 +1,125 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Module: TODO +-- +-- Description: +-- ------------------------------------ +-- TODO +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair of VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library IEEE; +use IEEE.STD_LOGIC_1164.all; +use IEEE.NUMERIC_STD.all; + +library OSVVM; + +library PoC; +use PoC.utils.all; +use PoC.vectors.all; +use PoC.strings.all; + + +package sortnet_tb is + generic ( + META_BITS : positive; + DATA_BITS : positive; + INPUTS : positive + ); + + subtype T_DATA is std_logic_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + function to_dv(slm : T_SLM) return T_DATA_VECTOR; + function to_slm(dv : T_DATA_VECTOR) return T_SLM; + + type T_SCOREBOARD_DATA is record + IsKey : std_logic; + Meta : std_logic_vector(META_BITS - 1 downto 0); + Data : T_DATA_VECTOR(INPUTS - 1 downto 0); + end record; + + function match(expected : T_SCOREBOARD_DATA; actual : T_SCOREBOARD_DATA) return boolean; + function to_string(dataset : T_SCOREBOARD_DATA) return string; + + package P_SCOREBOARD is new OSVVM.ScoreboardGenericPkg + generic map ( + ExpectedType => T_SCOREBOARD_DATA, + ActualType => T_SCOREBOARD_DATA, + Match => match, + expected_to_string => to_string, --[T_SCOREBOARD_DATA return string], + actual_to_string => to_string + ); + + alias PT_SCOREBOARD is P_SCOREBOARD.ScoreBoardPType; +end package; + + +package body sortnet_tb is + function match(expected : T_SCOREBOARD_DATA; actual : T_SCOREBOARD_DATA) return boolean is + variable good : boolean; + begin + good := (expected.IsKey = actual.IsKey); + good := good and (expected.Meta = actual.Meta); + if (expected.IsKey = '1') then + for i in expected.Data'range loop + good := good and (expected.Data(i) = actual.Data(i)); + exit when (good = FALSE); + end loop; + end if; + return good; + end function; + + function to_string(dataset : T_SCOREBOARD_DATA) return string is + variable KeyMarker : string(1 to 2); + begin + KeyMarker := ite((dataset.IsKey = '1'), "* ", " "); + -- for i in 0 to 0 loop --dataset.Key'range loop + return "Data: " & to_string(dataset.Data(0), 'h') & KeyMarker & + " Meta: " & to_string(dataset.Meta, 'h'); + -- end loop; + end function; + + function to_dv(slm : T_SLM) return T_DATA_VECTOR is + variable Result : T_DATA_VECTOR(slm'range(1)); + begin + for i in slm'high(1) downto slm'low(1) loop + for j in T_DATA'range loop + Result(i)(j) := slm(i, j); + end loop; + end loop; + return Result; + end function; + + function to_slm(dv : T_DATA_VECTOR) return T_SLM is + variable Result : T_SLM(dv'range, T_DATA'range); + begin + for i in dv'range loop + for j in T_DATA'range loop + Result(i, j) := dv(i)(j); + end loop; + end loop; + return Result; + end function; +end package body; diff --git a/testsuite/gna/issue317/my_config.vhdl b/testsuite/gna/issue317/my_config.vhdl new file mode 100644 index 000000000..dd00d87e7 --- /dev/null +++ b/testsuite/gna/issue317/my_config.vhdl @@ -0,0 +1,53 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*-
+-- vim: tabstop=2:shiftwidth=2:noexpandtab
+-- kate: tab-width 2; replace-tabs off; indent-width 2;
+--
+-- =============================================================================
+-- Authors: Thomas B. Preusser
+-- Martin Zabel
+-- Patrick Lehmann
+--
+-- Package: Project specific configuration.
+--
+-- Description:
+-- ------------------------------------
+-- This is a template file.
+--
+-- The global packages common/config and common/board evaluate the settings
+-- declared in this file.
+--
+-- USAGE:
+-- 1) Copy this file into your project's source directory and rename it to
+-- "my_config.vhdl".
+-- 2) Add file to library "PoC" in your synthesis tool.
+-- 3) Change setup appropriately.
+--
+-- License:
+-- =============================================================================
+-- Copyright 2007-2015 Technische Universitaet Dresden - Germany,
+-- Chair for VLSI-Design, Diagnostics and Architecture
+--
+-- Licensed under the Apache License, Version 2.0 (the "License");
+-- you may not use this file except in compliance with the License.
+-- You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS,
+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+-- See the License for the specific language governing permissions and
+-- limitations under the License.
+-- =============================================================================
+
+library PoC;
+
+
+package my_config is
+ -- Change these lines to setup configuration.
+ constant MY_BOARD : string := "ML505"; -- e.g. Custom, ML505, KC705, Atlys
+ constant MY_DEVICE : string := "XC5VLX50T-1FF1136"; -- e.g. None, XC5VLX50T-1FF1136, EP2SGX90FF1508C3
+
+ -- For internal use only
+ constant MY_VERBOSE : boolean := FALSE; -- activate detailed report statements in functions and procedures
+end package;
diff --git a/testsuite/gna/issue317/my_project.vhdl b/testsuite/gna/issue317/my_project.vhdl new file mode 100644 index 000000000..c774bcfa9 --- /dev/null +++ b/testsuite/gna/issue317/my_project.vhdl @@ -0,0 +1,47 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- +-- ============================================================================= +-- Authors: Patrick Lehmann +-- +-- Package: Project specific configuration. +-- +-- Description: +-- ------------------------------------ +-- This is a template file. +-- +-- TODO +-- +-- USAGE: +-- 1) Copy this file into your project's source directory and rename it to +-- "my_project.vhdl". +-- 2) Add file to library "poc" in your synthesis tool. +-- 3) Change setup appropriately. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2015 Technische Universitaet Dresden - Germany, +-- Chair for VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= + +library PoC; + + +package my_project is + -- Change these lines to setup configuration. + constant MY_PROJECT_DIR : string := "prjdir"; -- e.g. "d:/vhdl/myproject/", "/home/me/projects/myproject/" + constant MY_OPERATING_SYSTEM : string := "LINUX"; -- e.g. "WINDOWS", "LINUX" +end package; diff --git a/testsuite/gna/issue317/repro1.vhdl b/testsuite/gna/issue317/repro1.vhdl new file mode 100644 index 000000000..76ed6aaf5 --- /dev/null +++ b/testsuite/gna/issue317/repro1.vhdl @@ -0,0 +1,23 @@ +library IEEE; +use IEEE.STD_LOGIC_1164.all; +package sortnet_tb is + generic ( + DATA_BITS : positive; + INPUTS : positive + ); + + subtype T_DATA is std_logic_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + type T_SCOREBOARD_DATA is record + Data : T_DATA_VECTOR(INPUTS - 1 downto 0); + end record; +end sortnet_tb; + +entity repro1 is +end repro1; + +architecture behav of repro1 is + package tb is new work.sortnet_tb generic map (3, 4); +begin +end behav; diff --git a/testsuite/gna/issue317/repro2.vhdl b/testsuite/gna/issue317/repro2.vhdl new file mode 100644 index 000000000..7d3203fd8 --- /dev/null +++ b/testsuite/gna/issue317/repro2.vhdl @@ -0,0 +1,29 @@ +package repro2_scbd is + generic (type t); +end repro2_scbd; + +library IEEE; +use IEEE.STD_LOGIC_1164.all; +package repro2_sortnet_tb is + generic ( + DATA_BITS : positive; + INPUTS : positive + ); + + subtype T_DATA is std_logic_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + type T_SCOREBOARD_DATA is record + Data : T_DATA_VECTOR(INPUTS - 1 downto 0); + end record; + + package scbd is new work.repro2_scbd generic map (t => t_scoreboard_data); +end repro2_sortnet_tb; + +entity repro2 is +end repro2; + +architecture behav of repro2 is + package tb is new work.repro2_sortnet_tb generic map (3, 4); +begin +end behav; diff --git a/testsuite/gna/issue317/repro3.vhdl b/testsuite/gna/issue317/repro3.vhdl new file mode 100644 index 000000000..1f382ad21 --- /dev/null +++ b/testsuite/gna/issue317/repro3.vhdl @@ -0,0 +1,25 @@ +package repro3_sortnet_tb is + generic ( + DATA_BITS : positive + ); + + subtype T_DATA is bit_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + procedure dec (v : inout natural); +end repro3_sortnet_tb; + +package body repro3_sortnet_tb is + procedure dec (v : inout natural) is + begin + v := v - 1; + end dec; +end repro3_sortnet_tb; + +entity repro3 is +end repro3; + +architecture behav of repro3 is + package tb is new work.repro3_sortnet_tb generic map (3); +begin +end behav; diff --git a/testsuite/gna/issue317/repro4.on b/testsuite/gna/issue317/repro4.on new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/testsuite/gna/issue317/repro4.on diff --git a/testsuite/gna/issue317/repro4.vhdl b/testsuite/gna/issue317/repro4.vhdl new file mode 100644 index 000000000..952aec122 --- /dev/null +++ b/testsuite/gna/issue317/repro4.vhdl @@ -0,0 +1,45 @@ +package repro4_gen is + generic (type t; + function id (a : t) return t); + + function id2 (p : t) return t; +end repro4_gen; + +package body repro4_gen is + function id2 (p : t) return t + is +-- constant c : t := p; + begin + return id (p); + end id2; +end repro4_gen; + +package repro4_sortnet_tb is + generic ( + DATA_BITS : positive; + LEN : Positive + ); + + subtype T_DATA is bit_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(1 to LEN) of T_DATA; + + function id (a : t_data_vector) return t_data_vector; + + package inst is new work.repro4_gen + generic map (t => t_data_vector, id => id); +end repro4_sortnet_tb; + +package body repro4_sortnet_tb is + function id (a : t_data_vector) return t_data_vector is + begin + return a; + end id; +end repro4_sortnet_tb; + +entity repro4 is +end repro4; + +architecture behav of repro4 is + package tb is new work.repro4_sortnet_tb generic map (3, 4); +begin +end behav; diff --git a/testsuite/gna/issue317/repro5.vhdl b/testsuite/gna/issue317/repro5.vhdl new file mode 100644 index 000000000..405b700d7 --- /dev/null +++ b/testsuite/gna/issue317/repro5.vhdl @@ -0,0 +1,63 @@ +package repro5_gen is + generic (type t; + function id (a : t) return t); + + function id2 (p : t) return t; + + type prot is protected + procedure Set (V : natural); + impure function Get return Natural; + end protected prot; +end repro5_gen; + +package body repro5_gen is + function id2 (p : t) return t + is +-- constant c : t := p; + begin + return id (p); + end id2; + + type prot is protected body + variable val : Natural; + procedure Set (V : natural) is + begin + val := v; + end Set; + + impure function Get return Natural is + begin + return val; + end Get; + end protected body prot; +end repro5_gen; + +package repro5_sortnet_tb is + generic ( + DATA_BITS : positive; + LEN : Positive + ); + + subtype T_DATA is bit_vector(DATA_BITS - 1 downto 0); + type T_DATA_VECTOR is array(1 to LEN) of T_DATA; + + function id (a : t_data_vector) return t_data_vector; + + package inst is new work.repro5_gen + generic map (t => t_data_vector, id => id); +end repro5_sortnet_tb; + +package body repro5_sortnet_tb is + function id (a : t_data_vector) return t_data_vector is + begin + return a; + end id; +end repro5_sortnet_tb; + +entity repro5 is +end repro5; + +architecture behav of repro5 is + package tb is new work.repro5_sortnet_tb generic map (3, 4); +begin +end behav; diff --git a/testsuite/gna/issue317/testsuite.sh b/testsuite/gna/issue317/testsuite.sh new file mode 100755 index 000000000..87e669b82 --- /dev/null +++ b/testsuite/gna/issue317/testsuite.sh @@ -0,0 +1,86 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS="--std=08" + +# Reproducer1 (declaration of a record in an uninstantiated package) +analyze repro1.vhdl +elab_simulate repro1 + +# Reproducer2 (package instantiation within an uninstantiated package) +analyze repro2.vhdl +elab_simulate repro2 + +# Reproducer3 (package instantiation with implicit subprograms) +analyze repro3.vhdl +elab_simulate repro3 + +analyze repro4.vhdl +elab_simulate repro4 + +# Reproducer5 (with a protected type) +analyze repro5.vhdl +elab_simulate repro5 + +# OSVVM +if true; then +analyze --work=osvvm OSVVM/NamePkg.vhd +analyze --work=osvvm OSVVM/OsvvmGlobalPkg.vhd +analyze --work=osvvm OSVVM/TranscriptPkg.vhd +analyze --work=osvvm OSVVM/TextUtilPkg.vhd +analyze --work=osvvm OSVVM/AlertLogPkg.vhd +analyze --work=osvvm OSVVM/RandomBasePkg.vhd +analyze --work=osvvm OSVVM/SortListPkg_int.vhd +analyze --work=osvvm OSVVM/RandomPkg.vhd +#analyze --work=osvvm MessagePkg.vhd +#analyze --work=osvvm VendorCovApiPkg.vhd +#analyze --work=osvvm CoveragePkg.vhd +#analyze --work=osvvm MemoryPkg.vhd +analyze --work=osvvm OSVVM/ScoreboardGenericPkg.vhd +#analyze --work=osvvm ScoreboardPkg_int.vhd +#analyze --work=osvvm ScoreboardPkg_slv.vhd + +#analyze --work=osvvm ResolutionPkg.vhd +#analyze --work=osvvm TbUtilPkg.vhd +#analyze --work=osvvm OsvvmContext.vhd +fi + +# PoC (Poc) +analyze --work=poc my_config.vhdl +analyze --work=poc my_project.vhdl + +analyze --work=poc PoC/src/common/utils.vhdl +analyze --work=poc PoC/src/common/config.vhdl +analyze --work=poc PoC/src/common/math.vhdl +analyze --work=poc PoC/src/common/strings.vhdl +analyze --work=poc PoC/src/common/physical.vhdl +analyze --work=poc PoC/src/common/vectors.vhdl +analyze --work=poc PoC/src/common/protected.v08.vhdl +analyze --work=poc PoC/src/common/fileio.v08.vhdl +analyze --work=poc PoC/src/common/components.vhdl + +analyze --work=poc PoC/src/sim/sim_types.vhdl +analyze --work=poc PoC/src/sim/sim_protected.v08.vhdl +analyze --work=poc PoC/src/sim/sim_global.v08.vhdl +analyze --work=poc PoC/src/sim/sim_simulation.v08.vhdl +analyze --work=poc PoC/src/sim/sim_waveform.vhdl + +analyze --work=poc PoC/src/sort/sortnet/sortnet_BitonicSort.vhdl + +# PoC (test) +analyze --work=test PoC/tb/common/config_tb.vhdl + + +# Testcase +analyze --work=test PoC/tb/sort/sortnet/sortnet_tb.pkg.vhdl +analyze --work=test PoC/tb/sort/sortnet/sortnet_BitonicSort_tb.vhdl +elab_simulate --work=test sortnet_BitonicSort_tb --ieee-asserts=disable-at-0 + +clean +clean osvvm +clean poc +clean test + + +echo "Test successful" |