rpms/ghdl/F-12 ghdl-svn133.patch, NONE, 1.1 ghdl.spec, 1.57, 1.58 ghdl-svn131.patch, 1.1, NONE grt-dispmemleak.patch, 1.1, NONE grt-processtimeoutchain.patch, 1.1, NONE

sailer sailer at fedoraproject.org
Tue Dec 29 23:59:49 UTC 2009


Author: sailer

Update of /cvs/extras/rpms/ghdl/F-12
In directory cvs1.fedora.phx.redhat.com:/tmp/cvs-serv18864

Modified Files:
	ghdl.spec 
Added Files:
	ghdl-svn133.patch 
Removed Files:
	ghdl-svn131.patch grt-dispmemleak.patch 
	grt-processtimeoutchain.patch 
Log Message:
update to svn133, tentative fix for ./tb --stats crash


ghdl-svn133.patch:
 errorout.adb           |    6 
 ghdldrv/ghdllocal.adb  |    2 
 grt/grt-processes.adb  |  448 ++++++++++++++++++++++++++++++-------------------
 grt/grt-processes.ads  |   31 +--
 grt/grt-rtis_utils.adb |    1 
 grt/grt-signals.adb    |   31 +--
 grt/grt-signals.ads    |   33 ++-
 grt/grt-types.ads      |    4 
 grt/grt-unithread.adb  |    9 
 grt/grt-unithread.ads  |    6 
 ortho-lang.c           |    2 
 version.ads            |    4 
 12 files changed, 346 insertions(+), 231 deletions(-)

--- NEW FILE ghdl-svn133.patch ---
diff -urN ghdl-0.28/vhdl/errorout.adb ghdl-0.29dev/vhdl/errorout.adb
--- ghdl-0.28/vhdl/errorout.adb	2008-09-27 03:27:50.000000000 +0200
+++ ghdl-0.29dev/vhdl/errorout.adb	2009-12-16 14:31:15.000000000 +0100
@@ -893,8 +893,12 @@
       procedure Append_Type (Def : Iir)
       is
          use Name_Table;
+         Decl : Iir := Get_Type_Declarator (Def);
       begin
-         Image (Get_Identifier (Get_Type_Declarator (Def)));
+         if Decl = Null_Iir then
+            Decl := Get_Type_Declarator (Get_Base_Type (Def));
+         end if;
+         Image (Get_Identifier (Decl));
          Append (Res, Name_Buffer (1 .. Name_Length));
       end Append_Type;
 
diff -urN ghdl-0.28/vhdl/ghdldrv/ghdllocal.adb ghdl-0.29dev/vhdl/ghdldrv/ghdllocal.adb
--- ghdl-0.28/vhdl/ghdldrv/ghdllocal.adb	2009-08-13 06:21:29.000000000 +0200
+++ ghdl-0.29dev/vhdl/ghdldrv/ghdllocal.adb	2009-12-16 14:31:12.000000000 +0100
@@ -223,7 +223,7 @@
       if Prefix_Path = null then
          Prefix_Path := new String'(Default_Pathes.Prefix);
       else
-         -- assume the user has set the correct path, so do not insert 32
+         -- Assume the user has set the correct path, so do not insert 32.
          Flag_32bit := False;
       end if;
 
diff -urN ghdl-0.28/vhdl/grt/grt-processes.adb ghdl-0.29dev/vhdl/grt/grt-processes.adb
--- ghdl-0.28/vhdl/grt/grt-processes.adb	2008-08-29 01:40:50.000000000 +0200
+++ ghdl-0.29dev/vhdl/grt/grt-processes.adb	2009-12-16 14:31:13.000000000 +0100
@@ -36,27 +36,30 @@
 package body Grt.Processes is
    Last_Time : constant Std_Time := Std_Time'Last;
 
+   --  Identifier for a process.
+   type Process_Id is new Integer;
+
    --  Table of processes.
    package Process_Table is new Grt.Table
-     (Table_Component_Type => Process_Type,
+     (Table_Component_Type => Process_Acc,
       Table_Index_Type => Process_Id,
       Table_Low_Bound => 1,
       Table_Initial => 16);
 
    --  List of non_sensitized processes.
    package Non_Sensitized_Process_Table is new Grt.Table
-     (Table_Component_Type => Process_Id,
+     (Table_Component_Type => Process_Acc,
       Table_Index_Type => Natural,
       Table_Low_Bound => 1,
       Table_Initial => 2);
 
    --  List of processes to be resume at next cycle.
-   type Process_Id_Array is array (Natural range <>) of Process_Id;
-   type Process_Id_Array_Acc is access Process_Id_Array;
+   type Process_Acc_Array is array (Natural range <>) of Process_Acc;
+   type Process_Acc_Array_Acc is access Process_Acc_Array;
 
-   Resume_Process_Table : Process_Id_Array_Acc;
+   Resume_Process_Table : Process_Acc_Array_Acc;
    Last_Resume_Process : Natural := 0;
-   Postponed_Resume_Process_Table : Process_Id_Array_Acc;
+   Postponed_Resume_Process_Table : Process_Acc_Array_Acc;
    Last_Postponed_Resume_Process : Natural := 0;
 
    --  Number of postponed processes.
@@ -66,8 +69,9 @@
    --  Number of resumed processes.
    Nbr_Resumed_Processes : Natural := 0;
 
-   procedure Free is new Ada.Unchecked_Deallocation
-     (Name => Sensitivity_Acc, Object => Sensitivity_El);
+   --  Earliest time out within non-sensitized processes.
+   Process_First_Timeout : Std_Time := Last_Time;
+   Process_Timeout_Chain : Process_Acc := null;
 
    procedure Init is
    begin
@@ -105,6 +109,7 @@
       function To_Proc_Acc is new Ada.Unchecked_Conversion
         (Source => System.Address, Target => Proc_Acc);
       Stack : Stack_Type;
+      P : Process_Acc;
    begin
       if State /= State_Sensitized then
          Stack := Stack_Create (Proc, This);
@@ -114,22 +119,22 @@
       else
          Stack := Null_Stack;
       end if;
-      Process_Table.Increment_Last;
-      Process_Table.Table (Process_Table.Last) :=
-        (Subprg => To_Proc_Acc (Proc),
-         This => This,
-         Rti => Ctxt,
-         Sensitivity => null,
-         Resumed => False,
-         Postponed => Postponed,
-         State => State,
-         Timeout => Bad_Time,
-         Stack => Stack);
+      P := new Process_Type'(Subprg => To_Proc_Acc (Proc),
+                             This => This,
+                             Rti => Ctxt,
+                             Sensitivity => null,
+                             Resumed => False,
+                             Postponed => Postponed,
+                             State => State,
+                             Timeout => Bad_Time,
+                             Timeout_Chain_Next => null,
+                             Timeout_Chain_Prev => null,
+                             Stack => Stack);
+      Process_Table.Append (P);
       --  Used to create drivers.
-      Set_Current_Process (Process_Table.Last, null);
-
+      Set_Current_Process (P);
       if State /= State_Sensitized then
-         Non_Sensitized_Process_Table.Append (Process_Table.Last);
+         Non_Sensitized_Process_Table.Append (P);
       end if;
       if Postponed then
          Nbr_Postponed_Processes := Nbr_Postponed_Processes + 1;
@@ -145,7 +150,7 @@
       Addr : System.Address)
    is
    begin
