Browse Source

add version 2.1 of OSVVM library; using osvvm randompkg to randomize stimuli in SpiT tests

pull/1/head
T. Meissner 10 years ago
parent
commit
592893ab2b
5 changed files with 1718 additions and 16 deletions
  1. +9
    -5
      test/Makefile
  2. +32
    -11
      test/SpiT.vhd
  3. +224
    -0
      test/osvvm_2.1/RandomBasePkg.vhd
  4. +1078
    -0
      test/osvvm_2.1/RandomPkg.vhd
  5. +375
    -0
      test/osvvm_2.1/SortListPkg_int.vhd

+ 9
- 5
test/Makefile View File

@ -3,12 +3,16 @@ SYN_SRC = ../syn
VHD_STD = 02 VHD_STD = 02
.PHONY: sim .PHONY: sim
sim: vhdl2008 queuet simt spit
sim: vhdl2008 osvvm queuet simt spit
.PHONY: vhdl2008 .PHONY: vhdl2008
vhdl2008 : env_c.vhd numeric_std_additions.vhd numeric_std_unsigned_c.vhd standard_additions_c.vhd standard_textio_additions_c.vhd std_logic_1164_additions.vhd vhdl2008 : env_c.vhd numeric_std_additions.vhd numeric_std_unsigned_c.vhd standard_additions_c.vhd standard_textio_additions_c.vhd std_logic_1164_additions.vhd
ghdl -a --std=$(VHD_STD) --work=ieee_proposed standard_additions_c.vhd standard_textio_additions_c.vhd std_logic_1164_additions.vhd numeric_std_additions.vhd numeric_std_unsigned_c.vhd env_c.vhd ghdl -a --std=$(VHD_STD) --work=ieee_proposed standard_additions_c.vhd standard_textio_additions_c.vhd std_logic_1164_additions.vhd numeric_std_additions.vhd numeric_std_unsigned_c.vhd env_c.vhd
.PHONY: osvvm
osvvm : vhdl2008 osvvm_2.1/SortListPkg_int.vhd osvvm_2.1/RandomBasePkg.vhd osvvm_2.1/RandomPkg.vhd
ghdl -a --std=$(VHD_STD) --work=osvvm --ieee=synopsys osvvm_2.1/SortListPkg_int.vhd osvvm_2.1/RandomBasePkg.vhd osvvm_2.1/RandomPkg.vhd
queuet : QueueT.vhd $(SIM_SRC)/QueueP.vhd $(SIM_SRC)/AssertP.vhd queuet : QueueT.vhd $(SIM_SRC)/QueueP.vhd $(SIM_SRC)/AssertP.vhd
ghdl -a --std=$(VHD_STD) --work=libvhdl $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/QueueP.vhd ghdl -a --std=$(VHD_STD) --work=libvhdl $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/QueueP.vhd
ghdl -a --std=$(VHD_STD) QueueT.vhd ghdl -a --std=$(VHD_STD) QueueT.vhd
@ -21,11 +25,11 @@ simt : vhdl2008 SimT.vhd $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/SimP.vhd
ghdl -e --std=$(VHD_STD) SimT ghdl -e --std=$(VHD_STD) SimT
ghdl -r --std=$(VHD_STD) SimT ghdl -r --std=$(VHD_STD) SimT
spit : vhdl2008 SpiT.vhd $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/SimP.vhd $(SYN_SRC)/SpiSlaveE.vhd $(SYN_SRC)/SpiMasterE.vhd
ghdl -a --std=$(VHD_STD) --work=libvhdl $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/SimP.vhd
spit : vhdl2008 osvvm SpiT.vhd $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/SimP.vhd $(SIM_SRC)/QueueP.vhd $(SYN_SRC)/SpiSlaveE.vhd $(SYN_SRC)/SpiMasterE.vhd
ghdl -a --std=$(VHD_STD) --work=libvhdl $(SIM_SRC)/AssertP.vhd $(SIM_SRC)/SimP.vhd $(SIM_SRC)/QueueP.vhd
ghdl -a --std=$(VHD_STD) -fpsl $(SYN_SRC)/SpiSlaveE.vhd $(SYN_SRC)/SpiMasterE.vhd ghdl -a --std=$(VHD_STD) -fpsl $(SYN_SRC)/SpiSlaveE.vhd $(SYN_SRC)/SpiMasterE.vhd
ghdl -a --std=$(VHD_STD) -fpsl SpiT.vhd
ghdl -e --std=$(VHD_STD) SpiT
ghdl -a --std=$(VHD_STD) --ieee=synopsys -fpsl SpiT.vhd
ghdl -e --std=$(VHD_STD) --ieee=synopsys SpiT
ghdl -r --std=$(VHD_STD) SpiT --wave=spit.ghw ghdl -r --std=$(VHD_STD) SpiT --wave=spit.ghw
.PHONY: clean .PHONY: clean


