From be60f84674d0141a2eea3dd5d21cc780cbb93aa2 Mon Sep 17 00:00:00 2001 From: umarcor Date: Tue, 11 Jun 2019 21:55:25 +0200 Subject: [PATCH] fix: do not overload 'length', use a custom enumerate type instead --- .../src/string_ptr_pkg-body-200x.vhd | 125 ++++++++--------- .../data_types/src/string_ptr_pkg-body-93.vhd | 127 +++++++++--------- vunit/vhdl/data_types/src/string_ptr_pkg.vhd | 2 + 3 files changed, 131 insertions(+), 123 deletions(-) diff --git a/vunit/vhdl/data_types/src/string_ptr_pkg-body-200x.vhd b/vunit/vhdl/data_types/src/string_ptr_pkg-body-200x.vhd index 538cf0fc6..fe57a180a 100644 --- a/vunit/vhdl/data_types/src/string_ptr_pkg-body-200x.vhd +++ b/vunit/vhdl/data_types/src/string_ptr_pkg-body-200x.vhd @@ -55,9 +55,10 @@ package body string_ptr_pkg is type string_ptr_storage_t is protected body type storage_t is record id : integer; - length : integer; -- 0: default/internal; >0: external through access; <0: external through funcs + mode : storage_mode_t; + length : integer; end record; - constant null_storage : storage_t := (integer'low, integer'low); + constant null_storage : storage_t := (integer'low, internal, integer'low); type storage_vector_t is array (natural range <>) of storage_t; type storage_vector_access_t is access storage_vector_t; @@ -121,12 +122,16 @@ package body string_ptr_pkg is impure function new_vector ( length : natural := 0; - id : integer := 0; + id : integer := 0; -- 0: default/internal; >0: external through access; <0: external through funcs value : val_t := val_t'low ) return natural is begin reallocate_ids(st.ids, st.id); if id = 0 then - st.ids(st.id) := (id => st.ptr, length => 0); + st.ids(st.id) := ( + id => st.ptr, + mode => internal, + length => 0 + ); reallocate_ptrs(st.ptrs, st.ptr); st.ptrs(st.ptr) := new vec_t'(1 to length => value); @@ -134,13 +139,21 @@ package body string_ptr_pkg is else assert length>0 report "Length of external memory cannot be 0" severity error; if id > 0 then - st.ids(st.id) := (id => st.eptr, length => length); + st.ids(st.id) := ( + id => st.eptr, + mode => extacc, + length => length + ); reallocate_eptrs(st.eptrs, st.eptr); st.eptrs(st.eptr) := get_ptr(id-1); st.eptr := st.eptr + 1; else - st.ids(st.id) := (id => -id-1, length => -length); + st.ids(st.id) := ( + id => -id-1, + mode => extfunc, + length => length + ); end if; end if; st.id := st.id + 1; @@ -150,7 +163,7 @@ package body string_ptr_pkg is impure function is_external ( ref : natural ) return boolean is begin - return st.ids(ref).length /= 0; + return st.ids(ref).mode /= internal; end; -- @TODO Remove check_external when all the functions/procedures are implemented @@ -177,11 +190,10 @@ package body string_ptr_pkg is ) return integer is variable s : storage_t := st.ids(ref); begin - if s.length /= 0 then - return abs(s.length); - else - return st.ptrs(s.id)'length; - end if; + case s.mode is + when internal => return st.ptrs(s.id)'length; + when others => return abs(s.length); + end case; end; procedure set ( @@ -191,16 +203,11 @@ package body string_ptr_pkg is ) is variable s : storage_t := st.ids(ref); begin - --report "set(" & to_string(s.id) & ", " & to_string(index) & ") length(" & to_string(s.length) & "): " & to_string(value) severity note; - if s.length /= 0 then --is_external - if s.length < 0 then - write_char(s.id, index-1, value); - else - st.eptrs(s.id)(index) := value; - end if; - else - st.ptrs(s.id)(index) := value; - end if; + case s.mode is + when extfunc => write_char(s.id, index-1, value); + when extacc => st.eptrs(s.id)(index) := value; + when internal => st.ptrs(s.id)(index) := value; + end case; end; impure function get ( @@ -209,16 +216,11 @@ package body string_ptr_pkg is ) return val_t is variable s : storage_t := st.ids(ref); begin - --report "get(" & to_string(s.id) & ", " & to_string(index) & ") length(" & to_string(s.length) & ")" severity note; - if s.length /= 0 then --is_external - if s.length < 0 then - return read_char(s.id, index-1); - else - return st.eptrs(s.id)(index); - end if; - else - return st.ptrs(s.id)(index); - end if; + case s.mode is + when extfunc => return read_char(s.id, index-1); + when extacc => return st.eptrs(s.id)(index); + when internal => return st.ptrs(s.id)(index); + end case; end; procedure reallocate ( @@ -228,18 +230,17 @@ package body string_ptr_pkg is variable s : storage_t := st.ids(ref); variable n_value : string(1 to value'length) := value; begin - if s.length /= 0 then --is_external - if s.length < 0 then + case s.mode is + when extfunc => -- @FIXME The reallocation request is just ignored. What should we do here? --check_external(ptr, "reallocate"); - else + when extacc => -- @TODO Implement reallocate for external models (through access) check_external(ref, "reallocate"); - end if; - else - deallocate(st.ptrs(s.id)); - st.ptrs(s.id) := new vec_t'(n_value); - end if; + when internal => + deallocate(st.ptrs(s.id)); + st.ptrs(s.id) := new vec_t'(n_value); + end case; end; procedure resize ( @@ -252,21 +253,22 @@ package body string_ptr_pkg is variable min_len : natural := length; variable s : storage_t := st.ids(ref); begin - if s.length /= 0 then - -- @TODO Implement resize for external models - check_external(ref, "resize"); - else - newp := new vec_t'(1 to length => value); - oldp := st.ptrs(s.id); - if min_len > oldp'length - drop then - min_len := oldp'length - drop; - end if; - for i in 1 to min_len loop - newp(i) := oldp(drop + i); - end loop; - st.ptrs(s.id) := newp; - deallocate(oldp); - end if; + case s.mode is + when internal => + newp := new vec_t'(1 to length => value); + oldp := st.ptrs(s.id); + if min_len > oldp'length - drop then + min_len := oldp'length - drop; + end if; + for i in 1 to min_len loop + newp(i) := oldp(drop + i); + end loop; + st.ptrs(s.id) := newp; + deallocate(oldp); + when others => + -- @TODO Implement resize for external models + check_external(ref, "resize"); + end case; end; impure function to_string ( @@ -274,12 +276,13 @@ package body string_ptr_pkg is ) return string is variable s : storage_t := st.ids(ref); begin - if s.length /= 0 then - -- @TODO Implement to_string for external models - check_external(ref, "to_string"); - else - return st.ptrs(s.id).all; - end if; + case s.mode is + when internal => + return st.ptrs(s.id).all; + when others => + -- @TODO Implement to_string for external models + check_external(ref, "to_string"); + end case; end; end protected body; diff --git a/vunit/vhdl/data_types/src/string_ptr_pkg-body-93.vhd b/vunit/vhdl/data_types/src/string_ptr_pkg-body-93.vhd index 48893511b..4b7be47e4 100644 --- a/vunit/vhdl/data_types/src/string_ptr_pkg-body-93.vhd +++ b/vunit/vhdl/data_types/src/string_ptr_pkg-body-93.vhd @@ -7,9 +7,10 @@ package body string_ptr_pkg is type storage_t is record id : integer; - length : integer; -- 0: default/internal; >0: external through access; <0: external through funcs + mode : storage_mode_t; + length : integer; end record; - constant null_storage : storage_t := (integer'low, integer'low); + constant null_storage : storage_t := (integer'low, internal, integer'low); type storage_vector_t is array (natural range <>) of storage_t; type storage_vector_access_t is access storage_vector_t; @@ -73,12 +74,16 @@ package body string_ptr_pkg is impure function new_string_ptr ( length : natural := 0; - id : integer := 0; + id : integer := 0; -- 0: default/internal; >0: external through access; <0: external through funcs value : val_t := val_t'low ) return ptr_t is begin reallocate_ids(st.ids, st.id); if id = 0 then - st.ids(st.id) := (id => st.ptr, length => 0); + st.ids(st.id) := ( + id => st.ptr, + mode => internal, + length => 0 + ); reallocate_ptrs(st.ptrs, st.ptr); st.ptrs(st.ptr) := new vec_t'(1 to length => value); @@ -86,13 +91,21 @@ package body string_ptr_pkg is else assert length>0 report "Length of external memory cannot be 0" severity error; if id > 0 then - st.ids(st.id) := (id => st.eptr, length => length); + st.ids(st.id) := ( + id => st.eptr, + mode => extacc, + length => length + ); reallocate_eptrs(st.eptrs, st.eptr); st.eptrs(st.eptr) := get_ptr(id-1); st.eptr := st.eptr + 1; else - st.ids(st.id) := (id => -id-1, length => -length); + st.ids(st.id) := ( + id => -id-1, + mode => extfunc, + length => length + ); end if; end if; st.id := st.id + 1; @@ -127,7 +140,7 @@ package body string_ptr_pkg is impure function is_external ( ptr : ptr_t ) return boolean is begin - return st.ids(ptr.ref).length /= 0; + return st.ids(ptr.ref).mode /= internal; end; -- @TODO Remove check_external when all the functions/procedures are implemented @@ -154,11 +167,10 @@ package body string_ptr_pkg is ) return integer is variable s : storage_t := st.ids(ptr.ref); begin - if s.length /= 0 then - return abs(s.length); - else - return st.ptrs(s.id)'length; - end if; + case s.mode is + when internal => return st.ptrs(s.id)'length; + when others => return abs(s.length); + end case; end; procedure set ( @@ -168,16 +180,11 @@ package body string_ptr_pkg is ) is variable s : storage_t := st.ids(ptr.ref); begin - --report "set(" & to_string(s.id) & ", " & to_string(index) & ") length(" & to_string(s.length) & "): " & to_string(value) severity note; - if s.length /= 0 then --is_external - if s.length < 0 then - write_char(s.id, index-1, value); - else - st.eptrs(s.id)(index) := value; - end if; - else - st.ptrs(s.id)(index) := value; - end if; + case s.mode is + when extfunc => write_char(s.id, index-1, value); + when extacc => st.eptrs(s.id)(index) := value; + when internal => st.ptrs(s.id)(index) := value; + end case; end; procedure set ( @@ -194,16 +201,11 @@ package body string_ptr_pkg is ) return val_t is variable s : storage_t := st.ids(ptr.ref); begin - --report "get(" & to_string(s.id) & ", " & to_string(index) & ") length(" & to_string(s.length) & ")" severity note; - if s.length /= 0 then --is_external - if s.length < 0 then - return read_char(s.id, index-1); - else - return st.eptrs(s.id)(index); - end if; - else - return st.ptrs(s.id)(index); - end if; + case s.mode is + when extfunc => return read_char(s.id, index-1); + when extacc => return st.eptrs(s.id)(index); + when internal => return st.ptrs(s.id)(index); + end case; end; impure function get ( @@ -220,18 +222,17 @@ package body string_ptr_pkg is variable s : storage_t := st.ids(ptr.ref); variable n_value : string(1 to value'length) := value; begin - if s.length /= 0 then --is_external - if s.length < 0 then + case s.mode is + when extfunc => -- @FIXME The reallocation request is just ignored. What should we do here? --check_external(ptr, "reallocate"); - else + when extacc => -- @TODO Implement reallocate for external models (through access) check_external(ptr, "reallocate"); - end if; - else - deallocate(st.ptrs(s.id)); - st.ptrs(s.id) := new vec_t'(n_value); - end if; + when internal => + deallocate(st.ptrs(s.id)); + st.ptrs(s.id) := new vec_t'(n_value); + end case; end; procedure reallocate ( @@ -262,21 +263,22 @@ package body string_ptr_pkg is variable min_len : natural := length; variable s : storage_t := st.ids(ptr.ref); begin - if s.length /= 0 then - -- @TODO Implement resize for external models - check_external(ptr, "resize"); - else - newp := new vec_t'(1 to length => value); - oldp := st.ptrs(s.id); - if min_len > oldp'length - drop then - min_len := oldp'length - drop; - end if; - for i in 1 to min_len loop - newp(i) := oldp(drop + i); - end loop; - st.ptrs(s.id) := newp; - deallocate(oldp); - end if; + case s.mode is + when internal => + newp := new vec_t'(1 to length => value); + oldp := st.ptrs(s.id); + if min_len > oldp'length - drop then + min_len := oldp'length - drop; + end if; + for i in 1 to min_len loop + newp(i) := oldp(drop + i); + end loop; + st.ptrs(s.id) := newp; + deallocate(oldp); + when others => + -- @TODO Implement resize for external models + check_external(ptr, "resize"); + end case; end; procedure resize ( @@ -293,12 +295,13 @@ package body string_ptr_pkg is ) return string is variable s : storage_t := st.ids(ptr.ref); begin - if s.length /= 0 then - -- @TODO Implement to_string for external models - check_external(ptr, "to_string"); - else - return st.ptrs(s.id).all; - end if; + case s.mode is + when internal => + return st.ptrs(s.id).all; + when others => + -- @TODO Implement to_string for external models + check_external(ptr, "to_string"); + end case; end; function to_integer ( @@ -310,7 +313,7 @@ package body string_ptr_pkg is impure function to_string_ptr ( value : integer ) return ptr_t is begin - -- @TODO maybe assert that the index is valid + -- @TODO maybe assert that the ref is valid return (ref => value); end; diff --git a/vunit/vhdl/data_types/src/string_ptr_pkg.vhd b/vunit/vhdl/data_types/src/string_ptr_pkg.vhd index f879e8704..858085b0c 100644 --- a/vunit/vhdl/data_types/src/string_ptr_pkg.vhd +++ b/vunit/vhdl/data_types/src/string_ptr_pkg.vhd @@ -18,6 +18,8 @@ use work.codec_builder_pkg.all; package string_ptr_pkg is + type storage_mode_t is (internal, extfunc, extacc); + subtype index_t is integer range -1 to integer'high; type string_ptr_t is record