-      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, False);
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Ready, False);
    end Ghdl_Process_Register;
 
    procedure Ghdl_Sensitized_Process_Register
@@ -165,7 +170,7 @@
       Addr : System.Address)
    is
    begin
-      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, True);
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Ready, True);
    end Ghdl_Postponed_Process_Register;
 
    procedure Ghdl_Postponed_Sensitized_Process_Register
@@ -184,20 +189,22 @@
    is
       function To_Proc_Acc is new Ada.Unchecked_Conversion
         (Source => System.Address, Target => Proc_Acc);
+      P : Process_Acc;
    begin
-      Process_Table.Increment_Last;
-      Process_Table.Table (Process_Table.Last) :=
-        (Rti => Ctxt,
-         Sensitivity => null,
-         Resumed => False,
-         Postponed => False,
-         State => State_Sensitized,
-         Timeout => Bad_Time,
-         Subprg => To_Proc_Acc (Proc),
-         This => This,
-         Stack => Null_Stack);
+      P := new Process_Type'(Rti => Ctxt,
+                             Sensitivity => null,
+                             Resumed => False,
+                             Postponed => False,
+                             State => State_Sensitized,
+                             Timeout => Bad_Time,
+                             Timeout_Chain_Next => null,
+                             Timeout_Chain_Prev => null,
+                             Subprg => To_Proc_Acc (Proc),
+                             This => This,
+                             Stack => Null_Stack);
+      Process_Table.Append (P);
       --  Used to create drivers.
-      Set_Current_Process (Process_Table.Last, null);
+      Set_Current_Process (P);
    end Verilog_Process_Register;
 
    procedure Ghdl_Initial_Register (Instance : System.Address;
@@ -217,16 +224,16 @@
    procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
    is
    begin
-      Resume_Process_If_Event (Sig, Process_Table.Last);
+      Resume_Process_If_Event
+        (Sig, Process_Table.Table (Process_Table.Last));
    end Ghdl_Process_Add_Sensitivity;
 
-   procedure Resume_Process (Proc : Process_Id)
+   procedure Resume_Process (Proc : Process_Acc)
    is
-      P : Process_Type renames Process_Table.Table (Proc);
    begin
-      if not P.Resumed then
-         P.Resumed := True;
-         if P.Postponed then
+      if not Proc.Resumed then
+         Proc.Resumed := True;
+         if Proc.Postponed then
             Last_Postponed_Resume_Process := Last_Postponed_Resume_Process + 1;
             Postponed_Resume_Process_Table (Last_Postponed_Resume_Process)
               := Proc;
@@ -260,26 +267,66 @@
       Grt.Stack2.Release (Get_Stack2, Mark);
    end Ghdl_Stack2_Release;
 
-   function To_Acc is new Ada.Unchecked_Conversion
-     (Source => System.Address, Target => Process_Acc);
-
    procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
    is
-      El : Sensitivity_Acc;
+      Proc : constant Process_Acc := Get_Current_Process;
+      El : Action_List_Acc;
    begin
-      El := new Sensitivity_El'(Sig => Sig,
-                                Next => Get_Current_Process.Sensitivity);
-      Get_Current_Process.Sensitivity := El;
+      El := new Action_List'(Dynamic => True,
+                             Next => Sig.Event_List,
+                             Proc => Proc,
+                             Prev => null,
+                             Sig => Sig,
+                             Chain => Proc.Sensitivity);
+      if Sig.Event_List /= null and then Sig.Event_List.Dynamic then
+         Sig.Event_List.Prev := El;
+      end if;
+      Sig.Event_List := El;
+      Proc.Sensitivity := El;
    end Ghdl_Process_Wait_Add_Sensitivity;
 
