vhdl/translate: handle vhdl-93 'last_value. Fix #1440

6 files changed, 207 insertions, 75 deletions

diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb
index ea2caf189..5eaec4b32 100644
--- a/src/vhdl/translate/trans-chap14.adb
+++ b/src/vhdl/translate/trans-chap14.adb
@@ -16,6 +16,8 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
+with Flags;
+
 with Vhdl.Evaluation; use Vhdl.Evaluation;
 with Vhdl.Std_Package; use Vhdl.Std_Package;
 with Vhdl.Errors; use Vhdl.Errors;
@@ -477,26 +479,6 @@ package body Trans.Chap14 is
       return New_Selected_Element (New_Access_Element (S), Field);
    end Get_Signal_Field;
 
-   function Read_Last_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode
-   is
-   begin
-      return New_Value (Get_Signal_Value_Field
-                        (Sig, Sig_Type, Ghdl_Signal_Last_Value_Field));
-   end Read_Last_Value;
-
-   function Translate_Last_Value is new Chap7.Translate_Signal_Value
-     (Read_Value => Read_Last_Value);
-
-   function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode
-   is
-      Prefix      : constant Iir := Get_Prefix (Attr);
-      Prefix_Type : constant Iir := Get_Type (Prefix);
-      Name        : Mnode;
-   begin
-      Name := Chap6.Translate_Name (Prefix, Mode_Signal);
-      return Translate_Last_Value (M2E (Name), Prefix_Type);
-   end Translate_Last_Value_Attribute;
-
    function Read_Last_Time (Sig : O_Enode; Field : O_Fnode) return O_Enode
    is
       T : O_Lnode;
@@ -573,15 +555,15 @@ package body Trans.Chap14 is
                                               return O_Enode
    is
       Prefix_Type : constant Iir := Get_Type (Prefix);
+      Info        : constant Type_Info_Acc := Get_Info (Prefix_Type);
       Name        : Mnode;
-      Info        : Type_Info_Acc;
       Var         : O_Dnode;
       Data        : Last_Time_Data;
       Right_Bound : Int64;
       If_Blk      : O_If_Block;
    begin
       Name := Chap6.Translate_Name (Prefix, Mode_Signal);
-      Info := Get_Info (Prefix_Type);
+
       Var := Create_Temp (Std_Time_Otype);
 
       if Info.Type_Mode in Type_Mode_Scalar then
@@ -622,6 +604,150 @@ package body Trans.Chap14 is
       return New_Obj_Value (Var);
    end Translate_Last_Time_Attribute;
 
