aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2017-04-27 04:45:49 +0200
committerTristan Gingold <tgingold@free.fr>2017-05-09 21:16:25 +0200
commitc00e693a478890068c90804e0e64d79f14f5c2aa (patch)
treec1934ca103d954124a74d379b8e61e9ada8fdffd /src
parent47b7ace6a702830d33fb1a26bc49e9362147aa4b (diff)
downloadghdl-c00e693a478890068c90804e0e64d79f14f5c2aa.tar.gz
ghdl-c00e693a478890068c90804e0e64d79f14f5c2aa.tar.bz2
ghdl-c00e693a478890068c90804e0e64d79f14f5c2aa.zip
Create default value for ports.
Fix #328
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdlrun.adb12
-rw-r--r--src/grt/grt-signals.adb82
-rw-r--r--src/grt/grt-signals.ads24
-rw-r--r--src/vhdl/translate/trans-chap1.adb12
-rw-r--r--src/vhdl/translate/trans-chap14.adb35
-rw-r--r--src/vhdl/translate/trans-chap4.adb83
-rw-r--r--src/vhdl/translate/trans-chap4.ads3
-rw-r--r--src/vhdl/translate/trans-chap5.adb84
-rw-r--r--src/vhdl/translate/trans-chap6.adb196
-rw-r--r--src/vhdl/translate/trans-chap6.ads18
-rw-r--r--src/vhdl/translate/trans-chap7.adb15
-rw-r--r--src/vhdl/translate/trans-chap8.adb28
-rw-r--r--src/vhdl/translate/trans-chap9.adb477
-rw-r--r--src/vhdl/translate/trans-chap9.ads6
-rw-r--r--src/vhdl/translate/trans-foreach_non_composite.ads6
-rw-r--r--src/vhdl/translate/trans-helpers2.adb13
-rw-r--r--src/vhdl/translate/trans.ads1
-rw-r--r--src/vhdl/translate/trans_analyzes.adb3
-rw-r--r--src/vhdl/translate/trans_decls.ads32
-rw-r--r--src/vhdl/translate/translation.adb26
20 files changed, 688 insertions, 468 deletions
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 55165fac4..3f0cd10c6 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -363,6 +363,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Next_Assign_B1'Address);
Def (Trans_Decls.Ghdl_Signal_Associate_B1,
Grt.Signals.Ghdl_Signal_Associate_B1'Address);
+ Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_B1,
+ Grt.Signals.Ghdl_Signal_Add_Port_Driver_B1'Address);
Def (Trans_Decls.Ghdl_Create_Signal_E8,
Grt.Signals.Ghdl_Create_Signal_E8'Address);
@@ -376,6 +378,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Next_Assign_E8'Address);
Def (Trans_Decls.Ghdl_Signal_Associate_E8,
Grt.Signals.Ghdl_Signal_Associate_E8'Address);
+ Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_E8,
+ Grt.Signals.Ghdl_Signal_Add_Port_Driver_E8'Address);
Def (Trans_Decls.Ghdl_Create_Signal_E32,
Grt.Signals.Ghdl_Create_Signal_E32'Address);
@@ -389,6 +393,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Next_Assign_E32'Address);
Def (Trans_Decls.Ghdl_Signal_Associate_E32,
Grt.Signals.Ghdl_Signal_Associate_E32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_E32,
+ Grt.Signals.Ghdl_Signal_Add_Port_Driver_E32'Address);
Def (Trans_Decls.Ghdl_Create_Signal_I32,
Grt.Signals.Ghdl_Create_Signal_I32'Address);
@@ -402,6 +408,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Next_Assign_I32'Address);
Def (Trans_Decls.Ghdl_Signal_Associate_I32,
Grt.Signals.Ghdl_Signal_Associate_I32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_I32,
+ Grt.Signals.Ghdl_Signal_Add_Port_Driver_I32'Address);
Def (Trans_Decls.Ghdl_Create_Signal_I64,
Grt.Signals.Ghdl_Create_Signal_I64'Address);
@@ -415,6 +423,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Next_Assign_I64'Address);
Def (Trans_Decls.Ghdl_Signal_Associate_I64,
Grt.Signals.Ghdl_Signal_Associate_I64'Address);
+ Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_I64,
+ Grt.Signals.Ghdl_Signal_Add_Port_Driver_I64'Address);
Def (Trans_Decls.Ghdl_Create_Signal_F64,
Grt.Signals.Ghdl_Create_Signal_F64'Address);
@@ -428,6 +438,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Next_Assign_F64'Address);
Def (Trans_Decls.Ghdl_Signal_Associate_F64,
Grt.Signals.Ghdl_Signal_Associate_F64'Address);
+ Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_F64,
+ Grt.Signals.Ghdl_Signal_Add_Port_Driver_F64'Address);
Def (Trans_Decls.Ghdl_Signal_Attribute_Register_Prefix,
Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix'Address);
diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb
index e5afe588a..a681e1360 100644
--- a/src/grt/grt-signals.adb
+++ b/src/grt/grt-signals.adb
@@ -289,7 +289,6 @@ package body Grt.Signals is
procedure Ghdl_Signal_Init (Sig : Ghdl_Signal_Ptr; Val : Value_Union) is
begin
- Assign (Sig.Value_Ptr, Val, Sig.Mode);
Sig.Driving_Value := Val;
Sig.Last_Value := Val;
end Ghdl_Signal_Init;
@@ -297,9 +296,8 @@ package body Grt.Signals is
procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
Rti : Ghdl_Rti_Access)
is
- S_Rti : Ghdl_Rtin_Object_Acc;
+ S_Rti : constant Ghdl_Rtin_Object_Acc := To_Ghdl_Rtin_Object_Acc (Rti);
begin
- S_Rti := To_Ghdl_Rtin_Object_Acc (Rti);
if Flag_Activity = Activity_Minimal then
if (S_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0 then
Sig.Has_Active := True;
@@ -409,6 +407,21 @@ package body Grt.Signals is
end if;
end Ghdl_Process_Add_Driver;
+ procedure Ghdl_Process_Add_Port_Driver
+ (Sign : Ghdl_Signal_Ptr; Val : Value_Union)
+ is
+ Trans : Transaction_Acc;
+ begin
+ Trans := new Transaction'(Kind => Trans_Value,
+ Line => 0,
+ Time => 0,
+ Next => null,
+ Val => Val);
+ if Ghdl_Signal_Add_Driver (Sign, Trans) then
+ Free (Trans);
+ end if;
+ end Ghdl_Process_Add_Port_Driver;
+
procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr;
Drv : Ghdl_Value_Ptr)
is
@@ -420,7 +433,7 @@ package body Grt.Signals is
Line => 0,
Time => 0,
Next => null,
- Val => Read_Value (Sign.Value_Ptr, Sign.Mode));
+ Val => Read_Value (Drv, Sign.Mode));
if Ghdl_Signal_Add_Driver (Sign, Trans) then
Free (Trans);
return;
@@ -433,9 +446,6 @@ package body Grt.Signals is
Val_Ptr => Drv);
Sign.S.Drivers (Sign.S.Nbr_Drivers - 1).Last_Trans := Trans1;
Trans.Next := Trans1;
-
- -- Initialize driver value.
- Assign (Drv, Sign.Value_Ptr, Sign.Mode);
end Ghdl_Signal_Add_Direct_Driver;
procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr)
@@ -975,6 +985,13 @@ package body Grt.Signals is
Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B1, B1 => Val));
end Ghdl_Signal_Associate_B1;
+ procedure Ghdl_Signal_Add_Port_Driver_B1
+ (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is
+ begin
+ Ghdl_Process_Add_Port_Driver
+ (Sig, Value_Union'(Mode => Mode_B1, B1 => Val));
+ end Ghdl_Signal_Add_Port_Driver_B1;
+
procedure Ghdl_Signal_Simple_Assign_B1 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_B1)
is
@@ -1044,6 +1061,13 @@ package body Grt.Signals is
Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E8, E8 => Val));
end Ghdl_Signal_Associate_E8;
+ procedure Ghdl_Signal_Add_Port_Driver_E8
+ (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is
+ begin
+ Ghdl_Process_Add_Port_Driver
+ (Sig, Value_Union'(Mode => Mode_E8, E8 => Val));
+ end Ghdl_Signal_Add_Port_Driver_E8;
+
procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_E8)
is
@@ -1115,6 +1139,13 @@ package body Grt.Signals is
Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val));
end Ghdl_Signal_Associate_E32;
+ procedure Ghdl_Signal_Add_Port_Driver_E32
+ (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32) is
+ begin
+ Ghdl_Process_Add_Port_Driver
+ (Sig, Value_Union'(Mode => Mode_E32, E32 => Val));
+ end Ghdl_Signal_Add_Port_Driver_E32;
+
procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_E32)
is
@@ -1186,6 +1217,13 @@ package body Grt.Signals is
Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I32, I32 => Val));
end Ghdl_Signal_Associate_I32;
+ procedure Ghdl_Signal_Add_Port_Driver_I32
+ (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32) is
+ begin
+ Ghdl_Process_Add_Port_Driver
+ (Sig, Value_Union'(Mode => Mode_I32, I32 => Val));
+ end Ghdl_Signal_Add_Port_Driver_I32;
+
procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_I32)
is
@@ -1257,6 +1295,13 @@ package body Grt.Signals is
Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I64, I64 => Val));
end Ghdl_Signal_Associate_I64;
+ procedure Ghdl_Signal_Add_Port_Driver_I64
+ (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64) is
+ begin
+ Ghdl_Process_Add_Port_Driver
+ (Sig, Value_Union'(Mode => Mode_I64, I64 => Val));
+ end Ghdl_Signal_Add_Port_Driver_I64;
+
procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_I64)
is
@@ -1328,6 +1373,13 @@ package body Grt.Signals is
Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_F64, F64 => Val));
end Ghdl_Signal_Associate_F64;
+ procedure Ghdl_Signal_Add_Port_Driver_F64
+ (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64) is
+ begin
+ Ghdl_Process_Add_Port_Driver
+ (Sig, Value_Union'(Mode => Mode_F64, F64 => Val));
+ end Ghdl_Signal_Add_Port_Driver_F64;
+
procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_F64)
is
@@ -3478,6 +3530,13 @@ package body Grt.Signals is
end loop;
end Run_Propagation_Init;
+ -- LRM93 12.6.4 The simulation cycle
+ -- The initialization phase consists of the following steps:
+ -- - The driving value and the effective value of each explicitly
+ -- declared signal are computed, and the current value of the signal
+ -- is set to the effective value. This value is assumed to have been
+ -- the value of the signal for an infinite length of time prior to
+ -- the start of the simulation.
procedure Init_Signals
is
Sig : Ghdl_Signal_Ptr;
@@ -3488,8 +3547,11 @@ package body Grt.Signals is
case Sig.Net is
when Net_One_Driver
| Net_One_Direct =>
- -- Nothing to do: drivers were already created.
- null;
+ -- Use the current value of the transaction for the current
+ -- value of the signal.
+ Assign (Sig.Driving_Value,
+ Sig.S.Drivers (0).First_Trans.Val, Sig.Mode);
+ Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode);
when Net_One_Resolved =>
Sig.Has_Active := True;
@@ -3499,7 +3561,7 @@ package body Grt.Signals is
end if;
when No_Signal_Net =>
- null;
+ Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode);
when others =>
if Propagation.Table (Sig.Net).Updated then
diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads
index eaecdd0be..1c27789c6 100644
--- a/src/grt/grt-signals.ads
+++ b/src/grt/grt-signals.ads
@@ -585,6 +585,8 @@ package Grt.Signals is
procedure Ghdl_Signal_Next_Assign_B1 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_B1;
After : Std_Time);
+ procedure Ghdl_Signal_Add_Port_Driver_B1 (Sig : Ghdl_Signal_Ptr;
+ Val : Ghdl_B1);
function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr)
return Ghdl_B1;
procedure Ghdl_Signal_Force_Driving_B1 (Sig : Ghdl_Signal_Ptr;
@@ -607,6 +609,8 @@ package Grt.Signals is
procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_E8;
After : Std_Time);
+ procedure Ghdl_Signal_Add_Port_Driver_E8 (Sig : Ghdl_Signal_Ptr;
+ Val : Ghdl_E8);
function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
return Ghdl_E8;
procedure Ghdl_Signal_Force_Driving_E8 (Sig : Ghdl_Signal_Ptr;
@@ -629,6 +633,8 @@ package Grt.Signals is
procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_E32;
After : Std_Time);
+ procedure Ghdl_Signal_Add_Port_Driver_E32 (Sig : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32);
function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
return Ghdl_E32;
@@ -647,6 +653,8 @@ package Grt.Signals is
procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_I32;
After : Std_Time);
+ procedure Ghdl_Signal_Add_Port_Driver_I32 (Sig : Ghdl_Signal_Ptr;
+ Val : Ghdl_I32);
function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
return Ghdl_I32;
@@ -665,6 +673,8 @@ package Grt.Signals is
procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_I64;
After : Std_Time);
+ procedure Ghdl_Signal_Add_Port_Driver_I64 (Sig : Ghdl_Signal_Ptr;
+ Val : Ghdl_I64);
function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
return Ghdl_I64;
@@ -683,6 +693,8 @@ package Grt.Signals is
procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr;
Val : Ghdl_F64;
After : Std_Time);
+ procedure Ghdl_Signal_Add_Port_Driver_F64 (Sig : Ghdl_Signal_Ptr;
+ Val : Ghdl_F64);
function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr)
return Ghdl_F64;
@@ -827,6 +839,8 @@ private
"__ghdl_signal_start_assign_b1");
pragma Export (Ada, Ghdl_Signal_Next_Assign_B1,
"__ghdl_signal_next_assign_b1");
+ pragma Export (Ada, Ghdl_Signal_Add_Port_Driver_B1,
+ "__ghdl_signal_add_port_driver_b1");
pragma Export (Ada, Ghdl_Signal_Driving_Value_B1,
"__ghdl_signal_driving_value_b1");
@@ -842,6 +856,8 @@ private
"__ghdl_signal_start_assign_e8");
pragma Export (C, Ghdl_Signal_Next_Assign_E8,
"__ghdl_signal_next_assign_e8");
+ pragma Export (C, Ghdl_Signal_Add_Port_Driver_E8,
+ "__ghdl_signal_add_port_driver_e8");
pragma Export (C, Ghdl_Signal_Driving_Value_E8,
"__ghdl_signal_driving_value_e8");
@@ -857,6 +873,8 @@ private
"__ghdl_signal_start_assign_e32");
pragma Export (C, Ghdl_Signal_Next_Assign_E32,
"__ghdl_signal_next_assign_e32");
+ pragma Export (C, Ghdl_Signal_Add_Port_Driver_E32,
+ "__ghdl_signal_add_port_driver_e32");
pragma Export (C, Ghdl_Signal_Driving_Value_E32,
"__ghdl_signal_driving_value_e32");
@@ -872,6 +890,8 @@ private
"__ghdl_signal_start_assign_i32");
pragma Export (C, Ghdl_Signal_Next_Assign_I32,
"__ghdl_signal_next_assign_i32");
+ pragma Export (C, Ghdl_Signal_Add_Port_Driver_I32,
+ "__ghdl_signal_add_port_driver_i32");
pragma Export (C, Ghdl_Signal_Driving_Value_I32,
"__ghdl_signal_driving_value_i32");
@@ -887,6 +907,8 @@ private
"__ghdl_signal_start_assign_i64");
pragma Export (C, Ghdl_Signal_Next_Assign_I64,
"__ghdl_signal_next_assign_i64");
+ pragma Export (C, Ghdl_Signal_Add_Port_Driver_I64,
+ "__ghdl_signal_add_port_driver_i64");
pragma Export (C, Ghdl_Signal_Driving_Value_I64,
"__ghdl_signal_driving_value_i64");
@@ -902,6 +924,8 @@ private
"__ghdl_signal_start_assign_f64");
pragma Export (C, Ghdl_Signal_Next_Assign_F64,
"__ghdl_signal_next_assign_f64");
+ pragma Export (C, Ghdl_Signal_Add_Port_Driver_F64,
+ "__ghdl_signal_add_port_driver_f64");
pragma Export (C, Ghdl_Signal_Driving_Value_F64,
"__ghdl_signal_driving_value_f64");
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index d3f3be69b..68f4acd57 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -77,6 +77,7 @@ package body Trans.Chap1 is
El : Iir;
El_Type : Iir;
Default : Iir;
+ Value : Iir;
begin
Push_Local_Factory;
@@ -93,6 +94,17 @@ package body Trans.Chap1 is
end if;
Chap4.Elab_Signal_Declaration_Storage (El, False);
Chap4.Elab_Signal_Declaration_Object (El, Entity, False);
+
+ Value := Get_Default_Value (El);
+ if Is_Valid (Value) then
+ -- Set default value.
+ Chap9.Destroy_Types (Value);
+ Chap4.Elab_Object_Init
+ (Get_Var (Get_Info (El).Signal_Val,
+ Get_Info (Get_Type (El)), Mode_Value),
+ El, Value, Alloc_System);
+ end if;
+
Close_Temp;
El := Get_Chain (El);
diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb
index 3d0cf7d50..8fd37261b 100644
--- a/src/vhdl/translate/trans-chap14.adb
+++ b/src/vhdl/translate/trans-chap14.adb
@@ -403,24 +403,14 @@ package body Trans.Chap14 is
return Data;
end Bool_Sigattr_Update_Data_Record;
- procedure Bool_Sigattr_Finish_Data_Composite
- (Data : in out Bool_Sigattr_Data_Type)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Bool_Sigattr_Finish_Data_Composite;
-
procedure Bool_Sigattr_Foreach is new Foreach_Non_Composite
(Data_Type => Bool_Sigattr_Data_Type,
Composite_Data_Type => Bool_Sigattr_Data_Type,
Do_Non_Composite => Bool_Sigattr_Non_Composite_Signal,
Prepare_Data_Array => Bool_Sigattr_Prepare_Data_Composite,
Update_Data_Array => Bool_Sigattr_Update_Data_Array,
- Finish_Data_Array => Bool_Sigattr_Finish_Data_Composite,
Prepare_Data_Record => Bool_Sigattr_Prepare_Data_Composite,
- Update_Data_Record => Bool_Sigattr_Update_Data_Record,
- Finish_Data_Record => Bool_Sigattr_Finish_Data_Composite);
+ Update_Data_Record => Bool_Sigattr_Update_Data_Record);
function Translate_Bool_Signal_Attribute (Attr : Iir; Field : O_Fnode)
return O_Enode
@@ -570,24 +560,14 @@ package body Trans.Chap14 is
return Data;
end Last_Time_Update_Data_Record;
- procedure Last_Time_Finish_Data_Composite
- (Data : in out Last_Time_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Last_Time_Finish_Data_Composite;
-
procedure Translate_Last_Time is new Foreach_Non_Composite
(Data_Type => Last_Time_Data,
Composite_Data_Type => Last_Time_Data,
Do_Non_Composite => Translate_Last_Time_Non_Composite,
Prepare_Data_Array => Last_Time_Prepare_Data_Composite,
Update_Data_Array => Last_Time_Update_Data_Array,
- Finish_Data_Array => Last_Time_Finish_Data_Composite,
Prepare_Data_Record => Last_Time_Prepare_Data_Composite,
- Update_Data_Record => Last_Time_Update_Data_Record,
- Finish_Data_Record => Last_Time_Finish_Data_Composite);
+ Update_Data_Record => Last_Time_Update_Data_Record);
function Translate_Last_Time_Attribute (Prefix : Iir; Field : O_Fnode)
return O_Enode
@@ -692,23 +672,14 @@ package body Trans.Chap14 is
return Label;
end Driving_Update_Data_Record;
- procedure Driving_Finish_Data_Composite (Label : in out O_Snode)
- is
- pragma Unreferenced (Label);
- begin
- null;
- end Driving_Finish_Data_Composite;
-
procedure Driving_Foreach is new Foreach_Non_Composite
(Data_Type => O_Snode,
Composite_Data_Type => O_Snode,
Do_Non_Composite => Driving_Non_Composite_Signal,
Prepare_Data_Array => Driving_Prepare_Data_Composite,
Update_Data_Array => Driving_Update_Data_Array,
- Finish_Data_Array => Driving_Finish_Data_Composite,
Prepare_Data_Record => Driving_Prepare_Data_Composite,
- Update_Data_Record => Driving_Update_Data_Record,
- Finish_Data_Record => Driving_Finish_Data_Composite);
+ Update_Data_Record => Driving_Update_Data_Record);
function Translate_Driving_Attribute (Attr : Iir) return O_Enode
is
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 58bb614ce..44e1a6f9c 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -219,6 +219,13 @@ package body Trans.Chap4 is
Info.Signal_Valp := Create_Var
(Create_Var_Identifier (Decl, "_VALP", 0),
Get_Object_Ptr_Type (Type_Info, Mode_Value));
+
+ if Get_Default_Value (Decl) /= Null_Iir then
+ -- Default value for ports.
+ Info.Signal_Val := Create_Var
+ (Create_Var_Identifier (Decl, "_INIT", 0),
+ Get_Object_Type (Type_Info, Mode_Value));
+ end if;
else
Info.Signal_Val := Create_Var
(Create_Var_Identifier (Decl, "_VAL", 0),
@@ -499,20 +506,15 @@ package body Trans.Chap4 is
end Elab_Object_Storage;
-- Generate code to create object OBJ and initialize it with value VAL.
- procedure Elab_Object_Init (Name : Mnode; Obj : Iir; Value : Iir)
+ procedure Elab_Object_Init
+ (Name : Mnode; Obj : Iir; Value : Iir; Alloc_Kind : Allocation_Kind)
is
Obj_Type : constant Iir := Get_Type (Obj);
Type_Info : constant Type_Info_Acc := Get_Info (Obj_Type);
- Obj_Info : constant Object_Info_Acc := Get_Info (Obj);
Name_Node : Mnode;
Value_Node : O_Enode;
-
- Alloc_Kind : Allocation_Kind;
begin
- -- Elaborate subtype.
- Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var);
-
-- Note: no temporary variable region is created, as the allocation
-- may be performed on the stack.
@@ -571,12 +573,14 @@ package body Trans.Chap4 is
-- Generate code to create object OBJ and initialize it with value VAL.
procedure Elab_Object_Value (Obj : Iir; Value : Iir)
is
- Name : Mnode;
+ Obj_Info : constant Object_Info_Acc := Get_Info (Obj);
+ Alloc_Kind : constant Allocation_Kind :=
+ Get_Alloc_Kind_For_Var (Obj_Info.Object_Var);
+ Name : constant Mnode :=
+ Get_Var (Obj_Info.Object_Var, Get_Info (Get_Type (Obj)), Mode_Value);
begin
Elab_Object_Storage (Obj);
- Name := Get_Var (Get_Info (Obj).Object_Var,
- Get_Info (Get_Type (Obj)), Mode_Value);
- Elab_Object_Init (Name, Obj, Value);
+ Elab_Object_Init (Name, Obj, Value, Alloc_Kind);
end Elab_Object_Value;
-- Create code to elaborate OBJ.
@@ -1004,6 +1008,8 @@ package body Trans.Chap4 is
-- Elaborate signal subtypes and allocate the storage for the object.
procedure Elab_Signal_Declaration_Storage (Decl : Iir; Has_Copy : Boolean)
is
+ Is_Port : constant Boolean :=
+ Get_Kind (Decl) = Iir_Kind_Interface_Signal_Declaration;
Sig_Type : constant Iir := Get_Type (Decl);
Type_Info : Type_Info_Acc;
Name_Sig : Mnode;
@@ -1021,26 +1027,37 @@ package body Trans.Chap4 is
-- bounds have already been set.
if Has_Copy then
Name_Sig := Chap6.Translate_Name (Decl, Mode_Signal);
+ Name_Val := Mnode_Null;
else
Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val);
end if;
Name_Sig := Stabilize (Name_Sig);
Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Sig, Sig_Type);
- if not Has_Copy then
+ if Name_Val /= Mnode_Null then
+ Name_Val := Stabilize (Name_Val);
+ Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Val, Sig_Type);
+ end if;
+ if Is_Port and then Get_Default_Value (Decl) /= Null_Iir then
+ Name_Val := Chap6.Get_Port_Init_Value (Decl);
Name_Val := Stabilize (Name_Val);
Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Val, Sig_Type);
end if;
elsif Is_Complex_Type (Type_Info) then
if Has_Copy then
Name_Sig := Chap6.Translate_Name (Decl, Mode_Signal);
+ Name_Val := Mnode_Null;
else
Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val);
end if;
Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Sig);
- if not Has_Copy then
+ if Name_Val /= Mnode_Null then
Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Val);
end if;
- elsif Get_Kind (Decl) = Iir_Kind_Interface_Signal_Declaration then
+ if Is_Port and then Get_Default_Value (Decl) /= Null_Iir then
+ Name_Val := Chap6.Get_Port_Init_Value (Decl);
+ Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Val);
+ end if;
+ elsif Is_Port then
if not Has_Copy then
-- A port that isn't collapsed. Allocate value.
Name_Val := Chap6.Translate_Name (Decl, Mode_Value);
@@ -1306,24 +1323,14 @@ package body Trans.Chap4 is
Param => Data.Param);
end Create_Delayed_Signal_Update_Data_Record;
- procedure Create_Delayed_Signal_Finish_Data_Composite
- (Data : in out Delayed_Signal_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Create_Delayed_Signal_Finish_Data_Composite;
-
procedure Create_Delayed_Signal is new Foreach_Non_Composite
(Data_Type => Delayed_Signal_Data,
Composite_Data_Type => Delayed_Signal_Data,
Do_Non_Composite => Create_Delayed_Signal_Noncomposite,
Prepare_Data_Array => Create_Delayed_Signal_Prepare_Composite,
Update_Data_Array => Create_Delayed_Signal_Update_Data_Array,
- Finish_Data_Array => Create_Delayed_Signal_Finish_Data_Composite,
Prepare_Data_Record => Create_Delayed_Signal_Prepare_Composite,
- Update_Data_Record => Create_Delayed_Signal_Update_Data_Record,
- Finish_Data_Record => Create_Delayed_Signal_Finish_Data_Composite);
+ Update_Data_Record => Create_Delayed_Signal_Update_Data_Record);
procedure Elab_Signal_Delayed_Attribute (Decl : Iir)
is
@@ -1498,15 +1505,11 @@ package body Trans.Chap4 is
Chap3.Translate_Named_Type_Definition (Decl_Type, Get_Identifier (Decl));
Info := Add_Info (Decl, Kind_Alias);
- case Get_Kind (Get_Object_Prefix (Decl)) is
- when Iir_Kind_Signal_Declaration
- | Iir_Kind_Interface_Signal_Declaration
- | Iir_Kind_Guard_Signal_Declaration
- | Iir_Kinds_Signal_Attribute =>
- Info.Alias_Kind := Mode_Signal;
- when others =>
- Info.Alias_Kind := Mode_Value;
- end case;
+ if Is_Signal_Name (Decl) then
+ Info.Alias_Kind := Mode_Signal;
+ else
+ Info.Alias_Kind := Mode_Value;
+ end if;
Tinfo := Get_Info (Decl_Type);
for Mode in Mode_Value .. Info.Alias_Kind loop
@@ -1898,24 +1901,14 @@ package body Trans.Chap4 is
Kind => Data.Kind);
end Read_Source_Update_Data_Record;
- procedure Read_Source_Finish_Data_Composite
- (Data : in out Read_Source_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Read_Source_Finish_Data_Composite;
-
procedure Read_Signal_Source is new Foreach_Non_Composite
(Data_Type => Read_Source_Data,
Composite_Data_Type => Read_Source_Data,
Do_Non_Composite => Read_Source_Non_Composite,
Prepare_Data_Array => Read_Source_Prepare_Data_Array,
Update_Data_Array => Read_Source_Update_Data_Array,
- Finish_Data_Array => Read_Source_Finish_Data_Composite,
Prepare_Data_Record => Read_Source_Prepare_Data_Record,
- Update_Data_Record => Read_Source_Update_Data_Record,
- Finish_Data_Record => Read_Source_Finish_Data_Composite);
+ Update_Data_Record => Read_Source_Update_Data_Record);
procedure Translate_Resolution_Function_Body (Func : Iir)
is
diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads
index 50fe23e69..cfc1917fe 100644
--- a/src/vhdl/translate/trans-chap4.ads
+++ b/src/vhdl/translate/trans-chap4.ads
@@ -100,7 +100,8 @@ package Trans.Chap4 is
function Get_Scalar_Initial_Value (Atype : Iir) return O_Enode;
-- Initialize NAME/OBJ with VALUE.
- procedure Elab_Object_Init (Name : Mnode; Obj : Iir; Value : Iir);
+ procedure Elab_Object_Init
+ (Name : Mnode; Obj : Iir; Value : Iir; Alloc_Kind : Allocation_Kind);
-- Get the ortho type for an object of type TINFO.
function Get_Object_Type (Tinfo : Type_Info_Acc; Kind : Object_Kind_Type)
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index cc068b754..f4efc4103 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -98,9 +98,8 @@ package body Trans.Chap5 is
end loop;
end Elab_Attribute_Specification;
- procedure Gen_Elab_Disconnect_Non_Composite (Targ : Mnode;
- Targ_Type : Iir;
- Time : O_Dnode)
+ procedure Gen_Elab_Disconnect_Non_Composite
+ (Targ : Mnode; Targ_Type : Iir; Time : O_Dnode)
is
pragma Unreferenced (Targ_Type);
Assoc : O_Assoc_List;
@@ -113,18 +112,15 @@ package body Trans.Chap5 is
end Gen_Elab_Disconnect_Non_Composite;
function Gen_Elab_Disconnect_Prepare
- (Targ : Mnode; Targ_Type : Iir; Time : O_Dnode)
- return O_Dnode
+ (Targ : Mnode; Targ_Type : Iir; Time : O_Dnode) return O_Dnode
is
pragma Unreferenced (Targ, Targ_Type);
begin
return Time;
end Gen_Elab_Disconnect_Prepare;
- function Gen_Elab_Disconnect_Update_Data_Array (Time : O_Dnode;
- Targ_Type : Iir;
- Index : O_Dnode)
- return O_Dnode
+ function Gen_Elab_Disconnect_Update_Data_Array
+ (Time : O_Dnode; Targ_Type : Iir; Index : O_Dnode) return O_Dnode
is
pragma Unreferenced (Targ_Type, Index);
begin
@@ -133,31 +129,21 @@ package body Trans.Chap5 is
function Gen_Elab_Disconnect_Update_Data_Record
(Time : O_Dnode; Targ_Type : Iir; El : Iir_Element_Declaration)
- return O_Dnode
+ return O_Dnode
is
pragma Unreferenced (Targ_Type, El);
begin
return Time;
end Gen_Elab_Disconnect_Update_Data_Record;
- procedure Gen_Elab_Disconnect_Finish_Data_Composite
- (Data : in out O_Dnode)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Gen_Elab_Disconnect_Finish_Data_Composite;
-
procedure Gen_Elab_Disconnect is new Foreach_Non_Composite
(Data_Type => O_Dnode,
Composite_Data_Type => O_Dnode,
Do_Non_Composite => Gen_Elab_Disconnect_Non_Composite,
Prepare_Data_Array => Gen_Elab_Disconnect_Prepare,
Update_Data_Array => Gen_Elab_Disconnect_Update_Data_Array,
- Finish_Data_Array => Gen_Elab_Disconnect_Finish_Data_Composite,
Prepare_Data_Record => Gen_Elab_Disconnect_Prepare,
- Update_Data_Record => Gen_Elab_Disconnect_Update_Data_Record,
- Finish_Data_Record => Gen_Elab_Disconnect_Finish_Data_Composite);
+ Update_Data_Record => Gen_Elab_Disconnect_Update_Data_Record);
procedure Elab_Disconnection_Specification
(Spec : Iir_Disconnection_Specification)
@@ -349,23 +335,14 @@ package body Trans.Chap5 is
return Res;
end Connect_Update_Data_Record;
- procedure Connect_Finish_Data_Composite (Data : in out Connect_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Connect_Finish_Data_Composite;
-
procedure Connect is new Foreach_Non_Composite
(Data_Type => Connect_Data,
Composite_Data_Type => Connect_Data,
Do_Non_Composite => Connect_Scalar,
Prepare_Data_Array => Connect_Prepare_Data_Composite,
Update_Data_Array => Connect_Update_Data_Array,
- Finish_Data_Array => Connect_Finish_Data_Composite,
Prepare_Data_Record => Connect_Prepare_Data_Composite,
- Update_Data_Record => Connect_Update_Data_Record,
- Finish_Data_Record => Connect_Finish_Data_Composite);
+ Update_Data_Record => Connect_Update_Data_Record);
procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir;
Formal : Iir;
@@ -381,6 +358,7 @@ package body Trans.Chap5 is
Formal_Val : Mnode;
Actual_Sig : Mnode;
Actual_Val : Mnode;
+ Init_Node : Mnode;
Actual_En : O_Enode;
Data : Connect_Data;
Mode : Connect_Mode;
@@ -471,6 +449,21 @@ package body Trans.Chap5 is
Mode => Mode,
By_Copy => By_Copy);
Connect (Formal_Sig, Formal_Type, Data);
+
+ -- Set driving value
+ if By_Copy
+ and then (Mode = Connect_Both or Mode = Connect_Source)
+ then
+ Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal);
+
+ if Is_Valid (Get_Default_Value (Port)) then
+ Init_Node := Chap6.Get_Port_Init_Value (Formal);
+ else
+ Init_Node := Mnode_Null;
+ end if;
+ Chap9.Gen_Port_Init_Driving
+ (Formal_Sig, Formal_Type, Init_Node);
+ end if;
else
if Get_In_Conversion (Assoc) /= Null_Iir then
Chap4.Elab_In_Conversion (Assoc, Formal, Actual_Sig);
@@ -610,6 +603,7 @@ package body Trans.Chap5 is
-- Set bounds for PORT.
procedure Elab_Unconstrained_Port_Bounds (Port : Iir; Assoc : Iir)
is
+ Info : Signal_Info_Acc;
Bounds : Mnode;
Act_Node : Mnode;
begin
@@ -645,6 +639,14 @@ package body Trans.Chap5 is
M2Lp (Chap3.Get_Array_Bounds (Act_Node)),
M2Addr (Bounds));
end loop;
+
+ -- Set bounds of init value (if present)
+ Info := Get_Info (Port);
+ if Info.Signal_Val /= Null_Var then
+ New_Assign_Stmt
+ (M2Lp (Chap3.Get_Array_Bounds (Chap6.Get_Port_Init_Value (Port))),
+ M2Addr (Bounds));
+ end if;
Close_Temp;
end Elab_Unconstrained_Port_Bounds;
@@ -654,6 +656,7 @@ package body Trans.Chap5 is
Actual_Env : Map_Env;
Assoc : Iir;
Inter : Iir;
+ Value : Iir;
begin
Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr);
@@ -668,7 +671,8 @@ package body Trans.Chap5 is
Fbt_Info : constant Type_Info_Acc := Get_Info (Fb_Type);
begin
Set_Map_Env (Formal_Env);
- -- Set bounds of unconstrained ports.
+
+ -- Set bounds of unbounded ports.
if Get_Whole_Association_Flag (Assoc)
and then Fbt_Info.Type_Mode in Type_Mode_Unbounded
then
@@ -678,6 +682,7 @@ package body Trans.Chap5 is
end if;
-- Allocate storage of ports.
+ -- (Only once for each port, individual association are ignored).
Open_Temp;
case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is
when Iir_Kind_Association_Element_By_Individual
@@ -698,6 +703,15 @@ package body Trans.Chap5 is
when Iir_Kind_Association_Element_By_Expression =>
if Get_Whole_Association_Flag (Assoc) then
if Get_Collapse_Signal_Flag (Assoc) then
+ Value := Get_Default_Value (Formal_Base);
+ if Is_Valid (Value) then
+ -- Set default value.
+ Chap9.Destroy_Types (Value);
+ Chap4.Elab_Object_Init
+ (Get_Var (Get_Info (Formal_Base).Signal_Val,
+ Fbt_Info, Mode_Value),
+ Inter, Value, Alloc_System);
+ end if;
-- For collapsed association, copy signals.
Elab_Port_Map_Aspect_Assoc
(Assoc, Formal, True, Formal_Env, Actual_Env);
@@ -711,8 +725,8 @@ package body Trans.Chap5 is
end if;
else
-- By sub-element.
- -- Either the whole signal is collapsed or it was already
- -- created.
+ -- Never collapsed, signal was already created (by the
+ -- By_Individual association).
-- And associate.
Elab_Port_Map_Aspect_Assoc
(Assoc, Formal, False, Formal_Env, Actual_Env);
@@ -758,7 +772,7 @@ package body Trans.Chap5 is
Targ := Chap6.Translate_Name (Formal, Mode_Value);
Set_Map_Env (Actual_Env);
Chap4.Elab_Object_Init
- (Targ, Formal, Get_Actual (Assoc));
+ (Targ, Formal, Get_Actual (Assoc), Alloc_System);
else
Set_Map_Env (Formal_Env);
Targ := Chap6.Translate_Name (Formal, Mode_Value);
diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index 098dc18ca..3475ddd14 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -957,6 +957,40 @@ package body Trans.Chap6 is
-- end case;
-- end Translate_Formal_Name;
+ function Translate_Object_Alias_Name (Name : Iir; Mode : Object_Kind_Type)
+ return Mnode
+ is
+ Name_Type : constant Iir := Get_Type (Name);
+ Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
+ Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
+ R : O_Lnode;
+ pragma Assert (Mode <= Name_Info.Alias_Kind);
+ begin
+ -- Alias_Var is not like an object variable, since it is
+ -- always a pointer to the aliased object.
+ case Type_Info.Type_Mode is
+ when Type_Mode_Fat_Array =>
+ -- Get_Var for Mnode is ok here as an unbounded object is always
+ -- a pointer (and so is an alias).
+ return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, Mode);
+ when Type_Mode_Array
+ | Type_Mode_Record
+ | Type_Mode_Acc
+ | Type_Mode_Bounds_Acc =>
+ R := Get_Var (Name_Info.Alias_Var (Mode));
+ return Lp2M (R, Type_Info, Mode);
+ when Type_Mode_Scalar =>
+ R := Get_Var (Name_Info.Alias_Var (Mode));
+ if Mode = Mode_Signal then
+ return Lv2M (R, Type_Info, Mode_Signal);
+ else
+ return Lp2M (R, Type_Info, Mode_Value);
+ end if;
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Translate_Object_Alias_Name;
+
function Translate_Name (Name : Iir; Mode : Object_Kind_Type) return Mnode
is
Name_Type : constant Iir := Get_Type (Name);
@@ -1099,30 +1133,49 @@ package body Trans.Chap6 is
end case;
end Translate_Name;
- procedure Translate_Direct_Driver
- (Name : Iir; Sig : out Mnode; Drv : out Mnode)
+ function Get_Signal_Direct_Driver (Sig : Iir) return Mnode
is
- Name_Type : constant Iir := Get_Type (Name);
- Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
- Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
+ Info : constant Ortho_Info_Acc := Get_Info (Sig);
+ Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Sig));
+ begin
+ return Get_Var (Info.Signal_Driver, Type_Info, Mode_Value);
+ end Get_Signal_Direct_Driver;
+
+ function Get_Port_Init_Value (Port : Iir) return Mnode
+ is
+ Info : constant Ortho_Info_Acc := Get_Info (Port);
+ Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Port));
+ begin
+ return Get_Var (Info.Signal_Val, Type_Info, Mode_Value);
+ end Get_Port_Init_Value;
+
+ generic
+ with procedure Translate_Signal_Base
+ (Name : Iir; Sig : out Mnode; Drv : out Mnode);
+ procedure Translate_Signal (Name : Iir; Sig : out Mnode; Drv : out Mnode);
+
+ procedure Translate_Signal (Name : Iir; Sig : out Mnode; Drv : out Mnode) is
begin
case Get_Kind (Name) is
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
- Translate_Direct_Driver (Get_Named_Entity (Name), Sig, Drv);
- when Iir_Kind_Object_Alias_Declaration =>
- Translate_Direct_Driver (Get_Name (Name), Sig, Drv);
+ Translate_Signal (Get_Named_Entity (Name), Sig, Drv);
when Iir_Kind_Signal_Declaration
- | Iir_Kind_Interface_Signal_Declaration =>
- Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
- Drv := Get_Var (Name_Info.Signal_Driver, Type_Info, Mode_Value);
+ | Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Stable_Attribute
+ | Iir_Kind_Quiet_Attribute
+ | Iir_Kind_Delayed_Attribute
+ | Iir_Kind_Transaction_Attribute
+ | Iir_Kind_Guard_Signal_Declaration
+ | Iir_Kind_Object_Alias_Declaration =>
+ Translate_Signal_Base (Name, Sig, Drv);
when Iir_Kind_Slice_Name =>
declare
Data : Slice_Name_Data;
Pfx_Sig : Mnode;
Pfx_Drv : Mnode;
begin
- Translate_Direct_Driver (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
+ Translate_Signal (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
Translate_Slice_Name_Init (Pfx_Sig, Name, Data);
Sig := Translate_Slice_Name_Finish
(Data.Prefix_Var, Name, Data);
@@ -1135,8 +1188,7 @@ package body Trans.Chap6 is
Pfx_Sig : Mnode;
Pfx_Drv : Mnode;
begin
- Translate_Direct_Driver
- (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
+ Translate_Signal (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
Data := Translate_Indexed_Name_Init (Pfx_Sig, Name);
Sig := Data.Res;
Drv := Translate_Indexed_Name_Finish (Pfx_Drv, Name, Data);
@@ -1147,17 +1199,67 @@ package body Trans.Chap6 is
Pfx_Sig : Mnode;
Pfx_Drv : Mnode;
begin
- Translate_Direct_Driver
- (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
+ Translate_Signal (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
Sig := Translate_Selected_Element (Pfx_Sig, El);
Drv := Translate_Selected_Element (Pfx_Drv, El);
end;
when others =>
- Error_Kind ("translate_direct_driver", Name);
+ Error_Kind ("translate_signal", Name);
end case;
- end Translate_Direct_Driver;
+ end Translate_Signal;
- procedure Translate_Signal_Name
+ procedure Translate_Direct_Driver_Base
+ (Name : Iir; Sig : out Mnode; Drv : out Mnode) is
+ begin
+ case Get_Kind (Name) is
+ when Iir_Kind_Signal_Declaration
+ | Iir_Kind_Interface_Signal_Declaration =>
+ declare
+ Name_Type : constant Iir := Get_Type (Name);
+ Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
+ Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
+ begin
+ Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
+ Drv := Get_Var (Name_Info.Signal_Driver, Type_Info, Mode_Value);
+ end;
+ when Iir_Kind_Object_Alias_Declaration =>
+ Translate_Direct_Driver (Get_Name (Name), Sig, Drv);
+ when others =>
+ Error_Kind ("translate_direct_driver_base", Name);
+ end case;
+ end Translate_Direct_Driver_Base;
+
+ procedure Translate_Direct_Driver_1 is new
+ Translate_Signal (Translate_Signal_Base => Translate_Direct_Driver_Base);
+
+ procedure Translate_Direct_Driver
+ (Name : Iir; Sig : out Mnode; Drv : out Mnode)
+ renames Translate_Direct_Driver_1;
+
+ procedure Translate_Port_Init_Base
+ (Name : Iir; Sig : out Mnode; Drv : out Mnode)
+ is
+ Name_Type : constant Iir := Get_Type (Name);
+ Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
+ Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
+ begin
+ case Get_Kind (Name) is
+ when Iir_Kind_Interface_Signal_Declaration =>
+ Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
+ Drv := Get_Var (Name_Info.Signal_Val, Type_Info, Mode_Value);
+ when others =>
+ Error_Kind ("translate_direct_driver_base", Name);
+ end case;
+ end Translate_Port_Init_Base;
+
+ procedure Translate_Port_Init_1 is new
+ Translate_Signal (Translate_Signal_Base => Translate_Port_Init_Base);
+
+ procedure Translate_Port_Init
+ (Name : Iir; Sig : out Mnode; Init : out Mnode)
+ renames Translate_Port_Init_1;
+
+ procedure Translate_Signal_Base
(Name : Iir; Sig : out Mnode; Val : out Mnode)
is
Name_Type : constant Iir := Get_Type (Name);
@@ -1165,12 +1267,6 @@ package body Trans.Chap6 is
Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
begin
case Get_Kind (Name) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Selected_Name =>
- Translate_Signal_Name (Get_Named_Entity (Name), Sig, Val);
- when Iir_Kind_Object_Alias_Declaration =>
- Sig := Translate_Name (Name, Mode_Signal);
- Val := Translate_Name (Name, Mode_Value);
when Iir_Kind_Signal_Declaration
| Iir_Kind_Stable_Attribute
| Iir_Kind_Quiet_Attribute
@@ -1182,44 +1278,18 @@ package body Trans.Chap6 is
when Iir_Kind_Interface_Signal_Declaration =>
Sig := Translate_Interface_Name (Name, Name_Info, Mode_Signal);
Val := Translate_Interface_Name (Name, Name_Info, Mode_Value);
- when Iir_Kind_Slice_Name =>
- declare
- Data : Slice_Name_Data;
- Pfx_Sig : Mnode;
- Pfx_Val : Mnode;
- begin
- Translate_Signal_Name
- (Get_Prefix (Name), Pfx_Sig, Pfx_Val);
- Translate_Slice_Name_Init (Pfx_Sig, Name, Data);
- Sig := Translate_Slice_Name_Finish
- (Data.Prefix_Var, Name, Data);
- Val := Translate_Slice_Name_Finish
- (Pfx_Val, Name, Data);
- end;
- when Iir_Kind_Indexed_Name =>
- declare
- Data : Indexed_Name_Data;
- Pfx_Sig : Mnode;
- Pfx_Val : Mnode;
- begin
- Translate_Signal_Name
- (Get_Prefix (Name), Pfx_Sig, Pfx_Val);
- Data := Translate_Indexed_Name_Init (Pfx_Sig, Name);
- Sig := Data.Res;
- Val := Translate_Indexed_Name_Finish (Pfx_Val, Name, Data);
- end;
- when Iir_Kind_Selected_Element =>
- declare
- El : constant Iir := Get_Selected_Element (Name);
- Pfx_Sig : Mnode;
- Pfx_Val : Mnode;
- begin
- Translate_Signal_Name (Get_Prefix (Name), Pfx_Sig, Pfx_Val);
- Sig := Translate_Selected_Element (Pfx_Sig, El);
- Val := Translate_Selected_Element (Pfx_Val, El);
- end;
+ when Iir_Kind_Object_Alias_Declaration =>
+ Sig := Translate_Object_Alias_Name (Name, Mode_Signal);
+ Val := Translate_Object_Alias_Name (Name, Mode_Value);
when others =>
- Error_Kind ("translate_signal_name", Name);
+ Error_Kind ("translate_signal_base", Name);
end case;
- end Translate_Signal_Name;
+ end Translate_Signal_Base;
+
+ procedure Translate_Signal_Name_1 is new
+ Translate_Signal (Translate_Signal_Base);
+
+ procedure Translate_Signal_Name
+ (Name : Iir; Sig : out Mnode; Val : out Mnode)
+ renames Translate_Signal_Name_1;
end Trans.Chap6;
diff --git a/src/vhdl/translate/trans-chap6.ads b/src/vhdl/translate/trans-chap6.ads
index 0d3b0211f..d5822c4e0 100644
--- a/src/vhdl/translate/trans-chap6.ads
+++ b/src/vhdl/translate/trans-chap6.ads
@@ -30,15 +30,15 @@ package Trans.Chap6 is
procedure Translate_Direct_Driver
(Name : Iir; Sig : out Mnode; Drv : out Mnode);
- -- Same as Translate_Name, but only for formal names.
- -- If SCOPE_TYPE and SCOPE_PARAM are not null, use them for the scope
- -- of the base name.
- -- Indeed, for recursive instantiation, NAME can designates the actual
- -- and the formal.
- -- function Translate_Formal_Name (Scope_Type : O_Tnode;
- -- Scope_Param : O_Lnode;
- -- Name : Iir)
- -- return Mnode;
+ -- Translate port NAME to its node (SIG) and its default value (INIT).
+ procedure Translate_Port_Init
+ (Name : Iir; Sig : out Mnode; Init : out Mnode);
+
+ -- Direct driver of SIG (must be present).
+ function Get_Signal_Direct_Driver (Sig : Iir) return Mnode;
+
+ -- Initial value of PORT (must be present).
+ function Get_Port_Init_Value (Port : Iir) return Mnode;
-- Get record element EL of PREFIX.
function Translate_Selected_Element
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 3c597f12c..a1f084845 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -3730,13 +3730,6 @@ package body Trans.Chap7 is
return Chap6.Translate_Selected_Element (Val, El);
end Sig2val_Update_Data_Record;
- procedure Sig2val_Finish_Data_Composite (Data : in out Mnode)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Sig2val_Finish_Data_Composite;
-
procedure Translate_Signal_Assign_Driving_Non_Composite
(Targ : Mnode; Targ_Type : Iir; Data: Mnode) is
begin
@@ -3752,10 +3745,8 @@ package body Trans.Chap7 is
Do_Non_Composite => Translate_Signal_Assign_Driving_Non_Composite,
Prepare_Data_Array => Sig2val_Prepare_Composite,
Update_Data_Array => Sig2val_Update_Data_Array,
- Finish_Data_Array => Sig2val_Finish_Data_Composite,
Prepare_Data_Record => Sig2val_Prepare_Composite,
- Update_Data_Record => Sig2val_Update_Data_Record,
- Finish_Data_Record => Sig2val_Finish_Data_Composite);
+ Update_Data_Record => Sig2val_Update_Data_Record);
function Translate_Signal_Value (Sig : O_Enode; Sig_Type : Iir)
return O_Enode
@@ -3775,10 +3766,8 @@ package body Trans.Chap7 is
Do_Non_Composite => Translate_Signal_Non_Composite,
Prepare_Data_Array => Sig2val_Prepare_Composite,
Update_Data_Array => Sig2val_Update_Data_Array,
- Finish_Data_Array => Sig2val_Finish_Data_Composite,
Prepare_Data_Record => Sig2val_Prepare_Composite,
- Update_Data_Record => Sig2val_Update_Data_Record,
- Finish_Data_Record => Sig2val_Finish_Data_Composite);
+ Update_Data_Record => Sig2val_Update_Data_Record);
Tinfo : Type_Info_Acc;
begin
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index d37b2bad1..d32483348 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -3638,24 +3638,14 @@ package body Trans.Chap8 is
return Res;
end Gen_Signal_Update_Data_Record;
- procedure Gen_Signal_Finish_Data_Composite
- (Data : in out Signal_Assign_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Gen_Signal_Finish_Data_Composite;
-
procedure Gen_Start_Signal_Assign is new Foreach_Non_Composite
(Data_Type => Signal_Assign_Data,
Composite_Data_Type => Signal_Assign_Data,
Do_Non_Composite => Gen_Start_Signal_Assign_Non_Composite,
Prepare_Data_Array => Gen_Signal_Prepare_Data_Composite,
Update_Data_Array => Gen_Signal_Update_Data_Array,
- Finish_Data_Array => Gen_Signal_Finish_Data_Composite,
Prepare_Data_Record => Gen_Signal_Prepare_Data_Record,
- Update_Data_Record => Gen_Signal_Update_Data_Record,
- Finish_Data_Record => Gen_Signal_Finish_Data_Composite);
+ Update_Data_Record => Gen_Signal_Update_Data_Record);
procedure Gen_Next_Signal_Assign_Non_Composite
(Targ : Mnode; Targ_Type : Iir; Data : Signal_Assign_Data)
@@ -3749,10 +3739,8 @@ package body Trans.Chap8 is
Do_Non_Composite => Gen_Next_Signal_Assign_Non_Composite,
Prepare_Data_Array => Gen_Signal_Prepare_Data_Composite,
Update_Data_Array => Gen_Signal_Update_Data_Array,
- Finish_Data_Array => Gen_Signal_Finish_Data_Composite,
Prepare_Data_Record => Gen_Signal_Prepare_Data_Record,
- Update_Data_Record => Gen_Signal_Update_Data_Record,
- Finish_Data_Record => Gen_Signal_Finish_Data_Composite);
+ Update_Data_Record => Gen_Signal_Update_Data_Record);
procedure Translate_Signal_Target_Aggr
(Aggr : Mnode; Target : Iir; Target_Type : Iir);
@@ -3974,24 +3962,14 @@ package body Trans.Chap8 is
Expr_Node => Val.Expr_Node);
end Gen_Signal_Direct_Update_Data_Record;
- procedure Gen_Signal_Direct_Finish_Data_Composite
- (Data : in out Signal_Direct_Assign_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Gen_Signal_Direct_Finish_Data_Composite;
-
procedure Gen_Signal_Direct_Assign is new Foreach_Non_Composite
(Data_Type => Signal_Direct_Assign_Data,
Composite_Data_Type => Signal_Direct_Assign_Data,
Do_Non_Composite => Gen_Signal_Direct_Assign_Non_Composite,
Prepare_Data_Array => Gen_Signal_Direct_Prepare_Data_Composite,
Update_Data_Array => Gen_Signal_Direct_Update_Data_Array,
- Finish_Data_Array => Gen_Signal_Direct_Finish_Data_Composite,
Prepare_Data_Record => Gen_Signal_Direct_Prepare_Data_Record,
- Update_Data_Record => Gen_Signal_Direct_Update_Data_Record,
- Finish_Data_Record => Gen_Signal_Direct_Finish_Data_Composite);
+ Update_Data_Record => Gen_Signal_Direct_Update_Data_Record);
procedure Translate_Direct_Signal_Assignment
(Target : Iir; Targ : Mnode; Drv : Mnode; We : Iir)
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index c35dd5ea5..1b8f55a43 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -57,6 +57,7 @@ package body Trans.Chap9 is
if Var /= Null_Var then
Sig := Get_Object_Prefix (Drivers (I).Sig);
Info := Get_Info (Sig);
+ pragma Assert (Info.Kind = Kind_Signal);
case Info.Kind is
when Kind_Signal =>
Info.Signal_Driver := Var;
@@ -276,9 +277,9 @@ package body Trans.Chap9 is
Sig := Get_Nth_Element (Drivers, I - 1);
Info.Process_Drivers (I) := (Sig => Sig, Var => Null_Var);
Sig := Get_Object_Prefix (Sig);
- if Get_Kind (Sig) /= Iir_Kind_Object_Alias_Declaration
- and then not Get_After_Drivers_Flag (Sig)
- then
+ pragma Assert
+ (Get_Kind (Sig) /= Iir_Kind_Object_Alias_Declaration);
+ if not Get_After_Drivers_Flag (Sig) then
Info.Process_Drivers (I).Var :=
Create_Var (Create_Var_Identifier (Sig, "_DDRV", I),
Chap4.Get_Object_Type
@@ -1227,6 +1228,50 @@ package body Trans.Chap9 is
end;
end Destroy_Types;
+ function Foreach_Non_Composite_Prepare_Data_Array_Mnode
+ (Targ : Mnode; Targ_Type : Iir; Val : Mnode) return Mnode
+ is
+ pragma Unreferenced (Targ, Targ_Type);
+ begin
+ return Val;
+ end Foreach_Non_Composite_Prepare_Data_Array_Mnode;
+
+ function Foreach_Non_Composite_Prepare_Data_Record_Mnode
+ (Targ : Mnode; Targ_Type : Iir; Val : Mnode) return Mnode
+ is
+ pragma Unreferenced (Targ, Targ_Type);
+ begin
+ if Val = Mnode_Null then
+ return Mnode_Null;
+ else
+ return Stabilize (Val);
+ end if;
+ end Foreach_Non_Composite_Prepare_Data_Record_Mnode;
+
+ function Foreach_Non_Composite_Update_Data_Array_Mnode
+ (Val : Mnode; Targ_Type : Iir; Index : O_Dnode) return Mnode is
+ begin
+ if Val = Mnode_Null then
+ return Mnode_Null;
+ else
+ return Chap3.Index_Base (Chap3.Get_Composite_Base (Val),
+ Targ_Type, New_Obj_Value (Index));
+ end if;
+ end Foreach_Non_Composite_Update_Data_Array_Mnode;
+
+ function Foreach_Non_Composite_Update_Data_Record_Mnode
+ (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
+ return Mnode
+ is
+ pragma Unreferenced (Targ_Type);
+ begin
+ if Val = Mnode_Null then
+ return Mnode_Null;
+ else
+ return Chap6.Translate_Selected_Element (Val, El);
+ end if;
+ end Foreach_Non_Composite_Update_Data_Record_Mnode;
+
procedure Gen_Register_Direct_Driver_Non_Composite
(Targ : Mnode; Targ_Type : Iir; Drv : Mnode)
is
@@ -1241,62 +1286,186 @@ package body Trans.Chap9 is
New_Procedure_Call (Constr);
end Gen_Register_Direct_Driver_Non_Composite;
- function Gen_Register_Direct_Driver_Prepare_Data_Composite
- (Targ : Mnode; Targ_Type : Iir; Val : Mnode)
- return Mnode
+ procedure Gen_Register_Direct_Driver is new Foreach_Non_Composite
+ (Data_Type => Mnode,
+ Composite_Data_Type => Mnode,
+ Do_Non_Composite => Gen_Register_Direct_Driver_Non_Composite,
+ Prepare_Data_Array => Foreach_Non_Composite_Prepare_Data_Array_Mnode,
+ Update_Data_Array => Foreach_Non_Composite_Update_Data_Array_Mnode,
+ Prepare_Data_Record => Foreach_Non_Composite_Prepare_Data_Record_Mnode,
+ Update_Data_Record => Foreach_Non_Composite_Update_Data_Record_Mnode);
+
+ procedure Gen_Add_Port_Driver_Non_Composite
+ (Targ : Mnode; Targ_Type : Iir; Init : O_Enode)
is
- pragma Unreferenced (Targ, Targ_Type);
+ Type_Info : constant Type_Info_Acc := Get_Info (Targ_Type);
+ Constr : O_Assoc_List;
+ Init_Subprg : O_Dnode;
+ Conv : O_Tnode;
begin
- return Val;
- end Gen_Register_Direct_Driver_Prepare_Data_Composite;
+ case Type_Info.Type_Mode is
+ when Type_Mode_B1 =>
+ Init_Subprg := Ghdl_Signal_Add_Port_Driver_B1;
+ Conv := Ghdl_Bool_Type;
+ when Type_Mode_E8 =>
+ Init_Subprg := Ghdl_Signal_Add_Port_Driver_E8;
+ Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Init_Subprg := Ghdl_Signal_Add_Port_Driver_E32;
+ Conv := Ghdl_I32_Type;
+ when Type_Mode_I32
+ | Type_Mode_P32 =>
+ Init_Subprg := Ghdl_Signal_Add_Port_Driver_I32;
+ Conv := Ghdl_I32_Type;
+ when Type_Mode_P64
+ | Type_Mode_I64 =>
+ Init_Subprg := Ghdl_Signal_Add_Port_Driver_I64;
+ Conv := Ghdl_I64_Type;
+ when Type_Mode_F64 =>
+ Init_Subprg := Ghdl_Signal_Add_Port_Driver_F64;
+ Conv := Ghdl_Real_Type;
+ when others =>
+ Error_Kind ("gen_add_port_driver_non_composite", Targ_Type);
+ end case;
+
+ Start_Association (Constr, Init_Subprg);
+ New_Association
+ (Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
+ New_Association (Constr, New_Convert_Ov (Init, Conv));
+ New_Procedure_Call (Constr);
+ end Gen_Add_Port_Driver_Non_Composite;
- function Gen_Register_Direct_Driver_Prepare_Data_Record
- (Targ : Mnode; Targ_Type : Iir; Val : Mnode)
- return Mnode
+ procedure Gen_Add_Port_Driver_Non_Composite
+ (Targ : Mnode; Targ_Type : Iir; Init : Mnode) is
+ begin
+ Gen_Add_Port_Driver_Non_Composite (Targ, Targ_Type, M2E (Init));
+ end Gen_Add_Port_Driver_Non_Composite;
+
+ procedure Gen_Add_Port_Driver is new Foreach_Non_Composite
+ (Data_Type => Mnode,
+ Composite_Data_Type => Mnode,
+ Do_Non_Composite => Gen_Add_Port_Driver_Non_Composite,
+ Prepare_Data_Array => Foreach_Non_Composite_Prepare_Data_Array_Mnode,
+ Update_Data_Array => Foreach_Non_Composite_Update_Data_Array_Mnode,
+ Prepare_Data_Record => Foreach_Non_Composite_Prepare_Data_Record_Mnode,
+ Update_Data_Record => Foreach_Non_Composite_Update_Data_Record_Mnode);
+
+ type Add_Port_Driver_Default_Data is null record;
+
+ procedure Gen_Add_Port_Driver_Non_Composite_Default
+ (Targ : Mnode; Targ_Type : Iir; Init : Add_Port_Driver_Default_Data)
is
- pragma Unreferenced (Targ, Targ_Type);
+ pragma Unreferenced (Init);
+ begin
+ Gen_Add_Port_Driver_Non_Composite
+ (Targ, Targ_Type, Chap4.Get_Scalar_Initial_Value (Targ_Type));
+ end Gen_Add_Port_Driver_Non_Composite_Default;
+
+ function Gen_Add_Port_Driver_Prepare_Data_Composite_Default
+ (Targ : Mnode; Targ_Type : Iir; Data : Add_Port_Driver_Default_Data)
+ return Add_Port_Driver_Default_Data
+ is
+ pragma Unreferenced (Targ);
+ pragma Unreferenced (Targ_Type);
begin
- return Stabilize (Val);
- end Gen_Register_Direct_Driver_Prepare_Data_Record;
+ return Data;
+ end Gen_Add_Port_Driver_Prepare_Data_Composite_Default;
- function Gen_Register_Direct_Driver_Update_Data_Array
- (Val : Mnode; Targ_Type : Iir; Index : O_Dnode)
- return Mnode
+ function Gen_Add_Port_Driver_Update_Data_Array_Default
+ (Data : Add_Port_Driver_Default_Data; Targ_Type : Iir; Index : O_Dnode)
+ return Add_Port_Driver_Default_Data
is
+ pragma Unreferenced (Targ_Type);
+ pragma Unreferenced (Index);
begin
- return Chap3.Index_Base (Chap3.Get_Composite_Base (Val),
- Targ_Type, New_Obj_Value (Index));
- end Gen_Register_Direct_Driver_Update_Data_Array;
+ return Data;
+ end Gen_Add_Port_Driver_Update_Data_Array_Default;
- function Gen_Register_Direct_Driver_Update_Data_Record
- (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
- return Mnode
+ function Gen_Add_Port_Driver_Update_Data_Record_Default
+ (Data : Add_Port_Driver_Default_Data;
+ Targ_Type : Iir;
+ El : Iir_Element_Declaration)
+ return Add_Port_Driver_Default_Data
is
pragma Unreferenced (Targ_Type);
+ pragma Unreferenced (El);
begin
- return Chap6.Translate_Selected_Element (Val, El);
- end Gen_Register_Direct_Driver_Update_Data_Record;
+ return Data;
+ end Gen_Add_Port_Driver_Update_Data_Record_Default;
- procedure Gen_Register_Direct_Driver_Finish_Data_Composite
- (Data : in out Mnode)
+ procedure Gen_Add_Port_Driver_Default is new Foreach_Non_Composite
+ (Data_Type => Add_Port_Driver_Default_Data,
+ Composite_Data_Type => Add_Port_Driver_Default_Data,
+ Do_Non_Composite => Gen_Add_Port_Driver_Non_Composite_Default,
+ Prepare_Data_Array =>
+ Gen_Add_Port_Driver_Prepare_Data_Composite_Default,
+ Update_Data_Array =>
+ Gen_Add_Port_Driver_Update_Data_Array_Default,
+ Prepare_Data_Record =>
+ Gen_Add_Port_Driver_Prepare_Data_Composite_Default,
+ Update_Data_Record =>
+ Gen_Add_Port_Driver_Update_Data_Record_Default);
+
+ procedure Gen_Port_Init_Driving_Scalar
+ (Targ : Mnode; Targ_Type : Iir; Init : Mnode)
is
- pragma Unreferenced (Data);
+ Type_Info : constant Type_Info_Acc := Get_Info (Targ_Type);
+ Assoc : O_Assoc_List;
+ Init_Subprg : O_Dnode;
+ Init_Val : O_Enode;
+ Conv : O_Tnode;
begin
- null;
- end Gen_Register_Direct_Driver_Finish_Data_Composite;
+ case Type_Info.Type_Mode is
+ when Type_Mode_B1 =>
+ Init_Subprg := Ghdl_Signal_Init_B1;
+ Conv := Ghdl_Bool_Type;
+ when Type_Mode_E8 =>
+ Init_Subprg := Ghdl_Signal_Init_E8;
+ Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Init_Subprg := Ghdl_Signal_Init_E32;
+ Conv := Ghdl_I32_Type;
+ when Type_Mode_I32
+ | Type_Mode_P32 =>
+ Init_Subprg := Ghdl_Signal_Init_I32;
+ Conv := Ghdl_I32_Type;
+ when Type_Mode_P64
+ | Type_Mode_I64 =>
+ Init_Subprg := Ghdl_Signal_Init_I64;
+ Conv := Ghdl_I64_Type;
+ when Type_Mode_F64 =>
+ Init_Subprg := Ghdl_Signal_Init_F64;
+ Conv := Ghdl_Real_Type;
+ when others =>
+ Error_Kind ("merge_signals_rti_non_composite", Targ_Type);
+ end case;
- procedure Gen_Register_Direct_Driver is new Foreach_Non_Composite
+ -- Init the signal.
+ Start_Association (Assoc, Init_Subprg);
+ New_Association
+ (Assoc,
+ New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
+ if Init /= Mnode_Null then
+ Init_Val := M2E (Init);
+ else
+ Init_Val := Chap4.Get_Scalar_Initial_Value (Targ_Type);
+ end if;
+ New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));
+ New_Procedure_Call (Assoc);
+ end Gen_Port_Init_Driving_Scalar;
+
+ procedure Gen_Port_Init_Driving_1 is new Foreach_Non_Composite
(Data_Type => Mnode,
Composite_Data_Type => Mnode,
- Do_Non_Composite => Gen_Register_Direct_Driver_Non_Composite,
- Prepare_Data_Array =>
- Gen_Register_Direct_Driver_Prepare_Data_Composite,
- Update_Data_Array => Gen_Register_Direct_Driver_Update_Data_Array,
- Finish_Data_Array => Gen_Register_Direct_Driver_Finish_Data_Composite,
- Prepare_Data_Record => Gen_Register_Direct_Driver_Prepare_Data_Record,
- Update_Data_Record => Gen_Register_Direct_Driver_Update_Data_Record,
- Finish_Data_Record =>
- Gen_Register_Direct_Driver_Finish_Data_Composite);
+ Do_Non_Composite => Gen_Port_Init_Driving_Scalar,
+ Prepare_Data_Array => Foreach_Non_Composite_Prepare_Data_Array_Mnode,
+ Update_Data_Array => Foreach_Non_Composite_Update_Data_Array_Mnode,
+ Prepare_Data_Record => Foreach_Non_Composite_Prepare_Data_Record_Mnode,
+ Update_Data_Record => Foreach_Non_Composite_Update_Data_Record_Mnode);
+
+ procedure Gen_Port_Init_Driving
+ (Port : Mnode; Port_Type : Iir; Init : Mnode)
+ renames Gen_Port_Init_Driving_1;
-- procedure Register_Scalar_Direct_Driver (Sig : Mnode;
-- Sig_Type : Iir;
@@ -1365,19 +1534,38 @@ package body Trans.Chap9 is
if Flag_Direct_Drivers then
Chap9.Set_Direct_Drivers (Proc);
- declare
- Sig : Iir;
- Base : Iir;
- Sig_Node, Drv_Node : Mnode;
- begin
- for I in Info.Process_Drivers.all'Range loop
- Sig := Info.Process_Drivers (I).Sig;
+ for I in Info.Process_Drivers.all'Range loop
+ declare
+ Sig : constant Iir := Info.Process_Drivers (I).Sig;
+ Base : constant Iir := Get_Object_Prefix (Sig);
+ Sig_Node, Drv_Node, Init_Node : Mnode;
+ Base_Type : Iir;
+ begin
Open_Temp;
Chap9.Destroy_Types (Sig);
- Base := Get_Object_Prefix (Sig);
if Info.Process_Drivers (I).Var /= Null_Var then
-- Elaborate direct driver. Done only once.
Chap4.Elab_Direct_Driver_Declaration_Storage (Base);
+
+ -- Initial value.
+ Drv_Node := Chap6.Get_Signal_Direct_Driver (Base);
+ Base_Type := Get_Type (Base);
+ if Get_Kind (Base) = Iir_Kind_Interface_Signal_Declaration
+ then
+ -- From the port default value.
+ if Is_Valid (Get_Default_Value (Base)) then
+ Chap3.Translate_Object_Copy
+ (Drv_Node, M2E (Chap6.Get_Port_Init_Value (Base)),
+ Base_Type);
+ else
+ Chap4.Init_Object (Drv_Node, Base_Type);
+ end if;
+ else
+ -- From the signal value.
+ Chap3.Translate_Object_Copy
+ (Drv_Node, Chap7.Translate_Expression (Base),
+ Base_Type);
+ end if;
end if;
if Chap4.Has_Direct_Driver (Base) then
-- Signal has a direct driver.
@@ -1385,13 +1573,28 @@ package body Trans.Chap9 is
Gen_Register_Direct_Driver
(Sig_Node, Get_Type (Sig), Drv_Node);
else
- Register_Signal (Chap6.Translate_Name (Sig, Mode_Signal),
- Get_Type (Sig),
- Ghdl_Process_Add_Driver);
+ -- TODO (issue328): add default value
+ if Get_Kind (Base) = Iir_Kind_Interface_Signal_Declaration
+ then
+ if Is_Valid (Get_Default_Value (Base)) then
+ Chap6.Translate_Port_Init
+ (Sig, Sig_Node, Init_Node);
+ Gen_Add_Port_Driver
+ (Sig_Node, Get_Type (Sig), Init_Node);
+ else
+ Sig_Node := Chap6.Translate_Name (Sig, Mode_Signal);
+ Gen_Add_Port_Driver_Default
+ (Sig_Node, Get_Type (Sig), (others => <>));
+ end if;
+ else
+ Register_Signal (Chap6.Translate_Name (Sig, Mode_Signal),
+ Get_Type (Sig),
+ Ghdl_Process_Add_Driver);
+ end if;
end if;
Close_Temp;
- end loop;
- end;
+ end;
+ end loop;
Chap9.Reset_Direct_Drivers (Proc);
else
@@ -2246,196 +2449,68 @@ package body Trans.Chap9 is
Close_Temp;
end Elab_Stmt_For_Generate_Statement;
- type Merge_Signals_Data is record
- Sig : Iir;
- Set_Init : Boolean;
- Has_Val : Boolean;
- Val : Mnode;
- end record;
-
- procedure Merge_Signals_Rti_Non_Composite (Targ : Mnode;
- Targ_Type : Iir;
- Data : Merge_Signals_Data)
+ procedure Merge_Signals_Rti_Non_Composite
+ (Targ : Mnode; Targ_Type : Iir; Sig : Iir)
is
- Type_Info : Type_Info_Acc;
- Sig : Mnode;
-
- Init_Subprg : O_Dnode;
- Conv : O_Tnode;
- Assoc : O_Assoc_List;
- Init_Val : O_Enode;
+ pragma Unreferenced (Targ_Type);
+ Assoc : O_Assoc_List;
begin
- Type_Info := Get_Info (Targ_Type);
-
- Open_Temp;
-
- if Data.Set_Init then
- case Type_Info.Type_Mode is
- when Type_Mode_B1 =>
- Init_Subprg := Ghdl_Signal_Init_B1;
- Conv := Ghdl_Bool_Type;
- when Type_Mode_E8 =>
- Init_Subprg := Ghdl_Signal_Init_E8;
- Conv := Ghdl_I32_Type;
- when Type_Mode_E32 =>
- Init_Subprg := Ghdl_Signal_Init_E32;
- Conv := Ghdl_I32_Type;
- when Type_Mode_I32
- | Type_Mode_P32 =>
- Init_Subprg := Ghdl_Signal_Init_I32;
- Conv := Ghdl_I32_Type;
- when Type_Mode_P64
- | Type_Mode_I64 =>
- Init_Subprg := Ghdl_Signal_Init_I64;
- Conv := Ghdl_I64_Type;
- when Type_Mode_F64 =>
- Init_Subprg := Ghdl_Signal_Init_F64;
- Conv := Ghdl_Real_Type;
- when others =>
- Error_Kind ("merge_signals_rti_non_composite", Targ_Type);
- end case;
-
- Sig := Stabilize (Targ, True);
-
- -- Init the signal.
- Start_Association (Assoc, Init_Subprg);
- New_Association
- (Assoc,
- New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
- if Data.Has_Val then
- Init_Val := M2E (Data.Val);
- else
- Init_Val := Chap4.Get_Scalar_Initial_Value (Targ_Type);
- end if;
- New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));
- New_Procedure_Call (Assoc);
- else
- Sig := Targ;
- end if;
-
Start_Association (Assoc, Ghdl_Signal_Merge_Rti);
New_Association
- (Assoc, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
+ (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
New_Association
(Assoc,
New_Lit (New_Global_Unchecked_Address
- (Get_Info (Data.Sig).Signal_Rti,
- Rtis.Ghdl_Rti_Access)));
+ (Get_Info (Sig).Signal_Rti, Rtis.Ghdl_Rti_Access)));
New_Procedure_Call (Assoc);
- Close_Temp;
end Merge_Signals_Rti_Non_Composite;
function Merge_Signals_Rti_Prepare
- (Targ : Mnode; Targ_Type : Iir; Data : Merge_Signals_Data)
- return Merge_Signals_Data
+ (Targ : Mnode; Targ_Type : Iir; Sig : Iir) return Iir
is
pragma Unreferenced (Targ);
pragma Unreferenced (Targ_Type);
- Res : Merge_Signals_Data;
begin
- Res := Data;
- if Data.Has_Val then
- if Get_Type_Info (Data.Val).Type_Mode in Type_Mode_Records then
- Res.Val := Stabilize (Data.Val);
- else
- Res.Val := Chap3.Get_Composite_Base (Data.Val);
- end if;
- end if;
-
- return Res;
+ return Sig;
end Merge_Signals_Rti_Prepare;
function Merge_Signals_Rti_Update_Data_Array
- (Data : Merge_Signals_Data; Targ_Type : Iir; Index : O_Dnode)
- return Merge_Signals_Data
+ (Sig : Iir; Targ_Type : Iir; Index : O_Dnode) return Iir
is
+ pragma Unreferenced (Targ_Type);
+ pragma Unreferenced (Index);
begin
- if not Data.Has_Val then
- return Data;
- else
- return Merge_Signals_Data'
- (Sig => Data.Sig,
- Val => Chap3.Index_Base (Data.Val, Targ_Type,
- New_Obj_Value (Index)),
- Has_Val => True,
- Set_Init => Data.Set_Init);
- end if;
+ return Sig;
end Merge_Signals_Rti_Update_Data_Array;
- procedure Merge_Signals_Rti_Finish_Data_Composite
- (Data : in out Merge_Signals_Data)
- is
- pragma Unreferenced (Data);
- begin
- null;
- end Merge_Signals_Rti_Finish_Data_Composite;
-
function Merge_Signals_Rti_Update_Data_Record
- (Data : Merge_Signals_Data;
- Targ_Type : Iir;
- El : Iir_Element_Declaration) return Merge_Signals_Data
+ (Sig : Iir; Targ_Type : Iir; El : Iir_Element_Declaration) return Iir
is
pragma Unreferenced (Targ_Type);
+ pragma Unreferenced (El);
begin
- if not Data.Has_Val then
- return Data;
- else
- return Merge_Signals_Data'
- (Sig => Data.Sig,
- Val => Chap6.Translate_Selected_Element (Data.Val, El),
- Has_Val => True,
- Set_Init => Data.Set_Init);
- end if;
+ return Sig;
end Merge_Signals_Rti_Update_Data_Record;
- pragma Inline (Merge_Signals_Rti_Finish_Data_Composite);
-
procedure Merge_Signals_Rti is new Foreach_Non_Composite
- (Data_Type => Merge_Signals_Data,
- Composite_Data_Type => Merge_Signals_Data,
+ (Data_Type => Iir,
+ Composite_Data_Type => Iir,
Do_Non_Composite => Merge_Signals_Rti_Non_Composite,
Prepare_Data_Array => Merge_Signals_Rti_Prepare,
Update_Data_Array => Merge_Signals_Rti_Update_Data_Array,
- Finish_Data_Array => Merge_Signals_Rti_Finish_Data_Composite,
Prepare_Data_Record => Merge_Signals_Rti_Prepare,
- Update_Data_Record => Merge_Signals_Rti_Update_Data_Record,
- Finish_Data_Record => Merge_Signals_Rti_Finish_Data_Composite);
+ Update_Data_Record => Merge_Signals_Rti_Update_Data_Record);
procedure Merge_Signals_Rti_Of_Port_Chain (Chain : Iir)
is
Port : Iir;
- Port_Type : Iir;
- Data : Merge_Signals_Data;
- Val : Iir;
begin
Port := Chain;
while Port /= Null_Iir loop
- Port_Type := Get_Type (Port);
- Data.Sig := Port;
Open_Temp;
-
- case Get_Mode (Port) is
- when Iir_Buffer_Mode
- | Iir_Out_Mode
- | Iir_Inout_Mode =>
- Data.Set_Init := True;
- Val := Get_Default_Value (Port);
- if Val = Null_Iir then
- Data.Has_Val := False;
- else
- Data.Has_Val := True;
- Data.Val := E2M (Chap7.Translate_Expression (Val, Port_Type),
- Get_Info (Port_Type),
- Mode_Value);
- end if;
- when others =>
- Data.Set_Init := False;
- Data.Has_Val := False;
- end case;
-
Merge_Signals_Rti
- (Chap6.Translate_Name (Port, Mode_Signal), Port_Type, Data);
+ (Chap6.Translate_Name (Port, Mode_Signal), Get_Type (Port), Port);
Close_Temp;
Port := Get_Chain (Port);
diff --git a/src/vhdl/translate/trans-chap9.ads b/src/vhdl/translate/trans-chap9.ads
index 1a94c01b8..955b6e77d 100644
--- a/src/vhdl/translate/trans-chap9.ads
+++ b/src/vhdl/translate/trans-chap9.ads
@@ -40,4 +40,10 @@ package Trans.Chap9 is
-- slices in the sensitivity or driver list) and the process subprg.
procedure Destroy_Types (N : Iir);
procedure Destroy_Types_In_List (L : Iir_List);
+
+ -- Called by chap5 to initialize the driving value of a signal associated
+ -- to a collapsed port.
+ procedure Gen_Port_Init_Driving
+ (Port : Mnode; Port_Type : Iir; Init : Mnode);
+
end Trans.Chap9;
diff --git a/src/vhdl/translate/trans-foreach_non_composite.ads b/src/vhdl/translate/trans-foreach_non_composite.ads
index 9413a8200..f43bf706d 100644
--- a/src/vhdl/translate/trans-foreach_non_composite.ads
+++ b/src/vhdl/translate/trans-foreach_non_composite.ads
@@ -40,7 +40,8 @@ generic
return Data_Type;
-- This function is called at the end of a record process.
- with procedure Finish_Data_Array (Data : in out Composite_Data_Type);
+ with procedure Finish_Data_Array (Data : in out Composite_Data_Type)
+ is null;
-- This function should stabilize DATA.
with function Prepare_Data_Record (Targ : Mnode;
@@ -55,7 +56,8 @@ generic
return Data_Type;
-- This function is called at the end of a record process.
- with procedure Finish_Data_Record (Data : in out Composite_Data_Type);
+ with procedure Finish_Data_Record (Data : in out Composite_Data_Type)
+ is null;
procedure Trans.Foreach_Non_Composite (Targ : Mnode;
Targ_Type : Iir;
diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb
index 7c5ad147d..500753bb5 100644
--- a/src/vhdl/translate/trans-helpers2.adb
+++ b/src/vhdl/translate/trans-helpers2.adb
@@ -178,7 +178,7 @@ package body Trans.Helpers2 is
function Register_Prepare_Data_Composite (Targ : Mnode;
Targ_Type : Iir;
Data : O_Dnode)
- return O_Dnode
+ return O_Dnode
is
pragma Unreferenced (Targ);
pragma Unreferenced (Targ_Type);
@@ -196,23 +196,14 @@ package body Trans.Helpers2 is
return Data;
end Register_Update_Data_Record;
- procedure Register_Finish_Data_Composite (D : in out O_Dnode)
- is
- pragma Unreferenced (D);
- begin
- null;
- end Register_Finish_Data_Composite;
-
procedure Register_Signal_1 is new Foreach_Non_Composite
(Data_Type => O_Dnode,
Composite_Data_Type => O_Dnode,
Do_Non_Composite => Register_Non_Composite_Signal,
Prepare_Data_Array => Register_Prepare_Data_Composite,
Update_Data_Array => Register_Update_Data_Array,
- Finish_Data_Array => Register_Finish_Data_Composite,
Prepare_Data_Record => Register_Prepare_Data_Composite,
- Update_Data_Record => Register_Update_Data_Record,
- Finish_Data_Record => Register_Finish_Data_Composite);
+ Update_Data_Record => Register_Update_Data_Record);
procedure Register_Signal (Targ : Mnode;
Targ_Type : Iir;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index b1549a0cb..2b19d3bd9 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1278,6 +1278,7 @@ package Trans is
when Kind_Signal =>
-- The current value of the signal.
+ -- Also the initial value of collapsed ports.
Signal_Val : Var_Type := Null_Var;
-- Pointer to the value, for ports.
Signal_Valp : Var_Type := Null_Var;
diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb
index 357527882..32b9fac65 100644
--- a/src/vhdl/translate/trans_analyzes.adb
+++ b/src/vhdl/translate/trans_analyzes.adb
@@ -35,8 +35,7 @@ package body Trans_Analyzes is
Base := Get_Object_Prefix (Target);
-- Assigment to subprogram interface does not create a driver.
if Get_Kind (Base) = Iir_Kind_Interface_Signal_Declaration
- and then
- Get_Kind (Get_Parent (Base)) = Iir_Kind_Procedure_Declaration
+ and then Is_Parameter (Base)
then
return Walk_Continue;
end if;
diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads
index e8039fc29..0a2d5e69f 100644
--- a/src/vhdl/translate/trans_decls.ads
+++ b/src/vhdl/translate/trans_decls.ads
@@ -77,52 +77,58 @@ package Trans_Decls is
Ghdl_Signal_Start_Assign_Null : O_Dnode;
Ghdl_Signal_Next_Assign_Null : O_Dnode;
+ Ghdl_Create_Signal_B1 : O_Dnode;
+ Ghdl_Signal_Simple_Assign_B1 : O_Dnode;
+ Ghdl_Signal_Start_Assign_B1 : O_Dnode;
+ Ghdl_Signal_Next_Assign_B1 : O_Dnode;
+ Ghdl_Signal_Associate_B1 : O_Dnode;
+ Ghdl_Signal_Add_Port_Driver_B1 : O_Dnode;
+ Ghdl_Signal_Init_B1 : O_Dnode;
+ Ghdl_Signal_Driving_Value_B1 : O_Dnode;
+
Ghdl_Create_Signal_E8 : O_Dnode;
- Ghdl_Signal_Init_E8 : O_Dnode;
Ghdl_Signal_Simple_Assign_E8 : O_Dnode;
Ghdl_Signal_Start_Assign_E8 : O_Dnode;
Ghdl_Signal_Next_Assign_E8 : O_Dnode;
Ghdl_Signal_Associate_E8 : O_Dnode;
+ Ghdl_Signal_Add_Port_Driver_E8 : O_Dnode;
+ Ghdl_Signal_Init_E8 : O_Dnode;
Ghdl_Signal_Driving_Value_E8 : O_Dnode;
Ghdl_Create_Signal_E32 : O_Dnode;
- Ghdl_Signal_Init_E32 : O_Dnode;
Ghdl_Signal_Simple_Assign_E32 : O_Dnode;
Ghdl_Signal_Start_Assign_E32 : O_Dnode;
Ghdl_Signal_Next_Assign_E32 : O_Dnode;
Ghdl_Signal_Associate_E32 : O_Dnode;
+ Ghdl_Signal_Add_Port_Driver_E32 : O_Dnode;
+ Ghdl_Signal_Init_E32 : O_Dnode;
Ghdl_Signal_Driving_Value_E32 : O_Dnode;
- Ghdl_Create_Signal_B1 : O_Dnode;
- Ghdl_Signal_Init_B1 : O_Dnode;
- Ghdl_Signal_Simple_Assign_B1 : O_Dnode;
- Ghdl_Signal_Start_Assign_B1 : O_Dnode;
- Ghdl_Signal_Next_Assign_B1 : O_Dnode;
- Ghdl_Signal_Associate_B1 : O_Dnode;
- Ghdl_Signal_Driving_Value_B1 : O_Dnode;
-
Ghdl_Create_Signal_I32 : O_Dnode;
- Ghdl_Signal_Init_I32 : O_Dnode;
Ghdl_Signal_Simple_Assign_I32 : O_Dnode;
Ghdl_Signal_Start_Assign_I32 : O_Dnode;
Ghdl_Signal_Next_Assign_I32 : O_Dnode;
Ghdl_Signal_Associate_I32 : O_Dnode;
+ Ghdl_Signal_Add_Port_Driver_I32 : O_Dnode;
+ Ghdl_Signal_Init_I32 : O_Dnode;
Ghdl_Signal_Driving_Value_I32 : O_Dnode;
Ghdl_Create_Signal_F64 : O_Dnode;
- Ghdl_Signal_Init_F64 : O_Dnode;
Ghdl_Signal_Simple_Assign_F64 : O_Dnode;
Ghdl_Signal_Start_Assign_F64 : O_Dnode;
Ghdl_Signal_Next_Assign_F64 : O_Dnode;
Ghdl_Signal_Associate_F64 : O_Dnode;
+ Ghdl_Signal_Add_Port_Driver_F64 : O_Dnode;
+ Ghdl_Signal_Init_F64 : O_Dnode;
Ghdl_Signal_Driving_Value_F64 : O_Dnode;
Ghdl_Create_Signal_I64 : O_Dnode;
- Ghdl_Signal_Init_I64 : O_Dnode;
Ghdl_Signal_Simple_Assign_I64 : O_Dnode;
Ghdl_Signal_Start_Assign_I64 : O_Dnode;
Ghdl_Signal_Next_Assign_I64 : O_Dnode;
Ghdl_Signal_Associate_I64 : O_Dnode;
+ Ghdl_Signal_Add_Port_Driver_I64 : O_Dnode;
+ Ghdl_Signal_Init_I64 : O_Dnode;
Ghdl_Signal_Driving_Value_I64 : O_Dnode;
Ghdl_Signal_In_Conversion : O_Dnode;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 8d8c69789..b6bf0ac7b 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -780,6 +780,7 @@ package body Translation is
Start_Assign : out O_Dnode;
Next_Assign : out O_Dnode;
Associate_Value : out O_Dnode;
+ Add_Port_Driver : out O_Dnode;
Driving_Value : out O_Dnode)
is
Interfaces : O_Inter_List;
@@ -828,8 +829,7 @@ package body Translation is
New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
Std_Time_Otype);
- New_Interface_Decl (Interfaces, Param, Wki_Val,
- Val_Type);
+ New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type);
New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
Std_Time_Otype);
Finish_Subprogram_Decl (Interfaces, Start_Assign);
@@ -841,8 +841,7 @@ package body Translation is
(Interfaces, Get_Identifier ("__ghdl_signal_next_assign_" & Suffix),
O_Storage_External);
New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
- New_Interface_Decl (Interfaces, Param, Wki_Val,
- Val_Type);
+ New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type);
New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
Std_Time_Otype);
Finish_Subprogram_Decl (Interfaces, Next_Assign);
@@ -853,10 +852,19 @@ package body Translation is
(Interfaces, Get_Identifier ("__ghdl_signal_associate_" & Suffix),
O_Storage_External);
New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
- New_Interface_Decl (Interfaces, Param, Wki_Val,
- Val_Type);
+ New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type);
Finish_Subprogram_Decl (Interfaces, Associate_Value);
+ -- procedure __ghdl_signal_add_port_driver_XX (sign : __ghdl_signal_ptr;
+ -- val : VAL_TYPE);
+ Start_Procedure_Decl
+ (Interfaces,
+ Get_Identifier ("__ghdl_signal_add_port_driver_" & Suffix),
+ O_Storage_External);
+ New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+ New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type);
+ Finish_Subprogram_Decl (Interfaces, Add_Port_Driver);
+
-- function __ghdl_signal_driving_value_XXX (sign : __ghdl_signal_ptr)
-- return VAL_TYPE;
Start_Function_Decl
@@ -1477,6 +1485,7 @@ package body Translation is
Ghdl_Signal_Start_Assign_E8,
Ghdl_Signal_Next_Assign_E8,
Ghdl_Signal_Associate_E8,
+ Ghdl_Signal_Add_Port_Driver_E8,
Ghdl_Signal_Driving_Value_E8);
-- function __ghdl_create_signal_e32 (init_val : ghdl_i32_type)
@@ -1490,6 +1499,7 @@ package body Translation is
Ghdl_Signal_Start_Assign_E32,
Ghdl_Signal_Next_Assign_E32,
Ghdl_Signal_Associate_E32,
+ Ghdl_Signal_Add_Port_Driver_E32,
Ghdl_Signal_Driving_Value_E32);
-- function __ghdl_create_signal_b1 (init_val : ghdl_bool_type)
@@ -1503,6 +1513,7 @@ package body Translation is
Ghdl_Signal_Start_Assign_B1,
Ghdl_Signal_Next_Assign_B1,
Ghdl_Signal_Associate_B1,
+ Ghdl_Signal_Add_Port_Driver_B1,
Ghdl_Signal_Driving_Value_B1);
Create_Signal_Subprograms ("i32", Ghdl_I32_Type,
@@ -1512,6 +1523,7 @@ package body Translation is
Ghdl_Signal_Start_Assign_I32,
Ghdl_Signal_Next_Assign_I32,
Ghdl_Signal_Associate_I32,
+ Ghdl_Signal_Add_Port_Driver_I32,
Ghdl_Signal_Driving_Value_I32);
Create_Signal_Subprograms ("f64", Ghdl_Real_Type,
@@ -1521,6 +1533,7 @@ package body Translation is
Ghdl_Signal_Start_Assign_F64,
Ghdl_Signal_Next_Assign_F64,
Ghdl_Signal_Associate_F64,
+ Ghdl_Signal_Add_Port_Driver_F64,
Ghdl_Signal_Driving_Value_F64);
if not Flag_Only_32b then
@@ -1531,6 +1544,7 @@ package body Translation is
Ghdl_Signal_Start_Assign_I64,
Ghdl_Signal_Next_Assign_I64,
Ghdl_Signal_Associate_I64,
+ Ghdl_Signal_Add_Port_Driver_I64,
Ghdl_Signal_Driving_Value_I64);
end if;