+   procedure Update_Process_First_Timeout (Proc : Process_Acc) is
+   begin
+      if Proc.Timeout < Process_First_Timeout then
+         Process_First_Timeout := Proc.Timeout;
+      end if;
+      Proc.Timeout_Chain_Next := Process_Timeout_Chain;
+      Proc.Timeout_Chain_Prev := null;
+      if Process_Timeout_Chain /= null then
+         Process_Timeout_Chain.Timeout_Chain_Prev := Proc;
+      end if;
+      Process_Timeout_Chain := Proc;
+   end Update_Process_First_Timeout;
+
+   procedure Remove_Process_From_Timeout_Chain (Proc : Process_Acc) is
+   begin
+      --  Remove Proc from the timeout list.
+      if Proc.Timeout_Chain_Prev /= null then
+         Proc.Timeout_Chain_Prev.Timeout_Chain_Next :=
+           Proc.Timeout_Chain_Next;
+         --  Be sure a second call won't corrupt the chain.
+         Proc.Timeout_Chain_Prev := null;
+      elsif Process_Timeout_Chain = Proc then
+         --  Only if Proc is in the chain.
+         Process_Timeout_Chain := Proc.Timeout_Chain_Next;
+      end if;
+      if Proc.Timeout_Chain_Next /= null then
+         Proc.Timeout_Chain_Next.Timeout_Chain_Prev :=
+           Proc.Timeout_Chain_Prev;
+         Proc.Timeout_Chain_Next := null;
+      end if;
+   end Remove_Process_From_Timeout_Chain;
+
    procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
       if Time < 0 then
          --  LRM93 8.1
          Error ("negative timeout clause");
       end if;
-      Get_Current_Process.Timeout := Current_Time + Time;
+      Proc.Timeout := Current_Time + Time;
+      Update_Process_First_Timeout (Proc);
    end Ghdl_Process_Wait_Set_Timeout;
 
    function Ghdl_Process_Wait_Suspend return Boolean
@@ -295,27 +342,75 @@
 --          Cur_Proc.Timeout := Std_Time'Last;
 --       end if;
       Stack_Switch (Get_Main_Stack, Proc.Stack);
-      -- Note: in case of timeout, the timeout is removed when processis is
+      -- Note: in case of timeout, the timeout is removed when process is
       -- woken up.
       return Proc.State = State_Timeout;
    end Ghdl_Process_Wait_Suspend;
 
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Action_List, Action_List_Acc);
+
    procedure Ghdl_Process_Wait_Close
    is
       Proc : constant Process_Acc := Get_Current_Process;
-      El : Sensitivity_Acc;
-      N_El : Sensitivity_Acc;
+      El : Action_List_Acc;
+      N_El : Action_List_Acc;
    begin
       --  Remove the sensitivity.
       El := Proc.Sensitivity;
       Proc.Sensitivity := null;
       while El /= null loop
-         N_El := El.Next;
+         pragma Assert (El.Proc = Get_Current_Process);
+         if El.Prev = null then
+            El.Sig.Event_List := El.Next;
+         else
+            pragma Assert (El.Prev.Dynamic);
+            El.Prev.Next := El.Next;
+         end if;
+         if El.Next /= null and then El.Next.Dynamic then
+            El.Next.Prev := El.Prev;
+         end if;
+         N_El := El.Chain;
          Free (El);
          El := N_El;
       end loop;
-      --  Remove the timeout.
-      Proc.Timeout := Bad_Time;
+
+      --  Remove Proc from the timeout list.
+      Remove_Process_From_Timeout_Chain (Proc);
+
+      --  This is necessary when the process has been woken-up by an event
+      --  before the timeout triggers.
+      if Process_First_Timeout = Proc.Timeout then
+         --  Remove the timeout.
+         Proc.Timeout := Bad_Time;
+
+         declare
+            Next_Timeout : Std_Time;
+            P : Process_Acc;
+         begin
+            Next_Timeout := Last_Time;
+            P := Process_Timeout_Chain;
+            while P /= null loop
+               case P.State is
+                  when State_Delayed
+                    | State_Wait =>
+                     if P.Timeout > 0
+                       and then P.Timeout < Next_Timeout
+                     then
+                        Next_Timeout := P.Timeout;
+                     end if;
+                  when others =>
+                     null;
+               end case;
+               P := P.Timeout_Chain_Next;
+            end loop;
+            Process_First_Timeout := Next_Timeout;
+         end;
+      else
+         --  Remove the timeout.
+         Proc.Timeout := Bad_Time;
+      end if;
+      Proc.State := State_Ready;
    end Ghdl_Process_Wait_Close;
 
    procedure Ghdl_Process_Wait_Exit
@@ -345,8 +440,13 @@
       end if;
       Proc.Timeout := Current_Time + Time;
       Proc.State := State_Wait;
+      Update_Process_First_Timeout (Proc);
       --  Suspend this process.
       Stack_Switch (Get_Main_Stack, Proc.Stack);
+      --  Clean-up.
+      Proc.Timeout := Bad_Time;
+      Remove_Process_From_Timeout_Chain (Proc);
+      Proc.State := State_Ready;
    end Ghdl_Process_Wait_Timeout;
 
    --  Verilog.
@@ -356,6 +456,7 @@
    begin
       Proc.Timeout := Current_Time + Std_Time (Del);
       Proc.State := State_Delayed;
+      Update_Process_First_Timeout (Proc);
    end Ghdl_Process_Delay;
 
    --  Protected object lock.
@@ -364,7 +465,7 @@
    type Object_Lock is record
       --  The owner of the lock.
       --  Nul_Process_Id means the lock is free.
-      Process : Process_Id;
+      Process : Process_Acc;
       --  Number of times the lock has been acquired.
       Count : Natural;
    end record;
@@ -379,14 +480,14 @@
    is
       Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
    begin
-      if Lock.Process = Nul_Process_Id then
+      if Lock.Process = null then
          if Lock.Count /= 0 then
             Internal_Error ("protected_enter");
          end if;
-         Lock.Process := Get_Current_Process_Id;
+         Lock.Process := Get_Current_Process;
          Lock.Count := 1;
       else
-         if Lock.Process /= Get_Current_Process_Id then
+         if Lock.Process /= Get_Current_Process then
             Internal_Error ("protected_enter(2)");
          end if;
          Lock.Count := Lock.Count + 1;