+ 32
- 11
test/SpiT.vhd View File

@ -2,16 +2,22 @@ library ieee;
use ieee.std_logic_1164.all; use ieee.std_logic_1164.all;
use ieee.numeric_std.all; use ieee.numeric_std.all;
library libvhdl;
use libvhdl.AssertP.all;
use libvhdl.SimP.all;
--+ including vhdl 2008 libraries --+ including vhdl 2008 libraries
--+ These lines can be commented out when using
--+ a simulator with built-in VHDL 2008 support
library ieee_proposed; library ieee_proposed;
use ieee_proposed.standard_additions.all; use ieee_proposed.standard_additions.all;
use ieee_proposed.std_logic_1164_additions.all; use ieee_proposed.std_logic_1164_additions.all;
use ieee_proposed.numeric_std_additions.all; use ieee_proposed.numeric_std_additions.all;
library osvvm;
use osvvm.RandomPkg.all;
library libvhdl;
use libvhdl.AssertP.all;
use libvhdl.SimP.all;
use libvhdl.QueueP.all;
entity SpiT is entity SpiT is
@ -117,18 +123,24 @@ begin
signal s_dout_valid : std_logic; signal s_dout_valid : std_logic;
signal s_dout_accept : std_logic; signal s_dout_accept : std_logic;
shared variable sv_mosi_queue : t_list_queue;
shared variable sv_miso_queue : t_list_queue;
begin begin
SpiMasterStimP : process is SpiMasterStimP : process is
variable v_random : RandomPType;
begin begin
v_random.InitSeed(v_random'instance_name);
wait until s_reset_n = '1'; wait until s_reset_n = '1';
for i in 0 to integer'(2**C_DATA_WIDTH-1) loop for i in 0 to integer'(2**C_DATA_WIDTH-1) loop
s_din <= std_logic_vector(to_unsigned(i, C_DATA_WIDTH));
s_din <= v_random.RandSlv(C_DATA_WIDTH);
s_din_valid <= '1'; s_din_valid <= '1';
wait until rising_edge(s_clk) and s_din_accept = '1'; wait until rising_edge(s_clk) and s_din_accept = '1';
s_din_valid <= '0'; s_din_valid <= '0';
sv_mosi_queue.push(s_din);
wait until rising_edge(s_clk); wait until rising_edge(s_clk);
end loop; end loop;
wait; wait;
@ -162,12 +174,14 @@ begin
SpiMasterCheckP : process is SpiMasterCheckP : process is
variable v_queue_data : std_logic_vector(C_DATA_WIDTH-1 downto 0) := (others => '0');
begin begin
wait until s_reset_n = '1'; wait until s_reset_n = '1';
for i in 0 to integer'(2**C_DATA_WIDTH-1) loop for i in 0 to integer'(2**C_DATA_WIDTH-1) loop
wait until rising_edge(s_clk) and s_dout_valid = '1'; wait until rising_edge(s_clk) and s_dout_valid = '1';
s_dout_accept <= '1'; s_dout_accept <= '1';
assert_equal(s_dout, std_logic_vector(to_unsigned(i, C_DATA_WIDTH)));
sv_miso_queue.pop(v_queue_data);
assert_equal(s_dout, v_queue_data);
wait until rising_edge(s_clk); wait until rising_edge(s_clk);
s_dout_accept <= '0'; s_dout_accept <= '0';
end loop; end loop;
@ -180,11 +194,18 @@ begin
-- Unit test of spi slave procedure, checks all combinations -- Unit test of spi slave procedure, checks all combinations
-- of cpol & cpha against spi master procedure -- of cpol & cpha against spi master procedure
SpiSlaveP : process is SpiSlaveP : process is
variable v_master_data : std_logic_vector(7 downto 0) := (others => '0');
variable v_send_data : std_logic_vector(C_DATA_WIDTH-1 downto 0) := (others => '0');
variable v_receive_data : std_logic_vector(C_DATA_WIDTH-1 downto 0) := (others => '0');
variable v_queue_data : std_logic_vector(C_DATA_WIDTH-1 downto 0) := (others => '0');
variable v_random : RandomPType;
begin begin
v_random.InitSeed(v_random'instance_name);
wait until s_reset_n = '1';
for i in 0 to integer'(2**C_DATA_WIDTH-1) loop for i in 0 to integer'(2**C_DATA_WIDTH-1) loop
spi_slave (data_in => v_master_data,
data_out => v_master_data,
v_send_data := v_random.RandSlv(C_DATA_WIDTH);
sv_miso_queue.push(v_send_data);
spi_slave (data_in => v_send_data,
data_out => v_receive_data,
sclk => s_sclk, sclk => s_sclk,
ste => s_ste, ste => s_ste,
mosi => s_mosi, mosi => s_mosi,
@ -192,8 +213,8 @@ begin
cpol => mode / 2, cpol => mode / 2,
cpha => mode mod 2 cpha => mode mod 2
); );
assert_equal(v_master_data, std_logic_vector(to_unsigned(i, C_DATA_WIDTH)));
v_master_data := std_logic_vector(unsigned(v_master_data) + 1);
sv_mosi_queue.pop(v_queue_data);
assert_equal(v_receive_data, v_queue_data);
end loop; end loop;
wait; wait;
end process SpiSlaveP; end process SpiSlaveP;


+ 224
- 0
test/osvvm_2.1/RandomBasePkg.vhd View File

@ -0,0 +1,224 @@
--
-- File Name: RandomBasePkg.vhd
-- Design Unit Name: RandomBasePkg
-- Revision: STANDARD VERSION, revision 2.0, VHDL-2008
--
-- Maintainer: Jim Lewis email: jim@synthworks.com
-- Contributor(s):
-- Jim Lewis jim@synthworks.com
--
--
-- Description:
-- Defines Base randomization, seed definition, seed generation,
-- and seed IO functionality for RandomPkg.vhd
-- Defines:
-- Procedure Uniform - baseline randomization
-- Type RandomSeedType - the seed as a single object
-- function GenRandSeed from integer_vector, integer, or string
-- IO function to_string, & procedures write, read
--
-- In revision 2.0 these types and functions are included by package reference.
-- Long term these will be passed as generics to RandomGenericPkg
--
--
-- Developed for:
-- SynthWorks Design Inc.
-- VHDL Training Classes
-- 11898 SW 128th Ave. Tigard, Or 97223
-- http://www.SynthWorks.com
--
-- Revision History:
-- Date Version Description
-- 01/2008: 0.1 Initial revision
-- Numerous revisions for VHDL Testbenches and Verification
-- 02/2009: 1.0 First Public Released Version
-- 02/25/2009 1.1 Replaced reference to std_2008 with a reference
-- to ieee_proposed.standard_additions.all ;
-- 03/01/2011 2.0 STANDARD VERSION
-- Fixed abstraction by moving RandomParmType to RandomPkg.vhd
--
--
-- Copyright (c) 2008, 2009, 2010, 2011 by SynthWorks Design Inc. All rights reserved.
--
-- Verbatim copies of this source file may be used and
-- distributed without restriction.
--
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the ARTISTIC License
-- as published by The Perl Foundation; either version 2.0 of
-- the License, or (at your option) any later version.
--
-- This source is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-- PURPOSE. See the Artistic License for details.
--
-- You should have received a copy of the license with this source.
-- If not download it from,
-- http://www.perlfoundation.org/artistic_license_2_0
--
library ieee ;
use ieee.math_real.all ;
use std.textio.all ;
-- comment out following 2 lines with VHDL-2008. Leave in for VHDL-2002
library ieee_proposed ; -- remove with VHDL-2008
use ieee_proposed.standard_additions.all ; -- remove with VHDL-2008
package RandomBasePkg is
-- RandomSeedType and Uniform can be replaced by any procedure that
-- produces a uniform distribution with 0 <= Value < 1 or 0 < Value < 1
-- and maintains the same call interface
type RandomSeedType is array (1 to 2) of integer ;
procedure Uniform (Result : out real ; Seed : inout RandomSeedType) ;
-- Translate from integer_vector, integer, or string to RandomSeedType
-- Required by RandomPkg.InitSeed
-- GenRandSeed makes sure all values are in a valid range
function GenRandSeed(IV : integer_vector) return RandomSeedType ;
function GenRandSeed(I : integer) return RandomSeedType ;
function GenRandSeed(S : string) return RandomSeedType ;
-- IO for RandomSeedType. If use subtype, then create aliases here
-- in a similar fashion VHDL-2008 std_logic_textio.
-- Not required by RandomPkg
function to_string(A : RandomSeedType) return string ;
procedure write(variable L: inout line ; A : RandomSeedType ) ;
procedure read (variable L: inout line ; A : out RandomSeedType ; good : out boolean ) ;
procedure read (variable L: inout line ; A : out RandomSeedType ) ;
end RandomBasePkg ;
-----------------------------------------------------------------
-----------------------------------------------------------------
package body RandomBasePkg is
-----------------------------------------------------------------
-- Uniform
-- Generate a random number with a Uniform distribution
-- Required by RandomPkg. All randomization is derived from here.
-- Value produced must be either:
-- 0 <= Value < 1 or 0 < Value < 1
--
-- Current version uses ieee.math_real.Uniform
-- This abstraction allows higher precision version
-- of a uniform distribution to be used provided
--
procedure Uniform (
Result : out real ;
Seed : inout RandomSeedType
) is
begin
ieee.math_real.Uniform (Seed(Seed'left), Seed(Seed'right), Result) ;
end procedure Uniform ;
-----------------------------------------------------------------
-- GenRandSeed
-- Convert integer_vector to RandomSeedType
-- Uniform requires two seed values of the form:
-- 1 <= SEED1 <= 2147483562; 1 <= SEED2 <= 2147483398
--
-- if 2 seed values are passed to GenRandSeed and they are
-- in the above range, then they must remain unmodified.
--
function GenRandSeed(IV : integer_vector) return RandomSeedType is
alias iIV : integer_vector(1 to IV'length) is IV ;
variable Seed1 : integer ;
variable Seed2 : integer ;
constant SEED1_MAX : integer := 2147483562 ;
constant SEED2_MAX : integer := 2147483398 ;
begin
if iIV'Length <= 0 then -- no seed
report "%%FATAL: GenRandSeed received NULL integer_vector" severity failure ;
return (3, 17) ; -- if continue seed = (3, 17)
elsif iIV'Length = 1 then -- one seed value
-- inefficient handling, but condition is unlikely
return GenRandSeed(iIV(1)) ; -- generate a seed
else -- only use the left two values
-- 1 <= SEED1 <= 2147483562
-- mod returns 0 to MAX-1, the -1 adjusts legal values, +1 adjusts them back
Seed1 := ((iIV(1)-1) mod SEED1_MAX) + 1 ;
-- 1 <= SEED2 <= 2147483398
Seed2 := ((iIV(2)-1) mod SEED2_MAX) + 1 ;
return (Seed1, Seed2) ;
end if ;
end function GenRandSeed ;
-----------------------------------------------------------------
-- GenRandSeed
-- transform a single integer into the internal seed
--
function GenRandSeed(I : integer) return RandomSeedType is
variable result : integer_vector(1 to 2) ;
begin
result(1) := I ;
result(2) := I/3 + 1 ;
return GenRandSeed(result) ; -- make value ranges legal
end function GenRandSeed ;
-----------------------------------------------------------------
-- GenRandSeed
-- transform a string value into the internal seed
-- usage: RV.GenRandSeed(RV'instance_path));
--
function GenRandSeed(S : string) return RandomSeedType is
constant LEN : integer := S'length ;
constant HALF_LEN : integer := LEN/2 ;
alias revS : string(LEN downto 1) is S ;
variable result : integer_vector(1 to 2) ;
variable temp : integer := 0 ;
begin
for i in 1 to HALF_LEN loop
temp := (temp + character'pos(revS(i))) mod (integer'right - 2**8) ;
end loop ;
result(1) := temp ;
for i in HALF_LEN + 1 to LEN loop
temp := (temp + character'pos(revS(i))) mod (integer'right - 2**8) ;
end loop ;
result(2) := temp ;
return GenRandSeed(result) ; -- make value ranges legal
end function GenRandSeed ;
-----------------------------------------------------------------
function to_string(A : RandomSeedType) return string is
begin
return to_string(A(A'left)) & " " & to_string(A(A'right)) ;
end function to_string ;
-----------------------------------------------------------------
procedure write(variable L: inout line ; A : RandomSeedType ) is
begin
write(L, to_string(A)) ;
end procedure ;
-----------------------------------------------------------------
procedure read(variable L: inout line ; A : out RandomSeedType ; good : out boolean ) is
variable iGood : boolean ;
begin
for i in A'range loop
read(L, A(i), iGood) ;
exit when not iGood ;
end loop ;
good := iGood ;
end procedure read ;
-----------------------------------------------------------------
procedure read(variable L: inout line ; A : out RandomSeedType ) is
variable good : boolean ;
begin
read(L, A, good) ;
assert good report "read[line, RandomSeedType] failed" severity error ;
end procedure read ;
end RandomBasePkg ;

+ 1078
- 0
test/osvvm_2.1/RandomPkg.vhd
File diff suppressed because it is too large
View File


+ 375
- 0
test/osvvm_2.1/SortListPkg_int.vhd View File

@ -0,0 +1,375 @@
--
-- File Name: SortListPkg_int.vhd
-- Design Unit Name: SortListPkg_int
-- Revision: STANDARD VERSION, revision 2.1
--
-- Maintainer: Jim Lewis email: jim@synthworks.com
-- Contributor(s):
-- Jim Lewis jim@synthworks.com
--
-- Description:
-- Sorting utility for array of scalars
-- Uses protected type so as to shrink and expand the data structure
--
-- Developed for:
-- SynthWorks Design Inc.
-- VHDL Training Classes
-- 11898 SW 128th Ave. Tigard, Or 97223
-- http://www.SynthWorks.com
--
-- Revision History:
-- Date Version Description
-- 06/2008: 0.1 Initial revision
-- Numerous revisions for VHDL Testbenches and Verification
-- 02/2009: 1.0 First Public Released Version
-- 02/25/2009 1.1 Replaced reference to std_2008 with a reference to
-- ieee_proposed.standard_additions.all ;
-- 06/16/2010 1.2 Added EraseList parameter to to_array
-- 3/2011 2.0 added inside as non protected type
-- 6/2011 2.1 added sort as non protected type
--
--
-- Copyright (c) 2008, 2009, 2011 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.std_logic_textio.all ;
-- comment out following 2 lines with VHDL-2008. Leave in for VHDL-2002
library ieee_proposed ; -- remove with VHDL-2008
use ieee_proposed.standard_additions.all ; -- remove with VHDL-2008
--use ieee_proposed.standard_textio_additions.all;
package SortListPkg_int is
-- with VHDL-2008, convert package to generic package
-- convert subtypes ElementType and ArrayofElementType to generics
-- package SortListGenericPkg is
subtype ElementType is integer ;
subtype ArrayofElementType is integer_vector ;
function inside (constant E : ElementType; constant A : in ArrayofElementType) return boolean ;
impure function sort (constant A : in ArrayofElementType) return ArrayofElementType ;
type SortListPType is protected
procedure add ( constant A : in ElementType ) ;
procedure add ( constant A : in ArrayofElementType ) ;
procedure add ( constant A : in ArrayofElementType ; Min, Max : integer ) ;
procedure add ( variable A : inout SortListPType ) ;
-- Count items in list
impure function count return integer ;
impure function find_index ( constant A : ElementType) return integer ;
impure function inside (constant A : ElementType) return boolean ;
procedure insert ( constant A : in ElementType; constant index : in integer := 1 ) ;
impure function get ( constant index : in integer := 1 ) return ElementType ;
procedure erase ;
impure function Empty return boolean ;
procedure print ;
procedure remove ( constant A : in ElementType ) ;
procedure remove ( constant A : in ArrayofElementType ) ;
procedure remove ( variable A : inout SortListPType ) ;
impure function to_array (constant EraseList : boolean := FALSE) return ArrayofElementType ;
end protected SortListPType ;
end SortListPkg_int ;
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
package body SortListPkg_int is
function inside (constant E : ElementType; constant A : in ArrayofElementType) return boolean is
begin
for i in A'range loop
if E = A(i) then
return TRUE ;
end if ;
end loop ;
return FALSE ;
end function inside ;
type SortListPType is protected body
type ListType ;
type ListPointerType is access ListType ;
type ListType is record
A : ElementType ;
-- item_num : integer ;
NextPtr : ListPointerType ;
-- PrevPtr : ListPointerType ;
end record ;
variable HeadPointer : ListPointerType := NULL ;
-- variable TailPointer : ListPointerType := NULL ;
procedure add ( constant A : in ElementType ) is
variable CurPtr, tempPtr : ListPointerType ;
begin
if HeadPointer = NULL then
HeadPointer := new ListType'(A, NULL) ;
elsif A = HeadPointer.A then -- ignore duplicates
return ;
elsif A < HeadPointer.A then
tempPtr := HeadPointer ;
HeadPointer := new ListType'(A, tempPtr) ;
else
CurPtr := HeadPointer ;
loop
exit when CurPtr.NextPtr = NULL ;
exit when A < CurPtr.NextPtr.A ;
if A = CurPtr.NextPtr.A then return ; end if; -- exit
CurPtr := CurPtr.NextPtr ;
end loop ;
tempPtr := CurPtr.NextPtr ;
CurPtr.NextPtr := new ListType'(A, tempPtr) ;
end if ;
end procedure add ;
procedure add ( constant A : in ArrayofElementType ) is
begin
for i in A'range loop
add(A(i)) ;
end loop ;
end procedure add ;
procedure add ( constant A : in ArrayofElementType ; Min, Max : integer ) is
begin
for i in A'range loop
if A(i) >= Min and A(i) <= Max then
add(A(i)) ;
end if ;
end loop ;
end procedure add ;
procedure add ( variable A : inout SortListPType ) is
begin
for i in 1 to A.Count loop
add(A.Get(i)) ;
end loop ;
end procedure add ;
-- Count items in list
impure function count return integer is
variable result : positive := 1 ;
variable CurPtr : ListPointerType ;
begin
if HeadPointer = NULL then
return 0 ;
else
CurPtr := HeadPointer ;
loop
exit when CurPtr.NextPtr = NULL ;
result := result + 1 ;
CurPtr := CurPtr.NextPtr ;
end loop ;
return result ;
end if ;
end function count ;
impure function find_index (constant A : ElementType) return integer is
variable result : positive := 2 ;
variable CurPtr : ListPointerType ;
begin
if HeadPointer = NULL then
return 0 ;
elsif A <= HeadPointer.A then
return 1 ;
else
CurPtr := HeadPointer ;
loop
exit when CurPtr.NextPtr = NULL ;
exit when A <= CurPtr.NextPtr.A ;
result := result + 1 ;
CurPtr := CurPtr.NextPtr ;
end loop ;
return result ;
end if ;
end function find_index ;
impure function inside (constant A : ElementType) return boolean is
variable CurPtr : ListPointerType ;
begin
if HeadPointer = NULL then
return FALSE ;
end if ;
if A = HeadPointer.A then
return TRUE ;
else
CurPtr := HeadPointer ;
loop
exit when CurPtr.NextPtr = NULL ;
exit when A < CurPtr.NextPtr.A ;
if A = CurPtr.NextPtr.A then
return TRUE ; -- exit
end if;
CurPtr := CurPtr.NextPtr ;
end loop ;
end if ;
return FALSE ;
end function inside ;
procedure insert( constant A : in ElementType; constant index : in integer := 1 ) is
variable CurPtr, tempPtr : ListPointerType ;
begin
if index <= 1 then
tempPtr := HeadPointer ;
HeadPointer := new ListType'(A, tempPtr) ;
else
CurPtr := HeadPointer ;
for i in 3 to index loop
exit when CurPtr.NextPtr = NULL ; -- end of list
CurPtr := CurPtr.NextPtr ;
end loop ;
tempPtr := CurPtr.NextPtr ;
CurPtr.NextPtr := new ListType'(A, tempPtr) ;
end if;
end procedure insert ;
impure function get ( constant index : in integer := 1 ) return ElementType is
variable CurPtr : ListPointerType ;
begin
if index > Count then
report "%%FAILURE: SortListPType index out of range" severity failure ;
return ElementType'left ;
elsif HeadPointer = NULL then
return ElementType'left ;
elsif index <= 1 then
return HeadPointer.A ;
else
CurPtr := HeadPointer ;
for i in 2 to index loop
CurPtr := CurPtr.NextPtr ;
end loop ;
return CurPtr.A ;
end if;
end function get ;
procedure erase (variable CurPtr : inout ListPointerType ) is
begin
if CurPtr.NextPtr /= NULL then
erase (CurPtr.NextPtr) ;
end if ;
deallocate (CurPtr) ;
end procedure erase ;
procedure erase is
begin
if HeadPointer /= NULL then
erase(HeadPointer) ;
-- deallocate (HeadPointer) ;
HeadPointer := NULL ;
end if;
end procedure erase ;
impure function Empty return boolean is
begin
return HeadPointer = NULL ;
end Empty ;
procedure print is
variable buf : line ;
variable CurPtr : ListPointerType ;
begin
if HeadPointer = NULL then
write (buf, string'("( )")) ;
else
CurPtr := HeadPointer ;
write (buf, string'("(")) ;
loop
write (buf, CurPtr.A) ;
exit when CurPtr.NextPtr = NULL ;
write (buf, string'(", ")) ;
CurPtr := CurPtr.NextPtr ;
end loop ;
write (buf, string'(")")) ;
end if ;
writeline(OUTPUT, buf) ;
end procedure print ;
procedure remove ( constant A : in ElementType ) is
variable CurPtr, tempPtr : ListPointerType ;
begin
if HeadPointer = NULL then
return ;
elsif A = HeadPointer.A then
tempPtr := HeadPointer ;
HeadPointer := HeadPointer.NextPtr ;
deallocate (tempPtr) ;
else
CurPtr := HeadPointer ;
loop
exit when CurPtr.NextPtr = NULL ;
if A = CurPtr.NextPtr.A then
tempPtr := CurPtr.NextPtr ;
CurPtr.NextPtr := CurPtr.NextPtr.NextPtr ;
deallocate (tempPtr) ;
exit ;
end if ;
exit when A < CurPtr.NextPtr.A ;
CurPtr := CurPtr.NextPtr ;
end loop ;
end if ;
end procedure remove ;
procedure remove ( constant A : in ArrayofElementType ) is
begin
for i in A'range loop
remove(A(i)) ;
end loop ;
end procedure remove ;
procedure remove ( variable A : inout SortListPType ) is
variable item : natural ;
begin
for i in 1 to A.Count loop
remove(A.Get(i)) ;
end loop ;
end procedure remove ;
impure function to_array (constant EraseList : boolean := FALSE) return ArrayofElementType is
variable result : ArrayofElementType(1 to Count) ;
begin
for i in 1 to Count loop
result(i) := Get(i) ;
end loop ;
if EraseList then
erase ;
end if ;
return result ;
end function to_array ;
end protected body SortListPType ;
impure function sort (constant A : in ArrayofElementType) return ArrayofElementType is
variable Result : SortListPType ;
begin
Result.Add(A) ;
return Result.to_array(EraseList => TRUE) ;
end function sort ;
end SortListPkg_int ;

Loading…
Cancel
Save