Use a convention C access for instance, to fix windows crash.

4 files changed, 64 insertions, 52 deletions

diff --git a/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c
index eb04a9c..a913a44 100644
--- a/translate/grt/grt-cbinding.c
+++ b/translate/grt/grt-cbinding.c
@@ -18,6 +18,7 @@
 */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 
 FILE *
 __ghdl_get_stdout (void)
@@ -56,7 +57,7 @@ __ghdl_fprintf_clock (FILE *stream, int a, int b)
   fprintf (stream, "%3d.%03d", a, b);
 }
 
-#if 1
+#ifndef WITH_GNAT_RUN_TIME
 void
 __gnat_last_chance_handler (void)
 {
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 0a57565..0e34d9f 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -23,7 +23,6 @@ pragma Unreferenced (System.Storage_Elements);
 with Grt.Disp;
 with Grt.Astdio;
 with Grt.Errors; use Grt.Errors;
-with Grt.Stacks; use Grt.Stacks;
 with Grt.Options;
 with Grt.Rtis_Addr; use Grt.Rtis_Addr;
 with Grt.Rtis_Utils;
@@ -46,15 +45,12 @@ package body Grt.Processes is
       Table_Low_Bound => 1,
       Table_Initial => 16);
 
-   function To_Proc_Acc is new Ada.Unchecked_Conversion
-     (Source => System.Address, Target => Proc_Acc);
-
    type Finalizer_Type is record
       --  Subprogram containing process code.
       Subprg : Proc_Acc;
 
       --  Instance (THIS parameter) for the subprogram.
-      This : System.Address;
+      This : Instance_Acc;
    end record;
 
    --  List of finalizer.
@@ -111,8 +107,8 @@ package body Grt.Processes is
       return Nbr_Resumed_Processes;
    end Get_Nbr_Resumed_Processes;
 