@@ -397,7 +498,7 @@
    is
       Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
    begin
-      if Lock.Process /= Get_Current_Process_Id then
+      if Lock.Process /= Get_Current_Process then
          Internal_Error ("protected_leave(1)");
       end if;
 
@@ -406,7 +507,7 @@
       end if;
       Lock.Count := Lock.Count - 1;
       if Lock.Count = 0 then
-         Lock.Process := Nul_Process_Id;
+         Lock.Process := null;
       end if;
    end Ghdl_Protected_Leave;
 
@@ -414,8 +515,7 @@
    is
       Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
    begin
-      Lock.all := new Object_Lock'(Process => Nul_Process_Id,
-                                   Count => 0);
+      Lock.all := new Object_Lock'(Process => null, Count => 0);
    end Ghdl_Protected_Init;
 
    procedure Ghdl_Protected_Fini (Obj : System.Address)
@@ -425,7 +525,7 @@
 
       Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
    begin
-      if Lock.all.Count /= 0 or Lock.all.Process /= Nul_Process_Id then
+      if Lock.all.Count /= 0 or Lock.all.Process /= null then
          Internal_Error ("protected_fini");
       end if;
       Deallocate (Lock.all);
@@ -448,40 +548,63 @@
       end if;
 
       --     3) The next time at which a process resumes.
-      for I in Non_Sensitized_Process_Table.First ..
-        Non_Sensitized_Process_Table.Last
-      loop
-         declare
-            Pid : constant Process_Id :=
-              Non_Sensitized_Process_Table.Table (I);
-            Proc : Process_Type renames Process_Table.Table (Pid);
-         begin
-            if Proc.State = State_Wait
-              and then Proc.Timeout < Res
-              and then Proc.Timeout >= 0
-            then
-               --  No signals to be updated.
-               Grt.Signals.Flush_Active_List;
-
-               if Proc.Timeout = Current_Time then
-                  --  Can't be better.
-                  return Current_Time;
-               else
-                  Res := Proc.Timeout;
-               end if;
-            end if;
-         end;
-      end loop;
+      if Process_First_Timeout < Res then
+         --  No signals to be updated.
+         Grt.Signals.Flush_Active_List;
+
+         Res := Process_First_Timeout;
+      end if;
 
       return Res;
    end Compute_Next_Time;
 
-   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id)
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc)
    is
    begin
-      Grt.Rtis_Utils.Put (Stream, Process_Table.Table (Proc).Rti);
+      Grt.Rtis_Utils.Put (Stream, Proc.Rti);
    end Disp_Process_Name;
 
+   procedure Disp_All_Processes
+   is
+      use Grt.Stdio;
+      use Grt.Astdio;
+   begin
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : constant Process_Acc := Process_Table.Table (I);
+         begin
+            Disp_Process_Name (stdout, Proc);
+            New_Line (stdout);
+            Put (stdout, "  State: ");
+            case Proc.State is
+               when State_Sensitized =>
+                  Put (stdout, "sensitized");
+               when State_Wait =>
+                  Put (stdout, "wait");
+                  if Proc.Timeout /= Bad_Time then
+                     Put (stdout, " until ");
+                     Put_Time (stdout, Proc.Timeout);
+                  end if;
+               when State_Ready =>
+                  Put (stdout, "ready");
+               when State_Timeout =>
+                  Put (stdout, "timeout");
+               when State_Delayed =>
+                  Put (stdout, "delayed");
+               when State_Dead =>
+                  Put (stdout, "dead");
+            end case;
+--              Put (stdout, ": time: ");
+--              Put_U64 (stdout, Proc.Stats_Time);
+--              Put (stdout, ", runs: ");
+--              Put_U32 (stdout, Proc.Stats_Run);
+            New_Line (stdout);
+         end;
+      end loop;
+   end Disp_All_Processes;
+
+   pragma Unreferenced (Disp_All_Processes);
+
    type Run_Handler is access function return Integer;
    --  pragma Convention (C, Run_Handler);
 
@@ -502,12 +625,12 @@
    Run_Failure : constant Integer := -1;
 
    Mt_Last : Natural;
-   Mt_Table : Process_Id_Array_Acc;
+   Mt_Table : Process_Acc_Array_Acc;
    Mt_Index : aliased Natural;
 
    procedure Run_Processes_Threads
    is
-      Pid : Process_Id;
+      Proc : Process_Acc;
       Idx : Natural;
    begin
       loop
@@ -516,41 +639,36 @@
          if Idx > Mt_Last then
             return;
          end if;
-         Pid := Mt_Table (Idx);
+         Proc := Mt_Table (Idx);
 