+   function Read_Last_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode is
+   begin
+      return New_Value (Get_Signal_Value_Field
+                        (Sig, Sig_Type, Ghdl_Signal_Last_Value_Field));
+   end Read_Last_Value;
+
+   function Translate_Last_Value_87 is new Chap7.Translate_Signal_Value
+     (Read_Value => Read_Last_Value);
+
+   type Last_Value_Data is record
+      Var_Time : O_Dnode;
+      Res : Mnode;
+   end record;
+
+   procedure Translate_Last_Value_93_Non_Composite
+     (Targ : Mnode; Targ_Type : Iir; Data : Last_Value_Data)
+   is
+      Tinfo   : constant Type_Info_Acc := Get_Info (Targ_Type);
+      If_Blk  : O_If_Block;
+      Targ1   : Mnode;
+      Val     : O_Enode;
+      Val_Ptr : O_Lnode;
+      Res     : O_Dnode;
+   begin
+      Open_Temp;
+      Targ1 := Stabilize (Targ, Can_Copy => True);
+      pragma Unreferenced (Targ);
+
+      Res := Create_Temp (Tinfo.Ortho_Type (Mode_Value));
+
+      Start_If_Stmt
+        (If_Blk,
+         New_Compare_Op (ON_Ge,
+                         Read_Last_Time (M2E (Targ1),
+                                         Ghdl_Signal_Last_Event_Field),
+                         New_Obj_Value (Data.Var_Time),
+                         Ghdl_Bool_Type));
+      New_Assign_Stmt (New_Obj (Res),
+                       Read_Last_Value (M2E (Targ1), Targ_Type));
+      New_Else_Stmt (If_Blk);
+      --  Read the pointer to the value.
+      Val_Ptr := Get_Signal_Field (Targ1, Ghdl_Signal_Value_Field);
+      Val := New_Value (Val_Ptr);
+      --  Convert the pointer to the correct pointer type.
+      Val := New_Convert (Val, Tinfo.Ortho_Ptr_Type (Mode_Value));
+      --  Read the current value
+      Val := New_Value (New_Access_Element (Val));
+      New_Assign_Stmt (New_Obj (Res), Val);
+      Finish_If_Stmt (If_Blk);
+      New_Assign_Stmt (M2Lv (Data.Res), New_Obj_Value (Res));
+
+      Close_Temp;
+   end Translate_Last_Value_93_Non_Composite;
+
+   function Last_Value_Prepare_Data_Composite
+     (Targ : Mnode; Targ_Type : Iir; Data : Last_Value_Data)
+         return Last_Value_Data
+   is
+      pragma Unreferenced (Targ, Targ_Type);
+      New_Res : Mnode;
+   begin
+      if Get_Type_Info (Data.Res).Type_Mode in Type_Mode_Unbounded then
+         New_Res := Stabilize (Chap3.Get_Composite_Base (Data.Res));
+      else
+         New_Res := Stabilize (Data.Res);
+      end if;
+      return (Var_Time => Data.Var_Time, Res => New_Res);
+   end Last_Value_Prepare_Data_Composite;
+
+   function Last_Value_Update_Data_Array (Data      : Last_Value_Data;
+                                          Targ_Type : Iir;
+                                          Index     : O_Dnode)
+                                         return Last_Value_Data is
+   begin
+      return (Var_Time => Data.Var_Time,
+              Res => Chap3.Index_Base (Data.Res, Targ_Type,
+                                       New_Obj_Value (Index)));
+   end Last_Value_Update_Data_Array;
+
+   function Last_Value_Update_Data_Record (Data      : Last_Value_Data;
+                                           Targ_Type : Iir;
+                                           El        : Iir_Element_Declaration)
+                                          return Last_Value_Data
+   is
+      pragma Unreferenced (Targ_Type);
+   begin
+      return (Var_Time => Data.Var_Time,
+              Res => Chap6.Translate_Selected_Element (Data.Res, El));
+   end Last_Value_Update_Data_Record;
+
+   procedure Translate_Last_Value_93 is new Foreach_Non_Composite
+     (Data_Type => Last_Value_Data,
+      Composite_Data_Type => Last_Value_Data,
+      Do_Non_Composite => Translate_Last_Value_93_Non_Composite,
+      Prepare_Data_Array => Last_Value_Prepare_Data_Composite,
+      Update_Data_Array => Last_Value_Update_Data_Array,
+      Prepare_Data_Record => Last_Value_Prepare_Data_Composite,
+      Update_Data_Record => Last_Value_Update_Data_Record);
+
+   function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode
+   is
+      use Flags;
+
+      Prefix      : constant Iir := Get_Prefix (Attr);
+      Prefix_Type : constant Iir := Get_Type (Prefix);
+      Info        : constant Type_Info_Acc := Get_Info (Prefix_Type);
+      Name        : Mnode;
+      Last        : O_Dnode;
+      Res         : Mnode;
+      Data_Time   : Last_Time_Data;
+      Data_Value  : Last_Value_Data;
+   begin
+      Name := Chap6.Translate_Name (Prefix, Mode_Signal);
+      if Info.Type_Mode in Type_Mode_Scalar then
+         --  Very simple for scalar: read the last value.
+         return Read_Last_Value (M2E (Name), Prefix_Type);
+      end if;
+
+      if Flags.Vhdl_Std = Vhdl_87 then
+         return M2E (Translate_Last_Value_87 (Name, Prefix_Type));
+      end if;
+
+      --  For composite: first compute the last_event.
+      Stabilize (Name);
+      Last := Create_Temp (Std_Time_Otype);
+      New_Assign_Stmt
+        (New_Obj (Last),
+         New_Lit (New_Signed_Literal (Std_Time_Otype, 0)));
+      Data_Time := Last_Time_Data'(Var => Last,
+                                   Field => Ghdl_Signal_Last_Event_Field);
+      Translate_Last_Time (Name, Prefix_Type, Data_Time);
+
+      --  Then for each scalar signal:
+      --  * read the last_value if the global last_event is before the
+      --    last_event of the signal
+      --  * read the current value if the global last_event is after the
+      --    last_event of the signal.
+      Res := Chap7.Allocate_Value_From_Signal (Name, Prefix_Type);
+      Data_Value := (Var_Time => Last, Res => Res);
+
+      Translate_Last_Value_93 (Name, Prefix_Type, Data_Value);
+      return M2Addr (Res);
+   end Translate_Last_Value_Attribute;
+
    --  Return TRUE if the scalar signal SIG is being driven.
    function Read_Driving_Attribute (Sig : O_Enode) return O_Enode
    is
@@ -754,7 +880,7 @@ package body Trans.Chap14 is
       Name        : Mnode;
    begin
       Name := Chap6.Translate_Name (Prefix, Mode_Signal);