-   procedure Process_Register (This : System.Address;
-                               Proc : System.Address;
+   procedure Process_Register (This : Instance_Acc;
+                               Proc : Proc_Acc;
                                Ctxt : Rti_Context;
                                State : Process_State;
                                Postponed : Boolean)
@@ -128,7 +124,7 @@ package body Grt.Processes is
       else
          Stack := Null_Stack;
       end if;
-      P := new Process_Type'(Subprg => To_Proc_Acc (Proc),
+      P := new Process_Type'(Subprg => Proc,
                              This => This,
                              Rti => Ctxt,
                              Sensitivity => null,
@@ -150,8 +146,8 @@ package body Grt.Processes is
    end Process_Register;
 
    procedure Ghdl_Process_Register
-     (Instance : System.Address;
-      Proc : System.Address;
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
       Ctxt : Ghdl_Rti_Access;
       Addr : System.Address)
    is
@@ -160,8 +156,8 @@ package body Grt.Processes is
    end Ghdl_Process_Register;
 
    procedure Ghdl_Sensitized_Process_Register
-     (Instance : System.Address;
-      Proc : System.Address;
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
       Ctxt : Ghdl_Rti_Access;
       Addr : System.Address)
    is
@@ -170,8 +166,8 @@ package body Grt.Processes is
    end Ghdl_Sensitized_Process_Register;
 
    procedure Ghdl_Postponed_Process_Register
-     (Instance : System.Address;
-      Proc : System.Address;
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
       Ctxt : Ghdl_Rti_Access;
       Addr : System.Address)
    is
@@ -180,8 +176,8 @@ package body Grt.Processes is
    end Ghdl_Postponed_Process_Register;
 
    procedure Ghdl_Postponed_Sensitized_Process_Register
-     (Instance : System.Address;
-      Proc : System.Address;
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
       Ctxt : Ghdl_Rti_Access;
       Addr : System.Address)
    is
@@ -189,12 +185,10 @@ package body Grt.Processes is
       Process_Register (Instance, Proc, (Addr, Ctxt), State_Sensitized, True);
    end Ghdl_Postponed_Sensitized_Process_Register;
 
-   procedure Verilog_Process_Register (This : System.Address;
-                                       Proc : System.Address;
+   procedure Verilog_Process_Register (This : Instance_Acc;
+                                       Proc : Proc_Acc;
                                        Ctxt : Rti_Context)
    is
-      function To_Proc_Acc is new Ada.Unchecked_Conversion
-        (Source => System.Address, Target => Proc_Acc);
       P : Process_Acc;
    begin
       P := new Process_Type'(Rti => Ctxt,
@@ -205,7 +199,7 @@ package body Grt.Processes is
                              Timeout => Bad_Time,
                              Timeout_Chain_Next => null,
                              Timeout_Chain_Prev => null,
-                             Subprg => To_Proc_Acc (Proc),
+                             Subprg => Proc,
                              This => This,
                              Stack => Null_Stack);
       Process_Table.Append (P);
@@ -213,15 +207,15 @@ package body Grt.Processes is
       Set_Current_Process (P);
    end Verilog_Process_Register;
 
-   procedure Ghdl_Initial_Register (Instance : System.Address;
-                                    Proc : System.Address)
+   procedure Ghdl_Initial_Register (Instance : Instance_Acc;
+                                    Proc : Proc_Acc)
    is
    begin
       Verilog_Process_Register (Instance, Proc, Null_Context);
    end Ghdl_Initial_Register;
 
-   procedure Ghdl_Always_Register (Instance : System.Address;
-                                   Proc : System.Address)
+   procedure Ghdl_Always_Register (Instance : Instance_Acc;
+                                   Proc : Proc_Acc)
    is
    begin
       Verilog_Process_Register (Instance, Proc, Null_Context);
@@ -234,11 +228,11 @@ package body Grt.Processes is
         (Sig, Process_Table.Table (Process_Table.Last));
    end Ghdl_Process_Add_Sensitivity;
 
-   procedure Ghdl_Finalize_Register (Instance : System.Address;
-                                     Proc : System.Address)
+   procedure Ghdl_Finalize_Register (Instance : Instance_Acc;
+                                     Proc : Proc_Acc)
    is
    begin
-      Finalizer_Table.Append (Finalizer_Type'(To_Proc_Acc (Proc), Instance));
+      Finalizer_Table.Append (Finalizer_Type'(Proc, Instance));
    end Ghdl_Finalize_Register;
 
    procedure Call_Finalizers is
@@ -667,7 +661,7 @@ package body Grt.Processes is
             Grt.Astdio.Put ("run process ");
             Disp_Process_Name (Stdio.stdout, Proc);
             Grt.Astdio.Put (" [");
-            Grt.Astdio.Put (Stdio.stdout, Proc.This);
+            Grt.Astdio.Put (Stdio.stdout, To_Address (Proc.This));
             Grt.Astdio.Put ("]");
             Grt.Astdio.New_Line;
          end if;
@@ -720,7 +714,7 @@ package body Grt.Processes is
                   Grt.Astdio.Put ("run process ");
                   Disp_Process_Name (Stdio.stdout, Proc);
                   Grt.Astdio.Put (" [");
-                  Grt.Astdio.Put (Stdio.stdout, Proc.This);
+                  Grt.Astdio.Put (Stdio.stdout, To_Address (Proc.This));
                   Grt.Astdio.Put ("]");
                   Grt.Astdio.New_Line;
                end if;
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index 3218d72..e1ac953 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -19,7 +19,7 @@ with System;
 with Grt.Stack2; use Grt.Stack2;
 with Grt.Types; use Grt.Types;
 with Grt.Signals; use Grt.Signals;
-with Grt.Stacks;
+with Grt.Stacks; use Grt.Stacks;
 with Grt.Rtis; use Grt.Rtis;
 with Grt.Rtis_Addr;
 with Grt.Stdio;
@@ -63,31 +63,32 @@ package Grt.Processes is
 
    --  Register a process during elaboration.
    --  This procedure is called by vhdl elaboration code.
-   procedure Ghdl_Process_Register (Instance : System.Address;
-                                    Proc : System.Address;
+   procedure Ghdl_Process_Register (Instance : Instance_Acc;
+                                    Proc : Proc_Acc;
                                     Ctxt : Ghdl_Rti_Access;
                                     Addr : System.Address);
-   procedure Ghdl_Sensitized_Process_Register (Instance : System.Address;
-                                               Proc : System.Address;
+   procedure Ghdl_Sensitized_Process_Register (Instance : Instance_Acc;
+                                               Proc : Proc_Acc;
                                                Ctxt : Ghdl_Rti_Access;
                                                Addr : System.Address);
-   procedure Ghdl_Postponed_Process_Register (Instance : System.Address;
-                                              Proc : System.Address;
+   procedure Ghdl_Postponed_Process_Register (Instance : Instance_Acc;
+                                              Proc : Proc_Acc;
                                               Ctxt : Ghdl_Rti_Access;
                                               Addr : System.Address);
    procedure Ghdl_Postponed_Sensitized_Process_Register
-     (Instance : System.Address;
-      Proc : System.Address;
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
       Ctxt : Ghdl_Rti_Access;
       Addr : System.Address);
 
-   procedure Ghdl_Finalize_Register (Instance : System.Address;
-                                     Proc : System.Address);
+   --  For verilog processes.
+   procedure Ghdl_Finalize_Register (Instance : Instance_Acc;
+                                     Proc : Proc_Acc);
 
-   procedure Ghdl_Initial_Register (Instance : System.Address;
-                                    Proc : System.Address);
-   procedure Ghdl_Always_Register (Instance : System.Address;
-                                   Proc : System.Address);
+   procedure Ghdl_Initial_Register (Instance : Instance_Acc;
+                                    Proc : Proc_Acc);
+   procedure Ghdl_Always_Register (Instance : Instance_Acc;
+                                   Proc : Proc_Acc);
 
    --  Add a simple signal in the sensitivity of the last registered
    --  (sensitized) process.
@@ -113,6 +114,7 @@ package Grt.Processes is
    --  Verilog.
    procedure Ghdl_Process_Delay (Del : Ghdl_U32);
 
+   --  Secondary stack.
    function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
      return System.Address;
    function Ghdl_Stack2_Mark return Mark_Id;
@@ -125,10 +127,6 @@ package Grt.Processes is
    procedure Ghdl_Protected_Fini (Obj : System.Address);
 
 private
-   --  Access to a process subprogram.
-   type Proc_Acc is access procedure (Self : System.Address);
-   pragma Convention (C, Proc_Acc);
-
    --  State of a process.
    type Process_State is
      (
@@ -164,7 +162,7 @@ private
       Subprg : Proc_Acc;
 
       --  Instance (THIS parameter) for the subprogram.
-      This : System.Address;
+      This : Instance_Acc;
 
       --  Name of the process.
       Rti : Rtis_Addr.Rti_Context;
diff --git a/translate/grt/grt-stacks.ads b/translate/grt/grt-stacks.ads
index 920012c..30b9f05 100644
--- a/translate/grt/grt-stacks.ads
+++ b/translate/grt/grt-stacks.ads
@@ -16,8 +16,24 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with System; use System;
+with Ada.Unchecked_Conversion;
 
 package Grt.Stacks is
+   --  Instance is the parameter of the process procedure.
+   --  This is in fact a fully opaque type whose content is private to the
+   --  process.
+   type Instance is limited private;
+   type Instance_Acc is access all Instance;
+   pragma Convention (C, Instance_Acc);
+
+   --  A process is identified by a procedure having a single private
+   --  parameter (its instance).
+   type Proc_Acc is access procedure (Self : Instance_Acc);
+   pragma Convention (C, Proc_Acc);
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Instance_Acc, System.Address);
+
    type Stack_Type is new Address;
    Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
 
@@ -28,7 +44,8 @@ package Grt.Stacks is
 
    --  Create a new stack, which on first execution will call FUNC with
    --  an argument ARG.
-   function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
+   function Stack_Create (Func : Proc_Acc; Arg : Instance_Acc)
+                         return Stack_Type;
 
    --  Resume stack TO and save the current context to the stack pointed by
    --  CUR.
@@ -50,6 +67,8 @@ package Grt.Stacks is
    procedure Error_Null_Access;
    pragma No_Return (Error_Null_Access);
 private
+   type Instance is null record;
+
    pragma Import (C, Stack_Init, "grt_stack_init");
    pragma Import (C, Stack_Create, "grt_stack_create");
    pragma Import (C, Stack_Switch, "grt_stack_switch");