-         declare
-            Proc : Process_Type renames Process_Table.Table (Pid);
-         begin
-            if Grt.Options.Trace_Processes then
-               Grt.Astdio.Put ("run process ");
-               Disp_Process_Name (Stdio.stdout, Pid);
-               Grt.Astdio.Put (" [");
-               Grt.Astdio.Put (Stdio.stdout, Proc.This);
-               Grt.Astdio.Put ("]");
-               Grt.Astdio.New_Line;
-            end if;
-            if not Proc.Resumed then
-               Internal_Error ("run non-resumed process");
-            end if;
-            Proc.Resumed := False;
-            Set_Current_Process
-              (Pid, To_Acc (Process_Table.Table (Pid)'Address));
-            if Proc.State = State_Sensitized then
-               Proc.Subprg.all (Proc.This);
-            else
-               Stack_Switch (Proc.Stack, Get_Main_Stack);
-            end if;
-            if Grt.Options.Checks then
-               Ghdl_Signal_Internal_Checks;
-               Grt.Stack2.Check_Empty (Get_Stack2);
-            end if;
-         end;
+         if Grt.Options.Trace_Processes then
+            Grt.Astdio.Put ("run process ");
+            Disp_Process_Name (Stdio.stdout, Proc);
+            Grt.Astdio.Put (" [");
+            Grt.Astdio.Put (Stdio.stdout, Proc.This);
+            Grt.Astdio.Put ("]");
+            Grt.Astdio.New_Line;
+         end if;
+         if not Proc.Resumed then
+            Internal_Error ("run non-resumed process");
+         end if;
+         Proc.Resumed := False;
+         Set_Current_Process (Proc);
+         if Proc.State = State_Sensitized then
+            Proc.Subprg.all (Proc.This);
+         else
+            Stack_Switch (Proc.Stack, Get_Main_Stack);
+         end if;
+         if Grt.Options.Checks then
+            Ghdl_Signal_Internal_Checks;
+            Grt.Stack2.Check_Empty (Get_Stack2);
+         end if;
       end loop;
    end Run_Processes_Threads;
 
    function Run_Processes (Postponed : Boolean) return Integer
    is
-      Table : Process_Id_Array_Acc;
+      Table : Process_Acc_Array_Acc;
       Last : Natural;
    begin
       if Options.Flag_Stats then
@@ -571,15 +689,14 @@
       if Options.Nbr_Threads = 1 then
          for I in 1 .. Last loop
             declare
-               Pid : constant Process_Id := Table (I);
-               Proc : Process_Type renames Process_Table.Table (Pid);
+               Proc : constant Process_Acc := Table (I);
             begin
                if not Proc.Resumed then
                   Internal_Error ("run non-resumed process");
                end if;
                if Grt.Options.Trace_Processes then
                   Grt.Astdio.Put ("run process ");
-                  Disp_Process_Name (Stdio.stdout, Pid);
+                  Disp_Process_Name (Stdio.stdout, Proc);
                   Grt.Astdio.Put (" [");
                   Grt.Astdio.Put (Stdio.stdout, Proc.This);
                   Grt.Astdio.Put ("]");
@@ -587,8 +704,7 @@
                end if;
 
                Proc.Resumed := False;
-               Set_Current_Process
-                 (Pid, To_Acc (Process_Table.Table (Pid)'Address));
+               Set_Current_Process (Proc);
                if Proc.State = State_Sensitized then
                   Proc.Subprg.all (Proc.This);
                else
@@ -642,7 +758,7 @@
       null;
 
       for I in Process_Table.First .. Process_Table.Last loop
-         Resume_Process (I);
+         Resume_Process (Process_Table.Table (I));
       end loop;
 
       --  - Each nonpostponed process in the model is executed until it
@@ -697,47 +813,43 @@
       --  d) For each process P, if P is currently sensitive to a signal S and
       --     if an event has occured on S in this simulation cycle, then P
       --     resumes.
-      for I in Non_Sensitized_Process_Table.First ..
-        Non_Sensitized_Process_Table.Last
-      loop
+      if Current_Time = Process_First_Timeout then
+         Tn := Last_Time;
          declare
-            Pid : constant Process_Id :=
-              Non_Sensitized_Process_Table.Table (I);
-            Proc : Process_Type renames Process_Table.Table (Pid);
-            El : Sensitivity_Acc;
+            Proc : Process_Acc;
          begin
-            case Proc.State is
-               when State_Sensitized =>
-                  null;
-               when State_Delayed =>
-                  if Proc.Timeout = Current_Time then
-                     Proc.Timeout := Bad_Time;
-                     Resume_Process (Pid);
-                     Proc.State := State_Sensitized;
-                  end if;
-               when State_Wait =>
-                  if Proc.Timeout = Current_Time then
-                     Proc.Timeout := Bad_Time;
-                     Resume_Process (Pid);
-                     Proc.State := State_Timeout;
-                  else
-                     El := Proc.Sensitivity;
-                     while El /= null loop
-                        if El.Sig.Event then
-                           Resume_Process (Pid);
-                           exit;
-                        else
-                           El := El.Next;
-                        end if;
-                     end loop;
-                  end if;
-               when State_Timeout =>
-                  Internal_Error ("process in timeout");
-               when State_Dead =>
-                  null;
-            end case;
+            Proc := Process_Timeout_Chain;
+            while Proc /= null loop
+               case Proc.State is
+                  when State_Sensitized =>
+                     null;
+                  when State_Delayed =>
+                     if Proc.Timeout = Current_Time then
+                        Proc.Timeout := Bad_Time;
+                        Resume_Process (Proc);
+                        Proc.State := State_Sensitized;
+                     elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
+                        Tn := Proc.Timeout;
+                     end if;
+                  when State_Wait =>
+                     if Proc.Timeout = Current_Time then
+                        Proc.Timeout := Bad_Time;
+                        Resume_Process (Proc);
+                        Proc.State := State_Timeout;
+                     elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
+                        Tn := Proc.Timeout;
+                     end if;
+                  when State_Timeout
+                    | State_Ready =>
+                     Internal_Error ("process in timeout");
+                  when State_Dead =>
+                     null;
+               end case;
+               Proc := Proc.Timeout_Chain_Next;
+            end loop;
          end;
-      end loop;
+         Process_First_Timeout := Tn;
+      end if;
 
       --  e) Each nonpostponed that has resumed in the current simulation cycle
       --     is executed until it suspends.
@@ -810,9 +922,9 @@
 
       --  Allocate processes arrays.
       Resume_Process_Table :=
-        new Process_Id_Array (1 .. Nbr_Non_Postponed_Processes);
+        new Process_Acc_Array (1 .. Nbr_Non_Postponed_Processes);
       Postponed_Resume_Process_Table :=
-        new Process_Id_Array (1 .. Nbr_Postponed_Processes);
+        new Process_Acc_Array (1 .. Nbr_Postponed_Processes);
 
       Status := Run_Through_Longjump (Initialization_Phase'Access);
       if Status /= Run_Resumed then
diff -urN ghdl-0.28/vhdl/grt/grt-processes.ads ghdl-0.29dev/vhdl/grt/grt-processes.ads
--- ghdl-0.28/vhdl/grt/grt-processes.ads	2008-08-28 06:38:08.000000000 +0200
+++ ghdl-0.29dev/vhdl/grt/grt-processes.ads	2009-12-16 14:31:13.000000000 +0100
@@ -42,6 +42,9 @@
    --  If true, the simulation should be stopped.
    Break_Simulation : Boolean;
 
+   type Process_Type is private;
+   --  type Process_Acc is access all Process_Type;
+
    --  Return the identifier of the current process.
    --  During the elaboration, this is the identifier of the last process
    --  being elaborated.  So, this function can be used to create signal
@@ -56,7 +59,7 @@
    function Get_Nbr_Resumed_Processes return Natural;
 
    --  Disp the name of process PROC.
-   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id);
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc);
 
    --  Register a process during elaboration.
    --  This procedure is called by vhdl elaboration code.
@@ -88,7 +91,7 @@
    procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
 
    --  Resume a process.
-   procedure Resume_Process (Proc : Process_Id);
+   procedure Resume_Process (Proc : Process_Acc);
 
    --  Wait without timeout or sensitivity.
    procedure Ghdl_Process_Wait_Exit;
@@ -118,26 +121,19 @@
    procedure Ghdl_Protected_Init (Obj : System.Address);
    procedure Ghdl_Protected_Fini (Obj : System.Address);
 
-   type Process_Type is private;
-   type Process_Acc is access all Process_Type;
 private
-      --  Access to a process subprogram.
+   --  Access to a process subprogram.
    type Proc_Acc is access procedure (Self : System.Address);
 
-   --  Simply linked list for sensitivity.
-   type Sensitivity_El;
-   type Sensitivity_Acc is access Sensitivity_El;
-   type Sensitivity_El is record
-      Sig : Ghdl_Signal_Ptr;
-      Next : Sensitivity_Acc;
-   end record;
-
    --  State of a process.
    type Process_State is
      (
       --  Sensitized process.  Its state cannot change.
       State_Sensitized,
 
+      --  Non-sensitized process, ready to run.
+      State_Ready,
+
       --  Verilog process, being suspended.
       State_Delayed,
 
@@ -146,6 +142,8 @@
 
       --  Non-sensitized process being awaked by a wait timeout.  This state
       --  is transcient.
+      --  This is necessary so that the process will exit immediately from the
+      --  wait statements without checking if the wait condition is true.
       State_Timeout,
 
       --  Non-sensitized process waiting until end.
@@ -178,8 +176,11 @@
       --  Timeout value for wait.
       Timeout : Std_Time;
 
-      --  Sensitivity list.
-      Sensitivity : Sensitivity_Acc;
+      --  Sensitivity list while the (non-sensitized) process is waiting.
+      Sensitivity : Action_List_Acc;
+
+      Timeout_Chain_Next : Process_Acc;
+      Timeout_Chain_Prev : Process_Acc;
    end record;
 
    pragma Export (C, Ghdl_Process_Register,
diff -urN ghdl-0.28/vhdl/grt/grt-rtis_utils.adb ghdl-0.29dev/vhdl/grt/grt-rtis_utils.adb
--- ghdl-0.28/vhdl/grt/grt-rtis_utils.adb	2008-12-31 05:41:58.000000000 +0100
+++ ghdl-0.29dev/vhdl/grt/grt-rtis_utils.adb	2009-12-16 14:31:13.000000000 +0100
@@ -502,6 +502,7 @@
    begin
       Rtis_Utils.Get_Value (Name, Value, Type_Rti);
       Put (Stream, Name);
+      Free (Name);
    end Disp_Value;
 
    procedure Get_Enum_Value
diff -urN ghdl-0.28/vhdl/grt/grt-signals.adb ghdl-0.29dev/vhdl/grt/grt-signals.adb
--- ghdl-0.28/vhdl/grt/grt-signals.adb	2008-09-12 21:34:38.000000000 +0200
+++ ghdl-0.29dev/vhdl/grt/grt-signals.adb	2009-12-16 14:31:13.000000000 +0100
@@ -266,9 +266,9 @@
                         / System.Storage_Unit);
       end Size;
 
-      Id : Process_Id;
+      Proc : Process_Acc;
    begin
-      Id := Get_Current_Process_Id;
+      Proc := Get_Current_Process;
       if Sign.S.Nbr_Drivers = 0 then
          Check_New_Source (Sign);
          Sign.S.Drivers := Malloc (Size (1));
@@ -276,7 +276,7 @@
       else
          -- Do not create a driver twice.
          for I in 0 .. Sign.S.Nbr_Drivers - 1 loop
-            if Sign.S.Drivers (I).Proc = Id then
+            if Sign.S.Drivers (I).Proc = Proc then
                return True;
             end if;
          end loop;
@@ -287,7 +287,7 @@
       Sign.S.Drivers (Sign.S.Nbr_Drivers - 1) :=
         (First_Trans => Trans,
          Last_Trans => Trans,
-         Proc => Id);
+         Proc => Proc);
       return False;
    end Ghdl_Signal_Add_Driver;
 
@@ -444,14 +444,14 @@
 
    function Find_Driver (Sig : Ghdl_Signal_Ptr) return Ghdl_Index_Type
    is
-      Id : Process_Id;
+      Proc : Process_Acc;
    begin
       if Sig.S.Drivers = null then
          Error ("assignment to a signal without any driver");
       end if;
-      Id := Get_Current_Process_Id;
+      Proc := Get_Current_Process;
       for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
-         if Sig.S.Drivers (I).Proc = Id then
+         if Sig.S.Drivers (I).Proc = Proc then
             return I;
          end if;
       end loop;
@@ -460,14 +460,14 @@
 
    function Get_Driver (Sig : Ghdl_Signal_Ptr) return Driver_Acc
    is
-      Id : Process_Id;
+      Proc : Process_Acc;
    begin
       if Sig.S.Drivers = null then
          return null;
       end if;
-      Id := Get_Current_Process_Id;
+      Proc := Get_Current_Process;
       for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
-         if Sig.S.Drivers (I).Proc = Id then
+         if Sig.S.Drivers (I).Proc = Proc then
             return Sig.S.Drivers (I)'Access;
          end if;
       end loop;
@@ -1815,11 +1815,11 @@
    end Call_Conversion_Function;
 
    procedure Resume_Process_If_Event
-     (Sig : Ghdl_Signal_Ptr; Proc : Process_Id)
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc)
    is
       El : Action_List_Acc;
    begin
