diff options
| -rw-r--r-- | translate/grt/grt-cbinding.c | 3 | ||||
| -rw-r--r-- | translate/grt/grt-processes.adb | 54 | ||||
| -rw-r--r-- | translate/grt/grt-processes.ads | 38 | ||||
| -rw-r--r-- | translate/grt/grt-stacks.ads | 21 |
4 files changed, 64 insertions, 52 deletions
diff --git a/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c index eb04a9cc3..a913a4453 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 0a57565cd..0e34d9f45 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 3218d7286..e1ac95336 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 920012cba..30b9f05b7 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"); |