fix: do not overload 'length', use a custom enumerate type instead

Author: umarcor

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,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;
@@ -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,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;