-      El := new Action_List'(Kind => Action_Process,
+      El := new Action_List'(Dynamic => False,
                              Proc => Proc,
                              Next => Sig.Event_List);
       Sig.Event_List := El;
@@ -2745,12 +2745,7 @@
 
          El := Sig.Event_List;
          while El /= null loop
-            case El.Kind is
-               when Action_Process =>
-                  Resume_Process (El.Proc);
-               when Action_Signal =>
-                  Internal_Error ("set_effective_value");
-            end case;
+            Resume_Process (El.Proc);
             El := El.Next;
          end loop;
       end if;
diff -urN ghdl-0.28/vhdl/grt/grt-signals.ads ghdl-0.29dev/vhdl/grt/grt-signals.ads
--- ghdl-0.28/vhdl/grt/grt-signals.ads	2008-08-21 04:50:51.000000000 +0200
+++ ghdl-0.29dev/vhdl/grt/grt-signals.ads	2009-12-16 14:31:13.000000000 +0100
@@ -20,6 +20,7 @@
 with Grt.Table;
 with Grt.Types; use Grt.Types;
 with Grt.Rtis; use Grt.Rtis;
+limited with Grt.Processes;
 pragma Elaborate_All (Grt.Table);
 
 package Grt.Signals is
@@ -59,12 +60,14 @@
       end case;
    end record;
 
