diff --git a/AlertLogPkg.vhd b/AlertLogPkg.vhd index e980095..d879b9b 100644 --- a/AlertLogPkg.vhd +++ b/AlertLogPkg.vhd @@ -1,7 +1,7 @@ -- -- File Name: AlertLogPkg.vhd -- Design Unit Name: AlertLogPkg --- Revision: STANDARD VERSION, revision 2015.03 +-- Revision: STANDARD VERSION -- -- Maintainer: Jim Lewis email: jim@synthworks.com -- Contributor(s): @@ -26,8 +26,9 @@ -- Revision History: -- Date Version Description -- 01/2015: 2015.01 Initial revision --- 02/2015 2015.03 Added: AlertIfEqual, AlertIfNotEqual, AlertIfDiff, PathTail, +-- 03/2015 2015.03 Added: AlertIfEqual, AlertIfNotEqual, AlertIfDiff, PathTail, -- ReportNonZeroAlerts, ReadLogEnables +-- 05/2015 2015.06 Added IncAlertCount, AffirmIf -- -- -- Copyright (c) 2015 by SynthWorks Design Inc. All rights reserved. @@ -54,6 +55,7 @@ use std.textio.all ; use work.OsvvmGlobalPkg.all ; use work.TranscriptPkg.all ; +use work.TextUtilPkg.all ; library IEEE ; use ieee.std_logic_1164.all ; @@ -66,18 +68,21 @@ package AlertLogPkg is 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) ; -- NEVER - subtype LogIndexType is LogType range DEBUG to INFO ; + type LogType is (ALWAYS, DEBUG, FINAL, INFO, PASSED) ; -- NEVER + subtype LogIndexType is LogType range DEBUG to PASSED ; type LogEnableType is array (LogIndexType) of boolean ; - constant ALERTLOG_BASE_ID : AlertLogIDType := 0 ; - constant ALERT_DEFAULT_ID : AlertLogIDType := 1 ; - constant LOG_DEFAULT_ID : AlertLogIDType := 1 ; - constant ALERTLOG_DEFAULT_ID : AlertLogIDType := ALERT_DEFAULT_ID ; - constant OSVVM_ALERTLOG_ID : AlertLogIDType := 2 ; - 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 + 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 ; @@ -89,7 +94,14 @@ package AlertLogPkg is 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 ) ; @@ -155,7 +167,15 @@ package AlertLogPkg is 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 ; @@ -163,6 +183,7 @@ package AlertLogPkg is 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 ; @@ -181,39 +202,51 @@ package AlertLogPkg is procedure Log( AlertLogID : AlertLogIDType ; Message : string ; - Level : LogType := ALWAYS + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable ) ; - procedure Log( Message : string ; Level : LogType := ALWAYS) ; + procedure Log( Message : string ; Level : LogType := ALWAYS ; Enable : boolean := FALSE) ; - impure function IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean ; - impure function IsLoggingEnabled(Level : LogType) return boolean ; - ------------------------------------------------------------ -- Accessor Methods procedure SetAlertLogName(Name : string ) ; - procedure InitializeAlertLogStruct ; + 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) 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 ; - impure function GetAlertLogName(AlertLogID : AlertLogIDType) return string ; ------------------------------------------------------------ procedure SetAlertLogOptions ( @@ -234,11 +267,28 @@ package AlertLogPkg is FailName : string := OSVVM_STRING_INIT_PARM_DETECT ) ; - -- Used by TextUtilPkg - impure function GetAlertReportPrefix return string ; - impure function GetAlertDoneName return string ; - impure function GetAlertPassName return string ; - impure function GetAlertFailName return string ; + 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 ; @@ -262,10 +312,7 @@ package body AlertLogPkg is 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 ") ; -- , NEVER => "NEVER " - - -- Local - constant NUM_PREDEFINED_AL_IDS : AlertLogIDType := 2 ; -- Not including base + constant LOG_NAME : LogNameType := (DEBUG => "DEBUG ", FINAL => "FINAL ", INFO => "INFO ", ALWAYS => "ALWAYS ", PASSED => "PASSED ") ; -- , NEVER => "NEVER " type AlertLogStructPType is protected @@ -279,6 +326,7 @@ package body AlertLogPkg is ) ; ------------------------------------------------------------ + 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 ) ; @@ -293,7 +341,8 @@ package body AlertLogPkg is ------------------------------------------------------------ AlertLogID : AlertLogIDType ; Message : string ; - Level : LogType := ALWAYS + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable ) ; ------------------------------------------------------------ @@ -312,7 +361,8 @@ package body AlertLogPkg is 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) 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 ; @@ -321,19 +371,25 @@ package body AlertLogPkg is -- 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 IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean ; + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean ; procedure ReportLogEnables ; - impure function GetAlertLogName(AlertLogID : AlertLogIDType) return string ; ------------------------------------------------------------ -- Reporting Accessor @@ -354,11 +410,27 @@ package body AlertLogPkg is PassName : string := OSVVM_STRING_INIT_PARM_DETECT ; FailName : string := OSVVM_STRING_INIT_PARM_DETECT ) ; - - impure function GetAlertReportPrefix return string ; - impure function GetAlertDoneName return string ; - impure function GetAlertPassName return string ; - impure function GetAlertFailName return string ; + 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 ; @@ -366,10 +438,11 @@ package body AlertLogPkg is type AlertLogStructPType is protected body - variable GlobalAlertEnabled : boolean := TRUE ; -- Allows turn off and on --- variable TranscriptEnabled : boolean := FALSE ; --- variable TranscriptMirrored : boolean := FALSE ; + variable GlobalAlertEnabledVar : boolean := TRUE ; -- Allows turn off and on + variable AffirmCheckCountVar : natural := 0 ; +--?? variable AffirmPassedCountVar : natural := 0 ; + ------------------------------------------------------------ type AlertLogRecType is record ------------------------------------------------------------ @@ -383,10 +456,12 @@ package body AlertLogPkg is ------------------------------------------------------------ -- Basis for AlertLog Data Structure - variable NumAlertLogIDs : AlertLogIDType := NUM_PREDEFINED_AL_IDS ; -- Initial number defined - variable NumAllocatedAlertLogIDs : AlertLogIDType := 0 ; - type AlertLogRecPtrType is access AlertLogRecType ; - type AlertLogArrayType is array (AlertLogIDType range <>) of AlertLogRecPtrType ; + 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 ; @@ -395,7 +470,8 @@ package body AlertLogPkg is variable FailOnWarningVar : boolean := TRUE ; variable FailOnDisabledErrorsVar : boolean := TRUE ; variable ReportHierarchyVar : boolean := TRUE ; - variable HierarchyInUseVar : boolean := FALSE ; + variable FoundReportHierVar : boolean := FALSE ; + variable FoundAlertHierVar : boolean := FALSE ; variable WriteAlertLevelVar : boolean := TRUE ; variable WriteAlertNameVar : boolean := TRUE ; @@ -460,18 +536,20 @@ package body AlertLogPkg is level : AlertType := ERROR ) is variable buf : Line ; - constant AlertPrefix : string := ResolveOsvvmOption(AlertPrefixVar.GetOpt, OSVVM_DEFAULT_ALERT_PREFIX) ; + constant AlertPrefix : string := AlertPrefixVar.Get(OSVVM_DEFAULT_ALERT_PREFIX) ; variable StopDueToCount : boolean := FALSE ; begin - if GlobalAlertEnabled then - -- do not write when disabled + 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 ; - if HierarchyInUseVar and WriteAlertNameVar then +--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 ; @@ -485,17 +563,44 @@ package body AlertLogPkg is IncrementAlertCount(AlertLogID, Level, StopDueToCount) ; if StopDueToCount then write(buf, LF & AlertPrefix & " Stop Count on " & ALERT_NAME(Level) & " reached") ; - if HierarchyInUseVar then +--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 ; - std.env.stop(0) ; + 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 @@ -504,7 +609,7 @@ package body AlertLogPkg is begin ResultValues(1) := CurrentLength + 1 ; -- AlertLogJustifyAmountVar ResultValues(2) := CurrentLength + IndentAmount ; -- ReportJustifyAmountVar - for i in AlertLogID+1 to NumAlertLogIDs loop + 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)) ; @@ -581,7 +686,7 @@ package body AlertLogPkg is ------------------------------------------------------------ variable Count : AlertCountType := (others => 0) ; begin - for i in ALERTLOG_BASE_ID to NumAlertLogIDs loop + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop Count := Count + GetDisabledAlertCount(AlertLogPtr(i).AlertCount, AlertLogPtr(i).AlertEnabled) ; end loop ; return Count ; @@ -593,7 +698,7 @@ package body AlertLogPkg is variable Count : AlertCountType := (others => 0) ; begin Count := GetDisabledAlertCount(AlertLogPtr(AlertLogID).AlertCount, AlertLogPtr(AlertLogID).AlertEnabled) ; - for i in AlertLogID+1 to NumAlertLogIDs loop + for i in AlertLogID+1 to NumAlertLogIDsVar loop if AlertLogID = AlertLogPtr(i).ParentID then Count := Count + GetDisabledAlertCount(i) ; end if ; @@ -619,23 +724,34 @@ package body AlertLogPkg is if NumErrors = 0 then if NumDisabledErrors = 0 then -- Passed - Write(buf, ReportPrefix & DoneName & " " & PassName & " " & Name & - " at " & to_string(NOW, 1 ns)) ; + 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 & - " Failed Due to Disabled Error(s) = " & to_string(NumDisabledErrors) & - " at " & to_string(NOW, 1 ns)) ; + 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 & - " Total Error(s) = " & to_string(NumErrors) ) ; + 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 ; @@ -652,7 +768,7 @@ package body AlertLogPkg is ) is variable buf : line ; begin - for i in AlertLogID+1 to NumAlertLogIDs loop + 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)) ; @@ -681,7 +797,7 @@ package body AlertLogPkg is if ReportJustifyAmountVar <= 0 then SetJustify ; end if ; - NumErrors := SumAlertCount(ExternalErrors) + SumAlertCount( GetEnabledAlertCount(AlertLogPtr(AlertLogID).AlertCount, AlertLogPtr(AlertLogID).AlertEnabled)) ; + NumErrors := SumAlertCount( ExternalErrors + GetEnabledAlertCount(AlertLogPtr(AlertLogID).AlertCount, AlertLogPtr(AlertLogID).AlertEnabled) ) ; if FailOnDisabledErrorsVar then NumDisabledErrors := SumAlertCount( GetDisabledAlertCount(AlertLogID) ) ; else @@ -703,7 +819,7 @@ package body AlertLogPkg is ) ; end if ; --Print Hierarchy when enabled and error or disabled error - if (HierarchyInUseVar and ReportHierarchyVar) and (NumErrors /= 0 or NumDisabledErrors /=0) then + if (FoundReportHierVar and ReportHierarchyVar) and (NumErrors /= 0 or NumDisabledErrors /=0) then PrintChild( AlertLogID => AlertLogID, Prefix => ReportPrefix & " ", @@ -729,10 +845,13 @@ package body AlertLogPkg is 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 NumAlertLogIDs loop + 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 ; @@ -747,13 +866,14 @@ package body AlertLogPkg is Level : LogType ) is variable buf : line ; - constant LogPrefix : string := ResolveOsvvmOption(LogPrefixVar.GetOpt, OSVVM_DEFAULT_LOG_PREFIX) ; + constant LogPrefix : string := LogPrefixVar.Get(OSVVM_DEFAULT_LOG_PREFIX) ; begin write(buf, LogPrefix) ; if WriteLogLevelVar then write(buf, " " & LOG_NAME(Level) ) ; end if ; - if HierarchyInUseVar and WriteLogNameVar then +--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 ; @@ -769,10 +889,11 @@ package body AlertLogPkg is ------------------------------------------------------------ AlertLogID : AlertLogIDType ; Message : string ; - Level : LogType := ALWAYS + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable ) is begin - if Level = ALWAYS then + if Level = ALWAYS or Enable then LocalLog(AlertLogID, Message, Level) ; elsif AlertLogPtr(AlertLogID).LogEnabled(Level) then LocalLog(AlertLogID, Message, Level) ; @@ -790,6 +911,13 @@ package body AlertLogPkg is 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 @@ -801,7 +929,7 @@ package body AlertLogPkg is begin if AlertLogID = ALERTLOG_BASE_ID then AlertEnabled := (TRUE, TRUE, TRUE) ; - LogEnabled := (FALSE, FALSE, FALSE) ; + LogEnabled := (others => FALSE) ; AlertStopCount := (FAILURE => 0, ERROR => integer'right, WARNING => integer'right) ; else if ParentID < ALERTLOG_BASE_ID then @@ -813,14 +941,21 @@ package body AlertLogPkg is end if ; AlertStopCount := (FAILURE => integer'right, ERROR => integer'right, WARNING => integer'right) ; end if ; - AlertLogPtr(AlertLogID) := new AlertLogRecType'( - Name => new string'(NAME), - ParentID => ParentID, - AlertCount => (0, 0, 0), - AlertEnabled => AlertEnabled, - AlertStopCount => AlertStopCount, - LogEnabled => LogEnabled - ) ; + 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 ; ------------------------------------------------------------ @@ -828,24 +963,33 @@ package body AlertLogPkg is procedure Initialize(NewNumAlertLogIDs : integer := MIN_NUM_AL_IDS) is ------------------------------------------------------------ begin - if NumAllocatedAlertLogIDs /= 0 then + 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 NewNumAlertLogIDs) ; - NumAllocatedAlertLogIDs := NewNumAlertLogIDs ; - NumAlertLogIDs := NUM_PREDEFINED_AL_IDS ; + AlertLogPtr := new AlertLogArrayType(ALERTLOG_BASE_ID to ALERTLOG_BASE_ID + NewNumAlertLogIDs) ; + NumAllocatedAlertLogIDsVar := NewNumAlertLogIDs ; +--xx NumAlertLogIDsVar := 0 ; +--xx NumAlertLogIDsVar := NUM_PREDEFINED_AL_IDS ; -- Create BASE AlertLogID (if it differs from DEFAULT if ALERTLOG_BASE_ID /= ALERT_DEFAULT_ID then NewAlertLogRec(ALERTLOG_BASE_ID, "AlertLogTop", ALERTLOG_BASE_ID) ; +--xx NumAlertLogIDsVar := NumAlertLogIDsVar + 1 ; 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 ; +--xx NumPredefinedAlIDsVar := NumAlertLogIDsVar ; end procedure Initialize ; ------------------------------------------------------------ @@ -864,7 +1008,7 @@ package body AlertLogPkg is procedure Deallocate is ------------------------------------------------------------ begin - for i in ALERTLOG_BASE_ID to NumAlertLogIDs loop + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop Deallocate(AlertLogPtr(i).Name) ; Deallocate(AlertLogPtr(i)) ; end loop ; @@ -877,13 +1021,16 @@ package body AlertLogPkg is PassNameVar.Deallocate ; FailNameVar.Deallocate ; -- Restore variables to their initial state - NumAlertLogIDs := 0 ; - NumAllocatedAlertLogIDs := 0 ; - GlobalAlertEnabled := TRUE ; -- Allows turn off and on + NumAlertLogIDsVar := 0 ; + NumAllocatedAlertLogIDsVar := 0 ; + GlobalAlertEnabledVar := TRUE ; -- Allows turn off and on + AffirmCheckCountVar := 0 ; +--?? AffirmPassedCountVar := 0 ; FailOnWarningVar := TRUE ; FailOnDisabledErrorsVar := TRUE ; ReportHierarchyVar := TRUE ; - HierarchyInUseVar := FALSE ; + FoundReportHierVar := FALSE ; + FoundAlertHierVar := FALSE ; WriteAlertLevelVar := TRUE ; WriteAlertNameVar := TRUE ; WriteAlertTimeVar := TRUE ; @@ -898,15 +1045,15 @@ package body AlertLogPkg is ------------------------------------------------------------ variable oldAlertLogPtr : AlertLogArrayPtrType ; begin - if NumAllocatedAlertLogIDs = 0 then + 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 NumAlertLogIDs) := oldAlertLogPtr(ALERTLOG_BASE_ID to NumAlertLogIDs) ; + AlertLogPtr(ALERTLOG_BASE_ID to NumAlertLogIDsVar) := oldAlertLogPtr(ALERTLOG_BASE_ID to NumAlertLogIDsVar) ; deallocate(oldAlertLogPtr) ; end if ; - NumAllocatedAlertLogIDs := NewNumAlertLogIDs ; + NumAllocatedAlertLogIDsVar := NewNumAlertLogIDs ; end procedure GrowAlertStructure ; ------------------------------------------------------------ @@ -917,7 +1064,7 @@ package body AlertLogPkg is ------------------------------------------------------------ variable oldAlertLogPtr : AlertLogArrayPtrType ; begin - if NewNumAlertLogIDs > NumAllocatedAlertLogIDs then + if NewNumAlertLogIDs > NumAllocatedAlertLogIDsVar then GrowAlertStructure(NewNumAlertLogIDs) ; end if; end procedure SetNumAlertLogIDs ; @@ -928,18 +1075,18 @@ package body AlertLogPkg is ------------------------------------------------------------ variable NormNumAlertLogIDs : AlertLogIDType ; begin - NumAlertLogIDs := NumAlertLogIDs + 1 ; - if NumAlertLogIDs > NumAllocatedAlertLogIDs then - GrowAlertStructure(NumAllocatedAlertLogIDs + MIN_NUM_AL_IDS) ; + NumAlertLogIDsVar := NumAlertLogIDsVar + 1 ; + if NumAlertLogIDsVar > NumAllocatedAlertLogIDsVar then + GrowAlertStructure(NumAllocatedAlertLogIDsVar + MIN_NUM_AL_IDS) ; end if ; - return NumAlertLogIDs ; + return NumAlertLogIDsVar ; end function GetNextAlertLogID ; ------------------------------------------------------------ impure function FindAlertLogID(Name : string ) return AlertLogIDType is ------------------------------------------------------------ begin - for i in ALERTLOG_BASE_ID to NumAlertLogIDs loop + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop if Name = AlertLogPtr(i).Name.all then return i ; end if ; @@ -952,7 +1099,7 @@ package body AlertLogPkg is ------------------------------------------------------------ variable CurParentID : AlertLogIDType ; begin - for i in ALERTLOG_BASE_ID to NumAlertLogIDs loop + 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) @@ -964,7 +1111,7 @@ package body AlertLogPkg is end function FindAlertLogID ; ------------------------------------------------------------ - impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType) return AlertLogIDType is + impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType ; CreateHierarchy : Boolean) return AlertLogIDType is ------------------------------------------------------------ variable ResultID : AlertLogIDType ; begin @@ -978,11 +1125,21 @@ package body AlertLogPkg is else ResultID := GetNextAlertLogID ; NewAlertLogRec(ResultID, Name, ParentID) ; - HierarchyInUseVar := TRUE ; + 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 @@ -992,9 +1149,49 @@ package body AlertLogPkg is procedure SetGlobalAlertEnable (A : boolean := TRUE) is ------------------------------------------------------------ begin - GlobalAlertEnabled := A ; + 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( @@ -1022,11 +1219,18 @@ package body AlertLogPkg is 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 NumAlertLogIDs loop + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop AlertLogPtr(i).AlertEnabled(Level) := Enable ; end loop ; end procedure SetAlertEnable ; @@ -1037,7 +1241,7 @@ package body AlertLogPkg is begin AlertLogPtr(AlertLogID).AlertEnabled(Level) := Enable ; if DescendHierarchy then - for i in AlertLogID+1 to NumAlertLogIDs loop + for i in AlertLogID+1 to NumAlertLogIDsVar loop if AlertLogID = AlertLogPtr(i).ParentID then SetAlertEnable(i, Level, Enable, DescendHierarchy) ; end if ; @@ -1045,11 +1249,18 @@ package body AlertLogPkg is 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 NumAlertLogIDs loop + for i in ALERTLOG_BASE_ID to NumAlertLogIDsVar loop AlertLogPtr(i).LogEnabled(Level) := Enable ; end loop ; end procedure SetLogEnable ; @@ -1060,7 +1271,7 @@ package body AlertLogPkg is begin AlertLogPtr(AlertLogID).LogEnabled(Level) := Enable ; if DescendHierarchy then - for i in AlertLogID+1 to NumAlertLogIDs loop + for i in AlertLogID+1 to NumAlertLogIDsVar loop if AlertLogID = AlertLogPtr(i).ParentID then SetLogEnable(i, Level, Enable, DescendHierarchy) ; end if ; @@ -1069,7 +1280,7 @@ package body AlertLogPkg is end procedure SetLogEnable ; ------------------------------------------------------------ - impure function IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is ------------------------------------------------------------ begin if Level = ALWAYS then @@ -1077,8 +1288,8 @@ package body AlertLogPkg is else return AlertLogPtr(AlertLogID).LogEnabled(Level) ; end if ; - end function IsLoggingEnabled ; - + end function GetLogEnable ; + ------------------------------------------------------------ -- PT Local procedure PrintLogLevels( @@ -1097,7 +1308,7 @@ package body AlertLogPkg is end if ; end loop ; WriteLine(buf) ; - for i in AlertLogID+1 to NumAlertLogIDs loop + for i in AlertLogID+1 to NumAlertLogIDsVar loop if AlertLogID = AlertLogPtr(i).ParentID then PrintLogLevels( AlertLogID => i, @@ -1118,13 +1329,6 @@ package body AlertLogPkg is PrintLogLevels(ALERTLOG_BASE_ID, "", 0) ; end procedure ReportLogEnables ; - ------------------------------------------------------------ - impure function GetAlertLogName(AlertLogID : AlertLogIDType) return string is - ------------------------------------------------------------ - begin - return AlertLogPtr(AlertLogID).Name.all ; - end function GetAlertLogName ; - ------------------------------------------------------------ procedure SetAlertLogOptions ( ------------------------------------------------------------ @@ -1193,32 +1397,153 @@ package body AlertLogPkg is end procedure SetAlertLogOptions ; ------------------------------------------------------------ - impure function GetAlertReportPrefix return string is + 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 GetAlertReportPrefix ; + end function GetAlertLogReportPrefix ; ------------------------------------------------------------ - impure function GetAlertDoneName return string is + impure function GetAlertLogDoneName return string is ------------------------------------------------------------ begin return ResolveOsvvmDoneName(DoneNameVar.GetOpt) ; - end function GetAlertDoneName ; + end function GetAlertLogDoneName ; ------------------------------------------------------------ - impure function GetAlertPassName return string is + impure function GetAlertLogPassName return string is ------------------------------------------------------------ begin return ResolveOsvvmPassName(PassNameVar.GetOpt) ; - end function GetAlertPassName ; + end function GetAlertLogPassName ; ------------------------------------------------------------ - impure function GetAlertFailName return string is + impure function GetAlertLogFailName return string is ------------------------------------------------------------ begin return ResolveOsvvmFailName(FailNameVar.GetOpt) ; - end function GetAlertFailName ; + end function GetAlertLogFailName ; end protected body AlertLogStructPType ; @@ -1229,48 +1554,7 @@ package body AlertLogPkg is --- /////////////////////////////////////////////////////////////////////////// --- /////////////////////////////////////////////////////////////////////////// --- /////////////////////////////////////////////////////////////////////////// - - ------------------------------------------------------------ - -- package local - procedure EmptyOrCommentLine ( - -- Better as Function, but not supported in VHDL functions - ------------------------------------------------------------ - 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 ; - - -- if line empty (null or 0 length), Empty = TRUE - if L = null or L.all'length = 0 then - return ; - end if ; - - -- if line starts with '#', empty = TRUE - if L.all(1) = '#' then - return ; - end if ; - - -- if line starts with '--', empty = TRUE - if L.all'length >= 2 and L.all(1) = '-' and L.all(2) = '-' then - return ; - end if ; - - -- Otherwise, remove white space and check for end of line - -- Code borrowed from David Bishop, skip_whitespace - WhiteSpLoop : while L /= null and L.all'length > 0 loop - if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then - read (L, Char, Valid) ; - else - Empty := FALSE ; - exit WhiteSpLoop ; - end if ; - end loop WhiteSpLoop ; - end procedure EmptyOrCommentLine ; - + ------------------------------------------------------------ procedure Alert( ------------------------------------------------------------ @@ -1286,9 +1570,27 @@ package body AlertLogPkg is procedure Alert( Message : string ; Level : AlertType := ERROR ) is ------------------------------------------------------------ begin - AlertLogStruct.Alert(ALERT_DEFAULT_ID , Message, Level) ; + 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 ------------------------------------------------------------ @@ -1701,7 +2003,7 @@ package body AlertLogPkg is 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, Level) ; + AlertIfDiff (AlertLogID, FileID1, FileID2, Message & " " & Name1 & " /= " & Name2 & ", ", Level) ; else if status1 /= OPEN_OK then AlertLogStruct.Alert(AlertLogID , Message & " File, " & Name1 & ", did not open", Level) ; @@ -1758,6 +2060,33 @@ package body AlertLogPkg is 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, ERROR) ; -- 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 ------------------------------------------------------------ @@ -1793,6 +2122,17 @@ package body AlertLogPkg is 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 ------------------------------------------------------------ @@ -1830,7 +2170,8 @@ package body AlertLogPkg is impure function SumAlertCount(AlertCount: AlertCountType) return integer is ------------------------------------------------------------ begin - return AlertCount(FAILURE) + AlertCount(ERROR) + AlertCount(WARNING) ; + -- Using ABS ensures correct expected error handling. + return abs(AlertCount(FAILURE)) + abs(AlertCount(ERROR)) + abs(AlertCount(WARNING)) ; end function SumAlertCount ; ------------------------------------------------------------ @@ -1890,38 +2231,24 @@ package body AlertLogPkg is end function GetDisabledAlertCount ; ------------------------------------------------------------ - procedure log( - ------------------------------------------------------------ + procedure Log( AlertLogID : AlertLogIDType ; - Message : string ; - Level : LogType := ALWAYS + Message : string ; + Level : LogType := ALWAYS ; + Enable : boolean := FALSE -- override internal enable ) is begin - AlertLogStruct.Log(AlertLogID, Message, Level) ; + AlertLogStruct.Log(AlertLogID, Message, Level, Enable) ; end procedure log ; ------------------------------------------------------------ - procedure log( Message : string ; Level : LogType := ALWAYS) is + procedure Log( Message : string ; Level : LogType := ALWAYS ; Enable : boolean := FALSE) is ------------------------------------------------------------ begin - AlertLogStruct.Log(LOG_DEFAULT_ID, Message, Level) ; + AlertLogStruct.Log(LOG_DEFAULT_ID, Message, Level, Enable) ; end procedure log ; - ------------------------------------------------------------ - impure function IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is - ------------------------------------------------------------ - begin - return AlertLogStruct.IsLoggingEnabled(AlertLogID, Level) ; - end function IsLoggingEnabled ; - - ------------------------------------------------------------ - impure function IsLoggingEnabled(Level : LogType) return boolean is - ------------------------------------------------------------ - begin - return AlertLogStruct.IsLoggingEnabled(LOG_DEFAULT_ID, Level) ; - end function IsLoggingEnabled ; - - ------------------------------------------------------------ + ------------------------------------------------------------ procedure SetAlertLogName(Name : string ) is ------------------------------------------------------------ begin @@ -1929,11 +2256,11 @@ package body AlertLogPkg is end procedure SetAlertLogName ; ------------------------------------------------------------ - procedure InitializeAlertLogStruct is + impure function GetAlertLogName(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return string is ------------------------------------------------------------ begin - AlertLogStruct.Initialize ; - end procedure InitializeAlertLogStruct ; + return AlertLogStruct.GetAlertLogName(AlertLogID) ; + end GetAlertLogName ; ------------------------------------------------------------ procedure DeallocateAlertLogStruct is @@ -1942,6 +2269,13 @@ package body AlertLogPkg is AlertLogStruct.Deallocate ; end procedure DeallocateAlertLogStruct ; + ------------------------------------------------------------ + procedure InitializeAlertLogStruct is + ------------------------------------------------------------ + begin + AlertLogStruct.Initialize ; + end procedure InitializeAlertLogStruct ; + ------------------------------------------------------------ impure function FindAlertLogID(Name : string ) return AlertLogIDType is ------------------------------------------------------------ @@ -1957,12 +2291,19 @@ package body AlertLogPkg is end function FindAlertLogID ; ------------------------------------------------------------ - impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertLogIDType is + impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) return AlertLogIDType is ------------------------------------------------------------ begin - return AlertLogStruct.GetAlertLogID(Name, ParentID ) ; + 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 ------------------------------------------------------------ @@ -1979,6 +2320,41 @@ package body AlertLogPkg is 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 ------------------------------------------------------------ @@ -1993,6 +2369,20 @@ package body AlertLogPkg is 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 ------------------------------------------------------------ @@ -2007,6 +2397,20 @@ package body AlertLogPkg is 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 ------------------------------------------------------------ @@ -2022,18 +2426,39 @@ package body AlertLogPkg is end procedure SetLogEnable ; ------------------------------------------------------------ - procedure ReportLogEnables is + impure function GetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is ------------------------------------------------------------ begin - AlertLogStruct.ReportLogEnables ; - end ReportLogEnables ; - + return AlertLogStruct.GetLogEnable(AlertLogID, Level) ; + end function GetLogEnable ; + ------------------------------------------------------------ - impure function GetAlertLogName(AlertLogID : AlertLogIDType) return string is + impure function GetLogEnable(Level : LogType) return boolean is ------------------------------------------------------------ begin - return AlertLogStruct.GetAlertLogName(AlertLogID) ; - end GetAlertLogName ; + 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 ( @@ -2073,34 +2498,132 @@ package body AlertLogPkg is 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 ------------------------------------------------------------ - impure function GetAlertReportPrefix return string 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.GetAlertReportPrefix ; - end function GetAlertReportPrefix ; + return AlertLogStruct.GetAlertLogReportPrefix ; + end function GetAlertLogReportPrefix ; ------------------------------------------------------------ - impure function GetAlertDoneName return string is + impure function GetAlertLogDoneName return string is ------------------------------------------------------------ begin - return AlertLogStruct.GetAlertDoneName ; - end function GetAlertDoneName ; + return AlertLogStruct.GetAlertLogDoneName ; + end function GetAlertLogDoneName ; ------------------------------------------------------------ - impure function GetAlertPassName return string is + impure function GetAlertLogPassName return string is ------------------------------------------------------------ begin - return AlertLogStruct.GetAlertPassName ; - end function GetAlertPassName ; + return AlertLogStruct.GetAlertLogPassName ; + end function GetAlertLogPassName ; ------------------------------------------------------------ - impure function GetAlertFailName return string is + impure function GetAlertLogFailName return string is ------------------------------------------------------------ begin - return AlertLogStruct.GetAlertFailName ; - end function GetAlertFailName ; + return AlertLogStruct.GetAlertLogFailName ; + end function GetAlertLogFailName ; ------------------------------------------------------------ function IsLogEnableType (Name : String) return boolean is @@ -2129,42 +2652,50 @@ package body AlertLogPkg is -- ------------------------------------------------------------ type ReadStateType is (GET_ID, GET_ENABLE) ; - variable ReadState : ReadStateType := GET_ID ; - variable buf : line ; - variable Empty : boolean ; - variable Name : string(1 to 80) ; - variable NameLen : integer ; - variable AlertLogID : AlertLogIDType ; - variable NumEnableRead : integer ; - variable LogLevel : LogType ; + 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) ; - EmptyOrCommentLine(buf, Empty) ; + 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 : while not Empty loop + 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 ; - NumEnableRead := 0 ; + ReadAnEnable := FALSE ; when GET_ENABLE => sread(buf, Name, NameLen) ; exit ReadNameLoop when NameLen = 0 ; - NumEnableRead := NumEnableRead + 1 ; - exit ReadNameLoop when not IsLogEnableType(Name(1 to NameLen)) ; + 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 ; - -- if have read an enable, find next AlertLog Name - if NumEnableRead > 0 then - ReadState := GET_ID ; - end if ; end loop ReadLineLoop ; end procedure ReadLogEnables ; diff --git a/AlertLogPkg_body_BVUL.vhd b/AlertLogPkg_body_BVUL.vhd deleted file mode 100644 index 38f2bcd..0000000 --- a/AlertLogPkg_body_BVUL.vhd +++ /dev/null @@ -1,491 +0,0 @@ --- --- File Name: AlertLogPkg_body_BVUL.vhd --- Design Unit Name: AlertLogPkg --- Revision: STANDARD VERSION, revision 2015.01 --- --- 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 --- --- --- 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 --- - - - - ---- /////////////////////////////////////////////////////////////////////////// ---- /////////////////////////////////////////////////////////////////////////// ---- /////////////////////////////////////////////////////////////////////////// - -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 ") ; -- , NEVER => "NEVER " - - -- Local - constant NUM_PREDEFINED_AL_IDS : AlertLogIDType := 2 ; -- Not including base - - type AlertToSeverityType is array (AlertType) of severity_level ; - constant ALERT_TO_SEVERITY : AlertToSeverityType := (WARNING => WARNING, ERROR => ERROR, FAILURE => FAILURE) ; -- , NEVER => "NEVER " - - - ------------------------------------------------------------ - procedure Alert( - ------------------------------------------------------------ - AlertLogID : AlertLogIDType ; - Message : string ; - Level : AlertType := ERROR - ) is - begin - report Message & "AlertLogID = " & to_string(AlertLogID) severity ALERT_TO_SEVERITY(Level) ; - end procedure alert ; - - ------------------------------------------------------------ - procedure Alert( Message : string ; Level : AlertType := ERROR ) is - ------------------------------------------------------------ - begin - Alert(ALERT_DEFAULT_ID , Message, Level) ; - end procedure alert ; - - ------------------------------------------------------------ - procedure AlertIf( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) is - ------------------------------------------------------------ - begin - if condition then - Alert(AlertLogID , Message, Level) ; - end if ; - end procedure AlertIf ; - - ------------------------------------------------------------ - procedure AlertIf( condition : boolean ; Message : string ; Level : AlertType := ERROR ) is - ------------------------------------------------------------ - begin - if condition then - 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( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) return boolean is - ------------------------------------------------------------ - begin - if condition then - Alert(AlertLogID , Message, Level) ; - end if ; - return condition ; - end function AlertIf ; - - ------------------------------------------------------------ - impure function AlertIf( condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean is - ------------------------------------------------------------ - begin - if condition then - Alert(ALERT_DEFAULT_ID, Message, Level) ; - end if ; - return condition ; - end function AlertIf ; - - ------------------------------------------------------------ - procedure AlertIfNot( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) is - ------------------------------------------------------------ - begin - if not condition then - Alert(AlertLogID, Message, Level) ; - end if ; - end procedure AlertIfNot ; - - ------------------------------------------------------------ - procedure AlertIfNot( condition : boolean ; Message : string ; Level : AlertType := ERROR ) is - ------------------------------------------------------------ - begin - if not condition then - 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( condition : boolean ; AlertLogID : AlertLogIDType ; Message : string ; Level : AlertType := ERROR ) return boolean is - ------------------------------------------------------------ - begin - if not condition then - Alert(AlertLogID, Message, Level) ; - end if ; - return not condition ; - end function AlertIfNot ; - - ------------------------------------------------------------ - impure function AlertIfNot( condition : boolean ; Message : string ; Level : AlertType := ERROR ) return boolean is - ------------------------------------------------------------ - begin - if not condition then - Alert(ALERT_DEFAULT_ID, Message, Level) ; - end if ; - return not condition ; - end function AlertIfNot ; - - ------------------------------------------------------------ - procedure SetAlertLogJustify is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertLogJustify ; - - ------------------------------------------------------------ - procedure ReportAlerts ( Name : string := OSVVM_STRING_INIT_PARM_DETECT ; AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID ; ExternalErrors : AlertCountType := (others => 0) ) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure ReportAlerts ; - - ------------------------------------------------------------ - procedure ReportAlerts ( Name : String ; AlertCount : AlertCountType ) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure ReportAlerts ; - - ------------------------------------------------------------ - procedure ClearAlerts is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure ClearAlerts ; - - ------------------------------------------------------------ - 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 - return AlertCount(FAILURE) + AlertCount(ERROR) + AlertCount(WARNING) ; - end function SumAlertCount ; - - ------------------------------------------------------------ - impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return (0, 0, 0) ; - end function GetAlertCount ; - - ------------------------------------------------------------ - impure function GetAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return integer is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return 0 ; - end function GetAlertCount ; - - ------------------------------------------------------------ - impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertCountType is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return (0, 0, 0) ; - end function GetEnabledAlertCount ; - - ------------------------------------------------------------ - impure function GetEnabledAlertCount(AlertLogID : AlertLogIDType := ALERTLOG_BASE_ID) return integer is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return 0 ; - end function GetEnabledAlertCount ; - - ------------------------------------------------------------ - impure function GetDisabledAlertCount return AlertCountType is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return (0, 0, 0) ; - end function GetDisabledAlertCount ; - - ------------------------------------------------------------ - impure function GetDisabledAlertCount return integer is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return 0 ; - end function GetDisabledAlertCount ; - - ------------------------------------------------------------ - impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return AlertCountType is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return (0, 0, 0) ; - end function GetDisabledAlertCount ; - - ------------------------------------------------------------ - impure function GetDisabledAlertCount(AlertLogID: AlertLogIDType) return integer is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return 0 ; - end function GetDisabledAlertCount ; - - ------------------------------------------------------------ - procedure log( - ------------------------------------------------------------ - AlertLogID : AlertLogIDType ; - Message : string ; - Level : LogType := ALWAYS - ) is - begin - report Message & "AlertLogID = " & to_string(AlertLogID) & " Level = " & to_string(Level) ; - end procedure log ; - - ------------------------------------------------------------ - procedure log( Message : string ; Level : LogType := ALWAYS) is - ------------------------------------------------------------ - begin - Log(LOG_DEFAULT_ID, Message, Level) ; - end procedure log ; - - ------------------------------------------------------------ - impure function IsLoggingEnabled(AlertLogID : AlertLogIDType ; Level : LogType) return boolean is - ------------------------------------------------------------ - begin --- returns true when log level is enabled -alert("AlertLogPkg: procedure must be implemented", FAILURE) ; --- return AlertLogStruct.IsLoggingEnabled(AlertLogID, Level) ; - return FALSE ; - end function IsLoggingEnabled ; - - ------------------------------------------------------------ - impure function IsLoggingEnabled(Level : LogType) return boolean is - ------------------------------------------------------------ - begin --- returns true when log level is enabled -alert("AlertLogPkg: procedure must be implemented", FAILURE) ; --- return AlertLogStruct.IsLoggingEnabled(LOG_DEFAULT_ID, Level) ; - return FALSE ; - end function IsLoggingEnabled ; - - ------------------------------------------------------------ - procedure SetAlertLogName(Name : string ) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertLogName ; - - ------------------------------------------------------------ - procedure InitializeAlertLogStruct is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure InitializeAlertLogStruct ; - - ------------------------------------------------------------ - procedure DeallocateAlertLogStruct is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure DeallocateAlertLogStruct ; - - ------------------------------------------------------------ - impure function FindAlertLogID(Name : string ) return AlertLogIDType is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return 0 ; - end function FindAlertLogID ; - - ------------------------------------------------------------ - impure function GetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID) return AlertLogIDType is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return 0 ; - end function GetAlertLogID ; - - ------------------------------------------------------------ - procedure SetGlobalAlertEnable (A : boolean := TRUE) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetGlobalAlertEnable ; - - ------------------------------------------------------------ - -- Set using constant. Set before code runs. - impure function SetGlobalAlertEnable (A : boolean := TRUE) return boolean is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return A ; - end function SetGlobalAlertEnable ; - - ------------------------------------------------------------ - procedure SetAlertStopCount(AlertLogID : AlertLogIDType ; Level : AlertType ; Count : integer) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertStopCount ; - - ------------------------------------------------------------ - procedure SetAlertStopCount(Level : AlertType ; Count : integer) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertStopCount ; - - ------------------------------------------------------------ - procedure SetAlertEnable(Level : AlertType ; Enable : boolean) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertEnable ; - - ------------------------------------------------------------ - procedure SetAlertEnable(AlertLogID : AlertLogIDType ; Level : AlertType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertEnable ; - - ------------------------------------------------------------ - procedure SetLogEnable(Level : LogType ; Enable : boolean) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetLogEnable ; - - ------------------------------------------------------------ - procedure SetLogEnable(AlertLogID : AlertLogIDType ; Level : LogType ; Enable : boolean ; DescendHierarchy : boolean := TRUE) is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetLogEnable ; - - ------------------------------------------------------------ - 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 - alert("AlertLogPkg: procedure not implemented for BVUL") ; - end procedure SetAlertLogOptions ; - - ------------------------------------------------------------ - impure function GetAlertReportPrefix return string is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return "" ; - end function GetAlertReportPrefix ; - - ------------------------------------------------------------ - impure function GetAlertDoneName return string is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return "" ; - end function GetAlertDoneName ; - - ------------------------------------------------------------ - impure function GetAlertPassName return string is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return "" ; - end function GetAlertPassName ; - - ------------------------------------------------------------ - impure function GetAlertFailName return string is - ------------------------------------------------------------ - begin - alert("AlertLogPkg: procedure not implemented for BVUL") ; - return "" ; - end function GetAlertFailName ; - -end package body AlertLogPkg ; \ No newline at end of file diff --git a/CoveragePkg.vhd b/CoveragePkg.vhd index 3a56983..9c5d65d 100644 --- a/CoveragePkg.vhd +++ b/CoveragePkg.vhd @@ -1,7 +1,7 @@ -- -- File Name: CoveragePkg.vhd -- Design Unit Name: CoveragePkg --- Revision: STANDARD VERSION, revision 2015.01 +-- Revision: STANDARD VERSION -- -- Maintainer: Jim Lewis email: jim@synthworks.com -- Contributor(s): @@ -41,6 +41,7 @@ -- 7/2014 2014.07 Bin Naming (for requirements tracking), WriteBin with Pass/Fail, GenBin[integer_vector] -- 12/2014 2014.07a Fix memory leak in deallocate. Removed initialied pointers which can lead to leaks. -- 01/2015 2015.01 Use AlertLogPkg to count assertions and filter log messages +-- 06/2015 2015.06 AddCross[CovMatrix?Type], Mirroring for WriteBin -- -- Development Notes: -- The coverage procedures are named ICover to avoid conflicts with @@ -89,6 +90,7 @@ use std.textio.all ; -- library ieee_proposed ; -- remove with VHDL-2008 -- use ieee_proposed.standard_additions.all ; -- remove with VHDL-2008 +use work.TextUtilPkg.all ; use work.TranscriptPkg.all ; use work.AlertLogPkg.all ; use work.RandomBasePkg.all ; @@ -262,6 +264,7 @@ package CoveragePkg is procedure FileOpenWriteBin (FileName : string; OpenKind : File_Open_Kind ) ; procedure FileCloseWriteBin ; procedure SetAlertLogID (A : AlertLogIDType) ; + procedure SetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) ; impure function GetAlertLogID return AlertLogIDType ; -- procedure FileOpenWriteCovDb (FileName : string; OpenKind : File_Open_Kind ) ; @@ -271,6 +274,7 @@ package CoveragePkg is procedure SetName (Name : String) ; impure function SetName (Name : String) return string ; impure function GetName return String ; + impure function GetNamePlus return String ; procedure SetMessage (Message : String) ; procedure DeallocateName ; -- clear name procedure DeallocateMessage ; -- clear message @@ -498,14 +502,14 @@ package CoveragePkg is -- These support usage of cross coverage constants -- Also support the older AddBins(GenCross(...)) methodology -- which has been replaced by AddCross - procedure AddBins (CovBin : CovMatrix2Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix3Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix4Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix5Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix6Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix7Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix8Type ; Name : String := "") ; - procedure AddBins (CovBin : CovMatrix9Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix2Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix3Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix4Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix5Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix6Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix7Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix8Type ; Name : String := "") ; + procedure AddCross (CovBin : CovMatrix9Type ; Name : String := "") ; ------------------------------------------------------------ -- Remaining are Deprecated @@ -547,7 +551,17 @@ package CoveragePkg is procedure WriteCovHoles ( FileName : string; AtLeast : integer ; OpenKind : File_Open_Kind := APPEND_MODE ) ; procedure WriteCovHoles ( LogLevel : LogType ; FileName : string; AtLeast : integer ; OpenKind : File_Open_Kind := APPEND_MODE ) ; - end protected CovPType ; + -- Replaced by a more appropriately named AddCross + procedure AddBins (CovBin : CovMatrix2Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix3Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix4Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix5Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix6Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix7Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix8Type ; Name : String := "") ; + procedure AddBins (CovBin : CovMatrix9Type ; Name : String := "") ; + + end protected CovPType ; ------------------------------------------------------------------------------------------ -- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CovPType XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CovPType XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX @@ -720,18 +734,23 @@ package CoveragePkg is function GenCross( Bin1, Bin2, Bin3, Bin4, Bin5, Bin6, Bin7, Bin8, Bin9 : CovBinType ) return CovMatrix9Type ; - ------------------------------------------------------------ - procedure increment( signal Count : inout integer ) ; - procedure increment( signal Count : inout integer ; enable : boolean ) ; - procedure increment( signal Count : inout integer ; enable : std_ulogic ) ; - - ------------------------------------------------------------ -- Utilities. Remove if added to std.standard function to_integer ( B : boolean ) return integer ; function to_integer ( SL : std_logic ) return integer ; function to_integer_vector ( BV : boolean_vector ) return integer_vector ; function to_integer_vector ( SLV : std_logic_vector ) return integer_vector ; + + + ------------------------------------------------------------ + ------------------------------------------------------------ +-- Deprecated: These are not part of the coverage model + + procedure increment( signal Count : inout integer ) ; + procedure increment( signal Count : inout integer ; enable : boolean ) ; + procedure increment( signal Count : inout integer ; enable : std_ulogic ) ; + + end package CoveragePkg ; @@ -741,18 +760,6 @@ end package CoveragePkg ; --- /////////////////////////////////////////////////////////////////////////// package body CoveragePkg is - ------------------------------------------------------------ - function inside ( - -- package local - ------------------------------------------------------------ - CovPoint : integer ; - BinVal : RangeType - ) return boolean is - begin - return CovPoint >= BinVal.min and CovPoint <= BinVal.max ; - end function inside ; - - ------------------------------------------------------------ function inside ( -- package local @@ -862,47 +869,6 @@ package body CoveragePkg is end procedure WriteBinVal ; - ------------------------------------------------------------ - -- package local - procedure EmptyOrCommentLine ( - -- Better as Function, but not supported in VHDL functions - ------------------------------------------------------------ - 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 ; - - -- if line empty (null or 0 length), Empty = TRUE - if L = null or L.all'length = 0 then - return ; - end if ; - - -- if line starts with '#', empty = TRUE - if L.all(1) = '#' then - return ; - end if ; - - -- if line starts with '--', empty = TRUE - if L.all'length >= 2 and L.all(1) = '-' and L.all(2) = '-' then - return ; - end if ; - - -- Otherwise, remove white space and check for end of line - -- Code borrowed from David Bishop, skip_whitespace - WhiteSpLoop : while L /= null and L.all'length > 0 loop - if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then - read (L, Char, Valid) ; - else - Empty := FALSE ; - exit WhiteSpLoop ; - end if ; - end loop WhiteSpLoop ; - end procedure EmptyOrCommentLine ; - ------------------------------------------------------------ -- package local for now procedure read ( @@ -1293,6 +1259,17 @@ package body CoveragePkg is AlertLogIDVar := A ; end procedure SetAlertLogID ; + ------------------------------------------------------------ + procedure SetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogIDVar := GetAlertLogID(Name, ParentID, CreateHierarchy) ; + if not RvSeedInit then -- Init seed if not initialized + RV.InitSeed(Name) ; + RvSeedInit := TRUE ; + end if ; + end procedure SetAlertLogID ; + ------------------------------------------------------------ impure function GetAlertLogID return AlertLogIDType is ------------------------------------------------------------ @@ -1343,15 +1320,42 @@ package body CoveragePkg is ------------------------------------------------------------ impure function GetName return String is ------------------------------------------------------------ + begin + return CovNameVar.Get("") ; + end function GetName ; + + ------------------------------------------------------------ + impure function GetNamePlus return String is + ------------------------------------------------------------ begin if CovNameVar.IsSet then + -- return Name if set return CovNameVar.Get ; + elsif AlertLogIDVar /= OSVVM_ALERTLOG_ID then + -- otherwise return AlertLogName if it is set + return GetAlertLogName(AlertLogIDVar) ; elsif CovMessageVar.IsSet then + -- otherwise Get the first word of the Message if it is set return GetWord(string'(CovMessageVar.Get(1))) ; else return "" ; end if ; - end function GetName ; + end function GetNamePlus ; + + ------------------------------------------------------------ + impure function GetNamePlus(prefix, suffix : string) return String is + ------------------------------------------------------------ + begin + if CovNameVar.IsSet then + -- return Name if set + return prefix & CovNameVar.Get & suffix ; + elsif AlertLogIDVar = OSVVM_ALERTLOG_ID and CovMessageVar.IsSet then + -- If AlertLogID not set, then use Message + return prefix & GetWord(string'(CovMessageVar.Get(1))) & suffix ; + else + return "" ; + end if ; + end function GetNamePlus ; ------------------------------------------------------------ procedure SetMessage (Message : String) is @@ -1385,14 +1389,17 @@ package body CoveragePkg is WeightScale := Scale ; if (WeightMode = REMAIN_EXP) and (WeightScale > 2.0) then - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.SetWeightMode: WeightScale > 2.0 and large Counts can cause RandCovPoint to fail due to integer values out of range", WARNING) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.SetWeightMode:" & + " WeightScale > 2.0 and large Counts can cause RandCovPoint to fail due to integer values out of range", WARNING) ; end if ; if (WeightScale < 1.0) and (WeightMode = REMAIN_WEIGHT or WeightMode = REMAIN_SCALED) then - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.SetWeightMode: WeightScale must be > 1.0 when WeightMode = REMAIN_WEIGHT or WeightMode = REMAIN_SCALED", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.SetWeightMode:" & + " WeightScale must be > 1.0 when WeightMode = REMAIN_WEIGHT or WeightMode = REMAIN_SCALED", FAILURE) ; WeightScale := 1.0 ; end if; if WeightScale <= 0.0 then - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.SetWeightMode: WeightScale must be > 0.0", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.SetWeightMode:" & + " WeightScale must be > 0.0", FAILURE) ; WeightScale := 1.0 ; end if; end procedure SetWeightMode ; @@ -1407,7 +1414,7 @@ package body CoveragePkg is MessageCount := CovMessageVar.GetCount ; if MessageCount = 0 then if Prefix'length + S'length > 0 then -- everything except WriteCovDb - write(buf, Prefix & S & GetName) ; -- Print name when no message + write(buf, Prefix & S & GetNamePlus) ; -- Print name when no message writeline(f, buf) ; -- write(f, Prefix & S & LF); end if ; @@ -1451,7 +1458,8 @@ package body CoveragePkg is CovThreshold := Percent + 0.0001 ; -- used in less than else CovThreshold := 0.0001 ; -- used in less than - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.SetCovThreshold: Invalid Threshold Value " & real'image(Percent), FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.SetCovThreshold:" & + " Invalid Threshold Value " & real'image(Percent), FAILURE) ; end if ; end procedure SetCovThreshold ; @@ -1585,7 +1593,9 @@ package body CoveragePkg is if NumBins = 0 then BinValLength := CurBinValLength ; -- number of points in cross else - AlertIf(BinValLength /= CurBinValLength, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg." & Caller & ": Cross coverage bins of different dimensions prohibited", FAILURE) ; + AlertIf(AlertLogIDVar, BinValLength /= CurBinValLength, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg." & Caller & ":" & + + " Cross coverage bins of different dimensions prohibited", FAILURE) ; end if; end procedure CheckBinValLength ; @@ -1733,7 +1743,8 @@ package body CoveragePkg is if CovBinPtr.all(Position).Action = COV_COUNT then InsertNewBin(BinVal, Action, Count, AtLeast, Weight, Name, PercentCov) ; else - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.InsertBin (AddBins/AddCross): ignore bin dropped. It is a subset of prior bin", ERROR) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.InsertBin (AddBins/AddCross):" & + " ignore bin dropped. It is a subset of prior bin", ERROR) ; end if; elsif Action = COV_ILLEGAL then @@ -1741,7 +1752,8 @@ package body CoveragePkg is if CovBinPtr.all(Position).Action = COV_COUNT then InsertNewBin(BinVal, Action, Count, AtLeast, Weight, Name, PercentCov) ; else - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.InsertBin (AddBins/AddCross): illegal bin dropped. It is a subset of prior bin", ERROR) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.InsertBin (AddBins/AddCross):" & + " illegal bin dropped. It is a subset of prior bin", ERROR) ; end if; end if ; end if ; -- merging enabled @@ -1964,6 +1976,7 @@ package body CoveragePkg is CovTarget := 100.0 ; MergingEnable := FALSE ; CountMode := COUNT_FIRST ; + AlertLogIDVar := OSVVM_ALERTLOG_ID ; -- RvSeedInit := FALSE ; WritePassFailVar := COV_OPT_INIT_PARM_DETECT ; WriteBinInfoVar := COV_OPT_INIT_PARM_DETECT ; @@ -1987,13 +2000,19 @@ package body CoveragePkg is -- OrderCount handling - Statistics OrderCount := OrderCount + 1 ; CovBinPtr(Index).OrderCount := OrderCount + CovBinPtr(Index).OrderCount ; - if CovBinPtr(Index).action = COV_ILLEGAL and IllegalMode /= ILLEGAL_OFF then - if CovPoint = NULL_INTV then - alert(AlertLogIDVar, "CoverageModel " & GetName & " Value randomized (ICoverLast) is in an illegal bin.", IllegalModeLevel) ; + if CovBinPtr(Index).action = COV_ILLEGAL then + if IllegalMode /= ILLEGAL_OFF then + if CovPoint = NULL_INTV then + alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.ICoverLast:" & + " Value randomized is in an illegal bin.", IllegalModeLevel) ; + else + write(buf, CovPoint) ; + alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.ICover:" & + " Value " & buf.all & " is in an illegal bin.", IllegalModeLevel) ; + deallocate(buf) ; + end if ; else - write(buf, CovPoint) ; - alert(AlertLogIDVar, "CoverageModel " & GetName & " Value " & buf.all & " is in an illegal bin.", IllegalModeLevel) ; - deallocate(buf) ; + IncAlertCount(AlertLogIDVar, ERROR) ; -- silent alert. end if ; end if ; end procedure ICoverIndex ; @@ -2018,13 +2037,14 @@ package body CoveragePkg is ------------------------------------------------------------ procedure ICover( CovPoint : integer_vector) is ------------------------------------------------------------ - variable Found : boolean := FALSE ; +--dd variable Found : boolean := FALSE ; begin if CountMode = COUNT_FIRST and inside(CovPoint, CovBinPtr(LastIndex).BinVal.all) then ICoverIndex(LastIndex, CovPoint) ; - Found := TRUE ; - end if; - if not Found then +--dd Found := TRUE ; +--dd end if; +--dd if not Found then + else CovLoop : for i in 1 to NumBins loop -- skip this CovBin if CovPoint is not in it next CovLoop when not inside(CovPoint, CovBinPtr(i).BinVal.all) ; @@ -2180,7 +2200,7 @@ package body CoveragePkg is impure function IsCovered ( PercentCov : real ) return boolean is ------------------------------------------------------------ begin - -- AlertIf(NumBins < 1, OSVVM_ALERTLOG_ID, "IsCovered: Empty Coverage Model", failure) ; + -- AlertIf(NumBins < 1, OSVVM_ALERTLOG_ID, "CoveragePkg.IsCovered: Empty Coverage Model", failure) ; return CountCovHoles(PercentCov) = 0 ; end function IsCovered ; @@ -2189,7 +2209,7 @@ package body CoveragePkg is impure function IsCovered return boolean is ------------------------------------------------------------ begin - -- AlertIf(NumBins < 1, OSVVM_ALERTLOG_ID, "IsCovered: Empty Coverage Model", failure) ; + -- AlertIf(NumBins < 1, OSVVM_ALERTLOG_ID, "CoveragePkg.IsCovered: Empty Coverage Model", failure) ; return CountCovHoles(CovTarget) = 0 ; end function IsCovered ; @@ -2277,9 +2297,9 @@ package body CoveragePkg is end if ; end if ; end loop CovLoop ; - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.GetHoleBinVal did not find hole. " & - "HoleCount = " & integer'image(HoleCount) & - "ReqHoleNum = " & integer'image(ReqHoleNum), ERROR + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.GetHoleBinVal:" & + " did not find a coverage hole. HoleCount = " & integer'image(HoleCount) & + " ReqHoleNum = " & integer'image(ReqHoleNum), ERROR ) ; return CovBinPtr(NumBins).BinVal.all ; @@ -2712,11 +2732,11 @@ package body CoveragePkg is if NumBins < 1 then if WriteBinFileInit or UsingLocalFile then swrite(buf, WritePrefix & " " & FailName & " ") ; - swrite(buf, GetName) ; - swrite(buf, "WriteBin: Coverage model is empty. Nothing to print.") ; + swrite(buf, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.WriteBin: Coverage model is empty. Nothing to print.") ; writeline(f, buf) ; end if ; - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.WriteBin: Coverage model is empty. Nothing to print.", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.WriteBin:" & + " Coverage model is empty. Nothing to print.", FAILURE) ; return ; end if ; -- Models with Bins @@ -2781,7 +2801,8 @@ package body CoveragePkg is constant rPassName : string := ResolveOsvvmPassName(PassName, PassNameVar.GetOpt ) ; constant rFailName : string := ResolveOsvvmFailName(FailName, FailNameVar.GetOpt ) ; begin - if WriteBinFileInit then -- WriteBin File defined Coverage Model (deprecated) + if WriteBinFileInit then + -- Write to Local WriteBinFile - Deprecated, recommend use TranscriptFile instead WriteBin ( f => WriteBinFile, WritePassFail => rWritePassFail, @@ -2793,6 +2814,7 @@ package body CoveragePkg is FailName => rFailName ) ; elsif IsTranscriptEnabled then + -- Write to TranscriptFile WriteBin ( f => TranscriptFile, WritePassFail => rWritePassFail, @@ -2803,7 +2825,21 @@ package body CoveragePkg is PassName => rPassName, FailName => rFailName ) ; + if IsTranscriptMirrored then + -- Mirrored to OUTPUT + WriteBin ( + f => OUTPUT, + WritePassFail => rWritePassFail, + WriteBinInfo => rWriteBinInfo, + WriteCount => rWriteCount, + WriteAnyIllegal => rWriteAnyIllegal, + WritePrefix => rWritePrefix, + PassName => rPassName, + FailName => rFailName + ) ; + end if ; else + -- Default Write to OUTPUT WriteBin ( f => OUTPUT, WritePassFail => rWritePassFail, @@ -2961,10 +2997,17 @@ package body CoveragePkg is begin if IsLoggingEnabled(AlertLogIDVar, LogLevel) then if WriteBinFileInit then + -- Write to Local WriteBinFile - Deprecated, recommend use TranscriptFile instead DumpBin(WriteBinFile) ; elsif IsTranscriptEnabled then + -- Write to TranscriptFile DumpBin(TranscriptFile) ; + if IsTranscriptMirrored then + -- Mirrored to OUTPUT + DumpBin(OUTPUT) ; + end if ; else + -- Default Write to OUTPUT DumpBin(OUTPUT) ; end if ; end if ; @@ -2980,12 +3023,12 @@ package body CoveragePkg is if NumBins < 1 then if WriteBinFileInit or UsingLocalFile then -- Duplicate Alert in specified file - swrite(buf, "%% FAILURE CoverageModel") ; - swrite(buf, GetName) ; - swrite(buf, "CoveragePkg.WriteCovHoles, FATAL, coverage model empty. Nothing to print.") ; + swrite(buf, "%% Alert FAILURE " & GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.WriteCovHoles:" & + " coverage model empty. Nothing to print.") ; writeline(f, buf) ; end if ; - Alert(AlertLogIDVar, "CoverageModel " & GetName & " coverage model empty. Nothing to print. In CoveragePkg.WriteCovHoles", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.WriteCovHoles:" & + " coverage model empty. Nothing to print.", FAILURE) ; return ; end if ; -- Models with Bins @@ -3012,36 +3055,37 @@ package body CoveragePkg is end procedure WriteCovHoles ; - ------------------------------------------------------------ - procedure WriteCovHoles ( LogLevel : LogType := ALWAYS ) is - ------------------------------------------------------------ - begin - if IsLoggingEnabled(AlertLogIDVar, LogLevel) then - if WriteBinFileInit then - WriteCovHoles(WriteBinFile, CovTarget) ; - elsif IsTranscriptEnabled then - WriteCovHoles(TranscriptFile, CovTarget) ; - else - WriteCovHoles(OUTPUT, CovTarget) ; - end if; - end if; - end procedure WriteCovHoles ; - - ------------------------------------------------------------ procedure WriteCovHoles ( PercentCov : real ) is ------------------------------------------------------------ begin if WriteBinFileInit then + -- Write to Local WriteBinFile - Deprecated, recommend use TranscriptFile instead WriteCovHoles(WriteBinFile, PercentCov) ; elsif IsTranscriptEnabled then + -- Write to TranscriptFile WriteCovHoles(TranscriptFile, PercentCov) ; + if IsTranscriptMirrored then + -- Mirrored to OUTPUT + WriteCovHoles(OUTPUT, PercentCov) ; + end if ; else + -- Default Write to OUTPUT WriteCovHoles(OUTPUT, PercentCov) ; end if; end procedure WriteCovHoles ; + + ------------------------------------------------------------ + procedure WriteCovHoles ( LogLevel : LogType := ALWAYS ) is + ------------------------------------------------------------ + begin + if IsLoggingEnabled(AlertLogIDVar, LogLevel) then + WriteCovHoles(CovTarget) ; + end if; + end procedure WriteCovHoles ; + ------------------------------------------------------------ procedure WriteCovHoles ( LogLevel : LogType ; PercentCov : real ) is ------------------------------------------------------------ @@ -3145,29 +3189,29 @@ package body CoveragePkg is -- pt local procedure ReadCovVars (file CovDbFile : text; Good : out boolean ) is ------------------------------------------------------------ - variable buf : line ; - variable Empty : boolean ; - variable ReadValid : boolean ; - variable GoodLoop1 : boolean ; - - variable iSeed : RandomSeedType ; - variable iIllegalMode : integer ; - variable iWeightMode : integer ; - variable iWeightScale : real ; - variable iCovThreshold : real ; - variable iCountMode : integer ; - variable iNumberOfMessages : integer ; - variable iThresholdingEnable : boolean ; - variable iCovTarget : real ; - variable iMergingEnable : boolean ; - + variable buf : line ; + variable Empty : boolean ; + variable MultiLineComment : boolean := FALSE ; + variable ReadValid : boolean ; + variable GoodLoop1 : boolean ; + variable iSeed : RandomSeedType ; + variable iIllegalMode : integer ; + variable iWeightMode : integer ; + variable iWeightScale : real ; + variable iCovThreshold : real ; + variable iCountMode : integer ; + variable iNumberOfMessages : integer ; + variable iThresholdingEnable : boolean ; + variable iCovTarget : real ; + variable iMergingEnable : boolean ; begin -- ReadLoop0 : while not EndFile(CovDbFile) loop ReadLoop0 : loop -- allows emulation of "return when" -- ReadLine to Get Coverage Model Name, skip blank and comment lines, fails when file empty - exit when AlertIf(EndFile(CovDbFile), AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: No Coverage Data to read", FAILURE) ; + exit when AlertIf(AlertLogIDVar, EndFile(CovDbFile), GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: No Coverage Data to read", FAILURE) ; ReadLine(CovDbFile, buf) ; - EmptyOrCommentLine(buf, Empty) ; + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; next when Empty ; if buf.all /= "Coverage_Model_Not_Named" then @@ -3181,46 +3225,56 @@ package body CoveragePkg is -- ReadLoop1 : while not EndFile(CovDbFile) loop ReadLoop1 : loop -- ReadLine to Get Variables, skip blank and comment lines, fails when file empty - exit when AlertIf(EndFile(CovDbFile), AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Coverage DB File Incomplete", FAILURE) ; + exit when AlertIf(AlertLogIDVar, EndFile(CovDbFile), GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Coverage DB File Incomplete", FAILURE) ; ReadLine(CovDbFile, buf) ; - EmptyOrCommentLine(buf, Empty) ; + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; next when Empty ; read(buf, iSeed, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Seed", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Seed", FAILURE) ; RV.SetSeed( iSeed ) ; RvSeedInit := TRUE ; read(buf, iCovThreshold, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading CovThreshold", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading CovThreshold", FAILURE) ; CovThreshold := iCovThreshold ; read(buf, iIllegalMode, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading IllegalMode", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading IllegalMode", FAILURE) ; SetIllegalMode(IllegalModeType'val( iIllegalMode )) ; read(buf, iWeightMode, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading WeightMode", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading WeightMode", FAILURE) ; WeightMode := WeightModeType'val( iWeightMode ) ; read(buf, iWeightScale, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading WeightScale", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading WeightScale", FAILURE) ; WeightScale := iWeightScale ; read(buf, iCountMode, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; CountMode := CountModeType'val( iCountMode ) ; read(buf, iThresholdingEnable, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; ThresholdingEnable := iThresholdingEnable ; read(buf, iCovTarget, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; CovTarget := iCovTarget ; read(buf, iMergingEnable, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading CountMode", FAILURE) ; MergingEnable := iMergingEnable ; exit ReadLoop1 ; @@ -3231,16 +3285,19 @@ package body CoveragePkg is -- ReadLoop2 : while not EndFile(CovDbFile) loop ReadLoop2 : while ReadValid loop -- ReadLine to Coverage Model Header WriteBin Message, skip blank and comment lines, fails when file empty - exit when AlertIf(EndFile(CovDbFile), AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Coverage DB File Incomplete", FAILURE) ; + exit when AlertIf(AlertLogIDVar, EndFile(CovDbFile), GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Coverage DB File Incomplete", FAILURE) ; ReadLine(CovDbFile, buf) ; - EmptyOrCommentLine(buf, Empty) ; + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; next when Empty ; read(buf, iNumberOfMessages, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading NumberOfMessages", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading NumberOfMessages", FAILURE) ; for i in 1 to iNumberOfMessages loop - exit when AlertIf(EndFile(CovDbFile), AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: End of File while reading Messages", FAILURE) ; + exit when AlertIf(AlertLogIDVar, EndFile(CovDbFile), GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: End of File while reading Messages", FAILURE) ; ReadLine(CovDbFile, buf) ; SetMessage(buf.all) ; end loop ; @@ -3261,22 +3318,26 @@ package body CoveragePkg is variable NumLines : out integer ; variable Good : out boolean ) is - variable buf : line ; - variable ReadValid : boolean ; - variable Empty : boolean ; + variable buf : line ; + variable ReadValid : boolean ; + variable Empty : boolean ; + variable MultiLineComment : boolean := FALSE ; begin ReadLoop : loop -- ReadLine to RangeItems NumLines, skip blank and comment lines, fails when file empty - exit when AlertIf(EndFile(CovDbFile), AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Coverage DB File Incomplete", FAILURE) ; + exit when AlertIf(AlertLogIDVar, EndFile(CovDbFile), GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Coverage DB File Incomplete", FAILURE) ; ReadLine(CovDbFile, buf) ; - EmptyOrCommentLine(buf, Empty) ; + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; next when Empty ; read(buf, NumRangeItems, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading NumRangeItems", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading NumRangeItems", FAILURE) ; read(buf, NumLines, ReadValid) ; - exit when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading NumLines", FAILURE) ; + exit when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading NumLines", FAILURE) ; exit ; end loop ReadLoop ; Good := ReadValid ; @@ -3293,50 +3354,61 @@ package body CoveragePkg is constant Merge : in boolean ; variable Good : out boolean ) is - variable buf : line ; - variable Empty : boolean ; - variable ReadValid : boolean ; + variable buf : line ; + variable Empty : boolean ; + variable MultiLineComment : boolean := FALSE ; + variable ReadValid : boolean ; -- Format: Action Count min1 max1 min2 max2 .... - variable Action : integer ; - variable Count : integer ; - variable BinVal : RangeArrayType(1 to NumRangeItems) ; - variable index : integer ; - variable AtLeast : integer ; - variable Weight : integer ; - variable PercentCov : real ; - variable NameLength : integer ; - variable SkipBlank : character ; - variable NamePtr : line ; + variable Action : integer ; + variable Count : integer ; + variable BinVal : RangeArrayType(1 to NumRangeItems) ; + variable index : integer ; + variable AtLeast : integer ; + variable Weight : integer ; + variable PercentCov : real ; + variable NameLength : integer ; + variable SkipBlank : character ; + variable NamePtr : line ; begin GrowBins(NumLines) ; ReadLoop : for i in 1 to NumLines loop GetValidLineLoop: loop - exit ReadLoop when AlertIf(EndFile(CovDbFile), AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg..ReadCovDb: Did not read specified number of lines", FAILURE) ; + exit ReadLoop when AlertIf(AlertLogIDVar, EndFile(CovDbFile), GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Did not read specified number of lines", FAILURE) ; ReadLine(CovDbFile, buf) ; - EmptyOrCommentLine(buf, Empty) ; + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; next GetValidLineLoop when Empty ; -- replace with EmptyLine(buf) exit GetValidLineLoop ; end loop ; read(buf, Action, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Action", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Action", FAILURE) ; read(buf, Count, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Count", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Count", FAILURE) ; read(buf, AtLeast, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading AtLeast", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading AtLeast", FAILURE) ; read(buf, Weight, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Weight", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Weight", FAILURE) ; read(buf, PercentCov, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading PercentCov", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading PercentCov", FAILURE) ; read(buf, BinVal, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading BinVal", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading BinVal", FAILURE) ; read(buf, NameLength, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Bin Name Length", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Bin Name Length", FAILURE) ; read(buf, SkipBlank, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Bin Name Length", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Bin Name Length", FAILURE) ; read(buf, NamePtr, NameLength, ReadValid) ; - exit ReadLoop when AlertIfNot(ReadValid, AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.ReadCovDb: Failed while reading Bin Name", FAILURE) ; + exit ReadLoop when AlertIfNot(AlertLogIDVar, ReadValid, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.ReadCovDb: Failed while reading Bin Name", FAILURE) ; index := FindExactBin(Merge, BinVal, Action, AtLeast, Weight, NamePtr.all) ; if index > 0 then -- Bin is an exact match so only merge the count values @@ -3398,11 +3470,7 @@ package body CoveragePkg is variable buf : line ; begin -- write coverage private variables to the file - if CovNameVar.IsSet then - write(buf, GetName) ; - else - swrite(buf, "Coverage_Model_Not_Named") ; - end if ; + swrite(buf, CovNameVar.Get("Coverage_Model_Not_Named")) ; writeline(CovDbFile, buf) ; write(buf, RV.GetSeed ) ; @@ -3477,7 +3545,8 @@ package body CoveragePkg is if NumBins >= 1 then WriteCovDb(CovDbFile) ; else - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.WriteCovDb when no bins defined ", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & + "CoveragePkg.WriteCovDb: no bins defined ", FAILURE) ; end if ; end procedure WriteCovDb ; @@ -3512,10 +3581,11 @@ package body CoveragePkg is end function GetErrorCount ; ------------------------------------------------------------ - -- These support the older AddBins(GenCross(...)) methodology + -- These support usage of cross coverage constants + -- Also support the older AddBins(GenCross(...)) methodology -- which has been replaced by AddCross ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix2Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix2Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3525,11 +3595,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix3Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix3Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3539,11 +3609,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix4Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix4Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3553,11 +3623,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix5Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix5Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3567,11 +3637,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix6Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix6Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3581,11 +3651,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix7Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix7Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3595,11 +3665,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix8Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix8Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3609,11 +3679,11 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; ------------------------------------------------------------ - procedure AddBins (CovBin : CovMatrix9Type ; Name : String := "") is + procedure AddCross (CovBin : CovMatrix9Type ; Name : String := "") is ------------------------------------------------------------ begin GrowBins(CovBin'length) ; @@ -3623,7 +3693,7 @@ package body CoveragePkg is CovBin(i).AtLeast, CovBin(i).Weight, Name ) ; end loop ; - end procedure AddBins ; + end procedure AddCross ; -- ------------------------------------------------------------ -- ------------------------------------------------------------ @@ -3766,7 +3836,8 @@ package body CoveragePkg is CovBinPtr(BinIndex).Count ) ; when others => - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.CalcWeight Selected Weight Mode not Supported with depricated RandCovPoint(AtLeast), see RandCovPoint(PercentCov)", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.CalcWeight:" & + " Selected Weight Mode not supported with deprecated RandCovPoint(AtLeast), see RandCovPoint(PercentCov)", FAILURE) ; return MaxAtLeast - CovBinPtr(BinIndex).Count ; end case ; @@ -3868,9 +3939,9 @@ package body CoveragePkg is end if ; end if ; end loop CovLoop ; - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.GetHoleBinVal did not find hole. " & - "HoleCount = " & integer'image(HoleCount) & - "ReqHoleNum = " & integer'image(ReqHoleNum), ERROR + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.GetHoleBinVal:" & + " did not find hole. HoleCount = " & integer'image(HoleCount) & + "ReqHoleNum = " & integer'image(ReqHoleNum), ERROR ) ; return CovBinPtr(NumBins).BinVal.all ; end function GetHoleBinVal ; @@ -3896,12 +3967,12 @@ package body CoveragePkg is if NumBins < 1 then if WriteBinFileInit or UsingLocalFile then -- Duplicate Alert in specified file - swrite(buf, "%% FAILURE CoverageModel ") ; - swrite(buf, GetName) ; - swrite(buf, "CoverageModel " & GetName & " CoveragePkg.WriteCovHoles: coverage model is empty. Nothing to print.") ; + swrite(buf, "%% Alert FAILURE " & GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.WriteCovHoles:" & + " coverage model is empty. Nothing to print.") ; writeline(f, buf) ; end if ; - Alert(AlertLogIDVar, "CoverageModel " & GetName & " CoveragePkg.WriteCovHoles: coverage model is empty. Nothing to print.", FAILURE) ; + Alert(AlertLogIDVar, GetNamePlus(prefix => "in ", suffix => ", ") & "CoveragePkg.WriteCovHoles:" & + " coverage model is empty. Nothing to print.", FAILURE) ; end if ; CovLoop : for i in 1 to NumBins loop -- minAtLeast := minimum(AtLeast,CovBinPtr(i).AtLeast) ; @@ -3929,10 +4000,17 @@ package body CoveragePkg is ------------------------------------------------------------ begin if WriteBinFileInit then + -- Write to Local WriteBinFile - Deprecated, recommend use TranscriptFile instead WriteCovHoles(WriteBinFile, AtLeast) ; elsif IsTranscriptEnabled then + -- Write to TranscriptFile WriteCovHoles(TranscriptFile, AtLeast) ; + if IsTranscriptMirrored then + -- Mirrored to OUTPUT + WriteCovHoles(OUTPUT, AtLeast) ; + end if ; else + -- Default Write to OUTPUT WriteCovHoles(OUTPUT, AtLeast) ; end if; end procedure WriteCovHoles ; @@ -3967,6 +4045,118 @@ package body CoveragePkg is WriteCovHoles(FileName, AtLeast, OpenKind) ; end if; end procedure WriteCovHoles ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix2Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix3Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix4Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix5Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix6Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix7Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix8Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; + + + ------------------------------------------------------------ + procedure AddBins (CovBin : CovMatrix9Type ; Name : String := "") is + ------------------------------------------------------------ + begin + GrowBins(CovBin'length) ; + for i in CovBin'range loop + InsertBin( + CovBin(i).BinVal, CovBin(i).Action, CovBin(i).Count, + CovBin(i).AtLeast, CovBin(i).Weight, Name + ) ; + end loop ; + end procedure AddBins ; end protected body CovPType ; @@ -3996,8 +4186,8 @@ package body CoveragePkg is if (NumBins1 /= NumBins2) then ErrorCount := ErrorCount + 1 ; - print("CoverageModels " & Bin1.GetName & " and " & Bin2.GetName & - " CoveragePkg.CompareBins, Bins have different lengths") ; + print("CoveragePkg.CompareBins: CoverageModels " & Bin1.GetNamePlus & " and " & Bin2.GetNamePlus & + " have different bin lengths") ; return ; end if ; @@ -4044,13 +4234,14 @@ package body CoveragePkg is begin CompareBins(Bin1, Bin2, ErrorCount) ; iAlertLogID := Bin1.GetAlertLogID ; - AlertIf(ErrorCount /= 0, "CoverageModels " & Bin1.GetName & " and " & Bin2.GetName & - " miscompared. CoveragePkg.CompareBins") ; + AlertIf(ErrorCount /= 0, "CoveragePkg.CompareBins: CoverageModels " & Bin1.GetNamePlus & " and " & Bin2.GetNamePlus & " are not the same.") ; end procedure CompareBins ; ------------------------------------------------------------ -- package local, Used by GenBin, IllegalBin, and IgnoreBin function MakeBin( + -- Must be pure to allow initializing coverage models passed as generics. + -- Impure implies the expression is not globally static. ------------------------------------------------------------ Min, Max : integer ; NumBin : integer ; @@ -4060,46 +4251,59 @@ package body CoveragePkg is ) return CovBinType is variable iCovBin : CovBinType(1 to NumBin) ; variable TotalBins : integer ; -- either real or integer - variable rMax, rCurMin, rNextMin, rNumItemsInBin, rRemainingBins : real ; -- must be real + variable rMax, rCurMin, rNumItemsInBin, rRemainingBins : real ; -- must be real + variable iCurMin, iCurMax : integer ; begin if Min > Max then - Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (GenBin, IllegalBin, IgnoreBin): Min must be <= Max", FAILURE) ; + -- Similar to NULL ranges. Only generate report warning. + report "OSVVM.CoveragePkg.MakeBin (called by GenBin, IllegalBin, or IgnoreBin) MAX > MIN generated NULL_BIN" + severity WARNING ; + -- No Alerts. They make this impure. + -- Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (called by GenBin, IllegalBin, IgnoreBin): Min must be <= Max", WARNING) ; return NULL_BIN ; elsif NumBin <= 0 then - Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (GenBin, IllegalBin, IgnoreBin): NumBin must be <= 0", FAILURE) ; + -- Similar to NULL ranges. Only generate report warning. + report "OSVVM.CoveragePkg.MakeBin (called by GenBin, IllegalBin, or IgnoreBin) NumBin <= 0 generated NULL_BIN" + severity WARNING ; + -- Alerts make this impure. + -- Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (called by GenBin, IllegalBin, IgnoreBin): NumBin must be <= 0", WARNING) ; return NULL_BIN ; elsif NumBin = 1 then iCovBin(1) := ( - BinVal => (1 => (Min, Max)), - Action => Action, - Count => 0, - Weight => Weight, - AtLeast => AtLeast + BinVal => (1 => (Min, Max)), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast ) ; return iCovBin ; else - rCurMin := real(Min) ; + -- Using type real to work around issues with integer sizing + iCurMin := Min ; + rCurMin := real(iCurMin) ; rMax := real(Max) ; rRemainingBins := (minimum( real(NumBin), rMax - rCurMin + 1.0 )) ; TotalBins := integer(rRemainingBins) ; for i in iCovBin'range loop - exit when rRemainingBins = 0.0 ; - rNumItemsInBin := trunc((rMax - rCurMin + 1.0) / rRemainingBins) ; -- can be too large - rNextMin := rCurMin + rNumItemsInBin ; -- can be 2**31 + rNumItemsInBin := trunc((rMax - rCurMin + 1.0) / rRemainingBins) ; -- Max - Min can be larger than integer range. + iCurMax := iCurMin - integer(-rNumItemsInBin + 1.0) ; -- Keep: the "minus negative" works around a simulator bounds issue found in 2015.06 iCovBin(i) := ( - BinVal => (1 => (integer(rCurMin), integer(rNextMin - 1.0))), - Action => Action, - Count => 0, - Weight => Weight, - AtLeast => AtLeast + BinVal => (1 => (iCurMin, iCurMax)), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast ) ; - rCurMin := rNextMin ; rRemainingBins := rRemainingBins - 1.0 ; + exit when rRemainingBins = 0.0 ; + iCurMin := iCurMax + 1 ; + rCurMin := real(iCurMin) ; end loop ; return iCovBin(1 to TotalBins) ; + end if ; end function MakeBin ; @@ -4118,17 +4322,21 @@ package body CoveragePkg is begin if A'length <= 0 then - Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (GenBin, IllegalBin, IgnoreBin): integer_vector parameter must have values", FAILURE) ; + -- Similar to NULL ranges. Only generate report warning. + report "OSVVM.CoveragePkg.MakeBin (called by GenBin, IllegalBin, or IgnoreBin) integer_vector length <= 0 generated NULL_BIN" + severity WARNING ; + -- Alerts make this impure. + -- Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (GenBin, IllegalBin, IgnoreBin): integer_vector parameter must have values", WARNING) ; return NULL_BIN ; else for i in NewA'Range loop iCovBin(i) := ( - BinVal => (i => (NewA(i), NewA(i)) ), - Action => Action, - Count => 0, - Weight => Weight, - AtLeast => AtLeast + BinVal => (i => (NewA(i), NewA(i)) ), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast ) ; end loop ; return iCovBin ; @@ -4713,34 +4921,6 @@ package body CoveragePkg is end function GenCross ; - ------------------------------------------------------------ - procedure increment( signal Count : inout integer ) is - ------------------------------------------------------------ - begin - Count <= Count + 1 ; - end procedure increment ; - - - ------------------------------------------------------------ - procedure increment( signal Count : inout integer ; enable : boolean ) is - ------------------------------------------------------------ - begin - if enable then - Count <= Count + 1 ; - end if ; - end procedure increment ; - - - ------------------------------------------------------------ - procedure increment( signal Count : inout integer ; enable : std_ulogic ) is - ------------------------------------------------------------ - begin - if to_x01(enable) = '1' then - Count <= Count + 1 ; - end if ; - end procedure increment ; - - ------------------------------------------------------------ function to_integer ( B : boolean ) return integer is ------------------------------------------------------------ @@ -4787,5 +4967,38 @@ package body CoveragePkg is end loop ; return result ; end function to_integer_vector ; + + + ------------------------------------------------------------ + ------------------------------------------------------------ +-- Deprecated: These are not part of the coverage model + + ------------------------------------------------------------ + procedure increment( signal Count : inout integer ) is + ------------------------------------------------------------ + begin + Count <= Count + 1 ; + end procedure increment ; + + + ------------------------------------------------------------ + procedure increment( signal Count : inout integer ; enable : boolean ) is + ------------------------------------------------------------ + begin + if enable then + Count <= Count + 1 ; + end if ; + end procedure increment ; + + + ------------------------------------------------------------ + procedure increment( signal Count : inout integer ; enable : std_ulogic ) is + ------------------------------------------------------------ + begin + if to_x01(enable) = '1' then + Count <= Count + 1 ; + end if ; + end procedure increment ; + end package body CoveragePkg ; \ No newline at end of file diff --git a/MakeBin_Debug.vhd b/MakeBin_Debug.vhd new file mode 100644 index 0000000..9b4d0ec --- /dev/null +++ b/MakeBin_Debug.vhd @@ -0,0 +1,111 @@ + ------------------------------------------------------------ + -- package local, Used by GenBin, IllegalBin, and IgnoreBin + function MakeBin( + ------------------------------------------------------------ + Min, Max : integer ; + NumBin : integer ; + AtLeast : integer ; + Weight : integer ; + Action : integer + ) return CovBinType is + variable iCovBin : CovBinType(1 to NumBin) ; + variable TotalBins : integer ; -- either real or integer + variable rMax, rCurMin, rNextMin, rNumItemsInBin, rRemainingBins : real ; -- must be real + variable CurMin, Offset : integer ; + begin + if Min > Max then + Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (GenBin, IllegalBin, IgnoreBin): Min must be <= Max", FAILURE) ; + return NULL_BIN ; + + elsif NumBin <= 0 then + Alert(OSVVM_ALERTLOG_ID, "CoveragePkg.MakeBin (GenBin, IllegalBin, IgnoreBin): NumBin must be <= 0", FAILURE) ; + return NULL_BIN ; + + elsif NumBin = 1 then + iCovBin(1) := ( + BinVal => (1 => (Min, Max)), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast + ) ; + return iCovBin ; + + else + CurMin := Min ; + TotalBins := integer( (minimum( real(NumBin), real(Max) - real(Min) + 1.0))) ; + RemainingBins := TotalBins ; + + for i in iCovBin'range loop + exit when RemainingBins = 0 ; + + Offset := CalcOffset(Min, Max, ) + RemainingBins := CALC_NUM_BINS - i ; + NumItemsInBin := (Max - CurMin + 1) / RemainingBins ; + NextMin := CurMin + NumItemsInBin ; + iCovBin(i) := ( + BinVal => (1 => (CurMin, NextMin - 1)), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast + ) ; + CurMin := NextMin ; + end loop ; + return iCovBin ; + + + rCurMin := real(Min) ; + rMax := real(Max) ; + rRemainingBins := (minimum( real(NumBin), rMax - rCurMin + 1.0 )) ; + TotalBins := integer(rRemainingBins) ; + for i in iCovBin'range loop + exit when rRemainingBins = 0.0 ; + rNumItemsInBin := trunc((rMax - rCurMin + 1.0) / rRemainingBins) ; -- can be too large + rNextMin := rCurMin + rNumItemsInBin ; -- can be 2**31 + iCovBin(i) := ( + BinVal => (1 => (integer(rCurMin), integer(rNextMin - 1.0))), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast + ) ; + rCurMin := rNextMin ; + rRemainingBins := rRemainingBins - 1.0 ; + end loop ; + return iCovBin(1 to TotalBins) ; + end if ; + end function MakeBin ; + + + ------------------------------------------------------------ + -- Local, Used by GenBin, IllegalBin, and IgnoreBin + function MakeBin( + ------------------------------------------------------------ + Min, Max : integer ; + NumBin : integer ; + AtLeast : integer ; + Weight : integer ; + Action : integer + ) return CovBinType is + constant CALC_NUM_BINS : integer := minimum(NumBin, Max-Min+1) ; + variable iCovBin : CovBinType(0 to CALC_NUM_BINS -1) ; + variable CurMin, NextMin, RemainingBins, NumItemsInBin : integer ; + begin + CurMin := Min ; + for i in iCovBin'range loop + RemainingBins := CALC_NUM_BINS - i ; + NumItemsInBin := (Max - CurMin + 1) / RemainingBins ; + NextMin := CurMin + NumItemsInBin ; + iCovBin(i) := ( + BinVal => (1 => (CurMin, NextMin - 1)), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast + ) ; + CurMin := NextMin ; + end loop ; + return iCovBin ; + end function MakeBin ; + diff --git a/MakeBin_Debug.vhld b/MakeBin_Debug.vhld new file mode 100644 index 0000000..176aa21 --- /dev/null +++ b/MakeBin_Debug.vhld @@ -0,0 +1,30 @@ + ------------------------------------------------------------ + -- Local, Used by GenBin, IllegalBin, and IgnoreBin + function MakeBin( + ------------------------------------------------------------ + Min, Max : integer ; + NumBin : integer ; + AtLeast : integer ; + Weight : integer ; + Action : integer + ) return CovBinType is + constant CALC_NUM_BINS : integer := minimum(NumBin, Max-Min+1) ; + variable iCovBin : CovBinType(0 to CALC_NUM_BINS -1) ; + variable CurMin, NextMin, RemainingBins, NumItemsInBin : integer ; + begin + CurMin := Min ; + for i in iCovBin'range loop + RemainingBins := CALC_NUM_BINS - i ; + NumItemsInBin := (Max - CurMin + 1) / RemainingBins ; + NextMin := CurMin + NumItemsInBin ; + iCovBin(i) := ( + BinVal => (1 => (CurMin, NextMin - 1)), + Action => Action, + Count => 0, + Weight => Weight, + AtLeast => AtLeast + ) ; + CurMin := NextMin ; + end loop ; + return iCovBin ; + end function MakeBin ; diff --git a/MemoryPkg.vhd b/MemoryPkg.vhd new file mode 100644 index 0000000..066cc6e --- /dev/null +++ b/MemoryPkg.vhd @@ -0,0 +1,666 @@ +-- +-- File Name: MemoryPkg.vhd +-- Design Unit Name: MemoryPkg +-- Revision: STANDARD VERSION +-- +-- Maintainer: Jim Lewis email: jim@synthworks.com +-- Contributor(s): +-- Jim Lewis email: jim@synthworks.com +-- +-- Description +-- Package defines a protected type, MemoryPType, and methods +-- for efficiently implementing memory data structures +-- +-- 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/2015: 2015.06 Updated for Alerts, ... +-- Numerous revisions for VHDL Testbenches and Verification +-- 05/2005: 0.1 Initial revision +-- +-- +-- Copyright (c) 2005 - 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 ; +library IEEE ; + use IEEE.std_logic_1164.all ; + use IEEE.numeric_std.all ; + use IEEE.numeric_std_unsigned.all ; + use IEEE.math_real.all ; + +use work.TextUtilPkg.all ; +use work.TranscriptPkg.all ; +use work.AlertLogPkg.all ; + +package MemoryPkg is + type MemoryPType is protected + ------------------------------------------------------------ + procedure MemInit ( AddrWidth, DataWidth : in integer ) ; + + ------------------------------------------------------------ + procedure MemWrite ( Addr, Data : in std_logic_vector ) ; + + ------------------------------------------------------------ + procedure MemRead ( + Addr : in std_logic_vector ; + Data : out std_logic_vector + ) ; + impure function MemRead ( Addr : std_logic_vector ) return std_logic_vector ; + + ------------------------------------------------------------ + procedure MemErase ; + procedure deallocate ; + + ------------------------------------------------------------ + procedure SetAlertLogID (A : AlertLogIDType) ; + procedure SetAlertLogID (Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) ; + impure function GetAlertLogID return AlertLogIDType ; + + ------------------------------------------------------------ + procedure FileReadH ( -- Hexadecimal File Read + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) ; + procedure FileReadH (FileName : string ; StartAddr : std_logic_vector) ; + procedure FileReadH (FileName : string) ; + + ------------------------------------------------------------ + procedure FileReadB ( -- Binary File Read + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) ; + procedure FileReadB (FileName : string ; StartAddr : std_logic_vector) ; + procedure FileReadB (FileName : string) ; + + ------------------------------------------------------------ + procedure FileWriteH ( -- Hexadecimal File Write + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) ; + procedure FileWriteH (FileName : string ; StartAddr : std_logic_vector) ; + procedure FileWriteH (FileName : string) ; + + ------------------------------------------------------------ + procedure FileWriteB ( -- Binary File Write + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) ; + procedure FileWriteB (FileName : string ; StartAddr : std_logic_vector) ; + procedure FileWriteB (FileName : string) ; + + end protected MemoryPType ; + +end MemoryPkg ; + +package body MemoryPkg is + constant BLOCK_WIDTH : integer := 10 ; + + type MemoryPType is protected body + + type MemBlockType is array (integer range <>) of integer ; + type MemBlockPtrType is access MemBlockType ; + type MemArrayType is array (integer range <>) of MemBlockPtrType ; + type ArrayPtrVarType is access MemArrayType ; + + variable ArrayPtrVar : ArrayPtrVarType := NULL ; + variable AddrWidthVar : integer := -1 ; -- set by MemInit - merges addr length and initialized checks. + variable DataWidthVar : natural := 1 ; -- set by MemInit + variable BlockkWidthVar : natural := 0 ; -- set by MemInit + + variable AlertLogIDVar : AlertLogIDType := OSVVM_ALERTLOG_ID ; + + type FileFormatType is (BINARY, HEX) ; + + ------------------------------------------------------------ + procedure MemInit ( AddrWidth, DataWidth : In integer ) is + ------------------------------------------------------------ + begin + if AddrWidth <= 0 then + Alert(AlertLogIDVar, "MemoryPType.MemInit. AddrWidth = " & to_string(AddrWidth) & " must be > 0.", FAILURE) ; + return ; + end if ; + if DataWidth <= 0 then + Alert(AlertLogIDVar, "MemoryPType.MemInit. DataWidth = " & to_string(DataWidth) & " must be > 0.", FAILURE) ; + return ; + end if ; + + AddrWidthVar := AddrWidth ; + DataWidthVar := DataWidth ; + BlockkWidthVar := minimum(BLOCK_WIDTH, AddrWidth) ; + ArrayPtrVar := new MemArrayType(0 to 2**(AddrWidth-BlockkWidthVar)-1) ; + end procedure MemInit ; + + ------------------------------------------------------------ + procedure MemWrite ( Addr, Data : in std_logic_vector ) is + ------------------------------------------------------------ + variable BlockAddr, WordAddr : integer ; + alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ; + begin + + -- Check Bounds of Address and if memory is initialized + if Addr'length /= AddrWidthVar then + if (ArrayPtrVar = NULL) then + Alert(AlertLogIDVar, "MemoryPType.MemWrite: Memory not initialized, Write Ignored.", FAILURE) ; + else + Alert(AlertLogIDVar, "MemoryPType.MemWrite: Addr'length: " & to_string(Addr'length) & " /= Memory Address Width: " & to_string(AddrWidthVar), FAILURE) ; + end if ; + return ; + end if ; + + -- Check Bounds on Data + if Data'length /= DataWidthVar then + Alert(AlertLogIDVar, "MemoryPType.MemWrite: Data'length: " & to_string(Data'length) & " /= Memory Data Width: " & to_string(DataWidthVar), FAILURE) ; + return ; + end if ; + + if is_X( Addr ) then + Alert(AlertLogIDVar, "MemoryPType.MemWrite: Address X, Write Ignored.") ; + return ; + end if ; + + -- Slice out upper address to form block address + if aAddr'high >= BlockkWidthVar then + BlockAddr := to_integer(aAddr(aAddr'high downto BlockkWidthVar)) ; + else + BlockAddr := 0 ; + end if ; + + -- If empty, allocate a memory block + if (ArrayPtrVar(BlockAddr) = NULL) then + ArrayPtrVar(BlockAddr) := new MemBlockType(0 to 2**BlockkWidthVar-1) ; + end if ; + + -- Address of a word within a block + WordAddr := to_integer(aAddr(BlockkWidthVar -1 downto 0)) ; + + -- Write to BlockAddr, WordAddr + if (Is_X(Data)) then + ArrayPtrVar(BlockAddr)(WordAddr) := -1 ; + else + ArrayPtrVar(BlockAddr)(WordAddr) := to_integer( Data ) ; + end if ; + end procedure MemWrite ; + + ------------------------------------------------------------ + procedure MemRead ( + ------------------------------------------------------------ + Addr : In std_logic_vector ; + Data : Out std_logic_vector + ) is + variable BlockAddr, WordAddr : integer ; + alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ; + begin + -- Check Bounds of Address and if memory is initialized + if Addr'length /= AddrWidthVar then + if (ArrayPtrVar = NULL) then + Alert(AlertLogIDVar, "MemoryPType.MemRead: Memory not initialized. Returning U", FAILURE) ; + else + Alert(AlertLogIDVar, "MemoryPType.MemRead: Addr'length: " & to_string(Addr'length) & " /= Memory Address Width: " & to_string(AddrWidthVar), FAILURE) ; + end if ; + Data := (Data'range => 'U') ; + return ; + end if ; + + -- Check Bounds on Data + if Data'length /= DataWidthVar then + Alert(AlertLogIDVar, "MemoryPType.MemRead: Data'length: " & to_string(Data'length) & " /= Memory Data Width: " & to_string(DataWidthVar), FAILURE) ; + Data := (Data'range => 'U') ; + return ; + end if ; + + -- If Addr X, data = X + if is_X( aAddr ) then + Data := (Data'range => 'X') ; + return ; + end if ; + + -- Slice out upper address to form block address + if aAddr'high >= BlockkWidthVar then + BlockAddr := to_integer(aAddr(aAddr'high downto BlockkWidthVar)) ; + else + BlockAddr := 0 ; + end if ; + + -- Empty Block, return all U + if (ArrayPtrVar(BlockAddr) = NULL) then + Data := (Data'range => 'U') ; + return ; + end if ; + + -- Address of a word within a block + WordAddr := to_integer(aAddr(BlockkWidthVar -1 downto 0)) ; + + -- X in Word, return all X + if (ArrayPtrVar(BlockAddr)(WordAddr) < 0) then + Data := (Data'range => 'X') ; + + -- Get the Word from the Array + else + Data := to_slv(ArrayPtrVar(BlockAddr)(WordAddr), Data'length) ; + + end if ; + end procedure MemRead ; + + ------------------------------------------------------------ + impure function MemRead ( Addr : std_logic_vector ) return std_logic_vector is + ------------------------------------------------------------ + variable BlockAddr, WordAddr : integer ; + alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ; + variable Data : std_logic_vector(DataWidthVar-1 downto 0) ; + begin + MemRead(Addr, Data) ; + return Data ; + end function MemRead ; + + ------------------------------------------------------------ + procedure MemErase is + -- Deallocate the memory, but not the array of pointers + ------------------------------------------------------------ + begin + for BlockAddr in ArrayPtrVar'range loop + if (ArrayPtrVar(BlockAddr) /= NULL) then + deallocate (ArrayPtrVar(BlockAddr)) ; + end if ; + end loop ; + end procedure ; + + ------------------------------------------------------------ + procedure deallocate is + -- Deallocate all allocated memory + ------------------------------------------------------------ + begin + MemErase ; + deallocate(ArrayPtrVar) ; + AddrWidthVar := -1 ; + DataWidthVar := 1 ; + BlockkWidthVar := 0 ; + end procedure ; + + ------------------------------------------------------------ + procedure SetAlertLogID (A : AlertLogIDType) is + ------------------------------------------------------------ + begin + AlertLogIDVar := A ; + end procedure SetAlertLogID ; + + ------------------------------------------------------------ + procedure SetAlertLogID(Name : string ; ParentID : AlertLogIDType := ALERTLOG_BASE_ID ; CreateHierarchy : Boolean := TRUE) is + ------------------------------------------------------------ + begin + AlertLogIDVar := GetAlertLogID(Name, ParentID, CreateHierarchy) ; + end procedure SetAlertLogID ; + + ------------------------------------------------------------ + impure function GetAlertLogID return AlertLogIDType is + ------------------------------------------------------------ + begin + return AlertLogIDVar ; + end function GetAlertLogID ; + + ------------------------------------------------------------ + -- PT Local + procedure FileReadX ( + -- Hexadecimal or Binary File Read + ------------------------------------------------------------ + FileName : string ; + DataFormat : FileFormatType ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) is + -- Format: + -- @hh..h -- Address in hex + -- hhh_XX_ZZ -- data values in hex - space delimited + -- "--" or "//" -- comments + file MemFile : text open READ_MODE is FileName ; + + variable Addr : std_logic_vector(AddrWidthVar - 1 downto 0) ; + variable SmallAddr : std_logic_vector(AddrWidthVar - 1 downto 0) ; + variable BigAddr : std_logic_vector(AddrWidthVar - 1 downto 0) ; + variable Data : std_logic_vector(DataWidthVar - 1 downto 0) ; + variable LineNum : natural ; + variable ItemNum : natural ; + variable AddrInc : std_logic_vector(AddrWidthVar - 1 downto 0) ; + variable buf : line ; + variable ReadValid : boolean ; + variable Empty : boolean ; + variable MultiLineComment : boolean ; + variable NextChar : character ; + variable StrLen : integer ; + begin + MultiLineComment := FALSE ; + if StartAddr'length /= AddrWidthVar and EndAddr'length /= AddrWidthVar then + if (ArrayPtrVar = NULL) then + Alert(AlertLogIDVar, "MemoryPType.FileReadX: Memory not initialized, FileRead Ignored.", FAILURE) ; + else + Alert(AlertLogIDVar, "MemoryPType.FileReadX: Addr'length: " & to_string(Addr'length) & " /= Memory Address Width: " & to_string(AddrWidthVar), FAILURE) ; + end if ; + return ; + end if ; + + Addr := StartAddr ; + LineNum := 0 ; + + if StartAddr <= EndAddr then + SmallAddr := StartAddr ; + BigAddr := EndAddr ; + AddrInc := (AddrWidthVar -1 downto 0 => '0') + 1 ; + else + SmallAddr := EndAddr ; + BigAddr := StartAddr ; + AddrInc := (others => '1') ; -- -1 + end if; + + ReadLineLoop : while not EndFile(MemFile) loop + ReadLine(MemFile, buf) ; + LineNum := LineNum + 1 ; + ItemNum := 0 ; + + ItemLoop : loop + EmptyOrCommentLine(buf, Empty, MultiLineComment) ; + exit ItemLoop when Empty ; + ItemNum := ItemNum + 1 ; + NextChar := buf.all(1) ; + + if (NextChar = '@') then + -- Get Address + read(buf, NextChar) ; + ReadHexToken(buf, Addr, StrLen) ; + exit ReadLineLoop when AlertIf(AlertLogIDVar, StrLen = 0, "MemoryPType.FileReadX: Address length 0 on line: " & to_string(LineNum), FAILURE) ; + exit ItemLoop when AlertIf(AlertLogIDVar, Addr < SmallAddr, + "MemoryPType.FileReadX: Address in file: " & to_hstring(Addr) & + " < StartAddr: " & to_hstring(StartAddr) & " on line: " & to_string(LineNum)) ; + exit ItemLoop when AlertIf(AlertLogIDVar, Addr > BigAddr, + "MemoryPType.FileReadX: Address in file: " & to_hstring(Addr) & + " > EndAddr: " & to_hstring(BigAddr) & " on line: " & to_string(LineNum)) ; + + elsif DataFormat = HEX and ishex(NextChar) then + -- Get Hex Data + ReadHexToken(buf, data, StrLen) ; + exit ReadLineLoop when AlertIfNot(AlertLogIDVar, StrLen > 0, + "MemoryPType.FileReadH: Error while reading data on line: " & to_string(LineNum) & + " Item number: " & to_string(ItemNum), FAILURE) ; + log("MemoryPType.FileReadX: MemWrite(Addr => " & to_hstring(Addr) & ", Data => " & to_hstring(Data) & ")", DEBUG) ; + MemWrite(Addr, data) ; + Addr := Addr + AddrInc ; + + elsif DataFormat = BINARY and isstd_logic(NextChar) then + -- Get Binary Data + -- read(buf, data, ReadValid) ; + ReadBinaryToken(buf, data, StrLen) ; + -- exit ReadLineLoop when AlertIfNot(AlertLogIDVar, ReadValid, + exit ReadLineLoop when AlertIfNot(AlertLogIDVar, StrLen > 0, + "MemoryPType.FileReadB: Error while reading data on line: " & to_string(LineNum) & + " Item number: " & to_string(ItemNum), FAILURE) ; + log("MemoryPType.FileReadX: MemWrite(Addr => " & to_hstring(Addr) & ", Data => " & to_string(Data) & ")", DEBUG) ; + MemWrite(Addr, data) ; + Addr := Addr + AddrInc ; + + else + -- Invalid Text, Issue Warning and skip it + Alert(AlertLogIDVar, + "MemoryPType.FileReadX: Invalid text on line: " & to_string(LineNum) & + " Item: " & to_string(ItemNum) & ". Skipping text: " & buf.all) ; + exit ItemLoop ; + end if ; + + end loop ItemLoop ; + end loop ReadLineLoop ; + +-- -- must read EndAddr-StartAddr number of words if both start and end specified +-- if (StartAddr /= 0 or (not EndAddr) /= 0) and (Addr /= EndAddr) then +-- Alert("MemoryPType.FileReadH: insufficient data values", WARNING) ; +-- end if ; + file_close(MemFile) ; + end FileReadX ; + + ------------------------------------------------------------ + procedure FileReadH ( + -- Hexadecimal File Read + ------------------------------------------------------------ + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) is + begin + FileReadX(FileName, HEX, StartAddr, EndAddr) ; + end FileReadH ; + + ------------------------------------------------------------ + procedure FileReadH (FileName : string ; StartAddr : std_logic_vector) is + -- Hexadecimal File Read + ------------------------------------------------------------ + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileReadX(FileName, HEX, StartAddr, EndAddr) ; + end FileReadH ; + + ------------------------------------------------------------ + procedure FileReadH (FileName : string) is + -- Hexadecimal File Read + ------------------------------------------------------------ + constant StartAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '0') ; + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileReadX(FileName, HEX, StartAddr, EndAddr) ; + end FileReadH ; + + ------------------------------------------------------------ + procedure FileReadB ( + -- Binary File Read + ------------------------------------------------------------ + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) is + begin + FileReadX(FileName, BINARY, StartAddr, EndAddr) ; + end FileReadB ; + + ------------------------------------------------------------ + procedure FileReadB (FileName : string ; StartAddr : std_logic_vector) is + -- Binary File Read + ------------------------------------------------------------ + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileReadX(FileName, BINARY, StartAddr, EndAddr) ; + end FileReadB ; + + ------------------------------------------------------------ + procedure FileReadB (FileName : string) is + -- Binary File Read + ------------------------------------------------------------ + constant StartAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '0') ; + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileReadX(FileName, BINARY, StartAddr, EndAddr) ; + end FileReadB ; + + ------------------------------------------------------------ + -- PT Local + procedure FileWriteX ( + -- Hexadecimal or Binary File Write + ------------------------------------------------------------ + FileName : string ; + DataFormat : FileFormatType ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) is + -- Format: + -- @hh..h -- Address in hex + -- hhhhh -- data one per line in either hex or binary as specified + file MemFile : text open WRITE_MODE is FileName ; + alias normStartAddr : std_logic_vector(StartAddr'length-1 downto 0) is StartAddr ; + alias normEndAddr : std_logic_vector(EndAddr'length-1 downto 0) is EndAddr ; + variable StartBlockAddr : natural ; + variable EndBlockAddr : natural ; + variable StartWordAddr : natural ; + variable EndWordAddr : natural ; + variable Data : std_logic_vector(DataWidthVar - 1 downto 0) ; + variable FoundData : boolean ; + variable buf : line ; + begin + if StartAddr'length /= AddrWidthVar and EndAddr'length /= AddrWidthVar then + -- Check StartAddr and EndAddr Widths and Memory not initialized + if (ArrayPtrVar = NULL) then + Alert(AlertLogIDVar, "MemoryPType.FileWriteX: Memory not initialized, FileRead Ignored.", FAILURE) ; + else + AlertIf(AlertLogIDVar, StartAddr'length /= AddrWidthVar, "MemoryPType.FileWriteX: StartAddr'length: " + & to_string(StartAddr'length) & + " /= Memory Address Width: " & to_string(AddrWidthVar), FAILURE) ; + AlertIf(AlertLogIDVar, EndAddr'length /= AddrWidthVar, "MemoryPType.FileWriteX: EndAddr'length: " + & to_string(EndAddr'length) & + " /= Memory Address Width: " & to_string(AddrWidthVar), FAILURE) ; + end if ; + return ; + end if ; + + if StartAddr > EndAddr then + -- Only support ascending addresses + Alert(AlertLogIDVar, "MemoryPType.FileWriteX: StartAddr: " & to_hstring(StartAddr) & + " > EndAddr: " & to_hstring(EndAddr), FAILURE) ; + return ; + end if ; + + -- Slice out upper address to form block address + if AddrWidthVar >= BlockkWidthVar then + StartBlockAddr := to_integer(normStartAddr(AddrWidthVar-1 downto BlockkWidthVar)) ; + EndBlockAddr := to_integer( normEndAddr(AddrWidthVar-1 downto BlockkWidthVar)) ; + else + StartBlockAddr := 0 ; + EndBlockAddr := 0 ; + end if ; + + BlockAddrLoop : for BlockAddr in StartBlockAddr to EndBlockAddr loop + next BlockAddrLoop when ArrayPtrVar(BlockAddr) = NULL ; + if BlockAddr = StartBlockAddr then + StartWordAddr := to_integer(normStartAddr(BlockkWidthVar-1 downto 0)) ; + else + StartWordAddr := 0 ; + end if ; + if BlockAddr = EndBlockAddr then + EndWordAddr := to_integer(normEndAddr(BlockkWidthVar-1 downto 0)) ; + else + EndWordAddr := 2**BlockkWidthVar-1 ; + end if ; + FoundData := FALSE ; + WordAddrLoop : for WordAddr in StartWordAddr to EndWordAddr loop + if (ArrayPtrVar(BlockAddr)(WordAddr) < 0) then + -- X in Word, return all X + Data := (Data'range => 'X') ; + FoundData := FALSE ; + else + -- Get the Word from the Array + Data := to_slv(ArrayPtrVar(BlockAddr)(WordAddr), Data'length) ; + if not FoundData then + -- Write Address + write(buf, '@') ; + hwrite(buf, to_slv(BlockAddr, AddrWidthVar-BlockkWidthVar) & to_slv(WordAddr, BlockkWidthVar)) ; + writeline(MemFile, buf) ; + end if ; + FoundData := TRUE ; + end if ; + if FoundData then -- Write Data + if DataFormat = HEX then + hwrite(buf, Data) ; + writeline(MemFile, buf) ; + else + write(buf, Data) ; + writeline(MemFile, buf) ; + end if; + end if ; + end loop WordAddrLoop ; + end loop BlockAddrLoop ; + file_close(MemFile) ; + end FileWriteX ; + + ------------------------------------------------------------ + procedure FileWriteH ( + -- Hexadecimal File Write + ------------------------------------------------------------ + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) is + begin + FileWriteX(FileName, HEX, StartAddr, EndAddr) ; + end FileWriteH ; + + ------------------------------------------------------------ + procedure FileWriteH (FileName : string ; StartAddr : std_logic_vector) is + -- Hexadecimal File Write + ------------------------------------------------------------ + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileWriteX(FileName, HEX, StartAddr, EndAddr) ; + end FileWriteH ; + + ------------------------------------------------------------ + procedure FileWriteH (FileName : string) is + -- Hexadecimal File Write + ------------------------------------------------------------ + constant StartAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '0') ; + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileWriteX(FileName, HEX, StartAddr, EndAddr) ; + end FileWriteH ; + + ------------------------------------------------------------ + procedure FileWriteB ( + -- Binary File Write + ------------------------------------------------------------ + FileName : string ; + StartAddr : std_logic_vector ; + EndAddr : std_logic_vector + ) is + begin + FileWriteX(FileName, BINARY, StartAddr, EndAddr) ; + end FileWriteB ; + + ------------------------------------------------------------ + procedure FileWriteB (FileName : string ; StartAddr : std_logic_vector) is + -- Binary File Write + ------------------------------------------------------------ + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileWriteX(FileName, BINARY, StartAddr, EndAddr) ; + end FileWriteB ; + + ------------------------------------------------------------ + procedure FileWriteB (FileName : string) is + -- Binary File Write + ------------------------------------------------------------ + constant StartAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '0') ; + constant EndAddr : std_logic_vector(AddrWidthVar - 1 downto 0) := (others => '1') ; + begin + FileWriteX(FileName, BINARY, StartAddr, EndAddr) ; + end FileWriteB ; + + end protected body MemoryPType ; + +end MemoryPkg ; \ No newline at end of file diff --git a/NamePkg.vhd b/NamePkg.vhd index 8addae2..44e4ec6 100644 --- a/NamePkg.vhd +++ b/NamePkg.vhd @@ -1,7 +1,7 @@ -- -- File Name: NamePkg.vhd -- Design Unit Name: NamePkg --- Revision: STANDARD VERSION, revision 2014.07 +-- Revision: STANDARD VERSION -- -- Maintainer: Jim Lewis email: jim@synthworks.com -- Contributor(s): @@ -26,9 +26,10 @@ -- 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 - 2014 by SynthWorks Design Inc. All rights reserved. +-- Copyright (c) 2010 - 2015 by SynthWorks Design Inc. All rights reserved. -- -- Verbatim copies of this source file may be used and -- distributed without restriction. @@ -54,7 +55,7 @@ package NamePkg is type NamePType is protected procedure Set (NameIn : String) ; - impure function Get return string ; + impure function Get (DefaultName : string := "") return string ; impure function GetOpt return string ; impure function IsSet return boolean ; procedure Clear ; -- clear name @@ -81,11 +82,11 @@ package body NamePkg is end procedure Set ; ------------------------------------------------------------ - impure function Get return string is + impure function Get (DefaultName : string := "") return string is ------------------------------------------------------------ begin if NamePtr = NULL then - return "" ; + return DefaultName ; else return NamePtr.all ; end if ; diff --git a/OsvvmContext.vhd b/OsvvmContext.vhd index ab3868b..a9ff243 100644 --- a/OsvvmContext.vhd +++ b/OsvvmContext.vhd @@ -17,9 +17,10 @@ -- Latest standard version available at: -- http://www.SynthWorks.com/downloads -- --- Revision History: For more details, see CoveragePkg_release_notes.pdf +-- Revision History: -- Date Version Description -- 01/2015 2015.01 Initial Revision +-- 06/2015 205.06 Added MemoryPkg -- -- -- Copyright (c) 2015 by SynthWorks Design Inc. All rights reserved. @@ -52,6 +53,7 @@ context OsvvmContext is use OSVVM.AlertLogPkg.all ; use OSVVM.RandomPkg.all ; use OSVVM.CoveragePkg.all ; + use OSVVM.MemoryPkg.all ; end context OsvvmContext ; diff --git a/OsvvmGlobalPkg.vhd b/OsvvmGlobalPkg.vhd index 562d99d..1d61e2b 100644 --- a/OsvvmGlobalPkg.vhd +++ b/OsvvmGlobalPkg.vhd @@ -55,6 +55,7 @@ package OsvvmGlobalPkg is -- 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" ; @@ -146,6 +147,16 @@ package body OsvvmGlobalPkg 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 ( diff --git a/README.md b/README.md index fe22de3..1da4c4d 100644 --- a/README.md +++ b/README.md @@ -11,6 +11,7 @@ This is an **unofficial** repository of "Open Source VHDL Verification Methodolo ## Release History + - 03.07.2015 - **2015.06** OSVVM VHDL sources, release notes, and User’s Guide for RandomPkg, CoveragePkg, AlertLogPkg, TranscriptPkg, MemoryPkg, and OsvvmGlobalPkg. - 23.03.2015 - **2015.03** OSVVM VHDL sources, release notes, and User’s Guide for RandomPkg, CoveragePkg, AlertLogPkg, TranscriptPkg, and OsvvmGlobalPkg. - 16.12.2014 - **2014.07a** OSVVM VHDL sources, CoveragePkg User’s Guide, RandomPkg User’s Guide, and release notes.1 - 22.01.2014 - **2014.01** Complete OS-VVM package containing VHDL sources and documentation. diff --git a/RandomBasePkg.vhd b/RandomBasePkg.vhd index 528f6c0..9dc00d8 100644 --- a/RandomBasePkg.vhd +++ b/RandomBasePkg.vhd @@ -1,7 +1,7 @@ -- -- File Name: RandomBasePkg.vhd -- Design Unit Name: RandomBasePkg --- Revision: STANDARD VERSION, revision 2015.01 +-- Revision: STANDARD VERSION -- -- Maintainer: Jim Lewis email: jim@synthworks.com -- Contributor(s): @@ -39,6 +39,7 @@ -- 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. @@ -84,9 +85,9 @@ package RandomBasePkg is -- Translate from integer_vector, integer, or string to RandomSeedType -- Required by RandomPkg.InitSeed -- GenRandSeed makes sure all values are in a valid range - function GenRandSeed(IV : integer_vector) return RandomSeedType ; - function GenRandSeed(I : integer) return RandomSeedType ; - function GenRandSeed(S : string) return RandomSeedType ; + 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. @@ -133,7 +134,7 @@ package body RandomBasePkg is -- if 2 seed values are passed to GenRandSeed and they are -- in the above range, then they must remain unmodified. -- - function GenRandSeed(IV : integer_vector) return RandomSeedType is + 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 ; @@ -163,7 +164,7 @@ package body RandomBasePkg is -- GenRandSeed -- transform a single integer into the internal seed -- - function GenRandSeed(I : integer) return RandomSeedType is + impure function GenRandSeed(I : integer) return RandomSeedType is variable result : integer_vector(1 to 2) ; begin result(1) := I ; @@ -177,7 +178,7 @@ package body RandomBasePkg is -- transform a string value into the internal seed -- usage: RV.GenRandSeed(RV'instance_path)); -- - function GenRandSeed(S : string) return RandomSeedType is + 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 ; diff --git a/RandomPkg.vhd b/RandomPkg.vhd index 9f4de18..84b82d4 100644 --- a/RandomPkg.vhd +++ b/RandomPkg.vhd @@ -1,7 +1,7 @@ -- -- File Name : RandomPkg.vhd -- Design Unit Name : RandomPkg --- Revision : STANDARD VERSION, revision 2015.01 +-- Revision : STANDARD VERSION -- -- Maintainer : Jim Lewis email : jim@synthworks.com -- Contributor(s) : @@ -44,6 +44,7 @@ -- 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, ...) ; -- -- Copyright (c) 2006 - 2015 by SynthWorks Design Inc. All rights reserved. -- @@ -331,18 +332,26 @@ package body RandomPkg is function Scale (A, Min, Max : real) return real is variable ValRange : Real ; begin - ValRange := Max - Min ; - return A * ValRange + Min ; + 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 - rMin := real(Min) - 0.5 ; - rMax := real(Max) + 0.5 ; - ValRange := rMax - rMin ; - return integer(round(A * ValRange + rMin)) ; + 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 @@ -474,7 +483,7 @@ package body RandomPkg is variable ReadValid : boolean ; begin read(L, A, ReadValid) ; - AlertIfNot( ReadValid, OSVVM_ALERTLOG_ID, "RandomPkg.read[line, RandomDistType] failed", FAILURE) ; + AlertIfNot( OSVVM_ALERTLOG_ID, ReadValid, "RandomPkg.read[line, RandomDistType] failed", FAILURE) ; end procedure read ; @@ -521,7 +530,7 @@ package body RandomPkg is variable ReadValid : boolean ; begin read(L, A, ReadValid) ; - AlertIfNot( ReadValid, OSVVM_ALERTLOG_ID, "RandomPkg.read[line, RandomParmType] failed", FAILURE) ; + AlertIfNot( OSVVM_ALERTLOG_ID, ReadValid, "RandomPkg.read[line, RandomParmType] failed", FAILURE) ; end procedure read ; @@ -618,7 +627,7 @@ package body RandomPkg is impure function Uniform (Min, Max : in real) return real is variable rRandomVal : real ; begin - AlertIf (Max < Min, OSVVM_ALERTLOG_ID, "RandomPkg.Uniform: Max < Min", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.Uniform: Max < Min", FAILURE) ; Uniform(rRandomVal, RandomSeed) ; return scale(rRandomVal, Min, Max) ; end function Uniform ; @@ -626,7 +635,7 @@ package body RandomPkg is impure function Uniform (Min, Max : integer) return integer is variable rRandomVal : real ; begin - AlertIf (Max < Min, OSVVM_ALERTLOG_ID, "RandomPkg.Uniform: Max < Min", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.Uniform: Max < Min", FAILURE) ; Uniform(rRandomVal, RandomSeed) ; return scale(rRandomVal, Min, Max) ; end function Uniform ; @@ -657,7 +666,7 @@ package body RandomPkg is impure function FavorSmall (Min, Max : real) return real is variable rRandomVal : real ; begin - AlertIf (Max < Min, OSVVM_ALERTLOG_ID, "RandomPkg.FavorSmall: Max < Min", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorSmall: Max < Min", FAILURE) ; Uniform(rRandomVal, RandomSeed) ; return scale(FavorSmall(rRandomVal), Min, Max) ; -- real end function FavorSmall ; @@ -665,7 +674,7 @@ package body RandomPkg is impure function FavorSmall (Min, Max : integer) return integer is variable rRandomVal : real ; begin - AlertIf (Max < Min, OSVVM_ALERTLOG_ID, "RandomPkg.FavorSmall: Max < Min", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorSmall: Max < Min", FAILURE) ; Uniform(rRandomVal, RandomSeed) ; return scale(FavorSmall(rRandomVal), Min, Max) ; -- integer end function FavorSmall ; @@ -696,7 +705,7 @@ package body RandomPkg is impure function FavorBig (Min, Max : real) return real is variable rRandomVal : real ; begin - AlertIf (Max < Min, OSVVM_ALERTLOG_ID, "RandomPkg.FavorBig: Max < Min", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorBig: Max < Min", FAILURE) ; Uniform(rRandomVal, RandomSeed) ; return scale(FavorBig(rRandomVal), Min, Max) ; -- real end function FavorBig ; @@ -704,7 +713,7 @@ package body RandomPkg is impure function FavorBig (Min, Max : integer) return integer is variable rRandomVal : real ; begin - AlertIf (Max < Min, OSVVM_ALERTLOG_ID, "RandomPkg.FavorBig: Max < Min", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < Min, "RandomPkg.FavorBig: Max < Min", FAILURE) ; Uniform(rRandomVal, RandomSeed) ; return scale(FavorBig(rRandomVal), Min, Max) ; -- integer end function FavorBig ; @@ -779,6 +788,7 @@ package body RandomPkg is begin if Max < Min then Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Normal: Max < Min", FAILURE) ; + return Mean ; else loop rRandomVal := Normal (Mean, StdDeviation) ; @@ -800,6 +810,7 @@ package body RandomPkg is 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) )) ; @@ -831,7 +842,7 @@ package body RandomPkg is -- 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 -1.0 ; + return Mean ; end if ; while (Product >= Bound) loop @@ -848,6 +859,7 @@ package body RandomPkg is begin if Max < Min then Alert(OSVVM_ALERTLOG_ID, "RandomPkg.Poisson: Max < Min", FAILURE) ; + return Mean ; else loop rRandomVal := Poisson (Mean) ; @@ -867,6 +879,7 @@ package body RandomPkg is 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) )) ; @@ -1542,7 +1555,7 @@ package body RandomPkg is impure function RandSigned (Max : signed) return signed is begin if max'length > 0 then - AlertIf (Max < 0, OSVVM_ALERTLOG_ID, "RandomPkg.RandSigned: Max < 0", FAILURE) ; + AlertIf (OSVVM_ALERTLOG_ID, Max < 0, "RandomPkg.RandSigned: Max < 0", FAILURE) ; return signed(RandUnsigned( unsigned(Max))) ; else return NULL_SV ; -- Null Array diff --git a/TextUtilPkg.vhd b/TextUtilPkg.vhd new file mode 100644 index 0000000..1b718dd --- /dev/null +++ b/TextUtilPkg.vhd @@ -0,0 +1,314 @@ +-- +-- 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 +-- +-- +-- 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 +-- + +use std.textio.all ; +library ieee ; +use ieee.std_logic_1164.all ; + +package TextUtilPkg is + ------------------------------------------------------------ + 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 + + ------------------------------------------------------------ + 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(1) = ' ' or L.all(1) = NBSP or L.all(1) = 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 Str : string(1 to 2) ; + begin + MultiLineComment := TRUE ; + Empty := TRUE ; + FindEndOfCommentLoop : while L /= null and L.all'length > 1 loop + if L.all(1) = '*' and L.all(2) = '/' then + read(L, Str, Valid) ; + Empty := FALSE ; + MultiLineComment := FALSE ; + exit FindEndOfCommentLoop ; + else + read(L, Str(1), Valid) ; -- remove one character and repeat + 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 Char : character ; + 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(1) = '#' ; -- shell style comment + + if L.all'length >= 2 then + exit when L.all(1 to 2) = "//" ; -- C style comment + exit when L.all(1 to 2) = "--" ; -- VHDL style comment + + if L.all(1 to 2) = "/*" 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(1) ; + 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(1) ; + 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/doc/AlertLogPkg_user_guide.pdf b/doc/AlertLogPkg_user_guide.pdf index 9a7c59f..6799043 100644 Binary files a/doc/AlertLogPkg_user_guide.pdf and b/doc/AlertLogPkg_user_guide.pdf differ diff --git a/doc/CoveragePkg_user_guide.pdf b/doc/CoveragePkg_user_guide.pdf index 384e4ce..3817497 100644 Binary files a/doc/CoveragePkg_user_guide.pdf and b/doc/CoveragePkg_user_guide.pdf differ diff --git a/doc/MemoryPkg_user_guide.pdf b/doc/MemoryPkg_user_guide.pdf new file mode 100644 index 0000000..aba18d8 Binary files /dev/null and b/doc/MemoryPkg_user_guide.pdf differ diff --git a/doc/RandomPkg_user_guide.pdf b/doc/RandomPkg_user_guide.pdf index 64a2f2e..dc76578 100644 Binary files a/doc/RandomPkg_user_guide.pdf and b/doc/RandomPkg_user_guide.pdf differ diff --git a/doc/TranscriptPkg_user_guide.pdf b/doc/TranscriptPkg_user_guide.pdf index 34049dd..cfd014a 100644 Binary files a/doc/TranscriptPkg_user_guide.pdf and b/doc/TranscriptPkg_user_guide.pdf differ diff --git a/doc/osvvm_release_notes.pdf b/doc/osvvm_release_notes.pdf index c96ac12..ce87dfc 100644 Binary files a/doc/osvvm_release_notes.pdf and b/doc/osvvm_release_notes.pdf differ