-      return Translate_Driving_Value (M2E (Name), Get_Type (Prefix));
+      return M2E (Translate_Driving_Value (Name, Get_Type (Prefix)));
    end Translate_Driving_Value_Attribute;
 
    function Translate_Image_Attribute (Attr : Iir) return O_Enode
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 029acee48..2b5701cc6 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2813,6 +2813,7 @@ package body Trans.Chap4 is
       Constr      : O_Assoc_List;
       Subprg_Info : Subprg_Info_Acc;
       Res         : Mnode;
+      M1          : Mnode;
       Imp         : Iir;
       Func        : Iir;
       Obj         : Iir;  --  Method object for function conversion
@@ -2975,8 +2976,9 @@ package body Trans.Chap4 is
          when Conv_Mode_Out =>
             V1 := New_Selected_Acc_Value (New_Obj (Var_Data),
                                           Conv_Info.In_Sig_Field);
-            R := M2E (Lop2M (V1, In_Info, Mode_Signal));
-            R := Chap7.Translate_Signal_Driving_Value (R, In_Type);
+            M1 := Lop2M (V1, In_Info, Mode_Signal);
+            M1 := Chap7.Translate_Signal_Driving_Value (M1, In_Type);
+            R := M2E (M1);
       end case;
 
       case Get_Kind (Imp) is
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 63640a03d..7fbab514c 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -4089,8 +4089,33 @@ package body Trans.Chap7 is
       Prepare_Data_Record => Sig2val_Prepare_Composite,
       Update_Data_Record => Sig2val_Update_Data_Record);
 
-   function Translate_Signal_Value (Sig : O_Enode; Sig_Type : Iir)
-                                   return O_Enode
+   function Allocate_Value_From_Signal (Sig : Mnode; Sig_Type : Iir)
+                                       return Mnode
+   is
+      Tinfo : constant Type_Info_Acc := Get_Info (Sig_Type);
+      Res     : Mnode;
+   begin
+      if Tinfo.Type_Mode in Type_Mode_Unbounded then
+         Res := Create_Temp (Tinfo);
+
+         --  Copy bounds.
+         New_Assign_Stmt
+           (M2Lp (Chap3.Get_Composite_Bounds (Res)),
+            M2Addr (Chap3.Get_Composite_Bounds (Sig)));
+
+         --  Allocate base.
+         Chap3.Allocate_Unbounded_Composite_Base (Alloc_Stack, Res, Sig_Type);
+      elsif Is_Complex_Type (Tinfo) then
+         Res := Create_Temp (Tinfo);
+         Chap4.Allocate_Complex_Object (Sig_Type, Alloc_Stack, Res);
+      else
+         Res := Create_Temp (Tinfo);
+      end if;
+
+      return Res;
+   end Allocate_Value_From_Signal;
+
+   function Translate_Signal_Value (Sig : Mnode; Sig_Type : Iir) return Mnode
    is
       procedure Translate_Signal_Non_Composite
         (Targ      : Mnode;
@@ -4110,47 +4135,23 @@ package body Trans.Chap7 is
          Prepare_Data_Record => Sig2val_Prepare_Composite,
          Update_Data_Record => Sig2val_Update_Data_Record);
 
-      Tinfo : Type_Info_Acc;
+      Tinfo : constant Type_Info_Acc := Get_Info (Sig_Type);
+      Sig2 : Mnode;
+      Res : Mnode;
    begin
-      Tinfo := Get_Info (Sig_Type);
       if Tinfo.Type_Mode in Type_Mode_Scalar then
-         return Read_Value (Sig, Sig_Type);
+         return E2M (Read_Value (M2E (Sig), Sig_Type), Tinfo, Mode_Value);
       else
-         declare
-            Res     : Mnode;
-            Var_Val : Mnode;
-         begin
-            --  allocate result array
-            if Tinfo.Type_Mode in Type_Mode_Unbounded then
-               Res := Create_Temp (Tinfo);
+         Sig2 := Stabilize (Sig);
+         pragma Unreferenced (Sig);
 
-               Var_Val := Stabilize (E2M (Sig, Tinfo, Mode_Signal));
+         Res := Allocate_Value_From_Signal (Sig2, Sig_Type);
 