+   type Process_Acc is access Grt.Processes.Process_Type;
+
    --  A driver is bound to a process (PROC) and contains a list of
    --  transactions.
    type Driver_Type is record
       First_Trans : Transaction_Acc;
       Last_Trans : Transaction_Acc;
-      Proc : Process_Id;
+      Proc : Process_Acc;
    end record;
 
    type Driver_Acc is access all Driver_Type;
@@ -89,19 +92,33 @@
    function To_Signal_Arr_Ptr is new Ada.Unchecked_Conversion
      (Source => System.Address, Target => Signal_Arr_Ptr);
 
+   --  List of processes to wake-up in case of event on the signal.
    type Action_List;
    type Action_List_Acc is access Action_List;
-   type Action_Kind is (Action_Signal, Action_Process);
-   type Action_List (Kind : Action_Kind) is record
+
+   type Action_List (Dynamic : Boolean) is record
+      --  Next action for the current signal.
       Next : Action_List_Acc;
-      case Kind is
-         when Action_Signal =>
+
+      --  Process to wake-up.
+      Proc : Process_Acc;
+
+      case Dynamic is
+         when True =>
+            --  For a non-sensitized process.
+            --  Previous action (to speed-up remove from the chain).
+            Prev : Action_List_Acc;
+
             Sig : Ghdl_Signal_Ptr;
-         when Action_Process =>
-            Proc : Process_Id;
+
+            --  Chain of signals for the process.
+            Chain : Action_List_Acc;
+         when False =>
+            null;
       end case;
    end record;
 
+
    --  How to compute resolved signal.
    type Resolved_Signal_Type is record
       Resolv_Proc : System.Address;
@@ -408,7 +425,7 @@
    --  Add PROC in the list of processes to be resumed in case of event on
    --  SIG.
    procedure Resume_Process_If_Event
-     (Sig : Ghdl_Signal_Ptr; Proc : Process_Id);
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc);
 
    procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
                                    Ctxt : Ghdl_Rti_Access;
diff -urN ghdl-0.28/vhdl/grt/grt-types.ads ghdl-0.29dev/vhdl/grt/grt-types.ads
--- ghdl-0.28/vhdl/grt/grt-types.ads	2007-12-02 02:56:05.000000000 +0100
+++ ghdl-0.29dev/vhdl/grt/grt-types.ads	2009-12-16 14:31:13.000000000 +0100
@@ -139,10 +139,6 @@
    end record;
    type Ghdl_Location_Ptr is access Ghdl_Location;
 
-   --  Identifier for a process.
-   type Process_Id is new Integer;
-   Nul_Process_Id : constant Process_Id := 0;
-
    --  Signal index.
    type Sig_Table_Index is new Integer;
 
diff -urN ghdl-0.28/vhdl/grt/grt-unithread.adb ghdl-0.29dev/vhdl/grt/grt-unithread.adb
--- ghdl-0.28/vhdl/grt/grt-unithread.adb	2008-08-29 02:01:16.000000000 +0200
+++ ghdl-0.29dev/vhdl/grt/grt-unithread.adb	2009-12-16 14:31:13.000000000 +0100
@@ -52,7 +52,6 @@
    end Atomic_Inc;
 
    Current_Process : Process_Acc;
-   Current_Process_Id : Process_Id;
 
    --  Called by linux.c
    function Grt_Get_Current_Process return Process_Acc;
@@ -64,10 +63,9 @@
    end Grt_Get_Current_Process;
 
 
-   procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc) is
+   procedure Set_Current_Process (Proc : Process_Acc) is
    begin
       Current_Process := Proc;
