summaryrefslogtreecommitdiff
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/ghwlib.c10
-rw-r--r--translate/grt/ghwlib.h6
-rw-r--r--translate/grt/grt-cbinding.c7
-rw-r--r--translate/grt/grt-disp_signals.adb230
-rw-r--r--translate/grt/grt-disp_signals.ads2
-rw-r--r--translate/grt/grt-lib.adb11
-rw-r--r--translate/grt/grt-lib.ads25
-rw-r--r--translate/grt/grt-main.adb3
-rw-r--r--translate/grt/grt-options.adb2
-rw-r--r--translate/grt/grt-options.ads1
-rw-r--r--translate/grt/grt-processes.adb40
-rw-r--r--translate/grt/grt-processes.ads5
-rw-r--r--translate/grt/grt-rtis.ads10
-rw-r--r--translate/grt/grt-rtis_utils.adb20
-rw-r--r--translate/grt/grt-rtis_utils.ads13
-rw-r--r--translate/grt/grt-sdf.adb24
-rw-r--r--translate/grt/grt-signals.adb6
-rw-r--r--translate/grt/grt-signals.ads4
-rw-r--r--translate/grt/grt-table.adb8
-rw-r--r--translate/grt/grt-vital_annotate.adb42
-rw-r--r--translate/grt/grt-waves.adb18
21 files changed, 330 insertions, 157 deletions
diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
index 4585688..2db63d9 100644
--- a/translate/grt/ghwlib.c
+++ b/translate/grt/ghwlib.c
@@ -296,7 +296,7 @@ ghw_read_range (struct ghw_handler *h)
int
ghw_read_str (struct ghw_handler *h)
{
- char hdr[12];
+ unsigned char hdr[12];
int i;
char *p;
int prev_len;
@@ -435,7 +435,7 @@ get_range_length (union ghw_range *rng)
int
ghw_read_type (struct ghw_handler *h)
{
- char hdr[8];
+ unsigned char hdr[8];
int i;
if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
@@ -777,7 +777,7 @@ ghw_read_value (struct ghw_handler *h,
int
ghw_read_hie (struct ghw_handler *h)
{
- char hdr[16];
+ unsigned char hdr[16];
int nbr_scopes;
int nbr_sigs;
int i;
@@ -1100,7 +1100,7 @@ ghw_read_signal_value (struct ghw_handler *h, struct ghw_sig *s)
int
ghw_read_snapshot (struct ghw_handler *h)
{
- char hdr[12];
+ unsigned char hdr[12];
int i;
struct ghw_sig *s;
@@ -1138,7 +1138,7 @@ void ghw_disp_values (struct ghw_handler *h);
int
ghw_read_cycle_start (struct ghw_handler *h)
{
- char hdr[8];
+ unsigned char hdr[8];
if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
return -1;
diff --git a/translate/grt/ghwlib.h b/translate/grt/ghwlib.h
index dbf20fe..0138267 100644
--- a/translate/grt/ghwlib.h
+++ b/translate/grt/ghwlib.h
@@ -150,7 +150,7 @@ struct ghw_type_enum
const char *name;
enum ghw_wkt_type wkt;
- int nbr;
+ unsigned int nbr;
const char **lits;
};
@@ -179,7 +179,7 @@ struct ghw_type_array
enum ghdl_rtik kind;
const char *name;
- int nbr_dim;
+ unsigned int nbr_dim;
union ghw_type *el;
union ghw_type **dims;
};
@@ -214,7 +214,7 @@ struct ghw_type_record
enum ghdl_rtik kind;
const char *name;
- int nbr_fields;
+ unsigned int nbr_fields;
int nbr_el; /* Number of scalar signals. */
struct ghw_record_element *el;
};
diff --git a/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c
index 1b75fcf..eb04a9c 100644
--- a/translate/grt/grt-cbinding.c
+++ b/translate/grt/grt-cbinding.c
@@ -37,6 +37,13 @@ __ghdl_get_stderr (void)
return stderr;
}
+int
+__ghdl_snprintf_g (char *buf, unsigned int len, double val)
+{
+ snprintf (buf, len, "%g", val);
+ return strlen (buf);
+}
+
void
__ghdl_fprintf_g (FILE *stream, double val)
{
diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb
index 85acb93..6a2d0c1 100644
--- a/translate/grt/grt-disp_signals.adb
+++ b/translate/grt/grt-disp_signals.adb
@@ -27,9 +27,63 @@ with Grt.Errors; use Grt.Errors;
pragma Elaborate_All (Grt.Rtis_Utils);
with Grt.Vstrings; use Grt.Vstrings;
with Grt.Options;
+with Grt.Processes;
with Grt.Disp; use Grt.Disp;
package body Grt.Disp_Signals is
+ procedure Foreach_Scalar_Signal
+ (Process : access procedure (Val_Addr : Address;
+ Val_Name : Vstring;
+ Val_Type : Ghdl_Rti_Access;
+ Param : Rti_Object))
+ is
+ procedure Call_Process (Val_Addr : Address;
+ Val_Name : Vstring;
+ Val_Type : Ghdl_Rti_Access;
+ Param : Rti_Object) is
+ begin
+ Process.all (Val_Addr, Val_Name, Val_Type, Param);
+ end Call_Process;
+
+ pragma Inline (Call_Process);
+
+ procedure Foreach_Scalar_Signal_Signal is new
+ Foreach_Scalar (Param_Type => Rti_Object,
+ Process => Call_Process);
+
+ function Foreach_Scalar_Signal_Object
+ (Ctxt : Rti_Context; Obj : Ghdl_Rti_Access)
+ return Traverse_Result
+ is
+ Sig : Ghdl_Rtin_Object_Acc;
+ begin
+ case Obj.Kind is
+ when Ghdl_Rtik_Signal
+ | Ghdl_Rtik_Port
+ | Ghdl_Rtik_Guard
+ | Ghdl_Rtik_Attribute_Quiet
+ | Ghdl_Rtik_Attribute_Stable
+ | Ghdl_Rtik_Attribute_Transaction =>
+ Sig := To_Ghdl_Rtin_Object_Acc (Obj);
+ Foreach_Scalar_Signal_Signal
+ (Ctxt, Sig.Obj_Type,
+ Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True,
+ Rti_Object'(Obj, Ctxt));
+ when others =>
+ null;
+ end case;
+ return Traverse_Ok;
+ end Foreach_Scalar_Signal_Object;
+
+ function Foreach_Scalar_Signal_Traverse is
+ new Traverse_Blocks (Process => Foreach_Scalar_Signal_Object);
+
+ Res : Traverse_Result;
+ pragma Unreferenced (Res);
+ begin
+ Res := Foreach_Scalar_Signal_Traverse (Get_Top_Context);
+ end Foreach_Scalar_Signal;
+
procedure Disp_Context (Ctxt : Rti_Context)
is
Blk : Ghdl_Rtin_Block_Acc;
@@ -166,90 +220,106 @@ package body Grt.Disp_Signals is
New_Line;
end Disp_Simple_Signal;
- procedure Disp_Scalar_Signal (Val_Addr : Address;
- Val_Name : Vstring;
- Val_Type : Ghdl_Rti_Access)
- is
- begin
- Put (stdout, Val_Name);
- Disp_Simple_Signal (To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all),
- Val_Type, Options.Disp_Sources);
- end Disp_Scalar_Signal;
-
- procedure Foreach_Scalar_Signal is new
- Foreach_Scalar (Process => Disp_Scalar_Signal);
-
- procedure Disp_Signal_Name (Stream : FILEs; Sig : Ghdl_Rtin_Object_Acc) is
+ procedure Disp_Signal_Name (Stream : FILEs;
+ Ctxt : Rti_Context;
+ Sig : Ghdl_Rtin_Object_Acc) is
begin
case Sig.Common.Kind is
when Ghdl_Rtik_Signal
| Ghdl_Rtik_Port
| Ghdl_Rtik_Guard =>
+ Put (stdout, Ctxt);
+ Put (".");
Put (Stream, Sig.Name);
when Ghdl_Rtik_Attribute_Quiet =>
+ Put (stdout, Ctxt);
+ Put (".");
Put (Stream, " 'quiet");
when Ghdl_Rtik_Attribute_Stable =>
+ Put (stdout, Ctxt);
+ Put (".");
Put (Stream, " 'stable");
when Ghdl_Rtik_Attribute_Transaction =>
+ Put (stdout, Ctxt);
+ Put (".");
Put (Stream, " 'quiet");
when others =>
null;
end case;
end Disp_Signal_Name;
- function Disp_Signal (Ctxt : Rti_Context;
- Obj : Ghdl_Rti_Access)
- return Traverse_Result
+ procedure Disp_Scalar_Signal (Val_Addr : Address;
+ Val_Name : Vstring;
+ Val_Type : Ghdl_Rti_Access;
+ Parent : Rti_Object)
is
- Sig : Ghdl_Rtin_Object_Acc;
begin
- case Obj.Kind is
- when Ghdl_Rtik_Signal
- | Ghdl_Rtik_Port
- | Ghdl_Rtik_Guard
- | Ghdl_Rtik_Attribute_Quiet
- | Ghdl_Rtik_Attribute_Stable
- | Ghdl_Rtik_Attribute_Transaction =>
- Sig := To_Ghdl_Rtin_Object_Acc (Obj);
- Put (stdout, Ctxt);
- Put (".");
- Disp_Signal_Name (stdout, Sig);
- Foreach_Scalar_Signal
- (Ctxt, Sig.Obj_Type,
- Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
- when others =>
- null;
- end case;
- return Traverse_Ok;
- end Disp_Signal;
+ Disp_Signal_Name (stdout, Parent.Ctxt,
+ To_Ghdl_Rtin_Object_Acc (Parent.Obj));
+ Put (stdout, Val_Name);
+ Disp_Simple_Signal (To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all),
+ Val_Type, Options.Disp_Sources);
+ end Disp_Scalar_Signal;
+
- function Disp_All_Signals is new Traverse_Blocks (Process => Disp_Signal);
+ procedure Disp_All_Signals is
+ begin
+ Foreach_Scalar_Signal (Disp_Scalar_Signal'access);
+ end Disp_All_Signals;
+
+ -- Option disp-sensitivity
- procedure Disp_All_Signals
+ procedure Disp_Scalar_Sensitivity (Val_Addr : Address;
+ Val_Name : Vstring;
+ Val_Type : Ghdl_Rti_Access;
+ Parent : Rti_Object)
is
- Res : Traverse_Result;
- pragma Unreferenced (Res);
+ pragma Unreferenced (Val_Type);
+ Sig : Ghdl_Signal_Ptr;
+
+ Action : Action_List_Acc;
begin
- if Boolean'(False) then
- for I in Sig_Table.First .. Sig_Table.Last loop
- Disp_Simple_Signal
- (Sig_Table.Table (I), null, Options.Disp_Sources);
- end loop;
+ Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+ if Sig.Flags.Seen then
+ return;
else
- Res := Disp_All_Signals (Get_Top_Context);
+ Sig.Flags.Seen := True;
end if;
- end Disp_All_Signals;
+ Disp_Signal_Name (stdout, Parent.Ctxt,
+ To_Ghdl_Rtin_Object_Acc (Parent.Obj));
+ Put (stdout, Val_Name);
+ New_Line (stdout);
+ Action := Sig.Event_List;
+ while Action /= null loop
+ Put (stdout, " wakeup ");
+ Grt.Processes.Disp_Process_Name (stdout, Action.Proc);
+ New_Line (stdout);
+ Action := Action.Next;
+ end loop;
+ if Sig.S.Mode_Sig in Mode_Signal_User then
+ for I in 1 .. Sig.S.Nbr_Drivers loop
+ Put (stdout, " driven ");
+ Grt.Processes.Disp_Process_Name
+ (stdout, Sig.S.Drivers (I - 1).Proc);
+ New_Line (stdout);
+ end loop;
+ end if;
+ end Disp_Scalar_Sensitivity;
- -- Option disp-signals-map
+ procedure Disp_All_Sensitivity is
+ begin
+ Foreach_Scalar_Signal (Disp_Scalar_Sensitivity'access);
+ end Disp_All_Sensitivity;
- Cur_Signals_Map_Ctxt : Rti_Context;
- Cur_Signals_Map_Obj : Ghdl_Rtin_Object_Acc;
+
+ -- Option disp-signals-map
procedure Disp_Signals_Map_Scalar (Val_Addr : Address;
Val_Name : Vstring;
- Val_Type : Ghdl_Rti_Access)
+ Val_Type : Ghdl_Rti_Access;
+ Parent : Rti_Object)
is
pragma Unreferenced (Val_Type);
@@ -258,9 +328,8 @@ package body Grt.Disp_Signals is
S : Ghdl_Signal_Ptr;
begin
- Put (stdout, Cur_Signals_Map_Ctxt);
- Put (".");
- Disp_Signal_Name (stdout, Cur_Signals_Map_Obj);
+ Disp_Signal_Name (stdout,
+ Parent.Ctxt, To_Ghdl_Rtin_Object_Acc (Parent.Obj));
Put (stdout, Val_Name);
Put (": ");
S := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
@@ -273,43 +342,9 @@ package body Grt.Disp_Signals is
New_Line;
end Disp_Signals_Map_Scalar;
- procedure Foreach_Disp_Signals_Map_Scalar is new
- Foreach_Scalar (Process => Disp_Signals_Map_Scalar);
-
- function Disp_Signals_Map_Signal (Ctxt : Rti_Context;
- Obj : Ghdl_Rti_Access)
- return Traverse_Result
- is
- Sig : Ghdl_Rtin_Object_Acc renames Cur_Signals_Map_Obj;
- begin
- case Obj.Kind is
- when Ghdl_Rtik_Signal
- | Ghdl_Rtik_Port
- | Ghdl_Rtik_Guard
- | Ghdl_Rtik_Attribute_Stable
- | Ghdl_Rtik_Attribute_Quiet
- | Ghdl_Rtik_Attribute_Transaction =>
- Cur_Signals_Map_Ctxt := Ctxt;
- Cur_Signals_Map_Obj := To_Ghdl_Rtin_Object_Acc (Obj);
- Foreach_Disp_Signals_Map_Scalar
- (Ctxt, Sig.Obj_Type,
- Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
- when others =>
- null;
- end case;
- return Traverse_Ok;
- end Disp_Signals_Map_Signal;
-
- function Disp_Signals_Map_Blocks is new Traverse_Blocks
- (Process => Disp_Signals_Map_Signal);
-
- procedure Disp_Signals_Map
- is
- Res : Traverse_Result;
- pragma Unreferenced (Res);
+ procedure Disp_Signals_Map is
begin
- Res := Disp_Signals_Map_Blocks (Get_Top_Context);
- Grt.Stdio.fflush (stdout);
+ Foreach_Scalar_Signal (Disp_Signals_Map_Scalar'access);
end Disp_Signals_Map;
-- Option --disp-signals-table
@@ -407,24 +442,24 @@ package body Grt.Disp_Signals is
procedure Process_Scalar (Val_Addr : Address;
Val_Name : Vstring;
- Val_Type : Ghdl_Rti_Access)
+ Val_Type : Ghdl_Rti_Access;
+ Param : Boolean)
is
pragma Unreferenced (Val_Type);
+ pragma Unreferenced (Param);
Sig1 : Ghdl_Signal_Ptr;
begin
-- Read the signal.
Sig1 := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
if Sig1 = Sig and not Found then
- Put (Stream, Cur_Ctxt);
- Put (Stream, ".");
- Disp_Signal_Name (Stream, Cur_Sig);
+ Disp_Signal_Name (Stream, Cur_Ctxt, Cur_Sig);
Put (Stream, Val_Name);
Found := True;
end if;
end Process_Scalar;
procedure Foreach_Scalar is new Grt.Rtis_Utils.Foreach_Scalar
- (Process_Scalar);
+ (Param_Type => Boolean, Process => Process_Scalar);
function Process_Block (Ctxt : Rti_Context;
Obj : Ghdl_Rti_Access)
@@ -442,7 +477,8 @@ package body Grt.Disp_Signals is
Cur_Sig := To_Ghdl_Rtin_Object_Acc (Obj);
Foreach_Scalar
(Ctxt, Cur_Sig.Obj_Type,
- Loc_To_Addr (Cur_Sig.Common.Depth, Cur_Sig.Loc, Ctxt), True);
+ Loc_To_Addr (Cur_Sig.Common.Depth, Cur_Sig.Loc, Ctxt),
+ True, True);
if Found then
return Traverse_Stop;
end if;
diff --git a/translate/grt/grt-disp_signals.ads b/translate/grt/grt-disp_signals.ads
index fd84fe0..398d4e5 100644
--- a/translate/grt/grt-disp_signals.ads
+++ b/translate/grt/grt-disp_signals.ads
@@ -26,6 +26,8 @@ package Grt.Disp_Signals is
procedure Disp_Signals_Table;
+ procedure Disp_All_Sensitivity;
+
procedure Disp_Mode_Signal (Mode : Mode_Signal_Type);
-- Disp informations on signal SIG.
diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
index dcddcf2..d35c73b 100644
--- a/translate/grt/grt-lib.adb
+++ b/translate/grt/grt-lib.adb
@@ -106,6 +106,16 @@ package body Grt.Lib is
Do_Report ("assertion", Str, Severity, Loc, Unit);
end Ghdl_Assert_Failed;
+ procedure Ghdl_Psl_Assert_Failed
+ (Str : Std_String_Ptr;
+ Severity : Integer;
+ Loc : Ghdl_Location_Ptr;
+ Unit : Ghdl_Rti_Access)
+ is
+ begin
+ Do_Report ("psl assertion", Str, Severity, Loc, Unit);
+ end Ghdl_Psl_Assert_Failed;
+
procedure Ghdl_Report
(Str : Std_String_Ptr;
Severity : Integer;
@@ -257,7 +267,6 @@ package body Grt.Lib is
return 1.0 / Res;
end if;
end Ghdl_Real_Exp;
-
end Grt.Lib;
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
index 5bb2cd4..d58117b 100644
--- a/translate/grt/grt-lib.ads
+++ b/translate/grt/grt-lib.ads
@@ -30,6 +30,12 @@ package Grt.Lib is
Loc : Ghdl_Location_Ptr;
Unit : Ghdl_Rti_Access);
+ procedure Ghdl_Psl_Assert_Failed
+ (Str : Std_String_Ptr;
+ Severity : Integer;
+ Loc : Ghdl_Location_Ptr;
+ Unit : Ghdl_Rti_Access);
+
procedure Ghdl_Report
(Str : Std_String_Ptr;
Severity : Integer;
@@ -79,10 +85,26 @@ package Grt.Lib is
-- the export pragma.
pragma Export (C, Ghdl_Assert_Default_Report,
"__ghdl_assert_default_report");
+
+ type Ghdl_Std_Ulogic_Boolean_Array_Type is array (Ghdl_E8 range 0 .. 8)
+ of Ghdl_B2;
+
+ Ghdl_Std_Ulogic_To_Boolean_Array :
+ constant Ghdl_Std_Ulogic_Boolean_Array_Type := (False, -- U
+ False, -- X
+ False, -- 0
+ True, -- 1
+ False, -- Z
+ False, -- W
+ False, -- L
+ True, -- H
+ False -- -
+ );
private
pragma Export (C, Ghdl_Memcpy, "__ghdl_memcpy");
pragma Export (C, Ghdl_Assert_Failed, "__ghdl_assert_failed");
+ pragma Export (C, Ghdl_Psl_Assert_Failed, "__ghdl_psl_assert_failed");
pragma Export (C, Ghdl_Report, "__ghdl_report");
pragma Export (C, Ghdl_Bound_Check_Failed_L0,
@@ -97,6 +119,9 @@ private
pragma Export (C, Ghdl_Integer_Exp, "__ghdl_integer_exp");
pragma Export (C, Ghdl_Real_Exp, "__ghdl_real_exp");
+
+ pragma Export (C, Ghdl_Std_Ulogic_To_Boolean_Array,
+ "__ghdl_std_ulogic_to_boolean_array");
end Grt.Lib;
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index 43166fa..a196999 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -149,6 +149,9 @@ package body Grt.Main is
if Disp_Signals_Order then
Grt.Disp.Disp_Signals_Order;
end if;
+ if Disp_Sensitivity then
+ Grt.Disp_Signals.Disp_All_Sensitivity;
+ end if;
-- Do the simulation.
Status := Grt.Processes.Simulation;
diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
index a272246..6d73843 100644
--- a/translate/grt/grt-options.adb
+++ b/translate/grt/grt-options.adb
@@ -281,6 +281,8 @@ package body Grt.Options is
Disp_Signals_Map := True;
elsif Argument = "--disp-signals-table" then
Disp_Signals_Table := True;
+ elsif Argument = "--disp-sensitivity" then
+ Disp_Sensitivity := True;
elsif Argument = "--stats" then
Flag_Stats := True;
elsif Argument = "--no-run" then
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
index 3057fc8..1d122ca 100644
--- a/translate/grt/grt-options.ads
+++ b/translate/grt/grt-options.ads
@@ -72,6 +72,7 @@ package Grt.Options is
Disp_Sources : Boolean := False;
Disp_Signals_Map : Boolean := False;
Disp_Signals_Table : Boolean := False;
+ Disp_Sensitivity : Boolean := False;
-- Set by --disp-order to diplay evaluation order of signals.
Disp_Signals_Order : Boolean := False;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 72d3f8e..0a57565 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -46,9 +46,20 @@ package body Grt.Processes is
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_Acc,
+ 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;
+ end record;
+
+ -- List of finalizer.
+ package Finalizer_Table is new Grt.Table
+ (Table_Component_Type => Finalizer_Type,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 2);
@@ -106,8 +117,6 @@ package body Grt.Processes is
State : Process_State;
Postponed : Boolean)
is
- function To_Proc_Acc is new Ada.Unchecked_Conversion
- (Source => System.Address, Target => Proc_Acc);
Stack : Stack_Type;
P : Process_Acc;
begin
@@ -133,9 +142,6 @@ package body Grt.Processes is
Process_Table.Append (P);
-- Used to create drivers.
Set_Current_Process (P);
- if State /= State_Sensitized then
- Non_Sensitized_Process_Table.Append (P);
- end if;
if Postponed then
Nbr_Postponed_Processes := Nbr_Postponed_Processes + 1;
else
@@ -228,6 +234,22 @@ 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)
+ is
+ begin
+ Finalizer_Table.Append (Finalizer_Type'(To_Proc_Acc (Proc), Instance));
+ end Ghdl_Finalize_Register;
+
+ procedure Call_Finalizers is
+ El : Finalizer_Type;
+ begin
+ for I in Finalizer_Table.First .. Finalizer_Table.Last loop
+ El := Finalizer_Table.Table (I);
+ El.Subprg.all (El.This);
+ end loop;
+ end Call_Finalizers;
+
procedure Resume_Process (Proc : Process_Acc)
is
begin
@@ -983,6 +1005,8 @@ package body Grt.Processes is
Threads.Finish;
end if;
+ Call_Finalizers;
+
Grt.Hooks.Call_Finish_Hooks;
if Status = Run_Failure then
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index 1d5bb5f..b59a5b1 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -81,6 +81,9 @@ package Grt.Processes is
Ctxt : Ghdl_Rti_Access;
Addr : System.Address);
+ procedure Ghdl_Finalize_Register (Instance : System.Address;
+ Proc : System.Address);
+
procedure Ghdl_Initial_Register (Instance : System.Address;
Proc : System.Address);
procedure Ghdl_Always_Register (Instance : System.Address;
@@ -192,6 +195,8 @@ private
pragma Export (C, Ghdl_Postponed_Sensitized_Process_Register,
"__ghdl_postponed_sensitized_process_register");
+ pragma Export (C, Ghdl_Finalize_Register, "__ghdl_finalize_register");
+
pragma Export (C, Ghdl_Always_Register, "__ghdl_always_register");
pragma Export (C, Ghdl_Initial_Register, "__ghdl_initial_register");
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 3059408..564b397 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -151,10 +151,10 @@ package Grt.Rtis is
Ghdl_Rti_Signal_Mode_Inout : constant Ghdl_Rti_U8 := 4;
Ghdl_Rti_Signal_Mode_In : constant Ghdl_Rti_U8 := 5;
- Ghdl_Rti_Signal_Kind_Mask : constant Ghdl_Rti_U8 := 48;
- Ghdl_Rti_Signal_Kind_No : constant Ghdl_Rti_U8 := 0;
- Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 16;
- Ghdl_Rti_Signal_Kind_Bus : constant Ghdl_Rti_U8 := 32;
+ Ghdl_Rti_Signal_Kind_Mask : constant Ghdl_Rti_U8 := 3 * 16;
+ Ghdl_Rti_Signal_Kind_No : constant Ghdl_Rti_U8 := 0 * 16;
+ Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 1 * 16;
+ Ghdl_Rti_Signal_Kind_Bus : constant Ghdl_Rti_U8 := 2 * 16;
Ghdl_Rti_Signal_Has_Active : constant Ghdl_Rti_U8 := 64;
@@ -198,7 +198,7 @@ package Grt.Rtis is
function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
(Source => Ghdl_Rtin_Subtype_Scalar_Acc, Target => Ghdl_Rti_Access);
- -- True if the type is complex.
+ -- True if the type is complex, set in Mode field.
Ghdl_Rti_Type_Complex_Mask : constant Ghdl_Rti_U8 := 1;
Ghdl_Rti_Type_Complex : constant Ghdl_Rti_U8 := 1;
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
index d01cea9..dbc70c2 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -169,7 +169,8 @@ package body Grt.Rtis_Utils is
procedure Foreach_Scalar (Ctxt : Rti_Context;
Obj_Type : Ghdl_Rti_Access;
Obj_Addr : Address;
- Is_Sig : Boolean)
+ Is_Sig : Boolean;
+ Param : Param_Type)
is
-- Current address.
Addr : Address;
@@ -185,7 +186,7 @@ package body Grt.Rtis_Utils is
Addr := Addr + (S / Storage_Unit);
end Update;
begin
- Process (Addr, Name, Rti);
+ Process (Addr, Name, Rti, Param);
if Is_Sig then
Update (Address'Size);
@@ -448,18 +449,15 @@ package body Grt.Rtis_Utils is
declare
S : String (1 .. 32);
L : Integer;
- -- Warning: this assumes a C99 snprintf (ie, it returns the
- -- number of characters).
- function snprintf (Cstr : Address;
- Size : Natural;
- Template : Address;
- Arg : Ghdl_F64)
+
+ function Snprintf_G (Cstr : Address;
+ Size : Natural;
+ Arg : Ghdl_F64)
return Integer;
- pragma Import (C, snprintf);
+ pragma Import (C, Snprintf_G, "__ghdl_snprintf_g");
- Format : constant String := "%g" & Character'Val (0);
begin
- L := snprintf (S'Address, S'Length, Format'Address, Value.F64);
+ L := Snprintf_G (S'Address, S'Length, Value.F64);
if L < 0 then
-- FIXME.
Append (Str, "?");
diff --git a/translate/grt/grt-rtis_utils.ads b/translate/grt/grt-rtis_utils.ads
index 9b8fd33..232016d 100644
--- a/translate/grt/grt-rtis_utils.ads
+++ b/translate/grt/grt-rtis_utils.ads
@@ -29,6 +29,12 @@ package Grt.Rtis_Utils is
-- Traverse_Stop: end of walk.
type Traverse_Result is (Traverse_Ok, Traverse_Skip, Traverse_Stop);
+ -- An RTI object is a context and an RTI declaration.
+ type Rti_Object is record
+ Obj : Ghdl_Rti_Access;
+ Ctxt : Rti_Context;
+ end record;
+
-- Traverse all blocks (package, entities, architectures, block, generate,
-- processes).
generic
@@ -38,13 +44,16 @@ package Grt.Rtis_Utils is
function Traverse_Blocks (Ctxt : Rti_Context) return Traverse_Result;
generic
+ type Param_Type is private;
with procedure Process (Val_Addr : Address;
Val_Name : Vstring;
- Val_Type : Ghdl_Rti_Access);
+ Val_Type : Ghdl_Rti_Access;
+ Param : Param_Type);
procedure Foreach_Scalar (Ctxt : Rti_Context;
Obj_Type : Ghdl_Rti_Access;
Obj_Addr : Address;
- Is_Sig : Boolean);
+ Is_Sig : Boolean;
+ Param : Param_Type);
procedure Get_Value (Str : in out Vstring;
Value : Value_Union;
diff --git a/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb
index fbf9f3e..16d7ee8 100644
--- a/translate/grt/grt-sdf.adb
+++ b/translate/grt/grt-sdf.adb
@@ -132,7 +132,7 @@ package body Grt.Sdf is
Read_Sdf;
end Read_Append;
- procedure Error_Sdf (Msg : String) is
+ procedure Error_Sdf_C is
begin
Error_C (Sdf_Filename.all);
Error_C (":");
@@ -140,6 +140,11 @@ package body Grt.Sdf is
Error_C (":");
Error_C (Pos - Line_Start);
Error_C (": ");
+ end Error_Sdf_C;
+
+ procedure Error_Sdf (Msg : String) is
+ begin
+ Error_Sdf_C;
Error_E (Msg);
end Error_Sdf;
@@ -525,6 +530,7 @@ package body Grt.Sdf is
-- Status of a parsing.
-- ERROR: parse error (syntax is not correct)
+ -- ALTERN: alternate construct parsed (ie simple RNUMBER for tc_rvalue).
-- OPTIONAL: the construct is absent.
-- FOUND: the construct is present.
-- SET: the construct is present and a value was extracted from.
@@ -737,6 +743,7 @@ package body Grt.Sdf is
Tok : Sdf_Token_Type;
Res : Parse_Status_Type;
begin
+ -- '('
if Get_Token /= Tok_Oparen then
Error_Sdf (Tok_Oparen);
return Status_Error;
@@ -748,12 +755,7 @@ package body Grt.Sdf is
Tok := Get_Token;
if Tok = Tok_Cparen then
-- This is a simple RNUMBER.
- if Get_Token = Tok_Cparen then
- return Status_Altern;
- else
- Error_Sdf (Tok_Cparen);
- return Status_Error;
- end if;
+ return Status_Altern;
end if;
if Sdf_Mtm = Minimum then
Res := Status_Set;
@@ -825,6 +827,10 @@ package body Grt.Sdf is
when Status_Error =>
return False;
when Status_Altern =>
+ Sdf_Context.Timing_Nbr := 1;
+ if Get_Token /= Tok_Cparen then
+ Error_Sdf (Tok_Cparen);
+ end if;
return True;
when Status_Found
| Status_Optional =>
@@ -980,7 +986,9 @@ package body Grt.Sdf is
end if;
Vital_Annotate.Sdf_Generic (Sdf_Context.all, Name (1 .. Len), Ok);
if not Ok then
- Error_Sdf ("could not annotate generic");
+ Error_Sdf_C;
+ Error_C ("could not annotate generic ");
+ Error_E (Name (1 .. Len));
return False;
end if;
return True;
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index bbbc736..8704aab 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -145,7 +145,8 @@ package body Grt.Signals is
Mode => Mode,
Flags => (Propag => Propag_None,
Is_Dumped => False,
- Cyc_Event => False),
+ Cyc_Event => False,
+ Seen => False),
Net => No_Signal_Net,
Link => null,
@@ -3290,7 +3291,8 @@ package body Grt.Signals is
Flags => (Propag => Propag_None,
Is_Dumped => False,
- Cyc_Event => False),
+ Cyc_Event => False,
+ Seen => False),
Net => No_Signal_Net,
Link => null,
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index 2ada098..bab73ce 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -225,6 +225,10 @@ package Grt.Signals is
-- Set when an event occured.
-- Only reset by GHW file dumper.
Cyc_Event : Boolean;
+
+ -- Set if the signal has already been visited. When outside of the
+ -- algorithm that use it, it must be cleared.
+ Seen : Boolean;
end record;
pragma Pack (Ghdl_Signal_Flags);
diff --git a/translate/grt/grt-table.adb b/translate/grt/grt-table.adb
index f570b40..739322c 100644
--- a/translate/grt/grt-table.adb
+++ b/translate/grt/grt-table.adb
@@ -22,7 +22,7 @@ with Grt.C; use Grt.C;
package body Grt.Table is
-- Maximum index of table before resizing.
- Max : Table_Index_Type := Table_Low_Bound - 1;
+ Max : Table_Index_Type := Table_Index_Type'Pred (Table_Low_Bound);
-- Current value of Last
Last_Val : Table_Index_Type;
@@ -62,7 +62,7 @@ package body Grt.Table is
procedure Decrement_Last is
begin
- Last_Val := Last_Val - 1;
+ Last_Val := Table_Index_Type'Pred (Last_Val);
end Decrement_Last;
procedure Free is
@@ -73,7 +73,7 @@ package body Grt.Table is
procedure Increment_Last is
begin
- Last_Val := Last_Val + 1;
+ Last_Val := Table_Index_Type'Succ (Last_Val);
if Last_Val > Max then
Resize;
@@ -105,7 +105,7 @@ package body Grt.Table is
end Set_Last;
begin
- Last_Val := Table_Low_Bound - 1;
+ Last_Val := Table_Index_Type'Pred (Table_Low_Bound);
Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1;
Table := Malloc (size_t (Table_Initial *
diff --git a/translate/grt/grt-vital_annotate.adb b/translate/grt/grt-vital_annotate.adb
index 2e7987c..b909f22 100644
--- a/translate/grt/grt-vital_annotate.adb
+++ b/translate/grt/grt-vital_annotate.adb
@@ -229,6 +229,8 @@ package body Grt.Vital_Annotate is
end Sdf_Instance_End;
VitalDelayType01 : VhpiHandleT;
+ VitalDelayType01Z : VhpiHandleT;
+ VitalDelayType01ZX : VhpiHandleT;
VitalDelayArrayType01 : VhpiHandleT;
VitalDelayType : VhpiHandleT;
VitalDelayArrayType : VhpiHandleT;
@@ -236,8 +238,8 @@ package body Grt.Vital_Annotate is
type Map_Type is array (1 .. 12) of Natural;
Map_1 : constant Map_Type := (1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0);
Map_2 : constant Map_Type := (1, 2, 1, 1, 2, 2, 0, 0, 0, 0, 0, 0);
- --Map_3 : constant Map_Type := (1, 2, 3, 1, 3, 2, 0, 0, 0, 0, 0, 0);
- --Map_6 : constant Map_Type := (1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 0);
+ Map_3 : constant Map_Type := (1, 2, 3, 1, 3, 2, 0, 0, 0, 0, 0, 0);
+ Map_6 : constant Map_Type := (1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 0);
--Map_12 : constant Map_Type := (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);
function Write_Td_Delay_Generic (Context : Sdf_Context_Type;
@@ -296,6 +298,20 @@ package body Grt.Vital_Annotate is
Errors.Error
("timing generic type mismatch SDF timing specification");
end case;
+ elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01Z) then
+ case Context.Timing_Nbr is
+ when 1 =>
+ return Write_Td_Delay_Generic (Context, Gen, 6, Map_1);
+ when 2 =>
+ return Write_Td_Delay_Generic (Context, Gen, 6, Map_2);
+ when 3 =>
+ return Write_Td_Delay_Generic (Context, Gen, 6, Map_3);
+ when 6 =>
+ return Write_Td_Delay_Generic (Context, Gen, 6, Map_6);
+ when others =>
+ Errors.Error
+ ("timing generic type mismatch SDF timing specification");
+ end case;
elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType) then
if Vhpi_Put_Value (Gen, Context.Timing (1) * 1000) /= AvhpiErrorOk
then
@@ -406,7 +422,10 @@ package body Grt.Vital_Annotate is
Internal_Error ("vhpiBaseType");
return;
end if;
- if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01) then
+ if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01)
+ or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01Z)
+ or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01ZX)
+ then
Ok := Write_Td_Delay_Generic (Context, Gen);
elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType01)
or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType)
@@ -451,7 +470,8 @@ package body Grt.Vital_Annotate is
Ok := Write_Td_Delay_Generic (Context, Gen_El);
end;
else
- Errors.Error ("vital: unhandled generic type");
+ Errors.Error_C ("vital: unhandled generic type for generic ");
+ Errors.Error_E (Name);
end if;
end Sdf_Generic;
@@ -483,8 +503,8 @@ package body Grt.Vital_Annotate is
-- Instance element.
S := E;
while Arg (E) /= '=' and Arg (E) /= '.' and Arg (E) /= '/' loop
- exit L1 when E > Arg'Last;
E := E + 1;
+ exit L1 when E > Arg'Last;
end loop;
-- Path element.
@@ -545,6 +565,10 @@ package body Grt.Vital_Annotate is
if Status = AvhpiErrorOk then
if Name_Compare (Decl, "vitaldelaytype01") then
VitalDelayType01 := Basetype;
+ elsif Name_Compare (Decl, "vitaldelaytype01z") then
+ VitalDelayType01Z := Basetype;
+ elsif Name_Compare (Decl, "vitaldelaytype01zx") then
+ VitalDelayType01ZX := Basetype;
elsif Name_Compare (Decl, "vitaldelayarraytype01") then
VitalDelayArrayType01 := Basetype;
elsif Name_Compare (Decl, "vitaldelaytype") then
@@ -559,6 +583,14 @@ package body Grt.Vital_Annotate is
Error ("cannot find VitalDelayType01 in ieee.vital_timing");
return;
end if;
+ if Vhpi_Get_Kind (VitalDelayType01Z) = VhpiUndefined then
+ Error ("cannot find VitalDelayType01Z in ieee.vital_timing");
+ return;
+ end if;
+ if Vhpi_Get_Kind (VitalDelayType01ZX) = VhpiUndefined then
+ Error ("cannot find VitalDelayType01ZX in ieee.vital_timing");
+ return;
+ end if;
if Vhpi_Get_Kind (VitalDelayArrayType01) = VhpiUndefined then
Error ("cannot find VitalDelayArrayType01 in ieee.vital_timing");
return;
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
index 62c1ae4..c4319c8 100644
--- a/translate/grt/grt-waves.adb
+++ b/translate/grt/grt-waves.adb
@@ -633,13 +633,16 @@ package body Grt.Waves is
| Ghdl_Rtik_Subtype_Array_Ptr =>
declare
Arr : Ghdl_Rtin_Subtype_Array_Acc;
+ B_Ctxt : Rti_Context;
begin
Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
Create_String_Id (Arr.Name);
- if Rti.Mode = 1 then
- N_Ctxt := Ctxt;
+ if Rti.Mode = Ghdl_Rti_Type_Complex then
+ B_Ctxt := Ctxt;
+ else
+ B_Ctxt := N_Ctxt;
end if;
- Create_Type (To_Ghdl_Rti_Access (Arr.Basetype), N_Ctxt);
+ Create_Type (To_Ghdl_Rti_Access (Arr.Basetype), B_Ctxt);
end;
when Ghdl_Rtik_Type_Array =>
declare
@@ -823,10 +826,12 @@ package body Grt.Waves is
procedure Write_Signal_Number (Val_Addr : Address;
Val_Name : Vstring;
- Val_Type : Ghdl_Rti_Access)
+ Val_Type : Ghdl_Rti_Access;
+ Param_Type : Natural)
is
pragma Unreferenced (Val_Name);
pragma Unreferenced (Val_Type);
+ pragma Unreferenced (Param_Type);
Num : Natural;
@@ -853,7 +858,8 @@ package body Grt.Waves is
end Write_Signal_Number;
procedure Foreach_Scalar_Signal_Number is new
- Grt.Rtis_Utils.Foreach_Scalar (Process => Write_Signal_Number);
+ Grt.Rtis_Utils.Foreach_Scalar (Param_Type => Natural,
+ Process => Write_Signal_Number);
procedure Write_Signal_Numbers (Decl : VhpiHandleT)
is
@@ -864,7 +870,7 @@ package body Grt.Waves is
Sig := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Decl));
Foreach_Scalar_Signal_Number
(Ctxt, Sig.Obj_Type,
- Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
+ Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True, 0);
end Write_Signal_Numbers;
procedure Write_Hierarchy_El (Decl : VhpiHandleT)
generated by cgit (git 2.34.1) at 2024-12-21 14:31:52 +0000