-               --  Copy bounds.
-               New_Assign_Stmt
-                 (M2Lp (Chap3.Get_Composite_Bounds (Res)),
-                  M2Addr (Chap3.Get_Composite_Bounds (Var_Val)));
-
-               --  Allocate base.
-               Chap3.Allocate_Unbounded_Composite_Base
-                 (Alloc_Stack, Res, Sig_Type);
-            elsif Is_Complex_Type (Tinfo) then
-               Res := Create_Temp (Tinfo);
-               Chap4.Allocate_Complex_Object (Sig_Type, Alloc_Stack, Res);
-            else
-               Res := Create_Temp (Tinfo);
-            end if;
-
-            Open_Temp;
-
-            if Tinfo.Type_Mode not in Type_Mode_Unbounded then
-               Var_Val := Stabilize (E2M (Sig, Tinfo, Mode_Signal));
-            end if;
+         Open_Temp;
+         Translate_Signal_Target (Res, Sig_Type, Sig2);
+         Close_Temp;
 
-            Translate_Signal_Target (Res, Sig_Type, Var_Val);
-            Close_Temp;
-            return M2Addr (Res);
-         end;
+         return Res;
       end if;
    end Translate_Signal_Value;
 
@@ -4165,7 +4166,7 @@ package body Trans.Chap7 is
      (Read_Value => Read_Signal_Driving_Value);
 
    function Translate_Signal_Driving_Value
-     (Sig : O_Enode; Sig_Type : Iir) return O_Enode
+     (Sig : Mnode; Sig_Type : Iir) return Mnode
          renames Translate_Signal_Driving_Value_1;
 
    procedure Set_Driving_Value
diff --git a/src/vhdl/translate/trans-chap7.ads b/src/vhdl/translate/trans-chap7.ads
index 5e52caebd..e4b316637 100644
--- a/src/vhdl/translate/trans-chap7.ads
+++ b/src/vhdl/translate/trans-chap7.ads
@@ -17,19 +17,22 @@
 --  02111-1307, USA.
 
 package Trans.Chap7 is
+   --  Allocate a value (with the same bounds) on the stack for SIG.
+   --  Note: SIG must be stable.
+   function Allocate_Value_From_Signal (Sig : Mnode; Sig_Type : Iir)
+                                       return Mnode;
+
    --  Generic function to extract a value from a signal.
    generic
       with function Read_Value (Sig : O_Enode; Sig_Type : Iir)
                                    return O_Enode;
-   function Translate_Signal_Value (Sig : O_Enode; Sig_Type : Iir)
-                                       return O_Enode;
+   function Translate_Signal_Value (Sig : Mnode; Sig_Type : Iir) return Mnode;
 
-   function Translate_Signal_Driving_Value (Sig : O_Enode; Sig_Type : Iir)
-                                               return O_Enode;
+   function Translate_Signal_Driving_Value (Sig : Mnode; Sig_Type : Iir)
+                                           return Mnode;
 
    --  For conversions.
-   procedure Set_Driving_Value
-     (Sig : Mnode; Sig_Type : Iir; Val : Mnode);
+   procedure Set_Driving_Value (Sig : Mnode; Sig_Type : Iir; Val : Mnode);
 
    --  Translate expression EXPR into ortho tree.
    function Translate_Expression (Expr : Iir; Rtype : Iir := Null_Iir)
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 345081b43..8ba63234d 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -4377,11 +4377,11 @@ package body Trans.Chap8 is
       --   with weird resolution functions.
       New_Assign_Stmt
         (New_Obj (Cond),
-         New_Compare_Op (ON_Neq,
-           Chap7.Translate_Signal_Driving_Value
-             (M2E (Targ_Sig), Targ_Type),
-           M2E (Drv),
-           Ghdl_Bool_Type));
+         New_Compare_Op
+           (ON_Neq,
+            M2E (Chap7.Translate_Signal_Driving_Value (Targ_Sig, Targ_Type)),
+            M2E (Drv),
+            Ghdl_Bool_Type));
       Finish_If_Stmt (If_Blk);
 
       --  Put signal into active list (if not already in the list).
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index f36867e57..e1ee8a3f7 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -126,11 +126,11 @@ package Trans is
    --  Signals.
    Ghdl_Scalar_Bytes               : O_Tnode;
    Ghdl_Signal_Type                : O_Tnode;
-   Ghdl_Signal_Value_Field         : O_Fnode;
    Ghdl_Signal_Driving_Value_Field : O_Fnode;
    Ghdl_Signal_Last_Value_Field    : O_Fnode;
    Ghdl_Signal_Last_Event_Field    : O_Fnode;
    Ghdl_Signal_Last_Active_Field   : O_Fnode;
+   Ghdl_Signal_Value_Field         : O_Fnode;
    Ghdl_Signal_Event_Field         : O_Fnode;
    Ghdl_Signal_Active_Field        : O_Fnode;
    Ghdl_Signal_Has_Active_Field    : O_Fnode;