Skip to content

Commit

Permalink
fix: do not overload 'length', use a custom enumerate type instead
Browse files Browse the repository at this point in the history
  • Loading branch information
@umarcor
umarcor committed Jun 11, 2019
1 parent 98393fd commit 43e7f86
Show file tree
Hide file tree
Showing 3 changed files with 131 additions and 123 deletions.
125 changes: 64 additions & 61 deletions vunit/vhdl/data_types/src/string_ptr_pkg-body-200x.vhd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -121,26 +122,38 @@ 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);
st.ptr := st.ptr + 1;
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;
Expand All @@ -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
Expand All @@ -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 (
Expand All @@ -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 (
Expand All @@ -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 (
Expand All @@ -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 (
Expand All @@ -252,34 +253,36 @@ 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 (
ref : natural
) 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;
Expand Down
Loading

0 comments on commit 43e7f86

Please sign in to comment.