-      Current_Process_Id := Id;
    end Set_Current_Process;
 
    function Get_Current_Process return Process_Acc is
@@ -75,11 +73,6 @@
       return Current_Process;
    end Get_Current_Process;
 
-   function Get_Current_Process_Id return Process_Id is
-   begin
-      return Current_Process_Id;
-   end Get_Current_Process_Id;
-
    Stack2 : Stack2_Ptr;
 
    function Get_Stack2 return Stack2_Ptr is
diff -urN ghdl-0.28/vhdl/grt/grt-unithread.ads ghdl-0.29dev/vhdl/grt/grt-unithread.ads
--- ghdl-0.28/vhdl/grt/grt-unithread.ads	2008-08-21 04:57:53.000000000 +0200
+++ ghdl-0.29dev/vhdl/grt/grt-unithread.ads	2009-12-16 14:31:13.000000000 +0100
@@ -20,8 +20,6 @@
 with Grt.Signals; use Grt.Signals;
 with Grt.Stack2; use Grt.Stack2;
 with Grt.Stacks; use Grt.Stacks;
-with Grt.Types; use Grt.Types;
-with Grt.Processes; use Grt.Processes;
 
 package Grt.Unithread is
    procedure Init;
@@ -38,9 +36,8 @@
    function Atomic_Inc (Val : access Natural) return Natural;
 
    --  Set and get the current process being executed by the thread.
-   procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc);
+   procedure Set_Current_Process (Proc : Process_Acc);
    function Get_Current_Process return Process_Acc;
-   function Get_Current_Process_Id return Process_Id;
 
    --  The secondary stack for the thread.
    function Get_Stack2 return Stack2_Ptr;
@@ -62,6 +59,5 @@
 
    pragma Inline (Set_Current_Process);
    pragma Inline (Get_Current_Process);
-   pragma Inline (Get_Current_Process_Id);
 
 end Grt.Unithread;
diff -urN ghdl-0.28/vhdl/ortho-lang.c ghdl-0.29dev/vhdl/ortho-lang.c
--- ghdl-0.28/vhdl/ortho-lang.c	2008-08-28 05:29:25.000000000 +0200
+++ ghdl-0.29dev/vhdl/ortho-lang.c	2009-12-16 14:31:14.000000000 +0100
@@ -385,7 +385,7 @@
     filename = in_fnames[0];
 
   linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 1);
-  input_location = linemap_line_start (line_table, 0, 252);
+  input_location = linemap_line_start (line_table, 1, 252);
 
   if (!lang_parse_file (filename))
     errorcount++;
diff -urN ghdl-0.28/vhdl/version.ads ghdl-0.29dev/vhdl/version.ads
--- ghdl-0.28/vhdl/version.ads	2009-09-17 03:31:54.000000000 +0200
+++ ghdl-0.29dev/vhdl/version.ads	2009-12-16 14:31:15.000000000 +0100
@@ -1,5 +1,5 @@
 package Version is
    Ghdl_Release : constant String :=
-      "GHDL 0.28 (20090917) [Sokcho edition]";
-   Ghdl_Ver : constant String := "0.28";
+      "GHDL 0.29dev (20090921) [Sokcho edition]";
+   Ghdl_Ver : constant String := "0.29dev";
 end Version;


Index: ghdl.spec
===================================================================
RCS file: /cvs/extras/rpms/ghdl/F-12/ghdl.spec,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -p -r1.57 -r1.58
--- ghdl.spec	14 Dec 2009 09:35:52 -0000	1.57
+++ ghdl.spec	29 Dec 2009 23:59:49 -0000	1.58
@@ -1,11 +1,11 @@
 %global gccver 4.3.4
 %global ghdlver 0.28
-%global ghdlsvnver 131
+%global ghdlsvnver 133
 
 Summary: A VHDL simulator, using the GCC technology
 Name: ghdl
 Version: %{ghdlver}
-Release: 0.%{ghdlsvnver}svn.1%{?dist}
+Release: 0.%{ghdlsvnver}svn.0%{?dist}
 License: GPLv2+
 Group: Development/Languages
 URL: http://ghdl.free.fr/
@@ -27,10 +27,7 @@ Patch105: ghdl-grtadac.patch
 Patch106: ghdl-ppc64abort.patch
 # https://gna.org/bugs/index.php?13389
 Patch107: ieee-mathreal.patch
-# https://gna.org/bugs/index.php?14930
-Patch108: grt-processtimeoutchain.patch
-# https://gna.org/bugs/index.php?14931
-Patch109: grt-dispmemleak.patch
+Patch108: grt-stats.patch
 BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
 Requires(post): /sbin/install-info
 Requires(preun): /sbin/install-info
@@ -136,8 +133,7 @@ popd
 %patch104 -p0 -b .libgnat44
 %patch105 -p1 -b .grtadac
 %patch106 -p0 -b .ppc64abort
-%patch108 -p0 -b .processtimeoutchain
-%patch109 -p0 -b .dispmemleak
+%patch108 -p0 -b .grtstats
 
 %build
 %{__rm} -fr obj-%{gcc_target_platform}
@@ -319,6 +315,10 @@ popd
 %{_libdir}/gcc/
 
 %changelog
+* Wed Dec 30 2009 Thomas Sailer <t.sailer at alumni.ethz.ch> - 0.28-0.133svn.0
+- update to svn133, drop upstreamed patches
+- fix crash when running ./tb --stats
+
 * Sun Dec 13 2009 Thomas Sailer <t.sailer at alumni.ethz.ch> - 0.28-0.131svn.1
 - Process Timeout Chain bugfix
 


--- ghdl-svn131.patch DELETED ---


--- grt-dispmemleak.patch DELETED ---


--- grt-processtimeoutchain.patch DELETED ---




More information about the fedora-extras-commits mailing list